diff --git a/.github/workflows/make.yml b/.github/workflows/make.yml index bd19e1c..58aa0a1 100644 --- a/.github/workflows/make.yml +++ b/.github/workflows/make.yml @@ -21,6 +21,7 @@ jobs: matrix: os: - ubuntu-latest + - windows-latest steps: - name: Checkout uses: actions/checkout@v4 @@ -31,3 +32,8 @@ jobs: if: runner.os == 'Linux' shell: bash run: bash -x make.sh build + + - name: Build on Windows + if: runner.os == 'Windows' + shell: powershell + run: pwsh -File make.ps1 build diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index 9f3398e..0000000 --- a/.gitmodules +++ /dev/null @@ -1,3 +0,0 @@ -[submodule "components/dexif"] - path = components/dexif - url = https://github.com/cutec-chris/dexif.git diff --git a/components/Abbrevia/MPL-1_1.txt b/components/Abbrevia/MPL-1_1.txt deleted file mode 100644 index 7a45bfe..0000000 --- a/components/Abbrevia/MPL-1_1.txt +++ /dev/null @@ -1,470 +0,0 @@ - MOZILLA PUBLIC LICENSE - Version 1.1 - - --------------- - -1. Definitions. - - 1.0.1. "Commercial Use" means distribution or otherwise making the - Covered Code available to a third party. - - 1.1. "Contributor" means each entity that creates or contributes to - the creation of Modifications. - - 1.2. "Contributor Version" means the combination of the Original - Code, prior Modifications used by a Contributor, and the Modifications - made by that particular Contributor. - - 1.3. "Covered Code" means the Original Code or Modifications or the - combination of the Original Code and Modifications, in each case - including portions thereof. - - 1.4. "Electronic Distribution Mechanism" means a mechanism generally - accepted in the software development community for the electronic - transfer of data. - - 1.5. "Executable" means Covered Code in any form other than Source - Code. - - 1.6. "Initial Developer" means the individual or entity identified - as the Initial Developer in the Source Code notice required by Exhibit - A. - - 1.7. "Larger Work" means a work which combines Covered Code or - portions thereof with code not governed by the terms of this License. - - 1.8. "License" means this document. - - 1.8.1. "Licensable" means having the right to grant, to the maximum - extent possible, whether at the time of the initial grant or - subsequently acquired, any and all of the rights conveyed herein. - - 1.9. "Modifications" means any addition to or deletion from the - substance or structure of either the Original Code or any previous - Modifications. When Covered Code is released as a series of files, a - Modification is: - A. Any addition to or deletion from the contents of a file - containing Original Code or previous Modifications. - - B. Any new file that contains any part of the Original Code or - previous Modifications. - - 1.10. "Original Code" means Source Code of computer software code - which is described in the Source Code notice required by Exhibit A as - Original Code, and which, at the time of its release under this - License is not already Covered Code governed by this License. - - 1.10.1. "Patent Claims" means any patent claim(s), now owned or - hereafter acquired, including without limitation, method, process, - and apparatus claims, in any patent Licensable by grantor. - - 1.11. "Source Code" means the preferred form of the Covered Code for - making modifications to it, including all modules it contains, plus - any associated interface definition files, scripts used to control - compilation and installation of an Executable, or source code - differential comparisons against either the Original Code or another - well known, available Covered Code of the Contributor's choice. The - Source Code can be in a compressed or archival form, provided the - appropriate decompression or de-archiving software is widely available - for no charge. - - 1.12. "You" (or "Your") means an individual or a legal entity - exercising rights under, and complying with all of the terms of, this - License or a future version of this License issued under Section 6.1. - For legal entities, "You" includes any entity which controls, is - controlled by, or is under common control with You. For purposes of - this definition, "control" means (a) the power, direct or indirect, - to cause the direction or management of such entity, whether by - contract or otherwise, or (b) ownership of more than fifty percent - (50%) of the outstanding shares or beneficial ownership of such - entity. - -2. Source Code License. - - 2.1. The Initial Developer Grant. - The Initial Developer hereby grants You a world-wide, royalty-free, - non-exclusive license, subject to third party intellectual property - claims: - (a) under intellectual property rights (other than patent or - trademark) Licensable by Initial Developer to use, reproduce, - modify, display, perform, sublicense and distribute the Original - Code (or portions thereof) with or without Modifications, and/or - as part of a Larger Work; and - - (b) under Patents Claims infringed by the making, using or - selling of Original Code, to make, have made, use, practice, - sell, and offer for sale, and/or otherwise dispose of the - Original Code (or portions thereof). - - (c) the licenses granted in this Section 2.1(a) and (b) are - effective on the date Initial Developer first distributes - Original Code under the terms of this License. - - (d) Notwithstanding Section 2.1(b) above, no patent license is - granted: 1) for code that You delete from the Original Code; 2) - separate from the Original Code; or 3) for infringements caused - by: i) the modification of the Original Code or ii) the - combination of the Original Code with other software or devices. - - 2.2. Contributor Grant. - Subject to third party intellectual property claims, each Contributor - hereby grants You a world-wide, royalty-free, non-exclusive license - - (a) under intellectual property rights (other than patent or - trademark) Licensable by Contributor, to use, reproduce, modify, - display, perform, sublicense and distribute the Modifications - created by such Contributor (or portions thereof) either on an - unmodified basis, with other Modifications, as Covered Code - and/or as part of a Larger Work; and - - (b) under Patent Claims infringed by the making, using, or - selling of Modifications made by that Contributor either alone - and/or in combination with its Contributor Version (or portions - of such combination), to make, use, sell, offer for sale, have - made, and/or otherwise dispose of: 1) Modifications made by that - Contributor (or portions thereof); and 2) the combination of - Modifications made by that Contributor with its Contributor - Version (or portions of such combination). - - (c) the licenses granted in Sections 2.2(a) and 2.2(b) are - effective on the date Contributor first makes Commercial Use of - the Covered Code. - - (d) Notwithstanding Section 2.2(b) above, no patent license is - granted: 1) for any code that Contributor has deleted from the - Contributor Version; 2) separate from the Contributor Version; - 3) for infringements caused by: i) third party modifications of - Contributor Version or ii) the combination of Modifications made - by that Contributor with other software (except as part of the - Contributor Version) or other devices; or 4) under Patent Claims - infringed by Covered Code in the absence of Modifications made by - that Contributor. - -3. Distribution Obligations. - - 3.1. Application of License. - The Modifications which You create or to which You contribute are - governed by the terms of this License, including without limitation - Section 2.2. The Source Code version of Covered Code may be - distributed only under the terms of this License or a future version - of this License released under Section 6.1, and You must include a - copy of this License with every copy of the Source Code You - distribute. You may not offer or impose any terms on any Source Code - version that alters or restricts the applicable version of this - License or the recipients' rights hereunder. However, You may include - an additional document offering the additional rights described in - Section 3.5. - - 3.2. Availability of Source Code. - Any Modification which You create or to which You contribute must be - made available in Source Code form under the terms of this License - either on the same media as an Executable version or via an accepted - Electronic Distribution Mechanism to anyone to whom you made an - Executable version available; and if made available via Electronic - Distribution Mechanism, must remain available for at least twelve (12) - months after the date it initially became available, or at least six - (6) months after a subsequent version of that particular Modification - has been made available to such recipients. You are responsible for - ensuring that the Source Code version remains available even if the - Electronic Distribution Mechanism is maintained by a third party. - - 3.3. Description of Modifications. - You must cause all Covered Code to which You contribute to contain a - file documenting the changes You made to create that Covered Code and - the date of any change. You must include a prominent statement that - the Modification is derived, directly or indirectly, from Original - Code provided by the Initial Developer and including the name of the - Initial Developer in (a) the Source Code, and (b) in any notice in an - Executable version or related documentation in which You describe the - origin or ownership of the Covered Code. - - 3.4. Intellectual Property Matters - (a) Third Party Claims. - If Contributor has knowledge that a license under a third party's - intellectual property rights is required to exercise the rights - granted by such Contributor under Sections 2.1 or 2.2, - Contributor must include a text file with the Source Code - distribution titled "LEGAL" which describes the claim and the - party making the claim in sufficient detail that a recipient will - know whom to contact. If Contributor obtains such knowledge after - the Modification is made available as described in Section 3.2, - Contributor shall promptly modify the LEGAL file in all copies - Contributor makes available thereafter and shall take other steps - (such as notifying appropriate mailing lists or newsgroups) - reasonably calculated to inform those who received the Covered - Code that new knowledge has been obtained. - - (b) Contributor APIs. - If Contributor's Modifications include an application programming - interface and Contributor has knowledge of patent licenses which - are reasonably necessary to implement that API, Contributor must - also include this information in the LEGAL file. - - (c) Representations. - Contributor represents that, except as disclosed pursuant to - Section 3.4(a) above, Contributor believes that Contributor's - Modifications are Contributor's original creation(s) and/or - Contributor has sufficient rights to grant the rights conveyed by - this License. - - 3.5. Required Notices. - You must duplicate the notice in Exhibit A in each file of the Source - Code. If it is not possible to put such notice in a particular Source - Code file due to its structure, then You must include such notice in a - location (such as a relevant directory) where a user would be likely - to look for such a notice. If You created one or more Modification(s) - You may add your name as a Contributor to the notice described in - Exhibit A. You must also duplicate this License in any documentation - for the Source Code where You describe recipients' rights or ownership - rights relating to Covered Code. You may choose to offer, and to - charge a fee for, warranty, support, indemnity or liability - obligations to one or more recipients of Covered Code. However, You - may do so only on Your own behalf, and not on behalf of the Initial - Developer or any Contributor. You must make it absolutely clear than - any such warranty, support, indemnity or liability obligation is - offered by You alone, and You hereby agree to indemnify the Initial - Developer and every Contributor for any liability incurred by the - Initial Developer or such Contributor as a result of warranty, - support, indemnity or liability terms You offer. - - 3.6. Distribution of Executable Versions. - You may distribute Covered Code in Executable form only if the - requirements of Section 3.1-3.5 have been met for that Covered Code, - and if You include a notice stating that the Source Code version of - the Covered Code is available under the terms of this License, - including a description of how and where You have fulfilled the - obligations of Section 3.2. The notice must be conspicuously included - in any notice in an Executable version, related documentation or - collateral in which You describe recipients' rights relating to the - Covered Code. You may distribute the Executable version of Covered - Code or ownership rights under a license of Your choice, which may - contain terms different from this License, provided that You are in - compliance with the terms of this License and that the license for the - Executable version does not attempt to limit or alter the recipient's - rights in the Source Code version from the rights set forth in this - License. If You distribute the Executable version under a different - license You must make it absolutely clear that any terms which differ - from this License are offered by You alone, not by the Initial - Developer or any Contributor. You hereby agree to indemnify the - Initial Developer and every Contributor for any liability incurred by - the Initial Developer or such Contributor as a result of any such - terms You offer. - - 3.7. Larger Works. - You may create a Larger Work by combining Covered Code with other code - not governed by the terms of this License and distribute the Larger - Work as a single product. In such a case, You must make sure the - requirements of this License are fulfilled for the Covered Code. - -4. Inability to Comply Due to Statute or Regulation. - - If it is impossible for You to comply with any of the terms of this - License with respect to some or all of the Covered Code due to - statute, judicial order, or regulation then You must: (a) comply with - the terms of this License to the maximum extent possible; and (b) - describe the limitations and the code they affect. Such description - must be included in the LEGAL file described in Section 3.4 and must - be included with all distributions of the Source Code. Except to the - extent prohibited by statute or regulation, such description must be - sufficiently detailed for a recipient of ordinary skill to be able to - understand it. - -5. Application of this License. - - This License applies to code to which the Initial Developer has - attached the notice in Exhibit A and to related Covered Code. - -6. Versions of the License. - - 6.1. New Versions. - Netscape Communications Corporation ("Netscape") may publish revised - and/or new versions of the License from time to time. Each version - will be given a distinguishing version number. - - 6.2. Effect of New Versions. - Once Covered Code has been published under a particular version of the - License, You may always continue to use it under the terms of that - version. You may also choose to use such Covered Code under the terms - of any subsequent version of the License published by Netscape. No one - other than Netscape has the right to modify the terms applicable to - Covered Code created under this License. - - 6.3. Derivative Works. - If You create or use a modified version of this License (which you may - only do in order to apply it to code which is not already Covered Code - governed by this License), You must (a) rename Your license so that - the phrases "Mozilla", "MOZILLAPL", "MOZPL", "Netscape", - "MPL", "NPL" or any confusingly similar phrase do not appear in your - license (except to note that your license differs from this License) - and (b) otherwise make it clear that Your version of the license - contains terms which differ from the Mozilla Public License and - Netscape Public License. (Filling in the name of the Initial - Developer, Original Code or Contributor in the notice described in - Exhibit A shall not of themselves be deemed to be modifications of - this License.) - -7. DISCLAIMER OF WARRANTY. - - COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, - WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, - WITHOUT LIMITATION, WARRANTIES THAT THE COVERED CODE IS FREE OF - DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE OR NON-INFRINGING. - THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED CODE - IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, - YOU (NOT THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE - COST OF ANY NECESSARY SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER - OF WARRANTY CONSTITUTES AN ESSENTIAL PART OF THIS LICENSE. NO USE OF - ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. - -8. TERMINATION. - - 8.1. This License and the rights granted hereunder will terminate - automatically if You fail to comply with terms herein and fail to cure - such breach within 30 days of becoming aware of the breach. All - sublicenses to the Covered Code which are properly granted shall - survive any termination of this License. Provisions which, by their - nature, must remain in effect beyond the termination of this License - shall survive. - - 8.2. If You initiate litigation by asserting a patent infringement - claim (excluding declatory judgment actions) against Initial Developer - or a Contributor (the Initial Developer or Contributor against whom - You file such action is referred to as "Participant") alleging that: - - (a) such Participant's Contributor Version directly or indirectly - infringes any patent, then any and all rights granted by such - Participant to You under Sections 2.1 and/or 2.2 of this License - shall, upon 60 days notice from Participant terminate prospectively, - unless if within 60 days after receipt of notice You either: (i) - agree in writing to pay Participant a mutually agreeable reasonable - royalty for Your past and future use of Modifications made by such - Participant, or (ii) withdraw Your litigation claim with respect to - the Contributor Version against such Participant. If within 60 days - of notice, a reasonable royalty and payment arrangement are not - mutually agreed upon in writing by the parties or the litigation claim - is not withdrawn, the rights granted by Participant to You under - Sections 2.1 and/or 2.2 automatically terminate at the expiration of - the 60 day notice period specified above. - - (b) any software, hardware, or device, other than such Participant's - Contributor Version, directly or indirectly infringes any patent, then - any rights granted to You by such Participant under Sections 2.1(b) - and 2.2(b) are revoked effective as of the date You first made, used, - sold, distributed, or had made, Modifications made by that - Participant. - - 8.3. If You assert a patent infringement claim against Participant - alleging that such Participant's Contributor Version directly or - indirectly infringes any patent where such claim is resolved (such as - by license or settlement) prior to the initiation of patent - infringement litigation, then the reasonable value of the licenses - granted by such Participant under Sections 2.1 or 2.2 shall be taken - into account in determining the amount or value of any payment or - license. - - 8.4. In the event of termination under Sections 8.1 or 8.2 above, - all end user license agreements (excluding distributors and resellers) - which have been validly granted by You or any distributor hereunder - prior to termination shall survive termination. - -9. LIMITATION OF LIABILITY. - - UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT - (INCLUDING NEGLIGENCE), CONTRACT, OR OTHERWISE, SHALL YOU, THE INITIAL - DEVELOPER, ANY OTHER CONTRIBUTOR, OR ANY DISTRIBUTOR OF COVERED CODE, - OR ANY SUPPLIER OF ANY OF SUCH PARTIES, BE LIABLE TO ANY PERSON FOR - ANY INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY - CHARACTER INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, - WORK STOPPAGE, COMPUTER FAILURE OR MALFUNCTION, OR ANY AND ALL OTHER - COMMERCIAL DAMAGES OR LOSSES, EVEN IF SUCH PARTY SHALL HAVE BEEN - INFORMED OF THE POSSIBILITY OF SUCH DAMAGES. THIS LIMITATION OF - LIABILITY SHALL NOT APPLY TO LIABILITY FOR DEATH OR PERSONAL INJURY - RESULTING FROM SUCH PARTY'S NEGLIGENCE TO THE EXTENT APPLICABLE LAW - PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE - EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO - THIS EXCLUSION AND LIMITATION MAY NOT APPLY TO YOU. - -10. U.S. GOVERNMENT END USERS. - - The Covered Code is a "commercial item," as that term is defined in - 48 C.F.R. 2.101 (Oct. 1995), consisting of "commercial computer - software" and "commercial computer software documentation," as such - terms are used in 48 C.F.R. 12.212 (Sept. 1995). Consistent with 48 - C.F.R. 12.212 and 48 C.F.R. 227.7202-1 through 227.7202-4 (June 1995), - all U.S. Government End Users acquire Covered Code with only those - rights set forth herein. - -11. MISCELLANEOUS. - - This License represents the complete agreement concerning subject - matter hereof. If any provision of this License is held to be - unenforceable, such provision shall be reformed only to the extent - necessary to make it enforceable. This License shall be governed by - California law provisions (except to the extent applicable law, if - any, provides otherwise), excluding its conflict-of-law provisions. - With respect to disputes in which at least one party is a citizen of, - or an entity chartered or registered to do business in the United - States of America, any litigation relating to this License shall be - subject to the jurisdiction of the Federal Courts of the Northern - District of California, with venue lying in Santa Clara County, - California, with the losing party responsible for costs, including - without limitation, court costs and reasonable attorneys' fees and - expenses. The application of the United Nations Convention on - Contracts for the International Sale of Goods is expressly excluded. - Any law or regulation which provides that the language of a contract - shall be construed against the drafter shall not apply to this - License. - -12. RESPONSIBILITY FOR CLAIMS. - - As between Initial Developer and the Contributors, each party is - responsible for claims and damages arising, directly or indirectly, - out of its utilization of rights under this License and You agree to - work with Initial Developer and Contributors to distribute such - responsibility on an equitable basis. Nothing herein is intended or - shall be deemed to constitute any admission of liability. - -13. MULTIPLE-LICENSED CODE. - - Initial Developer may designate portions of the Covered Code as - "Multiple-Licensed". "Multiple-Licensed" means that the Initial - Developer permits you to utilize portions of the Covered Code under - Your choice of the NPL or the alternative licenses, if any, specified - by the Initial Developer in the file described in Exhibit A. - -EXHIBIT A -Mozilla Public License. - - ``The contents of this file are subject to the Mozilla Public License - Version 1.1 (the "License"); you may not use this file except in - compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/ - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the - License for the specific language governing rights and limitations - under the License. - - The Original Code is ______________________________________. - - The Initial Developer of the Original Code is ________________________. - Portions created by ______________________ are Copyright (C) ______ - _______________________. All Rights Reserved. - - Contributor(s): ______________________________________. - - Alternatively, the contents of this file may be used under the terms - of the _____ license (the "[___] License"), in which case the - provisions of [______] License are applicable instead of those - above. If you wish to allow use of your version of this file only - under the terms of the [____] License and not to allow others to use - your version of this file under the MPL, indicate your decision by - deleting the provisions above and replace them with the notice and - other provisions required by the [___] License. If you do not delete - the provisions above, a recipient may use your version of this file - under either the MPL or the [___] License." - - [NOTE: The text of this Exhibit A may differ slightly from the text of - the notices in the Source Code files of the Original Code. You should - use the text of this Exhibit A rather than the text found in the - Original Code Source Code for Your Modifications.] - diff --git a/components/Abbrevia/Readme.html b/components/Abbrevia/Readme.html deleted file mode 100644 index 2122dcc..0000000 --- a/components/Abbrevia/Readme.html +++ /dev/null @@ -1,221 +0,0 @@ - - - - Abbrevia v5.0 - - - - - - -

Abbrevia

- -

Version 5.0
-December 6, 2011
-Home Page

- -
- -

Table of contents

- - - - -
- - -

Introduction

- -

Abbrevia is a compression toolkit for Embarcadero Delphi, C++ Builder, and Kylix, and FreePascal. It supports PKZip, Microsoft CAB, tar, gzip, bzip2 and zlib compression formats, and the creation of self-extracting executables. It includes several visual components that simplify displaying zip files.

- -

Abbrevia 5.0 adds a number of new features and support for more platforms:

- - - -

This is a source-only release. It includes design-time and run-time packages for Delphi 6 through Delphi XE2, C++Builder 2009 through XE2, and Kylix 3. FreePascal is supported, but runtime/design time packages are not included. The LZMA, PPMd, and WavPack algorithms are only supported on Delphi/C++Builder for Windows (32 and 64-bit).

- - -
- - -

Packages

- -

Abbrevia includes the following packages:

- - - -

$LIBSUFFIX is used, so each .bpl/.bpi will have a version number after it corresponding to the compiler version (e.g. 160 for Delphi XE2).

- -

The Kylix 3 AbbreviaCLX package includes all of the non-visual runtime units, and the Abbrevia package is not included separately.

- - -
- - -

Installation

- -

To install TurboPower Abbrevia into your IDE:

- -
    -
  1. Unzip the release files into a directory (e.g., d:\abbrevia).
    2. -
  2. Start Delphi or C++Builder.
    3. -
  3. Add the source subdirectory (e.g. d:\abbrevia\source) to the Delphi Library path. When using XE2 or later, add it to all platforms.
    4. -
  4. If using C++Builder, add the source subdirectory to C++Builder's Include and Library paths.
    5. -
  5. Open the project group in the packages directory that corresponds to the IDE being used (e.g. "Delphi XE2.groupproj").
    6. -
  6. Start at the top of the project group and compile each package in turn. If using C++Builder, install each one after compiling.
    7. -
  7. Select the "AbbreviaVCLDesign" package and install it. The IDE should notify you that the components have been installed. If you are using Delphi 7 you can install "AbbreviaCLXDesign" as well to get CLX designtime support.
    8. -
  8. Make sure the PATH environmental variable contains the directory in which the compiled packages (i.e. BPL or DPL files) were placed.
    9. -
- - -
- - -

Support and feedback

- -

Support forums are available on the SourceForge project site.

- -

Bug reports can be entered in the bug tracker. If possible please include a small test case that reproduces the issue. Sample files can be attached to the bug report, and confidential data can be emailed to the project administrator.

- -

If you have something you would like to see in the product feel free to add a feature request.

- - -
- - -

Development sources

- -

The current source code is available in the Subversion repository. The code here may not be as stable or tested as the official releases, but may include bug fixes or new features not yet included in the downloadable releases.

- -

The repository also includes DUnit tests, the source code to the third-party libraries, and the Help source code.

- - -
- - -

Getting involved

- -

If you want to help make Abbrevia better, there are several ways to get involved. We welcome help with features and bug fixes. Just look in the issue tracker to see what's needed. We're also looking for help for:

- - - - -
- - -

License

- -

Abbrevia is licensed under the Mozilla Public License, version 1.1. It can be used in commercial and closed-source applications provided any changes to Abbrevia units are made available electronically.

- -

The WavPack library used for zipx decompression has its own license, included as "WavPack License.txt". Redistribution requires a copyright notice in your documentation or elsewhere in your distribution. WavPack support can be removed by disabling the UnzipZipxSupport or UnzipWavPackSupport conditional define in AbDefine.inc.

- - -
- - -

Changes from 4.0

- -

These are the most significant features, fixes and changes made since v4.0. Information on earlier versions is available in the full changelog.

- -

Features

- - - -

API Changes

- - - -

Bug Fixes

- - - -

Split/Spanned Zip Changes

- - - - - \ No newline at end of file diff --git a/components/Abbrevia/WavPack License.txt b/components/Abbrevia/WavPack License.txt deleted file mode 100644 index c33a69e..0000000 --- a/components/Abbrevia/WavPack License.txt +++ /dev/null @@ -1,25 +0,0 @@ - Copyright (c) 1998 - 2009 Conifer Software - All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - * Neither the name of Conifer Software nor the names of its contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/components/Abbrevia/localization/AbResString.pas.afr b/components/Abbrevia/localization/AbResString.pas.afr deleted file mode 100644 index 103c236..0000000 --- a/components/Abbrevia/localization/AbResString.pas.afr +++ /dev/null @@ -1,247 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Henri Hakl, Roman Kassebaum - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbResString.pas *} -{*********************************************************} -{* Abbrevia: Resource strings, Africaans localization *} -{*********************************************************} -unit AbResString; - -interface - -resourcestring - AbErrZipInvalidS = 'Ongeldig - geen PKZIP bestaan nie'; - AbZipVersionNeededS = 'Lêer kannie ontpak word nie - kry nuwer weergawe van PKZIP'; - AbUnknownCompressionMethodS = 'Lêer kannie ontpak word nie - onbekende kompressiemetode'; - AbNoExtractionMethodS = 'Lêer kannie ontpak word nie - geen ondersteunende metode'; - AbInvalidPasswordS = 'Lêer kannie ontpak word nie - ongeldige paswoord'; - AbNoInsertionMethodS = 'Lêer kannie bygevoeg word nie - byvoeging is nie ondersteun nie'; - AbInvalidFactorS = 'Ongeldige reduksiefaktoor'; - AbDuplicateNameS = 'Lêer kannie bygevoeg word nie - tweevoud by name gevind'; - AbUnsupportedCompressionMethodS = 'Lêer kannie bygevoeg word nie - nie ondersteunde kompressiemetode'; - AbUserAbortS = 'Proses is deur gebruiker onderbreek'; - AbArchiveBusyS = 'Argief is besig - kan nuwe aanvrag nie bewerk nie'; - AbLastDiskRequestS = 'Benodig laaste skyf van gedeelde argief'; - AbDiskRequestS = 'Benodig skyf'; - AbImageRequestS = 'Benodig naam'; - AbBadSpanStreamS = 'Gedeelde argief moet als bestandsstroom geopen word'; - AbDiskNumRequestS = 'Benodig skyf %d van gedeelde argief'; - AbImageNumRequestS = 'Benodig segment %d van gedeelde argief'; - AbNoOverwriteSpanStreamS = 'Kannie bestaande gedeelde argief verander nie'; - AbNoSpannedSelfExtractS = 'Kannie selfontpakkende gedeelde argief maak nie'; - AbBlankDiskS = 'Benodig leë skyf'; - AbStreamFullS = 'Stroom skryffout'; - AbNoSuchDirectoryS = 'Gids bestaan nie'; - AbInflateBlockErrorS = 'Kannie blok ontpak nie'; - AbBadStreamTypeS = 'Ongeldige stroom'; - AbTruncateErrorS = 'Daar bestaan in afknottings fout in zip-lêer'; - AbZipBadCRCS = 'CRC kontroole his misluk'; - AbZipBadStubS = 'Stomp moet uitvoerbaar wees'; - AbFileNotFoundS = 'Lêer nie gevind nie'; - AbInvalidLFHS = 'Ongeldige lokaale lêer obskrif element'; - AbNoArchiveS = 'Argief bestaan nie'; - AbReadErrorS = 'Leesfout in argief'; - AbInvalidIndexS = 'Ongeldige indeks van argiefelement'; - AbInvalidThresholdS = 'Ongeldige drempel van argiefgroote'; - AbUnhandledFileTypeS = 'Onbekende argieftype'; - AbSpanningNotSupportedS = 'Argief deeling is nie ondersteun nie'; - AbLogCreateErrorS = 'Fout gedurende protokol skepping'; - AbMoveFileErrorS = 'Fout gedurende verplasing van lêer van %s na %s'; - AbFileSizeTooBigS = 'Lêer is te groot vir argieftype'; - - AbNoCabinetDllErrorS = 'Kannie lêer cabinet.dll laai nie'; - AbFCIFileOpenErrorS = 'FCI kannie lêer oopmaak nie'; - AbFCIFileReadErrorS = 'FCI kannie lêer lees nie'; - AbFCIFileWriteErrorS = 'FCI kannie lêer skryf nie'; - AbFCIFileCloseErrorS = 'FCI kannie lêer toemaak nie'; - AbFCIFileSeekErrorS = 'FCI kannie posisie verander nie'; - AbFCIFileDeleteErrorS = 'FCI kannie lêer verwyder nie'; - AbFCIAddFileErrorS = 'FCI kannie lêer byvoeg nie'; - AbFCICreateErrorS = 'FCI kannie conteks skep nie'; - AbFCIFlushCabinetErrorS = 'FCI kannie kabinet spoel nie'; - AbFCIFlushFolderErrorS = 'FCI kannie gids spoel nie'; - AbFDICopyErrorS = 'FDI kannie lêer opsom nie'; - AbFDICreateErrorS = 'FDI kannie konteks skep nie'; - AbInvalidCabTemplateS = 'Ongeldige kabinet sjabloon'; - AbInvalidCabFileS = 'Ongeldiger lêer - geen kabinet bestaan nie'; - - AbZipStored = 'Opgeslagen'; - AbZipShrunk = 'Gekrimp'; - AbZipReduced = 'Verminder'; - AbZipImploded = 'Geïmplodeerd'; - AbZipTokenized = 'In simboole gepak'; - AbZipDeflated = 'Gedeflationeerd'; - AbZipDeflate64 = 'Uitgebreid gedeflationeerd'; - AbZipDCLImploded = 'DCL geïmplodeerd'; - AbZipBzip2 = 'Bzip2'; - AbZipLZMA = 'LZMA'; - AbZipIBMTerse = 'IBM Terse'; - AbZipLZ77 = 'IBM LZ77'; - AbZipJPEG = 'JPEG'; - AbZipWavPack = 'WavPack'; - AbZipPPMd = 'PPMd'; - AbZipUnknown = 'Onbekend (%d)'; - AbZipBestMethod = 'Beste metode'; - - AbVersionFormatS = 'Weergawe'; - AbCompressedSizeFormatS = 'Gekomprimeerde groote: %d'; - AbUncompressedSizeFormatS = 'Ongekomprimeerde groote: %d'; - AbCompressionMethodFormatS = 'Kompressie metode: %s'; - AbCompressionRatioFormatS = 'Kompressieverhouding: %2.0f%%'; - AbCRCFormatS = 'CRC: %x'; - AbReadOnlyS = 'r'; - AbHiddenS = 'h'; - AbSystemS = 's'; - AbArchivedS = 'a'; - AbEFAFormatS = 'Eksterne lêerattribute: %s'; - AbIFAFormatS = 'Lêertype'; - AbTextS = 'Teks'; - AbBinaryS = 'Binêre'; - AbEncryptionFormatS = 'Versleuteling: %s'; - AbEncryptedS = 'Versleuteld'; - AbNotEncryptedS = 'Nie versleuteld nie'; - AbUnknownS = 'Onbekend'; - AbTimeStampFormatS = 'Tydstempel: %s'; - AbMadeByFormatS = 'Gemaak met weergawe: %f'; - AbNeededFormatS = 'Weergawe benodig vir ontpakking: %f'; - AbCommentFormatS = 'Opmerking: %s'; - AbDefaultExtS = '*.zip'; - AbFilterS = 'PKZIP argief (*.zip)|*.zip|Selfontpakkende Argief (*.exe)|*.exe|Alle Lêers (*.*)|*.*'; - AbFileNameTitleS = 'Kies lêernaam'; - - AbOKS = 'OK'; - AbCancelS = 'Verlaat'; - AbSelectDirectoryS = 'Kies lêer'; - - AbEnterPasswordS = 'Voeg paswoord in'; - AbPasswordS = '&Paswoord'; - AbVerifyS = '&Verifiseer'; - - AbCabExtS = '*.cab'; - AbCabFilterS = 'Kabinetsargiewe (*.cab)|*.CAB|Alle Lêers (*.*)|*.*'; - AbLogExtS = '*.txt'; - AbLogFilterS = 'Tekslêers (*.cab)|*.CAB|Alle Lêers (*.*)|*.*'; - AbExeExtS = '*.exe'; - AbExeFilterS = 'Selfontpakkende Zip Lêers (*.cab)|*.CAB|Alle Lêers (*.*)|*.*'; - - AbVMSReadTooManyBytesS = 'VMS: Te veel byte gelees'; - AbVMSInvalidOriginS = 'VMS: Ongeldige oorsprong %d, moet 0, 1 or 2 wees'; - AbVMSErrorOpenSwapS = 'VMS: Kannie wissellêer oopmaak nie'; - AbVMSSeekFailS = 'VMS: Kannie wissellêer posisie verander nie'; - AbVMSReadFailS = 'VMS: Kan %d byte in wissellêer nie lees nie'; - AbVMSWriteFailS = 'VMS: Kan %d byte in wissellêer nie skryf nie'; - AbVMSWriteTooManyBytesS = 'VMS: Aanvraag om te veel byte [%d] te skryf'; - - AbBBSReadTooManyBytesS = 'BBS: Aanvraag om te veel byte [%d] te lees'; - AbBBSSeekOutsideBufferS = 'BBS: Nuwe posisie is buite die buffer'; - AbBBSInvalidOriginS = 'BBS: Ongeldige oorsprongswaarde'; - AbBBSWriteTooManyBytesS = 'BBS: Aanvrag om te veel byte [%d] te skryf'; - - AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Nie by stroom einde nie'; - AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: Posisioneering misluk'; - AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteCunk: Skryf misluk'; - AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Ongeldige oorsprong'; - AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Ongeldige nuwe posisie'; - - AbItemNameHeadingS = 'Naam'; - AbPackedHeadingS = 'Gepak'; - AbMethodHeadingS = 'Metode'; - AbRatioHeadingS ='Besparing (%)'; - AbCRCHeadingS = 'CRC32'; - AbFileAttrHeadingS = 'Attribuut'; - AbFileFormatHeadingS = 'Formaat'; - AbEncryptionHeadingS = 'Versleuteld'; - AbTimeStampHeadingS = 'Tydstempel'; - AbFileSizeHeadingS = 'Groote'; - AbVersionMadeHeadingS = 'Gebruikte weergawe'; - AbVersionNeededHeadingS = 'Benodigde weergawe'; - AbPathHeadingS = 'Pad'; - AbPartialHeadingS = 'Partieel'; - AbExecutableHeadingS = 'Uitvoerbaar'; - - AbCabMethod0S = 'Geen'; - AbCabMethod1S = 'MSZip'; - - AbLtAddS = ' toegevoegd '; - AbLtDeleteS = ' gewist '; - AbLtExtractS = ' ontpakt '; - AbLtFreshenS = ' geaktualiseerd '; - AbLtMoveS = ' verplaas '; - AbLtReplaceS = ' vervang '; - AbLtStartS = ' geprotocoleerd '; - - AbGzipInvalidS = 'Ongeldige Gzip'; - AbGzipBadCRCS = 'Ongeldige CRC'; - AbGzipBadFileSizeS = 'Ongeldige bestaandsgroote'; - - AbTarInvalidS = 'Tar ongeldig'; - AbTarBadFileNameS = 'Lêer naam te lang'; - AbTarBadLinkNameS = 'Skakel naam te lang'; - AbTarBadOpS = 'Operasie nie ondersteun nie'; - - AbUnhandledEntityS = 'Nie behandelde entiteit'; - - { pre-defined "operating system" (really more FILE system) identifiers for the - Gzip header } - AbGzOsFat = 'FAT Lêersisteem (MS-DOS, OS/2, NT/Win32)'; - AbGzOsAmiga = 'Amiga'; - AbGzOsVMS = 'VMS (of OpenVMS)'; - AbGzOsUnix = 'Unix'; - AbGzOsVM_CMS = 'VM/CMS'; - AbGzOsAtari = 'Atari TOS'; - AbGzOsHPFS = 'HPFS Lêersisteem (OS/2, NT)'; - AbGzOsMacintosh = 'Macintosh'; - AbGzOsZ_System = 'Z-System'; - AbGzOsCP_M = 'CP/M'; - AbGzOsTOPS_20 = 'TOPS-20'; - AbGzOsNTFS = 'NTFS Lêersisteem (NT)'; - AbGzOsQDOS = 'QDOS'; - AbGzOsAcornRISCOS = 'Acorn RISCOS'; - AbGzOsVFAT = 'VFAT Lêersisteem (Win95, NT)'; - AbGzOsMVS = 'MVS'; - AbGzOsBeOS = 'BeOS (BeBox of PowerMac)'; - AbGzOsTandem = 'Tandem/NSK'; - AbGzOsTHEOS = 'THEOS'; - AbGzOsunknown = 'onbekend'; - AbGzOsUndefined = 'ID is Gzip nie bekend nie'; - -{!!.03 - Moved from AbCompnd.inc } -{ Compound File specific error messages } -resourcestring - AbCmpndIndexOutOfBounds = 'Indeks buite toegelate bereik'; - AbCmpndBusyUpdating = 'Saamgestelde lêer word geaktualiseer'; - AbCmpndInvalidFile = 'Ongeldige saamgestelde lêer'; - AbCmpndFileNotFound = 'Lêer/gids nie gevind nie'; - AbCmpndFolderNotEmpty = 'Gids nie leeg nie'; - AbCmpndExceedsMaxFileSize = 'Lêergroote oorskryf toegelate maksimum'; -{!!.03 - End Moved } - - - -implementation - -end. diff --git a/components/Abbrevia/localization/AbResString.pas.de b/components/Abbrevia/localization/AbResString.pas.de deleted file mode 100644 index 1b008de..0000000 --- a/components/Abbrevia/localization/AbResString.pas.de +++ /dev/null @@ -1,249 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Roman Kassebaum - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbResString.pas *} -{*********************************************************} -{* Abbrevia: Resource strings, German localization *} -{*********************************************************} -unit AbResString; - -interface - -resourcestring - AbErrZipInvalidS = 'Ungültige Datei - keine PKZip Datei'; - AbZipVersionNeededS = 'Kann die Datei nicht entpacken - neuere Version benötigt'; - AbUnknownCompressionMethodS = 'Kann die Datei nicht entpacken - nicht unterstützte Kommpressionsmethode'; - AbNoExtractionMethodS = 'Kann die Datei nicht entpacken - keine Entpackunterstützung angeboten'; - AbInvalidPasswordS = 'Kann die Datei nicht entpacken - ungültiges Passwort'; - AbNoInsertionMethodS = 'Kann die Datei nicht entpacken - keine Einfügeunterstützung angeboten'; - AbInvalidFactorS = 'Ungültiger Reduzierungsfaktor'; - AbDuplicateNameS = 'Kann die Datei nicht einfügen - doppelter gespeicherter Name'; - AbUnsupportedCompressionMethodS = 'Kann die Datei nicht einfügen - nicht unterstützt Kompressionsmethode'; - AbUserAbortS = 'Prozess wurde durch den Benutzer abgebrochen'; - AbArchiveBusyS = 'Das Archiv ist beschäftigt - kann nicht die neue Anforderung bearbeiten'; - AbLastDiskRequestS = 'Legen Sie die letzte Diskette ein'; - AbDiskRequestS = 'Diskette einlegen '; - AbImageRequestS = 'Name des Abbildes'; - AbBadSpanStreamS = 'Segmentierte Archive müssen als Datei-Strom geöffnet werden'; - AbDiskNumRequestS = 'Legen Sie die Diskette %d des segmentierten Archivs ein'; - AbImageNumRequestS = 'Legen Sie das Segment %d des segmentierten Archivs ein'; - AbNoOverwriteSpanStreamS = 'Kann kein existierendes segmentiertes Archiv verändern'; - AbNoSpannedSelfExtractS = 'Kann kein selbstentpackendes segmentiertes Archiv erstellen'; - AbBlankDiskS = 'Legen Sie eine leere Diskette ein'; - AbStreamFullS = 'Strom Schreibfehler'; - AbNoSuchDirectoryS = 'Verzeichnis existiert nicht'; - AbInflateBlockErrorS = 'Kann den Bereich nicht entpacken'; - AbBadStreamTypeS = 'Ungültiger Strom'; - AbTruncateErrorS = 'Fehler beim Abschneiden der zip Datei'; - AbZipBadCRCS = 'Fehlgeschalgene CRC Überprüfung'; - AbZipBadStubS = 'Der Stamm muss ausführbar sein'; - AbFileNotFoundS = 'Datei nicht gefunden'; - AbInvalidLFHS = 'Ungültiger lokaler Dateianfang'; - AbNoArchiveS = 'Das Archiv existiert nicht- leerer Dateinahme'; - AbReadErrorS = 'Fehler beim Lesen des Archivse'; - AbInvalidIndexS = 'Ungültiger Archiv Element Eintrag'; - AbInvalidThresholdS = 'Ungültige Archivgrößen Schwelle'; - AbUnhandledFileTypeS = 'Unbekannter Archiv'; - AbSpanningNotSupportedS = 'Aufteilen wird bei diesem Archivtyp nicht unterstützt'; - AbLogCreateErrorS = 'Fehler beim Erzeugen der Protokolldatei'; - AbMoveFileErrorS = 'Fehler beim Verschieben der Datei %s nach %s'; - AbFileSizeTooBigS = 'Datei ist zu groß für diesen Archivtypen'; - - AbNoCabinetDllErrorS = 'Kann die Datei cabinet.dll nicht laden'; - AbFCIFileOpenErrorS = 'FCI kann die Datei nicht öffnen'; - AbFCIFileReadErrorS = 'FCI kann die Datei nicht lesen'; - AbFCIFileWriteErrorS = 'FCI kann die Datei nicht schreiben'; - AbFCIFileCloseErrorS = 'FCI Fehler beim Schließen der Datei'; - AbFCIFileSeekErrorS = 'FCI Fehler beim Durchsuchen der Datei'; - AbFCIFileDeleteErrorS = 'FCI Fehler beim Löschen der Datei'; - AbFCIAddFileErrorS = 'FCI kann die Datei nicht hinzufügen'; - AbFCICreateErrorS = 'FCI kann den Zusammenhang nicht erstellen'; - AbFCIFlushCabinetErrorS = 'FCI kann das Cabinet-Archiv nicht leeren'; - AbFCIFlushFolderErrorS = 'FCI kann das Verzeichnis nicht leeren'; - AbFDICopyErrorS = 'FDI kann die Dateien nicht aufzählen'; - AbFDICreateErrorS = 'FDI kann den Zusammenhang nicht herstellen'; - AbInvalidCabTemplateS = 'Ungültige Vorlage für eine Cabinet-Datei'; - AbInvalidCabFileS = 'Ungültige Datei - keine Kabinett Datei'; - - AbZipStored = 'Gespeichert'; - AbZipShrunk = 'Geschrumpft'; - AbZipReduced = 'Reduziert'; - AbZipImploded = 'Implodiert'; - AbZipTokenized = 'In Merkmale aufgeteilt'; - AbZipDeflated = 'Gepackt'; - AbZipDeflate64 = 'Stärker gepackt'; - AbZipDCLImploded = 'DCL Implodiert'; - AbZipBzip2 = 'Bzip2'; - AbZipLZMA = 'LZMA'; - AbZipIBMTerse = 'IBM Terse'; - AbZipLZ77 = 'IBM LZ77'; - AbZipJPEG = 'JPEG'; - AbZipWavPack = 'WavPack'; - AbZipPPMd = 'PPMd'; - AbZipUnknown = 'Unbekannt (%d)'; - AbZipBestMethod = 'Beste Methode'; - - AbVersionFormatS = 'Version %s'; - AbCompressedSizeFormatS = 'Komprimierte Größe: %d'; - AbUncompressedSizeFormatS = 'Komprimierte Größe: %d'; - AbCompressionMethodFormatS = 'Kompressions-Methode: %s'; - AbCompressionRatioFormatS = 'Kompressions-Verhältnis: %2.0f%%'; - AbCRCFormatS = 'CRC: %x'; - AbReadOnlyS = 'r'; - AbHiddenS = 'h'; - AbSystemS = 's'; - AbArchivedS = 'a'; - AbEFAFormatS = 'Externe Datei Attribute: %s'; - AbIFAFormatS = 'Dateityp: %s'; - AbTextS = 'Text'; - AbBinaryS = 'Binär'; - AbEncryptionFormatS = 'Verschlüsselung: %s'; - AbEncryptedS = 'Verschlüsselt'; - AbNotEncryptedS = 'Nicht verschlüsselt'; - AbUnknownS = 'Unbekannt'; - AbTimeStampFormatS = 'Zeitstemple: %s'; - AbMadeByFormatS = 'Erzeugt mit der Version: %f'; - AbNeededFormatS = 'Version benötigt zum Extrahieren: %f'; - AbCommentFormatS = 'Kommentar: %s'; - AbDefaultExtS = '*.zip'; - AbFilterS = 'PKZip Archive (*.zip)|*.zip|Selbstentpackende Archive (*.exe)|*.exe|Alle Dateien (*.*)|*.*'; - AbFileNameTitleS = 'Dateinamen auswählen'; - - AbOKS = 'OK'; - AbCancelS = 'Abbrechen'; - AbSelectDirectoryS = 'Verzeichnis auswählen'; - - AbEnterPasswordS = 'Passwort eingeben'; - AbPasswordS = '&Passwort'; - AbVerifyS = '&Überprüfen'; - - AbCabExtS = '*.cab'; - AbCabFilterS = 'Cabinet Archive (*.cab)|*.CAB|Alle Dateien (*.*)|*.*'; - AbLogExtS = '*.txt'; - AbLogFilterS = 'Text Dateien (*.txt)|*.TXT|Alle Dateien (*.*)|*.*'; - AbExeExtS = '*.exe'; - AbExeFilterS = 'Selbstentpackende Zip Dateien (*.exe)|*.EXE|Alle Dateien (*.*)|*.*'; - - AbVMSReadTooManyBytesS = 'VMS: Anforderung, zu viele Bytes [%d] zu lesen'; - AbVMSInvalidOriginS = 'VMS: Ungültiger Ursprung %d, sollte 0, 1, 2 sein'; - AbVMSErrorOpenSwapS = 'VMS: Kann die Auslagerungsdatei %s nicht öffnen'; - AbVMSSeekFailS = 'VMS: Konnte nicht in der Auslagerungsdatei %s suchen'; - AbVMSReadFailS = 'VMS: Konnte nicht %d Bytes in der Auslagerungsdatei %s lesen'; - AbVMSWriteFailS = 'VMS: Konnte nicht %d Bytes in die Auslagerungsdatei %s schreiben'; - AbVMSWriteTooManyBytesS = 'VMS: Anforderung, zu viele Bytes [%d] zu schreiben'; - - AbBBSReadTooManyBytesS = 'BBS: Anforderung, zu viele Bytes [%d] zu lesen'; - AbBBSSeekOutsideBufferS = 'BBS: Die neue Position ist außerhalb des Puffers'; - AbBBSInvalidOriginS = 'BBS: Ungültiger Ursprungswert'; - AbBBSWriteTooManyBytesS = 'BBS: Anforderung, zu viele Bytes [%d] zu schreiben'; - - AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Nicht am Ende des Datenstroms'; - AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: Suche fehlgeschlagen'; - AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: Schreiben fehlgeschlagen'; - AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Ungültiger Ursprung'; - AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Ungültige neue Position'; - - AbItemNameHeadingS = 'Name'; - AbPackedHeadingS = 'Gepacked'; - AbMethodHeadingS = 'Methode'; - AbRatioHeadingS = 'Einsparung (%)'; - AbCRCHeadingS = 'CRC32'; - AbFileAttrHeadingS = 'Attribute'; - AbFileFormatHeadingS = 'Format'; - AbEncryptionHeadingS = 'Verschlüsselt'; - AbTimeStampHeadingS = 'Zeitstempel'; - AbFileSizeHeadingS = 'Größe'; - AbVersionMadeHeadingS = 'Version genutzt'; - AbVersionNeededHeadingS = 'Version benötigt'; - AbPathHeadingS = 'Pfad'; - AbPartialHeadingS = 'Teilweise'; - AbExecutableHeadingS = 'Ausführbar'; - AbFileTypeHeadingS = 'Typ'; - AbLastModifiedHeadingS = 'Modifiziert'; - - AbCabMethod0S = 'Keine'; - AbCabMethod1S = 'MSZip'; - - AbLtAddS = ' hinzugefügt '; - AbLtDeleteS = ' gelöscht '; - AbLtExtractS = ' extrahiert '; - AbLtFreshenS = ' aktualisiert '; - AbLtMoveS = ' verschoben '; - AbLtReplaceS = ' ersetzt '; - AbLtStartS = ' protokolliert '; - - AbGzipInvalidS = 'Ungültiges Gzip'; - AbGzipBadCRCS = 'Ungültiger CRC'; - AbGzipBadFileSizeS = 'Ungültige Datei Größe'; - - AbTarInvalidS = 'Ungültiges Tar'; - AbTarBadFileNameS = 'Dateiname zu lang'; - AbTarBadLinkNameS = 'Linkname zu lang'; - AbTarBadOpS = 'Nicht unterstützte Operation'; - - AbUnhandledEntityS = 'Nicht behandelte Entität'; - - { pre-defined "operating system" (really more FILE system) identifiers for the - Gzip header } - AbGzOsFat = 'FAT Datei-System (MS-DOS, OS/2, NT/Win32)'; - AbGzOsAmiga = 'Amiga'; - AbGzOsVMS = 'VMS (oder OpenVMS)'; - AbGzOsUnix = 'Unix'; - AbGzOsVM_CMS = 'VM/CMS'; - AbGzOsAtari = 'Atari TOS'; - AbGzOsHPFS = 'HPFS Datei-System (OS/2, NT)'; - AbGzOsMacintosh = 'Macintosh'; - AbGzOsZ_System = 'Z-System'; - AbGzOsCP_M = 'CP/M'; - AbGzOsTOPS_20 = 'TOPS-20'; - AbGzOsNTFS = 'NTFS Datei-System (NT)'; - AbGzOsQDOS = 'QDOS'; - AbGzOsAcornRISCOS = 'Acorn RISCOS'; - AbGzOsVFAT = 'VFAT Datei-System (Win95, NT)'; - AbGzOsMVS = 'MVS'; - AbGzOsBeOS = 'BeOS (BeBox oder PowerMac)'; - AbGzOsTandem = 'Tandem/NSK'; - AbGzOsTHEOS = 'THEOS'; - AbGzOsunknown = 'unkekannt'; - AbGzOsUndefined = 'ID ist Gzip nicht bekannt'; - -{!!.03 - Moved from AbCompnd.inc } -{ Compound File specific error messages } -resourcestring - AbCmpndIndexOutOfBounds = 'Index außerhalb des zulässigen Bereichs'; - AbCmpndBusyUpdating = 'Verbindungsdatei wird aktualisiert'; - AbCmpndInvalidFile = 'Ungültige Verbindungsdatei'; - AbCmpndFileNotFound = 'Datei/Verzeichnis nicht gefunden'; - AbCmpndFolderNotEmpty = 'Verzeichnis ist nicht leer'; - AbCmpndExceedsMaxFileSize = 'Dateigröße überschreitet das erlaubte Maximum'; -{!!.03 - End Moved } - - - -implementation - -end. diff --git a/components/Abbrevia/localization/AbResString.pas.fr b/components/Abbrevia/localization/AbResString.pas.fr deleted file mode 100644 index ca1eaea..0000000 --- a/components/Abbrevia/localization/AbResString.pas.fr +++ /dev/null @@ -1,247 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Hichem BOUKSANI, John Riche, Roman Kassebaum - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbResString.pas *} -{*********************************************************} -{* Abbrevia: Resource strings *} -{*********************************************************} -unit AbResString; - -interface - -resourcestring - AbErrZipInvalidS = 'Fichier non valide - N''est pas un fichier PKZip'; - AbZipVersionNeededS = 'Impossible d''extraire le fichier - nouvelle version requise'; - AbUnknownCompressionMethodS = 'Impossible d''extraire le fichier - méthode de compression non supportée'; - AbNoExtractionMethodS = 'Impossible d''extraire le fichier - aucun support d''extraction fourni'; - AbInvalidPasswordS = 'Impossible d''extraire le fichier - Mot de passe incorrect'; - AbNoInsertionMethodS = 'Imossible d''insérer le fichier - aucun support d''insertion fourni'; - AbInvalidFactorS = 'Facteur de réduction Invalide'; - AbDuplicateNameS = 'Impossible d''insérer le fichier - Nom du fichier existe en double'; - AbUnsupportedCompressionMethodS = 'Impossible d''insérer le fichier - méthode de compression non suppotée'; - AbUserAbortS = 'Processus abandonné par l''utilisateur'; - AbArchiveBusyS = 'Archivage en cours - ne peut traiter de nouvelles demandes'; - AbLastDiskRequestS = 'Insérer la dernière disquette du jeu multi-disquettes'; - AbDiskRequestS = 'Insérer une disquette'; - AbImageRequestS = 'Nom du fichier image'; - AbBadSpanStreamS = 'Archives multi-disquettes doivent être ouvertes comme fichiers de flux'; - AbDiskNumRequestS = 'Insérer la disquette %d du jeu multi-disquettes'; - AbImageNumRequestS = 'Insérer la disquette %d du jeu multi-disquettes'; - AbNoOverwriteSpanStreamS = 'Impossible de mettre à jour un jeu multi-disquettes existant'; - AbNoSpannedSelfExtractS = 'Impossible de créer un fichier auto-extractible à partir d''une archive multi-disquettes'; - AbBlankDiskS = 'Insérer une disquette vierge'; - AbStreamFullS = 'Erreur d''écriture du flux'; - AbNoSuchDirectoryS = 'Dossier inexistant'; - AbInflateBlockErrorS = 'Décompression du bloc impossible'; - AbBadStreamTypeS = 'Flux Invalide'; - AbTruncateErrorS = 'Erreur de troncage du fichier ZIP'; - AbZipBadCRCS = 'Echec du contrôle CRC'; - AbZipBadStubS = 'La souche doit être un executable'; - AbFileNotFoundS = 'Fichier inexistant'; - AbInvalidLFHS = 'Entrée de l''entête du fichier local invalide'; - AbNoArchiveS = 'L''archive n''existe pas - Nom de fichier non spécifié'; - AbReadErrorS = 'Erreur de l''ecture de l''archive'; - AbInvalidIndexS = 'L''indice de l''élément de l''archive est invalide'; - AbInvalidThresholdS = 'Le seuil de la taille de l''archive est invalide'; - AbUnhandledFileTypeS = 'Type d''archive non supporté'; - AbSpanningNotSupportedS = 'Multi-disquette non supporté par ce type d''archive'; - AbLogCreateErrorS = 'Erreur de création du fichier log'; - AbMoveFileErrorS = 'Erreur de déplacement du fichier %s vers %s'; - AbFileSizeTooBigS = 'Taille du fichier trop grande pour le type d''archive'; - - AbNoCabinetDllErrorS = 'Impossible de charger cabinet.dll'; - AbFCIFileOpenErrorS = 'FCI impossible d''ouvrir le fichier'; - AbFCIFileReadErrorS = 'FCI impossible de lire le fichier'; - AbFCIFileWriteErrorS = 'FCI Ecriture impossible sur le fichier'; - AbFCIFileCloseErrorS = 'FCI erreur de fermeture du fichier'; - AbFCIFileSeekErrorS = 'FCI Erreur de recherche de fichier'; - AbFCIFileDeleteErrorS = 'FCI erreur de suppression du fichier'; - AbFCIAddFileErrorS = 'FCI impossible d''ajouter le fichier'; - AbFCICreateErrorS = 'FCI impossible de créer le contexte'; - AbFCIFlushCabinetErrorS = 'FCI impossible de vider le cabinet'; - AbFCIFlushFolderErrorS = 'FCI Impossible de vider le dossier'; - AbFDICopyErrorS = 'FDI impossible d''enumérer les fichiers'; - AbFDICreateErrorS = 'FDI impossible de créer le contexte'; - AbInvalidCabTemplateS = 'Modèle du fichier CAB invalide'; - AbInvalidCabFileS = 'Fichier invalide - n''est pas un fichier cabinet'; - - AbZipStored = 'Stocké'; - AbZipShrunk = 'Compacté'; - AbZipReduced = 'Réduit'; - AbZipImploded = 'Implosé'; - AbZipTokenized = 'Divisé en plusieurs parties'; - AbZipDeflated = 'Déflation'; - AbZipDeflate64 = 'Déflation améliorée'; - AbZipDCLImploded = 'DCL Implosé'; - AbZipBzip2 = 'Bzip2'; - AbZipLZMA = 'LZMA'; - AbZipIBMTerse = 'IBM Terse'; - AbZipLZ77 = 'IBM LZ77'; - AbZipJPEG = 'JPEG'; - AbZipWavPack = 'WavPack'; - AbZipPPMd = 'PPMd'; - AbZipUnknown = 'Inconnu (%d)'; - AbZipBestMethod = 'Meilleure Méthode'; - - AbVersionFormatS = 'Version %s'; - AbCompressedSizeFormatS = 'Taille compressée: %d'; - AbUncompressedSizeFormatS = 'Taille non compressée: %d'; - AbCompressionMethodFormatS = 'Méthode de compression: %s'; - AbCompressionRatioFormatS = 'Ratio de compression: %2.0f%%'; - AbCRCFormatS = 'CRC: %x'; - AbReadOnlyS = 'r'; - AbHiddenS = 'h'; - AbSystemS = 's'; - AbArchivedS = 'a'; - AbEFAFormatS = 'Attribut du fichier externe: %s'; - AbIFAFormatS = 'Type du fichier: %s'; - AbTextS = 'Text'; - AbBinaryS = 'Binaire'; - AbEncryptionFormatS = 'Crypté: %s'; - AbEncryptedS = 'Crypté'; - AbNotEncryptedS = 'Non crypté'; - AbUnknownS = 'Inconnu'; - AbTimeStampFormatS = 'Heure: %s'; - AbMadeByFormatS = 'Version utilisée: %f'; - AbNeededFormatS = 'Version d''extraction: %f'; - AbCommentFormatS = 'Commentaire: %s'; - AbDefaultExtS = '*.zip'; - AbFilterS = 'Archives PKZip (*.zip)|*.zip|Archives Auto extractibles (*.exe)|*.exe|Tous les fichiers (*.*)|*.*'; - AbFileNameTitleS = 'Sélectionner un fichier'; - - AbOKS = 'OK'; - AbCancelS = 'Annuler'; - AbSelectDirectoryS = 'Sélectionner un Dossier'; - - AbEnterPasswordS = 'Saisir Mot de passe'; - AbPasswordS = '&Mot de passe'; - AbVerifyS = '&Vérifier'; - - AbCabExtS = '*.cab'; - AbCabFilterS = 'Archives Cabinet (*.cab)|*.CAB|Tous les fichiers (*.*)|*.*'; - AbLogExtS = '*.txt'; - AbLogFilterS = 'Fichiers Text (*.txt)|*.TXT|Tous les fichiers (*.*)|*.*'; - AbExeExtS = '*.exe'; - AbExeFilterS = 'Fichiers Zip auto-extractibles (*.exe)|*.EXE|Tous les fichiers (*.*)|*.*'; - - AbVMSReadTooManyBytesS = VMS: Tentative de l''ecture de trop d''octets [%d]'; - AbVMSInvalidOriginS = 'VMS: Origine invalide %d, doit être 0, 1, 2'; - AbVMSErrorOpenSwapS = 'VMS: Impossible d''ouvrir le fichier d''échange %s'; - AbVMSSeekFailS = 'VMS: Impossible de se déplacer dans le fichier d''échange %s'; - AbVMSReadFailS = 'VMS: impossible de lire %d octets du fichier d''échange %s'; - AbVMSWriteFailS = 'VMS: impossible d''écrire %d octets dans le fichier d''échange %s'; - AbVMSWriteTooManyBytesS = 'VMS: tentative d''écrire trop d''octets [%d]'; - - AbBBSReadTooManyBytesS = 'BBS: tentative de lecture de trop d''octets [%d]'; - AbBBSSeekOutsideBufferS = 'BBS: la nouvelle position est en dehors du buffer'; - AbBBSInvalidOriginS = 'BBS: Valeur d''origine invalide'; - AbBBSWriteTooManyBytesS = 'BBS: tentative d''écrire de trop d''octets [%d]'; - - AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Pas à la fin du flux'; - AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: échec de recherche'; - AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: échec d''écriture'; - AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Origine incorrecte'; - AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Nouvelle position incorrecte'; - - AbItemNameHeadingS = 'Nom'; - AbPackedHeadingS = 'Compressé'; - AbMethodHeadingS = 'Méthode'; - AbRatioHeadingS = 'Ratio (%)'; - AbCRCHeadingS = 'CRC32'; - AbFileAttrHeadingS = 'Attribut'; - AbFileFormatHeadingS = 'Format'; - AbEncryptionHeadingS = 'Crypté'; - AbTimeStampHeadingS = 'Heure'; - AbFileSizeHeadingS = 'Taille'; - AbVersionMadeHeadingS = 'Version Utilisée'; - AbVersionNeededHeadingS = 'Version nécessaire'; - AbPathHeadingS = 'Chemin'; - AbPartialHeadingS = 'Partiel'; - AbExecutableHeadingS = 'Exécutable'; - - AbCabMethod0S = 'Aucune'; - AbCabMethod1S = 'MSZip'; - - AbLtAddS = ' Ajouté '; - AbLtDeleteS = ' Supprimé '; - AbLtExtractS = ' Extrait '; - AbLtFreshenS = ' Rafraichir '; - AbLtMoveS = ' Déplacé '; - AbLtReplaceS = ' Remplacé '; - AbLtStartS = ' Connexion '; - - AbGzipInvalidS = 'Gzip Invalide'; - AbGzipBadCRCS = 'Mauvais CRC'; - AbGzipBadFileSizeS = 'Taille du fichier erronée'; - - AbTarInvalidS = 'Tar invalide'; - AbTarBadFileNameS = 'Nom de fichier trop long'; - AbTarBadLinkNameS = 'Chemin du lien symbolique trop long'; - AbTarBadOpS = 'Opération non supportée'; - - AbUnhandledEntityS = 'Entité non prise en charge'; - - { pre-defined "operating system" (really more FILE system) identifiers for the - Gzip header } - AbGzOsFat = 'Système de fichier FAT (MS-DOS, OS/2, NT/Win32)'; - AbGzOsAmiga = 'Amiga'; - AbGzOsVMS = 'VMS (ou OpenVMS)'; - AbGzOsUnix = 'Unix'; - AbGzOsVM_CMS = 'VM/CMS'; - AbGzOsAtari = 'Atari TOS'; - AbGzOsHPFS = 'Système de fichier HPFS (OS/2, NT)'; - AbGzOsMacintosh = 'Macintosh'; - AbGzOsZ_System = 'Z-System'; - AbGzOsCP_M = 'CP/M'; - AbGzOsTOPS_20 = 'TOPS-20'; - AbGzOsNTFS = 'Système de fichier NTFS (NT)'; - AbGzOsQDOS = 'QDOS'; - AbGzOsAcornRISCOS = 'Acorn RISCOS'; - AbGzOsVFAT = 'Système de fichier VFAT (Win95, NT)'; - AbGzOsMVS = 'MVS'; - AbGzOsBeOS = 'BeOS (BeBox ou PowerMac)'; - AbGzOsTandem = 'Tandem/NSK'; - AbGzOsTHEOS = 'THEOS'; - AbGzOsunknown = 'Inconnu'; - AbGzOsUndefined = 'ID non défini par gzip'; - -{!!.03 - Moved from AbCompnd.inc } -{ Compound File specific error messages } -resourcestring - AbCmpndIndexOutOfBounds = 'Indice hors limite'; - AbCmpndBusyUpdating = 'Fichier composé est occupé par la mise à jour'; - AbCmpndInvalidFile = 'Fichier composé invalide'; - AbCmpndFileNotFound = 'Fichier/Dossier introuvable'; - AbCmpndFolderNotEmpty = 'Dossier n''est pas vide'; - AbCmpndExceedsMaxFileSize = 'Taille du fichier dépasse la limite maximale'; -{!!.03 - End Moved } - - - -implementation - -end. diff --git a/components/Abbrevia/localization/AbResString.pas.nl b/components/Abbrevia/localization/AbResString.pas.nl deleted file mode 100644 index d29b010..0000000 --- a/components/Abbrevia/localization/AbResString.pas.nl +++ /dev/null @@ -1,252 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Rudy Velthuis - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbResString.pas 3.05 *} -{*********************************************************} -{* Abbrevia: Resource strings, Dutch localization *} -{*********************************************************} -unit AbResString; - -interface - -resourcestring - AbErrZipInvalidS = 'Ongeldig bestand - geen PKZip bestand'; - AbZipVersionNeededS = 'Kan bestand niet ontpakken - nieuwere versie nodig'; - AbUnknownCompressionMethodS = 'Kan bestand niet ontpakken - niet ondersteunde compressiemethode'; - AbNoExtractionMethodS = 'Kan bestand niet ontpakken - ontpakken wordt niet ondersteund'; - AbInvalidPasswordS = 'Kan bestand niet ontpakken - ongeldig paswoord'; - AbNoInsertionMethodS = 'Kan bestand niet invoegen - invoegen wordt niet ondersteund'; - AbInvalidFactorS = 'Ongeldige reductiefactor'; - AbDuplicateNameS = 'Kan het bestand niet invoegen - dupliceert opgeslagen naam'; - AbUnsupportedCompressionMethodS = 'Kan het bestand niet invoegen - niet ondersteunde compressiemethode'; - AbUserAbortS = 'Proces werd door gebruiker afgebroken'; - AbArchiveBusyS = 'Archief is bezig - kan nieuwe aanvraag niet bewerken'; - AbLastDiskRequestS = 'Plaats laatste diskette van opgesplitst archief'; - AbDiskRequestS = 'Plaats diskette'; - AbImageRequestS = 'Bestandsnaam afbeelding'; - AbBadSpanStreamS = 'Opgesplitste archieven moeten als bestandsstroom geopend worden'; - AbDiskNumRequestS = 'Plaats diskette %d van opgesplitst archief'; - AbImageNumRequestS = 'Plaats segment %d van opgesplitst archief'; - AbNoOverwriteSpanStreamS = 'Kan bestaand opgesplitst archief niet veranderen'; - AbNoSpannedSelfExtractS = 'Kan geen zelfontpakkend opgesplitst archief aanmaken'; - AbBlankDiskS = 'Plaats een lege diskette'; - AbStreamFullS = 'Schrijffout stroom'; - AbNoSuchDirectoryS = 'Directory bestaat niet'; - AbInflateBlockErrorS = 'Kan blok niet ontpakken'; - AbBadStreamTypeS = 'Ongeldige stroom'; - AbTruncateErrorS = 'Fout bij het afknotten van het zip bestand'; - AbZipBadCRCS = 'Mislukte CRC controle'; - AbZipBadStubS = 'Stomp moet uitvoerbaar bestand zijn'; - AbFileNotFoundS = 'Bestand niet gevonden'; - AbInvalidLFHS = 'Ongeldig Local File Header element'; - AbNoArchiveS = 'Archief bestaat niet - lege bestandsnaam'; - AbReadErrorS = 'Fout tijdens lezen van archief'; - AbInvalidIndexS = 'Ongeldige index van archiefelement'; - AbInvalidThresholdS = 'Ongeldige drempel van archiefgrootte'; - AbUnhandledFileTypeS = 'Onbekend archieftype'; - AbSpanningNotSupportedS = 'Opsplitsen wordt voor dit archieftype niet ondersteund'; - AbLogCreateErrorS = 'Fout tijdens aanmaken van protocolbestand'; - AbMoveFileErrorS = 'Fout tijdens het verplaatsen van bestand %s naar %s'; - AbFileSizeTooBigS = 'Bestand is te groot voor dit archieftype'; - - AbNoCabinetDllErrorS = 'Kan bestand cabinet.dll niet laden'; - AbFCIFileOpenErrorS = 'FCI kan bestand niet openen'; - AbFCIFileReadErrorS = 'FCI kan bestand niet lezen'; - AbFCIFileWriteErrorS = 'FCI kan bestand niet schrijven'; - AbFCIFileCloseErrorS = 'FCI fout tijdens sluiten van bestand'; - AbFCIFileSeekErrorS = 'FCI fout tijdens positioneren in bestand'; - AbFCIFileDeleteErrorS = 'FCI fout tijdens wissen van bestand'; - AbFCIAddFileErrorS = 'FCI kan bestand niet toevoegen'; - AbFCICreateErrorS = 'FCI kan context niet aanmaken'; - AbFCIFlushCabinetErrorS = 'FCI kan cabinet niet legen'; - AbFCIFlushFolderErrorS = 'FCI kan folder niet legen'; - AbFDICopyErrorS = 'FDI kann bestanden niet opsommen'; - AbFDICreateErrorS = 'FDI kan context niet aanmaken'; - AbInvalidCabTemplateS = 'Ongeldige sjabloon voor cabinetsbestand'; - AbInvalidCabFileS = 'Ongeldig bestand - geen cabinetsbestand'; - - AbZipStored = 'Opgeslagen'; - AbZipShrunk = 'Gekrompen'; - AbZipReduced = 'Gereduceerd'; - AbZipImploded = 'Geïmplodeerd'; - AbZipTokenized = 'In symbolen gepakt'; - AbZipDeflated = 'Gedeflationeerd'; - AbZipDeflate64 = 'Uitgebreid gedeflationeerd'; - AbZipDCLImploded = 'DCL geïmplodeerd'; - AbZipBzip2 = 'Bzip2'; - AbZipLZMA = 'LZMA'; - AbZipIBMTerse = 'IBM Terse'; - AbZipLZ77 = 'IBM LZ77'; - AbZipJPEG = 'JPEG'; - AbZipWavPack = 'WavPack'; - AbZipPPMd = 'PPMd'; - AbZipUnknown = 'Onbekend (%d)'; - AbZipBestMethod = 'Beste methode'; - - AbVersionFormatS = 'Versie %s'; - AbCompressedSizeFormatS = 'Gecomprimeerde grootte: %d'; - AbUncompressedSizeFormatS = 'Ongecomprimeerde grootte: %d'; - AbCompressionMethodFormatS = 'Compressiemethode: %s'; - AbCompressionRatioFormatS = 'Compressieverhouding: %2.0f%%'; - AbCRCFormatS = 'CRC: %x'; - AbReadOnlyS = 'r'; - AbHiddenS = 'h'; - AbSystemS = 's'; - AbArchivedS = 'a'; - AbEFAFormatS = 'Externe bestandsattributen: %s'; - AbIFAFormatS = 'Bestandstype: %s'; - AbTextS = 'Tekst'; - AbBinaryS = 'Binair'; - AbEncryptionFormatS = 'Versleuteling: %s'; - AbEncryptedS = 'Versleuteld'; - AbNotEncryptedS = 'Niet versleuteld'; - AbUnknownS = 'Onbekend'; - AbTimeStampFormatS = 'Tijdstempel: %s'; - AbMadeByFormatS = 'Gemaakt met versie: %f'; - AbNeededFormatS = 'Versie benodigd voor ontpakken: %f'; - AbCommentFormatS = 'Opmerking: %s'; - AbDefaultExtS = '*.zip'; - AbFilterS = 'PKZip Archieven (*.zip)|*.zip|Zelfontpakkende Archieven (*.exe)|*.exe|Alle Bestanden (*.*)|*.*'; - AbFileNameTitleS = 'Bestandsnaam Kiezen'; - - AbOKS = 'OK'; - AbCancelS = 'Verlaten'; - AbSelectDirectoryS = 'Bestand kiezen'; - - AbEnterPasswordS = 'Paswoord ingeven'; - AbPasswordS = '&Paswoord'; - AbVerifyS = '&Verificeren'; - - AbCabExtS = '*.cab'; - AbCabFilterS = 'Cabinetsarchieven (*.cab)|*.CAB|Alle Bestanden (*.*)|*.*'; - AbLogExtS = '*.txt'; - AbLogFilterS = 'Tekstbestanden (*.txt)|*.TXT|Alle Bestanden (*.*)|*.*'; - AbExeExtS = '*.exe'; - AbExeFilterS = 'Zelfontpakkende Zip Bestanden (*.exe)|*.EXE|Alle Bestanden (*.*)|*.*'; - - AbVMSReadTooManyBytesS = 'VMS: Anvraag om te veel byte [%d] te lezen'; - AbVMSInvalidOriginS = 'VMS: Ongeldige oorsprong %d, moet 0, 1 of 2 zijn'; - AbVMSErrorOpenSwapS = 'VMS: Kan wisselbestand %s niet openen'; - AbVMSSeekFailS = 'VMS: Kon niet in wisselbestand %s positioneren'; - AbVMSReadFailS = 'VMS: Kon %d byte in wisselbestand %s niet lezen'; - AbVMSWriteFailS = 'VMS: Kon %d byte niet in wisselbestand %s schrijven'; - AbVMSWriteTooManyBytesS = 'VMS: Anvraag om te veel byte [%d] te schrijven'; - - AbBBSReadTooManyBytesS = 'BBS: Anvraag om te veel byte [%d] te lezen'; - AbBBSSeekOutsideBufferS = 'BBS: Nieuwe positie is buiten de buffer'; - AbBBSInvalidOriginS = 'BBS: Ongeldige oorsprongswaarde'; - AbBBSWriteTooManyBytesS = 'BBS: Anvraag om te veel byte [%d] te schrijven'; - - AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Niet aan eind van stroom'; - AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: Positioneren mislukt'; - AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: Schrijven mislukt'; - AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Ongeldige oorsprong'; - AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Ongeldige nieuwe positie'; - - AbItemNameHeadingS = 'Naam'; - AbPackedHeadingS = 'Gepakt'; - AbMethodHeadingS = 'Methode'; - AbRatioHeadingS = 'Besparing (%)'; - AbCRCHeadingS = 'CRC32'; - AbFileAttrHeadingS = 'Attribuut'; - AbFileFormatHeadingS = 'Formaat'; - AbEncryptionHeadingS = 'Versleuteld'; - AbTimeStampHeadingS = 'Tijdstempel'; - AbFileSizeHeadingS = 'Grootte'; - AbVersionMadeHeadingS = 'Gebruikte versie'; - AbVersionNeededHeadingS = 'Benodigde versie'; - AbPathHeadingS = 'Pad'; - AbPartialHeadingS = 'Partieel'; - AbExecutableHeadingS = 'Uitvoerbaar'; - - AbCabMethod0S = 'Geen'; - AbCabMethod1S = 'MSZip'; - - AbLtAddS = ' toegevoegd '; - AbLtDeleteS = ' gewist '; - AbLtExtractS = ' ontpakt '; - AbLtFreshenS = ' geactualiseerd '; - AbLtMoveS = ' verplaatst '; - AbLtReplaceS = ' vervangen '; - AbLtStartS = ' geprotocolleerd '; - - AbGzipInvalidS = 'Ongeldige Gzip'; - AbGzipBadCRCS = 'Ongeldige CRC'; - AbGzipBadFileSizeS = 'Ongeldige bestandsgrootte'; - - AbTarInvalidS = 'Ongeldige Tar'; - - AbTarBadFileNameS = 'Bestandsnaam te lang'; - - AbTarBadLinkNameS = 'Link naam te lang'; - - AbTarBadOpS = 'Niet ondersteunde functie'; - - - - AbUnhandledEntityS = 'Niet behandelde entiteit'; - - { pre-defined "operating system" (really more FILE system) identifiers for the - Gzip header } - AbGzOsFat = 'FAT Bestandssysteem (MS-DOS, OS/2, NT/Win32)'; - AbGzOsAmiga = 'Amiga'; - AbGzOsVMS = 'VMS (oder OpenVMS)'; - AbGzOsUnix = 'Unix'; - AbGzOsVM_CMS = 'VM/CMS'; - AbGzOsAtari = 'Atari TOS'; - AbGzOsHPFS = 'HPFS Bestandssysteem (OS/2, NT)'; - AbGzOsMacintosh = 'Macintosh'; - AbGzOsZ_System = 'Z-System'; - AbGzOsCP_M = 'CP/M'; - AbGzOsTOPS_20 = 'TOPS-20'; - AbGzOsNTFS = 'NTFS Bestandssysteem (NT)'; - AbGzOsQDOS = 'QDOS'; - AbGzOsAcornRISCOS = 'Acorn RISC OS'; - AbGzOsVFAT = 'VFAT Bestandssysteem (Win95, NT)'; - AbGzOsMVS = 'MVS'; - AbGzOsBeOS = 'BeOS (BeBox of PowerMac)'; - AbGzOsTandem = 'Tandem/NSK'; - AbGzOsTHEOS = 'THEOS'; - AbGzOsunknown = 'onbekend'; - AbGzOsUndefined = 'ID is Gzip niet bekend'; - -{!!.03 - Moved from AbCompnd.inc } -{ Compound File specific error messages } -resourcestring - AbCmpndIndexOutOfBounds = 'Index niet in toegelaten bereik'; - AbCmpndBusyUpdating = 'Samengesteld bestand wordt geactualiseerd'; - AbCmpndInvalidFile = 'Ongeldig samengesteld bestand '; - AbCmpndFileNotFound = 'Bestand/directory niet gevonden'; - AbCmpndFolderNotEmpty = 'Directory is niet leeg'; - AbCmpndExceedsMaxFileSize = 'Bestandsgrootte overschrijdt toegelaten maximum'; -{!!.03 - End Moved } - - - -implementation - -end. diff --git a/components/Abbrevia/localization/AbResString.pas.ru b/components/Abbrevia/localization/AbResString.pas.ru deleted file mode 100644 index 8f46a17..0000000 --- a/components/Abbrevia/localization/AbResString.pas.ru +++ /dev/null @@ -1,251 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Pavel Koptev, Roman Kassebaum - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbResString.pas *} -{*********************************************************} -{* Abbrevia: Resource strings, Russian localization *} -{*********************************************************} -{* Warning: This file is UTF-8 encoded *} -{*********************************************************} -{* You need D2009 or higher to compile this unit *} -{*********************************************************} -unit AbResString; - -interface - -resourcestring - AbErrZipInvalidS = 'Формат архива не ÑоответÑтвует PKZip-формату'; - AbZipVersionNeededS = 'ДейÑтвие невозможно. Файл запакован более новой верÑией программы'; - AbUnknownCompressionMethodS = 'ДейÑтвие невозможно. ÐераÑпознанный метод ÑжатиÑ'; - AbNoExtractionMethodS = 'ДейÑтвие невозможно. Ðе доÑтупен метод раÑпаковки архива'; - AbInvalidPasswordS = 'ДейÑтвие невозможно. Ðеверный пароль'; - AbNoInsertionMethodS = 'ДейÑтвие невозможно. Ðрхивом не поддерживаетÑÑ Ð´Ð¾Ð±Ð°Ð²Ð»ÐµÐ½Ð¸Ðµ новых файлов'; - AbInvalidFactorS = 'ÐедейÑтвительный фактор ÑжатиÑ'; - AbDuplicateNameS = 'ДейÑтвие невозможно. Файл Ñ Ñ‚Ð°ÐºÐ¸Ð¼ именем в архиве уже приÑутÑтвует'; - AbUnsupportedCompressionMethodS = 'ДейÑтвие невозможно. Ðеподдерживаемый метод ÑжатиÑ'; - AbUserAbortS = 'ДейÑтвие отменено пользователем'; - AbArchiveBusyS = 'ДейÑтвие невозможно. Ðрхив поврежден'; - AbLastDiskRequestS = 'Ð’Ñтавьте поÑледнюю диÑкету в диÑковод'; - AbDiskRequestS = 'Ð’Ñтавьте диÑкету в диÑковод'; - AbImageRequestS = 'Ð˜Ð¼Ñ Ð¾Ð±Ñ€Ð°Ð·Ð°'; - AbBadSpanStreamS = 'Многотомные архивы открываютÑÑ ÐºÐ°Ðº файловый поток'; - AbDiskNumRequestS = 'Ð’Ñтавьте %d диÑкету в диÑковод'; - AbImageNumRequestS = 'Укажите раÑположение %d тома архива'; - AbNoOverwriteSpanStreamS = 'Ðевозможно изменить ÑущеÑтвующий многотомный архив'; - AbNoSpannedSelfExtractS = 'Ðевозможно Ñоздать многотомный SFX-Ðрхив'; - AbBlankDiskS = 'Ð’Ñтавьте чиÑтую диÑкету в диÑковод'; - AbStreamFullS = 'Ошибка запиÑи в памÑÑ‚ÑŒ'; - AbNoSuchDirectoryS = 'Папка не ÑущеÑтвует'; - AbInflateBlockErrorS = 'Блок данных не может быть раÑпакован'; - AbBadStreamTypeS = 'ÐедейÑтвительный поток'; - AbTruncateErrorS = 'Ошибка при разделении Zip-Файла'; - AbZipBadCRCS = 'Ðе Ð²ÐµÑ€Ð½Ð°Ñ ÐºÐ¾Ð½Ñ‚Ñ€Ð¾Ð»ÑŒÐ½Ð°Ñ Ñумма'; - AbZipBadStubS = 'Корневой Ñлемент архива должен быть иÑполнÑемым файлом'; - AbFileNotFoundS = 'Файл не найден'; - AbInvalidLFHS = 'Ðеверное начало файла'; - AbNoArchiveS = 'Ðрхив не ÑущеÑтвует'; - AbReadErrorS = 'Ошибка Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð°Ñ€Ñ…Ð¸Ð²Ð°'; - AbInvalidIndexS = 'Ðеверный Ð¸Ð½Ð´ÐµÐºÑ ÐµÐ»ÐµÐ¼ÐµÐ½Ñ‚Ð° архива'; - AbInvalidThresholdS = 'Ðеверный размер чаÑтей архива'; - AbUnhandledFileTypeS = 'ÐеизвеÑтный архив'; - AbSpanningNotSupportedS = 'МноготомноÑÑ‚ÑŒ не поддерживаетÑÑ Ñтим типом архивов'; - AbLogCreateErrorS = 'Ошибка при Ñоздании файла протокола'; - AbMoveFileErrorS = 'Ошибка при перемещении файла %s в %s'; - AbFileSizeTooBigS = 'Файл Ñлишком велик Ð´Ð»Ñ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð¾Ð³Ð¾ типа архива'; - - AbNoCabinetDllErrorS = 'Библиотека cabinet.dll не может быть загружена'; - AbFCIFileOpenErrorS = 'FCI невозможно открыть файл'; - AbFCIFileReadErrorS = 'FCI невозможно прочитать файл'; - AbFCIFileWriteErrorS = 'FCI невозможно запиÑать файл'; - AbFCIFileCloseErrorS = 'FCI ошибка при закрытии файла'; - AbFCIFileSeekErrorS = 'FCI ошибка при поиÑке в файле'; - AbFCIFileDeleteErrorS = 'FCI ошибка при удалении файла'; - AbFCIAddFileErrorS = 'FCI невозможно добавить файл'; - AbFCICreateErrorS = 'FCI ошибка ÑозданиÑ'; - AbFCIFlushCabinetErrorS = 'FCI Cabinet-архив не может быть Ñоздан'; - AbFCIFlushFolderErrorS = 'FCI невозможно удалить вÑе файлы из папки'; - AbFDICopyErrorS = 'FDI невозможно переÑчитать файлы'; - AbFDICreateErrorS = 'FDI ошибка ÑозданиÑ'; - AbInvalidCabTemplateS = 'Ðеверный шаблон Cabinet-файла'; - AbInvalidCabFileS = ' Ðеверный Cabinet-файл'; - - AbZipStored = 'Сохранено'; - AbZipShrunk = 'Сжато'; - AbZipReduced = 'Сжато'; - AbZipImploded = 'Сжато'; - AbZipTokenized = 'Разделен на чаÑти'; - AbZipDeflated = 'Сжато'; - AbZipDeflate64 = 'Лучшее Ñжатие'; - AbZipDCLImploded = 'DCL Сжато'; - AbZipBzip2 = 'Bzip2'; - AbZipLZMA = 'LZMA'; - AbZipIBMTerse = 'IBM Terse'; - AbZipLZ77 = 'IBM LZ77'; - AbZipJPEG = 'JPEG'; - AbZipWavPack = 'WavPack'; - AbZipPPMd = 'PPMd'; - AbZipUnknown = 'ÐеизвеÑтно (%d)'; - AbZipBestMethod = 'Лучший метод'; - - AbVersionFormatS = 'ВерÑÐ¸Ñ %s'; - AbCompressedSizeFormatS = 'Размер в архиве: %d'; - AbUncompressedSizeFormatS = 'Размер: %d'; - AbCompressionMethodFormatS = 'Метод ÑжатиÑ: %s'; - AbCompressionRatioFormatS = 'Степень ÑжатиÑ: %2.0f%%'; - AbCRCFormatS = 'CRC: %x'; - AbReadOnlyS = 'r'; - AbHiddenS = 'h'; - AbSystemS = 's'; - AbArchivedS = 'a'; - AbEFAFormatS = 'Внешние атрибуты файла: %s'; - AbIFAFormatS = 'Тип файла: %s'; - AbTextS = 'ТекÑÑ‚'; - AbBinaryS = 'Двоичный'; - AbEncryptionFormatS = 'Шифрование: %s'; - AbEncryptedS = 'Зашифрован'; - AbNotEncryptedS = 'Ðе зашифрован'; - AbUnknownS = 'ÐеизвеÑтно'; - AbTimeStampFormatS = 'Формат времени: %s'; - AbMadeByFormatS = 'ВерÑÐ¸Ñ Ð¿Ñ€Ð¾Ð³Ñ€Ð°Ð¼Ð¼Ñ‹ ÑозданиÑ: %f'; - AbNeededFormatS = 'Ð”Ð»Ñ Ñ€Ð°Ñпаковки требуетÑÑ Ð²ÐµÑ€ÑиÑ: %f'; - AbCommentFormatS = 'Комментарии: %s'; - AbDefaultExtS = '*.zip'; - AbFilterS = 'PKZip-архив (*.zip)|*.zip|SFX-Ðрхив (*.exe)|*.exe|Ð’Ñе файлы (*.*)|*.*'; - AbFileNameTitleS = 'Выберите Ð¸Ð¼Ñ Ñ„Ð°Ð¹Ð»Ð°'; - - AbOKS = 'OK'; - AbCancelS = 'Отмена'; - AbSelectDirectoryS = 'Выберете папку'; - - AbEnterPasswordS = 'Введите пароль'; - AbPasswordS = '&Пароль'; - AbVerifyS = '&Проверка'; - - AbCabExtS = '*.cab'; - AbCabFilterS = 'Cabinet-архив (*.cab)|*.CAB|Ð’Ñе файлы (*.*)|*.*'; - AbLogExtS = '*.txt'; - AbLogFilterS = 'ТекÑтовые файлы (*.txt)|*.TXT|Ð’Ñе файлы (*.*)|*.*'; - AbExeExtS = '*.exe'; - AbExeFilterS = 'SFX-архивы (*.exe)|*.EXE|Ð’Ñе файлы (*.*)|*.*'; - - AbVMSReadTooManyBytesS = 'VMS: попытка Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ñлишком большого чиÑла байт [%d]'; - AbVMSInvalidOriginS = 'VMS: недейÑтвительный иÑточник %d, разрешены 0, 1, 2'; - AbVMSErrorOpenSwapS = 'VMS: Ðевозможно открыть файл %s'; - AbVMSSeekFailS = 'VMS: Ðевозможно оÑущеÑтвить поиÑк в файле %s'; - AbVMSReadFailS = 'VMS: Ðевозможно прочитать файл %s'; - AbVMSWriteFailS = 'VMS: Ðевозможно %d байт запиÑать в файл %s'; - AbVMSWriteTooManyBytesS = 'VMS: попытка запиÑи Ñлишком большого чиÑла байт [%d]'; - - AbBBSReadTooManyBytesS = 'BBS: попытка Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ñлишком большого чиÑла байт [%d]'; - AbBBSSeekOutsideBufferS = 'BBS: Ð¿Ð¾Ð·Ð¸Ñ†Ð¸Ñ Ð½Ð°Ñ…Ð¾Ð´Ð¸Ñ‚ÑÑ Ð²Ð½Ðµ буфера'; - AbBBSInvalidOriginS = 'BBS: недейÑтвительно предыдущее значение'; - AbBBSWriteTooManyBytesS = 'BBS: попытка запиÑи Ñлишком большого чиÑла байт [%d]'; - - AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: попытка запиÑи данных не в конец потока'; - AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: поиÑк не удалÑÑ'; - AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: запиÑÑŒ не удалаÑÑŒ'; - AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: ÐедейÑтвительный иÑточник'; - AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: недейÑÑ‚Ð²Ð¸Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ Ð½Ð¾Ð²Ð°Ñ Ð¿Ð¾Ð·Ð¸Ñ†Ð¸Ñ'; - - AbItemNameHeadingS = 'ИмÑ'; - AbPackedHeadingS = 'Сжато'; - AbMethodHeadingS = 'Метод'; - AbRatioHeadingS = 'КоÑффициент ÑÐ¶Ð°Ñ‚Ð¸Ñ (%)'; - AbCRCHeadingS = 'CRC32'; - AbFileAttrHeadingS = 'Ðтрибуты'; - AbFileFormatHeadingS = 'Формат'; - AbEncryptionHeadingS = 'Шифрование'; - AbTimeStampHeadingS = 'ВремÑ'; - AbFileSizeHeadingS = 'Размер'; - AbVersionMadeHeadingS = 'ИÑпользована верÑиÑ'; - AbVersionNeededHeadingS = 'Ðеобходима верÑиÑ'; - AbPathHeadingS = 'Путь'; - AbPartialHeadingS = 'ЧаÑтично'; - AbExecutableHeadingS = 'Выполнимо'; - - AbCabMethod0S = 'нет'; - AbCabMethod1S = 'MSZip'; - - AbLtAddS = ' вÑтавлен '; - AbLtDeleteS = ' удален '; - AbLtExtractS = ' раÑпакован '; - AbLtFreshenS = ' обновлен '; - AbLtMoveS = ' перемещен '; - AbLtReplaceS = ' заменено '; - AbLtStartS = ' запротоколировано '; - - AbGzipInvalidS = 'ÐедейÑтвительный Gzip'; - AbGzipBadCRCS = 'ÐедейÑÑ‚Ð²Ð¸Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ ÐºÐ¾Ð½Ñ‚Ñ€Ð¾Ð»ÑŒÐ½Ð°Ñ Ñумма'; - AbGzipBadFileSizeS = 'ÐедейÑтвительный размер файла'; - - AbTarInvalidS = 'ÐедеÑтвительный Tar-архив'; - AbTarBadFileNameS = 'Слишком длинное Ð¸Ð¼Ñ Ñ„Ð°Ð¹Ð»Ð°'; - AbTarBadLinkNameS = 'Слишком Ð´Ð»Ð¸Ð½Ð½Ð°Ñ ÑÑылка'; - AbTarBadOpS = 'ÐÐµÐ¿Ð¾Ð´Ð´ÐµÑ€Ð¶Ð¸Ð²Ð°ÐµÐ¼Ð°Ñ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ñ'; - - AbUnhandledEntityS = 'Ðеобрабатываемый объект'; - - { pre-defined "operating system" (really more FILE system) identifiers for the - Gzip header } - AbGzOsFat = 'FAT Ñ„Ð°Ð¹Ð»Ð¾Ð²Ð°Ñ ÑиÑтема (MS-DOS, OS/2, NT/Win32)'; - AbGzOsAmiga = 'Amiga'; - AbGzOsVMS = 'VMS (или OpenVMS)'; - AbGzOsUnix = 'Unix'; - AbGzOsVM_CMS = 'VM/CMS'; - AbGzOsAtari = 'Atari TOS'; - AbGzOsHPFS = 'HPFS Ñ„Ð°Ð¹Ð»Ð¾Ð²Ð°Ñ ÑиÑтема (OS/2, NT)'; - AbGzOsMacintosh = 'Macintosh'; - AbGzOsZ_System = 'Z-System'; - AbGzOsCP_M = 'CP/M'; - AbGzOsTOPS_20 = 'TOPS-20'; - AbGzOsNTFS = 'NTFS Ñ„Ð°Ð¹Ð»Ð¾Ð²Ð°Ñ ÑиÑтема (NT)'; - AbGzOsQDOS = 'QDOS'; - AbGzOsAcornRISCOS = 'Acorn RISCOS'; - AbGzOsVFAT = 'VFAT Ñ„Ð°Ð¹Ð»Ð¾Ð²Ð°Ñ ÑиÑтема (Win95, NT)'; - AbGzOsMVS = 'MVS'; - AbGzOsBeOS = 'BeOS (BeBox или PowerMac)'; - AbGzOsTandem = 'Tandem/NSK'; - AbGzOsTHEOS = 'THEOS'; - AbGzOsunknown = 'неизвеÑтно'; - AbGzOsUndefined = 'Идентификационный номер Ð´Ð»Ñ Gzip не извеÑтен'; - -{!!.03 - Moved from AbCompnd.inc } -{ Compound File specific error messages } -resourcestring - AbCmpndIndexOutOfBounds = 'Ð˜Ð½Ð´ÐµÐºÑ Ð²Ñ‹Ñ…Ð¾Ð´Ð¸Ñ‚ за пределы допуÑтимого диапазона'; - AbCmpndBusyUpdating = 'ОбновлÑетÑÑ Ñ„Ð°Ð¹Ð» ÑвÑзок'; - AbCmpndInvalidFile = 'ÐедейÑтвительный файл ÑвÑзок'; - AbCmpndFileNotFound = 'Файл или папка не найдены'; - AbCmpndFolderNotEmpty = 'Папка не пуÑта'; - AbCmpndExceedsMaxFileSize = 'ДопуÑтимый размер файла был превышен'; -{!!.03 - End Moved } - - - -implementation - -end. diff --git a/components/Abbrevia/packages/Lazarus/abbrevia.lpk b/components/Abbrevia/packages/Lazarus/abbrevia.lpk deleted file mode 100644 index 27895bd..0000000 --- a/components/Abbrevia/packages/Lazarus/abbrevia.lpk +++ /dev/null @@ -1,224 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/Abbrevia/packages/Lazarus/abbrevia.lrs b/components/Abbrevia/packages/Lazarus/abbrevia.lrs deleted file mode 100644 index e0afd04..0000000 --- a/components/Abbrevia/packages/Lazarus/abbrevia.lrs +++ /dev/null @@ -1,137 +0,0 @@ -LazarusResources.Add('TAbCabBrowser','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9 - +'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#26'tEXtSoftware'#0'Paint.' - +'NET v3.5.100'#244'r'#161#0#0#0#191'IDATHKc'#248#255#255'?'#3'-1M'#13#7'9'#28 - +#195#2#3#3#131#255#228'b'#6#176'q'#168'!'#130#213#130'={'#246#252''''#5'o' - +#221#186#245#255#130#5#11#128#206#165#129#5'0'#195'I'#182#128#148'`'#2#185 - +#156','#11#254#255#159#9#12'R'#252#248#229#203'^p'#208#12'n'#11#26#26#26#254 - +#159'9S'#3#247#13#136#237#224#224#0#230'S'#197#7'0'#3'A'#134#194#240#138#21 - +'i'#148'['#0'r'#29'1'#152#172'8'#0'i"'#5#147#28#201#200#25#13#148#214#145#211 - +';'#200'0lx4'#163'a'#205'tTI'#166#248'r3U,'#24#205'h('#149#14#168#152#6#165 - +'yR2'#25#201'9'#25#150#177#136#201'\'#200#25#142#168#140'F'#170#203#209#213 - +#19#172#147#169#221#132#1#0#234#199#239's)'#217'6'#230#0#0#0#0'IEND'#174'B`' - +#130 -]); -LazarusResources.Add('TAbCabExtractor','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9 - +'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#26'tEXtSoftware'#0'Paint.' - +'NET v3.5.100'#244'r'#161#0#0#0#244'IDATHK'#205'V'#193#13#195' '#12'd$F`'#154 - +'NQ'#169','#208#1#250#227#201#2#252#24'!'#139'd'#10'7'#135#228#200'%'#165#193 - +'4'#145#242'8%('#228#206'6>'''#134#136#204#153'8'#149#28#129'o'#4#172#181'4' - +#10'S'#232'>+'#242'U '#231'L'#26#164#148'('#132#176#132'{'#130#0#147#171#5'4' - +'eB'#228'C'#2'D'#175#165#164#191'1'#207#207'R'#154'k'#11'x'#239'i'#154#238'k' - +'6'#184'w'#206#149#245'!'#25'0!H'#25'1'#222'6'#2#15'M'#23#225#144#17']'#15 - +#248#12#138#173'*'#145#166#15#240'R'#15'VR&'#151#215#150#147'k'#147#161#215 - +'e'#191#163'c'#24#16#136#13#224#217#223'N'#6#9'j'#15#176#16#175#155#179#8#25 - +#140#24#141#5#228''#249'M>'#251'/'#204#27#232'z'#195#213'h"'#21#11#0#0#0#0 - +'IEND'#174'B`'#130 -]); -LazarusResources.Add('TAbMakeCab','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9'pHYs'#0#0#14#194#0#0#14#194#1#21 - +'(J'#128#0#0#0#26'tEXtSoftware'#0'Paint.NET v3.5.100'#244'r'#161#0#0#0#253'I' - +'DATHK'#205'V'#193#13#131'0'#12#204'H'#25#129#21'X'#162'ST*'#11't'#128#254 - +#242#169#196#2#249'1'#2#139'0'#133#225#140#220'RJ'#192#142#136#218#199'IA' - +#138#238#156#179'/'#193#17#145'+'#137#162#228'('#252'K'#192'{O'#185'pL'#247 - +#233#200#166'@'#215'udA'#140#145'B'#8'S'#185#5#4#132#220',`'#177#9#149'g'#9 - +#16'=&K'#247'1'#12'w'#182#230#191#5#154#166#161#190#191#190'N'#131'uUU'#252 - +'m:'#1#134#192#185#27'O'#16'z '#246#8'!H'#5'm{'#201#21' '#170#235''''#11#160 - +':'#13'v{0W'#157#130#227#6'j'#144'l'#242'L'#222'&@l'#23'f}9'#239' '#219#194 - +'f'#208#196'wx'#255#22#194'z'#238#197#17'LA'#19#1#233#129'6l'#234#28#160'j' - +#144#174#167'h/l'#166'1'#197'M'#248#19#129#211#130#150':'#193'iA['#11'hB'#150 - +#213#3#140#158'&\'#203'='#166#219'T'#130#165#9#215'2p'#170#23#205'Z'#249'z' - +#255#225#155'|'#246'/'#204#8#140'9'#211#158'H'#173't'#157#0#0#0#0'IEND'#174 - +'B`'#130 -]); -LazarusResources.Add('TAbUnzipper','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9 - +'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#26'tEXtSoftware'#0'Paint.' - +'NET v3.5.100'#244'r'#161#0#0#1#2'IDATHK'#213#149#225#17#131' '#12#133#153 - +#160'cv'#130#254'/'#11't'#0#187#140#11#184#136'S'#164#198#220#211''''#2#130 - +#150#222#245'G'#206'V'#200#251#146#16#162#19#17#215#210#154#138'k'#224#255#1 - +'p'#207#155#132#134#178#127'%'#131'"'#128#155#170#149#178'+M0g'#160#194'"o' - +#25#199#215#238#169#239'l'#253'\'#183'-'#128'\'#6'g'#214'6g`'#17'v;'#243#222 - +#137#154#174#247#253'#'#186''''#230#199#25'S'#137'V'#128#247'~'#18'V'#155#150 - +#7#3#232#255'T '#12'AIu'#255'r'#15'B'#199#225'n'#194#12#24':'#3#197'"'#198';' - +#21'o'#6#128'x'#19#128'u_7G_'#5#224#238#225#18'A'#16#162',^'#5#208'sPaXx'#6 - +'a'#228#213#25'('#128'!'#10'`Q'#142#188'I'#137#170'3'#128#3#218#212#250#223 - +#12'g'#144#202#224#176#139#216#17#128'X'#137'R'#7'{'#8'`'#199#220#236'a'#161 - +#212'o'#220#252#205'M.q,'#221#19#5#156#153#152'9'#159#205','#194'h]'#135#28 - +#134#221#181#231'O>'#250#31'Ag'#1'z_'#17'J'#234#0#0#0#0'IEND'#174'B`'#130 -]); -LazarusResources.Add('TAbZipBrowser','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9 - +'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#26'tEXtSoftware'#0'Paint.' - +'NET v3.5.100'#244'r'#161#0#0#0#249'IDATHK'#237#149#221#21#131' '#12#133#153 - +#182#19't'#0#22#232#0'v'#25#23'p'#17#167'H'#137'9'#151'^'#249'S'#244#208#167 - +'>'#228'X'#133#220'/'#9'!u"'#226'F'#218'Pq'#13#252#15'8'#172'@'#220#224'B' - +#181'jv'#167#9'6'#128#10#139#188'e]_'#217'S'#191#217#250#181'n'#139#128'V'#6 - +'W'#214#16#16'e0'#133'o{'#243#222#137#154#2#230#249#153#173#167#251#241#206 - +#25#23#1#222#251' '#172#22#150#23#3#232#187'9'#230#129#240'7'#148'T'#247#199 - +'{'#144':.'#15#19'f'#192'2'#25#168#5'P'#241'a'#0#136#15#1'X'#247'M['#244']'#0 - +#238#30'.'#17#4'!'#202#226']'#0'='#7#21#134#165'g'#144'F'#222#157#129#2#24 - +#162#0#22#229#200#135#148#168';'#3'8'#160'M'#173#255#205'p'#6#181#12#14#187 - +#136#29#1'('#149#168'v'#176#135#0'vl'#205#30#22#170#253#198#205#223#221#228 - +'3'#142'g'#247#20#1'W&f'#203'g7'#139'0Z'#191'C'#14#195#238#222#243''''#127 - +#250#31#238'5'#15#228#129#133#21#144#0#0#0#0'IEND'#174'B`'#130 -]); -LazarusResources.Add('TAbZipKit','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9 - +'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#26'tEXtSoftware'#0'Paint.' - +'NET v3.5.100'#244'r'#161#0#0#1#12'IDATHK'#205'V'#193#13#195' '#12'd'#130#142 - +#217#9#250'/'#11't'#128't'#153','#144'E2'#133#203#197#186#214#16'H'#128#8#169 - +#15#139#4#240#157#207'v'#172'8'#17'q#'#173#25#220#5#15'XmP'#255'C'#192#200 - +#211#21'J'#220#243'&'#169'Qa'#181#130#203#4'. '#148#204#230#187#171#6#0#22'y' - +#203#186#190'v+'#246#244'\'#187#173#155#224'HA'#207'YT'#3#141'p'#218#153#247 - +'N`8'#159#231'G'#246'N'#206'/R'#172#178'c'#2#239'}'#0#134#133#253'E'#9#240'^' - +#10#196#146'0'#165#184#191'a'#231#8#150#187#2'['#130'eR'#162'\'#196#220#3#248 - +'0'#2#130#15'!'#208#238#155#182#232#155#8'l'#247#216#20#17#144#160#22#188#137 - +#0'u'#0'0-'#173'A'#26'y'#179#2#16'X'#18#16'XP'#27#249#144#20'5+'#160#3#219'T' - +#251'_'#141'5()8'#237'"'#235'H'#130'\'#138'J'#133'=%'#176#142'G'#179#199#2 - +#149#158#249#229'G_r'#141'c'#237#157',A'#207#196'<'#242#137'f'#17'G'#235'o' - +#200'q'#216']['#191')'#170#253'C'#232#185#247#1'J'#20#237#127#136#241#166#182 - +#0#0#0#0'IEND'#174'B`'#130 -]); -LazarusResources.Add('TAbZipper','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9 - +'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#26'tEXtSoftware'#0'Paint.' - +'NET v3.5.100'#244'r'#161#0#0#1#5'IDATHK'#205#149#235#13#131'0'#12#132'3m''' - +#232#0'Y'#160#3#208'eX'#128'E'#152#194#205'a]kB'#158'@'#164#254#176#210#146 - +#248'>;6'#198#137#136#27'i'#183#137#187#160#4#139#131#253#127#0'#'#143'Wfr9' - +#131'f'#128#11'''s'#214#210#4#197#26'@X'#228'-'#235#250':'#172'x'#166#251#229 - +'n'#171#2'J'#25#156#217#219#213'@#'#156#14#230#189#19#24#246#231#249#153'<' - +#147#242#179#25'oE'#142#1#222#251' '#12#11#219#139#2#240'?'#23#136#133#240'J' - +'q~'#211'N'#1#150#135#10'['#192'2)('#21'1'#159'A|'#24#128#226'C'#0#218'}'#211 - +#22'}'#23#192'v'#143#189'"'#10'R'#212#138'w'#1'P'#7#8#211#226#26#196#145'wg' - +#0#128#133#0'`Em'#228'C'#174#168';'#3':'#176'M'#181#255#213'X'#131'\'#6#213 - +'.'#178#142#4#164#174'(W'#216'*'#192':'#150'f'#143#21#202#253#230#155#191'{' - +#147'['#28'['#207'$'#1'g&f'#201'g7'#139'8Z'#127'C'#142#195#238#218#250#189 - +#162#218#199#228#202#254#7#213' '#251#233'X:'#182#131#0#0#0#0'IEND'#174'B`' - +#130 -]); diff --git a/components/Abbrevia/packages/Lazarus/abbrevia.pas b/components/Abbrevia/packages/Lazarus/abbrevia.pas deleted file mode 100644 index 8c0f9f5..0000000 --- a/components/Abbrevia/packages/Lazarus/abbrevia.pas +++ /dev/null @@ -1,26 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit Abbrevia; - -interface - -uses - AbArcTyp, AbBase, AbBitBkt, AbBrowse, AbBzip2, AbBzip2Typ, AbCharset, - AbConst, AbDfBase, AbDfCryS, AbDfDec, AbDfEnc, AbDfHufD, AbDfInW, AbDfOutW, - AbDfPkMg, AbDfStrm, AbDfXlat, AbExcept, AbGzTyp, AbReg, AbResString, - AbSelfEx, AbSpanSt, AbSWStm, AbTarTyp, AbUnzOutStm, AbUnzper, AbUnzPrc, - AbUtils, AbVMStrm, AbZBrows, AbZipKit, AbZipper, AbZipPrc, AbZipTyp, - AbZLTyp, LazarusPackageIntf; - -implementation - -procedure Register; -begin - RegisterUnit('AbReg', @AbReg.Register); -end; - -initialization - RegisterPackage('Abbrevia', @Register); -end. diff --git a/components/Abbrevia/source/AbArcTyp.pas b/components/Abbrevia/source/AbArcTyp.pas deleted file mode 100644 index 522b6b1..0000000 --- a/components/Abbrevia/source/AbArcTyp.pas +++ /dev/null @@ -1,2125 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbArcTyp.pas *} -{*********************************************************} -{* ABBREVIA: TABArchive, TABArchiveItem classes *} -{*********************************************************} - -unit AbArcTyp; - -{$I AbDefine.inc} - -interface - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - Classes, - Types, - AbUtils; - -{ ===== TAbArchiveItem ====================================================== } -type - TAbArchiveItem = class(TObject) - protected {private} - NextItem : TAbArchiveItem; - FAction : TAbArchiveAction; - FCompressedSize : Int64; - FCRC32 : Longint; - FDiskFileName : string; - FExternalFileAttributes : LongWord; - FFileName : string; - FIsEncrypted : Boolean; - FLastModFileTime : Word; - FLastModFileDate : Word; - FTagged : Boolean; - FUncompressedSize : Int64; - - protected {property methods} - function GetCompressedSize : Int64; virtual; - function GetCRC32 : Longint; virtual; - function GetDiskPath : string; - function GetExternalFileAttributes : LongWord; virtual; - function GetFileName : string; virtual; - function GetIsDirectory: Boolean; virtual; - function GetIsEncrypted : Boolean; virtual; - function GetLastModFileDate : Word; virtual; - function GetLastModFileTime : Word; virtual; - function GetNativeFileAttributes : LongInt; virtual; - function GetStoredPath : string; - function GetUncompressedSize : Int64; virtual; - procedure SetCompressedSize(const Value : Int64); virtual; - procedure SetCRC32(const Value : Longint); virtual; - procedure SetExternalFileAttributes( Value : LongWord ); virtual; - procedure SetFileName(const Value : string); virtual; - procedure SetIsEncrypted(Value : Boolean); virtual; - procedure SetLastModFileDate(const Value : Word); virtual; - procedure SetLastModFileTime(const Value : Word); virtual; - procedure SetUncompressedSize(const Value : Int64); virtual; - function GetLastModTimeAsDateTime: TDateTime; virtual; - procedure SetLastModTimeAsDateTime(const Value: TDateTime); virtual; - - public {methods} - constructor Create; - destructor Destroy; override; - function MatchesDiskName(const FileMask : string) : Boolean; - function MatchesStoredName(const FileMask : string) : Boolean; - function MatchesStoredNameEx(const FileMask : string) : Boolean; - - - public {properties} - property Action : TAbArchiveAction - read FAction - write FAction; - property CompressedSize : Int64 - read GetCompressedSize - write SetCompressedSize; - property CRC32 : Longint - read GetCRC32 - write SetCRC32; - property DiskFileName : string - read FDiskFileName - write FDiskFileName; - property DiskPath : string - read GetDiskPath; - property ExternalFileAttributes : LongWord - read GetExternalFileAttributes - write SetExternalFileAttributes; - property FileName : string - read GetFileName - write SetFileName; - property IsDirectory: Boolean - read GetIsDirectory; - property IsEncrypted : Boolean - read GetIsEncrypted - write SetIsEncrypted; - property LastModFileDate : Word - read GetLastModFileDate - write SetLastModFileDate; - property LastModFileTime : Word - read GetLastModFileTime - write SetLastModFileTime; - property NativeFileAttributes : LongInt - read GetNativeFileAttributes; - property StoredPath : string - read GetStoredPath; - property Tagged : Boolean - read FTagged - write FTagged; - property UncompressedSize : Int64 - read GetUncompressedSize - write SetUncompressedSize; - - property LastModTimeAsDateTime : TDateTime - read GetLastModTimeAsDateTime - write SetLastModTimeAsDateTime; - end; - - -{ ===== TAbArchiveListEnumerator ============================================ } -type - TAbArchiveList = class; - TAbArchiveListEnumerator = class - private - FIndex: Integer; - FList: TAbArchiveList; - public - constructor Create(aList: TAbArchiveList); - function GetCurrent: TAbArchiveItem; - function MoveNext: Boolean; - property Current: TAbArchiveItem read GetCurrent; - end; - - -{ ===== TAbArchiveList ====================================================== } - - TAbArchiveList = class - protected {private} - FList : TList; - FOwnsItems: Boolean; - HashTable : array[0..1020] of TAbArchiveItem; - protected {methods} - function GenerateHash(const S : string) : LongInt; - function GetCount : Integer; - function Get(Index : Integer) : TAbArchiveItem; - procedure Put(Index : Integer; Item : TAbArchiveItem); - public {methods} - constructor Create(AOwnsItems: Boolean); - destructor Destroy; override; - function Add(Item : Pointer): Integer; - procedure Clear; - procedure Delete(Index : Integer); - function Find(const FN : string) : Integer; - function GetEnumerator: TAbArchiveListEnumerator; - function IsActiveDupe(const FN : string) : Boolean; - public {properties} - property Count : Integer - read GetCount; - property Items[Index : Integer] : TAbArchiveItem - read Get - write Put; default; - end; - - -{ ===== TAbArchive specific types =========================================== } -type - TAbStoreOption = - (soStripDrive, soStripPath, soRemoveDots, soRecurse, soFreshen, soReplace); - TAbStoreOptions = - set of TAbStoreOption; - - TAbExtractOption = - (eoCreateDirs, eoRestorePath); - TAbExtractOptions = - set of TAbExtractOption; - - TAbArchiveStatus = - (asInvalid, asIdle, asBusy); - - TAbArchiveEvent = - procedure(Sender : TObject) of object; - TAbArchiveConfirmEvent = - procedure (Sender : TObject; var Confirm : Boolean) of object; - TAbArchiveProgressEvent = - procedure(Sender : TObject; Progress : Byte; var Abort : Boolean) of object; - TAbArchiveItemEvent = - procedure(Sender : TObject; Item : TAbArchiveItem) of object; - TAbArchiveItemConfirmEvent = - procedure(Sender : TObject; Item : TAbArchiveItem; - ProcessType : TAbProcessType; var Confirm : Boolean) of object; - TAbConfirmOverwriteEvent = - procedure(var Name : string; var Confirm : Boolean) of object; - TAbArchiveItemFailureEvent = - procedure(Sender : TObject; Item : TAbArchiveItem; - ProcessType : TAbProcessType; ErrorClass : TAbErrorClass; - ErrorCode : Integer) of object; - TAbArchiveItemExtractEvent = - procedure(Sender : TObject; Item : TAbArchiveItem; - const NewName : string) of object; - TAbArchiveItemExtractToStreamEvent = - procedure(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream) of object; - TAbArchiveItemTestEvent = - procedure(Sender : TObject; Item : TAbArchiveItem) of object; - TAbArchiveItemInsertEvent = - procedure(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream) of object; - TAbArchiveItemInsertFromStreamEvent = - procedure(Sender : TObject; Item : TAbArchiveItem; - OutStream, InStream : TStream) of object; - TAbArchiveItemProgressEvent = - procedure(Sender : TObject; Item : TAbArchiveItem; Progress : Byte; - var Abort : Boolean) of object; - TAbProgressEvent = - procedure(Progress : Byte; var Abort : Boolean) of object; - TAbRequestDiskEvent = - procedure(Sender : TObject; var Abort : Boolean) of object; - TAbRequestImageEvent = - procedure(Sender : TObject; ImageNumber : Integer; - var ImageName : string; var Abort : Boolean) of object; - TAbRequestNthDiskEvent = - procedure(Sender : TObject; DiskNumber : Byte; var Abort : Boolean) of object; - - -type - TAbArchiveStreamHelper = class - protected - FStream : TStream; - public - constructor Create(AStream : TStream); - procedure ExtractItemData(AStream : TStream); virtual; abstract; - function FindFirstItem : Boolean; virtual; abstract; - function FindNextItem : Boolean; virtual; abstract; - procedure ReadHeader; virtual; abstract; - procedure ReadTail; virtual; abstract; - function SeekItem(Index : Integer): Boolean; virtual; abstract; - procedure WriteArchiveHeader; virtual; abstract; - procedure WriteArchiveItem(AStream : TStream); virtual; abstract; - procedure WriteArchiveTail; virtual; abstract; - function GetItemCount : Integer; virtual; abstract; - end; - - -{ ===== TAbArchive ========================================================== } -type - TAbArchive = class(TObject) - public - FStream : TStream; - FStatus : TAbArchiveStatus; - - protected {property variables} //These break Encapsulation - FArchiveName : string; - FAutoSave : Boolean; - FBaseDirectory : string; - FCurrentItem : TAbArchiveItem; - FDOSMode : Boolean; - FExtractOptions : TAbExtractOptions; - FImageNumber : Word; - FInStream : TStream; - FIsDirty : Boolean; - FSpanningThreshold : Int64; - FItemList : TAbArchiveList; - FLogFile : string; - FLogging : Boolean; - FLogStream : TFileStream; - FMode : Word; - FOwnsStream : Boolean; - FSpanned : Boolean; - FStoreOptions : TAbStoreOptions; - FTempDir : string; - - protected {event variables} - FOnProcessItemFailure : TAbArchiveItemFailureEvent; - FOnArchiveProgress : TAbArchiveProgressEvent; - FOnArchiveSaveProgress : TAbArchiveProgressEvent; - FOnArchiveItemProgress : TAbArchiveItemProgressEvent; - FOnConfirmProcessItem : TAbArchiveItemConfirmEvent; - FOnConfirmOverwrite : TAbConfirmOverwriteEvent; - FOnConfirmSave : TAbArchiveConfirmEvent; - FOnLoad : TAbArchiveEvent; - FOnProgress : TAbProgressEvent; - FOnRequestImage : TAbRequestImageEvent; - FOnSave : TAbArchiveEvent; - - protected {methods} - constructor CreateInit; - procedure CheckValid; - function ConfirmPath(Item : TAbArchiveItem; const NewName : string; - out UseName : string) : Boolean; - procedure FreshenAt(Index : Integer); - function FreshenRequired(Item : TAbArchiveItem) : Boolean; - procedure GetFreshenTarget(Item : TAbArchiveItem); - function GetItemCount : Integer; - procedure MakeLogEntry(const FN: string; LT : TAbLogType); - procedure ReplaceAt(Index : Integer); - procedure SaveIfNeeded(aItem : TAbArchiveItem); - procedure SetBaseDirectory(Value : string); - procedure SetLogFile(const Value : string); - procedure SetLogging(Value : Boolean); - - protected {abstract methods} - function CreateItem(const FileSpec : string): TAbArchiveItem; - virtual; abstract; - procedure ExtractItemAt(Index : Integer; const UseName : string); - virtual; abstract; - procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream); - virtual; abstract; - procedure LoadArchive; - virtual; abstract; - procedure SaveArchive; - virtual; abstract; - procedure TestItemAt(Index : Integer); - virtual; abstract; - - protected {virtual methods} - procedure DoProcessItemFailure(Item : TAbArchiveItem; - ProcessType : TAbProcessType; ErrorClass : TAbErrorClass; - ErrorCode : Integer); - virtual; - procedure DoArchiveSaveProgress(Progress : Byte; var Abort : Boolean); - virtual; - procedure DoArchiveProgress(Progress : Byte; var Abort : Boolean); - virtual; - procedure DoArchiveItemProgress(Item : TAbArchiveItem; Progress : Byte; - var Abort : Boolean); - virtual; - procedure DoConfirmOverwrite(var FileName : string; var Confirm : Boolean); - virtual; - procedure DoConfirmProcessItem(Item : TAbArchiveItem; - const ProcessType : TAbProcessType; var Confirm : Boolean); - virtual; - procedure DoConfirmSave(var Confirm : Boolean); - virtual; - - procedure DoLoad; - virtual; - procedure DoProgress(Progress : Byte; var Abort : Boolean); - virtual; - procedure DoSave; - virtual; - function FixName(const Value : string) : string; - virtual; - function GetSpanningThreshold : Int64; - virtual; - function GetSupportsEmptyFolders : Boolean; - virtual; - procedure SetSpanningThreshold( Value : Int64 ); - virtual; - - protected {properties and events} - property InStream : TStream - read FInStream; - - public {methods} - constructor Create(const FileName : string; Mode : Word); - virtual; - constructor CreateFromStream(aStream : TStream; const aArchiveName : string); - virtual; - destructor Destroy; - override; - procedure Add(aItem : TAbArchiveItem); - virtual; - procedure AddFiles(const FileMask : string; SearchAttr : Integer); - procedure AddFilesEx(const FileMask, ExclusionMask : string; - SearchAttr : Integer); - procedure AddFromStream(const NewName : string; aStream : TStream); - procedure ClearTags; - procedure Delete(aItem : TAbArchiveItem); - procedure DeleteAt(Index : Integer); - procedure DeleteFiles(const FileMask : string); - procedure DeleteFilesEx(const FileMask, ExclusionMask : string); - procedure DeleteTaggedItems; - procedure Extract(aItem : TAbArchiveItem; const NewName : string); - procedure ExtractAt(Index : Integer; const NewName : string); - procedure ExtractFiles(const FileMask : string); - procedure ExtractFilesEx(const FileMask, ExclusionMask : string); - procedure ExtractTaggedItems; - procedure ExtractToStream(const aFileName : string; aStream : TStream); - function FindFile(const aFileName : string): Integer; - function FindItem(aItem : TAbArchiveItem): Integer; - procedure Freshen(aItem : TAbArchiveItem); - procedure FreshenFiles(const FileMask : string); - procedure FreshenFilesEx(const FileMask, ExclusionMask : string); - procedure FreshenTaggedItems; - procedure Load; virtual; - procedure Move(aItem : TAbArchiveItem; const NewStoredPath : string); - virtual; - procedure Replace(aItem : TAbArchiveItem); - procedure Save; - virtual; - procedure TagItems(const FileMask : string); - procedure TestTaggedItems; - procedure UnTagItems(const FileMask : string); - - - procedure DoDeflateProgress(aPercentDone : integer); - virtual; - procedure DoInflateProgress(aPercentDone : integer); - virtual; - procedure DoSpanningMediaRequest(Sender : TObject; ImageNumber : Integer; - var ImageName : string; var Abort : Boolean); virtual; - public {properties} - property OnProgress : TAbProgressEvent - read FOnProgress write FOnProgress; - property ArchiveName : string - read FArchiveName; - property AutoSave : Boolean - read FAutoSave - write FAutoSave; - property BaseDirectory : string - read FBaseDirectory - write SetBaseDirectory; - property Count : Integer - read GetItemCount; - property DOSMode : Boolean - read FDOSMode - write FDOSMode; - property ExtractOptions : TAbExtractOptions - read FExtractOptions - write FExtractOptions; - property IsDirty : Boolean - read FIsDirty - write FIsDirty; - property ItemList : TAbArchiveList - read FItemList; - property LogFile : string - read FLogFile - write SetLogFile; - property Logging : Boolean - read FLogging - write SetLogging; - property Mode : Word - read FMode; - property Spanned : Boolean - read FSpanned; - property SpanningThreshold : Int64 - read GetSpanningThreshold - write SetSpanningThreshold; - property Status : TAbArchiveStatus - read FStatus; - property StoreOptions : TAbStoreOptions - read FStoreOptions - write FStoreOptions; - property SupportsEmptyFolders : Boolean - read GetSupportsEmptyFolders; - property TempDirectory : string - read FTempDir - write FTempDir; - - public {events} - property OnProcessItemFailure : TAbArchiveItemFailureEvent - read FOnProcessItemFailure - write FOnProcessItemFailure; - property OnArchiveProgress : TAbArchiveProgressEvent - read FOnArchiveProgress - write FOnArchiveProgress; - property OnArchiveSaveProgress : TAbArchiveProgressEvent - read FOnArchiveSaveProgress - write FOnArchiveSaveProgress; - property OnArchiveItemProgress : TAbArchiveItemProgressEvent - read FOnArchiveItemProgress - write FOnArchiveItemProgress; - property OnConfirmProcessItem : TAbArchiveItemConfirmEvent - read FOnConfirmProcessItem - write FOnConfirmProcessItem; - property OnConfirmOverwrite : TAbConfirmOverwriteEvent - read FOnConfirmOverwrite - write FOnConfirmOverwrite; - property OnConfirmSave : TAbArchiveConfirmEvent - read FOnConfirmSave - write FOnConfirmSave; - property OnLoad : TAbArchiveEvent - read FOnLoad - write FOnLoad; - property OnRequestImage : TAbRequestImageEvent - read FOnRequestImage - write FOnRequestImage; - property OnSave : TAbArchiveEvent - read FOnSave - write FOnSave; - end; - - -{ ===== TAbExtraField ======================================================= } -type - PAbExtraSubField = ^TAbExtraSubField; - TAbExtraSubField = packed record - ID : Word; - Len : Word; - Data : record end; - end; - - TAbExtraField = class - private {fields} - FBuffer : TByteDynArray; - private {methods} - procedure DeleteField(aSubField : PAbExtraSubField); - function FindField(aID : Word; out aSubField : PAbExtraSubField) : Boolean; - function FindNext(var aCurField : PAbExtraSubField) : Boolean; - function GetCount : Integer; - function GetID(aIndex : Integer): Word; - procedure SetBuffer(const aValue : TByteDynArray); - protected {methods} - procedure Changed; virtual; - public {methods} - procedure Assign(aSource : TAbExtraField); - procedure Clear; - procedure CloneFrom(aSource : TAbExtraField; aID : Word); - procedure Delete(aID : Word); - function Get(aID : Word; out aData : Pointer; out aDataSize : Word) : Boolean; - function GetStream(aID : Word; out aStream : TStream): Boolean; - function Has(aID : Word): Boolean; - procedure LoadFromStream(aStream : TStream; aSize : Word); - procedure Put(aID : Word; const aData; aDataSize : Word); - public {properties} - property Count : Integer - read GetCount; - property Buffer : TByteDynArray - read FBuffer - write SetBuffer; - property IDs[aIndex : Integer]: Word - read GetID; - end; - - -const - AbDefAutoSave = False; - AbDefExtractOptions = [eoCreateDirs]; - AbDefStoreOptions = [soStripDrive, soRemoveDots]; - AbBufferSize = 32768; - AbLastDisk = -1; - AbLastImage = -1; - -implementation - -{.$R ABRES.R32} - -uses - RTLConsts, - SysUtils, - AbExcept, - AbDfBase, - AbConst, - AbResString; - - -{ TAbArchiveItem implementation ============================================ } -{ TAbArchiveItem } -constructor TAbArchiveItem.Create; -begin - inherited Create; - FCompressedSize := 0; - FUncompressedSize := 0; - FFileName := ''; - FAction := aaNone; - FLastModFileTime := 0; - FLastModFileDate := 0; -end; -{ -------------------------------------------------------------------------- } -destructor TAbArchiveItem.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetCompressedSize : Int64; -begin - Result := FCompressedSize; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetCRC32 : LongInt; -begin - Result := FCRC32; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetDiskPath : string; -begin - Result := ExtractFilePath(DiskFileName); -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetExternalFileAttributes : LongWord; -begin - Result := FExternalFileAttributes; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetFileName : string; -begin - Result := FFileName; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetIsDirectory: Boolean; -begin - Result := False; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetIsEncrypted : Boolean; -begin - Result := FIsEncrypted; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetLastModFileTime : Word; -begin - Result := FLastModFileTime; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetLastModFileDate : Word; -begin - Result := FLastModFileDate; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetNativeFileAttributes : LongInt; -begin - {$IFDEF MSWINDOWS} - if IsDirectory then - Result := faDirectory - else - Result := 0; - {$ENDIF} - {$IFDEF UNIX} - if IsDirectory then - Result := AB_FPERMISSION_GENERIC or AB_FPERMISSION_OWNEREXECUTE - else - Result := AB_FPERMISSION_GENERIC; - {$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetStoredPath : string; -begin - Result := ExtractFilePath(DiskFileName); -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetUnCompressedSize : Int64; -begin - Result := FUnCompressedSize; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.MatchesDiskName(const FileMask : string) : Boolean; -var - DiskName, Mask : string; -begin - DiskName := DiskFileName; - AbUnfixName(DiskName); - Mask := FileMask; - AbUnfixName(Mask); - Result := AbFileMatch(DiskName, Mask); -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.MatchesStoredName(const FileMask : string) : Boolean; -var - Value : string; - Drive, Dir, Name : string; -begin - Value := FileMask; - AbUnfixName(Value); - AbParseFileName(Value, Drive, Dir, Name); - Value := Dir + Name; - Name := FileName; - AbUnfixName(Name); - if IsDirectory then - Name := ExcludeTrailingPathDelimiter(Name); - Result := AbFileMatch(Name, Value); -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.MatchesStoredNameEx(const FileMask : string) : Boolean; -var - I, J: Integer; - MaskPart: string; -begin - Result := True; - I := 1; - while I <= Length(FileMask) do begin - J := I; - while (I <= Length(FileMask)) and (FileMask[I] <> PathSep {';'}) do Inc(I); - MaskPart := Trim(Copy(FileMask, J, I - J)); - if (I <= Length(FileMask)) and (FileMask[I] = PathSep {';'}) then Inc(I); - - if MatchesStoredName(MaskPart) then Exit; - end; - Result := False; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetCompressedSize(const Value : Int64); -begin - FCompressedSize := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetCRC32(const Value : LongInt); -begin - FCRC32 := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetExternalFileAttributes( Value : LongWord ); -begin - FExternalFileAttributes := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetFileName(const Value : string); -begin - FFileName := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetIsEncrypted(Value : Boolean); -begin - FIsEncrypted := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetLastModFileDate(const Value : Word); -begin - FLastModFileDate := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetLastModFileTime(const Value : Word); -begin - FLastModFileTime := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetUnCompressedSize(const Value : Int64); -begin - FUnCompressedSize := Value; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveItem.GetLastModTimeAsDateTime: TDateTime; -begin - Result := AbDosFileDateToDateTime(LastModFileDate, LastModFileTime); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveItem.SetLastModTimeAsDateTime(const Value: TDateTime); -var - FileDate : Integer; -begin - FileDate := AbDateTimeToDosFileDate(Value); - LastModFileTime := LongRec(FileDate).Lo; - LastModFileDate := LongRec(FileDate).Hi; -end; -{ -------------------------------------------------------------------------- } - -{ TAbArchiveEnumeratorList implementation ================================== } -{ TAbArchiveEnumeratorList } -constructor TAbArchiveListEnumerator.Create(aList: TAbArchiveList); -begin - inherited Create; - FIndex := -1; - FList := aList; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveListEnumerator.GetCurrent: TAbArchiveItem; -begin - Result := FList[FIndex]; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveListEnumerator.MoveNext: Boolean; -begin - Result := FIndex < FList.Count - 1; - if Result then - Inc(FIndex); -end; -{ -------------------------------------------------------------------------- } - -{ TAbArchiveList implementation ============================================ } - -{ TAbArchiveList } -constructor TAbArchiveList.Create(AOwnsItems: Boolean); -begin - inherited Create; - FList := TList.Create; - FOwnsItems := AOwnsItems; -end; -{ -------------------------------------------------------------------------- } -destructor TAbArchiveList.Destroy; -begin - Clear; - FList.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveList.Add(Item : Pointer) : Integer; -var - H : LongInt; -begin - if FOwnsItems then begin - H := GenerateHash(TAbArchiveItem(Item).FileName); - TAbArchiveItem(Item).NextItem := HashTable[H]; - HashTable[H] := TAbArchiveItem(Item); - end; - Result := FList.Add(Item); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveList.Clear; -var - i : Integer; -begin - if FOwnsItems then - for i := 0 to Count - 1 do - TObject(FList[i]).Free; - FList.Clear; - FillChar(HashTable, SizeOf(HashTable), #0); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveList.Delete(Index: Integer); -var - Look : TAbArchiveItem; - Last : Pointer; - FN : string; -begin - if FOwnsItems then begin - FN := TAbArchiveItem(FList[Index]).FileName; - Last := @HashTable[GenerateHash(FN)]; - Look := TAbArchiveItem(Last^); - while Look <> nil do begin - if CompareText(Look.FileName, FN) = 0 then begin - Move(Look.NextItem, Last^, 4); - Break; - end; - Last := @Look.NextItem; - Look := TAbArchiveItem(Last^); - end; - TObject(FList[Index]).Free; - end; - FList.Delete(Index); -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveList.Find(const FN : string) : Integer; -var - Look : TAbArchiveItem; - I : Integer; -begin - if FOwnsItems then begin - Look := HashTable[GenerateHash(FN)]; - while Look <> nil do begin - if CompareText(Look.FileName, FN) = 0 then begin - Result := FList.IndexOf(Look); - Exit; - end; - Look := Look.NextItem; - end; - end - else begin - for I := 0 to FList.Count - 1 do - if CompareText(Items[I].FileName, FN) = 0 then begin - Result := I; - Exit; - end; - end; - Result := -1; -end; -{ -------------------------------------------------------------------------- } -{$IFOPT Q+}{$DEFINE OVERFLOW_CHECKS_ON}{$Q-}{$ENDIF} -function TAbArchiveList.GenerateHash(const S : string) : LongInt; -var - G : LongInt; - I : Integer; - U : string; -begin - Result := 0; - U := AnsiUpperCase(S); - for I := 1 to Length(U) do begin - Result := (Result shl 4) + Ord(U[I]); - G := LongInt(Result and $F0000000); - if (G <> 0) then - Result := Result xor (G shr 24); - Result := Result and (not G); - end; - Result := Result mod 1021; -end; -{$IFDEF OVERFLOW_CHECKS_ON}{$Q+}{$ENDIF} -{ -------------------------------------------------------------------------- } -function TAbArchiveList.Get(Index : Integer): TAbArchiveItem; -begin - Result := TAbArchiveItem(FList[Index]); -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveList.GetCount : Integer; -begin - Result := FList.Count; -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveList.GetEnumerator: TAbArchiveListEnumerator; -begin - Result := TAbArchiveListEnumerator.Create(Self); -end; -{ -------------------------------------------------------------------------- } -function TAbArchiveList.IsActiveDupe(const FN : string) : Boolean; -var - Look : TAbArchiveItem; - I : Integer; -begin - if FOwnsItems then begin - Look := HashTable[GenerateHash(FN)]; - while Look <> nil do begin - if (CompareText(Look.FileName, FN) = 0) and - (Look.Action <> aaDelete) then begin - Result := True; - Exit; - end; - Look := Look.NextItem; - end; - end - else begin - for I := 0 to Count - 1 do - if (CompareText(Items[I].FileName, FN) = 0) and - (Items[I].Action <> aaDelete) then begin - Result := True; - Exit; - end; - end; - Result := False; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchiveList.Put(Index : Integer; Item : TAbArchiveItem); -var - H : LongInt; - Look : TAbArchiveItem; - Last : Pointer; - FN : string; -begin - if FOwnsItems then begin - FN := TAbArchiveItem(FList[Index]).FileName; - Last := @HashTable[GenerateHash(FN)]; - Look := TAbArchiveItem(Last^); - { Delete old index } - while Look <> nil do begin - if CompareText(Look.FileName, FN) = 0 then begin - Move(Look.NextItem, Last^, 4); - Break; - end; - Last := @Look.NextItem; - Look := TAbArchiveItem(Last^); - end; - { Free old instance } - TObject(FList[Index]).Free; - { Add new index } - H := GenerateHash(TAbArchiveItem(Item).FileName); - TAbArchiveItem(Item).NextItem := HashTable[H]; - HashTable[H] := TAbArchiveItem(Item); - end; - { Replace pointer } - FList[Index] := Item; -end; - - -{ TAbArchive implementation ================================================ } -{ TAbArchive } -constructor TAbArchive.CreateInit; -begin - inherited Create; - FIsDirty := False; - FAutoSave := False; - FItemList := TAbArchiveList.Create(True); - StoreOptions := []; - ExtractOptions := []; - FStatus := asIdle; - FOnProgress := DoProgress; - BaseDirectory := ExtractFilePath(ParamStr(0)); -end; -{ -------------------------------------------------------------------------- } -constructor TAbArchive.Create(const FileName : string; Mode : Word); - {create an archive by opening a filestream on filename with the given mode} -begin - FOwnsStream := True; - CreateFromStream(TFileStream.Create(FileName, Mode), FileName); - FMode := Mode; -end; -{ -------------------------------------------------------------------------- } -constructor TAbArchive.CreateFromStream(aStream : TStream; const aArchiveName : string); - {create an archive based on an existing stream} -begin - CreateInit; - FArchiveName := aArchiveName; - FStream := aStream; -end; -{ -------------------------------------------------------------------------- } -destructor TAbArchive.Destroy; -begin - FItemList.Free; - if FOwnsStream then - FStream.Free; - FLogStream.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Add(aItem : TAbArchiveItem); -var - Confirm, ItemAdded : Boolean; -begin - ItemAdded := False; - try - CheckValid; - if FItemList.IsActiveDupe(aItem.FileName) then begin - if (soFreshen in StoreOptions) then - Freshen(aItem) - else if (soReplace in StoreOptions) then - Replace(aItem) - else - DoProcessItemFailure(aItem, ptAdd, ecAbbrevia, AbDuplicateName); - Exit; - end; - DoConfirmProcessItem(aItem, ptAdd, Confirm); - if not Confirm then - Exit; - aItem.Action := aaAdd; - FItemList.Add(aItem); - ItemAdded := True; - FIsDirty := True; - if AutoSave then - Save; - finally - if not ItemAdded then - aItem.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.AddFiles(const FileMask : string; SearchAttr : Integer); - {Add files to the archive where the disk filespec matches} -begin - AddFilesEx(FileMask, '', SearchAttr); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.AddFilesEx(const FileMask, ExclusionMask : string; - SearchAttr : Integer); - {Add files matching Filemask except those matching ExclusionMask} -var - PathType : TAbPathType; - IsWild : Boolean; - SaveDir : string; - Mask : string; - MaskF : string; - - procedure CreateItems(Wild, Recursing : Boolean); - var - i : Integer; - Files : TStrings; - FilterList : TStringList; - Item : TAbArchiveItem; - begin - FilterList := TStringList.Create; - try - if (MaskF <> '') then - AbFindFilesEx(MaskF, SearchAttr, FilterList, Recursing); - - Files := TStringList.Create; - try - - AbFindFilesEx(Mask, SearchAttr, Files, Recursing); - if (Files.Count > 0) then - for i := 0 to pred(Files.Count) do - if FilterList.IndexOf(Files[i]) < 0 then - if not Wild then begin - if (Files[i] <> FArchiveName) then begin - Item := CreateItem(Files[i]); - Add(Item); - end; - end else begin - if (AbAddBackSlash(FBaseDirectory) + Files[i]) <> FArchiveName - then begin - Item := CreateItem(Files[i]); - Add(Item); - end; - end; - finally - Files.Free; - end; - - finally - FilterList.Free; - end; - end; - -begin - if not SupportsEmptyFolders then - SearchAttr := SearchAttr and not faDirectory; - - CheckValid; - IsWild := (Pos('*', FileMask) > 0) or (Pos('?', FileMask) > 0); - PathType := AbGetPathType(FileMask); - - Mask := FileMask; - AbUnfixName(Mask); - MaskF := ExclusionMask; - AbUnfixName(MaskF); - - case PathType of - ptNone, ptRelative : - begin - GetDir(0, SaveDir); - if BaseDirectory <> '' then - ChDir(BaseDirectory); - try - CreateItems(IsWild, soRecurse in StoreOptions); - finally - if BaseDirectory <> '' then - ChDir(SaveDir); - end; - end; - ptAbsolute : - begin - CreateItems(IsWild, soRecurse in StoreOptions); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.AddFromStream(const NewName : string; aStream : TStream); - {Add an item to the archive directly from a TStream descendant} -var - Confirm : Boolean; - Item : TAbArchiveItem; - PT : TAbProcessType; -begin - Item := CreateItem(NewName); - CheckValid; - - PT := ptAdd; - if FItemList.IsActiveDupe(NewName) then begin - if ((soFreshen in StoreOptions) or (soReplace in StoreOptions)) then begin - Item.Free; - Item := FItemList[FItemList.Find(NewName)]; - PT := ptReplace; - end else begin - DoProcessItemFailure(Item, ptAdd, ecAbbrevia, AbDuplicateName); - Item.Free; - Exit; - end; - end; - DoConfirmProcessItem(Item, PT, Confirm); - - if not Confirm then - Exit; - - FInStream := aStream; - Item.Action := aaStreamAdd; - if (PT = ptAdd) then - FItemList.Add(Item); - FIsDirty := True; - Save; - FInStream := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.CheckValid; -begin - if Status = asInvalid then - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.ClearTags; - {Clear all tags from the archive} -var - i : Integer; -begin - if Count > 0 then - for i := 0 to pred(Count) do - TAbArchiveItem(FItemList[i]).Tagged := False; -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.ConfirmPath(Item : TAbArchiveItem; const NewName : string; - out UseName : string) : Boolean; -var - Path : string; -begin - if Item.IsDirectory and not (ExtractOptions >= [eoRestorePath, eoCreateDirs]) then begin - Result := False; - Exit; - end; - if (NewName = '') then begin - UseName := Item.FileName; - AbUnfixName(UseName); - if Item.IsDirectory then - UseName := ExcludeTrailingPathDelimiter(UseName); - if (not (eoRestorePath in ExtractOptions)) then - UseName := ExtractFileName(UseName); - end - else - UseName := NewName; - if (AbGetPathType(UseName) <> ptAbsolute) then - UseName := AbAddBackSlash(BaseDirectory) + UseName; - - Path := ExtractFileDir(UseName); - if (Path <> '') and not DirectoryExists(Path) then - if (eoCreateDirs in ExtractOptions) then - AbCreateDirectory(Path) - else - raise EAbNoSuchDirectory.Create; - - Result := True; - if not Item.IsDirectory and FileExists(UseName) then - DoConfirmOverwrite(UseName, Result); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Delete(aItem : TAbArchiveItem); - {delete an item from the archive} -var - Index : Integer; -begin - CheckValid; - Index := FindItem(aItem); - if Index <> -1 then - DeleteAt(Index); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DeleteAt(Index : Integer); - {delete the item at the index from the archive} -var - Confirm : Boolean; -begin - CheckValid; - SaveIfNeeded(FItemList[Index]); - DoConfirmProcessItem(FItemList[Index], ptDelete, Confirm); - if not Confirm then - Exit; - - TAbArchiveItem(FItemList[Index]).Action := aaDelete; - FIsDirty := True; - if AutoSave then - Save; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DeleteFiles(const FileMask : string); - {delete all files from the archive that match the file mask} -begin - DeleteFilesEx(FileMask, ''); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DeleteFilesEx(const FileMask, ExclusionMask : string); - {Delete files matching Filemask except those matching ExclusionMask} -var - i : Integer; -begin - CheckValid; - if Count > 0 then begin - for i := pred(Count) downto 0 do begin - with TAbArchiveItem(FItemList[i]) do - if MatchesStoredNameEx(FileMask) then - if not MatchesStoredNameEx(ExclusionMask) then - DeleteAt(i); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DeleteTaggedItems; - {delete all tagged items from the archive} -var - i : Integer; -begin - CheckValid; - if Count > 0 then begin - for i := pred(Count) downto 0 do begin - with TAbArchiveItem(FItemList[i]) do - if Tagged then - DeleteAt(i); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoProcessItemFailure(Item : TAbArchiveItem; - ProcessType : TAbProcessType; ErrorClass : TAbErrorClass; - ErrorCode : Integer); -begin - if Assigned(FOnProcessItemFailure) then - FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoArchiveSaveProgress(Progress : Byte; var Abort : Boolean); -begin - Abort := False; - if Assigned(FOnArchiveSaveProgress) then - FOnArchiveSaveProgress(Self, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoArchiveProgress(Progress : Byte; var Abort : Boolean); -begin - Abort := False; - if Assigned(FOnArchiveProgress) then - FOnArchiveProgress(Self, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoArchiveItemProgress(Item : TAbArchiveItem; - Progress : Byte; var Abort : Boolean); -begin - Abort := False; - if Assigned(FOnArchiveItemProgress) then - FOnArchiveItemProgress(Self, Item, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoConfirmOverwrite(var FileName : string; var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FOnConfirmOverwrite) then - FOnConfirmOverwrite(FileName, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoConfirmProcessItem(Item : TAbArchiveItem; - const ProcessType : TAbProcessType; var Confirm : Boolean); -const - ProcessTypeToLogType : array[TAbProcessType] of TAbLogType = - (ltAdd, ltDelete, ltExtract, ltFreshen, ltMove, ltReplace, ltFoundUnhandled); -begin - Confirm := True; - if Assigned(FOnConfirmProcessItem) then - FOnConfirmProcessItem(Self, Item, ProcessType, Confirm); - if (Confirm and FLogging) then - MakeLogEntry(Item.Filename, ProcessTypeToLogType[ProcessType]); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoConfirmSave(var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FOnConfirmSave) then - FOnConfirmSave(Self, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoDeflateProgress(aPercentDone: integer); -var - Abort : Boolean; -begin - DoProgress(aPercentDone, Abort); - if Abort then - raise EAbAbortProgress.Create(AbUserAbortS); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoInflateProgress(aPercentDone: integer); -var - Abort : Boolean; -begin - DoProgress(aPercentDone, Abort); - if Abort then - raise EAbAbortProgress.Create(AbUserAbortS); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoLoad; -begin - if Assigned(FOnLoad) then - FOnLoad(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoProgress(Progress : Byte; var Abort : Boolean); -begin - Abort := False; - DoArchiveItemProgress(FCurrentItem, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoSave; -begin - if Assigned(FOnSave) then - FOnSave(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Extract(aItem : TAbArchiveItem; const NewName : string); - {extract an item from the archive} -var - Index : Integer; -begin - CheckValid; - Index := FindItem(aItem); - if Index <> -1 then - ExtractAt(Index, NewName); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.ExtractAt(Index : Integer; const NewName : string); - {extract an item from the archive at Index} -var - Confirm : Boolean; - ErrorClass : TAbErrorClass; - ErrorCode : Integer; - UseName : string; -begin - CheckValid; - SaveIfNeeded(FItemList[Index]); - DoConfirmProcessItem(FItemList[Index], ptExtract, Confirm); - if not Confirm then - Exit; - - if not ConfirmPath(FItemList[Index], NewName, UseName) then - Exit; - - try - FCurrentItem := FItemList[Index]; - ExtractItemAt(Index, UseName); - except - on E : Exception do begin - AbConvertException(E, ErrorClass, ErrorCode); - DoProcessItemFailure(FItemList[Index], ptExtract, ErrorClass, ErrorCode); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.ExtractToStream(const aFileName : string; - aStream : TStream); - {extract an item from the archive at Index directly to a stream} -var - Confirm : Boolean; - ErrorClass : TAbErrorClass; - ErrorCode : Integer; - Index : Integer; -begin - CheckValid; - Index := FindFile(aFileName); - if (Index = -1) then - Exit; - - SaveIfNeeded(FItemList[Index]); - - DoConfirmProcessItem(FItemList[Index], ptExtract, Confirm); - if not Confirm then - Exit; - FCurrentItem := FItemList[Index]; - try - ExtractItemToStreamAt(Index, aStream); - except - on E : Exception do begin - AbConvertException(E, ErrorClass, ErrorCode); - DoProcessItemFailure(FItemList[Index], ptExtract, ErrorClass, ErrorCode); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.ExtractFiles(const FileMask : string); - {extract all files from the archive that match the mask} -begin - ExtractFilesEx(FileMask, ''); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.ExtractFilesEx(const FileMask, ExclusionMask : string); - {Extract files matching Filemask except those matching ExclusionMask} -var - i : Integer; - Abort : Boolean; -begin - CheckValid; - if Count > 0 then begin - for i := 0 to pred(Count) do begin - with TAbArchiveItem(FItemList[i]) do - if MatchesStoredNameEx(FileMask) and - not MatchesStoredNameEx(ExclusionMask) and - ((eoCreateDirs in ExtractOptions) or not IsDirectory) then - ExtractAt(i, ''); - DoArchiveProgress(AbPercentage(succ(i), Count), Abort); - if Abort then - raise EAbUserAbort.Create; - end; - DoArchiveProgress(100, Abort); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.ExtractTaggedItems; - {extract all tagged items from the archive} -var - i : Integer; - Abort : Boolean; -begin - CheckValid; - if Count > 0 then begin - for i := 0 to pred(Count) do begin - with TAbArchiveItem(FItemList[i]) do - if Tagged then - ExtractAt(i, ''); - DoArchiveProgress(AbPercentage(succ(i), Count), Abort); - if Abort then - raise EAbUserAbort.Create; - end; - DoArchiveProgress(100, Abort); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.TestTaggedItems; - {test all tagged items in the archive} -var - i : Integer; - Abort : Boolean; -begin - CheckValid; - if Count > 0 then begin - for i := 0 to pred(Count) do begin - with TAbArchiveItem(FItemList[i]) do - if Tagged then begin - FCurrentItem := FItemList[i]; - TestItemAt(i); - end; - DoArchiveProgress(AbPercentage(succ(i), Count), Abort); - if Abort then - raise EAbUserAbort.Create; - end; - DoArchiveProgress(100, Abort); - end; -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.FindFile(const aFileName : string): Integer; - {find the index of the specified file} -begin - Result := FItemList.Find(aFileName); -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.FindItem(aItem : TAbArchiveItem): Integer; - {find the index of the specified item} -begin - Result := FItemList.Find(aItem.FileName); -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.FixName(const Value : string) : string; -var - lValue: string; -begin - lValue := Value; - {$IFDEF MSWINDOWS} - if DOSMode then begin - {Add the base directory to the filename before converting } - {the file spec to the short filespec format. } - if BaseDirectory <> '' then begin - {Does the filename contain a drive or a leading backslash? } - if not ((Pos(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then - {If not, add the BaseDirectory to the filename.} - lValue := AbAddBackSlash(BaseDirectory) + lValue; - end; - lValue := AbGetShortFileSpec(lValue); - end; - {$ENDIF} - - {strip drive stuff} - if soStripDrive in StoreOptions then - AbStripDrive(lValue); - - {check for a leading backslash} - if lValue[1] = AbPathDelim then - System.Delete(lValue, 1, 1); - - if soStripPath in StoreOptions then begin - lValue := ExtractFileName(lValue); - end; - - if soRemoveDots in StoreOptions then - AbStripDots(lValue); - - Result := lValue; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Freshen(aItem : TAbArchiveItem); - {freshen the item} -var - Index : Integer; -begin - CheckValid; - Index := FindItem(aItem); - if Index <> -1 then begin - {point existing item at the new file} - if AbGetPathType(aItem.DiskFileName) = ptAbsolute then - FItemList[Index].DiskFileName := aItem.DiskFileName; - FreshenAt(Index); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.FreshenAt(Index : Integer); - {freshen item at index} -var - Confirm : Boolean; - FR : Boolean; - ErrorClass : TAbErrorClass; - ErrorCode : Integer; -begin - CheckValid; - SaveIfNeeded(FItemList[Index]); - - GetFreshenTarget(FItemList[Index]); - FR := False; - try - FR := FreshenRequired(FItemList[Index]); - except - on E : Exception do begin - AbConvertException(E, ErrorClass, ErrorCode); - DoProcessItemFailure(FItemList[Index], ptFreshen, ErrorClass, ErrorCode); - end; - end; - if not FR then - Exit; - DoConfirmProcessItem(FItemList[Index], ptFreshen, Confirm); - if not Confirm then - Exit; - - TAbArchiveItem(FItemList[Index]).Action := aaFreshen; - FIsDirty := True; - if AutoSave then - Save; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.FreshenFiles(const FileMask : string); - {freshen all items that match the file mask} -begin - FreshenFilesEx(FileMask, ''); -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.FreshenFilesEx(const FileMask, ExclusionMask : string); - {freshen all items that match the file mask} -var - i : Integer; -begin - CheckValid; - if Count > 0 then begin - for i := pred(Count) downto 0 do begin - with TAbArchiveItem(FItemList[i]) do - if MatchesStoredNameEx(FileMask) then - if not MatchesStoredNameEx(ExclusionMask) then - FreshenAt(i); - end; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.FreshenRequired(Item : TAbArchiveItem) : Boolean; -var - FS : TFileStream; - DateTime : LongInt; - FileTime : Word; - FileDate : Word; - Matched : Boolean; - SaveDir : string; -begin - GetDir(0, SaveDir); - if BaseDirectory <> '' then - ChDir(BaseDirectory); - try - FS := TFileStream.Create(Item.DiskFileName, - fmOpenRead or fmShareDenyWrite); - try - DateTime := FileGetDate(FS.Handle); - FileTime := LongRec(DateTime).Lo; - FileDate := LongRec(DateTime).Hi; - Matched := (Item.LastModFileDate = FileDate) and - (Item.LastModFileTime = FileTime) and - (Item.UncompressedSize = FS.Size); - Result := not Matched; - finally - FS.Free; - end; - finally - if BaseDirectory <> '' then - ChDir(SaveDir); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.FreshenTaggedItems; - {freshen all tagged items} -var - i : Integer; -begin - CheckValid; - if Count > 0 then begin - for i := pred(Count) downto 0 do begin - with TAbArchiveItem(FItemList[i]) do - if Tagged then - FreshenAt(i); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.GetFreshenTarget(Item : TAbArchiveItem); -var - PathType : TAbPathType; - Files : TStrings; - SaveDir : string; - DName : string; -begin - PathType := AbGetPathType(Item.DiskFileName); - if (soRecurse in StoreOptions) and (PathType = ptNone) then begin - GetDir(0, SaveDir); - if BaseDirectory <> '' then - ChDir(BaseDirectory); - try - Files := TStringList.Create; - try - // even if archive supports empty folder we don't have to - // freshen it because there is no data, although, the timestamp - // can be update since the folder was added - AbFindFiles(Item.FileName, faAnyFile and not faDirectory, Files, - True); - if Files.Count > 0 then begin - DName := AbAddBackSlash(BaseDirectory) + Files[0]; - AbUnfixName(DName); - Item.DiskFileName := DName; - end - else - Item.DiskFileName := ''; - finally - Files.Free; - end; - finally - if BaseDirectory <> '' then - ChDir(SaveDir); - end; - end - else begin - if (BaseDirectory <> '') then - DName := AbAddBackSlash(BaseDirectory) + Item.FileName - else - if AbGetPathType(Item.DiskFileName) = ptAbsolute then - DName := Item.DiskFileName - else - DName := Item.FileName; - AbUnfixName(DName); - Item.DiskFileName := DName; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.GetSpanningThreshold : Int64; -begin - Result := FSpanningThreshold; -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.GetSupportsEmptyFolders : Boolean; -begin - Result := False; -end; -{ -------------------------------------------------------------------------- } -function TAbArchive.GetItemCount : Integer; -begin - if Assigned(FItemList) then - Result := FItemList.Count - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Load; - {load the archive} -begin - try - LoadArchive; - FStatus := asIdle; - finally - DoLoad; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.MakeLogEntry(const FN: string; LT : TAbLogType); -const - LogTypeRes : array[TAbLogType] of string = - (AbLtAddS, AbLtDeleteS, AbLtExtractS, AbLtFreshenS, AbLtMoveS, AbLtReplaceS, - AbLtStartS, AbUnhandledEntityS); -var - Buf : string; -begin - if Assigned(FLogStream) then begin - Buf := FN + LogTypeRes[LT] + DateTimeToStr(Now) + sLineBreak; - FLogStream.Write(Buf[1], Length(Buf) * SizeOf(Char)); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Move(aItem : TAbArchiveItem; const NewStoredPath : string); -var - Confirm : Boolean; - Found : Boolean; - i : Integer; - FixedPath: string; -begin - CheckValid; - FixedPath := FixName(NewStoredPath); - Found := False; - if Count > 0 then - for i := 0 to pred(Count) do - if (ItemList[i] <> aItem) and SameText(FixedPath, ItemList[i].FileName) and - (ItemList[i].Action <> aaDelete) then begin - Found := True; - Break; - end; - if Found then begin - DoProcessItemFailure(aItem, ptMove, ecAbbrevia, AbDuplicateName); - {even if something gets done in the AddItemFailure, we don't - want to continue...} - Exit; - end; - - SaveIfNeeded(aItem); - - DoConfirmProcessItem(aItem, ptMove, Confirm); - if not Confirm then - Exit; - - with aItem do begin - FileName := FixedPath; - Action := aaMove; - end; - FIsDirty := True; - if AutoSave then - Save; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Replace(aItem : TAbArchiveItem); - {replace the item} -var - Index : Integer; -begin - CheckValid; - Index := FindItem(aItem); - if Index <> -1 then begin - {point existing item at the new file} - if AbGetPathType(aItem.DiskFileName) = ptAbsolute then - FItemList[Index].DiskFileName := aItem.DiskFileName; - ReplaceAt(Index); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.ReplaceAt(Index : Integer); - {replace item at Index} -var - Confirm : Boolean; -begin - CheckValid; - SaveIfNeeded(FItemList[Index]); - - GetFreshenTarget(FItemList[Index]); - DoConfirmProcessItem(FItemList[Index], ptReplace, Confirm); - if not Confirm then - Exit; - - TAbArchiveItem(FItemList[Index]).Action := aaReplace; - FIsDirty := True; - if AutoSave then - Save; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.Save; - {save the archive} -var - Confirm : Boolean; -begin - if Status = asInvalid then - Exit; - if (not FIsDirty) and (Count > 0) then - Exit; - - DoConfirmSave(Confirm); - if not Confirm then - Exit; - - SaveArchive; - FIsDirty := False; - DoSave; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.SaveIfNeeded(aItem : TAbArchiveItem); -begin - if (aItem.Action <> aaNone) then - Save; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.SetBaseDirectory(Value : string); -begin - if (Value <> '') then - if Value[Length(Value)] = AbPathDelim then - if (Length(Value) > 1) and (Value[Length(Value) - 1] <> ':') then - System.Delete(Value, Length(Value), 1); - if (Length(Value) = 0) or DirectoryExists(Value) then - FBaseDirectory := Value - else - raise EAbNoSuchDirectory.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.SetSpanningThreshold( Value : Int64 ); -begin - FSpanningThreshold := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.SetLogFile(const Value : string); -begin - FLogFile := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.SetLogging(Value : Boolean); -begin - FLogging := Value; - if Assigned(FLogStream) then begin - FLogStream.Free; - FLogStream := nil; - end; - if FLogging and (FLogFile <> '') then begin - try - FLogStream := TFileStream.Create(FLogFile, fmCreate or fmOpenWrite); - MakeLogEntry(FArchiveName, ltStart); - except - raise EAbException.Create(AbLogCreateErrorS); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.TagItems(const FileMask : string); - {tag all items that match the mask} -var - i : Integer; -begin - if Count > 0 then - for i := 0 to pred(Count) do - with TAbArchiveItem(FItemList[i]) do begin - if MatchesStoredNameEx(FileMask) then - Tagged := True; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.UnTagItems(const FileMask : string); - {clear tags for all items that match the mask} -var - i : Integer; -begin - if Count > 0 then - for i := 0 to pred(Count) do - with TAbArchiveItem(FItemList[i]) do begin - if MatchesStoredNameEx(FileMask) then - Tagged := False; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbArchive.DoSpanningMediaRequest(Sender: TObject; - ImageNumber: Integer; var ImageName: string; var Abort: Boolean); -begin - raise EAbSpanningNotSupported.Create; -end; -{ -------------------------------------------------------------------------- } - -{ TAbExtraField implementation ============================================= } -procedure TAbExtraField.Assign(aSource : TAbExtraField); -begin - SetBuffer(aSource.Buffer); -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.Changed; -begin - // No-op -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.Clear; -begin - FBuffer := nil; - Changed; -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.CloneFrom(aSource : TAbExtraField; aID : Word); -var - Data : Pointer; - DataSize : Word; -begin - if aSource.Get(aID, Data, DataSize) then - Put(aID, Data, DataSize) - else Delete(aID); -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.Delete(aID : Word); -var - SubField : PAbExtraSubField; -begin - if FindField(aID, SubField) then begin - DeleteField(SubField); - Changed; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.DeleteField(aSubField : PAbExtraSubField); -var - Len, Offset : Integer; -begin - Len := SizeOf(TAbExtraSubField) + aSubField.Len; - Offset := PtrInt(aSubField) - PtrInt(Pointer(FBuffer)); - if Offset + Len < Length(FBuffer) then - Move(FBuffer[Offset + Len], aSubField^, Length(FBuffer) - Offset - Len); - SetLength(FBuffer, Length(FBuffer) - Len); -end; -{ -------------------------------------------------------------------------- } -function TAbExtraField.FindField(aID : Word; - out aSubField : PAbExtraSubField) : Boolean; -begin - Result := False; - aSubField := nil; - while FindNext(aSubField) do - if aSubField.ID = aID then begin - Result := True; - Break; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbExtraField.FindNext(var aCurField : PAbExtraSubField) : Boolean; -var - BytesLeft : Integer; -begin - if aCurField = nil then begin - aCurField := PAbExtraSubField(FBuffer); - BytesLeft := Length(FBuffer); - end - else begin - BytesLeft := Length(FBuffer) - - Integer(PtrInt(aCurField) - PtrInt(Pointer(FBuffer))) - - SizeOf(TAbExtraSubField) - aCurField.Len; - aCurField := Pointer(PtrInt(aCurField) + aCurField.Len + SizeOf(TAbExtraSubField)); - end; - Result := (BytesLeft >= SizeOf(TAbExtraSubField)); - if Result and (BytesLeft < SizeOf(TAbExtraSubField) + aCurField.Len) then - aCurField.Len := BytesLeft - SizeOf(TAbExtraSubField); -end; -{ -------------------------------------------------------------------------- } -function TAbExtraField.Get(aID : Word; out aData : Pointer; - out aDataSize : Word) : Boolean; -var - SubField : PAbExtraSubField; -begin - Result := FindField(aID, SubField); - if Result then begin - aData := @SubField.Data; - aDataSize := SubField.Len; - end - else begin - aData := nil; - aDataSize := 0; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbExtraField.GetCount : Integer; -var - SubField : PAbExtraSubField; -begin - Result := 0; - SubField := nil; - while FindNext(SubField) do - Inc(Result); -end; -{ -------------------------------------------------------------------------- } -function TAbExtraField.GetID(aIndex : Integer): Word; -var - i: Integer; - SubField : PAbExtraSubField; -begin - i := 0; - SubField := nil; - while FindNext(SubField) do - if i = aIndex then begin - Result := SubField.ID; - Exit; - end - else - Inc(i); - raise EListError.CreateFmt(SListIndexError, [aIndex]); -end; -{ -------------------------------------------------------------------------- } -function TAbExtraField.GetStream(aID : Word; out aStream : TStream): Boolean; -var - Data: Pointer; - DataSize: Word; -begin - Result := Get(aID, Data, DataSize); - if Result then begin - aStream := TMemoryStream.Create; - aStream.WriteBuffer(Data^, DataSize); - aStream.Position := 0; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbExtraField.Has(aID : Word): Boolean; -var - SubField : PAbExtraSubField; -begin - Result := FindField(aID, SubField); -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.LoadFromStream(aStream : TStream; aSize : Word); -begin - SetLength(FBuffer, aSize); - if aSize > 0 then - aStream.ReadBuffer( FBuffer[0], aSize); -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.Put(aID : Word; const aData; aDataSize : Word); -var - Offset : Cardinal; - SubField : PAbExtraSubField; -begin - if FindField(aID, SubField) then begin - if SubField.Len = aDataSize then begin - Move(aData, SubField.Data, aDataSize); - Changed; - Exit; - end - else DeleteField(SubField); - end; - Offset := Length(FBuffer); - SetLength(FBuffer, Length(FBuffer) + SizeOf(TAbExtraSubField) + aDataSize); - SubField := PAbExtraSubField(@FBuffer[Offset]); - SubField.ID := aID; - SubField.Len := aDataSize; - Move(aData, SubField.Data, aDataSize); - Changed; -end; -{ -------------------------------------------------------------------------- } -procedure TAbExtraField.SetBuffer(const aValue : TByteDynArray); -begin - SetLength(FBuffer, Length(aValue)); - if Length(FBuffer) > 0 then - Move(aValue[0], FBuffer[0], Length(FBuffer)); - Changed; -end; -{ -------------------------------------------------------------------------- } - -{ ========================================================================== } -{ TAbArchiveStreamHelper } - -constructor TAbArchiveStreamHelper.Create(AStream: TStream); -begin - if Assigned(AStream) then - FStream := AStream - else - raise Exception.Create('nil stream'); -end; - -end. diff --git a/components/Abbrevia/source/AbBase.pas b/components/Abbrevia/source/AbBase.pas deleted file mode 100644 index 2805fa4..0000000 --- a/components/Abbrevia/source/AbBase.pas +++ /dev/null @@ -1,70 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbBase.pas *} -{*********************************************************} -{* ABBREVIA: Base component class *} -{*********************************************************} - -unit AbBase; - -{$I AbDefine.inc} - -interface - -uses - Classes; - -type - TAbBaseComponent = class(TComponent) - protected {methods} - function GetVersion : string; - procedure SetVersion(const Value : string); - - protected {properties} - property Version : string - read GetVersion - write SetVersion - stored False; - end; - -implementation - -uses - AbConst; - -{ -------------------------------------------------------------------------- } -function TAbBaseComponent.GetVersion : string; -begin - Result := AbVersionS; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseComponent.SetVersion(const Value : string); -begin - {NOP} -end; - -end. diff --git a/components/Abbrevia/source/AbBitBkt.pas b/components/Abbrevia/source/AbBitBkt.pas deleted file mode 100644 index 73917fd..0000000 --- a/components/Abbrevia/source/AbBitBkt.pas +++ /dev/null @@ -1,241 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbBitBkt.pas *} -{*********************************************************} -{* ABBREVIA: Bit bucket memory stream class *} -{*********************************************************} - -unit AbBitBkt; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbUtils; - -type - TAbBitBucketStream = class(TStream) - private - FBuffer : {$IFDEF UNICODE}PByte{$ELSE}PAnsiChar{$ENDIF}; - FBufSize : longint; - FBufPosn : longint; - FPosn : Int64; - FSize : Int64; - FTail : longint; - protected - public - constructor Create(aBufSize : cardinal); - destructor Destroy; override; - function Read(var Buffer; Count : Longint) : Longint; override; - function Write(const Buffer; Count : Longint) : Longint; override; - function Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64; override; - - procedure ForceSize(aSize : Int64); - end; - -implementation - -uses - Math, SysUtils, AbExcept; - -{Notes: The buffer is a circular queue without a head pointer; FTail - is where data is next going to be written and it wraps - indescriminately. The buffer can never be empty--it is always - full (initially it is full of binary zeros. - The class is designed to act as a bit bucket for the test - feature of Abbrevia's zip code; it is not intended as a - complete class with many possible applications. It is designed - to be written to in a steady progression with some reading - back in the recently written stream (the buffer size details - how far back the Seek method will work). Seeking outside this - buffer will result in exceptions being generated. - For testing deflated files, the buffer size should be 32KB, - for imploded files, either 8KB or 4KB. The Create constructor - limits the buffer size to these values.} - -{===TAbBitBucketStream===============================================} -constructor TAbBitBucketStream.Create(aBufSize : cardinal); -begin - inherited Create; - if (aBufSize <> 4096) and - (aBufSize <> 8192) and - (aBufSize <> 32768) then - FBufSize := 32768 - else - FBufSize := aBufSize; - {add a 1KB leeway} - inc(FBufSize, 1024); - GetMem(FBuffer, FBufSize); -end; -{--------} -destructor TAbBitBucketStream.Destroy; -begin - if (FBuffer <> nil) then - FreeMem(FBuffer, FBufSize); - inherited Destroy; -end; -{--------} -procedure TAbBitBucketStream.ForceSize(aSize : Int64); -begin - FSize := aSize; -end; -{--------} -function TAbBitBucketStream.Read(var Buffer; Count : Longint) : Longint; -var - Chunk2Size : longint; - Chunk1Size : longint; - OutBuffer : PByte; -begin - OutBuffer := @Buffer; - {we cannot read more bytes than there is buffer} - if (Count > FBufSize) then - raise EAbBBSReadTooManyBytes.Create(Count); - {calculate the size of the chunks} - if (FBufPosn <= FTail) then begin - Chunk1Size := FTail - FBufPosn; - if (Chunk1Size > Count) then - Chunk1Size := Count; - Chunk2Size := 0; - end - else begin - Chunk1Size := FBufSize - FBufPosn; - if (Chunk1Size > Count) then begin - Chunk1Size := Count; - Chunk2Size := 0; - end - else begin - Chunk2Size := FTail; - if (Chunk2Size > (Count - Chunk1Size)) then - Chunk2Size := Count - Chunk1Size; - end - end; - {we cannot read more bytes than there are available} - if (Count > (Chunk1Size + Chunk2Size)) then - raise EAbBBSReadTooManyBytes.Create(Count); - {perform the read} - if (Chunk1Size > 0) then begin - Move(FBuffer[FBufPosn], OutBuffer^, Chunk1Size); - inc(FBufPosn, Chunk1Size); - inc(FPosn, Chunk1Size); - end; - if (Chunk2Size > 0) then begin - {we've wrapped} - Move(FBuffer[0], PByte(PtrInt(OutBuffer) + PtrInt(Chunk1Size))^, Chunk2Size); - FBufPosn := Chunk2Size; - inc(FPosn, Chunk2Size); - end; - Result := Count; -end; -{--------} -function TAbBitBucketStream.Write(const Buffer; Count : Longint) : Longint; -var - Chunk2Size : longint; - Chunk1Size : longint; - InBuffer : PByte; - Overage : longint; -begin - Result := Count; - InBuffer := @Buffer; - {we cannot write more bytes than there is buffer} - while Count > FBufSize do begin - Overage := Min(FBufSize, Count - FBufSize); - Write(InBuffer^, Overage); - Inc(PtrInt(InBuffer), Overage); - Dec(Count, Overage); - end; - {calculate the size of the chunks} - Chunk1Size := FBufSize - FTail; - if (Chunk1Size > Count) then begin - Chunk1Size := Count; - Chunk2Size := 0; - end - else begin - Chunk2Size := Count - Chunk1Size; - end; - {write the first chunk} - if (Chunk1Size > 0) then begin - Move(InBuffer^, FBuffer[FTail], Chunk1Size); - inc(FTail, Chunk1Size); - end; - {if the second chunk size is not zero, write the second chunk; note - that we have wrapped} - if (Chunk2Size > 0) then begin - Move(PByte(PtrInt(InBuffer) + PtrInt(Chunk1Size))^, FBuffer[0], Chunk2Size); - FTail := Chunk2Size; - end; - {the stream size and position have changed} - inc(FSize, Count); - FPosn := FSize; - FBufPosn := FTail; -end; -{--------} -function TAbBitBucketStream.Seek(const Offset : Int64; Origin : TSeekOrigin): Int64; -var - Posn : Int64; - BytesBack : longint; -begin - {calculate the new position} - case Origin of - soBeginning : - Posn := Offset; - soCurrent : - Posn := FPosn + Offset; - soEnd : - if (Offset = 0) then begin - {special case: position at end of stream} - FBufPosn := FTail; - FPosn := FSize; - Result := FSize; - Exit; - end - else begin - Posn := FSize + Offset; - end; - else - raise EAbBBSInvalidOrigin.Create; - end; - {calculate whether the new position is within the buffer; if not, - raise exception} - if (Posn > FSize) or - (Posn <= (FSize - FBufSize)) then - raise EAbBBSSeekOutsideBuffer.Create; - {set the internal fields for the new position} - FPosn := Posn; - BytesBack := FSize - Posn; - if (BytesBack <= FTail) then - FBufPosn := FTail - BytesBack - else - FBufPosn := longint(FTail) + FBufSize - BytesBack; - {return the new position} - Result := Posn; -end; -{====================================================================} - - -end. diff --git a/components/Abbrevia/source/AbBrowse.pas b/components/Abbrevia/source/AbBrowse.pas deleted file mode 100644 index 21e2347..0000000 --- a/components/Abbrevia/source/AbBrowse.pas +++ /dev/null @@ -1,602 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbBrowse.pas *} -{*********************************************************} -{* ABBREVIA: Base Browser Component *} -{*********************************************************} - -unit AbBrowse; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbBase, - AbUtils, - AbArcTyp; - -type - IAbProgressMeter = interface - ['{4B766704-FD20-40BF-BA40-2EC2DD77B178}'] - procedure DoProgress(Progress : Byte); - procedure Reset; - end; - - TAbBaseBrowser = class(TAbBaseComponent) - public - FArchive : TAbArchive; - protected {private} - FSpanningThreshold : Longint; - FItemProgressMeter : IAbProgressMeter; - FArchiveProgressMeter : IAbProgressMeter; - FBaseDirectory : string; - FFileName : string; - FLogFile : string; - FLogging : Boolean; - FOnArchiveProgress : TAbArchiveProgressEvent; - FOnArchiveItemProgress : TAbArchiveItemProgressEvent; - FOnChange : TNotifyEvent; - FOnConfirmProcessItem : TAbArchiveItemConfirmEvent; - FOnLoad : TAbArchiveEvent; - FOnProcessItemFailure : TAbArchiveItemFailureEvent; - FOnRequestImage : TAbRequestImageEvent; - FTempDirectory : string; - - { detected compression type } - FArchiveType : TAbArchiveType; - FForceType : Boolean; - - protected {private methods} - function GetCount : Integer; - function GetItem(Value : Longint) : TAbArchiveItem; - function GetSpanned : Boolean; - function GetStatus : TAbArchiveStatus; - procedure ResetMeters; virtual; - procedure SetArchiveProgressMeter(const Value: IAbProgressMeter); - procedure SetCompressionType(const Value: TAbArchiveType); - procedure SetBaseDirectory(const Value : string); - procedure SetItemProgressMeter(const Value: IAbProgressMeter); - procedure SetSpanningThreshold(Value : Longint); - procedure SetLogFile(const Value : string); - procedure SetLogging(Value : Boolean); - procedure SetTempDirectory(const Value : string); - - procedure Loaded; override; - procedure Notification(Component: TComponent; - Operation: TOperation); override; - - protected {virtual methods} - procedure DoArchiveItemProgress(Sender : TObject; - Item : TAbArchiveItem; - Progress : Byte; - var Abort : Boolean); virtual; - procedure DoArchiveProgress(Sender : TObject; - Progress : Byte; - var Abort : Boolean); virtual; - procedure DoChange; virtual; - procedure DoConfirmProcessItem(Sender : TObject; - Item : TAbArchiveItem; - ProcessType : TAbProcessType; - var Confirm : Boolean); virtual; - procedure DoLoad(Sender : TObject); virtual; - procedure DoProcessItemFailure(Sender : TObject; - Item : TAbArchiveItem; - ProcessType : TAbProcessType; - ErrorClass : TAbErrorClass; - ErrorCode : Integer); virtual; - procedure SetOnRequestImage(Value : TAbRequestImageEvent); virtual; - procedure InitArchive; virtual; - - {This method must be defined in descendent classes} - procedure SetFileName(const aFileName : string); virtual; abstract; - - - protected {properties} - property Archive : TAbArchive - read FArchive; - property ArchiveProgressMeter : IAbProgressMeter - read FArchiveProgressMeter - write SetArchiveProgressMeter; - property BaseDirectory : string - read FBaseDirectory - write SetBaseDirectory; - property FileName : string - read FFileName - write SetFileName; - property SpanningThreshold : Longint - read FSpanningThreshold - write SetSpanningThreshold - default 0; - property ItemProgressMeter : IAbProgressMeter - read FItemProgressMeter - write SetItemProgressMeter; - property LogFile : string - read FLogFile - write SetLogFile; - property Logging : Boolean - read FLogging - write SetLogging - default False; - property Spanned : Boolean - read GetSpanned; - property TempDirectory : string - read FTempDirectory - write SetTempDirectory; - - - - protected {events} - property OnArchiveProgress : TAbArchiveProgressEvent - read FOnArchiveProgress - write FOnArchiveProgress; - property OnArchiveItemProgress : TAbArchiveItemProgressEvent - read FOnArchiveItemProgress - write FOnArchiveItemProgress; - property OnConfirmProcessItem : TAbArchiveItemConfirmEvent - read FOnConfirmProcessItem - write FOnConfirmProcessItem; - property OnProcessItemFailure : TAbArchiveItemFailureEvent - read FOnProcessItemFailure - write FOnProcessItemFailure; - property OnRequestImage : TAbRequestImageEvent - read FOnRequestImage - write SetOnRequestImage; - - public {methods} - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - - procedure ClearTags; - {Clear all tags from the archive} - function FindItem(aItem : TAbArchiveItem) : Integer; - function FindFile(const aFileName : string) : Integer; - procedure TagItems(const FileMask : string); - {tag all items that match the mask} - procedure UnTagItems(const FileMask : string); - {clear tags for all items that match the mask} - procedure CloseArchive; - {closes the archive by setting FileName to ''} - procedure OpenArchive(const aFileName : string); - {opens the archive} - - public {properties} - property Count : Integer - read GetCount; - property Items[Index : Integer] : TAbArchiveItem - read GetItem; default; - property Status : TAbArchiveStatus - read GetStatus; - - property ArchiveType : TAbArchiveType - read FArchiveType - write SetCompressionType - default atUnknown; - - property ForceType : Boolean - read FForceType - write FForceType - default False; - - public {events} - property OnChange : TNotifyEvent - read FOnChange - write FOnChange; - property OnLoad : TAbArchiveEvent - read FOnLoad - write FOnLoad; - end; - -function AbDetermineArcType(const FN : string; AssertType : TAbArchiveType) : TAbArchiveType; overload; -function AbDetermineArcType(aStream: TStream) : TAbArchiveType; overload; - -implementation - -uses - SysUtils, - AbExcept, -{$IFDEF MSWINDOWS} - AbCabTyp, -{$ENDIF} - AbZipTyp, - AbTarTyp, - AbGzTyp, - AbBzip2Typ; - -{ TAbBaseBrowser implementation ======================================= } - -{ -------------------------------------------------------------------------- } -constructor TAbBaseBrowser.Create(AOwner : TComponent); -begin - inherited Create(AOwner); - FLogFile := ''; - FLogging := False; - FSpanningThreshold := 0; - - FArchiveType := atUnknown; - FForceType := False; -end; -{ -------------------------------------------------------------------------- } -destructor TAbBaseBrowser.Destroy; -begin - FArchive.Free; - FArchive := nil; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.ClearTags; - {Clear all tags from the archive} -begin - if Assigned(FArchive) then - FArchive.ClearTags - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.CloseArchive; - {closes the archive by setting FileName to ''} -begin - if FFileName <> '' then - FileName := ''; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.DoArchiveItemProgress(Sender : TObject; - Item : TAbArchiveItem; - Progress : Byte; - var Abort : Boolean); -begin - Abort := False; - if Assigned(FItemProgressMeter) then - FItemProgressMeter.DoProgress(Progress); - if Assigned(FOnArchiveItemProgress) then - FOnArchiveItemProgress(Self, Item, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.DoArchiveProgress(Sender : TObject; - Progress : Byte; - var Abort : Boolean); -begin - Abort := False; - if Assigned(FArchiveProgressMeter) then - FArchiveProgressMeter.DoProgress(Progress); - if Assigned(FOnArchiveProgress) then - FOnArchiveProgress(Self, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.DoChange; -begin - if Assigned(FOnChange) then begin - FOnChange(Self); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.DoConfirmProcessItem(Sender : TObject; - Item : TAbArchiveItem; - ProcessType : TAbProcessType; - var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FItemProgressMeter) then - FItemProgressMeter.Reset; - if Assigned(FOnConfirmProcessItem) then - FOnConfirmProcessItem(Self, Item, ProcessType, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.DoLoad(Sender : TObject); -begin - if Assigned(FOnLoad) then - FOnLoad(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.DoProcessItemFailure(Sender : TObject; - Item : TAbArchiveItem; - ProcessType : TAbProcessType; - ErrorClass : TAbErrorClass; - ErrorCode : Integer); -begin - if Assigned(FOnProcessItemFailure) then - FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode); -end; -{ -------------------------------------------------------------------------- } -function TAbBaseBrowser.FindItem(aItem : TAbArchiveItem) : Integer; -begin - if Assigned(FArchive) then - Result := FArchive.FindItem(aItem) - else - Result := -1; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseBrowser.FindFile(const aFileName : string) : Integer; -begin - if Assigned(FArchive) then - Result := FArchive.FindFile(aFileName) - else - Result := -1; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseBrowser.GetSpanned : Boolean; -begin - if Assigned(FArchive) then - Result := FArchive.Spanned - else - Result := False; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseBrowser.GetStatus : TAbArchiveStatus; -begin - if Assigned(FArchive) then - Result := FArchive.Status - else - Result := asInvalid; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseBrowser.GetCount : Integer; -begin - if Assigned(FArchive) then - Result := FArchive.Count - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseBrowser.GetItem(Value : Longint) : TAbArchiveItem; -begin - if Assigned(FArchive) then - Result := FArchive.ItemList[Value] - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.InitArchive; -begin - ResetMeters; - if Assigned(FArchive) then begin - {properties} - FArchive.SpanningThreshold := FSpanningThreshold; - FArchive.LogFile := FLogFile; - FArchive.Logging := FLogging; - FArchive.TempDirectory := FTempDirectory; - SetBaseDirectory(FBaseDirectory); - {events} - FArchive.OnArchiveProgress := DoArchiveProgress; - FArchive.OnArchiveItemProgress := DoArchiveItemProgress; - FArchive.OnConfirmProcessItem := DoConfirmProcessItem; - FArchive.OnLoad := DoLoad; - FArchive.OnProcessItemFailure := DoProcessItemFailure; - FArchive.OnRequestImage := FOnRequestImage; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.Loaded; -begin - inherited Loaded; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.Notification(Component: TComponent; - Operation: TOperation); -begin - inherited Notification(Component, Operation); - if (Operation = opRemove) then begin - if Assigned(ItemProgressMeter) and Component.IsImplementorOf(ItemProgressMeter) then - ItemProgressMeter := nil; - if Assigned(ArchiveProgressMeter) and Component.IsImplementorOf(ArchiveProgressMeter) then - ArchiveProgressMeter := nil; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.OpenArchive(const aFileName : string); - {opens the archive} -begin - FileName := AFileName; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.ResetMeters; -begin - if Assigned(FArchiveProgressMeter) then - FArchiveProgressMeter.Reset; - if Assigned(FItemProgressMeter) then - FItemProgressMeter.Reset; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetBaseDirectory(const Value : string); -begin - if Assigned(FArchive) then begin - FArchive.BaseDirectory := Value; - FBaseDirectory := FArchive.BaseDirectory; - end else - FBaseDirectory := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetSpanningThreshold(Value : Longint); -begin - FSpanningThreshold := Value; - if Assigned(FArchive) then - FArchive.SpanningThreshold := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetLogFile(const Value : string); -begin - FLogFile := Value; - if (csDesigning in ComponentState) then - Exit; - if Assigned(FArchive) then - FArchive.LogFile := Value; - SetLogging(Value <> ''); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetLogging(Value : Boolean); -begin - FLogging := Value; - if (csDesigning in ComponentState) then - Exit; - if Assigned(FArchive) then - FArchive.Logging:= Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetOnRequestImage(Value : TAbRequestImageEvent); -begin - FOnRequestImage := Value; - if Assigned(FArchive) then - FArchive.OnRequestImage := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetTempDirectory(const Value : string); -begin - FTempDirectory := Value; - if Assigned(FArchive) then - FArchive.TempDirectory := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.TagItems(const FileMask : string); - {tag all items that match the mask} -begin - if Assigned(FArchive) then - FArchive.TagItems(FileMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.UnTagItems(const FileMask : string); - {clear tags for all items that match the mask} -begin - if Assigned(FArchive) then - FArchive.UnTagItems(FileMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetCompressionType(const Value: TAbArchiveType); -begin - if not Assigned(FArchive) or (Status <> asInvalid) then - FArchiveType := Value - else - raise EAbArchiveBusy.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetArchiveProgressMeter(const Value: IAbProgressMeter); -begin - ReferenceInterface(FArchiveProgressMeter, opRemove); - FArchiveProgressMeter := Value; - ReferenceInterface(FArchiveProgressMeter, opInsert); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseBrowser.SetItemProgressMeter(const Value: IAbProgressMeter); -begin - ReferenceInterface(FItemProgressMeter, opRemove); - FItemProgressMeter := Value; - ReferenceInterface(FItemProgressMeter, opInsert); -end; -{ -------------------------------------------------------------------------- } -function AbDetermineArcType(const FN : string; AssertType : TAbArchiveType) : TAbArchiveType; -var - Ext : string; - FS : TFileStream; -begin - Result := AssertType; - if Result = atUnknown then begin - { Guess archive type based on it's extension } - Ext := UpperCase(ExtractFileExt(FN)); - if (Ext = '.ZIP') or (Ext = '.JAR') then - Result := atZip; - if (Ext = '.EXE') then - Result := atSelfExtZip; - if (Ext = '.TAR') then - Result := atTar; - if (Ext = '.GZ') then - Result := atGzip; - if (Ext = '.TGZ') then - Result := atGzippedTar; - if (Ext = '.CAB') then - Result := atCab; - if (Ext = '.BZ2') then - Result := atBzip2; - if (Ext = '.TBZ') then - Result := atBzippedTar; - end; - {$IFNDEF MSWINDOWS} - if Result = atCab then - Result := atUnknown; - {$ENDIF} - if FileExists(FN) and (AbFileGetSize(FN) > 0) then begin - { If the file doesn't exist (or is empty) presume to make one, otherwise - guess or verify the contents } - FS := TFileStream.Create(FN, fmOpenRead or fmShareDenyNone); - try - if Result = atUnknown then - Result := AbDetermineArcType(FS) - else begin - case Result of - atZip : begin - Result := VerifyZip(FS); - end; - atSelfExtZip : begin - Result := VerifySelfExtracting(FS); - end; - atTar : begin - Result := VerifyTar(FS); - end; - atGzip, atGzippedTar: begin - Result := VerifyGzip(FS); - end; - {$IFDEF MSWINDOWS} - atCab : begin - Result := VerifyCab(FS); - end; - {$ENDIF} - atBzip2, atBzippedTar: begin - Result := VerifyBzip2(FS); - end; - end; - end; - finally - FS.Free; - end; - end; -end; -{ -------------------------------------------------------------------------- } -function AbDetermineArcType(aStream: TStream): TAbArchiveType; -begin - { VerifyZip returns true for self-extracting zips too, so test those first } - Result := VerifySelfExtracting(aStream); - if Result = atUnknown then - Result := VerifyZip(aStream); - if Result = atUnknown then - Result := VerifyTar(aStream); - if Result = atUnknown then - Result := VerifyGzip(aStream); - if Result = atUnknown then - Result := VerifyBzip2(aStream); - {$IFDEF MSWINDOWS} - if Result = atUnknown then - Result := VerifyCab(aStream); - {$ENDIF} -end; -{ -------------------------------------------------------------------------- } - - -end. diff --git a/components/Abbrevia/source/AbBseCLX.pas b/components/Abbrevia/source/AbBseCLX.pas deleted file mode 100644 index 29f1696..0000000 --- a/components/Abbrevia/source/AbBseCLX.pas +++ /dev/null @@ -1,54 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbBaseCLX.pas *} -{*********************************************************} -{* ABBREVIA: Base component class (CLX) *} -{*********************************************************} - -unit AbBseCLX; - -{$I AbDefine.inc} - -interface - -uses - Classes, - {$IFNDEF BuildingStub} - QControls, - {$ENDIF BuildingStub} - AbConst, - AbBase; - - -{$IFNDEF BuildingStub} -type - TAbBaseWinControl = class(TWidgetControl); -{$ENDIF BuildingStub} - -implementation - -end. diff --git a/components/Abbrevia/source/AbBseVCL.pas b/components/Abbrevia/source/AbBseVCL.pas deleted file mode 100644 index b169ac8..0000000 --- a/components/Abbrevia/source/AbBseVCL.pas +++ /dev/null @@ -1,53 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbBaseVCL.pas *} -{*********************************************************} -{* ABBREVIA: Base component class (VCL) *} -{*********************************************************} - -unit AbBseVCL; - -{$I AbDefine.inc} - -interface - -uses - Classes - {$IFNDEF BuildingStub} - , Controls - {$ENDIF BuildingStub} - ; - - -{$IFNDEF BuildingStub} -type - TAbBaseWinControl = class(TWinControl); -{$ENDIF BuildingStub} - -implementation - -end. diff --git a/components/Abbrevia/source/AbBzip2.pas b/components/Abbrevia/source/AbBzip2.pas deleted file mode 100644 index 89cf209..0000000 --- a/components/Abbrevia/source/AbBzip2.pas +++ /dev/null @@ -1,778 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * This program, "bzip2", the associated library "libbzip2", and all - * documentation, are copyright (C) 1996-2007 Julian R Seward. All - * rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * - * 2. The origin of this software must not be misrepresented; you must - * not claim that you wrote the original software. If you use this - * software in a product, an acknowledgment in the product - * documentation would be appreciated but is not required. - * - * 3. Altered source versions must be plainly marked as such, and must - * not be misrepresented as being the original software. - * - * 4. The name of the author may not be used to endorse or promote - * products derived from this software without specific prior written - * permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS - * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY - * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE - * GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING - * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS - * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - * - * Julian Seward, jseward@bzip.org - * bzip2/libbzip2 version 1.0.5 of 10 December 2007 - * - * Pascal wrapper created by Edison Mera, version 1.04 - * http://edisonlife.homelinux.com/ - * - * Dynamic and runtime linking and Win64/OS X/Linux support by Craig Peterson - * http://tpabbrevia.sourceforge.net/ - * ***** END LICENSE BLOCK ***** *) - -unit AbBzip2; - -{$I AbDefine.inc} - -interface - -uses - SysUtils, Classes; - -type - TAlloc = function(opaque: Pointer; Items, Size: Integer): Pointer; cdecl; - TFree = procedure(opaque, Block: Pointer); cdecl; - - // Internal structure. Ignore. - TBZStreamRec = record - next_in: PByte; // next input byte - avail_in: Integer; // number of bytes available at next_in - total_in_lo32: Integer; // total nb of input bytes read so far - total_in_hi32: Integer; - - next_out: PByte; // next output byte should be put here - avail_out: Integer; // remaining free space at next_out - total_out_lo32: Integer; // total nb of bytes output so far - total_out_hi32: Integer; - - state: Pointer; - - bzalloc: TAlloc; // used to allocate the internal state - bzfree: TFree; // used to free the internal state - opaque: Pointer; - end; - - // Abstract ancestor class - TCustomBZip2Stream = class(TStream) - private - FStrm: TStream; - FStrmPos: Int64; - FOnProgress: TNotifyEvent; - FBZRec: TBZStreamRec; - FBuffer: array[Word] of Byte; - protected - procedure Progress(Sender: TObject); dynamic; - property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; - constructor Create(Strm: TStream); - end; - -{ TBZCompressionStream compresses data on the fly as data is written to it, and - stores the compressed data to another stream. - - TBZCompressionStream is write-only and strictly sequential. Reading from the - stream will raise an exception. Using Seek to move the stream pointer - will raise an exception. - - Output data is cached internally, written to the output stream only when - the internal output buffer is full. All pending output data is flushed - when the stream is destroyed. - - The Position property returns the number of uncompressed bytes of - data that have been written to the stream so far. - - CompressionRate returns the on-the-fly percentage by which the original - data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100 - If raw data size = 100 and compressed data size = 25, the CompressionRate - is 75% - - The OnProgress event is called each time the output buffer is filled and - written to the output stream. This is useful for updating a progress - indicator when you are writing a large chunk of data to the compression - stream in a single call.} - - - TBlockSize100k = (bs1, bs2, bs3, bs4, bs5, bs6, bs7, bs8, bs9); - - TBZCompressionStream = class(TCustomBZip2Stream) - private - function GetCompressionRate: Single; - public - constructor Create(BlockSize100k: TBlockSize100k; Dest: TStream); - destructor Destroy; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - property CompressionRate: Single read GetCompressionRate; - property OnProgress; - end; - -{ TDecompressionStream decompresses data on the fly as data is read from it. - - Compressed data comes from a separate source stream. TDecompressionStream - is read-only and unidirectional; you can seek forward in the stream, but not - backwards. The special case of setting the stream position to zero is - allowed. Seeking forward decompresses data until the requested position in - the uncompressed data has been reached. Seeking backwards, seeking relative - to the end of the stream, requesting the size of the stream, and writing to - the stream will raise an exception. - - The Position property returns the number of bytes of uncompressed data that - have been read from the stream so far. - - The OnProgress event is called each time the internal input buffer of - compressed data is exhausted and the next block is read from the input stream. - This is useful for updating a progress indicator when you are reading a - large chunk of data from the decompression stream in a single call.} - - TBZDecompressionStream = class(TCustomBZip2Stream) - public - constructor Create(Source: TStream); - destructor Destroy; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - property OnProgress; - end; - -{ CompressBuf compresses data, buffer to buffer, in one call. - In: InBuf = ptr to compressed data - InBytes = number of bytes in InBuf - Out: OutBuf = ptr to newly allocated buffer containing decompressed data - OutBytes = number of bytes in OutBuf } -procedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer; - out OutBuf: Pointer; out OutBytes: Integer); - - -{ DecompressBuf decompresses data, buffer to buffer, in one call. - In: InBuf = ptr to compressed data - InBytes = number of bytes in InBuf - OutEstimate = zero, or est. size of the decompressed data - Out: OutBuf = ptr to newly allocated buffer containing decompressed data - OutBytes = number of bytes in OutBuf } -procedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer; - OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); - - -type - EBZip2Error = class(Exception); - EBZCompressionError = class(EBZip2Error); - EBZDecompressionError = class(EBZip2Error); - -implementation - -// Compile for Win64 using MSVC -// \bin\x86_amd64\cl.exe -c -nologo -GS- -Z7 -wd4086 -Gs32768 -// -DBZ_NO_STDIO blocksort.c huffman.c compress.c decompress.c bzlib.c - -uses -{$IFDEF Bzip2Runtime} -{$IF DEFINED(FPC)} - dynlibs, -{$ELSEIF DEFINED(MSWINDOWS)} - Windows, -{$IFEND} -{$ENDIF} - AbUtils; - -{$IFDEF Bzip2Static} -{$IF DEFINED(WIN32)} - {$L Win32\blocksort.obj} - {$L Win32\huffman.obj} - {$L Win32\compress.obj} - {$L Win32\decompress.obj} - {$L Win32\bzlib.obj} -{$ELSEIF DEFINED(WIN64)} - {$L Win64\blocksort.obj} - {$L Win64\huffman.obj} - {$L Win64\compress.obj} - {$L Win64\decompress.obj} - {$L Win64\bzlib.obj} -{$IFEND} - -procedure BZ2_hbMakeCodeLengths; external; -procedure BZ2_blockSort; external; -procedure BZ2_hbCreateDecodeTables; external; -procedure BZ2_hbAssignCodes; external; -procedure BZ2_compressBlock; external; -procedure BZ2_decompress; external; -{$ENDIF} - -type - TLargeInteger = record - case Integer of - 0: ( - LowPart: LongWord; - HighPart: LongWord); - 1: ( - QuadPart: Int64); - end; - -const - BZ_RUN = 0; - BZ_FLUSH = 1; - BZ_FINISH = 2; - BZ_OK = 0; - BZ_RUN_OK = 1; - BZ_FLUSH_OK = 2; - BZ_FINISH_OK = 3; - BZ_STREAM_END = 4; - BZ_SEQUENCE_ERROR = (-1); - BZ_PARAM_ERROR = (-2); - BZ_MEM_ERROR = (-3); - BZ_DATA_ERROR = (-4); - BZ_DATA_ERROR_MAGIC = (-5); - BZ_IO_ERROR = (-6); - BZ_UNEXPECTED_EOF = (-7); - BZ_OUTBUFF_FULL = (-8); - - BZ_BLOCK_SIZE_100K = 9; - -{$IFDEF Bzip2Static} - BZ2_rNums: array[0..511] of Longint = ( - 619, 720, 127, 481, 931, 816, 813, 233, 566, 247, - 985, 724, 205, 454, 863, 491, 741, 242, 949, 214, - 733, 859, 335, 708, 621, 574, 73, 654, 730, 472, - 419, 436, 278, 496, 867, 210, 399, 680, 480, 51, - 878, 465, 811, 169, 869, 675, 611, 697, 867, 561, - 862, 687, 507, 283, 482, 129, 807, 591, 733, 623, - 150, 238, 59, 379, 684, 877, 625, 169, 643, 105, - 170, 607, 520, 932, 727, 476, 693, 425, 174, 647, - 73, 122, 335, 530, 442, 853, 695, 249, 445, 515, - 909, 545, 703, 919, 874, 474, 882, 500, 594, 612, - 641, 801, 220, 162, 819, 984, 589, 513, 495, 799, - 161, 604, 958, 533, 221, 400, 386, 867, 600, 782, - 382, 596, 414, 171, 516, 375, 682, 485, 911, 276, - 98, 553, 163, 354, 666, 933, 424, 341, 533, 870, - 227, 730, 475, 186, 263, 647, 537, 686, 600, 224, - 469, 68, 770, 919, 190, 373, 294, 822, 808, 206, - 184, 943, 795, 384, 383, 461, 404, 758, 839, 887, - 715, 67, 618, 276, 204, 918, 873, 777, 604, 560, - 951, 160, 578, 722, 79, 804, 96, 409, 713, 940, - 652, 934, 970, 447, 318, 353, 859, 672, 112, 785, - 645, 863, 803, 350, 139, 93, 354, 99, 820, 908, - 609, 772, 154, 274, 580, 184, 79, 626, 630, 742, - 653, 282, 762, 623, 680, 81, 927, 626, 789, 125, - 411, 521, 938, 300, 821, 78, 343, 175, 128, 250, - 170, 774, 972, 275, 999, 639, 495, 78, 352, 126, - 857, 956, 358, 619, 580, 124, 737, 594, 701, 612, - 669, 112, 134, 694, 363, 992, 809, 743, 168, 974, - 944, 375, 748, 52, 600, 747, 642, 182, 862, 81, - 344, 805, 988, 739, 511, 655, 814, 334, 249, 515, - 897, 955, 664, 981, 649, 113, 974, 459, 893, 228, - 433, 837, 553, 268, 926, 240, 102, 654, 459, 51, - 686, 754, 806, 760, 493, 403, 415, 394, 687, 700, - 946, 670, 656, 610, 738, 392, 760, 799, 887, 653, - 978, 321, 576, 617, 626, 502, 894, 679, 243, 440, - 680, 879, 194, 572, 640, 724, 926, 56, 204, 700, - 707, 151, 457, 449, 797, 195, 791, 558, 945, 679, - 297, 59, 87, 824, 713, 663, 412, 693, 342, 606, - 134, 108, 571, 364, 631, 212, 174, 643, 304, 329, - 343, 97, 430, 751, 497, 314, 983, 374, 822, 928, - 140, 206, 73, 263, 980, 736, 876, 478, 430, 305, - 170, 514, 364, 692, 829, 82, 855, 953, 676, 246, - 369, 970, 294, 750, 807, 827, 150, 790, 288, 923, - 804, 378, 215, 828, 592, 281, 565, 555, 710, 82, - 896, 831, 547, 261, 524, 462, 293, 465, 502, 56, - 661, 821, 976, 991, 658, 869, 905, 758, 745, 193, - 768, 550, 608, 933, 378, 286, 215, 979, 792, 961, - 61, 688, 793, 644, 986, 403, 106, 366, 905, 644, - 372, 567, 466, 434, 645, 210, 389, 550, 919, 135, - 780, 773, 635, 389, 707, 100, 626, 958, 165, 504, - 920, 176, 193, 713, 857, 265, 203, 50, 668, 108, - 645, 990, 626, 197, 510, 357, 358, 850, 858, 364, - 936, 638 - ); - - BZ2_crc32Table: array[0..255] of Longint = ( - $00000000, $04C11DB7, $09823B6E, $0D4326D9, - $130476DC, $17C56B6B, $1A864DB2, $1E475005, - $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61, - $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD, - $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9, - $5F15ADAC, $5BD4B01B, $569796C2, $52568B75, - $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011, - $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD, - -$67DC4920, -$631D54A9, -$6E5E7272, -$6A9F6FC7, - -$74D83FC4, -$70192275, -$7D5A04AE, -$799B191B, - -$41D4A4A8, -$4515B911, -$48569FCA, -$4C97827F, - -$52D0D27C, -$5611CFCD, -$5B52E916, -$5F93F4A3, - -$2BCD9270, -$2F0C8FD9, -$224FA902, -$268EB4B7, - -$38C9E4B4, -$3C08F905, -$314BDFDE, -$358AC26B, - -$0DC57FD8, -$09046261, -$044744BA, -$0086590F, - -$1EC1090C, -$1A0014BD, -$17433266, -$13822FD3, - $34867077, $30476DC0, $3D044B19, $39C556AE, - $278206AB, $23431B1C, $2E003DC5, $2AC12072, - $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16, - $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA, - $7897AB07, $7C56B6B0, $71159069, $75D48DDE, - $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02, - $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066, - $4D9B3063, $495A2DD4, $44190B0D, $40D816BA, - -$535A3969, -$579B24E0, -$5AD80207, -$5E191FB2, - -$405E4FB5, -$449F5204, -$49DC74DB, -$4D1D696E, - -$7552D4D1, -$7193C968, -$7CD0EFBF, -$7811F20A, - -$6656A20D, -$6297BFBC, -$6FD49963, -$6B1584D6, - -$1F4BE219, -$1B8AFFB0, -$16C9D977, -$1208C4C2, - -$0C4F94C5, -$088E8974, -$05CDAFAB, -$010CB21E, - -$39430FA1, -$3D821218, -$30C134CF, -$3400297A, - -$2A47797D, -$2E8664CC, -$23C54213, -$27045FA6, - $690CE0EE, $6DCDFD59, $608EDB80, $644FC637, - $7A089632, $7EC98B85, $738AAD5C, $774BB0EB, - $4F040D56, $4BC510E1, $46863638, $42472B8F, - $5C007B8A, $58C1663D, $558240E4, $51435D53, - $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47, - $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B, - $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF, - $1011A0FA, $14D0BD4D, $19939B94, $1D528623, - -$0ED0A9F2, -$0A11B447, -$075292A0, -$03938F29, - -$1DD4DF2E, -$1915C29B, -$1456E444, -$1097F9F5, - -$28D8444A, -$2C1959FF, -$215A7F28, -$259B6291, - -$3BDC3296, -$3F1D2F23, -$325E09FC, -$369F144D, - -$42C17282, -$46006F37, -$4B4349F0, -$4F825459, - -$51C5045E, -$550419EB, -$58473F34, -$5C862285, - -$64C99F3A, -$6008828F, -$6D4BA458, -$698AB9E1, - -$77CDE9E6, -$730CF453, -$7E4FD28C, -$7A8ECF3D, - $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640, - $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C, - $7B827D21, $7F436096, $7200464F, $76C15BF8, - $68860BFD, $6C47164A, $61043093, $65C52D24, - $119B4BE9, $155A565E, $18197087, $1CD86D30, - $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC, - $3793A651, $3352BBE6, $3E119D3F, $3AD08088, - $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654, - -$3A56D987, -$3E97C432, -$33D4E2E9, -$3715FF60, - -$2952AF5B, -$2D93B2EE, -$20D09435, -$24118984, - -$1C5E343F, -$189F298A, -$15DC0F51, -$111D12E8, - -$0F5A42E3, -$0B9B5F56, -$06D8798D, -$0219643C, - -$764702F7, -$72861F42, -$7FC53999, -$7B042430, - -$6543742B, -$6182699E, -$6CC14F45, -$680052F4, - -$504FEF4F, -$548EF2FA, -$59CDD421, -$5D0CC998, - -$434B9993, -$478A8426, -$4AC9A2FD, -$4E08BF4C - ); - -procedure bz_internal_error(errcode: Integer); cdecl; -begin - raise EBZip2Error.CreateFmt('Compression Error %d', [errcode]); -end; { _bz_internal_error } - -function malloc(size: Integer): Pointer; cdecl; -begin - GetMem(Result, Size); -end; { _malloc } - -procedure free(block: Pointer); cdecl; -begin - FreeMem(block); -end; { _free } -{$ENDIF} - -const - libbz2 = {$IF DEFINED(MSWINDOWS)}'libbz2.dll' - {$ELSEIF DEFINED(DARWIN)}'libbz2.dylib' - {$ELSE}'libbz2.so.1'{$IFEND}; - -{$IFDEF Bzip2Runtime} -var - hBzip2: HMODULE; - // deflate compresses data - BZ2_bzCompressInit: function(var strm: TBZStreamRec; blockSize100k: Integer; - verbosity: Integer; workFactor: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} - BZ2_bzCompress: function(var strm: TBZStreamRec; action: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} - BZ2_bzCompressEnd: function (var strm: TBZStreamRec): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} - BZ2_bzBuffToBuffCompress: function(dest: Pointer; var destLen: Integer; - source: Pointer; sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} - // inflate decompresses data - BZ2_bzDecompressInit: function(var strm: TBZStreamRec; verbosity: Integer; - small: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} - BZ2_bzDecompress: function(var strm: TBZStreamRec): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} - BZ2_bzDecompressEnd: function(var strm: TBZStreamRec): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} - BZ2_bzBuffToBuffDecompress: function(dest: Pointer; var destLen: Integer; - source: Pointer; sourceLen, small, verbosity: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -{$ELSE} -// deflate compresses data -function BZ2_bzCompressInit(var strm: TBZStreamRec; blockSize100k: Integer; - verbosity: Integer; workFactor: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzCompressInit'{$ENDIF}; - -function BZ2_bzCompress(var strm: TBZStreamRec; action: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzCompress'{$ENDIF}; - -function BZ2_bzCompressEnd(var strm: TBZStreamRec): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzCompressEnd'{$ENDIF}; - -function BZ2_bzBuffToBuffCompress(dest: Pointer; var destLen: Integer; source: Pointer; - sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzBuffToBuffCompress'{$ENDIF}; - -// inflate decompresses data -function BZ2_bzDecompressInit(var strm: TBZStreamRec; verbosity: Integer; - small: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzDecompressInit'{$ENDIF}; - -function BZ2_bzDecompress(var strm: TBZStreamRec): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzDecompress'{$ENDIF}; - -function BZ2_bzDecompressEnd(var strm: TBZStreamRec): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzDecompressEnd'{$ENDIF}; - -function BZ2_bzBuffToBuffDecompress(dest: Pointer; var destLen: Integer; source: Pointer; - sourceLen, small, verbosity: Integer): Integer; - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF} - {$IFDEF DARWIN}name '_BZ2_bzBuffToBuffDecompress'{$ENDIF}; -{$ENDIF} - -procedure LoadBzip2DLL; -begin - {$IFDEF Bzip2Runtime} - if hBzip2 <> 0 then - Exit; - hBzip2 := LoadLibrary(libbz2); - if hBzip2 = 0 then - raise EBZip2Error.Create('Bzip2 shared library not found'); - @BZ2_bzCompressInit := GetProcAddress(hBzip2, 'BZ2_bzCompressInit'); - @BZ2_bzCompress := GetProcAddress(hBzip2, 'BZ2_bzCompress'); - @BZ2_bzCompressEnd := GetProcAddress(hBzip2, 'BZ2_bzCompressEnd'); - @BZ2_bzBuffToBuffCompress := GetProcAddress(hBzip2, 'BZ2_bzBuffToBuffCompress'); - @BZ2_bzDecompressInit := GetProcAddress(hBzip2, 'BZ2_bzDecompressInit'); - @BZ2_bzDecompress := GetProcAddress(hBzip2, 'BZ2_bzDecompress'); - @BZ2_bzDecompressEnd := GetProcAddress(hBzip2, 'BZ2_bzDecompressEnd'); - @BZ2_bzBuffToBuffDecompress := GetProcAddress(hBzip2, 'BZ2_bzBuffToBuffDecompress'); - {$ENDIF} -end; - -function bzip2AllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl; -begin - GetMem(Result, Items * Size); -end; { bzip2AllocMem } - -procedure bzip2FreeMem(AppData, Block: Pointer); cdecl; -begin - FreeMem(Block); -end; { bzip2FreeMem } - -function CCheck(code: Integer): Integer; -begin - Result := code; - if code < 0 then - raise EBZCompressionError.CreateFmt('error %d', [code]); //!! -end; { CCheck } - -function DCheck(code: Integer): Integer; -begin - Result := code; - if code < 0 then - raise EBZDecompressionError.CreateFmt('error %d', [code]); //!! -end; { DCheck } - -procedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer; - out OutBuf: Pointer; out OutBytes: Integer); -var - strm: TBZStreamRec; - P: Pointer; -begin - LoadBzip2DLL; - FillChar(strm, sizeof(strm), 0); - strm.bzalloc := bzip2AllocMem; - strm.bzfree := bzip2FreeMem; - OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; - GetMem(OutBuf, OutBytes); - try - strm.next_in := InBuf; - strm.avail_in := InBytes; - strm.next_out := OutBuf; - strm.avail_out := OutBytes; - CCheck(BZ2_bzCompressInit(strm, 9, 0, 0)); - try - while CCheck(BZ2_bzCompress(strm, BZ_FINISH)) <> BZ_STREAM_END do - begin - P := OutBuf; - Inc(OutBytes, 256); - ReallocMem(OutBuf, OutBytes); - strm.next_out := PByte(PtrInt(OutBuf) - + (PtrInt(strm.next_out) - PtrInt(P))); - strm.avail_out := 256; - end; - finally - CCheck(BZ2_bzCompressEnd(strm)); - end; - ReallocMem(OutBuf, strm.total_out_lo32); - OutBytes := strm.total_out_lo32; - except - FreeMem(OutBuf); - raise - end; -end; - -procedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer; - OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); -var - strm: TBZStreamRec; - P: Pointer; - BufInc: Integer; -begin - LoadBzip2DLL; - FillChar(strm, sizeof(strm), 0); - strm.bzalloc := bzip2AllocMem; - strm.bzfree := bzip2FreeMem; - BufInc := (InBytes + 255) and not 255; - if OutEstimate = 0 then - OutBytes := BufInc - else - OutBytes := OutEstimate; - GetMem(OutBuf, OutBytes); - try - strm.next_in := InBuf; - strm.avail_in := InBytes; - strm.next_out := OutBuf; - strm.avail_out := OutBytes; - DCheck(BZ2_bzDecompressInit(strm, 0, 0)); - try - while DCheck(BZ2_bzDecompress(strm)) <> BZ_STREAM_END do - begin - P := OutBuf; - Inc(OutBytes, BufInc); - ReallocMem(OutBuf, OutBytes); - strm.next_out := PByte(PtrInt(OutBuf) + (PtrInt(strm.next_out) - PtrInt(P))); - strm.avail_out := BufInc; - end; - finally - DCheck(BZ2_bzDecompressEnd(strm)); - end; - ReallocMem(OutBuf, strm.total_out_lo32); - OutBytes := strm.total_out_lo32; - except - FreeMem(OutBuf); - raise - end; -end; - -// TCustomBZip2Stream - -constructor TCustomBZip2Stream.Create(Strm: TStream); -begin - inherited Create; - FStrm := Strm; - FStrmPos := Strm.Position; - FBZRec.bzalloc := bzip2AllocMem; - FBZRec.bzfree := bzip2FreeMem; -end; - -procedure TCustomBZip2Stream.Progress(Sender: TObject); -begin - if Assigned(FOnProgress) then FOnProgress(Sender); -end; { TCustomBZip2Stream } - - -// TBZCompressionStream - -constructor TBZCompressionStream.Create(BlockSize100k: TBlockSize100k; Dest: TStream); -const - BlockSizes: array[TBlockSize100k] of ShortInt = (1, 2, 3, 4, 5, 6, 7, 8, 9); -begin - inherited Create(Dest); - LoadBzip2DLL; - FBZRec.next_out := @FBuffer[0]; - FBZRec.avail_out := sizeof(FBuffer); - CCheck(BZ2_bzCompressInit(FBZRec, BlockSizes[BlockSize100k], 0, 0)); -end; - -destructor TBZCompressionStream.Destroy; -begin - if FBZRec.state <> nil then begin - FBZRec.next_in := nil; - FBZRec.avail_in := 0; - try - if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; - while (CCheck(BZ2_bzCompress(FBZRec, BZ_FINISH)) <> BZ_STREAM_END) - and (FBZRec.avail_out = 0) do - begin - FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); - FBZRec.next_out := @FBuffer[0]; - FBZRec.avail_out := sizeof(FBuffer); - end; - if FBZRec.avail_out < sizeof(FBuffer) then - FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FBZRec.avail_out); - finally - BZ2_bzCompressEnd(FBZRec); - end; - end; - inherited Destroy; -end; - -function TBZCompressionStream.Read(var Buffer; Count: Longint): Longint; -begin - raise EBZCompressionError.Create('Invalid stream operation'); -end; { TBZCompressionStream } - -function TBZCompressionStream.Write(const Buffer; Count: Longint): Longint; -begin - FBZRec.next_in := @Buffer; - FBZRec.avail_in := Count; - if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; - while (FBZRec.avail_in > 0) do - begin - CCheck(BZ2_bzCompress(FBZRec, BZ_RUN)); - if FBZRec.avail_out = 0 then - begin - FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); - FBZRec.next_out := @FBuffer[0]; - FBZRec.avail_out := sizeof(FBuffer); - FStrmPos := FStrm.Position; - end; - Progress(Self); - end; - Result := Count; -end; { TBZCompressionStream } - -function TBZCompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -var - conv64 : TLargeInteger; -begin - if (Offset = 0) and (Origin = soCurrent) then begin - conv64.LowPart := FBZRec.total_in_lo32; - conv64.HighPart := FBZRec.total_in_hi32; - Result := conv64.QuadPart - end - else - raise EBZCompressionError.Create('Invalid stream operation'); -end; { TBZCompressionStream } - -function TBZCompressionStream.GetCompressionRate: Single; -var - conv64In : TLargeInteger; - conv64Out: TLargeInteger; -begin - conv64In.LowPart := FBZRec.total_in_lo32; - conv64In.HighPart := FBZRec.total_in_hi32; - conv64Out.LowPart := FBZRec.total_out_lo32; - conv64Out.HighPart := FBZRec.total_out_hi32; - - if conv64In.QuadPart = 0 then - Result := 0 - else - Result := (1.0 - (conv64Out.QuadPart / conv64In.QuadPart)) * 100.0; -end; { TBZCompressionStream } - -// TDecompressionStream - -constructor TBZDecompressionStream.Create(Source: TStream); -begin - inherited Create(Source); - LoadBzip2DLL; - FBZRec.next_in := @FBuffer[0]; - FBZRec.avail_in := 0; - DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0)); -end; - -destructor TBZDecompressionStream.Destroy; -begin - if FBZRec.state <> nil then - BZ2_bzDecompressEnd(FBZRec); - inherited Destroy; -end; - -function TBZDecompressionStream.Read(var Buffer; Count: Longint): Longint; -begin - FBZRec.next_out := @Buffer; - FBZRec.avail_out := Count; - if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; - while (FBZRec.avail_out > 0) do - begin - if FBZRec.avail_in = 0 then - begin - FBZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer)); - if FBZRec.avail_in = 0 then - begin - Result := Count - FBZRec.avail_out; - Exit; - end; - FBZRec.next_in := @FBuffer[0]; - FStrmPos := FStrm.Position; - end; - CCheck(BZ2_bzDecompress(FBZRec)); - Progress(Self); - end; - Result := Count; -end; { TBZDecompressionStream } - -function TBZDecompressionStream.Write(const Buffer; Count: Longint): Longint; -begin - raise EBZDecompressionError.Create('Invalid stream operation'); -end; { TBZDecompressionStream } - -function TBZDecompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -var - I : Integer; - Buf : array[0..4095] of Char; - conv64: TLargeInteger; - NewOff: Int64; -begin - conv64.LowPart := FBZRec.total_out_lo32; - conv64.HighPart := FBZRec.total_out_hi32; - - if (Offset = 0) and (Origin = soBeginning) then - begin - DCheck(BZ2_bzDecompressEnd(FBZRec)); - DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0)); - FBZRec.next_in := @FBuffer[0]; - FBZRec.avail_in := 0; - FStrm.Position := 0; - FStrmPos := 0; - end - else if ((Offset >= 0) and (Origin = soCurrent)) or - (((Offset - conv64.QuadPart) > 0) and (Origin = soBeginning)) then - begin - NewOff := Offset; - if Origin = soBeginning then Dec(NewOff, conv64.QuadPart); - if NewOff > 0 then - begin - for I := 1 to NewOff div sizeof(Buf) do - ReadBuffer(Buf, sizeof(Buf)); - ReadBuffer(Buf, NewOff mod sizeof(Buf)); - end; - end - else - raise EBZDecompressionError.Create('Invalid stream operation'); - Result := conv64.QuadPart; -end; { TBZDecompressionStream } - -end. diff --git a/components/Abbrevia/source/AbBzip2Typ.pas b/components/Abbrevia/source/AbBzip2Typ.pas deleted file mode 100644 index 965dfd0..0000000 --- a/components/Abbrevia/source/AbBzip2Typ.pas +++ /dev/null @@ -1,430 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * Joel Haynie - * Craig Peterson - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbBzip2Typ.pas *} -{*********************************************************} -{* ABBREVIA: TAbBzip2Archive, TAbBzip2Item classes *} -{*********************************************************} -{* Misc. constants, types, and routines for working *} -{* with Bzip2 files *} -{*********************************************************} - -unit AbBzip2Typ; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbArcTyp, AbTarTyp, AbUtils; - -const - { Default Stream Header for Bzip2s is 'BZhX', where X is the block size setting 1-9 in ASCII } - { Each block has the following header: '1AY&SY', and are in units of 100kilobytes NOT 100kibiBytes } - AB_BZIP2_FILE_HEADER = 'BZh'; - AB_BZIP2_BLOCK_SIZE = ['1','2','3','4','5','6','7','8','9']; - AB_BZIP2_BLOCK_HEADER = '1AY&SY'; { Note: $314159265359, BCD for Pi :) } - { Note that Blocks are bit aligned, as such the only time you will "for sure" see - the block header is on the start of stream/File } - AB_BZIP2_FILE_TAIL =#23#114#36#83#133#9#0; { $1772245385090, BCD for sqrt(Pi) :) } - { This is odd as the blocks are bit allgned so this is a string that is 13*4 bits = 52 bits } - -type - PAbBzip2Header = ^TAbBzip2Header; { File Header } - TAbBzip2Header = packed record { SizeOf(TAbBzip2Header) = 10 } - FileHeader : array[0..2] of AnsiChar;{ 'BZh'; $42,5A,68 } - BlockSize : AnsiChar; { '1'..'9'; $31-$39 } - BlockHeader : array[0..5] of AnsiChar;{ '1AY&SY'; $31,41,59,26,53,59 } - end; - -{ The Purpose for this Item is the placeholder for aaAdd and aaDelete Support. } -{ For all intents and purposes we could just use a TAbArchiveItem } -type - TAbBzip2Item = class(TabArchiveItem); - - TAbBzip2ArchiveState = (gsBzip2, gsTar); - - TAbBzip2Archive = class(TAbTarArchive) - private - FBzip2Stream : TStream; { stream for Bzip2 file} - FBzip2Item : TAbArchiveList; { item in bzip2 (only one, but need polymorphism of class)} - FTarStream : TStream; { stream for possible contained Tar } - FTarList : TAbArchiveList; { items in possible contained Tar } - FTarAutoHandle: Boolean; - FState : TAbBzip2ArchiveState; - FIsBzippedTar : Boolean; - - procedure DecompressToStream(aStream: TStream); - procedure SetTarAutoHandle(const Value: Boolean); - procedure SwapToBzip2; - procedure SwapToTar; - - protected - { Inherited Abstract functions } - function CreateItem(const FileSpec : string): TAbArchiveItem; override; - procedure ExtractItemAt(Index : Integer; const NewName : string); override; - procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream); override; - procedure LoadArchive; override; - procedure SaveArchive; override; - procedure TestItemAt(Index : Integer); override; - function GetSupportsEmptyFolders : Boolean; override; - - public {methods} - constructor CreateFromStream(aStream : TStream; const aArchiveName : string); override; - destructor Destroy; override; - - procedure DoSpanningMediaRequest(Sender : TObject; ImageNumber : Integer; - var ImageName : string; var Abort : Boolean); override; - - { Properties } - property TarAutoHandle : Boolean - read FTarAutoHandle write SetTarAutoHandle; - - property IsBzippedTar : Boolean - read FIsBzippedTar write FIsBzippedTar; - end; - -function VerifyBzip2(Strm : TStream) : TAbArchiveType; - -implementation - -uses -{$IFDEF MSWINDOWS} - Windows, // Fix inline warnings -{$ENDIF} - StrUtils, SysUtils, - AbBzip2, AbExcept, AbVMStrm, AbBitBkt; - -{ ****************** Helper functions Not from Classes Above ***************** } -function VerifyHeader(const Header : TAbBzip2Header) : Boolean; -begin - Result := (Header.FileHeader = AB_BZIP2_FILE_HEADER) and - (Header.BlockSize in AB_BZIP2_BLOCK_SIZE) and - (Header.BlockHeader = AB_BZIP2_BLOCK_HEADER); -end; -{ -------------------------------------------------------------------------- } -function VerifyBzip2(Strm : TStream) : TAbArchiveType; -var - Hdr : TAbBzip2Header; - CurPos : int64; - DecompStream, TarStream: TStream; -begin - Result := atUnknown; - - CurPos := Strm.Position; - Strm.Seek(0, soBeginning); - - try - if (Strm.Read(Hdr, SizeOf(Hdr)) = SizeOf(Hdr)) and VerifyHeader(Hdr) then begin - Result := atBzip2; - { Check for embedded TAR } - Strm.Seek(0, soBeginning); - DecompStream := TBZDecompressionStream.Create(Strm); - try - TarStream := TMemoryStream.Create; - try - TarStream.CopyFrom(DecompStream, 512 * 2); - TarStream.Seek(0, soBeginning); - if VerifyTar(TarStream) = atTar then - Result := atBzippedTar; - finally - TarStream.Free; - end; - finally - DecompStream.Free; - end; - end; - except - on EReadError do - Result := atUnknown; - end; - Strm.Position := CurPos; { Return to original position. } -end; - - -{ ****************************** TAbBzip2Archive ***************************** } -constructor TAbBzip2Archive.CreateFromStream(aStream: TStream; - const aArchiveName: string); -begin - inherited CreateFromStream(aStream, aArchiveName); - FState := gsBzip2; - FBzip2Stream := FStream; - FBzip2Item := FItemList; - FTarStream := TAbVirtualMemoryStream.Create; - FTarList := TAbArchiveList.Create(True); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.SwapToTar; -begin - FStream := FTarStream; - FItemList := FTarList; - FState := gsTar; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.SwapToBzip2; -begin - FStream := FBzip2Stream; - FItemList := FBzip2Item; - FState := gsBzip2; -end; -{ -------------------------------------------------------------------------- } -function TAbBzip2Archive.CreateItem(const FileSpec: string): TAbArchiveItem; -begin - if IsBzippedTar and TarAutoHandle then begin - SwapToTar; - Result := inherited CreateItem(FileSpec); - end - else begin - SwapToBzip2; - Result := TAbBzip2Item.Create; - try - Result.DiskFileName := ExpandFileName(FileSpec); - Result.FileName := FixName(FileSpec); - except - Result.Free; - raise; - end; - end; -end; -{ -------------------------------------------------------------------------- } -destructor TAbBzip2Archive.Destroy; -begin - SwapToBzip2; - FTarList.Free; - FTarStream.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.ExtractItemAt(Index: Integer; - const NewName: string); -var - OutStream : TFileStream; -begin - if IsBzippedTar and TarAutoHandle then begin - SwapToTar; - inherited ExtractItemAt(Index, NewName); - end - else begin - SwapToBzip2; - OutStream := TFileStream.Create(NewName, fmCreate or fmShareDenyNone); - try - try - ExtractItemToStreamAt(Index, OutStream); - finally - OutStream.Free; - end; - { Bz2 doesn't store the last modified time or attributes, so don't set them } - except - on E : EAbUserAbort do begin - FStatus := asInvalid; - if FileExists(NewName) then - DeleteFile(NewName); - raise; - end else begin - if FileExists(NewName) then - DeleteFile(NewName); - raise; - end; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.ExtractItemToStreamAt(Index: Integer; - aStream: TStream); -begin - if IsBzippedTar and TarAutoHandle then begin - SwapToTar; - inherited ExtractItemToStreamAt(Index, aStream); - end - else begin - SwapToBzip2; - { Index ignored as there's only one item in a Bz2 } - DecompressToStream(aStream); - end; -end; -{ -------------------------------------------------------------------------- } -function TAbBzip2Archive.GetSupportsEmptyFolders : Boolean; -begin - Result := IsBzippedTar and TarAutoHandle; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.LoadArchive; -var - Item: TAbBzip2Item; - Abort: Boolean; - ItemName: string; -begin - if FBzip2Stream.Size = 0 then - Exit; - - if IsBzippedTar and TarAutoHandle then begin - { Decompress and send to tar LoadArchive } - DecompressToStream(FTarStream); - SwapToTar; - inherited LoadArchive; - end - else begin - SwapToBzip2; - Item := TAbBzip2Item.Create; - Item.Action := aaNone; - { Filename isn't stored, so constuct one based on the archive name } - ItemName := ExtractFileName(ArchiveName); - if ItemName = '' then - Item.FileName := 'unknown' - else if AnsiEndsText('.tbz', ItemName) or AnsiEndsText('.tbz2', ItemName) then - Item.FileName := ChangeFileExt(ItemName, '.tar') - else - Item.FileName := ChangeFileExt(ItemName, ''); - Item.DiskFileName := Item.FileName; - FItemList.Add(Item); - end; - DoArchiveProgress(100, Abort); - FIsDirty := False; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.SaveArchive; -var - CompStream: TStream; - i: Integer; - CurItem: TAbBzip2Item; - InputFileStream: TStream; -begin - if IsBzippedTar and TarAutoHandle then - begin - SwapToTar; - inherited SaveArchive; - FTarStream.Position := 0; - FBzip2Stream.Size := 0; - CompStream := TBZCompressionStream.Create(bs9, FBzip2Stream); - try - CompStream.CopyFrom(FTarStream, 0); - finally - CompStream.Free; - end; - end - else begin - { Things we know: There is only one file per archive.} - { Actions we have to address in SaveArchive: } - { aaNone & aaMove do nothing, as the file does not change, only the meta data } - { aaDelete could make a zero size file unless there are two files in the list.} - { aaAdd, aaStreamAdd, aaFreshen, & aaReplace will be the only ones to take action. } - SwapToBzip2; - for i := 0 to pred(Count) do begin - FCurrentItem := ItemList[i]; - CurItem := TAbBzip2Item(ItemList[i]); - case CurItem.Action of - aaNone, aaMove: Break;{ Do nothing; bz2 doesn't store metadata } - aaDelete: ; {doing nothing omits file from new stream} - aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin - FBzip2Stream.Size := 0; - CompStream := TBZCompressionStream.Create(bs9, FBzip2Stream); - try - if CurItem.Action = aaStreamAdd then - CompStream.CopyFrom(InStream, 0){ Copy/compress entire Instream to FBzip2Stream } - else begin - InputFileStream := TFileStream.Create(CurItem.DiskFileName, fmOpenRead or fmShareDenyWrite ); - try - CompStream.CopyFrom(InputFileStream, 0);{ Copy/compress entire Instream to FBzip2Stream } - finally - InputFileStream.Free; - end; - end; - finally - CompStream.Free; - end; - Break; - end; { End aaAdd, aaFreshen, aaReplace, & aaStreamAdd } - end; { End of CurItem.Action Case } - end; { End Item for loop } - end; { End Tar Else } -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.SetTarAutoHandle(const Value: Boolean); -begin - if Value then - SwapToTar - else - SwapToBzip2; - FTarAutoHandle := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.DecompressToStream(aStream: TStream); -const - BufSize = $F000; -var - DecompStream: TBZDecompressionStream; - Buffer: PByte; - N: Integer; -begin - DecompStream := TBZDecompressionStream.Create(FBzip2Stream); - try - GetMem(Buffer, BufSize); - try - N := DecompStream.Read(Buffer^, BufSize); - while N > 0 do begin - aStream.WriteBuffer(Buffer^, N); - N := DecompStream.Read(Buffer^, BufSize); - end; - finally - FreeMem(Buffer, BufSize); - end; - finally - DecompStream.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.TestItemAt(Index: Integer); -var - Bzip2Type: TAbArchiveType; - BitBucket: TAbBitBucketStream; -begin - if IsBzippedTar and TarAutoHandle then begin - SwapToTar; - inherited TestItemAt(Index); - end - else begin - { note Index ignored as there's only one item in a GZip } - Bzip2Type := VerifyBzip2(FBzip2Stream); - if not (Bzip2Type in [atBzip2, atBzippedTar]) then - raise EAbGzipInvalid.Create;// TODO: Add bzip2-specific exceptions } - BitBucket := TAbBitBucketStream.Create(1024); - try - DecompressToStream(BitBucket); - finally - BitBucket.Free; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBzip2Archive.DoSpanningMediaRequest(Sender: TObject; - ImageNumber: Integer; var ImageName: string; var Abort: Boolean); -begin - Abort := False; -end; - -end. diff --git a/components/Abbrevia/source/AbCBrows.pas b/components/Abbrevia/source/AbCBrows.pas deleted file mode 100644 index a3aab98..0000000 --- a/components/Abbrevia/source/AbCBrows.pas +++ /dev/null @@ -1,238 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCBrows.pas *} -{*********************************************************} -{* ABBREVIA: Cabinet file browser component *} -{*********************************************************} - -unit AbCBrows; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbBrowse, - AbCabTyp; - -type - TAbCustomCabBrowser = class(TAbBaseBrowser) - protected {private} - FSetID : Word; - - function GetCabArchive : TAbCabArchive; - function GetCabSize : Longint; - function GetCurrentCab : Word; - function GetFolderCount : Word; - function GetItem(Index : Integer) : TAbCabItem; virtual; - function GetHasNext : Boolean; - function GetHasPrev : Boolean; - function GetSetID : Word; - procedure InitArchive; - override; - procedure SetFileName(const aFileName : string); override; - procedure SetSetID(Value : Word); - - protected {properties} - property CabSize : Longint - read GetCabSize; - property CurrentCab : Word - read GetCurrentCab; - property FolderCount : Word - read GetFolderCount; - property HasNext : Boolean - read GetHasNext; - property HasPrev : Boolean - read GetHasPrev; - property SetID : Word - read GetSetID - write SetSetID; - - public {methods} - constructor Create(AOwner : TComponent); - override; - destructor Destroy; - override; - - public {properties} - property CabArchive : TAbCabArchive - read GetCabArchive; - property Items[Index : Integer] : TAbCabItem - read GetItem; default; - end; - - -type - {$IFDEF HasPlatformsAttribute} - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - {$ENDIF} - TAbCabBrowser = class(TAbCustomCabBrowser) - published - property ArchiveProgressMeter; - property BaseDirectory; - property CabSize; - property CurrentCab; - property FolderCount; - property HasNext; - property HasPrev; - property ItemProgressMeter; - property LogFile; - property Logging; - property OnArchiveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnLoad; - property SetID; - property TempDirectory; - property Version; - property FileName; {must be after OnLoad} - end; - {.Z+} - - -implementation - -uses - SysUtils, - AbArcTyp, - AbUtils; - -{ TAbCustomCabBrowser ====================================================== } -constructor TAbCustomCabBrowser.Create(AOwner : TComponent); -begin - inherited Create(AOwner); - FArchiveType := atCab; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomCabBrowser.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetCabArchive : TAbCabArchive; -begin - if Assigned(Archive) then - Result := TAbCabArchive(Archive) - else - Result := nil; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetCabSize : Longint; -begin - if Assigned(Archive) then - Result := TAbCabArchive(Archive).CabSize - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetCurrentCab : Word; -begin - if Assigned(Archive) then - Result := TAbCabArchive(Archive).CurrentCab - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetFolderCount : Word; -begin - if Assigned(Archive) then - Result := TAbCabArchive(Archive).FolderCount - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetHasNext : Boolean; -begin - if Assigned(Archive) then - Result := TAbCabArchive(Archive).HasNext - else - Result := False; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetHasPrev : Boolean; -begin - if Assigned(Archive) then - Result := TAbCabArchive(Archive).HasPrev - else - Result := False; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetItem(Index : Integer) : TAbCabItem; - {return cabinet item} -begin - if Assigned(CabArchive) then - Result := CabArchive.Items[Index] - else - Result := nil; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomCabBrowser.GetSetID : Word; -begin - if Assigned(Archive) then - Result := TAbCabArchive(Archive).SetID - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabBrowser.InitArchive; -begin - inherited InitArchive; - if Assigned(Archive) then - TAbCabArchive(Archive).SetID := FSetID; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabBrowser.SetFileName(const aFileName : string); - {open/create cabinet archive} -begin - FFileName := aFileName; - if (csDesigning in ComponentState) then - Exit; - if Assigned(FArchive) then begin - FArchive.Free; - FArchive := nil; - end; - if (aFileName <> '') and - FileExists(aFilename) and - (AbDetermineArcType(aFileName, atCab) = atCab) then - begin - FArchive := TAbCabArchive.Create(aFileName, fmOpenRead); - InitArchive; - FArchive.Load; - end; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabBrowser.SetSetID(Value : Word); -begin - FSetID := Value; - if Assigned(Archive) then - TAbCabArchive(Archive).SetID := Value; -end; -{ -------------------------------------------------------------------------- } - -end. diff --git a/components/Abbrevia/source/AbCView.pas b/components/Abbrevia/source/AbCView.pas deleted file mode 100644 index da8b2ad..0000000 --- a/components/Abbrevia/source/AbCView.pas +++ /dev/null @@ -1,176 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCView.pas *} -{*********************************************************} -{* ABBREVIA: Cabinet archive viewer component *} -{* Use AbQCView.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -Unit AbCView; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses - Windows, Classes, - {$IFDEF UsingClx} - AbQView, - {$ELSE} - AbView, - {$ENDIF} - AbCBrows, - AbCabTyp, AbArcTyp; - -type - TAbCabView = class(TAbBaseViewer) - protected - FCabComponent : TAbCustomCabBrowser; - FEmptyItemList: TAbArchiveList; - function GetItem(RowNum : Longint) : TAbCabItem; - procedure SetCabComponent(Value : TAbCustomCabBrowser); - procedure Notification(AComponent : TComponent; Operation : TOperation); - override; - procedure DoChange(Sender : TObject); - override; - public - constructor Create(AOwner : TComponent); - override; - destructor Destroy; - override; - property Items[RowNum : Longint] : TAbCabItem - read GetItem; - published {properties} - property Align; - property Attributes; - property BorderStyle; - property Color; - property Colors; -{$IFNDEF UsingClx} - property Ctl3D; -{$ENDIF} - property Cursor; - property Headings; - property DefaultColWidth; - property DefaultRowHeight; - property DisplayOptions; - property HeaderRowHeight; - property SortAttributes; -{$IFNDEF UsingClx} - property DragCursor; -{$ENDIF} - property DragMode; - property Enabled; - property Font; - property ParentColor; -{$IFNDEF UsingClx} - property ParentCtl3D; -{$ENDIF} - property ParentFont; - property ParentShowHint; - property PopupMenu; - property ShowHint; - property TabOrder; - property TabStop; - property Version; - property CabComponent : TAbCustomCabBrowser - read FCabComponent write SetCabComponent; - published {Events} - property OnChange; - property OnClick; - property OnDblClick; - property OnEnter; - property OnExit; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; - property OnSorted; - property OnDrawSortArrow; -end; - - -implementation - -type - TAbCabBrowserFriend = class(TAbCustomCabBrowser); - - -{ ===== TAbCabView ========================================================= } -constructor TAbCabView.Create(AOwner : TComponent); -begin - inherited; - FEmptyItemList := FItemList; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCabView.Destroy; -begin - FItemList := FEmptyItemList; - inherited; -end; -{ -------------------------------------------------------------------------- } -function TAbCabView.GetItem(RowNum : Longint) : TAbCabItem; -begin - if Assigned(FItemList) then - Result := TAbCabItem(FItemList.Items[FRowMap[RowNum]]) - else - Result := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabView.Notification(AComponent : TComponent; Operation : TOperation); -begin - inherited Notification(AComponent, Operation); - if Operation = opRemove then - if Assigned(FCabComponent) and (AComponent = FCabComponent) then begin - FCabComponent := nil; - Refresh; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabView.SetCabComponent(Value : TAbCustomCabBrowser); -begin - FCabComponent := Value; - FCabComponent.OnChange := DoChange; - FCabComponent.OnLoad := DoLoad; - DoChange(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabView.DoChange(Sender : TObject); -begin - if Assigned(FCabComponent) and Assigned(TAbCabBrowserFriend(FCabComponent).Archive) then - FItemList := TAbCabBrowserFriend(FCabComponent).Archive.ItemList - else if FEmptyItemList <> nil then - FItemList := FEmptyItemList; - inherited DoChange(Sender); -end; - -end. - diff --git a/components/Abbrevia/source/AbCabExt.pas b/components/Abbrevia/source/AbCabExt.pas deleted file mode 100644 index 8a2319d..0000000 --- a/components/Abbrevia/source/AbCabExt.pas +++ /dev/null @@ -1,188 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCabExt.pas *} -{*********************************************************} -{* ABBREVIA: Cabinet file extractor component *} -{*********************************************************} - -unit AbCabExt; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbCBrows, - AbArcTyp; - -type - TAbCustomCabExtractor = class(TAbCustomCabBrowser) - protected {private} - FExtractOptions : TAbExtractOptions; - FOnConfirmOverwrite : TAbConfirmOverwriteEvent; - - procedure DoConfirmOverwrite(var Name : string; - var Confirm : Boolean); - procedure InitArchive; - override; - procedure SetExtractOptions( Value : TAbExtractOptions ); - - protected {properties} - property ExtractOptions : TAbExtractOptions - read FExtractOptions - write SetExtractOptions - default AbDefExtractOptions; - property OnConfirmOverwrite : TAbConfirmOverwriteEvent - read FOnConfirmOverwrite - write FOnConfirmOverwrite; - - public - constructor Create( AOwner : TComponent ); override; - destructor Destroy; override; - - procedure ExtractAt(Index : Integer; const NewName : string); - procedure ExtractFiles(const FileMask : string); - procedure ExtractFilesEx(const FileMask, ExclusionMask : string); - procedure ExtractTaggedItems; - end; - - {$IFDEF HasPlatformsAttribute} - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - {$ENDIF} - TAbCabExtractor = class(TAbCustomCabExtractor) - published - property ArchiveProgressMeter; - property BaseDirectory; - property CabSize; - property CurrentCab; - property ExtractOptions; - property FolderCount; - property HasNext; - property HasPrev; - property ItemProgressMeter; - property OnArchiveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnConfirmOverwrite; - property OnConfirmProcessItem; - property OnLoad; - property OnProcessItemFailure; - property OnRequestImage; - property SetID; - property TempDirectory; - property Version; - property FileName; {must be after OnLoad} - end; - {.Z+} - - -implementation - -uses - AbExcept; - -{ TAbCustomCabExtractor ==================================================== } -constructor TAbCustomCabExtractor.Create(AOwner : TComponent); -begin - inherited Create( AOwner ); - ExtractOptions := AbDefExtractOptions; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomCabExtractor.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabExtractor.DoConfirmOverwrite - (var Name : string; - var Confirm : Boolean); -begin - if Assigned(FOnConfirmOverwrite) then - FOnConfirmOverwrite(Name, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabExtractor.ExtractAt(Index : Integer; - const NewName : string); - {extract a file from the archive that match the index} -begin - if Assigned( CabArchive ) then - CabArchive.ExtractAt( Index, NewName ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabExtractor.ExtractFiles(const FileMask : string); - {Extract files from the cabinet matching the filemask} -begin - if Assigned( CabArchive ) then - CabArchive.ExtractFiles( FileMask ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabExtractor.ExtractFilesEx(const FileMask, ExclusionMask : string); - {Extract files from the cabinet matching the FileMask, exluding those - matching ExclusionMask} -begin - if Assigned( CabArchive ) then - CabArchive.ExtractFilesEx( FileMask, ExclusionMask ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabExtractor.ExtractTaggedItems; - {Extract items in the archive that have been tagged} -begin - if Assigned( CabArchive ) then - CabArchive.ExtractTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabExtractor.InitArchive; - {Archive now points to the Cab file, update all Archive's properties...} -begin - inherited InitArchive; - if Assigned( CabArchive ) then begin - {poperties} - CabArchive.ExtractOptions := FExtractOptions; - {events} - CabArchive.OnConfirmOverwrite := DoConfirmOverwrite; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabExtractor.SetExtractOptions( Value : TAbExtractOptions ); -begin - FExtractOptions := Value; - if Assigned( FArchive ) then - FArchive.ExtractOptions := Value; -end; -{ -------------------------------------------------------------------------- } - -end. - diff --git a/components/Abbrevia/source/AbCabKit.pas b/components/Abbrevia/source/AbCabKit.pas deleted file mode 100644 index d6cdd97..0000000 --- a/components/Abbrevia/source/AbCabKit.pas +++ /dev/null @@ -1,213 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCabKit.PAS *} -{*********************************************************} -{* ABBREVIA: Cabinet file builder/extractor component *} -{*********************************************************} - -unit AbCabKit; - -{$I AbDefine.inc} - -interface - -uses - Classes, AbArcTyp, - AbCabMak; - -type - TAbCustomCabKit = class(TAbCustomMakeCab) - protected {private} - FExtractOptions : TAbExtractOptions; - FOnConfirmOverwrite : TAbConfirmOverwriteEvent; - - procedure DoConfirmOverwrite(var Name : string; - var Confirm : Boolean); - procedure InitArchive; override; - procedure SetExtractOptions( Value : TAbExtractOptions ); - procedure SetFileName(const aFileName : string); override; - - - protected {properties} - property ExtractOptions : TAbExtractOptions - read FExtractOptions - write SetExtractOptions - default AbDefExtractOptions; - - protected {events} - property OnConfirmOverwrite : TAbConfirmOverwriteEvent - read FOnConfirmOverwrite - write FOnConfirmOverwrite; - - public {methods} - constructor Create( AOwner : TComponent ); override; - destructor Destroy; override; - - procedure ExtractAt(Index : Integer; const NewName : string); - procedure ExtractFiles(const FileMask : string); - procedure ExtractFilesEx(const FileMask, ExclusionMask : string); - procedure ExtractTaggedItems; - end; - - {$IFDEF HasPlatformsAttribute} - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - {$ENDIF} - TAbCabKit = class(TAbCustomCabKit) - published - property ArchiveProgressMeter; - property BaseDirectory; - property CabSize; - property CompressionType; - property CurrentCab; - property ExtractOptions; - property FolderCount; - property FolderThreshold; - property HasNext; - property HasPrev; - property ItemProgressMeter; - property OnArchiveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnConfirmOverwrite; - property OnConfirmProcessItem; - property OnLoad; - property OnProcessItemFailure; - property OnRequestImage; - property OnSave; - property SetID; - property SpanningThreshold; - property TempDirectory; - property Version; - property FileName; {must be after OnLoad} - end; - - -implementation - -uses - SysUtils, - AbExcept, - AbCabTyp, - AbCBrows; - -{ TAbCustomCabKit ==================================================== } -constructor TAbCustomCabKit.Create(AOwner : TComponent); -begin - inherited Create( AOwner ); - ExtractOptions := AbDefExtractOptions; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomCabKit.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.DoConfirmOverwrite(var Name : string; - var Confirm : Boolean); -begin - if Assigned(FOnConfirmOverwrite) then - FOnConfirmOverwrite(Name, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.ExtractAt(Index : Integer; const NewName : string); - {extract a file from the archive that match the index} -begin - if Assigned( CabArchive ) then - CabArchive.ExtractAt( Index, NewName ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.ExtractFiles(const FileMask : string); - {Extract files from the cabinet matching the filemask} -begin - if Assigned(CabArchive) then - CabArchive.ExtractFiles(FileMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.ExtractFilesEx(const FileMask, ExclusionMask : string); - {Extract files from the cabinet matching the FileMask, exluding those - matching ExclusionMask} -begin - if Assigned(CabArchive) then - CabArchive.ExtractFilesEx(FileMask, ExclusionMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.ExtractTaggedItems; - {Extract items in the archive that have been tagged} -begin - if Assigned(CabArchive) then - CabArchive.ExtractTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.InitArchive; -begin - inherited InitArchive; - if Assigned( CabArchive ) then begin - {poperties} - CabArchive.ExtractOptions := FExtractOptions; - {events} - CabArchive.OnConfirmOverwrite := DoConfirmOverwrite; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.SetExtractOptions( Value : TAbExtractOptions ); -begin - FExtractOptions := Value; - if Assigned( FArchive ) then - FArchive.ExtractOptions := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomCabKit.SetFileName(const aFileName : string); - {Create or open the specified cabinet file} -begin - FFilename := aFileName; - if csDesigning in ComponentState then - Exit; - if Assigned(FArchive) then begin - FArchive.Free; - FArchive := nil; - end; - if (aFileName <> '') then begin - if (aFileName <> '') and FileExists(aFilename) then - FArchive := TAbCabArchive.Create(aFileName, fmOpenRead) - else - FArchive := TAbCabArchive.Create(aFileName, fmOpenWrite); - InitArchive; - FArchive.Load; - end; - DoChange; -end; -{ -------------------------------------------------------------------------- } - -end. diff --git a/components/Abbrevia/source/AbCabMak.pas b/components/Abbrevia/source/AbCabMak.pas deleted file mode 100644 index 18bc599..0000000 --- a/components/Abbrevia/source/AbCabMak.pas +++ /dev/null @@ -1,237 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCabMak.pas *} -{*********************************************************} -{* ABBREVIA: Cabinet builder component (VCL) *} -{* See AbQCabMk.pas for the CLX header *} -{*********************************************************} - -unit AbCabMak; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbCBrows, - AbArcTyp, AbCabTyp; - -type - TAbCustomMakeCab = class(TAbCustomCabBrowser) - protected {private} - FFolderThreshold : Longint; - FCompressionType : TAbCabCompressionType; - FStoreOptions : TAbStoreOptions; - FOnSave : TAbArchiveEvent; - - protected {methods} - procedure DoSave(Sender : TObject); virtual; - procedure InitArchive; override; - procedure SetFolderThreshold(Value : Longint); - procedure SetCompressionType(Value : TAbCabCompressionType); - procedure SetFileName(const aFileName : string); override; - procedure SetStoreOptions( Value : TAbStoreOptions ); - - protected {properties} - property CompressionType : TAbCabCompressionType - read FCompressionType - write SetCompressionType; - property FolderThreshold : Longint - read FFolderThreshold - write SetFolderThreshold; - property StoreOptions : TAbStoreOptions - read FStoreOptions - write SetStoreOptions - default AbDefStoreOptions; - - protected {events} - property OnSave : TAbArchiveEvent - read FOnSave - write FOnSave; - - public {methods} - constructor Create( AOwner : TComponent ); override; - procedure AddFiles(const FileMask : string; SearchAttr : Integer ); - procedure AddFilesEx(const FileMask : string; - const ExclusionMask : string; SearchAttr : Integer ); - procedure StartNewFolder; - procedure StartNewCabinet; - end; - -type - {$IFDEF HasPlatformsAttribute} - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - {$ENDIF} - TAbMakeCab = class(TAbCustomMakeCab) - published - property ArchiveProgressMeter; - property BaseDirectory; - property CabSize; - property CompressionType; - property FolderThreshold; - property ItemProgressMeter; - property StoreOptions; - property OnArchiveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnConfirmProcessItem; - property OnLoad; - property OnProcessItemFailure; - property OnRequestImage; - property OnSave; - property SetID; - property SpanningThreshold; - property TempDirectory; - property Version; - property FileName; {must be after OnLoad} - end; - {.Z+} - - -implementation - -uses - SysUtils, - AbExcept, - AbUtils; - -{ TAbCustomMakeCab ========================================================= } -constructor TAbCustomMakeCab.Create( AOwner : TComponent ); -begin - inherited Create( AOwner ); - FCompressionType := AbDefCompressionType; - FSpanningThreshold := AbDefCabSpanningThreshold; - FFolderThreshold := AbDefFolderThreshold; - FSetID := 0; - FStoreOptions := AbDefStoreOptions; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.AddFiles(const FileMask : string; SearchAttr : Integer ); - {Add files to the cabinet where the disk filespec matches} -begin - if Assigned(CabArchive) then - CabArchive.AddFiles(FileMask, SearchAttr) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.AddFilesEx(const FileMask : string; - const ExclusionMask : string; - SearchAttr : Integer); - {Add files that match Filemask except those matching ExclusionMask} -begin - if Assigned(CabArchive) then - CabArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.DoSave(Sender : TObject); -begin - if Assigned(FOnSave) then - FOnSave(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.InitArchive; -begin - inherited InitArchive; - if Assigned(CabArchive) then begin - {properties} - CabArchive.FolderThreshold := FFolderThreshold; - CabArchive.CompressionType := FCompressionType; - CabArchive.SetID := FSetID; - CabArchive.StoreOptions := FStoreOptions; - {events} - CabArchive.OnSave := DoSave; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.SetCompressionType(Value : TAbCabCompressionType); - {Set the type of compression to use} -begin - FCompressionType := Value; - if Assigned(CabArchive) then - CabArchive.CompressionType := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.SetFileName(const aFileName : string); - {Create the specified cabinet file} -begin - FFilename := aFileName; - if csDesigning in ComponentState then - Exit; - if Assigned(FArchive) then begin - FArchive.Free; - FArchive := nil; - end; - if (aFileName <> '') then begin - FArchive := TAbCabArchive.Create(aFileName, fmOpenWrite); - InitArchive; - FArchive.Load; - FArchiveType := atCab; - end; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.SetFolderThreshold(Value : Longint); - {Set folder compression boundary} -begin - FFolderThreshold := Value; - if Assigned(CabArchive) then - CabArchive.FolderThreshold := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.SetStoreOptions(Value : TAbStoreOptions); -begin - FStoreOptions := Value; - if Assigned(CabArchive) then - CabArchive.StoreOptions := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.StartNewCabinet; - {Flush current cabinet and start a new one} -begin - if Assigned(CabArchive) then - CabArchive.NewCabinet - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMakeCab.StartNewFolder; - {Flush current folder and start a new one} -begin - if Assigned(CabArchive) then - CabArchive.NewFolder - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } - -end. diff --git a/components/Abbrevia/source/AbCabTyp.pas b/components/Abbrevia/source/AbCabTyp.pas deleted file mode 100644 index 7fbc186..0000000 --- a/components/Abbrevia/source/AbCabTyp.pas +++ /dev/null @@ -1,815 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCabTyp.pas *} -{*********************************************************} -{* ABBREVIA: Cabinet Archive *} -{* Based on info from the FCI/FDI Library Description, *} -{* included in the Microsoft Cabinet SDK *} -{*********************************************************} - -unit AbCabTyp; - -{$I AbDefine.inc} - -interface - -uses - Windows, Classes, AbFciFdi, AbArcTyp, AbUtils; - -type - TAbCabItem = class(TAbArchiveItem) - protected {private} - FPartialFile : Boolean; - FRawFileName : AnsiString; - public - property PartialFile : Boolean - read FPartialFile - write FPartialFile; - property RawFileName : AnsiString - read FRawFileName - write FRawFileName; - end; - -type - TAbCabCompressionType = (ctNone, ctMSZIP, ctLZX); - TAbCabinetMode = (cmRead, cmWrite); - TAbCabStatus = (csFile, csFolder, csCabinet); - - -const - faExtractAndExecute = $040; - faUTF8Name = $080; - AbDefCabSpanningThreshold = 0; - AbDefFolderThreshold = 0; - AbDefCompressionType = ctMSZIP; - AbDefReserveHeaderSize = 0; - AbDefReserveFolderSize = 0; - AbDefReserveDataSize = 0; - AbDefLZXWindowSize = 18; - - CompressionTypeMap : array[TAbCabCompressionType] of Word = (0, 1, 4611); - -type - TAbCabArchive = class(TAbArchive) - protected {private} - {internal variables} - FCabName : AnsiString; - FCabPath : AnsiString; - FFCICabInfo : FCICabInfo; - FFCIContext : HFCI; - FFDIContext : HFDI; - FFDICabInfo : FDICabInfo; - FErrors : CabErrorRecord; - FItemInProgress : TAbCabItem; - FItemStream : TStream; - FIIPName : string; - FItemProgress : DWord; - FNextCabinet : string; - FNextDisk : string; - FTempFileID : Integer; - - {property variables} - FCurrentCab : Word; - FCabSize : Longint; - FCompressionType : TAbCabCompressionType; - FFileCount : Word; - FFolderThreshold : LongWord; - FFolderCount : Word; - FHasPrev : Boolean; - FHasNext : Boolean; - FSetID : Word; - - {internal methods} - procedure CloseCabFile; - procedure CreateCabFile; - function CreateItem( const FileSpec : string ): TAbArchiveItem; - override; - procedure DoCabItemProgress(BytesCompressed : DWord; - var Abort : Boolean); - procedure DoGetNextCabinet(CabIndex : Integer; var CabName : string; - var Abort : Boolean); - procedure ExtractItemAt(Index : Integer; const NewName : string); - override; - procedure ExtractItemToStreamAt(Index : Integer; OutStream : TStream); - override; - function GetItem(ItemIndex : Integer) : TAbCabItem; - procedure LoadArchive; - override; - procedure OpenCabFile; - procedure PutItem( Index : Integer; Value : TAbCabItem ); - procedure SaveArchive; - override; - procedure SetFolderThreshold(Value : LongWord); - procedure SetSetID(Value : Word); - procedure SetSpanningThreshold(Value : Int64); - override; - procedure TestItemAt(Index : Integer); - override; - - public {methods} - constructor Create(const FileName : string; Mode : Word); - override; - constructor CreateFromStream(aStream : TStream; const aArchiveName : string); - override; - destructor Destroy; - override; - procedure Add(aItem : TAbArchiveItem); - override; - procedure NewCabinet; - procedure NewFolder; - - public {properties} - property CurrentCab : Word - read FCurrentCab; - property CabSize : Longint - read FCabSize; - property CompressionType : TAbCabCompressionType - read FCompressionType - write FCompressionType; - property FolderThreshold : LongWord - read FFolderThreshold - write SetFolderThreshold; - property FolderCount : Word - read FFolderCount; - property HasPrev : Boolean - read FHasPrev; - property HasNext : Boolean - read FHasNext; - property Items[Index : Integer] : TAbCabItem - read GetItem - write PutItem; default; - property ItemProgress : DWord - read FItemProgress - write FItemProgress; - property SetID : Word - read FSetID - write SetSetID; - end; - -function VerifyCab(const Fn : string) : TAbArchiveType; overload; -function VerifyCab(Strm : TStream) : TAbArchiveType; overload; - -implementation - -uses - SysUtils{$IFDEF HasAnsiStrings}, AnsiStrings{$ENDIF}, AbCharset, AbConst, AbExcept; - -{$WARN UNIT_PLATFORM OFF} -{$WARN SYMBOL_PLATFORM OFF} - -type - PWord = ^Word; - PInteger = ^Integer; - -{ == FDI/FCI Callback Functions - cdecl calling convention ================= } -function FXI_GetMem(uBytes : Integer) : Pointer; - cdecl; - {allocate memory} -begin - Result := nil; - if (uBytes > 0) then - GetMem(Result, uBytes); -end; -{ -------------------------------------------------------------------------- } -procedure FXI_FreeMem(lpBuffer : Pointer); - cdecl; - {free memory} -begin - FreeMem(lpBuffer); -end; - - -{ == FCI Callback Functions - cdecl calling convention ===================== } -function FCI_FileOpen(lpPathName: PAnsiChar; Flag, Mode: Integer; - PError: PInteger; Archive: TAbCabArchive) : PtrInt; - cdecl; - {open a file} -begin - Result := _lcreat(lpPathName, 0); - if (Result = -1) then - raise EAbFCIFileOpenError.Create; -end; -{ -------------------------------------------------------------------------- } -function FCI_FileRead(hFile: PtrInt; lpBuffer: Pointer; - uBytes: UINT; PError: PInteger; Archive: TAbCabArchive) : UINT; - cdecl; - {read from a file} -begin - Result := _lread(hFile, lpBuffer, uBytes); - if (Result = UINT(-1)) then - raise EAbFCIFileReadError.Create; -end; -{ -------------------------------------------------------------------------- } -function FCI_FileWrite(hFile: PtrInt; lpBuffer: Pointer; - uBytes: UINT; PError: PInteger; Archive: TAbCabArchive) : UINT; - cdecl; - {write to a file} -begin - Result := _lwrite(hFile, lpBuffer, uBytes); - if (Result = UINT(-1)) then - raise EAbFCIFileWriteError.Create; -end; -{ -------------------------------------------------------------------------- } -function FCI_FileClose(hFile: PtrInt; PError: PInteger; - Archive: TAbCabArchive) : Integer; - cdecl; - {close a file} -begin - Result := _lclose(hFile); - if (Result = -1) then - raise EAbFCIFileCloseError.Create; -end; -{ -------------------------------------------------------------------------- } -function FCI_FileSeek(hFile: PtrInt; Offset: Longint; - Origin: Integer; PError: PInteger; Archive: TAbCabArchive) : Longint; - cdecl; - {reposition file pointer} -begin - Result := _llseek(hFile, Offset, Origin); - if (Result = -1) then - raise EAbFCIFileSeekError.Create; -end; -{ -------------------------------------------------------------------------- } -function FCI_FileDelete(lpFilename: PAnsiChar; PError: PInteger; - Archive: TAbCabArchive) : Boolean; - cdecl; - {delete a file} -begin - Result := SysUtils.DeleteFile(string(lpFilename)); - if not Result then - raise EAbFCIFileDeleteError.Create; -end; -{ -------------------------------------------------------------------------- } -function FCI_GetNextCab(lpCCab: PFCICabInfo; PrevCab: Longint; - Archive: TAbCabArchive) : Boolean; - cdecl; - {get next cabinet filename} -var - CabName : string; - Abort : Boolean; -begin - Abort := False; - with lpCCab^ do begin - CabName := string(szCab); - {obtain next cabinet. Make index zero-based} - Archive.DoGetNextCabinet(Pred(iCab), CabName, Abort); - if not Abort then - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(szCab, AnsiString(CabName), Length(szCab)); - end; - Result := not Abort; -end; -{ -------------------------------------------------------------------------- } -function FCI_FileDest(PCCab: PFCICabInfo; PFilename: PAnsiChar; cbFile: Longint; - Continuation: Boolean; Archive: TAbCabArchive) : Integer; - cdecl; - {currently not used} -begin - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function FCI_GetOpenInfo(lpPathname: Pointer; PDate, PTime, PAttribs : PWord; - PError: PInteger; Archive: TAbCabArchive) : PtrInt; - cdecl; - {open a file and return date/attributes} -var - AttrEx: TAbAttrExRec; - I, DT: Integer; - RawName: RawByteString; -begin - Result := FileOpen(string(lpPathname), fmOpenRead or fmShareDenyNone); - if (Result = -1) then - raise EAbFCIFileOpenError.Create; - if not AbFileGetAttrEx(string(lpPathname), AttrEx) then - raise EAbFileNotFound.Create; - PAttribs^ := AttrEx.Attr; - DT := DateTimeToFileDate(AttrEx.Time); - PDate^ := DT shr 16; - PTime^ := DT and $0FFFF; - Archive.ItemProgress := 0; - Archive.FItemInProgress.UncompressedSize := AttrEx.Size; - RawName := Archive.FItemInProgress.RawFileName; - for I := 1 to Length(RawName) do - if Ord(RawName[I]) > 127 then - PAttribs^ := PAttribs^ or faUTF8Name; -end; -{ -------------------------------------------------------------------------- } -function FCI_Status(Status: Word; cb1, cb2: DWord; - Archive: TAbCabArchive) : Longint; cdecl; - {keep archive informed} -var - Abort : Boolean; -begin - Result := 0; - if (Status = Word(csCabinet)) then begin - Archive.DoSave; - Archive.FCabSize := cb2; - Result := cb2; - end else if (Status = Word(csFolder)) then - Archive.FCabSize := Archive.FCabSize + Longint(cb2) - else if (Status = Word(csFile)) then begin - Archive.DoCabItemProgress(cb2, Abort); - Result := Longint(Abort); - end; -end; -{ -------------------------------------------------------------------------- } -function FCI_GetTempFile(lpTempName: PAnsiChar; TempNameSize: Integer; - Archive: TAbCabArchive) : PtrInt; cdecl; - {obtain temporary filename} -var - TempPath : array[0..255] of AnsiChar; -begin - Archive.FTempFileID := Archive.FTempFileID + 1; - if (Archive.TempDirectory <> '') then - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(TempPath, AnsiString(Archive.TempDirectory), Length(TempPath)) - else - GetTempPathA(255, TempPath); - GetTempFileNameA(TempPath, 'VMS', Archive.FTempFileID, lpTempName); - Result := 1; -end; - -{ == FDI Callback Functions - cdecl calling convention ===================== } -function FDI_FileOpen(lpPathName: PAnsiChar; Flag, Mode: Integer) : PtrInt; - cdecl; - {open a file} -begin - try - Result := PtrInt(TFileStream.Create(string(lpPathName), fmOpenRead or fmShareDenyWrite)); - except on EFOpenError do - Result := -1; - end; -end; -{ -------------------------------------------------------------------------- } -function FDI_FileRead(hFile: PtrInt; lpBuffer: Pointer; uBytes: UINT) : UINT; - cdecl; - {read from a file} -begin - Result := TStream(hFile).Read(lpBuffer^, uBytes); -end; -{ -------------------------------------------------------------------------- } -function FDI_FileWrite(hFile: PtrInt; lpBuffer: Pointer; uBytes: UINT) : UINT; - cdecl; - {write to a file} -begin - Result := TStream(hFile).Write(lpBuffer^, uBytes); -end; -{ -------------------------------------------------------------------------- } -function FDI_FileClose(hFile : PtrInt) : Longint; - cdecl; - {close a file} -begin - try - TStream(hFile).Free; - Result := 0; - except - Result := -1; - end; -end; -{ -------------------------------------------------------------------------- } -function FDI_FileSeek(hFile : PtrInt; Offset : Longint; Origin : Integer) : Longint; - cdecl; - {reposition file pointer} -begin - Result := TStream(hFile).Seek(Offset, Origin); -end; -{ -------------------------------------------------------------------------- } -function FDI_EnumerateFiles(fdint : FDINOTIFICATIONTYPE; - pfdin : PFDINotification) : PtrInt; - cdecl; - {Enumerate the files and build the archive file list} -var - Item : TAbCabItem; - Archive : TAbCabArchive; -begin - Result := 0; - Archive := pfdin^.pv; - with Archive do case fdint of - FDINT_Cabinet_Info : - begin - FSetID := pfdin^.setID; - FCurrentCab := pfdin^.iCabinet; - FNextCabinet := string(pfdin^.psz1); - FNextDisk := string(pfdin^.psz2); - Result := 0; - end; - FDINT_Copy_File, FDINT_Partial_File : - begin - Item := TAbCabItem.Create; - with Item do begin - RawFileName := AnsiString(pfdin^.psz1); - if (pfdin^.attribs and faUTF8Name) = faUTF8Name then - Filename := UTF8ToString(RawFileName) - else - Filename := string(RawFileName); - UnCompressedSize := pfdin^.cb; - LastModFileDate := pfdin^.date; - LastModFileTime := pfdin^.time; - ExternalFileAttributes := pfdin^.attribs; - IsEncrypted := False; {encryption not implemented at this time} - PartialFile := (fdint = FDINT_Partial_File); - end; - FItemList.Add(Item); - Result := 0; - end; - end; -end; -{ -------------------------------------------------------------------------- } -function FDI_ExtractFiles(fdint : FDINOTIFICATIONTYPE; - pfdin : PFDINotification) : PtrInt; - cdecl; - {extract file from cabinet} -var - Archive : TAbCabArchive; -begin - Result := 0; - Archive := pfdin^.pv; - case fdint of - FDINT_Copy_File : - begin - if (AnsiString(pfdin^.psz1) = Archive.FItemInProgress.RawFileName) then - if Archive.FIIPName <> '' then - Result := Integer(TFileStream.Create(Archive.FIIPName, fmCreate)) - else - Result := Integer(Archive.FItemStream) - else - Result := 0; - end; - FDINT_Next_Cabinet : - begin - if pfdin^.fdie = FDIError_None then - Result := 0 - else - Result := -1; - end; - FDINT_Close_File_Info : - begin - if Archive.FIIPName <> '' then begin - FileSetDate(TFileStream(pfdin^.hf).Handle, - Longint(pfdin^.date) shl 16 + pfdin^.time); - TFileStream(pfdin^.hf).Free; - FileSetAttr(Archive.FIIPName, pfdin^.attribs); - end; - Result := 1; - end; - end; -end; - - -{ == TAbCabArchive ========================================================= } -function VerifyCab(const Fn : string) : TAbArchiveType; -var - Stream : TFileStream; -begin - Stream := TFileStream.Create(FN, fmOpenRead or fmShareDenyNone); - try - Result := VerifyCab(Stream); - finally - Stream.Free; - end; -end; -{ -------------------------------------------------------------------------- } -function VerifyCab(Strm : TStream) : TAbArchiveType; overload; -var - Context : HFDI; - Info : FDICabInfo; - Errors : CabErrorRecord; - StartPos : int64; -begin - Result := atUnknown; - Context := FDICreate(@FXI_GetMem, @FXI_FreeMem, @FDI_FileOpen, - @FDI_FileRead, @FDI_FileWrite, @FDI_FileClose, @FDI_FileSeek, cpuDefault, - @Errors); - if Context = nil then - Exit; - try - StartPos := Strm.Position; - if FDIIsCabinet(Context, Integer(Strm), @Info) then - Result := atCab; - Strm.Position := StartPos; - finally - FDIDestroy(Context); - end; -end; - - -{ == TAbCabArchive ========================================================= } -constructor TAbCabArchive.Create(const FileName : string; Mode : Word ); -begin - {Mode is used to identify which interface to use: } - { fmOpenWrite - FCI, fmOpenRead - FDI} - inherited CreateInit; - if (Mode and fmCreate) = fmCreate then FMode := fmOpenWrite - else FMode := Mode and fmOpenWrite; - FArchiveName := FileName; - FCabName := AnsiString(ExtractFileName(FileName)); - FCabPath := AnsiString(ExtractFilePath(FileName)); - SpanningThreshold := AbDefCabSpanningThreshold; - FFolderThreshold := AbDefFolderThreshold; - FItemInProgress := nil; - FItemProgress := 0; -end; -{ -------------------------------------------------------------------------- } -constructor TAbCabArchive.CreateFromStream(aStream : TStream; - const aArchiveName : string); -begin - raise EAbCabException.Create('TAbCabArchive does not support CreateFromStream'); -end; -{ -------------------------------------------------------------------------- } -destructor TAbCabArchive.Destroy; -begin - CloseCabFile; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.Add(aItem : TAbArchiveItem); - {add a file to the cabinet} -var - Confirm, ItemAdded : Boolean; - Item : TAbCabItem; -begin - ItemAdded := False; - try - CheckValid; - if (FMode <> fmOpenWrite) then begin - DoProcessItemFailure(aItem, ptAdd, ecCabError, 0); - Exit; - end; - if FItemList.IsActiveDupe(aItem.FileName) then begin - DoProcessItemFailure(aItem, ptAdd, ecAbbrevia, AbDuplicateName); - Exit; - end; - DoConfirmProcessItem(aItem, ptAdd, Confirm); - if not Confirm then - Exit; - Item := TAbCabItem(aItem); - FItemInProgress := Item; - Item.Action := aaAdd; - - Item.RawFileName := UTF8Encode(Item.FileName); - if not FCIAddFile(FFCIContext, Pointer(Item.DiskFileName), - PAnsiChar(Item.RawFileName), False, @FCI_GetNextCab, @FCI_Status, - @FCI_GetOpenInfo, CompressionTypeMap[FCompressionType]) then - raise EAbFCIAddFileError.Create; - FItemList.Add(Item); - ItemAdded := True; - - FIsDirty := True; - finally - if not ItemAdded then - aItem.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.CloseCabFile; - {Make sure the Cabinet DLL is shut down} -var - Abort : Boolean; -begin - if (FFDIContext <> nil) then begin - FDIDestroy(FFDIContext); - FFDIContext := nil; - end; - if (FFCIContext <> nil) then begin - FCIFlushCabinet(FFCIContext, False, @FCI_GetNextCab, @FCI_Status); - FCIDestroy(FFCIContext); - FFCIContext := nil; - end; - DoArchiveProgress(0, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.CreateCabFile; - {create a new cabinet} -begin - {set cabinet parameters} - with FFCICabInfo do begin - if (SpanningThreshold > 0) then - cb := SpanningThreshold - else - cb := AbDefCabSpanningThreshold; - if (FolderThreshold > 0) then - cbFolderThresh := FolderThreshold - else - cbFolderThresh := AbDefFolderThreshold; - cbReserveCFHeader := AbDefReserveHeaderSize; - cbReserveCFFolder := AbDefReserveFolderSize; - cbReserveCFData := AbDefReserveDataSize; - iCab := 1; - iDisk := 0; - fFailOnIncompressible := 0; - setID := SetID; - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(szDisk, ''); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(szCab, FCabName, Length(szCab)); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(szCabPath, FCabPath, Length(szCabPath)); - end; - - {obtain an FCI context} - FFCIContext := FCICreate(@FErrors, @FCI_FileDest, @FXI_GetMem, @FXI_FreeMem, - @FCI_FileOpen, @FCI_FileRead, @FCI_FileWrite, @FCI_FileClose, @FCI_FileSeek, - @FCI_FileDelete, @FCI_GetTempFile, @FFCICabInfo, Self); - if (FFCIContext = nil) then - if FErrors.ErrorPresent then begin - CloseCabFile; - raise EAbFCICreateError.Create; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbCabArchive.CreateItem( const FileSpec : string ): TAbArchiveItem; - {create a new item for the file list} -begin - Result := TAbCabItem.Create; - with TAbCabItem(Result) do begin - CompressedSize := 0; - DiskFileName := ExpandFileName(FileSpec); - FileName := FixName(FileSpec); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.DoCabItemProgress(BytesCompressed : DWord; - var Abort : Boolean); - {fire OnCabItemProgress event} -var - Progress : Byte; -begin - Abort := False; - if Assigned(FOnArchiveItemProgress) then begin - Inc(FItemProgress, BytesCompressed); - Progress := AbPercentage(FItemProgress, - FItemInProgress.UnCompressedSize); - FOnArchiveItemProgress(Self, FItemInProgress, Progress, Abort); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.DoGetNextCabinet(CabIndex : Integer; - var CabName : string; var Abort : Boolean); - {fire OnRequestImage event} -begin - Abort := False; - if Assigned(FOnRequestImage) then - FOnRequestImage(Self, CabIndex, CabName, Abort) - else - AbIncFilename(CabName, CabIndex); -end; -{----------------------------------------------------------------------------} -procedure TAbCabArchive.ExtractItemAt(Index : Integer; const NewName : string); - {extract a file from the cabinet} -begin - FItemInProgress := GetItem(Index); - FIIPName := NewName; - try - if not FDICopy(FFDIContext, PAnsiChar(FCabName), PAnsiChar(FCabPath), 0, - @FDI_ExtractFiles, nil, Self) then - DoProcessItemFailure(FItemInProgress, ptExtract, ecCabError, FErrors.ErrorCode); - finally - FIIPName := ''; - end; -end; -{----------------------------------------------------------------------------} -procedure TAbCabArchive.ExtractItemToStreamAt(Index : Integer; OutStream : TStream); -begin - FItemInProgress := GetItem(Index); - FItemStream := OutStream; - try - if not FDICopy(FFDIContext, PAnsiChar(FCabName), PAnsiChar(FCabPath), 0, - @FDI_ExtractFiles, nil, Self) then - DoProcessItemFailure(FItemInProgress, ptExtract, ecCabError, FErrors.ErrorCode); - finally - FItemStream := nil; - end; -end; -{----------------------------------------------------------------------------} -function TAbCabArchive.GetItem(ItemIndex : Integer) : TAbCabItem; - {fetch an item from the file list} -begin - Result := TAbCabItem(FItemList.Items[ItemIndex]); -end; -{----------------------------------------------------------------------------} -procedure TAbCabArchive.LoadArchive; - {Open existing cabinet or create a new one} -begin - if (FMode = fmOpenRead) then begin - FFDIContext := FDICreate(@FXI_GetMem, @FXI_FreeMem, @FDI_FileOpen, - @FDI_FileRead, @FDI_FileWrite, @FDI_FileClose, @FDI_FileSeek, - cpuDefault, @FErrors); - if (FFDIContext = nil) then - raise EAbFDICreateError.Create; - OpenCabFile; - end else - CreateCabFile; -end; -{----------------------------------------------------------------------------} -procedure TAbCabArchive.NewCabinet; - {flush current cabinet and start a new one} -begin - if not FCIFlushCabinet(FFCIContext, True, @FCI_GetNextCab, @FCI_Status) then - raise EAbFCIFlushCabinetError.Create; -end; -{----------------------------------------------------------------------------} -procedure TAbCabArchive.NewFolder; - {flush current folder and start a new one} -begin - if not FCIFlushFolder(FFCIContext, @FCI_GetNextCab, @FCI_Status) then - raise EAbFCIFlushFolderError.Create; -end; -{----------------------------------------------------------------------------} -procedure TAbCabArchive.OpenCabFile; - {Open an existing cabinet} -var - Abort : Boolean; - Stream : TFileStream; -begin - {verify that the archive can be opened and is a cabinet} - Stream := TFileStream.Create(FArchiveName, fmOpenRead or fmShareDenyNone); - try - if not FDIIsCabinet(FFDIContext, PtrInt(Stream), @FFDICabInfo) then begin - CloseCabFile; - raise EAbInvalidCabFile.Create; - end; - finally - Stream.Free; - end; - - {store information about the cabinet} - FCabSize := FFDICabInfo.cbCabinet; - FFolderCount := FFDICabInfo.cFolders; - FFileCount := FFDICabInfo.cFiles; - FCurrentCab := FFDICabInfo.iCabinet; - FHasPrev := FFDICabInfo.hasPrev; - FHasNext := FFDICabInfo.hasNext; - - {Enumerate the files and build the file list} - if not FDICopy(FFDIContext, PAnsiChar(FCabName), PAnsiChar(FCabPath), 0, - @FDI_EnumerateFiles, nil, Self) then begin - CloseCabFile; - raise EAbFDICopyError.Create; - end; - DoArchiveProgress(100, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.PutItem( Index : Integer; Value : TAbCabItem ); - {replace an existing item in the file list} -begin - FItemList.Items[Index] := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.SaveArchive; -begin - { No-op; file is flushed in destructor } -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.SetFolderThreshold(Value : LongWord); - {set maximum compression boundary} -begin - if (Value > 0) then - FFolderThreshold := Value - else - FFolderThreshold := AbDefFolderThreshold; - FFCICabInfo.cbFolderThresh := FFolderThreshold; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.SetSetID(Value : Word); - {set cabinet SetID} -begin - FSetID := Value; - FFCICabInfo.SetID := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.SetSpanningThreshold(Value : Int64); - {set maximum cabinet size} -begin - if (Value > 0) then - FSpanningThreshold := Value - else - FSpanningThreshold := AbDefCabSpanningThreshold; - FFCICabInfo.cb := FSpanningThreshold; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabArchive.TestItemAt(Index : Integer); -begin - {not implemented for cabinet archives} -end; - -end. diff --git a/components/Abbrevia/source/AbCharset.pas b/components/Abbrevia/source/AbCharset.pas deleted file mode 100644 index 2857fa4..0000000 --- a/components/Abbrevia/source/AbCharset.pas +++ /dev/null @@ -1,344 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * Craig Peterson - * - * Portions created by the Initial Developer are Copyright (C) 2011 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCharset.pas *} -{*********************************************************} -{* ABBREVIA: Types and routines for working with various *} -{* character encodings. *} -{*********************************************************} - -unit AbCharset; - -{$I AbDefine.inc} - -interface - -{$IFDEF MSWINDOWS} -uses - Windows; -{$ENDIF} - -{ Unicode backwards compatibility types } -{$IF NOT DECLARED(RawByteString)} -type - RawByteString = AnsiString; -{$IFEND} -{$IF NOT DECLARED(UnicodeString)} -type - UnicodeString = WideString; -{$IFEND} - -type - TAbCharSet = (csASCII, csANSI, csUTF8); - -function AbDetectCharSet(const aValue: RawByteString): TAbCharSet; - -function AbIsOEM(const aValue: RawByteString): Boolean; - -function AbRawBytesToString(const aValue: RawByteString): string; - -function AbStringToUnixBytes(const aValue: string): RawByteString; - -function AbSysCharSetIsUTF8: Boolean; - -{$IFDEF MSWINDOWS} -function AbTryEncode(const aValue: UnicodeString; aCodePage: UINT; - aAllowBestFit: Boolean; out aResult: AnsiString): Boolean; -{$ENDIF} - -{ Unicode backwards compatibility functions } -{$IFNDEF UNICODE} -function UTF8ToString(const S: RawByteString): string; -{$ENDIF} - -implementation - -uses -{$IFDEF LibcAPI} - Libc, -{$ENDIF} - SysUtils; - -function AbDetectCharSet(const aValue: RawByteString): TAbCharSet; -var - i, TrailCnt: Integer; -begin - Result := csASCII; - TrailCnt := 0; - for i := 1 to Length(aValue) do begin - if Byte(aValue[i]) >= $80 then - Result := csANSI; - if TrailCnt > 0 then - if Byte(aValue[i]) in [$80..$BF] then - Dec(TrailCnt) - else Exit - else if Byte(aValue[i]) in [$80..$BF] then - Exit - else - case Byte(aValue[i]) of - $C0..$C1, $F5..$FF: Exit; - $C2..$DF: TrailCnt := 1; - $E0..$EF: TrailCnt := 2; - $F0..$F4: TrailCnt := 3; - end; - end; - if (TrailCnt = 0) and (Result = csANSI) then - Result := csUTF8; -end; -{ -------------------------------------------------------------------------- } -function AbIsOEM(const aValue: RawByteString): Boolean; -// Detect whether a string of bytes is likely to be the system's ANSI or OEM codepage -{$IFDEF MSWINDOWS} -const - // Byte values of alpha-numeric characters in OEM and ANSI codepages. - // Excludes NBSP, ordinal indicators, exponents, the florin symbol, and, for - // ANSI codepages matched to certain OEM ones, the micro character. - // - // US (OEM 437, ANSI 1252) - Oem437AnsiChars = - [138, 140, 142, 154, 156, 158, 159, 181, 192..214, 216..246, 248..255]; - Oem437OemChars = - [128..154, 160..165, 224..235, 237, 238]; - // Arabic (OEM 720, ANSI 1256) - Oem720AnsiChars = - [129, 138, 140..144, 152, 154, 156, 159, 170, 181, 192..214, 216..239, 244, - 249, 251, 252, 255]; - Oem720OemChars = - [130, 131, 133, 135..140, 147, 149..155, 157..173, 224..239]; - // Greek (OEM 737, ANSI 1253) - Oem737AnsiChars = - [162, 181, 184..186, 188, 190..209, 211..254]; - Oem737OemChars = - [128..175, 224..240, 244, 245]; - // Baltic Rim (OEM 775, ANSI 1257) - Oem775AnsiChars = - [168, 170, 175, 184, 186, 191..214, 216..246, 248..254]; - Oem775OemChars = - [128..149, 151..155, 157, 160..165, 173, 181..184, 189, 190, 198, 199, - 207..216, 224..238]; - // Western European (OEM 850, ANSI 1252) - Oem850AnsiChars = - [138, 140, 142, 154, 156, 158, 159, 192..214, 216..246, 248..255]; - Oem850OemChars = - [128..155, 157, 160..165, 181..183, 198, 199, 208..216, 222, 224..237]; - // Central & Eastern European (OEM 852, ANSI 1250) - Oem852AnsiChars = - [138, 140..143, 154, 156..159, 163, 165, 170, 175, 179, 185, 186, 188, - 190..214, 216..246, 248..254]; - Oem852OemChars = - [128..157, 159..169, 171..173, 181..184, 189, 190, 198, 199, 208..216, 221, - 222, 224..238, 251..253]; - // Cyrillic (OEM 855, ANSI 1251) - Oem855AnsiChars = - [128, 129, 131, 138, 140..144, 154, 156..159, 161..163, 165, 168, 170, 175, - 178..180, 184, 186, 188..255]; - Oem855OemChars = - [128..173, 181..184, 189, 190, 198, 199, 208..216, 221, 222, 224..238, - 241..252]; - // Turkish (OEM 857, ANSI 1254) - Oem857AnsiChars = - [138, 140, 154, 156, 159, 192..214, 216..246, 248..255]; - Oem857OemChars = - [128..155, 157..167, 181..183, 198, 199, 210..212, 214..216, 222, 224..230, - 233..237]; - // Hebrew (OEM 862, ANSI 1255) - Oem862AnsiChars = - [181, 212..214, 224..250]; - Oem862OemChars = - [128..154, 160..165, 224..235, 237, 238]; - // Cyrillic CIS (OEM 866, ANSI 1251) - Oem866AnsiChars = - [128, 129, 131, 138, 140..144, 154, 156..159, 161..163, 165, 168, 170, 175, - 178..181, 184, 186, 188..255]; - Oem866OemChars = - [128..175, 224..247]; -var - AnsiChars, OemChars: set of Byte; - IsANSI: Boolean; - i: Integer; -begin - case GetOEMCP of - 437: - begin - AnsiChars := Oem437AnsiChars; - OemChars := Oem437OemChars; - end; - 720: - begin - AnsiChars := Oem720AnsiChars; - OemChars := Oem720OemChars; - end; - 737: - begin - AnsiChars := Oem737AnsiChars; - OemChars := Oem737OemChars; - end; - 775: - begin - AnsiChars := Oem775AnsiChars; - OemChars := Oem775OemChars; - end; - 850: - begin - AnsiChars := Oem850AnsiChars; - OemChars := Oem850OemChars; - end; - 852: - begin - AnsiChars := Oem852AnsiChars; - OemChars := Oem852OemChars; - end; - 855: - begin - AnsiChars := Oem855AnsiChars; - OemChars := Oem855OemChars; - end; - 857: - begin - AnsiChars := Oem857AnsiChars; - OemChars := Oem857OemChars; - end; - 862: - begin - AnsiChars := Oem862AnsiChars; - OemChars := Oem862OemChars; - end; - 866: - begin - AnsiChars := Oem866AnsiChars; - OemChars := Oem866OemChars; - end; - else - begin - Result := False; - Exit; - end; - end; - - IsANSI := True; - Result := True; - for i := 0 to Length(aValue) do - if Ord(aValue[i]) >= $80 then - begin - if IsANSI then - IsANSI := Ord(aValue[i]) in AnsiChars; - if Result then - Result := Ord(aValue[i]) in OemChars; - if not IsANSI and not Result then - Break - end; - if IsANSI then - Result := False; -end; -{$ELSE !MSWINDOWS} -begin - Result := False; -end; -{$ENDIF !MSWINDOWS} -{ -------------------------------------------------------------------------- } -function AbSysCharSetIsUTF8: Boolean; -begin - {$IFDEF DARWIN} - Result := True; - {$ENDIF} - {$IFDEF MSWINDOWS} - Result := False; - {$ENDIF} - {$IFDEF LINUX} - if DefaultSystemCodePage = CP_UTF8 then - Result := True; - {$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function AbRawBytesToString(const aValue: RawByteString): string; -// Detect encoding of raw bytes and convert to a string -begin - case AbDetectCharSet(aValue) of - csASCII: - Result := string(aValue); - - csANSI: begin - {$IFDEF MSWINDOWS} - if AbIsOEM(aValue) then begin - SetLength(Result, Length(aValue)); - OemToCharBuff(PAnsiChar(aValue), PChar(Result), Length(Result)); - end - else - {$ENDIF} - Result := string(aValue); - end; - - csUTF8: - Result := UTF8ToString(aValue); - end; -end; -{ -------------------------------------------------------------------------- } -function AbStringToUnixBytes(const aValue: string): RawByteString; -// Convert from a string to an appropriate encoding for Unix archive types (tar/gz) -// Based on testing the system encoding should be used on Linux, and UTF-8 -// everywhere else. Windows apps don't agree on whether to use ANSI, OEM, or UTF-8. -begin - // Delphi XE2+ Posix platforms only support the UTF-8 locale - {$IF DEFINED(LINUX) AND (DEFINED(FPC) OR DEFINED(KYLIX))} - Result := AnsiString(aValue); - {$ELSE} - Result := UTF8Encode(aValue); - {$IFEND} -end; -{ -------------------------------------------------------------------------- } -{$IFDEF MSWINDOWS} -function AbTryEncode(const aValue: UnicodeString; aCodePage: UINT; - aAllowBestFit: Boolean; out aResult: AnsiString): Boolean; -// Try to encode the given Unicode string as the requested codepage -const - WC_NO_BEST_FIT_CHARS = $00000400; - Flags: array[Boolean] of DWORD = (WC_NO_BEST_FIT_CHARS, 0); -var - UsedDefault: BOOL; -begin - if not aAllowBestFit and not CheckWin32Version(4, 1) then - Result := False - else begin - SetLength(aResult, WideCharToMultiByte(aCodePage, Flags[aAllowBestFit], - PWideChar(aValue), Length(aValue), nil, 0, nil, @UsedDefault)); - SetLength(aResult, WideCharToMultiByte(aCodePage, Flags[aAllowBestFit], - PWideChar(aValue), Length(aValue), PAnsiChar(aResult), - Length(aResult), nil, @UsedDefault)); - Result := not UsedDefault; - end; -end; -{$ENDIF MSWINDOWS} - - -{ == Unicode backwards compatibility functions ============================= } -{$IFNDEF UNICODE} -function UTF8ToString(const S: RawByteString): string; -begin - Result := UTf8ToAnsi(S); -end; -{$ENDIF} - -end. diff --git a/components/Abbrevia/source/AbComCtrls.pas b/components/Abbrevia/source/AbComCtrls.pas deleted file mode 100644 index 3fa5b87..0000000 --- a/components/Abbrevia/source/AbComCtrls.pas +++ /dev/null @@ -1,1371 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is Craig Peterson - * - * Portions created by the Initial Developer are Copyright (C) 2011 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbComCtrls.pas *} -{*********************************************************} -{* ABBREVIA: Listview and treeview components that work *} -{* with an archive component. The treeview can have a *} -{* listview associated, in which case the listview will*} -{* only show items in the selected folder. *} -{*********************************************************} - -unit AbComCtrls; - -interface - -{$I AbDefine.inc} - -uses - Windows, Messages, SysUtils, Classes, Controls, ComCtrls, Graphics, AbBrowse, - AbArcTyp; - -const - AbTreeArchiveImage = 0; - AbTreeFolderImage = 1; - AbTreeFolderExpandedImage = 2; - -type -{ ===== TAbListItem ========================================================= } - TAbListItem = class(TListItem) - protected {private} - FArchiveItem : TAbArchiveItem; - protected {methods} - function GetIsDirectory : Boolean; - function GetIsEncrypted : Boolean; - public {properties} - property ArchiveItem : TAbArchiveItem - read FArchiveItem - write FArchiveItem; - property IsDirectory : Boolean - read GetIsDirectory; - property IsEncrypted : Boolean - read GetIsEncrypted; - end; - - -{ ===== TAbListItems ======================================================== } - TAbListItems = class(TListItems) - protected {methods} - function GetItem(aIndex: Integer): TAbListItem; - procedure SetItem(aIndex: Integer; aValue: TAbListItem); - public {properties} - property Item[Index: Integer]: TAbListItem - read GetItem - write SetItem; default; - end; - - -{ ===== TAbCustomListView =================================================== } -type - TAbViewColumn = - (vcName, vcFileType, vcLastModified, vcSize, vcRatio, - vcPacked, vcCRC, vcAttributes, vcEncrypted, vcMethod, vcPath); - TAbViewColumns = set of TAbViewColumn; - -const - AbDefVisibleColumns = [Low(TAbViewColumn)..High(TAbViewColumn)]; - -type - TAbCustomTreeView = class; - - {$IF NOT DECLARED(TWindowProcPtr)} - TWindowProcPtr = Pointer; - {$IFEND} - - TAbCustomListView = class(TCustomListView) - protected {private} - FArchive : TAbBaseBrowser; - FDefHeaderProc : TWindowProcPtr; - FFlatList: Boolean; - FHeaderHandle : HWND; - FHeaderImages : TImageList; - FHeaderInstance : Pointer; - FInUpdateSortArrows: Boolean; - FPath : string; - FSortAscending : Boolean; - FSortColIndex : Integer; - FSortColumn : TAbViewColumn; - FSortUpBmp : HBITMAP; - FSortDownBmp : HBITMAP; - FTreeView : TAbCustomTreeView; - FVisibleColumns : TAbViewColumns; - - protected {methods} - procedure ColClick(aColumn: TListColumn); - override; - function CreateListItem: TListItem; - override; - function CreateListItems: TListItems; - override; - procedure CreateWnd; - override; - function CustomDrawSubItem(Item: TListItem; SubItem: Integer; - State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; - override; - procedure DblClick; - override; - procedure DoChange(Sender : TObject); - virtual; - function GetListItems: TAbListItems; - function GetVersion: string; - procedure HeaderWndProc(var Msg: TMessage); - virtual; - function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; - override; - procedure Notification(aComponent : TComponent; aOperation : TOperation); - override; - procedure SetArchive(aValue : TAbBaseBrowser); - procedure SetFlatList(aValue : Boolean); - procedure SetPath(aValue : string); - procedure SetTreeView(aValue : TAbCustomTreeView); - procedure SetVisibleColumns(aValue : TAbViewColumns); - procedure UpdateColumns; - procedure UpdateSortArrow; - procedure UpdateView; - - protected {properties} - property HeaderImages : TImageList - read FHeaderImages; - - public {methods} - constructor Create(aOwner: TComponent); - override; - destructor Destroy; - override; - procedure Sort(aColumn: TAbViewColumn; aAscending: Boolean); - - public {properties} - property Archive : TAbBaseBrowser - read FArchive - write SetArchive; - property Columns; - // Show only items in the current path - property FlatList : Boolean - read FFlatList - write SetFlatList; - property Items: TAbListItems - read GetListItems - stored False; - property TreeView : TAbCustomTreeView - read FTreeView - write SetTreeView; - property Path : string - read FPath - write SetPath; - property Version : string - read GetVersion - stored False; - property VisibleColumns : TAbViewColumns - read FVisibleColumns - write SetVisibleColumns - default AbDefVisibleColumns; - end; - - -{ ===== TAbListView ========================================================= } - TAbListView = class(TAbCustomListView) - published - property Action; - property Align; - property AllocBy; - property Anchors; - property Archive; - property BevelEdges; - property BevelInner; - property BevelOuter; - property BevelKind default bkNone; - property BevelWidth; - property BiDiMode; - property BorderStyle; - property BorderWidth; - property Checkboxes; - property Color; - property ColumnClick; - property Constraints; - property Ctl3D; - property DoubleBuffered; - property DragCursor; - property DragKind; - property DragMode; - property Enabled; - property Font; - property FlatScrollBars; - property FullDrag; - property GridLines; -{$IFDEF HasListViewGroups} - property Groups; -{$ENDIF} - property HideSelection; - property HotTrack; - property HotTrackStyles; - property HoverTime; - property IconOptions; - property Items; - property LargeImages; - property MultiSelect; -{$IFDEF HasListViewGroups} - property GroupHeaderImages; - property GroupView default False; -{$ENDIF} - property ReadOnly default False; - property RowSelect; - property ParentBiDiMode; - property ParentColor default False; -{$IFDEF HasParentDoubleBuffered} - property ParentDoubleBuffered; -{$ENDIF} - property ParentFont; - property ParentShowHint; - property Path; - property PopupMenu; - property ShowColumnHeaders; - property ShowWorkAreas; - property ShowHint; - property TabOrder; - property TabStop default True; - property TreeView; - property Version; - property ViewStyle; - property Visible; - property VisibleColumns; - property OnClick; - property OnColumnClick; - property OnColumnDragged; - property OnColumnRightClick; - property OnContextPopup; - property OnDblClick; - property OnEdited; - property OnEditing; - property OnEndDock; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnDragDrop; - property OnDragOver; - property OnInfoTip; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; -{$IFDEF HasOnMouseActivate} - property OnMouseActivate; -{$ENDIF} - property OnMouseDown; -{$IFDEF HasOnMouseEnter} - property OnMouseEnter; - property OnMouseLeave; -{$ENDIF} - property OnMouseMove; - property OnMouseUp; - property OnResize; - property OnSelectItem; -{$IFDEF HasListViewOnItemChecked} - property OnItemChecked; -{$ENDIF} - property OnStartDock; - property OnStartDrag; - end; - - -{ ===== TAbCustomTreeView =================================================== } - TAbCustomTreeView = class(TTreeView) - protected {private} - FArchive: TAbBaseBrowser; - FListView: TAbCustomListView; - FPath: string; - - protected {methods} - procedure Change(aNode: TTreeNode); - override; - procedure DoChange(Sender : TObject); - virtual; - procedure GetSelectedIndex(aNode: TTreeNode); - override; - function GetVersion: string; - procedure Notification(aComponent : TComponent; aOperation : TOperation); - override; - procedure SelectPathNode; - procedure SetArchive(aValue: TAbBaseBrowser); - procedure SetListView(aValue: TAbCustomListView); - procedure SetPath(const aValue: string); - - public {methods} - constructor Create(aOwner: TComponent); - override; - - public {properties} - property Archive: TAbBaseBrowser - read FArchive - write SetArchive; - property HideSelection - default False; - property ListView: TAbCustomListView - read FListView - write SetListView; - property Path: string - read FPath - write SetPath; - property Version: string - read GetVersion - stored False; - end; - - -{ ===== TAbTreeView ========================================================= } - TAbTreeView = class(TAbCustomTreeView) - published - property Align; - property Anchors; - property Archive; - property AutoExpand; - property BevelEdges; - property BevelInner; - property BevelOuter; - property BevelKind default bkNone; - property BevelWidth; - property BiDiMode; - property BorderStyle; - property BorderWidth; - property ChangeDelay; - property Color; - property Ctl3D; - property Constraints; - property DoubleBuffered; - property DragKind; - property DragCursor; - property DragMode; - property Enabled; - property Font; - property HideSelection; - property HotTrack; - property Indent; - property Items; - property ListView; - property ParentBiDiMode; - property ParentColor default False; - property ParentCtl3D; -{$IFDEF HasParentDoubleBuffered} - property ParentDoubleBuffered; -{$ENDIF} - property ParentFont; - property ParentShowHint; - property Path; - property PopupMenu; - property ReadOnly; - property RightClickSelect; - property RowSelect; - property ShowButtons; - property ShowHint; - property ShowLines; - property ShowRoot; - property TabOrder; - property TabStop default True; - property ToolTips; - property Version; - property Visible; - property OnChanging; - property OnClick; - property OnCollapsed; - property OnCollapsing; - property OnContextPopup; - property OnDblClick; - property OnDeletion; - property OnDragDrop; - property OnDragOver; - property OnEdited; - property OnEditing; - property OnEndDock; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnExpanding; - property OnExpanded; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; -{$IFDEF HasOnMouseActivate} - property OnMouseActivate; -{$ENDIF} - property OnMouseDown; -{$IFDEF HasOnMouseEnter} - property OnMouseEnter; - property OnMouseLeave; -{$ENDIF} - property OnMouseMove; - property OnMouseUp; - property OnStartDock; - property OnStartDrag; - end; - - -{ ===== TAbProgressBar ====================================================== } - TAbProgressBar = class(TProgressBar, IAbProgressMeter) - protected {private} - function GetVersion : string; - - public {methods} - procedure DoProgress(Progress : Byte); - procedure Reset; - - published {properties} - property Version: string - read GetVersion - stored False; - end; - - -implementation - -{$R AbComCtrls.res} - -uses - CommCtrl, Contnrs, Forms, ShellAPI, StrUtils, AbConst, AbResString, AbUtils, - AbZipTyp; - -const - HDF_SORTDOWN = $0200; - HDF_SORTUP = $0400; - -{ -------------------------------------------------------------------------- } -{$IF NOT DECLARED(StartsText)} -function StartsText(const aSubText, aText: string): Boolean; -begin - Result := (Length(aText) > Length(aSubText)) and - SameText(aSubText, Copy(aText, 1, Length(aSubText))); -end; -{$IFEND} -{ -------------------------------------------------------------------------- } -function AbNormalizeFilename(const aFilename: string): string; -var - i: Integer; -begin - Result := aFilename; - for i := 1 to Length(Result) do - if IsDelimiter('\/', Result, i) then - Result[i] := PathDelim; - if IsDelimiter(PathDelim, Result, Length(Result)) then - SetLength(Result, Length(Result) - 1); -end; -{ -------------------------------------------------------------------------- } -var - ComCtl32MajorVer: Integer = -1; - -function IsComCtl32Version6: Boolean; -type - PDllVersionInfo = ^TDllVersionInfo; - TDllVersionInfo = packed record - cbSize: DWORD; - dwMajorVersion: DWORD; - dwMinorVersion: DWORD; - dwBuildNumber: DWORD; - dwPlatformId: DWORD; - end; -var - DllGetVersion: function(pdvi: PDllVersionInfo): HRESULT; stdcall; - dvi: TDllVersionInfo; - hComCtl32: HMODULE; -begin - if ComCtl32MajorVer = -1 then begin - ComCtl32MajorVer := 0; - hComCtl32 := LoadLibrary(comctl32); - if hComCtl32 <> 0 then begin - DllGetVersion := GetProcAddress(hComCtl32, 'DllGetVersion'); - if Assigned(DllGetVersion) then begin - dvi.cbSize := SizeOf(dvi); - if Succeeded(DllGetVersion(@dvi)) then - ComCtl32MajorVer := dvi.dwMajorVersion; - end; - FreeLibrary(hComCtl32); - end; - end; - Result := ComCtl32MajorVer >= 6; -end; -{ -------------------------------------------------------------------------- } -function SameEvent(const aEvent1, aEvent2: TNotifyEvent): Boolean; -begin - Result := (TMethod(aEvent1).Code = TMethod(aEvent2).Code) and - (TMethod(aEvent1).Data = TMethod(aEvent2).Data); -end; - - - -{ ===== TAbListItem ========================================================= } -function TAbListItem.GetIsDirectory: Boolean; -begin - Result := (ArchiveItem = nil) or ArchiveItem.IsDirectory; -end; -{ -------------------------------------------------------------------------- } -function TAbListItem.GetIsEncrypted: Boolean; -begin - Result := (ArchiveItem <> nil) and ArchiveItem.IsEncrypted; -end; - - -{ ===== TAbListItems ======================================================== } -function TAbListItems.GetItem(aIndex: Integer): TAbListItem; -begin - Result := inherited Item[aIndex] as TAbListItem; -end; -{ -------------------------------------------------------------------------- } -procedure TAbListItems.SetItem(aIndex: Integer; aValue: TAbListItem); -begin - inherited Item[aIndex] := aValue; -end; - -{ ===== TAbCustomListView =================================================== } -constructor TAbCustomListView.Create(aOwner: TComponent); -var - Bmp : TBitmap; - sfi: SHFILEINFO; -begin - inherited; - FHeaderInstance := MakeObjectInstance(HeaderWndProc); - // Load header image into an image list; the header's hbm property - // doesn't support transparency - FHeaderImages := TImageList.Create(Self); - Bmp := TBitmap.Create; - try - Bmp.LoadFromResourceName(HInstance, 'AbComCtrls_Lock'); - FHeaderImages.AddMasked(Bmp, clFuchsia); - finally - Bmp.Free; - end; - // Load system image lists - LargeImages := TImageList.Create(Self); - LargeImages.ShareImages := True; - LargeImages.Handle := SHGetFileInfo('', 0, sfi, SizeOf(sfi), - SHGFI_LARGEICON or SHGFI_SYSICONINDEX); - SmallImages := TImageList.Create(Self); - SmallImages.ShareImages := True; - SmallImages.Handle := SHGetFileInfo('', 0, sfi, SizeOf(sfi), - SHGFI_SMALLICON or SHGFI_SYSICONINDEX); - // Load sort arrow bitmaps for older comctrl32.dll versions - FSortAscending := True; - FSortColumn := vcName; - if not IsComCtl32Version6 then begin - FSortUpBmp := LoadImage(HInstance, 'AbComCtrls_SortUp', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS); - FSortDownBmp := LoadImage(HInstance, 'AbComCtrls_SortDown', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DColors); - end; - // Set default column visibility - VisibleColumns := AbDefVisibleColumns; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomListView.Destroy; -begin - if FHeaderHandle <> 0 then - SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc)); - FreeObjectInstance(FHeaderInstance); - if FSortUpBmp <> 0 then - DeleteObject(FSortUpBmp); - if FSortDownBmp <> 0 then - DeleteObject(FSortDownBmp); - inherited; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.ColClick(aColumn: TListColumn); -var - Col: TAbViewColumn; -begin - inherited; - Col := TAbViewColumn(aColumn.Tag); - Sort(Col, (Col <> FSortColumn) or not FSortAscending); -end; -{ -------------------------------------------------------------------------- } -function TAbCustomListView.CreateListItem: TListItem; -begin - Result := TAbListItem.Create(Items); -end; -{ -------------------------------------------------------------------------- } -function TAbCustomListView.CreateListItems: TListItems; -begin - Result := TAbListItems.Create(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.CreateWnd; -begin - inherited; - FHeaderHandle := ListView_GetHeader(Handle); - if FHeaderHandle <> 0 then begin - FDefHeaderProc := TWindowProcPtr(GetWindowLong(FHeaderHandle, GWL_WNDPROC)); - SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FHeaderInstance)); - end; - Header_SetImageList(ListView_GetHeader(Handle), FHeaderImages.Handle); - UpdateColumns; - UpdateView; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomListView.CustomDrawSubItem(Item: TListItem; SubItem: Integer; - State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; -var - i: Integer; - R: TRect; -begin - Result := True; - if (Stage = cdPrePaint) and TAbListItem(Item).IsEncrypted then - if TAbViewColumn(Columns[SubItem].Tag) = vcEncrypted then begin - Result := False; - R := Item.DisplayRect(drBounds); - Inc(R.Left, 6); - for i := 0 to SubItem - 1 do - Inc(R.Left, Columns[i].Width); - HeaderImages.Draw(Canvas, R.Left, R.Top, 0); - end - else begin - Result := True; - // Fixed other columns drawing with wrong font after using TImageList.Draw - Canvas.Brush.Color := ColorToRGB(Color); - SetBkMode(Canvas.Handle, TRANSPARENT); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.DblClick; -begin - inherited; - if TAbListItem(Selected).IsDirectory then - if Path = '' then - Path := Selected.Caption - else - Path := Path + PathDelim + Selected.Caption; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.DoChange(Sender: TObject); -begin - UpdateView; - if (Sender = FArchive) and Assigned(FTreeView) then - FTreeView.DoChange(Self); -end; -{ -------------------------------------------------------------------------- } -function TAbCustomListView.GetListItems: TAbListItems; -begin - Result := inherited Items as TAbListItems; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomListView.GetVersion: string; -begin - Result := AbVersionS; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.HeaderWndProc(var Msg: TMessage); -const - FMT_MASK = HDF_BITMAP or HDF_BITMAP_ON_RIGHT or HDF_SORTDOWN or HDF_SORTUP; -var - Item: THDItem; -begin - if (Msg.Msg = HDM_SETITEM) and not FInUpdateSortArrows then begin - Item.Mask := HDI_FORMAT; - if Header_GetItem(FHeaderHandle, Msg.WParam, Item) then begin - PHDItem(Msg.LParam).Mask := PHDItem(Msg.LParam).Mask and not HDI_BITMAP; - PHDItem(Msg.LParam).fmt := PHDItem(Msg.LParam).fmt and not FMT_MASK - or (Item.fmt and FMT_MASK); - end; - end; - Msg.Result := CallWindowProc(FDefHeaderProc, FHeaderHandle, Msg.Msg, - Msg.WParam, Msg.LParam); - if Msg.Msg = WM_DESTROY then - FHeaderHandle := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomListView.IsCustomDrawn(Target: TCustomDrawTarget; - Stage: TCustomDrawStage): Boolean; -begin - Result := (vcEncrypted in VisibleColumns) and (Stage = cdPrePaint) and - (Target = dtSubItem); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.Notification(aComponent: TComponent; - aOperation: TOperation); -begin - inherited; - if aOperation = opRemove then begin - if aComponent = FArchive then begin - FArchive := nil; - Clear; - end; - if aComponent = FTreeView then begin - if Assigned(FArchive) and SameEvent(FArchive.OnChange, FTreeView.DoChange) then - FArchive.OnChange := DoChange; - FTreeView := nil; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.SetArchive(aValue: TAbBaseBrowser); -begin - if aValue <> FArchive then begin - if Assigned(FArchive) then begin - FArchive.RemoveFreeNotification(Self); - if SameEvent(FArchive.OnChange, DoChange) then - if Assigned(TreeView) and (TreeView.Archive = FArchive) then - FArchive.OnChange := TreeView.DoChange - else - FArchive.OnChange := nil; - end; - FArchive := aValue; - if Assigned(FArchive) then begin - FArchive.FreeNotification(Self); - FArchive.OnChange := DoChange; - DoChange(Self); - end - else - Items.Clear; - if Assigned(TreeView) then - TreeView.Archive := aValue; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.SetFlatList(aValue : Boolean); -begin - if aValue <> FFlatList then begin - FFlatList := aValue; - UpdateView; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.SetPath(aValue: string); -begin - if aValue <> FPath then begin - FPath := ExcludeTrailingPathDelimiter(aValue); - if Assigned(TreeView) then - TreeView.Path := aValue; - if not FlatList then - UpdateView; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.SetTreeView(aValue: TAbCustomTreeView); -begin - if aValue <> FTreeView then begin - if Assigned(FTreeView) then begin - FTreeView.RemoveFreeNotification(Self); - FTreeView.ListView := nil; - end; - FTreeView := aValue; - if Assigned(FTreeView) then begin - FTreeView.FreeNotification(Self); - if Assigned(FArchive) then - FTreeView.Archive := FArchive - else if Assigned(FTreeView.Archive) then - Archive := FTreeView.Archive; - FTreeView.ListView := Self; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.SetVisibleColumns(aValue : TAbViewColumns); -begin - if aValue <> FVisibleColumns then begin - FVisibleColumns := aValue; - UpdateColumns; - UpdateView; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomListView_SortProc(aItem1, aItem2: TAbListItem; - aListView: TAbCustomListView): Integer; stdcall; -var - Item1, Item2: TAbArchiveItem; - Ratio1, Ratio2: Single; -begin - if aItem1.IsDirectory <> aItem2.IsDirectory then - if aItem1.IsDirectory then - Result := -1 - else - Result := 1 - else begin - Result := 0; - if aListView.FSortColumn in [vcFileType, vcPath] then begin - Result := CompareText(aItem1.SubItems[aListView.FSortColIndex], - aItem2.SubItems[aListView.FSortColIndex]); - end - else if not aItem1.IsDirectory then begin - // Don't do more advanced sorts for directories, since they may be - // implicitly stored and won't have corresponding archive items - Item1 := aItem1.ArchiveItem; - Item2 := aItem2.ArchiveItem; - case aListView.FSortColumn of - vcLastModified: - begin - if Item1.LastModTimeAsDateTime < Item2.LastModTimeAsDateTime then - Result := -1 - else if Item1.LastModTimeAsDateTime > Item2.LastModTimeAsDateTime then - Result := 1; - end; - vcSize: - begin - if Item1.UncompressedSize < Item2.UncompressedSize then - Result := -1 - else if Item1.UncompressedSize > Item2.UncompressedSize then - Result := 1; - end; - vcRatio: - begin - if Item1.UncompressedSize > 0 then - Ratio1 := Item1.CompressedSize / Item1.UncompressedSize - else - Ratio1 := 1; - if Item2.UncompressedSize > 0 then - Ratio2 := Item2.CompressedSize / Item2.UncompressedSize - else - Ratio2 := 1; - if Ratio1 > Ratio2 then - Result := -1 - else if Ratio1 < Ratio2 then - Result := 1 - end; - vcPacked: - begin - if Item1.CompressedSize < Item2.CompressedSize then - Result := -1 - else if Item1.CompressedSize > Item2.CompressedSize then - Result := 1; - end; - vcCRC: - begin - if Longword(Item1.CRC32) < Longword(Item2.CRC32) then - Result := -1 - else if Longword(Item1.CRC32) > Longword(Item2.CRC32) then - Result := 1; - end; - vcAttributes, - vcMethod: - begin - Result := CompareText(aItem1.SubItems[aListView.FSortColIndex], - aItem2.SubItems[aListView.FSortColIndex]); - end; - vcEncrypted: - begin - if not Item1.IsEncrypted and Item2.IsEncrypted then - Result := -1 - else if Item1.IsEncrypted and not Item2.IsEncrypted then - Result := 1 - end; - end; - end; - if Result = 0 then - Result := AnsiCompareText(aItem1.Caption, aItem2.Caption); - end; - if not aListView.FSortAscending then - Result := -Result; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.Sort(aColumn: TAbViewColumn; aAscending: Boolean); -begin - if (aColumn <> FSortColumn) or (aAscending <> FSortAscending) then begin - FSortColumn := aColumn; - FSortAscending := aAscending; - UpdateSortArrow; - CustomSort(TLVCompare(@TAbCustomListView_SortProc), LPARAM(Self)); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.UpdateColumns; -const - ColWidths: array[TAbViewColumn] of Integer = ( - 180{vcName}, 110{vcFileType}, 130{vcLastModified}, 80{vcSize}, 50{vcRatio}, - 80{vcPacked}, 70{vcCRC}, 30{vcAttributes}, 28{vcEncrypted}, 60{vcMethod}, - 300{vcPath}); -var - Col: TAbViewColumn; - Column: TListColumn; -begin - if HandleAllocated then - Items.BeginUpdate; - Columns.BeginUpdate; - try - Columns.Clear; - for Col := Low(Col) to High(Col) do begin - if not (Col in FVisibleColumns) then - Continue; - Column := Columns.Add; - case Col of - vcName: Column.Caption := AbItemNameHeadingS; - vcFileType: Column.Caption := AbFileTypeHeadingS; - vcLastModified: Column.Caption := AbLastModifiedHeadingS; - vcSize: Column.Caption := AbFileSizeHeadingS; - vcRatio: Column.Caption := AbRatioHeadingS; - vcPacked: Column.Caption := AbPackedHeadingS; - vcCRC: Column.Caption := AbCRCHeadingS; - vcAttributes: Column.Caption := AbFileAttrHeadingS; - vcEncrypted: Column.ImageIndex := 0; - vcMethod: Column.Caption := AbMethodHeadingS; - vcPath: Column.Caption := AbPathHeadingS; - end; - Column.Width := ColWidths[Col]; - Column.Tag := Ord(Col); - if Col in [vcSize, vcRatio, vcPacked] then - Column.Alignment := taRightJustify; - end; - finally - Columns.EndUpdate; - if HandleAllocated then - Items.EndUpdate; - end; - UpdateSortArrow; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.UpdateSortArrow; -var - i: Integer; - Item: THDITEM; -begin - if not HandleAllocated then - Exit; - FInUpdateSortArrows := True; - try - for i := 0 to Columns.Count - 1 do begin - FillChar(Item, SizeOf(Item), 0); - Item.Mask := HDI_FORMAT; - if not IsComCtl32Version6 then - Item.Mask := Item.Mask or HDI_BITMAP; - Header_GetItem(FHeaderHandle, Columns[i].Index, Item); - // Add sort arrow to requested column - if TAbViewColumn(Columns[i].Tag) = FSortColumn then begin - FSortColIndex := i - 1; - if IsComCtl32Version6 then begin - Item.fmt := Item.fmt and not (HDF_SORTDOWN or HDF_SORTUP); - if FSortAscending then - Item.fmt := Item.fmt or HDF_SORTUP - else - Item.fmt := Item.fmt or HDF_SORTDOWN; - end - else begin - Item.fmt := Item.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT; - if FSortAscending then - Item.hbm := FSortUpBmp - else - Item.hbm := FSortDownBmp; - end; - end - // Remove sort arrow from other columns - else begin - if IsComCtl32Version6 then - Item.fmt := Item.fmt and not (HDF_SORTDOWN or HDF_SORTUP) - else begin - Item.Mask := Item.Mask and not HDI_BITMAP; - Item.fmt := Item.fmt and not (HDF_BITMAP OR HDF_BITMAP_ON_RIGHT); - end; - end; - Header_SetItem(FHeaderHandle, Columns[i].Index, Item); - end; - finally - FInUpdateSortArrows := False; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomListView.UpdateView; -var - ArcItem: TAbArchiveItem; - Col: TAbViewColumn; - ColImage: Integer; - ColText, Filename, FolderName: string; - DOSAttr: Integer; - Folders: TStringList; - i, j: Integer; - ListItem: TAbListItem; - ParentDir: string; - sfi: SHFILEINFO; -begin - ListItem := nil; // Suppress compiler warning - if (Items.Count = 0) and (FArchive = nil) then - Exit; - Items.BeginUpdate; - try - Items.Clear; - if Assigned(FArchive) then begin - Folders := TStringList.Create; - try - for i := 0 to FArchive.Count - 1 do - if FArchive[i].Action <> aaDelete then begin - ArcItem := FArchive[i]; - Filename := AbNormalizeFilename(ArcItem.FileName); - // Exclude unwanted items - if FlatList and ArcItem.IsDirectory then - Continue; - // Create new ListItem - ParentDir := ExtractFileDir(FileName); - if FlatList or (ParentDir = Path) then begin - // If an ListItem has already been created for a folder, use it - if ArcItem.IsDirectory then begin - FolderName := ExtractFileName(FileName); - if Folders.Find(FolderName, j) then - ListItem := Folders.Objects[j] as TAbListItem - else begin - ListItem := Items.Add as TAbListItem; - Folders.AddObject(FolderName, ListItem); - end - end - else - ListItem := Items.Add as TAbListItem; - ListItem.ArchiveItem := FArchive[i]; - end - else if (Path = '') or StartsText(Path + PathDelim, ParentDir) then begin - // Create folder for implicitly stored directories, - // if one hasn't been created already - while ParentDir <> Path do begin - FileName := ParentDir; - ParentDir := ExtractFileDir(FileName); - end; - FolderName := ExtractFileName(FileName); - if Folders.IndexOf(FolderName) <> -1 then - Continue; - ListItem := Items.Add as TAbListItem; - Folders.AddObject(FolderName, ListItem); - ArcItem := nil; - end - else - // ListItem isn't below Path - Continue; - // Get file type information from the shell - if ListItem.IsDirectory then - DOSAttr := FILE_ATTRIBUTE_DIRECTORY - else - DOSAttr := FILE_ATTRIBUTE_NORMAL; - SHGetFileInfo(PChar(ExtractFileName(Filename)), DOSAttr, sfi, sizeof(sfi), - SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES); - // Fill in columns - ListItem.Caption := ExtractFileName(Filename); - ListItem.ImageIndex := sfi.iIcon; - ListItem.SubItems.Clear; - for Col := Succ(Low(Col)) to High(Col) do - if Col in FVisibleColumns then begin - ColText := ''; - ColImage := -1; - case Col of - vcFileType: - ColText := sfi.szTypeName; - vcLastModified: - if ArcItem <> nil then - ColText := DateToStr(ArcItem.LastModTimeAsDateTime) + ' ' + - TimeToStr(ArcItem.LastModTimeAsDateTime); - vcSize: - if not ListItem.IsDirectory then - ColText := FormatFloat('#,##0', ArcItem.UncompressedSize); - vcRatio: - if not ListItem.IsDirectory then - if ArcItem.UncompressedSize > 0 then - ColText := Format('%d%%', - [100 - Round(ArcItem.CompressedSize * 100 / ArcItem.UncompressedSize)]) - else - ColText := '0%'; - vcPacked: - if not ListItem.IsDirectory then - ColText := FormatFloat('#,##0', ArcItem.CompressedSize); - vcCRC: - if not ListItem.IsDirectory then - ColText := IntToHex(ArcItem.CRC32, 8); - vcAttributes: - if ArcItem <> nil then begin - {$WARN SYMBOL_PLATFORM OFF} - if (faReadOnly and ArcItem.ExternalFileAttributes) = faReadOnly then - ColText := ColText + AbReadOnlyS; - if (faHidden and ArcItem.ExternalFileAttributes) = faHidden then - ColText := ColText + AbHiddenS; - if (faSysFile and ArcItem.ExternalFileAttributes) = faSysFile then - ColText := ColText + AbSystemS; - if (faArchive and ArcItem.ExternalFileAttributes) = faArchive then - ColText := ColText + AbArchivedS; - {$WARN SYMBOL_PLATFORM ON} - end; - vcMethod: - if ArcItem is TAbZipItem then - ColText := ZipCompressionMethodToString( - TAbZipItem(ArcItem).CompressionMethod); - vcPath: - ColText := ExtractFileDir(FileName); - end; - ListItem.SubItems.Add(ColText); - ListItem.SubItemImages[ListItem.SubItems.Count - 1] := ColImage; - end; - end; - finally - Folders.Free; - end; - CustomSort(TLVCompare(@TAbCustomListView_SortProc), LPARAM(Self)); - end; - finally - Items.EndUpdate; - end; -end; - - -{ ===== TAbCustomTreeView =================================================== } -constructor TAbCustomTreeView.Create(aOwner: TComponent); -var - Bmp : TBitmap; - Icon : TIcon; - sfi: SHFILEINFO; -begin - inherited; - HideSelection := False; - Images := TImageList.Create(Self); - Bmp := TBitmap.Create; - try - Bmp.LoadFromResourceName(HInstance, 'AbComCtrls_Zip'); - Images.AddMasked(Bmp, clFuchsia); - Icon := TIcon.Create; - try - // On Windows 7 an empty filename returns the drive icon instead of a folder - SHGetFileInfo('Folder', FILE_ATTRIBUTE_DIRECTORY, sfi, sizeof(sfi), - SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES); - Icon.Handle := sfi.hIcon; - Bmp.PixelFormat := pf24bit; - Bmp.Canvas.Brush.Color := clWindow; - Bmp.Canvas.FillRect(Rect(0, 0, 16, 16)); - Bmp.Canvas.Draw(0, 0, Icon); - Images.AddMasked(Bmp, clWindow); - SHGetFileInfo('Folder', FILE_ATTRIBUTE_DIRECTORY, sfi, sizeof(sfi), - SHGFI_ICON or SHGFI_OPENICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES); - Icon.Handle := sfi.hIcon; - Bmp.Canvas.FillRect(Rect(0, 0, 16, 16)); - Bmp.Canvas.Draw(0, 0, Icon); - Images.AddMasked(Bmp, clWindow); - finally - Icon.Free; - end; - finally - Bmp.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.Change(aNode: TTreeNode); -var - Filename: string; -begin - inherited; - if aNode.Selected then begin - Filename := ''; - if aNode <> Items.GetFirstNode then begin - Filename := aNode.Text; - aNode := aNode.Parent; - while aNode <> Items.GetFirstNode do begin - Filename := aNode.Text + PathDelim + Filename; - aNode := aNode.Parent; - end; - end; - Path := Filename; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.DoChange(Sender: TObject); -var - Nodes: TStringList; - ZipNode: TTreeNode; - - function GetNode(const aFilename: string): TTreeNode; - var - i: Integer; - begin - if aFilename = '' then - Result := ZipNode - else if Nodes.Find(aFilename, i) then - Result := TTreeNode(Nodes.Objects[i]) - else begin - Result := Items.AddChild(GetNode(ExtractFileDir(aFilename)), - ExtractFileName(aFilename)); - {$IFDEF HasTreeViewExpandedImageIndex} - Result.ExpandedImageIndex := AbTreeFolderExpandedImage; - {$ENDIF} - Result.ImageIndex := AbTreeFolderImage; - Nodes.AddObject(aFilename, Result); - end; - end; - -var - i: Integer; - Filename: string; -begin - Items.BeginUpdate; - try - Items.Clear; - if Assigned(FArchive) then begin - Nodes := TStringList.Create; - try - Nodes.Sorted := True; - if Archive.FArchive <> nil then - Filename := ExtractFileName(Archive.FArchive.ArchiveName) - else - Filename := PathDelim; - ZipNode := Items.AddChild(nil, Filename); - {$IFDEF HasTreeViewExpandedImageIndex} - ZipNode.ExpandedImageIndex := AbTreeArchiveImage; - {$ENDIF} - ZipNode.ImageIndex := AbTreeArchiveImage; - for i := 0 to FArchive.Count - 1 do - if FArchive[i].Action <> aaDelete then begin - Filename := AbNormalizeFilename(FArchive[i].FileName); - if not FArchive[i].IsDirectory then - Filename := ExtractFileDir(Filename); - GetNode(Filename); - end; - finally - Nodes.Free; - end; - Items.AlphaSort(True); - ZipNode.Expand(False); - SelectPathNode; - end; - finally - Items.EndUpdate; - end; - if (Sender = FArchive) and Assigned(FListView) then - FListView.DoChange(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.GetSelectedIndex(aNode: TTreeNode); -begin - {$IFDEF HasTreeViewExpandedImageIndex} - if aNode.Expanded then - aNode.SelectedIndex := aNode.ExpandedImageIndex - else - {$ENDIF} - aNode.SelectedIndex := aNode.ImageIndex; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomTreeView.GetVersion: string; -begin - Result := AbVersionS; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.Notification(aComponent: TComponent; - aOperation: TOperation); -begin - inherited; - if aOperation = opRemove then begin - if aComponent = FArchive then begin - FArchive := nil; - Items.Clear; - end; - if aComponent = FListView then begin - if Assigned(FArchive) and SameEvent(FArchive.OnChange, FListView.DoChange) then - FArchive.OnChange := DoChange; - FListView := nil; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.SelectPathNode; -var - Filename, Remaining: string; - i: Integer; - Node: TTreeNode; -begin - // Find selected node, expanding parents along the way - Node := Items.GetFirstNode; - Remaining := FPath; - if StartsText(PathDelim, Remaining) then - System.Delete(Remaining, 1, 1); - while Remaining <> '' do begin - Node.Expand(False); - i := Pos(PathDelim, Remaining); - if i = 0 then - i := Length(Remaining) + 1; - Filename := Copy(Remaining, 1, i - 1); - Remaining := Copy(Remaining, i + 1, MaxInt); - if Filename = '' then - Continue; - Node := Node.getFirstChild; - while (Node <> nil) and not SameText(Filename, Node.Text) do - Node := Node.getNextSibling; - if Node = nil then begin - Node := Items.GetFirstNode; - Break; - end; - end; - Selected := Node; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.SetArchive(aValue: TAbBaseBrowser); -begin - if aValue <> FArchive then begin - if Assigned(FArchive) then begin - FArchive.RemoveFreeNotification(Self); - if SameEvent(FArchive.OnChange, DoChange) then - if Assigned(ListView) and (ListView.Archive = FArchive) then - FArchive.OnChange := ListView.DoChange - else - FArchive.OnChange := nil; - end; - FArchive := aValue; - if Assigned(FArchive) then begin - FArchive.FreeNotification(Self); - FArchive.OnChange := DoChange; - DoChange(Self); - end - else - Items.Clear; - if Assigned(ListView) then - ListView.Archive := aValue; - SelectPathNode; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.SetListView(aValue: TAbCustomListView); -begin - if aValue <> FListView then begin - if Assigned(FListView) then begin - FListView.RemoveFreeNotification(Self); - FListView.TreeView := nil; - end; - FListView := aValue; - if Assigned(FListView) then begin - FListView.FreeNotification(Self); - if Assigned(FArchive) then - FListView.Archive := FArchive - else if Assigned(FListView.Archive) then - Archive := FListView.Archive; - FListView.TreeView := Self; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomTreeView.SetPath(const aValue: string); -begin - if FPath <> aValue then begin - FPath := ExcludeTrailingPathDelimiter(aValue); - SelectPathNode; - if Assigned(FListView) then - FListView.Path := aValue; - end; -end; - - -{ ===== TAbProgressBar ====================================================== } -procedure TAbProgressBar.DoProgress(Progress : Byte); -begin - Position := Progress; - Application.ProcessMessages; -end; -{ -------------------------------------------------------------------------- } -function TAbProgressBar.GetVersion : string; -begin - Result := AbVersionS; -end; -{ -------------------------------------------------------------------------- } -procedure TAbProgressBar.Reset; -begin - DoProgress(0); -end; - -end. diff --git a/components/Abbrevia/source/AbComCtrls.res b/components/Abbrevia/source/AbComCtrls.res deleted file mode 100644 index 7698351..0000000 Binary files a/components/Abbrevia/source/AbComCtrls.res and /dev/null differ diff --git a/components/Abbrevia/source/AbCompnd.pas b/components/Abbrevia/source/AbCompnd.pas deleted file mode 100644 index d646fd9..0000000 --- a/components/Abbrevia/source/AbCompnd.pas +++ /dev/null @@ -1,2238 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCompnd.pas *} -{*********************************************************} -{* ABBREVIA: Compound File classes and component *} -{* Use AbQCmpnd.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbCompnd; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses - Classes, SysUtils, -{$IFDEF UsingClx} - QComCtrls, -{$ELSE} - ComCtrls, -{$ENDIF} - AbBase, AbResString, AbDfDec, AbDfEnc, AbDfBase; - -const - AbCompoundFileVersion = '3.1'; - -const - {SystemBlock constants} - sbSignatureSize = 40; {byte size of Signature field} - sbVolumeLabelSize = 40; {byte size of Volume Label field} - sbAllocationSizeSize = 4; {byte size of Allocation Size field} - sbVersionSize = 4; {byte size of Version field} - sbUpdateSize = 1; {byte size of Updating Flag field} - - {Total size of System Block} - SizeOfSystemBlock = sbSignatureSize + sbVolumeLabelSize + - sbAllocationSizeSize + sbVersionSize + sbUpdateSize; - - {RootDir constants} - rdEntryNameSize = 28; {byte size of Name field} - rdEntryIDSize = 4; {byte size of EntryID field} - rdParentFolderSize = 4; {byte size of ParentFolder field} - rdEntryTypeSize = 4; {byte size of EntryType field} - rdAttributesSize = 4; {byte size of Attributes field} - rdStartBlockSize = 4; {byte size of StartBlock field} - rdLastModifiedSize = 8; {byte size of LastModified field} - rdSizeSize = 4; {byte size of UncompressedSize field} - rdCompressedSizeSize = 4; {byte size of CompressedSize field} - - {Total size of a single Root Directory Entry} - rdSizeOfDirEntry = rdEntryNameSize + rdEntryIDSize + rdParentFolderSize + - rdEntryTypeSize + rdAttributesSize + rdStartBlockSize + - rdLastModifiedSize + rdSizeSize + rdCompressedSizeSize; - - rdUnUsed = -2; {Constant used to flag an RD entry as unused} - - {Total size of a Root Directory entry} - SizeOfRootDirBlock = rdEntryNameSize + rdEntryIDSize + rdParentFolderSize + - rdEntryTypeSize + rdAttributesSize + rdStartBlockSize + - rdLastModifiedSize + rdSizeSize + rdCompressedSizeSize; - - {FAT table constants} - ftEndOfBlock = -1; {End of Block} - ftUnusedBlock = -2; {Unused Block} - - {General constants} - cfAllocationSize = 512; {Default AllocationSize (bytes)} - -type - ECompoundFileError = class(Exception); - TrdEntryType = (etFolder, etFile); - - {dynamic array parameter for returning FAT chain sequences} - type TFATChainArray = array of Integer; - - {forwards} -{$M+} - TAbCompoundFile = class; -{$M-} - TBeforeDirDeleteEvent = procedure(Sender : TAbCompoundFile; Dir : AnsiString; - var AllowDelete : Boolean) of object; - TBeforeDirModifiedEvent = procedure(Sender : TAbCompoundFile; Dir : AnsiString; - var AllowModify : Boolean) of object; - TBeforeFileDeleteEvent = procedure(Sender : TAbCompoundFile;FileName : AnsiString; - var AllowDelete : Boolean) of object; - TBeforeFileModifiedEvent = procedure(Sender : TAbCompoundFile; - FileName : AnsiString; var AllowModify : - Boolean) of object; - - TMultiNode = class(TObject) - protected {private} - FParent : Pointer; {pointer to the parent node} - FKey : AnsiString; {node identifier} - FChildren : TStringList; {list for child keys & nodes} - FData : TObject; {contained object} - - function GetChildCount : Integer; - public - constructor Create(const Key : AnsiString); - destructor Destroy; override; - function AddChild(const Key : AnsiString) : TMultiNode; - procedure DeleteChild(Index : Integer); - function DeleteChildByName(const ChildKey : AnsiString) : Boolean; - function DeleteChildren : Boolean; - function GetChild(Index : integer) : TMultiNode; - function GetChildByName(const Key : AnsiString) : TMultiNode; - function HasParent : Boolean; - function HasChildren : Boolean; - function Contains(const Key : AnsiString) : Boolean; - property Parent : Pointer read FParent write FParent; - property ChildCount : Integer read GetChildCount; - property Children[Index : Integer] : TMultiNode read GetChild; - property Data : TObject read FData write FData; - property Key : AnsiString read FKey write FKey; - end; - - - TMultiTree = class(TObject) - protected {private} - FRoot : TMultiNode; {reference to root node} - FCount : Integer; {count of nodes in the tree} - FCurrentNode : TMultiNode; {analogous to current directory} - FSepChar : AnsiChar; {directory separator character} - FIDCount : Integer; {counter incremented during preorder trav.} - {(used to assign unique ID to each node)} - - procedure VisitSubNodesPost(Node : TMultiNode; ID : Integer); - procedure VisitSubNodesPre(Node : TMultiNode; Strm : TStream); - procedure VisitNode(Node : TMultiNode; Strm : TStream); - procedure ParseDirStr(const Key : AnsiString; Lst : TStringList); - procedure PopulateSubNodes(ParentNode : TMultiNode; - TreeView : TTreeView; TreeNode : TTreeNode); - procedure TraversePost(ID : Integer); - procedure TraversePre(Strm : TStream); - - public - constructor Create; - destructor Destroy; override; - function Insert(ParentNode : TMultiNode; const Key : AnsiString) : TMultiNode; - function GetNode(const Key : AnsiString) : TMultiNode; - function DeleteNode(const Key : AnsiString) : Boolean; - procedure ChangeDir(const Key : AnsiString); - function PopulateTreeView(TreeView : TTreeView) : Integer; - property Root : TMultiNode read FRoot; - property Count : Integer read FCount; - property CurrentNode : TMultiNode read FCurrentNode; - property SepChar : AnsiChar read FSepChar write FSepChar; - end; - - - TAbSystemBlock = class(TObject) - protected {private} - FSignature : AnsiString; {identifies the compound file structure} - FVolumeLabel : AnsiString; {file identification in addition to filename} - FAllocationSize : Integer; {size of allocation block} - FVersion : AnsiString; {version string identifier} - FUpdating : Boolean; {internal processing indicator} - - {protected methods} - procedure BeginUpdate; - procedure EndUpdate; - procedure WriteToStream(Strm : TMemoryStream); - - {properties} - property Signature : AnsiString read FSignature write FSignature; - property VolumeLabel : AnsiString read FVolumeLabel write FVolumeLabel; - property Updating : Boolean read FUpdating; - property AllocationSize : Integer - read FAllocationSize write FAllocationSize; - property Version : AnsiString read FVersion; - public - constructor Create(const VolLabel : AnsiString; AllocationSz : Integer); - end; - - TAbDirectoryEntry = class(TObject) - protected {private} - FName : AnsiString; {name of file or folder} - FEntryID : Integer; {unique ID for this dir. entry} - FParentFolder : LongInt; {unique ID of parent folder} - FEntryType : TrdEntryType; {folder or file} - FAttributes : LongInt; {file system attributes} - FStartBlock : LongInt; {starting allocation block} - FLastModified : TDateTime; {last modification date/time} - FSize : LongInt; {uncompressed file size} - FCompressedSize : LongInt; {compressed file size} - - procedure WriteToStream(Strm : TMemoryStream); - function IsReadOnly : Boolean; - function IsHidden : Boolean; - function IsSysFile : Boolean; - function IsVolumeID : Boolean; - function IsDirectory : Boolean; - function IsArchive : Boolean; - function GetIsFree : Boolean; - - public - constructor Create(AsFile : Boolean); - - property EntryName : AnsiString read FName write FName; - property ParentFolder : LongInt read FParentFolder write FParentFolder; - property Attributes : LongInt read FAttributes write FAttributes; - property StartBlock : LongInt read FStartBlock write FStartBlock; - property LastModified : TDateTime read FLastModified write FLastModified; - property Size : LongInt read FSize write FSize; - property CompressedSize : LongInt - read FCompressedSize write FCompressedSize; - property IsFree : Boolean read GetIsFree; - property EntryType : TrdEntryType read FEntryType write FEntryType; - end; - - - TAbRootDir = class(TMultiTree) - fAllocSize : Integer; - protected {private} - function AddFolder(FolderName : AnsiString) : TAbDirectoryEntry; - function AddFile(FileName : AnsiString) : TAbDirectoryEntry; - procedure DeleteFolder(FolderName : AnsiString); - procedure DeleteFile(FileName : AnsiString); - procedure WriteToStream(Strm : TMemoryStream); - procedure GoToEntryID(ID : Integer); - public - constructor Create(VolLabel : AnsiString; AllocSize : Integer); - destructor Destroy; override; - end; - - - TAbFATTable = class(TObject) - protected {private} - fFATArray : Array of Integer; {dynamic array for the FAT} - fAllocSize : Integer; - - procedure WriteToStream(Strm : TMemoryStream); - - public - constructor Create(AllocSize : Integer); - destructor Destroy; override; - function IsEndOfFile(Ndx : Integer) : Boolean; - function IsUnUsed(Ndx : Integer) : Boolean; - function GetNextUnusedBlock : Integer; - procedure GetNewChain(NumBytes : Integer; - var ChainArray : TFATChainArray); - procedure GetExistingChain(StartNdx : Integer; - var ChainArray : TFATChainArray); - procedure ClearExistingChain(StartNdx : Integer); - procedure GetRootDirChain(var ChainArray : TFATChainArray); - procedure GetFATChain(var ChainArray : TFATChainArray); - procedure GetNewRootDirChain(NumBytes : Integer; - var ChainArray : TFATChainArray); - procedure GetNewFATChain(NumBytes : Integer; - var ChainArray : TFATChainArray); - procedure ClearRootDirChain; - procedure ClearFATChain; - end; - - - TAbCompoundFile = class(TObject) - protected {private} - FSystemBlock : TAbSystemBlock; {system block} - FFATTable : TAbFATTable; {FAT table} - FRootDir : TAbRootDir; {root directory} - FDiskFile : string; {compound file name} - FSizeOnDisk : Integer; {sum total of compressed sizes + - uncompressed Sys, RootDir, & FAT blks} - FStream : TFileStream; {Compound file stream (*.cf)} - - FOnAfterOpen : TNotifyEvent; - FOnBeforeClose : TNotifyEvent; - FOnBeforeDirDelete : TBeforeDirDeleteEvent; - FOnBeforeDirModified : TBeforeDirModifiedEvent; - FOnBeforeFileDelete : TBeforeFileDeleteEvent; - FOnBeforeFileModified : TBeforeFileModifiedEvent; - - function GetVolumeLabel : AnsiString; - procedure SetVolumeLabel(Val : AnsiString); - function GetDirectoryEntries : Integer; - function GetSizeOnDisk : Integer; - procedure PersistFileData(FileData : TStream; - var ChainArray : TFATChainArray); - procedure PersistSystemBlock; - procedure PersistRootDirBlock; - procedure PersistFATBlock; - procedure BuildSysBlock; - procedure BuildFat; - procedure BuildRootDir; - procedure AddDirEntriesFromList(Lst : TStringList); - - procedure Defrag; {not implemented} - public - constructor Create(const FileName : string; const VolLabel : AnsiString; - AllocSize : Integer); overload; - constructor Create(const FileName : string; const VolLabel : AnsiString; - AllocSize : Integer; const Signature: AnsiString); overload; - destructor Destroy; override; - procedure EnumerateFiles(Lst : TStringList); - procedure EnumerateFolders(Lst : TStringList); - procedure AddFile(FName : AnsiString; FileData : TStream; FileSize : Integer); - function AddFolder(FName : AnsiString) : Boolean; - procedure UpdateFile(FName : AnsiString; FData : TStream); - procedure DeleteFile(FName : AnsiString); - procedure DeleteFolder(FName : AnsiString); - procedure Open(const FName : string); overload; - procedure Open(const FName : string; const Signature: AnsiString); overload; - function OpenFile(FileName : AnsiString; var Strm : TStream) : Integer; - function PopulateTreeView(TreeView : TTreeView) : Integer; - procedure PopulateSubNodes(ParentNode : TMultiNode; - TreeView : TTreeView; TreeNode : TTreeNode); - procedure RenameFile(OrigName, NewName : AnsiString); - procedure RenameFolder(OrigName, NewName : AnsiString); - procedure SetCurrentDirectory(val : AnsiString); - function GetCurrentDirectory : AnsiString; - function GetAllocationSize : Integer; - property CurrentDirectory : AnsiString - read GetCurrentDirectory write SetCurrentDirectory; - property DirectoryEntries : Integer read GetDirectoryEntries; - property SizeOnDisk : Integer read GetSizeOnDisk; - property Stream : TFileStream read FStream write FStream; - - - published - property VolumeLabel : AnsiString read GetVolumeLabel write SetVolumeLabel; - property FileName : string read FDiskFile; - property AllocationSize : Integer read GetAllocationSize; - - property OnAfterOpen : TNotifyEvent - read FOnAfterOpen write FOnAfterOpen; - property OnBeforeClose : TNotifyEvent - read FOnBeforeClose write FOnBeforeClose; - property OnBeforeDirDelete : TBeforeDirDeleteEvent - read FOnBeforeDirDelete write FOnBeforeDirDelete; - property OnBeforeDirModified : TBeforeDirModifiedEvent - read FOnBeforeDirModified write FOnBeforeDirModified; - property OnBeforeFileDelete : TBeforeFileDeleteEvent - read FOnBeforeFileDelete write FOnBeforeFileDelete; - property OnBeforeFileModified : TBeforeFileModifiedEvent - read FOnBeforeFileModified write FOnBeforeFileModified; - end; - -implementation - -uses - StrUtils{$IFDEF HasAnsiStrings}, AnsiStrings{$ENDIF}; - -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} - {TMultiNode} -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} -constructor TMultiNode.Create(const Key : AnsiString); - {- Creates and initializes a new node} -begin - inherited Create; - FKey := Key; - FChildren := TStringList.Create; - FChildren.Sorted := True; - FChildren.Duplicates := dupError; -end; -{-----------------------------------------------------------------------------} -destructor TMultiNode.Destroy; - {- Destroys the node and all of the children} -var - i : integer; -begin - {free children} - for i := FChildren.Count - 1 downto 0 do - FChildren.Objects[i].Free; - FChildren.Free; - if Assigned(FData) then - TAbDirectoryEntry(FData).Free; - inherited Destroy; -end; -{-----------------------------------------------------------------------------} -function TMultiNode.AddChild(const Key : AnsiString) : TMultiNode; - {- Creates and adds a new node - returns the newly added node} -begin - if Contains(Key) then - Result := nil - else begin - Result := TMultiNode.Create(Key); - Result.Parent := self; - FChildren.AddObject(string(Key), Result); - end; -end; -{-----------------------------------------------------------------------------} -function TMultiNode.Contains(const Key : AnsiString) : Boolean; - {- Returns true if the node contains a child of the name specified by 'Key'} -begin - Result := (FChildren.IndexOf(string(Key)) >= 0); -end; -{-----------------------------------------------------------------------------} -procedure TMultiNode.DeleteChild(Index : Integer); - {- Deletes the child node specified by 'Index'} -begin - if ((Index < 0) or (Index > FChildren.Count - 1)) then - raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds); - FChildren.Objects[Index].Free; - FChildren.Delete(Index); -end; -{-----------------------------------------------------------------------------} -function TMultiNode.DeleteChildByName(const ChildKey : AnsiString) : Boolean; - {- If node found, node is deleted and true is returned, else returns false} -begin - Result := Contains(ChildKey); - if Result then begin - FChildren.Objects[FChildren.IndexOf(string(ChildKey))].Free; - FChildren.Delete(FChildren.IndexOf(string(ChildKey))); - end; -end; -{-----------------------------------------------------------------------------} -function TMultiNode.DeleteChildren : Boolean; - {- Deletes all child nodes} -var - i : Integer; -begin - Result := FChildren.Count > 0; - for i := FChildren.Count - 1 downto 0 do begin - FChildren.Objects[i].Free; - FChildren.Delete(i); - end; -end; -{-----------------------------------------------------------------------------} -function TMultiNode.GetChild(Index : integer) : TMultiNode; - {- Returns the node specified by Index} -begin - if ((Index < 0) or (Index > FChildren.Count - 1)) then - raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds); - Result := (FChildren.Objects[Index] as TMultiNode); -end; -{-----------------------------------------------------------------------------} -function TMultiNode.GetChildByName(const Key : AnsiString) : TMultiNode; - {- Returns the child node specified by 'Key'. If not found, result = nil} -begin - Result := nil; - if Contains(Key) then - Result := (FChildren.Objects[FChildren.IndexOf(string(Key))] as TMultiNode); -end; -{-----------------------------------------------------------------------------} -function TMultiNode.GetChildCount : Integer; - {- Returns the node's children count} -begin - Result := FChildren.Count; -end; -{-----------------------------------------------------------------------------} -function TMultiNode.HasParent : Boolean; - {- Returns true if parent is assigned, else returns false} -begin - Result := (FParent <> nil); -end; -{-----------------------------------------------------------------------------} -function TMultiNode.HasChildren : Boolean; - {- Returns true if the node contains 1 or more child nodes.} -begin - Result := (FChildren.Count > 0); -end; -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} - {TMultiTree} -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} -constructor TMultiTree.Create; - {- creates an empty tree} -begin - inherited Create; - FSepChar := '\'; -end; -{-----------------------------------------------------------------------------} -destructor TMultiTree.Destroy; - {- destroys all nodes (post-order)} -var - Curr : TMultiNode; -begin - Curr := Root; - while Curr <> nil do begin - if Curr.HasChildren then - Curr := Curr.Children[0] - else - begin - if Curr = Root then begin - Curr.Free; - exit; - end else begin - Curr := Curr.Parent; - Curr.DeleteChild(0); - end; - end; - end; -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.ChangeDir(const Key : AnsiString); - {- Sets current directory of tree if path('Key') is valid} -var - Node : TMultiNode; - Lst : TStringList; - i, Ndx : integer; - NotFound : Boolean; -begin - if Root = nil then exit; - NotFound := False; - Lst := TStringList.Create; - try - ParseDirStr(Key, Lst); - Node := CurrentNode; - for i := 0 to Lst.Count - 1 do begin - - if Lst.Strings[i] = '\' then begin - Node := Root; - Continue; - end - - else if Lst.Strings[i] = '.' then - Continue - - else if Lst.Strings[i] = '..' then begin - if Node <> Root then - Node := TMultiNode(Node.Parent); - end else begin - Ndx := Node.FChildren.IndexOf(Lst.Strings[i]); - if Ndx >= 0 then - Node := Node.GetChild(Ndx) - else begin - NotFound := True; - Break; - end; - end; - end; - finally - Lst.Free; - end; - if NotFound = false then - FCurrentNode := Node; -end; -{-----------------------------------------------------------------------------} -function TMultiTree.DeleteNode(const Key : AnsiString) : Boolean; - {- If node found, deletes the node & returns true, else returns false} -begin - Result := False; - if CurrentNode <> nil then - if CurrentNode.Contains(Key) then begin - Result := CurrentNode.DeleteChildByName(Key); - Dec(FCount); - end; -end; -{-----------------------------------------------------------------------------} -function TMultiTree.GetNode(const Key : AnsiString) : TMultiNode; - {- Returns the node if found, else returns nil} -begin - Result := nil; - if CurrentNode <> nil then - if CurrentNode.Contains(Key) then - Result := CurrentNode.GetChildByName(Key); -end; -{-----------------------------------------------------------------------------} -function TMultiTree.Insert(ParentNode : TMultiNode; - const Key : AnsiString) : TMultiNode; - {- Adds child node to specified ParentNode} -var - NewNode : TMultiNode; -begin - Result := nil; - if CurrentNode = nil then begin - {adding root node} - NewNode := TMultiNode.Create(Key); - FRoot := NewNode; - FCurrentNode := NewNode; - Result := NewNode; - end else begin - if not CurrentNode.Contains(Key) then begin - Result := CurrentNode.AddChild(Key); - Result.Parent := CurrentNode; - end; - end; - Inc(FCount); -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.ParseDirStr(const Key : AnsiString; Lst : TStringList); - {- parses Key into individual dir commands adding each to Lst} -var - LocKey : AnsiString; - Counter : integer; -begin - LocKey := Key; - Lst.Clear; - if LocKey = '' then - LocKey := '\'; - - {- are we to start from the root folder} - Counter := 0; - while LocKey[Counter+1] = '\' do - inc(Counter); - - if Counter = 1 then - Lst.Add('\'); - - {- begin parsing} - while Length(LocKey) > 0 do begin - while LocKey[1] = '\' do - begin - Delete(LocKey, 1, 1); - if Length(LocKey) = 0 then - exit; - end; - - if pos(SepChar,LocKey) > 0 then begin - Lst.Add(string(copy(LocKey, 1, Pos(SepChar, LocKey) - 1))); - Delete(LocKey, 1, Pos(SepChar, LocKey)); - end else - if Length(LocKey) > 0 then begin - Lst.Add(string(LocKey)); - LocKey := ''; - end; - end; -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.PopulateSubNodes(ParentNode : TMultiNode; - TreeView : TTreeView; TreeNode : TTreeNode); - {- Visits sub-nodes recursively - pre order} -var - Curr : TMultiNode; - i : Integer; - Node : TTreeNode; -begin - Node := TreeView.Items.AddChild(TreeNode, string(ParentNode.Key)); - Curr := ParentNode; - if Curr <> nil then begin - if Curr.HasChildren then begin - for i := 0 to Curr.ChildCount -1 do - PopulateSubNodes(Curr.Children[i], TreeView, Node); - end; - end; -end; -{-----------------------------------------------------------------------------} -function TMultiTree.PopulateTreeView(TreeView : TTreeView) : Integer; -{- Populates a user-supplied TTreeView with multiway tree nodes} -var - i : Integer; - TreeNode : TTreeNode; -begin - TreeView.Items.Clear; - if Root <> nil then begin - TreeNode := TreeView.Items.Add(nil, string(Root.Key)); - if Root.HasChildren then begin - for i := 0 to Root.ChildCount - 1 do - PopulateSubNodes(Root.Children[i], TreeView, TreeNode); - end; - end; - Result := TreeView.Items.Count -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.TraversePost(ID : Integer); - {- Traverses tree post-order - CurrentNode after traversal will be the node - whose EntryID = ID} -var - i : Integer; -begin - if Root <> nil then begin - if Root.HasChildren then begin - for i := 0 to Root.ChildCount - 1 do - VisitSubNodesPost(Root.Children[i], ID); - end; - if (TAbDirectoryEntry(Root.FData).FEntryID = ID) then - FCurrentNode := Root; - end; -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.TraversePre(Strm : TStream); - {- Traverses tree pre-order} -var - i : Integer; -begin - if Root <> nil then begin - FIDCount := 1; - TAbDirectoryEntry(Root.Data).FEntryID := FIDCount; - - VisitNode(Root, Strm); - if Root.HasChildren then begin - for i := 0 to Root.ChildCount - 1 do - VisitSubNodesPre(Root.Children[i], Strm); - end; - end; -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.VisitNode(Node : TMultiNode; Strm : TStream); - {- Called recursively from VisitSubNodesPre. Assigns unique entry ID's for - each directory entry to maintain hierarchy} -begin - if Node.Parent = nil then - TAbDirectoryEntry(Node.Data).ParentFolder := -1 - else - TAbDirectoryEntry(Node.Data).ParentFolder := - TAbDirectoryEntry(TMultiNode(Node.Parent).Data).FEntryID; - - TAbDirectoryEntry(Node.Data).WriteToStream(TMemoryStream(Strm)); -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.VisitSubNodesPost(Node : TMultiNode; ID : Integer); - {- Visits sub-nodes recursively - post order} -var - Curr : TMultiNode; - i : Integer; -begin - Curr := Node; - if Curr <> nil then begin - if Curr.HasChildren then begin - for i := 0 to Curr.ChildCount -1 do - VisitSubNodesPost(Curr.Children[i], ID); - end; - if (TAbDirectoryEntry(Curr.FData).FEntryID = ID) then - FCurrentNode := Curr; - end; -end; -{-----------------------------------------------------------------------------} -procedure TMultiTree.VisitSubNodesPre(Node : TMultiNode; Strm : TStream); - {- Visits sub-nodes recursively - pre order} -var - Curr : TMultiNode; - i : Integer; -begin - Curr := Node; - if Curr <> nil then begin - Inc(FIDCount); - TAbDirectoryEntry(Curr.Data).FEntryID := FIDCount; - - VisitNode(Curr, Strm); - if Curr.HasChildren then begin - for i := 0 to Curr.ChildCount -1 do - VisitSubNodesPre(Curr.Children[i], Strm); - end; - end; -end; -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} - {TAbSystemBlock} -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} -constructor TAbSystemBlock.Create(const VolLabel : AnsiString; AllocationSz : Integer); -{- Creates the System block structure of the compound file} -begin - inherited Create; - FSignature := 'AbCompoundFile'; - FVolumeLabel := VolLabel; - FAllocationSize := AllocationSz; - FVersion := AbCompoundFileVersion; - FUpdating := False; -end; -{-----------------------------------------------------------------------------} -procedure TAbSystemBlock.BeginUpdate; - {- Sets updating to true - temporarily blocking other actions} -begin - FUpdating := True; -end; -{-----------------------------------------------------------------------------} -procedure TAbSystemBlock.EndUpdate; - {- Clears updating flag & allows for other actions} -begin - FUpdating := False; -end; -{-----------------------------------------------------------------------------} -procedure TAbSystemBlock.WriteToStream(Strm : TMemoryStream); - {- writes the contents to the stream parameter} -var - Sig : Array[0..sbSignatureSize - 1] of AnsiChar; - VolLabel : Array[0..sbVolumeLabelSize - 1] of AnsiChar; - AllocSize : Integer; - Version : Array[0..sbVersionSize - 1] of AnsiChar; - Updt : Byte; -begin - FillChar(Sig, sbSignatureSize, #0); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(Sig, FSignature); - - FillChar(VolLabel[0], sbVolumeLabelSize, #0); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(VolLabel, FVolumeLabel); - - AllocSize := FAllocationSize; - - FillChar(Version[0], sbVersionSize, #0); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(Version, FVersion); - - if FUpdating then - Updt := $01 - else - Updt := $00; - - Strm.Write(Sig[0], sbSignatureSize); - Strm.Write(VolLabel[0], sbVolumeLabelSize); - Strm.Write(AllocSize, SizeOf(Integer)); - Strm.Write(Version[0], sbVersionSize); - Strm.Write(Updt, sbUpdateSize); -end; -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} - {TAbDirectoryEntry} -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} -constructor TAbDirectoryEntry.Create(AsFile : Boolean); - {- Creates & initializes a new TAbDirectoryEntry} -begin - inherited Create; - FName := ''; - FParentFolder := rdUnused; - if AsFile then begin - FEntryType := etFile; - {$WARN SYMBOL_PLATFORM OFF} - FAttributes := faArchive; - {$WARN SYMBOL_PLATFORM ON} - end else begin - FEntryType := etFolder; - FAttributes := faDirectory; - end; - FStartBlock := rdUnused; - FLastModified := 0; - FSize := rdUnused; - FCompressedSize := rdUnused; -end; -{-----------------------------------------------------------------------------} -function TAbDirectoryEntry.GetIsFree : Boolean; - {- returns true if the entry has been marked for deletion} -begin - Result := (FName = ''); -end; -{-----------------------------------------------------------------------------} -function TAbDirectoryEntry.IsArchive : Boolean; - {- returns true if the entry is an archive} -begin -{$WARN SYMBOL_PLATFORM OFF} - Result := ((FAttributes and faArchive) > 0); -{$WARN SYMBOL_PLATFORM ON} -end; -{-----------------------------------------------------------------------------} -function TAbDirectoryEntry.IsDirectory : Boolean; - {- returns true if the entry is a directory} -begin - Result := ((FAttributes and faDirectory) > 0); -end; -{-----------------------------------------------------------------------------} -function TAbDirectoryEntry.IsHidden : Boolean; - {- returns true if the entry is hidden} -begin -{$WARN SYMBOL_PLATFORM OFF} - Result := ((FAttributes and faHidden) > 0); -{$WARN SYMBOL_PLATFORM ON} -end; -{-----------------------------------------------------------------------------} -function TAbDirectoryEntry.IsReadOnly : Boolean; - {- returns true if the entry is read-only} -begin -{$WARN SYMBOL_PLATFORM OFF} - Result := ((FAttributes and faReadOnly) > 0); -{$WARN SYMBOL_PLATFORM ON} -end; -{-----------------------------------------------------------------------------} -function TAbDirectoryEntry.IsSysFile : Boolean; - {- returns true if the entry is a system file} -begin -{$WARN SYMBOL_PLATFORM OFF} - Result := ((FAttributes and faSysFile) > 0); -{$WARN SYMBOL_PLATFORM ON} -end; -{-----------------------------------------------------------------------------} -function TAbDirectoryEntry.IsVolumeID : Boolean; - {- returns true if the entry is a volume ID} -begin -{$WARN SYMBOL_DEPRECATED OFF} -{$WARN SYMBOL_PLATFORM OFF} - Result := ((FAttributes and faVolumeID) > 0); -{$WARN SYMBOL_PLATFORM ON} -{$WARN SYMBOL_DEPRECATED ON} -end; -{-----------------------------------------------------------------------------} -procedure TAbDirectoryEntry.WriteToStream(Strm : TMemoryStream); - {- writes properties to stream} -var - EntryName : Array[0..rdEntryNameSize] of AnsiChar; - FType : Integer; -begin - FillChar(EntryName, rdEntryNameSize - 1, #0); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(EntryName, FName); - - Strm.Write(EntryName[0], rdEntryNameSize); - - Strm.Write(FEntryID, rdEntryIDSize); - Strm.Write(FParentFolder, rdParentFolderSize); - - if EntryType = etFolder then - FType := $00000000 - else - FType := $00000001; - Strm.Write(FType, rdEntryTypeSize); - Strm.Write(FAttributes, rdAttributesSize); - Strm.Write(FStartBlock, rdStartBlockSize); - Strm.Write(FLastModified, rdLastModifiedSize); - Strm.Write(FSize, rdSizeSize); - Strm.Write(FCompressedSize, rdCompressedSizeSize); -end; -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} - {TAbRootDir} -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} -constructor TAbRootDir.Create(VolLabel : AnsiString; AllocSize : Integer); - {- Creates a single-entry (vol-label) root directory structure} -begin - inherited Create; - fAllocSize := AllocSize; - if VolLabel <> '' then - AddFolder(VolLabel); -end; -{-----------------------------------------------------------------------------} -destructor TAbRootDir.Destroy; - {- Destroys the root dir.} -begin - inherited Destroy; -end; -{-----------------------------------------------------------------------------} -function TAbRootDir.AddFile(FileName : AnsiString) : TAbDirectoryEntry; - {- Adds a file to the current directory of the compound file} -var - NewNode : TMultiNode; - NewData : TAbDirectoryEntry; -begin - NewData := nil; - NewNode := Insert(CurrentNode, FileName); - if NewNode <> nil then begin - NewData := TAbDirectoryEntry.Create(True); - NewData.FName := FileName; - NewData.ParentFolder := 1; -{$WARN SYMBOL_PLATFORM OFF} - NewData.Attributes := faArchive; -{$WARN SYMBOL_PLATFORM ON} - NewData.StartBlock := 3; - NewData.LastModified := Now; - NewData.Size := 4; - NewData.CompressedSize := 5; - NewData.EntryType := etFile; - NewNode.Data := NewData; - end; - Result := NewData; -end; -{-----------------------------------------------------------------------------} -function TAbRootDir.AddFolder(FolderName : AnsiString) : TAbDirectoryEntry; - {- Adds a folder to the current directory of the compound file} -var - NewNode : TMultiNode; - NewData : TAbDirectoryEntry; -begin - Result := nil; - NewNode := Insert(CurrentNode, FolderName); - if NewNode <> nil then begin - NewData := TAbDirectoryEntry.Create(False); - NewData.FName := FolderName; - NewData.ParentFolder := 1; - NewData.Attributes := faDirectory; - NewData.StartBlock := rdUnUsed; - NewData.LastModified := Now; - NewData.Size := 0; - NewData.CompressedSize := 0; - NewData.EntryType := etFolder; - NewNode.Data := NewData; - Result :=NewData; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbRootDir.DeleteFile(FileName : AnsiString); - {- Deletes the specified file if found} -begin - DeleteNode(FileName); -end; -{-----------------------------------------------------------------------------} -procedure TAbRootDir.DeleteFolder(FolderName : AnsiString); - {- Deletes the specifed folder if found & empty} -begin - if not CurrentNode.Contains(FolderName) then - raise ECompoundFileError.Create(AbCmpndFileNotFound); - if CurrentNode.ChildCount > 0 then - raise ECompoundFileError.Create(AbCmpndFolderNotEmpty); - DeleteFolder(FolderName); -end; -{-----------------------------------------------------------------------------} -procedure TAbRootDir.WriteToStream(Strm : TMemoryStream); - {- Streams and writes the root directory entries to the stream parameter} -begin - TraversePre(Strm); -end; -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} - {TAbFATTable} -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} -constructor TAbFATTable.Create(AllocSize : Integer); - {- Creates the FAT table structure} -var - i : Integer; -begin - {Sets FAT length equal to one allocation block} - fAllocSize := AllocSize; - SetLength(fFATArray, AllocSize div SizeOf(Integer)); - for i := 0 to High(fFATArray) do - fFATArray[i] := ftUnusedBlock; - for i := 0 to 2 do - fFATArray[i] := ftEndOfBlock; -end; -{-----------------------------------------------------------------------------} -destructor TAbFATTable.Destroy; - {- Destroys the FAT table} -begin - Finalize(fFATArray); -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.ClearExistingChain(StartNdx : Integer); - {- Sets all of the FAT entries pertaining to the sequence starting at StartNds - to ftUnUsedBlock} -var - ChainArray : TFATChainArray; - i : Integer; -begin - SetLength(ChainArray, 0); - GetExistingChain(StartNdx, ChainArray); - for i := 0 to High(ChainArray) do - fFATArray[ChainArray[i]] := ftUnUsedBlock; -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.ClearFATChain; - {- Sets the FAT entries pertaining to the FAT table to unused} -begin - ClearExistingChain(2); -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.ClearRootDirChain; - {- Sets the FAT entries pertaining the the RootDir to unused} -begin - ClearExistingChain(1); -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.GetExistingChain(StartNdx : Integer; - var ChainArray : TFATChainArray); - {- Walks the FAT table starting at the index specified, and populates the - chain array parameter with the results} -var - BlkCount, i, ChainNdx : Integer; -begin - if fFATArray[StartNdx] = ftUnUsedBlock then begin - SetLength(ChainArray, 0); - exit; - end; - - {determine count} - if StartNdx < 1 then - SetLength(ChainArray, 0) - else begin - BlkCount := 1; - i := StartNdx; - while fFATArray[i] <> ftEndOfBlock do begin - i := fFATArray[i]; - Inc(BlkCount); - end; - - {set up array} - SetLength(ChainArray, BlkCount); - for i := 0 to High(ChainArray) do - ChainArray[i] := ftUnusedBlock; - - {walk FAT & populate array} - ChainNdx := 0; - ChainArray[ChainNdx] := StartNdx; - i := StartNdx; - while fFATArray[i] <> ftEndOfBlock do begin - Inc(ChainNdx); - ChainArray[ChainNdx] := fFATArray[i]; - i := fFATArray[i]; - end; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.GetFATChain(var ChainArray : TFATChainArray); - {- Returns the sequence of FAT blocks used by the FAT table in the - ChainArray parameter} -begin - GetExistingChain(2, ChainArray); -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.GetNewChain(NumBytes : Integer; - var ChainArray : TFATChainArray); - {- Finds sequence of free blocks required of a file of size NumBytes - The new FAT chain is commited and passed back in the ChainArray parameter} -var - FirstBlock : Integer; - TotalBlocksRequired : Integer; - i, j, BlocksFound : Integer; -begin - if ((NumBytes mod fAllocSize) <> 0) then - TotalBlocksRequired := (NumBytes div fAllocSize) + 1 - else - TotalBlocksRequired := (NumBytes div fAllocSize); - - if TotalBlocksRequired = 0 then - exit; - - FirstBlock := GetNextUnusedBlock; - - {set up array} - SetLength(ChainArray, TotalBlocksRequired); - for i := 0 to High(ChainArray) do - ChainArray[i] := ftUnusedBlock; - - ChainArray[0] := FirstBlock; - BlocksFound := 1; - i := FirstBlock + 1; - - while BlocksFound < TotalBlocksRequired do begin - if ((fFATArray[i] = ftUnusedBlock) and (i > 2)) then begin - ChainArray[BlocksFound] := i; - inc(BlocksFound); - end; - Inc(i); - - if i > High(fFATArray) then begin - {grow FAT (allocate another block)} - SetLength(fFATArray, Length(fFATArray) + (fAllocSize div SizeOf(Integer))); - for j := High(fFATArray) downto (Length(fFATArray) - - (fAllocSize div SizeOf(Integer))) do - fFATArray[j] := ftUnUsedBlock; - end; - end; - - {Update FAT} - for i := 0 to High(ChainArray) do begin - if i = High(ChainArray) then - fFATArray[ChainArray[i]] := -1 - else - fFATArray[ChainArray[i]] := ChainArray[i+1]; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.GetNewFATChain(NumBytes : Integer; - var ChainArray : TFATChainArray); - {- Finds and commits a new chain starting at the 3rd block. The new chain is - returned in the ChainArray parameter} -var - FirstBlock : Integer; - TotalBlocksRequired : Integer; - i, j, BlocksFound : Integer; -begin - if ((NumBytes mod fAllocSize) <> 0) then - TotalBlocksRequired := (NumBytes div fAllocSize) + 1 - else - TotalBlocksRequired := (NumBytes div fAllocSize); - - if TotalBlocksRequired = 0 then - exit; - - FirstBlock := 2; - - {set up array} - SetLength(ChainArray, TotalBlocksRequired); - for i := 0 to High(ChainArray) do - ChainArray[i] := ftUnusedBlock; - - ChainArray[0] := FirstBlock; - BlocksFound := 1; - i := FirstBlock + 1; - - while BlocksFound < TotalBlocksRequired do begin - if ((fFATArray[i] = ftUnusedBlock) and (i > 2)) then begin - ChainArray[BlocksFound] := i; - inc(BlocksFound); - end; - Inc(i); - - if i > High(fFATArray) then begin - {grow FAT (allocate another block)} - SetLength(fFATArray, Length(fFATArray) + (fAllocSize div SizeOf(Integer))); - for j := High(fFATArray) downto (Length(fFATArray) - - (fAllocSize div SizeOf(Integer))) do - fFATArray[j] := ftUnUsedBlock; - end; - end; - - {Update FAT} - for i := 0 to High(ChainArray) do begin - if i = High(ChainArray) then - fFATArray[ChainArray[i]] := -1 - else - fFATArray[ChainArray[i]] := ChainArray[i+1]; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.GetNewRootDirChain(NumBytes : Integer; - var ChainArray : TFATChainArray); - {- Finds and commits a new chain starting at the 2nd block. The new chain is - returned in the ChainArray parameter} -var - FirstBlock : Integer; - TotalBlocksRequired : Integer; - i, j, BlocksFound : Integer; -begin - if ((NumBytes mod fAllocSize) <> 0) then - TotalBlocksRequired := (NumBytes div fAllocSize) + 1 - else - TotalBlocksRequired := (NumBytes div fAllocSize); - - if TotalBlocksRequired = 0 then - exit; - - FirstBlock := 1; - - {set up array} - SetLength(ChainArray, TotalBlocksRequired); - for i := 0 to High(ChainArray) do - ChainArray[i] := ftUnusedBlock; - - ChainArray[0] := FirstBlock; - BlocksFound := 1; - i := FirstBlock + 1; - - while BlocksFound < TotalBlocksRequired do begin - if ((fFATArray[i] = ftUnusedBlock) and (i > 2)) then begin - ChainArray[BlocksFound] := i; - inc(BlocksFound); - end; - Inc(i); - - if i > High(fFATArray) then begin - {grow FAT (allocate another block)} - SetLength(fFATArray, Length(fFATArray) + (fAllocSize div SizeOf(Integer))); - for j := High(fFATArray) downto (Length(fFATArray) - - (fAllocSize div SizeOf(Integer))) do - fFATArray[j] := ftUnUsedBlock; - end; - end; - - {Update FAT} - for i := 0 to High(ChainArray) do begin - if i = High(ChainArray) then - fFATArray[ChainArray[i]] := -1 - else - fFATArray[ChainArray[i]] := ChainArray[i+1]; - end; -end; -{-----------------------------------------------------------------------------} -function TAbFATTable.GetNextUnusedBlock : Integer; - {- Returns the index into the FAT table of the next block marked as unused} -var - i, j : Integer; -begin - if Length(fFATArray) = 0 then - Result := -1 - else begin - Result := -1; - i := 3; - while i <= High(fFATArray) do begin - if fFATArray[i] = ftUnusedBlock then begin - Result := i; - exit; - end; - inc(i); - - if i > High(fFATArray) then begin - {grow FAT (allocate another block)} - SetLength(fFATArray, Length(fFATArray) + - (fAllocSize div SizeOf(Integer))); - for j := High(fFATArray) downto (Length(fFATArray) - - (fAllocSize div SizeOf(Integer))) do - fFATArray[j] := ftUnUsedBlock; - end; - end; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.GetRootDirChain(var ChainArray : TFATChainArray); - {- Returns the sequence of FAT blocks used by the RootDir in the - ChainArray parameter} -begin - GetExistingChain(1, ChainArray); -end; -{-----------------------------------------------------------------------------} -function TAbFATTable.IsEndOfFile(Ndx : Integer) : Boolean; - {- Returns true if Ndx into FAT signifies end of file} -begin - if ((Ndx < 0) or (Ndx > High(fFATArray)) or - (Length(fFATArray) = 0)) then - raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds) - else - Result := (fFATArray[Ndx] = ftEndOfBlock); -end; -{-----------------------------------------------------------------------------} -function TAbFATTable.IsUnUsed(Ndx : Integer) : Boolean; - {- Returns true if Ndx into FAT signifies an unused block} -begin - if ((Ndx < 0) or (Ndx > High(fFATArray)) or - (Length(fFATArray) = 0)) then - raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds) - else - Result := (fFATArray[Ndx] = ftUnUsedBlock); -end; -{-----------------------------------------------------------------------------} -procedure TAbFATTable.WriteToStream(Strm : TMemoryStream); - {- Streams and writes the FAT entries to the stream parameter} -begin - Strm.Write(fFATArray[0], Length(fFATArray) * SizeOf(Integer)); -end; -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} - {TAbCompoundFile} -{-----------------------------------------------------------------------------} -{-----------------------------------------------------------------------------} -constructor TAbCompoundFile.Create(const FileName : string; const VolLabel : AnsiString; - AllocSize : Integer); - {- Creates a new instance} -var - Buff : Array of Byte; -begin - inherited Create; - FSystemBlock := TAbSystemBlock.Create(VolLabel, AllocSize); - FFATTable := TAbFATTable.Create(AllocSize); - FRootDir := TAbRootDir.Create(VolLabel, AllocSize); - {create file} - - if FileName <> '' then begin - FDiskFile := FileName; - FStream := TFileStream.Create(FileName, fmOpenReadWrite or - fmCreate or fmShareDenyNone); - - {fill first 3 blocks of file} - SetLength(Buff, 3 * AllocSize); - FStream.Write(Buff, 3 * AllocSize); - - {write System, RootDir, and FAT blocks} - PersistSystemBlock; - PersistRootDirBlock; - PersistFATBlock; - - if Assigned(FOnAfterOpen) then - FOnAfterOpen(self); - end; -end; - -constructor TAbCompoundFile.Create(const FileName : string; const VolLabel : AnsiString; - AllocSize : Integer; const Signature: AnsiString); - {- Creates a new instance} -var - Buff : Array of Byte; -begin - inherited Create; - FSystemBlock := TAbSystemBlock.Create(VolLabel, AllocSize); - FSystemBlock.Signature := {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}LeftStr(Signature, sbSignatureSize); - FFATTable := TAbFATTable.Create(AllocSize); - FRootDir := TAbRootDir.Create(VolLabel, AllocSize); - {create file} - - if FileName <> '' then begin - FDiskFile := FileName; - FStream := TFileStream.Create(FileName, fmOpenReadWrite or - fmCreate or fmShareDenyNone); - - {fill first 3 blocks of file} - SetLength(Buff, 3 * AllocSize); - FStream.Write(Buff, 3 * AllocSize); - - {write System, RootDir, and FAT blocks} - PersistSystemBlock; - PersistRootDirBlock; - PersistFATBlock; - - if Assigned(FOnAfterOpen) then - FOnAfterOpen(self); - end; -end; - -{-----------------------------------------------------------------------------} -destructor TAbCompoundFile.Destroy; - {- Persists and then destroys the instance of the compound file} -begin - PersistSystemBlock; - PersistRootDirBlock; - PersistFATBlock; - - if Assigned(FOnBeforeClose) then - FOnBeforeClose(self); - - FSystemBlock.Free; - FFATTable.Free; - FRootDir.Free; - FStream.Free; - inherited; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.AddFile(FName : AnsiString; FileData : TStream; - FileSize : Integer); - function JustFilename(const PathName : AnsiString) : AnsiString; - {-Return just the filename and extension of a pathname.} - var - I : Cardinal; - begin - Result := ''; - if PathName = '' then Exit; - I := Succ(Word(Length(PathName))); - repeat - Dec(I); - until (PathName[I] in ['\',':']) or (I = 0); - Result := System.Copy(PathName, Succ(I), rdEntryNameSize); - end; - - {- Compresses, adds & persists the data (FileData)} -var - DirEntry : TAbDirectoryEntry; - CompStream : TStream; - CompHelper : TAbDeflateHelper; - ChainArray : TFATChainArray; -begin - FName := JustFileName(FName); - if ((FStream.Size + FileData.Size + - (4 * FSystemBlock.AllocationSize)) >= MaxLongInt) then - raise ECompoundFileError.Create(AbCmpndExceedsMaxFileSize); - - if FSystemBlock.Updating then - raise ECompoundFileError.Create(AbCmpndBusyUpdating); - FSystemBlock.BeginUpdate; - CompStream := TMemoryStream.Create; - CompHelper := TAbDeflateHelper.Create; - try - DirEntry := FRootDir.AddFile(FName); - if DirEntry <> nil then begin - DirEntry.FSize := FileSize; - - {compress & update dir entry's compressed size} - FileData.Seek(0, soBeginning); - Deflate(FileData, CompStream, CompHelper); - DirEntry.FCompressedSize := CompStream.Size; - - {Get new FAT chain & persist the data} - SetLength(ChainArray, 0); - FFATTable.GetNewChain(CompStream.Size, ChainArray); - DirEntry.FStartBlock := ChainArray[0]; - PersistFileData(CompStream, ChainArray); - PersistRootDirBlock; - PersistFATBlock; - end; - finally - CompStream.Free; - CompHelper.Free; - FSystemBlock.EndUpdate; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.AddDirEntriesFromList(Lst : TStringList); - {- Add individual root directory entries to RootDir structure maintaining seq.} -var - i : Integer; - LstEntry : TAbDirectoryEntry; - Entry : TAbDirectoryEntry; -begin - for i := 0 to Lst.Count - 1 do begin - LstEntry := (Lst.Objects[i] as TAbDirectoryEntry); - - {locate parent folder} - FRootDir.GoToEntryID(LstEntry.FParentFolder); - - {Add file or folder} - if LstEntry.EntryType = etFolder then - Entry := FRootDir.AddFolder(LstEntry.FName) - else - Entry := FRootDir.AddFile(LstEntry.FName); - - {assign values} - Entry.FName := LstEntry.FName; - Entry.FEntryID := LstEntry.FEntryID; - Entry.FParentFolder := LstEntry.FParentFolder; - Entry.FEntryType := LstEntry.FEntryType; - Entry.FAttributes := LstEntry.FAttributes; - Entry.FStartBlock := LstEntry.FStartBlock; - Entry.FLastModified := LstEntry.FLastModified; - Entry.FSize := LstEntry.FSize; - Entry.FCompressedSize := LstEntry.FCompressedSize; - end; -end; -{-----------------------------------------------------------------------------} -function TAbCompoundFile.AddFolder(FName : AnsiString) : Boolean; - {- Adds a new folder (directory) to the compound file} -var - EntryCount : Integer; -begin - if ((FStream.Size + FSystemBlock.AllocationSize) >= MaxLongInt) then - raise ECompoundFileError.Create(AbCmpndExceedsMaxFileSize); - - EntryCount := FRootDir.Count; - FSystemBlock.BeginUpdate; - try - FRootDir.AddFolder(FName); - PersistRootDirBlock; - PersistFATBlock; - finally - FSystemBlock.EndUpdate; - end; - Result := ((FRootDir.Count - EntryCount) = 1); -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.BuildFat; - {- Extracts FAT from this string, writes it to DestStrm(TMemoryStream) and - ultimately updates/persists the FAT table} -var - Buff : Array of Integer; - IntBuff : Array[0..0] of Integer; - DestStrm : TMemoryStream; - i, CurrPos : Integer; - NextBlock : Integer; -begin - DestStrm := TMemoryStream.Create; - try - {Dim Buff to allocation block size} - SetLength(Buff, FSystemBlock.AllocationSize div SizeOf(Integer)); - - {Clear Buff} - for i := Low(Buff) to High(Buff) do - Buff[i] := ftUnusedBlock; - - {read 1st FAT block into Buff -> Write Buff to DestStrm} - FStream.Seek(2 * FSystemBlock.AllocationSize, soBeginning); - FStream.Read(Buff[0], FSystemBlock.AllocationSize); - DestStrm.Write(Buff[0], FSystemBlock.AllocationSize); - - {Determine next block of FAT chain} - NextBlock := Buff[2]; - - {read remaining FAT blocks if they exist} - While NextBlock <> ftEndOfBlock do begin - FStream.Seek((NextBlock) * FSystemBlock.AllocationSize, soBeginning); - - {Clear buff} - for i := Low(Buff) to High(Buff) do - Buff[i] := ftUnusedBlock; - - FStream.Read(Buff[0], FSystemBlock.AllocationSize); - DestStrm.Write(Buff[0], FSystemBlock.AllocationSize); - - {Determine the next FAT block - we'll return to this position in stream} - CurrPos := DestStrm.Position; - DestStrm.Seek((NextBlock - 1) * SizeOf(Integer), soBeginning); - DestStrm.Read(IntBuff[0], SizeOf(Integer)); - NextBlock := IntBuff[0]; - DestStrm.Seek(CurrPos, soBeginning); - end; - - {Set length of and populate the FFATTable.fFATArray in mem structure} - DestStrm.Seek(0, soBeginning); - SetLength(FFATTable.fFATArray, DestStrm.Size div SizeOf(Integer)); - for i := 1 to DestStrm.Size div SizeOf(Integer) do begin - DestStrm.Read(IntBuff[0], SizeOf(Integer)); - FFATTable.fFATArray[i-1] := IntBuff[0]; - end; - finally - DestStrm.Free; - end; - PersistFATBlock; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.BuildRootDir; - {- Builds list of root directory entries & passes list to AddDirEntriesFromList} -var - ChainArray : TFATChainArray; - DestStrm : TMemoryStream; - Buff : Array of Byte; - i : Integer; - Entry : TAbDirectoryEntry; - Lst : TStringList; - - {RootDirEntry buffers} - EName : Array[0..rdEntryNameSize - 1] of AnsiChar; - EID : Array[0..0] of Integer; - EPF : Array[0..0] of Integer; - EType : Array[0..0] of Integer; - EAttrib : Array[0..0] of Integer; - EStartBlk : Array[0..0] of Integer; - EMod : Array[0..0] of TDateTime; - ESz : Array[0..0] of Integer; - ECompSz : Array[0..0] of Integer; -begin - {Get RootDir FAT chain} - FFATTable.GetRootDirChain(ChainArray); - SetLength(Buff, FSystemBlock.AllocationSize); - DestStrm := TMemoryStream.Create; - Lst := TStringList.Create; - Lst.Duplicates := dupAccept; - Lst.Sorted := False; - try - {Read entire RotDir block to DestStrm} - for i := 0 to High(ChainArray) do begin - FStream.Seek(FSystemBlock.AllocationSize * ChainArray[i], soBeginning); - FStream.Read(Buff[0], FSystemBlock.AllocationSize); - DestStrm.Write(Buff[0], FSystemBlock.AllocationSize); - end; - - {Reset DestStrm} - DestStrm.Seek(0, soBeginning); - - {For all directory entries, read entry, create object, & add to Lst} - for i := 0 to (DestStrm.Size div rdSizeOfDirEntry) - 1 do begin - {read a single directory entry} - DestStrm.Read(EName[0], rdEntryNameSize); - if EName = '' then - continue; - DestStrm.Read(EID[0], SizeOf(Integer)); - DestStrm.Read(EPF[0], SizeOf(Integer)); - DestStrm.Read(EType[0], SizeOf(Integer)); - DestStrm.Read(EAttrib[0], SizeOf(Integer)); - DestStrm.Read(EStartBlk[0], SizeOf(Integer)); - DestStrm.Read(EMod[0], SizeOf(TDateTime)); - DestStrm.Read(ESz[0], SizeOf(Integer)); - DestStrm.Read(ECompSz[0], SizeOf(Integer)); - - if EType[0] = 0 then - Entry := TAbDirectoryEntry.Create(False) - else - Entry := TAbDirectoryEntry.Create(True); - - Entry.FName := EName; - Entry.FEntryID := EID[0]; - Entry.FParentFolder := EPF[0]; - if EType[0] = 0 then - Entry.FEntryType := etFolder - else - Entry.FEntryType := etFile; - Entry.FAttributes := EAttrib[0]; - Entry.FStartBlock := EStartBlk[0]; - Entry.FLastModified := EMod[0]; - Entry.FSize := ESz[0]; - Entry.FCompressedSize := ECompSz[0]; - - {Don't add an empty dir entry} - if Entry.FName <> '' then - Lst.AddObject(IntToStr(i), TObject(Entry)); - end; - - {Add individual root directory entries to RootDir structure maintaining seq.} - AddDirEntriesFromList(Lst); - finally - DestStrm.Free; - for i := 0 to Lst.Count - 1 do - if Lst.Objects[i] <> nil then - TAbDirectoryEntry(Lst.Objects[i]).Free; - Lst.Free; - end; - - {Save updates} - PersistRootDirBlock; - PersistFATBlock; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.BuildSysBlock; - {- Constructs System block from the contents of FStream - (used when opening an existing compound file)} -var - Sig : Array[0..sbSignatureSize - 1] of AnsiChar; - VolLabel : Array[0..sbVolumeLabelSize - 1] of AnsiChar; - Version : Array[0..sbVersionSize - 1] of AnsiChar; - AllocationSz : Array[0..0] of Integer; -begin - FStream.Seek(0, soBeginning); - FStream.Read(Sig[0], sbSignatureSize); - FStream.Read(VolLabel[0], sbVolumeLabelSize); - FStream.Read(AllocationSz[0], sbAllocationSizeSize); - FStream.Read(Version[0], sbVersionSize); - - FSystemBlock.Signature := Sig; - FSystemBlock.VolumeLabel := VolLabel; - FSystemBlock.AllocationSize := AllocationSz[0]; - FSystemBlock.FVersion := Version; - PersistSystemBlock; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.Defrag; - {- Optimizes disk storage} -begin -{ not implemeneted } -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.DeleteFile(FName : AnsiString); - {- Deletes the file from the RootDirectory and FAT blocks (data remains)} -var - StartBlock : Integer; - Allow : Boolean; - AllowDirMod : Boolean; -begin - Allow := True; - AllowDirMod := True; - - if not FRootDir.CurrentNode.Contains(FName) then - raise ECompoundFileError.Create(AbCmpndFileNotFound); - - if Assigned(FOnBeforeFileDelete) then - FOnBeforeFileDelete(self, FName, Allow); - - if Assigned(FOnBeforeDirModified) then - FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key, - AllowDirMod); - - if (Allow and AllowDirMod) then begin - StartBlock := TAbDirectoryEntry(FRootDir.GetNode(FName).FData).StartBlock; - FFATTable.ClearExistingChain(StartBlock); - - FRootDir.DeleteFile(FName); - PersistRootDirBlock; - PersistFATBlock; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.DeleteFolder(FName : AnsiString); - {- Deletes the folder from the RootDirectory block} -var - Allow : Boolean; - AllowDirMod : Boolean; -begin - Allow := True; - AllowDirMod := True; - - if not FRootDir.CurrentNode.Contains(FName) then - raise ECompoundFileError.Create(AbCmpndFileNotFound); - - if Assigned(FOnBeforeDirDelete) then - FOnBeforeDirDelete(self, FName, Allow); - - if Assigned(FOnBeforeDirModified) then - FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key, - AllowDirMod); - - if (Allow and AllowDirMod) then begin - FRootDir.DeleteFolder(FName); - PersistRootDirBlock; - PersistFATBlock; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.EnumerateFiles(Lst : TStringList); -var - i : Integer; -begin - Lst.Clear; - for i := 0 to FRootDir.CurrentNode.ChildCount - 1 do begin - if (FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryType = etFile then - Lst.Add(string((FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryName)); - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.EnumerateFolders(Lst : TStringList); -var - i : Integer; -begin - Lst.Clear; - for i := 0 to FRootDir.CurrentNode.ChildCount - 1 do begin - if (FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryType = etFolder then - Lst.Add(string((FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryName)); - end; -end; -{-----------------------------------------------------------------------------} -function TAbCompoundFile.GetAllocationSize : Integer; - {- Returns the block allocation size used by the compound file} -begin - result := FSystemBlock.AllocationSize; -end; -{-----------------------------------------------------------------------------} -function TAbCompoundFile.GetCurrentDirectory : AnsiString; - {- Returns the current directory} -begin - Result := FRootDir.CurrentNode.Key; -end; -{-----------------------------------------------------------------------------} -function TAbCompoundFile.GetDirectoryEntries : Integer; - {- Returns the total number of directory entries (files and folders)} -begin - Result := FRootDir.Count; -end; -{-----------------------------------------------------------------------------} -function TAbCompoundFile.GetSizeOnDisk : Integer; - {- Returns the compound file size (FStream.Size)} -begin - Result := FStream.Size; -end; -{-----------------------------------------------------------------------------} -function TAbCompoundFile.GetVolumeLabel : AnsiString; - {- Returns the volume label of the compound file} -begin - Result := FSystemBlock.VolumeLabel; -end; -{-----------------------------------------------------------------------------} -procedure TAbRootDir.GoToEntryID(ID : Integer); - {- Traverses tree and sets the current node to the node whose EntryID = ID} -begin - TraversePost(ID); -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.Open(const FName : string); -{- Opens an existing compound file and builds Sys, Root Dir, and FAT blocks} -var - Sig : Array[0..sbSignatureSize - 1] of AnsiChar; -begin - if FStream <> nil then - FStream.Free; - FStream := TFileStream.Create(FName, fmOpenReadWrite or fmShareDenyNone); - - {Ensure valid signature} - FStream.Read(Sig[0], sbSignatureSize); - if Sig <> {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}LeftStr(FSystemBlock.Signature, sbSignatureSize) then begin - raise ECompoundFileError.Create(AbCmpndInvalidFile); - exit; - end; - - FDiskFile := FName; - {populate Compound File structure} - BuildSysBlock; - BuildFat; - BuildRootDir; - - if Assigned(FOnAfterOpen) then - FOnAfterOpen(self); -end; - -procedure TAbCompoundFile.Open(const FName : string; const Signature: AnsiString); -{- Opens an existing compound file and builds Sys, Root Dir, and FAT blocks} -var - Sig : Array[0..sbSignatureSize - 1] of AnsiChar; -begin - if FStream <> nil then - FStream.Free; - FStream := TFileStream.Create(FName, fmOpenReadWrite or fmShareDenyNone); - - {Ensure valid signature} - FStream.Read(Sig[0], sbSignatureSize); - if Sig <> {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}LeftStr(Signature, sbSignatureSize) then begin - raise ECompoundFileError.Create(AbCmpndInvalidFile); - exit; - end; - - FDiskFile := FName; - {populate Compound File structure} - BuildSysBlock; - BuildFat; - BuildRootDir; - - if Assigned(FOnAfterOpen) then - FOnAfterOpen(self); -end; -{-----------------------------------------------------------------------------} -function TAbCompoundFile.OpenFile(FileName : AnsiString; var Strm : TStream) - : Integer; - {- Opens the file and writes the file contents to Strm} -var - ChainArray : TFatChainArray; - i, j : Integer; - Buff : Array of Byte; - RemainingBytes : Integer; - CompStream : TStream; - CompHelper : TAbDeflateHelper; -begin - if not FRootDir.CurrentNode.Contains(FileName) then - raise ECompoundFileError.Create(AbCmpndFileNotFound); - - CompStream := TMemoryStream.Create; - CompHelper := TAbDeflateHelper.Create; - - try - {Read the existing (compressed) file into CompStream} - FFATTable.GetExistingChain((FRootDir.GetNode(FileName).FData - as TAbDirectoryEntry).StartBlock, ChainArray); - SetLength(Buff, FSystemBlock.AllocationSize); - for i := 0 to high(ChainArray) do begin - for j := 0 to Pred(FSystemBlock.AllocationSize) do - Buff[j] := Byte(chr(0)); - FStream.Seek((ChainArray[i]) * FSystemBlock.AllocationSize, soBeginning); - if i <> High(ChainArray) then begin - FStream.Read(buff[0], FSystemBlock.AllocationSize); - CompStream.Write(Buff[0], FSystemBlock.AllocationSize); - end else begin - {read less than entire block} - RemainingBytes := (FRootDir.GetNode(FileName).FData as TAbDirectoryEntry). - CompressedSize mod FSystemBlock.AllocationSize; - FStream.Read(Buff[0], RemainingBytes); - CompStream.Write(Buff[0], RemainingBytes); - end; - end; - - {CompStream now contains the entire compressed file stream} - CompStream.Seek(0, soBeginning); - Inflate(CompStream, Strm, CompHelper); - finally - CompStream.Free; - CompHelper.Free; - end; - Result := Strm.Size; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.PersistFATBlock; - {- Saves the FAT table to disk} -var - FATStrm : TMemoryStream; - Buff : Array of Byte; - i : Integer; - ChainArray : TFATChainArray; -begin - {Init Buffer} - SetLength(Buff, FSystemBlock.AllocationSize); - - {Init & fill RootDir stream} - FATStrm := TMemoryStream.Create; - - try - FFATTable.WriteToStream(FATStrm); - - {prep FAT Table} - fFATTable.ClearFATChain; - fFATTable.GetNewFATChain(FATStrm.Size, ChainArray); - - FATStrm.Seek(0, soBeginning); - for i := 0 to High(ChainArray) do begin - - {Clear block contents} - FillChar(Buff[0], FSystemBlock.AllocationSize, #0); - FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning); - FStream.Write(Buff[0], FSystemBlock.AllocationSize); - - {write new contents} - FATStrm.Read(Buff[0], FSystemBlock.AllocationSize); - FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning); - FStream.Write(Buff[0], FSystemBlock.AllocationSize); - end; - finally - FATStrm.Free; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.PersistFileData(FileData : TStream; - var ChainArray : TFATChainArray); - {- Walks FAT chain and persists data (FileData) to the corresponding blocks} -var - Buff : Array of Byte; - i : Integer; - j : Integer; -begin - if FileData <> nil then begin - FileData.Seek(0, soBeginning); - SetLength(Buff, FSystemBlock.AllocationSize); - for i := 0 to High(ChainArray) do begin - for j := 0 to FSystemBlock.AllocationSize - 1 do - Buff[j] := Byte(chr(0)); - FileData.Read(Buff[0], FSystemBlock.AllocationSize); - FStream.Seek(FSystemBlock.AllocationSize * ChainArray[i], soBeginning); - - FStream.Write(Buff[0],FSystemBlock.AllocationSize); - end; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.PersistRootDirBlock; - {- Saves the RootDirectory block to disk} -var - RdStrm : TMemoryStream; - Buff : Array of Byte; - i : Integer; - ChainArray : TFATChainArray; -begin - {Init Buffer} - SetLength(Buff, FSystemBlock.AllocationSize); - - {Init & fill RootDir stream} - RdStrm := TMemoryStream.Create; - try - FRootDir.WriteToStream(RdStrm); - - {prep FAT Table} - fFATTable.ClearRootDirChain; - fFATTable.GetNewRootDirChain(RdStrm.Size, ChainArray); - - RdStrm.Seek(0, soBeginning); - for i := 0 to High(ChainArray) do begin - {Clear block contents} - FillChar(Buff[0], FSystemBlock.AllocationSize, #0); - FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning); - FStream.Write(Buff[0], FSystemBlock.AllocationSize); - - {write new contents} - RdStrm.Read(Buff[0], FSystemBlock.AllocationSize); - FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning); - FStream.Write(Buff[0], FSystemBlock.AllocationSize); - end; - finally - RdStrm.Free; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.PersistSystemBlock; - {- Saves the System block to disk} -var - Strm : TMemoryStream; - Buff : Array of Byte; -begin - SetLength(Buff, FSystemBlock.AllocationSize); - Strm := TMemoryStream.Create; - try - FSystemBlock.WriteToStream(Strm); - Strm.Seek(0, soBeginning); - Strm.Read(Buff[0], Strm.Size); - FStream.Seek(0, soBeginning); - FStream.Write(Buff[0], FSystemBlock.AllocationSize); - finally - Strm.Free; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.SetCurrentDirectory(val : AnsiString); - {- Changes the current directory to the val parameter} -begin - FRootDir.ChangeDir(Val); -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.SetVolumeLabel(Val : AnsiString); - {- Sets the volume label of the compound file} -begin - FSystemBlock.VolumeLabel := Val; - PersistSystemBlock; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.UpdateFile(FName : AnsiString; FData : TStream); -var - StartBlk : Integer; - ChainArray : TFATChainArray; - DirEntry : TAbDirectoryEntry; - CompStream : TStream; - CompHelper : TAbDeflateHelper; - Allow : Boolean; - AllowDirMod : Boolean; -begin - Allow := True; - AllowDirMod := True; - if not FRootDir.CurrentNode.Contains(FName) then - raise ECompoundFileError.Create(AbCmpndFileNotFound); - - if ((FStream.Size + FData.Size + - (4 * FSystemBlock.AllocationSize)) >= MaxLongInt) then - raise ECompoundFileError.Create(AbCmpndExceedsMaxFileSize); - - if Assigned(FOnBeforeFileModified) then - FOnBeforeFileModified(self, FName, Allow); - - if Assigned(FOnBeforeDirModified) then - FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key, - AllowDirMod); - - if (Allow and AllowDirMod) then begin - {get dir entry & start block} - DirEntry := TAbDirectoryEntry(FRootDir.CurrentNode.GetChildByName(FName).Data); - StartBlk := DirEntry.StartBlock; - CompStream := TMemoryStream.Create; - CompHelper := TAbDeflateHelper.Create; - - try - {clear existing FAT chain} - FFATTable.ClearExistingChain(StartBlk); - SetLength(ChainArray, 0); - - {Deflate data} - FData.Seek(0, soBeginning); - Deflate(FData, CompStream, CompHelper); - - {Commit new FAT chain} - FFATTable.GetNewChain(CompStream.Size, ChainArray); - - {update start block, size, compressed size} - DirEntry.FStartBlock := ChainArray[0]; - DirEntry.Size := FData.Size; - DirEntry.CompressedSize := CompStream.Size; - - {persist changes} - PersistFileData(CompStream, ChainArray); - PersistRootDirBlock; - PersistFATBlock; - finally - CompStream.Free; - CompHelper.Free; - end; - end; -end; -{-----------------------------------------------------------------------------} - - - -function TAbCompoundFile.PopulateTreeView(TreeView : TTreeView) : Integer; - {- Populates the tree view parameter with all root directory entries} -var - i : Integer; - TreeNode : TTreeNode; -begin - TreeView.Items.Clear; - if FRootDir.Root <> nil then begin - TreeNode := TreeView.Items.Add(nil, string(FRootDir.Root.Key)); - TreeNode.ImageIndex := 0; - TreeNode.SelectedIndex := 0; - if FRootDir.Root.HasChildren then begin - for i := 0 to FRootDir.Root.ChildCount - 1 do - PopulateSubNodes(FRootDir.Root.Children[i], TreeView, TreeNode); - end; - end; - Result := TreeView.Items.Count; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.PopulateSubNodes(ParentNode : TMultiNode; - TreeView : TTreeView; TreeNode : TTreeNode); - {- Visits sub-nodes recursively - pre order} -var - Curr : TMultiNode; - i : Integer; - Node : TTreeNode; -begin - Node := TreeView.Items.AddChild(TreeNode, string(ParentNode.Key)); - if TAbDirectoryEntry(ParentNode.Data).EntryType = etFolder then begin - Node.ImageIndex := 0; - Node.SelectedIndex := 0; - end else begin - Node.ImageIndex := 1; - Node.SelectedIndex := 1; - end; - Curr := ParentNode; - if Curr <> nil then begin - if Curr.HasChildren then begin - for i := 0 to Curr.ChildCount -1 do - PopulateSubNodes(Curr.Children[i], TreeView, Node); - end; - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.RenameFile(OrigName, NewName : AnsiString); - {- Renames the file if file is found} -var - MultNode : TMultiNode; - Allow : Boolean; - AllowDirMod : Boolean; -begin - Allow := True; - AllowDirMod := True; - - {confirm valid names} - if ((OrigName = '') or (NewName = '')) then exit; - - {prevent duplicate names} - if ((FRootDir.FCurrentNode.Contains(NewName)) or - (FRootDir.FCurrentNode.Key = NewName)) then exit; - - if Assigned(FOnBeforeFileModified) then - FOnBeforeFileModified(self, OrigName, Allow); - - if Assigned(FOnBeforeDirModified) then - FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key, - AllowDirMod); - - if (Allow and AllowDirMod) then begin - if FRootDir.FCurrentNode.Contains(OrigName) then begin - MultNode := FRootDir.FCurrentNode.GetChildByName(OrigName); - MultNode.Key := NewName; - TAbDirectoryEntry(MultNode.Data).FName := NewName; - PersistRootDirBlock; - end else if FRootDir.FCurrentNode.Key = OrigName then begin - MultNode := FRootDir.FCurrentNode; - MultNode.Key := NewName; - TAbDirectoryEntry(MultNode.Data).FName := NewName; - PersistRootDirBlock; - end else - raise ECompoundFileError.Create(AbCmpndFileNotFound); - end; -end; -{-----------------------------------------------------------------------------} -procedure TAbCompoundFile.RenameFolder(OrigName, NewName : AnsiString); - {- Renames the folder if the folder is found} -var - MultNode : TMultiNode; - Allow : Boolean; - AllowDirMod : Boolean; -begin - Allow := True; - AllowDirMod := True; - - {confirm valid names} - if ((OrigName = '') or (NewName = '')) then exit; - - {prevent duplicate names} - if ((FRootDir.FCurrentNode.Contains(NewName)) or - (FRootDir.FCurrentNode.Key = NewName)) then exit; - - - if Assigned(FOnBeforeFileModified) then - FOnBeforeFileModified(self, OrigName, Allow); - - if Assigned(FOnBeforeDirModified) then - FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key, - AllowDirMod); - - if (Allow and AllowDirMod) then begin - if FRootDir.FCurrentNode.Contains(OrigName) then begin - MultNode := FRootDir.FCurrentNode.GetChildByName(OrigName); - if (TAbDirectoryEntry(MultNode.Data).EntryType <> etFolder) then - exit; - MultNode.Key := NewName; - TAbDirectoryEntry(MultNode.Data).FName := NewName; - PersistRootDirBlock; - end else if FRootDir.FCurrentNode.Key = OrigName then begin - MultNode := FRootDir.FCurrentNode; - if (TAbDirectoryEntry(MultNode.Data).EntryType <> etFolder) then - exit; - MultNode.Key := NewName; - TAbDirectoryEntry(MultNode.Data).FName := NewName; - PersistRootDirBlock; - end else - raise ECompoundFileError.Create(AbCmpndFileNotFound); - end; -end; -{-----------------------------------------------------------------------------} - -end. diff --git a/components/Abbrevia/source/AbConst.pas b/components/Abbrevia/source/AbConst.pas deleted file mode 100644 index bf638cb..0000000 --- a/components/Abbrevia/source/AbConst.pas +++ /dev/null @@ -1,220 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbConst.pas *} -{*********************************************************} -{* Abbrevia: Constants *} -{*********************************************************} - -unit AbConst; - -{$I AbDefine.inc} - -interface - -const - AbVersion = 5.0; - AbVersionS = '5.0'; - Ab_MessageLen = 255; - Ab_CaptionLen = 80; - AB_ZIPPATHDELIM = '/'; - -const - AbZipVersionNeeded = 1; - AbUnknownCompressionMethod = 2; - AbNoExtractionMethod = 3; - AbInvalidPassword = 4; - AbNoInsertionMethod = 5; - AbInvalidFactor = 6; - AbDuplicateName = 7; - AbUnsupportedCompressionMethod = 8; - AbUserAbort = 9; - AbArchiveBusy = 10; - AbBadSpanStream = 11; - AbNoOverwriteSpanStream = 12; - AbNoSpannedSelfExtract = 13; - AbStreamFull = 14; - AbNoSuchDirectory = 15; - AbInflateBlockError = 16; - AbBadStreamType = 17; - AbTruncateError = 18; - AbZipBadCRC = 19; - AbZipBadStub = 20; - AbFileNotFound = 21; - AbInvalidLFH = 22; - AbNoArchive = 23; - AbErrZipInvalid = 24; - AbReadError = 25; - AbInvalidIndex = 26; - AbInvalidThreshold = 27; - AbUnhandledFileType = 28; - AbSpanningNotSupported = 29; - - AbBBSReadTooManyBytes = 40; - AbBBSSeekOutsideBuffer = 41; - AbBBSInvalidOrigin = 42; - AbBBSWriteTooManyBytes = 43; - - AbNoCabinetDllError = 50; - AbFCIFileOpenError = 51; - AbFCIFileReadError = 52; - AbFCIFileWriteError = 53; - AbFCIFileCloseError = 54; - AbFCIFileSeekError = 55; - AbFCIFileDeleteError = 56; - AbFCIAddFileError = 57; - AbFCICreateError = 58; - AbFCIFlushCabinetError = 59; - AbFCIFlushFolderError = 60; - AbFDICopyError = 61; - AbFDICreateError = 62; - AbInvalidCabTemplate = 63; - AbInvalidCabFile = 64; - - AbSWSNotEndofStream = 80; - AbSWSSeekFailed = 81; - AbSWSWriteFailed = 82; - AbSWSInvalidOrigin = 83; - AbSWSInvalidNewOrigin = 84; - - AbVMSReadTooManyBytes = 100; - AbVMSInvalidOrigin = 101; - AbVMSErrorOpenSwap = 102; - AbVMSSeekFail = 103; - AbVMSReadFail = 104; - AbVMSWriteFail = 105; - AbVMSWriteTooManyBytes = 106; - - AbGZipInvalid = 200; - AbGzipBadCRC = 201; - AbGzipBadFileSize = 202; - - AbTarInvalid = 220; - AbTarBadFileName = 221; - AbTarBadLinkName = 222; - AbTarBadOp = 223; - - -function AbStrRes(Index : Integer) : string; - -implementation - -uses - AbResString; - -type - AbStrRec = record - ID: Integer; - Str: string; - end; - -const - AbStrArray : array [0..66] of AbStrRec = ( - (ID: AbZipVersionNeeded; Str: AbZipVersionNeededS), - (ID: AbUnknownCompressionMethod; Str: AbUnknownCompressionMethodS), - (ID: AbNoExtractionMethod; Str: AbNoExtractionMethodS), - (ID: AbInvalidPassword; Str: AbInvalidPasswordS), - (ID: AbNoInsertionMethod; Str: AbNoInsertionMethodS), - (ID: AbInvalidFactor; Str: AbInvalidFactorS), - (ID: AbDuplicateName; Str: AbDuplicateNameS), - (ID: AbUnsupportedCompressionMethod; Str: AbUnsupportedCompressionMethodS), - (ID: AbUserAbort; Str: AbUserAbortS), - (ID: AbArchiveBusy; Str: AbArchiveBusyS), - (ID: AbBadSpanStream; Str: AbBadSpanStreamS), - (ID: AbNoOverwriteSpanStream; Str: AbNoOverwriteSpanStreamS), - (ID: AbNoSpannedSelfExtract; Str: AbNoSpannedSelfExtractS), - (ID: AbStreamFull; Str: AbStreamFullS), - (ID: AbNoSuchDirectory; Str: AbNoSuchDirectoryS), - (ID: AbInflateBlockError; Str: AbInflateBlockErrorS), - (ID: AbBadStreamType; Str: AbBadStreamTypeS), - (ID: AbTruncateError; Str: AbTruncateErrorS), - (ID: AbZipBadCRC; Str: AbZipBadCRCS), - (ID: AbZipBadStub; Str: AbZipBadStubS), - (ID: AbFileNotFound; Str: AbFileNotFoundS), - (ID: AbInvalidLFH; Str: AbInvalidLFHS), - (ID: AbNoArchive; Str: AbNoArchiveS), - (ID: AbErrZipInvalid; Str: AbErrZipInvalidS), - (ID: AbReadError; Str: AbReadErrorS), - (ID: AbInvalidIndex; Str: AbInvalidIndexS), - (ID: AbInvalidThreshold; Str: AbInvalidThresholdS), - (ID: AbUnhandledFileType; Str: AbUnhandledFileTypeS), - (ID: AbSpanningNotSupported; Str: AbSpanningNotSupportedS), - - (ID: AbBBSReadTooManyBytes; Str: AbBBSReadTooManyBytesS), - (ID: AbBBSSeekOutsideBuffer; Str: AbBBSSeekOutsideBufferS), - (ID: AbBBSInvalidOrigin; Str: AbBBSInvalidOriginS), - (ID: AbBBSWriteTooManyBytes; Str: AbBBSWriteTooManyBytesS), - - (ID: AbNoCabinetDllError; Str: AbNoCabinetDllErrorS), - (ID: AbFCIFileOpenError; Str: AbFCIFileOpenErrorS), - (ID: AbFCIFileReadError; Str: AbFCIFileReadErrorS), - (ID: AbFCIFileWriteError; Str: AbFCIFileWriteErrorS), - (ID: AbFCIFileCloseError; Str: AbFCIFileCloseErrorS), - (ID: AbFCIFileSeekError; Str: AbFCIFileSeekErrorS), - (ID: AbFCIFileDeleteError; Str: AbFCIFileDeleteErrorS), - (ID: AbFCIAddFileError; Str: AbFCIAddFileErrorS), - (ID: AbFCICreateError; Str: AbFCICreateErrorS), - (ID: AbFCIFlushCabinetError; Str: AbFCIFlushCabinetErrorS), - (ID: AbFCIFlushFolderError; Str: AbFCIFlushFolderErrorS), - (ID: AbFDICopyError; Str: AbFDICopyErrorS), - (ID: AbFDICreateError; Str: AbFDICreateErrorS), - (ID: AbInvalidCabTemplate; Str: AbInvalidCabTemplateS), - (ID: AbInvalidCabFile; Str: AbInvalidCabFileS), - - (ID: AbSWSNotEndofStream; Str: AbSWSNotEndofStreamS), - (ID: AbSWSSeekFailed; Str: AbSWSSeekFailedS), - (ID: AbSWSWriteFailed; Str: AbSWSWriteFailedS), - (ID: AbSWSInvalidOrigin; Str: AbSWSInvalidOriginS), - (ID: AbSWSInvalidNewOrigin; Str: AbSWSInvalidNewOriginS), - - (ID: AbVMSReadTooManyBytes; Str: AbVMSReadTooManyBytesS), - (ID: AbVMSInvalidOrigin; Str: AbVMSInvalidOriginS), - (ID: AbVMSErrorOpenSwap; Str: AbVMSErrorOpenSwapS), - (ID: AbVMSSeekFail; Str: AbVMSSeekFailS), - (ID: AbVMSReadFail; Str: AbVMSReadFailS), - (ID: AbVMSWriteFail; Str: AbVMSWriteFailS), - (ID: AbVMSWriteTooManyBytes; Str: AbVMSWriteTooManyBytesS), - - (ID: AbGzipInvalid; Str: AbGzipInvalidS), - (ID: AbGzipBadCRC; Str: AbGzipBadCRCS), - (ID: AbGzipBadFileSize; Str: AbGzipBadFileSizeS), - - (ID: AbTarInvalid; Str: AbTarInvalidS), - (ID: AbTarBadFileName; Str: AbTarBadFileNameS), - (ID: AbTarBadLinkName; Str: AbTarBadLinkNameS), - (ID: AbTarBadOp; Str: AbTarBadOpS) - ); - -function AbStrRes(Index : Integer) : string; -var - i : Integer; -begin - for i := Low(AbStrArray) to High(AbStrArray) do - if AbStrArray[i].ID = Index then - Result := AbStrArray[i].Str; -end; - -end. diff --git a/components/Abbrevia/source/AbCrtl.pas b/components/Abbrevia/source/AbCrtl.pas deleted file mode 100644 index 436a376..0000000 --- a/components/Abbrevia/source/AbCrtl.pas +++ /dev/null @@ -1,184 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbCrtl.pas *} -{*********************************************************} -{* ABBREVIA: C++Builder C runtime functions *} -{*********************************************************} - -unit AbCrtl; - -{$I AbDefine.inc} - -interface - -uses - Windows; - -type - UInt32 = LongWord; - size_t = {$IF defined(CPUX64)}Int64{$ELSE}Integer{$IFEND}; // NativeInt is 8 bytes in Delphi 2007 - -const - __turboFloat: LongInt = 0; - _fltused: LongInt = 0; - -procedure abs; cdecl; - external 'msvcrt.dll'; -procedure _llshl; cdecl; - external 'msvcrt.dll'; -procedure _llushr; cdecl; - external 'msvcrt.dll'; -procedure _ftol; cdecl; - external 'msvcrt.dll' {$IFDEF BCB}name '__ftol'{$ENDIF}; - -{ ctype.h declarations ===================================================== } -function isdigit(ch: Integer): Integer; cdecl; - -{ string.h declarations ==================================================== } -function memcpy(Dest, Src: Pointer; Count: size_t): Pointer; cdecl; -function memmove(Dest, Src: Pointer; Count: size_t): Pointer; cdecl; -function memset(Dest: Pointer; Value: Byte; Count: size_t): Pointer; cdecl; -function strlen(P: PAnsiChar): Integer; cdecl; -function strcpy(Des, Src: PAnsiChar): PAnsiChar; cdecl; -function strncpy(Des, Src: PAnsiChar; MaxLen: Integer): PAnsiChar; cdecl; - -function memcmp(s1,s2: Pointer; numBytes: LongWord): integer; cdecl; - external 'msvcrt.dll'; -function wcscpy(strDestination, strSource: PWideChar): PWideChar; cdecl; - external 'msvcrt.dll'; - -{ stdlib.h declarations ==================================================== } -function malloc(Size: Integer): Pointer; cdecl; -procedure free(Ptr: Pointer); cdecl; -function realloc(Ptr: Pointer; Size: Integer): Pointer; cdecl; - -{ intrin.h declarations ==================================================== } -procedure ___cpuid(CPUInfo: PInteger; InfoType: Integer); cdecl; - external 'msvcrt.dll'; - -{ stdio.h declarations ===================================================== } -function sprintf(S: PChar; const Format: PChar): Integer; - cdecl; varargs; external 'msvcrt.dll' {$IFDEF BCB}name '_sprintf'{$ENDIF}; - -{ process.h declarations =================================================== } -function _beginthreadex(security: Pointer; stack_size: Cardinal; - start_address: Pointer; arglist: Pointer; initflag: Cardinal; - var thrdaddr: Cardinal): THandle; cdecl; - -{ MSVC/Win64 declarations ================================================== } -procedure __C_specific_handler; cdecl; external 'msvcrt.dll'; - -implementation - -{ ctype.h declarations ===================================================== } -function isdigit(ch: Integer): Integer; cdecl; -begin - if AnsiChar(ch) in ['0'..'9'] then - Result := 1 - else - Result := 0; -end; - -{ string.h declarations ==================================================== } -function memcpy(Dest, Src: Pointer; Count: size_t): Pointer; cdecl; -begin - System.Move(Src^, Dest^, Count); - Result := Dest; -end; -{ -------------------------------------------------------------------------- } -function memmove(Dest, Src: Pointer; Count: size_t): Pointer; cdecl; -begin - System.Move(Src^, Dest^, Count); - Result := Dest; -end; -{ -------------------------------------------------------------------------- } -function memset(Dest: Pointer; Value: Byte; Count: size_t): Pointer; cdecl; -begin - FillChar(Dest^, Count, Value); - Result := Dest; -end; -{ -------------------------------------------------------------------------- } -function strlen(P: PAnsiChar): Integer; cdecl; -{$IF RTLVersion >= 20} -asm - jmp System.@PCharLen -end; -{$ELSE} -begin - Result := 0; - while P^ <> #0 do - Inc(P); -end; -{$IFEND} -{ -------------------------------------------------------------------------- } -function strcpy(Des, Src: PAnsiChar): PAnsiChar; cdecl; -begin - Result := Des; - Move(Src^, Des^, strlen(Src) + 1); -end; -{ -------------------------------------------------------------------------- } -function strncpy(Des, Src: PAnsiChar; MaxLen: Integer): PAnsiChar; cdecl; -var - Len: Integer; -begin - Len := strlen(Src); - if Len > MaxLen then - Len := MaxLen; - Move(Src^, Des^, Len); - if Len < MaxLen then - FillChar(Des[Len], MaxLen - Len, 0); - Result := Des; -end; - -{ stdlib.h declarations ==================================================== } -function malloc(Size: Integer): Pointer; cdecl; -begin - GetMem(Result, Size); -end; -{ -------------------------------------------------------------------------- } -procedure free(Ptr: Pointer); cdecl; -begin - FreeMem(Ptr) -end; -{ -------------------------------------------------------------------------- } -function realloc(Ptr: Pointer; Size: Integer): Pointer; cdecl; -begin - Result := ReallocMemory(Ptr, Size); -end; - -{ process.h declarations =================================================== } -function _beginthreadex(security: Pointer; stack_size: Cardinal; - start_address: Pointer; arglist: Pointer; initflag: Cardinal; - var thrdaddr: Cardinal): THandle; cdecl; -begin - Result := CreateThread(security, stack_size, start_address, arglist, - initflag, thrdaddr); -end; -{ -------------------------------------------------------------------------- } - -end. diff --git a/components/Abbrevia/source/AbDefine.inc b/components/Abbrevia/source/AbDefine.inc deleted file mode 100644 index 2eac8f5..0000000 --- a/components/Abbrevia/source/AbDefine.inc +++ /dev/null @@ -1,292 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDefine.inc *} -{*********************************************************} -{* ABBREVIA: Compiler options/directives include file *} -{*********************************************************} - -{NOTE: ABDEFINE.INC is included in all ABBREVIA units; hence you can - specify global compiler options here. ABDEFINE.INC is included - *before* each unit's own required compiler options, so options - specified here could be overridden by hardcoded options in the - unit source file.} - - -{====Compiler options that can be changed====} -{$A+ Force alignment on word/dword boundaries} -{$S- No stack checking} - -{---Global compiler defines for 32-bit OS's---} -{====Global fixed compiler options (do NOT change)====} - -{$B- Incomplete boolean evaluation} -{$H+ Long string support} -{$P- No open string parameters} -{$Q- Arithmetic overflow checking} {!! - Needs to be turned on!} -{$R- Range checking} {!! - Needs to be turned on!} -{$T+ No type-checked pointers} -{$V- No var string checking} -{$X+ Extended syntax} -{$Z1 Enumerations are byte sized} - -{====Platform defines================================================} - -{ map Delphi platform defines to FreePascal's (MSWINDOWS/UNIX/LINUX/DARWIN) } -{$IFNDEF FPC} - {$IF DEFINED(LINUX) AND (CompilerVersion < 15)} - {$DEFINE KYLIX} - {$DEFINE UNIX} - {$IFEND} - {$IFDEF MACOS} - {$DEFINE DARWIN} - {$ENDIF} - {$IFDEF POSIX} - {$DEFINE UNIX} - {$ENDIF} -{$ENDIF} - -{ Unix API (Kylix/Delphi/FreePascal) } -{$IFDEF UNIX} - {$IF DEFINED(FPC)} - {$DEFINE FPCUnixAPI} - {$ELSEIF DEFINED(KYLIX)} - {$DEFINE LibcAPI} - {$ELSE} - {$DEFINE PosixAPI} - {$IFEND} -{$ENDIF} - -{$IFDEF FPC} - {$MODE DELPHI} - {$PACKRECORDS C} -{$ENDIF} - -{Activate this define to show CLX/LCL dialogs for spanning media requests. The - default behavior will abort the operation instead. This define is only safe - when using Abbrevia from the foreground thread. If using it from a background - thread override OnRequestLastDisk, OnRequestNthDisk, and OnRequestBlankDisk and - synchronize to the foreground yourself. The Windows version always MessageBox - so it's thread-safe.} -{.$DEFINE UnixDialogs} - -{====RTL defines=====================================================} - -{$IFNDEF FPC} - {$IF RTLVersion >= 18} // Delphi 2006 - {$DEFINE HasAdvancedRecords} - {$IFEND} - {$IF RTLVersion >= 20} // Delphi 2009 - {$DEFINE HasThreadFinished} - {$IFEND} - {$IF RTLVersion >= 21} // Delphi 2010 - {$DEFINE HasThreadStart} - {$IFEND} - {$IF RTLVersion >= 23} // Delphi XE2 - {$DEFINE HasPlatformsAttribute} - {$IFEND} -{$ENDIF} - -{====Widgetset defines===============================================} - -{ VCL version specific defines } -{$IFNDEF FPC} - {$IF RTLVersion >= 17} // Delphi 2005 - {$DEFINE HasOnMouseActivate} - {$IFEND} - {$IF RTLVersion >= 18} // Delphi 2006 - {$DEFINE HasOnMouseEnter} - {$IFEND} - {$IF RTLVersion >= 20} // Delphi 2009 - {$DEFINE HasListViewGroups} - {$DEFINE HasListViewOnItemChecked} - {$DEFINE HasParentDoubleBuffered} - {$DEFINE HasTreeViewExpandedImageIndex} - {$IFEND} - {$IF RTLVersion >= 21} // Delphi 2010 - {$DEFINE HasGridDrawingStyle} - {$DEFINE HasTouch} - {$IFEND} - {$IF RTLVersion >= 24} // Delphi XE3 - {$DEFINE HasUITypes} - {$IFEND} - {$IF RTLVersion >= 25} // Delphi XE4 - {$DEFINE HasAnsiStrings} - {$IFEND} -{$ENDIF} - -{====General defines=================================================} - -{Activate the following define to include extra code to get rid of all - hints and warnings. Parts of ABBREVIA are written in such a way - that the hint/warning algorithms of the Delphi compilers are - fooled and report things like variables being used before - initialisation and so on when in reality the problem does not exist.} -{$DEFINE DefeatWarnings} - -{ Disable warnings for explicit string casts } -{$IFDEF UNICODE} - {$WARN EXPLICIT_STRING_CAST OFF} - {$WARN EXPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -{ Disable hints on Delphi XE2/Mac to prevent unexpanded inline messages } -{$IFDEF POSIX} - {$HINTS OFF} -{$ENDIF} - -{====Bzip2 defines===================================================} - -{Activate this define to statically link bzip2 .obj files into the application. - Curerntly only supported by Delphi/Win32.} -{.$DEFINE Bzip2Static} - -{Activate this define to dynamically link to a libbz2.dll/libbbz2.so.1} -{.$DEFINE Bzip2Dynamic} - -{Activate this define to load libbz2.dll/libbz2.so.1 at runtime using LoadLibrary} -{.$DEFINE Bzip2Runtime} - -{Pick an appropriate linking method if none of the above are activate} -{$IF NOT DEFINED(Bzip2Static) AND NOT DEFINED(Bzip2Dynamic) AND NOT DEFINED(Bzip2Runtime)} - {$IFDEF FPC} - {$DEFINE Bzip2Runtime} - {$ELSE} - {$IFDEF MSWINDOWS} - {$DEFINE Bzip2Static} - {$ELSE} - {$DEFINE Bzip2Dynamic} - {$ENDIF} - {$ENDIF} -{$IFEND} - -{====Zip defines=====================================================} - -{Activate the following define when you don't want Visual parts of -the VCL library included for a program using a TAbArchive or -TAbZipArchive} -{.$DEFINE BuildingStub} - -{Activate the following define to include support for extracting files -using PKzip compatible unShrink.} - -{.$DEFINE UnzipShrinkSupport} - -{Activate the following define to include support for extracting files -using PKZip compatible unReduce.} - -{.$DEFINE UnzipReduceSupport} - -{Activate the following define to include support for extracting files -using PKZip compatible unImplode.} - -{.$DEFINE UnzipImplodeSupport} - -{Activate the following to include support for extracting files using -all older PKZip compatible methods (Shrink, Reduce, Implode} - -{$DEFINE UnzipBackwardSupport} - -{Activate the following to include support for extracting files using -BZIP2 compression. Added in AppNote.txt v4.6. } - -{.$DEFINE UnzipBzip2Support} - -{Activate the following to include support for extracting files using -7-zip compatible Lzma compression. Added in AppNote.txt v6.3.} - -{.$DEFINE UnzipLzmaSupport} - -{Activate the following to include support for extracting files using -zipx PPMd I compression. Added in AppNote.txt v6.3.} - -{.$DEFINE UnzipPPMdSupport} - -{Activate the following to include support for extracting .wav files -using zipx WavPack compression. Requires copyright notice in your -documentation. Check "WavPack License.txt" for details. -Added in AppNote.txt v6.3. } - -{.$DEFINE UnzipWavPackSupport} - -{Activate the following to include support for extracting files using -all newer (zipx) compatible methods (Bzip2, Lzma, PPMd, WavPack)} - -{$DEFINE UnzipZipxSupport} - -{Activate the following to include logging support in the deflate/ - inflate code. Since this logging support is a by-product of assertion - checking, you should only activate it if that is also on: $C+} -{$IFOPT C+} //if Assertions are on -{.$DEFINE UseLogging} -{$ENDIF} - -{ - According to - http://www.gzip.org/zlib/rfc1952.txt - - A compliant gzip compressor should calculate and set the CRC32 and ISIZE. - However, a compliant decompressor should not check these values. - - If you want to check the the values of the CRC32 and ISIZE in a GZIP file - when decompressing enable the STRICTGZIP define below. } - -{.$DEFINE STRICTGZIP} - -{ The following define is ONLY used for Abbrevia Unit Tests. - It has no effect on the Abbrevia Library. - - If defined it uses Winzip to create and test archives for compatability. - The winzip tests require Systools stSpawn.pas - It can be downloaded at http://sf.net/projects/tpsystools } - -{$IFDEF MSWINDOWS} - {.$DEFINE WINZIPTESTS} -{$ENDIF} - - -{-------- !! DO NOT CHANGE DEFINES BELOW THIS LINE !! --------} - -{$IFDEF UnzipBackwardSupport} - {$DEFINE UnzipShrinkSupport} - {$DEFINE UnzipReduceSupport} - {$DEFINE UnzipImplodeSupport} -{$ENDIF} - -{$IFDEF UnzipZipxSupport} - {$DEFINE UnzipBzip2Support} - {$DEFINE UnzipLzmaSupport} - {$DEFINE UnzipPPMdSupport} - {$DEFINE UnzipWavPackSupport} -{$ENDIF} - -{ Linking .obj files isn't currently supported in Kylix or FPC } -{$IF DEFINED(FPC) OR NOT DEFINED(MSWINDOWS)} - {$UNDEF UnzipLzmaSupport} - {$UNDEF UnzipPPMdSupport} - {$UNDEF UnzipWavPackSupport} -{$IFEND} - diff --git a/components/Abbrevia/source/AbDfBase.pas b/components/Abbrevia/source/AbDfBase.pas deleted file mode 100644 index 5a2d73b..0000000 --- a/components/Abbrevia/source/AbDfBase.pas +++ /dev/null @@ -1,819 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfBase.pas *} -{*********************************************************} -{* Deflate base unit *} -{*********************************************************} - -unit AbDfBase; - -{$I AbDefine.inc} - -interface - -uses - SysUtils, - Classes; - -type - PAbDfLongintList = ^TAbDfLongintList; - TAbDfLongintList = - array [0..pred(MaxInt div sizeof(longint))] of longint; - -const - dfc_CodeLenCodeLength = 7; - dfc_LitDistCodeLength = 15; - dfc_MaxCodeLength = 15; - -const - dfc_MaxMatchLen = 258; {lengths are 3..258 for deflate} - dfc_MaxMatchLen64 = 64 * 1024; {lengths are 3..65536 for deflate64} - -const - dfc_LitExtraOffset = 257; - dfc_LitExtraBits : array [0..30] of byte = - (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, - 4, 4, 4, 4, 5, 5, 5, 5, 16, 99, 99); - { note: the last two are required to avoid going beyond the end} - { of the array when generating static trees} - - dfc_DistExtraOffset = 0; - dfc_DistExtraBits : array [0..31] of byte = - (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, - 10, 10, 11, 11, 12, 12, 13, 13, 14, 14); - { note: the last two are only use for deflate64} - - dfc_LengthBase : array [0..28] of word = - (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 35, 43, - 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 3); - { note: the final 3 is correct for deflate64; for symbol 285,} - { lengths are stored as (length - 3)} - { for deflate it's very wrong, but there's special code in} - { the (de)compression code to cater for this} - - dfc_DistanceBase : array [0..31] of word = - (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, - 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289, - 16385, 24577, 32769, 49153); - - dfc_CodeLengthIndex : array [0..18] of byte = - (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15); - -const - dfc_CanUseStored = $01; - dfc_CanUseStatic = $02; - dfc_CanUseDynamic = $04; - dfc_UseLazyMatch = $08; - dfc_UseDeflate64 = $10; - dfc_UseAdler32 = $20; - dfc_CanUseHuffman = dfc_CanUseStatic or dfc_CanUseDynamic; - dfc_TestOnly = $40000000; - -type - TAbProgressStep = procedure (aPercentDone : integer) of object; - {-progress metering of deflate/inflate; abort with AbortProgress} - - TAbDeflateHelper = class - private - FAmpleLength : longint; - FChainLength : longint; - FLogFile : string; - FMaxLazy : longint; - FOnProgressStep : TAbProgressStep; - FOptions : longint; - FPartSize : Int64; - FSizeCompressed : Int64; - FSizeNormal : Int64; - FStreamSize : Int64; - FWindowSize : longint; - FZipOption : AnsiChar; - protected - procedure dhSetAmpleLength(aValue : longint); - procedure dhSetChainLength(aValue : longint); - procedure dhSetLogFile(const aValue : string); - procedure dhSetMaxLazy(aValue : longint); - procedure dhSetOnProgressStep(aValue : TAbProgressStep); - procedure dhSetOptions(aValue : longint); - procedure dhSetWindowSize(aValue : longint); - procedure dhSetZipOption(aValue : AnsiChar); - public - constructor Create; - - procedure Assign(aHelper : TAbDeflateHelper); - - property AmpleLength : longint - read FAmpleLength write dhSetAmpleLength; - property ChainLength : longint - read FChainLength write dhSetChainLength; - property LogFile : string - read FLogFile write dhSetLogFile; - property MaxLazyLength : longint - read FMaxLazy write dhSetMaxLazy; - property Options : longint - read FOptions write dhSetOptions; - property PartialSize : Int64 - read FPartSize write FPartSize; - property PKZipOption : AnsiChar - read FZipOption write dhSetZipOption; - property StreamSize : Int64 - read FStreamSize write FStreamSize; - property WindowSize : longint - read FWindowSize write dhSetWindowSize; - - property CompressedSize : Int64 - read FSizeCompressed write FSizeCompressed; - property NormalSize : Int64 - read FSizeNormal write FSizeNormal; - - property OnProgressStep : TAbProgressStep - read FOnProgressStep write dhSetOnProgressStep; - end; - -type - TAbLineDelimiter = (ldCRLF, ldLF); - - TAbLogger = class(TStream) - private - FBuffer : PAnsiChar; - FCurPos : PAnsiChar; - FLineDelim : TAbLineDelimiter; - FStream : TFileStream; - protected - function logWriteBuffer : boolean; - public - constructor Create(const aLogName : string); - destructor Destroy; override; - - function Read(var Buffer; Count : longint) : longint; override; - function Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64; override; - function Write(const Buffer; Count : longint) : longint; override; - procedure WriteLine(const S : string); - procedure WriteStr(const S : string); - - property LineDelimiter : TAbLineDelimiter - read FLineDelim write FLineDelim; - end; - -type - TAbNodeManager = class - private - FFreeList : pointer; - FNodeSize : cardinal; - FNodesPerPage : cardinal; - FPageHead : pointer; - FPageSize : cardinal; - protected - function nmAllocNewPage : pointer; - public - constructor Create(aNodeSize : cardinal); - destructor Destroy; override; - - function AllocNode : pointer; - function AllocNodeClear : pointer; - procedure FreeNode(aNode : pointer); - end; - -{---exception classes---} -type - EAbAbortProgress = class(Exception); - EAbPartSizedInflate = class(Exception); - EAbInflatePasswordError = class(Exception); - EAbInternalInflateError = class(Exception); - EAbInflateError = class(Exception) - public - constructor Create(const aMsg : string); - constructor CreateUnknown(const aMsg : string; - const aErrorMsg : string); - end; - EAbInternalDeflateError = class(Exception); - EAbDeflateError = class(Exception) - public - constructor Create(const aMsg : string); - constructor CreateUnknown(const aMsg : string; - const aErrorMsg : string); - end; - -{---aborting a process---} -procedure AbortProgress; - -{---calculation of checksums---} -procedure AbUpdateAdlerBuffer(var aAdler : longint; - var aBuffer; aCount : integer); -procedure AbUpdateCRCBuffer(var aCRC : longint; - var aBuffer; aCount : integer); - - -implementation - -uses - AbUtils; - -{===TAbDeflateHelper=================================================} -constructor TAbDeflateHelper.Create; -begin - inherited Create; - FAmpleLength := 8; - FChainLength := 32; - {FLogFile := '';} - FMaxLazy := 16; - {FOnProgressStep := nil;} - FOptions := $F; - {FStreamSize := 0;} - FWindowSize := 32 * 1024; - FZipOption := 'n'; -end; -{--------} -procedure TAbDeflateHelper.Assign(aHelper : TAbDeflateHelper); -begin - FAmpleLength := aHelper.FAmpleLength; - FChainLength := aHelper.FChainLength; - FLogFile := aHelper.FLogFile; - FMaxLazy := aHelper.FMaxLazy; - FOnProgressStep := aHelper.FOnProgressStep; - FOptions := aHelper.FOptions; - FPartSize := aHelper.FPartSize; - FStreamSize := aHelper.FStreamSize; - FWindowSize := aHelper.FWindowSize; - FZipOption := aHelper.FZipOption; -end; -{--------} -procedure TAbDeflateHelper.dhSetAmpleLength(aValue : longint); -begin - if (aValue <> AmpleLength) then begin - if (aValue <> -1) and (aValue < 4) then - aValue := 4; - FAmpleLength := aValue; - FZipOption := '?'; - end; -end; -{--------} -procedure TAbDeflateHelper.dhSetChainLength(aValue : longint); -begin - if (aValue <> ChainLength) then begin - if (aValue <> -1) and (aValue < 4) then - aValue := 4; - FChainLength := aValue; - FZipOption := '?'; - end; -end; -{--------} -procedure TAbDeflateHelper.dhSetLogFile(const aValue : string); -begin - FLogFile := aValue; -end; -{--------} -procedure TAbDeflateHelper.dhSetMaxLazy(aValue : longint); -begin - if (aValue <> MaxLazyLength) then begin - if (aValue <> -1) and (aValue < 4) then - aValue := 4; - FMaxLazy := aValue; - FZipOption := '?'; - end; -end; -{--------} -procedure TAbDeflateHelper.dhSetOnProgressStep(aValue : TAbProgressStep); -begin - FOnProgressStep := aValue; -end; -{--------} -procedure TAbDeflateHelper.dhSetOptions(aValue : longint); -begin - if (aValue <> Options) then begin - FOptions := aValue; - FZipOption := '?'; - end; -end; -{--------} -procedure TAbDeflateHelper.dhSetWindowSize(aValue : longint); -var - NewValue : longint; -begin - if (aValue <> WindowSize) then begin - {calculate the window size rounded to nearest 1024 bytes} - NewValue := ((aValue + 1023) div 1024) * 1024; - {if the new window size is greater than 32KB...} - if (NewValue > 32 * 1024) then - {if the Deflate64 option is set, force to 64KB} - if ((Options and dfc_UseDeflate64) <> 0) then - NewValue := 64 * 1024 - {otherwise, force to 32KB} - else - NewValue := 32 * 1024; - {set the new window size} - FWindowSize := NewValue; - end; -end; -{--------} -procedure TAbDeflateHelper.dhSetZipOption(aValue : AnsiChar); -begin - {notes: - The original Abbrevia code used the following table for - setting the equivalent values: - Good Lazy Chain UseLazy Option - 4 4 4 N s ^ - 4 5 8 N | - 4 6 32 N f faster - 4 4 16 Y slower - 8 16 32 Y n | - 8 16 128 Y | - 8 32 256 Y | - 32 128 1024 Y | - 32 258 4096 Y x V - The new Abbrevia 3 code follows these values to a certain extent. - } - - {force to lower case} - if ('A' <= aValue) and (aValue <= 'Z') then - aValue := AnsiChar(ord(aValue) + ord('a') - ord('A')); - - {if the value has changed...} - if (aValue <> PKZipOption) then begin - - {switch on the new value...} - case aValue of - '0' : {no compression} - begin - FZipOption := aValue; - FOptions := (FOptions and (not $0F)) or dfc_CanUseStored; - FAmpleLength := 8; { not actually needed} - FChainLength := 32; { not actually needed} - FMaxLazy := 16; { not actually needed} - end; - '2' : {hidden option: Abbrevia 2 compatibility} - begin - FZipOption := aValue; - FOptions := FOptions or $0F; - FAmpleLength := 8; - FChainLength := 32; - FMaxLazy := 16; - end; - 'f' : {fast compression} - begin - FZipOption := aValue; - FOptions := FOptions or $07; { no lazy matching} - FAmpleLength := 4; - FChainLength := 32; - FMaxLazy := 6; - end; - 'n' : {normal compression} - begin - FZipOption := aValue; - FOptions := FOptions or $0F; - FAmpleLength := 16; - FChainLength := 32; - FMaxLazy := 24; - end; - 's' : {super fast compression} - begin - FZipOption := aValue; - FOptions := FOptions or $07; { no lazy matching} - FAmpleLength := 4; - FChainLength := 4; - FMaxLazy := 4; - end; - 'x' : {maximum compression} - begin - FZipOption := aValue; - FOptions := FOptions or $0F; - FAmpleLength := 64;{32;} - FChainLength := 4096; - FMaxLazy := 258; - end; - end; - end; -end; -{====================================================================} - - -{===TAbLogger========================================================} -const - LogBufferSize = 4096; -{--------} -constructor TAbLogger.Create(const aLogName : string); -begin - Assert(aLogName <> '', - 'TAbLogger.Create: a filename must be provided for the logger'); - - {create the ancestor} - inherited Create; - - {set the default line terminator} - {$IFDEF MSWINDOWS} - FLineDelim := ldCRLF; - {$ENDIF} - {$IFDEF UNIX} - FLineDelim := ldLF; - {$ENDIF} - - {create and initialize the buffer} - GetMem(FBuffer, LogBufferSize); - FCurPos := FBuffer; - - {create the log file} - FStream := TFileStream.Create(aLogName, fmCreate); -end; -{--------} -destructor TAbLogger.Destroy; -begin - {if there is a buffer ensure that it is flushed before freeing it} - if (FBuffer <> nil) then begin - if (FCurPos <> FBuffer) then - logWriteBuffer; - FreeMem(FBuffer, LogBufferSize); - end; - - {free the stream} - FStream.Free; - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -function TAbLogger.logWriteBuffer : boolean; -var - BytesToWrite : longint; - BytesWritten : longint; -begin - BytesToWrite := FCurPos - FBuffer; - BytesWritten := FStream.Write(FBuffer^, BytesToWrite); - if (BytesWritten = BytesToWrite) then begin - Result := true; - FCurPos := FBuffer; - end - else begin - Result := false; - if (BytesWritten <> 0) then begin - Move(FBuffer[BytesWritten], FBuffer^, BytesToWrite - BytesWritten); - FCurPos := FBuffer + (BytesToWrite - BytesWritten); - end; - end; -end; -{--------} -function TAbLogger.Read(var Buffer; Count : longint) : longint; -begin - Assert(false, 'TAbLogger.Read: loggers are write-only, no reading allowed'); - Result := 0; -end; -{--------} -function TAbLogger.Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64; -begin - case Origin of - soBeginning : - begin - end; - soCurrent : - if (Offset = 0) then begin - Result := FStream.Position + (FCurPos - FBuffer); - Exit; - end; - soEnd : - if (Offset = 0) then begin - Result := FStream.Position + (FCurPos - FBuffer); - Exit; - end; - end; - - Assert(false, 'TAbLogger.Seek: loggers are write-only, no seeking allowed'); - Result := 0; -end; -{--------} -function TAbLogger.Write(const Buffer; Count : longint) : longint; -var - UserBuf : PAnsiChar; - BytesToGo : longint; - BytesToWrite : longint; -begin - {reference the user's buffer as a PChar} - UserBuf := @Buffer; - - {start the counter for the number of bytes written} - Result := 0; - - {if needed, empty the internal buffer into the underlying stream} - if (LogBufferSize = FCurPos - FBuffer) then - if not logWriteBuffer then - Exit; - - {calculate the number of bytes to copy this time from the user's - buffer to the internal buffer} - BytesToGo := Count; - BytesToWrite := LogBufferSize - (FCurPos - FBuffer); - if (BytesToWrite > BytesToGo) then - BytesToWrite := BytesToGo; - - {copy the bytes} - Move(UserBuf^, FCurPos^, BytesToWrite); - - {adjust the counters} - inc(FCurPos, BytesToWrite); - dec(BytesToGo, BytesToWrite); - inc(Result, BytesToWrite); - - {while there are still more bytes to copy, do so} - while (BytesToGo <> 0) do begin - {advance the user's buffer} - inc(UserBuf, BytesToWrite); - - {empty the internal buffer into the underlying stream} - if not logWriteBuffer then - Exit; - - {calculate the number of bytes to copy this time from the user's - buffer to the internal buffer} - BytesToWrite := LogBufferSize; - if (BytesToWrite > BytesToGo) then - BytesToWrite := BytesToGo; - - {copy the bytes} - Move(UserBuf^, FCurPos^, BytesToWrite); - - {adjust the counters} - inc(FCurPos, BytesToWrite); - dec(BytesToGo, BytesToWrite); - inc(Result, BytesToWrite); - end; -end; -{--------} -procedure TAbLogger.WriteLine(const S : string); -const - cLF : AnsiChar = ^J; - cCRLF : array [0..1] of AnsiChar = ^M^J; -begin - if (length(S) > 0) then - Write(S[1], length(S)); - case FLineDelim of - ldLF : Write(cLF, sizeof(cLF)); - ldCRLF : Write(cCRLF, sizeof(cCRLF)); - end; -end; -{--------} -procedure TAbLogger.WriteStr(const S : string); -begin - if (length(S) > 0) then - Write(S[1], length(S)); -end; -{====================================================================} - - -{===Calculate checksums==============================================} -procedure AbUpdateAdlerBuffer(var aAdler : longint; - var aBuffer; aCount : integer); -var - S1 : LongWord; - S2 : LongWord; - i : integer; - Buffer : PAnsiChar; - BytesToUse : integer; -begin - {Note: this algorithm will *only* work if the buffer is 4KB or less, - which is why we go to such lengths to chop up the user buffer - into usable chunks of 4KB. - - However, for Delphi 3 there is no proper 32-bit longword. - Although the additions pose no problems in this situation, - the mod operations below (especially for S2) will be signed - integer divisions, producing an (invalid) signed result. In - this case, the buffer is chopped up into 2KB chunks to avoid - any signed problems.} - - {split the current Adler checksum into its halves} - S1 := LongWord(aAdler) and $FFFF; - S2 := LongWord(aAdler) shr 16; - - {reference the user buffer as a PChar: it makes it easier} - Buffer := @aBuffer; - - {while there's still data to checksum...} - while (aCount <> 0) do begin - - {calculate the number of bytes to checksum this time} - {$IFDEF HasLongWord} - BytesToUse := 4096; - {$ELSE} - BytesToUse := 2048; - {$ENDIF} - if (BytesToUse > aCount) then - BytesToUse := aCount; - - {checksum the bytes} - for i := 0 to pred(BytesToUse) do begin - inc(S1, ord(Buffer^)); - inc(S2, S1); - inc(Buffer); - end; - - {recalibrate the Adler checksum halves} - S1 := S1 mod 65521; - S2 := S2 mod 65521; - - {calculate the number of bytes still to go} - dec(aCount, BytesToUse); - end; - - {join the halves to produce the complete Adler checksum} - aAdler := longint((S2 shl 16) or S1); -end; -{--------} -procedure AbUpdateCRCBuffer(var aCRC : longint; - var aBuffer; aCount : integer); -var - i : integer; - CRC : LongWord; - Buffer : PAnsiChar; -begin -{$R-}{$Q-} - {reference the user buffer as a PChar: it makes it easier} - Buffer := @aBuffer; - - {get the current CRC as a local variable, it's faster} - CRC := aCRC; - - {checksum the bytes in the buffer} - for i := 0 to pred(aCount) do begin - CRC := AbCrc32Table[byte(CRC) xor byte(Buffer^)] xor (CRC shr 8); - inc(Buffer); - end; - - {return the new CRC} - aCRC := CRC; -{$R+}{$Q+} -end; -{====================================================================} - - -{===EAbInflateError==================================================} -constructor EAbInflateError.Create(const aMsg : string); -begin - inherited Create( - 'Abbrevia inflate error, possibly a corrupted compressed stream. ' + - '(Internal cause: ' + aMsg + ')'); -end; -{--------} -constructor EAbInflateError.CreateUnknown(const aMsg : string; - const aErrorMsg : string); -begin - inherited Create(aMsg + ': ' + aErrorMsg); -end; -{====================================================================} - - -{===EAbDeflateError==================================================} -constructor EAbDeflateError.Create(const aMsg : string); -begin - inherited Create( - 'Abbrevia deflate error. ' + - '(Internal cause: ' + aMsg + ')'); -end; -{--------} -constructor EAbDeflateError.CreateUnknown(const aMsg : string; - const aErrorMsg : string); -begin - inherited Create(aMsg + ': ' + aErrorMsg); -end; -{====================================================================} - - -{===Node manager=====================================================} -const - PageSize = 8 * 1024; -type - PGenericNode = ^TGenericNode; - TGenericNode = packed record - gnNext : PGenericNode; - gnData : record end; - end; -{--------} -constructor TAbNodeManager.Create(aNodeSize : cardinal); -const - Gran = sizeof(pointer); - Mask = not (Gran - 1); -begin - {create the ancestor} - inherited Create; - - {save the node size rounded to nearest 4 bytes} - if (aNodeSize <= sizeof(pointer)) then - aNodeSize := sizeof(pointer) - else - aNodeSize := (aNodeSize + Gran - 1) and Mask; - FNodeSize := aNodeSize; - - {calculate the page size (default 1024 bytes) and the number of - nodes per page; if the default page size is not large enough for - two or more nodes, force a single node per page} - FNodesPerPage := (PageSize - sizeof(pointer)) div aNodeSize; - if (FNodesPerPage > 1) then - FPageSize := PageSize - else begin - FNodesPerPage := 1; - FPagesize := aNodeSize + sizeof(pointer); - end; -end; -{--------} -destructor TAbNodeManager.Destroy; -var - Temp : pointer; -begin - {dispose of all the pages, if there are any} - while (FPageHead <> nil) do begin - Temp := PGenericNode(FPageHead)^.gnNext; - FreeMem(FPageHead, FPageSize); - FPageHead := Temp; - end; - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -function TAbNodeManager.AllocNode : pointer; -begin - Result := FFreeList; - if (Result = nil) then - Result := nmAllocNewPage - else - FFreeList := PGenericNode(Result)^.gnNext; -end; -{--------} -function TAbNodeManager.AllocNodeClear : pointer; -begin - Result := FFreeList; - if (Result = nil) then - Result := nmAllocNewPage - else - FFreeList := PGenericNode(Result)^.gnNext; - FillChar(Result^, FNodeSize, 0); -end; -{--------} -procedure TAbNodeManager.FreeNode(aNode : pointer); -begin - {add the node (if non-nil) to the top of the free list} - if (aNode <> nil) then begin - PGenericNode(aNode)^.gnNext := FFreeList; - FFreeList := aNode; - end; -end; -{--------} -function TAbNodeManager.nmAllocNewPage : pointer; -var - NewPage : PAnsiChar; - i : integer; - FreeList : pointer; - NodeSize : integer; -begin - {allocate a new page and add it to the front of the page list} - GetMem(NewPage, FPageSize); - PGenericNode(NewPage)^.gnNext := FPageHead; - FPageHead := NewPage; - - {now split up the new page into nodes and push them all onto the - free list; note that the first 4 bytes of the page is a pointer to - the next page, so remember to skip over it} - inc(NewPage, sizeof(pointer)); - FreeList := FFreeList; - NodeSize := FNodeSize; - for i := 0 to pred(FNodesPerPage) do begin - PGenericNode(NewPage)^.gnNext := FreeList; - FreeList := NewPage; - inc(NewPage, NodeSize); - end; - - {return the top of the list} - Result := FreeList; - FFreeList := PGenericNode(Result)^.gnNext; -end; -{====================================================================} - - -{====================================================================} -procedure AbortProgress; -begin - raise EAbAbortProgress.Create('Abort'); -end; -{====================================================================} - -end. diff --git a/components/Abbrevia/source/AbDfCryS.pas b/components/Abbrevia/source/AbDfCryS.pas deleted file mode 100644 index e0ddf2d..0000000 --- a/components/Abbrevia/source/AbDfCryS.pas +++ /dev/null @@ -1,634 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfCryS.pas *} -{*********************************************************} -{* Deflate encryption streams *} -{*********************************************************} - -unit AbDfCryS; - -{$I AbDefine.inc} - -interface - -uses - Classes; - -type - TAbZipEncryptHeader = array [0..11] of byte; - - TAbZipDecryptEngine = class - private - FReady : boolean; - FState : array [0..2] of longint; - protected - procedure zdeInitState(const aPassphrase : AnsiString); - public - constructor Create; - - function Decode(aCh : byte) : byte; - {-decodes a byte} - procedure DecodeBuffer(var aBuffer; aCount : integer); - {-decodes a buffer} - - function VerifyHeader(const aHeader : TAbZipEncryptHeader; - const aPassphrase : AnsiString; - aCheckValue : longint) : boolean; - {-validate an encryption header} - end; - - TAbDfDecryptStream = class(TStream) - private - FCheckValue : longint; - FEngine : TAbZipDecryptEngine; - FOwnsStream : Boolean; - FPassphrase : AnsiString; - FReady : boolean; - FStream : TStream; - protected - public - constructor Create(aStream : TStream; - aCheckValue : longint; - const aPassphrase : AnsiString); - destructor Destroy; override; - - function IsValid : boolean; - - function Read(var aBuffer; aCount : longint) : longint; override; - function Seek(aOffset : longint; aOrigin : word) : longint; override; - function Write(const aBuffer; aCount : longint) : longint; override; - - property OwnsStream : Boolean - read FOwnsStream - write FOwnsStream; - end; - - TAbZipEncryptEngine = class - private - FReady : boolean; - FState : array [0..2] of longint; - protected - procedure zeeInitState(const aPassphrase : AnsiString); - public - constructor Create; - - function Encode(aCh : byte) : byte; - {-encodes a byte} - procedure EncodeBuffer(var aBuffer; aCount : integer); - {-encodes a buffer} - - procedure CreateHeader(var aHeader : TAbZipEncryptHeader; - const aPassphrase : AnsiString; - aCheckValue : longint); - {-generate an encryption header} - end; - - TAbDfEncryptStream = class(TStream) - private - FBuffer : PAnsiChar; - FBufSize : integer; - FEngine : TAbZipEncryptEngine; - FStream : TStream; - protected - public - constructor Create(aStream : TStream; - aCheckValue : longint; - const aPassphrase : AnsiString); - destructor Destroy; override; - - function Read(var aBuffer; aCount : longint) : longint; override; - function Seek(aOffset : longint; aOrigin : word) : longint; override; - function Write(const aBuffer; aCount : longint) : longint; override; - end; - -implementation - -{Notes: the ZIP spec defines a couple of primitive routines for - performing encryption. For speed Abbrevia inlines them into - the respective methods of the encryption/decryption engines - - char crc32(long,char) - return updated CRC from current CRC and next char - - update_keys(char): - Key(0) <- crc32(key(0),char) - Key(1) <- Key(1) + (Key(0) & 000000ffH) - Key(1) <- Key(1) * 134775813 + 1 - Key(2) <- crc32(key(2),key(1) >> 24) - end update_keys - - char decrypt_byte() - local unsigned short temp - temp <- Key(2) | 2 - decrypt_byte <- (temp * (temp ^ 1)) >> 8 - end decrypt_byte -} - -uses - AbUtils; - -{---magic numbers from ZIP spec---} -const - StateInit1 = 305419896; - StateInit2 = 591751049; - StateInit3 = 878082192; - MagicNumber = 134775813; - -{===internal encryption class========================================} -constructor TAbZipDecryptEngine.Create; -begin - {create the ancestor} - inherited Create; - - {we're not ready for decryption yet since a header hasn't been - properly verified with VerifyHeader} - FReady := false; -end; -{--------} -function TAbZipDecryptEngine.Decode(aCh : byte) : byte; -var - Temp : longint; -begin - {check for programming error} - Assert(FReady, - 'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first'); - - {calculate the decoded byte (uses inlined decrypt_byte)} - Temp := (FState[2] and $FFFF) or 2; - Result := aCh xor ((Temp * (Temp xor 1)) shr 8); - - {mix the decoded byte into the state (uses inlined update_keys)} - FState[0] := AbUpdateCrc32(Result, FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); -end; -{--------} -procedure TAbZipDecryptEngine.DecodeBuffer(var aBuffer; aCount : integer); -var - i : integer; - Temp : longint; - Buffer : PAnsiChar; - WorkState : array [0..2] of longint; -begin - {check for programming error} - Assert(FReady, - 'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first'); - - {move the state to a local variable--for better speed} - WorkState[0] := FState[0]; - WorkState[1] := FState[1]; - WorkState[2] := FState[2]; - - {reference the buffer as a PChar--easier arithmetic} - Buffer := @aBuffer; - - {for each byte in the buffer...} - for i := 0 to pred(aCount) do begin - - {calculate the next decoded byte (uses inlined decrypt_byte)} - Temp := (WorkState[2] and $FFFF) or 2; - Buffer^ := AnsiChar( - byte(Buffer^) xor ((Temp * (Temp xor 1)) shr 8)); - - {mix the decoded byte into the state (uses inlined update_keys)} - WorkState[0] := AbUpdateCrc32(byte(Buffer^), WorkState[0]); - WorkState[1] := WorkState[1] + (WorkState[0] and $FF); - WorkState[1] := (WorkState[1] * MagicNumber) + 1; - WorkState[2] := AbUpdateCrc32(WorkState[1] shr 24, WorkState[2]); - - {move onto the next byte} - inc(Buffer); - end; - - {save the state} - FState[0] := WorkState[0]; - FState[1] := WorkState[1]; - FState[2] := WorkState[2]; -end; -{--------} -function TAbZipDecryptEngine.VerifyHeader(const aHeader : TAbZipEncryptHeader; - const aPassphrase : AnsiString; - aCheckValue : longint) : boolean; -type - TLongAsBytes = packed record - L1, L2, L3, L4 : byte - end; -var - i : integer; - Temp : longint; - WorkHeader : TAbZipEncryptHeader; -begin - {check for programming errors} - Assert(aPassphrase <> '', - 'TAbZipDecryptEngine.VerifyHeader: need a passphrase'); - - {initialize the decryption state} - zdeInitState(aPassphrase); - - {decrypt the bytes in the header} - for i := 0 to 11 do begin - - {calculate the next decoded byte (uses inlined decrypt_byte)} - Temp := (FState[2] and $FFFF) or 2; - WorkHeader[i] := aHeader[i] xor ((Temp * (Temp xor 1)) shr 8); - - {mix the decoded byte into the state (uses inlined update_keys)} - FState[0] := AbUpdateCrc32(WorkHeader[i], FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); - end; - - {the header is valid if the twelfth byte of the decrypted header - equals the fourth byte of the check value} - Result := WorkHeader[11] = TLongAsBytes(aCheckValue).L4; - - {note: zips created with PKZIP prior to version 2.0 also checked - that the tenth byte of the decrypted header equals the third - byte of the check value} - FReady := Result; -end; -{--------} -procedure TAbZipDecryptEngine.zdeInitState(const aPassphrase : AnsiString); -var - i : integer; -begin - {initialize the decryption state} - FState[0] := StateInit1; - FState[1] := StateInit2; - FState[2] := StateInit3; - - {mix in the passphrase to the state (uses inlined update_keys)} - for i := 1 to length(aPassphrase) do begin - FState[0] := AbUpdateCrc32(byte(aPassphrase[i]), FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); - end; -end; -{====================================================================} - - -{====================================================================} -constructor TAbDfDecryptStream.Create(aStream : TStream; - aCheckValue : longint; - const aPassphrase : AnsiString); -begin - {create the ancestor} - inherited Create; - - {save the parameters} - FStream := aStream; - FCheckValue := aCheckValue; - FPassphrase := aPassphrase; - - {create the decryption engine} - FEngine := TAbZipDecryptEngine.Create; -end; -{--------} -destructor TAbDfDecryptStream.Destroy; {new !!.02} -begin - FEngine.Free; - if FOwnsStream then - FStream.Free; - inherited Destroy; -end; -{--------} -function TAbDfDecryptStream.IsValid : boolean; -var - Header : TAbZipEncryptHeader; -begin - {read the header from the stream} - FStream.ReadBuffer(Header, sizeof(Header)); - - {check to see if the decryption engine agrees it's valid} - Result := FEngine.VerifyHeader(Header, FPassphrase, FCheckValue); - - {if it isn't valid, reposition the stream, ready for the next try} - if not Result then begin - FStream.Seek(-sizeof(Header), soCurrent); - FReady := false; - end - - {otherwise, the stream is ready for decrypting data} - else - FReady := true; -end; -{--------} -function TAbDfDecryptStream.Read(var aBuffer; aCount : longint) : longint; -begin - {check for programming error} - Assert(FReady, - 'TAbDfDecryptStream.Read: the stream header has not been verified'); - - {read the data from the underlying stream} - Result := FStream.Read(aBuffer, aCount); - - {decrypt the data} - FEngine.DecodeBuffer(aBuffer, Result); -end; -{--------} -function TAbDfDecryptStream.Seek(aOffset : longint; aOrigin : word) : longint; -begin - Result := FStream.Seek(aOffset, aOrigin); -end; -{--------} -function TAbDfDecryptStream.Write(const aBuffer; aCount : longint) : longint; -begin - {check for programming error} - Assert(false, - 'TAbDfDecryptStream.Write: the stream is read-only'); - Result := 0; -end; -{====================================================================} - - -{===TAbZipEncryptEngine==============================================} -constructor TAbZipEncryptEngine.Create; -begin - {create the ancestor} - inherited Create; - - {we're not ready for encryption yet since a header hasn't been - properly generated with CreateHeader} - FReady := false; -end; -{--------} -procedure TAbZipEncryptEngine.CreateHeader( - var aHeader : TAbZipEncryptHeader; - const aPassphrase : AnsiString; - aCheckValue : longint); -type - TLongAsBytes = packed record - L1, L2, L3, L4 : byte - end; -var - Ch : byte; - i : integer; - Temp : longint; - WorkHeader : TAbZipEncryptHeader; -begin - {check for programming errors} - Assert(aPassphrase <> '', - 'TAbZipEncryptEngine.CreateHeader: need a passphrase'); - - {set the first ten bytes of the header with random values (in fact, - we use a random value for each byte and mix it in with the state)} - - {initialize the decryption state} - zeeInitState(aPassphrase); - - {for the first ten bytes...} - for i := 0 to 9 do begin - - {get a random value} - Ch := Random( 256 ); - - {calculate the XOR encoding byte (uses inlined decrypt_byte)} - Temp := (FState[2] and $FFFF) or 2; - Temp := (Temp * (Temp xor 1)) shr 8; - - {mix the unencoded byte into the state (uses inlined update_keys)} - FState[0] := AbUpdateCrc32(Ch, FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); - - {set the current byte of the header} - WorkHeader[i] := Ch xor Temp; - end; - - {now encrypt the first ten bytes of the header (this merely sets up - the state so that we can encrypt the last two bytes)} - - {reinitialize the decryption state} - zeeInitState(aPassphrase); - - {for the first ten bytes...} - for i := 0 to 9 do begin - - {calculate the XOR encoding byte (uses inlined decrypt_byte)} - Temp := (FState[2] and $FFFF) or 2; - Temp := (Temp * (Temp xor 1)) shr 8; - - {mix the unencoded byte into the state (uses inlined update_keys)} - FState[0] := AbUpdateCrc32(WorkHeader[i], FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); - - {set the current byte of the header} - WorkHeader[i] := WorkHeader[i] xor Temp; - end; - - {now initialize byte 10 of the header, and encrypt it} - Ch := TLongAsBytes(aCheckValue).L3; - Temp := (FState[2] and $FFFF) or 2; - Temp := (Temp * (Temp xor 1)) shr 8; - FState[0] := AbUpdateCrc32(Ch, FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); - WorkHeader[10] := Ch xor Temp; - - {now initialize byte 11 of the header, and encrypt it} - Ch := TLongAsBytes(aCheckValue).L4; - Temp := (FState[2] and $FFFF) or 2; - Temp := (Temp * (Temp xor 1)) shr 8; - FState[0] := AbUpdateCrc32(Ch, FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); - WorkHeader[11] := Ch xor Temp; - - {we're now ready to encrypt} - FReady := true; - - {return the header} - aHeader := WorkHeader; -end; -{--------} -function TAbZipEncryptEngine.Encode(aCh : byte) : byte; -var - Temp : longint; -begin - {check for programming error} - Assert(FReady, - 'TAbZipEncryptEngine.Encode: must call CreateHeader first'); - - {calculate the encoded byte (uses inlined decrypt_byte)} - Temp := (FState[2] and $FFFF) or 2; - Result := aCh xor (Temp * (Temp xor 1)) shr 8; - - {mix the unencoded byte into the state (uses inlined update_keys)} - FState[0] := AbUpdateCrc32(aCh, FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); -end; -{--------} -procedure TAbZipEncryptEngine.EncodeBuffer(var aBuffer; aCount : integer); -var - Ch : byte; - i : integer; - Temp : longint; - Buffer : PAnsiChar; - WorkState : array [0..2] of longint; -begin - {check for programming error} - Assert(FReady, - 'TAbZipEncryptEngine.EncodeBuffer: must call CreateHeader first'); - - {move the state to a local variable--for better speed} - WorkState[0] := FState[0]; - WorkState[1] := FState[1]; - WorkState[2] := FState[2]; - - {reference the buffer as a PChar--easier arithmetic} - Buffer := @aBuffer; - - {for each byte in the buffer...} - for i := 0 to pred(aCount) do begin - - {calculate the next encoded byte (uses inlined decrypt_byte)} - Temp := (WorkState[2] and $FFFF) or 2; - Ch := byte(Buffer^); - Buffer^ := AnsiChar(Ch xor ((Temp * (Temp xor 1)) shr 8)); - - {mix the decoded byte into the state (uses inlined update_keys)} - WorkState[0] := AbUpdateCrc32(Ch, WorkState[0]); - WorkState[1] := WorkState[1] + (WorkState[0] and $FF); - WorkState[1] := (WorkState[1] * MagicNumber) + 1; - WorkState[2] := AbUpdateCrc32(WorkState[1] shr 24, WorkState[2]); - - {move onto the next byte} - inc(Buffer); - end; - - {save the state} - FState[0] := WorkState[0]; - FState[1] := WorkState[1]; - FState[2] := WorkState[2]; -end; -{--------} -procedure TAbZipEncryptEngine.zeeInitState(const aPassphrase : AnsiString); -var - i : integer; -begin - {initialize the decryption state} - FState[0] := StateInit1; - FState[1] := StateInit2; - FState[2] := StateInit3; - - {mix in the passphrase to the state (uses inlined update_keys)} - for i := 1 to length(aPassphrase) do begin - FState[0] := AbUpdateCrc32(byte(aPassphrase[i]), FState[0]); - FState[1] := FState[1] + (FState[0] and $FF); - FState[1] := (FState[1] * MagicNumber) + 1; - FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]); - end; -end; -{====================================================================} - - -{===TAbDfEncryptStream===============================================} -constructor TAbDfEncryptStream.Create(aStream : TStream; - aCheckValue : longint; - const aPassphrase : AnsiString); -var - Header : TAbZipEncryptHeader; -begin - {create the ancestor} - inherited Create; - - {save the stream parameter} - FStream := aStream; - - {create the encryption engine} - FEngine := TAbZipEncryptEngine.Create; - - {generate the encryption header, write it to the stream} - FEngine.CreateHeader(Header, aPassphrase, aCheckValue); - aStream.WriteBuffer(Header, sizeof(Header)); -end; -{--------} -destructor TAbDfEncryptStream.Destroy; -begin - {free the internal buffer if used} - if (FBuffer <> nil) then - FreeMem(FBuffer); - - {free the engine} - FEngine.Free; - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -function TAbDfEncryptStream.Read(var aBuffer; aCount : longint) : longint; -begin - {check for programming error} - Assert(false, - 'TAbDfEncryptStream.Read: the stream is write-only'); - Result := 0; -end; -{--------} -function TAbDfEncryptStream.Seek(aOffset : longint; aOrigin : word) : longint; -begin - Result := FStream.Seek(aOffset, aOrigin); -end; -{--------} -function TAbDfEncryptStream.Write(const aBuffer; aCount : longint) : longint; -begin - {note: since we cannot alter a const parameter, we should copy the - data to our own buffer, encrypt it and then write it} - - {check that our buffer is large enough} - if (FBufSize < aCount) then begin - if (FBuffer <> nil) then - FreeMem(FBuffer); - GetMem(FBuffer, aCount); - FBufSize := aCount; - end; - - {copy the data to our buffer} - Move(aBuffer, FBuffer^, aCount); - - {encrypt the data in our buffer} - FEngine.EncodeBuffer(FBuffer^, aCount); - - {write the data in our buffer to the underlying stream} - Result := FStream.Write(FBuffer^, aCount); -end; -{====================================================================} - - -end. - - - diff --git a/components/Abbrevia/source/AbDfDec.pas b/components/Abbrevia/source/AbDfDec.pas deleted file mode 100644 index 6e9dcbf..0000000 --- a/components/Abbrevia/source/AbDfDec.pas +++ /dev/null @@ -1,822 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfDec.pas *} -{*********************************************************} -{* Deflate decoding unit *} -{*********************************************************} - -unit AbDfDec; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbDfBase; - -function Inflate(aSource : TStream; aDest : TStream; - aHelper : TAbDeflateHelper) : longint; - -implementation - -uses - SysUtils, - AbDfStrm, - AbDfHufD, - AbDfOutW, - AbDfCryS; - - -{===Helper routines==================================================} -procedure ReadLitDistCodeLengths(aInStrm : TAbDfInBitStream; - aCodeLenTree : TAbDfDecodeHuffmanTree; - var aCodeLens : array of integer; - aCount : integer; - var aTotalBits : integer); -var - i : integer; - SymbolCount : integer; - LookupValue : integer; - EncodedSymbol : longint; - Symbol : integer; - SymbolCodeLen : integer; - RepeatCount : integer; - BitBuffer : TAb32bit; - BitCount : integer; -begin - {$IFDEF UseLogging} - {we need to calculate the total number of bits in the code lengths - for reporting purposes, so zero the count} - aTotalBits := 0; - {$ENDIF} - - {clear the code lengths array} - FillChar(aCodeLens, sizeof(aCodeLens), 0); - - {read all the Symbols required in the bit stream} - SymbolCount := 0; - while (SymbolCount < aCount) do begin - {grab the lookup set of bits} - BitCount := aCodeLenTree.LookupBitLength + 7; - {$IFOPT C+} - BitBuffer := aInStrm.PeekBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - BitBuffer := aInStrm.PeekMoreBits(BitCount) - else - BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount]; - {$ENDIF} - LookupValue := - BitBuffer and AbExtractMask[aCodeLenTree.LookupBitLength]; - - {get the encoded Symbol} - {$IFOPT C+} {if Assertions are on} - EncodedSymbol := aCodeLenTree.Decode(LookupValue); - {$ELSE} - EncodedSymbol := aCodeLenTree.Decodes^[LookupValue]; - {$ENDIF} - - {extract the data} - Symbol := EncodedSymbol and $FFFF; - SymbolCodeLen := (EncodedSymbol shr 16) and $FF; - - {$IFDEF UseLogging} - {keep count of the total number of bits read} - inc(aTotalBits, SymbolCodeLen); - {$ENDIF} - - {check that the symbol is between 0 and 18} - if not ((0 <= Symbol) and (Symbol <= 18)) then - raise EAbInternalInflateError.Create( - 'decoded a symbol not between 0 and 18 {ReadLitDistCodeLengths}'); - - {check that the codelength is in range} - if not ((0 < SymbolCodeLen) and - (SymbolCodeLen <= aCodeLenTree.LookupBitLength)) then - raise EAbInternalInflateError.Create( - 'decoded a code length out of range {ReadLitDistCodeLengths}'); - - {for a Symbol of 0..15, just save the value} - if (Symbol <= 15) then begin - aCodeLens[SymbolCount] := Symbol; - inc(SymbolCount); - {$IFOPT C+} - aInStrm.DiscardBits(SymbolCodeLen); - {$ELSE} - if (aInStrm.BitsLeft < SymbolCodeLen) then - aInStrm.DiscardMoreBits(SymbolCodeLen) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen; - aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen; - end; - {$ENDIF} - end - - {for a Symbol of 16, get two more bits and copy the previous - code length that many times + 3} - else if (Symbol = 16) then begin - RepeatCount := 3 + ((BitBuffer shr SymbolCodeLen) and $3); - Symbol := aCodeLens[SymbolCount-1]; - for i := 0 to pred(RepeatCount) do - aCodeLens[SymbolCount+i] := Symbol; - inc(SymbolCount, RepeatCount); - BitCount := SymbolCodeLen + 2; - {$IFOPT C+} - aInStrm.DiscardBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - aInStrm.DiscardMoreBits(BitCount) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount; - aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount; - end; - {$ENDIF} - {$IFDEF UseLogging} - inc(aTotalBits, 2); - {$ENDIF} - end - - {for a Symbol of 17, get three more bits and copy a zero code - length that many times + 3} - else if (Symbol = 17) then begin - RepeatCount := 3 + ((BitBuffer shr SymbolCodeLen) and $7); - {note: the codelengths array was aet to zeros at the start so - the following two lines are not needed - for i := 0 to pred(RepeatCount) do - aCodeLens[SymbolCount+i] := 0;} - inc(SymbolCount, RepeatCount); - BitCount := SymbolCodeLen + 3; - {$IFOPT C+} - aInStrm.DiscardBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - aInStrm.DiscardMoreBits(BitCount) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount; - aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount; - end; - {$ENDIF} - {$IFDEF UseLogging} - inc(aTotalBits, 3); - {$ENDIF} - end - - {for a Symbol of 18, get seven more bits and copy a zero code - length that many times + 11} - else if (Symbol = 18) then begin - RepeatCount := 11 + ((BitBuffer shr SymbolCodeLen) and $7F); - {note: the codelengths array was aet to zeros at the start so - the following two lines are not needed - for i := 0 to pred(RepeatCount) do - aCodeLens[SymbolCount+i] := 0;} - inc(SymbolCount, RepeatCount); - BitCount := SymbolCodeLen + 7; - {$IFOPT C+} - aInStrm.DiscardBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - aInStrm.DiscardMoreBits(BitCount) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount; - aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount; - end; - {$ENDIF} - {$IFDEF UseLogging} - inc(aTotalBits, 7); - {$ENDIF} - end; - end; -end; -{--------} -procedure DecodeData(aInStrm : TAbDfInBitStream; - aOutWindow : TAbDfOutputWindow; - aLiteralTree : TAbDfDecodeHuffmanTree; - aDistanceTree : TAbDfDecodeHuffmanTree; - aDeflate64 : boolean); -var - LookupValue : integer; - EncodedSymbol : longint; - Symbol : integer; - SymbolCodeLen : integer; - ExtraBitCount : integer; - Length : integer; - Distance : integer; - BitBuffer : TAb32bit; - BitCount : integer; -begin - {extract the first symbol (it's got to be a literal/length symbol)} - {..grab the lookup set of bits} - if aDeflate64 then - BitCount := aLiteralTree.LookupBitLength + 16 - else - BitCount := aLiteralTree.LookupBitLength + 5; - {$IFOPT C+} - BitBuffer := aInStrm.PeekBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - BitBuffer := aInStrm.PeekMoreBits(BitCount) - else - BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount]; - {$ENDIF} - LookupValue := - BitBuffer and AbExtractMask[aLiteralTree.LookupBitLength]; - {..get the encoded symbol} - {$IFOPT C+} {if Assertions are on} - EncodedSymbol := aLiteralTree.Decode(LookupValue); - {$ELSE} - EncodedSymbol := aLiteralTree.Decodes^[LookupValue]; - {$ENDIF} - {..extract the data} - Symbol := EncodedSymbol and $FFFF; - SymbolCodeLen := (EncodedSymbol shr 16) and $FF; -// ExtraBitCount := EncodedSymbol shr 24; - - {repeat until we get the end-of-block symbol} - while ((Symbol <> 256) {and (ExtraBitCount <> 15)}) do begin - {for a literal, just output it to the sliding window} - if (Symbol < 256) then begin - aOutWindow.AddLiteral(AnsiChar(Symbol)); - {$IFOPT C+} - aInStrm.DiscardBits(SymbolCodeLen); - {$ELSE} - if (aInStrm.BitsLeft < SymbolCodeLen) then - aInStrm.DiscardMoreBits(SymbolCodeLen) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen; - aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen; - end; - {$ENDIF} - end - - {for a length value, we need to get any extra bits, and then the - distance (plus any extra bits for that), and then add the - duplicated characters to the sliding window} - else begin - - {check that the length symbol is less than or equal to 285} - if (Symbol > 285) then - raise EAbInternalInflateError.Create( - 'decoded an invalid length symbol: greater than 285 [DecodeData]'); - - {calculate the length (if need be, by calculating the number of - extra bits that encode the length)} - if (not aDeflate64) and (Symbol = 285) then begin - Length := 258; - {$IFOPT C+} - aInStrm.DiscardBits(SymbolCodeLen); - {$ELSE} - if (aInStrm.BitsLeft < SymbolCodeLen) then - aInStrm.DiscardMoreBits(SymbolCodeLen) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen; - aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen; - end; - {$ENDIF} - end - else begin - ExtraBitCount := EncodedSymbol shr 24; - if (ExtraBitCount = 0) then begin - Length := dfc_LengthBase[Symbol - 257]; - {$IFOPT C+} - aInStrm.DiscardBits(SymbolCodeLen); - {$ELSE} - if (aInStrm.BitsLeft < SymbolCodeLen) then - aInStrm.DiscardMoreBits(SymbolCodeLen) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen; - aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen; - end; - {$ENDIF} - end - else begin - Length := dfc_LengthBase[Symbol - 257] + - ((BitBuffer shr SymbolCodeLen) and - AbExtractMask[ExtraBitCount]); - BitCount := SymbolCodeLen + ExtraBitCount; - {$IFOPT C+} - aInStrm.DiscardBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - aInStrm.DiscardMoreBits(BitCount) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount; - aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount; - end; - {$ENDIF} - end; - end; - - {extract the distance} - {..grab the lookup set of bits} - BitCount := aDistanceTree.LookupBitLength + 14; - {$IFOPT C+} - BitBuffer := aInStrm.PeekBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - BitBuffer := aInStrm.PeekMoreBits(BitCount) - else - BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount]; - {$ENDIF} - LookupValue := - BitBuffer and AbExtractMask[aDistanceTree.LookupBitLength]; - {..get the encoded symbol} - {$IFOPT C+} {if Assertions are on} - EncodedSymbol := aDistanceTree.Decode(LookupValue); - {$ELSE} - EncodedSymbol := aDistanceTree.Decodes^[LookupValue]; - {$ENDIF} - {..extract the data} - Symbol := EncodedSymbol and $FFFF; - SymbolCodeLen := (EncodedSymbol shr 16) and $FF; - - {check that the distance symbol is less than or equal to 29} - if (not aDeflate64) and (Symbol > 29) then - raise EAbInternalInflateError.Create( - 'decoded an invalid distance symbol: greater than 29 [DecodeData]'); - - {..calculate the extra bits for the distance} - ExtraBitCount := EncodedSymbol shr 24; - {..calculate the distance} - if (ExtraBitCount = 0) then begin - Distance := dfc_DistanceBase[Symbol]; - {$IFOPT C+} - aInStrm.DiscardBits(SymbolCodeLen); - {$ELSE} - if (aInStrm.BitsLeft < SymbolCodeLen) then - aInStrm.DiscardMoreBits(SymbolCodeLen) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen; - aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen; - end; - {$ENDIF} - end - else begin - Distance := dfc_DistanceBase[Symbol] + - ((BitBuffer shr SymbolCodeLen) and - AbExtractMask[ExtraBitCount]); - BitCount := SymbolCodeLen + ExtraBitCount; - {$IFOPT C+} - aInStrm.DiscardBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - aInStrm.DiscardMoreBits(BitCount) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount; - aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount; - end; - {$ENDIF} - end; - - {duplicate the characters in the sliding window} - aOutWindow.AddLenDist(Length, Distance); - end; - - {extract the next symbol} - {..grab the lookup set of bits} - if aDeflate64 then - BitCount := aLiteralTree.LookupBitLength + 16 - else - BitCount := aLiteralTree.LookupBitLength + 5; - {$IFOPT C+} - BitBuffer := aInStrm.PeekBits(BitCount); - {$ELSE} - if (aInStrm.BitsLeft < BitCount) then - BitBuffer := aInStrm.PeekMoreBits(BitCount) - else - BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount]; - {$ENDIF} - LookupValue := - BitBuffer and AbExtractMask[aLiteralTree.LookupBitLength]; - {..get the encoded symbol} - {$IFOPT C+} {if Assertions are on} - EncodedSymbol := aLiteralTree.Decode(LookupValue); - {$ELSE} - EncodedSymbol := aLiteralTree.Decodes^[LookupValue]; - {$ENDIF} - {..extract the data} - Symbol := EncodedSymbol and $FFFF; - SymbolCodeLen := (EncodedSymbol shr 16) and $FF; - end; - - {discard the bits for the end-of-block marker} - {$IFOPT C+} - aInStrm.DiscardBits(SymbolCodeLen); - {$ELSE} - if (aInStrm.BitsLeft < SymbolCodeLen) then - aInStrm.DiscardMoreBits(SymbolCodeLen) - else begin - aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen; - aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen; - end; - {$ENDIF} -end; -{--------} -procedure InflateStoredBlock(aInStrm : TAbDfInBitStream; - aOutWindow : TAbDfOutputWindow; - aLog : TAbLogger); -const - BufferSize = 16 * 1024; -var - LenNotLen : packed record - Len : word; - NotLen : word; - end; - BytesToGo : integer; - BytesToWrite : integer; - Buffer : pointer; -begin - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then - aLog.WriteLine('....a stored block'); - {$ENDIF} - - {align the input bit stream to the nearest byte boundary} - aInStrm.AlignToByte; - - {read the length of the stored data and the notted length} - aInStrm.ReadBuffer(LenNotLen, sizeof(LenNotLen)); - - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then - aLog.WriteLine(Format('..block length: %d (%-4x, NOT %-4x)', - [LenNotLen.Len, LenNotLen.Len, LenNotLen.NotLen])); - {$ENDIF} - - {check that NOT of the length equals the notted length} - if ((not LenNotLen.Len) <> LenNotLen.NotLen) then - raise EAbInternalInflateError.Create( - 'invalid stored block (length and NOT length do not match) [InflateStoredBlock]'); - - {calculate the number of bytes to copy from the stored block} - BytesToGo := LenNotLen.Len; - - {allocate a large buffer} - GetMem(Buffer, BufferSize); - - {copy all the data in the stored block to the output window} - try - {while there are still some bytes to copy...} - while (BytesToGo <> 0) do begin - {calculate the number of bytes this time} - if (BytesToGo > BufferSize) then - BytesToWrite := BufferSize - else - BytesToWrite := BytesToGo; - - {read that many bytes and write them to the output window} - aInStrm.ReadBuffer(Buffer^, BytesToWrite); - aOutWindow.AddBuffer(Buffer^, BytesToWrite); - - {calculate the number of bytes still to copy} - dec(BytesToGo, BytesToWrite); - end; - finally - FreeMem(Buffer); - end; -end; -{--------} -procedure InflateStaticBlock(aInStrm : TAbDfInBitStream; - aOutWindow : TAbDfOutputWindow; - aLog : TAbLogger; - aDeflate64 : boolean); -begin - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then - aLog.WriteLine('....a static huffman tree block'); - {$ENDIF} - - {decode the data with the static trees} - DecodeData(aInStrm, aOutWindow, - AbStaticLiteralTree, AbStaticDistanceTree, aDeflate64); -end; -{--------} -procedure InflateDynamicBlock(aInStrm : TAbDfInBitStream; - aOutWindow : TAbDfOutputWindow; - aLog : TAbLogger; - aDeflate64 : boolean); -var - i : integer; - LitCount : integer; - DistCount : integer; - CodeLenCount : integer; - CodeLens : array [0..285+32] of integer; - CodeLenTree : TAbDfDecodeHuffmanTree; - LiteralTree : TAbDfDecodeHuffmanTree; - DistanceTree : TAbDfDecodeHuffmanTree; - TotalBits : integer; -begin - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then - aLog.WriteLine('....a dynamic huffman tree block'); - {$ENDIF} - - {prepare for the try..finally} - CodeLenTree := nil; - LiteralTree := nil; - DistanceTree := nil; - - try - {decode the number of literal, distance and codelength codes} - LitCount := aInStrm.ReadBits(5) + 257; - DistCount := aInStrm.ReadBits(5) + 1; - CodeLenCount := aInStrm.ReadBits(4) + 4; - - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then begin - aLog.WriteLine(Format('Count of literals: %d', [LitCount])); - aLog.WriteLine(Format('Count of distances: %d', [DistCount])); - aLog.WriteLine(Format('Count of code lengths: %d', [CodeLenCount])); - end; - {$ENDIF} - - {verify that the counts are valid} - if (LitCount > 286) then - raise EAbInternalInflateError.Create( - 'count of literal codes in dynamic block is greater than 286 [InflateDynamicBlock]'); - if (not aDeflate64) and (DistCount > 30) then - raise EAbInternalInflateError.Create( - 'count of distance codes in dynamic block is greater than 30 [InflateDynamicBlock]'); - - {read the codelengths} - FillChar(CodeLens, 19 * sizeof(integer), 0); - for i := 0 to pred(CodeLenCount) do - CodeLens[dfc_CodeLengthIndex[i]] := aInStrm.ReadBits(3); - - {$IFDEF UseLogging} - {log them} - if (aLog <> nil) then begin - aLog.WriteLine('CodeLength Huffman tree: code lengths'); - for i := 0 to 18 do - aLog.WriteStr(Format('%-3d', [CodeLens[i]])); - aLog.WriteLine(''); - aLog.WriteLine(Format('..total bits: %d', [CodeLenCount * 3])); - end; - {$ENDIF} - - {create the codelength huffman tree} - CodeLenTree := TAbDfDecodeHuffmanTree.Create(19, 7, huDecoding); - CodeLenTree.Build(CodeLens, 0, 19, [0], $FFFF); - - {$IFDEF UseLogging} - {log the tree} - if (aLog <> nil) then begin - aLog.WriteLine('Code lengths tree'); - CodeLenTree.DebugPrint(aLog); - end; - {$ENDIF} - - {read the codelengths for both the literal/length and distance - huffman trees} - ReadLitDistCodeLengths(aInStrm, CodeLenTree, CodeLens, - LitCount + DistCount, TotalBits); - - {$IFDEF UseLoggingx} - {log them} - if (aLog <> nil) then begin - aLog.WriteLine('Literal/length & Dist Huffman trees: code lengths'); - for i := 0 to pred(LitCount + DistCount) do - aLog.WriteLine(Format('%3d: %3d', [i, CodeLens[i]])); - aLog.WriteLine(''); - aLog.WriteLine(Format('..total bits: %d', [TotalBits])); - end; - {$ENDIF} - - {create the literal huffman tree} - LiteralTree := TAbDfDecodeHuffmanTree.Create(286, 15, huDecoding); - LiteralTree.Build(CodeLens, 0, LitCount, - dfc_LitExtraBits, dfc_LitExtraOffset); - - {$IFDEF UseLogging} - {log the tree} - if (aLog <> nil) then begin - aLog.WriteLine('Literal/length tree'); - LiteralTree.DebugPrint(aLog); - end; - {$ENDIF} - - {create the distance huffman tree} - if aDeflate64 then - DistanceTree := TAbDfDecodeHuffmanTree.Create(32, 15, huDecoding) - else - DistanceTree := TAbDfDecodeHuffmanTree.Create(30, 15, huDecoding); - DistanceTree.Build(CodeLens, LitCount, DistCount, - dfc_DistExtraBits, dfc_DistExtraOffset); - - {$IFDEF UseLogging} - {log the tree} - if (aLog <> nil) then begin - aLog.WriteLine('Distance tree'); - DistanceTree.DebugPrint(aLog); - end; - {$ENDIF} - - {using the literal and distance trees, decode the bit stream} - DecodeData(aInStrm, aOutWindow, - LiteralTree, DistanceTree, aDeflate64); - finally - CodeLenTree.Free; - LiteralTree.Free; - DistanceTree.Free; - end; -end; -{====================================================================} - - -{===Interfaced routine===============================================} -function Inflate(aSource : TStream; aDest : TStream; - aHelper : TAbDeflateHelper) : longint; -var - Helper : TAbDeflateHelper; - InBitStrm : TAbDfInBitStream; - OutWindow : TAbDfOutputWindow; - Log : TAbLogger; - UseDeflate64 : boolean; - UseCRC32 : boolean; - IsFinalBlock : boolean; - BlockType : integer; - TestOnly : boolean; - SourceStartPos : longint; - DestStartPos : longint; - {$IFDEF UseLogging} - StartPosn : longint; - {$ENDIF} -begin - {$IFDEF DefeatWarnings} - Result := 0; - SourceStartPos := 0; - DestStartPos := 0; - TestOnly := False; - {$ENDIF} - - {$IFDEF UseLogging} - StartPosn := 0; - {$ENDIF} - - {pre-conditions: streams must be allocated of course} - Assert(aSource <> nil, 'Deflate: aSource stream cannot be nil'); - Assert(aDest <> nil, 'Deflate: aDest stream cannot be nil'); - - {prepare for the try..finally} - Helper := nil; - InBitStrm := nil; - OutWindow := nil; - Log := nil; - - try {finally} - try {except} - {create our helper; assign the passed one to it} - Helper := TAbDeflateHelper.Create; - if (aHelper <> nil) then - Helper.Assign(aHelper); - - {get the initial start positions of both streams} - SourceStartPos := aSource.Position; - DestStartPos := aDest.Position; - - {if the helper's stream size is -1, and it has a progress event - handler, calculate the stream size from the stream itself} - if Assigned(Helper.OnProgressStep) then begin - if (Helper.StreamSize = -1) then - Helper.StreamSize := aSource.Size; - end - - {otherwise we certainly can't do any progress reporting} - else begin - Helper.OnProgressStep := nil; - Helper.StreamSize := 0; - end; - - {create the logger, if requested} - if (Helper.LogFile <> '') then begin - Log := TAbLogger.Create(Helper.LogFile); - Log.WriteLine('INFLATING STREAM...'); - {$IFNDEF UseLogging} - Log.WriteLine('Need to recompile the app with UseLogging turned on'); - {$ENDIF} - end; - - InBitStrm := TAbDfInBitStream.Create(aSource, - Helper.OnProgressStep, - Helper.StreamSize); - - {create the output sliding window} - UseDeflate64 := (Helper.Options and dfc_UseDeflate64) <> 0; - UseCRC32 := (Helper.Options and dfc_UseAdler32) = 0; - TestOnly := (Helper.Options and dfc_TestOnly) <> 0; - OutWindow := TAbDfOutputWindow.Create( - aDest, UseDeflate64, UseCRC32, Helper.PartialSize, - TestOnly, Log); - - {start decoding the deflated stream} - repeat - {read the final block flag and the block type} - IsFinalBlock := InBitStrm.ReadBit; - BlockType := InBitStrm.ReadBits(2); - - {$IFDEF UseLogging} - {log it} - if (Log <> nil) then begin - Log.WriteLine(''); - Log.WriteLine('Starting new block'); - Log.WriteLine(Format('..final block? %d', [ord(IsFinalBlock)])); - Log.WriteLine(Format('..block type? %d', [BlockType])); - StartPosn := OutWindow.Position; - end; - {$ENDIF} - - case BlockType of - 0 : InflateStoredBlock(InBitStrm, OutWindow, Log); - 1 : InflateStaticBlock(InBitStrm, OutWindow, Log, UseDeflate64); - 2 : InflateDynamicBlock(InBitStrm, OutWindow, Log, UseDeflate64); - else - raise EAbInternalInflateError.Create( - 'starting new block, but invalid block type [Inflate]'); - end; - - {$IFDEF UseLogging} - {log it} - if (Log <> nil) then - Log.WriteLine(Format('---block end--- (decoded size %d bytes)', - [OutWindow.Position - StartPosn])); - {$ENDIF} - until IsFinalBlock; - - {get the uncompressed stream's checksum} - Result := OutWindow.Checksum; - if TestOnly and (aHelper <> nil) then - aHelper.NormalSize := OutWindow.Position; - {$IFDEF UseLogging} - {log it} - if (Log <> nil) then - Log.WriteLine(Format('End of compressed stream, checksum %-8x', - [Result])); - {$ENDIF} - except - on E : EAbPartSizedInflate do begin - {nothing, just swallow the exception} - Result := 0; - end; - on E : EAbAbortProgress do begin - {nothing, just swallow the exception} - Result := 0; - end; - on E : EAbInternalInflateError do begin - if (Log <> nil) then - Log.WriteLine(Format('Internal exception raised: %s', - [E.Message])); - raise EAbInflateError.Create(E.Message); - end; - end; - finally - Helper.Free; - OutWindow.Free; - InBitStrm.Free; - Log.Free; - end; - - {if there's a helper return the compressed and uncompressed sizes} - if (aHelper <> nil) then begin - if not TestOnly then - aHelper.NormalSize := aDest.Position - DestStartPos; - aHelper.CompressedSize := aSource.Position - SourceStartPos; - end; - - {WARNING NOTE: the compiler will warn that the return value of this - function might be undefined. However, it is wrong: it - has been fooled by the code. If you don't want to see - this warning again, enable the DefeatWarnings - compiler define in AbDefine.inc.} -end; -{====================================================================} - -end. diff --git a/components/Abbrevia/source/AbDfEnc.pas b/components/Abbrevia/source/AbDfEnc.pas deleted file mode 100644 index 600fc13..0000000 --- a/components/Abbrevia/source/AbDfEnc.pas +++ /dev/null @@ -1,906 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfEnc.pas *} -{*********************************************************} -{* Deflate encoding unit *} -{*********************************************************} - -unit AbDfEnc; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbDfBase; - -function Deflate(aSource : TStream; aDest : TStream; - aHelper : TAbDeflateHelper) : longint; - -implementation - -uses - AbDfInW, - AbDfHufD, - AbDfStrm, - AbDfCryS, - AbDfPkMg; - -{====================================================================} -function CalcDynamicBitCount(aUseDeflate64: boolean; - aLitBuckets : PAbDfLitBuckets; - aDistBuckets : PAbDfDistBuckets; - aCodeBuckets : PAbDfCodeLenBuckets; - const aCodeLens : array of integer; - const aCLCodeLens : array of integer; - aLitCount : integer; - aDistCount : integer; - aCodeCount : integer) : longint; -var - Symbol : integer; - LastSymbol : integer; - Inx : integer; -begin - {note: this routine calculates the number of bits required to - compress a given block} - - {a dynamic block starts off with 5 bits of literal symbol count, 5 - bits of distance symbol count, 4 bits of codelength symbol count, - and then 3 bits for every codelength symbol used} - Result := 5 + 5 + 4 + - (aCodeCount * 3); - - {add in the bits needed to compress the literal and distance trees} - inc(Result, aCodeBuckets^[16] * (aCLCodeLens[16] + 2)); - inc(Result, aCodeBuckets^[17] * (aCLCodeLens[16] + 3)); - inc(Result, aCodeBuckets^[18] * (aCLCodeLens[16] + 7)); - for Symbol := 3 to pred(aCodeCount) do begin - Inx := dfc_CodeLengthIndex[Symbol]; - Assert(Inx <=15, - 'CalcDynamicBitCount: the index array of codelengths is corrupted'); - inc(Result, aCodeBuckets^[Inx] * aCLCodeLens[Inx]) - end; - - {make the literal symbol 285 a special case} - LastSymbol := pred(aLitCount); - if (LastSymbol = 285) then - LastSymbol := 284; - - {add in all the bits needed to compress the literals (except 285)} - for Symbol := 0 to LastSymbol do - if (Symbol < dfc_LitExtraOffset) then - inc(Result, aLitBuckets^[Symbol] * aCodeLens[Symbol]) - else - inc(Result, aLitBuckets^[Symbol] * - (aCodeLens[Symbol] + - dfc_LitExtraBits[Symbol - dfc_LitExtraOffset])); - - {add in all the bits needed to compress the literal symbol 285} - if (pred(aLitCount) = 285) then - if (not aUseDeflate64) then - inc(Result, aLitBuckets^[285] * aCodeLens[285]) - else - inc(Result, aLitBuckets^[285] * (aCodeLens[285] + 16)); - - {add in all the bits needed to compress the distances} - for Symbol := 0 to pred(aDistCount) do - inc(Result, aDistBuckets^[Symbol] * - (aCodeLens[aLitCount + Symbol] + - dfc_DistExtraBits[Symbol])); -end; -{====================================================================} - - -{====================================================================} -procedure OutputEndOfBlock(aBitStrm : TAbDfOutBitStream; - aLitTree : TAbDfDecodeHuffmanTree); -var - Code : longint; -begin - {note: this routine encodes the end-of-block character (symbol 256) - and then writes out the code to the bit stream} - - {encode the end-of-block character as a symbol} - {$IFOPT C+} {if Assertions are on } - Code := aLitTree.Encode(256); - {$ELSE} - Code := aLitTree.Encodes^[256]; - {$ENDIF} - - {write the code out to the bit stream} - aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF); -end; -{--------} -procedure EncodeLZStreamStored(aFinalBlock : boolean; - aStream : TAbDfLZStream; - aBitStrm : TAbDfOutBitStream; - aDataSize : integer; - aLog : TAbLogger); -var - BlockHeader : packed record - bhSize : word; - bhNotSize : word; - end; - Buffer : pointer; - Code : integer; - BlockSize : integer; -begin - {note: this routine writes out an incompressible block to the bit - stream (the store algorithm)} - - {allocate the maximum buffer we can write at once} - GetMem(Buffer, 64 * 1024); - try - - {while there's more incompressible data to store...} - while (aDataSize <> 0) do begin - - {calculate the block size to write this time} - if (aDataSize > $FFFF) then begin - BlockSize := $FFFF; - dec(aDataSize, $FFFF); - end - else begin - BlockSize := aDataSize; - aDataSize := 0; - end; - - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then begin - aLog.WriteLine('..Writing new block...'); - aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)])); - aLog.WriteLine('..block type? 0'); - aLog.WriteLine(Format('..block size: %d', [BlockSize])); - end; - {$ENDIF} - - {output the block information to the bit stream} - if aFinalBlock then - Code := 1 + (0 shl 1) - else - Code := 0 + (0 shl 1); - aBitStrm.WriteBits(Code, 3); - - {align the bit stream to the nearest byte} - aBitStrm.AlignToByte; - - {write the stored block header} - BlockHeader.bhSize := BlockSize; - BlockHeader.bhNotSize := not BlockHeader.bhSize; - aBitStrm.WriteBuffer(BlockHeader, sizeof(BlockHeader)); - - {get and write this block} - aStream.ReadStoredBuffer(Buffer^, BlockSize); - aBitStrm.WriteBuffer(Buffer^, BlockSize); - end; - finally - FreeMem(Buffer); - end; - - {clear the stream, ready for the next block} - aStream.Clear; -end; -{--------} -procedure EncodeLZStreamStatic(aFinalBlock : boolean; - aUseDeflate64 : boolean; - aStream : TAbDfLZStream; - aBitStrm : TAbDfOutBitStream; - aLog : TAbLogger); -var - Code : integer; -begin - {note: this routine writes out the stream of LZ77 tokens for the - current block to the bit stream, using the static huffman - trees to encode the token symbols} - - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then begin - aLog.WriteLine('..Writing new block...'); - aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)])); - aLog.WriteLine('..block type? 1'); - end; - {$ENDIF} - - {output the block information to the bit stream} - if aFinalBlock then - Code := 1 + (1 shl 1) - else - Code := 0 + (1 shl 1); - aBitStrm.WriteBits(Code, 3); - - {encode the LZ77 stream} - aStream.Encode(aBitStrm, - AbStaticLiteralTree, AbStaticDistanceTree, - aUseDeflate64); - - {output the end-of-block marker to the bit stream} - OutputEndOfBlock(aBitStrm, AbStaticLiteralTree); - {$IFDEF UseLogging} - if (aLog <> nil) then - aLog.WriteLine('Char: end-of-block marker (#256)'); - {$ENDIF} -end; -{--------} -procedure EncodeLZStreamDynamic(aFinalBlock : boolean; - aUseDeflate64 : boolean; - aUseBest : boolean; - aStream : TAbDfLZStream; - aBitStrm : TAbDfOutBitStream; - aLog : TAbLogger); -var - i : integer; - LitTree : TAbDfDecodeHuffmanTree; - DistTree : TAbDfDecodeHuffmanTree; - CodeLenTree : TAbDfDecodeHuffmanTree; - CodeLenStream : TAbDfCodeLenStream; - CodeLens : array [0..285+32] of integer; - CLCodeLens : array [0..18] of integer; - LitCodeCount : integer; - DistCodeCount : integer; - LenCodeCount : integer; - BitCount : integer; - Code : integer; - StaticSize : integer; - StoredSize : integer; -begin - {note: this routine writes out the stream of LZ77 tokens for the - current block to the bit stream, using the dynamic huffman - trees to encode the token symbols; if the routine determines - that the data can better be compressed using the static - huffman trees or should be stored as is, it'll switch - algorithms} - - {prepare for the try..finally} - LitTree := nil; - DistTree := nil; - CodeLenTree := nil; - CodeLenStream := nil; - - try - - {calculate the code lengths for the literal symbols} - GenerateCodeLengths(15, aStream.LitBuckets^, CodeLens, 0, aLog); - - {calculate the number of the used codelengths for the literals} - LitCodeCount := 286; - repeat - dec(LitCodeCount); - until (CodeLens[LitCodeCount] <> 0); - inc(LitCodeCount); - - {calculate the code lengths for the distance symbols} - GenerateCodeLengths(15, aStream.DistBuckets^, CodeLens, - LitCodeCount, aLog); - - {calculate the number of the used codelengths for the distances} - DistCodeCount := 32; - repeat - dec(DistCodeCount); - until (CodeLens[DistCodeCount + LitCodeCount] <> 0); - inc(DistCodeCount); - - {calculate the code lengths array as a stream of items} - CodeLenStream := TAbDfCodeLenStream.Create(aLog); - CodeLenStream.Build(CodeLens, LitCodeCount + DistCodeCount); - - {calculate the codelengths for the code lengths} - GenerateCodeLengths(7, CodeLenStream.Buckets^, CLCodeLens, 0, nil); - - {calculate the number of the used codelengths for the code lengths} - LenCodeCount := 19; - repeat - dec(LenCodeCount); - until (CLCodeLens[dfc_CodeLengthIndex[LenCodeCount]] <> 0); - inc(LenCodeCount); - {..there's a minimum of four, though} - if (LenCodeCount < 4) then - LenCodeCount := 4; - - {if we have to work out and use the best method...} - if aUseBest then begin - - {calculate the number of bits required for the compressed data - using dynamic huffman trees} - BitCount := CalcDynamicBitCount(aUseDeflate64, - aStream.LitBuckets, - aStream.DistBuckets, - CodeLenStream.Buckets, - CodeLens, - CLCodeLens, - LitCodeCount, - DistCodeCount, - LenCodeCount); - - {choose the algorithm with the smallest size} - StaticSize := aStream.StaticSize; - StoredSize := (aStream.StoredSize + 4) * 8; - if (StaticSize < BitCount) then begin - if (StoredSize < StaticSize) then - EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm, - (StoredSize div 8) - 4, aLog) - else - EncodeLZStreamStatic(aFinalBlock, aUseDeflate64, - aStream, aBitStrm, aLog); - Exit; - end - else if (StoredSize < BitCount) then begin - EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm, - (StoredSize div 8) - 4, aLog); - Exit; - end; - end; - - {create the code lengths tree} - CodeLenTree := TAbDfDecodeHuffmanTree.Create(19, 7, huEncoding); - CodeLenTree.Build(CLCodeLens, 0, 19, [0], $FFFF); - - {$IFDEF UseLogging} - {log the tree} - if (aLog <> nil) then begin - aLog.WriteLine('Code lengths tree'); - CodeLenTree.DebugPrint(aLog); - end; - {$ENDIF} - - {calculate the literal encoding tree} - LitTree := TAbDfDecodeHuffmanTree.Create(286, 15, huEncoding); - LitTree.Build(CodeLens, 0, LitCodeCount, - dfc_LitExtraBits, dfc_LitExtraOffset); - - {$IFDEF UseLogging} - {log the tree} - if (aLog <> nil) then begin - aLog.WriteLine('Literal/length tree'); - LitTree.DebugPrint(aLog); - end; - {$ENDIF} - - {calculate the distance tree} - if aUseDeflate64 then - DistTree := TAbDfDecodeHuffmanTree.Create(32, 15, huEncoding) - else - DistTree := TAbDfDecodeHuffmanTree.Create(30, 15, huEncoding); - DistTree.Build(CodeLens, LitCodeCount, DistCodeCount, - dfc_DistExtraBits, dfc_DistExtraOffset); - - {$IFDEF UseLogging} - if (aLog <> nil) then begin - {log the tree} - aLog.WriteLine('Distance tree'); - DistTree.DebugPrint(aLog); - - {log the new block} - aLog.WriteLine('..Writing new block...'); - aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)])); - aLog.WriteLine('..block type? 2'); - aLog.WriteLine(Format('Count of literals: %d', [LitCodeCount])); - aLog.WriteLine(Format('Count of distances: %d', [DistCodeCount])); - aLog.WriteLine(Format('Count of code lengths: %d', [LenCodeCount])); - end; - {$ENDIF} - - {output the block information to the bit stream} - if aFinalBlock then - Code := 1 + (2 shl 1) - else - Code := 0 + (2 shl 1); - aBitStrm.WriteBits(Code, 3); - - {output the various counts to the bit stream} - Code := (LitCodeCount - 257) + - ((DistCodeCount - 1) shl 5) + - ((LenCodeCount - 4) shl 10); - aBitStrm.WriteBits(Code, 14); - - {output the code length codelengths to the bit stream} - for i := 0 to pred(LenCodeCount) do - aBitStrm.WriteBits(CLCodeLens[dfc_CodeLengthIndex[i]], 3); - - {encode and write the codelength stream to the bit stream} - CodeLenStream.Encode(aBitStrm, CodeLenTree); - - {encode and write the LZ77 stream to the bit stream} - aStream.Encode(aBitStrm, LitTree, DistTree, aUseDeflate64); - - {output the end-of-block marker to the bit stream} - OutputEndOfBlock(aBitStrm, LitTree); - {$IFDEF UseLogging} - if (aLog <> nil) then - aLog.WriteLine('Char: end-of-block marker (#256)'); - {$ENDIF} - - finally - LitTree.Free; - DistTree.Free; - CodeLenTree.Free; - CodeLenStream.Free; - end; -end; -{====================================================================} - - -{===Single algorithm Static/Dynamic Huffman tree deflate=============} -function DeflateStaticDynamic(aStatic : boolean; - aUseBest: boolean; - aSource : TStream; aDest : TStream; - aHelper : TAbDeflateHelper; - aLog : TAbLogger) : longint; -var - i : integer; - SlideWin : TAbDfInputWindow; - BitStrm : TAbDfOutBitStream; - LZ77Stream : TAbDfLZStream; - KeyLen : integer; - Match : TAbDfMatch; - PrevMatch : TAbDfMatch; - UseDeflate64 : boolean; - UseCRC32 : boolean; - GotMatch : boolean; - LZStrmIsFull : boolean; - TestForBinary: boolean; -begin - {note: turn on the following define to see when and how the lazy - matching algorithm works} - {$IFDEF UseLogging} - {$DEFINE UseLazyMatchLogging} - {$ENDIF} - - {$IFDEF UseLogging} - if (aLog <> nil) then - if aStatic then - aLog.WriteLine('..compressing source data with static huffman trees') - else - aLog.WriteLine('..compressing source data with dynamic huffman trees'); - {$ENDIF} - - {prepare for the try..finally} - SlideWin := nil; - BitStrm := nil; - LZ77Stream := nil; - try - - {create the sliding window} - UseDeflate64 := (aHelper.Options and dfc_UseDeflate64) <> 0; - UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0; - SlideWin := TAbDfInputWindow.Create(aSource, - aHelper.StreamSize, - aHelper.WindowSize, - aHelper.ChainLength, - UseDeflate64, UseCRC32); - SlideWin.OnProgress := aHelper.OnProgressStep; - - {create the bit stream} - BitStrm := TAbDfOutBitStream.Create(aDest); - - {create the LZ77 stream} - LZ77Stream := TAbDfLZStream.Create(SlideWin, UseDeflate64, aLog); - LZStrmIsFull := false; - TestForBinary := true; - - {set the previous match to be a literal character: this will - ensure that no lazy matching goes on with the first key read} - PrevMatch.maLen := 0; - - {get the first key length} - KeyLen := SlideWin.GetNextKeyLength; - - {while the current key is three characters long...} - while (KeyLen = 3) do begin - - {tweak for binary/text} - {note: the test for whether a stream is binary or not is to - check whether there are any #0 characters in the first - 1024 bytes: if there are the stream is binary. - this test and tweaking is based on experimentation - compression ratios for binary and text files based on the - PKZIP 'n' option.} - if TestForBinary and (LZ77Stream.StoredSize = 1024) then begin - if (aHelper.PKZipOption = 'n') then - if (LZ77Stream.LitBuckets^[0] = 0) then begin - aHelper.AmpleLength := aHelper.AmpleLength * 2; - aHelper.MaxLazyLength := aHelper.MaxLazyLength * 2; - aHelper.ChainLength := aHelper.ChainLength * 2; - SlideWin.ChainLen := aHelper.ChainLength; - end; - TestForBinary := false; - end; - - {if the LZ77 stream is full, empty it} - if LZStrmIsFull then begin - if aStatic then - EncodeLZStreamStatic(false, UseDeflate64, - LZ77Stream, BitStrm, aLog) - else - EncodeLZStreamDynamic(false, UseDeflate64, aUseBest, - LZ77Stream, BitStrm, aLog); - LZ77Stream.Clear; - LZStrmIsFull := false; - end; - - {try and find a match of three or more characters (note: this - has the side effect of adding the current key to the internal - hash table); this routine will only return true if it finds a - match greater than the previous match} - GotMatch := SlideWin.FindLongestMatch(aHelper.AmpleLength, - Match, PrevMatch); - - {if the maximum match length were three and the distance exceeds - 4096 bytes, it's most likely that we'll get better compression - by outputting the three literal bytes rather than by outputting - a length symbol, a distance symbol, and at least ten extra - bits for the extra distance value} - if (Match.maLen = 3) and (Match.maDist > 4096) then - GotMatch := false; - - {if we found a match...} - if GotMatch then begin - - {if there were no previous match, we can't do any lazy match - processing now, so save the current match details ready for - lazy matching the next time through, and advance the sliding - window} - if (PrevMatch.maLen = 0) then begin - PrevMatch.maLen := Match.maLen; - PrevMatch.maDist := Match.maDist; - PrevMatch.maLit := Match.maLit; - SlideWin.AdvanceByOne; - end - - {otherwise the previous match is smaller than this one, so - we're going to accept this match in preference; throw away - the previous match, output the previous literal character - instead and save these match details} - else begin - {$IFDEF UseLazyMatchLogging} - if (aLog <> nil) then - aLog.WriteLine( - Format( - '..this match longer, rejecting previous one (%d,%d)', - [PrevMatch.maLen, PrevMatch.maDist])); - {$ENDIF} - LZStrmIsFull := LZ77Stream.AddLiteral(PrevMatch.maLit); - PrevMatch.maLen := Match.maLen; - PrevMatch.maDist := Match.maDist; - PrevMatch.maLit := Match.maLit; - SlideWin.AdvanceByOne; - end; - - {if, by this point, we're storing up a match, check to see - if it equals or exceeds the maximum lazy match length; if - it does then output the match right now and avoid checking - for a lazy match} - if (PrevMatch.maLen >= aHelper.MaxLazyLength) then begin - {$IFDEF UseLazyMatchLogging} - if (aLog <> nil) then - if ((aHelper.Options and dfc_UseLazyMatch) <> 0) then - aLog.WriteLine('..match longer than max lazy match, using it'); - {$ENDIF} - LZStrmIsFull := - LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist); - SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 1); - PrevMatch.maLen := 0; - end; - end - - {otherwise, we don't have a match at all: so we possibly just - need to output a literal character} - else begin - {if there was a previous match, output it and discard the - results of this match} - if (PrevMatch.maLen <> 0) then begin - LZStrmIsFull := - LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist); - SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 2); - PrevMatch.maLen := 0; - end - - {otherwise there was no previous match or it's already been - output, so output this literal} - else begin - LZStrmIsFull := LZ77Stream.AddLiteral(Match.maLit); - SlideWin.AdvanceByOne; - PrevMatch.maLen := 0; - end; - end; - - {get the next key} - KeyLen := SlideWin.GetNextKeyLength; - end; - - {if the last key read were one or two characters in length, save - them as literal character encodings} - if (KeyLen > 0) then begin - {if there's a match pending, it'll be of length 3: output it} - if (PrevMatch.maLen <> 0) then begin - Assert(PrevMatch.maLen = 3, - 'DeflateStaticDynamic: previous match should be length 3'); - LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist); - end - {otherwise, output the one or two final literals} - else - for i := 1 to KeyLen do - LZ77Stream.AddLiteral(SlideWin.GetNextChar); - end; - - {empty the LZ77 stream} - if aStatic then - EncodeLZStreamStatic(true, UseDeflate64, - LZ77Stream, BitStrm, aLog) - else - EncodeLZStreamDynamic(true, UseDeflate64, aUseBest, - LZ77Stream, BitStrm, aLog); - - {calculate the checksum of the input stream} - Result := SlideWin.Checksum; - finally - {free the objects} - SlideWin.Free; - BitStrm.Free; - LZ77Stream.Free; - end;{try..finally} - - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then - aLog.WriteLine(Format('..checksum: %8x', [Result])) - {$ENDIF} -end; -{====================================================================} - - -{===Simple storing===================================================} -function DeflateStored(aSource : TStream; aDest : TStream; - aHelper : TAbDeflateHelper; - aLog : TAbLogger) : longint; -const - StoredBlockSize = $FFFF; -var - Buffer : PAnsiChar; - BytesRead : LongWord; - ByteCount : Int64; - BytesToGo : Int64; - CurPos : Int64; - Size : Int64; - Percent : longint; - CheckSum : longint; - UseCRC32 : boolean; - BlockHeader : packed record - bhInfo : byte; - bhSize : word; - bhNotSize : word; - end; -begin - {note: this routine merely stores the aSource stream data, no - compression is attempted or done} - {$IFDEF UseLogging} - if (aLog <> nil) then - aLog.WriteLine('..storing source data to destination, no compression'); - {$ENDIF} - - {initialize} - ByteCount := 0; - UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0; - if UseCRC32 then - Checksum := -1 { CRC32 starts off with all bits set} - else - CheckSum := 1; { Adler32 starts off with a value of 1} - if (aHelper.StreamSize > 0) then - BytesToGo := aHelper.StreamSize - else begin - CurPos := aSource.Seek(0, soCurrent); - Size := aSource.Seek(0, soEnd); - aSource.Seek(CurPos, soBeginning); - BytesToGo := Size - CurPos; - end; - - {get a buffer} - GetMem(Buffer, StoredBlockSize); - try - - {while there is still data to be stored...} - while (BytesToGo <> 0) do begin - - {read the next block} - BytesRead := aSource.Read(Buffer^, StoredBlockSize); - - {fire the progress event} - if Assigned(aHelper.OnProgressStep) then begin - inc(ByteCount, BytesRead); - Percent := Round((100.0 * ByteCount) / aHelper.StreamSize); - aHelper.OnProgressStep(Percent); - end; - - {update the checksum} - if UseCRC32 then - AbUpdateCRCBuffer(Checksum, Buffer^, BytesRead) - else - AbUpdateAdlerBuffer(Checksum, Buffer^, BytesRead); - - {write the block header} - if (BytesRead = BytesToGo) then - BlockHeader.bhInfo := 1 {ie, final block, stored} - else - BlockHeader.bhInfo := 0; {ie, not final block, stored} - BlockHeader.bhSize := BytesRead; - BlockHeader.bhNotSize := not BlockHeader.bhSize; - aDest.WriteBuffer(BlockHeader, sizeof(BlockHeader)); - - {write the block of data} - aDest.WriteBuffer(Buffer^, BytesRead); - - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then begin - if (BlockHeader.bhInfo = 0) then - aLog.WriteLine(Format('..block size: %d', [BytesRead])) - else - aLog.WriteLine(Format('..block size: %d (final block)', - [BytesRead])); - end; - {$ENDIF} - - {decrement the number of bytes to go} - dec(BytesToGo, BytesRead); - end; - finally - FreeMem(Buffer); - end; - - {return the checksum} - {note: the CRC32 checksum algorithm requires a post-conditioning - step after being calculated (the result is NOTted), whereas - Adler32 does not} - if UseCRC32 then - Result := not Checksum - else - Result := Checksum; - - {$IFDEF UseLogging} - {log it} - if (aLog <> nil) then - aLog.WriteLine(Format('..checksum: %8x', [Result])) - {$ENDIF} -end; -{====================================================================} - - -{===Interfaced routine===============================================} -function Deflate(aSource : TStream; aDest : TStream; - aHelper : TAbDeflateHelper) : longint; -var - Helper : TAbDeflateHelper; - Log : TAbLogger; - SourceStartPos : longint; - DestStartPos : longint; -begin - {pre-conditions: streams are allocated, - options enable some kind of archiving} - Assert(aSource <> nil, 'Deflate: aSource stream cannot be nil'); - Assert(aDest <> nil, 'Deflate: aDest stream cannot be nil'); - Assert((aHelper = nil) or ((aHelper.Options and $07) <> 0), - 'Deflate: aHelper.Options must enable some kind of archiving'); - - {$IFDEF DefeatWarnings} - Result := 0; - {$ENDIF} - - {prepare for the try..finally} - Helper := nil; - Log := nil; - - try {finally} - try {except} - {create our helper; assign the passed one to it} - Helper := TAbDeflateHelper.Create; - if (aHelper <> nil) then - Helper.Assign(aHelper); - - {save the current positions of both streams} - SourceStartPos := aSource.Position; - DestStartPos := aDest.Position; - - {if the helper's stream size is -1, and it has a progress event - handler, calculate the stream size from the stream itself} - if Assigned(Helper.OnProgressStep) then begin - if (Helper.StreamSize = -1) then - Helper.StreamSize := aSource.Size; - end - - {otherwise we certainly can't do any progress reporting} - else begin - Helper.OnProgressStep := nil; - Helper.StreamSize := 0; - end; - - {if lazy matching is not requested, ensure the maximum lazy - match length is zero: this make the LZ77 code a little easier - to understand} - if ((Helper.Options and dfc_UseLazyMatch) = 0) then - Helper.MaxLazyLength := 0; - - {patch up the various lengths in the helper if they specify the - maximum (that is, are equal to -1)} - if (Helper.AmpleLength = -1) then - Helper.AmpleLength := MaxLongInt; - if (Helper.MaxLazyLength = -1) then - Helper.MaxLazyLength := MaxLongInt; - if (Helper.ChainLength = -1) then - Helper.ChainLength := MaxLongInt; - - {create the logger, if requested} - if (Helper.LogFile <> '') then begin - Log := TAbLogger.Create(Helper.LogFile); - Log.WriteLine('DEFLATING STREAM...'); - {$IFNDEF UseLogging} - Log.WriteLine('Need to recompile the app with UseLogging turned on'); - {$ENDIF} - end; - - {use the helper's options property to decide what to do} - case (Helper.Options and $07) of - dfc_CanUseStored : - Result := DeflateStored(aSource, aDest, Helper, Log); - dfc_CanUseStatic : - Result := DeflateStaticDynamic(true, false, aSource, aDest, Helper, Log); - dfc_CanUseDynamic : - Result := DeflateStaticDynamic(false, false, aSource, aDest, Helper, Log); - else - Result := DeflateStaticDynamic(false, true, aSource, aDest, Helper, Log); - end; - - {save the uncompressed and compressed sizes} - if (aHelper <> nil) then begin - aHelper.NormalSize := aSource.Position - SourceStartPos; - aHelper.CompressedSize := aDest.Position - DestStartPos; - end; - except - on E : EAbInternalDeflateError do begin - {$IFDEF UseLogging} - if (Log <> nil) then - Log.WriteLine(Format('Internal exception raised: %s', - [E.Message])); - {$ENDIF} - raise EAbDeflateError.Create(E.Message); - end; - end; - finally - Helper.Free; - Log.Free; - end; - {WARNING NOTE: the compiler will warn that the return value of this - function might be undefined. However, it is wrong: it - has been fooled by the code. If you don't want to see - this warning again, enable the DefeatWarnings - compiler define in AbDefine.inc.} -end; -{====================================================================} - -end. - diff --git a/components/Abbrevia/source/AbDfHufD.pas b/components/Abbrevia/source/AbDfHufD.pas deleted file mode 100644 index f4642d8..0000000 --- a/components/Abbrevia/source/AbDfHufD.pas +++ /dev/null @@ -1,530 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfHufD.pas *} -{*********************************************************} -{* Deflate Huffman tree for decoder *} -{*********************************************************} - -unit AbDfHufD; - -{$I AbDefine.inc} - -{Activate this compiler define and rebuild if you want the complete - huffman tree output to print to the current log. The output is - voluminous to say the least...} -{$IFDEF UseLogging} -{.$DEFINE EnableMegaLog} -{$ENDIF} - -{Notes: - -The object of this class is to build a decoder array, not to build a -Huffman tree particularly. We don't want to decode huffman strings bit -by bit. moving down the Huffman tree sometimes left, sometimes right. -Instead we want to grab a set of bits and look them up in an array. -Sometimes we'll grab too many bits, sure, but we can deal with that -later. So, the object of the exercise is to calculate the code for a -symbol, reverse it ('cos that's how the input bit stream will present -it to us) and set that element of the array to the decoded symbol -value (plus some extra information: bit lengths). - -If the alphabet size were 19 (the codelengths huffman tree) and the -maximum code length 5, for example, the decoder array would be 2^5 -elements long, much larger than the alphabet size. The user of this -class will be presenting sets of 5 bits for us to decode. We would -like to look up these 5 bits in the array (as an index) and have the -symbol returned. Now, since the alphabet size is much less than the -number of elements in the decoder array, we must set the other -elements in the array as well. Consider a symbol that has a code of -110 in this scenario. The reversed code is 011, or 3, so we'd be -setting element 3. However we should also be setting elements 01011, -10011, and 11011 to this symbol information as well, since the lookup -will be 5 bits long. - -Because the code is a huffman code from a prefix tree, we won't get -any index clashes between actual codes by this "filling in" process. - -For the codelength Huffman tree, the maximum code length is at most 7. -This equates to a 128 element array. For the literal and distance -trees, the max code length is at most 15. This equates to a 32768 -element array. - -For a given lookup value the decoder will return a 32-bit value. The -lower 16 bits is the decoded symbol, the next 8 bits is the code -length for that symbol, the last 8 bits (the most significant) are the -number of extra bits that must be extracted from the input bit stream. -} - -interface - -uses - AbDfBase; - -type - TAbDfHuffmanUsage = ( {usage of a huffman decoder..} - huEncoding, {..encoding} - huDecoding, {..decoding} - huBoth); {..both (used for static trees)} - - TAbDfDecodeHuffmanTree = class - private - FAlphaSize : integer; - FDecodes : PAbDfLongintList; - FDefMaxCodeLen : integer; - FEncodes : PAbDfLongintList; - {$IFOPT C+} - FMask : integer; - {$ENDIF} - FMaxCodeLen : integer; - FUsage : TAbDfHuffmanUsage; - protected - public - constructor Create(aAlphabetSize : integer; - aDefMaxCodeLen: integer; - aUsage : TAbDfHuffmanUsage); - destructor Destroy; override; - - procedure Build(const aCodeLengths : array of integer; - aStartInx : integer; - aCount : integer; - const aExtraBits : array of byte; - aExtraOffset : integer); - function Decode(aLookupBits : integer) : longint; - function Encode(aSymbol : integer) : longint; - - {$IFDEF UseLogging} - procedure DebugPrint(aLog : TAbLogger); - {$ENDIF} - - property LookupBitLength : integer read FMaxCodeLen; - property Decodes : PAbDfLongintList read FDecodes; - property Encodes : PAbDfLongintList read FEncodes; - end; - -var - AbStaticLiteralTree : TAbDfDecodeHuffmanTree; - AbStaticDistanceTree : TAbDfDecodeHuffmanTree; - -implementation - -uses - SysUtils; - -const - PowerOfTwo : array [0..dfc_MaxCodeLength] of integer = - (1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, - 4096, 8192, 16384, 32768); - -{===Debug helper routine=============================================} -{$IFDEF EnableMegaLog} -function CodeToStr(aCode : longint; aLen : integer) : string; -var - i : integer; -begin - if (aLen = 0) then - Result := 'no code' - else begin - SetLength(Result, 32); - FillChar(Result[1], 32, ' '); - for i := 32 downto (33-aLen) do begin - if Odd(aCode) then - Result[i] := '1' - else - Result[i] := '0'; - aCode := aCode shr 1; - end; - end; -end; -{$ENDIF} -{====================================================================} - - -{===TAbDfDecodeHuffmanTree===========================================} -constructor TAbDfDecodeHuffmanTree.Create( - aAlphabetSize : integer; - aDefMaxCodeLen: integer; - aUsage : TAbDfHuffmanUsage); -begin - {protect against dumb programming mistakes} - Assert(aAlphabetSize >= 2, - 'TAbDfDecodeHuffmanTree.Create: a huffman tree must be for at least two symbols'); - - {let the ancestor initialize} - inherited Create; - - {save the alphabet size, etc} - FAlphaSize := aAlphabetSize; - FDefMaxCodeLen := aDefMaxCodeLen; - FUsage := aUsage; - - {allocate the encoder array (needs to be initialized to zeros)} - if (aUsage <> huDecoding) then - FEncodes := AllocMem(FAlphaSize * sizeof(longint)); -end; -{--------} -destructor TAbDfDecodeHuffmanTree.Destroy; -begin - {destroy the codes arrays} - if (FDecodes <> nil) then - FreeMem(FDecodes); - if (FEncodes <> nil) then - FreeMem(FEncodes); - - {let the ancestor die} - inherited Destroy; -end; -{--------} -procedure TAbDfDecodeHuffmanTree.Build( - const aCodeLengths : array of integer; - aStartInx : integer; - aCount : integer; - const aExtraBits : array of byte; - aExtraOffset : integer); -const - ByteRevTable : array [0..255] of byte = ( - $00, $80, $40, $C0, $20, $A0, $60, $E0, $10, $90, $50, $D0, - $30, $B0, $70, $F0, $08, $88, $48, $C8, $28, $A8, $68, $E8, - $18, $98, $58, $D8, $38, $B8, $78, $F8, $04, $84, $44, $C4, - $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4, - $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC, - $3C, $BC, $7C, $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2, - $12, $92, $52, $D2, $32, $B2, $72, $F2, $0A, $8A, $4A, $CA, - $2A, $AA, $6A, $EA, $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA, - $06, $86, $46, $C6, $26, $A6, $66, $E6, $16, $96, $56, $D6, - $36, $B6, $76, $F6, $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE, - $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81, $41, $C1, - $21, $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1, - $09, $89, $49, $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9, - $39, $B9, $79, $F9, $05, $85, $45, $C5, $25, $A5, $65, $E5, - $15, $95, $55, $D5, $35, $B5, $75, $F5, $0D, $8D, $4D, $CD, - $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD, - $03, $83, $43, $C3, $23, $A3, $63, $E3, $13, $93, $53, $D3, - $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB, - $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7, - $27, $A7, $67, $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7, - $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF, $1F, $9F, $5F, $DF, - $3F, $BF, $7F, $FF); -var - i : integer; - Symbol : integer; - LengthCount : array [0..dfc_MaxCodeLength] of integer; - NextCode : array [0..dfc_MaxCodeLength] of integer; - Code : longint; - CodeLen : integer; - CodeData : longint; - DecoderLen : integer; - CodeIncr : integer; - Decodes : PAbDfLongintList; - Encodes : PAbDfLongintList; - {$IFDEF CPU386} - DecodesEnd : pointer; - {$ENDIF} - TablePtr : pointer; -begin - {count the number of instances of each code length and calculate the - maximum code length at the same time} - FillChar(LengthCount, sizeof(LengthCount), 0); - FMaxCodeLen := 0; - for i := 0 to pred(aCount) do begin - CodeLen := aCodeLengths[i + aStartInx]; - Assert((CodeLen <= FDefMaxCodeLen), - Format('TAbDfDecodeHuffmanTree.Build: a code length is greater than %d', - [FDefMaxCodeLen])); - if (CodeLen > FMaxCodeLen) then - FMaxCodeLen := CodeLen; - inc(LengthCount[CodeLen]); - end; - - {now we know the maximum code length we can allocate our decoder - array} - {$IFNDEF CPU386} - DecoderLen := 0; - {$ENDIF} - if (FUsage <> huEncoding) then begin - DecoderLen := PowerOfTwo[FMaxCodeLen]; - GetMem(FDecodes, DecoderLen * sizeof(longint)); - {$IFDEF CPU386} - DecodesEnd := PAnsiChar(FDecodes) + (DecoderLen * sizeof(longint)); - {$ENDIF} - {$IFOPT C+} - FillChar(FDecodes^, DecoderLen * sizeof(longint), $FF); - FMask := not (DecoderLen - 1); - {$ENDIF} - end; - - {calculate the start codes for each code length} - Code := 0; - LengthCount[0] := 0; - for i := 1 to FDefMaxCodeLen do begin - Code := (Code + LengthCount[i-1]) shl 1; - NextCode[i] := Code; - end; - - {for speed and convenience} - Decodes := FDecodes; - Encodes := FEncodes; - TablePtr := @ByteRevTable; - - {for each symbol...} - for Symbol := 0 to pred(aCount) do begin - {calculate the code length} - CodeLen := aCodeLengths[Symbol + aStartInx]; - - {if the code length were zero, just set the relevant entry in the - encoder array; the decoder array doesn't need anything} - if (CodeLen = 0) then begin - if (FUsage <> huDecoding) then - Encodes^[Symbol] := -1 - end - - {otherwise we need to fill elements in both the encoder and - decoder arrays} - else begin - {calculate *reversed* code} - Code := NextCode[CodeLen]; - {$IFDEF CPU386} - asm - push esi - mov eax, Code - mov esi, TablePtr - xor ecx, ecx - xor edx, edx - mov cl, ah - mov dl, al - mov al, [esi+ecx] - mov ah, [esi+edx] - mov ecx, 16 - pop esi - sub ecx, CodeLen - shr eax, cl - mov Code, eax - end; - {$ELSE} - CodeData:= Code; - LongRec(Code).Bytes[1]:= ByteRevTable[LongRec(CodeData).Bytes[0]]; - LongRec(Code).Bytes[0]:= ByteRevTable[LongRec(CodeData).Bytes[1]]; - Code:= Code shr (16-CodeLen); - {$ENDIF} - - {set the code data (bit count, extra bits required, symbol), - everywhere the reversed code would appear in the decoder array; - set the code data in the encoder array as well} - if (Symbol >= aExtraOffset) then begin - if (FUsage <> huEncoding) then - CodeData := Symbol + { symbol} - (CodeLen shl 16) + { code length} - (aExtraBits[Symbol-aExtraOffset] shl 24); - { extra bits required} - if (FUsage <> huDecoding) then - Encodes^[Symbol] := Code + { code} - (CodeLen shl 16) + { code length} - (aExtraBits[Symbol-aExtraOffset] shl 24) - { extra bits required} - end - else begin - if (FUsage <> huEncoding) then - CodeData := Symbol + { symbol} - (CodeLen shl 16); { code length} - if (FUsage <> huDecoding) then - Encodes^[Symbol] := Code + { code} - (CodeLen shl 16); { code length} - end; - - {OPTIMIZATION NOTE: the following code - - CodeIncr := PowerOfTwo[CodeLen]; - while Code < DecoderLen do begin - Decodes^[Code] := CodeData; - inc(Code, CodeIncr); - end; - - was replaced by the asm code below to improve the speed. The - code in the loop is the big time sink in this routine so it was - best to replace it.} - if (FUsage <> huEncoding) then begin - {$IFDEF CPU386} - CodeIncr := PowerOfTwo[CodeLen] * sizeof(longint); - asm - push edi { save edi} - mov eax, Decodes { get the Decodes array} - mov edi, DecodesEnd { get the end of the Decodes array} - mov edx, Code { get Code and..} - shl edx, 1 { ..multiply by 4} - shl edx, 1 - add eax, edx { eax => first element to be set} - mov edx, CodeData { get the CodeData} - mov ecx, CodeIncr { get the increment per loop} - @@1: - mov [eax], edx { set the element} - add eax, ecx { move to the next element} - cmp eax, edi { if we haven't gone past the end..} - jl @@1 { ..go back for the next one} - pop edi { retrieve edi} - end; - {$ELSE} - CodeIncr := PowerOfTwo[CodeLen]; - while Code < DecoderLen do begin - Decodes^[Code] := CodeData; - inc(Code, CodeIncr); - end; - {$ENDIF} - end; - - {we've used this code up for this symbol, so increment for the - next symbol at this code length} - inc(NextCode[CodeLen]); - end; - end; -end; -{--------} -{$IFDEF UseLogging} -procedure TAbDfDecodeHuffmanTree.DebugPrint(aLog : TAbLogger); -{$IFDEF EnableMegaLog} -var - i : integer; - Code : longint; -{$ENDIF} -begin - {to print the huffman tree, we must have a logger...} - Assert(aLog <> nil, - 'TAbDfDecodeHuffmanTree.DebugPrint needs a logger object to which to print'); - - if (FUsage <> huEncoding) then begin - aLog.WriteLine('Huffman decoder array'); - aLog.WriteLine(Format('Alphabet size: %d', [FAlphaSize])); - aLog.WriteLine(Format('Max codelength: %d', [FMaxCodeLen])); - - {$IFDEF EnableMegaLog} - aLog.WriteLine('Index Len Xtra Symbol Reversed Code'); - for i := 0 to pred(PowerOfTwo[FMaxCodeLen]) do begin - Code := FDecodes^[i]; - if (Code = -1) then - aLog.WriteLine(Format('%5d%49s', [i, 'no code'])) - else - aLog.WriteLine(Format('%5d%4d%5d%7d%33s', - [i, - ((Code shr 16) and $FF), - ((Code shr 24) and $FF), - (Code and $FFFF), - CodeToStr(i, ((Code shr 16) and $FF))])); - end; - aLog.WriteLine('---end decoder array---'); - {$ENDIF} - end; - - if (FUsage <> huDecoding) then begin - aLog.WriteLine('Huffman encoder array'); - aLog.WriteLine(Format('Alphabet size: %d', [FAlphaSize])); - - {$IFDEF EnableMegaLog} - aLog.WriteLine('Symbol Len Xtra Reversed Code'); - for i := 0 to pred(FAlphaSize) do begin - Code := FEncodes^[i]; - if (Code = -1) then - aLog.WriteLine(Format('%6d%42s', [i, 'no code'])) - else - aLog.WriteLine(Format('%6d%4d%5d%33s', - [i, - ((Code shr 16) and $FF), - ((Code shr 24) and $FF), - CodeToStr((Code and $FFFF), ((Code shr 16) and $FF))])); - end; - aLog.WriteLine('---end encoder array---'); - {$ENDIF} - end; -end; -{$ENDIF} -{--------} -function TAbDfDecodeHuffmanTree.Decode(aLookupBits : integer) : longint; -begin - {protect against dumb programming mistakes (note: FMask only exists - if assertions are on)} - {$IFOPT C+} - Assert((aLookupBits and FMask) = 0, - 'TAbDfDecodeHuffmanTree.Decode: trying to decode too many bits, use LookupBitLength property'); - {$ENDIF} - - {return the code data} - Result := FDecodes^[aLookupBits]; -end; -{--------} -function TAbDfDecodeHuffmanTree.Encode(aSymbol : integer) : longint; -begin - {protect against dumb programming mistakes} - Assert((0 <= aSymbol) and (aSymbol < FAlphaSize), - 'TAbDfDecodeHuffmanTree.Encode: trying to encode a symbol that is not in the alphabet'); - - {return the code data} - Result := FEncodes^[aSymbol]; - - {if the result is -1, it's another programming mistake: the user is - attempting to get a code for a symbol that wasn't being used} - Assert(Result <> -1, - 'TAbDfDecodeHuffmanTree.Encode: trying to encode a symbol that was not used'); -end; -{====================================================================} - - -{===BuildStaticTrees=================================================} -procedure BuildStaticTrees; -var - i : integer; - CodeLens : array [0..287] of integer; -begin - {this routine builds the static huffman trees, those whose code - lengths are determined by the deflate spec} - - {the static literal tree first} - for i := 0 to 143 do - CodeLens[i] := 8; - for i := 144 to 255 do - CodeLens[i] := 9; - for i := 256 to 279 do - CodeLens[i] := 7; - for i := 280 to 287 do - CodeLens[i] := 8; - AbStaticLiteralTree := TAbDfDecodeHuffmanTree.Create(288, 15, huBoth); - AbStaticLiteralTree.Build(CodeLens, 0, 288, - dfc_LitExtraBits, dfc_LitExtraOffset); - - {the static distance tree afterwards} - for i := 0 to 31 do - CodeLens[i] := 5; - AbStaticDistanceTree := TAbDfDecodeHuffmanTree.Create(32, 15, huBoth); - AbStaticDistanceTree.Build(CodeLens, 0, 32, - dfc_DistExtraBits, dfc_DistExtraOffset); -end; -{====================================================================} - -initialization - BuildStaticTrees; - -finalization - AbStaticLiteralTree.Free; - AbStaticDistanceTree.Free; - -end. diff --git a/components/Abbrevia/source/AbDfInW.pas b/components/Abbrevia/source/AbDfInW.pas deleted file mode 100644 index 51e5168..0000000 --- a/components/Abbrevia/source/AbDfInW.pas +++ /dev/null @@ -1,764 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfInW.pas *} -{*********************************************************} -{* Deflate input sliding window unit *} -{*********************************************************} - -unit AbDfInW; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbDfBase; - -{Notes: TdfInputWindow implements a sliding window on data for the - LZ77 dictionary encoding. - - The stream passed to the class is automatically read when - required to keep the internal buffer fully loaded. - } - -type - TAbDfMatch = record - maLen : integer; - maDist : integer; - maLit : AnsiChar; - end; - -type - PAbPointerList = ^TAbPointerList; - TAbPointerList = array[0..MaxInt div SizeOf(Pointer) - 1] of Pointer; - - TAbDfInputWindow = class - private - FAdvanceStart : boolean; - FBuffer : PAnsiChar; - FBufferEnd : PAnsiChar; - FBytesUsed : longint; - FChainLen : integer; - FHashChains : PAbPointerList; - FHashHeads : PAbPointerList; - FHashIndex : integer; - FChecksum : longint; - FCurrent : PAnsiChar; - FLookAheadEnd : PAnsiChar; - FMaxMatchLen : integer; - FMustSlide : boolean; - FOnProgress : TAbProgressStep; - FSlidePoint : PAnsiChar; - FStart : PAnsiChar; - FStartOffset : longint; - FStream : TStream; - FStreamSize : Int64; - FUseCRC32 : boolean; - FUseDeflate64 : boolean; - FWinMask : integer; - FWinSize : integer; - protected - function iwGetChecksum : longint; - procedure iwReadFromStream; - procedure iwSetCapacity(aValue : longint); - procedure iwSlide; - public - constructor Create(aStream : TStream; - aStreamSize : Int64; - aWinSize : integer; - aChainLength : integer; - aUseDeflate64 : boolean; - aUseCRC32 : boolean); - destructor Destroy; override; - - procedure Advance(aCount : integer; - aHashCount : integer); - procedure AdvanceByOne; - function FindLongestMatch(aAmpleLength : integer; - var aMatch : TAbDfMatch; - const aPrevMatch : TAbDfMatch) : boolean; - function GetNextChar : AnsiChar; - function GetNextKeyLength : integer; - function Position : longint; - procedure ReadBuffer(var aBuffer; aCount : longint; - aOffset : Int64); - - property ChainLen : integer read FChainLen write FChainLen; - property Checksum : longint read iwGetChecksum; - property OnProgress : TAbProgressStep - read FOnProgress write FOnProgress; - end; - -implementation - -uses - SysUtils; - -{Notes: - Meaning of the internal pointers: - - |----------+===================+==+--------------------------| - | | | | | - FBuffer FStart FCurrent FLookAheadEnd FBufferEnd - - FCurrent is the current match position. The valid data that - can be matched is between FStart and FLookAheadEnd, The data - between FStart and FCurrent has already been seen; the data - between FCurrent and FLookAheadEnd can be used for matching. - - The buffer size depends on the requested window size (a - multiple of 1KB, up to 32KB for deflate, up to 64KB for - deflate64) and the lookahead size (up to 258 bytes for deflate - and 64KB for deflate64.) - - The window of data continuously slides to the right, and is - slid back to FBuffer whenever FStart reaches a point 16KB - away, this point being given by FSlidePoint. - - - The hash table: - This is a chained hash table with some peculiarities. First - the table itself, FHashHeads. It contains pointers to strings - in the window buffer, not to chains. The chains are held is a - separate structure, FHashChains. The hash function on the - three-character keys is a Rabin-Karp function: - ((((Ch1 shl 5) xor Ch2) shl 5) xor Ch3) and $3FFF - designed so that a running hash value can be kept and - calculated per character. The hash table is $4000 elements - long (obviously, given the hash function). - On insertion, the previous pointer in the hash table at the - calculated index is saved and replaced by the new pointer. The - old pointer is saved in the chains array. This has the same - number of elements as the sliding window has characters. The - pointer is placed at (Ptr and (WindowsSize-1)) overwriting the - value that's already there. In this fashion the individual - chains in the standard hash table are interwoven with each - other in this hash table, like a skein of threads. - } - -const - c_HashCount = $4000; {the number of hash entries} - c_HashMask = c_HashCount - 1; {a mask for the hash function} - c_HashShift = 5; {shift value for the hash function} - -{===TAbDfInputWindow=================================================} -constructor TAbDfInputWindow.Create(aStream : TStream; - aStreamSize : Int64; - aWinSize : integer; - aChainLength : integer; - aUseDeflate64 : boolean; - aUseCRC32 : boolean); -begin - {create the ancestor} - inherited Create; - - {save parameters} - FStreamSize := aStreamSize; - FWinSize := aWinSize; - FWinMask := aWinSize - 1; - FStream := aStream; - FChainLen := aChainLength; - FUseDeflate64 := aUseDeflate64; - FUseCRC32 := aUseCRC32; - if aUseCRC32 then - FChecksum := -1 { CRC32 starts off with all bits set } - else - FCheckSum := 1; { Adler32 starts off with a value of 1 } - - {set capacity of sliding window} - iwSetCapacity(aWinSize); - - {create the hash table, first the hash table itself (and set all - entries to nil)} - FHashHeads := AllocMem(c_HashCount * sizeof(pointer)); - - {..now the chains (there's no need to set the entries to nil, since - the chain entries get fed from the head entries before searching)} - GetMem(FHashChains, aWinSize * sizeof(pointer)); - - {read the first chunk of data from the stream} - FMustSlide := true; - iwReadFromStream; - - {if there are at least two bytes, prime the hash index} - if ((FLookAheadEnd - FBuffer) >= 2) then - FHashIndex := ((longint(FBuffer[0]) shl c_HashShift) xor - longint(FBuffer[1])) and - c_HashMask; -end; -{--------} -destructor TAbDfInputWindow.Destroy; -begin - {free the hash table} - FreeMem(FHashHeads); - FreeMem(FHashChains); - - {free the buffer} - FreeMem(FBuffer); - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -procedure TAbDfInputWindow.Advance(aCount : integer; - aHashCount : integer); -var - i : integer; - ByteCount : integer; - Percent : integer; - HashChains: PAbPointerList; - HashHeads : PAbPointerList; - HashInx : integer; - CurPos : PAnsiChar; -begin - Assert((FLookAheadEnd - FCurrent) >= aCount, - 'TAbDfInputWindow.Advance: seem to be advancing into the unknown'); - Assert((aHashCount = aCount) or (aHashCount = pred(aCount)), - 'TAbDfInputWindow.Advance: the parameters are plain wrong'); - {use local var for speed} - CurPos := FCurrent; - - {advance the current pointer if needed} - if (aCount > aHashCount) then - inc(CurPos); - - {make sure we update the hash table; remember that the string[3] at - the current position has already been added to the hash table (for - notes on updating the hash table, see FindLongestMatch} - - {use local vars for speed} - HashChains := FHashChains; - HashHeads := FHashHeads; - HashInx := FHashIndex; - - {update the hash table} - for i := 0 to pred(aHashCount) do begin - HashInx := - ((HashInx shl c_HashShift) xor longint(CurPos[2])) and - c_HashMask; - HashChains^[longint(CurPos) and FWinMask] := - HashHeads^[HashInx]; - HashHeads^[HashInx] := CurPos; - inc(CurPos); - end; - - {replace old values} - FHashChains := HashChains; - FHashHeads := HashHeads; - FHashIndex := HashInx; - FCurrent := CurPos; - - {if we've seen at least FWinSize bytes...} - if FAdvanceStart then begin - - {advance the start of the sliding window} - inc(FStart, aCount); - inc(FStartOffset, aCount); - - {check to see if we have advanced into the slide zone} - if FMustSlide and (FStart >= FSlidePoint) then - iwSlide; - end - - {otherwise check to see if we've seen at least FWinSize bytes} - else if ((CurPos - FStart) >= FWinSize) then begin - FAdvanceStart := true; - {note: we can't advance automatically aCount bytes here, we need - to calculate the actual count} - ByteCount := (CurPos - FWinSize) - FStart; - inc(FStart, ByteCount); - inc(FStartOffset, ByteCount); - end; - - {show progress} - if Assigned(FOnProgress) then begin - inc(FBytesUsed, aCount); - if ((FBytesUsed and $FFF) = 0) then begin - Percent := Round((100.0 * FBytesUsed) / FStreamSize); - FOnProgress(Percent); - end; - end; - - {check to see if we have advanced into the slide zone} - if (FStart >= FSlidePoint) then - iwSlide; -end; -{--------} -procedure TAbDfInputWindow.AdvanceByOne; -var - Percent : integer; -begin - {advance the current pointer} - inc(FCurrent); - - {if we've seen at least FWinSize bytes...} - if FAdvanceStart then begin - - {advance the start of the sliding window} - inc(FStart, 1); - inc(FStartOffset, 1); - - {check to see if we have advanced into the slide zone} - if FMustSlide and (FStart >= FSlidePoint) then - iwSlide; - end - - {otherwise check to see if we've seen FWinSize bytes} - else if ((FCurrent - FStart) = FWinSize) then - FAdvanceStart := true; - - {show progress} - if Assigned(FOnProgress) then begin - inc(FBytesUsed, 1); - if ((FBytesUsed and $FFF) = 0) then begin - Percent := Round((100.0 * FBytesUsed) / FStreamSize); - FOnProgress(Percent); - end; - end; -end; -{--------} -function TAbDfInputWindow.FindLongestMatch(aAmpleLength : integer; - var aMatch : TAbDfMatch; - const aPrevMatch : TAbDfMatch) - : boolean; -{Note: this routine implements a greedy algorithm and is by far the - time sink for compression. There are two versions, one written - in Pascal for understanding, one in assembler for speed. - Activate one and only one of the following compiler defines.} -{$IFDEF CPU386} - {$DEFINE UseGreedyAsm} -{$ELSE} - {$DEFINE UseGreedyPascal} -{$ENDIF} - -{Check to see that all is correct} -{$IFDEF UseGreedyAsm} - {$IFDEF UseGreedyPascal} - !! Compile Error: only one of the greedy compiler defines can be used - {$ENDIF} -{$ELSE} - {$IFNDEF UseGreedyPascal} - !! Compile Error: one of the greedy compiler defines must be used - {$ENDIF} -{$ENDIF} -type - PLongint = ^longint; - PWord = ^word; -var - MaxLen : longint; - MaxDist : longint; - MaxMatch : integer; - ChainLen : integer; - PrevStrPos : PAnsiChar; - CurPos : PAnsiChar; - {$IFDEF UseGreedyAsm} - CurWord : word; - MaxWord : word; - {$ENDIF} - {$IFDEF UseGreedyPascal} - Len : longint; - MatchStr : PAnsiChar; - CurrentCh : PAnsiChar; - CurCh : AnsiChar; - MaxCh : AnsiChar; - {$ENDIF} -begin - {calculate the hash index for the current position; using the - Rabin-Karp algorithm this is equal to the previous index less the - effect of the character just lost plus the effect of the character - just gained} - CurPos := FCurrent; - FHashIndex := - ((FHashIndex shl c_HashShift) xor longint(CurPos[2])) and - c_HashMask; - - {get the head of the hash chain: this is the position in the sliding - window of the previous 3-character string with this hash value} - PrevStrPos := FHashHeads^[FHashIndex]; - - {set the head of the hash chain equal to our current position} - FHashHeads^[FHashIndex] := CurPos; - - {update the chain itself: set the entry for this position equal to - the previous string position} - FHashChains^[longint(CurPos) and FWinMask] := PrevStrPos; - - {calculate the maximum match we could do at this position} - MaxMatch := (FLookAheadEnd - CurPos); - if (MaxMatch > FMaxMatchLen) then - MaxMatch := FMaxMatchLen; - if (aAmpleLength > MaxMatch) then - aAmpleLength := MaxMatch; - - {calculate the current match length} - if (aPrevMatch.maLen = 0) then - MaxLen := 2 - else begin - if (MaxMatch < aPrevMatch.maLen) then begin - Result := false; - aMatch.maLen := 0; - aMatch.maLit := CurPos^; - Exit; - end; - MaxLen := aPrevMatch.maLen; - end; - - {get the bytes at the current position and at the end of the maximum - match we have to better} - {$IFDEF UseGreedyAsm} - CurWord := PWord(CurPos)^; - MaxWord := PWord(CurPos + pred(MaxLen))^; - {$ENDIF} - {$IFDEF UseGreedyPascal} - CurCh := CurPos^; - MaxCh := (CurPos + pred(MaxLen))^; - {$ENDIF} - - {set the chain length to search based on the current maximum match - (basically: if we've already satisfied the ample length - requirement, don't search as far)} - if (MaxLen >= aAmpleLength) then - ChainLen := FChainLen div 4 - else - ChainLen := FChainLen; - - {get ready for the loop} - {$IFDEF DefeatWarnings} - MaxDist := 0; - {$ENDIF} - - {$IFDEF UseGreedyAsm} { slip into assembler for speed...} - asm - push ebx { save those registers we should} - push esi - push edi - - mov ebx, Self { ebx will store the Self pointer} - mov edi, PrevStrPos { edi => previous string} - mov esi, CurPos { esi => current string} - - @@TestThisPosition: - { check previous string is in range} - or edi, edi - je @@Exit - cmp edi, [ebx].TAbDfInputWindow.FStart - jb @@Exit - cmp edi, CurPos - jae @@Exit - - mov ax, [edi] { check previous string starts with same} - cmp CurWord, ax { two bytes as current} - jne @@GetNextPosition { ..nope, they don't match} - - mov edx, edi { check previous string ends with same} - add edi, MaxLen { two bytes as current (by "ends" we} - dec edi { mean the last two bytes at the} - mov ax, [edi] { current match length)} - cmp MaxWord, ax - mov edi, edx - jne @@GetNextPosition { ..nope, they don't match} - - push edi { compare the previous string with the} - push esi { current string} - mov eax, MaxMatch - add edi, 2 { (we've already checked that the first} - sub eax, 2 { two characters are the same)} - add esi, 2 - mov ecx, eax - - @@CmpQuads: - cmp ecx, 4 - jb @@CmpSingles - - mov edx, [esi] - cmp edx, [edi] - jne @@CmpSingles - - add esi, 4 - add edi, 4 - sub ecx, 4 - jnz @@CmpQuads - - jmp @@MatchCheck - - @@CmpSingles: - or ecx, ecx - jb @@MatchCheck - - mov dl, [esi] - cmp dl, [edi] - jne @@MatchCheck - - inc esi - inc edi - dec ecx - jnz @@CmpSingles - - @@MatchCheck: - sub eax, ecx - add eax, 2 - pop esi - pop edi - - cmp eax, MaxLen { have we found a longer match?} - jbe @@GetNextPosition { ..no} - mov MaxLen, eax { ..yes, so save it} - - mov eax, esi { calculate the dist for this new match} - sub eax, edi - mov MaxDist, eax - - cmp eax, aAmpleLength { if this match is ample enough, exit} - jae @@Exit - - mov eax, esi { calculate the two bytes at the end of} - add eax, MaxLen { this new match} - dec eax - mov ax, [eax] - mov MaxWord, ax - - @@GetNextPosition: - mov eax, ChainLen { we've visited one more link on the} - dec eax { chain, if that's the last one we} - je @@Exit { should visit, exit} - mov ChainLen, eax - - { advance along the chain} - mov edx, [ebx].TAbDfInputWindow.FHashChains - mov eax, [ebx].TAbDfInputWindow.FWinMask - and edi, eax - shl edi, 2 - mov edi, [edx+edi] - jmp @@TestThisPosition - - @@Exit: - pop edi - pop esi - pop ebx - end; - {$ENDIF} - - {$IFDEF UseGreedyPascal} - {for all possible hash nodes in the chain...} - while (FStart <= PrevStrPos) and (PrevStrPos < CurPos) do begin - - {if the initial and maximal characters match...} - if (PrevStrPos[0] = CurCh) and - (PrevStrPos[pred(MaxLen)] = MaxCh) then begin - - {compare more characters} - Len := 1; - CurrentCh := CurPos + 1; - MatchStr := PrevStrPos + 1; - - {compare away, but don't go above the maximum length} - while (Len < MaxMatch) and (MatchStr^ = CurrentCh^) do begin - inc(CurrentCh); - inc(MatchStr); - inc(Len); - end; - - {have we reached another maximum for the length?} - if (Len > MaxLen) then begin - MaxLen := Len; - {calculate the distance} - MaxDist := CurPos - PrevStrPos; - MaxCh := CurPos[pred(MaxLen)]; - - {is the new best length ample enough?} - if MaxLen >= aAmpleLength then - Break; - end; - end; - - {have we reached the end of this chain?} - dec(ChainLen); - if (ChainLen = 0) then - Break; - - {otherwise move onto the next position} - PrevStrPos := FHashChains^[longint(PrevStrPos) and FWinMask]; - end; - {$ENDIF} - - {based on the results of our investigation, return the match values} - if (MaxLen < 3) or (MaxLen <= aPrevMatch.maLen) then begin - Result := false; - aMatch.maLen := 0; - aMatch.maLit := CurPos^; - end - else begin - Result := true; - aMatch.maLen := MaxLen; - aMatch.maDist := MaxDist; - aMatch.maLit := CurPos^; { just in case...} - end; -end; -{--------} -function TAbDfInputWindow.GetNextChar : AnsiChar; -begin - Result := FCurrent^; - inc(FCurrent); -end; -{--------} -function TAbDfInputWindow.GetNextKeyLength : integer; -begin - Result := FLookAheadEnd - FCurrent; - if (Result > 3) then - Result := 3; -end; -{--------} -function TAbDfInputWindow.iwGetChecksum : longint; -begin - {the CRC32 checksum algorithm requires a post-conditioning step - after being calculated (the result is NOTted), whereas Adler32 does - not} - if FUseCRC32 then - Result := not FChecksum - else - Result := FChecksum; -end; -{--------} -procedure TAbDfInputWindow.iwReadFromStream; -var - BytesRead : longint; - BytesToRead : longint; -begin - {read some more data into the look ahead zone} - BytesToRead := FBufferEnd - FLookAheadEnd; - BytesRead := FStream.Read(FLookAheadEnd^, BytesToRead); - - {if nothing was read, we reached the end of the stream; hence - there's no more need to slide the window since we have all the - data} - if (BytesRead = 0) then - FMustSlide := false - - {otherwise something was actually read...} - else begin - {update the checksum} - if FUseCRC32 then - AbUpdateCRCBuffer(FChecksum, FLookAheadEnd^, BytesRead) - else - AbUpdateAdlerBuffer(FChecksum, FLookAheadEnd^, BytesRead); - - {reposition the pointer for the end of the lookahead area} - inc(FLookAheadEnd, BytesRead); - end; -end; -{--------} -procedure TAbDfInputWindow.iwSetCapacity(aValue : longint); -var - ActualSize : integer; -begin - {calculate the actual size; this will be the value passed in, plus - the correct look ahead size, plus 16KB} - ActualSize := aValue + (16 * 1024); - if FUseDeflate64 then begin - inc(ActualSize, dfc_MaxMatchLen64); - FMaxMatchLen := dfc_MaxMatchLen64; - end - else begin - inc(ActualSize, dfc_MaxMatchLen); - FMaxMatchLen := dfc_MaxMatchLen; - end; - - {get the new buffer} - GetMem(FBuffer, ActualSize); - - {set the other buffer pointers} - FStart := FBuffer; - FCurrent := FBuffer; - FLookAheadEnd := FBuffer; - FBufferEnd := FBuffer + ActualSize; - FSlidePoint := FBuffer + (16 * 1024); -end; -{--------} -procedure TAbDfInputWindow.iwSlide; -type - PLongint = ^longint; -var - i : integer; - ByteCount : integer; - Buffer : longint; - ListItem : PLongint; -begin - {move current valid data back to the start of the buffer} - ByteCount := FLookAheadEnd - FStart; - Move(FStart^, FBuffer^, ByteCount); - - {reset the various pointers} - ByteCount := FStart - FBuffer; - FStart := FBuffer; - dec(FCurrent, ByteCount); - dec(FLookAheadEnd, ByteCount); - - {patch up the hash table: the head pointers} - Buffer := longint(FBuffer); - ListItem := PLongint(@FHashHeads^[0]); - for i := 0 to pred(c_HashCount) do begin - dec(ListItem^, ByteCount); - if (ListItem^ < Buffer) then - ListItem^ := 0; - inc(PAnsiChar(ListItem), sizeof(pointer)); - end; - - {..the chain pointers} - ListItem := PLongint(@FHashChains^[0]); - for i := 0 to pred(FWinSize) do begin - dec(ListItem^, ByteCount); - if (ListItem^ < Buffer) then - ListItem^ := 0; - inc(PAnsiChar(ListItem), sizeof(pointer)); - end; - - {now read some more data from the stream} - iwReadFromStream; -end; -{--------} -function TAbDfInputWindow.Position : longint; -begin - Result := (FCurrent - FStart) + FStartOffset; -end; -{--------} -procedure TAbDfInputWindow.ReadBuffer(var aBuffer; aCount : longint; - aOffset : Int64); -var - CurPos : Int64; -begin - CurPos := FStream.Seek(0, soCurrent); - FStream.Seek(aOffSet, soBeginning); - FStream.ReadBuffer(aBuffer, aCount); - FStream.Seek(CurPos, soBeginning); -end; -{====================================================================} - -end. - - - diff --git a/components/Abbrevia/source/AbDfOutW.pas b/components/Abbrevia/source/AbDfOutW.pas deleted file mode 100644 index a78b166..0000000 --- a/components/Abbrevia/source/AbDfOutW.pas +++ /dev/null @@ -1,377 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfOutW.pas *} -{*********************************************************} -{* Deflate output sliding window *} -{*********************************************************} - -unit AbDfOutW; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbDfBase; - -{Notes: TAbDfOutputWindow implements a sliding window on previously - written data for the LZ77 dictionary decoding. - - AddLiteral will add a literal character at the current - position and advance by one. AddLenDist will copy the required - number of characters from the given position to the current - position, and advance the stream on by the length. The class - will periodically update the stream from the internal buffer. - - For normal Deflate, the internal buffer is 48K + 512 bytes in - size. Once there is 48Kb worth of data, 16KB is written to - file, and the buffer is shifted left by 16KB. We need to keep - the last decoded 32KB in memory at all times. - - For Deflate64, the internal buffer is 96K + 512 bytes in - size. Once there is 96Kb worth of data, 32KB is written to - file, and the buffer is shifted left by 32KB. We need to keep - the last decoded 64KB in memory at all times. - } - -type - TAbDfOutputWindow = class - private - FBuffer : PAnsiChar; - FChecksum : longint; - FCurrent : PAnsiChar; - FLog : TAbLogger; - FPartSize : longint; - FSlideCount : integer; - FStream : TStream; - FStreamPos : longint; - FTestOnly : boolean; - FUseCRC32 : boolean; - FWritePoint : PAnsiChar; - protected - function swGetChecksum : longint; - procedure swWriteToStream(aFlush : boolean); - public - constructor Create(aStream : TStream; - aUseDeflate64 : boolean; - aUseCRC32 : boolean; - aPartSize : longint; - aTestOnly : boolean; - aLog : TAbLogger); - destructor Destroy; override; - - procedure AddBuffer(var aBuffer; aCount : integer); - procedure AddLiteral(aCh : AnsiChar); - procedure AddLenDist(aLen : integer; aDist : integer); - function Position : longint; - - property Checksum : longint read swGetChecksum; - property Log : TAbLogger read FLog; - end; - -implementation - -uses - SysUtils; - -{Notes: - Meaning of the internal pointers: - - |==============================+------------------------+----| - | | | - FBuffer FCurrent FWritePoint - - Once FCurrent reaches or exceeds FWritePoint, FSlideCount - bytes of data from FBuffer are written to the stream and the - remaining data is moved back FSlideCount bytes, moving - FCurrent along with it as well. - } - -{===TAbDfOutputWindow==================================================} -constructor TAbDfOutputWindow.Create(aStream : TStream; - aUseDeflate64 : boolean; - aUseCRC32 : boolean; - aPartSize : longint; - aTestOnly : boolean; - aLog : TAbLogger); -var - Size : integer; - LookAheadSize : integer; -begin - {allow the ancestor to initialize} - inherited Create; - - {save parameters} - FLog := aLog; - FStream := aStream; - FTestOnly := aTestOnly; - if (aPartSize <= 0) then - FPartSize := 0 - else - FPartSize := aPartSize; - FUseCRC32 := aUseCRC32; - if aUseCRC32 then - FChecksum := -1 { CRC32 starts off with all bits set} - else - FCheckSum := 1; { Adler32 starts off with a value of 1} - - {set capacity of sliding window} - if aUseDeflate64 then begin - Size := 96 * 1024; - FSlideCount := 32 * 1024; - LookAheadSize := 64 * 1024; - end - else begin - Size := 64 * 1024; - FSlideCount := 32 * 1024; - LookAheadSize := 258; - end; - GetMem(FBuffer, Size + LookAheadSize); - - {set the other internal pointers} - FCurrent := FBuffer; - FWritePoint := FBuffer + Size; - if (FPartSize > Size) then - FPartSize := Size; -end; -{--------} -destructor TAbDfOutputWindow.Destroy; -begin - {write remaining data and free the buffer} - if (FBuffer <> nil) then begin - if (FCurrent <> FBuffer) then - swWriteToStream(true); - FreeMem(FBuffer); - end; - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -procedure TAbDfOutputWindow.AddBuffer(var aBuffer; aCount : integer); -var - Buffer : PAnsiChar; - BytesToWrite : integer; -begin - {if we've advanced to the point when we need to write, do so} - if (FCurrent >= FWritePoint) then - swWriteToStream(false); - - {cast the user buffer to a PChar, it's easier to use} - Buffer := @aBuffer; - - {calculate the number of bytes to copy} - BytesToWrite := FWritePoint - FCurrent; - if (BytesToWrite > aCount) then - BytesToWrite := aCount; - - {move this block of bytes} - Move(Buffer^, FCurrent^, BytesToWrite); - - {advance pointers and counters} - inc(FCurrent, BytesToWrite); - dec(aCount, BytesToWrite); - - {while there is still data to copy...} - while (aCount > 0) do begin - {advance the user buffer pointer} - inc(Buffer, BytesToWrite); - - {write the sliding window chunk to the stream} - swWriteToStream(false); - - {calculate the number of bytes to copy} - BytesToWrite := FWritePoint - FCurrent; - if (BytesToWrite > aCount) then - BytesToWrite := aCount; - - {move this block of bytes} - Move(Buffer^, FCurrent^, BytesToWrite); - - {advance pointers and counters} - inc(FCurrent, BytesToWrite); - dec(aCount, BytesToWrite); - end; -end; -{--------} -procedure AddLenDistToLog(aLog : TAbLogger; - aPosn : longint; - aLen : integer; - aDist : integer; - aOverLap : boolean); -begin - {NOTE the reason for this separate routine is to avoid string - allocations and try..finally blocks in the main method: an - optimization issue} - if aOverLap then - aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d **overlap**', - [aPosn, aLen, aDist])) - else - aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d', - [aPosn, aLen, aDist])); -end; -{--------} -procedure TAbDfOutputWindow.AddLenDist(aLen : integer; aDist : integer); -var - i : integer; - ToChar : PAnsiChar; - FromChar : PAnsiChar; -begin - {log it} - {$IFDEF UseLogging} - if (FLog <> nil) then - AddLenDistToLog(FLog, Position, aLen, aDist, (aLen > aDist)); - {$ENDIF} - - {if the length to copy is less than the distance, just do a move} - if (aLen <= aDist) then begin - Move((FCurrent - aDist)^ , FCurrent^, aLen); - end - - {otherwise we have to use a byte-by-byte copy} - else begin - FromChar := FCurrent - aDist; - ToChar := FCurrent; - for i := 1 to aLen do begin - ToChar^ := FromChar^; - inc(FromChar); - inc(ToChar); - end; - end; - - {increment the current pointer} - inc(FCurrent, aLen); - - {if we've reached the point requested, abort} - if (FPartSize > 0) and ((FCurrent - FBuffer) >= FPartSize) then - raise EAbPartSizedInflate.Create(''); {NOTE: This exception is expected during detection of .GZ and .TGZ files. (VerifyGZip)} - - {if we've advanced to the point when we need to write, do so} - if (FCurrent >= FWritePoint) then - swWriteToStream(false); -end; -{--------} -procedure AddLiteralToLog(aLog : TAbLogger; - aPosn : longint; - aCh : AnsiChar); -begin - {NOTE the reason for this separate routine is to avoid string - allocations and try..finally blocks in the main method: an - optimization issue} - if (' ' < aCh) and (aCh <= '~') then - aLog.WriteLine(Format('%8x Char: %3d $%2x [%s]', [aPosn, ord(aCh), ord(aCh), aCh])) - else - aLog.WriteLine(Format('%8x Char: %3d $%2x', [aPosn, ord(aCh), ord(aCh)])); -end; -{--------} -procedure TAbDfOutputWindow.AddLiteral(aCh : AnsiChar); -begin - {log it} - {$IFDEF UseLogging} - if (FLog <> nil) then - AddLiteralToLog(FLog, Position, aCh); - {$ENDIF} - - {add the literal to the buffer} - FCurrent^ := aCh; - - {increment the current pointer} - inc(FCurrent); - - {if we've reached the point requested, abort} - if (FPartSize > 0) and ((FCurrent - FBuffer) >= FPartSize) then - raise EAbPartSizedInflate.Create(''); - - {if we've advanced to the point when we need to write, do so} - if (FCurrent >= FWritePoint) then - swWriteToStream(false); -end; -{--------} -function TAbDfOutputWindow.Position : longint; -begin - if FTestOnly then - Result := FStreamPos + (FCurrent - FBuffer) - else - Result := FStream.Position + (FCurrent - FBuffer); -end; -{--------} -function TAbDfOutputWindow.swGetChecksum : longint; -begin - {since the checksum is calculated by the method that flushes to the - stream, make sure any buffered data is written out first} - if (FCurrent <> FBuffer) then - swWriteToStream(true); - - {the CRC32 checksum algorithm requires a post-conditioning step - after being calculated (the result is NOTted), whereas Adler32 does - not} - if FUseCRC32 then - Result := not FChecksum - else - Result := FChecksum; -end; -{--------} -procedure TAbDfOutputWindow.swWriteToStream(aFlush : boolean); -var - FromPtr : PAnsiChar; -begin - {if the request was to flush, write all remaining data after - updating the checksum} - if aFlush then begin - if FUseCRC32 then - AbUpdateCRCBuffer(FChecksum, FBuffer^, FCurrent - FBuffer) - else - AbUpdateAdlerBuffer(FChecksum, FBuffer^, FCurrent - FBuffer); - if FTestOnly then - inc(FStreamPos, FCurrent - FBuffer) - else - FStream.WriteBuffer(FBuffer^, FCurrent - FBuffer); - FCurrent := FBuffer; - end - - {otherwise, update the checksum with the data in the sliding window - chunk, write it out to the stream, and move the rest of the buffer - back} - else begin - if FUseCRC32 then - AbUpdateCRCBuffer(FChecksum, FBuffer^, FSlideCount) - else - AbUpdateAdlerBuffer(FChecksum, FBuffer^, FSlideCount); - if FTestOnly then - inc(FStreamPos, FSlideCount) - else - FStream.WriteBuffer(FBuffer^, FSlideCount); - FromPtr := FBuffer + FSlideCount; - Move(FromPtr^, FBuffer^, FCurrent - FromPtr); - FCurrent := FCurrent - FSlideCount; - end; -end; -{====================================================================} - -end. - diff --git a/components/Abbrevia/source/AbDfPkMg.pas b/components/Abbrevia/source/AbDfPkMg.pas deleted file mode 100644 index 8bb68d4..0000000 --- a/components/Abbrevia/source/AbDfPkMg.pas +++ /dev/null @@ -1,282 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfPkMg.pas *} -{*********************************************************} -{* Deflate package-merge algorithm *} -{*********************************************************} - -unit AbDfPkMg; - -{$I AbDefine.inc} - -interface - -uses - AbDfBase; - -procedure GenerateCodeLengths(aMaxCodeLen : integer; - const aWeights : array of integer; - var aCodeLengths : array of integer; - aStartInx : integer; - aLog : TAbLogger); - -implementation - -type - PPkgNode = ^TPkgNode; - TPkgNode = packed record - pnWeight : integer; - pnCount : integer; - pnLeft : PPkgNode; - pnRight : PPkgNode; - end; - - PPkgNodeList = ^TPkgNodeList; - TPkgNodeList = array [0..pred(286 * 2)] of PPkgNode; - {Note: the "286" is the number of literal/length symbols, the - maximum number of weights we'll be calculating the optimal - code lengths for} - - -{===helper routines==================================================} -function IsCalcFeasible(aCount : integer; - aMaxCodeLen : integer) : boolean; - -begin - {works out if length-limited codes can be calculated for a given - number of symbols and the maximum code length} - - {return whether 2^aMaxCodeLen > aCount} - Result := (1 shl aMaxCodeLen) > aCount; -end; -{--------} -procedure QSS(aList : PPkgNodeList; - aFirst : integer; - aLast : integer); -var - L, R : integer; - Pivot : integer; - Temp : pointer; -begin - {while there are at least two items to sort} - while (aFirst < aLast) do begin - {the pivot is the middle item} - Pivot := aList^[(aFirst+aLast) div 2]^.pnWeight; - {set indexes and partition} - L := pred(aFirst); - R := succ(aLast); - while true do begin - repeat dec(R); until (aList^[R]^.pnWeight <= Pivot); - repeat inc(L); until (aList^[L]^.pnWeight >= Pivot); - if (L >= R) then Break; - Temp := aList^[L]; - aList^[L] := aList^[R]; - aList^[R] := Temp; - end; - {quicksort the first subfile} - if (aFirst < R) then - QSS(aList, aFirst, R); - {quicksort the second subfile - recursion removal} - aFirst := succ(R); - end; -end; -{--------} -procedure SortList(aList : PPkgNodeList; aCount : integer); -begin - QSS(aList, 0, pred(aCount)); -end; -{--------} -procedure Accumulate(aNode : PPkgNode); -begin - while (aNode^.pnLeft <> nil) do begin - Accumulate(aNode^.pnLeft); - aNode := aNode^.pnRight; - end; - inc(aNode^.pnCount); -end; -{====================================================================} - - -{===Interfaced routine===============================================} -procedure GenerateCodeLengths(aMaxCodeLen : integer; - const aWeights : array of integer; - var aCodeLengths : array of integer; - aStartInx : integer; - aLog : TAbLogger); -var - i : integer; - Bit : integer; - WeightCount : integer; - OrigList : PPkgNodeList; - OrigListCount : integer; - MergeList : PPkgNodeList; - MergeListCount : integer; - PkgList : PPkgNodeList; - PkgListCount : integer; - OrigInx : integer; - PkgInx : integer; - Node : PPkgNode; - NodeMgr : TAbNodeManager; -begin - {calculate the number of weights} - WeightCount := succ(high(aWeights)); - - {check for dumb programming errors} - Assert((0 < aMaxCodeLen) and (aMaxCodeLen <= 15), - 'GenerateCodeLengths: the maximum code length should be in the range 1..15'); - Assert((1 <= WeightCount) and (WeightCount <= 286), - 'GenerateCodeLengths: the weight array must have 1..286 elements'); - Assert(IsCalcFeasible(WeightCount, aMaxCodeLen), - 'GenerateCodeLengths: the package-merge algorithm should always be feasible'); - - {clear the code lengths array} - FillChar(aCodeLengths[aStartInx], WeightCount * sizeof(integer), 0); - - {prepare for the try..finally} - OrigList := nil; - MergeList := nil; - PkgList := nil; - NodeMgr := nil; - try - - {create the node manager} - NodeMgr := TAbNodeManager.Create(sizeof(TPkgNode)); - - {create the original list of nodes} - GetMem(OrigList, WeightCount * sizeof(PPkgNode)); - OrigListCount := 0; - for i := 0 to pred(WeightCount) do - if (aWeights[i] <> 0) then begin - Node := NodeMgr.AllocNode; - Node^.pnLeft := nil; { this will indicate a leaf} - Node^.pnRight := pointer(i); { the index of the weight} - Node^.pnWeight := aWeights[i]; { the weight itself} - Node^.pnCount := 1; { how many times used} - OrigList^[OrigListCount] := Node; - inc(OrigListCount); - end; - - {we need at least 2 items, so make anything less a special case} - if (OrigListCount <= 1) then begin - - {if there are no items at all in the original list, we need to - pretend that there is one, since we shall eventually need to - calculate a Count-1 value that cannot be negative} - if (OrigListCount = 0) then begin - aCodeLengths[aStartInx] := 1; - Exit; - end; - - {otherwise there is only one item: set its code length directly} - for i := 0 to pred(WeightCount) do - if (aWeights[i] <> 0) then begin - aCodeLengths[aStartInx + i] := 1; - Exit; - end; - end; - - {there are at least 2 items in the list; so sort the list} - SortList(OrigList, OrigListCount); - - {create the merge and package lists} - GetMem(MergeList, OrigListCount * 2 * sizeof(PPkgNode)); - GetMem(PkgList, OrigListCount * 2 * sizeof(PPkgNode)); - - {initialize the merge list to have the same items as the - original list} - Move(OrigList^, MergeList^, OrigListCount * sizeof(PPkgNode)); - MergeListCount := OrigListCount; - - {do aMaxCodeLen - 2 times...} - for Bit := 1 to pred(aMaxCodeLen) do begin - - {generate the package list from the merge list by grouping pairs - from the merge list and adding them to the package list} - PkgListCount := 0; - for i := 0 to pred(MergeListCount div 2) do begin - Node := NodeMgr.AllocNode; - Node^.pnLeft := MergeList^[i * 2]; - Node^.pnRight := MergeList^[i * 2 + 1]; - Node^.pnWeight := Node^.pnLeft^.pnWeight + - Node^.pnRight^.pnWeight; - {$IFOPT C+} - Node^.pnCount := 0; - {$ENDIF} - PkgList^[PkgListCount] := Node; - inc(PkgListCount); - end; - - {merge the original list and the package list} - MergeListCount := 0; - OrigInx := 0; - PkgInx := 0; - {note the optimization here: the package list will *always* be - last to empty in the merge process since it will have at least - one item whose accumulated weight is greater than all of the - items in the original list} - while (OrigInx < OrigListCount) and (PkgInx < PkgListCount) do begin - if (OrigList^[OrigInx]^.pnWeight <= PkgList^[PkgInx]^.pnWeight) then begin - MergeList^[MergeListCount] := OrigList^[OrigInx]; - inc(OrigInx); - end - else begin - MergeList^[MergeListCount] := PkgList^[PkgInx]; - inc(PkgInx); - end; - inc(MergeListCount); - end; - if (OrigInx < OrigListCount) then begin - Move(OrigList^[OrigInx], MergeList^[MergeListCount], - (OrigListCount - OrigInx) * sizeof(PPkgNode)); - inc(MergeListCount, (OrigListCount - OrigInx)); - end - else begin - Move(PkgList^[PkgInx], MergeList^[MergeListCount], - (PkgListCount - PkgInx) * sizeof(PPkgNode)); - inc(MergeListCount, (PkgListCount - PkgInx)); - end; - end; - - {calculate the code lengths} - for i := 0 to (OrigListCount * 2) - 3 do begin - Node := MergeList^[i]; - if (Node^.pnLeft <> nil) then - Accumulate(Node); - end; - for i := 0 to pred(OrigListCount) do - aCodeLengths[aStartInx + integer(OrigList^[i].pnRight)] := - OrigList^[i].pnCount; - finally - FreeMem(OrigList); - FreeMem(MergeList); - FreeMem(PkgList); - NodeMgr.Free; - end; -end; -{====================================================================} - -end. diff --git a/components/Abbrevia/source/AbDfStrm.pas b/components/Abbrevia/source/AbDfStrm.pas deleted file mode 100644 index ad68b07..0000000 --- a/components/Abbrevia/source/AbDfStrm.pas +++ /dev/null @@ -1,1519 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfStrm.pas *} -{*********************************************************} -{* Deflate streams unit for various streams *} -{*********************************************************} - -unit AbDfStrm; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbDfBase, - AbDfInW, - AbDfHufD; - -type - TAb32bit = longint; { a 32-bit type} - - PAbDfLitBuckets = ^TAbDfLitBuckets; - TAbDfLitBuckets = array [0..285] of integer; - PAbDfDistBuckets = ^TAbDfDistBuckets; - TAbDfDistBuckets = array [0..31] of integer; - PAbDfCodeLenBuckets = ^TAbDfCodeLenBuckets; - TAbDfCodeLenBuckets = array [0..18] of integer; - - -const - AbExtractMask : array [1..31] of TAb32bit = - ($00000001, $00000003, $00000007, $0000000F, - $0000001F, $0000003F, $0000007F, $000000FF, - $000001FF, $000003FF, $000007FF, $00000FFF, - $00001FFF, $00003FFF, $00007FFF, $0000FFFF, - $0001FFFF, $0003FFFF, $0007FFFF, $000FFFFF, - $001FFFFF, $003FFFFF, $007FFFFF, $00FFFFFF, - $01FFFFFF, $03FFFFFF, $07FFFFFF, $0FFFFFFF, - $1FFFFFFF, $3FFFFFFF, $7FFFFFFF); - -type - TAbDfInBitStream = class { input bit stream} - private - FBitBuffer : TAb32bit; - FBitsLeft : integer; - FBufEnd : PAnsiChar; - FBuffer : PAnsiChar; - FBufPos : PAnsiChar; - FByteCount : longint; - FFakeCount : integer; - FOnProgress: TAbProgressStep; - {$IFOPT C+} - FPeekCount : integer; - {$ENDIF} - FStream : TStream; - FStreamSize: longint; - protected - function ibsFillBuffer : boolean; - public - constructor Create(aStream : TStream; - aOnProgress : TAbProgressStep; - aStreamSize : longint); - destructor Destroy; override; - - procedure AlignToByte; - procedure DiscardBits(aCount : integer); - procedure DiscardMoreBits(aCount : integer); - function PeekBits(aCount : integer) : integer; - function PeekMoreBits(aCount : integer) : integer; - function ReadBit : boolean; - function ReadBits(aCount : integer) : integer; - procedure ReadBuffer(var aBuffer; aCount : integer); - - property BitBuffer : TAb32bit read FBitBuffer write FBitBuffer; - property BitsLeft : integer read FBitsLeft write FBitsLeft; - end; - -type - TAbDfOutBitStream = class { output bit stream} - private - FBitBuffer : TAb32bit; - FBitsUsed : integer; - FBufEnd : PAnsiChar; - FBuffer : PAnsiChar; - FBufPos : PAnsiChar; - FStream : TStream; - protected - procedure obsEmptyBuffer; - public - constructor Create(aStream : TStream); - destructor Destroy; override; - - procedure AlignToByte; - function Position : longint; - procedure WriteBit(aBit : boolean); - procedure WriteBits(aBits : integer; aCount : integer); - procedure WriteBuffer(var aBuffer; aCount : integer); - procedure WriteMoreBits(aBits : integer; aCount : integer); - - property BitBuffer : TAb32bit read FBitBuffer write FBitBuffer; - property BitsUsed : integer read FBitsUsed write FBitsUsed; - end; - -type - TAbDfLZStream = class { LZ77 token stream} - private - FCurPos : PAnsiChar; - FDistBuckets : PAbDfDistBuckets; - FDistCount : integer; - FLitBuckets : PAbDfLitBuckets; - FLitCount : integer; - FLog : TAbLogger; - FSlideWin : TAbDfInputWindow; - FStartOfs : Int64; - FStoredSize : LongWord; - FStream : PAnsiChar; - FStrmEnd : PAnsiChar; - {$IFDEF UseLogging} - FSWPos : longint; - {$ENDIF} - FUseDeflate64: boolean; - protected - function lzsGetApproxSize : LongWord; - function lzsGetStaticSize : integer; - function lzsGetStoredSize : integer; - function lzsIsFull : boolean; - public - constructor Create(aSlideWin : TAbDfInputWindow; - aUseDeflate64 : boolean; - aLog : TAbLogger); - destructor Destroy; override; - - function AddLenDist(aLen : integer; aDist : integer) : boolean; - { returns true if the stream is "full"} - function AddLiteral(aCh : AnsiChar) : boolean; - { returns true if the stream is "full"} - - procedure Clear; - procedure Encode(aBitStrm : TAbDfOutBitStream; - aLitTree : TAbDfDecodeHuffmanTree; - aDistTree : TAbDfDecodeHuffmanTree; - aUseDeflate64 : boolean); - procedure Rewind; - - procedure ReadStoredBuffer(var aBuffer; aCount : integer); - - property LenDistCount : integer read FDistCount; - property LiteralCount : integer read FLitCount; - - property DistBuckets : PAbDfDistBuckets read FDistBuckets; - property LitBuckets : PAbDfLitBuckets read FLitBuckets; - - property StaticSize : integer read lzsGetStaticSize;{ in bits} - property StoredSize : integer read lzsGetStoredSize;{ in bytes} - end; - -type - TAbDfCodeLenStream = class { codelength token stream} - private - FBuckets : PAbDfCodeLenBuckets; - FPosition : PAnsiChar; - FStream : PAnsiChar; {array [0..285+32*2] of byte;} - FStrmEnd : PAnsiChar; - protected - public - constructor Create(aLog : TAbLogger); - destructor Destroy; override; - - procedure Build(const aCodeLens : array of integer; - aCount : integer); - procedure Encode(aBitStrm : TAbDfOutBitStream; - aTree : TAbDfDecodeHuffmanTree); - - property Buckets : PAbDfCodeLenBuckets read FBuckets; - end; - -implementation - -uses - SysUtils, - AbDfXlat; - -type - PAb32bit = ^TAb32bit; - -const - BitStreamBufferSize = 16*1024; - -{===TAbDfInBitStream=================================================} -constructor TAbDfInBitStream.Create(aStream : TStream; - aOnProgress : TAbProgressStep; - aStreamSize : longint); -begin - {protect against dumb programming mistakes} - Assert(aStream <> nil, - 'TAbDfInBitStream.Create: Cannot create a bit stream wrapping a nil stream'); - - {create the ancestor} - inherited Create; - - {save the stream instance, allocate the buffer} - FStream := aStream; - GetMem(FBuffer, BitStreamBufferSize); - - {save the on progress handler} - if Assigned(aOnProgress) and (aStreamSize > 0) then begin - FOnProgress := aOnProgress; - FStreamSize := aStreamSize; - end; -end; -{--------} -destructor TAbDfInBitStream.Destroy; -begin - {if we did some work...} - if (FBuffer <> nil) then begin - - {reposition the underlying stream to the point where we stopped; - this position is equal to... - the position of the underlying stream, PLUS - the number of fake bytes we added, LESS - the number of bytes in the buffer, PLUS - the position in the buffer, PLUS - the number of complete bytes in the bit buffer} - FStream.Seek(FStream.Position + - FFakeCount - - (FBufEnd - FBuffer) + - (FBufPos - FBuffer) - - (FBitsLeft div 8), soBeginning); - - {free the buffer} - FreeMem(FBuffer); - end; - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -procedure TAbDfInBitStream.AlignToByte; -begin - {get rid of the odd bits by shifting them out of the bit cache} - FBitBuffer := FBitBuffer shr (FBitsLeft mod 8); - dec(FBitsLeft, FBitsLeft mod 8); -end; -{--------} -procedure TAbDfInBitStream.DiscardBits(aCount : integer); -var - BitsToGo : integer; -begin - {aCount comes from a (possibly corrupt) stream, so check that it is - the correct range, 1..32} - if (aCount <= 0) or (aCount > 32) then - raise EAbInternalInflateError.Create( - 'count of bits must be between 1 and 32 inclusive [TAbDfInBitStream.DiscardBits]'); - - {$IFOPT C+} - {verify that the count of bits to discard is less than or equal to - the recent count from PeekBits--a programming error} - Assert((aCount <= FPeekCount), - 'TAbDfInBitStream.DiscardBits: discarding more bits than peeked'); - {since we're discarding bits already peeked, reset the peek count} - FPeekCount := 0; - {$ENDIF} - - {if we have more than enough bits in our bit buffer, update the - bitbuffer and the number of bits left} - if (aCount <= FBitsLeft) then begin - FBitBuffer := FBitBuffer shr aCount; - dec(FBitsLeft, aCount); - end - - {otherwise we shall have to read another integer out of the buffer - to satisfy the request} - else begin - {check that there is data in the buffer, if not it's indicates a - corrupted stream: PeekBits should have filled it} - if (FBufPos = FBufEnd) then - raise EAbInternalInflateError.Create( - 'no more compressed data in stream [TAbDfInBitStream.DiscardBits]'); - - {refill the bit buffer} - BitsToGo := aCount - FBitsLeft; - FBitBuffer := PAb32bit(FBufPos)^; - inc(FBufPos, sizeof(TAb32bit)); - FBitBuffer := FBitBuffer shr BitsToGo; - FBitsLeft := 32 - BitsToGo; - end; -end; -{--------} -procedure TAbDfInBitStream.DiscardMoreBits(aCount : integer); -var - BitsToGo : integer; -begin - {aCount comes from a (possibly corrupt) stream, so check that it is - the correct range, 1..32} - if (aCount <= 0) or (aCount > 32) then - raise EAbInternalInflateError.Create( - 'count of bits must be between 1 and 32 inclusive [TAbDfInBitStream.DiscardMoreBits]'); - - {$IFOPT C+} - {verify that the count of bits to discard is less than or equal to - the recent count from PeekBits--a programming error} - Assert((aCount <= FPeekCount), - 'TAbDfInBitStream.DiscardBits: discarding more bits than peeked'); - {since we're discarding bits already peeked, reset the peek count} - FPeekCount := 0; - {$ENDIF} - - {check that there is data in the buffer, if not it's indicates a - corrupted stream: PeekBits/PeekMoreBits should have filled it} - if (FBufPos = FBufEnd) then - raise EAbInternalInflateError.Create( - 'no more compressed data in stream [TAbDfInBitStream.DiscardBits]'); - - {refill the bit buffer} - BitsToGo := aCount - FBitsLeft; - FBitBuffer := PAb32bit(FBufPos)^; - inc(FBufPos, sizeof(TAb32bit)); - FBitBuffer := FBitBuffer shr BitsToGo; - FBitsLeft := 32 - BitsToGo; -end; -{--------} -function TAbDfInBitStream.ibsFillBuffer : boolean; -var - BytesRead : longint; - BytesToRead : longint; - i : integer; - Percent : integer; - Buffer : PAnsiChar; - BufferCount : integer; -begin - {check for dumb programming mistakes: this routine should only be - called if there are less than 4 bytes unused in the buffer} - Assert((FBufEnd - FBufPos) < sizeof(longint), - 'TAbDfInBitStream.ibsFillBuffer: the buffer should be almost empty'); - - {if there are still 1, 2, or three bytes unused, move them to the - front of the buffer} - Buffer := FBuffer; - while (FBufPos <> FBufEnd) do begin - Buffer^ := FBufPos^; - inc(FBufPos); - inc(Buffer); - end; - - {fill the buffer} - BytesToRead := BitStreamBufferSize - (Buffer - FBuffer); - BytesRead := FStream.Read(Buffer^, BytesToRead); - - {reset the internal pointers} - FBufPos := FBuffer; - FBufEnd := Buffer + BytesRead; - BufferCount := FBufEnd - FBuffer; - - {if, as a result of the read, no data is in the buffer, return - false; the caller will decide what to do about the problem} - if (BufferCount = 0) then - Result := false - - {otherwise there is data to be processed} - else begin - Result := true; - - {if we didn't read anything from the stream, we need to make sure - that enough buffer is zeroed out so that reading longint values - don't produce (dreadfully) bogus values} - if (BytesRead = 0) and ((BufferCount mod 4) <> 0) then begin - FFakeCount := 4 - (BufferCount mod 4); - for i := 0 to pred(FFakeCount) do begin - FBufEnd^ := #0; - inc(FBufEnd); - end; - end; - - {fire the progress event} - if Assigned(FOnProgress) then begin - inc(FByteCount, BytesRead); - Percent := Round((100.0 * FByteCount) / FStreamSize); - FOnProgress(Percent); - end; - end; -end; -{--------} -function TAbDfInBitStream.PeekBits(aCount : integer) : integer; -var - BitsToGo : integer; - TempBuffer : integer; -begin - {check that aCount is in the correct range 1..32} - Assert((0 <= aCount) and (aCount <= 32), - 'TAbDfInBitStream.PeekBits: count of bits must be between 1 and 32 inclusive'); - - {if we have more than enough bits in our bit buffer, return as many - as needed} - if (aCount <= FBitsLeft) then - Result := FBitBuffer and AbExtractMask[aCount] - - {otherwise we shall have to read another integer out of the buffer - to satisfy the request; note that this will fill the stream buffer - if required} - else begin - BitsToGo := aCount - FBitsLeft; - Result := FBitBuffer; - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - if not ibsFillBuffer then - TempBuffer := 0 - else - TempBuffer := PAb32bit(FBufPos)^ - else - TempBuffer := PAb32bit(FBufPos)^; - Result := Result + - ((TempBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft); - end; - - {$IFOPT C+} - {save the number of bits peeked for an assertion check later} - FPeekCount := aCount; - {$ENDIF} -end; -{--------} -function TAbDfInBitStream.PeekMoreBits(aCount : integer) : integer; -var - BitsToGo : integer; - TempBuffer : integer; -begin - BitsToGo := aCount - FBitsLeft; - Result := FBitBuffer; - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - if not ibsFillBuffer then - TempBuffer := 0 - else - TempBuffer := PAb32bit(FBufPos)^ - else - TempBuffer := PAb32bit(FBufPos)^; - Result := Result + - ((TempBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft); -end; -{--------} -function TAbDfInBitStream.ReadBit : boolean; -begin - if (FBitsLeft = 0) then begin - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - if not ibsFillBuffer then - raise EAbInternalInflateError.Create( - 'no more compressed data in stream [TAbDfInBitStream.ReadBit]'); - FBitBuffer := PAb32bit(FBufPos)^; - inc(FBufPos, sizeof(TAb32bit)); - FBitsLeft := 32; - end; - Result := Odd(FBitBuffer); - FBitBuffer := FBitBuffer shr 1; - dec(FBitsLeft); -end; -{--------} -function TAbDfInBitStream.ReadBits(aCount : integer) : integer; -var - BitsToGo : integer; -begin - {aCount comes from a (possibly corrupt) stream, so check that it is - the correct range, 1..16} - if (aCount <= 0) or (aCount > 16) then - raise EAbInternalInflateError.Create( - 'count of bits must be between 1 and 16 inclusive [TAbDfInBitStream.ReadBits]'); - - {if we have more than enough bits in our bit buffer, return as many - as needed, and update the bitbuffer and the number of bits left} - if (aCount <= FBitsLeft) then begin - Result := FBitBuffer and AbExtractMask[aCount]; - FBitBuffer := FBitBuffer shr aCount; - dec(FBitsLeft, aCount); - end - - {if we have exactly enough bits in our bit buffer, return them all, - and update the bitbuffer and the number of bits left} - else if (aCount = FBitsLeft) then begin - Result := FBitBuffer; - FBitBuffer := 0; - FBitsLeft := 0; - end - - {otherwise we shall have to read another integer out of the buffer - to satisfy the request} - else begin - BitsToGo := aCount - FBitsLeft; - Result := FBitBuffer; - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - if not ibsFillBuffer then - raise EAbInternalInflateError.Create( - 'no more compressed data in stream [TAbDfInBitStream.ReadBits]'); - FBitBuffer := PAb32bit(FBufPos)^; - inc(FBufPos, sizeof(TAb32bit)); - Result := Result + - ((FBitBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft); - FBitBuffer := FBitBuffer shr BitsToGo; - FBitsLeft := 32 - BitsToGo; - end; -end; -{--------} -procedure TAbDfInBitStream.ReadBuffer(var aBuffer; aCount : integer); -var - i : integer; - Buffer : PAnsiChar; - BytesToRead : integer; - BytesInBuffer : integer; -begin - {this method is designed to read a set of bytes and this can only be - done if the stream has been byte aligned--if it isn't, it's a - programming error} - Assert((FBitsLeft mod 8) = 0, - 'TAbDfInBitStream.ReadBuffer. cannot read a buffer unless the stream is byte-aligned'); - - {get the address of the user buffer as a PChar: easier arithmetic} - Buffer := @aBuffer; - - {if we have some bits left in the bit buffer, we need to copy those - first} - if (FBitsLeft > 0) then begin - BytesToRead := FBitsLeft div 8; - for i := 0 to pred(BytesToRead) do begin - Buffer^ := AnsiChar(FBitBuffer and $FF); - inc(Buffer); - FBitBuffer := FBitBuffer shr 8; - end; - {calculate the count of bytes still to read} - dec(aCount, BytesToRead); - end; - - {calculate the number of bytes to copy} - BytesInBuffer := FBufEnd - FBufPos; - if (aCount <= BytesInBuffer) then - BytesToRead := aCount - else - BytesToRead := BytesInBuffer; - - {copy the data from our buffer to the user buffer} - Move(FBufPos^, Buffer^, BytesToRead); - - {update variables} - dec(aCount, BytesToRead); - inc(FBufPos, BytesToRead); - - {while there is still data to copy, keep on filling our internal - buffer and copy it to the user buffer} - while (aCount <> 0) do begin - - {increment the user buffer pointer past the data just copied} - inc(Buffer, BytesToRead); - - {fill our buffer} - if not ibsFillBuffer then - raise EAbInternalInflateError.Create( - 'no more compressed data in stream [TAbDfInBitStream.ReadBuffer]'); - - {calculate the number of bytes to copy} - BytesInBuffer := FBufEnd - FBufPos; - if (aCount <= BytesInBuffer) then - BytesToRead := aCount - else - BytesToRead := BytesInBuffer; - - {copy the data from our buffer to the user buffer} - Move(FBufPos^, Buffer^, BytesToRead); - - {update variables} - dec(aCount, BytesToRead); - inc(FBufPos, BytesToRead); - end; - - {now we've copied everything over, reset the bit variables: they're - empty and need refilling} - FBitBuffer := 0; - FBitsLeft := 0; -end; -{====================================================================} - - -{===TAbDfOutBitStream================================================} -constructor TAbDfOutBitStream.Create(aStream : TStream); -begin - {protect against dumb programming mistakes} - Assert(aStream <> nil, - 'TAbDfOutBitStream.Create: Cannot create a bit stream wrapping a nil stream'); - - {create the ancestor} - inherited Create; - - {save the stream instance, allocate the buffer} - FStream := aStream; - GetMem(FBuffer, BitStreamBufferSize); - FBufEnd := FBuffer + BitStreamBufferSize; - FBufPos := FBuffer; -end; -{--------} -destructor TAbDfOutBitStream.Destroy; -var - i : integer; -begin - {if the buffer was allocated...} - if (FBuffer <> nil) then begin - - {if there are still some bits in the bit buffer...} - if (FBitsUsed <> 0) then begin - - {pad the bit buffer to a byte boundary} - AlignToByte; - - {empty the main buffer if there isn't enough room to copy over - the 1 to 4 bytes in the bit buffer} - if ((FBufEnd - FBufPos) < FBitsUsed div 8) then - obsEmptyBuffer; - - {flush the bit buffer} - for i := 1 to (FBitsUsed div 8) do begin - FBufPos^ := AnsiChar(FBitBuffer); - FBitBuffer := FBitBuffer shr 8; - inc(FBufPos); - end; - end; - - {if there is some data in the main buffer, empty it} - if (FBufPos <> FBuffer) then - obsEmptyBuffer; - - {free the buffer} - FreeMem(FBuffer); - end; - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -procedure TAbDfOutBitStream.AlignToByte; -begin - {round up the number of bits used to the nearest 8} - FBitsUsed := (FBitsUsed + 7) and $F8; - - {if the bit buffer is now full, flush it to the main buffer} - if (FBitsUsed = 32) then begin - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - obsEmptyBuffer; - PAb32bit(FBufPos)^ := FBitBuffer; - inc(FBufPos, sizeof(TAb32bit)); - FBitBuffer := 0; - FBitsUsed := 0; - end; -end; -{--------} -procedure TAbDfOutBitStream.obsEmptyBuffer; -var - ByteCount : integer; - BytesWritten : longint; -begin - {empty the buffer} - ByteCount := FBufPos - FBuffer; - BytesWritten := FStream.Write(FBuffer^, ByteCount); - - {if we couldn't write the correct number of bytes, it's an error} - if (BytesWritten <> ByteCount) then - raise EAbInternalDeflateError.Create( - 'could not write to the output stream [TAbDfInBitStream.obsEmptyBuffer]'); - - {reset the pointers} - FBufPos := FBuffer; -end; -{--------} -function TAbDfOutBitStream.Position : longint; -begin - Assert(false, - 'TAbDfOutBitStream.Position: not implemented yet!'); - Result := -1; -end; -{--------} -procedure TAbDfOutBitStream.WriteBit(aBit : boolean); -begin - {only set the corresponding bit in the bit buffer if the passed bit - is set (the bit buffer is set to zero when emptied, so we don't - actually have to record clear bits)} - if aBit then - FBitBuffer := FBitBuffer or (1 shl FBitsUsed); - - {we've now got one more bit} - inc(FBitsUsed); - - {if the bit buffer is now full, flush it to the main buffer} - if (FBitsUsed = 32) then begin - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - obsEmptyBuffer; - PAb32bit(FBufPos)^ := FBitBuffer; - inc(FBufPos, sizeof(TAb32bit)); - FBitBuffer := 0; - FBitsUsed := 0; - end; -end; -{--------} -procedure TAbDfOutBitStream.WriteBits(aBits : integer; aCount : integer); -begin - {protect against programming mistakes...} - {..the count should be in the range 1 to 16 (BTW, the latter is only - used once: Deflate64 with length symbol 258)} - Assert((0 < aCount) and (aCount <= 16), - 'TAbDfOutBitStream.WriteBits: aCount should be from 1 to 16'); - {..there shouldn't be more than aCount bits} - Assert((aBits shr aCount) = 0, - 'TAbDfOutBitStream.WriteBits: aBits has more than aCount bits'); - - {copy as many bits as we can to the bit buffer} - FBitBuffer := FBitBuffer or (aBits shl FBitsUsed); - - {increment the number of bits used} - inc(FBitsUsed, aCount); - - {if we've overshot...} - if (FBitsUsed >= 32) then begin - - {the bit buffer is now full, so flush it} - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - obsEmptyBuffer; - PAb32bit(FBufPos)^ := FBitBuffer; - inc(FBufPos, sizeof(TAb32bit)); - - {patch up the bit buffer and the number of bits used} - dec(FBitsUsed, 32); - FBitBuffer := aBits shr (aCount - FBitsUsed); - end; -end; -{--------} -procedure TAbDfOutBitStream.WriteBuffer(var aBuffer; aCount : integer); -var - Buffer : PAnsiChar; - BytesToCopy : integer; -begin - {guard against dumb programming errors: we must be byte aligned} - Assert((FBitsUsed and $7) = 0, - 'TAbDfOutBitStream.WriteBuffer: must be byte aligned'); - - {use the user buffer as a PChar} - Buffer := @aBuffer; - - {flush the bit buffer to the underlying stream} - while (FBitsUsed <> 0) do begin - if (FBufEnd = FBufPos) then - obsEmptyBuffer; - FBufPos^ := AnsiChar(FBitBuffer and $FF); - inc(FBufPos); - FBitBuffer := FBitBuffer shr 8; - dec(FBitsUsed, 8); - end; - - {copy over the data to the underlying stream} - BytesToCopy := FBufEnd - FBufPos; - if (BytesToCopy > aCount) then - BytesToCopy := aCount; - Move(Buffer^, FBufPos^, BytesToCopy); - inc(FBufPos, BytesToCopy); - dec(aCount, BytesToCopy); - while (aCount <> 0) do begin - inc(Buffer, BytesToCopy); - obsEmptyBuffer; - BytesToCopy := FBufEnd - FBufPos; - if (BytesToCopy > aCount) then - BytesToCopy := aCount; - Move(Buffer^, FBufPos^, BytesToCopy); - inc(FBufPos, BytesToCopy); - dec(aCount, BytesToCopy); - end; - - {finish with a flushed buffer} - obsEmptyBuffer; -end; -{--------} -procedure TAbDfOutBitStream.WriteMoreBits(aBits : integer; aCount : integer); -begin - {the bit buffer is now full, so flush it} - if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then - obsEmptyBuffer; - PAb32bit(FBufPos)^ := FBitBuffer; - inc(FBufPos, sizeof(TAb32bit)); - - {patch up the bit buffer and the number of bits used} - dec(FBitsUsed, 32); - FBitBuffer := aBits shr (aCount - FBitsUsed); -end; -{====================================================================} - - -{===TAbDfLZStream====================================================} -const - {Implementation note: this stream size has been chosen so that if - the data must be stored, a block size of about 64K will result} - StreamSize = 160 * 1024; -type - PWord = ^word; -{--------} -constructor TAbDfLZStream.Create(aSlideWin : TAbDfInputWindow; - aUseDeflate64 : boolean; - aLog : TAbLogger); -begin - {create the ancestor} - inherited Create; - - {save the sliding window and the logger} - FSlideWin := aSlideWin; - FUseDeflate64 := aUseDeflate64; - FLog := aLog; - - {create the buckets} - New(FDistBuckets); - New(FLitBuckets); - - {create the memory stream, allocate its buffer, position at start} - GetMem(FStream, StreamSize); - Clear; -end; -{--------} -destructor TAbDfLZStream.Destroy; -begin - {free the buckets} - if (FDistBuckets <> nil) then - Dispose(FDistBuckets); - if (FLitBuckets <> nil) then - Dispose(FLitBuckets); - - {free the memory stream} - if (FStream <> nil) then - FreeMem(FStream); - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -{$IFDEF UseLogging} -procedure AddLenDistToLog(aLog : TAbLogger; - aPosn : longint; - aLen : integer; - aDist : integer; - aOverLap : boolean); -begin - {NOTE the reason for this separate routine is to avoid string - allocations and try..finally blocks in the main method: an - optimization issue} - if aOverLap then - aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d **overlap**', - [aPosn, aLen, aDist])) - else - aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d', - [aPosn, aLen, aDist])); -end; -{$ENDIF} -{--------} -function TAbDfLZStream.AddLenDist(aLen : integer; aDist : integer) - : boolean; -var - LenSymbol : integer; - DistSymbol : integer; - CurPos : PAnsiChar; -begin - {$IFDEF UseLogging} - {log it} - if (FLog <> nil) then begin - if (aLen > aDist) then - AddLenDistToLog(FLog, FSWPos, aLen, aDist, true) - else - AddLenDistToLog(FLog, FSWPos, aLen, aDist, false); - inc(FSWPos, aLen); - end; - {$ENDIF} - - {write a length/distance record to the stream} - CurPos := FCurPos; - CurPos^ := AnsiChar(false); - inc(CurPos); - PWord(CurPos)^ := word(aLen - 1); - inc(CurPos, sizeof(word)); - PWord(CurPos)^ := word(aDist - 1); - inc(CurPos, sizeof(word)); - FCurPos := CurPos; - - {increment the various counters} - inc(FDistCount); - inc(FStoredSize, aLen); - - {convert the length and distance to their symbols} - {$IFOPT C+} {if Assertions are on} - LenSymbol := AbSymbolTranslator.TranslateLength(aLen); - DistSymbol := AbSymbolTranslator.TranslateDistance(aDist); - {$ELSE} - if (3 <= aLen) and (aLen <= 258) then - LenSymbol := AbSymbolTranslator.LenSymbols[aLen-3] + 257 - else - LenSymbol := 285; - if (aDist <= 256) then - DistSymbol := AbSymbolTranslator.ShortDistSymbols[aDist - 1] - else if (aDist <= 32768) then - DistSymbol := AbSymbolTranslator.MediumDistSymbols[((aDist - 1) div 128) - 2] - else - DistSymbol := AbSymbolTranslator.LongDistSymbols[((aDist - 1) div 16384) - 2]; - {$ENDIF} - - {increment the buckets} - inc(FLitBuckets^[LenSymbol]); - inc(FDistBuckets^[DistSymbol]); - - {return whether the stream is full and needs encoding} - Result := lzsIsFull; -end; -{--------} -{$IFDEF UseLogging} -procedure AddLiteralToLog(aLog : TAbLogger; - aPosn : longint; - aCh : AnsiChar); -begin - {NOTE the reason for this separate routine is to avoid string - allocations and try..finally blocks in the main method: an - optimization issue} - if (' ' < aCh) and (aCh <= '~') then - aLog.WriteLine(Format('%8x Char: %3d $%2x [%s]', [aPosn, ord(aCh), ord(aCh), aCh])) - else - aLog.WriteLine(Format('%8x Char: %3d $%2x', [aPosn, ord(aCh), ord(aCh)])); -end; -{$ENDIF} -{--------} -function TAbDfLZStream.AddLiteral(aCh : AnsiChar) : boolean; -var - CurPos : PAnsiChar; -begin - {$IFDEF UseLogging} - {log it} - if (FLog <> nil) then begin - AddLiteralToLog(FLog, FSWPos, aCh); - inc(FSWPos); - end; - {$ENDIF} - - {write a literal to the internal stream} - CurPos := FCurPos; - CurPos^ := AnsiChar(true); - inc(CurPos); - CurPos^ := aCh; - inc(CurPos); - FCurPos := CurPos; - - {increment the various counters} - inc(FLitCount); - inc(FLitBuckets^[byte(aCh)]); - inc(FStoredSize); - - {return whether the stream is full and needs encoding} - Result := lzsIsFull; -end; -{--------} -procedure TAbDfLZStream.Clear; -begin - {position the stream at the start} - Rewind; - - {reset all variables} - FStrmEnd := nil; - FLitCount := 0; - FDistCount := 0; - FStartOfs := FSlideWin.Position; - FStoredSize := 0; - {$IFDEF UseLogging} - FSWPos := FStartOfs; - {$ENDIF} - - {reset the buckets} - FillChar(FLitBuckets^, sizeof(FLitBuckets^), 0); - FLitBuckets^[256] := 1; { end-of-block marker: it's always there...} - FillChar(FDistBuckets^, sizeof(FDistBuckets^), 0); -end; -{--------} -procedure TAbDfLZStream.Encode(aBitStrm : TAbDfOutBitStream; - aLitTree : TAbDfDecodeHuffmanTree; - aDistTree : TAbDfDecodeHuffmanTree; - aUseDeflate64 : boolean); -var - Len : integer; - Dist : integer; - Symbol : integer; - CurPos : PAnsiChar; - StrmEnd : PAnsiChar; - Code : longint; - ExtraBits : longint; -begin - {rewind the LZ77 stream} - Rewind; - - {for speed use local variables} - CurPos := FCurPos; - StrmEnd := FStrmEnd; - - {while there are still items in the stream...} - while (CurPos < StrmEnd) do begin - - {if the next item is a literal...} - if boolean(CurPos^) then begin - - {encode the literal character as a symbol} - inc(CurPos); - {$IFOPT C+} {if Assertions are on} - Code := aLitTree.Encode(byte(CurPos^)); - {$ELSE} - Code := aLitTree.Encodes^[byte(CurPos^)]; - {$ENDIF} - inc(CurPos); - - {write the code out to the bit stream} - {$IFOPT C+} - aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF); - {$ELSE} - with aBitStrm do begin - BitBuffer := BitBuffer or ((Code and $FFFF) shl BitsUsed); - BitsUsed := BitsUsed + ((Code shr 16) and $FF); - if (BitsUsed >= 32) then - WriteMoreBits(Code and $FFFF, (Code shr 16) and $FF); - end; - {$ENDIF} - end - - {otherwise it's a length/distance pair} - else begin - - {DO THE LENGTH FIRST-------------------------------------------} - {get the length from the stream} - inc(CurPos); - Len := integer(PWord(CurPos)^) + 1; - inc(CurPos, sizeof(word)); - - {translate it to a symbol and convert that to a code using the - literal/length huffman tree} - {$IFOPT C+} {if Assertions are on} - Symbol := AbSymbolTranslator.TranslateLength(Len); - Code := aLitTree.Encode(Symbol); - {$ELSE} - if (3 <= Len) and (Len <= 258) then - Symbol := AbSymbolTranslator.LenSymbols[Len-3] + 257 - else - Symbol := 285; - Code := aLitTree.Encodes^[Symbol]; - {$ENDIF} - - {output the length code} - {$IFOPT C+} - aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF); - {$ELSE} - with aBitStrm do begin - BitBuffer := BitBuffer or ((Code and $FFFF) shl BitsUsed); - BitsUsed := BitsUsed + ((Code shr 16) and $FF); - if (BitsUsed >= 32) then - WriteMoreBits(Code and $FFFF, (Code shr 16) and $FF); - end; - {$ENDIF} - - {if the length symbol were 285, its definition changes from Deflate - to Deflate64, so make it a special case: for Deflate there are no - extra bits, for Deflate64 output the (length - 3) as 16 bits} - if (Symbol = 285) then begin - if aUseDeflate64 then begin - {$IFOPT C+} - aBitStrm.WriteBits(Len - 3, 16); - {$ELSE} - with aBitStrm do begin - BitBuffer := BitBuffer or ((Len - 3) shl BitsUsed); - BitsUsed := BitsUsed + 16; - if (BitsUsed >= 32) then - WriteMoreBits(Len - 3, 16); - end; - {$ENDIF} - end; - end - - {otherwise if there are extra bits to be output for this length, - calculate them and output them} - else begin - ExtraBits := Code shr 24; - if (ExtraBits <> 0) then begin - {$IFOPT C+} - aBitStrm.WriteBits((Len - dfc_LengthBase[Symbol - 257]), - ExtraBits); - {$ELSE} - with aBitStrm do begin - BitBuffer := BitBuffer or - ((Len - dfc_LengthBase[Symbol - 257]) shl BitsUsed); - BitsUsed := BitsUsed + ExtraBits; - if (BitsUsed >= 32) then - WriteMoreBits((Len - dfc_LengthBase[Symbol - 257]), - ExtraBits); - end; - {$ENDIF} - end; - end; - - {DO THE DISTANCE NEXT------------------------------------------} - {get the distance from the stream} - Dist := integer(PWord(CurPos)^) + 1; - inc(CurPos, sizeof(word)); - - {translate it to a symbol and convert that to a code using the - distance huffman tree} - {$IFOPT C+} {if Assertions are on} - Symbol := AbSymbolTranslator.TranslateDistance(Dist); - Assert(aUseDeflate64 or (Symbol < 30), - 'TAbDfLZStream.Encode: a Deflate64 distance symbol has been generated for Deflate'); - Code := aDistTree.Encode(Symbol); - {$ELSE} - if (Dist <= 256) then - Symbol := AbSymbolTranslator.ShortDistSymbols[Dist - 1] - else if (Dist <= 32768) then - Symbol := AbSymbolTranslator.MediumDistSymbols[((Dist - 1) div 128) - 2] - else - Symbol := AbSymbolTranslator.LongDistSymbols[((Dist - 1) div 16384) - 2]; - Code := aDistTree.Encodes^[Symbol]; - {$ENDIF} - - {output the distance code} - {$IFOPT C+} - aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF); - {$ELSE} - with aBitStrm do begin - BitBuffer := BitBuffer or ((Code and $FFFF) shl BitsUsed); - BitsUsed := BitsUsed + ((Code shr 16) and $FF); - if (BitsUsed >= 32) then - WriteMoreBits(Code and $FFFF, (Code shr 16) and $FF); - end; - {$ENDIF} - - {if there are extra bits to be output for this distance, calculate - them and output them} - ExtraBits := Code shr 24; - if (ExtraBits <> 0) then begin - {$IFOPT C+} - aBitStrm.WriteBits((Dist - dfc_DistanceBase[Symbol]), - ExtraBits); - {$ELSE} - with aBitStrm do begin - BitBuffer := BitBuffer or - ((Dist - dfc_DistanceBase[Symbol]) shl BitsUsed); - BitsUsed := BitsUsed + ExtraBits; - if (BitsUsed >= 32) then - WriteMoreBits((Dist - dfc_DistanceBase[Symbol]), - ExtraBits); - end; - {$ENDIF} - end; - end; - end; - -{clear the stream; ready for some more items} -{ Clear;} -end; -{--------} -function TAbDfLZStream.lzsGetApproxSize : LongWord; -var - i : integer; -begin - {note: calculates an approximate compressed size without taking too - long about it. The average encoded bit length for literals - and lengths is assumed to be 8. Distances are assumed to - follow the static tree definition (ie, 5 bits per distance, - plus any extra bits). - There are FLitCount literals, FDistCount lengths, and - FDistCount distances} - Result := (13 * FDistCount) + (8 * FLitCount); - for i := 4 to 31 do - inc(Result, FDistBuckets^[i] * dfc_DistExtraBits[i]); - Result := Result div 8; -end; -{--------} -function TAbDfLZStream.lzsGetStaticSize : integer; -var - i : integer; -begin - Result := 0; - for i := 0 to 143 do - inc(Result, FLitBuckets^[i] * 8); - for i := 144 to 255 do - inc(Result, FLitBuckets^[i] * 9); - inc(Result, FLitBuckets^[256] * 7); - for i := 257 to 279 do - inc(Result, FLitBuckets^[i] * - (7 + dfc_LitExtraBits[i - dfc_LitExtraOffset])); - for i := 280 to 284 do - inc(Result, FLitBuckets^[i] * - (8 + dfc_LitExtraBits[i - dfc_LitExtraOffset])); - if FUseDeflate64 then - inc(Result, FLitBuckets^[285] * (8 + 16)) - else - inc(Result, FLitBuckets^[285] * 8); - - for i := 0 to 31 do - inc(Result, FDistBuckets^[i] * (5 + dfc_DistExtraBits[i])); -end; -{--------} -function TAbDfLZStream.lzsGetStoredSize : integer; -begin - Result := FStoredSize; -{Result := FSlideWin.Position - FStartOfs;} -end; -{--------} -function TAbDfLZStream.lzsIsFull : boolean; -begin - {if the number of hits on the (eventual) literal tree is a multiple - of 8192, the stream is full if the majority were straight literals - and we're getting approx 50% compression} - if (((FLitCount + FDistCount) and $1FFF) = 0) then begin - Result := (FDistCount < FLitCount) and - (lzsGetApproxSize < (FStoredSize div 2)); - if Result then - Exit; - end; - - {otherwise the stream is full if the number of hits on the literal - tree or on the distance tree is 32768} -{ Result := (FCurPos - FStream) > (StreamSIze - 100);} - Result := (FDistCount >= 32768) or - ((FLitCount + FDistCount) >= 32768); -end; -{--------} -procedure TAbDfLZStream.ReadStoredBuffer(var aBuffer; aCount : integer); -begin - FSlideWin.ReadBuffer(aBuffer, aCount, FStartOfs); - inc(FStartOfs, aCount); -end; -{--------} -procedure TAbDfLZStream.Rewind; -begin - {position the stream at the beginning} - FStrmEnd := FCurPos; - FCurPos := FStream; -end; -{====================================================================} - - -{===TAbDfCodeLenStream===============================================} -constructor TAbDfCodeLenStream.Create(aLog : TAbLogger); -begin - {create the ancestor} - inherited Create; - - {allocate the stream (to contain all literals and distances and - possible extra data} - GetMem(FStream, (285 + 32) * 2); - FPosition := FStream; - - {allocate the buckets} - FBuckets := AllocMem(sizeof(TAbDfCodeLenBuckets)); -end; -{--------} -destructor TAbDfCodeLenStream.Destroy; -begin - {free the stream} - if (FStream <> nil) then - FreeMem(FStream); - - {free the buckets} - if (FBuckets <> nil) then - Dispose(FBuckets); - - {destroy the ancestor} - inherited Destroy; -end; -{--------} -procedure TAbDfCodeLenStream.Build(const aCodeLens : array of integer; - aCount : integer); -var - i : integer; - State : (ScanStart, ScanNormal, Got2nd, Got3rd); - Count : integer; - ThisCount : integer; - CodeLen : integer; - PrevCodeLen : integer; - CurPos : PAnsiChar; - Buckets : PAbDfCodeLenBuckets; -begin - {start the automaton} - State := ScanStart; - CurPos := FStream; - Buckets := FBuckets; - Count := 0; - PrevCodeLen := 0; - - {for all the codelengths in the array (plus a fake one at the end to - ensure all codeslengths are counted)...} - for i := 0 to aCount do begin - - {get the current codelength} - if (i = aCount) then - CodeLen := -1 - else - CodeLen := aCodeLens[i]; - - {switch based on the state...} - case State of - ScanStart : - begin - PrevCodeLen := CodeLen; - State := ScanNormal; - end; - - ScanNormal : - begin - {if the current code is the same as the previous, move to - the next state} - if (CodeLen = PrevCodeLen) then - State := Got2nd - - {otherwise output the previous code} - else begin - CurPos^ := AnsiChar(PrevCodeLen); - inc(CurPos); - inc(Buckets^[PrevCodeLen]); - PrevCodeLen := CodeLen; - end; - end; - - Got2nd : - begin - {if the current code is the same as the previous, move to - the next state; we now have three similar codes in a row} - if (CodeLen = PrevCodeLen) then begin - State := Got3rd; - Count := 3; - end - - {otherwise output the previous two similar codes, move back - to the initial state} - else begin - CurPos^ := AnsiChar(PrevCodeLen); - inc(CurPos); - CurPos^ := AnsiChar(PrevCodeLen); - inc(CurPos); - inc(Buckets^[PrevCodeLen], 2); - PrevCodeLen := CodeLen; - State := ScanNormal; - end; - end; - - Got3rd: - begin - {if the current code is the same as the previous, increment - the count of similar codes} - if (CodeLen = PrevCodeLen) then - inc(Count) - - {otherwise we need to output the repeat values...} - else begin - - {if the previous code were a zero code...} - if (PrevCodeLen = 0) then begin - - {while there are zero codes to be output...} - while (Count <> 0) do begin - - {if there are less than three zero codes, output them - individually} - if (Count < 3) then begin - while (Count <> 0) do begin - CurPos^ := #0; - inc(CurPos); - inc(Buckets^[0]); - dec(Count); - end; - end - - {if there are less than 11 successive zero codes, - output a 17 code and the count of zeros} - else if (Count < 11) then begin - CurPos^ := #17; - inc(CurPos); - inc(Buckets^[17]); - CurPos^ := AnsiChar(Count - 3); - inc(CurPos); - Count := 0; - end - - {otherwise output an 18 code and the count of zeros} - else begin - ThisCount := Count; - if (ThisCount > 138) then - ThisCount := 138; - CurPos^ := #18; - inc(CurPos); - inc(Buckets^[18]); - CurPos^ := AnsiChar(ThisCount - 11); - inc(CurPos); - dec(Count, ThisCount); - end; - end; - end - - {otherwise the previous code was a non-zero code...} - else begin - - {output the first code} - CurPos^ := AnsiChar(PrevCodeLen); - inc(CurPos); - inc(Buckets^[PrevCodeLen]); - dec(Count); - - {while there are more codes to be output...} - while (Count <> 0) do begin - - {if there are less than three codes, output them - individually} - if (Count < 3) then begin - while (Count <> 0) do begin - CurPos^ := AnsiChar(PrevCodeLen); - inc(CurPos); - inc(Buckets^[PrevCodeLen]); - dec(Count); - end; - end - - {otherwise output an 16 code and the count} - else begin - ThisCount := Count; - if (ThisCount > 6) then - ThisCount := 6; - CurPos^ := #16; - inc(CurPos); - inc(Buckets^[16]); - CurPos^ := AnsiChar(ThisCount - 3); - inc(CurPos); - dec(Count, ThisCount); - end; - end; - end; - - {move back to the initial state} - PrevCodeLen := CodeLen; - State := ScanNormal; - end; - end; - end; - end; - - {set the read position} - FStrmEnd := CurPos; - FPosition := FStream; -end; -{--------} -procedure TAbDfCodeLenStream.Encode(aBitStrm : TAbDfOutBitStream; - aTree : TAbDfDecodeHuffmanTree); -var - Symbol : integer; - ExtraData : integer; - Code : longint; - CurPos : PAnsiChar; - StrmEnd : PAnsiChar; -begin - {prepare for the loop} - CurPos := FPosition; - StrmEnd := FStrmEnd; - - {while there are tokens in the stream...} - while (CurPos <> StrmEnd) do begin - - {get the next symbol} - Symbol := ord(CurPos^); - inc(CurPos); - - {if the symbol is 0..15, get the code and output it} - if (Symbol <= 15) then begin - {$IFOPT C+} {if Assertions are on} - Code := aTree.Encode(Symbol); - {$ELSE} - Code:= aTree.Encodes^[Symbol]; - {$ENDIF} - aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF); - end - - {otherwise the symbol is 16, 17, or 18} - else begin - {get the extra data} - ExtraData := ord(CurPos^); - inc(CurPos); - {get the code and output it} - {$IFOPT C+} {if Assertions are on} - Code := aTree.Encode(Symbol); - {$ELSE} - Code:= aTree.Encodes^[Symbol]; - {$ENDIF} - aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF); - if (Symbol = 16) then - aBitStrm.WriteBits(ExtraData, 2) - else if (Symbol = 17) then - aBitStrm.WriteBits(ExtraData, 3) - else {Symbol = 18} - aBitStrm.WriteBits(ExtraData, 7); - end; - end; -end; -{====================================================================} - -end. diff --git a/components/Abbrevia/source/AbDfXlat.pas b/components/Abbrevia/source/AbDfXlat.pas deleted file mode 100644 index ae67b07..0000000 --- a/components/Abbrevia/source/AbDfXlat.pas +++ /dev/null @@ -1,194 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDfXlat.pas *} -{*********************************************************} -{* Deflate length/dist to symbol translator *} -{*********************************************************} - -unit AbDfXlat; - -{$I AbDefine.inc} - -interface - -uses - SysUtils; - -type - TAbDfTranslator = class - private - FBuffer : PAnsiChar; - FLenSymbols : PByteArray; - {for lengths 3..258} - FLongDistSymbols : PByteArray; - {for distances 32769..65536 (deflate64)} - FMediumDistSymbols : PByteArray; - {for distances 257..32768} - FShortDistSymbols : PByteArray; - {for distances 1..256} - protected - procedure trBuild; - public - constructor Create; - destructor Destroy; override; - - function TranslateLength(aLen : integer): integer; - function TranslateDistance(aDist : integer) : integer; - - property LenSymbols : PByteArray read FLenSymbols; - property LongDistSymbols : PByteArray read FLongDistSymbols; - property MediumDistSymbols : PByteArray read FMediumDistSymbols; - property ShortDistSymbols : PByteArray read FShortDistSymbols; - end; - -var - AbSymbolTranslator : TAbDfTranslator; - -implementation - -uses - AbDfBase; - -{====================================================================} -constructor TAbDfTranslator.Create; -begin - {create the ancestor} - inherited Create; - - {allocate the translation arrays (the buffer *must* be zeroed)} - FBuffer := AllocMem(256 + 2 + 256 + 256); - FLenSymbols := PByteArray(FBuffer); - FLongDistSymbols := PByteArray(FBuffer + 256); - FMediumDistSymbols := PByteArray(FBuffer + 256 + 2); - FShortDistSymbols := PByteArray(FBuffer + 256 + 2 + 256); - - {build the translation arrays} - trBuild; -end; -{--------} -destructor TAbDfTranslator.Destroy; -begin - if (FBuffer <> nil) then - FreeMem(FBuffer); - inherited Destroy; -end; -{--------} -function TAbDfTranslator.TranslateDistance(aDist : integer) : integer; -begin - {save against dumb programming mistakes} - Assert((1 <= aDist) and (aDist <= 65536), - 'TAbDfTranslator.Translate: distance should be 1..65536'); - - {translate the distance} - if (aDist <= 256) then - Result := FShortDistSymbols[aDist - 1] - else if (aDist <= 32768) then - Result := FMediumDistSymbols[((aDist - 1) div 128) - 2] - else - Result := FLongDistSymbols[((aDist - 1) div 16384) - 2]; -end; -{--------} -function TAbDfTranslator.TranslateLength(aLen : integer): integer; -begin - {save against dumb programming mistakes} - Assert((3 <= aLen) and (aLen <= 65536), - 'TAbDfTranslator.Translate: length should be 3..65536'); - - {translate the length} - dec(aLen, 3); - if (0 <= aLen) and (aLen <= 255) then - Result := FLenSymbols[aLen] + 257 - else - Result := 285; -end; -{--------} -procedure TAbDfTranslator.trBuild; -var - i : integer; - Len : integer; - Dist : integer; - Value : integer; -begin - {initialize the length translation array; elements will contain - (Symbol - 257) for a given (length - 3)} - for i := low(dfc_LengthBase) to pred(high(dfc_LengthBase)) do begin - Len := dfc_LengthBase[i] - 3; - FLenSymbols[Len] := i; - end; - FLenSymbols[255] := 285 - 257; - Value := -1; - for i := 0 to 255 do begin - if (Value < FLenSymbols[i]) then - Value := FLenSymbols[i] - else - FLenSymbols[i] := Value; - end; - - {initialize the short distance translation array: it will contain - the Symbol for a given (distance - 1) where distance <= 256} - for i := 0 to 15 do begin - Dist := dfc_DistanceBase[i] - 1; - FShortDistSymbols[Dist] := i; - end; - Value := -1; - for i := 0 to 255 do begin - if (Value < FShortDistSymbols[i]) then - Value := FShortDistSymbols[i] - else - FShortDistSymbols[i] := Value; - end; - - {initialize the medium distance translation array: it will contain - the Symbol for a given (((distance - 1) div 128) - 2) where - distance is in the range 256..32768} - for i := 16 to 29 do begin - Dist := ((dfc_DistanceBase[i] - 1) div 128) - 2; - FMediumDistSymbols[Dist] := i; - end; - Value := -1; - for i := 0 to 255 do begin - if (Value < FMediumDistSymbols[i]) then - Value := FMediumDistSymbols[i] - else - FMediumDistSymbols[i] := Value; - end; - - {initialize the long distance translation array: it will contain the - Symbol for a given ((distance - 1) div 16384) - 2) for distances - over 32768 in deflate64} - FLongDistSymbols[0] := 30; - FLongDistSymbols[1] := 31; -end; -{====================================================================} - -initialization - AbSymbolTranslator := TAbDfTranslator.Create; - -finalization - AbSymbolTranslator.Free; - -end. diff --git a/components/Abbrevia/source/AbDlgDir.dfm b/components/Abbrevia/source/AbDlgDir.dfm deleted file mode 100644 index a2e7057..0000000 Binary files a/components/Abbrevia/source/AbDlgDir.dfm and /dev/null differ diff --git a/components/Abbrevia/source/AbDlgDir.pas b/components/Abbrevia/source/AbDlgDir.pas deleted file mode 100644 index 72ebaac..0000000 --- a/components/Abbrevia/source/AbDlgDir.pas +++ /dev/null @@ -1,243 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDlgDir.pas *} -{*********************************************************} -{* ABBREVIA: Dialog - Directory *} -{* Use AbQDgDir.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbDlgDir; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, Messages, ShlObj, ActiveX, -{$ENDIF} - SysUtils, Classes, -{$IFDEF UsingClx} - QButtons, QExtCtrls, QGraphics, QForms, QControls, QStdCtrls, -{$ELSE} - Buttons, ExtCtrls, Graphics, Forms, Controls, StdCtrls, - {$WARN UNIT_PLATFORM OFF} - FileCtrl, - {$WARN UNIT_PLATFORM ON} -{$ENDIF} - AbResString; - -type -{$IFNDEF UsingClx} - TDirDlg = class(TForm) - OKBtn: TButton; - CancelBtn: TButton; - Bevel1: TBevel; - DriveComboBox1: TDriveComboBox; - DirectoryListBox1: TDirectoryListBox; - Panel1: TPanel; - procedure DirectoryListBox1Change(Sender: TObject); - procedure FormCreate(Sender: TObject); - public - SelectedFolder: string; - end; -{$ELSE} - TDirDlg = class(TForm) - OKBtn: TButton; - CancelBtn: TButton; - Bevel1: TBevel; - Panel1: TPanel; - procedure DirectoryListBox1Change(Sender: TObject); - procedure FormCreate(Sender: TObject); - public - SelectedFolder: string; - end; -{$ENDIF} - - -{$IFDEF MSWINDOWS} -type - TAbDirDlg = class(TComponent) - protected {private} - FAdditionalText : string; - FCaption : string; - FHandle : Integer; - FIDList : PItemIDList; - FSelectedFolder : string; - - procedure SetSelectedFolder(const Value : string); - procedure FreeIDList; - - public {properties} - property AdditionalText : string - read FAdditionalText - write FAdditionalText; - property Caption : string - read FCaption - write FCaption; - property Handle : Integer - read FHandle; - property IDList : PItemIDList - read FIDList; - property SelectedFolder : string - read FSelectedFolder - write SetSelectedFolder; - - public {methods} - constructor Create(AOwner : TComponent); - override; - destructor Destroy; - override; - function Execute : Boolean; - end; -{$ENDIF} - -var - DirDlg: TDirDlg; - -implementation - -{$IFNDEF UsingCLX} -{$R *.dfm} -{$ENDIF} - -{== TAbDirDlg ========================================================} -{$IFDEF MSWINDOWS} -function AbDirDlgCallbackProc(hWnd : HWND; Msg : UINT; lParam : LPARAM; - Data : LPARAM): Integer; stdcall; -var - X, Y : Integer; - R : TRect; - Buf : array[0..MAX_PATH-1] of Char; -begin - Result := 0; - with TAbDirDlg(Data) do begin - case Msg of - BFFM_INITIALIZED : - begin - FHandle := hWnd; - if (FCaption <> '') then - SendMessage(hWnd, WM_SETTEXT, 0, Integer(PChar(FCaption))); - SendMessage(hWnd, BFFM_SETSELECTION, 1, Integer(PChar(SelectedFolder))); - GetWindowRect(hWnd, R); - X := (Screen.Width div 2) - ((R.Right - R.Left) div 2); - Y := (Screen.Height div 2) - ((R.Bottom - R.Top) div 2); - SetWindowPos(hWnd, 0, X, Y, 0, 0, SWP_NOSIZE or SWP_NOZORDER); - end; - BFFM_SELCHANGED : - if (FHandle <> 0) then begin - FIDList := PItemIDList(lParam); - SHGetPathFromIDList(IDList, Buf); - SelectedFolder := Buf; - end; - end; - end; -end; -{ -------------------------------------------------------------------------- } -constructor TAbDirDlg.Create(AOwner : TComponent); -begin - inherited Create(AOwner); -end; -{ -------------------------------------------------------------------------- } -destructor TAbDirDlg.Destroy; -begin - if FIDList <> nil then - FreeIDList; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbDirDlg.Execute : Boolean; -var - Info : TBrowseInfo; - Buf : array[0..MAX_PATH-1] of Char; -begin - if (FIDList <> nil) then - FreeIDList; - -{$IFNDEF UsingClx} - if (Owner is TWinControl) then - Info.hwndOwner := (Owner as TWinControl).Handle - else if Owner is TApplication then - Info.hwndOwner := (Owner as TApplication).Handle - else -{$ENDIF} - Info.hwndOwner := 0; - Info.pidlRoot := nil; - Info.pszDisplayName := Buf; - Info.lpszTitle := PChar(FAdditionalText); - Info.ulFlags := BIF_RETURNONLYFSDIRS; - Info.lpfn := AbDirDlgCallbackProc; - Info.lParam := Integer(Self); - Info.iImage := 0; - - FIDList := SHBrowseForFolder(Info); - FHandle := 0; - Result := (FIDList <> nil); -end; -{ -------------------------------------------------------------------------- } -procedure TAbDirDlg.FreeIDList; -var - Malloc : IMalloc; -begin - if coGetMalloc(MEMCTX_TASK, Malloc) = NOERROR then begin - Malloc.Free(FIDList); - FIDList := nil; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbDirDlg.SetSelectedFolder(const Value : string); -begin - FSelectedFolder := Value; - if FSelectedFolder <> '' then - if FSelectedFolder[Length(FSelectedFolder)] = '\' then - Delete(FSelectedFolder, Length(FSelectedFolder), 1); - if (Length(FSelectedFolder) = 2) then - FSelectedFolder := FSelectedFolder + '\'; -end; -{$ENDIF} - -{== TDirDlg ========================================================} -{ TDirDlg } -procedure TDirDlg.FormCreate(Sender: TObject); -begin - DirectoryListBox1Change(nil); - OKBtn.Caption := AbOKS; - CancelBtn.Caption := AbCancelS; - Caption := AbSelectDirectoryS; -end; -{ -------------------------------------------------------------------------- } -procedure TDirDlg.DirectoryListBox1Change(Sender: TObject); -begin -{$IFNDEF UsingClx} - SelectedFolder := DirectoryListBox1.Directory; -{$ENDIF} - Panel1.Caption := SelectedFolder; -end; - -end. diff --git a/components/Abbrevia/source/AbDlgPwd.dfm b/components/Abbrevia/source/AbDlgPwd.dfm deleted file mode 100644 index 2feaf52..0000000 Binary files a/components/Abbrevia/source/AbDlgPwd.dfm and /dev/null differ diff --git a/components/Abbrevia/source/AbDlgPwd.pas b/components/Abbrevia/source/AbDlgPwd.pas deleted file mode 100644 index 7107076..0000000 --- a/components/Abbrevia/source/AbDlgPwd.pas +++ /dev/null @@ -1,130 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbDlgPwd.pas *} -{*********************************************************} -{* ABBREVIA: Dialog - Password *} -{* Use AbQDgPwd.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbDlgPwd; - -{$R *.dfm} -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses - SysUtils, -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF LibcAPI} - Libc, -{$ENDIF} -{$IFDEF UsingClx} - QGraphics, QForms, QControls, QStdCtrls, - QButtons, QExtCtrls, -{$ELSE} - Graphics, Forms, Controls, StdCtrls, - Buttons, ExtCtrls, -{$ENDIF} - Classes; - -type - TPassWordDlg = class(TForm) - OKBtn: TButton; - CancelBtn: TButton; - Bevel1: TBevel; - Edit1: TEdit; -{$IFDEF MSWINDOWS} - Edit2: TEdit; -{$ENDIF} - Label1: TLabel; -{$IFDEF MSWINDOWS} - Label2: TLabel; -{$ENDIF} - procedure Edit1Change(Sender: TObject); - procedure Edit2Change(Sender: TObject); - procedure FormActivate(Sender: TObject); - procedure FormCreate(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - PassWordDlg: TPassWordDlg; - -implementation - -uses - AbResString; - -procedure TPassWordDlg.Edit1Change(Sender: TObject); -begin -{$IFDEF MSWINDOWS} - Edit2.Text := ''; - OKBtn.Enabled := ( CompareStr( Edit1.Text, Edit2.Text ) = 0); -{$ELSE} - OKBtn.Enabled := true; -{$ENDIF} -end; - -procedure TPassWordDlg.Edit2Change(Sender: TObject); -begin -{$IFDEF MSWINDOWS} - OKBtn.Enabled := ( CompareStr( Edit1.Text, Edit2.Text ) = 0); -{$ELSE} - OKBtn.Enabled := true; -{$ENDIF} -end; - -procedure TPassWordDlg.FormActivate(Sender: TObject); -begin -{$IFDEF MSWINDOWS} - OKBtn.Enabled := ( CompareStr( Edit1.Text, Edit2.Text ) = 0); -{$ELSE} - OKBtn.Enabled := true; -{$ENDIF} -end; - -procedure TPassWordDlg.FormCreate(Sender: TObject); -begin - Caption := AbEnterPasswordS; - OKBtn.Caption := AbOKS; - CancelBtn.Caption := AbCancelS; - Label1.Caption := AbPasswordS; -{$IFDEF MSWINDOWS} - Label2.Caption := AbVerifyS; -{$ENDIF} -end; - -end. diff --git a/components/Abbrevia/source/AbExcept.pas b/components/Abbrevia/source/AbExcept.pas deleted file mode 100644 index aa377e4..0000000 --- a/components/Abbrevia/source/AbExcept.pas +++ /dev/null @@ -1,847 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbExcept.pas *} -{*********************************************************} -{* ABBREVIA: Exception classes *} -{*********************************************************} - -unit AbExcept; - -{$I AbDefine.inc} - -interface - -uses - SysUtils, - AbUtils; - -type - EAbException = class( Exception ) - public - ErrorCode : Integer; - end; - - EAbArchiveBusy = class( EAbException ) - public - constructor Create; - end; - - EAbBadStream = class( EAbException ) - protected - FInnerException : Exception; - public - constructor Create; - constructor CreateInner(aInnerException : Exception); - property InnerException : Exception read FInnerException; - end; - - EAbDuplicateName = class( EAbException ) - public - constructor Create; - end; - - EAbFileNotFound = class( EAbException ) - public - constructor Create; - end; - - EAbNoArchive = class( EAbException ) - public - constructor Create; - end; - - EAbUserAbort = class( EAbException ) - public - constructor Create; - end; - - EAbNoSuchDirectory = class( EAbException ) - public - constructor Create; - end; - - EAbUnhandledType = class( EAbException ) - public - constructor Create; - end; - - EAbSpanningNotSupported = class (EAbException) - public - constructor Create; - end; - - EAbInvalidSpanningThreshold = class ( EAbException ) - public - constructor Create; - end; - - EAbZipException = class( EAbException ); {Zip exception} - EAbCabException = class( EAbException ); {Cab exception} - EAbTarException = class( EAbException ); {Tar Exception} - EAbGzipException = class( EAbException); {GZip exception} - - EAbZipBadSpanStream = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipBadCRC = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipInflateBlock = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipInvalid = class( EAbZipException ) - public - constructor Create; - end; - - EAbInvalidIndex = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipInvalidFactor = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipInvalidLFH = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipInvalidMethod = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipInvalidPassword = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipInvalidStub= class( EAbZipException ) - public - constructor Create; - end; - - EAbZipNoExtraction = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipNoInsertion = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipSpanOverwrite= class( EAbZipException ) - public - constructor Create; - end; - - EAbZipStreamFull = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipTruncate = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipUnsupported = class( EAbZipException ) - public - constructor Create; - end; - - EAbZipVersion = class( EAbZipException ) - public - constructor Create; - end; - - EAbReadError = class( EAbZipException ) - public - constructor Create; - end; - - EAbGzipBadCRC = class( EAbGZipException ) - public - constructor Create; - end; - - EAbGzipBadFileSize = class( EAbGZipException ) - public - constructor Create; - end; - - EAbGzipInvalid = class( EAbGZipException ) - public - constructor Create; - end; - - EAbTarInvalid = class( EAbTarException) - public - constructor Create; - end; - - EAbTarBadFileName = class( EAbTarException) - public - constructor Create; - end; - - EAbTarBadLinkName = class( EAbTarException) - public - constructor Create; - end; - - EAbTarBadOp = class( EAbTarException) - public - constructor Create; - end; - - EAbVMSInvalidOrigin = class( EAbZipException ) - public - constructor Create( Value : Integer ); - end; - - EAbVMSErrorOpenSwap = class( EAbZipException ) - public - constructor Create( const Value : string ); - end; - - EAbVMSSeekFail = class( EAbZipException ) - public - constructor Create( const Value : string ); - end; - - EAbVMSReadFail = class( EAbZipException ) - public - constructor Create( Count : Integer; const Value : string ); - end; - - EAbVMSWriteFail = class( EAbZipException ) - public - constructor Create( Count : Integer; const Value : string ); - end; - - EAbVMSWriteTooManyBytes = class( EAbZipException ) - public - constructor Create( Count : Integer ); - end; - - EAbBBSReadTooManyBytes = class( EAbZipException ) - public - constructor Create(Count : Integer ); - end; - - EAbBBSSeekOutsideBuffer = class( EAbZipException ) - public - constructor Create; - end; - - EAbBBSInvalidOrigin = class( EAbZipException ) - public - constructor Create; - end; - - EAbBBSWriteTooManyBytes = class( EAbZipException ) - public - constructor Create(Count : Integer ); - end; - - EAbSWSNotEndofStream = class( EAbZipException ) - public - constructor Create; - end; - - EAbSWSSeekFailed = class( EAbZipException ) - public - constructor Create; - end; - - EAbSWSWriteFailed = class( EAbZipException ) - public - constructor Create; - end; - - EAbSWSInvalidOrigin = class( EAbZipException ) - public - constructor Create; - end; - - EAbSWSInvalidNewOrigin = class( EAbZipException ) - public - constructor Create; - end; - - EAbNoCabinetDll = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFileOpenError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFileReadError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFileWriteError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFileCloseError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFileSeekError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFileDeleteError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIAddFileError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCICreateError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFlushCabinetError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFCIFlushFolderError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFDICopyError = class( EAbCabException ) - public - constructor Create; - end; - - EAbFDICreateError = class( EAbCabException ) - public - constructor Create; - end; - - EAbInvalidCabTemplate = class( EAbCabException ) - public - constructor Create; - end; - - EAbInvalidCabFile = class( EAbCabException ) - public - constructor Create; - end; - - EAbFileTooLarge = class(EAbException) - public - constructor Create; - end; - - procedure AbConvertException( const E : Exception; - var eClass : TAbErrorClass; - var eErrorCode : Integer ); - - -implementation - -uses - Classes, - AbConst, - AbResString; - -constructor EAbArchiveBusy.Create; -begin - inherited Create(AbArchiveBusyS); - ErrorCode := AbArchiveBusy; -end; - -constructor EAbBadStream.Create; -begin - inherited Create(AbBadStreamTypeS); - FInnerException := nil; - ErrorCode := AbBadStreamType; -end; - -constructor EAbBadStream.CreateInner(aInnerException: Exception); -begin - inherited Create(AbBadStreamTypeS + #13#10 + aInnerException.Message); - FInnerException := aInnerException; - ErrorCode := AbBadStreamType; -end; - - -constructor EAbDuplicateName.Create; -begin - inherited Create(AbDuplicateNameS); - ErrorCode := AbDuplicateName; -end; - -constructor EAbNoSuchDirectory.Create; -begin - inherited Create(AbNoSuchDirectoryS); - ErrorCode := AbNoSuchDirectory; -end; - -constructor EAbInvalidSpanningThreshold.Create; -begin - inherited Create(AbInvalidThresholdS); - ErrorCode := AbInvalidThreshold; -end; - -constructor EAbFileNotFound.Create; -begin - inherited Create(AbFileNotFoundS); - ErrorCode := AbFileNotFound; -end; - -constructor EAbNoArchive.Create; -begin - inherited Create(AbNoArchiveS); - ErrorCode := AbNoArchive; -end; - -constructor EAbUserAbort.Create; -begin - inherited Create(AbUserAbortS); - ErrorCode := AbUserAbort; -end; - -constructor EAbZipBadSpanStream.Create; -begin - inherited Create(AbBadSpanStreamS); - ErrorCode := AbBadSpanStream; -end; - -constructor EAbZipBadCRC.Create; -begin - inherited Create(AbZipBadCRCS); - ErrorCode := AbZipBadCRC; -end; - -constructor EAbZipInflateBlock.Create; -begin - inherited Create(AbInflateBlockErrorS); - ErrorCode := AbInflateBlockError; -end; - -constructor EAbZipInvalid.Create; -begin - inherited Create(AbErrZipInvalidS); - ErrorCode := AbErrZipInvalid; -end; - -constructor EAbInvalidIndex.Create; -begin - inherited Create(AbInvalidIndexS); - ErrorCode := AbInvalidIndex; -end; - -constructor EAbZipInvalidFactor.Create; -begin - inherited Create(AbInvalidFactorS); - ErrorCode := AbInvalidFactor; -end; - -constructor EAbZipInvalidLFH.Create; -begin - inherited Create(AbInvalidLFHS); - ErrorCode := AbInvalidLFH; -end; - -constructor EAbZipInvalidMethod.Create; -begin - inherited Create(AbUnknownCompressionMethodS); - ErrorCode := AbUnknownCompressionMethod; -end; - -constructor EAbZipInvalidPassword.Create; -begin - inherited Create(AbInvalidPasswordS); - ErrorCode := AbInvalidPassword; -end; - -constructor EAbZipInvalidStub.Create; -begin - inherited Create(AbZipBadStubS); - ErrorCode := AbZipBadStub; -end; - -constructor EAbZipNoExtraction.Create; -begin - inherited Create(AbNoExtractionMethodS); - ErrorCode := AbNoExtractionMethod; -end; - -constructor EAbZipNoInsertion.Create; -begin - inherited Create(AbNoInsertionMethodS); - ErrorCode := AbNoInsertionMethod; -end; - -constructor EAbZipSpanOverwrite.Create; -begin - inherited Create(AbNoOverwriteSpanStreamS); - ErrorCode := AbNoOverwriteSpanStream; -end; - -constructor EAbZipStreamFull.Create; -begin - inherited Create(AbStreamFullS); - ErrorCode := AbStreamFull; -end; - -constructor EAbZipTruncate.Create; -begin - inherited Create(AbTruncateErrorS); - ErrorCode := AbTruncateError; -end; - -constructor EAbZipUnsupported.Create; -begin - inherited Create(AbUnsupportedCompressionMethodS); - ErrorCode := AbUnsupportedCompressionMethod; -end; - -constructor EAbZipVersion.Create; -begin - inherited Create(AbZipVersionNeededS); - ErrorCode := AbZipVersionNeeded; -end; - -constructor EAbReadError.Create; -begin - inherited Create(AbReadErrorS); - ErrorCode := AbReadError; -end; - -constructor EAbVMSInvalidOrigin.Create( Value : Integer ); -begin - inherited Create(Format(AbVMSInvalidOriginS, [Value])); - ErrorCode := AbVMSInvalidOrigin; -end; - -constructor EAbBBSReadTooManyBytes.Create(Count : Integer ); -begin - inherited Create(Format(AbBBSReadTooManyBytesS, [Count])); - ErrorCode := AbBBSReadTooManyBytes; -end; - -constructor EAbBBSSeekOutsideBuffer.Create; -begin - inherited Create(AbBBSSeekOutsideBufferS); - ErrorCode := AbBBSSeekOutsideBuffer; -end; - -constructor EAbBBSInvalidOrigin.Create; -begin - inherited Create(AbBBSInvalidOriginS); - ErrorCode := AbBBSInvalidOrigin; -end; - -constructor EAbBBSWriteTooManyBytes.Create(Count : Integer); -begin - inherited Create(Format(AbBBSWriteTooManyBytesS, [Count])); - ErrorCode := AbBBSWriteTooManyBytes; -end; - -constructor EAbVMSErrorOpenSwap.Create( const Value : string ); -begin - inherited Create(Format(AbVMSErrorOpenSwapS, [Value])); - ErrorCode := AbVMSErrorOpenSwap; -end; - -constructor EAbVMSSeekFail.Create( const Value : string ); -begin - inherited Create(Format(AbVMSSeekFailS, [Value])); - ErrorCode := AbVMSSeekFail; -end; - -constructor EAbVMSReadFail.Create( Count : Integer; const Value : string ); -begin - inherited Create(Format(AbVMSReadFailS, [Count, Value])); - ErrorCode := AbVMSReadFail; -end; - -constructor EAbVMSWriteFail.Create( Count : Integer; const Value : string ); -begin - inherited Create(Format(AbVMSWriteFailS, [Count, Value])); - ErrorCode := AbVMSWriteFail; -end; - -constructor EAbVMSWriteTooManyBytes.Create( Count : Integer ); -begin - inherited Create(Format(AbVMSWriteTooManyBytesS, [Count])); - ErrorCode := AbVMSWriteTooManyBytes; -end; - -constructor EAbSWSNotEndofStream.Create; -begin - inherited Create(AbSWSNotEndofStreamS); - ErrorCode := AbSWSNotEndofStream; -end; - -constructor EAbSWSSeekFailed.Create; -begin - inherited Create(AbSWSSeekFailedS); - ErrorCode := AbSWSSeekFailed; -end; - -constructor EAbSWSWriteFailed.Create; -begin - inherited Create(AbSWSWriteFailedS); - ErrorCode := AbSWSWriteFailed; -end; - -constructor EAbSWSInvalidOrigin.Create; -begin - inherited Create(AbSWSInvalidOriginS); - ErrorCode := AbSWSInvalidOrigin; -end; - -constructor EAbSWSInvalidNewOrigin.Create; -begin - inherited Create(AbSWSInvalidNewOriginS); - ErrorCode := AbSWSInvalidNewOrigin; -end; - -constructor EAbFCIFileOpenError.Create; -begin - inherited Create(AbFCIFileOpenErrorS); - ErrorCode := AbFCIFileOpenError; -end; - -constructor EAbNoCabinetDll.Create; -begin - inherited Create(AbNoCabinetDllErrorS); - ErrorCode := AbNoCabinetDllError; -end; - -constructor EAbFCIFileReadError.Create; -begin - inherited Create(AbFCIFileReadErrorS); - ErrorCode := AbFCIFileReadError; -end; - -constructor EAbFCIFileWriteError.Create; -begin - inherited Create(AbFCIFileWriteErrorS); - ErrorCode := AbFCIFileWriteError; -end; - -constructor EAbFCIFileCloseError.Create; -begin - inherited Create(AbFCIFileCloseErrorS); - ErrorCode := AbFCIFileCloseError; -end; - -constructor EAbFCIFileSeekError.Create; -begin - inherited Create(AbFCIFileSeekErrorS); - ErrorCode := AbFCIFileSeekError; -end; - -constructor EAbFCIFileDeleteError.Create; -begin - inherited Create(AbFCIFileDeleteErrorS); - ErrorCode := AbFCIFileDeleteError; -end; - -constructor EAbFCIAddFileError.Create; -begin - inherited Create(AbFCIAddFileErrorS); - ErrorCode := AbFCIAddFileError; -end; - -constructor EAbFCICreateError.Create; -begin - inherited Create(AbFCICreateErrorS); - ErrorCode := AbFCICreateError; -end; - -constructor EAbFCIFlushCabinetError.Create; -begin - inherited Create(AbFCIFlushCabinetErrorS); - ErrorCode := AbFCIFlushCabinetError; -end; - -constructor EAbFCIFlushFolderError.Create; -begin - inherited Create(AbFCIFlushFolderErrorS); - ErrorCode := AbFCIFlushFolderError; -end; - -constructor EAbFDICopyError.Create; -begin - inherited Create(AbFDICopyErrorS); - ErrorCode := AbFDICopyError; -end; - -constructor EAbFDICreateError.Create; -begin - inherited Create(AbFDICreateErrorS); - ErrorCode := AbFDICreateError; -end; - -constructor EAbInvalidCabTemplate.Create; -begin - inherited Create(AbInvalidCabTemplateS); - ErrorCode := AbInvalidCabTemplate; -end; - -constructor EAbInvalidCabFile.Create; -begin - inherited Create(AbInvalidCabFileS); - ErrorCode := AbInvalidCabFile; -end; - -procedure AbConvertException( const E : Exception; - var eClass : TAbErrorClass; - var eErrorCode : Integer ); -begin - eClass := ecOther; - eErrorCode := 0; - if E is EAbException then begin - eClass := ecAbbrevia; - eErrorCode := (E as EAbException).ErrorCode; - end - else if E is EInOutError then begin - eClass := ecInOutError; - eErrorCode := (E as EInOutError).ErrorCode; - end - else if E is EFilerError then - eClass := ecFilerError - else if E is EFOpenError then - eClass := ecFileOpenError - else if E is EFCreateError then - eClass := ecFileCreateError; -end; - -{ EAbUnhandledType } - -constructor EAbUnhandledType.Create; -begin - inherited Create(AbUnhandledFileTypeS); - ErrorCode := AbUnhandledFileType; -end; - -{ EAbGzipBadCRC } - -constructor EAbGzipBadCRC.Create; -begin - inherited Create(AbGzipBadCRCS); - ErrorCode := AbGzipBadCRC; -end; - -{ EAbGzipBadFileSize } - -constructor EAbGzipBadFileSize.Create; -begin - inherited Create(AbGzipBadFileSizeS); - ErrorCode := AbGzipBadFileSize; -end; - -{ EAbGzipInvalid } - -constructor EAbGzipInvalid.Create; -begin - inherited Create(AbSpanningNotSupportedS); - ErrorCode := AbSpanningNotSupported; - -end; - -{ EAbTarInvalid } - -constructor EAbTarInvalid.Create; -begin - inherited Create(AbTarInvalidS); - ErrorCode := AbTarInvalid; -end; - -{ EAbTarBadFileName } - -constructor EAbTarBadFileName.Create; -begin - inherited Create(AbTarBadFileNameS); - ErrorCode := AbTarBadFileName; -end; - -{ EAbTarBadLinkName } - -constructor EAbTarBadLinkName.Create; -begin - inherited Create(AbTarBadLinkNameS); - ErrorCode := AbTarBadLinkName; -end; - -{ EAbTarBadOp } - -constructor EAbTarBadOp.Create; -begin - inherited Create(AbTarBadOpS); - ErrorCode := AbTarBadOp; -end; - -{ EAbSpanningNotSupported } - -constructor EAbSpanningNotSupported.Create; -begin - inherited Create(AbSpanningNotSupportedS); - ErrorCode := AbSpanningNotSupported; -end; - -{ EAbFileTooLarge } - -constructor EAbFileTooLarge.Create; -begin - {TODO Create const and fix wording} - inherited Create(AbFileSizeTooBigS); -end; - -end. diff --git a/components/Abbrevia/source/AbFciFdi.pas b/components/Abbrevia/source/AbFciFdi.pas deleted file mode 100644 index 3a2e946..0000000 --- a/components/Abbrevia/source/AbFciFdi.pas +++ /dev/null @@ -1,414 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbFciFdi.pas *} -{*********************************************************} -{* ABBREVIA: Cabinet DLL wrapper *} -{* Based on info from the FCI/FDI Library Description, *} -{* included in the Microsoft Cabinet SDK *} -{*********************************************************} - -unit AbFciFdi; - -{$I AbDefine.inc} - -interface - -uses - Windows, AbUtils; - -const - CabinetDLL = 'cabinet.dll'; - cpuUnknown = -1; - cpu80286 = 0; - cpu80386 = 1; - cpuDefault = cpuUnknown; - - -type - {FDI errors} - FDIError = - (FDIError_None, FDIError_Cabinet_Not_Found, - FDIError_Not_A_Cabinet, FDIError_Unknown_Cabinet_Version, - FDIError_Corrupt_Cabinet, FDIError_Alloc_Fail, - FDIError_Bad_Compr_Type, FDIError_MDI_Fail, - FDIError_Target_File, FDIError_Reserve_Mismatch, - FDIError_Wrong_Cabinet, FDIError_User_Abort); - - {FCI errors} - FCIError = - (FCIError_NONE, FCIError_Open_SRC, - FCIError_Read_SRC, FCIError_Alloc_Fail, - FCIError_Temp_File, FCIError_Bad_Compr_Type, - FCIError_Cab_File, FCIError_User_Abort, - FCIERRor_MCI_Fail); - - {FDI notifications} - FDINotificationType = - (FDINT_Cabinet_Info, FDINT_Partial_File, - FDINT_Copy_File, FDINT_Close_File_Info, - FDINT_Next_Cabinet, FDINT_Enumerate); - - {FDI/FCI error structure} - PCabErrorRecord = ^CabErrorRecord; - CabErrorRecord = record - ErrorCode : Integer; - ErrorType : Integer; - ErrorPresent : BOOL; - end; - - {FDI cabinet information structure} - PFDICabInfo = ^FDICabInfo; - FDICabInfo = record - cbCabinet : Longint; - cFolders : Word; - cFiles : Word; - setID : Word; - iCabinet : Word; - fReserve : BOOL; - hasprev : BOOL; - hasnext : BOOL; - end; - - {FCI cabinet information structure} - PFCICabInfo = ^FCICabInfo; - FCICabInfo = record - cb : Longint; - cbFolderThresh : Longint; - cbReserveCFHeader : Integer; - cbReserveCFFolder : Integer; - cbReserveCFData : Integer; - iCab : Integer; - iDisk : Integer; - fFailOnIncompressible : Integer; - setID : Word; - szDisk : array[0..255] of AnsiChar; - szCab : array[0..255] of AnsiChar; - szCabPath : array[0..255] of AnsiChar; - end; - - {FDI notification structure} - PFDINotification = ^FDINotification; - FDINotification = record - cb : Longint; - psz1 : PAnsiChar; - psz2 : PAnsiChar; - psz3 : PAnsiChar; - pv : Pointer; - hf : PtrInt; - date : Word; - time : Word; - attribs : Word; - setID : Word; - iCabinet : Word; - iFolder : Word; - fdie : FDIERROR; - end; - - {misc defines} - HFDI = Pointer; - HFCI = Pointer; - FARPROC = Pointer; - - -{== Cabinet DLL routine prototypes ==========================================} -type - TFDICreate = - function (pfnalloc, pfnfree, pfnopen, pfnread, pfnwrite, pfnclose, - pfnseek : FARPROC; cpuType : Integer; pError : PCabErrorRecord) : HFDI; - cdecl; -{----------------------------------------------------------------------------} - TFDIIsCabinet = - function(hfdi : HFDI; hf : PtrInt; pfdici : PFDICabInfo) : BOOL; - cdecl; -{----------------------------------------------------------------------------} - TFDICopy = - function(hfdi : HFDI; pszCabinet, pszCabPath : PAnsiChar; - flags : Integer; pfnfdin, pfnfdid : FARPROC; Archive : Pointer) : BOOL; - cdecl; -{----------------------------------------------------------------------------} - TFDIDestroy = - function(hfdi : HFDI) : BOOL; - cdecl; -{----------------------------------------------------------------------------} - TFCICreate = - function(pError : PCabErrorRecord; pfnfcifp, pfnalloc, pfnfree, - pfnopen, pfnread, pfnwrite, pfnclose, pfnseek, pfndelete, - pfnfcigtf : FARPROC; pccab : PFCICabInfo; Archive : Pointer) : HFCI; - cdecl; -{----------------------------------------------------------------------------} - TFCIAddFile = - function(hfci : HFCI; pszFilePath, pszFileName : PAnsiChar; - fExecute : BOOL; pfnfcignc, pfnfcis, pfnfcigoi : FARPROC; - typeCompress : Word) : BOOL; - cdecl; -{----------------------------------------------------------------------------} - TFCIFlushCabinet = - function(hfci : HFCI; fGetNextCab : BOOL; - pfnfcignc, pfnfcis : FARPROC) : BOOL; - cdecl; -{----------------------------------------------------------------------------} - TFCIFlushFolder = - function(hfci : HFCI; pfnfcignc, pfnfcis : FARPROC) : BOOL; - cdecl; -{----------------------------------------------------------------------------} - TFCIDestroy = - function(hfci : HFCI) : BOOL; - cdecl; - - -{== DLL routine wrappers ====================================================} -function FDICreate(pfnalloc, pfnfree, pfnopen, pfnread, - pfnwrite, pfnclose, pfnseek : FARPROC; - cpuType : Integer; pError : PCabErrorRecord) : HFDI; - {returns an FDI context for opening an existing cabinet} - { pfnalloc - heap allocation callback function } - { pfnfree - heap deallocation callback function } - { pfnopen - open file callback function } - { pfnwrite - write file callback function } - { pfnclose - close file callback function } - { pfnseek - reposition file pointer callback function } - { cpuType - -1: unknown, 0: 80286, 1: 80386 } - { pError - pointer to error record } -{----------------------------------------------------------------------------} -function FDIIsCabinet(hfdi : HFDI; hf : PtrInt; - pfdici : PFDICabInfo) : BOOL; - {checks cabinet file for validity} - { hfdi - FDI context } - { hf - cabinet file handle } - { pfdici - pointer to FDI cabinet info structure } -{----------------------------------------------------------------------------} -function FDICopy(hfdi : HFDI; pszCabinet, pszCabPath : PAnsiChar; - flags : Integer; pfnfdin, pfnfdid : FARPROC; - Archive : Pointer) : BOOL; - {enumerates every file in the cabinet. The callback function } - {should indicate whether or not to extract a given file} - { hfdi - FDI context } - { pszCabinet - cabinet file name } - { pszCabPath - cabinet file path } - { flags - currently not used } - { pfnfdin - FDI notifaction callback function } - { pfnfdid - decryption callback (currently not used)} - { Archive - the calling TAbCabArchive instance } -{----------------------------------------------------------------------------} -function FDIDestroy(hfdi : HFDI) : BOOL; - {releases FDI context and frees resources} - { hfdi - FDI context } -{----------------------------------------------------------------------------} -function FCICreate(pError : PCabErrorRecord; - pfnfcifp, pfnalloc, pfnfree, pfnopen, pfnread, pfnwrite, pfnclose, - pfnseek, pfndelete, pfnfcigtf : FARPROC; - pccab : PFCICabInfo; Archive : Pointer) : HFCI; - {creates a new cabinet file and returns the FCI context} - { pError - pointer to error record } - { pfnfcifp - callback notification when file has been placed in cabinet } - { pfnalloc - callback function to allocate memory } - { pfnfree - callback function to free memory } - { pfnopen - callback function to open a file } - { pfnwrite - callback function to write to a file } - { pfnclose - callback function to close a file } - { pfnseek - callback function to reposition file pointer } - { pfndelete - callback function to delete a file } - { pfnfcigtf - callback function to obtain temp filename } - { pccab - pointer to FCI cabinet infor structure } - { Archive - the calling TAbCabArchive instance } -{----------------------------------------------------------------------------} -function FCIAddFile(hfci : HFCI; pszFilePath, pszFileName : PAnsiChar; - fExecute : BOOL; pfnfcignc, pfnfcis, pfnfcigoi : FARPROC; - typeCompress : Word) : BOOL; - {adds a file to the cabinet} - { hfci - FCI context } - { pszFilePath - full pathname of file being added } - { pszFileName - just the file name } - { fExecute - flag to indicate if file is executable } - { pfnfcignc - callback function to obtain next cabinet info } - { pfnfcis - callback function to relay progress } - { pfnfcigoi - callback function to open file and get attributes } - { typeCompress - compression type to use } -{----------------------------------------------------------------------------} -function FCIFlushCabinet(hfci : HFCI; fGetNextCab : BOOL; - pfnfcignc, pfnfcis : FARPROC) : BOOL; - {writes current cabinet file out to disk and optionally starts a new one} - { hfci - FCI context } - { fGetNextCab - flag indicating whether to start a new cabinet } - { pfnfcignc - callback function to obtain next cabinet info } - { pfnfcis - callback function to relay progress } -{----------------------------------------------------------------------------} -function FCIFlushFolder(hfci : HFCI; - pfnfcignc, pfnfcis : FARPROC) : BOOL; - {close current compression block and start a new one} - { hfci - FCI context } - { pfnfcignc - callback function to obtain next cabinet info } - { pfnfcis - callback function to relay progress } -{----------------------------------------------------------------------------} -function FCIDestroy(hfci : HFCI) : BOOL; - {releases FCI context and frees resources} - { hfdi - FDI context } -{----------------------------------------------------------------------------} - - -implementation - -uses - AbExcept; - - -var - CabDLLLoaded : Boolean; - CabDLLHandle : THandle; - FDICreateProc : TFDICreate; - FDIIsCabinetProc : TFDIIsCabinet; - FDICopyProc : TFDICopy; - FDIDestroyProc : TFDIDestroy; - FCICreateProc : TFCICreate; - FCIAddFileProc : TFCIAddFile; - FCIFlushCabinetProc : TFCIFlushCabinet; - FCIFlushFolderProc : TFCIFlushFolder; - FCIDestroyProc : TFCIDestroy; - - -{============================================================================} -procedure LoadCabinetDLL; -begin - if CabDllLoaded then - Exit; - CabDllHandle := LoadLibrary(CabinetDLL); - if (CabDllHandle = 0) then - raise EAbNoCabinetDLL.Create; - @FDICreateProc := GetProcAddress(CabDllHandle, 'FDICreate'); - @FDIIsCabinetProc := GetProcAddress(CabDllHandle, 'FDIIsCabinet'); - @FDICopyProc := GetProcAddress(CabDllHandle, 'FDICopy'); - @FDIDestroyProc := GetProcAddress(CabDllHandle, 'FDIDestroy'); - @FCICreateProc := GetProcAddress(CabDllHandle, 'FCICreate'); - @FCIAddFileProc := GetProcAddress(CabDllHandle, 'FCIAddFile'); - @FCIFlushCabinetProc := GetProcAddress(CabDllHandle, 'FCIFlushCabinet'); - @FCIFlushFolderProc := GetProcAddress(CabDllHandle, 'FCIFlushFolder'); - @FCIDestroyProc := GetProcAddress(CabDllHandle, 'FCIDestroy'); - CabDllLoaded := True; -end; -{----------------------------------------------------------------------------} -function FDICreate(pfnalloc, pfnfree, pfnopen, pfnread, - pfnwrite, pfnclose, pfnseek : FARPROC; - cpuType : Integer; pError : PCabErrorRecord) : HFDI; -begin - LoadCabinetDLL; - if Assigned(FDICreateProc) then - Result := FDICreateProc(pfnalloc, pfnfree, pfnopen, pfnread, - pfnwrite, pfnclose, pfnseek, cpuType, pError) - else - Result := nil; -end; -{----------------------------------------------------------------------------} -function FDIIsCabinet(hfdi : HFDI; hf : PtrInt; - pfdici : PFDICabInfo) : BOOL; -begin - LoadCabinetDLL; - if Assigned(FDIIsCabinetProc) then - Result := FDIIsCabinetProc(hfdi, hf, pfdici) - else - Result := False; -end; -{----------------------------------------------------------------------------} -function FDICopy(hfdi : HFDI; pszCabinet, pszCabPath : PAnsiChar; - flags : Integer; pfnfdin, pfnfdid : FARPROC; - Archive : Pointer) : BOOL; -begin - LoadCabinetDLL; - if Assigned(FDICopyProc) then - Result := FDICopyProc(hfdi, pszCabinet, pszCabPath, flags, - pfnfdin, pfnfdid, Archive) - else - Result := False; -end; -{----------------------------------------------------------------------------} -function FDIDestroy(hfdi : HFDI) : BOOL; -begin - LoadCabinetDLL; - if Assigned(FDIDestroyProc) then - Result := FDIDestroyProc(hfdi) - else - Result := False; -end; -{----------------------------------------------------------------------------} -function FCICreate(pError : PCabErrorRecord; - pfnfcifp, pfnalloc, pfnfree, pfnopen, pfnread, pfnwrite, pfnclose, - pfnseek, pfndelete, pfnfcigtf : FARPROC; - pccab : PFCICabInfo; Archive : Pointer) : HFCI; -begin - LoadCabinetDLL; - if Assigned(FCICreateProc) then - Result := FCICreateProc(pError, pfnfcifp, pfnalloc, pfnfree, pfnopen, - pfnread, pfnwrite, pfnclose, pfnseek, pfndelete, pfnfcigtf, - pccab, Archive) - else - Result := nil; -end; -{----------------------------------------------------------------------------} -function FCIAddFile(hfci : HFCI; pszFilePath, pszFileName : PAnsiChar; - fExecute : BOOL; pfnfcignc, pfnfcis, pfnfcigoi : FARPROC; - typeCompress : Word) : BOOL; -begin - LoadCabinetDLL; - if Assigned(FCIAddFileProc) then - Result := FCIAddFileProc(hfci, pszFilePath, pszFileName, - fExecute, pfnfcignc, pfnfcis, pfnfcigoi, typeCompress) - else - Result := False; -end; -{----------------------------------------------------------------------------} -function FCIFlushCabinet(hfci : HFCI; fGetNextCab : BOOL; - pfnfcignc, pfnfcis : FARPROC) : BOOL; -begin - LoadCabinetDLL; - if Assigned(FCIFlushCabinetProc) then - Result := FCIFlushCabinetProc(hfci, fGetNextCab, pfnfcignc, pfnfcis) - else - Result := False; -end; -{----------------------------------------------------------------------------} -function FCIFlushFolder(hfci : HFCI; - pfnfcignc, pfnfcis : FARPROC) : BOOL; -begin - LoadCabinetDLL; - if Assigned(FCIFlushFolderProc) then - Result := FCIFlushFolderProc(hfci, pfnfcignc, pfnfcis) - else - Result := False; -end; -{----------------------------------------------------------------------------} -function FCIDestroy(hfci : HFCI) : BOOL; -begin - LoadCabinetDLL; - if Assigned(FCIDestroyProc) then - Result := FCIDestroyProc(hfci) - else - Result := False; -end; -{----------------------------------------------------------------------------} -initialization - CabDllLoaded := False; - -end. diff --git a/components/Abbrevia/source/AbGzTyp.pas b/components/Abbrevia/source/AbGzTyp.pas deleted file mode 100644 index 97a71b9..0000000 --- a/components/Abbrevia/source/AbGzTyp.pas +++ /dev/null @@ -1,1288 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbGzTyp.pas *} -{*********************************************************} -{* ABBREVIA: TAbGzipArchive, TAbGzipItem classes *} -{*********************************************************} -{* Misc. constants, types, and routines for working *} -{* with GZip files *} -{* See: RFC 1952 *} -{* "GZIP file format specification version 4.3" *} -{* for more information on GZip *} -{* See "algorithm.doc" in Gzip source and "format.txt" *} -{* on gzip.org for differences from RFC *} -{*********************************************************} - -unit AbGzTyp; - -{$I AbDefine.inc} - -interface - -uses - Classes, AbUtils, AbArcTyp, AbTarTyp, AbVMStrm; - -type - { pre-defined "operating system" (really more FILE system) - types for the Gzip header } - TAbGzFileSystem = - (osFat, osAmiga, osVMS, osUnix, osVM_CMS, osAtariTOS, - osHPFS, osMacintosh, osZSystem, osCP_M, osTOPS20, - osNTFS, osQDOS, osAcornRISCOS, osVFAT, osMVS, osBeOS, - osTandem, osTHEOS, osUnknown, osUndefined); - -type - PAbGzHeader = ^TAbGzHeader; - TAbGzHeader = packed record { SizeOf(TGzHeader) = 10} - ID1 : Byte; { ID Byte, should always be $1F} - ID2 : Byte; { ID Byte, should always be $8B} - CompMethod : Byte; { compression method used} - { 0..7 reserved, 8 = deflate, others undefined as of this writing (4/27/2001)} - Flags : Byte; { misc flags} - { Bit 0: FTEXT compressed file contains text, can be used for} - { cross platform line termination translation} - { Bit 1: FCONTINUATION file is a continuation of a multi-part gzip file} - { RFC 1952 says this is the header CRC16 flag, but gzip} - { reserves it and won't extract the file if this is set} - { header data includes part number after header record} - { Bit 2: FEXTRA header data contains Extra Data, starts after part} - { number (if any)} - { Bit 3: FNAME header data contains FileName, null terminated} - { string starting immediately after Extra Data (if any)} - { RFC 1952 says this is ISO 8859-1 encoded, but gzip} - { always uses the system encoding} - { Bit 4: FCOMMENT header data contains Comment, null terminated string} - { starting immediately after FileName (if any)} - { Bit 5: FENCRYPTED file is encrypted using zip-1.9 encryption } - { header data contains a 12-byte encryption header } - { starting immediately after Comment. Documented in} - { "algorithm.doc", but unsupported in gzip} - { Bits 6..7 are undefined and reserved as of this writing (8/25/2009)} - ModTime : LongInt; { File Modification (Creation) time,} - { UNIX cdate format} - XtraFlags : Byte; { additional flags} - { XtraFlags = 2 -- Deflate compressor used maximum compression algorithm} - { XtraFlags = 4 -- Deflate compressor used fastest algorithm} - OS : Byte; { Operating system that created file,} - { see GZOsToStr routine for values} - end; - - TAbGzTailRec = packed record - CRC32 : LongInt; { crc for uncompressed data } - ISize : LongWord; { size of uncompressed data } - end; - - TAbGzExtraFieldSubID = array[0..1] of AnsiChar; - -type - TAbGzipExtraField = class(TAbExtraField) - private - FGZHeader : PAbGzHeader; - function GetID(aIndex : Integer): TAbGzExtraFieldSubID; - protected - procedure Changed; override; - public - constructor Create(aGZHeader : PAbGzHeader); - procedure Delete(aID : TAbGzExtraFieldSubID); - function Get(aID : TAbGzExtraFieldSubID; - out aData : Pointer; out aDataSize : Word) : Boolean; - procedure Put(aID : TAbGzExtraFieldSubID; const aData; aDataSize : Word); - public - property IDs[aIndex : Integer]: TAbGzExtraFieldSubID - read GetID; - end; - - TAbGzipItem = class(TAbArchiveItem) - protected {private} - FGZHeader : TAbGzHeader; - FExtraField : TAbGzipExtraField; - FFileComment : AnsiString; - FRawFileName : AnsiString; - - protected - function GetFileSystem: TAbGzFileSystem; - function GetHasExtraField: Boolean; - function GetHasFileComment: Boolean; - function GetHasFileName: Boolean; - function GetIsText: Boolean; - - procedure SetFileComment(const Value : AnsiString); - procedure SetFileSystem(const Value: TAbGzFileSystem); - procedure SetIsText(const Value: Boolean); - - function GetExternalFileAttributes : LongWord; override; - function GetIsEncrypted : Boolean; override; - function GetLastModFileDate : Word; override; - function GetLastModFileTime : Word; override; - function GetLastModTimeAsDateTime: TDateTime; override; - - procedure SetExternalFileAttributes( Value : LongWord ); override; - procedure SetFileName(const Value : string); override; - procedure SetIsEncrypted(Value : Boolean); override; - procedure SetLastModFileDate(const Value : Word); override; - procedure SetLastModFileTime(const Value : Word); override; - procedure SetLastModTimeAsDateTime(const Value: TDateTime); override; - - procedure SaveGzHeaderToStream(AStream : TStream); - procedure LoadGzHeaderFromStream(AStream : TStream); - public - property CompressionMethod : Byte - read FGZHeader.CompMethod; - - property ExtraFlags : Byte {Default: 2} - read FGZHeader.XtraFlags write FGZHeader.XtraFlags; - - property Flags : Byte - read FGZHeader.Flags; - - property FileComment : AnsiString - read FFileComment write SetFileComment; - - property FileSystem : TAbGzFileSystem {Default: osFat (Windows); osUnix (Linux)} - read GetFileSystem write SetFileSystem; - - property ExtraField : TAbGzipExtraField - read FExtraField; - - property IsEncrypted : Boolean - read GetIsEncrypted; - - property HasExtraField : Boolean - read GetHasExtraField; - - property HasFileName : Boolean - read GetHasFileName; - - property HasFileComment : Boolean - read GetHasFileComment; - - property IsText : Boolean - read GetIsText write SetIsText; - - property GZHeader : TAbGzHeader - read FGZHeader; - - constructor Create; - destructor Destroy; override; - end; - - TAbGzipStreamHelper = class(TAbArchiveStreamHelper) - private - function GetGzCRC: LongInt; - function GetFileSize: LongInt; - protected {private} - FItem : TAbGzipItem; - FTail : TAbGzTailRec; - public - constructor Create(AStream : TStream); - destructor Destroy; override; - - procedure ExtractItemData(AStream : TStream); override; - function FindFirstItem : Boolean; override; - function FindNextItem : Boolean; override; - function SeekItem(Index : Integer): Boolean; override; - procedure SeekToItemData; - procedure WriteArchiveHeader; override; - procedure WriteArchiveItem(AStream : TStream); override; - procedure WriteArchiveTail; override; - function GetItemCount : Integer; override; - procedure ReadHeader; override; - procedure ReadTail; override; - - property CRC : LongInt - read GetGzCRC; - property FileSize : LongInt - read GetFileSize; - property TailCRC : LongInt - read FTail.CRC32; - property TailSize : LongWord - read FTail.ISize; - end; - - TAbGzipArchiveState = (gsGzip, gsTar); - - TAbGzipArchive = class(TAbTarArchive) - private - FGZStream : TStream; { stream for GZip file} - FGZItem : TAbArchiveList; { item in Gzip (only one, but need polymorphism of class)} - FTarStream : TAbVirtualMemoryStream; { stream for possible contained Tar } - FTarList : TAbArchiveList; { items in possible contained Tar } - FTarAutoHandle: Boolean; - FState : TAbGzipArchiveState; - FIsGzippedTar : Boolean; - - procedure SetTarAutoHandle(const Value: Boolean); - function GetIsGzippedTar: Boolean; - procedure SwapToGzip; - procedure SwapToTar; - - protected - function CreateItem(const FileSpec : string): TAbArchiveItem; - override; - procedure ExtractItemAt(Index : Integer; const UseName : string); - override; - procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream); - override; - procedure LoadArchive; - override; - procedure SaveArchive; - override; - procedure TestItemAt(Index : Integer); - override; - function FixName(const Value : string) : string; - override; - function GetSupportsEmptyFolders : Boolean; - override; - - function GetItem(Index: Integer): TAbGzipItem; - procedure PutItem(Index: Integer; const Value: TAbGzipItem); - public {methods} - constructor CreateFromStream(aStream : TStream; const aArchiveName : string); - override; - destructor Destroy; - override; - - procedure DoSpanningMediaRequest(Sender : TObject; ImageNumber : Integer; - var ImageName : string; var Abort : Boolean); override; - - property TarAutoHandle : Boolean - read FTarAutoHandle write SetTarAutoHandle; - - property IsGzippedTar : Boolean - read GetIsGzippedTar write FIsGzippedTar; - - property Items[Index : Integer] : TAbGzipItem - read GetItem - write PutItem; default; - end; - -function VerifyGZip(Strm : TStream) : TAbArchiveType; -function GZOsToStr(OS: Byte) : string; - -implementation - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} - SysUtils, - AbBitBkt, AbCharset, AbDfBase, AbDfDec, AbDfEnc, AbExcept, AbResString; - -const - { Header Signature Values} - AB_GZ_HDR_ID1 = $1F; - AB_GZ_HDR_ID2 = $8B; - - { Test bits for TGzHeader.Flags field } - AB_GZ_FLAG_FTEXT = $01; - AB_GZ_FLAG_FCONTINUATION = $02; - AB_GZ_FLAG_FEXTRA = $04; - AB_GZ_FLAG_FNAME = $08; - AB_GZ_FLAG_FCOMMENT = $10; - AB_GZ_FLAG_FENCRYPTED = $20; - AB_GZ_UNSUPPORTED_FLAGS = $E2; - - { GZip OS source flags } - AB_GZ_OS_ID_FAT = 0; - AB_GZ_OS_ID_Amiga = 1; - AB_GZ_OS_ID_VMS = 2; - AB_GZ_OS_ID_Unix = 3; - AB_GZ_OS_ID_VM_CMS = 4; - AB_GZ_OS_ID_AtariTOS = 5; - AB_GZ_OS_ID_HPFS = 6; - AB_GZ_OS_ID_Macintosh = 7; - AB_GZ_OS_ID_Z_System = 8; - AB_GZ_OS_ID_CP_M = 9; - AB_GZ_OS_ID_TOPS20 = 10; - AB_GZ_OS_ID_NTFS = 11; - AB_GZ_OS_ID_QDOS = 12; - AB_GZ_OS_ID_AcornRISCOS = 13; - AB_GZ_OS_ID_VFAT = 14; - AB_GZ_OS_ID_MVS = 15; - AB_GZ_OS_ID_BEOS = 16; - AB_GZ_OS_ID_TANDEM = 17; - AB_GZ_OS_ID_THEOS = 18; - AB_GZ_OS_ID_unknown = 255; - -function GZOsToStr(OS: Byte) : string; -{ -Return a descriptive string for TGzHeader.OS field -} -begin - case OS of - AB_GZ_OS_ID_FAT : Result := AbGzOsFat; - AB_GZ_OS_ID_Amiga : Result := AbGzOsAmiga; - AB_GZ_OS_ID_VMS : Result := AbGzOsVMS; - AB_GZ_OS_ID_Unix : Result := AbGzOsUnix; - AB_GZ_OS_ID_VM_CMS : Result := AbGzOsVM_CMS; - AB_GZ_OS_ID_AtariTOS : Result := AbGzOsAtari; - AB_GZ_OS_ID_HPFS : Result := AbGzOsHPFS; - AB_GZ_OS_ID_Macintosh : Result := AbGzOsMacintosh; - AB_GZ_OS_ID_Z_System : Result := AbGzOsZ_System; - AB_GZ_OS_ID_CP_M : Result := AbGzOsCP_M; - AB_GZ_OS_ID_TOPS20 : Result := AbGzOsTOPS_20; - AB_GZ_OS_ID_NTFS : Result := AbGzOsNTFS; - AB_GZ_OS_ID_QDOS : Result := AbGzOsQDOS; - AB_GZ_OS_ID_AcornRISCOS : Result := AbGzOsAcornRISCOS; - AB_GZ_OS_ID_VFAT : Result := AbGzOsVFAT; - AB_GZ_OS_ID_MVS : Result := AbGzOsMVS; - AB_GZ_OS_ID_BEOS : Result := AbGzOsBeOS; - AB_GZ_OS_ID_TANDEM : Result := AbGzOsTandem; - AB_GZ_OS_ID_THEOS : Result := AbGzOsTHEOS; - AB_GZ_OS_ID_unknown : Result := AbGzOsunknown; - else - Result := AbGzOsUndefined; - end; -end; - - -function VerifyHeader(const Header : TAbGzHeader) : Boolean; -begin - { check id fields and if deflated (only handle deflate anyway)} - Result := (Header.ID1 = AB_GZ_HDR_ID1) and - (Header.ID2 = AB_GZ_HDR_ID2) and - (Header.CompMethod = 8 {deflate}); -end; - -function VerifyGZip(Strm : TStream) : TAbArchiveType; -var - GHlp : TAbGzipStreamHelper; - Hlpr : TAbDeflateHelper; - PartialTarData : TMemoryStream; - CurPos : Int64; -begin - Result := atUnknown; - CurPos := Strm.Position; - try - Strm.Seek(0, soBeginning); - - {prepare for the try..finally} - Hlpr := nil; - PartialTarData := nil; - - GHlp := TAbGzipStreamHelper.Create(Strm); - try - {create the stream helper and read the item header} - GHlp.ReadHeader; - - { check id fields and if deflated (only handle deflate anyway)} - if VerifyHeader(GHlp.FItem.FGZHeader) then begin - Result := atGZip; { provisional } - - { check if is actually a Gzipped Tar } - { partial extract contents, verify vs. Tar } - PartialTarData := TMemoryStream.Create; - GHlp.SeekToItemData; - Hlpr := TAbDeflateHelper.Create; - Hlpr.PartialSize := 512; - PartialTarData.SetSize(512 * 2); - Inflate(Strm, PartialTarData, Hlpr); - - {set to beginning of extracted data} - PartialTarData.Position := 0; - - if (VerifyTar(PartialTarData) = atTar) then - Result := atGZippedTar; - end; - finally - GHlp.Free; - Hlpr.Free; - PartialTarData.Free; - end; - except - on EReadError do - Result := atUnknown; - end; - Strm.Position := CurPos; -end; - -{ TAbGzipExtraField } - -constructor TAbGzipExtraField.Create(aGZHeader : PAbGzHeader); -begin - inherited Create; - FGZHeader := aGZHeader; -end; - -procedure TAbGzipExtraField.Changed; -begin - if Buffer = nil then - FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FEXTRA - else - FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FEXTRA; -end; - -procedure TAbGzipExtraField.Delete(aID : TAbGzExtraFieldSubID); -begin - inherited Delete(Word(aID)); -end; - -function TAbGzipExtraField.GetID(aIndex : Integer): TAbGzExtraFieldSubID; -begin - Result := TAbGzExtraFieldSubID(inherited IDs[aIndex]); -end; - -function TAbGzipExtraField.Get(aID : TAbGzExtraFieldSubID; out aData : Pointer; - out aDataSize : Word) : Boolean; -begin - Result := inherited Get(Word(aID), aData, aDataSize); -end; - -procedure TAbGzipExtraField.Put(aID : TAbGzExtraFieldSubID; const aData; aDataSize : Word); -begin - inherited Put(Word(aID), aData, aDataSize); -end; - - -{ TAbGzipStreamHelper } - -constructor TAbGzipStreamHelper.Create(AStream : TStream); -begin - inherited Create(AStream); - FItem := TAbGzipItem.Create; -end; - -destructor TAbGzipStreamHelper.Destroy; -begin - FItem.Free; - inherited; -end; - -function ReadCStringInStream(AStream: TStream): AnsiString; -{ -locate next instance of a null character in a stream -leaves stream positioned just past that, -or at end of stream if not found or null is last byte in stream. -Result is the entire read string. -} -const - BuffSiz = 1024; -var - Buff : array [0..BuffSiz-1] of AnsiChar; - Len, DataRead : LongInt; -begin -{ basically what this is supposed to do is...} -{ - repeat - AStream.Read(C, 1); - Result := Result + C; - until (AStream.Position = AStream.Size) or (C = #0); -} - Result := ''; - repeat - DataRead := AStream.Read(Buff, BuffSiz - 1); - Buff[DataRead] := #0; - Len := StrLen(Buff); - if Len > 0 then begin - SetLength(Result, Length(Result) + Len); - Move(Buff, Result[Length(Result) - Len + 1], Len); - end; - if Len < DataRead then begin - AStream.Seek(Len - DataRead + 1, soCurrent); - Break; - end; - until DataRead = 0; -end; - -procedure TAbGzipStreamHelper.SeekToItemData; -{find end of header data, including FileName etc.} -begin - {** Seek to Compressed Data **} - FStream.Seek(0, soBeginning); - FItem.LoadGzHeaderFromStream(FStream); -end; - -procedure TAbGzipStreamHelper.ExtractItemData(AStream: TStream); -var - Helper : TAbDeflateHelper; -begin - Helper := TAbDeflateHelper.Create; - try - SeekToItemData; - if (AStream is TAbBitBucketStream) then - Helper.Options := Helper.Options or dfc_TestOnly; - FItem.CRC32 := Inflate(FStream, AStream, Helper); - FItem.UncompressedSize := AStream.Size{Helper.NormalSize}; - finally - Helper.Free; - end; -end; - -function TAbGzipStreamHelper.FindFirstItem: Boolean; -var - GZH : TAbGzHeader; - DataRead : Integer; -begin - Result := False; - FStream.Seek(0, soBeginning); - DataRead := FStream.Read(GZH, SizeOf(TAbGzHeader)); - if (DataRead = SizeOf(TAbGzHeader)) and VerifyHeader(GZH) then begin - FItem.FGZHeader := GZH; - Result := True; - end; - FStream.Seek(0, soBeginning); -end; - -function TAbGzipStreamHelper.FindNextItem: Boolean; -begin - { only one item in a GZip } - Result := False; -end; - -function TAbGzipStreamHelper.SeekItem(Index: Integer): Boolean; -begin - if Index > 0 then - Result := False - else - Result := FindFirstItem; -end; - -procedure TAbGzipStreamHelper.WriteArchiveHeader; -begin - FItem.SaveGzHeaderToStream(FStream); -end; - -procedure TAbGzipStreamHelper.WriteArchiveItem(AStream: TStream); -var - Helper : TAbDeflateHelper; -begin - Helper := TAbDeflateHelper.Create; - try - FItem.CRC32 := Deflate(AStream, FStream, Helper); - FItem.UncompressedSize := AStream.Size; - finally - Helper.Free; - end; -end; - -procedure TAbGzipStreamHelper.WriteArchiveTail; -var - Tail : TAbGzTailRec; -begin - Tail.CRC32 := FItem.CRC32; - Tail.ISize := FItem.UncompressedSize; - FStream.Write(Tail, SizeOf(TAbGzTailRec)); -end; - -function TAbGzipStreamHelper.GetItemCount: Integer; -begin - { only one item in a gzip } - Result := 1; -end; - -procedure TAbGzipStreamHelper.ReadHeader; -begin - FItem.LoadGzHeaderFromStream(FStream); -end; - -procedure TAbGzipStreamHelper.ReadTail; -begin - FStream.Read(FTail, SizeOf(TAbGzTailRec)); -end; - -function TAbGzipStreamHelper.GetGzCRC: LongInt; -begin - Result := FItem.CRC32; -end; - -function TAbGzipStreamHelper.GetFileSize: LongInt; -begin - Result := FItem.UncompressedSize; -end; - -{ TAbGzipItem } - -constructor TAbGzipItem.Create; -begin - inherited Create; - - { default ID fields } - FGzHeader.ID1 := AB_GZ_HDR_ID1; - FGzHeader.ID2 := AB_GZ_HDR_ID2; - - { compression method } - FGzHeader.CompMethod := 8; { deflate } - - { Maxium Compression } - FGzHeader.XtraFlags := 2; - - FFileName := ''; - FFileComment := ''; - FExtraField := TAbGzipExtraField.Create(@FGzHeader); - - { source OS ID } -{$IFDEF LINUX } {assume EXT2 system } - FGzHeader.OS := AB_GZ_OS_ID_Unix; -{$ENDIF LINUX } -{$IFDEF MSWINDOWS } {assume FAT system } - FGzHeader.OS := AB_GZ_OS_ID_FAT; -{$ENDIF MSWINDOWS } -end; - -destructor TAbGzipItem.Destroy; -begin - FExtraField.Free; - inherited; -end; - -function TAbGzipItem.GetExternalFileAttributes: LongWord; -begin - { GZip has no provision for storing attributes } - Result := 0; -end; - -function TAbGzipItem.GetFileSystem: TAbGzFileSystem; -begin - case FGzHeader.OS of - 0..18: Result := TAbGzFileSystem(FGzHeader.OS); - 255: Result := osUnknown; - else - Result := osUndefined; - end; { case } -end; - -function TAbGzipItem.GetIsEncrypted: Boolean; -begin - Result := (FGZHeader.Flags and AB_GZ_FLAG_FENCRYPTED) = AB_GZ_FLAG_FENCRYPTED; -end; - -function TAbGzipItem.GetHasExtraField: Boolean; -begin - Result := (FGZHeader.Flags and AB_GZ_FLAG_FEXTRA) = AB_GZ_FLAG_FEXTRA; -end; - -function TAbGzipItem.GetHasFileComment: Boolean; -begin - Result := (FGZHeader.Flags and AB_GZ_FLAG_FCOMMENT) = AB_GZ_FLAG_FCOMMENT; -end; - -function TAbGzipItem.GetHasFileName: Boolean; -begin - Result := (FGZHeader.Flags and AB_GZ_FLAG_FNAME) = AB_GZ_FLAG_FNAME; -end; - -function TAbGzipItem.GetIsText: Boolean; -begin - Result := (FGZHeader.Flags and AB_GZ_FLAG_FTEXT) = AB_GZ_FLAG_FTEXT; -end; - -function TAbGzipItem.GetLastModFileDate: Word; -begin - { convert to local DOS file Date } - Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Hi; -end; - -function TAbGzipItem.GetLastModFileTime: Word; -begin - { convert to local DOS file Time } - Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Lo; -end; - -function TAbGzipItem.GetLastModTimeAsDateTime: TDateTime; -begin - Result := AbUnixTimeToLocalDateTime(FGZHeader.ModTime); -end; - -procedure TAbGzipItem.LoadGzHeaderFromStream(AStream: TStream); -var - LenW : Word; -begin - AStream.Read(FGzHeader, SizeOf(TAbGzHeader)); - if not VerifyHeader(FGzHeader) then - Exit; - - { Skip part number, if any } - if (FGzHeader.Flags and AB_GZ_FLAG_FCONTINUATION) = AB_GZ_FLAG_FCONTINUATION then - AStream.Seek(SizeOf(Word), soCurrent); - - if HasExtraField then begin - { get length of extra data } - AStream.Read(LenW, SizeOf(Word)); - FExtraField.LoadFromStream(AStream, LenW); - end - else - FExtraField.Clear; - - { Get Filename, if any } - if HasFileName then begin - FRawFileName := ReadCStringInStream(AStream); - FFileName := AbRawBytesToString(FRawFileName) - end - else - FFileName := 'unknown'; - - { any comment present? } - if HasFileComment then - FFileComment := ReadCStringInStream(AStream) - else - FFileComment := ''; - - - {Assert: stream should now be located at start of compressed data } - {If file was compressed with 3.3 spec this will be invalid so use with care} - CompressedSize := AStream.Size - AStream.Position - SizeOf(TAbGzTailRec); - - FDiskFileName := FileName; - AbUnfixName(FDiskFileName); - Action := aaNone; - Tagged := False; -end; - -procedure TAbGzipItem.SaveGzHeaderToStream(AStream: TStream); -var - LenW : Word; -begin - { default ID fields } - FGzHeader.ID1 := AB_GZ_HDR_ID1; - FGzHeader.ID2 := AB_GZ_HDR_ID2; - - { compression method } - FGzHeader.CompMethod := 8; { deflate } - - { reset unsupported flags } - FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_UNSUPPORTED_FLAGS; - - { main header data } - AStream.Write(FGzHeader, SizeOf(TAbGzHeader)); - - { add extra field if any } - if HasExtraField then begin - LenW := Length(FExtraField.Buffer); - AStream.Write(LenW, SizeOf(LenW)); - if LenW > 0 then - AStream.Write(FExtraField.Buffer[0], LenW); - end; - - { add filename if any (and include final #0 from string) } - if HasFileName then - AStream.Write(FRawFileName[1], Length(FRawFileName) + 1); - - { add file comment if any (and include final #0 from string) } - if HasFileComment then - AStream.Write(FFileComment[1], Length(FFileComment) + 1); -end; - -procedure TAbGzipItem.SetExternalFileAttributes(Value: LongWord); -begin - { do nothing } -end; - -procedure TAbGzipItem.SetFileComment(const Value: AnsiString); -begin - FFileComment := Value; - if FFileComment <> '' then - FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FCOMMENT - else - FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FCOMMENT; -end; - -procedure TAbGzipItem.SetFileName(const Value: string); -begin - FFileName := Value; - FRawFileName := AbStringToUnixBytes(Value); - if Value <> '' then - FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FNAME - else - FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FNAME; -end; - -procedure TAbGzipItem.SetFileSystem(const Value: TAbGzFileSystem); -begin - if Value = osUnknown then - FGzHeader.OS := 255 - else - FGzHeader.OS := Ord(Value); -end; - -procedure TAbGzipItem.SetIsEncrypted(Value: Boolean); -begin - { do nothing } -end; - -procedure TAbGzipItem.SetIsText(const Value: Boolean); -begin - if Value then - FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FTEXT - else - FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FTEXT; -end; - -procedure TAbGzipItem.SetLastModFileDate(const Value: Word); -begin - { replace date, keep existing time } - LastModTimeAsDateTime := - EncodeDate( - Value shr 9 + 1980, - Value shr 5 and 15, - Value and 31) + - Frac(LastModTimeAsDateTime); -end; - -procedure TAbGzipItem.SetLastModFileTime(const Value: Word); -begin - { keep current date, replace time } - LastModTimeAsDateTime := - Trunc(LastModTimeAsDateTime) + - EncodeTime( - Value shr 11, - Value shr 5 and 63, - Value and 31 shl 1, 0); -end; - -procedure TAbGzipItem.SetLastModTimeAsDateTime(const Value: TDateTime); -begin - FGZHeader.ModTime := AbLocalDateTimeToUnixTime(Value); -end; - -{ TAbGzipArchive } - -constructor TAbGzipArchive.CreateFromStream(aStream : TStream; - const aArchiveName : string); -begin - inherited CreateFromStream(aStream, aArchiveName); - FState := gsGzip; - FGZStream := FStream; - FGZItem := FItemList; - FTarStream := TAbVirtualMemoryStream.Create; - FTarList := TAbArchiveList.Create(True); -end; - -procedure TAbGzipArchive.SwapToTar; -begin - FStream := FTarStream; - FItemList := FTarList; - FState := gsTar; -end; - -procedure TAbGzipArchive.SwapToGzip; -begin - FStream := FGzStream; - FItemList := FGzItem; - FState := gsGzip; -end; - -function TAbGzipArchive.CreateItem(const FileSpec: string): TAbArchiveItem; -var - GzItem : TAbGzipItem; -begin - if IsGZippedTar and TarAutoHandle then begin - SwapToTar; - Result := inherited CreateItem(FileSpec); - end - else begin - SwapToGzip; - GzItem := TAbGzipItem.Create; - try - GzItem.CompressedSize := 0; - GzItem.CRC32 := 0; - GzItem.DiskFileName := ExpandFileName(FileSpec); - GzItem.FileName := FixName(FileSpec); - Result := GzItem; - except - Result := nil; - end; - end; -end; - -destructor TAbGzipArchive.Destroy; -begin - SwapToGzip; - FTarList.Free; - FTarStream.Free; - inherited Destroy; -end; - - -procedure TAbGzipArchive.ExtractItemAt(Index: Integer; - const UseName: string); -var - OutStream : TFileStream; - CurItem : TAbGzipItem; -begin - if IsGZippedTar and TarAutoHandle then begin - SwapToTar; - inherited ExtractItemAt(Index, UseName); - end - else begin - SwapToGzip; - if Index > 0 then Index := 0; { only one item in a GZip} - - CurItem := TAbGzipItem(ItemList[Index]); - - OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyNone); - try - try {OutStream} - ExtractItemToStreamAt(Index, OutStream); - finally {OutStream} - OutStream.Free; - end; {OutStream} - AbSetFileTime(UseName, CurItem.LastModTimeAsDateTime); - AbSetFileAttr(UseName, CurItem.NativeFileAttributes); - except - on E : EAbUserAbort do begin - FStatus := asInvalid; - if FileExists(UseName) then - DeleteFile(UseName); - raise; - end else begin - if FileExists(UseName) then - DeleteFile(UseName); - raise; - end; - end; - end; -end; - -procedure TAbGzipArchive.ExtractItemToStreamAt(Index: Integer; - aStream: TStream); -var - GzHelp : TAbGzipStreamHelper; -begin - if IsGzippedTar and TarAutoHandle then begin - SwapToTar; - inherited ExtractItemToStreamAt(Index, aStream); - end - else begin - SwapToGzip; - { note Index ignored as there's only one item in a GZip } - - GZHelp := TAbGzipStreamHelper.Create(FGzStream); - try - { read GZip Header } - GzHelp.ReadHeader; - - { extract copy data from GZip} - GzHelp.ExtractItemData(aStream); - - { Get validation data } - GzHelp.ReadTail; - - {$IFDEF STRICTGZIP} - { According to - http://www.gzip.org/zlib/rfc1952.txt - - A compliant gzip compressor should calculate and set the CRC32 and ISIZE. - However, a compliant decompressor should not check these values. - - If you want to check the the values of the CRC32 and ISIZE in a GZIP file - when decompressing enable the STRICTGZIP define contained in AbDefine.inc } - - { validate against CRC } - if GzHelp.FItem.Crc32 <> GzHelp.TailCRC then - raise EAbGzipBadCRC.Create; - - { validate against file size } - if GzHelp.FItem.UncompressedSize <> GZHelp.TailSize then - raise EAbGzipBadFileSize.Create; - {$ENDIF} - finally - GzHelp.Free; - end; - end; -end; - -function TAbGzipArchive.FixName(const Value: string): string; -{ fix up fileaname for storage } -begin - if FState = gsTar then - Result := inherited FixName( Value ) - else begin - {GZip files Always strip the file path} - StoreOptions := StoreOptions + [soStripDrive, soStripPath]; - Result := ''; - if Value <> '' then - Result := ExtractFileName(Value); - end; -end; - -function TAbGzipArchive.GetIsGzippedTar: Boolean; -begin - Result := FIsGzippedTar; -end; - -function TAbGzipArchive.GetItem(Index: Integer): TAbGzipItem; -begin - Result := nil; - if Index = 0 then - Result := TAbGzipItem(FItemList.Items[Index]); -end; - -function TAbGzipArchive.GetSupportsEmptyFolders : Boolean; -begin - Result := IsGzippedTar and TarAutoHandle; -end; - -procedure TAbGzipArchive.LoadArchive; -var - GzHelp : TAbGzipStreamHelper; - Item : TAbGzipItem; - Abort : Boolean; -begin - SwapToGzip; - if FGzStream.Size > 0 then begin - GzHelp := TAbGzipStreamHelper.Create(FGzStream); - try - if GzHelp.FindFirstItem then begin - Item := TAbGzipItem.Create; - Item.LoadGzHeaderFromStream(FGzStream); - FGzStream.Seek(-SizeOf(TAbGzTailRec), soEnd); - GZHelp.ReadTail; - Item.CRC32 := GZHelp.TailCRC; - Item.UncompressedSize := GZHelp.TailSize; - - Item.Action := aaNone; - FGZItem.Add(Item); - - if IsGzippedTar and TarAutoHandle then begin - { extract Tar and set stream up } - FTarStream.SwapFileDirectory := FTempDir; - GzHelp.SeekToItemData; - GzHelp.ExtractItemData(FTarStream); - SwapToTar; - inherited LoadArchive; - end; - end; - - DoArchiveProgress(100, Abort); - FIsDirty := False; - finally - { Clean Up } - GzHelp.Free; - end; - end; -end; - -procedure TAbGzipArchive.PutItem(Index: Integer; const Value: TAbGzipItem); -begin - if Index = 0 then - FItemList.Items[Index] := Value; -end; - -procedure TAbGzipArchive.SaveArchive; -var - InGzHelp, OutGzHelp : TAbGzipStreamHelper; - Abort : Boolean; - i : Integer; - NewStream : TAbVirtualMemoryStream; - UncompressedStream : TStream; - SaveDir : string; - CurItem : TAbGzipItem; -begin - {prepare for the try..finally} - OutGzHelp := nil; - NewStream := nil; - - try - InGzHelp := TAbGzipStreamHelper.Create(FGzStream); - - try - {init new archive stream} - NewStream := TAbVirtualMemoryStream.Create; - OutGzHelp := TAbGzipStreamHelper.Create(NewStream); - - { create helper } - NewStream.SwapFileDirectory := FTempDir; - - { save the Tar data } - if IsGzippedTar and TarAutoHandle then begin - SwapToTar; - inherited SaveArchive; - if FGZItem.Count = 0 then begin - CurItem := TAbGzipItem.Create; - FGZItem.Add(CurItem); - end; - CurItem := FGZItem[0] as TAbGzipItem; - CurItem.Action := aaNone; - CurItem.LastModTimeAsDateTime := Now; - CurItem.SaveGzHeaderToStream(NewStream); - FTarStream.Position := 0; - OutGzHelp.WriteArchiveItem(FTarStream); - CurItem.CRC32 := OutGzHelp.CRC; - CurItem.UncompressedSize := OutGzHelp.FileSize; - OutGzHelp.WriteArchiveTail; - end - else begin - SwapToGzip; - - {build new archive from existing archive} - for i := 0 to pred(Count) do begin - FCurrentItem := ItemList[i]; - CurItem := TAbGzipItem(ItemList[i]); - InGzHelp.SeekToItemData; - - case CurItem.Action of - aaNone, aaMove : begin - {just copy the file to new stream} - CurItem.SaveGzHeaderToStream(NewStream); - InGzHelp.SeekToItemData; - NewStream.CopyFrom(FGZStream, FGZStream.Size - FGZStream.Position); - end; - - aaDelete: {doing nothing omits file from new stream} ; - - aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin - try - if (CurItem.Action = aaStreamAdd) then begin - { adding from a stream } - CurItem.SaveGzHeaderToStream(NewStream); - CurItem.UncompressedSize := InStream.Size; - OutGzHelp.WriteArchiveItem(InStream); - OutGzHelp.WriteArchiveTail; - end - else begin - { it's coming from a file } - GetDir(0, SaveDir); - try {SaveDir} - if (BaseDirectory <> '') then - ChDir(BaseDirectory); - CurItem.LastModTimeAsDateTime := AbGetFileTime(CurItem.DiskFileName); - UncompressedStream := TFileStream.Create(CurItem.DiskFileName, - fmOpenRead or fmShareDenyWrite ); - finally {SaveDir} - ChDir( SaveDir ); - end; {SaveDir} - - try - CurItem.UncompressedSize := UncompressedStream.Size; - CurItem.SaveGzHeaderToStream(NewStream); - OutGzHelp.WriteArchiveItem(UncompressedStream); - OutGzHelp.WriteArchiveTail; - - finally {UncompressedStream} - UncompressedStream.Free; - end; {UncompressedStream} - end; - except - ItemList[i].Action := aaDelete; - DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0); - end; - end; - end; {case} - end; { for } - end; - finally - InGzHelp.Free; - end; - - {copy new stream to FStream} - SwapToGzip; - NewStream.Position := 0; - if (FStream is TMemoryStream) then - TMemoryStream(FStream).LoadFromStream(NewStream) - else if FOwnsStream then begin - { need new stream to write } - FreeAndNil(FStream); - FGZStream := nil; - FStream := TFileStream.Create(FArchiveName, fmCreate or fmShareDenyWrite); - FGZStream := FStream; - FStream.CopyFrom(NewStream, NewStream.Size); - end - else begin - FStream.Size := 0; - FStream.Position := 0; - FStream.CopyFrom(NewStream, NewStream.Size); - end; - - {update Items list} - for i := pred( Count ) downto 0 do begin - if ItemList[i].Action = aaDelete then - FItemList.Delete( i ) - else if ItemList[i].Action <> aaFailed then - ItemList[i].Action := aaNone; - end; - - if IsGzippedTar and TarAutoHandle then - SwapToTar; - - DoArchiveSaveProgress( 100, Abort ); - DoArchiveProgress( 100, Abort ); - finally {NewStream} - OutGzHelp.Free; - NewStream.Free; - end; -end; - -procedure TAbGzipArchive.SetTarAutoHandle(const Value: Boolean); -begin - if Value then - SwapToTar - else - SwapToGzip; - FTarAutoHandle := Value; -end; - -procedure TAbGzipArchive.TestItemAt(Index: Integer); -var - SavePos : LongInt; - GZType : TAbArchiveType; - BitBucket : TAbBitBucketStream; - GZHelp : TAbGzipStreamHelper; -begin - if IsGzippedTar and TarAutoHandle then begin - inherited TestItemAt(Index); - end - else begin - { note Index ignored as there's only one item in a GZip } - SavePos := FGzStream.Position; - GZType := VerifyGZip(FGZStream); - if not (GZType in [atGZip, atGZippedTar]) then - raise EAbGzipInvalid.Create; - - BitBucket := nil; - GZHelp := nil; - try - BitBucket := TAbBitBucketStream.Create(1024); - GZHelp := TAbGzipStreamHelper.Create(FGZStream); - - GZHelp.ExtractItemData(BitBucket); - GZHelp.ReadTail; - - { validate against CRC } - if GzHelp.FItem.Crc32 <> GZHelp.TailCRC then - raise EAbGzipBadCRC.Create; - - { validate against file size } - if GzHelp.FItem.UncompressedSize <> GZHelp.TailSize then - raise EAbGzipBadFileSize.Create; - - finally - GZHelp.Free; - BitBucket.Free; - end; - - FGzStream.Position := SavePos; - end; -end; - -procedure TAbGzipArchive.DoSpanningMediaRequest(Sender: TObject; - ImageNumber: Integer; var ImageName: string; var Abort: Boolean); -begin - Abort := False; -end; - -end. diff --git a/components/Abbrevia/source/AbHexVw.pas b/components/Abbrevia/source/AbHexVw.pas deleted file mode 100644 index bee0569..0000000 --- a/components/Abbrevia/source/AbHexVw.pas +++ /dev/null @@ -1,112 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbHexVw.pas *} -{*********************************************************} -{* Abbrevia: Hex View utility *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbHexVw; -{$ENDIF} - -interface - -uses - Classes, -{$IFDEF UsingCLX} - QStdCtrls, QGraphics, -{$ELSE} - StdCtrls, Graphics, -{$ENDIF} - SysUtils; -type - THexView = class(TMemo) - protected - FBlockSize : Integer; - public - procedure SetStream(Strm : TStream); - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - property Stream : TStream write SetStream; - property BlockSize : Integer read FBlockSize write FBlockSize; - end; - -implementation - -constructor THexView.Create(AOwner : TComponent); -begin - Inherited Create(AOwner); - Font.Style := Font.Style + [fsBold]; - ReadOnly := True; - ScrollBars := ssVertical; - WordWrap := False; - WantTabs := True; - FBlockSize := 512; -end; - -destructor THexView.Destroy; -begin - inherited Destroy; -end; - -procedure THexView.SetStream(Strm : TStream); -var - Buff : Array[0..15] of Byte; - i, j : Integer; - Str : String; - StrList : TStringList; -begin - Strm.Seek(0, soBeginning); - StrList := TStringList.Create; - Clear; - while Strm.Position < Strm.Size do begin - if ((Strm.Position mod FBlockSize) = 0) then - StrList.Add('==========================================================='); - Str := ''; - - for j := 0 to 15 do - Buff[j] := Byte(chr(0)); - Strm.Read(Buff, 16); - Str := Str + Format('%4.4X', [strm.Position - $10]) + ':' + #9; - - for i := 0 to 15 do begin - Str := Str + Format('%2.2X', [Buff[i]]) + ' '; - if i = 7 then Str := Str + #9; - end; - Str := Str + #9; - for i := 0 to 15 do begin - if (Buff[i] < $30) then - Buff[i] := byte('.'); - Str := Str + Char(Buff[i]); - end; - StrList.Add(Str); - end; - SetLines(StrList); - StrList.Free; -end; - -end. diff --git a/components/Abbrevia/source/AbLZMA.pas b/components/Abbrevia/source/AbLZMA.pas deleted file mode 100644 index 5477afd..0000000 --- a/components/Abbrevia/source/AbLZMA.pas +++ /dev/null @@ -1,630 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is Craig Peterson - * - * Portions created by the Initial Developer are Copyright (C) 2011 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * Pierre le Riche - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbLZMA.pas *} -{*********************************************************} -{* ABBREVIA: Lzma compression/decompression procedures. *} -{*********************************************************} - -unit AbLZMA; - -{$I AbDefine.inc} - -interface - -uses - Classes, {Windows,} SysUtils{, AbCrtl, AbUtils}; - -{ Raw LZMA decompression =================================================== } - -{ Decompresses the LZMA compressed data in ASrc to ADes. ASrc should not have - the header used by the other compression/decompression routines, and - AProperties should contain any necessary data. } -procedure LzmaDecodeStream(AProperties: PByte; APropSize: Integer; ASrc, ADes: TStream; - AUncompressedSize: Int64 = -1); overload; - - -{ Stream compression and decompression (taken from LzmaUtil.c) ============= } - -procedure LzmaDecodeStream(ASourceStream, ATargetStream: TStream); overload; -procedure LzmaEncodeStream(ASourceStream, ATargetStream: TStream; ASourceSize: Int64); - - -{ In-memory compression and decompression ================================== } - -{ Given a pointer to the compressed data, this will return the size of the - decompressed data. } -function LzmaGetUncompressedSize(APCompressedData: Pointer; ACompressedSize: Integer): Integer; - -{ Decompresses the LZMA compressed data at APCompressedData to the buffer - pointed to by APUncompressedData. The buffer at APUncompressedData should be - large enough to hold the number of bytes as returned by LzmaGetDecompressedSize. } -procedure LzmaDecodeBuffer(APCompressedData: Pointer; ACompressedSize: Integer; - APUncompressedData: Pointer); - -{ Compresses the data at APUncompressedData to the buffer at APCompressedData, - and returns the number of bytes written. If ACompressedDataBufferCapacity is - less than the number of bytes required to store the entire compressed stream, - or any other error occurs, then an exception is raised. (A safe number for - ACompressedDataBufferCapacity is slightly more than AUncompressedDataBufferSize.) - Leave ACompressionLevel and ADictionarySize at -1 in order to use the default - values (5 and 16MB respectively). } -function LzmaEncodeBuffer(APUncompressedData: Pointer; AUncompressedSize: Integer; - APCompressedData: Pointer; ACompressedDataBufferCapacity: Integer; - ACompressionLevel: Integer = -1; ADictionarySize: Integer = -1): Integer; - - -{ Types.h declarations ===================================================== } - -const - SZ_OK = 0; - SZ_ERROR_DATA = 1; - SZ_ERROR_MEM = 2; - SZ_ERROR_CRC = 3; - SZ_ERROR_UNSUPPORTED = 4; - SZ_ERROR_PARAM = 5; - SZ_ERROR_INPUT_EOF = 6; - SZ_ERROR_OUTPUT_EOF = 7; - SZ_ERROR_READ = 8; - SZ_ERROR_WRITE = 9; - SZ_ERROR_PROGRESS = 10; - SZ_ERROR_FAIL = 11; - SZ_ERROR_THREAD = 12; - SZ_ERROR_ARCHIVE = 16; - SZ_ERROR_NO_ARCHIVE = 17; - -type - SRes = Integer; - - ISeqInStream = packed record - Read: function(p: Pointer; var buf; var size: size_t): SRes; cdecl; - end; - PISeqInStream = ^ISeqInStream; - - ISeqOutStream = packed record - Write: function(p: Pointer; const buf; size: size_t): size_t; cdecl; - end; - PISeqOutStream = ^ISeqOutStream; - - ICompressProgress = packed record - Progress: function(p: Pointer; inSize, outSize: Int64): SRes; cdecl; - end; - PICompressProgress = ^ICompressProgress; - - ISzAlloc = packed record - Alloc: function(p: Pointer; size: size_t): Pointer; cdecl; - Free: procedure(p: Pointer; address: Pointer); cdecl; - end; - PISzAlloc = ^ISzAlloc; - - -{ LzmaDec.h declarations =================================================== } - -type - CLzmaProb = Word; - -// LZMA Properties -const - LZMA_PROPS_SIZE = 5; - -type - CLzmaProps = packed record - lc, lp, pb: Cardinal; - dicSize: UInt32; - end; - -// LZMA Decoder state -const - LZMA_REQUIRED_INPUT_MAX = 20; - -type - CLzmaDec = packed record - prop: CLzmaProps; - probs: ^CLzmaProb; - dic: PByte; - buf: PByte; - range, code: UInt32; - dicPos: size_t; - dicBufSize: size_t; - processedPos: UInt32; - checkDicSize: UInt32; - state: Cardinal; - reps: array[0..3] of UInt32; - remainLen: Cardinal; - needFlush: Integer; - needInitState: Integer; - numProbs: UInt32; - tempBufSize: Cardinal; - tempBuf: array[0..LZMA_REQUIRED_INPUT_MAX - 1] of Byte; - end; - -type - ELzmaFinishMode = LongInt; - -const - LZMA_FINISH_ANY = 0; // finish at any point - LZMA_FINISH_END = 1; // block must be finished at the end - -type - ELzmaStatus = LongInt; - -const - LZMA_STATUS_NOT_SPECIFIED = 0; // use main error code instead - LZMA_STATUS_FINISHED_WITH_MARK = 1; // stream was finished with end mark. - LZMA_STATUS_NOT_FINISHED = 3; // stream was not finished - LZMA_STATUS_NEEDS_MORE_INPUT = 4; // you must provide more input bytes - LZMA_STATUS_MAYBE_FINISHED_WITHOUT_MARK = 5; // there is probability that stream was finished without end mark - -procedure LzmaDec_Construct(var p: CLzmaDec); cdecl; -procedure LzmaDec_Init(var p: CLzmaDec); cdecl; external; -function LzmaDec_DecodeToBuf(var p: CLzmaDec; dest: PByte; var destLen: size_t; - src: PByte; var srcLen: size_t; finishMode: ELzmaFinishMode; - var status: ELzmaStatus): SRes; cdecl; external; -function LzmaDec_Allocate(var state: CLzmaDec; prop: PByte; propsSize: Integer; - alloc: PISzAlloc): SRes; cdecl; external; -procedure LzmaDec_Free(var state: CLzmaDec; alloc: PISzAlloc); cdecl; external; - -// One call decoding interface -function LzmaDecode(dest: PByte; var destLen: size_t; src: PByte; - var srcLen: size_t; propData: PByte; propSize: Integer; - finishMode: ELzmaFinishMode; var status: ELzmaStatus; - alloc: PISzAlloc): SRes; cdecl; external; - - -{ LzmaEnc.h declarations =================================================== } - -type - CLzmaEncHandle = Pointer; - - CLzmaEncProps = packed record - level: Integer; // 0 <= level <= 9 - dictSize: UInt32; // (1 << 12) <= dictSize <= (1 << 27) for 32-bit version - // (1 << 12) <= dictSize <= (1 << 30) for 64-bit version - // default = (1 << 24) - lc: Integer; // 0 <= lc <= 8, default = 3 - lp: Integer; // 0 <= lp <= 4, default = 0 - pb: Integer; // 0 <= pb <= 4, default = 2 - algo: Integer; // 0 - fast, 1 - normal, default = 1 - fb: Integer; // 5 <= fb <= 273, default = 32 - btMode: Integer; // 0 - hashChain Mode, 1 - binTree mode - normal, default = 1 - numHashBytes: Integer; // 2, 3 or 4, default = 4 - mc: UInt32; // 1 <= mc <= (1 << 30), default = 32 - writeEndMark: Cardinal; // 0 - do not write EOPM, 1 - write EOPM, default = 0 - numThreads: Integer; // 1 or 2, default = 2 - end; - -procedure LzmaEncProps_Init(var p: CLzmaEncProps); cdecl; external; -function LzmaEnc_Create(Alloc: PISzAlloc): CLzmaEncHandle; cdecl; external; -procedure LzmaEnc_Destroy(p: CLzmaEncHandle; Alloc, allocBig: PISzAlloc); cdecl; external; -function LzmaEnc_SetProps(p: CLzmaEncHandle; var props: CLzmaEncProps): SRes; cdecl; external; -function LzmaEnc_WriteProperties(p: CLzmaEncHandle; properties: PByte; - var size: size_t): SRes; cdecl; external; -function LzmaEnc_Encode(p: CLzmaEncHandle; outStream: PISeqOutStream; - inStream: PISeqInStream; Progress: PICompressProgress; - Alloc, allocBig: PISzAlloc): SRes; cdecl; external; -function LzmaEnc_MemEncode(p: CLzmaEncHandle; dest: PByte; var destLen: size_t; - src: PByte; srcLen: size_t; writeEndMark: Integer; Progress: PICompressProgress; - Alloc, allocBig: PISzAlloc): SRes; cdecl; external; - -// One call encoding interface -function LzmaEncode(dest: PByte; var destLen: size_t; src: PByte; - srcLen: size_t; var props: CLzmaEncProps; propsEncoded: PByte; - var propsSize: size_t; writeEndMark: Integer; progress: PICompressProgress; - alloc: pISzAlloc; allocBig: PISzAlloc): SRes; cdecl; external; - - -{ LzFind.h declarations ==================================================== } - -procedure MatchFinder_NeedMove; external; -procedure MatchFinder_GetPointerToCurrentPos; external; -procedure MatchFinder_MoveBlock; external; -procedure MatchFinder_ReadIfRequired; external; -procedure MatchFinder_Construct; external; -procedure MatchFinder_Create; external; -procedure MatchFinder_Free; external; -procedure MatchFinder_Normalize3; external; -procedure MatchFinder_ReduceOffsets; external; -procedure GetMatchesSpec1; external; -procedure MatchFinder_Init; external; -procedure MatchFinder_CreateVTable; external; - - -{ LzFindMt.h declarations ================================================== } - -procedure MatchFinderMt_Construct; external; -procedure MatchFinderMt_Destruct; external; -procedure MatchFinderMt_Create; external; -procedure MatchFinderMt_CreateVTable; external; -procedure MatchFinderMt_ReleaseStream; external; - - -{ Lzma header fields ======================================================= } - -type - // The condensed compression properties - TLZMAPropertyData = array[0..LZMA_PROPS_SIZE - 1] of Byte; - - // The header usually stored in front of LZMA compressed data - TLZMAHeader = packed record - PropertyData: TLZMAPropertyData; - UncompressedSize: Int64; - end; - PLZMAHeader = ^TLZMAHeader; - - -{ Error handling =========================================================== } - -type - EAbLZMAException = class(Exception); - -procedure LzmaCheck(AResultCode: SRes); -procedure RaiseLzmaException(AResultCode: SRes); - - -{ Linker directives ======================================================== } - -{$WARN BAD_GLOBAL_SYMBOL OFF} -{$IF DEFINED(WIN32)} - {$L Win32\LzFind.obj} - {$L Win32\LzFindMt.obj} - {$L Win32\LzmaDec.obj} - {$L Win32\LzmaEnc.obj} - {$L Win32\Threads.obj} -{$ELSEIF DEFINED(WIN64)} - {$L Win64\LzFind.obj} - {$L Win64\LzFindMt.obj} - {$L Win64\LzmaDec.obj} - {$L Win64\LzmaEnc.obj} - {$L Win64\Threads.obj} -{$IFEND} - - -implementation - -{ Error handling =========================================================== } - -procedure LzmaCheck(AResultCode: SRes); -begin - if AResultCode <> SZ_OK then - RaiseLzmaException(AResultCode); -end; -{ -------------------------------------------------------------------------- } -procedure RaiseLzmaException(AResultCode: SRes); -begin - case AResultCode of - SZ_ERROR_DATA: raise EAbLZMAException.Create('LZMA Data Error.'); - SZ_ERROR_MEM: raise EAbLZMAException.Create('LZMA Memory Error.'); - SZ_ERROR_CRC: raise EAbLZMAException.Create('LZMA CRC Error.'); - SZ_ERROR_UNSUPPORTED: raise EAbLZMAException.Create('LZMA "Unsupported" Error.'); - SZ_ERROR_PARAM: raise EAbLZMAException.Create('LZMA Parameter Error.'); - SZ_ERROR_INPUT_EOF: raise EAbLZMAException.Create('LZMA Input EOF Error.'); - SZ_ERROR_OUTPUT_EOF: raise EAbLZMAException.Create('LZMA Output EOF Error.'); - SZ_ERROR_READ: raise EAbLZMAException.Create('LZMA Read Error.'); - SZ_ERROR_WRITE: raise EAbLZMAException.Create('LZMA Write Error.'); - SZ_ERROR_PROGRESS: raise EAbLZMAException.Create('LZMA Progress Error.'); - SZ_ERROR_FAIL: raise EAbLZMAException.Create('LZMA "Fail" Error.'); - SZ_ERROR_THREAD: raise EAbLZMAException.Create('LZMA Thread Error.'); - SZ_ERROR_ARCHIVE: raise EAbLZMAException.Create('LZMA Archive Error.'); - SZ_ERROR_NO_ARCHIVE: raise EAbLZMAException.Create('LZMA "No Archive" Error.'); - else - raise EAbLZMAException.CreateFmt('Unknown LZMA error (%d)', [AResultCode]); - end; -end; - - -{ Helper Routines ========================================================== } - -procedure LzmaDec_Construct(var p: CLzmaDec); cdecl; -begin - p.dic := nil; - p.probs := nil; -end; -{ -------------------------------------------------------------------------- } -function SzAlloc(p: Pointer; size: size_t): Pointer; cdecl; -begin - Result := GetMemory(size); -end; -{ -------------------------------------------------------------------------- } -procedure SzFree(p, address: Pointer); cdecl; -begin - FreeMemory(address); -end; - -var - DelphiMMInterface: ISzAlloc = (Alloc: SzAlloc; Free: SzFree); - - -{ CSeq*Stream implementation =============================================== } - -type - CSeqInStream = packed record - Intf: ISeqInStream; - Stream: TStream; - end; - - CSeqOutStream = packed record - Intf: ISeqOutStream; - Stream: TStream; - end; -{ -------------------------------------------------------------------------- } -function ISeqInStream_Read(p: Pointer; var buf; var size: size_t): SRes; cdecl; -begin - try - size := CSeqInStream(p^).Stream.Read(buf, size); - Result := SZ_OK; - except - Result := SZ_ERROR_DATA; - end; -end; -{ -------------------------------------------------------------------------- } -function ISeqOutStream_Write(p: Pointer; const buf; size: size_t): size_t; cdecl; -begin - try - Result := CSeqOutStream(p^).Stream.Write(buf, size); - except - Result := 0; - end; -end; - - -{ Raw LZMA decompression =================================================== } - -{ Decompress an Lzma compressed stream. Based on LzmaUtil.c::Decode2 } -function LzmaDecode2(var aState: CLzmaDec; aOutStream, aInStream: TStream; - aUncompressedSize: Int64 = -1): SRes; -const - IN_BUF_SIZE = 1 shl 16; - OUT_BUF_SIZE = 1 shl 16; -var - LHasSize: Boolean; - LInBuf: array [0..IN_BUF_SIZE - 1] of Byte; - LOutBuf: array [0..OUT_BUF_SIZE - 1] of Byte; - LInPos, LInSize, LOutPos: size_t; - LInProcessed, LOutProcessed: size_t; - LFinishMode: ELzmaFinishMode; - LStatus: ELzmaStatus; -begin - Result := 0; - LHasSize := aUncompressedSize <> -1; - LInPos := 0; - LInSize := 0; - LOutPos := 0; - - LzmaDec_Init(aState); - while True do - begin - if LInPos = LInSize then - begin - LInSize := aInStream.Read(LInBuf, IN_BUF_SIZE); - LInPos := 0; - if LInSize = 0 then - Break; - end - else - begin - LInProcessed := LInSize - LInPos; - LOutProcessed := OUT_BUF_SIZE - LOutPos; - LFinishMode := LZMA_FINISH_ANY; - if LHasSize and (LOutProcessed > aUncompressedSize) then - begin - LOutProcessed := size_t(aUncompressedSize); - LFinishMode := LZMA_FINISH_END; - end; - Result := LzmaDec_DecodeToBuf(aState, @LOutBuf[LOutPos], LOutProcessed, - @LInBuf[LInPos], LInProcessed, LFinishMode, LStatus); - Inc(LInPos, LInProcessed); - Inc(LOutPos, LOutProcessed); - Dec(aUncompressedSize, LOutProcessed); - - if (aOutStream <> nil) and (aOutStream.Write(LOutBuf, LOutPos) <> LOutPos) then - begin - Result := SZ_ERROR_WRITE; - Exit; - end; - - LOutPos := 0; - - if (Result <> SZ_OK) or (LHasSize and (aUncompressedSize = 0)) then - Exit; - - if (LInProcessed = 0) and (LOutProcessed = 0) then - begin - if LHasSize or (LStatus <> LZMA_STATUS_FINISHED_WITH_MARK) then - Result := SZ_ERROR_DATA; - Exit; - end; - end; - end; -end; -{ -------------------------------------------------------------------------- } -{ Decompress an LZMA compressed stream. Pass AUncompressedSize = -1 if the - uncompressed size is not known. } -procedure LzmaDecodeStream(AProperties: PByte; APropSize: Integer; - ASrc, ADes: TStream; AUncompressedSize: Int64); -var - LLZMADecState: CLzmaDec; -begin - LzmaDec_Construct(LLZMADecState); - try - LzmaCheck(LzmaDec_Allocate(LLZMADecState, AProperties, APropSize, @DelphiMMInterface)); - LzmaCheck(LzmaDecode2(LLZMADecState, ADes, ASrc, AUncompressedSize)); - finally - LzmaDec_Free(LLZMADecState, @DelphiMMInterface); - end; -end; - - -{ Stream to stream compression and decompression =========================== } - -{ Decompresses streams compressed with the LZMA SDK's LzmaUtil.exe. - Based on LzmaUtil.c::Decode } -procedure LzmaDecodeStream(ASourceStream, ATargetStream: TStream); -var - LUncompressedSize: Int64; - // Header: 5 bytes of LZMA properties and 8 bytes of uncompressed size - LHeader: TLZMAHeader; -begin - // Read and parse header - ASourceStream.ReadBuffer(LHeader, SizeOf(LHeader)); - LUncompressedSize := LHeader.UncompressedSize; - - LzmaDecodeStream(PByte(@LHeader.PropertyData), LZMA_PROPS_SIZE, ASourceStream, - ATargetStream, LUncompressedSize); -end; -{ -------------------------------------------------------------------------- } -{ Compresses a stream so it's compatible with the LZMA SDK's LzmaUtil.exe. - Based on LzmaUtil.c::Encode } -procedure LzmaEncodeStream(ASourceStream, ATargetStream: TStream; ASourceSize: Int64); -var - LEncHandle: CLzmaEncHandle; - LEncProps: CLzmaEncProps; - LHeader: TLZMAHeader; - LPropDataSize: size_t; - LInStreamRec: CSeqInStream; - LOutStreamRec: CSeqOutStream; -begin - LInStreamRec.Intf.Read := ISeqInStream_Read; - LInStreamRec.Stream := ASourceStream; - LOutStreamRec.Intf.Write := ISeqOutStream_Write; - LOutStreamRec.Stream := ATargetStream; - - LEncHandle := LzmaEnc_Create(@DelphiMMInterface); - if LEncHandle = nil then - LzmaCheck(SZ_ERROR_MEM); - - try - LzmaEncProps_Init(LEncProps); - - LzmaCheck(LzmaEnc_SetProps(LEncHandle, LEncProps)); - - LPropDataSize := LZMA_PROPS_SIZE; - - LzmaCheck(LzmaEnc_WriteProperties(LEncHandle, PByte(@LHeader.PropertyData), - LPropDataSize)); - - LHeader.UncompressedSize := ASourceSize; - - ATargetStream.WriteBuffer(LHeader, SizeOf(LHeader)); - - LzmaCheck(LzmaEnc_Encode(LEncHandle, @LOutStreamRec.Intf, - @LInStreamRec.Intf, nil, @DelphiMMInterface, @DelphiMMInterface)); - - finally - LzmaEnc_Destroy(LEncHandle, @DelphiMMInterface, @DelphiMMInterface); - end; -end; - - -{ In-memory compression and decompression ================================== } - -{ Given a pointer to the compressed data, this will return the size of the - decompressed data. } -function LzmaGetUncompressedSize(APCompressedData: Pointer; ACompressedSize: Integer): Integer; -begin - if ACompressedSize <= SizeOf(TLZMAHeader) then - raise EAbLZMAException.Create('The LZMA compressed data is invalid (not enough bytes)'); - - Result := PLZMAHeader(APCompressedData).UncompressedSize; -end; -{ -------------------------------------------------------------------------- } -{ Decompresses the LZMA compressed data at APCompressedData to the buffer - pointed to by APUncompressedData. The buffer at APUncompressedData should be - large enough to hold the number of bytes as returned by LzGetDecompressedSize. } -procedure LzmaDecodeBuffer(APCompressedData: Pointer; ACompressedSize: Integer; - APUncompressedData: Pointer); -var - LPropertyData: TLZMAPropertyData; - LUncompressedSize: Int64; - LInputByteCount, LOutputByteCount: size_t; - LStatus: ELzmaStatus; -begin - if ACompressedSize <= SizeOf(TLZMAHeader) then - raise EAbLZMAException.Create('The LZMA compressed data is invalid (not enough bytes)'); - - // Read the header from the compressed data. - LPropertyData := PLZMAHeader(APCompressedData).PropertyData; - LUncompressedSize := PLZMAHeader(APCompressedData).UncompressedSize; - Inc(PAnsiChar(APCompressedData), SizeOf(TLZMAHeader)); - Dec(ACompressedSize, SizeOf(TLZMAHeader)); - - // Decompress from the input to the output buffer. This will change the byte - // count variables to the actual number of bytes consumed/written. - LInputByteCount := ACompressedSize; - LOutputByteCount := LUncompressedSize; - LzmaCheck(LzmaDecode(APUncompressedData, LOutputByteCount, - APCompressedData, LInputByteCount, PByte(@LPropertyData), LZMA_PROPS_SIZE, - LZMA_FINISH_END, LStatus, @DelphiMMInterface)); - - // Check that the input buffer was fully consumed and the output buffer was filled up. - if (LOutputByteCount <> LUncompressedSize) or (LInputByteCount <> ACompressedSize) then - raise EAbLZMAException.Create('LZMA decompression data error'); -end; -{ -------------------------------------------------------------------------- } -{ Compresses the data at APUncompressedData to the buffer at APCompressedData, - and returns the number of bytes written. If ACompressedDataBufferCapacity is - less than the number of bytes required to store the entire compressed stream, - or any other error occurs, then an exception is raised. (A safe number for - ACompressedDataBufferCapacity is slightly more than AUncompressedDataBufferSize.) - Leave ACompressionLevel and ADictionarySize at -1 in order to use the default - values (5 and 16MB respectively). } -function LzmaEncodeBuffer(APUncompressedData: Pointer; AUncompressedSize: Integer; - APCompressedData: Pointer; - ACompressedDataBufferCapacity, ACompressionLevel, ADictionarySize: Integer): Integer; -var - LEncProps: CLzmaEncProps; - LPropsSize: size_t; - LPOutBuf: PByte; - LOutputBytes: size_t; -begin - if ACompressedDataBufferCapacity <= SizeOf(TLZMAHeader) then - raise EAbLZMAException.Create('LZMA output buffer too small'); - - // Set the uncompressed size in the header - PLZMAHeader(APCompressedData).UncompressedSize := AUncompressedSize; - - // Set the properties - LzmaEncProps_Init(LEncProps); - if ACompressionLevel >= 0 then - LEncProps.level := ACompressionLevel; - if ADictionarySize >= 0 then - LEncProps.dictSize := ADictionarySize; - - LPOutBuf := PByte(PtrUInt(APCompressedData) + SizeOf(TLZMAHeader)); - LOutputBytes := ACompressedDataBufferCapacity - SizeOf(TLZMAHeader); - LPropsSize := LZMA_PROPS_SIZE; - LzmaCheck(LzmaEncode(LPOutBuf, LOutputBytes, APUncompressedData, - AUncompressedSize, LEncProps, APCompressedData, LPropsSize, 0, nil, - @DelphiMMInterface, @DelphiMMInterface)); - - Result := LOutputBytes + SizeOf(TLZMAHeader); -end; - -initialization - // The LZMA routines are multithreaded and use the Delphi memory manager. - IsMultiThread := True; - -end. diff --git a/components/Abbrevia/source/AbLZMAStream.pas b/components/Abbrevia/source/AbLZMAStream.pas deleted file mode 100644 index e1cfea0..0000000 --- a/components/Abbrevia/source/AbLZMAStream.pas +++ /dev/null @@ -1,836 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is Pierre le Riche - * - * Portions created by the Initial Developer are Copyright (C) 2011 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Pierre le Riche - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** - - -Usage: - LZMA Compression: - 1) Create a TAbLZMACompressionStream, passing as parameter to the constructor - the output stream where you want the compressed data stored. - 2) Write the data that you want to compress to the TAbLZMACompressionStream. - Compression occurs in a background thread. - 3) (Optional) Notify the background compression thread that no more data will - be written by calling NoMoreDataToCompress. Poll the IsBusy method to - determine whether the background thread is still busy. - 4) Free the TAbLZMACompressionStream to finish up and release resources. The - compressed data will now be available in the output stream. - - LZMA Decompression: - 1) Create a TAbLZMADecompressionStream, passing as parameter to the constructor - the stream that contains the compressed data. - 2) Read the decompressed data from TAbLZMADecompressionStream. - 3) Free the TAbLZMADecompressionStream to finish up and release resources. - -*) - -unit AbLZMAStream; - -{$I AbDefine.inc} - -interface - -uses - Windows, Classes, SysUtils, AbLZMA, AbUtils; - -const - {The size of the intermediate buffers for compressed and decompressed data.} - CompressedDataBufferSize = 16 * 1024; - UncompressedDataBufferSize = 32 * 1024; - {When reading/writing very small blocks from/to a (de)compression stream an - intermediate buffer is used to buffer the small IO operations in order to - improve performance. Reads and writes larger than this size are unbuffered - and handled by the (de)compression algorithm directly. This value must be - smaller than the compressed and uncompressed data buffers.} - MaximumBlockSizeForBufferedIO = 1024; - -type - - {------------LZMA compression stream------------} - - TAbLZMACompressionStream = class; - - {The background compression thread.} - TAbLZMACompressionThread = class(TThread) - protected - FCompressionStream: TAbLZMACompressionStream; - {$IFNDEF HasThreadFinished} - FFinished: Boolean; - procedure DoTerminate; override; - property Finished: Boolean read FFinished; - {$ENDIF} - public - procedure Execute; override; - end; - - {Buffers queued for compression by the background compression thread.} - PAbQueuedBuffer = ^TAbQueuedBuffer; - TAbQueuedBuffer = packed record - PreviousBuffer, NextBuffer: PAbQueuedBuffer; - DataSize: Integer; - {Adds this buffer to the compression queue for the given compression stream. - It is assumed that the compression stream has acquired the buffer critical - section.} - procedure QueueBuffer(ACompressionStream: TAbLZMACompressionStream); - {Removes this buffer from the compression queue} - procedure UnQueueBuffer; - {Returns a pointer to the data the given offset into the buffer} - function GetDataPointer(AOffset: Integer): Pointer; - end; - - TAbLZMACompressionStream = class(TStream) - protected - FOutputStream: TStream; - {The critical section used to control access to the buffers that are queued - for compression. The main thread and the compression thread may not access - the buffer queue at the same time.} - FBufferCriticalSection: TRTLCriticalSection; - {This semaphore is signalled by the main thread when it added a workload - for the compression thread (usually when a buffer has been added to - compress).} - FPendingWorkSemaphore: THandle; - {The LZMA compression handle} - FLZMAEncHandle: CLzmaEncHandle; - {The background thread used to perform the compression} - FCompressionThread: TAbLZMACompressionThread; - {The error code returned by the compression method. 0 = Success.} - FCompressionErrorCode: Integer; - {The intermediate compression buffer used to aggregate small writes. When - NoMoreDataToCompress is called this buffer is freed, so no more data may - be written.} - FPIntermediateCompressionBuffer: PAbQueuedBuffer; - FIntermediateCompressionBufferAvailableBytes: Integer; - {The circular linked list of buffers that are queued for compression.} - FQueuedData: TAbQueuedBuffer; - {The number of bytes of buffer FQueuedData.NextBuffer that has already been - submitted to the compressor.} - FCurrentBufferBytesSubmitted: Integer; - {The position in the output stream where the uncompressed size must be - stored.} - FOutputStreamHeaderSizeFieldPosition: Int64; - {The total number of bytes written to the compression stream} - FTotalBytesWritten: Int64; - {Wakes up the compression thread by signalling the "pending work semaphore"} - procedure WakeCompressionThread; inline; - public - constructor Create(AOutputStream: TStream; ACompressionLevel: Integer = 5; - ADictionarySize: Integer = 65536); - destructor Destroy; override; - {Reading is not supported and will raise an exception.} - function Read(var ABuffer; ACount: Longint): Longint; override; - {Submits data to the compression queue.} - function Write(const ABuffer; ACount: Longint): Longint; override; - {Will raise an exception if an attempt is made to seek off the current - position.} - function Seek(AOffset: Integer; AOrigin: Word): Integer; override; - function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override; - {Signals the compression thread that no more data will be submitted. - Calling write after NoMoreDataToCompress has been called will raise an - exception.} - procedure NoMoreDataToCompress; - {Calls NoMoreDataToCompress and then waits for the background compression - process to complete, returning the value of ErrorCode (0 = success).} - function WaitForCompressionToFinish: Integer; - {Returns True if the background thread is still busy compressing data. Will - always return True until NoMoreDataToCompress is called.} - function IsBusy: Boolean; - {-------------Public properties---------------} - {The error code returned by the compression method. 0 = Success.} - property ErrorCode: Integer read FCompressionErrorCode; - end; - - {------------LZMA decompression stream------------} - - TAbLZMADecompressionStream = class(TStream) - protected - FSourceStream: TStream; - {The intermediate buffers for compressed and uncompressed data - respectively.} - FCompressedDataBuffer: array[0..CompressedDataBufferSize - 1] of Byte; - FUncompressedDataBuffer: array[0..UncompressedDataBufferSize - 1] of Byte; - {Read buffer control: Used to speed up frequent small reads via - FUncompressedDataBuffer.} - FReadBufferSize: Integer; - FReadBufferAvailableBytes: Integer; - {The current size and position into FCompressedDataBuffer} - FCompressedDataBufferSize: Integer; - FCompressedDataBufferPosition: Integer; - {The uncompressed size according to the header.} - FUncompressedSize: Int64; - {The total number of bytes that have been decompressed.} - FBytesDecompressed: Int64; - {The LZMA decompression state} - FLzmaState: CLzmaDec; - {Decompresses data from the compressed source to the buffer pointed to by - APBuffer. Returns the number of actual bytes stored (which may be less - than the requested size if the end of the compressed stream was reached).} - function InternalDecompressToBuffer(APBuffer: Pointer; ABufferSize: Integer): Integer; - {---Property getters/setters---} - function GetBytesRead: Int64; - function GetSize: Int64; override; - public - constructor Create(ASourceStream: TStream); - destructor Destroy; override; - function Read(var ABuffer; ACount: Integer): Integer; override; - {Writing to a decompression stream is not allowed} - function Write(const ABuffer; ACount: Integer): Integer; override; - {Will raise an exception if an attempt is made to seek off the current - position.} - function Seek(AOffset: Integer; AOrigin: Word): Integer; override; - function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override; - {---Public properties---} - {The number of decompressed bytes read from the decompression stream.} - property BytesRead: Int64 read GetBytesRead; - end; - -implementation - -uses - AbCrtl; - -{------------Memory management-------------} - -function SzAlloc(p: Pointer; size: size_t): Pointer; cdecl; -begin - Result := GetMemory(size); -end; - -procedure SzFree(p, address: Pointer); cdecl; -begin - FreeMemory(address); -end; - -var - DelphiMMInterface: ISzAlloc = (Alloc: SzAlloc; Free: SzFree); - -{------------Compression "interface"-------------} - -type - - {The "interfaces" for the input and output streams} - CSeqInStream_Compress = packed record - Intf: ISeqInStream; - CompressionStream: TAbLZMACompressionStream; - end; - - CSeqOutStream_Compress = packed record - Intf: ISeqOutStream; - OutputStream: TStream; - end; - -function ISeqInStream_Compress_Read(p: Pointer; var buf; var size: size_t): SRes; cdecl; -var - LDoNotWaitForMoreData: Boolean; - LStream: TAbLZMACompressionStream; - LPSourceBuf, LPTargetBuf: PAnsiChar; - LTargetSpace, LSourceBytesAvail: Integer; - LPCurBuf: PAbQueuedBuffer; -begin - try - LTargetSpace := size; - LPTargetBuf := @buf; - LStream := CSeqInStream_Compress(p^).CompressionStream; - while True do - begin - {Copy any buffered data to the LZMA buffer, returning the number of bytes - written} - EnterCriticalSection(LStream.FBufferCriticalSection); - try - {If the write buffer has been freed that the main thread will not add - any more buffers for compression.} - LDoNotWaitForMoreData := LStream.FPIntermediateCompressionBuffer = nil; - - {Copy as much queued data to the LZMA compression buffer as we have (or - will fit).} - while True do - begin - LPCurBuf := LStream.FQueuedData.NextBuffer; - {No buffers left? -> Break the loop} - if LPCurBuf = @LStream.FQueuedData then - Break; - {Can this buffer be submitted in its entirety, or only a part?} - LPSourceBuf := LPCurBuf.GetDataPointer(LStream.FCurrentBufferBytesSubmitted); - LSourceBytesAvail := LPCurBuf.DataSize - LStream.FCurrentBufferBytesSubmitted; - if LSourceBytesAvail > LTargetSpace then - begin - {Submit only part of the buffer} - System.Move(LPSourceBuf^, LPTargetBuf^, LTargetSpace); - Inc(LStream.FCurrentBufferBytesSubmitted, LTargetSpace); - LTargetSpace := 0; - Break; - end - else - begin - {Submit all the remaining bytes in the buffer and free it.} - System.Move(LPSourceBuf^, LPTargetBuf^, LSourceBytesAvail); - Inc(LPTargetBuf, LSourceBytesAvail); - Dec(LTargetSpace, LSourceBytesAvail); - LStream.FCurrentBufferBytesSubmitted := 0; - LPCurBuf.UnQueueBuffer; - FreeMem(LPCurBuf); - end; - end; - finally - LeaveCriticalSection(LStream.FBufferCriticalSection); - end; - - {If data was submitted to the compressor, or the main thread indicated - that compression is complete then the loop is broken.} - if (LTargetSpace <> size) or LDoNotWaitForMoreData then - Break; - {No data currently queued, but there may still be more coming: Wait for - the main thread to notify this thread that more work is pending.} - WaitForSingleObject(LStream.FPendingWorkSemaphore, INFINITE); - end; - {Update the number of bytes written} - Dec(size, LTargetSpace); - Result := SZ_OK; - except - Result := SZ_ERROR_DATA; - end; -end; - -function ISeqOutStream_Compress_Write(p: Pointer; const buf; size: size_t): size_t; cdecl; -begin - try - Result := CSeqOutStream_Compress(p^).OutputStream.Write(buf, size); - except - Result := 0; - end; -end; - -{ TAbQueuedBuffer } - -function TAbQueuedBuffer.GetDataPointer(AOffset: Integer): Pointer; -begin - Result := Pointer(PtrUInt(@Self) + SizeOf(TAbQueuedBuffer) + PtrUInt(AOffset)); -end; - -procedure TAbQueuedBuffer.QueueBuffer(ACompressionStream: TAbLZMACompressionStream); -begin - PreviousBuffer:= ACompressionStream.FQueuedData.PreviousBuffer; - NextBuffer:= @ACompressionStream.FQueuedData; - ACompressionStream.FQueuedData.PreviousBuffer.NextBuffer := @Self; - ACompressionStream.FQueuedData.PreviousBuffer := @Self; -end; - -procedure TAbQueuedBuffer.UnQueueBuffer; -begin - PreviousBuffer.NextBuffer := NextBuffer; - NextBuffer.PreviousBuffer := PreviousBuffer; - PreviousBuffer := nil; - NextBuffer := nil; -end; - -{ TAbLZMACompressionStream } - -constructor TAbLZMACompressionStream.Create(AOutputStream: TStream; ACompressionLevel, - ADictionarySize: Integer); -var - LLZMAProps: CLzmaEncProps; - LLZMAPropData: TLZMAPropertyData; - LHeaderSize: size_t; -begin - inherited Create; - - FOutputStream := AOutputStream; - - {Initialize the linked list of buffers.} - FQueuedData.PreviousBuffer := @FQueuedData; - FQueuedData.NextBuffer := @FQueuedData; - - {Allocate the intermediate compression buffer} - GetMem(FPIntermediateCompressionBuffer, UncompressedDataBufferSize + SizeOf(TAbQueuedBuffer)); - FIntermediateCompressionBufferAvailableBytes := UncompressedDataBufferSize; - - {Initialize the critical section used to control access to the queued data - buffer.} - InitializeCriticalSection(FBufferCriticalSection); - {Create the semaphore used to put the worker thread to sleep when the input - buffer is empty.} - FPendingWorkSemaphore := CreateSemaphore(nil, 0, 1, nil); - - {Create the LZMA encoder} - FLZMAEncHandle := LzmaEnc_Create(@DelphiMMInterface); - if FLZMAEncHandle = nil then - raise Exception.Create('Unable to allocate memory for the LZMA compressor.'); - - {Set the compression properties} - LzmaEncProps_Init(LLZMAProps); - LLZMAProps.level := ACompressionLevel; - LLZMAProps.dictSize := ADictionarySize; - LzmaCheck(LzmaEnc_SetProps(FLZMAEncHandle, LLZMAProps)); - - {Store the header in the output stream, making note of the position in the - stream where the uncompressed size will be stored when compression is - completed.} - LHeaderSize := LZMA_PROPS_SIZE; - LzmaCheck(LzmaEnc_WriteProperties(FLZMAEncHandle, PByte(@LLZMAPropData), LHeaderSize)); - FOutputStream.WriteBuffer(LLZMAPropData, LHeaderSize); - FOutputStreamHeaderSizeFieldPosition := FOutputStream.Position; - FOutputStream.WriteBuffer(FTotalBytesWritten, SizeOf(FTotalBytesWritten)); - - {Create and start the compression thread.} - FCompressionThread := TAbLZMACompressionThread.Create(True); - FCompressionThread.FCompressionStream := Self; - {$IFDEF HasThreadStart} - FCompressionThread.Start; - {$ELSE} - FCompressionThread.Resume; - {$ENDIF} -end; - -destructor TAbLZMACompressionStream.Destroy; -var - LPBuf: PAbQueuedBuffer; - LOldPos: Int64; -begin - WaitForCompressionToFinish; - - {If something went wrong during creation of this object before the thread was - created, then the encoder handle may be non-nil.} - if FLZMAEncHandle <> nil then - begin - LzmaEnc_Destroy(FLZMAEncHandle, @DelphiMMInterface, @DelphiMMInterface); - FLZMAEncHandle := nil; - end; - - {Free the critical section and semaphore} - DeleteCriticalSection(FBufferCriticalSection); - CloseHandle(FPendingWorkSemaphore); - - {Free the intermediate compression buffer if something went wrong before the - thread could be created.} - FreeMem(FPIntermediateCompressionBuffer); - - {If compression failed there may be uncompressed data in the queue: free - those buffers.} - while True do - begin - LPBuf := FQueuedData.NextBuffer; - if LPBuf = @FQueuedData then - Break; - LPBuf.UnQueueBuffer; - FreeMem(LPBuf); - end; - - {Unpdate the uncompressed size in the header} - if FTotalBytesWritten > 0 then - begin - LOldPos := FOutputStream.Position; - FOutputStream.Position := FOutputStreamHeaderSizeFieldPosition; - FOutputStream.WriteBuffer(FTotalBytesWritten, SizeOf(FTotalBytesWritten)); - FOutputStream.Position := LOldPos; - end; - - inherited Destroy; -end; - -function TAbLZMACompressionStream.IsBusy: Boolean; -begin - Result := (FCompressionThread <> nil) and (not FCompressionThread.Finished); -end; - -procedure TAbLZMACompressionStream.NoMoreDataToCompress; -var - LUnqueuedBytes: Integer; -begin - if FPIntermediateCompressionBuffer <> nil then - begin - EnterCriticalSection(FBufferCriticalSection); - try - {No more data may be submitted at this point. Set the flag to indicate - this, and wake the compression thread so that it can finish up.} - LUnqueuedBytes := UncompressedDataBufferSize - FIntermediateCompressionBufferAvailableBytes; - if LUnqueuedBytes > 0 then - begin - FPIntermediateCompressionBuffer.DataSize := LUnqueuedBytes; - FPIntermediateCompressionBuffer.QueueBuffer(Self); - end - else - FreeMem(FPIntermediateCompressionBuffer); - {The temporary buffer is always released, so no further writes may be - performed.} - FPIntermediateCompressionBuffer := nil; - finally - LeaveCriticalSection(FBufferCriticalSection); - end; - {Wake up the compression thread so it can finish the compression process.} - WakeCompressionThread; - end; -end; - -function TAbLZMACompressionStream.Read(var ABuffer; ACount: Integer): Longint; -begin - raise Exception.Create('The compression stream does not support reading.'); -end; - -function TAbLZMACompressionStream.Seek(const AOffset: Int64; - AOrigin: TSeekOrigin): Int64; -begin - Result := FTotalBytesWritten; - if ((AOrigin <> soBeginning) or (AOffset <> Result)) - and ((AOrigin = soBeginning) or (AOffset <> 0)) then - begin - raise Exception.Create('The compression stream does not support seeking away from the current position.'); - end; -end; - -function TAbLZMACompressionStream.Seek(AOffset: Integer; AOrigin: Word): Integer; -begin - Result := Seek(Int64(AOffset), TSeekOrigin(AOrigin)); -end; - -function TAbLZMACompressionStream.WaitForCompressionToFinish: Integer; -begin - if FCompressionThread <> nil then - begin - {Notify the thread that no further data will be submitted.} - NoMoreDataToCompress; - {Wait for the compression thread to complete normally and then free it.} - FCompressionThread.WaitFor; - FreeAndNil(FCompressionThread); - end; - Result := FCompressionErrorCode; -end; - -procedure TAbLZMACompressionStream.WakeCompressionThread; -begin - ReleaseSemaphore(FPendingWorkSemaphore, 1, nil); -end; - -function TAbLZMACompressionStream.Write(const ABuffer; ACount: Integer): Longint; -var - LPSource: PAnsiChar; - LPBufData: Pointer; - LPLargeBuf: PAbQueuedBuffer; -begin - if FPIntermediateCompressionBuffer = nil then - raise Exception.Create('Write may not be called after NoMoreDataToCompress.'); - - if ACount <= 0 then - begin - Result := 0; - Exit; - end; - - LPSource := @ABuffer; - {Get a pointer to the position in the intermediate buffer to be written.} - LPBufData := FPIntermediateCompressionBuffer.GetDataPointer( - UncompressedDataBufferSize - FIntermediateCompressionBufferAvailableBytes); - if FIntermediateCompressionBufferAvailableBytes > ACount then - begin - {Copy the data into the intermediate buffer and exit.} - System.Move(LPSource^, LPBufData^, ACount); - Dec(FIntermediateCompressionBufferAvailableBytes, ACount); - Result := ACount; - end - else - begin - {Fill up the intermediate buffer} - System.Move(LPSource^, LPBufData^, FIntermediateCompressionBufferAvailableBytes); - Dec(ACount, FIntermediateCompressionBufferAvailableBytes); - Inc(LPSource, FIntermediateCompressionBufferAvailableBytes); - Result := FIntermediateCompressionBufferAvailableBytes; - {If we get here the current intermediate buffer is now full, and must be - queued.} - EnterCriticalSection(FBufferCriticalSection); - try - {Insert this buffer into the compression queue.} - FPIntermediateCompressionBuffer.DataSize := UncompressedDataBufferSize; - FPIntermediateCompressionBuffer.QueueBuffer(Self); - {Allocate a new intermediate compression buffer} - GetMem(FPIntermediateCompressionBuffer, UncompressedDataBufferSize + SizeOf(TAbQueuedBuffer)); - FIntermediateCompressionBufferAvailableBytes := UncompressedDataBufferSize; - {Should the remaining data be copied into the intermediate compression - buffer, or is it too large and must it be queued separately?} - if ACount < UncompressedDataBufferSize then - begin - LPBufData := FPIntermediateCompressionBuffer.GetDataPointer(0); - System.Move(LPSource^, LPBufData^, ACount); - Dec(FIntermediateCompressionBufferAvailableBytes, ACount); - end - else - begin - {The remaining data is larger than the intermediate buffer: queue it - separately} - GetMem(LPLargeBuf, ACount + SizeOf(TAbQueuedBuffer)); - LPLargeBuf.DataSize := ACount; - LPLargeBuf.QueueBuffer(Self); - {Copy the data across} - LPBufData := LPLargeBuf.GetDataPointer(0); - System.Move(LPSource^, LPBufData^, ACount); - end; - {Update the number of bytes written} - Inc(Result, ACount); - finally - LeaveCriticalSection(FBufferCriticalSection); - end; - {Wake up the compression thread to compress the newly queued data} - WakeCompressionThread; - end; - - Inc(FTotalBytesWritten, Result); -end; - -{ TAbLZMACompressionThread } - -{$IFNDEF HasThreadFinished} -procedure TAbLZMACompressionThread.DoTerminate; -begin - inherited DoTerminate; - FFinished := True; -end; -{$ENDIF} - -procedure TAbLZMACompressionThread.Execute; -var - LInStreamRec: CSeqInStream_Compress; - LOutStreamRec: CSeqOutStream_Compress; -begin - {Call the compression function and save the error code} - LInStreamRec.Intf.Read := ISeqInStream_Compress_Read; - LInStreamRec.CompressionStream := FCompressionStream; - LOutStreamRec.Intf.Write := ISeqOutStream_Compress_Write; - LOutStreamRec.OutputStream := FCompressionStream.FOutputStream; - FCompressionStream.FCompressionErrorCode := LzmaEnc_Encode(FCompressionStream.FLZMAEncHandle, - @LOutStreamRec.Intf, @LInStreamRec.Intf, nil, @DelphiMMInterface, @DelphiMMInterface); - {Free the compression handle} - LzmaEnc_Destroy(FCompressionStream.FLZMAEncHandle, @DelphiMMInterface, @DelphiMMInterface); - FCompressionStream.FLZMAEncHandle := nil; -end; - -{ TAbLZMADecompressionStream } - -constructor TAbLZMADecompressionStream.Create(ASourceStream: TStream); -var - LLZMAPropData: TLZMAPropertyData; -begin - inherited Create; - - FSourceStream := ASourceStream; - - {Read the header and uncompressed size from the compressed data stream.} - FSourceStream.ReadBuffer(LLZMAPropData, LZMA_PROPS_SIZE); - FSourceStream.ReadBuffer(FUncompressedSize, SizeOf(FUncompressedSize)); - - {Initialize the decompressor using the information from the header} - LzmaDec_Construct(FLzmaState); - LzmaCheck(LzmaDec_Allocate(FLzmaState, PByte(@LLZMAPropData), LZMA_PROPS_SIZE, - @DelphiMMInterface)); - LzmaDec_Init(FLzmaState); -end; - -destructor TAbLZMADecompressionStream.Destroy; -var - LUnusedBytes: Integer; -begin - {Release all decompression resources.} - LzmaDec_Free(FLzmaState, @DelphiMMInterface); - - {Any unconsumed bytes in the compressed input buffer should be returned to - the source stream.} - LUnusedBytes := FCompressedDataBufferSize - FCompressedDataBufferPosition; - if LUnusedBytes > 0 then - FSourceStream.Position := FSourceStream.Position - LUnusedBytes; - - inherited Destroy; -end; - -function TAbLZMADecompressionStream.GetBytesRead: Int64; -begin - Result := FBytesDecompressed - FReadBufferAvailableBytes; -end; - -function TAbLZMADecompressionStream.GetSize: Int64; -begin - Result := FUncompressedSize; -end; - -function TAbLZMADecompressionStream.InternalDecompressToBuffer(APBuffer: Pointer; - ABufferSize: Integer): Integer; -var - LInputBytesProcessed, LOutputBytesProcessed: size_t; - LFinishMode: Integer; - LStatus: ELzmaStatus; -begin - Result := 0; - {Any more data to decompress to the output buffer?} - while ABufferSize > 0 do - begin - {Read more compressed data into the compressed data buffer, if required.} - if FCompressedDataBufferPosition >= FCompressedDataBufferSize then - begin - FCompressedDataBufferSize := FSourceStream.Read(FCompressedDataBuffer, - CompressedDataBufferSize); - FCompressedDataBufferPosition := 0; - end; - - {Initialize the "processed byte count" variables to the sizes of the input - and output buffers.} - LInputBytesProcessed := FCompressedDataBufferSize - FCompressedDataBufferPosition; - LOutputBytesProcessed := ABufferSize; - {We may not read more bytes than the number of uncompressed bytes according - to the header.} - if (FUncompressedSize - FBytesDecompressed) <= LOutputBytesProcessed then - begin - LOutputBytesProcessed := FUncompressedSize - FBytesDecompressed; - LFinishMode := LZMA_FINISH_END; - end - else - LFinishMode := LZMA_FINISH_ANY; - - {Decompress from the input to the output buffer} - LzmaCheck(LzmaDec_DecodeToBuf(FLzmaState, APBuffer, - LOutputBytesProcessed, @FCompressedDataBuffer[FCompressedDataBufferPosition], - LInputBytesProcessed, LFinishMode, LStatus)); - - {Update the input and output buffer stats} - Inc(FCompressedDataBufferPosition, LInputBytesProcessed); - Inc(PAnsiChar(APBuffer), LOutputBytesProcessed); - Dec(ABufferSize, LOutputBytesProcessed); - - {Update the number of bytes decompressed} - Inc(Result, LOutputBytesProcessed); - Inc(FBytesDecompressed, LOutputBytesProcessed); - - {Was all the data decompressed? If so, break the loop.} - if FUncompressedSize = FBytesDecompressed then - Break; - - {Was nothing from the input or output streams processed? If so, then - something has gone wrong.} - if (LInputBytesProcessed = 0) and (LOutputBytesProcessed = 0) then - raise Exception.Create('LZMA decompression data error'); - - end; -end; - -function TAbLZMADecompressionStream.Read(var ABuffer; ACount: Integer): Integer; -var - LBytesAlreadyRead: Integer; -begin - {Anything to read?} - if ACount > 0 then - begin - {Do we have enough data in the read buffer to satisfy the request?} - if FReadBufferAvailableBytes >= ACount then - begin - {Enough data in the buffer: Fill the output buffer.} - System.Move(PAnsiChar(@FUncompressedDataBuffer)[FReadBufferSize - FReadBufferAvailableBytes], - ABuffer, ACount); - {Subtract from the available bytes in the read buffer.} - Dec(FReadBufferAvailableBytes, ACount); - {Successfully read the number of bytes requested} - Result := ACount; - end - else - begin - {Not enough bytes available in the read buffer: Is there anything - available in the uncompressed data buffer? If so, then transfer what we - have.} - if FReadBufferAvailableBytes > 0 then - begin - {There is some data in the buffer: Read everything} - System.Move(PAnsiChar(@FUncompressedDataBuffer)[FReadBufferSize - FReadBufferAvailableBytes], - ABuffer, FReadBufferAvailableBytes); - LBytesAlreadyRead := FReadBufferAvailableBytes; - FReadBufferAvailableBytes := 0; - end - else - LBytesAlreadyRead := 0; - {If we get here it means the read buffer has been emptied and some data - still has to be read: Do we need to fill up the read buffer again, or do - we read directly into the target buffer? Large reads bypass the read - buffering mechanism.} - if ACount <= MaximumBlockSizeForBufferedIO then - begin - {Try to fill the read buffer again} - FReadBufferSize := InternalDecompressToBuffer(@FUncompressedDataBuffer, UncompressedDataBufferSize); - FReadBufferAvailableBytes := FReadBufferSize; - {No more data available? If so we're done.} - if FReadBufferAvailableBytes = 0 then begin - Result := LBytesAlreadyRead; - Exit; - end; - {Is enough data now available?} - if FReadBufferAvailableBytes >= (ACount - LBytesAlreadyRead) then - begin - {Enough data in the buffer: Fill the output buffer.} - System.Move(FUncompressedDataBuffer, - PAnsiChar(@ABuffer)[LBytesAlreadyRead], - ACount - LBytesAlreadyRead); - {Subtract from the available bytes in the read buffer and return the - number of bytes read.} - Dec(FReadBufferAvailableBytes, ACount - LBytesAlreadyRead); - {Successfully read the number of bytes requested} - Result := ACount; - end - else - begin - {Enough data is still not available (the end of the compressed stream - has been reached): Read what we can.} - System.Move(FUncompressedDataBuffer, - PAnsiChar(@ABuffer)[LBytesAlreadyRead], - FReadBufferAvailableBytes); - Inc(LBytesAlreadyRead, FReadBufferAvailableBytes); - FReadBufferAvailableBytes := 0; - Result := LBytesAlreadyRead; - end; - end - else - begin - {Decompress directly into the output buffer.} - Result := InternalDecompressToBuffer( - @PAnsiChar(@ABuffer)[LBytesAlreadyRead], - ACount - LBytesAlreadyRead) + LBytesAlreadyRead; - end; - end; - end - else - Result := 0; -end; - -function TAbLZMADecompressionStream.Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; -begin - Result := GetBytesRead; - if ((AOrigin <> soBeginning) or (AOffset <> Result)) - and ((AOrigin <> soCurrent) or (AOffset <> 0)) then - begin - raise Exception.Create('Decompression streams do not support seeking away ' - + 'from the current position.'); - end; -end; - -function TAbLZMADecompressionStream.Seek(AOffset: Integer; AOrigin: Word): Integer; -begin - Result := Seek(Int64(AOffset), TSeekOrigin(AOrigin)); -end; - -function TAbLZMADecompressionStream.Write(const ABuffer; ACount: Integer): Integer; -begin - raise Exception.Create('Writing to a LZMA decompression stream is not supported.'); -end; - -end. diff --git a/components/Abbrevia/source/AbMeter.pas b/components/Abbrevia/source/AbMeter.pas deleted file mode 100644 index 46d8420..0000000 --- a/components/Abbrevia/source/AbMeter.pas +++ /dev/null @@ -1,307 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbMeter.pas *} -{*********************************************************} -{* ABBREVIA: Progress meter *} -{* Use AbQMeter.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbMeter; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses - Classes, - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} - {$IFDEF LibcAPI} - Libc, - {$ENDIF} - {$IFDEF UsingCLX } - QControls, QGraphics, QForms, QExtCtrls, - {$ELSE} - Controls, Graphics, Forms, ExtCtrls, - {$ENDIF} - AbBrowse; - -type - TAbMeterOrientation = (moHorizontal, moVertical); - - TAbCustomMeter = class(TGraphicControl, IAbProgressMeter) - {.Z+} - protected {private} - {property variables} - FBorderStyle : TBorderStyle; - FCtl3D : Boolean; - FOrientation : TAbMeterOrientation; - FPercent : Integer; - FTickMarks : Byte; - FUsedColor : TColor; - FUnusedColor : TColor; - - {internal methods} - function GetVersion : string; - procedure Paint; - override; - procedure SetBorderStyle(const Value : TBorderStyle); - procedure SetCtl3D(const Value : Boolean); - procedure SetOrientation(const O : TAbMeterOrientation); - procedure SetTickMarks(const Value: Byte); - procedure SetUnusedColor(const C : TColor); - procedure SetUsedColor(const C : TColor); - procedure SetVersion(Value : string); - property Version : string - read GetVersion write SetVersion stored False; - - {.Z-} - public {methods} - constructor Create(AOwner : TComponent); - override; - procedure DoProgress(Progress : Byte); - procedure Reset; - - public {properties} - property BorderStyle : TBorderStyle - read FBorderStyle write SetBorderStyle default bsSingle; - property Ctl3D : Boolean - read FCtl3D write SetCtl3D default True; - property Orientation : TAbMeterOrientation - read FOrientation write SetOrientation; - property TickMarks: Byte - read FTickMarks write SetTickMarks default 10; - property UnusedColor : TColor - read FUnusedColor write SetUnusedColor; - property UsedColor : TColor - read FUsedColor write SetUsedColor; - end; - - TAbMeter = class(TAbCustomMeter) - published - property Anchors; - property Constraints; - property Align; - property BorderStyle; - property Ctl3D; - property Font; - property OnClick; - property OnDblClick; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; - property Orientation; - property ParentFont; - property ParentShowHint; - property ShowHint; - property TickMarks; - property UnusedColor; - property UsedColor; - property Version; - property Visible; - end; - {.Z+} - - -implementation - -uses - Types, AbConst; - -{ == TAbCustomMeter ======================================================== } -constructor TAbCustomMeter.Create(AOwner : TComponent); -begin - inherited Create(AOwner); - {$IFNDEF UsingCLX} - if NewStyleControls then - ControlStyle := ControlStyle + [csOpaque] - else - ControlStyle := ControlStyle + [csOpaque, csFramed]; - {$ELSE} - ControlStyle := ControlStyle + [csOpaque, csFramed]; - {$ENDIF} - - FBorderStyle := bsSingle; - FCtl3D := True; - FOrientation := moHorizontal; - FTickMarks := 10; - FUnusedColor := clBtnFace; - FUsedColor := clNavy; - Width := 150; - Height := 16; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomMeter.GetVersion : string; -begin - Result := AbVersionS; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.DoProgress(Progress : Byte); -begin - if (Progress <> FPercent) then begin - FPercent := Progress; - if (FPercent >= 100) then - FPercent := 0; - Refresh; - Application.ProcessMessages; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.Paint; -const - VSpace = 2; - HSpace = 1; - LSpace = 1; - RSpace = 1; -var - ClRect, R : TRect; - ClWidth : Integer; - ClHeight : Integer; - BlockWidth : Integer; - BlockCount : Integer; - i : Integer; -begin - ClRect := ClientRect; - - ClWidth := ClRect.Right - CLRect.Left + 1; - ClHeight := ClRect.Bottom - ClRect.Top + 1; - - if (Orientation = moHorizontal) then - BlockWidth := ((ClWidth - LSpace - RSpace - (9 * VSpace)) div FTickMarks) + 1 - else - BlockWidth := ((ClHeight - LSpace - RSpace - (9 * HSpace)) div FTickMarks) + 1; - BlockCount := FPercent div FTickMarks; - - if not Assigned((Canvas as TControlCanvas).Control) then begin - TControlCanvas(Canvas).Control := self; - end; - with Canvas do begin - Brush.Color := FUnusedColor; - FillRect(Rect(ClRect.Left, ClRect.Top, ClRect.Left + ClWidth - 1, - ClRect.Top + ClHeight - 1)); - Brush.Color := FUsedColor; - if (BlockCount > 0) then begin - if (Orientation = moHorizontal) then begin - R.Top := ClRect.Top + HSpace; - R.Bottom := ClRect.Bottom - HSpace; - for i := 0 to Pred(BlockCount) do begin - R.Left := ClRect.Left + LSpace + (i * VSpace) + - (i * BlockWidth); - R.Right := R.Left + BlockWidth; - FillRect(R); - end; - end else begin {moVertical} - R.Left := ClRect.Left + VSpace; - R.Right := ClRect.Right - VSpace; - for i := 0 to Pred(BlockCount) do begin - R.Bottom := ClRect.Bottom - LSpace - (i * HSpace) - - (i * BlockWidth); - R.Top := R.Bottom - BlockWidth; - FillRect(R); - end; - end; - end; - end; - {$IFNDEF LCL} - if (BorderStyle <> bsNone) then begin - if Ctl3D then - Frame3D(Canvas, ClRect, clBtnShadow, clBtnHighlight, 1) - else - Frame3D(Canvas, ClRect, clBlack, clBlack, 1); - end; - {$ENDIF} -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.Reset; -begin - DoProgress(0); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.SetBorderStyle(const Value : TBorderStyle); -begin - if (Value <> FBorderStyle) then begin - FBorderStyle := Value; - Invalidate; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.SetCtl3D(const Value : Boolean); -begin - if (Value <> FCtl3D) then begin - FCtl3D := Value; - Invalidate; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.SetOrientation(const O : TAbMeterOrientation); -var - Temp : Integer; -begin - if (O <> FOrientation) then begin - FOrientation := O; - if not (csLoading in ComponentState) then begin - Temp := Width; - Width := Height; - Height := Temp; - end; - Invalidate; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.SetTickMarks(const Value: Byte); -begin - if Value <= 0 then - FTickMarks := 10 - else - FTickMarks := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.SetUnusedColor(const C : TColor); -begin - if (C <> FUnusedColor) then begin - FUnusedColor := C; - Invalidate; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.SetUsedColor(const C : TColor); -begin - if (C <> FUsedColor) then begin - FUsedColor := C; - Invalidate; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomMeter.SetVersion(Value : string); -begin - {NOP} -end; - -end. diff --git a/components/Abbrevia/source/AbPPMd.pas b/components/Abbrevia/source/AbPPMd.pas deleted file mode 100644 index eb9764d..0000000 --- a/components/Abbrevia/source/AbPPMd.pas +++ /dev/null @@ -1,167 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is Craig Peterson - * - * Portions created by the Initial Developer are Copyright (C) 2011 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbPPMd.pas *} -{*********************************************************} -{* ABBREVIA: PPMd decompression *} -{*********************************************************} - -unit AbPPMd; - -{$I AbDefine.inc} - -interface - -uses - Classes; - -procedure DecompressPPMd(aSrc, aDes: TStream); - -implementation - -uses - AbCrtl, - SysUtils, - AbExcept; - - -// Compiled with: -// Release: bcc32 -q -c *.c -// Debug: bcc32 -q -c -v -y *.c - - -{ Linker derectives ======================================================== } - -// Don't re-order these; it will cause linker errors -{$IF DEFINED(WIN32)} - {$L Win32\PPMdVariantI.obj} - {$L Win32\PPMdContext.obj} - {$L Win32\PPMdSubAllocatorVariantI.obj} - {$L Win32\CarrylessRangeCoder.obj} -{$ELSEIF DEFINED(WIN64)} - {$L Win64\PPMdVariantI.obj} - {$L Win64\PPMdContext.obj} - {$L Win64\PPMdSubAllocatorVariantI.obj} - {$L Win64\CarrylessRangeCoder.obj} -{$IFEND} - - -{ CarrylessRangeCoder.h ==================================================== } - -type - PInStream = ^TInStream; - TInStream = record - nextByte: function(Self: PInStream): Byte; cdecl; - // Private data - stream: TStream; - InPos: Integer; - InCount: Integer; - InBuf: array[0..4097] of Byte; - end; -{ -------------------------------------------------------------------------- } -function TInStream_NextByte(Self: PInStream): Byte; cdecl; -begin - if Self.InPos = Self.InCount then begin - Self.InCount := Self.stream.Read(Self.InBuf, SizeOf(Self.InBuf)); - if Self.InCount = 0 then - raise EAbReadError.Create; - Self.InPos := 0; - end; - Result := Self.InBuf[Self.InPos]; - Inc(Self.InPos); -end; -{ -------------------------------------------------------------------------- } -function TInStream_Create(aStream: TStream): PInStream; -begin - GetMem(Result, SizeOf(TInStream)); - Result.nextByte := TInStream_NextByte; - Result.stream := aStream; - Result.InPos := 0; - Result.InCount := 0; -end; - - -{ PPMdVariantI.h =========================================================== } - -type - PPMdModelVariantI = Pointer; - -function CreatePPMdModelVariantI(const input: TInStream; - suballocsize, maxorder, restoration: Integer): PPMdModelVariantI; cdecl; external; -procedure FreePPMdModelVariantI(Self: PPMdModelVariantI); cdecl; external; - -function NextPPMdVariantIByte(Self: PPMdModelVariantI): Integer; cdecl; external; - - -{ Decompression routines =================================================== } - -procedure DecompressPPMd(aSrc, aDes: TStream); -const - OutBufSize = 4096; -var - nextByte: Integer; - params: word; - ppmd: PPMdModelVariantI; - Src: PInStream; - OutBuf: PByteArray; - OutPos: Integer; -begin - Src := TInStream_Create(aSrc); - try - GetMem(OutBuf, OutBufSize); - try - OutPos := 0; - - ASrc.ReadBuffer(Params, SizeOf(Params));// Pkzip stream header - ppmd := CreatePPMdModelVariantI(Src^, - (((Params shr 4) and $FF) + 1) shl 20,// sub-allocator size - (Params and $0F) + 1, // model order - Params shr 12); // model restoration method - try - while True do begin - nextByte := NextPPMdVariantIByte(ppmd); - if nextByte < 0 then Break; - OutBuf[OutPos] := Byte(nextByte); - Inc(OutPos); - if OutPos = OutBufSize then begin - aDes.WriteBuffer(OutBuf^, OutBufSize); - OutPos := 0; - end; - end; - if OutPos > 0 then - aDes.WriteBuffer(OutBuf^, OutPos); - finally - FreePPMdModelVariantI(ppmd); - end; - finally - FreeMem(OutBuf); - end; - finally - FreeMem(Src); - end; -end; - -end. diff --git a/components/Abbrevia/source/AbPeCol.dfm b/components/Abbrevia/source/AbPeCol.dfm deleted file mode 100644 index e7c54cd..0000000 Binary files a/components/Abbrevia/source/AbPeCol.dfm and /dev/null differ diff --git a/components/Abbrevia/source/AbPeCol.pas b/components/Abbrevia/source/AbPeCol.pas deleted file mode 100644 index 7aad5fb..0000000 --- a/components/Abbrevia/source/AbPeCol.pas +++ /dev/null @@ -1,177 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbPeCol.pas *} -{*********************************************************} -{* ABBREVIA: Property Editor - ZipView column headings *} -{* Use AbQPeCol.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbPeCol; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF UsingClx} - QGraphics, - QForms, - QControls, - QStdCtrls, - QButtons, - QExtCtrls, - AbQView, - AbBseCLX, -{$ELSE} - Graphics, - Forms, - Controls, - StdCtrls, - Buttons, - ExtCtrls, - AbView, - AbBseVcl, -{$ENDIF} - DesignIntf, - DesignEditors, - AbConst, - SysUtils, - Classes; - -type - TAbColHeadingsEditor = class(TForm) - Panel1: TPanel; - Label1: TLabel; - Attribute1: TComboBox; - Done1: TBitBtn; - Apply1: TBitBtn; - Label2: TLabel; - Heading1: TEdit; - Button1: TButton; - procedure FormShow(Sender: TObject); - procedure Attribute1Click(Sender: TObject); - procedure Apply1Click(Sender: TObject); - procedure Heading1Exit(Sender: TObject); - private - { Private declarations } - public - Viewer : TAbBaseViewer; - - end; - - TAbColHeadingsProperty = class(TClassProperty) - public - procedure Edit; override; - function GetAttributes: TPropertyAttributes; override; - end; - - -var - AbColHeadingsEditor: TAbColHeadingsEditor; - -implementation - -uses - AbResString; - -{$IFNDEF UsingCLX} -{$R *.dfm} -{$ENDIF} - -type - TAbViewerFriend = class(TAbBaseViewer); - - -{===TAbColHeadingsProperty==========================================} -procedure TAbColHeadingsProperty.Edit; -var - hEditor : TAbColHeadingsEditor; -begin - hEditor := TAbColHeadingsEditor.Create(Application); - try - hEditor.Viewer := TAbViewerFriend(GetComponent(0)); - hEditor.ShowModal; - Designer.Modified; - finally - hEditor.Free; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbColHeadingsProperty.GetAttributes: TPropertyAttributes; - begin - Result := inherited GetAttributes + [paDialog, paAutoUpdate]; - end; - - -{===TAbColHeadingsEditor============================================} - -procedure TAbColHeadingsEditor.FormShow(Sender: TObject); -const - cResString: array[TAbViewAttribute] of string = (AbItemNameHeadingS, - AbPackedHeadingS, AbMethodHeadingS, AbRatioHeadingS, AbCRCHeadingS, - AbFileAttrHeadingS, AbFileFormatHeadingS, AbEncryptionHeadingS, - AbTimeStampHeadingS, AbFileSizeHeadingS, AbVersionMadeHeadingS, - AbVersionNeededHeadingS, AbPathHeadingS); -var - i : TAbViewAttribute; -begin - with Attribute1 do begin - Clear; - for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do - Items.Add(cResString[i]); - - ItemIndex := 0; - end; - Attribute1Click(nil); -end; - -procedure TAbColHeadingsEditor.Attribute1Click(Sender: TObject); -begin - if (Attribute1.ItemIndex > -1) then - Heading1.Text := TAbViewerFriend(Viewer).Headings[Attribute1.ItemIndex]; -end; - -procedure TAbColHeadingsEditor.Apply1Click(Sender: TObject); -begin - if (Attribute1.ItemIndex > -1) then begin - TAbViewerFriend(Viewer).Headings[Attribute1.ItemIndex] := Heading1.Text; - TAbViewerFriend(Viewer).InvalidateRow(0); - end; -end; - -procedure TAbColHeadingsEditor.Heading1Exit(Sender: TObject); -begin - Apply1Click(nil); -end; - -end. - diff --git a/components/Abbrevia/source/AbPeDir.pas b/components/Abbrevia/source/AbPeDir.pas deleted file mode 100644 index a6c8964..0000000 --- a/components/Abbrevia/source/AbPeDir.pas +++ /dev/null @@ -1,123 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbPeDir.pas *} -{*********************************************************} -{* ABBREVIA: Property Editor - Directory *} -{* Use AbQPeDir.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbPeDir; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF UsingClx} - QGraphics, - QForms, - QControls, - QStdCtrls, - QButtons, - QExtCtrls, -{$ELSE} - Graphics, - Forms, - Controls, - StdCtrls, - Buttons, - ExtCtrls, -{$ENDIF} - DesignIntf, - DesignEditors, - SysUtils, - Classes; - -type - TAbDirectoryProperty = class( TStringProperty ) - public - function GetAttributes: TPropertyAttributes; - override; - procedure Edit; - override; - end; - -implementation - -uses -{$IFDEF UsingClx} - AbQDgDir; -{$ELSE} - AbDlgDir; -{$ENDIF} - - -function TAbDirectoryProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paDialog]; -end; - -{$IFDEF MSWINDOWS} -procedure TAbDirectoryProperty.Edit; -var - D : TAbDirDlg; -begin - D := TAbDirDlg.Create(Application); - try - D.Caption := 'Directory'; - D.AdditionalText := 'Select Directory'; - if D.Execute then - Value := D.SelectedFolder; - finally - D.Free; - end; -end; -{$ELSE} -procedure TAbDirectoryProperty.Edit; -var - D : TDirDlg; -begin - D := TDirDlg.Create(Application); - try -{$IFDEF MSWINDOWS} - D.DirectoryListBox1.Directory := Value; -{$ENDIF} - D.ShowModal; - if D.ModalResult = mrOK then - Value := D.SelectedFolder; - finally - D.Free; - end; -end; -{$ENDIF} - -end. diff --git a/components/Abbrevia/source/AbPeFn.pas b/components/Abbrevia/source/AbPeFn.pas deleted file mode 100644 index eeb016f..0000000 --- a/components/Abbrevia/source/AbPeFn.pas +++ /dev/null @@ -1,176 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbPeFn.pas *} -{*********************************************************} -{* ABBREVIA: Property Editor - FileName *} -{* Use AbQPeFn.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbPeFn; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses -{$IFDEF UsingClx } - QDialogs, QForms, -{$ELSE} - Dialogs, Forms, -{$ENDIF} - DesignIntf, - DesignEditors, - SysUtils; - - -type - TAbFileNameProperty = class(TStringProperty) - public - function GetAttributes: TPropertyAttributes; - override; - procedure Edit; - override; - end; - - TAbExeNameProperty = class(TStringProperty) - public - function GetAttributes: TPropertyAttributes; - override; - procedure Edit; - override; - end; - - TAbCabNameProperty = class( TStringProperty ) - public - function GetAttributes: TPropertyAttributes; - override; - procedure Edit; - override; - end; - - TAbLogNameProperty = class( TStringProperty ) - public - function GetAttributes: TPropertyAttributes; - override; - procedure Edit; - override; - end; - -implementation - -uses - AbResString, - AbArcTyp; - -{ -------------------------------------------------------------------------- } -procedure AbGetFilename(const Ext : string; - const Filter : string; - const Title : string; - var aFilename : string); -var - D : TOpenDialog; -begin - D := TOpenDialog.Create( Application ); - try - D.DefaultExt := Ext; - D.Filter := Filter; - D.FilterIndex := 0; - D.Options := []; - D.Title := Title; - D.FileName := aFilename; - if D.Execute then - aFilename := D.FileName; - finally - D.Free; - end; -end; - -{ == for zip files ========================================================= } -function TAbFileNameProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paDialog]; -end; -{ -------------------------------------------------------------------------- } -procedure TAbFileNameProperty.Edit; -var - FN : string; -begin - FN := Value; - AbGetFilename(AbDefaultExtS, AbFilterS, AbFileNameTitleS, FN); - Value := FN; -end; - -{ == for exe files ========================================================= } -function TAbExeNameProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paDialog]; -end; -{ -------------------------------------------------------------------------- } -procedure TAbExeNameProperty.Edit; -var - FN : string; -begin - FN := Value; - AbGetFilename(AbExeExtS, AbExeFilterS, AbFileNameTitleS, FN); - Value := FN; -end; - -{ == for cab files ========================================================= } -function TAbCabNameProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paDialog]; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCabNameProperty.Edit; -var - FN : string; -begin - FN := Value; - AbGetFilename(AbCabExtS, AbCabFilterS, AbFileNameTitleS, FN); - Value := FN; -end; - -{ == for log files ========================================================= } -function TAbLogNameProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paDialog]; -end; -{ -------------------------------------------------------------------------- } -procedure TAbLogNameProperty.Edit; -var - FN : string; -begin - FN := Value; - AbGetFilename(AbLogExtS, AbLogFilterS, AbFileNameTitleS, FN); - Value := FN; -end; -{ -------------------------------------------------------------------------- } - -end. - diff --git a/components/Abbrevia/source/AbPePass.pas b/components/Abbrevia/source/AbPePass.pas deleted file mode 100644 index 7dcfd84..0000000 --- a/components/Abbrevia/source/AbPePass.pas +++ /dev/null @@ -1,103 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbPePass.pas *} -{*********************************************************} -{* ABBREVIA: Password property editor *} -{* Use AbQPePas.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbPePass; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF UsingClx} - QGraphics, - QForms, - QControls, - QStdCtrls, - QButtons, - QExtCtrls, -{$ELSE} - Graphics, - Forms, - Controls, - StdCtrls, - Buttons, - ExtCtrls, -{$ENDIF} - DesignIntf, - DesignEditors, - SysUtils, - Classes; - -type - TAbPasswordProperty = class( TStringProperty ) - public - function GetAttributes: TPropertyAttributes; - override; - procedure Edit; - override; - end; - -implementation - -uses -{$IFDEF UsingClx} - AbQDgPwd; -{$ELSE} - AbDlgPwd; -{$ENDIF} - -function TAbPasswordProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paDialog]; -end; - -procedure TAbPasswordProperty.Edit; -var - D : TPasswordDlg; -begin - D := TPasswordDlg.Create( Application ); - try - D.Edit1.Text := Value; - D.ShowModal; - if D.ModalResult = mrOK then - Value := D.Edit1.Text; - finally - D.Free; - end; -end; - -end. diff --git a/components/Abbrevia/source/AbPeVer.dfm b/components/Abbrevia/source/AbPeVer.dfm deleted file mode 100644 index 9735099..0000000 Binary files a/components/Abbrevia/source/AbPeVer.dfm and /dev/null differ diff --git a/components/Abbrevia/source/AbPeVer.pas b/components/Abbrevia/source/AbPeVer.pas deleted file mode 100644 index 45ea6e9..0000000 --- a/components/Abbrevia/source/AbPeVer.pas +++ /dev/null @@ -1,347 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbPeVer.pas *} -{*********************************************************} -{* ABBREVIA: Property Editor - Version *} -{* Use AbQPeVer.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbPeVer; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, - ShellAPI, -{$ENDIF} -{$IFDEF LibcAPI} - Libc, -{$ENDIF} -{$IFDEF UsingClx} - QGraphics, - QForms, - QControls, - QStdCtrls, - QButtons, - QExtCtrls, - QDialogs, -{$ELSE} - Graphics, - Forms, - Controls, - StdCtrls, - Buttons, - ExtCtrls, - Dialogs, -{$ENDIF} - DesignIntf, - DesignEditors, - SysUtils, - Classes; - -type - TAbAboutBox = class(TForm) - lblVersion: TLabel; - Panel1: TPanel; - Image1: TImage; - btnOK: TButton; - Panel2: TPanel; - WebLbl: TLabel; - NewsLbl: TLabel; - Bevel1: TBevel; - Label1: TLabel; - Label2: TLabel; - Label3: TLabel; - Label5: TLabel; - Label6: TLabel; - Label7: TLabel; - Label10: TLabel; - Label11: TLabel; - procedure FormCreate(Sender: TObject); - procedure btnOKClick(Sender: TObject); - procedure WebLblClick(Sender: TObject); - procedure WebLblMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); - procedure NewsLblClick(Sender: TObject); - procedure NewsLblMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); - procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); - procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); - private - { Private declarations } - public - { Public declarations } - end; - - - TAbVersionProperty = class( TStringProperty ) - public - function GetAttributes: TPropertyAttributes; - override; - procedure Edit; - override; - end; - -var - AbAboutBox : TAbAboutBox; - -implementation - -{$IFNDEF UsingCLX} -{$R *.dfm} -{$ENDIF} - -uses - AbArcTyp, - AbConst, - AbResString; - -{$IFDEF LINUX} -const - { String Constants } - sCannotStartBrowser = 'Unable to start web browser. Make sure you have it properly set-up on your system.'; - -const - MaxBrowsers = 1; - -type - ECannotStartBrowser = class(Exception); - -type - TBrowserStartCmd = record - Command : string [64]; - Parameters : string [255]; - XTerm : Boolean; { Start browser in an XTerm } - end; - -const - { The list of browsers we can launch. } - - BrowserList : array [1..MaxBrowsers] of TBrowserStartCmd = - ((Command : 'netscape'; Parameters : ''; Xterm : False)); - - -procedure GetCurrentPath (PathList : TStringList); -var - WorkPath : PChar; - StartPos : PChar; - CurrentPath : PChar; - State : (Scanning, GotColon); -begin - WorkPath := getenv ('PATH'); - - PathList.Clear; - - StartPos := WorkPath; - State := Scanning; - while (WorkPath^ <> #0) do begin - case State of - Scanning : - begin - if (WorkPath^ = ':') then begin - State := GotColon; - if (WorkPath <> StartPos) then begin - CurrentPath := StrAlloc(WorkPath - StartPos + 1); - StrLCopy(CurrentPath, StartPos, WorkPath-StartPos); - PathList.Add (CurrentPath); - StrDispose(CurrentPath); - end; - end; - end; - GotColon : - begin - if (WorkPath^ <> ':') then begin - StartPos := WorkPath; - State := Scanning; - end; - end; - end;{case} - inc(WorkPath); - end; - if (State = Scanning) and (WorkPath <> StartPos) then begin - CurrentPath := StrAlloc(WorkPath - StartPos + 1); - StrLCopy(CurrentPath, StartPos, WorkPath-StartPos); - PathList.Add (CurrentPath); - StrDispose(CurrentPath); - end; -end; - - -function IsBrowserPresent (PathList : TStringList; - Browser : string) : Boolean; -var - i : integer; -begin - Result := False; - for i := 0 to PathList.Count - 1 do begin - if FileExists (PathList[i] + '/' + Browser) then begin - Result := True; - exit; - end; - end; -end; - -procedure CallBrowser (Browser : string; - Parameters : string; - Website : string; - XTerm : Boolean); -begin - if Pos ('', Parameters) > 0 then begin - Parameters := Copy (Parameters, 1, Pos ('', Parameters) - 1) + - Website + - Copy (Parameters, Pos ('', Parameters) + 6, 255); - end else - Parameters := Parameters + ' ' + Website; - if XTerm then begin - Parameters := '-e ' + Browser + ' ' + Parameters; - Browser := 'xterm'; - end; - Libc.system (PChar (Browser + ' ' + Parameters + ' &')); -end; - -procedure StartBrowser (Website : string); - -var - PathList : TStringList; - i : integer; - -begin - PathList := TStringList.Create; - try - GetCurrentPath (PathList); - for i := 1 to MaxBrowsers do begin - if IsBrowserPresent (PathList, BrowserList[i].Command) then begin - CallBrowser (BrowserList[i].Command, BrowserList[i].Parameters, - Website, BrowserList[i].XTerm); - exit; - end; - end; - raise ECannotStartBrowser.Create(sCannotStartBrowser); - finally - PathList.Free; - end; -end; -{$ENDIF} - - -procedure TAbAboutBox.FormCreate(Sender: TObject); -begin - Top := (Screen.Height - Height ) div 3; - Left := (Screen.Width - Width ) div 2; - lblVersion.Caption := Format(AbVersionFormatS, [AbVersionS] ); -end; - -function TAbVersionProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paDialog, paReadOnly]; -end; - -procedure TAbVersionProperty.Edit; -begin - with TAbAboutBox.Create( Application ) do - try - ShowModal; - finally - Free; - end; -end; - -procedure TAbAboutBox.btnOKClick(Sender: TObject); -begin - Close; -end; - -procedure TAbAboutBox.WebLblClick(Sender: TObject); -begin -{$IFDEF MSWINDOWS } - if ShellExecute(0, 'open', 'http://www.sourceforge.net/projects/tpabbrevia', '', '', - SW_SHOWNORMAL) <= 32 then - ShowMessage('Unable to start web browser'); -{$ENDIF MSWINDOWS } -{$IFDEF LINUX } - try - StartBrowser('http://www.sourceforge.net/projects/tpabbrevia'); - except - on ECannotStartBrowser do - ShowMessage('Unable to start web browser'); - end; -{$ENDIF LINUX } - WebLbl.Font.Color := clNavy; -end; - -procedure TAbAboutBox.WebLblMouseMove(Sender: TObject; Shift: TShiftState; - X, Y: Integer); -begin - WebLbl.Font.Color := clRed; -end; - -procedure TAbAboutBox.NewsLblClick(Sender: TObject); -begin -{$IFDEF MSWINDOWS } - if ShellExecute(0, 'open', 'http://www.sourceforge.net/forum/forum.php?forum_id=241865', '', '', - SW_SHOWNORMAL) <= 32 then - ShowMessage('Unable to start web browser'); -{$ENDIF MSWINDOWS } -{$IFDEF LINUX } - try - StartBrowser('http://www.sourceforge.net/forum/forum.php?forum_id=241865'); - except - on ECannotStartBrowser do - ShowMessage('Unable to start web browser'); - end; -{$ENDIF LINUX } - NewsLbl.Font.Color := clNavy; -end; - -procedure TAbAboutBox.NewsLblMouseMove(Sender: TObject; Shift: TShiftState; - X, Y: Integer); -begin - NewsLbl.Font.Color := clRed; -end; - -procedure TAbAboutBox.Panel2MouseMove(Sender: TObject; Shift: TShiftState; - X, Y: Integer); -begin - NewsLbl.Font.Color := clNavy; -end; - -procedure TAbAboutBox.FormMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); -begin - WebLbl.Font.Color := clNavy; - NewsLbl.Font.Color := clNavy; -end; - -end. - diff --git a/components/Abbrevia/source/AbQCView.pas b/components/Abbrevia/source/AbQCView.pas deleted file mode 100644 index b541bf2..0000000 --- a/components/Abbrevia/source/AbQCView.pas +++ /dev/null @@ -1,39 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQCView.pas *} -{*********************************************************} -{* ABBREVIA: Cabinet archive viewer component (CLX) *} -{* Use AbCView.pas for VCL *} -{*********************************************************} - -Unit AbQCView; - -{$DEFINE UsingCLX} - -{$I AbCView.pas} - - diff --git a/components/Abbrevia/source/AbQCmpnd.pas b/components/Abbrevia/source/AbQCmpnd.pas deleted file mode 100644 index 046d66e..0000000 --- a/components/Abbrevia/source/AbQCmpnd.pas +++ /dev/null @@ -1,39 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQCmpnd.pas *} -{*********************************************************} -{* ABBREVIA: Compound File classes and component (CLX) *} -{* Use AbCompnd.pas for VCL *} -{*********************************************************} - -unit AbQCmpnd; - -{$DEFINE UsingCLX} - -{$I AbCompnd.pas} - - diff --git a/components/Abbrevia/source/AbQDgDir.pas b/components/Abbrevia/source/AbQDgDir.pas deleted file mode 100644 index 89a5013..0000000 --- a/components/Abbrevia/source/AbQDgDir.pas +++ /dev/null @@ -1,40 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQDgDir.pas *} -{*********************************************************} -{* ABBREVIA: Dialog - Directory (CLX) *} -{* Use AbDlgDir.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingClx } - -unit AbQDgDir; - -{$R *.xfm} - -{$I AbDlgDir.pas} - diff --git a/components/Abbrevia/source/AbQDgDir.xfm b/components/Abbrevia/source/AbQDgDir.xfm deleted file mode 100644 index 7acaa04..0000000 Binary files a/components/Abbrevia/source/AbQDgDir.xfm and /dev/null differ diff --git a/components/Abbrevia/source/AbQDgPwd.pas b/components/Abbrevia/source/AbQDgPwd.pas deleted file mode 100644 index b1f8481..0000000 --- a/components/Abbrevia/source/AbQDgPwd.pas +++ /dev/null @@ -1,40 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQDgPwd.pas *} -{*********************************************************} -{* ABBREVIA: Dialog - Password (CLX) *} -{* Use AbDlgPwd.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingClx} - -unit AbQDgPwd; - -{$R *.xfm} - -{$I AbDlgPwd.pas} - diff --git a/components/Abbrevia/source/AbQDgPwd.xfm b/components/Abbrevia/source/AbQDgPwd.xfm deleted file mode 100644 index 2e99d52..0000000 Binary files a/components/Abbrevia/source/AbQDgPwd.xfm and /dev/null differ diff --git a/components/Abbrevia/source/AbQHexVw.pas b/components/Abbrevia/source/AbQHexVw.pas deleted file mode 100644 index 53eb1cf..0000000 --- a/components/Abbrevia/source/AbQHexVw.pas +++ /dev/null @@ -1,39 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQCmpnd.pas *} -{*********************************************************} -{* ABBREVIA: Compound File classes and component (CLX) *} -{* Use AbCompnd.pas for VCL *} -{*********************************************************} - -unit AbQHexVw; - -{$DEFINE UsingCLX} - -{$I AbHexVw.pas} - - diff --git a/components/Abbrevia/source/AbQMeter.pas b/components/Abbrevia/source/AbQMeter.pas deleted file mode 100644 index fe889b1..0000000 --- a/components/Abbrevia/source/AbQMeter.pas +++ /dev/null @@ -1,38 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQMeter.pas *} -{*********************************************************} -{* ABBREVIA: Progress meter (CLX) *} -{* Use AbMeter.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingCLX} - -unit AbQMeter; - -{$I AbMeter.pas} - diff --git a/components/Abbrevia/source/AbQPeCol.pas b/components/Abbrevia/source/AbQPeCol.pas deleted file mode 100644 index c940e68..0000000 --- a/components/Abbrevia/source/AbQPeCol.pas +++ /dev/null @@ -1,43 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQPeCol.pas *} -{*********************************************************} -{* ABBREVIA: Property Editor - ZipView column headings *} -{* (CLX) *} -{* Use AbPeCol.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingClx} - -unit AbQPeCol; - -{$R *.xfm} - -{$I AbPeCol.pas} - - - diff --git a/components/Abbrevia/source/AbQPeCol.xfm b/components/Abbrevia/source/AbQPeCol.xfm deleted file mode 100644 index 99d3fe7..0000000 Binary files a/components/Abbrevia/source/AbQPeCol.xfm and /dev/null differ diff --git a/components/Abbrevia/source/AbQPeDir.pas b/components/Abbrevia/source/AbQPeDir.pas deleted file mode 100644 index f227960..0000000 --- a/components/Abbrevia/source/AbQPeDir.pas +++ /dev/null @@ -1,37 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbPeDir.pas *} -{*********************************************************} -{* ABBREVIA: Property Editor - Directory (CLX) *} -{* Use AbPeDir.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingCLX} - -unit AbQPeDir; - -{$I AbPeDir.pas} diff --git a/components/Abbrevia/source/AbQPeFn.pas b/components/Abbrevia/source/AbQPeFn.pas deleted file mode 100644 index 4129c17..0000000 --- a/components/Abbrevia/source/AbQPeFn.pas +++ /dev/null @@ -1,38 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQPeFn.PAS *} -{*********************************************************} -{* ABBREVIA: Property Editor - FileName (CLX) *} -{* Use AbPeFn.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingClx} - -unit AbQPeFn; - -{$I AbPeFn.pas} - diff --git a/components/Abbrevia/source/AbQPePas.pas b/components/Abbrevia/source/AbQPePas.pas deleted file mode 100644 index b5934ad..0000000 --- a/components/Abbrevia/source/AbQPePas.pas +++ /dev/null @@ -1,39 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQPePas.pas *} -{*********************************************************} -{* ABBREVIA: Password property editor (CLX) *} -{* Use AbPePass.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingClx} - -unit AbQPePas; - -{$I AbPePass.pas} - - diff --git a/components/Abbrevia/source/AbQPeVer.pas b/components/Abbrevia/source/AbQPeVer.pas deleted file mode 100644 index 250973a..0000000 --- a/components/Abbrevia/source/AbQPeVer.pas +++ /dev/null @@ -1,40 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQPeVer.pas *} -{*********************************************************} -{* ABBREVIA: Property Editor - Version (CLX) *} -{* See AbPeVer.pas for the VCL header *} -{*********************************************************} - -{$DEFINE UsingClx} - -unit AbQPeVer; - -{$R *.xfm} - -{$I AbPeVer.pas} - diff --git a/components/Abbrevia/source/AbQPeVer.xfm b/components/Abbrevia/source/AbQPeVer.xfm deleted file mode 100644 index 99db5e6..0000000 Binary files a/components/Abbrevia/source/AbQPeVer.xfm and /dev/null differ diff --git a/components/Abbrevia/source/AbQView.pas b/components/Abbrevia/source/AbQView.pas deleted file mode 100644 index 904a62e..0000000 --- a/components/Abbrevia/source/AbQView.pas +++ /dev/null @@ -1,38 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQView.pas *} -{*********************************************************} -{* ABBREVIA: Base archive viewer component (CLX) *} -{* Use AbView.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingCLX} - -unit AbQView; - -{$I AbView.pas} - diff --git a/components/Abbrevia/source/AbQZView.pas b/components/Abbrevia/source/AbQZView.pas deleted file mode 100644 index e4afa7c..0000000 --- a/components/Abbrevia/source/AbQZView.pas +++ /dev/null @@ -1,39 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQZView.pas *} -{*********************************************************} -{* ABBREVIA: Zip archive viewer component (CLX) *} -{* Use AbZView.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingCLX} - -unit AbQZView; - -{$I AbZView.pas} - - diff --git a/components/Abbrevia/source/AbQZpOut.pas b/components/Abbrevia/source/AbQZpOut.pas deleted file mode 100644 index 8ce1cb5..0000000 --- a/components/Abbrevia/source/AbQZpOut.pas +++ /dev/null @@ -1,40 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbQZpOut.pas *} -{*********************************************************} -{* ABBREVIA: Visual Component with Zip and unzip support *} -{* (CLX) *} -{* Use AbZipOut.pas for VCL *} -{*********************************************************} - -{$DEFINE UsingCLX} - -unit AbQZpOut; - -{$I AbZipOut.pas} - - diff --git a/components/Abbrevia/source/AbReg.pas b/components/Abbrevia/source/AbReg.pas deleted file mode 100644 index 9c9bc59..0000000 --- a/components/Abbrevia/source/AbReg.pas +++ /dev/null @@ -1,188 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbReg.pas *} -{*********************************************************} -{* ABBREVIA: Registrations (VCL) *} -{*********************************************************} - -unit AbReg; - -{$I AbDefine.inc} -{$UNDEF UsingClx } - -{$R AbReg.res} - -interface - -uses - Classes, - {$IFDEF LCL} - LResources, - {$ENDIF} - {$IFDEF MSWINDOWS} - AbCBrows, AbCabExt, AbCabMak, AbCabKit, - {$ENDIF} - AbZBrows, AbUnzper, AbZipper, AbZipKit, AbSelfEx; - -procedure Register; - -implementation - -{$IFNDEF FPC} -uses - AbUtils, - AbPeDir, - AbPeFn, - AbPePass, - AbPeVer, - AbPeCol, - DesignIntf, - DesignEditors, - SysUtils; -{$ENDIF} - -procedure Register; -begin -{$IFNDEF FPC} - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'Version', - TAbVersionProperty ); -{$ENDIF} - - RegisterComponents( 'Abbrevia', - [ TAbZipBrowser, - TAbUnzipper, - TAbZipper, - TAbZipKit, - {$IFDEF MSWINDOWS} - TAbCabBrowser, - TAbCabExtractor, - TAbMakeCab, - TAbCabKit, - {$ENDIF} - TAbMakeSelfExe ]); -end; - -{$IFDEF LCL} -initialization - {$I abbrevia.lrs} -{$ENDIF} - -end. diff --git a/components/Abbrevia/source/AbReg.res b/components/Abbrevia/source/AbReg.res deleted file mode 100644 index d63d006..0000000 Binary files a/components/Abbrevia/source/AbReg.res and /dev/null differ diff --git a/components/Abbrevia/source/AbRegClx.pas b/components/Abbrevia/source/AbRegClx.pas deleted file mode 100644 index faa925c..0000000 --- a/components/Abbrevia/source/AbRegClx.pas +++ /dev/null @@ -1,235 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbRegClx.pas *} -{*********************************************************} -{* ABBREVIA: Registrations (CLX) *} -{*********************************************************} - -unit AbRegClx; - -{$I AbDefine.inc} -{$DEFINE UsingCLX} - -{$R AbReg.res} - -interface - -{$IFDEF LINUX} - !! Error, this unit is for CLX on Windows, use AbRegLinux.pas for Linux -{$ENDIF} - -uses - Classes, - AbCBrows, AbCabExt, AbCabMak, AbCabKit, - AbZBrows, AbUnzper, AbZipper, AbZipKit, AbSelfEx, - AbQCView, AbQZpOut, AbQView, AbQZView, AbQMeter; - -procedure Register; - -implementation - -uses - AbUtils, - AbQPeDir, - AbQPeFn, - AbQPePas, - AbQPeVer, - AbQPeCol, - AbQDgDir, - AbQDgPwd, - DesignIntf, - DesignEditors, - SysUtils; - -procedure Register; -begin - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile', - TAbFileNameProperty ); - - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMeter, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings', - TAbColHeadingsProperty ); -{$IFDEF MSWINDOWS} - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbCabView, 'Headings', - TAbColHeadingsProperty ); -{$ENDIF} - - RegisterComponents( 'Abbrevia', - [ TAbZipBrowser, - TAbUnzipper, - TAbZipper, - TAbZipKit, - TAbZipView, - TAbZipOutline, - -{$IFDEF MSWINDOWS} - TAbCabBrowser, - TAbCabExtractor, - TAbMakeCab, - TAbCabKit, - TAbCabView, -{$ENDIF} - - TAbMeter, - TAbMakeSelfExe ]); - - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings', - TAbColHeadingsProperty ); - - RegisterComponents( 'Abbrevia', - [ - TAbMeter, - TAbCabView, - TAbZipView, - TAbZipOutline - ]); -end; - -end. diff --git a/components/Abbrevia/source/AbRegLinux.pas b/components/Abbrevia/source/AbRegLinux.pas deleted file mode 100644 index fccd84e..0000000 --- a/components/Abbrevia/source/AbRegLinux.pas +++ /dev/null @@ -1,153 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbRegLinux.pas *} -{*********************************************************} -{* ABBREVIA: Registrations *} -{*********************************************************} - -unit AbRegLinux; - -{$I AbDefine.inc} -{$R AbReg.res} - -interface - -{$IFDEF MSWINDOWS} - !! Error, this unit is for CLX on Linux, use AbRegClx.pas for Windows -{$ENDIF} - -uses - Classes, - AbQZpOut, AbQView, AbQZView, AbQMeter; - -procedure Register; - -implementation - -uses - AbUtils, - AbQPeDir, - AbQPeFn, - AbQPePas, - AbQPeVer, - AbQPeCol, - AbZBrows, - AbZipper, - AbUnzper, - AbZipKit, - AbSelfEx, - DesignIntf, - DesignEditors; - -procedure Register; -begin - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMeter, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings', - TAbColHeadingsProperty ); - RegisterComponents( 'Abbrevia', - [TAbZipBrowser, - TAbUnzipper, - TAbZipper, - TAbZipKit, - TAbZipOutline, - TAbZipView, - TAbMeter, - TAbMakeSelfExe]); -end; - -end. diff --git a/components/Abbrevia/source/AbRegVcl.pas b/components/Abbrevia/source/AbRegVcl.pas deleted file mode 100644 index 72921ff..0000000 --- a/components/Abbrevia/source/AbRegVcl.pas +++ /dev/null @@ -1,247 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbRegVcl.pas *} -{*********************************************************} -{* ABBREVIA: Registrations (VCL) *} -{*********************************************************} - -unit AbRegVcl; - -{$I AbDefine.inc} -{$UNDEF UsingClx } - -{$R AbReg.res} - -interface - -uses - Classes, - AbCBrows, AbCabExt, AbCabMak, AbCabKit, AbCView, - AbCompnd, AbHexVw, AbZBrows, AbUnzper, AbZipper, AbZipKit, AbZipOut, - AbView, AbComCtrls, AbZView, AbMeter, AbSelfEx, AbZipExt; - -procedure Register; - -implementation - -uses - AbConst, - AbUtils, - AbPeDir, - AbPeFn, - AbPePass, - AbPeVer, - AbPeCol, - DesignIntf, - DesignEditors, - Graphics, - ToolsAPI, - SysUtils, - Windows; - -procedure Register; -begin - - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe', - TAbExeNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile', - TAbFileNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbListView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbTreeView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMeter, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbProgressBar, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Password', - TAbPasswordProperty ); - RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings', - TAbColHeadingsProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'FileName', - TAbCabNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'BaseDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'LogFile', - TAbLogNameProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'TempDirectory', - TAbDirectoryProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( string ), TAbCabView, 'Version', - TAbVersionProperty ); - RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbCabView, 'Headings', - TAbColHeadingsProperty ); - - RegisterComponents( 'Abbrevia', - [ TAbZipBrowser, - TAbUnzipper, - TAbZipper, - TAbZipKit, - TAbZipView, - TAbZipOutline, - TAbTreeView, - TAbListView, - TAbCabBrowser, - TAbCabExtractor, - TAbMakeCab, - TAbCabKit, - TAbCabView, - TAbProgressBar, - TAbMeter, - TAbMakeSelfExe ]); -end; - -{$IF DECLARED(IOTAAboutBoxServices)} -var - AboutBoxIndex: Integer = -1; - -procedure RegisterAboutBox; -begin - SplashScreenServices.AddPluginBitmap( - 'Abbrevia: Advanced data compression toolkit, v' + AbVersionS, - LoadBitmap(HInstance, 'SPLASH')); - AboutBoxIndex := (BorlandIDEServices as IOTAAboutBoxServices).AddPluginInfo( - 'Abbrevia ' + AbVersionS, - 'Abbrevia: Advanced data compression toolkit, v' + AbVersionS + sLineBreak + - 'http://tpabbrevia.sourceforge.net/' + sLineBreak + - sLineBreak + - 'Copyright (c) 1997-2011 Abbrevia development team' + sLineBreak + - 'Covered under the Mozilla Public License (MPL) v1.1' + sLineBreak + - 'Abbrevia includes source code from bzip2, the LZMA SDK,' + sLineBreak + - 'Dag Ågren''s version of PPMd, and the WavPack SDK.', - LoadBitmap(HInstance, 'SPLASH')); -end; - -procedure UnregisterAboutBox; -begin - if AboutBoxIndex <> -1 then - (BorlandIDEServices as IOTAAboutBoxServices).RemovePluginInfo(AboutBoxIndex); -end; - -initialization - RegisterAboutBox; - -finalization - UnRegisterAboutBox; -{$IFEND} - -end. diff --git a/components/Abbrevia/source/AbResString.pas b/components/Abbrevia/source/AbResString.pas deleted file mode 100644 index b48e17d..0000000 --- a/components/Abbrevia/source/AbResString.pas +++ /dev/null @@ -1,250 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Roman Kassebaum - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* Abbrevia: AbResString.pas *} -{*********************************************************} -{* Abbrevia: Resource strings *} -{*********************************************************} - -unit AbResString; - -{$I AbDefine.inc} - -interface - -resourcestring - AbErrZipInvalidS = 'Invalid file - not a PKZip file'; - AbZipVersionNeededS = 'Cannot extract file - newer version required'; - AbUnknownCompressionMethodS = 'Cannot extract file - unsupported compression method'; - AbNoExtractionMethodS = 'Cannot extract file - no extraction support provided'; - AbInvalidPasswordS = 'Cannot extract file - invalid password'; - AbNoInsertionMethodS = 'Cannot insert file - no insertion support provided'; - AbInvalidFactorS = 'Invalid Reduce Factor'; - AbDuplicateNameS = 'Cannot insert file - duplicates stored name'; - AbUnsupportedCompressionMethodS = 'Cannot insert file - unsupported compression method'; - AbUserAbortS = 'Process aborted by user'; - AbArchiveBusyS = 'Archive is busy - cannot process new requests'; - AbLastDiskRequestS = 'Insert the last disk in the spanned disk set'; - AbDiskRequestS = 'Insert floppy'; - AbImageRequestS = 'Image file name'; - AbBadSpanStreamS = 'Spanned archives must be opened as file streams'; - AbDiskNumRequestS = 'Insert disk number %d of the spanned disk set'; - AbImageNumRequestS = 'Insert span number %d of the spanned file set'; - AbNoOverwriteSpanStreamS = 'Cannot update an existing spanned disk set'; - AbNoSpannedSelfExtractS = 'Cannot make a self-extracting spanned disk set'; - AbBlankDiskS = 'Insert a blank floppy disk'; - AbStreamFullS = 'Stream write error'; - AbNoSuchDirectoryS = 'Directory does not exist'; - AbInflateBlockErrorS = 'Cannot inflate block'; - AbBadStreamTypeS = 'Invalid Stream'; - AbTruncateErrorS = 'Error truncating Zip File'; - AbZipBadCRCS = 'Failed CRC Check'; - AbZipBadStubS = 'Stub must be an executable'; - AbFileNotFoundS = 'File not found'; - AbInvalidLFHS = 'Invalid Local File Header entry'; - AbNoArchiveS = 'Archive does not exist - Filename is blank'; - AbReadErrorS = 'Error reading archive'; - AbInvalidIndexS = 'Invalid archive item index'; - AbInvalidThresholdS = 'Invalid archive size threshold'; - AbUnhandledFileTypeS = 'Unhandled Archive Type'; - AbSpanningNotSupportedS = 'Spanning not supported by this Archive type'; - AbLogCreateErrorS = 'Error creating Log File'; - AbMoveFileErrorS = 'Error Moving File %s to %s'; - AbFileSizeTooBigS = 'File size is too big for archive type'; - - AbNoCabinetDllErrorS = 'Cannot load cabinet.dll'; - AbFCIFileOpenErrorS = 'FCI cannot open file'; - AbFCIFileReadErrorS = 'FCI cannot read file'; - AbFCIFileWriteErrorS = 'FCI cannot write file'; - AbFCIFileCloseErrorS = 'FCI close file error'; - AbFCIFileSeekErrorS = 'FCI file seek error'; - AbFCIFileDeleteErrorS = 'FCI file delete error'; - AbFCIAddFileErrorS = 'FCI cannot add file'; - AbFCICreateErrorS = 'FCI cannot create context'; - AbFCIFlushCabinetErrorS = 'FCI cannot flush cabinet'; - AbFCIFlushFolderErrorS = 'FCI cannot flush folder'; - AbFDICopyErrorS = 'FDI cannot enumerate files'; - AbFDICreateErrorS = 'FDI cannot create context'; - AbInvalidCabTemplateS = 'Invalid cab file template'; - AbInvalidCabFileS = 'Invalid file - not a cabinet file'; - - AbZipStored = 'Stored'; - AbZipShrunk = 'Shrunk'; - AbZipReduced = 'Reduced'; - AbZipImploded = 'Imploded'; - AbZipTokenized = 'Tokenized'; - AbZipDeflated = 'Deflated'; - AbZipDeflate64 = 'Enhanced Deflation'; - AbZipDCLImploded = 'DCL Imploded'; - AbZipBzip2 = 'Bzip2'; - AbZipLZMA = 'LZMA'; - AbZipIBMTerse = 'IBM Terse'; - AbZipLZ77 = 'IBM LZ77'; - AbZipJPEG = 'JPEG'; - AbZipWavPack = 'WavPack'; - AbZipPPMd = 'PPMd'; - AbZipUnknown = 'Unknown (%d)'; - AbZipBestMethod = 'Best Method'; - - AbVersionFormatS = 'Version %s'; - AbCompressedSizeFormatS = 'Compressed Size: %d'; - AbUncompressedSizeFormatS = 'Uncompressed Size: %d'; - AbCompressionMethodFormatS = 'Compression Method: %s'; - AbCompressionRatioFormatS = 'Compression Ratio: %2.0f%%'; - AbCRCFormatS = 'CRC: %x'; - AbReadOnlyS = 'r'; - AbHiddenS = 'h'; - AbSystemS = 's'; - AbArchivedS = 'a'; - AbEFAFormatS = 'External File Attributes: %s'; - AbIFAFormatS = 'File Type: %s'; - AbTextS = 'Text'; - AbBinaryS = 'Binary'; - AbEncryptionFormatS = 'Encryption: %s'; - AbEncryptedS = 'Encrypted'; - AbNotEncryptedS = 'Not Encrypted'; - AbUnknownS = 'Unknown'; - AbTimeStampFormatS = 'Time Stamp: %s'; - AbMadeByFormatS = 'Made by Version: %f'; - AbNeededFormatS = 'Version Needed to Extract: %f'; - AbCommentFormatS = 'Comment: %s'; - AbDefaultExtS = '*.zip'; - AbFilterS = 'PKZip Archives (*.zip)|*.zip|Self Extracting Archives (*.exe)|*.exe|All Files (*.*)|*.*'; - AbFileNameTitleS = 'Select File Name'; - - AbOKS = 'OK'; - AbCancelS = 'Cancel'; - AbSelectDirectoryS = 'Select Directory'; - - AbEnterPasswordS = 'Enter Password'; - AbPasswordS = '&Password'; - AbVerifyS = '&Verify'; - - AbCabExtS = '*.cab'; - AbCabFilterS = 'Cabinet Archives (*.cab)|*.CAB|All Files (*.*)|*.*'; - AbLogExtS = '*.txt'; - AbLogFilterS = 'Text Files (*.txt)|*.TXT|All Files (*.*)|*.*'; - AbExeExtS = '*.exe'; - AbExeFilterS = 'Self-Extracting Zip Files (*.exe)|*.EXE|All Files (*.*)|*.*'; - - AbVMSReadTooManyBytesS = 'VMS: request to read too many bytes [%d]'; - AbVMSInvalidOriginS = 'VMS: invalid origin %d, should be 0, 1, 2'; - AbVMSErrorOpenSwapS = 'VMS: Cannot open swap file %s'; - AbVMSSeekFailS = 'VMS: Failed to seek in swap file %s'; - AbVMSReadFailS = 'VMS: Failed to read %d bytes from swap file %s'; - AbVMSWriteFailS = 'VMS: Failed to write %d bytes to swap file %s'; - AbVMSWriteTooManyBytesS = 'VMS: request to write too many bytes [%d]'; - - AbBBSReadTooManyBytesS = 'BBS: request to read too many bytes [%d]'; - AbBBSSeekOutsideBufferS = 'BBS: New position is outside the buffer'; - AbBBSInvalidOriginS = 'BBS: Invalid Origin value'; - AbBBSWriteTooManyBytesS = 'BBS: request to write too many bytes [%d]'; - - AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Not at end of stream'; - AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: seek failed'; - AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: write failed'; - AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: invalid origin'; - AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: invalid new position'; - - AbItemNameHeadingS = 'Name'; - AbPackedHeadingS = 'Packed'; - AbMethodHeadingS = 'Method'; - AbRatioHeadingS = 'Ratio (%)'; - AbCRCHeadingS = 'CRC32'; - AbFileAttrHeadingS = 'Attributes'; - AbFileFormatHeadingS = 'Format'; - AbEncryptionHeadingS = 'Encrypted'; - AbTimeStampHeadingS = 'Time Stamp'; - AbFileSizeHeadingS = 'Size'; - AbVersionMadeHeadingS = 'Version Made'; - AbVersionNeededHeadingS = 'Version Needed'; - AbPathHeadingS = 'Path'; - AbPartialHeadingS = 'Partial'; - AbExecutableHeadingS = 'Executable'; - AbFileTypeHeadingS = 'Type'; - AbLastModifiedHeadingS = 'Modified'; - - AbCabMethod0S = 'None'; - AbCabMethod1S = 'MSZip'; - - AbLtAddS = ' added '; - AbLtDeleteS = ' deleted '; - AbLtExtractS = ' extracted '; - AbLtFreshenS = ' freshened '; - AbLtMoveS = ' moved '; - AbLtReplaceS = ' replaced '; - AbLtStartS = ' logging '; - - AbGzipInvalidS = 'Invalid Gzip'; - AbGzipBadCRCS = 'Bad CRC'; - AbGzipBadFileSizeS = 'Bad File Size'; - - AbTarInvalidS = 'Invalid Tar'; - AbTarBadFileNameS = 'File name too long'; - AbTarBadLinkNameS = 'Symbolic link path too long'; - AbTarBadOpS = 'Unsupported Operation'; - - AbUnhandledEntityS = 'Unhandled Entity'; - - { pre-defined "operating system" (really more FILE system) identifiers for the - Gzip header } - AbGzOsFat = 'FAT File System (MS-DOS, OS/2, NT/Win32)'; - AbGzOsAmiga = 'Amiga'; - AbGzOsVMS = 'VMS (or OpenVMS)'; - AbGzOsUnix = 'Unix'; - AbGzOsVM_CMS = 'VM/CMS'; - AbGzOsAtari = 'Atari TOS'; - AbGzOsHPFS = 'HPFS File System (OS/2, NT)'; - AbGzOsMacintosh = 'Macintosh'; - AbGzOsZ_System = 'Z-System'; - AbGzOsCP_M = 'CP/M'; - AbGzOsTOPS_20 = 'TOPS-20'; - AbGzOsNTFS = 'NTFS File System (NT)'; - AbGzOsQDOS = 'QDOS'; - AbGzOsAcornRISCOS = 'Acorn RISCOS'; - AbGzOsVFAT = 'VFAT File System (Win95, NT)'; - AbGzOsMVS = 'MVS'; - AbGzOsBeOS = 'BeOS (BeBox or PowerMac)'; - AbGzOsTandem = 'Tandem/NSK'; - AbGzOsTHEOS = 'THEOS'; - AbGzOsunknown = 'unknown'; - AbGzOsUndefined = 'ID undefined by gzip'; - -{ Compound File specific error messages } -resourcestring - AbCmpndIndexOutOfBounds = 'Index out of bounds'; - AbCmpndBusyUpdating = 'Compound file is busy updating'; - AbCmpndInvalidFile = 'Invalid compound file'; - AbCmpndFileNotFound = 'File/Directory not found'; - AbCmpndFolderNotEmpty = 'Folder not empty'; - AbCmpndExceedsMaxFileSize = 'File size exceeds maximum allowable'; - - - -implementation - -end. diff --git a/components/Abbrevia/source/AbSWStm.pas b/components/Abbrevia/source/AbSWStm.pas deleted file mode 100644 index f8c177c..0000000 --- a/components/Abbrevia/source/AbSWStm.pas +++ /dev/null @@ -1,397 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbSWStm.pas *} -{*********************************************************} -{* ABBREVIA: TabSlidingWindowStream class *} -{*********************************************************} - -unit AbSWStm; - -{$I AbDefine.inc} - -{Notes: The TabSlidingWindowStream class provides a simple buffered - stream for sliding window compression/decompression routines. - The sliding window stream is limited when compared with a true - buffered stream: - - it is assumed that the underlying stream is just going to - be written to and is initially empty - - the buffer is fixed in size to 40KB - - write operations can only occur at the end of the stream - - the stream can only be positioned with a certain limited - range - - we can only read up to 32KB - - we can only write up to 32KB - The stream is written as a wrapper around another stream - (presumably a file stream) which is used for actual reads to - the buffer and writes from the buffer. - The stream buffer is organized as five 8KB chunks in an - array. The last chunk is the only one used for writing, the - other four are a 32KB buffer for reading. As the final chunk - gets filled, the class will drop off the first chunk (writing - it to the underlying stream, and shift the other chunks in the - array.} - - -{Define this if you wish to see a trace of the stream usage in a file - called C:\SlideWin.LOG} -{.$DEFINE DebugTrace} - -interface - -uses - SysUtils, - Classes; - -const - abSWChunkCount = 5; - -type - TabSlidingWindowStream = class(TStream) - protected {private} - bsChunks : array [0..pred(abSWChunkCount)] of PByteArray; - bsBufferStart : longint; - bsLastPos : integer; - bsCurChunk : integer; - bsPosInChunk : integer; - bsPosInBuffer : longint; - bsSize : Longint; {count of bytes in stream} - bsDirty : boolean; {whether the buffer is dirty or not} - bsStream : TStream; {actual stream containing data} - {$IFDEF DebugTrace} - bsF : System.Text; - {$ENDIF} - protected - procedure bsWriteChunk(aIndex : integer); - procedure bsSlide; - - public - constructor Create(aStream : TStream); - {-create the buffered stream} - destructor Destroy; override; - {-destroy the buffered stream} - - procedure Flush; - {-ensures that all dirty buffered data is flushed} - function Read(var Buffer; Count : Longint) : Longint; override; - {-read from the stream into a buffer} - function Seek(Offset : Longint; Origin : Word) : Longint; override; - {-seek to a particular point in the stream} - function Write(const Buffer; Count : Longint) : Longint; override; - {-write to the stream from a buffer} - end; - -implementation - -const - ChunkSize = 8192; {cannot be greater than MaxInt} - - -{===Helper routines==================================================} -procedure RaiseException(const S : string); -begin - raise Exception.Create(S); -end; -{====================================================================} - - -{===TabSlidingWindowStream===========================================} -constructor TabSlidingWindowStream.Create(aStream : TStream); -var - i : integer; -begin - inherited Create; - {save the actual stream} - bsStream := aStream; - {allocate the chunks-they must be set to binary zeros} - for i := 0 to pred(abSWChunkCount) do - bsChunks[i] := AllocMem(ChunkSize); - {set the page/buffer variables to the start of the stream; remember - we only write to the last chunk--the previous chunks are set to - binary zeros} - aStream.Position := 0; - bsSize := 0; - bsBufferStart := -ChunkSize * pred(abSWChunkCount); - bsPosInBuffer := ChunkSize * pred(abSWChunkCount); - bsCurChunk := pred(abSWChunkCount); - bsPosInChunk := 0; - bsDirty := false; - {$IFDEF DebugTrace} - System.Assign(bsF, 'c:\SlideWin.LOG'); - if FileExists('c:\SlideWin.LOG') then - System.Append(bsF) - else - System.Rewrite(bsF); - writeln(bsF, '---NEW LOG---'); - {$ENDIF} -end; -{--------} -destructor TabSlidingWindowStream.Destroy; -var - i : integer; -begin - {destroy the buffer, after writing it to the actual stream} - if bsDirty then - Flush; - for i := 0 to pred(abSWChunkCount) do - if (bsChunks[i] <> nil) then - FreeMem(bsChunks[i], ChunkSize); - {$IFDEF DebugTrace} - System.Close(bsF); - {$ENDIF} - {let our ancestor clean up} - inherited Destroy; -end; -{--------} -procedure TabSlidingWindowStream.bsSlide; -var - SavePtr : PByteArray; - i : integer; -begin - {write out the first chunk} - bsWriteChunk(0); - {slide the chunks around} - SavePtr := bsChunks[0]; - for i := 0 to abSWChunkCount-2 do - bsChunks[i] := bsChunks[i+1]; - bsChunks[pred(abSWChunkCount)] := SavePtr; - {advance the buffer start position} - inc(bsBufferStart, ChunkSize); - {reset the write position} - bsPosInChunk := 0; - bsPosInBuffer := ChunkSize * pred(abSWChunkCount); - bsLastPos := 0; -end; -{--------} -procedure TabSlidingWindowStream.bsWriteChunk(aIndex : integer); -var - SeekResult : longint; - BytesWrit : longint; - Offset : longint; - BytesToWrite : integer; -begin - Offset := bsBufferStart + (longint(aIndex) * ChunkSize); - if (Offset >= 0) then begin - SeekResult := bsStream.Seek(Offset, 0); - if (SeekResult = -1) then - RaiseException('TabSlidingWindowStream.bsWriteChunk: seek failed'); - if (aIndex <> pred(abSWChunkCount)) then - BytesToWrite := ChunkSize - else - BytesToWrite := bsLastPos; - BytesWrit := bsStream.Write(bsChunks[aIndex]^, BytesToWrite); - if (BytesWrit <> BytesToWrite) then - RaiseException('TabSlidingWindowStream.bsWriteChunk: write failed'); - end; -end; -{--------} -procedure TabSlidingWindowStream.Flush; -var - i : integer; -begin - if bsDirty then begin - for i := 0 to pred(abSWChunkCount) do - bsWriteChunk(i); - bsDirty := false; - end; -end; -{--------} -function TabSlidingWindowStream.Read(var Buffer; Count : Longint) : Longint; -var - BufPtr : PByte; - BytesToGo : Longint; - BytesToRead : integer; -begin - BufPtr := @Buffer; - - {$IFDEF DebugTrace} - System.Writeln(bsF, 'Read: ', Count, ' bytes'); - {$ENDIF} - {we do not support reads greater than 32KB bytes} - if (Count > 32*1024) then - Count := 32*1024; - - {reading is complicated by the fact we can only read in chunks of - ChunkSize: we need to partition out the overall read into a - read from part of the chunk, zero or more reads from complete - chunks and then a possible read from part of a chunk} - - {calculate the actual number of bytes we can read - this depends on - the current position and size of the stream as well as the number - of bytes requested} - BytesToGo := Count; - if (bsSize < (bsBufferStart + bsPosInBuffer + Count)) then - BytesToGo := bsSize - (bsBufferStart + bsPosInBuffer); - if (BytesToGo <= 0) then begin - Result := 0; - Exit; - end; - {remember to return the result of our calculation} - Result := BytesToGo; - - {calculate the number of bytes we can read prior to the loop} - BytesToRead := ChunkSize - bsPosInChunk; - if (BytesToRead > BytesToGo) then - BytesToRead := BytesToGo; - {copy from the stream buffer to the caller's buffer} - if (BytesToRead = 1) then - BufPtr^ := bsChunks[bsCurChunk]^[bsPosInChunk] - else - Move(bsChunks[bsCurChunk]^[bsPosInChunk], BufPtr^, BytesToRead); - {calculate the number of bytes still to read} - dec(BytesToGo, BytesToRead); - - {while we have bytes to read, read them} - while (BytesToGo > 0) do begin - {advance the pointer for the caller's buffer} - inc(BufPtr, BytesToRead); - {as we've exhausted this chunk, advance to the next} - inc(bsCurChunk); - bsPosInChunk := 0; - {calculate the number of bytes we can read in this cycle} - BytesToRead := ChunkSize; - if (BytesToRead > BytesToGo) then - BytesToRead := BytesToGo; - {copy from the stream buffer to the caller's buffer} - Move(bsChunks[bsCurChunk]^, BufPtr^, BytesToRead); - {calculate the number of bytes still to read} - dec(BytesToGo, BytesToRead); - end; - {remember our new position} - inc(bsPosInChunk, BytesToRead); -end; -{--------} -function TabSlidingWindowStream.Seek(Offset : Longint; - Origin : Word) : Longint; -{$IFDEF DebugTrace} -const - OriginStr : array [0..2] of string[7] = ('start', 'current', 'end'); -{$ENDIF} -var - NewPos : Longint; -begin - {$IFDEF DebugTrace} - System.Writeln(bsF, 'Seek: ', Offset, ' bytes from ', OriginStr[Origin]); - {$ENDIF} - {calculate the new position} - case Origin of - soFromBeginning : NewPos := Offset; - soFromCurrent : NewPos := bsBufferStart + bsPosInBuffer + Offset; - soFromEnd : NewPos := bsSize + Offset; - else - NewPos := 0; - RaiseException('TabSlidingWindowStream.Seek: invalid origin'); - end; - {if the new position is invalid, say so} - if (NewPos < bsBufferStart) or (NewPos > bsSize) then - RaiseException('TabSlidingWindowStream.Seek: invalid new position'); - {calculate the chunk number and the position in buffer & chunk} - bsPosInBuffer := NewPos - bsBufferStart; - bsCurChunk := bsPosInBuffer div ChunkSize; - bsPosInChunk := bsPosInBuffer mod ChunkSize; - {return the new position} - Result := NewPos; -end; -{--------} -function TabSlidingWindowStream.Write(const Buffer; Count : Longint) : Longint; -var - BufPtr : PByte; - BytesToGo : Longint; - BytesToWrite: integer; -begin - BufPtr := @Buffer; - - {$IFDEF DebugTrace} - System.Writeln(bsF, 'Write: ', Count, ' bytes'); - {$ENDIF} - {we ONLY write at the end of the stream} - if ((bsBufferStart + bsPosInBuffer) <> bsSize) then - RaiseException('TabSlidingWindowStream.Write: Not at end of stream'); - - {we do not support writes greater than 32KB bytes} - if (Count > 32*1024) then - Count := 32*1024; - - {writing is complicated by the fact we write in chunks of Chunksize - bytes: we need to partition out the overall write into a write - to part of the chunk, zero or more writes to complete chunks and - then a possible write to part of a chunk; every time we fill a - chunk we have toi slide the buffer} - - {when we write to this stream we always assume that we can write the - requested number of bytes: if we can't (eg, the disk is full) we'll - get an exception somewhere eventually} - BytesToGo := Count; - {remember to return the result of our calculation} - Result := BytesToGo; - - {calculate the number of bytes we can write prior to the loop} - BytesToWrite := ChunkSize - bsPosInChunk; - if (BytesToWrite > BytesToGo) then - BytesToWrite := BytesToGo; - {copy from the caller's buffer to the stream buffer} - if (BytesToWrite = 1) then - bsChunks[pred(abSWChunkCount)]^[bsPosInChunk] := BufPtr^ - else - Move(BufPtr^, - bsChunks[pred(abSWChunkCount)]^[bsPosInChunk], - BytesToWrite); - {mark our buffer as requiring a save to the actual stream} - bsDirty := true; - {calculate the number of bytes still to write} - dec(BytesToGo, BytesToWrite); - - {while we have bytes to write, write them} - while (BytesToGo > 0) do begin - {slide the buffer} - bsSlide; - {advance the pointer for the caller's buffer} - inc(BufPtr, BytesToWrite); - {calculate the number of bytes we can write in this cycle} - BytesToWrite := ChunkSize; - if (BytesToWrite > BytesToGo) then - BytesToWrite := BytesToGo; - {copy from the caller's buffer to our buffer} - Move(BufPtr^, - bsChunks[pred(abSWChunkCount)]^, - BytesToWrite); - {calculate the number of bytes still to write} - dec(BytesToGo, BytesToWrite); - end; - {remember our new position} - inc(bsPosInChunk, BytesToWrite); - bsPosInBuffer := (longint(ChunkSize) * pred(abSWChunkCount)) + bsPosInChunk; - bsLastPos := bsPosInChunk; - {make sure the stream size is correct} - inc(bsSize, Result); - {if we're at the end of the chunk, slide the buffer ready for next - time we write} - if (bsPosInChunk = ChunkSize) then - bsSlide; -end; -{====================================================================} - -end. diff --git a/components/Abbrevia/source/AbSelfEx.pas b/components/Abbrevia/source/AbSelfEx.pas deleted file mode 100644 index cbfa23d..0000000 --- a/components/Abbrevia/source/AbSelfEx.pas +++ /dev/null @@ -1,140 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbSelfEx.pas *} -{*********************************************************} -{* ABBREVIA: Component for building self-extracting zips *} -{*********************************************************} - -unit AbSelfEx; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbBase; - -type - TAbGetFileEvent = procedure(Sender : TObject; var aFilename : string; - var Abort : Boolean) of object; - -type - TAbMakeSelfExe = class(TAbBaseComponent) - protected {private} - FStubExe : string; - FZipFile : string; - FSelfExe : string; - FStubStream : TFileStream; - FZipStream : TFileStream; - FSelfStream : TFileStream; - FOnGetStubExe : TAbGetFileEvent; - FOnGetZipFile : TAbGetFileEvent; - - procedure DoGetStubExe(var Abort : Boolean); - procedure DoGetZipFile(var Abort : Boolean); - - public - function Execute : Boolean; - - published - property SelfExe : string - read FSelfExe - write FSelfExe; - property StubExe : string - read FStubExe - write FStubExe; - property ZipFile : string - read FZipFile - write FZipFile; - property OnGetStubExe : TAbGetFileEvent - read FOnGetStubExe - write FOnGetStubExe; - property OnGetZipFile : TAbGetFileEvent - read FOnGetZipFile - write FOnGetZipFile; - property Version; - end; - - -implementation - -uses - SysUtils, -{$IFDEF LibcAPI} - Libc, -{$ENDIF} - AbExcept, AbZipTyp; - -{ -------------------------------------------------------------------------- } -function TAbMakeSelfExe.Execute : Boolean; -var - Abort : Boolean; -begin - Abort := False; - if (FStubExe = '') then - DoGetStubExe(Abort); - if Abort then - raise EAbUserAbort.Create; - if not FileExists(FStubExe) then - raise EAbFileNotFound.Create; - if (FZipFile = '') then - DoGetZipFile(Abort); - if Abort then - raise EAbUserAbort.Create; - if not FileExists(FZipFile) then - raise EAbFileNotFound.Create; - - FStubStream := TFileStream.Create(FStubExe, fmOpenRead or fmShareDenyWrite); - FZipStream := TFileStream.Create(FZipFile, fmOpenRead or fmShareDenyWrite); - if (FSelfExe = '') then - FSelfExe := ChangeFileExt(FZipFile, '.exe'); - FSelfStream := TFileStream.Create(FSelfExe, fmCreate or fmShareExclusive); - try - MakeSelfExtracting(FStubStream, FZipStream, FSelfStream); - Result := True; - finally - FStubStream.Free; - FZipStream.Free; - FSelfStream.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbMakeSelfExe.DoGetStubExe(var Abort: Boolean); -begin - if Assigned(FOnGetStubExe) then - FOnGetStubExe(Self, FStubExe, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbMakeSelfExe.DoGetZipFile(var Abort : Boolean); -begin - if Assigned(FOnGetZipFile) then - FOnGetZipFile(Self, FZipFile, Abort); -end; -{ -------------------------------------------------------------------------- } - -end. diff --git a/components/Abbrevia/source/AbSpanSt.pas b/components/Abbrevia/source/AbSpanSt.pas deleted file mode 100644 index 0c3557a..0000000 --- a/components/Abbrevia/source/AbSpanSt.pas +++ /dev/null @@ -1,398 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbSpanSt.pas *} -{*********************************************************} -{* ABBREVIA: TAbSpan*Stream Classes *} -{*********************************************************} -{* Streams to handle splitting ZIP files or spanning *} -{* them to diskettes *} -{*********************************************************} - -unit AbSpanSt; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbArcTyp; - -type -{ TAbSpanBaseStream interface ============================================== } - TAbSpanBaseStream = class(TStream) - protected {private} - FArchiveName: string; - - FOnRequestImage: TAbRequestImageEvent; - - protected {methods} - function GetImageName( ImageNumber: Integer ): string; - - public {methods} - constructor Create( const ArchiveName: string ); - - public {events} - property OnRequestImage : TAbRequestImageEvent - read FOnRequestImage - write FOnRequestImage; - end; - -{ TAbSpanReadStream interface ============================================== } - TAbSpanReadStream = class(TAbSpanBaseStream) - protected {private} - FCurrentImage: LongWord; - FIsSplit: Boolean; - FLastImage: LongWord; - FStream: TStream; - - FOnRequestNthDisk : TAbRequestNthDiskEvent; - - protected {methods} - procedure GotoImage( ImageNumber: Integer ); - procedure SetOnRequestImage(Value: TAbRequestImageEvent); - - public {methods} - constructor Create( const ArchiveName: string; CurrentImage: LongWord; - Stream: TStream ); - destructor Destroy; - override; - function Read(var Buffer; Count: Longint): Longint; - override; - function Write(const Buffer; Count: Longint): Longint; - override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; - override; - procedure SeekImage( Image: LongWord; const Offset: Int64); - - public {events} - property OnRequestImage - write SetOnRequestImage; - property OnRequestNthDisk : TAbRequestNthDiskEvent - read FOnRequestNthDisk - write FOnRequestNthDisk; - end; - -{ TAbSpanWriteStream interface ============================================= } - TAbSpanWriteStream = class(TAbSpanBaseStream) - protected {private} - FCurrentImage: LongWord; - FImageSize: Int64; - FStream: TStream; - FThreshold: Int64; - - FOnRequestBlankDisk : TAbRequestDiskEvent; - - protected {methods} - procedure NewImage; - - public {methods} - constructor Create( const ArchiveName: string; Stream: TStream; - Threshold: Int64 ); - destructor Destroy; - override; - function Read(var Buffer; Count: Longint): Longint; - override; - function Write(const Buffer; Count: Longint): Longint; - override; - function WriteUnspanned(const Buffer; Count: Longint; - FailOnSpan: Boolean = False): Boolean; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; - override; - function ReleaseStream: TStream; - - public {properties} - property CurrentImage : LongWord - read FCurrentImage; - - public {events} - property OnRequestBlankDisk : TAbRequestDiskEvent - read FOnRequestBlankDisk - write FOnRequestBlankDisk; - end; - -implementation - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} - Math, RTLConsts, SysUtils, AbUtils, AbExcept; - - -{============================================================================} -{ TAbSpanBaseStream implementation ========================================= } -constructor TAbSpanBaseStream.Create( const ArchiveName: string ); -begin - inherited Create; - FArchiveName := ArchiveName; -end; -{------------------------------------------------------------------------------} -function TAbSpanBaseStream.GetImageName( ImageNumber: Integer ): string; -var - Abort : Boolean; - Ext : string; -begin - {generate default name} - Ext := ExtractFileExt(FArchiveName); - if (Length(Ext) < 2) then - Ext := '.' + Format('%.2d', [ImageNumber]) - else - Ext := Ext[1] + Ext[2] + Format('%.2d', [ImageNumber]); - Result := ChangeFileExt(FArchiveName, Ext); - {call event} - if Assigned(FOnRequestImage) then begin - Abort := False; - FOnRequestImage(Self, ImageNumber, Result, Abort); - if Abort then - raise EAbUserAbort.Create; - end; -end; - -{============================================================================} -{ TAbSpanReadStream implementation ========================================= } -constructor TAbSpanReadStream.Create( const ArchiveName: string; - CurrentImage: LongWord; Stream: TStream ); -begin - inherited Create(ArchiveName); - FCurrentImage := CurrentImage; - FIsSplit := FileExists(GetImageName(1)) or not AbDriveIsRemovable(ArchiveName); - FLastImage := CurrentImage; - FStream := Stream; -end; -{------------------------------------------------------------------------------} -destructor TAbSpanReadStream.Destroy; -begin - FreeAndNil(FStream); - inherited; -end; -{------------------------------------------------------------------------------} -procedure TAbSpanReadStream.GotoImage( ImageNumber: Integer ); -var - Abort: Boolean; - ImageName: string; -begin - { switch to the requested image. ImageNumber is passed in as 0-based to - match the zip spec, but all of the callbacks receive 1-based values. } - FreeAndNil(FStream); - FCurrentImage := ImageNumber; - Inc(ImageNumber); - ImageName := FArchiveName; - if FIsSplit then begin - { the last image uses the original filename } - if FCurrentImage <> FLastImage then - ImageName := GetImageName(ImageNumber) - end - else if Assigned(FOnRequestNthDisk) then begin - Abort := False; - repeat - FOnRequestNthDisk(Self, ImageNumber, Abort); - if Abort then - raise EAbUserAbort.Create; - until AbGetDriveFreeSpace(ImageName) <> -1; - end - else - raise EAbUserAbort.Create; - FStream := TFileStream.Create(ImageName, fmOpenRead or fmShareDenyWrite); -end; -{------------------------------------------------------------------------------} -function TAbSpanReadStream.Read(var Buffer; Count: Longint): Longint; -var - BytesRead, BytesLeft: LongInt; - PBuf: PByte; -begin - { read until the buffer's full, switching images if necessary } - Result := 0; - if FStream = nil then - Exit; - PBuf := @Buffer; - BytesLeft := Count; - while Result < Count do begin - BytesRead := FStream.Read(PBuf^, BytesLeft); - Inc(Result, BytesRead); - Inc(PBuf, BytesRead); - Dec(BytesLeft, BytesRead); - if BytesRead < BytesLeft then begin - if FCurrentImage <> FLastImage then - GotoImage(FCurrentImage + 1) - else - Break; - end; - end; -end; -{------------------------------------------------------------------------------} -function TAbSpanReadStream.Write(const Buffer; Count: Longint): Longint; -begin - raise EAbException.Create('TAbSpanReadStream.Write unsupported'); -end; -{------------------------------------------------------------------------------} -function TAbSpanReadStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - if FStream = nil then - Result := 0 - else if (Offset = 0) and (Origin = soCurrent) then - Result := FStream.Position - else - raise EAbException.Create('TAbSpanReadStream.Seek unsupported'); -end; -{------------------------------------------------------------------------------} -procedure TAbSpanReadStream.SeekImage( Image: LongWord; const Offset: Int64); -begin - if FStream = nil then - Exit; - if FCurrentImage <> Image then - GotoImage(Image); - FStream.Position := Offset; -end; -{------------------------------------------------------------------------------} -procedure TAbSpanReadStream.SetOnRequestImage(Value: TAbRequestImageEvent); -begin - FOnRequestImage := Value; - FIsSplit := FileExists(GetImageName(1)) or not AbDriveIsRemovable(FArchiveName); -end; - -{============================================================================} -{ TAbSpanWriteStream implementation ======================================== } -constructor TAbSpanWriteStream.Create( const ArchiveName: string; - Stream: TStream; Threshold: Int64 ); -begin - inherited Create(ArchiveName); - FCurrentImage := 0; - FStream := Stream; - FThreshold := Threshold; -end; -{------------------------------------------------------------------------------} -destructor TAbSpanWriteStream.Destroy; -begin - FStream.Free; - inherited; -end; -{------------------------------------------------------------------------------} -procedure TAbSpanWriteStream.NewImage; -var - Abort: Boolean; -begin - { start a new span or blank disk. FCurrentImage is 0-based to match the zip - spec, but all of the callbacks receive 1-based values. } - FreeAndNil(FStream); - Inc(FCurrentImage); - if FThreshold > 0 then - RenameFile(FArchiveName, GetImageName(FCurrentImage)) - else begin - if Assigned(FOnRequestBlankDisk) then begin - Abort := False; - repeat - FOnRequestBlankDisk(Self, Abort); - if Abort then - raise EAbUserAbort.Create; - until AbGetDriveFreeSpace(FArchiveName) <> -1; - end - else - raise EAbUserAbort.Create; - AbSetSpanVolumeLabel(AbDrive(FArchiveName), FCurrentImage); - end; - FStream := TFileStream.Create(FArchiveName, fmCreate or fmShareDenyWrite); - FImageSize := 0; -end; -{------------------------------------------------------------------------------} -function TAbSpanWriteStream.Read(var Buffer; Count: Longint): Longint; -begin - raise EAbException.Create('TAbSpanWriteStream.Read unsupported'); -end; -{------------------------------------------------------------------------------} -function TAbSpanWriteStream.Write(const Buffer; Count: Longint): Longint; -var - BytesWritten, BytesLeft: LongInt; - PBuf: PByte; -begin - { write until the buffer is done, starting new spans if necessary } - Result := 0; - if FStream = nil then - Exit; - PBuf := @Buffer; - BytesLeft := Count; - while Result < Count do begin - if FThreshold > 0 then - BytesWritten := FStream.Write(PBuf^, Min(BytesLeft, FThreshold - FImageSize)) - else - BytesWritten := FStream.Write(PBuf^, BytesLeft); - Inc(FImageSize, BytesWritten); - Inc(Result, BytesWritten); - Inc(PBuf, BytesWritten); - Dec(BytesLeft, BytesWritten); - if BytesWritten < BytesLeft then - NewImage; - end; -end; -{------------------------------------------------------------------------------} -function TAbSpanWriteStream.WriteUnspanned(const Buffer; Count: Longint; - FailOnSpan: Boolean = False): Boolean; -var - BytesWritten: LongInt; -begin - { write as a contiguous block, starting a new span if there isn't room. - FailOnSpan (and result = false) can be used to update data before it's - written again } - if FStream = nil then - raise EWriteError.Create(SWriteError); - if (FThreshold > 0) and (FThreshold - FImageSize < Count) then - BytesWritten := 0 - else - BytesWritten := FStream.Write(Buffer, Count); - if BytesWritten < Count then begin - if BytesWritten > 0 then - FStream.Size := FStream.Size - BytesWritten; - NewImage; - if FailOnSpan then - BytesWritten := 0 - else begin - BytesWritten := Count; - FStream.WriteBuffer(Buffer, Count); - end; - end; - Inc(FImageSize, BytesWritten); - Result := (BytesWritten = Count); -end; -{------------------------------------------------------------------------------} -function TAbSpanWriteStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - if FStream = nil then - Result := 0 - else if (Offset = 0) and (Origin = soCurrent) then - Result := FStream.Position - else - raise EAbException.Create('TAbSpanWriteStream.Seek unsupported'); -end; -{------------------------------------------------------------------------------} -function TAbSpanWriteStream.ReleaseStream: TStream; -begin - Result := FStream; - FStream := nil; -end; -{------------------------------------------------------------------------------} -end. diff --git a/components/Abbrevia/source/AbTarTyp.pas b/components/Abbrevia/source/AbTarTyp.pas deleted file mode 100644 index b9b27be..0000000 --- a/components/Abbrevia/source/AbTarTyp.pas +++ /dev/null @@ -1,2232 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Joel Haynie - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbTarTyp.pas *} -{*********************************************************} -{* ABBREVIA: TAbTarArchive, TAbTarItem classes *} -{*********************************************************} -{* Misc. constants, types, and routines for working *} -{* with Tar files *} -{*********************************************************} - -unit AbTarTyp; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbUtils, AbArcTyp; - -const - AB_TAR_RECORDSIZE = 512; {Note: SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE} - AB_TAR_NAMESIZE = 100; - AB_TAR_V7_EMPTY_SIZE = 167; - AB_TAR_USTAR_PREFIX_SIZE = 155; - AB_TAR_STAR_PREFIX_SIZE = 131; - AB_TAR_OLD_GNU_EMPTY1_SIZE = 5; - AB_TAR_OLD_GNU_SPARSE_SIZE = 96; - AB_TAR_OLD_GNU_EMPTY2_SIZE = 17; - AB_TAR_SIZE_AFTER_STDHDR = 167; - AB_TAR_TUSRNAMELEN = 32; - AB_TAR_TGRPNAMELEN = 32; - - -{ The checksum field is filled with this while the checksum is computed. } - AB_TAR_CHKBLANKS = ' '; { 8 blank spaces(#20), no null } - AB_TAR_L_HDR_NAME = '././@LongLink'; { As seen in the GNU File Examples} - AB_TAR_L_HDR_USR_NAME='root'; { On Cygwin this is #0, Redhat it is 'root' } - AB_TAR_L_HDR_GRP_NAME='root'; { Same on all OS's } - AB_TAR_L_HDR_ARR8_0 ='0000000'#0; { 7 zeros and one null } - AB_TAR_L_HDR_ARR12_0 ='00000000000'#0;{ 11 zeros and one null } - AB_TAR_MAGIC_VAL = 'ustar'#0; { 5 chars & a nul } - AB_TAR_MAGIC_VER = '00'; { 2 chars } - AB_TAR_MAGIC_GNUOLD = 'ustar '#0; { 7 chars & a null } - AB_TAR_MAGIC_V7_NONE = #0#0#0#0#0#0#0#0;{ 8, #0 } - -{ The linkflag defines the type of file(FH), and Meta Data about File(MDH) } - AB_TAR_LF_OLDNORMAL = #0; { FH, Normal disk file, Unix compatible } { Historically used for V7 } - AB_TAR_LF_NORMAL = '0'; { FH, Normal disk file } - AB_TAR_LF_LINK = '1'; { FH, Link to previously archived file } - AB_TAR_LF_SYMLINK = '2'; { FH, Symbolic(soft) link } - AB_TAR_LF_CHR = '3'; { FH, Character special file }{ Used for device nodes, Conditionally compiled into GNUTAR } - AB_TAR_LF_BLK = '4'; { FH, Block special file }{ Used for device nodes, Conditionally compiled into GNUTAR } - AB_TAR_LF_DIR = '5'; { FH, Directory, Zero size File } - AB_TAR_LF_FIFO = '6'; { FH, FIFO special file }{ Used for fifo files(pipe like), Conditionally complied into GNUTAR } - AB_TAR_LF_CONTIG = '7'; { FH, Contiguous file } { Normal File, but All blocks should be contiguos on the disk } - AB_TAR_LF_XHDR = 'x'; { MDH, POSIX, Next File has Extended Header } - AB_TAR_LF_XGL = 'g'; { MDH, POSIX, Global Extended Header } - AB_TAR_LF_DUMPDIR = 'D'; { FH, Extra GNU, Dump Directory} { Generated Dump of Files in a directory, has a size } - AB_TAR_LF_LONGLINK = 'K'; { MDH, Extra GNU, Next File has Long LinkName} - AB_TAR_LF_LONGNAME = 'L'; { MDH, Extra GNU, Next File has Long Name} - AB_TAR_LF_MULTIVOL = 'M'; { FH, Extra GNU, MultiVolume File Cont.}{ End of a file that spans multiple TARs } - AB_TAR_LF_SPARSE = 'S'; { FH, Extra GNU, Sparse File Cont.} - AB_TAR_LF_VOLHDR = 'V'; { FH, Extra GNU, File is Volume Header } - AB_TAR_LF_EXHDR = 'X'; { MDH, Extra GNU, Solaris Extended Header } - { The only questionable MetaData type is 'V', file or meta-data? will treat as file header } - AB_SUPPORTED_F_HEADERS = [AB_TAR_LF_OLDNORMAL, AB_TAR_LF_NORMAL, AB_TAR_LF_LINK, - AB_TAR_LF_SYMLINK, AB_TAR_LF_DIR]; - AB_UNSUPPORTED_F_HEADERS = [AB_TAR_LF_CHR, AB_TAR_LF_BLK, AB_TAR_LF_FIFO, - AB_TAR_LF_CONTIG, AB_TAR_LF_DUMPDIR, AB_TAR_LF_MULTIVOL, - AB_TAR_LF_SPARSE, AB_TAR_LF_VOLHDR]; - AB_SUPPORTED_MD_HEADERS = [AB_TAR_LF_LONGNAME, AB_TAR_LF_LONGLINK]; - AB_UNSUPPORTED_MD_HEADERS= [AB_TAR_LF_XHDR, AB_TAR_LF_XGL, AB_TAR_LF_EXHDR]; - AB_GNU_MD_HEADERS = [AB_TAR_LF_LONGLINK, AB_TAR_LF_LONGNAME]; { If present then OLD_/GNU_FORMAT } - AB_PAX_MD_HEADERS = [AB_TAR_LF_XHDR, AB_TAR_LF_XGL]; { If present then POSIX_FORMAT } - AB_IGNORE_SIZE_HEADERS = [AB_TAR_LF_LINK, AB_TAR_LF_SYMLINK, AB_TAR_LF_CHR, - AB_TAR_LF_BLK, AB_TAR_LF_DIR, AB_TAR_LF_FIFO]; -{ The rest of the Chars are unsupported and unknown types Treat those headers as File types } -{ Further link types may be defined later. } - -{ Bits used in the mode field - values in octal } - AB_TAR_TSUID = $0800; { Set UID on execution } - AB_TAR_TSGID = $0400; { Set GID on execution } - AB_TAR_TSVTX = $0200; { Save text (sticky bit) } - - -type - Arr8 = array [0..7] of AnsiChar; - Arr12 = array [0..11] of AnsiChar; - Arr12B = array[0..11] of Byte; - ArrName = array [0..AB_TAR_NAMESIZE-1] of AnsiChar; - TAbTarHeaderFormat = (UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, - USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT); - TAbTarItemType = (SUPPORTED_ITEM, UNSUPPORTED_ITEM, UNKNOWN_ITEM); - TAbTarHeaderType = (FILE_HEADER, META_DATA_HEADER, MD_DATA_HEADER, UNKNOWN_HEADER); - TAbTarMagicType = (GNU_OLD, NORMAL); - TAbTarMagicRec = packed record - case TAbTarMagicType of - GNU_OLD: (gnuOld : array[0..7] of AnsiChar); { Old GNU magic: (Magic.gnuOld) } - NORMAL : (value : array[0..5] of AnsiChar; { Magic value: (Magic.value)} - version: array[0..1] of AnsiChar); { Version: (Magic.version) } - end; - -{ Notes from GNU Tar & POSIX Spec.: } -{All the first 345 bytes are the same. } -{ "USTAR_header": Prefix(155): 345-499, - empty(12): 500-511 } -{ "old_gnu_header": atime(12): 345-356, - ctime(12): 357-368, - offset(12): 369-380, - longnames(4): 381-384, - empty(1): 385, - sparse structs(4x(12+12)=96): 386-481, - isextended(1): 482, - realsize(12): 483-494, - empty(16): 495-511 } -{ "star_header": Prefix(131): 345-475, - atime(12): 476-487, - ctime(12): 488-499, - empty(12): 500-511 } -{ "star_in_header": prefix(1): 345, - empty(9): 346-354, - isextended(1): 355, - sparse structs(4x(12+12)=96): 356-451, - realsize(12): 452-463, - offset(12): 464-475, - atime(12): 476-487, - ctime(12): 488-499, - empty(8): 500-507, - xmagic(4): 508-511 } -{ "sparse_header": These two structs are the same, and they are Meta data about file. } -{"star_ext_header": sparse structs(21x(12+12)=504): 0-503, - isextended(1): 504 } -{POSIX(PAX) extended header: is a buffer packed with content of this form: - This if from the POSIX spec. References the C printf command string. - "%d %s=%s\n". Then they are simply concatenated. } - { PAX Extended Header Keywords: } - { 'atime', 'charset', 'comment', 'ctime', 'gid', 'gname', 'linkpath', 'mtime', 'path', - 'realtime.', 'security.', 'size', 'uid', 'uname' } - { GNU Added PAX Extended Header Keywords: } - { 'GNU.sparse.name', 'GNU.sparse.major', 'GNU.sparse.minor', - 'GNU.sparse.realsize', 'GNU.sparse.numblocks', 'GNU.sparse.size', - 'GNU.sparse.offset', 'GNU.sparse.numbytes', 'GNU.sparse.map', 'GNU.dumpdir', - 'GNU.volume.label', 'GNU.volume.filename', 'GNU.volume.size', - 'GNU.volume.offset' } - - { V7 uses AB_TAR_LF_OLDNORMAL linkflag, has no magic field & no Usr/Grp Names } - { V7 Format ends Empty(padded with zeros), as does the POSIX record. } - TAbTarEnd_Empty_Rec = packed record - Empty: array[0..AB_TAR_V7_EMPTY_SIZE-1] of Byte; { 345-511, $159-1FF, Empty Space } - end; - { UStar End Format } - TAbTarEnd_UStar_Rec = packed record - Prefix: array[0..AB_TAR_USTAR_PREFIX_SIZE-1] of AnsiChar; - { 345-499, $159-1F3, Prefix of file & path name, null terminated ASCII string } - Empty : Arr12B;{ 500-512, $1F4-1FF, Empty Space } - end; - { Old GNU End Format } - TAbTarEnd_GNU_old_Rec = packed record - Atime : Arr12; { 345-356, $159-164, time of last access (UNIX Date in ASCII coded Octal)} - Ctime : Arr12; { 357-368, $165-170, time of last status change (UNIX Date in ASCII coded Octal)} - Offset: Arr12; { 369-380, $171-17C, Multirecord specific value } - Empty1: array[0..AB_TAR_OLD_GNU_EMPTY1_SIZE-1] of Byte; - { 381-385, $17D-181, Empty Space, Once contained longname ref. } - Sparse: array[0..AB_TAR_OLD_GNU_SPARSE_SIZE-1] of Byte; - { 386-481, $182-1E1, Sparse File specific values } - IsExtended: byte;{ 482, $ 1E2, Flag to signify Sparse file headers follow } - RealSize: Arr12;{ 483-494, $1E3-1EE, Real size of a Sparse File. } - Empty2: array[0..AB_TAR_OLD_GNU_EMPTY2_SIZE-1] of Byte; - { 495-511, $1EF-1FF, Empty Space } - end; - { Star End Format } - TAbTarEnd_Star_Rec = packed record - Prefix: array[0..AB_TAR_STAR_PREFIX_SIZE-1] of AnsiChar; - { 345-499, $159-1F3, prefix of file & path name, null terminated ASCII string } - Atime : Arr12; { 476-487, $1DC-1E7, time of last access (UNIX Date in ASCII coded Octal)} - Ctime : Arr12; { 488-499, $1E8-1F3, time of last status change (UNIX Date in ASCII coded Octal)} - Empty : Arr12B;{ 500-512, $1F4-1FF, Empty Space } - end; - { When support for sparse files is added, Add another record for sparse in header } - - -{ Note: SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE by design } - PAbTarHeaderRec = ^TAbTarHeaderRec; { Declare pointer type for use in the list } - TAbTarHeaderRec = packed record - Name : ArrName; { 0- 99, $ 0- 63, filename, null terminated ASCII string, unless length is 100 } - Mode : Arr8; { 100-107, $ 64- 6B, file mode (UNIX style, ASCII coded Octal) } - uid : Arr8; { 108-115, $ 6C- 73, usrid # (UNIX style, ASCII coded Octal) } - gid : Arr8; { 116-123, $ 74- 7B, grpid # (UNIX style, ASCII coded Octal) } - Size : Arr12; { 124-135, $ 7C- 87, size of TARred file (ASCII coded Octal) } - ModTime : Arr12; { 136-147, $ 88- 93, time of last modification.(UNIX Date in ASCII coded Octal) - UTC time } - ChkSum : Arr8; { 148-155, $ 94- 9B, checksum of header (6 bytes ASCII coded Octal, #00, #20) } - LinkFlag: AnsiChar; { 156, $ 9C, type of item, one of the Link Flag constants from above } - LinkName: ArrName; { 157-256, $ 9D-100, name of link, null terminated ASCII string } - Magic : TAbTarMagicRec; - { 257-264, $101-108, identifier, usually 'ustar'#00'00' } - UsrName : array [0..AB_TAR_TUSRNAMELEN-1] of AnsiChar; - { 265-296, $109-128, username, null terminated ASCII string } - GrpName : array [0..AB_TAR_TGRPNAMELEN-1] of AnsiChar; - { 297-328, $129-148, groupname, null terminated ASCII string } - DevMajor: Arr8; { 329-336, $149-150, major device ID (UNIX style, ASCII coded Octal) } - DevMinor: Arr8; { 337-344, $151-158, minor device ID (UNIX style, ASCII coded Octal) } - case TAbTarHeaderFormat of{ 345-511, $159-1FF See byte Definitions above.} - V7_FORMAT : ( v7 : TAbTarEnd_Empty_Rec ); - OLDGNU_FORMAT: ( gnuOld: TAbTarEnd_GNU_old_Rec ); - GNU_FORMAT : ( gnu : TAbTarEnd_GNU_old_Rec ); - USTAR_FORMAT : ( ustar : TAbTarEnd_UStar_Rec ); - STAR_FORMAT : ( star : TAbTarEnd_Star_Rec ); - POSIX_FORMAT : ( pax : TAbTarEnd_Empty_Rec ); - end;{ end TAbTarHeaderRec } - { There are three main types of headers we will see in a Tar file } - { TAbTarHeaderType = (STANDARD_HDR, SPARSE_HDR, POSIX_EXTENDED_HDR); } - { The 1st is defined above, The later two are simply organized data types. } - - TAbTarItemRec = record - { Note: that the actual The name needs to be coherient with the name Inherited - from parent type TAbArchiveItem } - Name : string; { Path & File name. } - Mode : LongWord; { File Permissions } - uid : Integer; { User ID } - gid : Integer; { Group ID } - Size : Int64; { Tared File size } - ModTime : Int64; { Last time of Modification, in UnixTime } - ChkSumPass : Boolean; { Header Check sum found to be good } - LinkFlag : AnsiChar; { Link Flag, Echos the actual File Type of this Item. } - ItemType : TAbTarItemType; { Item Type Assigned from LinkFlag Header Types. } - LinkName : string; { Link Name } - Magic : AnsiString; { Magic value } - Version : Integer; { Version Number } - UsrName : string; { User Name, for User ID } - GrpName : string; { Group Name, for Group ID } - DevMajor : Integer; { Major Device ID } - DevMinor : Integer; { Minor Device ID } - { Additional Types used for holding info. } - AccessTime : Int64; { Time of Last Access, in UnixTime } - ChangeTime : Int64; { Time of Last Status Change, in UnixTime } - ArchiveFormat: TAbTarHeaderFormat; { Type of Archive of this record } - StreamPosition: Int64; { Pointer to the top of the item in the file. } - Dirty : Boolean; { Indication if this record needs to have its headers CheckSum recalculated } - ItemReadOnly: Boolean; { Indication if this record is READ ONLY } - FileHeaderCount:Integer;{ Number of Headers in the Orginal TarHeaders in the File Stream } - end; - -type - PTAbTarItem = ^TAbTarItem; - TAbTarItem = class(TAbArchiveItem) - private - { The following private members are used for Stuffing FTarItem struct } - procedure ParseTarHeaders; { Error in header if } - procedure DetectHeaderFormat; { Helper to stuff HeaderFormat } - procedure GetFileNameFromHeaders; { Helper to pull name from Headers } - procedure GetLinkNameFromHeaders; { Helper to pull name from Headers } - function TestCheckSum: Boolean; { Helper to Calculate Checksum of a header. } - procedure DoGNUExistingLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString); - procedure DoGNUNewLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString); - protected {private} - PTarHeader: PAbTarHeaderRec;{ Points to FTarHeaderList.Items[FTarHeaderList.Count-1] } - FTarHeaderList: TList; { List of The Headers } - FTarHeaderTypeList: TList; { List of the Header Types } - FTarItem: TAbTarItemRec; { Data about current TAR Item } - protected - function GetDevMajor: Integer; - function GetDevMinor: Integer; - function GetGroupID: Integer; - function GetGroupName: string; - function GetLinkName: string; - function GetUserID: Integer; - function GetUserName: string; - function GetModTime: Int64; - function GetNumHeaders: Integer; - function GetMagic: string; - - { All Sets shall update the headers Or add headers as needed. } - procedure SetDevMajor(const Value: Integer); - procedure SetDevMinor(const Value: Integer); - procedure SetGroupID(const Value: Integer); { Extended Headers } - procedure SetGroupName(const Value: string); { Extended Headers } - procedure SetLinkFlag(Value: AnsiChar); - procedure SetLinkName(const Value: string); { Extended Headers } - procedure SetUserID(const Value: Integer); { Extended Headers } - procedure SetUserName(const Value: string); { Extended Headers } - procedure SetModTime(const Value: Int64); - Procedure SetMagic(const Value: string); - { TODO: add support for Atime and Ctime here } - - { Overrides for Inherited Properties from type TAbArchiveItem } - function GetCompressedSize : Int64; override; - function GetExternalFileAttributes : LongWord; override; - function GetFileName : string; override; - function GetIsDirectory: Boolean; override; - function GetIsEncrypted : Boolean; override; - function GetLastModFileDate : Word; override; - function GetLastModFileTime : Word; override; - function GetLastModTimeAsDateTime: TDateTime; override; - function GetNativeFileAttributes : LongInt; override; - function GetUncompressedSize : Int64; override; - - procedure SetCompressedSize(const Value : Int64); override; { Extended Headers } - procedure SetExternalFileAttributes( Value : LongWord ); override; - procedure SetFileName(const Value : string); override; { Extended Headers } - procedure SetIsEncrypted(Value : Boolean); override; - procedure SetLastModFileDate(const Value : Word); override; { Extended Headers } - procedure SetLastModFileTime(const Value : Word); override; { Extended Headers } - procedure SetLastModTimeAsDateTime(const Value: TDateTime); override; - procedure SetUncompressedSize(const Value : Int64); override; { Extended Headers } - - procedure SaveTarHeaderToStream(AStream : TStream); - procedure LoadTarHeaderFromStream(AStream : TStream); - - property Magic : string { Magic value } - read GetMagic write SetMagic; - public - { property Name : STRING; Path & File name. Inherited from parent type TAbArchiveItem } - { read GetFileName write SetFileName; overridden above} - property Mode : LongWord { File Permissions } - read GetExternalFileAttributes write SetExternalFileAttributes; - property UserID : Integer { User ID } - read GetUserID write SetUserID; - property GroupID : Integer { Group ID } - read GetGroupID write SetGroupID; - property ModTime : Int64 - read GetModTime write SetModTime; - { property UncompressedSize/CompressedSize(Size): Int64; File size (comp/uncomp) Inherited from parent type TAbArchiveItem } - { read GetUncompressedSize, GetCompressedSize; overridden above } - { write SetUncompressedSize, SetCompressedSize; overridden above } - { property LastModFileTime/LastModFileDate(ModeTime): TDateTime; Last time of Modification Inherited from parent type TAbArchiveItem } - { read GetLastModFileTime, GetLastModFileDate; overridden above } - { write SetLastModFileTime, SetLastModFileDate; overridden above } - - property CheckSumGood: Boolean - read FTarItem.ChkSumPass; { Header Check sum found to be good } - property LinkFlag : AnsiChar { Link Flag of File Header } - read FTarItem.LinkFlag write SetLinkFlag; - property LinkName : string { Link Name } - read GetLinkName write SetLinkName; - property UserName : string { User Name, for User ID } - read GetUserName write SetUserName; - property GroupName : string { Group Name, for Group ID } - read GetGroupName write SetGroupName; - property DevMajor : Integer { Major Device ID } - read GetDevMajor write SetDevMajor; - property DevMinor : Integer { Minor Device ID } - read GetDevMinor write SetDevMinor; - { TODO: Add support ATime and CTime } - {AccessTime : TDateTime;} { Time of Last Access } - {ChangeTime : TDateTime;} { Time of Last Status Change } - { Additional Types used for holding info. } - property ExternalFileAttributes; - property ArchiveFormat: TAbTarHeaderFormat - read FTarItem.ArchiveFormat write FTarItem.ArchiveFormat; - property ItemType: TAbTarItemType - read FTarItem.ItemType write FTarItem.ItemType; - property ItemReadOnly: Boolean - read FTarItem.ItemReadOnly write FTarItem.ItemReadOnly; - property FileHeaderCount: Integer - read FTarItem.FileHeaderCount; - property HeaderCount: Integer - read GetNumHeaders; - property StreamPosition: Int64 - read FTarItem.StreamPosition write FTarItem.StreamPosition; - constructor Create; - destructor Destroy; override; - end; { end TAbArchiveItem } - - - TAbTarStreamHelper = class(TAbArchiveStreamHelper) - private - function FindItem: Boolean; { Tool for FindFirst/NextItem functions } - protected - FTarHeader : TAbTarHeaderRec; { Speed-up Buffer only } - FCurrItemSize : Int64; { Current Item size } - FCurrItemPreHdrs: Integer; { Number of Meta-data Headers before the Item } - public - destructor Destroy; override; - procedure ExtractItemData(AStream : TStream); override; - function FindFirstItem : Boolean; override; - function FindNextItem : Boolean; override; - procedure ReadHeader; override; - procedure ReadTail; override; - function SeekItem(Index : Integer): Boolean; override; - procedure WriteArchiveHeader; override; - procedure WriteArchiveItem(AStream : TStream); override; - procedure WriteArchiveItemSize(AStream : TStream; Size: Int64); - procedure WriteArchiveTail; override; - function GetItemCount : Integer; override; - end; - - - TAbTarArchive = class(TAbArchive) - private - FArchReadOnly : Boolean; - FArchFormat: TAbTarHeaderFormat; - protected - function CreateItem(const FileSpec : string): TAbArchiveItem; - override; - procedure ExtractItemAt(Index : Integer; const UseName : string); - override; - procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream); - override; - procedure LoadArchive; - override; - procedure SaveArchive; - override; - procedure TestItemAt(Index : Integer); - override; - function FixName(const Value: string): string; - override; - function GetSupportsEmptyFolders: Boolean; - override; - - function GetItem(Index: Integer): TAbTarItem; - procedure PutItem(Index: Integer; const Value: TAbTarItem); - - public {methods} - constructor CreateFromStream(aStream : TStream; const aArchiveName : string); - override; - property UnsupportedTypesDetected : Boolean - read FArchReadOnly; - property Items[Index : Integer] : TAbTarItem - read GetItem - write PutItem; default; - end; - -function VerifyTar(Strm : TStream) : TAbArchiveType; - - -implementation - -uses - {$IFDEF MSWINDOWS} - Windows, // Fix inline warnings - {$ENDIF MSWINDOWS} - Math, RTLConsts, SysUtils, {$IFDEF HasAnsiStrings}AnsiStrings, {$ENDIF}AbCharset, AbVMStrm, AbExcept; - -{ ****************** Helper functions Not from Classes Above ***************** } -function OctalToInt(const Oct : PAnsiChar; aLen : integer): Int64; -var - i : integer; -begin - Result := 0; - - i := 0; - while (i < aLen) and (Oct[i] = ' ') do - inc(i); - - if (i = aLen) then - Exit; - - while (i < aLen) and (Oct[i] in ['0'..'7']) do begin - Result := (Result * 8) + (Ord(Oct[i]) - Ord('0')); - inc(i); - end; -end; - -function IntToOctal(Value : Int64): AnsiString; -const - OctDigits : array[0..7] of AnsiChar = '01234567'; -begin - if Value = 0 then - Result := '0' - else begin - Result := ''; - while Value > 0 do begin - Result := OctDigits[Value and 7] + Result; - Value := Value shr 3; - end; - end; -end; - - -function CalcTarHeaderChkSum(const TarH : TAbTarHeaderRec): LongInt; -var - HdrBuffer : PAnsiChar; - HdrChkSum : LongInt; - j : Integer; -begin - { prepare for the checksum calculation } - HdrBuffer := PAnsiChar(@TarH); - HdrChkSum := 0; - - {calculate the checksum, a simple sum of the bytes in the header} - for j := 0 to Pred(SizeOf(TAbTarHeaderRec)) do - HdrChkSum := HdrChkSum + Ord(HdrBuffer[j]); - - Result := HdrChkSum; -end; - -function VerifyTar(Strm : TStream) : TAbArchiveType; -{ assumes Tar positioned correctly for test of item } -var - TarItem : TAbTarItem; - StartPos : Int64; -begin - StartPos := Strm.Position; - try - { Verifies that the header checksum is valid, and Item type is understood. - This does not mean that extraction is supported. } - TarItem := TAbTarItem.Create; - try - { get current Tar Header } - TarItem.LoadTarHeaderFromStream(Strm); - if TarItem.CheckSumGood then - Result := atTar - else - Result := atUnknown; - finally - TarItem.Free; - end; - except - on EReadError do - Result := atUnknown; - end; - Strm.Position := StartPos; -end; - -function PadString(const S : AnsiString; Places : Integer) : AnsiString; -{ -Pads a string (S) with one right space and as many left spaces as -needed to fill Places - -If length S greater than Places, just returns S - -Some TAR utilities evidently expect Octal numeric fields to be in -this format -} -begin - if Length(S) >= LongInt(Places) then - Result := S - else begin - Result := S + ' '; - Result := StringOfChar(AnsiChar(' '), Places - Length(Result)) + Result; - end; -end; - -{ Round UP to the nearest Tar Block Boundary. } -function RoundToTarBlock(Size: Int64) : Int64; -begin - Result := (Size + (AB_TAR_RECORDSIZE - 1)) and - not (AB_TAR_RECORDSIZE - 1); -end; - - -{ ****************************** TAbTarItem ********************************** } -constructor TAbTarItem.Create; -begin - inherited Create; - FTarHeaderList := TList.Create; - FTarHeaderTypeList := TList.Create; - GetMem(PTarHeader, AB_TAR_RECORDSIZE); { PTarHeader is our new Header } - FillChar(PTarHeader^, AB_TAR_RECORDSIZE, #0); - FTarHeaderList.Add(PTarHeader); - FTarHeaderTypeList.Add(Pointer(FILE_HEADER)); - FTarItem.FileHeaderCount := 1; - { set defaults } - FTarItem.ArchiveFormat := UNKNOWN_FORMAT; - - FileName := ''; - Mode := AB_FPERMISSION_GENERIC; - UserID := 0; - GroupID := 0; - UncompressedSize := 0; - { ModTime } - LinkFlag := AB_TAR_LF_OLDNORMAL; - { Link Name } - PTarHeader.Magic.gnuOld := AB_TAR_MAGIC_V7_NONE; { Default to GNU type } - UserName := ''; - GroupName := ''; - DevMajor := 0; - DevMinor := 0; - { TODO: atime, ctime } - FTarItem.ItemType := SUPPORTED_ITEM; - FTarItem.Dirty := True; { Checksum needs to be generated } - FTarItem.ItemReadOnly := False; -end; - -destructor TAbTarItem.Destroy; -var - i : Integer; -begin - if Assigned(FTarHeaderList) then - begin - for i := 0 to FTarHeaderList.Count - 1 do - FreeMem(FTarHeaderList.Items[i]); { This list holds PAbTarHeaderRec's } - FTarHeaderList.Free; - end; - FTarHeaderTypeList.Free; - inherited Destroy; -end; - -function TAbTarItem.GetCompressedSize: Int64; -{ TAR includes no internal compression, returns same value as GetUncompressedSize } -begin - Result := FTarItem.Size; -end; - -function TAbTarItem.GetDevMajor: Integer; -begin - Result := FTarItem.DevMajor; -end; - -function TAbTarItem.GetDevMinor: Integer; -begin - Result := FTarItem.DevMinor; -end; - -function TAbTarItem.GetExternalFileAttributes: LongWord; -begin - Result := FTarItem.Mode; -end; - -function TAbTarItem.GetFileName: string; -begin - Result := FTarItem.Name; { Inherited String from Parent Class } -end; - -function TAbTarItem.GetGroupID: Integer; -begin - Result := FTarItem.gid; -end; - -function TAbTarItem.GetGroupName: string; -begin - Result := FTarItem.GrpName; -end; - -function TAbTarItem.GetIsDirectory: Boolean; -begin - Result := (LinkFlag = AB_TAR_LF_DIR); -end; - -function TAbTarItem.GetIsEncrypted: Boolean; -begin - { TAR has no native encryption } - Result := False; -end; - -function TAbTarItem.GetLastModFileDate: Word; -begin - { convert to local DOS file Date } - Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Hi; -end; - -function TAbTarItem.GetLastModFileTime: Word; -begin - { convert to local DOS file Time } - Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Lo; -end; - -function TAbTarItem.GetLastModTimeAsDateTime: TDateTime; -begin - Result := AbUnixTimeToLocalDateTime(FTarItem.ModTime); -end; - -function TAbTarItem.GetLinkName: string; -begin - Result := FTarItem.LinkName; -end; - -function TAbTarItem.GetMagic: string; -begin - Result := string(FTarItem.Magic); -end; - -function TAbTarItem.GetNativeFileAttributes : LongInt; -begin - Result := GetExternalFileAttributes; -{$IFDEF MSWINDOWS} - Result := AbUnix2DosFileAttributes(Result); -{$ENDIF} -end; - -function TAbTarItem.GetUncompressedSize: Int64; -{ TAR includes no internal compression, returns same value as GetCompressedSize } -begin - Result := FTarItem.Size; -end; - -function TAbTarItem.GetUserID: Integer; -begin - Result := FTarItem.uid; -end; - -function TAbTarItem.GetUserName: string; -begin - Result := FTarItem.UsrName; -end; - -function TAbTarItem.GetModTime: Int64; -begin - Result := FTarItem.ModTime; -end; - -{ Get Number of tar headers currently for this item } -function TAbTarItem.GetNumHeaders: Integer; -begin - Result := FTarHeaderList.Count; -end; - -{ Takes data from Supported Header types stored in TAbTarItem.FTarHeaderList } -{ and updates values in the TAbTarItem.FTarItem.X } - -procedure TAbTarItem.DetectHeaderFormat; -begin - if FTarItem.ArchiveFormat <> UNKNOWN_FORMAT then - Exit;{ We have already set the format. } - { In the previous header parsing if pax headers are detected the format is changed } - { GNU_FORMAT is detected by the presence of GNU extended headers. } - - { These detections are similar to GNU tar's. } - if (PTarHeader.Magic.value = AB_TAR_MAGIC_VAL) then - begin { We have one of three types, STAR_FORMAT, USTAR_FORMAT, POSIX_FORMAT } - { Detect STAR format. Leave disabled until explicit STAR support is added. } - {if (PTarHeader.star.Prefix[130] = #00) and - (PTarHeader.star.Atime[0] in ['0'..'7']) and - (PTarHeader.star.Atime[11] = #20) and - (PTarHeader.star.Ctime[0]in ['0'..'7']) and - (PTarHeader.star.Ctime[11] = #20) then - begin - FTarItme.ArchiveType := STAR_FORMAT; - end } - { else if } { POSIX uses the existance of x headers } - - { This can define false positives, Pax headers/ STAR format could be detected as this } - FTarItem.ArchiveFormat := USTAR_FORMAT; - end - else if (PTarHeader.Magic.gnuOld = AB_TAR_MAGIC_GNUOLD) then - begin - FTarItem.ArchiveFormat := OLDGNU_FORMAT; - end - else { V7 uses AB_TAR_LF_OLDNORMAL linkflag, has no magic field & no Usr/Grp Names } - begin - FTarItem.ArchiveFormat := V7_FORMAT; { Lowest Common Denominator } - end; -end; - -{ Extract the file name from the headers } -procedure TAbTarItem.GetFileNameFromHeaders; -var - I, J : Integer; - PHeader: PAbTarHeaderRec; - FoundName: Boolean; - NameLength : Int64; - NumMHeaders: integer; - ExtraName: integer; - RawFileName, TempStr: AnsiString; -begin - { UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT } - FoundName := False; - I := 0; - while (not FoundName) and (I <= (FTarHeaderList.Count - 1)) do - begin - PHeader := FTarHeaderList.Items[I]; - if PHeader.LinkFlag = AB_TAR_LF_LONGNAME then - begin - FoundName := True; - RawFileName := ''; - NameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size)); - NumMHeaders := NameLength div AB_TAR_RECORDSIZE; - ExtraName := NameLength mod AB_TAR_RECORDSIZE; { Chars in the last Header } - { NumMHeaders should never be zero } - { It appears that it is not null terminated in the blocks } - for J := 1 to NumMHeaders do - begin - { Copy entire content of Header to String } - PHeader := FTarHeaderList.Items[I+J]; - SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE); - RawFileName := RawFileName + TempStr; - end; - if ExtraName <> 0 then - begin - PHeader := FTarHeaderList.Items[I+NumMHeaders+1]; - SetString(TempStr, PAnsiChar(PHeader), ExtraName-1); - RawFileName := RawFileName + TempStr; - end - else { We already copied the entire name, but the string is still null terminated. } - begin - { Removed the last zero } - SetLength(RawFileName, (Length(RawFileName)-1)); - end; - end { end long filename link flag } - else - I := I + 1; - end; { End While } - - if not FoundName then - begin - if (FTarItem.ArchiveFormat = USTAR_FORMAT) and - (PTarHeader.ustar.Prefix[0] <> #0) then - RawFileName := PTarHeader.ustar.Prefix+'/'+PTarHeader.Name - else - { V7_FORMAT, OLDGNU_FORMAT } - RawFileName := PTarHeader.Name; - end; { End not FoundName } - - FTarItem.Name := AbRawBytesToString(RawFileName); -end; - -{ Extract the file name from the headers } -procedure TAbTarItem.GetLinkNameFromHeaders; -var - I, J : Integer; - PHeader: PAbTarHeaderRec; - FoundName: Boolean; - NameLength : Int64; - NumMHeaders: integer; - ExtraName: integer; - RawLinkName, TempStr: AnsiString; -begin - { UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT } - PHeader := nil; - FoundName := False; - I := 0; - { Note that: FTarHeaderList.Count <= 1, always } - while (not FoundName) and (I <= (FTarHeaderList.Count - 1)) do - begin - PHeader := FTarHeaderList.Items[I]; - if PHeader.LinkFlag = AB_TAR_LF_LONGLINK then - begin - FoundName := True; - RawLinkName := ''; - NameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size)); - NumMHeaders := NameLength div AB_TAR_RECORDSIZE; - ExtraName := NameLength mod AB_TAR_RECORDSIZE; { Chars in the last Header } - { NumMHeaders should never be zero } - { It appears that it is not null terminated in the blocks } - for J := 1 to NumMHeaders do - begin - { Copy entire content of Header to String } - PHeader := FTarHeaderList.Items[I+J]; - SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE); - RawLinkName := RawLinkName + TempStr; - end; - if ExtraName <> 0 then - begin - PHeader := FTarHeaderList.Items[I+NumMHeaders+1]; - SetString(TempStr, PAnsiChar(PHeader), ExtraName-1); - RawLinkName := RawLinkName + TempStr; - end - else { We already copied the entire name, but the string is still null terminated. } - begin - { Removed the last zero } - SetLength(RawLinkName, (Length(RawLinkName)-1)); - end; - end { end long filename link flag } - else - I := I + 1; - end; { End While } - - if not FoundName then - RawLinkName := PHeader.LinkName; - - FTarItem.LinkName := AbRawBytesToString(RawLinkName); -end; - -{ Return True if CheckSum passes out. } -function TAbTarItem.TestCheckSum : Boolean; -var - TarChkSum : LongInt; - TarChkSumArr : Arr8; { ChkSum field is Arr8 } - PHeader: PAbTarHeaderRec; - I: Integer; -begin - Result := True; - { Check sums are in valid headers but NOT in the data headers. } - for I := 0 to FTarHeaderList.Count - 1 do - begin - if TAbTarHeaderType(FTarHeaderTypeList.Items[I]) in [FILE_HEADER, META_DATA_HEADER] then - begin - PHeader := FTarHeaderList.Items[i]; - { Save off old Check sum } - Move(PHeader.ChkSum, TarChkSumArr, SizeOf(PHeader.ChkSum)); - TarChkSum := OctalToInt(TarChkSumArr, SizeOf(TarChkSumArr)); - { Set to Generator Value } - PHeader.ChkSum := AB_TAR_CHKBLANKS; - if CalcTarHeaderChkSum(PHeader^) <> TarChkSum then - Result := False; { Pass unless one miss-compares } - { Save back old checksum } - Move(TarChkSumArr, PHeader.ChkSum, SizeOf(TarChkSumArr)); - end; - end; -end; - -procedure TAbTarItem.ParseTarHeaders; -begin - { The final index is the Item index } - DetectHeaderFormat; - { Long term this parsing is not correct, as the values in extended headers - override the later values in this header } - FTarItem.Mode := OctalToInt(PTarHeader.Mode, SizeOf(PTarHeader.Mode)); - FTarItem.uid := OctalToInt(PTarHeader.uid, SizeOf(PTarHeader.uid)); { Extended in PAX Headers } - FTarItem.gid := OctalToInt(PTarHeader.gid, SizeOf(PTarHeader.gid)); { Extended in PAX Headers } - FTarItem.Size := OctalToInt(PTarHeader.Size, SizeOf(PTarHeader.Size)); { Extended in PAX Headers } - { ModTime should be an Int64 but no tool support, No issues until Feb 6th, 2106 :) } - { ModTime is Extended in PAX Headers } - FTarItem.ModTime := OctalToInt(PTarHeader.ModTime, SizeOf(PTarHeader.ModTime)); - FTarItem.ChkSumPass := TestCheckSum(); - FTarItem.LinkFlag := PTarHeader.LinkFlag; - GetLinkNameFromHeaders; { Extended in PAX Headers } - FTarItem.Magic := PTarHeader.Magic.value; - FTarItem.Version := OctalToInt(PTarHeader.Magic.version, SizeOf(PTarHeader.Magic.version)); - FTarItem.UsrName := string(PTarHeader.UsrName); { Extended in PAX Headers } - FTarItem.GrpName := string(PTarHeader.GrpName); { Extended in PAX Headers } - FTarItem.DevMajor := OctalToInt(PTarHeader.DevMajor, SizeOf(PTarHeader.DevMajor)); - FTarItem.DevMinor := OctalToInt(PTarHeader.DevMinor, SizeOf(PTarHeader.DevMinor)); - GetFileNameFromHeaders; - { FTarItem.ArchiveFormat; Already stuffed } - { FTarItem.StreamPosition: Already Stuffed } - { FTarItem.Dirty; Stuffed upon creaction } -end; - -procedure TAbTarItem.LoadTarHeaderFromStream(AStream: TStream); -var - NumMHeaders : Integer; - I : Integer; - FoundItem : Boolean; -begin - { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE } - { We should expect FindNext/FirstItem, and next check for bounds. } - if FTarHeaderList.Count > 0 then - begin { We're Going to stomp over the headers that are already present } - { We need to destory the memory we've used } - PTarHeader := nil; - for i := 0 to FTarHeaderList.Count - 1 do - FreeMem(FTarHeaderList.Items[i]); { This list holds PAbTarHeaderRec's } - FTarHeaderList.Clear; - FTarHeaderTypeList.Clear; - FTarItem.FileHeaderCount := 0; - { All pointers should now be removed from those headers } - end; - { Now lets start filling up that list. } - FTarItem.ItemType := UNKNOWN_ITEM; { We don't know what we have yet } - FoundItem := False; - while not FoundItem do - begin - { Create a Header to be Stored in the Items List } - GetMem(PTarHeader, AB_TAR_RECORDSIZE); - AStream.ReadBuffer(PTarHeader^, AB_TAR_RECORDSIZE); - FTarHeaderList.Add(PTarHeader); { Store the Header to the list } - { Parse header based on LinkFlag } - if PTarHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then - begin { This Header type is in the Set of un/supported Meta data type headers } - if PTarHeader.LinkFlag in AB_UNSUPPORTED_MD_HEADERS then - FTarItem.ItemReadOnly := True; { We don't fully support this meta-data type } - if (PTarHeader.LinkFlag in AB_PAX_MD_HEADERS) and (PTarHeader.Magic.value = AB_TAR_MAGIC_VAL) then - FTarItem.ArchiveFormat := POSIX_FORMAT; { We have a POSIX_FORMAT, has x headers, and Magic matches } - if PTarHeader.LinkFlag in AB_GNU_MD_HEADERS then - FTarItem.ArchiveFormat := OLDGNU_FORMAT; { We have a OLDGNU_FORMAT, has L/K headers } - { There can be a unknown number of Headers of data } - { We are for sure going to read at least one more header, but are we going to read more than that? } - FTarHeaderTypeList.Add(Pointer(META_DATA_HEADER)); - NumMHeaders := Ceil(OctalToInt(PTarHeader.Size, SizeOf(PTarHeader.Size)) / AB_TAR_RECORDSIZE); - { NumMHeasder should never be zero } - for I := 1 to NumMHeaders do - begin - GetMem(PTarHeader, AB_TAR_RECORDSIZE); { Create a new Header } - AStream.ReadBuffer(PTarHeader^, AB_TAR_RECORDSIZE); { Get the Meta Data } - FTarHeaderList.Add(PTarHeader); { Store the Header to the list } - FTarHeaderTypeList.Add(Pointer(MD_DATA_HEADER)); - end; - { Loop and reparse } - end - else if PTarHeader.LinkFlag in AB_SUPPORTED_F_HEADERS then - begin { This Header type is in the Set of supported File type Headers } - FoundItem := True; { Exit Criterion } - FTarItem.ItemType := SUPPORTED_ITEM; - if FTarItem.ItemReadOnly then { Since some of the Headers are read only. } - FTarItem.ItemType := UNSUPPORTED_ITEM; { This Item is unsupported } - FTarHeaderTypeList.Add(Pointer(FILE_HEADER)); - end - else if PTarHeader.LinkFlag in AB_UNSUPPORTED_F_HEADERS then - begin { This Header type is in the Set of unsupported File type Headers } - FoundItem := True; { Exit Criterion } - FTarItem.ItemType := UNSUPPORTED_ITEM; - FTarHeaderTypeList.Add(Pointer(FILE_HEADER)); - end - else { These are unknown header types } - begin { Note: Some of these unknown types could have known Meta-data headers } - FoundItem := True; - FTarItem.ItemType := UNKNOWN_ITEM; - FTarHeaderTypeList.Add(Pointer(UNKNOWN_HEADER)); - end;{ end LinkFlag parsing } - end; { end Found Item While } - { PTarHeader points to FTarHeaderList.Items[FTarHeaderList.Count-1]; } - - { Re-wind the Stream back to the begining of this Item inc. all headers } - AStream.Seek(-(FTarHeaderList.Count*AB_TAR_RECORDSIZE), soCurrent); - { AStream.Position := FTarItem.StreamPosition; } { This should be equivalent as above } - FTarItem.FileHeaderCount := FTarHeaderList.Count; - if FTarItem.ItemType <> UNKNOWN_ITEM then - begin - ParseTarHeaders; { Update FTarItem values } - FFileName := FTarItem.Name; {FTarHeader.Name;} - FDiskFileName := FileName; - AbUnfixName(FDiskFileName); - end; - Action := aaNone; - Tagged := False; -end; - - -{ ****************** BEGIN SET ********************** } - -procedure TAbTarItem.SaveTarHeaderToStream(AStream: TStream); -var - i : Integer; - j : Integer; - PHeader : PAbTarHeaderRec; - HdrChkSum : Integer; - HdrChkStr : AnsiString; - HdrBuffer : PAnsiChar; - SkipNextChkSum: Integer; - SkipChkSum: Boolean; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE } - if FTarItem.Dirty then - SkipNextChkSum := 0 - else - SkipNextChkSum := FTarHeaderList.Count; { Don't recalc any chkSums } - - { The first header in the Item list must have a checksum calculation } - for i := 0 to (FTarHeaderList.Count-1) do - begin - SkipChkSum := False; - PHeader := FTarHeaderList.Items[i]; - if (SkipNextChkSum = 0) then - begin { We need to parse this header } - if PHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then - begin { We have a Meta-Data Header, Calculate how many headers to skip. } - { These meta-data headers have non-Header buffers after this Header } - SkipNextChkSum := Ceil(OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE); - { Ceil will mandate one run through, and will handle 512 correctly } - end - else if PHeader.LinkFlag in AB_SUPPORTED_F_HEADERS then - begin - SkipNextChkSum := 0; - end - else - begin { Un-Supported Header type, Copy but do nothing to the data } - SkipNextChkSum := 0; - SkipChkSum := True; - end;{ end LinkFlag parsing } - end - else - begin { Do not calcuate the check sum on this meta Data header buffer } - SkipNextChkSum := SkipNextChkSum - 1; - SkipChkSum := True; - end;{ end SkipNextChkSum } - - if not SkipChkSum then - begin { We are Calculating the Checksum for this Header } - {Tar ChkSum is "odd" The check sum field is filled with #20 chars as empty } - { ChkSum field itself is #20'd and has an effect on the sum } - PHeader.ChkSum := AB_TAR_CHKBLANKS; - { Set up the buffers } - HdrBuffer := PAnsiChar(PHeader); - HdrChkSum := 0; - { Calculate the checksum, a simple sum of the bytes in the header } - for j := 0 to (AB_TAR_RECORDSIZE-1) do - HdrChkSum := HdrChkSum + Ord(HdrBuffer[j]); - { set the checksum in the header } - HdrChkStr := PadString(IntToOctal(HdrChkSum), SizeOf(PHeader.ChkSum)); - Move(HdrChkStr[1], PHeader.ChkSum, Length(HdrChkStr)); - end; { end Skip Check Sum } - { write header to the file } - AStream.Write(PHeader^, AB_TAR_RECORDSIZE); - end; { End for the number of headers in the list } - { Updated here as the stream is now updated to the latest number of headers } - FTarItem.FileHeaderCount := FTarHeaderList.Count; -end; - -procedure TAbTarItem.SetCompressedSize(const Value: Int64); -var - S : AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { Size is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers } - FTarItem.Size := Value; { Store our Vitrual Copy } - S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header } - Move(S[1], PTarHeader.Size, Length(S)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetDevMajor(const Value: Integer); -var - S : AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { Dev Major and Minor are Only used for AB_TAR_LF_CHR, AB_TAR_LF_BLK } - { Otherwise they are stuffed with #00 } - FTarItem.DevMajor := Value; { Store to the struct } - S := PadString(IntToOctal(Value), SizeOf(Arr8)); - Move(S[1], PTarHeader.DevMajor, Length(S)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetDevMinor(const Value: Integer); -var - S : AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { Dev Major and Minor are Only used for AB_TAR_LF_CHR, AB_TAR_LF_BLK } - { Otherwise they are stuffed with #00 } - FTarItem.DevMinor := Value; - S := PadString(IntToOctal(Value), SizeOf(Arr8)); - Move(S[1], PTarHeader.DevMinor, Length(S)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetExternalFileAttributes(Value: LongWord); -var - S : AnsiString; - I: Integer; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - FTarItem.Mode := Value; - S := PadString(IntToOctal(Value), SizeOf(Arr8)); - for I := 0 to FTarHeaderList.Count - 1 do - if TAbTarHeaderType(FTarHeaderTypeList.Items[I]) in [FILE_HEADER, META_DATA_HEADER] then - Move(S[1], PAbTarHeaderRec(FTarHeaderList.Items[I]).Mode, Length(S)); - FTarItem.Dirty := True; -end; - -{ Add/Remove Headers as needed To/From Existing GNU Long (Link/Name) TarItems } -procedure TAbTarItem.DoGNUExistingLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString); -var - PHeader: PAbTarHeaderRec; - J: Integer; - OldNameLength: Integer; - TotalOldNumHeaders: Integer; - TotalNewNumHeaders: Integer; - NumHeaders: Integer; - ExtraName: Integer; - tempStr: AnsiString; -begin - PHeader := FTarHeaderList.Items[I]; - - { Need this data from the old header } - OldNameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));{ inlcudes Null termination } - { Length(FTarItem.Name)+1 = OldNameLength; }{ This should be true, always } - - { Save off the new Length, so we don't have to change the pointers later. } - tempStr := PadString(IntToOctal(Length(Value)+1), SizeOf(PHeader.Size)); - Move(tempStr[1], PHeader.Size, Length(tempStr)); - - TotalOldNumHeaders := Ceil(OldNameLength / AB_TAR_RECORDSIZE); - TotalNewNumHeaders := Ceil((Length(Value)+1) / AB_TAR_RECORDSIZE);{ Null terminated } - {Length(Value)+1: 1-512 = 1, 513-1024 = 2 ... } - J := TotalOldNumHeaders - TotalNewNumHeaders; - while J <> 0 do - begin - if J > 0 then - begin { Old > New, Have to many Headers, Remove } - FreeMem(FTarHeaderList.Items[I+J]); { Free the Memory for the extra Header } - FTarHeaderList.Delete(I+J); { Delete the List index } - FTarHeaderTypeList.Delete(I+J); - J := J - 1; - end - else { if J < 0 then } - begin { Old < New, Need more Headers, Insert } - GetMem(PHeader, AB_TAR_RECORDSIZE); - FTarHeaderList.Insert(I+1,PHeader);{ Insert: Inserts at index } - FTarHeaderTypeList.Insert(I+1,Pointer(MD_DATA_HEADER));{ We are only adding MD Data headers here } - J := J + 1; - end; - end;{ end numHeaders while } - { Yes, GNU Tar adds a Nil filled MD data header if Length(Value) mod AB_TAR_RECORDSIZE = 0 } - NumHeaders := (Length(Value)+1) div AB_TAR_RECORDSIZE; { Include Null terminator } - ExtraName := (Length(Value)+1) mod AB_TAR_RECORDSIZE; { Chars in the last Header } - { Now we have the number of headers set up, stuff the name in the Headers } - TempStr := AnsiString(Value); - for J := 1 to NumHeaders do - begin - { Copy entire next AB_TAR_RECORDSIZE bytes of tempString to content of Header } - { There may only be AB_TAR_RECORDSIZE-1 bytes if this is the last rounded header } - PHeader := FTarHeaderList.Items[I+J]; - Move(TempStr[1], PHeader^, AB_TAR_RECORDSIZE); - if Length(TempStr) >= AB_TAR_RECORDSIZE then - Delete(TempStr, 1, AB_TAR_RECORDSIZE);{ Crop string } - end; - if ExtraName <> 0 then - begin - { Copy whatever is left in tempStr into the rest of the buffer } - PHeader := FTarHeaderList.Items[I+NumHeaders+1]; - FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block } - Move(TempStr[1], PHeader^, ExtraName-1); { The string is null terminated } - end - else { We already copied the entire name, but it must be null terminated } - begin - FillChar(Pointer(PtrInt(PHeader)+AB_TAR_RECORDSIZE-1)^, 1, #0); { Zero rest of the block } - end; - - { Finally we need to stuff the file type Header. } - { Note: Value.length > AB_TAR_NAMESIZE(100) } - if LinkFlag = AB_TAR_LF_LONGNAME then - Move(Value[1], PTarHeader.Name, AB_TAR_NAMESIZE) - else - Move(Value[1], PTarHeader.LinkName, AB_TAR_NAMESIZE); -end; - - -{ Always inserts the L/K Headers at index 0+ } -procedure TAbTarItem.DoGNUNewLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString); -var - PHeader: PAbTarHeaderRec; - J: Integer; - NumHeaders: Integer; - ExtraName: Integer; - tempStr: AnsiString; -begin - { We have a GNU_FORMAT, and no L/K Headers.} - { Add a new MD Header and MD Data Headers } - { Make an L/K header } - GetMem(PHeader, AB_TAR_RECORDSIZE); - FTarHeaderList.Insert(I, PHeader);{ Insert: Inserts at base index } - FTarHeaderTypeList.Insert(I, Pointer( META_DATA_HEADER));{ This is the L/K Header } - FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block } - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.Name, AB_TAR_L_HDR_NAME); { Stuff L/K String Name } - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.Mode, AB_TAR_L_HDR_ARR8_0); { Stuff zeros } - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.uid, AB_TAR_L_HDR_ARR8_0); { Stuff zeros } - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.gid, AB_TAR_L_HDR_ARR8_0); { Stuff zeros } - tempStr := PadString(IntToOctal(Length(Value)+1), SizeOf(PHeader.Size)); { Stuff Size } - Move(tempStr[1], PHeader.Size, Length(tempStr)); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.ModTime, AB_TAR_L_HDR_ARR12_0); { Stuff zeros } - { Check sum will be calculated as the Dirty flag is in caller. } - PHeader.LinkFlag := LinkFlag; { Stuff Link FlagSize } - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.Magic.gnuOld, AB_TAR_MAGIC_GNUOLD); { Stuff the magic } - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.UsrName, AB_TAR_L_HDR_USR_NAME); - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPCopy(PHeader.GrpName, AB_TAR_L_HDR_GRP_NAME); - { All else stays as Zeros. } - { Completed with L/K Header } - - { OK, now we need to add the proper number of MD Data Headers, and intialize to new name } - { Yes, GNU Tar adds an extra Nil filled MD data header if Length(Value) mod AB_TAR_RECORDSIZE = 0 } - NumHeaders := Ceil((Length(Value)+1) / AB_TAR_RECORDSIZE); { Include Null terminator } - ExtraName := (Length(Value)+1) mod AB_TAR_RECORDSIZE; { Chars in the last Header } - { Now we have the number of headers set up, stuff the name in the Headers } - TempStr := AnsiString(Value); - for J := 1 to NumHeaders-1 do - begin - { Make a buffer, and copy entire next AB_TAR_RECORDSIZE bytes of tempStr to content of Header } - { There may only be AB_TAR_RECORDSIZE-1 bytes if this is the last rounded header } - GetMem(PHeader, AB_TAR_RECORDSIZE); - FTarHeaderList.Insert(J+I, PHeader); - FTarHeaderTypeList.Insert(J+I, Pointer(MD_DATA_HEADER));{ We are adding MD Data headers here } - Move(TempStr[1], PHeader^, AB_TAR_RECORDSIZE); - if Length(TempStr) >= AB_TAR_RECORDSIZE then - Delete(TempStr, 1, AB_TAR_RECORDSIZE);{ Crop string } - end; - if ExtraName <> 0 then - begin - { Copy what ever is left in tempStr into the rest of the buffer } - { Create the last MD Data Header } - GetMem(PHeader, AB_TAR_RECORDSIZE); - FTarHeaderList.Insert(I+NumHeaders, PHeader);{ Insert: Inserts at base index } - FTarHeaderTypeList.Insert(I+NumHeaders, Pointer(MD_DATA_HEADER));{ We are only adding MD Data headers here } - FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block } - Move(TempStr[1], PHeader^, ExtraName-1); { The string is null terminated in the header } - end - else { We already copied the entire name, but it must be null terminated } - begin - FillChar(Pointer(PtrInt(PHeader)+AB_TAR_RECORDSIZE-1)^, 1, #0); { Zero rest of the block } - end; - - { Finally we need to stuff the file type Header. } - { Note: Value.length > AB_TAR_NAMESIZE(100) } - if LinkFlag = AB_TAR_LF_LONGNAME then - Move(Value[1], PHeader.Name, AB_TAR_NAMESIZE) - else - Move(Value[1], PHeader.LinkName, AB_TAR_NAMESIZE); -end; - -procedure TAbTarItem.SetFileName(const Value: string); -var - FoundMetaDataHeader: Boolean; - PHeader: PAbTarHeaderRec; - I, J: Integer; - TotalOldNumHeaders: Integer; - RawFileName: AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { Assume ItemReadOnly is set for all Unsupported Type. } - - { Cases: - New File Name is short, Length <= 100, - All formats: Zero Name field and move new name to field. - V7: Work complete, 1 header - USTAR: zero prefix field, 1 Header - OLD_GNU & GNU: Remove old name headers, 1 header. - STAR & PAX: And should not yet get here. - New File Name is Long, Length >=101 - Note: The Header Parsing sets any V7 to GNU if 'L'/'K" Headers are present - V7: Raise an exception, as this can NOT be done, no change to header. - USTAR: if new length <= 254 zero fill header, update name fields, 1 updated Header - if new Length >= 255 raise an exception, as this can NOT be done, no change to header - if old was Short, Add files to match format, - OLD_GNU & GNU: Create new Name header, Add N Headers for name, Update name in file header, update name fields, min 3 headers - STAR & PAX: And should not yet get here. - if old was Long, - OLD_GNU & GNU: Add N Headers for name, Update name in MD header, update name field in File Headers, min 3 headers - - Add headers to length of new Name Length, update name in file header, update name fields } - RawFileName := AbStringToUnixBytes(Value); - { In all cases zero out the name fields in the File Header. } - if Length(RawFileName) > AB_TAR_NAMESIZE then begin { Must be null terminated except at 100 char length } - { Look for long name meta-data headers already in the archive. } - FoundMetaDataHeader := False; - I := 0; - { FTarHeaderList.Count <= 1 always } - while (not FoundMetaDataHeader) and (I <= (FTarHeaderList.Count - 1)) do begin - PHeader := FTarHeaderList.Items[I]; - if PHeader.LinkFlag = AB_TAR_LF_LONGNAME then begin - { We are growing or Shriking the Name MD Data fields. } - FoundMetaDataHeader := True; - DoGNUExistingLongNameLink(AB_TAR_LF_LONGNAME, I, RawFileName); - { Need to copy the Name to the header. } - FTarItem.Name := Value; - end - else - I := I + 1; - end; { End While } - { MD Headers & MD Data Headers have been stuffed if FoundMetaDataHeader } - { Still need to stuff the File type header contents. } - if not FoundMetaDataHeader then - begin - case FTarItem.ArchiveFormat of - V7_FORMAT: raise EAbTarBadFileName.Create; { File Name to Long } - USTAR_FORMAT: - begin - { Longest file name is AB_TAR_NAMESIZE(100) chars } - { Longest Prefix is AB_TAR_USTAR_PREFIX_SIZE(155) chars } - { These two fields are delimted by a '/' char } - {0123456789012345, Length = 15, NameLength = 5, PrefixLength = 9} - { AAAA/BBBB/C.txt, Stored as Name := 'C.txt', Prefix := 'AAAA/BBBB' } - { That means Theoretical maximum is 256 for Length(RawFileName) } - if Length(RawFileName) > (AB_TAR_NAMESIZE+AB_TAR_USTAR_PREFIX_SIZE+1) then { Check the obvious one. } - raise EAbTarBadFileName.Create; { File Name to Long } - for I := Length(RawFileName) downto Length(RawFileName)-AB_TAR_NAMESIZE-1 do begin - if RawFileName[I] = '/' then begin - if (I <= AB_TAR_USTAR_PREFIX_SIZE+1) and (Length(RawFileName)-I <= AB_TAR_NAMESIZE) then begin - { We have a successfull parse. } - FillChar(PTarHeader.Name, SizeOf(PTarHeader.Name), #0); - FillChar(PTarHeader.ustar.Prefix, SizeOf(PTarHeader.ustar.Prefix), #0); - Move(RawFileName[I+1], PTarHeader.Name, Length(RawFileName)-I); - Move(RawFileName[1], PTarHeader.ustar.Prefix, I); - break; - end - else if (Length(RawFileName)-I > AB_TAR_NAMESIZE) then - raise EAbTarBadFileName.Create { File Name not splittable } - { else continue; } - end; - end;{ End for I... } - end; { End USTAR Format } - OLDGNU_FORMAT: DoGNUNewLongNameLink(AB_TAR_LF_LONGNAME, 0, RawFileName); {GNU_FORMAT} - else begin - { UNKNOWN_FORMAT, STAR_FORMAT, POSIX_FORMAT } - raise EAbTarBadOp.Create; { Unknown Archive Format } - end;{ End of Else for case statement } - end;{ End of case statement } - FTarItem.Name := Value; - end; { if no Meta data header found } - end { End "name length larger than 100" } - else - begin { Short new name, Simple Case Just put it in the Name Field & remove any headers } - { PTarHeader Points to the File type Header } - { Zero the Name field } - FillChar(PTarHeader.Name, SizeOf(PTarHeader.Name), #0); - if FTarItem.ArchiveFormat in [USTAR_FORMAT] then { Zero the prefix field } - FillChar(PTarHeader.ustar.Prefix, SizeOf(PTarHeader.ustar.Prefix), #0); - if FTarItem.ArchiveFormat in [GNU_FORMAT, OLDGNU_FORMAT] then - begin { We may have AB_TAR_LF_LONGNAME Headers to be removed } - { Remove long file names Headers if they exist} - FoundMetaDataHeader := False; - I := 0; - while not FoundMetaDataHeader and (I <= (FTarHeaderList.Count - 1)) do - begin - PHeader := FTarHeaderList.Items[I]; - if PHeader.LinkFlag in [AB_TAR_LF_LONGNAME] then - begin { Delete this Header, and the data Headers. } - FoundMetaDataHeader := True; - TotalOldNumHeaders := Ceil( OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE); - for J := TotalOldNumHeaders downto 0 do - begin { Note 0 will delete the Long Link MD Header } - FreeMem(FTarHeaderList.Items[I+J]); { This list holds PAbTarHeaderRec's } - FTarHeaderList.Delete(I+J); - FTarHeaderTypeList.Delete(I+J); - end; - end - else - I := I + 1; { Got to next header } - end;{ End While not found... } - end; { End if GNU... } - { Save off the new name and store to the Header } - FTarItem.Name := Value; - { Must add Null Termination before we store to Header } - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(PTarHeader.Name, RawFileName, AB_TAR_NAMESIZE); - end;{ End else Short new name,... } - - { Update the inherited file names. } - FFileName := FTarItem.Name; - DiskFileName := FFileName; - AbUnfixName(FDiskFileName); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetGroupID(const Value: Integer); -var - S : AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { gid is extendable in PAX Headers, Rember PAX extended Header Over Rule File Headers } - FTarItem.gid := Value; - S := PadString(IntToOctal(Value), SizeOf(Arr8)); - Move(S[1], PTarHeader.gid, Length(S)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetGroupName(const Value: string); -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { GrpName is extendable in PAX Headers, Rember PAX extended Header Over Rule File Headers } - FTarItem.GrpName := Value; - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(PTarHeader.GrpName, AnsiString(Value), SizeOf(PTarHeader.GrpName)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetIsEncrypted(Value: Boolean); -begin - { do nothing, TAR has no native encryption } -end; - -procedure TAbTarItem.SetLastModFileDate(const Value: Word); -begin - { replace date, keep existing time } - LastModTimeAsDateTime := - EncodeDate( - Value shr 9 + 1980, - Value shr 5 and 15, - Value and 31) + - Frac(LastModTimeAsDateTime); -end; - -procedure TAbTarItem.SetLastModFileTime(const Value: Word); -begin - { keep current date, replace time } - LastModTimeAsDateTime := - Trunc(LastModTimeAsDateTime) + - EncodeTime( - Value shr 11, - Value shr 5 and 63, - Value and 31 shl 1, 0); -end; - -procedure TAbTarItem.SetLastModTimeAsDateTime(const Value: TDateTime); -begin - // TAR stores always Unix time. - SetModTime(AbLocalDateTimeToUnixTime(Value)); // also updates headers -end; - -procedure TAbTarItem.SetLinkFlag(Value: AnsiChar); -begin - if FTarItem.ItemReadOnly then - Exit; - FTarItem.LinkFlag := Value; - PTarHeader.LinkFlag := Value; - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetLinkName(const Value: string); -var - FoundMetaDataHeader: Boolean; - PHeader: PAbTarHeaderRec; - I, J: Integer; - TotalOldNumHeaders: Integer; - RawLinkName: AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { Cases: - New Link Name is short, Length <= 100, - All formats: Zero Name field and move new name to field. - V7: Work complete, 1 header - USTAR: Work complete, 1 Header - OLD_GNU & GNU: Remove old link headers, 1 header. - STAR & PAX: And should not yet get here. - New File Name is Long, Length >=101 - Note: The Header Parsing sets any V7 to GNU if 'L'/'K' Headers are present - V7: Raise an exception, as this can NOT be done, no change to header. - USTAR: Raise an exception, as this can NOT be done, no change to header. - if old was Short, Add files to match format, - OLD_GNU & GNU: Create new Link header, Add N Headers for name, Update name in file header, update name fields, min 3 headers - if old was Long, - OLD_GNU & GNU: Add N Headers for name, Update name in MD header, update name field in File Headers, min 3 headers - STAR & PAX: And should not yet get here.} - RawLinkName := AbStringToUnixBytes(Value); - if Length(RawLinkName) > AB_TAR_NAMESIZE then { Must be null terminated except at 100 char length } - begin - { Look for long name meta-data headers already in the archive. } - FoundMetaDataHeader := False; - I := 0; - { FTarHeaderList.Count <= 1 always } - while (not FoundMetaDataHeader) and (I <= (FTarHeaderList.Count - 1)) do begin - PHeader := FTarHeaderList.Items[I]; - if PHeader.LinkFlag = AB_TAR_LF_LONGLINK then - begin { We are growing or Shriking the Name MD Data fields. } - FoundMetaDataHeader := True; - DoGNUExistingLongNameLink(AB_TAR_LF_LONGLINK, I, RawLinkName); - { Need to copy the Name to the header. } - FTarItem.LinkName := Value; - end - else - I := I + 1; - end; { End While } - { MD Headers & MD Data Headers have been stuffed if FoundMetaDataHeader } - { Still need to stuff the File type header contents. } - if not FoundMetaDataHeader then - begin - case FTarItem.ArchiveFormat of - V7_FORMAT: raise EAbTarBadLinkName.Create; { Link Name to Long } - USTAR_FORMAT: raise EAbTarBadLinkName.Create; { Link Name to Long } - OLDGNU_FORMAT: DoGNUNewLongNameLink(AB_TAR_LF_LONGLINK, 0, RawLinkName); {GNU_FORMAT} - else - begin - { UNKNOWN_FORMAT, STAR_FORMAT, POSIX_FORMAT } - raise EAbTarBadOp.Create; { Unknown Archive Format } - end;{ End of Else for case statement } - end;{ End of case statement } - FTarItem.LinkName := Value; - end; { if no Meta data header found } - end { End "name length larger than 100" } - else - begin { Short new name, Simple Case Just put it in the Link Field & remove any headers } - { PTarHeader Points to the File type Header } - { Zero the Link field } - FillChar(PTarHeader.LinkName, SizeOf(PTarHeader.LinkName), #0); - if FTarItem.ArchiveFormat in [GNU_FORMAT, OLDGNU_FORMAT] then - begin { We may have AB_TAR_LF_LONGNAME Headers to be removed } - { Remove long file names Headers if they exist} - FoundMetaDataHeader := False; - I := 0; - while not FoundMetaDataHeader and (I <= (FTarHeaderList.Count - 1)) do - begin - PHeader := FTarHeaderList.Items[I]; - if PHeader.LinkFlag in [AB_TAR_LF_LONGLINK] then - begin { Delete this Header, and the data Headers. } - FoundMetaDataHeader := True; - TotalOldNumHeaders := Ceil( OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE); - for J := TotalOldNumHeaders downto 0 do - begin { Note 0 will delete the Long Link MD Header } - FreeMem(FTarHeaderList.Items[I+J]); { This list holds PAbTarHeaderRec's } - FTarHeaderList.Delete(I+J); - FTarHeaderTypeList.Delete(I+J); - end; - end - else - I := I + 1; { Got to next header } - end;{ End While not found... } - end; { End if GNU... } - { Save off the new name and store to the Header } - FTarItem.LinkName := Value; - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(PTarHeader.LinkName, RawLinkName, AB_TAR_NAMESIZE); - end;{ End else Short new name,... } - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetMagic(const Value: String); -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - FTarItem.Magic := AnsiString(Value); - Move(Value[1], PTarHeader.Magic, SizeOf(TAbTarMagicRec)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetUncompressedSize(const Value: Int64); -var - S : AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { Size is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers } - FTarItem.Size := Value; { Store our Vitrual Copy } - S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header } - Move(S[1], PTarHeader.Size, Length(S)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetUserID(const Value: Integer); -var - S : AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { uid is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers } - FTarItem.uid := Value; - S := PadString(IntToOctal(Value), SizeOf(Arr8)); - Move(S[1], PTarHeader.uid, Length(S)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetUserName(const Value: string); -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { UsrName is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers } - FTarItem.UsrName := Value; - {$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrPLCopy(PTarHeader.UsrName, AnsiString(Value), SizeOf(PTarHeader.UsrName)); - FTarItem.Dirty := True; -end; - -procedure TAbTarItem.SetModTime(const Value: Int64); -var - S: AnsiString; -begin - if FTarItem.ItemReadOnly then { Read Only - Do Not Save } - Exit; - { ModTime is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers } - FTarItem.ModTime := Value; { Store our Virtual Copy } - S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header } - Move(S[1], PTarHeader.ModTime, Length(S)); - FTarItem.Dirty := True; -end; - - -{ ************************** TAbTarStreamHelper ****************************** } -destructor TAbTarStreamHelper.Destroy; -begin - inherited Destroy; -end; - -{ This is slow, use the archive class instead } -procedure TAbTarStreamHelper.ExtractItemData(AStream: TStream); -begin - { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE } - if FCurrItemSize <> 0 then - begin - { copy stored data to output } - AStream.CopyFrom(FStream, FCurrItemSize); - {reset the stream to the start of the item} - FStream.Seek(-(FCurrItemPreHdrs*AB_TAR_RECORDSIZE+FCurrItemSize), soCurrent); - end; - { else do nothing } -end; - -{ This function Should only be used from LoadArchive, as it is slow. } -function TAbTarStreamHelper.FindItem: Boolean; -var - DataRead : LongInt; - FoundItem: Boolean; - SkipHdrs : Integer; -begin - { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE } - { Note: Standard LBA size of hard disks is 512 bytes = AB_TAR_RECORDSIZE } - FoundItem := False; - { Getting an new Item reset these numbers } - FCurrItemSize := 0; - FCurrItemPreHdrs := 0; - DataRead := FStream.Read(FTarHeader, AB_TAR_RECORDSIZE); { Read in a header } - { DataRead <> AB_TAR_RECORDSIZE means end of stream, and the End Of Archive - record is all #0's, which the StrLen(FTarHeader.Name) check will catch } - while (DataRead = AB_TAR_RECORDSIZE) and ({$IFDEF HasAnsiStrings}AnsiStrings.{$ENDIF}StrLen(FTarHeader.Name) > 0) and not FoundItem do - begin { Either exit when we find a supported file or end of file or an invalid header name. } - if FTarHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then - begin { We have a un/supported Meta-Data Header } - { FoundItem := False } { Value remains False. } - SkipHdrs := Ceil(OctalToInt(FTarHeader.Size, SizeOf(FTarHeader.Size))/AB_TAR_RECORDSIZE); - FStream.Seek(SkipHdrs*AB_TAR_RECORDSIZE, soCurrent); - { Tally new Headers: Consumed + Current } - FCurrItemPreHdrs := FCurrItemPreHdrs + SkipHdrs + 1; - { Read our next header, Loop, and re-parse } - DataRead := FStream.Read(FTarHeader, AB_TAR_RECORDSIZE); - end - else if FTarHeader.LinkFlag in (AB_SUPPORTED_F_HEADERS+AB_UNSUPPORTED_F_HEADERS) then - begin { We have a un/supported File Header. } - FoundItem := True; - if not (FTarHeader.LinkFlag in AB_IGNORE_SIZE_HEADERS) then - FCurrItemSize := OctalToInt(FTarHeader.Size, SizeOf(FTarHeader.Size)) - else FCurrItemSize := 0; { Per The spec these Headers do not have file content } - FCurrItemPreHdrs := FCurrItemPreHdrs + 1; { Tally current header } - end - else - begin{ We Have an Unknown header } - FoundItem := True; - FCurrItemSize := 0; - { We could have many un/supported headers before this unknown type } - FCurrItemPreHdrs := FCurrItemPreHdrs + 1; { Tally current header } - { These Headers should throw exceptions when TAbTarItem.LoadTarHeaderFromStream is called } - end; { End of Link Flag parsing } - end; - { Rewind to the "The Beginning" of this Item } - { Really that means to the first supported Header Type before a supported Item Type } - if FoundItem then - FStream.Seek(-(FCurrItemPreHdrs*AB_TAR_RECORDSIZE), soCurrent); - Result := FoundItem; -end; - -{ Should only be used from LoadArchive, as it is slow. } -function TAbTarStreamHelper.FindFirstItem: Boolean; -begin - FStream.Seek(0, soBeginning); - Result := FindItem; -end; - -{ Should only be used from LoadArchive, as it is slow. } -function TAbTarStreamHelper.FindNextItem: Boolean; -begin - { Fast Forward Past the current Item } - FStream.Seek((FCurrItemPreHdrs*AB_TAR_RECORDSIZE + RoundToTarBlock(FCurrItemSize)), soCurrent); - Result := FindItem; -end; - -{ This is slow, use the archive class instead } -function TAbTarStreamHelper.GetItemCount : Integer; -var - Found : Boolean; -begin - Result := 0; - Found := FindFirstItem; - while Found do begin - Inc(Result); - Found := FindNextItem; - end; -end; - -procedure TAbTarStreamHelper.ReadHeader; -begin - { do nothing } - { Tar archives have no overall header data } -end; - -procedure TAbTarStreamHelper.ReadTail; -begin - { do nothing } - { Tar archives have no overall tail data } -end; - -{ This is slow, use the archive class instead } -function TAbTarStreamHelper.SeekItem(Index: Integer): Boolean; -var - i : Integer; -begin - Result := FindFirstItem; { see if can get to first item } - i := 1; - while Result and (i < Index) do begin - Result := FindNextItem; - Inc(i); - end; -end; - -procedure TAbTarStreamHelper.WriteArchiveHeader; -begin - { do nothing } - { Tar archives have no overall header data } -end; - -procedure TAbTarStreamHelper.WriteArchiveItem(AStream: TStream); -begin - WriteArchiveItemSize(AStream, AStream.Size); -end; - -procedure TAbTarStreamHelper.WriteArchiveItemSize(AStream: TStream; Size: Int64); -var - PadBuff : PAnsiChar; - PadSize : Integer; -begin - if Size = 0 then - Exit; - { transfer actual item data } - FStream.CopyFrom(AStream, Size); - - { Pad to Next block } - PadSize := RoundToTarBlock(Size) - Size; - GetMem(PadBuff, PadSize); - FillChar(PadBuff^, PadSize, #0); - FStream.Write(PadBuff^, PadSize); - FreeMem(PadBuff, PadSize); -end; - - -procedure TAbTarStreamHelper.WriteArchiveTail; -var - PadBuff : PAnsiChar; - PadSize : Integer; -begin - { append 2 terminating null blocks } - PadSize := AB_TAR_RECORDSIZE; - GetMem(PadBuff, PadSize); - try - FillChar(PadBuff^, PadSize, #0); - FStream.Write(PadBuff^, PadSize); - FStream.Write(PadBuff^, PadSize); - finally - FreeMem(PadBuff, PadSize); - end; -end; - - - -{ ***************************** TAbTarArchive ******************************** } -constructor TAbTarArchive.CreateFromStream(aStream : TStream; const aArchiveName : string); -begin - inherited; - FArchFormat := V7_FORMAT; // Default for new archives -end; - -function TAbTarArchive.CreateItem(const FileSpec: string): TAbArchiveItem; -var - Item : TAbTarItem; - S : String; - I: Integer; -begin - if FArchReadOnly then - raise EAbTarBadOp.Create; { Create Item Unsupported in this Archive } - - S := FixName(FileSpec); - Item := TAbTarItem.Create; - try - // HeaderFormat = (UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT); - if FArchFormat in [OLDGNU_FORMAT, GNU_FORMAT] then - begin - Item.ArchiveFormat := FArchFormat; - Item.LinkFlag := AB_TAR_LF_NORMAL; - Item.Magic := AB_TAR_MAGIC_GNUOLD; - end - else if FArchFormat in [USTAR_FORMAT] then - begin - Item.ArchiveFormat := USTAR_FORMAT; - Item.LinkFlag := AB_TAR_LF_NORMAL; - Item.Magic := AB_TAR_MAGIC_VAL+AB_TAR_MAGIC_VER; - end - else if (FArchFormat = V7_FORMAT) and (Length(S) > 100) then - begin { Switch the rep over to GNU so it can have long file names. } - FArchFormat := OLDGNU_FORMAT; - Item.ArchiveFormat := OLDGNU_FORMAT; - { Leave the Defaults for LinkFlag, and Magic } - { Update all the rest so that it can transistion to GNU_FORMAT } - for I := 0 to FItemList.Count - 1 do - TAbTarItem(FItemList.Items[i]).ArchiveFormat := OLDGNU_FORMAT; - end;{ This should not execute... }{ - else if FArchFormat in [STAR_FORMAT, POSIX_FORMAT] then - begin - Item.ArchiveFormat := FArchFormat; - Item.LinkFlag := AB_TAR_LF_NORMAL; - Item.Magic := AB_TAR_MAGIC_VAL+AB_TAR_MAGIC_VER; - end; - }{ else FArchFormat in [ UNKNOWN_FORMAT, V7_FORMAT and Length(S) <= 100 ] } { This is the default. } - - { Most others are initialized in the .Create } - Item.CRC32 := 0; - { Note this can raise exceptions for file name lengths. } - Item.FileName := FixName(FileSpec); - Item.DiskFileName := ExpandFileName(FileSpec); - Item.Action := aaNone; - finally - Result := Item; - end; -end; - - -procedure TAbTarArchive.ExtractItemAt(Index: Integer; const UseName: string); -var - OutStream : TFileStream; - CurItem : TAbTarItem; -begin - { Check the index is not out of range. } - if(Index >= ItemList.Count) then - raise EListError.CreateFmt(SListIndexError, [Index]); - - CurItem := TAbTarItem(ItemList[Index]); - - if CurItem.ItemType in [UNKNOWN_ITEM] then - raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract } - if (CurItem.ItemType = UNSUPPORTED_ITEM) and - ((Length(CurItem.FileName) >= AB_TAR_NAMESIZE) or - (Length(CurItem.LinkName) >= AB_TAR_NAMESIZE)) then - raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract } - { We will allow extractions if the file name/Link name are strickly less than 100 chars } - - if CurItem.IsDirectory then - AbCreateDirectory(UseName) - else begin - OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyNone); - try - try {OutStream} - ExtractItemToStreamAt(Index, OutStream); - finally {OutStream} - OutStream.Free; - end; {OutStream} - except - if ExceptObject is EAbUserAbort then - FStatus := asInvalid; - DeleteFile(UseName); - raise; - end; - end; - AbSetFileTime(UseName, CurItem.LastModTimeAsDateTime); - AbSetFileAttr(UseName, CurItem.NativeFileAttributes); -end; - -procedure TAbTarArchive.ExtractItemToStreamAt(Index: Integer; - aStream: TStream); -var - CurItem : TAbTarItem; -begin - if(Index >= ItemList.Count) then - raise EListError.CreateFmt(SListIndexError, [Index]); - - CurItem := TAbTarItem(ItemList[Index]); - - if CurItem.ItemType in [UNKNOWN_ITEM] then - raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract } - if (CurItem.ItemType = UNSUPPORTED_ITEM) and - ((Length(CurItem.FileName) >= AB_TAR_NAMESIZE) or - (Length(CurItem.LinkName) >= AB_TAR_NAMESIZE)) then - raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract } - { We will allow extractions if the file name is strictly less than 100 chars } - - FStream.Position := CurItem.StreamPosition+CurItem.FileHeaderCount*AB_TAR_RECORDSIZE; - if CurItem.UncompressedSize <> 0 then - aStream.CopyFrom(FStream, CurItem.UncompressedSize); - { Else there is nothing to copy. } -end; - -procedure TAbTarArchive.LoadArchive; -var - TarHelp : TAbTarStreamHelper; - Item : TAbTarItem; - ItemFound : Boolean; - Abort : Boolean; - Confirm : Boolean; - i : Integer; - Progress : Byte; - -begin - { create helper } - TarHelp := TAbTarStreamHelper.Create(FStream); - try {TarHelp} - {build Items list from tar header records} - - { reset Tar } - ItemFound := (FStream.Size > 0) and TarHelp.FindFirstItem; - if ItemFound then FArchFormat := UNKNOWN_FORMAT - else FArchFormat := V7_FORMAT; - - { while more data in Tar } - while (FStream.Position < FStream.Size) and ItemFound do begin - {create new Item} - Item := TAbTarItem.Create; - Item.FTarItem.StreamPosition := FStream.Position; - try {Item} - Item.LoadTarHeaderFromStream(FStream); - if Item.ItemReadOnly then - FArchReadOnly := True; { Set Archive as Read Only } - if Item.ItemType in [SUPPORTED_ITEM, UNSUPPORTED_ITEM] then begin - { List of supported Item/File Types. } - { Add the New Supported Item to the List } - if FArchFormat < Item.ArchiveFormat then - FArchFormat := Item.ArchiveFormat; { Take the max format } - Item.Action := aaNone; - FItemList.Add(Item); - end { end if } - else begin - { unhandled Tar file system entity, notify user, but otherwise ignore } - if Assigned(FOnConfirmProcessItem) then - FOnConfirmProcessItem(self, Item, ptFoundUnhandled, Confirm); - end; - - { show progress and allow for aborting } - Progress := (FStream.Position*100) div FStream.Size; - DoArchiveProgress(Progress, Abort); - if Abort then begin - FStatus := asInvalid; - raise EAbUserAbort.Create; - end; - - { get the next item } - ItemFound := TarHelp.FindNextItem; - except {Item} - raise EAbTarBadOp.Create; { Invalid Item } - end; {Item} - end; {end while } - - { All the items need to reflect this information. } - for i := 0 to FItemList.Count - 1 do - begin - TAbTarItem(FItemList.Items[i]).ArchiveFormat := FArchFormat; - TAbTarItem(FItemList.Items[i]).ItemReadOnly := FArchReadOnly; - end; - - DoArchiveProgress(100, Abort); - FIsDirty := False; - - finally {TarHelp} - { Clean Up } - TarHelp.Free; - end; {TarHelp} -end; - - -function TAbTarArchive.FixName(const Value: string): string; -{ fixup filename for storage } -var - lValue : string; -begin - lValue := Value; - {$IFDEF MSWINDOWS} - if DOSMode then begin - {Add the base directory to the filename before converting } - {the file spec to the short filespec format. } - if BaseDirectory <> '' then begin - {Does the filename contain a drive or a leading backslash? } - if not ((Pos(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then - {If not, add the BaseDirectory to the filename.} - lValue := BaseDirectory + AbPathDelim + lValue; - end; - lValue := AbGetShortFileSpec( lValue ); - end; - {$ENDIF MSWINDOWS} - - { Should always trip drive info if on a Win/Dos system } - StoreOptions := StoreOptions + [soStripDrive]; - - { strip drive stuff } - if soStripDrive in StoreOptions then - AbStripDrive( lValue ); - - { check for a leading slash } - if lValue[1] = AbPathDelim then - System.Delete( lValue, 1, 1 ); - - if soStripPath in StoreOptions then - lValue := ExtractFileName(lValue); - - if soRemoveDots in StoreOptions then - AbStripDots(lValue); - - AbFixName(lValue); - - Result := lValue; -end; - -function TAbTarArchive.GetItem(Index: Integer): TAbTarItem; -begin - Result := TAbTarItem(FItemList.Items[Index]); -end; - -function TAbTarArchive.GetSupportsEmptyFolders: Boolean; -begin - Result := True; -end; - -procedure TAbTarArchive.PutItem(Index: Integer; const Value: TAbTarItem); -begin - //TODO: Remove this from all archives - FItemList.Items[Index] := Value; -end; - -procedure TAbTarArchive.SaveArchive; -var - OutTarHelp : TAbTarStreamHelper; - Abort : Boolean; - i : Integer; - NewStream : TAbVirtualMemoryStream; - TempStream : TStream; - SaveDir : string; - CurItem : TAbTarItem; - AttrEx : TAbAttrExRec; -begin - if FArchReadOnly then - raise EAbTarBadOp.Create; { Archive is read only } - - {init new archive stream} - NewStream := TAbVirtualMemoryStream.Create; - OutTarHelp := TAbTarStreamHelper.Create(NewStream); - - try {NewStream/OutTarHelp} - { create helper } - NewStream.SwapFileDirectory := FTempDir; - - {build new archive from existing archive} - for i := 0 to pred(Count) do begin - FCurrentItem := ItemList[i]; - CurItem := TAbTarItem(ItemList[i]); - - case CurItem.Action of - aaNone, aaMove : begin {just copy the file to new stream} - { "Seek" to the Item Data } { SaveTarHeaders, Updates FileHeaderCount } - FStream.Position := CurItem.StreamPosition+CurItem.FileHeaderCount*AB_TAR_RECORDSIZE; - CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. } - { Flush The Headers to the new stream } - CurItem.SaveTarHeaderToStream(NewStream); - { Copy to new Stream, Round to the AB_TAR_RECORDSIZE boundry, and Pad zeros} - outTarhelp.WriteArchiveItemSize(FStream, CurItem.UncompressedSize); - end; - - aaDelete: {doing nothing omits file from new stream} ; - - aaStreamAdd : begin - try - { adding from a stream } - CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. } - CurItem.UncompressedSize := InStream.Size; - CurItem.SaveTarHeaderToStream(NewStream); - OutTarHelp.WriteArchiveItemSize(InStream, InStream.Size); - except - ItemList[i].Action := aaDelete; - DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0); - end; - end; - - aaAdd, aaFreshen, aaReplace: begin - try - { it's coming from a file } - GetDir(0, SaveDir); - try {SaveDir} - if (BaseDirectory <> '') then - ChDir(BaseDirectory); - { update metadata } - if not AbFileGetAttrEx(CurItem.DiskFileName, AttrEx) then - raise EAbFileNotFound.Create; - CurItem.ExternalFileAttributes := AttrEx.Mode; - CurItem.LastModTimeAsDateTime := AttrEx.Time; - { TODO: uid, gid, uname, gname should be added here } - { TODO: Add support for different types of files here } - if (AttrEx.Mode and AB_FMODE_DIR) <> 0 then begin - CurItem.LinkFlag := AB_TAR_LF_DIR; - CurItem.UncompressedSize := 0; - CurItem.SaveTarHeaderToStream(NewStream); - end - else begin - TempStream := TFileStream.Create(CurItem.DiskFileName, - fmOpenRead or fmShareDenyWrite ); - try { TempStream } - CurItem.UncompressedSize := TempStream.Size; - CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. } - CurItem.SaveTarHeaderToStream(NewStream); - OutTarHelp.WriteArchiveItemSize(TempStream, TempStream.Size); - finally { TempStream } - TempStream.Free; - end; { TempStream } - end; - finally {SaveDir} - ChDir( SaveDir ); - end; {SaveDir} - except - ItemList[i].Action := aaDelete; - DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0); - end; - end; { aaAdd ... } - end; { case } - end; { for i ... } - - if NewStream.Size <> 0 then - OutTarHelp.WriteArchiveTail; { Terminate the TAR } - { Size of NewStream is still 0, and max of the stream will also be 0 } - - {copy new stream to FStream} - NewStream.Position := 0; - if (FStream is TMemoryStream) then - TMemoryStream(FStream).LoadFromStream(NewStream) - else if (FStream is TAbVirtualMemoryStream) or not FOwnsStream then begin - FStream.Size := 0; - FStream.Position := 0; - FStream.CopyFrom(NewStream, NewStream.Size); - end - else begin - { write to a new stream } - FreeAndNil(FStream); - FStream := TFileStream.Create(FArchiveName, fmCreate or fmShareDenyWrite); - FStream.CopyFrom(NewStream, NewStream.Size); - end; - - {update Items list} - for i := pred( Count ) downto 0 do begin - if ItemList[i].Action = aaDelete then - FItemList.Delete( i ) - else if ItemList[i].Action <> aaFailed then - ItemList[i].Action := aaNone; - end; - - DoArchiveSaveProgress( 100, Abort ); - DoArchiveProgress( 100, Abort ); - finally {NewStream/OutTarHelp} - OutTarHelp.Free; - NewStream.Free; - end; -end; - -{ This assumes that LoadArchive has been called. } -procedure TAbTarArchive.TestItemAt(Index: Integer); -begin - FStream.Position := TAbTarItem(FItemList[Index]).StreamPosition; - if VerifyTar(FStream) <> atTar then - raise EAbTarInvalid.Create; { Invalid Tar } -end; - -end. diff --git a/components/Abbrevia/source/AbUnzOutStm.pas b/components/Abbrevia/source/AbUnzOutStm.pas deleted file mode 100644 index 7c74a00..0000000 --- a/components/Abbrevia/source/AbUnzOutStm.pas +++ /dev/null @@ -1,197 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is Craig Peterson - * - * Portions created by the Initial Developer are Copyright (C) 2011 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbUnzOutStm.pas *} -{*********************************************************} -{* ABBREVIA: UnZip output stream; progress and CRC32 *} -{*********************************************************} - -unit AbUnzOutStm; - -{$I AbDefine.inc} - -interface - -uses - SysUtils, Classes, AbArcTyp; - -type - // Fixed-length read-only stream, limits reads to the range between - // the input stream's starting position and a specified size. Seek/Position - // are adjusted to be 0 based. - TAbUnzipSubsetStream = class( TStream ) - private - FStream : TStream; - FStartPos: Int64; - FCurPos: Int64; - FEndPos: Int64; - - public - constructor Create(aStream: TStream; aStreamSize: Int64); - - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - end; - - - // Write-only output stream, computes CRC32 and calls progress event - TAbUnzipOutputStream = class( TStream ) - private - FBytesWritten : Int64; - FCRC32 : LongInt; - FCurrentProgress : Byte; - FStream : TStream; - FUncompressedSize : Int64; - FOnProgress : TAbProgressEvent; - - function GetCRC32 : LongInt; - - public - constructor Create(aStream : TStream); - - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - - property CRC32 : LongInt - read GetCRC32; - property Stream : TStream - read FStream - write FStream; - property UncompressedSize : Int64 - read FUncompressedSize - write FUncompressedSize; - property OnProgress : TAbProgressEvent - read FOnProgress - write FOnProgress; - end; - - -implementation - -uses - Math, AbExcept, AbUtils; - -{ TAbUnzipSubsetStream implementation ====================================== } - -{ -------------------------------------------------------------------------- } -constructor TAbUnzipSubsetStream.Create(aStream: TStream; aStreamSize: Int64); -begin - inherited Create; - FStream := aStream; - FStartPos := FStream.Position; - FCurPos := FStartPos; - FEndPos := FStartPos + aStreamSize; -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipSubsetStream.Read(var Buffer; Count: Longint): Longint; -begin - if Count > FEndPos - FCurPos then - Count := FEndPos - FCurPos; - if Count > 0 then begin - Result := FStream.Read(Buffer, Count); - Inc(FCurPos, Result); - end - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipSubsetStream.Write(const Buffer; Count: Longint): Longint; -begin - raise EAbException.Create('TAbUnzipSubsetStream.Write not supported'); -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipSubsetStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -var - OldPos: Int64; -begin - OldPos := FCurPos; - case Origin of - soBeginning: FCurPos := FStartPos + Offset; - soCurrent: FCurPos := FCurPos + Offset; - soEnd: FCurPos := FEndPos + Offset; - end; - if FCurPos < FStartPos then - FCurPos := FStartPos; - if FCurPos > FEndPos then - FCurPos := FEndPos; - if OldPos <> FCurPos then - FStream.Position := FCurPos; - Result := FCurPos - FStartPos; -end; -{ -------------------------------------------------------------------------- } - - -{ TAbUnzipOutputStream implementation ====================================== } - -{ -------------------------------------------------------------------------- } -constructor TAbUnzipOutputStream.Create(aStream: TStream); -begin - inherited Create; - FStream := aStream; - FCRC32 := -1; -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipOutputStream.Read(var Buffer; Count: Integer): Longint; -begin - raise EAbException.Create('TAbUnzipOutputStream.Read not supported'); -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipOutputStream.Write(const Buffer; Count: Longint): Longint; -var - Abort : Boolean; - NewProgress : Byte; -begin - Result := FStream.Write(Buffer, Count); - - AbUpdateCRC( FCRC32, Buffer, Count ); - - Inc( FBytesWritten, Result ); - if Assigned( FOnProgress ) then begin - Abort := False; - NewProgress := AbPercentage(FBytesWritten, FUncompressedSize); - if (NewProgress <> FCurrentProgress) then begin - FOnProgress( NewProgress, Abort ); - FCurrentProgress := NewProgress; - end; - if Abort then - raise EAbUserAbort.Create; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipOutputStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - Result := FStream.Seek(Offset, Origin); -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipOutputStream.GetCRC32: LongInt; -begin - Result := not FCRC32; -end; - -end. - diff --git a/components/Abbrevia/source/AbUnzPrc.pas b/components/Abbrevia/source/AbUnzPrc.pas deleted file mode 100644 index f3db5e3..0000000 --- a/components/Abbrevia/source/AbUnzPrc.pas +++ /dev/null @@ -1,1211 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbUnzPrc.pas *} -{*********************************************************} -{* ABBREVIA: UnZip procedures *} -{*********************************************************} - -unit AbUnzPrc; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbArcTyp, - AbZipTyp; - -type - TAbUnzipHelper = class( TObject ) - protected {private} - {internal variables} - FOutWriter : TStream; - FOutStream : TStream; - FUnCompressedSize : LongInt; - FCompressionMethod : TAbZipCompressionMethod; - FDictionarySize : TAbZipDictionarySize; - FShannonFanoTreeCount : Byte; - - FOutBuf : PAbByteArray; {output buffer} - FOutSent : LongInt; {number of bytes sent to output buffer} - FOutPos : Cardinal; {current position in output buffer} - FBitSValid : Byte; {Number of valid bits} - - FInBuf : TAbByteArray4K; - FInPos : Integer; {current position in input buffer} - FInCnt : Integer; {number of bytes in input buffer} - FInEof : Boolean; {set when stream read returns 0} - FCurByte : Byte; {current input byte} - FBitsLeft : Byte; {bits left to process in FCurByte} - - FZStream : TStream; - protected - procedure uzFlushOutBuf; - {-Flushes the output buffer} - - function uzReadBits(Bits : Byte) : Integer; - {-Read the specified number of bits} - procedure uzReadNextPrim; - {-does less likely part of uzReadNext} - - {$IFDEF UnzipImplodeSupport} - procedure uzUnImplode; - {-Extract an imploded file} - {$ENDIF} - - {$IFDEF UnzipReduceSupport} - procedure uzUnReduce; - {-Extract a reduced file} - {$ENDIF} - - {$IFDEF UnzipShrinkSupport} - procedure uzUnShrink; - {-Extract a shrunk file} - {$ENDIF} - procedure uzWriteByte(B : Byte); - {write to output} - public - constructor Create( InputStream, OutputStream : TStream ); - destructor Destroy; - override; - - procedure Execute; - - property UnCompressedSize : LongInt - read FUncompressedSize - write FUncompressedSize; - property CompressionMethod : TAbZipCompressionMethod - read FCompressionMethod - write FCompressionMethod; - property DictionarySize : TAbZipDictionarySize - read FDictionarySize - write FDictionarySize; - property ShannonFanoTreeCount : Byte - read FShannonFanoTreeCount - write FShannonFanoTreeCount; - end; - - - - procedure AbUnzipToStream( Sender : TObject; Item : TAbZipItem; - OutStream : TStream); - - procedure AbUnzip(Sender : TObject; Item : TAbZipItem; const UseName : string); - - procedure AbTestZipItem(Sender : TObject; Item : TAbZipItem); - - procedure InflateStream(CompressedStream, UnCompressedStream : TStream); - {-Inflates everything in CompressedStream to UncompressedStream - no encryption is tried, no check on CRC is done, uses the whole - compressedstream - no Progress events - no Frills!} - -implementation - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} - SysUtils, - {$IFDEF UnzipBzip2Support} - AbBzip2, - {$ENDIF} - {$IFDEF UnzipLzmaSupport} - AbLzma, - {$ENDIF} - {$IFDEF UnzipPPMdSupport} - AbPPMd, - {$ENDIF} - {$IFDEF UnzipWavPackSupport} - AbWavPack, - {$ENDIF} - AbBitBkt, - AbConst, - AbDfBase, - AbDfCryS, - AbDfDec, - AbExcept, - AbSpanSt, - AbSWStm, - AbUnzOutStm, - AbUtils; - -{ -------------------------------------------------------------------------- } -procedure AbReverseBits(var W : Word); - {-Reverse the order of the bits in W} -register; -const - RevTable : array[0..255] of Byte = ($00, $80, $40, $C0, $20, $A0, $60, - $E0, $10, $90, $50, $D0, $30, $B0, $70, $F0, $08, $88, $48, $C8, $28, - $A8, $68, $E8, $18, $98, $58, $D8, $38, $B8, $78, $F8, $04, $84, $44, - $C4, $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4, $0C, - $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC, $3C, $BC, $7C, - $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2, $12, $92, $52, $D2, $32, - $B2, $72, $F2, $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA, $1A, $9A, $5A, - $DA, $3A, $BA, $7A, $FA, $06, $86, $46, $C6, $26, $A6, $66, $E6, $16, - $96, $56, $D6, $36, $B6, $76, $F6, $0E, $8E, $4E, $CE, $2E, $AE, $6E, - $EE, $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81, $41, $C1, $21, - $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1, $09, $89, $49, - $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9, $39, $B9, $79, $F9, $05, - $85, $45, $C5, $25, $A5, $65, $E5, $15, $95, $55, $D5, $35, $B5, $75, - $F5, $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D, - $BD, $7D, $FD, $03, $83, $43, $C3, $23, $A3, $63, $E3, $13, $93, $53, - $D3, $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB, $1B, - $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7, $27, $A7, $67, - $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7, $0F, $8F, $4F, $CF, $2F, - $AF, $6F, $EF, $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF); -begin - W := RevTable[Byte(W shr 8)] or Word(RevTable[Byte(W)] shl 8); -end; - - -{ TAbUnzipHelper implementation ============================================ } - -{ -------------------------------------------------------------------------- } -constructor TAbUnzipHelper.Create( InputStream, OutputStream : TStream ); -begin - inherited Create; - FOutBuf := AllocMem( AbBufferSize ); - FOutPos := 0; - FZStream := InputStream; - FOutStream := OutputStream; - FUncompressedSize := 0; - FDictionarySize := dsInvalid; - FShannonFanoTreeCount := 0; - FCompressionMethod := cmDeflated; -end; -{ -------------------------------------------------------------------------- } -destructor TAbUnzipHelper.Destroy; -begin - FreeMem( FOutBuf, AbBufferSize ); - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbUnzipHelper.Execute; -begin - {parent class handles exceptions via OnExtractFailure} - FBitsLeft := 0; - FCurByte := 0; - FInCnt := 0; - FOutSent := 0; - FOutPos := 0; - FInEof := False; - - {set the output stream; for Imploded/Reduced files this has to be - buffered, for all other types of compression, the code buffers the - output data nicely and so the given output stream can be used.} - {$IFDEF UnzipImplodeSupport} - if (FCompressionMethod = cmImploded) then - FOutWriter := TabSlidingWindowStream.Create(FOutStream) - else - {$ENDIF} - {$IFDEF UnzipReduceSupport} - if (FCompressionMethod >= cmReduced1) and - (FCompressionMethod <= cmReduced4) then - FOutWriter := TabSlidingWindowStream.Create(FOutStream) - else - {$ENDIF} - FOutWriter := FOutStream; - FInPos := 1+SizeOf(FInBuf); - -{ GetMem( FInBuf, SizeOf(FInBuf^) );} - try - {uncompress it with the appropriate method} - case FCompressionMethod of - {$IFDEF UnzipShrinkSupport} - cmShrunk : uzUnshrink; - {$ENDIF} - {$IFDEF UnzipReduceSupport} - cmReduced1..cmReduced4 : uzUnReduce; - {$ENDIF} - {$IFDEF UnzipImplodeSupport} - cmImploded : uzUnImplode; - {$ENDIF} - {cmTokenized} - {cmEnhancedDeflated} - {cmDCLImploded} - else - raise EAbZipInvalidMethod.Create; - end; - - finally - uzFlushOutBuf; - {free any memory} - if (FOutWriter <> FOutStream) then - FOutWriter.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbUnzipHelper.uzReadNextPrim; -begin - FInCnt := FZStream.Read( FInBuf, sizeof( FInBuf ) ); - FInEof := FInCnt = 0; - {load first byte in buffer and set position counter} - FCurByte := FInBuf[1]; - FInPos := 2; -end; -{ -------------------------------------------------------------------------- } -procedure TAbUnzipHelper.uzFlushOutBuf; - {-flushes the output buffer} -begin - if (FOutPos <> 0) then begin - FOutWriter.Write( FOutBuf^, FOutPos ); - Inc( FOutSent, FOutPos ); - FOutPos := 0; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbUnzipHelper.uzWriteByte(B : Byte); - {-Write one byte to the output buffer} -begin - FOutBuf^[FOutPos] := B; - inc(FOutPos); - if (FOutPos = AbBufferSize) or - (LongInt(FOutPos) + FOutSent = FUncompressedSize) then - uzFlushOutBuf; -end; -{ -------------------------------------------------------------------------- } -function TAbUnzipHelper.uzReadBits(Bits : Byte) : Integer; - {-Read the specified number of bits} -var - SaveCurByte, Delta, SaveBitsLeft : Byte; -begin - {read next byte if we're out of bits} - if FBitsLeft = 0 then begin - {do we still have a byte buffered?} - if FInPos <= FInCnt then begin - {get next byte out of buffer and advance position counter} - FCurByte := FInBuf[FInPos]; - Inc(FInPos); - end - {are there any left to read?} - else - uzReadNextPrim; - - FBitsLeft := 8; - end; - if ( Bits < FBitsLeft ) then begin - Dec( FBitsLeft, Bits ); - Result := ((1 shl Bits) - 1) and FCurByte; - FCurByte := FCurByte shr Bits; - end - else if ( Bits = FBitsLeft ) then begin - Result := FCurByte; - FCurByte := 0; - FBitsLeft := 0; - end - else begin - SaveCurByte := FCurByte; - SaveBitsLeft := FBitsLeft; - {number of additional bits that we need} - Delta := Bits - FBitsLeft; - {do we still have a byte buffered?} - if FInPos <= FInCnt then begin - {get next byte out of buffer and advance position counter} - FCurByte := FInBuf[FInPos]; - Inc(FInPos); - end - {are there any left to read?} - else - uzReadNextPrim; - - FBitsLeft := 8; - Result := ( uzReadBits( Delta ) shl SaveBitsLeft ) or SaveCurByte; - end; -end; -{$IFDEF UnzipImplodeSupport} -{ -------------------------------------------------------------------------- } -procedure TAbUnzipHelper.uzUnImplode; - {-Extract an imploded file} -const - szLengthTree = SizeOf(TAbSfTree)-(192*SizeOf(TAbSfEntry)); - szDistanceTree = SizeOf(TAbSfTree)-(192*SizeOf(TAbSfEntry)); - szLitTree = SizeOf(TAbSfTree); -var - Length : Integer; - DIndex : LongInt; - Distance : Integer; - SPos : LongInt; - MyByte : Byte; - DictBits : Integer; {number of bits used in sliding dictionary} - MinMatchLength : Integer; {minimum match length} - LitTree : PAbSfTree; {Literal tree} - LengthTree : PAbSfTree; {Length tree} - DistanceTree : PAbSfTree; {Distance tree} - - procedure uzLoadTree(var T; TreeSize : Integer); - {-Load one Shannon-Fano tree} - var - I : Word; - Tree : TAbSfTree absolute T; - - procedure GenerateTree; - {-Generate a Shannon-Fano tree} - var - C : Word; - CodeIncrement : Integer; - LastBitLength : Integer; - I : Integer; - begin - C := 0; - CodeIncrement := 0; - LastBitLength := 0; - - for I := Tree.Entries-1 downto 0 do - with Tree.Entry[I] do begin - Inc(C, CodeIncrement); - if BitLength <> LastBitLength then begin - LastBitLength := BitLength; - CodeIncrement := 1 shl (16-LastBitLength); - end; - Code := C; - end; - end; - - procedure SortLengths; - {-Sort the bit lengths in ascending order, while retaining the order - of the original lengths stored in the file} - var - XL : Integer; - XGL : Integer; - TXP : PAbSfEntry; - TXGP : PAbSfEntry; - X, Gap : Integer; - Done : Boolean; - LT : LongInt; - begin - Gap := Tree.Entries shr 1; - repeat - repeat - Done := True; - for X := 0 to (Tree.Entries-1)-Gap do begin - TXP := @Tree.Entry[X]; - TXGP := @Tree.Entry[X+Gap]; - XL := TXP^.BitLength; - XGL := TXGP^.BitLength; - if (XL > XGL) or - ((XL = XGL) and (TXP^.Value > TXGP^.Value)) then begin - LT := TXP^.L; - TXP^.L := TXGP^.L; - TXGP^.L := LT; - Done := False; - end; - end; - until Done; - - Gap := Gap shr 1; - until (Gap = 0); - end; - - procedure uzReadLengths; - {-Read bit lengths for a tree} - var - TreeBytes : Integer; - I, J, K : Integer; - Num, Len : Integer; - B : Byte; - begin - {get number of bytes in compressed tree} - TreeBytes := uzReadBits(8)+1; - - I := 0; - Tree.MaxLength := 0; - - {High nibble: Number of values at this bit length + 1. - Low nibble: Bits needed to represent value + 1} - for J := 1 to TreeBytes do begin - B := uzReadBits(8); - Len := (B and $0F)+1; - Num := (B shr 4)+1; - - for K := I to I+Num-1 do - with Tree, Entry[K] do begin - if Len > MaxLength then - MaxLength := Len; - BitLength := Len; - Value := K; - end; - Inc(I, Num); - end; - end; - - begin - Tree.Entries := TreeSize; - uzReadLengths; - SortLengths; - GenerateTree; - for I := 0 to TreeSize-1 do - AbReverseBits(Tree.Entry[I].Code); - end; - - function uzReadTree(var T) : Byte; - {-Read next byte using a Shannon-Fano tree} - var - Bits : Integer; - CV : Word; - E : Integer; - Cur : Integer; - var - Tree : TAbSfTree absolute T; - begin - Result := 0; - Bits := 0; - CV := 0; - Cur := 0; - E := Tree.Entries; - repeat - CV := CV or (uzReadBits(1) shl Bits); - Inc(Bits); - while Tree.Entry[Cur].BitLength < Bits do begin - Inc(Cur); - if Cur >= E then - Exit; - end; - while Tree.Entry[Cur].BitLength = Bits do begin - if Tree.Entry[Cur].Code = CV then begin - Result := Tree.Entry[Cur].Value; - Exit; - end; - Inc(Cur); - if Cur >= E then - Exit; - end; - until False; - end; - -begin - {do we have an 8K dictionary?} - if FDictionarySize = ds8K then - DictBits := 7 - else - DictBits := 6; - - {allocate trees} - LengthTree := AllocMem(szLengthTree); - DistanceTree := AllocMem(szDistanceTree); - LitTree := nil; - try - {do we have a Literal tree?} - MinMatchLength := FShannonFanoTreeCount; - if MinMatchLength = 3 then begin - LitTree := AllocMem(szLitTree); - uzLoadTree(LitTree^, 256); - end; - - {load the other two trees} - uzLoadTree(LengthTree^, 64); - uzLoadTree(DistanceTree^, 64); - - while (not FInEof) and (FOutSent + LongInt(FOutPos) < FUncompressedSize) do - {is data literal?} - if Boolean(uzReadBits(1)) then begin - {if MinMatchLength = 3 then we have a Literal tree} - if (MinMatchLength = 3) then - uzWriteByte( uzReadTree(LitTree^) ) - else - uzWriteByte( uzReadBits(8) ); - end - else begin - {data is a sliding dictionary} - Distance := uzReadBits(DictBits); - - {using the Distance Shannon-Fano tree, read and decode the - upper 6 bits of the Distance value} - Distance := Distance or (uzReadTree(DistanceTree^) shl DictBits); - - {using the Length Shannon-Fano tree, read and decode the Length value} - Length := uzReadTree(LengthTree^); - if Length = 63 then - Inc(Length, uzReadBits(8)); - Inc(Length, MinMatchLength); - - {move backwards Distance+1 bytes in the output stream, and copy - Length characters from this position to the output stream. - (if this position is before the start of the output stream, - then assume that all the data before the start of the output - stream is filled with zeros)} - DIndex := (FOutSent + LongInt(FOutPos))-(Distance+1); - while Length > 0 do begin - if DIndex < 0 then - uzWriteByte(0) - else begin - uzFlushOutBuf; - SPos := FOutWriter.Position; - FOutWriter.Position := DIndex; - FOutWriter.Read( MyByte, 1 ); - FOutWriter.Position := SPos; - uzWriteByte(MyByte); - end; - Inc(DIndex); - Dec(Length); - end; - end; - finally - if (LitTree <> nil) then - FreeMem(LitTree, szLitTree); - FreeMem(LengthTree, szLengthTree); - FreeMem(DistanceTree, szDistanceTree); - end; -end; -{$ENDIF UnzipImplodeSupport} -{ -------------------------------------------------------------------------- } -{$IFDEF UnzipReduceSupport} -procedure TAbUnzipHelper.uzUnReduce; -const - FactorMasks : array[1..4] of Byte = ($7F, $3F, $1F, $0F); - DLE = 144; -var - C, Last : Byte; - OpI : LongInt; - I, J, Sz : Integer; - D : Word; - SPos : LongInt; - MyByte : Byte; - Factor : Byte; {reduction Factor} - FactorMask : Byte; {bit mask to use based on Factor} - Followers : PAbFollowerSets; {array of follower sets} - State : Integer; {used while processing reduced files} - V : Integer; {"} - Len : Integer; {"} - - function BitsNeeded( i : Byte ) : Word; - begin - dec( i ); - Result := 0; - repeat - inc( Result ); - i := i shr 1; - until i = 0; - end; - -begin - GetMem(Followers, SizeOf(TAbFollowerSets)); - try - Factor := Ord( FCompressionMethod ) - 1; - FactorMask := FactorMasks[Factor]; - State := 0; - C := 0; - V := 0; - Len := 0; - D := 0; - - {load follower sets} - for I := 255 downto 0 do begin - Sz := uzReadBits(6); - Followers^[I].Size := Sz; - Dec(Sz); - for J := 0 to Sz do - Followers^[I].FSet[J] := uzReadBits(8); - end; - - while (not FInEof) and ((FOutSent + LongInt(FOutPos)) < FUncompressedSize) do begin - Last := C; - with Followers^[Last] do - if Size = 0 then - C := uzReadBits(8) - else begin - C := uzReadBits(1); - if C <> 0 then - C := uzReadBits(8) - else - C := FSet[uzReadBits(BitsNeeded(Size))]; - end; - - if FInEof then - Exit; - - case State of - 0 : - if C <> DLE then - uzWriteByte(C) - else - State := 1; - 1 : - if C <> 0 then begin - V := C; - Len := V and FactorMask; - if Len = FactorMask then - State := 2 - else - State := 3; - end - else begin - uzWriteByte(DLE); - State := 0; - end; - - 2 : - begin - Inc(Len, C); - State := 3; - end; - - 3 : - begin - case Factor of - 1 : D := (V shr 7) and $01; - 2 : D := (V shr 6) and $03; - 3 : D := (V shr 5) and $07; - 4 : D := (V shr 4) and $0f; - else - raise EAbZipInvalidFactor.Create; - end; - {Delphi raises compiler Hints here, saying D might - be undefined... If Factor is not in [1..4], the - exception gets raised, and we never execute the following - line} - OpI := (FOutSent + LongInt(FOutPos))-(Swap(D)+C+1); - - for I := 0 to Len+2 do begin - if OpI < 0 then - uzWriteByte(0) - else if OpI >= FOutSent then - uzWriteByte(FOutBuf[OpI - FOutSent]) - else begin - SPos := FOutWriter.Position; - FOutWriter.Position := OpI; - FOutWriter.Read( MyByte, 1 ); - FOutWriter.Position := SPos; - uzWriteByte(MyByte); - end; - Inc(OpI); - end; - - State := 0; - end; - end; - end; - finally - FreeMem(Followers, SizeOf(Followers^)); - end; -end; -{$ENDIF UnzipReduceSupport} -{ -------------------------------------------------------------------------- } -{$IFDEF UnzipShrinkSupport} -procedure TAbUnzipHelper.uzUnShrink; - {-Extract a file that was shrunk} -const - MaxBits = 13; - InitBits = 9; - FirstFree = 257; - Clear = 256; - MaxCodeMax = 8192; {= 1 shl MaxBits} - Unused = -1; -var - CodeSize : SmallInt; - NextFree : SmallInt; - BaseChar : SmallInt; - NewCode : SmallInt; - OldCode : SmallInt; - SaveCode : SmallInt; - N, R : SmallInt; - I : Integer; - PrefixTable : PAbIntArray8K; {used while processing shrunk files} - SuffixTable : PAbByteArray8K; {"} - Stack : PAbByteArray8K; {"} - StackIndex : Integer; {"} -begin - CodeSize := InitBits; -{ MaxCode := (1 shl InitBits)-1;} - NextFree := FirstFree; - - PrefixTable := nil; - SuffixTable := nil; - Stack := nil; - - try - GetMem(PrefixTable, SizeOf(PrefixTable^)); - SuffixTable := AllocMem(SizeOf(SuffixTable^)); - GetMem(Stack, SizeOf(Stack^)); - - FillChar(PrefixTable^, SizeOf(PrefixTable^), $FF); - for NewCode := 255 downto 0 do begin - PrefixTable^[NewCode] := 0; - SuffixTable^[NewCode] := NewCode; - end; - - OldCode := uzReadBits(CodeSize); - if FInEof then - Exit; - BaseChar := OldCode; - - uzWriteByte(BaseChar); - - StackIndex := 0; - while (not FInEof) do begin - NewCode := uzReadBits(CodeSize); - while (NewCode = Clear) and (not FInEof) do begin - case uzReadBits(CodeSize) of - 1 : begin - Inc(CodeSize); - end; - 2 : begin - {mark all nodes as potentially unused} - for I := FirstFree to pred( NextFree ) do - PrefixTable^[I] := PrefixTable^[I] or LongInt($8000); - - {unmark those used by other nodes} - for N := FirstFree to NextFree-1 do begin - {reference to another node?} - R := PrefixTable^[N] and $7FFF; - {flag node as referenced} - if R >= FirstFree then - PrefixTable^[R] := PrefixTable^[R] and $7FFF; - end; - - {clear the ones that are still marked} - for I := FirstFree to pred( NextFree ) do - if PrefixTable^[I] < 0 then - PrefixTable^[I] := -1; - - {recalculate NextFree} - NextFree := FirstFree; - while (NextFree < MaxCodeMax) and - (PrefixTable^[NextFree] <> -1) do - Inc(NextFree); - end; - end; - - NewCode := uzReadBits(CodeSize); - end; - - if FInEof then - Exit; - - {save current code} - SaveCode := NewCode; - - {special case} - if PrefixTable^[NewCode] = Unused then begin - Stack^[StackIndex] := BaseChar; - Inc(StackIndex); - NewCode := OldCode; - end; - - {generate output characters in reverse order} - while (NewCode >= FirstFree) do begin - if PrefixTable^[NewCode] = Unused then begin - Stack^[StackIndex] := BaseChar; - Inc(StackIndex); - NewCode := OldCode; - end else begin - Stack^[StackIndex] := SuffixTable^[NewCode]; - Inc(StackIndex); - NewCode := PrefixTable^[NewCode]; - end; - end; - - BaseChar := SuffixTable^[NewCode]; - uzWriteByte(BaseChar); - - {put them out in forward order} - while (StackIndex > 0) do begin - Dec(StackIndex); - uzWriteByte(Stack^[StackIndex]); - end; - - {add new entry to tables} - NewCode := NextFree; - if NewCode < MaxCodeMax then begin - PrefixTable^[NewCode] := OldCode; - SuffixTable^[NewCode] := BaseChar; - while (NextFree < MaxCodeMax) and - (PrefixTable^[NextFree] <> Unused) do - Inc(NextFree); - end; - - {remember previous code} - OldCode := SaveCode; - end; - finally - FreeMem(PrefixTable, SizeOf(PrefixTable^)); - FreeMem(SuffixTable, SizeOf(SuffixTable^)); - FreeMem(Stack, SizeOf(Stack^)); - end; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -procedure RequestPassword(Archive : TAbZipArchive; var Abort : Boolean); -var - APassPhrase : AnsiString; -begin - APassPhrase := Archive.Password; - Abort := False; - if Assigned(Archive.OnNeedPassword) then begin - Archive.OnNeedPassword(Archive, APassPhrase); - if APassPhrase = '' then - Abort := True - else - Archive.Password := APassPhrase; - end; -end; -{ -------------------------------------------------------------------------- } -procedure CheckPassword(Archive : TAbZipArchive; var Tries : Integer; var Abort : Boolean); -begin - { if current password empty } - if Archive.Password = '' then begin - { request password } - RequestPassword(Archive, Abort); - { increment tries } - Inc(Tries); - end; - - { if current password still empty } - if Archive.Password = '' then begin - { abort } - raise EAbZipInvalidPassword.Create; - end; -end; - - -{ -------------------------------------------------------------------------- } -procedure DoInflate(Archive : TAbZipArchive; Item : TAbZipItem; InStream, OutStream : TStream); -var - Hlpr : TAbDeflateHelper; -begin - Hlpr := TAbDeflateHelper.Create; - try - if Item.CompressionMethod = cmEnhancedDeflated then - Hlpr.Options := Hlpr.Options or dfc_UseDeflate64; - - Hlpr.StreamSize := Item.CompressedSize; - - Inflate(InStream, OutStream, Hlpr); - finally - Hlpr.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure DoLegacyUnzip(Archive : TAbZipArchive; Item : TAbZipItem; InStream, OutStream : TStream); -var - Helper : TAbUnzipHelper; -begin - Helper := TAbUnzipHelper.Create(InStream, OutStream); - try {Helper} - Helper.DictionarySize := Item.DictionarySize; - Helper.UnCompressedSize := Item.UncompressedSize; - Helper.CompressionMethod := Item.CompressionMethod; - Helper.ShannonFanoTreeCount := Item.ShannonFanoTreeCount; - Helper.Execute; - finally - Helper.Free; - end; -end; -{ -------------------------------------------------------------------------- } -{$IFDEF UnzipBzip2Support} -procedure DoExtractBzip2(Archive : TAbZipArchive; Item : TAbZipItem; InStream, OutStream : TStream); -var - Bzip2Stream: TStream; -begin - Bzip2Stream := TBZDecompressionStream.Create(InStream); - try - OutStream.CopyFrom(Bzip2Stream, Item.UncompressedSize); - finally - Bzip2Stream.Free; - end; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -{$IFDEF UnzipLzmaSupport} -procedure DoExtractLzma(Archive : TAbZipArchive; Item : TAbZipItem; - InStream, OutStream : TStream); -var - Header: packed record - MajorVer, MinorVer: Byte; - PropSize: Word; - end; - Properties: array of Byte; -begin - InStream.ReadBuffer(Header, SizeOf(Header)); - SetLength(Properties, Header.PropSize); - InStream.ReadBuffer(Properties[0], Header.PropSize); - LzmaDecodeStream(PByte(Properties), Header.PropSize, InStream, OutStream, - Item.UncompressedSize); -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -function ExtractPrep(ZipArchive: TAbZipArchive; Item: TAbZipItem): TStream; -var - LFH : TAbZipLocalFileHeader; - Abort : Boolean; - Tries : Integer; - CheckValue : LongInt; - DecryptStream: TAbDfDecryptStream; -begin - { validate } - if (Lo(Item.VersionNeededToExtract) > Ab_ZipVersion) then - raise EAbZipVersion.Create; - - { seek to compressed file } - if ZipArchive.FStream is TAbSpanReadStream then - TAbSpanReadStream(ZipArchive.FStream).SeekImage(Item.DiskNumberStart, - Item.RelativeOffset) - else - ZipArchive.FStream.Position := Item.RelativeOffset; - - { get local header info for Item} - LFH := TAbZipLocalFileHeader.Create; - try - { select appropriate CRC value based on General Purpose Bit Flag } - { also get whether the file is stored, while we've got the local file header } - LFH.LoadFromStream(ZipArchive.FStream); - if (LFH.GeneralPurposeBitFlag and AbHasDataDescriptorFlag = AbHasDataDescriptorFlag) then - { if bit 3 is set, then the data descriptor record is appended - to the compressed data } - CheckValue := LFH.LastModFileTime shl $10 - else - CheckValue := Item.CRC32; - finally - LFH.Free; - end; - - Result := TAbUnzipSubsetStream.Create(ZipArchive.FStream, - Item.CompressedSize); - - { get decrypting stream } - if Item.IsEncrypted then begin - try - { need to decrypt } - Tries := 0; - Abort := False; - CheckPassword(ZipArchive, Tries, Abort); - while True do begin - if Abort then - raise EAbUserAbort.Create; - { check for valid password } - DecryptStream := TAbDfDecryptStream.Create(Result, - CheckValue, ZipArchive.Password); - if DecryptStream.IsValid then begin - DecryptStream.OwnsStream := True; - Result := DecryptStream; - Break; - end; - FreeAndNil(DecryptStream); - { prompt again } - Inc(Tries); - if (Tries > ZipArchive.PasswordRetries) then - raise EAbZipInvalidPassword.Create; - RequestPassword(ZipArchive, Abort); - end; - except - Result.Free; - raise; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure DoExtract(aZipArchive: TAbZipArchive; aItem: TAbZipItem; - aInStream, aOutStream: TStream); -var - OutStream : TAbUnzipOutputStream; -begin - if aItem.UncompressedSize = 0 then - Exit; - - OutStream := TAbUnzipOutputStream.Create(aOutStream); - try - OutStream.UncompressedSize := aItem.UncompressedSize; - OutStream.OnProgress := aZipArchive.OnProgress; - - { determine storage type } - case aItem.CompressionMethod of - cmStored: begin - { unstore aItem } - OutStream.CopyFrom(aInStream, aItem.UncompressedSize); - end; - cmDeflated, cmEnhancedDeflated: begin - { inflate aItem } - DoInflate(aZipArchive, aItem, aInStream, OutStream); - end; - {$IFDEF UnzipBzip2Support} - cmBzip2: begin - DoExtractBzip2(aZipArchive, aItem, aInStream, OutStream); - end; - {$ENDIF} - {$IFDEF UnzipLzmaSupport} - cmLZMA: begin - DoExtractLzma(aZipArchive, aItem, aInStream, OutStream); - end; - {$ENDIF} - {$IFDEF UnzipPPMdSupport} - cmPPMd: begin - DecompressPPMd(aInStream, OutStream); - end; - {$ENDIF} - {$IFDEF UnzipWavPackSupport} - cmWavPack: begin - DecompressWavPack(aInStream, OutStream); - end; - {$ENDIF} - cmShrunk..cmImploded: begin - DoLegacyUnzip(aZipArchive, aItem, aInStream, OutStream); - end; - else - raise EAbZipInvalidMethod.Create; - end; - - { check CRC } - if OutStream.CRC32 <> aItem.CRC32 then - if Assigned(aZipArchive.OnProcessItemFailure) then - aZipArchive.OnProcessItemFailure(aZipArchive, aItem, ptExtract, - ecAbbrevia, AbZipBadCRC) - else - raise EAbZipBadCRC.Create; - finally - OutStream.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure AbUnzipToStream( Sender : TObject; Item : TAbZipItem; OutStream : TStream); -var - ZipArchive : TAbZipArchive; - InStream : TStream; -begin - ZipArchive := Sender as TAbZipArchive; - if not Assigned(OutStream) then - raise EAbBadStream.Create; - - InStream := ExtractPrep(ZipArchive, Item); - try - DoExtract(ZipArchive, Item, InStream, OutStream); - finally - InStream.Free - end; -end; -{ -------------------------------------------------------------------------- } -procedure AbUnzip(Sender : TObject; Item : TAbZipItem; const UseName : string); - {create the output filestream and pass it to DoExtract} -var - InStream, OutStream : TStream; - ZipArchive : TAbZipArchive; -begin - ZipArchive := TAbZipArchive(Sender); - - if Item.IsDirectory then - AbCreateDirectory(UseName) - else begin - InStream := ExtractPrep(ZipArchive, Item); - try - OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyWrite); - try - try {OutStream} - DoExtract(ZipArchive, Item, InStream, OutStream); - finally {OutStream} - OutStream.Free; - end; {OutStream} - except - if ExceptObject is EAbUserAbort then - ZipArchive.FStatus := asInvalid; - DeleteFile(UseName); - raise; - end; - finally - InStream.Free - end; - end; - - AbSetFileTime(UseName, Item.LastModTimeAsDateTime); - AbSetFileAttr(UseName, Item.NativeFileAttributes); -end; -{ -------------------------------------------------------------------------- } -procedure AbTestZipItem(Sender : TObject; Item : TAbZipItem); - {extract item to bit bucket and verify its local file header} -var - BitBucket : TAbBitBucketStream; - FieldSize : Word; - LFH : TAbZipLocalFileHeader; - Zip64Field : PZip64LocalHeaderRec; - ZipArchive : TAbZipArchive; -begin - ZipArchive := TAbZipArchive(Sender); - - if (Lo(Item.VersionNeededToExtract) > Ab_ZipVersion) then - raise EAbZipVersion.Create; - - { seek to compressed file } - if ZipArchive.FStream is TAbSpanReadStream then - TAbSpanReadStream(ZipArchive.FStream).SeekImage(Item.DiskNumberStart, - Item.RelativeOffset) - else - ZipArchive.FStream.Position := Item.RelativeOffset; - - BitBucket := nil; - LFH := nil; - try - BitBucket := TAbBitBucketStream.Create(0); - LFH := TAbZipLocalFileHeader.Create; - {get the item's local file header} - ZipArchive.FStream.Seek(Item.RelativeOffset, soBeginning); - LFH.LoadFromStream(ZipArchive.FStream); - ZipArchive.FStream.Seek(Item.RelativeOffset, soBeginning); - - {currently a single exception is raised for any LFH error} - if (LFH.VersionNeededToExtract <> Item.VersionNeededToExtract) then - raise EAbZipInvalidLFH.Create; - if (LFH.GeneralPurposeBitFlag <> Item.GeneralPurposeBitFlag) then - raise EAbZipInvalidLFH.Create; - if (LFH.LastModFileTime <> Item.LastModFileTime) then - raise EAbZipInvalidLFH.Create; - if (LFH.LastModFileDate <> Item.LastModFileDate) then - raise EAbZipInvalidLFH.Create; - if (LFH.CRC32 <> Item.CRC32) then - raise EAbZipInvalidLFH.Create; - if LFH.ExtraField.Get(Ab_Zip64SubfieldID, Pointer(Zip64Field), FieldSize) then begin - if (Zip64Field.CompressedSize <> Item.CompressedSize) then - raise EAbZipInvalidLFH.Create; - if (Zip64Field.UncompressedSize <> Item.UncompressedSize) then - raise EAbZipInvalidLFH.Create; - end - else begin - if (LFH.CompressedSize <> Item.CompressedSize) then - raise EAbZipInvalidLFH.Create; - if (LFH.UncompressedSize <> Item.UncompressedSize) then - raise EAbZipInvalidLFH.Create; - end; - if (LFH.FileName <> Item.RawFileName) then - raise EAbZipInvalidLFH.Create; - - {any CRC errors will raise exception during extraction} - AbUnZipToStream(Sender, Item, BitBucket); - finally - BitBucket.Free; - LFH.Free; - end; - -end; -{ -------------------------------------------------------------------------- } -procedure InflateStream( CompressedStream, UnCompressedStream : TStream ); - {-Inflates everything in CompressedStream to UncompressedStream - no encryption is tried, no check on CRC is done, uses the whole - compressedstream - no Progress events - no Frills!} -begin - Inflate(CompressedStream, UncompressedStream, nil); -end; - -end. - diff --git a/components/Abbrevia/source/AbUnzper.pas b/components/Abbrevia/source/AbUnzper.pas deleted file mode 100644 index 8655f0a..0000000 --- a/components/Abbrevia/source/AbUnzper.pas +++ /dev/null @@ -1,282 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: ABUnzper.pas *} -{*********************************************************} -{* ABBREVIA: Non-visual Component with UnZip support *} -{*********************************************************} - -unit AbUnzper; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbZBrows, AbArcTyp, AbZipTyp; - -type - TAbCustomUnZipper = class(TAbCustomZipBrowser) - protected {private} - FExtractOptions : TAbExtractOptions; - FOnConfirmOverwrite : TAbConfirmOverwriteEvent; - FOnNeedPassword : TAbNeedPasswordEvent; - FPasswordRetries : Byte; - - protected {methods} - procedure DoConfirmOverwrite(var Name : string; - var Confirm : Boolean); - virtual; - procedure DoNeedPassword(Sender : TObject; - var NewPassword : AnsiString); - virtual; - procedure InitArchive; override; - procedure SetExtractOptions(Value : TAbExtractOptions); - procedure SetPasswordRetries(Value : Byte); - procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem; - const NewName : string ); - procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream); - procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem); - - procedure SetFileName(const aFileName : string); - override; - - protected {properties} - property ExtractOptions : TAbExtractOptions - read FExtractOptions - write SetExtractOptions - default AbDefExtractOptions; - property OnConfirmOverwrite : TAbConfirmOverwriteEvent - read FOnConfirmOverwrite - write FOnConfirmOverwrite; - property OnNeedPassword : TAbNeedPasswordEvent - read FOnNeedPassword - write FOnNeedPassword; - property PasswordRetries : Byte - read FPasswordRetries - write SetPasswordRetries - default AbDefPasswordRetries; - - public {methods} - constructor Create( AOwner : TComponent ); - override; - destructor Destroy; - override; - procedure ExtractAt(Index : Integer; const NewName : string); - procedure ExtractFiles(const FileMask : string); - procedure ExtractFilesEx(const FileMask, ExclusionMask : string); - procedure ExtractToStream(const aFileName : string; ToStream : TStream); - procedure ExtractTaggedItems; - procedure TestTaggedItems; - end; - - TAbUnZipper = class(TAbCustomUnZipper) - published - property ArchiveProgressMeter; - property ItemProgressMeter; - property BaseDirectory; - property ExtractOptions; - property LogFile; - property Logging; - property OnArchiveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnConfirmOverwrite; - property OnConfirmProcessItem; - property OnLoad; - property OnNeedPassword; - property OnRequestImage; - property OnProcessItemFailure; - property OnRequestLastDisk; - property OnRequestNthDisk; - property Password; - property PasswordRetries; - property TempDirectory; - property Version; - property FileName; {must be after OnLoad} - end; - - -implementation - -uses - SysUtils, - AbUtils, - AbExcept, - AbUnzPrc; - -{ -------------------------------------------------------------------------- } -constructor TAbCustomUnZipper.Create( AOwner : TComponent ); -begin - inherited Create(AOwner); - ExtractOptions := AbDefExtractOptions; - PasswordRetries := AbDefPasswordRetries; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomUnZipper.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.DoConfirmOverwrite(var Name : string; - var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FOnConfirmOverwrite) then - FOnConfirmOverwrite( Name, Confirm ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.DoNeedPassword(Sender : TObject; - var NewPassword : AnsiString); -begin - if Assigned(FOnNeedPassword) then begin - FOnNeedPassword(Self, NewPassword); - Password := NewPassword; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.ExtractAt(Index : Integer; const NewName : string); - {extract a file from the archive that match the index} -begin - if (FArchive <> nil) then - FArchive.ExtractAt(Index, NewName) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.ExtractFiles(const FileMask : string); - {extract all files from the archive that match the mask} -begin - if (FArchive <> nil) then - FArchive.ExtractFiles( FileMask ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.ExtractFilesEx(const FileMask, ExclusionMask : string); - {extract files matching FileMask except those matching ExclusionMask} -begin - if (FArchive <> nil) then - FArchive.ExtractFilesEx(FileMask, ExclusionMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.ExtractToStream(const aFileName : string; - ToStream : TStream); -begin - if (FArchive <> nil) then - FArchive.ExtractToStream(aFileName, ToStream) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.ExtractTaggedItems; - {extract all tagged items from the archive} -begin - if (FArchive <> nil) then - FArchive.ExtractTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.InitArchive; -begin - inherited InitArchive; - if FArchive <> nil then begin - FArchive.ExtractOptions := FExtractOptions; - FArchive.OnConfirmOverwrite := DoConfirmOverwrite; - end; - if FArchive is TAbZipArchive then begin - TAbZipArchive(FArchive).PasswordRetries := FPasswordRetries; - TAbZipArchive(FArchive).OnNeedPassword := DoNeedPassword; - TAbZipArchive(FArchive).TestHelper := TestItemProc; - TAbZipArchive(FArchive).ExtractHelper := UnzipProc; - TAbZipArchive(FArchive).ExtractToStreamHelper := UnzipToStreamProc; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.SetExtractOptions(Value : TAbExtractOptions); -begin - FExtractOptions := Value; - if (FArchive <> nil) then - FArchive.ExtractOptions := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.SetPasswordRetries(Value : Byte); -begin - FPasswordRetries := Value; - if FArchive is TAbZipArchive then - TAbZipArchive(FArchive).PasswordRetries := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.TestTaggedItems; - {Test specified items} -begin - if (FArchive <> nil) then - FArchive.TestTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.UnzipProc(Sender : TObject; - Item : TAbArchiveItem; - const NewName : string); -begin - AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.UnzipToStreamProc(Sender : TObject; - Item : TAbArchiveItem; - OutStream : TStream); -begin - AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomUnZipper.TestItemProc(Sender : TObject; - Item : TAbArchiveItem); -begin - AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item)); -end; -{ -------------------------------------------------------------------------- } - -procedure TAbCustomUnZipper.SetFileName(const aFileName: string); -begin - if aFileName <> '' then - begin - if not FileExists(aFileName) then - raise EAbFileNotFound.Create; - if AbFileGetSize(aFileName) <= 0 then - raise EAbBadStream.Create; - end; - - inherited SetFileName(aFileName); -end; - -end. - diff --git a/components/Abbrevia/source/AbUtils.pas b/components/Abbrevia/source/AbUtils.pas deleted file mode 100644 index bc9d5d2..0000000 --- a/components/Abbrevia/source/AbUtils.pas +++ /dev/null @@ -1,1357 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbUtils.pas *} -{*********************************************************} -{* ABBREVIA: Utility classes and routines *} -{*********************************************************} - -unit AbUtils; - -{$I AbDefine.inc} - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF LibcAPI} - Libc, -{$ENDIF} -{$IFDEF FPCUnixAPI} - baseunix, - {$IFDEF Linux} - initc, - {$ENDIF} - unix, -{$ENDIF} -{$IFDEF PosixAPI} - Posix.SysStatvfs, - Posix.SysStat, - Posix.Utime, - Posix.Base, - Posix.Unistd, - Posix.Fcntl, - Posix.SysTypes, -{$ENDIF} -{$IFDEF UNIX} - DateUtils, -{$ENDIF} - SysUtils, - Classes, - AbCharset; - - -type - {describe the pending action for an archive item} - TAbArchiveAction = - (aaFailed, aaNone, aaAdd, aaDelete, aaFreshen, aaMove, aaReplace, - aaStreamAdd); - TAbProcessType = - (ptAdd, ptDelete, ptExtract, ptFreshen, ptMove, ptReplace, ptFoundUnhandled); - TAbLogType = - (ltAdd, ltDelete, ltExtract, ltFreshen, ltMove, ltReplace, ltStart, ltFoundUnhandled); - TAbErrorClass = - (ecAbbrevia, ecInOutError, ecFilerError, ecFileCreateError, - ecFileOpenError, ecCabError, ecOther); - -const - AbPathDelim = PathDelim; { Delphi/Linux constant } - AbPathSep = PathSep; { Delphi/Linux constant } - AbDosPathDelim = '\'; - AbUnixPathDelim = '/'; - AbDosPathSep = ';'; - AbUnixPathSep = ':'; - AbDosAnyFile = '*.*'; - AbUnixAnyFile = '*'; - AbAnyFile = {$IFDEF UNIX} AbUnixAnyFile; {$ELSE} AbDosAnyFile; {$ENDIF} - AbThisDir = '.'; - AbParentDir = '..'; - -type - TAbArchiveType = (atUnknown, atZip, atSpannedZip, atSelfExtZip, - atTar, atGzip, atGzippedTar, atCab, atBzip2, atBzippedTar); - - -{$IF NOT DECLARED(DWORD)} -type - DWORD = LongWord; -{$IFEND} - -{$IF NOT DECLARED(PtrInt)} -type - // Delphi 7-2007 declared NativeInt incorrectly - {$IFDEF CPU386} - PtrInt = LongInt; - PtrUInt = LongWord; - {$ELSE} - PtrInt = NativeInt; - PtrUInt = NativeUInt; - {$ENDIF} -{$IFEND} - -{ System-encoded SBCS string (formerly AnsiString) } -type - AbSysString = {$IFDEF Posix}UTF8String{$ELSE}AnsiString{$ENDIF}; - -const - AbCrc32Table : array[0..255] of DWord = ( - $00000000, $77073096, $ee0e612c, $990951ba, - $076dc419, $706af48f, $e963a535, $9e6495a3, - $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, - $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, - $1db71064, $6ab020f2, $f3b97148, $84be41de, - $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, - $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, - $14015c4f, $63066cd9, $fa0f3d63, $8d080df5, - $3b6e20c8, $4c69105e, $d56041e4, $a2677172, - $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, - $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, - $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59, - $26d930ac, $51de003a, $c8d75180, $bfd06116, - $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f, - $2802b89e, $5f058808, $c60cd9b2, $b10be924, - $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, - $76dc4190, $01db7106, $98d220bc, $efd5102a, - $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433, - $7807c9a2, $0f00f934, $9609a88e, $e10e9818, - $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01, - $6b6b51f4, $1c6c6162, $856530d8, $f262004e, - $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, - $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, - $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65, - $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, - $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, - $4369e96a, $346ed9fc, $ad678846, $da60b8d0, - $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, - $5005713c, $270241aa, $be0b1010, $c90c2086, - $5768b525, $206f85b3, $b966d409, $ce61e49f, - $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, - $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad, - $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, - $ead54739, $9dd277af, $04db2615, $73dc1683, - $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, - $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, - $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, - $f762575d, $806567cb, $196c3671, $6e6b06e7, - $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, - $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, - $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, - $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b, - $d80d2bda, $af0a1b4c, $36034af6, $41047a60, - $df60efc3, $a867df55, $316e8eef, $4669be79, - $cb61b38c, $bc66831a, $256fd2a0, $5268e236, - $cc0c7795, $bb0b4703, $220216b9, $5505262f, - $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, - $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d, - $9b64c2b0, $ec63f226, $756aa39c, $026d930a, - $9c0906a9, $eb0e363f, $72076785, $05005713, - $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, - $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, - $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, - $81be16cd, $f6b9265b, $6fb077e1, $18b74777, - $88085ae6, $ff0f6a70, $66063bca, $11010b5c, - $8f659eff, $f862ae69, $616bffd3, $166ccf45, - $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, - $a7672661, $d06016f7, $4969474d, $3e6e77db, - $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, - $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, - $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, - $bad03605, $cdd70693, $54de5729, $23d967bf, - $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, - $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d - ); - - -type - TAbPathType = ( ptNone, ptRelative, ptAbsolute ); - - {===Helper functions===} - function AbCopyFile(const Source, Destination: string; FailIfExists: Boolean): Boolean; - - procedure AbCreateDirectory( const Path : string ); - {creates the requested directory tree. CreateDir is insufficient, - because if you have a path x:\dir, and request x:\dir\sub1\sub2, - (/dir and /dir/sub1/sub2 on Unix) it fails.} - - function AbCreateTempFile(const Dir : string) : string; - - function AbGetTempDirectory : string; - {-Return the system temp directory} - - function AbGetTempFile(const Dir : string; CreateIt : Boolean) : string; - - function AbDrive(const ArchiveName : string) : Char; - - function AbDriveIsRemovable(const ArchiveName : string) : Boolean; - - function AbFileMatch(FileName : string; FileMask : string ) : Boolean; - {see if FileName matches FileMask} - - procedure AbFindFiles(const FileMask : string; SearchAttr : Integer; - FileList : TStrings; Recurse : Boolean ); - - procedure AbFindFilesEx( const FileMask : string; SearchAttr : Integer; - FileList : TStrings; Recurse : Boolean ); - - function AbAddBackSlash(const DirName : string) : string; - - function AbFindNthSlash( const Path : string; n : Integer ) : Integer; - {return the position of the character just before the nth backslash} - - function AbGetDriveFreeSpace(const ArchiveName : string) : Int64; - {return the available space on the specified drive } - - function AbGetPathType( const Value : string ) : TAbPathType; - {returns path type - none, relative or absolute} - - {$IFDEF MSWINDOWS} - function AbGetShortFileSpec(const LongFileSpec : string ) : string; - {$ENDIF} - - procedure AbIncFilename( var Filename : string; Value : Word ); - - procedure AbParseFileName( FileSpec : string; - out Drive : string; - out Path : string; - out FileName : string ); - - procedure AbParsePath( Path : string; SubPaths : TStrings ); - {- break abart path into subpaths --- Path : abbrevia/examples -> - SubPaths[0] = abbrevia - SubPaths[1] = examples} - - function AbPatternMatch(const Source : string; iSrc : Integer; - const Pattern : string; iPat : Integer ) : Boolean; - { recursive routine to see if the source string matches - the pattern. Both ? and * wildcard characters are allowed.} - - function AbPercentage(V1, V2 : Int64) : Byte; - {-Returns the ratio of V1 to V2 * 100} - - procedure AbStripDots( var FName : string ); - {-strips relative path information} - - procedure AbStripDrive( var FName : string ); - {-strips the drive off a filename} - - procedure AbFixName( var FName : string ); - {-changes backslashes to forward slashes} - - procedure AbUnfixName( var FName : string ); - {-changes forward slashes to backslashes} - - procedure AbUpdateCRC( var CRC : LongInt; const Buffer; Len : Integer ); - - function AbUpdateCRC32(CurByte : Byte; CurCrc : LongInt) : LongInt; - {-Returns an updated crc32} - - function AbCRC32Of( const aValue : RawByteString ) : LongInt; - - - function AbWriteVolumeLabel(const VolName : string; - Drive : Char) : Cardinal; -const - AB_SPAN_VOL_LABEL = 'PKBACK# %3.3d'; - - function AbGetVolumeLabel(Drive : Char) : string; - procedure AbSetSpanVolumeLabel(Drive: Char; VolNo : Integer); - function AbTestSpanVolumeLabel(Drive: Char; VolNo : Integer): Boolean; - - procedure AbSetFileAttr(const aFileName : string; aAttr: Integer); - {-Sets platform-native file attributes (DOS attr or Unix mode)} - function AbFileGetSize(const aFileName : string) : Int64; - -type - TAbAttrExRec = record - Time: TDateTime; - Size: Int64; - Attr: Integer; - Mode: {$IFDEF UNIX}mode_t{$ELSE}Cardinal{$ENDIF}; - end; - - function AbFileGetAttrEx(const aFileName: string; out aAttr: TAbAttrExRec) : Boolean; - - function AbSwapLongEndianness(Value : LongInt): LongInt; - - -{ date and time stuff } -const - Date1900 {: LongInt} = $0001AC05; {Julian day count for 01/01/1900 -- TDateTime Start Date} - Date1970 {: LongInt} = $00020FE4; {Julian day count for 01/01/1970 -- Unix Start Date} - Unix0Date: TDateTime = 25569; {Date1970 - Date1900} - - SecondsInDay = 86400; {Number of seconds in a day} - SecondsInHour = 3600; {Number of seconds in an hour} - SecondsInMinute = 60; {Number of seconds in a minute} - HoursInDay = 24; {Number of hours in a day} - MinutesInHour = 60; {Number of minutes in an hour} - MinutesInDay = 1440; {Number of minutes in a day} - - - function AbUnixTimeToLocalDateTime(UnixTime : LongInt) : TDateTime; - function AbLocalDateTimeToUnixTime(DateTime : TDateTime) : LongInt; - - function AbDosFileDateToDateTime(FileDate, FileTime : Word) : TDateTime; - function AbDateTimeToDosFileDate(Value : TDateTime) : LongInt; - - function AbGetFileTime(const aFileName: string): TDateTime; - function AbSetFileTime(const aFileName: string; aValue: TDateTime): Boolean; - -{ file attributes } - function AbDOS2UnixFileAttributes(Attr: LongInt): LongInt; - function AbUnix2DosFileAttributes(Attr: LongInt): LongInt; - -{ UNIX File Types and Permissions } -const - AB_FMODE_FILE = $0000; - AB_FMODE_FIFO = $1000; - AB_FMODE_CHARSPECFILE = $2000; - AB_FMODE_DIR = $4000; - AB_FMODE_BLOCKSPECFILE = $6000; - AB_FMODE_FILE2 = $8000; - AB_FMODE_FILELINK = $A000; - AB_FMODE_SOCKET = $C000; - - - AB_FPERMISSION_OWNERREAD = $0100; { read by owner } - AB_FPERMISSION_OWNERWRITE = $0080; { write by owner } - AB_FPERMISSION_OWNEREXECUTE = $0040; { execute/search by owner } - AB_FPERMISSION_GROUPREAD = $0020; { read by group } - AB_FPERMISSION_GROUPWRITE = $0010; { write by group } - AB_FPERMISSION_GROUPEXECUTE = $0008; { execute/search by group } - AB_FPERMISSION_OTHERREAD = $0004; { read by other } - AB_FPERMISSION_OTHERWRITE = $0002; { write by other } - AB_FPERMISSION_OTHEREXECUTE = $0001; { execute/search by other } - - AB_FPERMISSION_GENERIC = - AB_FPERMISSION_OWNERREAD or - AB_FPERMISSION_OWNERWRITE or - AB_FPERMISSION_GROUPREAD or - AB_FPERMISSION_OTHERREAD; - -{ Unicode backwards compatibility functions } -{$IFNDEF UNICODE} -function CharInSet(C: AnsiChar; CharSet: TSysCharSet): Boolean; -{$ENDIF} - -implementation - -uses - StrUtils, - AbConst, - AbExcept; - -{$IF DEFINED(FPCUnixAPI)} -function mktemp(template: PAnsiChar): PAnsiChar; cdecl; - external clib name 'mktemp'; -{$ELSEIF DEFINED(PosixAPI)} -function mktemp(template: PAnsiChar): PAnsiChar; cdecl; - external libc name _PU + 'mktemp'; -{$IFEND} - -{$IF DEFINED(FPCUnixAPI) AND DEFINED(Linux)} -// FreePascal libc definitions -type - nl_item = cint; - -const - __LC_CTYPE = 0; - _NL_CTYPE_CLASS = (__LC_CTYPE shl 16); - _NL_CTYPE_CODESET_NAME = (_NL_CTYPE_CLASS)+14; - -function nl_langinfo(__item: nl_item): PAnsiChar; cdecl; - external clib name 'nl_langinfo'; -{$IFEND} - -{===platform independent routines for platform dependent stuff=======} -function ExtractShortName(const SR : TSearchRec) : string; -begin - {$IFDEF MSWINDOWS} - {$WARN SYMBOL_PLATFORM OFF} - if SR.FindData.cAlternateFileName[0] <> #0 then - Result := SR.FindData.cAlternateFileName - else - Result := SR.FindData.cFileName; - {$WARN SYMBOL_PLATFORM ON} - {$ENDIF} - {$IFDEF UNIX} - Result := SR.Name; - {$ENDIF} -end; -{====================================================================} - - -{ ========================================================================== } -function AbCopyFile(const Source, Destination: string; FailIfExists: Boolean): Boolean; -{$IFDEF UNIX} -var - DesStream, SrcStream: TFileStream; -{$ENDIF} -begin -{$IFDEF UNIX} - Result := False; - if not FailIfExists or not FileExists(Destination) then - try - SrcStream := TFileStream.Create(Source, fmOpenRead or fmShareDenyWrite); - try - DesStream := TFileStream.Create(Destination, fmCreate); - try - DesStream.CopyFrom(SrcStream, 0); - Result := True; - finally - DesStream.Free; - end; - finally - SrcStream.Free; - end; - except - // Ignore errors and just return false - end; -{$ENDIF UNIX} -{$IFDEF MSWINDOWS} - Result := CopyFile(PChar(Source), PChar(Destination), FailIfExists); -{$ENDIF MSWINDOWS} -end; -{ -------------------------------------------------------------------------- } -procedure AbCreateDirectory( const Path : string ); - {creates the requested directory tree. CreateDir is insufficient, - because if you have a path x:\dir, and request x:\dir\sub1\sub2, - (/dir and /dir/sub1/sub2 on Unix) it fails.} -var - iStartSlash : Integer; - i : Integer; - TempPath : string; -begin - if DirectoryExists( Path ) then - Exit; - {see how much of the path currently exists} - if Pos( '\\', Path ) > 0 then - {UNC Path \\computername\sharename\path1..\pathn} - iStartSlash := 5 - else - {standard Path drive:\path1..\pathn} - iStartSlash := 2; - - repeat - {find the Slash at iStartSlash} - i := AbFindNthSlash( Path, iStartSlash ); - {get a temp path to try: drive:\path1} - TempPath := Copy( Path, 1, i ); - {if it doesn't exist, create it} - if not DirectoryExists( TempPath ) then - MkDir( TempPath ); - inc( iStartSlash ); - until ( Length( TempPath ) = Length( Path ) ); -end; -{ -------------------------------------------------------------------------- } -function AbCreateTempFile(const Dir : string) : string; -begin - Result := AbGetTempFile(Dir, True); -end; -{ -------------------------------------------------------------------------- } -function AbGetTempDirectory : string; -begin -{$IFDEF MSWiNDOWS} - SetLength(Result, MAX_PATH); - SetLength(Result, GetTempPath(Length(Result), PChar(Result))); -{$ENDIF} -{$IFDEF UNIX} - Result := '/tmp/'; -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function AbGetTempFile(const Dir : string; CreateIt : Boolean) : string; -var - TempPath : string; -{$IFDEF MSWINDOWS} - FileNameZ : array [0..259] of char; -{$ENDIF} -{$IFDEF UNIX} - hFile: Integer; - FileName: AbSysString; -{$ENDIF} -begin - if DirectoryExists(Dir) then - TempPath := Dir - else - TempPath := AbGetTempDirectory; -{$IFDEF MSWINDOWS} - GetTempFileName(PChar(TempPath), 'VMS', Word(not CreateIt), FileNameZ); - Result := string(FileNameZ); -{$ENDIF} -{$IFDEF UNIX} - FileName := AbSysString(TempPath) + 'VMSXXXXXX'; - mktemp(PAnsiChar(AbSysString(FileName))); - Result := string(FileName); - if CreateIt then begin - hFile := FileCreate(Result); - if hFile <> -1 then - FileClose(hFile); - end; -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function AbDrive(const ArchiveName : string) : Char; -var - iPos: Integer; - Path : string; -begin - Path := ExpandFileName(ArchiveName); - iPos := Pos(':', Path); - if (iPos <= 0) then - Result := 'A' - else - Result := Path[1]; -end; -{ -------------------------------------------------------------------------- } -function AbDriveIsRemovable(const ArchiveName : string) : Boolean; -{$IFDEF MSWINDOWS} -var - Path: string; -{$ENDIF} -begin -{$IFDEF MSWINDOWS} - Path := ExpandFileName(ArchiveName); - if AnsiStartsText('\\?\UNC\', Path) then - Delete(Path, 1, 8) - else if AnsiStartsText('\\?\', Path) then - Delete(Path, 1, 4); - Path := IncludeTrailingPathDelimiter(ExtractFileDrive(Path)); - Result := GetDriveType(PChar(Path)) = DRIVE_REMOVABLE; -{$ENDIF} -{$IFDEF LINUX} - {LINUX -- Following may not cover all the bases} - Result := AnsiStartsText('/mnt/floppy', ExtractFilePath(ExpandFileName(ArchiveName))); -{$ENDIF} -{$IFDEF DARWIN} - Result := False; -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function AbGetDriveFreeSpace(const ArchiveName : string) : Int64; -{ attempt to find free space (in bytes) on drive/volume, - returns -1 if fails for some reason } -{$IFDEF MSWINDOWS} -var - FreeAvailable, TotalSpace: Int64; -begin - if GetDiskFreeSpaceEx(PChar(ExtractFilePath(ExpandFileName(ArchiveName))), - FreeAvailable, TotalSpace, nil) then - Result := FreeAvailable - else - Result := -1; -{$ENDIF} -{$IFDEF UNIX} -var - FStats : {$IFDEF PosixAPI}_statvfs{$ELSE}TStatFs{$ENDIF}; -begin - {$IF DEFINED(LibcAPI)} - if statfs(PAnsiChar(ExtractFilePath(ArchiveName)), FStats) = 0 then - Result := Int64(FStats.f_bAvail) * Int64(FStats.f_bsize) - {$ELSEIF DEFINED(FPCUnixAPI)} - if fpStatFS(PAnsiChar(ExtractFilePath(ArchiveName)), @FStats) = 0 then - Result := Int64(FStats.bAvail) * Int64(FStats.bsize) - {$ELSEIF DEFINED(PosixAPI)} - if statvfs(PAnsiChar(AbSysString(ExtractFilePath(ArchiveName))), FStats) = 0 then - Result := Int64(FStats.f_bavail) * Int64(FStats.f_bsize) - {$IFEND} - else - Result := -1; -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function AbFileMatch(FileName: string; FileMask: string ): Boolean; - {see if FileName matches FileMask} -var - DirMatch : Boolean; - MaskDir : string; -begin - FileName := UpperCase( FileName ); - FileMask := UpperCase( FileMask ); - MaskDir := ExtractFilePath( FileMask ); - if MaskDir = '' then - DirMatch := True - else - DirMatch := AbPatternMatch( ExtractFilePath( FileName ), 1, MaskDir, 1 ); - - Result := DirMatch and AbPatternMatch( ExtractFileName( FileName ), 1, - ExtractFileName( FileMask ), 1 ); -end; -{ -------------------------------------------------------------------------- } -procedure AbFindFiles( const FileMask : string; SearchAttr : Integer; - FileList : TStrings; Recurse : Boolean ); -var - NewFile : string; - SR : TSearchRec; - Found : Integer; - NameMask: string; -begin - Found := FindFirst( FileMask, SearchAttr, SR ); - if Found = 0 then begin - try - NameMask := UpperCase(ExtractFileName(FileMask)); - while Found = 0 do begin - NewFile := ExtractFilePath( FileMask ) + SR.Name; - if (SR.Name <> AbThisDir) and - (SR.Name <> AbParentDir) and - AbPatternMatch(UpperCase(SR.Name), 1, NameMask, 1) then - if (SR.Attr and faDirectory) <> 0 then - FileList.Add( NewFile + PathDelim ) - else - FileList.Add( NewFile ); - Found := FindNext( SR ); - end; - finally - FindClose( SR ); - end; - end; - if not Recurse then - Exit; - NewFile := ExtractFilePath( FileMask ); - if ( NewFile <> '' ) and ( NewFile[Length(NewFile)] <> AbPathDelim) then - NewFile := NewFile + AbPathDelim; - NewFile := NewFile + AbAnyFile; - - Found := FindFirst( NewFile, faDirectory or SearchAttr, SR ); - if Found = 0 then begin - try - while ( Found = 0 ) do begin - if ( SR.Name <> AbThisDir ) and - ( SR.Name <> AbParentDir ) and - ((SR.Attr and faDirectory) > 0 ) then - AbFindFiles( ExtractFilePath( NewFile ) + SR.Name + AbPathDelim + - ExtractFileName( FileMask ), SearchAttr, - FileList, True ); - Found := FindNext( SR ); - end; - finally - FindClose( SR ); - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure AbFindFilesEx( const FileMask : string; SearchAttr : Integer; - FileList : TStrings; Recurse : Boolean ); -var - I, J: Integer; - MaskPart: string; -begin - I := 1; - while I <= Length(FileMask) do begin - J := I; - while (I <= Length(FileMask)) and (FileMask[I] <> AbPathSep) do Inc(I); - MaskPart := Trim(Copy(FileMask, J, I - J)); - if (I <= Length(FileMask)) and (FileMask[I] = AbPathSep) then Inc(I); - - AbFindFiles(MaskPart, SearchAttr, FileList, Recurse); - end; -end; -{ -------------------------------------------------------------------------- } -function AbAddBackSlash(const DirName : string) : string; -{ Add a default slash to a directory name } -const - AbDelimSet : set of AnsiChar = [AbPathDelim, ':', #0]; -begin - Result := DirName; - if Length(DirName) = 0 then - Exit; - if not CharInSet(DirName[Length(DirName)], AbDelimSet) then - Result := DirName + AbPathDelim; -end; -{ -------------------------------------------------------------------------- } -function AbFindNthSlash( const Path : string; n : Integer ) : Integer; -{ return the position of the character just before the nth slash } -var - i : Integer; - Len : Integer; - iSlash : Integer; -begin - Len := Length( Path ); - Result := Len; - iSlash := 0; - i := 0; - while i <= Len do begin - if Path[i] = AbPathDelim then begin - inc( iSlash ); - if iSlash = n then begin - Result := pred( i ); - break; - end; - end; - inc( i ); - end; -end; -{ -------------------------------------------------------------------------- } -function AbGetPathType( const Value : string ) : TAbPathType; -{ returns path type - none, relative or absolute } -begin - Result := ptNone; -{$IFDEF MSWINDOWS} -{check for drive/unc info} - if ( Pos( '\\', Value ) > 0 ) or ( Pos( ':', Value ) > 0 ) then -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -{ UNIX absolute paths start with a slash } - if (Value[1] = AbPathDelim) then -{$ENDIF UNIX} - Result := ptAbsolute - else if ( Pos( AbPathDelim, Value ) > 0 ) or ( Pos( AB_ZIPPATHDELIM, Value ) > 0 ) then - Result := ptRelative; -end; -{ -------------------------------------------------------------------------- } -{$IFDEF MSWINDOWS} -{$WARN SYMBOL_PLATFORM OFF} -function AbGetShortFileSpec(const LongFileSpec : string ) : string; -var - SR : TSearchRec; - Search : string; - Drive : string; - Path : string; - FileName : string; - Found : Integer; - SubPaths : TStrings; - i : Integer; -begin - AbParseFileName( LongFileSpec, Drive, Path, FileName ); - SubPaths := TStringList.Create; - try - AbParsePath( Path, SubPaths ); - Search := Drive; - Result := Search + AbPathDelim; - if SubPaths.Count > 0 then - for i := 0 to pred( SubPaths.Count ) do begin - Search := Search + AbPathDelim + SubPaths[i]; - Found := FindFirst( Search, faHidden + faSysFile + faDirectory, SR ); - if Found <> 0 then - raise EAbException.Create( 'Path not found' ); - try - Result := Result + ExtractShortName(SR) + AbPathDelim; - finally - FindClose( SR ); - end; - end; - Search := Search + AbPathDelim + FileName; - Found := FindFirst( Search, - faReadOnly + faHidden + faSysFile + faArchive, SR ); - if Found <> 0 then - raise EAbFileNotFound.Create; - try - Result := Result + ExtractShortName(SR); - finally - FindClose( SR ); - end; - finally - SubPaths.Free; - end; -end; -{$WARN SYMBOL_PLATFORM ON} -{$ENDIF} -{ -------------------------------------------------------------------------- } -procedure AbIncFilename( var Filename : string; Value : Word ); -{ place value at the end of filename, e.g. Files.C04 } -var - Ext : string; - I : Word; -begin - I := (Value + 1) mod 100; - Ext := ExtractFileExt(Filename); - if (Length(Ext) < 2) then - Ext := '.' + Format('%.2d', [I]) - else - Ext := Ext[1] + Ext[2] + Format('%.2d', [I]); - Filename := ChangeFileExt(Filename, Ext); -end; -{ -------------------------------------------------------------------------- } -procedure AbParseFileName( FileSpec : string; - out Drive : string; - out Path : string; - out FileName : string ); -var - i : Integer; - iColon : Integer; - iStartSlash : Integer; -begin - if Pos( AB_ZIPPATHDELIM, FileSpec ) > 0 then - AbUnfixName( FileSpec ); - FileName := ExtractFileName( FileSpec ); - Path := ExtractFilePath( FileSpec ); - {see how much of the path currently exists} - iColon := Pos( ':', Path ); - if Pos( '\\', Path ) > 0 then begin - {UNC Path \\computername\sharename\path1..\pathn} - {everything up to the 4th slash is the drive} - iStartSlash := 4; - i := AbFindNthSlash( Path, iStartSlash ); - Drive := Copy( Path, 1, i ); - Delete( Path, 1, i + 1 ); - end - else if iColon > 0 then begin - Drive := Copy( Path, 1, iColon ); - Delete( Path, 1, iColon ); - if Path[1] = AbPathDelim then - Delete( Path, 1, 1 ); - end; -end; -{ -------------------------------------------------------------------------- } -procedure AbParsePath( Path : string; SubPaths : TStrings ); -{ break abart path into subpaths --- Path : abbrevia/examples > - SubPaths[0] = abbrevia - SubPaths[1] = examples} -var - i : Integer; - iStart : Integer; - iStartSlash : Integer; - SubPath : string; -begin - if Path = '' then Exit; - if Path[ Length( Path ) ] = AbPathDelim then - Delete( Path, Length( Path ), 1 ); - iStart := 1; - iStartSlash := 1; - repeat - {find the Slash at iStartSlash} - i := AbFindNthSlash( Path, iStartSlash ); - {get the subpath} - SubPath := Copy( Path, iStart, i - iStart + 1 ); - iStart := i + 2; - inc( iStartSlash ); - SubPaths.Add( SubPath ); - until ( i = Length( Path ) ); -end; -{ -------------------------------------------------------------------------- } -function AbPatternMatch(const Source : string; iSrc : Integer; - const Pattern : string; iPat : Integer ) : Boolean; -{ recursive routine to see if the source string matches - the pattern. Both ? and * wildcard characters are allowed. - Compares Source from iSrc to Length(Source) to - Pattern from iPat to Length(Pattern)} -var - Matched : Boolean; - k : Integer; -begin - if Length( Source ) = 0 then begin - Result := Length( Pattern ) = 0; - Exit; - end; - - if iPat = 1 then begin - if ( CompareStr( Pattern, AbDosAnyFile) = 0 ) or - ( CompareStr( Pattern, AbUnixAnyFile ) = 0 ) then begin - Result := True; - Exit; - end; - end; - - if Length( Pattern ) = 0 then begin - Result := (Length( Source ) - iSrc + 1 = 0); - Exit; - end; - - while True do begin - if ( Length( Source ) < iSrc ) and - ( Length( Pattern ) < iPat ) then begin - Result := True; - Exit; - end; - - if Length( Pattern ) < iPat then begin - Result := False; - Exit; - end; - - if Pattern[iPat] = '*' then begin - k := iPat; - if ( Length( Pattern ) < iPat + 1 ) then begin - Result := True; - Exit; - end; - - while True do begin - Matched := AbPatternMatch( Source, k, Pattern, iPat + 1 ); - if Matched or ( Length( Source ) < k ) then begin - Result := Matched; - Exit; - end; - inc( k ); - end; - end - else begin - if ( (Pattern[iPat] = '?') and - ( Length( Source ) <> iSrc - 1 ) ) or - ( Pattern[iPat] = Source[iSrc] ) then begin - inc( iPat ); - inc( iSrc ); - end - else begin - Result := False; - Exit; - end; - end; - end; -end; -{ -------------------------------------------------------------------------- } -function AbPercentage(V1, V2 : Int64) : Byte; -{ Returns the ratio of V1 to V2 * 100 } -begin - if V2 <= 0 then - Result := 0 - else if V1 >= V2 then - Result := 100 - else - Result := (V1 * 100) div V2; -end; -{ -------------------------------------------------------------------------- } -procedure AbStripDots( var FName : string ); -{ strips relative path information, e.g. ".."} -begin - while Pos( AbParentDir + AbPathDelim, FName ) = 1 do - System.Delete( FName, 1, 3 ); -end; -{ -------------------------------------------------------------------------- } -procedure AbStripDrive( var FName : string ); -{ strips the drive off a filename } -var - Drive, Path, Name : string; -begin - AbParseFileName( FName, Drive, Path, Name ); - FName := Path + Name; -end; -{ -------------------------------------------------------------------------- } -procedure AbFixName( var FName : string ); -{ changes backslashes to forward slashes } -var - i : Integer; -begin - for i := 1 to Length( FName ) do - if FName[i] = AbPathDelim then - FName[i] := AB_ZIPPATHDELIM; -end; -{ -------------------------------------------------------------------------- } -procedure AbUnfixName( var FName : string ); -{ changes forward slashes to backslashes } -var - i : Integer; -begin - for i := 1 to Length( FName ) do - if FName[i] = AB_ZIPPATHDELIM then - FName[i] := AbPathDelim; -end; -{ -------------------------------------------------------------------------- } -procedure AbUpdateCRC( var CRC : LongInt; const Buffer; Len : Integer ); -var - BufPtr : PByte; - i : Integer; - CRCTemp : DWORD; -begin - BufPtr := @Buffer; - CRCTemp := CRC; - for i := 0 to pred( Len ) do - begin - CRCTemp := AbCrc32Table[ Byte(CrcTemp) xor (BufPtr^) ] xor - ((CrcTemp shr 8) and $00FFFFFF); - Inc(BufPtr); - end; - CRC := CRCTemp; -end; -{ -------------------------------------------------------------------------- } -function AbUpdateCRC32(CurByte : Byte; CurCrc : LongInt) : LongInt; -{ Return the updated 32bit CRC } -{ Normally a good candidate for basm, but Delphi32's code - generation couldn't be beat on this one!} -begin - Result := DWORD(AbCrc32Table[ Byte(CurCrc xor LongInt( CurByte ) ) ] xor - ((CurCrc shr 8) and DWORD($00FFFFFF))); -end; -{ -------------------------------------------------------------------------- } -function AbCRC32Of( const aValue : RawByteString ) : LongInt; -begin - Result := -1; - AbUpdateCRC(Result, aValue[1], Length(aValue)); - Result := not Result; -end; -{ -------------------------------------------------------------------------- } -function AbWriteVolumeLabel(const VolName : string; - Drive : Char) : Cardinal; -var - Temp : string; - Vol : array[0..11] of Char; - Root : array[0..3] of Char; -begin - Temp := VolName; - StrCopy(Root, '%:' + AbPathDelim); - Root[0] := Drive; - if Length(Temp) > 11 then - SetLength(Temp, 11); - StrPCopy(Vol, Temp); -{$IFDEF MSWINDOWS} - if Windows.SetVolumeLabel(Root, Vol) then - Result := 0 - else Result := GetLastError; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -{ Volume labels not supported on Unix } - Result := 0; -{$ENDIF UNIX} -end; -{ -------------------------------------------------------------------------- } -{$IFDEF MSWINDOWS} -function AbOffsetFromUTC: LongInt; -{ local timezone's offset from UTC in seconds (UTC = local + bias) } -var - TZI: TTimeZoneInformation; -begin -case GetTimeZoneInformation(TZI) of - TIME_ZONE_ID_UNKNOWN: - Result := TZI.Bias; - TIME_ZONE_ID_DAYLIGHT: - Result := TZI.Bias + TZI.DaylightBias; - TIME_ZONE_ID_STANDARD: - Result := TZI.Bias + TZI.StandardBias - else - Result := 0 - end; -Result := Result * SecondsInMinute; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -function AbUnixTimeToLocalDateTime(UnixTime : LongInt) : TDateTime; -{ convert UTC unix date to Delphi TDateTime in local timezone } -{$IFDEF MSWINDOWS} -var - Hrs, Mins, Secs : Word; - TodaysSecs : LongInt; - Time: TDateTime; -begin - UnixTime := UnixTime - AbOffsetFromUTC; - TodaysSecs := UnixTime mod SecondsInDay; - Hrs := TodaysSecs div SecondsInHour; - TodaysSecs := TodaysSecs - (Hrs * SecondsInHour); - Mins := TodaysSecs div SecondsInMinute; - Secs := TodaysSecs - (Mins * SecondsInMinute); - - if TryEncodeTime(Hrs, Mins, Secs, 0, Time) then - Result := Unix0Date + (UnixTime div SecondsInDay) + Time - else - Result := 0; -{$ENDIF} -{$IFDEF UNIX} -begin - Result := FileDateToDateTime(UnixTime); -{$ENDIF} -end; - -{ -------------------------------------------------------------------------- } -function AbLocalDateTimeToUnixTime(DateTime : TDateTime) : LongInt; -{ convert local Delphi TDateTime to UTC unix date } -{$IFDEF MSWINDOWS} -var - Hrs, Mins, Secs, MSecs : Word; - Dt, Tm : TDateTime; -begin - Dt := Trunc(DateTime); - Tm := DateTime - Dt; - if Dt < Unix0Date then - Result := 0 - else - Result := Trunc(Dt - Unix0Date) * SecondsInDay; - - DecodeTime(Tm, Hrs, Mins, Secs, MSecs); - Result := Result + (Hrs * SecondsInHour) + (Mins * SecondsInMinute) + Secs; - Result := Result + AbOffsetFromUTC; -{$ENDIF} -{$IFDEF UNIX} -begin - Result := DateTimeToFileDate(DateTime); -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function AbDosFileDateToDateTime(FileDate, FileTime : Word) : TDateTime; -{$IFDEF MSWINDOWS} -var - Temp : LongInt; -begin - LongRec(Temp).Lo := FileTime; - LongRec(Temp).Hi := FileDate; - Result := FileDateToDateTime(Temp); -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -var - Yr, Mo, Dy : Word; - Hr, Mn, S : Word; -begin - Yr := FileDate shr 9 + 1980; - - Mo := FileDate shr 5 and 15; - if Mo < 1 then Mo := 1; - if Mo > 12 then Mo := 12; - - Dy := FileDate and 31; - if Dy < 1 then Dy := 1; - if Dy > DaysInAMonth(Yr, Mo) then - Dy := DaysInAMonth(Yr, Mo); - - Hr := FileTime shr 11; - if Hr > 23 then Hr := 23; - - Mn := FileTime shr 5 and 63; - if Mn > 59 then Mn := 59; - - S := FileTime and 31 shl 1; - if S > 59 then S := 59; - - Result := - EncodeDate(Yr, Mo, Dy) + - EncodeTime(Hr, Mn, S, 0); -{$ENDIF UNIX} -end; - -function AbDateTimeToDosFileDate(Value : TDateTime) : LongInt; -{$IFDEF MSWINDOWS} -begin - Result := DateTimeToFileDate(Value); -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -var - Yr, Mo, Dy : Word; - Hr, Mn, S, MS: Word; -begin - DecodeDate(Value, Yr, Mo, Dy); - if (Yr < 1980) or (Yr > 2107) then { outside DOS file date year range } - Yr := 1980; - DecodeTime(Value, Hr, Mn, S, MS); - - LongRec(Result).Lo := (S shr 1) or (Mn shl 5) or (Hr shl 11); - LongRec(Result).Hi := Dy or (Mo shl 5) or (Word(Yr - 1980) shl 9); -{$ENDIF UNIX} -end; - -{ -------------------------------------------------------------------------- } - -function AbGetFileTime(const aFileName: string): TDateTime; -var - Attr: TAbAttrExRec; -begin - AbFileGetAttrEx(aFileName, Attr); - Result := Attr.Time; -end; - -function AbSetFileTime(const aFileName: string; aValue: TDateTime): Boolean; -begin - {$IFDEF MSWINDOWS} - Result := FileSetDate(aFileName, AbDateTimeToDosFileDate(aValue)) = 0; - {$ENDIF} - {$IFDEF UNIX} - Result := FileSetDate(aFileName, AbLocalDateTimeToUnixTime(aValue)) = 0; - {$ENDIF} -end; - -{ -------------------------------------------------------------------------- } -function AbSwapLongEndianness(Value : LongInt): LongInt; -{ convert BigEndian <-> LittleEndian 32-bit value } -type - TCastArray = array [0..3] of Byte; -var - i : Integer; -begin - for i := 3 downto 0 do - TCastArray(Result)[3-i] := TCastArray(Value)[i]; -end; -{ -------------------------------------------------------------------------- } -function AbDOS2UnixFileAttributes(Attr: LongInt): LongInt; -begin - {$WARN SYMBOL_PLATFORM OFF} - Result := { default permissions } - AB_FPERMISSION_OWNERREAD or - AB_FPERMISSION_GROUPREAD or - AB_FPERMISSION_OTHERREAD; - - if (Attr and faReadOnly) = 0 then - Result := Result or AB_FPERMISSION_OWNERWRITE; - - if (Attr and faDirectory) <> 0 then - Result := Result or AB_FMODE_DIR or AB_FPERMISSION_OWNEREXECUTE - else - Result := Result or AB_FMODE_FILE; - {$WARN SYMBOL_PLATFORM ON} -end; -{ -------------------------------------------------------------------------- } -function AbUnix2DosFileAttributes(Attr: LongInt): LongInt; -begin - {$WARN SYMBOL_PLATFORM OFF} - Result := 0; - case (Attr and $F000) of - AB_FMODE_FILE, AB_FMODE_FILE2: { standard file } - Result := 0; - - AB_FMODE_DIR: { directory } - Result := Result or faDirectory; - - AB_FMODE_FIFO, - AB_FMODE_CHARSPECFILE, - AB_FMODE_BLOCKSPECFILE, - AB_FMODE_FILELINK, - AB_FMODE_SOCKET: - Result := Result or faSysFile; - end; - - if (Attr and AB_FPERMISSION_OWNERWRITE) <> AB_FPERMISSION_OWNERWRITE then - Result := Result or faReadOnly; - {$WARN SYMBOL_PLATFORM ON} -end; -{ -------------------------------------------------------------------------- } -procedure AbSetFileAttr(const aFileName : string; aAttr: Integer); -begin - {$WARN SYMBOL_PLATFORM OFF} - {$IFDEF MSWINDOWS} - FileSetAttr(aFileName, aAttr); - {$ENDIF} - {$IF DEFINED(LibcAPI) OR DEFINED(PosixAPI)} - chmod(PAnsiChar(AbSysString(aFileName)), aAttr); - {$ELSEIF DEFINED(FPCUnixAPI)} - fpchmod(aFileName, aAttr); - {$IFEND} - {$WARN SYMBOL_PLATFORM ON} -end; -{ -------------------------------------------------------------------------- } -function AbFileGetSize(const aFileName : string) : Int64; -var - SR: TAbAttrExRec; -begin - if AbFileGetAttrEx(aFileName, SR) then - Result := SR.Size - else - Result := -1; -end; -{ -------------------------------------------------------------------------- } -function AbFileGetAttrEx(const aFileName: string; out aAttr: TAbAttrExRec) : Boolean; -var -{$IFDEF MSWINDOWS} - FileDate: LongRec; - FindData: TWin32FindData; - LocalFileTime: TFileTime; -{$ENDIF} -{$IFDEF FPCUnixAPI} - StatBuf: stat; -{$ENDIF} -{$IFDEF LibcAPI} - StatBuf: TStatBuf64; -{$ENDIF} -{$IFDEF PosixAPI} - StatBuf: _stat; -{$ENDIF} -begin - aAttr.Time := 0; - aAttr.Size := -1; - aAttr.Attr := -1; - aAttr.Mode := 0; -{$IFDEF MSWINDOWS} - Result := GetFileAttributesEx(PChar(aFileName), GetFileExInfoStandard, @FindData); - if Result then begin - if FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime) and - FileTimeToDosDateTime(LocalFileTime, FileDate.Hi, FileDate.Lo) then - aAttr.Time := FileDateToDateTime(Integer(FileDate)); - LARGE_INTEGER(aAttr.Size).LowPart := FindData.nFileSizeLow; - LARGE_INTEGER(aAttr.Size).HighPart := FindData.nFileSizeHigh; - aAttr.Attr := FindData.dwFileAttributes; - aAttr.Mode := AbDOS2UnixFileAttributes(FindData.dwFileAttributes); - end; -{$ENDIF} -{$IFDEF UNIX} - {$IFDEF FPCUnixAPI} - Result := (FpStat(aFileName, StatBuf) = 0); - {$ENDIF} - {$IFDEF LibcAPI} - // Work around Kylix QC#2761: Stat64, et al., are defined incorrectly - Result := (__lxstat64(_STAT_VER, PAnsiChar(aFileName), StatBuf) = 0); - {$ENDIF} - {$IFDEF PosixAPI} - Result := (stat(PAnsiChar(AbSysString(aFileName)), StatBuf) = 0); - {$ENDIF} - if Result then begin - aAttr.Time := FileDateToDateTime(StatBuf.st_mtime); - aAttr.Size := StatBuf.st_size; - aAttr.Attr := AbUnix2DosFileAttributes(StatBuf.st_mode); - aAttr.Mode := StatBuf.st_mode; - end; -{$ENDIF UNIX} -end; - - -const - MAX_VOL_LABEL = 16; - -function AbGetVolumeLabel(Drive : Char) : string; -{-Get the volume label for the specified drive.} -{$IFDEF MSWINDOWS} -var - Root : string; - Flags, MaxLength : DWORD; - NameSize : Integer; - VolName : string; -{$ENDIF} -begin -{$IFDEF MSWINDOWS} - NameSize := 0; - Root := Drive + ':\'; - SetLength(VolName, MAX_VOL_LABEL); - - Result := ''; - - if GetVolumeInformation(PChar(Root), PChar(VolName), Length(VolName), - nil, MaxLength, Flags, nil, NameSize) - then - Result := VolName; -{$ELSE} - Result := ''; //Stop Gap, spanning support needs to be rethought for Unix -{$ENDIF} -end; - -procedure AbSetSpanVolumeLabel(Drive: Char; VolNo : Integer); -begin - AbWriteVolumeLabel(Format(AB_SPAN_VOL_LABEL, - [VolNo]), Drive); -end; - -function AbTestSpanVolumeLabel(Drive: Char; VolNo : Integer): Boolean; -var - VolLabel, TestLabel : string; -begin - TestLabel := Format(AB_SPAN_VOL_LABEL, [VolNo]); - VolLabel := UpperCase(AbGetVolumeLabel(Drive)); - Result := VolLabel = TestLabel; -end; - -{ Unicode backwards compatibility functions } -{$IFNDEF UNICODE} -function CharInSet(C: AnsiChar; CharSet: TSysCharSet): Boolean; -begin -Result := C in CharSet; -end; -{$ENDIF} - -end. diff --git a/components/Abbrevia/source/AbVMStrm.pas b/components/Abbrevia/source/AbVMStrm.pas deleted file mode 100644 index 0f7049d..0000000 --- a/components/Abbrevia/source/AbVMStrm.pas +++ /dev/null @@ -1,540 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbVMStrm.pas *} -{*********************************************************} -{* ABBREVIA: Virtual Memory Stream *} -{*********************************************************} - -unit AbVMStrm; - -{$I AbDefine.inc} - -interface - -uses - Classes; - -const - AB_VMSPageSize = 4096; {must be a power of two} - AB_VMSMaxPages = 2048; {makes 8MB with the above value} - -type - PvmsPage = ^TvmsPage; - TvmsPage = packed record - vpStmOfs : Int64; {value will be multiple of AB_VMSPageSize} - vpLRU : integer; {'time' page was last accessed} - vpDirty : Boolean; {has the page been changed?} - vpData : array [0..pred(AB_VMSPageSize)] of byte; {stream data} - end; - -type - TAbVirtualMemoryStream = class(TStream) - protected {private} - vmsCachePage : PvmsPage; {the latest page used} - vmsLRU : Longint; {'tick' value} - vmsMaxMemToUse : Longword; {maximum memory to use for data} - vmsMaxPages : Integer; {maximum data pages} - vmsPageList : TList; {page array, sorted by offset} - vmsPosition : Int64; {position of stream} - vmsSize : Int64; {size of stream} - vmsSwapFileDir : string; {swap file directory} - vmsSwapFileName : string; {swap file name} - vmsSwapFileSize : Int64; {size of swap file} - vmsSwapStream : TFileStream;{swap file stream} - protected - procedure vmsSetMaxMemToUse(aNewMem : Longword); - - function vmsAlterPageList(aNewMem : Longword) : Longword; - procedure vmsFindOldestPage(out OldestInx : Longint; - out OldestPage: PvmsPage); - function vmsGetNextLRU : Longint; - function vmsGetPageForOffset(aOffset : Int64) : PvmsPage; - - procedure vmsSwapFileCreate; - procedure vmsSwapFileDestroy; - procedure vmsSwapFileRead(aPage : PvmsPage); - procedure vmsSwapFileWrite(aPage : PvmsPage); - public - constructor Create; - {-create the virtual memory stream} - destructor Destroy; override; - {-destroy the virtual memory stream} - - function Read(var Buffer; Count : Longint) : Longint; override; - {-read from the stream into a buffer} - function Write(const Buffer; Count : Longint) : Longint; override; - {-write to the stream from a buffer} - function Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64; override; - {-seek to a particular point in the stream} - - procedure SetSize(const NewSize : Int64); override; - {-set the stream size} - - property MaxMemToUse : Longword - read vmsMaxMemToUse write vmsSetMaxMemToUse; - {-maximum memory to use for data before swapping to disk} - property SwapFileDirectory : string - read vmsSwapFileDir write vmsSwapFileDir; - end; - -implementation - -uses - {$IFDEF MSWINDOWS} - Windows, // Fix warning about unexpanded inline functions - {$ENDIF} - SysUtils, - AbExcept, - AbUtils; - -const - LastLRUValue = $7FFFFFFF; - -{===TAbVirtualMemoryStream===========================================} -constructor TAbVirtualMemoryStream.Create; -var - Page : PvmsPage; -begin - inherited Create; - {create the page array} - vmsPageList := TList.Create; - {create the first page} - New(Page); - with Page^ do begin - vpStmOfs := 0; - vpLRU := vmsGetNextLRU; - vpDirty := False; - FillChar(vpData, AB_VMSPageSize, 0); - end; - vmsPageList.Insert(0, pointer(Page)); - {prime the cache, from now on the cache will never be nil} - vmsCachePage := Page; - {default to using all allowed pages} - MaxMemToUse := AB_VMSMaxPages * AB_VMSPageSize; -end; -{--------} -destructor TAbVirtualMemoryStream.Destroy; -var - Inx : integer; -begin - {destroy the swap file} - vmsSwapFileDestroy; - {throw away all pages in the list} - if (vmsPageList <> nil) then begin - for Inx := 0 to pred(vmsPageList.Count) do - Dispose(PvmsPage(vmsPageList[Inx])); - vmsPageList.Destroy; - end; - {let our ancestor clean up} - inherited Destroy; -end; -{--------} -function TAbVirtualMemoryStream.Read(var Buffer; Count : Longint) : Longint; -var - BufPtr : PByte; - Page : PvmsPage; - PageDataInx : integer; - Posn : int64; - BytesToGo : int64; - BytesToRead : int64; - StartOfs : int64; -begin - {reading is complicated by the fact we can only read in chunks of - AB_VMSPageSize: we need to partition out the overall read into a read - from a partial page, zero or more reads from complete pages and - then a possible read from a partial page} - - {initialise some variables, note that the complex calc in the - expression for PageDataInx is the offset of the start of the page - where Posn is found.} - BufPtr := @Buffer; - Posn := vmsPosition; - PageDataInx := Posn - (Posn and (not pred(AB_VMSPageSize))); - BytesToRead := AB_VMSPageSize - PageDataInx; - {calculate the actual number of bytes to read - this depends on the - current position and size of the stream} - BytesToGo := Count; - if (vmsSize < (vmsPosition + Count)) then - BytesToGo := vmsSize - vmsPosition; - if (BytesToGo < 0) then - BytesToGo := 0; - Result := BytesToGo; - - {while we have bytes to read, read them} - while (BytesToGo <> 0) do begin - if (BytesToRead > BytesToGo) then - BytesToRead := BytesToGo; - StartOfs := Posn and (not pred(AB_VMSPageSize)); - if (vmsCachePage^.vpStmOfs = StartOfs) then - Page := vmsCachePage - else - Page := vmsGetPageForOffset(StartOfs); - Move(Page^.vpData[PageDataInx], BufPtr^, BytesToRead); - dec(BytesToGo, BytesToRead); - inc(Posn, BytesToRead); - inc(BufPtr, BytesToRead); - PageDataInx := 0; - BytesToRead := AB_VMSPageSize; - end; - {remember our new position} - vmsPosition := Posn; -end; -{--------} -function TAbVirtualMemoryStream.Seek(const Offset : Int64; - Origin : TSeekOrigin) : Int64; -begin - case Origin of - soBeginning : vmsPosition := Offset; - soCurrent : inc(vmsPosition, Offset); - soEnd : vmsPosition := vmsSize + Offset; - else - raise EAbVMSInvalidOrigin.Create( Integer(Origin)); - end; - Result := vmsPosition; -end; -{--------} -procedure TAbVirtualMemoryStream.SetSize(const NewSize : Int64); -var - Page : PvmsPage; - Inx : integer; - NewFileSize : Int64; -begin - if (NewSize < vmsSize) then begin - {go through the page list discarding pages whose offset is greater - than our new size; don't bother saving any data from them since - it be beyond the end of the stream anyway} - {never delete the last page here} - for Inx := pred(vmsPageList.Count) downto 1 do begin - Page := PvmsPage(vmsPageList[Inx]); - if (Page^.vpStmOfs >= NewSize) then begin - Dispose(Page); - vmsPageList.Delete(Inx); - end else begin - Break; - end; - end; - - { Reset cache to the first page in case the cached page was deleted. } - vmsCachePage := vmsPageList[0]; - - {force the swap file file size in range, it'll be a multiple of - AB_VMSPageSize} - NewFileSize := pred(NewSize + AB_VMSPageSize) and - (not pred(AB_VMSPageSize)); - if (NewFileSize < vmsSwapFileSize) then - vmsSwapFileSize := NewFileSize; - {ignore the swap file itself} - end; - vmsSize := NewSize; - if (vmsPosition > NewSize) then - vmsPosition := NewSize; -end; -{--------} -function TAbVirtualMemoryStream.vmsAlterPageList(aNewMem : Longword) : Longword; -var - NumPages : Longint; - Page : PvmsPage; - i : integer; - OldestPageNum : Longint; -begin - {calculate the max number of pages required} - if aNewMem = 0 then - NumPages := 1 // always have at least one page - else - NumPages := pred(aNewMem + AB_VMSPageSize) div AB_VMSPageSize; - if (NumPages > AB_VMSMaxPages) then - NumPages := AB_VMSMaxPages; - {if the maximum number of pages means we have to shrink the current - list, do so, tossing out the oldest pages first} - if (NumPages < vmsPageList.Count) then - begin - for i := 1 to (vmsPageList.Count - NumPages) do begin - {find the oldest page} - vmsFindOldestPage(OldestPageNum, Page); - {if it is dirty, write it out to the swap file} - if Page^.vpDirty then begin - vmsSwapFileWrite(Page); - end; - {remove it from the page list} - vmsPageList.Delete(OldestPageNum); - {free the page memory} - Dispose(Page); - end; - - { Reset cache to the first page in case the cached page was deleted. } - vmsCachePage := vmsPageList[0]; - end; - {remember our new max number of pages} - vmsMaxPages := NumPages; - Result := NumPages * AB_VMSPageSize; -end; -{--------} -procedure TAbVirtualMemoryStream.vmsFindOldestPage(out OldestInx : Longint; - out OldestPage: PvmsPage); -var - OldestLRU : Longint; - Inx : integer; - Page : PvmsPage; -begin - OldestInx := -1; - OldestLRU := LastLRUValue; - for Inx := 0 to pred(vmsPageList.Count) do begin - Page := PvmsPage(vmsPageList[Inx]); - if (Page^.vpLRU < OldestLRU) then begin - OldestInx := Inx; - OldestLRU := Page^.vpLRU; - OldestPage := Page; - end; - end; -end; -{--------} -function TAbVirtualMemoryStream.vmsGetNextLRU : Longint; -var - Inx : integer; -begin - if (vmsLRU = LastLRUValue) then begin - {reset all LRUs in list} - for Inx := 0 to pred(vmsPageList.Count) do - PvmsPage(vmsPageList[Inx])^.vpLRU := 0; - vmsLRU := 0; - end; - inc(vmsLRU); - Result := vmsLRU; -end; -{--------} -function TAbVirtualMemoryStream.vmsGetPageForOffset(aOffset : Int64) : PvmsPage; -var - Page : PvmsPage; - PageOfs : Int64; - L, M, R : integer; - OldestPageNum : integer; - CreatedNewPage: boolean; -begin - {using a sequential or a binary search (depending on the number of - pages), try to find the page in the cache; we'll do a sequential - search if the number of pages is very small, eg less than 4} - if (vmsPageList.Count < 4) then begin - L := vmsPageList.Count; - for M := 0 to pred(vmsPageList.Count) do begin - Page := PvmsPage(vmsPageList[M]); - PageOfs := Page^.vpStmOfs; - if (aOffset < PageOfs) then begin - L := M; - Break; - end; - if (aOffset = PageOfs) then begin - Page^.vpLRU := vmsGetNextLRU; - vmsCachePage := Page; - Result := Page; - Exit; - end; - end; - end - else {we need to do a binary search} begin - L := 0; - R := pred(vmsPageList.Count); - repeat - M := (L + R) div 2; - Page := PvmsPage(vmsPageList[M]); - PageOfs := Page^.vpStmOfs; - if (aOffset < PageOfs) then - R := pred(M) - else if (aOffset > PageOfs) then - L := succ(M) - else {aOffset = PageOfs} begin - Page^.vpLRU := vmsGetNextLRU; - vmsCachePage := Page; - Result := Page; - Exit; - end; - until (L > R); - end; - {if we get here the page for the offset is not present in the page - list, and once created/loaded, the page should be inserted at L} - - {enter a try..except block so that if a new page is created and an - exception occurs, the page is freed} - CreatedNewPage := false; - Result := nil; - try - {if there is room to insert a new page, create one ready} - if (vmsPageList.Count < vmsMaxPages) then begin - New(Page); - CreatedNewPage := true; - end - {otherwise there is no room for the insertion, so find the oldest - page in the list and discard it} - else {vmsMaxPages <= vmsPageList.Count} begin - {find the oldest page} - vmsFindOldestPage(OldestPageNum, Page); - {if it is dirty, write it out to the swap file} - if Page^.vpDirty then begin - vmsSwapFileWrite(Page); - end; - {remove it from the page list} - vmsPageList.Delete(OldestPageNum); - {patch up the insertion point, in case the page just deleted was - before it} - if (OldestPageNum < L) then - dec(L); - end; - {set all the page fields} - with Page^ do begin - vpStmOfs := aOffset; - vpLRU := vmsGetNextLRU; - vpDirty := False; - vmsSwapFileRead(Page); - end; - {insert the page into the correct spot} - vmsPageList.Insert(L, pointer(Page)); - {return the page, remembering to save it in the cache} - vmsCachePage := Page; - Result := Page; - except - if CreatedNewPage then - Dispose(Page); - end;{try..except} -end; -{--------} -procedure TAbVirtualMemoryStream.vmsSetMaxMemToUse(aNewMem : Longword); -begin - vmsMaxMemToUse := vmsAlterPageList(aNewMem); -end; -{--------} -procedure TAbVirtualMemoryStream.vmsSwapFileCreate; -begin - if (vmsSwapStream = nil) then begin - vmsSwapFileName := AbCreateTempFile(vmsSwapFileDir); - try - vmsSwapStream := TFileStream.Create(vmsSwapFileName, fmCreate); - except - DeleteFile(vmsSwapFileName); - raise EAbVMSErrorOpenSwap.Create( vmsSwapFileName ); - end; - vmsSwapFileSize := 0; - end; -end; -{--------} -procedure TAbVirtualMemoryStream.vmsSwapFileDestroy; -begin - if (vmsSwapStream <> nil) then begin - FreeAndNil(vmsSwapStream); - DeleteFile(vmsSwapFileName); - end; -end; -{--------} -procedure TAbVirtualMemoryStream.vmsSwapFileRead(aPage : PvmsPage); -var - BytesRead : Longint; - SeekResult: Int64; -begin - if (vmsSwapStream = nil) or (aPage^.vpStmOfs >= vmsSwapFileSize) then begin - {there is nothing to be read from the disk (either the swap file - doesn't exist or it's too small) so zero out the page data} - FillChar(aPage^.vpData, AB_VMSPageSize, 0) - end - else {there is something to be read from the swap file} begin - SeekResult := vmsSwapStream.Seek(aPage^.vpStmOfs, soBeginning); - if (SeekResult = -1) then - raise EAbVMSSeekFail.Create( vmsSwapFileName ); - BytesRead := vmsSwapStream.Read(aPage^.vpData, AB_VMSPageSize); - if (BytesRead <> AB_VMSPageSize) then - raise EAbVMSReadFail.Create( AB_VMSPageSize, vmsSwapFileName ); - end; -end; -{--------} -procedure TAbVirtualMemoryStream.vmsSwapFileWrite(aPage : PvmsPage); -var - NewPos : Int64; - SeekResult: Int64; - BytesWritten : Longint; -begin - if (vmsSwapStream = nil) then - vmsSwapFileCreate; - SeekResult := vmsSwapStream.Seek(aPage^.vpStmOfs, soBeginning); - if (SeekResult = -1) then - raise EAbVMSSeekFail.Create( vmsSwapFileName ); - BytesWritten := vmsSwapStream.Write(aPage^.vpData, AB_VMSPageSize); - if BytesWritten <> AB_VMSPageSize then - raise EAbVMSWriteFail.Create( AB_VMSPageSize, vmsSwapFileName ); - NewPos := aPage^.vpStmOfs + AB_VMSPageSize; - if (NewPos > vmsSwapFileSize) then - vmsSwapFileSize := NewPos; -end; -{--------} -function TAbVirtualMemoryStream.Write(const Buffer; Count : Longint) : Longint; -var - BufPtr : PByte; - Page : PvmsPage; - PageDataInx : integer; - Posn : Int64; - BytesToGo : Int64; - BytesToWrite: Int64; - StartOfs : Int64; -begin - {writing is complicated by the fact we can only write in chunks of - AB_VMSPageSize: we need to partition out the overall write into a - write to a partial page, zero or more writes to complete pages and - then a possible write to a partial page} - - {initialise some variables, note that the complex calc in the - expression for PageDataInx is the offset of the start of the page - where Posn is found.} - BufPtr := @Buffer; - Posn := vmsPosition; - PageDataInx := Posn - (Posn and (not pred(AB_VMSPageSize))); - BytesToWrite := AB_VMSPageSize - PageDataInx; - {calculate the actual number of bytes to write} - BytesToGo := Count; - Result := BytesToGo; - - {while we have bytes to write, write them} - while (BytesToGo <> 0) do begin - if (BytesToWrite > BytesToGo) then - BytesToWrite := BytesToGo; - StartOfs := Posn and (not pred(AB_VMSPageSize)); - if (vmsCachePage^.vpStmOfs = StartOfs) then - Page := vmsCachePage - else - Page := vmsGetPageForOffset(StartOfs); - Move(BufPtr^, Page^.vpData[PageDataInx], BytesToWrite); - Page^.vpDirty := True; - dec(BytesToGo, BytesToWrite); - inc(Posn, BytesToWrite); - inc(BufPtr, BytesToWrite); - PageDataInx := 0; - BytesToWrite := AB_VMSPageSize; - end; - {remember our new position} - vmsPosition := Posn; - {if we've grown the stream, make a note of it} - if (vmsPosition > vmsSize) then - vmsSize := vmsPosition; -end; -{====================================================================} - -end. diff --git a/components/Abbrevia/source/AbView.pas b/components/Abbrevia/source/AbView.pas deleted file mode 100644 index 44d7a6f..0000000 --- a/components/Abbrevia/source/AbView.pas +++ /dev/null @@ -1,1657 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbView.pas *} -{*********************************************************} -{* ABBREVIA: Base archive viewer component *} -{* Use AbQView.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbView; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses - Classes, - Types, -{$IFDEF MSWINDOWS} - Windows, - Messages, -{$ENDIF} -{$IFDEF LibcAPI} - Libc, -{$ENDIF} -{$IFDEF UsingCLX } - Qt, - QControls, - QGraphics, - QGrids, -{$ELSE} - Controls, - Graphics, - Grids, -{$ENDIF} - AbArcTyp; - -type - TAbViewAttribute = - (vaItemName, vaPacked, vaMethod, vaRatio, vaCRC, - vaFileAttributes, vaFileType, vaEncryption, vaTimeStamp, - vaFileSize, vaVersionMade, vaVersionNeeded, vaPath); - TAbViewAttributes = set of TAbViewAttribute; - - TAbDisplayOption = - (doAlternateColors, doColLines, doColMove, doColSizing, doMultiSelect, - doRowLines, doShowIcons, doThumbTrack, doTrackActiveRow); - TAbDisplayOptions = set of TAbDisplayOption; - - TAbSortAttribute = - (saItemName, saPacked, saPath, saRatio, saTimeStamp, saFileSize); - TAbSortAttributes = set of TAbSortAttribute; - -const - AbDefColWidth = 150; - AbDefRowHeight = 24; - AbHeaderRow = 0; - AbDefSelColor = clHighlight; - AbDefSelTextColor = clHighlightText; - AbDefHighColor = clAqua; - AbDefHighTextColor = clRed; - AbDefDelColor = clYellow; - AbDefDelTextColor = clNavy; - - -{ ===== TAbColors ========================================================== } -type - TAbColors = class(TPersistent) - protected {private} - FSelected : TColor; - FSelectedText : TColor; - FAlternate : TColor; - FAlternateText : TColor; - FDeleted : TColor; - FDeletedText : TColor; - FUpdating : Boolean; - FOnChange : TNotifyEvent; - procedure DoOnChange; - procedure SetSelected(Value : TColor); - procedure SetSelectedText(Value : TColor); - procedure SetAlternate(Value : TColor); - procedure SetAlternateText(Value : TColor); - procedure SetDeleted(Value : TColor); - procedure SetDeletedText(Value : TColor); - public - procedure BeginUpdate; - procedure EndUpdate; - property OnChange : TNotifyEvent - read FOnChange - write FOnChange; - published - property Selected : TColor - read FSelected - write SetSelected; - property SelectedText : TColor - read FSelectedText - write SetSelectedText; - property Alternate : TColor - read FAlternate - write SetAlternate; - property AlternateText : TColor - read FAlternateText - write SetAlternateText; - property Deleted : TColor - read FDeleted - write SetDeleted; - property DeletedText : TColor - read FDeletedText - write SetDeletedText; - end; - - -{ ===== TAbSelList ========================================================= } -type - TAbSelList = class - protected {private} - FList : TList; - FCurrent : Longint; - public {methods} - constructor Create; - destructor Destroy; - override; - procedure Clear; - procedure Deselect(Index : Longint); - function IsSelected(Index : Longint) : Boolean; - procedure Select(Index : Longint); - procedure SelectAll(Count : Longint); - function SelCount : Longint; - procedure Toggle(Index : Longint); - function FindFirst : Longint; - function FindNext : Longint; - end; - - -{ ===== TAbRowMap ========================================================== } -type - TAbRowMap = class - protected {private} - FRows : TList; - FInvRows : TList; - FSortAscending : Boolean; - function GetRow(RowNum : Longint) : Longint; - function GetInvRow(RowNum : Longint) : Longint; - procedure SortOnItemName(ItemList : TAbArchiveList); - procedure SortOnItemDir(ItemList : TAbArchiveList); - public {methods} - constructor Create; - destructor Destroy; - override; - procedure Clear; - procedure Init(RowCount : Longint); - procedure SortBy(Attr : TAbSortAttribute; ItemList : TAbArchiveList); - public {properties} - property Rows[RowNum : Longint] : Longint - read GetRow; default; - property InvRows[RowNum : Longint] : Longint - read GetInvRow; - property SortAscending : Boolean - read FSortAscending; - end; - - -{ ===== TAbBaseViewer ==================================================== } -type - TAbColHeadings = class(TStringList) - end; - TAbSortedEvent = - procedure (Sender : TObject; Attr : TAbViewAttribute) of object; - TAbDrawSortArrowEvent = - procedure (Sender : TObject; Column : Integer; Ascending: Boolean; - Cnv: TCanvas; Rect : TRect) of object; - - TAbBaseViewer = class(TCustomGrid) - protected {private} - FAllowInvalidate : Boolean; - FAttributes : TAbViewAttributes; - FDisplayOptions : TAbDisplayOptions; - FSortAttributes : TAbSortAttributes; - FColMap : array[TAbViewAttribute] of Integer; - FColSizing : Boolean; - FColMoving : Boolean; - FHeadings : TAbColHeadings; - FItemList : TAbArchiveList; - FRowMap : TAbRowMap; - FFileName : string; - FFontSize : Integer; - FItemIndex : Longint; - FColors : TAbColors; - FButtonDown : Boolean; - FIcons : TStringList; - FSelList : TAbSelList; - FMultiSelecting : Boolean; - FShiftState : TShiftState; - FSortCol : Integer; - RowAnchor : Longint; - ViewMouseCoord : TGridCoord; - - FOnChange : TNotifyEvent; - FOnClick : TNotifyEvent; - FOnDblClick : TNotifyEvent; - FOnSorted : TAbSortedEvent; - FOnDrawSortArrow : TAbDrawSortArrowEvent; - - function AttrToSortAttribute(Attr : TAbViewAttribute; - var SortAttr : TAbSortAttribute) : Boolean; - function AttrToStr(Attr : TAbViewAttribute; aItem : TAbArchiveItem) : string; - function ColMap(ColNum : Integer) : Integer; - procedure ColorsChange(Sender : TObject); - procedure DrawHeaderButton(ACol : Integer; const AText : string); - procedure DrawSortArrow; - function DrawTextFormat(Attr : TAbViewAttribute; var Rect : TRect) : Word; - function GetCount : Longint; - function GetActiveRow : Longint; - function GetHeaderRowHeight : Integer; -{$IFDEF MSWINDOWS} - function GetIcon(const ItemName : string) : HIcon; -{$ENDIF} -{$IFDEF UsingClx} - { no file type icons in Clx } -{$ENDIF} - function GetSelCount : Longint; - function GetSelected(RowNum : Longint) : Boolean; - function GetVersion : string; - procedure InitColMap; - procedure InvalidateRow(ARow: Longint); - procedure MoveColumn(FromCol, ToCol : Integer); - procedure RefreshCell(ARow, ACol: Longint); - procedure RefreshRow(ARow: Longint); - procedure SetActiveRow(RowNum : Longint); - procedure SetAttributes(Value : TAbViewAttributes); - procedure SetDisplayOptions(Value : TAbDisplayOptions); - procedure SetSortAttributes(Value : TAbSortAttributes); - procedure SetHeaderRowHeight(Value : Integer); - procedure SetHeadings(Value: TAbColHeadings); - procedure SetSelected(RowNum : Longint; Value : Boolean); - procedure SetVersion(const Value : string); - function UpdateColCount(Attributes : TAbViewAttributes) : Integer; -{$IFDEF UsingCLX} - procedure FontChanged; override; - procedure SizeChanged(OldColCount, OldRowCount: Longint); override; -{$ELSE} - procedure WMSize(var Msg: TWMSize); - message WM_SIZE; - procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); - message WM_ERASEBKGND; - procedure CMFontChanged(var Message: TMessage); - message CM_FONTCHANGED; -{$ENDIF UsingCLX} - - protected {overridden methods} - procedure Click; - override; - procedure DblClick; - override; - procedure KeyDown(var Key: Word; Shift: TShiftState); - override; - procedure KeyUp(var Key: Word; Shift: TShiftState); - override; - procedure Loaded; - override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y : Integer); - override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - override; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); - override; - procedure ColumnMoved(FromIndex, ToIndex: Longint); - override; -{$IFDEF HasGridDrawingStyle} - procedure Paint; - override; -{$ENDIF} - procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); - override; - procedure TopLeftChanged; - override; - - protected {virtual methods} - procedure DoChange(Sender : TObject); - virtual; - procedure DoLoad(Sender : TObject); - virtual; - procedure DoSorted(Attr : TAbViewAttribute); - virtual; - - protected {properties} - property Attributes : TAbViewAttributes - read FAttributes - write SetAttributes; - property DisplayOptions : TAbDisplayOptions - read FDisplayOptions - write SetDisplayOptions; - property HeaderRowHeight : Integer - read GetHeaderRowHeight - write SetHeaderRowHeight; - property Headings : TAbColHeadings - read FHeadings - write SetHeadings; - property ItemList : TAbArchiveList - read FItemList - write FItemList; - property SortAttributes : TAbSortAttributes - read FSortAttributes - write SetSortAttributes; - property Version : string - read GetVersion - write SetVersion - stored False; - - protected {events} - property OnChange : TNotifyEvent - read FOnChange - write FOnChange; - property OnClick : TNotifyEvent - read FOnClick - write FOnClick; - property OnDblClick : TNotifyEvent - read FOnDblClick - write FOnDblClick; - property OnSorted : TAbSortedEvent - read FOnSorted - write FOnSorted; - property OnDrawSortArrow : TAbDrawSortArrowEvent - read FOnDrawSortArrow - write FOnDrawSortArrow; - - public {methods} - constructor Create(AOwner : TComponent); - override; - destructor Destroy; - override; - procedure BeginUpdate; - procedure EndUpdate; - procedure ClearSelections; - procedure SelectAll; - - public {run-time properties} - property ActiveRow : Longint - read GetActiveRow write SetActiveRow; - property Colors : TAbColors - read FColors write FColors; - property Count : Longint - read GetCount; - property SelCount : Longint - read GetSelCount; - property Selected[RowNum : Longint] : Boolean - read GetSelected write SetSelected; - - property ColWidths; - property RowHeights; - published - property OnDragDrop; - property OnDragOver; - end; - - -implementation - -uses -{$IFDEF MSWINDOWS} - ShellApi, -{$ENDIF} -{$IFDEF HasUITypes} - UITypes, -{$ENDIF} - SysUtils, - AbUtils, - AbConst, - AbResString, - AbZipTyp; - -{ ===== TAbColors ========================================================== } -procedure TAbColors.BeginUpdate; -begin - FUpdating := True; -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.EndUpdate; -begin - FUpdating := False; - DoOnChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.DoOnChange; -begin - if not FUpdating and Assigned(FOnChange) then - FOnChange(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.SetSelected(Value : TColor); -begin - if (Value <> FSelected) then begin - FSelected := Value; - DoOnChange; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.SetSelectedText(Value : TColor); -begin - if (Value <> FSelectedText) then begin - FSelectedText := Value; - DoOnChange; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.SetAlternate(Value : TColor); -begin - if (Value <> FAlternate) then begin - FAlternate := Value; - DoOnChange; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.SetAlternateText(Value : TColor); -begin - if (Value <> FAlternateText) then begin - FAlternateText := Value; - DoOnChange; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.SetDeleted(Value : TColor); -begin - if (Value <> FDeleted) then begin - FDeleted := Value; - DoOnChange; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbColors.SetDeletedText(Value : TColor); -begin - if (Value <> FDeletedText) then begin - FDeletedText := Value; - DoOnChange; - end; -end; - - -{ ===== TAbSelList ========================================================= } -constructor TAbSelList.Create; -begin - FList := TList.Create; - FCurrent := -1; -end; -{ -------------------------------------------------------------------------- } -destructor TAbSelList.Destroy; -begin - FList.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbSelList.Clear; -begin - FList.Clear; - FCurrent := -1; -end; -{ -------------------------------------------------------------------------- } -procedure TAbSelList.Select(Index: Longint); -begin - if FList.IndexOf(Pointer(Index)) < 0 then - FList.Add(Pointer(Index)); -end; -{ -------------------------------------------------------------------------- } -procedure TAbSelList.Deselect(Index: Longint); -var - i : Longint; -begin - i := FList.IndexOf(Pointer(Index)); - if (i >= 0) then - FList.Delete(i); -end; -{ -------------------------------------------------------------------------- } -function TAbSelList.IsSelected(Index : Longint) : Boolean; -begin - Result := FList.IndexOf(Pointer(Index)) >= 0; -end; -{ -------------------------------------------------------------------------- } -procedure TAbSelList.Toggle(Index: Longint); -begin - if IsSelected(Index) then - Deselect(Index) - else - Select(Index); -end; -{ -------------------------------------------------------------------------- } -function TAbSelList.SelCount : Longint; -begin - Result := FList.Count; -end; -{ -------------------------------------------------------------------------- } -procedure TAbSelList.SelectAll(Count : Longint); -var - i : Longint; -begin - for i := 0 to Pred(Count) do - Select(i); -end; -{ -------------------------------------------------------------------------- } -function TAbSelList.FindFirst : Longint; -begin - FCurrent := -1; - if (FList.Count > 0) then - Result := FindNext - else - Result := -1; -end; -{ -------------------------------------------------------------------------- } -function TAbSelList.FindNext : Longint; -begin - if (FList.Count > 0) and (FCurrent < Pred(FList.Count)) then begin - Inc(FCurrent); - Result := Longint(FList[FCurrent]); - end else - Result := -1; -end; - - -{ ===== TAbRowMap ========================================================== } -procedure TAbRowMap.Clear; -begin - FRows.Clear; - FInvRows.Clear; -end; -{ -------------------------------------------------------------------------- } -function TAbRowMap.GetRow(RowNum : Longint) : Longint; -begin - if (RowNum >= 0) and (RowNum < FRows.Count) then - Result := Longint(FRows[RowNum]) - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbRowMap.GetInvRow(RowNum : Longint) : Longint; -begin - if (RowNum >= 0) and (RowNum < FInvRows.Count) then - Result := Longint(FInvRows[RowNum]) - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -constructor TAbRowMap.Create; -begin - inherited Create; - FRows := TList.Create; - FInvRows := TList.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbRowMap.Init(RowCount : Longint); -var - i : Longint; -begin - Clear; - if (RowCount > 0) then - for i := 0 to Pred(RowCount) do begin - FRows.Add(Pointer(i)); - FInvRows.Add(Pointer(i)); - end; -end; -{ -------------------------------------------------------------------------- } -destructor TAbRowMap.Destroy; -begin - FRows.Free; - FInvRows.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbRowMap.SortBy(Attr : TAbSortAttribute; ItemList : TAbArchiveList); -type - PSortRec = ^TSortRec; - TSortRec = record - Val : Double; - Index : Longint; - end; -var - i, LI : Longint; - SL : TList; - RowCount : Longint; - P : PSortRec; - DT : TDateTime; - aItem : TAbArchiveItem; - - procedure QuickSort(SL : TList; L, R: Integer); - var - i, j: Integer; - P: PSortRec; - begin - i := L; - j := R; - P := SL[(L + R) shr 1]; - repeat - while PSortRec(SL[i])^.Val < P^.Val do Inc(i); - while PSortRec(SL[j])^.Val > P^.Val do Dec(j); - if (i <= j) then - begin - SL.Exchange(i, j); - Inc(i); - Dec(j); - end; - until i > j; - if L < j then QuickSort(SL, L, j); - if i < R then QuickSort(SL, i, R); - end; - -begin - if (ItemList.Count <= 0) then - Exit; - case Attr of - saItemName : SortOnItemName(ItemList); - saPath : SortOnItemDir(ItemList); - else begin - RowCount := ItemList.Count; - SL := TList.Create; - try {SL} - SL.Capacity := RowCount; - for i := 0 to Pred(RowCount) do begin - GetMem(P, SizeOf(TSortRec)); - aItem := TAbArchiveItem(ItemList.Items[i]); - case Attr of - saPacked : P^.Val := aItem.CompressedSize; - saRatio : - begin - if (aItem is TAbZipItem) then - P^.Val := TAbZipItem(aItem).CompressionRatio - else - P^.Val := 0; - end; - saFileSize : P^.Val := aItem.UnCompressedSize; - saTimeStamp : begin - LI := LongInt(aItem.LastModFileDate) shl 16 + - aItem.LastModFileTime; - DT := FileDateToDateTime(LI); - P^.Val := Double(DT); - end; - end; - P^.Index := i; - SL.Add(P); - end; - QuickSort(SL, 0, Pred(SL.Count)); - for i := 0 to Pred(SL.Count) do begin - if FSortAscending then - P := SL[i] - else - P := SL[Pred(SL.Count) - i]; - FRows[i] := Pointer(P^.Index) - end; - finally {SL} - while (SL.Count > 0) do begin - FreeMem(SL[0], Sizeof(TSortRec)); - SL.Delete(0); - end; - SL.Free; - end; {SL} - end; - end; - - FSortAscending := not FSortAscending; - for i := 0 to Pred(ItemList.Count) do - FInvRows[Rows[i]] := Pointer(i); -end; -{ -------------------------------------------------------------------------- } -procedure TAbRowMap.SortOnItemName(ItemList : TAbArchiveList); -var - i, RowCount : Longint; - SL : TStringList; - FN : string; -begin - RowCount := ItemList.Count; - SL := TStringList.Create; - try {SL} - for i := 0 to Pred(RowCount) do begin - FN := TAbArchiveItem(ItemList.Items[i]).Filename; - AbUnFixName(FN); - SL.AddObject(ExtractFilename(FN), Pointer(i)); - end; - SL.Sort; - for i := 0 to Pred(RowCount) do begin - if FSortAscending then - FRows[i] := SL.Objects[i] - else - FRows[i] := SL.Objects[Pred(RowCount) - i]; - end; - finally {SL} - SL.Free; - end; {SL} -end; - -{ -------------------------------------------------------------------------- } -procedure TAbRowMap.SortOnItemDir(ItemList : TAbArchiveList); -var - i, RowCount : Longint; - SL : TStringList; - FN : string; -begin - RowCount := ItemList.Count; - SL := TStringList.Create; - try {SL} - for i := 0 to Pred(RowCount) do begin - FN := TAbArchiveItem(ItemList.Items[i]).DiskPath; - AbUnFixName(FN); - SL.AddObject(ExtractFilePath(FN), Pointer(i)); - end; - SL.Sort; - for i := 0 to Pred(RowCount) do begin - if FSortAscending then - FRows[i] := SL.Objects[i] - else - FRows[i] := SL.Objects[Pred(RowCount) - i]; - end; - finally {SL} - SL.Free; - end; {SL} -end; - -{===== TAbBaseViewer ===============================================} -constructor TAbBaseViewer.Create(AOwner : TComponent); -begin - inherited Create(AOwner); - - FItemList := TAbArchiveList.Create(False); - - RowCount := 2; - FixedCols := 0; - FixedRows := 1; {Header Row} - FSortCol := -1; - Color := clWindow; - FColors := TAbColors.Create; - FColors.OnChange := ColorsChange; - FColors.Selected := AbDefSelColor; - FColors.SelectedText := AbDefSelTextColor; - FColors.Alternate := AbDefHighColor; - FColors.AlternateText := AbDefHighTextColor; - FColors.Deleted := AbDefDelColor; - FColors.DeletedText := AbDefDelTextColor; - DefaultColWidth := AbDefColWidth; - DefaultRowHeight := AbDefRowHeight; - DefaultDrawing := False; - ParentColor := False; -{$IFNDEF UsingCLX} - ParentCtl3D := True; -{$ENDIF} - ParentFont := True; - ParentShowHint := True; - FHeadings := TAbColHeadings.Create; - InitColMap; - FColSizing := False; - FColMoving := False; - FAllowInvalidate := True; - FRowMap := TAbRowMap.Create; - FIcons := TStringList.Create; - FSelList := TAbSelList.Create; - Attributes := [vaItemname, vaPacked, vaTimeStamp, vaFileSize, vaPath]; - SetDisplayOptions([doColSizing]); - Visible := True; -end; -{ -------------------------------------------------------------------------- } -destructor TAbBaseViewer.Destroy; -begin - FRowMap.Free; - FHeadings.Free; - FColors.Free; - FIcons.Free; - FSelList.Free; - FItemList.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.AttrToSortAttribute(Attr : TAbViewAttribute; - var SortAttr : TAbSortAttribute) : Boolean; -begin - Result := True; - case Attr of - vaItemName : SortAttr := saItemName; - vaPacked : SortAttr := saPacked; - vaFileSize : SortAttr := saFileSize; - vaRatio : SortAttr := saRatio; - vaTimeStamp : SortAttr := saTimeStamp; - vaPath : SortAttr := saPath; - else - Result := False; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.AttrToStr(Attr : TAbViewAttribute; - aItem : TAbArchiveItem) : string; -var - FN : string; - LI : Longint; -begin - Result := ''; - if Attr in [vaItemName, vaPath] then begin - FN := aItem.Filename; - AbUnFixName(FN); - end; - - {first take care of common attributes} - with aItem do case Attr of - vaCRC : - Result := IntToHex(CRC32, 8); - vaItemname : - Result := ExtractFilename(FN); - vaPacked : - Result := IntToStr(CompressedSize); - vaFileSize : - Result := IntToStr(UncompressedSize); - vaFileAttributes : - begin -{$IFDEF MSWINDOWS} -{$WARN SYMBOL_PLATFORM OFF} - if (faReadOnly and ExternalFileAttributes) = faReadOnly then - Result := Result + AbReadOnlyS; - if (faHidden and ExternalFileAttributes) = faHidden then - Result := Result + AbHiddenS; - if (faSysFile and ExternalFileAttributes) = faSysFile then - Result := Result + AbSystemS; - if (faArchive and ExternalFileAttributes) = faArchive then - Result := Result + AbArchivedS; -{$WARN SYMBOL_PLATFORM OFF} -{$ENDIF MSWINDOWS} - end; - vaEncryption : - if IsEncrypted then - Result := AbEncryptedS; - vaTimeStamp : - if (LastModFileDate + LastModFileTime = 0) then - Result := AbUnknownS - else begin - LI := LongInt(LastModFileDate) shl 16 + LastModFileTime; - Result := DateTimeToStr(FileDateToDateTime(LI)); - end; - vaPath : - Result := DiskPath; - end; - - {now handle the zip specific attributes} - if (aItem is TAbZipItem) then with TAbZipItem(aItem) do case Attr of - vaFileType : - if (InternalFileAttributes = 1) then - Result := AbTextS - else - Result := AbBinaryS; - vaMethod : - Result := ZipCompressionMethodToString(CompressionMethod); - vaRatio : - Result := IntToStr(Round(CompressionRatio)); - vaVersionMade : - Result := IntToStr(Round(Lo(VersionMadeBy)/ 10.0)); - vaVersionNeeded : - Result := IntToStr(Round(Lo(VersionNeededToExtract)/ 10.0)); - end; -{$IFDEF LINUX} - Result := ' ' + Result; -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.BeginUpdate; -begin - FAllowInvalidate := False; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.EndUpdate; -begin - FAllowInvalidate := True; - Refresh; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.ClearSelections; -var - i : Longint; -begin - if (FSelList.SelCount > 0) then begin - i := FSelList.FindFirst; - repeat - InvalidateRow(FRowMap.InvRows[i]+1); - i := FSelList.FindNext; - until (i < 0); - FSelList.Clear; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.Click; - {Here is the logic for MultiSelect} -var - i : Longint; -begin - inherited Click; - if Assigned(FItemList) and (FItemList.Count > 0) then begin - if (ssCtrl in FShiftState) and (doMultiSelect in FDisplayOptions) then - Selected[ActiveRow] := not Selected[ActiveRow] - else begin - if not ((ssShift in FShiftState) and - (doMultiSelect in FDisplayOptions)) then begin - ClearSelections; - Selected[ActiveRow] := True; - end else begin - ClearSelections; - if (RowAnchor < ActiveRow) then - for i := RowAnchor to ActiveRow do - Selected[i] := True - else - for i := ActiveRow to RowAnchor do - Selected[i] := True; - end; - end; - Update; - if Assigned(FOnClick) then - FOnClick(Self); - end; -end; -{ -------------------------------------------------------------------------- } -{$IFDEF UsingCLX} -procedure TAbBaseViewer.FontChanged; -{$ELSE} -procedure TAbBaseViewer.CMFontChanged(var Message: TMessage); -{$ENDIF} -begin - inherited; - if not (csLoading in ComponentState) then begin - Canvas.Font := Font; - DefaultRowHeight := Canvas.TextHeight('W') + 2; - HeaderRowHeight := Canvas.TextHeight('W') + 4; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.ColMap(ColNum : Integer) : Integer; -begin - Result := FColMap[TAbViewAttribute(ColNum)]; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.ColorsChange(Sender : TObject); -begin - Invalidate; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.ColumnMoved(FromIndex, ToIndex : Longint); -begin - MoveColumn(FromIndex, ToIndex); - Invalidate; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.DblClick; - {Dont pass along the event if double click in header} -begin - inherited DblClick; - if (ViewMouseCoord.Y <> abHeaderRow) then - if Assigned(FItemList) and (FItemList.Count > 0) then - if Assigned(FOnDblClick) then - FOnDblClick(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.DoChange; -begin - RowCount := 2; {HeaderRow + 1} - FSelList.Clear; - if Assigned(FItemList) then begin - FRowMap.Init(FItemList.Count); - if (FItemList.Count > 0) then - RowCount := FItemList.Count + 1 - else begin -{ RefreshRow(1);} - FSortCol := -1; - end; - end; - if FAllowInvalidate then - Refresh; - if Assigned(FOnChange) then - FOnChange(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.DoLoad; -begin - FIcons.Clear; - FSelList.Clear; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.DoSorted(Attr : TAbViewAttribute); -begin - DrawSortArrow; - if Assigned(FOnSorted) then - FOnSorted(Self, Attr); -end; -{ -------------------------------------------------------------------------- } -{$IFDEF HasGridDrawingStyle} -procedure TAbBaseViewer.Paint; -begin - DefaultDrawing := FInternalDrawingStyle <> gdsClassic; - inherited; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.DrawCell(ACol, ARow: Longint; ARect: TRect; - AState: TGridDrawState); -var - s : string; - aItem : TAbArchiveItem; - TxtRect : TRect; - Attr : TAbViewAttribute; - DTFormat : Word; -{$IFNDEF UsingClx} - H : Integer; - Icon : HIcon; -{$ENDIF} -begin -{$IFDEF LINUX} - if not DefaultDrawing then - DefaultDrawing := true; -{$ENDIF} - - Canvas.Font := Font; - if (ARow = AbHeaderRow) then begin - DrawHeaderButton(ACol, FHeadings[ColMap(ACol)]) - end else if not FAllowInvalidate then {waiting for EndUpdate} - Exit - else with Canvas do begin - if not (doColLines in DisplayOptions) then - ARect.Right := ARect.Right + 1; - Brush.Color := clWindow; - if (not Assigned(FItemList)) or (FItemList.Count = 0) then begin - if not DefaultDrawing then Canvas.FillRect(ARect); - Exit; - end; - - aItem := FItemList.Items[FRowMap[ARow-1]]; - Attr := TAbViewAttribute(ColMap(ACol)); - S := AttrToStr(Attr, aItem); - if (gdSelected in AState) or FSelList.IsSelected(FRowMap[ARow-1]) then begin - if not DefaultDrawing then begin - Brush.Color := FColors.Selected; - Font.Color := FColors.SelectedText; - end -{$IFDEF HasGridDrawingStyle} - else begin - if DrawingStyle = gdsGradient then - Canvas.Font.Color := clHighlightText; - if not (gdSelected in AState) then begin - if (goRowSelect in Options) then - Include(AState, gdRowSelected); - DrawCellHighlight(ARect, AState, ACol, ARow); - end; - end; -{$ENDIF} - end else if aItem.Action = aaDelete then begin - Brush.Color := FColors.Deleted; - Font.Color := FColors.DeletedText; - end else if ((doAlternateColors in FDisplayOptions) and - not Odd(ARow)) then begin - Brush.Color := FColors.Alternate; - Font.Color := FColors.AlternateText; - end; - if not DefaultDrawing then - Canvas.FillRect(ARect); - Canvas.Brush.Style := bsClear; - TxtRect := ARect; -{$IFNDEF UsingCLX} - Icon := 0; - if (Attr = vaItemName) then - Icon := GetIcon(aItem.Filename); - if (Icon <> 0) then begin - H := ARect.Bottom - ARect.Top; - DrawIconEx(Canvas.Handle, ARect.Left+1, ARect.Top+1, Icon, - H - 2, H - 2, 0, 0, DI_NORMAL); - TxtRect.Left := TxtRect.Left + H; - end; -{$ENDIF} - - DTFormat := DrawTextFormat(Attr, TxtRect); -{$IFNDEF UsingCLX} - DrawText(Canvas.Handle, PChar(s), -1, TxtRect, DTFormat); -{$ELSE} - Canvas.TextRect(TxtRect, TxtRect.Left, TxtRect.Top, s, DTFormat); -{$ENDIF} - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.DrawHeaderButton(ACol : Integer; const AText : string); -var - ARect : TRect; - DTFormat : Word; -begin - ARect := CellRect(ACol, 0); - if not DefaultDrawing then with Canvas do begin - Brush.Style := bsSolid; - Brush.Color := clBtnface; - FillRect(ARect); - if FButtonDown then - Pen.Color := clBtnHighlight - else - Pen.Color := clBtnShadow; - MoveTo(ARect.Left, ARect.Bottom - 1); - LineTo(ARect.Right - 1, ARect.Bottom - 1); - LineTo(ARect.Right - 1, ARect.Top -1); - if FButtonDown then - Pen.Color := clBtnShadow - else - Pen.Color := clBtnHighlight; - MoveTo(ARect.Left, ARect.Bottom - 2); - LineTo(ARect.Left, ARect.Top); - LineTo(ARect.Right - 1, ARect.Top); - Brush.Style := bsClear; - end; - ARect.Right := ARect.Left + ColWidths[ACol]; - if FSortCol = ACol then - ARect.Right := ARect.Right - 5 - (2 * (ARect.Bottom - ARect.Top) div 10); -{$IFDEF UsingCLX} - { prefix is off by default in Qt} - DTFormat := Integer(AlignmentFlags_AlignVCenter) or - Integer(AlignmentFlags_SingleLine) or - Integer(AlignmentFlags_AlignHCenter); -{$ELSE} - DTFormat := DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX or DT_CENTER; -{$ENDIF} - if FButtonDown then - ARect := Rect(ARect.Left+1, ARect.Top+1, ARect.Right, ARect.Bottom); -{$IFDEF UsingCLX} - Canvas.TextRect(ARect, ARect.Left, ARect.Top, AText, DTFormat); -{$ELSE} - DrawText(Canvas.Handle, PChar(AText), -1, ARect, DTFormat); -{$ENDIF} - if FSortCol = ACol then - DrawSortArrow; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.DrawSortArrow; -var - ARect : TRect; - SavedColor : TColor; -begin - if (FSortCol > -1) then begin - { set up Rect for the OnDrawSortArrow event } - ARect := CellRect(FSortCol, 0); - ARect.Top := (ARect.Bottom - ARect.Top) div 10; - ARect.Bottom := ARect.Bottom - ARect.Top; - ARect.Right := ARect.Left + ColWidths[FSortCol] - 5; - ARect.Left := ARect.Right - ((ARect.Bottom - ARect.Top)); - - if Assigned(FOnDrawSortArrow) then begin - FOnDrawSortArrow(Self, FSortCol, FRowMap.SortAscending, Canvas, ARect); - Exit; - end; - { make ARect smaller for our own drawing } - inc(ARect.Left, 10); - inc(ARect.Top, 5); - dec(ARect.Bottom, 5); - - with Canvas do begin - Pen.Color := clBtnShadow; - - SavedColor := Brush.Color; - Brush.Color := clBtnFace; - with ARect do - if FRowMap.SortAscending then begin - Polygon([Point(((Right-Left)div 2)+Left, Bottom), Point(Right, Top), - Point(Left, Top)]); -{$IFNDEF UsingCLX} - if Ctl3D then begin - Pen.Color := clBtnHighlight; - MoveTo(((Right-Left)div 2)+Left, Bottom); - LineTo(Right, Top); - end; -{$ENDIF} - end else begin - Polygon([Point(((Right-Left)div 2)+Left, Top), Point(Right, Bottom), - Point(Left, Bottom)]); -{$IFNDEF UsingCLX} - if Ctl3D then begin - Pen.Color := clBtnHighlight; - MoveTo(((Right-Left)div 2)+Left, Top); - LineTo(Right, Bottom); - LineTo(Left, Bottom); - Pen.Color := clBtnShadow; - LineTo(((Right-Left)div 2)+Left, Top); - end; -{$ENDIF} - end; - Brush.Color := SavedColor; - end; - end; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.DrawTextFormat(Attr : TAbViewAttribute; - var Rect : TRect) : Word; -begin -{$IFDEF MSWINDOWS} - Result := DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX; - case Attr of - vaItemname : Result := Result or DT_LEFT; - vaPacked : Result := Result or DT_RIGHT; - vaFileSize : Result := Result or DT_RIGHT; - vaMethod : Result := Result or DT_CENTER; - vaRatio : Result := Result or DT_CENTER; - vaCRC : Result := Result or DT_CENTER; - vaFileAttributes : Result := Result or DT_CENTER; - vaFileType : Result := Result or DT_CENTER; - vaEncryption : Result := Result or DT_CENTER; - vaTimeStamp : Result := Result or DT_LEFT; - vaVersionMade : Result := Result or DT_CENTER; - vaVersionNeeded : Result := Result or DT_CENTER; - vaPath : Result := Result or DT_LEFT; - end; - if (Result and 3) = DT_LEFT then - OffsetRect(Rect, 5, 0) - else if (Result and 3) = DT_RIGHT then - OffsetRect(Rect, -5, 0); -{$ENDIF} -{$IFDEF LINUX} - Result := Integer(AlignmentFlags_AlignVCenter) or - Integer(AlignmentFlags_SingleLine); - case Attr of - vaItemname : Result := Result or Integer(AlignmentFlags_AlignLeft); - vaPacked : Result := Result or Integer(AlignmentFlags_AlignRight); - vaFileSize : Result := Result or Integer(AlignmentFlags_AlignRight); - vaMethod : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaRatio : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaCRC : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaFileAttributes : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaFileType : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaEncryption : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaTimeStamp : Result := Result or Integer(AlignmentFlags_AlignLeft); - vaVersionMade : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaVersionNeeded : Result := Result or Integer(AlignmentFlags_AlignCenter); - vaPath : Result := Result or Integer(AlignmentFlags_AlignLeft); - end; -{$ENDIF} -end; - -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.GetActiveRow : Longint; -begin - Result := Row - 1; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.GetCount : Longint; -begin - if Assigned(FItemList) then - Result := FItemList.Count - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.GetHeaderRowHeight : Integer; -begin - Result := RowHeights[AbHeaderRow]; -end; -{ -------------------------------------------------------------------------- } -{$IFDEF MSWINDOWS} -function TAbBaseViewer.GetIcon(const ItemName : string) : HIcon; -var - i : Longint; - t : string; - sfi : SHFILEINFO; -begin - Result := 0; - if not (doShowIcons in FDisplayOptions) then - Exit; - t := ExtractFileExt(ItemName); - i := FIcons.IndexOf(t); - if (i > -1) then - Result := HIcon(FIcons.Objects[i]) - else begin - SHGetFileInfo(PChar(t), FILE_ATTRIBUTE_NORMAL, sfi, sizeof(sfi), - SHGFI_ICON or SHGFI_USEFILEATTRIBUTES); - Result := sfi.hIcon; - FIcons.AddObject(t, Pointer(Result)); - end; -end; -{$ENDIF} -{$IFDEF UsingCLX } - { no file type icons in CLX } -{$ENDIF} -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.GetSelCount : Longint; -begin - Result := FSelList.SelCount; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.GetSelected(RowNum : Longint) : Boolean; -begin - if Assigned(FItemList) then - Result := FSelList.IsSelected(FRowMap[RowNum]) - else - Result := False; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.GetVersion : string; -begin - Result := AbVersionS; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.InitColMap; -const - cResString: array[TAbViewAttribute] of string = (AbItemNameHeadingS, - AbPackedHeadingS, AbMethodHeadingS, AbRatioHeadingS, AbCRCHeadingS, - AbFileAttrHeadingS, AbFileFormatHeadingS, AbEncryptionHeadingS, - AbTimeStampHeadingS, AbFileSizeHeadingS, AbVersionMadeHeadingS, - AbVersionNeededHeadingS, AbPathHeadingS); -var - i : TAbViewAttribute; -begin - FHeadings.Clear; - for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do begin - FHeadings.Add(cResString[i]); - FColMap[i] := Ord(i); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.InvalidateRow(ARow: Longint); -var - Rect: TRect; -begin - if not HandleAllocated then - Exit; - if ((ARow < TopRow) or (ARow > TopRow + VisibleRowCount)) and (ARow <> 0) then - Exit; - Rect := CellRect(0, ARow); - Rect.Right := ClientWidth; -{$IFDEF UsingCLX} - InvalidateRect(Rect, False); -{$ELSE} - InvalidateRect(Handle, @Rect, True); -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.KeyDown(var Key: Word; Shift: TShiftState); -begin - FShiftState := Shift; - inherited KeyDown(Key, Shift); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.KeyUp(var Key: Word; Shift: TShiftState); -begin - FShiftState := Shift; - inherited KeyUp(Key, Shift); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.Loaded; -begin - inherited Loaded; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.MouseDown(Button: TMouseButton; - Shift: TShiftState; X, Y : Integer); - - function GetMinLen(Col: Integer): Word; - var - I, L : Integer; - s : String; - aItem : TAbArchiveItem; - Attr : TAbViewAttribute; - Sorted : Boolean; - begin - Attr := TAbViewAttribute(ColMap(Col)); - Result := Canvas.TextWidth(FHeadings[ColMap(Col)]); - case Attr of - vaItemName : Sorted := saItemName in FSortAttributes; - vaPacked : Sorted := saPacked in FSortAttributes; - vaRatio : Sorted := saRatio in FSortAttributes; - vaTimeStamp: Sorted := saTimeStamp in FSortAttributes; - vaFileSize : Sorted := saFileSize in FSortAttributes; - vaPath : Sorted := saPath in FSortAttributes; - else Sorted := False; - end; - if Sorted then - Result := Result + RowHeights[0] + 16 - else - Result := Result + 8; - - if Assigned(FItemList) then - for I := 0 to (FItemList.Count-1) do begin - aItem := FItemList.Items[I]; - S := AttrToStr(Attr, aItem); - L := Canvas.TextWidth(S) + 8; - if (doShowIcons in FDisplayOptions) and (Attr = vaItemName) then - inc(L, RowHeights[I]); - if L > Result then - Result := L; - end; - end; - -var - ACol : Longint; - ARow : Longint; - Rect : TRect; -begin - ViewMouseCoord := MouseCoord(X, Y); - inherited MouseDown(Button, Shift, X, Y); - - FShiftState := Shift; - { handle double clicks on header row dividers } - if (ssDouble in FShiftState) and (ViewMouseCoord.Y = AbHeaderRow) then begin - FColSizing := True; - Rect := CellRect(ViewMouseCoord.X, ViewMouseCoord.Y); - Rect.Left := Rect.Right - 3; - if PtInRect(Rect, Point(X, Y)) then begin - ColWidths[MouseCoord(Rect.Left, Y).X] := - GetMinLen(MouseCoord(Rect.Left, Y).X) - end - else begin - Rect := CellRect(ViewMouseCoord.X, ViewMouseCoord.Y); - Rect.Right := Rect.Left + 4; - if PtInRect(Rect, Point(X, Y)) then - ColWidths[MouseCoord(Rect.Left, Y).X-1] := - GetMinLen(MouseCoord(Rect.Left, Y).X-1); - end; - end; - - { if grid is being resized } - if (FGridState = gsColSizing) then begin - FColSizing := True; - Exit; {dont press button when resizing column} - end; - - { refresh the headers} - if Assigned(FItemList) then - if (FItemList.Count > 0) then begin - ARow := ViewMouseCoord.Y; - ACol := ViewMouseCoord.X; - if (ARow = abHeaderRow) then begin - {if not (doColMove in FDisplayOptions) then} - if not (doColMove in FDisplayOptions) and not FColSizing then - FButtonDown := True; - RefreshCell(0, ACol); - end else if not (ssShift in Shift) then - RowAnchor := ActiveRow; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.MouseUp(Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -var - ACol : Longint; - ARow : Longint; - Attr : TAbViewAttribute; - SortAttribute : TAbSortAttribute; -begin - inherited MouseUp(Button, Shift, X, Y); - if csDesigning in ComponentState then Exit; - - FShiftState := Shift; - FButtonDown := False; - - if FColSizing then begin - Refresh; - FColSizing := False; - end else - if Assigned(FItemList) then - if (FItemList.Count > 0) then begin - ARow := ViewMouseCoord.Y; - ACol := ViewMouseCoord.X; - if (ARow = abHeaderRow) then begin - Attr := TAbViewAttribute(ColMap(ACol)); - if not FColMoving and - AttrToSortAttribute(Attr, SortAttribute) and - (SortAttribute in FSortAttributes) then begin - FSortCol := ACol; - FItemIndex := FRowMap[Row-1]; - FRowMap.SortBy(SortAttribute, FItemList); - FButtonDown := False; - RefreshCell(0, ACol); - if (doTrackActiveRow in FDisplayOptions) then - Row := FRowMap.InvRows[FItemIndex] + 1; - Refresh; - DoSorted(Attr); - end else begin - FButtonDown := False; - RefreshCell(0, ACol); - end; - end else - Paint; - end; - - FColMoving := False; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - inherited MouseMove(Shift, X, Y); - - if (FGridState = gsColMoving) then - FColMoving := True; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.MoveColumn(FromCol, ToCol : Integer); -var - temp, i : Integer; -begin - Temp := ColMap(FromCol); - if (FromCol < ToCol) then begin - for i := (FromCol + 1) to ToCol do - FColMap[TAbViewAttribute(i-1)] := FColMap[TAbViewAttribute(i)]; {Shift left} - end else begin - for i := (FromCol - 1) downto ToCol do - FColMap[TAbViewAttribute(i+1)] := FColMap[TAbViewAttribute(i)]; {Shift right} - end; - FColMap[TAbViewAttribute(ToCol)] := Temp; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.RefreshCell(ARow, ACol: Longint); -var - Rect: TRect; -begin - if not HandleAllocated then - Exit; - Rect := CellRect(ACol, ARow); -{$IFDEF UsingCLX} - InvalidateRect(Rect, False); -{$ELSE} - InvalidateRect(Handle, @Rect, False); -{$ENDIF} - Update; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.RefreshRow(ARow: Longint); -begin - InvalidateRow(ARow); - Update; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SelectAll; -begin - if Assigned(FItemList) then - if (FItemList.Count > 0) then begin - FSelList.SelectAll(FItemList.Count); - Invalidate; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetActiveRow(RowNum : Longint); -begin - if Assigned(FItemList) then - if (RowNum >= 0) and (RowNum < FItemList.Count) then - Row := RowNum + 1; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetAttributes(Value : TAbViewAttributes); -begin - FAttributes := Value; - ColCount := UpdateColCount(FAttributes); - DoChange(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetDisplayOptions(Value : TAbDisplayOptions); - {maps DisplayOptions to TGridOptions} -begin - FDisplayOptions := Value; - Options := [goFixedVertLine, goFixedHorzLine, goRowSelect]; -{$IFDEF HasGridDrawingStyle} - Options := Options + [goFixedRowClick]; // Highlight pressed header when themed -{$ENDIF} - - if (doColLines in Value) then - Options := Options + [goVertLine]; - if (doColMove in Value) then - Options := Options + [goColMoving]; - if (doColSizing in Value) then - Options := Options + [goColSizing]; - if (doRowLines in Value) then - Options := Options + [goHorzLine]; - if (doThumbTrack in Value) then - Options := Options + [goThumbTracking]; - DoChange(nil); -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetHeaderRowHeight(Value : Integer); -begin - RowHeights[abHeaderRow] := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetHeadings(Value: TAbColHeadings); -begin - Headings.Assign(Value); - Refresh; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetSortAttributes(Value : TAbSortAttributes); -begin - FSortAttributes := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetSelected(RowNum : Longint; Value: Boolean); -begin - if Assigned(FItemList) then - case Value of - True : FSelList.Select(FRowMap[RowNum]); - False : FSelList.Deselect(FRowMap[RowNum]); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.SetVersion(const Value : string); -begin - {NOP} -end; -{ -------------------------------------------------------------------------- } -procedure TAbBaseViewer.TopLeftChanged; -begin - if FAllowInvalidate then - Invalidate; -end; -{ -------------------------------------------------------------------------- } -function TAbBaseViewer.UpdateColCount(Attributes : TAbViewAttributes) : Integer; -var - i : TAbViewAttribute; -begin - Result := 0; - for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do begin - if (i in Attributes) then begin - FColMap[TAbViewAttribute(Result)] := Ord(i); - Inc(Result); - end; - end; -end; -{ -------------------------------------------------------------------------- } -{$IFDEF UsingCLX} -procedure TAbBaseViewer.SizeChanged(OldColCount, OldRowCount: Longint); -begin - inherited SizeChanged(OldColCount, OldRowCount); - Refresh; -end; -{$ELSE} -procedure TAbBaseViewer.WMSize(var Msg: TWMSize); -begin - inherited; - Refresh; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -{$IFNDEF UsingCLX} -procedure TAbBaseViewer.WMEraseBkgnd(var Msg: TWMEraseBkgnd); -begin - Msg.Result := -1; -end; -{$ENDIF} - -end. diff --git a/components/Abbrevia/source/AbWavPack.pas b/components/Abbrevia/source/AbWavPack.pas deleted file mode 100644 index 6bab507..0000000 --- a/components/Abbrevia/source/AbWavPack.pas +++ /dev/null @@ -1,439 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is Craig Peterson - * - * Portions created by the Initial Developer are Copyright (C) 2011 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbWavPack.pas *} -{*********************************************************} -{* ABBREVIA: WavPack decompression procedures *} -{*********************************************************} - -unit AbWavPack; - -{$I AbDefine.inc} - -interface - -uses - Classes; - -// Decompress a WavPack compressed stream from aSrc and write to aDes. -// aSrc must not allow reads past the compressed data. -procedure DecompressWavPack(aSrc, aDes: TStream); - - -implementation - -uses - AbCrtl, - Math, - SysUtils; - -// Compile using -// bcc32 -DWIN32 -DNO_USE_FSTREAMS -c -w-8004 -w-8012 -w-8017 -w-8057 -w-8065 *.c -// -// In wavpack_local.h remove the line "#define FASTCALL __fastcall" - -{ C runtime library ======================================================== } - -function fabs(x: Double): Double; cdecl; -begin - if x < 0 then Result := -1 - else Result := x -end; - -function floor(x: Double): Integer; cdecl; -begin - Result := Floor(x); -end; - -function labs(n: Integer): Integer; cdecl; -begin - if n < 0 then Result := -n - else Result := n; -end; - -function _stricmp(str1, str2: PAnsiChar): Integer; cdecl; - external 'msvcrt.dll' name '_stricmp'; - -function strncmp(str1, str2: PAnsiChar; num: Integer): Integer; cdecl; - external 'msvcrt.dll' {$IFDEF BCB}name '_strncmp'{$ENDIF}; - - -{ Forward declarations ===================================================== } - -// bits.c -procedure bs_open_read; external; -procedure bs_close_read; external; -procedure bs_open_write; external; -procedure bs_close_write; external; -procedure little_endian_to_native; external; -procedure native_to_little_endian; external; - -// extra1.c -procedure execute_mono; external; - -// extra2.c -procedure execute_stereo; external; - -// float.c -procedure float_values; external; -procedure read_float_info; external; -procedure scan_float_data; external; -procedure send_float_data; external; -procedure WavpackFloatNormalize; external; -procedure write_float_info; external; - -// metadata.c -procedure add_to_metadata; external; -procedure copy_metadata; external; -procedure free_metadata; external; -procedure process_metadata; external; -procedure read_metadata_buff; external; -procedure write_metadata_block; external; - -// pack.c -procedure pack_block; external; -procedure pack_init; external; - -// tags.c -procedure load_tag; external; -procedure valid_tag; external; - -// unpack.c -procedure check_crc_error; external; -procedure free_tag; external; -procedure unpack_init; external; -procedure unpack_samples; external; - -// unpack3.c -procedure free_stream3; external; -procedure get_version3; external; -procedure get_sample_index3; external; -procedure open_file3; external; -procedure seek_sample3; external; -procedure unpack_samples3; external; - -// words.c -procedure exp2s; external; -procedure flush_word; external; -procedure get_word; external; -procedure get_words_lossless; external; -procedure init_words; external; -procedure log2s; external; -procedure log2buffer; external; -procedure nosend_word; external; -procedure read_hybrid_profile; external; -procedure read_entropy_vars; external; -procedure restore_weight; external; -procedure scan_word; external; -procedure send_word; external; -procedure send_words_lossless; external; -procedure store_weight; external; -procedure write_entropy_vars; external; -procedure write_hybrid_profile; external; - - -{ Linker derectives ======================================================== } - -{$IF DEFINED(WIN32)} - {$L Win32\wv_bits.obj} - {$L Win32\wv_extra1.obj} - {$L Win32\wv_extra2.obj} - {$L Win32\wv_float.obj} - {$L Win32\wv_metadata.obj} - {$L Win32\wv_pack.obj} - {$L Win32\wv_tags.obj} - {$L Win32\wv_unpack.obj} - {$L Win32\wv_unpack3.obj} - {$L Win32\wv_words.obj} - {$L Win32\wv_wputils.obj} -{$ELSEIF DEFINED(WIN64)} - {$L Win64\wv_bits.obj} - {$L Win64\wv_extra1.obj} - {$L Win64\wv_extra2.obj} - {$L Win64\wv_float.obj} - {$L Win64\wv_metadata.obj} - {$L Win64\wv_pack.obj} - {$L Win64\wv_tags.obj} - {$L Win64\wv_unpack.obj} - {$L Win64\wv_unpack3.obj} - {$L Win64\wv_words.obj} - {$L Win64\wv_wputils.obj} -{$IFEND} - -{ wavpack_local.h ========================================================== } - -const - OPEN_WVC = $1; // open/read "correction" file - OPEN_TAGS = $2; // read ID3v1 / APEv2 tags (seekable file) - OPEN_WRAPPER = $4; // make audio wrapper available (i.e. RIFF) - OPEN_2CH_MAX = $8; // open multichannel as stereo (no downmix) - OPEN_NORMALIZE = $10; // normalize floating point data to +/- 1.0 - OPEN_STREAMING = $20; // "streaming" mode blindly unpacks blocks - // w/o regard to header file position info - OPEN_EDIT_TAGS = $40; // allow editing of tags - -type - int32_t = LongInt; - uint32_t = LongWord; - - WavpackStreamReader = record - read_bytes: function(id, data: Pointer; bcount: int32_t): int32_t; cdecl; - get_pos: function(id: Pointer): uint32_t; cdecl; - set_pos_abs: function(id: Pointer; pos: uint32_t): Integer; cdecl; - set_pos_rel: function(id: Pointer; delta: int32_t; mode: Integer): Integer; cdecl; - push_back_byte: function(id: Pointer; c: Integer): Integer; cdecl; - get_length: function(id: Pointer): uint32_t; cdecl; - can_seek: function(id: Pointer): Integer; cdecl; - write_bytes: function(id, data: Pointer; bcount: int32_t): int32_t; cdecl; - end; - - WavpackContext = Pointer; - - -{ wputils.c ================================================================ } - -function WavpackOpenFileInputEx(const reader: WavpackStreamReader; - wv_id, wvc_id: Pointer; error: PAnsiChar; flags, norm_offset: Integer): WavpackContext; - cdecl; external; - -function WavpackGetWrapperBytes(wpc: WavpackContext): uint32_t; cdecl; external; -function WavpackGetWrapperData(wpc: WavpackContext): PByte; cdecl; external; -procedure WavpackFreeWrapper (wpc: WavpackContext); cdecl; external; - -procedure WavpackSeekTrailingWrapper(wpc: WavpackContext); cdecl; external; - -function WavpackGetNumSamples(wpc: WavpackContext): uint32_t; cdecl; external; -function WavpackGetNumChannels(wpc: WavpackContext): Integer; cdecl; external; -function WavpackGetBytesPerSample (wpc: WavpackContext): Integer; cdecl; external; - -function WavpackUnpackSamples(wpc: WavpackContext; buffer: Pointer; - samples: uint32_t): uint32_t; cdecl; external; - -function WavpackCloseFile(wpc: WavpackContext): WavpackContext; cdecl; external; - - -{ TWavPackStream implementation ============================================ } - -type - PWavPackStream = ^TWavPackStream; - TWavPackStream = record - HasPushedByte: Boolean; - PushedByte: Byte; - Stream: TStream; - end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_read_bytes(id, data: Pointer; bcount: int32_t): int32_t; cdecl; -begin - if PWavPackStream(id).HasPushedByte then begin - PByte(data)^ := PWavPackStream(id).PushedByte; - PWavPackStream(id).HasPushedByte := False; - Inc(PByte(data)); - Dec(bcount); - if bcount = 0 then - Result := 1 - else - Result := PWavPackStream(id).Stream.Read(data^, bcount) + 1; - end - else - Result := PWavPackStream(id).Stream.Read(data^, bcount); -end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_get_pos(id: Pointer): uint32_t; cdecl; -begin - Result := PWavPackStream(id).Stream.Position; -end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_set_pos_abs(id: Pointer; pos: uint32_t): Integer; cdecl; -begin - PWavPackStream(id).Stream.Position := pos; - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_set_pos_rel(id: Pointer; delta: int32_t; - mode: Integer): Integer; cdecl; -begin - PWavPackStream(id).Stream.Seek(delta, mode); - Result := 1; -end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_push_back_byte(id: Pointer; c: Integer): Integer; cdecl; -begin - Assert(not PWavPackStream(id).HasPushedByte); - PWavPackStream(id).HasPushedByte := True; - PWavPackStream(id).PushedByte := Byte(c); - Result := 1; -end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_get_length(id: Pointer): uint32_t; cdecl; -begin - Result := PWavPackStream(id).Stream.Size; -end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_can_seek(id: Pointer): Integer; cdecl; -begin - Result := 1; -end; -{ -------------------------------------------------------------------------- } -function TWavPackStream_write_bytes(id, data: Pointer; - bcount: int32_t): int32_t; cdecl; -begin - Result := PWavPackStream(id).Stream.Write(data^, bcount); -end; - - -{ Decompression routines =================================================== } - -{ -------------------------------------------------------------------------- } -// Reformat samples from longs in processor's native endian mode to -// little-endian data with (possibly) less than 4 bytes / sample. -// -// Based on wvunpack.c::format_samples. -// Conversions simplified since we only support little-endian processors -function FormatSamples(bps: Integer; dst, src: PByte; samcnt: uint32_t): PByte; -var - sample: LongWord; -begin - while samcnt > 0 do begin - Dec(samcnt); - // Get next sample - sample := PLongWord(src)^; - // Convert and write to output - case bps of - 1: begin - dst^ := sample + 128; - end; - 2: begin - PWord(dst)^ := sample; - end; - 3: begin - PByteArray(dst)[0] := sample; - PByteArray(dst)[1] := sample shr 8; - PByteArray(dst)[2] := sample shr 16; - end; - 4: begin - PLongWord(dst)^ := sample; - end; - end; - Inc(src, SizeOf(LongWord)); - Inc(dst, bps); - end; - Result := dst; -end; -{ -------------------------------------------------------------------------- } -// Decompress a WavPack compressed stream from aSrc and write to aDes. -// aSrc must not allow reads past the compressed data. -// -// Based on wvunpack.c::unpack_file() -procedure DecompressWavPack(aSrc, aDes: TStream); -type - PtrInt = {$IF DEFINED(CPUX64)}Int64{$ELSE}LongInt{$IFEND}; -const - OutputBufSize = 256 * 1024; -var - StreamReader: WavpackStreamReader; - Context: WavpackContext; - Src: TWavpackStream; - Error: array[0..79] of AnsiChar; - SamplesToUnpack, SamplesUnpacked: uint32_t; - NumChannels, bps, BytesPerSample: Integer; - OutputBuf, OutputPtr: PByte; - DecodeBuf: Pointer; -begin - OutputBuf := nil; - DecodeBuf := nil; - - StreamReader.read_bytes := TWavPackStream_read_bytes; - StreamReader.get_pos := TWavPackStream_get_pos; - StreamReader.set_pos_abs := TWavPackStream_set_pos_abs; - StreamReader.set_pos_rel := TWavPackStream_set_pos_rel; - StreamReader.push_back_byte := TWavPackStream_push_back_byte; - StreamReader.get_length := TWavPackStream_get_length; - StreamReader.can_seek := TWavPackStream_can_seek; - StreamReader.write_bytes := TWavPackStream_write_bytes; - - FillChar(Src, SizeOf(Src), 0); - Src.Stream := aSrc; - - Context := WavpackOpenFileInputEx(StreamReader, @Src, nil, Error, OPEN_WRAPPER, 0); - if Context = nil then - raise Exception.Create('WavPack decompression failed: ' + Error); - try - // Write .wav header - if WavpackGetWrapperBytes(Context) > 0 then begin - aDes.WriteBuffer(WavpackGetWrapperData(Context)^, WavpackGetWrapperBytes(Context)); - WavpackFreeWrapper(Context); - end; - - NumChannels := WavpackGetNumChannels(Context); - bps := WavpackGetBytesPerSample(Context); - BytesPerSample := NumChannels * bps; - - GetMem(OutputBuf, OutputBufSize); - OutputPtr := OutputBuf; - GetMem(DecodeBuf, 4096 * NumChannels * SizeOf(Integer)); - - repeat - // Unpack samples - SamplesToUnpack := (OutputBufSize - (PtrInt(OutputPtr) - PtrInt(OutputBuf))) div BytesPerSample; - if (SamplesToUnpack > 4096) then - SamplesToUnpack := 4096; - SamplesUnpacked := WavpackUnpackSamples(Context, DecodeBuf, SamplesToUnpack); - - // Convert from 32-bit integers down to appriopriate bit depth - // and copy to output buffer. - if (SamplesUnpacked > 0) then - OutputPtr := FormatSamples(bps, OutputPtr, DecodeBuf, - SamplesUnpacked * uint32_t(NumChannels)); - - // Write output when it's full or when we're done - if (SamplesUnpacked = 0) or - ((OutputBufSize - (PtrInt(OutputPtr) - PtrInt(OutputBuf))) < BytesPerSample) then begin - aDes.WriteBuffer(OutputBuf^, PtrInt(OutputPtr) - PtrInt(OutputBuf)); - OutputPtr := OutputBuf; - end; - until (SamplesUnpacked = 0); - - // Write .wav footer - while WavpackGetWrapperBytes(Context) > 0 do begin - try - aDes.WriteBuffer(WavpackGetWrapperData(Context)^, - WavpackGetWrapperBytes(Context)); - finally - WavpackFreeWrapper(Context); - end; - // Check for more RIFF data - WavpackUnpackSamples (Context, DecodeBuf, 1); - end; - finally - if DecodeBuf <> nil then - FreeMemory(DecodeBuf); - if OutputBuf <> nil then - FreeMemory(OutputBuf); - WavpackCloseFile(Context); - end; -end; - -end. diff --git a/components/Abbrevia/source/AbZBrows.pas b/components/Abbrevia/source/AbZBrows.pas deleted file mode 100644 index 150913a..0000000 --- a/components/Abbrevia/source/AbZBrows.pas +++ /dev/null @@ -1,366 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZBrows.pas *} -{*********************************************************} -{* ABBREVIA: Zip file Browser Component *} -{*********************************************************} - -unit AbZBrows; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbArcTyp, AbBrowse, AbSpanSt, AbZipTyp; - -type - TAbCustomZipBrowser = class(TAbBaseBrowser) - private - function GetTarAutoHandle: Boolean; - procedure SetTarAutoHandle(const Value: Boolean); - protected {private} - FPassword : AnsiString; - FOnRequestLastDisk : TAbRequestDiskEvent; - FOnRequestNthDisk : TAbRequestNthDiskEvent; - FOnRequestBlankDisk : TAbRequestDiskEvent; - FTarAutoHandle : Boolean; - - protected {methods} - function GetItem(Index : Integer) : TAbZipItem; virtual; - function GetStream: TStream; - function GetZipfileComment : AnsiString; - procedure InitArchive; - override; - procedure SetFileName(const aFileName : string); - override; - procedure SetStream(aValue: TStream); - procedure SetOnRequestLastDisk(Value : TAbRequestDiskEvent); - procedure SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent); - procedure SetOnRequestBlankDisk(Value : TAbRequestDiskEvent); - - procedure SetPassword(const Value : AnsiString); - procedure SetZipfileComment(const Value : AnsiString); - virtual; - - protected {properties} - property Password : AnsiString - read FPassword - write SetPassword; - - protected {events} - property OnRequestLastDisk : TAbRequestDiskEvent - read FOnRequestLastDisk - write SetOnRequestLastDisk; - property OnRequestNthDisk : TAbRequestNthDiskEvent - read FOnRequestNthDisk - write SetOnRequestNthDisk; - property OnRequestBlankDisk : TAbRequestDiskEvent - read FOnRequestBlankDisk - write SetOnRequestBlankDisk; - - public {methods} - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - - public {properties} - property Items[Index : Integer] : TAbZipItem - read GetItem; default; - property Stream : TStream // This can be used instead of Filename - read GetStream write SetStream; - property ZipArchive : {TAbZipArchive} TAbArchive - read FArchive; - property ZipfileComment : AnsiString - read GetZipfileComment - write SetZipfileComment; - - property TarAutoHandle : Boolean - read GetTarAutoHandle - write SetTarAutoHandle; - end; - - TAbZipBrowser = class(TAbCustomZipBrowser) - published - property ArchiveProgressMeter; - property ItemProgressMeter; - property BaseDirectory; - property LogFile; - property Logging; - property OnArchiveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnConfirmProcessItem; - property OnLoad; - property OnProcessItemFailure; - property OnRequestLastDisk; - property OnRequestNthDisk; - property Version; - property TarAutoHandle; - property FileName; {must be after OnLoad} - end; - - -implementation - -uses - SysUtils, AbBzip2Typ, AbExcept, AbGzTyp, AbTarTyp, AbUtils; - -{ TAbCustomZipBrowser implementation ======================================= } - -{ -------------------------------------------------------------------------- } -constructor TAbCustomZipBrowser.Create(AOwner : TComponent); -begin - inherited Create(AOwner); -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomZipBrowser.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipBrowser.GetItem(Index : Integer) : TAbZipItem; -begin - Result := TAbZipItem(ZipArchive.ItemList[Index]); -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipBrowser.GetStream: TStream; -begin - if FArchive <> nil then - Result := FArchive.FStream - else - Result := nil -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipBrowser.GetTarAutoHandle: Boolean; -begin - Result := False; - if FArchive is TAbGzipArchive then - Result := TAbGzipArchive(FArchive).TarAutoHandle - else if FArchive is TAbBzip2Archive then - Result := TAbBzip2Archive(FArchive).TarAutoHandle; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipBrowser.GetZipfileComment : AnsiString; -begin - if FArchive is TAbZipArchive then - Result := TAbZipArchive(FArchive).ZipfileComment - else - Result := ''; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipBrowser.InitArchive; -begin - inherited InitArchive; - if FArchive is TAbZipArchive then begin - {properties} - TAbZipArchive(FArchive).Password := FPassword; - {events} - TAbZipArchive(FArchive).OnRequestLastDisk := FOnRequestLastDisk; - TAbZipArchive(FArchive).OnRequestNthDisk := FOnRequestNthDisk; - end; -end; -{ -------------------------------------------------------------------------- } - -procedure TAbCustomZipBrowser.SetFileName(const aFileName : string); -var - ArcType : TAbArchiveType; -begin - - FFileName := aFileName; - if csDesigning in ComponentState then - Exit; - try - if Assigned(FArchive) then begin - FArchive.Save; - end; - except - end; - FArchive.Free; - FArchive := nil; - - if FileName <> '' then begin - if FileExists(FileName) then begin { open it } - ArcType := ArchiveType; - if not ForceType then - ArcType := AbDetermineArcType(FileName, atUnknown); - - case ArcType of - atZip, atSpannedZip, atSelfExtZip : begin - FArchive := TAbZipArchive.Create(FileName, fmOpenRead or fmShareDenyNone); - InitArchive; - end; - - atTar : begin - FArchive := TAbTarArchive.Create(FileName, fmOpenRead or fmShareDenyNone); - inherited InitArchive; - end; - - atGZip : begin - FArchive := TAbGzipArchive.Create(FileName, fmOpenRead or fmShareDenyNone); - TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbGzipArchive(FArchive).IsGzippedTar := False; - inherited InitArchive; - end; - - atGZippedTar : begin - FArchive := TAbGzipArchive.Create(FileName, fmOpenRead or fmShareDenyNone); - TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbGzipArchive(FArchive).IsGzippedTar := True; - inherited InitArchive; - end; - - atBzip2 : begin - FArchive := TAbBzip2Archive.Create(FileName, fmOpenRead or fmShareDenyNone); - TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbBzip2Archive(FArchive).IsBzippedTar := False; - inherited InitArchive; - end; - - atBzippedTar : begin - FArchive := TAbBzip2Archive.Create(FileName, fmOpenRead or fmShareDenyNone); - TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbBzip2Archive(FArchive).IsBzippedTar := True; - inherited InitArchive; - end; - - else - raise EAbUnhandledType.Create; - end {case}; - FArchive.Load; - FArchiveType := ArcType; - end; - end; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipBrowser.SetStream(aValue: TStream); -var - ArcType : TAbArchiveType; -begin - FFileName := ''; - try - if FArchive <> nil then - FArchive.Save; - except - end; - FreeAndNil(FArchive); - - if aValue <> nil then begin - ArcType := ArchiveType; - if not ForceType then - ArcType := AbDetermineArcType(aValue); - - case ArcType of - atZip, atSpannedZip, atSelfExtZip : begin - FArchive := TAbZipArchive.CreateFromStream(aValue, ''); - end; - - atTar : begin - FArchive := TAbTarArchive.CreateFromStream(aValue, ''); - end; - - atGZip, atGZippedTar : begin - FArchive := TAbGzipArchive.CreateFromStream(aValue, ''); - TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbGzipArchive(FArchive).IsGzippedTar := (ArcType = atGZippedTar); - end; - - atBzip2, atBzippedTar : begin - FArchive := TAbBzip2Archive.CreateFromStream(aValue, ''); - TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbBzip2Archive(FArchive).IsBzippedTar := (ArcType = atBzippedTar); - end; - - else - raise EAbUnhandledType.Create; - end {case}; - InitArchive; - FArchive.Load; - FArchiveType := ArcType; - end; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipBrowser.SetOnRequestBlankDisk(Value : TAbRequestDiskEvent); -begin - FOnRequestBlankDisk := Value; - if FArchive is TAbZipArchive then - TAbZipArchive(FArchive).OnRequestBlankDisk := FOnRequestBlankDisk; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipBrowser.SetOnRequestLastDisk(Value : TAbRequestDiskEvent); -begin - FOnRequestLastDisk := Value; - if FArchive is TAbZipArchive then - TAbZipArchive(FArchive).OnRequestLastDisk := FOnRequestLastDisk; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipBrowser.SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent); -begin - FOnRequestNthDisk := Value; - if FArchive is TAbZipArchive then - TAbZipArchive(FArchive).OnRequestNthDisk := FOnRequestNthDisk; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipBrowser.SetPassword(const Value : AnsiString); -begin - FPassword := Value; - if FArchive is TAbZipArchive then - TAbZipArchive(FArchive).Password := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipBrowser.SetTarAutoHandle(const Value: Boolean); -begin - FTarAutoHandle := Value; - - if FArchive is TAbGzipArchive then begin - if TAbGzipArchive(FArchive).TarAutoHandle <> Value then begin - TAbGzipArchive(FArchive).TarAutoHandle := Value; - InitArchive; - FArchive.Load; - DoChange; - end; - end; - if FArchive is TAbBzip2Archive then begin - if TAbBzip2Archive(FArchive).TarAutoHandle <> Value then begin - TAbBzip2Archive(FArchive).TarAutoHandle := Value; - InitArchive; - FArchive.Load; - DoChange; - end; - end; -end; - -procedure TAbCustomZipBrowser.SetZipfileComment(const Value : AnsiString); -begin - {NOP - descendents wishing to set this property should override} -end; -{ -------------------------------------------------------------------------- } - -end. diff --git a/components/Abbrevia/source/AbZLTyp.pas b/components/Abbrevia/source/AbZLTyp.pas deleted file mode 100644 index 845d069..0000000 --- a/components/Abbrevia/source/AbZLTyp.pas +++ /dev/null @@ -1,315 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZLTyp.pas *} -{*********************************************************} -{* ABBREVIA: TAbZlItem class *} -{*********************************************************} -{* Misc. constants, types, and routines for working *} -{* with ZLib compressed data *} -{* See: RFC 1950 *} -{* "ZLIB Compressed Data Format Specification *} -{* version 3.3" for more information on ZLib *} -{*********************************************************} - -unit AbZLTyp; - -{$I AbDefine.inc} - -interface - -uses - SysUtils, Classes, AbUtils, AbArcTyp, AbZipPrc, AbDfBase, AbDfDec, AbDfEnc; - -const - AB_ZL_PRESET_DICT = $20; - - AB_ZL_DEF_COMPRESSIONMETHOD = $8; { Deflate } - AB_ZL_DEF_COMPRESSIONINFO = $7; { 32k window for Deflate } - - AB_ZL_FASTEST_COMPRESSION = $0; - AB_ZL_FAST_COMPRESSION = $1; - AB_ZL_DEFAULT_COMPRESSION = $2; - AB_ZL_MAXIMUM_COMPRESSION = $3; - - AB_ZL_FCHECK_MASK = $1F; - AB_ZL_CINFO_MASK = $F0; { mask out leftmost 4 bits } - AB_ZL_FLEVEL_MASK = $C0; { mask out leftmost 2 bits } - AB_ZL_CM_MASK = $0F; { mask out rightmost 4 bits } - - -type - TAbZLHeader = packed record - CMF : Byte; - FLG : Byte; - end; - - TAbZLItem = class(TAbArchiveItem) - private - function GetCompressionInfo: Byte; - function GetCompressionLevel: Byte; - function GetIsPresetDictionaryPresent: Boolean; - procedure SetCompressionInfo(Value: Byte); - procedure SetCompressionLevel(Value: Byte); - function GetCompressionMethod: Byte; - procedure SetCompressionMethod(Value: Byte); - function GetFCheck: Byte; - procedure MakeFCheck; - protected { private } - FZLHeader : TAbZlHeader; - FAdler32 : LongInt; - public - constructor Create; - - property IsPresetDictionaryPresent : Boolean - read GetIsPresetDictionaryPresent; - property CompressionLevel : Byte - read GetCompressionLevel write SetCompressionLevel; - property CompressionInfo : Byte - read GetCompressionInfo write SetCompressionInfo; - - property CompressionMethod : Byte - read GetCompressionMethod write SetCompressionMethod; - property Adler32 : LongInt - read FAdler32 write FAdler32; - - property FCheck : Byte - read GetFCheck; - - procedure SaveZLHeaderToStream(AStream : TStream); - procedure ReadZLHeaderFromStream(AStream : TStream); - end; - - TAbZLStreamHelper = class(TAbArchiveStreamHelper) - protected { private } - FItem : TAbZLItem; - public - constructor Create(AStream : TStream); - destructor Destroy; override; - - property Item : TAbZLItem - read FItem; - - procedure ExtractItemData(AStream : TStream); override; - function FindFirstItem : Boolean; override; - function FindNextItem : Boolean; override; - procedure ReadHeader; override; - procedure ReadTail; override; - function SeekItem(Index : Integer): Boolean; override; - procedure WriteArchiveHeader; override; - procedure WriteArchiveItem(AStream : TStream); override; - procedure WriteArchiveTail; override; - function GetItemCount : Integer; override; - end; - - -implementation - -{ TAbZLStreamHelper } - -constructor TAbZLStreamHelper.Create(AStream: TStream); -begin - inherited Create(AStream); - FItem := TAbZLItem.Create; -end; - -destructor TAbZLStreamHelper.Destroy; -begin - FItem.Free; - inherited Destroy; -end; - -procedure TAbZLStreamHelper.ExtractItemData(AStream: TStream); -{ assumes already positioned appropriately } -var - Hlpr : TAbDeflateHelper; -begin - Hlpr := TAbDeflateHelper.Create; - Hlpr.Options := Hlpr.Options or dfc_UseAdler32; - if not FItem.IsPresetDictionaryPresent then - Inflate(FStream, AStream, Hlpr) - else - raise Exception.Create('preset dictionaries unsupported'); - Hlpr.Free; -end; - -function TAbZLStreamHelper.FindFirstItem: Boolean; -var - ZLH : TAbZLHeader; -begin - FStream.Seek(0, soBeginning); - Result := FStream.Read(ZLH, SizeOf(TAbZLHeader)) = SizeOf(TAbZLHeader); - FItem.FZLHeader := ZLH; - FStream.Seek(0, soBeginning); -end; - -function TAbZLStreamHelper.FindNextItem: Boolean; -begin - { only one item in a ZLib Stream } - Result := FindFirstItem; -end; - -function TAbZLStreamHelper.GetItemCount: Integer; -begin - { only one item in a ZLib Stream } - Result := 1; -end; - -procedure TAbZLStreamHelper.ReadHeader; -{ assumes already positioned appropriately } -var - ZLH : TAbZLHeader; -begin - FStream.Read(ZLH, SizeOf(TAbZlHeader)); - FItem.FZLHeader := ZLH; -end; - -procedure TAbZLStreamHelper.ReadTail; -{ assumes already positioned appropriately } -var - Adler: LongInt; -begin - FStream.Read(Adler, SizeOf(LongInt)); - FItem.Adler32 := Adler; -end; - -function TAbZLStreamHelper.SeekItem(Index: Integer): Boolean; -begin - { only one item in a ZLib Stream } - if Index <> 1 then - Result := False - else - Result := FindFirstItem; -end; - -procedure TAbZLStreamHelper.WriteArchiveHeader; -begin - Item.SaveZLHeaderToStream(FStream); -end; - -procedure TAbZLStreamHelper.WriteArchiveItem(AStream: TStream); -var - Hlpr : TAbDeflateHelper; -begin - { Compress file } - Hlpr := TAbDeflateHelper.Create; - Hlpr.Options := Hlpr.Options or dfc_UseAdler32; - Item.Adler32 := AbDfEnc.Deflate(AStream, FStream, Hlpr); - Hlpr.Free; -end; - -procedure TAbZLStreamHelper.WriteArchiveTail; -var - Ad32 : LongInt; -begin - Ad32 := AbSwapLongEndianness(Item.Adler32); - FStream.Write(Ad32, SizeOf(LongInt)); -end; - -{ TAbZLItem } - -constructor TAbZLItem.Create; -begin - { Set default Values for fields } - FillChar(FZLHeader, SizeOf(TAbZlHeader), #0); - FZLHeader.CMF := (AB_ZL_DEF_COMPRESSIONINFO shl 4); { 32k Window size } - FZLHeader.CMF := FZLHeader.CMF or AB_ZL_DEF_COMPRESSIONMETHOD; { Deflate } - FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_PRESET_DICT; { no preset dictionary} - FZLHeader.FLG := FZLHeader.FLG or (AB_ZL_DEFAULT_COMPRESSION shl 6); { assume default compression } - MakeFCheck; -end; - -function TAbZLItem.GetCompressionInfo: Byte; -begin - Result := FZLHeader.CMF shr 4; -end; - -function TAbZLItem.GetCompressionLevel: Byte; -begin - Result := FZLHeader.FLG shr 6; -end; - -function TAbZLItem.GetCompressionMethod: Byte; -begin - Result := FZLHeader.CMF and AB_ZL_CM_MASK; -end; - -function TAbZLItem.GetFCheck: Byte; -begin - Result := FZLHeader.FLG and AB_ZL_FCHECK_MASK; -end; - -function TAbZLItem.GetIsPresetDictionaryPresent: Boolean; -begin - Result := (FZLHeader.FLG and AB_ZL_PRESET_DICT) = AB_ZL_PRESET_DICT; -end; - -procedure TAbZLItem.MakeFCheck; -{ create the FCheck value for the current Header } -var - zlh : Word; -begin - FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_FCHECK_MASK; - zlh := (FZLHeader.CMF * 256) + FZLHeader.FLG; - Inc(FZLHeader.FLG, 31 - (zlh mod 31)); -end; - -procedure TAbZLItem.ReadZLHeaderFromStream(AStream: TStream); -begin - AStream.Read(FZLHeader, SizeOf(TAbZLHeader)); -end; - -procedure TAbZLItem.SaveZLHeaderToStream(AStream: TStream); -begin - MakeFCheck; - AStream.Write(FZLHeader, SizeOf(TAbZlHeader)); -end; - -procedure TAbZLItem.SetCompressionInfo(Value: Byte); -begin - FZLHeader.CMF := FZLHeader.CMF and not AB_ZL_CINFO_MASK; - FZLHeader.CMF := FZLHeader.CMF or (Value shl 4); { shift value and add to bit field } -end; - -procedure TAbZLItem.SetCompressionLevel(Value: Byte); -var - Temp : Byte; -begin - Temp := Value; - if not Temp in [AB_ZL_FASTEST_COMPRESSION..AB_ZL_MAXIMUM_COMPRESSION] then - Temp := AB_ZL_DEFAULT_COMPRESSION; - FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_FLEVEL_MASK; - FZLHeader.FLG := FZLHeader.FLG or (Temp shl 6); { shift value and add to bit field } -end; - -procedure TAbZLItem.SetCompressionMethod(Value: Byte); -begin - if Value > AB_ZL_CM_MASK then Value := (Value shl 4) shr 4; - FZLHeader.CMF := FZLHeader.CMF and not AB_ZL_CM_MASK; - FZLHeader.CMF := FZLHeader.CMF or Value; -end; - -end. diff --git a/components/Abbrevia/source/AbZView.pas b/components/Abbrevia/source/AbZView.pas deleted file mode 100644 index a9f4038..0000000 --- a/components/Abbrevia/source/AbZView.pas +++ /dev/null @@ -1,229 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZView.pas *} -{*********************************************************} -{* ABBREVIA: Zip archive viewer component *} -{* Use AbQZView.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbZView; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses - Classes, -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF UsingCLX } - QControls, - AbQView, -{$ELSE} - Controls, - AbView, -{$ENDIF} - AbZBrows, - AbZipTyp; - -type - TAbIncludeItemEvent = procedure (Sender: TObject; - Item: TAbZipItem; - var Include: Boolean) of object; - - TAbZipView = class(TAbBaseViewer) - protected - FZipComponent : TAbCustomZipBrowser; - FOnIncludeItem: TAbIncludeItemEvent; - - function GetItem(RowNum : Longint) : TAbZipItem; - procedure SetZipComponent(Value : TAbCustomZipBrowser); - procedure Notification(AComponent : TComponent; Operation : TOperation); - override; - procedure DoChange(Sender : TObject); - override; - public - property Items[RowNum : Longint] : TAbZipItem - read GetItem; - published {properties} - property Align; - property Anchors; - property Attributes; -{$IFNDEF UsingCLX} - property BevelEdges; - property BevelInner; - property BevelKind; - property BevelOuter; - property BevelWidth; -{$ENDIF} - property BorderStyle; - property Color; - property Colors; -{$IFNDEF UsingCLX} - property Ctl3D; - property ParentCtl3D; - property DragCursor; -{$ENDIF} - property Cursor; - property Headings; - property DefaultColWidth; - property DefaultRowHeight; - property DisplayOptions; - property HeaderRowHeight; - property SortAttributes; - property DragMode; -{$IFDEF HasGridDrawingStyle} - property DrawingStyle; -{$ENDIF} - property Enabled; - property Font; -{$IFDEF HasGridDrawingStyle} - property GradientEndColor; - property GradientStartColor; -{$ENDIF} - property ParentColor; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property ShowHint; - property TabOrder; - property TabStop; -{$IFDEF HasTouch} - property Touch; -{$ENDIF} - property Version; - property ZipComponent : TAbCustomZipBrowser - read FZipComponent write SetZipComponent; - published {Events} - property OnChange; - property OnClick; - property OnDblClick; - property OnEnter; - property OnExit; -{$IFDEF HasTouch} - property OnGesture; -{$ENDIF} - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; -{$IFDEF HasOnMouseActivate} - property OnMouseActivate; -{$ENDIF} - property OnMouseDown; -{$IFDEF HasOnMouseEnter} - property OnMouseEnter; - property OnMouseLeave; -{$ENDIF} - property OnMouseMove; - property OnMouseUp; - property OnSorted; - property OnDrawSortArrow; - - property OnIncludeItem: TAbIncludeItemEvent - read FOnIncludeItem - write FOnIncludeItem; -end; - -implementation - -uses - AbArcTyp; - -{ ===== TAbZipView ========================================================= } -function TAbZipView.GetItem(RowNum : Longint) : TAbZipItem; -begin - if Assigned(FItemList) then - Result := TAbZipItem(FItemList.Items[FRowMap[RowNum]]) - else - Result := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipView.Notification(AComponent : TComponent; Operation : TOperation); -begin - inherited Notification(AComponent, Operation); - if Operation = opRemove then - if Assigned(FZipComponent) and (AComponent = FZipComponent) then begin - FZipComponent := nil; - Refresh; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipView.SetZipComponent(Value : TAbCustomZipBrowser); -begin - if Value <> nil then begin - FZipComponent := Value; - - if not (csDesigning in ComponentState) then begin - FZipComponent.OnChange := DoChange; - FZipComponent.OnLoad := DoLoad; - DoChange(Self); - end; - end - else - FZipComponent := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipView.DoChange(Sender : TObject); -var - i : Integer; - TheArchive : TAbArchive; - Include : Boolean; -begin - FItemList.Clear; - if Assigned(FZipComponent) then begin - { let's make this a bit easier to read } - TheArchive := FZipComponent.FArchive; - - if Assigned(TheArchive) then begin - for i := 0 to Pred(TheArchive.ItemList.Count) do begin - if Assigned(FOnIncludeItem) then begin - FOnIncludeItem(self, TAbZipItem(TheArchive.ItemList[i]), Include); - if Include then - FItemList.Add(TheArchive.ItemList[i]); - end - else begin - { if it doesn't look like a folder place holder... } - if TAbZipItem(TheArchive.ItemList[i]).DiskFileName <> - TAbZipItem(TheArchive.ItemList[i]).DiskPath then - { ...add it to the display list } - FItemList.Add(TheArchive.ItemList[i]); - end; - end; - end - else - FItemList.Clear; - end - else - FItemList.Clear; - inherited DoChange(Sender); -end; - -end. - diff --git a/components/Abbrevia/source/AbZipExt.pas b/components/Abbrevia/source/AbZipExt.pas deleted file mode 100644 index ed77c11..0000000 --- a/components/Abbrevia/source/AbZipExt.pas +++ /dev/null @@ -1,144 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZipExt.pas *} -{*********************************************************} -{* ABBREVIA: Zip file registration *} -{*********************************************************} - -unit AbZipExt; - -{$I AbDefine.inc} - -interface - -uses - SysUtils, Classes; - -function AbExistingZipAssociation : Boolean; -function AbGetZipAssociation(var App, ID, FileType : string) : Boolean; -function AbRegisterZipExtension(const App : string; - ID, FileType : string; - Replace : Boolean) : Boolean; - - -implementation - -uses -{$IFDEF MSWINDOWS} - Windows, - Messages, - Registry, - ShellAPI, -{$ENDIF} -{$IFDEF LibcAPI} - Libc, -{$ENDIF} - AbConst; - -const - ZipExt = '.zip'; - DefZipID = 'Zip'; - DefZipType = 'Zip File'; - OpenCommand = 'Shell\Open\Command'; - DefaultIcon = 'DefaultIcon'; - -var - Reg : TRegistry; - -{ -------------------------------------------------------------------------- } -function AbExistingZipAssociation : Boolean; -var - App, ID, FileType : string; -begin - Result := False; - Reg := TRegistry.Create; - Reg.RootKey := HKEY_CLASSES_ROOT; - Reg.OpenKey('',False); - if Reg.OpenKey(ZipExt, False) then begin - ID := Reg.ReadString(''); - if Reg.OpenKey('\' + ID, False) then begin - FileType := Reg.ReadString(''); - if Reg.OpenKey(OpenCommand, False) then begin - App := Reg.ReadString(''); - if (App <> '') then - Result := True; - end; - end; - end; - Reg.Free; -end; -{ -------------------------------------------------------------------------- } -function AbGetZipAssociation(var App, ID, FileType : string) : Boolean; -begin - Result := False; - Reg := TRegistry.Create; - Reg.RootKey := HKEY_CLASSES_ROOT; - Reg.OpenKey('',False); - if Reg.OpenKey(ZipExt, False) then begin - ID := Reg.ReadString(''); - if Reg.OpenKey('\' + ID, False) then begin - FileType := Reg.ReadString(''); - if Reg.OpenKey(OpenCommand, False) then begin - App := Reg.ReadString(''); - Result := True; - end; - end; - end; - Reg.Free; -end; -{ -------------------------------------------------------------------------- } -function AbRegisterZipExtension(const App : string; - ID, FileType : string; - Replace : Boolean) : Boolean; -begin - Result := False; - if AbExistingZipAssociation and not Replace then - Exit; - try - if (ID = '') then - ID := DefZipID; - if (FileType = '') then - FileType := DefZipType; - Reg := TRegistry.Create; - Reg.RootKey := HKEY_CLASSES_ROOT; - Reg.OpenKey('',False); - Reg.OpenKey(ZipExt, True); - Reg.WriteString('', ID); - Reg.OpenKey('\' + ID, True); - Reg.WriteString('', FileType); - Reg.OpenKey(OpenCommand, True); - Reg.WriteString('', App); - Reg.OpenKey('\' + DefaultIcon, True); - Reg.WriteString('', App + ',0'); - Result := True; - finally - Reg.Free; - end; -end; -{ -------------------------------------------------------------------------- } - -end. diff --git a/components/Abbrevia/source/AbZipKit.pas b/components/Abbrevia/source/AbZipKit.pas deleted file mode 100644 index e5ba144..0000000 --- a/components/Abbrevia/source/AbZipKit.pas +++ /dev/null @@ -1,284 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZipKit.pas *} -{*********************************************************} -{* ABBREVIA: TABZipKit component *} -{*********************************************************} - -unit AbZipKit; - -{$I AbDefine.inc} - -interface - -uses - Classes, AbZipper, AbArcTyp, AbZipTyp; - -type - TAbCustomZipKit = class(TAbCustomZipper) - protected {private} - FExtractOptions : TAbExtractOptions; - FOnConfirmOverwrite : TAbConfirmOverwriteEvent; - FOnNeedPassword : TAbNeedPasswordEvent; - FPasswordRetries : Byte; - - protected {methods} - procedure DoConfirmOverwrite(var Name : string; var Confirm : Boolean); - virtual; - procedure DoNeedPassword(Sender : TObject; var NewPassword : AnsiString); - virtual; - procedure InitArchive; - override; - procedure SetExtractOptions(Value : TAbExtractOptions); - procedure SetPasswordRetries(Value : Byte); - procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem; - const NewName : string ); - procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream); - procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem); - - protected {properties} - property ExtractOptions : TAbExtractOptions - read FExtractOptions - write SetExtractOptions - default AbDefExtractOptions; - property PasswordRetries : Byte - read FPasswordRetries - write SetPasswordRetries - default AbDefPasswordRetries; - - protected {events} - property OnConfirmOverwrite : TAbConfirmOverwriteEvent - read FOnConfirmOverwrite - write FOnConfirmOverwrite; - property OnNeedPassword : TAbNeedPasswordEvent - read FOnNeedPassword - write FOnNeedPassword; - - public {methods} - constructor Create(AOwner : TComponent); - override; - destructor Destroy; - override; - procedure ExtractAt(Index : Integer; const NewName : string); - procedure ExtractFiles(const FileMask : string); - {extract all files from the archive that match the mask} - procedure ExtractFilesEx(const FileMask, ExclusionMask : string); - {extract files matching FileMask except those matching ExclusionMask} - procedure ExtractTaggedItems; - {extract all tagged items from the archive} - procedure ExtractToStream(const aFileName : string; ToStream : TStream); - {extract the specified item to TStream descendant} - procedure TestTaggedItems; - {test all tagged items in the archive} - - public {property} - property Spanned; - end; - - TAbZipKit = class(TAbCustomZipKit) - published - property ArchiveProgressMeter; - property ArchiveSaveProgressMeter; - property AutoSave; - property BaseDirectory; - property CompressionMethodToUse; - property DeflationOption; - {$IFDEF MSWINDOWS} - property DOSMode; - {$ENDIF} - property ExtractOptions; - property SpanningThreshold; - property ItemProgressMeter; - property LogFile; - property Logging; - property OnArchiveProgress; - property OnArchiveSaveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnConfirmOverwrite; - property OnConfirmProcessItem; - property OnConfirmSave; - property OnLoad; - property OnNeedPassword; - property OnProcessItemFailure; - property OnRequestBlankDisk; - property OnRequestImage; - property OnRequestLastDisk; - property OnRequestNthDisk; - property OnSave; - property Password; - property PasswordRetries; - property StoreOptions; - property TempDirectory; - property Version; - property FileName; {must be after OnLoad} - end; - - -implementation - -uses - AbExcept, - AbUnzPrc, - AbZBrows; - -{ -------------------------------------------------------------------------- } -constructor TAbCustomZipKit.Create( AOwner : TComponent ); -begin - inherited Create( AOwner ); - PasswordRetries := AbDefPasswordRetries; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomZipKit.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.DoConfirmOverwrite( var Name : string; - var Confirm : Boolean ); -begin - Confirm := True; - if Assigned( FOnConfirmOverwrite ) then - FOnConfirmOverwrite( Name, Confirm ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.DoNeedPassword( Sender : TObject; - var NewPassword : AnsiString ); -begin - if Assigned( FOnNeedPassword ) then begin - FOnNeedPassword( Self, NewPassword ); - FPassword := NewPassword; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.ExtractAt(Index : Integer; const NewName : string); - {extract a file from the archive that match the index} -begin - if (FArchive <> nil) then - FArchive.ExtractAt( Index, NewName ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.ExtractFiles(const FileMask : string); - {extract all files from the archive that match the mask} -begin - if (FArchive <> nil) then - FArchive.ExtractFiles( FileMask ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.ExtractFilesEx(const FileMask, ExclusionMask : string); - {extract files matching FileMask except those matching ExclusionMask} -begin - if (FArchive <> nil) then - FArchive.ExtractFilesEx( FileMask, ExclusionMask ) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.ExtractTaggedItems; - {extract all tagged items from the archive} -begin - if (FArchive <> nil) then - FArchive.ExtractTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.ExtractToStream(const aFileName : string; - ToStream : TStream); -begin - if (FArchive <> nil) then - FArchive.ExtractToStream(aFileName, ToStream) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.InitArchive; -begin - inherited InitArchive; - if (FArchive <> nil) then begin - FArchive.ExtractOptions := FExtractOptions; - FArchive.OnConfirmOverwrite := DoConfirmOverwrite; - end; - if FArchive is TAbZipArchive then begin - {properties} - TAbZipArchive(FArchive).PasswordRetries := FPasswordRetries; - {events} - TAbZipArchive(FArchive).OnNeedPassword := DoNeedPassword; - TAbZipArchive(FArchive).ExtractHelper := UnzipProc; - TAbZipArchive(FArchive).ExtractToStreamHelper := UnzipToStreamProc; - TAbZipArchive(FArchive).TestHelper := TestItemProc; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.SetExtractOptions( Value : TAbExtractOptions ); -begin - FExtractOptions := Value; - if (FArchive <> nil) then - FArchive.ExtractOptions := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.SetPasswordRetries( Value : Byte ); -begin - FPasswordRetries := Value; - if (FArchive <> nil) then - (FArchive as TAbZipArchive).PasswordRetries := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.TestTaggedItems; - {test all tagged items in the archive} -begin - if (FArchive <> nil) then - FArchive.TestTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.UnzipProc( Sender : TObject; Item : TAbArchiveItem; - const NewName : string ); -begin - AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream); -begin - AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipKit.TestItemProc(Sender : TObject; Item : TAbArchiveItem); -begin - AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item)); -end; -{ -------------------------------------------------------------------------- } - -end. - diff --git a/components/Abbrevia/source/AbZipOut.pas b/components/Abbrevia/source/AbZipOut.pas deleted file mode 100644 index 405d5f4..0000000 --- a/components/Abbrevia/source/AbZipOut.pas +++ /dev/null @@ -1,2375 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZipOut.pas *} -{*********************************************************} -{* ABBREVIA: Visual Component with Zip and unzip support *} -{* Use AbQZpOut.pas for CLX *} -{*********************************************************} - -{$IFNDEF UsingCLX} -unit AbZipOut; -{$ENDIF} - -{$I AbDefine.inc} - -interface - -uses - Classes, -{$IFDEF MSWINDOWS} - Windows, - Messages, -{$ENDIF} - Types, -{$IFDEF UsingCLX} - QGraphics, - QComCtrls, - QImglist, - QControls, - QForms, -{$ELSE} - Graphics, - Controls, - Forms, - ComCtrls, - Imglist, -{$ENDIF} - AbArcTyp, - AbBrowse, - AbUtils, - AbZipTyp; - - -const - cBitmapHeight = 16; - cBitmapWidth = 16; - -type - TAbZipAttribute = - (zaCompressedSize, zaCompressionMethod, zaCompressionRatio, zaCRC, - zaExternalFileAttributes, zaInternalFileAttributes, zaEncryption, - zaTimeStamp, zaUncompressedSize, zaVersionMade, zaVersionNeeded, - zaComment); - - TAbZipAttributes = set of TAbZipAttribute; - -const - AbDefZipAttributes = - [zaCompressedSize, zaCompressionMethod, zaCompressionRatio, zaCRC, - zaExternalFileAttributes, zaEncryption, zaTimeStamp, zaUncompressedSize]; - - AbDefColor = clWindow; - AbDefHierarchy = True; - AbDefParentColor = False; - -{.Z+} -type - TTreeNodeFriend = class(TTreeNode) - end; -{.Z-} - -type - TWindowsDropEvent = - procedure(Sender : TObject; FileName : string) of object; -{TAbZipDisplayOutline does not support Owner-Draw} -type - TAbZipDisplayOutline = class(TTreeView) - private - FDirBitMap : TBitMap; - FFileBitMap : TBitMap; - FAttrBitMap : TBitMap; - FDirBitMapSelected : TBitMap; - FFileBitMapSelected : TBitMap; - FAttrBitMapSelected : TBitMap; - FImageList : TImageList; - FFileIndex : integer; - FFileSelectedIndex : integer; - FDirectoryIndex : integer; - FDirSelectedIndex : integer; - FAttrIndex : integer; - FBitMapHeight : integer; - FBitMapWidth : integer; - FAttrSelectedIndex : integer; - - FOnWindowsDrop : TWindowsDropEvent; - -{$IFNDEF UsingCLX} - procedure WMDropFiles(var Msg : TWMDropFiles); - message WM_DROPFILES; -{$ENDIF} - - procedure IndexBitmaps; - - procedure SetDirectoryBitMap(Value : TBitmap); - procedure SetFileBitMap(Value : TBitmap); - procedure SetAttributeBitMap(Value : TBitmap); - procedure SetDirectoryBitMapSelected(Value : TBitmap); - procedure SetFileBitMapSelected(Value : TBitmap); - procedure SetAttributeBitMapSelected(Value : TBitmap); - procedure SetBitMapHeight(Value : Integer); - procedure SetBitMapWidth(Value : Integer); - - protected - procedure DoOnWindowsDrop(FileName : string); virtual; - -{$IFDEF UsingCLX} - function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; - const MousePos: TPoint): Boolean; - override; -{$ELSE} - function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; - MousePos: TPoint): Boolean; - override; -{$ENDIF} - procedure Loaded; override; - procedure SetOnWindowsDrop(Value : TWindowsDropEvent); - public - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - public - property zdPictureDirectory : TBitmap - read FDirBitMap - write SetDirectoryBitMap; - property zdPictureFile : TBitmap - read FFileBitMap - write SetFileBitMap; - property zdPictureZipAttribute : TBitmap - read FAttrBitMap - write SetAttributeBitMap; - property zdPictureDirectorySelected : TBitmap - read FDirBitMapSelected - write SetDirectoryBitMapSelected; - property zdPictureFileSelected : TBitmap - read FFileBitMapSelected - write SetFileBitMapSelected; - property zdPictureZipAttributeSelected : TBitmap - read FAttrBitMapSelected - write SetAttributeBitMapSelected; - property BitMapHeight : Integer - read FBitMapHeight - write SetBitMapHeight; - property BitMapWidth : Integer - read FBitMapWidth - write SetBitMapWidth; - property OnWindowsDrop : TWindowsDropEvent - read FOnWindowsDrop - write SetOnWindowsDrop; - end; - -type -{$IFDEF UsingClx} - TAbCustomZipOutline = class(TWidgetControl) -{$ELSE} - TAbCustomZipOutline = class(TWinControl) -{$ENDIF} - protected {private} - FArchive : TAbZipArchive; - FItemProgressMeter : IAbProgressMeter; - FArchiveProgressMeter : IAbProgressMeter; - FAttributes : TAbZipAttributes; - FAutoSave : Boolean; - FBaseDirectory : string; - FCompressionMethodToUse : TAbZipSupportedMethod; - FDeflationOption : TAbZipDeflationOption; -{$IFDEF MSWINDOWS} - FDOSMode : Boolean; -{$ENDIF} - FFileName : string; - FExtractOptions : TAbExtractOptions; - FHierarchy : Boolean; - FLogFile : string; - FLogging : Boolean; - FSpanningThreshold : Longint; - FOutline : TAbZipDisplayOutline; - FPassword : AnsiString; - FPasswordRetries : Byte; - FStoreOptions : TAbStoreOptions; - FTempDirectory : string; - - FOnProcessItemFailure : TAbArchiveItemFailureEvent; - FOnArchiveItemProgress : TAbArchiveItemProgressEvent; - FOnArchiveProgress : TAbArchiveProgressEvent; - FOnChange : TNotifyEvent; - FOnClick : TNotifyEvent; - FOnCollapse : TTVExpandedEvent; - FOnConfirmOverwrite : TAbConfirmOverwriteEvent; - FOnConfirmProcessItem : TAbArchiveItemConfirmEvent; - FOnConfirmSave : TAbArchiveConfirmEvent; - FOnDblClick : TNotifyEvent; - FOnDragDrop : TDragDropEvent; - FOnDragOver : TDragOverEvent; - FOnEndDrag : TEndDragEvent; - FOnEnter : TNotifyEvent; - FOnExit : TNotifyEvent; - FOnExpand : TTVExpandedEvent; - FOnKeyDown : TKeyEvent; - FOnKeyPress : TKeyPressEvent; - FOnKeyUp : TKeyEvent; - FOnLoad : TAbArchiveEvent; - FOnMouseDown : TMouseEvent; - FOnMouseMove : TMouseMoveEvent; - FOnMouseUp : TMouseEvent; - FOnNeedPassword : TAbNeedPasswordEvent; - FOnRequestImage : TAbRequestImageEvent; - FOnRequestLastDisk : TAbRequestDiskEvent; - FOnRequestNthDisk : TAbRequestNthDiskEvent; - FOnRequestBlankDisk : TAbRequestDiskEvent; - FOnSave : TAbArchiveEvent; -{$IFDEF MSWINDOWS} - FOnStartDrag : TStartDragEvent; -{$ENDIF MSWINDOWS} - FOnWindowsDrop : TWindowsDropEvent; - - protected {methods} - procedure AddAttributeNodes(Item : TAbZipItem; oNode : TTreeNode); - procedure DoProcessItemFailure(Sender : TObject; Item : TAbArchiveItem; - ProcessType : TAbProcessType; - ErrorClass : TAbErrorClass; - ErrorCode : Integer); virtual; - procedure DoArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem; - Progress : Byte; var Abort : Boolean); virtual; - procedure DoArchiveProgress(Sender : TObject; Progress : Byte; - var Abort : Boolean); virtual; - procedure DoChange; virtual; - procedure DoClick(Sender : TObject); virtual; - procedure DoCollapse(Sender : TObject; Node: TTreeNode); virtual; - procedure DoConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem; - ProcessType : TAbProcessType; - var Confirm : Boolean); virtual; - procedure DoConfirmOverwrite(var Name : string; var Confirm : Boolean); virtual; - procedure DoConfirmSave(Sender : TObject; var Confirm : Boolean); virtual; - procedure DoDblClick(Sender : TObject); virtual; - procedure DoDragDrop(Sender, Source: TObject; X, Y: Integer); virtual; - procedure DoDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); virtual; - procedure DoOnEndDrag(Sender, Target: TObject; X, Y: Integer); virtual; - procedure DoOnEnter(Sender : TObject); virtual; - procedure DoOnExit(Sender : TObject); virtual; - procedure DoExpand(Sender: TObject; Node : TTreeNode); virtual; - procedure DoKeyDown(Sender : TObject; var Key: Word; Shift: TShiftState); - virtual; - procedure DoKeyPress(Sender : TObject; var Key: Char); virtual; - procedure DoKeyUp(Sender : TObject; var Key: Word; Shift: TShiftState); - virtual; - procedure DoLoad(Sender : TObject); virtual; - procedure DoMouseDown(Sender : TObject; Button: TMouseButton; - Shift: TShiftState; X, Y : Integer); virtual; - procedure DoMouseMove(Sender : TObject; Shift: TShiftState; X, Y: Integer); - virtual; - procedure DoMouseUp(Sender : TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); virtual; - procedure DoNeedPassword(Sender : TObject; var NewPassword : AnsiString); - virtual; - procedure DoSave(Sender : TObject); virtual; -{$IFDEF MSWINDOWS} - procedure DoOnStartDrag(Sender: TObject; var DragObject: TDragObject); - virtual; -{$ENDIF} - procedure DoWindowsDrop(Sender : TObject; FileName : string); virtual; - function GetBorderStyle : TBorderStyle; - function GetCount : Integer; - function GetCursor : TCursor; -{$IFNDEF UsingCLX} - function GetDragCursor : TCursor; -{$ENDIF} - function GetDragMode : TDragMode; - function GetItem(Index : Integer) : TAbZipItem; - function GetPictureDirectory : TBitmap; - function GetPictureFile : TBitmap; - function GetPictureZipAttribute: TBitmap; - function GetPictureDirectorySelected : TBitmap; - function GetPictureFileSelected : TBitmap; - function GetPictureZipAttributeSelected : TBitmap; - function GetPictureHeight : Integer; - function GetPictureWidth : Integer; - function GetSelectedItem : LongInt; - function GetSelectedZipItem : TAbZipItem; - function GetStatus : TAbArchiveStatus; - function GetVersion : string; - function GetZipfileComment : AnsiString; - procedure InitArchive; - procedure Loaded; override; - procedure Notification(Component: TComponent; Operation: TOperation); - override; - procedure PutItem(Index : Integer; Value : TAbZipItem); - procedure SetArchiveProgressMeter(const Value: IAbProgressMeter); - procedure SetAttributes(Value : TAbZipAttributes); - procedure SetAutoSave(Value : Boolean); - procedure SetBaseDirectory(Value : string); - procedure SetBorderStyle(Value : TBorderStyle); - procedure SetCompressionMethodToUse(Value : TAbZipSupportedMethod); - procedure SetDeflationOption(Value : TAbZipDeflationOption); -{$IFDEF MSWINDOWS} - procedure SetDOSMode(Value : Boolean); -{$ENDIF} - procedure SetCursor(Value : TCursor); -{$IFNDEF UsingCLX} - procedure SetDragCursor(Value : TCursor); -{$ENDIF} -{$IFNDEF UsingCLX} - procedure SetDragMode(Value : TDragMode); override; -{$ENDIF} - procedure SetExtractOptions(Value : TAbExtractOptions); - procedure SetFileName(const aFileName : string); virtual; - procedure SetHierarchy(Value : Boolean); - procedure SetItemProgressMeter(const Value: IAbProgressMeter); - procedure SetLogFile(Value : string); - procedure SetLogging(Value : Boolean); - procedure SetOnRequestImage(Value : TAbRequestImageEvent); - procedure SetOnRequestLastDisk(Value : TAbRequestDiskEvent); - procedure SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent); - procedure SetOnRequestBlankDisk(Value : TAbRequestDiskEvent); - procedure SetOnWindowsDrop(Value : TWindowsDropEvent); - procedure SetPassword(Value : AnsiString); - procedure SetPasswordRetries(Value : Byte); - procedure SetPictureDirectory(Value : TBitmap); - procedure SetPictureFile(Value : TBitmap); - procedure SetPictureZipAttribute(Value : TBitmap); - procedure SetPictureDirectorySelected(Value : TBitmap); - procedure SetPictureFileSelected(Value : TBitmap); - procedure SetPictureZipAttributeSelected(Value : TBitmap); - procedure SetPictureHeight(Value : Integer); - procedure SetPictureWidth(Value : Integer); - procedure SetSelectedItem(Value : LongInt); - procedure SetStoreOptions(Value : TAbStoreOptions); - procedure SetTempDirectory(Value : string); - procedure SetSpanningThreshold(Value : Longint); - procedure SetVersion(Value : string); - procedure SetZipfileComment(Value : AnsiString); - procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem); - procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem; - const NewName : string); - procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream); - procedure UpdateOutline; - procedure ZipProc(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream); - procedure ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem; - OutStream, InStream : TStream); - - protected {properties} - property ArchiveProgressMeter : IAbProgressMeter - read FArchiveProgressMeter - write SetArchiveProgressMeter; - property Attributes : TAbZipAttributes - read FAttributes - write SetAttributes - default AbDefZipAttributes; - property AutoSave : Boolean - read FAutoSave - write SetAutoSave - default AbDefAutoSave; - property BaseDirectory : string - read FBaseDirectory - write SetBaseDirectory; - property BorderStyle : TBorderStyle - read GetBorderStyle - write SetBorderStyle; - property CompressionMethodToUse : TAbZipSupportedMethod - read FCompressionMethodToUse - write SetCompressionMethodToUse - default AbDefCompressionMethodToUse; - property Cursor : TCursor - read GetCursor - write SetCursor; - property DeflationOption : TAbZipDeflationOption - read FDeflationOption - write SetDeflationOption - default AbDefDeflationOption; -{$IFDEF MSWINDOWS} - property DOSMode : Boolean - read FDOSMode - write SetDOSMode; -{$ENDIF} -{$IFNDEF UsingCLX} - property DragCursor : TCursor - read GetDragCursor - write SetDragCursor; - property DragMode : TDragMode - read GetDragMode - write SetDragMode; -{$ENDIF} - property ExtractOptions : TAbExtractOptions - read FExtractOptions - write SetExtractOptions - default AbDefExtractOptions; - property FileName : string - read FFileName - write SetFileName; - property Hierarchy : Boolean - read FHierarchy - write SetHierarchy - default AbDefHierarchy; - property SpanningThreshold : Longint - read FSpanningThreshold - write SetSpanningThreshold - default 0; - property ItemProgressMeter : IAbProgressMeter - read FItemProgressMeter - write SetItemProgressMeter; - property LogFile : string - read FLogFile - write SetLogFile; - property Logging : Boolean - read FLogging - write SetLogging; - property OnWindowsDrop : TWindowsDropEvent - read FOnWindowsDrop - write SetOnWindowsDrop; - property Password : AnsiString - read FPassword - write SetPassword; - property PasswordRetries : Byte - read FPasswordRetries - write SetPasswordRetries - default AbDefPasswordRetries; - property PictureDirectory : TBitmap - read GetPictureDirectory - write SetPictureDirectory; - property PictureFile : TBitmap - read GetPictureFile - write SetPictureFile; - property PictureZipAttribute : TBitmap - read GetPictureZipAttribute - write SetPictureZipAttribute; - property PictureDirectorySelected : TBitmap - read GetPictureDirectorySelected - write SetPictureDirectorySelected; - property PictureFileSelected : TBitmap - read GetPictureFileSelected - write SetPictureFileSelected; - property PictureZipAttributeSelected : TBitmap - read GetPictureZipAttributeSelected - write SetPictureZipAttributeSelected; - property PictureHeight : Integer - read GetPictureHeight - write SetPictureHeight; - property PictureWidth : Integer - read GetPictureWidth - write SetPictureWidth; - property StoreOptions : TAbStoreOptions - read FStoreOptions - write SetStoreOptions - default AbDefStoreOptions; - property Version : string - read GetVersion - write SetVersion - stored False; - - protected {events} - property OnProcessItemFailure : TAbArchiveItemFailureEvent - read FOnProcessItemFailure - write FOnProcessItemFailure; - property OnArchiveItemProgress : TAbArchiveItemProgressEvent - read FOnArchiveItemProgress - write FOnArchiveItemProgress; - property OnArchiveProgress : TAbArchiveProgressEvent - read FOnArchiveProgress - write FOnArchiveProgress; - property OnChange : TNotifyEvent - read FOnChange - write FOnChange; - property OnClick : TNotifyEvent - read FOnClick - write FOnClick; - property OnConfirmProcessItem : TAbArchiveItemConfirmEvent - read FOnConfirmProcessItem - write FOnConfirmProcessItem; - property OnConfirmOverwrite : TAbConfirmOverwriteEvent - read FOnConfirmOverwrite - write FOnConfirmOverwrite; - property OnConfirmSave : TAbArchiveConfirmEvent - read FOnConfirmSave - write FOnConfirmSave; - property OnCollapse : TTVExpandedEvent - read FOnCollapse - write FOnCollapse; - property OnDblClick : TNotifyEvent - read FOnDblClick - write FOnDblClick; - property OnDragDrop : TDragDropEvent - read FOnDragDrop - write FOnDragDrop; - property OnDragOver : TDragOverEvent - read FOnDragOver - write FOnDragOver; - property OnEndDrag : TEndDragEvent - read FOnEndDrag - write FOnEndDrag; - property OnEnter : TNotifyEvent - read FOnEnter - write FOnEnter; - property OnExit : TNotifyEvent - read FOnExit - write FOnExit; - property OnExpand : TTVExpandedEvent - read FOnExpand - write FOnExpand; - property OnKeyDown : TKeyEvent - read FOnKeyDown - write FOnKeyDown; - property OnKeyPress : TKeyPressEvent - read FOnKeyPress - write FOnKeyPress; - property OnKeyUp : TKeyEvent - read FOnKeyUp - write FOnKeyUp; - property OnLoad : TAbArchiveEvent - read FOnLoad - write FOnLoad; - property OnMouseDown : TMouseEvent - read FOnMouseDown - write FOnMouseDown; - property OnMouseMove : TMouseMoveEvent - read FOnMouseMove - write FOnMouseMove; - property OnMouseUp : TMouseEvent - read FOnMouseUp - write FOnMouseUp; - property OnNeedPassword : TAbNeedPasswordEvent - read FOnNeedPassword - write FOnNeedPassword; - property OnRequestImage : TAbRequestImageEvent - read FOnRequestImage - write SetOnRequestImage; - property OnRequestLastDisk : TAbRequestDiskEvent - read FOnRequestLastDisk - write SetOnRequestLastDisk; - property OnRequestNthDisk : TAbRequestNthDiskEvent - read FOnRequestNthDisk - write SetOnRequestNthDisk; - property OnRequestBlankDisk : TAbRequestDiskEvent - read FOnRequestBlankDisk - write SetOnRequestBlankDisk; - property OnSave : TAbArchiveEvent - read FOnSave - write FOnSave; -{$IFDEF MSWINDOWS} - property OnStartDrag : TStartDragEvent - read FOnStartDrag - write FOnStartDrag; -{$ENDIF MSWINDOWS} - - public {methods} - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - - procedure AddFiles(const FileMask : string; SearchAttr : Integer); - {Add files to the archive where the disk filespec matches} - procedure AddFilesEx(const FileMask, ExclusionMask : string; - SearchAttr : Integer); - {Add files that match Filemask except those matching ExclusionMask} - procedure AddFromStream(const NewName : string; FromStream : TStream); - {Create and add a zip item directly from a stream} - procedure ClearTags; - {Clear all tags from the archive} - procedure CloseArchive; - {closes the archive by setting FileName to ''} - procedure DeleteAt(Index : Integer); - {delete item specified by index} - procedure DeleteFiles(const FileMask : string); - {Delete all files from the archive that match the file mask} - procedure DeleteFilesEx(const FileMask, ExclusionMask : string); - {Delete files that match Filemask except those matching ExclusionMask} - procedure DeleteTaggedItems; - {delete all tagged items from the archive} - procedure ExtractAt(Index : Integer; const NewName : string); - {extract item specified by index} - procedure ExtractFiles(const FileMask : string); - {extract all files from the archive that match the mask} - procedure ExtractFilesEx(const FileMask, ExclusionMask : string); - {Extract files that match Filemask except those matching ExclusionMask} - procedure ExtractTaggedItems; - {extract all tagged items from the archive} - procedure ExtractToStream(const aFileName : string; ToStream : TStream); - {extract an item directly to a stream} - function FindItem(aItem : TAbArchiveItem) : Integer; - {extract specified item} - function FindFile(const aFileName : string) : Integer; - {find the item with the given file name} - procedure FreshenFiles(const FileMask : string); - {freshen all items that match the file mask} - procedure FreshenFilesEx(const FileMask, ExclusionMask : string); - {freshen items matching FileMask but not ExclusionMask} - procedure FreshenTaggedItems; - {freshen all tagged items} - procedure FullCollapse; - procedure FullExpand; - function GetTextItem(const Value: string): LongInt; - function GetOutLineItem(X, Y : Integer): LongInt; - procedure Move(aItem : TAbArchiveItem; NewStoredPath : string); - procedure OpenArchive(const aFileName : String); - {opens the archive} - procedure Replace(aItem : TAbArchiveItem); - procedure Save; - {saves the archive} - procedure TagItems(const FileMask : string); - procedure TestTaggedItems; - procedure UnTagItems(const FileMask : string); - - public {properties} - property Count : Integer - read GetCount; - property Items[Index : Integer] : TAbZipItem - read GetItem - write PutItem; default; - property SelectedItem: LongInt - read GetSelectedItem - write SetSelectedItem; - property SelectedZipItem : TAbZipItem - read GetSelectedZipItem; - property Status : TAbArchiveStatus - read GetStatus; - property TempDirectory : string - read FTempDirectory - write SetTempDirectory; - property ZipfileComment : AnsiString - read GetZipfileComment - write SetZipfileComment; - end; - - -type - TAbZipOutline = class(TAbCustomZipOutline) - published - property Align; - property ArchiveProgressMeter; - property ItemProgressMeter; - property Attributes; - property AutoSave; - property BaseDirectory; - property BorderStyle; - property Color - default AbDefColor; - property CompressionMethodToUse; - property Count; -{$IFNDEF UsingCLX} - property Ctl3D; -{$ENDIF} - property Cursor; - property DeflationOption; -{$IFDEF MSWINDOWS} - property DOSMode; -{$ENDIF} -{$IFNDEF UsingCLX} - property DragCursor; -{$ENDIF} - property DragMode; - property Enabled; - property ExtractOptions; - property Font; - property Hierarchy; - property LogFile; - property Logging; - property OnProcessItemFailure; - property OnArchiveItemProgress; - property OnArchiveProgress; - property OnChange; - property OnClick; - property OnConfirmProcessItem; - property OnConfirmOverwrite; - property OnConfirmSave; - property OnCollapse; - property OnDblClick; - property OnDragDrop; - property OnDragOver; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnExpand; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnLoad; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; -{$IFNDEF UsingCLX} - property OnMouseWheel; - property OnMouseWheelDown; - property OnMouseWheelUp; -{$ENDIF} - property OnNeedPassword; - property OnRequestImage; - property OnRequestLastDisk; - property OnRequestNthDisk; - property OnRequestBlankDisk; - property OnSave; -{$IFDEF MSWINDOWS} - property OnStartDrag; -{$ENDIF MSWINDOWS} - property OnWindowsDrop; - property ParentColor - default AbDefParentColor; -{$IFNDEF UsingCLX} - property ParentCtl3D; -{$ENDIF} - property ParentFont; - property ParentShowHint; - property Password; - property PasswordRetries; - property PictureDirectory; - property PictureDirectorySelected; - property PictureFile; - property PictureFileSelected; - property PictureZipAttribute; - property PictureZipAttributeSelected; - property PopupMenu; - property ShowHint; - property StoreOptions; - property TabOrder; - property TabStop; - property SpanningThreshold; - property Version; - property TempDirectory; - property Visible; - property FileName; {must be after OnLoad} - end; - -implementation - -uses -{$IFDEF MSWINDOWS} - ShellApi, -{$ENDIF} - SysUtils, - AbConst, - AbExcept, - AbResString, - AbUnzPrc, - AbZipPrc; - -{$R AbZipOut.res} - -type - TAbZipArchiveFriend = class(TAbZipArchive) - end; - -{ -------------------------------------------------------------------------- } -{ ========================================================================== } -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.IndexBitmaps; -begin - FImageList.Clear; - - FImageList.Height := FBitMapHeight; - FImageList.Width := FBitMapWidth; - - if not FAttrBitMap.Empty then - FAttrIndex := FImageList.Add( FAttrBitMap, nil ); - if not FAttrBitMap.Empty then - FAttrSelectedIndex := FImageList.Add( FAttrBitMapSelected, nil ); - if not FAttrBitMap.Empty then - FDirectoryIndex := FImageList.Add( FDirBitMap, nil ); - if not FAttrBitMap.Empty then - FDirSelectedIndex := FImageList.Add( FDirBitMapSelected , nil ); - if not FAttrBitMap.Empty then - FFileIndex := FImageList.Add( FFileBitMap, nil ); - if not FAttrBitMap.Empty then - FFileSelectedIndex := FImageList.Add( FFileBitMapSelected, nil ); -end; -{ -------------------------------------------------------------------------- } -constructor TAbZipDisplayOutline.Create(AOwner : TComponent); -begin - FBitMapHeight := cBitmapHeight; - FBitMapWidth := cBitmapWidth; - - FDirBitMap := TBitMap.Create; - FFileBitMap := TBitMap.Create; - FAttrBitMap := TBitMap.Create; - FDirBitMapSelected := TBitMap.Create; - FFileBitMapSelected := TBitMap.Create; - FAttrBitMapSelected := TBitMap.Create; - - FDirBitMap.LoadFromResourceName( HInstance, 'DIR' ); - FFileBitMap.LoadFromResourceName( HInstance, 'FILEFIX' ); - FAttrBitMap.LoadFromResourceName( HInstance, 'ATTR' ); - FDirBitMapSelected.LoadFromResourceName ( HInstance, 'DIRS' ); - FFileBitMapSelected.LoadFromResourceName( HInstance, 'FILES' ); - FAttrBitMapSelected.LoadFromResourceName( HInstance, 'ATTRS' ); - - inherited Create(AOwner); - - FImageList := TImageList.Create(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.Loaded; -begin - inherited Loaded; -{$IFNDEF UsingCLX} - if Assigned(FOnWindowsDrop) then - DragAcceptFiles(Handle, True); -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -destructor TAbZipDisplayOutline.Destroy; -begin - FImageList.Free; - FDirBitMap.Free; - FFileBitMap.Free; - FAttrBitMap.Free; - FDirBitMapSelected.Free; - FFileBitMapSelected.Free; - FAttrBitMapSelected.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetAttributeBitMap(Value : TBitmap); -begin - if Value <> nil then begin - FAttrBitMap.assign( Value ) - end else begin - FAttrBitMap.LoadFromResourceName( HInstance, 'ATTR' ); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetDirectoryBitMap(Value : TBitmap); -begin - if Value <> nil then begin - FDirBitMap.assign( Value ) - end else begin - FDirBitMap.LoadFromResourceName( HInstance, 'DIR' ); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetFileBitMap(Value : TBitmap); -begin - if Value <> nil then begin - FFileBitMap.assign( Value ) - end else begin - FFileBitMap.LoadFromResourceName( HInstance, 'FILEFIX' ); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetAttributeBitMapSelected(Value : TBitmap); -begin - if Value <> nil then - FAttrBitMapSelected.assign( Value ) - else begin - FAttrBitMapSelected.LoadFromResourceName( HInstance, 'ATTRS' ); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetDirectoryBitMapSelected(Value : TBitmap); -begin - if Value <> nil then - FDirBitMapSelected.assign( Value ) - else begin - FDirBitMapSelected.LoadFromResourceName ( HInstance, 'DIRS' ); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetFileBitMapSelected(Value : TBitmap); -begin - if Value <> nil then - FFileBitMapSelected.assign( Value ) - else begin - FFileBitMapSelected.LoadFromResourceName( HInstance, 'FILES' ); - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetBitMapHeight(Value : Integer); -begin - if FBitMapHeight <> Value then - FBitMapHeight := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetBitMapWidth(Value : Integer); -begin - if FBitMapWidth <> Value then - FBitMapWidth := Value; -end; -{$IFNDEF UsingCLX} -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.WMDropFiles(var Msg : TWMDropFiles); -var - FileName : string; - I : Integer; - NumFiles : Integer; -begin - Msg.Result := 1; - NumFiles := DragQueryFile(Msg.Drop, Cardinal(-1), nil, 0); - try - for I := 0 to pred(NumFiles) do begin - SetLength(FileName, DragQueryFile(Msg.Drop, I, nil, 0)); - DragQueryFile(Msg.Drop, I, PChar(FileName), Length(FileName) + 1); - DoOnWindowsDrop(FileName); - end; - finally - DragFinish(Msg.Drop); - end; - if IsIconic(Application.Handle) then - ShowWindow(Application.Handle, SW_SHOWNORMAL) - else - BringWindowToTop(Handle); -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.DoOnWindowsDrop(FileName : string); -begin - if csDesigning in ComponentState then - Exit; - if csLoading in ComponentState then - Exit; - if Assigned(FOnWindowsDrop) then - FOnWindowsDrop(Self, FileName); -end; -{ -------------------------------------------------------------------------- } -{$IFDEF UsingCLX} -function TAbZipDisplayOutline.DoMouseWheel(Shift: TShiftState; - WheelDelta: Integer; const MousePos: TPoint): Boolean; -{$ELSE} -function TAbZipDisplayOutline.DoMouseWheel(Shift: TShiftState; - WheelDelta: Integer; MousePos: TPoint): Boolean; -{$ENDIF} - const - WHEEL_DELTA = 120; - var - oHold : TTreeNode; - oNode : TTreeNode; -begin - { We always return true - if there's an event handler that returns } - { false, we'll do the work; if it returns true, the work has been } - { done, ergo this routine should return true. } - Result := True; - if not inherited DoMouseWheel(Shift, WheelDelta, MousePos) then begin - if Items.Count = 0 then - Exit; - - if Selected = nil then - exit; - if Selected.HasChildren then - Selected.Expand( false ); - - oNode := nil; - oHold := Selected; - if WheelDelta < 0 then begin - if oHold.HasChildren then - oNode := oHold.getFirstChild; - if oNode = nil then - oNode := oHold.GetNextChild( oHold ); - if oNode = nil then - oNode := oHold.GetNext; - end else begin - oNode := oHold.GetPrevChild( oHold ); - if oNode <> nil then begin - if oNode.HasChildren then - oNode := oNode.GetLastChild; - end else - oNode := oHold.GetPrev; - end; - if oNode <> nil then - Selected := oNode; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDisplayOutline.SetOnWindowsDrop(Value : TWindowsDropEvent); -{$IFNDEF UsingCLX} -var - WasAccepting : Boolean; -{$ENDIF} -begin -{$IFNDEF UsingCLX} - WasAccepting := Assigned(FOnWindowsDrop); - FOnWindowsDrop := Value; - if csLoading in ComponentState then - Exit; - if csDestroying in ComponentState then - Exit; - if Assigned(Value) then - DragAcceptFiles(Handle, True) - else if WasAccepting then - DragAcceptFiles(Handle, False); -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -{ ========================================================================== } -{ -------------------------------------------------------------------------- } -constructor TAbCustomZipOutline.Create(AOwner : TComponent); -begin - inherited Create(AOwner); - Width := 300; - Height := 143; - Color := AbDefColor; - ParentColor := AbDefParentColor; - - FOutline := TAbZipDisplayOutline.Create(Self); - FOutline.Parent := Self; - FOutline.Visible := True; - FOutline.Align := alClient; - FOutline.ParentColor := True; -{$IFNDEF UsingCLX} - FOutline.ParentCtl3D := True; -{$ENDIF} - FOutline.ParentFont := True; - FOutline.ParentShowHint := True; - - FOutline.Images := FOutline.FImageList; - - AutoSave := AbDefAutoSave; - Attributes := AbDefZipAttributes; - CompressionMethodToUse := AbDefCompressionMethodToUse; - DeflationOption := AbDefDeflationOption; - ExtractOptions := AbDefExtractOptions; - Hierarchy := AbDefHierarchy; - PasswordRetries := AbDefPasswordRetries; - StoreOptions := AbDefStoreOptions; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomZipOutline.Destroy; -begin - FArchive.Free; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.AddAttributeNodes( Item : TAbZipItem; - oNode : TTreeNode ); -var - ExtAttrString : string; - dt : TDateTime; - li : LongInt; - s : string; - tmpNode : TTreeNode; -begin - with Item do begin - if zaCompressedSize in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbCompressedSizeFormatS, - [CompressedSize])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaUnCompressedSize in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbUncompressedSizeFormatS, - [UncompressedSize])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaCompressionMethod in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbCompressionMethodFormatS, - [ZipCompressionMethodToString(CompressionMethod)])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaCompressionRatio in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbCompressionRatioFormatS, - [CompressionRatio])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaCRC in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbCRCFormatS, - [CRC32])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaExternalFileAttributes in Attributes then begin - ExtAttrString := ''; -{$IFDEF MSWINDOWS} -{$WARN SYMBOL_PLATFORM OFF} - if (faReadOnly and ExternalFileAttributes) = faReadOnly then - ExtAttrString := ExtAttrString + AbReadOnlyS; - if (faHidden and ExternalFileAttributes) = faHidden then - ExtAttrString := ExtAttrString + AbHiddenS; - if (faSysFile and ExternalFileAttributes) = faSysFile then - ExtAttrString := ExtAttrString + AbSystemS; - if (faArchive and ExternalFileAttributes) = faArchive then - ExtAttrString := ExtAttrString + AbArchivedS; -{$WARN SYMBOL_PLATFORM ON} -{$ENDIF} - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbEFAFormatS, - [ExtAttrString])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaInternalFileAttributes in Attributes then - if InternalFileAttributes = 1 then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbIFAFormatS, - [AbTextS])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end else begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbIFAFormatS, - [AbBinaryS])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaEncryption in Attributes then - if IsEncrypted then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbEncryptionFormatS, - [AbEncryptedS])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end else begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbEncryptionFormatS, - [AbNotEncryptedS])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaTimeStamp in Attributes then begin - if (LastModFileDate + LastModFileTime = 0) then - s := AbUnknownS - else begin - li := LongInt(LastModFileDate) shl 16 + LastModFileTime; - dt := FileDateToDateTime(li); - s := DateTimeToStr(dt); - end; - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbTimeStampFormatS, [s])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaVersionMade in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbMadeByFormatS, - [Lo(VersionMadeBy)/ 10.0])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaVersionNeeded in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbNeededFormatS, - [Lo(VersionNeededToExtract)/ 10.0])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - if zaComment in Attributes then begin - tmpNode := FOutline.Items.AddChild(oNode, - Format(AbCommentFormatS, - [FileComment])); - tmpNode.ImageIndex := FOutline.FAttrIndex; - tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex; - end; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.AddFiles(const FileMask : string; - SearchAttr : Integer); - {Add files to the archive where the disk filespec matches} -begin - if Assigned(FArchive) then - FArchive.AddFiles(FileMask, SearchAttr) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.AddFilesEx(const FileMask, ExclusionMask : string; - SearchAttr : Integer); - {Add files that match Filemask except those matching ExclusionMask} -begin - if Assigned(FArchive) then - FArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.AddFromStream(const NewName : string; - FromStream : TStream); - {Add zip item directly from TStream descendant} -begin - if Assigned(FArchive) then begin - FromStream.Position := 0; - FArchive.AddFromStream(NewName, FromStream); - end else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ClearTags; - {Clear all tags from the archive} -begin - if Assigned(FArchive) then - FArchive.ClearTags - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DeleteAt(Index : Integer); - {delete item at Index} -begin - if Assigned( FArchive ) then - FArchive.DeleteAt( Index ) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DeleteFiles(const FileMask : string); - {delete all files from the archive that match the file mask} -begin - if Assigned(FArchive) then - FArchive.DeleteFiles(FileMask) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DeleteFilesEx(const FileMask, ExclusionMask : string); - {Delete files that match Filemask except those matching ExclusionMask} -begin - if Assigned(FArchive) then - FArchive.DeleteFilesEx(FileMask, ExclusionMask) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DeleteTaggedItems; - {delete all tagged items from the archive} -begin - if Assigned(FArchive) then - FArchive.DeleteTaggedItems - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoProcessItemFailure(Sender : TObject; - Item : TAbArchiveItem; - ProcessType : TAbProcessType; - ErrorClass : TAbErrorClass; - ErrorCode : Integer); -begin - if Assigned(FOnProcessItemFailure) then - FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoArchiveItemProgress(Sender : TObject; - Item : TAbArchiveItem; - Progress : Byte; - var Abort : Boolean); -begin - Abort := False; - if Assigned(FItemProgressMeter) then - FItemProgressMeter.DoProgress(Progress); - if Assigned(FOnArchiveItemProgress) then - FOnArchiveItemProgress(Self, Item, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoArchiveProgress(Sender : TObject; - Progress : Byte; - var Abort : Boolean); -begin - Abort := False; - if Assigned(FArchiveProgressMeter) then - FArchiveProgressMeter.DoProgress(Progress); - if Assigned(FOnArchiveProgress) then - FOnArchiveProgress(Self, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoChange; -begin - {Archive now points to the new zip file} - UpdateOutline; - {then, call the FOnChange event...} - if Assigned(FOnChange) then - FOnChange(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoClick(Sender : TObject); -begin - if Assigned(FOnClick) then - FOnClick(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoCollapse(Sender: TObject; Node: TTreeNode); -begin - if Assigned(FOnCollapse) then - FOnCollapse(Self, Node); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoConfirmProcessItem(Sender : TObject; - Item : TAbArchiveItem; - ProcessType : TAbProcessType; - var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FItemProgressMeter) then - FItemProgressMeter.Reset; - if Assigned(FOnConfirmProcessItem) then - FOnConfirmProcessItem(Self, Item, ProcessType, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoConfirmOverwrite(var Name : string; - var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FOnConfirmOverwrite) then - FOnConfirmOverwrite(Name, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoConfirmSave(Sender : TObject; - var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FOnConfirmSave) then - FOnConfirmSave(Self, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoDblClick(Sender : TObject); -begin - if Assigned(FOnDblClick) then - FOnDblClick(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoDragDrop(Sender, Source: TObject; X, Y: Integer); -begin - if Assigned(FOnDragDrop) then - FOnDragDrop(Self, Source, X, Y); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); -begin - Accept := False; - if Assigned(FOnDragOver) then - FOnDragOver(Self, Source, X, Y, State, Accept); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoOnEndDrag(Sender, Target: TObject; X, Y: Integer); -begin - if Assigned(FOnEndDrag) then - FOnEndDrag(Self, Target, X, Y); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoOnEnter(Sender : TObject); -begin - if Assigned(FOnEnter) then - FOnEnter(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoOnExit(Sender : TObject); -begin - if Assigned(FOnExit) then - FOnExit(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoExpand(Sender: TObject; Node : TTreeNode); -begin - if Assigned(FOnExpand) then - FOnExpand(Self, Node); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoKeyDown(Sender : TObject; var Key: Word; - Shift: TShiftState); -begin - if Assigned(FOnKeyDown) then - FOnKeyDown(Self, Key, Shift); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoKeyPress(Sender : TObject; var Key: Char); -begin - if Assigned(FOnKeyPress) then - FOnKeyPress(Self, Key); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoKeyUp(Sender : TObject; var Key: Word; - Shift: TShiftState); -begin - if Assigned(FOnKeyUp) then - FOnKeyUp(Self, Key, Shift); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoLoad(Sender : TObject); -begin - if Assigned(FOnLoad) then - FOnLoad(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoMouseDown(Sender : TObject; Button: TMouseButton; - Shift: TShiftState; - X, Y : Integer); -begin - if Assigned(FOnMouseDown) then - FOnMouseDown(Self, Button, Shift, X, Y); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoMouseMove(Sender : TObject; - Shift: TShiftState; X, Y: Integer); -begin - if Assigned(FOnMouseMove) then - FOnMouseMove(Self, Shift, X, Y); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoMouseUp(Sender : TObject; - Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - if Assigned(FOnMouseUp) then - FOnMouseUp(Self, Button, Shift, X, Y); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoNeedPassword(Sender : TObject; - var NewPassword : AnsiString); -begin - if Assigned(FOnNeedPassword) then begin - FOnNeedPassword(Sender, NewPassword); - Password := NewPassword; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoSave(Sender : TObject); -begin - if Assigned(FOnSave) then - FOnSave(Self); -end; -{ -------------------------------------------------------------------------- } -{$IFDEF MSWINDOWS} -procedure TAbCustomZipOutline.DoOnStartDrag(Sender: TObject; - var DragObject: TDragObject); -begin - if Assigned(FOnStartDrag) then - FOnStartDrag(Self, DragObject); -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.DoWindowsDrop(Sender : TObject; - FileName : string); -begin - if csDesigning in ComponentState then - Exit; - if csLoading in ComponentState then - Exit; - if Assigned(FOnWindowsDrop) then - FOnWindowsDrop(Self, FileName); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ExtractAt(Index : Integer; const NewName : string); - {extract a file from the archive that match the index} -begin - if Assigned(FArchive) then - FArchive.ExtractAt(Index, NewName) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ExtractFiles(const FileMask : string); - {extract all files from the archive that match the mask} -begin - if Assigned(FArchive) then - FArchive.ExtractFiles(FileMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ExtractFilesEx(const FileMask, ExclusionMask : string); - {extract files that match FileMask except those matching ExclusionMask} -begin - if Assigned(FArchive) then - FArchive.ExtractFilesEx(FileMask, ExclusionMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ExtractTaggedItems; - {extract all tagged items from the archive} -begin - if Assigned(FArchive) then - FArchive.ExtractTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ExtractToStream(const aFileName : string; - ToStream : TStream); -begin - if Assigned(FArchive) then - FArchive.ExtractToStream(aFileName, ToStream) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.FindFile(const aFileName : string) : Integer; -begin - if Assigned(FArchive) then - Result := FArchive.FindFile(aFileName) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.FindItem(aItem : TAbArchiveItem) : Integer; -begin - if Assigned(FArchive) then - Result := FArchive.FindItem(aItem) - else - Result := -1; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.FreshenFiles(const FileMask : string); - {freshen all items that match the file mask} -begin - if Assigned(FArchive) then - FArchive.FreshenFiles(FileMask) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.FreshenFilesEx(const FileMask, ExclusionMask : string); - {freshen all items matching FileMask except those matching ExclusionMask} -begin - if Assigned(FArchive) then - FArchive.FreshenFilesEx(FileMask, ExclusionMask) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.FreshenTaggedItems; - {freshen all tagged items} -begin - if Assigned(FArchive) then - FArchive.FreshenTaggedItems - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.FullCollapse; -begin - FOutline.FullCollapse; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.FullExpand; -begin - FOutline.FullExpand; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetBorderStyle : TBorderStyle; -begin - Result := FOutline.BorderStyle; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetCount : Integer; -begin - if Assigned(FArchive) then - Result := FArchive.Count - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetCursor : TCursor; -begin - Result := FOutline.Cursor; -end; -{ -------------------------------------------------------------------------- } -{$IFNDEF UsingCLX} -function TAbCustomZipOutline.GetDragCursor : TCursor; -begin - Result := FOutline.DragCursor; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetDragMode : TDragMode; -begin - Result := FOutline.DragMode; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetItem(Index : Integer) : TAbZipItem; -begin - if Assigned(FArchive) then - Result := TAbZipItem(FArchive.ItemList[Index]) - else - Result := nil; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureDirectory : TBitmap; -begin - Result := FOutline.zdPictureDirectory; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureFile : TBitmap; -begin - Result := FOutline.zdPictureFile; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureZipAttribute: TBitmap; -begin - Result := FOutline.zdPictureZipAttribute; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureDirectorySelected : TBitmap; -begin - Result := FOutline.zdPictureDirectorySelected; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureFileSelected : TBitmap; -begin - Result := FOutline.zdPictureFileSelected; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureZipAttributeSelected: TBitmap; -begin - Result := FOutline.zdPictureZipAttributeSelected; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureHeight: Integer; -begin - Result := FOutline.FBitMapHeight; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetPictureWidth: Integer; -begin - Result := FOutline.FBitMapWidth; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetSelectedItem : LongInt; -begin - Result := FOutline.Selected.AbsoluteIndex; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetSelectedZipItem : TAbZipItem; -begin - {returns nil if the currently selected item of the outline is a folder or - a zip attribute} - if FOutline.Items.Count > 0 then - Result := FOutline.Selected.Data - else - Result := nil; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetStatus : TAbArchiveStatus; -begin - if Assigned(FArchive) then - Result := FArchive.Status - else - Result := asInvalid; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetTextItem(const Value: string): LongInt; -var - oNode : TTreeNode; - oHold : TTreeNode; -begin - Result := -1; - if FOutline.Items.Count <= 0 then - exit; - - oNode := FOutline.Items[0]; - while oNode <> nil do begin - if oNode.Text = Value then - break; - oHold := oNode; - oNode := nil; - if oHold.HasChildren then - oNode := oHold.getFirstChild; - if oNode = nil then - oNode := oHold.GetNextChild( oHold ); - if oNode = nil then - oNode := oHold.GetNext; - end; - if oNode <> nil then - Result := oNode.AbsoluteIndex -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetOutLineItem(X, Y : Integer): LongInt; -var - oNode : TTreeNode; -begin - oNode := FOutLine.GetNodeAt(X, X); - if oNode <> nil then - Result := oNode.AbsoluteIndex - else - Result := -1; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetVersion : string; -begin - Result := AbVersionS; -end; -{ -------------------------------------------------------------------------- } -function TAbCustomZipOutline.GetZipfileComment : AnsiString; -begin - if Assigned(FArchive) then - Result := TAbZipArchive(FArchive).ZipfileComment - else - Result := ''; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.InitArchive; -begin - if Assigned(FArchive) then begin - {properties} - FArchive.AutoSave := FAutoSave; - FArchive.CompressionMethodToUse := FCompressionMethodToUse; - SetBaseDirectory(FBaseDirectory); - FArchive.DeflationOption := FDeflationOption; -{$IFDEF MSWINDOWS} - FArchive.DOSMode := FDOSMode; -{$ENDIF} - FArchive.ExtractOptions := FExtractOptions; - FArchive.LogFile := FLogFile; - FArchive.Logging := FLogging; - FArchive.Password := FPassword; - FArchive.PasswordRetries := FPasswordRetries; - FArchive.StoreOptions := FStoreOptions; - FArchive.TempDirectory := FTempDirectory; - FArchive.SpanningThreshold := FSpanningThreshold; - {events} - TAbZipArchiveFriend(FArchive).ExtractHelper := UnzipProc; - TAbZipArchiveFriend(FArchive).ExtractToStreamHelper := UnzipToStreamProc; - TAbZipArchiveFriend(FArchive).InsertHelper := ZipProc; - TAbZipArchiveFriend(FArchive).InsertFromStreamHelper := ZipFromStreamProc; - FArchive.OnProcessItemFailure := DoProcessItemFailure; - FArchive.OnArchiveItemProgress := DoArchiveItemProgress; - FArchive.OnArchiveProgress := DoArchiveProgress; - FArchive.OnConfirmProcessItem := DoConfirmProcessItem; - FArchive.OnConfirmOverwrite := DoConfirmOverwrite; - FArchive.OnConfirmSave := DoConfirmSave; - FArchive.OnLoad := DoLoad; - FArchive.OnSave := DoSave; - FArchive.OnRequestImage := FOnRequestImage; - FArchive.OnNeedPassword := DoNeedPassword; - FArchive.OnRequestBlankDisk := FOnRequestBlankDisk; - FArchive.OnRequestLastDisk := FOnRequestLastDisk; - FArchive.OnRequestNthDisk := FOnRequestNthDisk; - TAbZipArchiveFriend(FArchive).TestHelper := TestItemProc; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.Loaded; -begin - inherited Loaded; - FOutline.OnClick := DoClick; - FOutline.OnCollapsed := DoCollapse; - FOutline.OnDblClick := DoDblClick; - FOutline.OnDragDrop := DoDragDrop; - FOutline.OnDragOver := DoDragOver; - FOutline.OnEndDrag := DoOnEndDrag; - FOutline.OnEnter := DoOnEnter; - FOutline.OnExit := DoOnExit; - FOutline.OnExpanded := DoExpand; - FOutline.OnKeyDown := DoKeyDown; - FOutline.OnKeyPress := DoKeyPress; - FOutline.OnKeyUp := DoKeyUp; - FOutline.OnMouseDown := DoMouseDown; - FOutline.OnMouseMove := DoMouseMove; - FOutline.OnMouseUp := DoMouseUp; -{$IFDEF MSWINDOWS} - FOutline.OnStartDrag := DoOnStartDrag; -{$ENDIF MSWINDOWS} - if Assigned(FOnWindowsDrop) then - FOutline.OnWindowsDrop := DoWindowsDrop - else - FOutline.OnWindowsDrop := nil; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.Move(aItem : TAbArchiveItem; NewStoredPath : string); -begin - if Assigned(FArchive) then - FArchive.Move(aItem, NewStoredPath) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.Notification(Component: TComponent; - Operation: TOperation); -begin - inherited Notification(Component, Operation); - if (Operation = opRemove) then begin - if Assigned(ItemProgressMeter) and Component.IsImplementorOf(ItemProgressMeter) then - ItemProgressMeter := nil; - if Assigned(ArchiveProgressMeter) and Component.IsImplementorOf(ArchiveProgressMeter) then - ArchiveProgressMeter := nil; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.PutItem(Index : Integer; Value : TAbZipItem); -begin - if Assigned(FArchive) then - FArchive.ItemList[Index] := Value - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.Replace(aItem : TAbArchiveItem); - {replace the item} -begin - if Assigned( FArchive ) then - FArchive.Replace( aItem ) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.Save; -begin - if Assigned(FArchive) then begin - FArchive.Save; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetArchiveProgressMeter(const Value: IAbProgressMeter); -begin - ReferenceInterface(FArchiveProgressMeter, opRemove); - FArchiveProgressMeter := Value; - ReferenceInterface(FArchiveProgressMeter, opInsert); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetAttributes(Value : TAbZipAttributes); -begin - FAttributes := Value; - UpdateOutline; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetAutoSave(Value : Boolean); -begin - FAutoSave := Value; - if Assigned(FArchive) then - FArchive.AutoSave := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetBaseDirectory(Value : string); -begin - if Assigned(FArchive) then begin - FArchive.BaseDirectory := Value; - FBaseDirectory := FArchive.BaseDirectory; - end - else - FBaseDirectory := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetBorderStyle(Value : TBorderStyle); -begin - FOutline.BorderStyle := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetCompressionMethodToUse( - Value : TAbZipSupportedMethod); -begin - FCompressionMethodToUse := Value; - if Assigned(FArchive) then - FArchive.CompressionMethodToUse := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetCursor(Value : TCursor); -begin - FOutline.Cursor := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetDeflationOption(Value : TAbZipDeflationOption); -begin - FDeflationOption := Value; - if Assigned(FArchive) then - FArchive.DeflationOption := Value; -end; -{ -------------------------------------------------------------------------- } -{$IFDEF MSWINDOWS} -procedure TAbCustomZipOutline.SetDOSMode(Value : Boolean); -begin - FDOSMode := Value; - if Assigned(FArchive) then - FArchive.DOSMode := Value; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -{$IFNDEF UsingCLX} -procedure TAbCustomZipOutline.SetDragCursor(Value : TCursor); -begin - FOutline.DragCursor := Value; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -{$IFNDEF UsingCLX} -procedure TAbCustomZipOutline.SetDragMode(Value : TDragMode); -begin - {$IFDEF MSWINDOWS} - inherited SetDragMode(Value); - {$ENDIF} - FOutline.DragMode := Value; -end; -{$ENDIF} -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetExtractOptions(Value : TAbExtractOptions); -begin - FExtractOptions := Value; - if Assigned(FArchive) then - FArchive.ExtractOptions := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetFileName(const aFileName : string); -begin - if Assigned(FArchive) and (Status = asBusy) then - raise EAbArchiveBusy.Create; - FFileName := aFileName; - try - if Assigned(FArchive) then - FArchive.Save; - except - end; - FArchive.Free; - FArchive := nil; - if FileName <> '' then - if FileExists(FileName) then begin - if csDesigning in ComponentState then - FArchive := TAbZipArchive.Create(FileName, - fmOpenRead or - fmShareDenyNone) - else begin - try - FArchive := TAbZipArchive.Create(FileName, - fmOpenReadWrite or - fmShareDenyWrite); - except - {deals with read-only files} - FArchive := TAbZipArchive.Create(FileName, - fmOpenRead or - fmShareDenyWrite); - end; - InitArchive; - end; - FArchive.Load; - end - else begin - FArchive := TAbZipArchive.Create(FileName, - fmCreate or fmShareDenyNone); - InitArchive; - try - FArchive.Load; - except - end; - end; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetHierarchy(Value : Boolean); -begin - FHierarchy := Value; - UpdateOutline; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetItemProgressMeter(const Value: IAbProgressMeter); -begin - ReferenceInterface(FItemProgressMeter, opRemove); - FItemProgressMeter := Value; - ReferenceInterface(FItemProgressMeter, opInsert); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetLogFile(Value : string); -begin - FLogFile := Value; - if (csDesigning in ComponentState) then - Exit; - if Assigned(FArchive) then - FArchive.LogFile := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetLogging(Value : Boolean); -begin - FLogging := Value; - if (csDesigning in ComponentState) then - Exit; - if Assigned(FArchive) then - FArchive.Logging:= Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetOnRequestImage(Value : TAbRequestImageEvent); -begin - FOnRequestImage := Value; - if Assigned(FArchive) then - FArchive.OnRequestImage := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetOnRequestLastDisk(Value : TAbRequestDiskEvent); -begin - FOnRequestLastDisk := Value; - if Assigned(FArchive) then - FArchive.OnRequestLastDisk := FOnRequestLastDisk; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent); -begin - FOnRequestNthDisk := Value; - if Assigned(FArchive) then - FArchive.OnRequestNthDisk := FOnRequestNthDisk; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetOnRequestBlankDisk(Value : TAbRequestDiskEvent); -begin - FOnRequestBlankDisk := Value; - if Assigned(FArchive) then - FArchive.OnRequestBlankDisk := FOnRequestBlankDisk; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetOnWindowsDrop(Value : TWindowsDropEvent); -begin - FOnWindowsDrop := Value; - if csLoading in ComponentState then - Exit; - if csDestroying in ComponentState then - Exit; - if Assigned(Value) then - FOutline.OnWindowsDrop := DoWindowsDrop - else - FOutline.OnWindowsDrop := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPassword(Value : AnsiString); -begin - FPassword := Value; - if Assigned(FArchive) then - FArchive.Password := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPasswordRetries(Value : Byte); -begin - FPasswordRetries := Value; - if Assigned(FArchive) then - FArchive.PasswordRetries := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureDirectory(Value : TBitmap); -begin - if Value <> nil then begin - if (Value.Height = FOutline.FBitMapHeight) and - (Value.Width = FOutline.FBitMapWidth) then - FOutline.zdPictureDirectory := Value; - end else - FOutline.zdPictureDirectory := nil; - -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureFile(Value : TBitmap); -begin - if Value <> nil then begin - if (Value.Height = FOutline.FBitMapHeight) and - (Value.Width = FOutline.FBitMapWidth) then - FOutline.zdPictureFile := Value; - end else - FOutline.zdPictureFile := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureZipAttribute(Value : TBitmap); -begin - if Value <> nil then begin - if (Value.Height = FOutline.FBitMapHeight) and - (Value.Width = FOutline.FBitMapWidth) then - FOutline.zdPictureZipAttribute := Value; - end else - FOutline.zdPictureZipAttribute := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureDirectorySelected(Value : TBitmap); -begin - if Value <> nil then begin - if (Value.Height = FOutline.FBitMapHeight) and - (Value.Width = FOutline.FBitMapWidth) then - FOutline.zdPictureDirectorySelected := Value; - end else - FOutline.zdPictureDirectorySelected := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureFileSelected(Value : TBitmap); -begin - if Value <> nil then begin - if (Value.Height = FOutline.FBitMapHeight) and - (Value.Width = FOutline.FBitMapWidth) then - FOutline.zdPictureFileSelected := Value; - end else - FOutline.zdPictureFileSelected := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureZipAttributeSelected(Value : TBitmap); -begin - if Value <> nil then begin - if (Value.Height = FOutline.FBitMapHeight) and - (Value.Width = FOutline.FBitMapWidth) then - FOutline.zdPictureZipAttributeSelected := Value; - end else - FOutline.zdPictureZipAttributeSelected := nil; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureHeight(Value : Integer); -begin - FOutline.FBitMapHeight := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetPictureWidth(Value : Integer); -begin - FOutline.FBitMapWidth := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetSelectedItem(Value : LongInt); -begin - if ( Value >= 0 ) and ( Value <= pred( FOutline.Items.Count )) then - FOutline.Selected := FOutline.Items[ Value ]; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetStoreOptions(Value : TAbStoreOptions); -begin - FStoreOptions := Value; - if Assigned(FArchive) then - FArchive.StoreOptions := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetTempDirectory(Value : string); -begin - FTempDirectory := Value; - if Assigned(FArchive) then - FArchive.TempDirectory := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetSpanningThreshold(Value : Longint); -begin - FSpanningThreshold := Value; - if Assigned(FArchive) then - FArchive.SpanningThreshold := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetVersion(Value : string); -begin - {NOP} -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.SetZipfileComment(Value : AnsiString); -begin - if Assigned(FArchive) then - TAbZipArchive(FArchive).ZipfileComment := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.TagItems(const FileMask : string); - {tag all items that match the mask} -begin - if Assigned(FArchive) then - FArchive.TagItems(FileMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.UnTagItems(const FileMask : string); - {clear tags for all items that match the mask} -begin - if Assigned(FArchive) then - FArchive.UnTagItems(FileMask) - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.UnzipProc(Sender : TObject; - Item : TAbArchiveItem; - const NewName : string); -begin - AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.UnzipToStreamProc(Sender : TObject; - Item : TAbArchiveItem; - OutStream : TStream); -begin - if Assigned(OutStream) then - AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.UpdateOutline; -var - Found : Boolean; - i : Integer; - CurRoot : TTreeNode; - CurParent : TTreeNode; - CurChild : TTreeNode; - RootNode : TTreeNode; - oNode : TTreeNode; - SubDir : string; - ItemString : string; - - function GetSubDir(var ItemString : string) : string; - var - i : Integer; - begin - i := Pos(AbPathDelim, ItemString); - Result := ''; - if i > 0 then begin - Result := Copy(ItemString, 1, pred(i)); - System.Delete(ItemString, 1, i); - end; - end; -begin - RootNode := nil; - CurRoot := nil; - FOutline.Items.Clear; - if not Assigned(FArchive) then - Exit; - if FArchive.Count = 0 then - Exit; - - FOutline.IndexBitmaps; - - if Hierarchy then begin - for i := 0 to pred(FArchive.Count) do begin - {do not display deleted items...} - if FArchive.ItemList[i].Action = aaDelete then - continue; - - ItemString := FArchive.ItemList[i].FileName; - AbUnfixName(ItemString); - - if ItemString[ Length( ItemString )] = AbPathDelim then - Continue; - - if ( FOutline.Items.Count <> 0 ) and ( CurRoot <> nil ) then begin - SubDir := GetSubDir(ItemString); - - if RootNode = nil then - RootNode := FOutline.TopItem; - - CurParent := RootNode; - while CurParent <> nil do begin - if CurParent.Text = SubDir then begin - CurRoot := CurParent; - break; - end else begin - CurParent := CurParent.getNextSibling; - end; - end; - if CurParent = nil then begin - ItemString := FArchive.ItemList[i].FileName; - AbUnfixName(ItemString); - end; - end else - CurParent := nil; - - SubDir := GetSubDir(ItemString); - while SubDir <> '' do begin - if CurParent <> nil then begin - Found := False; - CurChild := CurParent.GetFirstChild; - while CurChild <> nil do begin - if CurChild.Text <> SubDir then - CurChild := CurParent.GetNextChild( CurChild ) - else begin - Found := True; - break; - end; - end; - if Found then - CurParent := CurChild - else begin - if ItemString <> '' then begin - CurParent := FOutline.Items.AddChild( CurParent, SubDir ); - CurParent.ImageIndex := FOutline.FDirectoryIndex; - CurParent.SelectedIndex := FOutline.FDirSelectedIndex; - end; - end; - end else begin - if ItemString <> '' then begin - CurRoot := FOutline.Items.Add( nil, SubDir ); - if FOutline.Items.Count = 1 then - RootNode := CurRoot; - CurRoot.ImageIndex := FOutline.FDirectoryIndex; - CurRoot.SelectedIndex := FOutline.FDirSelectedIndex; - CurParent := CurRoot - end; - end; - SubDir := GetSubDir(ItemString); - end; - if ItemString <> '' then begin - oNode := FOutline.Items.AddChildObject(CurParent, ItemString, - FArchive.ItemList[i]); - - if FOutline.Items.Count = 1 then - RootNode := oNode; - oNode.ImageIndex := FOutline.FFileIndex; - oNode.SelectedIndex := FOutline.FFileSelectedIndex; - AddAttributeNodes(TAbZipItem(FArchive.ItemList[i]), oNode); - end; - end; - end - else begin - for i := 0 to pred(FArchive.Count) do begin - ItemString := FArchive.ItemList[i].FileName; - AbUnfixName(ItemString); - oNode := FOutline.Items.AddObject(FOutline.Selected, ItemString, - FArchive.ItemList[i]); - - oNode.ImageIndex := FOutline.FFileIndex; - oNode.SelectedIndex := FOutline.FFileSelectedIndex; - AddAttributeNodes(TAbZipItem(FArchive.ItemList[i]), oNode); - end; - end; - FullExpand; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.TestItemProc(Sender : TObject; Item : TAbArchiveItem); -begin - AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item)); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.TestTaggedItems; - {Test specified items} -begin - if Assigned(FArchive) then - FArchive.TestTaggedItems - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ZipProc(Sender : TObject; - Item : TAbArchiveItem; - OutStream : TStream); -begin - AbZip(TAbZipArchive(Sender), TAbZipItem(Item), OutStream); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.ZipFromStreamProc(Sender : TObject; - Item : TAbArchiveItem; - OutStream, InStream : TStream); -begin - if Assigned(InStream) then - AbZipFromStream(TAbZipArchive(Sender), TAbZipItem(Item), - OutStream, InStream) - else - raise EAbZipNoInsertion.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.CloseArchive; - {closes the archive by setting FileName to ''} -begin - if FFileName <> '' then - FileName := ''; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipOutline.OpenArchive(const aFileName : String); - {opens the archive} -begin - FileName := AFileName; -end; -{ -------------------------------------------------------------------------- } -end. - diff --git a/components/Abbrevia/source/AbZipOut.res b/components/Abbrevia/source/AbZipOut.res deleted file mode 100644 index a150263..0000000 Binary files a/components/Abbrevia/source/AbZipOut.res and /dev/null differ diff --git a/components/Abbrevia/source/AbZipPrc.pas b/components/Abbrevia/source/AbZipPrc.pas deleted file mode 100644 index 5b59d27..0000000 --- a/components/Abbrevia/source/AbZipPrc.pas +++ /dev/null @@ -1,339 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZipPrc.pas *} -{*********************************************************} -{* ABBREVIA: TABZipHelper class *} -{*********************************************************} - -unit AbZipPrc; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbZipTyp; - - procedure AbZip( Sender : TAbZipArchive; Item : TAbZipItem; - OutStream : TStream ); - - procedure AbZipFromStream(Sender : TAbZipArchive; Item : TAbZipItem; - OutStream, InStream : TStream); - - procedure DeflateStream( UncompressedStream, CompressedStream : TStream ); - {-Deflates everything in UncompressedStream to CompressedStream - no encryption is tried, no check on CRC is done, uses the whole - compressedstream - no Progress events - no Frills! } - -implementation - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF LibcAPI} - Libc, -{$ENDIF} - SysUtils, - AbArcTyp, - AbExcept, - AbUtils, - AbDfCryS, - AbVMStrm, - AbDfBase, - AbDfEnc, - AbSpanSt; - - -{ ========================================================================== } -procedure DoDeflate(Archive : TAbZipArchive; Item : TAbZipItem; OutStream, InStream : TStream); -const - DEFLATE_NORMAL_MASK = $00; - DEFLATE_MAXIMUM_MASK = $02; - DEFLATE_FAST_MASK = $04; - DEFLATE_SUPERFAST_MASK = $06; -var - Hlpr : TAbDeflateHelper; -begin - Item.CompressionMethod := cmDeflated; - - Hlpr := TAbDeflateHelper.Create; - - {anything dealing with store options, etc. should already be done.} - - try {Hlpr} - Hlpr.StreamSize := InStream.Size; - - { set deflation level desired } - Hlpr.PKZipOption := '0'; - - case Archive.DeflationOption of - doNormal : begin - Hlpr.PKZipOption := 'n'; - Item.GeneralPurposeBitFlag := - Item.GeneralPurposeBitFlag or DEFLATE_NORMAL_MASK; - end; - - doMaximum : begin - Hlpr.PKZipOption := 'x'; - Item.GeneralPurposeBitFlag := - Item.GeneralPurposeBitFlag or DEFLATE_MAXIMUM_MASK; - end; - - doFast : begin - Hlpr.PKZipOption := 'f'; - Item.GeneralPurposeBitFlag := - Item.GeneralPurposeBitFlag or DEFLATE_FAST_MASK; - end; - - doSuperFast : begin - Hlpr.PKZipOption := 's'; - Item.GeneralPurposeBitFlag := - Item.GeneralPurposeBitFlag or DEFLATE_SUPERFAST_MASK; - end; - end; - - { attach progress notification method } - Hlpr.OnProgressStep := Archive.DoInflateProgress; - - { provide encryption check value } - Item.CRC32 := Deflate(InStream, OutStream, Hlpr); - - finally {Hlpr} - Hlpr.Free; - end; {Hlpr} -end; -{ ========================================================================== } -procedure DoStore(Archive : TAbZipArchive; Item : TAbZipItem; OutStream, InStream : TStream); -var - CRC32 : LongInt; - Percent : LongInt; - LastPercent : LongInt; - InSize : Int64; - DataRead : Int64; - Total : Int64; - Abort : Boolean; - Buffer : array [0..8191] of byte; -begin - { setup } - Item.CompressionMethod := cmStored; - Abort := False; - CRC32 := -1; - Total := 0; - Percent := 0; - LastPercent := 0; - InSize := InStream.Size; - - { get first bufferful } - DataRead := InStream.Read(Buffer, SizeOf(Buffer)); - { while more data has been read and we're not told to bail } - while (DataRead <> 0) and not Abort do begin - {report the progress} - if Assigned(Archive.OnProgress) then begin - Total := Total + DataRead; - Percent := Round((100.0 * Total) / InSize); - if (LastPercent <> Percent) then - Archive.OnProgress(Percent, Abort); - LastPercent := Percent; - end; - - { update CRC} - AbUpdateCRCBuffer(CRC32, Buffer, DataRead); - - { write data (encrypting if needed) } - OutStream.WriteBuffer(Buffer, DataRead); - - { get next bufferful } - DataRead := InStream.Read(Buffer, SizeOf(Buffer)); - end; - - { finish CRC calculation } - Item.CRC32 := not CRC32; - - { show final progress increment } - if (Percent < 100) and Assigned(Archive.OnProgress) then - Archive.OnProgress(100, Abort); - - { User wants to bail } - if Abort then begin - raise EAbUserAbort.Create; - end; - -end; -{ ========================================================================== } -procedure DoZipFromStream(Sender : TAbZipArchive; Item : TAbZipItem; - OutStream, InStream : TStream); -var - ZipArchive : TAbZipArchive; - InStartPos : LongInt; - TempOut : TAbVirtualMemoryStream; - DestStrm : TStream; -begin - ZipArchive := TAbZipArchive(Sender); - - { configure Item } - Item.UncompressedSize := InStream.Size; - Item.GeneralPurposeBitFlag := Item.GeneralPurposeBitFlag and AbLanguageEncodingFlag; - - if ZipArchive.Password <> '' then { encrypt the stream } - DestStrm := TAbDfEncryptStream.Create(OutStream, - LongInt(Item.LastModFileTime shl $10), - ZipArchive.Password) - else - DestStrm := OutStream; - try - if InStream.Size > 0 then begin - - { determine how to store Item based on specified CompressionMethodToUse } - case ZipArchive.CompressionMethodToUse of - smDeflated : begin - { Item is to be deflated regarless } - { deflate item } - DoDeflate(ZipArchive, Item, DestStrm, InStream); - end; - - smStored : begin - { Item is to be stored regardless } - { store item } - DoStore(ZipArchive, Item, DestStrm, InStream); - end; - - smBestMethod : begin - { Item is to be archived using method producing best compression } - TempOut := TAbVirtualMemoryStream.Create; - try - TempOut.SwapFileDirectory := Sender.TempDirectory; - - { save starting points } - InStartPos := InStream.Position; - - { try deflating item } - DoDeflate(ZipArchive, Item, TempOut, InStream); - { if deflated size > input size then got negative compression } - { so storing the item is more efficient } - - if TempOut.Size > InStream.Size then begin { store item instead } - { reset streams to original positions } - InStream.Position := InStartPos; - TempOut.Free; - TempOut := TAbVirtualMemoryStream.Create; - TempOut.SwapFileDirectory := Sender.TempDirectory; - - { store item } - DoStore(ZipArchive, Item, TempOut, InStream); - end {if}; - - TempOut.Seek(0, soBeginning); - DestStrm.CopyFrom(TempOut, TempOut.Size); - finally - TempOut.Free; - end; - end; - end; { case } - - end - else begin - { InStream is zero length} - Item.CRC32 := 0; - { ignore any storage indicator and treat as stored } - DoStore(ZipArchive, Item, DestStrm, InStream); - end; - finally - if DestStrm <> OutStream then - DestStrm.Free; - end; - - { update item } - Item.CompressedSize := OutStream.Size; - Item.InternalFileAttributes := 0; { don't care } - if (ZipArchive.Password <> '') then - Item.GeneralPurposeBitFlag := Item.GeneralPurposeBitFlag - or AbFileIsEncryptedFlag or AbHasDataDescriptorFlag; -end; -{ -------------------------------------------------------------------------- } -procedure AbZipFromStream(Sender : TAbZipArchive; Item : TAbZipItem; - OutStream, InStream : TStream); -var - FileTimeStamp : LongInt; -begin - // Set item properties for non-file streams - Item.ExternalFileAttributes := 0; - FileTimeStamp := DateTimeToFileDate(SysUtils.Now); - Item.LastModFileTime := LongRec(FileTimeStamp).Lo; - Item.LastModFileDate := LongRec(FileTimeStamp).Hi; - - DoZipFromStream(Sender, Item, OutStream, InStream); -end; -{ -------------------------------------------------------------------------- } -procedure AbZip( Sender : TAbZipArchive; Item : TAbZipItem; - OutStream : TStream ); -var - UncompressedStream : TStream; - SaveDir : string; - AttrEx : TAbAttrExRec; -begin - UncompressedStream := nil; - GetDir(0, SaveDir); - try {SaveDir} - if (Sender.BaseDirectory <> '') then - ChDir(Sender.BaseDirectory); - if not AbFileGetAttrEx(Item.DiskFileName, AttrEx) then - raise EAbFileNotFound.Create; - if ((AttrEx.Attr and faDirectory) <> 0) then - UncompressedStream := TMemoryStream.Create - else - UncompressedStream := - TFileStream.Create(Item.DiskFileName, fmOpenRead or fmShareDenyWrite); - finally {SaveDir} - ChDir( SaveDir ); - end; {SaveDir} - try {UncompressedStream} - {$IFDEF UNIX} - Item.ExternalFileAttributes := LongWord(AttrEx.Mode) shl 16 + LongWord(AttrEx.Attr); - {$ELSE} - Item.ExternalFileAttributes := AttrEx.Attr; - {$ENDIF} - Item.LastModTimeAsDateTime := AttrEx.Time; - DoZipFromStream(Sender, Item, OutStream, UncompressedStream); - finally {UncompressedStream} - UncompressedStream.Free; - end; {UncompressedStream} -end; -{ -------------------------------------------------------------------------- } -procedure DeflateStream( UncompressedStream, CompressedStream : TStream ); - {-Deflates everything in CompressedStream to UncompressedStream - no encryption is tried, no check on CRC is done, uses the whole - Uncompressedstream - no Progress events - no Frills! - } -begin - Deflate(UncompressedStream, CompressedStream, nil); -end; -{ -------------------------------------------------------------------------- } - -end. - diff --git a/components/Abbrevia/source/AbZipTyp.pas b/components/Abbrevia/source/AbZipTyp.pas deleted file mode 100644 index 448c6ae..0000000 --- a/components/Abbrevia/source/AbZipTyp.pas +++ /dev/null @@ -1,2344 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Craig Peterson - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZipTyp.pas *} -{*********************************************************} -{* ABBREVIA: PKZip types *} -{* Based on information from Appnote.txt, shipped with *} -{* PKWare's PKZip for Windows 2.5 *} -{*********************************************************} - -unit AbZipTyp; - -{$I AbDefine.inc} - -interface - -uses - Classes, AbArcTyp, AbUtils, AbSpanSt; - -const - { note #$50 = 'P', #$4B = 'K'} - Ab_ZipVersion = 63; - Ab_ZipLocalFileHeaderSignature : Longint = $04034B50; - Ab_ZipDataDescriptorSignature : Longint = $08074B50; - Ab_ZipCentralDirectoryFileHeaderSignature : Longint = $02014B50; - Ab_Zip64EndCentralDirectorySignature : Longint = $06064B50; - Ab_Zip64EndCentralDirectoryLocatorSignature:Longint = $07064B50; - Ab_ZipEndCentralDirectorySignature : Longint = $06054B50; - Ab_ZipSpannedSetSignature : Longint = $08074B50; - Ab_ZipPossiblySpannedSignature : Longint = $30304B50; - Ab_GeneralZipSignature : Word = $4B50; - - Ab_ArchiveExtraDataRecord : Longint = $08064B50; - Ab_DigitalSignature : Longint = $05054B50; - - Ab_WindowsExeSignature : Word = $5A4D; - Ab_LinuxExeSignature : Longint = $464C457F; - - AbDefZipSpanningThreshold = 0; - AbDefPasswordRetries = 3; - AbFileIsEncryptedFlag = $0001; - AbHasDataDescriptorFlag = $0008; - AbLanguageEncodingFlag = $0800; - - Ab_Zip64SubfieldID : Word = $0001; - Ab_InfoZipUnicodePathSubfieldID : Word = $7075; - Ab_XceedUnicodePathSubfieldID : Word = $554E; - Ab_XceedUnicodePathSignature : LongWord= $5843554E; - -type - PAbByteArray4K = ^TAbByteArray4K; - TAbByteArray4K = array[1..4096] of Byte; - PAbByteArray8K = ^TAbByteArray8K; - TAbByteArray8K = array[0..8192] of Byte; - PAbIntArray8K = ^TAbIntArray8K; - TAbIntArray8K = array[0..8192] of SmallInt; - - PAbWordArray = ^TAbWordArray; - TAbWordArray = array[0..65535 div SizeOf(Word)-1] of Word; - PAbByteArray = ^TAbByteArray; - TAbByteArray = array[0..65535-1] of Byte; - PAbSmallIntArray = ^TAbSmallIntArray; - TAbSmallIntArray = array[0..65535 div SizeOf(SmallInt)-1] of SmallInt; - - PAbIntegerArray = ^TAbIntegerArray; - TAbIntegerArray = array[0..65535 div sizeof(integer)-1] of integer; - - TAbZip64EndOfCentralDirectoryRecord = packed record - Signature : Longint; - RecordSize : Int64; - VersionMadeBy : Word; - VersionNeededToExtract : Word; - DiskNumber : LongWord; - StartDiskNumber : LongWord; - EntriesOnDisk : Int64; - TotalEntries : Int64; - DirectorySize : Int64; - DirectoryOffset : Int64; - end; - - TAbZip64EndOfCentralDirectoryLocator = packed record - Signature : Longint; - StartDiskNumber : Longint; - RelativeOffset : Int64; - TotalDisks : Longint; - end; - - TAbZipEndOfCentralDirectoryRecord = packed record - Signature : Longint; - DiskNumber : Word; - StartDiskNumber : Word; - EntriesOnDisk : Word; - TotalEntries : Word; - DirectorySize : LongWord; - DirectoryOffset : LongWord; - CommentLength : Word; - end; - - TAbFollower = {used to expand reduced files} - packed record - Size : Byte; {size of follower set} - FSet : array[0..31] of Byte; {follower set} - end; - PAbFollowerSets = ^TAbFollowerSets; - TAbFollowerSets = array[0..255] of TAbFollower; - - - PAbSfEntry = ^TAbSfEntry; - TAbSfEntry = {entry in a Shannon-Fano tree} - packed record - case Byte of - 0 : (Code : Word; Value, BitLength : Byte); - 1 : (L : Longint); - end; - PAbSfTree = ^TAbSfTree; - TAbSfTree = - packed record {a Shannon-Fano tree} - Entries : SmallInt; - MaxLength : SmallInt; - Entry : array[0..256] of TAbSfEntry; - end; - - PInfoZipUnicodePathRec = ^TInfoZipUnicodePathRec; - TInfoZipUnicodePathRec = packed record - Version: Byte; - NameCRC32: LongInt; - UnicodeName: array[0..0] of AnsiChar; - end; - - PXceedUnicodePathRec = ^TXceedUnicodePathRec; - TXceedUnicodePathRec = packed record - Signature: LongWord; - Length: Integer; - UnicodeName: array[0..0] of WideChar; - end; - - PZip64LocalHeaderRec = ^TZip64LocalHeaderRec; - TZip64LocalHeaderRec = packed record - UncompressedSize: Int64; - CompressedSize: Int64; - end; - -type - TAbZipCompressionMethod = - (cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3, - cmReduced4, cmImploded, cmTokenized, cmDeflated, - cmEnhancedDeflated, cmDCLImploded, cmBzip2 = 12, cmLZMA = 14, - cmIBMTerse = 18, cmLZ77, cmJPEG = 96, cmWavPack = 97, cmPPMd); - - TAbZipSupportedMethod = - (smStored, smDeflated, smBestMethod); - - {ExternalFileAttributes compatibility; aliases are Info-ZIP/PKZIP overlaps} - TAbZipHostOS = - (hosDOS, hosAmiga, hosVAX, hosUnix, hosVMCMS, hosAtari, - hosOS2, hosMacintosh, hosZSystem, hosCPM, hosNTFS, hosTOPS20 = hosNTFS, - hosMVS, hosWinNT = hosMVS, hosVSE, hosQDOS = hosVSE, hosRISC, - hosVFAT, hosAltMVS, hosBeOS, hosTandem, hosOS400, hosTHEOS = hosOS400, - hosDarwin, hosAtheOS = 30); - - {for method 6 - imploding} - TAbZipDictionarySize = - (dsInvalid, ds4K, ds8K); - - {for method 8 - deflating} - TAbZipDeflationOption = - (doInvalid, doNormal, doMaximum, doFast, doSuperFast ); - -type - TAbNeedPasswordEvent = procedure(Sender : TObject; - var NewPassword : AnsiString) of object; - -const - AbDefCompressionMethodToUse = smBestMethod; - AbDefDeflationOption = doNormal; - - -type - TAbZipDataDescriptor = class( TObject ) - protected {private} - FCRC32 : Longint; - FCompressedSize : Int64; - FUncompressedSize : Int64; - public {methods} - procedure SaveToStream( Stream : TStream ); - public {properties} - property CRC32 : Longint - read FCRC32 write FCRC32; - property CompressedSize : Int64 - read FCompressedSize write FCompressedSize; - property UncompressedSize : Int64 - read FUncompressedSize write FUncompressedSize; - end; - -type -{ TAbZipFileHeader interface =============================================== } - {ancestor class for ZipLocalFileHeader and DirectoryFileHeader} - TAbZipFileHeader = class( TObject ) - protected {private} - FValidSignature : Longint; - FSignature : Longint; - FVersionNeededToExtract : Word; - FGeneralPurposeBitFlag : Word; - FCompressionMethod : Word; - FLastModFileTime : Word; - FLastModFileDate : Word; - FCRC32 : Longint; - FCompressedSize : LongWord; - FUncompressedSize : LongWord; - FFileName : AnsiString; - FExtraField : TAbExtraField; - protected {methods} - function GetCompressionMethod : TAbZipCompressionMethod; - function GetCompressionRatio : Double; - function GetDataDescriptor : Boolean; - function GetDeflationOption : TAbZipDeflationOption; - function GetDictionarySize : TAbZipDictionarySize; - function GetEncrypted : Boolean; - function GetIsUTF8 : Boolean; - function GetShannonFanoTreeCount : Byte; - function GetValid : Boolean; - procedure SetCompressionMethod( Value : TAbZipCompressionMethod ); - procedure SetIsUTF8( Value : Boolean ); - public {methods} - constructor Create; - destructor Destroy; override; - public {properties} - property Signature : Longint - read FSignature write FSignature; - property VersionNeededToExtract : Word - read FVersionNeededToExtract write FVersionNeededToExtract; - property GeneralPurposeBitFlag : Word - read FGeneralPurposeBitFlag write FGeneralPurposeBitFlag; - property CompressionMethod : TAbZipCompressionMethod - read GetCompressionMethod write SetCompressionMethod; - property LastModFileTime : Word - read FLastModFileTime write FLastModFileTime; - property LastModFileDate : Word - read FLastModFileDate write FLastModFileDate; - property CRC32 : Longint - read FCRC32 write FCRC32; - property CompressedSize : LongWord - read FCompressedSize write FCompressedSize; - property UncompressedSize : LongWord - read FUncompressedSize write FUncompressedSize; - property FileName : AnsiString - read FFileName write FFileName; - property ExtraField : TAbExtraField - read FExtraField; - - property CompressionRatio : Double - read GetCompressionRatio; - property DeflationOption : TAbZipDeflationOption - read GetDeflationOption; - property DictionarySize : TAbZipDictionarySize - read GetDictionarySize; - property HasDataDescriptor : Boolean - read GetDataDescriptor; - property IsValid : Boolean - read GetValid; - property IsEncrypted : Boolean - read GetEncrypted; - property IsUTF8 : Boolean - read GetIsUTF8 write SetIsUTF8; - property ShannonFanoTreeCount : Byte - read GetShannonFanoTreeCount; - end; - -{ TAbZipLocalFileHeader interface ========================================== } - TAbZipLocalFileHeader = class( TAbZipFileHeader ) - public {methods} - constructor Create; - destructor Destroy; override; - procedure LoadFromStream( Stream : TStream ); - procedure SaveToStream( Stream : TStream ); - end; - -{ TAbZipDirectoryFileHeader interface ====================================== } - TAbZipDirectoryFileHeader = class( TAbZipFileHeader ) - protected {private} - FVersionMadeBy : Word; - FDiskNumberStart : Word; - FInternalFileAttributes : Word; - FExternalFileAttributes : LongWord; - FRelativeOffset : LongWord; - FFileComment : AnsiString; - public {methods} - constructor Create; - destructor Destroy; override; - procedure LoadFromStream( Stream : TStream ); - procedure SaveToStream( Stream : TStream ); - public {properties} - property VersionMadeBy : Word - read FVersionMadeBy write FVersionMadeBy; - property DiskNumberStart : Word - read FDiskNumberStart write FDiskNumberStart; - property InternalFileAttributes : Word - read FInternalFileAttributes write FInternalFileAttributes; - property ExternalFileAttributes : LongWord - read FExternalFileAttributes write FExternalFileAttributes; - property RelativeOffset : LongWord - read FRelativeOffset write FRelativeOffset; - property FileComment : AnsiString - read FFileComment write FFileComment; - end; - -{ TAbZipDirectoryFileFooter interface ====================================== } - TAbZipDirectoryFileFooter = class( TObject ) - protected {private} - FDiskNumber : LongWord; - FStartDiskNumber : LongWord; - FEntriesOnDisk : Int64; - FTotalEntries : Int64; - FDirectorySize : Int64; - FDirectoryOffset : Int64; - FZipfileComment : AnsiString; - function GetIsZip64: Boolean; - public {methods} - procedure LoadFromStream( Stream : TStream ); - procedure LoadZip64FromStream( Stream : TStream ); - procedure SaveToStream( Stream : TStream; aZip64TailOffset : Int64 = -1 ); - public {properties} - property DiskNumber : LongWord - read FDiskNumber write FDiskNumber; - property EntriesOnDisk : Int64 - read FEntriesOnDisk write FEntriesOnDisk; - property TotalEntries : Int64 - read FTotalEntries write FTotalEntries; - property DirectorySize : Int64 - read FDirectorySize write FDirectorySize; - property DirectoryOffset : Int64 - read FDirectoryOffset write FDirectoryOffset; - property StartDiskNumber : LongWord - read FStartDiskNumber write FStartDiskNumber; - property ZipfileComment : AnsiString - read FZipfileComment write FZipfileComment; - property IsZip64: Boolean - read GetIsZip64; - end; - -{ TAbZipItem interface ===================================================== } - TAbZipItem = class( TAbArchiveItem ) - protected {private} - FItemInfo : TAbZipDirectoryFileHeader; - FDiskNumberStart : LongWord; - FLFHExtraField : TAbExtraField; - FRelativeOffset : Int64; - - protected {methods} - function GetCompressionMethod : TAbZipCompressionMethod; - function GetCompressionRatio : Double; - function GetDeflationOption : TAbZipDeflationOption; - function GetDictionarySize : TAbZipDictionarySize; - function GetExtraField : TAbExtraField; - function GetFileComment : AnsiString; - function GetGeneralPurposeBitFlag : Word; - function GetHostOS: TAbZipHostOS; - function GetInternalFileAttributes : Word; - function GetRawFileName : AnsiString; - function GetShannonFanoTreeCount : Byte; - function GetVersionMadeBy : Word; - function GetVersionNeededToExtract : Word; - procedure SaveCDHToStream( Stream : TStream ); - procedure SaveDDToStream( Stream : TStream ); - procedure SaveLFHToStream( Stream : TStream ); - procedure SetCompressionMethod( Value : TAbZipCompressionMethod ); - procedure SetDiskNumberStart( Value : LongWord ); - procedure SetFileComment(const Value : AnsiString ); - procedure SetGeneralPurposeBitFlag( Value : Word ); - procedure SetHostOS( Value : TAbZipHostOS ); - procedure SetInternalFileAttributes( Value : Word ); - procedure SetRelativeOffset( Value : Int64 ); - procedure SetVersionMadeBy( Value : Word ); - procedure SetVersionNeededToExtract( Value : Word ); - procedure UpdateVersionNeededToExtract; - procedure UpdateZip64ExtraHeader; - - protected {redefined property methods} - function GetCRC32 : Longint; override; - function GetExternalFileAttributes : LongWord; override; - function GetIsDirectory: Boolean; override; - function GetIsEncrypted : Boolean; override; - function GetLastModFileDate : Word; override; - function GetLastModFileTime : Word; override; - function GetNativeFileAttributes : LongInt; override; - procedure SetCompressedSize( const Value : Int64 ); override; - procedure SetCRC32( const Value : Longint ); override; - procedure SetExternalFileAttributes( Value : LongWord ); override; - procedure SetFileName(const Value : string ); override; - procedure SetLastModFileDate(const Value : Word ); override; - procedure SetLastModFileTime(const Value : Word ); override; - procedure SetUncompressedSize( const Value : Int64 ); override; - - public {methods} - constructor Create; - destructor Destroy; override; - procedure LoadFromStream( Stream : TStream ); - - public {properties} - property CompressionMethod : TAbZipCompressionMethod - read GetCompressionMethod - write SetCompressionMethod; - property CompressionRatio : Double - read GetCompressionRatio; - property DeflationOption : TAbZipDeflationOption - read GetDeflationOption; - property DictionarySize : TAbZipDictionarySize - read GetDictionarySize; - property DiskNumberStart : LongWord - read FDiskNumberStart - write SetDiskNumberStart; - property ExtraField : TAbExtraField - read GetExtraField; - property FileComment : AnsiString - read GetFileComment - write SetFileComment; - property HostOS: TAbZipHostOS - read GetHostOS - write SetHostOS; - property InternalFileAttributes : Word - read GetInternalFileAttributes - write SetInternalFileAttributes; - property GeneralPurposeBitFlag : Word - read GetGeneralPurposeBitFlag - write SetGeneralPurposeBitFlag; - property LFHExtraField : TAbExtraField - read FLFHExtraField; - property RawFileName : AnsiString - read GetRawFileName; - property RelativeOffset : Int64 - read FRelativeOffset - write SetRelativeOffset; - property ShannonFanoTreeCount : Byte - read GetShannonFanoTreeCount; - property VersionMadeBy : Word - read GetVersionMadeBy - write SetVersionMadeBy; - property VersionNeededToExtract : Word - read GetVersionNeededToExtract - write SetVersionNeededToExtract; - end; - -{ TAbZipArchive interface ================================================== } - TAbZipArchive = class( TAbArchive ) - protected {private} - FCompressionMethodToUse : TAbZipSupportedMethod; - FDeflationOption : TAbZipDeflationOption; - FInfo : TAbZipDirectoryFileFooter; - FIsExecutable : Boolean; - FPassword : AnsiString; - FPasswordRetries : Byte; - FStubSize : LongWord; - - FExtractHelper : TAbArchiveItemExtractEvent; - FExtractToStreamHelper : TAbArchiveItemExtractToStreamEvent; - FTestHelper : TAbArchiveItemTestEvent; - FInsertHelper : TAbArchiveItemInsertEvent; - FInsertFromStreamHelper : TAbArchiveItemInsertFromStreamEvent; - FOnNeedPassword : TAbNeedPasswordEvent; - FOnRequestLastDisk : TAbRequestDiskEvent; - FOnRequestNthDisk : TAbRequestNthDiskEvent; - FOnRequestBlankDisk : TAbRequestDiskEvent; - - protected {methods} - procedure DoExtractHelper(Index : Integer; const NewName : string); - procedure DoExtractToStreamHelper(Index : Integer; aStream : TStream); - procedure DoTestHelper(Index : Integer); - procedure DoInsertHelper(Index : Integer; OutStream : TStream); - procedure DoInsertFromStreamHelper(Index : Integer; OutStream : TStream); - function GetItem( Index : Integer ) : TAbZipItem; - function GetZipfileComment : AnsiString; - procedure PutItem( Index : Integer; Value : TAbZipItem ); - procedure DoRequestDisk(const AMessage: string; var Abort : Boolean); - procedure DoRequestLastDisk( var Abort : Boolean ); - virtual; - procedure DoRequestNthDisk(Sender: TObject; DiskNumber : Byte; var Abort : Boolean ); - virtual; - procedure DoRequestBlankDisk(Sender: TObject; var Abort : Boolean ); - virtual; - procedure ExtractItemAt(Index : Integer; const UseName : string); - override; - procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream); - override; - procedure TestItemAt(Index : Integer); - override; - function FixName(const Value : string ) : string; - override; - function GetSupportsEmptyFolders: Boolean; - override; - procedure LoadArchive; - override; - procedure SaveArchive; - override; - procedure SetZipfileComment(const Value : AnsiString ); - - protected {properties} - property IsExecutable : Boolean - read FIsExecutable write FIsExecutable; - - public {protected} - procedure DoRequestImage(Sender: TObject; ImageNumber: Integer; - var ImageName: string; var Abort: Boolean); - - public {methods} - constructor CreateFromStream( aStream : TStream; const ArchiveName : string ); - override; - destructor Destroy; - override; - function CreateItem(const FileName : string): TAbArchiveItem; - override; - - public {properties} - property CompressionMethodToUse : TAbZipSupportedMethod - read FCompressionMethodToUse - write FCompressionMethodToUse; - property DeflationOption : TAbZipDeflationOption - read FDeflationOption - write FDeflationOption; - property ExtractHelper : TAbArchiveItemExtractEvent - read FExtractHelper - write FExtractHelper; - property ExtractToStreamHelper : TAbArchiveItemExtractToStreamEvent - read FExtractToStreamHelper - write FExtractToStreamHelper; - property TestHelper : TAbArchiveItemTestEvent - read FTestHelper - write FTestHelper; - property InsertHelper : TAbArchiveItemInsertEvent - read FInsertHelper - write FInsertHelper; - property InsertFromStreamHelper : TAbArchiveItemInsertFromStreamEvent - read FInsertFromStreamHelper - write FInsertFromStreamHelper; - property Password : AnsiString - read FPassword - write FPassword; - property PasswordRetries : Byte - read FPasswordRetries - write FPasswordRetries - default AbDefPasswordRetries; - property StubSize : LongWord - read FStubSize; - property ZipfileComment : AnsiString - read GetZipfileComment - write SetZipfileComment; - - property Items[Index : Integer] : TAbZipItem - read GetItem - write PutItem; default; - - public {events} - property OnNeedPassword : TAbNeedPasswordEvent - read FOnNeedPassword write FOnNeedPassword; - property OnRequestLastDisk : TAbRequestDiskEvent - read FOnRequestLastDisk write FOnRequestLastDisk; - property OnRequestNthDisk : TAbRequestNthDiskEvent - read FOnRequestNthDisk write FOnRequestNthDisk; - property OnRequestBlankDisk : TAbRequestDiskEvent - read FOnRequestBlankDisk write FOnRequestBlankDisk; - end; - -{============================================================================} -procedure MakeSelfExtracting( StubStream, ZipStream, - SelfExtractingStream : TStream ); - {-takes an executable stub, and a .zip format stream, and creates - a SelfExtracting stream. The stub should create a TAbZipArchive - passing itself as the file, using a read-only open mode. It should - then perform operations as needed - like ExtractFiles( '*.*' ). - This routine updates the RelativeOffset of each item in the archive} - -function FindCentralDirectoryTail(aStream : TStream) : Int64; - -function VerifyZip(Strm : TStream) : TAbArchiveType; - -function VerifySelfExtracting(Strm : TStream) : TAbArchiveType; - -function ZipCompressionMethodToString(aMethod: TAbZipCompressionMethod): string; - -implementation - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} - {$IFDEF LibcAPI} - Libc, - {$ENDIF} - {$IFDEF UnixDialogs} - {$IFDEF KYLIX} - QControls, - QDialogs, - {$ENDIF} - {$IFDEF LCL} - Controls, - Dialogs, - {$ENDIF} - {$ENDIF} - Math, - AbCharset, - AbResString, - AbExcept, - AbVMStrm, - SysUtils; - -function VerifyZip(Strm : TStream) : TAbArchiveType; -{ determine if stream appears to be in PkZip format } -var - Footer : TAbZipEndOfCentralDirectoryRecord; - Sig : LongInt; - TailPosition : int64; - StartPos : int64; -begin - StartPos := Strm.Position; - Result := atUnknown; - try - Strm.Position := 0; - Strm.Read(Sig, SizeOf(Sig)); - if (Sig = Ab_ZipSpannedSetSignature) then - Result := atSpannedZip - else begin - { attempt to find Central Directory Tail } - TailPosition := FindCentralDirectoryTail( Strm ); - if TailPosition <> -1 then begin - { check Central Directory Signature } - Strm.ReadBuffer(Footer, SizeOf(Footer)); - if Footer.Signature = Ab_ZipEndCentralDirectorySignature then - if Footer.DiskNumber = 0 then - Result := atZip - else - Result := atSpannedZip; - end; - end; - except - on EReadError do - Result := atUnknown; - end; - Strm.Position := StartPos; -end; - -function VerifySelfExtracting(Strm : TStream) : TAbArchiveType; -{ determine if stream appears to be an executable with appended PkZip data } -var - FileSignature : Longint; - StartPos : Int64; - IsWinExe, IsLinuxExe : Boolean; -begin - StartPos := Strm.Position; - { verify presence of executable stub } - {check file type of stub stream} - Strm.Position := 0; - Strm.Read( FileSignature, sizeof( FileSignature ) ); - - Result := atSelfExtZip; - - { detect executable type } - IsLinuxExe := FileSignature = Ab_LinuxExeSignature; - IsWinExe := LongRec(FileSignature).Lo = Ab_WindowsExeSignature; - if not (IsWinExe or IsLinuxExe) then - Result := atUnknown; - - { Check for central directory tail } - if VerifyZip(Strm) <> atZip then - Result := atUnknown; - - Strm.Position := StartPos; -end; -{============================================================================} -function ZipCompressionMethodToString(aMethod: TAbZipCompressionMethod): string; -begin - case aMethod of - cmStored: - Result := AbZipStored; - cmShrunk: - Result := AbZipShrunk; - cmReduced1..cmReduced4: - Result := AbZipReduced; - cmImploded: - Result := AbZipImploded; - cmTokenized: - Result := AbZipTokenized; - cmDeflated: - Result := AbZipDeflated; - cmEnhancedDeflated: - Result := AbZipDeflate64; - cmDCLImploded: - Result := AbZipDCLImploded; - cmBzip2: - Result := AbZipBzip2; - cmLZMA: - Result := AbZipLZMA; - cmIBMTerse: - Result := AbZipIBMTerse; - cmLZ77: - Result := AbZipLZ77; - cmJPEG: - Result := AbZipJPEG; - cmWavPack: - Result := AbZipWavPack; - cmPPMd: - Result := AbZipPPMd; - else - Result := Format(AbZipUnknown, [Ord(aMethod)]); - end; -end; -{============================================================================} -function FindCentralDirectoryTail(aStream : TStream) : Int64; -{ search end of aStream looking for ZIP Central Directory structure - returns position in stream if found (otherwise returns -1), - leaves stream positioned at start of structure or at original - position if not found } -const - StartBufSize = 512; - MaxBufSize = 64 * 1024; -var - StartPos : Int64; - TailRec : TAbZipEndOfCentralDirectoryRecord; - Buffer : PAnsiChar; - Offset : Int64; - TestPos : PAnsiChar; - Done : boolean; - BytesRead : Int64; - BufSize : Int64; - CommentLen: integer; -begin - {save the starting position} - StartPos := aStream.Seek(0, soCurrent); - - {start off with the majority case: no zip file comment, so the - central directory tail is the last thing in the stream and it's a - fixed size and doesn't indicate a zip file comment} - Result := aStream.Seek(-sizeof(TailRec), soEnd); - if (Result >= 0) then begin - aStream.ReadBuffer(TailRec, sizeof(TailRec)); - if (TailRec.Signature = Ab_ZipEndCentralDirectorySignature) and - (TailRec.CommentLength = 0) then begin - aStream.Seek(Result, soBeginning); - Exit; - end; - end; - - {the zip stream seems to have a comment, or it has null padding - bytes from some flaky program, or it's not even a zip formatted - stream; we need to search for the tail signature} - - {get a buffer} - BufSize := StartBufSize; - GetMem(Buffer, BufSize); - try - - {start out searching backwards} - Offset := -BufSize; - - {while there is still data to search ...} - Done := false; - while not Done do begin - - {seek to the search position} - Result := aStream.Seek(Offset, soEnd); - if (Result <= 0) then begin - Result := aStream.Seek(0, soBeginning); - Done := true; - end; - - {read a buffer full} - BytesRead := aStream.Read(Buffer^, BufSize); - - if BytesRead < sizeOf(TailRec) then begin - Result := -1; - Exit; - end; - - {search backwards through the buffer looking for the signature} - TestPos := Buffer + BytesRead - sizeof(TailRec); - while (TestPos <> Buffer) and - (PLongint(TestPos)^ <> Ab_ZipEndCentralDirectorySignature) do - dec(TestPos); - - {if we found the signature...} - if (PLongint(TestPos)^ = Ab_ZipEndCentralDirectorySignature) then begin - - {get the tail record at this position} - Move(TestPos^, TailRec, sizeof(TailRec)); - - {if it's as valid a tail as we can check here...} - CommentLen := -Offset - (TestPos - Buffer + sizeof(TailRec)); - if (TailRec.CommentLength <= CommentLen) then begin - - {calculate its position and exit} - Result := Result + (TestPos - Buffer); - aStream.Seek(Result, soBeginning); - Exit; - end; - end; - - {otherwise move back one step, doubling the buffer} - if (BufSize < MaxBufSize) then begin - FreeMem(Buffer); - BufSize := BufSize * 2; - if BufSize > MaxBufSize then - BufSize := MaxBufSize; - GetMem(Buffer, BufSize); - end; - dec(Offset, BufSize - SizeOf(TailRec)); - end; - - {if we reach this point, the CD tail is not present} - Result := -1; - aStream.Seek(StartPos, soBeginning); - finally - FreeMem(Buffer); - end; -end; -{============================================================================} -procedure MakeSelfExtracting( StubStream, ZipStream, - SelfExtractingStream : TStream ); - {-takes an executable stub, and a .zip format stream, and creates - a SelfExtracting stream. The stub should create a TAbZipArchive - passing itself as the file, using a read-only open mode. It should - then perform operations as needed - like ExtractFiles( '*.*' ). - This routine updates the RelativeOffset of each item in the archive} -var - DirectoryStart : Int64; - FileSignature : Longint; - StubSize : LongWord; - TailPosition : Int64; - ZDFF : TAbZipDirectoryFileFooter; - ZipItem : TAbZipItem; - IsWinExe, IsLinuxExe : Boolean; -begin - {check file type of stub stream} - StubStream.Position := 0; - StubStream.Read(FileSignature, SizeOf(FileSignature)); - - {detect executable type } - IsLinuxExe := FileSignature = Ab_LinuxExeSignature; - IsWinExe := LongRec(FileSignature).Lo = Ab_WindowsExeSignature; - - if not (IsWinExe or IsLinuxExe) then - raise EAbZipInvalidStub.Create; - - StubStream.Position := 0; - StubSize := StubStream.Size; - - ZipStream.Position := 0; - ZipStream.Read( FileSignature, sizeof( FileSignature ) ); - if LongRec(FileSignature).Lo <> Ab_GeneralZipSignature then - raise EAbZipInvalid.Create; - ZipStream.Position := 0; - - {copy the stub into the selfex stream} - SelfExtractingStream.Position := 0; - SelfExtractingStream.CopyFrom( StubStream, 0 ); - - TailPosition := FindCentralDirectoryTail( ZipStream ); - if TailPosition = -1 then - raise EAbZipInvalid.Create; - {load the ZipDirectoryFileFooter} - ZDFF := TAbZipDirectoryFileFooter.Create; - try - ZDFF.LoadFromStream( ZipStream ); - DirectoryStart := ZDFF.DirectoryOffset; - finally - ZDFF.Free; - end; - {copy everything up to the CDH into the SelfExtractingStream} - ZipStream.Position := 0; - SelfExtractingStream.CopyFrom( ZipStream, DirectoryStart ); - ZipStream.Position := DirectoryStart; - repeat - ZipItem := TAbZipItem.Create; - try - ZipItem.LoadFromStream( ZipStream ); - ZipItem.RelativeOffset := ZipItem.RelativeOffset + StubSize; - {save the modified entry into the Self Extracting Stream} - ZipItem.SaveCDHToStream( SelfExtractingStream ); - finally - ZipItem.Free; - end; - until ZipStream.Position = TailPosition; - - {save the CDH Footer.} - ZDFF := TAbZipDirectoryFileFooter.Create; - try - ZDFF.LoadFromStream( ZipStream ); - ZDFF.DirectoryOffset := ZDFF.DirectoryOffset + StubSize; - ZDFF.SaveToStream( SelfExtractingStream ); - finally - ZDFF.Free; - end; -end; -{============================================================================} -{ TAbZipDataDescriptor implementation ====================================== } -procedure TAbZipDataDescriptor.SaveToStream( Stream : TStream ); -begin - Stream.Write( Ab_ZipDataDescriptorSignature, sizeof( Ab_ZipDataDescriptorSignature ) ); - Stream.Write( FCRC32, sizeof( FCRC32 ) ); - if (FCompressedSize >= $FFFFFFFF) or (FUncompressedSize >= $FFFFFFFF) then begin - Stream.Write( FCompressedSize, sizeof( FCompressedSize ) ); - Stream.Write( FUncompressedSize, sizeof( FUncompressedSize ) ); - end - else begin - Stream.Write( FCompressedSize, sizeof( LongWord ) ); - Stream.Write( FUncompressedSize, sizeof( LongWord ) ); - end; -end; -{ -------------------------------------------------------------------------- } - -{ TAbZipFileHeader implementation ========================================== } -constructor TAbZipFileHeader.Create; -begin - inherited Create; - FExtraField := TAbExtraField.Create; - FValidSignature := $0; -end; -{ -------------------------------------------------------------------------- } -destructor TAbZipFileHeader.Destroy; -begin - FreeAndNil(FExtraField); - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetCompressionMethod : TAbZipCompressionMethod; -begin - Result := TAbZipCompressionMethod( FCompressionMethod ); -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetDataDescriptor : Boolean; -begin - Result := ( CompressionMethod = cmDeflated ) and - ( ( FGeneralPurposeBitFlag and AbHasDataDescriptorFlag ) <> 0 ); -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetCompressionRatio : Double; -var - CompSize : Int64; -begin - {adjust for encrypted headers - ensures we never get negative compression - ratios for stored, encrypted files - no guarantees about negative - compression ratios in other cases} - if isEncrypted then - CompSize := CompressedSize - 12 - else - CompSize := CompressedSize; - if UncompressedSize > 0 then - Result := 100.0 * ( 1 - ( ( 1.0 * CompSize ) / UncompressedSize ) ) - else - Result := 0.0; -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetDeflationOption : TAbZipDeflationOption; -begin - if CompressionMethod = cmDeflated then - if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then - if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then - Result := doSuperFast - else - Result := doMaximum - else - if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then - Result := doFast - else - Result := doNormal - else - Result := doInvalid; -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetDictionarySize : TAbZipDictionarySize; -begin - if CompressionMethod = cmImploded then - if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then - Result := ds8K - else - Result := ds4K - else - Result := dsInvalid; -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetEncrypted : Boolean; -begin - {bit 0 of the GeneralPurposeBitFlag} - Result := ( ( FGeneralPurposeBitFlag and AbFileIsEncryptedFlag ) <> 0 ); -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetIsUTF8 : Boolean; -begin - Result := ( ( GeneralPurposeBitFlag and AbLanguageEncodingFlag ) <> 0 ); -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetShannonFanoTreeCount : Byte; -begin - if CompressionMethod = cmImploded then - if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then - Result := 3 - else - Result := 2 - else - Result := 0; -end; -{ -------------------------------------------------------------------------- } -function TAbZipFileHeader.GetValid : Boolean; -begin - Result := ( FValidSignature = FSignature ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipFileHeader.SetCompressionMethod( Value : - TAbZipCompressionMethod ); -begin - FCompressionMethod := Ord( Value ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipFileHeader.SetIsUTF8( Value : Boolean ); -begin - if Value then - GeneralPurposeBitFlag := GeneralPurposeBitFlag or AbLanguageEncodingFlag - else - GeneralPurposeBitFlag := GeneralPurposeBitFlag and not AbLanguageEncodingFlag; -end; -{ -------------------------------------------------------------------------- } - -{ TAbZipLocalFileHeader implementation ===================================== } -constructor TAbZipLocalFileHeader.Create; -begin - inherited Create; - FValidSignature := Ab_ZipLocalFileHeaderSignature; -end; -{ -------------------------------------------------------------------------- } -destructor TAbZipLocalFileHeader.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipLocalFileHeader.LoadFromStream( Stream : TStream ); -var - ExtraFieldLength, FileNameLength : Word; -begin - with Stream do begin - Read( FSignature, sizeof( FSignature ) ); - Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) ); - Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) ); - Read( FCompressionMethod, sizeof( FCompressionMethod ) ); - Read( FLastModFileTime, sizeof( FLastModFileTime ) ); - Read( FLastModFileDate, sizeof( FLastModFileDate ) ); - Read( FCRC32, sizeof( FCRC32 ) ); - Read( FCompressedSize, sizeof( FCompressedSize ) ); - Read( FUncompressedSize, sizeof( FUncompressedSize ) ); - Read( FileNameLength, sizeof( FileNameLength ) ); - Read( ExtraFieldLength, sizeof( ExtraFieldLength ) ); - - SetLength( FFileName, FileNameLength ); - if FileNameLength > 0 then - Read( FFileName[1], FileNameLength ); - - FExtraField.LoadFromStream( Stream, ExtraFieldLength ); - end; - if not IsValid then - raise EAbZipInvalid.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipLocalFileHeader.SaveToStream( Stream : TStream ); -var - ExtraFieldLength, FileNameLength: Word; -begin - with Stream do begin - {write the valid signature from the constant} - Write( FValidSignature, sizeof( FValidSignature ) ); - Write( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) ); - Write( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) ); - Write( FCompressionMethod, sizeof( FCompressionMethod ) ); - Write( FLastModFileTime, sizeof( FLastModFileTime ) ); - Write( FLastModFileDate, sizeof( FLastModFileDate ) ); - Write( FCRC32, sizeof( FCRC32 ) ); - Write( FCompressedSize, sizeof( FCompressedSize ) ); - Write( FUncompressedSize, sizeof( FUncompressedSize ) ); - FileNameLength := Word( Length( FFileName ) ); - Write( FileNameLength, sizeof( FileNameLength ) ); - ExtraFieldLength := Length(FExtraField.Buffer); - Write( ExtraFieldLength, sizeof( ExtraFieldLength ) ); - if FileNameLength > 0 then - Write( FFileName[1], FileNameLength ); - if ExtraFieldLength > 0 then - Write(FExtraField.Buffer[0], ExtraFieldLength); - end; -end; -{ -------------------------------------------------------------------------- } - -{ TAbZipDirectoryFileHeader implementation ================================= } -constructor TAbZipDirectoryFileHeader.Create; -begin - inherited Create; - FValidSignature := Ab_ZipCentralDirectoryFileHeaderSignature; -end; -{ -------------------------------------------------------------------------- } -destructor TAbZipDirectoryFileHeader.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDirectoryFileHeader.LoadFromStream( Stream : TStream ); -var - ExtraFieldLength, FileCommentLength, FileNameLength : Word; -begin - with Stream do begin - Read( FSignature, sizeof( FSignature ) ); - Read( FVersionMadeBy, sizeof( FVersionMadeBy ) ); - Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) ); - Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) ); - Read( FCompressionMethod, sizeof( FCompressionMethod ) ); - Read( FLastModFileTime, sizeof( FLastModFileTime ) ); - Read( FLastModFileDate, sizeof( FLastModFileDate ) ); - Read( FCRC32, sizeof( FCRC32 ) ); - Read( FCompressedSize, sizeof( FCompressedSize ) ); - Read( FUncompressedSize, sizeof( FUncompressedSize ) ); - Read( FileNameLength, sizeof( FileNameLength ) ); - Read( ExtraFieldLength, sizeof( ExtraFieldLength ) ); - Read( FileCommentLength, sizeof( FileCommentLength ) ); - Read( FDiskNumberStart, sizeof( FDiskNumberStart ) ); - Read( FInternalFileAttributes, sizeof( FInternalFileAttributes ) ); - Read( FExternalFileAttributes, sizeof( FExternalFileAttributes ) ); - Read( FRelativeOffset, sizeof( FRelativeOffset ) ); - - SetLength( FFileName, FileNameLength ); - if FileNameLength > 0 then - Read( FFileName[1], FileNameLength ); - - FExtraField.LoadFromStream( Stream, ExtraFieldLength ); - - SetLength( FFileComment, FileCommentLength ); - if FileCommentLength > 0 then - Read( FFileComment[1], FileCommentLength ); - end; - if not IsValid then - raise EAbZipInvalid.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDirectoryFileHeader.SaveToStream( Stream : TStream ); -var - ExtraFieldLength, FileCommentLength, FileNameLength : Word; -begin - with Stream do begin - {write the valid signature from the constant} - Write( FValidSignature, sizeof( FValidSignature ) ); - Write( FVersionMadeBy, sizeof( FVersionMadeBy ) ); - Write( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) ); - Write( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) ); - Write( FCompressionMethod, sizeof( FCompressionMethod ) ); - Write( FLastModFileTime, sizeof( FLastModFileTime ) ); - Write( FLastModFileDate, sizeof( FLastModFileDate ) ); - Write( FCRC32, sizeof( FCRC32 ) ); - Write( FCompressedSize, sizeof( FCompressedSize ) ); - Write( FUncompressedSize, sizeof( FUncompressedSize ) ); - FileNameLength := Word( Length( FFileName ) ); - Write( FileNameLength, sizeof( FileNameLength ) ); - ExtraFieldLength := Length(FExtraField.Buffer); - Write( ExtraFieldLength, sizeof( ExtraFieldLength ) ); - FileCommentLength := Word( Length( FFileComment ) ); - Write( FileCommentLength, sizeof( FileCommentLength ) ); - Write( FDiskNumberStart, sizeof( FDiskNumberStart ) ); - Write( FInternalFileAttributes, sizeof( FInternalFileAttributes ) ); - Write( FExternalFileAttributes, sizeof( FExternalFileAttributes ) ); - Write( FRelativeOffset, sizeof( FRelativeOffset ) ); - if FileNameLength > 0 then - Write( FFileName[1], FileNameLength ); - if ExtraFieldLength > 0 then - Write( FExtraField.Buffer[0], ExtraFieldLength ); - if FileCommentLength > 0 then - Write( FFileComment[1], FileCommentLength ); - end; -end; -{ -------------------------------------------------------------------------- } - -{ TAbZipDirectoryFileFooter implementation ================================= } -function TAbZipDirectoryFileFooter.GetIsZip64: Boolean; -begin - Result := (DiskNumber >= $FFFF) or - (StartDiskNumber >= $FFFF) or - (EntriesOnDisk >= $FFFF) or - (TotalEntries >= $FFFF) or - (DirectorySize >= $FFFFFFFF) or - (DirectoryOffset >= $FFFFFFFF); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDirectoryFileFooter.LoadFromStream( Stream : TStream ); -var - Footer: TAbZipEndOfCentralDirectoryRecord; -begin - Stream.ReadBuffer( Footer, SizeOf(Footer) ); - if Footer.Signature <> Ab_ZipEndCentralDirectorySignature then - raise EAbZipInvalid.Create; - FDiskNumber := Footer.DiskNumber; - FStartDiskNumber := Footer.StartDiskNumber; - FEntriesOnDisk := Footer.EntriesOnDisk; - FTotalEntries := Footer.TotalEntries; - FDirectorySize := Footer.DirectorySize; - FDirectoryOffset := Footer.DirectoryOffset; - SetLength( FZipfileComment, Footer.CommentLength ); - if Footer.CommentLength > 0 then - Stream.ReadBuffer( FZipfileComment[1], Footer.CommentLength ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDirectoryFileFooter.LoadZip64FromStream( Stream : TStream ); - {load the ZIP64 end of central directory record. - LoadFromStream() must be called first to load the standard record} -var - Footer: TAbZip64EndOfCentralDirectoryRecord; -begin - Stream.ReadBuffer( Footer, SizeOf(Footer) ); - if Footer.Signature <> Ab_Zip64EndCentralDirectorySignature then - raise EAbZipInvalid.Create; - if FDiskNumber = $FFFF then - FDiskNumber := Footer.DiskNumber; - if FStartDiskNumber = $FFFF then - FStartDiskNumber := Footer.StartDiskNumber; - if FEntriesOnDisk = $FFFF then - FEntriesOnDisk := Footer.EntriesOnDisk; - if FTotalEntries = $FFFF then - FTotalEntries := Footer.TotalEntries; - if FDirectorySize = $FFFFFFFF then - FDirectorySize := Footer.DirectorySize; - if FDirectoryOffset = $FFFFFFFF then - FDirectoryOffset := Footer.DirectoryOffset; - {RecordSize, VersionMadeBy, and VersionNeededToExtract are currently ignored} -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipDirectoryFileFooter.SaveToStream( Stream : TStream; - aZip64TailOffset: Int64 = -1); - {write end of central directory record, along with Zip64 records if necessary. - aZip64TailOffset is the value to use for the Zip64 locator's directory - offset, and is only necessary when writing to an intermediate stream} -var - Footer: TAbZipEndOfCentralDirectoryRecord; - Zip64Footer: TAbZip64EndOfCentralDirectoryRecord; - Zip64Locator: TAbZip64EndOfCentralDirectoryLocator; -begin - if IsZip64 then begin - {setup Zip64 end of central directory record} - Zip64Footer.Signature := Ab_Zip64EndCentralDirectorySignature; - Zip64Footer.RecordSize := SizeOf(Zip64Footer) - - SizeOf(Zip64Footer.Signature) - SizeOf(Zip64Footer.RecordSize); - Zip64Footer.VersionMadeBy := 45; - Zip64Footer.VersionNeededToExtract := 45; - Zip64Footer.DiskNumber := DiskNumber; - Zip64Footer.StartDiskNumber := StartDiskNumber; - Zip64Footer.EntriesOnDisk := EntriesOnDisk; - Zip64Footer.TotalEntries := TotalEntries; - Zip64Footer.DirectorySize := DirectorySize; - Zip64Footer.DirectoryOffset := DirectoryOffset; - {setup Zip64 end of central directory locator} - Zip64Locator.Signature := Ab_Zip64EndCentralDirectoryLocatorSignature; - Zip64Locator.StartDiskNumber := DiskNumber; - if aZip64TailOffset = -1 then - Zip64Locator.RelativeOffset := Stream.Position - else - Zip64Locator.RelativeOffset := aZip64TailOffset; - Zip64Locator.TotalDisks := DiskNumber + 1; - {write Zip64 records} - Stream.WriteBuffer(Zip64Footer, SizeOf(Zip64Footer)); - Stream.WriteBuffer(Zip64Locator, SizeOf(Zip64Locator)); - end; - Footer.Signature := Ab_ZipEndCentralDirectorySignature; - Footer.DiskNumber := Min(FDiskNumber, $FFFF); - Footer.StartDiskNumber := Min(FStartDiskNumber, $FFFF); - Footer.EntriesOnDisk := Min(FEntriesOnDisk, $FFFF); - Footer.TotalEntries := Min(FTotalEntries, $FFFF); - Footer.DirectorySize := Min(FDirectorySize, $FFFFFFFF); - Footer.DirectoryOffset := Min(FDirectoryOffset, $FFFFFFFF); - Footer.CommentLength := Length( FZipfileComment ); - Stream.WriteBuffer( Footer, SizeOf(Footer) ); - if FZipfileComment <> '' then - Stream.Write( FZipfileComment[1], Length(FZipfileComment) ); -end; -{ -------------------------------------------------------------------------- } - -{ TAbZipItem implementation ================================================ } -constructor TAbZipItem.Create; -begin - inherited Create; - FItemInfo := TAbZipDirectoryFileHeader.Create; - FLFHExtraField := TAbExtraField.Create; -end; -{ -------------------------------------------------------------------------- } -destructor TAbZipItem.Destroy; -begin - FLFHExtraField.Free; - FItemInfo.Free; - FItemInfo := nil; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetCompressionMethod : TAbZipCompressionMethod; -begin - Result := FItemInfo.CompressionMethod; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetCompressionRatio : Double; -begin - Result := FItemInfo.CompressionRatio; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetCRC32 : Longint; -begin - Result := FItemInfo.CRC32; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetDeflationOption : TAbZipDeflationOption; -begin - Result := FItemInfo.DeflationOption; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetDictionarySize : TAbZipDictionarySize; -begin - Result := FItemInfo.DictionarySize; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetGeneralPurposeBitFlag : Word; -begin - Result := FItemInfo.GeneralPurposeBitFlag; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetHostOS: TAbZipHostOS; -begin - Result := TAbZipHostOS(Hi(VersionMadeBy)); -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetExternalFileAttributes : LongWord; -begin - Result := FItemInfo.ExternalFileAttributes; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetExtraField : TAbExtraField; -begin - Result := FItemInfo.ExtraField; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetFileComment : AnsiString; -begin - Result := FItemInfo.FileComment; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetInternalFileAttributes : Word; -begin - Result := FItemInfo.InternalFileAttributes; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetIsDirectory: Boolean; -begin - Result := ((ExternalFileAttributes and faDirectory) <> 0) or - ((FileName <> '') and CharInSet(Filename[Length(FFilename)], ['\','/'])); -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetIsEncrypted : Boolean; -begin - Result := FItemInfo.IsEncrypted; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetLastModFileDate : Word; -begin - Result := FItemInfo.LastModFileDate; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetLastModFileTime : Word; -begin - Result := FItemInfo.LastModFileTime; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetNativeFileAttributes : LongInt; -begin -{$IFDEF MSWINDOWS} - if (HostOS = hosUnix) or (ExternalFileAttributes > $1FFFF) then - Result := AbUnix2DosFileAttributes(ExternalFileAttributes shr 16) - else - Result := Byte(ExternalFileAttributes); -{$ENDIF} -{$IFDEF UNIX} - if HostOS in [hosDOS, hosNTFS, hosWinNT] then - Result := AbDOS2UnixFileAttributes(ExternalFileAttributes) - else - Result := ExternalFileAttributes shr 16; -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetRawFileName : AnsiString; -begin - Result := FItemInfo.FileName; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetShannonFanoTreeCount : Byte; -begin - Result := FItemInfo.ShannonFanoTreeCount; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetVersionMadeBy : Word; -begin - Result := FItemInfo.VersionMadeBy; -end; -{ -------------------------------------------------------------------------- } -function TAbZipItem.GetVersionNeededToExtract : Word; -begin - Result := FItemInfo.VersionNeededToExtract; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.LoadFromStream( Stream : TStream ); -var - FieldSize: Word; - FieldStream: TStream; - InfoZipField: PInfoZipUnicodePathRec; - UnicodeName: UnicodeString; - UTF8Name: AnsiString; - XceedField: PXceedUnicodePathRec; -begin - FItemInfo.LoadFromStream( Stream ); - - { decode filename (ANSI/OEM/UTF-8) } - if FItemInfo.IsUTF8 or (AbDetectCharSet(FItemInfo.FileName) = csUTF8) then - FFileName := UTF8ToString(FItemInfo.FileName) - else if FItemInfo.ExtraField.Get(Ab_InfoZipUnicodePathSubfieldID, Pointer(InfoZipField), FieldSize) and - (FieldSize > SizeOf(TInfoZipUnicodePathRec)) and - (InfoZipField.Version = 1) and - (InfoZipField.NameCRC32 = AbCRC32Of(FItemInfo.FileName)) then begin - SetString(UTF8Name, InfoZipField.UnicodeName, - FieldSize - SizeOf(TInfoZipUnicodePathRec) + 1); - FFileName := UTF8ToString(UTF8Name); - end - else if FItemInfo.ExtraField.Get(Ab_XceedUnicodePathSubfieldID, Pointer(XceedField), FieldSize) and - (FieldSize > SizeOf(TXceedUnicodePathRec)) and - (XceedField.Signature = Ab_XceedUnicodePathSignature) and - (XceedField.Length * SizeOf(WideChar) = FieldSize - SizeOf(TXceedUnicodePathRec) + SizeOf(WideChar)) then begin - SetString(UnicodeName, XceedField.UnicodeName, XceedField.Length); - FFileName := string(UnicodeName); - end - {$IFDEF MSWINDOWS} - else if (GetACP <> GetOEMCP) and ((HostOS = hosDOS) or AbIsOEM(FItemInfo.FileName)) then begin - SetLength(FFileName, Length(FItemInfo.FileName)); - OemToCharBuff(PAnsiChar(FItemInfo.FileName), PChar(FFileName), Length(FFileName)); - end - {$ENDIF} - else - FFileName := string(FItemInfo.FileName); - - { read ZIP64 extended header } - FUncompressedSize := FItemInfo.UncompressedSize; - FCompressedSize := FItemInfo.CompressedSize; - FRelativeOffset := FItemInfo.RelativeOffset; - FDiskNumberStart := FItemInfo.DiskNumberStart; - if FItemInfo.ExtraField.GetStream(Ab_Zip64SubfieldID, FieldStream) then - try - if FItemInfo.UncompressedSize = $FFFFFFFF then - FieldStream.ReadBuffer(FUncompressedSize, SizeOf(Int64)); - if FItemInfo.CompressedSize = $FFFFFFFF then - FieldStream.ReadBuffer(FCompressedSize, SizeOf(Int64)); - if FItemInfo.RelativeOffset = $FFFFFFFF then - FieldStream.ReadBuffer(FRelativeOffset, SizeOf(Int64)); - if FItemInfo.DiskNumberStart = $FFFF then - FieldStream.ReadBuffer(FDiskNumberStart, SizeOf(LongWord)); - finally - FieldStream.Free; - end; - - LastModFileTime := FItemInfo.LastModFileTime; - LastModFileDate := FItemInfo.LastModFileDate; - FDiskFileName := FileName; - AbUnfixName( FDiskFileName ); - Action := aaNone; - Tagged := False; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SaveLFHToStream( Stream : TStream ); -var - LFH : TAbZipLocalFileHeader; - Zip64Field: TZip64LocalHeaderRec; -begin - LFH := TAbZipLocalFileHeader.Create; - try - LFH.VersionNeededToExtract := VersionNeededToExtract; - LFH.GeneralPurposeBitFlag := GeneralPurposeBitFlag; - LFH.CompressionMethod := CompressionMethod; - LFH.LastModFileTime := LastModFileTime; - LFH.LastModFileDate := LastModFileDate; - LFH.CRC32 := CRC32; - LFH.FileName := RawFileName; - LFH.ExtraField.Assign(LFHExtraField); - LFH.ExtraField.CloneFrom(ExtraField, Ab_InfoZipUnicodePathSubfieldID); - LFH.ExtraField.CloneFrom(ExtraField, Ab_XceedUnicodePathSubfieldID); - { setup sizes; unlike the central directory header, the ZIP64 local header - needs to store both compressed and uncompressed sizes if either needs it } - if (CompressedSize >= $FFFFFFFF) or (UncompressedSize >= $FFFFFFFF) then begin - LFH.UncompressedSize := $FFFFFFFF; - LFH.CompressedSize := $FFFFFFFF; - Zip64Field.UncompressedSize := UncompressedSize; - Zip64Field.CompressedSize := CompressedSize; - LFH.ExtraField.Put(Ab_Zip64SubfieldID, Zip64Field, SizeOf(Zip64Field)); - end - else begin - LFH.UncompressedSize := UncompressedSize; - LFH.CompressedSize := CompressedSize; - LFH.ExtraField.Delete(Ab_Zip64SubfieldID); - end; - LFH.SaveToStream( Stream ); - finally - LFH.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SaveCDHToStream( Stream : TStream ); - {-Save a ZipCentralDirectorHeader entry to Stream} -begin - FItemInfo.SaveToStream( Stream ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SaveDDToStream( Stream : TStream ); -var - DD : TAbZipDataDescriptor; -begin - DD := TAbZipDataDescriptor.Create; - try - DD.CRC32 := CRC32; - DD.CompressedSize := CompressedSize; - DD.UncompressedSize := UncompressedSize; - DD.SaveToStream( Stream ); - finally - DD.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetCompressedSize( const Value : Int64 ); -begin - FCompressedSize := Value; - FItemInfo.CompressedSize := Min(Value, $FFFFFFFF); - UpdateZip64ExtraHeader; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetCompressionMethod( Value : TAbZipCompressionMethod ); -begin - FItemInfo.CompressionMethod := Value; - UpdateVersionNeededToExtract; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetCRC32( const Value : Longint ); -begin - FItemInfo.CRC32 := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetDiskNumberStart( Value : LongWord ); -begin - FDiskNumberStart := Value; - FItemInfo.DiskNumberStart := Min(Value, $FFFF); - UpdateZip64ExtraHeader; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetExternalFileAttributes( Value : LongWord ); -begin - FItemInfo.ExternalFileAttributes := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetFileComment(const Value : AnsiString ); -begin - FItemInfo.FileComment := Value; -end; -{ -------------------------------------------------------------------------- } -{$IFDEF KYLIX}{$IFOPT O+}{$DEFINE OPTIMIZATIONS_ON}{$O-}{$ENDIF}{$ENDIF} -procedure TAbZipItem.SetFileName(const Value : string ); -var - {$IFDEF MSWINDOWS} - AnsiName : AnsiString; - {$ENDIF} - UTF8Name : AnsiString; - FieldSize : Word; - I : Integer; - InfoZipField : PInfoZipUnicodePathRec; - UseExtraField: Boolean; -begin - inherited SetFileName(Value); - {$IFDEF MSWINDOWS} - FItemInfo.IsUTF8 := False; - HostOS := hosDOS; - if AbTryEncode(Value, CP_OEMCP, False, AnsiName) then - {no-op} - else if (GetACP <> GetOEMCP) and AbTryEncode(Value, CP_ACP, False, AnsiName) then - HostOS := hosWinNT - else if AbTryEncode(Value, CP_OEMCP, True, AnsiName) then - {no-op} - else if (GetACP <> GetOEMCP) and AbTryEncode(Value, CP_ACP, True, AnsiName) then - HostOS := hosWinNT - else - FItemInfo.IsUTF8 := True; - if FItemInfo.IsUTF8 then - FItemInfo.FileName := Utf8Encode(Value) - else - FItemInfo.FileName := AnsiName; - {$ENDIF} - {$IFDEF UNIX} - FItemInfo.FileName := AnsiString(Value); - FItemInfo.IsUTF8 := AbSysCharSetIsUTF8; - {$ENDIF} - - UseExtraField := False; - if not FItemInfo.IsUTF8 then - for i := 1 to Length(Value) do begin - if Ord(Value[i]) > 127 then begin - UseExtraField := True; - Break; - end; - end; - - if UseExtraField then begin - UTF8Name := AnsiToUTF8(Value); - FieldSize := SizeOf(TInfoZipUnicodePathRec) + Length(UTF8Name) - 1; - GetMem(InfoZipField, FieldSize); - try - InfoZipField.Version := 1; - InfoZipField.NameCRC32 := AbCRC32Of(FItemInfo.FileName); - Move(UTF8Name[1], InfoZipField.UnicodeName, Length(UTF8Name)); - FItemInfo.ExtraField.Put(Ab_InfoZipUnicodePathSubfieldID, InfoZipField^, FieldSize); - finally - FreeMem(InfoZipField); - end; - end - else - FItemInfo.ExtraField.Delete(Ab_InfoZipUnicodePathSubfieldID); - FItemInfo.ExtraField.Delete(Ab_XceedUnicodePathSubfieldID); -end; -{$IFDEF OPTIMIZATIONS_ON}{$O+}{$ENDIF} -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetGeneralPurposeBitFlag( Value : Word ); -begin - FItemInfo.GeneralPurposeBitFlag := Value; - UpdateVersionNeededToExtract; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetHostOS( Value : TAbZipHostOS ); -begin - FItemInfo.VersionMadeBy := Low(FItemInfo.VersionMadeBy) or - Word(Ord(Value)) shl 8; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetInternalFileAttributes( Value : Word ); -begin - FItemInfo.InternalFileAttributes := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetLastModFileDate( const Value : Word ); -begin - FItemInfo.LastModFileDate := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetLastModFileTime( const Value : Word ); -begin - FItemInfo.LastModFileTime := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetRelativeOffset( Value : Int64 ); -begin - FRelativeOffset := Value; - FItemInfo.RelativeOffset := Min(Value, $FFFFFFFF); - UpdateZip64ExtraHeader; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetUncompressedSize( const Value : Int64 ); -begin - FUncompressedSize := Value; - FItemInfo.UncompressedSize:= Min(Value, $FFFFFFFF); - UpdateZip64ExtraHeader; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetVersionMadeBy( Value : Word ); -begin - FItemInfo.VersionMadeBy := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.SetVersionNeededToExtract( Value : Word ); -begin - FItemInfo.VersionNeededToExtract := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.UpdateVersionNeededToExtract; - {calculates VersionNeededToExtract and VersionMadeBy based on used features} -begin - {According to AppNote.txt zipx compression methods should set the Version - Needed To Extract to the AppNote version the method was introduced in (e.g., - 6.3 for PPMd). Most utilities just set it to 2.0 and rely on the extractor - detecting unsupported compression methods, since it's easier to add support - for decompression methods without implementing the entire newer spec. } - if ExtraField.Has(Ab_Zip64SubfieldID) then - VersionNeededToExtract := 45 - else if IsDirectory or IsEncrypted or not (CompressionMethod in [cmStored..cmImploded]) then - VersionNeededToExtract := 20 - else - VersionNeededToExtract := 10; - VersionMadeBy := (VersionMadeBy and $FF00) + Max(20, VersionNeededToExtract); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipItem.UpdateZip64ExtraHeader; -var - Changed: Boolean; - FieldStream: TMemoryStream; -begin - FieldStream := TMemoryStream.Create; - try - if UncompressedSize >= $FFFFFFFF then - FieldStream.WriteBuffer(FUncompressedSize, SizeOf(Int64)); - if CompressedSize >= $FFFFFFFF then - FieldStream.WriteBuffer(FCompressedSize, SizeOf(Int64)); - if RelativeOffset >= $FFFFFFFF then - FieldStream.WriteBuffer(FRelativeOffset, SizeOf(Int64)); - if DiskNumberStart >= $FFFF then - FieldStream.WriteBuffer(FDiskNumberStart, SizeOf(LongWord)); - Changed := (FieldStream.Size > 0) <> ExtraField.Has(Ab_Zip64SubfieldID); - if FieldStream.Size > 0 then - ExtraField.Put(Ab_Zip64SubfieldID, FieldStream.Memory^, FieldStream.Size) - else - ExtraField.Delete(Ab_Zip64SubfieldID); - if Changed then - UpdateVersionNeededToExtract; - finally - FieldStream.Free; - end; -end; -{ -------------------------------------------------------------------------- } - - -{ TAbZipArchive implementation ============================================= } -constructor TAbZipArchive.CreateFromStream( aStream : TStream; - const ArchiveName : string ); -begin - inherited CreateFromStream( aStream, ArchiveName ); - FCompressionMethodToUse := smBestMethod; - FInfo := TAbZipDirectoryFileFooter.Create; - StoreOptions := StoreOptions + [soStripDrive]; - FDeflationOption := doNormal; - FPasswordRetries := AbDefPasswordRetries; - FTempDir := ''; - SpanningThreshold := AbDefZipSpanningThreshold; -end; -{ -------------------------------------------------------------------------- } -destructor TAbZipArchive.Destroy; -begin - FInfo.Free; - FInfo := nil; - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -function TAbZipArchive.CreateItem( const FileName : string ): TAbArchiveItem; -var - FileSpec : string; -begin - FileSpec := FileName; - Result := TAbZipItem.Create; - with TAbZipItem( Result ) do begin - CompressionMethod := cmDeflated; - GeneralPurposeBitFlag := 0; - CompressedSize := 0; - CRC32 := 0; - DiskFileName := ExpandFileName(FileSpec); - FileName := FixName(FileSpec); - RelativeOffset := 0; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoExtractHelper(Index : Integer; const NewName : string); -begin - if Assigned(FExtractHelper) then - FExtractHelper(Self, ItemList[Index], NewName) - else - raise EAbZipNoExtraction.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoExtractToStreamHelper(Index : Integer; - aStream : TStream); -begin - if Assigned(FExtractToStreamHelper) then - FExtractToStreamHelper(Self, ItemList[Index], aStream) - else - raise EAbZipNoExtraction.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoTestHelper(Index : Integer); -begin - if Assigned(FTestHelper) then - FTestHelper(Self, ItemList[Index]) - else - raise EAbZipNoExtraction.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoInsertHelper(Index : Integer; OutStream : TStream); -begin - if Assigned(FInsertHelper) then - FInsertHelper(Self, ItemList[Index], OutStream) - else - raise EAbZipNoInsertion.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoInsertFromStreamHelper(Index : Integer; - OutStream : TStream); -begin - if Assigned(FInsertFromStreamHelper) then - FInsertFromStreamHelper(Self, ItemList[Index], OutStream, InStream) - else - raise EAbZipNoInsertion.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoRequestDisk(const AMessage: string; var Abort : Boolean); -begin -{$IFDEF MSWINDOWS} - Abort := Windows.MessageBox( 0, PChar(AMessage), PChar(AbDiskRequestS), - MB_TASKMODAL or MB_OKCANCEL ) = IDCANCEL; -{$ENDIF} -{$IFDEF UnixDialogs} - {$IFDEF KYLIX} - Abort := QDialogs.MessageDlg(AbDiskRequestS, AMessage, mtWarning, - mbOKCancel, 0) = mrCancel; - {$ENDIF} - {$IFDEF LCL} - Abort := Dialogs.MessageDlg(AbDiskRequestS, AMessage, mtWarning, mbOKCancel, - 0) = mrCancel; - {$ENDIF} -{$ELSE} - Abort := True; -{$ENDIF} -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoRequestLastDisk( var Abort : Boolean ); -begin - Abort := False; - if Assigned( FOnRequestLastDisk ) then - FOnRequestLastDisk( Self, Abort ) - else - DoRequestDisk( AbLastDiskRequestS, Abort ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoRequestNthDisk( Sender: TObject; - DiskNumber : Byte; - var Abort : Boolean ); -begin - Abort := False; - if Assigned( FOnRequestNthDisk ) then - FOnRequestNthDisk( Self, DiskNumber, Abort ) - else - DoRequestDisk( Format(AbDiskNumRequestS, [DiskNumber]), Abort ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoRequestBlankDisk(Sender: TObject; var Abort : Boolean ); -begin - Abort := False; - FSpanned := True; - - if Assigned( FOnRequestBlankDisk ) then - FOnRequestBlankDisk( Self, Abort ) - else - DoRequestDisk( AbBlankDiskS, Abort ); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.DoRequestImage(Sender: TObject; ImageNumber : Integer; - var ImageName : string ; var Abort : Boolean); -begin - if Assigned(FOnRequestImage) then - FOnRequestImage(Self, ImageNumber, ImageName, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.ExtractItemAt(Index : Integer; const UseName : string); -begin - DoExtractHelper(Index, UseName); -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.ExtractItemToStreamAt(Index : Integer; - aStream : TStream); -begin - DoExtractToStreamHelper(Index, aStream); -end; -{ -------------------------------------------------------------------------- } -function TAbZipArchive.FixName(const Value : string ) : string; - {-changes backslashes to forward slashes} -var - i : SmallInt; - lValue : string; -begin - lValue := Value; - {$IFDEF MSWINDOWS} - if DOSMode then begin - {Add the base directory to the filename before converting } - {the file spec to the short filespec format. } - if BaseDirectory <> '' then begin - {Does the filename contain a drive or a leading backslash? } - if not ((Pos(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then - {If not, add the BaseDirectory to the filename.} - lValue := AbAddBackSlash(BaseDirectory) + lValue; - end; - lValue := AbGetShortFileSpec( lValue ); - end; - {$ENDIF MSWINDOWS} - - {Zip files Always strip the drive path} - StoreOptions := StoreOptions + [soStripDrive]; - - {strip drive stuff} - if soStripDrive in StoreOptions then - AbStripDrive( lValue ); - - {check for a leading backslash} - if (Length(lValue) > 1) and (lValue[1] = AbPathDelim) then - System.Delete( lValue, 1, 1 ); - - if soStripPath in StoreOptions then begin - lValue := ExtractFileName( lValue ); - end; - - if soRemoveDots in StoreOptions then - AbStripDots( lValue ); - - for i := 1 to Length( lValue ) do - if lValue[i] = '\' then - lValue[i] := '/'; - Result := lValue; -end; -{ -------------------------------------------------------------------------- } -function TAbZipArchive.GetItem( Index : Integer ) : TAbZipItem; -begin - Result := TAbZipItem(FItemList.Items[Index]); -end; -{ -------------------------------------------------------------------------- } -function TAbZipArchive.GetSupportsEmptyFolders: Boolean; -begin - Result := True; -end; -{ -------------------------------------------------------------------------- } -function TAbZipArchive.GetZipfileComment : AnsiString; -begin - Result := FInfo.ZipfileComment; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.LoadArchive; -var - Abort : Boolean; - TailPosition : int64; - Item : TAbZipItem; - Progress : Byte; - FileSignature : Longint; - Zip64Locator : TAbZip64EndOfCentralDirectoryLocator; -begin - Abort := False; - if FStream.Size = 0 then - Exit; - - {Get signature info} - FStream.Position := 0; - FStream.Read( FileSignature, sizeof( FileSignature ) ); - - {Get Executable Type; allow non-native stubs} - IsExecutable := - (LongRec(FileSignature).Lo = Ab_WindowsExeSignature) or - (FileSignature = Ab_LinuxExeSignature); - - { try to locate central directory tail } - TailPosition := FindCentralDirectoryTail( FStream ); - if (TailPosition = -1) and (FileSignature = Ab_ZipSpannedSetSignature) and - FOwnsStream and AbDriveIsRemovable(ArchiveName) then begin - while TailPosition = -1 do begin - FreeAndNil(FStream); - DoRequestLastDisk(Abort); - if Abort then begin - FStatus := asInvalid; //TODO: Status updates are extremely inconsistent - raise EAbUserAbort.Create; - end; - FStream := TFileStream.Create( ArchiveName, Mode ); - TailPosition := FindCentralDirectoryTail( FStream ); - end; - end; - - if TailPosition = -1 then begin - FStatus := asInvalid; - raise EAbZipInvalid.Create; - end; - - { load the ZipDirectoryFileFooter } - FInfo.LoadFromStream(FStream); - - { find Zip64 end of central directory locator; it will usually occur - immediately before the standard end of central directory record. - the actual Zip64 end of central directory may be on another disk } - if FInfo.IsZip64 then begin - Dec(TailPosition, SizeOf(Zip64Locator)); - repeat - if TailPosition < 0 then - raise EAbZipInvalid.Create; - FStream.Position := TailPosition; - FStream.ReadBuffer(Zip64Locator, SizeOf(Zip64Locator)); - Dec(TailPosition); - until Zip64Locator.Signature = Ab_Zip64EndCentralDirectoryLocatorSignature; - { update current image number } - FInfo.DiskNumber := Zip64Locator.TotalDisks - 1; - end; - - { setup spanning support and move to the start of the central directory } - FSpanned := FInfo.DiskNumber > 0; - - if FSpanned then begin - if FOwnsStream then begin - FStream := TAbSpanReadStream.Create( ArchiveName, FInfo.DiskNumber, FStream ); - TAbSpanReadStream(FStream).OnRequestImage := DoRequestImage; - TAbSpanReadStream(FStream).OnRequestNthDisk := DoRequestNthDisk; - if FInfo.IsZip64 then begin - TAbSpanReadStream(FStream).SeekImage(Zip64Locator.StartDiskNumber, - Zip64Locator.RelativeOffset); - FInfo.LoadZip64FromStream(FStream); - end; - TAbSpanReadStream(FStream).SeekImage(FInfo.StartDiskNumber, FInfo.DirectoryOffset); - end - else - raise EAbZipBadSpanStream.Create; - end - else begin - if FInfo.IsZip64 then begin - FStream.Position := Zip64Locator.RelativeOffset; - FInfo.LoadZip64FromStream(FStream); - end; - FStream.Position := FInfo.DirectoryOffset; - end; - - { build Items list from central directory records } - FStubSize := High(LongWord); - while Count < FInfo.TotalEntries do begin - { create new Item } - Item := TAbZipItem.Create; - try - Item.LoadFromStream(FStream); - Item.Action := aaNone; - FItemList.Add(Item); - except - Item.Free; - raise; - end; - - if IsExecutable and (Item.DiskNumberStart = 0) and - (Item.RelativeOffset < FStubSize) then - FStubSize := Item.RelativeOffset; - - Progress := (Count * 100) div FInfo.TotalEntries; - DoArchiveProgress( Progress, Abort ); - if Abort then begin - FStatus := asInvalid; - raise EAbUserAbort.Create; - end; - end; - - DoArchiveProgress(100, Abort); - FIsDirty := False; -end; - -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.PutItem( Index : Integer; Value : TAbZipItem ); -begin - FItemList.Items[Index] := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.SaveArchive; - {builds a new archive and copies it to FStream} -var - Abort : Boolean; - MemStream : TMemoryStream; - HasDataDescriptor : Boolean; - i : LongWord; - LFH : TAbZipLocalFileHeader; - NewStream : TStream; - WorkingStream : TAbVirtualMemoryStream; - CurrItem : TAbZipItem; - Progress : Byte; -begin - if Count = 0 then - Exit; - - {shouldn't be trying to overwrite an existing spanned archive} - if Spanned then begin - for i := 0 to Pred(Count) do - if ItemList[i].Action <> aaFailed then - ItemList[i].Action := aaNone; - FIsDirty := False; - raise EAbZipSpanOverwrite.Create; - end; - - {init new zip archive stream - can span only new archives, if SpanningThreshold > 0 or removable drive - spanning writes to original location, rather than writing to a temp stream first} - if FOwnsStream and (FStream.Size = 0) and not IsExecutable and - ((SpanningThreshold > 0) or AbDriveIsRemovable(ArchiveName)) then begin - NewStream := TAbSpanWriteStream.Create(ArchiveName, FStream, SpanningThreshold); - FStream := nil; - TAbSpanWriteStream(NewStream).OnRequestBlankDisk := DoRequestBlankDisk; - TAbSpanWriteStream(NewStream).OnRequestImage := DoRequestImage; - end - else begin - NewStream := TAbVirtualMemoryStream.Create; - TAbVirtualMemoryStream(NewStream).SwapFileDirectory := FTempDir; - end; - - try {NewStream} - {copy the executable stub over to the output} - if IsExecutable then - NewStream.CopyFrom( FStream, StubSize ) - {assume spanned for spanning stream} - else if NewStream is TAbSpanWriteStream then - NewStream.Write(Ab_ZipSpannedSetSignature, - SizeOf(Ab_ZipSpannedSetSignature)); - - {build new zip archive from existing archive} - for i := 0 to pred( Count ) do begin - CurrItem := (ItemList[i] as TAbZipItem); - FCurrentItem := ItemList[i]; - - case CurrItem.Action of - aaNone, aaMove: begin - {just copy the file to new stream} - Assert(not (NewStream is TAbSpanWriteStream)); - FStream.Position := CurrItem.RelativeOffset; - CurrItem.DiskNumberStart := 0; - CurrItem.RelativeOffset := NewStream.Position; - {toss old local file header} - LFH := TAbZipLocalFileHeader.Create; - try {LFH} - LFH.LoadFromStream( FStream ); - if CurrItem.LFHExtraField.Count = 0 then - CurrItem.LFHExtraField.Assign(LFH.ExtraField); - finally {LFH} - LFH.Free; - end; {LFH} - {write out new local file header and append compressed data} - - CurrItem.SaveLFHToStream( NewStream ); - if (CurrItem.CompressedSize > 0) then - NewStream.CopyFrom(FStream, CurrItem.CompressedSize); - end; - - aaDelete: begin - {doing nothing omits file from new stream} - end; - - aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin - {compress the file and add it to new stream} - try - WorkingStream := TAbVirtualMemoryStream.Create; - try {WorkingStream} - WorkingStream.SwapFileDirectory := FTempDir; - {compress the file} - if (CurrItem.Action = aaStreamAdd) then - DoInsertFromStreamHelper(i, WorkingStream) - else - DoInsertHelper(i, WorkingStream); - {write local header} - if NewStream is TAbSpanWriteStream then begin - MemStream := TMemoryStream.Create; - try - CurrItem.SaveLFHToStream(MemStream); - TAbSpanWriteStream(NewStream).WriteUnspanned( - MemStream.Memory^, MemStream.Size); - {calculate positions after the write in case it triggered a new span} - CurrItem.DiskNumberStart := TAbSpanWriteStream(NewStream).CurrentImage; - CurrItem.RelativeOffset := NewStream.Position - MemStream.Size; - finally - MemStream.Free; - end; - end - else begin - CurrItem.DiskNumberStart := 0; - CurrItem.RelativeOffset := NewStream.Position; - CurrItem.SaveLFHToStream(NewStream); - end; - {copy compressed data} - NewStream.CopyFrom(WorkingStream, 0); - if CurrItem.IsEncrypted then - CurrItem.SaveDDToStream(NewStream); - finally - WorkingStream.Free; - end; - except - on E : Exception do - begin - { Exception was caused by a User Abort and Item Failure should not be called - Question: Do we want an New Event when this occurs or should the - exception just be re-raised [783614] } - if (E is EAbUserAbort) then - raise; - CurrItem.Action := aaDelete; - DoProcessItemFailure(CurrItem, ptAdd, ecFileOpenError, 0); - end; - end; - end; - end; { case } - - { TODO: Check HasDataDescriptior behavior; seems like it's getting - written twice for encrypted files } - {Now add the data descriptor record to new stream} - HasDataDescriptor := (CurrItem.CompressionMethod = cmDeflated) and - ((CurrItem.GeneralPurposeBitFlag and AbHasDataDescriptorFlag) <> 0); - if (CurrItem.Action <> aaDelete) and HasDataDescriptor then - CurrItem.SaveDDToStream(NewStream); - Progress := AbPercentage(9 * succ( i ), 10 * Count); - DoArchiveSaveProgress(Progress, Abort); - DoArchiveProgress(Progress, Abort); - if Abort then - raise EAbUserAbort.Create; - end; - - {write the central directory} - if NewStream is TAbSpanWriteStream then - FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage - else - FInfo.DiskNumber := 0; - FInfo.StartDiskNumber := FInfo.DiskNumber; - FInfo.DirectoryOffset := NewStream.Position; - FInfo.DirectorySize := 0; - FInfo.EntriesOnDisk := 0; - FInfo.TotalEntries := 0; - MemStream := TMemoryStream.Create; - try - {write central directory entries} - for i := 0 to Count - 1 do begin - if not (FItemList[i].Action in [aaDelete, aaFailed]) then begin - (FItemList[i] as TAbZipItem).SaveCDHToStream(MemStream); - if NewStream is TAbSpanWriteStream then begin - TAbSpanWriteStream(NewStream).WriteUnspanned(MemStream.Memory^, MemStream.Size); - {update tail info on span change} - if FInfo.DiskNumber <> TAbSpanWriteStream(NewStream).CurrentImage then begin - FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage; - FInfo.EntriesOnDisk := 0; - if FInfo.TotalEntries = 0 then begin - FInfo.StartDiskNumber := FInfo.DiskNumber; - FInfo.DirectoryOffset := NewStream.Position - MemStream.Size; - end; - end; - end - else - NewStream.WriteBuffer(MemStream.Memory^, MemStream.Size); - FInfo.DirectorySize := FInfo.DirectorySize + MemStream.Size; - FInfo.EntriesOnDisk := FInfo.EntriesOnDisk + 1; - FInfo.TotalEntries := FInfo.TotalEntries + 1; - MemStream.Clear; - end; - end; - {append the central directory footer} - FInfo.SaveToStream(MemStream, NewStream.Position); - if NewStream is TAbSpanWriteStream then begin - {update the footer if writing it would trigger a new span} - if not TAbSpanWriteStream(NewStream).WriteUnspanned(MemStream.Memory^, - MemStream.Size) then begin - FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage; - FInfo.EntriesOnDisk := 0; - FInfo.SaveToStream(NewStream); - end; - end - else - NewStream.WriteBuffer(MemStream.Memory^, MemStream.Size); - finally {MemStream} - MemStream.Free; - end; {MemStream} - - FSpanned := (FInfo.DiskNumber > 0); - - {update output stream} - if NewStream is TAbSpanWriteStream then begin - {zip has already been written to target location} - FStream := TAbSpanWriteStream(NewStream).ReleaseStream; - if Spanned then begin - {switch to read stream} - FStream := TAbSpanReadStream.Create(ArchiveName, FInfo.DiskNumber, FStream); - TAbSpanReadStream(FStream).OnRequestImage := DoRequestImage; - TAbSpanReadStream(FStream).OnRequestNthDisk := DoRequestNthDisk; - end - else begin - {replace spanned signature} - FStream.Position := 0; - FStream.Write(Ab_ZipPossiblySpannedSignature, - SizeOf(Ab_ZipPossiblySpannedSignature)); - end; - end - else begin - {copy new stream to FStream (non-spanned only)} - NewStream.Position := 0; - if (FStream is TMemoryStream) then - TMemoryStream(FStream).LoadFromStream(NewStream) - else begin - if FOwnsStream then begin - {need new stream to write} - FreeAndNil(FStream); - FStream := TFileStream.Create(FArchiveName, - fmOpenReadWrite or fmShareDenyWrite); - end; - FStream.Size := 0; - FStream.Position := 0; - FStream.CopyFrom(NewStream, 0) - end; - end; - - {update Items list} - for i := pred( Count ) downto 0 do begin - if FItemList[i].Action = aaDelete then - FItemList.Delete( i ) - else if FItemList[i].Action <> aaFailed then - FItemList[i].Action := aaNone; - end; - - DoArchiveSaveProgress( 100, Abort ); - DoArchiveProgress( 100, Abort ); - finally {NewStream} - NewStream.Free; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.SetZipfileComment(const Value : AnsiString ); -begin - FInfo.FZipfileComment := Value; - FIsDirty := True; -end; -{ -------------------------------------------------------------------------- } -procedure TAbZipArchive.TestItemAt(Index : Integer); -begin - DoTestHelper(Index); -end; - -end. - - - - diff --git a/components/Abbrevia/source/AbZipper.pas b/components/Abbrevia/source/AbZipper.pas deleted file mode 100644 index 4bb0b62..0000000 --- a/components/Abbrevia/source/AbZipper.pas +++ /dev/null @@ -1,575 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -{*********************************************************} -{* ABBREVIA: AbZipper.pas *} -{*********************************************************} -{* ABBREVIA: Non-visual Component with Zip support *} -{*********************************************************} - -unit AbZipper; - -{$I AbDefine.inc} - -interface - -uses - Classes, - AbBrowse, AbZBrows, AbArcTyp, AbZipTyp; - -type - TAbCustomZipper = class(TAbCustomZipBrowser) - protected {private} - FAutoSave : Boolean; - FCompressionMethodToUse : TAbZipSupportedMethod; - FDeflationOption : TAbZipDeflationOption; - FDOSMode : Boolean; - FOnConfirmSave : TAbArchiveConfirmEvent; - FOnSave : TAbArchiveEvent; - FOnArchiveSaveProgress : TAbArchiveProgressEvent; - FArchiveSaveProgressMeter : IAbProgressMeter; - - FStoreOptions : TAbStoreOptions; - - protected {methods} - procedure DoConfirmSave(Sender : TObject; var Confirm : Boolean); - virtual; - procedure DoSave(Sender : TObject); - virtual; - procedure DoArchiveSaveProgress(Sender : TObject; Progress : Byte; - var Abort : Boolean); - - procedure InitArchive; - override; - procedure SetAutoSave(Value : Boolean); - procedure SetCompressionMethodToUse(Value : TAbZipSupportedMethod); - procedure SetDeflationOption(Value : TAbZipDeflationOption); - procedure SetDOSMode( Value : Boolean ); - procedure SetFileName(const aFileName : string); - override; - procedure SetStoreOptions( Value : TAbStoreOptions ); - procedure SetArchiveSaveProgressMeter(const Value: IAbProgressMeter); - procedure SetZipfileComment(const Value : AnsiString); - override; - procedure ZipProc(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream); - procedure ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem; - OutStream, InStream : TStream ); - procedure Notification(Component: TComponent; - Operation: TOperation); override; - procedure ResetMeters; override; - - protected {properties} - property AutoSave : Boolean - read FAutoSave - write SetAutoSave; - property CompressionMethodToUse : TAbZipSupportedMethod - read FCompressionMethodToUse - write SetCompressionMethodToUse - default AbDefCompressionMethodToUse; - property DeflationOption : TAbZipDeflationOption - read FDeflationOption - write SetDeflationOption - default AbDefDeflationOption; - property DOSMode : Boolean - read FDOSMode - write SetDOSMode; - property StoreOptions : TAbStoreOptions - read FStoreOptions - write SetStoreOptions - default AbDefStoreOptions; - property ArchiveSaveProgressMeter : IAbProgressMeter - read FArchiveSaveProgressMeter - write SetArchiveSaveProgressMeter; - - - protected {events} - property OnConfirmSave : TAbArchiveConfirmEvent - read FOnConfirmSave - write FOnConfirmSave; - property OnSave : TAbArchiveEvent - read FOnSave - write FOnSave; - property OnArchiveSaveProgress : TAbArchiveProgressEvent - read FOnArchiveSaveProgress - write FOnArchiveSaveProgress; - - public {methods} - constructor Create(AOwner : TComponent); - override; - destructor Destroy; - override; - procedure AddFiles(const FileMask : string; SearchAttr : Integer); - procedure AddFilesEx(const FileMask, ExclusionMask : string; SearchAttr : Integer); - procedure AddFromStream(const NewName : string; FromStream : TStream); - procedure DeleteAt(Index : Integer); - procedure DeleteFiles(const FileMask : string); - procedure DeleteFilesEx(const FileMask, ExclusionMask : string); - procedure DeleteTaggedItems; - procedure FreshenFiles(const FileMask : string); - procedure FreshenFilesEx(const FileMask, ExclusionMask : string); - procedure FreshenTaggedItems; - procedure Move(aItem : TAbArchiveItem; const NewStoredPath : string); - procedure Save; - procedure Replace(aItem : TAbArchiveItem); - end; - -type - TAbZipper = class(TAbCustomZipper) - published - property ArchiveProgressMeter; - property ArchiveSaveProgressMeter; - property ItemProgressMeter; - property AutoSave; - property BaseDirectory; - property CompressionMethodToUse; - property DeflationOption; - property DOSMode; - property SpanningThreshold; - property LogFile; - property Logging; - property OnArchiveProgress; - property OnArchiveSaveProgress; - property OnArchiveItemProgress; - property OnChange; - property OnConfirmProcessItem; - property OnConfirmSave; - property OnLoad; - property OnProcessItemFailure; - property OnRequestBlankDisk; - property OnRequestImage; - property OnRequestLastDisk; - property OnRequestNthDisk; - property OnSave; - property Password; - property StoreOptions; - property TempDirectory; - property Version; - property FileName; {must be after OnLoad} - end; - -implementation - -uses - SysUtils, AbUtils, AbTarTyp, AbGzTyp, AbBzip2Typ, AbExcept, AbZipPrc; - -{ -------------------------------------------------------------------------- } -constructor TAbCustomZipper.Create( AOwner : TComponent ); -begin - inherited Create( AOwner ); - CompressionMethodToUse := AbDefCompressionMethodToUse; - DeflationOption := AbDefDeflationOption; - StoreOptions := AbDefStoreOptions; -end; -{ -------------------------------------------------------------------------- } -destructor TAbCustomZipper.Destroy; -begin - inherited Destroy; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.AddFiles(const FileMask : string; SearchAttr : Integer); - {Add files to the archive where the disk filespec matches} -begin - if (FArchive <> nil) then - FArchive.AddFiles(FileMask, SearchAttr) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.AddFilesEx(const FileMask, ExclusionMask : string; - SearchAttr : Integer); - {Add files that match Filemask except those matching ExclusionMask} -begin - if (FArchive <> nil) then - FArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.AddFromStream(const NewName : string; - FromStream : TStream); - {Add stream directly to archive} -begin - if (FArchive <> nil) then begin - FromStream.Position := 0; - FArchive.AddFromStream(NewName, FromStream); - end else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.DeleteFiles(const FileMask : string); - {delete all files from the archive that match the file mask} -begin - if (FArchive <> nil) then - FArchive.DeleteFiles( FileMask ) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.DeleteAt(Index : Integer); - {delete item at Index} -begin - if (FArchive <> nil) then - FArchive.DeleteAt( Index ) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.DeleteFilesEx(const FileMask, ExclusionMask : string); - {Delete files that match Filemask except those matching ExclusionMask} -begin - if (FArchive <> nil) then - FArchive.DeleteFilesEx(FileMask, ExclusionMask) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.DeleteTaggedItems; - {delete all tagged items from the archive} -begin - if (FArchive <> nil) then - FArchive.DeleteTaggedItems - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.DoConfirmSave(Sender : TObject; var Confirm : Boolean); -begin - Confirm := True; - if Assigned(FOnConfirmSave) then - FOnConfirmSave(Self, Confirm); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.DoSave(Sender : TObject); -begin - if Assigned(FOnSave) then - FOnSave(Self); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.FreshenFiles(const FileMask : string); - {freshen all items that match the file mask} -begin - if (FArchive <> nil) then - FArchive.FreshenFiles( FileMask ) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.FreshenFilesEx(const FileMask, ExclusionMask : string); - {freshen all items matching FileMask except those matching ExclusionMask} -begin - if (FArchive <> nil) then - FArchive.FreshenFilesEx( FileMask, ExclusionMask ) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.FreshenTaggedItems; - {freshen all tagged items} -begin - if (FArchive <> nil) then - FArchive.FreshenTaggedItems - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.InitArchive; -begin - inherited InitArchive; - if FArchive <> nil then begin - {properties} - FArchive.AutoSave := FAutoSave; - FArchive.DOSMode := FDOSMode; - FArchive.StoreOptions := FStoreOptions; - {events} - FArchive.OnArchiveSaveProgress := DoArchiveSaveProgress; - FArchive.OnConfirmSave := DoConfirmSave; - FArchive.OnSave := DoSave; - end; - if (FArchive is TAbZipArchive) then begin - {properties} - TAbZipArchive(FArchive).CompressionMethodToUse := FCompressionMethodToUse; - TAbZipArchive(FArchive).DeflationOption := FDeflationOption; - {events} - TAbZipArchive(FArchive).OnRequestBlankDisk := OnRequestBlankDisk; - TAbZipArchive(FArchive).InsertHelper := ZipProc; - TAbZipArchive(FArchive).InsertFromStreamHelper := ZipFromStreamProc; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.Move(aItem : TAbArchiveItem; const NewStoredPath : string); - {renames the item} -begin - if (FArchive <> nil) then - FArchive.Move(aItem, NewStoredPath) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.Replace(aItem : TAbArchiveItem); - {replace the item} -begin - if (FArchive <> nil) then - FArchive.Replace( aItem ) - else - raise EAbNoArchive.Create; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.Save; -begin - if (FArchive <> nil) then begin - FArchive.Save; - DoChange; - end; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetAutoSave(Value : Boolean); -begin - FAutoSave := Value; - if (FArchive <> nil) then - FArchive.AutoSave := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetCompressionMethodToUse( - Value : TAbZipSupportedMethod); -begin - FCompressionMethodToUse := Value; - if (FArchive is TAbZipArchive) then - TAbZipArchive(FArchive).CompressionMethodToUse := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetDeflationOption(Value : TAbZipDeflationOption); -begin - FDeflationOption := Value; - if (FArchive is TAbZipArchive) then - TAbZipArchive(FArchive).DeflationOption := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetDOSMode(Value : Boolean); -begin - FDOSMode := Value; - if (FArchive <> nil) then - FArchive.DOSMode := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetFileName(const aFileName : string); -var - ArcType : TAbArchiveType; -begin - FFileName := aFileName; - if (csDesigning in ComponentState) then - Exit; - - if Assigned(FArchive) then - begin - FArchive.Save; - FreeAndNil(FArchive); - end; - - ArcType := ArchiveType; - - if (FileName <> '') then - if FileExists(FileName) then begin { open it } - - if not ForceType then - ArcType := AbDetermineArcType(FileName, atUnknown); - - case ArcType of - atZip, atSpannedZip, atSelfExtZip : begin - FArchive := TAbZipArchive.Create(FileName, fmOpenRead or fmShareDenyNone); - InitArchive; - end; - - atTar : begin - FArchive := TAbTarArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone); - inherited InitArchive; - end; - - atGZip : begin - FArchive := TAbGzipArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone); - TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbGzipArchive(FArchive).IsGzippedTar := False; - inherited InitArchive; - end; - - atGZippedTar : begin - FArchive := TAbGzipArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone); - TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbGzipArchive(FArchive).IsGzippedTar := True; - inherited InitArchive; - end; - - atBzip2 : begin - FArchive := TAbBzip2Archive.Create(FileName, fmOpenReadWrite or fmShareDenyNone); - TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbBzip2Archive(FArchive).IsBzippedTar := False; - inherited InitArchive; - end; - - atBzippedTar : begin - FArchive := TAbBzip2Archive.Create(FileName, fmOpenReadWrite or fmShareDenyNone); - TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbBzip2Archive(FArchive).IsBzippedTar := True; - inherited InitArchive; - end; - - else - raise EAbUnhandledType.Create; - end {case}; - FArchive.Load; - FArchiveType := ArcType; - - end else begin { file doesn't exist, so create a new one } - if not ForceType then - ArcType := AbDetermineArcType(FileName, atUnknown); - - case ArcType of - atZip : begin - FArchive := TAbZipArchive.Create(FileName, fmCreate); - InitArchive; - end; - - atTar : begin - FArchive := TAbTarArchive.Create(FileName, fmCreate or fmShareDenyNone); - inherited InitArchive; - end; - - atGZip : begin - FArchive := TAbGzipArchive.Create(FileName, fmCreate or fmShareDenyNone); - TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbGzipArchive(FArchive).IsGzippedTar := False; - inherited InitArchive; - end; - - atGZippedTar : begin - FArchive := TAbGzipArchive.Create(FileName, fmCreate or fmShareDenyNone); - TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbGzipArchive(FArchive).IsGzippedTar := True; - inherited InitArchive; - end; - - atBzip2 : begin - FArchive := TAbBzip2Archive.Create(FileName, fmCreate or fmShareDenyNone); - TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbBzip2Archive(FArchive).IsBzippedTar := False; - inherited InitArchive; - end; - - atBzippedTar : begin - FArchive := TAbBzip2Archive.Create(FileName, fmCreate or fmShareDenyNone); - TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle; - TAbBzip2Archive(FArchive).IsBzippedTar := True; - inherited InitArchive; - end; - - else - raise EAbUnhandledType.Create; - end {case}; - - FArchiveType := ArcType; - end; - DoChange; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetStoreOptions(Value : TAbStoreOptions); -begin - FStoreOptions := Value; - if (FArchive <> nil) then - FArchive.StoreOptions := Value; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetArchiveSaveProgressMeter(const Value: IAbProgressMeter); -begin - ReferenceInterface(FArchiveSaveProgressMeter, opRemove); - FArchiveSaveProgressMeter := Value; - ReferenceInterface(FArchiveSaveProgressMeter, opInsert); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.SetZipfileComment(const Value : AnsiString); -begin - if (FArchive is TAbZipArchive) then - TAbZipArchive(FArchive).ZipfileComment := Value - else - raise EAbNoArchive.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.ZipProc(Sender : TObject; Item : TAbArchiveItem; - OutStream : TStream); -begin - AbZip(TAbZipArchive(Sender), TAbZipItem(Item), OutStream); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem; - OutStream, InStream : TStream); -begin - if Assigned(InStream) then - AbZipFromStream(TAbZipArchive(Sender), TAbZipItem(Item), - OutStream, InStream) - else - raise EAbZipNoInsertion.Create; -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.DoArchiveSaveProgress(Sender : TObject; - Progress : Byte; - var Abort : Boolean); -begin - Abort := False; - if Assigned(FArchiveSaveProgressMeter) then - FArchiveSaveProgressMeter.DoProgress(Progress); - if Assigned(FOnArchiveSaveProgress) then - FOnArchiveSaveProgress(Self, Progress, Abort); -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.Notification(Component: TComponent; - Operation: TOperation); -begin - inherited Notification(Component, Operation); - if (Operation = opRemove) then - if Assigned(ArchiveSaveProgressMeter) and Component.IsImplementorOf(ArchiveSaveProgressMeter) then - ArchiveSaveProgressMeter := nil -end; -{ -------------------------------------------------------------------------- } -procedure TAbCustomZipper.ResetMeters; -begin - inherited ResetMeters; - if Assigned(FArchiveSaveProgressMeter) then - FArchiveSaveProgressMeter.Reset; -end; -{ -------------------------------------------------------------------------- } - -end. - diff --git a/components/Abbrevia/source/COM/Abbrevia.dpr b/components/Abbrevia/source/COM/Abbrevia.dpr deleted file mode 100644 index 266b64c..0000000 --- a/components/Abbrevia/source/COM/Abbrevia.dpr +++ /dev/null @@ -1,48 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -library Abbrevia; - -uses - ComServ, - _ZipKit in '_ZipKit.pas', - _ZipItem in '_ZipItem.pas', - _GZipItem in '_GZipItem.pas', - _TarItem in '_TarItem.pas', - Abbrevia_TLB in 'Abbrevia_TLB.pas'; - -exports - DllGetClassObject, - DllCanUnloadNow, - DllRegisterServer, - DllUnregisterServer, - DllInstall; - -{$R *.TLB} - -{$R *.RES} - -begin -end. diff --git a/components/Abbrevia/source/COM/Abbrevia.dproj b/components/Abbrevia/source/COM/Abbrevia.dproj deleted file mode 100644 index 3322ecf..0000000 --- a/components/Abbrevia/source/COM/Abbrevia.dproj +++ /dev/null @@ -1,183 +0,0 @@ - - - {EDA07E3C-7B07-4B14-9B53-64A70EF3F00A} - Abbrevia.dpr - True - Release - 3 - Library - None - 13.4 - Win32 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform) - ..\;$(DCC_UnitSearchPath) - None - true - 5 - 1033 - false - CompanyName=;FileDescription=Abbrevia COM components;FileVersion=5.0.0.0;InternalName=;LegalCopyright=Copyright (c) Abbrevia Group 2011;LegalTrademarks=;OriginalFilename=;ProductName=Abbrevia;ProductVersion=5.0;Comments= - System;Xml;Data;Datasnap;Web;Soap;System.Win;Winapi;Vcl;$(DCC_Namespace) - 00400000 - false - true - false - false - false - - - Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - Abbrevia_Icon.ico - - - /i:user /n Abbrevia.dll - C:\Windows\System32\regsvr32.exe - Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - - - false - false - 0 - RELEASE;$(DCC_Define) - - - CompanyName=;FileDescription=Abbrevia COM components;FileVersion=5.0;InternalName=;LegalCopyright=Copyright (c) 2011 Abbrevia Group;LegalTrademarks=;OriginalFilename=Abbrevia.dll;ProductName=Abbrevia;ProductVersion=5.0;Comments=http://tpabbrevia.sourceforge.net/ - - - CompanyName=;FileDescription=Abbrevia COM components;FileVersion=5.0;InternalName=;LegalCopyright=Copyright (c) 2011 Abbrevia Group;LegalTrademarks=;OriginalFilename=Abbrevia.dll;ProductName=Abbrevia;ProductVersion=5.0;Comments=http://tpabbrevia.sourceforge.net/ - - - DEBUG;$(DCC_Define) - false - true - - - true - - - true - CompanyName=;FileDescription=;FileVersion=5.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - - - - MainSource - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - - - - - Abbrevia.dpr - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1033 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - True - False - True - - - 1 - - - 12 - - - - diff --git a/components/Abbrevia/source/COM/Abbrevia.res b/components/Abbrevia/source/COM/Abbrevia.res deleted file mode 100644 index 6850cf0..0000000 Binary files a/components/Abbrevia/source/COM/Abbrevia.res and /dev/null differ diff --git a/components/Abbrevia/source/COM/Abbrevia.ridl b/components/Abbrevia/source/COM/Abbrevia.ridl deleted file mode 100644 index 73d332c..0000000 --- a/components/Abbrevia/source/COM/Abbrevia.ridl +++ /dev/null @@ -1,671 +0,0 @@ -// ************************************************************************ // -// WARNING -// ------- -// This file is generated by the Type Library importer or Type Libary Editor. -// Barring syntax errors, the Editor will parse modifications made to the file. -// However, when applying changes via the Editor this file will be regenerated -// and comments or formatting changes will be lost. -// ************************************************************************ // -// File generated on 12/6/2011 11:22:23 AM (- $Rev: 12980 $, 51698824). - -[ - uuid(AF804E20-4043-499E-BB14-237B9F26F89F), - version(3.0), - helpstring("TurboPower Abbrevia Compression Library v3.03"), - helpfile("C:\\Abbrevia\\COM\\abrv-com.hlp"), - helpcontext(0x00000001) - -] -library Abbrevia -{ - - importlib("stdole2.tlb"); - - interface IZipItem; - interface IGZipItem; - interface ITarItem; - interface IZipKit; - dispinterface IZipKitEvents; - coclass ZipItem; - coclass GZipItem; - coclass TarItem; - coclass ZipKit; - - - [ - uuid(6CABD61B-653C-4CEB-807C-C80E8DE8163D), - version(3.0) - ] - enum TArchiveAction - { - aaFailed = 0, - aaNone = 1, - aaAdd = 2, - aaDelete = 3, - aaFreshen = 4, - aaMove = 5, - aaStreamAdd = 6 - }; - - [ - uuid(148F84A1-2B70-4A63-B561-FF0EE49E74B3), - version(3.0) - ] - enum TArchiveStatus - { - asInvalid = 0, - asIdle = 1, - asBusy = 2 - }; - - [ - uuid(5D495174-DB09-4C59-A26D-FEBDE3EAE100), - version(3.0) - ] - enum TErrorClass - { - eclAbbrevia = 0, - eclInOutError = 1, - eclFileError = 2, - eclFileCreateError = 3, - eclFileOpenError = 4, - eclOther = 5 - }; - - [ - uuid(6A4738B9-69F1-4717-8393-681FF21E8DB7), - version(3.0) - ] - enum TFileAttributes - { - faReadOnly = 1, - faHidden = 2, - faSysFile = 4, - faVolumeID = 8, - faDirectory = 16, - faArchive = 32 - }; - - [ - uuid(F77BBE04-0859-4F18-9DEA-B2887C1F6AF7), - version(3.0) - ] - enum TProcessType - { - ptAdd = 0, - ptDelete = 1, - ptExtract = 2, - ptFreshen = 3, - ptMove = 4, - ptReplace = 5 - }; - - [ - uuid(D78287A7-65FA-4391-8F5A-C7D3A11E9970), - version(3.0) - ] - enum TStoreOptions - { - soStripDrive = 1, - soStripPath = 2, - soRemoveDots = 4, - soRecurse = 8, - soFreshen = 16, - soReplace = 32 - }; - - [ - uuid(192C6697-A38D-4F48-B32B-F33500460E62), - version(3.0) - ] - enum TZipCompressionMethod - { - cmStored = 0, - cmShrunk = 1, - cmReduced1 = 2, - cmReduced2 = 3, - cmReduced3 = 4, - cmReduced4 = 5, - cmImploded = 6, - cmTokenized = 7, - cmDeflated = 8, - cmEnhancedDeflated = 9, - cmDCLImploded = 10, - cmBestMethod = 11 - }; - - [ - uuid(800F8CDC-2F0F-4020-BCBB-FEDA82D0EFEF), - version(3.0) - ] - enum TZipDeflateOption - { - doInvalid = 0, - doNormal = 1, - doMaximum = 2, - doFast = 3, - doSuperFast = 4 - }; - - [ - uuid(D697ED2A-F088-409F-962A-57D8324EEDD6), - version(3.0) - ] - enum TZipDictionarySize - { - dsInvalid = 0, - ds4K = 1, - ds8K = 2 - }; - - [ - uuid(B9889806-26F9-47E7-AC1F-906AA161B078), - version(3.0) - ] - enum TZipExtractOptions - { - eoCreateDirs = 0, - eoRestorePath = 1 - }; - - [ - uuid(D40E0708-AE71-4A44-A6C8-430EDF760DE2), - version(3.0) - ] - enum TZipSupportMethod - { - smStored = 0, - smDeflated = 1, - smBestMethod = 2 - }; - - [ - uuid(EFD2C909-BF04-4C54-9ACB-38D872B95C9F), - version(3.0) - ] - enum TErrorCode - { - ecDuplicateName = 0, - ecInvalidPassword = 1, - ecNoSuchDirectory = 2, - ecUnknownCompressionMethod = 3, - ecUserAbort = 4, - ecZipBadCRC = 5, - ecZipVersionNumber = 6, - ecSpannedItemNotFound = 7 - }; - - [ - uuid(44EB05F9-CED9-46D0-84E2-BD3362977437), - version(3.0) - ] - enum TArchiveType - { - atUnknown = 0, - atZip = 1, - atSelfExtZip = 2, - atTar = 3, - atGZip = 4, - atGZippedTar = 5, - atCab = 6 - }; - - [ - uuid(36568A72-3B4B-41C4-8E34-19931A8EAF63), - version(3.0) - ] - enum TFileSystem - { - fsFAT = 0, - fsAmiga = 1, - fsVMS = 2, - fsUnix = 3, - fsVM_CMS = 4, - fsAtariTOS = 5, - fsHPFS = 6, - fsMacintosh = 7, - fsZSystem = 8, - fsCP_M = 9, - fsTOPS20 = 10, - fsNTFS = 11, - fsQDOS = 12, - fsAcornRISCOS = 13, - fsUnknown = 14, - fsUndefined = 15 - }; - - [ - uuid(851699A1-422A-4C65-8E08-D0499ACDD834), - version(3.0), - helpstring("Dispatch interface for ZipItem Object"), - helpcontext(0x00000005), - dual, - oleautomation - ] - interface IZipItem: IDispatch - { - [propget, id(0x00000001)] - HRESULT _stdcall Action([out, retval] enum TArchiveAction* Value); - [propget, id(0x00000002)] - HRESULT _stdcall CompressedSize([out, retval] long* Value); - [propget, id(0x00000003)] - HRESULT _stdcall CRC32([out, retval] long* Value); - [propget, id(0x00000004)] - HRESULT _stdcall DiskFileName([out, retval] BSTR* Value); - [propget, id(0x00000005)] - HRESULT _stdcall DiskPath([out, retval] BSTR* Value); - [propget, id(0x00000006)] - HRESULT _stdcall ExternalFileAttributes([out, retval] enum TFileAttributes* Value); - [propput, id(0x00000006)] - HRESULT _stdcall ExternalFileAttributes([in] enum TFileAttributes Value); - [propget, id(0x00000007)] - HRESULT _stdcall FileName([out, retval] BSTR* Value); - [propput, id(0x00000007)] - HRESULT _stdcall FileName([in] BSTR Value); - [propget, id(0x00000008)] - HRESULT _stdcall IsEncrypted([out, retval] VARIANT_BOOL* Value); - [propget, id(0x00000009)] - HRESULT _stdcall LastModFileDateTime([out, retval] DATE* Value); - [propget, id(0x0000000A)] - HRESULT _stdcall StoredPath([out, retval] BSTR* Value); - [propget, id(0x0000000B)] - HRESULT _stdcall Tagged([out, retval] VARIANT_BOOL* Value); - [propput, id(0x0000000B)] - HRESULT _stdcall Tagged([in] VARIANT_BOOL Value); - [propget, id(0x0000000C)] - HRESULT _stdcall UnCompressedSize([out, retval] long* Value); - [propget, id(0x0000000D)] - HRESULT _stdcall CRC32St([out, retval] BSTR* Value); - [propget, id(0x0000000E)] - HRESULT _stdcall Password([out, retval] BSTR* Value); - [propput, id(0x0000000E)] - HRESULT _stdcall Password([in] BSTR Value); - [propget, id(0x0000000F)] - HRESULT _stdcall CompressionMethod([out, retval] enum TZipCompressionMethod* Value); - [propget, id(0x00000010)] - HRESULT _stdcall CompressionRatio([out, retval] double* Value); - [propget, id(0x00000011)] - HRESULT _stdcall DeflateOption([out, retval] enum TZipDeflateOption* Value); - [propget, id(0x00000012)] - HRESULT _stdcall DictionarySize([out, retval] enum TZipDictionarySize* Value); - [propget, id(0x00000013)] - HRESULT _stdcall DiskNumberStart([out, retval] long* Value); - [propget, id(0x00000014)] - HRESULT _stdcall ExtraField([out, retval] BSTR* Value); - [propput, id(0x00000014)] - HRESULT _stdcall ExtraField([in] BSTR Value); - [propget, id(0x00000015)] - HRESULT _stdcall FileComment([out, retval] BSTR* Value); - [propput, id(0x00000015)] - HRESULT _stdcall FileComment([in] BSTR Value); - [propget, id(0x00000016)] - HRESULT _stdcall InternalFileAttributes([out, retval] long* Value); - [propput, id(0x00000016)] - HRESULT _stdcall InternalFileAttributes([in] long Value); - [propget, id(0x00000017)] - HRESULT _stdcall VersionMadeBy([out, retval] long* Value); - [propget, id(0x00000018)] - HRESULT _stdcall VersionNeededToExtract([out, retval] long* Value); - }; - - [ - uuid(8FA78CE0-FD29-441E-9777-93B63EF1A9EE), - version(3.0), - dual, - oleautomation - ] - interface IGZipItem: IDispatch - { - [propget, id(0x00000001)] - HRESULT _stdcall Action([out, retval] enum TArchiveAction* Value); - [propget, id(0x00000002)] - HRESULT _stdcall CompressedSize([out, retval] long* Value); - [propget, id(0x00000003)] - HRESULT _stdcall CRC32([out, retval] long* Value); - [propget, id(0x00000004)] - HRESULT _stdcall DiskFileName([out, retval] BSTR* Value); - [propget, id(0x00000005)] - HRESULT _stdcall DiskPath([out, retval] BSTR* Value); - [propget, id(0x00000006)] - HRESULT _stdcall ExternalFileAttributes([out, retval] enum TFileAttributes* Value); - [propput, id(0x00000006)] - HRESULT _stdcall ExternalFileAttributes([in] enum TFileAttributes Value); - [propget, id(0x00000007)] - HRESULT _stdcall FileName([out, retval] BSTR* Value); - [propput, id(0x00000007)] - HRESULT _stdcall FileName([in] BSTR Value); - [propget, id(0x00000008)] - HRESULT _stdcall IsEncrypted([out, retval] VARIANT_BOOL* Value); - [propget, id(0x00000009)] - HRESULT _stdcall LastModFileDateTime([out, retval] DATE* Value); - [propget, id(0x0000000A)] - HRESULT _stdcall StoredPath([out, retval] BSTR* Value); - [propget, id(0x0000000B)] - HRESULT _stdcall Tagged([out, retval] VARIANT_BOOL* Value); - [propput, id(0x0000000B)] - HRESULT _stdcall Tagged([in] VARIANT_BOOL Value); - [propget, id(0x0000000C)] - HRESULT _stdcall UnCompressedSize([out, retval] long* Value); - [propget, id(0x0000000D)] - HRESULT _stdcall CRC32St([out, retval] BSTR* Value); - [propget, id(0x0000000E)] - HRESULT _stdcall Password([out, retval] BSTR* Value); - [propput, id(0x0000000E)] - HRESULT _stdcall Password([in] BSTR Value); - [propget, id(0x0000000F)] - HRESULT _stdcall CompressionMethod([out, retval] unsigned char* Value); - [propput, id(0x0000000F)] - HRESULT _stdcall CompressionMethod([in] unsigned char Value); - [propget, id(0x00000010)] - HRESULT _stdcall ExtraField([out, retval] BSTR* Value); - [propput, id(0x00000010)] - HRESULT _stdcall ExtraField([in] BSTR Value); - [propget, id(0x00000011)] - HRESULT _stdcall ExtraFlags([out, retval] unsigned char* Value); - [propput, id(0x00000011)] - HRESULT _stdcall ExtraFlags([in] unsigned char Value); - [propget, id(0x00000012)] - HRESULT _stdcall FileComment([out, retval] BSTR* Value); - [propput, id(0x00000012)] - HRESULT _stdcall FileComment([in] BSTR Value); - [propget, id(0x00000013)] - HRESULT _stdcall FileSystem([out, retval] enum TFileSystem* Value); - [propput, id(0x00000013)] - HRESULT _stdcall FileSystem([in] enum TFileSystem Value); - [propget, id(0x00000014)] - HRESULT _stdcall Flags([out, retval] unsigned char* Value); - [propput, id(0x00000014)] - HRESULT _stdcall Flags([in] unsigned char Value); - [propget, id(0x00000015)] - HRESULT _stdcall HeaderCRC([out, retval] long* Value); - }; - - [ - uuid(729E9F52-C489-4A41-A770-4E2C5282AE39), - version(3.0), - dual, - oleautomation - ] - interface ITarItem: IDispatch - { - [propget, id(0x00000001)] - HRESULT _stdcall Action([out, retval] enum TArchiveAction* Value); - [propget, id(0x00000002)] - HRESULT _stdcall CompressedSize([out, retval] long* Value); - [propget, id(0x00000003)] - HRESULT _stdcall CRC32([out, retval] long* Value); - [propget, id(0x00000004)] - HRESULT _stdcall DiskFileName([out, retval] BSTR* Value); - [propget, id(0x00000005)] - HRESULT _stdcall DiskPath([out, retval] BSTR* Value); - [propget, id(0x00000006)] - HRESULT _stdcall ExternalFileAttributes([out, retval] enum TFileAttributes* Value); - [propput, id(0x00000006)] - HRESULT _stdcall ExternalFileAttributes([in] enum TFileAttributes Value); - [propget, id(0x00000007)] - HRESULT _stdcall FileName([out, retval] BSTR* Value); - [propput, id(0x00000007)] - HRESULT _stdcall FileName([in] BSTR Value); - [propget, id(0x00000008)] - HRESULT _stdcall IsEncrypted([out, retval] VARIANT_BOOL* Value); - [propget, id(0x00000009)] - HRESULT _stdcall LastModFileDateTime([out, retval] DATE* Value); - [propget, id(0x0000000A)] - HRESULT _stdcall StoredPath([out, retval] BSTR* Value); - [propget, id(0x0000000B)] - HRESULT _stdcall Tagged([out, retval] VARIANT_BOOL* Value); - [propput, id(0x0000000B)] - HRESULT _stdcall Tagged([in] VARIANT_BOOL Value); - [propget, id(0x0000000C)] - HRESULT _stdcall UnCompressedSize([out, retval] long* Value); - [propget, id(0x0000000D)] - HRESULT _stdcall CRC32St([out, retval] BSTR* Value); - [propget, id(0x0000000E)] - HRESULT _stdcall Password([out, retval] BSTR* Value); - [propput, id(0x0000000E)] - HRESULT _stdcall Password([in] BSTR Value); - [propget, id(0x0000000F)] - HRESULT _stdcall DevMajor([out, retval] long* Value); - [propput, id(0x0000000F)] - HRESULT _stdcall DevMajor([in] long Value); - [propget, id(0x00000010)] - HRESULT _stdcall DevMinor([out, retval] long* Value); - [propput, id(0x00000010)] - HRESULT _stdcall DevMinor([in] long Value); - [propget, id(0x00000011)] - HRESULT _stdcall GroupID([out, retval] long* Value); - [propput, id(0x00000011)] - HRESULT _stdcall GroupID([in] long Value); - [propget, id(0x00000012)] - HRESULT _stdcall GroupName([out, retval] BSTR* Value); - [propput, id(0x00000012)] - HRESULT _stdcall GroupName([in] BSTR Value); - [propget, id(0x00000013)] - HRESULT _stdcall LinkFlag([out, retval] unsigned char* Value); - [propput, id(0x00000013)] - HRESULT _stdcall LinkFlag([in] unsigned char Value); - [propget, id(0x00000014)] - HRESULT _stdcall LinkName([out, retval] BSTR* Value); - [propput, id(0x00000014)] - HRESULT _stdcall LinkName([in] BSTR Value); - [propget, id(0x00000015)] - HRESULT _stdcall Mode([out, retval] long* Value); - [propput, id(0x00000015)] - HRESULT _stdcall Mode([in] long Value); - [propget, id(0x00000016)] - HRESULT _stdcall UserID([out, retval] long* Value); - [propput, id(0x00000016)] - HRESULT _stdcall UserID([in] long Value); - [propget, id(0x00000017)] - HRESULT _stdcall UserName([out, retval] BSTR* Value); - [propput, id(0x00000017)] - HRESULT _stdcall UserName([in] BSTR Value); - }; - - [ - uuid(B7480A7F-4E27-4B45-9FE6-224B60295A0C), - version(3.0), - helpstring("Dispatch interface for ZipKit Object"), - helpcontext(0x00000006), - dual, - oleautomation - ] - interface IZipKit: IDispatch - { - [id(0x00000001)] - HRESULT _stdcall Add([in] BSTR FileMask, [in] BSTR ExclusionMask, [in] long SearchAttr); - [id(0x00000007)] - HRESULT _stdcall AddFromStream([in] BSTR FileName, [in] VARIANT Stream); - [propget, id(0x00000003)] - HRESULT _stdcall AutoSave([out, retval] VARIANT_BOOL* Value); - [propput, id(0x00000003)] - HRESULT _stdcall AutoSave([in] VARIANT_BOOL Value); - [propget, id(0x00000004)] - HRESULT _stdcall BaseDirectory([out, retval] BSTR* Value); - [propput, id(0x00000004)] - HRESULT _stdcall BaseDirectory([in] BSTR Value); - [id(0x00000005)] - HRESULT _stdcall ClearTags(void); - [propget, id(0x00000006)] - HRESULT _stdcall CompressionMethodToUse([out, retval] enum TZipSupportMethod* Value); - [propput, id(0x00000006)] - HRESULT _stdcall CompressionMethodToUse([in] enum TZipSupportMethod Value); - [propget, id(0x00000002)] - HRESULT _stdcall Count([out, retval] long* Value); - [propget, id(0x00000008)] - HRESULT _stdcall DeflateOption([out, retval] enum TZipDeflateOption* Value); - [propput, id(0x00000008)] - HRESULT _stdcall DeflateOption([in] enum TZipDeflateOption Value); - [id(0x00000009)] - HRESULT _stdcall Delete([in] BSTR FileMask, [in] BSTR ExclusionMask); - [id(0x0000000A)] - HRESULT _stdcall DeleteAt([in] long Index); - [id(0x0000000B)] - HRESULT _stdcall DeleteTaggedItems(void); - [propget, id(0x0000000C)] - HRESULT _stdcall DOSMode([out, retval] VARIANT_BOOL* Value); - [propput, id(0x0000000C)] - HRESULT _stdcall DOSMode([in] VARIANT_BOOL Value); - [id(0x0000000D)] - HRESULT _stdcall Extract([in] BSTR FileMask, [in] BSTR ExclusionMask); - [id(0x0000000E)] - HRESULT _stdcall ExtractAt([in] long Index, [in] BSTR NewName); - [propget, id(0x0000000F)] - HRESULT _stdcall ExtractOptions([out, retval] enum TZipExtractOptions* Value); - [propput, id(0x0000000F)] - HRESULT _stdcall ExtractOptions([in] enum TZipExtractOptions Value); - [id(0x00000010)] - HRESULT _stdcall ExtractTaggedItems(void); - [propget, id(0x00000011)] - HRESULT _stdcall FileName([out, retval] BSTR* Value); - [propput, id(0x00000011)] - HRESULT _stdcall FileName([in] BSTR Value); - [id(0x00000012)] - HRESULT _stdcall Find([in] BSTR FileName, [out, retval] long* Value); - [id(0x00000013)] - HRESULT _stdcall Freshen([in] BSTR FileMask, [in] BSTR ExclusionMask); - [id(0x00000014)] - HRESULT _stdcall FreshenTaggedItems(void); - [propget, id(0x00000000)] - HRESULT _stdcall Item([in] long Index, [out, retval] IDispatch** Value); - [propget, id(0x00000017)] - HRESULT _stdcall LogFile([out, retval] BSTR* Value); - [propput, id(0x00000017)] - HRESULT _stdcall LogFile([in] BSTR Value); - [propget, id(0x00000018)] - HRESULT _stdcall Logging([out, retval] VARIANT_BOOL* Value); - [propput, id(0x00000018)] - HRESULT _stdcall Logging([in] VARIANT_BOOL Value); - [propget, id(0x00000019)] - HRESULT _stdcall Password([out, retval] BSTR* Value); - [propput, id(0x00000019)] - HRESULT _stdcall Password([in] BSTR Value); - [propget, id(0x0000001A)] - HRESULT _stdcall PasswordRetries([out, retval] unsigned char* Value); - [propput, id(0x0000001A)] - HRESULT _stdcall PasswordRetries([in] unsigned char Value); - [id(0x0000001B)] - HRESULT _stdcall Replace([in] BSTR FileMask); - [id(0x0000001C)] - HRESULT _stdcall Save(void); - [propget, id(0x0000001D)] - HRESULT _stdcall Spanned([out, retval] VARIANT_BOOL* Value); - [propget, id(0x0000001E)] - HRESULT _stdcall SpanningThreshold([out, retval] long* Value); - [propput, id(0x0000001E)] - HRESULT _stdcall SpanningThreshold([in] long Value); - [propget, id(0x0000001F)] - HRESULT _stdcall Status([out, retval] enum TArchiveStatus* Value); - [propget, id(0x00000020)] - HRESULT _stdcall StoreOptions([out, retval] enum TStoreOptions* Value); - [propput, id(0x00000020)] - HRESULT _stdcall StoreOptions([in] enum TStoreOptions Value); - [id(0x00000021)] - HRESULT _stdcall TagItems([in] BSTR FileMask); - [propget, id(0x00000022)] - HRESULT _stdcall TempDirectory([out, retval] BSTR* Value); - [propput, id(0x00000022)] - HRESULT _stdcall TempDirectory([in] BSTR Value); - [id(0x00000023)] - HRESULT _stdcall TestTaggedItems(void); - [id(0x00000024)] - HRESULT _stdcall UntagItems([in] BSTR FileMask); - [propget, id(0x00000025)] - HRESULT _stdcall ZipFileComment([out, retval] BSTR* Value); - [propput, id(0x00000025)] - HRESULT _stdcall ZipFileComment([in] BSTR Value); - [id(0x00000026)] - HRESULT _stdcall License([in] BSTR Key, [out, retval] VARIANT_BOOL* Value); - [propget, id(0xFFFFFFFC), restricted, hidden] - HRESULT _stdcall _NewEnum([out, retval] IUnknown** Value); - [id(0x00000015)] - HRESULT _stdcall ExtractToStream([in] BSTR FileName, [out, retval] VARIANT* Value); - [propget, id(0x00000028)] - HRESULT _stdcall CompressionType([out, retval] enum TArchiveType* Value); - [propput, id(0x00000028)] - HRESULT _stdcall CompressionType([in] enum TArchiveType Value); - [propget, id(0x00000029)] - HRESULT _stdcall TarAutoHandle([out, retval] VARIANT_BOOL* Value); - [propput, id(0x00000029)] - HRESULT _stdcall TarAutoHandle([in] VARIANT_BOOL Value); - }; - - [ - uuid(F094D5F4-3A52-45AE-9D86-4409611DD29E), - version(3.0), - helpstring("Events interface for ZipKit Object") - ] - dispinterface IZipKitEvents - { - properties: - methods: - [id(0x00000001)] - void OnArchiveItemProgress([in] IDispatch* Item, [in] unsigned char Progress, [in, out] VARIANT_BOOL* Abort); - [id(0x00000002)] - void OnArchiveProgress([in] unsigned char Progress, [in, out] VARIANT_BOOL* Abort); - [id(0x00000003)] - void OnChange(void); - [id(0x00000004)] - void OnConfirmOverwrite([in, out] BSTR* Name, [in, out] VARIANT_BOOL* Confirm); - [id(0x00000005)] - void OnConfirmProcessItem([in] IDispatch* Item, [in] enum TProcessType ProcessType, [in, out] VARIANT_BOOL* Confirm); - [id(0x00000006)] - void OnConfirmSave([in, out] VARIANT_BOOL* Confirm); - [id(0x00000007)] - void OnLoad(void); - [id(0x00000008)] - void OnNeedPassword([in, out] BSTR* NewPassword); - [id(0x00000009)] - void OnProcessItemFailure([in] IDispatch* Item, [in] enum TProcessType ProcessType, [in] enum TErrorClass ErrorClass, [in] enum TErrorCode ErrorCode, [in] BSTR ErrorString); - [id(0x0000000A)] - void OnRequestBlankDisk([in, out] VARIANT_BOOL* Abort); - [id(0x0000000B)] - void OnRequestImage([in] long ImageNumber, [in, out] BSTR* ImageName, [in, out] VARIANT_BOOL* Abort); - [id(0x0000000C)] - void OnRequestLastDisk([in, out] VARIANT_BOOL* Abort); - [id(0x0000000D)] - void OnRequestNthDisk([in] long DiskNumber, [in, out] VARIANT_BOOL* Abort); - [id(0x0000000E)] - void OnSave(void); - }; - - [ - uuid(650989D8-F0FF-4C71-83C3-92556F4329F5), - version(3.0) - ] - coclass ZipItem - { - [default] interface IZipItem; - }; - - [ - uuid(2B35BB50-D9C7-4669-B18E-943B5199FD8E), - version(3.0) - ] - coclass GZipItem - { - [default] interface IGZipItem; - }; - - [ - uuid(2DF3E624-0E6C-42CF-8041-676B9A06375E), - version(3.0) - ] - coclass TarItem - { - [default] interface ITarItem; - }; - - [ - uuid(730B4B32-9127-492A-BF02-196A7E6B4E1B), - version(3.0), - helpstring("ZipKit Object"), - helpcontext(0x00000006) - ] - coclass ZipKit - { - [default] interface IZipKit; - [default, source] dispinterface IZipKitEvents; - }; - -}; diff --git a/components/Abbrevia/source/COM/Abbrevia.tlb b/components/Abbrevia/source/COM/Abbrevia.tlb deleted file mode 100644 index 323cae4..0000000 Binary files a/components/Abbrevia/source/COM/Abbrevia.tlb and /dev/null differ diff --git a/components/Abbrevia/source/COM/Abbrevia_TLB.pas b/components/Abbrevia/source/COM/Abbrevia_TLB.pas deleted file mode 100644 index 87606de..0000000 --- a/components/Abbrevia/source/COM/Abbrevia_TLB.pas +++ /dev/null @@ -1,817 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -unit Abbrevia_TLB; - -// ************************************************************************ // -// WARNING -// ------- -// The types declared in this file were generated from data read from a -// Type Library. If this type library is explicitly or indirectly (via -// another type library referring to this type library) re-imported, or the -// 'Refresh' command of the Type Library Editor activated while editing the -// Type Library, the contents of this file will be regenerated and all -// manual modifications will be lost. -// ************************************************************************ // - -// $Rev: 491 $ -// File generated on 7/23/2009 9:45:45 PM from Type Library described below. - -// ************************************************************************ // -// Type Lib: C:\Abbrevia\COM\abbrevia.dll -// LIBID: {AF804E20-4043-499E-BB14-237B9F26F89F} -// LCID: 0 -// Helpfile: C:\Abbrevia\COM\abrv-com.hlp -// HelpString: TurboPower Abbrevia Compression Library v3.03 -// DepndLst: -// (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb) -// ************************************************************************ // -{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. -{$WARN SYMBOL_PLATFORM OFF} -{$WRITEABLECONST ON} -{$VARPROPSETTER ON} -interface - -uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants; - - -// *********************************************************************// -// GUIDS declared in the TypeLibrary. Following prefixes are used: -// Type Libraries : LIBID_xxxx -// CoClasses : CLASS_xxxx -// DISPInterfaces : DIID_xxxx -// Non-DISP interfaces: IID_xxxx -// *********************************************************************// -const - // TypeLibrary Major and minor versions - AbbreviaMajorVersion = 5; - AbbreviaMinorVersion = 0; - - LIBID_Abbrevia: TGUID = '{AF804E20-4043-499E-BB14-237B9F26F89F}'; - - IID_IZipItem: TGUID = '{851699A1-422A-4C65-8E08-D0499ACDD834}'; - IID_IGZipItem: TGUID = '{8FA78CE0-FD29-441E-9777-93B63EF1A9EE}'; - IID_ITarItem: TGUID = '{729E9F52-C489-4A41-A770-4E2C5282AE39}'; - IID_IZipKit: TGUID = '{B7480A7F-4E27-4B45-9FE6-224B60295A0C}'; - DIID_IZipKitEvents: TGUID = '{F094D5F4-3A52-45AE-9D86-4409611DD29E}'; - CLASS_ZipItem: TGUID = '{650989D8-F0FF-4C71-83C3-92556F4329F5}'; - CLASS_GZipItem: TGUID = '{2B35BB50-D9C7-4669-B18E-943B5199FD8E}'; - CLASS_TarItem: TGUID = '{2DF3E624-0E6C-42CF-8041-676B9A06375E}'; - CLASS_ZipKit: TGUID = '{730B4B32-9127-492A-BF02-196A7E6B4E1B}'; - -// *********************************************************************// -// Declaration of Enumerations defined in Type Library -// *********************************************************************// -// Constants for enum TArchiveAction -type - TArchiveAction = TOleEnum; -const - aaFailed = $00000000; - aaNone = $00000001; - aaAdd = $00000002; - aaDelete = $00000003; - aaFreshen = $00000004; - aaMove = $00000005; - aaStreamAdd = $00000006; - -// Constants for enum TArchiveStatus -type - TArchiveStatus = TOleEnum; -const - asInvalid = $00000000; - asIdle = $00000001; - asBusy = $00000002; - -// Constants for enum TErrorClass -type - TErrorClass = TOleEnum; -const - eclAbbrevia = $00000000; - eclInOutError = $00000001; - eclFileError = $00000002; - eclFileCreateError = $00000003; - eclFileOpenError = $00000004; - eclOther = $00000005; - -// Constants for enum TFileAttributes -type - TFileAttributes = TOleEnum; -const - faReadOnly = $00000001; - faHidden = $00000002; - faSysFile = $00000004; - faVolumeID = $00000008; - faDirectory = $00000010; - faArchive = $00000020; - -// Constants for enum TProcessType -type - TProcessType = TOleEnum; -const - ptAdd = $00000000; - ptDelete = $00000001; - ptExtract = $00000002; - ptFreshen = $00000003; - ptMove = $00000004; - ptReplace = $00000005; - -// Constants for enum TStoreOptions -type - TStoreOptions = TOleEnum; -const - soStripDrive = $00000001; - soStripPath = $00000002; - soRemoveDots = $00000004; - soRecurse = $00000008; - soFreshen = $00000010; - soReplace = $00000020; - -// Constants for enum TZipCompressionMethod -type - TZipCompressionMethod = TOleEnum; -const - cmStored = $00000000; - cmShrunk = $00000001; - cmReduced1 = $00000002; - cmReduced2 = $00000003; - cmReduced3 = $00000004; - cmReduced4 = $00000005; - cmImploded = $00000006; - cmTokenized = $00000007; - cmDeflated = $00000008; - cmEnhancedDeflated = $00000009; - cmDCLImploded = $0000000A; - cmBestMethod = $0000000B; - -// Constants for enum TZipDeflateOption -type - TZipDeflateOption = TOleEnum; -const - doInvalid = $00000000; - doNormal = $00000001; - doMaximum = $00000002; - doFast = $00000003; - doSuperFast = $00000004; - -// Constants for enum TZipDictionarySize -type - TZipDictionarySize = TOleEnum; -const - dsInvalid = $00000000; - ds4K = $00000001; - ds8K = $00000002; - -// Constants for enum TZipExtractOptions -type - TZipExtractOptions = TOleEnum; -const - eoCreateDirs = $00000000; - eoRestorePath = $00000001; - -// Constants for enum TZipSupportMethod -type - TZipSupportMethod = TOleEnum; -const - smStored = $00000000; - smDeflated = $00000001; - smBestMethod = $00000002; - -// Constants for enum TErrorCode -type - TErrorCode = TOleEnum; -const - ecDuplicateName = $00000000; - ecInvalidPassword = $00000001; - ecNoSuchDirectory = $00000002; - ecUnknownCompressionMethod = $00000003; - ecUserAbort = $00000004; - ecZipBadCRC = $00000005; - ecZipVersionNumber = $00000006; - ecSpannedItemNotFound = $00000007; - -// Constants for enum TArchiveType -type - TArchiveType = TOleEnum; -const - atUnknown = $00000000; - atZip = $00000001; - atSelfExtZip = $00000002; - atTar = $00000003; - atGZip = $00000004; - atGZippedTar = $00000005; - atCab = $00000006; - -// Constants for enum TFileSystem -type - TFileSystem = TOleEnum; -const - fsFAT = $00000000; - fsAmiga = $00000001; - fsVMS = $00000002; - fsUnix = $00000003; - fsVM_CMS = $00000004; - fsAtariTOS = $00000005; - fsHPFS = $00000006; - fsMacintosh = $00000007; - fsZSystem = $00000008; - fsCP_M = $00000009; - fsTOPS20 = $0000000A; - fsNTFS = $0000000B; - fsQDOS = $0000000C; - fsAcornRISCOS = $0000000D; - fsUnknown = $0000000E; - fsUndefined = $0000000F; - -type - -// *********************************************************************// -// Forward declaration of types defined in TypeLibrary -// *********************************************************************// - IZipItem = interface; - IZipItemDisp = dispinterface; - IGZipItem = interface; - IGZipItemDisp = dispinterface; - ITarItem = interface; - ITarItemDisp = dispinterface; - IZipKit = interface; - IZipKitDisp = dispinterface; - IZipKitEvents = dispinterface; - -// *********************************************************************// -// Declaration of CoClasses defined in Type Library -// (NOTE: Here we map each CoClass to its Default Interface) -// *********************************************************************// - ZipItem = IZipItem; - GZipItem = IGZipItem; - TarItem = ITarItem; - ZipKit = IZipKit; - - -// *********************************************************************// -// Interface: IZipItem -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {851699A1-422A-4C65-8E08-D0499ACDD834} -// *********************************************************************// - IZipItem = interface(IDispatch) - ['{851699A1-422A-4C65-8E08-D0499ACDD834}'] - function Get_Action: TArchiveAction; safecall; - function Get_CompressedSize: Integer; safecall; - function Get_CRC32: Integer; safecall; - function Get_DiskFileName: WideString; safecall; - function Get_DiskPath: WideString; safecall; - function Get_ExternalFileAttributes: TFileAttributes; safecall; - procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Get_IsEncrypted: WordBool; safecall; - function Get_LastModFileDateTime: TDateTime; safecall; - function Get_StoredPath: WideString; safecall; - function Get_Tagged: WordBool; safecall; - procedure Set_Tagged(Value: WordBool); safecall; - function Get_UnCompressedSize: Integer; safecall; - function Get_CRC32St: WideString; safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - function Get_CompressionMethod: TZipCompressionMethod; safecall; - function Get_CompressionRatio: Double; safecall; - function Get_DeflateOption: TZipDeflateOption; safecall; - function Get_DictionarySize: TZipDictionarySize; safecall; - function Get_DiskNumberStart: Integer; safecall; - function Get_ExtraField: WideString; safecall; - procedure Set_ExtraField(const Value: WideString); safecall; - function Get_FileComment: WideString; safecall; - procedure Set_FileComment(const Value: WideString); safecall; - function Get_InternalFileAttributes: Integer; safecall; - procedure Set_InternalFileAttributes(Value: Integer); safecall; - function Get_VersionMadeBy: Integer; safecall; - function Get_VersionNeededToExtract: Integer; safecall; - property Action: TArchiveAction read Get_Action; - property CompressedSize: Integer read Get_CompressedSize; - property CRC32: Integer read Get_CRC32; - property DiskFileName: WideString read Get_DiskFileName; - property DiskPath: WideString read Get_DiskPath; - property ExternalFileAttributes: TFileAttributes read Get_ExternalFileAttributes write Set_ExternalFileAttributes; - property FileName: WideString read Get_FileName write Set_FileName; - property IsEncrypted: WordBool read Get_IsEncrypted; - property LastModFileDateTime: TDateTime read Get_LastModFileDateTime; - property StoredPath: WideString read Get_StoredPath; - property Tagged: WordBool read Get_Tagged write Set_Tagged; - property UnCompressedSize: Integer read Get_UnCompressedSize; - property CRC32St: WideString read Get_CRC32St; - property Password: WideString read Get_Password write Set_Password; - property CompressionMethod: TZipCompressionMethod read Get_CompressionMethod; - property CompressionRatio: Double read Get_CompressionRatio; - property DeflateOption: TZipDeflateOption read Get_DeflateOption; - property DictionarySize: TZipDictionarySize read Get_DictionarySize; - property DiskNumberStart: Integer read Get_DiskNumberStart; - property ExtraField: WideString read Get_ExtraField write Set_ExtraField; - property FileComment: WideString read Get_FileComment write Set_FileComment; - property InternalFileAttributes: Integer read Get_InternalFileAttributes write Set_InternalFileAttributes; - property VersionMadeBy: Integer read Get_VersionMadeBy; - property VersionNeededToExtract: Integer read Get_VersionNeededToExtract; - end; - -// *********************************************************************// -// DispIntf: IZipItemDisp -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {851699A1-422A-4C65-8E08-D0499ACDD834} -// *********************************************************************// - IZipItemDisp = dispinterface - ['{851699A1-422A-4C65-8E08-D0499ACDD834}'] - property Action: TArchiveAction readonly dispid 1; - property CompressedSize: Integer readonly dispid 2; - property CRC32: Integer readonly dispid 3; - property DiskFileName: WideString readonly dispid 4; - property DiskPath: WideString readonly dispid 5; - property ExternalFileAttributes: TFileAttributes dispid 6; - property FileName: WideString dispid 7; - property IsEncrypted: WordBool readonly dispid 8; - property LastModFileDateTime: TDateTime readonly dispid 9; - property StoredPath: WideString readonly dispid 10; - property Tagged: WordBool dispid 11; - property UnCompressedSize: Integer readonly dispid 12; - property CRC32St: WideString readonly dispid 13; - property Password: WideString dispid 14; - property CompressionMethod: TZipCompressionMethod readonly dispid 15; - property CompressionRatio: Double readonly dispid 16; - property DeflateOption: TZipDeflateOption readonly dispid 17; - property DictionarySize: TZipDictionarySize readonly dispid 18; - property DiskNumberStart: Integer readonly dispid 19; - property ExtraField: WideString dispid 20; - property FileComment: WideString dispid 21; - property InternalFileAttributes: Integer dispid 22; - property VersionMadeBy: Integer readonly dispid 23; - property VersionNeededToExtract: Integer readonly dispid 24; - end; - -// *********************************************************************// -// Interface: IGZipItem -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {8FA78CE0-FD29-441E-9777-93B63EF1A9EE} -// *********************************************************************// - IGZipItem = interface(IDispatch) - ['{8FA78CE0-FD29-441E-9777-93B63EF1A9EE}'] - function Get_Action: TArchiveAction; safecall; - function Get_CompressedSize: Integer; safecall; - function Get_CRC32: Integer; safecall; - function Get_DiskFileName: WideString; safecall; - function Get_DiskPath: WideString; safecall; - function Get_ExternalFileAttributes: TFileAttributes; safecall; - procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Get_IsEncrypted: WordBool; safecall; - function Get_LastModFileDateTime: TDateTime; safecall; - function Get_StoredPath: WideString; safecall; - function Get_Tagged: WordBool; safecall; - procedure Set_Tagged(Value: WordBool); safecall; - function Get_UnCompressedSize: Integer; safecall; - function Get_CRC32St: WideString; safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - function Get_CompressionMethod: Byte; safecall; - procedure Set_CompressionMethod(Value: Byte); safecall; - function Get_ExtraField: WideString; safecall; - procedure Set_ExtraField(const Value: WideString); safecall; - function Get_ExtraFlags: Byte; safecall; - procedure Set_ExtraFlags(Value: Byte); safecall; - function Get_FileComment: WideString; safecall; - procedure Set_FileComment(const Value: WideString); safecall; - function Get_FileSystem: TFileSystem; safecall; - procedure Set_FileSystem(Value: TFileSystem); safecall; - function Get_Flags: Byte; safecall; - procedure Set_Flags(Value: Byte); safecall; - function Get_HeaderCRC: Integer; safecall; - property Action: TArchiveAction read Get_Action; - property CompressedSize: Integer read Get_CompressedSize; - property CRC32: Integer read Get_CRC32; - property DiskFileName: WideString read Get_DiskFileName; - property DiskPath: WideString read Get_DiskPath; - property ExternalFileAttributes: TFileAttributes read Get_ExternalFileAttributes write Set_ExternalFileAttributes; - property FileName: WideString read Get_FileName write Set_FileName; - property IsEncrypted: WordBool read Get_IsEncrypted; - property LastModFileDateTime: TDateTime read Get_LastModFileDateTime; - property StoredPath: WideString read Get_StoredPath; - property Tagged: WordBool read Get_Tagged write Set_Tagged; - property UnCompressedSize: Integer read Get_UnCompressedSize; - property CRC32St: WideString read Get_CRC32St; - property Password: WideString read Get_Password write Set_Password; - property CompressionMethod: Byte read Get_CompressionMethod write Set_CompressionMethod; - property ExtraField: WideString read Get_ExtraField write Set_ExtraField; - property ExtraFlags: Byte read Get_ExtraFlags write Set_ExtraFlags; - property FileComment: WideString read Get_FileComment write Set_FileComment; - property FileSystem: TFileSystem read Get_FileSystem write Set_FileSystem; - property Flags: Byte read Get_Flags write Set_Flags; - property HeaderCRC: Integer read Get_HeaderCRC; - end; - -// *********************************************************************// -// DispIntf: IGZipItemDisp -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {8FA78CE0-FD29-441E-9777-93B63EF1A9EE} -// *********************************************************************// - IGZipItemDisp = dispinterface - ['{8FA78CE0-FD29-441E-9777-93B63EF1A9EE}'] - property Action: TArchiveAction readonly dispid 1; - property CompressedSize: Integer readonly dispid 2; - property CRC32: Integer readonly dispid 3; - property DiskFileName: WideString readonly dispid 4; - property DiskPath: WideString readonly dispid 5; - property ExternalFileAttributes: TFileAttributes dispid 6; - property FileName: WideString dispid 7; - property IsEncrypted: WordBool readonly dispid 8; - property LastModFileDateTime: TDateTime readonly dispid 9; - property StoredPath: WideString readonly dispid 10; - property Tagged: WordBool dispid 11; - property UnCompressedSize: Integer readonly dispid 12; - property CRC32St: WideString readonly dispid 13; - property Password: WideString dispid 14; - property CompressionMethod: Byte dispid 15; - property ExtraField: WideString dispid 16; - property ExtraFlags: Byte dispid 17; - property FileComment: WideString dispid 18; - property FileSystem: TFileSystem dispid 19; - property Flags: Byte dispid 20; - property HeaderCRC: Integer readonly dispid 21; - end; - -// *********************************************************************// -// Interface: ITarItem -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {729E9F52-C489-4A41-A770-4E2C5282AE39} -// *********************************************************************// - ITarItem = interface(IDispatch) - ['{729E9F52-C489-4A41-A770-4E2C5282AE39}'] - function Get_Action: TArchiveAction; safecall; - function Get_CompressedSize: Integer; safecall; - function Get_CRC32: Integer; safecall; - function Get_DiskFileName: WideString; safecall; - function Get_DiskPath: WideString; safecall; - function Get_ExternalFileAttributes: TFileAttributes; safecall; - procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Get_IsEncrypted: WordBool; safecall; - function Get_LastModFileDateTime: TDateTime; safecall; - function Get_StoredPath: WideString; safecall; - function Get_Tagged: WordBool; safecall; - procedure Set_Tagged(Value: WordBool); safecall; - function Get_UnCompressedSize: Integer; safecall; - function Get_CRC32St: WideString; safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - function Get_DevMajor: Integer; safecall; - procedure Set_DevMajor(Value: Integer); safecall; - function Get_DevMinor: Integer; safecall; - procedure Set_DevMinor(Value: Integer); safecall; - function Get_GroupID: Integer; safecall; - procedure Set_GroupID(Value: Integer); safecall; - function Get_GroupName: WideString; safecall; - procedure Set_GroupName(const Value: WideString); safecall; - function Get_LinkFlag: Byte; safecall; - procedure Set_LinkFlag(Value: Byte); safecall; - function Get_LinkName: WideString; safecall; - procedure Set_LinkName(const Value: WideString); safecall; - function Get_Mode: Integer; safecall; - procedure Set_Mode(Value: Integer); safecall; - function Get_UserID: Integer; safecall; - procedure Set_UserID(Value: Integer); safecall; - function Get_UserName: WideString; safecall; - procedure Set_UserName(const Value: WideString); safecall; - property Action: TArchiveAction read Get_Action; - property CompressedSize: Integer read Get_CompressedSize; - property CRC32: Integer read Get_CRC32; - property DiskFileName: WideString read Get_DiskFileName; - property DiskPath: WideString read Get_DiskPath; - property ExternalFileAttributes: TFileAttributes read Get_ExternalFileAttributes write Set_ExternalFileAttributes; - property FileName: WideString read Get_FileName write Set_FileName; - property IsEncrypted: WordBool read Get_IsEncrypted; - property LastModFileDateTime: TDateTime read Get_LastModFileDateTime; - property StoredPath: WideString read Get_StoredPath; - property Tagged: WordBool read Get_Tagged write Set_Tagged; - property UnCompressedSize: Integer read Get_UnCompressedSize; - property CRC32St: WideString read Get_CRC32St; - property Password: WideString read Get_Password write Set_Password; - property DevMajor: Integer read Get_DevMajor write Set_DevMajor; - property DevMinor: Integer read Get_DevMinor write Set_DevMinor; - property GroupID: Integer read Get_GroupID write Set_GroupID; - property GroupName: WideString read Get_GroupName write Set_GroupName; - property LinkFlag: Byte read Get_LinkFlag write Set_LinkFlag; - property LinkName: WideString read Get_LinkName write Set_LinkName; - property Mode: Integer read Get_Mode write Set_Mode; - property UserID: Integer read Get_UserID write Set_UserID; - property UserName: WideString read Get_UserName write Set_UserName; - end; - -// *********************************************************************// -// DispIntf: ITarItemDisp -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {729E9F52-C489-4A41-A770-4E2C5282AE39} -// *********************************************************************// - ITarItemDisp = dispinterface - ['{729E9F52-C489-4A41-A770-4E2C5282AE39}'] - property Action: TArchiveAction readonly dispid 1; - property CompressedSize: Integer readonly dispid 2; - property CRC32: Integer readonly dispid 3; - property DiskFileName: WideString readonly dispid 4; - property DiskPath: WideString readonly dispid 5; - property ExternalFileAttributes: TFileAttributes dispid 6; - property FileName: WideString dispid 7; - property IsEncrypted: WordBool readonly dispid 8; - property LastModFileDateTime: TDateTime readonly dispid 9; - property StoredPath: WideString readonly dispid 10; - property Tagged: WordBool dispid 11; - property UnCompressedSize: Integer readonly dispid 12; - property CRC32St: WideString readonly dispid 13; - property Password: WideString dispid 14; - property DevMajor: Integer dispid 15; - property DevMinor: Integer dispid 16; - property GroupID: Integer dispid 17; - property GroupName: WideString dispid 18; - property LinkFlag: Byte dispid 19; - property LinkName: WideString dispid 20; - property Mode: Integer dispid 21; - property UserID: Integer dispid 22; - property UserName: WideString dispid 23; - end; - -// *********************************************************************// -// Interface: IZipKit -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {B7480A7F-4E27-4B45-9FE6-224B60295A0C} -// *********************************************************************// - IZipKit = interface(IDispatch) - ['{B7480A7F-4E27-4B45-9FE6-224B60295A0C}'] - procedure Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); safecall; - procedure AddFromStream(const FileName: WideString; Stream: OleVariant); safecall; - function Get_AutoSave: WordBool; safecall; - procedure Set_AutoSave(Value: WordBool); safecall; - function Get_BaseDirectory: WideString; safecall; - procedure Set_BaseDirectory(const Value: WideString); safecall; - procedure ClearTags; safecall; - function Get_CompressionMethodToUse: TZipSupportMethod; safecall; - procedure Set_CompressionMethodToUse(Value: TZipSupportMethod); safecall; - function Get_Count: Integer; safecall; - function Get_DeflateOption: TZipDeflateOption; safecall; - procedure Set_DeflateOption(Value: TZipDeflateOption); safecall; - procedure Delete(const FileMask: WideString; const ExclusionMask: WideString); safecall; - procedure DeleteAt(Index: Integer); safecall; - procedure DeleteTaggedItems; safecall; - function Get_DOSMode: WordBool; safecall; - procedure Set_DOSMode(Value: WordBool); safecall; - procedure Extract(const FileMask: WideString; const ExclusionMask: WideString); safecall; - procedure ExtractAt(Index: Integer; const NewName: WideString); safecall; - function Get_ExtractOptions: TZipExtractOptions; safecall; - procedure Set_ExtractOptions(Value: TZipExtractOptions); safecall; - procedure ExtractTaggedItems; safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Find(const FileName: WideString): Integer; safecall; - procedure Freshen(const FileMask: WideString; const ExclusionMask: WideString); safecall; - procedure FreshenTaggedItems; safecall; - function Get_Item(Index: Integer): IDispatch; safecall; - function Get_LogFile: WideString; safecall; - procedure Set_LogFile(const Value: WideString); safecall; - function Get_Logging: WordBool; safecall; - procedure Set_Logging(Value: WordBool); safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - function Get_PasswordRetries: Byte; safecall; - procedure Set_PasswordRetries(Value: Byte); safecall; - procedure Replace(const FileMask: WideString); safecall; - procedure Save; safecall; - function Get_Spanned: WordBool; safecall; - function Get_SpanningThreshold: Integer; safecall; - procedure Set_SpanningThreshold(Value: Integer); safecall; - function Get_Status: TArchiveStatus; safecall; - function Get_StoreOptions: TStoreOptions; safecall; - procedure Set_StoreOptions(Value: TStoreOptions); safecall; - procedure TagItems(const FileMask: WideString); safecall; - function Get_TempDirectory: WideString; safecall; - procedure Set_TempDirectory(const Value: WideString); safecall; - procedure TestTaggedItems; safecall; - procedure UntagItems(const FileMask: WideString); safecall; - function Get_ZipFileComment: WideString; safecall; - procedure Set_ZipFileComment(const Value: WideString); safecall; - function License(const Key: WideString): WordBool; safecall; - function Get__NewEnum: IUnknown; safecall; - function ExtractToStream(const FileName: WideString): OleVariant; safecall; - function Get_CompressionType: TArchiveType; safecall; - procedure Set_CompressionType(Value: TArchiveType); safecall; - function Get_TarAutoHandle: WordBool; safecall; - procedure Set_TarAutoHandle(Value: WordBool); safecall; - property AutoSave: WordBool read Get_AutoSave write Set_AutoSave; - property BaseDirectory: WideString read Get_BaseDirectory write Set_BaseDirectory; - property CompressionMethodToUse: TZipSupportMethod read Get_CompressionMethodToUse write Set_CompressionMethodToUse; - property Count: Integer read Get_Count; - property DeflateOption: TZipDeflateOption read Get_DeflateOption write Set_DeflateOption; - property DOSMode: WordBool read Get_DOSMode write Set_DOSMode; - property ExtractOptions: TZipExtractOptions read Get_ExtractOptions write Set_ExtractOptions; - property FileName: WideString read Get_FileName write Set_FileName; - property Item[Index: Integer]: IDispatch read Get_Item; - property LogFile: WideString read Get_LogFile write Set_LogFile; - property Logging: WordBool read Get_Logging write Set_Logging; - property Password: WideString read Get_Password write Set_Password; - property PasswordRetries: Byte read Get_PasswordRetries write Set_PasswordRetries; - property Spanned: WordBool read Get_Spanned; - property SpanningThreshold: Integer read Get_SpanningThreshold write Set_SpanningThreshold; - property Status: TArchiveStatus read Get_Status; - property StoreOptions: TStoreOptions read Get_StoreOptions write Set_StoreOptions; - property TempDirectory: WideString read Get_TempDirectory write Set_TempDirectory; - property ZipFileComment: WideString read Get_ZipFileComment write Set_ZipFileComment; - property _NewEnum: IUnknown read Get__NewEnum; - property CompressionType: TArchiveType read Get_CompressionType write Set_CompressionType; - property TarAutoHandle: WordBool read Get_TarAutoHandle write Set_TarAutoHandle; - end; - -// *********************************************************************// -// DispIntf: IZipKitDisp -// Flags: (4416) Dual OleAutomation Dispatchable -// GUID: {B7480A7F-4E27-4B45-9FE6-224B60295A0C} -// *********************************************************************// - IZipKitDisp = dispinterface - ['{B7480A7F-4E27-4B45-9FE6-224B60295A0C}'] - procedure Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); dispid 1; - procedure AddFromStream(const FileName: WideString; Stream: OleVariant); dispid 7; - property AutoSave: WordBool dispid 3; - property BaseDirectory: WideString dispid 4; - procedure ClearTags; dispid 5; - property CompressionMethodToUse: TZipSupportMethod dispid 6; - property Count: Integer readonly dispid 2; - property DeflateOption: TZipDeflateOption dispid 8; - procedure Delete(const FileMask: WideString; const ExclusionMask: WideString); dispid 9; - procedure DeleteAt(Index: Integer); dispid 10; - procedure DeleteTaggedItems; dispid 11; - property DOSMode: WordBool dispid 12; - procedure Extract(const FileMask: WideString; const ExclusionMask: WideString); dispid 13; - procedure ExtractAt(Index: Integer; const NewName: WideString); dispid 14; - property ExtractOptions: TZipExtractOptions dispid 15; - procedure ExtractTaggedItems; dispid 16; - property FileName: WideString dispid 17; - function Find(const FileName: WideString): Integer; dispid 18; - procedure Freshen(const FileMask: WideString; const ExclusionMask: WideString); dispid 19; - procedure FreshenTaggedItems; dispid 20; - property Item[Index: Integer]: IDispatch readonly dispid 0; - property LogFile: WideString dispid 23; - property Logging: WordBool dispid 24; - property Password: WideString dispid 25; - property PasswordRetries: Byte dispid 26; - procedure Replace(const FileMask: WideString); dispid 27; - procedure Save; dispid 28; - property Spanned: WordBool readonly dispid 29; - property SpanningThreshold: Integer dispid 30; - property Status: TArchiveStatus readonly dispid 31; - property StoreOptions: TStoreOptions dispid 32; - procedure TagItems(const FileMask: WideString); dispid 33; - property TempDirectory: WideString dispid 34; - procedure TestTaggedItems; dispid 35; - procedure UntagItems(const FileMask: WideString); dispid 36; - property ZipFileComment: WideString dispid 37; - function License(const Key: WideString): WordBool; dispid 38; - property _NewEnum: IUnknown readonly dispid $FFFFFFFC; - function ExtractToStream(const FileName: WideString): OleVariant; dispid 21; - property CompressionType: TArchiveType dispid 40; - property TarAutoHandle: WordBool dispid 41; - end; - -// *********************************************************************// -// DispIntf: IZipKitEvents -// Flags: (4096) Dispatchable -// GUID: {F094D5F4-3A52-45AE-9D86-4409611DD29E} -// *********************************************************************// - IZipKitEvents = dispinterface - ['{F094D5F4-3A52-45AE-9D86-4409611DD29E}'] - procedure OnArchiveItemProgress(const Item: IDispatch; Progress: Byte; var Abort: WordBool); dispid 1; - procedure OnArchiveProgress(Progress: Byte; var Abort: WordBool); dispid 2; - procedure OnChange; dispid 3; - procedure OnConfirmOverwrite(var Name: WideString; var Confirm: WordBool); dispid 4; - procedure OnConfirmProcessItem(const Item: IDispatch; ProcessType: TProcessType; - var Confirm: WordBool); dispid 5; - procedure OnConfirmSave(var Confirm: WordBool); dispid 6; - procedure OnLoad; dispid 7; - procedure OnNeedPassword(var NewPassword: WideString); dispid 8; - procedure OnProcessItemFailure(const Item: IDispatch; ProcessType: TProcessType; - ErrorClass: TErrorClass; ErrorCode: TErrorCode; - const ErrorString: WideString); dispid 9; - procedure OnRequestBlankDisk(var Abort: WordBool); dispid 10; - procedure OnRequestImage(ImageNumber: Integer; var ImageName: WideString; var Abort: WordBool); dispid 11; - procedure OnRequestLastDisk(var Abort: WordBool); dispid 12; - procedure OnRequestNthDisk(DiskNumber: Integer; var Abort: WordBool); dispid 13; - procedure OnSave; dispid 14; - end; - -// *********************************************************************// -// The Class CoZipItem provides a Create and CreateRemote method to -// create instances of the default interface IZipItem exposed by -// the CoClass ZipItem. The functions are intended to be used by -// clients wishing to automate the CoClass objects exposed by the -// server of this typelibrary. -// *********************************************************************// - CoZipItem = class - class function Create: IZipItem; - class function CreateRemote(const MachineName: string): IZipItem; - end; - -// *********************************************************************// -// The Class CoGZipItem provides a Create and CreateRemote method to -// create instances of the default interface IGZipItem exposed by -// the CoClass GZipItem. The functions are intended to be used by -// clients wishing to automate the CoClass objects exposed by the -// server of this typelibrary. -// *********************************************************************// - CoGZipItem = class - class function Create: IGZipItem; - class function CreateRemote(const MachineName: string): IGZipItem; - end; - -// *********************************************************************// -// The Class CoTarItem provides a Create and CreateRemote method to -// create instances of the default interface ITarItem exposed by -// the CoClass TarItem. The functions are intended to be used by -// clients wishing to automate the CoClass objects exposed by the -// server of this typelibrary. -// *********************************************************************// - CoTarItem = class - class function Create: ITarItem; - class function CreateRemote(const MachineName: string): ITarItem; - end; - -// *********************************************************************// -// The Class CoZipKit provides a Create and CreateRemote method to -// create instances of the default interface IZipKit exposed by -// the CoClass ZipKit. The functions are intended to be used by -// clients wishing to automate the CoClass objects exposed by the -// server of this typelibrary. -// *********************************************************************// - CoZipKit = class - class function Create: IZipKit; - class function CreateRemote(const MachineName: string): IZipKit; - end; - -implementation - -uses ComObj; - -class function CoZipItem.Create: IZipItem; -begin - Result := CreateComObject(CLASS_ZipItem) as IZipItem; -end; - -class function CoZipItem.CreateRemote(const MachineName: string): IZipItem; -begin - Result := CreateRemoteComObject(MachineName, CLASS_ZipItem) as IZipItem; -end; - -class function CoGZipItem.Create: IGZipItem; -begin - Result := CreateComObject(CLASS_GZipItem) as IGZipItem; -end; - -class function CoGZipItem.CreateRemote(const MachineName: string): IGZipItem; -begin - Result := CreateRemoteComObject(MachineName, CLASS_GZipItem) as IGZipItem; -end; - -class function CoTarItem.Create: ITarItem; -begin - Result := CreateComObject(CLASS_TarItem) as ITarItem; -end; - -class function CoTarItem.CreateRemote(const MachineName: string): ITarItem; -begin - Result := CreateRemoteComObject(MachineName, CLASS_TarItem) as ITarItem; -end; - -class function CoZipKit.Create: IZipKit; -begin - Result := CreateComObject(CLASS_ZipKit) as IZipKit; -end; - -class function CoZipKit.CreateRemote(const MachineName: string): IZipKit; -begin - Result := CreateRemoteComObject(MachineName, CLASS_ZipKit) as IZipKit; -end; - -end. diff --git a/components/Abbrevia/source/COM/Readme.txt b/components/Abbrevia/source/COM/Readme.txt deleted file mode 100644 index 52496ff..0000000 --- a/components/Abbrevia/source/COM/Readme.txt +++ /dev/null @@ -1,17 +0,0 @@ -The COM DLLs for v5.0 are compiled using Delphi XE2 (including extended RTTI) and include zipx support. Recompiling with Delphi 2009 and without zipx support should roughly halve the size of the 32-bit DLL. - -They can be registered for all users (requires admin rights) using: - - regsvr32 Abbrevia.dll - -And for the current user using: - - regsvr32 /i:user /n Abbrevia.dll - -To uninstall use: - - regsvr32 /u Abbrevia.dll - -or - - regsvr32 /i:user /n /u Abbrevia.dll \ No newline at end of file diff --git a/components/Abbrevia/source/COM/_GZipItem.pas b/components/Abbrevia/source/COM/_GZipItem.pas deleted file mode 100644 index f3da1c8..0000000 --- a/components/Abbrevia/source/COM/_GZipItem.pas +++ /dev/null @@ -1,262 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -unit _GZipItem; - -interface - -uses - ComObj, Abbrevia_TLB, AbGzTyp, AbZipKit; - -type - - TGZipItem = class(TAutoIntfObject, IGZipItem) - private - FOwner : TAbGzipItem; - FParent : TAbZipKit; - public - constructor Create(AOwner : TAbGzipItem; AParent : TAbZipKit); - protected - {IArchiveItem} - function Get_Action: TArchiveAction; safecall; - function Get_CompressedSize: Integer; safecall; - function Get_CRC32: Integer; safecall; - function Get_CRC32St: WideString; safecall; - function Get_DiskFileName: WideString; safecall; - function Get_DiskPath: WideString; safecall; - function Get_ExternalFileAttributes: TFileAttributes; safecall; - procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Get_IsEncrypted: WordBool; safecall; - function Get_LastModFileDateTime: TDateTime; safecall; - function Get_StoredPath: WideString; safecall; - function Get_Tagged: WordBool; safecall; - procedure Set_Tagged(Value: WordBool); safecall; - function Get_UnCompressedSize: Integer; safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - - {IGZipItem} - function Get_CompressionMethod: Byte; safecall; - procedure Set_CompressionMethod(Value: Byte); safecall; - function Get_ExtraField: WideString; safecall; - procedure Set_ExtraField(const Value: WideString); safecall; - function Get_ExtraFlags: Byte; safecall; - procedure Set_ExtraFlags(Value: Byte); safecall; - function Get_FileComment: WideString; safecall; - procedure Set_FileComment(const Value: WideString); safecall; - function Get_FileSystem: TFileSystem; safecall; - procedure Set_FileSystem(Value: TFileSystem); safecall; - function Get_Flags: Byte; safecall; - procedure Set_Flags(Value: Byte); safecall; - function Get_HeaderCRC: Integer; safecall; - end; - - -implementation - -uses - ComServ, {StStrL,} SysUtils; - -{------------------------------------------------------------------------------} -constructor TGzipItem.Create(AOwner : TAbGzipItem; AParent : TAbZipKit); -begin - inherited Create(ComServer.TypeLib, IGZipItem); - FOwner := AOwner; - FParent := AParent; -end; -{------------------------------------------------------------------------------} -{IArchiveItem} -{------------------------------------------------------------------------------} -function TGzipItem.Get_Action: TArchiveAction; -begin - Result := TArchiveAction(FOwner.Action); -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_CompressedSize: Integer; -begin - result := FOwner.CompressedSize; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_CRC32: Integer; -begin - result := FOwner.CRC32; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_CRC32St: WideString; -begin - result := IntToHex(FOwner.CRC32, 8); -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_DiskFileName: WideString; -begin - result := FOwner.DiskFileName; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_DiskPath: WideString; -begin - result := FOwner.DiskPath; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_ExternalFileAttributes: TFileAttributes; -begin - result := TFileAttributes(FOwner.ExternalFileAttributes); -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_ExternalFileAttributes(Value: TFileAttributes); -begin - FOwner.ExternalFileAttributes := LongInt(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_FileName: WideString; -begin - result := FOwner.FileName; -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_FileName(const Value: WideString); -begin - FOwner.FileName := Value; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_IsEncrypted: WordBool; -begin - result := FOwner.IsEncrypted; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_LastModFileDateTime: TDateTime; -begin - result := FileDateToDateTime((FOwner.LastModFileDate shl 16) + FOwner.LastModFileTime); -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_StoredPath: WideString; -begin - result := FOwner.StoredPath; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_Tagged: WordBool; -begin - result := FOwner.Tagged; -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_Tagged(Value: WordBool); -begin - FOwner.Tagged := Value; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_UnCompressedSize: Integer; -begin - result := FOwner.UncompressedSize; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_Password: WideString; -begin - {!!!} - //result := FOwner.Password; -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_Password(const Value: WideString); -begin - {!!!} - //FOwner.Password := Value; - //FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -{IGZipItem} -{------------------------------------------------------------------------------} -function TGzipItem.Get_CompressionMethod: Byte; -begin - result := FOwner.CompressionMethod; -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_CompressionMethod(Value: Byte); -begin - -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_ExtraField: WideString; -begin - result := ''; -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_ExtraField(const Value: WideString); -begin - -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_ExtraFlags: Byte; -begin - result := FOwner.ExtraFlags; -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_ExtraFlags(Value: Byte); -begin - FOwner.ExtraFlags := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_FileComment: WideString; -begin - result := WideString(FOwner.FileComment); -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_FileComment(const Value: WideString); -begin - FOwner.FileComment := AnsiString(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_FileSystem: TFileSystem; -begin - result := TFileSystem(FOwner.FileSystem); -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_FileSystem(Value: TFileSystem); -begin - FOwner.FileSystem := TAbGzFileSystem(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_Flags: Byte; -begin - result := FOwner.Flags; -end; -{------------------------------------------------------------------------------} -procedure TGzipItem.Set_Flags(Value: Byte); -begin - -end; -{------------------------------------------------------------------------------} -function TGzipItem.Get_HeaderCRC: Integer; -begin - result := 0; -end; -{------------------------------------------------------------------------------} - - - - -end. diff --git a/components/Abbrevia/source/COM/_TarItem.pas b/components/Abbrevia/source/COM/_TarItem.pas deleted file mode 100644 index 2ba1dee..0000000 --- a/components/Abbrevia/source/COM/_TarItem.pas +++ /dev/null @@ -1,297 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -unit _TarItem; - -interface - -uses - ComObj, Abbrevia_TLB, AbTarTyp, AbZipKit; - -type - - TTarItem = class(TAutoIntfObject, ITarItem) - private - FOwner : TAbTarItem; - FParent : TAbZipKit; - public - constructor Create(AOwner : TAbTarItem; AParent : TAbZipKit); - protected - {IArchiveItem} - function Get_Action: TArchiveAction; safecall; - function Get_CompressedSize: Integer; safecall; - function Get_CRC32: Integer; safecall; - function Get_CRC32St: WideString; safecall; - function Get_DiskFileName: WideString; safecall; - function Get_DiskPath: WideString; safecall; - function Get_ExternalFileAttributes: TFileAttributes; safecall; - procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Get_IsEncrypted: WordBool; safecall; - function Get_LastModFileDateTime: TDateTime; safecall; - function Get_StoredPath: WideString; safecall; - function Get_Tagged: WordBool; safecall; - procedure Set_Tagged(Value: WordBool); safecall; - function Get_UnCompressedSize: Integer; safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - - {ITarItem} - function Get_DevMajor: Integer; safecall; - procedure Set_DevMajor(Value: Integer); safecall; - function Get_DevMinor: Integer; safecall; - procedure Set_DevMinor(Value: Integer); safecall; - function Get_GroupID: Integer; safecall; - procedure Set_GroupID(Value: Integer); safecall; - function Get_GroupName: WideString; safecall; - procedure Set_GroupName(const Value: WideString); safecall; - function Get_LinkFlag: Byte; safecall; - procedure Set_LinkFlag(Value: Byte); safecall; - function Get_LinkName: WideString; safecall; - procedure Set_LinkName(const Value: WideString); safecall; - function Get_Mode: Integer; safecall; - procedure Set_Mode(Value: Integer); safecall; - function Get_UserID: Integer; safecall; - procedure Set_UserID(Value: Integer); safecall; - function Get_UserName: WideString; safecall; - procedure Set_UserName(const Value: WideString); safecall; - - end; - - -implementation - -uses - ComServ, {StStrL,} SysUtils; - -{------------------------------------------------------------------------------} -constructor TTarItem.Create(AOwner : TAbTarItem; AParent : TAbZipKit); -begin - inherited Create(ComServer.TypeLib, ITarItem); - FOwner := AOwner; - FParent := AParent; -end; -{------------------------------------------------------------------------------} -{IArchiveItem} -{------------------------------------------------------------------------------} -function TTarItem.Get_Action: TArchiveAction; -begin - Result := TArchiveAction(FOwner.Action); -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_CompressedSize: Integer; -begin - result := FOwner.CompressedSize; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_CRC32: Integer; -begin - result := FOwner.CRC32; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_CRC32St: WideString; -begin - result := IntToHex(FOwner.CRC32, 8); -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_DiskFileName: WideString; -begin - result := FOwner.DiskFileName; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_DiskPath: WideString; -begin - result := FOwner.DiskPath; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_ExternalFileAttributes: TFileAttributes; -begin - result := TFileAttributes(FOwner.ExternalFileAttributes); -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_ExternalFileAttributes(Value: TFileAttributes); -begin - FOwner.ExternalFileAttributes := LongInt(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_FileName: WideString; -begin - result := FOwner.FileName; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_FileName(const Value: WideString); -begin - FOwner.FileName := Value; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_IsEncrypted: WordBool; -begin - result := FOwner.IsEncrypted; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_LastModFileDateTime: TDateTime; -begin - result := FileDateToDateTime((FOwner.LastModFileDate shl 16) + FOwner.LastModFileTime); -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_StoredPath: WideString; -begin - result := FOwner.StoredPath; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_Tagged: WordBool; -begin - result := FOwner.Tagged; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_Tagged(Value: WordBool); -begin - FOwner.Tagged := Value; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_UnCompressedSize: Integer; -begin - result := FOwner.UncompressedSize; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_Password: WideString; -begin - {!!!} - //result := FOwner.Password; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_Password(const Value: WideString); -begin - {!!!} - //FOwner.Password := Value; - //FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -{ITarItem} -{------------------------------------------------------------------------------} -function TTarItem.Get_DevMajor: Integer; -begin - result := FOwner.DevMajor; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_DevMajor(Value: Integer); -begin - FOwner.DevMajor := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_DevMinor: Integer; -begin - result := FOwner.DevMinor; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_DevMinor(Value: Integer); -begin - FOwner.DevMinor := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_GroupID: Integer; -begin - result := FOwner.GroupID; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_GroupID(Value: Integer); -begin - FOwner.GroupID := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_GroupName: WideString; -begin - result := FOwner.GroupName; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_GroupName(const Value: WideString); -begin - FOwner.GroupName := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_LinkFlag: Byte; -begin - result := Byte(FOwner.LinkFlag); -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_LinkFlag(Value: Byte); -begin - FOwner.LinkFlag := AnsiChar(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_LinkName: WideString; -begin - result := FOwner.LinkName; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_LinkName(const Value: WideString); -begin - FOwner.LinkName := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_Mode: Integer; -begin - result := FOwner.Mode; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_Mode(Value: Integer); -begin - FOwner.Mode := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_UserID: Integer; -begin - result := FOwner.UserID; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_UserID(Value: Integer); -begin - FOwner.UserID := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TTarItem.Get_UserName: WideString; -begin - result := FOwner.UserName; -end; -{------------------------------------------------------------------------------} -procedure TTarItem.Set_UserName(const Value: WideString); -begin - FOwner.UserName := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} - - -end. diff --git a/components/Abbrevia/source/COM/_ZipItem.pas b/components/Abbrevia/source/COM/_ZipItem.pas deleted file mode 100644 index 5b8867c..0000000 --- a/components/Abbrevia/source/COM/_ZipItem.pas +++ /dev/null @@ -1,255 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -unit _ZipItem; - -interface - -uses - ComObj, Abbrevia_TLB, AbZipTyp, AbZipKit; - -type - TZipItem = class(TAutoIntfObject, IZipItem) - private - FOwner : TAbZipItem; - FParent : TAbZipKit; - public - constructor Create(AOwner : TAbZipItem; AParent : TAbZipKit); - protected - {IArchiveItem} - function Get_Action: TArchiveAction; safecall; - function Get_CompressedSize: Integer; safecall; - function Get_CRC32: Integer; safecall; - function Get_CRC32St: WideString; safecall; - function Get_DiskFileName: WideString; safecall; - function Get_DiskPath: WideString; safecall; - function Get_ExternalFileAttributes: TFileAttributes; safecall; - procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Get_IsEncrypted: WordBool; safecall; - function Get_LastModFileDateTime: TDateTime; safecall; - function Get_StoredPath: WideString; safecall; - function Get_Tagged: WordBool; safecall; - procedure Set_Tagged(Value: WordBool); safecall; - function Get_UnCompressedSize: Integer; safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - - {IZipItem} - function Get_CompressionMethod: TZipCompressionMethod; safecall; - function Get_CompressionRatio: Double; safecall; - function Get_DeflateOption: TZipDeflateOption; safecall; - function Get_DictionarySize: TZipDictionarySize; safecall; - function Get_DiskNumberStart: Integer; safecall; - function Get_ExtraField: WideString; safecall; - procedure Set_ExtraField(const Value: WideString); safecall; - function Get_FileComment: WideString; safecall; - procedure Set_FileComment(const Value: WideString); safecall; - function Get_InternalFileAttributes: Integer; safecall; - procedure Set_InternalFileAttributes(Value: Integer); safecall; - function Get_VersionMadeBy: Integer; safecall; - function Get_VersionNeededToExtract: Integer; safecall; - end; - -implementation - -uses - ComServ, SysUtils; - -{------------------------------------------------------------------------------} -constructor TZipItem.Create(AOwner : TAbZipItem; AParent : TAbZipKit); -begin - inherited Create(ComServer.TypeLib, IZipItem); - FOwner := AOwner; - FParent := AParent; -end; -{------------------------------------------------------------------------------} -{IArchiveItem} -{------------------------------------------------------------------------------} -function TZipItem.Get_Action: TArchiveAction; -begin - Result := TArchiveAction(FOwner.Action); -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_CompressedSize: Integer; -begin - result := FOwner.CompressedSize; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_CRC32: Integer; -begin - result := FOwner.CRC32; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_CRC32St: WideString; -begin - result := IntToHex(FOwner.CRC32, 8); -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_DiskFileName: WideString; -begin - result := FOwner.DiskFileName; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_DiskPath: WideString; -begin - result := FOwner.DiskPath; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_ExternalFileAttributes: TFileAttributes; -begin - result := TFileAttributes(FOwner.ExternalFileAttributes); -end; -{------------------------------------------------------------------------------} -procedure TZipItem.Set_ExternalFileAttributes(Value: TFileAttributes); -begin - FOwner.ExternalFileAttributes := LongInt(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_FileName: WideString; -begin - result := FOwner.FileName; -end; -{------------------------------------------------------------------------------} -procedure TZipItem.Set_FileName(const Value: WideString); -begin - FOwner.FileName := Value; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_IsEncrypted: WordBool; -begin - result := FOwner.IsEncrypted; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_LastModFileDateTime: TDateTime; -begin - result := FileDateToDateTime((FOwner.LastModFileDate shl 16) + FOwner.LastModFileTime); -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_StoredPath: WideString; -begin - result := FOwner.StoredPath; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_Tagged: WordBool; -begin - result := FOwner.Tagged; -end; -{------------------------------------------------------------------------------} -procedure TZipItem.Set_Tagged(Value: WordBool); -begin - FOwner.Tagged := Value; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_UnCompressedSize: Integer; -begin - result := FOwner.UncompressedSize; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_Password: WideString; -begin - Result := WideString(FParent.Password); -end; -{------------------------------------------------------------------------------} -procedure TZipItem.Set_Password(const Value: WideString); -begin - FParent.Password := AnsiString(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -{IZipItem} -{------------------------------------------------------------------------------} -function TZipItem.Get_CompressionMethod: TZipCompressionMethod; -begin - Result := TZipCompressionMethod(FOwner.CompressionMethod); -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_CompressionRatio: Double; -begin - result := FOwner.CompressionRatio; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_DeflateOption: TZipDeflateOption; -begin - result := TZipDeflateOption(FOwner.DeflationOption); -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_DictionarySize: TZipDictionarySize; -begin - result := TZipDictionarySize(FOwner.DictionarySize); -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_DiskNumberStart: Integer; -begin - result := FOwner.DiskNumberStart; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_ExtraField: WideString; -begin - result := ''; -end; -{------------------------------------------------------------------------------} -procedure TZipItem.Set_ExtraField(const Value: WideString); -begin - -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_FileComment: WideString; -begin - result := WideString(FOwner.FileComment); -end; -{------------------------------------------------------------------------------} -procedure TZipItem.Set_FileComment(const Value: WideString); -begin - FOwner.FileComment := AnsiString(Value); - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_InternalFileAttributes: Integer; -begin - result := FOwner.InternalFileAttributes; -end; -{------------------------------------------------------------------------------} -procedure TZipItem.Set_InternalFileAttributes(Value: Integer); -begin - FOwner.InternalFileAttributes := Value; - FParent.ZipArchive.IsDirty := True; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_VersionMadeBy: Integer; -begin - result := FOwner.VersionMadeBy; -end; -{------------------------------------------------------------------------------} -function TZipItem.Get_VersionNeededToExtract: Integer; -begin - result := FOwner.VersionNeededToExtract; -end; -{------------------------------------------------------------------------------} - - -end. diff --git a/components/Abbrevia/source/COM/_ZipKit.pas b/components/Abbrevia/source/COM/_ZipKit.pas deleted file mode 100644 index 2588140..0000000 --- a/components/Abbrevia/source/COM/_ZipKit.pas +++ /dev/null @@ -1,771 +0,0 @@ -(* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is TurboPower Abbrevia - * - * The Initial Developer of the Original Code is - * TurboPower Software - * - * Portions created by the Initial Developer are Copyright (C) 1997-2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * - * ***** END LICENSE BLOCK ***** *) - -unit _ZipKit; - -interface - -uses - ComObj, Classes, Windows, Abbrevia_TLB, ActiveX, axctrls, AbZipKit, AbArcTyp, - AbUtils, _ZipItem, _GZipItem, _TarItem, AbZipTyp, AbTarTyp, AbGzTyp, - AbConst, AbBrowse; - -type - {$IFNDEF VER130}{$WARN SYMBOL_PLATFORM OFF}{$ENDIF} - TZipKit = class(TAutoObject, IConnectionPointContainer, IEnumVariant, IZipKit) - private - {private declarations} - FConnectionPoints : TConnectionPoints; - FEvents : IZipKitEvents; - FOwner : TAbZipKit; - FEnumPos : Integer; - - {Events for FOwner} - procedure _OnArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem; Progress : Byte; var Abort : Boolean); - procedure _OnArchiveProgress(Sender : TObject; Progress : Byte; var Abort : Boolean); - procedure _OnChange(Sender : TObject); - procedure _OnConfirmOverwrite(var Name : string; var confirm : Boolean); - procedure _OnConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem; ProcessType : TAbProcessType; var Confirm : Boolean); - procedure _OnConfirmSave(Sender : TObject; var Confirm : Boolean); - procedure _OnLoad(Sender : TObject); - procedure _OnNeedPassword(Sender : TObject; var NewPassword : AnsiString); - procedure _OnProcessItemFailure(Sender : TObject; Item : TAbArchiveItem; ProcessType : TAbProcessType; ErrorClass : TAbErrorClass; ErrorCode : Integer); - procedure _OnRequestBlankDisk(Sender : TObject; var Abort : Boolean); - procedure _OnRequestImage(Sender : TObject; ImageNumber : Integer; var ImageName : string; var Abort : Boolean); - procedure _OnRequestLastDisk(Sender : TObject; var Abort : Boolean); - procedure _OnRequestNthDisk(Sender : TObject; DiskNumber : Byte; var Abort : Boolean); - procedure _OnSave(Sender : TObject); - - public - procedure Initialize; override; - destructor Destroy; override; - - protected - - {IConnectionPointContainer} - property ConnectionPoints: TConnectionPoints read FConnectionPoints - implements IConnectionPointContainer; - procedure EventSinkChanged(const EventSink: IUnknown); override; - - - {IEnumVariant} - function Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched: LongWord): HResult; stdcall; - function Skip(celt: LongWord): HResult; stdcall; - function Reset: HResult; stdcall; - function Clone(out Enum: IEnumVariant): HResult; stdcall; - - - {IZipKit} - procedure Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); safecall; - procedure AddFromStream(const FileName: WideString; Stream: OleVariant); safecall; - function Get_AutoSave: WordBool; safecall; - procedure Set_AutoSave(Value: WordBool); safecall; - function Get_BaseDirectory: WideString; safecall; - procedure Set_BaseDirectory(const Value: WideString); safecall; - procedure ClearTags; safecall; - function Get_CompressionMethodToUse: TZipSupportMethod; safecall; - procedure Set_CompressionMethodToUse(Value: TZipSupportMethod); safecall; - function Get_Count: Integer; safecall; - function Get_DeflateOption: TZipDeflateOption; safecall; - procedure Set_DeflateOption(Value: TZipDeflateOption); safecall; - procedure Delete(const FileMask: WideString; const ExclusionMask: WideString); safecall; - procedure DeleteAt(Index: Integer); safecall; - procedure DeleteTaggedItems; safecall; - function Get_DOSMode: WordBool; safecall; - procedure Set_DOSMode(Value: WordBool); safecall; - procedure Extract(const FileMask: WideString; const ExclusionMask: WideString); safecall; - procedure ExtractAt(Index: Integer; const NewName: WideString); safecall; - function Get_ExtractOptions: TZipExtractOptions; safecall; - procedure Set_ExtractOptions(Value: TZipExtractOptions); safecall; - procedure ExtractTaggedItems; safecall; - function Get_FileName: WideString; safecall; - procedure Set_FileName(const Value: WideString); safecall; - function Find(const FileName: WideString): Integer; safecall; - procedure Freshen(const FileMask: WideString; const ExclusionMask: WideString); safecall; - procedure FreshenTaggedItems; safecall; - function Get_Item(Index: Integer): IDispatch; safecall; - function Get_LogFile: WideString; safecall; - procedure Set_LogFile(const Value: WideString); safecall; - function Get_Logging: WordBool; safecall; - procedure Set_Logging(Value: WordBool); safecall; - function Get_Password: WideString; safecall; - procedure Set_Password(const Value: WideString); safecall; - function Get_PasswordRetries: Byte; safecall; - procedure Set_PasswordRetries(Value: Byte); safecall; - procedure Replace(const FileMask: WideString); safecall; - procedure Save; safecall; - function Get_Spanned: WordBool; safecall; - function Get_SpanningThreshold: Integer; safecall; - procedure Set_SpanningThreshold(Value: Integer); safecall; - function Get_Status: TArchiveStatus; safecall; - function Get_StoreOptions: TStoreOptions; safecall; - procedure Set_StoreOptions(Value: TStoreOptions); safecall; - procedure TagItems(const FileMask: WideString); safecall; - function Get_TempDirectory: WideString; safecall; - procedure Set_TempDirectory(const Value: WideString); safecall; - procedure TestTaggedItems; safecall; - procedure UntagItems(const FileMask: WideString); safecall; - function Get_ZipFileComment: WideString; safecall; - procedure Set_ZipFileComment(const Value: WideString); safecall; - function License(const Key: WideString): WordBool; safecall; - function Get__NewEnum: IUnknown; safecall; - function ExtractToStream(const FileName: WideString): OleVariant; safecall; - function Get_CompressionType: TArchiveType; safecall; - procedure Set_CompressionType(Value: TArchiveType); safecall; - - function Get_TarAutoHandle: WordBool; safecall; - procedure Set_TarAutoHandle(Value: WordBool); safecall; - end; - - -implementation - - -uses - ComServ; - -{------------------------------------------------------------------------------} -{IConnectionPointContainer} -{------------------------------------------------------------------------------} -procedure TZipKit.EventSinkChanged(const EventSink: IUnknown); -begin - FEvents := EventSink as IZipKitEvents; -end; -{------------------------------------------------------------------------------} -{IEnumVariant} -{------------------------------------------------------------------------------} -function TZipKit.Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched: LongWord): HResult; stdcall; -var - V : OleVariant; - I : Integer; -begin - Result := S_FALSE; - try - if @pceltFetched <> nil then - pceltFetched := 0; - for I := 0 to celt - 1 do begin - if FEnumPos >= FOwner.Count then begin - FEnumPos := 0; - Exit; - end; - V := Get_Item(FEnumPos); - PVariantArgList(@rgvar)[I] := TVariantArg(V); - - { Prevent COM garbage collection } - TVarData(V).VType := varEmpty; - TVarData(V).VInteger := 0; - - Inc(FEnumPos); - if @pceltFetched <> nil then - Inc(pceltFetched); - end; - except - end; - if (@pceltFetched = nil) or (pceltFetched = celt) then - Result := S_OK; -end; -{------------------------------------------------------------------------------} -function TZipKit.Skip(celt: LongWord): HResult; -begin - Inc(FEnumPos, celt); - Result := S_OK; -end; -{------------------------------------------------------------------------------} -function TZipKit.Reset: HResult; -begin - FEnumPos := 0; - Result := S_OK; -end; -{------------------------------------------------------------------------------} -function TZipKit.Clone(out Enum: IEnumVariant): HResult; -begin - Enum := nil; - Result := S_OK; - try - Enum := Self.Create; - TZipKit(Enum).FOwner := FOwner; - except - Result := E_OUTOFMEMORY; - end; -end; -{------------------------------------------------------------------------------} -{IZipKit} -{------------------------------------------------------------------------------} -procedure TZipKit.Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); -begin - FOwner.AddFilesEx(FileMask, ExclusionMask, SearchAttr); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.AddFromStream(const FileName: WideString; Stream: OleVariant); -var - InStream : TMemoryStream; - Info : array of Byte; -begin - Info := nil; - InStream := TMemoryStream.Create; - try - Info := Stream; - InStream.Write(Info[0], Length(Info)); - InStream.Position := 0; - FOwner.AddFromStream(FileName, InStream); - finally - InStream.Free; - end; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_AutoSave: WordBool; -begin - Result := FOwner.AutoSave; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_AutoSave(Value: WordBool); -begin - FOwner.AutoSave := Value; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_BaseDirectory: WideString; -begin - Result := FOwner.BaseDirectory; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_BaseDirectory(const Value: WideString); -begin - FOwner.BaseDirectory := Value; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.ClearTags; -begin - FOwner.ClearTags; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_CompressionMethodToUse: TZipSupportMethod; -begin - Result := TZipCompressionMethod(FOwner.CompressionMethodToUse); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_CompressionMethodToUse(Value: TZipSupportMethod); -begin - FOwner.CompressionMethodToUse := TAbZipSupportedMethod(Value); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_Count: Integer; -begin - Result := FOwner.Count; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_DeflateOption: TZipDeflateOption; -begin - Result := TZipDeflateOption(FOwner.DeflationOption); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_DeflateOption(Value: TZipDeflateOption); -begin - FOwner.DeflationOption := TAbZipDeflationOption(Value); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Delete(const FileMask: WideString; const ExclusionMask: WideString); -begin - FOwner.DeleteFilesEx(FileMask, ExclusionMask); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.DeleteAt(Index: Integer); -begin - FOwner.DeleteAt(Index); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.DeleteTaggedItems; -begin - FOwner.DeleteTaggedItems; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_DOSMode: WordBool; -begin - Result := FOwner.DOSMode; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_DOSMode(Value: WordBool); -begin - FOwner.DOSMode := Value; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Extract(const FileMask: WideString; const ExclusionMask: WideString); -begin - FOwner.ExtractFilesEx(FileMask, ExclusionMask); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.ExtractAt(Index: Integer; const NewName: WideString); -begin - FOwner.ExtractAt(Index, NewName); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_ExtractOptions: TZipExtractOptions; -begin - Result := 0; - if TAbExtractOption(eoCreateDirs) in FOwner.ExtractOptions then - Result := Result + TZipExtractOptions(eoCreateDirs); - if TAbExtractOption(eoRestorePath) in FOwner.ExtractOptions then - Result := Result + TZipExtractOptions(eoRestorePath); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_ExtractOptions(Value: TZipExtractOptions); -var - TempOptions : TAbExtractOptions; -begin - TempOptions := []; - if (Value or Abbrevia_TLB.eoCreateDirs) = Value then - Include(TempOptions, AbArcTyp.eoCreateDirs); - if (Value or Abbrevia_TLB.eoRestorePath) = Value then - Include(TempOptions, AbArcTyp.eoRestorePath); - FOwner.ExtractOptions := TempOptions -end; -{------------------------------------------------------------------------------} -procedure TZipKit.ExtractTaggedItems; -begin - FOwner.ExtractTaggedItems; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_FileName: WideString; -begin - Result := FOwner.FileName; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_FileName(const Value: WideString); -begin - FOwner.FileName := Value; -end; -{------------------------------------------------------------------------------} -function TZipKit.Find(const FileName: WideString): Integer; -begin - Result := FOwner.FindFile(FileName); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Freshen(const FileMask: WideString; const ExclusionMask: WideString); -begin - FOwner.FreshenFilesEx(FileMask, ExclusionMask); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.FreshenTaggedItems; -begin - FOwner.FreshenTaggedItems; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_Item(Index: Integer): IDispatch; -begin - Result := TZipItem.Create(FOwner.Items[Index], FOwner); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_LogFile: WideString; -begin - Result := FOwner.LogFile; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_LogFile(const Value: WideString); -begin - FOwner.LogFile := Value; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_Logging: WordBool; -begin - Result := FOwner.Logging; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_Logging(Value: WordBool); -begin - FOwner.Logging := Value; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_Password: WideString; -begin - Result := WideString(FOwner.Password); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_Password(const Value: WideString); -begin - FOwner.Password := AnsiString(Value); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_PasswordRetries: Byte; -begin - Result := FOwner.PasswordRetries; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_PasswordRetries(Value: Byte); -begin - FOwner.PasswordRetries := Value; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Replace(const FileMask: WideString); -begin - FOwner.Replace(FOwner.Items[FOwner.FindFile(FileMask)]); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Save; -begin - FOwner.Save; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_Spanned: WordBool; -begin - Result := FOwner.Spanned; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_SpanningThreshold: Integer; -begin - Result := FOwner.SpanningThreshold; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_SpanningThreshold(Value: Integer); -begin - FOwner.SpanningThreshold := Value; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_Status: TArchiveStatus; -begin - Result := TArchiveStatus(FOwner.Status); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_StoreOptions: TStoreOptions; -begin - Result := 0; - if TAbStoreOption(soStripDrive) in FOwner.StoreOptions then - Result := Result + TStoreOptions(soStripDrive); - if TAbStoreOption(soStripPath) in FOwner.StoreOptions then - Result := Result + TStoreOptions(soStripPath); - if TAbStoreOption(soRemoveDots) in FOwner.StoreOptions then - Result := Result + TStoreOptions(soRemoveDots); - if TAbStoreOption(soRecurse) in FOwner.StoreOptions then - Result := Result + TStoreOptions(soRecurse); - if TAbStoreOption(soFreshen) in FOwner.StoreOptions then - Result := Result + TStoreOptions(soFreshen); - if TAbStoreOption(soReplace) in FOwner.StoreOptions then - Result := Result + TStoreOptions(soReplace); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_StoreOptions(Value: TStoreOptions); -var - TempOptions : TAbStoreOptions; -begin - TempOptions := []; - if (Value or Abbrevia_TLB.soStripDrive) = Value then - Include(TempOptions, AbArcTyp.soStripDrive); - if (Value or Abbrevia_TLB.soStripPath) = Value then - Include(TempOptions, AbArcTyp.soStripPath); - if (Value or Abbrevia_TLB.soRemoveDots) = Value then - Include(TempOptions, AbArcTyp.soRemoveDots); - if (Value or Abbrevia_TLB.soRecurse) = Value then - Include(TempOptions, AbArcTyp.soRecurse); - if (Value or Abbrevia_TLB.soFreshen) = Value then - Include(TempOptions, AbArcTyp.soFreshen); - if (Value or Abbrevia_TLB.soReplace) = Value then - Include(TempOptions, AbArcTyp.soReplace); - FOwner.StoreOptions := TempOptions -end; -{------------------------------------------------------------------------------} -procedure TZipKit.TagItems(const FileMask: WideString); -begin - FOwner.TagItems(FileMask); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_TempDirectory: WideString; -begin - Result := FOwner.TempDirectory; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_TempDirectory(const Value: WideString); -begin - FOwner.TempDirectory := Value; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.TestTaggedItems; -begin - FOwner.TestTaggedItems; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.UntagItems(const FileMask: WideString); -begin - FOwner.UnTagItems(FileMask); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_ZipFileComment: WideString; -begin - Result := WideString(FOwner.ZipFileComment); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_ZipFileComment(const Value: WideString); -begin - FOwner.ZipfileComment := AnsiString(Value); -end; -{------------------------------------------------------------------------------} -function TZipKit.License(const Key: WideString): WordBool; -begin - Result := True; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get__NewEnum: IUnknown; -begin - Result := Self; -end; -{------------------------------------------------------------------------------} -function TZipKit.ExtractToStream(const FileName: WideString): OleVariant; -var - Stream : TMemoryStream; - Info : array of Byte; -begin - Stream := TMemoryStream.Create; - try - FOwner.ExtractToStream(FileName, Stream); - Stream.Position := 0; - SetLength(Info, Stream.Size); - Stream.Read(Info[0], Stream.Size); - Result := Info; - finally - Stream.Free; - end; -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_CompressionType: TArchiveType; -begin - Result := TArchiveType((FOwner as TAbBaseBrowser).ArchiveType); -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_CompressionType(Value: TArchiveType); -begin - (FOwner as TAbBaseBrowser).ArchiveType := TAbArchiveType(ord(Value)); -end; -{------------------------------------------------------------------------------} -function TZipKit.Get_TarAutoHandle: WordBool; -begin - Result := FOwner.TarAutoHandle; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Set_TarAutoHandle(Value: WordBool); -begin - FOwner.TarAutoHandle := Value; -end; -{------------------------------------------------------------------------------} -{TZipKit Events} -{------------------------------------------------------------------------------} -procedure TZipKit._OnArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem; - Progress : Byte; var Abort : Boolean); -var - FAbort : WordBool; -begin - FAbort := Abort; - if Assigned(FEvents) then begin - if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then - FEvents.OnArchiveItemProgress(TZipItem.Create(TAbZipItem(Item), FOwner), - Progress, FAbort) - else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then - FEvents.OnArchiveItemProgress(TTarItem.Create(TAbTarItem(Item), FOwner), - Progress, FAbort) - else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then - FEvents.OnArchiveItemProgress(TGZipItem.Create(TAbGZipItem(Item), FOwner), - Progress, FAbort); - end; - Abort := FAbort; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnArchiveProgress(Sender : TObject; Progress : Byte; - var Abort : Boolean); -var - FAbort : WordBool; -begin - FAbort := Abort; - if Assigned(FEvents) then - FEvents.OnArchiveProgress(Progress, FAbort); - Abort := FAbort; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnChange(Sender : TObject); -begin - if Assigned(FEvents) then - FEvents.OnChange; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnConfirmOverwrite(var Name : string; var confirm : Boolean); -var - FConfirm : WordBool; - FName : WideString; -begin - FConfirm := Confirm; - FName := Name; - if Assigned(FEvents) then - FEvents.OnConfirmOverwrite(FName, FConfirm); - Name := FName; - Confirm := FConfirm; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem; - ProcessType : TAbProcessType; var Confirm : Boolean); -var - FConfirm : WordBool; -begin - FConfirm := Confirm; - if Assigned(FEvents) then begin - if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then - FEvents.OnConfirmProcessItem(TZipItem.Create(TAbZipItem(Item), FOwner), - TProcessType(ProcessType), FConfirm) - else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then - FEvents.OnConfirmProcessItem(TTarItem.Create(TAbTarItem(Item), FOwner), - TProcessType(ProcessType), FConfirm) - else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then - FEvents.OnConfirmProcessItem(TGZipItem.Create(TAbGZipItem(Item), FOwner), - TProcessType(ProcessType), FConfirm); - end; - Confirm := FConfirm -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnConfirmSave(Sender : TObject; var Confirm : Boolean); -var - FConfirm : WordBool; -begin - FConfirm := Confirm; - if Assigned(FEvents) then - FEvents.OnConfirmSave(FConfirm); - Confirm := FConfirm; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnLoad(Sender : TObject); -begin - if Assigned(FEvents) then - FEvents.OnLoad; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnNeedPassword(Sender : TObject; var NewPassword : AnsiString); -var - FNewPassword : WideString; -begin - FNewPassword := WideString(NewPassword); - if Assigned(FEvents) then - FEvents.OnNeedPassword(FNewPassword); - NewPassword := AnsiString(FNewPassword); -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnProcessItemFailure(Sender : TObject; Item : TAbArchiveItem; - ProcessType : TAbProcessType; ErrorClass : TAbErrorClass; - ErrorCode : Integer); -begin - if Assigned(FEvents) then begin - if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then - FEvents.OnProcessItemFailure(TZipItem.Create(TAbZipItem(Item), FOwner), - TProcessType(ProcessType), TErrorClass(ErrorClass), - TErrorCode(ErrorCode), AbStrRes(ErrorCode)) - else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then - FEvents.OnProcessItemFailure(TTarItem.Create(TAbTarItem(Item), FOwner), - TProcessType(ProcessType), TErrorClass(ErrorClass), - TErrorCode(ErrorCode),AbStrRes(ErrorCode)) - else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then - FEvents.OnProcessItemFailure(TGZipItem.Create(TAbGZipItem(Item), FOwner), - TProcessType(ProcessType), TErrorClass(ErrorClass), - TErrorCode(ErrorCode),AbStrRes(ErrorCode)); - end; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnRequestBlankDisk(Sender : TObject; var Abort : Boolean); -var - FAbort : WordBool; -begin - FAbort := Abort; - if Assigned(FEvents) then - FEvents.OnRequestBlankDisk(FAbort); - Abort := FAbort; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnRequestImage(Sender : TObject; ImageNumber : Integer; var ImageName : string; var Abort : Boolean); -var - FImageName : WideString; - FAbort : WordBool; -begin - FImageName := ImageName; - FAbort := Abort; - if Assigned(FEvents) then - FEvents.OnRequestImage(ImageNumber, FImageName, FAbort); - Abort := FAbort; - ImageName := FImageName; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnRequestLastDisk(Sender : TObject; var Abort : Boolean); -var - FAbort : WordBool; -begin - FAbort := Abort; - if Assigned(FEvents) then - FEvents.OnRequestLastDisk(FAbort); - Abort := FAbort; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnRequestNthDisk(Sender : TObject; DiskNumber : Byte; var Abort : Boolean); -var - FAbort : WordBool; -begin - FAbort := Abort; - if Assigned(FEvents) then - FEvents.OnRequestNthDisk(DiskNumber, FAbort); - Abort := FAbort; -end; -{------------------------------------------------------------------------------} -procedure TZipKit._OnSave(Sender : TObject); -begin - if Assigned(FEvents) then - FEvents.OnSave; -end; -{------------------------------------------------------------------------------} -procedure TZipKit.Initialize; -begin - inherited Initialize; - FConnectionPoints := TConnectionPoints.Create(Self); - if AutoFactory.EventTypeInfo <> nil then - FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID, - ckSingle, EventConnect); - FOwner := AbZipKit.TAbZipKit.Create(nil); - FOwner.OnArchiveItemProgress := _OnArchiveItemProgress; - FOwner.OnArchiveProgress := _OnArchiveProgress; - FOwner.OnChange := _OnChange; - FOwner.OnConfirmOverwrite := _OnConfirmOverwrite; - FOwner.OnConfirmProcessItem := _OnConfirmProcessItem; - FOwner.OnConfirmSave := _OnConfirmSave; - FOwner.OnLoad := _OnLoad; - FOwner.OnNeedPassword := _OnNeedPassword; - FOwner.OnProcessItemFailure := _OnProcessItemFailure; - FOwner.OnRequestBlankDisk := _OnRequestBlankDisk; - FOwner.OnRequestImage := _OnRequestImage; - FOwner.OnRequestLastDisk := _OnRequestLastDisk; - FOwner.OnRequestNthDisk := _OnRequestNthDisk; - FOwner.OnSave := _OnSave; - FEnumPos := 0; -end; -{------------------------------------------------------------------------------} -destructor TZipKit.Destroy; -begin - FOwner.Free; - inherited Destroy; -end; -{------------------------------------------------------------------------------} - -initialization - TAutoObjectFactory.Create(ComServer, TZipKit, Class_ZipKit, ciMultiInstance, tmBoth); - - -end. diff --git a/components/Abbrevia/source/Win32/CarrylessRangeCoder.obj b/components/Abbrevia/source/Win32/CarrylessRangeCoder.obj deleted file mode 100644 index af43aa2..0000000 Binary files a/components/Abbrevia/source/Win32/CarrylessRangeCoder.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/LzFind.obj b/components/Abbrevia/source/Win32/LzFind.obj deleted file mode 100644 index 3247156..0000000 Binary files a/components/Abbrevia/source/Win32/LzFind.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/LzFindMt.obj b/components/Abbrevia/source/Win32/LzFindMt.obj deleted file mode 100644 index 53fab51..0000000 Binary files a/components/Abbrevia/source/Win32/LzFindMt.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/LzmaDec.obj b/components/Abbrevia/source/Win32/LzmaDec.obj deleted file mode 100644 index be5495d..0000000 Binary files a/components/Abbrevia/source/Win32/LzmaDec.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/LzmaEnc.obj b/components/Abbrevia/source/Win32/LzmaEnc.obj deleted file mode 100644 index 2a59d7e..0000000 Binary files a/components/Abbrevia/source/Win32/LzmaEnc.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/PPMdContext.obj b/components/Abbrevia/source/Win32/PPMdContext.obj deleted file mode 100644 index cc7e7fb..0000000 Binary files a/components/Abbrevia/source/Win32/PPMdContext.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/PPMdSubAllocatorVariantI.obj b/components/Abbrevia/source/Win32/PPMdSubAllocatorVariantI.obj deleted file mode 100644 index 8eaec33..0000000 Binary files a/components/Abbrevia/source/Win32/PPMdSubAllocatorVariantI.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/PPMdVariantI.obj b/components/Abbrevia/source/Win32/PPMdVariantI.obj deleted file mode 100644 index 1a700b7..0000000 Binary files a/components/Abbrevia/source/Win32/PPMdVariantI.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/Threads.obj b/components/Abbrevia/source/Win32/Threads.obj deleted file mode 100644 index ef9dc77..0000000 Binary files a/components/Abbrevia/source/Win32/Threads.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/blocksort.obj b/components/Abbrevia/source/Win32/blocksort.obj deleted file mode 100644 index 830650e..0000000 Binary files a/components/Abbrevia/source/Win32/blocksort.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/bzlib.obj b/components/Abbrevia/source/Win32/bzlib.obj deleted file mode 100644 index 4013c1d..0000000 Binary files a/components/Abbrevia/source/Win32/bzlib.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/compress.obj b/components/Abbrevia/source/Win32/compress.obj deleted file mode 100644 index 66247ae..0000000 Binary files a/components/Abbrevia/source/Win32/compress.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/decompress.obj b/components/Abbrevia/source/Win32/decompress.obj deleted file mode 100644 index 99acce1..0000000 Binary files a/components/Abbrevia/source/Win32/decompress.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/huffman.obj b/components/Abbrevia/source/Win32/huffman.obj deleted file mode 100644 index 9987cfa..0000000 Binary files a/components/Abbrevia/source/Win32/huffman.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_bits.obj b/components/Abbrevia/source/Win32/wv_bits.obj deleted file mode 100644 index f2224e9..0000000 Binary files a/components/Abbrevia/source/Win32/wv_bits.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_extra1.obj b/components/Abbrevia/source/Win32/wv_extra1.obj deleted file mode 100644 index c0ae7ea..0000000 Binary files a/components/Abbrevia/source/Win32/wv_extra1.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_extra2.obj b/components/Abbrevia/source/Win32/wv_extra2.obj deleted file mode 100644 index b2acba2..0000000 Binary files a/components/Abbrevia/source/Win32/wv_extra2.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_float.obj b/components/Abbrevia/source/Win32/wv_float.obj deleted file mode 100644 index db5dabe..0000000 Binary files a/components/Abbrevia/source/Win32/wv_float.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_metadata.obj b/components/Abbrevia/source/Win32/wv_metadata.obj deleted file mode 100644 index 569fb71..0000000 Binary files a/components/Abbrevia/source/Win32/wv_metadata.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_pack.obj b/components/Abbrevia/source/Win32/wv_pack.obj deleted file mode 100644 index d89acc9..0000000 Binary files a/components/Abbrevia/source/Win32/wv_pack.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_tags.obj b/components/Abbrevia/source/Win32/wv_tags.obj deleted file mode 100644 index 7f19daa..0000000 Binary files a/components/Abbrevia/source/Win32/wv_tags.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_unpack.obj b/components/Abbrevia/source/Win32/wv_unpack.obj deleted file mode 100644 index 3f3533f..0000000 Binary files a/components/Abbrevia/source/Win32/wv_unpack.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_unpack3.obj b/components/Abbrevia/source/Win32/wv_unpack3.obj deleted file mode 100644 index 66e33c6..0000000 Binary files a/components/Abbrevia/source/Win32/wv_unpack3.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_words.obj b/components/Abbrevia/source/Win32/wv_words.obj deleted file mode 100644 index 3bd3485..0000000 Binary files a/components/Abbrevia/source/Win32/wv_words.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win32/wv_wputils.obj b/components/Abbrevia/source/Win32/wv_wputils.obj deleted file mode 100644 index b9e606d..0000000 Binary files a/components/Abbrevia/source/Win32/wv_wputils.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/CarrylessRangeCoder.obj b/components/Abbrevia/source/Win64/CarrylessRangeCoder.obj deleted file mode 100644 index 108be30..0000000 Binary files a/components/Abbrevia/source/Win64/CarrylessRangeCoder.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/LzFind.obj b/components/Abbrevia/source/Win64/LzFind.obj deleted file mode 100644 index 5cffd4a..0000000 Binary files a/components/Abbrevia/source/Win64/LzFind.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/LzFindMt.obj b/components/Abbrevia/source/Win64/LzFindMt.obj deleted file mode 100644 index 5af6a24..0000000 Binary files a/components/Abbrevia/source/Win64/LzFindMt.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/LzmaDec.obj b/components/Abbrevia/source/Win64/LzmaDec.obj deleted file mode 100644 index 2eaf3ec..0000000 Binary files a/components/Abbrevia/source/Win64/LzmaDec.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/LzmaEnc.obj b/components/Abbrevia/source/Win64/LzmaEnc.obj deleted file mode 100644 index 9507567..0000000 Binary files a/components/Abbrevia/source/Win64/LzmaEnc.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/PPMdContext.obj b/components/Abbrevia/source/Win64/PPMdContext.obj deleted file mode 100644 index d0f8244..0000000 Binary files a/components/Abbrevia/source/Win64/PPMdContext.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/PPMdSubAllocatorVariantI.obj b/components/Abbrevia/source/Win64/PPMdSubAllocatorVariantI.obj deleted file mode 100644 index f3b358e..0000000 Binary files a/components/Abbrevia/source/Win64/PPMdSubAllocatorVariantI.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/PPMdVariantI.obj b/components/Abbrevia/source/Win64/PPMdVariantI.obj deleted file mode 100644 index 8b26c2d..0000000 Binary files a/components/Abbrevia/source/Win64/PPMdVariantI.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/Threads.obj b/components/Abbrevia/source/Win64/Threads.obj deleted file mode 100644 index dc70040..0000000 Binary files a/components/Abbrevia/source/Win64/Threads.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/blocksort.obj b/components/Abbrevia/source/Win64/blocksort.obj deleted file mode 100644 index f374153..0000000 Binary files a/components/Abbrevia/source/Win64/blocksort.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/bzlib.obj b/components/Abbrevia/source/Win64/bzlib.obj deleted file mode 100644 index bdcbe2c..0000000 Binary files a/components/Abbrevia/source/Win64/bzlib.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/compress.obj b/components/Abbrevia/source/Win64/compress.obj deleted file mode 100644 index eea55ff..0000000 Binary files a/components/Abbrevia/source/Win64/compress.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/decompress.obj b/components/Abbrevia/source/Win64/decompress.obj deleted file mode 100644 index 9327881..0000000 Binary files a/components/Abbrevia/source/Win64/decompress.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/huffman.obj b/components/Abbrevia/source/Win64/huffman.obj deleted file mode 100644 index 5b83cd9..0000000 Binary files a/components/Abbrevia/source/Win64/huffman.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_bits.obj b/components/Abbrevia/source/Win64/wv_bits.obj deleted file mode 100644 index 695de6f..0000000 Binary files a/components/Abbrevia/source/Win64/wv_bits.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_extra1.obj b/components/Abbrevia/source/Win64/wv_extra1.obj deleted file mode 100644 index f8f6f92..0000000 Binary files a/components/Abbrevia/source/Win64/wv_extra1.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_extra2.obj b/components/Abbrevia/source/Win64/wv_extra2.obj deleted file mode 100644 index bba85d4..0000000 Binary files a/components/Abbrevia/source/Win64/wv_extra2.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_float.obj b/components/Abbrevia/source/Win64/wv_float.obj deleted file mode 100644 index fb15e05..0000000 Binary files a/components/Abbrevia/source/Win64/wv_float.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_metadata.obj b/components/Abbrevia/source/Win64/wv_metadata.obj deleted file mode 100644 index 379b078..0000000 Binary files a/components/Abbrevia/source/Win64/wv_metadata.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_pack.obj b/components/Abbrevia/source/Win64/wv_pack.obj deleted file mode 100644 index ac2d3c6..0000000 Binary files a/components/Abbrevia/source/Win64/wv_pack.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_tags.obj b/components/Abbrevia/source/Win64/wv_tags.obj deleted file mode 100644 index 2bcfd9b..0000000 Binary files a/components/Abbrevia/source/Win64/wv_tags.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_unpack.obj b/components/Abbrevia/source/Win64/wv_unpack.obj deleted file mode 100644 index d022362..0000000 Binary files a/components/Abbrevia/source/Win64/wv_unpack.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_unpack3.obj b/components/Abbrevia/source/Win64/wv_unpack3.obj deleted file mode 100644 index 3b563a1..0000000 Binary files a/components/Abbrevia/source/Win64/wv_unpack3.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_words.obj b/components/Abbrevia/source/Win64/wv_words.obj deleted file mode 100644 index 1deac0b..0000000 Binary files a/components/Abbrevia/source/Win64/wv_words.obj and /dev/null differ diff --git a/components/Abbrevia/source/Win64/wv_wputils.obj b/components/Abbrevia/source/Win64/wv_wputils.obj deleted file mode 100644 index 7e62718..0000000 Binary files a/components/Abbrevia/source/Win64/wv_wputils.obj and /dev/null differ diff --git a/components/bgrabitmap/COPYING.LGPL.txt b/components/bgrabitmap/COPYING.LGPL.txt deleted file mode 100644 index 92b8903..0000000 --- a/components/bgrabitmap/COPYING.LGPL.txt +++ /dev/null @@ -1,481 +0,0 @@ - GNU LIBRARY GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1991 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -[This is the first released version of the library GPL. It is - numbered 2 because it goes with version 2 of the ordinary GPL.] - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Library General Public License, applies to some -specially designated Free Software Foundation software, and to any -other libraries whose authors decide to use it. You can use it for -your libraries, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if -you distribute copies of the library, or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link a program with the library, you must provide -complete object files to the recipients so that they can relink them -with the library, after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - Our method of protecting your rights has two steps: (1) copyright -the library, and (2) offer you this license which gives you legal -permission to copy, distribute and/or modify the library. - - Also, for each distributor's protection, we want to make certain -that everyone understands that there is no warranty for this free -library. If the library is modified by someone else and passed on, we -want its recipients to know that what they have is not the original -version, so that any problems introduced by others will not reflect on -the original authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that companies distributing free -software will individually obtain patent licenses, thus in effect -transforming the program into proprietary software. To prevent this, -we have made it clear that any patent must be licensed for everyone's -free use or not licensed at all. - - Most GNU software, including some libraries, is covered by the ordinary -GNU General Public License, which was designed for utility programs. This -license, the GNU Library General Public License, applies to certain -designated libraries. This license is quite different from the ordinary -one; be sure to read it in full, and don't assume that anything in it is -the same as in the ordinary license. - - The reason we have a separate public license for some libraries is that -they blur the distinction we usually make between modifying or adding to a -program and simply using it. Linking a program with a library, without -changing the library, is in some sense simply using the library, and is -analogous to running a utility program or application program. However, in -a textual and legal sense, the linked executable is a combined work, a -derivative of the original library, and the ordinary General Public License -treats it as such. - - Because of this blurred distinction, using the ordinary General -Public License for libraries did not effectively promote software -sharing, because most developers did not use the libraries. We -concluded that weaker conditions might promote sharing better. - - However, unrestricted linking of non-free programs would deprive the -users of those programs of all benefit from the free status of the -libraries themselves. This Library General Public License is intended to -permit developers of non-free programs to use free libraries, while -preserving your freedom as a user of such programs to change the free -libraries that are incorporated in them. (We have not seen how to achieve -this as regards changes in header files, but we have achieved it as regards -changes in the actual functions of the Library.) The hope is that this -will lead to faster development of free libraries. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, while the latter only -works together with the library. - - Note that it is possible for a library to be covered by the ordinary -General Public License rather than by this special one. - - GNU LIBRARY GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library which -contains a notice placed by the copyright holder or other authorized -party saying it may be distributed under the terms of this Library -General Public License (also called "this License"). Each licensee is -addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control compilation -and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - - 6. As an exception to the Sections above, you may also compile or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Accompany the work with a written offer, valid for at - least three years, to give the same user the materials - specified in Subsection 6a, above, for a charge no more - than the cost of performing this distribution. - - c) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - d) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the source code distributed need not include anything that is normally -distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under any -particular circumstance, the balance of the section is intended to apply, -and the section as a whole is intended to apply in other circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License may add -an explicit geographical distribution limitation excluding those countries, -so that distribution is permitted only in or among countries not thus -excluded. In such case, this License incorporates the limitation as if -written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Library General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. - - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms of the -ordinary General Public License). - - To apply these terms, attach the following notices to the library. It is -safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James Random Hacker. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! diff --git a/components/bgrabitmap/COPYING.modifiedLGPL.txt b/components/bgrabitmap/COPYING.modifiedLGPL.txt deleted file mode 100644 index 8fa8217..0000000 --- a/components/bgrabitmap/COPYING.modifiedLGPL.txt +++ /dev/null @@ -1,24 +0,0 @@ -This is the file COPYING.modifiedLGPL, it applies to all units of the -BGRABitmap library. - -These files are distributed under the Library GNU General Public License -(see the file COPYING.LGPL) with the following modification: - -As a special exception, the copyright holders of this library give you -permission to link this library with independent modules to produce an -executable, regardless of the license terms of these independent modules, -and to copy and distribute the resulting executable under terms of your choice, -provided that you also meet, for each linked independent module, the terms -and conditions of the license of that module. An independent module is a -module which is not derived from or based on this library. If you modify this -library, you may extend this exception to your version of the library, but -you are not obligated to do so. If you do not wish to do so, delete this -exception statement from your version. - - -If you didn't receive a copy of the file COPYING.LGPL, contact: - Free Software Foundation, Inc., - 675 Mass Ave - Cambridge, MA 02139 - USA - diff --git a/components/bgrabitmap/basiccolorspace.inc b/components/bgrabitmap/basiccolorspace.inc deleted file mode 100644 index 0e9ce01..0000000 --- a/components/bgrabitmap/basiccolorspace.inc +++ /dev/null @@ -1,1635 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type - {* Possible channels in a bitmap using any RGBA colorspace } - TChannel = (cRed, cGreen, cBlue, cAlpha); - {** Combination of channels } - TChannels = set of TChannel; - -const - TBGRAPixel_ChannelByteOffset : array[TChannel] of integer = - (TBGRAPixel_RedByteOffset, TBGRAPixel_GreenByteOffset, TBGRAPixel_BlueByteOffset, TBGRAPixel_AlphaByteOffset); - -{ Gamma conversion arrays. Should be used as readonly } -var - // TBGRAPixel -> TExpandedPixel - GammaExpansionTab: packed array[0..255] of word; - GammaExpansionTabHalf: packed array[0..254] of word; - - // TExpandedPixel -> TBGRAPixel - GammaCompressionTab : packed array[0..65535] of byte; //rounded value - -procedure BGRASetGamma(AGamma: single = 1.7); -function BGRAGetGamma: single; - -type - PExpandedPixel = ^TExpandedPixel; - { TExpandedPixel } - {* Stores a gamma expanded RGB color. Values range from 0 to 65535 } - TExpandedPixel = packed record - red, green, blue, alpha: word; - end; - TExpandedPixelBuffer = packed array of TExpandedPixel; - - procedure AllocateExpandedPixelBuffer(var ABuffer: TExpandedPixelBuffer; ASize: integer); - - {** Converts a pixel from sRGB to gamma expanded RGB } - function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline; - {** Converts a pixel from gamma expanded RGB to sRGB } - function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; inline; overload; - {** Converts a pixel from gamma expanded RGB to sRGB } - function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline; overload; - {** Apply gamma compression with word values } - function GammaCompressionW(AExpanded: word): word; - {** Apply gamma expansion with word values } - function GammaExpansionW(ACompressed: word): word; - {** Returns the intensity of an gamma-expanded pixel. The intensity is the - maximum value reached by any component } - function GetIntensity(const c: TExpandedPixel): word; inline; - {** Sets the intensity of a gamma-expanded pixel } - function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel; - {** Returns the lightness of an gamma-expanded pixel. The lightness is the - perceived brightness, 0 being black and 65535 being white } - function GetLightness(const c: TExpandedPixel): word; inline; overload; - {** Sets the lightness of a gamma-expanded pixel } - function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel; overload; - {** Sets the lightness of a gamma expanded pixel, provided you already know the current - value of lightness ''curLightness''. It is a bit faster than the previous function } - function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel; overload; - {** Returns the importance of the color. It is similar to saturation - in HSL colorspace, except it is gamma corrected. A value of zero indicates - a black/gray/white, and a value of 65535 indicates a bright color } - function ColorImportance(ec: TExpandedPixel): word; - {** Merge two gamma expanded pixels (so taking into account gamma correction) } - function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; overload; - function MergeBGRA(ec1: TExpandedPixel; weight1: integer; ec2: TExpandedPixel; weight2: integer): TExpandedPixel; overload; - {** Computes the difference (with gamma correction) between two pixels, - taking into account all dimensions, including transparency. The - result ranges from 0 to 65535 } - function ExpandedDiff(ec1, ec2: TExpandedPixel): word; - - function FPColorToExpanded(AColor: TFPColor; AGammaExpansion: boolean=true): TExpandedPixel; - function ExpandedToFPColor(AExpanded: TExpandedPixel; AGammaCompression: boolean=true): TFPColor; - -type - {* General purpose color variable with single-precision floating point values } - TColorF = packed array[1..4] of single; - ArrayOfTColorF = array of TColorF; - - {** Creates a TColorF structure } - function ColorF(red,green,blue,alpha: single): TColorF; - function BGRAToColorF(c: TBGRAPixel; AGammaExpansion: boolean): TColorF; overload; - function BGRAToColorF(const a: array of TBGRAPixel; AGammaExpansion: boolean): ArrayOfTColorF; overload; - function ColorFToBGRA(c: TColorF; AGammaCompression: boolean): TBGRAPixel; - function GammaCompressionF(c: TColorF): TColorF; - function GammaExpansionF(c: TColorF): TColorF; - {** Subtract each component separately } - operator - (const c1, c2: TColorF): TColorF; inline; - {** Add each component separately } - operator + (const c1, c2: TColorF): TColorF; inline; - {** Multiply each component separately } - operator * (const c1, c2: TColorF): TColorF; inline; - {** Multiply each component by ''factor'' } - operator * (const c1: TColorF; factor: single): TColorF; inline; - -type - {* Pixel color defined in HSL colorspace. Values range from 0 to 65535 } - - { THSLAPixel } - - THSLAPixel = packed record - {** Hue of the pixel. Extremum values 0 and 65535 are red } - hue: word; - {** Saturation of the color. 0 is gray and 65535 is the brightest color (including white) } - saturation: word; - {** Lightness of the color. 0 is black, 32768 is normal, and 65535 is white } - lightness: word; - {** Opacity of the pixel. 0 is transparent and 65535 is opaque } - alpha: word; - end; - - {** Creates a pixel with given HSLA values, where A stands for alpha } - function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel; overload; inline; - {** Creates an opaque pixel with given HSL values } - function HSLA(hue, saturation, lightness: word): THSLAPixel; overload; inline; - {** Converts a pixel from sRGB to HSL color space } - function BGRAToHSLA(c: TBGRAPixel): THSLAPixel; - {** Converts a pixel from gamma expanded RGB to HSL color space } - function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel; - {** Converts a pixel from HSL colorspace to sRGB } - function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel; - {** Converts a pixel from HSL colorspace to gamma expanded RGB } - function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel; - {** Computes the hue difference } - function HueDiff(h1, h2: word): word; - {** Returns the hue of a gamma expanded pixel } - function GetHue(ec: TExpandedPixel): word; - -type - {* Pixel color defined in corrected HSL colorspace. G stands for corrected hue - and B stands for actual brightness. Values range from 0 to 65535 } - TGSBAPixel = packed record - {** Hue of the pixel. Extremum values 0 and 65535 are red } - hue: word; - {** Saturation of the color. 0 is gray and 65535 is the brightest color (excluding white) } - saturation: word; - {** Actual perceived brightness. 0 is black, 32768 is normal, and 65535 is white } - lightness: word; - {** Opacity of the pixel. 0 is transparent and 65535 is opaque } - alpha: word; - end; - - {** Converts a pixel from sRGB to correct HSL color space } - function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel; - {** Converts a pixel from gamma expanded RGB to correct HSL color space } - function ExpandedToGSBA(const ec: TExpandedPixel): TGSBAPixel; - {** Converts a G hue (GSBA) to a H hue (HSLA) } - function GtoH(ghue: word): word; - {** Converts a H hue (HSLA) to a G hue (GSBA) } - function HtoG(hue: word): word; - {** Converts a pixel from corrected HSL to sRGB } - function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel; overload; - function GSBAToBGRA(const c: THSLAPixel): TBGRAPixel; overload; - {** Converts a pixel from correct HSL to gamma expanded RGB } - function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel; overload; - function GSBAToExpanded(const c: THSLAPixel): TExpandedPixel; overload; - {** Converts a pixel from correct HSL to usual HSL } - function GSBAToHSLA(const c: TGSBAPixel): THSLAPixel; overload; - function GSBAToHSLA(const c: THSLAPixel): THSLAPixel; overload; - function HSLAToGSBA(const c: THSLAPixel): TGSBAPixel; - -type - { TBGRAPixelBasicHelper } - - TBGRAPixelBasicHelper = record helper for TBGRAPixel - function ToExpanded: TExpandedPixel; - procedure FromExpanded(const AValue: TExpandedPixel); - function ToHSLAPixel: THSLAPixel; - procedure FromHSLAPixel(const AValue: THSLAPixel); - function ToGSBAPixel: TGSBAPixel; - procedure FromGSBAPixel(const AValue: TGSBAPixel); overload; - procedure FromGSBAPixel(const AValue: THSLAPixel); overload; - function ToColorF(AGammaExpansion: boolean): TColorF; - procedure FromColorF(const AValue: TColorF; AGammaCompression: boolean); - end; - - { TExpandedPixelBasicHelper } - - TExpandedPixelBasicHelper = record helper for TExpandedPixel - function ToFPColor(AGammaCompression: boolean = true): TFPColor; - procedure FromFPColor(const AValue: TFPColor; AGammaExpansion: boolean = true); - function ToColor: TColor; - procedure FromColor(const AValue: TColor); - function ToBGRAPixel: TBGRAPixel; - procedure FromBGRAPixel(AValue: TBGRAPixel); - function ToHSLAPixel: THSLAPixel; - procedure FromHSLAPixel(const AValue: THSLAPixel); - function ToGSBAPixel: TGSBAPixel; - procedure FromGSBAPixel(const AValue: TGSBAPixel); overload; - procedure FromGSBAPixel(const AValue: THSLAPixel); overload; - end; - -operator := (const AValue: TExpandedPixel): TColor; -operator := (const AValue: TColor): TExpandedPixel; -Operator := (const Source: TExpandedPixel): TBGRAPixel; -Operator := (const Source: TBGRAPixel): TExpandedPixel; - -type - { TFPColorBasicHelper } - - TFPColorBasicHelper = record helper for TFPColor - function ToColor: TColor; - procedure FromColor(const AValue: TColor); - function ToBGRAPixel: TBGRAPixel; - procedure FromBGRAPixel(AValue: TBGRAPixel); - function ToExpanded(AGammaExpansion: boolean = true): TExpandedPixel; - procedure FromExpanded(const AValue: TExpandedPixel; AGammaCompression: boolean = true); - function ToHSLAPixel(AGammaExpansion: boolean = true): THSLAPixel; - procedure FromHSLAPixel(const AValue: THSLAPixel; AGammaCompression: boolean = true); - function ToGSBAPixel(AGammaExpansion: boolean = true): TGSBAPixel; - procedure FromGSBAPixel(const AValue: TGSBAPixel; AGammaCompression: boolean = true); overload; - procedure FromGSBAPixel(const AValue: THSLAPixel; AGammaCompression: boolean = true); overload; - end; - - { THSLAPixelBasicHelper } - - THSLAPixelBasicHelper = record helper for THSLAPixel - function ToColor: TColor; - procedure FromColor(const AValue: TColor); - function ToBGRAPixel: TBGRAPixel; - procedure FromBGRAPixel(AValue: TBGRAPixel); - function ToGSBAPixel: TGSBAPixel; - procedure FromGSBAPixel(AValue: TGSBAPixel); - function ToExpanded: TExpandedPixel; - procedure FromExpanded(AValue: TExpandedPixel); - function ToFPColor(AGammaCompression: boolean=true): TFPColor; - procedure FromFPColor(AValue: TFPColor; AGammaExpansion: boolean=true); - end; - -Operator := (const Source: THSLAPixel): TBGRAPixel; -Operator := (const Source: TBGRAPixel): THSLAPixel; -Operator := (const Source: THSLAPixel): TExpandedPixel; -Operator := (const Source: TExpandedPixel): THSLAPixel; -operator := (const AValue: TColor): THSLAPixel; -operator := (const AValue: THSLAPixel): TColor; - -type - { TGSBAPixelBasicHelper } - - TGSBAPixelBasicHelper = record helper for TGSBAPixel - function ToColor: TColor; - procedure FromColor(const AValue: TColor); - function ToBGRAPixel: TBGRAPixel; - procedure FromBGRAPixel(AValue: TBGRAPixel); - function ToHSLAPixel: THSLAPixel; - procedure FromHSLAPixel(AValue: THSLAPixel); - function ToExpanded: TExpandedPixel; - procedure FromExpanded(AValue: TExpandedPixel); - function ToFPColor(AGammaCompression: boolean=true): TFPColor; - procedure FromFPColor(AValue: TFPColor; AGammaExpansion: boolean=true); - end; - -Operator := (const Source: TGSBAPixel): TBGRAPixel; -Operator := (const Source: TBGRAPixel): TGSBAPixel; -Operator := (const Source: TGSBAPixel): TExpandedPixel; -Operator := (const Source: TExpandedPixel): TGSBAPixel; -operator := (const AValue: TColor): TGSBAPixel; -operator := (const AValue: TGSBAPixel): TColor; -Operator := (const Source: TGSBAPixel): THSLAPixel; //no conversion, just copying for backward compatibility (use ToHSLAPixel instead for conversion) -Operator := (const Source: THSLAPixel): TGSBAPixel; //no conversion, just copying for backward compatibility (use ToGSBAPixel instead for conversion) -{$ENDIF} - - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} -{ TBGRAPixel } - -function TBGRAPixel.GetClassIntensity: word; -begin - result := GetIntensity(self); -end; - -function TBGRAPixel.GetClassLightness: word; -begin - result := GetLightness(self); -end; - -procedure TBGRAPixel.SetClassIntensity(AValue: word); -begin - self := SetIntensity(self, AValue); -end; - -procedure TBGRAPixel.SetClassLightness(AValue: word); -begin - self := SetLightness(self, AValue); -end; - -procedure TBGRAPixel.FromRGB(ARed, AGreen, ABlue: Byte; AAlpha: Byte); -begin - red := ARed; - green := AGreen; - blue := ABlue; - alpha := AAlpha; -end; - -procedure TBGRAPixel.FromColor(AColor: TColor; AAlpha: Byte); -begin - if AColor = clNone then - Self := BGRAPixelTransparent - else - begin - RedGreenBlue(ColorToRGB(AColor), red,green,blue); - alpha := AAlpha; - end; -end; - -procedure TBGRAPixel.FromString(AStr: string); -begin - Self := StrToBGRA(AStr); -end; - -procedure TBGRAPixel.FromFPColor(AColor: TFPColor); -begin - self := FPColorToBGRA(AColor); -end; - -procedure TBGRAPixel.ToRGB(out ARed, AGreen, ABlue, AAlpha: Byte); -begin - ARed := red; - AGreen := green; - ABlue := blue; - AAlpha := alpha; -end; - -procedure TBGRAPixel.ToRGB(out ARed, AGreen, ABlue: Byte); -begin - ARed := red; - AGreen := green; - ABlue := blue -end; - -function TBGRAPixel.ToColor: TColor; -begin - if alpha = 0 then - result := clNone - else - result := RGBToColor(red,green,blue); -end; - -function TBGRAPixel.ToString: string; -begin - result := BGRAToStr(Self, CSSColors); -end; - -function TBGRAPixel.ToGrayscale(AGammaCorrection: boolean): TBGRAPixel; -begin - if AGammaCorrection then - result := BGRAToGrayscale(self) - else - result := BGRAToGrayscaleLinear(self); -end; - -function TBGRAPixel.ToFPColor: TFPColor; -begin - result := BGRAToFPColor(Self); -end; - -function TBGRAPixel.EqualsExactly(constref AColor: TBGRAPixel): boolean; -begin - result := PLongWord(@AColor)^ = PLongWord(@self)^; -end; - -class operator TBGRAPixel.:=(Source: TBGRAPixel): TColor; -begin - result := Source.ToColor; -end; - -class operator TBGRAPixel.:=(Source: TColor): TBGRAPixel; -begin - result.FromColor(Source); -end; - -{ The gamma correction is approximated here by a power function } -var - GammaExpFactor : single; //exponent - -const - redWeightShl10 = 306; // = 0.299 - greenWeightShl10 = 601; // = 0.587 - blueWeightShl10 = 117; // = 0.114 - -procedure BGRANoGamma; -var i,j: integer; - prevExp, nextExp: Word; -begin - GammaExpFactor := 1; - prevExp := 0; - for i := 0 to 255 do - begin - GammaExpansionTab[i] := (i shl 8) + i; - if i = 255 then nextExp := 65535 - else - begin - nextExp := GammaExpansionTab[i]+128; - GammaExpansionTabHalf[i] := nextExp+1; - end; - for j := prevExp to nextExp do - GammaCompressionTab[j] := i; - if i < 255 then - prevExp := nextExp+1; - end; -end; - -procedure BGRASetGamma(AGamma: single); -var - GammaLinearFactor: single; - i,j,prevpos,nextpos,midpos: Int32or64; -begin - if AGamma = 1 then - begin - BGRANoGamma; - exit; - end; - GammaExpFactor := AGamma; - //the linear factor is used to normalize expanded values in the range 0..65535 - GammaLinearFactor := 65535 / power(255, GammaExpFactor); - GammaExpansionTab[0] := 0; - nextpos := 0; - for i := 0 to 255 do - begin - prevpos := nextpos; - midpos := round(power(i, GammaExpFactor) * GammaLinearFactor); - if i = 255 then - nextpos := 65536 - else - nextpos := round(power(i+0.5, GammaExpFactor) * GammaLinearFactor); - GammaExpansionTab[i] := midpos; - if i < 255 then - GammaExpansionTabHalf[i] := nextpos; - for j := prevpos to midpos-1 do - GammaCompressionTab[j] := i; - for j := midpos to nextpos-1 do - GammaCompressionTab[j] := i; - end; - GammaCompressionTab[0] := 0; -end; - -function BGRAGetGamma: single; -begin - result := GammaExpFactor; -end; - -procedure AllocateExpandedPixelBuffer(var ABuffer: TExpandedPixelBuffer; - ASize: integer); -begin - if ASize > length(ABuffer) then - setlength(ABuffer, max(length(ABuffer)*2,ASize)); -end; - -{ Apply gamma correction using conversion tables } -function GammaExpansion(c: TBGRAPixel): TExpandedPixel; -begin - Result.red := GammaExpansionTab[c.red]; - Result.green := GammaExpansionTab[c.green]; - Result.blue := GammaExpansionTab[c.blue]; - Result.alpha := c.alpha shl 8 + c.alpha; -end; - -function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; -begin - Result.red := GammaCompressionTab[ec.red]; - Result.green := GammaCompressionTab[ec.green]; - Result.blue := GammaCompressionTab[ec.blue]; - Result.alpha := ec.alpha shr 8; -end; - -function GammaCompression(red, green, blue, alpha: word): TBGRAPixel; -begin - Result.red := GammaCompressionTab[red]; - Result.green := GammaCompressionTab[green]; - Result.blue := GammaCompressionTab[blue]; - Result.alpha := alpha shr 8; -end; - -function GammaExpansionW(ACompressed: word): word; -const - fracShift = 8; - fracHalf = 1 shl (fracShift-1); - fracQuarter = 1 shl (fracShift-2); -var - intPart, fracPart, half: word; - byteVal: byte; -begin - if ACompressed = 0 then - result := 0 - else if ACompressed = $ffff then - result := $ffff - else - begin - //div 257 - byteVal := ACompressed shr fracShift; - intPart := (byteVal shl fracShift) + byteVal; - if ACompressed < intPart then - begin - dec(byteVal); - dec(intPart, 257); - end; - - fracPart := ACompressed - intPart; - if fracPart >= fracHalf then dec(fracPart); //[0..256] -> [0..255] - - if fracPart >= fracHalf then - begin - result := GammaExpansionTab[byteVal+1]; - half := GammaExpansionTabHalf[byteVal]; - dec(result, ((result-half)*((1 shl fracShift)-fracPart)+fracQuarter) shr (fracShift-1)); - end - else - begin - result := GammaExpansionTab[byteVal]; - if fracPart > 0 then - begin - half := GammaExpansionTabHalf[byteVal]; - inc(result, ((half-result)*fracPart+fracQuarter) shr (fracShift-1)); - end; - end; - end; -end; - -function GammaCompressionW(AExpanded: word): word; -var - compByte: Byte; - reExp, reExpDelta: Word; -begin - if AExpanded=0 then exit(0) else - if AExpanded=65535 then exit(65535) else - begin - compByte := GammaCompressionTab[AExpanded]; - reExp := GammaExpansionTab[compByte]; - result := compByte + (compByte shl 8); - if reExp < AExpanded then - begin - reExpDelta := GammaExpansionTabHalf[compByte]-reExp; - if reExpDelta<>0 then - inc(result, ((AExpanded-reExp)*128+(reExpDelta shr 1)) div reExpDelta); - end else - begin - reExpDelta := reExp-GammaExpansionTabHalf[compByte-1]; - if reExpDelta<>0 then - dec(result, ((reExp-AExpanded)*128+(reExpDelta shr 1)) div reExpDelta); - end; - end; -end; - -{ The intensity is defined here as the maximum value of any color component } -function GetIntensity(const c: TExpandedPixel): word; inline; -begin - Result := c.red; - if c.green > Result then - Result := c.green; - if c.blue > Result then - Result := c.blue; -end; - -function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel; -var - curIntensity: word; -begin - curIntensity := GetIntensity(c); - if curIntensity = 0 then //suppose it's gray if there is no color information - begin - Result.red := intensity; - Result.green := intensity; - Result.blue := intensity; - result.alpha := c.alpha; - end - else - begin - //linear interpolation to reached wanted intensity - Result.red := (c.red * intensity + (curIntensity shr 1)) div curIntensity; - Result.green := (c.green * intensity + (curIntensity shr 1)) div curIntensity; - Result.blue := (c.blue * intensity + (curIntensity shr 1)) div curIntensity; - Result.alpha := c.alpha; - end; -end; - -{ The lightness here is defined as the subjective sensation of luminosity, where - blue is the darkest component and green the lightest } -function GetLightness(const c: TExpandedPixel): word; inline; -begin - Result := (c.red * redWeightShl10 + c.green * greenWeightShl10 + - c.blue * blueWeightShl10 + 512) shr 10; -end; - -function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel; -var - curLightness: word; -begin - curLightness := GetLightness(c); - if lightness = curLightness then - begin //no change - Result := c; - exit; - end; - result := SetLightness(c, lightness, curLightness); -end; - -function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel; -var - AddedWhiteness, maxBeforeWhite: word; - clip: boolean; -begin - if lightness = curLightness then - begin //no change - Result := c; - exit; - end; - if lightness = 65535 then //set to white - begin - Result.red := 65535; - Result.green := 65535; - Result.blue := 65535; - Result.alpha := c.alpha; - exit; - end; - if lightness = 0 then //set to black - begin - Result.red := 0; - Result.green := 0; - Result.blue := 0; - Result.alpha := c.alpha; - exit; - end; - if curLightness = 0 then //set from black - begin - Result.red := lightness; - Result.green := lightness; - Result.blue := lightness; - Result.alpha := c.alpha; - exit; - end; - if lightness < curLightness then //darker is easy - begin - result.alpha:= c.alpha; - result.red := (c.red * lightness + (curLightness shr 1)) div curLightness; - result.green := (c.green * lightness + (curLightness shr 1)) div curLightness; - result.blue := (c.blue * lightness + (curLightness shr 1)) div curLightness; - exit; - end; - //lighter and grayer - Result := c; - AddedWhiteness := lightness - curLightness; - maxBeforeWhite := 65535 - AddedWhiteness; - clip := False; - if Result.red <= maxBeforeWhite then - Inc(Result.red, AddedWhiteness) - else - begin - Result.red := 65535; - clip := True; - end; - if Result.green <= maxBeforeWhite then - Inc(Result.green, AddedWhiteness) - else - begin - Result.green := 65535; - clip := True; - end; - if Result.blue <= maxBeforeWhite then - Inc(Result.blue, AddedWhiteness) - else - begin - Result.blue := 65535; - clip := True; - end; - - if clip then //light and whiter - begin - curLightness := GetLightness(Result); - addedWhiteness := lightness - curLightness; - maxBeforeWhite := 65535 - curlightness; - Result.red := Result.red + addedWhiteness * (65535 - Result.red) div - maxBeforeWhite; - Result.green := Result.green + addedWhiteness * (65535 - Result.green) div - maxBeforeWhite; - Result.blue := Result.blue + addedWhiteness * (65535 - Result.blue) div - maxBeforeWhite; - end; -end; - -function ColorImportance(ec: TExpandedPixel): word; -var min,max: word; -begin - min := ec.red; - max := ec.red; - if ec.green > max then - max := ec.green - else - if ec.green < min then - min := ec.green; - if ec.blue > max then - max := ec.blue - else - if ec.blue < min then - min := ec.blue; - result := max - min; -end; - -{ Merge two colors of same importance } -function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; -var c12: LongWord; -begin - if (ec1.alpha = 0) then - Result := ec2 - else - if (ec2.alpha = 0) then - Result := ec1 - else - begin - c12 := ec1.alpha + ec2.alpha; - Result.red := (int64(ec1.red) * ec1.alpha + int64(ec2.red) * ec2.alpha + c12 shr 1) div c12; - Result.green := (int64(ec1.green) * ec1.alpha + int64(ec2.green) * ec2.alpha + c12 shr 1) div c12; - Result.blue := (int64(ec1.blue) * ec1.alpha + int64(ec2.blue) * ec2.alpha + c12 shr 1) div c12; - Result.alpha := (c12 + 1) shr 1; - end; -end; - -function MergeBGRA(ec1: TExpandedPixel; weight1: integer; ec2: TExpandedPixel; - weight2: integer): TExpandedPixel; -var - f1,f2,f12: int64; -begin - if (weight1 = 0) then - begin - if (weight2 = 0) then - result := BGRAPixelTransparent - else - Result := ec2 - end - else - if (weight2 = 0) then - Result := ec1 - else - if (weight1+weight2 = 0) then - Result := BGRAPixelTransparent - else - begin - f1 := int64(ec1.alpha)*weight1; - f2 := int64(ec2.alpha)*weight2; - f12 := f1+f2; - if f12 = 0 then - result := BGRAPixelTransparent - else - begin - Result.red := (ec1.red * f1 + ec2.red * f2 + f12 shr 1) div f12; - Result.green := (ec1.green * f1 + ec2.green * f2 + f12 shr 1) div f12; - Result.blue := (ec1.blue * f1 + ec2.blue * f2 + f12 shr 1) div f12; - {$hints off} - Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2); - {$hints on} - end; - end; -end; - -function LessStartSlope65535(value: word): word; -var factor: word; -begin - factor := 4096 - (not value)*3 shr 7; - result := value*factor shr 12; -end; - -function ExpandedDiff(ec1, ec2: TExpandedPixel): word; -var - CompRedAlpha1, CompGreenAlpha1, CompBlueAlpha1, CompRedAlpha2, - CompGreenAlpha2, CompBlueAlpha2: integer; - DiffAlpha: word; - ColorDiff: word; - TempHueDiff: word; -begin - if (ec1.alpha = 0) and (ec2.alpha = 0) then exit(0) else - if (ec1.alpha = ec2.alpha) and (ec1.red = ec2.red) and - (ec1.green = ec2.green) and (ec1.blue = ec2.blue) then exit(0); - CompRedAlpha1 := ec1.red * ec1.alpha shr 16; //gives 0..65535 - CompGreenAlpha1 := ec1.green * ec1.alpha shr 16; - CompBlueAlpha1 := ec1.blue * ec1.alpha shr 16; - CompRedAlpha2 := ec2.red * ec2.alpha shr 16; - CompGreenAlpha2 := ec2.green * ec2.alpha shr 16; - CompBlueAlpha2 := ec2.blue * ec2.alpha shr 16; - Result := (Abs(CompRedAlpha2 - CompRedAlpha1)*redWeightShl10 + - Abs(CompBlueAlpha2 - CompBlueAlpha1)*blueWeightShl10 + - Abs(CompGreenAlpha2 - CompGreenAlpha1)*greenWeightShl10) shr 10; - ColorDiff := min(ColorImportance(ec1),ColorImportance(ec2)); - if ColorDiff > 0 then - begin - TempHueDiff := HueDiff(HtoG(GetHue(ec1)),HtoG(GetHue(ec2))); - if TempHueDiff < 32768 then - TempHueDiff := LessStartSlope65535(TempHueDiff shl 1) shr 4 - else - TempHueDiff := TempHueDiff shr 3; - Result := ((Result shr 4)* (not ColorDiff) + TempHueDiff*ColorDiff) shr 12; - end; - DiffAlpha := Abs(integer(ec2.Alpha) - integer(ec1.Alpha)); - if DiffAlpha > Result then - Result := DiffAlpha; -end; - -function FPColorToExpanded(AColor: TFPColor; AGammaExpansion: boolean): TExpandedPixel; -begin - result.FromFPColor(AColor, AGammaExpansion); -end; - -function ExpandedToFPColor(AExpanded: TExpandedPixel; AGammaCompression: boolean): TFPColor; -begin - result.FromExpanded(AExpanded, AGammaCompression); -end; - -function ColorF(red, green, blue, alpha: single): TColorF; -begin - result[1] := red; - result[2] := green; - result[3] := blue; - result[4] := alpha; -end; - -function BGRAToColorF(c: TBGRAPixel; AGammaExpansion: boolean): TColorF; -const OneOver255 = 1/255; - OneOver65535 = 1/65535; -begin - if not AGammaExpansion then - begin - result[1] := c.red*OneOver255; - result[2] := c.green*OneOver255; - result[3] := c.blue*OneOver255; - result[4] := c.alpha*OneOver255; - end else - with GammaExpansion(c) do - begin - result[1] := red*OneOver65535; - result[2] := green*OneOver65535; - result[3] := blue*OneOver65535; - result[4] := alpha*OneOver65535; - end; -end; - -function BGRAToColorF(const a: array of TBGRAPixel; AGammaExpansion: boolean - ): ArrayOfTColorF; -var - i: Int32or64; -begin - setlength(result, length(a)); - for i := 0 to high(a) do - result[i] := BGRAToColorF(a[i],AGammaExpansion); -end; - -function ColorFToBGRA(c: TColorF; AGammaCompression: boolean): TBGRAPixel; -begin - if not AGammaCompression then - begin - result.red := Min(255,Max(0,round(c[1]*255))); - result.green := Min(255,Max(0,round(c[2]*255))); - result.blue := Min(255,Max(0,round(c[3]*255))); - end else - begin - result.red := GammaCompressionTab[Min(65535,Max(0,round(c[1]*65535)))]; - result.green := GammaCompressionTab[Min(65535,Max(0,round(c[2]*65535)))]; - result.blue := GammaCompressionTab[Min(65535,Max(0,round(c[3]*65535)))]; - end; - result.alpha := Min(255,Max(0,round(c[4]*255))); -end; - -function GammaCompressionF(c: TColorF): TColorF; -var inv: single; -begin - inv := 1/GammaExpFactor; - result := ColorF(power(c[1],inv),power(c[2],inv),power(c[3],inv),c[4]); -end; - -function GammaExpansionF(c: TColorF): TColorF; -begin - result := ColorF(power(c[1],GammaExpFactor),power(c[2],GammaExpFactor),power(c[3],GammaExpFactor),c[4]); -end; - -operator-(const c1, c2: TColorF): TColorF; -begin - result[1] := c1[1]-c2[1]; - result[2] := c1[2]-c2[2]; - result[3] := c1[3]-c2[3]; - result[4] := c1[4]-c2[4]; -end; - -operator+(const c1, c2: TColorF): TColorF; -begin - result[1] := c1[1]+c2[1]; - result[2] := c1[2]+c2[2]; - result[3] := c1[3]+c2[3]; - result[4] := c1[4]+c2[4]; -end; - -operator*(const c1, c2: TColorF): TColorF; -begin - result[1] := c1[1]*c2[1]; - result[2] := c1[2]*c2[2]; - result[3] := c1[3]*c2[3]; - result[4] := c1[4]*c2[4]; -end; - -operator*(const c1: TColorF; factor: single): TColorF; -begin - result[1] := c1[1]*factor; - result[2] := c1[2]*factor; - result[3] := c1[3]*factor; - result[4] := c1[4]*factor; -end; - -{ THSLAPixel } - -function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel; -begin - Result.hue := hue; - Result.saturation := saturation; - Result.lightness := lightness; - Result.alpha := alpha; -end; - -function HSLA(hue, saturation, lightness: word): THSLAPixel; -begin - Result.hue := hue; - Result.saturation := saturation; - Result.lightness := lightness; - Result.alpha := $ffff; -end; - -{ Conversion from RGB value to HSL colorspace. See : http://en.wikipedia.org/wiki/HSL_color_space } -function BGRAToHSLA(c: TBGRAPixel): THSLAPixel; -begin - result := ExpandedToHSLA(GammaExpansion(c)); -end; - -procedure ExpandedToHSLAInline(r,g,b: Int32Or64; var dest: THSLAPixel); inline; -const - deg60 = 10922; - deg120 = 21845; - deg240 = 43690; -var - min, max, minMax: Int32or64; - UMinMax,UTwiceLightness: UInt32or64; -begin - if g > r then - begin - max := g; - min := r; - end else - begin - max := r; - min := g; - end; - if b > max then - max := b else - if b < min then - min := b; - minMax := max - min; - - if minMax = 0 then - dest.hue := 0 - else - if max = r then - {$PUSH}{$RANGECHECKS OFF} - dest.hue := ((g - b) * deg60) div minMax - {$POP} - else - if max = g then - dest.hue := ((b - r) * deg60) div minMax + deg120 - else - {max = b} dest.hue := ((r - g) * deg60) div minMax + deg240; - UTwiceLightness := max + min; - if min = max then - dest.saturation := 0 else - begin - UMinMax:= minMax; - if UTwiceLightness < 65536 then - dest.saturation := (UMinMax shl 16) div (UTwiceLightness + 1) - else - dest.saturation := (UMinMax shl 16) div (131072 - UTwiceLightness); - end; - dest.lightness := UTwiceLightness shr 1; -end; - -function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel; -begin - result.alpha := ec.alpha; - ExpandedToHSLAInline(ec.red,ec.green,ec.blue,result); -end; - -{ Conversion from HSL colorspace to RGB. See : http://en.wikipedia.org/wiki/HSL_color_space } -function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel; -var ec: TExpandedPixel; -begin - ec := HSLAToExpanded(c); - Result := GammaCompression(ec); -end; - -function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel; -const - deg30 = 4096; - deg60 = 8192; - deg120 = deg60 * 2; - deg180 = deg60 * 3; - deg240 = deg60 * 4; - deg360 = deg60 * 6; - - function ComputeColor(p, q: Int32or64; h: Int32or64): Int32or64; inline; - begin - if h < deg180 then - begin - if h < deg60 then - Result := p + ((q - p) * h + deg30) div deg60 - else - Result := q - end else - begin - if h < deg240 then - Result := p + ((q - p) * (deg240 - h) + deg30) div deg60 - else - Result := p; - end; - end; - -var - q, p, L, S, H: Int32or64; -begin - L := c.lightness; - S := c.saturation; - if S = 0 then //gray - begin - result.red := L; - result.green := L; - result.blue := L; - result.alpha := c.alpha; - exit; - end; - {$hints off} - if L < 32768 then - q := (L shr 1) * ((65535 + S) shr 1) shr 14 - else - q := L + S - ((L shr 1) * - (S shr 1) shr 14); - {$hints on} - if q > 65535 then q := 65535; - p := (L shl 1) - q; - if p > 65535 then p := 65535; - H := c.hue * deg360 shr 16; - result.green := ComputeColor(p, q, H); - inc(H, deg120); - if H > deg360 then Dec(H, deg360); - result.red := ComputeColor(p, q, H); - inc(H, deg120); - if H > deg360 then Dec(H, deg360); - result.blue := ComputeColor(p, q, H); - result.alpha := c.alpha; -end; - -function HueDiff(h1, h2: word): word; -begin - result := abs(integer(h1)-integer(h2)); - if result > 32768 then result := 65536-result; -end; - -function GetHue(ec: TExpandedPixel): word; -const - deg60 = 8192; - deg120 = deg60 * 2; - deg240 = deg60 * 4; - deg360 = deg60 * 6; -var - min, max, minMax: integer; - r,g,b: integer; -begin - r := ec.red; - g := ec.green; - b := ec.blue; - min := r; - max := r; - if g > max then - max := g - else - if g < min then - min := g; - if b > max then - max := b - else - if b < min then - min := b; - minMax := max - min; - - if minMax = 0 then - Result := 0 - else - if max = r then - Result := (((g - b) * deg60) div - minMax + deg360) mod deg360 - else - if max = g then - Result := ((b - r) * deg60) div minMax + deg120 - else - {max = b} Result := - ((r - g) * deg60) div minMax + deg240; - - Result := (Result shl 16) div deg360; //normalize -end; - -{ TGSBAPixel } - -function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel; -var - ec: TExpandedPixel; -begin - ec := GammaExpansion(c); - result := ExpandedToGSBA(ec); -end; - -function ExpandedToGSBA(const ec: TExpandedPixel): TGSBAPixel; -var lightness: UInt32Or64; - red,green,blue: Int32or64; - hsla: THSLAPixel; -begin - red := ec.red; - green := ec.green; - blue := ec.blue; - hsla.alpha := ec.alpha; - - lightness := (red * redWeightShl10 + green * greenWeightShl10 + - blue * blueWeightShl10 + 512) shr 10; - - ExpandedToHSLAInline(red,green,blue,hsla); - result := TGSBAPixel(hsla); - - if result.lightness > 32768 then - result.saturation := result.saturation* UInt32or64(not result.lightness) div 32767; - result.lightness := lightness; - result.hue := HtoG(result.hue); -end; - -function GtoH(ghue: word): word; -const - segment: array[0..5] of UInt32or64 = - (13653, 10923, 8192, 13653, 10923, 8192); -var g: UInt32or64; -begin - g := ghue; - if g < segment[0] then - result := g * 10923 div segment[0] - else - begin - dec(g, segment[0]); - if g < segment[1] then - result := g * (21845-10923) div segment[1] + 10923 - else - begin - dec(g, segment[1]); - if g < segment[2] then - result := g * (32768-21845) div segment[2] + 21845 - else - begin - dec(g, segment[2]); - if g < segment[3] then - result := g * (43691-32768) div segment[3] + 32768 - else - begin - dec(g, segment[3]); - if g < segment[4] then - result := g * (54613-43691) div segment[4] + 43691 - else - begin - dec(g, segment[4]); - result := g * (65536-54613) div segment[5] + 54613; - end; - end; - end; - end; - end; -end; - -function HtoG(hue: word): word; -const - segmentDest: array[0..5] of UInt32or64 = - (13653, 10923, 8192, 13653, 10923, 8192); - segmentSrc: array[0..5] of UInt32or64 = - (10923, 10922, 10923, 10923, 10922, 10923); -var - h,g: UInt32or64; -begin - h := hue; - if h < segmentSrc[0] then - g := h * segmentDest[0] div segmentSrc[0] - else - begin - g := segmentDest[0]; - dec(h, segmentSrc[0]); - if h < segmentSrc[1] then - inc(g, h * segmentDest[1] div segmentSrc[1]) - else - begin - inc(g, segmentDest[1]); - dec(h, segmentSrc[1]); - if h < segmentSrc[2] then - inc(g, h * segmentDest[2] div segmentSrc[2]) - else - begin - inc(g, segmentDest[2]); - dec(h, segmentSrc[2]); - if h < segmentSrc[3] then - inc(g, h * segmentDest[3] div segmentSrc[3]) - else - begin - inc(g, segmentDest[3]); - dec(h, segmentSrc[3]); - if h < segmentSrc[4] then - inc(g, h * segmentDest[4] div segmentSrc[4]) - else - begin - inc(g, segmentDest[4]); - dec(h, segmentSrc[4]); - inc(g, h * segmentDest[5] div segmentSrc[5]); - end; - end; - end; - end; - end; - result := g; -end; - -function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel; -var ec: TExpandedPixel; -begin - ec := GSBAToExpanded(c); - result := GammaCompression(ec); -end; - -function GSBAToBGRA(const c: THSLAPixel): TBGRAPixel; -begin - result := GSBAToBGRA(TGSBAPixel(c)); -end; - -function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel; -var lightness: word; -begin - c.hue := GtoH(c.hue); - lightness := c.lightness; - c.lightness := 32768; - result := SetLightness(HSLAToExpanded(THSLAPixel(c)),lightness); -end; - -function GSBAToExpanded(const c: THSLAPixel): TExpandedPixel; -begin - result := GSBAToExpanded(TGSBAPixel(c)); -end; - -function GSBAToHSLA(const c: TGSBAPixel): THSLAPixel; -begin - result := ExpandedToHSLA(GSBAToExpanded(c)); -end; - -function GSBAToHSLA(const c: THSLAPixel): THSLAPixel; -begin - result := ExpandedToHSLA(GSBAToExpanded(TGSBAPixel(c))); -end; - -function HSLAToGSBA(const c: THSLAPixel): TGSBAPixel; -begin - result := ExpandedToGSBA(HSLAToExpanded(c)); -end; - -{ TBGRAPixelBasicHelper } - -function TBGRAPixelBasicHelper.ToExpanded: TExpandedPixel; -begin - result := GammaExpansion(self); -end; - -procedure TBGRAPixelBasicHelper.FromExpanded(const AValue: TExpandedPixel); -begin - Self := GammaCompression(AValue); -end; - -function TBGRAPixelBasicHelper.ToHSLAPixel: THSLAPixel; -begin - result := BGRAToHSLA(Self); -end; - -procedure TBGRAPixelBasicHelper.FromHSLAPixel(const AValue: THSLAPixel); -begin - Self := HSLAToBGRA(AValue); -end; - -function TBGRAPixelBasicHelper.ToGSBAPixel: TGSBAPixel; -begin - result := BGRAToGSBA(Self); -end; - -procedure TBGRAPixelBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel); -begin - Self := GSBAToBGRA(AValue); -end; - -procedure TBGRAPixelBasicHelper.FromGSBAPixel(const AValue: THSLAPixel); -begin - Self := GSBAToBGRA(AValue); -end; - -function TBGRAPixelBasicHelper.ToColorF(AGammaExpansion: boolean): TColorF; -begin - result := BGRAToColorF(Self,AGammaExpansion); -end; - -procedure TBGRAPixelBasicHelper.FromColorF(const AValue: TColorF; - AGammaCompression: boolean); -begin - Self := ColorFToBGRA(AValue,AGammaCompression); -end; - -{ TExpandedPixelBasicHelper } - -function TExpandedPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor; -begin - if AGammaCompression then - begin - result.red := GammaCompressionW(self.red); - result.green := GammaCompressionW(self.green); - result.blue := GammaCompressionW(self.blue); - end else - begin - result.red := self.red; - result.green := self.green; - result.blue := self.blue; - end; - result.alpha := self.alpha; -end; - -procedure TExpandedPixelBasicHelper.FromFPColor(const AValue: TFPColor; - AGammaExpansion: boolean); -begin - if AGammaExpansion then - begin - self.red := GammaExpansionW(AValue.red); - self.green := GammaExpansionW(AValue.green); - self.blue := GammaExpansionW(AValue.blue); - end else - begin - self.red := AValue.red; - self.green := AValue.green; - self.blue := AValue.blue; - end; - self.alpha := AValue.alpha; -end; - -function TExpandedPixelBasicHelper.ToColor: TColor; -begin - result := BGRAToColor(GammaCompression(self)); -end; - -procedure TExpandedPixelBasicHelper.FromColor(const AValue: TColor); -begin - self := GammaExpansion(ColorToBGRA(AValue)); -end; - -function TExpandedPixelBasicHelper.ToBGRAPixel: TBGRAPixel; -begin - result := GammaCompression(Self); -end; - -procedure TExpandedPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin - Self := GammaExpansion(AValue); -end; - -function TExpandedPixelBasicHelper.ToHSLAPixel: THSLAPixel; -begin - result := ExpandedToHSLA(Self); -end; - -procedure TExpandedPixelBasicHelper.FromHSLAPixel(const AValue: THSLAPixel); -begin - Self := HSLAToExpanded(AValue); -end; - -function TExpandedPixelBasicHelper.ToGSBAPixel: TGSBAPixel; -begin - result := ExpandedToGSBA(Self); -end; - -procedure TExpandedPixelBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel); -begin - Self := GSBAToExpanded(AValue); -end; - -procedure TExpandedPixelBasicHelper.FromGSBAPixel(const AValue: THSLAPixel); -begin - Self := GSBAToExpanded(AValue); -end; - -operator := (const AValue: TExpandedPixel): TColor; -begin Result := BGRAToColor(GammaCompression(AValue)); end; - -operator := (const AValue: TColor): TExpandedPixel; -begin Result := GammaExpansion(ColorToBGRA(AValue)) end; - -operator :=(const Source: TExpandedPixel): TBGRAPixel; -begin - result := GammaCompression(Source); -end; - -operator :=(const Source: TBGRAPixel): TExpandedPixel; -begin - result := GammaExpansion(Source); -end; - -{ TFPColorBasicHelper } - -function TFPColorBasicHelper.ToColor: TColor; -begin - result := FPColorToTColor(self); -end; - -procedure TFPColorBasicHelper.FromColor(const AValue: TColor); -begin - self := TColorToFPColor(AValue); -end; - -function TFPColorBasicHelper.ToBGRAPixel: TBGRAPixel; -begin - result := FPColorToBGRA(self); -end; - -procedure TFPColorBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin - self := BGRAToFPColor(AValue); -end; - -function TFPColorBasicHelper.ToExpanded(AGammaExpansion: boolean): TExpandedPixel; -begin - result.FromFPColor(self, AGammaExpansion); -end; - -procedure TFPColorBasicHelper.FromExpanded(const AValue: TExpandedPixel; - AGammaCompression: boolean); -begin - self := AValue.ToFPColor(AGammaCompression); -end; - -function TFPColorBasicHelper.ToHSLAPixel(AGammaExpansion: boolean): THSLAPixel; -begin - result.FromFPColor(self, AGammaExpansion); -end; - -procedure TFPColorBasicHelper.FromHSLAPixel(const AValue: THSLAPixel; - AGammaCompression: boolean); -begin - FromExpanded(AValue.ToExpanded, AGammaCompression); -end; - -function TFPColorBasicHelper.ToGSBAPixel(AGammaExpansion: boolean): TGSBAPixel; -begin - result.FromFPColor(self, AGammaExpansion); -end; - -procedure TFPColorBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel; - AGammaCompression: boolean); -begin - FromExpanded(AValue.ToExpanded, AGammaCompression); -end; - -procedure TFPColorBasicHelper.FromGSBAPixel(const AValue: THSLAPixel; - AGammaCompression: boolean); -begin - FromExpanded(AValue.ToExpanded, AGammaCompression); -end; - -{ THSLAPixelBasicHelper } - -function THSLAPixelBasicHelper.ToColor: TColor; -begin - result := BGRAToColor(HSLAToBGRA(self)); -end; - -procedure THSLAPixelBasicHelper.FromColor(const AValue: TColor); -begin - self := BGRAToHSLA(ColorToBGRA(AValue)); -end; - -function THSLAPixelBasicHelper.ToBGRAPixel: TBGRAPixel; -begin - result := HSLAToBGRA(self); -end; - -procedure THSLAPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin - self := BGRAToHSLA(AValue); -end; - -function THSLAPixelBasicHelper.ToGSBAPixel: TGSBAPixel; -begin - result := HSLAToGSBA(self); -end; - -procedure THSLAPixelBasicHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin - self := GSBAToHSLA(AValue); -end; - -function THSLAPixelBasicHelper.ToExpanded: TExpandedPixel; -begin - result := HSLAToExpanded(Self); -end; - -procedure THSLAPixelBasicHelper.FromExpanded(AValue: TExpandedPixel); -begin - Self := ExpandedToHSLA(AValue); -end; - -function THSLAPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor; -begin - result.FromExpanded(self.ToExpanded, AGammaCompression); -end; - -procedure THSLAPixelBasicHelper.FromFPColor(AValue: TFPColor; - AGammaExpansion: boolean); -begin - FromExpanded(AValue.ToExpanded(AGammaExpansion)); -end; - -operator :=(const Source: THSLAPixel): TBGRAPixel; -begin - result := HSLAToBGRA(Source); -end; - -operator :=(const Source: TBGRAPixel): THSLAPixel; -begin - result := BGRAToHSLA(Source); -end; - -operator :=(const Source: THSLAPixel): TExpandedPixel; -begin - result := HSLAToExpanded(Source); -end; - -operator:=(const Source: TExpandedPixel): THSLAPixel; -begin - result := ExpandedToHSLA(Source); -end; - -operator := (const AValue: TColor): THSLAPixel; -begin Result := BGRAToHSLA(ColorToBGRA(AValue)) end; - -operator := (const AValue: THSLAPixel): TColor; -begin Result := BGRAToColor(HSLAToBGRA(AValue)) end; - -{ TGSBAPixelBasicHelper } - -function TGSBAPixelBasicHelper.ToColor: TColor; -begin - result := BGRAToColor(GSBAToBGRA(self)); -end; - -procedure TGSBAPixelBasicHelper.FromColor(const AValue: TColor); -begin - self := BGRAToGSBA(ColorToBGRA(AValue)); -end; - -function TGSBAPixelBasicHelper.ToBGRAPixel: TBGRAPixel; -begin - result := GSBAToBGRA(self); -end; - -procedure TGSBAPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin - self := BGRAToGSBA(AValue); -end; - -function TGSBAPixelBasicHelper.ToHSLAPixel: THSLAPixel; -begin - result := GSBAToHSLA(self); -end; - -procedure TGSBAPixelBasicHelper.FromHSLAPixel(AValue: THSLAPixel); -begin - self := HSLAToGSBA(AValue); -end; - -function TGSBAPixelBasicHelper.ToExpanded: TExpandedPixel; -begin - result := GSBAToExpanded(self); -end; - -procedure TGSBAPixelBasicHelper.FromExpanded(AValue: TExpandedPixel); -begin - self := ExpandedToGSBA(AValue); -end; - -function TGSBAPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor; -begin - result.FromGSBAPixel(self, AGammaCompression); -end; - -procedure TGSBAPixelBasicHelper.FromFPColor(AValue: TFPColor; - AGammaExpansion: boolean); -begin - FromExpanded(AValue.ToExpanded(AGammaExpansion)); -end; - -operator :=(const Source: TGSBAPixel): TBGRAPixel; -begin - result := GSBAToBGRA(Source); -end; - -operator :=(const Source: TBGRAPixel): TGSBAPixel; -begin - result := BGRAToGSBA(Source); -end; - -operator :=(const Source: TGSBAPixel): TExpandedPixel; -begin - result := GSBAToExpanded(Source); -end; - -operator:=(const Source: TExpandedPixel): TGSBAPixel; -begin - result := ExpandedToGSBA(Source); -end; - -operator := (const AValue: TColor): TGSBAPixel; -begin Result := BGRAToGSBA(ColorToBGRA(AValue)) end; - -operator := (const AValue: TGSBAPixel): TColor; -begin Result := BGRAToColor(GSBAToBGRA(AValue)) end; - -operator :=(const Source: TGSBAPixel): THSLAPixel; -begin - result := THSLAPixel(Pointer(@Source)^); -end; - -operator:=(const Source: THSLAPixel): TGSBAPixel; -begin - result := TGSBAPixel(Pointer(@Source)^); -end; -{$ENDIF} diff --git a/components/bgrabitmap/bezier.inc b/components/bgrabitmap/bezier.inc deleted file mode 100644 index c4a0e1c..0000000 --- a/components/bgrabitmap/bezier.inc +++ /dev/null @@ -1,1463 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} - -type - { TCubicBezierCurve } - {* Definition of a Bézier curve of order 3. It has two control points ''c1'' and ''c2''. Those are not reached by the curve } - TCubicBezierCurve = object - private - function SimpleComputePoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; - public - {** Starting point (reached) } - p1: TPointF; - {** First control point (not reached by the curve) } - c1: TPointF; - {** Second control point (not reached by the curve) } - c2: TPointF; - {** Ending point (reached) } - p2: TPointF; - {** Computes the point at time ''t'', varying from 0 to 1 } - function ComputePointAt(t: single): TPointF; - {** Split the curve in two such that ''ALeft.p2'' = ''ARight.p1'' } - procedure Split(out ALeft, ARight: TCubicBezierCurve); - {** Compute an approximation of the length of the curve. ''AAcceptedDeviation'' indicates the - maximum orthogonal distance that is ignored and approximated by a straight line. } - function ComputeLength(AAcceptedDeviation: single = 0.1): single; - {** Computes a polygonal approximation of the curve. ''AAcceptedDeviation'' indicates the - maximum orthogonal distance that is ignored and approximated by a straight line. - ''AIncludeFirstPoint'' indicates if the first point must be included in the array } - function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; - procedure CopyToPath(ADest: IBGRAPath); - function GetBounds: TRectF; - end; - - {** Creates a structure for a cubic Bézier curve } - function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload; - -type - { TQuadraticBezierCurve } - {* Definition of a Bézier curve of order 2. It has one control point } - TQuadraticBezierCurve = object - private - function SimpleComputePoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; - function ComputeExtremumPositionOutsideSegment: single; - public - {** Starting point (reached) } - p1: TPointF; - {** Control point (not reached by the curve) } - c: TPointF; - {** Ending point (reached) } - p2: TPointF; - {** Computes the point at time ''t'', varying from 0 to 1 } - function ComputePointAt(t: single): TPointF; - {** Split the curve in two such that ''ALeft.p2'' = ''ARight.p1'' } - procedure Split(out ALeft, ARight: TQuadraticBezierCurve); - {** Compute the '''exact''' length of the curve } - function ComputeLength: single; - {** Computes a polygonal approximation of the curve. ''AAcceptedDeviation'' indicates the - maximum orthogonal distance that is ignored and approximated by a straight line. - ''AIncludeFirstPoint'' indicates if the first point must be included in the array } - function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; - procedure CopyToPath(ADest: IBGRAPath); - function GetBounds: TRectF; - end; - - {** Creates a structure for a quadratic Bézier curve } - function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload; - {** Creates a structure for a quadratic Bézier curve without curvature } - function BezierCurve(origin, destination: TPointF) : TQuadraticBezierCurve; overload; - -type - { A quasi-standard rational quadratic Bezier curve is defined by three points and a number: - p1 = starting point - c = control point - p2 = ending point - weight = weight for the control point - - The curve is defined with the function (t in [0;1]): - f: t -> ((1-t)^2*p1 + 2*t*(1-t)*weight*c + t^2*p2) / (1-t)^2 + 2*t*(1-t)*weight + t^2) - - The curve is an arc of: - - ellipse when weight in ]-1;1[ - - parabola when weight = 1 (classical quadratic Bezier curve) - - hyperbola when weight > 1 - - A negative weight give the complementary curve for its positive counterpart. - So when weight <= -1 the curve is discontinuous: - - infinite branches of parabola when weight = -1 - - infinite branches of hyperbola and symetric hyperbola when weight < -1 - - To transform a rational quadratic Bezier curve with an affin transformation, you - only have to transform the three points and leave the weight as it is. } - - ArrayOfSingle = array of single; - - { TRationalQuadraticBezierCurve } - {* Definition of a quasi-standard rational Bézier curve of order 2. It has one weighted control point } - TRationalQuadraticBezierCurve = object - //** Starting, control and ending points - p1, c, p2 : TPointF; - //** Weight of control point - weight : single; - private - function GetIsInfinite: boolean; - function InternalComputePoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; - function GetBoundingPositions(AIncludeFirstAndLast: boolean; ASorted: boolean): ArrayOfSingle; - public - function ComputePointAt(t: single): TPointF; - function ComputeLength(AAcceptedDeviation: single = 0.1): single; - function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; overload; - function ToPoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF; overload; - function GetBounds: TRectF; - procedure Split(out ALeft, ARight: TRationalQuadraticBezierCurve); - property IsInfinite: boolean read GetIsInfinite; - end; - - function BezierCurve(origin, control, destination: TPointF; Aweight:single) : TRationalQuadraticBezierCurve; overload; - -type - TEasyBezierCurveMode= (cmAuto, cmCurve, cmAngle); - TEasyBezierPointTransformFunc = function(APoint: PPointF; AData: Pointer): TPointF of object; - - { TEasyBezierCurve } - - TEasyBezierCurve = object - private - function GetCurveMode(AIndex: integer): TEasyBezierCurveMode; - function GetCurveStartPoint: TPointF; - function GetPoint(AIndex: integer): TPointF; - function GetPointCount: integer; - procedure SetClosed(AValue: boolean); - procedure SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode); - procedure SetMinimumDotProduct(AValue: single); - procedure SetPoint(AIndex: integer; AValue: TPointF); - protected - FCurves: array of record - isCurvedToNext,isCurvedToPrevious: boolean; - Center,ControlPoint,NextCenter: TPointF; - end; - FInvalidated: boolean; - FPoints: array of record - Coord: TPointF; - CurveMode: TEasyBezierCurveMode; - end; - FMinimumDotProduct: single; - FClosed: boolean; - function MaybeCurve(start1, end1, start2, end2: integer): boolean; - procedure ComputeQuadraticCurves; - function PointTransformNone(APoint: PPointF; {%H-}AData: Pointer): TPointF; - function PointTransformOffset(APoint: PPointF; AData: Pointer): TPointF; - public - procedure Init; - procedure Clear; - procedure SetPoints(APoints: array of TPointF; ACurveMode: TEasyBezierCurveMode); overload; - procedure SetPoints(APoints: array of TPointF; ACurveMode: array of TEasyBezierCurveMode); overload; - procedure SetPoints(APoints: array of TPointF; ACurveMode: TEasyBezierCurveMode; AStart, ACount: integer); overload; - procedure SetPoints(APoints: array of TPointF; ACurveMode: array of TEasyBezierCurveMode; AStart, ACount: integer); overload; - procedure CopyToPath(ADest: IBGRAPath); overload; - procedure CopyToPath(ADest: IBGRAPath; AOffset: TPointF; AReverse: boolean = false); overload; - procedure CopyToPath(ADest: IBGRAPath; ATransformFunc: TEasyBezierPointTransformFunc; ATransformData: Pointer; AReverse: boolean = false); overload; - property Point[AIndex: integer]: TPointF read GetPoint write SetPoint; - property CurveMode[AIndex: integer]: TEasyBezierCurveMode read GetCurveMode write SetCurveMode; - property PointCount: integer read GetPointCount; - property MinimumDotProduct: single read FMinimumDotProduct write SetMinimumDotProduct; - property Closed: boolean read FClosed write SetClosed; - property CurveStartPoint: TPointF read GetCurveStartPoint; - function ToPoints: ArrayOfTPointF; - function ComputeLength: single; - end; - -const - EasyBezierDefaultMinimumDotProduct = 0.707; - - function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; ACurveMode: TEasyBezierCurveMode; - AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; - - function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; ACurveMode: array of TEasyBezierCurveMode; - AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; - - function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; ACurveMode: TEasyBezierCurveMode; - AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; - - function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; ACurveMode: array of TEasyBezierCurveMode; - AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; overload; - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} -//-------------- Bézier curves definitions ---------------- -// See : http://en.wikipedia.org/wiki/B%C3%A9zier_curve - -// Define a Bézier curve with two control points. -function BezierCurve(origin, control1, control2, destination: TPointF): TCubicBezierCurve; -begin - result.p1 := origin; - result.c1 := control1; - result.c2 := control2; - result.p2 := destination; -end; - -// Define a Bézier curve with one control point. -function BezierCurve(origin, control, destination: TPointF - ): TQuadraticBezierCurve; -begin - result.p1 := origin; - result.c := control; - result.p2 := destination; -end; - -//straight line -function BezierCurve(origin, destination: TPointF): TQuadraticBezierCurve; -begin - result.p1 := origin; - result.c := (origin+destination)*0.5; - result.p2 := destination; -end; - -// rational Bezier curve -function BezierCurve(origin, control, destination: TPointF; Aweight:single) : TRationalQuadraticBezierCurve; -begin - result.p1 := origin; - result.c := control; - result.p2 := destination; - result.weight := Aweight; -end; - -function ComputeBezierCurvePrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = 0.1): integer; -var - len: single; -begin - len := sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y); - len := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)); - len := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)); - Result := round(sqrt(sqrt(len)/ AAcceptedDeviation) * 1); - if Result<=0 then Result:=1; -end; - -{ TCubicBezierCurve } - -function TCubicBezierCurve.SimpleComputePoints(AAcceptedDeviation: single; - AIncludeFirstPoint: boolean = true): ArrayOfTPointF; -var - t,step: single; - i,nb: Integer; - a,b,c: TpointF; -begin - nb := ComputeBezierCurvePrecision(p1,c1,c2,p2, AAcceptedDeviation/2); - if nb <= 1 then nb := 2; - a:=p2-p1+3*(c1-c2); - b:=3*(p1+c2)-6*c1; - c:=3*(c1-p1); - if AIncludeFirstPoint then - begin - setlength(result,nb); - result[0] := p1; - result[nb-1] := p2; - step := 1/(nb-1); - t := 0; - for i := 1 to nb-2 do - begin - IncF(t, step); - result[i] := p1+t*(c+t*(b+t*a)) - end; - end else - begin - setlength(result,nb-1); - result[nb-2] := p2; - step := 1/(nb-1); - t := 0; - for i := 0 to nb-3 do - begin - IncF(t, step); - result[i] := p1+t*(c+t*(b+t*a)) - end; - end; -end; - -function TCubicBezierCurve.ComputePointAt(t: single): TPointF; -var - f1,f2,f3,f4: single; -begin - f1 := (1-t); - f2 := f1*f1; - f1 := f1 * f2; - f2 := f2 * t*3; - f4 := t*t; - f3 := f4*(1-t)*3; - f4 := f4 * t; - - result.x := f1*p1.x + f2*c1.x + - f3*c2.x + f4*p2.x; - result.y := f1*p1.y + f2*c1.y + - f3*c2.y + f4*p2.y; -end; - -procedure TCubicBezierCurve.Split(out ALeft, ARight: TCubicBezierCurve); -var midc: TPointF; -begin - ALeft.p1 := p1; - ALeft.c1 := 0.5*(p1+c1); - ARight.p2 := p2; - ARight.c2 := 0.5*(p2+c2); - midc := 0.5*(c1+c2); - ALeft.c2 := 0.5*(ALeft.c1+midc); - ARight.c1 := 0.5*(ARight.c2+midc); - ALeft.p2 := 0.5*(ALeft.c2+ARight.c1); - ARight.p1 := ALeft.p2; -end; - -function TCubicBezierCurve.ComputeLength(AAcceptedDeviation: single): single; -var - t,step: single; - i,nb: Integer; - curCoord,nextCoord: TPointF; -begin - nb := ComputeBezierCurvePrecision(p1,c1,c2,p2, AAcceptedDeviation); - if nb <= 1 then nb := 2; - result := 0; - curCoord := p1; - step := 1/(nb-1); - t := 0; - for i := 1 to nb-2 do - begin - IncF(t, step); - nextCoord := ComputePointAt(t); - IncF(result, VectLen(nextCoord-curCoord)); - curCoord := nextCoord; - end; - IncF(result, VectLen(p2-curCoord)); -end; - -function TCubicBezierCurve.ToPoints(AAcceptedDeviation: single; - AIncludeFirstPoint: boolean = true): ArrayOfTPointF; -begin - result := SimpleComputePoints(AAcceptedDeviation, AIncludeFirstPoint); -end; - -procedure TCubicBezierCurve.CopyToPath(ADest: IBGRAPath); -begin - ADest.lineTo(p1); - ADest.bezierCurveTo(c1,c2,p2); -end; - -{//The following function computes by splitting the curve. It is slower than the simple function. -function TCubicBezierCurve.ToPoints(AAcceptedDeviation: single; - ARelativeDeviation: boolean): ArrayOfTPointF; - function ToPointsRec(const ACurve: TCubicBezierCurve): ArrayOfTPointF; - var simpleLen2: single; - v: TPointF; - left,right: TCubicBezierCurve; - subLeft,subRight: ArrayOfTPointF; - maxDev,dev1,dev2: single; - subLeftLen: integer; - - procedure ComputeExtremum; - begin - raise Exception.Create('Not implemented'); - result := nil; - end; - - begin - v := ACurve.p2-ACurve.p1; - simpleLen2 := v*v; - if simpleLen2 = 0 then - begin - if (ACurve.c1.x = ACurve.p1.x) and (ACurve.c1.y = ACurve.p1.y) and - (ACurve.c2.x = ACurve.p2.x) and (ACurve.c2.y = ACurve.p2.y) then - begin - result := nil; - exit; - end; - ACurve.Split(left,right); - end else - begin - ACurve.Split(left,right); - if not ARelativeDeviation then simpleLen2:= sqrt(simpleLen2); - maxDev := AAcceptedDeviation*simpleLen2; - if abs(PointF(v.y,-v.x) * (left.p2-ACurve.p1)) <= maxDev then - begin - dev1 := PointF(v.y,-v.x) * (ACurve.c1-ACurve.p1); - dev2 := PointF(v.y,-v.x) * (ACurve.c2-ACurve.p2); - if not ((Sign(dev1)<>Sign(dev2)) and ((abs(dev1) > maxDev) or (abs(dev2) > maxDev))) then - begin - result := nil; - if ((ACurve.c1-ACurve.p1)*v < -maxDev) or - ((ACurve.c1-ACurve.p2)*v > maxDev) or - ((ACurve.c2-ACurve.p1)*v < -maxDev) or - ((ACurve.c2-ACurve.p2)*v > maxDev) then - ComputeExtremum; - exit; - end; - end; - end; - subRight := ToPointsRec(right); - subLeft := ToPointsRec(left); - subLeftLen := length(subLeft); - - //avoid leaving a gap in memory - result := subLeft; - subLeft := nil; - setlength(result, subLeftLen+1+length(subRight)); - result[subLeftLen] := left.p2; - move(subRight[0], result[subLeftLen+1], length(subRight)*sizeof(TPointF)); - end; - -var - subLen: integer; - -begin - if (c1.x = p1.x) and (c1.y = p1.y) and - (c1.x = c2.x) and (c1.y = c2.y) and - (c1.x = p2.x) and (c1.y = p2.y) then - begin - setlength(result,1); - result[0] := c1; - exit; - end else - begin - result := ToPointsRec(self); - subLen := length(result); - setlength(result, length(result)+2); - move(result[0], result[1], subLen*sizeof(TPointF)); - result[0] := p1; - result[high(result)] := p2; - end; -end;} - -function TCubicBezierCurve.GetBounds: TRectF; -const precision = 1e-5; - - procedure Include(pt: TPointF); - begin - if pt.x < result.Left then result.Left := pt.x - else if pt.x > result.Right then result.Right := pt.x; - if pt.y < result.Top then result.Top := pt.y - else if pt.y > result.Bottom then result.Bottom := pt.y; - end; - - procedure IncludeT(t: single); - begin - if (t > 0) and (t < 1) then - Include(ComputePointAt(t)); - end; - - procedure IncludeABC(a,b,c: single); - var b2ac, sqrtb2ac: single; - begin - if abs(a) < precision then - begin - if abs(b) < precision then exit; - IncludeT(-c/b); - end else - begin - b2ac := sqr(b) - 4 * a * c; - if b2ac >= 0 then - begin - sqrtb2ac := sqrt(b2ac); - IncludeT((-b + sqrtb2ac) / (2 * a)); - IncludeT((-b - sqrtb2ac) / (2 * a)); - end; - end; - end; - -var - va, vb, vc: TPointF; - -begin - result.TopLeft := p1; - result.BottomRight := p1; - Include(p2); - - vb := 6 * p1 - 12 * c1 + 6 * c2; - va := -3 * p1 + 9 * c1 - 9 * c2 + 3 * p2; - vc := 3 * c1 - 3 * p1; - - IncludeABC(va.x,vb.x,vc.x); - IncludeABC(va.y,vb.y,vc.y); -end; - -{ TQuadraticBezierCurve } - -function TQuadraticBezierCurve.SimpleComputePoints(AAcceptedDeviation: single; - AIncludeFirstPoint: boolean = true): ArrayOfTPointF; -var - t,step: single; - i,nb: Integer; - pA,pB : TpointF; -begin - nb := ComputeBezierCurvePrecision(p1,c,c,p2, AAcceptedDeviation); - if nb <= 1 then nb := 2; - pA := p2+p1-2*c; pB := 2*(c-p1); - if AIncludeFirstPoint then - begin - setlength(result,nb); - result[0] := p1; - result[nb-1] := p2; - step := 1/(nb-1); - t := 0; - for i := 1 to nb-2 do - begin - IncF(t, step); - result[i] := p1+t*(pB+t*pA); - end; - end else - begin - setlength(result,nb-1); - result[nb-2] := p2; - step := 1/(nb-1); - t := 0; - for i := 0 to nb-3 do - begin - IncF(t, step); - result[i] := p1+t*(pB+t*pA); - end; - end; -end; - -function TQuadraticBezierCurve.ComputeExtremumPositionOutsideSegment: single; -var a,b: single; - v: TPointF; -begin - v := self.p2-self.p1; - a := (self.p1-2*self.c+self.p2)*v; - if a = 0 then //no solution - begin - result := -1; - exit; - end; - b := (self.c-self.p1)*v; - result := -b/a; -end; - -function TQuadraticBezierCurve.ComputePointAt(t: single): TPointF; -var - rev_t,f2,t2: single; -begin - rev_t := (1-t); - f2 := rev_t*t*2; - rev_t := rev_t * rev_t; - t2 := t*t; - result.x := rev_t*p1.x + f2*c.x + t2*p2.x; - result.y := rev_t*p1.y + f2*c.y + t2*p2.y; -end; - -procedure TQuadraticBezierCurve.Split(out ALeft, ARight: TQuadraticBezierCurve); -begin - ALeft.p1 := p1; - ALeft.c := 0.5*(p1+c); - ARight.p2 := p2; - ARight.c := 0.5*(p2+c); - ALeft.p2 := 0.5*(ALeft.c+ARight.c); - ARight.p1 := ALeft.p2; -end; - -function TQuadraticBezierCurve.ComputeLength: single; -var a,b: TPointF; - A_,AB_,B_,Sabc,A_2,A_32,B_2,BA, - divisor: single; - extremumPos: single; - extremum: TPointF; -begin - a := p1 - 2*c + p2; - b := 2*(c - p1); - A_ := 4*(a*a); - B_ := b*b; - if (A_ = 0) or (B_ = 0) then - begin - result := VectLen(p2-p1); - exit; - end; - AB_ := 4*(a*b); - - A_2 := sqrt(A_); - B_2 := 2*sqrt(B_); - BA := AB_/A_2; - divisor := BA+B_2; - if divisor <= 0 then - begin - extremumPos:= ComputeExtremumPositionOutsideSegment; - if (extremumPos <= 0) or (extremumPos >= 1) then - result := VectLen(p2-p1) - else - begin - extremum := ComputePointAt(extremumPos); - result := VectLen(extremum-p1)+VectLen(p2-extremum); - end; - exit; - end; - - Sabc := 2*sqrt(A_+AB_+B_); - A_32 := 2*A_*A_2; - result := ( A_32*Sabc + - A_2*AB_*(Sabc-B_2) + - (4*B_*A_-AB_*AB_)*ln( (2*A_2+BA+Sabc)/divisor ) - )/(4*A_32); -end; - -function TQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single; - AIncludeFirstPoint: boolean = true): ArrayOfTPointF; -begin - result := SimpleComputePoints(AAcceptedDeviation, AIncludeFirstPoint); -end; - -procedure TQuadraticBezierCurve.CopyToPath(ADest: IBGRAPath); -begin - ADest.lineTo(p1); - ADest.quadraticCurveTo(c,p2); -end; - -function TQuadraticBezierCurve.GetBounds: TRectF; -const precision = 1e-5; - - procedure Include(pt: TPointF); - begin - if pt.x < result.Left then result.Left := pt.x - else if pt.x > result.Right then result.Right := pt.x; - if pt.y < result.Top then result.Top := pt.y - else if pt.y > result.Bottom then result.Bottom := pt.y; - end; - - procedure IncludeT(t: single); - begin - if (t > 0) and (t < 1) then - Include(ComputePointAt(t)); - end; - - procedure IncludeABC(a,b,c: single); - var denom: single; - begin - denom := a-2*b+c; - if abs(denom) < precision then exit; - IncludeT((a-b)/denom); - end; - -begin - result.TopLeft := p1; - result.BottomRight := p1; - Include(p2); - - IncludeABC(p1.x,c.x,p2.x); - IncludeABC(p1.y,c.y,p2.y); -end; - -{//The following function computes by splitting the curve. It is slower than the simple function -function TQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single; ARelativeDeviation: boolean): ArrayOfTPointF; - - function ToPointsRec(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; - var simpleLen2: single; - v: TPointF; - left,right: TQuadraticBezierCurve; - subLeft,subRight: ArrayOfTPointF; - subLeftLen: Integer; - - procedure ComputeExtremum; - var - t: single; - begin - t := ACurve.ComputeExtremumPositionOutsideSegment; - if (t <= 0) or (t >= 1) then - result := nil - else - begin - setlength(result,1); - result[0] := ACurve.ComputePointAt(t); - end; - end; - - begin - v := ACurve.p2-ACurve.p1; - simpleLen2 := v*v; - if simpleLen2 = 0 then - begin - if (ACurve.c.x = ACurve.p1.x) and (ACurve.c.y = ACurve.p1.y) then - begin - result := nil; - exit; - end; - ACurve.Split(left,right); - end else - begin - ACurve.Split(left,right); - if not ARelativeDeviation then simpleLen2:= sqrt(simpleLen2); - if abs(PointF(v.y,-v.x) * (left.p2-ACurve.p1)) - <= AAcceptedDeviation*simpleLen2 then - begin - result := nil; - if ((ACurve.c-ACurve.p1)*v < -AAcceptedDeviation*simpleLen2) or - ((ACurve.c-ACurve.p2)*v > AAcceptedDeviation*simpleLen2) then - ComputeExtremum; - exit; - end; - end; - subRight := ToPointsRec(right); - subLeft := ToPointsRec(left); - subLeftLen := length(subLeft); - - //avoid leaving a gap in memory - result := subLeft; - subLeft := nil; - setlength(result, subLeftLen+1+length(subRight)); - result[subLeftLen] := left.p2; - move(subRight[0], result[subLeftLen+1], length(subRight)*sizeof(TPointF)); - end; - -var - subLen: integer; - -begin - if (c.x = p1.x) and (c.y = p1.y) and - (c.x = p2.x) and (c.y = p2.y) then - begin - setlength(result,1); - result[0] := c; - exit; - end else - begin - result := ToPointsRec(self); - subLen := length(result); - setlength(result, length(result)+2); - move(result[0], result[1], subLen*sizeof(TPointF)); - result[0] := p1; - result[high(result)] := p2; - end; -end;} - -{ TRationalQuadraticBezierCurve } - -function TRationalQuadraticBezierCurve.GetIsInfinite: boolean; -begin - result:= (weight <= -1); -end; - -function TRationalQuadraticBezierCurve.InternalComputePoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single; - AIncludeFirstPoint: boolean = true): ArrayOfTPointF; -var - pA,pB : TpointF; - a1,b1: single; - - function InternalComputeAt(t: single): TPointF; - var - den: single; - begin - den := (1+t*(b1+t*a1)); - if den <> 0 then - result := (p1+t*(pB+t*pA))*(1/den) - else - result := EmptyPointF - end; - - procedure ComputeFactors; - var - c2 : TpointF; - c1: single; - begin - c1 := 2*weight; c2 := c1*c; - pA := p2+p1-c2; pB := -2*p1+c2; - a1 := 2-c1; b1 := -a1; - end; - - function ComputeContinuous(t1,t2: single; AIncludeFirstPoint: boolean): ArrayOfTPointF; - var - pointCount: integer; - - procedure AddPoint(APoint: TPointF); - begin - if isEmptyPointF(APoint) then exit; - if pointCount >= length(result) then - setlength(result, pointCount*2+4); - result[pointCount] := APoint; - inc(pointCount); - end; - - procedure ComputeRec(left: single; constref leftPoint: TPointF; right: single; constref rightPoint: TPointF); - var - middlePoint, u: TPointF; - middle, lenU, deviation: Single; - begin - if rightPoint<>leftPoint then - begin - middle := (left+right)*0.5; - middlePoint := InternalComputeAt(middle); - u := rightPoint-leftPoint; - lenU := VectLen(u); - if lenU>0 then u.Scale(1/lenU); - deviation := abs((middlePoint-leftPoint)*PointF(u.y,-u.x)); - if deviation > AAcceptedDeviation then - begin - ComputeRec(left, leftPoint, middle, middlePoint); - AddPoint(middlePoint); - ComputeRec(middle, middlePoint, right, rightPoint); - end else - if deviation > AAcceptedDeviation*0.6 then - AddPoint(middlePoint); - end; - end; - - var - startPoint, endPoint: TPointF; - begin - pointCount := 0; - result:= nil; - startPoint := InternalComputeAt(t1); - endPoint := InternalComputeAt(t2); - if AIncludeFirstPoint then AddPoint(startPoint); - if endPoint <> startPoint then - begin - ComputeRec(t1,startPoint,t2,endPoint); - AddPoint(endPoint); - end; - setlength(result,PointCount); - end; - -var - tSplitA, tSplitB, tSplit1, tSplit2, delta: single; - leftPart,middlePart,rightPart: array of TPointF; - tList: ArrayOfSingle; - parts: array of ArrayOfTPointF; - i: Integer; - - function PointWithinInifiniteBounds(APoint: TPointF): boolean; - begin - result := not isEmptyPointF(APoint) and - (APoint.x > AInfiniteBounds.Left) and (APoint.x < AInfiniteBounds.Right) and - (APoint.y > AInfiniteBounds.Top) and (APoint.y < AInfiniteBounds.Bottom); - end; - -begin - if weight = 0 then exit(PointsF([p1,p2])); - ComputeFactors; - - if weight > -1 then - begin - tList := GetBoundingPositions(true,true); - setlength(parts, length(tList)-1); - for i := 0 to high(parts) do - parts[i] := ComputeContinuous(tList[i],tList[i+1], AIncludeFirstPoint and (i=0)); - result := ConcatPointsF(parts); - end - else - if weight = -1 then - begin - tSplit1 := 0.5; - tSplitA := 0; - while PointWithinInifiniteBounds(InternalComputeAt(tSplitA)) do tSplitA := (tSplitA+tSplit1)*0.5; - tSplitB := 1; - while PointWithinInifiniteBounds(InternalComputeAt(tSplitB)) do tSplitB := (tSplitB+tSplit1)*0.5; - - tList := GetBoundingPositions(true,true); - setlength(parts, length(tList)-1); - for i := 0 to high(parts) do - begin - if (tList[i] > tSplitA) and (tList[i+1] <= tSplitB) then parts[i] := nil - else - if (tList[i] <= tSplitA) and (tList[i+1] >= tSplitA) then - begin - parts[i] := ComputeContinuous(tList[i],tSplitA, AIncludeFirstPoint or (i>0)); - setlength(parts[i], length(parts[i])+1); - parts[i][high(parts[i])] := EmptyPointF; - - if tList[i+1] > tSplitB then - parts[i] := ConcatPointsF([parts[i], ComputeContinuous(tSplitB,tList[i+1], true)]) - else - tList[i+1] := tSplitB; - end - else - if (tList[i] < tSplitB) and (tList[i+1] >= tSplitB) then - parts[i] := ComputeContinuous(tSplitB,tList[i+1], AIncludeFirstPoint or (i>0)) - else - parts[i] := ComputeContinuous(tList[i],tList[i+1], AIncludeFirstPoint or (i>0)); - end; - result := ConcatPointsF(parts); - end else - begin - delta:= 1 - 2/(1-weight); - tSplit1 := (1 - sqrt(delta))/2; - tSplit2 := 1-tSplit1; - - tSplitA := 0; - while PointWithinInifiniteBounds(InternalComputeAt(tSplitA)) do tSplitA := (tSplitA+tSplit1)*0.5; - leftPart := ComputeContinuous(0, tSplitA, AIncludeFirstPoint); - - tSplitA := (tSplit1+tSplit2)*0.5; - tSplitB := tSplitA; - while PointWithinInifiniteBounds(InternalComputeAt(tSplitA)) do tSplitA := (tSplitA+tSplit1)*0.5; - while PointWithinInifiniteBounds(InternalComputeAt(tSplitB)) do tSplitB := (tSplitB+tSplit2)*0.5; - middlePart := ComputeContinuous(tSplitA, tSplitB, true); - - tSplitB := 1; - while PointWithinInifiniteBounds(InternalComputeAt(tSplitB)) do tSplitB := (tSplitB+tSplit2)*0.5; - rightPart:= ComputeContinuous(tSplitB, 1, true); - result := ConcatPointsF([leftPart, PointsF([EmptyPointF]), middlePart, PointsF([EmptyPointF]), rightPart]); - end; -end; - -function TRationalQuadraticBezierCurve.GetBoundingPositions( - AIncludeFirstAndLast: boolean; ASorted: boolean): ArrayOfSingle; -const precision = 1e-6; -var a,delta,sqrtDelta,den,invDen: single; - A_,B_,p2_,c_: TPointF; - posCount : integer; - - procedure Include(t: single); - var - i: Integer; - begin - if (t < 0) or (t > 1) then exit; - for i := 0 to PosCount-1 do - if result[i] = t then exit; - result[posCount] := t; - inc(posCount); - end; - - procedure SortList; - var i,j,k: integer; - temp: single; - begin - for i := 1 to high(result) do - begin - j := i; - while (j > 0) and (result[j-1] > result[i]) do dec(j); - if j <> i then - begin - temp := result[i]; - for k := i downto j+1 do - result[k] := result[k-1]; - result[j] := temp; - end; - end; - end; - -begin - setlength(result, 6); - posCount := 0; - - if AIncludeFirstAndLast then - begin - Include(0); - Include(1); - end; - - p2_ := p2-p1; c_ := c-p1; //translation with -p1 - B_ := 2*weight*c_; A_ := p2_-B_; - a := 2*(1-weight); - - //on Ox - den := a*p2_.x; - if abs(den) >= precision then - begin - delta := sqr(A_.x)+den*B_.x; - if delta >= 0 then - begin - invDen := 1/den; - sqrtDelta := sqrt(delta); - Include( (A_.x-sqrtDelta)*invDen ); - Include( (A_.x+sqrtDelta)*invDen ); - end; - end else //den=0 - if abs(A_.x) >= precision then - Include( -B_.x/A_.x*0.5 ); - - //on Oy - den := a*p2_.y; - if abs(den) >= precision then - begin - delta := sqr(A_.y)+den*B_.y; - if delta >= 0 then - begin - invDen := 1/den; - sqrtDelta := sqrt(delta); - Include( (A_.y-sqrtDelta)*invDen ); - Include( (A_.y+sqrtDelta)*invDen ); - end; - end else //den=0 - if abs(A_.y) >= precision then - Include( -B_.y/A_.y*0.5 ); - - setlength(result, posCount); - if ASorted then SortList; -end; - -function TRationalQuadraticBezierCurve.ComputePointAt(t: single): TPointF; -var - rev_t,f2,t2,den: single; -begin - rev_t := (1-t); - t2 := t*t; - f2 := weight*rev_t*t*2; - rev_t := rev_t * rev_t; - den := rev_t+f2+t2; - if den <> 0 then - begin - result.x := (rev_t*p1.x + f2*c.x + t2*p2.x)/den; - result.y := (rev_t*p1.y + f2*c.y + t2*p2.y)/den; - end - else - result := EmptyPointF -end; - -function TRationalQuadraticBezierCurve.ToPoints(AInfiniteBounds: TRectF; AAcceptedDeviation: single; - AIncludeFirstPoint: boolean = true): ArrayOfTPointF; -begin - if weight=1 then - result := BezierCurve(p1,c,p2).ToPoints(AAcceptedDeviation, AIncludeFirstPoint) - else - result := InternalComputePoints(AInfiniteBounds, AAcceptedDeviation, AIncludeFirstPoint) -end; - -function TRationalQuadraticBezierCurve.GetBounds: TRectF; -var a: single; - A_,B_,p2_,c_: TPointF; - t: single; - tList: array of Single; - i: Integer; - - procedure Include(pt: TPointF); - begin - if pt.x < result.Left then result.Left := pt.x - else if pt.x > result.Right then result.Right := pt.x; - if pt.y < result.Top then result.Top := pt.y - else if pt.y > result.Bottom then result.Bottom := pt.y; - end; - -begin - if weight=1 then exit(BezierCurve(p1,c,p2).GetBounds); - if IsInfinite then exit(EmptyRectF); - tList:= GetBoundingPositions(false,false); - - result.TopLeft := p1; - result.BottomRight := p1; - Include(p2); - - p2_ := p2-p1; c_ := c-p1; //translation with -p1 - B_ := 2*weight*c_; A_ := p2_-B_; - a := 2*(1-weight); - - for i := 0 to high(tList) do - begin - t := tList[i]; - Include( p1+t*(B_+t*A_)*(1/(1+t*(-a+t*a))) ); - end; -end; - -function TRationalQuadraticBezierCurve.ComputeLength(AAcceptedDeviation: single): single; -var i: Integer; - curCoord,nextCoord: TPointF; - pts: ArrayOfTPointF; -begin - if weight = 1 then exit(BezierCurve(p1,c,p2).ComputeLength); - if weight <= -1 then exit(EmptySingle); // no bounds in this case - pts := InternalComputePoints(EmptyRectF, AAcceptedDeviation, true); - curCoord := p1; result:=0; - for i := 1 to high(pts) do - begin - nextCoord := pts[i]; - if (nextCoord <> EmptyPointF) and (curCoord <> EmptyPointF) then - IncF(result, VectLen(nextCoord-curCoord)); - curCoord := nextCoord; - end; - finalize(pts) -end; - -function TRationalQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single; - AIncludeFirstPoint: boolean): ArrayOfTPointF; -begin - result := ToPoints(RectF(-64,-64, 16384, 16384), AAcceptedDeviation, AIncludeFirstPoint); -end; - -procedure TRationalQuadraticBezierCurve.Split(out ALeft, ARight: TRationalQuadraticBezierCurve); -const precision=1E-6; -var M, D, E, H, c1, c2: TPointF; - alpha, sg, w: single; - - function Intersec(): TPointF; //dichotomie - var t, t1, t2: single; - U, V: TPointF; - begin - t1 := 0; t2 := 0.5; U := E-c1; - if VectDet(U,p1-c1)>0 then sg := 1 else sg := -1; - while (t2-t1) > precision do //19 iterations - begin - t := (t1+t2)/2; - V := ComputePointAt(t)-c1; - if VectDet(U,V)*sg>0 then t1 := t else t2 := t; - end; - result := ComputePointAt((t1+t2)/2) - end; - -begin - if IsInfinite then raise exception.Create('Cannot split an infinite curve'); - - M := ComputePointAt(0.5); - ALeft.p1 := p1; - ALeft.p2 := M; - ARight.p1 := M; - ARight.p2 := p2; - ALeft.weight := 1; - ARight.weight := 1; - D := 0.5*(p1+p2); - if (weight = 1) or (D = c) then - begin - ALeft.c := 0.5*(p1+c); - ARight.c := 0.5*(p2+c); - exit; - end; - if weight > 0 then - alpha := VectLen(D-M)/VectLen(D-c) - else - alpha := -VectLen(D-M)/VectLen(D-c); - c1 := p1 + alpha*(c-p1); - c2 := p2 + alpha*(c-p2); - ALeft.c := c1; - ARight.c := c2; - E := 0.5*(p1+M); - H := Intersec(); //between [c1;E] and the curve - w := VectLen(E-c1)/VectLen(H-c1)-1; // new weight - ALeft.weight := w; - ARight.weight := w; -end; - -{ TEasyBezierCurve } - -function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; - ACurveMode: TEasyBezierCurveMode; AMinimumDotProduct: single): TEasyBezierCurve; -begin - result := EasyBezierCurve(APoints, 0, length(APoints), AClosed, ACurveMode, AMinimumDotProduct); -end; - -function EasyBezierCurve(APoints: array of TPointF; AClosed: boolean; - ACurveMode: array of TEasyBezierCurveMode; AMinimumDotProduct: single): TEasyBezierCurve; -begin - result := EasyBezierCurve(APoints, 0, length(APoints), AClosed, ACurveMode, AMinimumDotProduct); -end; - -function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; - ACurveMode: TEasyBezierCurveMode; AMinimumDotProduct: single): TEasyBezierCurve; -begin - result.Init; - result.SetPoints(APoints, ACurveMode, AStart, ACount); - result.Closed:= AClosed; - result.MinimumDotProduct:= AMinimumDotProduct; -end; - -function EasyBezierCurve(APoints: array of TPointF; AStart, ACount: integer; AClosed: boolean; - ACurveMode: array of TEasyBezierCurveMode; - AMinimumDotProduct: single = EasyBezierDefaultMinimumDotProduct): TEasyBezierCurve; -begin - result.Init; - result.SetPoints(APoints, ACurveMode, AStart, ACount); - result.Closed:= AClosed; - result.MinimumDotProduct:= AMinimumDotProduct; -end; - -procedure TEasyBezierCurve.CopyToPath(ADest: IBGRAPath; ATransformFunc: TEasyBezierPointTransformFunc; - ATransformData: Pointer; AReverse: boolean); -var i: integer; - nextMove: boolean; - pt,startCoord: TPointF; -begin - if PointCount = 0 then exit; - if (FCurves = nil) or FInvalidated then ComputeQuadraticCurves; - nextMove := true; - - if AReverse then - begin - for i := PointCount-1 downto 0 do - begin - pt := Point[i]; - if isEmptyPointF(pt) then - begin - if not nextMove and FClosed then ADest.closePath; - nextMove := true; - end else - begin - pt := Point[i]; - with FCurves[i] do - begin - if isCurvedToNext then - begin - if nextMove then - begin - ADest.moveTo(ATransformFunc(@NextCenter,ATransformData)); - nextMove := false; - end; - ADest.quadraticCurveTo(ATransformFunc(@ControlPoint,ATransformData),ATransformFunc(@Center,ATransformData)); - end; - if not isCurvedToPrevious then - begin - if nextMove then - begin - ADest.moveTo(ATransformFunc(@pt,ATransformData)); - nextMove := false; - end else - ADest.lineTo(ATransformFunc(@pt,ATransformData)); - end; - end; - end; - end; - end else - begin - for i := 0 to PointCount-1 do - begin - pt := Point[i]; - if isEmptyPointF(pt) then - begin - if not nextMove and FClosed then ADest.closePath; - nextMove := true; - end else - begin - with FCurves[i] do - begin - if nextMove then - begin - if not isCurvedToPrevious then - startCoord := pt - else - startCoord := Center; - ADest.moveTo(ATransformFunc(@startCoord,ATransformData)); - nextMove := false; - end else - if not isCurvedToPrevious then - ADest.lineTo(ATransformFunc(@pt,ATransformData)); - - if isCurvedToNext then - begin - if not isCurvedToPrevious then ADest.lineTo(ATransformFunc(@Center,ATransformData)); - ADest.quadraticCurveTo(ATransformFunc(@ControlPoint,ATransformData),ATransformFunc(@NextCenter,ATransformData)); - end; - end; - end; - end; - end; - if not nextMove and FClosed then ADest.closePath; -end; - -function TEasyBezierCurve.ToPoints: ArrayOfTPointF; -var p: TBGRACustomPath; -begin - if not Assigned(BGRAPathFactory) then raise exception.Create('BGRAPath unit needed'); - p := BGRAPathFactory.Create; - CopyToPath(p); - result := p.getPoints; - p.Free; -end; - -function TEasyBezierCurve.ComputeLength: single; -var p: TBGRACustomPath; -begin - if not Assigned(BGRAPathFactory) then raise exception.Create('BGRAPath unit needed'); - p := BGRAPathFactory.Create; - CopyToPath(p); - result := p.getLength; - p.Free; -end; - -procedure TEasyBezierCurve.CopyToPath(ADest: IBGRAPath); -begin - CopyToPath(ADest, @PointTransformNone, nil); -end; - -procedure TEasyBezierCurve.CopyToPath(ADest: IBGRAPath; AOffset: TPointF; AReverse: boolean); -begin - CopyToPath(ADest, @PointTransformOffset, @AOffset, AReverse); -end; - -procedure TEasyBezierCurve.ComputeQuadraticCurves; -var - i,FirstPointIndex,NextPt,NextPt2: integer; -begin - setlength(FCurves, PointCount); - FirstPointIndex := 0; - for i := 0 to PointCount-1 do - FCurves[i].isCurvedToPrevious := false; - for i := 0 to PointCount-1 do - begin - FCurves[i].isCurvedToNext := false; - FCurves[i].Center := EmptyPointF; - FCurves[i].ControlPoint := EmptyPointF; - FCurves[i].NextCenter := EmptyPointF; - - if IsEmptyPointF(Point[i]) then - begin - FirstPointIndex := i+1; - end else - begin - NextPt := i+1; - if (NextPt = PointCount) or isEmptyPointF(Point[NextPt]) then NextPt := FirstPointIndex; - NextPt2 := NextPt+1; - if (NextPt2 = PointCount) or isEmptyPointF(Point[NextPt2]) then NextPt2 := FirstPointIndex; - - FCurves[i].Center := (Point[i]+Point[NextPt])*0.5; - FCurves[i].NextCenter := (Point[NextPt]+Point[NextPt2])*0.5; - FCurves[i].ControlPoint := Point[NextPt]; - - if (i < PointCount-2) or FClosed then - begin - case CurveMode[nextPt] of - cmAuto: FCurves[i].isCurvedToNext:= MaybeCurve(i,NextPt,NextPt,NextPt2); - cmCurve: FCurves[i].isCurvedToNext:= true; - else FCurves[i].isCurvedToNext:= false; - end; - FCurves[NextPt].isCurvedToPrevious := FCurves[i].isCurvedToNext; - end; - end; - end; - FInvalidated:= false; -end; - -function TEasyBezierCurve.PointTransformNone(APoint: PPointF; AData: Pointer): TPointF; -begin - result := APoint^; -end; - -function TEasyBezierCurve.PointTransformOffset(APoint: PPointF; AData: Pointer): TPointF; -begin - result := APoint^ + PPointF(AData)^; -end; - -procedure TEasyBezierCurve.Init; -begin - FClosed := false; - FMinimumDotProduct:= EasyBezierDefaultMinimumDotProduct; - FPoints := nil; - FInvalidated := true; -end; - -procedure TEasyBezierCurve.Clear; -begin - FPoints := nil; -end; - -procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; - ACurveMode: TEasyBezierCurveMode); -begin - SetPoints(APoints, ACurveMode, 0, length(APoints)); -end; - -procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; - ACurveMode: array of TEasyBezierCurveMode); -begin - SetPoints(APoints, ACurveMode, 0, length(APoints)); -end; - -procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; - ACurveMode: TEasyBezierCurveMode; AStart, ACount: integer); -var - i: Integer; -begin - if (AStart < 0) or (AStart+ACount > length(APoints)) then - raise exception.Create('Index out of bounds'); - setlength(FPoints, ACount); - for i := 0 to ACount-1 do - begin - FPoints[i].Coord := APoints[AStart + i]; - FPoints[i].CurveMode:= ACurveMode; - end; - FInvalidated:= true; -end; - -procedure TEasyBezierCurve.SetPoints(APoints: array of TPointF; - ACurveMode: array of TEasyBezierCurveMode; AStart, ACount: integer); -var - i,j: Integer; -begin - if (AStart < 0) or (AStart+ACount > length(APoints)) then - raise exception.Create('Index out of bounds'); - setlength(FPoints, ACount); - if length(ACurveMode) > 0 then - j := AStart mod length(ACurveMode); - for i := 0 to ACount-1 do - begin - FPoints[i].Coord := APoints[i + AStart]; - if length(ACurveMode) = 0 then - FPoints[i].CurveMode:= cmAuto - else - begin - FPoints[i].CurveMode:= ACurveMode[j]; - inc(j); - if j = length(ACurveMode) then j := 0; - end; - end; - FInvalidated:= true; -end; - -function TEasyBezierCurve.GetCurveMode(AIndex: integer): TEasyBezierCurveMode; -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - result:= FPoints[AIndex].CurveMode; -end; - -function TEasyBezierCurve.GetCurveStartPoint: TPointF; -begin - if (PointCount=0) or isEmptyPointF(Point[0]) then exit(EmptyPointF); - if FInvalidated or (FCurves = nil) then ComputeQuadraticCurves; - if not FCurves[0].isCurvedToPrevious then - result := Point[0] - else - result := FCurves[0].Center; -end; - -function TEasyBezierCurve.GetPoint(AIndex: integer): TPointF; -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - result:= FPoints[AIndex].Coord; -end; - -function TEasyBezierCurve.GetPointCount: integer; -begin - result:= length(FPoints); -end; - -procedure TEasyBezierCurve.SetClosed(AValue: boolean); -begin - if FClosed=AValue then Exit; - FClosed:=AValue; - FInvalidated:= true; -end; - -procedure TEasyBezierCurve.SetCurveMode(AIndex: integer; - AValue: TEasyBezierCurveMode); -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - if FPoints[AIndex].CurveMode = AValue then exit; - FPoints[AIndex].CurveMode := AValue; - FInvalidated:= true; -end; - -procedure TEasyBezierCurve.SetMinimumDotProduct(AValue: single); -begin - if FMinimumDotProduct=AValue then Exit; - FMinimumDotProduct:=AValue; - FInvalidated:= true; -end; - -procedure TEasyBezierCurve.SetPoint(AIndex: integer; AValue: TPointF); -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - if FPoints[AIndex].Coord = AValue then exit; - FPoints[AIndex].Coord := AValue; - FInvalidated:= true; -end; - -function TEasyBezierCurve.MaybeCurve(start1,end1,start2,end2: integer): boolean; -var - u,v: TPointF; - lu,lv: single; -begin - if (start1=-1) or (end1=-1) or (start2=-1) or (end2=-1) then - begin - result := false; - exit; - end; - u := pointF(Point[end1].x - Point[start1].x, Point[end1].y - Point[start1].y); - lu := sqrt(u*u); - if lu <> 0 then u.Scale(1/lu); - v := pointF(Point[end2].x - Point[start2].x, Point[end2].y - Point[start2].y); - lv := sqrt(v*v); - if lv <> 0 then v.Scale(1/lv); - - result := u*v > FMinimumDotProduct; -end; - -{$ENDIF} diff --git a/components/bgrabitmap/bglcontrols.lpk b/components/bgrabitmap/bglcontrols.lpk deleted file mode 100644 index 503cec7..0000000 --- a/components/bgrabitmap/bglcontrols.lpk +++ /dev/null @@ -1,71 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <_ExternHelp Items="Count"/> - - - diff --git a/components/bgrabitmap/bglcontrols.pas b/components/bgrabitmap/bglcontrols.pas deleted file mode 100644 index 4df85dd..0000000 --- a/components/bgrabitmap/bglcontrols.pas +++ /dev/null @@ -1,21 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit BGLControls; - -interface - -uses - BGLVirtualScreen, LazarusPackageIntf; - -implementation - -procedure Register; -begin - RegisterUnit('BGLVirtualScreen', @BGLVirtualScreen.Register); -end; - -initialization - RegisterPackage('BGLControls', @Register); -end. diff --git a/components/bgrabitmap/bglvirtualscreen.pas b/components/bgrabitmap/bglvirtualscreen.pas deleted file mode 100644 index 5dae0b8..0000000 --- a/components/bgrabitmap/bglvirtualscreen.pas +++ /dev/null @@ -1,434 +0,0 @@ -unit BGLVirtualScreen; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, BGRAClasses, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, - ExtCtrls, BGRABitmapTypes, BGRAOpenGL, OpenGLContext, BGRACanvasGL, - BGRASpriteGL; - -type - TCustomBGLVirtualScreen = class; - TBGLRedrawEvent = procedure (Sender: TObject; BGLContext: TBGLContext) of object; - TBGLLoadTexturesEvent = procedure (Sender: TObject; BGLContext: TBGLContext) of object; - TBGLElapseEvent = procedure (Sender: TObject; BGLContext: TBGLContext; ElapsedMs: integer) of object; - TBGLFramesPerSecondEvent = procedure (Sender: TObject; BGLContext: TBGLContext; FramesPerSecond: integer) of object; - TBGLUseContextCallback = procedure (Sender: TObject; BGLContext: TBGLContext; Data: Pointer) of object; - - { TCustomBGLVirtualScreen } - - TCustomBGLVirtualScreen = class(TCustomOpenGLControl) - private - { Private declarations } - FOnRedraw: TBGLRedrawEvent; - FOnLoadTextures: TBGLLoadTexturesEvent; - FOnUnloadTextures: TBGLLoadTexturesEvent; - FOnElapse: TBGLElapseEvent; - FOnFramesPerSecond: TBGLFramesPerSecondEvent; - FSmoothedElapse: boolean; - FTexturesLoaded: boolean; - FBevelInner, FBevelOuter: TPanelBevel; - FBevelWidth: TBevelWidth; - FBorderWidth: TBorderWidth; - FRedrawOnIdle: boolean; - FSprites: TBGLCustomSpriteEngine; - FElapseAccumulator, FElapseCount, FStoredFPS: integer; - FSmoothedElapseAccumulator: single; - FContextPrepared: boolean; - FOldSprites: TBGLCustomSpriteEngine; - FShaderList,FOldShaderList: TStringList; - function GetCanvas: TBGLCustomCanvas; - procedure SetBevelInner(const AValue: TPanelBevel); - procedure SetBevelOuter(const AValue: TPanelBevel); - procedure SetBevelWidth(const AValue: TBevelWidth); - procedure SetBorderWidth(const AValue: TBorderWidth); - procedure SetRedrawOnIdle(AValue: Boolean); - procedure SetSmoothedElapse(AValue: boolean); - protected - class var FToRedrawOnIdle: array of TCustomBGLVirtualScreen; - { Protected declarations } - procedure RedrawContent(ctx: TBGLContext); virtual; - procedure SetEnabled(Value: boolean); override; - procedure OnAppIdle(Sender: TObject; var Done: Boolean); - procedure LoadTextures; virtual; - function PrepareBGLContext: TBGLContext; - procedure ReleaseBGLContext(ctx: TBGLContext); - public - { Public declarations } - procedure DoOnPaint; override; - procedure QueryLoadTextures; virtual; - procedure UnloadTextures; virtual; - procedure UseContext(ACallback: TBGLUseContextCallback; AData: Pointer = nil); - constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; - public - property Canvas: TBGLCustomCanvas read GetCanvas; - property Sprites: TBGLCustomSpriteEngine read FSprites; - property OnLoadTextures: TBGLLoadTexturesEvent Read FOnLoadTextures Write FOnLoadTextures; - property OnUnloadTextures: TBGLLoadTexturesEvent Read FOnUnloadTextures Write FOnUnloadTextures; - property OnRedraw: TBGLRedrawEvent Read FOnRedraw Write FOnRedraw; - property OnElapse: TBGLElapseEvent Read FOnElapse Write FOnElapse; - property OnFramesPerSecond: TBGLFramesPerSecondEvent Read FOnFramesPerSecond Write FOnFramesPerSecond; - property RedrawOnIdle: Boolean read FRedrawOnIdle write SetRedrawOnIdle default False; - property BorderWidth: TBorderWidth Read FBorderWidth Write SetBorderWidth default 0; - property BevelInner: TPanelBevel Read FBevelInner Write SetBevelInner default bvNone; - property BevelOuter: TPanelBevel Read FBevelOuter Write SetBevelOuter default bvNone; - property BevelWidth: TBevelWidth Read FBevelWidth Write SetBevelWidth default 1; - property SmoothedElapse: boolean read FSmoothedElapse write SetSmoothedElapse default False; - end; - - TBGLVirtualScreen = class(TCustomBGLVirtualScreen) - published - property OnRedraw; - property Align; - property Anchors; - property AutoSize; - property BorderSpacing; - property BevelInner; - property BevelOuter; - property BevelWidth; - property BidiMode; - property BorderWidth; - property BorderStyle; - property Caption; - property ChildSizing; - property ClientHeight; - property ClientWidth; - property Color; - property Constraints; - property DockSite; - property DragCursor; - property DragKind; - property DragMode; - property Enabled; - property Font; - property ParentBidiMode; - property ParentColor; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property RedrawOnIdle; - property ShowHint; - property TabOrder; - property TabStop; - property UseDockManager default True; - property Visible; - property OnClick; - property OnContextPopup; - property OnDockDrop; - property OnDockOver; - property OnDblClick; - property OnDragDrop; - property OnDragOver; - property OnElapse; - property OnEndDock; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnFramesPerSecond; - property OnGetSiteInfo; - property OnGetDockCaption; - property OnLoadTextures; - property OnUnloadTextures; - property OnMouseDown; - property OnMouseEnter; - property OnMouseLeave; - property OnMouseMove; - property OnMouseUp; - property OnMouseWheel; - property OnMouseWheelDown; - property OnMouseWheelUp; - property OnResize; - property OnStartDock; - property OnStartDrag; - property OnUnDock; - property SmoothedElapse; - end; - -procedure Register; - -implementation - -procedure Register; -begin - {$I bglvirtualscreen_icon.lrs} - RegisterComponents('OpenGL', [TBGLVirtualScreen]); -end; - -{ TCustomBGLVirtualScreen } - -procedure TCustomBGLVirtualScreen.SetBevelInner(const AValue: TPanelBevel); -begin - if FBevelInner = AValue then - exit; - FBevelInner := AValue; - Invalidate; -end; - -function TCustomBGLVirtualScreen.GetCanvas: TBGLCustomCanvas; -begin - result := BGLCanvas; -end; - -procedure TCustomBGLVirtualScreen.SetBevelOuter(const AValue: TPanelBevel); -begin - if FBevelOuter = AValue then - exit; - FBevelOuter := AValue; - Invalidate; -end; - -procedure TCustomBGLVirtualScreen.SetBevelWidth(const AValue: TBevelWidth); -begin - if FBevelWidth = AValue then - exit; - FBevelWidth := AValue; - Invalidate; -end; - -procedure TCustomBGLVirtualScreen.SetBorderWidth(const AValue: TBorderWidth); -begin - if FBorderWidth = AValue then - exit; - FBorderWidth := AValue; - Invalidate; -end; - -procedure TCustomBGLVirtualScreen.SetRedrawOnIdle(AValue: Boolean); -var - i: Integer; - j: Integer; -begin - if FRedrawOnIdle=AValue then Exit; - FRedrawOnIdle:=AValue; - - if FRedrawOnIdle then - begin - if length(FToRedrawOnIdle)= 0 then - Application.AddOnIdleHandler(@OnAppIdle); - setlength(FToRedrawOnIdle, length(FToRedrawOnIdle)+1); - FToRedrawOnIdle[high(FToRedrawOnIdle)] := self; - end - else - if length(FToRedrawOnIdle)> 0 then - begin - for i := 0 to high(FToRedrawOnIdle) do - begin - if FToRedrawOnIdle[i]=self then - begin - for j := i to high(FToRedrawOnIdle)-1 do - FToRedrawOnIdle[j] := FToRedrawOnIdle[j+1]; - setlength(FToRedrawOnIdle, length(FToRedrawOnIdle)-1); - break; - end; - end; - if length(FToRedrawOnIdle) = 0 then - Application.RemoveOnIdleHandler(@OnAppIdle); - end; -end; - -procedure TCustomBGLVirtualScreen.SetSmoothedElapse(AValue: boolean); -begin - if FSmoothedElapse=AValue then Exit; - FSmoothedElapse:=AValue; -end; - -procedure TCustomBGLVirtualScreen.DoOnPaint; -var - ctx: TBGLContext; - knownFPS: Integer; -begin - if not FTexturesLoaded then LoadTextures; - - ctx := PrepareBGLContext; - if Color = clNone then - BGLViewPort(ClientWidth,ClientHeight) - else - if Color = clDefault then - BGLViewPort(ClientWidth,ClientHeight,ColorToBGRA(clWindow)) - else - BGLViewPort(ClientWidth,ClientHeight,ColorToBGRA(Color)); - - RedrawContent(ctx); - inherited DoOnPaint; - SwapBuffers; - - inc(FElapseAccumulator, FrameDiffTimeInMSecs); - Inc(FElapseCount); - if FElapseAccumulator >= 2000 then - begin - FStoredFPS := 1000*FElapseCount div FElapseAccumulator; - if Assigned(FOnFramesPerSecond) then - FOnFramesPerSecond(self, ctx, FStoredFPS); - FElapseAccumulator := 0; - FElapseCount := 0; - end; - - If Assigned(FOnElapse) then - begin - if SmoothedElapse then - begin - If FStoredFPS <> 0 then - knownFPS:= FStoredFPS - else - if FElapseAccumulator >= 500 then - knownFPS := 1000*FElapseCount div FElapseAccumulator - else - knownFPS := 0; - - if knownFPS > 0 then - begin - IncF(FSmoothedElapseAccumulator, 1000/knownFPS); - end else - IncF(FSmoothedElapseAccumulator, FrameDiffTimeInMSecs); - - FOnElapse(self, ctx, Trunc(FSmoothedElapseAccumulator)); - DecF(FSmoothedElapseAccumulator, Trunc(FSmoothedElapseAccumulator)); - end else - FOnElapse(self, ctx, FrameDiffTimeInMSecs); - end; - - ReleaseBGLContext(ctx); -end; - -procedure TCustomBGLVirtualScreen.QueryLoadTextures; -begin - FTexturesLoaded := false; -end; - -procedure TCustomBGLVirtualScreen.LoadTextures; -var ctx: TBGLContext; -begin - if MakeCurrent then - begin - if Assigned(FOnLoadTextures) then - begin - ctx := PrepareBGLContext; - FOnLoadTextures(self, ctx); - ReleaseBGLContext(ctx); - end; - FTexturesLoaded:= true; - end; -end; - -function TCustomBGLVirtualScreen.PrepareBGLContext: TBGLContext; -begin - if FContextPrepared then - raise exception.Create('Context already prepared'); - FOldSprites := BGRASpriteGL.BGLSpriteEngine; - BGRASpriteGL.BGLSpriteEngine := FSprites; - FOldShaderList := BGLCanvas.Lighting.ShaderList; - BGLCanvas.Lighting.ShaderList := FShaderList; - result.Canvas := BGLCanvas; - result.Sprites := FSprites; - FContextPrepared := true; -end; - -procedure TCustomBGLVirtualScreen.ReleaseBGLContext(ctx: TBGLContext); -begin - if not FContextPrepared then - raise exception.Create('Context not prepared'); - ctx.Canvas.Lighting.ShaderList := FOldShaderList; - BGRASpriteGL.BGLSpriteEngine := FOldSprites; - FContextPrepared := false; -end; - -procedure TCustomBGLVirtualScreen.UnloadTextures; -var ctx: TBGLContext; -begin - if MakeCurrent then - begin - ctx := PrepareBGLContext; - if Assigned(FOnUnloadTextures) then FOnUnloadTextures(self, ctx); - FSprites.Clear; - ctx.Canvas.Lighting.FreeShaders; - ReleaseBGLContext(ctx); - FTexturesLoaded := false; - end; -end; - -procedure TCustomBGLVirtualScreen.UseContext(ACallback: TBGLUseContextCallback; AData: Pointer); -var - ctx: TBGLContext; -begin - if not MakeCurrent then - raise exception.Create('Unable to switch to the OpenGL context'); - ctx := PrepareBGLContext; - try - ACallback(self, ctx, AData); - finally - ReleaseBGLContext(ctx); - end; -end; - -procedure TCustomBGLVirtualScreen.RedrawContent(ctx: TBGLContext); -var - ARect: TRect; - w: integer; -begin - ARect := rect(0,0,ctx.Canvas.Width,ctx.Canvas.Height); - w := BevelWidth; - if w = 0 then w := 1; - - // if BevelOuter is set then draw a frame with BevelWidth - if (BevelOuter <> bvNone) and (w > 0) then - ctx.Canvas.Frame3d(ARect, w, BevelOuter); // Note: Frame3D inflates ARect - - ARect.Inflate(-BorderWidth, -BorderWidth); - - // if BevelInner is set then skip the BorderWidth and draw a frame with BevelWidth - if (BevelInner <> bvNone) and (w > 0) then - ctx.Canvas.Frame3d(ARect, w, BevelInner); // Note: Frame3D inflates ARect - - if Assigned(FOnRedraw) then - FOnRedraw(self, ctx); -end; - -procedure TCustomBGLVirtualScreen.SetEnabled(Value: boolean); -begin - if Value <> Enabled then Invalidate; - inherited SetEnabled(Value); -end; - -procedure TCustomBGLVirtualScreen.OnAppIdle(Sender: TObject; var Done: Boolean); -var - i: Integer; -begin - if length(FToRedrawOnIdle) > 0 then - begin - for i := 0 to high(FToRedrawOnIdle) do - if not (csDesigning in FToRedrawOnIdle[i].ComponentState) then - FToRedrawOnIdle[i].Invalidate; - Done:=false; - end; -end; - -constructor TCustomBGLVirtualScreen.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - FTexturesLoaded:= False; - AutoResizeViewport := true; - FSprites := TBGLDefaultSpriteEngine.Create; - FShaderList:= TStringList.Create; - FStoredFPS := 0; - FElapseAccumulator := 0; - FElapseCount := 0; - FSmoothedElapseAccumulator := 0; -end; - -destructor TCustomBGLVirtualScreen.Destroy; -var - i: Integer; -begin - for i := 0 to FShaderList.Count-1 do - FShaderList.Objects[i].Free; - FShaderList.Free; - RedrawOnIdle := false; - FSprites.Free; - inherited Destroy; -end; - -end. - diff --git a/components/bgrabitmap/bglvirtualscreen_icon.lrs b/components/bgrabitmap/bglvirtualscreen_icon.lrs deleted file mode 100644 index 1e122eb..0000000 --- a/components/bgrabitmap/bglvirtualscreen_icon.lrs +++ /dev/null @@ -1,47 +0,0 @@ -LazarusResources.Add('TBGLVirtualScreen','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#3#0#0#0#215#169#205 - +#202#0#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0 - +#3#0'PLTE'#0#0#0'7k'#190'vv'#146#128#128#128#150#181#231#192#192#192#194#192 - +#193#223#223#219#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#179#142 - +#179#217#0#0#1#0'tRNS'#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 - +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0'S'#247#7'%'#0#0#0 - +#9'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#25'tEXtSoftware'#0'Pain' - +'t.NET v3.5.87;'#128']'#0#0#0#145'IDAT(S}'#146#1#14#133' '#12'C;`'#204#251'_' - +#216#223'150'#244'WM'#180#175#133'd'#130#243'C'#248#3#202'.'#166#217'(GR+' - +#253#2#246#168#241#173#245#13#136#208'n'#182#1'i'#188'Dr'#3#244#220#150#212 - +#128#24#200'xo'#128#27#152#195#21#140#133#140#15#236#5#132#191#0#212#216#186 - +'&'#0#173#131#12#127'j'#248#167#163#240'g'#160#170#142#194'O@'#237#246#151 - +#165#152#214'+?5`'#10#234#25#241'=D'#28#204#247'Y1v'#20#250#233''''#6#168')' - +#239#221#1#240'z >O'#201#15#143#1#178'Ms O)'#0#0#0#0'IEND'#174'B`'#130 -]); diff --git a/components/bgrabitmap/bgraanimatedgif.pas b/components/bgrabitmap/bgraanimatedgif.pas deleted file mode 100644 index 16c17a4..0000000 --- a/components/bgrabitmap/bgraanimatedgif.pas +++ /dev/null @@ -1,1225 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAAnimatedGif; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, FPImage, BGRABitmap, BGRABitmapTypes, - BGRAPalette, BGRAGifFormat; - -type - TDisposeMode = BGRAGifFormat.TDisposeMode; - TGifSubImage = BGRAGifFormat.TGifSubImage; - TGifSubImageArray = BGRAGifFormat.TGifSubImageArray; - - //how to deal with the background under the GIF animation - TGifBackgroundMode = (gbmSimplePaint, gbmEraseBackground, - gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously); - - { TBGRAAnimatedGif } - - TBGRAAnimatedGif = class(TGraphic) - private - FAspectRatio: single; - FWidth, FHeight: integer; - FBackgroundColor: TColor; - - FPrevDate: TDateTime; - FPaused: boolean; - FTimeAccumulator: double; - FCurrentImage, FWantedImage: integer; - FTotalAnimationTime: int64; - FPreviousDisposeMode: TDisposeMode; - - FBackgroundImage, FPreviousVirtualScreen, FStretchedVirtualScreen, - FInternalVirtualScreen, FRestoreImage: TBGRABitmap; - FImageChanged: boolean; - - procedure CheckFrameIndex(AIndex: integer); - function GetAverageDelayMs: integer; - function GetCount: integer; - function GetFrameDelayMs(AIndex: integer): integer; - function GetFrameDisposeMode(AIndex: integer): TDisposeMode; - function GetFrameHasLocalPalette(AIndex: integer): boolean; - function GetFrameImage(AIndex: integer): TBGRABitmap; - function GetFrameImagePos(AIndex: integer): TPoint; - function GetTimeUntilNextImage: integer; - procedure Render(StretchWidth, StretchHeight: integer); - procedure SetAspectRatio(AValue: single); - procedure SetBackgroundColor(AValue: TColor); - procedure SetFrameDelayMs(AIndex: integer; AValue: integer); - procedure SetFrameDisposeMode(AIndex: integer; AValue: TDisposeMode); - procedure SetFrameHasLocalPalette(AIndex: integer; AValue: boolean); - procedure SetFrameImage(AIndex: integer; AValue: TBGRABitmap); - procedure SetFrameImagePos(AIndex: integer; AValue: TPoint); - procedure UpdateSimple(Canvas: TCanvas; ARect: TRect; - DrawOnlyIfChanged: boolean = True); - procedure UpdateEraseBackground(Canvas: TCanvas; ARect: TRect; - DrawOnlyIfChanged: boolean = True); - procedure Init; - function GetBitmap: TBitmap; - function GetMemBitmap: TBGRABitmap; - procedure SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); - procedure SetCurrentImage(Index: integer); - - protected - FImages: TGifSubImageArray; - - {TGraphic} - procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; - function GetEmpty: boolean; override; - function GetHeight: integer; override; - function GetTransparent: boolean; override; - function GetWidth: integer; override; - procedure SetHeight({%H-}Value: integer); override; - procedure SetTransparent({%H-}Value: boolean); override; - procedure SetWidth({%H-}Value: integer); override; - procedure ClearViewer; virtual; - - public - EraseColor: TColor; - BackgroundMode: TGifBackgroundMode; - LoopCount: Word; - LoopDone: Integer; - - constructor Create(filenameUTF8: string); overload; - constructor Create(stream: TStream); overload; - constructor Create(stream: TStream; AMaxImageCount: integer); overload; - constructor Create; overload; override; - function Duplicate: TBGRAAnimatedGif; - function AddFrame(AImage: TFPCustomImage; X,Y: integer; ADelayMs: integer; - ADisposeMode: TDisposeMode = dmErase; AHasLocalPalette: boolean = false) : integer; - procedure InsertFrame(AIndex: integer; AImage: TFPCustomImage; X,Y: integer; ADelayMs: integer; - ADisposeMode: TDisposeMode = dmErase; AHasLocalPalette: boolean = false); - procedure DeleteFrame(AIndex: integer; AEnsureNextFrameDoesNotChange: boolean); - - //add a frame that replaces completely the previous one - function AddFullFrame(AImage: TFPCustomImage; ADelayMs: integer; - AHasLocalPalette: boolean = true): integer; - procedure InsertFullFrame(AIndex: integer; - AImage: TFPCustomImage; ADelayMs: integer; - AHasLocalPalette: boolean = true); - procedure ReplaceFullFrame(AIndex: integer; - AImage: TFPCustomImage; ADelayMs: integer; - AHasLocalPalette: boolean = true); - - {TGraphic} - procedure LoadFromStream(Stream: TStream); overload; override; - procedure LoadFromStream(Stream: TStream; AMaxImageCount: integer); overload; - procedure LoadFromResource(AFilename: string); - procedure SaveToStream(Stream: TStream); overload; override; - procedure LoadFromFile(const AFilenameUTF8: string); override; - procedure SaveToFile(const AFilenameUTF8: string); override; - class function GetFileExtensions: string; override; - - procedure SetSize(AWidth,AHeight: integer); virtual; - procedure SaveToStream(Stream: TStream; AQuantizer: TBGRAColorQuantizerAny; - ADitheringAlgorithm: TDitheringAlgorithm); overload; virtual; - procedure Clear; override; - destructor Destroy; override; - procedure Pause; - procedure Resume; - - procedure Show(Canvas: TCanvas; ARect: TRect); overload; - procedure Update(Canvas: TCanvas; ARect: TRect); overload; - procedure Hide(Canvas: TCanvas; ARect: TRect); overload; - - property BackgroundColor: TColor Read FBackgroundColor write SetBackgroundColor; - property Count: integer Read GetCount; - property Width: integer Read FWidth; - property Height: integer Read FHeight; - property Paused: boolean Read FPaused; - property Bitmap: TBitmap Read GetBitmap; - property MemBitmap: TBGRABitmap Read GetMemBitmap; - property CurrentImage: integer Read FCurrentImage Write SetCurrentImage; - property TimeUntilNextImageMs: integer read GetTimeUntilNextImage; - property FrameImage[AIndex: integer]: TBGRABitmap read GetFrameImage write SetFrameImage; - property FrameHasLocalPalette[AIndex: integer]: boolean read GetFrameHasLocalPalette write SetFrameHasLocalPalette; - property FrameImagePos[AIndex: integer]: TPoint read GetFrameImagePos write SetFrameImagePos; - property FrameDelayMs[AIndex: integer]: integer read GetFrameDelayMs write SetFrameDelayMs; - property FrameDisposeMode[AIndex: integer]: TDisposeMode read GetFrameDisposeMode write SetFrameDisposeMode; - property AspectRatio: single read FAspectRatio write SetAspectRatio; - property TotalAnimationTimeMs: Int64 read FTotalAnimationTime; - property AverageDelayMs: integer read GetAverageDelayMs; - end; - - { TBGRAReaderGIF } - - TBGRAReaderGIF = class(TFPCustomImageReader) - protected - procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; - function InternalCheck(Str: TStream): boolean; override; - end; - - { TBGRAWriterGIF } - - TBGRAWriterGIF = class(TFPCustomImageWriter) - protected - procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override; - end; - -const - GifBackgroundModeStr: array[TGifBackgroundMode] of string = - ('gbmSimplePaint', 'gbmEraseBackground', 'gbmSaveBackgroundOnce', - 'gbmUpdateBackgroundContinuously'); - -implementation - -uses BGRABlend, BGRAUTF8{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF}; - -const - {$IFDEF ENDIAN_LITTLE} - AlphaMask = $FF000000; - {$ELSE} - AlphaMask = $000000FF; - {$ENDIF} - - -{ TBGRAAnimatedGif } - -class function TBGRAAnimatedGif.GetFileExtensions: string; -begin - Result := 'gif'; -end; - -procedure TBGRAAnimatedGif.SetSize(AWidth, AHeight: integer); -begin - ClearViewer; - FWidth := AWidth; - FHeight := AHeight; -end; - -procedure TBGRAAnimatedGif.SaveToStream(Stream: TStream; - AQuantizer: TBGRAColorQuantizerAny; - ADitheringAlgorithm: TDitheringAlgorithm); -var data: TGIFData; -begin - data.Height:= Height; - data.Width := Width; - data.AspectRatio := 1; - data.BackgroundColor := BackgroundColor; - data.Images := FImages; - data.LoopCount := LoopCount; - GIFSaveToStream(data, Stream, AQuantizer, ADitheringAlgorithm); -end; - -procedure TBGRAAnimatedGif.Render(StretchWidth, StretchHeight: integer); -var - curDate: TDateTime; - previousImage, nextImage: integer; - -begin - if FInternalVirtualScreen = nil then - begin - FInternalVirtualScreen := TBGRABitmap.Create(FWidth, FHeight); - if (Count = 0) and (BackgroundColor <> clNone) then - FInternalVirtualScreen.Fill(BackgroundColor) - else - FInternalVirtualScreen.Fill(BGRAPixelTransparent); - FImageChanged := True; - end; - - if Count = 0 then - exit; - - previousImage := FCurrentImage; - - curDate := Now; - if FWantedImage <> -1 then - begin - nextImage := FWantedImage; - FTimeAccumulator := 0; - FWantedImage := -1; - end - else - if FCurrentImage = -1 then - begin - nextImage := 0; - FTimeAccumulator := 0; - FPreviousDisposeMode := dmNone; - end - else - begin - if not FPaused then - IncF(FTimeAccumulator, (curDate - FPrevDate) * 24 * 60 * 60 * 1000); - if FTotalAnimationTime > 0 then FTimeAccumulator:= frac(FTimeAccumulator/FTotalAnimationTime)*FTotalAnimationTime; - nextImage := FCurrentImage; - while FTimeAccumulator > FImages[nextImage].DelayMs do - begin - DecF(FTimeAccumulator, FImages[nextImage].DelayMs); - Inc(nextImage); - if nextImage >= Count then - begin - if (LoopCount > 0) and (LoopDone >= LoopCount-1) then - begin - LoopDone := LoopCount; - dec(nextImage); - break; - end else - begin - nextImage := 0; - inc(LoopDone); - end; - end; - - if nextImage = previousImage then - begin - if not ((LoopCount > 0) and (LoopDone >= LoopCount-1)) then - begin - Inc(nextImage); - if nextImage >= Count then - nextImage := 0; - end; - break; - end; - end; - end; - FPrevDate := curDate; - - while FCurrentImage <> nextImage do - begin - Inc(FCurrentImage); - if FCurrentImage >= Count then - begin - FCurrentImage := 0; - FPreviousDisposeMode := dmErase; - end; - - case FPreviousDisposeMode of - dmErase: FInternalVirtualScreen.Fill(BGRAPixelTransparent); - dmRestore: if FRestoreImage <> nil then - FInternalVirtualScreen.PutImage(0, 0, FRestoreImage, dmSet); - end; - - with FImages[FCurrentImage] do - begin - if disposeMode = dmRestore then - begin - if FRestoreImage = nil then - FRestoreImage := TBGRABitmap.Create(FWidth, FHeight); - FRestoreImage.PutImage(0, 0, FInternalVirtualScreen, dmSet); - end; - - if Image <> nil then - FInternalVirtualScreen.PutImage(Position.X, Position.Y, Image, - dmSetExceptTransparent); - FPreviousDisposeMode := DisposeMode; - end; - - FImageChanged := True; - previousImage := FCurrentImage; - FInternalVirtualScreen.InvalidateBitmap; - end; - - if FStretchedVirtualScreen <> nil then - FStretchedVirtualScreen.FreeReference; - if (FInternalVirtualScreen.Width = StretchWidth) and - (FInternalVirtualScreen.Height = StretchHeight) then - FStretchedVirtualScreen := TBGRABitmap(FInternalVirtualScreen.NewReference) - else - FStretchedVirtualScreen := - TBGRABitmap(FInternalVirtualScreen.Resample(StretchWidth, StretchHeight)); -end; - -procedure TBGRAAnimatedGif.SetAspectRatio(AValue: single); -begin - if AValue < 0.25 then AValue := 0.25; - if AValue > 4 then AValue := 4; - if FAspectRatio=AValue then Exit; - FAspectRatio:=AValue; -end; - -procedure TBGRAAnimatedGif.SetBackgroundColor(AValue: TColor); -begin - if FBackgroundColor=AValue then Exit; - FBackgroundColor:=AValue; -end; - -procedure TBGRAAnimatedGif.SetFrameDelayMs(AIndex: integer; AValue: integer); -begin - CheckFrameIndex(AIndex); - if AValue < 0 then AValue := 0; - FTotalAnimationTime := FTotalAnimationTime + AValue - FImages[AIndex].DelayMs; - FImages[AIndex].DelayMs := AValue; -end; - -procedure TBGRAAnimatedGif.SetFrameDisposeMode(AIndex: integer; - AValue: TDisposeMode); -begin - CheckFrameIndex(AIndex); - FImages[AIndex].DisposeMode := AValue; -end; - -procedure TBGRAAnimatedGif.SetFrameHasLocalPalette(AIndex: integer; - AValue: boolean); -begin - CheckFrameIndex(AIndex); - FImages[AIndex].HasLocalPalette := AValue; - -end; - -procedure TBGRAAnimatedGif.SetFrameImage(AIndex: integer; AValue: TBGRABitmap); -var ACopy: TBGRABitmap; -begin - CheckFrameIndex(AIndex); - ACopy := AValue.Duplicate; - FImages[AIndex].Image.FreeReference; - FImages[AIndex].Image := ACopy; -end; - -procedure TBGRAAnimatedGif.SetFrameImagePos(AIndex: integer; AValue: TPoint); -begin - CheckFrameIndex(AIndex); - FImages[AIndex].Position := AValue; -end; - -procedure TBGRAAnimatedGif.UpdateSimple(Canvas: TCanvas; ARect: TRect; - DrawOnlyIfChanged: boolean = True); -begin - if FPreviousVirtualScreen <> nil then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end; - - Render(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); - if FImageChanged then - begin - FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, False); - FImageChanged := False; - end - else - if not DrawOnlyIfChanged then - FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, False); - - FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.NewReference); -end; - -procedure TBGRAAnimatedGif.CheckFrameIndex(AIndex: integer); -begin - if (AIndex < 0) or (AIndex >= Count) then Raise ERangeError.Create('Index out of bounds'); -end; - -function TBGRAAnimatedGif.GetAverageDelayMs: integer; -var sum: int64; - i: Integer; -begin - if Count > 0 then - begin - sum := 0; - for i := 0 to Count-1 do - inc(sum, FrameDelayMs[i]); - result := sum div Count; - end else - result := 100; //default -end; - -function TBGRAAnimatedGif.GetCount: integer; -begin - Result := length(FImages); -end; - -function TBGRAAnimatedGif.GetFrameDelayMs(AIndex: integer): integer; -begin - CheckFrameIndex(AIndex); - result := FImages[AIndex].DelayMs; -end; - -function TBGRAAnimatedGif.GetFrameDisposeMode(AIndex: integer): TDisposeMode; -begin - CheckFrameIndex(AIndex); - result := FImages[AIndex].DisposeMode; -end; - -function TBGRAAnimatedGif.GetFrameHasLocalPalette(AIndex: integer): boolean; -begin - CheckFrameIndex(AIndex); - result := FImages[AIndex].HasLocalPalette; -end; - -function TBGRAAnimatedGif.GetFrameImage(AIndex: integer): TBGRABitmap; -begin - CheckFrameIndex(AIndex); - result := FImages[AIndex].Image; -end; - -function TBGRAAnimatedGif.GetFrameImagePos(AIndex: integer): TPoint; -begin - CheckFrameIndex(AIndex); - result := FImages[AIndex].Position; -end; - -function TBGRAAnimatedGif.GetTimeUntilNextImage: integer; -var - acc: double; -begin - if Count <= 1 then result := 60*1000 else - if (FWantedImage <> -1) or (FCurrentImage = -1) then - result := 0 - else - begin - acc := FTimeAccumulator; - if not FPaused then IncF(acc, (Now- FPrevDate) * 24 * 60 * 60 * 1000); - if acc >= FImages[FCurrentImage].DelayMs then - result := 0 - else - result := round(FImages[FCurrentImage].DelayMs-FTimeAccumulator); - end; -end; - -constructor TBGRAAnimatedGif.Create(filenameUTF8: string); -begin - inherited Create; - Init; - LoadFromFile(filenameUTF8); -end; - -constructor TBGRAAnimatedGif.Create(stream: TStream); -begin - inherited Create; - Init; - LoadFromStream(stream); -end; - -constructor TBGRAAnimatedGif.Create(stream: TStream; AMaxImageCount: integer); -begin - inherited Create; - Init; - LoadFromStream(stream, AMaxImageCount); -end; - -constructor TBGRAAnimatedGif.Create; -begin - inherited Create; - Init; - LoadFromStream(nil); -end; - -function TBGRAAnimatedGif.Duplicate: TBGRAAnimatedGif; -var - i: integer; -begin - Result := TBGRAAnimatedGif.Create; - setlength(Result.FImages, length(FImages)); - for i := 0 to high(FImages) do - begin - Result.FImages[i] := FImages[i]; - FImages[i].Image.NewReference; - end; - Result.FWidth := FWidth; - Result.FHeight := FHeight; - Result.FBackgroundColor := FBackgroundColor; -end; - -function TBGRAAnimatedGif.AddFrame(AImage: TFPCustomImage; X, Y: integer; - ADelayMs: integer; ADisposeMode: TDisposeMode; AHasLocalPalette: boolean - ): integer; -begin - result := length(FImages); - setlength(FImages, length(FImages)+1); - if ADelayMs < 0 then ADelayMs:= 0; - with FImages[result] do - begin - Image := TBGRABitmap.Create(AImage); - Position := Point(x,y); - DelayMs := ADelayMs; - HasLocalPalette := AHasLocalPalette; - DisposeMode := ADisposeMode; - end; - inc(FTotalAnimationTime, ADelayMs); -end; - -procedure TBGRAAnimatedGif.InsertFrame(AIndex: integer; AImage: TFPCustomImage; X, - Y: integer; ADelayMs: integer; ADisposeMode: TDisposeMode; - AHasLocalPalette: boolean); -var i: integer; -begin - if (AIndex < 0) or (AIndex > Count) then - raise ERangeError.Create('Index out of bounds'); - setlength(FImages, length(FImages)+1); - if ADelayMs < 0 then ADelayMs:= 0; - for i := high(FImages) downto AIndex+1 do - FImages[i] := FImages[i-1]; - with FImages[AIndex] do - begin - Image := TBGRABitmap.Create(AImage); - Position := Point(x,y); - DelayMs := ADelayMs; - HasLocalPalette := AHasLocalPalette; - DisposeMode := ADisposeMode; - end; - inc(FTotalAnimationTime, ADelayMs); -end; - -function TBGRAAnimatedGif.AddFullFrame(AImage: TFPCustomImage; - ADelayMs: integer; AHasLocalPalette: boolean): integer; -begin - if (AImage.Width <> Width) or (AImage.Height <> Height) then - raise exception.Create('Size mismatch'); - if Count > 0 then - FrameDisposeMode[Count-1] := dmErase; - result := AddFrame(AImage, 0,0, ADelayMs, dmErase, AHasLocalPalette); -end; - -procedure TBGRAAnimatedGif.InsertFullFrame(AIndex: integer; - AImage: TFPCustomImage; ADelayMs: integer; AHasLocalPalette: boolean); -var nextImage: TBGRABitmap; -begin - if (AIndex < 0) or (AIndex > Count) then - raise ERangeError.Create('Index out of bounds'); - - if AIndex = Count then - AddFullFrame(AImage, ADelayMs, AHasLocalPalette) - else - begin - //if previous image did not clear up, ensure that - //next image will stay the same - if (AIndex > 0) and (FrameDisposeMode[AIndex-1] <> dmErase) then - begin - CurrentImage := AIndex; - nextImage := MemBitmap.Duplicate; - FrameImagePos[AIndex] := Point(0,0); - FrameImage[AIndex] := nextImage; - FrameHasLocalPalette[AIndex] := true; - FreeAndNil(nextImage); - - FrameDisposeMode[AIndex-1] := dmErase; - end; - - InsertFrame(AIndex, AImage, 0,0, ADelayMs, dmErase, AHasLocalPalette); - end; -end; - -procedure TBGRAAnimatedGif.ReplaceFullFrame(AIndex: integer; - AImage: TFPCustomImage; ADelayMs: integer; AHasLocalPalette: boolean); -begin - DeleteFrame(AIndex, True); - if AIndex > 0 then FrameDisposeMode[AIndex-1] := dmErase; - InsertFrame(AIndex, AImage, 0,0, ADelayMs, dmErase, AHasLocalPalette); -end; - -procedure TBGRAAnimatedGif.DeleteFrame(AIndex: integer; - AEnsureNextFrameDoesNotChange: boolean); -var - nextImage: TBGRABitmap; - i: Integer; -begin - CheckFrameIndex(AIndex); - - //if this frame did not clear up, ensure that - //next image will stay the same - if AEnsureNextFrameDoesNotChange and - ((AIndex < Count-1) and (FrameDisposeMode[AIndex] <> dmErase)) then - begin - CurrentImage := AIndex+1; - nextImage := MemBitmap.Duplicate; - FrameImagePos[AIndex+1] := Point(0,0); - FrameImage[AIndex+1] := nextImage; - FrameHasLocalPalette[AIndex+1] := true; - FreeAndNil(nextImage); - end; - - dec(FTotalAnimationTime, FImages[AIndex].DelayMs); - - FImages[AIndex].Image.FreeReference; - for i := AIndex to Count-2 do - FImages[i] := FImages[i+1]; - SetLength(FImages, Count-1); - - if (CurrentImage >= Count) then - CurrentImage := 0; -end; - -procedure TBGRAAnimatedGif.LoadFromStream(Stream: TStream); -begin - LoadFromStream(Stream, maxLongint); -end; - -procedure TBGRAAnimatedGif.LoadFromStream(Stream: TStream; - AMaxImageCount: integer); -var data: TGIFData; - i: integer; -begin - data := GIFLoadFromStream(Stream, AMaxImageCount); - - ClearViewer; - Clear; - FWidth := data.Width; - FHeight := data.Height; - FBackgroundColor := data.BackgroundColor; - FAspectRatio:= data.AspectRatio; - LoopDone := 0; - LoopCount := data.LoopCount; - - SetLength(FImages, length(data.Images)); - FTotalAnimationTime:= 0; - for i := 0 to high(FImages) do - begin - FImages[i] := data.Images[i]; - inc(FTotalAnimationTime, FImages[i].DelayMs); - end; -end; - -procedure TBGRAAnimatedGif.LoadFromResource(AFilename: string); -var - stream: TStream; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - LoadFromStream(stream); - finally - stream.Free; - end; -end; - -procedure TBGRAAnimatedGif.SaveToStream(Stream: TStream); -begin - SaveToStream(Stream, BGRAColorQuantizerFactory, daFloydSteinberg); -end; - -procedure TBGRAAnimatedGif.LoadFromFile(const AFilenameUTF8: string); -var stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(stream); - finally - Stream.Free; - end; -end; - -procedure TBGRAAnimatedGif.SaveToFile(const AFilenameUTF8: string); -var - Stream: TFileStreamUTF8; -begin - Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); - try - SaveToStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TBGRAAnimatedGif.Draw(ACanvas: TCanvas; const Rect: TRect); -begin - if FBackgroundImage <> nil then - FreeAndNil(FBackgroundImage); - SaveBackgroundOnce(ACanvas, Rect); - - if FPreviousVirtualScreen <> nil then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end; - - Render(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top); - FStretchedVirtualScreen.Draw(ACanvas, Rect.Left, Rect.Top, false); - FImageChanged := False; - - FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.Duplicate); -end; - -function TBGRAAnimatedGif.GetEmpty: boolean; -begin - Result := (length(FImages) = 0); -end; - -function TBGRAAnimatedGif.GetHeight: integer; -begin - Result := FHeight; -end; - -function TBGRAAnimatedGif.GetTransparent: boolean; -begin - Result := True; -end; - -function TBGRAAnimatedGif.GetWidth: integer; -begin - Result := FWidth; -end; - -procedure TBGRAAnimatedGif.SetHeight(Value: integer); -begin - //not implemented -end; - -procedure TBGRAAnimatedGif.SetTransparent(Value: boolean); -begin - //not implemented -end; - -procedure TBGRAAnimatedGif.SetWidth(Value: integer); -begin - //not implemented -end; - -procedure TBGRAAnimatedGif.ClearViewer; -begin - FCurrentImage := -1; - FWantedImage := -1; - FTimeAccumulator := 0; - - if FStretchedVirtualScreen <> nil then - FStretchedVirtualScreen.FreeReference; - if FPreviousVirtualScreen <> nil then - FPreviousVirtualScreen.FreeReference; - FInternalVirtualScreen.Free; - FRestoreImage.Free; - FBackgroundImage.Free; - - FInternalVirtualScreen := nil; - FStretchedVirtualScreen := nil; - FRestoreImage := nil; - FBackgroundImage := nil; - FPreviousVirtualScreen := nil; - - FPreviousDisposeMode := dmNone; -end; - -procedure TBGRAAnimatedGif.SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); -begin - if (FBackgroundImage <> nil) and - ((FBackgroundImage.Width <> ARect.Right - ARect.Left) or - (FBackgroundImage.Height <> ARect.Bottom - ARect.Top)) then - FreeAndNil(FBackgroundImage); - - if (BackgroundMode in [gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously]) and - (FBackgroundImage = nil) then - begin - FBackgroundImage := TBGRABitmap.Create(ARect.Right - ARect.Left, - ARect.Bottom - ARect.Top); - FBackgroundImage.GetImageFromCanvas(Canvas, ARect.Left, ARect.Top); - end; -end; - -procedure TBGRAAnimatedGif.SetCurrentImage(Index: integer); -begin - if (Index >= 0) and (Index < Length(FImages)) then - FWantedImage := Index; -end; - -procedure TBGRAAnimatedGif.Clear; -var - i: integer; -begin - inherited Clear; - - for i := 0 to Count - 1 do - FImages[i].Image.FreeReference; - FImages := nil; - LoopDone := 0; - LoopCount := 0; -end; - -destructor TBGRAAnimatedGif.Destroy; -begin - Clear; - - if FStretchedVirtualScreen <> nil then - FStretchedVirtualScreen.FreeReference; - if FPreviousVirtualScreen <> nil then - FPreviousVirtualScreen.FreeReference; - FInternalVirtualScreen.Free; - FRestoreImage.Free; - FBackgroundImage.Free; - inherited Destroy; -end; - -procedure TBGRAAnimatedGif.Pause; -begin - FPaused := True; -end; - -procedure TBGRAAnimatedGif.Resume; -begin - FPaused := False; -end; - -procedure TBGRAAnimatedGif.Show(Canvas: TCanvas; ARect: TRect); -begin - Canvas.StretchDraw(ARect, self); -end; - -procedure TBGRAAnimatedGif.Update(Canvas: TCanvas; ARect: TRect); -var - n: integer; - PChangePix, PNewPix, PBackground, PNewBackground: PLongWord; - oldpix, newpix, newbackpix: LongWord; - NewBackgroundImage: TBGRABitmap; -begin - if (BackgroundMode = gbmUpdateBackgroundContinuously) and - (FBackgroundImage = nil) then - BackgroundMode := gbmSaveBackgroundOnce; - - SaveBackgroundOnce(Canvas, ARect); - - case BackgroundMode of - gbmSimplePaint: - begin - UpdateSimple(Canvas, ARect); - exit; - end; - gbmEraseBackground: - begin - UpdateEraseBackground(Canvas, ARect); - exit; - end; - gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously: - begin - if FPreviousVirtualScreen <> nil then - begin - if (FPreviousVirtualScreen.Width <> ARect.Right - ARect.Left) or - (FPreviousVirtualScreen.Height <> ARect.Bottom - ARect.Top) then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end - else - FPreviousVirtualScreen := TBGRABitmap(FPreviousVirtualScreen.GetUnique); - end; - - Render(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); - - if FImageChanged then - begin - if BackgroundMode = gbmUpdateBackgroundContinuously then - begin - NewBackgroundImage := - TBGRABitmap.Create(FStretchedVirtualScreen.Width, - FStretchedVirtualScreen.Height); - NewBackgroundImage.GetImageFromCanvas(Canvas, ARect.Left, ARect.Top); - - if FPreviousVirtualScreen = nil then - begin - FPreviousVirtualScreen := TBGRABitmap.Create(FWidth, FHeight); - FPreviousVirtualScreen.Fill(BGRAPixelTransparent); - end; - - PChangePix := PLongWord(FPreviousVirtualScreen.Data); - PNewPix := PLongWord(FStretchedVirtualScreen.Data); - PBackground := PLongWord(FBackgroundImage.Data); - PNewBackground := PLongWord(NewBackgroundImage.Data); - for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do - begin - oldpix := PChangePix^; - - if (oldpix and AlphaMask = AlphaMask) then //pixel opaque précédent - begin - newbackpix := PNewBackground^; - if (newbackpix <> oldpix) then //stocke nouveau fond - PBackground^ := newbackpix; - end; - - newpix := PNewPix^; - - if newpix and AlphaMask = AlphaMask then - PChangePix^ := newpix //pixel opaque - else if newpix and AlphaMask > 0 then - begin - PChangePix^ := PBackground^; - DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^); - end - else if PChangePix^ and AlphaMask <> 0 then - PChangePix^ := PBackground^; //efface précédent - -{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} - - Inc(PNewPix); - Inc(PChangePix); - Inc(PBackground); - Inc(PNewBackground); - end; - NewBackgroundImage.Free; - FPreviousVirtualScreen.InvalidateBitmap; - FPreviousVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); - FPreviousVirtualScreen.PutImage(0, 0, FStretchedVirtualScreen, dmSet); - end - else - begin - if FPreviousVirtualScreen = nil then - begin - FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); - FPreviousVirtualScreen := - TBGRABitmap(FStretchedVirtualScreen.NewReference); - end - else - begin - PChangePix := PLongWord(FPreviousVirtualScreen.Data); - PNewPix := PLongWord(FStretchedVirtualScreen.Data); - PBackground := PLongWord(FBackgroundImage.Data); - for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do - begin - newpix := PNewPix^; - - if newpix and AlphaMask = AlphaMask then - PChangePix^ := newpix //pixel opaque - else if newpix and AlphaMask > 0 then - begin - PChangePix^ := PBackground^; - DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^); - end - else if PChangePix^ and AlphaMask <> 0 then - PChangePix^ := PBackground^; //efface précédent - -{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} - - Inc(PNewPix); - Inc(PChangePix); - Inc(PBackground); - end; - FPreviousVirtualScreen.InvalidateBitmap; - FPreviousVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); - FPreviousVirtualScreen.PutImage(0, 0, FStretchedVirtualScreen, dmSet); - end; - end; - FImageChanged := False; - end; - end; - end; -end; - -procedure TBGRAAnimatedGif.Hide(Canvas: TCanvas; ARect: TRect); -var - shape: TBGRABitmap; - p, pback: PBGRAPixel; - MemEraseColor: TBGRAPixel; - n: integer; -begin - MemEraseColor := ColorToBGRA(EraseColor); - if FPreviousVirtualScreen <> nil then - begin - if (FPreviousVirtualScreen.Width <> ARect.Right - ARect.Left) or - (FPreviousVirtualScreen.Height <> ARect.Bottom - ARect.Top) then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end; - end; - - case BackgroundMode of - gbmEraseBackground, gbmSimplePaint: - begin - if FPreviousVirtualScreen <> nil then - begin - shape := TBGRABitmap(FPreviousVirtualScreen.Duplicate); - p := shape.Data; - for n := shape.NbPixels - 1 downto 0 do - begin - if p^.alpha <> 0 then - p^ := MemEraseColor - else - p^ := BGRAPixelTransparent; - Inc(p); - end; - shape.Draw(Canvas, ARect.Left, ARect.Top, false); - shape.FreeReference; - end; - end; - gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously: - begin - if (FPreviousVirtualScreen <> nil) and (FBackgroundImage <> nil) then - begin - shape := TBGRABitmap(FPreviousVirtualScreen.Duplicate); - p := shape.Data; - pback := FBackgroundImage.Data; - for n := shape.NbPixels - 1 downto 0 do - begin - if p^.alpha <> 0 then - p^ := pback^ - else - p^ := BGRAPixelTransparent; - Inc(p); - Inc(pback); - end; - shape.Draw(Canvas, ARect.Left, ARect.Top, false); - shape.FreeReference; - end; - end; - end; -end; - -procedure TBGRAAnimatedGif.UpdateEraseBackground(Canvas: TCanvas; - ARect: TRect; DrawOnlyIfChanged: boolean); -var - n: integer; - PChangePix, PNewPix: PLongWord; - newpix: LongWord; - MemPixEraseColor: LongWord; -begin - if EraseColor = clNone then - begin - UpdateSimple(Canvas, ARect, DrawOnlyIfChanged); - exit; - end; - - if FPreviousVirtualScreen <> nil then - begin - if (FPreviousVirtualScreen.Width <> ARect.Right - ARect.Left) or - (FPreviousVirtualScreen.Height <> ARect.Bottom - ARect.Top) then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end - else - FPreviousVirtualScreen := TBGRABitmap(FPreviousVirtualScreen.GetUnique); - end; - - Render(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); - if FImageChanged then - begin - PBGRAPixel(@MemPixEraseColor)^ := ColorToBGRA(EraseColor); - if FPreviousVirtualScreen = nil then - begin - FStretchedVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); - FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.NewReference); - end - else - begin - PChangePix := PLongWord(FPreviousVirtualScreen.Data); - PNewPix := PLongWord(FStretchedVirtualScreen.Data); - for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do - begin - newpix := PNewPix^; - - if newpix and AlphaMask = AlphaMask then - PChangePix^ := newpix //pixel opaque - else if newpix and AlphaMask > 0 then - begin - PChangePix^ := MemPixEraseColor; - DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^); - end - else if PChangePix^ and AlphaMask <> 0 then - PChangePix^ := MemPixEraseColor; //efface précédent -{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := MemPixEraseColor; //efface précédent} - - Inc(PNewPix); - Inc(PChangePix); - end; - FPreviousVirtualScreen.InvalidateBitmap; - FPreviousVirtualScreen.Draw(Canvas, ARect.Left, ARect.Top, false); - FPreviousVirtualScreen.PutImage(0, 0, FStretchedVirtualScreen, dmSet); - end; - - FImageChanged := False; - end; -end; - -procedure TBGRAAnimatedGif.Init; -begin - BackgroundMode := gbmSaveBackgroundOnce; - LoopCount := 0; - LoopDone := 0; -end; - -function TBGRAAnimatedGif.GetBitmap: TBitmap; -begin - Render(FWidth, FHeight); - Result := FStretchedVirtualScreen.Bitmap; -end; - -function TBGRAAnimatedGif.GetMemBitmap: TBGRABitmap; -begin - Render(FWidth, FHeight); - Result := FStretchedVirtualScreen; -end; - -{ TBGRAReaderGIF } - -procedure TBGRAReaderGIF.InternalRead(Str: TStream; Img: TFPCustomImage); -var - gif: TBGRAAnimatedGif; - x, y: integer; - Mem: TBGRABitmap; -begin - gif := TBGRAAnimatedGif.Create(Str, 1); - Mem := gif.MemBitmap; - if Img is TBGRABitmap then - begin - TBGRABitmap(Img).Assign(Mem); - end - else - begin - Img.SetSize(gif.Width, gif.Height); - for y := 0 to gif.Height - 1 do - for x := 0 to gif.Width - 1 do - with Mem.GetPixel(x, y) do - Img.Colors[x, y] := FPColor(red * $101, green * $101, blue * - $101, alpha * $101); - end; - gif.Free; -end; - -function TBGRAReaderGIF.InternalCheck(Str: TStream): boolean; -var - GIFSignature: TGIFSignature; - savepos: int64; -begin - savepos := str.Position; - try - fillchar({%H-}GIFSignature, sizeof(GIFSignature), 0); - str.Read(GIFSignature, sizeof(GIFSignature)); - if (GIFSignature[1] = 'G') and (GIFSignature[2] = 'I') and - (GIFSignature[3] = 'F') then - begin - Result := True; - end - else - Result := False; - except - on ex: Exception do - Result := False; - end; - str.Position := savepos; -end; - -{ TBGRAWriterGIF } - -procedure TBGRAWriterGIF.InternalWrite(Str: TStream; Img: TFPCustomImage); -var - gif: TBGRAAnimatedGif; -begin - gif := TBGRAAnimatedGif.Create; - try - gif.SetSize(Img.Width,Img.Height); - gif.AddFrame(Img, 0,0,0); - gif.SaveToStream(Str, BGRAColorQuantizerFactory, daFloydSteinberg); - except - on ex: EColorQuantizerMissing do - begin - FreeAndNil(gif); - raise EColorQuantizerMissing.Create('Please define the color quantizer factory. You can do that with the following statements: Uses BGRAPalette, BGRAColorQuantization; BGRAColorQuantizerFactory:= TBGRAColorQuantizer;'); - end; - on ex: Exception do - begin - FreeAndNil(gif); - raise ex; - end; - end; - FreeAndNil(gif); -end; - -initialization - - DefaultBGRAImageReader[ifGif] := TBGRAReaderGIF; - DefaultBGRAImageWriter[ifGif] := TBGRAWriterGIF; - - //Free Pascal Image - ImageHandlers.RegisterImageReader('Animated GIF', TBGRAAnimatedGif.GetFileExtensions, - TBGRAReaderGIF); - ImageHandlers.RegisterImageWriter('Animated GIF', TBGRAAnimatedGif.GetFileExtensions, - TBGRAWriterGIF); - - {$IFDEF BGRABITMAP_USE_LCL} - //Lazarus Picture - TPicture.RegisterFileFormat(TBGRAAnimatedGif.GetFileExtensions, 'Animated GIF', - TBGRAAnimatedGif); - {$ENDIF} -end. - diff --git a/components/bgrabitmap/bgraarrow.pas b/components/bgrabitmap/bgraarrow.pas deleted file mode 100644 index 4173e37..0000000 --- a/components/bgrabitmap/bgraarrow.pas +++ /dev/null @@ -1,527 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAArrow; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, BGRABitmapTypes, BGRAGraphics; - -type - { TBGRAArrow } - - TBGRAArrow = class(TBGRACustomArrow) - private - FLineCap: TPenEndCap; - FWidth : single; - FStart : ArrayOfTPointF; - FStartComputed: boolean; - FStartStyle: TBGRAArrowStyle; - FStartSizeFactor: TPointF; - FStartTipStyle: TPenJoinStyle; - FStartOffsetX: single; - FStartRepeatCount: integer; - FStartRelativePenWidth: single; - FStartTriangleBackOffset: single; - FEnd : ArrayOfTPointF; - FEndComputed: boolean; - FEndStyle: TBGRAArrowStyle; - FEndSizeFactor: TPointF; - FEndTipStyle: TPenJoinStyle; - FEndOffsetX: single; - FEndRepeatCount: integer; - FEndRelativePenWidth: single; - FEndTriangleBackOffset: single; - function ComputeAnyAt(const AData: ArrayOfTPointF; const APosition, ADirection: TPointF): ArrayOfTPointF; - function ComputeData(AStyle: TBGRAArrowStyle; const ASizeFactor: TPointF; - ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap; const AWidth: single; AOffsetX: single; - ARepeatCount: integer; ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF; - procedure SetWidth(AValue: single); - protected - function GetEndRepeatCount: integer; override; - function GetEndSizeFactor: TPointF; override; - function GetIsEndDefined: boolean; override; - function GetIsStartDefined: boolean; override; - function GetEndOffsetX: single; override; - function GetStartOffsetX: single; override; - function GetStartRepeatCount: integer; override; - function GetStartSizeFactor: TPointF; override; - procedure SetEndOffsetX(AValue: single); override; - procedure SetEndRepeatCount(AValue: integer); override; - procedure SetEndSizeFactor(AValue: TPointF); override; - procedure SetStartOffsetX(AValue: single); override; - procedure SetStartRepeatCount(AValue: integer); override; - procedure SetStartSizeFactor(AValue: TPointF); override; - function GetLineCap: TPenEndCap; override; - procedure SetLineCap(AValue: TPenEndCap); override; - procedure SetStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); - procedure SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); - public - constructor Create; - procedure StartAsNone; override; - procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; - procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; - procedure StartAsTail; override; - procedure EndAsNone; override; - procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; - procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; - procedure EndAsTail; override; - function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override; - function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override; - - end; - -implementation - -uses BGRAClasses, BGRATransform, BGRAPen, BGRAPath; - -{ TBGRAArrow } - -function TBGRAArrow.ComputeAnyAt(const AData: ArrayOfTPointF; const APosition, - ADirection: TPointF): ArrayOfTPointF; -var m: TAffineMatrix; - i: integer; -begin - if (AData = nil) or isEmptyPointF(APosition) or isEmptyPointF(ADirection) or ((ADirection.x = 0) and (ADirection.y = 0)) then - begin - result := nil; - exit; - end; - m := AffineMatrixTranslation(APosition.x,APosition.y)*AffineMatrixLinear(ADirection, PointF(-ADirection.y, ADirection.x)); - setlength(result, length(AData)); - for i := 0 to high(result) do - if not isEmptyPointF(AData[i]) then - result[i] := m*AData[i] - else - result[i] := EmptyPointF; -end; - -function TBGRAArrow.ComputeData(AStyle: TBGRAArrowStyle; - const ASizeFactor: TPointF; ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap; - const AWidth: single; AOffsetX: single; ARepeatCount: integer; - ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF; -var sizeFactorX,sizeFactorY,ofsX: single; - prefix,suffix,middle: ArrayOfTPointF; - arc: TArcDef; - i,j,n : integer; - withCut: ArrayOfTPointF; - subResult: ArrayOfTPointF; - w: single; - backOfs: single; - tailSizeX, tailAdditionalWidth: single; -begin - sizeFactorX := abs(ASizeFactor.X)*AWidth; - sizeFactorY := abs(ASizeFactor.Y)*AWidth; - if (sizeFactorX = 0) or (sizeFactorY = 0) then - begin - result := nil; - exit; - end; - w := AWidth*ARelativePenWidth; - if AStyle in [asTail,asTailRepeat] then - begin - tailSizeX := sizeFactorX/SizeFactorY*AWidth*0.5; - if AStyle = asTailRepeat then - begin - tailAdditionalWidth:= AWidth-tailSizeX; - if tailAdditionalWidth < 0 then tailAdditionalWidth := 0; - end else - tailAdditionalWidth:=0; - end - else - begin - tailSizeX := 0; - tailAdditionalWidth:=0; - end; - case AStyle of - asTriangle,asHollowTriangle: begin - backOfs := ATriangleBackOffset*sizeFactorX; - if AStyle = asHollowTriangle then - begin - result := ComputeWidePolylinePoints(PointsF([PointF(0.5*w,-AWidth*0.5), - PointF(0.5*w-backOfs,-sizeFactorY+w*0.5), - PointF(sizeFactorX-w*0.5,0), - PointF(w*0.5-backOfs,sizeFactorY-w*0.5), - PointF(0.5*w,AWidth*0.5)]), - w,BGRABlack,ALineCap,ATipStyle,nil,[plCycle]); - end else - begin - prefix := PointsF([PointF(0,-AWidth*0.5),PointF(-backOfs,-sizeFactorY)]); - suffix := PointsF([PointF(-backOfs,sizeFactorY),PointF(0,AWidth*0.5)]); - if (ATipStyle in[pjsRound,pjsBevel]) then - begin - arc := Html5ArcTo(prefix[1],PointF(sizeFactorX,0),suffix[0],AWidth*0.5); - if ATipStyle = pjsRound then - middle := ComputeArc(arc) - else - middle := PointsF([ArcStartPoint(arc),ArcEndPoint(arc)]); - end - else middle := PointsF([PointF(sizeFactorX,0)]); - result := ConcatPointsF([prefix,middle,suffix]); - end; - end; - asNormal,asCut: - begin - if AStyle = asCut then ALineCap:= pecSquare; - result := ComputeWidePolylinePoints([PointF(-sizeFactorX,-sizeFactorY), - PointF(0,0),PointF(-sizeFactorX,+sizeFactorY)],w,BGRABlack,ALineCap,ATipStyle,nil,[]); - end; - asFlipped,asFlippedCut: - begin - if AStyle = asFlippedCut then ALineCap:= pecSquare; - result := ComputeWidePolylinePoints([PointF(+sizeFactorX,-sizeFactorY), - PointF(0,0),PointF(+sizeFactorX,+sizeFactorY)],w,BGRABlack,ALineCap,ATipStyle,nil,[]); - end; - asTail: result := PointsF([PointF(0,-0.5*AWidth),PointF(tailSizeX,-0.5*AWidth),PointF(0,0),PointF(tailSizeX,0.5*AWidth),PointF(0,0.5*AWidth)]); - asTailRepeat: result := PointsF([PointF(0,-0.5*AWidth),PointF(tailSizeX+tailAdditionalWidth,-0.5*AWidth),PointF(tailAdditionalWidth,0),PointF(tailSizeX+tailAdditionalWidth,0.5*AWidth),PointF(0,0.5*AWidth),PointF(-tailSizeX,0)]); - else - result := nil; - end; - if (AStyle in [asCut,asFlippedCut,asHollowTriangle]) then - begin - n := 0; - setlength(withCut,length(result)*2); - for i := 0 to high(result) do - if isEmptyPointF(result[i]) then - begin - if (n > 0) and not isEmptyPointF(withCut[n-1]) then - begin - withCut[n] := EmptyPointF; - inc(n); - end; - end else - if abs(result[i].y)<=sizeFactorY then - begin - withCut[n] := result[i]; - inc(n); - end else - if result[i].y>sizeFactorY then - begin - j := (i+length(result)-1) mod length(result); - if result[j].y<=sizeFactorY then - begin - withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(sizeFactorY-result[j].y); - withCut[n].y := sizeFactorY; - inc(n); - end; - j := (i+1) mod length(result); - if result[j].y<=sizeFactorY then - begin - withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(sizeFactorY-result[j].y); - withCut[n].y := sizeFactorY; - inc(n); - end; - end else - if result[i].y<-sizeFactorY then - begin - j := (i+length(result)-1) mod length(result); - if result[j].y>=-sizeFactorY then - begin - withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(-sizeFactorY-result[j].y); - withCut[n].y := -sizeFactorY; - inc(n); - end; - j := (i+1) mod length(result); - if result[j].y>=-sizeFactorY then - begin - withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(-sizeFactorY-result[j].y); - withCut[n].y := -sizeFactorY; - inc(n); - end; - end; - if (n > 0) and isEmptyPointF(withCut[n-1]) then dec(n); - setlength(withCut,n); - result := withCut; - end; - if AOffsetX <> 0 then - begin - ofsX := AOffsetX*AWidth; - for i := 0 to high(result) do - if not isEmptyPointF(result[i]) then - IncF(result[i].x, ofsX); - end; - if ARepeatCount > 1 then - begin - if ARepeatCount > 10 then ARepeatCount:= 10; - if AStyle in[asTriangle,asHollowTriangle] then IncF(AOffsetX, sizeFactorX/AWidth) - else if AStyle in[asTail,asTailRepeat] then IncF(AOffsetX, (tailSizeX+tailAdditionalWidth)/AWidth+1) - else IncF(AOffsetX, 2*ARelativePenWidth); - if AStyle = asTail then AStyle := asTailRepeat; - subResult := ComputeData(AStyle,ASizeFactor,ATipStyle,ALineCap,AWidth,AOffsetX,ARepeatCount-1,ARelativePenWidth,ATriangleBackOffset); - result := ConcatPointsF([result,PointsF([EmptyPointF]),subResult]); - end; -end; - -function TBGRAArrow.GetIsEndDefined: boolean; -begin - result := FEndStyle <> asNone; -end; - -function TBGRAArrow.GetIsStartDefined: boolean; -begin - result := FStartStyle <> asNone; -end; - -function TBGRAArrow.GetEndOffsetX: single; -begin - result := FEndOffsetX; -end; - -function TBGRAArrow.GetStartOffsetX: single; -begin - result := FStartOffsetX; -end; - -function TBGRAArrow.GetStartRepeatCount: integer; -begin - result := FStartRepeatCount; -end; - -function TBGRAArrow.GetStartSizeFactor: TPointF; -begin - result := FStartSizeFactor; -end; - -procedure TBGRAArrow.SetEndOffsetX(AValue: single); -begin - if FEndOffsetX=AValue then Exit; - FEndOffsetX:=AValue; - FEndComputed:= false; - FEnd := nil; -end; - -function TBGRAArrow.GetLineCap: TPenEndCap; -begin - result := FLineCap; -end; - -procedure TBGRAArrow.SetEndRepeatCount(AValue: integer); -begin - if FEndRepeatCount=AValue then Exit; - FEndRepeatCount:=AValue; - FEndComputed:= false; - FEnd := nil; -end; - -procedure TBGRAArrow.SetEndSizeFactor(AValue: TPointF); -begin - if FEndSizeFactor=AValue then Exit; - FEndSizeFactor:=AValue; - FEndComputed:= false; - FEnd := nil; -end; - -procedure TBGRAArrow.SetLineCap(AValue: TPenEndCap); -begin - if FLineCap=AValue then Exit; - FLineCap:=AValue; - FStartComputed:= false; - FEndComputed:= false; - FStart:= nil; - FEnd := nil; -end; - -procedure TBGRAArrow.SetStartOffsetX(AValue: single); -begin - if FStartOffsetX=AValue then Exit; - FStartOffsetX:=AValue; - FStartComputed:= false; - FStart := nil; -end; - -procedure TBGRAArrow.SetStartRepeatCount(AValue: integer); -begin - if FStartRepeatCount=AValue then Exit; - FStartRepeatCount:=AValue; - FStartComputed:= false; - FStart := nil; -end; - -procedure TBGRAArrow.SetStartSizeFactor(AValue: TPointF); -begin - if FStartSizeFactor=AValue then Exit; - FStartSizeFactor:=AValue; - FStartComputed:= false; - FStart := nil; -end; - -procedure TBGRAArrow.SetWidth(AValue: single); -begin - if FWidth=AValue then Exit; - FWidth:=AValue; - FStartComputed := false; - FEndComputed:= false; -end; - -function TBGRAArrow.GetEndRepeatCount: integer; -begin - Result:= FEndRepeatCount; -end; - -function TBGRAArrow.GetEndSizeFactor: TPointF; -begin - Result:= FEndSizeFactor; -end; - -constructor TBGRAArrow.Create; -begin - FWidth := 1; - FStartSizeFactor := PointF(2,2); - FEndSizeFactor := PointF(2,2); -end; - -procedure TBGRAArrow.StartAsNone; -begin - SetStart(asNone); -end; - -procedure TBGRAArrow.StartAsClassic(AFlipped: boolean; ACut: boolean; - ARelativePenWidth: single); -var join: TPenJoinStyle; -begin - if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter; - if ACut then - begin - if AFlipped then - SetStart(asFlippedCut,join,ARelativePenWidth) - else - SetStart(asCut,join,ARelativePenWidth) - end - else - begin - if AFlipped then - SetStart(asFlipped,join,ARelativePenWidth) - else - SetStart(asNormal,join,ARelativePenWidth) - end; -end; - -procedure TBGRAArrow.StartAsTriangle(ABackOffset: single; ARounded: boolean; - AHollow: boolean; AHollowPenWidth: single); -var join: TPenJoinStyle; -begin - if ARounded then join := pjsRound else join := pjsMiter; - if AHollow then - SetStart(asHollowTriangle, join,AHollowPenWidth, ABackOffset) - else - SetStart(asTriangle, join,1,ABackOffset); -end; - -procedure TBGRAArrow.StartAsTail; -begin - SetStart(asTail); -end; - -procedure TBGRAArrow.EndAsNone; -begin - SetEnd(asNone); -end; - -procedure TBGRAArrow.EndAsClassic(AFlipped: boolean; ACut: boolean; - ARelativePenWidth: single); -var join: TPenJoinStyle; -begin - if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter; - if ACut then - begin - if AFlipped then - SetEnd(asFlippedCut,join,ARelativePenWidth) - else - SetEnd(asCut,join,ARelativePenWidth) - end - else - begin - if AFlipped then - SetEnd(asFlipped,join,ARelativePenWidth) - else - SetEnd(asNormal,join,ARelativePenWidth) - end; -end; - -procedure TBGRAArrow.EndAsTriangle(ABackOffset: single; ARounded: boolean; - AHollow: boolean; AHollowPenWidth: single); -var join: TPenJoinStyle; -begin - if ARounded then join := pjsRound else join := pjsMiter; - if AHollow then - SetEnd(asHollowTriangle, join,AHollowPenWidth, ABackOffset) - else - SetEnd(asTriangle, join,1, ABackOffset); -end; - -procedure TBGRAArrow.EndAsTail; -begin - SetEnd(asTail); -end; - -procedure TBGRAArrow.SetStart(AStyle: TBGRAArrowStyle; - ATipStyle: TPenJoinStyle; ARelativePenWidth: single; ATriangleBackOffset: single); -begin - FStartStyle := AStyle; - FStartTipStyle := ATipStyle; - FStartComputed := false; - FStartRelativePenWidth:= ARelativePenWidth; - FStartTriangleBackOffset := ATriangleBackOffset; - FStart := nil; -end; - -procedure TBGRAArrow.SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle; - ARelativePenWidth: single; ATriangleBackOffset: single); -begin - FEndStyle := AStyle; - FEndTipStyle := ATipStyle; - FEndComputed := false; - FEndRelativePenWidth:= ARelativePenWidth; - FEndTriangleBackOffset := ATriangleBackOffset; - FEnd := nil; -end; - -function TBGRAArrow.ComputeStartAt(const APosition: TPointF; - const ADirection: TPointF; const AWidth: single; const ACurrentPos: single - ): ArrayOfTPointF; -begin - if not IsStartDefined then - begin - result := nil; - exit; - end; - if AWidth <> FWidth then - begin - FWidth := AWidth; - FStartComputed:= false; - end; - if not FStartComputed then - begin - FStart := ComputeData(FStartStyle,FStartSizeFactor,FStartTipStyle,FLineCap,FWidth, - FStartOffsetX-ACurrentPos,FStartRepeatCount,FStartRelativePenWidth,FStartTriangleBackOffset); - FStartComputed:= true; - end; - result := ComputeAnyAt(FStart,APosition,ADirection); -end; - -function TBGRAArrow.ComputeEndAt(const APosition: TPointF; - const ADirection: TPointF; const AWidth: single; const ACurrentPos: single - ): ArrayOfTPointF; -begin - if not IsEndDefined then - begin - result := nil; - exit; - end; - if AWidth <> FWidth then - begin - FWidth := AWidth; - FEndComputed:= false; - end; - if not FEndComputed then - begin - FEnd := ComputeData(FEndStyle,FEndSizeFactor,FEndTipStyle,FLineCap,FWidth, - FEndOffsetX-ACurrentPos,FEndRepeatCount,FEndRelativePenWidth,FEndTriangleBackOffset); - FEndComputed:= true; - end; - result := ComputeAnyAt(FEnd,APosition,ADirection); -end; - -end. - diff --git a/components/bgrabitmap/bgrabitmap.inc b/components/bgrabitmap/bgrabitmap.inc deleted file mode 100644 index 955d85a..0000000 --- a/components/bgrabitmap/bgrabitmap.inc +++ /dev/null @@ -1,34 +0,0 @@ -{$DEFINE BGRABITMAP} -{ You can define the following compiler directives in the package options, - in tab Compiler options, in section Other. Directives must be prefixed with - "-d". So for example: - - - to always have RGBA pixel format, write "-dBGRABITMAP_RGBAPIXEL" - - to always have BGRA pixel format, write "-dBGRABITMAP_BGRAPIXEL" - - to use fpGUI toolkit, write "-dBGRABITMAP_USE_FPGUI" } -{$IFNDEF BGRABITMAP_DONT_USE_LCL} - {$IFDEF LCL} - {$DEFINE BGRABITMAP_USE_LCL} - {$ENDIF} -{$ENDIF} -{$IFDEF BGRABITMAP_USE_FPGUI} - {$UNDEF BGRABITMAP_USE_LCL} - {$DEFINE TCOLOR_BLUE_IN_LOW_BYTE} -{$ENDIF} -{$IFDEF BGRABITMAP_USE_MSEGUI} - {$UNDEF BGRABITMAP_USE_LCL} - {$DEFINE TCOLOR_BLUE_IN_LOW_BYTE} - {$DEFINE BGRABITMAP_DONT_USE_FPCANVAS} -{$ENDIF} -{$IFNDEF BGRABITMAP_DONT_USE_FPCANVAS} - {$DEFINE BGRABITMAP_USE_FPCANVAS} -{$ENDIF} - -{ Extensions of LCL to be used. Add // at the beginning of the line - to comment them if the functions are not available } -{$DEFINE BGRABITMAP_USE_LCL12} { Use functions of Lazarus 1.2 } -{$DEFINE BGRABITMAP_USE_LCL15} { Use functions of Lazarus 1.5 } - -{$MODESWITCH ADVANCEDRECORDS} -{$MODESWITCH TypeHelpers} - diff --git a/components/bgrabitmap/bgrabitmap.pas b/components/bgrabitmap/bgrabitmap.pas deleted file mode 100644 index 3929360..0000000 --- a/components/bgrabitmap/bgrabitmap.pas +++ /dev/null @@ -1,508 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - /**************************************************************************\ - bgrabitmap.pas - -------------- - Free easy-to-use memory bitmap 32-bit, - 8-bit for each channel, transparency. - Channels can be in the following orders: - - B G R A (recommended for Windows, required for fpGUI) - - R G B A (recommended for Gtk and MacOS) - - - Drawing primitives - - Resample - - Reference counter - - Drawing on LCL canvas - - Loading and saving images - - Note : line order can change, so if you access - directly to bitmap data, check LineOrder value - or use Scanline to compute position. - - - --> Include BGRABitmap and BGRABitmapTypes in the 'uses' clause. -} - -unit BGRABitmap; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -{ Compiler directives are used to include the best version according - to the platform } - -uses - BGRAClasses, BGRABitmapTypes, FPImage, SysUtils, -{$IFDEF BGRABITMAP_USE_FPGUI} - BGRAfpGUIBitmap, -{$ELSE} - {$IFDEF BGRABITMAP_USE_LCL} - {$IFDEF LCLwin32} - BGRAWinBitmap, - {$ELSE} - {$IFDEF LCLgtk} - BGRAGtkBitmap, - {$ELSE} - {$IFDEF LCLgtk2} - BGRAGtkBitmap, - {$ELSE} - {$IF defined(LCLqt) or defined(LCLqt5)} - BGRAQtBitmap, - {$ELSE} - {$IFDEF DARWIN} - BGRAMacBitmap, - {$ELSE} - BGRALCLBitmap, - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ELSE} - {$IFDEF BGRABITMAP_USE_MSEGUI} - BGRAMSEguiBitmap, - {$ELSE} - BGRANoGuiBitmap, - {$ENDIF} - {$ENDIF} -{$ENDIF} - BGRAGraphics; - -type -{$IFDEF BGRABITMAP_USE_FPGUI} - TBGRABitmap = class(TBGRAfpGUIBitmap) -{$ELSE} - {$IFDEF BGRABITMAP_USE_LCL} - {$IFDEF LCLwin32} - TBGRABitmap = class(TBGRAWinBitmap) - {$ELSE} - {$IFDEF LCLgtk} - TBGRABitmap = class(TBGRAGtkBitmap) - {$ELSE} - {$IFDEF LCLgtk2} - - { TBGRABitmap } - - TBGRABitmap = class(TBGRAGtkBitmap) - {$ELSE} - {$IF defined(LCLqt) or defined(LCLqt5)} - TBGRABitmap = class(TBGRAQtBitmap) - {$ELSE} - {$IFDEF DARWIN} - TBGRABitmap = class(TBGRAMacBitmap) - {$ELSE} - TBGRABitmap = class(TBGRALCLBitmap) - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ELSE} - {$IFDEF BGRABITMAP_USE_MSEGUI} - TBGRABitmap = class(TBGRAMSEguiBitmap) - {$ELSE} - TBGRABitmap = class(TBGRANoGUIBitmap) - {$ENDIF} - {$ENDIF} -{$ENDIF} - public - function NewBitmap: TBGRABitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer): TBGRABitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRABitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRABitmap; overload; override; - function NewBitmap(Filename: string): TBGRABitmap; overload; override; - function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRABitmap; overload; override; - function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRABitmap; overload; override; - function NewBitmap(AFPImage: TFPCustomImage): TBGRABitmap; overload; override; - function NewReference: TBGRABitmap; override; - function GetUnique: TBGRABitmap; override; - function Duplicate(DuplicateProperties: Boolean = False): TBGRABitmap; overload; override; - function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean) : TBGRABitmap; overload; override; - function GetPart(const ARect: TRect): TBGRABitmap; override; - function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel; - AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRABitmap; override; - function Resample(newWidth, newHeight: integer; - mode: TResampleMode = rmFineResample): TBGRABitmap; override; - function RotateCW: TBGRABitmap; override; - function RotateCCW: TBGRABitmap; override; - function RotateUD: TBGRABitmap; override; - function FilterSmartZoom3(Option: TMedianOption): TBGRABitmap; override; - function FilterMedian(Option: TMedianOption): TBGRABitmap; override; - function FilterSmooth: TBGRABitmap; override; - function FilterSharpen(Amount: single = 1): TBGRABitmap; overload; override; - function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRABitmap; overload; override; - function FilterContour(AGammaCorrection: boolean = false): TBGRABitmap; override; - function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRABitmap; override; - function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; - function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; - function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; - function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGRABitmap; overload; override; - function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGRABitmap; overload; override; - function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGRABitmap; overload; override; - function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGRABitmap; overload; override; - function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGRABitmap; overload; override; - function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRABitmap; overload; override; - function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRABitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean): TBGRABitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRABitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRABitmap; overload; override; - function FilterGrayscale: TBGRABitmap; overload; override; - function FilterGrayscale(ABounds: TRect): TBGRABitmap; overload; override; - function FilterNormalize(eachChannel: boolean = True): TBGRABitmap; overload; override; - function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRABitmap; overload; override; - function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRABitmap; override; - function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRABitmap; override; - function FilterSphere: TBGRABitmap; override; - function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRABitmap; overload; override; - function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRABitmap; overload; override; - function FilterCylinder: TBGRABitmap; override; - function FilterPlane: TBGRABitmap; override; - end; - -// draw a bitmap from pure data -procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - VerticalFlip: boolean; AWidth, AHeight: integer; Opaque: boolean); - -{ Replace the content of the variable Destination with the variable - Temp and frees previous object contained in Destination. - - This function is useful as a shortcut for : - - var - temp: TBGRABitmap; - begin - ... - temp := someBmp.Filter... as TBGRABitmap; - someBmp.Free; - someBmp := temp; - end; - - which becomes : - - begin - ... - BGRAReplace(someBmp, someBmp.Filter... ); - end; -} -procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject); - -implementation - -uses BGRAReadBMP, BGRAReadBmpMioMap, BGRAReadGif, - BGRAReadIco, BGRAReadJpeg, BGRAReadLzp, BGRAReadPCX, - BGRAReadPng, BGRAWritePNG, BGRAReadPSD, BGRAReadTGA, BGRAReadXPM, - BGRAWriteLzp, BGRAReadWebP, BGRAWriteWebP; - -var - tempBmp: TBGRABitmap; - -procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - VerticalFlip: boolean; AWidth, AHeight: integer; Opaque: boolean); -var - LineOrder: TRawImageLineOrder; -begin - if tempBmp = nil then - tempBmp := TBGRABitmap.Create; - if VerticalFlip then - LineOrder := riloBottomToTop - else - LineOrder := riloTopToBottom; - if Opaque then - tempBmp.DataDrawOpaque(ACanvas, Rect, AData, LineOrder, AWidth, AHeight) - else - tempBmp.DataDrawTransparent(ACanvas, Rect, AData, LineOrder, AWidth, AHeight); -end; - -procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject); -begin - Destination.Free; - Destination := Temp as TBGRABitmap; -end; - -{ TBGRABitmap } - -function TBGRABitmap.NewBitmap: TBGRABitmap; -begin - Result:=inherited NewBitmap as TBGRABitmap; -end; - -function TBGRABitmap.NewBitmap(AWidth, AHeight: integer): TBGRABitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight) as TBGRABitmap; -end; - -function TBGRABitmap.NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel - ): TBGRABitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGRABitmap; -end; - -function TBGRABitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer - ): TBGRABitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGRABitmap; -end; - -function TBGRABitmap.NewBitmap(Filename: string): TBGRABitmap; -begin - Result:=inherited NewBitmap(Filename) as TBGRABitmap; -end; - -function TBGRABitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRABitmap; -begin - Result:=inherited NewBitmap(Filename, AIsUtf8) as TBGRABitmap; -end; - -function TBGRABitmap.NewBitmap(Filename: string; AIsUtf8: boolean; - AOptions: TBGRALoadingOptions): TBGRABitmap; -begin - Result:=inherited NewBitmap(Filename, AIsUtf8, AOptions) as TBGRABitmap; -end; - -function TBGRABitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRABitmap; -begin - Result:=inherited NewBitmap(AFPImage) as TBGRABitmap; -end; - -function TBGRABitmap.NewReference: TBGRABitmap; -begin - Result:=inherited NewReference as TBGRABitmap; -end; - -function TBGRABitmap.GetUnique: TBGRABitmap; -begin - Result:=inherited GetUnique as TBGRABitmap; -end; - -function TBGRABitmap.Duplicate(DuplicateProperties: Boolean): TBGRABitmap; -begin - Result:=inherited Duplicate(DuplicateProperties) as TBGRABitmap; -end; - -function TBGRABitmap.Duplicate(DuplicateProperties, DuplicateXorMask: Boolean - ): TBGRABitmap; -begin - Result:=inherited Duplicate(DuplicateProperties, DuplicateXorMask) as TBGRABitmap; -end; - -function TBGRABitmap.GetPart(const ARect: TRect): TBGRABitmap; -begin - Result:=inherited GetPart(ARect) as TBGRABitmap; -end; - -function TBGRABitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; - APatternColor, ABackgroundColor: TBGRAPixel; AWidth: integer; - AHeight: integer; APenWidth: single): TBGRABitmap; -begin - Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor, - ABackgroundColor, AWidth, AHeight, APenWidth) as TBGRABitmap; -end; - -function TBGRABitmap.Resample(newWidth, newHeight: integer; mode: TResampleMode - ): TBGRABitmap; -begin - Result:=inherited Resample(newWidth, newHeight, mode) as TBGRABitmap; -end; - -function TBGRABitmap.RotateCW: TBGRABitmap; -begin - Result:=inherited RotateCW as TBGRABitmap; -end; - -function TBGRABitmap.RotateCCW: TBGRABitmap; -begin - Result:=inherited RotateCCW as TBGRABitmap; -end; - -function TBGRABitmap.RotateUD: TBGRABitmap; -begin - Result:=inherited RotateUD as TBGRABitmap; -end; - -function TBGRABitmap.FilterSmartZoom3(Option: TMedianOption): TBGRABitmap; -begin - Result:=inherited FilterSmartZoom3(Option) as TBGRABitmap; -end; - -function TBGRABitmap.FilterMedian(Option: TMedianOption): TBGRABitmap; -begin - Result:=inherited FilterMedian(Option) as TBGRABitmap; -end; - -function TBGRABitmap.FilterSmooth: TBGRABitmap; -begin - Result:=inherited FilterSmooth as TBGRABitmap; -end; - -function TBGRABitmap.FilterSharpen(Amount: single): TBGRABitmap; -begin - Result:=inherited FilterSharpen(Amount) as TBGRABitmap; -end; - -function TBGRABitmap.FilterSharpen(ABounds: TRect; Amount: single): TBGRABitmap; -begin - Result:=inherited FilterSharpen(ABounds, Amount) as TBGRABitmap; -end; - -function TBGRABitmap.FilterContour(AGammaCorrection: boolean = false): TBGRABitmap; -begin - Result:=inherited FilterContour(AGammaCorrection) as TBGRABitmap; -end; - -function TBGRABitmap.FilterPixelate(pixelSize: integer; useResample: boolean; - filter: TResampleFilter): TBGRABitmap; -begin - Result:=inherited FilterPixelate(pixelSize, useResample, filter) as TBGRABitmap; -end; - -function TBGRABitmap.FilterBlurRadial(radius: single; blurType: TRadialBlurType - ): TBGRABitmap; -begin - Result:=inherited FilterBlurRadial(radius, blurType) as TBGRABitmap; -end; - -function TBGRABitmap.FilterBlurRadial(const ABounds: TRect; radius: single; - blurType: TRadialBlurType): TBGRABitmap; -begin - Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TBGRABitmap; -end; - -function TBGRABitmap.FilterBlurRadial(radiusX, radiusY: single; - blurType: TRadialBlurType): TBGRABitmap; -begin - Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TBGRABitmap; -end; - -function TBGRABitmap.FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; - blurType: TRadialBlurType): TBGRABitmap; -begin - Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TBGRABitmap; -end; - -function TBGRABitmap.FilterBlurMotion(distance: single; angle: single; - oriented: boolean): TBGRABitmap; -begin - Result:=inherited FilterBlurMotion(distance, angle, oriented) as TBGRABitmap; -end; - -function TBGRABitmap.FilterBlurMotion(const ABounds: TRect; distance: single; - angle: single; oriented: boolean): TBGRABitmap; -begin - Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TBGRABitmap; -end; - -function TBGRABitmap.FilterCustomBlur(mask: TCustomUniversalBitmap - ): TBGRABitmap; -begin - Result:=inherited FilterCustomBlur(mask) as TBGRABitmap; -end; - -function TBGRABitmap.FilterCustomBlur(const ABounds: TRect; - mask: TCustomUniversalBitmap): TBGRABitmap; -begin - Result:=inherited FilterCustomBlur(ABounds, mask) as TBGRABitmap; -end; - -function TBGRABitmap.FilterEmboss(angle: single; AStrength: integer; - AOptions: TEmbossOptions): TBGRABitmap; -begin - Result:=inherited FilterEmboss(angle, AStrength, AOptions) as TBGRABitmap; -end; - -function TBGRABitmap.FilterEmboss(angle: single; ABounds: TRect; - AStrength: integer; AOptions: TEmbossOptions): TBGRABitmap; -begin - Result:=inherited FilterEmboss(angle, ABounds, AStrength, AOptions) as TBGRABitmap; -end; - -function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean): TBGRABitmap; -begin - Result:=inherited FilterEmbossHighlight(FillSelection) as TBGRABitmap; -end; - -function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean; - BorderColor: TBGRAPixel): TBGRABitmap; -begin - Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor) as TBGRABitmap; -end; - -function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean; - BorderColor: TBGRAPixel; var Offset: TPoint): TBGRABitmap; -begin - Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor, Offset) as TBGRABitmap; -end; - -function TBGRABitmap.FilterGrayscale: TBGRABitmap; -begin - Result:=inherited FilterGrayscale as TBGRABitmap; -end; - -function TBGRABitmap.FilterGrayscale(ABounds: TRect): TBGRABitmap; -begin - Result:=inherited FilterGrayscale(ABounds) as TBGRABitmap; -end; - -function TBGRABitmap.FilterNormalize(eachChannel: boolean): TBGRABitmap; -begin - Result:=inherited FilterNormalize(eachChannel) as TBGRABitmap; -end; - -function TBGRABitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean - ): TBGRABitmap; -begin - Result:=inherited FilterNormalize(ABounds, eachChannel) as TBGRABitmap; -end; - -function TBGRABitmap.FilterRotate(origin: TPointF; angle: single; - correctBlur: boolean): TBGRABitmap; -begin - Result:=inherited FilterRotate(origin, angle, correctBlur) as TBGRABitmap; -end; - -function TBGRABitmap.FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean - ): TBGRABitmap; -begin - Result:=inherited FilterAffine(AMatrix, correctBlur) as TBGRABitmap; -end; - -function TBGRABitmap.FilterSphere: TBGRABitmap; -begin - Result:=inherited FilterSphere as TBGRABitmap; -end; - -function TBGRABitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; - ATurn: Single; AExponent: Single): TBGRABitmap; -begin - Result:=inherited FilterTwirl(ACenter, ARadius, ATurn, AExponent) as TBGRABitmap; -end; - -function TBGRABitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint; - ARadius: Single; ATurn: Single; AExponent: Single): TBGRABitmap; -begin - Result:=inherited FilterTwirl(ABounds, ACenter, ARadius, ATurn, AExponent) as TBGRABitmap; -end; - -function TBGRABitmap.FilterCylinder: TBGRABitmap; -begin - Result:=inherited FilterCylinder as TBGRABitmap; -end; - -function TBGRABitmap.FilterPlane: TBGRABitmap; -begin - Result:=inherited FilterPlane as TBGRABitmap; -end; - -initialization - - //this variable is assigned to access appropriate functions - //depending on the platform - BGRABitmapFactory := TBGRABitmap; - -finalization - - tempBmp.Free; - -end. - diff --git a/components/bgrabitmap/bgrabitmappack.lpk b/components/bgrabitmap/bgrabitmappack.lpk deleted file mode 100644 index 207d824..0000000 --- a/components/bgrabitmap/bgrabitmappack.lpk +++ /dev/null @@ -1,624 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <_ExternHelp Items="Count"/> - - - diff --git a/components/bgrabitmap/bgrabitmappack.pas b/components/bgrabitmap/bgrabitmappack.pas deleted file mode 100644 index 8c46a1f..0000000 --- a/components/bgrabitmap/bgrabitmappack.pas +++ /dev/null @@ -1,36 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit BGRABitmapPack; - -{$warn 5023 off : no warning about unused units} -interface - -uses - BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, - BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, - BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, - BGRAFreeType, BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, - BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, - BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, - BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRAText, BGRATextFX, - BGRATransform, BGRATypewriter, BGRAVectorize, BGRAGrayscaleMask, - BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, BGRAReadPSD, - BGRAThumbnail, BGRAReadTGA, BGRAReadIco, BGRAReadJpeg, BGRAReadLzp, - UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRASVG, BGRAUnits, - BGRASVGShapes, BGRASVGType, BGRAReadBmpMioMap, BGRAArrow, BGRAPalette, - BGRAColorQuantization, BGRADithering, BGRAUTF8, BGRALCLBitmap, BGRAWritePNG, - BGRAGifFormat, BGRAGraphics, BGRASceneTypes, BGRARenderer3D, - BGRAWriteBmpMioMap, BGRAOpenGLType, BGRASpriteGL, BGRAOpenGL, BGRACanvasGL, - BGRAFontGL, BGRAOpenGL3D, BGRAPhoxo, BGRAFilterScanner, BGRAFilterType, - BGRAFilterBlur, BGRAMultiFileType, BGRAWinResource, BGRALazResource, - BGRAIconCursor, BGRABlurGL, BGRAReadTiff, BGRALazPaint, BGRAMemDirectory, - BGRAUnicode, BGRATextBidi, BGRALayerOriginal, BGRASVGOriginal, - BGRAGradientOriginal, BGRAUnicodeText, UniversalDrawer, LinearRGBABitmap, - XYZABitmap, BGRAWriteTiff, WordXYZABitmap, ExpandedBitmap, libwebp, - linuxlib, BGRAReadWebP, BGRAWriteWebP, BGRAClasses; - -implementation - -end. diff --git a/components/bgrabitmap/bgrabitmappack4fpgui.lpk b/components/bgrabitmap/bgrabitmappack4fpgui.lpk deleted file mode 100644 index 9df1aec..0000000 --- a/components/bgrabitmap/bgrabitmappack4fpgui.lpk +++ /dev/null @@ -1,481 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <_ExternHelp Items="Count"/> - - - diff --git a/components/bgrabitmap/bgrabitmappack4fpgui.pas b/components/bgrabitmap/bgrabitmappack4fpgui.pas deleted file mode 100644 index 596f378..0000000 --- a/components/bgrabitmap/bgrabitmappack4fpgui.pas +++ /dev/null @@ -1,30 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit BGRABitmapPack4fpGUI; - -{$warn 5023 off : no warning about unused units} -interface - -uses - BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, - BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, - BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, - BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, - BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, - BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, - BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRATransform, - BGRAGrayscaleMask, BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, - BGRAReadPSD, BGRAThumbnail, BGRAReadTGA, BGRAReadJpeg, BGRAReadLzp, - UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRAUnits, - BGRAReadBmpMioMap, BGRAArrow, BGRAGraphics, BGRAUTF8, BGRAfpGUIBitmap, - BGRATypewriter, BGRASVG, BGRASVGShapes, BGRASVGType, BGRAPalette, - BGRAColorQuantization, BGRADithering, BGRAFreeType, BGRACustomTextFX, - BGRAWritePNG, BGRAGifFormat, BGRASceneTypes, BGRARenderer3D, - BGRAWriteBmpMioMap, BGRAPhoxo, BGRAFilterScanner, BGRAFilterType, - BGRAFilterBlur, BGRAMultiFileType, BGRAWinResource, BGRAUnicode, BGRAClasses; - -implementation - -end. diff --git a/components/bgrabitmap/bgrabitmappack4nogui.lpk b/components/bgrabitmap/bgrabitmappack4nogui.lpk deleted file mode 100644 index aa56667..0000000 --- a/components/bgrabitmap/bgrabitmappack4nogui.lpk +++ /dev/null @@ -1,492 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <_ExternHelp Items="Count"/> - - - diff --git a/components/bgrabitmap/bgrabitmappack4nogui.pas b/components/bgrabitmap/bgrabitmappack4nogui.pas deleted file mode 100644 index 2f2d0cc..0000000 --- a/components/bgrabitmap/bgrabitmappack4nogui.pas +++ /dev/null @@ -1,31 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit BGRABitmapPack4NoGUI; - -{$warn 5023 off : no warning about unused units} -interface - -uses - BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, - BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, - BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, - BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, - BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, - BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, - BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRATransform, - BGRAGrayscaleMask, BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, - BGRAReadPSD, BGRAThumbnail, BGRAReadTGA, BGRAReadJpeg, BGRAReadLzp, - UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRAUnits, - BGRAReadBmpMioMap, BGRAArrow, BGRAGraphics, BGRAUTF8, BGRATypewriter, - BGRASVG, BGRASVGShapes, BGRASVGType, BGRAPalette, BGRAColorQuantization, - BGRADithering, BGRAFreeType, BGRACustomTextFX, BGRAWritePNG, BGRAGifFormat, - BGRANoGUIBitmap, BGRASceneTypes, BGRARenderer3D, BGRAWriteBmpMioMap, - BGRASpriteGL, BGRAOpenGLType, BGRAOpenGL, BGRACanvasGL, BGRAPhoxo, - BGRAFilterScanner, BGRAFilterType, BGRAFilterBlur, BGRAMultiFileType, - BGRAWinResource, BGRAUnicode, BGRAClasses; - -implementation - -end. diff --git a/components/bgrabitmap/bgrabitmaptypes.pas b/components/bgrabitmap/bgrabitmaptypes.pas deleted file mode 100644 index 4a416bc..0000000 --- a/components/bgrabitmap/bgrabitmaptypes.pas +++ /dev/null @@ -1,1533 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - /**************************************************************************\ - bgrabitmaptypes.pas - ------------------- - This unit defines basic types and it must be - included in the 'uses' clause. - - --> Include BGRABitmap and BGRABitmapTypes in the 'uses' clause. - If you are using LCL types, add also BGRAGraphics unit. -} - -unit BGRABitmapTypes; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, BGRAGraphics, BGRAUnicode, - FPImage{$IFDEF BGRABITMAP_USE_FPCANVAS}, FPImgCanv{$ENDIF} - {$IFDEF BGRABITMAP_USE_LCL}, LCLType, GraphType, LResources{$ENDIF}, - BGRAMultiFileType; - - -const - BGRABitmapVersion = 11030100; - - function BGRABitmapVersionStr: string; - -type - TMultiFileContainer = BGRAMultiFileType.TMultiFileContainer; - Int32or64 = BGRAClasses.Int32or64; - UInt32or64 = BGRAClasses.UInt32or64; - HDC = {$IFDEF BGRABITMAP_USE_LCL}LCLType.HDC{$ELSE}PtrUInt{$ENDIF}; - -{=== Miscellaneous types ===} - -type - {* Options when doing a floodfill (also called bucket fill) } - TFloodfillMode = ( - {** Pixels that are filled are replaced } - fmSet, - {** Pixels that are filled are drawn upon with the fill color } - fmDrawWithTransparency, - {** Pixels that are filled are drawn without gamma correction upon with the fill color } - fmLinearBlend, - {** Pixels that are XORed with the fill color} - fmXor, - {** Pixels that are filled are drawn upon to the extent that the color underneath is similar to - the start color. The more different the different is, the less it is drawn upon } - fmProgressive); - - {* Specifies how much smoothing is applied to the computation of the median } - TMedianOption = (moNone, moLowSmooth, moMediumSmooth, moHighSmooth); - {* Specifies the shape of a predefined blur } - TRadialBlurType = ( - {** Gaussian-like, pixel importance decreases progressively } - rbNormal, - {** Disk blur, pixel importance does not decrease progressively } - rbDisk, - {** Pixel are considered when they are at a certain distance } - rbCorona, - {** Gaussian-like, but 10 times smaller than ''rbNormal'' } - rbPrecise, - {** Gaussian-like but simplified to be computed faster } - rbFast, - {** Box blur, pixel importance does not decrease progressively - and the pixels are included when they are in a square. - This is much faster than ''rbFast'' however you may get - square shapes in the resulting image } - rbBox); - - TEmbossOption = (eoTransparent, eoPreserveHue); - TEmbossOptions = set of TEmbossOption; - - {* List of image formats } - TBGRAImageFormat = ( - {** Unknown format } - ifUnknown, - {** JPEG format, opaque, lossy compression } - ifJpeg, - {** PNG format, transparency, lossless compression } - ifPng, - {** GIF format, single transparent color, lossless in theory but only low number of colors allowed } - ifGif, - {** BMP format, transparency, no compression. Note that transparency is - not supported by all BMP readers so it is recommended to avoid - storing images with transparency in this format } - ifBmp, - {** iGO BMP (16-bit, rudimentary lossless compression) } - ifBmpMioMap, - {** ICO format, contains different sizes of the same image } - ifIco, - {** CUR format, has hotspot, contains different sizes of the same image } - ifCur, - {** PCX format, opaque, rudimentary lossless compression } - ifPcx, - {** Paint.NET format, layers, lossless compression } - ifPaintDotNet, - {** LazPaint format, layers, lossless compression } - ifLazPaint, - {** OpenRaster format, layers, lossless compression } - ifOpenRaster, - {** Phoxo format, layers } - ifPhoxo, - {** Photoshop format, layers, rudimentary lossless compression } - ifPsd, - {** Targa format (TGA), transparency, rudimentary lossless compression } - ifTarga, - {** TIFF format, limited support } - ifTiff, - {** X-Window capture, limited support } - ifXwd, - {** X-Pixmap, text encoded image, limited support } - ifXPixMap, - {** text or binary encoded image, no compression, extension PBM, PGM, PPM } - ifPortableAnyMap, - {** Scalable Vector Graphic, vectorial, read-only as raster } - ifSvg, - {** Lossless or lossy compression using V8 algorithm (need libwebp library) } - ifWebP); - - {* Options when loading an image } - TBGRALoadingOption = ( - {** Do not clear RGB channels when alpha is zero (not recommended) } - loKeepTransparentRGB, - {** Consider BMP to be opaque if no alpha value is provided (for compatibility) } - loBmpAutoOpaque, - {** Load JPEG quickly however with a lower quality } - loJpegQuick); - TBGRALoadingOptions = set of TBGRALoadingOption; - - TTextLayout = BGRAGraphics.TTextLayout; - TFontBidiMode = BGRAUnicode.TFontBidiMode; - TBidiTextAlignment = (btaNatural, btaOpposite, btaLeftJustify, btaRightJustify, btaCenter); - -const - fbmAuto = BGRAUnicode.fbmAuto; - fbmLeftToRight = BGRAUnicode.fbmLeftToRight; - fbmRightToLeft = BGRAUnicode.fbmRightToLeft; - - function AlignmentToBidiTextAlignment(AAlign: TAlignment; ARightToLeft: boolean): TBidiTextAlignment; overload; - function AlignmentToBidiTextAlignment(AAlign: TAlignment): TBidiTextAlignment; overload; - function BidiTextAlignmentToAlignment(ABidiAlign: TBidiTextAlignment; ARightToLeft: boolean): TAlignment; - -const - RadialBlurTypeToStr: array[TRadialBlurType] of string = - ('Normal','Disk','Corona','Precise','Fast','Box'); - - - tlTop = BGRAGraphics.tlTop; - tlCenter = BGRAGraphics.tlCenter; - tlBottom = BGRAGraphics.tlBottom; - - // checks the bounds of an image in the given clipping rectangle - function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, maxyb, ignoreleft: integer; const cliprect: TRect): boolean; - -{==== Imported from GraphType ====} -//if this unit is defined, otherwise -//define here the types used by the library. -{$IFDEF BGRABITMAP_USE_LCL} - type - { Order of the lines in an image } - TRawImageLineOrder = GraphType.TRawImageLineOrder; - { Order of the bits in a byte containing pixel values } - TRawImageBitOrder = GraphType.TRawImageBitOrder; - { Order of the bytes in a group of byte containing pixel values } - TRawImageByteOrder = GraphType.TRawImageByteOrder; - { Definition of a single line 3D bevel } - TGraphicsBevelCut = GraphType.TGraphicsBevelCut; - - const - riloTopToBottom = GraphType.riloTopToBottom; // The first line (line 0) is the top line - riloBottomToTop = GraphType.riloBottomToTop; // The first line (line 0) is the bottom line - - riboBitsInOrder = GraphType.riboBitsInOrder; // Bit 0 is pixel 0 - riboReversedBits = GraphType.riboReversedBits; // Bit 0 is pixel 7 (Bit 1 is pixel 6, ...) - - riboLSBFirst = GraphType.riboLSBFirst; // least significant byte first (little endian) - riboMSBFirst = GraphType.riboMSBFirst; // most significant byte first (big endian) - - fsSurface = GraphType.fsSurface; //type is defined as Graphics.TFillStyle - fsBorder = GraphType.fsBorder; - - bvNone = GraphType.bvNone; - bvLowered = GraphType.bvLowered; - bvRaised = GraphType.bvRaised; - bvSpace = GraphType.bvSpace; -{$ELSE} - type - {* Order of the lines in an image } - TRawImageLineOrder = ( - {** The first line in memory (line 0) is the top line } - riloTopToBottom, - {** The first line in memory (line 0) is the bottom line } - riloBottomToTop); - - {* Order of the bits in a byte containing pixel values } - TRawImageBitOrder = ( - {** The lowest bit is on the left. So with a monochrome picture, bit 0 would be pixel 0 } - riboBitsInOrder, - {** The lowest bit is on the right. So with a momochrome picture, bit 0 would be pixel 7 (bit 1 would be pixel 6, ...) } - riboReversedBits); - - {* Order of the bytes in a group of byte containing pixel values } - TRawImageByteOrder = ( - {** Least significant byte first (little endian) } - riboLSBFirst, - {** most significant byte first (big endian) } - riboMSBFirst); - - {* Definition of a single line 3D bevel } - TGraphicsBevelCut = - ( - {** No bevel } - bvNone, - {** Shape is lowered, light is on the bottom-right corner } - bvLowered, - {** Shape is raised, light is on the top-left corner } - bvRaised, - {** Shape is at the same level, there is no particular lighting } - bvSpace); -{$ENDIF} - -{$DEFINE INCLUDE_INTERFACE} -{$I bgrapixel.inc} - -{$DEFINE INCLUDE_INTERFACE} -{$I geometrytypes.inc} - -{$DEFINE INCLUDE_INTERFACE} -{$i csscolorconst.inc} - -{$DEFINE INCLUDE_INTERFACE} -{$I bgrascanner.inc} - -{$DEFINE INCLUDE_INTERFACE} -{$I unibitmap.inc} - -{$DEFINE INCLUDE_INTERFACE} -{$I unibitmapgeneric.inc} - -{==== Integer math ====} - - {* Computes the value modulo cycle, and if the ''value'' is negative, the result - is still positive } - function PositiveMod(value, cycle: Int32or64): Int32or64; inline; overload; - - { Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values. - They use a table to store already computed values. The return value is an integer - ranging from 0 to 65536, so the mean value is 32768 and the half amplitude is - 32768 instead of 1. The input has a period of 65536, so you can supply any integer - without applying a modulo. } - - { Compute all values now } - procedure PrecalcSin65536; - - {* Returns an integer approximation of the sine. Value ranges from 0 to 65535, - where 65536 corresponds to the next cycle } - function Sin65536(value: word): Int32or64; inline; - {* Returns an integer approximation of the cosine. Value ranges from 0 to 65535, - where 65536 corresponds to the next cycle } - function Cos65536(value: word): Int32or64; inline; - - {* Returns the square root of the given byte, considering that - 255 is equal to unity } - function ByteSqrt(value: byte): byte; inline; - -{==== Types provided for fonts ====} -type - {* Quality to be used to render text } - TBGRAFontQuality = ( - {** Use the system capabilities. It is rather fast however it may be - not be smoothed. } - fqSystem, - {** Use the system capabilities to render with ClearType. This quality is - of course better than fqSystem however it may not be perfect.} - fqSystemClearType, - {** Garanties a high quality antialiasing. } - fqFineAntialiasing, - {** Fine antialiasing with ClearType assuming an LCD display in red/green/blue order } - fqFineClearTypeRGB, - {** Fine antialiasing with ClearType assuming an LCD display in blue/green/red order } - fqFineClearTypeBGR); - - TGetFineClearTypeAutoFunc = function(): TBGRAFontQuality; -var - fqFineClearType : TGetFineClearTypeAutoFunc; - -type - {* Measurements of a font } - TFontPixelMetric = record - {** The values have been computed } - Defined: boolean; - {** Position of the baseline, where most letters lie } - Baseline, - {** Position of the top of the small letters (x being one of them) } - xLine, - {** Position of the top of the UPPERCASE letters } - CapLine, - {** Position of the bottom of letters like g and p } - DescentLine, - {** Total line height including line spacing defined by the font } - Lineheight: integer; - end; - - {* Measurements of a font in floating point values } - TFontPixelMetricF = record - {** The values have been computed } - Defined: boolean; - {** Position of the baseline, where most letters lie } - Baseline, - {** Position of the top of the small letters (x being one of them) } - xLine, - {** Position of the top of the UPPERCASE letters } - CapLine, - {** Position of the bottom of letters like g and p } - DescentLine, - {** Total line height including line spacing defined by the font } - Lineheight: single; - end; - - {* Vertical anchoring of the font. When text is drawn, a start coordinate - is necessary. Text can be positioned in different ways. This enum - defines what position it is regarding the font } - TFontVerticalAnchor = ( - {** The top of the font. Everything will be drawn below the start coordinate. } - fvaTop, - {** The center of the font } - fvaCenter, - {** The top of capital letters } - fvaCapLine, - {** The center of capital letters } - fvaCapCenter, - {** The top of small letters } - fvaXLine, - {** The center of small letters } - fvaXCenter, - {** The baseline, the bottom of most letters } - fvaBaseline, - {** The bottom of letters that go below the baseline } - fvaDescentLine, - {** The bottom of the font. Everything will be drawn above the start coordinate } - fvaBottom); - - {* Definition of a function that handles work-break } - TWordBreakHandler = procedure(var ABeforeUTF8, AAfterUTF8: string) of object; - - {* Alignment for a typewriter, that does not have any more information - than a square shape containing glyphs } - TBGRATypeWriterAlignment = (twaTopLeft, twaTop, twaTopRight, twaLeft, twaMiddle, twaRight, twaBottomLeft, twaBottom, twaBottomRight); - {* How a typewriter must render its content on a Canvas2d } - TBGRATypeWriterOutlineMode = (twoPath, twoFill, twoStroke, twoFillOverStroke, twoStrokeOverFill, twoFillThenStroke, twoStrokeThenFill); - - { TBGRACustomFontRenderer } - {* Abstract class for all font renderers } - TBGRACustomFontRenderer = class - protected - {** Specifies the height of the font without taking into account additional line spacing. - A negative value means that it is the full height instead } - FFontEmHeightF: single; - function GetFontEmHeight: integer; - procedure SetFontEmHeight(AValue: integer); - public - {** Specifies the font to use. Unless the font renderer accept otherwise, - the name is in human readable form, like 'Arial', 'Times New Roman', ... } - FontName: string; - - {** Specifies the set of styles to be applied to the font. - These can be fsBold, fsItalic, fsStrikeOut, fsUnderline. - So the value [fsBold,fsItalic] means that the font must be bold and italic } - FontStyle: TFontStyles; - - {** Specifies the quality of rendering. Default value is fqSystem } - FontQuality : TBGRAFontQuality; - - {** Specifies the rotation of the text, for functions that support text rotation. - It is expressed in tenth of degrees, positive values going counter-clockwise } - FontOrientation: integer; - - {** Returns measurement for the current font in pixels } - function GetFontPixelMetric: TFontPixelMetric; virtual; abstract; - function GetFontPixelMetricF: TFontPixelMetricF; virtual; - function FontExists(AName: string): boolean; virtual; abstract; - - {** Returns the total size of the string provided using the current font. - Orientation is not taken into account, so that the width is along the text } - function TextSize(sUTF8: string): TSize; overload; virtual; abstract; - function TextSizeF(sUTF8: string): TPointF; overload; virtual; - function TextSize(sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; overload; virtual; abstract; - function TextSizeF(sUTF8: string; AMaxWidthF: single; ARightToLeft: boolean): TPointF; overload; virtual; - function TextSizeAngle(sUTF8: string; {%H-}orientationTenthDegCCW: integer): TSize; virtual; - function TextSizeAngleF(sUTF8: string; {%H-}orientationTenthDegCCW: integer): TPointF; virtual; - - {** Returns the number of Unicode characters that fit into the specified size } - function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; virtual; abstract; - function TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; virtual; - - {** Draws the UTF8 encoded string, with color ''c''. - If align is taLeftJustify, (''x'',''y'') is the top-left corner. - If align is taCenter, (''x'',''y'') is at the top and middle of the text. - If align is taRightJustify, (''x'',''y'') is the top-right corner. - The value of ''FontOrientation'' is taken into account, so that the text may be rotated } - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; abstract; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; - - {** Same as above functions, except that the text is filled using texture. - The value of ''FontOrientation'' is taken into account, so that the text may be rotated } - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; abstract; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; - - {** Same as above, except that the orientation is specified, overriding the value of the property ''FontOrientation'' } - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; abstract; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; - {** Same as above, except that the orientation is specified, overriding the value of the property ''FontOrientation'' } - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; abstract; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment; {%H-}ARightToLeft: boolean); overload; virtual; - - {** Draw the UTF8 encoded string at the coordinate (''x'',''y''), clipped inside the rectangle ''ARect''. - Additional style information is provided by the style parameter. - The color ''c'' is used to fill the text. No rotation is applied. } - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; virtual; abstract; - - {** Same as above except a ''texture'' is used to fill the text } - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; virtual; abstract; - - {** Copy the path for the UTF8 encoded string into ''ADest''. - If ''align'' is ''taLeftJustify'', (''x'',''y'') is the top-left corner. - If ''align'' is ''taCenter'', (''x'',''y'') is at the top and middle of the text. - If ''align'' is ''taRightJustify'', (''x'',''y'') is the top-right corner. } - procedure CopyTextPathTo({%H-}ADest: IBGRAPath; {%H-}x, {%H-}y: single; {%H-}s: string; {%H-}align: TAlignment); virtual; //optional - procedure CopyTextPathTo({%H-}ADest: IBGRAPath; {%H-}x, {%H-}y: single; {%H-}s: string; {%H-}align: TAlignment; {%H-}ARightToLeft: boolean); virtual; //optional - function HandlesTextPath: boolean; virtual; - - property FontEmHeight: integer read GetFontEmHeight write SetFontEmHeight; - property FontEmHeightF: single read FFontEmHeightF write FFontEmHeightF; - end; - - {* Output mode for the improved renderer for readability. This is used by the font renderer based on LCL in ''BGRAText'' } - TBGRATextOutImproveReadabilityMode = (irMask, irNormal, irClearTypeRGB, irClearTypeBGR); - -{** Removes line ending and tab characters from a string (for a function - like ''TextOut'' that does not handle this). this works with UTF8 strings - as well } -function CleanTextOutString(const s: string): string; -{** Remove the line ending at the specified position or return False. - This works with UTF8 strings however the index is the byte index } -function RemoveLineEnding(var s: string; indexByte: integer): boolean; -{** Remove the line ending at the specified position or return False. - The index is the character index, that may be different from the - byte index } -function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; -{** Default word break handler } -procedure BGRADefaultWordBreakHandler(var ABefore, AAfter: string); - -{==== Images and resampling ====} - -type - {* How the resample is to be computed } - TResampleMode = ( - {** Low quality resample by repeating pixels, stretching them } - rmSimpleStretch, - {** Use resample filters. This gives high - quality resampling however this the proportion changes slightly because - the first and last pixel are considered to occupy only half a unit as - they are considered as the border of the picture - (pixel-centered coordinates) } - rmFineResample); - - {* List of resample filter to be used with ''rmFineResample'' } - TResampleFilter = ( - {** Equivalent of simple stretch with high quality and pixel-centered coordinates } - rfBox, - {** Linear interpolation giving slow transition between pixels } - rfLinear, - {** Mix of ''rfLinear'' and ''rfCosine'' giving medium speed stransition between pixels } - rfHalfCosine, - {** Cosine-like interpolation giving fast transition between pixels } - rfCosine, - {** Simple bi-cubic filter (blurry) } - rfBicubic, - {** Mitchell filter, good for downsizing interpolation } - rfMitchell, - {** Spline filter, good for upsizing interpolation, however slightly blurry } - rfSpline, - {** Lanczos with radius 2, blur is corrected } - rfLanczos2, - {** Lanczos with radius 3, high contrast } - rfLanczos3, - {** Lanczos with radius 4, high contrast } - rfLanczos4, - {** Best quality using rfMitchell or rfSpline } - rfBestQuality); - -const - {** List of strings to represent resample filters } - ResampleFilterStr : array[TResampleFilter] of string = - ('Box','Linear','HalfCosine','Cosine','Bicubic','Mitchell','Spline', - 'Lanczos2','Lanczos3','Lanczos4','BestQuality'); - - {** Gives the sample filter represented by a string } - function StrToResampleFilter(str: string): TResampleFilter; - -type - {* Image information from superficial analysis } - TQuickImageInfo = record - {** Width in pixels } - Width, - {** Height in pixels } - Height, - {** Bitdepth for colors (1, 2, 4, 8 for images with palette/grayscale, 16, 24 or 48 if each channel is present) } - ColorDepth, - {** Bitdepth for alpha (0 if no alpha channel, 1 if bit mask, 8 or 16 if alpha channel) } - AlphaDepth: integer; - end; - - {* Bitmap reader with additional features } - TBGRAImageReader = class(TFPCustomImageReader) - {** Return bitmap information (size, bit depth) } - function GetQuickInfo(AStream: TStream): TQuickImageInfo; virtual; abstract; - {** Return a draft of the bitmap, the ratio may change compared to the original width and height (useful to make thumbnails) } - function GetBitmapDraft(AStream: TStream; AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; virtual; abstract; - end; - - { TBGRACustomWriterPNG } - - TBGRACustomWriterPNG = class(TFPCustomImageWriter) - protected - function GetUseAlpha: boolean; virtual; abstract; - procedure SetUseAlpha(AValue: boolean); virtual; abstract; - public - property UseAlpha : boolean read GetUseAlpha write SetUseAlpha; - end; - -var - {** List of stream readers for images } - DefaultBGRAImageReader: array[TBGRAImageFormat] of TFPCustomImageReaderClass; - {** List of stream writers for images } - DefaultBGRAImageWriter: array[TBGRAImageFormat] of TFPCustomImageWriterClass; - - {** Detect the file format of a given file } - function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat; - {** Detect the file format of a given stream. ''ASuggestedExtensionUTF8'' can - be provided to guess the format } - function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string = ''): TBGRAImageFormat; - {** Returns the file format that is most likely to be stored in the - given filename (according to its extension) } - function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat; - {** Returns a likely image extension for the format } - function SuggestImageExtension(AFormat: TBGRAImageFormat): string; - {** Create an image reader for the given format } - function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader; - {** Create an image writer for the given format. ''AHasTransparentPixels'' - specifies if alpha channel must be supported } - function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter; - -{$DEFINE INCLUDE_INTERFACE} -{$I bgracustombitmap.inc} - -operator =(const AGuid1, AGuid2: TGuid): boolean; - -type - { TBGRAResourceManager } - - TBGRAResourceManager = class - protected - function GetWinResourceType(AExtension: string): pchar; - public - function GetResourceStream(AFilename: string): TStream; virtual; - function IsWinResource(AFilename: string): boolean; virtual; - end; - -var - BGRAResource : TBGRAResourceManager; - -implementation - -uses Math, SysUtils, BGRAUTF8, - FPReadXwd, FPReadXPM, - FPWriteJPEG, FPWriteBMP, FPWritePCX, - FPWriteTGA, FPWriteXPM, FPReadPNM, FPWritePNM; - -function BGRABitmapVersionStr: string; -var numbers: TStringList; - i,remaining: LongWord; -begin - numbers := TStringList.Create; - remaining := BGRABitmapVersion; - for i := 1 to 4 do - begin - numbers.Insert(0, IntToStr(remaining mod 100)); - remaining := remaining div 100; - end; - while (numbers.Count > 1) and (numbers[numbers.Count-1]='0') do - numbers.Delete(numbers.Count-1); - numbers.Delimiter:= '.'; - result := numbers.DelimitedText; - numbers.Free; -end; - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I geometrytypes.inc} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I unibitmap.inc} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I unibitmapgeneric.inc} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I csscolorconst.inc} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I bgracustombitmap.inc} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I bgrascanner.inc} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I bgrapixel.inc} - -function AlignmentToBidiTextAlignment(AAlign: TAlignment; ARightToLeft: boolean): TBidiTextAlignment; -begin - case AAlign of - taCenter: result := btaCenter; - taRightJustify: if ARightToLeft then result := btaNatural else result := btaOpposite; - else {taLeftJustify} - if ARightToLeft then result := btaOpposite else result := btaNatural; - end; -end; - -function AlignmentToBidiTextAlignment(AAlign: TAlignment): TBidiTextAlignment; -begin - case AAlign of - taCenter: result := btaCenter; - taRightJustify: result := btaRightJustify; - else {taLeftJustify} - result := btaLeftJustify; - end; -end; - -function BidiTextAlignmentToAlignment(ABidiAlign: TBidiTextAlignment; - ARightToLeft: boolean): TAlignment; -begin - case ABidiAlign of - btaCenter: result := taCenter; - btaLeftJustify: result := taLeftJustify; - btaRightJustify: result := taRightJustify; - btaOpposite: if ARightToLeft then result := taLeftJustify else result := taRightJustify; - else {btaNatural} - if ARightToLeft then result := taRightJustify else result := taLeftJustify; - end; -end; - -function CleanTextOutString(const s: string): string; -var idxIn, idxOut: integer; -begin - setlength(result, length(s)); - idxIn := 1; - idxOut := 1; - while IdxIn <= length(s) do - begin - if not (s[idxIn] in[#13,#10,#9]) then //those characters are always 1 byte long so it is the same with UTF8 - begin - result[idxOut] := s[idxIn]; - inc(idxOut); - end; - inc(idxIn); - end; - setlength(result, idxOut-1); -end; - -function RemoveLineEnding(var s: string; indexByte: integer): boolean; -begin //we can ignore UTF8 character length because #13 and #10 are always 1 byte long - //so this function can be applied to UTF8 strings as well - result := false; - if length(s) >= indexByte then - begin - if s[indexByte] in[#13,#10] then - begin - result := true; - if length(s) >= indexByte+1 then - begin - if (s[indexByte+1] <> s[indexByte]) and (s[indexByte+1] in[#13,#10]) then - delete(s,indexByte,2) - else - delete(s,indexByte,1); - end - else - delete(s,indexByte,1); - end else - if (s[indexByte] = #$C2) and (length(s) >= indexByte+1) and (s[indexByte+1] = #$85) then - begin - result := true; - delete(s,indexByte,2); - end else - if (s[indexByte] = #$E2) and (length(s) >= indexByte+2) and (s[indexByte+1] = #$80) and - (s[indexByte+2] in[#$A8,#$A9]) then - begin - result := true; - delete(s,indexByte,3); - end - end; -end; - -function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; -var indexByte: integer; - pIndex: PChar; -begin - pIndex := UTF8CharStart(@sUTF8[1],length(sUTF8),indexUTF8); - if pIndex = nil then - begin - result := false; - exit; - end; - indexByte := pIndex - @sUTF8[1]; - result := RemoveLineEnding(sUTF8, indexByte); -end; - -procedure BGRADefaultWordBreakHandler(var ABefore, AAfter: string); -const spacingChars = [' ']; - wordBreakChars = [' ',#9,'-','?','!']; -var p, charLen: integer; - u: LongWord; -begin - if (AAfter <> '') and (ABefore <> '') and not (AAfter[1] in spacingChars) and not (ABefore[length(ABefore)] in wordBreakChars) then - begin - p := length(ABefore); - while (p > 1) and not (ABefore[p-1] in wordBreakChars) do dec(p); - while (p < length(ABefore)+1) and (ABefore[p] in [#$80..#$BF]) do inc(p); //do not split UTF8 char - //keep non-spacing mark together - while p <= length(ABefore) do - begin - charLen := UTF8CharacterLength(@ABefore[p]); - if p+charLen > length(ABefore)+1 then charLen := length(ABefore)+1-p; - u := UTF8CodepointToUnicode(@ABefore[p],charLen); - if (GetUnicodeBidiClassEx(u) in[ubcNonSpacingMark, ubcCombiningLeftToRight]) then - inc(p,charLen) - else - break; - end; - - if p = 1 then - begin - //keep ideographic punctuation together - charLen := UTF8CharacterLength(@AAfter[p]); - if charLen > length(AAfter) then charLen := length(AAfter); - u := UTF8CodepointToUnicode(@AAfter[p],charLen); - case u of - UNICODE_IDEOGRAPHIC_COMMA, - UNICODE_IDEOGRAPHIC_FULL_STOP, - UNICODE_FULLWIDTH_COMMA, - UNICODE_HORIZONTAL_ELLIPSIS: - begin - p := length(ABefore)+1; - while p > 1 do - begin - charLen := 1; - dec(p); - while (p > 0) and (ABefore[p] in [#$80..#$BF]) do - begin - dec(p); //do not split UTF8 char - inc(charLen); - end; - if charLen <= 4 then - u := UTF8CodepointToUnicode(@ABefore[p],charLen) - else - u := ord('A'); - case GetUnicodeBidiClass(u) of - ubcNonSpacingMark: ; // include NSM - ubcOtherNeutrals, ubcWhiteSpace, ubcCommonSeparator, ubcEuropeanNumberSeparator: - begin - p := 1; - break; - end - else - break; - end; - end; - end; - end; - end; - - if p > 1 then //can put the word after - begin - AAfter := copy(ABefore,p,length(ABefore)-p+1)+AAfter; - ABefore := copy(ABefore,1,p-1); - end else - begin //cannot put the word after, so before - - end; - end; - while (ABefore <> '') and (ABefore[length(ABefore)] in spacingChars) do delete(ABefore,length(ABefore),1); - while (AAfter <> '') and (AAfter[1] in spacingChars) do delete(AAfter,1,1); -end; - - -function StrToResampleFilter(str: string): TResampleFilter; -var f: TResampleFilter; -begin - result := rfLinear; - str := LowerCase(str); - for f := low(TResampleFilter) to high(TResampleFilter) do - if CompareText(str,ResampleFilterStr[f])=0 then - begin - result := f; - exit; - end; -end; - -function GetFineClearTypeAuto: TBGRAFontQuality; -begin - result := fqFineClearTypeRGB; -end; - -{ TBGRACustomFontRenderer } - -function TBGRACustomFontRenderer.GetFontEmHeight: integer; -begin - result := round(FFontEmHeightF); -end; - -procedure TBGRACustomFontRenderer.SetFontEmHeight(AValue: integer); -begin - FFontEmHeightF:= AValue; -end; - -function TBGRACustomFontRenderer.GetFontPixelMetricF: TFontPixelMetricF; -begin - with GetFontPixelMetric do - begin - result.Defined := Defined; - result.Baseline := Baseline; - result.xLine := xLine; - result.CapLine := CapLine; - result.DescentLine := DescentLine; - result.Lineheight := LineHeight; - end; -end; - -function TBGRACustomFontRenderer.TextSizeF(sUTF8: string): TPointF; -begin - with TextSize(sUTF8) do - result := PointF(cx,cy); -end; - -function TBGRACustomFontRenderer.TextSizeF(sUTF8: string; AMaxWidthF: single; - ARightToLeft: boolean): TPointF; -begin - with TextSize(sUTF8, round(AMaxWidthF), ARightToLeft) do - result := PointF(cx,cy); -end; - -function TBGRACustomFontRenderer.TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; -begin - result := TextFitInfo(sUTF8, round(AMaxWidthF)); -end; - -function TBGRACustomFontRenderer.TextSizeAngle(sUTF8: string; - orientationTenthDegCCW: integer): TSize; -begin - result := TextSize(sUTF8); //ignore orientation by default -end; - -function TBGRACustomFontRenderer.TextSizeAngleF(sUTF8: string; - orientationTenthDegCCW: integer): TPointF; -begin - result := TextSizeF(sUTF8); //ignore orientation by default -end; - -procedure TBGRACustomFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; - ARightToLeft: boolean); -begin - //if RightToLeft is not handled - TextOut(ADest,x,y,sUTF8,c,align); -end; - -procedure TBGRACustomFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; - ARightToLeft: boolean); -begin - //if RightToLeft is not handled - TextOut(ADest,x,y,sUTF8,texture,align); -end; - -procedure TBGRACustomFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; - align: TAlignment; ARightToLeft: boolean); -begin - //if RightToLeft is not handled - TextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,c,align); -end; - -procedure TBGRACustomFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientationTenthDegCCW: integer; sUTF8: string; - texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); -begin - //if RightToLeft is not handled - TextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,texture,align); -end; - -procedure TBGRACustomFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment); -begin {optional implementation} end; - -procedure TBGRACustomFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, - y: single; s: string; align: TAlignment; ARightToLeft: boolean); -begin - //if RightToLeft is not handled - CopyTextPathTo(ADest, x,y, s, align); -end; - -function TBGRACustomFontRenderer.HandlesTextPath: boolean; -begin - result := false; -end; - - -function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, - maxyb, ignoreleft: integer; const cliprect: TRect): boolean; -var x2,y2: integer; -begin - if (x >= cliprect.Right) or (y >= cliprect.Bottom) or (x <= cliprect.Left-tx) or - (y <= cliprect.Top-ty) or (ty <= 0) or (tx <= 0) then - begin - result := false; - exit; - end; - - x2 := x + tx - 1; - y2 := y + ty - 1; - - if y < cliprect.Top then - minyb := cliprect.Top - else - minyb := y; - if y2 >= cliprect.Bottom then - maxyb := cliprect.Bottom - 1 - else - maxyb := y2; - - if x < cliprect.Left then - begin - ignoreleft := cliprect.Left-x; - minxb := cliprect.Left; - end - else - begin - ignoreleft := 0; - minxb := x; - end; - if x2 >= cliprect.Right then - maxxb := cliprect.Right - 1 - else - maxxb := x2; - - result := true; -end; - -{************************** Cyclic functions *******************} - -// Get the cyclic value in the range [0..cycle-1] -function PositiveMod(value, cycle: Int32or64): Int32or64; inline; -begin - result := value mod cycle; - if result < 0 then //modulo can be negative - Inc(result, cycle); -end; - -{ Table of precalc values. Note : the value is stored for - the first half of the cycle, and values are stored 'minus 1' - in order to stay in the range 0..65535 } -var - sinTab65536: packed array of word; - byteSqrtTab: packed array of word; - -function Sin65536(value: word): Int32or64; -var b: integer; -begin - //allocate array - if sinTab65536 = nil then - setlength(sinTab65536,32768); - - if value >= 32768 then //function is upside down after half-period - begin - b := value xor 32768; - if sinTab65536[b] = 0 then //precalc - sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1; - result := not sinTab65536[b]; - end else - begin - b := value; - if sinTab65536[b] = 0 then //precalc - sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1; - {$hints off} - result := sinTab65536[b]+1; - {$hints on} - end; -end; - -function Cos65536(value: word): Int32or64; -begin - {$PUSH}{$R-} - result := Sin65536(value+16384); //cosine is translated - {$POP} -end; - -procedure PrecalcSin65536; -var - i: Integer; -begin - for i := 0 to 32767 do Sin65536(i); -end; - -procedure PrecalcByteSqrt; -var i: integer; -begin - if byteSqrtTab = nil then - begin - setlength(byteSqrtTab,256); - for i := 0 to 255 do - byteSqrtTab[i] := round(sqrt(i/255)*255); - end; -end; - -function ByteSqrt(value: byte): byte; inline; -begin - if byteSqrtTab = nil then PrecalcByteSqrt; - result := ByteSqrtTab[value]; -end; - -function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat; -var stream: TFileStreamUTF8; -begin - try - stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); - except - result := ifUnknown; - exit; - end; - try - result := DetectFileFormat(stream, ExtractFileExt(AFilenameUTF8)); - finally - stream.Free; - end; -end; - -function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string - ): TBGRAImageFormat; -var - scores: array[TBGRAImageFormat] of integer; - imageFormat,bestImageFormat: TBGRAImageFormat; - bestScore: integer; - - procedure DetectFromStream; - var - {%H-}magic: packed array[0..7] of byte; - {%H-}dwords: packed array[0..9] of LongWord; - magicAsText, moreMagic: string; - - streamStartPos, maxFileSize: Int64; - expectedFileSize: LongWord; - - procedure DetectTarga; - var - paletteCount: integer; - {%H-}targaPixelFormat: packed record pixelDepth: byte; imgDescriptor: byte; end; - begin - if (magic[1] in[$00,$01]) and (magic[2] in[0,1,2,3,9,10,11]) and (maxFileSize >= 18) then - begin - paletteCount:= magic[5] + magic[6] shl 8; - if ((paletteCount = 0) and (magic[7] = 0)) or - (magic[7] in [16,24,32]) then //check palette bit count - begin - AStream.Position:= streamStartPos+16; - if AStream.Read({%H-}targaPixelFormat,2) = 2 then - begin - if (targaPixelFormat.pixelDepth in [8,16,24,32]) and - (targaPixelFormat.imgDescriptor and 15 < targaPixelFormat.pixelDepth) then - inc(scores[ifTarga],2); - end; - end; - end; - end; - - procedure DetectLazPaint; - var - w,h: LongWord; - i: integer; - begin - if (copy(magicAsText,1,8) = 'LazPaint') then //with header - begin - AStream.Position:= streamStartPos+8; - if AStream.Read(dwords,10*4) = 10*4 then - begin - for i := 0 to 6 do dwords[i] := LEtoN(dwords[i]); - if (dwords[0] = 0) and (dwords[1] <= maxFileSize) and (dwords[5] <= maxFileSize) and - (dwords[9] <= maxFileSize) and - (dwords[6] = 0) then inc(scores[ifLazPaint],2); - end; - end else //without header - if ((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and - ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0) then - begin - w := magic[0] + (magic[1] shl 8); - h := magic[4] + (magic[5] shl 8); - AStream.Position:= streamStartPos+8; - if AStream.Read(dwords,4) = 4 then - begin - dwords[0] := LEtoN(dwords[0]); - if (dwords[0] > 0) and (dwords[0] < 65536) then - begin - if 12+dwords[0] < expectedFileSize then - begin - AStream.Position:= streamStartPos+12+dwords[0]; - if AStream.Read(dwords,6*4) = 6*4 then - begin - for i := 0 to 5 do dwords[i] := LEtoN(dwords[i]); - if (dwords[0] <= w) and (dwords[1] <= h) and - (dwords[2] <= w) and (dwords[3] <= h) and - (dwords[2] >= dwords[0]) and (dwords[3] >= dwords[1]) and - ((dwords[4] = 0) or (dwords[4] = 1)) and - (dwords[5] > 0) then inc(scores[ifLazPaint],1); - end; - end; - end; - end; - end; - end; - - begin - fillchar({%H-}magic, sizeof(magic), 0); - fillchar({%H-}dwords, sizeof(dwords), 0); - - streamStartPos:= AStream.Position; - maxFileSize:= AStream.Size - streamStartPos; - if maxFileSize < 8 then exit; - if AStream.Read(magic,sizeof(magic)) <> sizeof(magic) then - begin - fillchar(scores,sizeof(scores),0); - exit; - end; - setlength(magicAsText,sizeof(magic)); - move(magic[0],magicAsText[1],sizeof(magic)); - - if (magic[0] = $ff) and (magic[1] = $d8) then - begin - inc(scores[ifJpeg]); - if (magic[2] = $ff) and (magic[3] >= $c0) then inc(scores[ifJpeg]); - end; - - if (magic[0] = $89) and (magic[1] = $50) and (magic[2] = $4e) and - (magic[3] = $47) and (magic[4] = $0d) and (magic[5] = $0a) and - (magic[6] = $1a) and (magic[7] = $0a) then inc(scores[ifPng],2); - - if (copy(magicAsText,1,6)='GIF87a') or (copy(magicAsText,1,6)='GIF89a') then inc(scores[ifGif],2); - - if (magic[0] = $0a) and (magic[1] in [0,2,3,4,5]) and (magic[2] in[0,1]) and (magic[3] in[1,2,4,8]) then - inc(scores[ifPcx],2); - - if (copy(magicAsText,1,2)='BM') then - begin - inc(scores[ifBmp]); - expectedFileSize:= magic[2] + (magic[3] shl 8) + (magic[4] shl 16) + (magic[5] shl 24); - if expectedFileSize = maxFileSize then inc(scores[ifBmp]); - end else - if (copy(magicAsText,1,2)='RL') then - begin - inc(scores[ifBmpMioMap]); - if (magic[2] in[0,1]) and (magic[3] = 0) then inc(scores[ifBmpMioMap]); - end; - - if (magic[0] = $00) and (magic[1] = $00) and (magic[3] = $00) and - (magic[4] + (magic[5] shl 8) > 0) then - begin - if magic[2] = $01 then - inc(scores[ifIco]) - else if magic[2] = $02 then - inc(scores[ifCur]); - end; - - if (copy(magicAsText,1,4) = 'PDN3') then - begin - expectedFileSize:= 6 + (magic[4] + (magic[5] shl 8) + (magic[6] shl 16)) + 2; - if expectedFileSize <= maxFileSize then - begin - inc(scores[ifPaintDotNet]); - if magic[7] = $3c then inc(scores[ifPaintDotNet]); - end; - end; - - if (copy(magicAsText,1,4) = 'oXo ') then - begin - inc(scores[ifPhoxo],1); - if (magic[4] = 1) and (magic[5] = 0) and (magic[6] = 0) and (magic[7] = 0) then - inc(scores[ifPhoxo],1); - end; - - DetectLazPaint; - - if (magic[0] = $50) and (magic[1] = $4b) and (magic[2] = $03) and (magic[3] = $04) then - begin - if DefaultBGRAImageReader[ifOpenRaster] = nil then inc(scores[ifOpenRaster]) else - with CreateBGRAImageReader(ifOpenRaster) do - try - AStream.Position := streamStartPos; - if CheckContents(AStream) then inc(scores[ifOpenRaster],2); - finally - Free; - end; - end; - - if (copy(magicAsText,1,4) = '8BPS') and (magic[4] = $00) and (magic[5] = $01) then inc(scores[ifPsd],2); - - DetectTarga; - - if (copy(magicAsText,1,2)='II') and (magic[2] = 42) and (magic[3]=0) then inc(scores[ifTiff]) else - if (copy(magicAsText,1,2)='MM') and (magic[2] = 0) and (magic[3]=42) then inc(scores[ifTiff]); - - if (copy(magicAsText,1,8) = '/* XPM *') or (copy(magicAsText,1,6) = '! XPM2') then inc(scores[ifXPixMap]); - - if (copy(magicAsText,1,6) = '3) and (magicAsText[1]='P') and - (magicAsText[2] in['1'..'6']) and (magicAsText[3] = #10) then inc(scores[ifPortableAnyMap]); - - if (copy(magicAsText,1,4) = 'RIFF') then - begin - AStream.Position:= streamStartPos+8; - setlength(moreMagic, 4); - if (AStream.Read(moreMagic[1],4) = 4) - and (moreMagic = 'WEBP') then - inc(scores[ifWebP], 2); - end; - - AStream.Position := streamStartPos; - end; - -var - extFormat: TBGRAImageFormat; - -begin - result := ifUnknown; - for imageFormat:= low(TBGRAImageFormat) to high(TBGRAImageFormat) do - scores[imageFormat] := 0; - - ASuggestedExtensionUTF8:= UTF8LowerCase(ASuggestedExtensionUTF8); - if (ASuggestedExtensionUTF8 <> '') and (ASuggestedExtensionUTF8[1] <> '.') then //first UTF8 char is in first pos - ASuggestedExtensionUTF8 := '.'+ASuggestedExtensionUTF8; - - extFormat:= SuggestImageFormat(ASuggestedExtensionUTF8); - if extFormat <> ifUnknown then inc(scores[extFormat]); - - If AStream <> nil then DetectFromStream; - - bestScore := 0; - bestImageFormat:= ifUnknown; - for imageFormat:=low(TBGRAImageFormat) to high(TBGRAImageFormat) do - if scores[imageFormat] > bestScore then - begin - bestScore:= scores[imageFormat]; - bestImageFormat:= imageFormat; - end; - result := bestImageFormat; -end; - -function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat; -var ext: string; - posDot: integer; -begin - result := ifUnknown; - - ext := ExtractFileName(AFilenameOrExtensionUTF8); - posDot := LastDelimiter('.', ext); - if posDot <> 0 then ext := copy(ext,posDot,length(ext)-posDot+1) - else ext := '.'+ext; - ext := UTF8LowerCase(ext); - - if (ext = '.jpg') or (ext = '.jpeg') then result := ifJpeg else - if (ext = '.png') then result := ifPng else - if (ext = '.gif') then result := ifGif else - if (ext = '.pcx') then result := ifPcx else - if (ext = '.bmp') then result := ifBmp else - if (ext = '.ico') then result := ifIco else - if (ext = '.cur') then result := ifCur else - if (ext = '.pdn') then result := ifPaintDotNet else - if (ext = '.lzp') then result := ifLazPaint else - if (ext = '.ora') then result := ifOpenRaster else - if (ext = '.psd') then result := ifPsd else - if (ext = '.tga') then result := ifTarga else - if (ext = '.tif') or (ext = '.tiff') then result := ifTiff else - if (ext = '.xwd') then result := ifXwd else - if (ext = '.xpm') then result := ifXPixMap else - if (ext = '.oxo') then result := ifPhoxo else - if (ext = '.svg') then result := ifSvg else - if (ext = '.pbm') or (ext = '.pgm') or (ext = '.ppm') then result := ifPortableAnyMap else - if (ext = '.webp') then result := ifWebP; -end; - -function SuggestImageExtension(AFormat: TBGRAImageFormat): string; -begin - case AFormat of - ifJpeg: result := 'jpg'; - ifPng: result := 'png'; - ifGif: result := 'gif'; - ifBmp: result := 'bmp'; - ifBmpMioMap: result := 'bmp'; - ifIco: result := 'ico'; - ifCur: result := 'ico'; - ifPcx: result := 'pcx'; - ifPaintDotNet: result := 'pdn'; - ifLazPaint: result := 'lzp'; - ifOpenRaster: result := 'ora'; - ifPhoxo: result := 'oXo'; - ifPsd: result := 'psd'; - ifTarga: result := 'tga'; - ifTiff: result := 'tif'; - ifXwd: result := 'xwd'; - ifXPixMap: result := 'xpm'; - ifSvg: result := 'svg'; - ifPortableAnyMap: result := 'ppm'; - ifWebP: result := 'webp'; - else result := '?'; - end; -end; - -function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader; -begin - if DefaultBGRAImageReader[AFormat] = nil then - begin - case AFormat of - ifUnknown: raise exception.Create('The image format is unknown.'); - ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to read this image.'); - ifPaintDotNet: raise exception.Create('You need to call BGRAPaintNet.RegisterPaintNetFormat to read this image.'); - ifSvg: raise exception.Create('You need to call BGRA.RegisterSvgFormat to read this image.'); - else - raise exception.Create('The image reader is not registered for this image format.'); - end; - end; - result := DefaultBGRAImageReader[AFormat].Create; -end; - -function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter; -begin - if DefaultBGRAImageWriter[AFormat] = nil then - begin - case AFormat of - ifUnknown: raise exception.Create('The image format is unknown'); - ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to write with this image format.'); - ifPhoxo: raise exception.Create('You need to call BGRAPhoxo.RegisterPhoxoFormat to write with this image format.'); - else - raise exception.Create('The image writer is not registered for this image format.'); - end; - end; - - if AFormat = ifPng then - begin - result := DefaultBGRAImageWriter[AFormat].Create; - if result is TBGRACustomWriterPNG then - TBGRACustomWriterPNG(result).UseAlpha := AHasTransparentPixels; - end else - if AFormat = ifBmp then - begin - result := TFPWriterBMP.Create; - if AHasTransparentPixels then - TFPWriterBMP(result).BitsPerPixel := 32 else - TFPWriterBMP(result).BitsPerPixel := 24; - end else - if AFormat = ifXPixMap then - begin - result := TFPWriterXPM.Create; - TFPWriterXPM(result).ColorCharSize := 2; - end else - result := DefaultBGRAImageWriter[AFormat].Create; -end; - -operator =(const AGuid1, AGuid2: TGuid): boolean; -begin - result := CompareMem(@AGuid1, @AGuid2, sizeof(TGuid)); -end; - -type - TResourceType = record - ext: string; - code: pchar; - end; - -{$IFNDEF BGRABITMAP_USE_LCL}{$IFDEF MSWINDOWS} -const - RT_BITMAP = MAKEINTRESOURCE(2); - RT_RCDATA = MAKEINTRESOURCE(10); - RT_GROUP_CURSOR = MAKEINTRESOURCE(12); - RT_GROUP_ICON = MAKEINTRESOURCE(14); - RT_HTML = MAKEINTRESOURCE(23); -{$ENDIF}{$ENDIF} - -const - ResourceTypes: array[1..7] of TResourceType = - ((ext: 'CUR'; code: RT_GROUP_CURSOR), - (ext: 'BMP'; code: RT_BITMAP), - (ext: 'ICO'; code: RT_GROUP_ICON), - (ext: 'DAT'; code: RT_RCDATA), - (ext: 'DATA'; code: RT_RCDATA), - (ext: 'HTM'; code: RT_HTML), - (ext: 'HTML'; code: RT_HTML)); - -{ TBGRAResourceManager } - -function TBGRAResourceManager.GetWinResourceType(AExtension: string): pchar; -var - i: Integer; -begin - if (AExtension <> '') and (AExtension[1]='.') then delete(AExtension,1,1); - for i := low(ResourceTypes) to high(ResourceTypes) do - if AExtension = ResourceTypes[i].ext then - exit(ResourceTypes[i].code); - - exit(RT_RCDATA); -end; - -function TBGRAResourceManager.GetResourceStream(AFilename: string): TStream; -var - name,ext: RawByteString; - rt: PChar; -begin - ext := UpperCase(ExtractFileExt(AFilename)); - name := ChangeFileExt(AFilename,''); - rt := GetWinResourceType(ext); - - if (rt = RT_GROUP_CURSOR) or (rt = RT_GROUP_ICON) then - raise exception.Create('Not implemented'); - - result := TResourceStream.Create(HINSTANCE, name, rt); -end; - -function TBGRAResourceManager.IsWinResource(AFilename: string): boolean; -var - name,ext: RawByteString; - rt: PChar; -begin - ext := UpperCase(ExtractFileExt(AFilename)); - name := ChangeFileExt(AFilename,''); - rt := GetWinResourceType(ext); - result := FindResource(HINSTANCE, pchar(name), rt)<>0; -end; - -{$IFDEF BGRABITMAP_USE_LCL} -type - - { TLCLResourceManager } - - TLCLResourceManager = class(TBGRAResourceManager) - protected - function FindLazarusResource(AFilename: string): TLResource; - public - function GetResourceStream(AFilename: string): TStream; override; - function IsWinResource(AFilename: string): boolean; override; - end; - -function TLCLResourceManager.FindLazarusResource(AFilename: string): TLResource; -var - name,ext: RawByteString; -begin - ext := UpperCase(ExtractFileExt(AFilename)); - if (ext<>'') and (ext[1]='.') then Delete(ext,1,1); - name := ChangeFileExt(AFilename,''); - if ext<>'' then - result := LazarusResources.Find(name,ext) - else - result := LazarusResources.Find(name); -end; - -function TLCLResourceManager.GetResourceStream(AFilename: string): TStream; -var - res: TLResource; -begin - res := FindLazarusResource(AFilename); - if Assigned(res) then - result := TLazarusResourceStream.CreateFromHandle(res) - else - result := inherited GetResourceStream(AFilename); -end; - -function TLCLResourceManager.IsWinResource(AFilename: string): boolean; -begin - if FindLazarusResource(AFilename)<>nil then - result := false - else - Result:=inherited IsWinResource(AFilename); -end; - -{$ENDIF} - -initialization - - {$DEFINE INCLUDE_INIT} - {$I bgrapixel.inc} - - {$DEFINE INCLUDE_INIT} - {$I csscolorconst.inc} - - fqFineClearType := @GetFineClearTypeAuto; - - DefaultBGRAImageWriter[ifJpeg] := TFPWriterJPEG; - DefaultBGRAImageWriter[ifBmp] := TFPWriterBMP; - DefaultBGRAImageWriter[ifPcx] := TFPWriterPCX; - DefaultBGRAImageWriter[ifTarga] := TFPWriterTarga; - DefaultBGRAImageWriter[ifXPixMap] := TFPWriterXPM; - DefaultBGRAImageWriter[ifPortableAnyMap] := TFPWriterPNM; - //writing XWD not implemented - - DefaultBGRAImageReader[ifXwd] := TFPReaderXWD; - DefaultBGRAImageReader[ifPortableAnyMap] := TFPReaderPNM; - //the other readers are registered by their unit - - {$IFDEF BGRABITMAP_USE_LCL} - BGRAResource := TLCLResourceManager.Create; - {$ELSE} - BGRAResource := TBGRAResourceManager.Create; - {$ENDIF} - -finalization - - {$DEFINE INCLUDE_FINAL} - {$I csscolorconst.inc} - - {$DEFINE INCLUDE_FINAL} - {$I bgrapixel.inc} - - BGRAResource.Free; -end. diff --git a/components/bgrabitmap/bgrablend.pas b/components/bgrabitmap/bgrablend.pas deleted file mode 100644 index 4cb0e29..0000000 --- a/components/bgrabitmap/bgrablend.pas +++ /dev/null @@ -1,1974 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRABlend; - -{ This unit contains pixel blending functions. They take a destination adress as parameter, - and draw pixels at this address with different blending modes. These functions are used - by many functions in BGRABitmap library to do the low level drawing. } - -{$mode objfpc}{$H+} - -interface - -uses - BGRABitmapTypes; - -{ Brush providers } - -procedure BGRASolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); -procedure BGRAScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; - AOffsetX: integer = 0; AOffsetY: integer = 0); -procedure BGRAMaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; AOffsetX: integer = 0; AOffsetY: integer = 0); -procedure BGRAEraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); -procedure BGRAAlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); - -{ Draw one pixel with alpha blending } -procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; -procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload; -procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel); inline; overload; -procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel); inline; overload; //alpha in 'c' parameter -procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; -procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; calpha: byte); inline; overload; -procedure ClearTypeDrawPixel(pdest: PBGRAPixel; Cr, Cg, Cb: byte; Color: TBGRAPixel); inline; -procedure InterpolateBilinear(pUpLeft,pUpRight,pDownLeft,pDownRight: PBGRAPixel; - iFactX,iFactY: Integer; ADest: PBGRAPixel); -procedure InterpolateBilinearMask(pUpLeft,pUpRight,pDownLeft,pDownRight: PByteMask; - iFactX,iFactY: Integer; ADest: PByteMask); - -procedure CopyPixelsWithOpacity(dest,src: PBGRAPixel; opacity: byte; Count: integer); inline; -function ApplyOpacity(opacity1,opacity2: byte): byte; inline; -function FastRoundDiv255(value: LongWord): LongWord; inline; - -{ Draw a series of pixels with alpha blending } -procedure PutPixels(pdest: PBGRAPixel; psource: PBGRAPixel; copycount: integer; mode: TDrawMode; AOpacity:byte); -procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; overload; -procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; Count: integer); inline; overload; -procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer); inline; overload; //alpha in 'c' parameter - -{ Draw one pixel with linear alpha blending } -procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; -procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload; - -{ Draw a series of pixels with linear alpha blending } -procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; - -{ Replace a series of pixels } -procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; - -{ Xor a series of pixels } -procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; -procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer); - -{ Set alpha value for a series of pixels } -procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline; - -{ Erase a series of pixels, i.e. decrease alpha value } -procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline; - -{ Draw a pixel to the extent the current pixel is close enough to compare value. - It should not be called on pixels that have not been checked to be close enough } -procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel; - maxDiff: byte); inline; -{ Draw a series of pixel to the extent the current pixel is close enough to compare value } -procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel; - Count: integer; compare: TBGRAPixel; maxDiff: byte); inline; - -{ Blend pixels with scanner content } -procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode); - -{ Perform advanced blending operation } -procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; - blendOp: TBlendOperation; Count: integer; excludeChannels: TChannels = []); - -{ Perform blending operation and merge over destination } -procedure BlendPixelsOver(pdest: PBGRAPixel; psrc: PBGRAPixel; - blendOp: TBlendOperation; Count: integer; opacity: byte; linearBlend: boolean = false; - excludeChannels: TChannels = []); - -//layer blend modes -//- http://www.pegtop.net/delphi/articles/blendmodes/ -//- http://www.w3.org/TR/2009/WD-SVGCompositing-20090430/#comp-op -//- http://docs.gimp.org/en/gimp-concepts-layer-modes.html -procedure LinearMultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure AddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearAddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure ColorBurnPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure DividePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure GlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure OverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure DifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearDifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure ExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearSubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearSubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure SubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure SubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure NegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearNegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LightenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure DarkenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure ScreenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure SoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure SvgSoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure HardLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure BlendXorPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure BlendMaskPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearMultiplySaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearHueInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearColorInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure LinearSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure CorrectedHueInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure CorrectedColorInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure CorrectedLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure CorrectedSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); -procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer; - mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; - KeepRGBOrder: boolean); -procedure BGRAFillClearTypeMaskPtr(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; maskData: PByte; maskPixelSize: Int32or64; maskRowSize: Int32or64; maskWidth,maskHeight: integer; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); - -implementation - -type - PBGRASolidBrushFixedData = ^TBGRASolidBrushFixedData; - TBGRASolidBrushFixedData = record - BGRA: TBGRAPixel; - Expanded: TExpandedPixel; - end; - -procedure BGRASolidBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PBGRAPixel; - bAlpha: Byte; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - FillDWord(pDest^, ACount, PLongWord(@PBGRASolidBrushFixedData(AFixedData)^.BGRA)^); - inc(pDest, ACount); - end else - begin - with PBGRASolidBrushFixedData(AFixedData)^ do - begin - if BGRA.alpha = 255 then - begin - bAlpha := FastRoundDiv257(AAlpha); - while ACount > 0 do - begin - DrawExpandedPixelInlineNoAlphaCheck(pDest, Expanded, bAlpha); - inc(pDest); - dec(ACount); - end; - end - else - begin - while ACount > 0 do - begin - pDest^ := GammaCompression(MergeBGRA(GammaExpansion(pDest^), not AAlpha, Expanded, AAlpha)); - inc(pDest); - dec(ACount); - end; - end; - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRASolidBrushSkipPixels({%H-}AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -begin - inc(PBGRAPixel(AContextData^.Dest), ACount); -end; - -procedure BGRASolidBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: byte; - pDest: PBGRAPixel; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end; - with PBGRASolidBrushFixedData(AFixedData)^ do - begin - pDest := PBGRAPixel(AContextData^.Dest); - bAlpha := FastRoundDiv257(Expanded.alpha*AAlpha shr 16); - if bAlpha = 255 then - begin - FillDWord(pDest^, ACount, PLongWord(@BGRA)^); - inc(pDest, ACount); - end else - begin - while ACount > 0 do - begin - DrawExpandedPixelInlineNoAlphaCheck(pDest, Expanded, bAlpha); - inc(pDest); - dec(ACount); - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; - end; -end; - -procedure BGRASolidBrushLinearDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - c: TBGRAPixel; - pDest: PBGRAPixel; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end; - with PBGRASolidBrushFixedData(AFixedData)^ do - begin - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - FastBlendPixelInline(pDest, BGRA); - inc(pDest); - dec(ACount); - end; - end else - begin - c := BGRA; - c.alpha := FastRoundDiv257(c.alpha*AAlpha shr 8); - while ACount > 0 do - begin - FastBlendPixelInline(pDest, c); - inc(pDest); - dec(ACount); - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; - end; -end; - -procedure BGRASolidBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - c: TBGRAPixel; - pDest: PBGRAPixel; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end; - with PBGRASolidBrushFixedData(AFixedData)^ do - begin - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor PLongWord(@BGRA)^; - inc(pDest); - dec(ACount); - end; - end else - begin - while ACount > 0 do - begin - PLongWord(@c)^ := PLongWord(pdest)^ xor PLongWord(@BGRA)^; - pDest^ := MergeBGRA(pDest^, not AAlpha, c, AAlpha); - inc(pDest); - dec(ACount); - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; - end; -end; - -procedure BGRASolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; - ADrawMode: TDrawMode); -begin - ABrush.Colorspace:= TBGRAPixelColorspace; - with PBGRASolidBrushFixedData(@ABrush.FixedData)^ do - begin - BGRA := PBGRAPixel(AColor)^; - if not (ADrawMode in[dmLinearBlend,dmXor]) then - Expanded := GammaExpansion(BGRA); - end; - ABrush.InternalInitContext:= nil; - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @BGRASolidBrushSetPixels; - - dmSetExceptTransparent: if PBGRAPixel(AColor)^.alpha <> 255 then - begin - ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end else ABrush.InternalPutNextPixels:= @BGRASolidBrushSetPixels; - - dmDrawWithTransparency: if PBGRAPixel(AColor)^.alpha = 0 then - begin - ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end else ABrush.InternalPutNextPixels:= @BGRASolidBrushDrawPixels; - - dmLinearBlend: if PBGRAPixel(AColor)^.alpha = 0 then - begin - ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end - else ABrush.InternalPutNextPixels:= @BGRASolidBrushLinearDrawPixels; - - dmXor: if PLongWord(AColor)^ = 0 then - begin - ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end else ABrush.InternalPutNextPixels:= @BGRASolidBrushXorPixels; - end; - -end; - -type - PBGRAScannerBrushFixedData = ^TBGRAScannerBrushFixedData; - TBGRAScannerBrushFixedData = record - Scanner: Pointer; //avoid ref count by using pointer type - OffsetX, OffsetY: integer; - case boolean of - true: (HasPutPixels: boolean); //BGRA - false: (Conversion: TBridgedConversion); //other - end; - -procedure BRGBAScannerBrushInitContext(AFixedData: Pointer; - AContextData: PUniBrushContext); -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, - AContextData^.Ofs.Y + OffsetY); -end; - -procedure BGRAScannerBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: Byte; - pDest: PBGRAPixel; - buf: packed array[0..3] of TBGRAPixel; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - if HasPutPixels then - begin - IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmSet); - inc(pDest, ACount); - end else - while ACount > 0 do - begin - pDest^ := IBGRAScanner(Scanner).ScanNextPixel; - inc(pDest); - dec(ACount); - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - if HasPutPixels then - begin - while ACount > 3 do - begin - IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); - pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, buf[0], bAlpha); - (pDest+1)^ := MergeBGRAWithGammaCorrection((pDest+1)^, not bAlpha, buf[1], bAlpha); - (pDest+2)^ := MergeBGRAWithGammaCorrection((pDest+2)^, not bAlpha, buf[2], bAlpha); - (pDest+3)^ := MergeBGRAWithGammaCorrection((pDest+3)^, not bAlpha, buf[3], bAlpha); - inc(pDest, 4); - dec(ACount, 4); - end; - end; - while ACount > 0 do - begin - pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, IBGRAScanner(Scanner).ScanNextPixel, bAlpha); - inc(pDest); - dec(ACount); - end; - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAScannerConvertBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pBuf,pDest: PBGRAPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TBGRAPixel; - bAlpha: Byte; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - end else - begin - pDest := PBGRAPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, pDest, qty, pixSize, sizeof(TBGRAPixel), nil); - inc(pDest, qty); - dec(ACount, qty); - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, pBuf^, bAlpha); - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end; - AContextData^.Dest := pDest; - end; - end; -end; - -procedure BGRAScannerBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: Byte; - pDest: PBGRAPixel; - buf: packed array[0..3] of TBGRAPixel; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - if HasPutPixels then - begin - IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmSetExceptTransparent); - inc(pDest, ACount); - end else - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - if buf[0].alpha = 255 then pDest^ := buf[0]; - inc(pDest); - dec(ACount); - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - if HasPutPixels then - begin - while ACount > 3 do - begin - IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); - if buf[0].alpha = 255 then pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, buf[0], bAlpha); - if buf[1].alpha = 255 then (pDest+1)^ := MergeBGRAWithGammaCorrection((pDest+1)^, not bAlpha, buf[1], bAlpha); - if buf[2].alpha = 255 then (pDest+2)^ := MergeBGRAWithGammaCorrection((pDest+2)^, not bAlpha, buf[2], bAlpha); - if buf[3].alpha = 255 then (pDest+3)^ := MergeBGRAWithGammaCorrection((pDest+3)^, not bAlpha, buf[3], bAlpha); - inc(pDest, 4); - dec(ACount, 4); - end; - end; - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - if buf[0].alpha = 255 then - pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, buf[0], bAlpha); - inc(pDest); - dec(ACount); - end; - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pBuf,pDest: PBGRAPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TBGRAPixel; - bAlpha: Byte; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - end else - begin - pDest := PBGRAPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - if pBuf^.alpha = 255 then pDest^ := pBuf^; - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - if pBuf^.alpha = 255 then - pDest^ := MergeBGRAWithGammaCorrection(pDest^, not bAlpha, pBuf^, bAlpha); - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end; - AContextData^.Dest := pDest; - end; - end; -end; - -procedure BGRAScannerBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: Byte; - pDest: PBGRAPixel; - buf: packed array[0..3] of TBGRAPixel; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - if HasPutPixels then - begin - IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmDrawWithTransparency); - inc(pDest, ACount); - end else - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - DrawPixelInlineWithAlphaCheck(pDest, buf[0]); - inc(pDest); - dec(ACount); - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - if HasPutPixels then - begin - while ACount > 3 do - begin - IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); - DrawPixelInlineWithAlphaCheck(pDest, buf[0], bAlpha); - DrawPixelInlineWithAlphaCheck(pDest+1, buf[1], bAlpha); - DrawPixelInlineWithAlphaCheck(pDest+2, buf[2], bAlpha); - DrawPixelInlineWithAlphaCheck(pDest+3, buf[3], bAlpha); - inc(pDest, 4); - dec(ACount, 4); - end; - end; - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - DrawPixelInlineWithAlphaCheck(pDest, buf[0], bAlpha); - inc(pDest); - dec(ACount); - end; - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAScannerConvertBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pBuf,pDest: PBGRAPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TBGRAPixel; - bAlpha: Byte; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - end else - begin - pDest := PBGRAPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - DrawPixelInlineWithAlphaCheck(pDest, pBuf^); - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - DrawPixelInlineWithAlphaCheck(pDest, pBuf^, bAlpha); - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end; - AContextData^.Dest := pDest; - end; - end; -end; - -procedure BGRAScannerBrushLinearDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: Byte; - pDest: PBGRAPixel; - buf: packed array[0..3] of TBGRAPixel; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - if HasPutPixels then - begin - IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmLinearBlend); - inc(pDest, ACount); - end else - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - FastBlendPixelInline(pDest, buf[0]); - inc(pDest); - dec(ACount); - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - if HasPutPixels then - begin - while ACount > 3 do - begin - IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); - FastBlendPixelInline(pDest, buf[0], bAlpha); - FastBlendPixelInline(pDest+1, buf[1], bAlpha); - FastBlendPixelInline(pDest+2, buf[2], bAlpha); - FastBlendPixelInline(pDest+3, buf[3], bAlpha); - inc(pDest, 4); - dec(ACount, 4); - end; - end; - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - FastBlendPixelInline(pDest, buf[0], bAlpha); - inc(pDest); - dec(ACount); - end; - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAScannerConvertBrushLinearDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pBuf,pDest: PBGRAPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TBGRAPixel; - bAlpha: Byte; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - end else - begin - pDest := PBGRAPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - FastBlendPixelInline(pDest, pBuf^); - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - FastBlendPixelInline(pDest, pBuf^, bAlpha); - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end; - AContextData^.Dest := pDest; - end; - end; -end; - -procedure BGRAScannerBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: byte; - pDest: PBGRAPixel; - buf: packed array[0..3] of TBGRAPixel; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - if HasPutPixels then - begin - IBGRAScanner(Scanner).ScanPutPixels(pDest, ACount, dmXor); - inc(pDest, ACount); - end else - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - PLongWord(pdest)^ := PLongWord(pdest)^ xor PLongWord(@buf[0])^; - inc(pDest); - dec(ACount); - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - if HasPutPixels then - begin - while ACount > 3 do - begin - IBGRAScanner(Scanner).ScanPutPixels(buf, 4, dmSet); - PLongWord(@buf[0])^ := PLongWord(pdest)^ xor PLongWord(@buf[0])^; - PLongWord(@buf[1])^ := PLongWord(pdest+1)^ xor PLongWord(@buf[1])^; - PLongWord(@buf[2])^ := PLongWord(pdest+2)^ xor PLongWord(@buf[2])^; - PLongWord(@buf[3])^ := PLongWord(pdest+3)^ xor PLongWord(@buf[3])^; - pDest^ := MergeBGRA(pDest^, not bAlpha, buf[0], bAlpha); - (pDest+1)^ := MergeBGRA((pDest+1)^, not bAlpha, buf[1], bAlpha); - (pDest+2)^ := MergeBGRA((pDest+2)^, not bAlpha, buf[2], bAlpha); - (pDest+3)^ := MergeBGRA((pDest+3)^, not bAlpha, buf[3], bAlpha); - inc(pDest, 4); - dec(ACount, 4); - end; - end; - while ACount > 0 do - begin - buf[0] := IBGRAScanner(Scanner).ScanNextPixel; - PLongWord(@buf[0])^ := PLongWord(pdest)^ xor PLongWord(@buf[0])^; - pDest^ := MergeBGRA(pDest^, not bAlpha, buf[0], bAlpha); - inc(pDest); - dec(ACount); - end; - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAScannerConvertBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pBuf,pDest: PBGRAPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TBGRAPixel; - bAlpha: Byte; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - end else - begin - pDest := PBGRAPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - PLongWord(pDest)^ := PLongWord(pDest)^ xor PLongWord(pBuf)^; - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TBGRAPixel), nil); - pBuf := @buf; - dec(ACount, qty); - while qty > 0 do - begin - PLongWord(pBuf)^ := PLongWord(pDest)^ xor PLongWord(pBuf)^; - pDest^ := MergeBGRA(pDest^, not bAlpha, pBuf^, bAlpha); - inc(pDest); - inc(pBuf); - dec(qty); - end; - end; - end; - AContextData^.Dest := pDest; - end; - end; -end; - -procedure BGRAScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - ADrawMode: TDrawMode; AOffsetX: integer = 0; AOffsetY: integer = 0); -var - sourceSpace: TColorspaceAny; -begin - ABrush.Colorspace:= TBGRAPixelColorspace; - with PBGRAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - HasPutPixels:= AScanner.IsScanPutPixelsDefined; - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @BRGBAScannerBrushInitContext; - sourceSpace := AScanner.GetScanCustomColorspace; - if (AScanner.IsScanPutPixelsDefined) or (sourceSpace = TBGRAPixelColorspace) - or (sourceSpace = TExpandedPixelColorspace) then - begin - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @BGRAScannerBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @BGRAScannerBrushSetPixelsExceptTransparent; - dmDrawWithTransparency: ABrush.InternalPutNextPixels:= @BGRAScannerBrushDrawPixels; - dmLinearBlend: ABrush.InternalPutNextPixels:= @BGRAScannerBrushLinearDrawPixels; - dmXor: ABrush.InternalPutNextPixels:= @BGRAScannerBrushXorPixels; - end; - end else - begin - with PBGRAScannerBrushFixedData(@ABrush.FixedData)^ do - Conversion := sourceSpace.GetBridgedConversion(TBGRAPixelColorspace); - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushSetPixelsExceptTransparent; - dmLinearBlend: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushLinearDrawPixels; - dmDrawWithTransparency: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushDrawPixels; - dmXor: ABrush.InternalPutNextPixels:= @BGRAScannerConvertBrushXorPixels; - end; - end; -end; - -procedure BGRASolidBrushErasePixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: byte; - pDest: PBGRAPixel; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - bAlpha := PByte(AFixedData)^ * AAlpha shr 16; - while ACount > 0 do - begin - ErasePixelInline(pDest, bAlpha); - inc(pDest); - dec(ACount); - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAMaskBrushApply(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - bAlpha: Byte; - pDest: PBGRAPixel; - qty, maskStride: Integer; - pMask: PByteMask; -begin - with PBGRAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - if AAlpha >= $ff7f then - begin - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.alpha := ApplyOpacity(pDest^.alpha, pMask^.gray); - if pDest^.alpha = 0 then pDest^ := BGRAPixelTransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end else - begin - bAlpha := FastRoundDiv257(AAlpha); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.alpha := ApplyOpacity(pDest^.alpha, ApplyOpacity(pMask^.gray, bAlpha)); - if pDest^.alpha = 0 then pDest^ := BGRAPixelTransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAMaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - AOffsetX: integer; AOffsetY: integer); -begin - ABrush.Colorspace:= TBGRAPixelColorspace; - with PBGRAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @BRGBAScannerBrushInitContext; - ABrush.InternalPutNextPixels:= @BGRAMaskBrushApply; -end; - -procedure BGRAEraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); -var - bAlpha: Byte; -begin - if AAlpha >= $ff7f then - BGRASolidBrushIndirect(ABrush, @BGRAPixelTransparent, dmSet) - else - begin - ABrush.Colorspace:= TBGRAPixelColorspace; - bAlpha := FastRoundDiv257(AAlpha); - PByte(@ABrush.FixedData)^ := bAlpha; - ABrush.InternalInitContext:= nil; - if bAlpha = 0 then - ABrush.InternalPutNextPixels:= @BGRASolidBrushSkipPixels - else - ABrush.InternalPutNextPixels:= @BGRASolidBrushErasePixels; - end; -end; - -procedure BGRASolidBrushAlphaPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - alphaAdd: Word; - pDest: PBGRAPixel; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end else - if AAlpha >= $ff7f then - begin - AlphaFillInline(PBGRAPixel(AContextData^.Dest), PByte(AFixedData)^, ACount); - inc(PBGRAPixel(AContextData^.Dest), ACount); - end else - begin - pDest := PBGRAPixel(AContextData^.Dest); - alphaAdd := PByte(AFixedData)^*AAlpha; - while ACount > 0 do - begin - pDest^.alpha := (pDest^.alpha*(not AAlpha) + alphaAdd) shr 16; - inc(pDest); - dec(ACount); - end; - PBGRAPixel(AContextData^.Dest) := pDest; - end; -end; - -procedure BGRAAlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); -var - bAlpha: Byte; -begin - if AAlpha <= $80 then - BGRASolidBrushIndirect(ABrush, @BGRAPixelTransparent, dmSet) - else - begin - ABrush.Colorspace:= TBGRAPixelColorspace; - bAlpha := FastRoundDiv257(AAlpha); - PByte(@ABrush.FixedData)^ := bAlpha; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @BGRASolidBrushAlphaPixels; - end; -end; - -procedure BGRAFillClearTypeMaskPtr(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; maskData: PByte; maskPixelSize: Int32or64; maskRowSize: Int32or64; maskWidth,maskHeight: integer; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); -var - pdest: PBGRAPixel; - ClearTypePixel: array[0..2] of byte; - curThird: integer; - - procedure OutputPixel; inline; - begin - if texture <> nil then - color := texture.ScanNextPixel; - if RGBOrder then - ClearTypeDrawPixel(pdest, ClearTypePixel[0],ClearTypePixel[1],ClearTypePixel[2], color) - else - ClearTypeDrawPixel(pdest, ClearTypePixel[2],ClearTypePixel[1],ClearTypePixel[0], color); - end; - - procedure NextAlpha(alphaValue: byte); inline; - begin - ClearTypePixel[curThird] := alphaValue; - inc(curThird); - if curThird = 3 then - begin - OutputPixel; - curThird := 0; - Fillchar(ClearTypePixel, sizeof(ClearTypePixel),0); - inc(pdest); - end; - end; - - procedure EndRow; inline; - begin - if curThird > 0 then OutputPixel; - end; - -var - yMask,n: integer; - a: byte; - pmask: PByte; - dx:integer; - miny,maxy,minx,minxThird,maxx,alphaMinX,alphaMaxX,alphaLineLen: integer; - leftOnSide, rightOnSide: boolean; - countBetween: integer; - v1,v2,v3: byte; - - procedure StartRow; inline; - begin - pdest := dest.Scanline[yMask+y]+minx; - if texture <> nil then - texture.ScanMoveTo(minx,yMask+y); - - curThird := minxThird; - ClearTypePixel[0] := 0; - ClearTypePixel[1] := 0; - ClearTypePixel[2] := 0; - end; - -begin - alphaLineLen := maskWidth+2; - - dec(xThird); //for first subpixel - - if xThird >= 0 then dx := xThird div 3 - else dx := -((-xThird+2) div 3); - inc(x, dx); - dec(xThird, dx*3); - - if y >= dest.ClipRect.Top then miny := 0 - else miny := dest.ClipRect.Top-y; - if y+maskHeight-1 < dest.ClipRect.Bottom then - maxy := maskHeight-1 else - maxy := dest.ClipRect.Bottom-1-y; - - if x >= dest.ClipRect.Left then - begin - minx := x; - minxThird := xThird; - alphaMinX := 0; - leftOnSide := false; - end else - begin - minx := dest.ClipRect.Left; - minxThird := 0; - alphaMinX := (dest.ClipRect.Left-x)*3 - xThird; - leftOnSide := true; - end; - - if x*3+xThird+maskWidth-1 < dest.ClipRect.Right*3 then - begin - maxx := (x*3+xThird+maskWidth-1) div 3; - alphaMaxX := alphaLineLen-1; - rightOnSide := false; - end else - begin - maxx := dest.ClipRect.Right-1; - alphaMaxX := maxx*3+2 - (x*3+xThird); - rightOnSide := true; - end; - - countBetween := alphaMaxX-alphaMinX-1; - - if (alphaMinX <= alphaMaxX) then - begin - for yMask := miny to maxy do - begin - StartRow; - - if leftOnSide then - begin - pmask := maskData + (yMask*maskRowSize)+ (alphaMinX-1)*maskPixelSize; - a := pmask^ div 3; - v1 := a+a; - v2 := a; - v3 := 0; - inc(pmask, maskPixelSize); - end else - begin - pmask := maskData + (yMask*maskRowSize); - v1 := 0; - v2 := 0; - v3 := 0; - end; - - for n := countBetween-1 downto 0 do - begin - a := pmask^ div 3; - inc(v1, a); - inc(v2, a); - inc(v3, a); - inc(pmask, maskPixelSize); - - NextAlpha(v1); - v1 := v2; - v2 := v3; - v3 := 0; - end; - - if rightOnSide then - begin - a := pmask^ div 3; - inc(v1, a); - inc(v2, a+a); - end; - - NextAlpha(v1); - NextAlpha(v2); - - EndRow; - end; - end; -end; - -procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); -var delta: Int32or64; -begin - delta := mask.Width*sizeof(TBGRAPixel); - if mask.LineOrder = riloBottomToTop then - delta := -delta; - BGRAFillClearTypeMaskPtr(dest,x,y,xThird,pbyte(mask.ScanLine[0])+1,sizeof(TBGRAPixel),delta,mask.Width,mask.Height,color,texture,RGBOrder); -end; - -procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer; - mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; - KeepRGBOrder: boolean); -var - minx,miny,maxx,maxy,countx,n,yb: integer; - pdest,psrc: PBGRAPixel; -begin - if y >= dest.ClipRect.Top then miny := 0 - else miny := dest.ClipRect.Top-y; - if y+mask.Height-1 < dest.ClipRect.Bottom then - maxy := mask.Height-1 else - maxy := dest.ClipRect.Bottom-1-y; - - if x >= dest.ClipRect.Left then minx := 0 - else minx := dest.ClipRect.Left-x; - if x+mask.Width-1 < dest.ClipRect.Right then - maxx := mask.Width-1 else - maxx := dest.ClipRect.Right-1-x; - - countx := maxx-minx+1; - if countx <= 0 then exit; - - for yb := miny to maxy do - begin - pdest := dest.ScanLine[y+yb]+(x+minx); - psrc := mask.ScanLine[yb]+minx; - if texture <> nil then - texture.ScanMoveTo(x+minx, y+yb); - if KeepRGBOrder then - begin - for n := countx-1 downto 0 do - begin - if texture <> nil then color := texture.ScanNextPixel; - ClearTypeDrawPixel(pdest, psrc^.red, psrc^.green, psrc^.blue, color); - inc(pdest); - inc(psrc); - end; - end else - begin - for n := countx-1 downto 0 do - begin - if texture <> nil then color := texture.ScanNextPixel; - ClearTypeDrawPixel(pdest, psrc^.blue, psrc^.green, psrc^.red, color); - inc(pdest); - inc(psrc); - end; - end; - end; -end; - -procedure ClearTypeDrawPixel(pdest: PBGRAPixel; Cr, Cg, Cb: byte; Color: TBGRAPixel); -var merge,mergeClearType: TBGRAPixel; - acc: word; - keep,dont_keep: byte; -begin - Cr := ApplyOpacity(Cr,color.alpha); - Cg := ApplyOpacity(Cg,color.alpha); - Cb := ApplyOpacity(Cb,color.alpha); - acc := Cr+Cg+Cb; - if acc = 0 then exit; - - merge := pdest^; - mergeClearType.red := GammaCompressionTab[(GammaExpansionTab[merge.red] * (not byte(Cr)) + - GammaExpansionTab[color.red] * Cr + 128) div 255]; - mergeClearType.green := GammaCompressionTab[(GammaExpansionTab[merge.green] * (not byte(Cg)) + - GammaExpansionTab[color.green] * Cg + 128) div 255]; - mergeClearType.blue := GammaCompressionTab[(GammaExpansionTab[merge.blue] * (not byte(Cb)) + - GammaExpansionTab[color.blue] * Cb + 128) div 255]; - mergeClearType.alpha := merge.alpha; - - if (mergeClearType.alpha = 255) then - pdest^:= mergeClearType - else - begin - if Cg <> 0 then - DrawPixelInlineWithAlphaCheck(@merge, color, Cg); - dont_keep := mergeClearType.alpha; - if dont_keep > 0 then - begin - keep := not dont_keep; - merge.red := GammaCompressionTab[(GammaExpansionTab[merge.red] * keep + GammaExpansionTab[mergeClearType.red] * dont_keep) div 255]; - merge.green := GammaCompressionTab[(GammaExpansionTab[merge.green] * keep + GammaExpansionTab[mergeClearType.green] * dont_keep) div 255]; - merge.blue := GammaCompressionTab[(GammaExpansionTab[merge.blue] * keep + GammaExpansionTab[mergeClearType.blue] * dont_keep) div 255]; - merge.alpha := mergeClearType.alpha + ApplyOpacity(merge.alpha, not mergeClearType.alpha); - end; - pdest^ := merge; - end; -end; - -procedure InterpolateBilinear(pUpLeft, pUpRight, pDownLeft, - pDownRight: PBGRAPixel; iFactX,iFactY: Integer; ADest: PBGRAPixel); -var - w1,w2,w3,w4,alphaW: LongWord; - rSum, gSum, bSum: LongWord; //rgbDiv = aSum - aSum, aDiv: LongWord; -begin - rSum := 0; - gSum := 0; - bSum := 0; - aSum := 0; - aDiv := 0; - - w4 := (iFactX*iFactY+127) shr 8; - w3 := iFactY-w4; - {$PUSH}{$HINTS OFF} - w1 := (256-iFactX)-w3; - {$POP} - w2 := iFactX-w4; - - if (pUpLeft <> nil) and (pUpRight <> nil) and (pDownLeft <> nil) and (pDownRight <> nil) and - (pUpLeft^.alpha = pUpRight^.alpha) and (pUpLeft^.alpha = pDownLeft^.alpha) and - (pUpRight^.alpha = pDownRight^.alpha) then - begin - if pUpLeft^.alpha = 0 then - ADest^ := BGRAPixelTransparent - else - begin - ADest^.red := (pUpLeft^.red*w1 + pUpRight^.red*w2 + pDownLeft^.red*w3 + pDownRight^.red*w4 + 128) shr 8; - ADest^.green := (pUpLeft^.green*w1 + pUpRight^.green*w2 + pDownLeft^.green*w3 + pDownRight^.green*w4 + 128) shr 8; - ADest^.blue := (pUpLeft^.blue*w1 + pUpRight^.blue*w2 + pDownLeft^.blue*w3 + pDownRight^.blue*w4 + 128) shr 8; - ADest^.alpha := pUpLeft^.alpha; - end; - exit; - end; - - { For each pixel around the coordinate, compute - the weight for it and multiply values by it before - adding to the sum } - if pUpLeft <> nil then - with pUpLeft^ do - begin - alphaW := alpha * w1; - inc(aDiv, w1); - inc(aSum, alphaW); - inc(rSum, red * alphaW); - inc(gSum, green * alphaW); - inc(bSum, blue * alphaW); - end; - if pUpRight <> nil then - with pUpRight^ do - begin - alphaW := alpha * w2; - inc(aDiv, w2); - inc(aSum, alphaW); - inc(rSum, red * alphaW); - inc(gSum, green * alphaW); - inc(bSum, blue * alphaW); - end; - if pDownLeft <> nil then - with pDownLeft^ do - begin - alphaW := alpha * w3; - inc(aDiv, w3); - inc(aSum, alphaW); - inc(rSum, red * alphaW); - inc(gSum, green * alphaW); - inc(bSum, blue * alphaW); - end; - if pDownRight <> nil then - with pDownRight^ do - begin - alphaW := alpha * w4; - inc(aDiv, w4); - inc(aSum, alphaW); - inc(rSum, red * alphaW); - inc(gSum, green * alphaW); - inc(bSum, blue * alphaW); - end; - - if aSum < 128 then //if there is no alpha - ADest^ := BGRAPixelTransparent - else - with ADest^ do - begin - red := (rSum + aSum shr 1) div aSum; - green := (gSum + aSum shr 1) div aSum; - blue := (bSum + aSum shr 1) div aSum; - if aDiv = 256 then - alpha := (aSum + 128) shr 8 - else - alpha := (aSum + aDiv shr 1) div aDiv; - end; -end; - -procedure InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft, - pDownRight: PByteMask; iFactX, iFactY: Integer; ADest: PByteMask); -var - w1,w2,w3,w4,sum: LongWord; -begin - w4 := (iFactX*iFactY+127) shr 8; - w3 := iFactY-w4; - {$PUSH}{$HINTS OFF} - w1 := (256-iFactX)-w3; - {$POP} - w2 := iFactX-w4; - - if (pUpLeft <> nil) and (pUpRight <> nil) and (pDownLeft <> nil) and (pDownRight <> nil) then - ADest^.gray := (pUpLeft^.gray*w1 + pUpRight^.gray*w2 + pDownLeft^.gray*w3 + pDownRight^.gray*w4 + 128) shr 8 - else - begin - sum := 0; - if pUpLeft <> nil then inc(sum, pUpLeft^.gray*w1); - if pUpRight <> nil then inc(sum, pUpRight^.gray*w2); - if pDownLeft <> nil then inc(sum, pDownLeft^.gray*w3); - if pDownRight <> nil then inc(sum, pDownRight^.gray*w4); - ADest^.gray := (sum + 128) shr 8; - end; -end; - -procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode); -var c : TBGRAPixel; - i: Integer; - scanNextFunc: function(): TBGRAPixel of object; -begin - if scan.IsScanPutPixelsDefined then - scan.ScanPutPixels(pdest,count,mode) else - begin - scanNextFunc := @scan.ScanNextPixel; - case mode of - dmLinearBlend: - for i := 0 to count-1 do - begin - FastBlendPixelInline(pdest, scanNextFunc()); - inc(pdest); - end; - dmDrawWithTransparency: - for i := 0 to count-1 do - begin - DrawPixelInlineWithAlphaCheck(pdest, scanNextFunc()); - inc(pdest); - end; - dmSet: - for i := 0 to count-1 do - begin - pdest^ := scanNextFunc(); - inc(pdest); - end; - dmXor: - for i := 0 to count-1 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(scanNextFunc()); - inc(pdest); - end; - dmSetExceptTransparent: - for i := 0 to count-1 do - begin - c := scanNextFunc(); - if c.alpha = 255 then pdest^ := c; - inc(pdest); - end; - end; - end; -end; - -procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - PLongWord(dest)^ := PLongWord(dest)^ xor LongWord(c); - Inc(dest); - Dec(Count); - end; -end; - -procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer); -begin - while Count > 0 do - begin - PLongWord(pdest)^ := PLongWord(psrc)^ xor PLongWord(pdest)^; - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -{$i blendpixels.inc} - -procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline; -begin - while Count > 0 do - begin - dest^.alpha := alpha; - Inc(dest); - Dec(Count); - end; -end; - -procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; -begin - FillDWord(dest^, Count, LongWord(c)); -end; - -procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); -var - n: integer; -begin - if c.alpha = 0 then exit; - for n := Count - 1 downto 0 do - begin - FastBlendPixelInline(dest, c); - Inc(dest); - end; -end; - -procedure PutPixels(pdest: PBGRAPixel; psource: PBGRAPixel; copycount: integer; - mode: TDrawMode; AOpacity: byte); -var i: integer; tempPixel: TBGRAPixel; -begin - case mode of - dmSet: - begin - if AOpacity <> 255 then - CopyPixelsWithOpacity(pdest, psource, AOpacity, copycount) - else - move(psource^, pdest^, copycount * sizeof(TBGRAPixel)); - end; - dmSetExceptTransparent: - begin - if AOpacity <> 255 then - begin - for i := copycount - 1 downto 0 do - begin - if psource^.alpha = 255 then - begin - tempPixel := psource^; - tempPixel.alpha := ApplyOpacity(tempPixel.alpha,AOpacity); - FastBlendPixelInline(pdest,tempPixel); - end; - Inc(pdest); - Inc(psource); - end; - end else - for i := copycount - 1 downto 0 do - begin - if psource^.alpha = 255 then - pdest^ := psource^; - Inc(pdest); - Inc(psource); - end; - end; - dmDrawWithTransparency: - begin - if AOpacity <> 255 then - begin - for i := copycount - 1 downto 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest, psource^, AOpacity); - Inc(pdest); - Inc(psource); - end; - end - else - for i := copycount - 1 downto 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest, psource^); - Inc(pdest); - Inc(psource); - end; - end; - dmFastBlend: - begin - if AOpacity <> 255 then - begin - for i := copycount - 1 downto 0 do - begin - FastBlendPixelInline(pdest, psource^, AOpacity); - Inc(pdest); - Inc(psource); - end; - end else - for i := copycount - 1 downto 0 do - begin - FastBlendPixelInline(pdest, psource^); - Inc(pdest); - Inc(psource); - end; - end; - dmXor: - begin - if AOpacity <> 255 then - begin - for i := copycount - 1 downto 0 do - begin - PLongWord(@tempPixel)^ := PLongWord(pdest)^ xor PLongWord(psource)^; - FastBlendPixelInline(pdest, tempPixel, AOpacity); - Inc(pdest); - Inc(psource); - end; - end else - XorPixels(pdest, psource, copycount); - end; - end; -end; - -procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); -var - n: integer; - ec: TExpandedPixel; -begin - if c.alpha = 0 then exit; - if c.alpha = 255 then - begin - filldword(dest^,count,LongWord(c)); - exit; - end; - ec := GammaExpansion(c); - for n := Count - 1 downto 0 do - begin - DrawExpandedPixelInlineNoAlphaCheck(dest, ec,c.alpha); - Inc(dest); - end; -end; - -procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; - Count: integer); -var - n: integer; - c: TBGRAPixel; -begin - if ec.alpha < $0100 then exit; - if ec.alpha >= $FF00 then - begin - c := GammaCompression(ec); - filldword(dest^,count,LongWord(c)); - exit; - end; - for n := Count - 1 downto 0 do - begin - DrawExpandedPixelInlineNoAlphaCheck(dest, ec, ec.alpha shr 8); - Inc(dest); - end; -end; - -procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer); -var - n: integer; -begin - if c.alpha = 0 then exit; - if c.alpha = 255 then - begin - filldword(dest^,count,LongWord(c)); - exit; - end; - for n := Count - 1 downto 0 do - begin - DrawExpandedPixelInlineNoAlphaCheck(dest, ec, c.alpha); - Inc(dest); - end; -end; - -procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel; - Count: integer; compare: TBGRAPixel; maxDiff: byte); inline; -var - n: integer; -begin - for n := Count - 1 downto 0 do - begin - DrawPixelInlineDiff(dest, c, compare, maxDiff); - Inc(dest); - end; -end; - -procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); -begin - case c.alpha of - 0: ; - 255: dest^ := c; - else - DrawPixelInlineNoAlphaCheck(dest,c); - end; -end; - -procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); -begin - c.alpha := ApplyOpacity(c.alpha,appliedOpacity); - DrawPixelInlineWithAlphaCheck(dest, c); -end; - -procedure CopyPixelsWithOpacity(dest, src: PBGRAPixel; opacity: byte; - Count: integer); -begin - while count > 0 do - begin - dest^ := MergeBGRAWithGammaCorrection(src^,opacity,dest^,not opacity); - inc(src); - inc(dest); - dec(count); - end; -end; - -function ApplyOpacity(opacity1, opacity2: byte): byte; -begin - result := opacity1*(opacity2+1) shr 8; -end; - -function FastRoundDiv255(value: LongWord): LongWord; inline; -begin - result := (value + (value shr 7)) shr 8; -end; - -procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel); -var - calpha: byte; -begin - calpha := ec.alpha shr 8; - case calpha of - 0: ; - 255: dest^ := GammaCompression(ec); - else - DrawExpandedPixelInlineNoAlphaCheck(dest,ec,calpha); - end; -end; - -procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel); -begin - case c.alpha of - 0: ; - 255: dest^ := c; - else - DrawExpandedPixelInlineNoAlphaCheck(dest,ec,c.alpha); - end; -end; - -procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); -var - a1f, a2f, a12, a12m, alphaCorr: UInt32or64; -begin - case dest^.alpha of - 0: dest^ := c; - 255: - begin - alphaCorr := c.alpha; - if alphaCorr >= 128 then inc(alphaCorr); - dest^.red := GammaCompressionTab[(GammaExpansionTab[dest^.red] * UInt32or64(256-alphaCorr) + GammaExpansionTab[c.red]*alphaCorr) shr 8]; - dest^.green := GammaCompressionTab[(GammaExpansionTab[dest^.green] * UInt32or64(256-alphaCorr) + GammaExpansionTab[c.green]*alphaCorr) shr 8]; - dest^.blue := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * UInt32or64(256-alphaCorr) + GammaExpansionTab[c.blue]*alphaCorr) shr 8]; - end; - else - begin - {$HINTS OFF} - a12 := 65025 - (not dest^.alpha) * (not c.alpha); - {$HINTS ON} - a12m := a12 shr 1; - - a1f := dest^.alpha * (not c.alpha); - a2f := (c.alpha shl 8) - c.alpha; - - PLongWord(dest)^ := ((GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f + - GammaExpansionTab[c.red] * a2f + a12m) div a12]) shl TBGRAPixel_RedShift) or - ((GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f + - GammaExpansionTab[c.green] * a2f + a12m) div a12]) shl TBGRAPixel_GreenShift) or - ((GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f + - GammaExpansionTab[c.blue] * a2f + a12m) div a12]) shl TBGRAPixel_BlueShift) or - (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift); - end; - end; -end; - -procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; - const ec: TExpandedPixel; calpha: byte); -var - a1f, a2f, a12, a12m, alphaCorr: UInt32or64; -begin - case dest^.alpha of - 0: begin - dest^.red := GammaCompressionTab[ec.red]; - dest^.green := GammaCompressionTab[ec.green]; - dest^.blue := GammaCompressionTab[ec.blue]; - dest^.alpha := calpha; - end; - 255: - begin - alphaCorr := calpha; - if alphaCorr >= 128 then inc(alphaCorr); - dest^.red := GammaCompressionTab[(GammaExpansionTab[dest^.red] * UInt32or64(256-alphaCorr) + ec.red*alphaCorr) shr 8]; - dest^.green := GammaCompressionTab[(GammaExpansionTab[dest^.green] * UInt32or64(256-alphaCorr) + ec.green*alphaCorr) shr 8]; - dest^.blue := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * UInt32or64(256-alphaCorr) + ec.blue*alphaCorr) shr 8]; - end; - else - begin - {$HINTS OFF} - a12 := 65025 - (not dest^.alpha) * (not calpha); - {$HINTS ON} - a12m := a12 shr 1; - - a1f := dest^.alpha * (not calpha); - a2f := (calpha shl 8) - calpha; - - PLongWord(dest)^ := ((GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f + - ec.red * a2f + a12m) div a12]) shl TBGRAPixel_RedShift) or - ((GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f + - ec.green * a2f + a12m) div a12]) shl TBGRAPixel_GreenShift) or - ((GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f + - ec.blue * a2f + a12m) div a12]) shl TBGRAPixel_BlueShift) or - (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift); - end; - end; -end; - -procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel); -var - a1f, a2f, a12, a12m, alphaCorr: UInt32or64; -begin - case c.alpha of - 0: ; - 255: dest^ := c; - else - begin - case dest^.alpha of - 0: dest^ := c; - 255: - begin - alphaCorr := c.alpha; - if alphaCorr >= 128 then inc(alphaCorr); - dest^.red := (dest^.red * UInt32or64(256-alphaCorr) + c.red*(alphaCorr+1)) shr 8; - dest^.green := (dest^.green * UInt32or64(256-alphaCorr) + c.green*(alphaCorr+1)) shr 8; - dest^.blue := (dest^.blue * UInt32or64(256-alphaCorr) + c.blue*(alphaCorr+1)) shr 8; - end; - else - begin - {$HINTS OFF} - a12 := 65025 - (not dest^.alpha) * (not c.alpha); - {$HINTS ON} - a12m := a12 shr 1; - - a1f := dest^.alpha * (not c.alpha); - a2f := (c.alpha shl 8) - c.alpha; - - PLongWord(dest)^ := (((dest^.red * a1f + c.red * a2f + a12m) div a12) shl TBGRAPixel_RedShift) or - (((dest^.green * a1f + c.green * a2f + a12m) div a12) shl TBGRAPixel_GreenShift) or - (((dest^.blue * a1f + c.blue * a2f + a12m) div a12) shl TBGRAPixel_BlueShift) or - (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift); - end; - end; - end; - end; -end; - -procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel; - appliedOpacity: byte); -begin - c.alpha := ApplyOpacity(c.alpha,appliedOpacity); - FastBlendPixelInline(dest,c); -end; - -procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel; - maxDiff: byte); inline; -var alpha: Int32or64; -begin - alpha := (c.alpha * (maxDiff + 1 - BGRADiff(dest^, compare)) + (maxDiff + 1) shr 1) div - (maxDiff + 1); - if alpha > 0 then - DrawPixelInlineWithAlphaCheck(dest, BGRA(c.red, c.green, c.blue, alpha)); -end; - -procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline; -var - newAlpha: byte; -begin - newAlpha := ApplyOpacity(dest^.alpha, not alpha); - if newAlpha = 0 then - dest^ := BGRAPixelTransparent - else - dest^.alpha := newAlpha; -end; - -{$i blendpixelsover.inc} - -{$i blendpixelinline.inc} - -end. - diff --git a/components/bgrabitmap/bgrablurgl.pas b/components/bgrabitmap/bgrablurgl.pas deleted file mode 100644 index aa3357b..0000000 --- a/components/bgrabitmap/bgrablurgl.pas +++ /dev/null @@ -1,200 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRABlurGL; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; - -type - - { TBGLBlurShader } - - TBGLBlurShader = class(TBGLShader3D) - private - function GetDirection: TPointF; - function GetImageIndex: integer; - function GetRadius: Single; - function GetTextureSize: TPoint; - procedure SetDirection(AValue: TPointF); - procedure SetImageIndex(AValue: integer); - procedure SetRadius(AValue: Single); - procedure SetTextureSize(AValue: TPoint); - protected - FTextureSize: TUniformVariablePoint; - FImageIndex: TUniformVariableInteger; - FDirection: TUniformVariablePointF; - FRadius: TUniformVariableSingle; - FBlurType: TRadialBlurType; - procedure StartUse; override; - public - constructor Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType); - function FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture; overload; - function FilterBlurMotion(ATexture: IBGLTexture; ADirection: TPointF): IBGLTexture; overload; - function FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture; - property ImageIndex: integer read GetImageIndex write SetImageIndex; - property TextureSize: TPoint read GetTextureSize write SetTextureSize; - property Direction: TPointF read GetDirection write SetDirection; - property Radius: Single read GetRadius write SetRadius; - property BlurType: TRadialBlurType read FBlurType; - end; - -implementation - -{ TBGLBlurShader } - -function TBGLBlurShader.GetDirection: TPointF; -begin - result := FDirection.Value; -end; - -function TBGLBlurShader.GetImageIndex: integer; -begin - result := FImageIndex.Value; -end; - -function TBGLBlurShader.GetRadius: Single; -begin - result := FRadius.Value; - if FBlurType = rbPrecise then result := result * 10; -end; - -function TBGLBlurShader.GetTextureSize: TPoint; -begin - result := FTextureSize.Value; -end; - -procedure TBGLBlurShader.SetDirection(AValue: TPointF); -begin - FDirection.Value := AValue; -end; - -procedure TBGLBlurShader.SetImageIndex(AValue: integer); -begin - FImageIndex.Value := AValue; -end; - -procedure TBGLBlurShader.SetRadius(AValue: Single); -begin - if FBlurType = rbPrecise then AValue := AValue/10; - FRadius.Value := AValue; -end; - -procedure TBGLBlurShader.SetTextureSize(AValue: TPoint); -begin - FTextureSize.Value:= AValue; -end; - -constructor TBGLBlurShader.Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType); -var weightFunc: string; -begin - FBlurType:= ABlurType; - case ABlurType of - rbNormal,rbPrecise: weightFunc:= -' float sigma = max(0.1,radius/1.8);'#10+ -' float normalized = x/sigma;'#10 + -' return 1/(2.506628274631*sigma)*exp(-0.5*normalized*normalized);'; - rbCorona: weightFunc := 'return max(0, 1-abs(x-radius));'; - rbFast: weightFunc := 'return max(0,radius+1-x);'; - else {rbBox,rbDisk} - weightFunc := 'if (x <= radius) return 1; else return max(0,radius+1-x);'; - end; - - inherited Create(ACanvas, -'void main(void) {'#10 + -' gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 + -' texCoord = vec2(gl_MultiTexCoord0);'#10 + -'}', - -'uniform sampler2D image;'#10 + -'uniform ivec2 textureSize;'#10 + -'uniform vec2 direction;'#10 + -'uniform float radius;'#10 + -'out vec4 FragmentColor;'#10 + - -'float computeWeight(float x)'#10 + -'{'#10 + -weightFunc + #10 + -'}'#10 + - -'void main(void)'#10 + -'{'#10 + -' int range = int(radius+1.5);'#10 + - -' float weight = computeWeight(0);'#10 + -' float totalWeight = weight;'#10 + -' FragmentColor = texture2D( image, texCoord ) * weight;'#10 + - -' for (int i=1; i<=range; i++) {'#10 + -' weight = computeWeight(i);'#10 + -' FragmentColor += texture2D( image, texCoord + i*direction/textureSize ) * weight;'#10 + -' FragmentColor += texture2D( image, texCoord - i*direction/textureSize ) * weight;'#10 + -' totalWeight += 2*weight;'#10 + -' }'#10 + - -' FragmentColor /= totalWeight;'#10 + -'}', - -'varying vec2 texCoord;', '130'); - - FImageIndex := UniformInteger['image']; - FTextureSize := UniformPoint['textureSize']; - FDirection := UniformPointF['direction']; - FRadius := UniformSingle['radius']; - - ImageIndex:= 0; - Direction := PointF(1,0); - TextureSize := Point(1,1); - Radius := 0; -end; - -function TBGLBlurShader.FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture; -var horiz: IBGLTexture; -begin - horiz := FilterBlurMotion(ATexture, PointF(1,0)); - result := FilterBlurMotion(horiz, PointF(0,1)); -end; - -function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture; -var previousBuf,buf: TBGLCustomFrameBuffer; - previousShader: TBGLCustomShader; -begin - previousBuf := Canvas.ActiveFrameBuffer; - buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height); - Canvas.ActiveFrameBuffer := buf; - - TextureSize := Point(ATexture.Width,ATexture.Height); - previousShader := Canvas.Lighting.ActiveShader; - Canvas.Lighting.ActiveShader := self; - - ATexture.Draw(0, 0); //perform horiz blur - - Canvas.Lighting.ActiveShader := previousShader; - Canvas.ActiveFrameBuffer := previousBuf; - result := buf.MakeTextureAndFree; -end; - -function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture; - ADirection: TPointF): IBGLTexture; -var prevDir: TPointF; -begin - prevDir := Direction; - Direction := ADirection; - result := FilterBlurMotion(ATexture); - Direction := prevDir; -end; - -procedure TBGLBlurShader.StartUse; -begin - inherited StartUse; - FImageIndex.Update; - FTextureSize.Update; - FDirection.Update; - FRadius.Update; -end; - -end. - - diff --git a/components/bgrabitmap/bgracanvas.pas b/components/bgrabitmap/bgracanvas.pas deleted file mode 100644 index 44dbc28..0000000 --- a/components/bgrabitmap/bgracanvas.pas +++ /dev/null @@ -1,1909 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRACanvas; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, FPImage, BGRABitmapTypes - {$IFDEF BGRABITMAP_USE_FPCANVAS}, FPCanvas{$ENDIF}; - -type - - { TBGRAColoredObject } - - TBGRAColoredObject = class - private - function GetColor: TColor; - function GetOpacity: Byte; - procedure SetColor(const AValue: TColor); - procedure SetOpacity(const AValue: Byte); - public - BGRAColor: TBGRAPixel; - procedure Assign(Source: TObject); virtual; - property Color: TColor read GetColor write SetColor; - property Opacity: Byte read GetOpacity write SetOpacity; - end; - - { TBGRAPen } - - TBGRAPen = class(TBGRAColoredObject) - private - FPenMode: TPenMode; - function GetActualColor: TBGRAPixel; - function GetActualDrawMode: TDrawMode; - function GetActualWidth: integer; - function GetCustomPenStyle: TBGRAPenStyle; - function GetInvisible: boolean; - function GetPenStyle: TPenStyle; - procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); - procedure SetPenMode(AValue: TPenMode); - procedure SetPenStyle(const AValue: TPenStyle); - protected - FCustomPenStyle: TBGRAPenStyle; - FPenStyle: TPenStyle; - public - Width: Integer; - EndCap: TPenEndCap; - JoinStyle: TPenJoinStyle; - constructor Create; - procedure Assign(Source: TObject); override; - procedure GetUniversalBrush(out ABrush: TUniversalBrush); - property Style: TPenStyle read GetPenStyle Write SetPenStyle; - property Mode: TPenMode read FPenMode write SetPenMode; - property CustomStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle; - property ActualWidth: integer read GetActualWidth; - property ActualColor: TBGRAPixel read GetActualColor; - property ActualDrawMode: TDrawMode read GetActualDrawMode; - property Invisible: boolean read GetInvisible; - end; - - { TBGRABrush } - - TBGRABrush = class(TBGRAColoredObject) - private - function GetActualColor: TBGRAPixel; - function GetActualDrawMode: TDrawMode; - function GetInvisible: boolean; - procedure SetBackColor(const AValue: TBGRAPixel); - procedure SetBrushStyle(const AValue: TBrushStyle); - procedure SetTexture(AValue: IBGRAScanner); - protected - FStyle, FStyleBeforeTexture: TBrushStyle; - FBackColor: TBGRAPixel; - FTexture: IBGRAScanner; - FInternalBitmap: TBGRACustomBitmap; - FInternalBitmapColor: TBGRAPixel; - public - constructor Create; - destructor Destroy; override; - procedure Assign(Source: TObject); override; - procedure GetUniversalBrush(ABitmapPrototype: TBGRACustomBitmap; out ABrush: TUniversalBrush); - function BuildTexture(Prototype: TBGRACustomBitmap): IBGRAScanner; - property Style: TBrushStyle read FStyle write SetBrushStyle; - property BackColor: TBGRAPixel read FBackColor write SetBackColor; - property ActualColor: TBGRAPixel read GetActualColor; - property ActualDrawMode: TDrawMode read GetActualDrawMode; - property Invisible: boolean read GetInvisible; - property Texture: IBGRAScanner read FTexture write SetTexture; - end; - - { TBGRAFont } - - TBGRAFont = class(TBGRAColoredObject) - private - function GetAntialiasing: Boolean; - procedure SetAntialiasing(const AValue: Boolean); - public - Name: string; - Height: Integer; - Style: TFontStyles; - Quality : TBGRAFontQuality; - Orientation: integer; - Texture: IBGRAScanner; - constructor Create; - procedure Assign(Source: TObject); override; - property Antialiasing: Boolean read GetAntialiasing write SetAntialiasing; - - end; - - { TBGRACanvas } - - TBGRACanvas = class - procedure SetBrush(const AValue: TBGRABrush); - procedure SetPen(const AValue: TBGRAPen); - function GetPixelColor(X, Y: Integer): TColor; - procedure SetPixelColor(X, Y: Integer; const AValue: TColor); - private - function GetClipping: Boolean; - function GetClipRect: TRect; - function GetExpandedPixel(X, Y: Integer): TExpandedPixel; - function GetFPPixelColor(X, Y: Integer): TFPColor; - function GetHeight: integer; - function GetWidth: integer; - procedure SetClipping(const AValue: Boolean); - procedure SetClipRect(const AValue: TRect); - procedure SetExpandedPixel(X, Y: Integer; const AValue: TExpandedPixel); - procedure SetFont(const AValue: TBGRAFont); - procedure SetFPPixelColor(X, Y: Integer; const AValue: TFPColor); - function ComputeEllipseC(x1, y1, x2, y2: integer; out cx,cy,rx,ry: single): boolean; - function CheckRectangle(var x1, y1, x2, y2: integer; out tx,ty: integer): boolean; - - protected - FBitmap: TBGRACustomBitmap; - FBrush: TBGRABrush; - FPen: TBGRAPen; - FPenPos: TPoint; - FFont : TBGRAFont; - FInactiveClipRect: TRect; - FClippingOn: Boolean; - procedure ApplyPenStyle; - procedure ApplyFont; - function NoPen: boolean; - function NoBrush: boolean; - public - AntialiasingMode: TAntialiasingMode; - FillMode : TFillMode; - TextStyle : TTextStyle; - DrawFontBackground : boolean; - constructor Create(ABitmap: TBGRACustomBitmap); - destructor Destroy; override; - procedure MoveTo(x,y: integer); overload; - procedure MoveTo(p: TPoint); overload; - procedure LineTo(x,y: integer); overload; - procedure LineTo(p: TPoint); overload; - procedure Line(x1,y1,x2,y2: integer); overload; - procedure Line(p1,p2: TPoint); overload; - procedure Arc(x1,y1,x2,y2,sx,sy,ex,ey: integer); - procedure Arc(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); - procedure Arc65536(x1,y1,x2,y2: integer; start65536,end65536: word; Options: TArcOptions); - procedure Chord(x1,y1,x2,y2,sx,sy,ex,ey: integer); - procedure Chord(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); - procedure Pie(x1,y1,x2,y2,sx,sy,ex,ey: integer); - procedure Pie(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); - procedure RadialPie(x1,y1,x2,y2,StartDeg16,LengthDeg16: integer); - procedure Ellipse(x1,y1,x2,y2: integer); - procedure Ellipse(const bounds: TRect); - procedure Rectangle(x1,y1,x2,y2: integer; Filled: Boolean = True); - procedure Rectangle(const bounds: TRect; Filled: Boolean = True); - procedure Frame(x1,y1,x2,y2: integer); - procedure Frame(const bounds: TRect); - procedure RoundRect(x1,y1,x2,y2: integer; dx,dy: integer); - procedure RoundRect(const bounds: TRect; dx,dy: integer); - procedure EllipseC(x,y,rx,ry: integer); - procedure FillRect(x1,y1,x2,y2: integer); - procedure FillRect(const bounds: TRect); - procedure FrameRect(x1,y1,x2,y2: integer; width: integer = 1); - procedure FrameRect(const bounds: TRect; width: integer = 1); - procedure Frame3D(var bounds: TRect; width: integer; Style: TGraphicsBevelCut); overload; - procedure Frame3D(var bounds: TRect; width: integer; Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); overload; - procedure GradientFill(ARect: TRect; AStart, AStop: TColor; - ADirection: TGradientDirection; GammaCorrection: Boolean = false); - procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); - procedure FloodFill(X, Y: Integer; FillColor: TBGRAPixel; FillStyle: TFillStyle); - procedure FloodFill(X, Y: Integer); - procedure Polygon(const APoints: array of TPoint); - procedure Polygon(const Points: array of TPoint; - Winding: Boolean; - StartIndex: Integer = 0; - NumPts: Integer = -1); - procedure Polygon(Points: PPoint; NumPts: Integer; - Winding: boolean = False); - procedure PolygonF(const APoints: array of TPointF); - procedure PolygonF(const APoints: array of TPointF; Winding: Boolean; FillOnly: Boolean = False); - procedure Polyline(const APoints: array of TPoint); - procedure Polyline(const Points: array of TPoint; - StartIndex: Integer; - NumPts: Integer = -1); - procedure Polyline(Points: PPoint; NumPts: Integer); - procedure PolylineF(const APoints: array of TPointF); - procedure PolyBezier(Points: PPoint; NumPts: Integer; - Filled: boolean = False; - Continuous: boolean = False); - procedure PolyBezier(const Points: array of TPoint; - Filled: boolean = False; - Continuous: boolean = False); - procedure Draw(X,Y: Integer; SrcBitmap: TBGRACustomBitmap); overload; - procedure Draw(X,Y: Integer; SrcBitmap: TBitmap); overload; - procedure CopyRect(X,Y: Integer; SrcBitmap: TBGRACustomBitmap; SrcRect: TRect); - procedure StretchDraw(DestRect: TRect; SrcBitmap: TBGRACustomBitmap; HorizFlip: Boolean = false; VertFlip: Boolean = false); - procedure DrawFocusRect(bounds: TRect); - procedure CopyRect(Dest: TRect; SrcBmp: TBGRACustomBitmap; - Source: TRect); virtual; - - procedure TextOut(X,Y: Integer; const Text: String); - procedure TextRect(const ARect: TRect; X, Y: integer; const Text: string); - procedure TextRect(ARect: TRect; X, Y: integer; const Text: string; - const Style: TTextStyle); - function TextExtent(const Text: string): TSize; - function TextHeight(const Text: string): Integer; - function TextWidth(const Text: string): Integer; - - property Pen: TBGRAPen read FPen write SetPen; - property PenPos : TPoint read FPenPos write FPenPos; - property Brush: TBGRABrush read FBrush write SetBrush; - property Font: TBGRAFont read FFont write SetFont; - property Pixels[X,Y: Integer]: TColor read GetPixelColor write SetPixelColor; - property GammaExpandedPixels[X,Y: Integer]: TExpandedPixel read GetExpandedPixel write SetExpandedPixel; - property Colors[X,Y: Integer]: TFPColor read GetFPPixelColor write SetFPPixelColor; - property Height: integer read GetHeight; - property Width : integer read GetWidth; - property ClipRect: TRect read GetClipRect write SetClipRect; - property Clipping: Boolean read GetClipping write SetClipping; - end; - -implementation - -uses BGRAPen, BGRAPath, BGRAPolygon, BGRAPolygonAliased, Math, BGRABlend; - -{ TBGRAFont } - -function TBGRAFont.GetAntialiasing: Boolean; -begin - result := Quality <> fqSystem; -end; - -procedure TBGRAFont.SetAntialiasing(const AValue: Boolean); -begin - if AValue = Antialiasing then exit; - if AValue then - Quality := fqFineAntialiasing - else - Quality := fqSystem; -end; - -constructor TBGRAFont.Create; -begin - Name := 'default'; - Height := 12; - Style := []; - Antialiasing := False; - Orientation := 0; - Texture := nil; - BGRAColor := BGRABlack; -end; - -procedure TBGRAFont.Assign(Source: TObject); -var sf: TBGRAFont; - f: TFont; - {$IFDEF BGRABITMAP_USE_FPCANVAS}cf: TFPCustomFont;{$ENDIF} -begin - if Source is TFont then - begin - f := TFont(Source); - Color := f.Color; - Opacity := 255; - Style := f.Style; - Name := f.Name; - Orientation := f.Orientation; - if f.Height= 0 then - Height := 16 else - Height := f.Height; - end else - if Source is TBGRAFont then - begin - sf := Source as TBGRAFont; - Name := sf.Name; - Height := sf.Height; - Style := sf.Style; - Quality := sf.Quality; - Orientation := sf.Orientation; - Texture := sf.Texture; - end - {$IFDEF BGRABITMAP_USE_FPCANVAS}else - if Source is TFPCustomFont then - begin - cf := Source as TFPCustomFont; - Color := FPColorToTColor(cf.FPColor); - Style := []; - if cf.Bold then include(Style, fsBold); - if cf.Italic then include(Style, fsItalic); - if cf.Underline then include(Style, fsUnderline); -{$IF FPC_FULLVERSION>=20602} //changed in 2.6.2 and 2.7 - if cf.StrikeThrough then include(Style, fsStrikeOut); -{$ELSE} - if cf.StrikeTrough then include(Style, fsStrikeOut); -{$ENDIF} - Name := cf.Name; - //Orientation := cf.Orientation; - if cf.Size = 0 then - Height := 16 else - Height := round(cf.Size*1.8); - end{$ENDIF}; - inherited Assign(Source); -end; - -{ TBGRABrush } - -function TBGRABrush.GetActualColor: TBGRAPixel; -begin - if (Style = bsClear) or (Opacity = 0) then - result := BGRAPixelTransparent - else - result := BGRAColor; -end; - -function TBGRABrush.GetActualDrawMode: TDrawMode; -begin - result := dmDrawWithTransparency; -end; - -function TBGRABrush.GetInvisible: boolean; -begin - result := (texture = nil) and ((style = bsClear) or ((style= bsSolid) and (bgracolor.alpha = 0)) - or ((bgracolor.alpha = 0) and (BackColor.alpha = 0))); -end; - -procedure TBGRABrush.SetBackColor(const AValue: TBGRAPixel); -begin - if FBackColor=AValue then exit; - FBackColor:=AValue; - FreeAndNil(FInternalBitmap); -end; - -procedure TBGRABrush.SetBrushStyle(const AValue: TBrushStyle); -begin - if FStyle=AValue then exit; - FStyle:=AValue; - if FStyle <> bsImage then FTexture := nil; - FreeAndNil(FInternalBitmap); -end; - -procedure TBGRABrush.SetTexture(AValue: IBGRAScanner); -begin - if FTexture=AValue then Exit; - FTexture:=AValue; - if Assigned(AValue) then - begin - if FStyle <> bsImage then - begin - FStyleBeforeTexture:= FStyle; - FStyle:= bsImage; - end; - end else - begin - if FStyle = bsImage then - FStyle := FStyleBeforeTexture; - end; -end; - -constructor TBGRABrush.Create; -begin - BGRAColor := BGRAWhite; - FInternalBitmap := nil; - FInternalBitmapColor := BGRAPixelTransparent; - FStyle := bsSolid; - FStyleBeforeTexture:= Style; - FTexture := nil; - FBackColor := BGRAPixelTransparent; -end; - -destructor TBGRABrush.Destroy; -begin - Texture := nil; - FInternalBitmap.Free; - inherited Destroy; -end; - -procedure TBGRABrush.Assign(Source: TObject); -var sb: TBGRABrush; - b: TBrush; -begin - if Source is TBGRABrush then - begin - sb := Source as TBGRABrush; - Texture := sb.Texture; - BackColor := sb.BackColor; - Style := sb.Style; - end else - if Source is TBrush then - begin - b := Source as TBrush; - Color := b.Color; - Opacity := 255; - Style := b.Style; - end; - inherited Assign(Source); -end; - -procedure TBGRABrush.GetUniversalBrush(ABitmapPrototype: TBGRACustomBitmap; out ABrush: TUniversalBrush); -var - tex: IBGRAScanner; - c: TBGRAPixel; -begin - tex := BuildTexture(ABitmapPrototype); - if tex <> nil then - BGRAScannerBrush(ABrush, tex, ActualDrawMode) - else - begin - c := ActualColor; - BGRASolidBrushIndirect(ABrush, @c, ActualDrawMode); - end; -end; - -function TBGRABrush.BuildTexture(Prototype: TBGRACustomBitmap): IBGRAScanner; -begin - //user-defined texture - if Texture <> nil then - result := texture - else - begin - //free pattern if color has changed - if (FInternalBitmap <> nil) and (FInternalBitmapColor <> BGRAColor) then - FreeAndNil(FInternalBitmap); - - //styles that do not have pattern - if Style in[bsSolid,bsClear] then - result := nil - else - begin - //create pattern if needed - if FInternalBitmap = nil then - begin - FInternalBitmap := CreateBrushTexture(Prototype, Style, BGRAColor,BackColor); - FInternalBitmapColor := BGRAColor; - end; - result := FInternalBitmap; - end; - end; -end; - -{ TBGRAPen } - -function TBGRAPen.GetActualColor: TBGRAPixel; -begin - if (Style = psClear) or (Opacity = 0) then - result := BGRAPixelTransparent - else - begin - case Mode of - pmBlack: result := BGRABlack; - pmWhite: result := BGRAWhite; - pmNop: result := BGRAPixelTransparent; - pmNot: result := BGRA(255,255,255,0); - pmCopy: result := BGRAColor; - pmNotCopy: result := BGRA(not BGRAColor.red, not BGRAColor.green, not BGRAColor.blue, BGRAColor.alpha); - pmMerge, pmNotMerge, pmMask, pmNotMask, pmXor: result := BGRA(BGRAColor.red, BGRAColor.green, BGRAColor.blue, 0); - pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmNotXor: result := BGRA(not BGRAColor.red, not BGRAColor.green, not BGRAColor.blue, 0); - else - raise exception.Create('Unhandled pen mode'); - end; - end; -end; - -function TBGRAPen.GetActualDrawMode: TDrawMode; -begin - case Mode of - pmBlack, pmWhite, pmNop, pmCopy, pmNotCopy: - result := dmDrawWithTransparency; - else - {pmNot, pmXor, pmNotXor and others} - result := dmXor; - end; -end; - -function TBGRAPen.GetActualWidth: integer; -begin - if width < 1 then result := 1 else - result := Width; -end; - -function TBGRAPen.GetCustomPenStyle: TBGRAPenStyle; -begin - result := DuplicatePenStyle(FCustomPenStyle); -end; - -function TBGRAPen.GetInvisible: boolean; -var b: TUniversalBrush; -begin - GetUniversalBrush(b); - result := b.DoesNothing; -end; - -function TBGRAPen.GetPenStyle: TPenStyle; -begin - Result:= FPenStyle; -end; - -procedure TBGRAPen.SetCustomPenStyle(const AValue: TBGRAPenStyle); -begin - FCustomPenStyle := DuplicatePenStyle(AValue); - FPenStyle:= BGRAToPenStyle(AValue); -end; - -procedure TBGRAPen.SetPenMode(AValue: TPenMode); -begin - if FPenMode=AValue then Exit; - FPenMode:=AValue; -end; - -procedure TBGRAPen.SetPenStyle(const AValue: TPenStyle); -begin - if AValue = psPattern then exit; - FCustomPenStyle := PenStyleToBGRA(AValue); - FPenStyle := AValue; -end; - -constructor TBGRAPen.Create; -begin - Width := 1; - EndCap := pecRound; - JoinStyle := pjsRound; - Style := psSolid; - BGRAColor := BGRABlack; - Mode := pmCopy; -end; - -procedure TBGRAPen.Assign(Source: TObject); -var sp: TBGRAPen; - p: TPen; -begin - if Source is TBGRAPen then - begin - sp := Source as TBGRAPen; - Mode := sp.Mode; - Width := sp.Width; - EndCap := sp.EndCap; - JoinStyle := sp.JoinStyle; - Style := sp.Style; - CustomStyle := sp.CustomStyle; - end else - if Source is TPen then - begin - p := Source as TPen; - Mode := p.Mode; - Width := p.Width; - EndCap := p.EndCap; - JoinStyle := p.JoinStyle; - Style := p.Style; - Color := p.Color; - Opacity := 255; - end; - inherited Assign(Source); -end; - -type - PBGRAPenBrushFixedData = ^TBGRAPenBrushFixedData; - TBGRAPenBrushFixedData = record - BGRA: TBGRAPixel; - NotResult: boolean; - end; - -procedure BGRAPenSkipPixels({%H-}AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -begin - inc(PBGRAPixel(AContextData^.Dest), ACount); -end; - -procedure BGRAPenMergePixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PBGRAPixel; - merged: TBGRAPixel; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - with PBGRAPenBrushFixedData(AFixedData)^ do - begin - while ACount > 0 do - begin - merged.red := pDest^.red or PBGRAPenBrushFixedData(AFixedData)^.BGRA.red; - merged.green := pDest^.green or PBGRAPenBrushFixedData(AFixedData)^.BGRA.green; - merged.blue := pDest^.blue or PBGRAPenBrushFixedData(AFixedData)^.BGRA.blue; - if NotResult then - begin - merged.red := not merged.red; - merged.green := not merged.green; - merged.blue := not merged.blue; - end; - if AAlpha >= $ff7f then - pDest^ := merged else - pDest^ := GammaCompression(MergeBGRA(GammaExpansion(pDest^), not AAlpha, - GammaExpansion(merged), AAlpha)); - inc(pDest); - dec(ACount); - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure BGRAPenMaskPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PBGRAPixel; - merged: TBGRAPixel; -begin - if AAlpha <= $80 then - begin - inc(PBGRAPixel(AContextData^.Dest), ACount); - exit; - end; - pDest := PBGRAPixel(AContextData^.Dest); - with PBGRAPenBrushFixedData(AFixedData)^ do - begin - while ACount > 0 do - begin - merged.red := pDest^.red and PBGRAPenBrushFixedData(AFixedData)^.BGRA.red; - merged.green := pDest^.green and PBGRAPenBrushFixedData(AFixedData)^.BGRA.green; - merged.blue := pDest^.blue and PBGRAPenBrushFixedData(AFixedData)^.BGRA.blue; - if NotResult then - begin - merged.red := not merged.red; - merged.green := not merged.green; - merged.blue := not merged.blue; - end; - if AAlpha >= $ff7f then - pDest^ := merged else - pDest^ := GammaCompression(MergeBGRA(GammaExpansion(pDest^), not AAlpha, - GammaExpansion(merged), AAlpha)); - inc(pDest); - dec(ACount); - end; - end; - PBGRAPixel(AContextData^.Dest) := pDest; -end; - -procedure TBGRAPen.GetUniversalBrush(out ABrush: TUniversalBrush); -var c: TBGRAPixel; -begin - if Opacity = 0 then - begin - TBGRACustomBitmap.IdleBrush(ABrush); - exit; - end; - c := ActualColor; - case Mode of - pmMerge, pmNotMerge, pmMergeNotPen, pmMaskPenNot: //or-based - begin - ABrush.Colorspace:= TBGRAPixelColorspace; - ABrush.InternalInitContext:= nil; - PBGRAPenBrushFixedData(@ABrush.FixedData)^.BGRA := c; - if Mode in [pmNotMerge, pmMaskPenNot] then - begin - ABrush.DoesNothing := false; - PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= true; - ABrush.InternalPutNextPixels:= @BGRAPenMergePixels; - end else - begin - ABrush.DoesNothing:= (c.red = 0) and (c.green = 0) and (c.blue = 0); - PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= false; - if ABrush.DoesNothing then - ABrush.InternalPutNextPixels:= @BGRAPenSkipPixels - else - ABrush.InternalPutNextPixels:= @BGRAPenMergePixels; - end; - end; - pmMask, pmNotMask, pmMaskNotPen, pmMergePenNot: //and-based - begin - ABrush.Colorspace:= TBGRAPixelColorspace; - ABrush.InternalInitContext:= nil; - PBGRAPenBrushFixedData(@ABrush.FixedData)^.BGRA := c; - if Mode in [pmNotMask, pmMergePenNot] then - begin - ABrush.DoesNothing := false; - PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= true; - ABrush.InternalPutNextPixels:= @BGRAPenMaskPixels; - end else - begin - ABrush.DoesNothing:= (c.red = 255) and (c.green = 255) and (c.blue = 255); - PBGRAPenBrushFixedData(@ABrush.FixedData)^.NotResult:= false; - if ABrush.DoesNothing then - ABrush.InternalPutNextPixels:= @BGRAPenSkipPixels - else - ABrush.InternalPutNextPixels:= @BGRAPenMaskPixels; - end; - end; - else //draw-based and xor-based - BGRASolidBrushIndirect(ABrush, @c, ActualDrawMode); - end; -end; - -{ TBGRAColoredObject } - -function TBGRAColoredObject.GetColor: TColor; -begin - result := BGRAToColor(BGRAColor); -end; - -function TBGRAColoredObject.GetOpacity: Byte; -begin - result := BGRAColor.alpha; -end; - -procedure TBGRAColoredObject.SetColor(const AValue: TColor); -begin - BGRAColor := ColorToBGRA(AValue,BGRAColor.alpha); -end; - -procedure TBGRAColoredObject.SetOpacity(const AValue: Byte); -begin - BGRAColor.alpha := AValue; -end; - -procedure TBGRAColoredObject.Assign(Source: TObject); -var so: TBGRAColoredObject; -begin - if Source is TBGRAColoredObject then - begin - so := Source as TBGRAColoredObject; - BGRAColor := so.BGRAColor; - end; -end; - -{ TBGRACanvas } - -procedure TBGRACanvas.SetBrush(const AValue: TBGRABrush); -begin - if FBrush=AValue then exit; - FBrush.Assign(AValue); -end; - -procedure TBGRACanvas.SetPen(const AValue: TBGRAPen); -begin - if FPen=AValue then exit; - FPen.Assign(AValue); -end; - -function TBGRACanvas.GetPixelColor(X, Y: Integer): TColor; -begin - result := BGRAToColor(FBitmap.GetPixel(x,y)); -end; - -procedure TBGRACanvas.SetPixelColor(X, Y: Integer; const AValue: TColor); -begin - FBitmap.SetPixel(x,y,ColorToBGRA(AValue)); -end; - -function TBGRACanvas.GetClipping: Boolean; -begin - result := FClippingOn; -end; - -function TBGRACanvas.GetClipRect: TRect; -begin - if not Clipping then - result := FInactiveClipRect else - result := FBitmap.ClipRect; -end; - -function TBGRACanvas.GetExpandedPixel(X, Y: Integer): TExpandedPixel; -begin - result := GammaExpansion(FBitmap.GetPixel(X,Y)); -end; - -function TBGRACanvas.GetFPPixelColor(X, Y: Integer): TFPColor; -begin - result := BGRAToFPColor(FBitmap.GetPixel(x,y)); -end; - -function TBGRACanvas.GetHeight: integer; -begin - result := FBitmap.Height; -end; - -function TBGRACanvas.GetWidth: integer; -begin - result := FBitmap.Width; -end; - -procedure TBGRACanvas.SetClipping(const AValue: Boolean); -begin - FClippingOn := AValue; - if not AValue then FBitmap.NoClip else - FBitmap.ClipRect := FInactiveClipRect; -end; - -procedure TBGRACanvas.SetClipRect(const AValue: TRect); -begin - FInactiveClipRect := AValue; - if FClippingOn then - begin - FBitmap.ClipRect := AValue; - FInactiveClipRect := FBitmap.ClipRect; - end; -end; - -procedure TBGRACanvas.SetExpandedPixel(X, Y: Integer; - const AValue: TExpandedPixel); -begin - FBitmap.SetPixel(x,y,GammaCompression(AValue)); -end; - -procedure TBGRACanvas.SetFont(const AValue: TBGRAFont); -begin - if FFont=AValue then exit; - FFont.Assign(AValue); -end; - -procedure TBGRACanvas.SetFPPixelColor(X, Y: Integer; const AValue: TFPColor); -begin - FBitmap.SetPixel(x,y,FPColorToBGRA(AValue)); -end; - -function TBGRACanvas.ComputeEllipseC(x1, y1, x2, y2: integer; out cx, cy, rx, - ry: single): boolean; -begin - cx := (x1+x2-1)/2; - cy := (y1+y2-1)/2; - rx := abs((x2-x1)/2); - ry := abs((y2-y1)/2); - result := (rx<>0) and (ry<>0); -end; - -function TBGRACanvas.CheckRectangle(var x1, y1, x2, y2: integer; out tx, ty: integer - ): boolean; -var - temp: integer; -begin - if x1 > x2 then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - if y1 > y2 then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; - tx := x2-x1; - ty := y2-y1; - result := (tx<>0) and (ty <>0); -end; - -procedure TBGRACanvas.ApplyPenStyle; -var - TempPenStyle: TBGRAPenStyle; - i: Integer; -begin - FBitmap.JoinStyle := FPen.JoinStyle; - FBitmap.LineCap := FPen.EndCap; - if FPen.Width = 1 then - begin - SetLength(TempPenStyle, length(FPen.CustomStyle)); - for i := 0 to high(TempPenStyle) do - TempPenStyle[i] := FPen.CustomStyle[i]*4; - FBitmap.CustomPenStyle := TempPenStyle; - end else - FBitmap.CustomPenStyle := FPen.CustomStyle; -end; - -procedure TBGRACanvas.ApplyFont; -begin - FBitmap.FontName := Font.Name; - FBitmap.FontHeight := -Font.Height; - FBitmap.FontStyle := Font.Style; - FBitmap.FontQuality := Font.Quality; - FBitmap.FontOrientation := Font.Orientation; -end; - -function TBGRACanvas.NoPen: boolean; -begin - result := Pen.Invisible; -end; - -function TBGRACanvas.NoBrush: boolean; -begin - result := Brush.Invisible; -end; - -constructor TBGRACanvas.Create(ABitmap: TBGRACustomBitmap); -begin - FBitmap := ABitmap; - AntialiasingMode := amOn; - FPen := TBGRAPen.Create; - FPenPos := Point(0,0); - FFont := TBGRAFont.Create; - FBrush := TBGRABrush.Create; - FClippingOn := False; - FInactiveClipRect := FBitmap.ClipRect; - FillMode := fmWinding; - DrawFontBackground := True; -end; - -destructor TBGRACanvas.Destroy; -begin - FPen.Free; - FBrush.Free; - FFont.Free; -end; - -procedure TBGRACanvas.MoveTo(x, y: integer); -begin - MoveTo(Point(x,y)); -end; - -procedure TBGRACanvas.MoveTo(p: TPoint); -begin - FPenPos := p; -end; - -procedure TBGRACanvas.LineTo(x, y: integer); -var pts: array of TPointF; - b: TUniversalBrush; -begin - Pen.GetUniversalBrush(b); - if not b.DoesNothing then - begin - //1 pixel-wide solid pen is rendered with pixel line - if (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then - begin - if AntialiasingMode = amOff then - FBitmap.DrawLine(FPenPos.x,FPenPos.y,x,y, b, False) - else - FBitmap.DrawLineAntialias(FPenPos.x,FPenPos.y,x,y, b, False); - end else - begin - ApplyPenStyle; - if AntialiasingMode = amOff then - begin - pts := FBitmap.ComputeWidePolyline([PointF(FPenPos.x,FPenPos.y),PointF(x,y)],Pen.ActualWidth); - FBitmap.FillPoly(pts, b); - end else - FBitmap.DrawLineAntialias(FPenPos.x,FPenPos.y,x,y, b, Pen.ActualWidth); - end; - end; - MoveTo(x,y); -end; - -procedure TBGRACanvas.LineTo(p: TPoint); -begin - LineTo(p.x,p.y); -end; - -procedure TBGRACanvas.Line(x1, y1, x2, y2: integer); -begin - MoveTo(x1,y1); - LineTo(x2,y2); -end; - -procedure TBGRACanvas.Line(p1, p2: TPoint); -begin - MoveTo(p1); - LineTo(p2); -end; - -procedure TBGRACanvas.Arc(x1, y1, x2, y2, sx, sy, ex, ey: integer); -var - angle1,angle2: word; - cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; - angle1 := round(arctan2(-(sy-cy)/ry,(sx-cx)/rx)*65536/(2*Pi)); - angle2 := round(arctan2(-(ey-cy)/ry,(ex-cx)/rx)*65536/(2*Pi)); - Arc65536(x1,y1,x2,y2,angle1, angle2, []); -end; - -procedure TBGRACanvas.Arc(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer); -begin - if LengthDeg16 > 360*16 then LengthDeg16 := 360*16; - Arc65536(x1,y1,x2,y2,StartDeg16*512 div 45, (StartDeg16+LengthDeg16)*512 div 45, []); -end; - -procedure TBGRACanvas.Arc65536(x1, y1, x2, y2: integer; start65536, end65536: word; Options: TArcOptions); -var cx,cy,rx,ry,w: single; - arcPts,penPts: array of TPointF; - multi: TBGRAMultishapeFiller; - tex: IBGRAScanner; - hasFill, hasPen: Boolean; - b: TUniversalBrush; -begin - if NoPen and NoBrush then exit; - if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; - - DecF(rx, 0.50); - DecF(ry, 0.50); - w := Pen.ActualWidth; - - if AntialiasingMode = amOff then - begin - if not NoPen and not Odd(Pen.ActualWidth) then - begin - DecF(rx, 0.01); - DecF(ry, 0.01); - end; - end; - - if NoPen then - begin - DecF(cx, 0.5); - DecF(cy, 0.5); - DecF(rx, 0.2); - DecF(ry, 0.2); - if (rx<0) or (ry<0) then exit; - end; - - arcPts := ComputeArc65536(cx,cy,rx,ry,start65536,end65536); - if (aoPie in Options) and (start65536 <> end65536) then - begin - setlength(arcPts,length(arcPts)+1); - arcPts[high(arcPts)] := PointF(cx,cy); - end; - - hasFill := (aoFillPath in Options) and not NoBrush; - hasPen := not NoPen; - if hasPen then - begin - ApplyPenStyle; - if (aoClosePath in Options) or (aoPie in Options) then - penPts := FBitmap.ComputeWidePolygon(arcPts,w) - else penPts := FBitmap.ComputeWidePolyline(arcPts,w); - end; - - if hasPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then - begin - if hasFill then - begin - Brush.GetUniversalBrush(FBitmap, b); - if AntialiasingMode <> amOff then - FBitmap.FillPolyAntialias(arcPts, b) - else FBitmap.FillPoly(arcPts, b); - end; - if hasPen then - begin - Pen.GetUniversalBrush(b); - if AntialiasingMode <> amOff then - FBitmap.FillPolyAntialias(penPts, b) - else FBitmap.FillPoly(penPts, b); - end; - end else - begin - multi := TBGRAMultishapeFiller.Create; - multi.Antialiasing := AntialiasingMode <> amOff; - multi.FillMode := FillMode; - multi.PolygonOrder := poLastOnTop; - multi.AliasingIncludeBottomRight := True; - if hasFill then - begin - tex := Brush.BuildTexture(FBitmap); - if tex <> nil then - multi.AddPolygon(arcPts, tex) else - multi.AddPolygon(arcPts, Brush.ActualColor); - end; - if hasPen then - multi.AddPolygon(penPts, Pen.ActualColor); - multi.Draw(FBitmap, Brush.ActualDrawMode); - multi.Free; - end; -end; - -procedure TBGRACanvas.Chord(x1, y1, x2, y2, sx, sy, ex, ey: integer); -var - angle1,angle2: word; - cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; - angle1 := round(arctan2(-(sy-cy)/ry,(sx-cx)/rx)*65536/(2*Pi)) and 65535; - angle2 := round(arctan2(-(ey-cy)/ry,(ex-cx)/rx)*65536/(2*Pi)) and 65535; - Arc65536(x1,y1,x2,y2,angle1, angle2, [aoClosePath,aoFillPath]); -end; - -procedure TBGRACanvas.Chord(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer); -begin - if LengthDeg16 > 360*16 then LengthDeg16 := 360*16; - Arc65536(x1,y1,x2,y2,StartDeg16*512 div 45, (StartDeg16+LengthDeg16)*512 div 45,[aoClosePath,aoFillPath]); -end; - -procedure TBGRACanvas.Pie(x1, y1, x2, y2, sx, sy, ex, ey: integer); -var - angle1,angle2: word; - cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; - angle1 := round(arctan2(-(sy-cy)/ry,(sx-cx)/rx)*65536/(2*Pi)) and 65535; - angle2 := round(arctan2(-(ey-cy)/ry,(ex-cx)/rx)*65536/(2*Pi)) and 65535; - Arc65536(x1,y1,x2,y2,angle1, angle2, [aoPie,aoFillPath]); -end; - -procedure TBGRACanvas.Pie(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer); -begin - if LengthDeg16 > 360*16 then LengthDeg16 := 360*16; - Arc65536(x1,y1,x2,y2,StartDeg16*512 div 45, (StartDeg16+LengthDeg16)*512 div 45,[aoPie,aoFillPath]); -end; - -procedure TBGRACanvas.RadialPie(x1, y1, x2, y2, StartDeg16, LengthDeg16: integer - ); -begin - Pie(x1,y1,x2,y2,StartDeg16,LengthDeg16); -end; - -procedure TBGRACanvas.Ellipse(x1, y1, x2, y2: integer); -var cx,cy,rx,ry,w: single; - tex: IBGRAScanner; - multi: TBGRAMultishapeFiller; - pb, bb: TUniversalBrush; -begin - if NoPen and NoBrush then exit; - if (AntialiasingMode = amOff) and not NoPen and (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then - begin - Pen.GetUniversalBrush(pb); - Brush.GetUniversalBrush(FBitmap, bb); - BGRARoundRectAliased(FBitmap, x1,y1,x2,y2, abs(x2-x1),abs(y2-y1), pb,bb, 65535); - exit; - end; - if not ComputeEllipseC(x1,y1,x2,y2,cx,cy,rx,ry) then exit; - w := Pen.ActualWidth; - DecF(rx, 0.50); - DecF(ry, 0.50); - - if AntialiasingMode = amOff then - begin - if not NoPen and not Odd(Pen.ActualWidth) then - begin - DecF(rx, 0.01); - DecF(ry, 0.01); - end; - end; - - if NoPen then - begin - DecF(cx, 0.5); - DecF(cy, 0.5); - DecF(rx, 0.2); - DecF(ry, 0.2); - if (rx<0) or (ry<0) then exit; - end; - - if not NoPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then - begin - if not NoBrush then - begin - Brush.GetUniversalBrush(FBitmap, bb); - if AntialiasingMode <> amOff then - FBitmap.FillEllipseAntialias(cx,cy,rx,ry, bb) - else FBitmap.FillEllipseInRect( - rect(round(cx-rx+0.5), round(cy-ry+0.5), round(cx+rx+0.5), round(cy+ry+0.5)), bb); - end; - if not NoPen then - begin - Pen.GetUniversalBrush(pb); - ApplyPenStyle; - if AntialiasingMode <> amOff then - FBitmap.EllipseAntialias(cx,cy,rx,ry, pb, w) - else FBitmap.Ellipse(cx,cy,rx,ry, pb, w); - end; - end else - begin - multi := TBGRAMultishapeFiller.Create; - multi.Antialiasing := AntialiasingMode <> amOff; - multi.PolygonOrder := poLastOnTop; - multi.AliasingIncludeBottomRight := True; - if not NoBrush then - begin - tex := Brush.BuildTexture(FBitmap); - if tex <> nil then - multi.AddEllipse(cx,cy,rx,ry,tex) - else - multi.AddEllipse(cx,cy,rx,ry,Brush.ActualColor); - end; - if not NoPen then - begin - if (Pen.Style = psSolid) and multi.Antialiasing then - multi.AddEllipseBorder(cx,cy,rx,ry,w,Pen.ActualColor) - else - begin - ApplyPenStyle; - multi.AddPolygon(FBitmap.ComputeWidePolygon(ComputeEllipse(cx,cy,rx,ry),w),Pen.ActualColor); - end; - end; - multi.Draw(FBitmap); - multi.Free; - end; -end; - -procedure TBGRACanvas.Ellipse(const bounds: TRect); -begin - Ellipse(bounds.left,bounds.top,bounds.right,bounds.Bottom); -end; - -procedure TBGRACanvas.Rectangle(x1, y1, x2, y2: integer; Filled: Boolean = True); -var tx,ty: integer; - tex: IBGRAScanner; - multi: TBGRAMultishapeFiller; - b: TUniversalBrush; -begin - if NoBrush then Filled := false; - if NoPen and not Filled then exit; - if not CheckRectangle(x1,y1,x2,y2,tx,ty) then exit; - - if NoPen then - FillRect(x1,y1,x2-1,y2-1) //one pixel - else - begin - dec(x2); - dec(y2); - - if not NoPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then - begin - if AntialiasingMode <> amOff then - begin - if Filled then FillRect(x1,y1,x2,y2); - ApplyPenStyle; - Pen.GetUniversalBrush(b); - FBitmap.RectangleAntialias(x1,y1,x2,y2, b, Pen.ActualWidth); - end else - PolygonF([PointF(x1,y1), PointF(x2,y1), PointF(x2,y2), PointF(x1,y2)]); - end else - begin - multi := TBGRAMultishapeFiller.Create; - multi.Antialiasing := AntialiasingMode <> amOff; - multi.PolygonOrder := poLastOnTop; - if Filled then - begin - tex := Brush.BuildTexture(FBitmap); - if tex <> nil then - multi.AddRectangle(x1,y1,x2,y2,tex) - else multi.AddRectangle(x1,y1,x2,y2,Brush.ActualColor); - end; - if not NoPen then - begin - ApplyPenStyle; - if (Pen.Style = psSolid) and (Pen.JoinStyle = pjsMiter) and (FBitmap.JoinMiterLimit > 1.4142) then - multi.AddRectangleBorder(x1,y1,x2,y2, Pen.ActualWidth, Pen.ActualColor) - else - multi.AddPolygon(FBitmap.ComputeWidePolygon( - [PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)], Pen.ActualWidth), - Pen.ActualColor); - end; - multi.Draw(FBitmap); - multi.Free; - end; - end; -end; - -procedure TBGRACanvas.Rectangle(const bounds: TRect; Filled: Boolean = True); -begin - Rectangle(bounds.left,bounds.top,bounds.right,bounds.Bottom, Filled); -end; - -procedure TBGRACanvas.Frame(x1, y1, x2, y2: integer); -begin - Rectangle(x1,y1,x2,y2,False); -end; - -procedure TBGRACanvas.Frame(const bounds: TRect); -begin - Rectangle(bounds,False); -end; - -procedure TBGRACanvas.RoundRect(x1, y1, x2, y2: integer; dx,dy: integer); -var tx,ty: integer; - tex: IBGRAScanner; - multi: TBGRAMultishapeFiller; - x1f,y1f,x2f,y2f: single; - pb, fb: TUniversalBrush; -begin - if not CheckRectangle(x1,y1,x2,y2,tx,ty) then exit; - if not NoPen and (AntialiasingMode = amOff) and (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then - begin - ApplyPenStyle; - Pen.GetUniversalBrush(pb); - Brush.GetUniversalBrush(FBitmap, fb); - FBitmap.RoundRect(x1,y1,x2,y2, dx,dy, pb, fb); - end else - begin - dec(x2); - dec(y2); - if not NoPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then - PolygonF(FBitmap.ComputeRoundRect(x1,y1,x2,y2, dx/2,dy/2, [])) else - begin - multi := TBGRAMultishapeFiller.Create; - multi.Antialiasing := AntialiasingMode <> amOff; - multi.PolygonOrder := poLastOnTop; - if not NoBrush then - begin - if NoPen then - begin - x1f := x1-0.5; - y1f := y1-0.5; - x2f := x2+0.5; - y2f := y2+0.5; - end else - begin - x1f := x1; - y1f := y1; - x2f := x2; - y2f := y2; - end; - tex := Brush.BuildTexture(FBitmap); - if tex <> nil then - multi.AddRoundRectangle(x1f,y1f,x2f,y2f,dx/2,dy/2,tex) - else - multi.AddRoundRectangle(x1f,y1f,x2f,y2f,dx/2,dy/2,Brush.ActualColor); - end; - if not NoPen then - begin - ApplyPenStyle; - if Pen.Style = psSolid then - multi.AddRoundRectangleBorder(x1,y1,x2,y2,dx/2,dy/2, Pen.ActualWidth ,Pen.ActualColor) - else - multi.AddPolygon(FBitmap.ComputeWidePolygon(ComputeRoundRect(x1,y1,x2,y2,dx/2,dy/2), Pen.ActualWidth), - Pen.ActualColor); - end; - multi.Draw(FBitmap); - multi.Free; - end; - end; -end; - -procedure TBGRACanvas.RoundRect(const bounds: TRect; dx,dy: integer); -begin - RoundRect(bounds.left,bounds.top,bounds.right,bounds.Bottom,dx,dy); -end; - -procedure TBGRACanvas.EllipseC(x, y, rx, ry: integer); -begin - Ellipse (Rect(x-rx,y-ry,x+rx,y+ry)); -end; - -procedure TBGRACanvas.FillRect(x1, y1, x2, y2: integer); -var - b: TUniversalBrush; -begin - if NoBrush then exit; - Brush.GetUniversalBrush(FBitmap, b); - FBitmap.FillRect(x1,y1,x2,y2, b); -end; - -procedure TBGRACanvas.FillRect(const bounds: TRect); -begin - FillRect(bounds.left,bounds.top,bounds.right,bounds.Bottom); -end; - -procedure TBGRACanvas.FrameRect(x1, y1, x2, y2: integer; width: integer = 1); -var - Temp: integer; - b: TUniversalBrush; - ofs: single; -begin - if (x1= x2) or (y1 =y2) or NoBrush then exit; - if x1 > x2 then - begin - Temp := x1; - x1 := x2; - x2 := Temp; - end; - if y1 > y2 then - begin - Temp := y1; - y1 := y2; - y2 := Temp; - end; - dec(x2); - dec(y2); - - Brush.GetUniversalBrush(FBitmap, b); - FBitmap.PenStyle := psSolid; - FBitmap.JoinStyle := pjsMiter; - if not odd(width) and (AntialiasingMode = amOff) then - ofs := 0.5 else ofs := 0; - FBitmap.RectangleAntialias(x1+ofs, y1+ofs, x2+ofs, y2+ofs, b, width); -end; - -procedure TBGRACanvas.FrameRect(const bounds: TRect; width: integer = 1); -begin - FrameRect(bounds.left,bounds.top,bounds.right,bounds.Bottom,width); -end; - -procedure TBGRACanvas.Frame3D(var bounds: TRect; width: integer; - Style: TGraphicsBevelCut); -begin - Frame3D(bounds,width,style,ColorToBGRA(clRgbBtnHighlight),ColorToBGRA(clRgbBtnShadow)); -end; - -procedure TBGRACanvas.Frame3D(var bounds: TRect; width: integer; - Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); -var temp: TBGRAPixel; - multi: TBGRAMultishapeFiller; - color1,color2: TBGRAPixel; -begin - if width <= 0 then exit; - color1 := LightColor; - color2 := ShadowColor; - if Style = bvLowered then - begin - temp := color1; - color1 := color2; - color2 := temp; - end; - if Style in [bvLowered,bvRaised] then - begin - multi := TBGRAMultishapeFiller.Create; - multi.Antialiasing := AntialiasingMode <> amOff; - multi.AddPolygon([PointF(bounds.Left-0.5,bounds.Top-0.5),PointF(bounds.Right-0.5,bounds.Top-0.5), - PointF(bounds.Right-0.5-width,bounds.Top-0.5+width),PointF(bounds.Left-0.5+width,bounds.Top-0.5+width), - PointF(bounds.Left-0.5+width,bounds.Bottom-0.5-width),PointF(bounds.Left-0.5,bounds.Bottom-0.5)],color1); - multi.AddPolygon([PointF(bounds.Right-0.5,bounds.Bottom-0.5),PointF(bounds.Left-0.5,bounds.Bottom-0.5), - PointF(bounds.Left-0.5+width,bounds.Bottom-0.5-width),PointF(bounds.Right-0.5-width,bounds.Bottom-0.5-width), - PointF(bounds.Right-0.5-width,bounds.Top-0.5+width),PointF(bounds.Right-0.5,bounds.Top-0.5)],color2); - multi.Draw(FBitmap); - multi.Free; - end; - bounds.Inflate(-width,-width); -end; - -procedure TBGRACanvas.GradientFill(ARect: TRect; AStart, AStop: TColor; - ADirection: TGradientDirection; GammaCorrection: Boolean = false); -var - Count: Integer; - - procedure NotGammaCorrected; - var - c: TBGRAPixel; - I: Integer; - BDiff,GDiff,RDiff: Integer; - BStop,BStart: Byte; - GStop,GStart: Byte; - RStop,RStart: Byte; - begin - RedGreenBlue(ColorToRGB(AStart), RStart, GStart, BStart); - RedGreenBlue(ColorToRGB(AStop), RStop, GStop, BStop); - - RDiff := RStop - RStart; - GDiff := GStop - GStart; - BDiff := BStop - BStart; - - for I := 0 to Count-1 do - begin - c := BGRA(RStart + (i * RDiff) div Count, - GStart + (i * GDiff) div Count, - BStart + (i * BDiff) div Count); - - if ADirection = gdHorizontal then - FBitmap.SetVertLine(ARect.Left+I,ARect.Top,ARect.Bottom-1,c) - else - FBitmap.SetHorizLine(ARect.Left,ARect.Top+I,ARect.Right-1,c); - end; - end; - - procedure GammaCorrected; - var - ec: TExpandedPixel; - c: TBGRAPixel; - I: Integer; - BDiff,GDiff,RDiff: Integer; - CStart,CStop: TExpandedPixel; - begin - CStart := GammaExpansion(ColorToBGRA(AStart)); - CStop := GammaExpansion(ColorToBGRA(AStop)); - - RDiff := CStop.red - CStart.red; - GDiff := CStop.green - CStart.green; - BDiff := CStop.blue - CStart.blue; - - for I := 0 to Count-1 do - begin - ec.red := CStart.red + (i * RDiff) div Count; - ec.green := CStart.green + (i * GDiff) div Count; - ec.blue := CStart.blue + (i * BDiff) div Count; - ec.alpha := $ffff; - c := GammaCompression(ec); - - if ADirection = gdHorizontal then - FBitmap.SetVertLine(ARect.Left+I,ARect.Top,ARect.Bottom-1,c) - else - FBitmap.SetHorizLine(ARect.Left,ARect.Top+I,ARect.Right-1,c); - end; - end; - -begin - with ARect do - if (Right <= Left) or (Bottom <= Top) then - Exit; - - if ADirection = gdVertical then - Count := ARect.Bottom - ARect.Top - else - Count := ARect.Right - ARect.Left; - - if GammaCorrection then - GammaCorrected else - NotGammaCorrected; -end; - -procedure TBGRACanvas.FloodFill(X, Y: Integer; FillColor: TColor; - FillStyle: TFillStyle); -begin - FloodFill(X,Y,ColorToBGRA(FillColor,255),FillStyle); -end; - -procedure TBGRACanvas.FloodFill(X, Y: Integer; FillColor: TBGRAPixel; - FillStyle: TFillStyle); -var - b: TUniversalBrush; -begin - if FillStyle = fsSurface then - begin - if FBitmap.GetPixel(X,Y) <> FillColor then exit; - Brush.GetUniversalBrush(FBitmap, b); - FBitmap.FloodFill(X,Y, b, false); - end; - //fsBorder not handled -end; - -procedure TBGRACanvas.FloodFill(X, Y: Integer); -begin - FloodFill(X,Y,FBitmap.GetPixel(X,Y),fsSurface); -end; - -procedure TBGRACanvas.Polygon(const APoints: array of TPoint); -begin - Polygon(@APoints[0],length(APoints), FillMode = fmWinding); -end; - -procedure TBGRACanvas.Polygon(const Points: array of TPoint; Winding: Boolean; - StartIndex: Integer; NumPts: Integer); -begin - if (StartIndex < 0) or (StartIndex >= length(Points)) then exit; - if NumPts < 0 then NumPts := length(Points)-StartIndex; - Polygon(@Points[StartIndex], NumPts, Winding); -end; - -procedure TBGRACanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: boolean); -var - ptsF: array of TPointF; - i: Integer; - Ofs: TPointF; -begin - if NoPen and NoBrush then exit; - if NoPen then Ofs := PointF(-0.5,-0.5) else Ofs := PointF(0,0); - setlength(ptsF, NumPts); - for i := 0 to NumPts-1 do - begin - ptsF[i] := PointF(Points^.x,Points^.y)+Ofs; - inc(Points); - end; - PolygonF(ptsF, Winding); -end; - -procedure TBGRACanvas.PolygonF(const APoints: array of TPointF); -begin - PolygonF(APoints, FillMode = fmWinding); -end; - -procedure TBGRACanvas.PolygonF(const APoints: array of TPointF; Winding: Boolean; FillOnly: Boolean = False); -var - hasPen, hasBrush: Boolean; - b: TUniversalBrush; - penPts: ArrayOfTPointF; - multi: TBGRAMultishapeFiller; - tex: IBGRAScanner; -begin - hasPen := not NoPen and not FillOnly; - hasBrush := not NoBrush; - if not HasPen and not HasBrush then exit; - if hasPen and (Pen.ActualDrawMode <> dmDrawWithTransparency) then - begin - ApplyPenStyle; - Pen.GetUniversalBrush(b); - penPts := FBitmap.ComputeWidePolygon(APoints, Pen.ActualWidth); - if AntialiasingMode = amOff then - FBitmap.FillPoly(penPts, b) - else FBitmap.FillPolyAntialias(penPts, b); - if hasBrush then - PolygonF(APoints, Winding, true); - end else - begin - multi := TBGRAMultishapeFiller.Create; - multi.Antialiasing := AntialiasingMode <> amOff; - if Winding then multi.FillMode := fmWinding else - multi.FillMode := fmAlternate; - multi.PolygonOrder := poLastOnTop; - if hasBrush then - begin - tex := Brush.BuildTexture(FBitmap); - if tex <> nil then - multi.AddPolygon(APoints, tex) - else multi.AddPolygon(APoints, Brush.ActualColor); - end; - if hasPen then - begin - ApplyPenStyle; - multi.AddPolygon(FBitmap.ComputeWidePolygon(APoints,Pen.ActualWidth), Pen.ActualColor); - end; - multi.Draw(FBitmap); - multi.Free - end; -end; - -procedure TBGRACanvas.Polyline(const APoints: array of TPoint); -begin - Polyline(@APoints[0],length(APoints)); -end; - -procedure TBGRACanvas.Polyline(const Points: array of TPoint; StartIndex: Integer; NumPts: Integer); -begin - if (StartIndex < 0) or (StartIndex >= length(Points)) then exit; - if NumPts < 0 then NumPts := length(Points)-StartIndex; - Polyline(@Points[StartIndex],NumPts); -end; - -procedure TBGRACanvas.Polyline(Points: PPoint; NumPts: Integer); -var - i: Integer; - ptsF: array of TPointF; - oldPos: TPoint; -begin - if NoPen or (NumPts <= 0) then exit; - - if (Pen.Style = psSolid) and (Pen.ActualWidth = 1) then - begin - oldPos := FPenPos; - MoveTo(Points^.x,Points^.y); - for i := 1 to NumPts-1 do - begin - inc(Points); - LineTo(Points^.x,Points^.y); - end; - FPenPos := oldPos; - exit; - end; - - setlength(ptsF, NumPts); - for i := 0 to NumPts-1 do - begin - ptsF[i] := PointF(Points^.x,Points^.y); - inc(Points); - end; - PolylineF(ptsF); -end; - -procedure TBGRACanvas.PolylineF(const APoints: array of TPointF); -var ptsF: Array of TPointF; -begin - if NoPen then exit; - ApplyPenStyle; - FBitmap.FillMode := fmWinding; - ptsF := FBitmap.ComputeWidePolyline(APoints,Pen.ActualWidth); - if AntialiasingMode = amOff then - FBitmap.FillPoly(ptsF,Pen.ActualColor,dmDrawWithTransparency) else - FBitmap.FillPolyAntialias(ptsF,Pen.ActualColor); -end; - -procedure TBGRACanvas.PolyBezier(Points: PPoint; NumPts: Integer; - Filled: boolean; Continuous: boolean); -var - beziers: array of TCubicBezierCurve; - nbBeziers,i: integer; - PrevPt: TPointF; - spline: array of TPointF; -begin - if NumPts < 4 then exit; - if Continuous then - begin - nbBeziers := 1+(NumPts-4) div 3; - setlength(beziers, nbBeziers); - PrevPt := PointF(Points^.x,Points^.y); - inc(Points); - for i := 0 to nbBeziers-1 do - begin - beziers[i].p1 := prevPt; - beziers[i].c1 := PointF(Points^.x,Points^.y); - inc(Points); - beziers[i].c2 := PointF(Points^.x,Points^.y); - inc(Points); - beziers[i].p2 := PointF(Points^.x,Points^.y); - inc(Points); - prevPt := beziers[i].p2; - end; - end else - begin - nbBeziers := NumPts div 4; - setlength(beziers, nbBeziers); - for i := 0 to nbBeziers-1 do - begin - beziers[i].p1 := PointF(Points^.x,Points^.y); - inc(Points); - beziers[i].c1 := PointF(Points^.x,Points^.y); - inc(Points); - beziers[i].c2 := PointF(Points^.x,Points^.y); - inc(Points); - beziers[i].p2 := PointF(Points^.x,Points^.y); - inc(Points); - end; - end; - spline := ComputeBezierSpline(beziers); - if Filled then - PolygonF(spline) else - PolylineF(spline); -end; - -procedure TBGRACanvas.PolyBezier(const Points: array of TPoint; - Filled: boolean; Continuous: boolean); -begin - PolyBezier(@Points[0],length(Points),Filled,Continuous); -end; - -procedure TBGRACanvas.Draw(X, Y: Integer; SrcBitmap: TBGRACustomBitmap); -begin - FBitmap.PutImage(X,Y,SrcBitmap,dmDrawWithTransparency); -end; - -procedure TBGRACanvas.Draw(X, Y: Integer; SrcBitmap: TBitmap); -begin - FBitmap.PutImage(X,Y,SrcBitmap,dmDrawWithTransparency); -end; - -procedure TBGRACanvas.CopyRect(X, Y: Integer; SrcBitmap: TBGRACustomBitmap; - SrcRect: TRect); -begin - FBitmap.PutImagePart(X,Y,SrcBitmap,SrcRect,dmDrawWithTransparency); -end; - -procedure TBGRACanvas.StretchDraw(DestRect: TRect; SrcBitmap: TBGRACustomBitmap; HorizFlip: Boolean = false; VertFlip: Boolean = false); -var Stretched: TBGRACustomBitmap; - temp: Integer; -begin - with DestRect do - begin - if (Left= Right) or (Top =Bottom) then exit; - if Left > Right then - begin - Temp := Left; - Left := Right+1; - Right := Temp+1; - HorizFlip := not HorizFlip; - end; - if Top > Bottom then - begin - Temp := Top; - Top := Bottom+1; - Bottom := Temp+1; - VertFlip := not VertFlip; - end; - end; - if (DestRect.Right-DestRect.Left <> SrcBitmap.Width) or - (DestRect.Bottom-DestRect.Top <> SrcBitmap.Height) or - HorizFlip or VertFlip then - begin - if AntialiasingMode = amOff then - Stretched := SrcBitmap.Resample(DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,rmSimpleStretch) else - Stretched := SrcBitmap.Resample(DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,rmFineResample); - if HorizFlip then Stretched.HorizontalFlip; - if VertFlip then Stretched.VerticalFlip; - FBitmap.PutImage(DestRect.Left,DestRect.Top,Stretched,dmDrawWithTransparency); - Stretched.Free; - end else - FBitmap.PutImage(DestRect.Left,DestRect.Top,SrcBitmap,dmDrawWithTransparency); -end; - -procedure TBGRACanvas.DrawFocusRect(bounds: TRect); -var - temp: Integer; - xb,yb: integer; - c: TBGRAPixel; -begin - c := Brush.ActualColor; - if (c.red = 0) and (c.Green =0) and (c.Blue =0) then exit; - c.alpha := 0; - with bounds do - begin - if (Left= Right) or (Top =Bottom) then exit; - if Left > Right then - begin - Temp := Left; - Left := Right; - Right := Temp; - end; - if Top > Bottom then - begin - Temp := Top; - Top := Bottom; - Bottom := Temp; - end; - dec(Right); - dec(Bottom); - for xb := max(FBitmap.ClipRect.Left, bounds.Left+1) to min(FBitmap.ClipRect.Right-1,bounds.Right-1) do - begin - if odd(xb) xor odd(Top) then FBitmap.XorPixel(xb,Top,c); - if odd(xb) xor odd(Bottom) then FBitmap.XorPixel(xb,Bottom,c); - end; - for yb := max(FBitmap.ClipRect.Top, bounds.Top) to min(FBitmap.ClipRect.Bottom-1,bounds.Bottom) do - begin - if odd(yb) xor odd(Left) then FBitmap.XorPixel(Left,yb,c); - if odd(yb) xor odd(Right) then FBitmap.XorPixel(Right,yb,c); - end; - end; -end; - -procedure TBGRACanvas.CopyRect(Dest: TRect; SrcBmp: TBGRACustomBitmap; - Source: TRect); -var TempBmp: TBGRACustomBitmap; - Temp: Integer; - FlipHoriz,FlipVert: Boolean; -begin - if (Dest.Right-Dest.Left = Source.Right-Source.Left) and (Dest.Bottom-Dest.Top = Source.Bottom-Source.Top) and - (Dest.Right > Dest.Left) and (Dest.Bottom > Dest.Top) then - begin - CopyRect(Dest.Left,Dest.Top, SrcBmp, Source); - exit; - end; - if (Source.Left = Source.Right) or (Source.Bottom = Source.Top) or - (Dest.Left = Dest.Right) or (Dest.Bottom = Dest.Top) then exit; - if Source.Left > Source.Right then - begin - Temp := Source.Left; - Source.Left := Source.Right+1; - Source.Right := Temp+1; - FlipHoriz := True; - end else - FlipHoriz := false; - if Source.Top > Source.Bottom then - begin - Temp := Source.Top; - Source.Top := Source.Bottom+1; - Source.Bottom := Temp+1; - FlipVert := True; - end else - FlipVert := false; - TempBmp := SrcBmp.GetPart(Source); - StretchDraw(Dest,TempBmp,FlipHoriz,FlipVert); - TempBmp.Free; -end; - -procedure TBGRACanvas.TextOut(X, Y: Integer; const Text: String); -var size: TSize; - c,s: single; -begin - ApplyFont; - if DrawFontBackground then - begin - size := TextExtent(Text); - c := cos(Font.Orientation*Pi/1800); - s := -sin(Font.Orientation*Pi/1800); - PolygonF([PointF(X,Y),PointF(X+c*size.cx,Y+s*size.cx), - PointF(X+c*size.cx-s*size.cy,Y+s*size.cx+c*size.cy), - PointF(X-s*size.cy,Y+c*size.cy)],False,True); - end; - if Font.Texture <> nil then - FBitmap.TextOut(x,y,Text,Font.Texture) else - FBitmap.TextOut(x,y,Text,Font.BGRAColor); -end; - -procedure TBGRACanvas.TextRect(const ARect: TRect; X, Y: integer; - const Text: string); -begin - ApplyFont; - if Font.Texture <> nil then - FBitmap.TextRect(ARect,x,y,Text,self.TextStyle,Font.Texture) else - FBitmap.TextRect(ARect,x,y,Text,self.TextStyle,Font.BGRAColor); -end; - -procedure TBGRACanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string; - const Style: TTextStyle); -begin - ApplyFont; - if Font.Texture <> nil then - FBitmap.TextRect(ARect,x,y,Text,Style,Font.Texture) else - FBitmap.TextRect(ARect,x,y,Text,Style,Font.BGRAColor); -end; - -function TBGRACanvas.TextExtent(const Text: string): TSize; -begin - ApplyFont; - result := FBitmap.TextSize(Text); -end; - -{$hints off} -function TBGRACanvas.TextHeight(const Text: string): Integer; -begin - ApplyFont; - result := FBitmap.TextSize(Text).cy; -end; -{$hints on} - -function TBGRACanvas.TextWidth(const Text: string): Integer; -begin - ApplyFont; - result := FBitmap.TextSize(Text).cx; -end; - -end. - diff --git a/components/bgrabitmap/bgracanvas2d.pas b/components/bgrabitmap/bgracanvas2d.pas deleted file mode 100644 index 2e0bad6..0000000 --- a/components/bgrabitmap/bgracanvas2d.pas +++ /dev/null @@ -1,2851 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRACanvas2D; - -{ To do : - - draw text with a different precision if the matrix is scaled - drawImage(in image, in double sx, in double sy, in double sw, in double sh, in double dx, in double dy, in double dw, in double dh) - -> using FillPoly with texture coordinates - linear gradient any transformation - clearPath clipping - createRadialGradient - globalCompositeOperation - image data functions -} - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATransform, - BGRAGradientScanner, BGRAPath, BGRAPen, BGRAGrayscaleMask; - -type - ArrayOfString = array of string; - - IBGRACanvasTextureProvider2D = interface - function getTexture: IBGRAScanner; - property texture: IBGRAScanner read GetTexture; - end; - - IBGRACanvasGradient2D = interface(IBGRACanvasTextureProvider2D) - procedure addColorStop(APosition: single; AColor: TBGRAPixel); - procedure addColorStop(APosition: single; AColor: TColor); - procedure addColorStop(APosition: single; AColor: string); - procedure setColors(ACustomGradient: TBGRACustomGradient); - function GetGammaCorrection: boolean; - procedure SetGammaCorrection(AValue: boolean); - function GetRepetition: TBGRAGradientRepetition; - procedure SetRepetition(AValue: TBGRAGradientRepetition); - property gammaCorrection: boolean read GetGammaCorrection write SetGammaCorrection; - property repetition: TBGRAGradientRepetition read GetRepetition write SetRepetition; - end; - - { TBGRACanvasTextureProvider2D } - - TBGRACanvasTextureProvider2D = class(TInterfacedObject,IBGRACanvasTextureProvider2D) - function getTexture: IBGRAScanner; virtual; abstract; - end; - - { TBGRACanvasState2D } - - TBGRACanvasState2D = class - private - FClipMask: TGrayscaleMask; - FClipMaskOwned: boolean; - function GetClipMaskReadWrite: TGrayscaleMask; - public - strokeColor: TBGRAPixel; - strokeTextureProvider: IBGRACanvasTextureProvider2D; - fillColor: TBGRAPixel; - fillMode: TFillMode; - fillTextureProvider: IBGRACanvasTextureProvider2D; - globalAlpha: byte; - - fontName: string; - fontStyle: TFontStyles; - fontEmHeight: single; - textAlign: TAlignment; - textBaseline: string; - textDirection: TFontBidiMode; - - lineWidth: single; - penStroker: TBGRAPenStroker; - - shadowOffsetX,shadowOffsetY,shadowBlur: single; - shadowColor: TBGRAPixel; - shadowFastest: boolean; - - matrix: TAffineMatrix; - constructor Create(AMatrix: TAffineMatrix; AClipMask: TGrayscaleMask; AClipMaskOwned: boolean); - function Duplicate: TBGRACanvasState2D; - destructor Destroy; override; - procedure transform(AMatrix: TAffineMatrix); - procedure SetClipMask(AClipMask: TGrayscaleMask; AOwned: boolean); - property clipMaskReadOnly: TGrayscaleMask read FClipMask; - property clipMaskReadWrite: TGrayscaleMask read GetClipMaskReadWrite; - end; - - TCanvas2dTextSize = record - width,height: single; - end; - - { TBGRACanvas2D } - - TBGRACanvas2D = class(IBGRAPath) - private - FSurface: TBGRACustomBitmap; - StateStack: TList; - currentState: TBGRACanvasState2D; - FCanvasOffset: TPointF; - FPixelCenteredCoordinates: boolean; - FPathPoints: array of TPointF; - FPathPointCount: integer; - FTextPaths: array of record - Text: string; - FontName: string; - FontMatrix: TAffineMatrix; - FontAlign: TAlignment; - FontAnchor: TFontVerticalAnchor; - FontStyle: TFontStyles; - TextDirection: TFontBidiMode; - end; - FFontRenderer: TBGRACustomFontRenderer; - FLastCoord, FStartCoord: TPointF; - function GetCurrentPathAsPoints: ArrayOfTPointF; - function GetTextDirection: TFontBidiMode; - function GetFontName: string; - function GetFontRenderer: TBGRACustomFontRenderer; - function GetFontEmHeight: single; - function GetFontString: string; - function GetFontStyle: TFontStyles; - function GetGlobalAlpha: single; - function GetHasShadow: boolean; - function GetHeight: Integer; - function GetLineCap: string; - function GetLineCapLCL: TPenEndCap; - function GetlineJoin: string; - function GetlineJoinLCL: TPenJoinStyle; - function GetLineWidth: single; - function GetMatrix: TAffineMatrix; - function GetMiterLimit: single; - function GetPixelCenteredCoordinates: boolean; - function GetShadowBlur: single; - function GetShadowFastest: boolean; - function GetShadowOffset: TPointF; - function GetShadowOffsetX: single; - function GetShadowOffsetY: single; - function GetStrokeMatrix: TAffineMatrix; - function GetTextAlign: string; - function GetTextAlignLCL: TAlignment; - function GetTextBaseline: string; - function GetFillMode: TFillMode; - function GetWidth: Integer; - procedure SetTextDirection(AValue: TFontBidiMode); - procedure SetFontName(AValue: string); - procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); - procedure SetFontEmHeight(AValue: single); - procedure SetFontString(AValue: string); - procedure SetFontStyle(AValue: TFontStyles); - procedure SetGlobalAlpha(const AValue: single); - procedure SetLineCap(const AValue: string); - procedure SetLineCapLCL(AValue: TPenEndCap); - procedure SetLineJoin(const AValue: string); - procedure FillPoly(const points: array of TPointF); - procedure FillStrokePoly(const points: array of TPointF; fillOver: boolean); - procedure FillTexts(AErase: boolean); - procedure SetLineJoinLCL(AValue: TPenJoinStyle); - procedure SetLineWidth(const AValue: single); - procedure SetMatrix(AValue: TAffineMatrix); - procedure SetMiterLimit(const AValue: single); - procedure SetPixelCenteredCoordinates(const AValue: boolean); - procedure SetShadowBlur(const AValue: single); - procedure SetShadowFastest(AValue: boolean); - procedure SetShadowOffset(const AValue: TPointF); - procedure SetShadowOffsetX(const AValue: single); - procedure SetShadowOffsetY(const AValue: single); - procedure SetStrokeMatrix(AValue: TAffineMatrix); - procedure SetTextAlign(AValue: string); - procedure SetTextAlignLCL(AValue: TAlignment); - procedure SetTextBaseline(AValue: string); - procedure SetFillMode(mode: TFillMode); - procedure StrokePoly(const points: array of TPointF); - procedure DrawShadow(const points, points2: array of TPointF; AFillMode: TFillMode = fmWinding); - procedure DrawShadowMask(X,Y: integer; AMask: TCustomUniversalBitmap; AMaskOwned: boolean); - procedure ClearPoly(const points: array of TPointF); - function ApplyTransform(const points: array of TPointF; matrix: TAffineMatrix): ArrayOfTPointF; overload; - function ApplyTransform(const points: array of TPointF): ArrayOfTPointF; overload; - function ApplyTransform(point: TPointF): TPointF; overload; - function GetPenPos(defaultX, defaultY: single): TPointF; - function GetPenPos(defaultPt: TPointF): TPointF; - procedure AddPoint(point: TPointF); - procedure AddPoints(const points: array of TPointF); - procedure AddPointsRev(const points: array of TPointF); - function ApplyGlobalAlpha(color: TBGRAPixel): TBGRAPixel; - function GetDrawMode: TDrawMode; - procedure copyTo({%H-}dest: IBGRAPath); //IBGRAPath - function getPoints: ArrayOfTPointF; //IBGRAPath - function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; //IBGRAPath - function getCursor: TBGRACustomPathCursor; //IBGRAPath - public - antialiasing, linearBlend, gradientGammaCorrection: boolean; - constructor Create(ASurface: TBGRACustomBitmap); - destructor Destroy; override; - - function toDataURL(mimeType: string = 'image/png'): string; - - procedure save; - procedure restore; - procedure scale(x,y: single); overload; - procedure scale(factor: single); overload; - procedure rotate(angleRadCW: single); - procedure translate(x,y: single); - procedure skewx(angleRadCW: single); - procedure skewy(angleRadCW: single); - procedure transform(m11,m21, m12,m22, m13,m23: single); overload; - procedure transform(AMatrix: TAffineMatrix); overload; - procedure setTransform(m11,m21, m12,m22, m13,m23: single); - procedure resetTransform; - - procedure strokeScale(x,y: single); - procedure strokeSkewx(angleRadCW: single); - procedure strokeSkewy(angleRadCW: single); - procedure strokeResetTransform; - - procedure strokeStyle(color: TBGRAPixel); overload; - procedure strokeStyle(color: TColor); overload; - procedure strokeStyle(color: string); overload; - procedure strokeStyle(texture: IBGRAScanner); overload; - procedure strokeStyle(provider: IBGRACanvasTextureProvider2D); overload; - procedure fillStyle(color: TBGRAPixel); overload; - procedure fillStyle(color: TColor); overload; - procedure fillStyle(color: string); overload; - procedure fillStyle(texture: IBGRAScanner); overload; - procedure fillStyle(provider: IBGRACanvasTextureProvider2D); overload; - procedure shadowColor(color: TBGRAPixel); overload; - procedure shadowColor(color: TColor); overload; - procedure shadowColor(color: string); overload; - procedure shadowNone; - function getShadowColor: TBGRAPixel; - - function createLinearGradient(x0,y0,x1,y1: single): IBGRACanvasGradient2D; overload; - function createLinearGradient(p0,p1: TPointF): IBGRACanvasGradient2D; overload; - function createLinearGradient(x0,y0,x1,y1: single; Colors: TBGRACustomGradient): IBGRACanvasGradient2D; overload; - function createLinearGradient(p0,p1: TPointF; Colors: TBGRACustomGradient): IBGRACanvasGradient2D; overload; - - function createRadialGradient(x0,y0,r0,x1,y1,r1: single; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; - function createRadialGradient(p0: TPointF; r0: single; p1: TPointF; r1: single; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; - function createRadialGradient(x0,y0,r0,x1,y1,r1: single; Colors: TBGRACustomGradient; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; - function createRadialGradient(p0: TPointF; r0: single; p1: TPointF; r1: single; Colors: TBGRACustomGradient; flipGradient: boolean=false): IBGRACanvasGradient2D; overload; - - function createPattern(image: TBGRACustomBitmap; repetition: string): IBGRACanvasTextureProvider2D; overload; - function createPattern(texture: IBGRAScanner): IBGRACanvasTextureProvider2D; overload; - - procedure fillRect(x,y,w,h: single); - procedure strokeRect(x,y,w,h: single); - procedure clearRect(x,y,w,h: single); - - procedure addPath(APath: IBGRAPath); overload; - procedure addPath(ASvgPath: string); overload; - procedure path(APath: IBGRAPath); overload; - procedure path(ASvgPath: string); overload; - procedure beginPath; - procedure closePath; - procedure toSpline(closed: boolean; style: TSplineStyle= ssOutside); - procedure moveTo(x,y: single); overload; - procedure lineTo(x,y: single); overload; - procedure moveTo(constref pt: TPointF); overload; - procedure lineTo(constref pt: TPointF); overload; - procedure polylineTo(const pts: array of TPointF); - procedure quadraticCurveTo(cpx,cpy,x,y: single); overload; - procedure quadraticCurveTo(constref cp,pt: TPointF); overload; - procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload; - procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); overload; - procedure rect(x,y,w,h: single); - procedure roundRect(x,y,w,h,radius: single); overload; - procedure roundRect(x,y,w,h,rx,ry: single); overload; - procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); - procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); - procedure spline(const pts: array of TPointF; style: TSplineStyle= ssOutside); - procedure splineTo(const pts: array of TPointF; style: TSplineStyle= ssOutside); - procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; - procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single); overload; - procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; - procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload; - procedure arc(constref arcDef: TArcDef); overload; - procedure arcTo(x1, y1, x2, y2, radius: single); overload; - procedure arcTo(p1,p2: TPointF; radius: single); overload; - procedure arcTo(rx, ry, xAngleRadCW: single; largeArc,anticlockwise: boolean; x, y: single); - procedure circle(x,y,r: single); - procedure ellipse(x,y,rx,ry: single); - procedure text(AText: string; x,y: single); - procedure fillText(AText: string; x,y: single); - procedure strokeText(AText: string; x,y: single); - function measureText(AText: string): TCanvas2dTextSize; - - procedure fill; overload; - procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; - procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; //may not render curve nicely - procedure stroke; overload; - procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; - procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; //may not render curve nicely - procedure fillOverStroke; - procedure strokeOverFill; - procedure clearPath; - procedure clip; - procedure unclip; - function isPointInPath(x,y: single): boolean; overload; - function isPointInPath(pt: TPointF): boolean; overload; - - procedure drawImage(image: TBGRACustomBitmap; dx,dy: single; AFilter: TResampleFilter = rfLinear); overload; - procedure drawImage(image: TBGRACustomBitmap; dx,dy,dw,dh: single; AFilter: TResampleFilter = rfLinear); overload; - - function getLineStyle: TBGRAPenStyle; - procedure lineStyle(const AValue: array of single); overload; - procedure lineStyle(AStyle: TPenStyle); overload; - - class function StrToFontNameList(AText: string): ArrayOfString; - class function FontNameListToStr(AList: ArrayOfString): string; - class function CSSFontNameToLCL(AName: string): string; - - property surface: TBGRACustomBitmap read FSurface; - property width: Integer read GetWidth; - property height: Integer read GetHeight; - property pixelCenteredCoordinates: boolean read GetPixelCenteredCoordinates write SetPixelCenteredCoordinates; - property globalAlpha: single read GetGlobalAlpha write SetGlobalAlpha; - property matrix: TAffineMatrix read GetMatrix write SetMatrix; - property strokeMatrix: TAffineMatrix read GetStrokeMatrix write SetStrokeMatrix; - - property lineWidth: single read GetLineWidth write SetLineWidth; - property lineCap: string read GetLineCap write SetLineCap; - property lineCapLCL: TPenEndCap read GetLineCapLCL write SetLineCapLCL; - property lineJoin: string read GetlineJoin write SetLineJoin; - property lineJoinLCL: TPenJoinStyle read GetlineJoinLCL write SetLineJoinLCL; - property miterLimit: single read GetMiterLimit write SetMiterLimit; - - property shadowOffsetX: single read GetShadowOffsetX write SetShadowOffsetX; - property shadowOffsetY: single read GetShadowOffsetY write SetShadowOffsetY; - property shadowOffset: TPointF read GetShadowOffset write SetShadowOffset; - property shadowBlur: single read GetShadowBlur write SetShadowBlur; - property shadowFastest: boolean read GetShadowFastest write SetShadowFastest; - property hasShadow: boolean read GetHasShadow; - - property fontName: string read GetFontName write SetFontName; - property fontEmHeight: single read GetFontEmHeight write SetFontEmHeight; - property fontStyle: TFontStyles read GetFontStyle write SetFontStyle; - property font: string read GetFontString write SetFontString; - property textAlignLCL: TAlignment read GetTextAlignLCL write SetTextAlignLCL; - property textAlign: string read GetTextAlign write SetTextAlign; - property textBaseline: string read GetTextBaseline write SetTextBaseline; - property direction: TFontBidiMode read GetTextDirection write SetTextDirection; - - property fillMode: TFillMode read GetFillMode write SetFillMode; - - property currentPath: ArrayOfTPointF read GetCurrentPathAsPoints; - property fontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer; - - protected - function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - end; - -implementation - -uses Math, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64; - -type - TColorStop = record - position: single; - color: TBGRAPixel; - end; - - TGradientArrayOfColors = array of TBGRAPixel; - TGradientArrayOfPositions = array of single; - - { TBGRACanvasGradient2D } - - TBGRACanvasGradient2D = class(TBGRACanvasTextureProvider2D, IBGRACanvasGradient2D) - private - colorStops: array of TColorStop; - nbColorStops: integer; - FCustomGradient: TBGRACustomGradient; - FGammaCorrection: boolean; - FRepetition: TBGRAGradientRepetition; - protected - scanner: TBGRAGradientScanner; - procedure CreateScanner; virtual; abstract; - function getColorArray: TGradientArrayOfColors; - function getPositionArray: TGradientArrayOfPositions; - procedure GetBGRAGradient(out ABGRAGradient: TBGRACustomGradient; out AOwned: boolean); - function GetGammaCorrection: boolean; - procedure SetGammaCorrection(AValue: boolean); - function GetRepetition: TBGRAGradientRepetition; - procedure SetRepetition(AValue: TBGRAGradientRepetition); - public - constructor Create; - function getTexture: IBGRAScanner; override; - destructor Destroy; override; - procedure addColorStop(APosition: single; AColor: TBGRAPixel); - procedure addColorStop(APosition: single; AColor: TColor); - procedure addColorStop(APosition: single; AColor: string); - procedure setColors(ACustomGradient: TBGRACustomGradient); - property texture: IBGRAScanner read GetTexture; - property colorStopCount: integer read nbColorStops; - property gammaCorrection: boolean read GetGammaCorrection write SetGammaCorrection; - property repetition: TBGRAGradientRepetition read GetRepetition write SetRepetition; - end; - - { TBGRACanvasLinearGradient2D } - - TBGRACanvasLinearGradient2D = class(TBGRACanvasGradient2D) - protected - o1,o2: TPointF; - FTransform: TAffineMatrix; - procedure CreateScanner; override; - public - constructor Create(x0,y0,x1,y1: single; transform: TAffineMatrix); - constructor Create(p0,p1: TPointF; transform: TAffineMatrix); - end; - - { TBGRACanvasRadialGradient2D } - - TBGRACanvasRadialGradient2D = class(TBGRACanvasGradient2D) - protected - c0,c1: TPointF; - cr0,cr1: single; - FFlipGradient: boolean; - FTransform: TAffineMatrix; - procedure CreateScanner; override; - public - constructor Create(x0,y0,r0,x1,y1,r1: single; transform: TAffineMatrix; flipGradient: boolean=false); - constructor Create(p0: TPointF; r0: single; p1: TPointF; r1: single; transform: TAffineMatrix; flipGradient: boolean=false); - end; - - { TBGRACanvasPattern2D } - - TBGRACanvasPattern2D = class(TBGRACanvasTextureProvider2D) - protected - scanner: TBGRACustomScanner; - foreignInterface: IBGRAScanner; - ownScanner: boolean; - public - function getTexture: IBGRAScanner; override; - constructor Create(source: TBGRACustomBitmap; repeatX,repeatY: boolean; Origin, HAxis, VAxis: TPointF); - constructor Create(source: IBGRAScanner; transformation: TAffineMatrix); - destructor Destroy; override; - end; - -{ TBGRACanvasPattern2D } - -function TBGRACanvasPattern2D.GetTexture: IBGRAScanner; -begin - if ownScanner then - result := scanner - else - result := foreignInterface; -end; - -constructor TBGRACanvasPattern2D.Create(source: TBGRACustomBitmap; repeatX, - repeatY: boolean; Origin, HAxis, VAxis: TPointF); -var - affine: TBGRAAffineBitmapTransform; -begin - if (abs(Origin.X-round(Origin.X)) < 1e-6) and - (abs(Origin.Y-round(Origin.Y)) < 1e-6) and - (HAxis = Origin+PointF(1,0)) and - (VAxis = Origin+PointF(0,1)) then - begin - if (round(Origin.X)=0) and (round(Origin.Y)=0) and repeatX and repeatY then - begin - foreignInterface := source; - ownScanner:= false; - end else - begin - scanner := TBGRABitmapScanner.Create(source,repeatX,repeatY,Point(round(Origin.X),round(Origin.Y))); - ownScanner := true; - end; - end - else - begin - affine := TBGRAAffineBitmapTransform.Create(source,repeatX,repeatY); - affine.Fit(Origin,HAxis,VAxis); - scanner := affine; - ownScanner:= true; - end; -end; - -constructor TBGRACanvasPattern2D.Create(source: IBGRAScanner; - transformation: TAffineMatrix); -var - affine : TBGRAAffineScannerTransform; -begin - if (abs(transformation[1,1]-1) < 1e-6) and - (abs(transformation[2,2]-1) < 1e-6) and - (abs(transformation[1,2]) < 1e-6) and - (abs(transformation[2,1]) < 1e-6) and - (abs(transformation[1,3]-round(transformation[1,3])) < 1e-6) and - (abs(transformation[2,3]-round(transformation[2,3])) < 1e-6) then - begin - if (abs(transformation[1,3]) < 1e-6) and - (abs(transformation[2,3]) < 1e-6) then - begin - foreignInterface := source; - ownScanner := false; - end else - begin - scanner := TBGRAScannerOffset.Create(source,Point(round(transformation[1,3]),round(transformation[2,3]))); - ownScanner := true; - end; - end else - begin - affine := TBGRAAffineScannerTransform.Create(source); - affine.Matrix := transformation; - affine.Invert; - scanner := affine; - ownScanner:= true; - end; -end; - -destructor TBGRACanvasPattern2D.Destroy; -begin - fillchar(foreignInterface,sizeof(foreignInterface),0); - if ownScanner then FreeAndNil(scanner); - inherited Destroy; -end; - -{ TBGRACanvasLinearGradient2D } - -procedure TBGRACanvasLinearGradient2D.CreateScanner; -var GradientOwner: boolean; - GradientColors: TBGRACustomGradient; -begin - GetBGRAGradient(GradientColors,GradientOwner); - scanner := TBGRAGradientScanner.Create(GradientColors,gtLinear,o1,o2,False,GradientOwner); - scanner.Transform := FTransform; -end; - -constructor TBGRACanvasLinearGradient2D.Create(x0, y0, x1, y1: single; transform: TAffineMatrix); -begin - o1 := PointF(x0,y0); - o2 := PointF(x1,y1); - FTransform := transform; -end; - -constructor TBGRACanvasLinearGradient2D.Create(p0, p1: TPointF; transform: TAffineMatrix); -begin - o1 := p0; - o2 := p1; - FTransform := transform; -end; - -{ TBGRACanvasRadialGradient2D } - -procedure TBGRACanvasRadialGradient2D.CreateScanner; -var GradientOwner: boolean; - GradientColors: TBGRACustomGradient; -begin - GetBGRAGradient(GradientColors,GradientOwner); - scanner := TBGRAGradientScanner.Create(GradientColors,c0,cr0,c1,cr1,GradientOwner); - scanner.FlipGradient := not FFlipGradient; - scanner.Transform := FTransform; -end; - -constructor TBGRACanvasRadialGradient2D.Create(x0, y0, r0, x1, y1, r1: single; - transform: TAffineMatrix; flipGradient: boolean); -begin - self.c0 := PointF(x0,y0); - self.cr0 := r0; - self.c1 := PointF(x1,y1); - self.cr1 := r1; - FTransform := transform; - FFlipGradient := flipGradient; -end; - -constructor TBGRACanvasRadialGradient2D.Create(p0: TPointF; r0: single; - p1: TPointF; r1: single; transform: TAffineMatrix; flipGradient: boolean); -begin - self.c0 := p0; - self.cr0 := r0; - self.c1 := p1; - self.cr1 := r1; - FTransform := transform; - FFlipGradient := flipGradient; -end; - -{ TBGRACanvasGradient2D } - -function TBGRACanvasGradient2D.getTexture: IBGRAScanner; -begin - if scanner = nil then CreateScanner; - result := scanner; -end; - -function TBGRACanvasGradient2D.GetGammaCorrection: boolean; -begin - result := FGammaCorrection; -end; - -procedure TBGRACanvasGradient2D.SetGammaCorrection(AValue: boolean); -begin - FGammaCorrection:= AValue; - FreeAndNil(scanner); -end; - -constructor TBGRACanvasGradient2D.Create; -begin - inherited Create; - scanner := nil; - FGammaCorrection:= false; -end; - -function TBGRACanvasGradient2D.GetRepetition: TBGRAGradientRepetition; -begin - result := FRepetition; -end; - -procedure TBGRACanvasGradient2D.SetRepetition( - AValue: TBGRAGradientRepetition); -begin - FRepetition := AValue; - FreeAndNil(scanner); -end; - -function TBGRACanvasGradient2D.getColorArray: TGradientArrayOfColors; -var - i: Integer; -begin - setlength(result, nbColorStops); - for i := 0 to nbColorStops-1 do - result[i] := colorStops[i].color; -end; - -function TBGRACanvasGradient2D.getPositionArray: TGradientArrayOfPositions; -var - i: Integer; -begin - setlength(result, nbColorStops); - for i := 0 to nbColorStops-1 do - result[i] := colorStops[i].position; -end; - -procedure TBGRACanvasGradient2D.GetBGRAGradient(out - ABGRAGradient: TBGRACustomGradient; out AOwned: boolean); -begin - if FCustomGradient = nil then - begin - if (colorStopCount = 2) and (colorStops[0].position = 0) and (colorStops[1].position = 1) then - begin - if FGammaCorrection then - ABGRAGradient := TBGRASimpleGradientWithGammaCorrection.Create(colorStops[0].color, colorStops[1].color, FRepetition) - else - ABGRAGradient := TBGRASimpleGradientWithoutGammaCorrection.Create(colorStops[0].color, colorStops[1].color, FRepetition); - end - else - ABGRAGradient := TBGRAMultiGradient.Create(getColorArray,getPositionArray,FGammaCorrection, FRepetition = grRepeat); - AOwned := true; - end else - begin - ABGRAGradient := FCustomGradient; - AOwned := false; - end; -end; - -destructor TBGRACanvasGradient2D.Destroy; -begin - FreeAndNil(scanner); - inherited Destroy; -end; - -procedure TBGRACanvasGradient2D.addColorStop(APosition: single; - AColor: TBGRAPixel); -begin - FreeAndNil(scanner); - if nbColorStops = length(colorStops) then - setlength(colorStops, (length(colorStops)+1)*2); - - with colorStops[nbColorStops] do - begin - position := APosition; - color := AColor; - end; - inc(nbColorStops); -end; - -procedure TBGRACanvasGradient2D.addColorStop(APosition: single; AColor: TColor - ); -begin - addColorStop(APosition, ColorToBGRA(AColor)); -end; - -procedure TBGRACanvasGradient2D.addColorStop(APosition: single; AColor: string - ); -begin - addColorStop(APosition, StrToBGRA(AColor)); -end; - -procedure TBGRACanvasGradient2D.setColors(ACustomGradient: TBGRACustomGradient - ); -begin - FCustomGradient := ACustomGradient; -end; - -{ TBGRACanvasState2D } - -function TBGRACanvasState2D.GetClipMaskReadWrite: TGrayscaleMask; -begin - if not FClipMaskOwned then - begin - if FClipMask <> nil then - FClipMask := FClipMask.Duplicate as TGrayscaleMask; - FClipMaskOwned := true; - end; - result := FClipMask; -end; - -constructor TBGRACanvasState2D.Create(AMatrix: TAffineMatrix; - AClipMask: TGrayscaleMask; AClipMaskOwned: boolean); -begin - strokeColor := BGRABlack; - fillColor := BGRABlack; - globalAlpha := 255; - - fontName := 'sans-serif'; - fontEmHeight := 10; - fontStyle := []; - textDirection := fbmAuto; - textAlign:= taLeftJustify; - textBaseline := 'alphabetic'; - - lineWidth := 1; - penStroker := TBGRAPenStroker.Create; - penStroker.LineCap := pecFlat; - penStroker.JoinStyle := pjsMiter; - penStroker.CustomPenStyle := DuplicatePenStyle(SolidPenStyle); - penStroker.MiterLimit := 10; - penStroker.StrokeMatrix := AffineMatrixIdentity; - - shadowOffsetX := 0; - shadowOffsetY := 0; - shadowBlur := 0; - shadowColor := BGRAPixelTransparent; - shadowFastest:= false; - - matrix := AMatrix; - FClipMask := nil; - FClipMaskOwned := true; - SetClipMask(AClipMask,AClipMaskOwned); -end; - -function TBGRACanvasState2D.Duplicate: TBGRACanvasState2D; -begin - result := TBGRACanvasState2D.Create(matrix,clipMaskReadOnly,false); - result.strokeColor := strokeColor; - result.strokeTextureProvider := strokeTextureProvider; - result.fillColor := fillColor; - result.fillMode := fillMode; - result.fillTextureProvider := fillTextureProvider; - result.globalAlpha := globalAlpha; - - result.fontName:= fontName; - result.fontEmHeight := fontEmHeight; - result.fontStyle := fontStyle; - result.textDirection:= textDirection; - result.textBaseline:= textBaseline; - - result.lineWidth := lineWidth; - result.penStroker.LineCap := penStroker.LineCap; - result.penStroker.JoinStyle := penStroker.JoinStyle; - result.penStroker.CustomPenStyle := DuplicatePenStyle(penStroker.CustomPenStyle); - result.penStroker.MiterLimit := penStroker.MiterLimit; - result.penStroker.StrokeMatrix := penStroker.StrokeMatrix; - - result.shadowOffsetX := shadowOffsetX; - result.shadowOffsetY := shadowOffsetY; - result.shadowBlur := shadowBlur; - result.shadowColor := shadowColor; - result.shadowFastest := shadowFastest; -end; - -destructor TBGRACanvasState2D.Destroy; -begin - if FClipMaskOwned and Assigned(FClipMask) then - FClipMask.Free; - penStroker.Free; - inherited Destroy; -end; - -procedure TBGRACanvasState2D.transform(AMatrix: TAffineMatrix); -begin - matrix := matrix*AMatrix; -end; - -procedure TBGRACanvasState2D.SetClipMask(AClipMask: TGrayscaleMask; - AOwned: boolean); -begin - if FClipMaskOwned and Assigned(FClipMask) then FreeAndNil(FClipMask); - FClipMask := AClipMask; - FClipMaskOwned := AOwned; -end; - -{ TBGRACanvas2D } - -function TBGRACanvas2D.GetHeight: Integer; -begin - if Assigned(surface) then - result := Surface.Height - else - result := 0; -end; - -function TBGRACanvas2D.GetLineCap: string; -begin - case currentState.penStroker.LineCap of - pecRound: result := 'round'; - pecSquare: result := 'square'; - else result := 'butt'; - end; -end; - -function TBGRACanvas2D.GetLineCapLCL: TPenEndCap; -begin - result := currentState.penStroker.LineCap; -end; - -function TBGRACanvas2D.GetlineJoin: string; -begin - case currentState.penStroker.JoinStyle of - pjsBevel: result := 'bevel'; - pjsRound: result := 'round'; - else result := 'miter'; - end; -end; - -function TBGRACanvas2D.GetlineJoinLCL: TPenJoinStyle; -begin - result := currentState.penStroker.JoinStyle; -end; - -function TBGRACanvas2D.getLineStyle: TBGRAPenStyle; -begin - result := DuplicatePenStyle(currentState.penStroker.CustomPenStyle); -end; - -function TBGRACanvas2D.GetLineWidth: single; -begin - result := currentState.lineWidth; -end; - -function TBGRACanvas2D.GetMatrix: TAffineMatrix; -begin - result := currentState.matrix; -end; - -function TBGRACanvas2D.GetMiterLimit: single; -begin - result := currentState.penStroker.MiterLimit; -end; - -function TBGRACanvas2D.GetPixelCenteredCoordinates: boolean; -begin - result := FPixelCenteredCoordinates; -end; - -function TBGRACanvas2D.GetShadowBlur: single; -begin - result := currentState.shadowBlur; -end; - -function TBGRACanvas2D.GetShadowFastest: boolean; -begin - result := currentState.shadowFastest; -end; - -function TBGRACanvas2D.GetShadowOffset: TPointF; -begin - result := PointF(shadowOffsetX,shadowOffsetY); -end; - -function TBGRACanvas2D.GetShadowOffsetX: single; -begin - result := currentState.shadowOffsetX; -end; - -function TBGRACanvas2D.GetShadowOffsetY: single; -begin - result := currentState.shadowOffsetY; -end; - -function TBGRACanvas2D.GetStrokeMatrix: TAffineMatrix; -begin - result := currentState.penStroker.StrokeMatrix; -end; - -function TBGRACanvas2D.GetTextAlign: string; -begin - case currentState.textAlign of - taRightJustify: result := 'right'; - taCenter: result := 'center'; - else - result := 'left'; - end; -end; - -function TBGRACanvas2D.GetTextAlignLCL: TAlignment; -begin - result := currentState.textAlign; -end; - -function TBGRACanvas2D.GetTextBaseline: string; -begin - result := currentState.textBaseline; -end; - -function TBGRACanvas2D.GetGlobalAlpha: single; -begin - result := currentState.globalAlpha/255; -end; - -function TBGRACanvas2D.GetCurrentPathAsPoints: ArrayOfTPointF; -var i: integer; -begin - setlength(result, FPathPointCount); - for i := 0 to high(result) do - result[i] := FPathPoints[i]; -end; - -function TBGRACanvas2D.GetTextDirection: TFontBidiMode; -begin - result := currentState.textDirection; -end; - -function TBGRACanvas2D.GetFontName: string; -begin - result := currentState.fontName; -end; - -function TBGRACanvas2D.GetFontRenderer: TBGRACustomFontRenderer; -var zoom1,zoom2,zoom: single; -begin - if FFontRenderer = nil then - begin - if FSurface <> nil then - result := FSurface.FontRenderer - else - result := nil; - end else - result := FFontRenderer; - if Assigned(result) then - begin - result.FontName := CSSFontNameToLCL(currentState.fontName); - result.FontStyle := currentState.fontStyle; - if antialiasing then - result.FontQuality:= fqFineAntialiasing - else - result.FontQuality := fqSystem; - result.FontOrientation := 0; - zoom1 := VectLen(currentState.matrix[1,1],currentState.matrix[2,1]); - zoom2 := VectLen(currentState.matrix[1,2],currentState.matrix[2,2]); - if zoom1>zoom2 then zoom := zoom1 else zoom := zoom2; - result.FontEmHeight := round(currentState.fontEmHeight*zoom); - end; -end; - -function TBGRACanvas2D.GetFontEmHeight: single; -begin - result := currentState.fontEmHeight; -end; - -function TBGRACanvas2D.GetFontString: string; -var formats: TFormatSettings; -begin - formats := DefaultFormatSettings; - formats.DecimalSeparator := '.'; - - result := ''; - if fsItalic in currentState.fontStyle then - AppendStr(result, 'italic '); - if fsBold in currentState.fontStyle then - AppendStr(result, 'bold '); - AppendStr(result, FloatToStrF(currentState.fontEmHeight,ffGeneral,6,0,formats)+'px '); - AppendStr(result, currentState.fontName); - result := trim(result); -end; - -function TBGRACanvas2D.GetFontStyle: TFontStyles; -begin - result := currentState.fontStyle; -end; - -function TBGRACanvas2D.GetHasShadow: boolean; -begin - result := (ApplyGlobalAlpha(currentState.shadowColor).alpha <> 0) and - ( (currentState.shadowBlur <> 0) or (currentState.shadowOffsetX <> 0) - or (currentState.shadowOffsetY <> 0) ); -end; - -function TBGRACanvas2D.GetWidth: Integer; -begin - if Assigned(Surface) then - result := Surface.Width - else - result := 0; -end; - -procedure TBGRACanvas2D.SetTextDirection(AValue: TFontBidiMode); -begin - currentState.textDirection := AValue; -end; - -procedure TBGRACanvas2D.SetFontName(AValue: string); -var - list: ArrayOfString; - i: Integer; -begin - list := StrToFontNameList(AValue); - for i := 0 to high(list) do - begin - if (list[i] = 'serif') or (list[i] = 'sans-serif') or (list[i] = 'monospace') - or (list[i] = 'cursive') or (list[i] = 'fantasy') then - begin - currentState.fontName:= list[i]; - exit; - end else - if Assigned(fontRenderer) and fontRenderer.FontExists(list[i]) then - begin - currentState.fontName := list[i]; - exit; - end; - end; - currentState.fontName := 'sans-serif'; -end; - -procedure TBGRACanvas2D.SetFontRenderer(AValue: TBGRACustomFontRenderer); -begin - if AValue = FFontRenderer then exit; - FreeAndNil(FFontRenderer); - FFontRenderer := AValue; -end; - -procedure TBGRACanvas2D.SetFontEmHeight(AValue: single); -begin - currentState.fontEmHeight := AValue; -end; - -procedure TBGRACanvas2D.SetFontString(AValue: string); -var idxSpace,errPos: integer; - attrib,u: string; - value: single; -begin - currentState.fontStyle := []; - currentState.fontEmHeight := 10; - currentState.fontName := 'sans-serif'; - AValue := trim(AValue); - while AValue <> '' do - begin - while (AValue <> '') and (AValue[1]in [#0..#32]) do delete(AValue,1,1); - idxSpace := pos(' ',AValue); - if idxSpace = 0 then - attrib := AValue - else - attrib := copy(AValue,1,idxSpace-1); - attrib := lowerCase(attrib); - if attrib = '' then break; - if (attrib = 'normal') or (attrib = 'small-caps') or (attrib = 'lighter') then - begin - //nothing - end else - if (attrib = 'italic') or (attrib = 'oblique') then - begin - include(currentState.fontStyle, fsItalic); - end else - if (attrib = 'bold') or (attrib = 'bolder') then - begin - include(currentState.fontStyle, fsBold); - end else - if (attrib[1] in ['.','0'..'9']) then - begin - u := ''; - while (length(attrib)>0) and (attrib[length(attrib)] in['a'..'z']) do - begin - u := attrib[length(attrib)]+u; - delete(attrib,length(attrib),1); - end; - val(attrib,value,errPos); - if errPos = 0 then - begin - if u = '' then //weight - begin - if value >= 600 then include(currentState.fontStyle, fsBold); - end else - if u = 'px' then currentState.fontEmHeight := value else - if u = 'pt' then currentState.fontEmHeight:= value/72*96 else - if u = 'in' then currentState.fontEmHeight:= value*96 else - if u = 'mm' then currentState.fontEmHeight:= value/25.4*96 else - if u = 'cm' then currentState.fontEmHeight:= value/2.54*96; - end; - end else - break; - delete(AValue,1,length(attrib)+1); - end; - AValue := trim(AValue); - if AValue <> '' then currentState.fontName := AValue; -end; - -procedure TBGRACanvas2D.SetFontStyle(AValue: TFontStyles); -begin - currentState.fontStyle:= AValue; -end; - -procedure TBGRACanvas2D.SetGlobalAlpha(const AValue: single); -begin - if AValue < 0 then currentState.globalAlpha:= 0 else - if AValue > 1 then currentState.globalAlpha:= 255 else - currentState.globalAlpha:= round(AValue*255); -end; - -procedure TBGRACanvas2D.SetLineCap(const AValue: string); -begin - if CompareText(AValue,'round')=0 then - currentState.penStroker.LineCap := pecRound else - if CompareText(AValue,'square')=0 then - currentState.penStroker.LineCap := pecSquare - else - currentState.penStroker.LineCap := pecFlat; -end; - -procedure TBGRACanvas2D.SetLineCapLCL(AValue: TPenEndCap); -begin - currentState.penStroker.LineCap := AValue; -end; - -procedure TBGRACanvas2D.SetLineJoin(const AValue: string); -begin - if CompareText(AValue,'round')=0 then - currentState.penStroker.JoinStyle := pjsRound else - if CompareText(AValue,'bevel')=0 then - currentState.penStroker.JoinStyle := pjsBevel - else - currentState.penStroker.JoinStyle := pjsMiter; -end; - -procedure TBGRACanvas2D.FillPoly(const points: array of TPointF); -var - bfill: boolean; - tempScan: TBGRACustomScanner; -begin - if (length(points) = 0) or (surface = nil) then exit; - If hasShadow then DrawShadow(points,[],fillMode); - bfill:= currentState.fillMode = fmWinding; - if currentState.clipMaskReadOnly <> nil then - begin - if currentState.fillTextureProvider <> nil then - tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha) - else - tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor)); - if self.antialiasing then - BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, bfill, linearBlend) - else - BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, bfill, GetDrawMode); - tempScan.free; - end else - begin - if currentState.fillTextureProvider <> nil then - begin - if currentState.globalAlpha <> 255 then - begin - tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha); - if self.antialiasing then - BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, bfill, linearBlend) - else - BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, bfill, GetDrawMode); - tempScan.Free; - end else - begin - if self.antialiasing then - BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, currentState.fillTextureProvider.texture, bfill, linearBlend) - else - BGRAPolygon.FillPolyAliasedWithTexture(surface, points, currentState.fillTextureProvider.texture, bfill, GetDrawMode); - end - end - else - begin - if self.antialiasing then - BGRAPolygon.FillPolyAntialias(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, bfill, linearBlend) - else - BGRAPolygon.FillPolyAliased(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, bfill, GetDrawMode) - end - end; -end; - -procedure TBGRACanvas2D.FillStrokePoly(const points: array of TPointF; - fillOver: boolean); -var - tempScan,tempScan2: TBGRACustomScanner; - multi: TBGRAMultishapeFiller; - contour : array of TPointF; - texture: IBGRAScanner; - idxContour: Integer; -begin - if (length(points) = 0) or (surface = nil) then exit; - tempScan := nil; - tempScan2 := nil; - multi := TBGRAMultishapeFiller.Create; - multi.FillMode := self.fillMode; - if currentState.clipMaskReadOnly <> nil then - begin - if currentState.fillTextureProvider <> nil then - tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha) - else - tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor)); - multi.AddPolygon(points, tempScan); - end else - begin - if currentState.fillTextureProvider <> nil then - begin - if currentState.globalAlpha <> 255 then - begin - tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha); - multi.AddPolygon(points, tempScan); - end else - multi.AddPolygon(points, currentState.fillTextureProvider.texture) - end - else - multi.AddPolygon(points, ApplyGlobalAlpha(currentState.fillColor)); - end; - - if currentState.lineWidth > 0 then - begin - contour := currentState.penStroker.ComputePolylineAutocycle(points,currentState.lineWidth); - - if currentState.clipMaskReadOnly <> nil then - begin - if currentState.strokeTextureProvider <> nil then - tempScan2 := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha) - else - tempScan2 := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor)); - idxContour := multi.AddPolygon(contour,tempScan); - end else - begin - if currentState.strokeTextureProvider <> nil then - texture := currentState.strokeTextureProvider.texture else - texture := nil; - if texture = nil then - idxContour := multi.AddPolygon(contour,ApplyGlobalAlpha(currentState.strokeColor)) - else - idxContour := multi.AddPolygon(contour,texture); - end; - multi.OverrideFillMode(idxContour, fmWinding); - If hasShadow then DrawShadow(points,contour); - end else - If hasShadow then DrawShadow(points,[]); - - if fillOver then multi.PolygonOrder := poFirstOnTop else multi.PolygonOrder:= poLastOnTop; - multi.Antialiasing := self.antialiasing; - multi.Draw(surface); - tempScan.free; - tempScan2.free; - multi.Free; -end; - -procedure TBGRACanvas2D.FillTexts(AErase: boolean); -var - i,j: Integer; - hy,hx,h: single; - bmp,bmpTransf: TBGRACustomBitmap; - tempScan: TBGRACustomScanner; - m: TAffineMatrix; - s: TSize; - sourceBounds, usedSourceBounds, surfaceBounds, shadowBounds: TRect; - rf: TResampleFilter; - pad: TSize; - p: PBGRAPixel; -begin - for i := 0 to High(FTextPaths) do - with FTextPaths[i] do - begin - hx := VectLen(FontMatrix[1,1],FontMatrix[2,1]); - hy := VectLen(FontMatrix[1,2],FontMatrix[2,2]); - h := max(hx,hy); - if self.antialiasing then h := round(h); - if h<=0 then continue; - m := FontMatrix*AffineMatrixScale(1/h, 1/h); - if pixelCenteredCoordinates then m := AffineMatrixTranslation(0.5,0.5)*m; - bmp := BGRABitmapFactory.Create; - try - bmp.FontName := CSSFontNameToLCL(FontName); - bmp.FontStyle:= FontStyle; - bmp.FontHeight:= round(h); - bmp.FontBidiMode:= TextDirection; - if self.antialiasing then - bmp.FontQuality := fqFineAntialiasing - else - bmp.FontQuality:= fqSystem; - - bmp.FontVerticalAnchor:= FontAnchor; - m := m*AffineMatrixTranslation(0,-bmp.FontVerticalAnchorOffset); - bmp.FontVerticalAnchor:= fvaTop; - - s := bmp.TextSize(Text); - case FontAlign of - taCenter: m := m*AffineMatrixTranslation(-s.cx/2,0); - taRightJustify: m := m*AffineMatrixTranslation(-s.cx,0); - end; - - pad := Size(round(h/3), round(h/3)); - m := m*AffineMatrixTranslation(-pad.cx,-pad.cy); - sourceBounds := BGRAClasses.Rect(0,0,s.cx+pad.cx*2,s.cy+pad.cy*2); - surfaceBounds := surface.GetImageAffineBounds(m, sourceBounds); - if hasShadow then - begin - shadowBounds := surfaceBounds; - shadowBounds.Inflate(ceil(shadowBlur),ceil(shadowBlur)); - shadowBounds.Offset(round(shadowOffsetX),round(shadowOffsetY)); - shadowBounds.Intersect(surface.ClipRect); - if not shadowBounds.IsEmpty then - begin - shadowBounds.Offset(-round(shadowOffsetX),-round(shadowOffsetY)); - surfaceBounds.Union(shadowBounds); - end; - end; - if not surfaceBounds.IsEmpty and IsAffineMatrixInversible(m) then - begin - usedSourceBounds := (AffineMatrixInverse(m) * - TAffineBox.AffineBox(RectF(surfaceBounds))).RectBounds; - usedSourceBounds.Inflate(1,1); - sourceBounds.Intersect(usedSourceBounds); - m := m * AffineMatrixTranslation(sourceBounds.Left, sourceBounds.Top); - bmp.SetSize(sourceBounds.Width, sourceBounds.Height); - bmp.Fill(BGRABlack); - bmp.TextOut(pad.cx - sourceBounds.Left,pad.cy - sourceBounds.Top, Text, BGRAWhite); - if self.antialiasing then bmp.ConvertToLinearRGB else - begin - p := bmp.Data; - for j := bmp.NbPixels-1 downto 0 do - begin - if p^.green<128 then p^ := BGRABlack else p^ := BGRAWhite; - inc(p); - end; - end; - - bmpTransf := BGRABitmapFactory.Create(surfaceBounds.Width,surfaceBounds.Height,BGRABlack); - try - m := AffineMatrixTranslation(-surfaceBounds.Left-0.5,-surfaceBounds.Top-0.5)*m; - if self.antialiasing then rf:= rfCosine else rf := rfBox; - bmpTransf.PutImageAffine(m, bmp, rf, GetDrawMode); - FreeAndNil(bmp); - - if AErase then - surface.EraseMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf) else - begin - if hasShadow then - DrawShadowMask(surfaceBounds.Left+round(shadowOffsetX),surfaceBounds.Top+round(shadowOffsetY), bmpTransf, false); - - if currentState.clipMaskReadOnly <> nil then - begin - if currentState.fillTextureProvider <> nil then - tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha) - else - tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor)); - surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, tempScan, GetDrawMode); - tempScan.free; - end else - begin - if currentState.fillTextureProvider <> nil then - begin - if currentState.globalAlpha <> 255 then - begin - tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha); - surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, tempScan, GetDrawMode); - tempScan.Free; - end else - surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, currentState.fillTextureProvider.texture, GetDrawMode); - end - else - surface.FillMask(surfaceBounds.Left,surfaceBounds.Top, bmpTransf, ApplyGlobalAlpha(currentState.fillColor), GetDrawMode); - end; - end; - finally - bmpTransf.Free; - end; - end; - finally - bmp.Free; - end; - end; -end; - -procedure TBGRACanvas2D.SetLineJoinLCL(AValue: TPenJoinStyle); -begin - currentState.penStroker.JoinStyle := AValue; -end; - -procedure TBGRACanvas2D.lineStyle(const AValue: array of single); -var a: array of single; - i: Integer; -begin - if odd(length(AValue)) then - begin - setlength(a, length(AValue)*2); - for i := 0 to high(AValue) do - begin - a[i] := AValue[i]; - a[i + length(AValue)] := AValue[i]; - end; - end else - a := DuplicatePenStyle(AValue); - currentState.penStroker.CustomPenStyle := a; -end; - -procedure TBGRACanvas2D.lineStyle(AStyle: TPenStyle); -begin - if AStyle = psPattern then exit; - lineStyle(PenStyleToBGRA(AStyle)); -end; - -class function TBGRACanvas2D.StrToFontNameList(AText: string): ArrayOfString; -var - list: TStringList; - inQuote: Char; - nameStart, i: Integer; - - procedure SkipSpace; - begin - while (i < length(AText)) and (AText[i] in [#0..#32]) do inc(i); - end; - - procedure SkipComma; - begin - SkipSpace; - if (i < length(AText)) and (AText[i] = ',') then inc(i); - SkipSpace; - end; - -begin - list := TStringList.Create; - inQuote := ' '; - i := 1; - SkipSpace; - nameStart := -1; - while i <= length(AText) do - begin - if inQuote <> ' ' then - begin - if AText[i] = inQuote then - begin - list.Add(copy(AText, nameStart, i-nameStart)); - inQuote := ' '; - inc(i); - SkipComma; - nameStart := -1; - end else - inc(i); - end else - if nameStart = -1 then - begin - if AText[i] in ['''', '"'] then - begin - nameStart := i+1; - inQuote := AText[i]; - inc(i); - end else - begin - nameStart := i; - inc(i); - end; - end else - if AText[i] = ',' then - begin - list.Add(Trim(copy(AText, nameStart, i-nameStart))); - inc(i); - SkipComma; - nameStart := -1; - end else - inc(i); - end; - if nameStart <> -1 then list.Add(copy(AText, nameStart, length(AText)-nameStart+1)); - setlength(result, list.Count); - for i := 0 to list.Count-1 do - result[i] := list[i]; - list.Free; -end; - -class function TBGRACanvas2D.FontNameListToStr(AList: ArrayOfString): string; -var - i: Integer; -begin - result := ''; - for i := 0 to high(AList) do - begin - if i > 0 then AppendStr(result, ', '); - if pos(' ',AList[i]) <> -1 then - AppendStr(result, '''' + StringReplace(AList[i], '''', ''', [rfReplaceAll]) + '''') - else AppendStr(result, AList[i]); - end; -end; - -class function TBGRACanvas2D.CSSFontNameToLCL(AName: string): string; -begin - if AName = 'sans-serif' then result := 'sans' - else if AName = 'cursive' then result := {$IFDEF WINDOWS}'Segoe Script'{$ELSE} - {$IFDEF LINUX}'Z003'{$ELSE} - {$IFDEF DARWIN}'Brush Script MT'{$ELSE} - 'sans' - {$ENDIF}{$ENDIF}{$ENDIF} - else if AName = 'fantasy' then result := {$IFDEF WINDOWS}'Comic Sans MS'{$ELSE} - {$IFDEF DARWIN}'Papyrus'{$ELSE} - 'sans' - {$ENDIF}{$ENDIF} - else result := StringReplace(StringReplace(AName, ''', '''', [rfReplaceAll]), - ''', '''', [rfReplaceAll]); -end; - -function TBGRACanvas2D.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - if GetInterface(iid, obj) then - Result := S_OK - else - Result := longint(E_NOINTERFACE); -end; - -{ There is no automatic reference counting, but it is compulsory to define these functions } -function TBGRACanvas2D._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -function TBGRACanvas2D._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -procedure TBGRACanvas2D.SetLineWidth(const AValue: single); -begin - currentState.lineWidth := AValue; -end; - -procedure TBGRACanvas2D.SetMatrix(AValue: TAffineMatrix); -begin - currentState.matrix := AValue; -end; - -procedure TBGRACanvas2D.SetMiterLimit(const AValue: single); -begin - currentState.penStroker.MiterLimit := AValue; -end; - -procedure TBGRACanvas2D.SetPixelCenteredCoordinates(const AValue: boolean); -begin - FPixelCenteredCoordinates:= AValue; - if AValue then - FCanvasOffset := PointF(0,0) - else - FCanvasOffset := PointF(-0.5,-0.5); -end; - -procedure TBGRACanvas2D.SetShadowBlur(const AValue: single); -begin - currentState.shadowBlur := AValue; -end; - -procedure TBGRACanvas2D.SetShadowFastest(AValue: boolean); -begin - currentState.shadowFastest := AValue; -end; - -procedure TBGRACanvas2D.SetShadowOffset(const AValue: TPointF); -begin - shadowOffsetX := AValue.X; - shadowOffsetY := AValue.Y; -end; - -procedure TBGRACanvas2D.SetShadowOffsetX(const AValue: single); -begin - currentState.shadowOffsetX := AValue; -end; - -procedure TBGRACanvas2D.SetShadowOffsetY(const AValue: single); -begin - currentState.shadowOffsetY := AValue; -end; - -procedure TBGRACanvas2D.SetStrokeMatrix(AValue: TAffineMatrix); -begin - currentState.penStroker.strokeMatrix := AValue; -end; - -procedure TBGRACanvas2D.SetTextAlign(AValue: string); -begin - AValue := trim(LowerCase(AValue)); - if (AValue = 'left') or (AValue = 'start') then - textAlignLCL := taLeftJustify else - if (AValue = 'right') or (AValue = 'end') then - textAlignLCL := taRightJustify else - if AValue = 'center' then - textAlignLCL := taCenter; -end; - -procedure TBGRACanvas2D.SetTextAlignLCL(AValue: TAlignment); -begin - currentState.textAlign := AValue; -end; - -procedure TBGRACanvas2D.SetTextBaseline(AValue: string); -begin - currentState.textBaseline := trim(lowercase(AValue)); -end; - -procedure TBGRACanvas2D.StrokePoly(const points: array of TPointF); -var - texture: IBGRAScanner; - tempScan: TBGRACustomScanner; - contour: array of TPointF; -begin - if (length(points)= 0) or (currentState.lineWidth = 0) or (surface = nil) then exit; - contour := currentState.penStroker.ComputePolylineAutocycle(points,currentState.lineWidth); - - If hasShadow then DrawShadow(contour,[]); - if currentState.clipMaskReadOnly <> nil then - begin - if currentState.strokeTextureProvider <> nil then - tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha) - else - tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor)); - if self.antialiasing then - BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,tempScan,True, linearBlend) - else - BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,tempScan,True,GetDrawMode); - tempScan.free; - end else - begin - if currentState.strokeTextureProvider <> nil then - texture := currentState.strokeTextureProvider.texture else - texture := nil; - if texture = nil then - begin - if self.antialiasing then - BGRAPolygon.FillPolyAntialias(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True, linearBlend) - else - BGRAPolygon.FillPolyAliased(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True,GetDrawMode) - end - else - begin - if self.antialiasing then - BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,texture,True, linearBlend) - else - BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,texture,True,GetDrawMode) - end; - end; -end; - -procedure TBGRACanvas2D.DrawShadow(const points, points2: array of TPointF; - AFillMode: TFillMode = fmWinding); -var ofsPts,ofsPts2: array of TPointF; - offset: TPointF; - i: Integer; - tempBmp: TGrayscaleMask; - maxRect: TRect; - foundRect: TRect; - firstFound: boolean; - - procedure AddPt(const coord: TPointF); - var pixRect: TRect; - begin - if isEmptyPointF(coord) then exit; - pixRect := BGRAClasses.Rect(round(floor(coord.x)),round(floor(coord.y)),round(ceil(coord.x+0.999))+1,round(ceil(coord.y+0.999))+1); - if firstFound then - begin - foundRect := pixRect; - firstFound := false - end - else - begin - if pixRect.left < foundRect.left then foundRect.left := pixRect.Left; - if pixRect.top < foundRect.top then foundRect.top := pixRect.top; - if pixRect.right > foundRect.right then foundRect.right := pixRect.right; - if pixRect.bottom > foundRect.bottom then foundRect.bottom := pixRect.bottom; - end; - end; - -begin - if not hasShadow or (surface = nil) then exit; - offset := PointF(shadowOffsetX,shadowOffsetY); - setlength(ofsPts, length(points)); - for i := 0 to high(ofsPts) do - ofsPts[i] := points[i]+offset; - setlength(ofsPts2, length(points2)); - for i := 0 to high(ofsPts2) do - ofsPts2[i] := points2[i]+offset; - - maxRect := BGRAClasses.Rect(0,0,width,height); - if currentState.clipMaskReadOnly <> nil then - foundRect := maxRect - else - begin - firstFound := true; - foundRect := EmptyRect; - for i := 0 to high(ofsPts) do - AddPt(ofsPts[i]); - for i := 0 to high(ofsPts2) do - AddPt(ofsPts2[i]); - if firstFound then exit; - foundRect.Inflate(ceil(shadowBlur), ceil(shadowBlur)); - foundRect.Intersect(maxRect); - if foundRect.IsEmpty then exit; - offset := PointF(-foundRect.Left,-foundRect.Top); - for i := 0 to high(ofsPts) do - ofsPts[i].Offset(offset); - for i := 0 to high(ofsPts2) do - ofsPts2[i].Offset(offset); - end; - - tempBmp := TGrayscaleMask.Create(foundRect.Right-foundRect.Left,foundRect.Bottom-foundRect.Top,BGRABlack); - tempBmp.FillMode := AFillMode; - tempBmp.FillPolyAntialias(ofsPts, BGRAWhite); - tempBmp.FillPolyAntialias(ofsPts2, BGRAWhite); - DrawShadowMask(foundRect.Left,foundRect.Top, tempBmp, true); -end; - -procedure TBGRACanvas2D.DrawShadowMask(X, Y: integer; AMask: TCustomUniversalBitmap; AMaskOwned: boolean); -const invSqrt2 = 1/sqrt(2); -var - bmp: TCustomUniversalBitmap; - gs: TGrayscaleMask; -begin - if AMask.Colorspace <> TByteMaskColorspace then - begin - gs := TGrayscaleMask.Create(AMask as TBGRACustomBitmap, cGreen); - if AMaskOwned then AMask.Free; - AMask := gs; - AMaskOwned:= true; - end; - bmp := AMask; - if shadowBlur > 0 then - begin - if shadowFastest then - begin - if shadowBlur*invSqrt2 >= 0.5 then - bmp := AMask.FilterBlurRadial(round(shadowBlur*invSqrt2),rbBox); - end - else - begin - if (shadowBlur < 5) and (abs(shadowBlur-round(shadowBlur)) > 1e-6) then - bmp := AMask.FilterBlurRadial(round(shadowBlur*10),rbPrecise) - else - bmp := AMask.FilterBlurRadial(round(shadowBlur),rbFast); - end; - end; - if currentState.clipMaskReadOnly <> nil then - begin - if (bmp = AMask) and not AMaskOwned then bmp := AMask.Duplicate; - bmp.ApplyMask(currentState.clipMaskReadOnly); - end; - surface.FillMask(X,Y,bmp,ApplyGlobalAlpha(getShadowColor),GetDrawMode); - if bmp <> AMask then bmp.Free; - if AMaskOwned then AMask.Free; -end; - -procedure TBGRACanvas2D.ClearPoly(const points: array of TPointF); -begin - if surface = nil then exit; - if self.antialiasing then - BGRAPolygon.FillPolyAntialias(surface, points, BGRA(0,0,0,255), true, true, linearBlend) - else - BGRAPolygon.FillPolyAliased(surface, points, BGRA(0,0,0,255), true, true, dmSet); -end; - -function TBGRACanvas2D.ApplyTransform(const points: array of TPointF; - matrix: TAffineMatrix): ArrayOfTPointF; -var - i: Integer; -begin - setlength(result,length(points)); - for i := 0 to high(result) do - if isEmptyPointF(points[i]) then - result[i] := EmptyPointF - else - result[i] := matrix*points[i]+FCanvasOffset; -end; - -function TBGRACanvas2D.ApplyTransform(const points: array of TPointF - ): ArrayOfTPointF; -var - i: Integer; -begin - setlength(result,length(points)); - for i := 0 to high(result) do - if isEmptyPointF(points[i]) then - result[i] := EmptyPointF - else - result[i] := currentState.matrix*points[i]+FCanvasOffset; -end; - -function TBGRACanvas2D.ApplyTransform(point: TPointF): TPointF; -begin - result := currentState.matrix*point+FCanvasOffset; -end; - -function TBGRACanvas2D.GetPenPos(defaultX,defaultY: single): TPointF; -begin - if isEmptyPointF(FLastCoord) then - result := PointF(defaultX,defaultY) - else - result := FLastCoord; -end; - -function TBGRACanvas2D.GetPenPos(defaultPt: TPointF): TPointF; -begin - result := GetPenPos(defaultPt.x,defaultPt.y); -end; - -procedure TBGRACanvas2D.AddPoint(point: TPointF); -begin - if FPathPointCount = length(FPathPoints) then - setlength(FPathPoints, (length(FPathPoints)+1)*2); - FPathPoints[FPathPointCount] := point; - inc(FPathPointCount); -end; - -procedure TBGRACanvas2D.AddPoints(const points: array of TPointF); -var i: integer; -begin - if FPathPointCount+length(points) > length(FPathPoints) then - setlength(FPathPoints, max( (length(FPathPoints)+1)*2, FPathPointCount+length(points) ) ); - for i := 0 to high(points) do - begin - FPathPoints[FPathPointCount] := points[i]; - inc(FPathPointCount); - end; -end; - -procedure TBGRACanvas2D.AddPointsRev(const points: array of TPointF); -var i: integer; -begin - if FPathPointCount+length(points) > length(FPathPoints) then - setlength(FPathPoints, max( (length(FPathPoints)+1)*2, FPathPointCount+length(points) ) ); - for i := high(points) downto 0 do - begin - FPathPoints[FPathPointCount] := points[i]; - inc(FPathPointCount); - end; -end; - -function TBGRACanvas2D.ApplyGlobalAlpha(color: TBGRAPixel): TBGRAPixel; -begin - result := BGRA(color.red,color.green,color.blue,ApplyOpacity(color.alpha, currentState.globalAlpha)); -end; - -function TBGRACanvas2D.GetDrawMode: TDrawMode; -begin - if linearBlend then result := dmLinearBlend else result := dmDrawWithTransparency; -end; - -procedure TBGRACanvas2D.copyTo(dest: IBGRAPath); -begin - //nothing -end; - -function TBGRACanvas2D.getPoints: ArrayOfTPointF; -begin - result := GetCurrentPathAsPoints; -end; - -function TBGRACanvas2D.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; -begin - result := GetCurrentPathAsPoints; - if not IsAffineMatrixIdentity(AMatrix) then - result := AMatrix*result; -end; - -function TBGRACanvas2D.getCursor: TBGRACustomPathCursor; -begin - result := nil; -end; - -constructor TBGRACanvas2D.Create(ASurface: TBGRACustomBitmap); -begin - FSurface := ASurface; - StateStack := TList.Create; - FPathPointCount := 0; - FLastCoord := EmptyPointF; - FStartCoord := EmptyPointF; - currentState := TBGRACanvasState2D.Create(AffineMatrixIdentity,nil,true); - pixelCenteredCoordinates := false; - antialiasing := true; - gradientGammaCorrection := false; -end; - -destructor TBGRACanvas2D.Destroy; -var - i: Integer; -begin - for i := 0 to StateStack.Count-1 do - TObject(StateStack[i]).Free; - StateStack.Free; - currentState.Free; - FreeAndNil(FFontRenderer); - inherited Destroy; -end; - -function TBGRACanvas2D.toDataURL(mimeType: string): string; -var - stream: TMemoryStream; - jpegWriter: TFPWriterJPEG; - bmpWriter: TFPWriterBMP; - output: TStringStream; - encode64: TBase64EncodingStream; -begin - if surface = nil then exit(''); - stream := TMemoryStream.Create; - if mimeType='image/jpeg' then - begin - jpegWriter := TFPWriterJPEG.Create; - Surface.SaveToStream(stream,jpegWriter); - jpegWriter.Free; - end else - if mimeType='image/bmp' then - begin - bmpWriter := TFPWriterBMP.Create; - Surface.SaveToStream(stream,bmpWriter); - bmpWriter.Free; - end else - begin - mimeType := 'image/png'; - Surface.SaveToStreamAsPng(stream); - end; - output := TStringStream.Create('data:'+mimeType+';base64,'); - output.Position := output.size; - stream.Position := 0; - encode64 := TBase64EncodingStream.Create(output); - encode64.CopyFrom(stream,stream.size); - encode64.free; - stream.free; - result := output.DataString; - output.free; -end; - -procedure TBGRACanvas2D.save; -var cur: TBGRACanvasState2D; -begin - cur := currentState.Duplicate; - StateStack.Add(cur); -end; - -procedure TBGRACanvas2D.restore; -begin - if StateStack.Count > 0 then - begin - FreeAndNil(currentState); - currentState := TBGRACanvasState2D(StateStack[StateStack.Count-1]); - StateStack.Delete(StateStack.Count-1); - end; -end; - -procedure TBGRACanvas2D.scale(x, y: single); -begin - currentState.transform(AffineMatrixScale(x,y)); -end; - -procedure TBGRACanvas2D.scale(factor: single); -begin - currentState.transform( AffineMatrixScale(factor,factor) ); -end; - -procedure TBGRACanvas2D.rotate(angleRadCW: single); -begin - currentState.transform( AffineMatrixRotationRad(-angleRadCW) ); -end; - -procedure TBGRACanvas2D.translate(x, y: single); -begin - if (x = 0) and (y = 0) then exit; - currentState.transform( AffineMatrixTranslation(x,y) ); -end; - -procedure TBGRACanvas2D.skewx(angleRadCW: single); -begin - currentState.transform( AffineMatrixSkewXRad(-angleRadCW) ); -end; - -procedure TBGRACanvas2D.skewy(angleRadCW: single); -begin - currentState.transform( AffineMatrixSkewYRad(-angleRadCW) ); -end; - -procedure TBGRACanvas2D.transform(m11,m21, m12,m22, m13,m23: single); -begin - currentState.transform( AffineMatrix(m11,m12,m13, - m21,m22,m23) ); -end; - -procedure TBGRACanvas2D.transform(AMatrix: TAffineMatrix); -begin - currentState.transform( AMatrix ); -end; - -procedure TBGRACanvas2D.setTransform(m11,m21, m12,m22, m13,m23: single); -begin - currentState.matrix := AffineMatrix(m11,m12,m13, - m21,m22,m23); -end; - -procedure TBGRACanvas2D.resetTransform; -begin - currentState.matrix := AffineMatrixIdentity; -end; - -procedure TBGRACanvas2D.strokeScale(x, y: single); -begin - currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixScale(x,y); -end; - -procedure TBGRACanvas2D.strokeSkewx(angleRadCW: single); -begin - currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixSkewXRad(-angleRadCW); -end; - -procedure TBGRACanvas2D.strokeSkewy(angleRadCW: single); -begin - currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixSkewYRad(-angleRadCW); -end; - -procedure TBGRACanvas2D.strokeResetTransform; -begin - currentState.penStroker.strokeMatrix := AffineMatrixIdentity; -end; - -procedure TBGRACanvas2D.strokeStyle(color: TBGRAPixel); -begin - currentState.strokeColor := color; - currentState.strokeTextureProvider := nil; -end; - -procedure TBGRACanvas2D.strokeStyle(color: TColor); -begin - currentState.strokeColor := ColorToBGRA(color); - currentState.strokeTextureProvider := nil; -end; - -procedure TBGRACanvas2D.strokeStyle(color: string); -begin - currentState.strokeColor := StrToBGRA(color); - currentState.strokeTextureProvider := nil; -end; - -procedure TBGRACanvas2D.strokeStyle(texture: IBGRAScanner); -begin - strokeStyle(createPattern(texture)); -end; - -procedure TBGRACanvas2D.strokeStyle(provider: IBGRACanvasTextureProvider2D); -begin - currentState.strokeColor := BGRAPixelTransparent; - currentState.strokeTextureProvider := provider; -end; - -function TBGRACanvas2D.GetFillMode: TFillMode; -begin - result := currentState.fillMode; -end; - -procedure TBGRACanvas2D.SetFillMode(mode: TFillMode); -begin - currentState.fillMode := mode; -end; - -procedure TBGRACanvas2D.fillStyle(color: TBGRAPixel); -begin - currentState.fillColor := color; - currentState.fillTextureProvider := nil; -end; - -procedure TBGRACanvas2D.fillStyle(color: TColor); -begin - currentState.fillColor := ColorToBGRA(color); - currentState.fillTextureProvider := nil; -end; - -procedure TBGRACanvas2D.fillStyle(color: string); -begin - currentState.fillColor := StrToBGRA(color); - currentState.fillTextureProvider := nil; -end; - -procedure TBGRACanvas2D.fillStyle(texture: IBGRAScanner); -begin - fillStyle(createPattern(texture)); -end; - -procedure TBGRACanvas2D.fillStyle(provider: IBGRACanvasTextureProvider2D); -begin - currentState.fillColor := BGRAPixelTransparent; - currentState.fillTextureProvider := provider; -end; - -procedure TBGRACanvas2D.shadowColor(color: TBGRAPixel); -begin - currentState.shadowColor := color; -end; - -procedure TBGRACanvas2D.shadowColor(color: TColor); -begin - shadowColor(ColorToBGRA(color)); -end; - -procedure TBGRACanvas2D.shadowColor(color: string); -begin - shadowColor(StrToBGRA(color)); -end; - -procedure TBGRACanvas2D.shadowNone; -begin - shadowColor(BGRAPixelTransparent); -end; - -function TBGRACanvas2D.getShadowColor: TBGRAPixel; -begin - result := currentState.shadowColor; -end; - -function TBGRACanvas2D.createLinearGradient(x0, y0, x1, y1: single): IBGRACanvasGradient2D; -begin - result := createLinearGradient(PointF(x0,y0), PointF(x1,y1)); -end; - -function TBGRACanvas2D.createLinearGradient(p0, p1: TPointF): IBGRACanvasGradient2D; -begin - result := TBGRACanvasLinearGradient2D.Create(p0,p1, - AffineMatrixTranslation(FCanvasOffset.x,FCanvasOffset.y)*currentState.matrix); - result.gammaCorrection := gradientGammaCorrection; -end; - -function TBGRACanvas2D.createLinearGradient(x0, y0, x1, y1: single; - Colors: TBGRACustomGradient): IBGRACanvasGradient2D; -begin - result := createLinearGradient(x0,y0,x1,y1); - result.setColors(Colors); -end; - -function TBGRACanvas2D.createLinearGradient(p0, p1: TPointF; - Colors: TBGRACustomGradient): IBGRACanvasGradient2D; -begin - result := createLinearGradient(p0,p1); - result.setColors(Colors); -end; - -function TBGRACanvas2D.createRadialGradient(x0, y0, r0, x1, y1, r1: single; - flipGradient: boolean): IBGRACanvasGradient2D; -begin - result := createRadialGradient(PointF(x0,y0), r0, PointF(x1,y1), r1, flipGradient); -end; - -function TBGRACanvas2D.createRadialGradient(p0: TPointF; r0: single; - p1: TPointF; r1: single; flipGradient: boolean): IBGRACanvasGradient2D; -begin - result := TBGRACanvasRadialGradient2D.Create(p0,r0,p1,r1, - AffineMatrixTranslation(FCanvasOffset.x,FCanvasOffset.y)*currentState.matrix, - flipGradient); - result.gammaCorrection := gradientGammaCorrection; -end; - -function TBGRACanvas2D.createRadialGradient(x0, y0, r0, x1, y1, r1: single; - Colors: TBGRACustomGradient; flipGradient: boolean): IBGRACanvasGradient2D; -begin - result := createRadialGradient(x0,y0,r0,x1,y1,r1,flipGradient); - result.setColors(Colors); -end; - -function TBGRACanvas2D.createRadialGradient(p0: TPointF; r0: single; - p1: TPointF; r1: single; Colors: TBGRACustomGradient; flipGradient: boolean): IBGRACanvasGradient2D; -begin - result := createRadialGradient(p0,r0,p1,r1,flipGradient); - result.setColors(Colors); -end; - -function TBGRACanvas2D.createPattern(image: TBGRACustomBitmap; repetition: string - ): IBGRACanvasTextureProvider2D; -var - repeatX,repeatY: boolean; - origin: TPointF; -begin - repetition := lowercase(trim(repetition)); - repeatX := true; - repeatY := true; - if repetition = 'repeat-x' then repeatY := false else - if repetition = 'repeat-y' then repeatX := false else - if repetition = 'no-repeat' then - begin - repeatX := false; - repeatY := false; - end; - origin := ApplyTransform(PointF(0,0)); - result := TBGRACanvasPattern2D.Create(image,repeatX,repeatY, - origin, origin+PointF(currentState.matrix[1,1],currentState.matrix[2,1])*image.Width, - origin+PointF(currentState.matrix[1,2],currentState.matrix[2,2])*image.Height); -end; - -function TBGRACanvas2D.createPattern(texture: IBGRAScanner - ): IBGRACanvasTextureProvider2D; -var - tempTransform: TAffineMatrix; -begin - tempTransform := AffineMatrixTranslation(FCanvasOffset.X+0.5,FCanvasOffset.Y+0.5)*currentState.matrix; - result := TBGRACanvasPattern2D.Create(texture,tempTransform); -end; - -procedure TBGRACanvas2D.fillRect(x, y, w, h: single); -begin - if (w=0) or (h=0) then exit; - FillPoly(ApplyTransform([PointF(x,y),PointF(x+w,y),PointF(x+w,y+h),PointF(x,y+h)])); -end; - -procedure TBGRACanvas2D.strokeRect(x, y, w, h: single); -begin - if (w=0) or (h=0) then exit; - StrokePoly(ApplyTransform([PointF(x,y),PointF(x+w,y),PointF(x+w,y+h),PointF(x,y+h),PointF(x,y)])); -end; - -procedure TBGRACanvas2D.clearRect(x, y, w, h: single); -begin - if (w=0) or (h=0) then exit; - ClearPoly(ApplyTransform([PointF(x,y),PointF(x+w,y),PointF(x+w,y+h),PointF(x,y+h)])); -end; - -procedure TBGRACanvas2D.addPath(APath: IBGRAPath); -begin - if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then - begin - AddPoint(EmptyPointF); - FLastCoord := EmptyPointF; - FStartCoord := EmptyPointF; - end; - APath.copyTo(self); -end; - -procedure TBGRACanvas2D.addPath(ASvgPath: string); -var p: TBGRAPath; -begin - p := TBGRAPath.Create(ASvgPath); - addPath(p); - p.Free; -end; - -procedure TBGRACanvas2D.path(APath: IBGRAPath); -begin - beginPath; - addPath(APath); -end; - -procedure TBGRACanvas2D.path(ASvgPath: string); -begin - beginPath; - addPath(ASvgPath); -end; - -procedure TBGRACanvas2D.beginPath; -begin - FPathPointCount := 0; - FLastCoord := EmptyPointF; - FStartCoord := EmptyPointF; - FTextPaths := nil; -end; - -procedure TBGRACanvas2D.closePath; -var i: integer; -begin - if FPathPointCount > 0 then - begin - i := FPathPointCount-1; - while (i > 0) and not isEmptyPointF(FPathPoints[i-1]) do dec(i); - AddPoint(FPathPoints[i]); - FLastCoord := FStartCoord; - end; -end; - -procedure TBGRACanvas2D.toSpline(closed: boolean; style: TSplineStyle); -var i,j: integer; - pts, splinePts: array of TPointF; - nb: integer; -begin - if FPathPointCount > 0 then - begin - i := FPathPointCount-1; - while (i > 0) and not isEmptyPointF(FPathPoints[i-1]) do dec(i); - nb := FPathPointCount - i; - setlength(pts,nb); - for j := 0 to nb-1 do - pts[j] := FPathPoints[i+j]; - if closed then - splinePts := BGRAPath.ComputeClosedSpline(pts,style) - else - splinePts := BGRAPath.ComputeOpenedSpline(pts,style); - dec(FPathPointCount,nb); - AddPoints(splinePts); - end; -end; - -procedure TBGRACanvas2D.moveTo(x, y: single); -begin - moveTo(PointF(x,y)); -end; - -procedure TBGRACanvas2D.lineTo(x, y: single); -begin - lineTo(PointF(x,y)); -end; - -procedure TBGRACanvas2D.moveTo(constref pt: TPointF); -begin - if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then - AddPoint(EmptyPointF); - AddPoint(ApplyTransform(pt)); - FStartCoord := pt; - FLastCoord := pt; -end; - -procedure TBGRACanvas2D.lineTo(constref pt: TPointF); -begin - AddPoint(ApplyTransform(pt)); - FLastCoord := pt; -end; - -procedure TBGRACanvas2D.polylineTo(const pts: array of TPointF); -begin - if length(pts)> 0 then - begin - AddPoints(ApplyTransform(pts)); - FLastCoord := pts[high(pts)]; - end; -end; - -procedure TBGRACanvas2D.quadraticCurveTo(cpx, cpy, x, y: single); -var - curve : TQuadraticBezierCurve; - pts : array of TPointF; -begin - curve := BezierCurve(ApplyTransform(GetPenPos(cpx,cpy)),ApplyTransform(PointF(cpx,cpy)),ApplyTransform(PointF(x,y))); - pts := BGRAPath.ComputeBezierCurve(curve); - AddPoints(pts); - FLastCoord := PointF(x,y); -end; - -procedure TBGRACanvas2D.quadraticCurveTo(constref cp, pt: TPointF); -begin - quadraticCurveTo(cp.x,cp.y,pt.x,pt.y); -end; - -procedure TBGRACanvas2D.bezierCurveTo(cp1x, cp1y, cp2x, cp2y, x, y: single); -var - curve : TCubicBezierCurve; - pts : array of TPointF; -begin - curve := BezierCurve(ApplyTransform(GetPenPos(cp1x,cp1y)),ApplyTransform(PointF(cp1x,cp1y)), - ApplyTransform(PointF(cp2x,cp2y)),ApplyTransform(PointF(x,y))); - pts := BGRAPath.ComputeBezierCurve(curve); - AddPoints(pts); - FLastCoord := PointF(x,y); -end; - -procedure TBGRACanvas2D.bezierCurveTo(constref cp1, cp2, pt: TPointF); -begin - bezierCurveTo(cp1.x,cp1.y,cp2.x,cp2.y,pt.x,pt.y); -end; - -procedure TBGRACanvas2D.rect(x, y, w, h: single); -begin - MoveTo(x,y); - LineTo(x+w,y); - LineTo(x+w,y+h); - LineTo(x,y+h); - closePath; -end; - -procedure TBGRACanvas2D.roundRect(x, y, w, h, radius: single); -begin - if radius <= 0 then - begin - rect(x,y,w,h); - exit; - end; - if (w <= 0) or (h <= 0) then exit; - if radius*2 > w then radius := w/2; - if radius*2 > h then radius := h/2; - moveTo(x+radius,y); - arcTo(PointF(x+w,y),PointF(x+w,y+h), radius); - arcTo(PointF(x+w,y+h),PointF(x,y+h), radius); - arcTo(PointF(x,y+h),PointF(x,y), radius); - arcTo(PointF(x,y),PointF(x+w,y), radius); - closePath; -end; - -procedure TBGRACanvas2D.roundRect(x, y, w, h, rx, ry: single); -begin - if (w <= 0) or (h <= 0) then exit; - if rx < 0 then rx := 0; - if ry < 0 then ry := 0; - if (rx = 0) and (ry = 0) then - begin - rect(x,y,w,h); - exit; - end; - if rx*2 > w then rx := w/2; - if ry*2 > h then ry := h/2; - moveTo(x+rx,y); - lineTo(x+w-rx,y); - arcTo(rx,ry,0,false,false,x+w,y+ry); - lineTo(x+w,y+h-ry); - arcTo(rx,ry,0,false,false,x+w-rx,y+h); - lineTo(x+rx,y+h); - arcTo(rx,ry,0,false,false,x,y+h-ry); - lineTo(x,y+ry); - arcTo(rx,ry,0,false,false,x+rx,y); - closePath; -end; - -procedure TBGRACanvas2D.openedSpline(const pts: array of TPointF; - style: TSplineStyle); -var transf: array of TPointF; -begin - if length(pts)=0 then exit; - transf := ApplyTransform(pts); - transf := BGRAPath.ComputeOpenedSpline(transf,style); - AddPoints(transf); - FLastCoord := pts[high(pts)]; -end; - -procedure TBGRACanvas2D.closedSpline(const pts: array of TPointF; - style: TSplineStyle); -var transf: array of TPointF; -begin - if length(pts)=0 then exit; - transf := ApplyTransform(pts); - transf := BGRAPath.ComputeClosedSpline(slice(transf, length(transf)-1),style); - AddPoints(transf); - FLastCoord := pts[high(pts)]; -end; - -procedure TBGRACanvas2D.spline(const pts: array of TPointF; style: TSplineStyle); -var transf: array of TPointF; -begin - if length(pts)=0 then exit; - transf := ApplyTransform(pts); - if (pts[0] = pts[high(pts)]) and (length(pts) > 1) then - transf := BGRAPath.ComputeClosedSpline(slice(transf, length(transf)-1),style) - else - transf := BGRAPath.ComputeOpenedSpline(transf,style); - AddPoints(transf); - FLastCoord := pts[high(pts)]; -end; - -procedure TBGRACanvas2D.splineTo(const pts: array of TPointF; - style: TSplineStyle); -var transf: array of TPointF; - i: Integer; -begin - if length(pts) = 0 then exit; - transf := ApplyTransform(pts); - if FPathPointCount <> 0 then - begin - setlength(transf,length(transf)+1); - for i := high(transf) downto 1 do - transf[i]:= transf[i-1]; - transf[0] := ApplyTransform(GetPenPos(pts[0].x,pts[0].y)); - end; - transf := BGRAPath.ComputeOpenedSpline(transf,style); - AddPoints(transf); - FLastCoord := pts[high(pts)]; -end; - -procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single; - anticlockwise: boolean); -var pts: array of TPointF; - temp: single; - pt: TPointF; - rx,ry: single; - len1,len2: single; - unitAffine: TAffineMatrix; - v1orig,v2orig,v1ortho,v2ortho: TPointF; - startRadCCW,endRadCCW: single; -begin - v1orig := PointF(currentState.matrix[1,1],currentState.matrix[2,1]); - v2orig := PointF(currentState.matrix[1,2],currentState.matrix[2,2]); - len1 := VectLen(v1orig); - len2 := VectLen(v2orig); - rx := len1*radius; - ry := len2*radius; - if len1 <> 0 then v1ortho := v1orig * (1/len1) else v1ortho := v1orig; - if len2 <> 0 then v2ortho := v2orig * (1/len2) else v2ortho := v2orig; - pt := currentState.matrix* PointF(x,y); - unitAffine := AffineMatrix(v1ortho.x, v2ortho.x, pt.x, - v1ortho.y, v2ortho.y, pt.y); - startRadCCW := -startAngleRadCW; - endRadCCW := -endAngleRadCW; - if not anticlockwise then - begin - temp := startRadCCW; - startRadCCW := endRadCCW; - endRadCCW:= temp; - pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW); - pts := ApplyTransform(pts,unitAffine); - AddPointsRev(pts); - end else - begin - pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW); - pts := ApplyTransform(pts,unitAffine); - AddPoints(pts); - end; - FLastCoord := ArcEndPoint(ArcDef(x,y,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise)); -end; - -procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single); -begin - arc(x,y,radius,startAngleRadCW,endAngleRadCW,false); -end; - -procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; - anticlockwise: boolean); -begin - arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise)) -end; - -procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); -begin - arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false)) -end; - -procedure TBGRACanvas2D.arc(constref arcDef: TArcDef); -var previousMatrix: TAffineMatrix; -begin - if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then - lineTo(arcDef.center) else - begin - previousMatrix := currentState.matrix; - translate(arcDef.center.x,arcDef.center.y); - rotate(arcDef.xAngleRadCW); - scale(arcDef.radius.x,arcDef.radius.y); - arc(0,0,1,arcDef.startAngleRadCW,arcDef.endAngleRadCW,arcDef.anticlockwise); - currentState.matrix := previousMatrix; - FLastCoord := ArcEndPoint(arcDef); - end; -end; - -procedure TBGRACanvas2D.arcTo(x1, y1, x2, y2, radius: single); -var p0: TPointF; -begin - p0 := GetPenPos(x1,y1); - arc(Html5ArcTo(p0,PointF(x1,y1),PointF(x2,y2),radius)); -end; - -procedure TBGRACanvas2D.arcTo(p1, p2: TPointF; radius: single); -begin - arcTo(p1.x,p1.y,p2.x,p2.y,radius); -end; - -procedure TBGRACanvas2D.arcTo(rx, ry, xAngleRadCW: single; largeArc, - anticlockwise: boolean; x, y: single); -begin - arc(SvgArcTo(GetPenPos(x,y), rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y))); - FLastCoord := PointF(x,y); -end; - -procedure TBGRACanvas2D.circle(x, y, r: single); -begin - arc(x,y,r,0,0); -end; - -procedure TBGRACanvas2D.ellipse(x, y, rx, ry: single); -begin - arc(x,y,rx,ry,0,0,0); -end; - -procedure TBGRACanvas2D.text(AText: string; x, y: single); -var renderer : TBGRACustomFontRenderer; - previousMatrix: TAffineMatrix; - fva: TFontVerticalAnchor; -begin - renderer := fontRenderer; - if renderer = nil then exit; - if renderer.FontEmHeight <= 0 then exit; - - case currentState.textBaseline of - 'bottom': fva := fvaBottom; - 'middle': fva := fvaCenter; - 'alphabetic': fva := fvaBaseline; - else {'top','hanging'} - fva := fvaTop; - end; - - if renderer.HandlesTextPath then - begin - previousMatrix := currentState.matrix; - translate(x,y); - scale(currentState.fontEmHeight/renderer.FontEmHeight); - if fva <> fvaTop then - with renderer.GetFontPixelMetric do - case fva of - fvaBottom: translate(0,-Lineheight); - fvaCenter: translate(0,-Lineheight/2); - fvaBaseline: translate(0,-baseline); - end; - if direction=fbmAuto then - renderer.CopyTextPathTo(self, 0,0, AText, textAlignLCL) - else - renderer.CopyTextPathTo(self, 0,0, AText, textAlignLCL, direction=fbmRightToLeft); - currentState.matrix := previousMatrix; - end else - begin - setlength(FTextPaths, length(FTextPaths)+1); - FTextPaths[high(FTextPaths)].Text := AText; - FTextPaths[high(FTextPaths)].FontName := fontName; - FTextPaths[high(FTextPaths)].FontMatrix := currentState.matrix*AffineMatrixTranslation(x,y)*AffineMatrixScale(fontEmHeight,fontEmHeight); - FTextPaths[high(FTextPaths)].FontStyle := fontStyle; - FTextPaths[high(FTextPaths)].FontAlign := textAlignLCL; - FTextPaths[high(FTextPaths)].FontAnchor := fva; - FTextPaths[high(FTextPaths)].TextDirection := direction; - end; - - FLastCoord := EmptyPointF; - FStartCoord := EmptyPointF; -end; - -procedure TBGRACanvas2D.fillText(AText: string; x, y: single); -begin - beginPath; - text(AText,x,y); - fill; - beginPath; -end; - -procedure TBGRACanvas2D.strokeText(AText: string; x, y: single); -begin - beginPath; - text(AText,x,y); - stroke; - beginPath; -end; - -function TBGRACanvas2D.measureText(AText: string): TCanvas2dTextSize; -var renderer: TBGRACustomFontRenderer; - ratio: Single; -begin - renderer := fontRenderer; - if renderer <> nil then - begin - if renderer.FontEmHeight = 0 then - begin - result.width := 0; - result.height:= 0; - end else - with renderer.TextSize(AText) do - begin - ratio := currentState.fontEmHeight/renderer.FontEmHeight; - result.width := cx*ratio; - result.height:= cy*ratio; - end; - end - else - begin - result.width := 0; - result.height := 0; - end; -end; - -procedure TBGRACanvas2D.fill; -begin - if FPathPointCount > 0 then - FillPoly(slice(FPathPoints,FPathPointCount)); - FillTexts(false); -end; - -procedure TBGRACanvas2D.stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); -begin - stroke(ADrawProc, AffineMatrixIdentity, AData); -end; - -procedure TBGRACanvas2D.stroke(ADrawProc: TBGRAPathDrawProc; - const AMatrix: TAffineMatrix; AData: pointer); -var - startIndex: integer; - - procedure CallStrokeProc(AEndIndex: integer); - var - j: Integer; - subPts: array of TPointF; - closed: boolean; - begin - closed := false; - while (AEndIndex>startIndex) - and (FPathPoints[AEndIndex-1]=FPathPoints[startIndex]) do - begin - dec(AEndIndex); - closed := true; - end; - if AEndIndex > startIndex then - begin - setlength(subPts, AEndIndex-startIndex); - if IsAffineMatrixIdentity(AMatrix) then - begin - for j := 0 to high(subPts) do - subPts[j] := FPathPoints[startIndex+j]; - end else - for j := 0 to high(subPts) do - subPts[j] := AMatrix*FPathPoints[startIndex+j]; - ADrawProc(subPts, closed, AData); - end; - end; - -var i: integer; -begin - startIndex := 0; - for i := 0 to FPathPointCount-1 do - if isEmptyPointF(FPathPoints[i]) then - begin - CallStrokeProc(i); - startIndex := i+1; - end; - CallStrokeProc(FPathPointCount); -end; - -procedure TBGRACanvas2D.stroke; -begin - if FPathPointCount > 0 then - StrokePoly(slice(FPathPoints,FPathPointCount)); -end; - -procedure TBGRACanvas2D.fill(AFillProc: TBGRAPathFillProc; AData: pointer); -begin - fill(AFillProc, AffineMatrixIdentity, AData); -end; - -procedure TBGRACanvas2D.fill(AFillProc: TBGRAPathFillProc; - const AMatrix: TAffineMatrix; AData: pointer); -var - startIndex: integer; - - procedure CallFillProc(AEndIndex: integer); - var - j: Integer; - subPts: array of TPointF; - begin - if AEndIndex > startIndex then - begin - setlength(subPts, AEndIndex-startIndex); - if IsAffineMatrixIdentity(AMatrix) then - begin - for j := 0 to high(subPts) do - subPts[j] := FPathPoints[startIndex+j]; - end else - for j := 0 to high(subPts) do - subPts[j] := AMatrix*FPathPoints[startIndex+j]; - - AFillProc(subPts, AData); - end; - end; - -var i: integer; -begin - startIndex := 0; - for i := 0 to FPathPointCount-1 do - if isEmptyPointF(FPathPoints[i]) then - begin - CallFillProc(i); - startIndex := i+1; - end; - CallFillProc(FPathPointCount); -end; - -procedure TBGRACanvas2D.fillOverStroke; -begin - if FPathPointCount > 0 then - FillStrokePoly(slice(FPathPoints,FPathPointCount),true); - FillTexts(false); -end; - -procedure TBGRACanvas2D.strokeOverFill; -begin - FillTexts(false); - if FPathPointCount > 0 then - FillStrokePoly(slice(FPathPoints,FPathPointCount),false); -end; - -procedure TBGRACanvas2D.clearPath; -begin - if FPathPointCount > 0 then - ClearPoly(slice(FPathPoints,FPathPointCount)); - FillTexts(true); -end; - -procedure TBGRACanvas2D.clip; -var - tempBmp: TGrayscaleMask; -begin - if FPathPointCount = 0 then - begin - if currentState.clipMaskReadOnly <> nil then - currentState.clipMaskReadWrite.Fill(BGRABlack); - exit; - end; - if currentState.clipMaskReadOnly = nil then - currentState.SetClipMask(TGrayscaleMask.Create(width,height,BGRAWhite),True); - tempBmp := TGrayscaleMask.Create(width,height,BGRABlack); - if antialiasing then - tempBmp.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite) - else - tempBmp.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite); - currentState.clipMaskReadWrite.ApplyMask(tempBmp); - tempBmp.Free; -end; - -procedure TBGRACanvas2D.unclip; -begin - if FPathPointCount = 0 then exit; - if currentState.clipMaskReadOnly = nil then exit; - if antialiasing then - currentState.clipMaskReadWrite.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite) - else - currentState.clipMaskReadWrite.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet); - if currentState.clipMaskReadOnly.Equals(BGRAWhite) then - currentState.SetClipMask(nil,true); -end; - -function TBGRACanvas2D.isPointInPath(x, y: single): boolean; -begin - result := isPointInPath(PointF(x,y)); -end; - -function TBGRACanvas2D.isPointInPath(pt: TPointF): boolean; -begin - if FPathPointCount <= 2 then - result := false - else - begin - setlength(FPathPoints,FPathPointCount); - result := IsPointInPolygon(FPathPoints,pt+FCanvasOffset, fillMode = fmWinding); - end; -end; - -procedure TBGRACanvas2D.drawImage(image: TBGRACustomBitmap; dx, dy: single; AFilter: TResampleFilter); -var - m: TAffineMatrix; -begin - if (image.Width = 0) or (image.Height = 0) then exit; - m := matrix*AffineMatrixTranslation(dx, dy); - if pixelCenteredCoordinates then - m := AffineMatrixTranslation(0.5, 0.5)*m; - Surface.PutImageAffine(m, image, AFilter, GetDrawMode, currentState.globalAlpha, false); -end; - -procedure TBGRACanvas2D.drawImage(image: TBGRACustomBitmap; dx, dy, dw, dh: single; AFilter: TResampleFilter); -var - m: TAffineMatrix; -begin - if (image.Width = 0) or (image.Height = 0) then exit; - m := matrix*AffineMatrixTranslation(dx, dy)*AffineMatrixScale(dw/image.Width,dh/image.Height); - if pixelCenteredCoordinates then - m := AffineMatrixTranslation(0.5, 0.5)*m; - Surface.PutImageAffine(m, image, AFilter, GetDrawMode, currentState.globalAlpha, false); -end; - -end. - diff --git a/components/bgrabitmap/bgracanvasgl.pas b/components/bgrabitmap/bgracanvasgl.pas deleted file mode 100644 index b6ecd28..0000000 --- a/components/bgrabitmap/bgracanvasgl.pas +++ /dev/null @@ -1,1840 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRACanvasGL; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, - BGRAOpenGLType, BGRATransform, BGRAPath, - BGRASSE, BGRAMatrix3D; - -type - TBGLPath = class; - TBGLCustomCanvas = class; - - TBGLCustomShader = class - protected - procedure StartUse; virtual; abstract; - procedure EndUse; virtual; abstract; - end; - - TBGLCustomArray = class - protected - FBuffer: LongWord; - function GetCount: integer; virtual; abstract; - function GetRecordSize: integer; virtual; abstract; - public - constructor Create(ABufferAddress: pointer; ACount: integer; ARecordSize: integer); virtual; abstract; - property Count: integer read GetCount; - property RecordSize: integer read GetRecordSize; - property Handle: LongWord read FBuffer; - end; - - { TAttributeVariable } - - TAttributeVariable = object - protected - FOwner: TObject; - FAttribute: LongWord; - FVectorSize: integer; - FArray: TBGLCustomArray; - FRecordOffset: integer; - FFloat: boolean; - procedure Init(AOwner: TObject; AAttribute: LongWord; AVectorSize: integer; - AFloat: boolean); - public - property Source: TBGLCustomArray read FArray write FArray; - property RecordOffset: integer read FRecordOffset write FRecordOffset; - property Handle: LongWord read FAttribute; - property VectorSize: integer read FVectorSize; - property IsFloat: boolean read FFloat; - property Owner: TObject read FOwner; - end; - - TBGLCustomElementArray = class - protected - function GetCount: integer; virtual; abstract; - public - constructor Create(const AElements: array of integer); virtual; abstract; - procedure Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable); virtual; abstract; - property Count: integer read GetCount; - end; - - { TBGLCustomLighting } - - TBGLCustomLighting = class - private - FCurrentShader: TBGLCustomShader; - function GetActiveShader: TBGLCustomShader; - procedure SetActiveShader(AValue: TBGLCustomShader); - protected - function GetSupportShaders: boolean; virtual; - function GetShader(AName: string): TBGLCustomShader; - procedure SetShader(AName: string; AValue: TBGLCustomShader); - procedure SetAmbiantLightF(AAmbiantLight: TColorF); virtual; abstract; - function GetAmbiantLightF: TColorF; virtual; abstract; - function GetBuiltInLightingEnabled: boolean; virtual; abstract; - procedure SetBuiltInLightingEnabled(AValue: boolean); virtual; abstract; - public - ShaderList: TStringList; - destructor Destroy; override; - function AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer; virtual; abstract; - function AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer; virtual; abstract; - procedure ClearLights; virtual; abstract; - function RemoveLight(AIndex: integer): boolean; virtual; abstract; - procedure SetSpecularIndex(AIndex: integer); virtual; abstract; - - function MakeVertexShader(ASource: string): LongWord; virtual; abstract; - function MakeFragmentShader(ASource: string): LongWord; virtual; abstract; - function MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord; virtual; abstract; - procedure DeleteShaderObject(AShader: LongWord); virtual; abstract; - procedure DeleteShaderProgram(AProgram: LongWord); virtual; abstract; - procedure UseProgram(AProgram: LongWord); virtual; abstract; - function GetUniformVariable(AProgram: LongWord; AName: string): LongWord; virtual; abstract; - function GetAttribVariable(AProgram: LongWord; AName: string): LongWord; virtual; abstract; - procedure SetUniformSingle(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); virtual; abstract; - procedure SetUniformInteger(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); virtual; abstract; - procedure BindAttribute(AAttribute: TAttributeVariable); virtual; abstract; - procedure UnbindAttribute(AAttribute: TAttributeVariable); virtual; abstract; - procedure FreeShaders; - property ActiveShader: TBGLCustomShader read GetActiveShader write SetActiveShader; - property Shader[AName: string]: TBGLCustomShader read GetShader write SetShader; - property SupportShaders: boolean read GetSupportShaders; - property AmbiantLightF: TColorF read GetAmbiantLightF write SetAmbiantLightF; - property BuiltInLightingEnabled: boolean read GetBuiltInLightingEnabled write SetBuiltInLightingEnabled; - end; - - { TBGLCustomCanvas } - - TBGLCustomCanvas = class - private - FActiveFrameBuffer: TBGLCustomFrameBuffer; - FHeight: integer; - FWidth: integer; - FNoClip: boolean; - FClipRect: TRect; - protected - procedure SwapRect(var r: TRect); overload; - procedure SwapRect(var x1,y1,x2,y2: single); overload; - procedure InternalArc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; ABorderColor,AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false); overload; - procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor,AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false); overload; - procedure InternalArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; ABorderColor,AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false); overload; - function ComputeEllipseC(r: TRect; AHasBorder: boolean; out cx,cy,rx,ry: single): boolean; - function GetHeight: integer; virtual; - function GetWidth: integer; virtual; - procedure SetWidth(AValue: integer); virtual; - procedure SetHeight(AValue: integer); virtual; - function GetClipRect: TRect; - procedure SetClipRect(AValue: TRect); - procedure EnableScissor(AValue: TRect); virtual; abstract; - procedure DisableScissor; virtual; abstract; - function GetMatrix: TAffineMatrix; virtual; abstract; - procedure SetMatrix(const AValue: TAffineMatrix); virtual; abstract; - function GetProjectionMatrix: TMatrix4D; virtual; - procedure SetProjectionMatrix(const {%H-}AValue: TMatrix4D); virtual; - procedure SetBlendMode(AValue: TOpenGLBlendMode); virtual; abstract; - function GetBlendMode: TOpenGLBlendMode; virtual; abstract; - function GetFaceCulling: TFaceCulling; virtual; abstract; - procedure SetFaceCulling(AValue: TFaceCulling); virtual; abstract; - procedure SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); virtual; - - function GetLighting: TBGLCustomLighting; virtual; - - procedure InternalStartPutPixel(const pt: TPointF); virtual; abstract; - procedure InternalStartPolyline(const pt: TPointF); virtual; abstract; - procedure InternalStartPolygon(const pt: TPointF); virtual; abstract; - procedure InternalStartTriangleFan(const pt: TPointF); virtual; abstract; - procedure InternalContinueShape(const pt: TPointF); overload; virtual; abstract; - - procedure InternalContinueShape(const {%H-}pt: TPoint3D); overload; virtual; - procedure InternalContinueShape(const {%H-}pt: TPoint3D_128); overload; virtual; - procedure InternalContinueShape(const {%H-}pt, {%H-}normal: TPoint3D_128); overload; virtual; - - procedure InternalEndShape; virtual; abstract; - procedure InternalSetColor(const AColor: TBGRAPixel); virtual; abstract; - procedure InternalSetColorF(const AColor: TColorF); virtual; abstract; - - procedure InternalStartBlend; virtual; abstract; - procedure InternalEndBlend; virtual; abstract; - - procedure InternalStartBlendTriangles; virtual; abstract; - procedure InternalStartBlendQuads; virtual; abstract; - procedure InternalEndBlendTriangles; virtual; abstract; - procedure InternalEndBlendQuads; virtual; abstract; - public - constructor Create; - procedure Fill(AColor: TBGRAPixel); virtual; abstract; - - procedure PutPixels(const APoints: array of TPointF; AColor: TBGRAPixel); overload; virtual; - procedure PutPixels(const APoints: array of TPointF; const AColors: array of TBGRAPixel); overload; virtual; - - procedure Line(x1,y1,x2,y2: single; AColor: TBGRAPixel; ADrawLastPoint: boolean = true); overload; - procedure Line(p1,p2: TPointF; AColor: TBGRAPixel; ADrawLastPoint: boolean = true); overload; - procedure Polylines(const APoints: array of TPointF; AColor: TBGRAPixel; ADrawLastPoints: boolean = true); virtual; - - procedure Polygons(const APoints: array of TPointF; AColor: TBGRAPixel); virtual; - procedure FillPolyConvex(const APoints: array of TPointF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); - - procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; - procedure FillTriangles(const APoints: array of TPointF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillTrianglesLinearColor(const APoints: array of TPointF; const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillTrianglesLinearColor(const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); overload; virtual; - procedure FillTrianglesLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; - procedure FillTrianglesLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; - procedure FillTrianglesFan(const APoints: array of TPointF; ACenterColor, ABorderColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - - procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TColorF; APixelCenteredCoordinates: boolean = true); overload; - procedure FillTriangles(const APoints: array of TPointF; AColor: TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillTrianglesLinearColor(const APoints: array of TPointF; const AColors: array of TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillTrianglesLinearColor(const APoints: array of TPoint3D; const AColors: array of TColorF); overload; virtual; - procedure FillTrianglesLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; - procedure FillTrianglesLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; - procedure FillTrianglesFan(const APoints: array of TPointF; ACenterColor, ABorderColor: TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; - - procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; - procedure FillQuads(const APoints: array of TPointF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillQuadsLinearColor(const APoints: array of TPointF; const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillQuadsLinearColor(const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); overload; virtual; - procedure FillQuadsLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; - procedure FillQuadsLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); overload; virtual; - - procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TColorF; APixelCenteredCoordinates: boolean = true); overload; - procedure FillQuads(const APoints: array of TPointF; AColor: TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillQuadsLinearColor(const APoints: array of TPointF; const AColors: array of TColorF; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillQuadsLinearColor(const APoints: array of TPoint3D; const AColors: array of TColorF); overload; virtual; - procedure FillQuadsLinearColor(const APoints: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; - procedure FillQuadsLinearColor(const APoints, ANormals: array of TPoint3D_128; const AColors: array of TColorF); overload; virtual; - - procedure DrawPath(APath: TBGLPath; c: TBGRAPixel); - procedure FillPathConvex(APath: TBGLPath; c: TBGRAPixel; APixelCenteredCoordinates: boolean = true); - - procedure FillRectLinearColor(r: TRect; ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor: TBGRAPixel); overload; virtual; - procedure FillRectLinearColor(x1,y1,x2,y2: single; - ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor: TBGRAPixel; - APixelCenteredCoordinates: boolean = true); overload; virtual; - - procedure Ellipse(cx,cy,rx,ry: single; AColor: TBGRAPixel); overload; - procedure EllipseInRect(r: TRect; AColor: TBGRAPixel); overload; - procedure Ellipse(cx,cy,rx,ry: single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; - procedure EllipseInRect(r: TRect; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; - procedure EllipseLinearColor(cx,cy,rx,ry: single; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; - procedure EllipseLinearColorInRect(r: TRect; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; - procedure FillEllipse(cx,cy,rx,ry: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); - procedure FillEllipseInRect(r: TRect; AColor: TBGRAPixel); - procedure FillEllipseLinearColor(cx, cy, rx, ry: single; AOuterColor, AInnerColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); - procedure FillEllipseLinearColorInRect(r: TRect; AOuterColor, AInnerColor: TBGRAPixel); - - procedure Arc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; - procedure Arc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; - procedure ArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); - procedure ArcLinearColor(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; - procedure ArcLinearColor(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; - procedure ArcLinearColorInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, AInnerFillColor: TBGRAPixel); - - procedure Pie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; - procedure Pie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; - procedure PieInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); - procedure PieLinearColor(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; - procedure PieLinearColor(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); overload; - procedure PieLinearColorInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, AInnerFillColor: TBGRAPixel); - - procedure Rectangle(r: TRect; AColor: TBGRAPixel); overload; - procedure Rectangle(r: TRect; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; - procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel); overload; - procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); overload; - procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel; w: single; APixelCenteredCoordinates: boolean = true); overload; - procedure Rectangle(x1,y1,x2,y2: single; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; - procedure RectangleWithin(x1,y1,x2,y2: single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; - procedure RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; - procedure FillRect(x1,y1,x2,y2: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; - procedure FillRect(r: TRect; AColor: TBGRAPixel); overload; - procedure FillRect(r: TRectF; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean = false); overload; - procedure FillRect(r: TRect; AScanner: IBGRAScanner); overload; virtual; - procedure RoundRect(x1,y1,x2,y2,rx,ry: single; ABorderColor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; - procedure RoundRect(x1,y1,x2,y2,rx,ry: single; ABorderColor,AFillColor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; - procedure FillRoundRect(x,y,x2,y2,rx,ry: single; AFillColor: TBGRAPixel; options: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); - - procedure Frame3D(var bounds: TRect; width: integer; Style: TGraphicsBevelCut); overload; - procedure Frame3D(var bounds: TRect; width: integer; - Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); overload; - - procedure PutImage(x,y: single; ATexture: IBGLTexture; AAlpha: byte = 255); overload; - procedure PutImage(x,y: single; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; - procedure StretchPutImage(x,y,w,h: single; ATexture: IBGLTexture; AAlpha: byte = 255); overload; - procedure StretchPutImage(x,y,w,h: single; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; - procedure StretchPutImage(r: TRect; ATexture: IBGLTexture; AAlpha: byte = 255); overload; - procedure StretchPutImage(r: TRect; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; - procedure PutImageAngle(x,y: single; ATexture: IBGLTexture; angleDeg: single; AAlpha: byte = 255); overload; - procedure PutImageAngle(x,y: single; ATexture: IBGLTexture; angleDeg: single; AColor: TBGRAPixel); overload; - procedure PutImageAffine(const Origin, HAxis, VAxis: TPointF; ATexture: IBGLTexture; AAlpha: byte = 255); overload; - procedure PutImageAffine(const Origin, HAxis, VAxis: TPointF; ATexture: IBGLTexture; AColor: TBGRAPixel); overload; - procedure PutImageAffine(x,y: single; ATexture: IBGLTexture; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload; - procedure PutImageAffine(x,y: single; ATexture: IBGLTexture; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload; - - procedure Translate(x,y: single); virtual; - procedure Scale(sx,sy: single); virtual; - procedure RotateDeg(angleCW: single); virtual; - procedure RotateRad(angleCCW: single); virtual; - procedure ResetTransform; virtual; - - procedure UseOrthoProjection; overload; virtual; - procedure UseOrthoProjection(AMinX,AMinY,AMaxX,AMaxY: single); overload; virtual; - procedure StartZBuffer; virtual; - procedure EndZBuffer; virtual; - procedure WaitForGPU({%H-}AOption: TWaitForGPUOption); virtual; - - function GetImage({%H-}x,{%H-}y,{%H-}w,{%H-}h: integer): TBGRACustomBitmap; virtual; - function CreateFrameBuffer({%H-}AWidth,{%H-}AHeight: integer): TBGLCustomFrameBuffer; virtual; - - procedure NoClip; - property ActiveFrameBuffer: TBGLCustomFrameBuffer read FActiveFrameBuffer write SetActiveFrameBuffer; - property Width: integer read GetWidth write SetWidth; - property Height: integer read GetHeight write SetHeight; - property ClipRect: TRect read GetClipRect write SetClipRect; - property Matrix: TAffineMatrix read GetMatrix write SetMatrix; - property ProjectionMatrix: TMatrix4D read GetProjectionMatrix write SetProjectionMatrix; - property BlendMode: TOpenGLBlendMode read GetBlendMode write SetBlendMode; - property FaceCulling: TFaceCulling read GetFaceCulling write SetFaceCulling; - property Lighting: TBGLCustomLighting read GetLighting; - end; - - { TBGLPath } - - TBGLPath = class(TBGRAPath) - private - procedure GLDrawProc(const APoints: array of TPointF; AClosed: boolean; AData: pointer); - procedure GLFillProc(const APoints: array of TPointF; AData: pointer); - public - procedure stroke(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1); overload; - procedure fillConvex(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1; APixelCenteredCoordinates: boolean = true); - end; - -implementation - -uses Math, BGRAGradientScanner; - -type - TGLStrokeData = record - Color: TBGRAPixel; - Canvas: TBGLCustomCanvas; - end; - TGLFillData = record - Color: TBGRAPixel; - Canvas: TBGLCustomCanvas; - PixelCenteredCoordinates: boolean; - end; - -{ TAttributeVariable } - -procedure TAttributeVariable.Init(AOwner: TObject; AAttribute: LongWord; - AVectorSize: integer; AFloat: boolean); -begin - FOwner := AOwner; - FAttribute:= AAttribute; - FVectorSize:= AVectorSize; - FFloat := AFloat; - FArray := nil; - FRecordOffset := 0; -end; - -{ TBGLCustomLighting } - -function TBGLCustomLighting.GetActiveShader: TBGLCustomShader; -begin - result := FCurrentShader; -end; - -function TBGLCustomLighting.GetSupportShaders: boolean; -begin - result := false; -end; - -function TBGLCustomLighting.GetShader(AName: string): TBGLCustomShader; -var index: integer; -begin - if ShaderList = nil then ShaderList := TStringList.Create; - index := ShaderList.IndexOf(AName); - if index = -1 then - result := nil - else - result := TBGLCustomShader(ShaderList.Objects[index]); -end; - -procedure TBGLCustomLighting.SetShader(AName: string; AValue: TBGLCustomShader); -var index: integer; -begin - if ShaderList = nil then ShaderList := TStringList.Create; - index := ShaderList.IndexOf(AName); - if AValue = nil then - begin - if index <> -1 then - ShaderList.Delete(index); - end else - begin - if index = -1 then - ShaderList.AddObject(AName,AValue) - else - ShaderList.Objects[index] := AValue; - end; -end; - -destructor TBGLCustomLighting.Destroy; -begin - FreeShaders; - FreeAndNil(ShaderList); - inherited Destroy; -end; - -procedure TBGLCustomLighting.FreeShaders; -var i: integer; -begin - if Assigned(ShaderList) then - begin - for i := 0 to ShaderList.Count-1 do - ShaderList.Objects[i].Free; - ShaderList.Clear; - end; -end; - -procedure TBGLCustomLighting.SetActiveShader(AValue: TBGLCustomShader); -begin - if AValue <> FCurrentShader then - begin - if Assigned(FCurrentShader) then FCurrentShader.EndUse; - FCurrentShader := AValue; - if Assigned(FCurrentShader) then FCurrentShader.StartUse; - end; -end; - -{ TBGLPath } - -procedure TBGLPath.GLDrawProc(const APoints: array of TPointF; - AClosed: boolean; AData: pointer); -begin - with TGLStrokeData(AData^) do - if AClosed then - Canvas.Polygons(APoints, Color) - else - Canvas.Polylines(APoints, Color); -end; - -procedure TBGLPath.GLFillProc(const APoints: array of TPointF; AData: pointer); -begin - with TGLFillData(AData^) do - Canvas.FillPolyConvex(APoints,Color,PixelCenteredCoordinates); -end; - -procedure TBGLPath.stroke(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single); -var data: TGLStrokeData; -begin - data.Color := AColor; - data.Canvas := ACanvas; - stroke(@GLDrawProc, AffineMatrixIdentity, AAcceptedDeviation, @data); -end; - -procedure TBGLPath.fillConvex(ACanvas: TBGLCustomCanvas; AColor: TBGRAPixel; AAcceptedDeviation: single; APixelCenteredCoordinates: boolean); -var data: TGLFillData; -begin - data.Color := AColor; - data.Canvas := ACanvas; - data.PixelCenteredCoordinates := APixelCenteredCoordinates; - fill(@GLFillProc, AffineMatrixIdentity, AAcceptedDeviation, @data); -end; - -{ TBGLCustomCanvas } - -function TBGLCustomCanvas.ComputeEllipseC(r: TRect; AHasBorder: boolean; out - cx, cy, rx, ry: single): boolean; -begin - if (r.right = r.left) or (r.bottom = r.top) then - begin - cx := r.left; - cy := r.top; - rx := 0; - ry := 0; - exit; - end; - SwapRect(r); - cx := (r.left+r.right-1)*0.5; - cy := (r.top+r.bottom-1)*0.5; - rx := (r.right-r.left)*0.5; - ry := (r.bottom-r.top)*0.5; - if AHasBorder then - begin - DecF(rx, 0.5); - if rx < 0 then rx := 0; - DecF(ry, 0.5); - if ry < 0 then ry := 0; - end; - result := true; -end; - -function TBGLCustomCanvas.GetHeight: integer; -begin - if FActiveFrameBuffer = nil then - result := FHeight - else - result := FActiveFrameBuffer.Height; -end; - -function TBGLCustomCanvas.GetWidth: integer; -begin - if FActiveFrameBuffer = nil then - result := FWidth - else - result := FActiveFrameBuffer.Width; -end; - -procedure TBGLCustomCanvas.SetWidth(AValue: integer); -begin - if FWidth=AValue then Exit; - FWidth:=AValue; -end; - -procedure TBGLCustomCanvas.SetHeight(AValue: integer); -begin - if FHeight=AValue then Exit; - FHeight:=AValue; -end; - -function TBGLCustomCanvas.GetClipRect: TRect; -begin - if FNoClip then - result := rect(0,0,Width,Height) - else - result := FClipRect; -end; - -procedure TBGLCustomCanvas.SetClipRect(AValue: TRect); -begin - SwapRect(AValue); - with ClipRect do - if (AValue.left = left) and (AValue.top = top) and (AValue.bottom = bottom) - and (AValue.right = right) then exit; - - if (AValue.Left = 0) and (AValue.Top = 0) and - (AValue.Right = Width) and (AValue.Bottom = Height) then - NoClip - else - begin - FClipRect := AValue; - EnableScissor(FClipRect); - end; -end; - -function TBGLCustomCanvas.GetProjectionMatrix: TMatrix4D; -begin - result := MatrixIdentity4D; -end; - -procedure TBGLCustomCanvas.SetProjectionMatrix(const AValue: TMatrix4D); -begin - raise exception.Create('Not implemented'); -end; - -function TBGLCustomCanvas.GetLighting: TBGLCustomLighting; -begin - result := nil; - raise exception.Create('Not implemented'); -end; - -procedure TBGLCustomCanvas.InternalContinueShape(const pt: TPoint3D); -begin - raise exception.Create('Not available'); -end; - -procedure TBGLCustomCanvas.InternalContinueShape(const pt: TPoint3D_128); -begin - raise exception.Create('Not available'); -end; - -procedure TBGLCustomCanvas.InternalContinueShape(const pt, normal: TPoint3D_128); -begin - raise exception.Create('Not available'); -end; - -procedure TBGLCustomCanvas.NoClip; -begin - FClipRect := rect(0,0,Width,Height); - FNoClip := true; - DisableScissor; -end; - -constructor TBGLCustomCanvas.Create; -begin - FNoClip:= true; -end; - -procedure TBGLCustomCanvas.FillTriangles(const APoints: array of TPointF; - AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if (length(APoints) < 3) or (AColor.alpha = 0) then exit; - InternalStartBlendTriangles; - InternalSetColor(AColor); - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - InternalContinueShape(APoints[i]+ofs); - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor(const APoints: array of TPointF; - const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendTriangles; - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i]+ofs); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor( - const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendTriangles; - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor( - const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendTriangles; - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor(const APoints, - ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); - if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); - InternalStartBlendTriangles; - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i], ANormals[i]); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillQuads(const APoints: array of TPointF; - AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if (length(APoints) < 4) or (AColor.alpha = 0) then exit; - InternalStartBlendQuads; - InternalSetColor(AColor); - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - InternalContinueShape(APoints[i]+ofs); - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor(const APoints: array of TPointF; - const AColors: array of TBGRAPixel; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendQuads; - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i]+ofs); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor( - const APoints: array of TPoint3D; const AColors: array of TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendQuads; - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor( - const APoints: array of TPoint3D_128; const AColors: array of TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendQuads; - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor(const APoints, - ANormals: array of TPoint3D_128; const AColors: array of TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); - if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); - InternalStartBlendQuads; - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i], ANormals[i]); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, - c2, c3, c4: TColorF; APixelCenteredCoordinates: boolean); -begin - FillQuadsLinearColor([pt1,pt2,pt3,pt4],[c1,c2,c3,c4],APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillQuads(const APoints: array of TPointF; - AColor: TColorF; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if (length(APoints) < 4) or (AColor[4] = 0) then exit; - InternalStartBlendQuads; - InternalSetColorF(AColor); - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - InternalContinueShape(APoints[i]+ofs); - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor( - const APoints: array of TPointF; const AColors: array of TColorF; - APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendQuads; - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i]+ofs); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor( - const APoints: array of TPoint3D; const AColors: array of TColorF); -var - i: Int32or64; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendQuads; - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor( - const APoints: array of TPoint3D_128; const AColors: array of TColorF); -var - i: Int32or64; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendQuads; - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.FillQuadsLinearColor(const APoints, - ANormals: array of TPoint3D_128; const AColors: array of TColorF); -var - i: Int32or64; -begin - if length(APoints) < 4 then exit; - if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); - if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); - InternalStartBlendQuads; - for i := 0 to length(APoints) - (length(APoints) and 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i], ANormals[i]); - end; - InternalEndBlendQuads; -end; - -procedure TBGLCustomCanvas.PutPixels(const APoints: array of TPointF; - AColor: TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) = 0 then exit; - InternalStartBlend; - InternalSetColor(AColor); - InternalStartPutPixel(APoints[0]); - for i := 1 to high(APoints) do - InternalContinueShape(APoints[i]); - InternalEndBlend; -end; - -procedure TBGLCustomCanvas.PutPixels(const APoints: array of TPointF; - const AColors: array of TBGRAPixel); -var - i: Int32or64; -begin - if length(APoints) = 0 then exit; - InternalStartBlend; - InternalSetColor(AColors[0]); - InternalStartPutPixel(APoints[0]); - for i := 1 to high(APoints) do - begin - InternalSetColor(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlend; -end; - -procedure TBGLCustomCanvas.FillTrianglesFan(const APoints: array of TPointF; - ACenterColor, ABorderColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - firstPoint: boolean; - ofs: TPointF; -begin - if (length(APoints) < 3) or ((ACenterColor.alpha = 0) and (ABorderColor.alpha = 0)) then exit; - InternalStartBlend; - firstPoint := true; - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to high(APoints) do - begin - if isEmptyPointF(APoints[i]) then - begin - if not firstPoint then - begin - InternalEndShape; - firstPoint := true; - end; - end else - begin - if firstPoint then - begin - InternalSetColor(ACenterColor); - InternalStartTriangleFan(APoints[i]+ofs); - InternalSetColor(ABorderColor); - firstPoint := false; - end else - InternalContinueShape(APoints[i]+ofs); - end; - end; - if not firstPoint then InternalEndShape; - InternalEndBlend; -end; - -procedure TBGLCustomCanvas.FillTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, - c2, c3: TColorF; APixelCenteredCoordinates: boolean); -begin - FillTrianglesLinearColor([pt1,pt2,pt3],[c1,c2,c3],APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillTriangles(const APoints: array of TPointF; - AColor: TColorF; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if (length(APoints) < 3) or (AColor[4] = 0) then exit; - InternalStartBlendTriangles; - InternalSetColorF(AColor); - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - InternalContinueShape(APoints[i]+ofs); - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor( - const APoints: array of TPointF; const AColors: array of TColorF; - APixelCenteredCoordinates: boolean); -var - i: Int32or64; - ofs: TPointF; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendTriangles; - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i]+ofs); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor( - const APoints: array of TPoint3D; const AColors: array of TColorF); -var - i: Int32or64; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendTriangles; - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor( - const APoints: array of TPoint3D_128; const AColors: array of TColorF); -var - i: Int32or64; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then - raise exception.Create('Length of APoints and AColors do not match'); - InternalStartBlendTriangles; - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i]); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesLinearColor(const APoints, - ANormals: array of TPoint3D_128; const AColors: array of TColorF); -var - i: Int32or64; -begin - if length(APoints) < 3 then exit; - if length(AColors)<>length(APoints) then raise exception.Create('Length of APoints and AColors do not match'); - if length(AColors)<>length(ANormals) then raise exception.Create('Length of APoints and ANormals do not match'); - InternalStartBlendTriangles; - for i := 0 to length(APoints) - (length(APoints) mod 3) - 1 do - begin - InternalSetColorF(AColors[i]); - InternalContinueShape(APoints[i], ANormals[i]); - end; - InternalEndBlendTriangles; -end; - -procedure TBGLCustomCanvas.FillTrianglesFan(const APoints: array of TPointF; - ACenterColor, ABorderColor: TColorF; APixelCenteredCoordinates: boolean); -var - i: Int32or64; - firstPoint: boolean; - ofs: TPointF; -begin - if (length(APoints) < 3) or ((ACenterColor[4] = 0) and (ABorderColor[4] = 0)) then exit; - InternalStartBlend; - firstPoint := true; - if APixelCenteredCoordinates then ofs := PointF(0.5,0.5) else ofs := PointF(0,0); - for i := 0 to high(APoints) do - begin - if isEmptyPointF(APoints[i]) then - begin - if not firstPoint then - begin - InternalEndShape; - firstPoint := true; - end; - end else - begin - if firstPoint then - begin - InternalSetColorF(ACenterColor); - InternalStartTriangleFan(APoints[i]+ofs); - InternalSetColorF(ABorderColor); - firstPoint := false; - end else - InternalContinueShape(APoints[i]+ofs); - end; - end; - if not firstPoint then InternalEndShape; - InternalEndBlend; -end; - -procedure TBGLCustomCanvas.Polylines(const APoints: array of TPointF; - AColor: TBGRAPixel; ADrawLastPoints: boolean); -const - STATE_START = 0; //nothing defined - STATE_SECOND = 1; //prevPoint defined and is the first point - STATE_AFTER = 2; //newPoint defined and is the lastest point, prevPoint is the point before that -var - i: Int32or64; - state: Int32or64; - prevPoint,newPoint,v,ofs: TPointF; - len: single; - - procedure Flush; - begin - case state of - STATE_SECOND: begin - InternalStartPutPixel(prevPoint); - InternalEndShape; - end; - STATE_AFTER: - begin - v := newPoint-prevPoint; - len := VectLen(v); - if len > 0 then - begin - v := v*(1/len); - if ADrawLastPoints then - InternalContinueShape(newPoint + v*0.5 + ofs) - else - InternalContinueShape(newPoint - v*0.5 + ofs); - end; - InternalEndShape; - end; - end; - state := STATE_START; - end; - -begin - if (length(APoints) = 0) or (AColor.alpha = 0) then exit; - InternalStartBlend; - InternalSetColor(AColor); - prevPoint := PointF(0,0); - newPoint := PointF(0,0); - state := STATE_START; - ofs := PointF(0.5,0.5); - for i := 0 to high(APoints) do - begin - if isEmptyPointF(APoints[i]) then - begin - Flush; - end else - begin - if state = STATE_START then - begin - state := STATE_SECOND; - prevPoint := APoints[i]; - end else - if APoints[i] <> prevPoint then - begin - if state = STATE_SECOND then - begin - newPoint := APoints[i]; - v := newPoint-prevPoint; - len := VectLen(v); - if len > 0 then - begin - v := v*(1/len); - InternalStartPolyline(prevPoint - v*0.5 + ofs); - state := STATE_AFTER; - end; - end else - begin - InternalContinueShape(newPoint + ofs); - prevPoint := newPoint; - newPoint := APoints[i]; - end; - end; - end; - end; - Flush; - InternalEndBlend; -end; - -procedure TBGLCustomCanvas.Polygons(const APoints: array of TPointF; - AColor: TBGRAPixel); -const - STATE_START = 0; //nothing defined - STATE_SECOND = 1; //prevPoint defined and is the first point - STATE_AFTER = 2; //newPoint defined and is the lastest point, prevPoint is the point before that -var - i: Int32or64; - state: Int32or64; - prevPoint,newPoint: TPointF; - ofs: TPointF; - - procedure Flush; - begin - case state of - STATE_SECOND: begin - InternalStartPutPixel(prevPoint); - InternalEndShape; - end; - STATE_AFTER: - begin - InternalContinueShape(newPoint + ofs); - InternalEndShape; - end; - end; - state := STATE_START; - end; - -begin - if (length(APoints) = 0) or (AColor.alpha = 0) then exit; - InternalStartBlend; - InternalSetColor(AColor); - prevPoint := PointF(0,0); - newPoint := PointF(0,0); - state := STATE_START; - ofs := PointF(0.5,0.5); - for i := 0 to high(APoints) do - begin - if isEmptyPointF(APoints[i]) then - begin - Flush; - end else - begin - if state = STATE_START then - begin - state := STATE_SECOND; - prevPoint := APoints[i]; - end else - if APoints[i] <> prevPoint then - begin - if state = STATE_SECOND then - begin - InternalStartPolygon(prevPoint+ofs); - newPoint := APoints[i]; - state := STATE_AFTER; - end else - begin - InternalContinueShape(newPoint+ofs); - prevPoint := newPoint; - newPoint := APoints[i]; - end; - end; - end; - end; - Flush; - InternalEndBlend; -end; - -procedure TBGLCustomCanvas.FillRect(r: TRect; AScanner: IBGRAScanner); -var - bmp: TBGLCustomBitmap; - yb,bandHeight,bandY: Int32or64; - tx: integer; -begin - SwapRect(r); - if (r.right = r.left) or (r.bottom = r.top) then exit; - tx := r.right-r.left; - bandHeight := 65536 div tx; - if bandHeight <= 2 then bandHeight := 2; - bandHeight := GetPowerOfTwo(bandHeight); - bmp := BGLBitmapFactory.Create(tx,bandHeight); - bmp.Texture.ResampleFilter := orfBox; - bandY := (r.Bottom-1-r.top) mod bandHeight; - for yb := r.bottom-1 downto r.top do - begin - AScanner.ScanMoveTo(r.left,yb); - AScanner.ScanPutPixels(bmp.ScanLine[bandY],tx,dmSet); - bmp.InvalidateBitmap; - if bandY = 0 then - begin - bmp.Texture.Draw(r.left,yb); - bandY := bandHeight-1; - end else - dec(bandY); - end; - bmp.Free; -end; - -procedure TBGLCustomCanvas.DrawPath(APath: TBGLPath; c: TBGRAPixel); -begin - APath.stroke(self, c); -end; - -procedure TBGLCustomCanvas.FillPathConvex(APath: TBGLPath; c: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - APath.fillConvex(self, c, 0.1, APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); -begin - if FActiveFrameBuffer=AValue then Exit; - if FActiveFrameBuffer <> nil then - FActiveFrameBuffer.SetCanvas(nil); - FActiveFrameBuffer:=AValue; - if FActiveFrameBuffer <> nil then - FActiveFrameBuffer.SetCanvas(self); -end; - -procedure TBGLCustomCanvas.SwapRect(var r: TRect); -var - temp: LongInt; -begin - if (r.Right < r.left) then - begin - temp := r.Left; - r.left := r.right; - r.right := temp; - end; - if (r.bottom < r.top) then - begin - temp := r.top; - r.top:= r.bottom; - r.bottom:= temp; - end; -end; - -procedure TBGLCustomCanvas.SwapRect(var x1, y1, x2, y2: single); -var - temp: single; -begin - if (x2 < x1) then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - if (y2 < y1) then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; -end; - -procedure TBGLCustomCanvas.InternalArc(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; ABorderColor, AOuterFillColor,ACenterFillColor: TBGRAPixel; - AOptions: TArcOptions; ADrawChord: boolean = false); -var angle1,angle2: single; -begin - if (rx = 0) or (ry = 0) then exit; - angle1 := arctan2(-(StartPoint.y-cy)/ry,(StartPoint.x-cx)/rx); - angle2 := arctan2(-(EndPoint.y-cy)/ry,(EndPoint.x-cx)/rx); - if angle1 = angle2 then angle2 := angle1+2*Pi; - InternalArc(cx,cy,rx,ry, angle1,angle2, - ABorderColor,AOuterFillColor,ACenterFillColor, AOptions, ADrawChord); -end; - -procedure TBGLCustomCanvas.InternalArc(cx, cy, rx, ry: single; - StartAngleRad, EndAngleRad: Single; ABorderColor, - AOuterFillColor,ACenterFillColor: TBGRAPixel; AOptions: TArcOptions; - ADrawChord: boolean = false); -var - pts,ptsFill: array of TPointF; - temp: single; -begin - if (rx = 0) or (ry = 0) then exit; - if ADrawChord then AOptions := AOptions+[aoClosePath]; - if not (aoFillPath in AOptions) then - begin - AOuterFillColor := BGRAPixelTransparent; - ACenterFillColor := BGRAPixelTransparent; - end; - - if (ABorderColor.alpha = 0) and (AOuterFillColor.alpha = 0) and (ACenterFillColor.alpha = 0) then exit; - - if abs(StartAngleRad-EndAngleRad) >= 2*PI - 1e-6 then - begin - Ellipse(cx,cy,rx,ry,ABorderColor); - FillEllipseLinearColor(cx,cy,rx,ry,AOuterFillColor,ACenterFillColor); - if aoPie in AOptions then - Line(cx,cy,cx+cos(StartAngleRad)*rx,cy-sin(StartAngleRad)*ry,ABorderColor,False); - exit; - end; - - if EndAngleRad < StartAngleRad then - begin - temp := StartAngleRad; - StartAngleRad:= EndAngleRad; - EndAngleRad:= temp; - end; - - pts := ComputeArcRad(cx,cy,rx,ry,StartAngleRad,EndAngleRad); - if aoPie in AOptions then - pts := ConcatPointsF([PointsF([PointF(cx,cy)]),pts]); - if (ACenterFillColor.alpha <> 0) or (AOuterFillColor.alpha <> 0) then - begin - if not (aoPie in AOptions) and (length(pts)>=2) then ptsFill := ConcatPointsF([PointsF([(pts[0]+pts[high(pts)])*0.5]),pts]) - else ptsFill := pts; - FillTrianglesFan(ptsFill, ACenterFillColor,AOuterFillColor); - end; - if ABorderColor.alpha <> 0 then - begin - if [aoPie,aoClosePath]*AOptions <> [] then - Polygons(pts, ABorderColor) - else - Polylines(pts, ABorderColor, true); - end; -end; - -procedure TBGLCustomCanvas.InternalArcInRect(r: TRect; StartAngleRad, - EndAngleRad: Single; ABorderColor, AOuterFillColor,ACenterFillColor: TBGRAPixel; - AOptions: TArcOptions; ADrawChord: boolean = false); -begin - if r.right = r.left then exit; - if r.bottom = r.top then exit; - SwapRect(r); - InternalArc((r.left+r.right-1)/2,(r.top+r.bottom-1)/2, - (r.right-r.left-1)/2,(r.bottom-r.top-1)/2, - StartAngleRad,EndAngleRad, - ABorderColor,AOuterFillColor,ACenterFillColor, - AOptions, ADrawChord); -end; - -procedure TBGLCustomCanvas.FillTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, - c2, c3: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - FillTrianglesLinearColor([pt1,pt2,pt3],[c1,c2,c3],APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, - c2, c3, c4: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - FillQuadsLinearColor([pt1,pt2,pt3,pt4],[c1,c2,c3,c4],APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillPolyConvex(const APoints: array of TPointF; - AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - FillTrianglesFan(APoints,AColor,AColor,APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.Line(x1, y1, x2, y2: single; AColor: TBGRAPixel; ADrawLastPoint: boolean); -var pts: array of TPointF; -begin - setlength(pts,2); - pts[0] := PointF(x1,y1); - pts[1] := PointF(x2,y2); - Polylines(pts,AColor,ADrawLastPoint); -end; - -procedure TBGLCustomCanvas.Line(p1, p2: TPointF; AColor: TBGRAPixel; ADrawLastPoint: boolean); -var pts: array of TPointF; -begin - setlength(pts,2); - pts[0] := p1; - pts[1] := p2; - Polylines(pts,AColor,ADrawLastPoint); -end; - -procedure TBGLCustomCanvas.FillRectLinearColor(r: TRect; - ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor: TBGRAPixel); -begin - FillRectLinearColor(r.left,r.top,r.right,r.bottom, - ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor, - False); -end; - -procedure TBGLCustomCanvas.FillRectLinearColor(x1, y1, x2, y2: single; - ATopLeftColor, ATopRightColor, ABottomRightColor, - ABottomLeftColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - FillQuadLinearColor(PointF(x1,y1),PointF(x2,y1), - PointF(x2,y2),PointF(x1,y2), - ATopLeftColor, ATopRightColor, ABottomRightColor, ABottomLeftColor, - APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.Ellipse(cx, cy, rx, ry: single; AColor: TBGRAPixel); -begin - if AColor.alpha = 0 then exit; - Polygons(ComputeEllipse(cx,cy,rx,ry),AColor); -end; - -procedure TBGLCustomCanvas.EllipseInRect(r: TRect; AColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; - Ellipse(cx,cy,rx,ry, AColor); -end; - -procedure TBGLCustomCanvas.FillEllipse(cx, cy, rx, ry: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - if AColor.alpha = 0 then exit; - FillTrianglesFan(ComputeEllipse(cx,cy,rx,ry),AColor,AColor,APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillEllipseInRect(r: TRect; AColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,False,cx,cy,rx,ry) then exit; - FillEllipse(cx,cy,rx,ry, AColor); -end; - -procedure TBGLCustomCanvas.FillEllipseLinearColor(cx, cy, rx, ry: single; - AOuterColor, AInnerColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - if (AOutercolor.alpha = 0) and (AInnercolor.alpha = 0) then exit; - FillTrianglesFan(ConcatPointsF([PointsF([PointF(cx,cy)]),ComputeEllipse(cx,cy,rx,ry)]),AInnercolor,AOutercolor,APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillEllipseLinearColorInRect(r: TRect; AOuterColor, - AInnerColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,False,cx,cy,rx,ry) then exit; - FillEllipseLinearColor(cx,cy,rx,ry, AOutercolor,AInnercolor); -end; - -procedure TBGLCustomCanvas.Arc(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AFillColor,AFillColor,[aoFillPath],ADrawChord); -end; - -procedure TBGLCustomCanvas.Arc(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AFillColor,AFillColor,[aoFillPath],ADrawChord); -end; - -procedure TBGLCustomCanvas.ArcInRect(r: TRect; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AFillColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; - Arc(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,ADrawChord, AFillColor); -end; - -procedure TBGLCustomCanvas.ArcLinearColor(cx, cy, rx, ry: single; - const StartPoint, EndPoint: TPointF; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, - AInnerFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath],ADrawChord); -end; - -procedure TBGLCustomCanvas.ArcLinearColor(cx, cy, rx, ry: single; - StartAngleRad, EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, - AInnerFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath],ADrawChord); -end; - -procedure TBGLCustomCanvas.ArcLinearColorInRect(r: TRect; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; ADrawChord: boolean; AOuterFillColor, - AInnerFillColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; - ArcLinearColor(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,ADrawChord, AOuterFillColor,AInnerFillColor); -end; - -procedure TBGLCustomCanvas.Pie(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; AColor: TBGRAPixel; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AFillColor,AFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGLCustomCanvas.Pie(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AFillColor,AFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGLCustomCanvas.PieInRect(r: TRect; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; AFillColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; - Pie(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,AFillColor); -end; - -procedure TBGLCustomCanvas.PieLinearColor(cx, cy, rx, ry: single; - const StartPoint, EndPoint: TPointF; AColor: TBGRAPixel; AOuterFillColor, - AInnerFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGLCustomCanvas.PieLinearColor(cx, cy, rx, ry: single; - StartAngleRad, EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, - AInnerFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,AOuterFillColor,AInnerFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGLCustomCanvas.PieLinearColorInRect(r: TRect; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; AOuterFillColor, - AInnerFillColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; - PieLinearColor(cx,cy,rx,ry,StartAngleRad,EndAngleRad, AColor,AOuterFillColor,AInnerFillColor); -end; - -procedure TBGLCustomCanvas.EllipseLinearColor(cx, cy, rx, ry: single; AColor: TBGRAPixel; - AOuterFillColor, AInnerFillColor: TBGRAPixel); -begin - if (rx>1) and (ry>1) then - FillEllipseLinearColor(cx,cy,rx-0.5,ry-0.5,AOuterFillColor,AInnerFillColor); - Ellipse(cx,cy,rx,ry,AColor); -end; - -procedure TBGLCustomCanvas.EllipseLinearColorInRect(r: TRect; AColor: TBGRAPixel; - AOuterFillColor, AInnerFillColor: TBGRAPixel); -var cx,cy,rx,ry: single; -begin - if not ComputeEllipseC(r,True,cx,cy,rx,ry) then exit; - FillEllipseLinearColor(cx,cy,rx,ry, AOuterFillColor,AInnerFillColor); - EllipseInRect(r,AColor); -end; - -procedure TBGLCustomCanvas.Ellipse(cx, cy, rx, ry: single; AColor: TBGRAPixel; - AFillColor: TBGRAPixel); -begin - EllipseLinearColor(cx,cy,rx,ry,AColor,AFillColor,AFillColor); -end; - -procedure TBGLCustomCanvas.EllipseInRect(r: TRect; AColor: TBGRAPixel; - AFillColor: TBGRAPixel); -begin - EllipseLinearColorInRect(r, AColor, AFillColor, AFillColor); -end; - -procedure TBGLCustomCanvas.Rectangle(r: TRect; AColor: TBGRAPixel); -begin - Rectangle(r,AColor,BGRAPixelTransparent); -end; - -procedure TBGLCustomCanvas.Rectangle(r: TRect; AColor: TBGRAPixel; - AFillColor: TBGRAPixel); -begin - SwapRect(r); - if r.left=r.right then exit; - if r.top=r.bottom then exit; - Rectangle(r.left,r.top,r.right-1,r.bottom-1,AColor,AFillColor); -end; - -procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; AColor: TBGRAPixel); -begin - Rectangle(x1,y1,x2,y2,AColor,1); -end; - -procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; - AColor: TBGRAPixel; AFillColor: TBGRAPixel); -begin - Rectangle(x1,y1,x2,y2,AColor,1,AFillColor); -end; - -procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; - AColor: TBGRAPixel; w: single; APixelCenteredCoordinates: boolean); -var hw: single; -begin - SwapRect(x1,y1,x2,y2); - hw := w*0.5; - if (x2-x1 > w) and (y2-y1 > w) then - FillQuads(PointsF([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y1+hw),PointF(x1-hw,y1+hw), - PointF(x1-hw,y2-hw),PointF(x2+hw,y2-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw), - PointF(x1-hw,y1+hw),PointF(x1+hw,y1+hw),PointF(x1+hw,y2-hw),PointF(x1-hw,y2-hw), - PointF(x2-hw,y1+hw),PointF(x2+hw,y1+hw),PointF(x2+hw,y2-hw),PointF(x2-hw,y2-hw)]), AColor, - APixelCenteredCoordinates) - else - FillQuads(PointsF([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw)]),AColor, - APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.Rectangle(x1, y1, x2, y2: single; - AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - SwapRect(x1,y1,x2,y2); - if (x2-x1 > w) and (y2-y1 > w) then - FillRect(x1+0.5*w,y1+0.5*w,x2-0.5*w,y2-0.5*w,AFillColor,APixelCenteredCoordinates); - Rectangle(x1,y1,x2,y2,AColor,w,APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.RectangleWithin(x1, y1, x2, y2: single; - ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; - APixelCenteredCoordinates: boolean); -begin - Rectangle(x1+w*0.5,y1+w*0.5,x2-w*0.5,y2-w*0.5, ABorderColor, w, AFillColor, - APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; - w: single; AFillColor: TBGRAPixel); -begin - RectangleWithin(r.left,r.top,r.right,r.bottom,ABorderColor,w,AFillColor,false); -end; - -procedure TBGLCustomCanvas.RoundRect(x1, y1, x2, y2, rx, ry: single; - ABorderColor: TBGRAPixel; options: TRoundRectangleOptions); -begin - RoundRect(x1,y1,x2,y2,rx,ry,ABorderColor,options); -end; - -procedure TBGLCustomCanvas.RoundRect(x1, y1, x2, y2, rx, ry: single; - ABorderColor, AFillColor: TBGRAPixel; options: TRoundRectangleOptions); -const radiusReduction = 1; -begin - SwapRect(x1,y1,x2,y2); - rx := abs(rx); - ry := abs(ry); - if (AFillColor.alpha <> 0) and (y2-y1 > 1) and (x2-x1 > 1) then - begin - if (rx <= radiusReduction) or (ry <= radiusReduction) then - FillRect(x1+0.5,y1+0.5,x2-0.5,y2-0.5, AFillColor) - else - FillPolyConvex(ComputeRoundRect(x1+0.5,y1+0.5,x2-0.5,y2-0.5,rx-radiusReduction,ry-radiusReduction,options),AFillColor); - end; - Polygons(ComputeRoundRect(x1,y1,x2,y2,rx,ry,options),ABorderColor); -end; - -procedure TBGLCustomCanvas.FillRoundRect(x, y, x2, y2, rx, ry: single; - AFillColor: TBGRAPixel; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean); -begin - if AFillColor.alpha <> 0 then - FillPolyConvex(ComputeRoundRect(x,y,x2,y2,rx,ry,options),AFillColor,APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillRect(x1, y1, x2, y2: single; AColor: TBGRAPixel; APixelCenteredCoordinates: boolean); -begin - FillQuads(PointsF([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)]), AColor, APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.FillRect(r: TRect; AColor: TBGRAPixel); -begin - SwapRect(r); - if r.left=r.right then exit; - if r.top=r.bottom then exit; - FillRect(r.left,r.top,r.Right,r.bottom,AColor,False); -end; - -procedure TBGLCustomCanvas.FillRect(r: TRectF; AColor: TBGRAPixel; - APixelCenteredCoordinates: boolean); -begin - if r.left=r.right then exit; - if r.top=r.bottom then exit; - FillRect(r.left,r.top,r.Right,r.bottom,AColor,APixelCenteredCoordinates); -end; - -procedure TBGLCustomCanvas.Frame3D(var bounds: TRect; width: integer; - Style: TGraphicsBevelCut); -begin - Frame3D(bounds,width,style,ColorToBGRA(clRgbBtnHighlight),ColorToBGRA(clRgbBtnShadow)); -end; - -procedure TBGLCustomCanvas.Frame3D(var bounds: TRect; width: integer; - Style: TGraphicsBevelCut; LightColor: TBGRAPixel; ShadowColor: TBGRAPixel); -var temp: TBGRAPixel; - color1,color2: TBGRAPixel; -begin - if width <= 0 then exit; - color1 := LightColor; - color2 := ShadowColor; - if Style = bvLowered then - begin - temp := color1; - color1 := color2; - color2 := temp; - end; - if Style in [bvLowered,bvRaised] then - with bounds do - begin - FillTrianglesFan([PointF(Left,Top),PointF(Right,Top), - PointF(Right-width,Top+width),PointF(Left+width,Top+width), - PointF(Left+width,Bottom-width),PointF(Left,Bottom)],color1,color1, False); - FillTrianglesFan([PointF(Right,Bottom),PointF(Left,Bottom), - PointF(Left+width,Bottom-width),PointF(Right-width,Bottom-width), - PointF(Right-width,Top+width),PointF(Right,Top)],color2,color2, false); - end; - bounds.Inflate(-width, -width); -end; - -procedure TBGLCustomCanvas.PutImage(x, y: single; ATexture: IBGLTexture; - AAlpha: byte); -begin - ATexture.Draw(x,y,AAlpha); -end; - -procedure TBGLCustomCanvas.PutImage(x, y: single; ATexture: IBGLTexture; - AColor: TBGRAPixel); -begin - ATexture.Draw(x,y,AColor); -end; - -procedure TBGLCustomCanvas.StretchPutImage(x, y, w, h: single; - ATexture: IBGLTexture; AAlpha: byte); -begin - ATexture.StretchDraw(x,y,w,h, AAlpha); -end; - -procedure TBGLCustomCanvas.StretchPutImage(x, y, w, h: single; - ATexture: IBGLTexture; AColor: TBGRAPixel); -begin - ATexture.StretchDraw(x,y,w,h, AColor); -end; - -procedure TBGLCustomCanvas.StretchPutImage(r: TRect; ATexture: IBGLTexture; - AAlpha: byte); -begin - ATexture.StretchDraw(r.left,r.top,r.right-r.left,r.bottom-r.top, AAlpha); -end; - -procedure TBGLCustomCanvas.StretchPutImage(r: TRect; ATexture: IBGLTexture; - AColor: TBGRAPixel); -begin - ATexture.StretchDraw(r.left,r.top,r.right-r.left,r.bottom-r.top, AColor); -end; - -procedure TBGLCustomCanvas.PutImageAngle(x, y: single; ATexture: IBGLTexture; - angleDeg: single; AAlpha: byte); -begin - ATexture.DrawAngle(x,y,angleDeg,AAlpha); -end; - -procedure TBGLCustomCanvas.PutImageAngle(x, y: single; ATexture: IBGLTexture; - angleDeg: single; AColor: TBGRAPixel); -begin - ATexture.DrawAngle(x,y,angleDeg,AColor); -end; - -procedure TBGLCustomCanvas.PutImageAffine(const Origin, HAxis, VAxis: TPointF; - ATexture: IBGLTexture; AAlpha: byte); -begin - {$PUSH}{$OPTIMIZATION OFF} - ATexture.DrawAffine(Origin, HAxis, VAxis, AAlpha); - {$POP} -end; - -procedure TBGLCustomCanvas.PutImageAffine(const Origin, HAxis, VAxis: TPointF; - ATexture: IBGLTexture; AColor: TBGRAPixel); -begin - {$PUSH}{$OPTIMIZATION OFF} - ATexture.DrawAffine(Origin, HAxis, VAxis, AColor); - {$POP} -end; - -procedure TBGLCustomCanvas.PutImageAffine(x, y: single; ATexture: IBGLTexture; - const AMatrix: TAffineMatrix; AAlpha: byte); -begin - ATexture.DrawAffine(x,y,AMatrix,AAlpha); -end; - -procedure TBGLCustomCanvas.PutImageAffine(x, y: single; ATexture: IBGLTexture; - const AMatrix: TAffineMatrix; AColor: TBGRAPixel); -begin - ATexture.DrawAffine(x,y,AMatrix,AColor); -end; - -procedure TBGLCustomCanvas.Translate(x, y: single); -begin - Matrix := Matrix*AffineMatrixTranslation(x,y); -end; - -procedure TBGLCustomCanvas.Scale(sx, sy: single); -begin - Matrix := Matrix*AffineMatrixScale(sx,sy); -end; - -procedure TBGLCustomCanvas.RotateDeg(angleCW: single); -begin - Matrix := Matrix*AffineMatrixRotationDeg(angleCW); -end; - -procedure TBGLCustomCanvas.RotateRad(angleCCW: single); -begin - Matrix := Matrix*AffineMatrixRotationRad(angleCCW); -end; - -procedure TBGLCustomCanvas.ResetTransform; -begin - Matrix := AffineMatrixIdentity; -end; - -procedure TBGLCustomCanvas.UseOrthoProjection; -begin - ProjectionMatrix := OrthoProjectionToOpenGL(0,0,Width,Height); -end; - -procedure TBGLCustomCanvas.UseOrthoProjection(AMinX, AMinY, AMaxX, AMaxY: single); -begin - ProjectionMatrix := OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY); -end; - -procedure TBGLCustomCanvas.StartZBuffer; -begin - raise exception.Create('Not implemented'); -end; - -procedure TBGLCustomCanvas.EndZBuffer; -begin - raise exception.Create('Not implemented'); -end; - -procedure TBGLCustomCanvas.WaitForGPU(AOption: TWaitForGPUOption); -begin - raise exception.Create('Not implemented'); -end; - -function TBGLCustomCanvas.GetImage(x, y, w, h: integer): TBGRACustomBitmap; -begin - result := nil; -end; - -function TBGLCustomCanvas.CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer; -begin - result := nil; - raise exception.Create('Not implemented'); -end; - -end. - diff --git a/components/bgrabitmap/bgraclasses.pas b/components/bgrabitmap/bgraclasses.pas deleted file mode 100644 index 8ba3343..0000000 --- a/components/bgrabitmap/bgraclasses.pas +++ /dev/null @@ -1,251 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAClasses; - -{$mode objfpc}{$H+} -{$modeswitch advancedrecords} - -interface - -uses - {$IFDEF BGRABITMAP_USE_MSEGUI}Types, Classes, mclasses, msegraphutils, mseguiglob{$ELSE}Types, Classes{$ENDIF}; - -type - Int32or64 = {$IFDEF CPU64}Int64{$ELSE}LongInt{$ENDIF}; - UInt32or64 = {$IFDEF CPU64}UInt64{$ELSE}LongWord{$ENDIF}; - - //types always imported from Classes - TFPList = Classes.TFPList; - TList = Classes.TList; - TNotifyEvent = Classes.TNotifyEvent; - EInvalidOperation = Classes.EInvalidOperation; - EFCreateError = Classes.EFCreateError; - EFOpenError = Classes.EFOpenError; - TAlignment = Classes.TAlignment; - TSeekOrigin = Classes.TSeekOrigin; - TStream = Classes.TStream; - TPersistent = Classes.TPersistent; - TStrings = Classes.TStrings; - TStringList = Classes.TStringList; - - TComponent = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TComponent; - TResourceStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TResourceStream; - TMemoryStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TMemoryStream; - THandleStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.THandleStream; - TStringStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TStringStream; - -type - {$IFDEF BGRABITMAP_USE_MSEGUI} - TPoint = msegraphutils.pointty; - TSize = msegraphutils.sizety; - TRect = Classes.TRect; - TClassesPoint = Classes.TPoint; - TMSERect = msegraphutils.rectty; - {$ELSE} - TPoint = Types.TPoint; - TSize = Types.TSize; - TRect = Types.TRect; - {$ENDIF} - PPoint = ^TPoint; - PSize = ^TSize; - PRect = ^TRect; - - {$IF FPC_FULLVERSION>=030001} - TPointF = Types.TPointF; - TRectF = Types.TRectF; - {$ELSE} - TPointF = record x : single; y : single; end; - - {$define BGRA_DEFINE_TRECTF} - TRectF = - {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} - packed - {$endif FPC_REQUIRES_PROPER_ALIGNMENT} - record - private - function GetHeight: single; - function GetWidth: Single; - public - property Width: Single read GetWidth; - property Height: single read GetHeight; - procedure Offset (const dx,dy : Single); - case Integer of - 0: (Left, Top, Right, Bottom: Single); - 1: (TopLeft, BottomRight: TPointF); - end; - {$ENDIF} - -const - //types always imported from Classes - taLeftJustify = Classes.taLeftJustify; - taRightJustify = Classes.taRightJustify; - taCenter = Classes.taCenter; - -type - {$IFDEF BGRABITMAP_USE_MSEGUI} - TShiftState = mseguiglob.shiftstatesty; - {$ELSE} - TShiftState = Classes.TShiftState; - {$ENDIF} - -const - {$IFDEF BGRABITMAP_USE_MSEGUI} - ssShift = mseguiglob.ss_shift; - ssAlt = mseguiglob.ss_alt; - ssCtrl = mseguiglob.ss_ctrl; - ssLeft = mseguiglob.ss_left; - ssRight = mseguiglob.ss_right; - ssMiddle = mseguiglob.ss_middle; - ssDouble = mseguiglob.ss_double; - ssTriple = mseguiglob.ss_triple; - {$ELSE} - ssShift = Classes.ssShift; - ssAlt = Classes.ssAlt; - ssCtrl = Classes.ssCtrl; - ssLeft = Classes.ssLeft; - ssRight = Classes.ssRight; - ssMiddle = Classes.ssMiddle; - ssDouble = Classes.ssDouble; - ssTriple = Classes.ssTriple; - {$ENDIF} - - soBeginning = Classes.soBeginning; - soCurrent = Classes.soCurrent; - soEnd = Classes.soEnd; - - {$IFDEF BGRABITMAP_USE_MSEGUI} - fmCreate = $FF00; - fmOpenRead = 0; - fmOpenWrite = 1; - fmOpenReadWrite = 2; - - soFromBeginning = 0; - soFromCurrent = 1; - soFromEnd = 2; - {$ELSE} - fmCreate = Classes.fmCreate; - fmOpenRead = Classes.fmOpenRead; - fmOpenWrite = Classes.fmOpenWrite; - fmOpenReadWrite = Classes.fmOpenReadWrite; - soFromBeginning = Classes.soFromBeginning; - soFromCurrent = Classes.soFromCurrent; - soFromEnd = Classes.soFromEnd; - {$ENDIF} - -function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect; -function Point(AX, AY: Integer): TPoint; -function Size(AWidth, AHeight: Integer): TSize; -procedure IncF(var ADest: single; ADelta: single); overload; inline; -procedure IncF(var ADest: double; ADelta: double); overload; inline; -procedure DecF(var ADest: single; ADelta: single); overload; inline; -procedure DecF(var ADest: double; ADelta: double); overload; inline; -procedure Inc64(var AValue: int64; const ADelta: int64); overload; inline; -procedure Dec64(var AValue: int64; const ADelta: int64); overload; inline; -procedure Inc64(var AValue: uint64; const ADelta: uint64); overload; inline; -procedure Dec64(var AValue: uint64; const ADelta: uint64); overload; inline; - -implementation - -function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect; -begin - with Result do - begin - Left := ALeft; - Top := ATop; - Right := ARight; - Bottom := ABottom; - end; -end; - -{$IFDEF BGRA_DEFINE_TRECTF} -{ TRectF } - -function TRectF.GetHeight: single; -begin - result := Bottom-Top; -end; - -function TRectF.GetWidth: Single; -begin - result := Right-Left; -end; - -procedure TRectF.Offset(const dx, dy: Single); -begin - left:=left+dx; right:=right+dx; - bottom:=bottom+dy; top:=top+dy; -end; -{$ENDIF} - -function Point(AX, AY: Integer): TPoint; -begin - with Result do - begin - X := AX; - Y := AY; - end; -end; - -function Size(AWidth, AHeight: Integer): TSize; -begin - Result.cx := AWidth; - Result.cy := AHeight; -end; - -procedure IncF(var ADest: single; ADelta: single); -begin - ADest := ADest + ADelta; -end; - -procedure IncF(var ADest: double; ADelta: double); -begin - ADest := ADest + ADelta; -end; - -procedure DecF(var ADest: single; ADelta: single); -begin - ADest := ADest - ADelta; -end; - -procedure DecF(var ADest: double; ADelta: double); -begin - ADest := ADest - ADelta; -end; - -procedure Inc64(var AValue: int64; const ADelta: int64); -begin - {$IFDEF CPU64} - Inc(AValue, ADelta); - {$ELSE} - AValue := AValue + ADelta; - {$ENDIF} -end; - -procedure Dec64(var AValue: int64; const ADelta: int64); -begin - {$IFDEF CPU64} - Dec(AValue, ADelta); - {$ELSE} - AValue := AValue - ADelta; - {$ENDIF} -end; - -procedure Inc64(var AValue: uint64; const ADelta: uint64); -begin - {$IFDEF CPU64} - Inc(AValue, ADelta); - {$ELSE} - AValue := AValue + ADelta; - {$ENDIF} -end; - -procedure Dec64(var AValue: uint64; const ADelta: uint64); -begin - {$IFDEF CPU64} - Dec(AValue, ADelta); - {$ELSE} - AValue := AValue - ADelta; - {$ENDIF} -end; - -end. - diff --git a/components/bgrabitmap/bgracolorint.pas b/components/bgrabitmap/bgracolorint.pas deleted file mode 100644 index 6551c68..0000000 --- a/components/bgrabitmap/bgracolorint.pas +++ /dev/null @@ -1,363 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAColorInt; - -{$mode objfpc}{$H+} -{$ifdef CPUI386} - {$define BGRACOLORINT_USEASM} -{$endif} -{$ifdef DARWIN} - {$undef BGRACOLORINT_USEASM} -{$endif} - -interface - -uses - BGRABitmapTypes; - -type - TColorInt65536 = packed record - r,g,b,a: integer; - end; - -function ColorInt65536(r,g,b,a: integer): TColorInt65536; inline; overload; -function ColorInt65536(r,g,b: integer): TColorInt65536; inline; overload; -function ColorFToColorInt65536(colorF: TColorF): TColorInt65536; inline; -function ColorInt65536ToColorF(color: TColorInt65536): TColorF; -operator +(const color1,color2: TColorInt65536): TColorInt65536; inline; -operator *(const color1,color2: TColorInt65536): TColorInt65536; -operator *(const color1: TColorInt65536; factor65536: integer): TColorInt65536; -function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean = false): TBGRAPixel; -function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean = false): TColorInt65536; -function BGRAToColorIntMultiply(const color1: TBGRAPixel; const color2: TColorInt65536): TColorInt65536; - -implementation - -function ColorInt65536(r, g, b, a: integer): TColorInt65536; -begin - result.r := r; - result.g := g; - result.b := b; - result.a := a; -end; - -function ColorInt65536(r, g, b: integer): TColorInt65536; -begin - result.r := r; - result.g := g; - result.b := b; - result.a := 65536; -end; - -function ColorFToColorInt65536(colorF: TColorF): TColorInt65536; -begin - result.r := round(colorF[1]*65536); - result.g := round(colorF[2]*65536); - result.b := round(colorF[3]*65536); - result.a := round(colorF[4]*65536); -end; - -function ColorInt65536ToColorF(color: TColorInt65536): TColorF; -const oneOver65536 = 1/65536; -begin - result[1] := color.r*oneOver65536; - result[2] := color.g*oneOver65536; - result[3] := color.b*oneOver65536; - result[4] := color.a*oneOver65536; -end; - -operator+(const color1, color2: TColorInt65536): TColorInt65536; -begin - result.r := color1.r+color2.r; - result.g := color1.g+color2.g; - result.b := color1.b+color2.b; - result.a := color1.a+color2.a; -end; - -operator*(const color1, color2: TColorInt65536): TColorInt65536; -{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler; - asm - push edx - push ebx - push esi - mov ebx, Color1 - mov esi, Color2 - //ecx = @result - - mov eax, [ebx] //r - imul [esi] - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx], edx - - mov eax, [ebx+4] //g - imul [esi+4] - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx+4], edx - - mov eax, [ebx+8] //b - imul [esi+8] - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx+8], edx - - mov eax, [ebx+12] //a - imul [esi+12] - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx+12], edx - - pop esi - pop ebx - pop edx - end; -{$ELSE} -begin - result.r := int64(color1.r)*color2.r shr 16; - result.g := int64(color1.g)*color2.g shr 16; - result.b := int64(color1.b)*color2.b shr 16; - result.a := int64(color1.a)*color2.a shr 16; -end; -{$ENDIF} - -operator*(const color1: TColorInt65536; factor65536: integer): TColorInt65536; -{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler; - asm - push edx - push ebx - push esi - mov ebx, Color1 - mov esi, factor65536 - //ecx = @result - - mov eax, [ebx] //r - imul esi - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx], edx - - mov eax, [ebx+4] //g - imul esi - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx+4], edx - - mov eax, [ebx+8] //b - imul esi - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx+8], edx - - mov eax, [ebx+12] //a - imul esi - shl edx, 16 - shr eax, 16 - or edx, eax - mov [ecx+12], edx - - pop esi - pop ebx - pop edx - end; -{$else} -var prod: int64; -begin - prod := int64(color1.r)*factor65536; - if prod >= 0 then result.r := prod shr 16 - else result.r := -((-prod) shr 16); - prod := int64(color1.g)*factor65536; - if prod >= 0 then result.g := prod shr 16 - else result.g := -((-prod) shr 16); - prod := int64(color1.b)*factor65536; - if prod >= 0 then result.b := prod shr 16 - else result.b := -((-prod) shr 16); - prod := int64(color1.a)*factor65536; - if prod >= 0 then result.a := prod shr 16 - else result.a := -((-prod) shr 16); -end; -{$endif} - -function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean): TColorInt65536; -begin - if AGammaExpansion then - begin - result.r := GammaExpansionTab[AColor.red] + (AColor.red shr 7); - result.g := GammaExpansionTab[AColor.green] + (AColor.green shr 7); - result.b := GammaExpansionTab[AColor.blue] + (AColor.blue shr 7); - end else - begin - result.r := AColor.red shl 8 + AColor.red + (AColor.red shr 7); - result.g := AColor.green shl 8 + AColor.green + (AColor.green shr 7); - result.b := AColor.blue shl 8 + AColor.blue + (AColor.blue shr 7); - end; - result.a := AColor.alpha shl 8 + AColor.alpha+ (AColor.alpha shr 7); -end; - -function BGRAToColorIntMultiply(const color1: TBGRAPixel; - const color2: TColorInt65536): TColorInt65536; -{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler; - asm - push ebx - push esi - - mov esi, Color2 - mov ebx, result - mov ecx, [Color1] - - mov eax, ecx - shr eax, TBGRAPixel_RedShift - and eax, 255 - mov edx, eax - shr edx, 7 - add eax, edx - imul [esi] - shl edx, 24 - shr eax, 8 - or edx, eax - mov [ebx], edx - - mov eax, ecx - shr eax, TBGRAPixel_GreenShift - and eax, 255 - mov edx, eax - shr edx, 7 - add eax, edx - imul [esi+4] - shl edx, 24 - shr eax, 8 - or edx, eax - mov [ebx+4], edx - - mov eax, ecx - shr eax, TBGRAPixel_BlueShift - and eax, 255 - mov edx, eax - shr edx, 7 - add eax, edx - imul [esi+8] - shl edx, 24 - shr eax, 8 - or edx, eax - mov [ebx+8], edx - - mov eax, ecx - shr eax, TBGRAPixel_AlphaShift - and eax, 255 - mov edx, eax - shr edx, 7 - add eax, edx - imul [esi+12] - shl edx, 24 - shr eax, 8 - or edx, eax - mov [ebx+12], edx - - pop esi - pop ebx - end; -{$ELSE} -begin - result.r := int64(color2.r)*(color1.red shr 7+color1.red) shr 8; - result.g := int64(color2.g)*(color1.green shr 7+color1.green) shr 8; - result.b := int64(color2.b)*(color1.blue shr 7+color1.blue) shr 8; - result.a := int64(color2.a)*(color1.alpha shr 7+color1.alpha) shr 8; -end; -{$ENDIF} - -function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean): TBGRAPixel; -var maxValue,invMaxValue,r,g,b: integer; -begin - if AColor.a <= 0 then - result.alpha := 0; - if AColor.a >= 65536 then - result.alpha := 255 - else - result.alpha := AColor.a shr 8 - (AColor.a shr 15); - - maxValue := AColor.r; - if AColor.g > maxValue then maxValue := AColor.g; - if AColor.b > maxValue then maxValue := AColor.b; - - if maxValue <= 0 then - begin - result.red := 0; - result.green := 0; - result.blue := 0; - exit; - end; - - if AGammaCompression then - begin - if maxValue <= 65535 then - begin - if AColor.r <= 0 then result.red := 0 else - result.red := GammaCompressionTab[AColor.r - (AColor.r shr 15)]; - - if AColor.g <= 0 then result.green := 0 else - result.green :=GammaCompressionTab[AColor.g - (AColor.g shr 15)]; - - if AColor.b <= 0 then result.blue := 0 else - result.blue := GammaCompressionTab[AColor.b - (AColor.b shr 15)]; - exit; - end; - - invMaxValue := (1073741824+maxValue-1) div maxValue; - - maxValue := (maxValue-65535) shr 1; - if AColor.r < 0 then r := maxValue else - r := AColor.r*invMaxValue shr 14 + maxValue; - if AColor.g < 0 then g := maxValue else - g := AColor.g*invMaxValue shr 14 + maxValue; - if AColor.b < 0 then b := maxValue else - b := AColor.b*invMaxValue shr 14 + maxValue; - - if r >= 65535 then result.red := 255 else - result.red := GammaCompressionTab[r]; - if g >= 65535 then result.green := 255 else - result.green := GammaCompressionTab[g]; - if b >= 65535 then result.blue := 255 else - result.blue := GammaCompressionTab[b]; - end else - begin - if maxValue <= 65535 then - begin - if AColor.r <= 0 then result.red := 0 else - result.red := AColor.r shr 8 - (AColor.r shr 15); - - if AColor.g <= 0 then result.green := 0 else - result.green := AColor.g shr 8 - (AColor.g shr 15); - - if AColor.b <= 0 then result.blue := 0 else - result.blue := AColor.b shr 8 - (AColor.b shr 15); - exit; - end; - - invMaxValue := (1073741824+maxValue-1) div maxValue; - - maxValue := (maxValue-65535) shr 9; - if AColor.r < 0 then r := maxValue else - r := AColor.r*invMaxValue shr 22 + maxValue; - if AColor.g < 0 then g := maxValue else - g := AColor.g*invMaxValue shr 22 + maxValue; - if AColor.b < 0 then b := maxValue else - b := AColor.b*invMaxValue shr 22 + maxValue; - - if r >= 255 then result.red := 255 else - result.red := r; - if g >= 255 then result.green := 255 else - result.green := g; - if b >= 255 then result.blue := 255 else - result.blue := b; - end; -end; - - -end. - diff --git a/components/bgrabitmap/bgracolorquantization.pas b/components/bgrabitmap/bgracolorquantization.pas deleted file mode 100644 index 4e130e0..0000000 --- a/components/bgrabitmap/bgracolorquantization.pas +++ /dev/null @@ -1,2037 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAColorQuantization; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAPalette, BGRABitmapTypes; - -type - TBGRAColorBox = class; - TBGRAColorTree = class; - TBGRAApproxPalette = class; - TBiggestLeafMethod = (blMix, blApparentInterval, blWeight); - - { TDimensionMinMax } - - TDimensionMinMax = object - Minimum: UInt32; - Maximum: UInt32; - function Size: UInt32; - function Contains(AValue: UInt32): boolean; - function PointLike: boolean; - procedure SetAsPoint(AValue: UInt32); - function GetCenter: UInt32; - procedure GrowToInclude(AValue: UInt32); - end; - - TColorDimension = (cdFast,cdRed,cdGreen,cdBlue,cdAlpha,cdRGB,cdRG,cdGB,cdRB,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG, - cdSaturation); - TColorDimensions = set of TColorDimension; - - { TBGRAColorQuantizer } - - TBGRAColorQuantizer = class(TBGRACustomColorQuantizer) - private - FColors: ArrayOfWeightedColor; - FPalette: TBGRAApproxPalette; - FReductionColorCount: Integer; - FReductionKeepContrast: boolean; - FSeparateAlphaChannel: boolean; - procedure Init(ABox: TBGRAColorBox); - procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; ARedBounds, AGreenBounds, ABlueBounds, AAlphaBounds: TDimensionMinMax; AUniform: boolean); overload; - procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; AColorBounds, AAlphaBounds: TDimensionMinMax); overload; - protected - function GetPalette: TBGRACustomApproxPalette; override; - function GetSourceColor(AIndex: integer): TBGRAPixel; override; - function GetSourceColorCount: Integer; override; - function GetReductionColorCount: integer; override; - procedure SetReductionColorCount(AValue: Integer); override; - public - constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); override; - constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); override; - constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); override; - constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); override; - destructor Destroy; override; - procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect); override; - function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload; override; - function GetDitheredBitmapIndexedData(ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; - ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; overload; override; - procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; - ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat); override; - end; - - { TBGRAApproxPalette } - - TBGRAApproxPalette = class(TBGRACustomApproxPalette) - private - FTree: TBGRAColorTree; - FColors: ArrayOfWeightedColor; - protected - function GetCount: integer; override; - function GetColorByIndex(AIndex: integer): TBGRAPixel; override; - function GetWeightByIndex(AIndex: Integer): UInt32; override; - procedure Init(const AColors: ArrayOfTBGRAPixel); - public - constructor Create(const AColors: ArrayOfTBGRAPixel); overload; - constructor Create(const AColors: ArrayOfWeightedColor); overload; - constructor Create(AOwnedSplitTree: TBGRAColorTree); overload; - destructor Destroy; override; - function ContainsColor(AValue: TBGRAPixel): boolean; override; - function IndexOfColor(AValue: TBGRAPixel): integer; override; - function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override; - function FindNearestColorIndex(AValue: TBGRAPixel): integer; override; - function GetAsArrayOfColor: ArrayOfTBGRAPixel; override; - function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; - end; - - { TBGRAApproxPaletteViaLargerPalette } - - TBGRAApproxPaletteViaLargerPalette = class(TBGRAApproxPalette) - private - FLarger: TBGRACustomApproxPalette; - FLargerColors: array of record - approxColor: TBGRAPixel; - approxColorIndex: integer; - end; - FLargerOwned: boolean; - FTransparentColorIndex: integer; - protected - function FindNearestLargerColorIndex(AValue: TBGRAPixel): integer; virtual; - function SlowFindNearestColorIndex(AValue: TBGRAPixel): integer; - public - constructor Create(const AColors: ArrayOfTBGRAPixel; ALarger: TBGRACustomApproxPalette; ALargerOwned: boolean); - destructor Destroy; override; - function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override; - function FindNearestColorIndex(AValue: TBGRAPixel): integer; override; - function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; - end; - - TIsChannelStrictlyGreaterFunc = TBGRAPixelComparer; - TIsChannelGreaterThanOrEqualToValueFunc = function (p : PBGRAPixel; v: UInt32): boolean; - - TColorBoxBounds = array[TColorDimension] of TDimensionMinMax; - - { TBGRAColorBox } - - TBGRAColorBox = class - private - FBounds: TColorBoxBounds; - FTotalWeight: UInt32; - FColors: ArrayOfWeightedColor; - FDimensions: TColorDimensions; - FPureTransparentColorCount: integer; - function GetApparentInterval(ADimension: TColorDimension): UInt32; - function GetAverageColor: TBGRAPixel; - function GetAverageColorOrMainColor: TBGRAPixel; - function GetBounds(ADimension: TColorDimension): TDimensionMinMax; - function GetColorCount(ACountPureTransparent: boolean): integer; - function GetHasPureTransparentColor: boolean; - function GetInferiorColor: TBGRAPixel; - function GetLargestApparentDimension: TColorDimension; - function GetLargestApparentInterval: UInt32; - function GetPointLike: boolean; - function GetSuperiorColor: TBGRAPixel; - procedure Init(AColors: ArrayOfWeightedColor; AOwner: boolean); - procedure SortBy(ADimension: TColorDimension); - function GetMedianIndex(ADimension : TColorDimension; AMinValue, AMaxValue: UInt32): integer; - public - constructor Create(ADimensions: TColorDimensions; AColors: ArrayOfWeightedColor; AOwner: boolean); overload; - constructor Create(ADimensions: TColorDimensions; const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette); overload; - constructor Create(ADimensions: TColorDimensions; ABounds: TColorBoxBounds); overload; - constructor Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); overload; - constructor Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload; - constructor Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption); overload; - function BoundsContain(AColor: TBGRAPixel): boolean; - function MedianCut(ADimension: TColorDimension; out SuperiorMiddle: UInt32): TBGRAColorBox; - function Duplicate : TBGRAColorBox; - property Bounds[ADimension: TColorDimension]: TDimensionMinMax read GetBounds; - property ApparentInterval[AChannel: TColorDimension]: UInt32 read GetApparentInterval; - property LargestApparentDimension: TColorDimension read GetLargestApparentDimension; - property LargestApparentInterval: UInt32 read GetLargestApparentInterval; - property PointLike: boolean read GetPointLike; - property AverageColor: TBGRAPixel read GetAverageColor; - property SuperiorColor: TBGRAPixel read GetSuperiorColor; - property InferiorColor: TBGRAPixel read GetInferiorColor; - property AverageColorOrMainColor: TBGRAPixel read GetAverageColorOrMainColor; - function GetAsArrayOfColors(AIncludePureTransparent: boolean): ArrayOfTBGRAPixel; - property TotalWeight: UInt32 read FTotalWeight; - property ColorCount[ACountPureTransparent: boolean]: integer read GetColorCount; - property HasPureTransparentColor: boolean read GetHasPureTransparentColor; - property PureTransparentColorCount: integer read FPureTransparentColorCount; - end; - - TBGRALeafColorMode = (lcAverage, lcCenter, lcExtremum, lcMix); - - { TBGRAColorTree } - - TBGRAColorTree = class - private - FLeaf: TBGRAColorBox; - FIsLeaf: boolean; - FLargestApparentInterval: integer; - FWeight: UInt32; - - FLeafColor: TBGRAPixel; - FLeafColorIndex: integer; - FLeafColorComputed: boolean; - FMinBorder, FMaxBorder: array[TColorDimension] of boolean; - FCenterColor: TBGRAPixel; - FAverageColor: TBGRAPixel; - - FPureTransparentColorCount: integer; - FPureTransparentColorIndex: integer; - FDimension: TColorDimension; - FPixelValueComparer: TIsChannelGreaterThanOrEqualToValueFunc; - FSuperiorMiddle: UInt32; - FInferiorBranch, FSuperiorBranch: TBGRAColorTree; - function GetApproximatedColorCount: integer; - function GetHasPureTransparentColor: boolean; - function GetLeafCount: integer; - procedure Init(ALeaf: TBGRAColorBox; AOwned: boolean); - procedure InternalComputeLeavesColor(ALeafColor: TBGRALeafColorMode; var AStartIndex: integer); - procedure CheckColorComputed; - public - constructor Create(ABox: TBGRAColorBox; AOwned: boolean); overload; - constructor Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); overload; - constructor Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload; - destructor Destroy; override; - procedure FreeLeaves; - function FindBiggestLeaf(AMethod: TBiggestLeafMethod): TBGRAColorTree; - property LargestApparentInterval: integer read FLargestApparentInterval; - property Weight: UInt32 read FWeight; - property IsLeaf: boolean read FIsLeaf; - function TrySplitLeaf: boolean; - procedure ComputeLeavesColor(ALeafColor: TBGRALeafColorMode); - function ApproximateColor(AColor: TBGRAPixel): TBGRAPixel; - function ApproximateColorIndex(AColor: TBGRAPixel): integer; - function GetAsArrayOfApproximatedColors: ArrayOfTBGRAPixel; - function GetAsArrayOfWeightedColors: ArrayOfWeightedColor; - procedure SplitIntoPalette(ACount: integer; AMethod: TBiggestLeafMethod; - ALeafColor: TBGRALeafColorMode); - function SplitIntoPaletteWithSubPalette(ACount: integer; AMethod: TBiggestLeafMethod; - ALeafColor: TBGRALeafColorMode; ASubPaletteCount: integer): ArrayOfTBGRAPixel; - property LeafCount: integer read GetLeafCount; - property ApproximatedColorCount: integer read GetApproximatedColorCount; - property HasPureTransparentColor: boolean read GetHasPureTransparentColor; - property PureTransparentColorCount: integer read FPureTransparentColorCount; - end; - -function GetPixelStrictComparer(ADimension: TColorDimension): TIsChannelStrictlyGreaterFunc; -function GetPixelValueComparer(ADimension: TColorDimension): TIsChannelGreaterThanOrEqualToValueFunc; -function BGRAColorCount(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption): integer; - -const AllColorDimensions = [cdRed,cdGreen,cdBlue,cdAlpha,cdRGB,cdRG,cdGB,cdRB,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG, - cdSaturation]; - -implementation - -uses BGRADithering, FPimage, FPWriteBMP, BGRAWritePNG, math; - -const MedianMinPercentage = 0.2; - -const RedShift = 1; - GreenShift = 2; - AlphaShift = 1; - SaturationShift = 2; - -function GetDimensionValue(APixel: TBGRAPixel; ADimension: TColorDimension): UInt32; -var v: UInt32; -begin - case ADimension of - cdFast: result := LongWord(APixel); - cdRed: result := GammaExpansionTab[APixel.red] shl RedShift; - cdGreen: result := GammaExpansionTab[APixel.green] shl GreenShift; - cdBlue: result := GammaExpansionTab[APixel.blue]; - cdAlpha: result := (APixel.alpha + (APixel.alpha shl 8)) shl AlphaShift; - cdRGB: result := GammaExpansionTab[APixel.blue] + (GammaExpansionTab[APixel.red] shl RedShift) + (GammaExpansionTab[APixel.green] shl GreenShift); - cdRG: result := (GammaExpansionTab[APixel.red] shl RedShift) + (GammaExpansionTab[APixel.green] shl GreenShift); - cdGB: result := GammaExpansionTab[APixel.blue] + (GammaExpansionTab[APixel.green] shl GreenShift); - cdRB: result := (GammaExpansionTab[APixel.red] shl RedShift) + GammaExpansionTab[APixel.blue]; - cdRInvG: result := (GammaExpansionTab[APixel.red] shl RedShift) + ((not GammaExpansionTab[APixel.green]) shl GreenShift); - cdGInvB: result := (GammaExpansionTab[APixel.green] shl GreenShift) + (not GammaExpansionTab[APixel.blue]); - cdRInvB: result := (GammaExpansionTab[APixel.red] shl RedShift) + (not GammaExpansionTab[APixel.blue]); - cdRInvGB: result := (GammaExpansionTab[APixel.red] shl RedShift) + ((not GammaExpansionTab[APixel.green]) shl GreenShift) + (not GammaExpansionTab[APixel.blue]); - cdGInvRB: result := (GammaExpansionTab[APixel.green] shl GreenShift) + ((not GammaExpansionTab[APixel.red]) shl RedShift) + (not GammaExpansionTab[APixel.blue]); - cdBInvRG: result := (GammaExpansionTab[APixel.blue]) + ((not GammaExpansionTab[APixel.red]) shl RedShift) + ((not GammaExpansionTab[APixel.green]) shl GreenShift); - cdSaturation: with GammaExpansion(APixel) do - begin - v := red; - if green>v then v := green; - if blue>v then v := blue; - result := v; - v := red; - if green - ((GammaExpansionTab[p2^.red] shl RedShift)+(GammaExpansionTab[p2^.green] shl GreenShift)+GammaExpansionTab[p2^.blue]); -end; - -function IsRGBGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := ((GammaExpansionTab[red] shl RedShift)+(GammaExpansionTab[green] shl GreenShift)+GammaExpansionTab[blue]) >= v; -end; - -function IsRGGreater(p1, p2: PBGRAPixel): boolean; -begin - result := ((GammaExpansionTab[p1^.red] shl RedShift)+(GammaExpansionTab[p1^.green] shl GreenShift)) > - ((GammaExpansionTab[p2^.red] shl RedShift)+(GammaExpansionTab[p2^.green] shl GreenShift)); -end; - -function IsRGGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := ((GammaExpansionTab[red] shl RedShift)+(GammaExpansionTab[green] shl GreenShift)) >= v; -end; - -function IsGBGreater(p1, p2: PBGRAPixel): boolean; -begin - result := ((GammaExpansionTab[p1^.green] shl GreenShift)+GammaExpansionTab[p1^.blue]) > - ((GammaExpansionTab[p2^.green] shl GreenShift)+GammaExpansionTab[p2^.blue]); -end; - -function IsGBGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := ((GammaExpansionTab[green] shl GreenShift)+GammaExpansionTab[blue]) >= v; -end; - -function IsRBGreater(p1, p2: PBGRAPixel): boolean; -begin - result := ((GammaExpansionTab[p1^.red] shl RedShift)+GammaExpansionTab[p1^.blue]) > - ((GammaExpansionTab[p2^.red] shl RedShift)+GammaExpansionTab[p2^.blue]); -end; - -function IsRBGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := ((GammaExpansionTab[red] shl RedShift)+GammaExpansionTab[blue]) >= v; -end; - -function IsRInvGGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := (GammaExpansionTab[p1^.red]+ ((not GammaExpansionTab[p1^.green]) shl GreenShift)) > - (GammaExpansionTab[p2^.red]+((not GammaExpansionTab[p2^.green]) shl GreenShift)); -end; - -function IsRInvGGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := (GammaExpansionTab[red]+((not GammaExpansionTab[green]) shl GreenShift)) >= v; -end; - -function IsGInvBGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := (GammaExpansionTab[p1^.green] shl GreenShift + not GammaExpansionTab[p1^.blue]) > - (GammaExpansionTab[p2^.green] shl GreenShift + not GammaExpansionTab[p2^.blue]); -end; - -function IsGInvBGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := (GammaExpansionTab[green] shl GreenShift + not GammaExpansionTab[blue]) >= v; -end; - -function IsRInvBGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := (GammaExpansionTab[p1^.red] shl RedShift + not GammaExpansionTab[p1^.blue]) > - (GammaExpansionTab[p2^.red] shl RedShift + not GammaExpansionTab[p2^.blue]); -end; - -function IsRInvBGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := (GammaExpansionTab[red] shl RedShift + not GammaExpansionTab[blue]) >= v; -end; - -function IsRInvGBGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := (GammaExpansionTab[p1^.red] shl RedShift + ((not GammaExpansionTab[p1^.green]) shl GreenShift) + not GammaExpansionTab[p1^.blue]) > - (GammaExpansionTab[p2^.red] shl RedShift + ((not GammaExpansionTab[p2^.green]) shl GreenShift) + not GammaExpansionTab[p2^.blue]); -end; - -function IsRInvGBGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := (GammaExpansionTab[red] shl RedShift + ((not GammaExpansionTab[green]) shl GreenShift) + not GammaExpansionTab[blue]) >= v; -end; - -function IsGInvRBGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := (GammaExpansionTab[p1^.green] shl GreenShift + ((not GammaExpansionTab[p1^.red]) shl RedShift) + not GammaExpansionTab[p1^.blue]) > - (GammaExpansionTab[p2^.green] shl GreenShift + ((not GammaExpansionTab[p2^.red]) shl RedShift) + not GammaExpansionTab[p2^.blue]); -end; - -function IsGInvRBGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := (GammaExpansionTab[green] shl GreenShift + ((not GammaExpansionTab[red]) shl RedShift) + not GammaExpansionTab[blue]) >= v; -end; - -function IsBInvRGGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := (GammaExpansionTab[p1^.blue] + ((not GammaExpansionTab[p1^.red]) shl RedShift) + ((not GammaExpansionTab[p1^.green]) shl GreenShift)) > - (GammaExpansionTab[p2^.blue] + ((not GammaExpansionTab[p2^.red]) shl RedShift) + ((not GammaExpansionTab[p2^.green]) shl GreenShift)); -end; - -function IsBInvRGGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - with p^ do - result := (GammaExpansionTab[blue] + ((not GammaExpansionTab[red]) shl RedShift) + ((not GammaExpansionTab[green]) shl GreenShift)) >= v; -end; - -function IsSaturationGreater(p1, p2: PBGRAPixel): boolean; -begin - result := GetDimensionValue(p1^,cdSaturation) > GetDimensionValue(p2^,cdSaturation); -end; - -function IsSaturationGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - result := GetDimensionValue(p^,cdSaturation) >= v; -end; - -function IsRedGreater(p1, p2: PBGRAPixel): boolean; -begin - result := p1^.red > p2^.red; -end; - -function IsRedGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - result := GammaExpansionTab[p^.red] shl RedShift >= v; -end; - -function IsGreenGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := p1^.green > p2^.green; -end; - -function IsGreenGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - result := GammaExpansionTab[p^.green] shl GreenShift >= v; -end; - -function IsBlueGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := p1^.blue > p2^.blue; -end; - -function IsBlueGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - result := GammaExpansionTab[p^.blue] >= v; -end; - -function IsAlphaGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := p1^.alpha > p2^.alpha; -end; - -function IsAlphaGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - result := (p^.alpha + p^.alpha shl 8) shl AlphaShift >= v; -end; - -function IsDWordGreater(p1, p2: PBGRAPixel - ): boolean; -begin - result := LongWord(p1^) > LongWord(p2^); -end; - -function IsDWordGreaterThanValue(p: PBGRAPixel; - v: UInt32): boolean; -begin - result := LongWord(p^) >= v; -end; - -function GetPixelStrictComparer(ADimension: TColorDimension - ): TIsChannelStrictlyGreaterFunc; -begin - case ADimension of - cdFast: result := @IsDWordGreater; - cdRed: result := @IsRedGreater; - cdGreen: result := @IsGreenGreater; - cdBlue: result := @IsBlueGreater; - cdAlpha: result := @IsAlphaGreater; - cdRGB: result := @IsRGBGreater; - cdRG: result := @IsRGGreater; - cdGB: result := @IsGBGreater; - cdRB: result := @IsRBGreater; - cdRInvG: result := @IsRInvGGreater; - cdGInvB: result := @IsGInvBGreater; - cdRInvB: result := @IsRInvBGreater; - cdRInvGB: result := @IsRInvGBGreater; - cdGInvRB: result := @IsGInvRBGreater; - cdBInvRG: result := @IsBInvRGGreater; - cdSaturation: result := @IsSaturationGreater; - else raise Exception.Create('Unknown dimension'); - end; -end; - -function GetPixelValueComparer(ADimension: TColorDimension - ): TIsChannelGreaterThanOrEqualToValueFunc; -begin - case ADimension of - cdFast: result := @IsDWordGreaterThanValue; - cdRed: result := @IsRedGreaterThanValue; - cdGreen: result := @IsGreenGreaterThanValue; - cdBlue: result := @IsBlueGreaterThanValue; - cdAlpha: result := @IsAlphaGreaterThanValue; - cdRGB: result := @IsRGBGreaterThanValue; - cdRG: result := @IsRGGreaterThanValue; - cdGB: result := @IsGBGreaterThanValue; - cdRB: result := @IsRBGreaterThanValue; - cdRInvG: result := @IsRInvGGreaterThanValue; - cdGInvB: result := @IsGInvBGreaterThanValue; - cdRInvB: result := @IsRInvBGreaterThanValue; - cdRInvGB: result := @IsRInvGBGreaterThanValue; - cdGInvRB: result := @IsGInvRBGreaterThanValue; - cdBInvRG: result := @IsBInvRGGreaterThanValue; - cdSaturation: result := @IsSaturationGreaterThanValue; - else raise Exception.Create('Unknown dimension'); - end; -end; - -function BGRAColorCount(ABitmap: TBGRACustomBitmap; - AAlpha: TAlphaChannelPaletteOption): integer; -var - box: TBGRAColorBox; -begin - box := TBGRAColorBox.Create(AllColorDimensions,ABitmap,AAlpha); - result := box.ColorCount[True]; - box.Free; -end; - -const - ApproxPaletteDimensions = [cdAlpha,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG,cdRGB]; - -{ TBGRAApproxPaletteViaLargerPalette } - -function TBGRAApproxPaletteViaLargerPalette.FindNearestLargerColorIndex( - AValue: TBGRAPixel): integer; -begin - result := FLarger.FindNearestColorIndex(AValue); -end; - -function TBGRAApproxPaletteViaLargerPalette.SlowFindNearestColorIndex( - AValue: TBGRAPixel): integer; -var diff,curDiff: Int32or64; - i: Int32or64; -begin - if AValue.alpha = 0 then - begin - result := FTransparentColorIndex; - exit; - end; - diff := BGRAWordDiff(AValue, FColors[0].Color); - result := 0; - for i := 0 to high(FColors) do - begin - curDiff := BGRAWordDiff(AValue, FColors[i].Color); - if curDiff < diff then - begin - result := i; - diff := curDiff; - end; - end; -end; - -constructor TBGRAApproxPaletteViaLargerPalette.Create( - const AColors: ArrayOfTBGRAPixel; ALarger: TBGRACustomApproxPalette; ALargerOwned: boolean); -var i: integer; - largeWeighted: ArrayOfWeightedColor; -begin - inherited Create(AColors); - FTransparentColorIndex:= -1; - for i := 0 to high(FColors) do - begin - FColors[i].Weight := 0; - if FColors[i].Color.alpha = 0 then FTransparentColorIndex:= i; - end; - FLarger := ALarger; - FLargerOwned := ALargerOwned; - largeWeighted := FLarger.GetAsArrayOfWeightedColor; - setlength(FLargerColors, length(largeWeighted)); - for i := 0 to high(FLargerColors) do - with FLargerColors[i] do - begin - approxColorIndex := SlowFindNearestColorIndex(largeWeighted[i].Color); - if approxColorIndex = -1 then - approxColor := BGRAPixelTransparent - else - begin - approxColor := FColors[approxColorIndex].Color; - inc(FColors[approxColorIndex].Weight, largeWeighted[i].Weight); - end; - end; -end; - -destructor TBGRAApproxPaletteViaLargerPalette.Destroy; -begin - if FLargerOwned then FreeAndNil(FLarger); - inherited Destroy; -end; - -function TBGRAApproxPaletteViaLargerPalette.FindNearestColor(AValue: TBGRAPixel - ): TBGRAPixel; -var index: integer; -begin - index := FindNearestLargerColorIndex(AValue); - if index = -1 then - result := BGRAPixelTransparent - else - Result:= FLargerColors[index].approxColor; -end; - -function TBGRAApproxPaletteViaLargerPalette.FindNearestColorIndex( - AValue: TBGRAPixel): integer; -var index: integer; -begin - index := FindNearestLargerColorIndex(AValue); - if index = -1 then - result := -1 - else - Result:= FLargerColors[index].approxColorIndex; -end; - -function TBGRAApproxPaletteViaLargerPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; -var - i: Integer; -begin - setlength(result, length(FColors)); - for i := 0 to high(FColors) do - result[i] := FColors[i]; -end; - -{ TBGRAApproxPalette } - -function TBGRAApproxPalette.GetCount: integer; -begin - result := length(FColors); -end; - -function TBGRAApproxPalette.GetColorByIndex(AIndex: integer): TBGRAPixel; -begin - if (AIndex < 0) or (AIndex >= length(FColors)) then - raise ERangeError.Create('Index out of bounds'); - result := FColors[AIndex].Color; -end; - -function TBGRAApproxPalette.GetWeightByIndex(AIndex: Integer): UInt32; -begin - if (AIndex < 0) or (AIndex >= length(FColors)) then - raise ERangeError.Create('Index out of bounds'); - result := FColors[AIndex].Weight; -end; - -procedure TBGRAApproxPalette.Init(const AColors: ArrayOfTBGRAPixel); -var - weightedColors: ArrayOfWeightedColor; - i: Int32or64; -begin - setlength(weightedColors, length(AColors)); - for i := 0 to high(weightedColors) do - with weightedColors[i] do - begin - Color := AColors[i]; - Weight := 1; - end; - FTree := TBGRAColorTree.Create(TBGRAColorBox.Create(ApproxPaletteDimensions,weightedColors,True),True); - FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage); - - FColors := FTree.GetAsArrayOfWeightedColors; -end; - -constructor TBGRAApproxPalette.Create(const AColors: ArrayOfTBGRAPixel); -begin - Init(AColors); -end; - -constructor TBGRAApproxPalette.Create(const AColors: ArrayOfWeightedColor); -begin - FTree := TBGRAColorTree.Create(TBGRAColorBox.Create(ApproxPaletteDimensions,AColors,True),True); - FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage); - - FColors := FTree.GetAsArrayOfWeightedColors; -end; - -constructor TBGRAApproxPalette.Create(AOwnedSplitTree: TBGRAColorTree); -begin - FTree := AOwnedSplitTree; - FColors := FTree.GetAsArrayOfWeightedColors; -end; - -destructor TBGRAApproxPalette.Destroy; -begin - FreeAndNil(FTree); - inherited Destroy; -end; - -function TBGRAApproxPalette.ContainsColor(AValue: TBGRAPixel): boolean; -begin - result := (IndexOfColor(AValue)<>-1); -end; - -function TBGRAApproxPalette.IndexOfColor(AValue: TBGRAPixel): integer; -begin - result := FTree.ApproximateColorIndex(AValue); - if (result <> -1) and not (LongWord(FColors[result].Color) = LongWord(AValue)) then result := -1; -end; - -function TBGRAApproxPalette.FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; -begin - result := FTree.ApproximateColor(AValue); -end; - -function TBGRAApproxPalette.FindNearestColorIndex(AValue: TBGRAPixel): integer; -begin - result := FTree.ApproximateColorIndex(AValue); -end; - -function TBGRAApproxPalette.GetAsArrayOfColor: ArrayOfTBGRAPixel; -var - i: Int32or64; -begin - setlength(result, length(FColors)); - for i := 0 to high(result) do - result[i] := FColors[i].Color; -end; - -function TBGRAApproxPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; -var - i: Int32or64; -begin - if Assigned(FTree) then - result := FTree.GetAsArrayOfWeightedColors - else - begin - setlength(result, length(FColors)); - for i := 0 to high(result) do - result[i] := FColors[i]; - end; -end; - -{ TBGRAColorQuantizer } - -procedure TBGRAColorQuantizer.Init(ABox: TBGRAColorBox); -begin - FColors := ABox.FColors; - if ABox.HasPureTransparentColor then - begin - setlength(FColors,length(FColors)+1); - with FColors[high(FColors)] do - begin - Color := BGRAPixelTransparent; - Weight:= ABox.PureTransparentColorCount; - end; - end; - ABox.FColors := nil; - ABox.Free; - FReductionColorCount := 256; - FReductionKeepContrast := true; -end; - -procedure TBGRAColorQuantizer.SetReductionColorCount(AValue: Integer); -begin - if AValue < 1 then AValue := 1; - if FReductionColorCount=AValue then Exit; - FReductionColorCount:=AValue; - FreeAndNil(FPalette); -end; - -procedure TBGRAColorQuantizer.NormalizeArrayOfColors( - AColors: ArrayOfTBGRAPixel; ARedBounds, AGreenBounds, ABlueBounds, - AAlphaBounds: TDimensionMinMax; AUniform: boolean); -var - curRedBounds, curGreenBounds, curBlueBounds, curAlphaBounds: TDimensionMinMax; - RedSub,RedMul,RedDiv,RedAdd: UInt32or64; - GreenSub,GreenMul,GreenDiv,GreenAdd: UInt32or64; - BlueSub,BlueMul,BlueDiv,BlueAdd: UInt32or64; - AlphaSub,AlphaMul,AlphaDiv,AlphaAdd: UInt32or64; - i: Int32or64; - colorBounds: TDimensionMinMax; -begin - if length(AColors)=0 then exit; - if AUniform then - begin - colorBounds := ABlueBounds; - colorBounds.GrowToInclude(AGreenBounds.Minimum shr GreenShift); - colorBounds.GrowToInclude(AGreenBounds.Maximum shr GreenShift); - colorBounds.GrowToInclude(ARedBounds.Minimum shr RedShift); - colorBounds.GrowToInclude(ARedBounds.Maximum shr RedShift); - NormalizeArrayOfColors(AColors, colorBounds, AAlphaBounds); - exit; - end; - curRedBounds.SetAsPoint(GetDimensionValue(AColors[0],cdRed)); - curGreenBounds.SetAsPoint(GetDimensionValue(AColors[0],cdGreen)); - curBlueBounds.SetAsPoint(GetDimensionValue(AColors[0],cdBlue)); - curAlphaBounds.SetAsPoint(GetDimensionValue(AColors[0],cdAlpha)); - for i := 1 to high(AColors) do - with AColors[i] do - begin - curRedBounds.GrowToInclude(GetDimensionValue(AColors[i],cdRed)); - curGreenBounds.GrowToInclude(GetDimensionValue(AColors[i],cdGreen)); - curBlueBounds.GrowToInclude(GetDimensionValue(AColors[i],cdBlue)); - curAlphaBounds.GrowToInclude(GetDimensionValue(AColors[i],cdAlpha)); - end; - RedSub := curRedBounds.Minimum shr RedShift; - RedMul := ARedBounds.Size shr RedShift; - RedDiv := curRedBounds.Size shr RedShift; - RedAdd := ARedBounds.Minimum shr RedShift; - if RedDiv = 0 then RedDiv := 1; - GreenSub := curGreenBounds.Minimum shr GreenShift; - GreenMul := AGreenBounds.Size shr GreenShift; - GreenDiv := curGreenBounds.Size shr GreenShift; - GreenAdd := AGreenBounds.Minimum shr GreenShift; - if GreenDiv = 0 then GreenDiv := 1; - BlueSub := curBlueBounds.Minimum; - BlueMul := ABlueBounds.Size; - BlueDiv := curBlueBounds.Size; - BlueAdd := ABlueBounds.Minimum; - if BlueDiv = 0 then BlueDiv := 1; - AlphaSub := curAlphaBounds.Minimum shr (AlphaShift+8); - AlphaMul := AAlphaBounds.Size shr (AlphaShift+8); - AlphaDiv := curAlphaBounds.Size shr (AlphaShift+8); - AlphaAdd := AAlphaBounds.Minimum shr (AlphaShift+8); - if AlphaDiv = 0 then AlphaDiv := 1; - for i := 0 to high(AColors) do - with AColors[i] do - begin - red := GammaCompressionTab[((GammaExpansionTab[red]-RedSub)*RedMul+(RedDiv shr 1)) div RedDiv + RedAdd]; - green := GammaCompressionTab[((GammaExpansionTab[green]-GreenSub)*GreenMul+(GreenDiv shr 1)) div GreenDiv + GreenAdd]; - blue := GammaCompressionTab[((GammaExpansionTab[blue]-BlueSub)*BlueMul+(BlueDiv shr 1)) div BlueDiv + BlueAdd]; - alpha := ((alpha-AlphaSub)*AlphaMul+(AlphaDiv shr 1)) div AlphaDiv + AlphaAdd; - end; -end; - -procedure TBGRAColorQuantizer.NormalizeArrayOfColors( - AColors: ArrayOfTBGRAPixel; AColorBounds, AAlphaBounds: TDimensionMinMax); -var - curColorBounds, curAlphaBounds: TDimensionMinMax; - ColorSub,ColorMul,ColorDiv,ColorAdd: UInt32or64; - AlphaSub,AlphaMul,AlphaDiv,AlphaAdd: UInt32or64; - i: Int32or64; -begin - if length(AColors)=0 then exit; - curColorBounds.SetAsPoint(GammaExpansionTab[AColors[0].red]); - curColorBounds.GrowToInclude(GammaExpansionTab[AColors[0].green]); - curColorBounds.GrowToInclude(GammaExpansionTab[AColors[0].blue]); - curAlphaBounds.SetAsPoint(AColors[0].alpha); - for i := 1 to high(AColors) do - with AColors[i] do - begin - curColorBounds.GrowToInclude(GammaExpansionTab[red]); - curColorBounds.GrowToInclude(GammaExpansionTab[green]); - curColorBounds.GrowToInclude(GammaExpansionTab[blue]); - curAlphaBounds.GrowToInclude(alpha); - end; - ColorSub := curColorBounds.Minimum; - ColorMul := AColorBounds.Size; - ColorDiv := curColorBounds.Size; - ColorAdd := AColorBounds.Minimum; - if ColorDiv = 0 then ColorDiv := 1; - AlphaSub := curAlphaBounds.Minimum; - AlphaMul := AAlphaBounds.Size shr 8; - AlphaDiv := curAlphaBounds.Size; - AlphaAdd := AAlphaBounds.Minimum shr 8; - if AlphaDiv = 0 then AlphaDiv := 1; - for i := 0 to high(AColors) do - with AColors[i] do - begin - red := GammaCompressionTab[((GammaExpansionTab[red]-ColorSub)*ColorMul+(ColorDiv shr 1)) div ColorDiv + ColorAdd]; - green := GammaCompressionTab[((GammaExpansionTab[green]-ColorSub)*ColorMul+(ColorDiv shr 1)) div ColorDiv + ColorAdd]; - blue := GammaCompressionTab[((GammaExpansionTab[blue]-ColorSub)*ColorMul+(ColorDiv shr 1)) div ColorDiv + ColorAdd]; - alpha := ((alpha-AlphaSub)*AlphaMul+(AlphaDiv shr 1)) div AlphaDiv + AlphaAdd; - end; -end; - -function TBGRAColorQuantizer.GetSourceColorCount: Integer; -begin - result := length(FColors); -end; - -function TBGRAColorQuantizer.GetReductionColorCount: integer; -begin - result := FReductionColorCount; -end; - -function TBGRAColorQuantizer.GetPalette: TBGRACustomApproxPalette; -var - tree: TBGRAColorTree; - - procedure MakeTreeErrorDiffusionFriendly; - var moreColors: ArrayOfWeightedColor; - box: TBGRAColorBox; - begin - moreColors := tree.GetAsArrayOfWeightedColors; - tree.free; - box := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],moreColors,True); - tree := TBGRAColorTree.Create(box,True); - tree.SplitIntoPalette(box.ColorCount[true], blApparentInterval, lcAverage); - end; - -var - originalBox: TBGRAColorBox; - colors: ArrayOfTBGRAPixel; - bounds: array[TColorDimension] of TDimensionMinMax; - nbLarge,nbOriginal: integer; - -begin - if not Assigned(FPalette) then - if FReductionColorCount >= length(FColors) then - begin - originalBox := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],FColors, False); - tree := TBGRAColorTree.Create(originalBox,True); - tree.SplitIntoPalette(originalBox.ColorCount[true], blApparentInterval, lcAverage); - FPalette := TBGRAApproxPalette.Create(tree); - end else - begin - originalBox := TBGRAColorBox.Create(AllColorDimensions, FColors, False); - bounds[cdRed] := originalBox.Bounds[cdRed]; - bounds[cdGreen] := originalBox.Bounds[cdGreen]; - bounds[cdBlue] := originalBox.Bounds[cdBlue]; - bounds[cdAlpha] := originalBox.Bounds[cdAlpha]; - if originalBox.HasPureTransparentColor then bounds[cdAlpha].Minimum := 0; - if FReductionColorCount = 1 then - begin - setlength(colors,1); - colors[0] := originalBox.AverageColor; - originalBox.Free; - FPalette := TBGRAApproxPalette.Create(colors); - end else - begin - tree := TBGRAColorTree.Create(originalBox,True); - if FReductionColorCount <= 64 then - begin - nbLarge := 128; - nbOriginal := originalBox.ColorCount[True]; - if nbOriginal < 128 then nbLarge:= nbOriginal; - colors := tree.SplitIntoPaletteWithSubPalette(nbLarge, blMix,lcMix, FReductionColorCount); - MakeTreeErrorDiffusionFriendly; - if FReductionColorCount <= 4 then - NormalizeArrayOfColors(colors, bounds[cdRed],bounds[cdGreen],bounds[cdBlue],bounds[cdAlpha],true); - FPalette := TBGRAApproxPaletteViaLargerPalette.Create(colors, TBGRAApproxPalette.Create(tree), True); - end else - begin - tree.SplitIntoPalette(FReductionColorCount, blMix,lcMix); - MakeTreeErrorDiffusionFriendly; - FPalette := TBGRAApproxPalette.Create(tree); - end; - end; - end; - result := FPalette; -end; - -function TBGRAColorQuantizer.GetSourceColor(AIndex: integer): TBGRAPixel; -begin - if (AIndex < 0) or (AIndex >= length(FColors)) then - raise ERangeError.Create('Index out of bounds'); - result := FColors[AIndex].Color; -end; - -constructor TBGRAColorQuantizer.Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); -begin - FSeparateAlphaChannel:= ASeparateAlphaChannel; - Init(TBGRAColorBox.Create(AllColorDimensions, APalette)); -end; - -constructor TBGRAColorQuantizer.Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); -begin - FSeparateAlphaChannel:= (AAlpha = acIgnore); - Init(TBGRAColorBox.Create(AllColorDimensions, ABitmap, AAlpha)); -end; - -constructor TBGRAColorQuantizer.Create(APalette: TBGRACustomPalette; - ASeparateAlphaChannel: boolean; AReductionColorCount: integer); -begin - FSeparateAlphaChannel:= ASeparateAlphaChannel; - Init(TBGRAColorBox.Create(AllColorDimensions, APalette)); - ReductionColorCount := AReductionColorCount; -end; - -constructor TBGRAColorQuantizer.Create(ABitmap: TBGRACustomBitmap; - AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); -begin - FSeparateAlphaChannel:= (AAlpha = acIgnore); - Init(TBGRAColorBox.Create(AllColorDimensions, ABitmap, AAlpha)); - ReductionColorCount := AReductionColorCount; -end; - -destructor TBGRAColorQuantizer.Destroy; -begin - FreeAndNil(FPalette); - inherited Destroy; -end; - -procedure TBGRAColorQuantizer.ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; - ABounds: TRect); -var task: TDitheringTask; -begin - task := CreateDitheringTask(AAlgorithm, ABitmap, ReducedPalette, FSeparateAlphaChannel, ABounds); - task.Destination := ABitmap; - task.Execute; - task.Free; -end; - -function TBGRAColorQuantizer.GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; - ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; -var task: TDitheringTask; -begin - task := CreateDitheringTask(AAlgorithm, ABitmap, ReducedPalette, FSeparateAlphaChannel, ABounds); - result := task.Execute; - task.Free; -end; - -function TBGRAColorQuantizer.GetDitheredBitmapIndexedData( - ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; - out AScanlineSize: PtrInt): Pointer; -var - indexer: TDitheringToIndexedImage; -begin - indexer := TDitheringToIndexedImage.Create(ReducedPalette, FSeparateAlphaChannel, ABitDepth, AByteOrder); - indexer.DefaultTransparentColorIndex := ReducedPalette.IndexOfColor(BGRAPixelTransparent); - AScanlineSize:= indexer.ComputeMinimumScanlineSize(ABitmap.Width); - result := indexer.DitherImage(AAlgorithm, ABitmap, AScanlineSize); - indexer.Free; -end; - -procedure TBGRAColorQuantizer.SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; - AStream: TStream; AFormat: TBGRAImageFormat); -var - dithered: TBGRACustomBitmap; - hasTransp: boolean; - writer: TFPCustomImageWriter; - depth: integer; -begin - dithered := GetDitheredBitmap(AAlgorithm, ABitmap); - try - ReducedPalette.AssignTo(dithered); - hasTransp := dithered.HasTransparentPixels; - writer := CreateBGRAImageWriter(AFormat, hasTransp); - try - if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).Indexed := true else - if writer is TFPWriterBMP then - begin - if not hasTransp then - begin - depth := BGRARequiredBitDepth(ReducedPalette); - if depth < 8 then - begin - if depth > 4 then - depth := 8 - else if depth > 1 then - depth := 4; - end; - TFPWriterBMP(writer).BitsPerPixel := depth; - end; - end; - dithered.SaveToStream(AStream, writer); - finally - writer.Free; - end; - finally - dithered.Free; - end; -end; - -{ TBGRAColorTree } - -function TBGRAColorTree.TrySplitLeaf: boolean; -var - dim: TColorDimension; - box2: TBGRAColorBox; - mid: UInt32; -begin - result := false; - if IsLeaf and Assigned(FLeaf) and not FLeaf.PointLike then - begin - dim := FLeaf.LargestApparentDimension; - box2 := FLeaf.MedianCut(dim,mid); - if box2 <> nil then - begin - FInferiorBranch := TBGRAColorTree.Create(FLeaf,True); - FSuperiorBranch := TBGRAColorTree.Create(box2,True); - - FInferiorBranch.FMinBorder := FMinBorder; - FInferiorBranch.FMaxBorder := FMaxBorder; - FSuperiorBranch.FMinBorder := FMinBorder; - FSuperiorBranch.FMaxBorder := FMaxBorder; - FInferiorBranch.FMaxBorder[dim] := false; - FSuperiorBranch.FMinBorder[dim] := false; - - FLeaf := nil; - FIsLeaf:= false; - FDimension := dim; - FPixelValueComparer := GetPixelValueComparer(FDimension); - FSuperiorMiddle := mid; - result := true; - end; - end; -end; - -procedure TBGRAColorTree.ComputeLeavesColor(ALeafColor: TBGRALeafColorMode); -var index: integer; -begin - index := 0; - if HasPureTransparentColor then - begin - FPureTransparentColorIndex:= index; - inc(index); - end; - InternalComputeLeavesColor(ALeafColor,{%H-}index); -end; - -procedure TBGRAColorTree.InternalComputeLeavesColor( - ALeafColor: TBGRALeafColorMode; var AStartIndex: integer); -var nbMin,nbMax: Int32or64; - c: TColorDimension; - extremumColor: TBGRAPixel; - extremumColorRelevant: Boolean; -begin - if IsLeaf then - begin - FLeafColorIndex := AStartIndex; - inc(AStartIndex); - if Assigned(FLeaf) then - begin - if not FLeafColorComputed then - begin - FLeafColorComputed := true; - FCenterColor.alpha:= min(FLeaf.FBounds[cdAlpha].GetCenter shr AlphaShift, 255); - FCenterColor.red:= GammaCompressionTab[min(FLeaf.FBounds[cdRed].GetCenter shr RedShift, 65535)]; - FCenterColor.green:= GammaCompressionTab[min(FLeaf.FBounds[cdGreen].GetCenter shr GreenShift, 65535)]; - FCenterColor.blue:= GammaCompressionTab[min(FLeaf.FBounds[cdBlue].GetCenter, 65535)]; - FAverageColor := FLeaf.AverageColorOrMainColor; - extremumColor := FAverageColor; - - if ALeafColor in [lcMix,lcExtremum] then - begin - nbMax := 0; - nbMin := 0; - for c := succ(low(TColorDimension)) to high(TColorDimension) do - begin - if FMinBorder[c] then inc(nbMin); - if FMaxBorder[c] then inc(nbMax); - end; - - if nbMin > nbMax then - extremumColor := FLeaf.InferiorColor - else if nbMax > nbMin then - extremumColor := FLeaf.SuperiorColor; - end; - - case ALeafColor of - lcAverage,lcMix: FLeafColor := FAverageColor; - lcExtremum: FLeafColor := extremumColor; - else FLeafColor := FCenterColor; - end; - - if ALeafColor = lcMix then - begin - extremumColorRelevant := false; - for c := succ(low(TColorDimension)) to high(TColorDimension) do - if UInt32(abs(GetDimensionValue(extremumColor,c) - GetDimensionValue(FLeafColor,c))) > - FLeaf.FBounds[c].Size div 7 then - begin - extremumColorRelevant := true; - break; - end; - if extremumColorRelevant then FLeafColor := extremumColor; - end; - end; - end else - begin - FLeafColor := BGRAPixelTransparent; - FCenterColor := BGRAPixelTransparent; - end; - end else - begin - if Assigned(FInferiorBranch) then FInferiorBranch.InternalComputeLeavesColor(ALeafColor, AStartIndex); - if Assigned(FSuperiorBranch) then FSuperiorBranch.InternalComputeLeavesColor(ALeafColor, AStartIndex); - end; -end; - -procedure TBGRAColorTree.CheckColorComputed; -begin - if not FLeafColorComputed then - raise exception.Create('Color not computed. Call ComputeLeavesColor first.'); -end; - -function TBGRAColorTree.ApproximateColor(AColor: TBGRAPixel): TBGRAPixel; -var branch: TBGRAColorTree; -begin - if AColor.alpha = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - if IsLeaf then - begin - CheckColorComputed; - result := FLeafColor; - end else - begin - if FPixelValueComparer(@AColor,FSuperiorMiddle) then - branch := FSuperiorBranch else branch := FInferiorBranch; - if Assigned(branch) then - result := branch.ApproximateColor(AColor) - else - result := BGRAPixelTransparent; - end; -end; - -function TBGRAColorTree.ApproximateColorIndex(AColor: TBGRAPixel): integer; -var branch: TBGRAColorTree; -begin - if AColor.alpha = 0 then - begin - result := FPureTransparentColorIndex; - exit; - end; - if IsLeaf then - begin - CheckColorComputed; - result := FLeafColorIndex; - end else - begin - if FPixelValueComparer(@AColor,FSuperiorMiddle) then - branch := FSuperiorBranch else branch := FInferiorBranch; - if Assigned(branch) then - result := branch.ApproximateColorIndex(AColor) - else - result := FPureTransparentColorIndex; - end; -end; - -function TBGRAColorTree.GetAsArrayOfApproximatedColors: ArrayOfTBGRAPixel; -var a,b: ArrayOfTBGRAPixel; - idx,i: integer; -begin - if IsLeaf then - begin - CheckColorComputed; - setlength(result,1+byte(HasPureTransparentColor)); - idx := 0; - if HasPureTransparentColor then - begin - result[idx] := BGRAPixelTransparent; - inc(idx); - end; - result[idx] := FLeafColor; - end else - begin - a := FInferiorBranch.GetAsArrayOfApproximatedColors; - b := FSuperiorBranch.GetAsArrayOfApproximatedColors; - setlength(result, length(a)+length(b)+byte(HasPureTransparentColor)); - idx := 0; - if HasPureTransparentColor then - begin - result[idx] := BGRAPixelTransparent; - inc(idx); - end; - for i := 0 to high(a) do - begin - result[idx] := a[i]; - inc(idx); - end; - for i := 0 to high(b) do - begin - result[idx] := b[i]; - inc(idx); - end; - end; -end; - -function TBGRAColorTree.GetAsArrayOfWeightedColors: ArrayOfWeightedColor; -var a,b: ArrayOfWeightedColor; - idx,i: integer; -begin - if IsLeaf then - begin - CheckColorComputed; - setlength(result,1+byte(HasPureTransparentColor)); - idx := 0; - if HasPureTransparentColor then - begin - result[idx].Color := BGRAPixelTransparent; - result[idx].Weight := PureTransparentColorCount; - inc(idx); - end; - result[idx].Color := FLeafColor; - result[idx].Weight := Weight; - end else - begin - a := FInferiorBranch.GetAsArrayOfWeightedColors; - b := FSuperiorBranch.GetAsArrayOfWeightedColors; - setlength(result, length(a)+length(b)+byte(HasPureTransparentColor)); - idx := 0; - if HasPureTransparentColor then - begin - result[idx].Color := BGRAPixelTransparent; - result[idx].Weight := PureTransparentColorCount; - inc(idx); - end; - for i := 0 to high(a) do - begin - result[idx] := a[i]; - inc(idx); - end; - for i := 0 to high(b) do - begin - result[idx] := b[i]; - inc(idx); - end; - end; -end; - -procedure TBGRAColorTree.SplitIntoPalette(ACount: integer; - AMethod: TBiggestLeafMethod; ALeafColor: TBGRALeafColorMode); -var nbColors: integer; - leaf: TBGRAColorTree; -begin - nbColors := ApproximatedColorCount; - while nbColors < ACount do - begin - leaf := FindBiggestLeaf(AMethod); - if not leaf.TrySplitLeaf then break; - inc(nbColors); - end; - ComputeLeavesColor(ALeafColor); - FreeLeaves; -end; - -function TBGRAColorTree.SplitIntoPaletteWithSubPalette(ACount: integer; - AMethod: TBiggestLeafMethod; ALeafColor: TBGRALeafColorMode; - ASubPaletteCount: integer): ArrayOfTBGRAPixel; -var nbColors: integer; - leaf: TBGRAColorTree; -begin - result := nil; - nbColors := ApproximatedColorCount; - if ASubPaletteCount > ACount then ASubPaletteCount:= ACount; - if nbColors = ASubPaletteCount then - begin - ComputeLeavesColor(ALeafColor); - result := GetAsArrayOfApproximatedColors; - end; - while nbColors < ACount do - begin - leaf := FindBiggestLeaf(AMethod); - if not leaf.TrySplitLeaf then break; - inc(nbColors); - if nbColors = ASubPaletteCount then - begin - ComputeLeavesColor(ALeafColor); - result := GetAsArrayOfApproximatedColors; - end; - end; - ComputeLeavesColor(ALeafColor); - FreeLeaves; -end; - -function TBGRAColorTree.GetLeafCount: integer; -begin - if IsLeaf then - result := 1 - else - begin - result := 0; - if Assigned(FInferiorBranch) then inc(result, FInferiorBranch.LeafCount); - if Assigned(FSuperiorBranch) then inc(result, FSuperiorBranch.LeafCount); - end; -end; - -function TBGRAColorTree.GetApproximatedColorCount: integer; -begin - if IsLeaf then - result := 1 - else - begin - result := 0; - if Assigned(FInferiorBranch) then inc(result, FInferiorBranch.ApproximatedColorCount); - if Assigned(FSuperiorBranch) then inc(result, FSuperiorBranch.ApproximatedColorCount); - end; - if HasPureTransparentColor then inc(result); -end; - -function TBGRAColorTree.GetHasPureTransparentColor: boolean; -begin - result := FPureTransparentColorCount > 0; -end; - -procedure TBGRAColorTree.Init(ALeaf: TBGRAColorBox; AOwned: boolean); -var - c: TColorDimension; -begin - if not AOwned then - FLeaf := ALeaf.Duplicate - else - FLeaf := ALeaf; - FLargestApparentInterval:= FLeaf.LargestApparentInterval; - FWeight := FLeaf.TotalWeight; - FIsLeaf:= true; - for c := low(TColorDimension) to high(TColorDimension) do - begin - FMinBorder[c] := true; - FMaxBorder[c] := true; - end; - FPureTransparentColorCount:= FLeaf.PureTransparentColorCount; - FPureTransparentColorIndex:= -1; -end; - -constructor TBGRAColorTree.Create(ABox: TBGRAColorBox; AOwned: boolean); -begin - Init(ABox,AOwned); -end; - -constructor TBGRAColorTree.Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); -begin - Init(TBGRAColorBox.Create(ADimensions, APalette),True); -end; - -constructor TBGRAColorTree.Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); -begin - Init(TBGRAColorBox.Create(ADimensions, ABitmap, AAlpha),True); -end; - -destructor TBGRAColorTree.Destroy; -begin - FreeAndNil(FInferiorBranch); - FreeAndNil(FSuperiorBranch); - FreeAndNil(FLeaf); - inherited Destroy; -end; - -procedure TBGRAColorTree.FreeLeaves; -begin - if IsLeaf then - FreeAndNil(FLeaf) - else - begin - if Assigned(FInferiorBranch) then FInferiorBranch.FreeLeaves; - if Assigned(FSuperiorBranch) then FSuperiorBranch.FreeLeaves; - end; -end; - -function TBGRAColorTree.FindBiggestLeaf(AMethod: TBiggestLeafMethod - ): TBGRAColorTree; -var infLeaf,supLeaf: TBGRAColorTree; -begin - if IsLeaf then - result := self - else - begin - infLeaf := FInferiorBranch.FindBiggestLeaf(AMethod); - supLeaf := FSuperiorBranch.FindBiggestLeaf(AMethod); - case AMethod of - blApparentInterval: - if infLeaf.LargestApparentInterval >= supLeaf.LargestApparentInterval then - result := infLeaf - else - result := supLeaf; - blWeight: - if (infLeaf.LargestApparentInterval > 0) and (infLeaf.Weight >= supLeaf.Weight) then - result := infLeaf - else - result := supLeaf; - else{blMix:} - if (sqrt(infLeaf.Weight/FWeight)*(infLeaf.LargestApparentInterval/LargestApparentInterval) >= - sqrt(supLeaf.Weight/FWeight)*(supLeaf.LargestApparentInterval/LargestApparentInterval) ) then - result := infLeaf - else - result := supLeaf; - end; - end; -end; - -{ TDimensionMinMax } - -function TDimensionMinMax.Size: UInt32; -begin - if Maximum>Minimum then - result := Maximum-Minimum - else - result := 0; -end; - -function TDimensionMinMax.Contains(AValue: UInt32): boolean; -begin - result := (AValue >= Minimum) and (AValue <= Maximum); -end; - -function TDimensionMinMax.PointLike: boolean; -begin - result := (Minimum = Maximum); -end; - -procedure TDimensionMinMax.SetAsPoint(AValue: UInt32); -begin - Minimum := AValue; - Maximum := AValue; -end; - -function TDimensionMinMax.GetCenter: UInt32; -begin - result := (Minimum+Maximum) shr 1; -end; - -procedure TDimensionMinMax.GrowToInclude(AValue: UInt32); -begin - if AValue < Minimum then Minimum := AValue - else if AValue > Maximum then Maximum := AValue; -end; - -{ TBGRAColorBox } - -function TBGRAColorBox.GetApparentInterval(ADimension: TColorDimension): UInt32; -var factor: single; -begin - if not (ADimension in FDimensions) then result := 0 - else - begin - factor := 1; - case ADimension of - cdRGB: factor := 0.7; - end; - result := round(FBounds[ADimension].Size*factor); - end; -end; - -function TBGRAColorBox.GetAverageColor: TBGRAPixel; -var - n: integer; - r, g, b, a: double; - cura: double; - w: UInt32; -begin - a := 0; - r := 0; - g := 0; - b := 0; - w := 0; - for n := 0 to high(FColors) do - with FColors[n].Color do - begin - cura := (alpha / 255)*FColors[n].Weight; - IncF(a, cura); - IncF(r, GammaExpansionTab[red] * cura); - IncF(g, GammaExpansionTab[green] * cura); - IncF(b, GammaExpansionTab[blue] * cura); - Inc(w, FColors[n].Weight); - end; - if w = 0 then - Result := BGRAPixelTransparent - else - begin - result.alpha := round(a*255/w); - if result.alpha = 0 then result := BGRAPixelTransparent - else - begin - result.red := GammaCompressionTab[round(r / a)]; - result.green := GammaCompressionTab[round(g / a)]; - result.blue := GammaCompressionTab[round(b / a)]; - end; - end; -end; - -function TBGRAColorBox.GetAverageColorOrMainColor: TBGRAPixel; -var i: integer; - maxWeight: UInt32; -begin - result := BGRAPixelTransparent; - maxWeight:= 0; - for i := 0 to high(FColors) do - with FColors[i] do - begin - if Weight > maxWeight then - begin - maxWeight:= Weight; - result := Color; - end; - end; - if maxWeight <= 3*FTotalWeight shr 2 then - result := GetAverageColor; -end; - -function TBGRAColorBox.GetBounds(ADimension: TColorDimension): TDimensionMinMax; -begin - result := FBounds[ADimension]; -end; - -function TBGRAColorBox.GetColorCount(ACountPureTransparent: boolean): integer; -begin - result := length(FColors); - if ACountPureTransparent and HasPureTransparentColor then inc(result); -end; - -function TBGRAColorBox.GetHasPureTransparentColor: boolean; -begin - result := FPureTransparentColorCount > 0; -end; - -function TBGRAColorBox.GetInferiorColor: TBGRAPixel; -var - n: integer; - r, g, b, a: double; - w: UInt32; - cura: double; - wantedWeight: UInt32; -begin - a := 0; - r := 0; - g := 0; - b := 0; - w := 0; - wantedWeight:= FTotalWeight div 10; - for n := 0 to high(FColors) do - with FColors[n].Color do - begin - cura := (alpha / 255)*FColors[n].Weight; - IncF(a, cura); - IncF(r, red * cura); - IncF(g, green * cura); - IncF(b, blue * cura); - Inc(w, FColors[n].Weight); - if w >= wantedWeight then break; - end; - if w = 0 then - Result := BGRAPixelTransparent - else - begin - result.alpha := round(a*255/w); - if result.alpha = 0 then result := BGRAPixelTransparent - else - begin - result.red := round(r / a); - result.green := round(g / a); - result.blue := round(b / a); - end; - end; -end; - -function TBGRAColorBox.GetLargestApparentDimension: TColorDimension; -var c: TColorDimension; - curApparentInterval, maxApparentInterval: UInt32; -begin - c := succ(low(TColorDimension)); - result := c; - maxApparentInterval:= ApparentInterval[c]; - while c < high(TColorDimension) do - begin - inc(c); - curApparentInterval:= ApparentInterval[c]; - if curApparentInterval > maxApparentInterval then - begin - maxApparentInterval:= curApparentInterval; - result := c; - end; - end; -end; - -function TBGRAColorBox.GetLargestApparentInterval: UInt32; -var - curApparentInterval: UInt32; - c: TColorDimension; -begin - result:= ApparentInterval[succ(low(TColorDimension))]; - for c := succ(succ(low(TColorDimension))) to high(TColorDimension) do - begin - curApparentInterval:= ApparentInterval[c]; - if curApparentInterval > result then - result := curApparentInterval; - end; -end; - -function TBGRAColorBox.GetPointLike: boolean; -var c: TColorDimension; -begin - for c := succ(low(TColorDimension)) to high(TColorDimension) do - if not FBounds[c].PointLike then - begin - result := false; - exit; - end; - result := true; -end; - -function TBGRAColorBox.GetSuperiorColor: TBGRAPixel; -var - n: integer; - r, g, b, a: double; - w: UInt32; - cura: double; - wantedWeight: UInt32; -begin - a := 0; - r := 0; - g := 0; - b := 0; - w := 0; - wantedWeight:= FTotalWeight div 10; - for n := high(FColors) downto 0 do - with FColors[n].Color do - begin - cura := (alpha / 255)*FColors[n].Weight; - IncF(a, cura); - IncF(r, red * cura); - IncF(g, green * cura); - IncF(b, blue * cura); - Inc(w, FColors[n].Weight); - if w >= wantedWeight then break; - end; - if w = 0 then - Result := BGRAPixelTransparent - else - begin - result.alpha := round(a*255/w); - if result.alpha = 0 then result := BGRAPixelTransparent - else - begin - result.red := round(r / a); - result.green := round(g / a); - result.blue := round(b / a); - end; - end; -end; - -procedure TBGRAColorBox.Init(AColors: ArrayOfWeightedColor; AOwner: boolean); -var - i,idx: Int32or64; - FirstColor: boolean; - c: TColorDimension; -begin - FPureTransparentColorCount:= 0; - FTotalWeight:= 0; - for c := low(TColorDimension) to high(TColorDimension) do - FBounds[c].SetAsPoint(0); - FirstColor := True; - if AOwner then - FColors := AColors - else - SetLength(FColors, length(AColors)); - idx := 0; - for i := 0 to high(AColors) do - with AColors[i] do - begin - if Color.alpha > 0 then - begin - if FirstColor then - begin - for c := low(TColorDimension) to high(TColorDimension) do - FBounds[c].SetAsPoint(GetDimensionValue(Color,c)); - FirstColor := false; - end else - begin - for c := low(TColorDimension) to high(TColorDimension) do - FBounds[c].GrowToInclude(GetDimensionValue(Color,c)); - end; - inc(FTotalWeight, Weight); - if not AOwner or (idx <> i) then - FColors[idx] := AColors[i]; - inc(idx); - end else - inc(FPureTransparentColorCount, Weight); - end; - setlength(FColors,idx); -end; - -procedure TBGRAColorBox.SortBy(ADimension: TColorDimension); -var comparer: TIsChannelStrictlyGreaterFunc; -begin - comparer := GetPixelStrictComparer(ADimension); - if comparer = nil then exit; - ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),comparer) -end; - -function TBGRAColorBox.GetMedianIndex(ADimension: TColorDimension; - AMinValue, AMaxValue: UInt32 - ): integer; -var i: integer; - sum,goal: UInt32; - valueComparer: TIsChannelGreaterThanOrEqualToValueFunc; - strictComparer: TIsChannelStrictlyGreaterFunc; - ofs: integer; -begin - if length(FColors) = 1 then - begin - result := 0; - exit; - end else - if length(FColors) = 0 then - begin - result := -1; - exit; - end; - valueComparer:= GetPixelValueComparer(ADimension); - sum := 0; - goal := (FTotalWeight+1) shr 1; - result := high(FColors) shr 1; - for i := 0 to high(FColors) do - begin - inc(sum, FColors[i].Weight); - if (sum>=goal) and (valueComparer(@FColors[i].Color, AMinValue)) then - begin - result := i; - while (result > 0) and (valueComparer(@FColors[result].Color, AMaxValue+1)) do dec(result); - break; - end; - end; - if result = 0 then inc(result); - //check that there it is not splitting consecutive colors with the same value - strictComparer := GetPixelStrictComparer(ADimension); - ofs := 0; - while true do - begin - if (result-ofs < 1) and (result+ofs > high(FColors)) then break; - if (result-ofs >= 1) and strictComparer(@FColors[result-ofs].Color,@FColors[result-ofs-1].Color) then - begin - result := result-ofs; - exit; - end; - if (result+ofs <= high(FColors)) and strictComparer(@FColors[result+ofs].Color,@FColors[result+ofs-1].Color) then - begin - result := result+ofs; - exit; - end; - inc(ofs); - end; -end; - -constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; AColors: ArrayOfWeightedColor; AOwner: boolean); -begin - FDimensions:= ADimensions; - Init(AColors,AOwner); -end; - -constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; - const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette); -var weightedColors: ArrayOfWeightedColor; - i: Integer; -begin - if AAlpha = acFullChannelInPalette then - begin - FDimensions:= ADimensions; - setlength(weightedColors, length(AColors)); - for i := 0 to high(weightedColors) do - with weightedColors[i] do - begin - color := AColors[i]; - Weight:= 1; - end; - Init(weightedColors,True); - end else - Create(ADimensions, @AColors[0], length(AColors), AAlpha); -end; - -constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; ABounds: TColorBoxBounds); -begin - FDimensions:= ADimensions; - FBounds := ABounds; - FTotalWeight:= 0; - FPureTransparentColorCount:= 0; -end; - -constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); -begin - FDimensions:= ADimensions; - Init(APalette.GetAsArrayOfWeightedColor,False); -end; - -constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; - ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); -begin - Create(ADimensions, ABitmap.Data, ABitmap.NbPixels, AAlpha); -end; - -constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption); -var i,j,prev,idx: integer; - p: PBGRAPixel; - skip: boolean; - alphaMask: LongWord; - transpIndex: integer; -begin - if AAlpha <> acFullChannelInPalette then - alphaMask := LEtoN($FF000000) - else - alphaMask := 0; - FDimensions:= ADimensions; - transpIndex := -1; - SetLength(FColors,ANbPixels); - if length(FColors)>0 then - begin - p := AColors; - idx := 0; - for i := 0 to ANbPixels-1 do - begin - if (p^.alpha = 0) or ((AAlpha = acTransparentEntry) and (p^.alpha < 128)) then - begin - skip := true; - if not (AAlpha = acIgnore) then - begin - if (transpIndex=-1) then - begin - transpIndex := idx; - with FColors[idx] do - begin - Color := BGRAPixelTransparent; - Weight:= 1; - end; - inc(idx); - end else - inc(FColors[transpIndex].Weight); - end; - if (p^.alpha = 0) then - begin - inc(p); - continue; - end; - end; - skip := false; - for j := idx-1 downto idx-10 do - if j < 0 then - break - else - with FColors[j] do - if LongWord(Color)=LongWord(p^) or alphaMask then - begin - skip := true; - inc(Weight); - break; - end; - if skip then - begin - inc(p); - continue; - end; - with FColors[idx] do - begin - Color := p^; - if AAlpha <> acFullChannelInPalette then Color.alpha := 255; - Weight := 1; - inc(p); - inc(idx); - end; - end; - setLength(FColors, idx); - - ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),@IsDWordGreater); - prev := 0; - for i := 1 to high(FColors) do - begin - if LongWord(FColors[i].Color)=LongWord(FColors[prev].Color) then - inc(FColors[prev].Weight, FColors[i].Weight) - else - begin - inc(prev); - if i <> prev then - FColors[prev] := FColors[i]; - end; - end; - setlength(FColors, prev+1); - end; - Init(FColors,True); -end; - -function TBGRAColorBox.BoundsContain(AColor: TBGRAPixel): boolean; -var c: TColorDimension; -begin - for c := succ(low(TColorDimension)) to high(TColorDimension) do - if not FBounds[c].Contains(GetDimensionValue(AColor,c)) then - begin - result := false; - exit; - end; - result := true; -end; - -function TBGRAColorBox.MedianCut(ADimension: TColorDimension; out SuperiorMiddle: UInt32 - ): TBGRAColorBox; -var idxSplit: Int32or64; - secondArray: ArrayOfWeightedColor; - i: Int32or64; -begin - result := nil; - SuperiorMiddle := 0; - if FBounds[ADimension].PointLike then exit; - if length(FColors) <= 1 then exit; - SortBy(ADimension); - idxSplit := GetMedianIndex(ADimension, - round(FBounds[ADimension].Minimum*(1-MedianMinPercentage)+FBounds[ADimension].Maximum*MedianMinPercentage), - round(FBounds[ADimension].Minimum*MedianMinPercentage+FBounds[ADimension].Maximum*(1-MedianMinPercentage))); - if idxSplit = -1 then exit; - setlength(secondArray, length(FColors)-idxSplit); - for i := idxSplit to high(FColors) do - secondArray[i-idxSplit] := FColors[i]; - result := TBGRAColorBox.Create(FDimensions, secondArray,True); - setlength(FColors, idxSplit); - Init(FColors,True); - SuperiorMiddle := (FBounds[ADimension].Maximum + result.FBounds[ADimension].Minimum + 1) shr 1; -end; - -function TBGRAColorBox.Duplicate: TBGRAColorBox; -var - i: Int32or64; -begin - result := TBGRAColorBox.Create(FDimensions, FBounds); - result.FTotalWeight := FTotalWeight; - setlength(result.FColors, length(FColors)); - for i := 0 to high(FColors) do - result.FColors[i] := FColors[i]; -end; - -function TBGRAColorBox.GetAsArrayOfColors(AIncludePureTransparent: boolean): ArrayOfTBGRAPixel; -var i,idx: integer; -begin - if AIncludePureTransparent and HasPureTransparentColor then - begin - setlength(result, length(FColors)+1); - result[0] := BGRAPixelTransparent; - idx := 1; - end else - begin - setlength(result, length(FColors)); - idx := 0; - end; - for i:= 0 to high(FColors) do - begin - result[idx] := FColors[i].Color; - inc(idx); - end; -end; - -end. - diff --git a/components/bgrabitmap/bgracolorspace.pas b/components/bgrabitmap/bgracolorspace.pas deleted file mode 100644 index 55fdcce..0000000 --- a/components/bgrabitmap/bgracolorspace.pas +++ /dev/null @@ -1,199 +0,0 @@ -unit BGRAColorspace; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, BGRABitmapTypes; - -type - { TCIERGB } - - TCIERGB = packed record - //components are between 0 and 1 - R,G,B,A: single; - function ToBGRA: TBGRAPixel; - procedure FromBGRA(AValue: TBGRAPixel); - function ToExpanded: TExpandedPixel; - procedure FromExpanded(AValue: TExpandedPixel); - end; - - { TCIEXYZ } - - TCIEXYZ = packed record - //components are between 0 and 1 - X, Y, Z, - A: single; - function ToRGB: TCIERGB; - procedure FromRGB(AValue: TCIERGB); - end; - - { TBGRAPixelColorspaceHelper } - - TBGRAPixelColorspaceHelper = record helper(TBGRAPixelHelper) for TBGRAPixel - function ToXYZ: TCIEXYZ; - procedure FromXYZ(const AValue: TCIEXYZ); - end; - - { TExpandedPixelColorspaceHelper } - - TExpandedPixelColorspaceHelper = record helper(TExpandedPixelHelper) for TExpandedPixel - function ToXYZ: TCIEXYZ; - procedure FromXYZ(const AValue: TCIEXYZ); - end; - -procedure RGBToXYZ(R, G, B: single; out X, Y, Z: single); -procedure XYZToRGB(X, Y, Z: single; out R, G, B: single); - -implementation - -function ClampF(AValue,AMin,AMax: single): single; -begin - if AValue <= AMin then result := AMin - else if AValue >= AMax then result := AMax - else result := AValue; -end; - -procedure RGBToXYZ(R, G, B: single; out X, Y, Z: single); -begin - // Observer= 2°, Illuminant= D65 - X := R * 0.4124 + G * 0.3576 + B * 0.1805; - Y := R * 0.2126 + G * 0.7152 + B * 0.0722; - Z := R * 0.0193 + G * 0.1192 + B * 0.9505; -end; - -procedure XYZToRGB(X, Y, Z: single; out R, G, B: single); -begin - R := ClampF(X * 3.2406 + Y * (-1.5372) + Z * (-0.49), 0, 1); - G := ClampF(X * (-0.969) + Y * 1.8758 + Z * 0.0415, 0, 1); - B := ClampF(X * 0.0557 + Y * (-0.2040) + Z * 1.0570, 0, 1); -end; - -{ TCIERGB } - -function TCIERGB.ToBGRA: TBGRAPixel; -var - redF,greenF,blueF: single; -begin - if r > 0.00313 then - redF := 1.055 * Power(r, 1 / 2.4) - 0.055 - else - redF := 12.92 * r; - if g > 0.00313 then - greenF := 1.055 * Power(g, 1 / 2.4) - 0.055 - else - greenF := 12.92 * g; - if b > 0.00313 then - blueF := 1.055 * Power(b, 1 / 2.4) - 0.055 - else - blueF := 12.92 * b; - - result.red := round(clampF(redF,0,1)*255); - result.green := round(clampF(greenF,0,1)*255); - result.blue := round(clampF(blueF,0,1)*255); - result.alpha := round(clampF(A,0,1)*255); -end; - -procedure TCIERGB.FromBGRA(AValue: TBGRAPixel); -begin - R := AValue.red/255; - G := AValue.green/255; - B := AValue.blue/255; - A := AValue.alpha/255; - - if R > 0.04045 then - R := Power((R + 0.055) / 1.055, 2.4) - else - R := R / 12.92; - if G > 0.04045 then - G := Power((G + 0.055) / 1.055, 2.4) - else - G := G / 12.92; - if B > 0.04045 then - B := Power((B + 0.055) / 1.055, 2.4) - else - B := B / 12.92; -end; - -function TCIERGB.ToExpanded: TExpandedPixel; -begin - result.red := round(ClampF(R,0,1)*65535); - result.green := round(ClampF(G,0,1)*65535); - result.blue := round(ClampF(B,0,1)*65535); - result.alpha := round(ClampF(A,0,1)*65535); -end; - -procedure TCIERGB.FromExpanded(AValue: TExpandedPixel); -begin - R := AValue.red/65535; - G := AValue.green/65535; - B := AValue.blue/65535; - A := AValue.alpha/65535; -end; - -{ TCIEXYZ } - -function TCIEXYZ.ToBGRA: TBGRAPixel; -begin - result.FromXYZ(self); -end; - -procedure TCIEXYZ.FromBGRA(AValue: TBGRAPixel); -begin - self := AValue.ToXYZ; -end; - -function TCIEXYZ.ToExpanded: TExpandedPixel; -begin - result.FromXYZ(self); -end; - -procedure TCIEXYZ.FromExpanded(AValue: TExpandedPixel); -begin - self := AValue.ToXYZ; -end; - -function TCIEXYZ.ToRGB: TCIERGB; -begin - XYZToRGB(X,Y,Z, result.R,result.G,result.B); - result.A := A; -end; - -procedure TCIEXYZ.FromRGB(AValue: TCIERGB); -begin - RGBToXYZ(AValue.R,AValue.G,AValue.B, X,Y,Z); - A := AValue.A; -end; - -{ TExpandedPixelColorspaceHelper } - -function TExpandedPixelColorspaceHelper.ToXYZ: TCIEXYZ; -var RGB: TCIERGB; -begin - RGB.FromExpanded(Self); - result.FromRGB(RGB); -end; - -procedure TExpandedPixelColorspaceHelper.FromXYZ(const AValue: TCIEXYZ); -var redF,greenF,blueF: single; -begin - self := AValue.ToRGB.ToExpanded; -end; - -{ TBGRAPixelColorspaceHelper } - -function TBGRAPixelColorspaceHelper.ToXYZ: TCIEXYZ; -var RGB: TCIERGB; -begin - RGB.FromBGRA(Self); - result.FromRGB(RGB); -end; - -procedure TBGRAPixelColorspaceHelper.FromXYZ(const AValue: TCIEXYZ); -begin - self := AValue.ToRGB.ToBGRA; -end; - -end. - diff --git a/components/bgrabitmap/bgracompressablebitmap.pas b/components/bgrabitmap/bgracompressablebitmap.pas deleted file mode 100644 index 65a5413..0000000 --- a/components/bgrabitmap/bgracompressablebitmap.pas +++ /dev/null @@ -1,317 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRACompressableBitmap; - -{$mode objfpc}{$H+} - -interface - -{ This unit contains the TBGRACompressableBitmap class, which - can be used to temporarily compress bitmaps in memory. - To use it, create an instance with the bitmap you want - to compress. You can then free the original bitmap because - TBGRACompressableBitmap contains all information necessary - to build it again. To construct again your bitmap, call - the GetBitmap function. - - When you have your bitmap in TBGRACompressableBitmap, - you can call Compress function as many times as necessary - until all data is compressed. It does only a part of the - work at each call, so you can put it in a loop or in - a timer. When it's done, Compress returns false to - notify that it did nothing, which means you can - stop calling Compress. - - In this implementation, the memory usage grows during - the compression process and is lower only after it is - finished. So it is recommended to compress one bitmap - at a time. } - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, zstream; - -type - - { TBGRACompressableBitmap } - - TBGRACompressableBitmap = class - private - FWidth,FHeight: integer; - FCaption: String; - FBounds: TRect; - FCompressedDataArray: array of TMemoryStream; - FUncompressedData: TMemoryStream; - FLineOrder: TRawImageLineOrder; - FCompressionProgress: Int64; - procedure Decompress; - procedure FreeData; - procedure Init; - public - CompressionLevel: Tcompressionlevel; - constructor Create; overload; - constructor Create(Source: TBGRABitmap); overload; - function GetBitmap: TBGRABitmap; - - //call Compress as many times as necessary - //when it returns false, it means that - //the image compression is finished - function Compress: boolean; - procedure WriteToStream(AStream: TStream); - procedure ReadFromStream(AStream: TStream); - - function UsedMemory: Int64; - procedure Assign(Source: TBGRABitmap); - destructor Destroy; override; - property Width : Integer read FWidth; - property Height: Integer read FHeight; - property Caption : string read FCaption write FCaption; - - end; - -implementation - -uses BGRAUTF8; - -// size of each chunk treated by Compress function -const maxPartSize = 524288; - -{ TBGRACompressedBitmap } - -constructor TBGRACompressableBitmap.Create; -begin - Init; -end; - -constructor TBGRACompressableBitmap.Create(Source: TBGRABitmap); -begin - Init; - Assign(Source); -end; - -{ Constructs the bitmap again, decompressing if necessary. - After this, the image is not compressed anymore so the - memoy usage grows again and the access becomes fast - because there is no need to decompress anymore. } -function TBGRACompressableBitmap.GetBitmap: TBGRABitmap; -var UsedPart: TBGRABitmap; - UsedNbPixels: Integer; -begin - Decompress; - if FUncompressedData = nil then - begin - result := nil; - exit; - end; - result := TBGRABitmap.Create(FWidth,FHeight); - result.Caption := FCaption; - FUncompressedData.Position := 0; - if (FBounds.Left <> 0) or (FBounds.Top <> 0) - or (FBounds.Right <> FWidth) or (FBounds.Bottom <> FHeight) then - begin - UsedNbPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top); - if UsedNbPixels > 0 then - begin - UsedPart := TBGRABitmap.Create(FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top); - FUncompressedData.Read(UsedPart.Data^,UsedPart.NbPixels*Sizeof(TBGRAPixel)); - if UsedPart.LineOrder <> FLineOrder then UsedPart.VerticalFlip; - If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue; - result.PutImage(FBounds.Left,FBounds.Top,UsedPart,dmSet); - UsedPart.Free; - end; - end else - begin - FUncompressedData.Read(result.Data^,result.NbPixels*Sizeof(TBGRAPixel)); - if result.LineOrder <> FLineOrder then result.VerticalFlip; - If TBGRAPixel_RGBAOrder then result.SwapRedBlue; - end; -end; - -{ Returns the total memory used by this object for storing bitmap data } -function TBGRACompressableBitmap.UsedMemory: Int64; -var i: integer; -begin - result := 0; - for i := 0 to high(FCompressedDataArray) do - inc(result, FCompressedDataArray[i].Size); - if FUncompressedData <> nil then inc(result, FUncompressedData.Size); -end; - -{ Do one compress step or return false } -function TBGRACompressableBitmap.Compress: boolean; -var comp: Tcompressionstream; - partSize: integer; -begin - if FCompressedDataArray = nil then FCompressionProgress := 0; - if (FUncompressedData = nil) or (FUncompressedData.Size = 0) then - begin - result := false; - exit; - end; - if FCompressionProgress < FUncompressedData.Size then - begin - setlength(FCompressedDataArray, length(FCompressedDataArray)+1); - FCompressedDataArray[high(FCompressedDataArray)] := TMemoryStream.Create; - FUncompressedData.Position := FCompressionProgress; - if FUncompressedData.Size - FCompressionProgress > maxPartSize then - partSize := maxPartSize else - partSize := integer(FUncompressedData.Size - FCompressionProgress); - - comp := Tcompressionstream.Create(CompressionLevel,FCompressedDataArray[high(FCompressedDataArray)],true); - LEWriteLongint(comp, partSize); - comp.CopyFrom(FUncompressedData,partSize); - comp.Free; - inc(FCompressionProgress, partSize); - end; - if FCompressionProgress >= FUncompressedData.Size then - FreeAndNil(FUncompressedData); - result := true; -end; - -procedure TBGRACompressableBitmap.WriteToStream(AStream: TStream); -var i:integer; -begin - repeat - until not Compress; - LEWriteLongint(AStream,FWidth); - LEWriteLongint(AStream,FHeight); - LEWriteLongint(AStream,length(FCaption)); - AStream.Write(FCaption[1],length(FCaption)); - if (FWidth=0) or (FHeight = 0) then exit; - - LEWriteLongint(AStream,FBounds.Left); - LEWriteLongint(AStream,FBounds.Top); - LEWriteLongint(AStream,FBounds.Right); - LEWriteLongint(AStream,FBounds.Bottom); - LEWriteLongint(AStream,ord(FLineOrder)); - - LEWriteLongint(AStream,length(FCompressedDataArray)); - for i := 0 to high(FCompressedDataArray) do - begin - LEWriteLongint(AStream,FCompressedDataArray[i].Size); - FCompressedDataArray[i].Position := 0; - AStream.CopyFrom(FCompressedDataArray[i],FCompressedDataArray[i].Size); - end; -end; - -procedure TBGRACompressableBitmap.ReadFromStream(AStream: TStream); -var size,i: integer; -begin - FreeData; - FWidth := LEReadLongint(AStream); - FHeight := LEReadLongint(AStream); - setlength(FCaption,LEReadLongint(AStream)); - AStream.Read(FCaption[1],length(FCaption)); - if (FWidth=0) or (FHeight = 0) then - begin - FUncompressedData := TMemoryStream.Create; - exit; - end; - - FBounds.Left := LEReadLongint(AStream); - FBounds.Top := LEReadLongint(AStream); - FBounds.Right := LEReadLongint(AStream); - FBounds.Bottom := LEReadLongint(AStream); - FLineOrder := TRawImageLineOrder(LEReadLongint(AStream)); - - setlength(FCompressedDataArray,LEReadLongint(AStream)); - for i := 0 to high(FCompressedDataArray) do - begin - size := LEReadLongint(AStream); - FCompressedDataArray[i] := TMemoryStream.Create; - FCompressedDataArray[i].CopyFrom(AStream,size); - end; - - if FCompressedDataArray = nil then - FUncompressedData := TMemoryStream.Create; -end; - -procedure TBGRACompressableBitmap.Decompress; -var decomp: Tdecompressionstream; - i: integer; - partSize: integer; -begin - if (FUncompressedData <> nil) or (FCompressedDataArray = nil) then exit; - FUncompressedData := TMemoryStream.Create; - for i := 0 to high(FCompressedDataArray) do - begin - FCompressedDataArray[i].Position := 0; - decomp := Tdecompressionstream.Create(FCompressedDataArray[i],true); - partSize := LEReadLongint(decomp); - FUncompressedData.CopyFrom(decomp,partSize); - decomp.Free; - FreeAndNil(FCompressedDataArray[i]); - end; - FCompressedDataArray := nil; -end; - -{ Free all data } -procedure TBGRACompressableBitmap.FreeData; -var i: integer; -begin - if FCompressedDataArray <> nil then - begin - for i := 0 to high(FCompressedDataArray) do - FCompressedDataArray[I].Free; - FCompressedDataArray := nil; - end; - if FUncompressedData <> nil then FreeAndNil(FUncompressedData); -end; - -procedure TBGRACompressableBitmap.Init; -begin - FUncompressedData := nil; - FCompressedDataArray := nil; - FWidth := 0; - FHeight := 0; - FCaption := ''; - FCompressionProgress := 0; - CompressionLevel := clfastest; -end; - -{ Copy a bitmap into this object. As it is copied, you need not - keep a copy of the source } -procedure TBGRACompressableBitmap.Assign(Source: TBGRABitmap); -var - UsedPart: TBGRABitmap; - NbUsedPixels: integer; -begin - FreeData; - if Source = nil then - begin - FWidth := 0; - FHeight := 0; - FCaption := ''; - exit; - end; - FWidth := Source.Width; - FHeight := Source.Height; - FCaption := Source.Caption; - FBounds := Source.GetImageBounds([cRed,cGreen,cBlue,cAlpha]); - NbUsedPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top); - FUncompressedData := TMemoryStream.Create; - if NbUsedPixels = 0 then exit; - - if (FBounds.Left <> 0) or (FBounds.Top <> 0) - or (FBounds.Right <> Source.Width) or (FBounds.Bottom <> Source.Height) then - begin - UsedPart := Source.GetPart(FBounds); - If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue; - FUncompressedData.Write(UsedPart.Data^,NbUsedPixels*Sizeof(TBGRAPixel)); - FLineOrder := UsedPart.LineOrder; - UsedPart.Free; - end else - begin - If TBGRAPixel_RGBAOrder then Source.SwapRedBlue; - FUncompressedData.Write(Source.Data^,Source.NbPixels*Sizeof(TBGRAPixel)); - If TBGRAPixel_RGBAOrder then Source.SwapRedBlue; - FLineOrder := Source.LineOrder; - end; -end; - -destructor TBGRACompressableBitmap.Destroy; -begin - FreeData; - inherited Destroy; -end; - -end. - diff --git a/components/bgrabitmap/bgracoordpool3d.pas b/components/bgrabitmap/bgracoordpool3d.pas deleted file mode 100644 index ef79c7d..0000000 --- a/components/bgrabitmap/bgracoordpool3d.pas +++ /dev/null @@ -1,435 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRACoordPool3D; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, BGRABitmapTypes, BGRASSE, BGRAMatrix3D; - -type - PBGRACoordData3D = ^TBGRACoordData3D; - TBGRACoordData3D = packed record - {0} sceneCoord: TPoint3D_128; - {16} viewCoord: TPoint3D_128; - {32} projectedCoord: TPointF; - {40} InvZ: single; - {44} used: wordbool; customNormalUsed: wordbool; - {48} viewNormal: TPoint3D_128; - {64} customNormal: TPoint3D_128; - end; {80} - - PBGRANormalData3D = ^TBGRANormalData3D; - TBGRANormalData3D = packed record - {0} customNormal: TPoint3D_128; - {16} viewNormal: TPoint3D_128; - {32} used: longbool; - {36} filler1,filler2,filler3: LongWord; - end; {48} - - { TBGRAGenericPool } - - TBGRAGenericPool = class - private - FFirstFree: integer; - FNbElements,FCapacity: integer; - FElementSize: PtrInt; - FUsedCapacity : integer; - function GetElement(AIndex: integer): Pointer; - procedure SetCapacity(ACapacity: integer); - protected - FPoolData: TMemoryBlockAlign128; - function GetUsed({%H-}AElement: integer): boolean; virtual; - procedure SetUsed({%H-}AElement: integer; {%H-}AUsed: boolean); virtual; - procedure Remove(AIndex: integer); //does not work if GetUsed/SetUsed are not implemented - public - constructor Create(ACapacity: integer; AElementSize: integer); - destructor Destroy; override; - function Add: integer; - property Element[AIndex: integer]: Pointer read GetElement; - property Capacity: integer read FCapacity; - property UsedCapacity: integer read FUsedCapacity; - end; - - { TBGRACoordPool3D } - - TBGRACoordPool3D = class(TBGRAGenericPool) - private - function GetCoordData(AIndex: integer): PBGRACoordData3D; - protected - function GetUsed(AElement: integer): boolean; override; - procedure SetUsed(AElement: integer; AUsed: boolean); override; - public - procedure Remove(AIndex: integer); - constructor Create(ACapacity: integer); - procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); - property CoordData[AIndex: integer]: PBGRACoordData3D read GetCoordData; - end; - - { TBGRANormalPool3D } - - TBGRANormalPool3D = class(TBGRAGenericPool) - private - function GetNormalData(AIndex: integer): PBGRANormalData3D; - protected - function GetUsed(AElement: integer): boolean; override; - procedure SetUsed(AElement: integer; AUsed: boolean); override; - public - procedure Remove(AIndex: integer); - constructor Create(ACapacity: integer); - procedure ComputeWithMatrix(const AMatrix: TMatrix3D); - property NormalData[AIndex: integer]: PBGRANormalData3D read GetNormalData; - end; - -implementation - -{ TBGRAGenericPool } - -function TBGRAGenericPool.GetElement(AIndex: integer): Pointer; -begin - result := Pointer(PByte(FPoolData.Data)+AIndex*FElementSize); -end; - -procedure TBGRAGenericPool.SetCapacity(ACapacity: integer); -var NewPoolData: TMemoryBlockAlign128; -begin - if FCapacity <> ACapacity then - begin - if ACapacity = 0 then - FreeAndNil(FPoolData) - else - begin - NewPoolData := TMemoryBlockAlign128.Create(ACapacity*FElementSize); - if FCapacity <> 0 then - begin - //previous block is smaller - if FCapacity < ACapacity then - begin - move(FPoolData.Data^, NewPoolData.Data^, FCapacity*FElementSize); - //pad with zeros - fillchar((pbyte(NewPoolData.Data)+FCapacity*FElementSize)^,(ACapacity-FCapacity)*FElementSize,0); - end - else //previous block is greater or equal - move(FPoolData.Data^, NewPoolData.Data^, ACapacity*FElementSize); - FreeAndNil(FPoolData); - end else - //clear new block - fillchar(pbyte(NewPoolData.Data)^,ACapacity*FElementSize,0); - - FPoolData := NewPoolData; - end; - FCapacity:= ACapacity; - end; -end; - -function TBGRAGenericPool.GetUsed(AElement: integer): boolean; -begin - result := false; -end; - -procedure TBGRAGenericPool.SetUsed(AElement: integer; AUsed: boolean); -begin - //nothing -end; - -constructor TBGRAGenericPool.Create(ACapacity: integer; AElementSize: integer); -begin - FCapacity := 0; - FPoolData := nil; - FNbElements:= 0; - FFirstFree := 0; - FUsedCapacity := 0; - FElementSize:= AElementSize; - SetCapacity(ACapacity); -end; - -destructor TBGRAGenericPool.Destroy; -begin - FreeAndNil(FPoolData); - FCapacity := 0; - FNbElements:= 0; - FFirstFree := 0; - FUsedCapacity := 0; - inherited Destroy; -end; - -procedure TBGRAGenericPool.Remove(AIndex: integer); -begin - if (AIndex < 0) or (AIndex >= FUsedCapacity) then - raise ERangeError.Create('Index out of bounds'); - if GetUsed(AIndex) then - begin - SetUsed(AIndex, false); - if AIndex < FFirstFree then FFirstFree := AIndex; - if AIndex = FUsedCapacity-1 then - begin - while (FUsedCapacity > 0) and not GetUsed(FUsedCapacity-1) do - dec(FUsedCapacity); - end; - end; -end; - -function TBGRAGenericPool.Add: integer; -begin - //check for free space - while FFirstFree < FCapacity do - begin - if not GetUsed(FFirstFree) then - begin - SetUsed(FFirstFree,True); - result := FFirstFree; - inc(FFirstFree); - if FFirstFree > FUsedCapacity then - FUsedCapacity := FFirstFree; - exit; - end; - inc(FFirstFree); - end; - - //no free space - SetCapacity(FCapacity*2+8); - SetUsed(FFirstFree, true); - result := FFirstFree; - inc(FFirstFree); - if FFirstFree > FUsedCapacity then - FUsedCapacity := FFirstFree; -end; - -{ TBGRACoordPool3D } - -constructor TBGRACoordPool3D.Create(ACapacity: integer); -begin - inherited Create(ACapacity,SizeOf(TBGRACoordData3D)); -end; - -procedure TBGRACoordPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D; - const AProjection: TProjection3D); -var - P: PBGRACoordData3D; - I: Int32or64; -begin - if UsedCapacity = 0 then exit; - P := PBGRACoordData3D(FPoolData.Data); - {$IFDEF CPUI386} - {$IFDEF BGRASSE_AVAILABLE} - {$asmmode intel} - if UseSSE then - begin - Matrix3D_SSE_Load(AMatrix); - asm - mov eax,[AProjection] - movups xmm4,[eax] - xorps xmm1,xmm1 - end; - i := UsedCapacity; - if UseSSE3 then - begin - while i > 0 do - with P^ do - begin - if used then - begin - MatrixMultiplyVect3D_SSE3_Aligned(sceneCoord,viewCoord); - if viewCoord.z > 0 then - begin - asm - mov eax, P - movaps xmm3, [eax+16] //viewCoord - movaps xmm2,xmm3 - shufps xmm2,xmm3,2+8+32+128 - rcpps xmm2,xmm2 //xmm2 = InvZ - movss [eax+40],xmm2 //-> InvZ - - mulps xmm3,xmm4 //xmm3 *= Projection.Zoom - mulps xmm3,xmm2 //xmm3 *= InvZ - - movhlps xmm0,xmm4 //xmm0 = Projection.Center - addps xmm3,xmm0 //xmm3 += Projection.Center - - movlps [eax+32],xmm3 //->projectedCoord - movaps [eax+48],xmm1 //->normal - end; - end else - asm - mov eax, P - movlps [eax+32],xmm1 //0->projectedCoord - movaps [eax+48],xmm1 //->normal - end; - if customNormalUsed then - MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal); - end; - dec(i); - inc(p); - end; - end else - begin - while i > 0 do - with P^ do - begin - if used then - begin - MatrixMultiplyVect3D_SSE_Aligned(sceneCoord,viewCoord); - if viewCoord.z > 0 then - begin - asm - mov eax, P - movaps xmm3, [eax+16] //viewCoord - movaps xmm2,xmm3 - shufps xmm2,xmm3,2+8+32+128 - rcpps xmm2,xmm2 //xmm2 = InvZ - movss [eax+40],xmm2 //-> InvZ - - mulps xmm3,xmm4 //xmm3 *= Projection.Zoom - mulps xmm3,xmm2 //xmm3 *= InvZ - - movhlps xmm0,xmm4 //xmm0 = Projection.Center - addps xmm3,xmm0 //xmm3 += Projection.Center - - movlps [eax+32],xmm3 //->projectedCoord - movaps [eax+48],xmm1 //->normal - end; - end else - asm - mov eax, P - movlps [eax+32],xmm1 //0 ->projectedCoord - movaps [eax+48],xmm1 //->normal - end; - if customNormalUsed then - MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal); - end; - dec(i); - inc(p); - end; - end; - end - else - {$ENDIF} - {$ENDIF} - begin - i := UsedCapacity; - while i > 0 do - with P^ do - begin - if used then - begin - viewCoord := AMatrix*sceneCoord; - if customNormalUsed then - viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal) - else - ClearPoint3D_128(viewNormal); - if viewCoord.z > 0 then - begin - InvZ := 1/viewCoord.z; - projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x, - viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y); - end else - projectedCoord := PointF(0,0); - end; - dec(i); - inc(p); - end; - end; -end; - -function TBGRACoordPool3D.GetCoordData(AIndex: integer): PBGRACoordData3D; -begin - result := PBGRACoordData3D(FPoolData.Data)+AIndex; -end; - -function TBGRACoordPool3D.GetUsed(AElement: integer): boolean; -begin - Result:= CoordData[AElement]^.used; -end; - -procedure TBGRACoordPool3D.SetUsed(AElement: integer; AUsed: boolean); -begin - CoordData[AElement]^.used := AUsed; -end; - -procedure TBGRACoordPool3D.Remove(AIndex: integer); -begin - inherited Remove(AIndex); -end; - -{ TBGRANormalPool3D } - -function TBGRANormalPool3D.GetNormalData(AIndex: integer): PBGRANormalData3D; -begin - result := PBGRANormalData3D(FPoolData.Data)+AIndex; -end; - -function TBGRANormalPool3D.GetUsed(AElement: integer): boolean; -begin - Result:= NormalData[AElement]^.used; -end; - -procedure TBGRANormalPool3D.SetUsed(AElement: integer; AUsed: boolean); -begin - NormalData[AElement]^.used := AUsed; -end; - -procedure TBGRANormalPool3D.Remove(AIndex: integer); -begin - inherited Remove(AIndex); -end; - -constructor TBGRANormalPool3D.Create(ACapacity: integer); -begin - inherited Create(ACapacity,SizeOf(TBGRANormalData3D)); -end; - -procedure TBGRANormalPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D); -var - P: PBGRANormalData3D; - I: Int32or64; -begin - if UsedCapacity = 0 then exit; - P := PBGRANormalData3D(FPoolData.Data); - {$IFDEF CPUI386} - {$IFDEF BGRASSE_AVAILABLE} - {$asmmode intel} - if UseSSE then - begin - Matrix3D_SSE_Load(AMatrix); - i := UsedCapacity; - if UseSSE3 then - begin - while i > 0 do - with P^ do - begin - if used then - MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal); - dec(i); - inc(p); - end; - end else - begin - while i > 0 do - with P^ do - begin - if used then - MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal); - dec(i); - inc(p); - end; - end; - end - else - {$ENDIF} - {$ENDIF} - begin - i := UsedCapacity; - while i > 0 do - with P^ do - begin - if used then - viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal); - dec(i); - inc(p); - end; - end; -end; - -end. - diff --git a/components/bgrabitmap/bgracustombitmap.inc b/components/bgrabitmap/bgracustombitmap.inc deleted file mode 100644 index 8ee8550..0000000 --- a/components/bgrabitmap/bgracustombitmap.inc +++ /dev/null @@ -1,1859 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type -{=== TBGRACustomBitmap ===} - - { TBGRACustomBitmap } - {* This is the base class for ''TBGRABitmap''. It is the direct parent of - ''TBGRADefaultBitmap'' class, which is the parent of the diverse - implementations. A bitmap can be used as a scanner using the interface - ''IBGRAScanner'' } - TBGRACustomBitmap = class(specialize TGenericUniversalBitmap,IBGRAScanner) - protected - FXorMask: TBGRACustomBitmap; - - { accessors to properies } - procedure SetXorMask(AValue: TBGRACustomBitmap); - - function GetAverageColor: TColor; virtual; abstract; - function GetAveragePixel: TBGRAPixel; virtual; abstract; - - //FreePascal drawing routines - {$IFDEF BGRABITMAP_USE_FPCANVAS}function GetCanvasFP: TFPImageCanvas; virtual; abstract;{$ENDIF} - function GetCanvasDrawModeFP: TDrawMode; virtual; abstract; - procedure SetCanvasDrawModeFP(const AValue: TDrawMode); virtual; abstract; - - //GUI bitmap object - function GetBitmap: TBitmap; virtual; abstract; - function GetCanvas: TCanvas; virtual; abstract; - function GetCanvasOpacity: byte; virtual; abstract; - procedure SetCanvasOpacity(AValue: byte); virtual; abstract; - function GetCanvasAlphaCorrection: boolean; virtual; abstract; - procedure SetCanvasAlphaCorrection(const AValue: boolean); virtual; abstract; - - procedure Init; override; - function InternalNew: TBGRACustomBitmap; override; - - procedure InternalArc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); overload; - procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); overload; virtual; abstract; - procedure InternalArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; ABorderColor : TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); - procedure InternalFillArcInRect(r: TRect; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel; AOptions: TArcOptions; ATexture: IBGRAScanner = nil); - - public - {** Resample filter is used when resizing the bitmap. See [[BGRABitmap Miscellaneous types#Images and resampling|resampling types]] } - ResampleFilter : TResampleFilter; - - {** Scan interpolation filter is used when the bitmap is used - as a scanner (interface ''IBGRAScanner'') } - ScanInterpolationFilter: TResampleFilter; - ScanMaskChannel: TChannel; - - {** Cursor position for mouse pointer } - HotSpot: TPoint; - - { ** Free reference to xor mask } - procedure DiscardXorMask; virtual; - { ** Allocate xor mask } - procedure NeedXorMask; virtual; - {** Xor mask to be applied when image is drawn } - property XorMask: TBGRACustomBitmap read FXorMask write SetXorMask; - - {** Average color of the image } - property AverageColor: TColor Read GetAverageColor; - {** Average color (including alpha) of the image } - property AveragePixel: TBGRAPixel Read GetAveragePixel; - - {** Canvas compatible with FreePascal } - {$IFDEF BGRABITMAP_USE_FPCANVAS}property CanvasFP: TFPImageCanvas read GetCanvasFP;{$ENDIF} - - {** Draw mode to used when image is access using FreePascal functions - and ''Colors'' property } - property CanvasDrawModeFP: TDrawMode read GetCanvasDrawModeFP write SetCanvasDrawModeFP; - - {** Bitmap in a format compatible with the current GUI. - Don't forget to call ''InvalidateBitmap'' before using it - if you changed something with direct pixel access (''Scanline'' - and ''Data'') } - property Bitmap: TBitmap Read GetBitmap; - {** Canvas provided by the GUI } - property Canvas: TCanvas Read GetCanvas; - {** Opacity to apply to changes made using GUI functions, provided - ''CanvasAlphaCorrection'' is set to ''True'' } - property CanvasOpacity: byte Read GetCanvasOpacity Write SetCanvasOpacity; - {** Specifies if the alpha values must be corrected after GUI access - to the bitmap } - property CanvasAlphaCorrection: boolean Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection; - - protected {----------- pen style accessors ----------------} - function GetPenJoinStyle: TPenJoinStyle; virtual; abstract; - procedure SetPenJoinStyle(const AValue: TPenJoinStyle); virtual; abstract; - function GetPenMiterLimit: single; virtual; abstract; - procedure SetPenMiterLimit(const AValue: single); virtual; abstract; - function GetPenStyle: TPenStyle; virtual; abstract; - procedure SetPenStyle(const AValue: TPenStyle); virtual; abstract; - function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract; - procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); virtual; abstract; - - function GetArrowEndRepeat: integer; virtual; abstract; - function GetArrowStartRepeat: integer; virtual; abstract; - procedure SetArrowEndRepeat(AValue: integer); virtual; abstract; - procedure SetArrowStartRepeat(AValue: integer); virtual; abstract; - function GetArrowEndOffset: single; virtual; abstract; - function GetArrowStartOffset: single; virtual; abstract; - procedure SetArrowEndOffset(AValue: single); virtual; abstract; - procedure SetArrowStartOffset(AValue: single); virtual; abstract; - function GetArrowEndSize: TPointF; virtual; abstract; - function GetArrowStartSize: TPointF; virtual; abstract; - procedure SetArrowEndSize(AValue: TPointF); virtual; abstract; - procedure SetArrowStartSize(AValue: TPointF); virtual; abstract; - - public {----------- pen style ----------------} - {** How to join segments. See [[BGRABitmap Types imported from Graphics|BGRAGraphics]] } - property JoinStyle: TPenJoinStyle read GetPenJoinStyle Write SetPenJoinStyle; - {** Limit for the extension of the segments when joining them - with ''pjsMiter'' join style, expressed in multiples of the width - of the pen } - property JoinMiterLimit: single read GetPenMiterLimit Write SetPenMiterLimit; - {** Pen style. See [[BGRABitmap Types imported from Graphics|BGRAGraphics]] } - property PenStyle: TPenStyle read GetPenStyle Write SetPenStyle; - {** Custom pen style. See [[BGRABitmap Geometry types|geometric types]] } - property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle; - - {** Size of arrows at the start of the line } - property ArrowStartSize: TPointF read GetArrowStartSize write SetArrowStartSize; - {** Size of arrows at the end of the line } - property ArrowEndSize: TPointF read GetArrowEndSize write SetArrowEndSize; - {** Offset of the arrow from the start of the line } - property ArrowStartOffset: single read GetArrowStartOffset write SetArrowStartOffset; - {** Offset of the arrow from the end of the line } - property ArrowEndOffset: single read GetArrowEndOffset write SetArrowEndOffset; - {** Number of times to repeat the starting arrow } - property ArrowStartRepeat: integer read GetArrowStartRepeat write SetArrowStartRepeat; - {** Number of times to repeat the ending arrow } - property ArrowEndRepeat: integer read GetArrowEndRepeat write SetArrowEndRepeat; - - procedure ArrowStartAsNone; virtual; abstract; - procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; - procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; - procedure ArrowStartAsTail; virtual; abstract; - - procedure ArrowEndAsNone; virtual; abstract; - procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; - procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; - procedure ArrowEndAsTail; virtual; abstract; - - protected {-------------------font style accessors------------------------} - function GetFontAntialias: Boolean; - procedure SetFontAntialias(const AValue: Boolean); - function GetFontRenderer: TBGRACustomFontRenderer; virtual; abstract; - procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); virtual; abstract; - function GetFontHeight: integer; virtual; abstract; - procedure SetFontHeight(AHeight: integer); virtual; abstract; - function GetFontFullHeight: integer; virtual; abstract; - procedure SetFontFullHeight(AHeight: integer); virtual; abstract; - function GetFontVerticalAnchorOffset: single; virtual; abstract; - function GetFontPixelMetric: TFontPixelMetric; virtual; abstract; - - function GetFontRightToLeftFor(AText: string): boolean; - - public {-------------------font style------------------------} - {** Specifies the font to use. Unless the font renderer accept otherwise, - the name is in human readable form, like 'Arial', 'Times New Roman', ... } - FontName: string; - {** Specifies the set of styles to be applied to the font. - These can be ''fsBold'', ''fsItalic'', ''fsStrikeOut'', ''fsUnderline''. - So the value [''fsBold'',''fsItalic''] means that the font must be bold and italic. - See [[BGRABitmap Miscellaneous types|miscellaneous types]] } - FontStyle: TFontStyles; - - {** Specifies the quality of rendering. Default value is ''fqSystem''. - See [[BGRABitmap Miscellaneous types|miscellaneous types]] } - FontQuality : TBGRAFontQuality; - - {** Specifies the rotation of the text, for functions that support text rotation. - It is expressed in tenth of degrees, positive values going counter-clockwise. } - FontOrientation: integer; - - {** Specifies how the font is vertically aligned relative to the start coordinate. - See [[BGRABitmap Miscellaneous types|miscellaneous types]]} - FontVerticalAnchor: TFontVerticalAnchor; - - {** Specifies the base direction of the text (cf Unicode). By default, it is - automatically determined by the first strongly oriented character. - You can specify another base direction here however it is not taken - into account by the LCL on Linux. } - FontBidiMode: TFontBidiMode; - - {** Specifies the height of the font in pixels without taking into account - additional line spacing. A negative value means that it is the - full height instead (see below) } - property FontHeight: integer Read GetFontHeight Write SetFontHeight; - - {** Specifies the height of the font in pixels, taking into account the - additional line spacing defined for the font } - property FontFullHeight: integer read GetFontFullHeight write SetFontFullHeight; - - {** Simplified property to specify the quality (see ''FontQuality'') } - property FontAntialias: Boolean read GetFontAntialias write SetFontAntialias; - - property FontVerticalAnchorOffset: single read GetFontVerticalAnchorOffset; - - {** Returns measurement for the current font in pixels } - property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric; - - {** Specifies the font renderer. When working with the LCL, - by default it is an instance of ''TLCLFontRenderer'' of - unit ''BGRAText''. Other renderers are provided in ''BGRATextFX'' - unit and ''BGRAVectorize'' unit. Additionally, ''BGRAFreeType'' - provides a renderer independent from the LCL. - * - * Once you assign a renderer, it will automatically be freed when - the bitmap is freed. The renderers may provide additional styling - for the font, not accessible with the properties in this class - * - * See [[BGRABitmap tutorial Font rendering|font rendering]]} - property FontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer; - - public - constructor Create(AFPImage: TFPCustomImage); overload; virtual; abstract; - constructor Create(ABitmap: TBitmap; AUseTransparent: boolean = true); overload; virtual; abstract; - constructor Create(AFilename: string); overload; virtual; abstract; - constructor Create(AFilename: string; AIsUtf8Filename: boolean); overload; virtual; abstract; - constructor Create(AFilename: string; AIsUtf8Filename: boolean; AOptions: TBGRALoadingOptions); overload; virtual; abstract; - constructor Create(AStream: TStream); overload; virtual; abstract; - - function NewBitmap: TBGRACustomBitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRACustomBitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRACustomBitmap; overload; override; - function NewBitmap(Filename: string): TBGRACustomBitmap; overload; virtual; abstract; - function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap; overload; virtual; abstract; - function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRACustomBitmap; overload; virtual; abstract; - function NewBitmap(AFPImage: TFPCustomImage): TBGRACustomBitmap; overload; virtual; abstract; - - procedure LoadFromStream(AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); override; - - {==== Reference counting ====} - - {** Adds a reference (this reference count is not the same as - the reference count of an interface, it changes only by - explicit calls) } - function NewReference: TBGRACustomBitmap; override; - {** Returns an object with a reference count equal to 1. Duplicate - this bitmap if necessary } - function GetUnique: TBGRACustomBitmap; override; - function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; overload; override; - function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean): TBGRACustomBitmap; overload; virtual; - procedure CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); override; - function GetPart(const ARect: TRect): TBGRACustomBitmap; override; - - function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel; - AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; override; - - {** Can only be called with an existing instance of ''TBGRACustomBitmap''. - Sets the dimensions of an existing ''TBGRACustomBitmap'' instance. } - procedure SetSize(AWidth, AHeight: integer); override; - - {==== Retrieve image from system ====} - - {** Gets the content of the specified device context } - procedure LoadFromDevice(DC: HDC); overload; virtual; abstract; - {** Gets the content from the specified rectangular area of a device context } - procedure LoadFromDevice(DC: HDC; ARect: TRect); overload; virtual; abstract; - {** Fills the content with a screenshot of the primary monitor } - procedure TakeScreenshotOfPrimaryMonitor; virtual; abstract; - {** Fills the content with a screenshot of the specified rectangular area of the desktop - (it can be from any screen) } - procedure TakeScreenshot(ARect: TRect); virtual; abstract; - {** For more methods, see derived class [[TBGRABitmap class|TBGRABitmap]] } - - {==== Drawing functions ====} - - {Pixel functions} - procedure SetPixel(x, y: int32or64; c: TColor); overload; virtual; abstract; - procedure XorPixel(x, y: int32or64; const c: TBGRAPixel); overload; virtual; abstract; - procedure DrawPixel(x, y: int32or64; const c: TBGRAPixel; ADrawMode: TDrawMode); overload; override; - procedure FastBlendPixel(x, y: int32or64; const c: TBGRAPixel); virtual; abstract; - function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; virtual; abstract; - function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; overload; virtual; abstract; - function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; virtual; abstract; - function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; virtual; abstract; - function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; virtual; abstract; - function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; virtual; abstract; - - {Line primitives} - procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract; - procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); overload; virtual; abstract; - procedure DrawHorizLine(x, y, x2: int32or64; texture: IBGRAScanner); overload; - procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract; - procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel; maxDiff: byte); virtual; abstract; - procedure HorizLineDiff(x, y, x2: int32or64; const ABrush: TUniversalBrush; ACompare: TBGRAPixel; AMaxDiffW: word); virtual; abstract; - - procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract; - procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract; - procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract; - - {==== Rectangles, ellipses and path (floating point coordinates) ====} - {* These functions use the current pen style/cap/join. The parameter ''w'' - specifies the width of the line and the base unit for dashes - * The coordinates are pixel-centered, so that when filling a rectangle, - if the supplied values are integers, the border will be half transparent. - If you want the border to be completely filled, you can subtract/add - 0.5 to the coordinates to include the remaining thin border. - See [[BGRABitmap tutorial 13|coordinate system]]. } - - {==== Multi-shape fill ====} - - {** Draws and fill a polyline using current pen style/cap/join in one go. - The stroke is stricly over the fill even if partially transparent. - ''fillcolor'' specifies a color to fill the polygon formed by the points } - procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; virtual; abstract; - {** Draws a filled polygon using current pen style/cap/join in one go. - The stroke is stricly over the fill even if partially transparent. - The polygon is always closed. You don't need to set the last point - to be the same as the first point. } - procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; virtual; abstract; - - procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; virtual; abstract; - procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; virtual; abstract; - - procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; - procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; - procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; - procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; - - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; virtual; abstract; - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; virtual; abstract; - - {==== Gradient/textured polygons ====} - - procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); overload; virtual; abstract; - procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); overload; virtual; abstract; - procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); overload; virtual; abstract; - procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); overload; virtual; abstract; - procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); overload; virtual; abstract; - - procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); overload; virtual; abstract; - procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); overload; virtual; abstract; - procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True; ACulling: TFaceCulling = fcNone; ACropToPolygon: boolean = true); overload; virtual; abstract; - procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); overload; virtual; abstract; - procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACulling: TFaceCulling = fcNone); overload; virtual; abstract; - procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; - procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; - procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); overload; virtual; abstract; - procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); overload; virtual; abstract; - procedure FillQuadAffineMapping(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; ADrawMode: TDrawMode = dmDrawWithTransparency; AOpacity: byte = 255); virtual; abstract; - procedure FillQuadAffineMappingAntialias(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; AOpacity: byte = 255); virtual; abstract; - - procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); overload; virtual; abstract; - procedure FillEllipseLinearColorAntialias(AOrigin, AXAxis, AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); overload; virtual; abstract; - - procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); overload; virtual; abstract; - procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); overload; virtual; abstract; - procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); overload; virtual; abstract; - procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); overload; virtual; abstract; - procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle = nil); overload; virtual; abstract; - - procedure Arc(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; w: single; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; - procedure Arc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; w: single; ADrawChord: boolean; AFillColor: TBGRAPixel); overload; - procedure FillChord(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AFillColor: TBGRAPixel); overload; - procedure FillChord(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; - procedure FillChord(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; texture: IBGRAScanner); overload; - procedure FillChord(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; - procedure FillChordInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; - procedure FillChordInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; - - procedure Pie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; - procedure Pie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; - procedure FillPie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; AFillColor: TBGRAPixel); overload; - procedure FillPie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; - procedure FillPie(cx,cy,rx,ry: single; const StartPoint,EndPoint: TPointF; texture: IBGRAScanner); overload; - procedure FillPie(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; - procedure FillPieInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; AFillColor: TBGRAPixel); overload; - procedure FillPieInRect(const ARect: TRect; StartAngleRad,EndAngleRad: Single; texture: IBGRAScanner); overload; - - procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; virtual; abstract; - procedure RectangleWithin(x1,y1,x2,y2: single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; - procedure RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); overload; - - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); overload; virtual; abstract; - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; virtual; abstract; - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); overload; virtual; abstract; - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); overload; virtual; abstract; - - procedure FillRect(r: TRect; texture: IBGRAScanner; mode: TDrawMode; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; - procedure FillRect(r: TRect; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; - procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; - procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; virtual; abstract; - - procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; - procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; - procedure TextOutCurved(APath: IBGRAPath; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; - procedure TextOutCurved(APath: IBGRAPath; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; - procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; virtual; abstract; - procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; virtual; abstract; - procedure TextMultiline(x,y: single; const sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaLeftJustify; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; - procedure TextMultiline(x,y: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaLeftJustify; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; - procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; virtual; abstract; - procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; virtual; abstract; - function TextSize(const sUTF8: string): TSize; overload; virtual; abstract; - function TextAffineBox(const sUTF8: string): TAffineBox; virtual; abstract; - function TextSize(const sUTF8: string; AMaxWidth: integer): TSize; overload; virtual; abstract; - function TextSize(const sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; overload; virtual; abstract; - function TextFitInfo(const sUTF8: string; AMaxWidth: integer): integer; virtual; abstract; - function TextSizeMultiline(const sUTF8: string; AMaxWidth: single = EmptySingle; AParagraphSpacing: single = 0): TSize; virtual; abstract; - - { Draw the UTF8 encoded string, (x,y) being the top-left corner by default. The color c or texture is used to fill the text. - The value of FontOrientation is taken into account, so that the text may be rotated. } - procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; ARightToLeft: boolean); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; c: TColor); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; c: TColor; ARightToLeft: boolean); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; ARightToLeft: boolean); overload; virtual; - procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; - procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; - procedure TextOut(x, y: single; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; - procedure TextOut(x, y: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; virtual; abstract; - - { Overrides the font orientation with the parameter orientationTenthDegCCW } - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel); overload; virtual; - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; virtual; - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner); overload; virtual; - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; virtual; - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; virtual; abstract; - - { Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary. - The position depends on the specified horizontal alignment halign and vertical alignement valign. - The color c or texture is used to fill the text. No rotation is applied. } - procedure TextRect(ARect: TRect; const sUTF8: string; halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); overload; virtual; - procedure TextRect(ARect: TRect; const sUTF8: string; halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); overload; virtual; - - //-------------------------- computing path ------------------------------------ - - {Spline} - function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract; - function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract; - function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; overload; virtual; abstract; - function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; overload; virtual; abstract; - function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF; overload; virtual; abstract; - function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload; virtual; abstract; - - {can be accessed via Pen property} - function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; overload; virtual; abstract; - function ComputeWidePolyline(const points: array of TPointF; w: single; ClosedCap: boolean): ArrayOfTPointF; overload; virtual; abstract; - function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract; - - function ComputeEllipse(x,y,rx,ry: single): ArrayOfTPointF; overload; deprecated; - function ComputeEllipse(x,y,rx,ry,w: single): ArrayOfTPointF; overload; deprecated; - function ComputeEllipseContour(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; - function ComputeEllipseContour(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; - function ComputeEllipseBorder(x,y,rx,ry,w: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; - function ComputeEllipseBorder(AOrigin, AXAxis, AYAxis: TPointF; w: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; - function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; virtual; abstract; - function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; virtual; abstract; - function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; - function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; virtual; abstract; - function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; virtual; abstract; - function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; virtual; abstract; - - {Filling} - - // compatibility: take into account ClipRect - procedure Fill(texture: IBGRAScanner); overload; virtual; - procedure Fill(texture: IBGRAScanner; mode: TDrawMode); overload; override; - - procedure Fill(c: TBGRAPixel; start, Count: integer); overload; virtual; abstract; - procedure DrawPixels(c: TBGRAPixel; start, Count: integer); virtual; abstract; - procedure AlphaFill(alpha: byte; start, Count: integer); overload; virtual; abstract; - procedure ReplaceColor(before, after: TColor); overload; virtual; abstract; - procedure ReplaceColor(ARect: TRect; before, after: TColor); overload; virtual; abstract; - procedure FloodFill(X, Y: integer; Color: TBGRAPixel; - mode: TFloodfillMode; Tolerance: byte = 0); overload; virtual; - procedure FloodFill(X, Y: integer; const Brush: TUniversalBrush; - Progressive: boolean; ToleranceW: Word = $00ff); overload; virtual; - procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; Color: TBGRAPixel; - mode: TFloodfillMode; Tolerance: byte = 0; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; virtual; abstract; - procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush; - Progressive: boolean; ToleranceW: Word = $00ff; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; virtual; abstract; - procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel; - gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - gammaColorCorrection: boolean = True; Sinus: Boolean=False; - ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); overload; virtual; abstract; - procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient; - gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - Sinus: Boolean=False; - ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); overload; virtual; abstract; - - {Canvas drawing functions} - procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract; - procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract; - procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); virtual; abstract; - procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); overload; virtual; abstract; - procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; virtual; abstract; - procedure DrawPart(ARect: TRect; ACanvas: TCanvas; x, y: integer; Opaque: boolean); overload; virtual; - procedure DrawPart(ARect: TRect; ACanvas: TCanvas; ATargetRect: TRect; Opaque: boolean); overload; virtual; - function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; virtual; abstract; - function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; virtual; abstract; - - {BGRA bitmap functions} - procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; - procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); overload; virtual; abstract; - procedure PutImage(x, y: integer; Source: TBitmap; mode: TDrawMode; AOpacity: byte = 255); overload; - procedure StretchPutImage(ARect: TRect; Source: TBitmap; mode: TDrawMode; AOpacity: byte = 255); overload; - procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); overload; virtual; abstract; - procedure StretchPutImageProportionally(ARect: TRect; AHorizAlign: TAlignment; AVertAlign: TTextLayout; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); - procedure PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap; AOpacity: byte = 255); - procedure PutImagePart(x,y: integer; Source: TBGRACustomBitmap; SourceRect: TRect; mode: TDrawMode; AOpacity: byte = 255); - procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload; - procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte=255); overload; - procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); overload; - procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); overload; - procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload; - procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOpacity: Byte=255; ACorrectBlur: Boolean = false; APixelCenteredCoords: boolean = true); overload; - procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; - procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; - procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; virtual; abstract; - procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte=255; ACorrectBlur: Boolean = false; APixelCenteredCoords: boolean = true); overload; - function GetImageAffineBounds(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap): TRect; overload; - function GetImageAffineBounds(Origin,HAxis,VAxis: TPointF; ASourceWidth, ASourceHeight: integer; const ASourceBounds: TRect; AClipOutput: boolean = true): TRect; overload; - function GetImageAffineBounds(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; APixelCenteredCoords: boolean = true): TRect; overload; - function GetImageAffineBounds(AMatrix: TAffineMatrix; ASourceBounds: TRect; AClipOutput: boolean = true; APixelCenteredCoords: boolean = true): TRect; overload; virtual; abstract; - class function IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; virtual; abstract; - procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload; - procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload; - procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload; - procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload; - procedure ComputeImageAngleAxes(x,y,w,h,angle: single; imageCenterX,imageCenterY: single; ARestoreOffsetAfterRotation: boolean; - out Origin,HAxis,VAxis: TPointF); - function GetImageAngleBounds(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; ARestoreOffsetAfterRotation: boolean = false): TRect; - procedure Blend(AColor: TBGRAPixel; AOperation: TBlendOperation; AIgnoreDestAlpha: boolean = false); virtual; - procedure BlendOver(AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false; AIgnoreDestAlpha: boolean = false); virtual; - procedure BlendRect(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AIgnoreDestAlpha: boolean = false); overload; - procedure BlendRect(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AExcludeChannels: TChannels); overload; virtual; abstract; - procedure BlendRectOver(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false; AIgnoreDestAlpha: boolean = false); overload; - procedure BlendRectOver(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; AExcludeChannels: TChannels); overload; virtual; abstract; - procedure BlendImage(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation); overload; virtual; abstract; - procedure BlendImage(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation); overload; virtual; abstract; - procedure BlendImageOver(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; virtual; abstract; - procedure BlendImageOver(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; virtual; abstract; - function Resample(newWidth, newHeight: integer; - mode: TResampleMode = rmFineResample): TBGRACustomBitmap; virtual; abstract; - - //masks - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode); overload; override; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte); overload; virtual; abstract; - procedure EraseMask(x,y: integer; AMask: TBGRACustomBitmap; alpha: byte=255); virtual; abstract; - procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); overload; virtual; abstract; - procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); overload; virtual; abstract; - function GetMaskFromAlpha: TBGRACustomBitmap; virtual; abstract; - function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; override; - function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; override; - - {inplace filters} - procedure Negative; virtual; abstract; - procedure NegativeRect(ABounds: TRect); virtual; abstract; - procedure LinearNegative; virtual; abstract; - procedure LinearNegativeRect(ABounds: TRect); virtual; abstract; - procedure InplaceGrayscale(AGammaCorrection: boolean = true); overload; virtual; abstract; - procedure InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); overload; virtual; abstract; - procedure InplaceNormalize(AEachChannel: boolean = True); overload; virtual; abstract; - procedure InplaceNormalize(ABounds: TRect; AEachChannel: boolean = True); overload; virtual; abstract; - procedure ConvertToLinearRGB; virtual; abstract; - procedure ConvertFromLinearRGB; virtual; abstract; - procedure SwapRedBlue; overload; virtual; abstract; - procedure SwapRedBlue(ARect: TRect); overload; virtual; abstract; - procedure GrayscaleToAlpha; virtual; abstract; - procedure AlphaToGrayscale; virtual; abstract; - procedure VerticalFlip(ARect: TRect); overload; override; - procedure HorizontalFlip(ARect: TRect); overload; override; - procedure RotateUDInplace(ARect: TRect); overload; override; - - {Filters} - function RotateCW: TBGRACustomBitmap; override; - function RotateCCW: TBGRACustomBitmap; override; - function RotateUD: TBGRACustomBitmap; override; - function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract; - function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract; - function FilterSmooth: TBGRACustomBitmap; virtual; abstract; - function FilterSharpen(Amount: single = 1): TBGRACustomBitmap; overload; virtual; abstract; - function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRACustomBitmap; overload; virtual; abstract; - function FilterContour(AGammaCorrection: boolean = false): TBGRACustomBitmap; virtual; abstract; - function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; virtual; abstract; - function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; - function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; - function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; - function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override; - function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; overload; override; - function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; overload; override; - function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGRACustomBitmap; overload; override; - function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGRACustomBitmap; overload; override; - function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; virtual; abstract; - function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; virtual; abstract; - function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; overload; virtual; abstract; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRACustomBitmap; overload; virtual; abstract; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; overload; virtual; abstract; - function FilterGrayscale: TBGRACustomBitmap; overload; virtual; abstract; - function FilterGrayscale(ABounds: TRect): TBGRACustomBitmap; overload; virtual; abstract; - function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; overload; virtual; abstract; - function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRACustomBitmap; overload; virtual; abstract; - function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRACustomBitmap; virtual; abstract; - function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRACustomBitmap; virtual; abstract; - function FilterSphere: TBGRACustomBitmap; virtual; abstract; - function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; virtual; abstract; - function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; virtual; abstract; - function FilterCylinder: TBGRACustomBitmap; virtual; abstract; - function FilterPlane: TBGRACustomBitmap; virtual; abstract; - - //IBGRAScanner - function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel; override; - function ScanNextExpandedPixel: TExpandedPixel; override; - function ScanAtExpanded(X,Y: Single): TExpandedPixel; override; - function ProvidesScanline(ARect: TRect): boolean; override; - function GetScanlineAt(X, Y: integer): PBGRAPixel; override; - procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); override; - function ScanAtIntegerMask(X,Y: integer): TByteMask; override; - function ScanAtMask(X,Y: Single): TByteMask; override; - end; - -type - TBGRABitmapAny = class of TBGRACustomBitmap; //used to create instances of the same type (see NewBitmap) - -var - BGRABitmapFactory : TBGRABitmapAny; -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} -function InternalGetImageBoundsWithin(ASourceBitmap: TBGRACustomBitmap; ASourceTexture: IBGRAScanner; - const ARect: TRect; Channels: TChannels; ANothingValue: Byte): TRect; -var - minx, miny, maxx, maxy: integer; - xb, xb2, yb: integer; - p: PLongWord; - colorMask, colorZeros: LongWord; - actualRect: TRect; - pixelBuffer: TBGRAPixelBuffer; -begin - pixelBuffer := nil; - if ASourceBitmap <> nil then - begin - actualRect := TRect.Intersect(ARect, rect(0,0,ASourceBitmap.Width,ASourceBitmap.Height)); - end - else if ASourceTexture <> nil then - begin - actualRect := ARect; - AllocateBGRAPixelBuffer(pixelBuffer, ARect.Right-ARect.Left) - end - else - begin - result := EmptyRect; - exit; - end; - maxx := actualRect.Left-1; - maxy := actualRect.Top-1; - minx := actualRect.Right; - miny := actualRect.Bottom; - colorMask := 0; - colorZeros := 0; - if cBlue in Channels then - begin - colorMask := colorMask or LongWord(BGRA(0,0,255,0)); - colorZeros:= colorZeros or LongWord(BGRA(0,0,ANothingValue,0)); - end; - if cGreen in Channels then - begin - colorMask := colorMask or LongWord(BGRA(0,255,0,0)); - colorZeros:= colorZeros or LongWord(BGRA(0,ANothingValue,0,0)); - end; - if cRed in Channels then - begin - colorMask := colorMask or LongWord(BGRA(255,0,0,0)); - colorZeros:= colorZeros or LongWord(BGRA(ANothingValue,0,0,0)); - end; - if cAlpha in Channels then - begin - colorMask := colorMask or LongWord(BGRA(0,0,0,255)); - colorZeros:= colorZeros or LongWord(BGRA(0,0,0,ANothingValue)); - end; - colorMask := NtoLE(colorMask); - colorZeros := NtoLE(colorZeros); - for yb := actualRect.Top to actualRect.Bottom-1 do - begin - if ASourceBitmap <> nil then - p := PLongWord(ASourceBitmap.ScanLine[yb])+actualRect.Left - else - begin - p := @pixelBuffer[0]; - ASourceTexture.ScanMoveTo(actualRect.Left,actualRect.Top); - ASourceTexture.ScanPutPixels(PBGRAPixel(p),ARect.Right-ARect.Left, dmSet); - end; - for xb := actualRect.Left to actualRect.Right - 1 do - begin - if (p^ and colorMask) <> colorZeros then - begin - if xb < minx then - minx := xb; - if yb < miny then - miny := yb; - if xb > maxx then - maxx := xb; - if yb > maxy then - maxy := yb; - - inc(p, actualRect.Right-1-xb); - for xb2 := actualRect.Right-1 downto xb+1 do - begin - if (p^ and colorMask) <> colorZeros then - begin - if xb2 > maxx then - maxx := xb2; - break; - end; - dec(p); - end; - break; - end; - Inc(p); - end; - end; - if minx > maxx then - begin - Result.left := 0; - Result.top := 0; - Result.right := 0; - Result.bottom := 0; - end - else - begin - Result.left := minx; - Result.top := miny; - Result.right := maxx + 1; - Result.bottom := maxy + 1; - end; -end; - -{ TBGRACustomBitmap } - -function TBGRACustomBitmap.GetFontAntialias: Boolean; -begin - result := FontQuality <> fqSystem; -end; - -procedure TBGRACustomBitmap.SetFontAntialias(const AValue: Boolean); -begin - if AValue and not FontAntialias then - FontQuality := fqFineAntialiasing - else if not AValue and (FontQuality <> fqSystem) then - FontQuality := fqSystem; -end; - -procedure TBGRACustomBitmap.SetXorMask(AValue: TBGRACustomBitmap); -begin - if FXorMask=AValue then Exit; - if (AValue.Width <> Width) or (AValue.Height <> Height) then - raise exception.Create('Dimension mismatch'); - DiscardXorMask; - FXorMask:=AValue; -end; - -procedure TBGRACustomBitmap.Init; -begin - inherited Init; - ScanMaskChannel:= cGreen; -end; - -function TBGRACustomBitmap.GetFontRightToLeftFor(AText: string): boolean; -begin - case FontBidiMode of - fbmAuto: result := IsRightToLeftUTF8(AText); - fbmRightToLeft: result := true; - else - {fbmLeftToRight} - result := false; - end; -end; - -function TBGRACustomBitmap.NewBitmap: TBGRACustomBitmap; -begin - Result:=inherited NewBitmap as TBGRACustomBitmap; -end; - -function TBGRACustomBitmap.NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight) as TBGRACustomBitmap; -end; - -function TBGRACustomBitmap.NewBitmap(AWidth, AHeight: integer; - const Color: TBGRAPixel): TBGRACustomBitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGRACustomBitmap; -end; - -function TBGRACustomBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer - ): TBGRACustomBitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGRACustomBitmap; -end; - -function TBGRACustomBitmap.InternalNew: TBGRACustomBitmap; -begin - Result:= BGRABitmapFactory.Create; -end; - -procedure TBGRACustomBitmap.DiscardXorMask; -begin - if Assigned(FXorMask) then - begin - if FXorMask is TBGRACustomBitmap then - begin - TBGRACustomBitmap(FXorMask).FreeReference; - FXorMask := nil; - end else - FreeAndNil(FXorMask); - end; -end; - -procedure TBGRACustomBitmap.NeedXorMask; -begin - if FXorMask = nil then - FXorMask := BGRABitmapFactory.Create(Width,Height); -end; - -function TBGRACustomBitmap.NewReference: TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited NewReference); -end; - -function TBGRACustomBitmap.GetUnique: TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited GetUnique); -end; - -function TBGRACustomBitmap.Duplicate(DuplicateProperties: Boolean): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited Duplicate(DuplicateProperties)); -end; - -function TBGRACustomBitmap.Duplicate(DuplicateProperties, - DuplicateXorMask: Boolean): TBGRACustomBitmap; -begin - result := Duplicate(DuplicateProperties); - if DuplicateXorMask and Assigned(XorMask) then - result.XorMask := FXorMask.Duplicate(True); -end; - -procedure TBGRACustomBitmap.CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); -var - other: TBGRACustomBitmap; -begin - inherited CopyPropertiesTo(ABitmap); - if ABitmap is TBGRACustomBitmap then - begin - other := TBGRACustomBitmap(ABitmap); - other.CanvasOpacity := CanvasOpacity; - other.CanvasDrawModeFP := CanvasDrawModeFP; - other.PenStyle := PenStyle; - other.CustomPenStyle := CustomPenStyle; - other.FontName := FontName; - other.FontHeight := FontHeight; - other.FontStyle := FontStyle; - other.FontQuality := FontQuality; - other.FontOrientation := FontOrientation; - other.FontVerticalAnchor:= FontVerticalAnchor; - other.FontBidiMode:= FontBidiMode; - other.LineCap := LineCap; - other.JoinStyle := JoinStyle; - other.ResampleFilter := ResampleFilter; - other.ScanInterpolationFilter:= ScanInterpolationFilter; - other.HotSpot := HotSpot; - end; -end; - -function TBGRACustomBitmap.GetPart(const ARect: TRect): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited GetPart(ARect)); -end; - -function TBGRACustomBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; - APatternColor, ABackgroundColor: TBGRAPixel; AWidth: integer; - AHeight: integer; APenWidth: single): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited CreateBrushTexture(ABrushStyle, APatternColor, ABackgroundColor, AWidth,AHeight,APenWidth)); -end; - -procedure TBGRACustomBitmap.SetSize(AWidth, AHeight: integer); -begin - if (AWidth <> Width) or (AHeight <> Height) then - begin - inherited SetSize(AWidth, AHeight); - DiscardXorMask; - end; -end; - -procedure TBGRACustomBitmap.InternalArc(cx, cy, rx, ry: single; - const StartPoint, EndPoint: TPointF; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; - ADrawChord: boolean; ATexture: IBGRAScanner); -var angle1,angle2: single; -begin - if (rx = 0) or (ry = 0) then exit; - angle1 := arctan2(-(StartPoint.y-cy)/ry,(StartPoint.x-cx)/rx); - angle2 := arctan2(-(EndPoint.y-cy)/ry,(EndPoint.x-cx)/rx); - if angle1 = angle2 then angle2 := angle1+2*Pi; - InternalArc(cx,cy,rx,ry, angle1,angle2, - ABorderColor,w,AFillColor, AOptions, ADrawChord, ATexture); -end; - -procedure TBGRACustomBitmap.InternalArcInRect(r: TRect; StartAngleRad, - EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; - ADrawChord: boolean; ATexture: IBGRAScanner); -var - temp: LongInt; -begin - if r.right = r.left then exit; - if r.bottom = r.top then exit; - if r.right < r.left then - begin - temp := r.left; - r.left := r.right; - r.right := temp; - end; - if r.Bottom < r.Top then - begin - temp := r.Top; - r.Top := r.Bottom; - r.Bottom := temp; - end; - InternalArc((r.left+r.right-1)/2,(r.top+r.bottom-1)/2, - (r.right-r.left-1)/2,(r.bottom-r.top-1)/2, - StartAngleRad,EndAngleRad, - ABorderColor,w,AFillColor, - AOptions, ADrawChord, ATexture); -end; - -procedure TBGRACustomBitmap.InternalFillArcInRect(r: TRect; StartAngleRad, - EndAngleRad: Single; AFillColor: TBGRAPixel; AOptions: TArcOptions; - ATexture: IBGRAScanner); -var - temp: LongInt; -begin - if r.right = r.left then exit; - if r.bottom = r.top then exit; - if r.right < r.left then - begin - temp := r.left; - r.left := r.right; - r.right := temp; - end; - if r.Bottom < r.Top then - begin - temp := r.Top; - r.Top := r.Bottom; - r.Bottom := temp; - end; - InternalArc((r.left+r.right-1)/2,(r.top+r.bottom-1)/2, - (r.right-r.left)/2,(r.bottom-r.top)/2, - StartAngleRad,EndAngleRad, - BGRAPixelTransparent,0,AFillColor, - AOptions, False, ATexture); -end; - -procedure TBGRACustomBitmap.DrawPixel(x, y: int32or64; const c: TBGRAPixel; - ADrawMode: TDrawMode); -begin - case ADrawMode of - dmSet: SetPixel(x,y,c); - dmSetExceptTransparent: if c.alpha = 255 then SetPixel(x,y,c); - dmLinearBlend: FastBlendPixel(x,y,c); - dmDrawWithTransparency: DrawPixel(x,y,c); - dmXor: XorPixel(x,y,c); - end; -end; - -procedure TBGRACustomBitmap.LoadFromStream(AStream: TStream; - AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -var - OldDrawMode: TDrawMode; -begin - { LoadFromStream uses TFPCustomImage routine, which uses - Colors property to access pixels. That's why the - FP drawing mode is temporarily changed to load - bitmaps properly } - OldDrawMode := CanvasDrawModeFP; - CanvasDrawModeFP := dmSet; - DiscardXorMask; - try - inherited LoadFromStream(AStream, AHandler, AOptions); - finally - CanvasDrawModeFP := OldDrawMode; - end; -end; - -{ Look for a pixel considering the bitmap is repeated in both directions } -procedure TBGRACustomBitmap.DrawHorizLine(x, y, x2: int32or64; - texture: IBGRAScanner); -begin - HorizLine(x,y,x2,texture,dmDrawWithTransparency); -end; - -procedure TBGRACustomBitmap.Arc(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; AColor: TBGRAPixel; w: single; ADrawChord: boolean; - AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,w,AFillColor,[aoFillPath],ADrawChord); -end; - -procedure TBGRACustomBitmap.Arc(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; w: single; ADrawChord: boolean; - AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,w,AFillColor,[aoFillPath],ADrawChord); -end; - -procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,AFillColor,[aoFillPath]); -end; - -procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,AFillColor,[aoFillPath]); -end; - -procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; texture: IBGRAScanner); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath],False,texture); -end; - -procedure TBGRACustomBitmap.FillChord(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; texture: IBGRAScanner); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath],False,texture); -end; - -procedure TBGRACustomBitmap.FillChordInRect(const ARect: TRect; StartAngleRad, - EndAngleRad: Single; AFillColor: TBGRAPixel); -begin - InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,AFillColor,[aoFillPath]); -end; - -procedure TBGRACustomBitmap.FillChordInRect(const ARect: TRect; StartAngleRad, - EndAngleRad: Single; texture: IBGRAScanner); -begin - InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,BGRAWhite,[aoFillPath],texture); -end; - -procedure TBGRACustomBitmap.Pie(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,AColor,w,AFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGRACustomBitmap.Pie(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; AColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,AColor,w,AFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,AFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; AFillColor: TBGRAPixel); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,AFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; const StartPoint, - EndPoint: TPointF; texture: IBGRAScanner); -begin - InternalArc(cx,cy,rx,ry,StartPoint,EndPoint,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath,aoPie],False,texture); -end; - -procedure TBGRACustomBitmap.FillPie(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; texture: IBGRAScanner); -begin - InternalArc(cx,cy,rx,ry,StartAngleRad,EndAngleRad,BGRAPixelTransparent,0,BGRAWhite,[aoFillPath,aoPie],False,texture); -end; - -procedure TBGRACustomBitmap.FillPieInRect(const ARect: TRect; StartAngleRad, - EndAngleRad: Single; AFillColor: TBGRAPixel); -begin - InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,AFillColor,[aoFillPath,aoPie]); -end; - -procedure TBGRACustomBitmap.FillPieInRect(const ARect: TRect; StartAngleRad, - EndAngleRad: Single; texture: IBGRAScanner); -begin - InternalFillArcInRect(ARect,StartAngleRad,EndAngleRad,BGRAWhite,[aoFillPath,aoPie],texture); -end; - -{ Following functions are defined for convenience } -procedure TBGRACustomBitmap.RectangleWithin(x1, y1, x2, y2: single; - ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; - APixelCenteredCoordinates: boolean); -begin - if not APixelCenteredCoordinates then - begin - DecF(x1, 0.5); - DecF(y1, 0.5); - DecF(x2, 0.5); - DecF(y2, 0.5); - end; - RectangleAntialias(x1+w*0.5,y1+w*0.5,x2-w*0.5,y2-w*0.5, ABorderColor, w, AFillColor); -end; - -procedure TBGRACustomBitmap.RectangleWithin(r: TRect; ABorderColor: TBGRAPixel; - w: single; AFillColor: TBGRAPixel); -begin - RectangleWithin(r.left,r.top,r.right,r.bottom,ABorderColor,w,AFillColor,false); -end; - -procedure TBGRACustomBitmap.FillRect(r: TRect; texture: IBGRAScanner; - mode: TDrawMode; ditheringAlgorithm: TDitheringAlgorithm); -begin - FillRect(r.Left,r.Top,r.Right,r.Bottom, texture, mode, ditheringAlgorithm); -end; - -procedure TBGRACustomBitmap.FillRect(r: TRect; texture: IBGRAScanner; - mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); -begin - FillRect(r.Left,r.Top,r.Right,r.Bottom, texture, mode, AScanOffset, ditheringAlgorithm); -end; - -procedure TBGRACustomBitmap.FillRect(x, y, x2, y2: integer; - texture: IBGRAScanner; mode: TDrawMode; - ditheringAlgorithm: TDitheringAlgorithm); -begin - FillRect(x,y,x2,y2,texture,mode,Point(0,0),ditheringAlgorithm); -end; - -procedure TBGRACustomBitmap.TextOutCurved(APath: IBGRAPath; const sUTF8: string; - AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); -var cursor: TBGRACustomPathCursor; -begin - cursor := APath.getCursor; - if cursor = nil then exit; - case AAlign of - taCenter: cursor.Position := cursor.PathLength*0.5; - taRightJustify: cursor.Position:= cursor.PathLength; - end; - TextOutCurved(cursor, sUTF8, AColor, AAlign, ALetterSpacing); - cursor.free; -end; - -procedure TBGRACustomBitmap.TextOutCurved(APath: IBGRAPath; const sUTF8: string; - ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); -var cursor: TBGRACustomPathCursor; -begin - cursor := APath.getCursor; - if cursor = nil then exit; - case AAlign of - taCenter: cursor.Position := cursor.PathLength*0.5; - taRightJustify: cursor.Position:= cursor.PathLength; - end; - TextOutCurved(cursor, sUTF8, ATexture, AAlign, ALetterSpacing); - cursor.free; -end; - -procedure TBGRACustomBitmap.TextMultiline(x, y: single; const sUTF8: string; - c: TBGRAPixel; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single); -begin - TextMultiline(x, y, EmptySingle, sUTF8, c, AAlign, AVertAlign, AParagraphSpacing); -end; - -procedure TBGRACustomBitmap.TextMultiline(x, y: single; const sUTF8: string; - ATexture: IBGRAScanner; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single); -begin - TextMultiline(x, y, EmptySingle, sUTF8, ATexture, AAlign, AVertAlign, AParagraphSpacing); -end; - -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; - align: TAlignment); -begin - TextOut(x,y,sUTF8,c,align, GetFontRightToLeftFor(sUTF8)); -end; - -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; - texture: IBGRAScanner; align: TAlignment); -begin - TextOut(x,y,sUTF8,texture,align, GetFontRightToLeftFor(sUTF8)); -end; - -{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text. - The value of FontOrientation is taken into account, so that the text may be rotated. } -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel); -begin - TextOut(x, y, sUTF8, c, taLeftJustify); -end; - -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; - ARightToLeft: boolean); -begin - TextOut(x, y, sUTF8, c, taLeftJustify, ARightToLeft); -end; - -{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text. - The value of FontOrientation is taken into account, so that the text may be rotated. } -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TColor); -begin - TextOut(x, y, sUTF8, ColorToBGRA(c)); -end; - -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; c: TColor; - ARightToLeft: boolean); -begin - TextOut(x, y, sUTF8, ColorToBGRA(c), ARightToLeft); -end; - -{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The texture is used to fill the text. - The value of FontOrientation is taken into account, so that the text may be rotated. } -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; - texture: IBGRAScanner); -begin - TextOut(x, y, sUTF8, texture, taLeftJustify); -end; - -procedure TBGRACustomBitmap.TextOut(x, y: single; const sUTF8: string; - texture: IBGRAScanner; ARightToLeft: boolean); -begin - TextOut(x, y, sUTF8, texture, taLeftJustify, ARightToLeft); -end; - -procedure TBGRACustomBitmap.TextOutAngle(x, y: single; - orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel); -begin - TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,c,taLeftJustify); -end; - -procedure TBGRACustomBitmap.TextOutAngle(x, y: single; - orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; - align: TAlignment); -begin - TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,c,align, GetFontRightToLeftFor(sUTF8)); -end; - -procedure TBGRACustomBitmap.TextOutAngle(x, y: single; - orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner); -begin - TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,texture,taLeftJustify); -end; - -procedure TBGRACustomBitmap.TextOutAngle(x, y: single; - orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; - align: TAlignment); -begin - TextOutAngle(x,y, orientationTenthDegCCW, sUTF8,texture,align, GetFontRightToLeftFor(sUTF8)); -end; - -{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary. - The position depends on the specified horizontal alignment halign and vertical alignement valign. - The color c is used to fill the text. No rotation is applied. } -procedure TBGRACustomBitmap.TextRect(ARect: TRect; const sUTF8: string; - halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); -var - style: TTextStyle; - sUTF8bidi: String; -begin - {$hints off} - FillChar(style,sizeof(style),0); - {$hints on} - style.Alignment := halign; - style.Layout := valign; - style.Wordbreak := true; - style.ShowPrefix := false; - style.Clipping := false; - style.RightToLeft := GetFontRightToLeftFor(sUTF8); - if FontBidiMode = fbmAuto then - sUTF8bidi := AddParagraphBidiUTF8(sUTF8, style.RightToLeft) - else sUTF8bidi := sUTF8; - TextRect(ARect, ARect.Left, ARect.Top, sUTF8bidi, style, c); -end; - -{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary. - The position depends on the specified horizontal alignment halign and vertical alignement valign. - The texture is used to fill the text. No rotation is applied. } -procedure TBGRACustomBitmap.TextRect(ARect: TRect; const sUTF8: string; - halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); -var - style: TTextStyle; - sUTF8bidi: String; -begin - {$hints off} - FillChar(style,sizeof(style),0); - {$hints on} - style.Alignment := halign; - style.Layout := valign; - style.Wordbreak := true; - style.ShowPrefix := false; - style.Clipping := false; - style.RightToLeft := GetFontRightToLeftFor(sUTF8); - if FontBidiMode = fbmAuto then - sUTF8bidi := AddParagraphBidiUTF8(sUTF8, style.RightToLeft) - else sUTF8bidi := sUTF8; - TextRect(ARect,ARect.Left,ARect.Top,sUTF8bidi,style,texture); -end; - -function TBGRACustomBitmap.ComputeEllipse(x, y, rx, ry: single): ArrayOfTPointF; -begin - result := ComputeEllipseContour(x,y,rx,ry); -end; - -function TBGRACustomBitmap.ComputeEllipse(x, y, rx, ry, w: single - ): ArrayOfTPointF; -begin - result := ComputeEllipseBorder(x,y,rx,ry,w); -end; - -procedure TBGRACustomBitmap.Fill(texture: IBGRAScanner); -begin - FillRect(ClipRect, texture, dmSet); -end; - -procedure TBGRACustomBitmap.Fill(texture: IBGRAScanner; mode: TDrawMode); -begin - FillRect(ClipRect, texture, mode); -end; - -procedure TBGRACustomBitmap.FloodFill(X, Y: integer; Color: TBGRAPixel; - mode: TFloodfillMode; Tolerance: byte); -begin - ParallelFloodFill(X,Y, Self, Color, mode, Tolerance); -end; - -procedure TBGRACustomBitmap.FloodFill(X, Y: integer; - const Brush: TUniversalBrush; Progressive: boolean; ToleranceW: Word); -begin - ParallelFloodFill(X,Y, Self, Brush, Progressive, ToleranceW); -end; - -procedure TBGRACustomBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; x, - y: integer; Opaque: boolean); -var - partial: TBGRACustomBitmap; -begin - if (ARect.Left = 0) and (ARect.Top = 0) and (ARect.Right = Width) and (ARect.Bottom = Height) then - Draw(ACanvas, x,y, Opaque) - else - begin - partial := GetPart(ARect); - if partial <> nil then - begin - partial.Draw(ACanvas, x, y, Opaque); - partial.Free; - end; - end; -end; - -procedure TBGRACustomBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; - ATargetRect: TRect; Opaque: boolean); -var - partial: TBGRACustomBitmap; -begin - if (ARect.Left = 0) and (ARect.Top = 0) and (ARect.Right = Width) and (ARect.Bottom = Height) then - Draw(ACanvas, ATargetRect, Opaque) - else - begin - partial := GetPart(ARect); - if partial <> nil then - begin - partial.Draw(ACanvas, ATargetRect, Opaque); - partial.Free; - end; - end; -end; - -procedure TBGRACustomBitmap.PutImage(x, y: integer; Source: TBitmap; - mode: TDrawMode; AOpacity: byte); -var bgra: TBGRACustomBitmap; -begin - bgra := BGRABitmapFactory.create(Source); - PutImage(x,y, bgra, mode, AOpacity); - bgra.free; -end; - -procedure TBGRACustomBitmap.StretchPutImage(ARect: TRect; Source: TBitmap; - mode: TDrawMode; AOpacity: byte); -var bgra: TBGRACustomBitmap; -begin - bgra := BGRABitmapFactory.create(Source); - StretchPutImage(ARect, bgra, mode, AOpacity); - bgra.free; -end; - -procedure TBGRACustomBitmap.StretchPutImageProportionally(ARect: TRect; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; Source: TBGRACustomBitmap; - mode: TDrawMode; AOpacity: byte); -var - ratio: single; - imgRect: TRect; -begin - if (Source.Width = 0) or (Source.Height = 0) then exit; - if (ARect.Width <= 0) or (ARect.Height <= 0) then exit; - - ratio := min(ARect.Width/Source.Width, ARect.Height/Source.Height); - imgRect := RectWithSize(ARect.Left,ARect.Top, round(Source.Width*ratio), round(Source.Height*ratio)); - case AHorizAlign of - taCenter: imgRect.Offset((ARect.Width-imgRect.Width) div 2, 0); - taRightJustify: imgRect.Offset(ARect.Width-imgRect.Width, 0); - end; - case AVertAlign of - tlCenter: imgRect.Offset(0,(ARect.Height-imgRect.Height) div 2); - tlBottom: imgRect.Offset(0,ARect.Height-imgRect.Height); - end; - StretchPutImage(imgRect, Source, mode, AOpacity); -end; - -procedure TBGRACustomBitmap.PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap; AOpacity: byte); -begin - PutImageAngle(x,y,source,0,0,0,AOpacity); -end; - -procedure TBGRACustomBitmap.PutImagePart(x, y: integer; - Source: TBGRACustomBitmap; SourceRect: TRect; mode: TDrawMode; AOpacity: byte); -var w,h,sourcex,sourcey,nx,ny,xb,yb,destx,desty: integer; - oldClip,newClip: TRect; -begin - if (Source = nil) or (AOpacity = 0) then exit; - w := SourceRect.Right-SourceRect.Left; - h := SourceRect.Bottom-SourceRect.Top; - if (w <= 0) or (h <= 0) or (Source.Width = 0) or (Source.Height = 0) then exit; - sourcex := PositiveMod(SourceRect.Left, Source.Width); - sourcey := PositiveMod(SourceRect.Top, Source.Height); - nx := (sourceX+w + Source.Width-1) div Source.Width; - ny := (sourceY+h + Source.Height-1) div Source.Height; - - oldClip := ClipRect; - newClip := rect(x,y,x+w,y+h); - newClip.Intersect(oldClip); - if newClip.IsEmpty then exit; - - ClipRect := newClip; - - desty := y-sourcey; - for yb := 0 to ny-1 do - begin - destx := x-sourcex; - for xb := 0 to nx-1 do - begin - self.PutImage(destx,desty,Source,mode,AOpacity); - inc(destx,Source.Width); - end; - inc(desty,Source.Height); - end; - - ClipRect := oldClip; -end; - -procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; - Source: TBGRACustomBitmap; AOpacity: Byte; ACorrectBlur: Boolean); -begin - if ACorrectBlur then - PutImageAffine(Origin,HAxis,VAxis,Source,rfCosine,AOpacity) - else - PutImageAffine(Origin,HAxis,VAxis,Source,rfLinear,AOpacity); -end; - -procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; - Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte); -begin - if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; - PutImageAffine(Origin,HAxis,VAxis,Source,GetImageAffineBounds(Origin,HAxis,VAxis,Source),AResampleFilter,dmDrawWithTransparency,AOpacity); -end; - -procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; - Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; - AMode: TDrawMode; AOpacity: Byte); -begin - if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; - PutImageAffine(Origin,HAxis,VAxis,Source,GetImageAffineBounds(Origin,HAxis,VAxis,Source),AResampleFilter,AMode,AOpacity); -end; - -procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; - Source: TBGRACustomBitmap; AOutputBounds: TRect; - AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte); -var m: TAffineMatrix; w,h: integer; -begin - if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; - if Source.Width < 2 then w := 2 else w := Source.Width; //avoid actual size of zero - if Source.Height < 2 then h := 2 else h := Source.Height; - m[1,1] := (HAxis.x-Origin.x)/(w-1); m[1,2] := (VAxis.x-Origin.x)/(h-1); m[1,3] := Origin.x; - m[2,1] := (HAxis.y-Origin.y)/(w-1); m[2,2] := (VAxis.y-Origin.y)/(h-1); m[2,3] := Origin.y; - PutImageAffine(m,Source,AOutputBounds,AResampleFilter,AMode,AOpacity); -end; - -procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF; - Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte; - ACorrectBlur: Boolean); -begin - if ACorrectBlur then - PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfCosine,dmDrawWithTransparency,AOpacity) - else - PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfLinear,dmDrawWithTransparency,AOpacity); -end; - -procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; - Source: TBGRACustomBitmap; AOpacity: Byte; ACorrectBlur: Boolean; APixelCenteredCoords: boolean); -begin - if ACorrectBlur then - PutImageAffine(AMatrix,Source,rfCosine,AOpacity,APixelCenteredCoords) - else - PutImageAffine(AMatrix,Source,rfLinear,AOpacity,APixelCenteredCoords); -end; - -procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; - Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte; APixelCenteredCoords: boolean); -begin - PutImageAffine(AMatrix, Source, AResampleFilter, dmDrawWithTransparency, AOpacity, APixelCenteredCoords); -end; - -procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; - Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; - AMode: TDrawMode; AOpacity: Byte; APixelCenteredCoords: boolean); -begin - if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; - PutImageAffine(AMatrix, Source, GetImageAffineBounds(AMatrix,Source), - AResampleFilter,AMode,AOpacity,APixelCenteredCoords); -end; - -procedure TBGRACustomBitmap.PutImageAffine(AMatrix: TAffineMatrix; - Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte; - ACorrectBlur: Boolean; APixelCenteredCoords: boolean); -begin - if ACorrectBlur then - PutImageAffine(AMatrix,Source,AOutputBounds,rfCosine,dmDrawWithTransparency,AOpacity,APixelCenteredCoords) - else - PutImageAffine(AMatrix,Source,AOutputBounds,rfLinear,dmDrawWithTransparency,AOpacity,APixelCenteredCoords); -end; - -{ Returns the area that contains the affine transformed image } -function TBGRACustomBitmap.GetImageAffineBounds(Origin, HAxis, VAxis: TPointF; - Source: TBGRACustomBitmap): TRect; -begin - if Source = nil then - result := EmptyRect - else - result := GetImageAffineBounds(Origin,HAxis,VAxis,Source.Width,Source.Height,Source.GetImageBounds); -end; - -function TBGRACustomBitmap.GetImageAffineBounds(Origin, HAxis, VAxis: TPointF; - ASourceWidth, ASourceHeight: integer; const ASourceBounds: TRect; AClipOutput: boolean): TRect; -var m: TAffineMatrix; -begin - if (ASourceWidth = 0) or (ASourceHeight = 0) then - result := EmptyRect - else - begin - if ASourceWidth < 2 then ASourceWidth := 2; //avoid division by zero by supposing a pixel size of 2 - if ASourceHeight < 2 then ASourceHeight := 2; //i.e. an actual size of 1 (cf pixel centered coordinates) - m[1,1] := (HAxis.x-Origin.x)/(ASourceWidth-1); m[1,2] := (VAxis.x-Origin.x)/(ASourceHeight-1); m[1,3] := Origin.x; - m[2,1] := (HAxis.y-Origin.y)/(ASourceWidth-1); m[2,2] := (VAxis.y-Origin.y)/(ASourceHeight-1); m[2,3] := Origin.y; - result := GetImageAffineBounds(m, ASourceBounds, AClipOutput); - end; -end; - -function TBGRACustomBitmap.GetImageAffineBounds(AMatrix: TAffineMatrix; - Source: TBGRACustomBitmap; APixelCenteredCoords: boolean): TRect; -begin - result := GetImageAffineBounds(AMatrix, Source.GetImageBounds, true, APixelCenteredCoords); -end; - -procedure TBGRACustomBitmap.PutImageAngle(x, y: single; - Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; - imageCenterX: single; imageCenterY: single; AOpacity: Byte; - ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean); -begin - if ACorrectBlur then - PutImageAngle(x,y,Source,angle,AOutputBounds,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation) - else - PutImageAngle(x,y,Source,angle,AOutputBounds,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation); -end; - -procedure TBGRACustomBitmap.PutImageAngle(x, y: single; - Source: TBGRACustomBitmap; angle: single; imageCenterX: single; - imageCenterY: single; AOpacity: Byte; ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean); -begin - if ACorrectBlur then - PutImageAngle(x,y,Source,angle,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation) - else - PutImageAngle(x,y,Source,angle,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation); -end; - -procedure TBGRACustomBitmap.PutImageAngle(x, y: single; - Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; - AResampleFilter: TResampleFilter; imageCenterX: single; imageCenterY: single; AOpacity: Byte; - ARestoreOffsetAfterRotation: boolean); -var - Origin,HAxis,VAxis: TPointF; -begin - if (source = nil) or (AOpacity=0) then exit; - ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation, - Origin,HAxis,VAxis); - PutImageAffine(Origin,HAxis,VAxis,source,AOutputBounds,AResampleFilter,dmDrawWithTransparency,AOpacity); -end; - -procedure TBGRACustomBitmap.PutImageAngle(x, y: single; - Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter; - imageCenterX: single; imageCenterY: single; AOpacity: Byte; - ARestoreOffsetAfterRotation: boolean); -var - Origin,HAxis,VAxis: TPointF; -begin - if (source = nil) or (AOpacity=0) then exit; - ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation, - Origin,HAxis,VAxis); - PutImageAffine(Origin,HAxis,VAxis,source,AResampleFilter,AOpacity); -end; - -procedure TBGRACustomBitmap.ComputeImageAngleAxes(x, y, w, h, - angle: single; imageCenterX, imageCenterY: single; - ARestoreOffsetAfterRotation: boolean; out Origin, HAxis, VAxis: TPointF); -var - cosa,sina: single; - - { Compute rotated coordinates } - function Coord(relX,relY: single): TPointF; - begin - DecF(relX, imageCenterX); - DecF(relY, imageCenterY); - result.x := relX*cosa - relY*sina+ x; - result.y := relY*cosa + relX*sina+ y; - if ARestoreOffsetAfterRotation then - result.Offset(imageCenterX,imageCenterY); - end; - -begin - cosa := cos(-angle*Pi/180); - sina := -sin(-angle*Pi/180); - Origin := Coord(0,0); - if w < 2 then w := 2; //when pixel size is 1, actual size is zero, so avoid that - if h < 2 then h := 2; - HAxis := Coord(w-1,0); - VAxis := Coord(0,h-1); -end; - -function TBGRACustomBitmap.GetImageAngleBounds(x, y: single; - Source: TBGRACustomBitmap; angle: single; imageCenterX: single; - imageCenterY: single; ARestoreOffsetAfterRotation: boolean): TRect; -var - cosa,sina: single; - - { Compute rotated coordinates } - function Coord(relX,relY: single): TPointF; - begin - DecF(relX, imageCenterX); - DecF(relY, imageCenterY); - result.x := relX*cosa - relY*sina + x; - result.y := relY*cosa + relX*sina + y; - if ARestoreOffsetAfterRotation then - result.Offset(imageCenterX,imageCenterY); - end; - -begin - if (source = nil) then - begin - result := EmptyRect; - exit; - end; - cosa := cos(-angle*Pi/180); - sina := -sin(-angle*Pi/180); - result := GetImageAffineBounds(Coord(0,0),Coord(source.Width,0),Coord(0,source.Height),source); -end; - -procedure TBGRACustomBitmap.Blend(AColor: TBGRAPixel; - AOperation: TBlendOperation; AIgnoreDestAlpha: boolean); -begin - BlendRect(ClipRect, AColor, AOperation, AIgnoreDestAlpha); -end; - -procedure TBGRACustomBitmap.BlendOver(AColor: TBGRAPixel; - AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; AIgnoreDestAlpha: boolean); -begin - BlendRectOver(ClipRect, AColor, AOperation, AOpacity, ALinearBlend, AIgnoreDestAlpha); -end; - -procedure TBGRACustomBitmap.BlendRect(ADest: TRect; AColor: TBGRAPixel; - AOperation: TBlendOperation; AIgnoreDestAlpha: boolean); -begin - if AIgnoreDestAlpha then - BlendRect(ADest, AColor, AOperation, [cAlpha]) - else BlendRect(ADest, AColor, AOperation, []); -end; - -procedure TBGRACustomBitmap.BlendRectOver(ADest: TRect; AColor: TBGRAPixel; - AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; - AIgnoreDestAlpha: boolean); -begin - if AIgnoreDestAlpha then - BlendRectOver(ADest, AColor, AOperation, AOpacity, ALinearBlend,[cAlpha]) - else BlendRectOver(ADest, AColor, AOperation, AOpacity, ALinearBlend, []); -end; - -procedure TBGRACustomBitmap.FillMask(x, y: integer; - AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode); -begin - FillMask(x, y, AMask, ATexture, ADrawMode, 255); -end; - -procedure TBGRACustomBitmap.VerticalFlip(ARect: TRect); -begin - inherited VerticalFlip(ARect); - if Assigned(XorMask) then XorMask.VerticalFlip(ARect); -end; - -procedure TBGRACustomBitmap.HorizontalFlip(ARect: TRect); -begin - inherited HorizontalFlip(ARect); - if Assigned(XorMask) then XorMask.HorizontalFlip(ARect); -end; - -procedure TBGRACustomBitmap.RotateUDInplace(ARect: TRect); -begin - inherited RotateUDInplace(ARect); - if Assigned(XorMask) then XorMask.RotateUDInplace(ARect); -end; - -function TBGRACustomBitmap.RotateCW: TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(Inherited RotateCW); - if Assigned(XorMask) then result.FXorMask := self.XorMask.RotateCW; -end; - -function TBGRACustomBitmap.RotateCCW: TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(Inherited RotateCCW); - if Assigned(XorMask) then result.FXorMask := self.XorMask.RotateCCW; -end; - -function TBGRACustomBitmap.RotateUD: TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(Inherited RotateUD); - if Assigned(XorMask) then result.FXorMask := self.XorMask.RotateUD; -end; - -function TBGRACustomBitmap.FilterBlurRadial(radius: single; - blurType: TRadialBlurType): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterBlurRadial(radius, blurType)); -end; - -function TBGRACustomBitmap.FilterBlurRadial(const ABounds: TRect; radius: single; - blurType: TRadialBlurType): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterBlurRadial(ABounds, radius, blurType)); -end; - -function TBGRACustomBitmap.FilterBlurRadial(radiusX, radiusY: single; - blurType: TRadialBlurType): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterBlurRadial(radiusX,radiusY, blurType)); -end; - -function TBGRACustomBitmap.FilterBlurRadial(const ABounds: TRect; radiusX, - radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterBlurRadial(ABounds, radiusX,radiusY, blurType)); -end; - -function TBGRACustomBitmap.FilterBlurMotion(distance: single; angle: single; - oriented: boolean): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterBlurMotion(distance, angle, oriented)); -end; - -function TBGRACustomBitmap.FilterBlurMotion(const ABounds: TRect; distance: single; - angle: single; oriented: boolean): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterBlurMotion(ABounds, distance, angle, oriented)); -end; - -function TBGRACustomBitmap.FilterCustomBlur(mask: TCustomUniversalBitmap - ): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterCustomBlur(mask)); -end; - -function TBGRACustomBitmap.FilterCustomBlur(const ABounds: TRect; - mask: TCustomUniversalBitmap): TBGRACustomBitmap; -begin - result := TBGRACustomBitmap(inherited FilterCustomBlur(ABounds,mask)); -end; - -function TBGRACustomBitmap.GetImageBoundsWithin(const ARect: TRect; - Channel: TChannel; ANothingValue: Byte): TRect; -begin - result := InternalGetImageBoundsWithin(self,nil,ARect,[Channel],ANothingValue); -end; - -function TBGRACustomBitmap.GetImageBoundsWithin(const ARect: TRect; - Channels: TChannels; ANothingValue: Byte): TRect; -begin - result := InternalGetImageBoundsWithin(self,nil,ARect,Channels,ANothingValue); -end; - -function TBGRACustomBitmap.ScanAtIntegerExpanded(X, Y: integer): TExpandedPixel; -begin - result := GammaExpansion(ScanAtInteger(X,Y)); -end; - -function TBGRACustomBitmap.ScanNextExpandedPixel: TExpandedPixel; -begin - result := GammaExpansion(ScanNextPixel); -end; - -function TBGRACustomBitmap.ScanAtExpanded(X, Y: Single): TExpandedPixel; -begin - result := GammaExpansion(ScanAt(X,Y)); -end; - -function TBGRACustomBitmap.ProvidesScanline(ARect: TRect): boolean; -begin - result := (ARect.Left+ScanOffset.x >= 0) and (ARect.Top+ScanOffset.y >= 0) and - (ARect.Right+ScanOffset.x <= Width) and (ARect.Bottom+ScanOffset.y <= Height); -end; - -function TBGRACustomBitmap.GetScanlineAt(X, Y: integer): PBGRAPixel; -begin - result := ScanLine[y+ScanOffset.y]+x+ScanOffset.x; -end; - -procedure TBGRACustomBitmap.ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); -var - PPixels: Pointer; -begin - ScanNextCustomChunk(ACount, PPixels); - AMask := (PByteMask(PPixels)+TBGRAPixel_ChannelByteOffset[ScanMaskChannel]); - AStride := sizeof(TBGRAPixel); -end; - -function TBGRACustomBitmap.ScanAtIntegerMask(X,Y: integer): TByteMask; -var - c: TBGRAPixel; -begin - c := ScanAtInteger(X,Y); - result := (PByte(@c)+TBGRAPixel_ChannelByteOffset[ScanMaskChannel])^; -end; - -function TBGRACustomBitmap.ScanAtMask(X,Y: Single): TByteMask; -var - c: TBGRAPixel; -begin - c := ScanAt(X,Y); - result := (PByte(@c)+TBGRAPixel_ChannelByteOffset[ScanMaskChannel])^; -end; - -{$ENDIF} diff --git a/components/bgrabitmap/bgracustomtextfx.pas b/components/bgrabitmap/bgracustomtextfx.pas deleted file mode 100644 index f6c4c08..0000000 --- a/components/bgrabitmap/bgracustomtextfx.pas +++ /dev/null @@ -1,600 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRACustomTextFX; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, BGRAPhongTypes, BGRAGrayscaleMask; - -const DefaultOutlineWidth = 3; - -type - { TBGRACustomTextEffect } - - TBGRACustomTextEffect = class - private - function GetBounds: TRect; - function GetMaskHeight: integer; - class function GetOutlineWidth: integer; static; - function GetShadowBounds(ARadius: integer): TRect; - function GetMaskWidth: integer; - function GetTextHeight: integer; - function GetTextWidth: integer; - procedure SetShadowQuality(AValue: TRadialBlurType); - protected - FShadowQuality: TRadialBlurType; - FTextMask: TGrayscaleMask; - FShadowRadius: integer; - FOutlineMask, FShadowMask : TGrayscaleMask; - FShadingMask: TBGRACustomBitmap; - FShadingAltitude: integer; - FShadingRounded: boolean; - FTextSize: TSize; - FOffset: TPoint; - function DrawMaskMulticolored(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; const AColors: array of TBGRAPixel): TRect; - function DrawMask(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; AColor: TBGRAPixel): TRect; overload; - function DrawMask(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; ATexture: IBGRAScanner): TRect; overload; - function InternalDrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect; - procedure Init(AMask: TGrayscaleMask; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint); - public - constructor Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint); - constructor Create(AMask: TGrayscaleMask; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint); - procedure ApplySphere; - procedure ApplyVerticalCylinder; - procedure ApplyHorizontalCylinder; - function Draw(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect; overload; - function Draw(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect; overload; - function Draw(ADest: TBGRACustomBitmap; X, Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload; - function Draw(ADest: TBGRACustomBitmap; X, Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect; overload; - - function DrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ARounded: Boolean = true): TRect; overload; - function DrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; ARounded: Boolean = true): TRect; overload; - function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; AAlign: TAlignment; ARounded: Boolean = true): TRect; overload; - function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; AAlign: TAlignment; ARounded: Boolean = true): TRect; overload; - - function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel): TRect; overload; - function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect; overload; - function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect; overload; - function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect; overload; - function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload; - function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect; overload; - function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel): TRect; overload; - function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload; - destructor Destroy; override; - property TextMask: TGrayscaleMask read FTextMask; - property TextMaskOffset: TPoint read FOffset; - property Width: integer read GetTextWidth; deprecated; - property Height: integer read GetTextHeight; deprecated; - property MaskWidth: integer read GetMaskWidth; - property MaskHeight: integer read GetMaskHeight; - property TextSize: TSize read FTextSize; - property TextWidth: integer read GetTextWidth; - property TextHeight: integer read GetTextHeight; - property Bounds: TRect read GetBounds; - property ShadowBounds[ARadius: integer]: TRect read GetShadowBounds; - property ShadowQuality: TRadialBlurType read FShadowQuality write SetShadowQuality; - class property OutlineWidth: integer read GetOutlineWidth; - end; - -implementation - -uses Math, BGRAGradientScanner; - -procedure BGRACustomReplace(var Destination: TBGRACustomBitmap; Temp: TObject); overload; -begin - Destination.Free; - Destination := Temp as TBGRACustomBitmap; -end; - -procedure BGRACustomReplace(var Destination: TGrayscaleMask; Temp: TObject); overload; -begin - Destination.Free; - Destination := Temp as TGrayscaleMask; -end; - -{ TBGRACustomTextEffect } - -function TBGRACustomTextEffect.GetBounds: TRect; -begin - if FTextMask = nil then - result := EmptyRect else - with TextMaskOffset do - result := rect(X,Y,X+FTextMask.Width,Y+FTextMask.Height); -end; - -function TBGRACustomTextEffect.GetMaskHeight: integer; -begin - if FTextMask = nil then - result := 0 - else - result := FTextMask.Height; -end; - -class function TBGRACustomTextEffect.GetOutlineWidth: integer; static; -begin - result := DefaultOutlineWidth; -end; - -function TBGRACustomTextEffect.GetShadowBounds(ARadius: integer): TRect; -begin - result := Bounds; - if (ARadius > 0) and not result.IsEmpty then - result.Inflate(ARadius, ARadius); -end; - -function TBGRACustomTextEffect.GetMaskWidth: integer; -begin - if FTextMask = nil then - result := 0 - else - result := FTextMask.Width; -end; - -function TBGRACustomTextEffect.GetTextHeight: integer; -begin - result := FTextSize.cy; -end; - -function TBGRACustomTextEffect.GetTextWidth: integer; -begin - result := FTextSize.cx; -end; - -procedure TBGRACustomTextEffect.SetShadowQuality(AValue: TRadialBlurType); -begin - if FShadowQuality=AValue then Exit; - FShadowQuality:=AValue; - FreeAndNil(FShadowMask); -end; - -function TBGRACustomTextEffect.DrawMaskMulticolored(ADest: TBGRACustomBitmap; - AMask: TCustomUniversalBitmap; X, Y: Integer; const AColors: array of TBGRAPixel - ): TRect; -var - scan: TBGRASolidColorMaskScanner; - xb,yb,startX,numColor: integer; - p0,p: PByte; - emptyCol, nextCol: boolean; -begin - if (AMask = nil) or (length(AColors)=0) then - begin - result := EmptyRect; - exit; - end; - if (length(AColors)=0) then - begin - result := DrawMask(ADest,AMask,X,Y,AColors[0]); - exit; - end; - scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColors[0]); - numColor := 0; - startX := -1; - p0 := AMask.DataByte; - for xb := 0 to AMask.Width-1 do - begin - p := p0; - - if startX=-1 then - begin - emptyCol := true; - for yb := AMask.Height-1 downto 0 do - begin - if (p^ <> 0) then - begin - emptyCol := false; - break; - end; - inc(p, AMask.Width); - end; - - if not emptyCol then - begin - if startX=-1 then - startX := xb; - end else - begin - if startX<>-1 then - begin - ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency); - inc(numColor); - if numColor = length(AColors) then - numColor := 0; - scan.Color := AColors[numColor]; - startX := -1; - end; - end; - - end else - begin - emptyCol := true; - nextCol := true; - for yb := AMask.Height-1 downto 0 do - begin - if (p^ <> 0) then - begin - emptyCol := false; - if ((p-1)^ <> 0) then - begin - nextCol := false; - break; - end; - end; - inc(p, AMask.Width); - end; - if nextCol or emptyCol then - begin - ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency); - inc(numColor); - if numColor = length(AColors) then - numColor := 0; - scan.Color := AColors[numColor]; - if emptyCol then startX := -1 - else startX := xb; - end; - end; - - inc(p0); - end; - if startX<>-1 then - ADest.FillRect(X+startX,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency); - scan.Free; - result := rect(X,Y,X+AMask.Width,Y+AMask.Height); -end; - -function TBGRACustomTextEffect.DrawMask(ADest: TBGRACustomBitmap; - AMask: TCustomUniversalBitmap; X, Y: Integer; AColor: TBGRAPixel): TRect; -var - scan: TBGRACustomScanner; -begin - if AMask = nil then - begin - result := EmptyRect; - exit; - end; - scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColor); - ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency); - scan.Free; - result := rect(X,Y,X+AMask.Width,Y+AMask.Height); -end; - -function TBGRACustomTextEffect.DrawMask(ADest: TBGRACustomBitmap; - AMask: TCustomUniversalBitmap; X, Y: Integer; ATexture: IBGRAScanner): TRect; -var - scan: TBGRACustomScanner; -begin - if AMask = nil then - begin - result := EmptyRect; - exit; - end; - scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),ATexture); - ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency); - scan.Free; - result := rect(X,Y,X+AMask.Width,Y+AMask.Height); -end; - -function TBGRACustomTextEffect.InternalDrawShaded(ADest: TBGRACustomBitmap; X, - Y: integer; Shader: TCustomPhongShading; Altitude: integer; - AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect; -var - WithMargin,GrayMap: TGrayscaleMask; - HeightMap: TBGRACustomBitmap; - p: PBGRAPixel; - n,maxv: integer; - v,blurRadius: single; - iBlurRadius: integer; -begin - if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then - begin - result := EmptyRect; - exit; - end; - - if (FShadingMask <> nil) and ((FShadingAltitude <> Altitude) or (FShadingRounded <> ARounded)) then - FreeAndNil(FShadingMask); - - if FShadingMask = nil then - begin - FShadingRounded := ARounded; - FShadingAltitude := Altitude; - - if ARounded then blurRadius := Altitude - else blurRadius := Altitude*0.5; - - iBlurRadius := ceil(blurRadius); - - WithMargin := TGrayscaleMask.Create(FTextMask.Width+iBlurRadius*2, FTextMask.Height+iBlurRadius*2,BGRABlack); - WithMargin.PutImage(iBlurRadius, iBlurRadius, FTextMask, dmSet); - if (iBlurRadius <> blurRadius) and (blurRadius < 3) then - GrayMap := WithMargin.FilterBlurRadial(round(blurRadius*10), rbPrecise) - else - GrayMap := WithMargin.FilterBlurRadial(iBlurRadius, rbFast); - HeightMap := BGRABitmapFactory.Create; - HeightMap.SetSize(GrayMap.Width, GrayMap.Height); - GrayMap.Draw(HeightMap, 0, 0); - GrayMap.Free; - - p := HeightMap.Data; - maxv := 0; - for n := HeightMap.NbPixels-1 downto 0 do - begin - if p^.green > maxv then - maxv := p^.green; - inc(p); - end; - - if maxv > 0 then - begin - p := HeightMap.Data; - for n := HeightMap.NbPixels-1 downto 0 do - begin - v := p^.green/maxv; - if ARounded then - begin - if v <= 0.5 then - v := v*v*2 else - v := 1-(1-v)*(1-v)*2; - end; - p^ := MapHeightToBGRA( v, p^.alpha); - inc(p); - end; - end; - - HeightMap.ApplyMask(WithMargin); - WithMargin.Free; - BGRACustomReplace(HeightMap, HeightMap.GetPart( rect(iBlurRadius, iBlurRadius, - HeightMap.Width-iBlurRadius, HeightMap.Height-iBlurRadius) ) ); - FShadingMask := HeightMap; - end; - - inc(X, FOffset.X); - Inc(Y, FOffset.Y); - if ATexture <> nil then - Shader.DrawScan(ADest,FShadingMask,Altitude,X,Y, ATexture) - else - Shader.Draw(ADest,FShadingMask,Altitude,X,Y, AColor); - result := rect(X,Y, X+FShadingMask.Width,Y+FShadingMask.Height); -end; - -procedure TBGRACustomTextEffect.Init(AMask: TGrayscaleMask; - AMaskOwner: boolean; AWidth, AHeight: integer; AOffset: TPoint); -begin - FTextSize := Size(AWidth,AHeight); - FOffset := AOffset; - if not AMaskOwner then - FTextMask := AMask.Duplicate - else - FTextMask := AMask; - FShadowQuality:= rbFast; -end; - -function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; - AColor: TBGRAPixel; AAlign: TAlignment): TRect; -begin - Case AAlign of - taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,AColor); - taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,AColor); - else result := Draw(ADest,X,Y,AColor); - end; -end; - -function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; - ATexture: IBGRAScanner; AAlign: TAlignment): TRect; -begin - Case AAlign of - taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,ATexture); - taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,ATexture); - else result := Draw(ADest,X,Y,ATexture); - end; -end; - -function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; - Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; - ARounded: Boolean): TRect; -begin - result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,AColor,nil,ARounded); -end; - -function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; - Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; - ARounded: Boolean): TRect; -begin - result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,BGRAPixelTransparent,ATexture,ARounded); -end; - -function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; - Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; - AAlign: TAlignment; ARounded: Boolean): TRect; -begin - Case AAlign of - taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,AColor,ARounded); - taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,AColor,ARounded); - taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,AColor,ARounded); - else - result := EmptyRect; - end; -end; - -function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; - Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; - AAlign: TAlignment; ARounded: Boolean): TRect; -begin - Case AAlign of - taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,ATexture,ARounded); - taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,ATexture,ARounded); - taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,ATexture,ARounded); - else - result := EmptyRect; - end; -end; - -constructor TBGRACustomTextEffect.Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth, - AHeight: integer; AOffset: TPoint); -var - grayMask: TGrayscaleMask; -begin - grayMask := TGrayscaleMask.Create(AMask, cGreen); - if AMaskOwner then AMask.Free; - Init(grayMask, true, AWidth, AHeight, AOffset); -end; - -constructor TBGRACustomTextEffect.Create(AMask: TGrayscaleMask; - AMaskOwner: boolean; AWidth, AHeight: integer; AOffset: TPoint); -begin - Init(AMask, AMaskOwner, AWidth, AHeight, AOffset); -end; - -procedure TBGRACustomTextEffect.ApplySphere; -begin - if FTextMask = nil then exit; - FreeAndNil(FOutlineMask); - FreeAndNil(FShadowMask); - FShadowRadius := 0; - BGRACustomReplace(FTextMask, FTextMask.FilterSphere); -end; - -procedure TBGRACustomTextEffect.ApplyVerticalCylinder; -begin - if FTextMask = nil then exit; - FreeAndNil(FOutlineMask); - FreeAndNil(FShadowMask); - FShadowRadius := 0; - BGRACustomReplace(FTextMask, FTextMask.FilterCylinder); -end; - -procedure TBGRACustomTextEffect.ApplyHorizontalCylinder; -begin - if FTextMask = nil then exit; - FreeAndNil(FOutlineMask); - FreeAndNil(FShadowMask); - FShadowRadius := 0; - BGRACustomReplace(FTextMask,FTextMask.RotateCW); - BGRACustomReplace(FTextMask,FTextMask.FilterCylinder); - BGRACustomReplace(FTextMask,FTextMask.RotateCCW); -end; - -function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; - AColor: TBGRAPixel): TRect; -begin - result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColor); -end; - -function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer; - ATexture: IBGRAScanner): TRect; -begin - result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,ATexture); -end; - -function TBGRACustomTextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X, - Y: integer; const AColors: array of TBGRAPixel): TRect; -begin - result := DrawMaskMulticolored(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColors); -end; - -function TBGRACustomTextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X, - Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect; -begin - Case AAlign of - taRightJustify: result := DrawMulticolored(ADest,X-TextSize.cx,Y,AColors); - taCenter: result := DrawMulticolored(ADest,X-TextSize.cx div 2,Y,AColors); - else result := DrawMulticolored(ADest,X,Y,AColors); - end; -end; - -function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; - AColor: TBGRAPixel): TRect; -begin - if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then - begin - result := EmptyRect; - exit; - end; - if FOutlineMask = nil then - begin - FOutlineMask := FTextMask.FilterContour; - FOutlineMask.Negative; - end; - result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,AColor); -end; - -function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; - ATexture: IBGRAScanner): TRect; -begin - if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then - begin - result := EmptyRect; - exit; - end; - if FOutlineMask = nil then - begin - FOutlineMask := FTextMask.FilterContour; - FOutlineMask.Negative; - end; - result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,ATexture); -end; - -function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; - AColor: TBGRAPixel; AAlign: TAlignment): TRect; -begin - Case AAlign of - taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,AColor); - taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,AColor); - else result := DrawOutline(ADest,X,Y,AColor); - end; -end; - -function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer; - ATexture: IBGRAScanner; AAlign: TAlignment): TRect; -begin - Case AAlign of - taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,ATexture); - taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,ATexture); - else result := DrawOutline(ADest,X,Y,ATexture); - end; -end; - -function TBGRACustomTextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y, - Radius: integer; AColor: TBGRAPixel): TRect; -begin - if (Radius <= 0) or (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then - begin - result := Draw(ADest,X,Y,AColor); - exit; - end; - if (FShadowRadius <> Radius) or (FShadowMask = nil) then - begin - FShadowRadius := Radius; - FreeAndNil(FShadowMask); - FShadowMask := TGrayscaleMask.Create(FTextMask.Width+Radius*2,FTextMask.Height+Radius*2, 0); - FShadowMask.PutImage(Radius,Radius,FTextMask,dmSet); - BGRACustomReplace(FShadowMask, FShadowMask.FilterBlurRadial(Radius,ShadowQuality)); - end; - Inc(X,FOffset.X-Radius); - Inc(Y,FOffset.Y-Radius); - DrawMask(ADest,FShadowMask,X,Y,AColor); - result := rect(X,Y,X+FShadowMask.Width,Y+FShadowMask.Height); -end; - -function TBGRACustomTextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y, - Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; -begin - Case AAlign of - taRightJustify: result := DrawShadow(ADest,X-TextSize.cx,Y,Radius,AColor); - taCenter: result := DrawShadow(ADest,X-TextSize.cx div 2,Y,Radius,AColor); - else result := DrawShadow(ADest,X,Y,Radius,AColor); - end; -end; - -destructor TBGRACustomTextEffect.Destroy; -begin - FShadowMask.free; - FTextMask.Free; - FOutlineMask.Free; - FShadingMask.Free; - inherited Destroy; -end; - -end. - diff --git a/components/bgrabitmap/bgradefaultbitmap.pas b/components/bgrabitmap/bgradefaultbitmap.pas deleted file mode 100644 index 3d015a4..0000000 --- a/components/bgrabitmap/bgradefaultbitmap.pas +++ /dev/null @@ -1,4639 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - /**************************************************************************\ - bgradefaultbitmap.pas - --------------------- - This unit defines basic operations on bitmaps. - It should NOT be added to the 'uses' clause. - Some operations may be slow, so there are - accelerated versions for some routines. -} - -unit BGRADefaultBitmap; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -{ This unit contains TBGRADefaultBitmap class. This class contains basic drawing routines, - and call functions from other units to perform advanced drawing functions. } - -uses - SysUtils, BGRAClasses, FPImage, BGRAGraphics, BGRABitmapTypes, - {$IFDEF BGRABITMAP_USE_FPCANVAS}FPImgCanv,{$ENDIF} - BGRACanvas, BGRACanvas2D, BGRATransform, BGRATextBidi, - UniversalDrawer, BGRAGrayscaleMask; - -type - TBGRAPtrBitmap = class; - {=== TBGRABitmap reference ===} - { TBGRADefaultBitmap } - {* This class is the base for all ''TBGRABitmap'' classes. It implements most - function to the exception from implementations specific to the - widgetset }{ in the doc, it is presented as - TBGRABitmap = class(TBGRACustomBitmap) - } - TBGRADefaultBitmap = class(TBGRACustomBitmap) - private - { Bounds checking which are shared by drawing functions. These functions check - if the coordinates are visible and return true if it is the case, swap - coordinates if necessary and make them fit into the clipping rectangle } - function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; inline; - function CheckAntialiasRectBounds(var x,y,x2,y2: single; w: single): boolean; - function GetCanvasBGRA: TBGRACanvas; - function GetCanvas2D: TBGRACanvas2D; - procedure GradientFillDithered(x, y, x2, y2: integer; c1, c2: TBGRAPixel; - gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - gammaColorCorrection: boolean = True; Sinus: Boolean=False; - ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload; - procedure GradientFillDithered(x, y, x2, y2: integer; gradient: TBGRACustomGradient; - gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - Sinus: Boolean=False; - ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload; - - protected - //Pixel data - FDataModified: boolean; //if data image has changed so TBitmap should be updated - - //GUI bitmap object - FBitmap: TBitmap; - FBitmapModified: boolean; //if TBitmap has changed so pixel data should be updated - FCanvasOpacity: byte; //opacity used with standard canvas functions - FAlphaCorrectionNeeded: boolean; //the alpha channel is not correct because standard functions do not - //take it into account - - //FreePascal drawing routines - {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP: TFPImageCanvas;{$ENDIF} - FCanvasDrawModeFP: TDrawMode; - FCanvasPixelProcFP: procedure(x, y: int32or64; const col: TBGRAPixel) of object; - - //canvas-like with antialiasing and texturing - FCanvasBGRA: TBGRACanvas; - FCanvas2D: TBGRACanvas2D; - - //drawing options - FFontHeight: integer; - FFontRenderer: TBGRACustomFontRenderer; - - //Pixel data - function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; - AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; virtual; abstract; - - //FreePascal drawing routines - {$IFDEF BGRABITMAP_USE_FPCANVAS}function GetCanvasFP: TFPImageCanvas; override;{$ENDIF} - procedure SetCanvasDrawModeFP(const AValue: TDrawMode); override; - function GetCanvasDrawModeFP: TDrawMode; override; - - //GUI bitmap object - function GetBitmap: TBitmap; override; - function GetCanvas: TCanvas; override; - function GetCanvasOpacity: byte; override; - procedure SetCanvasOpacity(AValue: byte); override; - function GetCanvasAlphaCorrection: boolean; override; - procedure SetCanvasAlphaCorrection(const AValue: boolean); override; - procedure DoAlphaCorrection; - procedure DiscardBitmapChange; inline; - procedure DoLoadFromBitmap; virtual; - - function CreatePtrBitmap(AWidth,AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; virtual; - - procedure RebuildBitmap; virtual; abstract; - procedure FreeBitmap; virtual; - - procedure Init; override; - - {TFPCustomImage} - procedure SetInternalColor(x, y: integer; const Value: TFPColor); override; - function GetInternalColor(x, y: integer): TFPColor; override; - procedure SetInternalPixel(x, y: integer; Value: integer); override; - function GetInternalPixel(x, y: integer): integer; override; - - {Image functions} - function FineResample(NewWidth, NewHeight: integer): TBGRACustomBitmap; - function SimpleStretch(NewWidth, NewHeight: integer): TBGRACustomBitmap; - function CheckEmpty: boolean; override; - function GetHasTransparentPixels: boolean; override; - function GetHasSemiTransparentPixels: boolean; override; - function GetAverageColor: TColor; override; - function GetAveragePixel: TBGRAPixel; override; - - protected //pen style accesors - function GetPenJoinStyle: TPenJoinStyle; override; - procedure SetPenJoinStyle(const AValue: TPenJoinStyle); override; - function GetPenMiterLimit: single; override; - procedure SetPenMiterLimit(const AValue: single); override; - function GetCustomPenStyle: TBGRAPenStyle; override; - procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); override; - procedure SetPenStyle(const AValue: TPenStyle); override; - function GetPenStyle: TPenStyle; override; - - function GetArrowEndSize: TPointF; override; - function GetArrowStartSize: TPointF; override; - procedure SetArrowEndSize(AValue: TPointF); override; - procedure SetArrowStartSize(AValue: TPointF); override; - function GetArrowEndOffset: single; override; - function GetArrowStartOffset: single; override; - procedure SetArrowEndOffset(AValue: single); override; - procedure SetArrowStartOffset(AValue: single); override; - function GetArrowEndRepeat: integer; override; - function GetArrowStartRepeat: integer; override; - procedure SetArrowEndRepeat(AValue: integer); override; - procedure SetArrowStartRepeat(AValue: integer); override; - - protected //font accessors - function GetFontHeight: integer; override; - procedure SetFontHeight(AHeight: integer); override; - function GetFontFullHeight: integer; override; - procedure SetFontFullHeight(AHeight: integer); override; - function GetFontPixelMetric: TFontPixelMetric; override; - function CreateDefaultFontRenderer: TBGRACustomFontRenderer; virtual; abstract; - function GetFontVerticalAnchorOffset: single; override; - function GetFontAnchorRotatedOffset: TPointF; overload; - function GetFontAnchorRotatedOffset(ACustomOrientation: integer): TPointF; overload; - function GetFontRenderer: TBGRACustomFontRenderer; override; - procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); override; - - function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TBGRAPixel; - function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TBGRAPixel; - procedure InternalTextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); - procedure InternalTextOutLetterSpacing(x,y: single; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); - procedure InternalCrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); - - procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; - AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); override; - function InternalNew: TBGRADefaultBitmap; override; - - public - {** Provides a canvas with opacity and antialiasing } - property CanvasBGRA: TBGRACanvas read GetCanvasBGRA; - {** Provides a canvas with 2d transformation and similar to HTML5. } - property Canvas2D: TBGRACanvas2D read GetCanvas2D; - {** For more properties, see parent class [[TBGRACustomBitmap and IBGRAScanner#TBGRACustomBitmap|TBGRACustomBitmap]] } - - procedure SetSize(AWidth, AHeight: integer); override; - - {==== Constructors ====} - - {------------------------- Constructors from TBGRACustomBitmap-------------} - - {** Creates an image by copying the content of a ''TFPCustomImage'' } - constructor Create(AFPImage: TFPCustomImage); overload; override; - {** Creates an image by copying the content of a ''TBitmap'' } - constructor Create(ABitmap: TBitmap; AUseTransparent: boolean = true); overload; override; - - {** Creates an image by loading its content from the file ''AFilename''. - The encoding of the string is the default one for the operating system. - It is recommended to use the next constructor and UTF8 encoding } - constructor Create(AFilename: string); overload; override; - - {** Creates an image by loading its content from the file ''AFilename''. - The boolean ''AIsUtf8Filename'' specifies if UTF8 encoding is assumed - for the filename } - constructor Create(AFilename: string; AIsUtf8: boolean); overload; override; - constructor Create(AFilename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions); overload; override; - - {** Creates an image by loading its content from the stream ''AStream'' } - constructor Create(AStream: TStream); overload; override; - {** Free the object and all its resources } - destructor Destroy; override; - - {** Clear all channels of transparent pixels } - procedure ClearTransparentPixels; override; - - {------------------------- Quasi-constructors -----------------------------} - - {** Can only be called from an existing instance of ''TBGRABitmap''. - Creates a new instance with dimensions 0 x 0. } - function NewBitmap: TBGRADefaultBitmap; overload; override; - - {** Can only be called from an existing instance of ''TBGRABitmap''. - Creates a new instance with dimensions ''AWidth'' and ''AHeight'', - containing transparent pixels. } - function NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap; overload; override; - - {* Example: - - * var bmp1, bmp2: TBGRABitmap; - * begin - * bmp1 := TBGRABitmap.Create(100,100); - * bmp2 := bmp1.NewBitmap(100,100); - * ... - * end; - See tutorial 2 on [[BGRABitmap_tutorial_2|how to load and display an image]]. - * See reference on [[TBGRACustomBitmap_and_IBGRAScanner#Load_and_save_files|loading and saving files]] } - - {** Can only be called from an existing instance of ''TBGRABitmap''. - Creates a new instance with dimensions ''AWidth'' and ''AHeight'', - and fills it with Color } - function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRADefaultBitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRADefaultBitmap; overload; override; - - {** Can only be called from an existing instance of ''TBGRABitmap''. - Creates a new instance with by loading its content - from the file ''Filename''. The encoding of the string - is the default one for the operating system } - function NewBitmap(Filename: string): TBGRADefaultBitmap; overload; override; - - {** Can only be called from an existing instance of ''TBGRABitmap''. - Creates a new instance with by loading its content - from the file ''Filename'' } - function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRADefaultBitmap; overload; override; - function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRADefaultBitmap; overload; override; - - {** Can only be called from an existing instance of ''TBGRABitmap''. - Creates an image by copying the content of a ''TFPCustomImage'' } - function NewBitmap(AFPImage: TFPCustomImage): TBGRADefaultBitmap; overload; override; - - {** Assign the content of the specified ''Source''. It can be a ''TBGRACustomBitmap'' or - a ''TFPCustomImage'' } - procedure Assign(Source: TPersistent); overload; override; - procedure Assign(Source: TBitmap; AUseTransparent: boolean); overload; - - {** Stores the image in the stream without compression nor header } - procedure Serialize(AStream: TStream); override; - {** Reads the image in a stream that was previously serialized } - procedure Deserialize(AStream: TStream); override; - - // universal brushes - procedure SolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - - {==== Pixel functions ====} - {** Sets the pixel by replacing the content at (''x'',''y'') with the specified color. - Alpha value is set to 255 (opaque) } - procedure SetPixel(x, y: int32or64; c: TColor); overload; override; - {** Applies a logical '''xor''' to the content of the pixel with the specified value. - This includes the alpha channel, so if you want to preserve the opacity, provide - a color ''c'' with alpha channel equal to zero } - procedure XorPixel(x, y: int32or64; const c: TBGRAPixel); override; - {** Draws a pixel with gamma correction at (''x'',''y''). Pixel is supplied - in sRGB colorspace } - procedure DrawPixel(x, y: int32or64; const c: TBGRAPixel); overload; override; - {** Draws a pixel without gamma correction at (''x'',''y''). Pixel is supplied - in sRGB colorspace } - procedure FastBlendPixel(x, y: int32or64; const c: TBGRAPixel); override; - {** Erase the content of the pixel by reducing the value of the - alpha channel. ''alpha'' specifies how much to decrease. - If the resulting alpha reaches zero, the content - is replaced by ''BGRAPixelTransparent'' } - procedure ErasePixel(x, y: int32or64; alpha: byte); override; - {** Sets the alpha value at (''x'',''y''). If ''alpha'' = 0, the - pixel is replaced by ''BGRAPixelTransparent'' } - procedure AlphaPixel(x, y: int32or64; alpha: byte); override; - {** Computes the value of the pixel at a floating point coordiante - by interpolating the values of the pixels around it. - * There is a one pixel wide margin around the pixel where the pixels are - still considered inside. If ''smoothBorder'' is set to true, pixel fade - to transparent. - * If it is more out of the bounds, the result is ''BGRAPixelTransparent''. - * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted - values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' } - function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; overload; override; - {** Similar to previous ''GetPixel'' function, but the fractional part of - the coordinate is supplied with a number from 0 to 255. The actual - coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) } - function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; override; - {** Computes the value of the pixel at a floating point coordiante - by interpolating the values of the pixels around it. If the pixel - is out of bounds, the image is repeated. - * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted - values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' } - function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override; - {** Similar to previous ''GetPixel'' function, but the fractional part of - the coordinate is supplied with a number from 0 to 255. The actual - coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) } - function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override; - {** Computes the value of the pixel at a floating point coordiante - by interpolating the values of the pixels around it. ''repeatX'' and - ''repeatY'' specifies if the image is to be repeated or not. - * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted - values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' } - function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override; - {** Similar to previous ''GetPixel'' function, but the fractional part of - the coordinate is supplied with a number from 0 to 255. The actual - coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) } - function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override; - - {==== Drawing lines and polylines (integer coordinates) ====} - {* These functions do not take into account current pen style/cap/join. - See [[BGRABitmap tutorial 13|coordinate system]]. } - - {** Applies xor to the pixels at line ''y'' and - at columns ''x'' to ''x2'' included, using specified color. - This includes the alpha channel, so if you want to preserve the - opacity, provide a color ''c'' with alpha channel equal to zero } - procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override; - {** Draws an horizontal line with gamma correction at line ''y'' and - at columns ''x'' to ''x2'' included, using specified color } - procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); override; overload; - {** Draws an horizontal line without gamma correction at line ''y'' and - at columns ''x'' to ''x2'' included, using specified color } - procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override; - {** Replaces the alpha value of the pixels at line ''y'' and - at columns ''x'' to ''x2'' included } - procedure AlphaHorizLine(x, y, x2: int32or64; alpha: byte); override; - {** Draws an horizontal line with gamma correction at line ''y'' and - at columns ''x'' to ''x2'' included, using specified color, - and with a transparency that increases with the color difference - with ''compare''. If the difference is greater than ''maxDiff'', - pixels are not changed } - procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel; - maxDiff: byte); override; - procedure HorizLineDiff(x, y, x2: int32or64; const ABrush: TUniversalBrush; - ACompare: TBGRAPixel; AMaxDiffW: word); override; - - {** Xors a vertical line at column ''x'' and at row ''y'' to ''y2'' } - procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); override; - {** Draws a vertical line with gamma correction at column ''x'' and at row ''y'' to ''y2'' } - procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); override; - {** Draws a vertical line without gamma correction at column ''x'' and at row ''y'' to ''y2'' } - procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); override; - {** Replace alpha values in a vertical line at column ''x'' and at row ''y'' to ''y2'' } - procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); override; - - {** Fills completely a rectangle, without any border, with the specified ''texture'' and - with the specified ''mode'' } - procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; override; - - {==== Rectangles, ellipses and path (floating point coordinates) ====} - {* These functions use the current pen style/cap/join. The parameter ''w'' - specifies the width of the line and the base unit for dashes - * The coordinates are pixel-centered, so that when filling a rectangle, - if the supplied values are integers, the border will be half transparent. - If you want the border to be completely filled, you can subtract/add - 0.5 to the coordinates to include the remaining thin border. - See [[BGRABitmap tutorial 13|coordinate system]]. } - - {==== Multi-shape fill ====} - - {** Draws and fill a polyline using current pen style/cap/join in one go. - The stroke is stricly over the fill even if partially transparent. - ''fillcolor'' specifies a color to fill the polygon formed by the points } - procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override; - {** Draws a filled polygon using current pen style/cap/join in one go. - The stroke is stricly over the fill even if partially transparent. - The polygon is always closed. You don't need to set the last point - to be the same as the first point. } - procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override; - - {** Draws and fills an ellipse } - procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override; - procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override; - - {** Draws and fills a path } - procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override; - procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override; - procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override; - procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override; - - {** Draws and fills a path with a matrix transform } - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override; - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override; - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override; - procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override; - - {** Draws a rectangle with antialiasing and fills it with color ''back''. - Note that the pixel (x2,y2) is included contrary to integer coordinates } - procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override; - - {** Draws a rounded rectangle border with antialiasing. The corners have an - elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to - draw the corners. See [[BGRABitmap Geometry types|geometry types]] } - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); overload; override; - {** Draws a rounded rectangle border with the specified texture. - The corners have an elliptical radius of ''rx'' and ''ry''. - ''options'' specifies how to draw the corners. - See [[BGRABitmap Geometry types|geometry types]] } - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); overload; override; - {** Draws and fills a round rectangle } - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; override; - {** Draws and fills a round rectangle with textures } - procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); overload; override; - - {==== Gradient polygons ====} - - procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override; - procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override; - procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override; - procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override; - procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override; - - procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override; - procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override; - procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True; ACulling: TFaceCulling = fcNone; ACropToPolygon: boolean = true); override; - procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override; - procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACulling: TFaceCulling = fcNone); override; - procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override; - procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); override; - procedure FillQuadAffineMapping(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; ADrawMode: TDrawMode = dmDrawWithTransparency; AOpacity: byte = 255); override; - procedure FillQuadAffineMappingAntialias(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; AOpacity: byte = 255); override; - - {** Fills an ellipse with a gradient of color. ''outercolor'' specifies - the end color of the gradient on the border of the ellipse and - ''innercolor'' the end color of the gradient at the center of the ellipse } - procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); overload; override; - procedure FillEllipseLinearColorAntialias(AOrigin, AXAxis, AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); overload; override; - - procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override; - procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override; - procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override; - procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); override; - procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle = nil); override; - - procedure ArrowStartAsNone; override; - procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; - procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; - procedure ArrowStartAsTail; override; - - procedure ArrowEndAsNone; override; - procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override; - procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override; - procedure ArrowEndAsTail; override; - - { Draws the UTF8 encoded string, with color c. - If align is taLeftJustify, (x,y) is the top-left corner. - If align is taCenter, (x,y) is at the top and middle of the text. - If align is taRightJustify, (x,y) is the top-right corner. - The value of FontOrientation is taken into account, so that the text may be rotated. } - procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; - - { Same as above functions, except that the text is filled using texture. - The value of FontOrientation is taken into account, so that the text may be rotated. } - procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; - - procedure TextOut(x, y: single; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; override; - procedure TextOut(x, y: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; override; - - { Same as above, except that the orientation is specified, overriding the value of the property FontOrientation. } - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; - - procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; override; - procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; override; - - procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override; - procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override; - - { Draw the UTF8 encoded string at the coordinate (x,y), clipped inside the rectangle ARect. - Additional style information is provided by the style parameter. - The color c or texture is used to fill the text. No rotation is applied. } - procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; override; - procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; override; - - { Returns the total size of the string provided using the current font. - Orientation is not taken into account, so that the width is along the text. End of lines are stripped from the string. } - function TextSize(const sUTF8: string): TSize; override; - function TextSizeMultiline(const sUTF8: string; AMaxWidth: single = EmptySingle; AParagraphSpacing: single = 0): TSize; override; - - { Returns the affine box of the string provided using the current font. - Orientation is taken into account. End of lines are stripped from the string. } - function TextAffineBox(const sUTF8: string): TAffineBox; override; - - { Returns the total size of a paragraph i.e. with word break } - function TextSize(const sUTF8: string; AMaxWidth: integer): TSize; override; - function TextSize(const sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; override; - function TextFitInfo(const sUTF8: string; AMaxWidth: integer): integer; override; - - {Spline} - function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override; - function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override; - - function ComputeBezierCurve(const ACurve: TCubicBezierCurve): ArrayOfTPointF; overload; override; - function ComputeBezierCurve(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; overload; override; - function ComputeBezierSpline(const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; overload; override; - function ComputeBezierSpline(const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload; override; - - function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override; - function ComputeWidePolyline(const points: array of TPointF; w: single; ClosedCap: boolean): ArrayOfTPointF; overload; override; - function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override; - - function ComputeEllipseContour(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override; - function ComputeEllipseContour(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; override; - function ComputeEllipseBorder(x,y,rx,ry,w: single; quality: single = 1): ArrayOfTPointF; overload; override; - function ComputeEllipseBorder(AOrigin, AXAxis, AYAxis: TPointF; w: single; quality: single = 1): ArrayOfTPointF; override; overload; - function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override; - function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override; - function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override; - function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; override; - function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override; - function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override; - - {Filling} - procedure Fill(c: TBGRAPixel; start, Count: integer); overload; override; - procedure DrawPixels(c: TBGRAPixel; start, Count: integer); override; - procedure AlphaFill(alpha: byte; start, Count: integer); overload; override; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const AColor: TBGRAPixel; ADrawMode: TDrawMode); overload; override; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte); overload; override; - procedure EraseMask(x,y: integer; AMask: TBGRACustomBitmap; alpha: byte=255); override; - procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); override; - procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); override; - procedure ReplaceColor(before, after: TColor); overload; override; - procedure ReplaceColor(ABounds: TRect; before, after: TColor); overload; override; - procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; Color: TBGRAPixel; - mode: TFloodfillMode; Tolerance: byte = 0; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; override; - procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush; - Progressive: boolean; ToleranceW: Word = $00ff; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; override; - procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel; - gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - gammaColorCorrection: boolean = True; Sinus: Boolean=False; - ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override; - procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient; - gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - Sinus: Boolean=False; ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override; - - function ScanAtInteger(X,Y: integer): TBGRAPixel; override; - function ScanNextPixel: TBGRAPixel; override; - function ScanAt(X,Y: Single): TBGRAPixel; override; - function IsScanPutPixelsDefined: boolean; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - - {Canvas drawing functions} - procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); overload; override; - procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; override; - procedure InvalidateBitmap; override; //call if you modify with Scanline - procedure LoadFromBitmapIfNeeded; override; //call to ensure that bitmap data is up to date - procedure NotifyBitmapChange; inline; - - {BGRA bitmap functions} - procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); overload; override; - procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); overload; override; - procedure PutImage(X, Y: integer; ASource: TCustomUniversalBitmap; AMode: TDrawMode; AOpacity: byte); overload; override; - procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; override; - function GetImageAffineBounds(AMatrix: TAffineMatrix; ASourceBounds: TRect; AClipOutput: boolean = true; APixelCenteredCoords: boolean = true): TRect; overload; override; - class function IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; override; - - procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override; - procedure BlendRect(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AExcludeChannels: TChannels); overload; override; - procedure BlendRectOver(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; AExcludeChannels: TChannels); overload; override; - procedure BlendImage(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation); overload; override; - procedure BlendImage(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation); overload; override; - procedure BlendImageOver(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; override; - procedure BlendImageOver(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; override; - - function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; override; - function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; override; - - function Resample(newWidth, newHeight: integer; - mode: TResampleMode = rmFineResample): TBGRADefaultBitmap; override; - procedure Negative; override; - procedure NegativeRect(ABounds: TRect); override; - procedure LinearNegative; override; - procedure LinearNegativeRect(ABounds: TRect); override; - procedure InplaceGrayscale(AGammaCorrection: boolean = true); overload; override; - procedure InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); overload; override; - procedure InplaceNormalize(AEachChannel: boolean = True); overload; override; - procedure InplaceNormalize(ABounds: TRect; AEachChannel: boolean = True); overload; override; - procedure SwapRedBlue; override; - procedure SwapRedBlue(ARect: TRect); override; - procedure GrayscaleToAlpha; override; - procedure AlphaToGrayscale; override; - function GetMaskFromAlpha: TBGRADefaultBitmap; override; - function GetGrayscaleMaskFromAlpha: TGrayscaleMask; - procedure ConvertToLinearRGB; override; - procedure ConvertFromLinearRGB; override; - - {Filters} - function FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap; override; - function FilterMedian(Option: TMedianOption): TBGRADefaultBitmap; override; - function FilterSmooth: TBGRADefaultBitmap; override; - function FilterSharpen(Amount: single = 1): TBGRADefaultBitmap; overload; override; - function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRADefaultBitmap; overload; override; - function FilterContour(AGammaCorrection: boolean = false): TBGRADefaultBitmap; override; - function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRADefaultBitmap; override; - function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRADefaultBitmap; overload; override; - function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRADefaultBitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean): TBGRADefaultBitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRADefaultBitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRADefaultBitmap; overload; override; - function FilterGrayscale: TBGRADefaultBitmap; overload; override; - function FilterGrayscale(ABounds: TRect): TBGRADefaultBitmap; overload; override; - function FilterNormalize(eachChannel: boolean = True): TBGRADefaultBitmap; overload; override; - function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRADefaultBitmap; overload; override; - function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRADefaultBitmap; override; - function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRADefaultBitmap; override; - function FilterSphere: TBGRADefaultBitmap; override; - function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; overload; override; - function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; overload; override; - function FilterCylinder: TBGRADefaultBitmap; override; - function FilterPlane: TBGRADefaultBitmap; override; - end; - - { TBGRAPtrBitmap } - - TBGRAPtrBitmap = class(TBGRADefaultBitmap) - protected - function GetLineOrder: TRawImageLineOrder; override; - procedure SetLineOrder(AValue: TRawImageLineOrder); override; - procedure ReallocData; override; - procedure FreeData; override; - procedure CannotResize; - procedure NotImplemented; - procedure RebuildBitmap; override; - - function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; //to override - function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte; - {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean - =True): boolean; override; //to override - public - constructor Create(AWidth, AHeight: integer; AData: Pointer); overload; - procedure SetDataPtr(AData: Pointer); - property LineOrder: TRawImageLineOrder Read GetLineOrder Write SetLineOrder; - - procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; - {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override - procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; - {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override - procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //to override - - procedure Assign({%H-}Source: TPersistent); override; - procedure TakeScreenshot({%H-}ARect: TRect); override; - procedure TakeScreenshotOfPrimaryMonitor; override; - procedure LoadFromDevice({%H-}DC: HDC); override; - procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; - end; - - { TBGRAMemoryStreamBitmap } - - TBGRAMemoryStreamBitmap = class(TBGRAPtrBitmap) - private - function GetOwnStream: boolean; - procedure SetOwnStream(AValue: boolean); - protected - FStream: TMemoryStream; - FStreamOffset: IntPtr; - FOwnStream: boolean; - public - constructor Create(AWidth, AHeight: integer; AStream: TMemoryStream; AStreamOffset: IntPtr; AOwnStream: boolean); - constructor Create(AWidth, AHeight: integer); override; - constructor Create(AWidth, AHeight: integer; AColor: TBGRAPixel); - destructor Destroy; override; - property OwnStream: boolean read GetOwnStream write SetOwnStream; - property Stream: TMemoryStream read FStream; - end; - -var - DefaultTextStyle: TTextStyle; - -procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer; - c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - gammaColorCorrection: boolean = True; Sinus: Boolean=False); - -implementation - -uses Math, BGRAUTF8, BGRABlend, BGRAFilters, BGRAGradientScanner, - BGRAResample, BGRAPolygon, BGRAPolygonAliased, - BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM, - BGRAReadBMP, BGRAReadJpeg, - BGRADithering, BGRAFilterScanner; - -{ TBGRAMemoryStreamBitmap } - -function TBGRAMemoryStreamBitmap.GetOwnStream: boolean; -begin - result := FOwnStream; -end; - -procedure TBGRAMemoryStreamBitmap.SetOwnStream(AValue: boolean); -begin - FOwnStream:= AValue; -end; - -constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer; - AStream: TMemoryStream; AStreamOffset: IntPtr; AOwnStream: boolean); -begin - inherited Create(AWidth, AHeight, PByte(AStream.Memory) + AStreamOffset); - FStream := AStream; - FStreamOffset:= AStreamOffset; - FOwnStream := AOwnStream; -end; - -constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer); -begin - Create(AWidth, AHeight, BGRAPixelTransparent); -end; - -constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer; - AColor: TBGRAPixel); -begin - inherited Create(AWidth, AHeight); - FStream := TMemoryStream.Create; - FStreamOffset:= 0; - FStream.Size := RowSize * Height; - FOwnStream := true; - SetDataPtr(PByte(FStream.Memory) + FStreamOffset); - Fill(AColor, dmSet); -end; - -destructor TBGRAMemoryStreamBitmap.Destroy; -begin - if FOwnStream then FStream.Free; - inherited Destroy; -end; - -{ TBGRADefaultBitmap } - -function TBGRADefaultBitmap.CheckEmpty: boolean; -const - alphaMask = $ff shl TBGRAPixel_AlphaShift; -var - i: integer; - p: PBGRAPixel; -begin - p := Data; - for i := (NbPixels shr 1) - 1 downto 0 do - begin - if PInt64(p)^ and (alphaMask or (alphaMask shl 32)) <> 0 then - begin - Result := False; - exit; - end; - Inc(p,2); - end; - if Odd(NbPixels) and (p^.alpha <> 0) then - begin - Result := false; - exit; - end; - Result := True; -end; - -function TBGRADefaultBitmap.GetCanvasAlphaCorrection: boolean; -begin - Result := (FCanvasOpacity <> 0); -end; - -function TBGRADefaultBitmap.GetCustomPenStyle: TBGRAPenStyle; -begin - result := GetInternalPen.CustomPenStyle; -end; - -procedure TBGRADefaultBitmap.SetCanvasAlphaCorrection(const AValue: boolean); -begin - if AValue then - begin - if FCanvasOpacity = 0 then - FCanvasOpacity := 255; - end - else - FCanvasOpacity := 0; -end; - -procedure TBGRADefaultBitmap.DoLoadFromBitmap; -begin - //nothing -end; - -procedure TBGRADefaultBitmap.SetCustomPenStyle(const AValue: TBGRAPenStyle); -begin - GetInternalPen.CustomPenStyle := AValue; -end; - -procedure TBGRADefaultBitmap.SetPenStyle(const AValue: TPenStyle); -begin - GetInternalPen.Style := AValue; -end; - -function TBGRADefaultBitmap.GetPenStyle: TPenStyle; -begin - Result:= GetInternalPen.Style; -end; - -function TBGRADefaultBitmap.GetArrowEndSize: TPointF; -begin - result := GetArrow.EndSize; -end; - -function TBGRADefaultBitmap.GetArrowStartSize: TPointF; -begin - result := GetArrow.StartSize; -end; - -procedure TBGRADefaultBitmap.SetArrowEndSize(AValue: TPointF); -begin - {$PUSH}{$OPTIMIZATION OFF} - GetArrow.EndSize := AValue; - {$POP} -end; - -procedure TBGRADefaultBitmap.SetArrowStartSize(AValue: TPointF); -begin - {$PUSH}{$OPTIMIZATION OFF} - GetArrow.StartSize := AValue; - {$POP} -end; - -function TBGRADefaultBitmap.GetArrowEndOffset: single; -begin - result := GetArrow.EndOffsetX; -end; - -function TBGRADefaultBitmap.GetArrowStartOffset: single; -begin - result := GetArrow.StartOffsetX; -end; - -procedure TBGRADefaultBitmap.SetArrowEndOffset(AValue: single); -begin - GetArrow.EndOffsetX := AValue; -end; - -procedure TBGRADefaultBitmap.SetArrowStartOffset(AValue: single); -begin - GetArrow.StartOffsetX := AValue; -end; - -function TBGRADefaultBitmap.GetArrowEndRepeat: integer; -begin - result := GetArrow.EndRepeatCount; -end; - -function TBGRADefaultBitmap.GetArrowStartRepeat: integer; -begin - result := GetArrow.StartRepeatCount; -end; - -procedure TBGRADefaultBitmap.SetArrowEndRepeat(AValue: integer); -begin - GetArrow.EndRepeatCount := AValue; -end; - -procedure TBGRADefaultBitmap.SetArrowStartRepeat(AValue: integer); -begin - GetArrow.StartRepeatCount := AValue; -end; - -procedure TBGRADefaultBitmap.SetFontHeight(AHeight: integer); -begin - FFontHeight := AHeight; -end; - -function TBGRADefaultBitmap.GetFontFullHeight: integer; -begin - if FontHeight < 0 then - result := -FontHeight - else - result := TextSize('Hg').cy; -end; - -procedure TBGRADefaultBitmap.SetFontFullHeight(AHeight: integer); -begin - if AHeight > 0 then - FontHeight := -AHeight - else - FontHeight := 1; -end; - -function TBGRADefaultBitmap.GetFontPixelMetric: TFontPixelMetric; -begin - result := FontRenderer.GetFontPixelMetric; -end; - -function TBGRADefaultBitmap.GetFontRenderer: TBGRACustomFontRenderer; -begin - if FFontRenderer = nil then FFontRenderer := CreateDefaultFontRenderer; - if FFontRenderer = nil then raise exception.Create('No font renderer'); - result := FFontRenderer; - result.FontName := FontName; - result.FontStyle := FontStyle; - result.FontQuality := FontQuality; - result.FontOrientation := FontOrientation; - result.FontEmHeight := FFontHeight; -end; - -procedure TBGRADefaultBitmap.SetFontRenderer(AValue: TBGRACustomFontRenderer); -begin - if AValue = FFontRenderer then exit; - FFontRenderer.Free; - FFontRenderer := AValue -end; - -function TBGRADefaultBitmap.GetFontVerticalAnchorOffset: single; -begin - case FontVerticalAnchor of - fvaTop: result := 0; - fvaCenter: result := FontFullHeight*0.5; - fvaCapLine: result := FontPixelMetric.CapLine; - fvaCapCenter: result := (FontPixelMetric.CapLine+FontPixelMetric.Baseline)*0.5; - fvaXLine: result := FontPixelMetric.xLine; - fvaXCenter: result := (FontPixelMetric.xLine+FontPixelMetric.Baseline)*0.5; - fvaBaseline: result := FontPixelMetric.Baseline; - fvaDescentLine: result := FontPixelMetric.DescentLine; - fvaBottom: result := FontFullHeight; - else - result := 0; - end; -end; - -function TBGRADefaultBitmap.GetFontAnchorRotatedOffset: TPointF; -begin - result := GetFontAnchorRotatedOffset(FontOrientation); -end; - -function TBGRADefaultBitmap.GetFontAnchorRotatedOffset( - ACustomOrientation: integer): TPointF; -begin - result := PointF(0, GetFontVerticalAnchorOffset); - if ACustomOrientation <> 0 then - result := AffineMatrixRotationDeg(-ACustomOrientation*0.1)*result; -end; - -{ Creates a new bitmap with dimensions 0 x 0 } -function TBGRADefaultBitmap.NewBitmap: TBGRADefaultBitmap; -begin - Result := inherited NewBitmap as TBGRADefaultBitmap; -end; - -{ Creates a new bitmap with dimensions AWidth and AHeight and filled with - transparent pixels. Internally, it uses the same type so that if you - use an optimized version, you get a new bitmap with the same optimizations } -function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap; -begin - result := inherited NewBitmap(AWidth, AHeight) as TBGRADefaultBitmap; -end; - -{ Can only be called from an existing instance of TBGRABitmap. - Creates a new instance with dimensions AWidth and AHeight, - and fills it with Color. } -function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer; - const Color: TBGRAPixel): TBGRADefaultBitmap; -begin - result := inherited NewBitmap(AWidth, AHeight, Color) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRADefaultBitmap; -begin - result := inherited NewBitmap(AWidth, AHeight, AColor) as TBGRADefaultBitmap; -end; - -{ Creates a new bitmap and loads it contents from a file. - The encoding of the string is the default one for the operating system. - It is recommended to use the next function and UTF8 encoding } -function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRADefaultBitmap; -var - BGRAClass: TBGRABitmapAny; -begin - BGRAClass := TBGRABitmapAny(self.ClassType); - Result := BGRAClass.Create(Filename) as TBGRADefaultBitmap; -end; - -{ Creates a new bitmap and loads it contents from a file. - It is recommended to use UTF8 encoding } -function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRADefaultBitmap; -var - BGRAClass: TBGRABitmapAny; -begin - BGRAClass := TBGRABitmapAny(self.ClassType); - Result := BGRAClass.Create(Filename,AIsUtf8) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean; - AOptions: TBGRALoadingOptions): TBGRADefaultBitmap; -var - BGRAClass: TBGRABitmapAny; -begin - BGRAClass := TBGRABitmapAny(self.ClassType); - Result := BGRAClass.Create(Filename,AIsUtf8,AOptions) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRADefaultBitmap; -var - BGRAClass: TBGRABitmapAny; -begin - BGRAClass := TBGRABitmapAny(self.ClassType); - Result := BGRAClass.Create(AFPImage) as TBGRADefaultBitmap; -end; - -{----------------------- TFPCustomImage override ------------------------------} - -{ Set the size of the current bitmap. All data is lost during the process } -procedure TBGRADefaultBitmap.SetSize(AWidth, AHeight: integer); -begin - if (Width <> AWidth) or (Height <> AHeight) then - begin - inherited SetSize(AWidth, AHeight); - FreeBitmap; - end; -end; - -{---------------------- Constructors ---------------------------------} - -constructor TBGRADefaultBitmap.Create(AFPImage: TFPCustomImage); -begin - inherited Create; - Assign(AFPImage); -end; - -{ Creates an image of dimensions AWidth and AHeight and filled with transparent pixels. } -constructor TBGRADefaultBitmap.Create(ABitmap: TBitmap; AUseTransparent: boolean); -begin - inherited Create; - Assign(ABitmap, AUseTransparent); -end; - -{ Creates an image by loading its content from the file AFilename. - The encoding of the string is the default one for the operating system. - It is recommended to use the next constructor and UTF8 encoding. } -constructor TBGRADefaultBitmap.Create(AFilename: string); -begin - inherited Create; - LoadFromFile(Afilename); -end; - -{ Free the object and all its resources } -destructor TBGRADefaultBitmap.Destroy; -begin - DiscardXorMask; - FFontRenderer.Free; - {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP.Free;{$ENDIF} - FCanvasBGRA.Free; - FCanvas2D.Free; - FreeBitmap; - inherited Destroy; -end; - -{------------------------- Loading functions ----------------------------------} - -{ Creates an image by loading its content from the file AFilename. - The boolean AIsUtf8Filename specifies if UTF8 encoding is assumed for the filename. } -constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean); -begin - inherited Create; - if AIsUtf8 then - LoadFromFileUTF8(Afilename) - else - LoadFromFile(Afilename); -end; - -constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean; - AOptions: TBGRALoadingOptions); -begin - inherited Create; - if AIsUtf8 then - LoadFromFileUTF8(Afilename, AOptions) - else - LoadFromFile(Afilename, AOptions); -end; - -{ Creates an image by loading its content from the stream AStream. } -constructor TBGRADefaultBitmap.Create(AStream: TStream); -begin - inherited Create; - LoadFromStream(AStream); -end; - -procedure TBGRADefaultBitmap.Serialize(AStream: TStream); -begin - If TBGRAPixel_RGBAOrder then - begin - LoadFromBitmapIfNeeded; - TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False); - end; - inherited Serialize(AStream); - If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False); -end; - -procedure TBGRADefaultBitmap.Deserialize(AStream: TStream); -begin - inherited Deserialize(AStream); - If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.SolidBrushIndirect(out - ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode); -begin - BGRASolidBrushIndirect(ABrush, AColor, ADrawMode); -end; - -class procedure TBGRADefaultBitmap.SolidBrush(out ABrush: TUniversalBrush; - const AColor: TBGRAPixel; ADrawMode: TDrawMode); -begin - BGRASolidBrushIndirect(ABrush, @AColor, ADrawMode); -end; - -class procedure TBGRADefaultBitmap.ScannerBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; ADrawMode: TDrawMode; - AOffsetX: integer; AOffsetY: integer); -begin - BGRAScannerBrush(ABrush, AScanner, ADrawMode, AOffsetX, AOffsetY); -end; - -class procedure TBGRADefaultBitmap.MaskBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); -begin - BGRAMaskBrush(ABrush, AScanner, AOffsetX, AOffsetY); -end; - -class procedure TBGRADefaultBitmap.EraseBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - BGRAEraseBrush(ABrush, AAlpha); -end; - -class procedure TBGRADefaultBitmap.AlphaBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - BGRAAlphaBrush(ABrush, AAlpha); -end; - -procedure TBGRADefaultBitmap.Assign(Source: TPersistent); -var pdest: PBGRAPixel; - x,y: Int32or64; -begin - if Source is TBGRACustomBitmap then - begin - DiscardBitmapChange; - SetSize(TBGRACustomBitmap(Source).Width, TBGRACustomBitmap(Source).Height); - PutImage(0, 0, TBGRACustomBitmap(Source), dmSet); - if Source is TBGRADefaultBitmap then - begin - HotSpot := TBGRADefaultBitmap(Source).HotSpot; - if XorMask <> TBGRADefaultBitmap(Source).XorMask then - begin - DiscardXorMask; - if TBGRADefaultBitmap(Source).XorMask is TBGRADefaultBitmap then - FXorMask := TBGRADefaultBitmap(TBGRADefaultBitmap(Source).XorMask).NewReference as TBGRADefaultBitmap - else - FXorMask := TBGRADefaultBitmap(Source).XorMask.Duplicate; - end; - end; - end else - if Source is TFPCustomImage then - begin - DiscardBitmapChange; - SetSize(TFPCustomImage(Source).Width, TFPCustomImage(Source).Height); - for y := 0 to TFPCustomImage(Source).Height-1 do - begin - pdest := ScanLine[y]; - for x := 0 to TFPCustomImage(Source).Width-1 do - begin - pdest^ := FPColorToBGRA(TFPCustomImage(Source).Colors[x,y]); - inc(pdest); - end; - end; - end else - inherited Assign(Source); -end; - -procedure TBGRADefaultBitmap.Assign(Source: TBitmap; AUseTransparent: boolean); -var - transpColor: TBGRAPixel; -begin - Assign(Source); - if AUseTransparent and TBitmap(Source).Transparent then - begin - if TBitmap(Source).TransparentMode = tmFixed then - transpColor := ColorToBGRA(TBitmap(Source).TransparentColor) - else - transpColor := GetPixel(0,Height-1); - ReplaceColor(transpColor, BGRAPixelTransparent); - end; -end; - -{------------------------- Clipping -------------------------------} - -function TBGRADefaultBitmap.InternalGetPixelCycle256(ix, iy: int32or64; iFactX, - iFactY: int32or64): TBGRAPixel; -var - ixMod2: int32or64; - pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel; - scan: PBGRAPixel; -begin - scan := GetScanlineFast(iy); - - pUpLeft := (scan + ix); - ixMod2 := ix+1; - if ixMod2=Width then ixMod2 := 0; - pUpRight := (scan + ixMod2); - - Inc(iy); - if iy = Height then iy := 0; - scan := GetScanlineFast(iy); - pDownLeft := (scan + ix); - pDownRight := (scan + ixMod2); - - InterpolateBilinear(pUpLeft, pUpRight, pDownLeft, - pDownRight, iFactX, iFactY, @result); -end; - -function TBGRADefaultBitmap.InternalGetPixel256(ix, iy: int32or64; iFactX, - iFactY: int32or64; smoothBorder: boolean): TBGRAPixel; -var - pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel; - scan: PBGRAPixel; -begin - if (iy >= 0) and (iy < FHeight) then - begin - scan := GetScanlineFast(iy); - - if (ix >= 0) and (ix < FWidth) then - pUpLeft := scan+ix - else if smoothBorder then - pUpLeft := @BGRAPixelTransparent - else - pUpLeft := nil; - - if (ix+1 >= 0) and (ix+1 < FWidth) then - pUpRight := scan+(ix+1) - else if smoothBorder then - pUpRight := @BGRAPixelTransparent - else - pUpRight := nil; - end else - if smoothBorder then - begin - pUpLeft := @BGRAPixelTransparent; - pUpRight := @BGRAPixelTransparent; - end else - begin - pUpLeft := nil; - pUpRight := nil; - end; - - if (iy+1 >= 0) and (iy+1 < FHeight) then - begin - scan := GetScanlineFast(iy+1); - - if (ix >= 0) and (ix < FWidth) then - pDownLeft := scan+ix - else if smoothBorder then - pDownLeft := @BGRAPixelTransparent - else - pDownLeft := nil; - - if (ix+1 >= 0) and (ix+1 < FWidth) then - pDownRight := scan+(ix+1) - else if smoothBorder then - pDownRight := @BGRAPixelTransparent - else - pDownRight := nil; - end else - if smoothBorder then - begin - pDownLeft := @BGRAPixelTransparent; - pDownRight := @BGRAPixelTransparent; - end else - begin - pDownLeft := nil; - pDownRight := nil; - end; - - InterpolateBilinear(pUpLeft, pUpRight, pDownLeft, - pDownRight, iFactX, iFactY, @result); -end; - -{-------------------------- Pixel functions -----------------------------------} - -procedure TBGRADefaultBitmap.XorPixel(x, y: int32or64; const c: TBGRAPixel); -var - p : PLongWord; -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - p := PLongWord(GetScanlineFast(y) +x); - p^ := p^ xor LongWord(c); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TColor); -var - p: PBGRAPixel; -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - p := GetScanlineFast(y) + x; - RedGreenBlue(c, p^.red,p^.green,p^.blue); - p^.alpha := 255; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.DrawPixel(x, y: int32or64; const c: TBGRAPixel); -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - DrawPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, c); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.FastBlendPixel(x, y: int32or64; const c: TBGRAPixel); -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - FastBlendPixelInline(GetScanlineFast(y) + x, c); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.ErasePixel(x, y: int32or64; alpha: byte); -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - ErasePixelInline(GetScanlineFast(y) + x, alpha); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.AlphaPixel(x, y: int32or64; alpha: byte); -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - if alpha = 0 then - (GetScanlineFast(y) +x)^ := BGRAPixelTransparent - else - (GetScanlineFast(y) +x)^.alpha := alpha; - InvalidateBitmap; -end; - -function TBGRADefaultBitmap.GetPixel256(x, y, fracX256, fracY256: int32or64; - AResampleFilter: TResampleFilter; smoothBorder: boolean = true): TBGRAPixel; -begin - if (fracX256 = 0) and (fracY256 = 0) then - result := GetPixel(x,y) - else if AResampleFilter = rfBox then - begin - if fracX256 >= 128 then inc(x); - if fracY256 >= 128 then inc(y); - result := GetPixel(x,y); - end else - begin - LoadFromBitmapIfNeeded; - result := InternalGetPixel256(x,y,FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter),smoothBorder); - end; -end; - -{$hints off} -{ This function compute an interpolated pixel at floating point coordinates } -function TBGRADefaultBitmap.GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; -var - ix, iy: Int32or64; - iFactX,iFactY: Int32or64; -begin - ix := round(x*256); - if (ix<= -256) or (ix>=Width shl 8) then - begin - result := BGRAPixelTransparent; - exit; - end; - iy := round(y*256); - if (iy<= -256) or (iy>=Height shl 8) then - begin - result := BGRAPixelTransparent; - exit; - end; - - iFactX := ix and 255; //distance from integer coordinate - iFactY := iy and 255; - if ix<0 then ix := -1 else ix := ix shr 8; - if iy<0 then iy := -1 else iy := iy shr 8; - - //if the coordinate is integer, then call standard GetPixel function - if (iFactX = 0) and (iFactY = 0) then - begin - Result := (GetScanlineFast(iy)+ix)^; - exit; - end; - - LoadFromBitmapIfNeeded; - result := InternalGetPixel256(ix,iy,FineInterpolation256(iFactX,AResampleFilter),FineInterpolation256(iFactY,AResampleFilter),smoothBorder); -end; - -{ Same as GetPixel(single,single,TResampleFilter) but with coordinate cycle, supposing the image repeats itself in both directions } -function TBGRADefaultBitmap.GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; -var - ix, iy: Int32or64; - iFactX,iFactY: Int32or64; -begin - if FNbPixels = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - LoadFromBitmapIfNeeded; - ix := round(x*256); - iy := round(y*256); - iFactX := ix and 255; - iFactY := iy and 255; - ix := PositiveMod(ix, FWidth shl 8) shr 8; - iy := PositiveMod(iy, FHeight shl 8) shr 8; - if (iFactX = 0) and (iFactY = 0) then - begin - result := (GetScanlineFast(iy)+ix)^; - exit; - end; - if ScanInterpolationFilter <> rfLinear then - begin - iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter ); - iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter ); - end; - result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY); -end; - -function TBGRADefaultBitmap.GetPixelCycle(x, y: single; - AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean - ): TBGRAPixel; -var - ix, iy: Int32or64; - iFactX,iFactY: Int32or64; -begin - if FNbPixels = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - ix := round(x*256); - iy := round(y*256); - iFactX := ix and 255; - iFactY := iy and 255; - if ix < 0 then ix := -((iFactX-ix) shr 8) - else ix := ix shr 8; - if iy < 0 then iy := -((iFactY-iy) shr 8) - else iy := iy shr 8; - result := GetPixelCycle256(ix,iy,iFactX,iFactY,AResampleFilter,repeatX,repeatY); -end; - -function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256, - fracY256: int32or64; AResampleFilter: TResampleFilter): TBGRAPixel; -begin - if (fracX256 = 0) and (fracY256 = 0) then - result := GetPixelCycle(x,y) - else if AResampleFilter = rfBox then - begin - if fracX256 >= 128 then inc(x); - if fracY256 >= 128 then inc(y); - result := GetPixelCycle(x,y); - end else - begin - LoadFromBitmapIfNeeded; - result := InternalGetPixelCycle256(PositiveMod(x,FWidth),PositiveMod(y,FHeight),FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter)); - end; -end; - -function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256, - fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; - repeatY: boolean): TBGRAPixel; -begin - if not repeatX and not repeatY then - result := GetPixel256(x,y,fracX256,fracY256,AResampleFilter) - else if repeatX and repeatY then - result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter) - else - begin - if not repeatX then - begin - if x < 0 then - begin - if x < -1 then - begin - result := BGRAPixelTransparent; - exit; - end; - result := GetPixelCycle256(0,y,0,fracY256,AResampleFilter); - result.alpha:= result.alpha*fracX256 shr 8; - if result.alpha = 0 then - result := BGRAPixelTransparent; - exit; - end; - if x >= FWidth-1 then - begin - if x >= FWidth then - begin - result := BGRAPixelTransparent; - exit; - end; - result := GetPixelCycle256(FWidth-1,y,0,fracY256,AResampleFilter); - result.alpha:= result.alpha*(256-fracX256) shr 8; - if result.alpha = 0 then - result := BGRAPixelTransparent; - exit; - end; - end else - begin - if y < 0 then - begin - if y < -1 then - begin - result := BGRAPixelTransparent; - exit; - end; - result := GetPixelCycle256(x,0,fracX256,0,AResampleFilter); - result.alpha:= result.alpha*fracY256 shr 8; - if result.alpha = 0 then - result := BGRAPixelTransparent; - exit; - end; - if y >= FHeight-1 then - begin - if y >= FHeight then - begin - result := BGRAPixelTransparent; - exit; - end; - result := GetPixelCycle256(x,FHeight-1,fracX256,0,AResampleFilter); - result.alpha:= result.alpha*(256-fracY256) shr 8; - if result.alpha = 0 then - result := BGRAPixelTransparent; - exit; - end; - end; - result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter); - end; -end; - -{$hints on} - -procedure TBGRADefaultBitmap.InvalidateBitmap; -begin - FDataModified := True; -end; - -function TBGRADefaultBitmap.GetBitmap: TBitmap; -begin - if FAlphaCorrectionNeeded then - begin - if CanvasAlphaCorrection then - LoadFromBitmapIfNeeded - else - FAlphaCorrectionNeeded := false; - end; - if FDataModified or (FBitmap = nil) then - begin - RebuildBitmap; - FBitmapModified := false; - FAlphaCorrectionNeeded:= false; - FDataModified := False; - end; - Result := FBitmap; -end; - -function TBGRADefaultBitmap.GetCanvas: TCanvas; -begin - if FDataModified or (FBitmap = nil) then - begin - RebuildBitmap; - FBitmapModified := false; - FAlphaCorrectionNeeded:= false; - FDataModified := False; - end; - Result := FBitmap.Canvas; -end; - -{$IFDEF BGRABITMAP_USE_FPCANVAS}function TBGRADefaultBitmap.GetCanvasFP: TFPImageCanvas; -begin - {$warnings off} - if FCanvasFP = nil then - FCanvasFP := TFPImageCanvas.Create(self); - {$warnings on} - result := FCanvasFP; -end;{$ENDIF} - -procedure TBGRADefaultBitmap.SetCanvasDrawModeFP(const AValue: TDrawMode); -begin - FCanvasDrawModeFP := AValue; - Case AValue of - dmLinearBlend: FCanvasPixelProcFP := @FastBlendPixel; - dmDrawWithTransparency: FCanvasPixelProcFP := @DrawPixel; - dmXor: FCanvasPixelProcFP:= @XorPixel; - else FCanvasPixelProcFP := @SetPixel; - end; -end; - -function TBGRADefaultBitmap.GetCanvasDrawModeFP: TDrawMode; -begin - Result:= FCanvasDrawModeFP; -end; - -procedure TBGRADefaultBitmap.LoadFromBitmapIfNeeded; -begin - if FBitmapModified then - begin - DoLoadFromBitmap; - DiscardBitmapChange; - end; - if FAlphaCorrectionNeeded then - begin - DoAlphaCorrection; - end; -end; - -procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); -begin - if AFadePosition = 0 then - FillRect(ARect, Source1, mode) else - if AFadePosition = 255 then - FillRect(ARect, Source2, mode) else - InternalCrossFade(ARect, Source1,Source2, AFadePosition,nil, mode); -end; - -procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); -begin - InternalCrossFade(ARect, Source1,Source2, 0,AFadeMask, mode); -end; - -procedure TBGRADefaultBitmap.DiscardBitmapChange; inline; -begin - FBitmapModified := False; -end; - -procedure TBGRADefaultBitmap.NotifyBitmapChange; -begin - FBitmapModified := True; - FAlphaCorrectionNeeded := true; -end; - -{ Initialize properties } -procedure TBGRADefaultBitmap.Init; -begin - inherited Init; - FBitmap := nil; - {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP := nil;{$ENDIF} - FCanvasBGRA := nil; - CanvasDrawModeFP := dmDrawWithTransparency; - FCanvasOpacity := 255; - FAlphaCorrectionNeeded := False; - - FontName := 'Arial'; - FontStyle := []; - FontAntialias := False; - FontVerticalAnchor:= fvaTop; - FFontHeight := 20; - - ResampleFilter := rfHalfCosine; - ScanInterpolationFilter := rfLinear; -end; - -procedure TBGRADefaultBitmap.SetInternalColor(x, y: integer; const Value: TFPColor); -begin - FCanvasPixelProcFP(x,y, FPColorToBGRA(Value)); -end; - -function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor; -begin - if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then - result := colTransparent - else - begin - LoadFromBitmapIfNeeded; - result := BGRAToFPColor((Scanline[y] + x)^); - end; -end; - -procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer); -var - c: TFPColor; -begin - if not PtInClipRect(x,y) then exit; - c := Palette.Color[Value]; - (Scanline[y] + x)^ := FPColorToBGRA(c); - InvalidateBitmap; -end; - -function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer; -var - c: TFPColor; -begin - if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then - result := 0 - else - begin - LoadFromBitmapIfNeeded; - c := BGRAToFPColor((Scanline[y] + x)^); - Result := palette.IndexOf(c); - end; -end; - -procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); -begin - if (self = nil) or (Width = 0) or (Height = 0) then exit; - if Opaque then - DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data, - FLineOrder, FWidth, FHeight) - else - begin - LoadFromBitmapIfNeeded; - if Empty then - exit; - ACanvas.Draw(X, Y, Bitmap); - end; -end; - -procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); -begin - if (self = nil) or (Width = 0) or (Height = 0) then exit; - if Opaque then - DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight) - else - begin - LoadFromBitmapIfNeeded; - ACanvas.StretchDraw(Rect, Bitmap); - end; -end; - -{---------------------------- Line primitives ---------------------------------} - -procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); -begin - if not CheckHorizLineBounds(x,y,x2) then exit; - XorInline(scanline[y] + x, c, x2 - x + 1); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel - ); -begin - if not CheckHorizLineBounds(x,y,x2) then exit; - DrawExpandedPixelsInline(scanline[y] + x, ec, x2 - x + 1); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); -begin - if not CheckHorizLineBounds(x,y,x2) then exit; - FastBlendPixelsInline(scanline[y] + x, c, x2 - x + 1); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: int32or64; alpha: byte); -begin - if alpha = 0 then - begin - SetHorizLine(x, y, x2, BGRAPixelTransparent); - exit; - end; - if not CheckHorizLineBounds(x,y,x2) then exit; - AlphaFillInline(scanline[y] + x, alpha, x2 - x + 1); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); -var - n, delta: int32or64; - p: PBGRAPixel; -begin - if not CheckVertLineBounds(x,y,y2) then exit; - if LineOrder = riloTopToBottom then delta := Width else delta := -Width; - p := scanline[y] + x; - for n := y2 - y downto 0 do - begin - PLongWord(p)^ := PLongWord(p)^ xor LongWord(c); - Inc(p, delta); - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); -var - n, delta: int32or64; - p: PBGRAPixel; -begin - if c.alpha = 255 then - begin - SetVertLine(x,y,y2,c); - exit; - end; - if not CheckVertLineBounds(x,y,y2) or (c.alpha=0) then exit; - p := scanline[y] + x; - if LineOrder = riloTopToBottom then delta := Width else delta := -Width; - for n := y2 - y downto 0 do - begin - DrawPixelInlineNoAlphaCheck(p, c); - Inc(p, delta); - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: int32or64; alpha: byte); -var - n, delta: int32or64; - p: PBGRAPixel; -begin - if alpha = 0 then - begin - SetVertLine(x, y, y2, BGRAPixelTransparent); - exit; - end; - if not CheckVertLineBounds(x,y,y2) then exit; - p := scanline[y] + x; - if LineOrder = riloTopToBottom then delta := Width else delta := -Width; - for n := y2 - y downto 0 do - begin - p^.alpha := alpha; - Inc(p, delta); - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); -var - n, delta: int32or64; - p: PBGRAPixel; -begin - if not CheckVertLineBounds(x,y,y2) then exit; - p := scanline[y] + x; - if LineOrder = riloTopToBottom then delta := Width else delta := -Width; - for n := y2 - y downto 0 do - begin - FastBlendPixelInline(p, c); - Inc(p, delta); - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: int32or64; - c, compare: TBGRAPixel; maxDiff: byte); -begin - if not CheckHorizLineBounds(x,y,x2) then exit; - DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.HorizLineDiff(x, y, x2: int32or64; - const ABrush: TUniversalBrush; ACompare: TBGRAPixel; AMaxDiffW: word); -var - pScan: PBGRAPixel; - ctx: TUniBrushContext; - sameCount, remain: Int32or64; - startAlpha, nextAlpha: Word; - compExpand: TExpandedPixel; -begin - if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; - if not CheckHorizLineBounds(x,y,x2) then exit; - LoadFromBitmapIfNeeded; - pScan := PBGRAPixel(GetPixelAddress(x,y)); - ABrush.MoveTo(@ctx, pScan,x,y); - remain := x2-x+1; - compExpand := ACompare.ToExpanded; - if pScan^ = ACompare then nextAlpha := 65535 - else nextAlpha := (65535 * (AMaxDiffW + 1 - ExpandedDiff(GammaExpansion(pScan^), compExpand)) + (AMaxDiffW + 1) shr 1) div (AMaxDiffW + 1); - inc(pScan); - while remain > 0 do - begin - startAlpha := nextAlpha; - sameCount := 1; - dec(remain); - while remain > 0 do - begin - if pScan^ = ACompare then nextAlpha := 65535 - else nextAlpha := (65535 * (AMaxDiffW + 1 - ExpandedDiff(GammaExpansion(pScan^), compExpand)) + (AMaxDiffW + 1) shr 1) div (AMaxDiffW + 1); - inc(pScan); - if nextAlpha = startAlpha then - begin - inc(sameCount); - dec(remain); - end else break; - end; - ABrush.PutNextPixels(@ctx, startAlpha, sameCount); - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.InternalTextOutCurved( - ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; - ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); -var - glyphCursor: TGlyphCursorUtf8; - currentGlyph: TGlyphUtf8; - currentGlyphUtf8: string; - currentGlyphWidth: single; - angle, textLen: single; - - procedure NextGlyph; - begin - currentGlyph := glyphCursor.GetNextGlyph; - if currentGlyph.MirroredGlyphUtf8 <> '' then - currentGlyphUtf8:= currentGlyph.MirroredGlyphUtf8 - else currentGlyphUtf8 := currentGlyph.GlyphUtf8; - currentGlyphWidth := TextSize(currentGlyphUtf8).cx; - end; - -begin - if (ATexture = nil) and (AColor.alpha = 0) then exit; - sUTF8 := CleanTextOutString(sUTF8); - if sUTF8 = '' then exit; - glyphCursor := TGlyphCursorUtf8.New(sUTF8, FontBidiMode); - - if AAlign<> taLeftJustify then - begin - textLen := -ALetterSpacing; - while not glyphCursor.EndOfString do - begin - NextGlyph; - IncF(textLen, ALetterSpacing + currentGlyphWidth); - end; - case AAlign of - taCenter: ACursor.MoveBackward(textLen*0.5); - taRightJustify: ACursor.MoveBackward(textLen); - end; - glyphCursor.Rewind; - end; - - while not glyphCursor.EndOfString do - begin - NextGlyph; - ACursor.MoveForward(currentGlyphWidth); - ACursor.MoveBackward(currentGlyphWidth, false); - ACursor.MoveForward(currentGlyphWidth*0.5); - with ACursor.CurrentTangent do angle := arctan2(y,x); - with ACursor.CurrentCoordinate do - begin - if ATexture = nil then - TextOutAngle(x,y, system.round(-angle*1800/Pi), currentGlyphUtf8, AColor, taCenter) - else - TextOutAngle(x,y, system.round(-angle*1800/Pi), currentGlyphUtf8, ATexture, taCenter); - end; - ACursor.MoveForward(currentGlyphWidth*0.5 + ALetterSpacing); - end; -end; - -procedure TBGRADefaultBitmap.InternalTextOutLetterSpacing(x, y: single; - sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; - AAlign: TAlignment; ALetterSpacing: single); -var - glyphCursor: TGlyphCursorUtf8; - currentGlyph: TGlyphUtf8; - currentGlyphUtf8: string; - currentGlyphWidth: single; - angle, textLen: single; - m: TAffineMatrix; - ofs: TPointF; - - procedure NextGlyph; - begin - currentGlyph := glyphCursor.GetNextGlyph; - if currentGlyph.MirroredGlyphUtf8 <> '' then - currentGlyphUtf8:= currentGlyph.MirroredGlyphUtf8 - else currentGlyphUtf8 := currentGlyph.GlyphUtf8; - currentGlyphWidth := TextSize(currentGlyphUtf8).cx; - end; - -begin - if (ATexture = nil) and (AColor.alpha = 0) then exit; - sUTF8 := CleanTextOutString(sUTF8); - if sUTF8 = '' then exit; - glyphCursor := TGlyphCursorUtf8.New(sUTF8, FontBidiMode); - - ofs := PointF(0, 0); - if AAlign<> taLeftJustify then - begin - textLen := -ALetterSpacing; - while not glyphCursor.EndOfString do - begin - NextGlyph; - IncF(textLen, ALetterSpacing + currentGlyphWidth); - end; - case AAlign of - taCenter: DecF(ofs.x, 0.5*textLen); - taRightJustify: DecF(ofs.x, textLen); - end; - glyphCursor.Rewind; - end; - m := AffineMatrixRotationDeg(-FontOrientation*0.1); - ofs := m*ofs; - incF(x, ofs.x); - incF(y, ofs.y); - - while not glyphCursor.EndOfString do - begin - NextGlyph; - if ATexture = nil then - TextOut(x,y, currentGlyphUtf8, AColor, taLeftJustify, currentGlyph.RightToLeft) - else - TextOut(x,y, currentGlyphUtf8, ATexture, taLeftJustify, currentGlyph.RightToLeft); - ofs := m*PointF(currentGlyphWidth + ALetterSpacing, 0); - incF(x, ofs.x); - incF(y, ofs.y); - end; -end; - -procedure TBGRADefaultBitmap.InternalCrossFade(ARect: TRect; Source1, - Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode); -var xb,yb: Int32or64; - pdest: PBGRAPixel; - c: TBGRAPixel; - buf1,buf2: ArrayOfTBGRAPixel; -begin - ARect.Intersect(ClipRect); - if ARect.IsEmpty then exit; - setlength(buf1, ARect.Width); - setlength(buf2, ARect.Width); - for yb := ARect.top to ARect.Bottom-1 do - begin - pdest := GetScanlineFast(yb)+ARect.Left; - Source1.ScanMoveTo(ARect.left, yb); - Source1.ScanPutPixels(@buf1[0], length(buf1), dmSet); - Source2.ScanMoveTo(ARect.left, yb); - Source2.ScanPutPixels(@buf2[0], length(buf2), dmSet); - if AFadeMask<>nil then AFadeMask.ScanMoveTo(ARect.left, yb); - for xb := 0 to ARect.Right-ARect.left-1 do - begin - if AFadeMask<>nil then AFadePos := AFadeMask.ScanNextPixel.green; - c := MergeBGRAWithGammaCorrection(buf1[xb],not AFadePos,buf2[xb],AFadePos); - case mode of - dmSet: pdest^ := c; - dmDrawWithTransparency: DrawPixelInlineWithAlphaCheck(pdest, c); - dmLinearBlend: FastBlendPixelInline(pdest,c); - dmSetExceptTransparent: if c.alpha = 255 then pdest^ := c; - end; - inc(pdest); - end; - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.InternalArc(cx, cy, rx, ry: single; StartAngleRad, - EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions; - ADrawChord: boolean; ATexture: IBGRAScanner); -var - pts, ptsFill: array of TPointF; - temp: single; - multi: TBGRAMultishapeFiller; -begin - if (rx = 0) or (ry = 0) then exit; - if ADrawChord then AOptions := AOptions+[aoClosePath]; - if not (aoFillPath in AOptions) then - AFillColor := BGRAPixelTransparent; - - if (ABorderColor.alpha = 0) and (AFillColor.alpha = 0) then exit; - - if (abs(StartAngleRad-EndAngleRad) >= 2*PI - 1e-6) or (StartAngleRad = EndAngleRad) then - begin - if (aoPie in AOptions) or ((PenStyle <> psSolid) and (PenStyle <> psClear)) then - EndAngleRad:= StartAngleRad+2*PI - else - begin - EllipseAntialias(cx,cy,rx,ry,ABorderColor,w,AFillColor); - exit; - end; - end; - - if EndAngleRad < StartAngleRad then - begin - temp := StartAngleRad; - StartAngleRad:= EndAngleRad; - EndAngleRad:= temp; - end; - - pts := ComputeArcRad(cx,cy,rx,ry,StartAngleRad,EndAngleRad); - if aoPie in AOptions then pts := ConcatPointsF([PointsF([PointF(cx,cy)]),pts]); - - multi := TBGRAMultishapeFiller.Create; - multi.FillMode := fmWinding; - multi.PolygonOrder := poLastOnTop; - if AFillColor.alpha <> 0 then - begin - if not (aoPie in AOptions) and (length(pts)>=2) then ptsFill := ConcatPointsF([PointsF([(pts[0]+pts[high(pts)])*0.5]),pts]) - else ptsFill := pts; - if ATexture <> nil then - multi.AddPolygon(ptsFill, ATexture) - else - multi.AddPolygon(ptsFill, AFillColor); - end; - if ABorderColor.alpha <> 0 then - begin - if [aoPie,aoClosePath]*AOptions <> [] then - multi.AddPolygon(ComputeWidePolygon(pts,w), ABorderColor) - else - multi.AddPolygon(ComputeWidePolyline(pts,w), ABorderColor); - end; - multi.Antialiasing := true; - multi.Draw(self); - multi.Free; -end; - -function TBGRADefaultBitmap.InternalNew: TBGRADefaultBitmap; -var - BGRAClass: TBGRABitmapAny; -begin - BGRAClass := TBGRABitmapAny(self.ClassType); - if BGRAClass = TBGRAPtrBitmap then - BGRAClass := TBGRADefaultBitmap; - Result := BGRAClass.Create(0, 0) as TBGRADefaultBitmap; -end; - -class function TBGRADefaultBitmap.IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; -const oneOver512 = 1/512; -var Orig,HAxis,VAxis: TPointF; -begin - Orig := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Top); - if (abs(Orig.x-round(Orig.x)) > oneOver512) or - (abs(Orig.y-round(Orig.y)) > oneOver512) then - begin - result := false; - exit; - end; - HAxis := AMatrix*PointF(ASourceBounds.Right-1,ASourceBounds.Top); - if (abs(HAxis.x - (round(Orig.x)+ASourceBounds.Right-1 - ASourceBounds.Left)) > oneOver512) or - (abs(HAxis.y - round(Orig.y)) > oneOver512) then - begin - result := false; - exit; - end; - VAxis := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Bottom-1); - if (abs(VAxis.y - (round(Orig.y)+ASourceBounds.Bottom-1 - ASourceBounds.Top)) > oneOver512) or - (abs(VAxis.x - round(Orig.x)) > oneOver512) then - begin - result := false; - exit; - end; - result := true; -end; - -{---------------------------- Lines ---------------------------------} -{ Call appropriate functions } - -procedure TBGRADefaultBitmap.DrawPolyLineAntialias( - const points: array of TPointF; c: TBGRAPixel; w: single; - fillcolor: TBGRAPixel); -var multi: TBGRAMultishapeFiller; -begin - multi := TBGRAMultishapeFiller.Create; - multi.PolygonOrder := poLastOnTop; - multi.AddPolygon(points,fillcolor); - multi.AddPolygon(ComputeWidePolyline(points,w),c); - if LinearAntialiasing then - multi.Draw(self,dmLinearBlend) - else - multi.Draw(self,dmDrawWithTransparency); - multi.Free; -end; - -procedure TBGRADefaultBitmap.DrawPolygonAntialias( - const points: array of TPointF; c: TBGRAPixel; w: single; - fillcolor: TBGRAPixel); -var multi: TBGRAMultishapeFiller; -begin - multi := TBGRAMultishapeFiller.Create; - multi.PolygonOrder := poLastOnTop; - multi.AddPolygon(points,fillcolor); - multi.AddPolygon(ComputeWidePolygon(points,w),c); - if LinearAntialiasing then - multi.Draw(self,dmLinearBlend) - else - multi.Draw(self,dmDrawWithTransparency); - multi.Free; -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; - AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); -var tempPath: TBGRAPath; - multi: TBGRAMultishapeFiller; -begin - tempPath := TBGRAPath.Create(APath); - multi := TBGRAMultishapeFiller.Create; - multi.FillMode := FillMode; - multi.PolygonOrder := poLastOnTop; - multi.AddPathFill(tempPath,AMatrix,AFillColor); - multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,GetInternalPen); - multi.Draw(self); - multi.Free; - tempPath.Free; -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; - AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); -var tempPath: TBGRAPath; - multi: TBGRAMultishapeFiller; -begin - tempPath := TBGRAPath.Create(APath); - multi := TBGRAMultishapeFiller.Create; - multi.FillMode := FillMode; - multi.PolygonOrder := poLastOnTop; - multi.AddPathFill(tempPath,AMatrix,AFillColor); - multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,GetInternalPen); - multi.Draw(self); - multi.Free; - tempPath.Free; -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; - AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); -var tempPath: TBGRAPath; - multi: TBGRAMultishapeFiller; -begin - tempPath := TBGRAPath.Create(APath); - multi := TBGRAMultishapeFiller.Create; - multi.FillMode := FillMode; - multi.PolygonOrder := poLastOnTop; - multi.AddPathFill(tempPath,AMatrix,AFillTexture); - multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,GetInternalPen); - multi.Draw(self); - multi.Free; - tempPath.Free; -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; - AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); -var - tempPath: TBGRAPath; - multi: TBGRAMultishapeFiller; -begin - tempPath := TBGRAPath.Create(APath); - multi := TBGRAMultishapeFiller.Create; - multi.FillMode := FillMode; - multi.PolygonOrder := poLastOnTop; - multi.AddPathFill(tempPath,AMatrix,AFillTexture); - multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,GetInternalPen); - multi.Draw(self); - multi.Free; - tempPath.Free; -end; - -procedure TBGRADefaultBitmap.ArrowStartAsNone; -begin - GetArrow.StartAsNone; -end; - -procedure TBGRADefaultBitmap.ArrowStartAsClassic(AFlipped: boolean; - ACut: boolean; ARelativePenWidth: single); -begin - GetArrow.StartAsClassic(AFlipped,ACut,ARelativePenWidth); -end; - -procedure TBGRADefaultBitmap.ArrowStartAsTriangle(ABackOffset: single; - ARounded: boolean; AHollow: boolean; AHollowPenWidth: single); -begin - GetArrow.StartAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth); -end; - -procedure TBGRADefaultBitmap.ArrowStartAsTail; -begin - GetArrow.StartAsTail; -end; - -procedure TBGRADefaultBitmap.ArrowEndAsNone; -begin - GetArrow.EndAsNone; -end; - -procedure TBGRADefaultBitmap.ArrowEndAsClassic(AFlipped: boolean; - ACut: boolean; ARelativePenWidth: single); -begin - GetArrow.EndAsClassic(AFlipped,ACut,ARelativePenWidth); -end; - -procedure TBGRADefaultBitmap.ArrowEndAsTriangle(ABackOffset: single; - ARounded: boolean; AHollow: boolean; AHollowPenWidth: single); -begin - GetArrow.EndAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth); -end; - -procedure TBGRADefaultBitmap.ArrowEndAsTail; -begin - GetArrow.EndAsTail; -end; - -{------------------------ Shapes ----------------------------------------------} -{ Call appropriate functions } - -procedure TBGRADefaultBitmap.FillTriangleLinearColor(pt1, pt2, pt3: TPointF; - c1, c2, c3: TBGRAPixel); -begin - FillPolyLinearColor([pt1,pt2,pt3],[c1,c2,c3]); -end; - -procedure TBGRADefaultBitmap.FillTriangleLinearColorAntialias(pt1, pt2, - pt3: TPointF; c1, c2, c3: TBGRAPixel); -var - grad: TBGRAGradientTriangleScanner; -begin - grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3); - FillPolyAntialias([pt1,pt2,pt3],grad); - grad.Free; -end; - -procedure TBGRADefaultBitmap.FillTriangleLinearMapping(pt1, pt2, pt3: TPointF; - texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); -begin - FillPolyLinearMapping([pt1,pt2,pt3],texture,[tex1,tex2,tex3],TextureInterpolation); -end; - -procedure TBGRADefaultBitmap.FillTriangleLinearMappingLightness(pt1, pt2, - pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1, - light2, light3: word; TextureInterpolation: Boolean); -begin - FillPolyLinearMappingLightness([pt1,pt2,pt3],texture,[tex1,tex2,tex3],[light1,light2,light3],TextureInterpolation); -end; - -procedure TBGRADefaultBitmap.FillTriangleLinearMappingAntialias(pt1, pt2, - pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); -var - mapping: TBGRATriangleLinearMapping; -begin - mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3); - FillPolyAntialias([pt1,pt2,pt3],mapping); - mapping.Free; -end; - -procedure TBGRADefaultBitmap.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; - c1, c2, c3, c4: TBGRAPixel); -var - center: TPointF; - centerColor: TBGRAPixel; - multi: TBGRAMultishapeFiller; -begin - if not IsConvex([pt1,pt2,pt3,pt4]) then //need to merge colors - begin - multi := TBGRAMultishapeFiller.Create; - multi.AddQuadLinearColor(pt1,pt2,pt3,pt4,c1,c2,c3,c4); - multi.Antialiasing:= false; - multi.Draw(self); - multi.Free; - exit; - end; - center := (pt1+pt2+pt3+pt4)*(1/4); - centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)), - MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) ); - FillTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor); - FillTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor); - FillTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor); - FillTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor); -end; - -procedure TBGRADefaultBitmap.FillQuadLinearColorAntialias(pt1, pt2, pt3, - pt4: TPointF; c1, c2, c3, c4: TBGRAPixel); -var multi : TBGRAMultishapeFiller; -begin - multi := TBGRAMultishapeFiller.Create; - multi.AddQuadLinearColor(pt1, pt2, pt3, pt4, c1, c2, c3, c4); - multi.Draw(self); - multi.free; -end; - -procedure TBGRADefaultBitmap.FillQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; - texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; - TextureInterpolation: Boolean; ACulling: TFaceCulling; ACropToPolygon: boolean); -var - scan: TBGRAQuadLinearScanner; - r: TRect; -begin - if ((abs(pt1.y-pt2.y)<1e-6) and (abs(pt3.y-pt4.y)<1e-6)) or - ((abs(pt3.y-pt2.y)<1e-6) and (abs(pt1.y-pt4.y)<1e-6)) then - FillPolyLinearMapping([pt1,pt2,pt3,pt4], texture, - [tex1,tex2,tex3,tex4], TextureInterpolation) - else - begin - scan := TBGRAQuadLinearScanner.Create(texture, - [tex1,tex2,tex3,tex4], - [pt1,pt2,pt3,pt4],TextureInterpolation); - scan.Culling := ACulling; - if ACropToPolygon then - begin - scan.Padding := true; - FillPoly([pt1,pt2,pt3,pt4],scan,dmDrawWithTransparency); - end - else - begin - r := RectWithSize(floor(pt1.x),floor(pt1.y),1,1); - r.Union( RectWithSize(floor(pt2.x),floor(pt2.y),1,1) ); - r.Union( RectWithSize(floor(pt3.x),floor(pt3.y),1,1) ); - r.Union( RectWithSize(floor(pt4.x),floor(pt4.y),1,1) ); - FillRect(r,scan,dmDrawWithTransparency); - end; - scan.Free; - end; -end; - -procedure TBGRADefaultBitmap.FillQuadLinearMappingLightness(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1, - light2, light3, light4: word; TextureInterpolation: Boolean); -var - center: TPointF; - centerTex: TPointF; - centerLight: word; -begin - center := (pt1+pt2+pt3+pt4)*(1/4); - centerTex := (tex1+tex2+tex3+tex4)*(1/4); - centerLight := (light1+light2+light3+light4) div 4; - FillTriangleLinearMappingLightness(pt1,pt2,center, texture,tex1,tex2,centerTex, light1,light2,centerLight, TextureInterpolation); - FillTriangleLinearMappingLightness(pt2,pt3,center, texture,tex2,tex3,centerTex, light2,light3,centerLight, TextureInterpolation); - FillTriangleLinearMappingLightness(pt3,pt4,center, texture,tex3,tex4,centerTex, light3,light4,centerLight, TextureInterpolation); - FillTriangleLinearMappingLightness(pt4,pt1,center, texture,tex4,tex1,centerTex, light4,light1,centerLight, TextureInterpolation); -end; - -procedure TBGRADefaultBitmap.FillQuadLinearMappingAntialias(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; - ACulling: TFaceCulling); -var multi : TBGRAMultishapeFiller; -begin - multi := TBGRAMultishapeFiller.Create; - multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4, ACulling); - multi.Draw(self); - multi.free; -end; - -procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; - ADrawMode: TDrawMode); -var - persp: TBGRAPerspectiveScannerTransform; -begin - persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); - FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode); - persp.Free; -end; - -procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; - ACleanBorders: TRect; ADrawMode: TDrawMode); -var - persp: TBGRAPerspectiveScannerTransform; - clean: TBGRAExtendedBorderScanner; -begin - clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders); - persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); - FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode); - persp.Free; - clean.Free; -end; - -procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); -var - persp: TBGRAPerspectiveScannerTransform; -begin - persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); - FillPolyAntialias([pt1,pt2,pt3,pt4],persp); - persp.Free; -end; - -procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; - ACleanBorders: TRect); -var - persp: TBGRAPerspectiveScannerTransform; - clean: TBGRAExtendedBorderScanner; -begin - clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders); - persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); - FillPolyAntialias([pt1,pt2,pt3,pt4],persp); - persp.Free; - clean.Free; -end; - -procedure TBGRADefaultBitmap.FillQuadAffineMapping(Orig, HAxis, VAxis: TPointF; - AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; ADrawMode: TDrawMode; AOpacity: byte); -var pts3: TPointF; - affine: TBGRAAffineBitmapTransform; -begin - if not APixelCenteredCoordinates then - begin - Orig.Offset(-0.5,-0.5); - HAxis.Offset(-0.5,-0.5); - VAxis.Offset(-0.5,-0.5); - end; - pts3 := HAxis+(VAxis-Orig); - affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates); - affine.GlobalOpacity:= AOpacity; - affine.Fit(Orig,HAxis,VAxis); - FillPoly([Orig,HAxis,pts3,VAxis],affine,ADrawMode); - affine.Free; -end; - -procedure TBGRADefaultBitmap.FillQuadAffineMappingAntialias(Orig, HAxis, - VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; AOpacity: byte); -var pts3: TPointF; - affine: TBGRAAffineBitmapTransform; -begin - if not APixelCenteredCoordinates then - begin - Orig.Offset(-0.5,-0.5); - HAxis.Offset(-0.5,-0.5); - VAxis.Offset(-0.5,-0.5); - end; - pts3 := HAxis+(VAxis-Orig); - affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates); - affine.GlobalOpacity:= AOpacity; - affine.Fit(Orig,HAxis,VAxis); - FillPolyAntialias([Orig,HAxis,pts3,VAxis],affine); - affine.Free; -end; - -procedure TBGRADefaultBitmap.FillPolyLinearMapping(const points: array of TPointF; - texture: IBGRAScanner; texCoords: array of TPointF; - TextureInterpolation: Boolean); -begin - PolygonLinearTextureMappingAliased(self,points,texture,texCoords,TextureInterpolation, FillMode = fmWinding); -end; - -procedure TBGRADefaultBitmap.FillPolyLinearMappingLightness( - const points: array of TPointF; texture: IBGRAScanner; - texCoords: array of TPointF; lightnesses: array of word; - TextureInterpolation: Boolean); -begin - PolygonLinearTextureMappingAliasedWithLightness(self,points,texture,texCoords,TextureInterpolation,lightnesses,FillMode = fmWinding); -end; - -procedure TBGRADefaultBitmap.FillPolyLinearColor( - const points: array of TPointF; AColors: array of TBGRAPixel); -begin - PolygonLinearColorGradientAliased(self,points,AColors, FillMode = fmWinding); -end; - -procedure TBGRADefaultBitmap.FillPolyPerspectiveMapping( - const points: array of TPointF; const pointsZ: array of single; - texture: IBGRAScanner; texCoords: array of TPointF; - TextureInterpolation: Boolean; zbuffer: psingle); -begin - PolygonPerspectiveTextureMappingAliased(self,points,pointsZ,texture,texCoords,TextureInterpolation, FillMode = fmWinding, zbuffer); -end; - -procedure TBGRADefaultBitmap.FillPolyPerspectiveMappingLightness( - const points: array of TPointF; const pointsZ: array of single; - texture: IBGRAScanner; texCoords: array of TPointF; - lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle); -begin - PolygonPerspectiveTextureMappingAliasedWithLightness(self,points,pointsZ,texture,texCoords,TextureInterpolation,lightnesses, FillMode = fmWinding, zbuffer); -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; - AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); -begin - DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillColor); -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; - AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); -begin - DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillColor); -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; - AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); -begin - DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillTexture); -end; - -procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; - AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); -begin - DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillTexture); -end; - -procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single; - c: TBGRAPixel; w: single; back: TBGRAPixel); -var multi: TBGRAMultishapeFiller; - hw: single; -begin - if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then - begin - FillEllipseAntialias(x, y, rx, ry, back); - exit; - end; - rx := abs(rx); - ry := abs(ry); - hw := w/2; - if (rx <= hw) or (ry <= hw) then - begin - FillEllipseAntialias(x,y,rx+hw,ry+hw,c); - exit; - end; - { use multishape filler for fine junction between polygons } - multi := TBGRAMultishapeFiller.Create; - if (PenStyle = psSolid) then - begin - if back.alpha <> 0 then multi.AddEllipse(x,y,rx-hw,ry-hw,back); - multi.AddEllipseBorder(x,y,rx,ry,w,c) - end - else - begin - if back.alpha <> 0 then multi.AddEllipse(x,y,rx,ry,back); - multi.AddPolygon(ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry),w),c); - end; - multi.PolygonOrder := poLastOnTop; - multi.Draw(self); - multi.Free; -end; - -procedure TBGRADefaultBitmap.EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; - c: TBGRAPixel; w: single; back: TBGRAPixel); -var multi: TBGRAMultishapeFiller; - pts: ArrayOfTPointF; -begin - if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then - begin - FillEllipseAntialias(AOrigin, AXAxis, AYAxis, back); - exit; - end; - { use multishape filler for fine junction between polygons } - multi := TBGRAMultishapeFiller.Create; - pts := ComputeEllipseContour(AOrigin, AXAxis, AYAxis); - if back.alpha <> 0 then multi.AddPolygon(pts, back); - pts := ComputeWidePolygon(pts,w); - multi.AddPolygon(pts,c); - multi.PolygonOrder := poLastOnTop; - multi.Draw(self); - multi.Free; -end; - -procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(x, y, rx, - ry: single; outercolor, innercolor: TBGRAPixel); -var - grad: TBGRAGradientScanner; - affine: TBGRAAffineScannerTransform; -begin - if (rx=0) or (ry=0) then exit; - if rx=ry then - begin - grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(x,y),PointF(x+rx,y),True); - FillEllipseAntialias(x,y,rx,ry,grad); - grad.Free; - end else - begin - grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True); - affine := TBGRAAffineScannerTransform.Create(grad); - affine.Scale(rx,ry); - affine.Translate(x,y); - FillEllipseAntialias(x,y,rx,ry,affine); - affine.Free; - grad.Free; - end; -end; - -procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(AOrigin, AXAxis, - AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); -var - grad: TBGRAGradientScanner; - affine: TBGRAAffineScannerTransform; -begin - grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True); - affine := TBGRAAffineScannerTransform.Create(grad); - affine.Fit(AOrigin,AXAxis,AYAxis); - FillEllipseAntialias(AOrigin,AXAxis,AYAxis,affine); - affine.Free; - grad.Free; -end; - -procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single; - c: TBGRAPixel; w: single; back: TBGRAPixel); -var - bevel: single; - multi: TBGRAMultishapeFiller; - hw: single; -begin - if (PenStyle = psClear) or (c.alpha=0) or (w=0) then - begin - if back <> BGRAPixelTransparent then - FillRectAntialias(x,y,x2,y2,back); - exit; - end; - - hw := w/2; - if not CheckAntialiasRectBounds(x,y,x2,y2,w) then - begin - if JoinStyle = pjsBevel then - begin - bevel := (2-sqrt(2))*hw; - FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, c, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]); - end else - if JoinStyle = pjsRound then - FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, c) - else - FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, c); - exit; - end; - - { use multishape filler for fine junction between polygons } - multi := TBGRAMultishapeFiller.Create; - multi.FillMode := FillMode; - if (JoinStyle = pjsMiter) and (PenStyle = psSolid) then - multi.AddRectangleBorder(x,y,x2,y2,w,c) - else - multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w),c); - - if (frac(x + hw) = 0.5) and (frac(y + hw)=0.5) and (frac(x2 - hw)=0.5) and (frac(y2 - hw)=0.5) then - FillRect(ceil(x + hw), ceil(y + hw), ceil(x2 - hw), ceil(y2 - hw), back, dmDrawWithTransparency) - else - multi.AddRectangle(x + hw, y + hw, x2 - hw, y2 - hw, back); - multi.Draw(self); - multi.Free; -end; - -procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; - c: TBGRAPixel; w: single; options: TRoundRectangleOptions); -begin - if (PenStyle = psClear) or (c.alpha = 0) then exit; - if (PenStyle = psSolid) then - BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False, LinearAntialiasing) - else - DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),c,w); -end; - -procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; - pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; - options: TRoundRectangleOptions); -var - multi: TBGRAMultishapeFiller; -begin - if (PenStyle = psClear) or (pencolor.alpha = 0) then - begin - FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillColor,options); - exit; - end; - if (PenStyle = psSolid) then - BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,pencolor,fillcolor,nil,nil,False) - else - begin - multi := TBGRAMultishapeFiller.Create; - multi.PolygonOrder := poLastOnTop; - multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillColor,options); - multi.AddPolygon(ComputeWidePolygon(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),pencolor); - multi.Draw(self); - multi.Free; - end; -end; - -procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; - penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; - options: TRoundRectangleOptions); -var - multi: TBGRAMultishapeFiller; -begin - if (PenStyle = psClear) then - begin - FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillTexture,options); - exit; - end else - if (PenStyle = psSolid) then - BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,BGRAPixelTransparent,BGRAPixelTransparent,pentexture,filltexture,False) - else - begin - multi := TBGRAMultishapeFiller.Create; - multi.PolygonOrder := poLastOnTop; - multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillTexture,options); - multi.AddPolygon(ComputeWidePolygon(ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),penTexture); - multi.Draw(self); - multi.Free; - end; -end; - -procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single; - texture: IBGRAScanner; w: single; options: TRoundRectangleOptions); -begin - if (PenStyle = psClear) then exit; - if (PenStyle = psSolid) then - BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture, LinearAntialiasing) - else - DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),texture,w); -end; - -function TBGRADefaultBitmap.CheckRectBounds(var x, y, x2, y2: integer; minsize: integer): boolean; inline; -var - temp: integer; -begin - //swap coordinates if needed - if (x > x2) then - begin - temp := x; - x := x2; - x2 := temp; - end; - if (y > y2) then - begin - temp := y; - y := y2; - y2 := temp; - end; - if (x2 - x <= minsize) or (y2 - y <= minsize) then - begin - result := false; - exit; - end else - result := true; -end; - -procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer; - texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); -var dither: TDitheringTask; -begin - if not CheckClippedRectBounds(x,y,x2,y2) then exit; - dither := CreateDitheringTask(ditheringAlgorithm, texture, self, rect(x,y,x2,y2)); - dither.ScanOffset := AScanOffset; - dither.DrawMode := mode; - dither.Execute; - dither.Free; -end; - -{------------------------- Text functions ---------------------------------------} - -procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer; - const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); -begin - with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do - FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),c,align,ARightToLeft); -end; - -procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer; - const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); -begin - with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do - FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),texture,align,ARightToLeft); -end; - -procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); -begin - InternalTextOutCurved(ACursor, sUTF8, AColor, nil, AAlign, ALetterSpacing); -end; - -procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); -begin - InternalTextOutCurved(ACursor, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing); -end; - -procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single; const sUTF8: string; - c: TBGRAPixel; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single); -var - layout: TBidiTextLayout; - i: Integer; -begin - if FontBidiMode = fbmAuto then - layout := TBidiTextLayout.Create(FontRenderer, sUTF8) - else - layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8)); - for i := 0 to layout.ParagraphCount-1 do - layout.ParagraphAlignment[i] := AAlign; - layout.ParagraphSpacingBelow:= AParagraphSpacing; - layout.AvailableWidth := AWidth; - case AVertAlign of - tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight); - tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2); - else layout.TopLeft := PointF(ALeft,ATop); - end; - layout.DrawText(self, c); - layout.Free; -end; - -procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single; - const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment; - AVertAlign: TTextLayout; AParagraphSpacing: single); -var - layout: TBidiTextLayout; - i: Integer; -begin - if FontBidiMode = fbmAuto then - layout := TBidiTextLayout.Create(FontRenderer, sUTF8) - else - layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8)); - for i := 0 to layout.ParagraphCount-1 do - layout.ParagraphAlignment[i] := AAlign; - layout.ParagraphSpacingBelow:= AParagraphSpacing; - layout.AvailableWidth := AWidth; - case AVertAlign of - tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight); - tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2); - else layout.TopLeft := PointF(ALeft,ATop); - end; - layout.DrawText(self, ATexture); - layout.Free; -end; - -procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; - texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); -begin - FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),texture,align, ARightToLeft); -end; - -procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; - AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); -begin - InternalTextOutLetterSpacing(x, y, sUTF8, AColor, nil, AAlign, ALetterSpacing); -end; - -procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; - ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); -begin - InternalTextOutLetterSpacing(x, y, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing); -end; - -procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string; - c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); -begin - with (PointF(x,y)-GetFontAnchorRotatedOffset) do - FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),c,align, ARightToLeft); -end; - -procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; - const sUTF8: string; style: TTextStyle; c: TBGRAPixel); -begin - with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do - FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,c); -end; - -procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; const sUTF8: string; - style: TTextStyle; texture: IBGRAScanner); -begin - with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do - FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,texture); -end; - -{ Returns the total size of the string provided using the current font. - Orientation is not taken into account, so that the width is along the text. } -function TBGRADefaultBitmap.TextSize(const sUTF8: string): TSize; -begin - result := FontRenderer.TextSize(CleanTextOutString(sUTF8)); -end; - -function TBGRADefaultBitmap.TextSizeMultiline(const sUTF8: string; AMaxWidth: single; - AParagraphSpacing: single): TSize; -var - layout: TBidiTextLayout; -begin - if FontBidiMode = fbmAuto then - layout := TBidiTextLayout.Create(FontRenderer, sUTF8) - else - layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8)); - layout.ParagraphSpacingBelow:= AParagraphSpacing; - layout.AvailableWidth := AMaxWidth; - result := size(ceil(layout.UsedWidth), ceil(layout.TotalTextHeight)); - layout.Free; -end; - -function TBGRADefaultBitmap.TextAffineBox(const sUTF8: string): TAffineBox; -var size: TSize; - m: TAffineMatrix; - dy: single; -begin - dy := GetFontVerticalAnchorOffset; - size := FontRenderer.TextSizeAngle(sUTF8, FontOrientation); - m := AffineMatrixRotationDeg(-FontOrientation*0.1); - result := TAffineBox.AffineBox(PointF(0,-dy), m*PointF(size.cx,-dy), m*PointF(0,size.cy-dy)); -end; - -function TBGRADefaultBitmap.TextSize(const sUTF8: string; AMaxWidth: integer): TSize; -begin - result := FontRenderer.TextSize(sUTF8, AMaxWidth, GetFontRightToLeftFor(sUTF8)); -end; - -function TBGRADefaultBitmap.TextSize(const sUTF8: string; AMaxWidth: integer; - ARightToLeft: boolean): TSize; -begin - result := FontRenderer.TextSize(sUTF8, AMaxWidth, ARightToLeft); -end; - -function TBGRADefaultBitmap.TextFitInfo(const sUTF8: string; AMaxWidth: integer - ): integer; -begin - result := FontRenderer.TextFitInfo(sUTF8, AMaxWidth); -end; - -{---------------------------- Curves ----------------------------------------} - -function TBGRADefaultBitmap.ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; -begin - result := BGRAPath.ComputeClosedSpline(APoints, AStyle); -end; - -function TBGRADefaultBitmap.ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; -begin - result := BGRAPath.ComputeOpenedSpline(APoints, AStyle); -end; - -function TBGRADefaultBitmap.ComputeBezierCurve(const ACurve: TCubicBezierCurve - ): ArrayOfTPointF; -begin - Result:= BGRAPath.ComputeBezierCurve(ACurve); -end; - -function TBGRADefaultBitmap.ComputeBezierCurve( - const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; -begin - Result:= BGRAPath.ComputeBezierCurve(ACurve); -end; - -function TBGRADefaultBitmap.ComputeBezierSpline( - const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; -begin - Result:= BGRAPath.ComputeBezierSpline(ASpline); -end; - -function TBGRADefaultBitmap.ComputeBezierSpline( - const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; -begin - Result:= BGRAPath.ComputeBezierSpline(ASpline); -end; - -function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF; - w: single): ArrayOfTPointF; -begin - result := GetInternalPen.ComputePolyline(points,w); -end; - -function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF; - w: single; ClosedCap: boolean): ArrayOfTPointF; -begin - result := GetInternalPen.ComputePolyline(points,w,ClosedCap); -end; - -function TBGRADefaultBitmap.ComputeWidePolygon(const points: array of TPointF; - w: single): ArrayOfTPointF; -begin - result := GetInternalPen.ComputePolygon(points,w); -end; - -function TBGRADefaultBitmap.ComputeEllipseContour(x, y, rx, ry: single; quality: single): ArrayOfTPointF; -begin - result := BGRAPath.ComputeEllipse(x,y,rx,ry, quality); -end; - -function TBGRADefaultBitmap.ComputeEllipseContour(AOrigin, AXAxis, - AYAxis: TPointF; quality: single): ArrayOfTPointF; -begin - result := BGRAPath.ComputeEllipse(AOrigin,AXAxis,AYAxis, quality); -end; - -function TBGRADefaultBitmap.ComputeEllipseBorder(x, y, rx, ry, w: single; quality: single): ArrayOfTPointF; -begin - result := ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry, quality),w); -end; - -function TBGRADefaultBitmap.ComputeEllipseBorder(AOrigin, AXAxis, - AYAxis: TPointF; w: single; quality: single): ArrayOfTPointF; -begin - result := ComputeWidePolygon(ComputeEllipseContour(AOrigin,AXAxis,AYAxis, quality),w); -end; - -function TBGRADefaultBitmap.ComputeArc65536(x, y, rx, ry: single; start65536, - end65536: word; quality: single): ArrayOfTPointF; -begin - result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality); -end; - -function TBGRADefaultBitmap.ComputeArcRad(x, y, rx, ry: single; startRad, - endRad: single; quality: single): ArrayOfTPointF; -begin - result := BGRAPath.ComputeArcRad(x,y,rx,ry,startRad,endRad,quality); -end; - -function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; quality: single): ArrayOfTPointF; -begin - result := BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,quality); -end; - -function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; - options: TRoundRectangleOptions; quality: single): ArrayOfTPointF; -begin - Result:= BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,options,quality); -end; - -function TBGRADefaultBitmap.ComputePie65536(x, y, rx, ry: single; start65536, - end65536: word; quality: single): ArrayOfTPointF; -begin - result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality); - if (start65536 <> end65536) then - begin - setlength(result,length(result)+1); - result[high(result)] := PointF(x,y); - end; -end; - -function TBGRADefaultBitmap.ComputePieRad(x, y, rx, ry: single; startRad, - endRad: single; quality: single): ArrayOfTPointF; -begin - result := self.ComputePie65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi),quality); -end; - -{---------------------------------- Fill ---------------------------------} - -procedure TBGRADefaultBitmap.Fill(c: TBGRAPixel; start, Count: integer); -begin - if start < 0 then - begin - inc(Count, start); - start := 0; - end; - if start >= nbPixels then - exit; - if start + Count > nbPixels then - Count := nbPixels - start; - - FillInline(Data + start, c, Count); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.AlphaFill(alpha: byte; start, Count: integer); -begin - if alpha = 0 then - Fill(BGRAPixelTransparent, start, Count); - if start < 0 then - begin - inc(Count, start); - start := 0; - end; - if start >= nbPixels then - exit; - if start + Count > nbPixels then - Count := nbPixels - start; - - AlphaFillInline(Data + start, alpha, Count); - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TCustomUniversalBitmap; - const AColor: TBGRAPixel; ADrawMode: TDrawMode); -var - scan: TBGRACustomScanner; -begin - if (AMask = nil) or (AColor.alpha = 0) then exit; - scan := TBGRASolidColorMaskScanner.Create(AMask, Point(-X,-Y), AColor); - self.FillRect(X,Y, X+AMask.Width,Y+AMask.Height, scan, ADrawMode); - scan.Free; -end; - -procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TCustomUniversalBitmap; - ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte); -var - scan: TBGRACustomScanner; -begin - if AMask = nil then exit; - scan := TBGRATextureMaskScanner.Create(AMask, Point(-X,-Y), ATexture, AOpacity); - self.FillRect(X,Y, X+AMask.Width,Y+AMask.Height, scan, ADrawMode); - scan.Free; -end; - -procedure TBGRADefaultBitmap.EraseMask(x, y: integer; AMask: TBGRACustomBitmap; - alpha: byte); -var - x0,y0,x2, y2, yb,xb, tx, delta: integer; - p, psrc: PBGRAPixel; -begin - if (AMask = nil) or (alpha = 0) then exit; - x0 := x; - y0 := y; - x2 := x+AMask.Width; - y2 := y+AMask.Height; - if not CheckClippedRectBounds(x,y,x2,y2) then exit; - tx := x2 - x; - Dec(x2); - Dec(y2); - - p := Scanline[y] + x; - if FLineOrder = riloBottomToTop then - delta := -Width - else - delta := Width; - - for yb := y to y2 do - begin - psrc := AMask.ScanLine[yb-y0]+(x-x0); - if alpha = 255 then - begin - for xb := tx-1 downto 0 do - begin - ErasePixelInline(p, psrc^.green); - inc(p); - inc(psrc); - end; - end else - begin - for xb := tx-1 downto 0 do - begin - ErasePixelInline(p, ApplyOpacity(psrc^.green,alpha)); - inc(p); - inc(psrc); - end; - end; - dec(p, tx); - Inc(p, delta); - end; - - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer; - AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean); -begin - BGRAFillClearTypeMask(self,x, y, xThird, AMask, color, nil, ARGBOrder); -end; - -procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer; - AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean); -begin - BGRAFillClearTypeMask(self,x, y, xThird, AMask, BGRAPixelTransparent, texture, ARGBOrder); -end; - -{ Replace color without taking alpha channel into account } -procedure TBGRADefaultBitmap.ReplaceColor(before, after: TColor); -var - p: PLongWord; - n: integer; - colorMask,beforeBGR, afterBGR: LongWord; - rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte; -begin - colorMask := LongWord(BGRA(255,255,255,0)); - RedGreenBlue(before, rBefore,gBefore,bBefore); - RedGreenBlue(after, rAfter,gAfter,bAfter); - beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0)); - afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0)); - - p := PLongWord(Data); - for n := NbPixels - 1 downto 0 do - begin - if p^ and colorMask = beforeBGR then - p^ := (p^ and not ColorMask) or afterBGR; - Inc(p); - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.ReplaceColor(ABounds: TRect; before, after: TColor); -var p: PLongWord; - xb,yb,xcount: integer; - - colorMask,beforeBGR, afterBGR: LongWord; - rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte; -begin - colorMask := LongWord(BGRA(255,255,255,0)); - RedGreenBlue(before, rBefore,gBefore,bBefore); - RedGreenBlue(after, rAfter,gAfter,bAfter); - beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0)); - afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0)); - - ABounds.Intersect(ClipRect); - if ABounds.IsEmpty then exit; - xcount := ABounds.Right-ABounds.Left; - for yb := ABounds.Top to ABounds.Bottom-1 do - begin - p := PLongWord(ScanLine[yb]+ABounds.Left); - for xb := xcount-1 downto 0 do - begin - if p^ and colorMask = beforeBGR then - p^ := (p^ and not ColorMask) or afterBGR; - Inc(p); - end; - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer; - Dest: TCustomUniversalBitmap; Color: TBGRAPixel; mode: TFloodfillMode; - Tolerance: byte; DestOfsX: integer; DestOfsY: integer); -var - b: TUniversalBrush; -begin - case mode of - fmSet: Dest.SolidBrushBGRA(b, Color, dmSet); - fmDrawWithTransparency: Dest.SolidBrushBGRA(b, Color, dmDrawWithTransparency); - fmLinearBlend: Dest.SolidBrushBGRA(b, Color, dmLinearBlend); - fmXor: Dest.SolidBrushBGRA(b, Color, dmXor); - fmProgressive: Dest.SolidBrushBGRA(b, Color, dmDrawWithTransparency); - end; - ParallelFloodFill(X,Y, Dest, b, mode=fmProgressive, (Tolerance shl 8)+$ff, DestOfsX, DestOfsY); -end; - -{ General purpose FloodFill. It can be used to fill inplace or to - fill a destination bitmap according to the content of the current bitmap. - - The first pixel encountered is taken as a reference, further pixels - are compared to this pixel. If the distance between next colors and - the first color is lower than the tolerance, then the floodfill continues. - - It uses an array of bits to store visited places to avoid filling twice - the same area. It also uses a stack of positions to remember where - to continue after a place is completely filled. - - The first direction to be checked is horizontal, then - it checks pixels on the line above and on the line below. } -procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer; - Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush; Progressive: boolean; - ToleranceW: Word; DestOfsX: integer; DestOfsY: integer); -var - S: TBGRAPixel; - SExpand: TExpandedPixel; - SX, EX, I: integer; - Added: boolean; - - Visited: array of LongWord; - VisitedLineSize: integer; - - Stack: array of integer; - StackCount: integer; - pScan: PBGRAPixel; - - function CheckPixel(AX, AY: integer): boolean; inline; - begin - if Visited[AX shr 5 + AY * VisitedLineSize] and (1 shl (AX and 31)) <> 0 then - Result := False - else - begin - if (pScan+AX)^ = S then result := true else - Result := ExpandedDiff(GammaExpansion((pScan+AX)^), SExpand) <= ToleranceW; - end; - end; - - procedure SetVisited(X1, AY, X2: integer); - var - StartMask, EndMask: LongWord; - StartPos, EndPos: integer; - begin - if X2 < X1 then - exit; - StartMask := $FFFFFFFF shl (X1 and 31); - case X2 and 31 of - 31: EndMask := $FFFFFFFF; - 30: EndMask := $7FFFFFFF; - else - EndMask := 1 shl ((X2 and 31) + 1) - 1; - end; - StartPos := X1 shr 5 + AY * VisitedLineSize; - EndPos := X2 shr 5 + AY * VisitedLineSize; - if StartPos = EndPos then - Visited[StartPos] := Visited[StartPos] or (StartMask and EndMask) - else - begin - Visited[StartPos] := Visited[StartPos] or StartMask; - Visited[EndPos] := Visited[EndPos] or EndMask; - if EndPos - StartPos > 1 then - FillDWord(Visited[StartPos + 1], EndPos - StartPos - 1, $FFFFFFFF); - end; - end; - - procedure Push(AX, AY: integer); inline; - begin - if StackCount + 1 >= High(Stack) then - SetLength(Stack, Length(Stack) shl 1); - - Stack[StackCount] := AX; - Inc(StackCount); - Stack[StackCount] := AY; - Inc(StackCount); - end; - - procedure Pop(var AX, AY: integer); inline; - begin - Dec(StackCount); - AY := Stack[StackCount]; - Dec(StackCount); - AX := Stack[StackCount]; - end; - -begin - if Brush.DoesNothing then exit; - if Progressive and not (dest is TBGRACustomBitmap) then - raise exception.Create('Progressive mode only available on TBGRACustomBitmap and derived classes'); - if PtInClipRect(X,Y) then - begin - S := GetPixel(X, Y); - SExpand := s.ToExpanded; - - VisitedLineSize := (Width + 31) shr 5; - SetLength(Visited, VisitedLineSize * Height); - FillDWord(Visited[0], Length(Visited), 0); - - SetLength(Stack, 2); - StackCount := 0; - - Push(X, Y); - repeat - Pop(X, Y); - pScan := GetScanlineFast(Y); - if not CheckPixel(X, Y) then - Continue; - - SX := X; - while (SX > FClipRect.Left) and CheckPixel(Pred(SX), Y) do - Dec(SX); - EX := X; - while (EX < Pred(FClipRect.Right)) and CheckPixel(Succ(EX), Y) do - Inc(EX); - - SetVisited(SX, Y, EX); - if Progressive then - TBGRACustomBitmap(dest).HorizLineDiff(SX+DestOfsX, Y+DestOfsY, EX+DestOfsX, Brush, S, ToleranceW) - else - dest.HorizLine(SX+DestOfsX, Y+DestOfsY, EX+DestOfsX, Brush); - - Added := False; - if Y > FClipRect.Top then - begin - pScan := GetScanlineFast(Pred(Y)); - for I := SX to EX do - if CheckPixel(I, Pred(Y)) then - begin - if Added then //do not add twice the same segment - Continue; - Push(I, Pred(Y)); - Added := True; - end - else - Added := False; - end; - - Added := False; - if Y < Pred(FClipRect.Bottom) then - begin - pScan := GetScanlineFast(Succ(Y)); - for I := SX to EX do - if CheckPixel(I, Succ(Y)) then - begin - if Added then //do not add twice the same segment - Continue; - Push(I, Succ(Y)); - Added := True; - end - else - Added := False; - end; - until StackCount <= 0; - end; -end; - -procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer; - c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - gammaColorCorrection: boolean; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm); -var - scanner: TBGRAGradientScanner; -begin - if (c1.alpha = 0) and (c2.alpha = 0) then - FillRect(x, y, x2, y2, BGRAPixelTransparent, mode) - else - if ditherAlgo <> daNearestNeighbor then - GradientFillDithered(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus,ditherAlgo) - else - begin - scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus); - FillRect(x,y,x2,y2,scanner,mode); - scanner.Free; - end; -end; - -procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer; - gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF; - mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm); -var - scanner: TBGRAGradientScanner; -begin - if ditherAlgo <> daNearestNeighbor then - GradientFillDithered(x,y,x2,y2,gradient,gtype,o1,o2,mode,sinus,ditherAlgo) - else - begin - scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus); - FillRect(x,y,x2,y2,scanner,mode); - scanner.Free; - end; -end; - -procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer; c1, - c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; - mode: TDrawMode; gammaColorCorrection: boolean; Sinus: Boolean; - ditherAlgo: TDitheringAlgorithm); -var - scanner: TBGRAGradientScanner; -begin - if (c1.alpha = 0) and (c2.alpha = 0) then - begin - if mode = dmSet then - FillRect(x, y, x2, y2, BGRAPixelTransparent, dmSet); - end - else - begin - scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus); - FillRect(x,y,x2,y2,scanner,mode,ditherAlgo); - scanner.Free; - end; -end; - -procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer; - gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF; - mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm); -var - scanner: TBGRAGradientScanner; -begin - scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus); - FillRect(x,y,x2,y2,scanner,mode,ditherAlgo); - scanner.Free; -end; - -function TBGRADefaultBitmap.ScanAtInteger(X, Y: integer): TBGRAPixel; -begin - if (FScanWidth <> 0) and (FScanHeight <> 0) then - result := (GetScanlineFast(PositiveMod(Y+ScanOffset.Y, FScanHeight))+PositiveMod(X+ScanOffset.X, FScanWidth))^ - else - result := BGRAPixelTransparent; -end; - -function TBGRADefaultBitmap.ScanNextPixel: TBGRAPixel; -begin - if (FScanWidth <> 0) and (FScanHeight <> 0) then - begin - result := PBGRAPixel(FScanPtr)^; - inc(FScanCurX); - inc(FScanPtr, sizeof(TBGRAPixel)); - if FScanCurX = FScanWidth then //cycle - begin - FScanCurX := 0; - dec(FScanPtr, FRowSize); - end; - end - else - result := BGRAPixelTransparent; -end; - -function TBGRADefaultBitmap.ScanAt(X, Y: Single): TBGRAPixel; -var - ix, iy: Int32or64; - iFactX,iFactY: Int32or64; -begin - if (FScanWidth = 0) or (FScanHeight = 0) then - begin - result := BGRAPixelTransparent; - exit; - end; - LoadFromBitmapIfNeeded; - ix := round(x*256); - iy := round(y*256); - if ScanInterpolationFilter = rfBox then - begin - ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; - iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; - result := (GetScanlineFast(iy)+ix)^; - exit; - end; - iFactX := ix and 255; - iFactY := iy and 255; - ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; - iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; - if (iFactX = 0) and (iFactY = 0) then - begin - result := (GetScanlineFast(iy)+ix)^; - exit; - end; - if ScanInterpolationFilter <> rfLinear then - begin - iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter ); - iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter ); - end; - result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY); -end; - -function TBGRADefaultBitmap.IsScanPutPixelsDefined: boolean; -begin - Result:= true; -end; - -procedure TBGRADefaultBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer; - mode: TDrawMode); -var - i,nbCopy: Integer; - c: TBGRAPixel; -begin - if (FScanWidth <= 0) or (FScanHeight <= 0) then - begin - if mode = dmSet then - FillDWord(pdest^, count, LongWord(BGRAPixelTransparent)); - exit; - end; - case mode of - dmLinearBlend: - for i := 0 to count-1 do - begin - FastBlendPixelInline(pdest, ScanNextPixel); - inc(pdest); - end; - dmDrawWithTransparency: - for i := 0 to count-1 do - begin - DrawPixelInlineWithAlphaCheck(pdest, ScanNextPixel); - inc(pdest); - end; - dmSet: - while count > 0 do - begin - nbCopy := FScanWidth-FScanCurX; - if count < nbCopy then nbCopy := count; - move(FScanPtr^,pdest^,nbCopy*sizeof(TBGRAPixel)); - inc(pdest,nbCopy); - inc(FScanCurX,nbCopy); - inc(FScanPtr,nbCopy*sizeof(TBGRAPixel)); - if FScanCurX = FScanWidth then - begin - FScanCurX := 0; - dec(FScanPtr, RowSize); - end; - dec(count,nbCopy); - end; - dmSetExceptTransparent: - for i := 0 to count-1 do - begin - c := ScanNextPixel; - if c.alpha = 255 then pdest^ := c; - inc(pdest); - end; - dmXor: - for i := 0 to count-1 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(ScanNextPixel); - inc(pdest); - end; - end; -end; - -{ General purpose pixel drawing function } -procedure TBGRADefaultBitmap.DrawPixels(c: TBGRAPixel; start, Count: integer); -var - p: PBGRAPixel; -begin - if c.alpha = 0 then - exit; - if c.alpha = 255 then - begin - Fill(c,start,Count); - exit; - end; - - if start < 0 then - begin - inc(Count, start); - start := 0; - end; - if start >= nbPixels then - exit; - if start + Count > nbPixels then - Count := nbPixels - start; - - p := Data + start; - DrawPixelsInline(p,c,Count); - InvalidateBitmap; -end; - -{------------------------- End fill ------------------------------} - -procedure TBGRADefaultBitmap.DoAlphaCorrection; -var - p: PBGRAPixel; - n: integer; - colormask: LongWord; - changed: boolean; -begin - if CanvasAlphaCorrection then - begin - p := PBGRAPixel(FDataByte); // avoid Data to avoid reloading from bitmap and thus stack overflow - colormask := $ffffffff - (255 shl TBGRAPixel_AlphaShift); - changed := false; - for n := NbPixels - 1 downto 0 do - begin - if (plongword(p)^ and colormask <> 0) and (p^.alpha = 0) then - begin - p^.alpha := FCanvasOpacity; - changed := true; - end; - Inc(p); - end; - if changed then InvalidateBitmap; - end; - FAlphaCorrectionNeeded := False; -end; - -{ Ensure that transparent pixels have all channels to zero } -procedure TBGRADefaultBitmap.ClearTransparentPixels; -var - p: PBGRAPixel; - n: integer; -begin - p := Data; - for n := NbPixels - 1 downto 0 do - begin - if (p^.alpha = 0) then - p^ := BGRAPixelTransparent; - Inc(p); - end; - InvalidateBitmap; -end; - -function TBGRADefaultBitmap.CheckAntialiasRectBounds(var x, y, x2, y2: single; - w: single): boolean; -var - temp: Single; -begin - if (x > x2) then - begin - temp := x; - x := x2; - x2 := temp; - end; - if (y > y2) then - begin - temp := y; - y := y2; - y2 := temp; - end; - - result := (x2 - x > w) and (y2 - y > w); -end; - -function TBGRADefaultBitmap.GetCanvasBGRA: TBGRACanvas; -begin - if FCanvasBGRA = nil then - FCanvasBGRA := TBGRACanvas.Create(self); - result := FCanvasBGRA; -end; - -function TBGRADefaultBitmap.GetCanvas2D: TBGRACanvas2D; -begin - if FCanvas2D = nil then - FCanvas2D := TBGRACanvas2D.Create(self); - result := FCanvas2D; -end; - -procedure TBGRADefaultBitmap.PutImage(X, Y: integer; ASource: TCustomUniversalBitmap; - AMode: TDrawMode; AOpacity: byte); -begin - inherited PutImage(X,Y, ASource, AMode, AOpacity); - if (AMode in [dmSetExceptTransparent,dmDrawWithTransparency,dmLinearBlend]) and - (ASource is TBGRACustomBitmap) and Assigned(TBGRACustomBitmap(ASource).XorMask) then - PutImage(X,Y,TBGRACustomBitmap(ASource).XorMask,dmXor,AOpacity); -end; - -procedure TBGRADefaultBitmap.BlendImage(x, y: integer; ASource: TBGRACustomBitmap; - AOperation: TBlendOperation); -begin - BlendImage(RectWithSize(x,y,ASource.Width,ASource.Height), ASource, -x,-y,AOperation); -end; - -procedure TBGRADefaultBitmap.BlendImage(ADest: TRect; ASource: IBGRAScanner; - AOffsetX, AOffsetY: integer; AOperation: TBlendOperation); -const BufSize = 8; -var - yb, remain, i, delta_dest: integer; - psource, pdest: PBGRAPixel; - sourceRect: TRect; - sourceScanline, sourcePut: boolean; - buf: packed array[0..BufSize-1] of TBGRAPixel; -begin - if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; - - sourceRect := ADest; - sourceRect.Offset(AOffsetX, AOffsetY); - sourceScanline := ASource.ProvidesScanline(sourceRect); - sourcePut := ASource.IsScanPutPixelsDefined; - - pdest := Scanline[ADest.Top] + ADest.Left; - if LineOrder = riloBottomToTop then - delta_dest := -Width - else delta_dest := Width; - - for yb := sourceRect.Top to sourceRect.Bottom-1 do - begin - if sourceScanline then - begin - psource := ASource.GetScanlineAt(sourceRect.Left, yb); - BlendPixels(pdest, psource, AOperation, ADest.Width); - end else - begin - ASource.ScanMoveTo(sourceRect.Left, yb); - remain := ADest.Width; - if sourcePut then - while remain >= BufSize do - begin - ASource.ScanPutPixels(@buf, BufSize, dmSet); - BlendPixels(pdest, @buf, AOperation, BufSize); - inc(pdest, bufSize); - dec(remain, bufSize); - end; - if remain > 0 then - begin - for i := 0 to remain-1 do - buf[i] := ASource.ScanNextPixel; - BlendPixels(pdest, @buf, AOperation, remain); - inc(pdest, remain); - end; - dec(pdest, ADest.Width); - end; - Inc(pdest, delta_dest); - end; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.BlendImageOver(x, y: integer; - ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean); -begin - BlendImageOver(RectWithSize(x,y,ASource.Width,ASource.Height), ASource, -x,-y, - AOperation, AOpacity, ALinearBlend); -end; - -procedure TBGRADefaultBitmap.BlendImageOver(ADest: TRect; ASource: IBGRAScanner; - AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean); -const BufSize = 8; -var - yb, remain, i, delta_dest: integer; - psource, pdest: PBGRAPixel; - sourceRect: TRect; - sourceScanline, sourcePut: boolean; - buf: packed array[0..BufSize-1] of TBGRAPixel; -begin - if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; - - sourceRect := ADest; - sourceRect.Offset(AOffsetX, AOffsetY); - sourceScanline := ASource.ProvidesScanline(sourceRect); - sourcePut := ASource.IsScanPutPixelsDefined; - - pdest := Scanline[ADest.Top] + ADest.Left; - if LineOrder = riloBottomToTop then - delta_dest := -Width - else delta_dest := Width; - - for yb := sourceRect.Top to sourceRect.Bottom-1 do - begin - if sourceScanline then - begin - psource := ASource.GetScanlineAt(sourceRect.Left, yb); - BlendPixelsOver(pdest, psource, AOperation, ADest.Width, AOpacity, ALinearBlend); - end else - begin - ASource.ScanMoveTo(sourceRect.Left, yb); - remain := ADest.Width; - if sourcePut then - while remain >= BufSize do - begin - ASource.ScanPutPixels(@buf, BufSize, dmSet); - BlendPixelsOver(pdest, @buf, AOperation, BufSize, AOpacity, ALinearBlend); - inc(pdest, bufSize); - dec(remain, bufSize); - end; - if remain > 0 then - begin - for i := 0 to remain-1 do - buf[i] := ASource.ScanNextPixel; - BlendPixelsOver(pdest, @buf, AOperation, remain, AOpacity, ALinearBlend); - inc(pdest, remain); - end; - dec(pdest, ADest.Width); - end; - Inc(pdest, delta_dest); - end; - InvalidateBitmap; -end; - -{ Draw an image with an affine transformation (rotation, scale, translate). - Parameters are the bitmap origin, the end of the horizontal axis and the end of the vertical axis. - The output bounds correspond to the pixels that will be affected in the destination. } -procedure TBGRADefaultBitmap.PutImageAffine(AMatrix: TAffineMatrix; - Source: TBGRACustomBitmap; AOutputBounds: TRect; - AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte; APixelCenteredCoords: boolean); -var affine: TBGRAAffineBitmapTransform; - sourceBounds: TRect; -begin - if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit; - AOutputBounds.Intersect(ClipRect); - if AOutputBounds.IsEmpty then exit; - - if not APixelCenteredCoords then AMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5); - if IsAffineRoughlyTranslation(AMatrix, rect(0,0,Source.Width,Source.Height)) then - begin - sourceBounds := AOutputBounds; - sourceBounds.Offset(-round(AMatrix[1,3]), -round(AMatrix[2,3])); - sourceBounds.Intersect( rect(0,0,Source.Width,Source.Height) ); - PutImagePart(round(AMatrix[1,3])+sourceBounds.Left,round(AMatrix[2,3])+sourceBounds.Top,Source,sourceBounds,AMode,AOpacity); - end else - begin - affine := TBGRAAffineBitmapTransform.Create(Source, false, AResampleFilter); - affine.GlobalOpacity := AOpacity; - affine.ViewMatrix := AMatrix; - FillRect(AOutputBounds,affine,AMode); - affine.Free; - end; -end; - -function TBGRADefaultBitmap.GetImageAffineBounds(AMatrix: TAffineMatrix; - ASourceBounds: TRect; AClipOutput: boolean; APixelCenteredCoords: boolean): TRect; -const pointMargin = 0.5 - 1/512; - - procedure FirstPoint(pt: TPointF); - begin - result.Left := round(pt.X); - result.Top := round(pt.Y); - result.Right := round(pt.X)+1; - result.Bottom := round(pt.Y)+1; - end; - - //include specified point in the bounds - procedure IncludePoint(pt: TPointF); - begin - if round(pt.X) < result.Left then result.Left := round(pt.X); - if round(pt.Y) < result.Top then result.Top := round(pt.Y); - if round(pt.X)+1 > result.Right then result.Right := round(pt.X)+1; - if round(pt.Y)+1 > result.Bottom then result.Bottom := round(pt.Y)+1; - end; - -begin - result := EmptyRect; - if ASourceBounds.IsEmpty then exit; - - if not APixelCenteredCoords then AMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5); - if IsAffineRoughlyTranslation(AMatrix,ASourceBounds) then - begin - result := ASourceBounds; - result.Offset(round(AMatrix[1,3]), round(AMatrix[2,3])); - end else - begin - FirstPoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Top-pointMargin)); - IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Top-pointMargin)); - IncludePoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Bottom-1+pointMargin)); - IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Bottom-1+pointMargin)); - end; - if AClipOutput then result.Intersect(ClipRect); -end; - -procedure TBGRADefaultBitmap.StretchPutImage(ARect: TRect; - Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte); -var noTransition: boolean; -begin - If (Source = nil) or (AOpacity = 0) then exit; - if (ARect.Right-ARect.Left = Source.Width) and (ARect.Bottom-ARect.Top = Source.Height) then - PutImage(ARect.Left,ARect.Top,Source,mode,AOpacity) - else - begin - noTransition:= (mode = dmXor) or ((mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and - (Source is TBGRADefaultBitmap) and - Assigned(TBGRADefaultBitmap(Source).XorMask)); - BGRAResample.StretchPutImage(Source, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, mode, AOpacity, noTransition); - if (mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and Assigned(TBGRADefaultBitmap(Source).XorMask) then - BGRAResample.StretchPutImage(TBGRADefaultBitmap(Source).XorMask, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, dmXor, AOpacity, noTransition); - end; -end; - -procedure TBGRADefaultBitmap.BlendRect(ADest: TRect; AColor: TBGRAPixel; - AOperation: TBlendOperation; AExcludeChannels: TChannels); -const BufSize = 8; -var srcBuf: packed array[0..BufSize-1] of TBGRAPixel; - i, yb, remain: Integer; - p: PBGRAPixel; -begin - if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; - for i := 0 to BufSize-1 do - srcBuf[i] := AColor; - for yb := ADest.Top to ADest.Bottom-1 do - begin - remain := ADest.Width; - p := PBGRAPixel(GetPixelAddress(ADest.Left, yb)); - while remain >= BufSize do - begin - BlendPixels(p, @srcBuf, AOperation, BufSize, AExcludeChannels); - inc(p, BufSize); - dec(remain, BufSize); - end; - if remain > 0 then - BlendPixels(p, @srcBuf, AOperation, remain, AExcludeChannels); - end; -end; - -procedure TBGRADefaultBitmap.BlendRectOver(ADest: TRect; AColor: TBGRAPixel; - AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; - AExcludeChannels: TChannels); -const BufSize = 8; -var srcBuf: packed array[0..BufSize-1] of TBGRAPixel; - i, yb, remain: Integer; - p: PBGRAPixel; -begin - if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit; - for i := 0 to BufSize-1 do - srcBuf[i] := AColor; - for yb := ADest.Top to ADest.Bottom-1 do - begin - remain := ADest.Width; - p := PBGRAPixel(GetPixelAddress(ADest.Left, yb)); - while remain >= BufSize do - begin - BlendPixelsOver(p, @srcBuf, AOperation, BufSize, AOpacity, ALinearBlend, AExcludeChannels); - inc(p, BufSize); - dec(remain, BufSize); - end; - if remain > 0 then - BlendPixelsOver(p, @srcBuf, AOperation, remain, AOpacity, ALinearBlend, AExcludeChannels); - end; -end; - -{----------------------------- Filters -----------------------------------------} -{ Call the appropriate function } - -function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterSmartZoom3(self, Option) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterMedian(self, option) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterSmooth: TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterBlurRadial(self, 3, rbPrecise) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterSphere: TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterSphere(self) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterTwirl(self, ACenter, ARadius, ATurn, AExponent) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint; - ARadius: Single; ATurn: Single; AExponent: Single): TBGRADefaultBitmap; -begin - result := BGRAFilters.FilterTwirl(self, ABounds, ACenter, ARadius, ATurn, AExponent) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterCylinder: TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterCylinder(self) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterPlane: TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterPlane(self) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterSharpen(Amount: single = 1): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterSharpen(self,round(Amount*256)) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterSharpen(ABounds: TRect; Amount: single - ): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterSharpen(self,ABounds,round(Amount*256)) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterContour(AGammaCorrection: boolean = false): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterContour(self, AGammaCorrection) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer; - useResample: boolean; filter: TResampleFilter): TBGRADefaultBitmap; -begin - Result:= BGRAFilters.FilterPixelate(self, pixelSize, useResample, filter) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterEmboss(angle: single; - AStrength: integer; AOptions: TEmbossOptions): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterEmboss(self, angle, AStrength, AOptions) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterEmboss(angle: single; ABounds: TRect; - AStrength: integer; AOptions: TEmbossOptions): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterEmboss(self, angle, ABounds, AStrength, AOptions) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean): -TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BGRAPixelTransparent) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean; - BorderColor: TBGRAPixel): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BorderColor) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean; - BorderColor: TBGRAPixel; var Offset: TPoint): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterEmbossHighlightOffset(self, FillSelection, BorderColor, Offset) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterGrayscale: TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterGrayscale(self) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterGrayscale(ABounds: TRect): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterGrayscale(self, ABounds) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterNormalize(eachChannel: boolean = True): -TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterNormalize(self, eachChannel) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterNormalize(self, ABounds, eachChannel) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterRotate(origin: TPointF; - angle: single; correctBlur: boolean): TBGRADefaultBitmap; -begin - Result := BGRAFilters.FilterRotate(self, origin, angle, correctBlur) as TBGRADefaultBitmap; -end; - -function TBGRADefaultBitmap.FilterAffine(AMatrix: TAffineMatrix; - correctBlur: boolean): TBGRADefaultBitmap; -begin - Result := NewBitmap(Width,Height); - Result.PutImageAffine(AMatrix,self,255,correctBlur); -end; - -function TBGRADefaultBitmap.GetHasTransparentPixels: boolean; -var - p: PBGRAPixel; - n: integer; -begin - p := Data; - for n := NbPixels - 1 downto 0 do - begin - if p^.alpha <> 255 then - begin - Result := True; - exit; - end; - Inc(p); - end; - Result := False; -end; - -function TBGRADefaultBitmap.GetHasSemiTransparentPixels: boolean; -var - n: integer; - p: PBGRAPixel; -begin - p := Data; - for n := NbPixels - 1 downto 0 do - begin - if (p^.alpha > 0) and (p^.alpha < 255) then - begin - result := true; - exit; - end; - inc(p); - end; - result := false; -end; - -function TBGRADefaultBitmap.GetAverageColor: TColor; -var - pix: TBGRAPixel; -begin - pix := GetAveragePixel; - {$hints off} - if pix.alpha = 0 then - result := clNone else - result := RGBToColor(pix.red,pix.green,pix.blue); - {$hints on} -end; - -function TBGRADefaultBitmap.GetAveragePixel: TBGRAPixel; -var - n: integer; - p: PBGRAPixel; - r, g, b, sum: double; - alpha: double; -begin - sum := 0; - r := 0; - g := 0; - b := 0; - p := Data; - for n := NbPixels - 1 downto 0 do - begin - alpha := p^.alpha / 255; - incF(sum, alpha); - incF(r, p^.red * alpha); - incF(g, p^.green * alpha); - incF(b, p^.blue * alpha); - Inc(p); - end; - if sum = 0 then - Result := BGRAPixelTransparent - else - Result := BGRA(round(r / sum),round(g / sum),round(b / sum),round(sum*255/NbPixels)); -end; - -function TBGRADefaultBitmap.GetPenJoinStyle: TPenJoinStyle; -begin - result := GetInternalPen.JoinStyle; -end; - -procedure TBGRADefaultBitmap.SetPenJoinStyle(const AValue: TPenJoinStyle); -begin - GetInternalPen.JoinStyle := AValue; -end; - -function TBGRADefaultBitmap.GetPenMiterLimit: single; -begin - result := GetInternalPen.MiterLimit; -end; - -procedure TBGRADefaultBitmap.SetPenMiterLimit(const AValue: single); -begin - GetInternalPen.MiterLimit := AValue; -end; - -procedure TBGRADefaultBitmap.SetCanvasOpacity(AValue: byte); -begin - LoadFromBitmapIfNeeded; - FCanvasOpacity := AValue; -end; - -{----------------------------- Resample ---------------------------------------} - -function TBGRADefaultBitmap.FineResample(NewWidth, NewHeight: integer): -TBGRACustomBitmap; -begin - Result := BGRAResample.FineResample(self, NewWidth, NewHeight, ResampleFilter); -end; - -function TBGRADefaultBitmap.SimpleStretch(NewWidth, NewHeight: integer): -TBGRACustomBitmap; -begin - Result := BGRAResample.SimpleStretch(self, NewWidth, NewHeight); -end; - -function TBGRADefaultBitmap.Resample(newWidth, newHeight: integer; - mode: TResampleMode): TBGRADefaultBitmap; -begin - case mode of - rmFineResample: Result := FineResample(newWidth, newHeight) as TBGRADefaultBitmap; - rmSimpleStretch: Result := SimpleStretch(newWidth, newHeight) as TBGRADefaultBitmap; - else - Result := nil; - end; -end; - -{-------------------------------- Data functions ------------------------} - -{ Compute negative with gamma correction. A negative contains - complentary colors (black becomes white etc.). - - It is NOT EXACTLY an involution, when applied twice, some color information is lost } -procedure TBGRADefaultBitmap.Negative; -begin - TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), True); -end; - -procedure TBGRADefaultBitmap.NegativeRect(ABounds: TRect); -begin - ABounds.Intersect(ClipRect); - if ABounds.IsEmpty then exit; - TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, True); -end; - -{ Compute negative without gamma correction. - - It is an involution, i.e it does nothing when applied twice } -procedure TBGRADefaultBitmap.LinearNegative; -begin - TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False); -end; - -procedure TBGRADefaultBitmap.LinearNegativeRect(ABounds: TRect); -begin - ABounds.Intersect(ClipRect); - if ABounds.IsEmpty then exit; - TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, False); -end; - -procedure TBGRADefaultBitmap.InplaceGrayscale(AGammaCorrection: boolean = true); -begin - TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), AGammaCorrection); -end; - -procedure TBGRADefaultBitmap.InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); -begin - ABounds.Intersect(ClipRect); - if ABounds.IsEmpty then exit; - TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, ABounds, AGammaCorrection); -end; - -procedure TBGRADefaultBitmap.InplaceNormalize(AEachChannel: boolean); -begin - InplaceNormalize(rect(0,0,Width,Height),AEachChannel); -end; - -procedure TBGRADefaultBitmap.InplaceNormalize(ABounds: TRect; - AEachChannel: boolean); -var scanner: TBGRAFilterScannerNormalize; -begin - ABounds.Intersect(ClipRect); - if ABounds.IsEmpty then exit; - scanner := TBGRAFilterScannerNormalize.Create(self,Point(0,0),ABounds,AEachChannel); - FillRect(ABounds,scanner,dmSet); - scanner.Free; -end; - -{ Swap red and blue channels. Useful when RGB order is swapped. - - It is an involution, i.e it does nothing when applied twice } -procedure TBGRADefaultBitmap.SwapRedBlue; -begin - TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False); -end; - -procedure TBGRADefaultBitmap.SwapRedBlue(ARect: TRect); -begin - if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit; - TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, ARect, False); -end; - -{ Convert a grayscale image into a black image with alpha value } -procedure TBGRADefaultBitmap.GrayscaleToAlpha; -var - n: integer; - p: PLongword; -begin - LoadFromBitmapIfNeeded; - p := PLongword(Data); - n := NbPixels; - if n = 0 then - exit; - repeat - p^ := (p^ shr TBGRAPixel_RedShift and $FF) shl TBGRAPixel_AlphaShift; - Inc(p); - Dec(n); - until n = 0; - InvalidateBitmap; -end; - -procedure TBGRADefaultBitmap.AlphaToGrayscale; -var - n: integer; - temp: LongWord; - p: PLongword; -begin - LoadFromBitmapIfNeeded; - p := PLongword(Data); - n := NbPixels; - if n = 0 then - exit; - repeat - temp := (p^ shr TBGRAPixel_AlphaShift) and $ff; - p^ := (temp shl TBGRAPixel_RedShift) or (temp shl TBGRAPixel_GreenShift) - or (temp shl TBGRAPixel_BlueShift) or ($ff shl TBGRAPixel_AlphaShift); - Inc(p); - Dec(n); - until n = 0; - InvalidateBitmap; -end; - -function TBGRADefaultBitmap.GetMaskFromAlpha: TBGRADefaultBitmap; -var y,x: integer; - psrc, pdest: PBGRAPixel; -begin - result := BGRABitmapFactory.Create(Width,Height) as TBGRADefaultBitmap; - for y := 0 to self.Height-1 do - begin - psrc := self.ScanLine[y]; - pdest := result.ScanLine[y]; - for x := 0 to self.Width-1 do - begin - pdest^ := BGRA(psrc^.alpha,psrc^.alpha,psrc^.alpha); - inc(psrc); - inc(pdest); - end; - end; -end; - -function TBGRADefaultBitmap.GetGrayscaleMaskFromAlpha: TGrayscaleMask; -var - psrc: PBGRAPixel; - pdest: PByte; - y, x: Integer; -begin - result := TGrayscaleMask.Create; - result.SetSize(Width,Height); - for y := 0 to self.Height-1 do - begin - psrc := self.ScanLine[y]; - pdest := result.ScanLine[y]; - for x := 0 to self.Width-1 do - begin - pdest^ := psrc^.alpha; - inc(psrc); - inc(pdest); - end; - end; -end; - -procedure TBGRADefaultBitmap.ConvertToLinearRGB; -var p: PBGRAPixel; - n: integer; -begin - p := Data; - for n := NbPixels-1 downto 0 do - begin - p^.red := GammaExpansionTab[p^.red] shr 8; - p^.green := GammaExpansionTab[p^.green] shr 8; - p^.blue := GammaExpansionTab[p^.blue] shr 8; - inc(p); - end; -end; - -procedure TBGRADefaultBitmap.ConvertFromLinearRGB; -var p: PBGRAPixel; - n: integer; -begin - p := Data; - for n := NbPixels-1 downto 0 do - begin - p^.red := GammaCompressionTab[p^.red shl 8 + p^.red]; - p^.green := GammaCompressionTab[p^.green shl 8 + p^.green]; - p^.blue := GammaCompressionTab[p^.blue shl 8 + p^.blue]; - inc(p); - end; -end; - -{ Make a copy of the transparent bitmap to a TBitmap with a background color - instead of transparency } -function TBGRADefaultBitmap.MakeBitmapCopy(BackgroundColor: TColor): TBitmap; -var - opaqueCopy: TBGRACustomBitmap; -begin - Result := TBitmap.Create; - Result.Width := Width; - Result.Height := Height; - opaqueCopy := NewBitmap(Width, Height); - opaqueCopy.Fill(BackgroundColor); - opaqueCopy.PutImage(0, 0, self, dmDrawWithTransparency); - opaqueCopy.Draw(Result.canvas, 0, 0, True); - opaqueCopy.Free; -end; - -function TBGRADefaultBitmap.GetPtrBitmap(Top, Bottom: Integer - ): TBGRACustomBitmap; -var temp: integer; - ptrbmp: TBGRAPtrBitmap; -begin - if Top > Bottom then - begin - temp := Top; - Top := Bottom; - Bottom := Temp; - end; - if Top < 0 then Top := 0; - if Bottom > Height then Bottom := Height; - if Top >= Bottom then - result := nil - else - begin - if LineOrder = riloTopToBottom then - ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Top]) else - ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Bottom-1]); - ptrbmp.LineOrder := LineOrder; - result := ptrbmp; - end; -end; - -{-------------------------- Allocation routines -------------------------------} - -function TBGRADefaultBitmap.CreatePtrBitmap(AWidth, AHeight: integer; - AData: PBGRAPixel): TBGRAPtrBitmap; -begin - result := TBGRAPtrBitmap.Create(AWidth,AHeight,AData); -end; - -procedure TBGRADefaultBitmap.FreeBitmap; -begin - FreeAndNil(FBitmap); -end; - -function TBGRADefaultBitmap.GetCanvasOpacity: byte; -begin - result:= FCanvasOpacity; -end; - -function TBGRADefaultBitmap.GetFontHeight: integer; -begin - result := FFontHeight; -end; - -{ TBGRAPtrBitmap } - -function TBGRAPtrBitmap.GetLineOrder: TRawImageLineOrder; -begin - result := inherited GetLineOrder; -end; - -procedure TBGRAPtrBitmap.SetLineOrder(AValue: TRawImageLineOrder); -begin - inherited SetLineOrder(AValue); -end; - -procedure TBGRAPtrBitmap.ReallocData; -begin - //nothing -end; - -procedure TBGRAPtrBitmap.FreeData; -begin - FDataByte := nil; -end; - -procedure TBGRAPtrBitmap.CannotResize; -begin - raise exception.Create('A pointer bitmap cannot be resized'); -end; - -procedure TBGRAPtrBitmap.NotImplemented; -begin - raise exception.Create('Not implemented'); -end; - -procedure TBGRAPtrBitmap.RebuildBitmap; -begin - NotImplemented; -end; - -function TBGRAPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; -begin - result := nil; - NotImplemented; -end; - -function TBGRAPtrBitmap.LoadFromRawImage(ARawImage: TRawImage; - DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; - RaiseErrorOnInvalidPixelFormat: boolean): boolean; -begin - result := false; - NotImplemented; -end; - -constructor TBGRAPtrBitmap.Create(AWidth, AHeight: integer; AData: Pointer); -begin - inherited Create(AWidth, AHeight); - SetDataPtr(AData); -end; - -procedure TBGRAPtrBitmap.SetDataPtr(AData: Pointer); -begin - FDataByte := AData; -end; - -procedure TBGRAPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - NotImplemented; -end; - -procedure TBGRAPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - NotImplemented; -end; - -procedure TBGRAPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer - ); -begin - NotImplemented; -end; - -procedure TBGRAPtrBitmap.Assign(Source: TPersistent); -begin - CannotResize; -end; - -procedure TBGRAPtrBitmap.TakeScreenshot(ARect: TRect); -begin - CannotResize; -end; - -procedure TBGRAPtrBitmap.TakeScreenshotOfPrimaryMonitor; -begin - CannotResize; -end; - -procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC); -begin - NotImplemented; -end; - -procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC; ARect: TRect); -begin - NotImplemented; -end; - -procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer; - c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode; - gammaColorCorrection: boolean = True; Sinus: Boolean=False); -begin - bmp.GradientFill(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus); -end; - -initialization - - with DefaultTextStyle do - begin - Alignment := taLeftJustify; - Layout := tlTop; - WordBreak := True; - SingleLine := True; - Clipping := True; - ShowPrefix := False; - Opaque := False; - end; - -end. - diff --git a/components/bgrabitmap/bgradithering.pas b/components/bgrabitmap/bgradithering.pas deleted file mode 100644 index 91b532f..0000000 --- a/components/bgrabitmap/bgradithering.pas +++ /dev/null @@ -1,761 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRADithering; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAFilterType, BGRAPalette, BGRABitmapTypes; - -type - TOutputPixelProc = procedure(X,Y: Int32or64; AColorIndex: Int32or64; AColor: TBGRAPixel) of object; - - { TDitheringTask } - - TDitheringTask = class(TFilterTask) - protected - FBounds: TRect; - FIgnoreAlpha: boolean; - FPalette: TBGRACustomApproxPalette; - FCurrentOutputScanline: PBGRAPixel; - FCurrentOutputY: Int32or64; - FOutputPixel : TOutputPixelProc; - FDrawMode: TDrawMode; - procedure UpdateCurrentLine(Y: Int32or64); inline; - procedure OutputPixel(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; - procedure OutputPixelSet(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; - procedure OutputPixelSetExceptTransparent(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; - procedure OutputPixelLinearBlend(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; - procedure OutputPixelDraw(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; - procedure OutputPixelXor(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual; - procedure ApproximateColor(const AColor: TBGRAPixel; out AApproxColor: TBGRAPixel; out AIndex: integer); - procedure SetDrawMode(AValue: TDrawMode); - procedure UpdateOutputPixel; - public - constructor Create(ASource: IBGRAScanner; APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap; AIgnoreAlpha: boolean; ABounds: TRect); overload; - constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean; ABounds: TRect); overload; - constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean); overload; - property OnOutputPixel: TOutputPixelProc read FOutputPixel write FOutputPixel; - property DrawMode: TDrawMode read FDrawMode write SetDrawMode; - end; - - { TNearestColorTask } - - TNearestColorTask = class(TDitheringTask) - protected - procedure DoExecute; override; - end; - - { TFloydSteinbergDitheringTask } - - TFloydSteinbergDitheringTask = class(TDitheringTask) - protected - procedure DoExecute; override; - end; - - { TDitheringToIndexedImage } - - TDitheringToIndexedImage = class - protected - FBitOrder: TRawImageBitOrder; - FByteOrder: TRawImageByteOrder; - FBitsPerPixel: integer; - FLineOrder: TRawImageLineOrder; - FPalette: TBGRACustomApproxPalette; - FIgnoreAlpha: boolean; - FTransparentColorIndex: Int32or64; - - //following variables are used during dithering - FCurrentScanlineSize: PtrInt; - FCurrentData: PByte; - FCurrentOutputY: Int32or64; - FCurrentOutputScanline: PByte; - FCurrentBitOrderMask: Int32or64; - FCurrentMaxY: Int32or64; - - procedure SetPalette(AValue: TBGRACustomApproxPalette); - procedure SetIgnoreAlpha(AValue: boolean); - procedure SetLineOrder(AValue: TRawImageLineOrder); - procedure SetBitOrder(AValue: TRawImageBitOrder); virtual; - procedure SetBitsPerPixel(AValue: integer); virtual; - procedure SetByteOrder(AValue: TRawImageByteOrder); virtual; - procedure OutputPixelSubByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual; - procedure OutputPixelFullByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual; - function GetScanline(Y: Int32or64): Pointer; virtual; - function GetTransparentColorIndex: integer; - procedure SetTransparentColorIndex(AValue: integer); - public - constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer); overload; //use platform byte order - constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer; AByteOrder: TRawImageByteOrder); overload; //maybe necessary if larger than 8 bits per pixel - - function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap): Pointer; overload; //use minimum scanline size - function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer; overload; - procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer); overload; //use minimum scanline size - procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt); overload; - function ComputeMinimumScanlineSize(AWidthInPixels: integer): PtrInt; - function AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): pointer; - - //optional customization of format - property BitsPerPixel: integer read FBitsPerPixel write SetBitsPerPixel; - property BitOrder: TRawImageBitOrder read FBitOrder write SetBitOrder; - property ByteOrder: TRawImageByteOrder read FByteOrder write SetByteOrder; - property LineOrder: TRawImageLineOrder read FLineOrder write SetLineOrder; - - property Palette: TBGRACustomApproxPalette read FPalette write SetPalette; - property IgnoreAlpha: boolean read FIgnoreAlpha write SetIgnoreAlpha; - - //when there is no transparent color in the palette, or that IgnoreAlpha is set to True, - //this allows to define the index for the fully transparent color - property DefaultTransparentColorIndex: integer read GetTransparentColorIndex write SetTransparentColorIndex; - end; - -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; - AIgnoreAlpha: boolean): TDitheringTask; overload; -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; - AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload; -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect): TDitheringTask; overload; -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; - AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload; - -function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap; - -implementation - -uses BGRABlend; - -function AbsRGBADiff(const c1, c2: TExpandedPixel): Int32or64; -begin - result := abs(c1.alpha-c2.alpha); - inc(result, abs(c1.red-c2.red) ); - inc(result, abs(c1.green-c2.green) ); - inc(result, abs(c1.blue-c2.blue) ); -end; - -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; - AIgnoreAlpha: boolean): TDitheringTask; -begin - result := CreateDitheringTask(AAlgorithm, ABitmap, APalette, AIgnoreAlpha, rect(0,0,ABitmap.width, ABitmap.Height)); -end; - -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; - AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; -begin - result := nil; - case AAlgorithm of - daNearestNeighbor: result := TNearestColorTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds); - daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds); - else raise exception.Create('Unknown algorithm'); - end; -end; - -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; - ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect - ): TDitheringTask; -begin - result := CreateDitheringTask(AAlgorithm, ASource, ADestination, nil, true, ABounds); -end; - -function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; - ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; - APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABounds: TRect - ): TDitheringTask; -begin - result := nil; - case AAlgorithm of - daNearestNeighbor: result := TNearestColorTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds); - daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds); - else raise exception.Create('Unknown algorithm'); - end; -end; - -function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm; - ABitmap: TBGRACustomBitmap): TBGRACustomBitmap; -var - palette16bit: TBGRA16BitPalette; - dither: TDitheringTask; -begin - palette16bit := TBGRA16BitPalette.Create; - dither := CreateDitheringTask(AAlgorithm, ABitmap, palette16bit, false); - result := dither.Execute; - dither.Free; - palette16bit.Free; -end; - -{ TDitheringToIndexedImage } - -procedure TDitheringToIndexedImage.SetBitsPerPixel(AValue: integer); -begin - if not (AValue in [1,2,4,8,16,32]) then - raise exception.Create('Invalid value for bits per pixel. Allowed values: 1,2,4,8,16,32.'); - if FBitsPerPixel=AValue then Exit; - FBitsPerPixel:=AValue; -end; - -procedure TDitheringToIndexedImage.SetByteOrder(AValue: TRawImageByteOrder); -begin - if FByteOrder=AValue then Exit; - FByteOrder:=AValue; -end; - -procedure TDitheringToIndexedImage.OutputPixelSubByte(X, Y: Int32or64; - AColorIndex: Int32or64; AColor: TBGRAPixel); -var p: PByte; -begin - if y <> FCurrentOutputY then - begin - FCurrentOutputY := y; - FCurrentOutputScanline := GetScanline(Y); - end; - if AColorIndex = -1 then AColorIndex := FTransparentColorIndex; - case FBitsPerPixel of - 1: begin - p := FCurrentOutputScanline+(x shr 3); - p^ := p^ or ((AColorIndex and 1) shl ((x xor FCurrentBitOrderMask) and 7)); - end; - 2: begin - p := FCurrentOutputScanline+(x shr 2); - p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 3) shl 1)); - end; - 4: begin - p := FCurrentOutputScanline+(x shr 1); - p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 1) shl 2)); - end; - end; -end; - -procedure TDitheringToIndexedImage.OutputPixelFullByte(X, Y: Int32or64; - AColorIndex: Int32or64; AColor: TBGRAPixel); -begin - if y <> FCurrentOutputY then - begin - FCurrentOutputY := y; - FCurrentOutputScanline := GetScanline(Y); - end; - if AColorIndex = -1 then AColorIndex := FTransparentColorIndex; - case FBitsPerPixel of - 8: (FCurrentOutputScanline+x)^ := AColorIndex; - 16: (PWord(FCurrentOutputScanline)+x)^ := AColorIndex; - 32: (PLongWord(FCurrentOutputScanline)+x)^ := AColorIndex; - end; -end; - -function TDitheringToIndexedImage.GetScanline(Y: Int32or64): Pointer; -begin - if FLineOrder = riloTopToBottom then - result := FCurrentData + Y*FCurrentScanlineSize - else - result := FCurrentData + (FCurrentMaxY-Y)*FCurrentScanlineSize -end; - -procedure TDitheringToIndexedImage.SetIgnoreAlpha(AValue: boolean); -begin - if FIgnoreAlpha=AValue then Exit; - FIgnoreAlpha:=AValue; -end; - -procedure TDitheringToIndexedImage.SetTransparentColorIndex(AValue: integer); -begin - if FTransparentColorIndex=AValue then Exit; - FTransparentColorIndex:=AValue; -end; - -function TDitheringToIndexedImage.GetTransparentColorIndex: integer; -begin - result := FTransparentColorIndex; -end; - -procedure TDitheringToIndexedImage.SetPalette(AValue: TBGRACustomApproxPalette); -begin - if FPalette=AValue then Exit; - FPalette:=AValue; -end; - -procedure TDitheringToIndexedImage.SetLineOrder(AValue: TRawImageLineOrder); -begin - if FLineOrder=AValue then Exit; - FLineOrder:=AValue; -end; - -procedure TDitheringToIndexedImage.SetBitOrder(AValue: TRawImageBitOrder); -begin - if FBitOrder=AValue then Exit; - FBitOrder:=AValue; -end; - -constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer); -begin - BitsPerPixel:= ABitsPerPixelForIndices; - BitOrder := riboReversedBits; //convention in BMP format - {$IFDEF ENDIAN_LITTLE} - ByteOrder:= riboLSBFirst; - {$ELSE} - ByteOrder:= riboMSBFirst; - {$ENDIF} - Palette := APalette; - IgnoreAlpha:= AIgnoreAlpha; -end; - -constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer; - AByteOrder: TRawImageByteOrder); -begin - BitsPerPixel:= ABitsPerPixelForIndices; - BitOrder := riboReversedBits; //convention in BMP format - ByteOrder:= AByteOrder; - Palette := APalette; - IgnoreAlpha:= AIgnoreAlpha; -end; - -function TDitheringToIndexedImage.ComputeMinimumScanlineSize( - AWidthInPixels: integer): PtrInt; -begin - result := (AWidthInPixels*FBitsPerPixel+7) shr 3; -end; - -function TDitheringToIndexedImage.AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap; - AScanlineSize: PtrInt): pointer; -var size: integer; -begin - size := AScanlineSize * AImage.Height; - GetMem(result, size); - Fillchar(result^, size, 0); -end; - -function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm; - AImage: TBGRACustomBitmap): Pointer; -begin - result := DitherImage(AAlgorithm, AImage, ComputeMinimumScanlineSize(AImage.Width)); -end; - -procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm; - AImage: TBGRACustomBitmap; AData: Pointer); -begin - DitherImageTo(AAlgorithm, AImage, AData, ComputeMinimumScanlineSize(AImage.Width)); -end; - -function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm; - AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer; -begin - result := AllocateSpaceForIndexedData(AImage, AScanlineSize); - DitherImageTo(AAlgorithm, AImage, result, AScanlineSize); -end; - -procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm; - AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt); -var ditherTask: TDitheringTask; -begin - FCurrentOutputY := -1; - FCurrentOutputScanline := nil; - FCurrentData := AData; - FCurrentMaxY:= AImage.Height-1; - FCurrentScanlineSize:= AScanlineSize; - - ditherTask := CreateDitheringTask(AAlgorithm, AImage, FPalette, FIgnoreAlpha); - try - ditherTask.Inplace := True; //do not allocate destination - if BitsPerPixel >= 8 then - ditherTask.OnOutputPixel := @OutputPixelFullByte - else - begin - ditherTask.OnOutputPixel:= @OutputPixelSubByte; - if BitOrder = riboBitsInOrder then - FCurrentBitOrderMask := 0 - else - FCurrentBitOrderMask := $ff; - end; - ditherTask.Execute; - finally - ditherTask.Free; - end; -end; - -{ TDitheringTask } - -procedure TDitheringTask.SetDrawMode(AValue: TDrawMode); -begin - if FDrawMode=AValue then Exit; - FDrawMode:=AValue; - UpdateOutputPixel; -end; - -procedure TDitheringTask.UpdateOutputPixel; -begin - case FDrawMode of - dmSet: FOutputPixel := @OutputPixelSet; - dmSetExceptTransparent: FOutputPixel := @OutputPixelSetExceptTransparent; - dmLinearBlend: FOutputPixel := @OutputPixelLinearBlend; - dmXor: FOutputPixel := @OutputPixelXor; - else - {dmDrawWithTransparency} FOutputPixel := @OutputPixelDraw; - end; -end; - -procedure TDitheringTask.UpdateCurrentLine(Y: Int32or64); -begin - if Y <> FCurrentOutputY then - begin - FCurrentOutputY := Y; - FCurrentOutputScanline := Destination.ScanLine[y]; - end; -end; - -procedure TDitheringTask.OutputPixel(X, Y: Int32or64; AColorIndex: Int32or64; - AColor: TBGRAPixel); -begin - UpdateCurrentLine(y); - PutPixels(FCurrentOutputScanline+x, @AColor, 1, FDrawMode, 255); -end; - -procedure TDitheringTask.OutputPixelSet(X, Y: Int32or64; - AColorIndex: Int32or64; AColor: TBGRAPixel); -begin - UpdateCurrentLine(y); - (FCurrentOutputScanline+x)^ := AColor; -end; - -procedure TDitheringTask.OutputPixelSetExceptTransparent(X, Y: Int32or64; - AColorIndex: Int32or64; AColor: TBGRAPixel); -begin - UpdateCurrentLine(y); - if AColor.alpha = 255 then (FCurrentOutputScanline+x)^ := AColor; -end; - -procedure TDitheringTask.OutputPixelLinearBlend(X, Y: Int32or64; - AColorIndex: Int32or64; AColor: TBGRAPixel); -begin - UpdateCurrentLine(y); - FastBlendPixelInline(FCurrentOutputScanline+x, AColor); -end; - -procedure TDitheringTask.OutputPixelDraw(X, Y: Int32or64; - AColorIndex: Int32or64; AColor: TBGRAPixel); -begin - UpdateCurrentLine(y); - DrawPixelInlineWithAlphaCheck(FCurrentOutputScanline+x, AColor); -end; - -procedure TDitheringTask.OutputPixelXor(X, Y: Int32or64; - AColorIndex: Int32or64; AColor: TBGRAPixel); -begin - UpdateCurrentLine(y); - PLongWord(FCurrentOutputScanline+x)^ := PLongWord(FCurrentOutputScanline+x)^ xor PLongWord(@AColor)^; -end; - -procedure TDitheringTask.ApproximateColor(const AColor: TBGRAPixel; - out AApproxColor: TBGRAPixel; out AIndex: integer); -begin - if FPalette <> nil then - begin - AIndex := FPalette.FindNearestColorIndex(AColor, FIgnoreAlpha); - if AIndex = -1 then - AApproxColor := BGRAPixelTransparent - else - AApproxColor := FPalette.Color[AIndex]; - end else - begin - if AColor.alpha = 0 then - begin - AApproxColor := BGRAPixelTransparent; - AIndex := -1; - end else - begin - AApproxColor := AColor; - AIndex := 0; - end; - end; -end; - -constructor TDitheringTask.Create(ASource: IBGRAScanner; - APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap; - AIgnoreAlpha: boolean; ABounds: TRect); -begin - FPalette := APalette; - SetSource(ASource); - FBounds := ABounds; - FIgnoreAlpha:= AIgnoreAlpha; - FCurrentOutputY := -1; - FCurrentOutputScanline:= nil; - Destination := ADestination; - FDrawMode:= dmSet; - UpdateOutputPixel; -end; - -constructor TDitheringTask.Create(bmp: TBGRACustomBitmap; - APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean; - ABounds: TRect); -begin - FPalette := APalette; - SetSource(bmp); - FBounds := ABounds; - FIgnoreAlpha:= AIgnoreAlpha; - FCurrentOutputY := -1; - FCurrentOutputScanline:= nil; - InPlace := AInPlace; - FDrawMode:= dmSet; - UpdateOutputPixel; -end; - -constructor TDitheringTask.Create(bmp: TBGRACustomBitmap; - APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean); -begin - FPalette := APalette; - SetSource(bmp); - FBounds := rect(0,0,bmp.Width,bmp.Height); - FIgnoreAlpha:= AIgnoreAlpha; - FCurrentOutputY := -1; - FCurrentOutputScanline:= nil; - InPlace := AInPlace; - FDrawMode:= dmSet; - UpdateOutputPixel; -end; - -{ TFloydSteinbergDitheringTask } - -procedure TFloydSteinbergDitheringTask.DoExecute; -const - ErrorPrecisionShift = 4; - MaxColorDiffForDiffusion = 4096; -type - TAccPixel = record - red,green,blue,alpha: Int32or64; - end; - TLine = array of TAccPixel; - - procedure AddError(var dest: TAccPixel; const src: TAccPixel; factor: Int32or64); inline; - const maxError = 65536 shl ErrorPrecisionShift; - minError = -(65536 shl ErrorPrecisionShift); - begin - inc(dest.alpha, src.alpha * factor); - if dest.alpha > maxError then dest.alpha := maxError; - if dest.alpha < minError then dest.alpha := minError; - inc(dest.red, src.red * factor); - if dest.red > maxError then dest.red := maxError; - if dest.red < minError then dest.red := minError; - inc(dest.green, src.green * factor); - if dest.green > maxError then dest.green := maxError; - if dest.green < minError then dest.green := minError; - inc(dest.blue, src.blue * factor); - if dest.blue > maxError then dest.blue := maxError; - if dest.blue < minError then dest.blue := minError; - end; - -var - w,h: Int32or64; - -var - p,pNext: PExpandedPixel; - destX,destY: Int32or64; - orig,cur,approxExp: TExpandedPixel; - approx: TBGRAPixel; - approxIndex: integer; - curPix,diff: TAccPixel; - i: Int32or64; - yWrite: Int32or64; - tempLine, currentLine, nextLine: TLine; - - nextScan,curScan: PExpandedPixel; - - function ClampWordDiv(AValue: Int32or64): Word; inline; - begin - if AValue < 0 then AValue := -((-AValue) shr ErrorPrecisionShift) else AValue := AValue shr ErrorPrecisionShift; - if AValue < 0 then - result := 0 - else if AValue > 65535 then - result := 65535 - else - result := AValue; - end; - - function Div16(AValue: Int32or64): Int32or64; inline; - begin - if AValue < 0 then - result := -((-AValue) shr 4) - else - result := AValue shr 4; - end; - -begin - w := FBounds.Right-FBounds.Left; - h := FBounds.Bottom-FBounds.Top; - if (w <= 0) or (h <= 0) then exit; - setlength(currentLine,w); - setlength(nextLine,w); - curScan := nil; - nextScan := RequestSourceExpandedScanLine(FBounds.Left, FBounds.Top, FBounds.Right-FBounds.Left); - for yWrite := 0 to h-1 do - begin - if GetShouldStop(yWrite) then break; - ReleaseSourceExpandedScanLine(curScan); - curScan := nextScan; - nextScan := nil; - p := curScan; - destX := FBounds.Left; - destY := yWrite+FBounds.Top; - if yWrite < h-1 then - nextScan := RequestSourceExpandedScanLine(FBounds.Left,yWrite+FBounds.Top+1, FBounds.Right-FBounds.Left); - pNext := nextScan; - if odd(yWrite) then - begin - inc(p, w); - inc(destX, w); - if pNext<>nil then inc(pNext, w); - for i := w-1 downto 0 do - begin - dec(p); - dec(destX); - if pNext<>nil then dec(pNext); - if p^.alpha <> 0 then - begin - orig := p^; - with currentLine[i] do - begin - curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift); - curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift); - curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift); - curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift); - cur.alpha := ClampWordDiv(curPix.alpha); - cur.red := ClampWordDiv(curPix.red); - cur.green := ClampWordDiv(curPix.green); - cur.blue := ClampWordDiv(curPix.blue); - end; - ApproximateColor(GammaCompression(cur), approx, approxIndex); - approxExp := GammaExpansion(approx); - diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift)); - if (approxExp.alpha = 0) or (cur.alpha = 0) then - begin - diff.red := 0; - diff.green := 0; - diff.blue := 0; - end else - begin - diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift)); - diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift)); - diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift)); - end; - if i > 0 then - begin - if AbsRGBADiff((p-1)^,orig) < MaxColorDiffForDiffusion then - AddError(currentLine[i-1], diff, 7); - end; - if nextLine <> nil then - begin - if i > 0 then - begin - if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then - AddError(nextLine[i-1], diff, 1); - end; - if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then - AddError(nextLine[i], diff, 5); - if i < w-1 then - begin - if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then - AddError(nextLine[i+1], diff, 3); - end; - end; - OnOutputPixel(destX,destY,approxIndex,approx); - end else - begin - ApproximateColor(BGRAPixelTransparent, approx, approxIndex); - OnOutputPixel(destX,destY,approxIndex,approx); - end; - end - end - else - for i := 0 to w-1 do - begin - if p^.alpha <> 0 then - begin - orig := p^; - with currentLine[i] do - begin - curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift); - curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift); - curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift); - curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift); - cur.alpha := ClampWordDiv(curPix.alpha); - cur.red := ClampWordDiv(curPix.red); - cur.green := ClampWordDiv(curPix.green); - cur.blue := ClampWordDiv(curPix.blue); - end; - ApproximateColor(GammaCompression(cur), approx, approxIndex); - approxExp := GammaExpansion(approx); - diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift)); - if (approxExp.alpha = 0) or (cur.alpha = 0) then - begin - diff.red := 0; - diff.green := 0; - diff.blue := 0; - end else - begin - diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift)); - diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift)); - diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift)); - end; - if i < w-1 then - begin - if AbsRGBADiff((p+1)^,orig) < MaxColorDiffForDiffusion then - AddError(currentLine[i+1], diff, 7); - end; - if pNext <> nil then - begin - if i > 0 then - begin - if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then - AddError(nextLine[i-1], diff, 3); - end; - if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then - AddError(nextLine[i], diff, 5); - if i < w-1 then - begin - if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then - AddError(nextLine[i+1], diff, 1); - end; - end; - OnOutputPixel(destX,destY,approxIndex,approx); - end else - begin - ApproximateColor(BGRAPixelTransparent, approx, approxIndex); - OnOutputPixel(destX,destY,approxIndex,approx); - end; - inc(p); - inc(destX); - if pNext<>nil then inc(pNext); - end; - tempLine := currentLine; - currentLine := nextLine; - nextLine := tempLine; - if yWrite = h-2 then - nextLine := nil - else fillchar(nextLine[0], sizeof(nextLine[0])*w, 0); - end; - ReleaseSourceExpandedScanLine(curScan); - ReleaseSourceExpandedScanLine(nextScan); - Destination.InvalidateBitmap; -end; - -{ TNearestColorTask } - -procedure TNearestColorTask.DoExecute; -var yb,xb: Int32or64; - curScan,psrc: PBGRAPixel; - colorIndex: LongInt; - colorValue: TBGRAPixel; -begin - for yb := FBounds.Top to FBounds.Bottom - 1 do - begin - if GetShouldStop(yb) then break; - curScan := RequestSourceScanLine(FBounds.Left,yb,FBounds.Right-FBounds.Left); - psrc := curScan; - for xb := FBounds.Left to FBounds.Right-1 do - begin - ApproximateColor(psrc^, colorValue, colorIndex); - OnOutputPixel(xb,yb,colorIndex,colorValue); - inc(psrc); - end; - ReleaseSourceScanLine(curScan); - end; - Destination.InvalidateBitmap; -end; - -end. - diff --git a/components/bgrabitmap/bgradnetdeserial.pas b/components/bgrabitmap/bgradnetdeserial.pas deleted file mode 100644 index afd79c7..0000000 --- a/components/bgrabitmap/bgradnetdeserial.pas +++ /dev/null @@ -1,1522 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRADNetDeserial; - -{$mode objfpc}{$H+} - -interface - -{ This unit allow to read .Net serialized classes with BinaryFormatter of - namespace System.Runtime.Serialization.Formatters.Binary. - - Serialization is a process by which objects in memory are saved according - to their structure. - - This unit is used by BGRAPaintNet to read Paint.NET images. } - -uses - BGRAClasses, SysUtils; - -type - arrayOfLongword = array of LongWord; - - TTypeCategory = (ftPrimitiveType = 0, ftString = 1, ftObjectType = - 2, ftRuntimeType = 3, - ftGenericType = 4, ftArrayOfObject = 5, ftArrayOfString = 6, - ftArrayOfPrimitiveType = 7); - - TPrimitiveType = (ptNone = 0, ptBoolean = 1, ptByte = 2, ptChar = 3, ptDecimal = 5, - ptDouble = 6, ptInt16 = 7, ptInt32 = 8, ptInt64 = 9, ptSByte = 10, ptSingle = 11, - ptDateTime = 13, ptUInt16 = 14, ptUInt32 = 15, ptUInt64 = 16, ptString = 18); - - TGenericArrayType = (gatSingleDimension, gatJagged, gatMultidimensional); - - TDotNetDeserialization = class; - - ArrayOfNameValue = array of record - Name: string; - Value, valueType: string; - end; - - TFieldType = record - category: TTypeCategory; - primitiveType: TPrimitiveType; - refAssembly: LongWord; - Name: string; - end; - - TSerializedType = record - ClassName: string; - nbFields: integer; - fieldNames: array of string; - fieldTypes: array of TFieldType; - refAssembly: LongWord; - end; - - TAssemblyReference = record - idAssembly: LongWord; - Name: string; - end; - - { TCustomSerializedObject } - - TCustomSerializedObject = class - protected - FContainer: TDotNetDeserialization; - function GetTypeAsString: string; virtual; abstract; - function GetFieldAsString(Index: LongWord): string; overload; virtual; abstract; - function GetFieldAsString(Name: string): string; overload; - function GetFieldCount: LongWord; virtual; abstract; - function GetFieldName(Index: LongWord): string; virtual; abstract; - function GetFieldTypeAsString(Index: LongWord): string; virtual; abstract; - function IsReferenceType(index: LongWord): boolean; virtual; abstract; - public - idObject: LongWord; - refCount: integer; - inToString: boolean; - constructor Create(container: TDotNetDeserialization); virtual; - property FieldCount: LongWord read GetFieldCount; - property FieldName[Index: LongWord]:string read GetFieldName; - property FieldAsString[Index: LongWord]: string read GetFieldAsString; - property FieldByNameAsString[Name: string]: string read GetFieldAsString; - property FieldTypeAsString[Index: LongWord]: string read GetFieldTypeAsString; - property TypeAsString: string read GetTypeAsString; - function GetFieldIndex(Name: string): integer; - end; - - { TSerializedClass } - - TSerializedClass = class(TCustomSerializedObject) - protected - function GetFieldAsString(Index: LongWord): string; override; - function GetFieldCount: LongWord; override; - function GetFieldName(Index: LongWord): string; override; - function GetFieldTypeAsString(Index: LongWord): string; override; - function IsReferenceType(index: LongWord): boolean; override; - function GetTypeAsString: string; override; - public - numType: integer; - fields: ArrayOfNameValue; - end; - - { TSerializedArray } - - TSerializedArray = class(TCustomSerializedObject) - private - data: pointer; - FItemSize: LongWord; - function GetItemPtr(Index: LongWord): pointer; - procedure InitData; - protected - FArrayType: TGenericArrayType; - function GetFieldAsString(Index: LongWord): string; override; - function GetFieldCount: LongWord; override; - function GetFieldName(Index: LongWord): string; override; - function GetFieldTypeAsString(Index: LongWord): string; override; - function IsReferenceType(index: LongWord): boolean; override; - function GetTypeAsString: string; override; - public - dimensions: array of LongWord; - itemType: TFieldType; - nbItems: LongWord; - constructor Create(AContainer: TDotNetDeserialization; AItemType: TFieldType; ALength: LongWord); overload; - constructor Create(AContainer: TDotNetDeserialization; AArrayType: TGenericArrayType; AItemType: TFieldType; ADimensions: arrayOfLongword); overload; - destructor Destroy; override; - property ItemPtr[Index:LongWord]: pointer read GetItemPtr; - property ItemSize: LongWord read FItemSize; - end; - - { TSerializedValue } - - TSerializedValue = class(TSerializedArray) - protected - function GetIsReferenceType: boolean; - function GetValueAsString: string; - function GetTypeAsString: string; override; - public - constructor Create(AContainer: TDotNetDeserialization; AItemType: TFieldType); overload; - property ValueAsString: string read GetValueAsString; - property IsReferenceType: boolean read GetIsReferenceType; - end; - - { TDotNetDeserialization } - TDotNetDeserialization = class - objectTypes: array of TSerializedType; - assemblies: array of TAssemblyReference; - objects: array of TCustomSerializedObject; - - function FindClass(typeName: string): TSerializedClass; - function FindObject(typeName: string): TCustomSerializedObject; - function GetSimpleField(obj: TCustomSerializedObject; Name: string): string; - function GetObjectField(obj: TCustomSerializedObject; Name: string): TCustomSerializedObject; overload; - function GetObjectField(obj: TCustomSerializedObject; index: integer): TCustomSerializedObject; overload; - function GetObject(id: string): TCustomSerializedObject; overload; - function GetObject(id: LongWord): TCustomSerializedObject; overload; - function IsBoxedValue(obj: TCustomSerializedObject; index: integer): boolean; - function GetBoxedValue(obj: TCustomSerializedObject; index: integer): string; - procedure LoadFromStream(Stream: TStream); - procedure LoadFromFile(filename: string); - procedure LoadFromFileUTF8(filenameUTF8: string); - function ToString: string; override; - constructor Create; - destructor Destroy; override; - function GetTypeOfClassObject(idObject: LongWord): integer; - private - EndOfStream: boolean; - ArrayFillerCount: Longword; - currentAutoObjectValue: LongWord; - function nextAutoObjectId: LongWord; - function LoadNextFromStream(Stream: TStream): LongWord; - function LoadStringFromStream(Stream: TStream): string; - function LoadDotNetCharFromStream(Stream: TStream): string; - function LoadTypeFromStream(Stream: TStream; IsRuntimeType: boolean): integer; - function LoadValuesFromStream(Stream: TStream; numType: integer): ArrayOfNameValue; - function LoadValueFromStream(Stream: TStream; const fieldType: TFieldType): string; - function LoadFieldType(Stream: TStream; category: TTypeCategory): TFieldType; - end; - -function WinReadByte(stream: TStream): byte; -function WinReadWord(Stream: TStream): word; -function WinReadSmallInt(Stream: TStream): smallint; -function WinReadLongint(Stream: TStream): longint; -function WinReadLongword(Stream: TStream): LongWord; -function WinReadInt64(Stream: TStream): int64; -function WinReadQWord(Stream: TStream): QWord; - -implementation - -uses BGRAUTF8; - -const - //block types - btRefTypeObject = 1; - btRuntimeObject = 4; - btExternalObject = 5; - btString = 6; - btGenericArray = 7; - btBoxedPrimitiveTypeValue = 8; - btObjectReference = 9; - btNullValue = 10; - btEndOfStream = 11; - btAssembly = 12; - btArrayFiller8b = 13; - btArrayFiller32b = 14; - btArrayOfPrimitiveType = 15; - btArrayOfObject = 16; - btArrayOfString = 17; - btMethodCall = 21; - btMethodResponse = 22; - - idArrayFiller = $80000000; - -{$hints off} - -function WinReadByte(stream: TStream): byte; -begin - stream.Read(Result, sizeof(Result)); -end; - -function WinReadWord(Stream: TStream): word; -begin - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -function WinReadSmallInt(Stream: TStream): smallint; -begin - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -function WinReadLongint(Stream: TStream): longint; -begin - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -function WinReadLongword(Stream: TStream): LongWord; -begin - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -function WinReadInt64(Stream: TStream): int64; -begin - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -function WinReadQWord(Stream: TStream): QWord; -begin - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -{$hints on} - -function GetFieldTypeSize(const fieldType: TFieldType): LongWord; -begin - case fieldType.category of - ftPrimitiveType: - case fieldType.primitiveType of - ptBoolean, ptByte,ptSByte: result := 1; - ptChar,ptString, ptDecimal: Result := sizeof(string); - ptSingle: result := sizeof(single); - ptDouble: result := sizeof(double); - ptInt16,ptUInt16: result := 2; - ptInt32,ptUInt32: result := 4; - ptInt64,ptUInt64,ptDateTime: result := 8; - else - raise Exception.Create('Unknown primitive type (' + IntToStr( - byte(fieldType.primitiveType)) + ')'); - end; - ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject, - ftArrayOfString, ftArrayOfPrimitiveType: result := 4; - else - raise Exception.Create('Unknown field type (' + IntToStr( - byte(fieldType.category)) + ')'); - end; -end; - -function IsDotNetTypeStoredAsString(const fieldType: TFieldType): boolean; -begin - result := (fieldType.category = ftPrimitiveType) and - (fieldType.primitiveType in [ptChar,ptString,ptDecimal]); -end; - -function DotNetValueToString(var value; const fieldType: TFieldType): string; -var - tempByte: byte; - value2bytes: record - case byte of - 2: (tempWord: word); - 3: (tempInt16: smallint); - end; - value4bytes: record - case byte of - 1: (tempSingle: single); - 2: (tempLongWord: LongWord); - 3: (tempLongInt: longint); - end; - value8bytes: record - case byte of - 1: (tempDouble: double); - 2: (tempInt64: Int64); - 2: (tempUInt64: QWord); - end; - tempIdObject: LongWord; - -begin - if IsDotNetTypeStoredAsString(fieldType) then - begin - Result := pstring(@value)^; - exit; - end; - case fieldType.category of - ftPrimitiveType: case fieldType.primitiveType of - ptBoolean: - begin - {$hints off} - move(value,tempByte,sizeof(tempByte)); - {$hints on} - if tempByte = 0 then - Result := 'False' - else - if tempByte = 1 then - Result := 'True' - else - raise Exception.Create('Invalid boolean value (' + - IntToStr(tempByte) + ')'); - end; - ptByte: Result := inttostr(pbyte(@value)^); - ptSByte: Result := inttostr(pshortint(@value)^); - ptInt16,ptUInt16: - begin - {$hints off} - move(value, value2bytes.tempWord,sizeof(word)); - {$hints on} - value2bytes.tempWord := LEtoN(value2bytes.tempWord); - if fieldType.primitiveType = ptInt16 then - Result := IntToStr(value2bytes.tempInt16) - else - Result := IntToStr(value2bytes.tempWord); - end; - ptInt32,ptUInt32,ptSingle: - begin - {$hints off} - move(value, value4bytes.tempLongWord,sizeof(LongWord)); - {$hints on} - value4bytes.tempLongWord := LEtoN(value4bytes.tempLongWord); - if fieldType.primitiveType = ptInt32 then - Result := IntToStr(value4bytes.tempLongInt) - else if fieldType.primitiveType = ptUInt32 then - Result := IntToStr(value4bytes.tempLongWord) - else - result := FloatToStr(value4bytes.tempSingle); - end; - - ptInt64,ptUInt64,ptDouble,ptDateTime: - begin - {$hints off} - move(value, value8bytes.tempUInt64,8); - {$hints on} - value8bytes.tempUInt64 := LEtoN(value8bytes.tempUInt64); - if fieldType.primitiveType = ptInt64 then - Result := IntToStr(value8bytes.tempInt64) - else if fieldType.primitiveType = ptUInt64 then - Result := IntToStr(value8bytes.tempUInt64) - else if fieldType.primitiveType = ptDouble then - result := FloatToStr(value8bytes.tempDouble) - else - Result := DateTimeToStr( - (value8bytes.tempUInt64 and $7FFFFFFFFFFFFFFF - 599264352000000000) / 864000000000); - end; - else - raise Exception.Create('Unknown primitive type (' + IntToStr( - byte(fieldType.primitiveType)) + ')'); - end; - ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject, - ftArrayOfString, ftArrayOfPrimitiveType: - begin - {$hints off} - move(value,tempIdObject,sizeof(tempIdObject)); - {$hints on} - result := '#' + IntToStr(tempIdObject); - end; - else - raise Exception.Create('Unknown field type (' + IntToStr( - byte(fieldType.category)) + ')'); - end; -end; - -function PrimitiveTypeName(pt: TPrimitiveType): string; -begin - case pt of - ptBoolean: Result := 'Boolean'; - ptByte: Result := 'Byte'; - ptChar: Result := 'Char'; - ptDecimal: Result := 'Decimal'; - ptDouble: Result := 'Double'; - ptInt16: Result := 'Int16'; - ptInt32: Result := 'Int32'; - ptInt64: Result := 'Int64'; - ptSByte: Result := 'SByte'; - ptSingle: Result := 'Single'; - ptDateTime: Result := 'DateTime'; - ptUInt16: Result := 'UInt16'; - ptUInt32: Result := 'UInt32'; - ptUInt64: Result := 'UInt64'; - ptString: Result := 'String'; - else - raise Exception.Create('Unknown primitive type (' + IntToStr(integer(pt)) + ')'); - end; -end; - -Function DotNetTypeToString(ft: TFieldType): string; -begin - if ft.category = ftPrimitiveType then - result := PrimitiveTypeName(ft.primitiveType) - else - case ft.category of - ftString: result := 'String'; - ftObjectType: result := 'Object'; - ftRuntimeType: result := 'RuntimeType'; - ftGenericType: result := 'GenericType'; - ftArrayOfObject: result := 'Object[]'; - ftArrayOfString: result := 'String[]'; - ftArrayOfPrimitiveType: result := 'PrimitiveType[]'; - else - raise Exception.Create('Unknown field type (' + IntToStr( - byte(ft.category)) + ')'); - end; -end; - -{ TCustomSerializedObject } - -function TCustomSerializedObject.GetFieldAsString(Name: string): string; -begin - result := GetFieldAsString(GetFieldIndex(Name)); -end; - -constructor TCustomSerializedObject.Create(container: TDotNetDeserialization); -begin - FContainer := container; - refCount := 0; -end; - -function TCustomSerializedObject.GetFieldIndex(Name: string): integer; -var - i: integer; - fn: string; -begin - if FieldCount = 0 then - begin - result := -1; - exit; - end; - //case sensitive - for i := 0 to FieldCount-1 do - if FieldName[i] = Name then - begin - Result := i; - exit; - end; - //case insensitive - for i := 0 to FieldCount-1 do - if compareText(FieldName[i], Name) = 0 then - begin - Result := i; - exit; - end; - //case sensitive inner member - for i := 0 to FieldCount-1 do - begin - fn := FieldName[i]; - if (length(Name) < length(fn)) and - (copy(fn, length(fn) - length(Name), - length(Name) + 1) = '+' + Name) then - begin - Result := i; - exit; - end; - end; - //case insensitive inner member - for i := 0 to FieldCount-1 do - begin - fn := FieldName[i]; - if (length(Name) < length(fn)) and - (compareText(copy(fn, length(fn) - - length(Name), length(Name) + 1), '+' + Name) = 0) then - begin - Result := i; - exit; - end; - end; - Result := -1; -end; - -{ TSerializedClass } - -function TSerializedClass.GetFieldAsString(Index: LongWord): string; -begin - result := fields[Index].Value; -end; - -function TSerializedClass.GetFieldCount: LongWord; -begin - Result:= length(fields); -end; - -function TSerializedClass.GetFieldName(Index: LongWord): string; -begin - result := fields[Index].Name; -end; - -function TSerializedClass.GetFieldTypeAsString(Index: LongWord): string; -begin - result := fields[Index].valueType; -end; - -function TSerializedClass.IsReferenceType(index: LongWord): boolean; -begin - Result:= FContainer.objectTypes[numType].fieldTypes[index].category <> ftPrimitiveType; -end; - -function TSerializedClass.GetTypeAsString: string; -begin - Result:= FContainer.objectTypes[numType].ClassName; -end; - -{ TSerializedArray } - -procedure TSerializedArray.InitData; -begin - FItemSize := GetFieldTypeSize(itemType); - getmem(data, itemSize*nbItems); - fillchar(data^, itemSize*nbItems, 0); -end; - -function TSerializedArray.GetItemPtr(Index: LongWord): pointer; -begin - if index >= nbItems then - raise exception.Create('Index out of bounds'); - result := pointer(pbyte(data)+Index*itemsize); -end; - -function TSerializedArray.GetFieldAsString(Index: LongWord): string; -begin - if data = nil then - result := '' - else - result := DotNetValueToString(ItemPtr[index]^, itemType); -end; - -function TSerializedArray.GetFieldCount: LongWord; -begin - Result:= nbItems; -end; - -function TSerializedArray.GetFieldName(Index: LongWord): string; -var - r: LongWord; -begin - result := '['; - for r := 1 to length(dimensions) do - begin - if r <> 1 then AppendStr(result, ','); - AppendStr(result, inttostr(index mod dimensions[r-1])); - index := index div dimensions[r-1]; - end; - AppendStr(result, ']'); -end; - -{$hints off} -function TSerializedArray.GetFieldTypeAsString(Index: LongWord): string; -begin - Result:= DotNetTypeToString(itemType); -end; -{$hints on} - -{$hints off} -function TSerializedArray.IsReferenceType(index: LongWord): boolean; -begin - Result:= itemType.category <> ftPrimitiveType; -end; -{$hints on} - -function TSerializedArray.GetTypeAsString: string; -var - i: Integer; -begin - Result:= DotNetTypeToString(itemType)+'['; - for i := 2 to length(dimensions) do - AppendStr(result, ','); - AppendStr(result, ']'); -end; - -constructor TSerializedArray.Create(AContainer: TDotNetDeserialization; AItemType: TFieldType; ALength: LongWord); -begin - inherited Create(AContainer); - setlength(dimensions,1); - dimensions[0] := ALength; - nbItems := ALength; - FArrayType := gatSingleDimension; - itemType := AItemType; - InitData; -end; - -constructor TSerializedArray.Create(AContainer: TDotNetDeserialization; AArrayType: TGenericArrayType; AItemType: TFieldType; - ADimensions: arrayOfLongword); -var n: LongWord; -begin - inherited Create(AContainer); - setlength(dimensions, length(ADimensions)); - nbItems := 1; - if length(ADimensions) <> 0 then - for n := 0 to length(ADimensions)-1 do - begin - dimensions[n] := ADimensions[n]; - nbItems := nbItems * ADimensions[n]; - end; - FArrayType := AArrayType; - itemType := AItemType; - InitData; -end; - -destructor TSerializedArray.Destroy; -var ps: PString; - n: LongWord; -begin - if IsDotNetTypeStoredAsString(itemType) and (nbItems <> 0) then - begin - ps := PString(data); - for n := 1 to nbItems do - begin - ps^ := ''; - inc(ps); - end; - end; - freemem(data); - inherited Destroy; -end; - -{ TSerializedValue } - -function TSerializedValue.GetIsReferenceType: boolean; -begin - result := inherited IsReferenceType(0); -end; - -function TSerializedValue.GetValueAsString: string; -begin - result := GetFieldAsString(0); -end; - -function TSerializedValue.GetTypeAsString: string; -begin - Result:= GetFieldTypeAsString(0); -end; - -constructor TSerializedValue.Create(AContainer: TDotNetDeserialization; - AItemType: TFieldType); -begin - inherited Create(AContainer,AItemType,1); -end; - -{ TDotNetDeserialization } - -function TDotNetDeserialization.FindClass(typeName: string): TSerializedClass; -var obj: TCustomSerializedObject; -begin - obj := FindObject(typeName); - if obj is TSerializedClass then - result := obj as TSerializedClass - else - raise exception.Create('FindClass: found object is not a class'); -end; - -function TDotNetDeserialization.FindObject(typeName: string): TCustomSerializedObject; -var - i: integer; - comparedType: string; -begin - for i := 0 to high(objects) do - begin - comparedType := objects[i].TypeAsString; - if (comparedType = typeName) or - ( (length(typeName) < length(comparedType) ) and - (copy(comparedType, length(comparedType) - length(typeName), - length(typeName) + 1) = '.' + typeName) ) then - begin - Result := objects[i]; - exit; - end; - end; - Result := nil; -end; - -function TDotNetDeserialization.GetSimpleField(obj: TCustomSerializedObject; - Name: string): string; -var - i,idxSlash: integer; - tempSub: TCustomSerializedObject; -begin - i := obj.GetFieldIndex(Name); - if i = -1 then - begin - idxSlash := pos('\',name); - if idxSlash <> 0 then - begin - tempSub := GetObjectField(obj,copy(name,1,idxSlash-1)); - if tempSub <> nil then - begin - result := GetSimpleField(tempSub,copy(name,idxSlash+1,length(name)-idxSlash)); - exit; - end; - end; - Result := '' - end - else - begin - if IsBoxedValue(obj, i) then - Result := GetBoxedValue(obj, i) - else - Result := obj.FieldAsString[i]; - end; -end; - -function TDotNetDeserialization.GetObjectField(obj: TCustomSerializedObject; - Name: string): TCustomSerializedObject; -var - i: integer; - idxSlash: LongInt; - tempSub: TCustomSerializedObject; -begin - i := obj.GetFieldIndex(Name); - if i = -1 then - begin - idxSlash := pos('\',name); - if idxSlash <> 0 then - begin - tempSub := GetObjectField(obj,copy(name,1,idxSlash-1)); - if tempSub <> nil then - begin - result := GetObjectField(tempSub,copy(name,idxSlash+1,length(name)-idxSlash)); - exit; - end; - end; - Result := nil - end - else - begin - if not obj.IsReferenceType(i) then - raise Exception.Create('GetObjectField: Not a reference type'); - Result := GetObject(obj.FieldAsString[i]); - end; -end; - -function TDotNetDeserialization.GetObjectField(obj: TCustomSerializedObject; - index: integer): TCustomSerializedObject; -begin - if not obj.IsReferenceType(index) then - raise Exception.Create('GetObjectField: Not a reference type'); - Result := GetObject(obj.FieldAsString[index]); -end; - -function TDotNetDeserialization.GetObject(id: string): TCustomSerializedObject; -var - idObj: LongWord; -begin - if copy(id, 1, 1) = '#' then - Delete(id, 1, 1); - idObj := StrToInt64(id); - Result := GetObject(idObj); -end; - -function TDotNetDeserialization.GetObject(id: LongWord): TCustomSerializedObject; -var - i: integer; -begin - for i := 0 to high(objects) do - if objects[i].idObject = id then - begin - Result := objects[i]; - exit; - end; - Result := nil; -end; - -function TDotNetDeserialization.IsBoxedValue(obj: TCustomSerializedObject; - index: integer): boolean; -var - subObj: TCustomSerializedObject; -begin - if not obj.IsReferenceType(index) then - begin - Result := False; - exit; - end; - subObj := GetObject(obj.FieldAsString[index]); - if subObj = nil then //suppose Nothing is a boxed value - begin - Result := True; - exit; - end; - Result := subObj is TSerializedValue; -end; - -function TDotNetDeserialization.GetBoxedValue(obj: TCustomSerializedObject; - index: integer): string; -var - subObj: TCustomSerializedObject; -begin - if not obj.IsReferenceType(index) then - raise Exception.Create('GetBoxedValue: Not a reference type'); - subObj := GetObject(obj.FieldAsString[index]); - if subObj = nil then - begin - Result := ''; //empty value - exit; - end; - if (subObj is TSerializedValue) and not (subObj as TSerializedValue).IsReferenceType then - Result := (subObj as TSerializedValue).ValueAsString - else - raise Exception.Create('GetBoxedValue: Not a primitive type'); -end; - -procedure TDotNetDeserialization.LoadFromStream(Stream: TStream); -var - header: packed record - blockId: byte; - value1, value2, value3, value4: longint; - end; - curStreamPosition, prevStreamPosition: int64; -begin - {$hints off} - if Stream.Read(header, sizeof(header)) <> sizeof(header) then - raise Exception.Create('Invalid header size'); - if (header.blockId <> 0) or (header.value1 <> 1) or (header.value2 <> -1) or - (header.value3 <> 1) or (header.value4 <> 0) then - raise Exception.Create('Invalid header format'); - {$hints on} - - EndOfStream := False; - curStreamPosition := Stream.Position; - try - while (Stream.Position < Stream.Size) and not EndOfStream do - begin - prevStreamPosition := curStreamPosition; - curStreamPosition := Stream.Position; - LoadNextFromStream(Stream); - end; - except - on ex: Exception do - raise Exception.Create('Error while loading serialized data at position ' + - IntToStr(stream.Position) + ' (block starting at ' + - IntToStr(curStreamPosition) + ', previous block at ' + - IntToStr(prevStreamPosition) + '). ' + ex.message); - end; -end; - -procedure TDotNetDeserialization.LoadFromFile(filename: string); -var - stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(SysToUTF8(filename), fmOpenRead); - try - LoadFromStream(stream); - finally - stream.Free; - end; -end; - -procedure TDotNetDeserialization.LoadFromFileUTF8(filenameUTF8: string); -var - stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead); - try - LoadFromStream(stream); - finally - stream.Free; - end; -end; - -function TDotNetDeserialization.ToString: string; - - function ObjectToString(num: integer; expectedType: string; - tab: string; main: boolean): string; - var - j, k: integer; - subId: LongWord; - subNum: integer; - objType, subExpectedType: string; - fieldTypeStr: string; - begin - Result := ''; - if (num < 0) or (num > high(objects)) then - raise Exception.Create('Index out of bounds'); - with objects[num] do //here array is not changed so it won't move - begin - if inToString then - begin - if main then - Result := '' - else - Result := '#' + IntToStr(idObject) + LineEnding; - exit; - end; - inToString := True; - objType := TypeAsString; - if main then - begin - AppendStr(Result, tab + 'Object'); - AppendStr(Result, ' #' + IntToStr(idObject)); - if (objType = '') or (objType = expectedType) then - AppendStr(Result, ' = ') - else - AppendStr(Result, ' As ' + objType + ' = '); - end - else - begin - if (objType = '') or (objType = expectedType) then - Result := '' - else - Result := '(' + objType + ') '; - if (idObject < idArrayFiller) and (refCount > 0) then - AppendStr(Result, '#' + IntToStr(idObject) + ' = '); - end; - if (length(objType) > 2) and (copy(objType, length(objType) - 1, 2) = '[]') then - subExpectedType := copy(objType, 1, length(objType) - 2) - else - subExpectedType := ''; - - if not main and (objects[num] is TSerializedValue) then - begin - AppendStr(Result, (objects[num] as TSerializedValue).ValueAsString + LineEnding); - end - else - if (FieldCount = 0) then - begin - AppendStr(Result, '{}' + LineEnding); - end - else - begin - AppendStr(Result, '{' + LineEnding); - for j := 0 to FieldCount-1 do - begin - AppendStr(Result, tab + ' ' + FieldName[j]); - fieldTypeStr := FieldTypeAsString[j]; - if (fieldTypeStr <> '') and (fieldTypeStr <> subExpectedType) and - not ((subExpectedType = '') and ((fieldTypeStr = 'Int32') or - (fieldTypeStr = 'Boolean') or (fieldTypeStr = 'Double'))) then - AppendStr(Result, ' As ' + fieldTypeStr); - AppendStr(Result, ' = '); - if not IsReferenceType(j) then - AppendStr(Result, FieldAsString[j] + lineending) - else - begin - try - subId := StrToInt64(copy(fieldAsString[j], 2, length(fieldAsString[j]) - 1)); - if subId = 0 then AppendStr(Result, 'null'+LineEnding) else - begin - begin - subNum := -1; - for k := 0 to high(objects) do - if (objects[k].idObject = subId) then - begin - subNum := k; - break; - end; - end; - if subNum = -1 then - AppendStr(Result, '(Not found) #' + IntToStr(subId)+LineEnding) - else - AppendStr(Result, objectToString(subNum, fieldTypeStr, tab + ' ', False)); - end; - except - AppendStr(Result, '!' + fieldAsString[j]+'!' +LineEnding) - end; - end; - end; - AppendStr(Result, tab + '}' + LineEnding); - if main then - AppendStr(Result, LineEnding); - end; - end; - end; - -var - i: integer; -begin - Result := ''; - for i := 0 to high(assemblies) do - AppendStr(Result, 'Imports ' + assemblies[i].Name + LineEnding); - AppendStr(Result, lineEnding); - for i := 0 to high(objects) do - objects[i].inToString := False; - for i := 0 to high(objects) do - AppendStr(Result, ObjectToString(i, 'Object', '', True)); -end; - -constructor TDotNetDeserialization.Create; -begin - currentAutoObjectValue := idArrayFiller + 1; -end; - -destructor TDotNetDeserialization.Destroy; -var - i: Integer; -begin - for i := 0 to high(objects) do - objects[i].Free; - inherited Destroy; -end; - -function TDotNetDeserialization.GetTypeOfClassObject(idObject: LongWord - ): integer; -var - i: Integer; -begin - for i := 0 to high(objects) do - if objects[i].idObject = idObject then - begin - if objects[i] is TSerializedClass then - begin - result := (objects[i] as TSerializedClass).numType; - exit; - end - else - raise exception.Create('GetTypeOfClassObject: Specified object is not of class type'); - end; - raise exception.Create('GetTypeOfClassObject: Object not found'); -end; - -function TDotNetDeserialization.nextAutoObjectId: LongWord; -begin - Inc(currentAutoObjectValue); - Result := currentAutoObjectValue; -end; - -function TDotNetDeserialization.LoadNextFromStream(Stream: TStream): LongWord; -var - blockType: byte; - idRefObject, tempIdObject: LongWord; - tempType: TFieldType; - arrayCount, arrayIndex,FillZeroCount : LongWord; - tempAnyObj: TCustomSerializedObject; - newClassObj: TSerializedClass; - newValueObj: TSerializedValue; - newArrayObj: TSerializedArray; - genericArrayType: TGenericArrayType; - genericArrayRank: LongWord; - genericArrayDims: array of LongWord; - genericArrayItemType: TFieldType; - - function GetArrayCellNumber(index: LongWord): string; - var r: LongWord; - begin - result := ''; - for r := 1 to genericArrayRank do - begin - if r <> 1 then AppendStr(result, ','); - AppendStr(result, inttostr(index mod genericArrayDims[r-1])); - index := index div genericArrayDims[r-1]; - end; - end; - -begin - Result := 0; //idObject or zero - blockType := WinReadByte(Stream); - case blockType of - - btAssembly: - begin - setlength(assemblies, length(assemblies) + 1); - with assemblies[high(assemblies)] do - begin - idAssembly := WinReadLongword(Stream); - Name := LoadStringFromStream(Stream); - end; - end; - - btRuntimeObject, btExternalObject: - begin - newClassObj := TSerializedClass.Create(self); - setlength(objects, length(objects) + 1); - objects[high(objects)] := newClassObj; - with newClassObj do - begin - idObject := WinReadLongword(Stream); - Result := idObject; - numType := LoadTypeFromStream(Stream, blockType = btRuntimeObject); - fields := LoadValuesFromStream(Stream, numType); - end; - end; - - btRefTypeObject: - begin - newClassObj := TSerializedClass.Create(self); - setlength(objects, length(objects) + 1); - objects[high(objects)] := newClassObj; - with newClassObj do - begin - idObject := WinReadLongword(Stream); - Result := idObject; - idRefObject := WinReadLongword(Stream); - numType := GetTypeOfClassObject(idRefObject); - fields := LoadValuesFromStream(Stream, numType); - end; - end; - - btString: - begin - tempType.primitiveType := ptString; - tempType.category := ftPrimitiveType; - tempType.Name := PrimitiveTypeName(ptString); - tempType.refAssembly := 0; - - newValueObj := TSerializedValue.Create(self,tempType); - setlength(objects, length(objects) + 1); - objects[high(objects)] := newValueObj; - with newValueObj do - begin - idObject := WinReadLongword(Stream); - Result := idObject; - pstring(data)^ := LoadStringFromStream(Stream); - end; - end; - - btBoxedPrimitiveTypeValue: - begin - try - tempType.category := ftPrimitiveType; - tempType.refAssembly := 0; - tempType.primitiveType := TPrimitiveType(WinReadByte(stream)); - tempType.Name := PrimitiveTypeName(tempType.primitiveType); - - newValueObj := TSerializedValue.Create(self,tempType); - setlength(objects, length(objects) + 1); - objects[high(objects)] := newValueObj; - - with newValueObj do - begin - idObject := nextAutoObjectId; - Result := idObject; - - if IsDotNetTypeStoredAsString(tempType) then - pstring(data)^ := LoadValueFromStream(Stream, tempType) - else - Stream.Read(data^, itemSize); - end; - except - on ex: Exception do - raise Exception.Create('Error while reading boxed primitive values. ' + - ex.Message); - end; - end; - - btObjectReference: - begin - result := WinReadLongword(Stream); - tempAnyObj := GetObject(Result); - if tempAnyObj <> nil then - Inc(tempAnyObj.refCount); - end; - - btNullValue: Result := 0; - - btArrayOfPrimitiveType: - begin - try - result := WinReadLongword(Stream); - arrayCount := WinReadLongword(Stream); - - tempType.category := ftPrimitiveType; - tempType.refAssembly := 0; - tempType.primitiveType := TPrimitiveType(WinReadByte(stream)); - tempType.Name := PrimitiveTypeName(tempType.primitiveType); - - newArrayObj := TSerializedArray.Create(self,tempType,arrayCount); - setlength(objects, length(objects) + 1); - objects[high(objects)] := newArrayObj; - with newArrayObj do - begin - idObject := result; - - if arrayCount <> 0 then - begin - if IsDotNetTypeStoredAsString(tempType) then - begin - for arrayIndex := 0 to arrayCount - 1 do - pstring(ItemPtr[arrayIndex])^ := LoadValueFromStream(Stream, tempType); - end else - begin - for arrayIndex := 0 to arrayCount - 1 do - stream.Read(ItemPtr[arrayIndex]^, itemSize); - end; - end; - end; - except - on ex: Exception do - raise Exception.Create('Error while reading array of primitive values. ' + - ex.Message); - end; - end; - - btArrayOfObject,btArrayOfString: - begin - try - result := WinReadLongword(Stream); - arrayCount := WinReadLongword(Stream); - - if blockType = btArrayOfObject then - tempType.category := ftObjectType - else - tempType.category := ftString; - - tempType.refAssembly := 0; - tempType.primitiveType := ptNone; - tempType.Name := DotNetTypeToString(tempType); - - newArrayObj := TSerializedArray.Create(self,tempType,arrayCount); - setlength(objects, length(objects) + 1); - objects[high(objects)] := newArrayObj; - - with newArrayObj do - begin - idObject:= result; - FillZeroCount := 0; - if arrayCount <> 0 then - for arrayIndex := 0 to arrayCount - 1 do - begin - if FillZeroCount > 0 then - Dec(FillZeroCount) - else - begin - tempIdObject := LoadNextFromStream(Stream); - if tempIdObject = idArrayFiller then - begin - tempIdObject := 0; - FillZeroCount := ArrayFillerCount; - ArrayFillerCount := 0; - end; - if FillZeroCount > 0 then - Dec(FillZeroCount) - else - plongword(ItemPtr[arrayIndex])^ := tempIdObject; - end; - end; - end; - except - on ex: Exception do - raise Exception.Create('Error while reading array of object. ' + ex.Message); - end; - end; - - btArrayFiller8b, btArrayFiller32b: - begin - Result := idArrayFiller; - arrayCount := 0; - if blockType = btArrayFiller8b then - arrayCount := WinReadByte(Stream) - else - arrayCount := WinReadLongWord(Stream); - ArrayFillerCount := arraycount; - end; - - btGenericArray: - begin - try - result := WinReadLongword(Stream); - genericArrayType := TGenericArrayType( WinReadByte(Stream) ); - genericArrayRank := WinReadLongword(Stream); - setlength(genericArrayDims,genericArrayRank); - arrayCount := 0; - if genericArrayRank <> 0 then - for arrayIndex := 0 to genericArrayRank-1 do - begin - genericArrayDims[arrayIndex] := WinReadLongword(Stream); - if arrayIndex=0 then - arrayCount := genericArrayDims[arrayIndex] - else - arrayCount := arrayCount * genericArrayDims[arrayIndex]; - end; - genericArrayItemType.category := TTypeCategory(WinReadByte(Stream)); - genericArrayItemType := LoadFieldType(stream,genericArrayItemType.category); - - newArrayObj := TSerializedArray.Create(self,genericArrayType,genericArrayItemType,genericArrayDims); - setlength(objects, length(objects) + 1); - objects[high(objects)] := newArrayObj; - newArrayObj.idObject := result; - - FillZeroCount := 0; - if arrayCount <> 0 then - for arrayIndex := 0 to arrayCount - 1 do - begin - if IsDotNetTypeStoredAsString(genericArrayItemType) then - PString(newArrayObj.ItemPtr[arrayIndex])^ := LoadValueFromStream(Stream,genericArrayItemType) - else - if genericArrayItemType.category = ftPrimitiveType then - Stream.Read(newArrayObj.ItemPtr[arrayIndex]^, newArrayObj.ItemSize) - else - begin - if FillZeroCount > 0 then - Dec(FillZeroCount) - else - begin - tempIdObject := LoadNextFromStream(Stream); - if tempIdObject = idArrayFiller then - begin - tempIdObject := 0; - FillZeroCount := ArrayFillerCount; - ArrayFillerCount := 0; - end; - if FillZeroCount > 0 then - Dec(FillZeroCount) - else - plongword(newArrayObj.ItemPtr[arrayIndex])^ := tempIdObject; - end; - end; - end; - except - on ex: Exception do - raise Exception.Create('Error while reading array of object. ' + ex.Message); - end; - end; - - btMethodCall, btMethodResponse: - raise Exception.Create('Method or method response not supported'); - - btEndOfStream: EndOfStream := True; - - else - raise Exception.Create('Unknown block type (' + IntToStr(blockType) + ')'); - end; -end; - -function TDotNetDeserialization.LoadStringFromStream(Stream: TStream): string; -var - byteLength, shift: byte; - fullLength: integer; - utf8value: string; -begin - fullLength := 0; - shift := 0; - {$hints off} - repeat - Stream.Read(byteLength, 1); - Inc(fullLength, (byteLength and 127) shl shift); - shift := shift + 7; - until (byteLength < 128) or (shift > 24); - {$hints on} - setlength(utf8value, fullLength); - if Stream.Read(utf8value[1], fullLength) <> fullLength then - raise Exception.Create('String length error'); - Result := utf8value; -end; - -function TDotNetDeserialization.LoadDotNetCharFromStream(Stream: TStream - ): string; -var - tempByte: byte; - dataLen: Byte; - utf8value: string; -begin - tempByte:= WinReadByte(Stream); - - if tempByte and $80 = 0 then - dataLen := 1 - else - if tempByte and $E0 = $C0 then - dataLen := 2 - else - if tempByte and $F0 = $E0 then - dataLen := 3 - else - if tempByte and $F8 = $F0 then - dataLen := 4 - else - raise Exception.Create('Invalid UTF8 char'); - - setlength(utf8value, dataLen); - utf8value[1] := char(tempByte); - Stream.Read(utf8value[2], dataLen - 1); - Result := utf8value; -end; - -function TDotNetDeserialization.LoadTypeFromStream(Stream: TStream; - IsRuntimeType: boolean): integer; -var - i: integer; -begin - try - setlength(objectTypes, length(objectTypes) + 1); - Result := high(objectTypes); - with objectTypes[Result] do - begin - ClassName := LoadStringFromStream(Stream); - nbFields := WinReadLongword(Stream); - setlength(fieldNames, nbFields); - setlength(fieldTypes, nbFields); - for i := 0 to nbFields - 1 do - fieldNames[i] := LoadStringFromStream(Stream); - for i := 0 to nbFields - 1 do - fieldTypes[i].category := TTypeCategory(WinReadByte(Stream)); - for i := 0 to nbFields - 1 do - fieldTypes[i] := LoadFieldType(Stream,fieldTypes[i].category); - if isRuntimeType then - refAssembly := 0 - else - refAssembly := WinReadLongword(Stream); - end; - except - on ex: Exception do - raise Exception.Create('Error while reading object type definition. ' + - ex.Message); - end; -end; - -function TDotNetDeserialization.LoadValuesFromStream(Stream: TStream; - numType: integer): ArrayOfNameValue; -var - i: integer; - ot: TSerializedType; -begin - if (numType < 0) or (numType > high(objectTypes)) then - raise Exception.Create('Type number out of bounds (' + IntToStr(numType) + ')'); - ot := objectTypes[numType]; //use temp because array address may change - try - with ot do - begin - setlength(Result, nbFields); - for i := 0 to nbFields - 1 do - begin - Result[i].Name := fieldNames[i]; - Result[i].valueType := fieldTypes[i].Name; - Result[i].Value := LoadValueFromStream(Stream, fieldTypes[i]); - end; - end; - except - on ex: Exception do - raise Exception.Create('Error while reading values of object of type ' + - ot.ClassName + '. ' + ex.Message); - end; -end; - -function TDotNetDeserialization.LoadValueFromStream(Stream: TStream; - const fieldType: TFieldType): string; -var - data : record - case byte of - 1: (ptr: pointer); - 2: (bytes: array[0..7] of byte); - end; - dataLen: LongWord; - tempIdObject: LongWord; -begin - try - if fieldType.Category = ftPrimitiveType then - begin - case fieldType.primitiveType of - ptChar: Result := LoadDotNetCharFromStream(Stream); - ptString, ptDecimal: Result := LoadStringFromStream(Stream); - else - begin - dataLen := GetFieldTypeSize(fieldType); - {$hints off} - stream.read(data,dataLen); - {$hints on} - result := DotNetValueToString(data,fieldType); - end; - end; - end else - if fieldType.Category in [ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject, - ftArrayOfString, ftArrayOfPrimitiveType] then - begin - tempIdObject := LoadNextFromStream(stream); - Result := '#' + IntToStr(tempIdObject); - end else - raise Exception.Create('Unknown field type (' + IntToStr( - byte(fieldType.category)) + ')'); - except - on ex: Exception do - raise Exception.Create('Error while reading object value. ' + ex.Message); - end; -end; - -function TDotNetDeserialization.LoadFieldType(Stream: TStream; category: TTypeCategory - ): TFieldType; -begin - result.category := category; - result.Name := ''; - result.refAssembly := 0; - result.primitiveType := ptNone; - case category of - ftPrimitiveType, ftArrayOfPrimitiveType: - begin - result.primitiveType := TPrimitiveType(WinReadByte(stream)); - result.Name := PrimitiveTypeName(result.primitiveType); - if result.category = ftArrayOfPrimitiveType then - AppendStr(result.Name, '[]'); - end; - ftString: result.Name := 'String'; - ftObjectType: result.Name := 'Object'; - ftRuntimeType: result.Name := LoadStringFromStream(Stream); - ftGenericType: - begin - result.Name := LoadStringFromStream(Stream); - result.refAssembly := WinReadLongword(Stream); - end; - ftArrayOfObject: result.Name := 'Object[]'; - ftArrayOfString: result.Name := 'String[]'; - else - raise Exception.Create('Unknown field type tag (' + IntToStr( - byte(result.category)) + ')'); - end; -end; - -initialization - - -end. - diff --git a/components/bgrabitmap/bgrafillinfo.pas b/components/bgrabitmap/bgrafillinfo.pas deleted file mode 100644 index 4f45d32..0000000 --- a/components/bgrabitmap/bgrafillinfo.pas +++ /dev/null @@ -1,1758 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAFillInfo; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes; - -const - AntialiasPrecision = 16; - AntialiasPrecisionShift = 4; - -type - TDensity = word; - PDensity = ^TDensity; - -type - { TFillShapeInfo } - - TFillShapeInfo = class(TBGRACustomFillInfo) - protected - FPointInsideInter : ArrayOfTIntersectionInfo; - //compute intersections. the array must be big enough - procedure ComputeIntersection(cury: single; var inter: ArrayOfTIntersectionInfo; var nbInter: integer); virtual; - //sort from left to right - procedure SortIntersection(var inter: ArrayOfTIntersectionInfo; nbInter: integer); virtual; - procedure InternalQuickSortIntersection(inter0: pointer; idxL, idxH: Integer); virtual; - //apply non-zero winding rule. it can change the number of intersections - procedure ConvertFromNonZeroWinding(var inter: ArrayOfTIntersectionInfo; var nbInter: integer); virtual; - //returns maximum of intersection per line - function NbMaxIntersection: integer; virtual; - - public - destructor Destroy; override; - - //returns true if the same segment number can be curved - function SegmentsCurved: boolean; override; - - //returns integer bounds - function GetBounds: TRect; override; - - //check if the point is inside the filling zone - function IsPointInside(x,y: single; windingMode: boolean): boolean; override; - - //create an array that will contain computed intersections. - //you may augment, in this case, use CreateIntersectionInfo for new items - function CreateIntersectionArray: ArrayOfTIntersectionInfo; override; - function CreateIntersectionInfo: TIntersectionInfo; override; //creates a single info - procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); override; - - //fill a previously created array of intersections with actual intersections at the current y coordinate. - //nbInter gets the number of computed intersections - procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); override; - - //can be called after ComputeAndSort or ComputeIntersection to determine the current horizontal slice - //so that it can be checked if the intermediates scanlines can be skipped - function GetSliceIndex: integer; override; - - end; - - { TFillEllipseInfo } - - TFillEllipseInfo = class(TFillShapeInfo) - private - FX, FY, FRX, FRY: single; - FSliceIndex: integer; - function GetCenter: TPointF; - protected - function NbMaxIntersection: integer; override; - procedure ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; - public - WindingFactor: integer; - constructor Create(x, y, rx, ry: single); - function GetBounds: TRect; override; - function SegmentsCurved: boolean; override; - function GetSliceIndex: integer; override; - property Center: TPointF read GetCenter; - property RadiusX: single read FRX; - property RadiusY: single read FRY; - end; - - { TFillBorderEllipseInfo } - - TFillBorderEllipseInfo = class(TFillShapeInfo) - private - FInnerBorder, FOuterBorder: TFillEllipseInfo; - protected - function NbMaxIntersection: integer; override; - procedure ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; - public - constructor Create(x, y, rx, ry, w: single); - function GetBounds: TRect; override; - function SegmentsCurved: boolean; override; - destructor Destroy; override; - function GetSliceIndex: integer; override; - property InnerBorder: TFillEllipseInfo read FInnerBorder; - property OuterBorder: TFillEllipseInfo read FOuterBorder; - end; - - { TFillRoundRectangleInfo } - - TFillRoundRectangleInfo = class(TFillShapeInfo) - private - FX1, FY1, FX2, FY2, FRX, FRY: single; - FOptions: TRoundRectangleOptions; - function GetBottomRight: TPointF; - function GetTopLeft: TPointF; - protected - function NbMaxIntersection: integer; override; - procedure ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; - public - WindingFactor: integer; - constructor Create(x1, y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean = true); - function SegmentsCurved: boolean; override; - function GetBounds: TRect; override; - property TopLeft: TPointF read GetTopLeft; - property BottomRight: TPointF read GetBottomRight; - property RadiusX: single read FRX; - property RadiusY: single read FRY; - end; - - { TFillRectangleInfo } - - TFillRectangleInfo = class(TFillShapeInfo) - private - FX1, FY1, FX2, FY2: single; - function GetBottomRight: TPointF; - function GetTopLeft: TPointF; - protected - function NbMaxIntersection: integer; override; - procedure ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; - public - WindingFactor: integer; - constructor Create(x1, y1, x2, y2: single; APixelCenteredCoordinates: boolean = true); - function GetBounds: TRect; override; - property TopLeft: TPointF read GetTopLeft; - property BottomRight: TPointF read GetBottomRight; - end; - - { TFillBorderRoundRectInfo } - - TFillBorderRoundRectInfo = class(TFillShapeInfo) - protected - FInnerBorder, FOuterBorder: TFillRoundRectangleInfo; - function NbMaxIntersection: integer; override; - procedure ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; - public - constructor Create(x1, y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean = true); - function GetBounds: TRect; override; - function SegmentsCurved: boolean; override; - destructor Destroy; override; - property InnerBorder: TFillRoundRectangleInfo read FInnerBorder; - property OuterBorder: TFillRoundRectangleInfo read FOuterBorder; - end; - - PCustomPointRecord = ^TCustomPointRecord; - TCustomPointRecord = record - originalIndex: integer; - slope: single; - empty: boolean; - next: integer; - winding: integer; - includeStartingPoint,includeEndingPoint: boolean; - data: pointer; - case boolean of - false: (x,y,x2,y2: single); - true: (coord,coord2: TPointF); - end; - - { TCustomFillPolyInfo } - - TCustomFillPolyInfo = class(TFillShapeInfo) - private - function GetNbPoints: integer; - protected - FPoints: array of TCustomPointRecord; - FSegmentsDataCreated: boolean; - FBoundsF: TRectF; - function NbMaxIntersection: integer; override; - procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; {%H-}dy: single; {%H-}AData: pointer); virtual; - procedure InitPoints(const points: array of TPointF); - procedure CreateSegmentsData; virtual; - public - constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); - destructor Destroy; override; - function CreateIntersectionArray: ArrayOfTIntersectionInfo; override; - function CreateSegmentData({%H-}numPt, {%H-}nextPt: integer; {%H-}ASeg: PCustomPointRecord): pointer; virtual; - procedure FreeSegmentData(data: pointer); virtual; - function GetBounds: TRect; override; - function GetBoundsF: TRectF; - property NbPoints: integer read GetNbPoints; - end; - - TPolySlice = record - y1,y2: single; - segments: array of record - id: integer; - custom: PCustomPointRecord; - end; - nbSegments: integer; - end; - - { TFillPolyInfo } - - TFillPolyInfo = class(TCustomFillPolyInfo) - protected - FSlices: array of TPolySlice; - FCurSlice: integer; - FMaxIntersection: integer; - function NbMaxIntersection: integer; override; - procedure ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; - public - constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); - function GetSliceIndex: integer; override; - end; - - POnePassRecord = ^TOnePassRecord; - TOnePassRecord = record - id: integer; - custom: PCustomPointRecord; - next: POnePassRecord; - nextWaiting: POnePassRecord; - nextDrawing: POnePassRecord; - end; - - { TOnePassFillPolyInfo } - - TOnePassFillPolyInfo = class(TCustomFillPolyInfo) - private - procedure InsertionSortByY; - function PartitionByY(left, right: integer): integer; - procedure QuickSortByY(left, right: integer); - procedure SortByY; - protected - FOnePass: array of TOnePassRecord; - FSortedByY: array of POnePassRecord; - FFirstWaiting, FFirstDrawing: POnePassRecord; - FShouldInitializeDrawing: boolean; - FSliceIndex: integer; - procedure ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override; - public - constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); - function CreateIntersectionArray: ArrayOfTIntersectionInfo; override; - function GetSliceIndex: integer; override; - end; - - { TSimpleFillPolyInfo } - - TSimpleFillPolyInfo = class(TCustomFillPolyInfo) - protected - procedure ComputeIntersection(cury: single; var inter: ArrayOfTIntersectionInfo; - var nbInter: integer); override; - public - constructor Create(const points: array of TPointF; APixelCenteredCoordinates: boolean = true); - end; - -procedure AddDensity(dest: PDensity; start,count: integer; value : word); inline; -function DivByAntialiasPrecision(value: UInt32or64): UInt32or64; inline; -function DivByAntialiasPrecision256(value: UInt32or64): UInt32or64; inline; -function DivByAntialiasPrecision65536(value: UInt32or64): UInt32or64; inline; -procedure ComputeAliasedRowBounds(x1,x2: single; minx,maxx: integer; out ix1,ix2: integer); - -function IsPointInPolygon(const points: ArrayOfTPointF; point: TPointF; windingMode: boolean): boolean; -function IsPointInEllipse(x,y,rx,ry: single; point: TPointF): boolean; -function IsPointInRoundRectangle(x1, y1, x2, y2, rx, ry: single; point: TPointF): boolean; -function IsPointInRectangle(x1, y1, x2, y2: single; point: TPointF): boolean; - -function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; - bmpDest: TBGRACustomBitmap): boolean; overload; -function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; - clip: TRect): boolean; overload; - -implementation - -uses Math; - -function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; - bmpDest: TBGRACustomBitmap): boolean; -begin - result := BGRAShapeComputeMinMax(AShape, minx,miny,maxx,maxy, bmpDest.ClipRect); -end; - -function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer; - clip: TRect): boolean; -var bounds: TRect; -begin - result := true; - bounds := AShape.GetBounds; - - if (bounds.Right <= bounds.left) or (bounds.bottom <= bounds.top) then - begin - result := false; - exit; - end; - - miny := bounds.top; - maxy := bounds.bottom - 1; - minx := bounds.left; - maxx := bounds.right - 1; - - if minx < clip.Left then - minx := clip.Left; - if maxx < clip.Left then - result := false; - - if maxx > clip.Right - 1 then - maxx := clip.Right- 1; - if minx > clip.Right - 1 then - result := false; - - if miny < clip.Top then - miny := clip.Top; - if maxy < clip.Top then - result := false; - - if maxy > clip.Bottom - 1 then - maxy := clip.Bottom - 1; - if miny > clip.Bottom - 1 then - result := false; -end; - -procedure ComputeAliasedRowBounds(x1,x2: single; minx,maxx: integer; out ix1,ix2: integer); -begin - ix1 := trunc(x1); - if frac(x1)>0.5 then inc(ix1) - else if frac(x1)<=-0.5 then dec(ix1); - ix2 := trunc(x2)-1; - if frac(x2)>0.5 then inc(ix2) - else if frac(x2)<=-0.5 then dec(ix2); - if ix1 < minx then ix1 := minx; - if ix2 >= maxx then ix2 := maxx; -end; - -function IsPointInPolygon(const points: ArrayOfTPointF; point: TPointF - ; windingMode: boolean): boolean; -var info: TBGRACustomFillInfo; -begin - info := TSimpleFillPolyInfo.Create(points); - result := info.IsPointInside(point.x+0.5,point.y+0.5,windingMode); - info.free; -end; - -function IsPointInEllipse(x, y, rx, ry: single; point: TPointF): boolean; -var info: TBGRACustomFillInfo; -begin - info := TFillEllipseInfo.Create(x,y,rx,ry); - result := info.IsPointInside(point.x+0.5,point.y+0.5,false); - info.free; -end; - -function IsPointInRoundRectangle(x1, y1, x2, y2, rx, ry: single; point: TPointF - ): boolean; -var info: TBGRACustomFillInfo; -begin - info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,[]); - result := info.IsPointInside(point.x+0.5,point.y+0.5,false); - info.free; -end; - -function IsPointInRectangle(x1, y1, x2, y2: single; point: TPointF): boolean; -begin - with point do - result := (((x1x)) or ((x1>x) and (x2y)) or ((y1>y) and (y2 0 then - begin - valueValue := value+(value shl 16); - while count > 0 do - begin - inc(plongword(dest)^, valueValue); - inc(dest,2); - dec(count); - end; - end; - if lastAdd <> 0 then - inc(dest^, value); -end; - -function DivByAntialiasPrecision(value: UInt32or64): UInt32or64; -begin // - result := value shr AntialiasPrecisionShift;// div AntialiasPrecision; -end; - -function DivByAntialiasPrecision256(value: UInt32or64): UInt32or64; -begin // - result := value shr (AntialiasPrecisionShift+8);// div (256*AntialiasPrecision); -end; - -function DivByAntialiasPrecision65536(value: UInt32or64): UInt32or64; -begin // - result := value shr (AntialiasPrecisionShift+16);//div (65536*AntialiasPrecision); -end; - -{ TFillRectangleInfo } - -function TFillRectangleInfo.GetBottomRight: TPointF; -begin - result := PointF(FX2-0.5,FY2-0.5); -end; - -function TFillRectangleInfo.GetTopLeft: TPointF; -begin - result := PointF(FX1-0.5,FY1-0.5); -end; - -function TFillRectangleInfo.NbMaxIntersection: integer; -begin - Result:= 2; -end; - -procedure TFillRectangleInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -begin - if (cury >= FY1) and (cury <= FY2) then - begin - inter[nbinter].interX := FX1; - inter[nbinter].winding := -windingFactor; - inter[nbinter].numSegment := 0; - Inc(nbinter); - inter[nbinter].interX := FX2; - inter[nbinter].winding := +windingFactor; - inter[nbinter].numSegment := 1; - Inc(nbinter); - end; -end; - -constructor TFillRectangleInfo.Create(x1, y1, x2, y2: single; - APixelCenteredCoordinates: boolean); -var - temp: Single; -begin - if y1 > y2 then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; - if x1 > x2 then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - if APixelCenteredCoordinates then - begin - FX1 := x1 + 0.5; - FY1 := y1 + 0.5; - FX2 := x2 + 0.5; - FY2 := y2 + 0.5; - end else - begin - FX1 := x1; - FY1 := y1; - FX2 := x2; - FY2 := y2; - end; - WindingFactor := 1; -end; - -function TFillRectangleInfo.GetBounds: TRect; -begin - result := rect(floor(fx1),floor(fy1),floor(fx2)+1,floor(fy2)+1); -end; - -{ TFillShapeInfo } - -function TFillShapeInfo.GetBounds: TRect; -begin - Result := rect(0, 0, 0, 0); -end; - - -function TFillShapeInfo.IsPointInside(x, y: single; windingMode: boolean - ): boolean; -var - i,nbInter: integer; -begin - if FPointInsideInter = nil then - FPointInsideInter := CreateIntersectionArray; - ComputeAndSort(y,FPointInsideInter,nbInter,windingMode); - i := 0; - while i+1 < nbInter do - begin - if (FPointInsideInter[i].interX < x) and (FPointInsideInter[i+1].interX > x) then - begin - result := true; - FreeIntersectionArray(FPointInsideInter); - exit; - end; - inc(i,2); - end; - result := false; -end; - -function TFillShapeInfo.NbMaxIntersection: integer; -begin - Result := 0; -end; - -destructor TFillShapeInfo.Destroy; -begin - FreeIntersectionArray(FPointInsideInter); - inherited Destroy; -end; - -function TFillShapeInfo.SegmentsCurved: boolean; -begin - result := false; -end; - -function TFillShapeInfo.CreateIntersectionInfo: TIntersectionInfo; -begin - result := TIntersectionInfo.Create; -end; - -procedure TFillShapeInfo.FreeIntersectionArray( - var inter: ArrayOfTIntersectionInfo); -var - i: Integer; -begin - for i := 0 to high(inter) do - inter[i].free; - inter := nil; -end; - -{$hints off} -procedure TFillShapeInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -begin - -end; -{$hints on} - -procedure TFillShapeInfo.SortIntersection(var inter: ArrayOfTIntersectionInfo; nbInter: integer); -var - i,j,k: Integer; - tempInter: TIntersectionInfo; -begin - if nbInter > 10 then - InternalQuickSortIntersection(@inter[0], 0, nbInter-1); - for i := 1 to nbinter - 1 do - begin - j := i; - while (j > 0) and (inter[i].interX < inter[j-1].interX) do dec(j); - if j <> i then - begin - tempInter := inter[i]; - for k := i-1 downto j do - inter[k+1] := inter[k]; - inter[j] := tempInter; - end; - end; -end; - -procedure TFillShapeInfo.InternalQuickSortIntersection(inter0: pointer; - idxL, idxH: Integer); -const Stride = sizeof(pointer); - MinSub = 10; -type PIntersectionInfo = ^TIntersectionInfo; -var - ls,hs : Integer; - li,hi : Integer; - mi : Integer; - ms : Integer; - pb : PByte; - tempInfo: TIntersectionInfo; - m: Single; -begin - pb:=PByte(inter0); - li:=idxL; - hi:=idxH; - mi:=(li+hi) div 2; - ls:=li*Stride; - hs:=hi*Stride; - ms:=mi*Stride; - m := PIntersectionInfo(pb+ms)^.interX; - repeat - while PIntersectionInfo(pb+ls)^.interX < m do begin - inc(ls, Stride); - inc(li); - end; - while m < PIntersectionInfo(pb+hs)^.interX do begin - dec(hs, Stride); - dec(hi); - end; - if ls <= hs then begin - tempInfo := PIntersectionInfo(pb+ls)^; - PIntersectionInfo(pb+ls)^ := PIntersectionInfo(pb+hs)^; - PIntersectionInfo(pb+hs)^ := tempInfo; - inc(ls, Stride); inc(li); - dec(hs, Stride); dec(hi); - end; - until ls>hs; - if hi>=idxL+MinSub-1 then InternalQuickSortIntersection(inter0, idxL, hi); - if li+MinSub-1<=idxH then InternalQuickSortIntersection(inter0, li, idxH); -end; - -procedure TFillShapeInfo.ConvertFromNonZeroWinding(var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -var windingSum,prevSum,i,nbAlternate: integer; - tempInfo: TIntersectionInfo; -begin - windingSum := 0; - nbAlternate := 0; - for i := 0 to nbInter-1 do - begin - prevSum := windingSum; - inc(windingSum, inter[i].winding); - if (windingSum = 0) xor (prevSum = 0) then - begin - if nbAlternate<>i then - begin - tempInfo := inter[nbAlternate]; - inter[nbAlternate] := inter[i]; - inter[i] := tempInfo; - end; - inc(nbAlternate); - end; - end; - nbInter := nbAlternate; -end; - -procedure TFillShapeInfo.ComputeAndSort(cury: single; - var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); -begin - nbInter := 0; - ComputeIntersection(cury,inter,nbInter); - if nbInter < 2 then exit; - SortIntersection(inter,nbInter); - if windingMode then ConvertFromNonZeroWinding(inter,nbInter); -end; - -function TFillShapeInfo.GetSliceIndex: integer; -begin - result := 0; -end; - -function TFillShapeInfo.CreateIntersectionArray: ArrayOfTIntersectionInfo; -var - i: Integer; -begin - setlength(result, NbMaxIntersection); - for i := 0 to high(result) do - result[i] := CreateIntersectionInfo; -end; - -function ComputeWinding(y1,y2: single): integer; -begin - if y2 > y1 then result := 1 else - if y2 < y1 then result := -1 else - result := 0; -end; - -type - arrayOfSingle = array of single; - -procedure InsertionSortSingles(var a: arrayOfSingle); -var i,j: integer; - temp: single; -begin - for i := 1 to high(a) do - begin - Temp := a[i]; - j := i; - while (j>0) and (a[j-1]> Temp) do - begin - a[j] := a[j-1]; - dec(j); - end; - a[j] := Temp; - end; -end; - -function PartitionSingles(var a: arrayOfSingle; left,right: integer): integer; - - procedure Swap(idx1,idx2: integer); inline; - var temp: single; - begin - temp := a[idx1]; - a[idx1] := a[idx2]; - a[idx2] := temp; - end; - -var pivotIndex: integer; - pivotValue: single; - storeIndex: integer; - i: integer; - -begin - pivotIndex := left + random(right-left+1); - pivotValue := a[pivotIndex]; - swap(pivotIndex,right); - storeIndex := left; - for i := left to right-1 do - if a[i] <= pivotValue then - begin - swap(i,storeIndex); - inc(storeIndex); - end; - swap(storeIndex,right); - result := storeIndex; -end; - -procedure QuickSortSingles(var a: arrayOfSingle; left,right: integer); -var pivotNewIndex: integer; -begin - if right > left+9 then - begin - pivotNewIndex := PartitionSingles(a,left,right); - QuickSortSingles(a,left,pivotNewIndex-1); - QuickSortSingles(a,pivotNewIndex+1,right); - end; -end; - -procedure SortSingles(var a: arrayOfSingle); -begin - if length(a) < 10 then InsertionSortSingles(a) else - begin - QuickSortSingles(a,0,high(a)); - InsertionSortSingles(a); - end; -end; - -procedure RemoveSingleDuplicates(var a: arrayOfSingle; var nb: integer); -var i,idx: integer; -begin - idx := 0; - for i := 1 to nb-1 do - begin - if a[i] <> a[idx] then - begin - inc(idx); - a[idx] := a[i]; - end; - end; - nb := idx+1; -end; - -function BinarySearchSingle(value: single; var a: arrayOfSingle; left,right: integer): integer; -var pivotIndex: integer; - pivotValue: single; -begin - pivotIndex := (left+right) div 2; - pivotValue := a[pivotIndex]; - if value = pivotValue then - result := pivotIndex else - if value < pivotValue then - begin - if pivotIndex = left then result := left else - result := BinarySearchSingle(value, a, left,pivotIndex-1); - end else - begin - if pivotIndex = right then result := right+1 else - result := BinarySearchSingle(value, a, pivotIndex+1, right); - end; -end; - -{ TCustomFillPolyInfo } - -constructor TCustomFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); -var - cur, first, i, j: integer; - p, pNext: PCustomPointRecord; - tempCoord: TPointF; - tempBool: Boolean; - -begin - InitPoints(points); - FSegmentsDataCreated:= false; - if FPoints=nil then - begin - FBoundsF := EmptyRectF; - exit; - end; - - //look for empty points, correct coordinate and successors - cur := -1; - first := -1; - p := @FPoints[0]; - for i := 0 to high(FPoints) do - begin - if not isEmptyPointF(p^.coord) then - begin - p^.empty := False; - if APixelCenteredCoordinates then - p^.coord.Offset(0.5,0.5); - if cur <> -1 then - FPoints[cur].next := i; - if first = -1 then - first := i; - cur := i; - end - else - begin - if (first <> -1) and (cur <> first) then - FPoints[cur].next := first; - - p^.empty := True; - p^.next := -1; - cur := -1; - first := -1; - end; - inc(p); - end; - if (first <> -1) and (cur <> first) then - FPoints[cur].next := first; - - FBoundsF := RectF(FPoints[0].coord,FPoints[0].coord); - - p := @FPoints[0]; - for i := 0 to high(FPoints) do - begin - if not p^.empty then - begin - if p^.x < FBoundsF.Left then FBoundsF.Left := p^.x else - if p^.x > FBoundsF.Right then FBoundsF.Right := p^.x; - if p^.y < FBoundsF.Top then FBoundsF.Top := p^.y else - if p^.y > FBoundsF.Bottom then FBoundsF.Bottom := p^.y; - end; - if p^.next <> -1 then - begin - pNext := @FPoints[p^.next]; - p^.coord2 := pNext^.coord; - end; - inc(p); - end; - - //compute slopes - p := @FPoints[0]; - for i := 0 to high(FPoints) do - begin - if not p^.empty then - begin - p^.winding := ComputeWinding(p^.y, p^.y2); - if p^.winding<>0 then - p^.slope := (p^.x2 - p^.x) / (p^.y2 - p^.y) - else - p^.slope := EmptySingle; - end - else - p^.slope := EmptySingle; - inc(p); - end; - - //check if end points are included - p := @FPoints[0]; - for i := 0 to high(FPoints) do - begin - if not p^.empty then - begin - j := p^.next; - pNext := @FPoints[j]; - if p^.winding > 0 then - p^.includeEndingPoint := pNext^.winding < 0 - else if p^.winding < 0 then - p^.includeEndingPoint := pNext^.winding >= 0 - else - p^.includeStartingPoint := false; - - if pNext^.winding > 0 then - pNext^.includeStartingPoint := true - else if pNext^.winding < 0 then - pNext^.includeStartingPoint := p^.winding <> 0; - end; - inc(p); - end; - - //flip vertically to have always top to bottom - p := @FPoints[0]; - for i := 0 to high(FPoints) do - begin - if p^.winding < 0 then - begin - tempCoord := p^.coord; - p^.coord := p^.coord2; - p^.coord2 := tempCoord; - tempBool := p^.includeStartingPoint; - p^.includeStartingPoint := p^.includeEndingPoint; - p^.includeEndingPoint := tempBool; - end; - inc(p); - end; -end; - -destructor TCustomFillPolyInfo.Destroy; -var - i: Integer; -begin - for i := 0 to high(FPoints) do - freemem(FPoints[i].data); - inherited Destroy; -end; - -function TCustomFillPolyInfo.CreateIntersectionArray: ArrayOfTIntersectionInfo; -var - i: Integer; -begin - CreateSegmentsData; - setlength(result, NbMaxIntersection); - for i := 0 to high(result) do - result[i] := nil; -end; - -function TCustomFillPolyInfo.CreateSegmentData(numPt, nextPt: integer; - ASeg: PCustomPointRecord): pointer; -begin - result := nil; -end; - -procedure TCustomFillPolyInfo.FreeSegmentData(data: pointer); -begin - freemem(data); -end; - -function TCustomFillPolyInfo.GetBounds: TRect; -begin - with FBoundsF do - result := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); -end; - -function TCustomFillPolyInfo.GetBoundsF: TRectF; -begin - result := FBoundsF; -end; - -function TCustomFillPolyInfo.GetNbPoints: integer; -begin - result := length(FPoints); -end; - -function TCustomFillPolyInfo.NbMaxIntersection: integer; -begin - Result := length(FPoints); -end; - -procedure TCustomFillPolyInfo.SetIntersectionValues(AInter: TIntersectionInfo; - AInterX: Single; AWinding, ANumSegment: integer; dy: single; AData: pointer); -begin - AInter.SetValues( AInterX, AWinding, ANumSegment ); -end; - -procedure TCustomFillPolyInfo.InitPoints(const points: array of TPointF); -const - minDist = 0.00390625; //1 over 256 - -var - i, first, nbP: integer; - - function PointAlmostEqual(const p1,p2: TPointF): boolean; - begin - result := (abs(p1.x-p2.x) < minDist) and (abs(p1.y-p2.y) < minDist); - end; - - procedure EndOfSubPolygon; - begin - //if there is a subpolygon - if first<>-1 then - begin - //last point is the same as first point? - if (nbP >= first+2) and PointAlmostEqual(FPoints[nbP-1].coord,FPoints[first].coord) then - dec(nbP); //remove superfluous looping point - - if (nbP <= first+2) then //are there only one or two points? - begin - //remove subpolygon because we need at least a triangle - nbP := first; - first := -1; - end; - - end; - end; - -begin - setlength(FPoints, length(points)); - nbP := 0; - first := -1; - for i := 0 to high(points) do - if isEmptyPointF(points[i]) then - begin - EndOfSubPolygon; - if first<>-1 then - begin - FPoints[nbP].originalIndex := i; - FPoints[nbP].coord := EmptyPointF; - inc(nbP); - first := -1; - end; - end else - if (first=-1) or not PointAlmostEqual(FPoints[nbP-1].coord,points[i]) then - begin - if first = -1 then first := nbP; - FPoints[nbP].originalIndex := i; - FPoints[nbP].coord := points[i]; - inc(nbP); - end; - EndOfSubPolygon; - //if last point was a subpolygon delimiter (EmptyPointF) then removes it - if (nbP > 0) and isEmptyPointF(FPoints[nbP-1].coord) then dec(nbP); - - setlength(FPoints, nbP); -end; - -procedure TCustomFillPolyInfo.CreateSegmentsData; -var - i: Integer; - p: PCustomPointRecord; -begin - if FSegmentsDataCreated then exit; - FSegmentsDataCreated := true; - if FPoints<>nil then - begin - p := @FPoints[0]; - for i := 0 to high(FPoints) do - begin - if not p^.empty and (p^.slope <> EmptySingle) then - begin - if p^.winding < 0 then - p^.data := CreateSegmentData(p^.next,i, p) - else - p^.data := CreateSegmentData(i,p^.next, p); - end; - inc(p); - end; - end; -end; - -{ TFillPolyInfo } - -function TFillPolyInfo.NbMaxIntersection: integer; -begin - Result:= FMaxIntersection; -end; - -procedure TFillPolyInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -var - j: integer; - cust: PCustomPointRecord; - pInter: PIntersectionInfo; -begin - if length(FSlices)=0 then exit; - - while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice); - while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice); - - pInter := @inter[nbInter]; - with FSlices[FCurSlice] do - if (cury >= y1) and (cury < y2) then - begin - for j := 0 to nbSegments-1 do - begin - cust := segments[j].custom; - if pInter^ = nil then pInter^ := CreateIntersectionInfo; - SetIntersectionValues(pInter^, (cury - cust^.y) * cust^.slope + cust^.x, - cust^.winding, segments[j].id, cury - cust^.y, cust^.data ); - Inc(nbinter); - inc(pInter); - end; - end; -end; - -constructor TFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); - function AddSeg(numSlice: integer): integer; - begin - result := FSlices[numSlice].nbSegments; - if length(FSlices[numSlice].segments)=FSlices[numSlice].nbSegments then - setlength(FSlices[numSlice].segments,FSlices[numSlice].nbSegments*2+2); - inc(FSlices[numSlice].nbSegments); - end; - -var - yList: array of single; - nbYList: integer; - ya,yb,temp: single; - sliceStart,sliceEnd,idxSeg: integer; - i,j,idSeg: integer; - -begin - inherited Create(points, APixelCenteredCoordinates); - - //slice - nbYList:= length(FPoints)*2; - setlength(YList, nbYList); - for i := 0 to high(FPoints) do - begin - YList[i*2] := FPoints[i].y; - YList[i*2+1] := FPoints[i].y2; - end; - - SortSingles(YList); - RemoveSingleDuplicates(YList, nbYList); - - setlength(FSlices, nbYList-1); - for i := 0 to high(FSlices) do - begin - FSlices[i].y1 := YList[i]; - FSlices[i].y2 := YList[i+1]; - FSlices[i].nbSegments := 0; - end; - - idSeg := 0; - for j := 0 to high(FPoints) do - begin - if FPoints[j].slope<>EmptySingle then - begin - ya := FPoints[j].y; - yb := FPoints[j].y2; - if yb < ya then - begin - temp := ya; - ya := yb; - yb := temp; - end; - sliceStart := BinarySearchSingle(ya,YList,0,nbYList-1); - sliceEnd := BinarySearchSingle(yb,YList,0,nbYList-1); - if sliceEnd > high(FSlices) then sliceEnd := high(FSlices); - for i := sliceStart to sliceEnd do - begin - if ((FPoints[j].y < FSlices[i].y2) and - (FPoints[j].y2 > FSlices[i].y1)) or - ((FPoints[j].y2 < FSlices[i].y2) and - (FPoints[j].y > FSlices[i].y1)) then - begin - idxSeg := AddSeg(i); - with FSlices[i].segments[idxSeg] do - begin - inc(idSeg); - id := idSeg; - custom:= @FPoints[j]; - end; - end; - end; - end; - end; - - FCurSlice := 0; - FMaxIntersection:= 0; - for i := 0 to high(FSlices) do - if FSlices[i].nbSegments > FMaxIntersection then - FMaxIntersection:= FSlices[i].nbSegments; -end; - -function TFillPolyInfo.GetSliceIndex: integer; -begin - Result:= FCurSlice; -end; - -{ TOnePassFillPolyInfo } - -function TOnePassFillPolyInfo.PartitionByY(left,right: integer): integer; - - procedure Swap(idx1,idx2: integer); inline; - var temp: POnePassRecord; - begin - temp := FSortedByY[idx1]; - FSortedByY[idx1] := FSortedByY[idx2]; - FSortedByY[idx2] := temp; - end; - -var pivotIndex: integer; - pivotValue: single; - storeIndex: integer; - i: integer; - -begin - pivotIndex := left + random(right-left+1); - pivotValue := FSortedByY[pivotIndex]^.custom^.y; - swap(pivotIndex,right); - storeIndex := left; - for i := left to right-1 do - if FSortedByY[i]^.custom^.y <= pivotValue then - begin - swap(i,storeIndex); - inc(storeIndex); - end; - swap(storeIndex,right); - result := storeIndex; -end; - -procedure TOnePassFillPolyInfo.QuickSortByY(left,right: integer); -var pivotNewIndex: integer; -begin - if right > left+9 then - begin - pivotNewIndex := PartitionByY(left,right); - QuickSortByY(left,pivotNewIndex-1); - QuickSortByY(pivotNewIndex+1,right); - end; -end; - -procedure TOnePassFillPolyInfo.InsertionSortByY; -var i,j: integer; - tempValue: single; - tempPtr: POnePassRecord; -begin - for i := 1 to high(FSortedByY) do - begin - tempPtr := FSortedByY[i]; - TempValue := tempPtr^.custom^.y; - j := i; - while (j>0) and (FSortedByY[j-1]^.custom^.y > TempValue) do - begin - FSortedByY[j] := FSortedByY[j-1]; - dec(j); - end; - FSortedByY[j] := tempPtr; - end; -end; - -procedure TOnePassFillPolyInfo.SortByY; -var i,nbSorted: integer; -begin - setlength(FSortedByY, length(FPoints)); - nbSorted := 0; - for i := 0 to high(FSortedByY) do - if not FPoints[i].empty then - begin - FSortedByY[nbSorted] := @FOnePass[i]; - inc(nbSorted); - end; - setlength(FSortedByY,nbSorted); - if length(FSortedByY) < 10 then InsertionSortByY else - begin - QuickSortByY(0,high(FSortedByY)); - InsertionSortByY; - end; -end; - -procedure TOnePassFillPolyInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -var - p,pprev,pnext: POnePassRecord; -{ t: TextFile; - i: Integer; } - pCust: PCustomPointRecord; - pInter: PIntersectionInfo; -begin - FShouldInitializeDrawing := true; - - p := FFirstWaiting; - while p <> nil do - begin - if (cury >= p^.custom^.y) then - begin - if cury <= p^.custom^.y2+1 then - begin - p^.nextDrawing := FFirstDrawing; - FFirstDrawing := p; - inc(FSliceIndex); - end; - end - else break; - p := p^.nextWaiting; - end; - FFirstWaiting:= p; - - p := FFirstDrawing; - pprev := nil; - pInter := @inter[nbInter]; - while p <> nil do - begin - pnext := p^.nextDrawing; - pCust := p^.custom; - if (((cury > pCust^.y) and (cury < pCust^.y2)) or - (pCust^.includeStartingPoint and (cury = pCust^.y)) or - (pCust^.includeEndingPoint and (cury = pCust^.y2))) then - begin - if pInter^ = nil then pInter^ := CreateIntersectionInfo; - SetIntersectionValues(pInter^, (cury - pCust^.y)*pCust^.slope + pCust^.x, - pCust^.winding, p^.id, cury - pCust^.y, pCust^.data); - inc(nbinter); - inc(pInter); - end else - if (cury > pCust^.y2+1) then - begin - if pprev <> nil then - pprev^.nextDrawing := pnext - else - FFirstDrawing:= pnext; - p := pnext; - Inc(FSliceIndex); - continue; - end; - pprev := p; - p := pnext; - end; -{ if odd(nbInter) then - begin - assignfile(t, 'polygon.dump'); - rewrite(t); - writeln(t,'Polygon tested at ',cury); - for i := 0 to NbPoints-1 do - if isEmptyPointF(FPoints[i]) then write(t,'] [') else - write(t,FPoints[i].x, ',', FPoints[i].y,' '); - writeln(t); - writeln(t,'Drawing'); - p := FFirstDrawing; - while p <> nil do - begin - if ((p^.winding > 0) and - (((cury > p^.y1) and (cury < p^.y2)) or - (p^.includeStartingPoint and (cury = p^.y1)) or - (p^.includeEndingPoint and (cury = p^.y2)))) or - ((p^.winding < 0) and - (((cury > p^.y1) and (cury < p^.y2)) or - (p^.includeStartingPoint and (cury = p^.y2)) or - (p^.includeEndingPoint and (cury = p^.y1)))) then - write(t,'* ') else write(t,'- '); - - writeln(t,p^.x1,',',p^.y1,' ',p^.x2,',',p^.y2,' ',p^.winding,' ',BoolToStr(p^.includeEndingPoint,'end incl','end not incl')); - p := p^.nextDrawing; - end; - closefile(t); - - raise exception.Create('Even intersections expected'); - end; } -end; - -constructor TOnePassFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); -var i,j: integer; - p: POnePassRecord; -begin - inherited create(points, APixelCenteredCoordinates); - - FShouldInitializeDrawing := true; - setlength(FOnePass, length(FPoints)); - for i := 0 to high(FPoints) do - if not FPoints[i].empty then - begin - p := @FOnePass[i]; - p^.id := i; - j := FPoints[i].next; - p^.next := @FOnePass[j]; - p^.custom:= @FPoints[i]; - end; - - SortByY; - FSliceIndex := 0; -end; - -function TOnePassFillPolyInfo.CreateIntersectionArray: ArrayOfTIntersectionInfo; -var i: integer; - p,pprev: POnePassRecord; -begin - if FShouldInitializeDrawing then - begin - FShouldInitializeDrawing := false; - FFirstWaiting:= nil; - pprev := nil; - for i := 0 to high(FSortedByY) do - begin - p := FSortedByY[i]; - if p^.custom^.slope <> EmptySingle then - begin - if pprev <> nil then - pprev^.nextWaiting:= p - else - FFirstWaiting := p; - pprev := p; - end; - end; - end; - result := inherited CreateIntersectionArray; -end; - -function TOnePassFillPolyInfo.GetSliceIndex: integer; -begin - Result:= FSliceIndex; -end; - -{ TSimpleFillPolyInfo } - -procedure TSimpleFillPolyInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -var i: integer; - p: PCustomPointRecord; - pInter: PIntersectionInfo; -begin - if FPoints = nil then exit; - p := @FPoints[0]; - pInter := @inter[nbInter]; - for i := 0 to high(FPoints) do - begin - if (p^.winding <> 0) and - ( ((cury > p^.y) and (cury < p^.y2)) or - (p^.includeStartingPoint and (cury = p^.y)) or - (p^.includeEndingPoint and (cury = p^.y2)) ) then - begin - if pInter^ = nil then pInter^ := CreateIntersectionInfo; - SetIntersectionValues(pInter^, (cury - p^.y)*p^.slope + p^.x, p^.winding, i, cury - p^.y, p^.data); - inc(nbinter); - inc(pInter); - end; - inc(p); - end; -end; - -constructor TSimpleFillPolyInfo.Create(const points: array of TPointF; APixelCenteredCoordinates: boolean); -begin - inherited Create(points, APixelCenteredCoordinates); -end; - -{ TFillEllipseInfo } - -constructor TFillEllipseInfo.Create(x, y, rx, ry: single); -begin - FX := x + 0.5; - FY := y + 0.5; - FRX := abs(rx); - FRY := abs(ry); - WindingFactor := 1; - FSliceIndex:= -1; -end; - -function TFillEllipseInfo.GetBounds: TRect; -begin - Result := rect(floor(fx - frx), floor(fy - fry), ceil(fx + frx), ceil(fy + fry)); -end; - -function TFillEllipseInfo.SegmentsCurved: boolean; -begin - Result:= true; -end; - -function TFillEllipseInfo.GetSliceIndex: integer; -begin - Result:= FSliceIndex; -end; - -function TFillEllipseInfo.GetCenter: TPointF; -begin - result := PointF(FX-0.5,FY-0.5); -end; - -function TFillEllipseInfo.NbMaxIntersection: integer; -begin - Result := 2; -end; - -procedure TFillEllipseInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -var - d: single; -begin - if (FRY <= 0) or (FRX <= 0) then exit; - d := sqr((cury - FY) / FRY); - if d < 1 then - begin - d := sqrt(1 - d) * FRX; - inter[nbinter].SetValues( FX - d, -windingFactor, 0); - Inc(nbinter); - inter[nbinter].SetValues( FX + d, windingFactor, 1); - Inc(nbinter); - FSliceIndex := 0; - end else - begin - if cury < FY then - FSliceIndex:= -1 - else - FSliceIndex:= 1; - end; -end; - -{ TFillBorderEllipseInfo } - -constructor TFillBorderEllipseInfo.Create(x, y, rx, ry, w: single); -begin - if rx < 0 then - rx := -rx; - if ry < 0 then - ry := -ry; - FOuterBorder := TFillEllipseInfo.Create(x, y, rx + w / 2, ry + w / 2); - if (rx > w / 2) and (ry > w / 2) then - begin - FInnerBorder := TFillEllipseInfo.Create(x, y, rx - w / 2, ry - w / 2); - FInnerBorder.WindingFactor := -1; - end - else - FInnerBorder := nil; -end; - -function TFillBorderEllipseInfo.GetBounds: TRect; -begin - Result := FOuterBorder.GetBounds; -end; - -function TFillBorderEllipseInfo.SegmentsCurved: boolean; -begin - Result:= FOuterBorder.SegmentsCurved; - if FInnerBorder <> nil then result := result or FInnerBorder.SegmentsCurved; -end; - -function TFillBorderEllipseInfo.NbMaxIntersection: integer; -begin - Result := 4; -end; - -procedure TFillBorderEllipseInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -begin - FOuterBorder.ComputeIntersection(cury, inter, nbInter); - if FInnerBorder <> nil then - FInnerBorder.ComputeIntersection(cury, inter, nbInter); -end; - -destructor TFillBorderEllipseInfo.Destroy; -begin - FOuterBorder.Free; - if FInnerBorder <> nil then - FInnerBorder.Free; - inherited Destroy; -end; - -function TFillBorderEllipseInfo.GetSliceIndex: integer; -begin - Result:= FOuterBorder.GetSliceIndex; -end; - -{ TFillRoundRectangleInfo } - -constructor TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean); -var - temp: Single; -begin - if y1 > y2 then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; - if x1 > x2 then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - if APixelCenteredCoordinates then - begin - FX1 := x1 + 0.5; - FY1 := y1 + 0.5; - FX2 := x2 + 0.5; - FY2 := y2 + 0.5; - end else - begin - FX1 := x1; - FY1 := y1; - FX2 := x2; - FY2 := y2; - end; - FRX := abs(rx); - FRY := abs(ry); - if 2*FRX > x2-x1 then FRX := (x2-x1)/2; - if 2*FRY > y2-y1 then FRY := (y2-y1)/2; - FOptions:= options; - WindingFactor := 1; -end; - -function TFillRoundRectangleInfo.SegmentsCurved: boolean; -begin - if (not (rrTopLeftSquare in FOptions) and not (rrTopLeftBevel in FOptions)) or - (not (rrTopRightSquare in FOptions) and not (rrTopRightBevel in FOptions)) or - (not (rrBottomRightSquare in FOptions) and not (rrBottomRightBevel in FOptions)) or - (not (rrBottomLeftSquare in FOptions) and not (rrBottomLeftBevel in FOptions)) then - result := true else result := false; -end; - -function TFillRoundRectangleInfo.GetBounds: TRect; -begin - result := rect(floor(fx1),floor(fy1),floor(fx2)+1,floor(fy2)+1); -end; - -function TFillRoundRectangleInfo.GetBottomRight: TPointF; -begin - result := PointF(FX2-0.5,FY2-0.5); -end; - -function TFillRoundRectangleInfo.GetTopLeft: TPointF; -begin - result := PointF(FX1-0.5,FY1-0.5); -end; - -function TFillRoundRectangleInfo.NbMaxIntersection: integer; -begin - result := 2; -end; - -procedure TFillRoundRectangleInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -var - d,d2: single; -begin - if (cury >= FY1) and (cury <= FY2) then - begin - if cury < FY1+FRY then - begin - d := abs((cury - (FY1+FRY)) / FRY); - if d > 1 then d2 := 0 - else d2 := sqrt(1 - sqr(d)) * FRX; - - if rrTopLeftSquare in FOptions then - inter[nbinter].interX := FX1 else - if rrTopLeftBevel in FOptions then - inter[nbinter].interX := FX1 + d*FRX - else - inter[nbinter].interX := FX1 + FRX - d2; - inter[nbinter].winding := -windingFactor; - inter[nbinter].numSegment := 0; - Inc(nbinter); - - if rrTopRightSquare in FOptions then - inter[nbinter].interX := FX2 else - if rrTopRightBevel in FOptions then - inter[nbinter].interX := FX2 - d*FRX - else - inter[nbinter].interX := FX2 - FRX + d2; - inter[nbinter].winding := +windingFactor; - inter[nbinter].numSegment := 1; - Inc(nbinter); - end else - if cury > FY2-FRY then - begin - d := abs((cury - (FY2-FRY)) / FRY); - if d > 1 then d2 := 0 - else d2 := sqrt(1 - sqr(d)) * FRX; - - if rrBottomLeftSquare in FOptions then - inter[nbinter].interX := FX1 else - if rrBottomLeftBevel in FOptions then - inter[nbinter].interX := FX1 + d*FRX - else - inter[nbinter].interX := FX1 + FRX - d2; - inter[nbinter].winding := -windingFactor; - inter[nbinter].numSegment := 0; - Inc(nbinter); - - if rrBottomRightSquare in FOptions then - inter[nbinter].interX := FX2 else - if rrBottomRightBevel in FOptions then - inter[nbinter].interX := FX2 - d*FRX - else - inter[nbinter].interX := FX2 - FRX + d2; - inter[nbinter].winding := +windingFactor; - inter[nbinter].numSegment := 1; - Inc(nbinter); - end else - begin - inter[nbinter].interX := FX1; - inter[nbinter].winding := -windingFactor; - inter[nbinter].numSegment := 0; - Inc(nbinter); - inter[nbinter].interX := FX2; - inter[nbinter].winding := +windingFactor; - inter[nbinter].numSegment := 1; - Inc(nbinter); - end; - end; -end; - -{ TFillBorderRoundRectInfo } - -constructor TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; APixelCenteredCoordinates: boolean); -var rdiff: single; - temp: Single; -begin - if y1 > y2 then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; - if x1 > x2 then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - - if rx < 0 then - rx := -rx; - if ry < 0 then - ry := -ry; - if 2*rx > x2-x1 then rx := (x2-x1)/2; - if 2*ry > y2-y1 then ry := (y2-y1)/2; - rdiff := w*(sqrt(2)-1); - FOuterBorder := TFillRoundRectangleInfo.Create(x1-w/2,y1-w/2,x2+w/2,y2+w/2, rx+rdiff, ry+rdiff, options, APixelCenteredCoordinates); - if (abs(x2-x1) > w) and (abs(y2-y1) > w) then - begin - if (rx-rdiff <= 0) or (ry-rdiff <= 0) then - FInnerBorder := TFillRoundRectangleInfo.Create(x1+w/2, y1+w/2, x2-w/2, y2-w/2, 0,0, options, APixelCenteredCoordinates) - else - FInnerBorder := TFillRoundRectangleInfo.Create(x1+w/2, y1+w/2, x2-w/2, y2-w/2, rx-rdiff, ry-rdiff, options, APixelCenteredCoordinates); - FInnerBorder.WindingFactor := -1; - end - else - FInnerBorder := nil; -end; - -function TFillBorderRoundRectInfo.GetBounds: TRect; -begin - result := FOuterBorder.GetBounds; -end; - -function TFillBorderRoundRectInfo.SegmentsCurved: boolean; -begin - Result:= FOuterBorder.SegmentsCurved; - if FInnerBorder <> nil then result := result or FInnerBorder.SegmentsCurved; -end; - -function TFillBorderRoundRectInfo.NbMaxIntersection: integer; -begin - Result := 4; -end; - -procedure TFillBorderRoundRectInfo.ComputeIntersection(cury: single; - var inter: ArrayOfTIntersectionInfo; var nbInter: integer); -begin - FOuterBorder.ComputeIntersection(cury, inter, nbInter); - if FInnerBorder <> nil then - FInnerBorder.ComputeIntersection(cury, inter, nbInter); -end; - -destructor TFillBorderRoundRectInfo.Destroy; -begin - FOuterBorder.Free; - FInnerBorder.Free; - inherited Destroy; -end; - -initialization - - Randomize; - -end. - diff --git a/components/bgrabitmap/bgrafilterblur.pas b/components/bgrabitmap/bgrafilterblur.pas deleted file mode 100644 index ecd712b..0000000 --- a/components/bgrabitmap/bgrafilterblur.pas +++ /dev/null @@ -1,1146 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAFilterBlur; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, BGRABitmapTypes, BGRAFilterType; - -type - { TCustomBlurTask } - - TCustomBlurTask = class(TFilterTask) - private - FBounds: TRect; - FMask: TCustomUniversalBitmap; - FMaskOwned: boolean; - public - constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false); - destructor Destroy; override; - protected - procedure DoExecute; override; - end; - - { TRadialBlurTask } - - TRadialBlurTask = class(TFilterTask) - private - FBounds: TRect; - FRadiusX,FRadiusY: single; - FBlurType: TRadialBlurType; - public - constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single; - blurType: TRadialBlurType); overload; - constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single; - blurType: TRadialBlurType); overload; - protected - procedure DoExecute; override; - end; - - { TMotionBlurTask } - - TMotionBlurTask = class(TFilterTask) - private - FBounds: TRect; - FDistance,FAngle: single; - FOriented: boolean; - public - constructor Create(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance, AAngle: single; AOriented: boolean); - protected - procedure DoExecute; override; - end; - -procedure FilterBlurCustom(bmp: TCustomUniversalBitmap; ABounds: TRect; - blurMask: TCustomUniversalBitmap; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -procedure FilterBlurMotion(bmp: TCustomUniversalBitmap; ABounds: TRect; distance: single; - angle: single; oriented: boolean; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -procedure FilterBlurRadial(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; - blurType: TRadialBlurType; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); - -implementation - -uses Math, SysUtils, BGRAGrayscaleMask, - BGRAGradientScanner; - -type - { TBoxBlurTask } - - TBoxBlurTask = class(TFilterTask) - private - FBounds: TRect; - FRadiusX,FRadiusY: single; - public - constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single); overload; - constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single); overload; - protected - procedure DoExecute; override; - end; - -{ TCustomBlurTask } - -constructor TCustomBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; - AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean); -begin - SetSource(bmp); - FBounds := ABounds; - if AMaskIsThreadSafe then - begin - FMask := AMask; - FMaskOwned := false; - end else - begin - FMask := AMask.Duplicate; - FMaskOwned := true; - end; -end; - -destructor TCustomBlurTask.Destroy; -begin - If FMaskOwned then FreeAndNil(FMask); - inherited Destroy; -end; - -procedure TCustomBlurTask.DoExecute; -begin - FilterBlurCustom(FSource,FBounds,FMask,Destination,@GetShouldStop); -end; - -{ TMotionBlurTask } - -constructor TMotionBlurTask.Create(ABmp: TBGRACustomBitmap; ABounds: TRect; - ADistance, AAngle: single; AOriented: boolean); -begin - SetSource(ABmp); - FBounds := ABounds; - FDistance := ADistance; - FAngle := AAngle; - FOriented:= AOriented; -end; - -procedure TMotionBlurTask.DoExecute; -begin - FilterBlurMotion(FSource,FBounds,FDistance,FAngle,FOriented,Destination,@GetShouldStop); -end; - -{ TRadialBlurTask } - -constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; - radius: single; blurType: TRadialBlurType); -begin - SetSource(bmp); - FBounds := ABounds; - FRadiusX := radius; - FRadiusY := radius; - FBlurType:= blurType; -end; - -constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; - radiusX, radiusY: single; blurType: TRadialBlurType); -begin - SetSource(bmp); - FBounds := ABounds; - FRadiusX := radiusX; - FRadiusY := radiusY; - FBlurType:= blurType; -end; - -procedure TRadialBlurTask.DoExecute; -begin - FilterBlurRadial(FSource,FBounds,FRadiusX,FRadiusY,FBlurType,Destination,@GetShouldStop); -end; - -procedure FilterBlurBoxRGBA(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; - ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); -var oldClip: TRect; -const - factMainX = 16; - factMainY = 16; -type - TAccumulator = LongWord; -{$i blurbox.inc} - -procedure FilterBlurBoxRGBA64(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; - ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); -var oldClip: TRect; -const - factMainX = 16; - factMainY = 16; -type - TAccumulator = UInt64; -{$DEFINE PARAM_USE_INC64} -{$i blurbox.inc} - -procedure FilterBlurBoxByte(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; - ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); -var oldClip: TRect; -const - factMainX = 16; - factMainY = 16; -type - TAccumulator = LongWord; -{$DEFINE PARAM_BYTEMASK} -{$i blurbox.inc} - -procedure FilterBlurBoxByte64(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; - ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); -var oldClip: TRect; -const - factMainX = 16; - factMainY = 16; -type - TAccumulator = UInt64; -{$DEFINE PARAM_BYTEMASK} -{$DEFINE PARAM_USE_INC64} -{$i blurbox.inc} - -procedure FilterBlurBox(ASource: TCustomUniversalBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; - ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil); -const - factMainX = 16; - factMainY = 16; -var - totalSum: UInt64; - factExtraX,factExtraY: UInt32or64; - {$IFNDEF CPU64}need64: Boolean;{$ENDIF} -begin - if ADestination.Colorspace <> ASource.Colorspace then - raise exception.Create('Colorspace mismatch'); - - totalSum := (2*ceil(ARadiusX)+1)*(2*ceil(ARadiusY)+1); - factExtraX := trunc(frac(ARadiusX+0.5/factMainX)*factMainX); - factExtraY := trunc(frac(ARadiusY+0.5/factMainY)*factMainY); - if factExtraX > 0 then totalSum := totalSum * factMainX; - if factExtraY > 0 then totalSum := totalSum * factMainY; - - if ASource.Colorspace = TBGRAPixelColorspace then - begin - {$IFNDEF CPU64} - need64 := totalSum > high(LongWord) div (256*256); - if not need64 then - FilterBlurBoxRGBA(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop) else - {$ENDIF} - FilterBlurBoxRGBA64(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop) - end - else if ASource.Colorspace = TByteMaskColorspace then - begin - {$IFNDEF CPU64} - need64 := totalSum > high(LongWord) div 256; - if not need64 then - FilterBlurBoxByte(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop) else - {$ENDIF} - FilterBlurBoxByte64(ASource, ABounds, ARadiusX,ARadiusY, ADestination, ACheckShouldStop); - end - else raise exception.Create('Unexpected colorspace: '+ASource.Colorspace.GetName); -end; - -{ This is a clever solution for fast computing of the blur - effect : it stores an array of vertical sums forming a square - around the pixel which moves with it. For each new pixel, - the vertical sums are kept except for the last column of - the square } -procedure FilterBlurFastRGBA(bmp: TCustomUniversalBitmap; ABounds: TRect; - radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); - {$IFDEF CPU64}{$DEFINE FASTBLUR_DOUBLE}{$ENDIF} - const BitMargin = 16; - type - PRowSum = ^TRowSum; - TRegularRowValue = UInt32or64; - TRowSum = record - sumR,sumG,sumB,rgbDiv,sumA,aDiv: TRegularRowValue; - end; - TExtendedRowValue = {$IFDEF FASTBLUR_DOUBLE}double{$ELSE}uint64{$ENDIF}; - TExtendedRowSum = record - sumR,sumG,sumB,rgbDiv,sumA,aDiv: TExtendedRowValue; - end; - - procedure IncExt(var ADest: TExtendedRowValue; ADelta: TExtendedRowValue); - begin - ADest := ADest + ADelta; - end; - - procedure AccumulatePixel(psrc: Pointer; w: UInt32or64; var sums: TRowSum; verticalWeightShift: Int32or64); inline; - var - c: LongWord; - begin - with sums do - begin - c := PLongWord(psrc)^; - Inc(aDiv, w); - w := w * ((c shr TBGRAPixel_AlphaShift) and $ff); - inc(sumA, w); - w := w shr verticalWeightShift; - inc(rgbDiv, w); - {$hints off} - inc(sumR, ((c shr TBGRAPixel_RedShift) and $ff)*w ); - inc(sumG, ((c shr TBGRAPixel_GreenShift) and $ff)*w ); - inc(sumB, ((c shr TBGRAPixel_BlueShift) and $ff)*w ); - {$hints on} - end; - end; - - procedure AccumulateExtended(var ex: TExtendedRowSum; psum: PRowSum; w: UInt32or64); inline; - begin - with psum^ do - begin - IncExt(ex.sumA, TExtendedRowValue(sumA)*w); - IncExt(ex.aDiv, TExtendedRowValue(aDiv)*w); - IncExt(ex.sumR, TExtendedRowValue(sumR)*w); - IncExt(ex.sumG, TExtendedRowValue(sumG)*w); - IncExt(ex.sumB, TExtendedRowValue(sumB)*w); - IncExt(ex.rgbDiv, TExtendedRowValue(rgbDiv)*w); - end; - end; - - procedure AccumulateShr(var total: TRowSum; psum: PRowSum; w: UInt32or64; horizontalWeightShift: Int32or64); inline; - var - addDiv2: Int32or64; - begin - with psum^ do - begin - addDiv2 := 1 shl (horizontalWeightShift-1); - inc(total.sumA, (sumA*w+addDiv2) shr horizontalWeightShift ); - inc(total.aDiv, (aDiv*w+addDiv2) shr horizontalWeightShift ); - inc(total.sumR, (sumR*w+addDiv2) shr horizontalWeightShift ); - inc(total.sumG, (sumG*w+addDiv2) shr horizontalWeightShift ); - inc(total.sumB, (sumB*w+addDiv2) shr horizontalWeightShift ); - inc(total.rgbDiv, (rgbDiv*w+addDiv2) shr horizontalWeightShift ); - end; - end; - - procedure AccumulateNormal(var total: TRowSum; psum: PRowSum; w: UInt32or64); inline; - begin - with psum^ do - begin - inc(total.sumA, sumA*w ); - inc(total.aDiv, aDiv*w ); - inc(total.sumR, sumR*w ); - inc(total.sumG, sumG*w ); - inc(total.sumB, sumB*w ); - inc(total.rgbDiv, rgbDiv*w ); - end; - end; - - procedure ComputeExtendedAverage(const sum: TExtendedRowSum; pdest: pointer); inline; - {$IFDEF FASTBLUR_DOUBLE} - var v: uint32or64; - {$ELSE} - var rgbDivShr1: TExtendedRowValue; - {$ENDIF} - begin - if (sum.aDiv <= 0) or (sum.rgbDiv <= 0) then - begin - PBGRAPixel(pdest)^ := BGRAPixelTransparent; - exit; - end; - {$IFDEF FASTBLUR_DOUBLE} - v := round(sum.sumA/sum.aDiv); - if v > 255 then PBGRAPixel(pdest)^.alpha := 255 else PBGRAPixel(pdest)^.alpha := v; - v := round(sum.sumR/sum.rgbDiv); - if v > 255 then PBGRAPixel(pdest)^.red := 255 else PBGRAPixel(pdest)^.red := v; - v := round(sum.sumG/sum.rgbDiv); - if v > 255 then PBGRAPixel(pdest)^.green := 255 else PBGRAPixel(pdest)^.green := v; - v := round(sum.sumB/sum.rgbDiv); - if v > 255 then PBGRAPixel(pdest)^.blue := 255 else PBGRAPixel(pdest)^.blue := v; - {$ELSE} - rgbDivShr1:= sum.rgbDiv shr 1; - PLongWord(pdest)^ := (((sum.sumA+sum.aDiv shr 1) div sum.aDiv) shl TBGRAPixel_AlphaShift) - or (((sum.sumR+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_RedShift) - or (((sum.sumG+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_GreenShift) - or (((sum.sumB+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_BlueShift); - {$ENDIF} - end; - - procedure ComputeClampedAverage(const sum: TRowSum; pdest: pointer); inline; - var v: UInt32or64; - begin - if (sum.aDiv = 0) or (sum.rgbDiv = 0) then - begin - PBGRAPixel(pdest)^ := BGRAPixelTransparent; - exit; - end; - v := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; - if v > 255 then PBGRAPixel(pdest)^.alpha := 255 else PBGRAPixel(pdest)^.alpha := v; - v := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv; - if v > 255 then PBGRAPixel(pdest)^.red := 255 else PBGRAPixel(pdest)^.red := v; - v := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv; - if v > 255 then PBGRAPixel(pdest)^.green := 255 else PBGRAPixel(pdest)^.green := v; - v := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv; - if v > 255 then PBGRAPixel(pdest)^.blue := 255 else PBGRAPixel(pdest)^.blue := v; - end; - - procedure ComputeAverage(const sum: TRowSum; pdest: pointer); inline; - var rgbDivShr1: UInt32or64; - begin - if (sum.aDiv = 0) or (sum.rgbDiv = 0) then - begin - PBGRAPixel(pdest)^ := BGRAPixelTransparent; - exit; - end; - rgbDivShr1:= sum.rgbDiv shr 1; - PLongWord(pdest)^ := (((sum.sumA+sum.aDiv shr 1) div sum.aDiv) shl TBGRAPixel_AlphaShift) - or (((sum.sumR+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_RedShift) - or (((sum.sumG+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_GreenShift) - or (((sum.sumB+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_BlueShift); - end; - - {$I blurfast.inc} - -procedure FilterBlurFastByte(bmp: TCustomUniversalBitmap; ABounds: TRect; -radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); - - const BitMargin = 8; - type - PRowSum = ^TRowSum; - TRegularRowValue = UInt32or64; - TRowSum = record - sumA,aDiv: TRegularRowValue; - end; - TExtendedRowValue = {$IFDEF FASTBLUR_DOUBLE}double{$ELSE}uint64{$ENDIF}; - TExtendedRowSum = record - sumA,aDiv: TExtendedRowValue; - end; - - procedure IncExt(var ADest: TExtendedRowValue; ADelta: TExtendedRowValue); - begin - ADest := ADest + ADelta; - end; - - procedure AccumulatePixel(psrc: Pointer; w: UInt32or64; var sums: TRowSum; verticalWeightShift: Int32or64); inline; - begin - with sums do - begin - Inc(aDiv, w); - inc(sumA, w*PByte(psrc)^ shr verticalWeightShift); - end; - end; - - procedure AccumulateExtended(var ex: TExtendedRowSum; psum: PRowSum; w: UInt32or64); inline; - begin - with psum^ do - begin - IncExt(ex.sumA, TExtendedRowValue(sumA)*w); - IncExt(ex.aDiv, TExtendedRowValue(aDiv)*w); - end; - end; - - procedure AccumulateShr(var total: TRowSum; psum: PRowSum; w: UInt32or64; horizontalWeightShift: Int32or64); inline; - var - addDiv2: Int32or64; - begin - with psum^ do - begin - addDiv2 := 1 shl (horizontalWeightShift-1); - inc(total.sumA, (sumA*w+addDiv2) shr horizontalWeightShift ); - inc(total.aDiv, (aDiv*w+addDiv2) shr horizontalWeightShift ); - end; - end; - - procedure AccumulateNormal(var total: TRowSum; psum: PRowSum; w: UInt32or64); inline; - begin - with psum^ do - begin - inc(total.sumA, sumA*w ); - inc(total.aDiv, aDiv*w ); - end; - end; - - procedure ComputeExtendedAverage(const sum: TExtendedRowSum; pdest: pointer); inline; - {$IFDEF FASTBLUR_DOUBLE} - var v: uint32or64; - {$ENDIF} - begin - if sum.aDiv <= 0 then - begin - PByte(pdest)^ := 0; - exit; - end; - {$IFDEF FASTBLUR_DOUBLE} - v := round(sum.sumA/sum.aDiv); - if v > 255 then PByte(pdest)^ := 255 else PByte(pdest)^ := v; - {$ELSE} - PByte(pdest)^ := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; - {$ENDIF} - end; - - procedure ComputeClampedAverage(const sum: TRowSum; pdest: pointer); inline; - var v: UInt32or64; - begin - if sum.aDiv = 0 then - begin - PByte(pdest)^ := 0; - exit; - end; - v := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; - if v > 255 then PByte(pdest)^ := 255 else PByte(pdest)^ := v; - end; - - procedure ComputeAverage(const sum: TRowSum; pdest: pointer); inline; - begin - if sum.aDiv = 0 then - begin - PByte(pdest)^ := 0; - exit; - end; - PByte(pdest)^ := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; - end; - - {$I blurfast.inc} - -procedure FilterBlurFast(bmp: TCustomUniversalBitmap; ABounds: TRect; - radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -begin - if ADestination.Colorspace <> bmp.Colorspace then - raise exception.Create('Colorspace mismatch'); - if bmp.Colorspace = TBGRAPixelColorspace then - FilterBlurFastRGBA(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop) - else if bmp.Colorspace = TByteMaskColorspace then - FilterBlurFastByte(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); -end; - -{ Normal radial blur compute a blur mask with a GradientFill and - then posterize to optimize general purpose blur } -procedure FilterBlurRadialNormal(bmp: TCustomUniversalBitmap; - ABounds: TRect; radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var - blurShape: TGrayscaleMask; - n: Int32or64; - p: PByte; - shift, addRound: LongWord; - grad: TBGRAGradientScanner; - minRadius,maxRadius: single; - oldClip: TRect; -begin - if (radiusX <= 0) and (radiusY <= 0) then - begin - oldClip := ADestination.IntersectClip(ABounds); - ADestination.PutImage(0,0,bmp,dmSet); - ADestination.ClipRect := oldClip; - exit; - end; - blurShape := TGrayscaleMask.Create(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1); - grad := TBGRAGradientScanner.Create(BGRAWhite, BGRABlack, gtRadial, - pointF(ceil(radiusX), ceil(radiusY)), - pointF(ceil(radiusX)-radiusX-0.5, ceil(radiusY)), - pointF(ceil(radiusX), ceil(radiusY)-radiusY-0.5),false); - blurShape.Fill(grad, dmSet); - grad.Free; - minRadius := min(radiusX,radiusY); - maxRadius := max(radiusX,radiusY); - shift := max(0,min(ceil((maxRadius-8)/2), floor(minRadius))); - if shift > 0 then - begin - if shift > 5 then shift := 5; - addRound := 1 shl (shift-1); - p := blurShape.Data; - for n := 0 to blurShape.NbPixels-1 do - begin - p^ := (p^+addRound) shr shift; - inc(p); - end; - end; - FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); - blurShape.Free; -end; - -{ Blur disk creates a disk mask with a FillEllipse } -procedure FilterBlurDisk(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var - blurShape: TGrayscaleMask; - oldClip: TRect; -begin - if (radiusX <= 0) and (radiusY <= 0) then - begin - oldClip := ADestination.IntersectClip(ABounds); - ADestination.PutImage(0,0,bmp,dmSet); - ADestination.ClipRect := oldClip; - exit; - end; - blurShape := TGrayscaleMask.Create(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1, BGRABlack); - blurShape.FillEllipseAntialias(ceil(radiusX), ceil(radiusY), radiusX + 0.5, radiusY + 0.5, BGRAWhite); - FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); - blurShape.Free; -end; - -{ Corona blur use a circle as mask } -procedure FilterBlurCorona(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var - blurShape: TGrayscaleMask; - oldClip: TRect; -begin - if (radiusX <= 0) and (radiusY <= 0) then - begin - oldClip := ADestination.IntersectClip(ABounds); - ADestination.PutImage(0,0,bmp,dmSet); - ADestination.ClipRect := oldClip; - exit; - end; - blurShape := TGrayscaleMask.Create(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1, BGRABlack); - blurShape.EllipseAntialias(ceil(radiusX), ceil(radiusY), radiusX, radiusY, BGRAWhite, 1); - FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); - blurShape.Free; -end; - -procedure FilterBlurRadial(bmp: TCustomUniversalBitmap; ABounds: TRect; radiusX,radiusY: single; - blurType: TRadialBlurType; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var - oldClip: TRect; -begin - if (radiusX <= 0) and (radiusY <= 0) then - begin - oldClip := ADestination.IntersectClip(ABounds); - ADestination.PutImage(0,0,bmp,dmSet); - ADestination.ClipRect := oldClip; - exit; - end; - if radiusX < 0 then radiusX := 0; - if radiusY < 0 then radiusY := 0; - case blurType of - rbCorona: FilterBlurCorona(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); - rbDisk: FilterBlurDisk(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); - rbNormal: FilterBlurRadialNormal(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); - rbFast: FilterBlurFast(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); - rbPrecise: FilterBlurRadialNormal(bmp, ABounds, radiusX / 10 + 0.5, radiusY/10 + 0.5, ADestination, ACheckShouldStop); - rbBox: FilterBlurBox(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop); - end; -end; - -function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; - ABlurType: TRadialBlurType): TFilterTask; overload; -begin - if ABlurType = rbBox then - result := TBoxBlurTask.Create(ABmp,ABounds,ARadius) - else - result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType); -end; - -function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; - ARadiusX, ARadiusY: single; ABlurType: TRadialBlurType): TFilterTask; overload; -begin - if ABlurType = rbBox then - result := TBoxBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY) - else - result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType); -end; - -{ This filter draws an antialiased line to make the mask, and - if the motion blur is oriented, does a GradientFill to orient it } -procedure FilterBlurMotion(bmp: TCustomUniversalBitmap; ABounds: TRect; distance: single; - angle: single; oriented: boolean; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var - blurShape: TBGRACustomBitmap; - intRadius: integer; - dx, dy, r: single; - oldClip: TRect; -begin - if distance < 1e-6 then - begin - oldClip := ADestination.IntersectClip(ABounds); - ADestination.PutImage(0,0,bmp,dmSet); - ADestination.ClipRect := oldClip; - exit; - end; - dx := cos(angle * Pi / 180); - dy := sin(angle * Pi / 180); - if not oriented and (abs(dx)<1e-6) then - FilterBlurBox(bmp, ABounds,0,distance/2, ADestination, ACheckShouldStop) - else if not oriented and (abs(dy)<1e-6) then - FilterBlurBox(bmp, ABounds,distance/2,0, ADestination, ACheckShouldStop) - else - begin - r := distance / 2; - intRadius := ceil(r); - blurShape := BGRABitmapFactory.Create(2 * intRadius + 1, 2 * intRadius + 1, BGRABlack); - blurShape.DrawLineAntialias(intRadius - dx * r, intRadius - dy * - r, intRadius + dx * r, intRadius + dy * r, BGRAWhite, 1, True); - if oriented then - blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, - BGRAPixelTransparent, BGRABlack, gtRadial, pointF(intRadius - - dx * r, intRadius - dy * r), - pointF(intRadius + dx * (r + 0.5), intRadius + dy * (r + 0.5)), - dmFastBlend, False); - FilterBlurCustom(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); - blurShape.Free; - end; -end; - -function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; - ADistance, AAngle: single; AOriented: boolean): TFilterTask; -begin - result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented); -end; - -{ General purpose blur : compute pixel sum according to the mask and then - compute only difference while scanning from the left to the right } -procedure FilterBlurSmallMask(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; -procedure FilterBlurSmallMaskWithShift(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; maskShift: integer; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; -procedure FilterBlurBigMask(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; -procedure FilterBlurMask64(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; - -//make sure value is in the range 0..255 -function clampByte(value: Int32or64): UInt32or64; inline; -begin - if value <= 0 then result := 0 else - if value >= 255 then result := 255 else - result := value; -end; - -function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; - AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean): TFilterTask; -begin - result := TCustomBlurTask.Create(ABmp,ABounds,AMask,AMaskIsThreadSafe); -end; - -procedure FilterBlurCustom(bmp: TCustomUniversalBitmap; - ABounds: TRect; blurMask: TCustomUniversalBitmap; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var - maskSum: int64; - p: PByteMask; - y, count, qty, maskShift, pStride: integer; -begin - maskSum := 0; - for y:= 0 to blurMask.Height-1 do - begin - blurMask.ScanMoveTo(0,Y); - count := blurMask.Width; - while count > 0 do - begin - qty := count; - blurMask.ScanNextMaskChunk(qty, p, pStride); - dec(count, qty); - while qty > 0 do - begin - inc(maskSum,p^.gray); - inc(p, pStride); - dec(qty); - end; - end; - end; - if bmp.Colorspace = TBGRAPixelColorspace then - begin - maskShift := 0; - while maskSum > 32768 do - begin - inc(maskShift); - maskSum := maskSum shr 1; - end; - //check if sum can be stored in a 32-bit signed integer - if maskShift = 0 then - FilterBlurSmallMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop) else - {$IFDEF CPU32} - if maskShift < 8 then - FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift,ABounds,ADestination,ACheckShouldStop) else - FilterBlurBigMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop); - {$ELSE} - FilterBlurMask64(bmp,blurMask,ABounds,ADestination,ACheckShouldStop); - {$ENDIF} - end else - if bmp.Colorspace = TByteMaskColorspace then - begin - if maskSum > 32768*255 then - FilterBlurMask64(bmp, blurMask, ABounds, Adestination, ACheckShouldStop) - else - FilterBlurSmallMask(bmp, blurMask, ABounds, Adestination, ACheckShouldStop) - end else - raise exception.Create('Unexpected source colorspace'); -end; - -type - TBlurClearSumProc = procedure(AData: Pointer); - TBlurAccumulateProc = procedure(AData: Pointer; pPix: pointer; maskAlpha: Int32or64); - TBlurComputeAverageProc = procedure(AData: Pointer; pPix: pointer); - -procedure FilterBlurGeneric(bmp: TCustomUniversalBitmap; blurMask: TCustomUniversalBitmap; - ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc; - AClearSum: TBlurClearSumProc; AAccumulate: TBlurAccumulateProc; - AComputeAverage: TBlurComputeAverageProc; AData: Pointer); - - {$I blurnormal.inc} - -//32-bit blur with shift -type - TFilterBlurSmallMaskWithShift_Sum = record - sumR, sumG, sumB, - sumA, Adiv, RGBdiv : Int32or64; - maskShift: integer; - end; - -procedure FilterBlurSmallMaskWithShift_ClearSum(AData: pointer); -begin - with TFilterBlurSmallMaskWithShift_Sum(AData^) do - begin - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - Adiv := 0; - RGBdiv := 0; - end; -end; - -procedure FilterBlurSmallMaskWithShift_ComputeAverage(AData: pointer; pPix: pointer); -var temp,rgbDivShr1: Int32or64; -begin - with TFilterBlurSmallMaskWithShift_Sum(AData^) do - if (Adiv <= 0) or (RGBdiv <= 0) then - PBGRAPixel(pPix)^ := BGRAPixelTransparent else - begin - temp := sumA + Adiv shr 1; - if temp < Adiv then - PBGRAPixel(pPix)^ := BGRAPixelTransparent - else - begin - rgbDivShr1 := RGBdiv shr 1; - PBGRAPixel(pPix)^.alpha := temp div Adiv; - PBGRAPixel(pPix)^.red := clampByte((sumR + rgbDivShr1) div RGBdiv); - PBGRAPixel(pPix)^.green := clampByte((sumG + rgbDivShr1) div RGBdiv); - PBGRAPixel(pPix)^.blue := clampByte((sumB + rgbDivShr1) div RGBdiv); - end; - end; -end; - -procedure FilterBlurSmallMaskWithShift_AccumulateSum(AData: pointer; pPix: pointer; maskAlpha: Int32or64); -var - pixMaskAlpha: Int32or64; - tempPixel: TBGRAPixel; -begin - with TFilterBlurSmallMaskWithShift_Sum(AData^) do - begin - tempPixel := PBGRAPixel(pPix)^; - pixMaskAlpha := maskAlpha * tempPixel.alpha; - inc(sumA, pixMaskAlpha); - inc(Adiv, maskAlpha); - pixMaskAlpha := (LongWord(pixMaskAlpha)+$80000000) shr maskShift - ($80000000 shr maskShift); - inc(RGBdiv, pixMaskAlpha); - inc(sumR, Int32or64(tempPixel.red) * pixMaskAlpha); - inc(sumG, Int32or64(tempPixel.green) * pixMaskAlpha); - inc(sumB, Int32or64(tempPixel.blue) * pixMaskAlpha); - end; -end; - -procedure FilterBlurSmallMaskWithShift(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; maskShift: integer; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var Sum: TFilterBlurSmallMaskWithShift_Sum; -begin - if ADestination.Colorspace <> bmp.Colorspace then - raise exception.Create('Colorspace mismatch'); - if bmp.Colorspace <> TBGRAPixelColorspace then - raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); - Sum.maskShift:= maskShift; - FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, - @FilterBlurSmallMaskWithShift_ClearSum, - @FilterBlurSmallMaskWithShift_AccumulateSum, - @FilterBlurSmallMaskWithShift_ComputeAverage, @Sum); -end; - -//32-bit blur -type - TFilterBlurSmallMask_Sum= record - sumR, sumG, sumB, sumA, Adiv : integer; - end; - -procedure FilterBlurSmallMask_ClearSum(AData: pointer); -begin - with TFilterBlurSmallMask_Sum(AData^) do - begin - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - Adiv := 0; - end; -end; - -procedure FilterBlurSmallMask_ComputeAverageRGBA(AData: pointer; pPix: pointer); -var temp,sumAShr1: integer; -begin - with TFilterBlurSmallMask_Sum(AData^) do - if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else - begin - temp := sumA + Adiv shr 1; - if temp < Adiv then - PBGRAPixel(pPix)^ := BGRAPixelTransparent - else - begin - sumAShr1 := sumA shr 1; - PBGRAPixel(pPix)^.alpha := temp div Adiv; - PBGRAPixel(pPix)^.red := clampByte((sumR + sumAShr1) div sumA); - PBGRAPixel(pPix)^.green := clampByte((sumG + sumAShr1) div sumA); - PBGRAPixel(pPix)^.blue := clampByte((sumB + sumAShr1) div sumA); - end; - end; -end; - -procedure FilterBlurSmallMask_ComputeAverageByte(AData: pointer; pPix: pointer); -begin - with TFilterBlurSmallMask_Sum(AData^) do - begin - if Adiv <= 0 then PByte(pPix)^ := 0 else - PByte(pPix)^ := (sumA + Adiv shr 1) div Adiv; - end; -end; - -procedure FilterBlurSmallMask_AccumulateSumRGBA(AData: pointer; pPix: pointer; maskAlpha: Int32or64); -var - pixMaskAlpha: integer; - tempPixel: TBGRAPixel; -begin - with TFilterBlurSmallMask_Sum(AData^) do - begin - tempPixel := PBGRAPixel(pPix)^; - pixMaskAlpha := integer(maskAlpha) * tempPixel.alpha; - inc(sumA, pixMaskAlpha); - inc(Adiv, maskAlpha); - inc(sumR, integer(tempPixel.red) * pixMaskAlpha); - inc(sumG, integer(tempPixel.green) * pixMaskAlpha); - inc(sumB, integer(tempPixel.blue) * pixMaskAlpha); - end; -end; - -procedure FilterBlurSmallMask_AccumulateSumByte(AData: pointer; pPix: pointer; maskAlpha: Int32or64); -begin - with TFilterBlurSmallMask_Sum(AData^) do - begin - inc(sumA, maskAlpha * PByte(pPix)^); - inc(Adiv, maskAlpha); - end; -end; - -procedure FilterBlurSmallMask(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var Sum: TFilterBlurSmallMask_Sum; - accumulate: TBlurAccumulateProc; - computeAverage: TBlurComputeAverageProc; -begin - if ADestination.Colorspace <> bmp.Colorspace then - raise exception.Create('Colorspace mismatch'); - - if bmp.Colorspace = TBGRAPixelColorspace then - begin - accumulate := @FilterBlurSmallMask_AccumulateSumRGBA; - computeAverage := @FilterBlurSmallMask_ComputeAverageRGBA - end - else if bmp.Colorspace = TByteMaskColorspace then - begin - accumulate := @FilterBlurSmallMask_AccumulateSumByte; - computeAverage := @FilterBlurSmallMask_ComputeAverageByte - end else - raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); - - FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, - @FilterBlurSmallMask_ClearSum,accumulate,computeAverage, @Sum); -end; - -//64-bit blur -type - TFilterBlurMask64_Sum= record - sumR, sumG, sumB, sumA, Adiv : int64; - end; - -procedure FilterBlurMask64_ClearSum(AData: pointer); -begin - with TFilterBlurMask64_Sum(AData^) do - begin - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - Adiv := 0; - end; -end; - -procedure FilterBlurMask64_ComputeAverageRGBA(AData: pointer; pPix: pointer); -var - temp, sumAShr1: Int64; -begin - with TFilterBlurMask64_Sum(AData^) do - begin - if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else - begin - temp := sumA + Adiv shr 1; - if temp < Adiv then - PBGRAPixel(pPix)^ := BGRAPixelTransparent - else - begin - sumAShr1 := sumA shr 1; - PBGRAPixel(pPix)^.alpha := temp div Adiv; - PBGRAPixel(pPix)^.red := clampByte((sumR + sumAShr1) div sumA); - PBGRAPixel(pPix)^.green := clampByte((sumG + sumAShr1) div sumA); - PBGRAPixel(pPix)^.blue := clampByte((sumB + sumAShr1) div sumA); - end; - end; - end; -end; - -procedure FilterBlurMask64_ComputeAverageConvertRGBAToByteMask(AData: pointer; pPix: pointer); -var c: TBGRAPixel; -begin - FilterBlurMask64_ComputeAverageRGBA(AData, @c); - PByteMask(pPix)^ := BGRAToMask(c); -end; - -procedure FilterBlurMask64_ComputeAverageByte(AData: pointer; pPix: pointer); -begin - with TFilterBlurMask64_Sum(AData^) do - begin - if Adiv <= 0 then PByte(pPix)^ := 0 else - PByte(pPix)^ := (sumA + Adiv shr 1) div Adiv; - end; -end; - -procedure FilterBlurMask64_ComputeAverageConvertByteMaskToRGBA(AData: pointer; pPix: pointer); -begin - with TFilterBlurMask64_Sum(AData^) do - begin - if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else - PBGRAPixel(pPix)^ := MaskToBGRA(TByteMask.New((sumA + Adiv shr 1) div Adiv)); - end; -end; - -procedure FilterBlurMask64_AccumulateSumRGBA(AData: pointer; pPix: pointer; maskAlpha: Int32or64); -var - pixMaskAlpha: Int32or64; - tempPixel: TBGRAPixel; -begin - with TFilterBlurMask64_Sum(AData^) do - begin - tempPixel := PBGRAPixel(pPix)^; - pixMaskAlpha := maskAlpha * tempPixel.alpha; - Inc64(sumA, pixMaskAlpha); - Inc64(Adiv, maskAlpha); - Inc64(sumR, tempPixel.red * pixMaskAlpha); - Inc64(sumG, tempPixel.green * pixMaskAlpha); - Inc64(sumB, tempPixel.blue * pixMaskAlpha); - end; -end; - -procedure FilterBlurMask64_AccumulateSumByte(AData: pointer; pPix: pointer; maskAlpha: Int32or64); -begin - with TFilterBlurMask64_Sum(AData^) do - begin - Inc64(sumA, maskAlpha * PByte(pPix)^); - Inc64(Adiv, maskAlpha); - end; -end; - -procedure FilterBlurMask64(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var Sum: TFilterBlurMask64_Sum; - accumulate: TBlurAccumulateProc; - computeAverage: TBlurComputeAverageProc; -begin - if ADestination.Colorspace <> bmp.Colorspace then - raise exception.Create('Colorspace mismatch'); - - if bmp.Colorspace = TBGRAPixelColorspace then - begin - accumulate := @FilterBlurMask64_AccumulateSumRGBA; - computeAverage := @FilterBlurMask64_ComputeAverageRGBA - end - else if bmp.Colorspace = TByteMaskColorspace then - begin - accumulate := @FilterBlurMask64_AccumulateSumByte; - computeAverage := @FilterBlurMask64_ComputeAverageByte - end else - raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); - - FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, - @FilterBlurMask64_ClearSum,accumulate,computeAverage, @Sum); -end; - -//floating point blur -type - TFilterBlurBigMask_Sum= record - sumR, sumG, sumB, sumA, Adiv : single; - end; - -procedure FilterBlurBigMask_ClearSum(AData: pointer); -begin - with TFilterBlurBigMask_Sum(AData^) do - begin - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - Adiv := 0; - end; -end; - -procedure FilterBlurBigMask_ComputeAverage(AData: pointer; pPix: pointer); -begin - with TFilterBlurBigMask_Sum(AData^) do - if Adiv <= 0 then PBGRAPixel(pPix)^ := BGRAPixelTransparent else - begin - PBGRAPixel(pPix)^.alpha := round(sumA/Adiv); - if PBGRAPixel(pPix)^.alpha = 0 then - PBGRAPixel(pPix)^ := BGRAPixelTransparent - else - begin - PBGRAPixel(pPix)^.red := clampByte(round(sumR/sumA)); - PBGRAPixel(pPix)^.green := clampByte(round(sumG/sumA)); - PBGRAPixel(pPix)^.blue := clampByte(round(sumB/sumA)); - end; - end; -end; - -procedure FilterBlurBigMask_AccumulateSum(AData: pointer; pPix: pointer; maskAlpha: Int32or64); -var - pixMaskAlpha: Int32or64; - tempPixel: TBGRAPixel; -begin - with TFilterBlurBigMask_Sum(AData^) do - begin - tempPixel := PBGRAPixel(pPix)^; - pixMaskAlpha := maskAlpha * tempPixel.alpha; - IncF(sumA, pixMaskAlpha); - IncF(Adiv, maskAlpha); - IncF(sumR, tempPixel.red * pixMaskAlpha); - IncF(sumG, tempPixel.green * pixMaskAlpha); - IncF(sumB, tempPixel.blue * pixMaskAlpha); - end; -end; - -procedure FilterBlurBigMask(bmp: TCustomUniversalBitmap; - blurMask: TCustomUniversalBitmap; ABounds: TRect; ADestination: TCustomUniversalBitmap; ACheckShouldStop: TCheckShouldStopFunc); -var Sum: TFilterBlurBigMask_Sum; -begin - if ADestination.Colorspace <> bmp.Colorspace then - raise exception.Create('Colorspace mismatch'); - if bmp.Colorspace <> TBGRAPixelColorspace then - raise exception.Create('Unexpected colorspace: '+bmp.Colorspace.GetName); - FilterBlurGeneric(bmp, blurMask, ABounds, ADestination, ACheckShouldStop, - @FilterBlurBigMask_ClearSum, - @FilterBlurBigMask_AccumulateSum, - @FilterBlurBigMask_ComputeAverage, @Sum); -end; - -constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; - radius: single); -begin - SetSource(bmp); - FBounds := ABounds; - FRadiusX := radius; - FRadiusY := radius; -end; - -constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; - radiusX, radiusY: single); -begin - SetSource(bmp); - FBounds := ABounds; - FRadiusX := max(radiusX,0); - FRadiusY := max(radiusY,0); -end; - -procedure TBoxBlurTask.DoExecute; -begin - FilterBlurBox(FSource,FBounds,FRadiusX,FRadiusY,Destination,@GetShouldStop); -end; - -end. - diff --git a/components/bgrabitmap/bgrafilters.pas b/components/bgrabitmap/bgrafilters.pas deleted file mode 100644 index e5531fe..0000000 --- a/components/bgrabitmap/bgrafilters.pas +++ /dev/null @@ -1,962 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAFilters; - -{$mode objfpc}{$H+} - -interface - -{ Here are some filters that can be applied to a bitmap. The filters - take a source image as a parameter and gives a filtered image as - a result. } - -uses - BGRAClasses, BGRABitmapTypes, BGRAFilterType, BGRAFilterBlur; - -type - TFilterTask = BGRAFilterType.TFilterTask; - -/////////////////////// PIXELWISE FILTERS //////////////////////////////// -type - { TGrayscaleTask } - { Grayscale converts colored pixel into grayscale with same luminosity } - TGrayscaleTask = class(TFilterTask) - private - FBounds: TRect; - public - constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect); - protected - procedure DoExecute; override; - end; - -{ Grayscale converts colored pixel into grayscale with same luminosity } -function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; overload; -function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload; -function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask; - -{ Normalize use the whole available range of values, making dark colors darkest possible - and light colors lightest possible } -function FilterNormalize(bmp: TBGRACustomBitmap; - eachChannel: boolean = True): TBGRACustomBitmap; overload; -function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect; - eachChannel: boolean = True): TBGRACustomBitmap; overload; - -////////////////////// 3X3 FILTERS //////////////////////////////////////////// - -{ Sharpen filter add more contrast between pixels } -function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer = 256): TBGRACustomBitmap; overload; -function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; overload; - -{ Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil } -function FilterContour(bmp: TBGRACustomBitmap; AGammaCorrection: boolean = false): TBGRACustomBitmap; - -{ Emboss filter compute a color difference in the angle direction } -function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; -function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; - -{ Emboss highlight computes a sort of emboss with 45 degrees angle and - with standard selection color (white/black and filled with blue) } -function FilterEmbossHighlight(bmp: TBGRACustomBitmap; - FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap; -function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap; - FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; - -{ The median filter consist in calculating the median value of pixels. Here - a square of 9x9 pixel is considered. The median allow to select the most - representative colors. The option parameter allow to choose to smooth the - result or not. } -function FilterMedian(bmp: TBGRACustomBitmap; Option: TMedianOption): TBGRACustomBitmap; - -//////////////////////// DEFORMATION FILTERS ///////////////////////////////// - -{ Distort the image as if it were on a sphere } -function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap; - -{ Twirl distortion, i.e. a progressive rotation } -function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; -function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; - -{ Distort the image as if it were on a vertical cylinder } -function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap; - -{ Compute a plane projection towards infinity (SLOW) } -function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap; - -{ Rotate filter rotate the image and clip it in the bounding rectangle } -function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF; - angle: single; correctBlur: boolean = false): TBGRACustomBitmap; - -///////////////////////// BLUR FILTERS ////////////////////////////////////// - -{ A radial blur applies a blur with a circular influence, i.e, each pixel - is merged with pixels within the specified radius. There is an exception - with rbFast blur, the optimization entails a hyperbolic shape. } -type TRadialBlurTask = BGRAFilterBlur.TRadialBlurTask; -function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; -function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; -function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload; -function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload; - -{ The precise blur allow to specify the blur radius with subpixel accuracy } -function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; deprecated 'Use FilterBlurRadial with blurType:=rbPrecise and radius multiplied by 10'; -function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask; deprecated 'Use CreateRadialBlurTask with blurType:=rbPrecise and radius multiplied by 10'; - -{ Motion blur merge pixels in a direction. The oriented parameter specifies - if the weights of the pixels are the same along the line or not. } -type TMotionBlurTask = BGRAFilterBlur.TMotionBlurTask; -function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; -function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance,AAngle: single; AOriented: boolean): TMotionBlurTask; - -{ General purpose blur filter, with a blur mask as parameter to describe - how pixels influence each other } -function FilterBlur(bmp: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap; -function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask; - -////////////////////////////// OTHER FILTERS ///////////////////////////////// - -{ SmartZoom x3 is a filter that upsizes 3 times the picture and add - pixels that could be logically expected (horizontal, vertical, diagonal lines) } -function FilterSmartZoom3(bmp: TBGRACustomBitmap; - Option: TMedianOption): TBGRACustomBitmap; - -function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; - -implementation - -uses Math, BGRATransform, SysUtils, BGRAFilterScanner; - -/////////////////////// PIXELWISE FILTERS //////////////////////////////// - -{ TGrayscaleTask } - -constructor TGrayscaleTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect); -begin - SetSource(bmp); - FBounds := ABounds; -end; - -procedure TGrayscaleTask.DoExecute; -var - yb: LongInt; -begin - if FBounds.IsEmpty then exit; - for yb := FBounds.Top to FBounds.bottom - 1 do - begin - if GetShouldStop(yb) then break; - TBGRAFilterScannerGrayscale.ComputeFilterAt(FSource.scanline[yb] + FBounds.left, - Destination.scanline[yb] + FBounds.left, FBounds.right-FBounds.left, true); - end; - Destination.InvalidateBitmap; -end; - -{ Filter grayscale applies BGRAToGrayscale function to all pixels } -function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; -begin - result := FilterGrayscale(bmp,rect(0,0,bmp.width,bmp.Height)); -end; - -function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; -var scanner: TBGRAFilterScannerGrayscale; -begin - result := bmp.NewBitmap(bmp.Width,bmp.Height); - scanner := TBGRAFilterScannerGrayscale.Create(bmp,Point(0,0),True); - result.FillRect(ABounds,scanner,dmSet); - scanner.Free; -end; - -function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask; -begin - result := TGrayscaleTask.Create(bmp,ABounds); -end; - -function FilterNormalize(bmp: TBGRACustomBitmap; eachChannel: boolean - ): TBGRACustomBitmap; -begin - result := FilterNormalize(bmp, rect(0,0,bmp.Width,bmp.Height), eachChannel); -end; - -{ Normalize compute min-max of specified channel and apply an affine transformation - to make it use the full range of values } -function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect; - eachChannel: boolean = True): TBGRACustomBitmap; -var scanner: TBGRAFilterScannerNormalize; - remain: TRect; -begin - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - remain := TRect.Intersect(ABounds, rect(0,0,bmp.Width,bmp.Height)); - if remain.IsEmpty then exit; - scanner := TBGRAFilterScannerNormalize.Create(bmp,Point(0,0),remain,eachChannel); - result.FillRect(remain,scanner,dmSet); - scanner.Free; -end; - -////////////////////// 3X3 FILTERS //////////////////////////////////////////// - -{ This filter compute for each pixel the mean of the eight surrounding pixels, - then the difference between this average pixel and the pixel at the center - of the square. Finally the difference is added to the new pixel, exagerating - its difference with its neighbours. } -function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; -var scanner: TBGRAFilterScanner; -begin - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - if ABounds.IsEmpty then exit; - scanner := TBGRASharpenScanner.Create(bmp,ABounds,AAmount); - result.FillRect(ABounds,scanner,dmSet); - scanner.Free; -end; - -function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer - ): TBGRACustomBitmap; -begin - result := FilterSharpen(bmp,rect(0,0,bmp.Width,bmp.Height),AAmount); -end; - -{ Filter contour computes for each pixel - the grayscale difference with surrounding pixels (in intensity and alpha) - and draw black pixels when there is a difference } -function FilterContour(bmp: TBGRACustomBitmap; AGammaCorrection: boolean = false): TBGRACustomBitmap; -var scanner: TBGRAContourScanner; -begin - result := bmp.NewBitmap(bmp.Width, bmp.Height); - scanner := TBGRAContourScanner.Create(bmp,rect(0,0,bmp.width,bmp.height),AGammaCorrection); - result.Fill(scanner); - scanner.Free; -end; - -function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap; -begin - result := FilterEmboss(bmp, angle, rect(0,0,bmp.Width,bmp.Height), AStrength, AOptions); -end; - -{ Emboss filter computes the difference between each pixel and the surrounding pixels - in the specified direction. } -function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap; -var - yb, xb: Int32or64; - dx, dy: single; - idx, idy: Int32or64; - x256,y256: Int32or64; - cMiddle: TBGRAPixel; - hMiddle: THSLAPixel; - - tempPixel, refPixel: TBGRAPixel; - pdest: PBGRAPixel; - - bounds: TRect; - psrc: PBGRAPixel; - redDiff,greenDiff,blueDiff: UInt32or64; - diff: Int32or64; -begin - //compute pixel position and weight - dx := cos(angle * Pi / 180); - dy := sin(angle * Pi / 180); - idx := floor(dx); - idy := floor(dy); - x256 := trunc((dx-idx)*256); - y256 := trunc((dy-idy)*256); - - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - if ABounds.IsEmpty then exit; - - bounds := bmp.GetImageBounds; - bounds.Intersect(ABounds); - if bounds.IsEmpty then exit; - bounds.Left := max(0, bounds.Left - 1); - bounds.Top := max(0, bounds.Top - 1); - bounds.Right := min(bmp.Width, bounds.Right + 1); - bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); - - if not (eoTransparent in AOptions) then - begin - if eoPreserveHue in AOptions then - Result.PutImagePart(ABounds.left,ABounds.top,bmp,ABounds,dmSet) - else - Result.FillRect(ABounds,BGRA(128, 128, 128, 255),dmSet); - end; - - //loop through destination - for yb := bounds.Top to bounds.bottom - 1 do - begin - pdest := Result.scanline[yb] + bounds.Left; - psrc := bmp.ScanLine[yb]+bounds.Left; - - for xb := bounds.Left+idx to bounds.Right-1+idx do - begin - refPixel := bmp.GetPixel256(xb,yb+idy,x256,y256); - cMiddle := psrc^; - inc(psrc); - - if eoPreserveHue in AOptions then - begin - diff := (integer(refPixel.red * refPixel.alpha) - integer(cMiddle.red * cMiddle.alpha)+ - integer(refPixel.green * refPixel.alpha) - integer(cMiddle.green * cMiddle.alpha)+ - integer(refPixel.blue * refPixel.alpha) - integer(cMiddle.blue * cMiddle.alpha))* AStrength div 128; - if diff > 0 then - hMiddle := BGRAToHSLA(refPixel) - else - hMiddle := BGRAToHSLA(cMiddle); - hMiddle.lightness := min(65535,max(0,hMiddle.lightness+diff)); - if eoTransparent in AOptions then - hMiddle.alpha := min(65535,abs(diff)); - pdest^ := HSLAToBGRA(hMiddle); - end else - begin - {$push}{$hints off}{$r-} - redDiff := UInt32or64(max(0, 65536 + (refPixel.red * refPixel.alpha - cMiddle.red * cMiddle.alpha) * AStrength div 64)) shr 9; - greenDiff := UInt32or64(max(0, 65536 + (refPixel.green * refPixel.alpha - cMiddle.green * cMiddle.alpha) * AStrength div 64)) shr 9; - blueDiff := UInt32or64(max(0, 65536 + (refPixel.blue * refPixel.alpha - cMiddle.blue * cMiddle.alpha) * AStrength div 64)) shr 9; - {$pop} - if (redDiff <> 128) or (greenDiff <> 128) or (blueDiff <> 128) then - begin - tempPixel.red := min(255, redDiff); - tempPixel.green := min(255, greenDiff); - tempPixel.blue := min(255, blueDiff); - if eoTransparent in AOptions then - begin - tempPixel.alpha := min(255,abs(Int32or64(redDiff-128))+abs(Int32or64(greenDiff-128))+abs(Int32or64(blueDiff-128))); - pdest^ := tempPixel; - end else - begin - tempPixel.alpha := 255; - pdest^ := tempPixel; - end; - end; - end; - - Inc(pdest); - end; - end; - Result.InvalidateBitmap; -end; - -{ Like general emboss, but with fixed direction and automatic color with transparency } -function FilterEmbossHighlight(bmp: TBGRACustomBitmap; - FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap; -var - bounds: TRect; - borderColorOverride: boolean; - borderColorLevel: Int32or64; - scan: TBGRAEmbossHightlightScanner; -begin - borderColorOverride := DefineBorderColor.alpha <> 0; - borderColorLevel := DefineBorderColor.red; - - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - - if borderColorOverride then - bounds := bmp.GetImageBounds(cRed, borderColorLevel) - else - bounds := bmp.GetImageBounds(cRed); - if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then - exit; - bounds.Left := max(0, bounds.Left - 1); - bounds.Top := max(0, bounds.Top - 1); - bounds.Right := min(bmp.Width, bounds.Right + 1); - bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); - - scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride); - scan.AllowDirectRead := true; - scan.FillSelection := FillSelection; - if borderColorOverride then scan.SourceBorderColor := DefineBorderColor; - Result.FillRect(bounds, scan, dmSet); - scan.Free; -end; - -function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap; - FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; -var - bounds: TRect; - borderColorOverride: boolean; - borderColorLevel: int32or64; - scan: TBGRAEmbossHightlightScanner; -begin - borderColorOverride := DefineBorderColor.alpha <> 0; - borderColorLevel := DefineBorderColor.red; - - if borderColorOverride then - bounds := bmp.GetImageBounds(cRed, borderColorLevel) - else - bounds := bmp.GetImageBounds(cRed); - if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then - begin - Result := bmp.NewBitmap(0, 0); - exit; - end; - bounds.Left := max(0, bounds.Left - 1); - bounds.Top := max(0, bounds.Top - 1); - bounds.Right := min(bmp.Width, bounds.Right + 1); - bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); - - Result := bmp.NewBitmap(bounds.Right-Bounds.Left+1, bounds.Bottom-Bounds.Top+1); - inc(Offset.X, bounds.Left); - inc(Offset.Y, bounds.Top); - - scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride); - scan.AllowDirectRead := true; - scan.FillSelection := FillSelection; - if borderColorOverride then scan.SourceBorderColor := DefineBorderColor; - Result.FillRect(rect(0,0,result.Width,result.Height), scan, dmSet, Offset); - scan.Free; -end; - -{ For each component, sort values to get the median } -function FilterMedian(bmp: TBGRACustomBitmap; - Option: TMedianOption): TBGRACustomBitmap; - - function ComparePixLt(p1, p2: TBGRAPixel): boolean; - begin - if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then - Result := (int32or64(p1.red) shl 8) + (int32or64(p1.green) shl 16) + - int32or64(p1.blue) < (int32or64(p2.red) shl 8) + (int32or64(p2.green) shl 16) + - int32or64(p2.blue) - else - Result := (p1.red + p1.green + p1.blue) < (p2.red + p2.green + p2.blue); - end; - -const - nbpix = 9; -var - yb, xb: int32or64; - dx, dy, n, i, j, k: int32or64; - a_pixels: array[0..nbpix - 1] of TBGRAPixel; - tempPixel, refPixel: TBGRAPixel; - tempValue: byte; - sumR, sumG, sumB, sumA, BGRAdiv, nbA: uint32or64; - tempAlpha: word; - bounds: TRect; - pdest: PBGRAPixel; -begin - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - - bounds := bmp.GetImageBounds; - if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then - exit; - bounds.Left := max(0, bounds.Left - 1); - bounds.Top := max(0, bounds.Top - 1); - bounds.Right := min(bmp.Width, bounds.Right + 1); - bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); - - for yb := bounds.Top to bounds.bottom - 1 do - begin - pdest := Result.scanline[yb] + bounds.left; - for xb := bounds.left to bounds.right - 1 do - begin - n := 0; - for dy := -1 to 1 do - for dx := -1 to 1 do - begin - a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy); - if a_pixels[n].alpha = 0 then - a_pixels[n] := BGRAPixelTransparent; - Inc(n); - end; - for i := 1 to n - 1 do - begin - j := i; - while (j > 1) and (a_pixels[j].alpha < a_pixels[j - 1].alpha) do - begin - tempValue := a_pixels[j].alpha; - a_pixels[j].alpha := a_pixels[j - 1].alpha; - a_pixels[j - 1].alpha := tempValue; - Dec(j); - end; - j := i; - while (j > 1) and (a_pixels[j].red < a_pixels[j - 1].red) do - begin - tempValue := a_pixels[j].red; - a_pixels[j].red := a_pixels[j - 1].red; - a_pixels[j - 1].red := tempValue; - Dec(j); - end; - j := i; - while (j > 1) and (a_pixels[j].green < a_pixels[j - 1].green) do - begin - tempValue := a_pixels[j].green; - a_pixels[j].green := a_pixels[j - 1].green; - a_pixels[j - 1].green := tempValue; - Dec(j); - end; - j := i; - while (j > 1) and (a_pixels[j].blue < a_pixels[j - 1].blue) do - begin - tempValue := a_pixels[j].blue; - a_pixels[j].blue := a_pixels[j - 1].blue; - a_pixels[j - 1].blue := tempValue; - Dec(j); - end; - end; - - refPixel := a_pixels[n div 2]; - - if option in [moLowSmooth, moMediumSmooth, moHighSmooth] then - begin - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - BGRAdiv := 0; - nbA := 0; - - case option of - moHighSmooth, moMediumSmooth: - begin - j := 2; - k := 2; - end; - else - begin - j := 1; - k := 1; - end; - end; - - {$hints off} - for i := -k to j do - begin - tempPixel := a_pixels[n div 2 + i]; - tempAlpha := tempPixel.alpha; - if (option = moMediumSmooth) and ((i = -k) or (i = j)) then - tempAlpha := tempAlpha div 2; - - inc(sumR, tempPixel.red * tempAlpha ); - inc(sumG, tempPixel.green * tempAlpha ); - inc(sumB, tempPixel.blue * tempAlpha ); - inc(BGRAdiv, tempAlpha); - - inc(sumA, tempAlpha); - Inc(nbA); - end; - {$hints on} - if option = moMediumSmooth then - Dec(nbA); - - if (BGRAdiv = 0) then - refPixel := BGRAPixelTransparent - else - begin - refPixel.red := round(sumR / BGRAdiv); - refPixel.green := round(sumG / BGRAdiv); - refPixel.blue := round(sumB / BGRAdiv); - refPixel.alpha := round(sumA / nbA); - end; - end; - - pdest^ := refPixel; - Inc(pdest); - end; - end; -end; - -//////////////////////// DEFORMATION FILTERS ///////////////////////////////// - -{ Compute the distance for each pixel to the center of the bitmap, - calculate the corresponding angle with arcsin, use this angle - to determine a distance from the center in the source bitmap } -function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap; -var - cx, cy: single; - scanner: TBGRASphereDeformationScanner; -begin - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - cx := bmp.Width / 2 - 0.5; - cy := bmp.Height / 2 - 0.5; - scanner := TBGRASphereDeformationScanner.Create(bmp,PointF(cx,cy),bmp.Width/2,bmp.Height/2); - result.FillEllipseAntialias(cx,cy,bmp.Width/2-0.5,bmp.Height/2-0.5,scanner); - scanner.Free; -end; - -{ Applies twirl scanner. See TBGRATwirlScanner } -function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; -var twirl: TBGRATwirlScanner; -begin - twirl := TBGRATwirlScanner.Create(bmp,ACenter,ARadius,ATurn,AExponent); - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - result.FillRect(ABounds, twirl, dmSet); - twirl.free; -end; - -function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; - ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap; -begin - result := FilterTwirl(bmp,rect(0,0,bmp.Width,bmp.Height),ACenter,ARadius,ATurn,AExponent); -end; - -{ Compute the distance for each pixel to the vertical axis of the bitmap, - calculate the corresponding angle with arcsin, use this angle - to determine a distance from the vertical axis in the source bitmap } -function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap; -var - cx: single; - scanner: TBGRAVerticalCylinderDeformationScanner; -begin - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - cx := bmp.Width / 2 - 0.5; - scanner := TBGRAVerticalCylinderDeformationScanner.Create(bmp,cx,bmp.Width/2); - result.Fill(scanner); - scanner.Free; -end; - -function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap; -const resampleGap=0.6; -var - cy, x1, x2, y1, y2, z1, z2, h: single; - yb: int32or64; - resampledBmp: TBGRACustomBitmap; - resampledBmpWidth: int32or64; - resampledFactor,newResampleFactor: single; - sub,resampledSub: TBGRACustomBitmap; - partRect: TRect; - resampleSizeY : int32or64; -begin - resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch); - resampledBmpWidth := resampledBmp.Width; - resampledFactor := 2; - Result := bmp.NewBitmap(bmp.Width, bmp.Height*2); - cy := result.Height / 2 - 0.5; - h := 1; - for yb := 0 to ((Result.Height-1) div 2) do - begin - y1 := (cy - (yb-0.5)) / (cy+0.5); - y2 := (cy - (yb+0.5)) / (cy+0.5); - if y2 <= 0 then continue; - z1 := h/y1; - z2 := h/y2; - newResampleFactor := 1/(z2-z1)*1.5; - - x1 := (z1+1)/2; - x2 := (z2+1)/2; - if newResampleFactor <= resampledFactor*resampleGap then - begin - resampledFactor := newResampleFactor; - if resampledBmp <> bmp then resampledBmp.Free; - if (x2-x1 >= 1) then resampleSizeY := 1 else - resampleSizeY := round(1+((x2-x1)-1)/(1/bmp.Height-1)*(bmp.Height-1)); - resampledBmp := bmp.Resample(max(1,round(bmp.Width*resampledFactor)),resampleSizeY,rmSimpleStretch); - resampledBmpWidth := resampledBmp.Width; - end; - - partRect := Rect(round(-resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x1*resampledBmp.Height), - round(resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x2*resampledBmp.Height)+1); - if x2-x1 > 1 then - begin - partRect.Top := 0; - partRect.Bottom := 1; - end; - sub := resampledBmp.GetPart(partRect); - if sub <> nil then - begin - resampledSub := sub.Resample(bmp.Width,1,rmFineResample); - result.PutImage(0,yb,resampledSub,dmSet); - result.PutImage(0,Result.Height-1-yb,resampledSub,dmSet); - resampledSub.free; - sub.free; - end; - end; - if resampledBmp <> bmp then resampledBmp.Free; - - if result.Height <> bmp.Height then - begin - resampledBmp := result.Resample(bmp.Width,bmp.Height,rmSimpleStretch); - result.free; - result := resampledBmp; - end; -end; - -{ Rotates the image. To do this, loop through the destination and - calculates the position in the source bitmap with an affine transformation } -function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF; - angle: single; correctBlur: boolean): TBGRACustomBitmap; -begin - Result := bmp.NewBitmap(bmp.Width, bmp.Height); - Result.PutImageAngle(0,0,bmp,angle,origin.x,origin.y,255,true,correctBlur); -end; - -///////////////////////// BLUR FILTERS ////////////////////////////////////// - -function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; -var task: TFilterTask; -begin - task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius,blurType); - result := task.Execute; - task.Free; -end; - -function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; -var task: TFilterTask; -begin - task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radiusX,radiusY,blurType); - result := task.Execute; - task.Free; -end; - -function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask; -begin - result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType); -end; - -function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; - ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask; -begin - result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType); -end; - -{ Precise blur } - -function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; -var task: TRadialBlurTask; -begin - task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius*10,rbPrecise); - result := task.Execute; - task.Free; -end; - -function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask; -begin - result := TRadialBlurTask.Create(ABmp,ABounds,ARadius*10,rbPrecise); -end; - -function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; -var task: TFilterTask; -begin - task := CreateMotionBlurTask(bmp, rect(0,0,bmp.Width,bmp.Height), distance, angle, oriented); - result := task.Execute; - task.Free; -end; - -function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; - ADistance, AAngle: single; AOriented: boolean): TMotionBlurTask; -begin - result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented); -end; - -function FilterBlur(bmp: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap; -var task: TFilterTask; -begin - task := TCustomBlurTask.Create(bmp,rect(0,0,bmp.Width,bmp.Height), AMask, AMaskIsThreadSafe); - result := task.Execute; - task.Free; -end; - -function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; - AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask; -begin - result := TCustomBlurTask.Create(ABmp, ABounds, AMask, AMaskIsThreadSafe); -end; - -///////////////////////////////////// OTHER FILTERS /////////////////////////// - -function FilterSmartZoom3(bmp: TBGRACustomBitmap; - Option: TMedianOption): TBGRACustomBitmap; -type - TSmartDiff = record - d, cd, sd, b, a: single; - end; - -var - xb, yb: Int32or64; - diag1, diag2, h1, h2, v1, v2: TSmartDiff; - c,c1,c2: TBGRAPixel; - temp, median: TBGRACustomBitmap; - - function ColorDiff(c1, c2: TBGRAPixel): single; - var - max1, max2: Int32or64; - begin - if (c1.alpha = 0) and (c2.alpha = 0) then - begin - Result := 0; - exit; - end - else - if (c1.alpha = 0) or (c2.alpha = 0) then - begin - Result := 1; - exit; - end; - max1 := c1.red; - if c1.green > max1 then - max1 := c1.green; - if c1.blue > max1 then - max1 := c1.blue; - - max2 := c2.red; - if c2.green > max2 then - max2 := c2.green; - if c2.blue > max2 then - max2 := c2.blue; - - if (max1 = 0) or (max2 = 0) then - begin - Result := 0; - exit; - end; - Result := (abs(c1.red / max1 - c2.red / max2) + - abs(c1.green / max1 - c2.green / max2) + abs(c1.blue / max1 - c2.blue / max2)) / 3; - end; - - function RGBDiff(c1, c2: TBGRAPixel): single; - begin - if (c1.alpha = 0) and (c2.alpha = 0) then - begin - Result := 0; - exit; - end - else - if (c1.alpha = 0) or (c2.alpha = 0) then - begin - Result := 1; - exit; - end; - Result := (abs(c1.red - c2.red) + abs(c1.green - c2.green) + - abs(c1.blue - c2.blue)) / 3 / 255; - end; - - function smartDiff(x1, y1, x2, y2: Int32or64): TSmartDiff; - var - c1, c2, c1m, c2m: TBGRAPixel; - begin - c1 := bmp.GetPixel(x1, y1); - c2 := bmp.GetPixel(x2, y2); - c1m := median.GetPixel(x1, y1); - c2m := median.GetPixel(x2, y2); - Result.d := RGBDiff(c1, c2); - Result.cd := ColorDiff(c1, c2); - Result.a := c1.alpha / 255 * c2.alpha / 255; - Result.d := Result.d * Result.a + (1 - Result.a) * - (1 + abs(c1.alpha - c2.alpha) / 255) / 5; - Result.b := RGBDiff(c1, c1m) * c1.alpha / 255 * c1m.alpha / 255 + - RGBDiff(c2, c2m) * c2.alpha / 255 * c2m.alpha / 255 + - (abs(c1.alpha - c1m.alpha) + abs(c2.alpha - c2m.alpha)) / 255 / 4; - Result.sd := Result.d + Result.cd * 3; - end; - -var - diff: single; - -begin - median := FilterMedian(bmp, moNone); - - temp := bmp.Resample(bmp.Width * 3, bmp.Height * 3, rmSimpleStretch); - Result := FilterMedian(temp, Option); - temp.Free; - - for yb := 0 to bmp.Height - 2 do - for xb := 0 to bmp.Width - 2 do - begin - diag1 := smartDiff(xb, yb, xb + 1, yb + 1); - diag2 := smartDiff(xb, yb + 1, xb + 1, yb); - - h1 := smartDiff(xb, yb, xb + 1, yb); - h2 := smartDiff(xb, yb + 1, xb + 1, yb + 1); - v1 := smartDiff(xb, yb, xb, yb + 1); - v2 := smartDiff(xb + 1, yb, xb + 1, yb + 1); - - diff := diag1.sd - diag2.sd; - if abs(diff) < 3 then - DecF(diff, (diag1.b - diag2.b) * (3 - abs(diff)) / 2); - //which diagonal to highlight? - if abs(diff) < 0.2 then - diff := 0; - - if diff < 0 then - begin - //same color? - if diag1.cd < 0.3 then - begin - c1 := bmp.GetPixel(xb, yb); - c2 := bmp.GetPixel(xb + 1, yb + 1); - c := MergeBGRA(c1, c2); - //restore - Result.SetPixel(xb * 3 + 2, yb * 3 + 2, bmp.GetPixel(xb, yb)); - Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(xb + 1, yb + 1)); - - if (diag1.sd < h1.sd) and (diag1.sd < v2.sd) then - Result.SetPixel(xb * 3 + 3, yb * 3 + 2, c); - if (diag1.sd < h2.sd) and (diag1.sd < v1.sd) then - Result.SetPixel(xb * 3 + 2, yb * 3 + 3, c); - end; - end - else - if diff > 0 then - begin - //same color? - if diag2.cd < 0.3 then - begin - c1 := bmp.GetPixel(xb, yb + 1); - c2 := bmp.GetPixel(xb + 1, yb); - c := MergeBGRA(c1, c2); - //restore - Result.SetPixel(xb * 3 + 3, yb * 3 + 2, bmp.GetPixel(xb + 1, yb)); - Result.SetPixel(xb * 3 + 2, yb * 3 + 3, bmp.GetPixel(xb, yb + 1)); - - if (diag2.sd < h1.sd) and (diag2.sd < v1.sd) then - Result.SetPixel(xb * 3 + 2, yb * 3 + 2, c); - if (diag2.sd < h2.sd) and (diag2.sd < v2.sd) then - Result.SetPixel(xb * 3 + 3, yb * 3 + 3, c); - - end; - end; - end; - - median.Free; -end; - -function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; - useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap; -var yb,xb, xs,ys, tx,ty: Int32or64; - psrc,pdest: PBGRAPixel; - temp,stretched: TBGRACustomBitmap; - oldfilter: TResampleFilter; -begin - if pixelSize < 1 then - begin - result := bmp.Duplicate; - exit; - end; - result := bmp.NewBitmap(bmp.Width,bmp.Height); - - tx := (bmp.Width+pixelSize-1) div pixelSize; - ty := (bmp.Height+pixelSize-1) div pixelSize; - if not useResample then - begin - temp := bmp.NewBitmap(tx,ty); - - xs := (bmp.Width mod pixelSize) div 2; - ys := (bmp.Height mod pixelSize) div 2; - - for yb := 0 to temp.height-1 do - begin - pdest := temp.ScanLine[yb]; - psrc := bmp.scanline[ys]+xs; - inc(ys,pixelSize); - for xb := temp.width-1 downto 0 do - begin - pdest^ := psrc^; - inc(pdest); - inc(psrc,pixelSize); - end; - end; - temp.InvalidateBitmap; - end else - begin - oldfilter := bmp.ResampleFilter; - bmp.ResampleFilter := filter; - temp := bmp.Resample(tx,ty,rmFineResample); - bmp.ResampleFilter := oldfilter; - end; - stretched := temp.Resample(temp.Width*pixelSize,temp.Height*pixelSize,rmSimpleStretch); - temp.free; - if bmp.Width mod pixelSize = 0 then - xs := 0 - else - xs := (-pixelSize+(bmp.Width mod pixelSize)) div 2; - if bmp.Height mod pixelSize = 0 then - ys := 0 - else - ys := (-pixelSize+(bmp.Height mod pixelSize)) div 2; - result.PutImage(xs,ys,stretched,dmSet); - stretched.Free; -end; - -end. - diff --git a/components/bgrabitmap/bgrafilterscanner.pas b/components/bgrabitmap/bgrafilterscanner.pas deleted file mode 100644 index 62d251e..0000000 --- a/components/bgrabitmap/bgrafilterscanner.pas +++ /dev/null @@ -1,788 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAFilterScanner; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, BGRABitmapTypes, BGRAFilterType; - -type - { TBGRAFilterScannerGrayscale } - { Grayscale converts colored pixel into grayscale with same luminosity } - TBGRAFilterScannerGrayscale = class(TBGRAFilterScannerPixelwise) - class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; - ACount: integer; AGammaCorrection: boolean); override; - end; - - { TBGRAFilterScannerNegative } - - TBGRAFilterScannerNegative = class(TBGRAFilterScannerPixelwise) - class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; - ACount: integer; AGammaCorrection: boolean); override; - end; - - { TBGRAFilterScannerSwapRedBlue } - - TBGRAFilterScannerSwapRedBlue = class(TBGRAFilterScannerPixelwise) - class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; - ACount: integer; {%H-}AGammaCorrection: boolean); override; - end; - - { TBGRAFilterScannerNormalize } - { Normalize compute min-max of specified channel and apply an affine transformation - to make it use the full range of values } - TBGRAFilterScannerNormalize = class(TBGRAFilterScannerPixelwise) - private - minValRed, maxValRed, minValGreen, maxValGreen, - minValBlue, maxValBlue, minAlpha, maxAlpha: word; - addValRed, addValGreen, addValBlue, addAlpha: word; - factorValRed, factorValGreen, factorValBlue, factorAlpha: int32or64; - procedure DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean); - protected - procedure DoComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; - ACount: integer; {%H-}AGammaCorrection: boolean); override; - public - constructor Create(ASource: IBGRAScanner; AOffset: TPoint; ABounds: TRect; - AEachChannel: boolean); - class procedure ComputeFilterAt({%H-}ASource: PBGRAPixel; {%H-}ADest: PBGRAPixel; - {%H-}ACount: integer; {%H-}AGammaCorrection: boolean); override; - end; - - { TBGRA3X3FilterScanner } - - TBGRA3X3FilterScanner = class(TBGRAFilterScannerMultipixel) - protected - FSourceBorderColor,FDestinationBorderColor: TBGRAPixel; - FAutoSourceBorderColor: boolean; - function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; virtual; abstract; - procedure DoComputeFilter(BufferX: Integer; - const Buffers: array of PBGRAPixel; BufferWidth: integer; - ADest: PBGRAPixel; ACount: integer); override; - public - constructor Create(ASource: IBGRAScanner; ABounds: TRect); overload; - constructor Create(ASource: TBGRACustomBitmap); overload; - property SourceBorderColor: TBGRAPixel read FSourceBorderColor write FSourceBorderColor; - property DestinationBorderColor: TBGRAPixel read FDestinationBorderColor write FDestinationBorderColor; - property AutoSourceBorderColor: boolean read FAutoSourceBorderColor write FAutoSourceBorderColor; - end; - - { TBGRAContourScanner } - { Filter contour compute a grayscale image, then for each pixel - calculates the difference with surrounding pixels (in intensity and alpha) - and draw black pixels when there is a difference } - TBGRAContourScanner = class(TBGRA3X3FilterScanner) - protected - FGammaCorrection: boolean; - FOpacity: byte; - function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override; - public - constructor Create(ASource: IBGRAScanner; ABounds: TRect; - AGammaCorrection: boolean = False); overload; - constructor Create(ASource: TBGRACustomBitmap; - AGammaCorrection: boolean = False); overload; - property Opacity: Byte read FOpacity write FOpacity; - end; - - { TBGRASharpenScanner } - - TBGRASharpenScanner = class(TBGRA3X3FilterScanner) - protected - FAmount: integer; - function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override; - public - constructor Create(ASource: IBGRAScanner; ABounds: TRect; - AAmount: integer = 256); overload; - constructor Create(ASource: TBGRACustomBitmap; - AAmount: integer = 256); overload; - end; - - { TBGRAEmbossHightlightScanner } - - TBGRAEmbossHightlightScanner = class(TBGRA3X3FilterScanner) - protected - FFillSelection: boolean; - FSourceChannel: TChannel; - FChannelOffset: Byte; - function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override; - procedure SetSourceChannel(AValue: TChannel); - public - constructor Create(ASource: IBGRAScanner; ABounds: TRect; ABoundsVisible: Boolean); overload; - constructor Create(ASource: TBGRACustomBitmap; ABoundsVisible: Boolean); overload; - property FillSelection: boolean read FFillSelection write FFillSelection; - property SourceChannel: TChannel read FSourceChannel write SetSourceChannel; - end; - -implementation - -uses BGRABlend, math, SysUtils; - -{ TBGRAEmbossHightlightScanner } - -procedure TBGRAEmbossHightlightScanner.SetSourceChannel(AValue: TChannel); -begin - FSourceChannel:=AValue; - FChannelOffset:= TBGRAPixel_ChannelByteOffset[FSourceChannel]; -end; - -function TBGRAEmbossHightlightScanner.DoFilter3X3(PTop, PMiddle, - PBottom: PBGRAPixel): TBGRAPixel; -var - sum: Int32or64; - slope,h: byte; - highlight: TBGRAPixel; -begin - sum := Int32or64((PByte(PTop)+FChannelOffset)^) + - Int32or64((PByte(PTop+1)+FChannelOffset)^) + - Int32or64((PByte(PMiddle)+FChannelOffset)^) - - Int32or64((PByte(PMiddle+2)+FChannelOffset)^) - - Int32or64((PByte(PBottom+1)+FChannelOffset)^) - - Int32or64((PByte(PBottom+2)+FChannelOffset)^); - sum := 128 - sum div 3; - if sum > 255 then - slope := 255 - else - if sum < 1 then - slope := 1 - else - slope := sum; - h := (PByte(PMiddle+1)+FChannelOffset)^; - - result.red := slope; - result.green := slope; - result.blue := slope; - result.alpha := abs(slope - 128) * 2; - - if FFillSelection then - begin - highlight := BGRA(h shr 2, h shr 1, h, h shr 1); - if result.red < highlight.red then - result.red := highlight.red; - if result.green < highlight.green then - result.green := highlight.green; - if result.blue < highlight.blue then - result.blue := highlight.blue; - if result.alpha < highlight.alpha then - result.alpha := highlight.alpha; - end; -end; - -constructor TBGRAEmbossHightlightScanner.Create(ASource: IBGRAScanner; - ABounds: TRect; ABoundsVisible: Boolean); -begin - inherited Create(ASource,ABounds); - SourceChannel := cGreen; - FillSelection:= true; - AutoSourceBorderColor := not ABoundsVisible; -end; - -constructor TBGRAEmbossHightlightScanner.Create(ASource: TBGRACustomBitmap; - ABoundsVisible: Boolean); -begin - inherited Create(ASource); - SourceChannel := cGreen; - FillSelection:= true; - AutoSourceBorderColor := not ABoundsVisible; -end; - -{ TBGRA3X3FilterScanner } - -procedure TBGRA3X3FilterScanner.DoComputeFilter(BufferX: Integer; - const Buffers: array of PBGRAPixel; BufferWidth: integer; ADest: PBGRAPixel; - ACount: integer); -var MiddleX: Integer; - TopLine,MiddleLine,BottomLine: array[0..2] of TBGRAPixel; - PTop,PMiddle,PBottom: PBGRAPixel; - borderColor: TBGRAPixel; -begin - if Buffers[1] = nil then - begin - FillDWord(ADest^, ACount, LongWord(FDestinationBorderColor)); - exit; - end; - MiddleX := BufferX+1; - while (ACount > 0) and (MiddleX < 0) do - begin - ADest^ := FDestinationBorderColor; - Dec(ACount); - Inc(ADest); - Inc(MiddleX); - end; - if (ACount > 0) and (MiddleX = 0) and (MiddleX < BufferWidth) then - begin - MiddleLine[1] := Buffers[1][MiddleX]; - if AutoSourceBorderColor then borderColor := MiddleLine[1] - else borderColor := FSourceBorderColor; - - TopLine[0] := borderColor; - MiddleLine[0] := borderColor; - BottomLine[0] := borderColor; - if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX]; - if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX]; - inc(MiddleX); - if MiddleX >= BufferWidth then - begin - TopLine[2] := borderColor; - MiddleLine[2] := borderColor; - BottomLine[2] := borderColor; - end else - begin - if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX]; - MiddleLine[2] := Buffers[1][MiddleX]; - if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX]; - end; - ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine); - Dec(ACount); - Inc(ADest); - end; - if (Buffers[0]<>nil) and (Buffers[2]<>nil) then - begin - while (ACount > 0) and (MiddleX+1 < BufferWidth) do - begin - ADest^ := DoFilter3X3(@Buffers[0][MiddleX-1],@Buffers[1][MiddleX-1],@Buffers[2][MiddleX-1]); - Inc(MiddleX); - Dec(ACount); - Inc(ADest); - end; - end else - begin - if not AutoSourceBorderColor then - begin - TopLine[0] := FSourceBorderColor; - TopLine[1] := FSourceBorderColor; - TopLine[2] := FSourceBorderColor; - BottomLine[0] := FSourceBorderColor; - BottomLine[1] := FSourceBorderColor; - BottomLine[2] := FSourceBorderColor; - end; - while (ACount > 0) and (MiddleX+1 < BufferWidth) do - begin - PMiddle:= @Buffers[1][MiddleX-1]; - if Buffers[0] = nil then - begin - if AutoSourceBorderColor then - begin - TopLine[0] := PMiddle[1]; - TopLine[1] := PMiddle[1]; - TopLine[2] := PMiddle[1]; - end; - PTop := @TopLine; - end - else PTop := @Buffers[0][MiddleX-1]; - if Buffers[2] = nil then - begin - if AutoSourceBorderColor then - begin - BottomLine[0] := PMiddle[1]; - BottomLine[1] := PMiddle[1]; - BottomLine[2] := PMiddle[1]; - end; - PBottom := @BottomLine; - end - else PBottom := @Buffers[2][MiddleX-1]; - ADest^ := DoFilter3X3(PTop,PMiddle,PBottom); - Inc(MiddleX); - Dec(ACount); - Inc(ADest); - end; - end; - if (ACount > 0) and (MiddleX < BufferWidth) then - begin - MiddleLine[1] := Buffers[1][MiddleX]; - if AutoSourceBorderColor then borderColor := MiddleLine[1] - else borderColor := FSourceBorderColor; - - if Buffers[0] = nil then TopLine[0] := borderColor else TopLine[0] := Buffers[0][MiddleX-1]; - MiddleLine[0] := Buffers[1][MiddleX-1]; - if Buffers[2] = nil then BottomLine[0] := borderColor else BottomLine[0] := Buffers[2][MiddleX-1]; - if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX]; - if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX]; - inc(MiddleX); - if MiddleX >= BufferWidth then - begin - TopLine[2] := borderColor; - MiddleLine[2] := borderColor; - BottomLine[2] := borderColor; - end else - begin - if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX]; - MiddleLine[2] := Buffers[1][MiddleX]; - if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX]; - end; - ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine); - Dec(ACount); - Inc(ADest); - end; - while (ACount > 0) do - begin - ADest^ := FDestinationBorderColor; - Dec(ACount); - Inc(ADest); - end; -end; - -constructor TBGRA3X3FilterScanner.Create(ASource: IBGRAScanner; - ABounds: TRect); -begin - inherited Create(ASource,ABounds,Point(-1,-1),3,3); - FSourceBorderColor := BGRAPixelTransparent; - FDestinationBorderColor := BGRAPixelTransparent; - FAutoSourceBorderColor := False; -end; - -constructor TBGRA3X3FilterScanner.Create(ASource: TBGRACustomBitmap); -begin - inherited Create(ASource,Rect(0,0,ASource.Width,ASource.Height),Point(-1,-1),3,3); - FSourceBorderColor := BGRAPixelTransparent; - FDestinationBorderColor := BGRAPixelTransparent; - FAutoSourceBorderColor := False; - AllowDirectRead := true; -end; - -{ TBGRASharpenScanner } - -function TBGRASharpenScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel; -var - sumR, sumG, sumB, sumA, nbA: UInt32or64; - refPixel: TBGRAPixel; - rgbDivShr1: UInt32or64; -begin - if FAmount = 0 then - begin - result := PMiddle[1]; - exit; - end; - //compute sum - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - //RGBdiv := 0; - nbA := 0; - - {$hints off} - with PTop[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - with PTop[1] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - with PTop[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - with PMiddle[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - with PMiddle[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - with PBottom[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - with PBottom[1] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - with PBottom[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end; - {$hints on} - - //we finally have an average pixel - if (sumA = 0) then - refPixel := BGRAPixelTransparent - else - begin - rgbDivShr1:= sumA shr 1; - refPixel.red := (sumR + rgbDivShr1) div sumA; - refPixel.green := (sumG + rgbDivShr1) div sumA; - refPixel.blue := (sumB + rgbDivShr1) div sumA; - refPixel.alpha := (sumA + nbA shr 1) div nbA; - end; - - //read the pixel at the center of the square - if refPixel <> BGRAPixelTransparent then - begin - with PMiddle[1] do - begin - //compute sharpened pixel by adding the difference - if FAmount<>256 then - result := BGRA( max(0, min($FFFF, Int32or64(red shl 8) + - FAmount*(red - refPixel.red))) shr 8, - max(0, min($FFFF, Int32or64(green shl 8) + - FAmount*(green - refPixel.green))) shr 8, - max(0, min($FFFF, Int32or64(blue shl 8) + - FAmount*(blue - refPixel.blue))) shr 8, - max(0, min($FFFF, Int32or64(alpha shl 8) + - FAmount*(alpha - refPixel.alpha))) shr 8 ) - else - result := BGRA( max(0, min(255, (red shl 1) - refPixel.red)), - max(0, min(255, (green shl 1) - refPixel.green)), - max(0, min(255, (blue shl 1) - refPixel.blue)), - max(0, min(255, (alpha shl 1) - refPixel.alpha))); - end; - end else - result := PMiddle[1]; -end; - -constructor TBGRASharpenScanner.Create(ASource: IBGRAScanner; - ABounds: TRect; AAmount: integer); -begin - inherited Create(ASource,ABounds); - FAmount:= AAmount; -end; - -constructor TBGRASharpenScanner.Create(ASource: TBGRACustomBitmap; - AAmount: integer); -begin - inherited Create(ASource); - FAmount:= AAmount; -end; - -{ TBGRAContourScanner } - -function TBGRAContourScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel; -var - sum: Int32or64; - slope: byte; -begin - if FGammaCorrection then - begin - sum := (FastBGRAExpandedDiff(PTop[0],PBottom[2]) + FastBGRAExpandedDiff(PTop[1],PBottom[1]) + - FastBGRAExpandedDiff(PTop[2],PBottom[0]) + FastBGRAExpandedDiff(PMiddle[0],PMiddle[2])) div 3; - - if sum >= 65535 then - slope := 0 - else if sum <= 0 then - slope := 255 - else slope := GammaCompressionTab[65535-sum]; - end else - begin - sum := (FastBGRALinearDiff(PTop[0],PBottom[2]) + FastBGRALinearDiff(PTop[1],PBottom[1]) + - FastBGRALinearDiff(PTop[2],PBottom[0]) + FastBGRALinearDiff(PMiddle[0],PMiddle[2])) div 3; - - if sum >= 255 then - slope := 0 - else if sum < 0 then - slope := 255 - else slope := 255-sum; - end; - result.red := slope; - result.green := slope; - result.blue := slope; - result.alpha := FOpacity; -end; - -constructor TBGRAContourScanner.Create(ASource: IBGRAScanner; - ABounds: TRect; AGammaCorrection: boolean); -begin - inherited Create(ASource,ABounds); - FGammaCorrection := AGammaCorrection; - AutoSourceBorderColor:= True; - FOpacity:= 255; -end; - -constructor TBGRAContourScanner.Create(ASource: TBGRACustomBitmap; - AGammaCorrection: boolean); -begin - inherited Create(ASource); - FGammaCorrection := AGammaCorrection; - AutoSourceBorderColor:= True; - FOpacity:= 255; -end; - -{ TBGRAFilterScannerNormalize } - -procedure TBGRAFilterScannerNormalize.DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean); -var - buffer: TBGRAPixelBuffer; - p: PBGRAPixel; - c: TExpandedPixel; - yb, xb: LongInt; -begin - if (ABounds.Right <= ABounds.Left) or (ABounds.Bottom <= ABounds.Top) then - begin - addValRed := 0; - addValGreen := 0; - addValBlue := 0; - addAlpha := 0; - factorValRed := 4096; - factorValGreen := 4096; - factorValBlue := 4096; - factorAlpha := 4096; - exit; - end; - maxValRed := 0; - minValRed := 65535; - maxValGreen := 0; - minValGreen := 65535; - maxValBlue := 0; - minValBlue := 65535; - maxAlpha := 0; - minAlpha := 65535; - buffer := nil; - for yb := ABounds.Top to ABounds.Bottom do - begin - if Source.ProvidesScanline(rect(ABounds.Left,yb,ABounds.Right,yb+1)) then - p := Source.GetScanlineAt(ABounds.Left,yb) - else - begin - Source.ScanMoveTo(ABounds.Left,yb); - AllocateBGRAPixelBuffer(buffer, ABounds.Right-ABounds.Left); - p := @buffer[0]; - ScannerPutPixels(Source,p,ABounds.Right-ABounds.Left,dmSet); - end; - for xb := ABounds.Right-ABounds.Left-1 downto 0 do - begin - c := GammaExpansion(p[xb]); - if c.red > maxValRed then - maxValRed := c.red; - if c.green > maxValGreen then - maxValGreen := c.green; - if c.blue > maxValBlue then - maxValBlue := c.blue; - if c.red < minValRed then - minValRed := c.red; - if c.green < minValGreen then - minValGreen := c.green; - if c.blue < minValBlue then - minValBlue := c.blue; - if c.alpha > maxAlpha then - maxAlpha := c.alpha; - if c.alpha < minAlpha then - minAlpha := c.alpha; - end; - end; - if not AEachChannel then - begin - minValRed := min(min(minValRed, minValGreen), minValBlue); - maxValRed := max(max(maxValRed, maxValGreen), maxValBlue); - minValGreen := minValRed; - maxValGreen := maxValRed; - minValBlue := minValBlue; - maxValBlue := maxValBlue; - end; - if maxValRed > minValRed then - begin - factorValRed := 268431360 div (maxValRed - minValRed); - addValRed := 0; - end else - begin - factorValRed := 0; - if minValRed = 0 then - addValRed := 0 - else addValRed := 65535; - end; - if maxValGreen > minValGreen then - begin - factorValGreen := 268431360 div (maxValGreen - minValGreen); - addValGreen := 0; - end else - begin - factorValGreen := 0; - if minValGreen = 0 then - addValGreen := 0 - else addValGreen := 65535; - end; - if maxValBlue > minValBlue then - begin - factorValBlue := 268431360 div (maxValBlue - minValBlue); - addValBlue := 0; - end else - begin - factorValBlue := 0; - if minValBlue = 0 then - addValBlue := 0 else - addValBlue := 65535; - end; - if maxAlpha > minAlpha then - begin - factorAlpha := 268431360 div (maxAlpha - minAlpha); - addAlpha := 0; - end else - begin - factorAlpha := 0; - if minAlpha = 0 then - addAlpha := 0 else - addAlpha := 65535; - end; -end; - -procedure TBGRAFilterScannerNormalize.DoComputeFilterAt(ASource: PBGRAPixel; - ADest: PBGRAPixel; ACount: integer; AGammaCorrection: boolean); -var - c: TExpandedPixel; -begin - While ACount > 0 do - begin - c := GammaExpansion(ASource^); - Inc(ASource); - c.red := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed; - c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen; - c.blue := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue; - c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha; - ADest^ := GammaCompression(c); - Inc(ADest); - dec(ACount); - end; -end; - -constructor TBGRAFilterScannerNormalize.Create(ASource: IBGRAScanner; - AOffset: TPoint; ABounds: TRect; AEachChannel: boolean); -begin - inherited Create(ASource,AOffset,True); - DetermineNormalizationFactors(ABounds, AEachChannel); -end; - -class procedure TBGRAFilterScannerNormalize.ComputeFilterAt( - ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; - AGammaCorrection: boolean); -begin - raise exception.Create('Normalize filter scanner cannot be called as a class procedure'); -end; - -{ TBGRAFilterScannerSwapRedBlue } - -class procedure TBGRAFilterScannerSwapRedBlue.ComputeFilterAt( - ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; - AGammaCorrection: boolean); -const RedMask = 255 shl TBGRAPixel_RedShift; - BlueMask = 255 shl TBGRAPixel_BlueShift; - GreenAndAlphaMask = (255 shl TBGRAPixel_GreenShift) or (255 shl TBGRAPixel_AlphaShift); - RedMask64 = RedMask or (RedMask shl 32); - BlueMask64 = BlueMask or (BlueMask shl 32); - GreenAndAlphaMask64 = GreenAndAlphaMask or (GreenAndAlphaMask shl 32); -var - temp: LongWord; - temp64: QWord; - oddN: boolean; -begin - {$PUSH}{$WARNINGS OFF} - if ACount <= 0 then exit; - oddN := odd(ACount); - ACount := ACount shr 1; - if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then - while ACount > 0 do - begin - temp64 := PQWord(ASource)^; - PQWord(ADest)^ := ((temp64 and BlueMask64) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or - ((temp64 and RedMask64) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or - (temp64 and GreenAndAlphaMask64); - dec(ACount); - inc(ASource,2); - inc(ADest,2); - end else - while ACount > 0 do - begin - temp64 := PQWord(ASource)^; - PQWord(ADest)^ := ((temp64 and BlueMask64) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or - ((temp64 and RedMask64) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or - (temp64 and GreenAndAlphaMask64); - dec(ACount); - inc(ASource,2); - inc(ADest,2); - end; - if oddN then - begin - if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then - begin - temp := PLongWord(ASource)^; - PLongWord(ADest)^ := ((temp and BlueMask) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or - ((temp and RedMask) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or - (temp and GreenAndAlphaMask); - end else - begin - temp := PLongWord(ASource)^; - PLongWord(ADest)^ := ((temp and BlueMask) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or - ((temp and RedMask) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or - (temp and GreenAndAlphaMask); - end; - end; - {$POP} -end; - -{ TBGRAFilterScannerNegative } - -class procedure TBGRAFilterScannerNegative.ComputeFilterAt( - ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; - AGammaCorrection: boolean); -begin - if ADest = ASource then - begin - if AGammaCorrection then - while ACount > 0 do - begin - with ADest^ do - if alpha <> 0 then - begin - ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]]; - ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]]; - ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]]; - end; - Inc(ADest); - dec(ACount); - end else - while ACount > 0 do - begin - if ADest^.alpha <> 0 then - LongWord(ADest^) := LongWord(ADest^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift)); - Inc(ADest); - dec(ACount); - end; - end else - if AGammaCorrection then - while ACount > 0 do - begin - with ASource^ do - if alpha = 0 then - ADest^ := BGRAPixelTransparent - else - begin - ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]]; - ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]]; - ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]]; - ADest^.alpha := alpha; - end; - inc(ASource); - Inc(ADest); - dec(ACount); - end else - while ACount > 0 do - begin - if ASource^.alpha = 0 then - ADest^ := BGRAPixelTransparent - else - LongWord(ADest^) := LongWord(ASource^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift)); - inc(ASource); - Inc(ADest); - dec(ACount); - end; -end; - -{ TBGRAFilterScannerGrayscale } - -class procedure TBGRAFilterScannerGrayscale.ComputeFilterAt( - ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer; - AGammaCorrection: boolean); -begin - if ASource = ADest then - begin - if AGammaCorrection then - while ACount > 0 do - begin - if ADest^.alpha <> 0 then - ADest^ := BGRAToGrayscale(ADest^); - Inc(ADest); - dec(ACount); - end else - while ACount > 0 do - begin - if ADest^.alpha <> 0 then - ADest^ := BGRAToGrayscaleLinear(ADest^); - Inc(ADest); - dec(ACount); - end; - end else - if AGammaCorrection then - while ACount > 0 do - begin - ADest^ := BGRAToGrayscale(ASource^); - inc(ASource); - Inc(ADest); - dec(ACount); - end else - while ACount > 0 do - begin - ADest^ := BGRAToGrayscaleLinear(ASource^); - inc(ASource); - Inc(ADest); - dec(ACount); - end; -end; - -end. - diff --git a/components/bgrabitmap/bgrafiltertype.pas b/components/bgrabitmap/bgrafiltertype.pas deleted file mode 100644 index 9eed018..0000000 --- a/components/bgrabitmap/bgrafiltertype.pas +++ /dev/null @@ -1,464 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAFilterType; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, BGRABitmapTypes; - -const - FilterScannerChunkSize = 16; - -type - TCheckShouldStopFunc = function(ACurrentY: integer) : boolean of object; - - { TFilterTask } - - TFilterTask = class - private - FCheckShouldStop: TCheckShouldStopFunc; - FScanOffset: TPoint; - procedure SetDestination(AValue: TBGRACustomBitmap); - function GetInplace: boolean; - procedure SetInplace(AValue: boolean); - protected - FDestination: TBGRACustomBitmap; - FSource: TBGRACustomBitmap; - FSourceScanner: IBGRAScanner; - FCurrentY: integer; - function GetShouldStop(ACurrentY: integer): boolean; - procedure DoExecute; virtual; abstract; - function RequestSourceScanLine(X,Y,Count: Integer): PBGRAPixel; - procedure ReleaseSourceScanLine(P: PBGRAPixel); - function RequestSourceExpandedScanLine(X,Y,Count: Integer): PExpandedPixel; - procedure ReleaseSourceExpandedScanLine(P: PExpandedPixel); - procedure SetSource(ABitmap: TBGRACustomBitmap); overload; - procedure SetSource(AScanner: IBGRAScanner); overload; - public - function Execute: TBGRACustomBitmap; - property Destination: TBGRACustomBitmap read FDestination write SetDestination; - property CheckShouldStop: TCheckShouldStopFunc read FCheckShouldStop write FCheckShouldStop; - property CurrentY: integer read FCurrentY; - property ScanOffset: TPoint read FScanOffset write FScanOffset; - property Inplace: boolean read GetInplace write SetInplace; - end; - - { TBGRAFilterScanner } - - TBGRAFilterScanner = class(TBGRACustomScanner) - private - FAllowDirectRead: boolean; - FCurX,FCurY: integer; - FSource: IBGRAScanner; - FOffset: TPoint; - FVariablePixelBuffer: TBGRAPixelBuffer; - FOutputBuffer: packed array[0..FilterScannerChunkSize-1] of TBGRAPixel; - FOutputBufferPos: integer; - public - constructor Create(ASource: IBGRAScanner; AOffset: TPoint); - procedure ComputeFilter(ASource: IBGRAScanner; X,Y: Integer; ADest: PBGRAPixel; ACount: integer); virtual; abstract; - function ScanAtInteger(X,Y: integer): TBGRAPixel; override; - procedure ScanMoveTo(X,Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - procedure ScanSkipPixels(ACount: integer); override; - function IsScanPutPixelsDefined: boolean; override; - function ScanAt(X,Y: Single): TBGRAPixel; override; - property Source: IBGRAScanner read FSource; - property Offset: TPoint read FOffset; - property AllowDirectRead: boolean read FAllowDirectRead write FAllowDirectRead; - end; - - { TBGRAFilterScannerPixelwise } - - TBGRAFilterScannerPixelwise = class(TBGRAFilterScanner) - private - FBuffer: TBGRAPixelBuffer; - FGammaCorrection: boolean; - protected - procedure DoComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; - ACount: integer; AGammaCorrection: boolean); virtual; - public - constructor Create(ASource: IBGRAScanner; AOffset: TPoint; AGammaCorrection: boolean = true); - procedure ComputeFilter(ASource: IBGRAScanner; X, Y: Integer; ADest: PBGRAPixel; - ACount: integer); override; - class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel; - ACount: integer; AGammaCorrection: boolean); virtual; abstract; - class procedure ComputeFilterInplace(ABitmap: TBGRACustomBitmap; ABounds: TRect; - AGammaCorrection: boolean); virtual; - property GammaCorrection: boolean read FGammaCorrection write FGammaCorrection; - end; - - { TBGRAFilterScannerMultipixel } - - TBGRAFilterScannerMultipixel = class(TBGRAFilterScanner) - private - FSourceBounds: TRect; - FKernelWidth,FKernelHeight: integer; - FCurBufferY: integer; - FCurBufferYDefined: boolean; - FBuffers: array of TBGRAPixelBuffer; - FPBuffers: array of PBGRAPixel; - protected - procedure DoComputeFilter(BufferX: Integer; const Buffers: array of PBGRAPixel; - BufferWidth: integer; ADest: PBGRAPixel; ACount: integer); virtual; abstract; - procedure LoadBuffer(ASource: IBGRAScanner; X,Y: Integer; BufferIndex: Integer; ACount: integer); virtual; - public - constructor Create(ASource: IBGRAScanner; ASourceBounds: TRect; AOffset: TPoint; - AKernelWidth,AKernelHeight: Integer); - procedure ComputeFilter(ASource: IBGRAScanner; X, Y: Integer; ADest: PBGRAPixel; - ACount: integer); override; - property KernelWidth: integer read FKernelWidth; - property KernelHeight: integer read FKernelHeight; - property SourceBounds: TRect read FSourceBounds; - end; - -implementation - -uses SysUtils, BGRABlend; - -{ TFilterTask } - -function TFilterTask.GetShouldStop(ACurrentY: integer): boolean; -begin - FCurrentY:= ACurrentY; - if Assigned(FCheckShouldStop) then - result := FCheckShouldStop(ACurrentY) - else - result := false; -end; - -function TFilterTask.RequestSourceScanLine(X, Y, Count: Integer): PBGRAPixel; -begin - if FSource <> nil then - result := FSource.ScanLine[y]+x - else - begin - getmem(result, sizeof(TBGRAPixel)*Count); - FSourceScanner.ScanMoveTo(X+FScanOffset.X,Y+FScanOffset.Y); - FSourceScanner.ScanPutPixels(result,count,dmSet); - end; -end; - -procedure TFilterTask.ReleaseSourceScanLine(P: PBGRAPixel); -begin - if FSource = nil then - if p <> nil then freemem(p); -end; - -function TFilterTask.RequestSourceExpandedScanLine(X, Y, Count: Integer - ): PExpandedPixel; -var p: PBGRAPixel; - pexp: PExpandedPixel; -begin - getmem(result, sizeof(TExpandedPixel)*Count); - if FSource <> nil then - begin - p := FSource.ScanLine[Y]+x; - pexp := result; - while Count > 0 do - begin - pexp^ := GammaExpansion(p^); - inc(pexp); - inc(p); - dec(Count); - end; - end else - begin - FSourceScanner.ScanMoveTo(X+FScanOffset.X,Y+FScanOffset.Y); - pexp := result; - while Count > 0 do - begin - pexp^ := FSourceScanner.ScanNextExpandedPixel; - inc(pexp); - dec(Count); - end; - end; -end; - -procedure TFilterTask.ReleaseSourceExpandedScanLine(P: PExpandedPixel); -begin - if p <> nil then freemem(p); -end; - -procedure TFilterTask.SetSource(ABitmap: TBGRACustomBitmap); -begin - FSource := ABitmap; - FSourceScanner := nil; -end; - -procedure TFilterTask.SetSource(AScanner: IBGRAScanner); -begin - FSource := nil; - FSourceScanner := AScanner; -end; - -function TFilterTask.Execute: TBGRACustomBitmap; -var DestinationOwned: boolean; -begin - FCurrentY := 0; - if Destination = nil then - begin - if FSource = nil then //using default factory - FDestination := BGRABitmapFactory.create(FSource.Width,FSource.Height) - else - FDestination := FSource.NewBitmap(FSource.Width,FSource.Height); - DestinationOwned:= true; - end else - DestinationOwned:= false; - try - DoExecute; - result := Destination; - FDestination := nil; - except - on ex: exception do - begin - if DestinationOwned then FreeAndNil(FDestination); - raise ex; - end; - end; -end; - -procedure TFilterTask.SetDestination(AValue: TBGRACustomBitmap); -begin - if FDestination <> nil then - raise exception.Create('Destination is already defined'); - FDestination := AValue; -end; - -function TFilterTask.GetInplace: boolean; -begin - result := (Destination = FSource) and (FSource <> nil); -end; - -procedure TFilterTask.SetInplace(AValue: boolean); -begin - if AValue = InPlace then exit; - if AValue and (FSource = nil) then - raise exception.Create('Inplace is valid only when source image is defined'); - Destination := FSource; -end; - -{ TBGRAFilterScanner } - -constructor TBGRAFilterScanner.Create(ASource: IBGRAScanner; AOffset: TPoint); -begin - FSource := ASource; - FOffset := AOffset; - FOutputBufferPos := FilterScannerChunkSize; -end; - -function TBGRAFilterScanner.ScanAtInteger(X, Y: integer): TBGRAPixel; -begin - ScanMoveTo(X,Y); - result := ScanNextPixel; -end; - -procedure TBGRAFilterScanner.ScanMoveTo(X, Y: Integer); -begin - FCurX := X; - FCurY := Y; - FOutputBufferPos := FilterScannerChunkSize; -end; - -function TBGRAFilterScanner.ScanNextPixel: TBGRAPixel; -begin - if FOutputBufferPos >= FilterScannerChunkSize then - begin - ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,@FOutputBuffer[0],FilterScannerChunkSize); - FOutputBufferPos := 0; - end; - Result:= FOutputBuffer[FOutputBufferPos]; - inc(FOutputBufferPos); - inc(FCurX); -end; - -procedure TBGRAFilterScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; - mode: TDrawMode); -begin - if mode = dmSet then - begin - ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,pdest,count); - inc(FCurX,count); - end else - begin - AllocateBGRAPixelBuffer(FVariablePixelBuffer, count); - ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,@FVariablePixelBuffer[0],count); - inc(FCurX,count); - PutPixels(pdest, @FVariablePixelBuffer[0], count, mode, 255); - end; -end; - -procedure TBGRAFilterScanner.ScanSkipPixels(ACount: integer); -begin - inc(FOutputBufferPos, ACount); - inc(FCurX, ACount); -end; - -function TBGRAFilterScanner.IsScanPutPixelsDefined: boolean; -begin - Result:= true; -end; - -function TBGRAFilterScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - result := ScanAtInteger(round(X),round(Y)); -end; - -{ TBGRAFilterScannerPixelwise } - -procedure TBGRAFilterScannerPixelwise.DoComputeFilterAt(ASource: PBGRAPixel; - ADest: PBGRAPixel; ACount: integer; AGammaCorrection: boolean); -begin - ComputeFilterAt(ASource,ADest,ACount,AGammaCorrection); -end; - -constructor TBGRAFilterScannerPixelwise.Create(ASource: IBGRAScanner; - AOffset: TPoint; AGammaCorrection: boolean); -begin - inherited Create(ASource,AOffset); - GammaCorrection := AGammaCorrection; - //it is most likely that direct read can be used, the only exception being - //that the destination would be equal to the source and that there would - //be an offset - AllowDirectRead := true; -end; - -procedure TBGRAFilterScannerPixelwise.ComputeFilter(ASource: IBGRAScanner; X, - Y: Integer; ADest: PBGRAPixel; ACount: integer); -var p: PBGRAPixel; -begin - if AllowDirectRead and ASource.ProvidesScanline(rect(x,y,x+ACount,y+1)) then - begin - p := ASource.GetScanlineAt(x,y); - end else - begin - AllocateBGRAPixelBuffer(FBuffer, ACount); - ASource.ScanMoveTo(X,Y); - p := @FBuffer[0]; - ASource.ScanPutPixels(p, ACount, dmSet); - end; - DoComputeFilterAt(p,ADest,ACount,GammaCorrection); -end; - -class procedure TBGRAFilterScannerPixelwise.ComputeFilterInplace( - ABitmap: TBGRACustomBitmap; ABounds: TRect; AGammaCorrection: boolean); -var - yb: LongInt; - p: Pointer; -begin - ABitmap.LoadFromBitmapIfNeeded; - if (ABounds.Left = 0) and (ABounds.Top = 0) and - (ABounds.Right = ABitmap.Width) and (ABounds.Bottom = ABitmap.Height) then - ComputeFilterAt(ABitmap.Data,ABitmap.Data,ABitmap.NbPixels,AGammaCorrection) - else - for yb := ABounds.Top to ABounds.Bottom-1 do - begin - p := ABitmap.ScanLine[yb]+ABounds.Left; - ComputeFilterAt(p,p,ABounds.Right-ABounds.Left,AGammaCorrection); - end; - ABitmap.InvalidateBitmap; -end; - -{ TBGRAFilterScannerMultipixel } - -procedure TBGRAFilterScannerMultipixel.LoadBuffer(ASource: IBGRAScanner; X, - Y: Integer; BufferIndex: Integer; ACount: integer); -begin - if (Y < FSourceBounds.Top) or (Y >= FSourceBounds.Bottom) then - FPBuffers[BufferIndex] := nil - else - if AllowDirectRead and ASource.ProvidesScanline(rect(x,y,x+ACount,y+1)) then - begin - FPBuffers[BufferIndex] := ASource.GetScanlineAt(X,Y); - end else - begin - AllocateBGRAPixelBuffer(FBuffers[BufferIndex], ACount); - ASource.ScanMoveTo(X,Y); - FPBuffers[BufferIndex] := @(FBuffers[BufferIndex][0]); - ASource.ScanPutPixels(FPBuffers[BufferIndex], ACount, dmSet); - end; -end; - -constructor TBGRAFilterScannerMultipixel.Create(ASource: IBGRAScanner; - ASourceBounds: TRect; AOffset: TPoint; AKernelWidth, AKernelHeight: Integer); -var - temp: Integer; -begin - inherited Create(ASource,AOffset); - FSourceBounds := ASourceBounds; - if FSourceBounds.Left > FSourceBounds.Right then - begin - temp := FSourceBounds.Left; - FSourceBounds.Left := FSourceBounds.Right; - FSourceBounds.Right := temp; - end; - if FSourceBounds.Top > FSourceBounds.Bottom then - begin - temp := FSourceBounds.Top; - FSourceBounds.Top := FSourceBounds.Bottom; - FSourceBounds.Bottom := temp; - end; - FKernelWidth := AKernelWidth; - FKernelHeight:= AKernelHeight; - SetLength(FBuffers, FKernelHeight); - SetLength(FPBuffers, FKernelHeight); - FCurBufferYDefined := false; - //it is not sure that direct read can be used, because if the destination - //is equal to the source, the output will change the input buffers - AllowDirectRead := false; -end; - -procedure TBGRAFilterScannerMultipixel.ComputeFilter(ASource: IBGRAScanner; X, - Y: Integer; ADest: PBGRAPixel; ACount: integer); -var - yb,dy: Integer; - temp: TBGRAPixelBuffer; - p: PBGRAPixel; -begin - if not FCurBufferYDefined or (Abs(Y-FCurBufferY)>=FKernelHeight) then - begin - FCurBufferY := y; - FCurBufferYDefined := true; - for yb := 0 to FKernelHeight-1 do - LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,SourceBounds.Right-FSourceBounds.Left); - end else - if Y < FCurBufferY then - begin - dy := FCurBufferY-y; - for yb := FKernelHeight-1 downto dy do - begin - temp := FBuffers[yb]; - FBuffers[yb] := FBuffers[yb-dy]; - FBuffers[yb-dy] := temp; - p := FPBuffers[yb]; - FPBuffers[yb] := FPBuffers[yb-dy]; - FPBuffers[yb-dy] := p; - end; - for yb := 0 to dy-1 do - LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,FSourceBounds.Right-FSourceBounds.Left); - FCurBufferY := y; - end else - if Y > FCurBufferY then - begin - dy := y-FCurBufferY; - for yb := 0 to FKernelHeight-1-dy do - begin - temp := FBuffers[yb]; - FBuffers[yb] := FBuffers[yb+dy]; - FBuffers[yb+dy] := temp; - p := FPBuffers[yb]; - FPBuffers[yb] := FPBuffers[yb+dy]; - FPBuffers[yb+dy] := p; - end; - for yb := FKernelHeight-1-dy+1 to FKernelHeight-1 do - LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,FSourceBounds.Right-FSourceBounds.Left); - FCurBufferY := y; - end; - DoComputeFilter(X-FSourceBounds.Left,FPBuffers,FSourceBounds.Right-FSourceBounds.Left,ADest,ACount); -end; - -end. - diff --git a/components/bgrabitmap/bgrafontgl.pas b/components/bgrabitmap/bgrafontgl.pas deleted file mode 100644 index 1e21f0f..0000000 --- a/components/bgrabitmap/bgrafontgl.pas +++ /dev/null @@ -1,694 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAFontGL; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRAOpenGLType, BGRABitmapTypes, - Avl_Tree; - -type - { TRenderedGlyph } - - TRenderedGlyph = class - private - FIdentifier: UTF8String; - FTexture: IBGLTexture; - FHorizontalOverflowPx, FVerticalOverflowPx, FAdvancePx: integer; - public - constructor Create(AIdentifier: UTF8String; ATexture: IBGLTexture; - AHorizontalOverflowPx, AVerticalOverflowPx: integer); - procedure Draw(x,y,Scale: single; AColor: TBGRAPixel); overload; - procedure Draw(x,y,Scale: single; AGradTopLeft, AGradTopRight, AGradBottomRight, AGradBottomLeft: TBGRAPixel); overload; - property Identifier: UTF8String read FIdentifier; - property AdvancePx: integer read FAdvancePx; - end; - - { IBGLRenderedFont } - - IBGLRenderedFont = interface(IBGLFont) - function GetBackgroundColor: TBGRAPixel; - function GetColor: TBGRAPixel; - function GetFontEmHeight: integer; - function GetFontFullHeight: integer; - function GetHorizontalOverflow: single; - function GetName: string; - function GetQuality: TBGRAFontQuality; - function GetStyle: TFontStyles; - function GetVerticalOverflow: single; - procedure SetBackgroundColor(AValue: TBGRAPixel); - procedure SetColor(AValue: TBGRAPixel); - procedure SetFontEmHeight(AValue: integer); - procedure SetFontFullHeight(AValue: integer); - procedure SetHorizontalOverflow(AValue: single); - procedure SetName(AValue: string); - procedure SetQuality(AValue: TBGRAFontQuality); - procedure SetStyle(AValue: TFontStyles); - procedure SetVerticalOverflow(AValue: single); - - property Name: string read GetName write SetName; - property Style: TFontStyles read GetStyle write SetStyle; - property Quality: TBGRAFontQuality read GetQuality write SetQuality; - property EmHeight: integer read GetFontEmHeight write SetFontEmHeight; - property FullHeight: integer read GetFontFullHeight write SetFontFullHeight; - property Color: TBGRAPixel read GetColor write SetColor; - property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow; - property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow; - property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor; - end; - - { TBGLRenderedFont } - - TBGLRenderedFont = class(TBGLCustomFont,IBGLRenderedFont) - private - FGlyphs: TAVLTree; - - FName: string; - FColor: TBGRAPixel; - FBackgroundColor: TBGRAPixel; - FEmHeight: integer; - FHorizontalOverflow: single; - FVerticalOverflow: single; - FQuality: TBGRAFontQuality; - FStyle: TFontStyles; - FGradTopLeft, FGradTopRight, FGradBottomRight, FGradBottomLeft: TBGRAPixel; - FUseGradientColor: boolean; - FClipped: boolean; - FWordBreakHandler: TWordBreakHandler; - - function FindGlyph(AIdentifier: string): TAVLTreeNode; - function GetBackgroundColor: TBGRAPixel; - function GetColor: TBGRAPixel; - function GetFontEmHeight: integer; - function GetGlyph(AIdentifier: string): TRenderedGlyph; - function GetHorizontalOverflow: single; - function GetName: string; - function GetQuality: TBGRAFontQuality; - function GetStyle: TFontStyles; - function GetVerticalOverflow: single; - procedure SetGlyph(AIdentifier: string; AValue: TRenderedGlyph); - function GetFontFullHeight: integer; - procedure SetBackgroundColor(AValue: TBGRAPixel); - procedure SetColor(AValue: TBGRAPixel); - procedure SetFontEmHeight(AValue: integer); - procedure SetFontFullHeight(AValue: integer); - procedure SetHorizontalOverflow(AValue: single); - procedure SetName(AValue: string); - procedure SetQuality(AValue: TBGRAFontQuality); - procedure SetStyle(AValue: TFontStyles); - procedure SetVerticalOverflow(AValue: single); - protected - FRenderer: TBGRACustomFontRenderer; - FRendererOwned: boolean; - function LoadFromFile({%H-}AFilename: UTF8String): boolean; override; - procedure FreeMemoryOnDestroy; override; - function CreateGlyph(AIdentifier: string): TRenderedGlyph; virtual; - procedure CopyFontToRenderer; virtual; - procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout); overload; virtual; - procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; override; - procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); override; - function GetClipped: boolean; override; - function GetUseGradientColors: boolean; override; - procedure SetClipped(AValue: boolean); override; - procedure SetUseGradientColors(AValue: boolean); override; - procedure DiscardGlyphs; virtual; - procedure DefaultWordBreakHandler(var ABefore, AAfter: string); - procedure SplitText(var ATextUTF8: string; AMaxWidth: single; out ARemainsUTF8: string); - function GetWrappedLines(ATextUTF8: string; AWidth: single): TStringList; - public - constructor Create(ARenderer: TBGRACustomFontRenderer; ARendererOwned: boolean = true); - procedure FreeMemory; override; - function TextWidth(const Text: UTF8String): single; override; - function TextHeight(const {%H-}Text: UTF8String): single; override; - function TextHeight(const Text: UTF8String; AWidth: single): single; override; - procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); override; - property Name: string read GetName write SetName; - property Style: TFontStyles read GetStyle write SetStyle; - property Quality: TBGRAFontQuality read GetQuality write SetQuality; - property EmHeight: integer read GetFontEmHeight write SetFontEmHeight; - property FullHeight: integer read GetFontFullHeight write SetFontFullHeight; - property Color: TBGRAPixel read GetColor write SetColor; - property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow; - property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow; - property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor; - property WordBreakHandler: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; - property Glyph[AIdentifier: string]: TRenderedGlyph read GetGlyph; - end; - -implementation - -uses BGRAUTF8; - -{ TRenderedGlyph } - -constructor TRenderedGlyph.Create(AIdentifier: UTF8String; ATexture: IBGLTexture; - AHorizontalOverflowPx, AVerticalOverflowPx: integer); -begin - FIdentifier := AIdentifier; - FTexture := ATexture; - FHorizontalOverflowPx:= AHorizontalOverflowPx; - FVerticalOverflowPx:= AVerticalOverflowPx; - FAdvancePx := ATexture.Width - 2*FHorizontalOverflowPx; -end; - -procedure TRenderedGlyph.Draw(x, y, Scale: single; AColor: TBGRAPixel); -begin - FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale, AColor); -end; - -procedure TRenderedGlyph.Draw(x, y, Scale: single; AGradTopLeft, AGradTopRight, - AGradBottomRight, AGradBottomLeft: TBGRAPixel); -begin - FTexture.SetGradientColors(AGradTopLeft,AGradTopRight, AGradBottomRight,AGradBottomLeft); - FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale); - FTexture.GradientColors := false; -end; - -function CompareGlyphNode(Data1, Data2: Pointer): integer; -begin - result := CompareStr(TRenderedGlyph(Data1).Identifier,TRenderedGlyph(Data2).Identifier); -end; - -{ TBGLRenderedFont } - -function TBGLRenderedFont.FindGlyph(AIdentifier: string): TAVLTreeNode; -var Comp: integer; - Node: TAVLTreeNode; -begin - Node:=FGlyphs.Root; - while (Node<>nil) do begin - Comp:=CompareStr(AIdentifier,TRenderedGlyph(Node.Data).Identifier); - if Comp=0 then break; - if Comp<0 then begin - Node:=Node.Left - end else begin - Node:=Node.Right - end; - end; - result := Node; -end; - -function TBGLRenderedFont.GetBackgroundColor: TBGRAPixel; -begin - result := FBackgroundColor; -end; - -function TBGLRenderedFont.GetColor: TBGRAPixel; -begin - result := FColor; -end; - -function TBGLRenderedFont.GetFontEmHeight: integer; -begin - result := FEmHeight; -end; - -function TBGLRenderedFont.CreateGlyph(AIdentifier: string): TRenderedGlyph; -var b: TBGLCustomBitmap; - hOverflow, vOverflow: integer; -begin - CopyFontToRenderer; - with FRenderer.TextSize(AIdentifier) do - begin - hOverflow := round(cx*HorizontalOverflow)+1; - vOverflow:= round(cy*VerticalOverflow)+1; - b:= BGLBitmapFactory.Create(cx+2*hOverflow,cy+2*vOverflow,BackgroundColor); - FRenderer.TextOut(b, hOverflow,vOverflow, AIdentifier, Color, taLeftJustify); - result:= TRenderedGlyph.Create(AIdentifier,b.MakeTextureAndFree,hOverflow,vOverflow); - end; -end; - -procedure TBGLRenderedFont.CopyFontToRenderer; -begin - FRenderer.FontName := FName; - FRenderer.FontEmHeight := FEmHeight; - FRenderer.FontOrientation := 0; - FRenderer.FontQuality := FQuality; - FRenderer.FontStyle := FStyle; -end; - -procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String; - AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout); -var - pstr: pchar; - left,charlen: integer; - nextchar: string; - g: TRenderedGlyph; -begin - if Text = '' then exit; - - pstr := @Text[1]; - left := length(Text); - case AHorizontalAlign of - taCenter: DecF(x, round(TextWidth(Text)/2)); - taRightJustify: DecF(x, TextWidth(Text)); - end; - case AVerticalAlign of - tlCenter: DecF(y, round(TextHeight(Text)/2)); - tlBottom: DecF(y, TextHeight(Text)*Scale); - end; - while left > 0 do - begin - charlen := UTF8CharacterLength(pstr); - setlength(nextchar, charlen); - move(pstr^, nextchar[1], charlen); - inc(pstr,charlen); - dec(left,charlen); - - g := GetGlyph(nextchar); - if g <> nil then - begin - if FUseGradientColor then - g.Draw(x,y,Scale,FGradTopLeft,FGradTopRight,FGradBottomRight,FGradBottomLeft) - else - g.Draw(x,y,Scale,AColor); - IncF(x, (g.AdvancePx + StepX) * Scale); - end; - end; -end; - -procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String; - AColor: TBGRAPixel); -begin - if Justify then - DoTextOut(X,Y,Text,AColor,taLeftJustify,VerticalAlign) - else - DoTextOut(X,Y,Text,AColor,HorizontalAlign,VerticalAlign); -end; - -procedure TBGLRenderedFont.DoTextRect(X, Y, Width, Height: Single; - const Text: UTF8String; AColor: TBGRAPixel); - - procedure DoDrawTextLine(LineY, LineWidth: Single; ALine: string; AJustify: boolean); - var CurX: single; - words: TStringList; - wordStart: integer; - i: Integer; - begin - if AJustify then - begin - words := TStringList.Create; - wordStart := 1; - for i := 1 to length(ALine) do - begin - if ALine[i]=' ' then - begin - words.Add(copy(ALine,wordStart,i-wordStart)); - wordStart := i+1; - end; - end; - words.add(copy(ALine,wordStart,length(ALine)+1-wordStart)); - CurX := X; - LineWidth := 0; - for i := 0 to words.Count-1 do - IncF(LineWidth, TextWidth(words[i])); - - for i := 0 to words.Count-1 do - begin - DoTextOut(CurX+round((Width-LineWidth)/(words.Count-1)*i),LineY,words[i],AColor,taLeftJustify,tlTop); - IncF(CurX, TextWidth(words[i])); - end; - words.Free; - end else - begin - Case HorizontalAlign of - taCenter: CurX := round(X+(Width-LineWidth)/2); - taRightJustify: CurX := X+Width-LineWidth; - else - CurX := X; - end; - DoTextOut(CurX,LineY,ALine,AColor,taLeftJustify,tlTop); - end; - end; - -var CurY: Single; - lineHeight: Single; - lines: TStringList; - i,originalNbLines: Integer; - maxLineCount: int64; -begin - If Text='' then exit; - lines := GetWrappedLines(Text,Width); - lineHeight := FullHeight * Scale; - originalNbLines := lines.Count; - - if Clipped then - begin - if lineHeight = 0 then exit; - maxLineCount := trunc(Height/lineHeight); - if maxLineCount <= 0 then exit; - while lines.Count > maxLineCount do - lines.Delete(lines.Count-1); - end; - - case VerticalAlign of - tlCenter: CurY := round(Y+( Height - lines.Count*lineHeight )/2); - tlBottom: CurY := Y + Height - lines.Count*lineHeight; - else CurY := Y; - end; - - for i := 0 to lines.Count-1 do - begin - DoDrawTextLine(CurY,TextWidth(lines[i]),lines[i],Justify and (i<>originalNbLines-1)); - IncF(CurY, lineHeight); - end; - lines.Free; -end; - -function TBGLRenderedFont.GetGlyph(AIdentifier: string): TRenderedGlyph; -var Node: TAVLTreeNode; -begin - Node := FindGlyph(AIdentifier); - if Node = nil then - begin - if UTF8Length(AIdentifier)<>1 then - result := nil - else - begin - result := CreateGlyph(AIdentifier); - SetGlyph(AIdentifier, result); - end; - end - else - result := TRenderedGlyph(Node.Data); -end; - -function TBGLRenderedFont.GetHorizontalOverflow: single; -begin - result := FHorizontalOverflow; -end; - -function TBGLRenderedFont.GetName: string; -begin - result := FName; -end; - -function TBGLRenderedFont.GetQuality: TBGRAFontQuality; -begin - result := FQuality; -end; - -function TBGLRenderedFont.GetStyle: TFontStyles; -begin - result := FStyle; -end; - -function TBGLRenderedFont.GetVerticalOverflow: single; -begin - result := FVerticalOverflow; -end; - -procedure TBGLRenderedFont.SetGlyph(AIdentifier: string; AValue: TRenderedGlyph); -var Node: TAVLTreeNode; -begin - if AValue.Identifier <> AIdentifier then - raise exception.Create('Identifier mismatch'); - Node := FindGlyph(AIdentifier); - if Node <> nil then - begin - if pointer(AValue) <> Node.Data then - TRenderedGlyph(Node.Data).Free; - Node.Data := AValue; - end else - FGlyphs.Add(pointer(AValue)); -end; - -procedure TBGLRenderedFont.SetStyle(AValue: TFontStyles); -begin - if FStyle=AValue then Exit; - FStyle:=AValue; - DiscardGlyphs; -end; - -procedure TBGLRenderedFont.SetVerticalOverflow(AValue: single); -begin - if FVerticalOverflow=AValue then Exit; - FVerticalOverflow:=AValue; - DiscardGlyphs; -end; - -function TBGLRenderedFont.GetClipped: boolean; -begin - result := FClipped; -end; - -function TBGLRenderedFont.GetUseGradientColors: boolean; -begin - result := FUseGradientColor; -end; - -procedure TBGLRenderedFont.SetClipped(AValue: boolean); -begin - FClipped:= AValue; -end; - -procedure TBGLRenderedFont.SetUseGradientColors(AValue: boolean); -begin - FUseGradientColor:= AValue; -end; - -procedure TBGLRenderedFont.DiscardGlyphs; -begin - FGlyphs.FreeAndClear; -end; - -procedure TBGLRenderedFont.DefaultWordBreakHandler(var ABefore, AAfter: string); -begin - BGRADefaultWordBreakHandler(ABefore,AAfter); -end; - -function TBGLRenderedFont.GetWrappedLines(ATextUTF8: string; AWidth: single - ): TStringList; -var - ARemains: string; -begin - result := TStringList.Create; - repeat - SplitText(ATextUTF8, AWidth, ARemains); - result.Add(ATextUTF8); - ATextUTF8 := ARemains; - until ARemains = ''; -end; - -procedure TBGLRenderedFont.SplitText(var ATextUTF8: string; AMaxWidth: single; - out ARemainsUTF8: string); -var - pstr: pchar; - p,left,charlen: integer; - totalWidth: single; - firstChar: boolean; - nextchar: string; - g: TRenderedGlyph; -begin - totalWidth := 0; - if ATextUTF8 = '' then - begin - ARemainsUTF8 := ''; - exit; - end else - begin - p := 1; - pstr := @ATextUTF8[1]; - left := length(ATextUTF8); - firstChar := true; - while left > 0 do - begin - if RemoveLineEnding(ATextUTF8,p) then - begin - ARemainsUTF8 := copy(ATextUTF8,p,length(ATextUTF8)-p+1); - ATextUTF8 := copy(ATextUTF8,1,p-1); - exit; - end; - - charlen := UTF8CharacterLength(pstr); - setlength(nextchar, charlen); - move(pstr^, nextchar[1], charlen); - inc(pstr,charlen); - - g := GetGlyph(nextchar); - if g <> nil then - begin - if not firstChar then IncF(totalWidth, StepX*Scale); - IncF(totalWidth, g.AdvancePx*Scale); - if not firstChar and (totalWidth > AMaxWidth) then - begin - ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); - ATextUTF8 := copy(ATextUTF8,1,p-1); - if Assigned(FWordBreakHandler) then - FWordBreakHandler(ATextUTF8,ARemainsUTF8) else - DefaultWordBreakHandler(ATextUTF8,ARemainsUTF8); - exit; - end; - end; - - dec(left,charlen); - inc(p,charlen); - firstChar := false; - end; - end; - ARemainsUTF8 := ''; //no split -end; - -procedure TBGLRenderedFont.SetName(AValue: string); -begin - if FName=AValue then Exit; - FName:=AValue; - DiscardGlyphs; -end; - -procedure TBGLRenderedFont.SetFontEmHeight(AValue: integer); -begin - if FEmHeight=AValue then Exit; - FEmHeight:=AValue; - DiscardGlyphs; -end; - -function TBGLRenderedFont.GetFontFullHeight: integer; -begin - if FEmHeight < 0 then - result := -EmHeight - else - result := FRenderer.TextSize('Hg').cy; -end; - -procedure TBGLRenderedFont.SetBackgroundColor(AValue: TBGRAPixel); -begin - if FBackgroundColor=AValue then Exit; - FBackgroundColor:=AValue; - DiscardGlyphs; -end; - -procedure TBGLRenderedFont.SetColor(AValue: TBGRAPixel); -begin - if FColor=AValue then Exit; - FColor:=AValue; - DiscardGlyphs; -end; - -procedure TBGLRenderedFont.SetFontFullHeight(AValue: integer); -begin - EmHeight:= -AValue; -end; - -procedure TBGLRenderedFont.SetHorizontalOverflow(AValue: single); -begin - if FHorizontalOverflow=AValue then Exit; - FHorizontalOverflow:=AValue; - DiscardGlyphs; -end; - -procedure TBGLRenderedFont.SetQuality(AValue: TBGRAFontQuality); -begin - if FQuality=AValue then Exit; - FQuality:=AValue; - DiscardGlyphs; -end; - -function TBGLRenderedFont.LoadFromFile(AFilename: UTF8String): boolean; -begin - result := false; -end; - -procedure TBGLRenderedFont.FreeMemoryOnDestroy; -begin - FreeMemory; - if FRendererOwned then FreeAndNil(FRenderer); - FreeAndNil(FGlyphs); -end; - -constructor TBGLRenderedFont.Create(ARenderer: TBGRACustomFontRenderer; - ARendererOwned: boolean); -begin - Init; - FRenderer := ARenderer; - FRendererOwned := ARendererOwned; - - FName := 'Arial'; - FColor := BGRAWhite; - FBackgroundColor := BGRAPixelTransparent; - FEmHeight := 20; - FStyle := []; - FHorizontalOverflow := 0.33; - FVerticalOverflow := 0; - FQuality := fqFineAntialiasing; - - FGradTopLeft := BGRAWhite; - FGradTopRight := BGRAWhite; - FGradBottomLeft := BGRAWhite; - FGradBottomRight := BGRAWhite; - FUseGradientColor:= false; - FClipped:= false; - - FGlyphs := TAVLTree.Create(@CompareGlyphNode); - FWordBreakHandler:= nil; -end; - -procedure TBGLRenderedFont.FreeMemory; -begin - DiscardGlyphs; - inherited FreeMemory; -end; - -function TBGLRenderedFont.TextWidth(const Text: UTF8String): single; -var - pstr: pchar; - left,charlen: integer; - nextchar: string; - g: TRenderedGlyph; - firstChar: boolean; -begin - result := 0; - if Text = '' then exit; - - firstChar := true; - pstr := @Text[1]; - left := length(Text); - while left > 0 do - begin - charlen := UTF8CharacterLength(pstr); - setlength(nextchar, charlen); - move(pstr^, nextchar[1], charlen); - inc(pstr,charlen); - dec(left,charlen); - - g := GetGlyph(nextchar); - if g <> nil then - begin - if firstChar then - firstchar := false - else - IncF(result, StepX * Scale); - IncF(result, g.AdvancePx * Scale); - end; - end; -end; - -function TBGLRenderedFont.TextHeight(const Text: UTF8String): single; -begin - result := FullHeight * Scale; -end; - -function TBGLRenderedFont.TextHeight(const Text: UTF8String; AWidth: single - ): single; -var - lines: TStringList; -begin - lines := GetWrappedLines(Text, AWidth); - result := lines.Count * (FullHeight * Scale); - lines.Free; -end; - -procedure TBGLRenderedFont.SetGradientColors(ATopLeft, ATopRight, ABottomRight, - ABottomLeft: TBGRAPixel); -begin - FGradTopLeft := ATopLeft; - FGradTopRight := ATopRight; - FGradBottomLeft := ABottomLeft; - FGradBottomRight := ABottomRight; - GradientColors := true; -end; - -end. - diff --git a/components/bgrabitmap/bgrafpcanvas.inc b/components/bgrabitmap/bgrafpcanvas.inc deleted file mode 100644 index c6e5edf..0000000 --- a/components/bgrabitmap/bgrafpcanvas.inc +++ /dev/null @@ -1,286 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} - -type - {* How to draw the end of line } - TPenEndCap = TFPPenEndCap; - -const - {** Draw a half-disk at the end of the line. The diameter of the disk is - equal to the pen width. } - pecRound = FPCanvas.pecRound; - {** Draw a half-square. The size of the square is equal to the pen width. - This is visually equivalent to extend the line of half the pen width } - pecSquare = FPCanvas.pecSquare; - {** The line ends exactly at the end point } - pecFlat = FPCanvas.pecFlat; - -type - {* How to join segments. This makes sense only for geometric pens (that - have a certain width) } - TPenJoinStyle = TFPPenJoinStyle; - -const - {** Segments are joined by filling the gap with an arc } - pjsRound = FPCanvas.pjsRound; - {** Segments are joind by filling the gap with an intermediary segment } - pjsBevel = FPCanvas.pjsBevel; - {** Segments are joined by extending them up to their intersection. - There is a miter limit so that if the intersection is too far, - an intermediary segment is used } - pjsMiter = FPCanvas.pjsMiter; - -type - {* Style to use for the pen. The unit for the pattern is the width of the - line } - TPenStyle = TFPPenStyle; - TPenMode = TFPPenMode; - -const - {** Pen is continuous } - psSolid = FPCanvas.psSolid; - {** Pen is dashed. The dash have a length of 3 unit and the gaps of 1 unit } - psDash = FPCanvas.psDash; - {** Pen is dotted. The dots have a length of 1 unit and the gaps of 1 unit } - psDot = FPCanvas.psDot; - {** Pattern is a dash of length 3 followed by a dot of length 1, separated by a gap of length 1 } - psDashDot = FPCanvas.psDashDot; - {** Dash of length 3, and two dots of length 1 } - psDashDotDot = FPCanvas.psDashDotDot; - {** Pen is not drawn } - psClear = FPCanvas.psClear; - {** Not used. Provided for compatibility } - psInsideframe = FPCanvas.psInsideframe; - {** Custom pattern used } - psPattern = FPCanvas.psPattern; - - pmBlack = FPCanvas.pmBlack; - pmWhite = FPCanvas.pmWhite; - pmNop = FPCanvas.pmNop; - pmNot = FPCanvas.pmNot; - pmCopy = FPCanvas.pmCopy; - pmNotCopy = FPCanvas.pmNotCopy; - pmMergePenNot = FPCanvas.pmMergePenNot; - pmMaskPenNot = FPCanvas.pmMaskPenNot; - pmMergeNotPen = FPCanvas.pmMergeNotPen; - pmMaskNotPen = FPCanvas.pmMaskNotPen; - pmMerge = FPCanvas.pmMerge; - pmNotMerge = FPCanvas.pmNotMerge; - pmMask = FPCanvas.pmMask; - pmNotMask = FPCanvas.pmNotMask; - pmXor = FPCanvas.pmXor; - pmNotXor = FPCanvas.pmNotXor; - -type - { TPen } - {* A class containing a pen } - TPen = class(TFPCustomPen) - private - function GetColor: TColor; - procedure SetColor(AValue: TColor); - public - constructor Create; override; - {** Color of the pen } - property Color: TColor read GetColor write SetColor; - {** Operation done on pixels } - property Mode; - {** End cap of the pen: how to draw the ends of the lines } - property EndCap; - {** Join style: how to join the segments of a polyline } - property JoinStyle; - {** Pen style: solid, dash, dot... } - property Style; - {** Pen width in pixels } - property Width; - end; - - {* Pattern when filling with a brush. It is used in BGRACanvas but can - also be created with TBGRABitmap.CreateBrushTexture function } - TBrushStyle = TFPBrushStyle; - -const - {** Fill with the current color } - bsSolid = FPCanvas.bsSolid; - {** Does not fill at all } - bsClear = FPCanvas.bsClear; - {** Draw horizontal lines } - bsHorizontal = FPCanvas.bsHorizontal; - {** Draw vertical lines } - bsVertical = FPCanvas.bsVertical; - {** Draw diagonal lines from top-left to bottom-right } - bsFDiagonal = FPCanvas.bsFDiagonal; - {** Draw diagonal lines from bottom-left to top-right } - bsBDiagonal = FPCanvas.bsBDiagonal; - {** Draw both horizontal and vertical lines } - bsCross = FPCanvas.bsCross; - {** Draw both diagonal lines } - bsDiagCross = FPCanvas.bsDiagCross; - {** Fills with an image } - bsImage = FPCanvas.bsImage; - -type - { TBrush } - {* A class describing a brush } - TBrush = class(TFPCustomBrush) - private - function GetColor: TColor; - procedure SetColor(AValue: TColor); - public - constructor Create; override; - {** Color of the brush } - property Color: TColor read GetColor write SetColor; - {** Style of the brush: solid, diagonal lines, horizontal lines... } - property Style; - end; - - { TFont } - {* Contains the description of a font } - TFont = class(TFPCustomFont) - private - FPixelsPerInch, FHeight: Integer; - FQuality: TFontQuality; - FStyle: TFontStyles; - function GetColor: TColor; - function GetHeight: Integer; - function GetSize: Integer; - function GetStyle: TFontStyles; - procedure SetColor(AValue: TColor); - procedure SetHeight(AValue: Integer); - procedure SetQuality(AValue: TFontQuality); - procedure SetStyle(AValue: TFontStyles); - protected - procedure SetSize(AValue: Integer); override; - public - constructor Create; override; - {** Pixels per inches } - property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch; - {** Color of the font } - property Color: TColor read GetColor write SetColor; - {** Height of the font in pixels. When the number is negative, it indicates a size in pixels } - property Height: Integer read GetHeight write SetHeight; - {** Size of the font in inches. When the number is negative, it indicates a height in inches } - property Size: Integer read GetSize write SetSize; - {** Quality of the font rendering } - property Quality: TFontQuality read FQuality write SetQuality; - {** Style to apply to the text } - property Style: TFontStyles read GetStyle write SetStyle; - end; - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -{ TPen } - -procedure TPen.SetColor(AValue: TColor); -begin - FPColor := TColorToFPColor(AValue); -end; - -function TPen.GetColor: TColor; -begin - result := FPColorToTColor(FPColor); -end; - -constructor TPen.Create; -begin - inherited Create; - Mode := pmCopy; - Style := psSolid; - Width := 1; - FPColor := colBlack; - EndCap:= pecRound; - JoinStyle:= pjsRound; -end; - -{ TBrush } - -function TBrush.GetColor: TColor; -begin - result := FPColorToTColor(FPColor); -end; - -procedure TBrush.SetColor(AValue: TColor); -begin - FPColor := TColorToFPColor(AValue); -end; - -constructor TBrush.Create; -begin - inherited Create; - FPColor := colWhite; -end; - -{ TFont } - -function TFont.GetColor: TColor; -begin - result := FPColorToTColor(FPColor); -end; - -function TFont.GetHeight: Integer; -begin - result := FHeight; -end; - -function TFont.GetSize: Integer; -begin - Result := inherited Size; -end; - -function TFont.GetStyle: TFontStyles; -begin - result := FStyle; -end; - -procedure TFont.SetColor(AValue: TColor); -begin - FPColor := TColorToFPColor(AValue); -end; - -procedure TFont.SetHeight(AValue: Integer); -begin - if Height <> AValue then - begin - FHeight := AValue; - inherited SetSize(-MulDiv(AValue, 72, FPixelsPerInch)); - end; -end; - -procedure TFont.SetQuality(AValue: TFontQuality); -begin - if FQuality=AValue then Exit; - FQuality:=AValue; -end; - -procedure TFont.SetSize(AValue: Integer); -begin - if Size <> AValue then - begin - inherited SetSize(AValue); - FHeight := -MulDiv(AValue, FPixelsPerInch, 72); - end; -end; - -procedure TFont.SetStyle(AValue: TFontStyles); -begin - if FStyle <> AValue then - begin - FStyle := AValue; - inherited SetFlags(5, fsBold in FStyle); - inherited SetFlags(6, fsItalic in FStyle); - inherited SetFlags(7, fsUnderline in FStyle); - inherited SetFlags(8, fsStrikeOut in FStyle); - end; -end; - -constructor TFont.Create; -begin - FPixelsPerInch := GetScreenDPIY; - FQuality := fqDefault; - FPColor := colBlack; -end; - -{$ENDIF} diff --git a/components/bgrabitmap/bgrafpgui.inc b/components/bgrabitmap/bgrafpgui.inc deleted file mode 100644 index d6ec560..0000000 --- a/components/bgrabitmap/bgrafpgui.inc +++ /dev/null @@ -1,78 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type - TColor = TfpgColor; - TRawImage = class(TfpgImage) - procedure BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean); - end; - TGUICanvas = TfpgCanvas; - -const - clNone = fpg_base.clNone; - clBlack = fpg_base.clBlack; - clWhite = fpg_base.clWhite; - -function clRgbBtnHighlight: TColor; -function clRgbBtnShadow: TColor; -function ColorToRGB(c: TColor): TColor; inline; -function GetScreenDPIX: integer; -function GetScreenDPIY: integer; - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -procedure TRawImage.BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean); -var - tempData: pointer; -begin - if (Width <> AWidth) or (Height <> AHeight) then - begin - AllocateImage(32,AWidth,AHeight); - if ATransparent then AllocateMask; - end else - begin - if ATransparent and not Masked then AllocateMask else - if not ATransparent and Masked then - begin - getmem(tempData, ImageDataSize); - if tempData <> nil then - begin - move(ImageData^, tempData^, ImageDataSize); - FreeImage; - AllocateImage(32,AWidth,AHeight); - move(tempData^, ImageData^, ImageDataSize); - freemem(tempData); - end; - end; - end; -end; - -function clRgbBtnHighlight: TColor; -begin - result := fpgColorToRGB(fpg_base.clHilite2); -end; - -function clRgbBtnShadow: TColor; -begin - result := fpgColorToRGB(fpg_base.clShadow2); -end; - -function ColorToRGB(c: TColor): TColor; inline; -begin - result := fpgColorToRGB(c); -end; - -function GetScreenDPIX: integer; -begin - result := fpgApplication.Screen_dpi_x; -end; - -function GetScreenDPIY: integer; -begin - result := fpgApplication.Screen_dpi_y; -end; - -{$ENDIF} diff --git a/components/bgrabitmap/bgrafpgui_uses.inc b/components/bgrabitmap/bgrafpgui_uses.inc deleted file mode 100644 index 54b33a7..0000000 --- a/components/bgrabitmap/bgrafpgui_uses.inc +++ /dev/null @@ -1 +0,0 @@ -uses BGRAClasses, FPImage, FPCanvas, fpg_base, fpg_main; diff --git a/components/bgrabitmap/bgrafpguibitmap.pas b/components/bgrabitmap/bgrafpguibitmap.pas deleted file mode 100644 index c6f0c90..0000000 --- a/components/bgrabitmap/bgrafpguibitmap.pas +++ /dev/null @@ -1,268 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAfpGUIBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap, - BGRAFreeType, EasyLazFreeType, LazFreeTypeFontCollection, - BGRACanvas; - -type - - { TBGRAfpGUIBitmap } - - TBGRAfpGUIBitmap = class(TBGRADefaultBitmap) - private - FPseudoCanvas: TBGRACanvas; - function GetPseudoCanvas: TBGRACanvas; - function GetBitmapTransparent: boolean; - procedure SetBitmapTransparent(AValue: boolean); - protected - procedure RebuildBitmap; override; - function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; - function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; - AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean - =True): boolean; override; - procedure Init; override; - procedure FreeData; override; - procedure ReallocData; override; - procedure FreeBitmap; override; - procedure NotAvailable; - public - destructor Destroy; override; - class procedure AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean = false); static; - class procedure AddFreeTypeFontFile(AFilename: string; AUTF8: boolean = false); static; - procedure Draw(ACanvas: TCanvas; x, y: integer; {%H-}Opaque: boolean=True); override; - procedure Draw(ACanvas: TCanvas; Rect: TRect; {%H-}Opaque: boolean=True); override; - procedure Draw(ACanvas: TGUICanvas; x, y: integer; {%H-}Opaque: boolean=True); overload; - procedure Draw(ACanvas: TGUICanvas; Rect: TRect; {%H-}Opaque: boolean=True); overload; - procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available - procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure TakeScreenshot({%H-}ARect: TRect); override; //not available - procedure TakeScreenshotOfPrimaryMonitor; override; //not available - procedure LoadFromDevice({%H-}DC: HDC); override; //not available - procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available - property BitmapTransparent: boolean read GetBitmapTransparent write SetBitmapTransparent; - property Canvas: TBGRACanvas read GetPseudoCanvas; - end; - -implementation - -{ TBGRAfpGUIBitmap } - -function TBGRAfpGUIBitmap.GetBitmapTransparent: boolean; -begin - result := FBitmap.Transparent; -end; - -function TBGRAfpGUIBitmap.GetPseudoCanvas: TBGRACanvas; -begin - if FPseudoCanvas = nil then - begin - FPseudoCanvas := TBGRACanvas.Create(self); - FPseudoCanvas.AntialiasingMode := amOff; - end; - result := FPseudoCanvas; -end; - -procedure TBGRAfpGUIBitmap.SetBitmapTransparent(AValue: boolean); -begin - if FBitmap.Transparent <> AValue then - begin - FBitmap.Transparent:= AValue; - InvalidateBitmap; - end; -end; - -procedure TBGRAfpGUIBitmap.RebuildBitmap; -var pmask, pmaskline: PByte; - pdata: PBGRAPixel; - raw: TRawImage; - x,y,bit,masklinesize,curmaskbyte: UInt32or64; -begin - if FBitmap.Transparent then - begin - raw := FBitmap.RawImage; - masklinesize := ((Width+31) div 32)*4; - pmaskline := FBitmap.RawImage.MaskData; - pdata := raw.ImageData; - for y := 0 to Height-1 do - begin - pmask:= pmaskline; - bit := $80; - curmaskbyte := 0; - for x := Width-1 downto 0 do - begin - if pdata^.alpha >= $80 then - curmaskbyte := curmaskbyte or bit; - bit := bit shr 1; - if bit = 0 then - begin - bit := $80; - pmask^ := curmaskbyte; - inc(pmask); - curmaskbyte := 0; - end; - inc(pdata); - end; - if bit <> $80 then - pmask^ := curmaskbyte; - inc(pmaskline, masklinesize); - end; - end; - FBitmap.RawImage.UpdateImage; -end; - -function TBGRAfpGUIBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; -begin - result := TBGRAFreeTypeFontRenderer.Create; -end; - -function TBGRAfpGUIBitmap.LoadFromRawImage(ARawImage: TRawImage; - DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; - RaiseErrorOnInvalidPixelFormat: boolean): boolean; -var - lineSize: integer; - y: Integer; -begin - if (ARawImage.Width <> Width) or - (ARawImage.Height <> Height) then - raise Exception.Create('Bitmap size is inconsistent'); - - lineSize := Width*sizeof(TBGRAPixel); - for y := 0 to Height-1 do - move(ARawImage.ScanLine[y]^, ScanLine[y]^, lineSize); - if AlwaysReplaceAlpha then AlphaFill(DefaultOpacity); - result := true; -end; - -procedure TBGRAfpGUIBitmap.Init; -begin - inherited Init; - FBitmap := TBitmap.Create; - FontAntialias:= true; -end; - -procedure TBGRAfpGUIBitmap.ReallocData; -begin - FBitmap.Width := Width; - FBitmap.Height:= Height; - FDataByte := PByte(FBitmap.RawImage.ImageData); - InvalidateBitmap; - FScanPtr := nil; -end; - -procedure TBGRAfpGUIBitmap.FreeData; -begin - //nothing -end; - -procedure TBGRAfpGUIBitmap.FreeBitmap; -begin - //nothing -end; - -procedure TBGRAfpGUIBitmap.NotAvailable; -begin - raise exception.Create('Function not available with fpGUI'); -end; - -destructor TBGRAfpGUIBitmap.Destroy; -begin - FreeAndNil(FBitmap); - FreeAndNil(FPseudoCanvas); - inherited Destroy; -end; - -class procedure TBGRAfpGUIBitmap.AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean); -begin - if AUTF8 then ADirectory:= Utf8ToAnsi(ADirectory); - EasyLazFreeType.FontCollection.AddFolder(ADirectory); -end; - -class procedure TBGRAfpGUIBitmap.AddFreeTypeFontFile(AFilename: string; AUTF8: boolean); -begin - if AUTF8 then AFilename:= Utf8ToAnsi(AFilename); - EasyLazFreeType.FontCollection.AddFile(AFilename); -end; - -procedure TBGRAfpGUIBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); -begin - Draw(ACanvas.GUICanvas, x, y, Opaque); -end; - -procedure TBGRAfpGUIBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); -begin - Draw(ACanvas.GUICanvas, Rect, Opaque); -end; - -procedure TBGRAfpGUIBitmap.Draw(ACanvas: TGUICanvas; x, y: integer; - Opaque: boolean); -begin - BitmapTransparent := not Opaque; - ACanvas.DrawImage(x,y, Bitmap.RawImage); -end; - -procedure TBGRAfpGUIBitmap.Draw(ACanvas: TGUICanvas; Rect: TRect; - Opaque: boolean); -begin - BitmapTransparent := not Opaque; - ACanvas.StretchDraw(rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top, FBitmap.RawImage); -end; - -procedure TBGRAfpGUIBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, - y: integer); -begin - NotAvailable; -end; - -procedure TBGRAfpGUIBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var temp: TBGRAfpGUIBitmap; -begin - temp := TBGRAfpGUIBitmap.Create(AWidth,AHeight); - move(AData^, temp.Data^, temp.NbPixels*sizeof(TBGRAPixel)); - if ALineOrder <> temp.LineOrder then temp.VerticalFlip; - temp.Draw(ACanvas, Rect, False); - temp.Free; -end; - -procedure TBGRAfpGUIBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var temp: TBGRAfpGUIBitmap; -begin - temp := TBGRAfpGUIBitmap.Create(AWidth,AHeight); - move(AData^, temp.Data^, temp.NbPixels*sizeof(TBGRAPixel)); - if ALineOrder <> temp.LineOrder then temp.VerticalFlip; - temp.Draw(ACanvas, Rect, True); - temp.Free; -end; - -procedure TBGRAfpGUIBitmap.TakeScreenshot(ARect: TRect); -begin - NotAvailable; -end; - -procedure TBGRAfpGUIBitmap.TakeScreenshotOfPrimaryMonitor; -begin - NotAvailable; -end; - -procedure TBGRAfpGUIBitmap.LoadFromDevice(DC: HDC); -begin - NotAvailable; -end; - -procedure TBGRAfpGUIBitmap.LoadFromDevice(DC: HDC; ARect: TRect); -begin - NotAvailable; -end; - -end. - diff --git a/components/bgrabitmap/bgrafreetype.pas b/components/bgrabitmap/bgrafreetype.pas deleted file mode 100644 index c95ecc7..0000000 --- a/components/bgrabitmap/bgrafreetype.pas +++ /dev/null @@ -1,1606 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAFreeType; - -{$mode objfpc}{$H+} - -{ - Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType - - This units provide a font renderer with FreeType fonts, using the integrated FreeType font engine in Lazarus. - The simplest way to render effects is to use TBGRAFreeTypeFontRenderer class. - To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions - to draw text like TBGRABitmap.TextOut will use the chosen renderer. - - >> Note that you need to define the default FreeType font collection - >> using EasyLazFreeType unit. - - To set the effects, keep a variable containing - the TBGRAFreeTypeFontRenderer class and modify ShadowVisible and other effects parameters. The FontHinted property - allows you to choose if the font is snapped to pixels to make it more readable. - - TBGRAFreeTypeDrawer class is the class that provides basic FreeType drawing - by deriving the TFreeTypeDrawer type. You can use it directly, but it is not - recommended, because there are less text layout parameters. However, it is - necessary if you want to create TBGRATextEffect objects using FreeType fonts. -} - -interface - -{$i bgrabitmap.inc} - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, EasyLazFreeType, FPimage, - BGRACustomTextFX, BGRAPhongTypes, BGRATypewriter, LazVersion; - -{$IF laz_fullversion >= 2001000} - {$DEFINE LAZFREETYPE_GLYPH_BOX_FIXED} -{$ENDIF} - -{$IF laz_fullversion >= 2010000} - {$DEFINE LAZFREETYPE_PROVIDE_KERNING} -{$ENDIF} - -type - TBGRAFreeTypeDrawer = class; - - //this is the class to assign to FontRenderer property of TBGRABitmap - { TBGRAFreeTypeFontRenderer } - - TBGRAFreeTypeFontRenderer = class(TBGRACustomFontRenderer) - private - FDrawer: TBGRAFreeTypeDrawer; - FFont: TFreeTypeFont; - FLastFontSize: single; - function GetCollection: TCustomFreeTypeFontCollection; - function GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer; - function GetShaderLightPosition: TPoint; - function GetShaderLightPositionF: TPointF; - procedure SetShaderLightPosition(const AValue: TPoint); - procedure SetShaderLightPositionF(const AValue: TPointF); - protected - FShaderOwner: boolean; - FShader: TCustomPhongShading; - FTypeWriter: TBGRACustomTypeWriter; - function GetTypeWriter: TBGRACustomTypeWriter; - procedure UpdateFont(ADisableClearType: boolean = false); - procedure Init; - procedure TextOutAnglePatch(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; - c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment); - procedure InternalTextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); - property TypeWriter: TBGRACustomTypeWriter read GetTypeWriter; - public - FontHinted: boolean; - - ShaderActive: boolean; - - ShadowVisible: boolean; - ShadowColor: TBGRAPixel; - ShadowRadius: integer; - ShadowOffset: TPoint; - ShadowQuality: TRadialBlurType; - - OutlineColor: TBGRAPixel; - OutlineVisible,OuterOutlineOnly: boolean; - OutlineTexture: IBGRAScanner; - - constructor Create; overload; - constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean); overload; - function FontExists(AName: string): boolean; override; - function GetFontPixelMetric: TFontPixelMetric; override; - function GetFontPixelMetricF: TFontPixelMetricF; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); overload; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); overload; override; - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); overload; override; - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); overload; override; - function TextSize(sUTF8: string): TSize; overload; override; - function TextSizeF(sUTF8: string): TPointF; overload; override; - function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; - function TextSizeF(sUTF8: string; AMaxWidthF: single; {%H-}ARightToLeft: boolean): TPointF; overload; override; - function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; - function TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; override; - destructor Destroy; override; - property Collection: TCustomFreeTypeFontCollection read GetCollection; - property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition; - property ShaderLightPositionF: TPointF read GetShaderLightPositionF write SetShaderLightPositionF; - end; - - { TBGRAFreeTypeDrawer } - - TBGRAFreeTypeDrawer = class(TFreeTypeDrawer) - private - FMask: TBGRACustomBitmap; - FColor: TBGRAPixel; - FInCreateTextEffect: boolean; - procedure RenderDirectly(x, y, tx: integer; data: pointer); - procedure RenderDirectlyClearType(x, y, tx: integer; data: pointer); - function ShadowActuallyVisible :boolean; - function OutlineActuallyVisible: boolean; - function ShaderActuallyActive : boolean; - public - Destination: TBGRACustomBitmap; - ClearTypeRGBOrder: boolean; - Texture: IBGRAScanner; - - Shader: TCustomPhongShading; - ShaderActive: boolean; - - ShadowVisible: boolean; - ShadowColor: TBGRAPixel; - ShadowRadius: integer; - ShadowOffset: TPoint; - ShadowQuality: TRadialBlurType; - - OutlineColor: TBGRAPixel; - OutlineVisible,OuterOutlineOnly: boolean; - OutlineTexture: IBGRAScanner; - - constructor Create(ADestination: TBGRACustomBitmap); - procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload; override; - procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload; - procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; - { If this code does not compile, you probably have an older version of Lazarus. To fix the problem, - go into "bgrabitmap.inc" and comment the compiler directives } - {$IFDEF BGRABITMAP_USE_LCL12} - procedure DrawTextWordBreak(AText: string; AFont: TFreeTypeRenderableFont; x, y, AMaxWidth: Single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; - procedure DrawTextRect(AText: string; AFont: TFreeTypeRenderableFont; X1,Y1,X2,Y2: Single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; - {$ENDIF} - {$IFDEF BGRABITMAP_USE_LCL15} - procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload; override; - procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload; - procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload; - {$ENDIF} - function CreateTextEffect(AText: string; AFont: TFreeTypeRenderableFont): TBGRACustomTextEffect; - destructor Destroy; override; - end; - - -implementation - -uses BGRABlend, Math, BGRATransform, BGRAUnicode, BGRAUTF8; - -{$i generatedutf8.inc} - -procedure RecomposeUTF8(AFont: TFreeTypeFont; ADecomposed: string; out ARecomposed: string; out AMarks, AInnerMarks: string); -var - joinBefore, joinAfter: boolean; - lookFor: string; - - function FindChars(AText: string): boolean; - var - p, charLen: Integer; - u: LongWord; - begin - if AFont = nil then exit(true); - - p := 1; - while p <= length(AText) do - begin - charLen := UTF8CharacterLength(@AText[p]); - u := UTF8CodepointToUnicode(@AText[p], charLen); - if AFont.CharIndex[u] = 0 then exit(false); - inc(p, charLen); - end; - result := true; - end; - - function RecomposeRec(AMin,AMax: integer): boolean; - - procedure TryExactMatch; - var - i, extra: Integer; - newExtra: String; - begin - for i := AMin to AMax do - if UTF8Decomposition[i].de = ARecomposed then - begin - if UTF8Decomposition[i].join <> arNone then - if (joinBefore xor (UTF8Decomposition[i].join in[arMedial,arFinal])) or - (joinAfter xor (UTF8Decomposition[i].join in[arInitial,arMedial])) then continue; - if not FindChars(UTF8Decomposition[i].re) then continue; - ARecomposed := UTF8Decomposition[i].re; - result := true; - exit; - end; - for i := AMin to AMax do - if ARecomposed.StartsWith(UTF8Decomposition[i].de, true) then - begin - extra := length(ARecomposed) - length(UTF8Decomposition[i].de); - if UTF8Decomposition[i].join <> arNone then - if (joinBefore xor (UTF8Decomposition[i].join in[arMedial,arFinal])) or - (joinAfter xor (UTF8Decomposition[i].join in[arInitial,arMedial])) then continue; - if not FindChars(UTF8Decomposition[i].re) then continue; - newExtra := copy(ARecomposed, length(ARecomposed)+1-extra, extra); - if GetFirstStrongBidiClassUTF8(newExtra) <> ubcUnknown then continue; - AMarks := newExtra + AMarks; - ARecomposed := UTF8Decomposition[i].re; - result := true; - exit; - end; - result := false; - end; - - var i,j: integer; - begin - if AMax <= AMin+9 then - begin - TryExactMatch; - end else - begin - i := (AMin+AMax) div 2; - if UTF8Decomposition[i].de.StartsWith(lookFor, true) then - begin - j := i; - while (j > AMin) and UTF8Decomposition[j-1].de.StartsWith(lookFor, true) do dec(j); - AMin := j; - j := i; - while (j < AMax) and UTF8Decomposition[j+1].de.StartsWith(lookFor, true) do inc(j); - AMax := j; - TryExactMatch; - end else - if CompareStr(lookFor, UTF8Decomposition[i].de) > 0 then - result := RecomposeRec(i+1, AMax) - else - result := RecomposeRec(AMin, i-1); - end; - end; - - procedure ExtractInnerMarks; - var - p, charLen, pStart: Integer; - u: LongWord; - begin - if ARecomposed.StartsWith(UTF8_ARABIC_LAM, true) then - begin - pStart := length(UTF8_ARABIC_LAM)+1; - p := pStart; - while p <= length(ARecomposed) do - begin - charLen := UTF8CharacterLength(@ARecomposed[p]); - u := UTF8CodepointToUnicode(@ARecomposed[p], charLen); - if GetUnicodeBidiClass(u) = ubcNonSpacingMark then - inc(p, charLen) - else break; - end; - if p>pStart then - begin - AppendStr(AInnerMarks, copy(ARecomposed, pStart, p-pStart)); - delete(ARecomposed, pStart, p-pStart); - end; - end; - end; - - procedure ExtractFinalMarks; - var - p,pStart,pPrev: Integer; - begin - pStart := length(ARecomposed)+1; - p := pStart; - while p > 1 do - begin - pPrev := p; - dec(p); - while (p > 1) and (ARecomposed[p] in[#$80..#$BF]) do dec(p); - if (p = 1) or (ARecomposed[p] in [#$80..#$BF]) or - not (GetUnicodeBidiClassEx(UTF8CodepointToUnicode(@ARecomposed[p], pPrev-p)) - in [ubcNonSpacingMark, ubcCombiningLeftToRight]) then - begin - p := pPrev; - break; - end; - end; - if p < pStart then - begin - AMarks := copy(ARecomposed, p, pStart-p) + AMarks; - delete(ARecomposed, p, pStart-p); - end; - end; - -begin - joinBefore := ADecomposed.StartsWith(UTF8_ZERO_WIDTH_JOINER, true); - joinAfter := ADecomposed.EndsWith(UTF8_ZERO_WIDTH_JOINER, true); - if joinBefore and joinAfter then - ADecomposed := copy(ADecomposed, length(UTF8_ZERO_WIDTH_JOINER)+1, - length(ADecomposed) - (length(UTF8_ZERO_WIDTH_JOINER) shl 1)) else - if joinBefore then Delete(ADecomposed, 1, length(UTF8_ZERO_WIDTH_JOINER)) else - if joinAfter then Delete(ADecomposed, length(ADecomposed) - length(UTF8_ZERO_WIDTH_JOINER) + 1, length(UTF8_ZERO_WIDTH_JOINER)); - - ARecomposed := ADecomposed; - AMarks := ''; - AInnerMarks := ''; - ExtractInnerMarks; - repeat - if length(ADecomposed)<=1 then break; - lookFor := copy(ARecomposed, 1, UTF8CharacterLength(@ARecomposed[1])); - until not RecomposeRec(0, high(UTF8Decomposition)); - ExtractFinalMarks; -end; - -type - TMarkGlyph = record - FreeTypeGlyph: TFreeTypeGlyph; - Index: integer; - Bounds: TRect; - CombiningClass: Byte; - end; - - { TBGRAFreeTypeGlyph } - - TBGRAFreeTypeGlyph = class(TBGRAGlyph) - protected - FFont: TFreeTypeFont; - FCentralText: string; - FCentralTextWidth: Single; - FMarks, FInnerMarks: TUnicodeArray; - FBounds: TRect; - function RetrieveMarkGlyph(AMark: LongWord; out AMarkGlyph: TMarkGlyph; AAllowTranslate: boolean): boolean; - procedure DrawNonSpacingMarks(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); - procedure DrawCentralGlyph(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel); - procedure DrawCombiningMarks(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel; out ACentralLeft: single); - public - constructor Create(AFont: TFreeTypeFont; AIdentifier: string); - constructor Create({%H-}AIdentifier: string); override; - procedure Draw(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); - end; - - { TFreeTypeTypeWriter } - - TFreeTypeTypeWriter = class(TBGRACustomTypeWriter) - protected - FFont: TFreeTypeFont; - function GetGlyph(AIdentifier: string): TBGRAGlyph; override; - function GetKerningOffset(AIdBefore, AIdAfter: string; ARightToLeft: boolean): single; override; - function ComputeKerning({%H-}AIdLeft, {%H-}AIdRight: string): single; override; - public - constructor Create(AFont: TFreeTypeFont); - procedure DrawText(ADrawer: TBGRAFreeTypeDrawer; ATextUTF8: string; X,Y: Single; - AColor: TBGRAPixel; AAlign: TBGRATypeWriterAlignment = twaTopLeft); overload; - end; - -{ TFreeTypeGlyph } - -constructor TBGRAFreeTypeGlyph.Create(AFont: TFreeTypeFont; AIdentifier: string); - - procedure SortMarks(A: TUnicodeArray); - procedure MoveBefore(AFrom, ATo: integer); - var k: integer; - backU: LongWord; - begin - if ATo >= AFrom then exit; - backU := A[AFrom]; - for k := AFrom downto ATo+1 do - A[k] := A[k-1]; - A[ATo] := backU; - end; - - procedure SortByCombiningClass; - var - start, i, j: Integer; - newCC: Byte; - begin - start := 0; - i := start+1; - while i <= high(a) do - begin - //sequence is split - if A[i] = UNICODE_COMBINING_GRAPHEME_JOINER then - begin - start := i+1; - i := start+1; - continue; - end else - begin - newCC := GetUnicodeCombiningClass(A[i]); - j := i; - while (j > start) and (newCC < GetUnicodeCombiningClass(A[j-1])) do dec(j); - MoveBefore(i, j); - inc(i); - end; - end; - end; - - procedure PutShaddaFirst; - var - i, j: Integer; - begin - j := 0; - for i := 0 to high(A) do - if A[i] = UNICODE_COMBINING_GRAPHEME_JOINER then - j := i+1 else - if GetUnicodeCombiningClass(A[i]) = 33 then - begin - MoveBefore(i, j); - inc(j); - end; - end; - - procedure PutLeadingMCMFirst(ACombiningClass: byte); - var - i, j: Integer; - begin - j := 0; - i := 0; - while i <= high(A) do - begin - if A[i] = UNICODE_COMBINING_GRAPHEME_JOINER then - begin - j := i+1; - inc(i); - end else - if GetUnicodeCombiningClass(A[i]) = ACombiningClass then - begin - //put leading MCM first - while IsModifierCombiningMark(A[i]) do - begin - MoveBefore(i, j); - inc(j); - inc(i); - if (i >= length(A)) or - not (GetUnicodeCombiningClass(A[i]) = ACombiningClass) then - break; - end; - //skip rest of combining class - while (i <= high(A)) and (GetUnicodeCombiningClass(A[i]) = ACombiningClass) do - inc(i); - end else - inc(i); - end; - end; - - begin - if A = nil then exit; - SortByCombiningClass; - PutShaddaFirst; - PutLeadingMCMFirst(230); - PutLeadingMCMFirst(220); - end; - - //some marks are combined both from left and right, so they need to be split - procedure SplitMarks; - procedure SplitMark(AFrom: LongWord; ATo1, ATo2: LongWord); - var - i, j: Integer; - begin - for i := high(FMarks) downto 0 do - if FMarks[i] = AFrom then - begin - FMarks[i] := ATo1; - setlength(FMarks, length(FMarks)+1); - for j := high(FMarks) downto i+2 do - FMarks[j] := FMarks[j-1]; - FMarks[i+1] := ATo2; - end; - end; - - begin - {BENGALI} - SplitMark($09CB, $09C7, $09BE); - SplitMark($09CC, $09C7, $09D7); - {TAMIL} - SplitMark($0BCA, $0BC6, $0BBE); - SplitMark($0BCB, $0BC7, $0BBE); - SplitMark($0BCC, $0BC6, $0BD7); - {MALAYALAM} - SplitMark($0D4A, $0D46, $0D3E); - SplitMark($0D4B, $0D47, $0D3E); - SplitMark($0D4C, $0D46, $0D57); - {BALINESE} - SplitMark($1B3D, $1B3C, $1B35); - SplitMark($1B40, $1B3E, $1B35); - SplitMark($1B41, $1B3F, $1B35); - end; - -var - marksStr, innerMarksStr: string; - ofs: TIntegerArray; - u: LongWord; - glyphIndex: LongInt; - ftGlyph: TFreeTypeGlyph; - i: Integer; -begin - inherited Create(AIdentifier); - FFont := AFont; - RecomposeUTF8(FFont, AIdentifier, FCentralText, marksStr, innerMarksStr); - UTF8ToUnicodeArray(marksStr, FMarks, ofs); - SortMarks(FMarks); - UTF8ToUnicodeArray(innerMarksStr, FInnerMarks, ofs); - SortMarks(FInnerMarks); - SplitMarks; - FCentralTextWidth := AFont.TextWidth(FCentralText); - Width := FCentralTextWidth; - for i := 0 to high(FMarks) do - if GetUnicodeBidiClassEx(FMarks[i]) = ubcCombiningLeftToRight then - begin - glyphIndex := AFont.CharIndex[FMarks[i]]; - if glyphIndex <> 0 then - begin - if AFont.ClearType then - Width += AFont.Glyph[glyphIndex].Advance/3 - else Width += AFont.Glyph[glyphIndex].Advance; - end; - end; - Height := AFont.LineFullHeight; - FBounds := EmptyRect; - if length(FCentralText) <> 0 then - begin - u := UTF8CodepointToUnicode(@FCentralText[1], UTF8CharacterLength(@FCentralText[1])); - glyphIndex := AFont.CharIndex[u]; - if glyphIndex <> 0 then - begin - ftGlyph := AFont.Glyph[glyphIndex]; - FBounds := ftGlyph.Bounds; - end; - end; -end; - -constructor TBGRAFreeTypeGlyph.Create(AIdentifier: string); -begin - raise exception.Create('Requires a font'); -end; - -function TBGRAFreeTypeGlyph.RetrieveMarkGlyph(AMark: LongWord; out AMarkGlyph: TMarkGlyph; AAllowTranslate: boolean): boolean; - const - ArabicMarkAbove: array[0..10] of LongWord = - ($0618, $0619, $064B, $064C, $064E, $064F, - $0651, $0652, $0670, $08F0, $08F1); - - ArabicMarkBelow: array[0..3] of LongWord = - ($061A, $064D, $0650, $08F2); - - type - TMarkFallback = record - NonSpacing: LongWord; - Spacing: LongWord; - Moved: boolean; - end; - - const - MarkFallback: array[0..40] of TMarkFallback = ( - (NonSpacing: $300; Spacing: $2CA; Moved: false), - (NonSpacing: $301; Spacing: $B4; Moved: false), - (NonSpacing: $302; Spacing: $5E; Moved: false), - (NonSpacing: $303; Spacing: $2DC; Moved: false), - (NonSpacing: $304; Spacing: $AF; Moved: false), - (NonSpacing: $305; Spacing: $203E; Moved: false), - (NonSpacing: $306; Spacing: $2D8; Moved: false), - (NonSpacing: $307; Spacing: $2D9; Moved: false), - (NonSpacing: $308; Spacing: $A8; Moved: false), - (NonSpacing: $30A; Spacing: $2DA; Moved: false), - (NonSpacing: $30B; Spacing: $2DD; Moved: false), - (NonSpacing: $30E; Spacing: $22; Moved: false), - (NonSpacing: $313; Spacing: $1FBD; Moved: false), - (NonSpacing: $314; Spacing: $1FFE; Moved: false), - (NonSpacing: $316; Spacing: $2CA; Moved: true), - (NonSpacing: $317; Spacing: $B4; Moved: true), - (NonSpacing: $320; Spacing: $AF; Moved: true), - (NonSpacing: $324; Spacing: $A8; Moved: true), - (NonSpacing: $325; Spacing: $2DA; Moved: true), - (NonSpacing: $327; Spacing: $B8; Moved: false), - (NonSpacing: $328; Spacing: $2DB; Moved: false), - (NonSpacing: $32D; Spacing: $5E; Moved: true), - (NonSpacing: $32E; Spacing: $2D8; Moved: true), - (NonSpacing: $330; Spacing: $2DC; Moved: true), - (NonSpacing: $331; Spacing: $AF; Moved: true), - (NonSpacing: $332; Spacing: $203E; Moved: true), - (NonSpacing: $333; Spacing: $2017; Moved: false), - (NonSpacing: $336; Spacing: $2013; Moved: false), - (NonSpacing: $337; Spacing: $2F; Moved: false), - (NonSpacing: $338; Spacing: $2F; Moved: false), - (NonSpacing: $33F; Spacing: $2017; Moved: true), - (NonSpacing: $340; Spacing: $2CA; Moved: false), - (NonSpacing: $341; Spacing: $B4; Moved: false), - (NonSpacing: $342; Spacing: $1FC0; Moved: false), - (NonSpacing: $343; Spacing: $1FBD; Moved: false), - (NonSpacing: $345; Spacing: $37A; Moved: false), - (NonSpacing: $348; Spacing: $22; Moved: true), - (NonSpacing: $35E; Spacing: $203E; Moved: false), - (NonSpacing: $35F; Spacing: $5F; Moved: false), - (NonSpacing: $3099; Spacing: $309B; Moved: false), - (NonSpacing: $309A; Spacing: $309C; Moved: false)); - - function IsArabicMarkAbove(u: LongWord): boolean; - var - i: Integer; - begin - for i := 0 to high(ArabicMarkAbove) do - if ArabicMarkAbove[i] = u then exit(true); - result := false; - end; - - function IsArabicMarkBelow(u: LongWord): boolean; - var - i: Integer; - begin - for i := 0 to high(ArabicMarkBelow) do - if ArabicMarkBelow[i] = u then exit(true); - result := false; - end; - -var k: integer; -begin - AMarkGlyph.Index := FFont.CharIndex[AMark]; - if AMarkGlyph.Index = 0 then - begin - for k := 0 to high(MarkFallback) do - if (MarkFallback[k].NonSpacing = AMark) and - (not MarkFallback[k].Moved or AAllowTranslate) then - begin - AMarkGlyph.Index := FFont.CharIndex[MarkFallback[k].Spacing]; - if AMarkGlyph.Index = 0 then - begin - if MarkFallback[k].Spacing = $1FBD then AMarkGlyph.Index:= FFont.CharIndex[$27] else - if MarkFallback[k].Spacing = $1FC0 then AMarkGlyph.Index:= FFont.CharIndex[$2DC] else - if MarkFallback[k].Spacing = $2CA then AMarkGlyph.Index:= FFont.CharIndex[$60]; - end; - break; - end; - end; - if AMarkGlyph.Index <> 0 then - begin - AMarkGlyph.FreeTypeGlyph := FFont.Glyph[AMarkGlyph.Index]; - AMarkGlyph.Bounds := AMarkGlyph.FreeTypeGlyph.Bounds; - AMarkGlyph.CombiningClass := GetUnicodeCombiningClass(AMark); - if AMarkGlyph.CombiningClass in[27..35] then - begin - if IsArabicMarkAbove(AMark) then AMarkGlyph.CombiningClass := 230 else - if IsArabicMarkBelow(AMark) then AMarkGlyph.CombiningClass := 220; - end; - result := true; - end - else result := false; -end; - -procedure TBGRAFreeTypeGlyph.DrawNonSpacingMarks(ADrawer: TBGRAFreeTypeDrawer; - ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); -var - markGlyph: TMarkGlyph; - aboveOfs, belowOfs, xRef, xRefBelow, xAfter: Single; - justBelow, justAbove: boolean; - - procedure DoJustAbove(const ALetterBounds: TRect); - begin - if justAbove then - begin - {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED} - DecF(aboveOfs, ALetterBounds.Top - markGlyph.Bounds.Bottom); - incF(aboveOfs, FFont.SizeInPixels/12); - {$ELSE} - DecF(aboveOfs, ALetterBounds.Top + FFont.Ascent/3); - {$ENDIF} - justAbove := false; - end; - end; - - procedure DoJustBelow(const ALetterBounds: TRect); - begin - if justBelow then - begin - {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED} - incF(belowOfs, ALetterBounds.Bottom - markGlyph.Bounds.Top); - incF(belowOfs, FFont.SizeInPixels/12); - {$ELSE} - incF(belowOfs, ALetterBounds.Bottom); - {$ENDIF} - justBelow := false; - end; - end; - - function GetMarkOffsetY(AMark: LongWord): single; - begin - if (AMark = $304) or (AMark= $305) or (AMark= $33F) or - (AMark = $320) or (AMark = $331) or (AMark = $332) or (AMark = $333) then - begin - result := FFont.SizeInPixels/8; - end else - begin - {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED} - result := markGlyph.Bounds.Height + FFont.SizeInPixels/20 - {$ELSE} - result := FFont.SizeInPixels/4; - {$ENDIF} - end; - end; - - procedure DrawMark(AMark: LongWord; const ALetterBounds: TRect); - var - ofsX, ofsY: Single; - begin - if GetUnicodeBidiClassEx(AMark) <> ubcNonSpacingMark then exit; - if RetrieveMarkGlyph(AMark, markGlyph, {$IFDEF LAZFREETYPE_GLYPH_BOX_FIXED}true{$ELSE}false{$ENDIF}) then - begin - if markGlyph.CombiningClass = 230 then - begin - DoJustAbove(ALetterBounds); - ofsX := -(markGlyph.Bounds.Left + markGlyph.Bounds.Right)/2; - ofsY := -aboveOfs; - IncF(aboveOfs, GetMarkOffsetY(AMark)); - ADrawer.DrawGlyph(markGlyph.Index, FFont, - xRef + ofsX, ATop + ofsY, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); - end else - if markGlyph.CombiningClass in[220,240] then - begin - if justBelow then incF(ofsX, xRefBelow - xRef); - DoJustBelow(ALetterBounds); - ofsX := -(markGlyph.Bounds.Left + markGlyph.Bounds.Right)/2; - ofsY := belowOfs; - IncF(belowOfs, GetMarkOffsetY(AMark)); - ADrawer.DrawGlyph(markGlyph.Index, FFont, - xRefBelow + ofsX, ATop + ofsY, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); - end else - if markGlyph.CombiningClass = 1 then //overlay - begin - ofsX := -(markGlyph.Bounds.Left + markGlyph.Bounds.Right)/2; - ADrawer.DrawGlyph(markGlyph.Index, FFont, - xRef + ofsX, ATop, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); - end else - ADrawer.DrawGlyph(markGlyph.Index, FFont, - xAfter, ATop, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); - end; - end; - -var - j: integer; -begin - if RTL then xAfter := ALeft else xAfter := ALeft + FCentralTextWidth; - - if FMarks <> nil then - begin - justAbove := false; - if (FCentralText = 'ï»') or (FCentralText = 'ﻂ') or (FCentralText = 'ﻃ') or (FCentralText = 'ﻄ') or - (FCentralText = 'ï»…') or (FCentralText = 'ﻆ') or (FCentralText = 'ﻇ') or (FCentralText = 'ﻈ') then - begin - aboveOfs := 0; - xRef := ALeft + Width*3/4; - xRefBelow := xRef; - end else - if (FCentralText = 'ï»') or (FCentralText = 'ﻞ') or (FCentralText = 'ﻚ') or (FCentralText = 'ï»™') then - begin - aboveOfs := 0; - xRef := ALeft + Width/2; - xRefBelow := xRef; - end else - if (FCentralText = 'ﻵ') or (FCentralText = 'ﻶ') or (FCentralText = 'ï»·') or (FCentralText = 'ﻸ') or - (FCentralText = 'ﻹ') or (FCentralText = 'ﻺ') or (FCentralText = 'ï»»') or (FCentralText = 'ﻼ') then - begin - justAbove := true; - aboveOfs := - FFont.SizeInPixels/10; - xRef := ALeft + Width/6; - xRefBelow := ALeft + Width/4; - end else - begin - justAbove := true; - aboveOfs := 0; - xRef := ALeft + Width/2; - xRefBelow := xRef; - end; - if (FCentralText = 'ï»…') or (FCentralText = 'ﻆ') or (FCentralText = 'ﻇ') or (FCentralText = 'ﻈ') or - (FCentralText = 'ﻚ') or (FCentralText = 'ï»™') then - begin - IncF(aboveOfs, FFont.SizeInPixels/12); - end; - if (FCentralText = 'ïº') or (FCentralText = 'ïº') or (FCentralText = 'ï­’') or (FCentralText = 'ï­“') or - (FCentralText = 'ï­–') or (FCentralText = 'ï­—') or (FCentralText = 'ï­š') or (FCentralText = 'ï­›') or - (FCentralText = 'Ù®') then - begin - DecF(aboveOfs, FFont.SizeInPixels/16); - end; - - belowOfs := 0; - justBelow := true; - for j := 0 to high(FMarks) do - DrawMark(FMarks[j], FBounds); - end; - if FInnerMarks <> nil then - begin - xRef := ALeft + Width*3/4; - xRefBelow := xRef; - aboveOfs := 0; - justAbove := true; - belowOfs := 0; - justBelow := true; - for j := 0 to high(FInnerMarks) do - DrawMark(FInnerMarks[j], FBounds); - end; -end; - -procedure TBGRAFreeTypeGlyph.DrawCentralGlyph(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel); -begin - ADrawer.DrawText(FCentralText, FFont, ALeft, ATop, BGRAToFPColor(AColor), [ftaTop,ftaLeft]); -end; - -procedure TBGRAFreeTypeGlyph.DrawCombiningMarks(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; AColor: TBGRAPixel; out ACentralLeft: single); -var - xRight: Single; - widthFactor: single; - - procedure DrawCombiningMark(AMark: LongWord); - var - markGlyph: TMarkGlyph; - begin - if GetUnicodeBidiClassEx(AMark) <> ubcCombiningLeftToRight then exit; - if RetrieveMarkGlyph(AMark, markGlyph, false) then - begin - if markGlyph.CombiningClass in[208,224] then - begin - ADrawer.DrawGlyph(markGlyph.Index, FFont, ALeft, ATop, - BGRAToFPColor(AColor), [ftaTop,ftaLeft]); - IncF(ALeft, markGlyph.FreeTypeGlyph.Advance*widthFactor); - IncF(xRight, markGlyph.FreeTypeGlyph.Advance*widthFactor); - end else - if markGlyph.CombiningClass in[210,226,9] then - begin - ADrawer.DrawGlyph(markGlyph.Index, FFont, xRight, ATop, - BGRAToFPColor(AColor), [ftaTop,ftaLeft]); - IncF(xRight, markGlyph.FreeTypeGlyph.Advance*widthFactor); - end else - begin - ADrawer.DrawGlyph(markGlyph.Index, FFont, ALeft, ATop, - BGRAToFPColor(AColor), [ftaTop,ftaLeft]); - IncF(ALeft, markGlyph.FreeTypeGlyph.Advance/2*widthFactor); - IncF(xRight, markGlyph.FreeTypeGlyph.Advance*widthFactor); - end; - end; - end; - -var - j: Integer; -begin - if FFont.ClearType then - widthFactor := 1/3 - else widthFactor:= 1; - xRight := ALeft + FCentralTextWidth; - for j := 0 to high(FMarks) do - DrawCombiningMark(FMarks[j]); - ACentralLeft:= ALeft; -end; - -procedure TBGRAFreeTypeGlyph.Draw(ADrawer: TBGRAFreeTypeDrawer; ALeft, ATop: single; RTL: boolean; AColor: TBGRAPixel); -var - xLeft: single; -begin - DrawCombiningMarks(ADrawer, ALeft, ATop, AColor, xLeft); - DrawCentralGlyph(ADrawer, xLeft, ATop, AColor); - DrawNonSpacingMarks(ADrawer, xLeft, ATop, RTL, AColor); -end; - -{ TFreeTypeTypeWriter } - -function TFreeTypeTypeWriter.GetGlyph(AIdentifier: string): TBGRAGlyph; -var - g: TBGRAFreeTypeGlyph; -begin - Result:= inherited GetGlyph(AIdentifier); - if result = nil then - begin - g := TBGRAFreeTypeGlyph.Create(FFont, AIdentifier); - SetGlyph(AIdentifier, g); - result := g; - end; -end; - -function TFreeTypeTypeWriter.GetKerningOffset(AIdBefore, AIdAfter: string; - ARightToLeft: boolean): single; -var - temp: String; -begin - //don't store kerning as it is stored in TFreeTypeFont font object - if ARightToLeft then - begin - temp := AIdBefore; - AIdBefore := AIdAfter; - AIdAfter := temp; - end; - result := ComputeKerning(AIdBefore, AIdAfter); -end; - -function TFreeTypeTypeWriter.ComputeKerning(AIdLeft, AIdRight: string): single; -{$IFDEF LAZFREETYPE_PROVIDE_KERNING} -var - uLeft, uRight: LongWord; -begin - if (AIdLeft = '') or (AIdRight = '') then exit(0); - uLeft := UTF8CodepointToUnicode(@AIdLeft[1], UTF8CharacterLength(@AIdLeft[1])); - uRight := UTF8CodepointToUnicode(@AIdRight[1], UTF8CharacterLength(@AIdRight[1])); - Result:= FFont.CharKerning[uLeft, uRight].Kerning.x; -end; -{$ELSE} -begin - result := 0; -end;{$ENDIF} - -constructor TFreeTypeTypeWriter.Create(AFont: TFreeTypeFont); -begin - inherited Create; - FFont := AFont; - SubstituteBidiBracket:= true; -end; - -procedure TFreeTypeTypeWriter.DrawText(ADrawer: TBGRAFreeTypeDrawer; - ATextUTF8: string; X, Y: Single; AColor: TBGRAPixel; AAlign: TBGRATypeWriterAlignment); -var - i : Integer; - ptGlyph: TPointF; - di: TBGRATextDisplayInfo; -begin - di := GetDisplayInfo(ATextUTF8, x, y, AAlign); - for i := 0 to high(di) do - begin - if di[i].Mirrored then - ptGlyph := di[i].Matrix * PointF(di[i].Glyph.Width, 0) - else ptGlyph := di[i].Matrix * PointF(0, 0); - TBGRAFreeTypeGlyph(di[i].Glyph).Draw(ADrawer, ptGlyph.x, ptGlyph.y, di[i].RTL, AColor); - end; -end; - -{ TBGRAFreeTypeFontRenderer } - -function TBGRAFreeTypeFontRenderer.GetCollection: TCustomFreeTypeFontCollection; -begin - result := EasyLazFreeType.FontCollection; -end; - -function TBGRAFreeTypeFontRenderer.GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer; -begin - result := FDrawer; - result.ShadowColor := ShadowColor; - result.ShadowOffset := ShadowOffset; - result.ShadowRadius := ShadowRadius; - result.ShadowVisible := ShadowVisible; - result.ShadowQuality := ShadowQuality; - result.ClearTypeRGBOrder := FontQuality <> fqFineClearTypeBGR; - result.Destination := ASurface; - result.OutlineColor := OutlineColor; - result.OutlineVisible := OutlineVisible; - result.OuterOutlineOnly := OuterOutlineOnly; - result.OutlineTexture := OutlineTexture; - if ShaderActive then result.Shader := FShader - else result.Shader := nil; -end; - -function TBGRAFreeTypeFontRenderer.GetShaderLightPosition: TPoint; -begin - if FShader = nil then - result := point(0,0) - else - result := FShader.LightPosition; -end; - -function TBGRAFreeTypeFontRenderer.GetShaderLightPositionF: TPointF; -begin - if FShader = nil then - result := pointF(0,0) - else - result := FShader.LightPositionF; -end; - -procedure TBGRAFreeTypeFontRenderer.SetShaderLightPosition(const AValue: TPoint); -begin - if FShader <> nil then - FShader.LightPosition := AValue; -end; - -procedure TBGRAFreeTypeFontRenderer.SetShaderLightPositionF( - const AValue: TPointF); -begin - if FShader <> nil then - FShader.LightPositionF := AValue; -end; - -function TBGRAFreeTypeFontRenderer.GetTypeWriter: TBGRACustomTypeWriter; -begin - if FTypeWriter = nil then - FTypeWriter := TFreeTypeTypeWriter.Create(FFont); - result := FTypeWriter; -end; - -procedure TBGRAFreeTypeFontRenderer.UpdateFont(ADisableClearType: boolean); -var fts: TFreeTypeStyles; - filename: string; - twChange, newClearType: boolean; - newSize: Single; -begin - twChange := false; - fts := []; - if fsBold in FontStyle then include(fts, ftsBold); - if fsItalic in FontStyle then include(fts, ftsItalic); - try - filename := FontName; - if (filename <> FFont.Name) or (fts <> FFont.Style) then - begin - twChange := true; - {$IFDEF BGRABITMAP_USE_LCL12} - FFont.SetNameAndStyle(filename,fts); - {$ELSE} - FFont.Name := filename; - FFont.Style := fts; - {$ENDIF} - end; - except - on ex: exception do - begin - end; - end; - newSize := FontEmHeightF; - if newSize <> FLastFontSize then - begin - twChange := true; - if FontEmHeightF >= 0 then - FFont.SizeInPixels := FontEmHeightF - else - FFont.LineFullHeight := -FontEmHeightF; - FLastFontSize := newSize; - end; - case FontQuality of - fqSystem: - begin - FFont.Quality := grqMonochrome; - newClearType := false; - end; - fqSystemClearType: - begin - FFont.Quality:= grqLowQuality; - newClearType:= true; - end; - fqFineAntialiasing: - begin - FFont.Quality:= grqHighQuality; - newClearType:= false; - end; - fqFineClearTypeRGB,fqFineClearTypeBGR: - begin - FFont.Quality:= grqHighQuality; - newClearType:= true; - end; - end; - if ADisableClearType then newClearType:= false; - if newClearType <> FFont.ClearType then - begin - twChange := true; - FFont.ClearType:= newClearType; - end; - if FFont.Hinted <> FontHinted then - begin - twChange := true; - FFont.Hinted := FontHinted; - end; - {$IFDEF BGRABITMAP_USE_LCL12} - FFont.StrikeOutDecoration := fsStrikeOut in FontStyle; - FFont.UnderlineDecoration := fsUnderline in FontStyle; - {$ENDIF} - if twChange then FreeAndNil(FTypeWriter); -end; - -procedure TBGRAFreeTypeFontRenderer.Init; -begin - ShaderActive := true; - - FDrawer := TBGRAFreeTypeDrawer.Create(nil); - FFont := TFreeTypeFont.Create; - FLastFontSize:= EmptySingle; - FontHinted:= True; - - ShadowColor := BGRABlack; - ShadowVisible := false; - ShadowOffset := Point(5,5); - ShadowRadius := 5; - ShadowQuality:= rbFast; -end; - -procedure TBGRAFreeTypeFontRenderer.TextOutAnglePatch(ADest: TBGRACustomBitmap; - x, y: single; orientation: integer; s: string; c: TBGRAPixel; - tex: IBGRAScanner; align: TAlignment); -const orientationToDeg = -0.1; -var - temp: TBGRACustomBitmap; - coord: TPointF; - angleDeg: single; - OldOrientation: integer; - filter: TResampleFilter; -begin - OldOrientation := FontOrientation; - FontOrientation:= 0; - UpdateFont(true); - - temp := BGRABitmapFactory.Create; - with TypeWriter.GetTextSizeBeforeTransform(s) do - temp.SetSize(ceil(x),ceil(y)); - temp.FillTransparent; - if tex<>nil then - begin - FDrawer.Texture := tex; - InternalTextOut(temp,0,0, s, BGRAWhite, taLeftJustify); - FDrawer.Texture := nil; - end - else - InternalTextOut(temp,0,0, s, c, taLeftJustify); - - orientation:= orientation mod 3600; - if orientation < 0 then inc(orientation, 3600); - - angleDeg := orientation * orientationToDeg; - coord := PointF(x,y); - case align of - taRightJustify: coord.Offset( AffineMatrixRotationDeg(angleDeg)*PointF(-temp.Width,0) ); - taCenter: coord.Offset( AffineMatrixRotationDeg(angleDeg)*PointF(-0.5*temp.Width,0) ); - end; - case orientation of - 0,900,1800,2700: filter := rfBox; - else filter := rfCosine; - end; - ADest.PutImageAngle(coord.x,coord.y, temp, angleDeg, filter); - temp.Free; - - FontOrientation:= OldOrientation; -end; - -procedure TBGRAFreeTypeFontRenderer.InternalTextOut(ADest: TBGRACustomBitmap; - x, y: single; s: string; c: TBGRAPixel; align: TAlignment); -var - twAlign: TBGRATypeWriterAlignment; -begin - case align of - taCenter: twAlign:= twaTop; - taRightJustify: twAlign := twaTopRight - else - twAlign := twaTopLeft; - end; - TFreeTypeTypeWriter(TypeWriter).DrawText(GetDrawer(ADest), s, x,y, c, twAlign); -end; - -constructor TBGRAFreeTypeFontRenderer.Create; -begin - Init; -end; - -constructor TBGRAFreeTypeFontRenderer.Create(AShader: TCustomPhongShading; - AShaderOwner: boolean); -begin - Init; - FShader := AShader; - FShaderOwner := AShaderOwner; -end; - -function TBGRAFreeTypeFontRenderer.FontExists(AName: string): boolean; -var - enum: IFreeTypeFamilyEnumerator; -begin - if Assigned(Collection) then - begin - enum := Collection.FamilyEnumerator; - while enum.MoveNext do - if CompareText(enum.Current.FamilyName, AName) = 0 then exit(true); - result := false; - end else - result := true; -end; - -function TBGRAFreeTypeFontRenderer.GetFontPixelMetric: TFontPixelMetric; -begin - UpdateFont; - result.Baseline := round(FFont.Ascent); - result.CapLine:= round(FFont.Ascent*0.2); - result.DescentLine:= round(FFont.Ascent+FFont.Descent); - result.Lineheight := round(FFont.LineFullHeight); - result.xLine := round(FFont.Ascent*0.45); - result.Defined := True; -end; - -function TBGRAFreeTypeFontRenderer.GetFontPixelMetricF: TFontPixelMetricF; -begin - UpdateFont; - result.Baseline := FFont.Ascent; - result.CapLine:= FFont.Ascent*0.2; - result.DescentLine:= FFont.Ascent+FFont.Descent; - result.Lineheight := FFont.LineFullHeight; - result.xLine := FFont.Ascent*0.45; - result.Defined := True; -end; - -procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); -begin - TextOutAnglePatch(ADest, x,y, orientation, s, c, nil, align); -end; - -procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientation: integer; s: string; texture: IBGRAScanner; - align: TAlignment); -begin - TextOutAnglePatch(ADest, x,y, orientation, s, BGRAPixelTransparent, texture, align); -end; - -procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; s: string; texture: IBGRAScanner; align: TAlignment); -begin - if FontOrientation mod 3600 <> 0 then - TextOutAngle(ADest, x,y, FontOrientation, s, texture, align) - else - begin - FDrawer.Texture := texture; - TextOut(ADest,x,y,s,BGRAWhite,align); - FDrawer.Texture := nil; - end; -end; - -procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; s: string; c: TBGRAPixel; align: TAlignment); -begin - if FontOrientation mod 3600 <> 0 then - TextOutAngle(ADest, x,y, FontOrientation, s, c, align) - else - begin - UpdateFont; - InternalTextOut(ADest, x,y, s, c, align); - end; -end; - -procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap; - ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); -var align: TFreeTypeAlignments; - intersectedClip,previousClip: TRect; -begin - previousClip := ADest.ClipRect; - if style.Clipping then - begin - intersectedClip := TRect.Intersect(previousClip, ARect); - if intersectedClip.IsEmpty then exit; - ADest.ClipRect := intersectedClip; - end; - UpdateFont; - align := []; - case style.Alignment of - taCenter: begin ARect.Left := x; include(align, ftaCenter); end; - taRightJustify: begin ARect.Left := x; include(align, ftaRight); end; - else - include(align, ftaLeft); - end; - case style.Layout of - {$IFDEF BGRABITMAP_USE_LCL12} - tlCenter: begin ARect.Top := y; include(align, ftaVerticalCenter); end; - {$ENDIF} - tlBottom: begin ARect.top := y; include(align, ftaBottom); end; - else include(align, ftaTop); - end; - try - {$IFDEF BGRABITMAP_USE_LCL12} - if style.Wordbreak then - GetDrawer(ADest).DrawTextRect(s, FFont, ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,BGRAToFPColor(c),align) - else - {$ENDIF} - begin - case style.Layout of - tlCenter: y := (ARect.Top+ARect.Bottom) div 2; - tlBottom: y := ARect.Bottom; - else - y := ARect.Top; - end; - case style.Alignment of - taLeftJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Left,y,BGRAToFPColor(c),align); - taCenter: GetDrawer(ADest).DrawText(s,FFont,(ARect.Left+ARect.Right-1) div 2,y,BGRAToFPColor(c),align); - taRightJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Right,y,BGRAToFPColor(c),align); - end; - end; - finally - if style.Clipping then - ADest.ClipRect := previousClip; - end; -end; - -procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap; - ARect: TRect; x, y: integer; s: string; style: TTextStyle; - texture: IBGRAScanner); -begin - FDrawer.Texture := texture; - TextRect(ADest,ARect,x,y,s,style,BGRAWhite); - FDrawer.Texture := nil; -end; - -function TBGRAFreeTypeFontRenderer.TextSize(sUTF8: string): TSize; -begin - with TextSizeF(sUTF8) do - result := Size(System.Round(x),System.Round(y)); -end; - -function TBGRAFreeTypeFontRenderer.TextSizeF(sUTF8: string): TPointF; -begin - UpdateFont; - result := TypeWriter.GetTextSizeBeforeTransform(sUTF8); -end; - -function TBGRAFreeTypeFontRenderer.TextSize(sUTF8: string; AMaxWidth: integer; - ARightToLeft: boolean): TSize; -begin - with TextSizeF(sUTF8, AMaxWidth, ARightToLeft) do - result := Size(System.Round(x),System.Round(y)); -end; - -function TBGRAFreeTypeFontRenderer.TextSizeF(sUTF8: string; AMaxWidthF: single; - ARightToLeft: boolean): TPointF; -var - w,h: single; - charCount, byteCount: integer; -begin - UpdateFont; - result.x := 0; - result.y := 0; - h := FFont.LineFullHeight; - repeat - TypeWriter.TextFitInfoBeforeTransform(sUTF8, AMaxWidthF, charCount, byteCount, w); - if w>result.x then result.x := w; - IncF(result.y, h); - sUTF8 := copy(sUTF8, byteCount+1, length(sUTF8)-byteCount); - until sUTF8 = ''; -end; - -function TBGRAFreeTypeFontRenderer.TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; -begin - result := TextFitInfoF(sUTF8, AMaxWidth); -end; - -function TBGRAFreeTypeFontRenderer.TextFitInfoF(sUTF8: string; - AMaxWidthF: single): integer; -var - byteCount: integer; - usedWidth: single; -begin - UpdateFont; - TypeWriter.TextFitInfoBeforeTransform(sUTF8, AMaxWidthF, result, byteCount, usedWidth); -end; - -destructor TBGRAFreeTypeFontRenderer.Destroy; -begin - FTypeWriter.Free; - FDrawer.Free; - FFont.Free; - if FShaderOwner then FShader.Free; - inherited Destroy; -end; - -{ TBGRAFreeTypeDrawer } - -procedure TBGRAFreeTypeDrawer.RenderDirectly( x,y,tx: integer; - data: pointer ); -var psrc: pbyte; - pdest: PBGRAPixel; - c: TBGRAPixel; -begin - if Destination <> nil then - begin - //ensure rendering in bounds - if (y < 0) or (y >= Destination.height) or (x < 0) or (x > Destination.width-tx) then exit; - - psrc := pbyte(data); - pdest := Destination.ScanLine[y]+x; - if Texture = nil then - begin - c := FColor; - while tx > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest,c,psrc^); - inc(psrc); - inc(pdest); - dec(tx); - end; - end else - begin - Texture.ScanMoveTo(x,y); - while tx > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest,Texture.ScanNextPixel,psrc^); - inc(psrc); - inc(pdest); - dec(tx); - end; - end; - end; -end; - -procedure TBGRAFreeTypeDrawer.RenderDirectlyClearType(x, y, tx: integer; data: pointer); -var xb: integer; - psrc: pbyte; - pdest: PBGRAPixel; -begin - if Destination <> nil then - begin - tx := tx div 3; - if tx=0 then exit; - if (FMask <> nil) and (FMask.Width <> tx) then - FMask.SetSize(tx,1) - else if FMask = nil then FMask := BGRABitmapFactory.create(tx,1); - - pdest := FMask.Data; - psrc := pbyte(data); - pdest^.red := (psrc^ + psrc^ + (psrc+1)^) div 3; - pdest^.green := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3; - if tx > 1 then - pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3 - else - pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3; - inc(pdest); - inc(psrc,3); - for xb := 1 to tx-2 do - begin - pdest^.red := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3; - pdest^.green := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3; - pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3; - inc(pdest); - inc(psrc,3); - end; - if tx > 1 then - begin - pdest^.red := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3; - pdest^.green := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3; - pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3; - end; - BGRAFillClearTypeRGBMask(Destination,x div 3,y,FMask,FColor,Texture,ClearTypeRGBOrder); - end; -end; - -function TBGRAFreeTypeDrawer.ShadowActuallyVisible: boolean; -begin - result := ShadowVisible and (ShadowColor.alpha <> 0); -end; - -function TBGRAFreeTypeDrawer.OutlineActuallyVisible: boolean; -begin - result := ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible; -end; - -function TBGRAFreeTypeDrawer.ShaderActuallyActive: boolean; -begin - result := (Shader <> nil) and ShaderActive; -end; - -constructor TBGRAFreeTypeDrawer.Create(ADestination: TBGRACustomBitmap); -begin - Destination := ADestination; - ClearTypeRGBOrder:= true; - ShaderActive := true; - ShadowQuality:= rbFast; -end; - -procedure TBGRAFreeTypeDrawer.DrawText(AText: string; - AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor); -var fx: TBGRACustomTextEffect; - procedure DoOutline; - begin - if OutlineActuallyVisible then - begin - if OutlineTexture <> nil then - fx.DrawOutline(Destination,round(x),round(y), OutlineTexture) - else - fx.DrawOutline(Destination,round(x),round(y), OutlineColor); - end; - end; -begin - if not FInCreateTextEffect and (ShadowActuallyVisible or OutlineActuallyVisible or ShaderActuallyActive) then - begin - fx := CreateTextEffect(AText, AFont); - fx.ShadowQuality := ShadowQuality; - DecF(y, AFont.Ascent); - if ShadowActuallyVisible then fx.DrawShadow(Destination, round(x+ShadowOffset.X),round(y+ShadowOffset.Y), ShadowRadius, ShadowColor); - if OuterOutlineOnly then DoOutline; - - if texture <> nil then - begin - if ShaderActuallyActive then - fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture) - else - fx.Draw(Destination,round(x),round(y), texture); - end else - begin - if ShaderActuallyActive then - fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), FPColorToBGRA(AColor)) - else - fx.Draw(Destination,round(x),round(y), FPColorToBGRA(AColor)); - end; - if not OuterOutlineOnly then DoOutline; - fx.Free; - end else - begin - FColor := FPColorToBGRA(AColor); - if AFont.ClearType then - AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectlyClearType) - else - AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectly); - end; -end; - -procedure TBGRAFreeTypeDrawer.DrawText(AText: string; - AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel); -begin - DrawText(AText, AFont, x,y, BGRAToFPColor(AColor)); -end; - -procedure TBGRAFreeTypeDrawer.DrawText(AText: string; - AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel; - AAlign: TFreeTypeAlignments); -begin - DrawText(AText, AFont, x,y, BGRAToFPColor(AColor), AAlign); -end; - -{$IFDEF BGRABITMAP_USE_LCL12} -procedure TBGRAFreeTypeDrawer.DrawTextWordBreak(AText: string; - AFont: TFreeTypeRenderableFont; x, y, AMaxWidth: Single; AColor: TBGRAPixel; - AAlign: TFreeTypeAlignments); -begin - DrawTextWordBreak(AText,AFont,x,y,AMaxWidth,BGRAToFPColor(AColor),AAlign); -end; - -procedure TBGRAFreeTypeDrawer.DrawTextRect(AText: string; - AFont: TFreeTypeRenderableFont; X1, Y1, X2, Y2: Single; AColor: TBGRAPixel; - AAlign: TFreeTypeAlignments); -begin - DrawTextRect(AText,AFont,X1,Y1,X2,Y2,BGRAToFPColor(AColor),AAlign); -end; -{$ENDIF} - -{$IFDEF BGRABITMAP_USE_LCL15} -procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer; - AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor); -var f: TFreeTypeFont; -begin - if not (AFont is TFreeTypeFont) then exit; - f := TFreeTypeFont(Afont); - FColor := FPColorToBGRA(AColor); - if AFont.ClearType then - f.RenderGlyph(AGlyph, x, y, Destination.ClipRect, @RenderDirectlyClearType) - else - f.RenderGlyph(AGlyph, x, y, Destination.ClipRect, @RenderDirectly); -end; - -procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer; - AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel); -begin - DrawGlyph(AGlyph, AFont, x,y, BGRAToFPColor(AColor)); -end; - -procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer; - AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel; - AAlign: TFreeTypeAlignments); -begin - DrawGlyph(AGlyph, AFont, x,y, BGRAToFPColor(AColor), AAlign); -end; -{$ENDIF} - -function TBGRAFreeTypeDrawer.CreateTextEffect(AText: string; - AFont: TFreeTypeRenderableFont): TBGRACustomTextEffect; -var - mask: TBGRACustomBitmap; - tx,ty,marginHoriz,marginVert: integer; - tempDest: TBGRACustomBitmap; - tempTex: IBGRAScanner; - tempClearType: boolean; -begin - FInCreateTextEffect:= True; - try - tx := ceil(AFont.TextWidth(AText)); - ty := ceil(AFont.TextHeight(AText)); - marginHoriz := ty div 2; - marginVert := 1; - mask := BGRABitmapFactory.Create(tx+2*marginHoriz,ty+2*marginVert,BGRABlack); - tempDest := Destination; - tempTex := Texture; - tempClearType:= AFont.ClearType; - Destination := mask; - Texture := nil; - AFont.ClearType := false; - DrawText(AText,AFont,marginHoriz,marginVert,BGRAWhite,[ftaTop,ftaLeft]); - Destination := tempDest; - Texture := tempTex; - AFont.ClearType := tempClearType; - mask.ConvertToLinearRGB; - result := TBGRACustomTextEffect.Create(mask, true,tx,ty,point(-marginHoriz,-marginVert)); - finally - FInCreateTextEffect:= false; - end; -end; - -destructor TBGRAFreeTypeDrawer.Destroy; -begin - FMask.Free; - inherited Destroy; -end; - -end. diff --git a/components/bgrabitmap/bgragifformat.pas b/components/bgrabitmap/bgragifformat.pas deleted file mode 100644 index dd32eed..0000000 --- a/components/bgrabitmap/bgragifformat.pas +++ /dev/null @@ -1,1219 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAGifFormat; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmap, BGRABitmapTypes, - BGRAPalette; - -type - //what to do when finishing a frame and starting the next one - TDisposeMode = (dmNone, //undefined value - dmKeep, //keep the changes done by the frame - dmErase, //clear everything after the frame - dmRestore); //restore to how it was before the frame - - //one image in the array - TGifSubImage = record - Image: TBGRABitmap; //image to draw at the beggining of the frame - Position: TPoint; //relative position of the image in the frame - DelayMs: integer; //time in milliseconds to wait before going to next frame - DisposeMode: TDisposeMode; //what do do when going to next frame - HasLocalPalette: boolean; //the image has its own palette - end; - TGifSubImageArray = array of TGifSubImage; - - TGIFSignature = packed array[1..6] of char; //'GIF87a' or 'GIF89a' - - TGIFScreenDescriptor = packed record - Width, Height: word; - flags, //screen bit depth = ((flags shr 4) and 7) + 1 - //palette bit depth = (flags and 7) + 1 - BackgroundColorIndex, //index of background color in global palette - AspectRatio64 : byte; //0 if not specified, otherwise aspect ratio is (AspectRatio64 + 15) / 64 - end; - - TGIFImageDescriptor = packed record - x, y, Width, Height: word; - flags: byte; - end; - - TGIFImageDescriptorWithHeader = packed record - ImageIntroducer: byte; - Image: TGIFImageDescriptor; - end; - - TGIFExtensionBlock = packed record - FunctionCode: byte; - end; - - TGIFGraphicControlExtension = packed record - flags: byte; - DelayHundredthSec: word; - TransparentColorIndex: byte; - end; - - TGIFGraphicControlExtensionWithHeader = packed record - ExtensionIntroducer: byte; - FunctionCode: byte; - BlockSize: byte; - GraphicControl: TGIFGraphicControlExtension; - BlockTerminator: byte; - end; - - TPackedRGBTriple = packed record - r, g, b: byte; - end; - - TGIFData = record - Width, Height: integer; - AspectRatio: single; - BackgroundColor: TColor; - LoopCount: Word; - Images: array of TGifSubImage; - end; - - { EColorQuantizerMissing } - - EColorQuantizerMissing = class(Exception) - constructor Create; - constructor Create(AMessage: string); - end; - -const - GIFScreenDescriptor_GlobalColorTableFlag = $80; //global palette is present - GIFScreenDescriptor_GlobalColorSortFlag = $08; //global palette colors are sorted by importance - - GIFImageIntroducer = $2c; - GIFExtensionIntroducer = $21; - GIFBlockTerminator = $00; - GIFFileTerminator = $3B; - - GIFGraphicControlExtension_TransparentFlag = $01; //transparent color index is provided - GIFGraphicControlExtension_UserInputFlag = $02; //wait for user input at this frame (ignored) - GIFGraphicControlExtension_FunctionCode = $f9; - GIFGraphicControlExtension_DisposeModeShift = 2; - - GIFImageDescriptor_LocalColorTableFlag = $80; //local palette is present - GIFImageDescriptor_InterlacedFlag = $40; //image data is interlaced - GIFImageDescriptor_LocalColorSortFlag = $20; //local palette colors are sorted by importance - - GIFInterlacedStart: array[1..4] of longint = (0, 4, 2, 1); - GIFInterlacedStep: array[1..4] of longint = (8, 8, 4, 2); - - GIFCodeTableSize = 4096; - - NetscapeApplicationIdentifier = 'NETSCAPE2.0'; - NetscapeSubBlockIdLoopCount = 1; - NetscapeSubBlockIdBuffering = 2; - -function CeilLn2(AValue: Integer): integer; -function BGRAToPackedRgbTriple(color: TBGRAPixel): TPackedRGBTriple; -function PackedRgbTribleToBGRA(rgb: TPackedRGBTriple): TBGRAPixel; -function GIFLoadFromStream(stream: TStream; MaxImageCount: integer = maxLongint): TGIFData; -procedure GIFSaveToStream(AData: TGifData; Stream: TStream; AQuantizerFactory: TBGRAColorQuantizerAny; - ADitheringAlgorithm: TDitheringAlgorithm); -procedure GIFDecodeLZW(AStream: TStream; AImage: TBGRACustomBitmap; - const APalette: ArrayOfTBGRAPixel; transcolorIndex: integer; - interlaced: boolean); - -//Encode an image supplied as an sequence of bytes, from left to right and top to bottom. -//Adapted from the work of Udo Schmal, http://www.gocher.me/FPWriteGIF -procedure GIFEncodeLZW(AStream: TStream; AImageData: PByte; - AImageWidth, AImageHeight: integer; ABitDepth: byte); - -implementation - -function PackedRgbTribleToBGRA(rgb: TPackedRGBTriple): TBGRAPixel; -begin - Result.red := rgb.r; - Result.green := rgb.g; - Result.blue := rgb.b; - Result.alpha := 255; -end; - -function BGRAToPackedRgbTriple(color: TBGRAPixel): TPackedRGBTriple; -begin - result.r := color.red; - result.g := color.green; - result.b := color.blue; -end; - -function CeilLn2(AValue: Integer): integer; -var comp: integer; -begin - result := 0; - comp := 1; - while (comp < AValue) and (result < 30) do - begin - inc(result); - comp := comp shl 1; - end; -end; - -procedure GIFDecodeLZW(AStream: TStream; AImage: TBGRACustomBitmap; - const APalette: ArrayOfTBGRAPixel; transcolorIndex: integer; - interlaced: boolean); -var - xd, yd: longint; -type - Pstr = ^Tstr; - - Tstr = record - prefix: Pstr; - suffix: longint; - end; - Pstrtab = ^Tstrtab; - Tstrtab = array[0..GIFCodeTableSize-1] of Tstr; - -var - strtab: Pstrtab; - oldcode, curcode, clearcode, endcode: longint; - codesize, codelen, codemask: longint; - stridx: longint; - bitbuf, bitsinbuf: longint; - bytbuf: packed array[0..255] of byte; - bytinbuf, bytbufidx: byte; - endofsrc: boolean; - xcnt, ycnt, ystep, pass: longint; - pdest: PBGRAPixel; - - procedure InitStringTable; - var - i: longint; - begin - new(strtab); - clearcode := 1 shl codesize; - endcode := clearcode + 1; - stridx := endcode + 1; - codelen := CeilLn2(stridx+1); - codemask := (1 shl codelen) - 1; - for i := 0 to clearcode - 1 do - begin - strtab^[i].prefix := nil; - strtab^[i].suffix := i; - end; - for i := clearcode to GIFCodeTableSize-1 do - begin - strtab^[i].prefix := nil; - strtab^[i].suffix := 0; - end; - end; - - procedure ClearStringTable; - var - i: longint; - begin - clearcode := 1 shl codesize; - endcode := clearcode + 1; - stridx := endcode + 1; - codelen := CeilLn2(stridx+1); - codemask := (1 shl codelen) - 1; - for i := clearcode to GIFCodeTableSize-1 do - begin - strtab^[i].prefix := nil; - strtab^[i].suffix := 0; - end; - end; - - procedure DoneStringTable; - begin - dispose(strtab); - end; - - function GetNextCode: longint; - begin - while (bitsinbuf < codelen) do - begin - if (bytinbuf = 0) then - begin - if AStream.Read(bytinbuf, 1) <> 1 then - raise exception.Create('Unexpected end of stream'); - - if (bytinbuf = 0) then - begin - endofsrc := True; - result := endcode; - exit; - end; - AStream.Read(bytbuf, bytinbuf); - bytbufidx := 0; - end; - bitbuf := bitbuf or (longint(byte(bytbuf[bytbufidx])) shl bitsinbuf); - Inc(bytbufidx); - Dec(bytinbuf); - Inc(bitsinbuf, 8); - end; - Result := bitbuf and codemask; - bitbuf := bitbuf shr codelen; - Dec(bitsinbuf, codelen); - //write(inttostr(result)+'@'+inttostr(codelen)+' '); - end; - - procedure AddStr2Tab(prefix: Pstr; suffix: longint); - begin - if stridx >= GIFCodeTableSize then exit; - strtab^[stridx].prefix := prefix; - strtab^[stridx].suffix := suffix; - Inc(stridx); - if (stridx = 1 shl codelen) - and (stridx < GIFCodeTableSize) then - inc(codelen); - codemask := (1 shl codelen) - 1; - end; - - function Code2Str(code: longint): Pstr; - begin - Result := addr(strtab^[code]); - end; - - procedure WriteStr(s: Pstr); - var - colorIndex: integer; - begin - if (s^.prefix <> nil) then - begin - if s^.prefix = s then - raise exception.Create('Circular reference in prefix'); - WriteStr(s^.prefix); - end; - if (ycnt >= yd) then - begin - if interlaced then - begin - while ycnt >= yd do - begin - if pass >= 5 then exit; - - Inc(pass); - ycnt := GIFInterlacedStart[pass]; - ystep := GIFInterlacedStep[pass]; - end; - end else exit; - end; - - colorIndex := s^.suffix; - if xcnt = 0 then pdest := AImage.ScanLine[ycnt]; - - if (colorIndex <> transcolorIndex) and (colorIndex >= 0) and - (colorIndex < length(APalette)) then - pdest^ := APalette[colorIndex]; - - Inc(xcnt); - inc(pdest); - - if (xcnt >= xd) then - begin - pdest := nil; - xcnt := 0; - Inc(ycnt, ystep); - - if not interlaced then - if (ycnt >= yd) then - begin - Inc(pass); - end; - - end; - end; - - function firstchar(s: Pstr): byte; - begin - while (s^.prefix <> nil) do - s := s^.prefix; - Result := s^.suffix; - end; - -begin - endofsrc := False; - xd := AImage.Width; - yd := AImage.Height; - xcnt := 0; - pdest := nil; - if interlaced then - begin - pass := 1; - ycnt := GIFInterlacedStart[pass]; - ystep := GIFInterlacedStep[pass]; - end - else - begin - pass := 4; - ycnt := 0; - ystep := 1; - end; - oldcode := 0; - bitbuf := 0; - bitsinbuf := 0; - bytinbuf := 0; - bytbufidx := 0; - codesize := 0; - AStream.Read(codesize, 1); - InitStringTable; - try - curcode := getnextcode; - //Write('Reading '); - while (curcode <> endcode) and (pass < 5) and not endofsrc do - begin - if (curcode = clearcode) then - begin - ClearStringTable; - repeat - curcode := getnextcode; - until (curcode <> clearcode); - if (curcode = endcode) then - break; - WriteStr(code2str(curcode)); - oldcode := curcode; - end - else - begin - if (curcode < stridx) then - begin - WriteStr(Code2Str(curcode)); - AddStr2Tab(Code2Str(oldcode), firstchar(Code2Str(curcode))); - oldcode := curcode; - end - else - begin - if (curcode > stridx) then - begin - //write('!Invalid! '); - break; - end; - AddStr2Tab(Code2Str(oldcode), firstchar(Code2Str(oldcode))); - WriteStr(Code2Str(stridx - 1)); - oldcode := curcode; - end; - end; - curcode := getnextcode; - end; - finally - DoneStringTable; - end; - //Writeln; - if not endofsrc then - begin - bytinbuf:= 0; - AStream.ReadBuffer(bytinbuf, 1); - if bytinbuf <> 0 then - raise exception.Create('Invalid GIF format: expecting block terminator'); - end; -end; - -//Encode an image supplied as an sequence of bytes, from left to right and top to bottom. -//Adapted from the work of Udo Schmal, http://www.gocher.me/FPWriteGIF -procedure GIFEncodeLZW(AStream: TStream; AImageData: PByte; - AImageWidth, AImageHeight: integer; ABitDepth: byte); - -var //input position - PInput, PInputEnd: PByte; - - // get the next pixel from the bitmap - function ReadValue: byte; - begin - result := PInput^; - Inc(PInput); - end; - -var // GIF buffer can be up to 255 bytes long - OutputBufferSize: Int32or64; - OutputBuffer: packed array[0..255] of byte; - - procedure FlushByteOutput; - begin - if OutputBufferSize > 0 then - begin - OutputBuffer[0] := OutputBufferSize; - AStream.WriteBuffer(OutputBuffer, OutputBufferSize+1); - OutputBufferSize := 0; - end; - end; - - procedure OutputByte(AValue: byte); - begin - if OutputBufferSize = 255 then FlushByteOutput; - inc(OutputBufferSize); - OutputBuffer[OutputBufferSize] := AValue; - end; - -type TCode = Word; - -var - BitBuffer : LongWord; // steady stream of bit output - BitBufferLen : Byte; // number of bits in buffer - CurCodeSize : byte; // current code size - - // save the code in the output data stream - procedure WriteCode(Code: TCode); - begin - //Write(IntToStr(Code)+'@'+IntToStr(CurCodeSize)+' '); - - // append code to bit buffer - BitBuffer := BitBuffer or (Code shl BitBufferLen); - BitBufferLen := BitBufferLen + CurCodeSize; - // output whole bytes - while BitBufferLen >= 8 do - begin - OutputByte(BitBuffer and $ff); - BitBuffer := BitBuffer shr 8; - dec(BitBufferLen, 8); - end; - end; - - procedure CloseBitOutput; - begin - // write out the rest of the bit string - // and add padding bits if necessary - while BitBufferLen > 0 do - begin - OutputByte(BitBuffer and $ff); - BitBuffer := BitBuffer shr 8; - if BitBufferLen >= 8 then - dec(BitBufferLen, 8) - else - BitBufferLen := 0; - end; - end; - -type - PCodeTableEntry = ^TCodeTableEntry; - TCodeTableEntry = packed record - Prefix: TCode; - LongerFirst, LongerLast: TCode; - Suffix, Padding: Byte; - NextWithPrefix: TCode; - end; - -var - ClearCode : TCode; // reset decode params - EndStreamCode : TCode; // last code in input stream - FirstCodeSlot : TCode; // first slot when table is empty - NextCodeSlot : TCode; // next slot to be used - - PEntry: PCodeTableEntry; - CodeTable: array of TCodeTableEntry; - CurrentCode : TCode; // code representing current string - - procedure DoClearCode; - var - i: Word; - begin - for i := 0 to (1 shl ABitDepth)-1 do - with CodeTable[i] do - begin - LongerFirst:= 0; - LongerLast:= 0; - end; - - WriteCode(ClearCode); - CurCodeSize := CeilLn2(FirstCodeSlot+1); - NextCodeSlot := FirstCodeSlot; - end; - -var - CurValue: Byte; - i: TCode; - found: boolean; // decoded string in prefix table? -begin - if ABitDepth > 8 then - raise exception.Create('Maximum bit depth is 8'); - - //most readers won't handle less than 2 bits - if ABitDepth < 2 then ABitDepth := 2; - - //output - AStream.WriteByte(ABitDepth); - ClearCode := 1 shl ABitDepth; - EndStreamCode := ClearCode + 1; - FirstCodeSlot := ClearCode + 2; - CurCodeSize := CeilLn2(FirstCodeSlot+1); - - OutputBufferSize := 0; - BitBuffer := 0; - BitBufferLen := 0; - - //input - PInput := AImageData; - PInputEnd := AImageData + PtrInt(AImageWidth)*AImageHeight; - - setlength(CodeTable, GIFCodeTableSize); - DoClearCode; - //write('Writing '); - - while PInput < PInputEnd do - begin - CurrentCode := ReadValue; - if CurrentCode >= ClearCode then - raise exception.Create('Internal error'); - - //try to match the longest string - while PInput < PInputEnd do - begin - CurValue := ReadValue; - - found := false; - - i := CodeTable[CurrentCode].LongerFirst; - while i <> 0 do - begin - PEntry := @CodeTable[i]; - if PEntry^.Suffix = CurValue then - begin - found := true; - CurrentCode := i; - break; - end; - i := PEntry^.NextWithPrefix; - end; - - if not found then - begin - PEntry := @CodeTable[CurrentCode]; - if PEntry^.LongerFirst = 0 then - begin - //store the first and last code being longer - PEntry^.LongerFirst := NextCodeSlot; - PEntry^.LongerLast := NextCodeSlot; - end else - begin - //link next entry having the same prefix - CodeTable[PEntry^.LongerLast].NextWithPrefix:= NextCodeSlot; - PEntry^.LongerLast := NextCodeSlot; - end; - - // add new encode table entry - PEntry := @CodeTable[NextCodeSlot]; - PEntry^.Prefix := CurrentCode; - PEntry^.Suffix := CurValue; - PEntry^.LongerFirst := 0; - PEntry^.LongerLast := 0; - PEntry^.NextWithPrefix := 0; - inc(NextCodeSlot); - - Dec(PInput); - break; - end; - end; - - // write the code of the longest entry found - WriteCode(CurrentCode); - - if NextCodeSlot >= GIFCodeTableSize then - DoClearCode - else if NextCodeSlot > 1 shl CurCodeSize then - inc(CurCodeSize); - end; - - WriteCode(EndStreamCode); - CloseBitOutput; - FlushByteOutput; - - AStream.WriteByte(0); //GIF block terminator - //Writeln; -end; - -function GIFLoadFromStream(stream: TStream; MaxImageCount: integer = maxLongint): TGIFData; - - procedure DumpData; - var - Count: byte; - begin - repeat - Count := 0; - stream.Read(Count, 1); - stream.position := stream.position + Count; - until (Count = 0) or (stream.position >= stream.size); - end; - - function ReadString: string; - var Count: byte; - begin - Count := 0; - stream.Read(Count, 1); - setlength(result, Count); - if Count > 0 then - stream.ReadBuffer(result[1], length(result)); - end; - -var - NbImages: integer; - - GIFSignature: TGIFSignature; - GIFScreenDescriptor: TGIFScreenDescriptor; - GIFBlockID: char; - GIFImageDescriptor: TGIFImageDescriptor; - - globalPalette: ArrayOfTBGRAPixel; - localPalette: ArrayOfTBGRAPixel; - - transcolorIndex: integer; - DelayMs: integer; - disposeMode: TDisposeMode; - - procedure LoadGlobalPalette; - var - NbEntries, i: integer; - rgb: TPackedRGBTriple; - begin - NbEntries := 1 shl (GIFScreenDescriptor.flags and $07 + 1); - setlength(globalPalette, NbEntries); - for i := 0 to NbEntries - 1 do - begin - stream.ReadBuffer({%H-}rgb, 3); - globalPalette[i] := PackedRgbTribleToBGRA(rgb); - end; - end; - - procedure LoadLocalPalette; - var - NbEntries, i: integer; - rgb: TPackedRGBTriple; - begin - NbEntries := 1 shl (GIFImageDescriptor.flags and $07 + 1); - setlength(localPalette, NbEntries); - for i := 0 to NbEntries - 1 do - begin - stream.ReadBuffer({%H-}rgb, 3); - localPalette[i] := PackedRgbTribleToBGRA(rgb); - end; - end; - - procedure LoadImage; - var - imgWidth, imgHeight: integer; - img: TBGRABitmap; - Interlaced: boolean; - palette: ArrayOfTBGRAPixel; - begin - stream.Read(GIFImageDescriptor, sizeof(GIFImageDescriptor)); - GIFImageDescriptor.Width := LEtoN(GIFImageDescriptor.Width); - GIFImageDescriptor.Height := LEtoN(GIFImageDescriptor.Height); - GIFImageDescriptor.x := LEtoN(GIFImageDescriptor.x); - GIFImageDescriptor.y := LEtoN(GIFImageDescriptor.y); - if (GIFImageDescriptor.flags and GIFImageDescriptor_LocalColorTableFlag = - GIFImageDescriptor_LocalColorTableFlag) then - LoadLocalPalette - else - localPalette := nil; - - if localPalette <> nil then - palette := localPalette - else - palette := globalPalette; - imgWidth := GIFImageDescriptor.Width; - imgHeight := GIFImageDescriptor.Height; - - if length(result.Images) <= NbImages then - setlength(result.Images, length(result.Images) * 2 + 1); - img := TBGRABitmap.Create(imgWidth, imgHeight); - img.Fill(BGRAPixelTransparent); - result.Images[NbImages].Image := img; - result.Images[NbImages].Position := point(GIFImageDescriptor.x, GIFImageDescriptor.y); - result.Images[NbImages].DelayMs := DelayMs; - result.Images[NbImages].DisposeMode := disposeMode; - result.Images[NbImages].HasLocalPalette := localPalette <> nil; - Inc(NbImages); - - Interlaced := GIFImageDescriptor.flags and GIFImageDescriptor_InterlacedFlag = - GIFImageDescriptor_InterlacedFlag; - GIFDecodeLZW(stream, img, palette, transcolorIndex, Interlaced); - end; - - procedure ReadExtension; - var - GIFExtensionBlock: TGIFExtensionBlock; - GIFGraphicControlExtension: TGIFGraphicControlExtension; - mincount, Count, SubBlockId: byte; - app: String; - - begin - stream.ReadBuffer({%H-}GIFExtensionBlock, sizeof(GIFExtensionBlock)); - case GIFExtensionBlock.FunctionCode of - $F9: //graphic control extension - begin - Count := 0; - stream.Read(Count, 1); - if Count < sizeof(GIFGraphicControlExtension) then - mincount := 0 - else - begin - mincount := sizeof(GIFGraphicControlExtension); - stream.ReadBuffer({%H-}GIFGraphicControlExtension, mincount); - GIFGraphicControlExtension.DelayHundredthSec := LEtoN(GIFGraphicControlExtension.DelayHundredthSec); - - if GIFGraphicControlExtension.flags and - GIFGraphicControlExtension_TransparentFlag = - GIFGraphicControlExtension_TransparentFlag then - transcolorIndex := GIFGraphicControlExtension.TransparentColorIndex - else - transcolorIndex := -1; - if GIFGraphicControlExtension.DelayHundredthSec <> 0 then - DelayMs := GIFGraphicControlExtension.DelayHundredthSec * 10; - DisposeMode := TDisposeMode((GIFGraphicControlExtension.flags shr GIFGraphicControlExtension_DisposeModeShift) and 7); - end; - stream.Position := Stream.Position + Count - mincount; - DumpData; - end; - $ff: //application extension - begin - app := ReadString; - if app <> '' then - begin - if app = NetscapeApplicationIdentifier then - begin - repeat - Count := 0; - stream.Read(Count,1); - if Count = 0 then break; - stream.ReadBuffer({%H-}SubBlockId,1); - Dec(Count); - if (SubBlockId = NetscapeSubBlockIdLoopCount) and (Count >= 2) then - begin - stream.ReadBuffer(result.LoopCount, 2); - dec(Count,2); - result.LoopCount := LEtoN(result.LoopCount); - if result.LoopCount > 0 then inc(result.LoopCount); - end; - stream.Position:= stream.Position+Count; - until false; - end else - DumpData; - end; - end - else - begin - DumpData; - end; - end; - end; - - procedure DiscardImages; - var - i: Integer; - begin - for i := 0 to NbImages-1 do - FreeAndNil(result.Images[i].Image); - NbImages:= 0; - end; - -begin - result.Width := 0; - result.Height := 0; - result.BackgroundColor := clNone; - result.Images := nil; - result.AspectRatio := 1; - result.LoopCount := 1; - if stream = nil then exit; - - NbImages := 0; - transcolorIndex := -1; - DelayMs := 100; - disposeMode := dmErase; - - try - FillChar({%H-}GIFSignature,sizeof(GIFSignature),0); - stream.Read(GIFSignature, sizeof(GIFSignature)); - if (GIFSignature[1] = 'G') and (GIFSignature[2] = 'I') and (GIFSignature[3] = 'F') then - begin - stream.ReadBuffer({%H-}GIFScreenDescriptor, sizeof(GIFScreenDescriptor)); - GIFScreenDescriptor.Width := LEtoN(GIFScreenDescriptor.Width); - GIFScreenDescriptor.Height := LEtoN(GIFScreenDescriptor.Height); - result.Width := GIFScreenDescriptor.Width; - result.Height := GIFScreenDescriptor.Height; - if GIFScreenDescriptor.AspectRatio64 = 0 then - result.AspectRatio:= 1 - else - result.AspectRatio:= (GIFScreenDescriptor.AspectRatio64+15)/64; - if (GIFScreenDescriptor.flags and GIFScreenDescriptor_GlobalColorTableFlag = - GIFScreenDescriptor_GlobalColorTableFlag) then - begin - LoadGlobalPalette; - if GIFScreenDescriptor.BackgroundColorIndex < length(globalPalette) then - result.BackgroundColor := - BGRAToColor(globalPalette[GIFScreenDescriptor.BackgroundColorIndex]); - end; - repeat - stream.ReadBuffer({%H-}GIFBlockID, sizeof(GIFBlockID)); - case GIFBlockID of - ';': ; - ',': begin - if NbImages >= MaxImageCount then break; - LoadImage; - end; - '!': ReadExtension; - else - begin - raise Exception.Create('GIF format: unexpected block type'); - break; - end; - end; - until (GIFBlockID = ';') or (stream.Position >= stream.size); - end - else - raise Exception.Create('GIF format: invalid header'); - except - on ex: Exception do - begin - DiscardImages; - raise Exception.Create('GIF format: '+ ex.Message); - end; - end; - setlength(result.Images, NbImages); -end; - -procedure GIFSaveToStream(AData: TGifData; Stream: TStream; AQuantizerFactory: TBGRAColorQuantizerAny; - ADitheringAlgorithm: TDitheringAlgorithm); -var - signature: TGIFSignature; - screenDescriptor: TGIFScreenDescriptor; - globalPalette: TBGRAPalette; - globalQuantizer: TBGRACustomColorQuantizer; - globalTranspIndex: integer; - - procedure AddColorsToPalette(AImage: TBGRACustomBitmap; APalette: TBGRAPalette); - var n: integer; - p: PBGRAPixel; - c: TBGRAPixel; - begin - p := AImage.Data; - for n := AImage.NbPixels-1 downto 0 do - begin - if p^.alpha < 255 then //transparent color will be needed to dither properly - APalette.AddColor(BGRAPixelTransparent); - if p^.alpha > 0 then //color may be needed to dither properly - begin - c := p^; - c.alpha := 255; - APalette.AddColor(c); - end; - inc(p); - end; - end; - - function ImageCount: integer; - begin - result := length(AData.Images); - end; - - function NeedGlobalPalette: boolean; - var i: integer; - begin - for i := 0 to ImageCount-1 do - if not AData.Images[i].HasLocalPalette then - begin - result := true; - exit; - end; - end; - - function IndexOfGlobalColor(AColor: TBGRAPixel): integer; - begin - if Assigned(globalQuantizer) then - result := globalQuantizer.ReducedPalette.FindNearestColorIndex(AColor) - else - result := globalPalette.IndexOfColor(AColor); - end; - - procedure MakeGlobalPalette; - var i: integer; - indexed: TBGRAIndexedPalette; - bitDepth: integer; - begin - globalPalette := TBGRAPalette.Create; - for i := 0 to ImageCount-1 do - if not AData.Images[i].HasLocalPalette then - AddColorsToPalette(AData.Images[i].Image, globalPalette); - if AData.BackgroundColor <> clNone then - globalPalette.AddColor(ColorToBGRA(AData.BackgroundColor)); - - if globalPalette.Count > 256 then - begin - if Assigned(AQuantizerFactory) then - begin - globalQuantizer:= AQuantizerFactory.Create(globalPalette, False, 256); - globalPalette.Free; - globalPalette := TBGRAIndexedPalette.Create(globalQuantizer.ReducedPalette); - end - else - begin - globalPalette.Free; - raise EColorQuantizerMissing.Create; - end; - end else - begin - indexed := TBGRAIndexedPalette.Create(globalPalette); - globalPalette.Free; - globalPalette := indexed; - end; - - globalTranspIndex:= globalPalette.IndexOfColor(BGRAPixelTransparent); - if AData.BackgroundColor <> clNone then - screenDescriptor.BackgroundColorIndex:= IndexOfGlobalColor(ColorToBGRA(AData.BackgroundColor)) and 255; - - bitDepth := CeilLn2(globalPalette.Count); - if bitDepth > 8 then bitDepth:= 8; - if bitDepth < 1 then bitDepth:= 1; - screenDescriptor.flags := screenDescriptor.flags or GIFScreenDescriptor_GlobalColorTableFlag; - screenDescriptor.flags := screenDescriptor.flags or (bitDepth-1); - end; - - procedure WritePalette(pal: TBGRAPalette; bitDepth: integer); - var i: integer; - numberToWrite,numberFromPal: Integer; - rgbs: ^TPackedRGBTriple; - black: TPackedRGBTriple; - begin - if not Assigned(pal) then exit; - numberToWrite:= 1 shl bitDepth; - numberFromPal := pal.Count; - if numberFromPal > numberToWrite then numberFromPal:= numberToWrite; - getmem(rgbs, numberToWrite*sizeof(TPackedRGBTriple)); - try - for i := 0 to numberFromPal-1 do - rgbs[i] := BGRAToPackedRgbTriple(pal.Color[i]); - black := BGRAToPackedRgbTriple(BGRABlack); - for i := numberFromPal to numberToWrite-1 do - rgbs[i] := black; - Stream.WriteBuffer(rgbs^,sizeof(TPackedRGBTriple)*numberToWrite); - finally - freemem(rgbs); - end; - end; - - procedure WriteGlobalPalette; - begin - WritePalette(globalPalette, (screenDescriptor.flags and 7)+1); - end; - - procedure FreeGlobalPalette; - begin - FreeAndNil(globalPalette); - FreeAndNil(globalQuantizer); - end; - - procedure WriteImages; - var - localPalette: TBGRAPalette; - localQuantizer: TBGRACustomColorQuantizer; - localTranspIndex: integer; - imageDescriptor: TGIFImageDescriptorWithHeader; - - procedure MakeLocalPalette(AFrameIndex: integer); - var - indexed: TBGRAIndexedPalette; - bitDepth: integer; - begin - localPalette := TBGRAPalette.Create; - AddColorsToPalette(AData.Images[AFrameIndex].Image, localPalette); - if localPalette.Count > 256 then - begin - if Assigned(AQuantizerFactory) then - begin - localQuantizer:= AQuantizerFactory.Create(localPalette, False, 256); - localPalette.Free; - localPalette := TBGRAIndexedPalette.Create(localQuantizer.ReducedPalette); - end - else - begin - localPalette.Free; - raise EColorQuantizerMissing.Create; - end; - end else - begin - indexed := TBGRAIndexedPalette.Create(localPalette); - localPalette.Free; - localPalette := indexed; - end; - - localTranspIndex:= localPalette.IndexOfColor(BGRAPixelTransparent); - - bitDepth := CeilLn2(localPalette.Count); - if bitDepth > 8 then bitDepth:= 8; - if bitDepth < 1 then bitDepth:= 1; - imageDescriptor.Image.flags := imageDescriptor.Image.flags or GIFImageDescriptor_LocalColorTableFlag; - imageDescriptor.Image.flags := imageDescriptor.Image.flags or (bitDepth-1); - end; - - procedure WriteLocalPalette; - begin - WritePalette(localPalette, (imageDescriptor.Image.flags and 7)+1); - end; - - procedure FreeLocalPalette; - begin - FreeAndNil(localPalette); - FreeAndNil(localQuantizer); - localTranspIndex:= -1; - end; - - procedure DitherAndCompressImage(AFrame: integer; APalette: TBGRAPalette; AQuantizer: TBGRACustomColorQuantizer); - var ImageData: Pointer; - Image: TBGRABitmap; - y,x: Int32or64; - psource: PBGRAPixel; - pdest: PByte; - begin - Image := AData.Images[AFrame].Image; - if Assigned(AQuantizer) then - ImageData := AQuantizer.GetDitheredBitmapIndexedData(8, ADitheringAlgorithm, Image) - else - begin - GetMem(ImageData, Image.Width*Image.Height); - pdest := ImageData; - for y := 0 to Image.Height -1 do - begin - psource := Image.ScanLine[y]; - for x := 0 to Image.Width -1 do - begin - if psource^.alpha < 128 then - pdest^ := APalette.IndexOfColor(BGRAPixelTransparent) - else - pdest^ := APalette.IndexOfColor(BGRA(psource^.red,psource^.green,psource^.blue,255)); - inc(psource); - inc(pdest); - end; - end; - end; - try - GIFEncodeLZW(Stream, ImageData, Image.Width, Image.Height, CeilLn2(APalette.Count)); - finally - FreeMem(ImageData); - end; - end; - - procedure WriteImage(AFrame: integer); - var - ext: TGIFGraphicControlExtensionWithHeader; - transpIndex: integer; - begin - fillchar({%H-}ext, sizeof(ext), 0); - try - ext.ExtensionIntroducer := GIFExtensionIntroducer; - ext.FunctionCode := GIFGraphicControlExtension_FunctionCode; - ext.BlockSize := sizeof(ext.GraphicControl); - ext.GraphicControl.DelayHundredthSec := (AData.Images[AFrame].DelayMs+5) div 10; - ext.GraphicControl.TransparentColorIndex := 0; - ext.GraphicControl.flags := integer(AData.Images[AFrame].DisposeMode) shl GIFGraphicControlExtension_DisposeModeShift; - ext.BlockTerminator := GIFBlockTerminator; - with AData.Images[AFrame].Position do - begin - imageDescriptor.Image.x := x; - imageDescriptor.Image.y := y; - end; - with AData.Images[AFrame].Image do - begin - imageDescriptor.Image.Width := Width; - imageDescriptor.Image.Height := Height; - end; - imageDescriptor.Image.flags := 0; - - if AData.Images[AFrame].HasLocalPalette then MakeLocalPalette(AFrame); - - if AData.Images[AFrame].Image.HasTransparentPixels then - begin - if AData.Images[AFrame].HasLocalPalette then - transpIndex := localTranspIndex - else - transpIndex := globalTranspIndex; - end else - transpIndex := -1; - if (transpIndex >= 0) and (transpIndex <= 255) then - begin - ext.GraphicControl.flags := ext.GraphicControl.flags or GIFGraphicControlExtension_TransparentFlag; - ext.GraphicControl.TransparentColorIndex := transpIndex; - end; - - Stream.WriteBuffer(ext, sizeof(ext)); - Stream.WriteBuffer(imageDescriptor, sizeof(imageDescriptor)); - WriteLocalPalette; - - if AData.Images[AFrame].HasLocalPalette then - DitherAndCompressImage(AFrame, localPalette, localQuantizer) - else - DitherAndCompressImage(AFrame, globalPalette, globalQuantizer); - finally - FreeLocalPalette; - end; - end; - - var - i: integer; - begin - localPalette := nil; - localQuantizer := nil; - localTranspIndex:= -1; - fillchar({%H-}imageDescriptor, sizeof(imageDescriptor), 0); - imageDescriptor.ImageIntroducer := GIFImageIntroducer; - for i := 0 to ImageCount-1 do - WriteImage(i); - end; - - procedure WriteLoopExtension; - var - app: shortstring; - w: Word; - begin - if AData.LoopCount = 1 then exit; - - Stream.WriteByte(GIFExtensionIntroducer); - Stream.WriteByte($ff); - app := NetscapeApplicationIdentifier; - Stream.WriteBuffer(app[0], length(app)+1); - - Stream.WriteByte(3); - Stream.WriteByte(NetscapeSubBlockIdLoopCount); - if AData.LoopCount = 0 then - w := 0 - else - w := AData.LoopCount-1; - w := NtoLE(w); - Stream.WriteWord(w); - - Stream.WriteByte(0); - end; - -begin - globalPalette := nil; - globalQuantizer := nil; - globalTranspIndex:= -1; - try - signature := 'GIF89a'; - screenDescriptor.Width := NtoLE(AData.Width); - screenDescriptor.Height := NtoLE(AData.Height); - screenDescriptor.flags := $70; //suppose 8-bit screen - screenDescriptor.BackgroundColorIndex := 0; //not specified for now - screenDescriptor.AspectRatio64 := round(AData.AspectRatio*64)-15; - if NeedGlobalPalette then MakeGlobalPalette; - - Stream.WriteBuffer(signature, sizeof(signature)); - Stream.WriteBuffer(screenDescriptor, sizeof(screenDescriptor)); - WriteGlobalPalette; - - WriteLoopExtension; - - WriteImages; - Stream.WriteByte(GIFFileTerminator); //end of file - - finally - FreeGlobalPalette; - end; -end; - -{ EColorQuantizerMissing } - -constructor EColorQuantizerMissing.Create; -begin - inherited Create('Please provide a color quantizer class (one is provided in BGRAColorQuantization)') -end; - -constructor EColorQuantizerMissing.Create(AMessage: string); -begin - inherited Create(AMessage); -end; - -end. - diff --git a/components/bgrabitmap/bgragradientoriginal.pas b/components/bgrabitmap/bgragradientoriginal.pas deleted file mode 100644 index 246b8bb..0000000 --- a/components/bgrabitmap/bgragradientoriginal.pas +++ /dev/null @@ -1,945 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAGradientOriginal; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRALayerOriginal, BGRABitmap, BGRABitmapTypes, BGRAGradientScanner, - BGRASVG, BGRASVGShapes, BGRASVGType; - -type - TBGRAColorInterpolation = BGRAGradientScanner.TBGRAColorInterpolation; - TBGRAGradientRepetition = BGRAGradientScanner.TBGRAGradientRepetition; - TBGRALayerGradientOriginal = class; - - { TBGRAGradientOriginalDiff } - - TBGRAGradientOriginalDiff = class(TBGRAOriginalDiff) - protected - FStorageBefore, FStorageAfter: TBGRAMemOriginalStorage; - public - constructor Create(AOriginal: TBGRALayerGradientOriginal); - procedure ComputeDifference(AOriginal: TBGRALayerGradientOriginal); - destructor Destroy; override; - procedure Apply(AOriginal: TBGRALayerCustomOriginal); override; - procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override; - function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override; - procedure Append(ADiff: TBGRAOriginalDiff); override; - function IsIdentity: boolean; override; - end; - - { TBGRALayerGradientOriginal } - - TBGRALayerGradientOriginal = class(TBGRALayerCustomOriginal) - private - function GetIsOpaque: boolean; - procedure SetColorInterpolation(AValue: TBGRAColorInterpolation); - procedure SetEndColor(AValue: TBGRAPixel); - procedure SetFocalPoint(AValue: TPointF); - procedure SetFocalRadius(AValue: Single); - procedure SetGradientType(AValue: TGradientType); - procedure SetOrigin(AValue: TPointF); - procedure SetRadius(AValue: Single); - procedure SetRepetition(AValue: TBGRAGradientRepetition); - procedure SetStartColor(AValue: TBGRAPixel); - procedure SetXAxis(AValue: TPointF); - procedure SetYAxis(AValue: TPointF); - protected - FStartColor,FEndColor: TBGRAPixel; - FGradientType: TGradientType; - FOrigin,FXAxis,FYAxis,FFocalPoint: TPointF; - FOriginBackup,FXAxisBackup, FYAxisBackup: TPointF; - FRadius,FFocalRadius: single; - FColorInterpolation: TBGRAColorInterpolation; - FRepetition: TBGRAGradientRepetition; - FUpdateCount: integer; - FUpdateDiff: TBGRAGradientOriginalDiff; - function GetAverageColor: TBGRAPixel; - function GetComputedRadius: single; - function GetComputedYAxis: TPointF; - function GetComputedFocalPoint: TPointF; - function GetComputedFocalRadius: single; - procedure OnMoveOrigin({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); - procedure OnMoveXAxis({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); - procedure OnMoveXAxisNeg({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); - procedure OnMoveYAxis({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); - procedure OnMoveFocalPoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); - procedure OnMoveFocalRadius({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState); - procedure OnStartMove({%H-}ASender: TObject; {%H-}AIndex: integer; {%H-}AShift: TShiftState); - procedure BeginUpdate; - procedure EndUpdate; - procedure NotifyChangeWithoutDiff; - public - constructor Create; override; - destructor Destroy; override; - function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; override; - function AddToSVGDefs(const AMatrix: TAffineMatrix; ADefs: TSVGDefine): TObject; - function IsInfiniteSurface: boolean; override; - procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override; - procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean; ADrawMode: TDrawMode); overload; - function CreateScanner(AMatrix: TAffineMatrix; ADraft: boolean = false): TBGRACustomScanner; - procedure ConfigureEditor(AEditor: TBGRAOriginalEditor); override; - function GetRenderBounds(ADestRect: TRect; {%H-}AMatrix: TAffineMatrix): TRect; override; - procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override; - procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override; - class function StorageClassName: RawByteString; override; - class function CanConvertToSVG: boolean; override; - property ComputedYAxis: TPointF read GetComputedYAxis; - property ComputedRadius: single read GetComputedRadius; - property ComputedFocalPoint: TPointF read GetComputedFocalPoint; - property ComputedFocalRadius: single read GetComputedFocalRadius; - procedure Transform(AMatrix: TAffineMatrix); - procedure AssignExceptGeometry(AOther: TBGRALayerGradientOriginal); - procedure FitGeometry(const ABox: TAffineBox); - procedure SetColors(AStartColor, AEndColor: TBGRAPixel); - procedure ApplyOpacity(AOpacity: byte); - function Equals(Obj: TObject): boolean; override; - - property StartColor: TBGRAPixel read FStartColor write SetStartColor; - property EndColor: TBGRAPixel read FEndColor write SetEndColor; - property AverageColor: TBGRAPixel read GetAverageColor; - property GradientType: TGradientType read FGradientType write SetGradientType; //default gtLinear - property Origin: TPointF read FOrigin write SetOrigin; - property XAxis: TPointF read FXAxis write SetXAxis; - property YAxis: TPointF read FYAxis write SetYAxis; - property FocalPoint: TPointF read FFocalPoint write SetFocalPoint; //default Origin - property Radius: Single read FRadius write SetRadius; //default 1 - property FocalRadius: Single read FFocalRadius write SetFocalRadius; //default 0 - property ColorInterpolation: TBGRAColorInterpolation read FColorInterpolation write SetColorInterpolation; - property Repetition: TBGRAGradientRepetition read FRepetition write SetRepetition; - property IsOpaque: boolean read GetIsOpaque; - - end; - -implementation - -uses BGRATransform, BGRABlend, math; - -{ TBGRAGradientOriginalDiff } - -constructor TBGRAGradientOriginalDiff.Create(AOriginal: TBGRALayerGradientOriginal); -begin - FStorageBefore := TBGRAMemOriginalStorage.Create; - AOriginal.SaveToStorage(FStorageBefore); -end; - -procedure TBGRAGradientOriginalDiff.ComputeDifference( - AOriginal: TBGRALayerGradientOriginal); -begin - if Assigned(FStorageAfter) then FreeAndNil(FStorageAfter); - FStorageAfter := TBGRAMemOriginalStorage.Create; - AOriginal.SaveToStorage(FStorageAfter); -end; - -destructor TBGRAGradientOriginalDiff.Destroy; -begin - FStorageBefore.Free; - FStorageAfter.Free; - inherited Destroy; -end; - -procedure TBGRAGradientOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal); -begin - if not Assigned(FStorageAfter) then raise exception.Create('Undefined state after diff'); - AOriginal.LoadFromStorage(FStorageAfter); - (AOriginal as TBGRALayerGradientOriginal).NotifyChangeWithoutDiff; -end; - -procedure TBGRAGradientOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal); -begin - if not Assigned(FStorageBefore) then raise exception.Create('Undefined state before diff'); - AOriginal.LoadFromStorage(FStorageBefore); - (AOriginal as TBGRALayerGradientOriginal).NotifyChangeWithoutDiff; -end; - -function TBGRAGradientOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean; -begin - result := ADiff is TBGRAGradientOriginalDiff; -end; - -procedure TBGRAGradientOriginalDiff.Append(ADiff: TBGRAOriginalDiff); -var - next: TBGRAGradientOriginalDiff; -begin - next := ADiff as TBGRAGradientOriginalDiff; - FreeAndNil(FStorageAfter); - FStorageAfter := next.FStorageAfter.Duplicate as TBGRAMemOriginalStorage; -end; - -function TBGRAGradientOriginalDiff.IsIdentity: boolean; -begin - result := FStorageBefore.Equals(FStorageAfter); -end; - -{ TBGRALayerGradientOriginal } - -function TBGRALayerGradientOriginal.GetComputedRadius: single; -begin - if FRadius = EmptySingle then result := 1 else result := FRadius; -end; - -function TBGRALayerGradientOriginal.GetAverageColor: TBGRAPixel; -begin - result := MergeBGRAWithGammaCorrection(StartColor, 1, EndColor, 1); -end; - -function TBGRALayerGradientOriginal.GetIsOpaque: boolean; -var - xLen, yLen, focalLen: Single; - focalCoord, u, v: TPointF; -begin - result := (StartColor.alpha = 255) and (EndColor.alpha = 255); - if result and (GradientType = gtRadial) and not FocalPoint.IsEmpty and - not Origin.IsEmpty and not XAxis.IsEmpty then - begin - u := XAxis - Origin; - v := ComputedYAxis - Origin; - xLen := VectLen(u); - yLen := VectLen(v); - if (xLen = 0) or (yLen = 0) then - result := false - else - begin - focalCoord := PointF((FocalPoint - Origin)*u/sqr(xLen), - (FocalPoint - Origin)*v/sqr(yLen)); - focalLen := VectLen(focalCoord); - if (focalLen + ComputedFocalRadius + 0.01 >= ComputedRadius) and not - (ComputedFocalRadius > focalLen + ComputedRadius + 0.01) then - result := false; - end; - end; -end; - -procedure TBGRALayerGradientOriginal.SetColorInterpolation( - AValue: TBGRAColorInterpolation); -begin - if FColorInterpolation=AValue then Exit; - BeginUpdate; - FColorInterpolation:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetEndColor(AValue: TBGRAPixel); -begin - if FEndColor.EqualsExactly(AValue) then Exit; - BeginUpdate; - FEndColor:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetFocalPoint(AValue: TPointF); -begin - if FFocalPoint=AValue then Exit; - BeginUpdate; - FFocalPoint:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetFocalRadius(AValue: Single); -begin - if FFocalRadius=AValue then Exit; - BeginUpdate; - FFocalRadius:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetGradientType(AValue: TGradientType); -begin - if FGradientType=AValue then Exit; - BeginUpdate; - FGradientType:=AValue; - if FGradientType in [gtLinear,gtReflected] then FYAxis := EmptyPointF; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetOrigin(AValue: TPointF); -begin - if FOrigin=AValue then Exit; - BeginUpdate; - FOrigin:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetRadius(AValue: Single); -begin - if FRadius=AValue then Exit; - BeginUpdate; - FRadius:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetRepetition( - AValue: TBGRAGradientRepetition); -begin - if FRepetition=AValue then Exit; - BeginUpdate; - FRepetition:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetStartColor(AValue: TBGRAPixel); -begin - if FStartColor.EqualsExactly(AValue) then Exit; - BeginUpdate; - FStartColor:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetXAxis(AValue: TPointF); -begin - if FXAxis=AValue then Exit; - BeginUpdate; - FXAxis:=AValue; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetYAxis(AValue: TPointF); -begin - if FYAxis=AValue then Exit; - BeginUpdate; - FYAxis:=AValue; - EndUpdate; -end; - -function TBGRALayerGradientOriginal.GetComputedYAxis: TPointF; -var - u: TPointF; -begin - if isEmptyPointF(FYAxis) then - begin - u := FXAxis - FOrigin; - result := FOrigin + PointF(-u.y,u.x) - end - else - result := FYAxis; -end; - -function TBGRALayerGradientOriginal.GetComputedFocalPoint: TPointF; -begin - if isEmptyPointF(FFocalPoint) then result := FOrigin else result := FFocalPoint; -end; - -function TBGRALayerGradientOriginal.GetComputedFocalRadius: single; -begin - if FFocalRadius = EmptySingle then result := 0 else result := FFocalRadius; -end; - -procedure TBGRALayerGradientOriginal.OnMoveOrigin(ASender: TObject; APrevCoord, - ANewCoord: TPointF; AShift: TShiftState); -var - delta: TPointF; -begin - BeginUpdate; - delta := ANewCoord-APrevCoord; - FOrigin.Offset(delta); - FXAxis.Offset(delta); - FYAxis.Offset(delta); - FFocalPoint.Offset(delta); - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.OnMoveXAxis(ASender: TObject; APrevCoord, - ANewCoord: TPointF; AShift: TShiftState); -var - m: TAffineMatrix; - c: TPointF; -begin - BeginUpdate; - if not (ssAlt in AShift) or (GradientType in [gtLinear,gtReflected]) then - begin - if not isEmptyPointF(FYAxis) and not isEmptyPointF(FYAxisBackup) then - begin - m := AffineMatrixScaledRotation(FXAxisBackup, ANewCoord, FOrigin); - FYAxis := m*FYAxisBackup; - end; - end else - if isEmptyPointF(FYAxis) then FYAxis := ComputedYAxis; - - if (GradientType = gtLinear) and (ssShift in AShift) then - begin - c := (FOriginBackup+FXAxisBackup)*0.5; - m := AffineMatrixScaledRotation(FXAxisBackup, ANewCoord, c); - FOrigin := m*FOriginBackup; - end - else - FOrigin := FOriginBackup; - - FXAxis := ANewCoord; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.OnMoveXAxisNeg(ASender: TObject; - APrevCoord, ANewCoord: TPointF; AShift: TShiftState); -var - delta, c: TPointF; - m: TAffineMatrix; -begin - BeginUpdate; - delta := ANewCoord-APrevCoord; - - if (GradientType = gtLinear) and (ssShift in AShift) then - begin - c := (FOriginBackup+FXAxisBackup)*0.5; - m := AffineMatrixScaledRotation(FOriginBackup, (FOrigin+delta), c); - FXAxis := m*FXAxisBackup; - end - else - FXAxis := FXAxisBackup; - - FOrigin.Offset(delta); - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.OnMoveYAxis(ASender: TObject; APrevCoord, - ANewCoord: TPointF; AShift: TShiftState); -var - m: TAffineMatrix; -begin - BeginUpdate; - if not (ssAlt in AShift) or (GradientType in [gtLinear,gtReflected]) then - begin - if not isEmptyPointF(FXAxis) then - begin - m := AffineMatrixScaledRotation(FYAxisBackup, ANewCoord, FOrigin); - FXAxis := m*FXAxisBackup; - end; - end; - FYAxis := ANewCoord; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.OnMoveFocalPoint(ASender: TObject; - APrevCoord, ANewCoord: TPointF; AShift: TShiftState); -begin - FocalPoint := ANewCoord; -end; - -procedure TBGRALayerGradientOriginal.OnMoveFocalRadius(ASender: TObject; - APrevCoord, ANewCoord: TPointF; AShift: TShiftState); -var refLen: single; - u, focalOrig: TPointF; -begin - BeginUpdate; - focalOrig := ComputedFocalPoint; - if isEmptyPointF(focalOrig) or isEmptyPointF(FOrigin) or isEmptyPointF(FXAxis) then exit; - refLen := VectLen(FOrigin-FXAxis); - if refLen = 0 then exit; - - u := (FOrigin-FXAxis)*(1/refLen); - FFocalRadius := u * (ANewCoord-focalOrig) / refLen - 0.1; - if FFocalRadius < 0 then FFocalRadius:= 0; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.OnStartMove(ASender: TObject; - AIndex: integer; AShift: TShiftState); -begin - FOriginBackup := FOrigin; - FXAxisBackup := FXAxis; - FYAxisBackup := ComputedYAxis; -end; - -procedure TBGRALayerGradientOriginal.BeginUpdate; -begin - if DiffExpected and (FUpdateCount = 0) then - FUpdateDiff := TBGRAGradientOriginalDiff.Create(self); - inc(FUpdateCount); -end; - -procedure TBGRALayerGradientOriginal.EndUpdate; -begin - if FUpdateCount > 0 then - begin - dec(FUpdateCount); - if FUpdateCount = 0 then - begin - if Assigned(FUpdateDiff) then - FUpdateDiff.ComputeDifference(self); - NotifyChange(FUpdateDiff); - FUpdateDiff := nil; - end; - end; -end; - -procedure TBGRALayerGradientOriginal.NotifyChangeWithoutDiff; -begin - NotifyChange; -end; - -constructor TBGRALayerGradientOriginal.Create; -begin - inherited Create; - FStartColor := BGRABlack; - FEndColor := BGRAWhite; - FGradientType := gtLinear; - FColorInterpolation:= ciStdRGB; - FRepetition := grPad; - FRadius := EmptySingle; - FFocalRadius := EmptySingle; - FFocalPoint := EmptyPointF; - FOrigin := PointF(0,0); - FXAxis := EmptyPointF; - FYAxis := EmptyPointF; -end; - -destructor TBGRALayerGradientOriginal.Destroy; -begin - FUpdateDiff.Free; - inherited Destroy; -end; - -function TBGRALayerGradientOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; -var - svg: TBGRASVG; - def: TSVGDefine; - grad: TSVGGradient; - r: TSVGRectangle; -begin - AOffset:= Point(0, 0); - svg := TBGRASVG.Create(640, 480, cuPixel); // potentially infinite - result := svg; - def := svg.Content.AppendDefine; - grad := AddToSVGDefs(AMatrix, def) as TSVGGradient; - r := svg.Content.AppendRect(0, 0, 100, 100, cuPercent); - if Assigned(grad) then - begin - grad.ID := 'grad1'; - r.fill:= 'url(#grad1)'; - end else - r.fillColor := AverageColor; -end; - -function TBGRALayerGradientOriginal.AddToSVGDefs(const AMatrix: TAffineMatrix; - ADefs: TSVGDefine): TObject; -const ApproxCount = 16; - MaxReflectRepeatCount = 8; -var - grad: TSVGGradient; - colors: TBGRASimpleGradient; - tOrigin, tXAxis, tYAxis, tFocalPoint, reflectedXAxis, repeatedXAxis: TPointF; - gt: TGradientType; - - procedure AddColorStops(AOffset, AFactor: single; AIncludeStart: boolean); - var i, i0: integer; - begin - if (Repetition <> grSine) and (ColorInterpolation in [ciStdRGB, ciLinearRGB]) then - begin - if AFactor >= 0 then - begin - if AIncludeStart then - grad.Content.AppendStop(StartColor, AOffset, false); - grad.Content.AppendStop(EndColor, AOffset + AFactor*1, false); - end else - begin - grad.Content.AppendStop(EndColor, AOffset + AFactor*1, false); - if AIncludeStart then - grad.Content.AppendStop(StartColor, AOffset, false); - end; - end else - begin - colors := TBGRASimpleGradient.CreateAny(ColorInterpolation, StartColor,EndColor, Repetition); - try - if AIncludeStart then i0 := 0 else i0 := 1; - if AFactor >= 0 then - begin - for i := i0 to ApproxCount do - grad.Content.AppendStop(colors.GetColorAtF(i/ApproxCount), AOffset + AFactor*i/ApproxCount, false); - end else - for i := ApproxCount downto i0 do - grad.Content.AppendStop(colors.GetColorAtF(i/ApproxCount), AOffset + AFactor*i/ApproxCount, false); - finally - colors.Free; - end; - end; - end; - -var j: integer; - m: TAffineMatrix; - radialScale: Single; - fp, u, v: TPointF; - lenU, lenV: Single; - -begin - m := AffineMatrixTranslation(0.5, 0.5) * AMatrix; - tOrigin := m * Origin; - tXAxis := m * XAxis; - tYAxis := m * ComputedYAxis; - tFocalPoint := m * ComputedFocalPoint; - gt := GradientType; - if (GradientType = gtReflected) and (Repetition = grReflect) then - gt := gtLinear; // same as linear in this case - case gt of - gtLinear: - grad := ADefs.Content.AppendLinearGradient(tOrigin.X,tOrigin.Y,tXAxis.X,tXAxis.Y,cuCustom); - gtReflected: - begin - if Repetition <> grPad then j := MaxReflectRepeatCount else j := 1; - reflectedXAxis := tOrigin - j*(tXAxis - tOrigin); - repeatedXAxis := tOrigin + j*(tXAxis - tOrigin); - grad := ADefs.Content.AppendLinearGradient(reflectedXAxis.X,reflectedXAxis.Y, - repeatedXAxis.X,repeatedXAxis.Y,cuCustom); - end; - gtDiamond, gtRadial: // diamond approximated by radial - begin - u := tXAxis - tOrigin; - v := tYAxis - tOrigin; - lenU := u.Length; - lenV := v.Length; - radialScale := (lenU + lenV)/2; - if radialScale = 0 then - grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,0, - tOrigin.X,tOrigin.Y,0, cuCustom) - else if (lenU = lenV) and (u*v = 0) then - grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,radialScale*ComputedRadius, - tFocalPoint.X,tFocalPoint.Y,radialScale*ComputedFocalRadius, cuCustom) - else - begin - if lenU = 0 then lenU := 1; - if lenV = 0 then lenV := 1; - fp := PointF((tFocalPoint - tOrigin) * u / sqr(lenU), - (tFocalPoint - tOrigin)*v / sqr(lenV)); - tFocalPoint := tOrigin + (fp.x * radialScale / lenU) * u + (fp.y * radialScale / lenV) * v; - grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,radialScale*ComputedRadius, - tFocalPoint.X,tFocalPoint.Y,radialScale*ComputedFocalRadius, cuCustom); - grad.gradientMatrix[cuPixel] := - AffineMatrix((1 / radialScale)*u, (1 / radialScale)*v, tOrigin) * - AffineMatrixTranslation(-tOrigin.X, -tOrigin.Y); - end; - end; - gtAngular: exit(nil); // not implemented - end; - case Repetition of - grPad: grad.spreadMethod := ssmPad; - grReflect: grad.spreadMethod := ssmReflect; - grRepeat, grSine: grad.spreadMethod := ssmRepeat; - end; - if gt = gtReflected then - begin - if Repetition <> grPad then - begin - for j := -MaxReflectRepeatCount+1 to 0 do - AddColorStops(0.5 + j/MaxReflectRepeatCount*0.5, -0.5/MaxReflectRepeatCount, true); - for j := 0 to MaxReflectRepeatCount-1 do - AddColorStops(0.5 + j*0.5/MaxReflectRepeatCount, 0.5/MaxReflectRepeatCount, j > 0); - end else - begin - AddColorStops(0.5, -0.5, true); - AddColorStops(0.5, 0.5, false); - end; - end else - AddColorStops(0, 1, true); - if ColorInterpolation = ciStdRGB then - grad.colorInterpolation := sciStdRGB - else grad.colorInterpolation := sciLinearRGB; - result := grad; -end; - -function TBGRALayerGradientOriginal.IsInfiniteSurface: boolean; -begin - Result:= true; -end; - -procedure TBGRALayerGradientOriginal.Render(ADest: TBGRABitmap; - AMatrix: TAffineMatrix; ADraft: boolean); -begin - Render(ADest,AMatrix,ADraft,dmSet); -end; - -procedure TBGRALayerGradientOriginal.Render(ADest: TBGRABitmap; - AMatrix: TAffineMatrix; ADraft: boolean; ADrawMode: TDrawMode); -var - grad: TBGRACustomScanner; - temp: TBGRABitmap; -begin - if (ADrawMode in[dmDrawWithTransparency, dmLinearBlend, dmSetExceptTransparent]) and - IsOpaque then ADrawMode := dmSet; - - if ADraft and (ADest.ClipRect.Width*ADest.ClipRect.Height > 512*512) then - begin - temp := TBGRABitmap.Create(0,0); - temp.SetSize(min(400,ADest.Width),min(400,ADest.Height)); - Render(temp, AffineMatrixScale(temp.Width/ADest.Width, - temp.Height/ADest.Height)*AMatrix, ADraft); - ADest.StretchPutImage(rect(0,0,ADest.Width,Adest.Height),temp, ADrawMode); - temp.Free; - end else - begin - grad := CreateScanner(AMatrix, ADraft); - if ADraft then - ADest.FillRect(ADest.ClipRect, grad,ADrawMode) - else ADest.FillRect(ADest.ClipRect, grad,ADrawMode, daFloydSteinberg); - grad.Free; - end; -end; - -function TBGRALayerGradientOriginal.CreateScanner(AMatrix: TAffineMatrix; ADraft: boolean): TBGRACustomScanner; -var - colors: TBGRACustomGradient; - grad: TBGRAGradientScanner; -begin - if isEmptyPointF(FOrigin) or isEmptyPointF(FXAxis) then exit(nil); - - colors := TBGRASimpleGradient.CreateAny(FColorInterpolation, FStartColor,FEndColor, FRepetition); - if ADraft then - colors := TBGRABufferedGradient.Create(colors, true, FRepetition = grPad, 1024); - - if FGradientType = gtRadial then - begin - grad := TBGRAGradientScanner.Create(FOrigin,FXAxis,ComputedYAxis,ComputedFocalPoint,ComputedRadius,ComputedFocalRadius); - end else - grad := TBGRAGradientScanner.Create(FGradientType, FOrigin,FXAxis,ComputedYAxis); - - grad.SetGradient(colors, true); - grad.Transform := AMatrix; - - exit(grad); -end; - -procedure TBGRALayerGradientOriginal.ConfigureEditor( - AEditor: TBGRAOriginalEditor); -var - originPoint: Integer; -begin - if not isEmptyPointF(FOrigin) then - begin - AEditor.AddStartMoveHandler(@OnStartMove); - - if not isEmptyPointF(FXAxis) and (FGradientType = gtLinear) then - originPoint := AEditor.AddPoint((FOrigin + FXAxis)*0.5, @OnMoveOrigin, true) - else originPoint := AEditor.AddPoint(FOrigin, @OnMoveOrigin, true); - - if not isEmptyPointF(FXAxis) then - begin - if not isEmptyPointF(FXAxis) and (FGradientType = gtLinear) then - begin - AEditor.AddArrow((FOrigin + FXAxis)*0.5, FXAxis, @OnMoveXAxis); - AEditor.AddArrow((FOrigin + FXAxis)*0.5, FOrigin, @OnMoveXAxisNeg); - end - else AEditor.AddArrow(FOrigin, FXAxis, @OnMoveXAxis); - - if FGradientType in[gtDiamond, gtRadial, gtAngular] then - AEditor.AddArrow(FOrigin, ComputedYAxis, @OnMoveYAxis); - end; - if FGradientType = gtRadial then - begin - AEditor.AddPoint(ComputedFocalPoint, @OnMoveFocalPoint, false, originPoint); - AEditor.AddArrow(ComputedFocalPoint, ComputedFocalPoint - (FXAxis - FOrigin) * (ComputedFocalRadius + 0.1), @OnMoveFocalRadius, false); - end; - end; -end; - -function TBGRALayerGradientOriginal.GetRenderBounds(ADestRect: TRect; - AMatrix: TAffineMatrix): TRect; -begin - result := ADestRect; -end; - -procedure TBGRALayerGradientOriginal.LoadFromStorage( - AStorage: TBGRACustomOriginalStorage); -var - colorArray: ArrayOfTBGRAPixel; -begin - colorArray := AStorage.ColorArray['colors']; - - FStartColor := colorArray[0]; - FEndColor := colorArray[high(colorArray)]; - - case AStorage.RawString['gradient-type'] of - 'reflected': FGradientType := gtReflected; - 'radial': FGradientType := gtRadial; - 'diamond': FGradientType := gtDiamond; - 'angular': FGradientType := gtAngular; - else {'linear'} FGradientType := gtLinear; - end; - - FOrigin := AStorage.PointF['origin']; - FXAxis := AStorage.PointF['x-axis']; - FYAxis := AStorage.PointF['y-axis']; - FFocalPoint := AStorage.PointF['focal-point']; - - FRadius := AStorage.Float['radial']; - FFocalRadius := AStorage.Float['focal-radius']; - - case AStorage.RawString['color-interpolation'] of - 'RGB': FColorInterpolation:= ciLinearRGB; - 'HSL+': FColorInterpolation:= ciLinearHSLPositive; - 'HSL-': FColorInterpolation:= ciLinearHSLNegative; - 'GSB+': FColorInterpolation:= ciGSBPositive; - 'GSB-': FColorInterpolation:= ciGSBNegative; - else {'sRGB'} FColorInterpolation:= ciStdRGB; - end; - - case AStorage.RawString['repetition'] of - 'repeat': FRepetition:= grRepeat; - 'reflect': FRepetition:= grReflect; - 'sine': FRepetition := grSine; - else {'pad'} FRepetition:= grPad; - end; -end; - -procedure TBGRALayerGradientOriginal.SaveToStorage( - AStorage: TBGRACustomOriginalStorage); -var - gtStr, ciStr: String; - colorArray: ArrayOfTBGRAPixel; -begin - setlength(colorArray,2); - colorArray[0] := FStartColor; - colorArray[1] := FEndColor; - AStorage.ColorArray['colors'] := colorArray; - - case FGradientType of - gtReflected: gtStr := 'reflected'; - gtRadial: gtStr := 'radial'; - gtDiamond: gtStr := 'diamond'; - gtAngular: gtStr := 'angular'; - else {gtLinear} gtStr := 'linear'; - end; - AStorage.RawString['gradient-type'] := gtStr; - - AStorage.PointF['origin'] := FOrigin; - AStorage.PointF['x-axis'] := FXAxis; - - if FGradientType in[gtRadial,gtDiamond,gtAngular] then - AStorage.PointF['y-axis'] := FYAxis - else - AStorage.RemoveAttribute('y-axis'); - - if FGradientType = gtRadial then - begin - AStorage.Float['radius'] := FRadius; - AStorage.Float['focal-radius'] := FFocalRadius; - AStorage.PointF['focal-point'] := FFocalPoint; - end else - begin - AStorage.RemoveAttribute('radius'); - AStorage.RemoveAttribute('focal-radius'); - end; - - case FColorInterpolation of - ciLinearRGB: ciStr := 'RGB'; - ciLinearHSLPositive: ciStr := 'HSL+'; - ciLinearHSLNegative: ciStr := 'HSL-'; - ciGSBPositive: ciStr := 'GSB+'; - ciGSBNegative: ciStr := 'GSB-'; - else {ciStdRGB} ciStr := 'sRGB'; - end; - AStorage.RawString['color-interpolation'] := ciStr; - - case FRepetition of - grRepeat: AStorage.RawString['repetition'] := 'repeat'; - grReflect: AStorage.RawString['repetition'] := 'reflect'; - grSine: AStorage.RawString['repetition'] := 'sine'; - else {grPad} AStorage.RawString['repetition'] := 'pad'; - end; -end; - -class function TBGRALayerGradientOriginal.StorageClassName: RawByteString; -begin - result := 'gradient'; -end; - -class function TBGRALayerGradientOriginal.CanConvertToSVG: boolean; -begin - Result:= true; -end; - -procedure TBGRALayerGradientOriginal.Transform(AMatrix: TAffineMatrix); -begin - BeginUpdate; - if not isEmptyPointF(FOrigin) then FOrigin := AMatrix*FOrigin; - if not isEmptyPointF(FXAxis) then FXAxis := AMatrix*FXAxis; - if not isEmptyPointF(FYAxis) then FYAxis := AMatrix*FYAxis; - if not isEmptyPointF(FFocalPoint) then FFocalPoint := AMatrix*FFocalPoint; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.AssignExceptGeometry( - AOther: TBGRALayerGradientOriginal); -begin - if (GradientType = AOther.GradientType) and - (StartColor.EqualsExactly(AOther.StartColor)) and - (EndColor.EqualsExactly(AOther.EndColor)) and - (ColorInterpolation = AOther.ColorInterpolation) and - (Repetition = AOther.Repetition) then exit; - BeginUpdate; - GradientType := AOther.GradientType; - StartColor:= AOther.StartColor; - EndColor:= AOther.EndColor; - ColorInterpolation:= AOther.ColorInterpolation; - Repetition:= AOther.Repetition; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.FitGeometry(const ABox: TAffineBox); -begin - BeginUpdate; - if GradientType = gtLinear then - begin - Origin := ABox.TopLeft; - XAxis := ABox.BottomRight; - end else - begin - Origin := (ABox.TopLeft + ABox.BottomRight)*0.5; - if GradientType = gtReflected then - XAxis := ABox.BottomRight - else - begin - XAxis := (ABox.TopRight + ABox.BottomRight)*0.5; - YAxis := (ABox.BottomLeft + ABox.BottomRight)*0.5; - end; - end; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.SetColors(AStartColor, - AEndColor: TBGRAPixel); -begin - if (AStartColor = StartColor) and (AEndColor = EndColor) then exit; - BeginUpdate; - StartColor := AStartColor; - EndColor := AEndColor; - EndUpdate; -end; - -procedure TBGRALayerGradientOriginal.ApplyOpacity(AOpacity: byte); -var - cStart, cEnd: TBGRAPixel; -begin - cStart := StartColor; - cStart.alpha := BGRABlend.ApplyOpacity(cStart.alpha, AOpacity); - cEnd := EndColor; - cEnd.alpha := BGRABlend.ApplyOpacity(cEnd.alpha, AOpacity); - SetColors(cStart, cEnd); -end; - -function TBGRALayerGradientOriginal.Equals(Obj: TObject): boolean; -var - other: TBGRALayerGradientOriginal; -begin - if Obj is TBGRALayerGradientOriginal then - begin - other := TBGRALayerGradientOriginal(Obj); - result := StartColor.EqualsExactly(other.StartColor) and - EndColor.EqualsExactly(other.EndColor) and - (GradientType = other.GradientType) and - (Origin = other.Origin) and - (XAxis = other.XAxis) and - ((GradientType in[gtLinear, gtReflected]) or - (YAxis = other.YAxis)) and - ((GradientType <> gtRadial) or - ((FocalPoint = other.FocalPoint) and - (FocalRadius = other.FocalRadius))) and - (ColorInterpolation = other.ColorInterpolation) and - (Repetition = other.Repetition); - end else - Result:=inherited Equals(Obj); -end; - -initialization - - RegisterLayerOriginal(TBGRALayerGradientOriginal); - -end. diff --git a/components/bgrabitmap/bgragradients.pas b/components/bgrabitmap/bgragradients.pas deleted file mode 100644 index 2680a25..0000000 --- a/components/bgrabitmap/bgragradients.pas +++ /dev/null @@ -1,1218 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAGradients; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} -{$i bgrasse.inc} - -interface - -{ Here are various functions that draw gradients, shadow and lighting } - -uses - BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRABitmap, BGRABlend, BGRAPhongTypes, - BGRASSE, BGRAGrayscaleMask; - -{$IFDEF BGRABITMAP_USE_LCL}{ Creates a bitmap with the specified text horizontally centered and with a shadow } -function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel; - AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True): TBGRABitmap; -{$ENDIF} - -{----------------------------------------------------------------------} -{ Functions to draw multiple gradients. - See : http://wiki.lazarus.freepascal.org/Double_Gradient#nGradient } -type - TnGradientInfo = record - StartColor,StopColor: TBGRAPixel; - Direction: TGradientDirection; - EndPercent : single; // Position from 0 to 1 - end; - -function nGradientInfo(StartColor, StopColor: TBGRAPixel; Direction: TGradientDirection; EndPercent: Single): TnGradientInfo; - -function nGradientAlphaFill(ARect: TRect; ADir: TGradientDirection; const AGradient: array of TnGradientInfo): TBGRABitmap; overload; -function nGradientAlphaFill(AWidth, AHeight: Integer; ADir: TGradientDirection; const AGradient: array of TnGradientInfo): TBGRABitmap; overload; -procedure nGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; ADir: TGradientDirection; const AGradient: array of TnGradientInfo); overload; -procedure nGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; ADir: TGradientDirection; const AGradient: array of TnGradientInfo); overload; - -function DoubleGradientAlphaFill(ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; - ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single): TBGRABitmap; overload; -function DoubleGradientAlphaFill(AWidth,AHeight: Integer; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; - ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single): TBGRABitmap; overload; -procedure DoubleGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; - ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single); overload; -procedure DoubleGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; - ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single); overload; - -{----------------------------------------------------------------------} -{ Phong shading functions. Use a height map (grayscale image or a precise map filled with MapHeightToBGRA) - to determine orientation and position of the surface. - - Phong shading consist in adding an ambiant light, a diffuse light (angle between light and object), - and a specular light (angle between light, object and observer, i.e. reflected light) } - -type - TRectangleMapOption = (rmoNoLeftBorder,rmoNoTopBorder,rmoNoRightBorder,rmoNoBottomBorder,rmoLinearBorder); - TRectangleMapOptions = set of TRectangleMapOption; - - { TPhongShading } - - TPhongShading = class(TCustomPhongShading) - public - LightSourceIntensity : Single; //global intensity of the light - - LightSourceDistanceTerm, //minimum distance always added (positive value) - LightSourceDistanceFactor, //how much actual distance is taken into account (usually 0 or 1) - LightDestFactor : Single; //how much the location of the lightened pixel is taken into account (usually 0 or 1) - - LightColor: TBGRAPixel; //color of the light reflection - - SpecularFactor, //how much light is reflected (0..1) - SpecularIndex : Single; //how concentrated reflected light is (positive value) - - AmbientFactor, //ambiant lighting whereever the point is (0..1) - DiffusionFactor, //diffusion, i.e. how much pixels are lightened by light source (0..1) - NegativeDiffusionFactor : Single; //how much hidden surface are darkened (0..1) - DiffuseSaturation: Boolean; //when diffusion saturates, use light color to show it - - constructor Create; - - { Render the specified map on the destination bitmap with one solid color. Map altitude - indicate the global height of the map. } - procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - Color : TBGRAPixel); override; - - { Render with a color map of the same size as the height map. Map altitude - indicate the global height of the map. } - procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorMap : TBGRACustomBitmap); override; - - { Render with a color scanner. Map altitude - indicate the global height of the map. } - procedure DrawScan(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorScan : IBGRAScanner); override; - - { Draw a cone of the specified color } - procedure DrawCone(dest: TBGRACustomBitmap; X,Y,Size: Integer; Altitude: Single; Color: TBGRAPixel); overload; - procedure DrawCone(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); overload; - - { Draw a vertical cone of the specified color } - procedure DrawVerticalCone(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); - - { Draw an horizontal cylinder of the specified color } - procedure DrawHorizontalCylinder(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); - - { Draw a vertical cylinder of the specified color } - procedure DrawVerticalCylinder(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); - - { Draw a hemisphere of the specified color } - procedure DrawSphere(dest: TBGRACustomBitmap; bounds: TRect; Altitude: Single; Color: TBGRAPixel); - - { Draw a rectangle of the specified color } - procedure DrawRectangle(dest: TBGRACustomBitmap; bounds: TRect; Border: Integer; Altitude: Single; Color: TBGRAPixel; RoundCorners: Boolean; Options: TRectangleMapOptions); - - protected - - procedure DrawMapNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorMap : TBGRACustomBitmap); - procedure DrawScannerNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorScan : IBGRAScanner); - procedure DrawColorNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - Color : TBGRAPixel); - - {$ifdef BGRASSE_AVAILABLE} - procedure DrawMapSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorMap : TBGRACustomBitmap); - procedure DrawScannerSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorScan : IBGRAScanner); - procedure DrawColorSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - Color : TBGRAPixel); - {$endif} - end; - -{ Create a grayscale height map for a cone (may not be precise enough) } -function CreateConeMap(size: integer): TBGRABitmap; - -{ Create a precise height map for a cone (not grayscale anymore but more precise) } -function CreateConePreciseMap(width,height: integer): TBGRABitmap; - -{ Create a precise height map for a vertical cone (not grayscale anymore but more precise) } -function CreateVerticalConePreciseMap(width,height: integer): TBGRABitmap; - -{ Create a precise height map for a vertical cylinder (not grayscale anymore but more precise) } -function CreateVerticalCylinderPreciseMap(width,height: integer): TBGRABitmap; - -{ Create a precise height map for an horizontal cylinder (not grayscale anymore but more precise) } -function CreateHorizontalCylinderPreciseMap(width,height: integer): TBGRABitmap; - -{ Create a grayscale height map for a sphere (may not be precise enough) } -function CreateSphereMap(width,height: integer): TBGRABitmap; - -{ Create a precise height map for a sphere (not grayscale anymore but more precise) } -function CreateSpherePreciseMap(width,height: integer): TBGRABitmap; - -{ Create a rectangle height map with a border } -function CreateRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; - -{ Create a precise height map for a rectangle height map with a border (not grayscale anymore but more precise) } -function CreateRectanglePreciseMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; -function CreateRectanglePreciseMap(width, height, borderWidth, borderHeight: integer; options: TRectangleMapOptions): TBGRABitmap; - -{ Create a round rectangle height map with a border } -function CreateRoundRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; - -{ Create a precise height map for a round rectangle height map with a border (not grayscale anymore but more precise) } -function CreateRoundRectanglePreciseMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; -function CreateRoundRectanglePreciseMap(width,height,borderWidth,borderHeight: integer; options: TRectangleMapOptions = []): TBGRABitmap; - -{---------- Perlin Noise -------------} -{ Random image using a superposition of interpolated random values. - See : http://wiki.lazarus.freepascal.org/Perlin_Noise - http://freespace.virgin.net/hugo.elias/models/m_perlin.htm } - -{ Creates a non-tilable random grayscale image } -function CreatePerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single = 1; - VerticalPeriod: Single = 1; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; - -{ Creates a tilable random grayscale image } -function CreateCyclicPerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single = 1; - VerticalPeriod: Single = 1; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; - -implementation - -uses Math, SysUtils{$IFDEF BGRABITMAP_USE_LCL}, BGRATextFX{$ENDIF}; {GraphType unit used by phongdraw.inc} - -{$IFDEF BGRABITMAP_USE_LCL}function TextShadow(AWidth, AHeight: Integer; AText: String; - AFontHeight: Integer; ATextColor, AShadowColor: TBGRAPixel; AOffSetX, - AOffSetY: Integer; ARadius: Integer; AFontStyle: TFontStyles; - AFontName: String; AShowText: Boolean): TBGRABitmap; -begin - result := BGRATextFX.TextShadow(AWidth,AHeight,AText,AFontHeight,ATextColor,AShadowColor,AOffsetX,AOffsetY,ARadius,AFontStyle,AFontName,AShowText) as TBGRABitmap; -end;{$ENDIF} - -function nGradientInfo(StartColor, StopColor: TBGRAPixel; - Direction: TGradientDirection; EndPercent: Single): TnGradientInfo; -begin - result.StartColor := StartColor; - result.StopColor := StopColor; - result.Direction := Direction; - result.EndPercent := EndPercent; -end; - -function DoubleGradientAlphaFill(ARect: TRect; AStart1,AStop1,AStart2,AStop2: TBGRAPixel; - ADirection1,ADirection2,ADir: TGradientDirection; AValue: Single): TBGRABitmap; -var - ABitmap: TBGRABitmap; - ARect1,ARect2: TRect; - APoint1,APoint2,APoint3,APoint4: TPointF; -begin - Dec(ARect.Right, ARect.Left); - ARect.Left := 0; - Dec(ARect.Bottom,ARect.Top); - ARect.Top := 0; - - ABitmap := TBGRABitmap.Create(ARect.Right,ARect.Bottom); - - if AValue <> 0 then ARect1:=ARect; - if AValue <> 1 then ARect2:=ARect; - - if ADir = gdVertical then begin - ARect1.Bottom:=Round(ARect1.Bottom * AValue); - ARect2.Top:=ARect1.Bottom; - end - else if ADir = gdHorizontal then begin - ARect1.Right:=Round(ARect1.Right * AValue); - ARect2.Left:=ARect1.Right; - end; - if ADirection1 = gdVertical then begin - APoint1:=PointF(ARect1.Left,ARect1.Top); - APoint2:=PointF(ARect1.Left,ARect1.Bottom); - end - else if ADirection1 = gdHorizontal then begin - APoint1:=PointF(ARect1.Left,ARect1.Top); - APoint2:=PointF(ARect1.Right,ARect1.Top); - end; - if ADirection2 = gdVertical then begin - APoint3:=PointF(ARect2.Left,ARect2.Top); - APoint4:=PointF(ARect2.Left,ARect2.Bottom); - end - else if ADirection2 = gdHorizontal then begin - APoint3:=PointF(ARect2.Left,ARect2.Top); - APoint4:=PointF(ARect2.Right,ARect2.Top); - end; - - if AValue <> 0 then - ABitmap.GradientFill(ARect1.Left,ARect1.Top,ARect1.Right,ARect1.Bottom, - AStart1,AStop1,gtLinear,APoint1,APoint2,dmSet,True); - if AValue <> 1 then - ABitmap.GradientFill( ARect2.Left,ARect2.Top,ARect2.Right,ARect2.Bottom, - AStart2,AStop2,gtLinear,APoint3,APoint4,dmSet,True); - - Result:=ABitmap; -end; - -function DoubleGradientAlphaFill(AWidth, AHeight: Integer; AStart1, AStop1, - AStart2, AStop2: TBGRAPixel; ADirection1, ADirection2, - ADir: TGradientDirection; AValue: Single): TBGRABitmap; -begin - result := DoubleGradientAlphaFill(Rect(0,0,AWidth,AHeight), - AStart1,AStop1,AStart2,AStop2, - ADirection1,ADirection2, ADir, AValue); -end; - -procedure DoubleGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; AStart1, - AStop1, AStart2, AStop2: TBGRAPixel; ADirection1, ADirection2, - ADir: TGradientDirection; AValue: Single); -var - bmp: TBGRABitmap; -begin - bmp := DoubleGradientAlphaFill(ARect,AStart1,AStop1,AStart2,AStop2,ADirection1,ADirection2,ADir,AValue); - bmp.Draw(ACanvas,ARect.Left,ARect.Top,not bmp.HasTransparentPixels); - bmp.Free; -end; - -procedure DoubleGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; AStart1, - AStop1, AStart2, AStop2: TBGRAPixel; ADirection1, ADirection2, - ADir: TGradientDirection; AValue: Single); -var - bmp: TBGRABitmap; -begin - bmp := DoubleGradientAlphaFill(ARect,AStart1,AStop1,AStart2,AStop2,ADirection1,ADirection2,ADir,AValue); - ABitmap.PutImage(ARect.Left,ARect.Top,bmp,dmDrawWithTransparency); - bmp.Free; -end; - -function nGradientAlphaFill(ARect: TRect; ADir: TGradientDirection; - const AGradient: array of TnGradientInfo): TBGRABitmap; -var - i:integer; - AnRect, OldRect: TRect; - Point1, Point2: TPointF; -begin - Result := TBGRABitmap.Create(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); - Dec(ARect.Right, ARect.Left); - ARect.Left := 0; - Dec(ARect.Bottom,ARect.Top); - ARect.Top := 0; - - OldRect := ARect; - - if ADir = gdVertical then - OldRect.Bottom := ARect.Top - else - OldRect.Right := ARect.Left; - - for i := 0 to high(AGradient) do - begin - AnRect:=OldRect; - if ADir = gdVertical then - begin - AnRect.Bottom:=Round((ARect.Bottom-ARect.Top) * AGradient[i].endPercent + ARect.Top); - AnRect.Top:=OldRect.Bottom; - Point1:=PointF(AnRect.Left,AnRect.Top); - Point2:=PointF(AnRect.Left,AnRect.Bottom); - end - else - begin - AnRect.Right:=Round((ARect.Right-ARect.Left) * AGradient[i].endPercent + ARect.Left); - AnRect.Left:=OldRect.Right; - Point1:=PointF(AnRect.Left,AnRect.Top); - Point2:=PointF(AnRect.Right,AnRect.Top); - end; - Result.GradientFill(AnRect.Left,AnRect.Top,AnRect.Right,AnRect.Bottom, - AGradient[i].StartColor,AGradient[i].StopColor,gtLinear,Point1,Point2,dmSet,True); - OldRect := AnRect; - end; -end; - -function nGradientAlphaFill(AWidth, AHeight: Integer; ADir: TGradientDirection; - const AGradient: array of TnGradientInfo): TBGRABitmap; -begin - result := nGradientAlphaFill(Rect(0,0,AWidth,AHeight),ADir,AGradient); -end; - -procedure nGradientAlphaFill(ACanvas: TCanvas; ARect: TRect; - ADir: TGradientDirection; const AGradient: array of TnGradientInfo); -var - bmp: TBGRABitmap; -begin - bmp := nGradientAlphaFill(ARect, ADir, AGradient); - bmp.Draw(ACanvas,ARect.Left,ARect.Top,not bmp.HasTransparentPixels); - bmp.Free; -end; - -procedure nGradientAlphaFill(ABitmap: TBGRABitmap; ARect: TRect; - ADir: TGradientDirection; const AGradient: array of TnGradientInfo); -var - bmp: TBGRABitmap; -begin - bmp := nGradientAlphaFill(ARect, ADir, AGradient); - ABitmap.PutImage(ARect.Left,ARect.Top,bmp,dmDrawWithTransparency); - bmp.Free; -end; - -{ TPhongShading } - -constructor TPhongShading.Create; -begin - //set default values - LightSourceIntensity := 500; - LightSourceDistanceTerm := 150; - LightSourceDistanceFactor := 1; - LightDestFactor := 1; - LightColor := BGRAWhite; - AmbientFactor := 0.3; - DiffusionFactor := 0.9; - DiffuseSaturation:= False; - NegativeDiffusionFactor := 0.1; - SpecularFactor := 0.6; - SpecularIndex := 10; - LightPosition3D := Point3D(-100,-100,100); -end; - -Const - PhongLightPrecisionSh = 12; - PhongLightPrecision = 1 shl PhongLightPrecisionSh; - PhongLightPrecisionDiv2 = PhongLightPrecision shr 1; - -{------------------ Phong drawing ----------------} -{ Look for the fastest method available } -procedure TPhongShading.Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - Color : TBGRAPixel); -begin - {$ifdef BGRASSE_AVAILABLE} - if UseSSE then - DrawColorSSE(dest,map,mapAltitude,ofsX,ofsY,Color) - else - {$endif} - DrawColorNormal(dest,map,mapAltitude,ofsX,ofsY,Color); -end; - -procedure TPhongShading.Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; - mapAltitude: single; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap); -begin - {$ifdef BGRASSE_AVAILABLE} - if UseSSE then - DrawMapSSE(dest,map,mapAltitude,ofsX,ofsY,ColorMap) - else - {$endif} - DrawMapNormal(dest,map,mapAltitude,ofsX,ofsY,ColorMap); -end; - -procedure TPhongShading.DrawScan(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; - mapAltitude: single; ofsX, ofsY: integer; ColorScan: IBGRAScanner); -begin - {$ifdef BGRASSE_AVAILABLE} - if UseSSE then - DrawScannerSSE(dest,map,mapAltitude,ofsX,ofsY,ColorScan) - else - {$endif} - DrawScannerNormal(dest,map,mapAltitude,ofsX,ofsY,ColorScan); -end; - - {------------------ End of phong drawing ----------------} - -procedure TPhongShading.DrawCone(dest: TBGRACustomBitmap; X, Y, Size: Integer; - Altitude: Single; Color: TBGRAPixel); -var map: TBGRABitmap; -begin - map := CreateConePreciseMap(Size,Size); - Draw(dest,map,Altitude,X,Y,Color); - map.Free; -end; - -procedure TPhongShading.DrawCone(dest: TBGRACustomBitmap; bounds: TRect; - Altitude: Single; Color: TBGRAPixel); -var map: TBGRABitmap; - temp: integer; -begin - if Bounds.Right < Bounds.Left then - begin - temp := Bounds.Left; - bounds.Left := bounds.Right; - Bounds.Right := temp; - end; - if Bounds.Bottom < Bounds.Top then - begin - temp := Bounds.Bottom; - bounds.Bottom := bounds.Top; - Bounds.Top := temp; - end; - map := CreateConePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); - Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); - map.Free; -end; - -procedure TPhongShading.DrawVerticalCone(dest: TBGRACustomBitmap; - bounds: TRect; Altitude: Single; Color: TBGRAPixel); -var map: TBGRABitmap; - temp: integer; -begin - if Bounds.Right < Bounds.Left then - begin - temp := Bounds.Left; - bounds.Left := bounds.Right; - Bounds.Right := temp; - end; - if Bounds.Bottom < Bounds.Top then - begin - temp := Bounds.Bottom; - bounds.Bottom := bounds.Top; - Bounds.Top := temp; - end; - map := CreateVerticalConePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); - Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); - map.Free; -end; - -procedure TPhongShading.DrawHorizontalCylinder(dest: TBGRACustomBitmap; - bounds: TRect; Altitude: Single; Color: TBGRAPixel); -var map: TBGRABitmap; - temp: integer; -begin - if Bounds.Right < Bounds.Left then - begin - temp := Bounds.Left; - bounds.Left := bounds.Right; - Bounds.Right := temp; - end; - if Bounds.Bottom < Bounds.Top then - begin - temp := Bounds.Bottom; - bounds.Bottom := bounds.Top; - Bounds.Top := temp; - end; - map := CreateHorizontalCylinderPreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); - Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); - map.Free; -end; - -procedure TPhongShading.DrawVerticalCylinder(dest: TBGRACustomBitmap; - bounds: TRect; Altitude: Single; Color: TBGRAPixel); -var map: TBGRABitmap; - temp: integer; -begin - if Bounds.Right < Bounds.Left then - begin - temp := Bounds.Left; - bounds.Left := bounds.Right; - Bounds.Right := temp; - end; - if Bounds.Bottom < Bounds.Top then - begin - temp := Bounds.Bottom; - bounds.Bottom := bounds.Top; - Bounds.Top := temp; - end; - map := CreateVerticalCylinderPreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); - Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); - map.Free; -end; - -procedure TPhongShading.DrawSphere(dest: TBGRACustomBitmap; bounds: TRect; - Altitude: Single; Color: TBGRAPixel); -var map: TBGRABitmap; - temp: integer; -begin - if Bounds.Right < Bounds.Left then - begin - temp := Bounds.Left; - bounds.Left := bounds.Right; - Bounds.Right := temp; - end; - if Bounds.Bottom < Bounds.Top then - begin - temp := Bounds.Bottom; - bounds.Bottom := bounds.Top; - Bounds.Top := temp; - end; - map := CreateSpherePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top); - Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); - map.Free; -end; - -procedure TPhongShading.DrawRectangle(dest: TBGRACustomBitmap; bounds: TRect; - Border: Integer; Altitude: Single; Color: TBGRAPixel; RoundCorners: Boolean; Options: TRectangleMapOptions); -var map: TBGRABitmap; - temp: integer; -begin - if Bounds.Right < Bounds.Left then - begin - temp := Bounds.Left; - bounds.Left := bounds.Right; - Bounds.Right := temp; - end; - if Bounds.Bottom < Bounds.Top then - begin - temp := Bounds.Bottom; - bounds.Bottom := bounds.Top; - Bounds.Top := temp; - end; - if border > 10 then - begin - if RoundCorners then - map := CreateRoundRectanglePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options) - else - map := CreateRectanglePreciseMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options); - end else - begin - if RoundCorners then - map := CreateRoundRectangleMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options) - else - map := CreateRectangleMap(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top,Border,Options); - end; - Draw(dest,map,Altitude,bounds.Left,bounds.Top,Color); - map.Free; -end; - -procedure TPhongShading.DrawMapNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; - mapAltitude: single; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap); - {$I phongdraw.inc } - -procedure TPhongShading.DrawColorNormal(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; - mapAltitude: single; ofsX, ofsY: integer; Color: TBGRAPixel); - {$define PARAM_SIMPLECOLOR} - {$I phongdraw.inc } - -procedure TPhongShading.DrawScannerNormal(dest: TBGRACustomBitmap; - map: TBGRACustomBitmap; mapAltitude: single; ofsX, ofsY: integer; - ColorScan: IBGRAScanner); - {$define PARAM_SCANNER} - {$I phongdraw.inc } - -{$ifdef BGRASSE_AVAILABLE} -procedure TPhongShading.DrawMapSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; - mapAltitude: single; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap); - {$define PARAM_PHONGSSE} - {$I phongdraw.inc } - -procedure TPhongShading.DrawColorSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; - mapAltitude: single; ofsX, ofsY: integer; Color: TBGRAPixel); - {$define PARAM_PHONGSSE} - {$define PARAM_SIMPLECOLOR} - {$I phongdraw.inc } - -procedure TPhongShading.DrawScannerSSE(dest: TBGRACustomBitmap; - map: TBGRACustomBitmap; mapAltitude: single; ofsX, ofsY: integer; - ColorScan: IBGRAScanner); - {$define PARAM_PHONGSSE} - {$define PARAM_SCANNER} - {$I phongdraw.inc } - -{$endif} - -{************************ maps ***********************************} - -function CreateConeMap(size: integer): TBGRABitmap; -var cx,cy,r: single; - mask: TGrayscaleMask; -begin - cx := (size-1)/2; - cy := (size-1)/2; - r := (size-1)/2; - result := TBGRABitmap.Create(size,size); - result.GradientFill(0,0,size,size,BGRAWhite,BGRABlack,gtRadial,PointF(cx,cy),PointF(cx+r,cy),dmSet,False); - - mask := TGrayscaleMask.Create(size,size,BGRABlack); - mask.FillEllipseAntialias(cx,cy,r,r,BGRAWhite); - result.ApplyMask(mask); - mask.Free; -end; - -function CreateConePreciseMap(width,height: integer): TBGRABitmap; -var cx,cy,rx,ry,d: single; - xb,yb: integer; - p: PBGRAPixel; - mask: TGrayscaleMask; -begin - result := TBGRABitmap.Create(width,height); - cx := (width-1)/2; - cy := (height-1)/2; - rx := (width-1)/2; - ry := (height-1)/2; - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - d := sqr((xb-cx)/(rx+1))+sqr((yb-cy)/(ry+1)); - if d >= 1 then - p^ := BGRAPixelTransparent else - p^ := MapHeightToBGRA(1-sqrt(d),255); - inc(p); - end; - end; - //antialiased border - mask := TGrayscaleMask.Create(width,height,BGRABlack); - mask.FillEllipseAntialias(cx,cy,rx,ry,BGRAWhite); - result.ApplyMask(mask); - mask.Free; -end; - -function CreateVerticalConePreciseMap(width, height: integer): TBGRABitmap; -var cx,rx,d,vpos: single; - xb,yb: integer; - p: PBGRAPixel; - mask: TGrayscaleMask; -begin - result := TBGRABitmap.Create(width,height); - if (height=0) or (width=0) then exit; - cx := (width-1)/2; - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - vpos := (yb+1)/height; - rx := width/2*vpos; - for xb := 0 to width-1 do - begin - d := sqr((xb-cx)/(rx+1)); - if d >= 1 then - p^ := BGRAPixelTransparent else - p^ := MapHeightToBGRA(sqrt(1-d)*vpos,255); - inc(p); - end; - end; - //antialiased border - mask := TGrayscaleMask.Create(width,height,BGRABlack); - mask.FillPolyAntialias([PointF(width/2,-0.5),PointF(0,height-0.5),PointF(width-0.5,height-0.5)],BGRAWhite); - result.ApplyMask(mask); - mask.Free; -end; - -function CreateVerticalCylinderPreciseMap(width, height: integer): TBGRABitmap; -var cx,rx,d: single; - xb: integer; -begin - result := TBGRABitmap.Create(width,height); - if (height=0) or (width=0) then exit; - rx := width/2; - cx := (width-1)/2; - for xb := 0 to width-1 do - begin - d := sqr((xb-cx)/(rx+1)); - result.SetVertLine(xb,0,height-1,MapHeightToBGRA(sqrt(1-d),255)); - end; -end; - -function CreateHorizontalCylinderPreciseMap(width, height: integer - ): TBGRABitmap; -var cy,ry,d: single; - xb,yb: integer; - p: PBGRAPixel; - c: TBGRAPixel; -begin - result := TBGRABitmap.Create(width,height); - if (height=0) or (width=0) then exit; - ry := height/2; - cy := (height-1)/2; - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - d := sqr((yb-cy)/(ry+1)); - c := MapHeightToBGRA(sqrt(1-d),255); - for xb := 0 to width-1 do - begin - p^ := c; - inc(p); - end; - end; -end; - -function CreateSphereMap(width,height: integer): TBGRABitmap; -var cx,cy,rx,ry,d: single; - xb,yb: integer; - p: PBGRAPixel; - h: integer; - mask: TGrayscaleMask; -begin - result := TBGRABitmap.Create(width,height); - cx := (width-1)/2; - cy := (height-1)/2; - rx := (width-1)/2; - ry := (height-1)/2; - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - d := sqr((xb-cx)/(rx+1))+sqr((yb-cy)/(ry+1)); - if d >= 1 then - p^ := BGRAPixelTransparent else - begin - h := round(sqrt(1-d)*255); - p^.red := h; - p^.green := h; - p^.blue := h; - p^.alpha := 255; - end; - inc(p); - end; - end; - //antialiased border - mask := TGrayscaleMask.Create(width,height,BGRABlack); - mask.FillEllipseAntialias(cx,cy,rx,ry,BGRAWhite); - result.ApplyMask(mask); - mask.Free; -end; - -procedure MapBorderLimit(width,height: integer; options: TRectangleMapOptions; var border: integer); -var maxHoriz,maxVert: integer; -begin - if [rmoNoLeftBorder,rmoNoRightBorder] <= options then maxHoriz := border else - if [rmoNoLeftBorder,rmoNoRightBorder] * options = [] then maxHoriz := width div 2 else - maxHoriz := width; - if border > maxHoriz then border := maxHoriz; - - if [rmoNoTopBorder,rmoNoBottomBorder] <= options then maxVert := border else - if [rmoNoTopBorder,rmoNoBottomBorder] * options = [] then maxVert := height div 2 else - maxVert := height; - if border > maxVert then border := maxVert; -end; - -procedure MapBorderLimit(width,height: integer; options: TRectangleMapOptions; var borderHoriz,borderVert: integer); -var maxHoriz,maxVert: integer; -begin - if [rmoNoLeftBorder,rmoNoRightBorder] <= options then maxHoriz := borderHoriz else - if [rmoNoLeftBorder,rmoNoRightBorder] * options = [] then maxHoriz := width div 2 else - maxHoriz := width; - if borderHoriz > maxHoriz then borderHoriz := maxHoriz; - - if [rmoNoTopBorder,rmoNoBottomBorder] <= options then maxVert := borderVert else - if [rmoNoTopBorder,rmoNoBottomBorder] * options = [] then maxVert := height div 2 else - maxVert := height; - if borderVert > maxVert then borderVert := maxVert; -end; - -function CreateSpherePreciseMap(width, height: integer): TBGRABitmap; -var cx,cy,rx,ry,d: single; - xb,yb: integer; - p: PBGRAPixel; - mask: TGrayscaleMask; -begin - result := TBGRABitmap.Create(width,height); - cx := (width-1)/2; - cy := (height-1)/2; - rx := (width-1)/2; - ry := (height-1)/2; - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - d := sqr((xb-cx)/(rx+1))+sqr((yb-cy)/(ry+1)); - if d >= 1 then - p^ := BGRAPixelTransparent else - p^ := MapHeightToBGRA(sqrt(1-d),255); - inc(p); - end; - end; - //antialiased border - mask := TGrayscaleMask.Create(width,height,BGRABlack); - mask.FillEllipseAntialias(cx,cy,rx,ry,BGRAWhite); - result.ApplyMask(mask); - mask.Free; -end; - -procedure RectangleMapRemoveCorners(dest: TBGRABitmap; options: TRectangleMapOptions); -begin - if [rmoNoLeftBorder,rmoNoTopBorder]*Options = [] then - begin - dest.SetPixel(0,0,BGRAPixelTransparent); - dest.ErasePixel(1,0,128); - dest.ErasePixel(0,1,128); - end; - - if [rmoNoRightBorder,rmoNoTopBorder]*Options = [] then - begin - dest.SetPixel(dest.width-1,0,BGRAPixelTransparent); - dest.ErasePixel(dest.width-2,0,128); - dest.ErasePixel(dest.width-1,1,128); - end; - - if [rmoNoRightBorder,rmoNoBottomBorder]*Options = [] then - begin - dest.SetPixel(dest.width-1,dest.height-1,BGRAPixelTransparent); - dest.ErasePixel(dest.width-2,dest.height-1,128); - dest.ErasePixel(dest.width-1,dest.height-2,128); - end; - - if [rmoNoLeftBorder,rmoNoBottomBorder]*Options = [] then - begin - dest.SetPixel(0,dest.height-1,BGRAPixelTransparent); - dest.ErasePixel(1,dest.height-1,128); - dest.ErasePixel(0,dest.height-2,128); - end; -end; - -function CreateRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; -var xb,yb: integer; - p: PBGRAPixel; - h: integer; -begin - MapBorderLimit(width,height,options,border); - - result := TBGRABitmap.Create(width,height); - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - if not (rmoNoLeftBorder in options) and (xb < border) and (yb > xb) and (yb < height-1-xb) then h := xb else - if not (rmoNoRightBorder in options) and (xb > width-1-border) and (yb > width-1-xb) and (yb < height-1-(width-1-xb)) then h := width-1-xb else - if not (rmoNoTopBorder in options) and (yb < border) and (xb > yb) and (xb < width-1-yb) then h := yb else - if not (rmoNoBottomBorder in options) and (yb > height-1-border) and (xb > height-1-yb) and (xb < width-1-(height-1-yb)) then h := height-1-yb else - if not (rmoNoLeftBorder in options) and (xb < border) then h := xb else - if not (rmoNoRightBorder in options) and (xb > width-1-border) then h := width-1-xb else - if not (rmoNoTopBorder in options) and (yb < border) then h := yb else - if not (rmoNoBottomBorder in options) and (yb > height-1-border) then h := height-1-yb else - begin - p^ := BGRAWhite; - inc(p); - Continue; - end; - - if rmoLinearBorder in options then h := h*256 div border else - h := round(sin((h+1/2)/border*Pi/2)*255); - p^.red := h; - p^.green := h; - p^.blue := h; - p^.alpha := 255; - inc(p); - end; - end; - - RectangleMapRemoveCorners(result,options); -end; - -function CreateRectanglePreciseMap(width, height, border: integer; - options: TRectangleMapOptions): TBGRABitmap; -var xb,yb: integer; - p: PBGRAPixel; - h: single; -begin - MapBorderLimit(width,height,options,border); - - result := TBGRABitmap.Create(width,height); - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - if not (rmoNoLeftBorder in options) and (xb < border) and (yb > xb) and (yb < height-1-xb) then h := xb else - if not (rmoNoRightBorder in options) and (xb > width-1-border) and (yb > width-1-xb) and (yb < height-1-(width-1-xb)) then h := width-1-xb else - if not (rmoNoTopBorder in options) and (yb < border) and (xb > yb) and (xb < width-1-yb) then h := yb else - if not (rmoNoBottomBorder in options) and (yb > height-1-border) and (xb > height-1-yb) and (xb < width-1-(height-1-yb)) then h := height-1-yb else - if not (rmoNoLeftBorder in options) and (xb < border) then h := xb else - if not (rmoNoRightBorder in options) and (xb > width-1-border) then h := width-1-xb else - if not (rmoNoTopBorder in options) and (yb < border) then h := yb else - if not (rmoNoBottomBorder in options) and (yb > height-1-border) then h := height-1-yb else - begin - p^ := BGRAWhite; - inc(p); - Continue; - end; - - if rmoLinearBorder in options then h := h/border else - h := sin((h+1/2)/border*Pi/2); - - p^ := MapHeightToBGRA(h,255); - - inc(p); - end; - end; - - RectangleMapRemoveCorners(result,options); -end; - -function CreateRectanglePreciseMap(width, height, borderWidth, borderHeight: integer; - options: TRectangleMapOptions): TBGRABitmap; -var xb,yb, minBorder: integer; - p: PBGRAPixel; - h: single; - smallStep: single; -begin - MapBorderLimit(width,height,options,borderWidth,borderHeight); - - minBorder := min(borderWidth,borderHeight); - if minBorder > 0 then smallStep := 1/minBorder else smallStep:= 0; - - result := TBGRABitmap.Create(width,height); - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - if not (rmoNoLeftBorder in options) and (xb < borderWidth) and (yb < borderHeight) then - h := min(xb/borderWidth, yb/borderHeight) else - if not (rmoNoRightBorder in options) and (xb > width-1-borderWidth) and (yb < borderHeight) then - h := min((width-1-xb)/borderWidth, yb/borderHeight) else - if not (rmoNoTopBorder in options) and (xb < borderWidth) and (yb > height-1-borderHeight) then - h := min(xb/borderWidth, (height-1-yb)/borderHeight) else - if not (rmoNoBottomBorder in options) and (xb > width-1-borderWidth) and (yb > height-1-borderHeight) then - h := min((width-1-xb)/borderWidth, (height-1-yb)/borderHeight) else - if not (rmoNoLeftBorder in options) and (xb < borderWidth) then h := xb/borderWidth else - if not (rmoNoRightBorder in options) and (xb > width-1-borderWidth) then h := (width-1-xb)/borderWidth else - if not (rmoNoTopBorder in options) and (yb < borderHeight) then h := yb/borderHeight else - if not (rmoNoBottomBorder in options) and (yb > height-1-borderHeight) then h := (height-1-yb)/borderHeight else - begin - p^ := BGRAWhite; - inc(p); - Continue; - end; - - if not (rmoLinearBorder in options) then - h := sin((h+smallStep*0.5)*Pi*0.5); - - p^ := MapHeightToBGRA(h,255); - - inc(p); - end; - end; - - RectangleMapRemoveCorners(result,options); -end; - -function CreateRoundRectangleMap(width,height,border: integer; options: TRectangleMapOptions = []): TBGRABitmap; -var d: single; - xb,yb: integer; - p: PBGRAPixel; - h: integer; -begin - MapBorderLimit(width,height,options,border); - - result := TBGRABitmap.Create(width,height); - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - if not (rmoNoLeftBorder in options) and not (rmoNoTopBorder in options) and (xb < border) and (yb < border) then d := border-sqrt(sqr(border-xb)+sqr(border-yb)) else - if not (rmoNoLeftBorder in options) and not (rmoNoBottomBorder in options) and (xb < border) and (yb > height-1-border) then d := border-sqrt(sqr(border-xb)+sqr(border-(height-1-yb))) else - if not (rmoNoRightBorder in options) and not (rmoNoTopBorder in options) and (xb > width-1-border) and (yb < border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-yb)) else - if not (rmoNoRightBorder in options) and not (rmoNoBottomBorder in options) and (xb > width-1-border) and (yb > height-1-border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-(height-1-yb))) else - if not (rmoNoLeftBorder in options) and (xb < border) then d := xb else - if not (rmoNoRightBorder in options) and (xb > width-1-border) then d := width-1-xb else - if not (rmoNoTopBorder in options) and (yb < border) then d := yb else - if not (rmoNoBottomBorder in options) and (yb > height-1-border) then d := height-1-yb else - begin - p^ := BGRAWhite; - inc(p); - Continue; - end; - - d := (d+1)*border/(border+1); - - if d < 0 then - p^ := BGRAPixelTransparent else - begin - if rmoLinearBorder in options then h := trunc(d*256/border) else - h := round(sin((d+1/2)/border*Pi/2)*255); - - p^.red := h; - p^.green := h; - p^.blue := h; - if d < 1 then p^.alpha := round(d*255) else - p^.alpha := 255; - end; - inc(p); - end; - end; -end; - -function CreatePerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single; - VerticalPeriod: Single; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; - - procedure AddNoise(frequencyH, frequencyV: integer; amplitude: byte; dest: TBGRABitmap); - var small,resampled: TBGRABitmap; - p: PBGRAPixel; - i: Integer; - begin - if (frequencyH = 0) or (frequencyV = 0) then exit; - small := TBGRABitmap.Create(frequencyH,frequencyV); - p := small.data; - for i := 0 to small.NbPixels-1 do - begin - p^.red := random(amplitude); - p^.green := p^.red; - p^.blue := p^.green; - p^.alpha := 255; - inc(p); - end; - small.ResampleFilter := ResampleFilter; - resampled := small.Resample(dest.Width,dest.Height); - dest.BlendImage(0,0,resampled,boAdditive); - resampled.Free; - small.Free; - end; - -var - i: Integer; - temp: TBGRABitmap; - -begin - result := TBGRABitmap.Create(AWidth,AHeight); - for i := 0 to 5 do - AddNoise(round(AWidth / HorizontalPeriod / (32 shr i)),round(AHeight / VerticalPeriod / (32 shr i)), round(exp(ln((128 shr i)/128)*Exponent)*128),result); - - temp := result.FilterNormalize(False); - result.Free; - result := temp; - - temp := result.FilterBlurRadial(1,rbNormal); - result.Free; - result := temp; -end; - -function CreateCyclicPerlinNoiseMap(AWidth, AHeight: integer; HorizontalPeriod: Single = 1; - VerticalPeriod: Single = 1; Exponent: Double = 1; ResampleFilter: TResampleFilter = rfCosine): TBGRABitmap; - - procedure AddNoise(frequencyH, frequencyV: integer; amplitude: byte; dest: TBGRABitmap); - var small,cycled,resampled: TBGRABitmap; - p: PBGRAPixel; - i: Integer; - x, y: Int64; - begin - if (frequencyH = 0) or (frequencyV = 0) then exit; - small := TBGRABitmap.Create(frequencyH,frequencyV); - p := small.data; - for i := 0 to small.NbPixels-1 do - begin - p^.red := random(amplitude); - p^.green := p^.red; - p^.blue := p^.green; - p^.alpha := 255; - inc(p); - end; - cycled := small.GetPart(rect(-2,-2,small.Width+2,small.Height+2)); - cycled.ResampleFilter := ResampleFilter; - resampled := cycled.Resample(round((cycled.Width-1)*(dest.Width/frequencyH)),round((cycled.Height-1)*(dest.Height/frequencyV))); - x := round(-2*(dest.Width/frequencyH)); - y := round(-2*(dest.Height/frequencyV)); - dest.BlendImage(x,y,resampled,boAdditive); - resampled.Free; - cycled.Free; - small.Free; - end; - -var - i: Integer; - temp: TBGRABitmap; - -begin - result := TBGRABitmap.Create(AWidth,AHeight); - for i := 0 to 5 do - AddNoise(round(AWidth / HorizontalPeriod / (32 shr i)),round(AHeight / VerticalPeriod / (32 shr i)), round(exp(ln((128 shr i)/128)*Exponent)*128),result); - - temp := result.FilterNormalize(False); - result.Free; - result := temp; - - temp := result.FilterBlurRadial(1,rbNormal); - result.Free; - result := temp; -end; - -function CreateRoundRectanglePreciseMap(width, height, border: integer; - options: TRectangleMapOptions): TBGRABitmap; -var d: single; - xb,yb: integer; - p: PBGRAPixel; - h: single; -begin - MapBorderLimit(width,height,options,border); - - result := TBGRABitmap.Create(width,height); - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - if not (rmoNoLeftBorder in options) and not (rmoNoTopBorder in options) and (xb < border) and (yb < border) then d := border-sqrt(sqr(border-xb)+sqr(border-yb)) else - if not (rmoNoLeftBorder in options) and not (rmoNoBottomBorder in options) and (xb < border) and (yb > height-1-border) then d := border-sqrt(sqr(border-xb)+sqr(border-(height-1-yb))) else - if not (rmoNoRightBorder in options) and not (rmoNoTopBorder in options) and (xb > width-1-border) and (yb < border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-yb)) else - if not (rmoNoRightBorder in options) and not (rmoNoBottomBorder in options) and (xb > width-1-border) and (yb > height-1-border) then d := border-sqrt(sqr(border-(width-1-xb))+sqr(border-(height-1-yb))) else - if not (rmoNoLeftBorder in options) and (xb < border) then d := xb else - if not (rmoNoRightBorder in options) and (xb > width-1-border) then d := width-1-xb else - if not (rmoNoTopBorder in options) and (yb < border) then d := yb else - if not (rmoNoBottomBorder in options) and (yb > height-1-border) then d := height-1-yb else - begin - p^ := BGRAWhite; - inc(p); - Continue; - end; - - d := (d+1)*border/(border+1); - - if d < 0 then - p^ := BGRAPixelTransparent else - begin - if rmoLinearBorder in options then h := d/border else - h := sin((d+1/2)/border*Pi/2); - - if d < 1 then p^:= MapHeightToBGRA(h,round(d*255)) else - p^ := MapHeightToBGRA(h,255); - end; - inc(p); - end; - end; -end; - -function CreateRoundRectanglePreciseMap(width, height, borderWidth, - borderHeight: integer; options: TRectangleMapOptions): TBGRABitmap; -var d: single; - xb,yb: integer; - p: PBGRAPixel; - h,smallStep,factor: single; - minBorder: integer; -begin - MapBorderLimit(width,height,options,borderWidth,borderHeight); - - minBorder := min(borderWidth,borderHeight); - if minBorder > 0 then smallStep := 1/minBorder else smallStep:= 0; - factor := minBorder/(minBorder+1); - result := TBGRABitmap.Create(width,height); - for yb := 0 to height-1 do - begin - p := result.scanline[yb]; - for xb := 0 to width-1 do - begin - if not (rmoNoLeftBorder in options) and not (rmoNoTopBorder in options) and (xb < borderWidth) and (yb < borderHeight) then - d := 1-sqrt(sqr((borderWidth-xb)/borderWidth)+sqr((borderHeight-yb)/borderHeight)) else - if not (rmoNoLeftBorder in options) and not (rmoNoBottomBorder in options) and (xb < borderWidth) and (yb > height-1-borderHeight) then - d := 1-sqrt(sqr((borderWidth-xb)/borderWidth)+sqr((borderHeight-(height-1-yb))/borderHeight)) else - if not (rmoNoRightBorder in options) and not (rmoNoTopBorder in options) and (xb > width-1-borderWidth) and (yb < borderHeight) then - d := 1-sqrt(sqr((borderWidth-(width-1-xb))/borderWidth)+sqr((borderHeight-yb)/borderHeight)) else - if not (rmoNoRightBorder in options) and not (rmoNoBottomBorder in options) and (xb > width-1-borderWidth) and (yb > height-1-borderHeight) then - d := 1-sqrt(sqr((borderWidth-(width-1-xb))/borderWidth)+sqr((borderHeight-(height-1-yb))/borderHeight)) else - if not (rmoNoLeftBorder in options) and (xb < borderWidth) then d := xb/borderWidth else - if not (rmoNoRightBorder in options) and (xb > width-1-borderWidth) then d := (width-1-xb)/borderWidth else - if not (rmoNoTopBorder in options) and (yb < borderHeight) then d := yb/borderHeight else - if not (rmoNoBottomBorder in options) and (yb > height-1-borderHeight) then d := (height-1-yb)/borderHeight else - begin - p^ := BGRAWhite; - inc(p); - Continue; - end; - - d := (d + smallStep)*factor; - - if d < 0 then - p^ := BGRAPixelTransparent else - begin - if rmoLinearBorder in options then h := d else - h := sin((d+smallStep*0.5)*Pi*0.5); - - if d < smallStep then p^:= MapHeightToBGRA(h,round(d/smallStep*255)) else - p^ := MapHeightToBGRA(h,255); - end; - inc(p); - end; - end; -end; - -initialization - - Randomize; - -end. - diff --git a/components/bgrabitmap/bgragradientscanner.pas b/components/bgrabitmap/bgragradientscanner.pas deleted file mode 100644 index 31bbdd4..0000000 --- a/components/bgrabitmap/bgragradientscanner.pas +++ /dev/null @@ -1,2192 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAGradientScanner; - -{$mode objfpc}{$H+} - -interface - -{ This unit contains scanners that generate gradients } - -uses - SysUtils, BGRABitmapTypes, BGRATransform; - -type - TBGRAColorInterpolation = (ciStdRGB, ciLinearRGB, ciLinearHSLPositive, ciLinearHSLNegative, ciGSBPositive, ciGSBNegative); - TBGRAGradientRepetition = (grPad, grRepeat, grReflect, grSine); - - { TBGRASimpleGradient } - - TBGRASimpleGradient = class(TBGRACustomGradient) - protected - FColor1,FColor2: TBGRAPixel; - ec1,ec2: TExpandedPixel; - FRepetition: TBGRAGradientRepetition; - function InterpolateToBGRA(position: word): TBGRAPixel; virtual; abstract; - function InterpolateToExpanded(position: word): TExpandedPixel; virtual; abstract; - public - class function CreateAny(AInterpolation: TBGRAColorInterpolation; AColor1,AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; overload; static; - class function CreateAny(AInterpolation: TBGRAColorInterpolation; AColor1,AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; overload; static; - constructor Create(AColor1,AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); overload; //do not call directly - constructor Create(AColor1,AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition); overload; //do not call directly - function GetColorAt(position: integer): TBGRAPixel; override; - function GetColorAtF(position: single): TBGRAPixel; override; - function GetExpandedColorAt(position: integer): TExpandedPixel; override; - function GetExpandedColorAtF(position: single): TExpandedPixel; override; - function GetAverageColor: TBGRAPixel; override; - function GetAverageExpandedColor: TExpandedPixel; override; - function GetMonochrome: boolean; override; - property Repetition: TBGRAGradientRepetition read FRepetition write FRepetition; - end; - - { TBGRASimpleGradientWithoutGammaCorrection } - - TBGRASimpleGradientWithoutGammaCorrection = class(TBGRASimpleGradient) - protected - function InterpolateToBGRA(position: word): TBGRAPixel; override; - function InterpolateToExpanded(position: word): TExpandedPixel; override; - public - constructor Create(Color1,Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; - constructor Create(Color1,Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; - end; - - { TBGRASimpleGradientWithGammaCorrection } - - TBGRASimpleGradientWithGammaCorrection = class(TBGRASimpleGradient) - protected - function InterpolateToBGRA(position: word): TBGRAPixel; override; - function InterpolateToExpanded(position: word): TExpandedPixel; override; - public - constructor Create(Color1,Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; - constructor Create(Color1,Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition = grPad); overload; - end; - - THueGradientOption = (hgoRepeat, hgoReflect, //repetition - hgoPositiveDirection, hgoNegativeDirection, //hue orientation - hgoHueCorrection, hgoLightnessCorrection); //color interpolation - THueGradientOptions = set of THueGradientOption; - - { TBGRAHueGradient } - - TBGRAHueGradient = class(TBGRASimpleGradient) - private - hsla1,hsla2: THSLAPixel; - hue1,hue2: LongWord; - FOptions: THueGradientOptions; - procedure Init(c1,c2: THSLAPixel; AOptions: THueGradientOptions); - function InterpolateToHSLA(position: word): THSLAPixel; - protected - function InterpolateToBGRA(position: word): TBGRAPixel; override; - function InterpolateToExpanded(position: word): TExpandedPixel; override; - public - constructor Create(Color1,Color2: TBGRAPixel; options: THueGradientOptions); overload; - constructor Create(Color1,Color2: TExpandedPixel; options: THueGradientOptions); overload; - constructor Create(Color1,Color2: THSLAPixel; options: THueGradientOptions); overload; - constructor Create(AHue1,AHue2: Word; Saturation,Lightness: Word; options: THueGradientOptions); overload; - function GetMonochrome: boolean; override; - end; - - TGradientInterpolationFunction = function(t: single): single of object; - - { TBGRAMultiGradient } - - TBGRAMultiGradient = class(TBGRACustomGradient) - private - FColors: array of TBGRAPixel; - FPositions: array of integer; - FPositionsF: array of single; - FEColors: array of TExpandedPixel; - FCycle: Boolean; - FInterpolationFunction: TGradientInterpolationFunction; - procedure Init(Colors: array of TBGRAPixel; Positions0To1: array of single; AGammaCorrection, ACycle: boolean); - public - GammaCorrection: boolean; - function CosineInterpolation(t: single): single; - function HalfCosineInterpolation(t: single): single; - constructor Create(Colors: array of TBGRAPixel; Positions0To1: array of single; AGammaCorrection: boolean; ACycle: boolean = false); - function GetColorAt(position: integer): TBGRAPixel; override; - function GetExpandedColorAt(position: integer): TExpandedPixel; override; - function GetAverageColor: TBGRAPixel; override; - function GetMonochrome: boolean; override; - property InterpolationFunction: TGradientInterpolationFunction read FInterpolationFunction write FInterpolationFunction; - end; - - { TBGRABufferedGradient } - - TBGRABufferedGradient = class(TBGRACustomGradient) - protected - FGradient: TBGRACustomGradient; - FGradientOwned: boolean; - FPadded: boolean; - FAverageColorComputed: boolean; - FAverageColorExpanded: TExpandedPixel; - FMonochromeComputed: boolean; - FMonochrome: boolean; - FBufferSize, FBufferShift: integer; - FColorTab: array of TBGRAPixel; - FColorComputed: bitpacked array[0..65535] of boolean; - FRepetition: TBGRAGradientRepetition; - public - constructor Create(AGradient: TBGRACustomGradient; AOwner: boolean; APadded: boolean; - ABufferSize: integer); - destructor Destroy; override; - {** Returns the color at a given ''position''. The reference range is - from 0 to 65535, however values beyond are possible as well } - function GetColorAt(position: integer): TBGRAPixel; override; - {** Returns the average color of the gradient } - function GetAverageColor: TBGRAPixel; override; - function GetAverageExpandedColor: TExpandedPixel; override; - function GetMonochrome: boolean; override; - end; - - TBGRAGradientScannerInternalScanNextFunc = function():single of object; - TBGRAGradientScannerInternalScanAtFunc = function(const p: TPointF):single of object; - - { TBGRAGradientScanner } - - TBGRAGradientScanner = class(TBGRACustomScanner) - protected - FGradientType: TGradientType; - FOrigin,FDir1,FDir2: TPointF; - FRelativeFocal: TPointF; - FRadius, FFocalRadius: single; - FTransform, FHiddenTransform: TAffineMatrix; - FSinus: Boolean; - FGradient: TBGRACustomGradient; - FGradientOwner: boolean; - FFlipGradient: boolean; - - FMatrix: TAffineMatrix; - FRepeatHoriz, FIsAverage: boolean; - FAverageColor: TBGRAPixel; - FAverageExpandedColor: TExpandedPixel; - FScanNextFunc: TBGRAGradientScannerInternalScanNextFunc; - FScanAtFunc: TBGRAGradientScannerInternalScanAtFunc; - FGetGradientColor: TBGRAGradientGetColorAtFloatFunc; - FGetGradientExpandedColor: TBGRAGradientGetExpandedColorAtFloatFunc; - FFocalDistance: single; - FFocalDirection, FFocalNormal: TPointF; - FRadialDenominator, FRadialDeltaSign, maxW1, maxW2: single; - - FPosition: TPointF; - FHorizColor: TBGRAPixel; - FHorizExpandedColor: TExpandedPixel; - - procedure Init(AGradientType: TGradientType; AOrigin, d1: TPointF; ATransform: TAffineMatrix; Sinus: Boolean=False); overload; - procedure Init(AGradientType: TGradientType; AOrigin, d1, d2: TPointF; ATransform: TAffineMatrix; Sinus: Boolean=False); overload; - procedure Init(AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single; ATransform: TAffineMatrix; AHiddenTransform: TAffineMatrix); overload; - - procedure InitGradientType; - procedure InitTransform; - procedure InitGradient; - - function ComputeRadialFocal(const p: TPointF): single; - - function ScanNextLinear: single; - function ScanNextReflected: single; - function ScanNextDiamond: single; - function ScanNextRadial: single; - function ScanNextRadial2: single; - function ScanNextRadialFocal: single; - function ScanNextAngular: single; - - function ScanAtLinear(const p: TPointF): single; - function ScanAtReflected(const p: TPointF): single; - function ScanAtDiamond(const p: TPointF): single; - function ScanAtRadial(const p: TPointF): single; - function ScanAtRadial2(const p: TPointF): single; - function ScanAtRadialFocal(const p: TPointF): single; - function ScanAtAngular(const p: TPointF): single; - - function ScanNextInline: TBGRAPixel; inline; - function ScanNextExpandedInline: TExpandedPixel; inline; - procedure SetTransform(AValue: TAffineMatrix); - procedure SetFlipGradient(AValue: boolean); - procedure SetSinus(AValue: boolean); - function GetGradientColor(a: single): TBGRAPixel; - function GetGradientExpandedColor(a: single): TExpandedPixel; - function GetGradientColorFlipped(a: single): TBGRAPixel; - function GetGradientExpandedColorFlipped(a: single): TExpandedPixel; - function GetGradientColorSinus(a: single): TBGRAPixel; - function GetGradientExpandedColorSinus(a: single): TExpandedPixel; - procedure UpdateGetGradientColorFunctions; - public - constructor Create(AGradientType: TGradientType; AOrigin, d1: TPointF); overload; - constructor Create(AGradientType: TGradientType; AOrigin, d1, d2: TPointF); overload; - constructor Create(AOrigin, d1, d2, AFocal: TPointF; ARadiusRatio: single = 1; AFocalRadiusRatio: single = 0); overload; - constructor Create(AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single); overload; - - constructor Create(c1, c2: TBGRAPixel; AGradientType: TGradientType; AOrigin, d1: TPointF; - gammaColorCorrection: boolean = True; Sinus: Boolean=False); overload; - constructor Create(c1, c2: TBGRAPixel; AGradientType: TGradientType; AOrigin, d1, d2: TPointF; - gammaColorCorrection: boolean = True; Sinus: Boolean=False); overload; - - constructor Create(gradient: TBGRACustomGradient; AGradientType: TGradientType; AOrigin, d1: TPointF; - Sinus: Boolean=False; AGradientOwner: Boolean=False); overload; - constructor Create(gradient: TBGRACustomGradient; AGradientType: TGradientType; AOrigin, d1, d2: TPointF; - Sinus: Boolean=False; AGradientOwner: Boolean=False); overload; - constructor Create(gradient: TBGRACustomGradient; AOrigin: TPointF; ARadius: single; AFocal: TPointF; - AFocalRadius: single; AGradientOwner: Boolean=False); overload; - - procedure SetGradient(c1,c2: TBGRAPixel; AGammaCorrection: boolean = true); overload; - procedure SetGradient(AGradient: TBGRACustomGradient; AOwner: boolean); overload; - destructor Destroy; override; - procedure ScanMoveTo(X, Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - function ScanNextExpandedPixel: TExpandedPixel; override; - function ScanAt(X, Y: Single): TBGRAPixel; override; - function ScanAtExpanded(X, Y: Single): TExpandedPixel; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - procedure ScanSkipPixels(ACount: integer); override; - function IsScanPutPixelsDefined: boolean; override; - property Transform: TAffineMatrix read FTransform write SetTransform; - property Gradient: TBGRACustomGradient read FGradient; - property FlipGradient: boolean read FFlipGradient write SetFlipGradient; - property Sinus: boolean Read FSinus write SetSinus; - end; - - { TBGRAConstantScanner } - - TBGRAConstantScanner = class(TBGRAGradientScanner) - constructor Create(c: TBGRAPixel); - end; - - { TBGRARandomScanner } - - TBGRARandomScanner = class(TBGRACustomScanner) - private - FOpacity: byte; - FGrayscale: boolean; - FRandomBuffer, FRandomBufferCount: integer; - public - constructor Create(AGrayscale: Boolean; AOpacity: byte); - function ScanAtInteger({%H-}X, {%H-}Y: integer): TBGRAPixel; override; - function ScanNextPixel: TBGRAPixel; override; - function ScanAt({%H-}X, {%H-}Y: Single): TBGRAPixel; override; - end; - - { TBGRAGradientTriangleScanner } - - TBGRAGradientTriangleScanner= class(TBGRACustomScanner) - protected - FMatrix: TAffineMatrix; - FColor1,FDiff2,FDiff3,FStep: TColorF; - FCurColor: TColorF; - public - constructor Create(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); - procedure ScanMoveTo(X,Y: Integer); override; - procedure ScanMoveToF(X,Y: Single); - function ScanAt(X,Y: Single): TBGRAPixel; override; - function ScanNextPixel: TBGRAPixel; override; - function ScanNextExpandedPixel: TExpandedPixel; override; - procedure ScanSkipPixels(ACount: integer); override; - end; - - { TBGRASolidColorMaskScanner } - - TBGRASolidColorMaskScanner = class(TBGRACustomScanner) - private - FOffset: TPoint; - FMask: IBGRAScanner; - FSolidColor: TBGRAPixel; - public - constructor Create(AMask: IBGRAScanner; AOffset: TPoint; ASolidColor: TBGRAPixel); - destructor Destroy; override; - function IsScanPutPixelsDefined: boolean; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - procedure ScanSkipPixels(ACount: integer); override; - procedure ScanMoveTo(X,Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - function ScanAt(X,Y: Single): TBGRAPixel; override; - property Color: TBGRAPixel read FSolidColor write FSolidColor; - end; - - { TBGRATextureMaskScanner } - - TBGRATextureMaskScanner = class(TBGRACustomScanner) - private - FOffset: TPoint; - FMask: IBGRAScanner; - FTexture: IBGRAScanner; - FTextureScanNext : TScanNextPixelFunction; - FTextureScanAt : TScanAtFunction; - FGlobalOpacity: Byte; - FMemTex: packed array of TBGRAPixel; - public - constructor Create(AMask: IBGRAScanner; AOffset: TPoint; ATexture: IBGRAScanner; AGlobalOpacity: Byte = 255); - destructor Destroy; override; - function IsScanPutPixelsDefined: boolean; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - procedure ScanSkipPixels(ACount: integer); override; - procedure ScanMoveTo(X,Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - function ScanAt(X,Y: Single): TBGRAPixel; override; - end; - - { TBGRAOpacityScanner } - - TBGRAOpacityScanner = class(TBGRACustomScanner) - private - FTexture: IBGRAScanner; - FOwnedScanner: TBGRACustomScanner; - FGlobalOpacity: Byte; - FScanNext : TScanNextPixelFunction; - FScanAt : TScanAtFunction; - FMemTex: packed array of TBGRAPixel; - public - constructor Create(ATexture: IBGRAScanner; AGlobalOpacity: Byte = 255); - constructor Create(ATexture: TBGRACustomScanner; AGlobalOpacity: Byte; AOwned: boolean); - destructor Destroy; override; - function IsScanPutPixelsDefined: boolean; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - procedure ScanSkipPixels(ACount: integer); override; - procedure ScanMoveTo(X,Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - function ScanAt(X,Y: Single): TBGRAPixel; override; - end; - -implementation - -uses BGRABlend, Math; - -{ TBGRABufferedGradient } - -constructor TBGRABufferedGradient.Create(AGradient: TBGRACustomGradient; - AOwner: boolean; APadded: boolean; ABufferSize: integer); -var - bufferPowSize: integer; -begin - FGradient := AGradient; - FGradientOwned:= AOwner; - FPadded := APadded; - bufferPowSize := 0; - while ABufferSize > 1 do - begin - ABufferSize := ABufferSize shr 1; - inc(bufferPowSize); - end; - if bufferPowSize > 16 then bufferPowSize := 16; - FBufferSize:= 1 shl bufferPowSize; - setlength(FColorTab, FBufferSize); - FBufferShift := 16-bufferPowSize; -end; - -destructor TBGRABufferedGradient.Destroy; -begin - if FGradientOwned then FGradient.Free; - inherited Destroy; -end; - -function TBGRABufferedGradient.GetColorAt(position: integer): TBGRAPixel; -var - posBuf: Integer; -begin - if FPadded then - begin - if position < 0 then - position := 0 else - if position >= 65536 then - position := 65536; - posBuf := position shr FBufferShift; - if posBuf > FBufferSize shr 1 then dec(posBuf); - end else - begin - position := position and 131071; - posBuf := position shr (FBufferShift+1); - end; - - if not FColorComputed[posBuf] then - begin - result := FGradient.GetColorAt(position); - FColorTab[posBuf] := result; - FColorComputed[posBuf] := true; - end else - result := FColorTab[posBuf]; -end; - -function TBGRABufferedGradient.GetAverageColor: TBGRAPixel; -begin - result := GammaCompression(GetAverageExpandedColor); -end; - -function TBGRABufferedGradient.GetAverageExpandedColor: TExpandedPixel; -begin - if not FAverageColorComputed then - begin - FAverageColorExpanded := FGradient.GetAverageExpandedColor; - FAverageColorComputed := true; - end; - result := FAverageColorExpanded; -end; - -function TBGRABufferedGradient.GetMonochrome: boolean; -begin - if not FMonochromeComputed then - begin - FMonochrome:= FGradient.Monochrome; - FMonochromeComputed:= true; - end; - result := FMonochrome; -end; - -{ TBGRASimpleGradient } - -constructor TBGRASimpleGradient.Create(AColor1, AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); -begin - FColor1 := AColor1; - FColor2 := AColor2; - ec1 := GammaExpansion(AColor1); - ec2 := GammaExpansion(AColor2); - FRepetition:= ARepetition; -end; - -constructor TBGRASimpleGradient.Create(AColor1, AColor2: TExpandedPixel; - ARepetition: TBGRAGradientRepetition); -begin - FColor1 := GammaCompression(AColor1); - FColor2 := GammaCompression(AColor2); - ec1 := AColor1; - ec2 := AColor2; - FRepetition:= ARepetition; -end; - -class function TBGRASimpleGradient.CreateAny(AInterpolation: TBGRAColorInterpolation; - AColor1, AColor2: TBGRAPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; -begin - case AInterpolation of - ciStdRGB: result := TBGRASimpleGradientWithoutGammaCorrection.Create(AColor1,AColor2); - ciLinearRGB: result := TBGRASimpleGradientWithGammaCorrection.Create(AColor1,AColor2); - ciLinearHSLPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection]); - ciLinearHSLNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection]); - ciGSBPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection, hgoHueCorrection, hgoLightnessCorrection]); - ciGSBNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection, hgoHueCorrection, hgoLightnessCorrection]); - end; - result.Repetition := ARepetition; -end; - -class function TBGRASimpleGradient.CreateAny(AInterpolation: TBGRAColorInterpolation; - AColor1, AColor2: TExpandedPixel; ARepetition: TBGRAGradientRepetition): TBGRASimpleGradient; -begin - case AInterpolation of - ciStdRGB: result := TBGRASimpleGradientWithoutGammaCorrection.Create(AColor1,AColor2); - ciLinearRGB: result := TBGRASimpleGradientWithGammaCorrection.Create(AColor1,AColor2); - ciLinearHSLPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection]); - ciLinearHSLNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection]); - ciGSBPositive: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoPositiveDirection, hgoHueCorrection, hgoLightnessCorrection]); - ciGSBNegative: result := TBGRAHueGradient.Create(AColor1,AColor2,[hgoNegativeDirection, hgoHueCorrection, hgoLightnessCorrection]); - end; - result.Repetition := ARepetition; -end; - -function TBGRASimpleGradient.GetAverageColor: TBGRAPixel; -begin - result := InterpolateToBGRA(32768); -end; - -function TBGRASimpleGradient.GetAverageExpandedColor: TExpandedPixel; -begin - Result:= InterpolateToExpanded(32768); -end; - -function TBGRASimpleGradient.GetColorAt(position: integer): TBGRAPixel; -begin - case FRepetition of - grSine: begin - position := Sin65536(position and $ffff); - if position = 65536 then - result := FColor2 - else - result := InterpolateToBGRA(position); - end; - grRepeat: result := InterpolateToBGRA(position and $ffff); - grReflect: - begin - position := position and $1ffff; - if position >= $10000 then - begin - if position = $10000 then - result := FColor2 - else - result := InterpolateToBGRA($20000 - position); - end - else - result := InterpolateToBGRA(position); - end; - else - begin - if position <= 0 then - result := FColor1 else - if position >= 65536 then - result := FColor2 else - result := InterpolateToBGRA(position); - end; - end; -end; - -function TBGRASimpleGradient.GetColorAtF(position: single): TBGRAPixel; -begin - if position = EmptySingle then result := BGRAPixelTransparent else - if FRepetition <> grPad then - result := GetColorAt(round(frac(position*0.5)*131072)) else //divided by 2 for reflected repetition - begin - if position <= 0 then - result := FColor1 else - if position >= 1 then - result := FColor2 else - result := GetColorAt(round(position*65536)); - end; -end; - -function TBGRASimpleGradient.GetExpandedColorAt(position: integer - ): TExpandedPixel; -begin - case FRepetition of - grSine: begin - position := Sin65536(position and $ffff); - if position = 65536 then - result := ec2 - else - result := InterpolateToExpanded(position); - end; - grRepeat: result := InterpolateToExpanded(position and $ffff); - grReflect: - begin - position := position and $1ffff; - if position >= $10000 then - begin - if position = $10000 then - result := ec2 - else - result := InterpolateToExpanded($20000 - position); - end - else - result := InterpolateToExpanded(position); - end; - else - begin - if position <= 0 then - result := ec1 else - if position >= 65536 then - result := ec2 else - result := InterpolateToExpanded(position); - end; - end; -end; - -function TBGRASimpleGradient.GetExpandedColorAtF(position: single - ): TExpandedPixel; -begin - if position = EmptySingle then result := BGRAPixelTransparent else - if FRepetition <> grPad then - result := GetExpandedColorAt(round(frac(position*0.5)*131072)) else //divided by 2 for reflected repetition - begin - if position <= 0 then - result := ec1 else - if position >= 1 then - result := ec2 else - result := GetExpandedColorAt(round(position*65536)); - end; -end; - -function TBGRASimpleGradient.GetMonochrome: boolean; -begin - Result:= (FColor1 = FColor2); -end; - -{ TBGRAConstantScanner } - -constructor TBGRAConstantScanner.Create(c: TBGRAPixel); -begin - inherited Create(c,c,gtLinear,PointF(0,0),PointF(0,0),false); -end; - -{ TBGRARandomScanner } - -constructor TBGRARandomScanner.Create(AGrayscale: Boolean; AOpacity: byte); -begin - FGrayscale:= AGrayscale; - FOpacity:= AOpacity; - FRandomBufferCount := 0; -end; - -function TBGRARandomScanner.ScanAtInteger(X, Y: integer): TBGRAPixel; -begin - Result:=ScanNextPixel; -end; - -function TBGRARandomScanner.ScanNextPixel: TBGRAPixel; -var rgb: integer; -begin - if FGrayscale then - begin - if FRandomBufferCount = 0 then - begin - FRandomBuffer := random(256*256*256); - FRandomBufferCount := 3; - end; - result.red := FRandomBuffer and 255; - FRandomBuffer:= FRandomBuffer shr 8; - dec(FRandomBufferCount); - result.green := result.red; - result.blue := result.red; - result.alpha:= FOpacity; - end else - begin - rgb := random(256*256*256); - Result:= BGRA(rgb and 255,(rgb shr 8) and 255,(rgb shr 16) and 255,FOpacity); - end; -end; - -function TBGRARandomScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - Result:=ScanNextPixel; -end; - -{ TBGRAHueGradient } - -procedure TBGRAHueGradient.Init(c1, c2: THSLAPixel; AOptions: THueGradientOptions); -begin - FOptions:= AOptions; - if (hgoLightnessCorrection in AOptions) then - begin - hsla1 := ExpandedToGSBA(ec1); - hsla2 := ExpandedToGSBA(ec2); - end else - begin - hsla1 := c1; - hsla2 := c2; - end; - if not (hgoHueCorrection in AOptions) then - begin - hue1 := c1.hue; - hue2 := c2.hue; - end else - begin - hue1 := HtoG(c1.hue); - hue2 := HtoG(c2.hue); - end; - if (hgoPositiveDirection in AOptions) and not (hgoNegativeDirection in AOptions) then - begin - if c2.hue <= c1.hue then inc(hue2, 65536); - end else - if not (hgoPositiveDirection in AOptions) and (hgoNegativeDirection in AOptions) then - begin - if c2.hue >= c1.hue then inc(hue1, 65536); - end; -end; - -function TBGRAHueGradient.InterpolateToHSLA(position: word): THSLAPixel; -var b,b2: LongWord; -begin - b := position shr 2; - b2 := 16384-b; - result.hue := ((hue1 * b2 + hue2 * b + 8191) shr 14) and $ffff; - result.saturation := (hsla1.saturation * b2 + hsla2.saturation * b + 8191) shr 14; - result.lightness := (hsla1.lightness * b2 + hsla2.lightness * b + 8191) shr 14; - result.alpha := (hsla1.alpha * b2 + hsla2.alpha * b + 8191) shr 14; - if hgoLightnessCorrection in FOptions then - begin - if not (hgoHueCorrection in FOptions) then - result.hue := HtoG(result.hue); - end else - begin - if hgoHueCorrection in FOptions then - result.hue := GtoH(result.hue); - end; -end; - -function TBGRAHueGradient.InterpolateToBGRA(position: word): TBGRAPixel; -begin - if hgoLightnessCorrection in FOptions then - result := GSBAToBGRA(InterpolateToHSLA(position)) - else - result := HSLAToBGRA(InterpolateToHSLA(position)); -end; - -function TBGRAHueGradient.InterpolateToExpanded(position: word): TExpandedPixel; -begin - if hgoLightnessCorrection in FOptions then - result := GSBAToExpanded(InterpolateToHSLA(position)) - else - result := HSLAToExpanded(InterpolateToHSLA(position)); -end; - -constructor TBGRAHueGradient.Create(Color1, Color2: TBGRAPixel;options: THueGradientOptions); -begin - if hgoReflect in options then - inherited Create(Color1,Color2,grReflect) - else if hgoRepeat in options then - inherited Create(Color1,Color2,grRepeat) - else - inherited Create(Color1,Color2,grPad); - - Init(BGRAToHSLA(Color1),BGRAToHSLA(Color2),options); -end; - -constructor TBGRAHueGradient.Create(Color1, Color2: TExpandedPixel; - options: THueGradientOptions); -begin - if hgoReflect in options then - inherited Create(Color1,Color2,grReflect) - else if hgoRepeat in options then - inherited Create(Color1,Color2,grRepeat) - else - inherited Create(Color1,Color2,grPad); - - Init(ExpandedToHSLA(Color1),ExpandedToHSLA(Color2),options); -end; - -constructor TBGRAHueGradient.Create(Color1, Color2: THSLAPixel; options: THueGradientOptions); -begin - if hgoReflect in options then - inherited Create(Color1.ToExpanded,Color2.ToExpanded,grReflect) - else if hgoRepeat in options then - inherited Create(Color1.ToExpanded,Color2.ToExpanded,grRepeat) - else - inherited Create(Color1.ToExpanded,Color2.ToExpanded,grPad); - - Init(Color1,Color2, options); -end; - -constructor TBGRAHueGradient.Create(AHue1, AHue2: Word; Saturation, - Lightness: Word; options: THueGradientOptions); -begin - Create(HSLA(AHue1,saturation,lightness), HSLA(AHue2,saturation,lightness), options); -end; - -function TBGRAHueGradient.GetMonochrome: boolean; -begin - Result:= false; -end; - -{ TBGRAMultiGradient } - -procedure TBGRAMultiGradient.Init(Colors: array of TBGRAPixel; - Positions0To1: array of single; AGammaCorrection, ACycle: boolean); -var - i: Integer; -begin - if length(Positions0To1) <> length(colors) then - raise Exception.Create('Dimension mismatch'); - if length(Positions0To1) = 0 then - raise Exception.Create('Empty gradient'); - setlength(FColors,length(Colors)); - setlength(FPositions,length(Positions0To1)); - setlength(FPositionsF,length(Positions0To1)); - setlength(FEColors,length(Colors)); - for i := 0 to high(colors) do - begin - FColors[i]:= colors[i]; - FPositions[i]:= round(Positions0To1[i]*65536); - FPositionsF[i]:= Positions0To1[i]; - FEColors[i]:= GammaExpansion(colors[i]); - end; - GammaCorrection := AGammaCorrection; - FCycle := ACycle; - if FPositions[high(FPositions)] = FPositions[0] then FCycle := false; -end; - -function TBGRAMultiGradient.CosineInterpolation(t: single): single; -begin - result := (1-cos(t*Pi))*0.5; -end; - -function TBGRAMultiGradient.HalfCosineInterpolation(t: single): single; -begin - result := (1-cos(t*Pi))*0.25 + t*0.5; -end; - -constructor TBGRAMultiGradient.Create(Colors: array of TBGRAPixel; - Positions0To1: array of single; AGammaCorrection: boolean; ACycle: boolean); -begin - Init(Colors,Positions0To1,AGammaCorrection, ACycle); -end; - -function TBGRAMultiGradient.GetColorAt(position: integer): TBGRAPixel; -var i: Int32or64; - ec: TExpandedPixel; - curPos,posDiff: Int32or64; -begin - if FCycle then - position := (position-FPositions[0]) mod (FPositions[high(FPositions)] - FPositions[0]) + FPositions[0]; - if position <= FPositions[0] then - result := FColors[0] else - if position >= FPositions[high(FPositions)] then - result := FColors[high(FColors)] else - begin - i := 0; - while (i < high(FPositions)-1) and (position >= FPositions[i+1]) do - inc(i); - - if Position = FPositions[i] then - result := FColors[i] - else - begin - curPos := position-FPositions[i]; - posDiff := FPositions[i+1]-FPositions[i]; - if FInterpolationFunction <> nil then - begin - curPos := round(FInterpolationFunction(curPos/posDiff)*65536); - posDiff := 65536; - end; - if GammaCorrection then - begin - if FEColors[i+1].red < FEColors[i].red then - ec.red := FEColors[i].red - UInt32or64(curPos)*UInt32or64(FEColors[i].red-FEColors[i+1].red) div UInt32or64(posDiff) else - ec.red := FEColors[i].red + UInt32or64(curPos)*UInt32or64(FEColors[i+1].red-FEColors[i].red) div UInt32or64(posDiff); - if FEColors[i+1].green < FEColors[i].green then - ec.green := FEColors[i].green - UInt32or64(curPos)*UInt32or64(FEColors[i].green-FEColors[i+1].green) div UInt32or64(posDiff) else - ec.green := FEColors[i].green + UInt32or64(curPos)*UInt32or64(FEColors[i+1].green-FEColors[i].green) div UInt32or64(posDiff); - if FEColors[i+1].blue < FEColors[i].blue then - ec.blue := FEColors[i].blue - UInt32or64(curPos)*UInt32or64(FEColors[i].blue-FEColors[i+1].blue) div UInt32or64(posDiff) else - ec.blue := FEColors[i].blue + UInt32or64(curPos)*UInt32or64(FEColors[i+1].blue-FEColors[i].blue) div UInt32or64(posDiff); - if FEColors[i+1].alpha < FEColors[i].alpha then - ec.alpha := FEColors[i].alpha - UInt32or64(curPos)*UInt32or64(FEColors[i].alpha-FEColors[i+1].alpha) div UInt32or64(posDiff) else - ec.alpha := FEColors[i].alpha + UInt32or64(curPos)*UInt32or64(FEColors[i+1].alpha-FEColors[i].alpha) div UInt32or64(posDiff); - result := GammaCompression(ec); - end else - begin - result.red := FColors[i].red + (curPos)*(FColors[i+1].red-FColors[i].red) div (posDiff); - result.green := FColors[i].green + (curPos)*(FColors[i+1].green-FColors[i].green) div (posDiff); - result.blue := FColors[i].blue + (curPos)*(FColors[i+1].blue-FColors[i].blue) div (posDiff); - result.alpha := FColors[i].alpha + (curPos)*(FColors[i+1].alpha-FColors[i].alpha) div (posDiff); - end; - end; - end; -end; - -function TBGRAMultiGradient.GetExpandedColorAt(position: integer - ): TExpandedPixel; -var i: Int32or64; - curPos,posDiff: Int32or64; - rw,gw,bw: UInt32or64; -begin - if FCycle then - position := (position-FPositions[0]) mod (FPositions[high(FPositions)] - FPositions[0]) + FPositions[0]; - if position <= FPositions[0] then - result := FEColors[0] else - if position >= FPositions[high(FPositions)] then - result := FEColors[high(FColors)] else - begin - i := 0; - while (i < high(FPositions)-1) and (position >= FPositions[i+1]) do - inc(i); - - if Position = FPositions[i] then - result := FEColors[i] - else - begin - curPos := position-FPositions[i]; - posDiff := FPositions[i+1]-FPositions[i]; - if FInterpolationFunction <> nil then - begin - curPos := round(FInterpolationFunction(curPos/posDiff)*65536); - posDiff := 65536; - end; - if GammaCorrection then - begin - if FEColors[i+1].red < FEColors[i].red then - result.red := FEColors[i].red - UInt32or64(curPos)*UInt32or64(FEColors[i].red-FEColors[i+1].red) div UInt32or64(posDiff) else - result.red := FEColors[i].red + UInt32or64(curPos)*UInt32or64(FEColors[i+1].red-FEColors[i].red) div UInt32or64(posDiff); - if FEColors[i+1].green < FEColors[i].green then - result.green := FEColors[i].green - UInt32or64(curPos)*UInt32or64(FEColors[i].green-FEColors[i+1].green) div UInt32or64(posDiff) else - result.green := FEColors[i].green + UInt32or64(curPos)*UInt32or64(FEColors[i+1].green-FEColors[i].green) div UInt32or64(posDiff); - if FEColors[i+1].blue < FEColors[i].blue then - result.blue := FEColors[i].blue - UInt32or64(curPos)*UInt32or64(FEColors[i].blue-FEColors[i+1].blue) div UInt32or64(posDiff) else - result.blue := FEColors[i].blue + UInt32or64(curPos)*UInt32or64(FEColors[i+1].blue-FEColors[i].blue) div UInt32or64(posDiff); - if FEColors[i+1].alpha < FEColors[i].alpha then - result.alpha := FEColors[i].alpha - UInt32or64(curPos)*UInt32or64(FEColors[i].alpha-FEColors[i+1].alpha) div UInt32or64(posDiff) else - result.alpha := FEColors[i].alpha + UInt32or64(curPos)*UInt32or64(FEColors[i+1].alpha-FEColors[i].alpha) div UInt32or64(posDiff); - end else - begin - rw := Int32or64(FColors[i].red shl 8) + (((curPos) shl 8)*(FColors[i+1].red-FColors[i].red)) div (posDiff); - gw := Int32or64(FColors[i].green shl 8) + (((curPos) shl 8)*(FColors[i+1].green-FColors[i].green)) div (posDiff); - bw := Int32or64(FColors[i].blue shl 8) + (((curPos) shl 8)*(FColors[i+1].blue-FColors[i].blue)) div (posDiff); - - if rw >= $ff00 then result.red := $ffff - else result.red := (GammaExpansionTab[rw shr 8]*UInt32or64(255 - (rw and 255)) + GammaExpansionTab[(rw shr 8)+1]*UInt32or64(rw and 255)) shr 8; - if gw >= $ff00 then result.green := $ffff - else result.green := (GammaExpansionTab[gw shr 8]*UInt32or64(255 - (gw and 255)) + GammaExpansionTab[(gw shr 8)+1]*UInt32or64(gw and 255)) shr 8; - if bw >= $ff00 then result.blue := $ffff - else result.blue := (GammaExpansionTab[bw shr 8]*UInt32or64(255 - (bw and 255)) + GammaExpansionTab[(bw shr 8)+1]*UInt32or64(bw and 255)) shr 8; - result.alpha := Int32or64(FColors[i].alpha shl 8) + (((curPos) shl 8)*(FColors[i+1].alpha-FColors[i].alpha)) div (posDiff); - result.alpha := result.alpha + (result.alpha shr 8); - end; - end; - end; -end; - -function TBGRAMultiGradient.GetAverageColor: TBGRAPixel; -var sumR,sumG,sumB,sumA: integer; - i: Integer; -begin - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - for i := 0 to high(FColors) do - begin - inc(sumR, FColors[i].red); - inc(sumG, FColors[i].green); - inc(sumB, FColors[i].blue); - inc(sumA, FColors[i].alpha); - end; - result := BGRA(sumR div length(FColors),sumG div length(FColors), - sumB div length(FColors),sumA div length(FColors)); -end; - -function TBGRAMultiGradient.GetMonochrome: boolean; -var i: integer; -begin - for i := 1 to high(FColors) do - if FColors[i] <> FColors[0] then - begin - result := false; - exit; - end; - Result:= true; -end; - -{ TBGRASimpleGradientWithGammaCorrection } - -function TBGRASimpleGradientWithGammaCorrection.InterpolateToBGRA(position: word - ): TBGRAPixel; -var b,b2: LongWord; - ec: TExpandedPixel; -begin - b := position; - b2 := 65536-b; - ec.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16; - ec.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16; - ec.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16; - ec.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16; - result := GammaCompression(ec); -end; - -function TBGRASimpleGradientWithGammaCorrection.InterpolateToExpanded( - position: word): TExpandedPixel; -var b,b2: LongWord; -begin - b := position; - b2 := 65536-b; - result.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16; - result.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16; - result.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16; - result.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16; -end; - -constructor TBGRASimpleGradientWithGammaCorrection.Create(Color1, - Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); -begin - inherited Create(Color1,Color2,ARepetition); -end; - -constructor TBGRASimpleGradientWithGammaCorrection.Create(Color1, - Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition); -begin - inherited Create(Color1,Color2,ARepetition); -end; - -{ TBGRASimpleGradientWithoutGammaCorrection } - -function TBGRASimpleGradientWithoutGammaCorrection.InterpolateToBGRA( - position: word): TBGRAPixel; -var b,b2: LongWord; -begin - b := position shr 6; - b2 := 1024-b; - result.red := (FColor1.red * b2 + FColor2.red * b + 511) shr 10; - result.green := (FColor1.green * b2 + FColor2.green * b + 511) shr 10; - result.blue := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 10; - result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 10; -end; - -function TBGRASimpleGradientWithoutGammaCorrection.InterpolateToExpanded( - position: word): TExpandedPixel; -var b,b2: LongWord; - rw,gw,bw: word; -begin - b := position shr 6; - b2 := 1024-b; - rw := (FColor1.red * b2 + FColor2.red * b + 511) shr 2; - gw := (FColor1.green * b2 + FColor2.green * b + 511) shr 2; - bw := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 2; - - if rw >= $ff00 then - result.red := 65535 - else - result.red := (GammaExpansionTab[rw shr 8]*UInt32or64(255 - (rw and 255)) + GammaExpansionTab[(rw shr 8)+1]*UInt32or64(rw and 255)) shr 8; - - if gw >= $ff00 then - result.green := 65535 - else - result.green := (GammaExpansionTab[gw shr 8]*UInt32or64(255 - (gw and 255)) + GammaExpansionTab[(gw shr 8)+1]*UInt32or64(gw and 255)) shr 8; - - if bw >= $ff00 then - result.blue := 65535 - else - result.blue := (GammaExpansionTab[bw shr 8]*UInt32or64(255 - (bw and 255)) + GammaExpansionTab[(bw shr 8)+1]*UInt32or64(bw and 255)) shr 8; - - result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 2; -end; - -constructor TBGRASimpleGradientWithoutGammaCorrection.Create(Color1, - Color2: TBGRAPixel; ARepetition: TBGRAGradientRepetition); -begin - inherited Create(Color1,Color2,ARepetition); -end; - -constructor TBGRASimpleGradientWithoutGammaCorrection.Create(Color1, - Color2: TExpandedPixel; ARepetition: TBGRAGradientRepetition); -begin - inherited Create(Color1,Color2,ARepetition); -end; - -{ TBGRAGradientTriangleScanner } - -constructor TBGRAGradientTriangleScanner.Create(pt1, pt2, pt3: TPointF; c1, c2, - c3: TBGRAPixel); -var ec1,ec2,ec3: TExpandedPixel; -begin - FMatrix := AffineMatrix(pt2.X-pt1.X, pt3.X-pt1.X, 0, - pt2.Y-pt1.Y, pt3.Y-pt1.Y, 0); - if not IsAffineMatrixInversible(FMatrix) then - FMatrix := AffineMatrix(0,0,0,0,0,0) - else - FMatrix := AffineMatrixInverse(FMatrix) * AffineMatrixTranslation(-pt1.x,-pt1.y); - - ec1 := GammaExpansion(c1); - ec2 := GammaExpansion(c2); - ec3 := GammaExpansion(c3); - FColor1[1] := ec1.red; - FColor1[2] := ec1.green; - FColor1[3] := ec1.blue; - FColor1[4] := ec1.alpha; - FDiff2[1] := ec2.red - ec1.red; - FDiff2[2] := ec2.green - ec1.green; - FDiff2[3] := ec2.blue - ec1.blue; - FDiff2[4] := ec2.alpha - ec1.alpha; - FDiff3[1] := ec3.red - ec1.red; - FDiff3[2] := ec3.green - ec1.green; - FDiff3[3] := ec3.blue - ec1.blue; - FDiff3[4] := ec3.alpha - ec1.alpha; - FStep := FDiff2*FMatrix[1,1]+FDiff3*FMatrix[2,1]; -end; - -procedure TBGRAGradientTriangleScanner.ScanMoveTo(X, Y: Integer); -begin - ScanMoveToF(X, Y); -end; - -procedure TBGRAGradientTriangleScanner.ScanMoveToF(X, Y: Single); -var - Cur: TPointF; -begin - Cur := FMatrix*PointF(X,Y); - FCurColor := FColor1+FDiff2*Cur.X+FDiff3*Cur.Y; -end; - -function TBGRAGradientTriangleScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - ScanMoveToF(X,Y); - result := ScanNextPixel; -end; - -function TBGRAGradientTriangleScanner.ScanNextPixel: TBGRAPixel; -var r,g,b,a: int64; -begin - r := round(FCurColor[1]); - g := round(FCurColor[2]); - b := round(FCurColor[3]); - a := round(FCurColor[4]); - if r > 65535 then r := 65535 else - if r < 0 then r := 0; - if g > 65535 then g := 65535 else - if g < 0 then g := 0; - if b > 65535 then b := 65535 else - if b < 0 then b := 0; - if a > 65535 then a := 65535 else - if a < 0 then a := 0; - result.red := GammaCompressionTab[r]; - result.green := GammaCompressionTab[g]; - result.blue := GammaCompressionTab[b]; - result.alpha := a shr 8; - FCurColor := FCurColor + FStep; -end; - -function TBGRAGradientTriangleScanner.ScanNextExpandedPixel: TExpandedPixel; -var r,g,b,a: int64; -begin - r := round(FCurColor[1]); - g := round(FCurColor[2]); - b := round(FCurColor[3]); - a := round(FCurColor[4]); - if r > 65535 then r := 65535 else - if r < 0 then r := 0; - if g > 65535 then g := 65535 else - if g < 0 then g := 0; - if b > 65535 then b := 65535 else - if b < 0 then b := 0; - if a > 65535 then a := 65535 else - if a < 0 then a := 0; - result.red := r; - result.green := g; - result.blue := b; - result.alpha := a; - FCurColor := FCurColor + FStep; -end; - -procedure TBGRAGradientTriangleScanner.ScanSkipPixels(ACount: integer); -begin - FCurColor := FCurColor + FStep*ACount; -end; - -{ TBGRAGradientScanner } - -procedure TBGRAGradientScanner.SetTransform(AValue: TAffineMatrix); -begin - if FTransform=AValue then Exit; - FTransform:=AValue; - InitTransform; -end; - -constructor TBGRAGradientScanner.Create(AGradientType: TGradientType; AOrigin, d1: TPointF); -begin - FGradient := nil; - SetGradient(BGRABlack,BGRAWhite,False); - Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,False); -end; - -constructor TBGRAGradientScanner.Create(AGradientType: TGradientType; AOrigin, d1,d2: TPointF); -begin - FGradient := nil; - SetGradient(BGRABlack,BGRAWhite,False); - Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,False); -end; - -constructor TBGRAGradientScanner.Create(AOrigin, - d1, d2, AFocal: TPointF; ARadiusRatio: single; AFocalRadiusRatio: single); -var - m, mInv: TAffineMatrix; - focalInv: TPointF; -begin - FGradient := nil; - SetGradient(BGRABlack,BGRAWhite,False); - - m := AffineMatrix((d1-AOrigin).x, (d2-AOrigin).x, AOrigin.x, - (d1-AOrigin).y, (d2-AOrigin).y, AOrigin.y); - if IsAffineMatrixInversible(m) then - begin - mInv := AffineMatrixInverse(m); - focalInv := mInv*AFocal; - end else - focalInv := PointF(0,0); - - Init(PointF(0,0), ARadiusRatio, focalInv, AFocalRadiusRatio, AffineMatrixIdentity, m); -end; - -constructor TBGRAGradientScanner.Create(AOrigin: TPointF; ARadius: single; - AFocal: TPointF; AFocalRadius: single); -begin - FGradient := nil; - SetGradient(BGRABlack,BGRAWhite,False); - - Init(AOrigin, ARadius, AFocal, AFocalRadius, AffineMatrixIdentity, AffineMatrixIdentity); -end; - -procedure TBGRAGradientScanner.SetFlipGradient(AValue: boolean); -begin - if FFlipGradient=AValue then Exit; - FFlipGradient:=AValue; - UpdateGetGradientColorFunctions; -end; - -function TBGRAGradientScanner.GetGradientColor(a: single): TBGRAPixel; -begin - if a = EmptySingle then - result := BGRAPixelTransparent - else - begin - if FFlipGradient then a := 1-a; - if FSinus then - begin - a := a*65536; - if (a <= low(int64)) or (a >= high(int64)) then - result := FAverageColor - else - result := FGradient.GetColorAt(Sin65536(round(a) and 65535)); - end else - result := FGradient.GetColorAtF(a); - end; -end; - -function TBGRAGradientScanner.GetGradientExpandedColor(a: single): TExpandedPixel; -begin - if a = EmptySingle then - QWord(result) := 0 - else - begin - if FFlipGradient then a := 1-a; - if FSinus then - begin - a := a * 65536; - if (a <= low(int64)) or (a >= high(int64)) then - result := FAverageExpandedColor - else - result := FGradient.GetExpandedColorAt(Sin65536(round(a) and 65535)); - end else - result := FGradient.GetExpandedColorAtF(a); - end; -end; - -function TBGRAGradientScanner.GetGradientColorFlipped(a: single): TBGRAPixel; -begin - result := FGradient.GetColorAtF(1 - a); -end; - -function TBGRAGradientScanner.GetGradientExpandedColorFlipped(a: single): TExpandedPixel; -begin - result := FGradient.GetExpandedColorAtF(1 - a); -end; - -function TBGRAGradientScanner.GetGradientColorSinus(a: single): TBGRAPixel; -begin - if FFlipGradient then a := 1-a; - a := a * 65536; - if (a <= low(int64)) or (a >= high(int64)) then - result := FAverageColor - else result := FGradient.GetColorAt(Sin65536(round(a) and 65535)); -end; - -function TBGRAGradientScanner.GetGradientExpandedColorSinus(a: single): TExpandedPixel; -begin - if FFlipGradient then a := 1-a; - a := a * 65536; - if (a <= low(int64)) or (a >= high(int64)) then - result := FAverageExpandedColor - else result := FGradient.GetExpandedColorAt(Sin65536(round(a) and 65535)); -end; - -procedure TBGRAGradientScanner.UpdateGetGradientColorFunctions; -begin - if FSinus then - begin - FGetGradientColor:= @GetGradientColorSinus; - FGetGradientExpandedColor:= @GetGradientExpandedColorSinus; - end else - if FFlipGradient then - begin - FGetGradientColor:= @GetGradientColorFlipped; - FGetGradientExpandedColor:= @GetGradientExpandedColorFlipped; - end else - begin - FGetGradientColor:= @FGradient.GetColorAtF; - FGetGradientExpandedColor:= @FGradient.GetExpandedColorAtF; - end; -end; - -procedure TBGRAGradientScanner.SetSinus(AValue: boolean); -begin - if FSinus=AValue then Exit; - FSinus:=AValue; - UpdateGetGradientColorFunctions; -end; - -procedure TBGRAGradientScanner.Init(AGradientType: TGradientType; AOrigin, d1: TPointF; - ATransform: TAffineMatrix; Sinus: Boolean); -var d2: TPointF; -begin - with (d1-AOrigin) do - d2 := PointF(AOrigin.x+y,AOrigin.y-x); - Init(AGradientType,AOrigin,d1,d2,ATransform,Sinus); -end; - -procedure TBGRAGradientScanner.Init(AGradientType: TGradientType; AOrigin, d1, d2: TPointF; - ATransform: TAffineMatrix; Sinus: Boolean); -begin - FGradientType:= AGradientType; - FFlipGradient:= false; - FOrigin := AOrigin; - FDir1 := d1; - FDir2 := d2; - FSinus := Sinus; - FTransform := ATransform; - FHiddenTransform := AffineMatrixIdentity; - - FRadius := 1; - FRelativeFocal := PointF(0,0); - FFocalRadius := 0; - - InitGradientType; - InitTransform; - UpdateGetGradientColorFunctions; -end; - -procedure TBGRAGradientScanner.Init(AOrigin: TPointF; ARadius: single; - AFocal: TPointF; AFocalRadius: single; ATransform: TAffineMatrix; AHiddenTransform: TAffineMatrix); -var maxRadius: single; -begin - FGradientType:= gtRadial; - FFlipGradient:= false; - FOrigin := AOrigin; - ARadius := abs(ARadius); - AFocalRadius := abs(AFocalRadius); - maxRadius := max(ARadius,AFocalRadius); - FDir1 := AOrigin+PointF(maxRadius,0); - FDir2 := AOrigin+PointF(0,maxRadius); - FSinus := False; - FTransform := ATransform; - FHiddenTransform := AHiddenTransform; - - FRadius := ARadius/maxRadius; - FRelativeFocal := (AFocal - AOrigin)*(1/maxRadius); - FFocalRadius := AFocalRadius/maxRadius; - - InitGradientType; - InitTransform; - UpdateGetGradientColorFunctions; -end; - -procedure TBGRAGradientScanner.InitGradientType; -begin - case FGradientType of - gtReflected: begin - FScanNextFunc:= @ScanNextReflected; - FScanAtFunc:= @ScanAtReflected; - end; - gtDiamond: begin - FScanNextFunc:= @ScanNextDiamond; - FScanAtFunc:= @ScanAtDiamond; - end; - gtRadial: if (FRelativeFocal.x = 0) and (FRelativeFocal.y = 0) then - begin - if (FFocalRadius = 0) and (FRadius = 1) then - begin - FScanNextFunc:= @ScanNextRadial; - FScanAtFunc:= @ScanAtRadial; - end else - begin - FScanNextFunc:= @ScanNextRadial2; - FScanAtFunc:= @ScanAtRadial2; - end; - end else - begin - FScanNextFunc:= @ScanNextRadialFocal; - FScanAtFunc:= @ScanAtRadialFocal; - - FFocalDirection := FRelativeFocal; - FFocalDistance := VectLen(FFocalDirection); - if FFocalDistance > 0 then FFocalDirection := FFocalDirection * (1/FFocalDistance); - FFocalNormal := PointF(-FFocalDirection.y,FFocalDirection.x); - FRadialDenominator := sqr(FRadius-FFocalRadius)-sqr(FFocalDistance); - - //case in which the second circle is bigger and the first circle is within the second - if (FRadius < FFocalRadius) and (FFocalDistance <= FFocalRadius-FRadius) then - FRadialDeltaSign := -1 - else - FRadialDeltaSign := 1; - - //clipping afer the apex - if (FFocalRadius < FRadius) and (FFocalDistance > FRadius-FFocalRadius) then - begin - maxW1 := FRadius/(FRadius-FFocalRadius)*FFocalDistance; - maxW2 := MaxSingle; - end else - if (FRadius < FFocalRadius) and (FFocalDistance > FFocalRadius-FRadius) then - begin - maxW1 := MaxSingle; - maxW2 := FFocalRadius/(FFocalRadius-FRadius)*FFocalDistance; - end else - begin - maxW1 := MaxSingle; - maxW2 := MaxSingle; - end; - end; - gtAngular: begin - FScanNextFunc:= @ScanNextAngular; - FScanAtFunc:= @ScanAtAngular; - end; - else - {gtLinear:} begin - FScanNextFunc:= @ScanNextLinear; - FScanAtFunc:= @ScanAtLinear; - end; - end; -end; - -procedure TBGRAGradientScanner.SetGradient(c1, c2: TBGRAPixel; - AGammaCorrection: boolean); -begin - if Assigned(FGradient) and FGradientOwner then FreeAndNil(FGradient); - - //transparent pixels have no color so - //take it from other color - if c1.alpha = 0 then c1 := BGRA(c2.red,c2.green,c2.blue,0); - if c2.alpha = 0 then c2 := BGRA(c1.red,c1.green,c1.blue,0); - - if AGammaCorrection then - FGradient := TBGRASimpleGradientWithGammaCorrection.Create(c1,c2) - else - FGradient := TBGRASimpleGradientWithoutGammaCorrection.Create(c1,c2); - FGradientOwner := true; - InitGradient; -end; - -procedure TBGRAGradientScanner.SetGradient(AGradient: TBGRACustomGradient; - AOwner: boolean); -begin - if Assigned(FGradient) and FGradientOwner then FreeAndNil(FGradient); - FGradient := AGradient; - FGradientOwner := AOwner; - InitGradient; -end; - -procedure TBGRAGradientScanner.InitTransform; -var u,v: TPointF; -begin - u := FDir1-FOrigin; - if FGradientType in[gtLinear,gtReflected] then - v := PointF(u.y, -u.x) - else - v := FDir2-FOrigin; - - FMatrix := FTransform * FHiddenTransform * AffineMatrix(u.x, v.x, FOrigin.x, - u.y, v.y, FOrigin.y); - if IsAffineMatrixInversible(FMatrix) then - begin - FMatrix := AffineMatrixInverse(FMatrix); - FIsAverage:= false; - end else - begin - FMatrix := AffineMatrixIdentity; - FIsAverage:= true; - end; - - case FGradientType of - gtReflected: FRepeatHoriz := (FMatrix[1,1]=0); - gtDiamond,gtAngular: FRepeatHoriz:= false; - gtRadial: begin - FRepeatHoriz:= false; - if FFocalRadius = FRadius then FIsAverage:= true; - end - else - {gtLinear:} FRepeatHoriz := (FMatrix[1,1]=0); - end; - - if FGradient.Monochrome then - FIsAverage:= true; - - if FIsAverage then - FRepeatHoriz:= true; - - FPosition := PointF(0,0); -end; - -procedure TBGRAGradientScanner.InitGradient; -begin - FAverageColor := FGradient.GetAverageColor; - FAverageExpandedColor := FGradient.GetAverageExpandedColor; - UpdateGetGradientColorFunctions; -end; - -function TBGRAGradientScanner.ComputeRadialFocal(const p: TPointF): single; -var - w1,w2,num: single; - h,d1,d2,delta: double; -begin - w1 := p*FFocalDirection; - w2 := FFocalDistance-w1; - if (w1 < maxW1) and (w2 < maxW2) then - begin - //vertical position and distances - h := sqr(p*FFocalNormal); - d1 := sqr(w1)+h; - d2 := sqr(w2)+h; - //finding t - delta := sqr(FFocalRadius)*d1 + 2*FRadius*FFocalRadius*(p*(FRelativeFocal-p))+ - sqr(FRadius)*d2 - sqr(VectDet(p,FRelativeFocal)); - if delta >= 0 then - begin - num := -FFocalRadius*(FRadius-FFocalRadius)-(FRelativeFocal*(FRelativeFocal-p)); - result := (num+FRadialDeltaSign*sqrt(delta))/FRadialDenominator; - end else - result := EmptySingle; - end else - result := EmptySingle; -end; - -function TBGRAGradientScanner.ScanNextLinear: single; -begin - result := FPosition.x; -end; - -function TBGRAGradientScanner.ScanNextReflected: single; -begin - result := abs(FPosition.x); -end; - -function TBGRAGradientScanner.ScanNextDiamond: single; -begin - result := max(abs(FPosition.x), abs(FPosition.y)); -end; - -function TBGRAGradientScanner.ScanNextRadial: single; -begin - result := sqrt(sqr(FPosition.x) + sqr(FPosition.y)); -end; - -function TBGRAGradientScanner.ScanNextRadial2: single; -begin - result := (sqrt(sqr(FPosition.x) + sqr(FPosition.y))-FFocalRadius)/(FRadius-FFocalRadius); -end; - -function TBGRAGradientScanner.ScanNextRadialFocal: single; -begin - result := ComputeRadialFocal(FPosition); -end; - -function TBGRAGradientScanner.ScanNextAngular: single; -begin - if FPosition.y >= 0 then - result := arctan2(FPosition.y,FPosition.x)/(2*Pi) - else - result := 1-arctan2(-FPosition.y,FPosition.x)/(2*Pi) -end; - -function TBGRAGradientScanner.ScanAtLinear(const p: TPointF): single; -begin - with (FMatrix*p) do - result := x; -end; - -function TBGRAGradientScanner.ScanAtReflected(const p: TPointF): single; -begin - with (FMatrix*p) do - result := abs(x); -end; - -function TBGRAGradientScanner.ScanAtDiamond(const p: TPointF): single; -begin - with (FMatrix*p) do - result := max(abs(x), abs(y)); -end; - -function TBGRAGradientScanner.ScanAtRadial(const p: TPointF): single; -begin - with (FMatrix*p) do - result := sqrt(sqr(x) + sqr(y)); -end; - -function TBGRAGradientScanner.ScanAtRadial2(const p: TPointF): single; -begin - with (FMatrix*p) do - result := (sqrt(sqr(x) + sqr(y))-FFocalRadius)/(FRadius-FFocalRadius); -end; - -function TBGRAGradientScanner.ScanAtRadialFocal(const p: TPointF): single; -begin - result := ComputeRadialFocal(FMatrix*p); -end; - -function TBGRAGradientScanner.ScanAtAngular(const p: TPointF): single; -begin - with (FMatrix*p) do - begin - if y >= 0 then - result := arctan2(y,x)/(2*Pi) - else - result := 1-arctan2(-y,x)/(2*Pi) - end; -end; - -function TBGRAGradientScanner.ScanNextInline: TBGRAPixel; -begin - result := FGetGradientColor(FScanNextFunc()); - FPosition.x := FPosition.x + FMatrix[1,1]; - FPosition.y := FPosition.y + FMatrix[2,1]; -end; - -function TBGRAGradientScanner.ScanNextExpandedInline: TExpandedPixel; -begin - result := FGetGradientExpandedColor(FScanNextFunc()); - FPosition.x := FPosition.x + FMatrix[1,1]; - FPosition.y := FPosition.y + FMatrix[2,1]; -end; - -constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel; - AGradientType: TGradientType; AOrigin, d1: TPointF; gammaColorCorrection: boolean; - Sinus: Boolean); -begin - FGradient := nil; - SetGradient(c1,c2,gammaColorCorrection); - Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,Sinus); -end; - -constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel; - AGradientType: TGradientType; AOrigin, d1, d2: TPointF; gammaColorCorrection: boolean; - Sinus: Boolean); -begin - FGradient := nil; - if AGradientType in[gtLinear,gtReflected] then raise EInvalidArgument.Create('Two directions are not required for linear and reflected gradients'); - SetGradient(c1,c2,gammaColorCorrection); - Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,Sinus); -end; - -constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient; - AGradientType: TGradientType; AOrigin, d1: TPointF; Sinus: Boolean; AGradientOwner: Boolean=False); -begin - FGradient := gradient; - FGradientOwner := AGradientOwner; - InitGradient; - Init(AGradientType,AOrigin,d1,AffineMatrixIdentity,Sinus); -end; - -constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient; - AGradientType: TGradientType; AOrigin, d1, d2: TPointF; Sinus: Boolean; - AGradientOwner: Boolean); -begin - if AGradientType in[gtLinear,gtReflected] then raise EInvalidArgument.Create('Two directions are not required for linear and reflected gradients'); - FGradient := gradient; - FGradientOwner := AGradientOwner; - InitGradient; - Init(AGradientType,AOrigin,d1,d2,AffineMatrixIdentity,Sinus); -end; - -constructor TBGRAGradientScanner.Create(gradient: TBGRACustomGradient; - AOrigin: TPointF; ARadius: single; AFocal: TPointF; AFocalRadius: single; - AGradientOwner: Boolean); -begin - FGradient := gradient; - FGradientOwner := AGradientOwner; - InitGradient; - Init(AOrigin, ARadius, AFocal, AFocalRadius, AffineMatrixIdentity, AffineMatrixIdentity); -end; - -destructor TBGRAGradientScanner.Destroy; -begin - if FGradientOwner then - FGradient.Free; - inherited Destroy; -end; - -procedure TBGRAGradientScanner.ScanMoveTo(X, Y: Integer); -begin - FPosition := FMatrix*PointF(x,y); - if FRepeatHoriz then - begin - if FIsAverage then - begin - FHorizColor := FAverageColor; - FHorizExpandedColor := FAverageExpandedColor; - end else - begin - FHorizColor := ScanNextInline; - FHorizExpandedColor := ScanNextExpandedInline; - end; - end; -end; - -function TBGRAGradientScanner.ScanNextPixel: TBGRAPixel; -begin - if FRepeatHoriz then - result := FHorizColor - else - result := ScanNextInline; -end; - -function TBGRAGradientScanner.ScanNextExpandedPixel: TExpandedPixel; -begin - if FRepeatHoriz then - result := FHorizExpandedColor - else - result := ScanNextExpandedInline; -end; - -function TBGRAGradientScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - if FIsAverage then - result := FAverageColor - else - result := GetGradientColor(FScanAtFunc(PointF(X,Y))); -end; - -function TBGRAGradientScanner.ScanAtExpanded(X, Y: Single): TExpandedPixel; -begin - if FIsAverage then - result := FAverageExpandedColor - else - result := GetGradientExpandedColor(FScanAtFunc(PointF(X,Y))); -end; - -procedure TBGRAGradientScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; - mode: TDrawMode); -var c: TBGRAPixel; -begin - if FRepeatHoriz then - begin - c := FHorizColor; - case mode of - dmDrawWithTransparency: DrawPixelsInline(pdest,c,count); - dmLinearBlend: FastBlendPixelsInline(pdest,c,count); - dmSet: FillDWord(pdest^,count,Longword(c)); - dmXor: XorInline(pdest,c,count); - dmSetExceptTransparent: if c.alpha = 255 then FillDWord(pdest^,count,Longword(c)); - end; - exit; - end; - - case mode of - dmDrawWithTransparency: - while count > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest,ScanNextInline); - inc(pdest); - dec(count); - end; - dmLinearBlend: - while count > 0 do - begin - FastBlendPixelInline(pdest,ScanNextInline); - inc(pdest); - dec(count); - end; - dmXor: - while count > 0 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(ScanNextInline); - inc(pdest); - dec(count); - end; - dmSet: - while count > 0 do - begin - pdest^ := ScanNextInline; - inc(pdest); - dec(count); - end; - dmSetExceptTransparent: - while count > 0 do - begin - c := ScanNextInline; - if c.alpha = 255 then pdest^ := c; - inc(pdest); - dec(count); - end; - end; -end; - -procedure TBGRAGradientScanner.ScanSkipPixels(ACount: integer); -begin - if not FRepeatHoriz and not FIsAverage then - FPosition.Offset(FMatrix[1,1]*ACount,FMatrix[2,1]*ACount); -end; - -function TBGRAGradientScanner.IsScanPutPixelsDefined: boolean; -begin - result := true; -end; - -{ TBGRATextureMaskScanner } - -constructor TBGRATextureMaskScanner.Create(AMask: IBGRAScanner; - AOffset: TPoint; ATexture: IBGRAScanner; AGlobalOpacity: Byte); -begin - FMask := AMask; - FOffset := AOffset; - FTexture := ATexture; - FTextureScanNext := @FTexture.ScanNextPixel; - FTextureScanAt := @FTexture.ScanAt; - FGlobalOpacity:= AGlobalOpacity; -end; - -destructor TBGRATextureMaskScanner.Destroy; -begin - fillchar(FMask,sizeof(FMask),0); //avoids interface deref - fillchar(FTexture,sizeof(FTexture),0); - inherited Destroy; -end; - -function TBGRATextureMaskScanner.IsScanPutPixelsDefined: boolean; -begin - Result:= true; -end; - -procedure TBGRATextureMaskScanner.ScanPutPixels(pdest: PBGRAPixel; - count: integer; mode: TDrawMode); -var c: TBGRAPixel; - ptex: pbgrapixel; - pmask: PByteMask; - stride, qty: integer; - - function GetNext: TBGRAPixel; inline; - begin - result := ptex^; - inc(ptex); - result.alpha := ApplyOpacity(result.alpha, pmask^.gray); - inc(pmask, stride); - end; - - function GetNextWithGlobal: TBGRAPixel; inline; - begin - result := ptex^; - inc(ptex); - result.alpha := ApplyOpacity( ApplyOpacity(result.alpha, pmask^.gray), FGlobalOpacity ); - inc(pmask, stride); - end; - -begin - if count > length(FMemTex) then setlength(FMemTex, max(length(FMemTex)*2,count)); - ScannerPutPixels(FTexture,@FMemTex[0],count,dmSet); - ptex := @FMemTex[0]; - while count > 0 do - begin - qty := count; - FMask.ScanNextMaskChunk(qty, pMask, stride); - dec(count, qty); - if FGlobalOpacity <> 255 then - begin - case mode of - dmDrawWithTransparency: - while qty > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest,GetNextWithGlobal); - inc(pdest); - dec(qty); - end; - dmLinearBlend: - while qty > 0 do - begin - FastBlendPixelInline(pdest,GetNextWithGlobal); - inc(pdest); - dec(qty); - end; - dmXor: - while qty > 0 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNextWithGlobal); - inc(pdest); - dec(qty); - end; - dmSet: - while qty > 0 do - begin - pdest^ := GetNextWithGlobal; - inc(pdest); - dec(qty); - end; - dmSetExceptTransparent: - while qty > 0 do - begin - c := GetNextWithGlobal; - if c.alpha = 255 then pdest^ := c; - inc(pdest); - dec(qty); - end; - end; - end else - begin - case mode of - dmDrawWithTransparency: - while qty > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest,GetNext); - inc(pdest); - dec(qty); - end; - dmLinearBlend: - while qty > 0 do - begin - FastBlendPixelInline(pdest,GetNext); - inc(pdest); - dec(qty); - end; - dmXor: - while qty > 0 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNext); - inc(pdest); - dec(qty); - end; - dmSet: - while qty > 0 do - begin - pdest^ := GetNext; - inc(pdest); - dec(qty); - end; - dmSetExceptTransparent: - while qty > 0 do - begin - c := GetNext; - if c.alpha = 255 then pdest^ := c; - inc(pdest); - dec(qty); - end; - end; - end; - end; -end; - -procedure TBGRATextureMaskScanner.ScanSkipPixels(ACount: integer); -begin - FMask.ScanSkipPixels(ACount); - FTexture.ScanSkipPixels(ACount); -end; - -procedure TBGRATextureMaskScanner.ScanMoveTo(X, Y: Integer); -begin - FMask.ScanMoveTo(X+FOffset.X,Y+FOffset.Y); - FTexture.ScanMoveTo(X,Y); -end; - -function TBGRATextureMaskScanner.ScanNextPixel: TBGRAPixel; -var - pMask: PByteMask; - stride, qty: integer; -begin - qty := 1; - FMask.ScanNextMaskChunk(qty,pMask,stride); - result := FTextureScanNext(); - result.alpha := ApplyOpacity( ApplyOpacity(result.alpha,pMask^.gray), FGlobalOpacity ); -end; - -function TBGRATextureMaskScanner.ScanAt(X, Y: Single): TBGRAPixel; -var alpha: byte; -begin - alpha := FMask.ScanAtMask(X+FOffset.X,Y+FOffset.Y).gray; - result := FTextureScanAt(X,Y); - result.alpha := ApplyOpacity( ApplyOpacity(result.alpha,alpha), FGlobalOpacity ); -end; - -{ TBGRASolidColorMaskScanner } - -constructor TBGRASolidColorMaskScanner.Create(AMask: IBGRAScanner; - AOffset: TPoint; ASolidColor: TBGRAPixel); -begin - FMask := AMask; - FOffset := AOffset; - FSolidColor := ASolidColor; -end; - -destructor TBGRASolidColorMaskScanner.Destroy; -begin - fillchar(FMask,sizeof(FMask),0); //avoids interface deref - inherited Destroy; -end; - -function TBGRASolidColorMaskScanner.IsScanPutPixelsDefined: boolean; -begin - Result:= true; -end; - -procedure TBGRASolidColorMaskScanner.ScanPutPixels(pdest: PBGRAPixel; - count: integer; mode: TDrawMode); -var c: TBGRAPixel; - pmask: PByteMask; - stride, qty: integer; - - function GetNext: TBGRAPixel; inline; - begin - result := FSolidColor; - result.alpha := ApplyOpacity(result.alpha,pmask^.gray); - inc(pmask, stride); - end; - -begin - while count > 0 do - begin - qty := count; - FMask.ScanNextMaskChunk(qty, pMask, stride); - dec(count, qty); - case mode of - dmDrawWithTransparency: - while qty > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest,GetNext); - inc(pdest); - dec(qty); - end; - dmLinearBlend: - while qty > 0 do - begin - FastBlendPixelInline(pdest,GetNext); - inc(pdest); - dec(qty); - end; - dmXor: - while qty > 0 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNext); - inc(pdest); - dec(qty); - end; - dmSet: - while qty > 0 do - begin - pdest^ := GetNext; - inc(pdest); - dec(qty); - end; - dmSetExceptTransparent: - while qty > 0 do - begin - c := GetNext; - if c.alpha = 255 then pdest^ := c; - inc(pdest); - dec(qty); - end; - end; - end; -end; - -procedure TBGRASolidColorMaskScanner.ScanSkipPixels(ACount: integer); -begin - FMask.ScanSkipPixels(ACount); -end; - -procedure TBGRASolidColorMaskScanner.ScanMoveTo(X, Y: Integer); -begin - FMask.ScanMoveTo(X+FOffset.X,Y+FOffset.Y); -end; - -function TBGRASolidColorMaskScanner.ScanNextPixel: TBGRAPixel; -var - pMask: PByteMask; - stride, qty: integer; -begin - qty := 1; - FMask.ScanNextMaskChunk(qty,pMask,stride); - result := FSolidColor; - result.alpha := ApplyOpacity(result.alpha,pMask^.gray); -end; - -function TBGRASolidColorMaskScanner.ScanAt(X, Y: Single): TBGRAPixel; -var alpha: byte; -begin - alpha := FMask.ScanAtMask(X,Y).gray; - result := FSolidColor; - result.alpha := ApplyOpacity(result.alpha,alpha); -end; - -{ TBGRAOpacityScanner } - -constructor TBGRAOpacityScanner.Create(ATexture: IBGRAScanner; - AGlobalOpacity: Byte); -begin - FTexture := ATexture; - FScanNext := @FTexture.ScanNextPixel; - FScanAt := @FTexture.ScanAt; - FGlobalOpacity:= AGlobalOpacity; - FOwnedScanner := nil; -end; - -constructor TBGRAOpacityScanner.Create(ATexture: TBGRACustomScanner; - AGlobalOpacity: Byte; AOwned: boolean); -begin - FTexture := ATexture; - FScanNext := @FTexture.ScanNextPixel; - FScanAt := @FTexture.ScanAt; - FGlobalOpacity:= AGlobalOpacity; - if AOwned then - FOwnedScanner := ATexture - else - FOwnedScanner := nil; -end; - -destructor TBGRAOpacityScanner.Destroy; -begin - fillchar(FTexture,sizeof(FTexture),0); - FOwnedScanner.Free; - inherited Destroy; -end; - -function TBGRAOpacityScanner.IsScanPutPixelsDefined: boolean; -begin - Result:= true; -end; - -procedure TBGRAOpacityScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; - mode: TDrawMode); -var c: TBGRAPixel; - ptex: pbgrapixel; - - function GetNext: TBGRAPixel; inline; - begin - result := ptex^; - inc(ptex); - result.alpha := ApplyOpacity(result.alpha,FGlobalOpacity); - end; - -begin - if count > length(FMemTex) then setlength(FMemTex, max(length(FMemTex)*2,count)); - ScannerPutPixels(FTexture,@FMemTex[0],count,dmSet); - - ptex := @FMemTex[0]; - - case mode of - dmDrawWithTransparency: - while count > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest,GetNext); - inc(pdest); - dec(count); - end; - dmLinearBlend: - while count > 0 do - begin - FastBlendPixelInline(pdest,GetNext); - inc(pdest); - dec(count); - end; - dmXor: - while count > 0 do - begin - PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(GetNext); - inc(pdest); - dec(count); - end; - dmSet: - while count > 0 do - begin - pdest^ := GetNext; - inc(pdest); - dec(count); - end; - dmSetExceptTransparent: - while count > 0 do - begin - c := GetNext; - if c.alpha = 255 then pdest^ := c; - inc(pdest); - dec(count); - end; - end; -end; - -procedure TBGRAOpacityScanner.ScanSkipPixels(ACount: integer); -begin - FTexture.ScanSkipPixels(ACount); -end; - -procedure TBGRAOpacityScanner.ScanMoveTo(X, Y: Integer); -begin - FTexture.ScanMoveTo(X,Y); -end; - -function TBGRAOpacityScanner.ScanNextPixel: TBGRAPixel; -begin - result := FScanNext(); - result.alpha := ApplyOpacity(result.alpha, FGlobalOpacity ); -end; - -function TBGRAOpacityScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - result := FScanAt(X,Y); - result.alpha := ApplyOpacity(result.alpha, FGlobalOpacity ); -end; - -initialization - - Randomize; - -end. - diff --git a/components/bgrabitmap/bgragraphics.pas b/components/bgrabitmap/bgragraphics.pas deleted file mode 100644 index 8628bf0..0000000 --- a/components/bgrabitmap/bgragraphics.pas +++ /dev/null @@ -1,724 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAGraphics; -{=== Types imported from Graphics ===} -{$mode objfpc}{$H+} -{$I bgrabitmap.inc} - -interface - -{$IFDEF BGRABITMAP_USE_LCL} -uses Graphics, GraphType, FPImage, FPCanvas; - -type - PColor = Graphics.PColor; - TColor = Graphics.TColor; - TAntialiasingMode = Graphics.TAntialiasingMode; - TGradientDirection = Graphics.TGradientDirection; - TPenEndCap = Graphics.TPenEndCap; - TPenJoinStyle = Graphics.TPenJoinStyle; - TPenStyle = Graphics.TPenStyle; - TPenMode = Graphics.TPenMode; - -const - amDontCare = Graphics.amDontCare; - amOn = Graphics.amOn; - amOff = Graphics.amOff; - - gdVertical = Graphics.gdVertical; - gdHorizontal = Graphics.gdHorizontal; - - pecRound = Graphics.pecRound; - pecSquare = Graphics.pecSquare; - pecFlat = Graphics.pecFlat; - - pjsRound = Graphics.pjsRound; - pjsBevel = Graphics.pjsBevel; - pjsMiter = Graphics.pjsMiter; - - psSolid = Graphics.psSolid; - psDash = Graphics.psDash; - psDot = Graphics.psDot; - psDashDot = Graphics.psDashDot; - psDashDotDot = Graphics.psDashDotDot; - psClear = Graphics.psClear; - psInsideframe = Graphics.psInsideframe; - psPattern = Graphics.psPattern; - - pmBlack = Graphics.pmBlack; - pmWhite = Graphics.pmWhite; - pmNop = Graphics.pmNop; - pmNot = Graphics.pmNot; - pmCopy = Graphics.pmCopy; - pmNotCopy = Graphics.pmNotCopy; - pmMergePenNot = Graphics.pmMergePenNot; - pmMaskPenNot = Graphics.pmMaskPenNot; - pmMergeNotPen = Graphics.pmMergeNotPen; - pmMaskNotPen = Graphics.pmMaskNotPen; - pmMerge = Graphics.pmMerge; - pmNotMerge = Graphics.pmNotMerge; - pmMask = Graphics.pmMask; - pmNotMask = Graphics.pmNotMask; - pmXor = Graphics.pmXor; - pmNotXor = Graphics.pmNotXor; - - tmAuto = Graphics.tmAuto; - tmFixed = Graphics.tmFixed; - -type - TPen = Graphics.TPen; - TTextLayout = Graphics.TTextLayout; - TTextStyle = Graphics.TTextStyle; - - TFillStyle = Graphics.TFillStyle; - TFillMode = Graphics.TFillMode; - TBrushStyle = Graphics.TBrushStyle; - -const - tlTop = Graphics.tlTop; - tlCenter = Graphics.tlCenter; - tlBottom = Graphics.tlBottom; - - fsSurface = GraphType.fsSurface; - fsBorder = GraphType.fsBorder; - - fmAlternate = Graphics.fmAlternate; - fmWinding = Graphics.fmWinding; - - bsSolid = Graphics.bsSolid; - bsClear = Graphics.bsClear; - bsHorizontal = Graphics.bsHorizontal; - bsVertical = Graphics.bsVertical; - bsFDiagonal = Graphics.bsFDiagonal; - bsBDiagonal = Graphics.bsBDiagonal; - bsCross = Graphics.bsCross; - bsDiagCross = Graphics.bsDiagCross; - bsImage = FPCanvas.bsImage; - -type - TBrush = Graphics.TBrush; - TCanvas = Graphics.TCanvas; - TGraphic = Graphics.TGraphic; - TRawImage = GraphType.TRawImage; - TBitmap = Graphics.TBitmap; - - TRasterImage = Graphics.TRasterImage; - - TFontStyle = Graphics.TFontStyle; - TFontStyles = Graphics.TFontStyles; - TFontQuality = Graphics.TFontQuality; - -type - TFont = Graphics.TFont; - -const - fsBold = Graphics.fsBold; - fsItalic = Graphics.fsItalic; - fsStrikeOut = Graphics.fsStrikeOut; - fsUnderline = Graphics.fsUnderline; - - fqDefault = Graphics.fqDefault; - fqDraft = Graphics.fqDraft; - fqProof = Graphics.fqProof; - fqNonAntialiased = Graphics.fqNonAntialiased; - fqAntialiased = Graphics.fqAntialiased; - fqCleartype = Graphics.fqCleartype; - fqCleartypeNatural = Graphics.fqCleartypeNatural; - - clNone = Graphics.clNone; - - clBlack = Graphics.clBlack; - clMaroon = Graphics.clMaroon; - clGreen = Graphics.clGreen; - clOlive = Graphics.clOlive; - clNavy = Graphics.clNavy; - clPurple = Graphics.clPurple; - clTeal = Graphics.clTeal; - clGray = Graphics.clGray; - clSilver = Graphics.clSilver; - clRed = Graphics.clRed; - clLime = Graphics.clLime; - clYellow = Graphics.clYellow; - clBlue = Graphics.clBlue; - clFuchsia = Graphics.clFuchsia; - clAqua = Graphics.clAqua; - clLtGray = Graphics.clLtGray; // clSilver alias - clDkGray = Graphics.clDkGray; // clGray alias - clWhite = Graphics.clWhite; - -function FPColorToTColor(const FPColor: TFPColor): TColor; inline; -function TColorToFPColor(const c: TColor): TFPColor; inline; -function ColorToRGB(c: TColor): TColor; inline; -function RGBToColor(R, G, B: Byte): TColor; inline; -procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); inline;// does not work on system color -function clRgbBtnHighlight: TColor; -function clRgbBtnShadow: TColor; - -implementation - -function FPColorToTColor(const FPColor: TFPColor): TColor; -begin - result := Graphics.FPColorToTColor(FPColor); -end; - -function TColorToFPColor(const c: TColor): TFPColor; -begin - result := Graphics.TColorToFPColor(c); -end; - -function ColorToRGB(c: TColor): TColor; -begin - result := Graphics.ColorToRGB(c); -end; - -function RGBToColor(R, G, B: Byte): TColor; -begin - result := Graphics.RGBToColor(R, G, B); -end; - -procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); -begin - Graphics.RedGreenBlue(rgb, Red, Green, Blue); -end; - -function clRgbBtnHighlight: TColor; -begin - result := Graphics.ColorToRGB(clBtnHighlight); -end; - -function clRgbBtnShadow: TColor; -begin - result := Graphics.ColorToRGB(clBtnShadow); -end; - -{$ELSE} - -{$IFDEF BGRABITMAP_USE_MSEGUI} - {$i bgramsegui_uses.inc} -{$ELSE} - {$IFDEF BGRABITMAP_USE_FPGUI} - {$i bgrafpgui_uses.inc} - {$ELSE} - {$i bgranogui_uses.inc} - {$ENDIF} -{$ENDIF} - -type - TTransparentMode = (tmAuto, tmFixed); - TGraphic = class; - -{$DEFINE INCLUDE_INTERFACE} -{$IFDEF BGRABITMAP_USE_MSEGUI} - {$i bgramsegui.inc} -{$ELSE} - {$IFDEF BGRABITMAP_USE_FPGUI} - {$i bgrafpgui.inc} - {$ELSE} - {$i bgranogui.inc} - {$ENDIF} -{$ENDIF} - -type - {* Pointer to a ''TColor'' value } - PColor = ^TColor; - {* Contains a color stored as RGB. The red/green/blue values - range from 0 to 255. The formula to get the color value is: - * ''color'' = ''red'' + (''green'' '''shl''' 8) + (''blue'' '''shl''' 16) - *except with fpGUI where it is: - * ''color'' = (''red'' '''shl''' 16) + (''green'' '''shl''' 8) + ''blue'' }{import - TColor = Int32; - } - {** Converts a ''TFPColor'' into a ''TColor'' value } - function FPColorToTColor(const FPColor: TFPColor): TColor; - {** Converts a ''TColor'' into a ''TFPColor'' value } - function TColorToFPColor(const c: TColor): TFPColor; - - function RGBToColor(R, G, B: Byte): TColor; inline; - procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); // does not work on system color - -type - {* Direction of change in a gradient } - TGradientDirection = ( - {** Color changes vertically } - gdVertical, - {** Color changes horizontally } - gdHorizontal); - - {* Antialiasing mode for a Canvas } - TAntialiasingMode = ( - {** It does not matter if there is antialiasing or not } - amDontCare, - {** Antialiasing is required (BGRACanvas provide it) } - amOn, - {** Antialiasing is disabled } - amOff); - -type - {* Vertical position of a text } - TTextLayout = (tlTop, tlCenter, tlBottom); - {* Styles to describe how a text is drawn in a rectangle } - TTextStyle = packed record - {** Horizontal alignment } - Alignment : TAlignment; - - {** Vertical alignment } - Layout : TTextLayout; - - {** If WordBreak is false then process #13, #10 as - standard chars and perform no Line breaking } - SingleLine: boolean; - - {** Clip Text to passed Rectangle } - Clipping : boolean; - - {** Replace #9 by apropriate amount of spaces (default is usually 8) } - ExpandTabs: boolean; - - {** Process first single '&' per line as an underscore and draw '&&' as '&' } - ShowPrefix: boolean; - - {** If line of text is too long too fit between left and right boundaries - try to break into multiple lines between words. See also ''EndEllipsis'' } - Wordbreak : boolean; - - {** Fills background with current brush } - Opaque : boolean; - - {** Use the system font instead of canvas font } - SystemFont: Boolean; - - {** For RightToLeft text reading (Text Direction) } - RightToLeft: Boolean; - - {** If line of text is too long to fit between left and right boundaries - truncates the text and adds "...". If Wordbreak is set as well, - Workbreak will dominate } - EndEllipsis: Boolean; - end; - - {* Option for floodfill (used in BGRACanvas) } - TFillStyle = - ( - {** Fill up to the color (it fills all except the specified color) } - fsSurface, - {** Fill the specified color (it fills only connected pixels of this color) } - fsBorder - ); - {* How to handle polygons that intersect with themselves and - overlapping polygons } - TFillMode = ( - {** Each time a boundary is found, it enters or exit the filling zone } - fmAlternate, - {** Adds or subtract 1 depending on the order of the points of the - polygons (clockwise or counter clockwise) and fill when the - result is non-zero. So, to draw a hole, you must specify the points - of the hole in the opposite order } - fmWinding); - -type - {$IFNDEF TFontStyle} - {* Available font styles } - TFontStyle = ( - {** Font is bold } - fsBold, - {** Font is italic } - fsItalic, - {** An horizontal line is drawn in the middle of the text } - fsStrikeOut, - {** Text is underlined } - fsUnderline); - {** A combination of font styles } - TFontStyles = set of TFontStyle; - {$ENDIF} - {$IFNDEF TFontQuality} - {* Quality to use when font is rendered by the system } - TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqCleartype, fqCleartypeNatural); - {$ENDIF} - - {$IFNDEF TCanvas} - { TCanvas } - {* A surface on which to draw } - TCanvas = class - protected - FCanvas: TGUICanvas; - public - constructor Create(ACanvas: TGUICanvas); - {** Draw an image with top-left corner at (''x'',''y'') } - procedure Draw(x,y: integer; AImage: TGraphic); - {** Draw and stretch an image within the rectangle ''ARect'' } - procedure StretchDraw(ARect: TRect; AImage: TGraphic); - property GUICanvas: TGUICanvas read FCanvas; - end; - {$ENDIF} - - { TGraphic } - {* A class containing any element that can be drawn within rectangular bounds } - TGraphic = class(TPersistent) - protected - procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract; - function GetEmpty: Boolean; virtual; abstract; - function GetHeight: Integer; virtual; abstract; - function GetWidth: Integer; virtual; abstract; - function GetTransparent: Boolean; virtual; abstract; - procedure SetTransparent(Value: Boolean); virtual; abstract; - procedure SetHeight(Value: Integer); virtual; abstract; - procedure SetWidth(Value: Integer); virtual; abstract; - function GetMimeType: string; virtual; - public - constructor Create; virtual; - {** Load the content from a given file } - procedure LoadFromFile({%H-}const Filename: string); virtual; - {** Load the content from a given stream } - procedure LoadFromStream(Stream: TStream); virtual; abstract; - {** Saves the content to a file } - procedure SaveToFile({%H-}const Filename: string); virtual; - {** Saves the content into a given stream } - procedure SaveToStream(Stream: TStream); virtual; abstract; - {** Returns the list of possible file extensions } - class function GetFileExtensions: string; virtual; - {** Clears the content } - procedure Clear; virtual; - public - {** Returns if the content is completely empty } - property Empty: Boolean read GetEmpty; - {** Returns the height of the bounding rectangle } - property Height: Integer read GetHeight write SetHeight; - {** Returns the width of the bounding rectangle } - property Width: Integer read GetWidth write SetWidth; - {** Gets or sets if it is drawn with transparency } - property Transparent: Boolean read GetTransparent write SetTransparent; - end; - - {$IFNDEF TBitmap} - { TBitmap } - {* Contains a bitmap } - TBitmap = class(TGraphic) - private - FHeight: integer; - FWidth: integer; - FInDraw: boolean; - FTransparent: boolean; - FTransparentColor: TColor; - FTransparentMode: TTransparentMode; - function GetCanvas: TCanvas; - function GetRawImage: TRawImage; - procedure SetTransparentColor(AValue: TColor); - procedure SetTransparentMode(AValue: TTransparentMode); - protected - FRawImage: TRawImage; - procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; - procedure Changed(Sender: TObject); virtual; - function GetHeight: Integer; override; - function GetWidth: Integer; override; - procedure SetHeight(Value: Integer); override; - procedure SetWidth(Value: Integer); override; - function GetEmpty: Boolean; override; - function GetTransparent: Boolean; override; - procedure SetTransparent({%H-}Value: Boolean); override; - function GetMimeType: string; override; - public - constructor Create; override; - destructor Destroy; override; - procedure LoadFromStream({%H-}Stream: TStream); override; - procedure SaveToStream({%H-}Stream: TStream); override; - {** Width of the bitmap in pixels } - property Width: integer read GetWidth write SetWidth; - {** Height of the bitmap in pixels } - property Height: integer read GetHeight write SetHeight; - property RawImage: TRawImage read GetRawImage; - property Canvas: TCanvas read GetCanvas; - property TransparentColor: TColor read FTransparentColor - write SetTransparentColor default clDefault; - property TransparentMode: TTransparentMode read FTransparentMode - write SetTransparentMode default tmAuto; - end; - {$ENDIF} - -{* Multiply and divide the number allowing big intermediate number and rounding the result } -function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; -{* Round the number using math convention } -function MathRound(AValue: ValReal): Int64; inline; - -{$IFDEF BGRABITMAP_USE_FPCANVAS} -{$DEFINE INCLUDE_INTERFACE} -{$i bgrafpcanvas.inc} -{$ENDIF} - -implementation - -uses sysutils, BGRAUTF8; - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$IFDEF BGRABITMAP_USE_MSEGUI} - {$i bgramsegui.inc} -{$ELSE} - {$IFDEF BGRABITMAP_USE_FPGUI} - {$i bgrafpgui.inc} - {$ELSE} - {$i bgranogui.inc} - {$ENDIF} -{$ENDIF} - -function MathRound(AValue: ValReal): Int64; inline; -begin - if AValue >= 0 then - Result := Trunc(AValue + 0.5) - else - Result := Trunc(AValue - 0.5); -end; - -function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; -begin - if nDenominator = 0 then - Result := -1 - else - Result := MathRound(int64(nNumber) * int64(nNumerator) / nDenominator); -end; - -function FPColorToTColor(const FPColor: TFPColor): TColor; -begin - {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} - Result:=((FPColor.Blue shr 8) and $ff) - or (FPColor.Green and $ff00) - or ((FPColor.Red shl 8) and $ff0000); - {$ELSE} - Result:=((FPColor.Red shr 8) and $ff) - or (FPColor.Green and $ff00) - or ((FPColor.Blue shl 8) and $ff0000); - {$ENDIF} -end; - -function TColorToFPColor(const c: TColor): TFPColor; -begin - {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} - Result.Blue:=(c and $ff); - Result.Blue:=Result.Blue+(Result.Blue shl 8); - Result.Green:=(c and $ff00); - Result.Green:=Result.Green+(Result.Green shr 8); - Result.Red:=(c and $ff0000) shr 8; - Result.Red:=Result.Red+(Result.Red shr 8); - {$ELSE} - Result.Red:=(c and $ff); - Result.Red:=Result.Red+(Result.Red shl 8); - Result.Green:=(c and $ff00); - Result.Green:=Result.Green+(Result.Green shr 8); - Result.Blue:=(c and $ff0000) shr 8; - Result.Blue:=Result.Blue+(Result.Blue shr 8); - {$ENDIF} - Result.Alpha:=FPImage.alphaOpaque; -end; - -procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); -begin - {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} - Blue := rgb and $000000ff; - Green := (rgb shr 8) and $000000ff; - Red := (rgb shr 16) and $000000ff; - {$ELSE} - Red := rgb and $000000ff; - Green := (rgb shr 8) and $000000ff; - Blue := (rgb shr 16) and $000000ff; - {$ENDIF} -end; - -function RGBToColor(R, G, B: Byte): TColor; -begin - {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE} - Result := (R shl 16) or (G shl 8) or B; - {$ELSE} - Result := (B shl 16) or (G shl 8) or R; - {$ENDIF} -end; - -{ TGraphic } - -function TGraphic.GetMimeType: string; -begin - result := ''; -end; - -constructor TGraphic.Create; -begin - //nothing -end; - -procedure TGraphic.LoadFromFile(const Filename: string); -var - Stream: TStream; -begin - Stream := TFileStreamUTF8.Create(Filename, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TGraphic.SaveToFile(const Filename: string); -var - Stream: TStream; -begin - Stream := TFileStreamUTF8.Create(Filename, fmCreate); - try - SaveToStream(Stream); - finally - Stream.Free; - end; -end; - -class function TGraphic.GetFileExtensions: string; -begin - result := ''; -end; - -procedure TGraphic.Clear; -begin - //nothing -end; - -{$IFNDEF TCanvas} -{ TCanvas } - -constructor TCanvas.Create(ACanvas: TGUICanvas); -begin - FCanvas := ACanvas; -end; - -procedure TCanvas.Draw(x, y: integer; AImage: TGraphic); -begin - if AImage is TBitmap then - FCanvas.DrawImage(x,y, TBitmap(AImage).RawImage) - else - AImage.Draw(self, rect(x,y,x+AImage.Width,y+AImage.Height)); -end; - -procedure TCanvas.StretchDraw(ARect: TRect; AImage: TGraphic); -begin - if AImage is TBitmap then - FCanvas.StretchDraw(ARect.Left,ARect.Top,ARect.Right-ARect.Left,ARect.Bottom-ARect.Top, TBitmap(AImage).RawImage) - else - AImage.Draw(self, ARect); -end; -{$ENDIF} - -{$IFNDEF TBitmap} -{ TBitmap } - -procedure TBitmap.SetWidth(Value: Integer); -begin - if FWidth=Value then Exit; - FWidth:=Value; -end; - -function TBitmap.GetEmpty: Boolean; -begin - result := (Width = 0) or (Height = 0); -end; - -function TBitmap.GetTransparent: Boolean; -begin - result := FTransparent; -end; - -procedure TBitmap.SetTransparent(Value: Boolean); -begin - if Value = FTransparent then exit; - FTransparent:= Value; -end; - -procedure TBitmap.SetTransparentColor(AValue: TColor); -begin - if FTransparentColor = AValue then exit; - FTransparentColor := AValue; - - if AValue = clDefault - then FTransparentMode := tmAuto - else FTransparentMode := tmFixed; -end; - -procedure TBitmap.SetTransparentMode(AValue: TTransparentMode); -begin - if AValue = TransparentMode then exit; - FTransparentMode := AValue; - - if AValue = tmAuto - then TransparentColor := clDefault -end; - -function TBitmap.GetMimeType: string; -begin - Result:= 'image/bmp'; -end; - -procedure TBitmap.Changed(Sender: TObject); -begin - //nothing -end; - -procedure TBitmap.LoadFromStream(Stream: TStream); -begin - raise exception.Create('Not implemented'); -end; - -procedure TBitmap.SaveToStream(Stream: TStream); -begin - raise exception.Create('Not implemented'); -end; - -procedure TBitmap.SetHeight(Value: Integer); -begin - if FHeight=Value then Exit; - FHeight:=Value; -end; - -function TBitmap.GetRawImage: TRawImage; -begin - FRawImage.BGRASetSizeAndTransparency(FWidth, FHeight, FTransparent); - result := FRawImage; -end; - -procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect); -begin - if FInDraw then exit; - FInDraw := true; - ACanvas.StretchDraw(Rect, self); - FInDraw := false; -end; - -function TBitmap.GetHeight: Integer; -begin - result := FHeight; -end; - -function TBitmap.GetWidth: Integer; -begin - result := FWidth; -end; - -function TBitmap.GetCanvas: TCanvas; -begin - result := nil; - raise exception.Create('Canvas not available'); -end; - -constructor TBitmap.Create; -begin - FRawImage := TRawImage.Create; - FTransparent:= false; -end; - -destructor TBitmap.Destroy; -begin - FRawImage.Free; - inherited Destroy; -end; -{$ENDIF} - -{$IFDEF BGRABITMAP_USE_FPCANVAS} -{$DEFINE INCLUDE_IMPLEMENTATION} -{$i bgrafpcanvas.inc} -{$ENDIF} - -{$ENDIF} - -end. - diff --git a/components/bgrabitmap/bgragrayscalemask.pas b/components/bgrabitmap/bgragrayscalemask.pas deleted file mode 100644 index 15ce756..0000000 --- a/components/bgrabitmap/bgragrayscalemask.pas +++ /dev/null @@ -1,1450 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAGrayscaleMask; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, BGRAGraphics, SysUtils, BGRABitmapTypes, BGRAResample, {%H-}UniversalDrawer; - -type - { TGrayscaleMask } - - TGrayscaleMask = class(specialize TGenericUniversalBitmap) - private - function GetScanLine(Y: Integer): PByte; inline; - protected - function InternalNew: TCustomUniversalBitmap; override; - procedure AssignTransparentPixel(out ADest); override; - function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TByteMask; - function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TByteMask; - procedure Init; override; - public - ScanInterpolationFilter: TResampleFilter; - - constructor Create(AWidth,AHeight: Integer; AValue: byte); overload; - constructor Create(ABitmap: TBGRACustomBitmap; AChannel: TChannel); overload; - constructor CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer); - constructor CreateDownSample(ABitmap: TGrayscaleMask; AWidth,AHeight: integer); - constructor CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer; ASourceRect: TRect); - constructor CreateDownSample(ABitmap: TGrayscaleMask; AWidth,AHeight: integer; ASourceRect: TRect); - procedure CopyFrom(ABitmap: TGrayscaleMask); overload; - procedure CopyFrom(ABitmap: TBGRACustomBitmap; AChannel: TChannel); overload; - procedure CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); override; - function GetImageBounds: TRect; overload; override; - function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; override; - function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; override; - - class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TByteMask; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - - procedure Draw(ABitmap: TBGRACustomBitmap; X,Y: Integer; AGammaCorrection: boolean = false); - procedure DrawAsAlpha(ABitmap: TBGRACustomBitmap; X,Y: Integer; const c: TBGRAPixel); overload; - procedure DrawAsAlpha(ABitmap: TBGRACustomBitmap; X,Y: Integer; texture: IBGRAScanner); overload; - function GetPixel(X,Y: integer): byte; overload; - procedure SetPixel(X,Y: integer; AValue: byte); - property ScanLine[Y: Integer]: PByte read GetScanLine; - property Data: PByte read FDataByte; - - function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TByteMask; overload; - function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TByteMask; - - procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); override; - function ScanAtIntegerMask(X,Y: integer): TByteMask; override; - function ScanAtMask(X,Y: Single): TByteMask; override; - function ScanAtInteger(X, Y: integer): TBGRAPixel; override; - function ScanAt(X, Y: Single): TBGRAPixel; override; - - {inplace filters} - procedure Negative; - procedure NegativeRect(ABounds: TRect); - procedure InplaceNormalize; overload; - procedure InplaceNormalize(ABounds: TRect); overload; - - //return type helpers - function NewBitmap: TGrayscaleMask; overload; override; - function NewBitmap(AWidth, AHeight: integer): TGrayscaleMask; overload; override; - function NewBitmap(AWidth, AHeight: integer; const Color: TByteMask): TGrayscaleMask; overload; override; - function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TGrayscaleMask; overload; override; - function NewReference: TGrayscaleMask; override; - function GetUnique: TGrayscaleMask; override; - function Duplicate(DuplicateProperties: Boolean = False): TGrayscaleMask; overload; override; - function GetPart(const ARect: TRect): TGrayscaleMask; override; - function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TByteMask; - AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TGrayscaleMask; override; - function RotateCW: TGrayscaleMask; override; - function RotateCCW: TGrayscaleMask; override; - function RotateUD: TGrayscaleMask; override; - function FilterContour(ABorderValue: byte = 0): TGrayscaleMask; - function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; - function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; - function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; - function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override; - function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TGrayscaleMask; overload; override; - function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TGrayscaleMask; overload; override; - function FilterCustomBlur(mask: TCustomUniversalBitmap): TGrayscaleMask; overload; override; - function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TGrayscaleMask; overload; override; - function FilterSphere: TGrayscaleMask; - function FilterCylinder: TGrayscaleMask; - end; - -procedure DownSamplePutImageGrayscale(sourceData: PByte; sourcePixelSize: Int32or64; sourceRowDelta: Int32or64; sourceWidth, sourceHeight: Int32or64; dest: TGrayscaleMask; ADestRect: TRect); overload; -procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; dest: TGrayscaleMask; ADestRect: TRect); overload; -procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect); overload; -procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); overload; -procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); overload; - -procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x, - y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; - texture: IBGRAScanner; RGBOrder: boolean); - -const - ByteMaskBlack : TByteMask = (gray:0); - ByteMaskWhite : TByteMask = (gray:255); - -operator = (const c1, c2: TByteMask): boolean; inline; - -implementation - -uses BGRABlend, BGRATransform; - -operator = (const c1, c2: TByteMask): boolean; -begin - result := c1.gray = c2.gray; -end; - -procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x, - y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; - texture: IBGRAScanner; RGBOrder: boolean); -var delta: Int32or64; -begin - delta := mask.Width; - BGRABlend.BGRAFillClearTypeMaskPtr(dest,x,y,xThird,mask.ScanLineByte[0],1,delta,mask.Width,mask.Height,color,texture,RGBOrder); -end; - -procedure ByteMaskSolidBrushSkipPixels({%H-}AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -begin - inc(PByteMask(AContextData^.Dest), ACount); -end; - -procedure ByteMaskChunkSetPixels( - ASource: PByteMask; ADest: PByteMask; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - if ASourceStride = 1 then - begin - move(ASource^, ADest^, ACount); - inc(ASource, ACount); - end else - while ACount > 0 do - begin - ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - ADest^.gray := (ADest^.gray*UInt32or64(65536-alphaOver) + ASource^.gray*alphaOver + 32768) shr 16; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure ByteMaskChunkXorPixels( - ASource: PByteMask; ADest: PByteMask; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; - temp: Byte; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - if ASourceStride = 1 then - begin - move(ASource^, ADest^, ACount); - inc(ASource, ACount); - end else - while ACount > 0 do - begin - ADest^.gray := ADest^.gray xor ASource^.gray; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - temp := ADest^.gray xor ASource^.gray; - ADest^.gray := (ADest^.gray*UInt32or64(65536-alphaOver) + temp*alphaOver + 32768) shr 16; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure ByteMaskSolidBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PByteMask; -begin - pDest := PByteMask(AContextData^.Dest); - ByteMaskChunkSetPixels( PByteMask(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -procedure ByteMaskSolidBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PByteMask; -begin - pDest := PByteMask(AContextData^.Dest); - ByteMaskChunkXorPixels( PByteMask(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -type - PByteMaskScannerBrushFixedData = ^TByteMaskScannerBrushFixedData; - TByteMaskScannerBrushFixedData = record - Scanner: Pointer; //avoid ref count by using pointer type - OffsetX, OffsetY: integer; - Conversion: TBridgedConversion; - end; - -procedure ByteMaskScannerBrushInitContext(AFixedData: Pointer; - AContextData: PUniBrushContext); -begin - with PByteMaskScannerBrushFixedData(AFixedData)^ do - IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, - AContextData^.Ofs.Y + OffsetY); -end; - -procedure ByteMaskScannerConvertBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PByteMask; - qty, pixSize: Integer; - buf: packed array[0..31] of TByteMask; -begin - with PByteMaskScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PByteMask(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PByteMask(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TByteMask), nil); - ByteMaskChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TByteMask) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ByteMaskScannerConvertBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PByteMask; - qty, pixSize: Integer; - buf: packed array[0..31] of TByteMask; -begin - with PByteMaskScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PByteMask(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PByteMask(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TByteMask), nil); - ByteMaskChunkXorPixels(@buf, pDest, AAlpha, qty, sizeof(TByteMask) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ByteMaskScannerChunkBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PByteMask; - qty: Integer; -begin - with PByteMaskScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PByteMask(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PByteMask(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - ByteMaskChunkSetPixels(PByteMask(psrc), pDest, AAlpha, qty, sizeof(TByteMask) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ByteMaskScannerChunkBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PByteMask; - qty: Integer; -begin - with PByteMaskScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PByteMask(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PByteMask(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - ByteMaskChunkXorPixels(PByteMask(psrc), pDest, AAlpha, qty, sizeof(TByteMask) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ByteMaskMaskBrushApply(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PByteMask; - qty, maskStride: Integer; - pMask: PByteMask; - factor: UInt32or64; -begin - with PByteMaskScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PByteMask(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PByteMask(AContextData^.Dest); - if AAlpha = 65535 then - begin - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.gray := ApplyOpacity(pDest^.gray, pMask^.gray); - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end else - begin - factor := AAlpha + (AAlpha shr 8) + (AAlpha shr 14); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.gray := (pDest^.gray*((factor*pMask^.gray+128) shr 8)) shr 16; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end; - PByteMask(AContextData^.Dest) := pDest; - end; -end; - -procedure ByteMaskBrushErasePixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PByteMask; - alphaMul,eraseMul: UInt32or64; -begin - pDest := PByteMask(AContextData^.Dest); - if AAlpha>=32768 then alphaMul := AAlpha+1 else alphaMul := AAlpha; - eraseMul := PWord(AFixedData)^; - if eraseMul>=32768 then inc(eraseMul); - eraseMul := 65536 - (eraseMul*alphaMul shr 16); - while ACount > 0 do - begin - pDest^.gray:= pDest^.gray*eraseMul shr 16; - dec(ACount); - inc(pDest); - end; - AContextData^.Dest := pDest; -end; - -{ TGrayscaleMask } - -function TGrayscaleMask.InternalNew: TCustomUniversalBitmap; -begin - Result:= TGrayscaleMask.Create; -end; - -procedure TGrayscaleMask.AssignTransparentPixel(out ADest); -begin - TByteMask(ADest).gray := 0; -end; - -function TGrayscaleMask.InternalGetPixelCycle256(ix, iy: int32or64; iFactX, - iFactY: int32or64): TByteMask; -var - ixMod2: int32or64; - pUpLeft, pUpRight, pDownLeft, pDownRight: PByteMask; - scan: PByteMask; -begin - scan := GetScanlineFast(iy); - - pUpLeft := (scan + ix); - ixMod2 := ix+1; - if ixMod2=Width then ixMod2 := 0; - pUpRight := (scan + ixMod2); - - Inc(iy); - if iy = Height then iy := 0; - scan := GetScanlineFast(iy); - pDownLeft := (scan + ix); - pDownRight := (scan + ixMod2); - - InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft, - pDownRight, iFactX, iFactY, @result); -end; - -function TGrayscaleMask.InternalGetPixel256(ix, iy: int32or64; iFactX, - iFactY: int32or64; smoothBorder: boolean): TByteMask; -var - pUpLeft, pUpRight, pDownLeft, pDownRight: PByteMask; - scan: PByteMask; -begin - if (iy >= 0) and (iy < FHeight) then - begin - scan := GetScanlineFast(iy); - - if (ix >= 0) and (ix < FWidth) then - pUpLeft := scan+ix - else if smoothBorder then - pUpLeft := @ByteMaskBlack - else - pUpLeft := nil; - - if (ix+1 >= 0) and (ix+1 < FWidth) then - pUpRight := scan+(ix+1) - else if smoothBorder then - pUpRight := @ByteMaskBlack - else - pUpRight := nil; - end else - if smoothBorder then - begin - pUpLeft := @ByteMaskBlack; - pUpRight := @ByteMaskBlack; - end else - begin - pUpLeft := nil; - pUpRight := nil; - end; - - if (iy+1 >= 0) and (iy+1 < FHeight) then - begin - scan := GetScanlineFast(iy+1); - - if (ix >= 0) and (ix < FWidth) then - pDownLeft := scan+ix - else if smoothBorder then - pDownLeft := @ByteMaskBlack - else - pDownLeft := nil; - - if (ix+1 >= 0) and (ix+1 < FWidth) then - pDownRight := scan+(ix+1) - else if smoothBorder then - pDownRight := @ByteMaskBlack - else - pDownRight := nil; - end else - if smoothBorder then - begin - pDownLeft := @ByteMaskBlack; - pDownRight := @ByteMaskBlack; - end else - begin - pDownLeft := nil; - pDownRight := nil; - end; - - InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft, - pDownRight, iFactX, iFactY, @result); -end; - -procedure TGrayscaleMask.Init; -begin - inherited Init; - ScanInterpolationFilter := rfLinear; -end; - -function TGrayscaleMask.GetScanLine(Y: Integer): PByte; -begin - result := PByte(GetScanLineByte(y)); -end; - -procedure TGrayscaleMask.CopyFrom(ABitmap: TBGRACustomBitmap; AChannel: TChannel); -var psrc: PByte; - pdest: PByte; - x,y: integer; - ofs: Int32or64; -begin - SetSize(ABitmap.Width, ABitmap.Height); - if NbPixels > 0 then - begin - pdest := DataByte; - ofs := TBGRAPixel_ChannelByteOffset[AChannel]; - for y := 0 to FHeight-1 do - begin - psrc := PByte(ABitmap.ScanLine[y])+ofs; - for x := FWidth-1 downto 0 do - begin - pdest^ := psrc^; - inc(pdest); - inc(psrc,sizeof(TBGRAPixel)); - end; - end; - end; -end; - -procedure TGrayscaleMask.CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); -begin - inherited CopyPropertiesTo(ABitmap); - if ABitmap is TGrayscaleMask then - begin - TGrayscaleMask(ABitmap).ScanInterpolationFilter:= self.ScanInterpolationFilter; - end; -end; - -function TGrayscaleMask.GetImageBounds: TRect; -begin - Result:= GetImageBounds(cGreen); -end; - -function TGrayscaleMask.GetImageBoundsWithin(const ARect: TRect; - Channel: TChannel; ANothingValue: Byte): TRect; -var - minx, miny, maxx, maxy: integer; - xb, xb2, yb: integer; - p: PByte; - actualRect: TRect; -begin - if Channel = cAlpha then raise exception.Create('Channel not found'); - actualRect := TRect.Intersect(ARect,rect(0,0,self.Width,self.Height)); - maxx := actualRect.Left-1; - maxy := actualRect.Top-1; - minx := actualRect.Right; - miny := actualRect.Bottom; - for yb := actualRect.Top to actualRect.Bottom-1 do - begin - p := GetPixelAddress(actualRect.Left,yb); - for xb := actualRect.Left to actualRect.Right - 1 do - begin - if p^<>ANothingValue then - begin - if xb < minx then minx := xb; - if yb < miny then miny := yb; - if xb > maxx then maxx := xb; - if yb > maxy then maxy := yb; - - inc(p, actualRect.Right-1-xb); - for xb2 := actualRect.Right-1 downto xb+1 do - begin - if p^ <> ANothingValue then - begin - if xb2 > maxx then maxx := xb2; - break; - end; - dec(p); - end; - break; - end; - Inc(p); - end; - end; - if minx > maxx then - begin - Result.left := 0; - Result.top := 0; - Result.right := 0; - Result.bottom := 0; - end - else - begin - Result.left := minx; - Result.top := miny; - Result.right := maxx + 1; - Result.bottom := maxy + 1; - end; -end; - -function TGrayscaleMask.GetImageBoundsWithin(const ARect: TRect; - Channels: TChannels; ANothingValue: Byte): TRect; -begin - if cAlpha in Channels then raise exception.Create('Channel not found') - else if Channels = [] then result := EmptyRect - else result := GetImageBoundsWithin(ARect, cGreen, ANothingValue); -end; - -class procedure TGrayscaleMask.SolidBrush(out ABrush: TUniversalBrush; - const AColor: TByteMask; ADrawMode: TDrawMode); -begin - ABrush.Colorspace := TByteMaskColorspace; - PByteMask(@ABrush.FixedData)^ := AColor; - if ADrawMode <> dmXor then - ABrush.InternalPutNextPixels:= @ByteMaskSolidBrushSetPixels - else - ABrush.InternalPutNextPixels:= @ByteMaskSolidBrushXorPixels; -end; - -class procedure TGrayscaleMask.ScannerBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; ADrawMode: TDrawMode; AOffsetX: integer; - AOffsetY: integer); -var - sourceSpace: TColorspaceAny; -begin - ABrush.Colorspace:= TByteMaskColorspace; - with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @ByteMaskScannerBrushInitContext; - sourceSpace := AScanner.GetScanCustomColorspace; - if sourceSpace = TByteMaskColorspace then - begin - if ADrawMode <> dmXor then - ABrush.InternalPutNextPixels:= @ByteMaskScannerChunkBrushSetPixels - else - ABrush.InternalPutNextPixels:= @ByteMaskScannerChunkBrushXorPixels; - end else - begin - with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do - Conversion := sourceSpace.GetBridgedConversion(TByteMaskColorspace); - if ADrawMode <> dmXor then - ABrush.InternalPutNextPixels:= @ByteMaskScannerConvertBrushSetPixels - else - ABrush.InternalPutNextPixels:= @ByteMaskScannerConvertBrushXorPixels; - end; -end; - -class procedure TGrayscaleMask.MaskBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); -begin - ABrush.Colorspace:= TByteMaskColorspace; - with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @ByteMaskScannerBrushInitContext; - ABrush.InternalPutNextPixels:= @ByteMaskMaskBrushApply; -end; - -class procedure TGrayscaleMask.EraseBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - ABrush.Colorspace := TByteMaskColorspace; - PWord(@ABrush.FixedData)^ := AAlpha; - ABrush.InternalPutNextPixels:= @ByteMaskBrushErasePixels; -end; - -class procedure TGrayscaleMask.AlphaBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - ABrush.Colorspace := TByteMaskColorspace; - PWord(@ABrush.FixedData)^ := not AAlpha; - ABrush.InternalPutNextPixels:= @ByteMaskBrushErasePixels; -end; - -constructor TGrayscaleMask.Create(AWidth, AHeight: Integer; AValue: byte); -begin - inherited Create(AWidth, AHeight, TByteMask.New(AValue)); -end; - -constructor TGrayscaleMask.Create(ABitmap: TBGRACustomBitmap; AChannel: TChannel); -begin - inherited Create(0,0); - CopyFrom(ABitmap, AChannel); -end; - -constructor TGrayscaleMask.CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth, - AHeight: integer); -begin - CreateDownSample(ABitmap, AWidth, AHeight, rect(0,0,ABitmap.Width,ABitmap.Height)); -end; - -constructor TGrayscaleMask.CreateDownSample(ABitmap: TGrayscaleMask; AWidth, - AHeight: integer); -begin - CreateDownSample(ABitmap, AWidth, AHeight, rect(0,0,ABitmap.Width,ABitmap.Height)); -end; - -constructor TGrayscaleMask.CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth, - AHeight: integer; ASourceRect: TRect); -begin - inherited Create(0,0); - if (AWidth = ABitmap.Width) and (AHeight = ABitmap.Height) then - CopyFrom(ABitmap,cGreen) - else - begin - if (ABitmap.Width < AWidth) or (ABitmap.Height < AHeight) then - raise exception.Create('Original size smaller'); - SetSize(AWidth,AHeight); - if NbPixels > 0 then - DownSamplePutImageGrayscale(ABitmap, self, rect(0,0,FWidth,FHeight), ASourceRect); - end; -end; - -constructor TGrayscaleMask.CreateDownSample(ABitmap: TGrayscaleMask; AWidth, - AHeight: integer; ASourceRect: TRect); -begin - inherited Create(0,0); - if (AWidth = ABitmap.Width) and (AHeight = ABitmap.Height) then - CopyFrom(ABitmap) - else - begin - if (ABitmap.Width < AWidth) or (ABitmap.Height < AHeight) then - raise exception.Create('Original size smaller'); - SetSize(AWidth,AHeight); - if NbPixels > 0 then - DownSamplePutImageGrayscale(ABitmap, self, rect(0,0,FWidth,FHeight), ASourceRect); - end; -end; - -procedure TGrayscaleMask.CopyFrom(ABitmap: TGrayscaleMask); -begin - SetSize(ABitmap.Width, ABitmap.Height); - if NbPixels > 0 then - move(ABitmap.Data^, Data^, NbPixels); -end; - -procedure TGrayscaleMask.Draw(ABitmap: TBGRACustomBitmap; X, Y: Integer; AGammaCorrection: boolean = false); -var - yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, - i, delta_source, delta_dest: integer; - pdest: PBGRAPixel; - psource: PByte; - value: byte; -begin - if not CheckPutImageBounds(x,y,FWidth,Fheight,minxb,minyb,maxxb,maxyb,ignoreleft,ABitmap.ClipRect) then exit; - copycount := maxxb - minxb + 1; - - psource := ScanLineByte[minyb - y] + ignoreleft; - delta_source := FWidth; - - pdest := ABitmap.Scanline[minyb] + minxb; - if ABitmap.LineOrder = riloBottomToTop then - delta_dest := -ABitmap.Width - else - delta_dest := ABitmap.Width; - - Dec(delta_source, copycount); - Dec(delta_dest, copycount); - for yb := minyb to maxyb do - begin - if AGammaCorrection then - begin - for i := copycount -1 downto 0 do - begin - value := GammaCompressionTab[psource^ + (psource^ shl 8)]; - pdest^ := BGRA(value,value,value,255); - inc(psource); - inc(pdest); - end; - end else - begin - for i := copycount -1 downto 0 do - begin - value := psource^; - pdest^ := BGRA(value,value,value,255); - inc(psource); - inc(pdest); - end; - end; - Inc(psource, delta_source); - Inc(pdest, delta_dest); - end; - ABitmap.InvalidateBitmap; -end; - -procedure TGrayscaleMask.DrawAsAlpha(ABitmap: TBGRACustomBitmap; X, Y: Integer; const c: TBGRAPixel); -begin - ABitmap.FillMask(x,y, self, c, dmDrawWithTransparency); -end; - -procedure TGrayscaleMask.DrawAsAlpha(ABitmap: TBGRACustomBitmap; X, Y: Integer; texture: IBGRAScanner); -begin - ABitmap.FillMask(x,y, self, texture, dmDrawWithTransparency); -end; - -function TGrayscaleMask.GetPixel(X, Y: integer): byte; -begin - if (x < 0) or (x >= FWidth) then - raise ERangeError.Create('GetPixel: out of bounds'); - result := (ScanLineByte[Y]+X)^; -end; - -procedure TGrayscaleMask.SetPixel(X, Y: integer; AValue: byte); -begin - if (x < 0) or (x >= FWidth) then - raise ERangeError.Create('SetPixel: out of bounds'); - (ScanLineByte[Y]+X)^ := AValue; -end; - -function TGrayscaleMask.GetPixel(x, y: single; - AResampleFilter: TResampleFilter; smoothBorder: boolean): TByteMask; -var - ix, iy: Int32or64; - iFactX,iFactY: Int32or64; -begin - ix := round(x*256); - if (ix<= -256) or (ix>=Width shl 8) then - begin - result := ByteMaskBlack; - exit; - end; - iy := round(y*256); - if (iy<= -256) or (iy>=Height shl 8) then - begin - result := ByteMaskBlack; - exit; - end; - - iFactX := ix and 255; //distance from integer coordinate - iFactY := iy and 255; - if ix<0 then ix := -1 else ix := ix shr 8; - if iy<0 then iy := -1 else iy := iy shr 8; - - //if the coordinate is integer, then call standard GetPixel function - if (iFactX = 0) and (iFactY = 0) then - begin - Result := (GetScanlineFast(iy)+ix)^; - exit; - end; - - result := InternalGetPixel256(ix,iy, FineInterpolation256(iFactX, AResampleFilter), - FineInterpolation256(iFactY, AResampleFilter), smoothBorder); -end; - -function TGrayscaleMask.GetPixel256(x, y, fracX256, fracY256: int32or64; - AResampleFilter: TResampleFilter; smoothBorder: boolean): TByteMask; -begin - if (fracX256 = 0) and (fracY256 = 0) then - result := GetPixel(x,y) - else if AResampleFilter = rfBox then - begin - if fracX256 >= 128 then inc(x); - if fracY256 >= 128 then inc(y); - result := GetPixel(x,y); - end else - result := InternalGetPixel256(x,y, FineInterpolation256(fracX256,AResampleFilter), - FineInterpolation256(fracY256,AResampleFilter), smoothBorder); -end; - -procedure TGrayscaleMask.ScanNextMaskChunk(var ACount: integer; out - AMask: PByteMask; out AStride: integer); -var - pPixels: Pointer; -begin - ScanNextCustomChunk(ACount, pPixels); - AMask := PByteMask(pPixels); - AStride := sizeof(TByteMask); -end; - -function TGrayscaleMask.ScanAtIntegerMask(X, Y: integer): TByteMask; -begin - if (FScanWidth <> 0) and (FScanHeight <> 0) then - result := GetPixelAddress(PositiveMod(X+ScanOffset.X, FScanWidth), - PositiveMod(Y+ScanOffset.Y, FScanHeight))^ - else - result := ByteMaskBlack; -end; - -function TGrayscaleMask.ScanAtMask(X, Y: Single): TByteMask; -var - ix, iy: Int32or64; - iFactX,iFactY: Int32or64; -begin - if (FScanWidth = 0) or (FScanHeight = 0) then - begin - result := BGRAPixelTransparent; - exit; - end; - LoadFromBitmapIfNeeded; - ix := round(x*256); - iy := round(y*256); - if ScanInterpolationFilter = rfBox then - begin - ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; - iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; - result := (GetScanlineFast(iy)+ix)^; - exit; - end; - iFactX := ix and 255; - iFactY := iy and 255; - ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8; - iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8; - if (iFactX = 0) and (iFactY = 0) then - begin - result := (GetScanlineFast(iy)+ix)^; - exit; - end; - if ScanInterpolationFilter <> rfLinear then - begin - iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter ); - iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter ); - end; - result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY); -end; - -function TGrayscaleMask.ScanAtInteger(X, Y: integer): TBGRAPixel; -begin - Result:= MaskToBGRA(ScanAtIntegerMask(X, Y)); -end; - -function TGrayscaleMask.ScanAt(X, Y: Single): TBGRAPixel; -begin - Result:= MaskToBGRA(ScanAtMask(X, Y)); -end; - -procedure TGrayscaleMask.Negative; -begin - NegativeRect(rect(0, 0, Width, Height)); -end; - -procedure TGrayscaleMask.NegativeRect(ABounds: TRect); -var - yb, w, xb: LongInt; - p: PByte; -begin - ABounds.Intersect(ClipRect); - w := ABounds.Width; - for yb := ABounds.Top to ABounds.Bottom-1 do - begin - p := GetPixelAddress(ABounds.Left, yb); - for xb := w-1 downto 0 do - begin - p^ := not p^; - inc(p); - end; - end; -end; - -procedure TGrayscaleMask.InplaceNormalize; -begin - InplaceNormalize(rect(0, 0, Width, Height)); -end; - -procedure TGrayscaleMask.InplaceNormalize(ABounds: TRect); -var - yb, w, xb: LongInt; - p: PByte; - minVal, maxVal, spread: byte; -begin - ABounds.Intersect(ClipRect); - if ABounds.IsEmpty then exit; - minVal := 255; - maxVal := 0; - w := ABounds.Width; - for yb := ABounds.Top to ABounds.Bottom-1 do - begin - p := GetPixelAddress(ABounds.Left, yb); - for xb := w-1 downto 0 do - begin - if p^ < minVal then minVal := p^; - if p^ > maxVal then maxVal := p^; - inc(p); - end; - end; - if (minVal > 0) or (maxVal < 255) then - begin - if minVal = maxVal then - begin - if (minVal > 0) and (minVal < 255) then - FillRect(ABounds, TByteMask.New(255)); - end else - begin - spread := maxVal - minVal; - for yb := ABounds.Top to ABounds.Bottom-1 do - begin - p := GetPixelAddress(ABounds.Left, yb); - for xb := w-1 downto 0 do - begin - p^ := (p^ - minVal) * 255 div spread; - inc(p); - end; - end; - end; - end; -end; - -function TGrayscaleMask.NewBitmap: TGrayscaleMask; -begin - Result:=inherited NewBitmap as TGrayscaleMask; -end; - -function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer): TGrayscaleMask; -begin - Result:=inherited NewBitmap(AWidth, AHeight) as TGrayscaleMask; -end; - -function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer; - const Color: TByteMask): TGrayscaleMask; -begin - Result:=inherited NewBitmap(AWidth, AHeight, Color) as TGrayscaleMask; -end; - -function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer; AColor: Pointer - ): TGrayscaleMask; -begin - Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TGrayscaleMask; -end; - -function TGrayscaleMask.NewReference: TGrayscaleMask; -begin - Result:=inherited NewReference as TGrayscaleMask; -end; - -function TGrayscaleMask.GetUnique: TGrayscaleMask; -begin - Result:=inherited GetUnique as TGrayscaleMask; -end; - -function TGrayscaleMask.Duplicate(DuplicateProperties: Boolean): TGrayscaleMask; -begin - Result:=inherited Duplicate(DuplicateProperties) as TGrayscaleMask; -end; - -function TGrayscaleMask.GetPart(const ARect: TRect): TGrayscaleMask; -begin - Result:=inherited GetPart(ARect) as TGrayscaleMask; -end; - -function TGrayscaleMask.CreateBrushTexture(ABrushStyle: TBrushStyle; - APatternColor, ABackgroundColor: TByteMask; AWidth: integer; - AHeight: integer; APenWidth: single): TGrayscaleMask; -begin - Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor, - ABackgroundColor, AWidth, AHeight, APenWidth) as TGrayscaleMask; -end; - -function TGrayscaleMask.RotateCW: TGrayscaleMask; -begin - Result:=inherited RotateCW as TGrayscaleMask; -end; - -function TGrayscaleMask.RotateCCW: TGrayscaleMask; -begin - Result:=inherited RotateCCW as TGrayscaleMask; -end; - -function TGrayscaleMask.RotateUD: TGrayscaleMask; -begin - Result:=inherited RotateUD as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterContour(ABorderValue: byte = 0): TGrayscaleMask; -var - pDest: PByte; - - procedure ComputeDiff(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; - var diff: Integer; - begin - diff := (abs((pCurRow+x+1)^ - (pCurRow+x-1)^) + - abs((pPrevRow+x-1)^ - (pNextRow+x+1)^) + - abs((pPrevRow+x)^ - (pNextRow+x)^) + - abs((pPrevRow+x+1)^ - (pNextRow+x-1)^)) div 3; - if diff > 255 then - (pDest+x)^ := 0 - else (pDest+x)^ := not Byte(diff); - end; - - procedure ComputeDiffLeft(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; - var diff: Integer; - begin - diff := (abs((pCurRow+x+1)^ - ABorderValue) + - abs(ABorderValue - (pNextRow+x+1)^) + - abs((pPrevRow+x)^ - (pNextRow+x)^) + - abs((pPrevRow+x+1)^ - ABorderValue)) div 3; - if diff > 255 then - (pDest+x)^ := 0 - else (pDest+x)^ := not Byte(diff); - end; - - procedure ComputeDiffRight(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; - var diff: Integer; - begin - diff := (abs(ABorderValue - (pCurRow+x-1)^) + - abs((pPrevRow+x-1)^ - ABorderValue) + - abs((pPrevRow+x)^ - (pNextRow+x)^) + - abs(ABorderValue - (pNextRow+x-1)^)) div 3; - if diff > 255 then - (pDest+x)^ := 0 - else (pDest+x)^ := not Byte(diff); - end; - - procedure ComputeDiffLeftRight(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline; - var diff: Integer; - begin - diff := abs((pPrevRow+x)^ - (pNextRow+x)^) div 3; - if diff > 255 then - (pDest+x)^ := 0 - else (pDest+x)^ := not Byte(diff); - end; - -var - pPrevRow, pCurRow, pNextRow, pBorder: PByte; - border: packed array of byte; - yb, xb: Integer; - -begin - if NbPixels = 0 then exit; - result := TGrayscaleMask.Create; - result.SetSize(Width, Height); - setlength(border, Width); - for xb := 0 to Width-1 do - border[xb] := ABorderValue; - pBorder := @border[0]; - pPrevRow := nil; - pCurRow := nil; - pNextRow := ScanLine[0]; - for yb := 0 to Height-1 do - begin - pPrevRow := pCurRow; - pCurRow := pNextRow; - if yb < Height-1 then - pNextRow := ScanLine[yb+1] - else pNextRow := nil; - pDest := result.ScanLine[yb]; - - if pPrevRow = nil then - begin - if pNextRow = nil then - begin - if Width = 1 then - ComputeDiffLeftRight(0, pBorder, pCurRow, pBorder) else - begin - ComputeDiffLeft(0, pBorder, pCurRow, pBorder); - for xb := 1 to Width-2 do - ComputeDiff(xb, pBorder, pCurRow, pBorder); - ComputeDiffRight(Width-1, pBorder, pCurRow, pBorder); - end; - end else - begin - if Width = 1 then - ComputeDiffLeftRight(0, pBorder, pCurRow, pNextRow) else - begin - ComputeDiffLeft(0, pBorder, pCurRow, pNextRow); - for xb := 1 to Width-2 do - ComputeDiff(xb, pBorder, pCurRow, pNextRow); - ComputeDiffRight(Width-1, pBorder, pCurRow, pNextRow); - end; - end; - end else - if pNextRow = nil then - begin - if Width = 1 then - ComputeDiffLeftRight(0, pPrevRow, pCurRow, pBorder) else - begin - ComputeDiffLeft(0, pPrevRow, pCurRow, pBorder); - for xb := 1 to Width-2 do - ComputeDiff(xb, pPrevRow, pCurRow, pBorder); - ComputeDiffRight(Width-1, pPrevRow, pCurRow, pBorder); - end; - end else - begin - if Width = 1 then - ComputeDiffLeftRight(0, pPrevRow, pCurRow, pNextRow) else - begin - ComputeDiffLeft(0, pPrevRow, pCurRow, pNextRow); - for xb := 1 to Width-2 do - ComputeDiff(xb, pPrevRow, pCurRow, pNextRow); - ComputeDiffRight(Width-1, pPrevRow, pCurRow, pNextRow); - end; - end; - end; -end; - -function TGrayscaleMask.FilterBlurRadial(radius: single; - blurType: TRadialBlurType): TGrayscaleMask; -begin - Result:=inherited FilterBlurRadial(radius, blurType) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterBlurRadial(const ABounds: TRect; radius: single; - blurType: TRadialBlurType): TGrayscaleMask; -begin - Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterBlurRadial(radiusX, radiusY: single; - blurType: TRadialBlurType): TGrayscaleMask; -begin - Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterBlurRadial(const ABounds: TRect; radiusX, - radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; -begin - Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterBlurMotion(distance: single; angle: single; - oriented: boolean): TGrayscaleMask; -begin - Result:=inherited FilterBlurMotion(distance, angle, oriented) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterBlurMotion(const ABounds: TRect; - distance: single; angle: single; oriented: boolean): TGrayscaleMask; -begin - Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterCustomBlur(mask: TCustomUniversalBitmap - ): TGrayscaleMask; -begin - Result:=inherited FilterCustomBlur(mask) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterCustomBlur(const ABounds: TRect; - mask: TCustomUniversalBitmap): TGrayscaleMask; -begin - Result:=inherited FilterCustomBlur(ABounds, mask) as TGrayscaleMask; -end; - -function TGrayscaleMask.FilterSphere: TGrayscaleMask; -var - cx, cy: single; - scanner: TBGRASphereDeformationScanner; -begin - Result := NewBitmap(Width, Height); - cx := Width / 2 - 0.5; - cy := Height / 2 - 0.5; - scanner := TBGRASphereDeformationScanner.Create(self, PointF(cx,cy), Width/2, Height/2); - result.FillEllipseAntialias(cx, cy, Width/2-0.5, Height/2-0.5, scanner); - scanner.Free; -end; - -function TGrayscaleMask.FilterCylinder: TGrayscaleMask; -var - cx: single; - scanner: TBGRAVerticalCylinderDeformationScanner; -begin - Result := NewBitmap(Width, Height); - cx := Width / 2 - 0.5; - scanner := TBGRAVerticalCylinderDeformationScanner.Create(self, cx, Width/2); - result.Fill(scanner, dmSet); - scanner.Free; -end; - -procedure DownSamplePutImageGrayscale(sourceData: PByte; - sourcePixelSize: Int32or64; sourceRowDelta: Int32or64; sourceWidth, - sourceHeight: Int32or64; dest: TGrayscaleMask; ADestRect: TRect); -var - x_dest,y_dest: integer; - pdest: PByte; - nbPix,sum: UInt32or64; - prev_x_src,x_src,x_src_nb,xb: Int32or64; - x_src_inc,x_src_acc,x_src_div,x_src_rest: Int32or64; - prev_y_src,y_src,y_src_nb,yb: Int32or64; - y_src_inc,y_src_acc,y_src_div,y_src_rest: Int32or64; - psrc,psrc2,psrc3: PByte; -begin - y_src_div := ADestRect.Bottom-ADestRect.Top; - y_src_inc := sourceHeight div y_src_div; - y_src_rest := sourceHeight mod y_src_div; - x_src_div := ADestRect.Right-ADestRect.Left; - x_src_inc := sourceWidth div x_src_div; - x_src_rest := sourceWidth mod x_src_div; - - if (x_src_rest = 0) and (y_src_rest = 0) then - begin - x_src_nb := x_src_inc; - y_src_nb := y_src_inc; - nbPix := x_src_nb*y_src_nb; - y_src := 0; - for y_dest := ADestRect.Top to ADestRect.Bottom-1 do - begin - pdest := dest.GetPixelAddress(ADestRect.Left, y_dest); - psrc := sourceData + y_src*sourceRowDelta; - inc(y_src,y_src_inc); - - for x_dest := ADestRect.Right-ADestRect.Left-1 downto 0 do - begin - sum := 0; - psrc2 := psrc; - for xb := x_src_nb-1 downto 0 do - begin - psrc3 := psrc2; - for yb := y_src_nb-1 downto 0 do - begin - inc(sum, psrc3^); - inc(psrc3, sourceRowDelta); - end; - inc(psrc2, sourcePixelSize); - end; - pdest^ := sum div nbPix; - - psrc := psrc2; - inc(pdest); - end; - end; - end else - begin - y_src := 0; - y_src_acc := 0; - for y_dest := ADestRect.Top to ADestRect.Bottom-1 do - begin - pdest := dest.GetPixelAddress(ADestRect.Left, y_dest); - psrc := sourceData + y_src*sourceRowDelta; - - prev_y_src := y_src; - inc(y_src,y_src_inc); - inc(y_src_acc,y_src_rest); - if y_src_acc >= y_src_div then - begin - dec(y_src_acc,y_src_div); - inc(y_src); - end; - y_src_nb := y_src-prev_y_src; - - x_src := 0; - x_src_acc := 0; - for x_dest := ADestRect.Right-ADestRect.Left-1 downto 0 do - begin - prev_x_src := x_src; - inc(x_src,x_src_inc); - inc(x_src_acc,x_src_rest); - if x_src_acc >= x_src_div then - begin - dec(x_src_acc,x_src_div); - inc(x_src); - end; - x_src_nb := x_src-prev_x_src; - - sum := 0; - nbPix := 0; - psrc2 := psrc; - for xb := x_src_nb-1 downto 0 do - begin - psrc3 := psrc2; - for yb := y_src_nb-1 downto 0 do - begin - inc(nbPix); - inc(sum, psrc3^); - inc(psrc3, sourceRowDelta); - end; - inc(psrc2, sourcePixelSize); - end; - pdest^ := sum div nbPix; - - psrc := psrc2; - inc(pdest); - end; - end; - end; -end; - -procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; - dest: TGrayscaleMask; ADestRect: TRect); -begin - DownSamplePutImageGrayscale(source, dest, ADestRect, rect(0,0,source.Width,source.Height)); -end; - -procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect); overload; -begin - DownSamplePutImageGrayscale(source, dest, ADestRect, rect(0,0,source.Width,source.Height)); -end; - -procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; - dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); -var delta: Int32or64; -begin - delta := source.Width*sizeof(TBGRAPixel); - if source.LineOrder = riloBottomToTop then - delta := -delta; - DownSamplePutImageGrayscale( - source.GetPixelAddress(ASourceRect.Left, ASourceRect.Top) + TBGRAPixel_GreenByteOffset, - sizeof(TBGRAPixel), delta, ASourceRect.Width, ASourceRect.Height, dest, ADestRect); -end; - -procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; - dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); -var delta: Int32or64; -begin - delta := source.Width; - if source.LineOrder = riloBottomToTop then - delta := -delta; - DownSamplePutImageGrayscale(source.GetPixelAddress(ASourceRect.Left, ASourceRect.Top), 1, - delta, ASourceRect.Width, ASourceRect.Height, dest, ADestRect); -end; - -end. - diff --git a/components/bgrabitmap/bgragtkbitmap.pas b/components/bgrabitmap/bgragtkbitmap.pas deleted file mode 100644 index d8f8750..0000000 --- a/components/bgrabitmap/bgragtkbitmap.pas +++ /dev/null @@ -1,339 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - /**************************************************************************\ - bgragtkbitmap.pas - ----------------- - This unit should NOT be added to the 'uses' clause. - It contains patches for Gtk. -} - -unit BGRAGtkBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRALCLBitmap, Graphics, - GraphType; - -type - { TBGRAGtkBitmap } - - TBGRAGtkBitmap = class(TBGRALCLBitmap) - private - FPixBuf: Pointer; - procedure DrawTransparent(ACanvas: TCanvas; Rect: TRect); - procedure DrawOpaque(ACanvas: TCanvas; ARect: TRect); - protected - procedure ReallocData; override; - procedure FreeData; override; - public - procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); - override; - procedure DrawPart(ARect: TRect; ACanvas: TCanvas; x, y: integer; Opaque: boolean); override; - procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override; - procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override; - procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); overload; override; - procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; ADataFirstRow: Pointer; - ARowStride: integer; AWidth, AHeight: integer); overload; - procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; - end; - -implementation - -uses BGRABitmapTypes, BGRADefaultBitmap, BGRAFilterScanner, LCLType, - LCLIntf, IntfGraphics, - {$IFDEF LCLgtk2} - gdk2, gtk2def, gdk2pixbuf, glib2, - {$ENDIF} - {$IFDEF LCLgtk} - gdk, gtkdef, gtkProc, gdkpixbuf, glib, - {$ENDIF} - FPImage, Dialogs; - -procedure TBGRAGtkBitmap.ReallocData; -begin - {$IFDEF LCLgtk2} - If FPixBuf <> nil then g_object_unref(FPixBuf); - {$ELSE} - If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf); - {$ENDIF} - FPixBuf := nil; - inherited ReallocData; - if (FWidth <> 0) and (FHeight <> 0) then - begin - FPixbuf := gdk_pixbuf_new_from_data(pguchar(FDataByte), - GDK_COLORSPACE_RGB, True, 8, Width, Height, Width*Sizeof(TBGRAPixel), nil, nil); - if FPixbuf = nil then - raise Exception.Create('Error initializing Pixbuf'); - end; -end; - -procedure TBGRAGtkBitmap.FreeData; -begin - {$IFDEF LCLgtk2} - If FPixBuf <> nil then g_object_unref(FPixBuf); - {$ELSE} - If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf); - {$ENDIF} - FPixBuf := nil; - inherited FreeData; -end; - -procedure TBGRAGtkBitmap.DrawTransparent(ACanvas: TCanvas; Rect: TRect); -var DrawWidth,DrawHeight: integer; - stretched: TBGRAGtkBitmap; - P: TPoint; -begin - DrawWidth := Rect.Right-Rect.Left; - DrawHeight := Rect.Bottom-Rect.Top; - if (Height = 0) or (Width = 0) or (DrawWidth <= 0) or (DrawHeight <= 0) then - exit; - - if (DrawWidth <> Width) or (DrawHeight <> Height) then - begin - stretched := Resample(DrawWidth,DrawHeight,rmSimpleStretch) as TBGRAGtkBitmap; - stretched.DrawTransparent(ACanvas,Rect); - stretched.Free; - exit; - end; - - LoadFromBitmapIfNeeded; - - {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP} - - P := Rect.TopLeft; - LPToDP(ACanvas.Handle, P, 1); - gdk_pixbuf_render_to_drawable(FPixBuf, - TGtkDeviceContext(ACanvas.Handle).Drawable, - TGtkDeviceContext(ACanvas.Handle).GC, - 0,0, P.X,P.Y, - Width,Height, - GDK_RGB_DITHER_NORMAL,0,0); - - {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP} -end; - -procedure TBGRAGtkBitmap.DrawOpaque(ACanvas: TCanvas; ARect: TRect); -begin - DataDrawOpaque(ACanvas,ARect,Data,LineOrder,Width,Height); -end; - -procedure TBGRAGtkBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - TempGtk: TBGRAGtkBitmap; - temp: integer; -begin - if (AHeight = 0) or (AWidth = 0) or (Rect.Left = Rect.Right) or - (Rect.Top = Rect.Bottom) then - exit; - - if Rect.Right < Rect.Left then - begin - temp := Rect.Left; - Rect.Left := Rect.Right; - Rect.Right := temp; - end; - - if Rect.Bottom < Rect.Top then - begin - temp := Rect.Top; - Rect.Top := Rect.Bottom; - Rect.Bottom := temp; - end; - - TempGtk := TBGRAGtkBitmap.Create(AWidth, AHeight); - Move(AData^,TempGtk.Data^,TempGtk.NbPixels*sizeof(TBGRAPixel)); - if ALineOrder <> TempGtk.LineOrder then TempGtk.VerticalFlip; - TempGtk.DrawTransparent(ACanvas,Rect); - TempGtk.Free; -end; - -procedure TBGRAGtkBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; x, - y: integer; Opaque: boolean); -var - rowStride,w,h: Integer; -begin - if Opaque then - begin - if LineOrder = riloTopToBottom then - rowStride := Width*sizeof(TBGRAPixel) - else - rowStride := -Width*sizeof(TBGRAPixel); - w:= ARect.Right-ARect.Left; - h:= ARect.Bottom-ARect.Top; - DataDrawOpaque(ACanvas, rect(x,y,x+w,y+h), Scanline[ARect.Top]+ARect.Left, rowStride, w,h); - end - else - inherited DrawPart(ARect, ACanvas, x, y, Opaque); -end; - -procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); -begin - if self = nil then - exit; - if Opaque then - DrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height)) - else - DrawTransparent(ACanvas, Rect(X, Y, X + Width, Y + Height)); -end; - -procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); -begin - if self = nil then - exit; - if Opaque then - DrawOpaque(ACanvas, Rect) - else - DrawTransparent(ACanvas, Rect); -end; - -procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - rowStride: Integer; - firstRow: Pointer; -begin - if ALineOrder = riloTopToBottom then - begin - rowStride := AWidth*sizeof(TBGRAPixel); - firstRow := AData; - end - else - begin - rowStride := -AWidth*sizeof(TBGRAPixel); - firstRow := PBGRAPixel(AData) + (AWidth*(AHeight-1)); - end; - - DataDrawOpaque(ACanvas, ARect, firstRow, rowStride, AWidth, AHeight); -end; - -procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; - ADataFirstRow: Pointer; ARowStride: integer; AWidth, AHeight: integer); - - procedure DataSwapRedBlue; - var - y: Integer; - p: PByte; - begin - p := PByte(ADataFirstRow); - for y := 0 to AHeight-1 do - begin - TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(PBGRAPixel(p),PBGRAPixel(p),AWidth,False); - inc(p, ARowStride); - end; - end; - - procedure DrawStretched; - var - dataStart: Pointer; - ptr: TBGRAPtrBitmap; - stretched: TBGRACustomBitmap; - begin - if ARowStride < 0 then - dataStart := PByte(ADataFirstRow) + ARowStride*(Height-1) - else - dataStart := ADataFirstRow; - - if ARowStride <> abs(AWidth*sizeof(TBGRAPixel)) then - raise exception.Create('DataDrawOpaque not supported when using custom row stride and resample'); - - ptr := TBGRAPtrBitmap.Create(AWidth,AHeight,dataStart); - if ARowStride < 0 then - ptr.LineOrder := riloBottomToTop - else - ptr.LineOrder := riloTopToBottom; - stretched := ptr.Resample(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); - ptr.free; - DataDrawOpaque(ACanvas,ARect,stretched.Data,stretched.LineOrder,stretched.Width,stretched.Height); - stretched.Free; - end; - -var - temp: integer; - pos: TPoint; - dest: HDC; - -begin - if (AHeight = 0) or (AWidth = 0) or (ARect.Left = ARect.Right) or - (ARect.Top = ARect.Bottom) then exit; - - if ARect.Right < ARect.Left then - begin - temp := ARect.Left; - ARect.Left := ARect.Right; - ARect.Right := temp; - end; - - if ARect.Bottom < ARect.Top then - begin - temp := ARect.Top; - ARect.Top := ARect.Bottom; - ARect.Bottom := temp; - end; - - if (AWidth <> ARect.Right-ARect.Left) or (AHeight <> ARect.Bottom-ARect.Top) then - DrawStretched - else - begin - dest := ACanvas.Handle; - pos := ARect.TopLeft; - LPtoDP(dest, pos, 1); - {$PUSH}{$WARNINGS OFF}if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;{$POP} - gdk_draw_rgb_32_image(TGtkDeviceContext(dest).Drawable, - TGtkDeviceContext(Dest).GC, pos.x,pos.y, - AWidth,AHeight, GDK_RGB_DITHER_NORMAL, - ADataFirstRow, ARowStride); - {$PUSH}{$WARNINGS OFF}if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;{$POP} - ACanvas.Changed; - end; -end; - -procedure TBGRAGtkBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); -var - subBmp: TBGRACustomBitmap; - subRect: TRect; - cw,ch: integer; - P: TPoint; -begin - cw := CanvasSource.Width; - ch := CanvasSource.Height; - if (x < 0) or (y < 0) or (x+Width > cw) or - (y+Height > ch) then - begin - FillTransparent; - if (x+Width <= 0) or (y+Height <= 0) or - (x >= cw) or (y >= ch) then - exit; - - if (x > 0) then subRect.Left := x else subRect.Left := 0; - if (y > 0) then subRect.Top := y else subRect.Top := 0; - if (x+Width > cw) then subRect.Right := cw else - subRect.Right := x+Width; - if (y+Height > ch) then subRect.Bottom := ch else - subRect.Bottom := y+Height; - - subBmp := NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top); - subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top); - PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet); - subBmp.Free; - exit; - end; - - P := Point(x,y); - LPToDP(CanvasSource.Handle, P, 1); - gdk_pixbuf_get_from_drawable(FPixBuf, - TGtkDeviceContext(CanvasSource.Handle).Drawable, - nil, P.X,P.Y,0,0,Width,Height); - {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP} - InvalidateBitmap; -end; - - -end. - - diff --git a/components/bgrabitmap/bgraiconcursor.pas b/components/bgrabitmap/bgraiconcursor.pas deleted file mode 100644 index 1976a85..0000000 --- a/components/bgrabitmap/bgraiconcursor.pas +++ /dev/null @@ -1,865 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAIconCursor; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, BGRAMultiFileType, BGRABitmapTypes; - -type - { TBGRAIconCursorEntry } - - TBGRAIconCursorEntry = class(TMultiFileEntry) - protected - FWidth,FHeight,FBitDepth: integer; - FExtension: string; - FContent: TStream; - FHotSpot: TPoint; - function GetName: utf8string; override; - procedure SetName({%H-}AValue: utf8string); override; - function GetExtension: utf8string; override; - function GetFileSize: int64; override; - public - constructor Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo; AContent: TStream); - class function TryCreate(AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry; static; - destructor Destroy; override; - function CopyTo(ADestination: TStream): int64; override; - function GetStream: TStream; override; - function GetBitmap: TBGRACustomBitmap; - property Width: integer read FWidth; - property Height: integer read FHeight; - property BitDepth: integer read FBitDepth; - property HotSpot: TPoint read FHotSpot write FHotSpot; - end; - - { TBGRAIconCursor } - - TBGRAIconCursor = class(TMultiFileContainer) - private - function GetBitDepthAt(AIndex: integer): integer; - function GetHeightAt(AIndex: integer): integer; - function GetHotSpotAtAt(AIndex: integer): TPoint; - function GetWidthAt(AIndex: integer): integer; - procedure SetFileType(AValue: TBGRAImageFormat); - procedure SetHotSpotAt(AIndex: integer; AValue: TPoint); - protected - FFileType : TBGRAImageFormat; - FLoading : boolean; - function CreateEntry(AName: utf8string; AExtension: utf8string; - AContent: TStream): TMultiFileEntry; override; - function ExpectedMagic: Word; - procedure Init; override; - procedure AssignTo(Dest: TPersistent); override; - public - constructor Create(AFileType: TBGRAImageFormat); overload; - procedure Assign(Source: TPersistent); override; - function Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer; AOverwrite: boolean = false): integer; overload; - function Add(AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload; - procedure LoadFromStream(AStream: TStream); override; - procedure SaveToStream(ADestination: TStream); override; - function GetBitmap(AIndex: integer): TBGRACustomBitmap; - function GetBestFitBitmap(AWidth,AHeight: integer): TBGRACustomBitmap; - function IndexOf(AWidth,AHeight,ABitDepth: integer): integer; overload; - property FileType: TBGRAImageFormat read FFileType write SetFileType; - property Width[AIndex: integer]: integer read GetWidthAt; - property Height[AIndex: integer]: integer read GetHeightAt; - property BitDepth[AIndex: integer]: integer read GetBitDepthAt; - property HotSpot[AIndex: integer]: TPoint read GetHotSpotAtAt write SetHotSpotAt; - end; - -function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer; ADithering: TDitheringAlgorithm): TBGRACustomBitmap; -function BGRABitDepthIconCursor(ABitmap: TBGRACustomBitmap): integer; - -implementation - -uses BGRAWinResource, BGRAUTF8, BGRAReadPng, BGRAReadBMP, FPWriteBMP, BGRAPalette, BGRAWritePNG, - BGRAColorQuantization{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF}; - -function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer; - ADithering: TDitheringAlgorithm): TBGRACustomBitmap; -var - frameMask, temp: TBGRACustomBitmap; - quantizer: TBGRAColorQuantizer; - maskQuantizer: TBGRAColorQuantizer; - - x,y: integer; - psrc,pdest: PBGRAPixel; -begin - if ABitDepth <= 0 then - raise exception.Create('Invalid bit depth'); - - if ABitDepth <= 24 then - begin - if ABitDepth = 1 then - begin - quantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite,BGRAPixelTransparent],false,3); - result := quantizer.GetDitheredBitmap(ADithering, ABitmap); - quantizer.Free; - end - else - begin - frameMask := ABitmap.GetMaskFromAlpha; - maskQuantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite],false,2); - temp := maskQuantizer.GetDitheredBitmap(ADithering, frameMask); - frameMask.Free; - frameMask := temp; - maskQuantizer.Free; - - result := ABitmap.Duplicate; - result.ReplaceTransparent(BGRABlack); - result.AlphaFill(255); - - if ABitDepth <= 8 then - begin - quantizer := TBGRAColorQuantizer.Create(result,acFullChannelInPalette, 1 shl ABitDepth); - temp := quantizer.GetDitheredBitmap(daFloydSteinberg, result); - result.free; - result := temp; - quantizer.Free; - end; - - result.ApplyMask(frameMask); - frameMask.Free; - end; - end else - result := ABitmap.Duplicate; - - if Assigned(ABitmap.XorMask) then - begin - result.NeedXorMask; - for y := 0 to ABitmap.XorMask.Height-1 do - begin - psrc := ABitmap.XorMask.ScanLine[y]; - pdest := result.XorMask.ScanLine[y]; - for x := 0 to ABitmap.XorMask.Width-1 do - begin - if ((psrc^.red shl 1)+(psrc^.green shl 2)+psrc^.blue >= 128*(1+2+4)) then - pdest^ := BGRA(255,255,255,0); - inc(psrc); - inc(pdest); - end; - end; - end; -end; - -function BGRABitDepthIconCursor(ABitmap: TBGRACustomBitmap): integer; -var pal: TBGRAPalette; - p: PBGRAPixel; - n: integer; - - function BlackAndWhite: boolean; - var - i: Integer; - begin - if pal.Count > 2 then result := false - else - begin - for i := 0 to pal.Count-1 do - if (pal.Color[i] <> BGRAWhite) and (pal.Color[i] <> BGRABlack) then - exit(false); - result := true; - end; - end; - -begin - pal := TBGRAPalette.Create; - p := ABitmap.Data; - n := ABitmap.NbPixels; - while (n > 0) and (pal.Count < 257) do - begin - if p^.alpha = 0 then - begin - if pal.Count < 257 then pal.AddColor(BGRABlack); - end else - if p^.alpha = 255 then - begin - if pal.Count < 257 then pal.AddColor(p^); - end else - begin - pal.Free; - exit(32); - end; - inc(p); - dec(n); - end; - if pal.Count > 256 then result := 24 else - if pal.Count > 16 then result := 8 else - if (pal.Count > 2) or not BlackAndWhite then result := 4 else - result := 1; - pal.Free; -end; - -{ TBGRAIconCursorEntry } - -constructor TBGRAIconCursorEntry.Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo; - AContent: TStream); -begin - inherited Create(AContainer); - FExtension:= AExtension; - FWidth := AInfo.Width; - FHeight:= AInfo.Height; - - // 16 bit per channel is not relevant for icon depth - if AInfo.ColorDepth >= 24 then - begin - if AInfo.AlphaDepth >= 8 then - FBitDepth := 32 - else - FBitDepth := 24; - end else - FBitDepth := AInfo.ColorDepth; - - FContent := AContent; -end; - -class function TBGRAIconCursorEntry.TryCreate( - AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry; -var - format: TBGRAImageFormat; - imageInfo: TQuickImageInfo; - tempStream: TMemoryStream; - reader: TBGRAImageReader; - bmp: TBGRACustomBitmap; - maskLine: packed array of byte; - maskStride: integer; - psrc: PBGRAPixel; - maskBit: byte; - maskPos,x,y: integer; - headerSize, dataSize: integer; -begin - AContent.Position:= 0; - format := DetectFileFormat(AContent); - case format of - ifBmp: - begin - reader := TBGRAReaderBMP.Create; - bmp := BGRABitmapFactory.Create; - try - AContent.Position := 0; - imageInfo := reader.GetQuickInfo(AContent); - if (imageInfo.width <= 0) or (imageInfo.height <= 0) or - (imageInfo.width > 256) or (imageInfo.height > 256) then - raise exception.Create('Invalid image size'); - AContent.Position := 0; - //load bitmap to build mask - bmp.LoadFromStream(AContent); - maskStride := ((bmp.Width+31) div 32)*4; - - tempStream := TMemoryStream.Create; - //BMP header is not stored in icon/cursor - AContent.Position:= sizeof(TBitMapFileHeader); - tempStream.CopyFrom(AContent, AContent.Size - sizeof(TBitMapFileHeader)); - AContent.Free; - - //fix height - tempStream.Position := 0; - headerSize := LEtoN(tempStream.ReadDWord); - if headerSize = sizeof(TOS2BitmapHeader) then // OS/2 1.x - begin - tempStream.Position := 6; - tempStream.WriteWord(NtoLE(word(bmp.Height*2))); //include mask size - end else - begin - tempStream.Position := 8; - tempStream.WriteDWord(NtoLE(LongWord(bmp.Height*2))); //include mask size - if headerSize >= 20+4 then - begin - tempStream.Position:= 20; - dataSize := LEtoN(tempStream.ReadDWord); - if dataSize <> 0 then - begin //if data size is supplied, include mask size - inc(dataSize, maskStride*bmp.Height); - tempStream.Position:= 20; - tempStream.WriteDWord(NtoLE(dataSize)); - end; - end; - end; - - //build mask - tempStream.Position := tempStream.Size; - setlength(maskLine, maskStride); - for y := bmp.Height-1 downto 0 do - begin - maskBit := $80; - maskPos := 0; - psrc := bmp.ScanLine[y]; - fillchar(maskLine[0], length(maskLine), 0); - for x := 0 to bmp.Width-1 do - begin - if psrc^.alpha = 0 then - maskLine[maskPos] := maskLine[maskPos] or maskBit; - maskBit := maskBit shr 1; - if maskBit = 0 then - begin - maskBit := $80; - inc(maskPos); - end; - inc(psrc); - end; - tempStream.WriteBuffer(maskLine[0], length(maskLine)); - end; - - result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, tempStream); - finally - bmp.Free; - reader.Free; - end; - end; - ifPng: - begin - reader := TBGRAReaderPNG.Create; - imageInfo := reader.GetQuickInfo(AContent); - reader.Free; - result := TBGRAIconCursorEntry.Create(AContainer, 'png', imageInfo, AContent); - - end; - ifUnknown, ifLazPaint {a headerless bmp can be confused for a headerless lzp}: - begin - //assume headerless BMP - AContent.Position := 0; - reader := TBGRAReaderBMP.Create; - imageInfo := reader.GetQuickInfo(AContent); - imageInfo.Height:= imageInfo.Height div 2; //mask size is included - reader.Free; - if (imageInfo.width <= 0) or (imageInfo.height <= 0) or - (imageInfo.width > 256) or (imageInfo.height > 256) then - raise exception.Create('Invalid image size'); - result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, AContent); - end; - else - raise exception.Create(SuggestImageExtension(format) + ' format is not handled'); - end; -end; - -destructor TBGRAIconCursorEntry.Destroy; -begin - FContent.Free; - inherited Destroy; -end; - -function TBGRAIconCursorEntry.CopyTo(ADestination: TStream): int64; -begin - if FContent.Size = 0 then - begin - result := 0; - exit; - end; - - FContent.Position := 0; - result := ADestination.CopyFrom(FContent, FContent.Size); -end; - -function TBGRAIconCursorEntry.GetStream: TStream; -begin - Result:= FContent; -end; - -function TBGRAIconCursorEntry.GetBitmap: TBGRACustomBitmap; -var reader: TBGRAImageReader; -begin - if Extension = 'dib' then - begin - reader := TBGRAReaderBMP.Create; - TBGRAReaderBMP(reader).Subformat := bsfHeaderlessWithMask; - end else - reader := TBGRAReaderPNG.create; - - result := BGRABitmapFactory.Create; - FContent.Position := 0; - try - result.LoadFromStream(FContent, reader); - except on ex: Exception do - begin - result.Free; - reader.Free; - raise ex; - end; - end; - reader.Free; - - result.HotSpot := HotSpot; -end; - -function TBGRAIconCursorEntry.GetName: utf8string; -begin - result := IntToStr(FWidth)+'x'+IntToStr(FHeight)+'x'+IntToStr(FBitDepth); -end; - -procedure TBGRAIconCursorEntry.SetName(AValue: utf8string); -begin - raise exception.Create('Name cannot be changed'); -end; - -function TBGRAIconCursorEntry.GetExtension: utf8string; -begin - result := FExtension; -end; - -function TBGRAIconCursorEntry.GetFileSize: int64; -begin - result := FContent.Size; -end; - -{ TBGRAIconCursor } - -function TBGRAIconCursor.GetBitDepthAt(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); - result := TBGRAIconCursorEntry(Entry[AIndex]).BitDepth; -end; - -function TBGRAIconCursor.GetHeightAt(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); - result := TBGRAIconCursorEntry(Entry[AIndex]).Height; -end; - -function TBGRAIconCursor.GetHotSpotAtAt(AIndex: integer): TPoint; -begin - if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); - result := TBGRAIconCursorEntry(Entry[AIndex]).HotSpot; -end; - -function TBGRAIconCursor.GetWidthAt(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); - result := TBGRAIconCursorEntry(Entry[AIndex]).Width; -end; - -procedure TBGRAIconCursor.SetFileType(AValue: TBGRAImageFormat); -begin - if FFileType=AValue then Exit; - if not (AValue in [ifIco,ifCur,ifUnknown]) then - raise exception.Create('Allowed formats: ICO, CUR or unknown'); - FFileType:=AValue; -end; - -procedure TBGRAIconCursor.SetHotSpotAt(AIndex: integer; AValue: TPoint); -begin - if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); - TBGRAIconCursorEntry(Entry[AIndex]).HotSpot := AValue; -end; - -function TBGRAIconCursor.CreateEntry(AName: utf8string; - AExtension: utf8string; AContent: TStream): TMultiFileEntry; -begin - AExtension := UTF8LowerCase(AExtension); - if (AExtension <> 'png') and (AExtension <> 'dib') then - raise exception.Create('The only supported extensions are PNG and DIB'); - - result := TBGRAIconCursorEntry.TryCreate(self, AContent); - if result.Extension <> AExtension then - begin - result.Free; - raise exception.Create(AExtension + ' file extension expected but ' + result.Extension + ' found'); - end; - - if result.Name <> AName then - begin - result.Free; - raise exception.Create('"' + AName + '" dimension expected but "' + result.Name + '" found'); - end; -end; - -function TBGRAIconCursor.ExpectedMagic: Word; -begin - case FFileType of - ifIco: result := ICON_OR_CURSOR_FILE_ICON_TYPE; - ifCur: result := ICON_OR_CURSOR_FILE_CURSOR_TYPE; - else - raise exception.Create('Invalid icon/cursor type'); - end; -end; - -procedure TBGRAIconCursor.Init; -begin - inherited Init; - FFileType:= ifUnknown; -end; - -procedure TBGRAIconCursor.AssignTo(Dest: TPersistent); -{$IFDEF BGRABITMAP_USE_LCL} -var - temp: TMemoryStream; -{$ENDIF} -begin - {$IFDEF BGRABITMAP_USE_LCL} - if Dest is TCustomIcon then - begin - temp := TMemoryStream.Create; - try - SaveToStream(temp); - temp.Position:= 0; - TCustomIcon(Dest).LoadFromStream(temp); - finally - temp.Free; - end; - end else - {$ENDIF} - inherited AssignTo(Dest); -end; - -constructor TBGRAIconCursor.Create(AFileType: TBGRAImageFormat); -begin - if not (AFileType in [ifIco,ifCur,ifUnknown]) then - raise exception.Create('Allowed formats: ICO, CUR or unknown'); - - Init; - FFileType := AFileType; -end; - -function TBGRAIconCursor.Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer; - AOverwrite: boolean): integer; -var stream, temp: TStream; - writer: TFPWriterBMP; - bmpXOR: TBGRACustomBitmap; - y: Integer; - psrcMask, pdest: PBGRAPixel; - bitAndMask: array of byte; - bitAndMaskPos: integer; - bitAndMaskBit: byte; - bitAndMaskRowSize, x: integer; - palette: TBGRAPalette; - writerPng: TBGRAWriterPNG; - -begin - stream := TMemoryStream.Create; - try - //PNG format is advised from 256 on but does not handle XOR - if ((ABitmap.Width >= 256) or (ABitmap.Height >= 256)) and (ABitDepth >= 8) and - ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) then - begin - writerPng := TBGRAWriterPNG.Create; - try - writerPng.WordSized := false; - if ABitDepth = 8 then - begin - writerPng.Indexed := true; - writerpng.UseAlpha := ABitmap.HasTransparentPixels; - end else - begin - writerPng.Indexed := false; - writerpng.UseAlpha := (ABitDepth = 32); - end; - ABitmap.SaveToStream(stream, writerPng); - finally - writerPng.Free; - end; - result := Add(stream, AOverwrite, true); - stream := nil; - end else - if ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) and - (not ABitmap.HasTransparentPixels or (ABitDepth = 32)) then - begin - writer := TFPWriterBMP.Create; - writer.BitsPerPixel := ABitDepth; - try - if not ABitmap.UsePalette and (ABitDepth < 24) then - begin - palette := TBGRAPalette.Create(ABitmap); - try - palette.AssignTo(ABitmap); - finally - palette.Free; - end; - ABitmap.SaveToStream(stream, writer); - ABitmap.UsePalette:= false; - end - else - ABitmap.SaveToStream(stream, writer); - finally - writer.Free; - end; - result := Add(stream, AOverwrite, true); - stream := nil; - end else - begin - bmpXOR := BGRABitmapFactory.Create(ABitmap); - try - bitAndMaskRowSize := ((bmpXOR.Width+31) div 32)*4; - setlength(bitAndMask, bitAndMaskRowSize*bmpXOR.Height); - for y := bmpXOR.Height-1 downto 0 do - begin - if assigned(ABitmap.XorMask) then - psrcMask := ABitmap.XorMask.ScanLine[y] - else - psrcMask := nil; - pdest := bmpXOR.ScanLine[y]; - bitAndMaskPos := (bmpXOR.Height-1-y)*bitAndMaskRowSize; - bitAndMaskBit:= $80; - for x := bmpXOR.Width-1 downto 0 do - begin - //xor mask is either 100% or 0% - if assigned(psrcMask) and ((psrcMask^.red <> 0) or (psrcMask^.green <> 0) or (psrcMask^.blue <> 0)) then - begin - pdest^ := psrcMask^; - pdest^.alpha := 255; - bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit; - end else - if pdest^.alpha = 0 then - begin - bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit; - if ABitDepth <= 24 then //if we cannot save alpha, replace with black. - begin //mask will task care of making it transparent - pdest^ := BGRABlack; - end; - end; - - bitAndMaskBit := bitAndMaskBit shr 1; - if bitAndMaskBit = 0 then - begin - bitAndMaskBit := $80; - inc(bitAndMaskPos); - end; - if assigned(psrcMask) then inc(psrcMask); - inc(pdest); - end; - end; - bmpXOR.InvalidateBitmap; - - if ABitDepth < 24 then - begin - palette := TBGRAPalette.Create(bmpXor); - palette.AssignTo(bmpXor); - palette.Free; - end; - - temp := TMemoryStream.Create; - try - writer := TFPWriterBMP.Create; - writer.BitsPerPixel := ABitDepth; - try - bmpXOR.SaveToStream(temp, writer); - //write double height to include mask - temp.Position := 22; - temp.WriteDWord(NtoLE(LongWord(bmpXOR.Height*2))); - //go after the file header - temp.Position := 14; - //copy bitmap without header - stream.CopyFrom(temp, temp.Size-temp.Position); - finally - writer.Free; - end; - finally - temp.Free; - end; - //write mask - stream.WriteBuffer(bitAndMask[0],length(bitAndMask)); - result := Add(stream, AOverwrite, true); - stream := nil; - finally - bmpXOR.Free; - end; - end; - - finally - stream.Free; - end; -end; - -function TBGRAIconCursor.Add(AContent: TStream; AOverwrite: boolean; - AOwnStream: boolean): integer; -var - index,i: Integer; - newEntry: TBGRAIconCursorEntry; - contentCopy: TMemoryStream; -begin - if not AOwnStream then - begin - AContent.Position:= 0; - contentCopy := TMemoryStream.Create; - contentCopy.CopyFrom(AContent, AContent.Size); - newEntry := TBGRAIconCursorEntry.TryCreate(self, contentCopy); - end else - newEntry := TBGRAIconCursorEntry.TryCreate(self, AContent); - - index := IndexOf(newEntry.Name, newEntry.Extension); - if index <> -1 then - begin - if AOverwrite then - Delete(index) - else - begin - newEntry.Free; - raise Exception.Create('Duplicate entry'); - end; - end else if not FLoading then - begin - for i := 0 to Count-1 do - if ((Width[i] < newEntry.Width) and (Height[i] < newEntry.Height)) or - ((Width[i] = newEntry.Width) and (Height[i] = newEntry.Height) and (BitDepth[i] < newEntry.BitDepth)) then - begin - index := i; - break; - end; - end; - result := AddEntry(newEntry, index); -end; - -procedure TBGRAIconCursor.LoadFromStream(AStream: TStream); -var header: TGroupIconHeader; - dir: packed array of TIconFileDirEntry; - startPos: int64; - entryContent: TMemoryStream; - entryIndex, i: integer; -begin - FLoading:= true; - try - startPos := AStream.Position; - AStream.ReadBuffer({%H-}header, sizeof(header)); - header.SwapIfNecessary; - if header.Reserved <> 0 then - raise exception.Create('Invalid file format'); - if FileType = ifUnknown then - begin - case header.ResourceType of - ICON_OR_CURSOR_FILE_ICON_TYPE: FFileType := ifIco; - ICON_OR_CURSOR_FILE_CURSOR_TYPE: FFileType := ifCur; - end; - end; - if header.ResourceType <> ExpectedMagic then - raise exception.Create('Invalid resource type'); - Clear; - setlength(dir, header.ImageCount); - AStream.ReadBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir)); - for i := 0 to high(dir) do - begin - AStream.Position:= LEtoN(dir[i].ImageOffset) + startPos; - entryContent := TMemoryStream.Create; - entryContent.CopyFrom(AStream, LEtoN(dir[i].ImageSize)); - entryIndex := Add(entryContent, false, true); - if ((dir[i].Width = 0) and (Width[entryIndex] < 256)) or - ((dir[i].Width > 0) and (Width[entryIndex] <> dir[i].Width)) or - ((dir[i].Height = 0) and (Height[entryIndex] < 256)) or - ((dir[i].Height > 0) and (Height[entryIndex] <> dir[i].Height)) then - raise Exception.Create('Inconsistent image size'); - if FFileType = ifCur then - TBGRAIconCursorEntry(Entry[entryIndex]).HotSpot := Point(LEtoN(dir[i].HotSpotX),LEtoN(dir[i].HotSpotY)); - end; - finally - FLoading:= false; - end; -end; - -procedure TBGRAIconCursor.SaveToStream(ADestination: TStream); -var header: TGroupIconHeader; - i: integer; - accSize: LongWord; - dir: packed array of TIconFileDirEntry; - contentSize: LongWord; -begin - if Count = 0 then - raise exception.Create('File cannot be empty'); - if FileType = ifUnknown then - raise exception.Create('You need to specify the file type'); - header.ImageCount:= Count; - header.Reserved := 0; - header.ResourceType:= ExpectedMagic; - header.SwapIfNecessary; - accSize := sizeof(header) + sizeof(TIconFileDirEntry)*Count; - setlength(dir, Count); - for i := 0 to Count-1 do - begin - if Width[i] >= 256 - then dir[i].Width := 0 - else dir[i].Width := Width[i]; - - if Height[i] >= 256 - then dir[i].Height := 0 - else dir[i].Height := Height[i]; - - if BitDepth[i] < 8 then - dir[i].Colors := 1 shl BitDepth[i] - else - dir[i].Colors := 0; - dir[i].Reserved := 0; - case FFileType of - ifCur: begin dir[i].HotSpotX:= NtoLE(Word(HotSpot[i].X)); dir[i].HotSpotY := NtoLE(Word(HotSpot[i].Y)); end; - ifIco: begin dir[i].BitsPerPixel:= NtoLE(Word(BitDepth[i])); dir[i].Planes := NtoLE(Word(1)); end; - else dir[i].Variable:= 0; - end; - dir[i].ImageOffset := LEtoN(accSize); - contentSize:= Entry[i].FileSize; - dir[i].ImageSize := NtoLE(contentSize); - inc(accSize,contentSize); - end; - - ADestination.WriteBuffer(header, sizeof(header)); - ADestination.WriteBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir)); - for i := 0 to Count-1 do - if Entry[i].CopyTo(ADestination) <> Entry[i].FileSize then - raise exception.Create('Unable to write data in stream'); -end; - -function TBGRAIconCursor.GetBitmap(AIndex: integer): TBGRACustomBitmap; -begin - if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds'); - result := TBGRAIconCursorEntry(Entry[AIndex]).GetBitmap; -end; - -function TBGRAIconCursor.GetBestFitBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; -var bestIndex: integer; - bestSizeDiff: integer; - bestBPP: integer; - sizeDiff, i: integer; -begin - bestBPP := 0; - bestSizeDiff := high(integer); - bestIndex := -1; - for i := 0 to Count-1 do - begin - sizeDiff := abs(AWidth-Width[i])+abs(AHeight-Height[i]); - if (sizeDiff < bestSizeDiff) or - ((sizeDiff = bestSizeDiff) and (BitDepth[i] > bestBPP)) then - begin - bestIndex := i; - bestSizeDiff:= sizeDiff; - bestBPP:= BitDepth[i]; - end; - end; - if bestIndex = -1 then - raise Exception.Create('No bitmap found') - else - result := GetBitmap(bestIndex); -end; - -function TBGRAIconCursor.IndexOf(AWidth, AHeight, ABitDepth: integer): integer; -var - i: Integer; -begin - for i := 0 to Count-1 do - if (Width[i] = AWidth) and (Height[i] = AHeight) and (BitDepth[i] = ABitDepth) then - begin - result := i; - exit; - end; - result := -1; -end; - -procedure TBGRAIconCursor.Assign(Source: TPersistent); -{$IFDEF BGRABITMAP_USE_LCL} -var - temp: TMemoryStream; -{$ENDIF} -begin - {$IFDEF BGRABITMAP_USE_LCL} - if Source is TCustomIcon then - begin - temp := TMemoryStream.Create; - try - TCustomIcon(Source).SaveToStream(temp); - temp.Position:= 0; - LoadFromStream(temp); - finally - temp.Free; - end; - end else - {$ENDIF} - inherited Assign(Source); -end; - -end. - diff --git a/components/bgrabitmap/bgralayeroriginal.pas b/components/bgrabitmap/bgralayeroriginal.pas deleted file mode 100644 index 7402128..0000000 --- a/components/bgrabitmap/bgralayeroriginal.pas +++ /dev/null @@ -1,2252 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRALayerOriginal; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmap, BGRABitmapTypes, BGRATransform, BGRAMemDirectory, fgl - {$IFDEF BGRABITMAP_USE_LCL},LCLType{$ENDIF}; - -type - PRectF = BGRABitmapTypes.PRectF; - TAffineMatrix = BGRATransform.TAffineMatrix; - TBGRALayerCustomOriginal = class; - TBGRAOriginalDiff = class; - TBGRALayerOriginalAny = class of TBGRALayerCustomOriginal; - TOriginalMovePointEvent = procedure(ASender: TObject; APrevCoord, ANewCoord: TPointF; AShift: TShiftState) of object; - TOriginalStartMovePointEvent = procedure(ASender: TObject; AIndex: integer; AShift: TShiftState) of object; - TOriginalClickPointEvent = procedure(ASender: TObject; AIndex: integer; AShift: TShiftState) of object; - TOriginalHoverPointEvent = procedure(ASender: TObject; AIndex: integer) of object; - TOriginalChangeEvent = procedure(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff) of object; - TOriginalEditingChangeEvent = procedure(ASender: TObject) of object; - TOriginalEditorCursor = (oecDefault, oecMove, oecMoveW, oecMoveE, oecMoveN, oecMoveS, - oecMoveNE, oecMoveSW, oecMoveNW, oecMoveSE, oecHandPoint, oecText); - TSpecialKey = (skUnknown, skBackspace, skTab, skReturn, skEscape, - skPageUp, skPageDown, skHome, skEnd, - skLeft, skUp, skRight, skDown, - skInsert, skDelete, - skNum0, skNum1, skNum2, skNum3, skNum4, skNum5, skNum6, skNum7, skNum8, skNum9, - skF1, skF2, skF3, skF4, skF5, skF6, skF7, skF8, skF9, skF10, skF11, skF12, - skA, skB, skC, skD, skE, skF, skG, skH, skI, skJ, skK, skL, skM, skN, skO, skP, skQ, skR, skS, skT, skU, skV, skW, skX, skY, skZ, - sk0, sk1, sk2, sk3, sk4, sk5, sk6, sk7, sk8, sk9, - skShift, skCtrl, skAlt); - -const - SpecialKeyStr: array[TSpecialKey] of string = - ('Unknown', 'Backspace', 'Tab', 'Return', 'Escape', - 'PageUp', 'PageDown', 'Home', 'End', - 'Left', 'Up', 'Right', 'Down', - 'Insert', 'Delete', - 'Num0', 'Num1', 'Num2', 'Num3', 'Num4', 'Num5', 'Num6', 'Num7', 'Num8', 'Num9', - 'F1', 'F2', 'F3', 'F4', 'F5', 'F6', 'F7', 'F8', 'F9', 'F10', 'F11', 'F12', - 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', - '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', - 'Shift', 'Ctrl', 'Alt'); - -{$IFDEF BGRABITMAP_USE_LCL} -const - SpecialKeyToLCL: array[TSpecialKey] of Word = - (VK_UNKNOWN, VK_BACK,VK_TAB,VK_RETURN,VK_ESCAPE, - VK_PRIOR,VK_NEXT,VK_HOME,VK_END, - VK_LEFT,VK_UP,VK_RIGHT,VK_DOWN, - VK_INSERT,VK_DELETE, - VK_NUMPAD0,VK_NUMPAD1,VK_NUMPAD2,VK_NUMPAD3,VK_NUMPAD4,VK_NUMPAD5,VK_NUMPAD6,VK_NUMPAD7,VK_NUMPAD8,VK_NUMPAD9, - VK_F1,VK_F2,VK_F3,VK_F4,VK_F5,VK_F6,VK_F7,VK_F8,VK_F9,VK_F10,VK_F11,VK_F12, - VK_A, VK_B, VK_C, VK_D, VK_E, VK_F, VK_G, VK_H, VK_I, VK_J, VK_K, VK_L, VK_M, VK_N, VK_O, VK_P, VK_Q, VK_R, VK_S, VK_T, VK_U, VK_V, VK_W, VK_X, VK_Y, VK_Z, - VK_0, VK_1, VK_2, VK_3, VK_4, VK_5, VK_6, VK_7, VK_8, VK_9, - VK_SHIFT, VK_CONTROL, VK_MENU); - - function LCLKeyToSpecialKey(AKey: Word; AShift: TShiftState): TSpecialKey; -{$ENDIF} - -type - TStartMoveHandlers = specialize TFPGList; - TClickPointHandlers = specialize TFPGList; - THoverPointHandlers = specialize TFPGList; - TBGRAOriginalPolylineStyle = (opsNone, opsSolid, opsDash, opsDashWithShadow); - - { TBGRAOriginalEditor } - - TBGRAOriginalEditor = class - private - FFocused: boolean; - FOnFocusChanged: TNotifyEvent; - function GetIsMovingPoint: boolean; - function GetPointCoord(AIndex: integer): TPointF; - function GetPointCount: integer; - function GetPointHighlighted(AIndex: integer): boolean; - procedure SetFocused(AValue: boolean); - procedure SetPointHighlighted(AIndex: integer; AValue: boolean); - protected - FMatrix,FMatrixInverse: TAffineMatrix; //view matrix from original coord - FGridMatrix,FGridMatrixInverse: TAffineMatrix; //grid matrix in original coord - FGridActive: boolean; - FPoints: array of record - Origin, Coord: TPointF; - OnMove, OnAlternateMove: TOriginalMovePointEvent; - RightButton, Highlighted: boolean; - SnapToPoint: integer; - HitBox: TAffineBox; - end; - FPolylines: array of record - Coords: array of TPointF; - Closed: boolean; - Style: TBGRAOriginalPolylineStyle; - BackColor: TBGRAPixel; - end; - FPointSize: single; - FPointMoving: integer; - FPointWasMoved: boolean; - FPointCoordDelta: TPointF; - FMovingRightButton: boolean; - FPrevMousePos: TPointF; - FStartMoveHandlers: TStartMoveHandlers; - FCurHoverPoint: integer; - FHoverPointHandlers: THoverPointHandlers; - FClickPointHandlers: TClickPointHandlers; - function RenderPoint(ADest: TBGRABitmap; ACoord: TPointF; AAlternateColor: boolean; AHighlighted: boolean): TRect; virtual; - function GetRenderPointBounds(ACoord: TPointF; AHighlighted: boolean): TRect; virtual; - function RenderArrow(ADest: TBGRABitmap; AOrigin, AEndCoord: TPointF): TRect; virtual; - function GetRenderArrowBounds(AOrigin, AEndCoord: TPointF): TRect; virtual; - function RenderPolygon(ADest: TBGRABitmap; ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): TRect; virtual; - function GetRenderPolygonBounds(ACoords: array of TPointF): TRect; - procedure SetMatrix(AValue: TAffineMatrix); - procedure SetGridMatrix(AValue: TAffineMatrix); - procedure SetGridActive(AValue: boolean); - function GetMoveCursor(APointIndex: integer): TOriginalEditorCursor; virtual; - function GetFixedShiftForButton(AShift: TShiftState; ARightDown: boolean): TShiftState; - public - constructor Create; - destructor Destroy; override; - procedure Clear; virtual; - procedure AddStartMoveHandler(AOnStartMove: TOriginalStartMovePointEvent); - procedure AddClickPointHandler(AOnClickPoint: TOriginalClickPointEvent); - procedure AddHoverPointHandler(AOnHoverPoint: TOriginalHoverPointEvent); - function AddPoint(const ACoord: TPointF; AOnMove: TOriginalMovePointEvent; ARightButton: boolean = false; ASnapToPoint: integer = -1): integer; - procedure AddPointAlternateMove(AIndex: integer; AOnAlternateMove: TOriginalMovePointEvent); - function AddFixedPoint(const ACoord: TPointF; ARightButton: boolean = false): integer; - function AddArrow(const AOrigin, AEndCoord: TPointF; AOnMoveEnd: TOriginalMovePointEvent; ARightButton: boolean = false): integer; - function AddPolyline(const ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle): integer; overload; - function AddPolyline(const ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): integer; overload; - procedure SetHitBox(AIndex: integer; AHitBox: TAffineBox); - procedure MouseMove(Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual; - procedure MouseDown(RightButton: boolean; Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual; - procedure MouseUp(RightButton: boolean; {%H-}Shift: TShiftState; {%H-}ViewX, {%H-}ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual; - procedure KeyDown({%H-}Shift: TShiftState; {%H-}Key: TSpecialKey; out AHandled: boolean); virtual; - procedure KeyUp({%H-}Shift: TShiftState; {%H-}Key: TSpecialKey; out AHandled: boolean); virtual; - procedure KeyPress({%H-}UTF8Key: string; out AHandled: boolean); virtual; - function GetPointAt(const ACoord: TPointF; ARightButton: boolean): integer; - function Render(ADest: TBGRABitmap; const {%H-}ALayoutRect: TRect): TRect; virtual; - function GetRenderBounds(const {%H-}ALayoutRect: TRect): TRect; virtual; - function SnapToGrid(const ACoord: TPointF; AIsViewCoord: boolean): TPointF; - function OriginalCoordToView(const AImageCoord: TPointF): TPointF; - function ViewCoordToOriginal(const AViewCoord: TPointF): TPointF; - property Matrix: TAffineMatrix read FMatrix write SetMatrix; - property GridMatrix: TAffineMatrix read FGridMatrix write SetGridMatrix; - property GridActive: boolean read FGridActive write SetGridActive; - property Focused: boolean read FFocused write SetFocused; - property PointSize: single read FPointSize write FPointSize; - property PointCount: integer read GetPointCount; - property PointCoord[AIndex: integer]: TPointF read GetPointCoord; - property PointHighlighted[AIndex: integer]: boolean read GetPointHighlighted write SetPointHighlighted; - property OnFocusChanged: TNotifyEvent read FOnFocusChanged write FOnFocusChanged; - property IsMovingPoint: boolean read GetIsMovingPoint; - end; - - TBGRACustomOriginalStorage = class; - ArrayOfSingle = array of single; - - TBGRAOriginalDiff = class - procedure Apply(AOriginal: TBGRALayerCustomOriginal); virtual; abstract; - procedure Unapply(AOriginal: TBGRALayerCustomOriginal); virtual; abstract; - function CanAppend(ADiff: TBGRAOriginalDiff): boolean; virtual; abstract; - procedure Append(ADiff: TBGRAOriginalDiff); virtual; abstract; - function IsIdentity: boolean; virtual; abstract; - end; - - { TBGRALayerCustomOriginal } - - TBGRALayerCustomOriginal = class - private - FOnChange: TOriginalChangeEvent; - FOnEditingChange: TOriginalEditingChangeEvent; - FRenderStorage: TBGRACustomOriginalStorage; - function GetDiffExpected: boolean; - procedure SetOnChange(AValue: TOriginalChangeEvent); - procedure SetRenderStorage(AValue: TBGRACustomOriginalStorage); - protected - FGuid: TGuid; - function GetGuid: TGuid; - procedure SetGuid(AValue: TGuid); - procedure NotifyChange(ADiff: TBGRAOriginalDiff = nil); overload; - procedure NotifyChange(ABounds: TRectF; ADiff: TBGRAOriginalDiff = nil); overload; - procedure NotifyEditorChange; - property DiffExpected: boolean read GetDiffExpected; - public - constructor Create; virtual; - destructor Destroy; override; - //one of the two Render functions must be overriden - procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); virtual; - procedure Render(ADest: TBGRABitmap; ARenderOffset: TPoint; AMatrix: TAffineMatrix; ADraft: boolean); virtual; - function GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix): TRect; virtual; abstract; - procedure ConfigureEditor({%H-}AEditor: TBGRAOriginalEditor); virtual; - procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); virtual; abstract; - procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); virtual; abstract; - procedure LoadFromFile(AFilenameUTF8: string); virtual; - procedure LoadFromStream(AStream: TStream); virtual; - procedure LoadFromResource(AFilename: string); - procedure SaveToFile(AFilenameUTF8: string); virtual; - procedure SaveToStream(AStream: TStream); virtual; - function CreateEditor: TBGRAOriginalEditor; virtual; - class function StorageClassName: RawByteString; virtual; abstract; - class function CanConvertToSVG: boolean; virtual; - function IsInfiniteSurface: boolean; virtual; - function ConvertToSVG(const {%H-}AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; virtual; - function Duplicate: TBGRALayerCustomOriginal; virtual; - property Guid: TGuid read GetGuid write SetGuid; - property OnChange: TOriginalChangeEvent read FOnChange write SetOnChange; - property OnEditingChange: TOriginalEditingChangeEvent read FOnEditingChange write FOnEditingChange; - property RenderStorage: TBGRACustomOriginalStorage read FRenderStorage write SetRenderStorage; - end; - - TBGRALayerImageOriginal = class; - - { TBGRAImageOriginalDiff } - - TBGRAImageOriginalDiff = class(TBGRAOriginalDiff) - protected - FContentVersionBefore,FContentVersionAfter: integer; - FImageBefore,FImageAfter: TBGRABitmap; - FJpegStreamBefore,FJpegStreamAfter: TMemoryStream; - public - constructor Create(AFromOriginal: TBGRALayerImageOriginal); - destructor Destroy; override; - procedure ComputeDiff(AToOriginal: TBGRALayerImageOriginal); - procedure Apply(AOriginal: TBGRALayerCustomOriginal); override; - procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override; - function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override; - procedure Append(ADiff: TBGRAOriginalDiff); override; - function IsIdentity: boolean; override; - end; - - { TBGRALayerImageOriginal } - - TBGRALayerImageOriginal = class(TBGRALayerCustomOriginal) - private - function GetImageHeight: integer; - function GetImageWidth: integer; - protected - FImage: TBGRABitmap; - FJpegStream: TMemoryStream; - FContentVersion: integer; - FDiff: TBGRAImageOriginalDiff; - procedure BeginUpdate; - procedure EndUpdate; - procedure InternalLoadImageFromStream(AStream: TStream; AUpdate: boolean); - procedure InternalClear; - public - constructor Create; override; - destructor Destroy; override; - function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; override; - procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override; - function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix): TRect; override; - procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override; - procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override; - procedure LoadFromStream(AStream: TStream); override; - procedure Clear; - procedure LoadImageFromStream(AStream: TStream); - procedure SaveImageToStream(AStream: TStream); - procedure AssignImage(AImage: TBGRACustomBitmap); - function GetImageCopy: TBGRABitmap; - class function StorageClassName: RawByteString; override; - class function CanConvertToSVG: boolean; override; - property Width: integer read GetImageWidth; - property Height: integer read GetImageHeight; - end; - - { TBGRACustomOriginalStorage } - - TBGRACustomOriginalStorage = class - protected - FFormats: TFormatSettings; - function GetBool(AName: utf8string): boolean; - function GetBoolDef(AName: utf8string; ADefault: boolean): boolean; - function GetColorArray(AName: UTF8String): ArrayOfTBGRAPixel; - function GetInteger(AName: utf8string): integer; - function GetIntegerDef(AName: utf8string; ADefault: integer): integer; - function GetPointF(AName: utf8string): TPointF; - function GetRectF(AName: utf8string): TRectF; - function GetRect(AName: utf8string): TRect; - function GetAffineMatrix(AName: utf8string): TAffineMatrix; - function GetRawString(AName: utf8string): RawByteString; virtual; abstract; - function GetSingle(AName: utf8string): single; - function GetSingleArray(AName: utf8string): ArrayOfSingle; - function GetSingleDef(AName: utf8string; ADefault: single): single; - function GetColor(AName: UTF8String): TBGRAPixel; - procedure SetBool(AName: utf8string; AValue: boolean); - procedure SetColorArray(AName: UTF8String; AValue: ArrayOfTBGRAPixel); - procedure SetInteger(AName: utf8string; AValue: integer); - procedure SetPointF(AName: utf8string; AValue: TPointF); - procedure SetRectF(AName: utf8string; AValue: TRectF); - procedure SetRect(AName: utf8string; AValue: TRect); - procedure SetAffineMatrix(AName: utf8string; const AValue: TAffineMatrix); - procedure SetRawString(AName: utf8string; AValue: RawByteString); virtual; abstract; - procedure SetSingle(AName: utf8string; AValue: single); - procedure SetSingleArray(AName: utf8string; AValue: ArrayOfSingle); - procedure SetColor(AName: UTF8String; AValue: TBGRAPixel); - function GetDelimiter: char; - function GetEmpty: boolean; virtual; abstract; - public - constructor Create; - function Duplicate: TBGRACustomOriginalStorage; virtual; abstract; - procedure RemoveAttribute(AName: utf8string); virtual; abstract; - function HasAttribute(AName: utf8string): boolean; virtual; abstract; - procedure RemoveObject(AName: utf8string); virtual; abstract; - function CreateObject(AName: utf8string): TBGRACustomOriginalStorage; virtual; abstract; - function OpenObject(AName: utf8string): TBGRACustomOriginalStorage; virtual; abstract; - function ObjectExists(AName: utf8string): boolean; virtual; abstract; - procedure EnumerateObjects(AList: TStringList); virtual; abstract; - procedure EnumerateFiles(AList: TStringList); virtual; abstract; - procedure RemoveFile(AName: utf8string); virtual; abstract; - function GetFileStream(AName: UTF8String): TStream; virtual; abstract; - function ReadFile(AName: UTF8String; ADest: TStream): boolean; virtual; abstract; - function ReadBitmap(AName: UTF8String; ADest: TCustomUniversalBitmap): boolean; virtual; abstract; - procedure WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean = false); virtual; abstract; - function FileExists(AName: UTF8String): boolean; virtual; abstract; - function FloatEquals(AName: utf8string; AValue: single): boolean; - function PointFEquals(AName: utf8string; const AValue: TPointF): boolean; - function AffineMatrixEquals(AName: utf8string; const AValue: TAffineMatrix): boolean; - property RawString[AName: utf8string]: RawByteString read GetRawString write SetRawString; - property Int[AName: utf8string]: integer read GetInteger write SetInteger; - property IntDef[AName: utf8string; ADefault: integer]: integer read GetIntegerDef; - property Bool[AName: utf8string]: boolean read GetBool write SetBool; - property BoolDef[AName: utf8string; ADefault: boolean]: boolean read GetBoolDef; - property Float[AName: utf8string]: single read GetSingle write SetSingle; - property FloatArray[AName: utf8string]: ArrayOfSingle read GetSingleArray write SetSingleArray; - property FloatDef[AName: utf8string; ADefault: single]: single read GetSingleDef; - property PointF[AName: utf8string]: TPointF read GetPointF write SetPointF; - property RectangleF[AName: utf8string]: TRectF read GetRectF write SetRectF; - property Rectangle[AName: utf8string]: TRect read GetRect write SetRect; - property AffineMatrix[AName: utf8string]: TAffineMatrix read GetAffineMatrix write SetAffineMatrix; - property Color[AName: UTF8String]: TBGRAPixel read GetColor write SetColor; - property ColorArray[AName: UTF8String]: ArrayOfTBGRAPixel read GetColorArray write SetColorArray; - property Empty: boolean read GetEmpty; - end; - - { TBGRAMemOriginalStorage } - - TBGRAMemOriginalStorage = class(TBGRACustomOriginalStorage) - protected - FMemDir: TMemDirectory; - FMemDirOwned: boolean; - function GetRawString(AName: utf8string): RawByteString; override; - procedure SetRawString(AName: utf8string; AValue: RawByteString); override; - function GetEmpty: boolean; override; - public - destructor Destroy; override; - constructor Create; - constructor Create(AMemDir: TMemDirectory; AMemDirOwned: boolean = false); - function Equals(Obj: TObject): boolean; override; - function Duplicate: TBGRACustomOriginalStorage; override; - procedure RemoveAttribute(AName: utf8string); override; - function HasAttribute(AName: utf8string): boolean; override; - procedure RemoveObject(AName: utf8string); override; - function CreateObject(AName: utf8string): TBGRACustomOriginalStorage; override; - function OpenObject(AName: utf8string): TBGRACustomOriginalStorage; override; - function ObjectExists(AName: utf8string): boolean; override; - procedure EnumerateObjects(AList: TStringList); override; - procedure EnumerateFiles(AList: TStringList); override; - procedure RemoveFile(AName: utf8string); override; - function GetFileStream(AName: UTF8String): TStream; override; - function ReadBitmap(AName: UTF8String; ADest: TCustomUniversalBitmap): boolean; override; - function ReadFile(AName: UTF8String; ADest: TStream): boolean; override; - procedure WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean = false); override; - function FileExists(AName: UTF8String): boolean; override; - procedure SaveToStream(AStream: TStream); - procedure LoadFromStream(AStream: TStream); - procedure LoadFromResource(AFilename: string); - procedure CopyTo(AMemDir: TMemDirectory); - end; - -procedure RegisterLayerOriginal(AClass: TBGRALayerOriginalAny); -function FindLayerOriginalClass(AStorageClassName: string): TBGRALayerOriginalAny; - -implementation - -uses BGRAPolygon, math, BGRAMultiFileType, BGRAUTF8, BGRAGraphics, BGRASVG, BGRASVGShapes; - -{$IFDEF BGRABITMAP_USE_LCL} -function LCLKeyToSpecialKey(AKey: Word; AShift: TShiftState): TSpecialKey; -var - sk: TSpecialKey; -begin - if (((AKey >= VK_A) and (AKey <= VK_Z)) or - ((AKey >= VK_0) and (AKey <= VK_9))) and (AShift*[ssCtrl,ssAlt]=[]) then exit(skUnknown); - for sk := low(TSpecialKey) to high(TSpecialKey) do - if AKey = SpecialKeyToLCL[sk] then exit(sk); - exit(skUnknown); -end; -{$ENDIF} - -var - LayerOriginalClasses: array of TBGRALayerOriginalAny; - -procedure RegisterLayerOriginal(AClass: TBGRALayerOriginalAny); -begin - setlength(LayerOriginalClasses, length(LayerOriginalClasses)+1); - LayerOriginalClasses[high(LayerOriginalClasses)] := AClass; -end; - -function FindLayerOriginalClass(AStorageClassName: string): TBGRALayerOriginalAny; -var - i: Integer; -begin - for i := 0 to high(LayerOriginalClasses) do - if LayerOriginalClasses[i].StorageClassName = AStorageClassName then - exit(LayerOriginalClasses[i]); - exit(nil); -end; - -{ TBGRAImageOriginalDiff } - -constructor TBGRAImageOriginalDiff.Create(AFromOriginal: TBGRALayerImageOriginal); -begin - FImageBefore := AFromOriginal.FImage.NewReference; - if Assigned(AFromOriginal.FJpegStream) then - begin - FJpegStreamBefore := TMemoryStream.Create; - AFromOriginal.FJpegStream.Position:= 0; - FJpegStreamBefore.CopyFrom(AFromOriginal.FJpegStream, AFromOriginal.FJpegStream.Size); - end; - FContentVersionBefore:= AFromOriginal.FContentVersion; -end; - -procedure TBGRAImageOriginalDiff.ComputeDiff( - AToOriginal: TBGRALayerImageOriginal); -begin - if Assigned(FImageAfter) then FImageAfter.FreeReference; - FImageAfter := AToOriginal.FImage.NewReference; - FreeAndNil(FJpegStreamAfter); - if Assigned(AToOriginal.FJpegStream) then - begin - FJpegStreamAfter := TMemoryStream.Create; - AToOriginal.FJpegStream.Position:= 0; - FJpegStreamAfter.CopyFrom(AToOriginal.FJpegStream, AToOriginal.FJpegStream.Size); - end; - FContentVersionAfter:= AToOriginal.FContentVersion; -end; - -procedure TBGRAImageOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal); -var - orig: TBGRALayerImageOriginal; -begin - orig := AOriginal as TBGRALayerImageOriginal; - orig.FImage.FreeReference; - orig.FImage := FImageAfter.NewReference; - FreeAndNil(orig.FJpegStream); - if Assigned(FJpegStreamAfter) then - begin - orig.FJpegStream := TMemoryStream.Create; - FJpegStreamAfter.Position := 0; - orig.FJpegStream.CopyFrom(FJpegStreamAfter, FJpegStreamAfter.Size); - end; - orig.FContentVersion := FContentVersionAfter; -end; - -procedure TBGRAImageOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal); -var - orig: TBGRALayerImageOriginal; -begin - orig := AOriginal as TBGRALayerImageOriginal; - orig.FImage.FreeReference; - orig.FImage := FImageBefore.NewReference; - FreeAndNil(orig.FJpegStream); - if Assigned(FJpegStreamBefore) then - begin - orig.FJpegStream := TMemoryStream.Create; - FJpegStreamBefore.Position := 0; - orig.FJpegStream.CopyFrom(FJpegStreamBefore, FJpegStreamBefore.Size); - end; - orig.FContentVersion := FContentVersionBefore; -end; - -function TBGRAImageOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean; -begin - result := (ADiff is TBGRAImageOriginalDiff) and - (TBGRAImageOriginalDiff(ADiff).FContentVersionAfter >= FContentVersionAfter); -end; - -procedure TBGRAImageOriginalDiff.Append(ADiff: TBGRAOriginalDiff); -var - next: TBGRAImageOriginalDiff; -begin - next := ADiff as TBGRAImageOriginalDiff; - if next.FContentVersionAfter < FContentVersionAfter then - raise exception.Create('Cannot append diff made before this one.'); - FImageAfter.FreeReference; - FImageAfter := next.FImageAfter.NewReference; - FreeAndNil(FJpegStreamAfter); - if Assigned(next.FJpegStreamAfter) then - begin - FJpegStreamAfter := TMemoryStream.Create; - next.FJpegStreamAfter.Position:= 0; - FJpegStreamAfter.CopyFrom(next.FJpegStreamAfter, next.FJpegStreamAfter.Size); - end; - FContentVersionAfter:= next.FContentVersionAfter; -end; - -function TBGRAImageOriginalDiff.IsIdentity: boolean; -begin - result := FImageBefore.Equals(FImageAfter) and - ( ((FJpegStreamBefore=nil) and (FJpegStreamAfter=nil)) or - (Assigned(FJpegStreamBefore) and Assigned(FJpegStreamAfter) and - (FJpegStreamBefore.Size = FJpegStreamAfter.Size) and - CompareMem(FJpegStreamBefore.Memory,FJpegStreamBefore.Memory,FJpegStreamBefore.Size)) ); - -end; - -destructor TBGRAImageOriginalDiff.Destroy; -begin - FImageBefore.FreeReference; - FImageAfter.FreeReference; - FJpegStreamBefore.Free; - FJpegStreamAfter.Free; - inherited Destroy; -end; - -{ TBGRAOriginalEditor } - -procedure TBGRAOriginalEditor.SetMatrix(AValue: TAffineMatrix); -begin - if FMatrix=AValue then Exit; - FMatrix:=AValue; - FMatrixInverse := AffineMatrixInverse(FMatrix); -end; - -function TBGRAOriginalEditor.GetMoveCursor(APointIndex: integer): TOriginalEditorCursor; -var - d: TPointF; - ratio: single; -begin - if (APointIndex < 0) or (APointIndex >= PointCount) then result := oecDefault else - if isEmptyPointF(FPoints[APointIndex].Origin) then - begin - if Assigned(FPoints[APointIndex].OnMove) then - result := oecMove - else - result := oecHandPoint; - end else - begin - d := AffineMatrixLinear(FMatrix)*(FPoints[APointIndex].Coord - FPoints[APointIndex].Origin); - ratio := sin(Pi/8); - if (d.x = 0) and (d.y = 0) then result := oecMove else - if abs(d.x)*ratio >= abs(d.y) then - begin - if d.x >= 0 then result := oecMoveE else result := oecMoveW - end else - if abs(d.y)*ratio >= abs(d.x) then - begin - if d.y >= 0 then result := oecMoveS else result := oecMoveN - end else - if (d.x > 0) and (d.y > 0) then result := oecMoveSE else - if (d.x < 0) and (d.y < 0) then result := oecMoveNW else - if (d.x > 0) and (d.y < 0) then result := oecMoveNE - else result := oecMoveSW; - end; -end; - -function TBGRAOriginalEditor.GetFixedShiftForButton(AShift: TShiftState; - ARightDown: boolean): TShiftState; -begin - result := AShift - [ssLeft,ssMiddle,ssRight]; - if ARightDown then include(result, ssRight) - else include(result, ssLeft); -end; - -function TBGRAOriginalEditor.GetPointCoord(AIndex: integer): TPointF; -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - result := FPoints[AIndex].Coord; -end; - -function TBGRAOriginalEditor.GetIsMovingPoint: boolean; -begin - result := FPointMoving <> -1; -end; - -function TBGRAOriginalEditor.GetPointCount: integer; -begin - result := length(FPoints); -end; - -function TBGRAOriginalEditor.GetPointHighlighted(AIndex: integer): boolean; -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - result := FPoints[AIndex].Highlighted; -end; - -procedure TBGRAOriginalEditor.SetFocused(AValue: boolean); -begin - if FFocused=AValue then Exit; - FFocused:=AValue; - if Assigned(FOnFocusChanged) then FOnFocusChanged(self); -end; - -procedure TBGRAOriginalEditor.SetPointHighlighted(AIndex: integer; - AValue: boolean); -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - FPoints[AIndex].Highlighted := AValue; -end; - -procedure TBGRAOriginalEditor.SetGridActive(AValue: boolean); -begin - if FGridActive=AValue then Exit; - FGridActive:=AValue; -end; - -procedure TBGRAOriginalEditor.SetGridMatrix(AValue: TAffineMatrix); -begin - if FGridMatrix=AValue then Exit; - FGridMatrix:=AValue; - FGridMatrixInverse := AffineMatrixInverse(FGridMatrix); -end; - -function TBGRAOriginalEditor.RenderPoint(ADest: TBGRABitmap; ACoord: TPointF; AAlternateColor: boolean; AHighlighted: boolean): TRect; -const alpha = 192; -var filler: TBGRAMultishapeFiller; - c: TBGRAPixel; - penScale: Single; - oldClip: TRect; -begin - result := GetRenderPointBounds(ACoord, AHighlighted); - if not isEmptyPointF(ACoord) then - begin - oldClip := ADest.ClipRect; - ADest.IntersectClip(result); - if AAlternateColor then c := BGRA(255,128,128,alpha) - else if AHighlighted then c := BGRA(96,170,255,alpha) - else c := BGRA(255,255,255,alpha); - if AHighlighted then - ADest.GradientFill(result.Left, result.Top, result.Right, result.Bottom, - c, BGRAPixelTransparent, - gtRadial, PointF(ACoord.x,ACoord.y), PointF(result.right,ACoord.y), - dmDrawWithTransparency); - penScale := FPointSize / 6; - if penScale < 1 then penScale := 1; - filler := TBGRAMultishapeFiller.Create; - filler.AddEllipseBorder(ACoord.x,ACoord.y, FPointSize-2,FPointSize-2, 3.5*penScale, BGRA(0,0,0,alpha)); - filler.AddEllipseBorder(ACoord.x,ACoord.y, FPointSize-2,FPointSize-2, 1*penScale, c); - filler.PolygonOrder:= poLastOnTop; - filler.Draw(ADest); - filler.Free; - ADest.ClipRect := oldClip; - end; -end; - -function TBGRAOriginalEditor.GetRenderPointBounds(ACoord: TPointF; AHighlighted: boolean): TRect; -var - r, penScale: Single; -begin - if isEmptyPointF(ACoord) then - result := EmptyRect - else - begin - penScale := FPointSize / 6; - if penScale < 1 then penScale := 1; - r := FPointSize + (penScale-1)*4; - if AHighlighted then r := max(r, FPointSize*2); - result := rect(floor(ACoord.x - r + 0.5), floor(ACoord.y - r + 0.5), - ceil(ACoord.x + r + 0.5), ceil(ACoord.y + r + 0.5)); - end; -end; - -function TBGRAOriginalEditor.RenderArrow(ADest: TBGRABitmap; AOrigin, - AEndCoord: TPointF): TRect; -const alpha = 192; -var - pts, ptsContour: ArrayOfTPointF; - i: Integer; - rF: TRectF; - penScale: Single; -begin - if isEmptyPointF(AOrigin) or isEmptyPointF(AEndCoord) then - result := EmptyRect - else - begin - penScale := FPointSize / 6; - if penScale < 1 then penScale := 1; - ADest.Pen.Arrow.EndAsClassic; - ADest.Pen.Arrow.EndSize := PointF(FPointSize/penScale,FPointSize/penScale); - pts := ADest.ComputeWidePolyline([AOrigin,AEndCoord],1*penScale); - ADest.Pen.Arrow.EndAsNone; - ptsContour := ADest.ComputeWidePolygon(pts, 2*penScale); - ADest.FillPolyAntialias(ptsContour, BGRA(0,0,0,alpha)); - ADest.FillPolyAntialias(pts, BGRA(255,255,255,alpha)); - rF := RectF(AOrigin,AEndCoord); - for i := 0 to high(ptsContour) do - if not isEmptyPointF(ptsContour[i]) then - begin - if ptsContour[i].x < rF.Left then rF.Left := ptsContour[i].x; - if ptsContour[i].x > rF.Right then rF.Right := ptsContour[i].x; - if ptsContour[i].y < rF.Top then rF.Top := ptsContour[i].y; - if ptsContour[i].y > rF.Bottom then rF.Bottom := ptsContour[i].y; - end; - result := rect(floor(rF.Left+0.5),floor(rF.Top+0.5),ceil(rF.Right+0.5),ceil(rF.Bottom+0.5)); - end; -end; - -function TBGRAOriginalEditor.GetRenderArrowBounds(AOrigin, AEndCoord: TPointF): TRect; -var - penScale, margin: Single; -begin - if isEmptyPointF(AOrigin) or isEmptyPointF(AEndCoord) then - result := EmptyRect - else - begin - penScale := FPointSize / 6; - if penScale < 1 then penScale := 1; - margin := penScale * 1.5; - result := Rect(floor(AOrigin.x+0.5-margin),floor(AOrigin.y+0.5-margin), - ceil(AOrigin.x+0.5+margin),ceil(AOrigin.y+0.5+margin)); - result.Union( rect(floor(AEndCoord.x+0.5-FPointSize-margin), floor(AEndCoord.y+0.5-FPointSize-margin), - ceil(AEndCoord.x+0.5+FPointSize+margin), ceil(AEndCoord.y+0.5+FPointSize+margin)) ); - end; -end; - -function TBGRAOriginalEditor.RenderPolygon(ADest: TBGRABitmap; - ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): TRect; -var - dashLen: integer; - i: integer; - ptsF: array of TPointF; - pts1,pts2: array of TPoint; -begin - dashLen := round(PointSize/2); - if dashLen < 1 then dashLen := 1; - - setlength(pts1, length(ACoords)); - for i := 0 to high(ACoords) do - pts1[i] := ACoords[i].Round; - - setlength(ptsF, length(pts1)); - for i := 0 to high(pts1) do - ptsF[i] := PointF(pts1[i]); - - if ABackColor.alpha <> 0 then - ADest.FillPolyAntialias(ptsF, ABackColor); - - case AStyle of - opsDash, opsDashWithShadow: - begin - if AStyle = opsDashWithShadow then - begin - //shadow - setlength(pts2,length(pts1)); - for i := 0 to high(pts1) do - if not isEmptyPoint(pts1[i]) then - pts2[i] := Point(pts1[i].x+1,pts1[i].y+1) - else pts2[i] := EmptyPoint; - if AClosed then - ADest.DrawPolygonAntialias(pts2, BGRA(0,0,0,96)) - else - ADest.DrawPolyLineAntialias(pts2, BGRA(0,0,0,96), true); - pts2:= nil; - end; - - //dotted line - if AClosed then - ADest.DrawPolygonAntialias(pts1, CSSIvory,BGRA(70,70,50),dashLen) - else - ADest.DrawPolyLineAntialias(pts1, CSSIvory,BGRA(70,70,50),dashLen, true); - end; - opsSolid: - begin - ADest.JoinStyle:= pjsRound; - ADest.LineCap:= pecRound; - //black outline - if AClosed then - ADest.DrawPolygonAntialias(ptsF, BGRA(0,0,0,192), 3) - else - ADest.DrawPolyLineAntialias(ptsF, BGRA(0,0,0,192), 3); - - if AClosed then - ADest.DrawPolygonAntialias(pts1, CSSIvory) - else - ADest.DrawPolyLineAntialias(pts1, CSSIvory, true); - end; - end; - - result := GetRenderPolygonBounds(ACoords); -end; - -function TBGRAOriginalEditor.GetRenderPolygonBounds(ACoords: array of TPointF): TRect; -var - first: Boolean; - rF: TRectF; - i: Integer; -begin - first:= true; - rF:= EmptyRectF; - for i := 0 to high(ACoords) do - if not isEmptyPointF(ACoords[i]) then - begin - if first then - begin - rF := RectF(Acoords[i],ACoords[i]); - first:= false; - end else - begin - if ACoords[i].x < rF.Left then rF.Left := ACoords[i].x; - if ACoords[i].x > rF.Right then rF.Right := ACoords[i].x; - if ACoords[i].y < rF.Top then rF.Top := ACoords[i].y; - if ACoords[i].y > rF.Bottom then rF.Bottom := ACoords[i].y; - end; - end; - if not first then - result := rect(floor(rF.Left-0.5),floor(rF.Top-0.5),ceil(rF.Right+1.5),ceil(rF.Bottom+1.5)) - else - result := EmptyRect; -end; - -constructor TBGRAOriginalEditor.Create; -begin - FPointSize:= 6; - FMatrix := AffineMatrixIdentity; - FMatrixInverse := AffineMatrixIdentity; - FGridMatrix := AffineMatrixIdentity; - FGridMatrixInverse := AffineMatrixIdentity; - FGridActive:= false; - FPointMoving:= -1; - FStartMoveHandlers := TStartMoveHandlers.Create; - FCurHoverPoint:= -1; - FHoverPointHandlers := THoverPointHandlers.Create; - FClickPointHandlers := TClickPointHandlers.Create; -end; - -destructor TBGRAOriginalEditor.Destroy; -begin - FreeAndNil(FStartMoveHandlers); - FreeAndNil(FHoverPointHandlers); - FreeAndNil(FClickPointHandlers); - inherited Destroy; -end; - -procedure TBGRAOriginalEditor.Clear; -begin - FPoints := nil; - FPolylines := nil; - FStartMoveHandlers.Clear; - FHoverPointHandlers.Clear; - FClickPointHandlers.Clear; -end; - -procedure TBGRAOriginalEditor.AddStartMoveHandler( - AOnStartMove: TOriginalStartMovePointEvent); -begin - FStartMoveHandlers.Add(AOnStartMove); -end; - -procedure TBGRAOriginalEditor.AddClickPointHandler( - AOnClickPoint: TOriginalClickPointEvent); -begin - FClickPointHandlers.Add(AOnClickPoint); -end; - -procedure TBGRAOriginalEditor.AddHoverPointHandler( - AOnHoverPoint: TOriginalHoverPointEvent); -begin - FHoverPointHandlers.Add(AOnHoverPoint); -end; - -function TBGRAOriginalEditor.AddPoint(const ACoord: TPointF; - AOnMove: TOriginalMovePointEvent; ARightButton: boolean; ASnapToPoint: integer): integer; -begin - setlength(FPoints, length(FPoints)+1); - result := High(FPoints); - with FPoints[result] do - begin - Origin := EmptyPointF; - Coord := ACoord; - OnMove := AOnMove; - OnAlternateMove:= nil; - RightButton:= ARightButton; - SnapToPoint:= ASnapToPoint; - HitBox := TAffineBox.EmptyBox; - end; -end; - -procedure TBGRAOriginalEditor.AddPointAlternateMove(AIndex: integer; - AOnAlternateMove: TOriginalMovePointEvent); -begin - if (AIndex >= 0) and (AIndex < PointCount) then - FPoints[AIndex].OnAlternateMove:= AOnAlternateMove; -end; - -function TBGRAOriginalEditor.AddFixedPoint(const ACoord: TPointF; - ARightButton: boolean): integer; -begin - setlength(FPoints, length(FPoints)+1); - result := High(FPoints); - with FPoints[result] do - begin - Origin := EmptyPointF; - Coord := ACoord; - OnMove := nil; - OnAlternateMove:= nil; - RightButton:= ARightButton; - Highlighted:= false; - SnapToPoint:= -1; - HitBox := TAffineBox.EmptyBox; - end; -end; - -function TBGRAOriginalEditor.AddArrow(const AOrigin, AEndCoord: TPointF; - AOnMoveEnd: TOriginalMovePointEvent; ARightButton: boolean): integer; -begin - setlength(FPoints, length(FPoints)+1); - result := High(FPoints); - with FPoints[result] do - begin - Origin := AOrigin; - Coord := AEndCoord; - OnMove := AOnMoveEnd; - OnAlternateMove:= nil; - RightButton:= ARightButton; - Highlighted:= false; - SnapToPoint:= -1; - HitBox := TAffineBox.EmptyBox; - end; -end; - -function TBGRAOriginalEditor.AddPolyline(const ACoords: array of TPointF; - AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle): integer; -begin - result := AddPolyline(ACoords, AClosed, AStyle, BGRAPixelTransparent); -end; - -function TBGRAOriginalEditor.AddPolyline(const ACoords: array of TPointF; - AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): integer; -var - i: Integer; -begin - setlength(FPolylines, length(FPolylines)+1); - result := high(FPolylines); - setlength(FPolylines[result].Coords, length(ACoords)); - for i := 0 to high(ACoords) do - FPolylines[result].Coords[i] := ACoords[i]; - FPolylines[result].Closed:= AClosed; - FPolylines[result].Style := AStyle; - FPolylines[result].BackColor := ABackColor; -end; - -procedure TBGRAOriginalEditor.SetHitBox(AIndex: integer; AHitBox: TAffineBox); -begin - if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds'); - FPoints[AIndex].HitBox := AHitBox; -end; - -procedure TBGRAOriginalEditor.MouseMove(Shift: TShiftState; ViewX, ViewY: single; out - ACursor: TOriginalEditorCursor; out AHandled: boolean); -var newMousePos, newCoord, snapCoord: TPointF; - hoverPoint, i: Integer; - subShift: TShiftState; -begin - AHandled := false; - newMousePos := ViewCoordToOriginal(PointF(ViewX,ViewY)); - if (FPointMoving <> -1) and (FPointMoving < length(FPoints)) then - begin - newCoord := newMousePos + FPointCoordDelta; - if GridActive then newCoord := SnapToGrid(newCoord, false); - if FPoints[FPointMoving].SnapToPoint <> -1 then - begin - snapCoord := FPoints[FPoints[FPointMoving].SnapToPoint].Coord; - if VectLen(AffineMatrixLinear(FMatrix)*(snapCoord - newCoord)) < FPointSize then - newCoord := snapCoord; - end; - if newCoord <> FPoints[FPointMoving].Coord then - begin - FPointWasMoved:= true; - subShift := GetFixedShiftForButton(Shift, FMovingRightButton); - if (FMovingRightButton xor FPoints[FPointMoving].RightButton) and - Assigned(FPoints[FPointMoving].OnAlternateMove) then - FPoints[FPointMoving].OnAlternateMove(self, FPoints[FPointMoving].Coord, newCoord, subShift) - else - FPoints[FPointMoving].OnMove(self, FPoints[FPointMoving].Coord, newCoord, subShift); - if (FPointMoving >= 0) and (FPointMoving < length(FPoints)) then - FPoints[FPointMoving].Coord := newCoord - else - FPointMoving := -1; - end; - ACursor := GetMoveCursor(FPointMoving); - AHandled:= true; - end else - begin - hoverPoint := GetPointAt(newMousePos, false); - if hoverPoint <> -1 then - ACursor := GetMoveCursor(hoverPoint) - else - ACursor:= oecDefault; - if hoverPoint <> FCurHoverPoint then - begin - FCurHoverPoint:= hoverPoint; - for i := 0 to FHoverPointHandlers.Count-1 do - FHoverPointHandlers[i](self, FCurHoverPoint); - end; - end; - FPrevMousePos:= newMousePos; -end; - -procedure TBGRAOriginalEditor.MouseDown(RightButton: boolean; - Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out - AHandled: boolean); -var - i, clickedPoint: Integer; - subShift: TShiftState; -begin - AHandled:= false; - FPrevMousePos:= ViewCoordToOriginal(PointF(ViewX,ViewY)); - if FPointMoving = -1 then - begin - clickedPoint := GetPointAt(FPrevMousePos, RightButton); - if clickedPoint <> -1 then - begin - subShift := GetFixedShiftForButton(Shift, RightButton); - if Assigned(FPoints[clickedPoint].OnMove) then - begin - FPointMoving:= clickedPoint; - FPointWasMoved:= false; - FMovingRightButton:= RightButton; - FPointCoordDelta := FPoints[FPointMoving].Coord - FPrevMousePos; - for i := 0 to FStartMoveHandlers.Count-1 do - FStartMoveHandlers[i](self, FPointMoving, subShift); - end else - begin - for i := 0 to FClickPointHandlers.Count-1 do - FClickPointHandlers[i](self, clickedPoint, subShift); - end; - AHandled:= true; - end; - end; - if FPointMoving <> -1 then - begin - ACursor := GetMoveCursor(FPointMoving); - AHandled:= true; - end - else - ACursor := oecDefault; -end; - -procedure TBGRAOriginalEditor.MouseUp(RightButton: boolean; Shift: TShiftState; - ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); -var - i: Integer; - subShift: TShiftState; -begin - AHandled:= false; - if (RightButton = FMovingRightButton) and (FPointMoving <> -1) then - begin - if not FPointWasMoved then - begin - subShift := GetFixedShiftForButton(Shift, RightButton); - for i := 0 to FClickPointHandlers.Count-1 do - FClickPointHandlers[i](self, FPointMoving, subShift); - end; - FPointMoving:= -1; - AHandled:= true; - end; - ACursor := oecDefault; -end; - -procedure TBGRAOriginalEditor.KeyDown(Shift: TShiftState; Key: TSpecialKey; out - AHandled: boolean); -begin - AHandled := false; -end; - -procedure TBGRAOriginalEditor.KeyUp(Shift: TShiftState; Key: TSpecialKey; out - AHandled: boolean); -begin - AHandled := false; -end; - -procedure TBGRAOriginalEditor.KeyPress(UTF8Key: string; out AHandled: boolean); -begin - AHandled := false; -end; - -function TBGRAOriginalEditor.GetPointAt(const ACoord: TPointF; ARightButton: boolean): integer; -var v: TPointF; - curDist,newDist: single; - i: Integer; - transfCoord: TPointF; -begin - if ARightButton then - curDist := sqr(2.25*FPointSize) - else - curDist := sqr(1.25*FPointSize); - result := -1; - transfCoord:= Matrix*ACoord; - - for i := 0 to high(FPoints) do - if FPoints[i].RightButton = ARightButton then - begin - v := Matrix*FPoints[i].Coord - transfCoord; - newDist := v*v; - if newDist <= curDist then - begin - curDist:= newDist; - result := i; - end; - end; - if result <> -1 then exit; - - if not ARightButton then - curDist := sqr(2.25*FPointSize) - else - curDist := sqr(1.25*FPointSize); - for i := 0 to high(FPoints) do - if FPoints[i].RightButton <> ARightButton then - begin - v := Matrix*FPoints[i].Coord - transfCoord; - newDist := v*v; - if newDist <= curDist then - begin - curDist:= newDist; - result := i; - end; - end; - - for i := 0 to high(FPoints) do - if (FPoints[i].RightButton = ARightButton) - and FPoints[i].HitBox.Contains(ACoord) then exit(i); - - for i := 0 to high(FPoints) do - if (FPoints[i].RightButton <> ARightButton) - and FPoints[i].HitBox.Contains(ACoord) then exit(i); -end; - -function TBGRAOriginalEditor.Render(ADest: TBGRABitmap; const ALayoutRect: TRect): TRect; -var - i,j: Integer; - elemRect: TRect; - ptsF: array of TPointF; -begin - result := EmptyRect; - for i := 0 to high(FPoints) do - begin - if isEmptyPointF(FPoints[i].Origin) then - elemRect := RenderPoint(ADest, OriginalCoordToView(FPoints[i].Coord), FPoints[i].RightButton, FPoints[i].Highlighted) - else - elemRect := RenderArrow(ADest, OriginalCoordToView(FPoints[i].Origin), OriginalCoordToView(FPoints[i].Coord)); - if not elemRect.IsEmpty then - begin - if result.IsEmpty then - result := elemRect - else - result.Union(elemRect); - end; - end; - for i := 0 to high(FPolylines) do - begin - with FPolylines[i] do - begin - setlength(ptsF, length(Coords)); - for j := 0 to high(Coords) do - if IsEmptyPointF(Coords[j]) then - ptsF[j] := EmptyPointF - else - ptsF[j] := OriginalCoordToView(Coords[j]); - elemRect := RenderPolygon(ADest, ptsF, Closed, Style, BackColor); - end; - if not elemRect.IsEmpty then - begin - if result.IsEmpty then - result := elemRect - else - result.Union(elemRect); - end; - end; -end; - -function TBGRAOriginalEditor.GetRenderBounds(const ALayoutRect: TRect): TRect; -var - i,j: Integer; - elemRect: TRect; - ptsF: array of TPointF; -begin - result := EmptyRect; - for i := 0 to high(FPoints) do - begin - if isEmptyPointF(FPoints[i].Origin) then - elemRect := GetRenderPointBounds(OriginalCoordToView(FPoints[i].Coord), FPoints[i].Highlighted) - else - elemRect := GetRenderArrowBounds(OriginalCoordToView(FPoints[i].Origin), OriginalCoordToView(FPoints[i].Coord)); - if not elemRect.IsEmpty then - begin - if result.IsEmpty then - result := elemRect - else - result.Union(elemRect); - end; - end; - for i := 0 to high(FPolylines) do - begin - with FPolylines[i] do - begin - setlength(ptsF, length(Coords)); - for j := 0 to high(Coords) do - if IsEmptyPointF(Coords[j]) then - ptsF[j] := EmptyPointF - else - ptsF[j] := OriginalCoordToView(Coords[j]); - elemRect := GetRenderPolygonBounds(ptsF); - end; - if not elemRect.IsEmpty then - begin - if result.IsEmpty then - result := elemRect - else - result.Union(elemRect); - end; - end; -end; - -function TBGRAOriginalEditor.SnapToGrid(const ACoord: TPointF; - AIsViewCoord: boolean): TPointF; -var - gridCoord: TPointF; -begin - if AIsViewCoord then - gridCoord := FGridMatrixInverse*ViewCoordToOriginal(ACoord) - else - gridCoord := FGridMatrixInverse*ACoord; - gridCoord.x := round(gridCoord.x); - gridCoord.y := round(gridCoord.y); - result := FGridMatrix*gridCoord; - if AIsViewCoord then - result := OriginalCoordToView(result); -end; - -function TBGRAOriginalEditor.OriginalCoordToView(const AImageCoord: TPointF): TPointF; -begin - result := FMatrix*AImageCoord; -end; - -function TBGRAOriginalEditor.ViewCoordToOriginal(const AViewCoord: TPointF): TPointF; -begin - result := FMatrixInverse*AViewCoord; -end; - -{ TBGRAMemOriginalStorage } - -function TBGRAMemOriginalStorage.GetRawString(AName: utf8string): RawByteString; -var - idx: Integer; -begin - if pos('.',AName)<>0 then exit(''); - idx := FMemDir.IndexOf(AName,'',true); - if idx = -1 then - result := '' - else if FMemDir.IsDirectory[idx] then - raise exception.Create('This name refers to an object and not an attribute') - else - result := FMemDir.RawString[idx]; -end; - -procedure TBGRAMemOriginalStorage.SetRawString(AName: utf8string; - AValue: RawByteString); -var - idx: Integer; -begin - if pos('.',AName)<>0 then - raise exception.Create('Attribute name cannot contain "."'); - idx := FMemDir.IndexOf(AName,'',true); - if idx = -1 then - FMemDir.Add(AName,'',AValue) - else if FMemDir.IsDirectory[idx] then - raise exception.Create('This name refers to an existing object and so cannot be an attribute') - else - FMemDir.RawString[idx] := AValue; -end; - -function TBGRAMemOriginalStorage.GetEmpty: boolean; -begin - result := FMemDir.Count = 0; -end; - -destructor TBGRAMemOriginalStorage.Destroy; -begin - if FMemDirOwned then FreeAndNil(FMemDir); - inherited Destroy; -end; - -constructor TBGRAMemOriginalStorage.Create; -begin - inherited Create; - FMemDir := TMemDirectory.Create; - FMemDirOwned:= true; -end; - -constructor TBGRAMemOriginalStorage.Create(AMemDir: TMemDirectory; AMemDirOwned: boolean = false); -begin - inherited Create; - FMemDir := AMemDir; - FMemDirOwned:= AMemDirOwned; -end; - -function TBGRAMemOriginalStorage.Equals(Obj: TObject): boolean; -var - other: TBGRAMemOriginalStorage; -begin - if not (Obj is TBGRAMemOriginalStorage) then exit(false); - other := TBGRAMemOriginalStorage(obj); - result := FMemDir.Equals(other.FMemDir); -end; - -function TBGRAMemOriginalStorage.Duplicate: TBGRACustomOriginalStorage; -begin - result := TBGRAMemOriginalStorage.Create; - CopyTo(TBGRAMemOriginalStorage(result).FMemDir); -end; - -procedure TBGRAMemOriginalStorage.RemoveAttribute(AName: utf8string); -var - idx: Integer; -begin - if pos('.',AName)<>0 then exit; - idx := FMemDir.IndexOf(AName,'',true); - if idx = -1 then exit - else if FMemDir.IsDirectory[idx] then - raise exception.Create('This name refers to an object and not an attribute') - else - FMemDir.Delete(idx); -end; - -function TBGRAMemOriginalStorage.HasAttribute(AName: utf8string): boolean; -var - idx: Integer; -begin - if pos('.',AName)<>0 then exit(false); - idx := FMemDir.IndexOf(AName,'',true); - if idx = -1 then exit(false) - else exit(not FMemDir.IsDirectory[idx]); -end; - -procedure TBGRAMemOriginalStorage.RemoveObject(AName: utf8string); -var - idx: Integer; -begin - idx := FMemDir.IndexOf(EntryFilename(AName)); - if idx = -1 then exit - else if not FMemDir.IsDirectory[idx] then - raise exception.Create('This name refers to an attribute and not an object') - else - FMemDir.Delete(idx); -end; - -function TBGRAMemOriginalStorage.CreateObject(AName: utf8string): TBGRACustomOriginalStorage; -var - dirIdx: Integer; -begin - if pos('.',AName)<>0 then - raise exception.Create('An object cannot contain "."'); - RemoveObject(AName); - dirIdx := FMemDir.AddDirectory(AName,''); - result := TBGRAMemOriginalStorage.Create(FMemDir.Directory[dirIdx]); -end; - -function TBGRAMemOriginalStorage.OpenObject(AName: utf8string): TBGRACustomOriginalStorage; -var - dir: TMemDirectory; -begin - if pos('.',AName)<>0 then - raise exception.Create('An object cannot contain "."'); - dir := FMemDir.FindPath(AName); - if dir = nil then - result := nil - else - result := TBGRAMemOriginalStorage.Create(dir); -end; - -function TBGRAMemOriginalStorage.ObjectExists(AName: utf8string): boolean; -var - dir: TMemDirectory; -begin - if pos('.',AName)<>0 then exit(false); - dir := FMemDir.FindPath(AName); - result:= Assigned(dir); -end; - -procedure TBGRAMemOriginalStorage.EnumerateObjects(AList: TStringList); -var - i: Integer; -begin - for i := 0 to FMemDir.Count-1 do - if FMemDir.IsDirectory[i] then - AList.Add(FMemDir.Entry[i].Name); -end; - -procedure TBGRAMemOriginalStorage.EnumerateFiles(AList: TStringList); -var - i: Integer; -begin - for i := 0 to FMemDir.Count-1 do - if not FMemDir.IsDirectory[i] then - AList.Add(FMemDir.Entry[i].Name); -end; - -procedure TBGRAMemOriginalStorage.RemoveFile(AName: utf8string); -var - idx: Integer; -begin - idx := FMemDir.IndexOf(EntryFilename(AName)); - if idx = -1 then exit - else if FMemDir.IsDirectory[idx] then - raise exception.Create('This name refers to an object and not a file') - else - FMemDir.Delete(idx); -end; - -function TBGRAMemOriginalStorage.GetFileStream(AName: UTF8String): TStream; -var - entryId: Integer; -begin - entryId := FMemDir.IndexOf(EntryFilename(AName)); - if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then - begin - with FMemDir.Entry[entryId] do - result := GetStream; - end - else - result := nil; -end; - -function TBGRAMemOriginalStorage.ReadBitmap(AName: UTF8String; - ADest: TCustomUniversalBitmap): boolean; -var - entryId: Integer; - stream: TStream; -begin - entryId := FMemDir.IndexOf(EntryFilename(AName)); - if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then - begin - if FMemDir.IsEntryCompressed[entryId] then - begin - stream := TMemoryStream.Create; - try - with FMemDir.Entry[entryId] do - begin - if CopyTo(stream) <> FileSize then - result := false - else - begin - stream.Position:= 0; - ADest.LoadFromStream(stream); - result := true; - end; - end; - finally - stream.Free; - end; - end else - with FMemDir.Entry[entryId] do - begin - stream := GetStream; - stream.Position:= 0; - ADest.LoadFromStream(stream); - result := true; - end; - end - else - result := false; -end; - -function TBGRAMemOriginalStorage.ReadFile(AName: UTF8String; ADest: TStream): boolean; -var - entryId: Integer; -begin - entryId := FMemDir.IndexOf(EntryFilename(AName)); - if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then - begin - with FMemDir.Entry[entryId] do - result := CopyTo(ADest) = FileSize - end - else - result := false; -end; - -procedure TBGRAMemOriginalStorage.WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean); -var - idxEntry: Integer; -begin - idxEntry := FMemDir.Add(EntryFilename(AName), ASource, true, AOwnStream); - if ACompress then FMemDir.IsEntryCompressed[idxEntry] := true; -end; - -function TBGRAMemOriginalStorage.FileExists(AName: UTF8String): boolean; -var - entryId: Integer; -begin - entryId := FMemDir.IndexOf(EntryFilename(AName)); - result := (entryId <> -1) and not FMemDir.IsDirectory[entryId]; -end; - -procedure TBGRAMemOriginalStorage.SaveToStream(AStream: TStream); -begin - FMemDir.SaveToStream(AStream); -end; - -procedure TBGRAMemOriginalStorage.LoadFromStream(AStream: TStream); -begin - FMemDir.LoadFromStream(AStream); -end; - -procedure TBGRAMemOriginalStorage.LoadFromResource(AFilename: string); -begin - FMemDir.LoadFromResource(AFilename); -end; - -procedure TBGRAMemOriginalStorage.CopyTo(AMemDir: TMemDirectory); -begin - FMemDir.CopyTo(AMemDir, true); -end; - -{ TBGRACustomOriginalStorage } - -function TBGRACustomOriginalStorage.GetColor(AName: UTF8String): TBGRAPixel; -begin - result := StrToBGRA(RawString[AName], BGRAPixelTransparent); -end; - -procedure TBGRACustomOriginalStorage.SetColor(AName: UTF8String; - AValue: TBGRAPixel); -begin - RawString[AName] := LowerCase(BGRAToStr(AValue, CSSColors)); -end; - -function TBGRACustomOriginalStorage.GetDelimiter: char; -begin - if FFormats.DecimalSeparator = ',' then - result := ';' else result := ','; -end; - -function TBGRACustomOriginalStorage.GetRectF(AName: utf8string): TRectF; -var - a: array of Single; -begin - a := FloatArray[AName]; - if length(a)<4 then - result := EmptyRectF - else - begin - result.Left := a[0]; - result.Top := a[1]; - result.Right := a[2]; - result.Bottom := a[3]; - end; -end; - -procedure TBGRACustomOriginalStorage.SetRectF(AName: utf8string; AValue: TRectF); -var - a: array of Single; -begin - setlength(a,4); - a[0] := AValue.Left; - a[1] := AValue.Top; - a[2] := AValue.Right; - a[3] := AValue.Bottom; - FloatArray[AName] := a; -end; - -function TBGRACustomOriginalStorage.GetAffineMatrix(AName: utf8string): TAffineMatrix; -var - stream: TMemoryStream; -begin - stream:= TMemoryStream.Create; - if ReadFile(AName, stream) and (stream.Size >= sizeof(result)) then - begin - stream.Position:= 0; - {$PUSH}{$HINTS OFF}stream.ReadBuffer({%H-}result, sizeof({%H-}result));{$POP} - LongWord(result[1,1]) := NtoLE(LongWord(result[1,1])); - LongWord(result[2,1]) := NtoLE(LongWord(result[2,1])); - LongWord(result[1,2]) := NtoLE(LongWord(result[1,2])); - LongWord(result[2,2]) := NtoLE(LongWord(result[2,2])); - LongWord(result[1,3]) := NtoLE(LongWord(result[1,3])); - LongWord(result[2,3]) := NtoLE(LongWord(result[2,3])); - end else - result := AffineMatrixIdentity; - stream.Free; -end; - -procedure TBGRACustomOriginalStorage.SetAffineMatrix(AName: utf8string; - const AValue: TAffineMatrix); -var - stream: TMemoryStream; -begin - stream:= TMemoryStream.Create; - stream.WriteBuffer(AValue, sizeof(AValue)); - WriteFile(AName,stream,false,true); -end; - -function TBGRACustomOriginalStorage.GetRect(AName: utf8string): TRect; -var - rF: TRectF; -begin - rF := RectangleF[AName]; - result := rect(round(rF.Left),round(rF.Top),round(rF.Right),round(rF.Bottom)); -end; - -procedure TBGRACustomOriginalStorage.SetRect(AName: utf8string; AValue: TRect); -var - rF: TRectF; -begin - rF := rectF(AValue.Left,AValue.Top,AValue.Right,AValue.Bottom); - RectangleF[AName] := rF; -end; - -function TBGRACustomOriginalStorage.GetBoolDef(AName: utf8string; - ADefault: boolean): boolean; -begin - if RawString[AName] = 'true' then result := true - else if RawString[AName] = 'false' then result := false - else result := ADefault; -end; - -function TBGRACustomOriginalStorage.GetBool(AName: utf8string): boolean; -begin - result := GetBoolDef(AName, false); -end; - -function TBGRACustomOriginalStorage.GetSingleArray(AName: utf8string): ArrayOfSingle; -var - textVal: String; - values: TStringList; - i: Integer; -begin - textVal := Trim(RawString[AName]); - if textVal = '' then exit(nil); - values := TStringList.Create; - values.StrictDelimiter := true; - values.Delimiter:= GetDelimiter; - values.DelimitedText:= textVal; - setlength(result, values.Count); - for i := 0 to high(result) do - if CompareText(values[i],'none')=0 then - result[i] := EmptySingle - else - result[i] := StrToFloatDef(values[i], 0, FFormats); - values.Free; -end; - -function TBGRACustomOriginalStorage.GetColorArray(AName: UTF8String - ): ArrayOfTBGRAPixel; -var colorNames: TStringList; - i: Integer; -begin - colorNames := TStringList.Create; - colorNames.StrictDelimiter := true; - colorNames.Delimiter:= GetDelimiter; - colorNames.DelimitedText:= RawString[AName]; - setlength(result, colorNames.Count); - for i := 0 to high(result) do - result[i] := StrToBGRA(colorNames[i],BGRAPixelTransparent); - colorNames.Free; -end; - -function TBGRACustomOriginalStorage.GetIntegerDef(AName: utf8string; - ADefault: integer): integer; -begin - result := StrToIntDef(RawString[AName],ADefault); -end; - -function TBGRACustomOriginalStorage.GetSingleDef(AName: utf8string; - ADefault: single): single; -begin - result := StrToFloatDef(RawString[AName], ADefault, FFormats); -end; - -procedure TBGRACustomOriginalStorage.SetBool(AName: utf8string; AValue: boolean); -begin - RawString[AName] := BoolToStr(AValue,'true','false'); -end; - -procedure TBGRACustomOriginalStorage.SetSingleArray(AName: utf8string; - AValue: ArrayOfSingle); -var - values: TStringList; - i: Integer; -begin - values:= TStringList.Create; - values.StrictDelimiter:= true; - values.Delimiter:= GetDelimiter; - for i := 0 to high(AValue) do - if AValue[i] = EmptySingle then - values.Add('none') - else - values.Add(FloatToStr(AValue[i], FFormats)); - RawString[AName] := values.DelimitedText; - values.Free; -end; - -procedure TBGRACustomOriginalStorage.SetColorArray(AName: UTF8String; - AValue: ArrayOfTBGRAPixel); -var colorNames: TStringList; - i: Integer; -begin - colorNames := TStringList.Create; - colorNames.StrictDelimiter := true; - colorNames.Delimiter:= GetDelimiter; - for i := 0 to high(AValue) do - colorNames.Add(LowerCase(BGRAToStr(AValue[i], CSSColors))); - RawString[AName] := colorNames.DelimitedText; - colorNames.Free; -end; - -function TBGRACustomOriginalStorage.GetInteger(AName: utf8string): integer; -begin - result := GetIntegerDef(AName,0); -end; - -function TBGRACustomOriginalStorage.GetPointF(AName: utf8string): TPointF; -var - s: String; - posComma: integer; -begin - s := RawString[AName]; - posComma := pos(GetDelimiter,s); - if posComma = 0 then - exit(EmptyPointF); - - result.x := StrToFloat(copy(s,1,posComma-1), FFormats); - result.y := StrToFloat(copy(s,posComma+1,length(s)-posComma), FFormats); -end; - -function TBGRACustomOriginalStorage.GetSingle(AName: utf8string): single; -begin - result := GetSingleDef(AName, EmptySingle); -end; - -procedure TBGRACustomOriginalStorage.SetInteger(AName: utf8string; - AValue: integer); -begin - RawString[AName] := IntToStr(AValue); -end; - -procedure TBGRACustomOriginalStorage.SetPointF(AName: utf8string; - AValue: TPointF); -begin - if isEmptyPointF(AValue) then RemoveAttribute(AName) - else RawString[AName] := FloatToStrF(AValue.x, ffGeneral,7,3, FFormats)+GetDelimiter+FloatToStrF(AValue.y, ffGeneral,7,3, FFormats); -end; - -procedure TBGRACustomOriginalStorage.SetSingle(AName: utf8string; AValue: single); -begin - if AValue = EmptySingle then RemoveAttribute(AName) - else RawString[AName] := FloatToStrF(AValue, ffGeneral,7,3, FFormats); -end; - -constructor TBGRACustomOriginalStorage.Create; -begin - FFormats := DefaultFormatSettings; - FFormats.DecimalSeparator := '.'; -end; - -function TBGRACustomOriginalStorage.FloatEquals(AName: utf8string; - AValue: single): boolean; -var - curValue: Single; -begin - curValue := Float[AName]; - if curValue = EmptySingle then - result := (AValue = EmptySingle) else - if AValue = EmptySingle then - result := false else - result := (FloatToStrF(AValue, ffGeneral,7,3, FFormats) = - FloatToStrF(curValue, ffGeneral,7,3, FFormats)); -end; - -function TBGRACustomOriginalStorage.PointFEquals(AName: utf8string; - const AValue: TPointF): boolean; -var - curValue: TPointF; -begin - curValue := PointF[AName]; - if isEmptyPointF(curValue) then - result := isEmptyPointF(AValue) else - if isEmptyPointF(AValue) then - result := False else - result := (FloatToStrF(AValue.x, ffGeneral,7,3, FFormats) = - FloatToStrF(curValue.x, ffGeneral,7,3, FFormats)) and - (FloatToStrF(AValue.y, ffGeneral,7,3, FFormats) = - FloatToStrF(curValue.y, ffGeneral,7,3, FFormats)); -end; - -function TBGRACustomOriginalStorage.AffineMatrixEquals(AName: utf8string; - const AValue: TAffineMatrix): boolean; -begin - result := (AffineMatrix[AName] = AValue); -end; - -{ TBGRALayerCustomOriginal } - -procedure TBGRALayerCustomOriginal.SetOnChange(AValue: TOriginalChangeEvent); -begin - if FOnChange=AValue then Exit; - FOnChange:=AValue; -end; - -function TBGRALayerCustomOriginal.GetDiffExpected: boolean; -begin - result := Assigned(FOnChange); -end; - -procedure TBGRALayerCustomOriginal.SetRenderStorage(AValue: TBGRACustomOriginalStorage); -begin - if FRenderStorage=AValue then Exit; - FRenderStorage:=AValue; -end; - -function TBGRALayerCustomOriginal.GetGuid: TGuid; -begin - result := FGuid; -end; - -procedure TBGRALayerCustomOriginal.SetGuid(AValue: TGuid); -begin - FGuid := AValue; -end; - -procedure TBGRALayerCustomOriginal.NotifyChange(ADiff: TBGRAOriginalDiff); -begin - if Assigned(FOnChange) then - FOnChange(self, nil, ADiff); - ADiff.Free; -end; - -procedure TBGRALayerCustomOriginal.NotifyChange(ABounds: TRectF; ADiff: TBGRAOriginalDiff); -begin - if Assigned(FOnChange) then - FOnChange(self, @ABounds, ADiff); - ADiff.Free; -end; - -procedure TBGRALayerCustomOriginal.NotifyEditorChange; -begin - if Assigned(FOnEditingChange) then - FOnEditingChange(self); -end; - -constructor TBGRALayerCustomOriginal.Create; -begin - FGuid := GUID_NULL; - FRenderStorage := nil; -end; - -destructor TBGRALayerCustomOriginal.Destroy; -begin - inherited Destroy; -end; - -procedure TBGRALayerCustomOriginal.Render(ADest: TBGRABitmap; - AMatrix: TAffineMatrix; ADraft: boolean); -begin - Render(ADest, Point(0,0), AMatrix, ADraft); -end; - -procedure TBGRALayerCustomOriginal.Render(ADest: TBGRABitmap; - ARenderOffset: TPoint; AMatrix: TAffineMatrix; ADraft: boolean); -begin - Render(ADest, AffineMatrixTranslation(ARenderOffset.X, ARenderOffset.Y)*AMatrix, ADraft); -end; - -procedure TBGRALayerCustomOriginal.ConfigureEditor(AEditor: TBGRAOriginalEditor); -begin - //nothing -end; - -procedure TBGRALayerCustomOriginal.LoadFromFile(AFilenameUTF8: string); -var - s: TFileStreamUTF8; -begin - s := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead, fmShareDenyWrite); - try - LoadFromStream(s); - finally - s.Free; - end; -end; - -procedure TBGRALayerCustomOriginal.LoadFromStream(AStream: TStream); -var storage: TBGRAMemOriginalStorage; - memDir: TMemDirectory; -begin - memDir := TMemDirectory.Create; - storage := nil; - try - memDir.LoadFromStream(AStream); - storage := TBGRAMemOriginalStorage.Create(memDir); - if storage.RawString['class'] <> StorageClassName then - raise exception.Create('Invalid class'); - LoadFromStorage(storage); - FreeAndNil(storage); - finally - storage.Free; - memDir.Free; - end; -end; - -procedure TBGRALayerCustomOriginal.LoadFromResource(AFilename: string); -var - stream: TStream; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - LoadFromStream(stream); - finally - stream.Free; - end; -end; - -procedure TBGRALayerCustomOriginal.SaveToFile(AFilenameUTF8: string); -var - s: TFileStreamUTF8; -begin - s := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); - try - SaveToStream(s); - finally - s.Free; - end; -end; - -procedure TBGRALayerCustomOriginal.SaveToStream(AStream: TStream); -var storage: TBGRAMemOriginalStorage; - memDir: TMemDirectory; -begin - memDir := TMemDirectory.Create; - storage := nil; - try - storage := TBGRAMemOriginalStorage.Create(memDir); - storage.RawString['class'] := StorageClassName; - SaveToStorage(storage); - FreeAndNil(storage); - memDir.SaveToStream(AStream); - finally - storage.Free; - memDir.Free; - end; -end; - -function TBGRALayerCustomOriginal.CreateEditor: TBGRAOriginalEditor; -begin - result := TBGRAOriginalEditor.Create; -end; - -class function TBGRALayerCustomOriginal.CanConvertToSVG: boolean; -begin - result := false; -end; - -function TBGRALayerCustomOriginal.IsInfiniteSurface: boolean; -begin - result := false; -end; - -function TBGRALayerCustomOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; -begin - AOffset := Point(0,0); - raise exception.Create('Not implemented'); -end; - -function TBGRALayerCustomOriginal.Duplicate: TBGRALayerCustomOriginal; -var - storage: TBGRAMemOriginalStorage; - c: TBGRALayerOriginalAny; -begin - c := FindLayerOriginalClass(StorageClassName); - if c = nil then raise exception.Create('Original class is not registered'); - storage := TBGRAMemOriginalStorage.Create; - try - SaveToStorage(storage); - result := c.Create; - result.LoadFromStorage(storage); - finally - storage.Free; - end; -end; - -{ TBGRALayerImageOriginal } - -function TBGRALayerImageOriginal.GetImageHeight: integer; -begin - if Assigned(FImage) then - result := FImage.Height - else - result := 0; -end; - -function TBGRALayerImageOriginal.GetImageWidth: integer; -begin - if Assigned(FImage) then - result := FImage.Width - else - result := 0; -end; - -procedure TBGRALayerImageOriginal.BeginUpdate; -begin - if DiffExpected and (FDiff=nil) then - FDiff := TBGRAImageOriginalDiff.Create(self); -end; - -procedure TBGRALayerImageOriginal.EndUpdate; -begin - if Assigned(FDiff) then FDiff.ComputeDiff(self); - NotifyChange(FDiff); - FDiff := nil; -end; - -procedure TBGRALayerImageOriginal.InternalLoadImageFromStream(AStream: TStream; AUpdate: boolean); -var - newJpegStream: TMemoryStream; - newImage: TBGRABitmap; -begin - if DetectFileFormat(AStream) = ifJpeg then - begin - newJpegStream := TMemoryStream.Create; - try - newJpegStream.CopyFrom(AStream, AStream.Size); - newJpegStream.Position := 0; - newImage := TBGRABitmap.Create(newJpegStream); - if AUpdate then BeginUpdate; - InternalClear; - FImage := newImage; - FJpegStream := newJpegStream; - newImage := nil; - newJpegStream := nil; - if AUpdate then - begin - Inc(FContentVersion); - EndUpdate; - end; - finally - newJpegStream.Free; - newImage.Free; - end; - end else - begin - newImage := TBGRABitmap.Create(AStream); - if AUpdate then BeginUpdate; - InternalClear; - FImage := newImage; - if AUpdate then - begin - Inc(FContentVersion); - EndUpdate; - end; - end; -end; - -procedure TBGRALayerImageOriginal.InternalClear; -begin - if Assigned(FImage) then - begin - FImage.FreeReference; - FImage := nil - end; - FreeAndNil(FJpegStream); -end; - -constructor TBGRALayerImageOriginal.Create; -begin - inherited Create; - FImage := nil; - FContentVersion := 0; - FJpegStream := nil; -end; - -destructor TBGRALayerImageOriginal.Destroy; -begin - FImage.FreeReference; - FJpegStream.Free; - FDiff.Free; - inherited Destroy; -end; - -function TBGRALayerImageOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; -var - svg: TBGRASVG; - img: TSVGImage; -begin - svg := TBGRASVG.Create(Width, Height, cuPixel); - Result:= svg; - AOffset := Point(0,0); - if Assigned(FJpegStream) then - img := svg.Content.AppendImage(0,0,Width,Height,FJpegStream,'image/jpeg') else - if Assigned(FImage) then - img := svg.Content.AppendImage(0,0,Width,Height,FImage,false); - img.matrix[cuCustom] := AMatrix; -end; - -procedure TBGRALayerImageOriginal.Render(ADest: TBGRABitmap; - AMatrix: TAffineMatrix; ADraft: boolean); -var resampleFilter: TResampleFilter; -begin - if ADraft then resampleFilter := rfBox else resampleFilter:= rfCosine; - if Assigned(FImage) then - ADest.PutImageAffine(AMatrix, FImage, resampleFilter, dmSet); -end; - -function TBGRALayerImageOriginal.GetRenderBounds(ADestRect: TRect; - AMatrix: TAffineMatrix): TRect; -var - aff: TAffineBox; -begin - if Assigned(FImage) then - begin - aff := AMatrix*TAffineBox.AffineBox(PointF(0,0),PointF(FImage.Width,0),PointF(0,FImage.Height)); - result := aff.RectBounds; - end else - result := EmptyRect; -end; - -procedure TBGRALayerImageOriginal.LoadFromStorage( - AStorage: TBGRACustomOriginalStorage); -var imgStream: TMemoryStream; - newImage: TBGRABitmap; -begin - imgStream := TMemoryStream.Create; - try - if AStorage.ReadFile('content.png', imgStream) then - begin - imgStream.Position:= 0; - newImage := TBGRABitmap.Create(imgStream); - InternalClear; - FImage := newImage; - end else - if AStorage.ReadFile('content.jpg', imgStream) then - begin - imgStream.Position:= 0; - newImage := TBGRABitmap.Create(imgStream); - InternalClear; - FImage := newImage; - FJpegStream := imgStream; - imgStream:= nil; - end else - InternalClear; - FContentVersion := AStorage.Int['content-version']; - finally - imgStream.Free; - end; -end; - -procedure TBGRALayerImageOriginal.SaveToStorage( - AStorage: TBGRACustomOriginalStorage); -var imgStream: TMemoryStream; -begin - if Assigned(FImage) then - begin - if FContentVersion > AStorage.Int['content-version'] then - begin - if Assigned(FJpegStream) then - begin - AStorage.WriteFile('content.jpg', FJpegStream, false); - AStorage.RemoveFile('content.png'); - AStorage.Int['content-version'] := FContentVersion; - end else - begin - imgStream := TMemoryStream.Create; - try - FImage.SaveToStreamAsPng(imgStream); - AStorage.RemoveFile('content.jpg'); - AStorage.WriteFile('content.png', imgStream, false); - AStorage.Int['content-version'] := FContentVersion; - finally - imgStream.Free; - end; - end; - end; - end else - begin - AStorage.RemoveFile('content.jpg'); - AStorage.RemoveFile('content.png'); - AStorage.Int['content-version'] := FContentVersion; - end; -end; - -procedure TBGRALayerImageOriginal.LoadFromStream(AStream: TStream); -begin - if TMemDirectory.CheckHeader(AStream) then - inherited LoadFromStream(AStream) - else - begin - InternalLoadImageFromStream(AStream, False); - inc(FContentVersion); - end; -end; - -procedure TBGRALayerImageOriginal.Clear; -begin - BeginUpdate; - InternalClear; - Inc(FContentVersion); - EndUpdate; -end; - -procedure TBGRALayerImageOriginal.LoadImageFromStream(AStream: TStream); -begin - InternalLoadImageFromStream(AStream, True); -end; - -procedure TBGRALayerImageOriginal.SaveImageToStream(AStream: TStream); -begin - if Assigned(FJpegStream) then - begin - FJpegStream.Position := 0; - if AStream.CopyFrom(FJpegStream, FJpegStream.Size)<>FJpegStream.Size then - raise exception.Create('Error while saving'); - end else - if Assigned(FImage) then - FImage.SaveToStreamAsPng(AStream) - else raise exception.Create('No image to be saved'); -end; - -procedure TBGRALayerImageOriginal.AssignImage(AImage: TBGRACustomBitmap); -var - newImage: TBGRABitmap; -begin - newImage := TBGRABitmap.Create; - newImage.Assign(AImage); - BeginUpdate; - InternalClear; - FImage := newImage; - Inc(FContentVersion); - EndUpdate; -end; - -function TBGRALayerImageOriginal.GetImageCopy: TBGRABitmap; -begin - if FImage = nil then result := nil - else result := FImage.Duplicate; -end; - -class function TBGRALayerImageOriginal.StorageClassName: RawByteString; -begin - result := 'image'; -end; - -class function TBGRALayerImageOriginal.CanConvertToSVG: boolean; -begin - Result:= true; -end; - -initialization - - RegisterLayerOriginal(TBGRALayerImageOriginal); - -end. - diff --git a/components/bgrabitmap/bgralayers.pas b/components/bgrabitmap/bgralayers.pas deleted file mode 100644 index 51a2def..0000000 --- a/components/bgrabitmap/bgralayers.pas +++ /dev/null @@ -1,3617 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRALayers; - -{$mode objfpc}{$H+} -{$MODESWITCH ADVANCEDRECORDS} - -interface - -uses - BGRAGraphics, BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, - BGRAMemDirectory, BGRATransform, fgl, BGRALayerOriginal; - -type - TBGRACustomLayeredBitmap = class; - TBGRACustomLayeredBitmapClass = class of TBGRACustomLayeredBitmap; - - { TBGRALayerOriginalEntry } - - TBGRALayerOriginalEntry = record - Guid: TGuid; - Instance: TBGRALayerCustomOriginal; - class operator = (const AEntry1,AEntry2: TBGRALayerOriginalEntry): boolean; - end; - -function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry; -function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry; - -type - TBGRALayerOriginalList = specialize TFPGList; - - TBGRALayeredBitmap = class; - TBGRALayeredBitmapClass = class of TBGRALayeredBitmap; - - TBGRALayeredBitmapSaveToStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); - TBGRALayeredBitmapLoadFromStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); - TBGRALayeredBitmapCheckStreamProc = function(AStream: TStream): boolean; - TOriginalRenderStatus = (orsNone, orsDraft, orsPartialDraft, orsProof, orsPartialProof); - - { TBGRACustomLayeredBitmap } - - TBGRACustomLayeredBitmap = class(TGraphic) - private - FFrozenRange: array of record - firstLayer,lastLayer: integer; - image: TBGRABitmap; - linearBlend: boolean; - end; - FLinearBlend: boolean; - FMemDirectory: TMemDirectory; - FMemDirectoryOwned: boolean; - FSelectionDrawMode: TDrawMode; - FSelectionLayerIndex: integer; - FSelectionRect: TRect; - FSelectionScanner: IBGRAScanner; - FSelectionScannerOffset: TPoint; - function GetDefaultBlendingOperation: TBlendOperation; - function GetHasMemFiles: boolean; - function GetLinearBlend: boolean; - function GetSelectionVisible: boolean; - procedure SetLinearBlend(AValue: boolean); - - protected - function GetNbLayers: integer; virtual; abstract; - function GetMemDirectory: TMemDirectory; - function GetBlendOperation(Layer: integer): TBlendOperation; virtual; abstract; - function GetLayerVisible(layer: integer): boolean; virtual; abstract; - function GetLayerOpacity(layer: integer): byte; virtual; abstract; - function GetLayerName(layer: integer): string; virtual; - function GetLayerOffset(layer: integer): TPoint; virtual; - function GetLayerFrozenRange(layer: integer): integer; - function GetLayerFrozen(layer: integer): boolean; virtual; - function GetLayerUniqueId(layer: integer): integer; virtual; - function GetLayerOriginal({%H-}layer: integer): TBGRALayerCustomOriginal; virtual; - function GetLayerOriginalKnown({%H-}layer: integer): boolean; virtual; - function GetLayerOriginalMatrix({%H-}layer: integer): TAffineMatrix; virtual; - function GetLayerOriginalGuid({%H-}layer: integer): TGuid; virtual; - function GetLayerOriginalRenderStatus({%H-}layer: integer): TOriginalRenderStatus; virtual; - function GetOriginalCount: integer; virtual; - function GetOriginalByIndex({%H-}AIndex: integer): TBGRALayerCustomOriginal; virtual; - function GetOriginalByIndexKnown({%H-}AIndex: integer): boolean; virtual; - function GetOriginalByIndexLoaded({%H-}AIndex: integer): boolean; virtual; - function GetOriginalByIndexClass({%H-}AIndex: integer): TBGRALayerOriginalAny; virtual; - function GetTransparent: Boolean; override; - function GetEmpty: boolean; override; - - function IndexOfOriginal(const AGuid: TGuid): integer; overload; virtual; - function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; virtual; - - procedure SetWidth(Value: Integer); override; - procedure SetHeight(Value: Integer); override; - procedure SetMemDirectory(AValue: TMemDirectory); - procedure SetTransparent(Value: Boolean); override; - - procedure SetLayerFrozen(layer: integer; AValue: boolean); virtual; - function RangeIntersect(first1,last1,first2,last2: integer): boolean; - procedure RemoveFrozenRange(index: integer); - function ContainsFrozenRange(first,last: integer): boolean; - function GetLayerDrawMode(AIndex: integer): TDrawMode; - - public - procedure SaveToFile(const filenameUTF8: string); override; - procedure SaveToStream(Stream: TStream); override; - procedure SaveToStreamAs(Stream: TStream; AExtension: string); - constructor Create; override; - destructor Destroy; override; - function ToString: ansistring; override; - procedure DiscardSelection; - function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual; - function GetLayerBitmapCopy(layer: integer): TBGRABitmap; virtual; abstract; - function ComputeFlatImage(ASeparateXorMask: boolean = false): TBGRABitmap; overload; - function ComputeFlatImage(firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload; - function ComputeFlatImage(ARect: TRect; ASeparateXorMask: boolean = false): TBGRABitmap; overload; - function ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload; - procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; overload; - procedure Draw(Canvas: TCanvas; x,y: integer); overload; - procedure Draw(Canvas: TCanvas; x,y: integer; firstLayer, lastLayer: integer); overload; - procedure Draw(Dest: TBGRABitmap; x,y: integer); overload; - procedure Draw(Dest: TBGRABitmap; x,y: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean = false); overload; - procedure Draw(Dest: TBGRABitmap; AX,AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false; ADestinationEmpty: boolean = false); overload; - function DrawLayer(Dest: TBGRABitmap; X,Y: Integer; AIndex: integer; ASeparateXorMask: boolean = false; ADestinationEmpty: boolean = false): boolean; - - procedure FreezeExceptOneLayer(layer: integer); overload; - procedure Freeze(firstLayer, lastLayer: integer); overload; - procedure Freeze; overload; - procedure Unfreeze; overload; - procedure Unfreeze(layer: integer); overload; - procedure Unfreeze(firstLayer, lastLayer: integer); overload; - - procedure NotifyLoaded; virtual; - procedure NotifySaving; virtual; - - property NbLayers: integer read GetNbLayers; - property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation; - property LayerVisible[layer: integer]: boolean read GetLayerVisible; - property LayerOpacity[layer: integer]: byte read GetLayerOpacity; - property LayerName[layer: integer]: string read GetLayerName; - property LayerOffset[layer: integer]: TPoint read GetLayerOffset; - property LayerFrozen[layer: integer]: boolean read GetLayerFrozen; - property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId; - property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal; - property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown; - property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid; - property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix; - property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus; - property SelectionScanner: IBGRAScanner read FSelectionScanner write FSelectionScanner; - property SelectionScannerOffset: TPoint read FSelectionScannerOffset write FSelectionScannerOffset; - property SelectionRect: TRect read FSelectionRect write FSelectionRect; - property SelectionLayerIndex: integer read FSelectionLayerIndex write FSelectionLayerIndex; - property SelectionDrawMode: TDrawMode read FSelectionDrawMode write FSelectionDrawMode; - property SelectionVisible: boolean read GetSelectionVisible; - property LinearBlend: boolean read GetLinearBlend write SetLinearBlend; //use linear blending unless specified - property DefaultBlendingOperation: TBlendOperation read GetDefaultBlendingOperation; - property MemDirectory: TMemDirectory read GetMemDirectory write SetMemDirectory; - property MemDirectoryOwned: boolean read FMemDirectoryOwned write FMemDirectoryOwned; - property HasMemFiles: boolean read GetHasMemFiles; - end; - - TEmbeddedOriginalChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal; - var ADiff: TBGRAOriginalDiff) of object; - TEmbeddedOriginalEditingChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal) of object; - TLayeredActionProgressEvent = procedure(ASender: TObject; AProgressPercent: integer) of object; - TEmbeddedOriginalLoadErrorEvent = procedure (ASender: TObject; AError: string; var ARaise: boolean) of object; - - TBGRALayerInfo = record - UniqueId: integer; - Name: string; - x, y: integer; - Source: TBGRABitmap; - blendOp: TBlendOperation; - Opacity: byte; - Visible: boolean; - Owner: boolean; - Frozen: boolean; - OriginalMatrix: TAffineMatrix; - OriginalRenderStatus: TOriginalRenderStatus; - OriginalGuid: TGuid; - OriginalInvalidatedBounds: TRectF; - end; - - { TBGRALayeredBitmap } - - TBGRALayeredBitmap = class(TBGRACustomLayeredBitmap) - private - FNbLayers: integer; - FLayers: array of TBGRALayerInfo; - FOnActionDone: TNotifyEvent; - FOnEditorFocusChanged: TNotifyEvent; - FEditorFocused: boolean; - FOnActionProgress: TLayeredActionProgressEvent; - FOnOriginalLoadError: TEmbeddedOriginalLoadErrorEvent; - FOriginalChange: TEmbeddedOriginalChangeEvent; - FOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent; - FWidth,FHeight: integer; - FOriginals: TBGRALayerOriginalList; - FOriginalEditor: TBGRAOriginalEditor; - FOriginalEditorOriginal: TGuid; - FOriginalEditorViewMatrix: TAffineMatrix; - procedure EditorFocusedChanged({%H-}Sender: TObject); - function GetLayerOriginalClass(layer: integer): TBGRALayerOriginalAny; - function GetOriginalEditor: TBGRAOriginalEditor; - function GetOriginalGuid(AIndex: integer): TGUID; - procedure SetEditorFocused(AValue: boolean); - procedure SetOnActionDone(AValue: TNotifyEvent); - procedure SetOnActionProgress(AValue: TLayeredActionProgressEvent); - - protected - function GetWidth: integer; override; - function GetHeight: integer; override; - function GetNbLayers: integer; override; - function GetBlendOperation(Layer: integer): TBlendOperation; override; - function GetLayerVisible(layer: integer): boolean; override; - function GetLayerOpacity(layer: integer): byte; override; - function GetLayerOffset(layer: integer): TPoint; override; - function GetLayerName(layer: integer): string; override; - function GetLayerFrozen(layer: integer): boolean; override; - function GetLayerUniqueId(layer: integer): integer; override; - function GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; override; - function GetLayerOriginalKnown(layer: integer): boolean; override; - function GetLayerOriginalMatrix(layer: integer): TAffineMatrix; override; - function GetLayerOriginalGuid(layer: integer): TGuid; override; - function GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus; override; - function GetOriginalCount: integer; override; - function GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal; override; - function GetOriginalByIndexKnown(AIndex: integer): boolean; override; - function GetOriginalByIndexLoaded(AIndex: integer): boolean; override; - function GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny; override; - procedure SetBlendOperation(Layer: integer; op: TBlendOperation); - procedure SetLayerVisible(layer: integer; AValue: boolean); - procedure SetLayerOpacity(layer: integer; AValue: byte); - procedure SetLayerOffset(layer: integer; AValue: TPoint); - procedure SetLayerName(layer: integer; AValue: string); - procedure SetLayerFrozen(layer: integer; AValue: boolean); override; - procedure SetLayerUniqueId(layer: integer; AValue: integer); - procedure SetLayerOriginalMatrix(layer: integer; AValue: TAffineMatrix); - procedure SetLayerOriginalGuid(layer: integer; const AValue: TGuid); - procedure SetLayerOriginalRenderStatus(layer: integer; AValue: TOriginalRenderStatus); - - procedure FindOriginal(AGuid: TGuid; - out ADir: TMemDirectory; - out AClass: TBGRALayerOriginalAny); - procedure StoreOriginal(AOriginal: TBGRALayerCustomOriginal); - procedure OriginalChange(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff); - procedure OriginalEditingChange(ASender: TObject); - function GetLayerDirectory(ALayerIndex: integer; ACanCreate: boolean): TMemDirectory; - procedure UpdateOriginalEditor(ALayerIndex: integer; AMatrix: TAffineMatrix; - APointSize: single); - - public - procedure LoadFromFile(const filenameUTF8: string); override; - procedure LoadFromStream(stream: TStream); override; - procedure LoadFromResource(AFilename: string); - procedure SetSize(AWidth, AHeight: integer); virtual; - procedure Clear; override; - procedure ClearOriginals; - procedure RemoveLayer(index: integer); - procedure InsertLayer(index: integer; fromIndex: integer); - procedure Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean = false; - ACopyAdditionalMemData: boolean = false); overload; - function MoveLayerUp(index: integer): integer; - function MoveLayerDown(index: integer): integer; - - function AddLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload; - function AddLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload; - function AddLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; - function AddLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddLayer(AName: string; Source: TBGRABitmap; Opacity: byte = 255): integer; overload; - function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload; - function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; - function AddLayer(AName: string; Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddSharedLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload; - function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; - function AddSharedLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddLayerFromFile(AFileName: string; Opacity: byte = 255): integer; overload; - function AddLayerFromFile(AFileName: string; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddLayerFromFile(AFileName: string; Position: TPoint; Opacity: byte = 255): integer; overload; - function AddLayerFromFile(AFileName: string; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte = 255): integer; overload; - function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload; - function AddOwnedLayer(ABitmap: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddLayerFromOriginal(const AGuid: TGuid; Opacity: byte = 255): integer; overload; - function AddLayerFromOriginal(const AGuid: TGuid; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddLayerFromOriginal(const AGuid: TGuid; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload; - function AddLayerFromOriginal(const AGuid: TGuid; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Opacity: byte = 255): integer; overload; - function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload; - function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload; - - class function IsValidRegistryIndentifier(AIdentifier: string): boolean; - function GetLayerRegistry(ALayerIndex: integer; ARegistryIdentifier: string): RawByteString; - procedure SetLayerRegistry(ALayerIndex: integer; ARegistryIdentifier: string; AValue: RawByteString); - procedure SaveLayerRegistryToStream(ALayerIndex: integer; AStream: TStream); - procedure LoadLayerRegistryFromStream(ALayerIndex: integer; AStream: TStream); - function GetGlobalRegistry(ARegistryIdentifier: string): RawByteString; - procedure SetGlobalRegistry(ARegistryIdentifier: string; AValue: RawByteString); - - function AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean = true): integer; - function AddOriginalFromStream(AStream: TStream; ALateLoad: boolean = false): integer; overload; - function AddOriginalFromStream(AStream: TStream; const AGuid: TGuid; ALateLoad: boolean = false): integer; overload; - function AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean = false): integer; overload; - function AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; const AGuid: TGuid; ALateLoad: boolean = false): integer; overload; - procedure SaveOriginalToStream(AIndex: integer; AStream: TStream); overload; - procedure SaveOriginalToStream(const AGuid: TGuid; AStream: TStream); overload; - function RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean; - procedure DeleteOriginal(AIndex: integer); - procedure NotifyLoaded; override; - procedure NotifySaving; override; - procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean = false; AFullSizeLayer: boolean = false); overload; - procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false); overload; - procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false); overload; - procedure RenderLayerFromOriginalIfNecessary(layer: integer; ADraft: boolean; var ABounds: TRect); - function RenderOriginalsIfNecessary(ADraft: boolean = false): TRect; - function RenderOriginalIfNecessary(const AGuid: TGuid; ADraft: boolean = false): TRect; - procedure RemoveUnusedOriginals; - procedure UnloadOriginals; - procedure UnloadOriginal(AIndex: integer); overload; - procedure UnloadOriginal(const AGuid: TGuid); overload; - - destructor Destroy; override; - constructor Create; overload; override; - constructor Create(AWidth, AHeight: integer); overload; virtual; - function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override; - function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override; - function GetLayerIndexFromId(AIdentifier: integer): integer; - function Duplicate(ASharedLayerIds: boolean = false): TBGRALayeredBitmap; - function ProduceLayerUniqueId: integer; - - procedure RotateCW; - procedure RotateCCW; - procedure RotateUD; overload; - procedure RotateUD(ALayerIndex: integer); overload; - procedure HorizontalFlip; overload; - procedure HorizontalFlip(ALayerIndex: integer); overload; - procedure VerticalFlip; overload; - procedure VerticalFlip(ALayerIndex: integer); overload; - procedure Resample(AWidth, AHeight: integer; AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter = rfLinear); - procedure SetLayerBitmap(layer: integer; ABitmap: TBGRABitmap; AOwned: boolean); - function TakeLayerBitmap(layer: integer): TBGRABitmap; - procedure ApplyLayerOffset(ALayerIndex: integer; APadWithTranparentPixels: boolean); - - function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload; - function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload; - function GetEditorBounds(ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload; - function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload; - function GetEditorBounds(ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload; - function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload; - procedure ClearEditor; - procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); - procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); - procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); - procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); - procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); - procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); - procedure KeyDown(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean); - procedure KeyUp(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean); - procedure KeyPress(UTF8Key: string; out AHandled: boolean); - - property Width : integer read GetWidth; - property Height: integer read GetHeight; - property NbLayers: integer read GetNbLayers; - property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation write SetBlendOperation; - property LayerVisible[layer: integer]: boolean read GetLayerVisible write SetLayerVisible; - property LayerOpacity[layer: integer]: byte read GetLayerOpacity write SetLayerOpacity; - property LayerName[layer: integer]: string read GetLayerName write SetLayerName; - property LayerBitmap[layer: integer]: TBGRABitmap read GetLayerBitmapDirectly; - property LayerOffset[layer: integer]: TPoint read GetLayerOffset write SetLayerOffset; - property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId write SetLayerUniqueId; - property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal; - property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown; - property LayerOriginalClass[layer: integer]: TBGRALayerOriginalAny read GetLayerOriginalClass; - property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid write SetLayerOriginalGuid; - property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix write SetLayerOriginalMatrix; - property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus write SetLayerOriginalRenderStatus; - - function IndexOfOriginal(const AGuid: TGuid): integer; overload; override; - function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; override; - property OriginalCount: integer read GetOriginalCount; - property Original[AIndex: integer]: TBGRALayerCustomOriginal read GetOriginalByIndex; - property OriginalGuid[AIndex: integer]: TGUID read GetOriginalGuid; - property OriginalKnown[AIndex: integer]: boolean read GetOriginalByIndexKnown; - property OriginalClass[AIndex: integer]: TBGRALayerOriginalAny read GetOriginalByIndexClass; - property OnOriginalChange: TEmbeddedOriginalChangeEvent read FOriginalChange write FOriginalChange; - property OnOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent read FOriginalEditingChange write FOriginalEditingChange; - property OnOriginalLoadError: TEmbeddedOriginalLoadErrorEvent read FOnOriginalLoadError write FOnOriginalLoadError; - property EditorFocused: boolean read FEditorFocused write SetEditorFocused; - property OnEditorFocusChanged: TNotifyEvent read FOnEditorFocusChanged write FOnEditorFocusChanged; - property OriginalEditor: TBGRAOriginalEditor read GetOriginalEditor; - property OnActionProgress: TLayeredActionProgressEvent read FOnActionProgress write SetOnActionProgress; - property OnActionDone: TNotifyEvent read FOnActionDone write SetOnActionDone; - end; - - TAffineMatrix = BGRABitmapTypes.TAffineMatrix; - -procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass); -procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass); -function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap; -function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap; - -var - LayeredBitmapSaveToStreamProc : TBGRALayeredBitmapSaveToStreamProc; - LayeredBitmapLoadFromStreamProc : TBGRALayeredBitmapLoadFromStreamProc; - LayeredBitmapCheckStreamProc: TBGRALayeredBitmapCheckStreamProc; - -type - TOnLayeredBitmapLoadStartProc = procedure(AFilenameUTF8: string) of object; - TOnLayeredBitmapLoadProgressProc = procedure(APercentage: integer) of object; - TOnLayeredBitmapLoadedProc = procedure() of object; - -procedure OnLayeredBitmapLoadFromStreamStart; -procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string); -procedure OnLayeredBitmapLoadProgress(APercentage: integer); -procedure OnLayeredBitmapLoaded; -procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc; - ADone: TOnLayeredBitmapLoadedProc); -procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc; - ADone: TOnLayeredBitmapLoadedProc); - -type - TOnLayeredBitmapSaveStartProc = procedure(AFilenameUTF8: string) of object; - TOnLayeredBitmapSaveProgressProc = procedure(APercentage: integer) of object; - TOnLayeredBitmapSavedProc = procedure() of object; - -procedure OnLayeredBitmapSaveToStreamStart; -procedure OnLayeredBitmapSaveStart(AFilenameUTF8: string); -procedure OnLayeredBitmapSaveProgress(APercentage: integer); -procedure OnLayeredBitmapSaved; -procedure RegisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; AProgress: TOnLayeredBitmapSaveProgressProc; - ADone: TOnLayeredBitmapSavedProc); -procedure UnregisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; AProgress: TOnLayeredBitmapSaveProgressProc; - ADone: TOnLayeredBitmapSavedProc); - -const - RenderTempSubDirectory = 'temp'; - -implementation - -uses BGRAUTF8, BGRABlend, BGRAMultiFileType, math; - -const - OriginalsDirectory = 'originals'; - LayersDirectory = 'layers'; - RenderSubDirectory = 'render'; - RegistrySubDirectory = 'registry'; - -type - TOnLayeredBitmapLoadStartProcList = specialize TFPGList; - TOnLayeredBitmapLoadProgressProcList = specialize TFPGList; - TOnLayeredBitmapLoadedProcList = specialize TFPGList; - TOnLayeredBitmapSaveStartProcList = specialize TFPGList; - TOnLayeredBitmapSaveProgressProcList = specialize TFPGList; - TOnLayeredBitmapSavedProcList = specialize TFPGList; - -var - LayeredBitmapLoadEvents: record - OnStart: TOnLayeredBitmapLoadStartProcList; - OnProgress: TOnLayeredBitmapLoadProgressProcList; - OnDone: TOnLayeredBitmapLoadedProcList; - end; - LayeredBitmapSaveEvents: record - OnStart: TOnLayeredBitmapSaveStartProcList; - OnProgress: TOnLayeredBitmapSaveProgressProcList; - OnDone: TOnLayeredBitmapSavedProcList; - end; - -var - NextLayerUniqueId: LongWord; - LayeredBitmapReaders: array of record - extension: string; - theClass: TBGRACustomLayeredBitmapClass; - end; - LayeredBitmapWriters: array of record - extension: string; - theClass: TBGRALayeredBitmapClass; - end; - -{ TBGRALayerOriginalEntry } - -class operator TBGRALayerOriginalEntry.=(const AEntry1, - AEntry2: TBGRALayerOriginalEntry): boolean; -begin - result := AEntry1.Guid = AEntry2.Guid; -end; - -function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry; -begin - result.Guid := AGuid; - result.Instance := nil; -end; - -function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry; -begin - result.Guid := AInstance.Guid; - result.Instance := AInstance; -end; - -{ TBGRALayeredBitmap } - -function TBGRALayeredBitmap.GetLayerUniqueId(layer: integer): integer; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - Result:= FLayers[layer].UniqueId; -end; - -function TBGRALayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; -var - idxOrig: Integer; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].OriginalGuid = GUID_NULL then exit(nil); - idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid); - if idxOrig = -1 then exit(nil); - result := Original[idxOrig]; - end; -end; - -function TBGRALayeredBitmap.GetLayerOriginalMatrix(layer: integer - ): TAffineMatrix; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - result := FLayers[layer].OriginalMatrix; -end; - -function TBGRALayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - result := FLayers[layer].OriginalGuid; -end; - -function TBGRALayeredBitmap.GetLayerOriginalRenderStatus(layer: integer - ): TOriginalRenderStatus; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - result := FLayers[layer].OriginalRenderStatus; -end; - -procedure TBGRALayeredBitmap.SetLayerUniqueId(layer: integer; AValue: integer); -var i: integer; - layerDir: TMemDirectory; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - for i := 0 to NbLayers-1 do - if (i <> layer) and (FLayers[i].UniqueId = AValue) then - raise Exception.Create('Another layer has the same identifier'); - layerDir := GetLayerDirectory(layer,false); - if Assigned(layerDir) then - layerDir.ParentDirectory.Rename(inttostr(FLayers[layer].UniqueId),'',inttostr(AValue)); - FLayers[layer].UniqueId := AValue; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerOriginalMatrix(layer: integer; - AValue: TAffineMatrix); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].OriginalMatrix = AValue then exit; - FLayers[layer].OriginalMatrix := AValue; - if FLayers[layer].OriginalGuid <> GUID_NULL then - begin - FLayers[layer].OriginalRenderStatus := orsNone; - Unfreeze(layer); - end; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerOriginalGuid(layer: integer; - const AValue: TGuid); -var - layerDir: TMemDirectory; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].OriginalGuid = AValue then exit; - FLayers[layer].OriginalGuid := AValue; - layerDir := GetLayerDirectory(layer, false); - if Assigned(layerDir) then - layerDir.Delete(RenderSubDirectory,''); - - if (AValue <> GUID_NULL) and (IndexOfOriginal(AValue) <> -1) then - begin - FLayers[layer].OriginalRenderStatus := orsNone; - Unfreeze(layer); - end; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerOriginalRenderStatus(layer: integer; - AValue: TOriginalRenderStatus); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].OriginalRenderStatus = AValue then exit; - FLayers[layer].OriginalRenderStatus := AValue; - Unfreeze(layer); - end; -end; - -procedure TBGRALayeredBitmap.FindOriginal(AGuid: TGuid; out - ADir: TMemDirectory; out AClass: TBGRALayerOriginalAny); -var - c: String; -begin - ADir := nil; - AClass := nil; - - if HasMemFiles then - begin - ADir := MemDirectory.FindPath(OriginalsDirectory+'/'+GUIDToString(AGuid)); - if ADir <> nil then - begin - c := ADir.RawStringByFilename['class']; - AClass := FindLayerOriginalClass(c); - end; - end; -end; - -procedure TBGRALayeredBitmap.StoreOriginal(AOriginal: TBGRALayerCustomOriginal); -var - dir, subdir: TMemDirectory; - storage: TBGRAMemOriginalStorage; -begin - if AOriginal.Guid = GUID_NULL then raise exception.Create('Original GUID undefined'); - dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; - subdir := dir.Directory[dir.AddDirectory(GUIDToString(AOriginal.Guid))]; - storage := TBGRAMemOriginalStorage.Create(subdir); - try - AOriginal.SaveToStorage(storage); - storage.RawString['class'] := AOriginal.StorageClassName; - finally - storage.Free; - end; -end; - -procedure TBGRALayeredBitmap.OriginalChange(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff); -var - i: Integer; - orig: TBGRALayerCustomOriginal; - transfBounds: TRectF; -begin - orig := TBGRALayerCustomOriginal(ASender); - if not (Assigned(ABounds) and IsEmptyRectF(ABounds^)) then - begin - for i := 0 to NbLayers-1 do - if LayerOriginalGuid[i] = orig.Guid then - begin - if ABounds = nil then - LayerOriginalRenderStatus[i] := orsNone - else - begin - transfBounds := (LayerOriginalMatrix[i]*TAffineBox.AffineBox(ABounds^)).RectBoundsF; - case LayerOriginalRenderStatus[i] of - orsDraft: begin - LayerOriginalRenderStatus[i] := orsPartialDraft; - FLayers[i].OriginalInvalidatedBounds := transfBounds; - end; - orsProof: begin - LayerOriginalRenderStatus[i] := orsPartialProof; - FLayers[i].OriginalInvalidatedBounds := transfBounds; - end; - orsPartialDraft: FLayers[i].OriginalInvalidatedBounds := - FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true); - orsPartialProof: FLayers[i].OriginalInvalidatedBounds := - FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true); - end; - end; - end; - end; - if Assigned(FOriginalChange) then - FOriginalChange(self, orig, ADiff); -end; - -procedure TBGRALayeredBitmap.OriginalEditingChange(ASender: TObject); -var - orig: TBGRALayerCustomOriginal; -begin - orig := TBGRALayerCustomOriginal(ASender); - if Assigned(FOriginalEditingChange) then - FOriginalEditingChange(self, orig); -end; - -function TBGRALayeredBitmap.GetLayerDirectory(ALayerIndex: integer; ACanCreate: boolean): TMemDirectory; -var - layersDir: TMemDirectory; - id: LongInt; -begin - if (MemDirectory.IndexOf(LayersDirectory,'')=-1) and not ACanCreate then exit(nil); - layersDir := MemDirectory.Directory[MemDirectory.AddDirectory(LayersDirectory)]; - id := LayerUniqueId[ALayerIndex]; - if (layersDir.IndexOf(IntToStr(id),'')=-1) and not ACanCreate then exit(nil); - result := layersDir.Directory[layersDir.AddDirectory(IntToStr(id))]; -end; - -procedure TBGRALayeredBitmap.UpdateOriginalEditor(ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single); -var - orig: TBGRALayerCustomOriginal; - editMatrix: TAffineMatrix; -begin - orig := LayerOriginal[ALayerIndex]; - - if (orig = nil) or (orig.Guid <> FOriginalEditorOriginal) then - begin - FreeAndNil(FOriginalEditor); - if orig = nil then - FOriginalEditorOriginal := GUID_NULL - else FOriginalEditorOriginal := orig.Guid; - end; - - if Assigned(OriginalEditor) then - FOriginalEditor.Clear; - - if Assigned(orig) then - begin - if OriginalEditor = nil then - begin - FOriginalEditor := orig.CreateEditor; - if FOriginalEditor = nil then - raise exception.Create('Unexpected nil value'); - FOriginalEditor.Focused := FEditorFocused; - FOriginalEditor.OnFocusChanged:=@EditorFocusedChanged; - end; - - editMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*LayerOriginalMatrix[ALayerIndex]*AffineMatrixTranslation(0.5,0.5); - if IsAffineMatrixInversible(editMatrix) then - begin - orig.ConfigureEditor(FOriginalEditor); - FOriginalEditorViewMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5); - FOriginalEditor.Matrix := editMatrix; - FOriginalEditor.PointSize := APointSize; - end; - end; -end; - -function TBGRALayeredBitmap.GetOriginalCount: integer; -begin - if Assigned(FOriginals) then - result := FOriginals.Count - else - result := 0; -end; - -function TBGRALayeredBitmap.GetOriginalByIndex(AIndex: integer - ): TBGRALayerCustomOriginal; -var - dir: TMemDirectory; - c: TBGRALayerOriginalAny; - guid: TGuid; - storage: TBGRAMemOriginalStorage; - raiseError: Boolean; -begin - if (AIndex < 0) or (AIndex >= OriginalCount) then - raise ERangeError.Create('Index out of bounds'); - - result := FOriginals[AIndex].Instance; - guid := FOriginals[AIndex].Guid; - - // load original on the fly - if (result = nil) and (guid <> GUID_NULL) then - begin - FindOriginal(guid, dir, c); - if not Assigned(dir) then - raise exception.Create('Original directory not found'); - if not Assigned(c) then - raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)'); - - result := c.Create; - result.Guid := guid; - storage := TBGRAMemOriginalStorage.Create(dir); - try - try - result.LoadFromStorage(storage); - finally - FOriginals[AIndex] := BGRALayerOriginalEntry(result); - result.OnChange:= @OriginalChange; - result.OnEditingChange:= @OriginalEditingChange; - storage.Free; - end; - except - on ex: Exception do - begin - raiseError := true; - if Assigned(FOnOriginalLoadError) then - FOnOriginalLoadError(self, ex.Message, raiseError); - if raiseError then - raise ex; - end; - end; - end; -end; - -function TBGRALayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean; -var - idxOrig: Integer; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].OriginalGuid = GUID_NULL then exit(true); - idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid); - if idxOrig = -1 then exit(false); - result := OriginalKnown[idxOrig]; - end; -end; - -function TBGRALayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean; -var - dir: TMemDirectory; - c: TBGRALayerOriginalAny; - guid: TGuid; -begin - if (AIndex < 0) or (AIndex >= OriginalCount) then - raise ERangeError.Create('Index out of bounds'); - - if Assigned(FOriginals[AIndex].Instance) then exit(true); - guid := FOriginals[AIndex].Guid; - if guid = GUID_NULL then exit(true); - - FindOriginal(guid, dir, c); - result:= Assigned(dir) and Assigned(c); -end; - -function TBGRALayeredBitmap.GetOriginalByIndexLoaded(AIndex: integer): boolean; -begin - if (AIndex < 0) or (AIndex >= OriginalCount) then - raise ERangeError.Create('Index out of bounds'); - - Result:= Assigned(FOriginals[AIndex].Instance); -end; - -function TBGRALayeredBitmap.GetOriginalGuid(AIndex: integer): TGUID; -begin - if (AIndex < 0) or (AIndex >= OriginalCount) then - raise ERangeError.Create('Index out of bounds'); - - result := FOriginals[AIndex].Guid; -end; - -procedure TBGRALayeredBitmap.SetEditorFocused(AValue: boolean); -begin - if Assigned(OriginalEditor) then OriginalEditor.Focused := AValue - else - begin - if FEditorFocused=AValue then Exit; - FEditorFocused:=AValue; - if Assigned(FOnEditorFocusChanged) then FOnEditorFocusChanged(self); - end; -end; - -procedure TBGRALayeredBitmap.SetOnActionDone(AValue: TNotifyEvent); -begin - if FOnActionDone=AValue then Exit; - FOnActionDone:=AValue; -end; - -procedure TBGRALayeredBitmap.SetOnActionProgress( - AValue: TLayeredActionProgressEvent); -begin - if FOnActionProgress=AValue then Exit; - FOnActionProgress:=AValue; -end; - -function TBGRALayeredBitmap.GetLayerOriginalClass(layer: integer): TBGRALayerOriginalAny; -var - idxOrig: Integer; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].OriginalGuid = GUID_NULL then exit(nil); - idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid); - if idxOrig = -1 then exit(nil); - result := OriginalClass[idxOrig]; - end; -end; - -function TBGRALayeredBitmap.GetOriginalEditor: TBGRAOriginalEditor; -begin - if Assigned(FOriginalEditor) and (IndexOfOriginal(FOriginalEditorOriginal)=-1) then - begin - FreeAndNil(FOriginalEditor); - FOriginalEditorOriginal := GUID_NULL; - end; - result := FOriginalEditor; -end; - -procedure TBGRALayeredBitmap.EditorFocusedChanged(Sender: TObject); -begin - if Assigned(OriginalEditor) then - begin - FEditorFocused := OriginalEditor.Focused; - if Assigned(FOnEditorFocusChanged) then FOnEditorFocusChanged(self); - end; -end; - -function TBGRALayeredBitmap.GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny; -var - dir: TMemDirectory; - c: TBGRALayerOriginalAny; - guid: TGuid; -begin - if (AIndex < 0) or (AIndex >= OriginalCount) then - raise ERangeError.Create('Index out of bounds'); - - if Assigned(FOriginals[AIndex].Instance) then exit(TBGRALayerOriginalAny(FOriginals[AIndex].Instance.ClassType)); - guid := FOriginals[AIndex].Guid; - if guid = GUID_NULL then exit(nil); - - FindOriginal(guid, dir, c); - result:= c; -end; - -function TBGRALayeredBitmap.GetWidth: integer; -begin - Result:= FWidth; -end; - -function TBGRALayeredBitmap.GetHeight: integer; -begin - Result:= FHeight; -end; - -function TBGRALayeredBitmap.GetNbLayers: integer; -begin - Result:= FNbLayers; -end; - -function TBGRALayeredBitmap.GetBlendOperation(Layer: integer): TBlendOperation; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - Result:= FLayers[layer].blendOp; -end; - -function TBGRALayeredBitmap.GetLayerVisible(layer: integer): boolean; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - Result:= FLayers[layer].Visible; -end; - -function TBGRALayeredBitmap.GetLayerOpacity(layer: integer): byte; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - Result:= FLayers[layer].Opacity; -end; - -function TBGRALayeredBitmap.GetLayerOffset(layer: integer): TPoint; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - with FLayers[layer] do - Result:= Point(x,y); -end; - -function TBGRALayeredBitmap.GetLayerName(layer: integer): string; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then - Result := FLayers[layer].Source.Caption - else - Result:= FLayers[layer].Name; - if Result = '' then - result := inherited GetLayerName(layer); - end; -end; - -function TBGRALayeredBitmap.GetLayerFrozen(layer: integer): boolean; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - Result:= FLayers[layer].Frozen; -end; - -procedure TBGRALayeredBitmap.SetBlendOperation(Layer: integer; - op: TBlendOperation); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].blendOp <> op then - begin - FLayers[layer].blendOp := op; - Unfreeze(layer); - end; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerVisible(layer: integer; AValue: boolean); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].Visible <> AValue then - begin - FLayers[layer].Visible := AValue; - Unfreeze(layer); - end; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerOpacity(layer: integer; AValue: byte); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if FLayers[layer].Opacity <> AValue then - begin - FLayers[layer].Opacity := AValue; - Unfreeze(layer); - end; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerOffset(layer: integer; AValue: TPoint); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if (FLayers[layer].x <> AValue.x) or - (FLayers[layer].y <> AValue.y) then - begin - if FLayers[layer].OriginalGuid <> GUID_NULL then - raise exception.Create('The offset of the layer is computed from an original. You can change it by changing the layer original matrix.'); - - FLayers[layer].x := AValue.x; - FLayers[layer].y := AValue.y; - Unfreeze(layer); - end; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerName(layer: integer; AValue: string); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then - FLayers[layer].Source.Caption := AValue - else - FLayers[layer].Name := AValue; - end; -end; - -procedure TBGRALayeredBitmap.SetLayerFrozen(layer: integer; AValue: boolean); -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - FLayers[layer].Frozen := AValue; -end; - -function TBGRALayeredBitmap.GetLayerBitmapDirectly(layer: integer): TBGRABitmap; -begin - if (layer < 0) or (layer >= NbLayers) then - result := nil - else - begin - if FLayers[layer].OriginalRenderStatus = orsNone then - RenderLayerFromOriginal(layer, true) - else if FLayers[layer].OriginalRenderStatus in [orsPartialDraft,orsPartialProof] then - RenderLayerFromOriginal(layer, true, FLayers[layer].OriginalInvalidatedBounds); - Result:= FLayers[layer].Source; - end; -end; - -procedure TBGRALayeredBitmap.LoadFromFile(const filenameUTF8: string); -var bmp: TBGRABitmap; - ext: string; - temp: TBGRACustomLayeredBitmap; - i: integer; - stream: TFileStreamUTF8; -begin - ext := UTF8LowerCase(ExtractFileExt(filenameUTF8)); - for i := 0 to high(LayeredBitmapReaders) do - if '.'+LayeredBitmapReaders[i].extension = ext then - begin - temp := LayeredBitmapReaders[i].theClass.Create; - try - temp.LoadFromFile(filenameUTF8); - Assign(temp); - finally - temp.Free; - end; - exit; - end; - - //when using "data" extension, simply deserialize - if (ext='.dat') or (ext='.data') then - begin - if Assigned(LayeredBitmapLoadFromStreamProc) then - begin - stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead, fmShareDenyWrite); - try - LayeredBitmapLoadFromStreamProc(stream, self); - finally - stream.Free; - end; - end else - raise exception.Create('Enable layer deserialization by calling BGRAStreamLayers.RegisterStreamLayers'); - end else - begin - bmp := TBGRABitmap.Create(filenameUTF8, True); - Clear; - SetSize(bmp.Width,bmp.Height); - AddOwnedLayer(bmp); - end; -end; - -procedure TBGRALayeredBitmap.LoadFromStream(stream: TStream); -var bmp: TBGRABitmap; -begin - if Assigned(LayeredBitmapLoadFromStreamProc) then - begin - if not Assigned(LayeredBitmapCheckStreamProc) or - LayeredBitmapCheckStreamProc(stream) then - begin - LayeredBitmapLoadFromStreamProc(Stream, self); - exit; - end; - end; - - bmp := TBGRABitmap.Create(stream); - Clear; - SetSize(bmp.Width,bmp.Height); - AddOwnedLayer(bmp); -end; - -procedure TBGRALayeredBitmap.LoadFromResource(AFilename: string); -var - stream: TStream; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - LoadFromStream(stream); - finally - stream.Free; - end; -end; - -procedure TBGRALayeredBitmap.SetSize(AWidth, AHeight: integer); -begin - Unfreeze; - FWidth := AWidth; - FHeight := AHeight; -end; - -procedure TBGRALayeredBitmap.Clear; -var i: integer; -begin - Unfreeze; - for i := NbLayers-1 downto 0 do - RemoveLayer(i); - MemDirectory := nil; - ClearOriginals; -end; - -procedure TBGRALayeredBitmap.ClearOriginals; -var - i: Integer; -begin - if Assigned(FOriginals) then - begin - for i := 0 to OriginalCount-1 do - FOriginals[i].Instance.Free; - FreeAndNil(FOriginals); - end; -end; - -procedure TBGRALayeredBitmap.RemoveLayer(index: integer); -var i: integer; - id: LongInt; - layersDir: TMemDirectory; -begin - if (index < 0) or (index >= NbLayers) then exit; - Unfreeze; - if Assigned(FMemDirectory) then - begin - id := LayerUniqueId[index]; - if FMemDirectory.IndexOf(LayersDirectory,'')<>-1 then - begin - layersDir := FMemDirectory.Directory[FMemDirectory.AddDirectory(LayersDirectory)]; - layersDir.Delete(IntToStr(id),''); - end; - end; - if FLayers[index].Owner then FLayers[index].Source.Free; - for i := index to FNbLayers-2 do - FLayers[i] := FLayers[i+1]; - Dec(FNbLayers); -end; - -procedure TBGRALayeredBitmap.InsertLayer(index: integer; fromIndex: integer); -var info: TBGRALayerInfo; - i: integer; -begin - if (index < 0) or (index > NbLayers) or (index = fromIndex) then exit; - if (fromIndex < 0) or (fromIndex >= NbLayers) then exit; - Unfreeze; - info := FLayers[fromIndex]; - for i := fromIndex to FNbLayers-2 do - FLayers[i] := FLayers[i+1]; - for i := FNbLayers-1 downto index+1 do - FLayers[i] := FLayers[i-1]; - FLayers[index] := info; -end; - -procedure TBGRALayeredBitmap.Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean; - ACopyAdditionalMemData: boolean); -var i,idx,idxOrig,idxNewOrig: integer; - usedOriginals: array of record - used: boolean; - sourceGuid,newGuid: TGuid; - end; - orig: TBGRALayerCustomOriginal; - stream: TMemoryStream; - targetDir, layerDir: TMemDirectory; - -begin - if ASource = nil then - raise exception.Create('Unexpected nil reference'); - Clear; - SetSize(ASource.Width,ASource.Height); - LinearBlend:= ASource.LinearBlend; - setlength(usedOriginals, ASource.GetOriginalCount); - for idxOrig := 0 to high(usedOriginals) do - with usedOriginals[idxOrig] do - begin - used:= false; - newGuid := GUID_NULL; - end; - for i := 0 to ASource.NbLayers-1 do - if (ASource.LayerOriginalGuid[i]<>GUID_NULL) and - (ASource.LayerOriginalKnown[i] or (ASource is TBGRALayeredBitmap)) then - begin - idxOrig := ASource.IndexOfOriginal(ASource.LayerOriginalGuid[i]); - if (idxOrig <> -1) and not usedOriginals[idxOrig].used then - begin - if ASource.GetOriginalByIndexLoaded(idxOrig) then - begin - orig := ASource.GetOriginalByIndex(idxOrig); - idxNewOrig := AddOriginal(orig, false); - usedOriginals[idxOrig].sourceGuid := orig.Guid; - end else - begin - stream := TMemoryStream.Create; - (ASource as TBGRALayeredBitmap).SaveOriginalToStream(idxOrig, stream); - stream.Position:= 0; - idxNewOrig := AddOriginalFromStream(stream,true); - stream.Free; - usedOriginals[idxOrig].sourceGuid := (ASource as TBGRALayeredBitmap).OriginalGuid[idxOrig]; - end; - usedOriginals[idxOrig].newGuid := OriginalGuid[idxNewOrig]; - usedOriginals[idxOrig].used := true; - end; - end; - for i := 0 to ASource.NbLayers-1 do - begin - idx := AddOwnedLayer(ASource.GetLayerBitmapCopy(i),ASource.LayerOffset[i],ASource.BlendOperation[i],ASource.LayerOpacity[i]); - LayerName[idx] := ASource.LayerName[i]; - LayerVisible[idx] := ASource.LayerVisible[i]; - if ASharedLayerIds and (ASource is TBGRALayeredBitmap) then - LayerUniqueId[idx] := TBGRALayeredBitmap(ASource).LayerUniqueId[i]; - for idxOrig := 0 to high(usedOriginals) do - if usedOriginals[idxOrig].sourceGuid = ASource.LayerOriginalGuid[i] then - begin - LayerOriginalGuid[idx] := usedOriginals[idxOrig].newGuid; - LayerOriginalMatrix[idx] := ASource.LayerOriginalMatrix[i]; - LayerOriginalRenderStatus[idx] := ASource.LayerOriginalRenderStatus[i]; - break; - end; - if ASource is TBGRALayeredBitmap then - begin - layerDir := TBGRALayeredBitmap(ASource).GetLayerDirectory(i,false); - if Assigned(layerDir) then - layerDir.CopyTo(GetLayerDirectory(idx,true), true); - end; - end; - if ACopyAdditionalMemData and ASource.HasMemFiles then - for i := 0 to ASource.GetMemDirectory.Count-1 do - if (ASource.GetMemDirectory.Entry[i].CompareNameAndExtension(OriginalsDirectory,'')<>0) and - (ASource.GetMemDirectory.Entry[i].CompareNameAndExtension(LayersDirectory,'')<>0) and - (ASource.GetMemDirectory.IsDirectory[i]) then - begin - with ASource.GetMemDirectory.Entry[i] do - targetDir := GetMemDirectory.Directory[GetMemDirectory.AddDirectory(Name,Extension)]; - ASource.GetMemDirectory.Directory[i].CopyTo(targetDir, true); - end; -end; - -function TBGRALayeredBitmap.MoveLayerUp(index: integer): integer; -begin - if (index >= 0) and (index <= NbLayers-2) then - begin - InsertLayer(index+1,index); - result := index+1; - end else - result := -1; -end; - -function TBGRALayeredBitmap.MoveLayerDown(index: integer): integer; -begin - if (index > 0) and (index <= NbLayers-1) then - begin - InsertLayer(index-1,index); - result := index-1; - end else - result := -1; -end; - -function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Opacity: byte - ): integer; -begin - result := AddLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity, False); -end; - -function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint; - BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer; -begin - result := AddLayer(Source.Caption,Source,Position,BlendOp,Opacity,Shared); -end; - -function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint; - Opacity: byte): integer; -begin - result := AddLayer(Source,Position,DefaultBlendingOperation,Opacity); -end; - -function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; - BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddLayer(Source,Point(0,0),BlendOp,Opacity); -end; - -function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; - Opacity: byte): integer; -begin - result := AddLayer(AName,Source,Point(0,0),Opacity); -end; - -function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; - Position: TPoint; BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer; -begin - if length(FLayers) = FNbLayers then - setlength(FLayers, length(FLayers)*2+1); - FLayers[FNbLayers].Name := AName; - FLayers[FNbLayers].X := Position.X; - FLayers[FNbLayers].Y := Position.Y; - FLayers[FNbLayers].blendOp := BlendOp; - FLayers[FNbLayers].Opacity := Opacity; - FLayers[FNbLayers].Visible := true; - FLayers[FNbLayers].Frozen := false; - FLayers[FNbLayers].UniqueId := ProduceLayerUniqueId; - FLayers[FNbLayers].OriginalMatrix := AffineMatrixIdentity; - FLayers[FNbLayers].OriginalRenderStatus := orsNone; - FLayers[FNbLayers].OriginalGuid := GUID_NULL; - if Shared then - begin - FLayers[FNbLayers].Source := Source; - FLayers[FNbLayers].Owner := false; - end else - begin - FLayers[FNbLayers].Source := Source.Duplicate; - FLayers[FNbLayers].Owner := true; - end; - result := FNbLayers; - inc(FNbLayers); - if (FNbLayers = 1) and (FWidth = 0) and (FHeight = 0) and (Source <> nil) then - SetSize(Source.Width,Source.Height); -end; - -function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; - Position: TPoint; Opacity: byte): integer; -begin - result := AddLayer(AName, Source, Position, DefaultBlendingOperation, Opacity); -end; - -function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap; - BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddLayer(AName, Source, Point(0,0), blendOp, Opacity); -end; - -function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; Opacity: byte - ): integer; -begin - result := AddSharedLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity); -end; - -function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; - Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddLayer(Source, Position, BlendOp, Opacity, True); -end; - -function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; - Position: TPoint; Opacity: byte): integer; -begin - result := AddSharedLayer(Source, Position, DefaultBlendingOperation, Opacity); -end; - -function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; - BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddSharedLayer(Source, Point(0,0), blendOp, Opacity); -end; - -function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; Opacity: byte - ): integer; -begin - result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Opacity); - FLayers[result].Name := ExtractFileName(AFilename); -end; - -function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; - Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,BlendOp,Opacity); - FLayers[result].Name := ExtractFileName(AFilename); -end; - -function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; - Position: TPoint; Opacity: byte): integer; -begin - result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,Opacity); - FLayers[result].Name := ExtractFileName(AFilename); -end; - -function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; - BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddOwnedLayer(TBGRABitmap.Create(AFilename),BlendOp,Opacity); - FLayers[result].Name := ExtractFileName(AFilename); -end; - -function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte - ): integer; -begin - result := AddSharedLayer(ABitmap,Opacity); - FLayers[result].Owner := True; -end; - -function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; - Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddSharedLayer(ABitmap,Position,BlendOp,Opacity); - FLayers[result].Owner := True; -end; - -function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; - Position: TPoint; Opacity: byte): integer; -begin - result := AddSharedLayer(ABitmap,Position,Opacity); - FLayers[result].Owner := True; -end; - -function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; - BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddSharedLayer(ABitmap,BlendOp,Opacity); - FLayers[result].Owner := True; -end; - -function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; - Opacity: byte): integer; -begin - result := AddLayerFromOriginal(AGuid, DefaultBlendingOperation, Opacity); -end; - -function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; - BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddLayerFromOriginal(AGuid, AffineMatrixIdentity, BlendOp, Opacity); -end; - -function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; - Matrix: TAffineMatrix; Opacity: byte): integer; -begin - result := AddLayerFromOriginal(AGuid, Matrix, DefaultBlendingOperation, Opacity); -end; - -function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid; - Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte): integer; -begin - result := AddOwnedLayer(TBGRABitmap.Create, BlendOp, Opacity); - LayerOriginalGuid[result] := AGuid; - LayerOriginalMatrix[result] := Matrix; - if not Assigned(LayerOriginal[result]) then - raise exception.Create('Original data or class not found'); -end; - -function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( - AOriginal: TBGRALayerCustomOriginal; Opacity: byte): integer; -begin - if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); - result := AddLayerFromOriginal(AOriginal.Guid, Opacity); -end; - -function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( - AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte): integer; -begin - if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); - result := AddLayerFromOriginal(AOriginal.Guid, BlendOp, Opacity); -end; - -function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( - AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte): integer; -begin - if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); - result := AddLayerFromOriginal(AOriginal.Guid, Matrix, Opacity); -end; - -function TBGRALayeredBitmap.AddLayerFromOwnedOriginal( - AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; - BlendOp: TBlendOperation; Opacity: byte): integer; -begin - if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal); - result := AddLayerFromOriginal(AOriginal.Guid, Matrix, BlendOp, Opacity); -end; - -class function TBGRALayeredBitmap.IsValidRegistryIndentifier(AIdentifier: string): boolean; -var - i: Integer; -begin - if length(AIdentifier) = 0 then exit(false); - for i := 1 to length(AIdentifier) do - if not (AIdentifier[i] in ['A'..'Z','a'..'z','0'..'9','_','-']) then exit(false); - exit(true); -end; - -function TBGRALayeredBitmap.GetLayerRegistry(ALayerIndex: integer; - ARegistryIdentifier: string): RawByteString; -var - layerDir, registryDir: TMemDirectory; -begin - if not IsValidRegistryIndentifier(ARegistryIdentifier) then - raise exception.Create('Invalid registry identifier'); - layerDir := GetLayerDirectory(ALayerIndex, false); - if layerDir = nil then exit(''); - registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; - result := registryDir.RawStringByFilename[ARegistryIdentifier] -end; - -procedure TBGRALayeredBitmap.SetLayerRegistry(ALayerIndex: integer; - ARegistryIdentifier: string; AValue: RawByteString); -var - layerDir, registryDir: TMemDirectory; -begin - if not IsValidRegistryIndentifier(ARegistryIdentifier) then - raise exception.Create('Invalid registry identifier'); - layerDir := GetLayerDirectory(ALayerIndex, true); - registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; - if length(AValue) = 0 then - registryDir.Delete(ARegistryIdentifier,'') - else registryDir.RawStringByFilename[ARegistryIdentifier] := AValue; -end; - -procedure TBGRALayeredBitmap.SaveLayerRegistryToStream(ALayerIndex: integer; - AStream: TStream); -var - layerDir, registryDir: TMemDirectory; -begin - layerDir := GetLayerDirectory(ALayerIndex, true); - registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; - registryDir.SaveToStream(AStream); -end; - -procedure TBGRALayeredBitmap.LoadLayerRegistryFromStream(ALayerIndex: integer; - AStream: TStream); -var - layerDir, registryDir: TMemDirectory; -begin - layerDir := GetLayerDirectory(ALayerIndex, true); - registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')]; - registryDir.LoadFromStream(AStream); -end; - -function TBGRALayeredBitmap.GetGlobalRegistry(ARegistryIdentifier: string): RawByteString; -var - registryDir: TMemDirectory; -begin - if not IsValidRegistryIndentifier(ARegistryIdentifier) then - raise exception.Create('Invalid registry identifier'); - registryDir := MemDirectory.Directory[MemDirectory.AddDirectory(RegistrySubDirectory,'')]; - result := registryDir.RawStringByFilename[ARegistryIdentifier] -end; - -procedure TBGRALayeredBitmap.SetGlobalRegistry(ARegistryIdentifier: string; AValue: RawByteString); -var - registryDir: TMemDirectory; -begin - if not IsValidRegistryIndentifier(ARegistryIdentifier) then - raise exception.Create('Invalid registry identifier'); - registryDir := MemDirectory.Directory[MemDirectory.AddDirectory(RegistrySubDirectory,'')]; - if length(AValue) = 0 then - registryDir.Delete(ARegistryIdentifier,'') - else registryDir.RawStringByFilename[ARegistryIdentifier] := AValue; -end; - -function TBGRALayeredBitmap.AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean): integer; -var - newGuid: TGuid; -begin - if AOriginal = nil then - raise exception.Create('Unexpected nil reference');; - if AOriginal.Guid = GUID_NULL then - begin - if CreateGUID(newGuid)<> 0 then - begin - if AOwned then AOriginal.Free; - raise exception.Create('Error while creating GUID'); - end; - AOriginal.Guid := newGuid; - end else - begin - if IndexOfOriginal(AOriginal) <> -1 then - begin - if AOwned then AOriginal.Free; - raise exception.Create('Original already added'); - end; - if IndexOfOriginal(AOriginal.Guid) <> -1 then - begin - if AOwned then AOriginal.Free; - raise exception.Create('GUID is already in use'); - end; - end; - if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create; - if AOwned then - begin - result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal)); - AOriginal.OnChange:= @OriginalChange; - AOriginal.OnEditingChange:= @OriginalEditingChange; - end - else - begin - StoreOriginal(AOriginal); - result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal.Guid)); - end; -end; - -function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream; - ALateLoad: boolean): integer; -var - newGuid: TGUID; -begin - if CreateGUID(newGuid)<> 0 then raise exception.Create('Error while creating GUID'); - result := AddOriginalFromStream(AStream, newGuid, ALateLoad); -end; - - -function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream; - const AGuid: TGuid; ALateLoad: boolean): integer; -var - storage: TBGRAMemOriginalStorage; -begin - storage:= TBGRAMemOriginalStorage.Create; - storage.LoadFromStream(AStream); - try - result := AddOriginalFromStorage(storage, AGuid, ALateLoad); - finally - storage.Free; - end; -end; - -function TBGRALayeredBitmap.AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean): integer; -var - newGuid: TGUID; -begin - if CreateGUID(newGuid)<> 0 then raise exception.Create('Error while creating GUID'); - result := AddOriginalFromStorage(AStorage, newGuid, ALateLoad); -end; - -function TBGRALayeredBitmap.AddOriginalFromStorage( - AStorage: TBGRAMemOriginalStorage; const AGuid: TGuid; ALateLoad: boolean): integer; -var - origClassName: String; - origClass: TBGRALayerOriginalAny; - orig: TBGRALayerCustomOriginal; - dir, subdir: TMemDirectory; - raiseError: Boolean; -begin - result := -1; - origClassName := AStorage.RawString['class']; - if origClassName = '' then raise Exception.Create('Original class name not defined'); - if ALateLoad then - begin - if IndexOfOriginal(AGuid)<>-1 then - raise exception.Create('Duplicate GUID'); - - dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; - subdir := dir.Directory[dir.AddDirectory(GUIDToString(AGuid))]; - AStorage.CopyTo(subdir); - - if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create; - result := FOriginals.Add(BGRALayerOriginalEntry(AGuid)); - end else - begin - origClass := FindLayerOriginalClass(origClassName); - if origClass = nil then raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)'); - orig := origClass.Create; - try - orig.LoadFromStorage(AStorage); - orig.Guid := AGuid; - result := AddOriginal(orig, true); - except on ex:exception do - begin - orig.Free; - raiseError := true; - if Assigned(FOnOriginalLoadError) then - FOnOriginalLoadError(self, ex.Message, raiseError); - if raiseError then - raise ex; - end; - end; - end; -end; - -procedure TBGRALayeredBitmap.SaveOriginalToStream(AIndex: integer; - AStream: TStream); -var - dir: TMemDirectory; - c: TBGRALayerOriginalAny; -begin - if (AIndex < 0) or (AIndex >= OriginalCount) then - raise ERangeError.Create('Index out of bounds'); - - if Assigned(FOriginals[AIndex].Instance) then - FOriginals[AIndex].Instance.SaveToStream(AStream) - else - begin - FindOriginal(FOriginals[AIndex].Guid, dir, c); - if dir = nil then - raise exception.Create('Original directory not found'); - dir.SaveToStream(AStream); - end; -end; - -procedure TBGRALayeredBitmap.SaveOriginalToStream(const AGuid: TGuid; - AStream: TStream); -var - idxOrig: Integer; -begin - idxOrig := IndexOfOriginal(AGuid); - if idxOrig = -1 then raise exception.Create('Original not found'); - SaveOriginalToStream(idxOrig, AStream); -end; - -function TBGRALayeredBitmap.RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean; -var - idx: Integer; -begin - idx := IndexOfOriginal(AOriginal); - if idx = -1 then exit(false); - DeleteOriginal(idx); - result := true; -end; - -procedure TBGRALayeredBitmap.DeleteOriginal(AIndex: integer); -var - dir: TMemDirectory; - i: Integer; - guid: TGuid; -begin - if (AIndex < 0) or (AIndex >= OriginalCount) then - raise ERangeError.Create('Index out of bounds'); - - guid := FOriginals[AIndex].Guid; - for i := 0 to NbLayers-1 do - if LayerOriginalGuid[i] = guid then - begin - LayerOriginalGuid[i] := GUID_NULL; - LayerOriginalMatrix[i] := AffineMatrixIdentity; - end; - - dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; - dir.Delete(GUIDToString(guid),''); - - FOriginals[AIndex].Instance.Free; - FOriginals.Delete(AIndex); //AOriginals freed -end; - -procedure TBGRALayeredBitmap.NotifyLoaded; -var - foundGuid: array of TGuid; - nbFoundGuid: integer; - - procedure AddGuid(const AGuid: TGuid); - begin - foundGuid[nbFoundGuid] := AGuid; - inc(nbFoundGuid); - end; - - function IndexOfGuid(AGuid: TGuid): integer; - var - i: Integer; - begin - for i := 0 to nbFoundGuid-1 do - if foundGuid[i] = AGuid then exit(i); - result := -1; - end; - -var - i: Integer; - dir: TMemDirectory; - newGuid: TGUID; - -begin - inherited NotifyLoaded; - - //if there are no files in memory, we are sure that there are no originals - if not HasMemFiles then - begin - ClearOriginals; - exit; - end; - - //determine list of GUID of originals - dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)]; - setlength(foundGuid, dir.Count); - nbFoundGuid:= 0; - for i := 0 to dir.Count-1 do - if dir.IsDirectory[i] and (dir.Entry[i].Extension = '') then - begin - if TryStringToGUID(dir.Entry[i].Name, newGuid) then - AddGuid(newGuid); - end; - - //remove originals that do not exist anymore - for i := OriginalCount-1 downto 0 do - if IndexOfGuid(FOriginals[i].Guid) = -1 then - DeleteOriginal(i); - - //add originals from memory directory - for i := 0 to nbFoundGuid-1 do - begin - if IndexOfOriginal(foundGuid[i]) = -1 then - begin - if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create; - FOriginals.Add(BGRALayerOriginalEntry(foundGuid[i])); - end; - end; -end; - -procedure TBGRALayeredBitmap.NotifySaving; -var - i, j, id, ErrPos: Integer; - layersDir, renderDir: TMemDirectory; -begin - inherited NotifySaving; - - RenderOriginalsIfNecessary; - - for i := 0 to OriginalCount-1 do - if Assigned(FOriginals[i].Instance) then - StoreOriginal(FOriginals[i].Instance); - - //check layer storage - if MemDirectory.IndexOf(LayersDirectory,'')<>-1 then - begin - layersDir := MemDirectory.Directory[MemDirectory.AddDirectory(LayersDirectory)]; - for i := layersDir.Count-1 downto 0 do - if layersDir.IsDirectory[i] then - begin - renderDir := layersDir.Directory[i].FindPath(RenderSubDirectory); - - if Assigned(renderDir) then - begin - //discard temporary files - renderDir.Delete(RenderTempSubDirectory,''); - - //compress significant files - for j := 0 to renderDir.Count-1 do - begin - if renderDir.Entry[j].FileSize > 128 then - renderDir.IsEntryCompressed[j] := true; - end; - end; - - //remove invalid layer references - val(layersDir.Entry[i].Name, id, errPos); - if (errPos <> 0) or (GetLayerIndexFromId(id)=-1) then - layersDir.Delete(i); - end; - if layersDir.Count = 0 then - MemDirectory.Delete(LayersDirectory,''); - end; -end; - -procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer; - ADraft: boolean; AFullSizeLayer: boolean = false); -begin - RenderLayerFromOriginal(layer, ADraft, rectF(0,0,Width,Height), AFullSizeLayer); -end; - -procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer; - ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false); -var - orig: TBGRALayerCustomOriginal; - rAll, rNewBounds, rInterRender: TRect; - newSource: TBGRABitmap; - layerDir, renderDir: TMemDirectory; - j: integer; - - procedure FreeSource; - begin - if FLayers[layer].Owner then - FreeAndNil(FLayers[layer].Source) - else - FLayers[layer].Source := nil; - end; - -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds'); - - orig := LayerOriginal[layer]; - if Assigned(orig) then - begin - Unfreeze(layer); - layerDir := GetLayerDirectory(layer, true); - renderDir := layerDir.Directory[layerDir.AddDirectory(RenderSubDirectory)]; - //uncompress files for faster access - for j := 0 to renderDir.Count-1 do - renderDir.IsEntryCompressed[j] := false; - orig.RenderStorage := TBGRAMemOriginalStorage.Create(renderDir); - - rAll := rect(0,0,Width,Height); - if AFullSizeLayer then - rNewBounds := rAll - else - begin - rNewBounds := orig.GetRenderBounds(rAll,FLayers[layer].OriginalMatrix); - rNewBounds.Intersect(rAll); - end; - rInterRender := TRect.Intersect(ARenderBounds, rNewBounds); - if (FLayers[layer].x = rNewBounds.Left) and - (FLayers[layer].y = rNewBounds.Top) and - Assigned(FLayers[layer].Source) and - (FLayers[layer].Source.Width = rNewBounds.Width) and - (FLayers[layer].Source.Height = rNewBounds.Height) then - begin - rInterRender.Offset(-rNewBounds.Left, -rNewBounds.Top); - FLayers[layer].Source.FillRect(rInterRender, BGRAPixelTransparent, dmSet); - FLayers[layer].Source.ClipRect := rInterRender; - orig.Render(FLayers[layer].Source, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft); - FLayers[layer].Source.NoClip; - end else - begin - if rInterRender = rNewBounds then - begin - FreeSource; - newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height); - orig.Render(newSource, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft); - end else - begin - newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height); - newSource.PutImage(FLayers[layer].x - rNewBounds.Left, FLayers[layer].y - rNewBounds.Top, FLayers[layer].Source, dmSet); - FreeSource; - rInterRender.Offset(-rNewBounds.Left, -rNewBounds.Top); - if not rInterRender.IsEmpty then - begin - newSource.FillRect(rInterRender, BGRAPixelTransparent, dmSet); - newSource.ClipRect := rInterRender; - orig.Render(newSource, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft); - newSource.NoClip; - end; - end; - FLayers[layer].Source := newSource; - FLayers[layer].x := rNewBounds.Left; - FLayers[layer].y := rNewBounds.Top; - end; - - orig.RenderStorage.AffineMatrix['last-matrix'] := FLayers[layer].OriginalMatrix; - orig.RenderStorage.Free; - orig.renderStorage := nil; - if renderDir.Count = 1 then //only matrix - layerDir.Delete(RenderSubDirectory,''); - end; - if ADraft then - FLayers[layer].OriginalRenderStatus := orsDraft - else - FLayers[layer].OriginalRenderStatus := orsProof; - FLayers[layer].OriginalInvalidatedBounds := EmptyRectF; -end; - -procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer; - ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false); -var - r: TRect; -begin - with ARenderBoundsF do - r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); - RenderLayerFromOriginal(layer, ADraft, r, AFullSizeLayer); -end; - -procedure TBGRALayeredBitmap.RenderLayerFromOriginalIfNecessary(layer: integer; - ADraft: boolean; var ABounds: TRect); - procedure UnionLayerArea(ALayer: integer); - var - r: TRect; - begin - if (FLayers[ALayer].Source = nil) or - (FLayers[ALayer].Source.Width = 0) or - (FLayers[ALayer].Source.Height = 0) then exit; - - r := RectWithSize(LayerOffset[ALayer].X, LayerOffset[ALayer].Y, - FLayers[ALayer].Source.Width, FLayers[ALayer].Source.Height); - if ABounds.IsEmpty then ABounds := r else - ABounds.Union(r); - end; - -var - r: TRect; - -begin - case LayerOriginalRenderStatus[layer] of - orsNone: - begin - UnionLayerArea(layer); - RenderLayerFromOriginal(layer, ADraft); - UnionLayerArea(layer); - end; - orsDraft: if not ADraft then - begin - UnionLayerArea(layer); - RenderLayerFromOriginal(layer, ADraft); - UnionLayerArea(layer); - end; - orsPartialDraft,orsPartialProof: - if not ADraft and (LayerOriginalRenderStatus[layer] = orsPartialDraft) then - begin - UnionLayerArea(layer); - RenderLayerFromOriginal(layer, ADraft, rect(0,0,Width,Height), true); - UnionLayerArea(layer); - end - else - begin - with FLayers[layer].OriginalInvalidatedBounds do - r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); - RenderLayerFromOriginal(layer, ADraft, r, true); - if not r.Isempty then - begin - if ABounds.IsEmpty then - ABounds := r - else - ABounds.Union(r); - end; - end; - end; -end; - -function TBGRALayeredBitmap.RenderOriginalsIfNecessary(ADraft: boolean): TRect; -var - i: Integer; -begin - result:= EmptyRect; - for i := 0 to NbLayers-1 do - RenderLayerFromOriginalIfNecessary(i, ADraft, result); -end; - -function TBGRALayeredBitmap.RenderOriginalIfNecessary(const AGuid: TGuid; - ADraft: boolean): TRect; -var - i: Integer; -begin - result:= EmptyRect; - for i := 0 to NbLayers-1 do - if LayerOriginalGuid[i] = AGuid then - RenderLayerFromOriginalIfNecessary(i, ADraft, result); -end; - -procedure TBGRALayeredBitmap.RemoveUnusedOriginals; -var useCount: array of integer; - i, idxOrig: Integer; -begin - if OriginalCount = 0 then exit; - setlength(useCount, OriginalCount); - for i := 0 to NbLayers-1 do - begin - idxOrig := IndexOfOriginal(LayerOriginalGuid[i]); - if idxOrig <> -1 then inc(useCount[idxOrig]); - end; - for i := high(useCount) downto 0 do - if useCount[i] = 0 then DeleteOriginal(i); -end; - -procedure TBGRALayeredBitmap.UnloadOriginals; -var - i: Integer; -begin - for i := 0 to OriginalCount-1 do - UnloadOriginal(i); -end; - -procedure TBGRALayeredBitmap.UnloadOriginal(AIndex: integer); -var - origInfo: TBGRALayerOriginalEntry; -begin - if (AIndex >= 0) and (AIndex < OriginalCount) then - begin - origInfo := FOriginals[AIndex]; - if Assigned(origInfo.Instance) then - begin - StoreOriginal(origInfo.Instance); - FreeAndNil(origInfo.Instance); - FOriginals[AIndex] := origInfo; - end; - end; -end; - -procedure TBGRALayeredBitmap.UnloadOriginal(const AGuid: TGuid); -begin - UnloadOriginal(IndexOfOriginal(AGuid)); -end; - -destructor TBGRALayeredBitmap.Destroy; -begin - FOriginalEditor.Free; - inherited Destroy; -end; - -constructor TBGRALayeredBitmap.Create; -begin - inherited Create; - FWidth := 0; - FHeight := 0; - FNbLayers:= 0; - FOriginals := nil; -end; - -constructor TBGRALayeredBitmap.Create(AWidth, AHeight: integer); -begin - inherited Create; - if AWidth < 0 then - FWidth := 0 - else - FWidth := AWidth; - if AHeight < 0 then - FHeight := 0 - else - FHeight := AHeight; - FNbLayers:= 0; -end; - -function TBGRALayeredBitmap.GetLayerBitmapCopy(layer: integer): TBGRABitmap; -begin - result := GetLayerBitmapDirectly(layer).Duplicate; -end; - -function TBGRALayeredBitmap.GetLayerIndexFromId(AIdentifier: integer): integer; -var i: integer; -begin - for i := 0 to NbLayers-1 do - if FLayers[i].UniqueId = AIdentifier then - begin - result := i; - exit; - end; - result := -1; //not found -end; - -function TBGRALayeredBitmap.Duplicate(ASharedLayerIds: boolean): TBGRALayeredBitmap; -begin - result := TBGRALayeredBitmap.Create; - result.Assign(self, ASharedLayerIds); -end; - -function TBGRALayeredBitmap.ProduceLayerUniqueId: integer; -begin - result := InterLockedIncrement(NextLayerUniqueId); -end; - -procedure TBGRALayeredBitmap.RotateCW; -var i: integer; - newBmp: TBGRABitmap; - newOfs: TPointF; - m: TAffineMatrix; -begin - SetSize(Height,Width); //unfreeze - m := AffineMatrixTranslation(Width,0)*AffineMatrixRotationDeg(90); - for i := 0 to NbLayers-1 do - begin - if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); - newOfs:= m*PointF(FLayers[i].x,FLayers[i].y+FLayers[i].Source.Height); - newBmp := FLayers[i].Source.RotateCW; - if FLayers[i].Owner then FreeAndNil(FLayers[i].Source); - FLayers[i].Source := newBmp; - FLayers[i].Owner := true; - FLayers[i].x := round(newOfs.x); - FLayers[i].y := round(newOfs.y); - FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix; - end; - if Assigned(OnActionDone) then OnActionDone(self); -end; - -procedure TBGRALayeredBitmap.RotateCCW; -var i: integer; - newBmp: TBGRABitmap; - newOfs: TPointF; - m: TAffineMatrix; -begin - SetSize(Height,Width); //unfreeze - m := AffineMatrixTranslation(0,Height)*AffineMatrixRotationDeg(-90); - for i := 0 to NbLayers-1 do - begin - if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); - newOfs:= m*PointF(FLayers[i].x+FLayers[i].Source.Width,FLayers[i].y); - newBmp := FLayers[i].Source.RotateCCW; - if FLayers[i].Owner then FreeAndNil(FLayers[i].Source); - FLayers[i].Source := newBmp; - FLayers[i].Owner := true; - FLayers[i].x := round(newOfs.x); - FLayers[i].y := round(newOfs.y); - FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix; - end; - if Assigned(OnActionDone) then OnActionDone(self); -end; - -procedure TBGRALayeredBitmap.RotateUD; -var i: integer; -begin - Unfreeze; - for i := 0 to NbLayers-1 do - begin - if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); - RotateUD(i); - end; - if Assigned(OnActionDone) then OnActionDone(self); -end; - -procedure TBGRALayeredBitmap.RotateUD(ALayerIndex: integer); -begin - if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then - raise ERangeError.Create('Index out of bounds'); - Unfreeze(ALayerIndex); - if FLayers[ALayerIndex].Owner then - FLayers[ALayerIndex].Source.RotateUDInplace - else - begin - FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.RotateUD; - FLayers[ALayerIndex].Owner := true; - end; - FLayers[ALayerIndex].x := Width-FLayers[ALayerIndex].x-FLayers[ALayerIndex].Source.Width; - FLayers[ALayerIndex].y := Height-FLayers[ALayerIndex].y-FLayers[ALayerIndex].Source.Height; - FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(+Width/2,+Height/2)*AffineMatrixScale(-1,-1)*AffineMatrixTranslation(-Width/2,-Height/2)*FLayers[ALayerIndex].OriginalMatrix; -end; - -procedure TBGRALayeredBitmap.HorizontalFlip; -var i: integer; -begin - Unfreeze; - for i := 0 to NbLayers-1 do - begin - if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); - HorizontalFlip(i); - end; - if Assigned(OnActionDone) then OnActionDone(self); -end; - -procedure TBGRALayeredBitmap.HorizontalFlip(ALayerIndex: integer); -begin - if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then - raise ERangeError.Create('Index out of bounds'); - Unfreeze(ALayerIndex); - if FLayers[ALayerIndex].Owner then - FLayers[ALayerIndex].Source.HorizontalFlip - else - begin - FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True); - FLayers[ALayerIndex].Source.HorizontalFlip; - FLayers[ALayerIndex].Owner := true; - end; - FLayers[ALayerIndex].x := Width-FLayers[ALayerIndex].x-FLayers[ALayerIndex].Source.Width; - FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(+Width/2,0)*AffineMatrixScale(-1,1)*AffineMatrixTranslation(-Width/2,0)*FLayers[ALayerIndex].OriginalMatrix; -end; - -procedure TBGRALayeredBitmap.VerticalFlip; -var i: integer; -begin - Unfreeze; - for i := 0 to NbLayers-1 do - begin - if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); - VerticalFlip(i); - end; - if Assigned(OnActionDone) then OnActionDone(self); -end; - -procedure TBGRALayeredBitmap.VerticalFlip(ALayerIndex: integer); -begin - if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then - raise ERangeError.Create('Index out of bounds'); - Unfreeze(ALayerIndex); - if FLayers[ALayerIndex].Owner then - FLayers[ALayerIndex].Source.VerticalFlip - else - begin - FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True); - FLayers[ALayerIndex].Source.VerticalFlip; - FLayers[ALayerIndex].Owner := true; - end; - FLayers[ALayerIndex].y := Height-FLayers[ALayerIndex].y-FLayers[ALayerIndex].Source.Height; - FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(0,+Height/2)*AffineMatrixScale(1,-1)*AffineMatrixTranslation(0,-Height/2)*FLayers[ALayerIndex].OriginalMatrix; -end; - -procedure TBGRALayeredBitmap.Resample(AWidth, AHeight: integer; - AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter); -var i, prevWidth, prevHeight: integer; - resampled: TBGRABitmap; - oldFilter : TResampleFilter; - dummyRect: TRect; -begin - if (AWidth < 0) or (AHeight < 0) then - raise exception.Create('Invalid size'); - prevWidth := Width; - if prevWidth < 1 then prevWidth := AWidth; - prevHeight := Height; - if prevHeight < 1 then prevHeight := AHeight; - SetSize(AWidth, AHeight); //unfreeze - dummyRect := EmptyRect; - for i := 0 to NbLayers-1 do - begin - if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers)); - if (FLayers[i].OriginalGuid <> GUID_NULL) and LayerOriginalKnown[i] then - begin - LayerOriginalMatrix[i] := AffineMatrixScale(AWidth/prevWidth,AHeight/prevHeight)*LayerOriginalMatrix[i]; - if AResampleMode = rmFineResample then RenderLayerFromOriginalIfNecessary(i, false, dummyRect); - end else - begin - if LayerBitmap[i].NbPixels <> 0 then - begin - oldFilter := LayerBitmap[i].ResampleFilter; - LayerBitmap[i].ResampleFilter := AFineResampleFilter; - resampled := LayerBitmap[i].Resample(max(1,round(LayerBitmap[i].Width*AWidth/prevWidth)), - max(1,round(LayerBitmap[i].Height*AHeight/prevHeight)), AResampleMode); - LayerBitmap[i].ResampleFilter := oldFilter; - SetLayerBitmap(i, resampled, True); - end; - with LayerOffset[i] do - LayerOffset[i] := Point(round(X*AWidth/prevWidth),round(Y*AHeight/prevHeight)); - end; - end; - if Assigned(OnActionDone) then OnActionDone(self); -end; - -procedure TBGRALayeredBitmap.SetLayerBitmap(layer: integer; - ABitmap: TBGRABitmap; AOwned: boolean); -var - layerDir: TMemDirectory; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds') - else - begin - if ABitmap = FLayers[layer].Source then exit; - Unfreeze(layer); - if FLayers[layer].Owner then FLayers[layer].Source.Free; - FLayers[layer].Source := ABitmap; - FLayers[layer].Owner := AOwned; - FLayers[layer].OriginalGuid := GUID_NULL; - FLayers[layer].OriginalMatrix := AffineMatrixIdentity; - layerDir := GetLayerDirectory(layer, false); - if Assigned(layerDir) then - layerDir.Delete(RenderSubDirectory,''); - end; -end; - -function TBGRALayeredBitmap.TakeLayerBitmap(layer: integer): TBGRABitmap; -begin - result := GetLayerBitmapDirectly(layer); - if Assigned(result) then - begin - if FLayers[layer].Owner then FLayers[layer].Owner := false - else result := result.Duplicate; - end; -end; - -procedure TBGRALayeredBitmap.ApplyLayerOffset(ALayerIndex: integer; - APadWithTranparentPixels: boolean); -var - r: TRect; - newBmp: TBGRABitmap; -begin - if APadWithTranparentPixels then - begin - if (LayerOffset[ALayerIndex].X=0) and (LayerOffset[ALayerIndex].Y=0) and - (LayerBitmap[ALayerIndex].Width=Width) and (LayerBitmap[ALayerIndex].Height=Height) then exit; - newBmp := TBGRABitmap.Create(Width,Height); - newBmp.PutImage(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y, LayerBitmap[ALayerIndex], dmSet); - if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free; - FLayers[ALayerIndex].Source := newBmp; - FLayers[ALayerIndex].Owner := true; - FLayers[ALayerIndex].x := 0; - FLayers[ALayerIndex].y := 0; - end else - begin - if (LayerOffset[ALayerIndex].X>=0) and (LayerOffset[ALayerIndex].Y>=0) and - (LayerOffset[ALayerIndex].X+LayerBitmap[ALayerIndex].Width <= Width) and - (LayerOffset[ALayerIndex].Y+LayerBitmap[ALayerIndex].Height <= Height) then exit; - r := RectWithSize(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y, - LayerBitmap[ALayerIndex].Width, LayerBitmap[ALayerIndex].Height); - r.Intersect( rect(0,0,Width,Height) ); - newBmp := TBGRABitmap.Create(r.Width,r.Height); - newBmp.PutImage(LayerOffset[ALayerIndex].X - r.Left, LayerOffset[ALayerIndex].Y - r.Top, LayerBitmap[ALayerIndex], dmSet); - if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free; - FLayers[ALayerIndex].Source := newBmp; - FLayers[ALayerIndex].Owner := true; - FLayers[ALayerIndex].x := r.Left; - FLayers[ALayerIndex].y := r.Top; - end; -end; - -function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap; - ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; -begin - result := DrawEditor(ADest, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize); -end; - -function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; - AMatrix: TAffineMatrix; APointSize: single): TRect; -begin - UpdateOriginalEditor(ALayerIndex, AMatrix, APointSize); - if Assigned(OriginalEditor) then - result := OriginalEditor.Render(ADest, rect(0,0,ADest.Width,ADest.Height)) - else result := EmptyRect; -end; - -function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer; X, - Y: Integer; APointSize: single): TRect; -begin - result := GetEditorBounds(ALayerIndex, AffineMatrixTranslation(X,Y), APointSize); -end; - -function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect; - ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; -begin - result := GetEditorBounds(ADestRect, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize); -end; - -function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer; - AMatrix: TAffineMatrix; APointSize: single): TRect; -begin - result := GetEditorBounds(rect(-maxLongint,-maxLongint,maxLongint,maxLongint), ALayerIndex, AMatrix, APointSize); -end; - -function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; - AMatrix: TAffineMatrix; APointSize: single): TRect; -begin - UpdateOriginalEditor(ALayerIndex, AMatrix, APointSize); - - if Assigned(OriginalEditor) then - result := OriginalEditor.GetRenderBounds(ADestRect) - else result := EmptyRect; -end; - -procedure TBGRALayeredBitmap.ClearEditor; -begin - if Assigned(FOriginalEditor) then FOriginalEditor.Clear; - FOriginalEditorOriginal := GUID_NULL; -end; - -procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out - ACursor: TOriginalEditorCursor); -var - handled: boolean; -begin - MouseMove(Shift, ImageX,ImageY, ACursor, handled); -end; - -procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean; - Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); -var - handled: boolean; -begin - MouseDown(RightButton, Shift, ImageX,ImageY, ACursor, handled); -end; - -procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState; - ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor); -var - handled: boolean; -begin - MouseUp(RightButton, Shift, ImageX,ImageY, ACursor, handled); -end; - -procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out - ACursor: TOriginalEditorCursor; out AHandled: boolean); -var - viewPt: TPointF; -begin - if Assigned(OriginalEditor) then - begin - viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY); - OriginalEditor.MouseMove(Shift, viewPt.X, viewPt.Y, ACursor, AHandled); - end - else - begin - ACursor:= oecDefault; - AHandled:= false; - end; -end; - -procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean; - Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out - AHandled: boolean); -var - viewPt: TPointF; -begin - if Assigned(OriginalEditor) then - begin - viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY); - OriginalEditor.MouseDown(RightButton, Shift, viewPt.X, viewPt.Y, ACursor, AHandled); - end - else - begin - ACursor:= oecDefault; - AHandled:= false; - end; -end; - -procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState; - ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); -var - viewPt: TPointF; -begin - if Assigned(OriginalEditor) then - begin - viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY); - OriginalEditor.MouseUp(RightButton, Shift, viewPt.X,viewPt.Y, ACursor, AHandled); - end - else - begin - ACursor:= oecDefault; - AHandled:= false; - end; -end; - -procedure TBGRALayeredBitmap.KeyDown(Shift: TShiftState; Key: TSpecialKey; out - AHandled: boolean); -begin - if Assigned(OriginalEditor) then - OriginalEditor.KeyDown(Shift, Key, AHandled) - else - AHandled := false; -end; - -procedure TBGRALayeredBitmap.KeyUp(Shift: TShiftState; Key: TSpecialKey; out - AHandled: boolean); -begin - if Assigned(OriginalEditor) then - OriginalEditor.KeyUp(Shift, Key, AHandled) - else - AHandled := false; -end; - -procedure TBGRALayeredBitmap.KeyPress(UTF8Key: string; out AHandled: boolean); -begin - if Assigned(OriginalEditor) then - OriginalEditor.KeyPress(UTF8Key, AHandled) - else - AHandled := false; -end; - -function TBGRALayeredBitmap.IndexOfOriginal(const AGuid: TGuid): integer; -var - i: Integer; -begin - for i := 0 to OriginalCount-1 do - if FOriginals[i].Guid = AGuid then - begin - result := i; - exit; - end; - result := -1 -end; - -function TBGRALayeredBitmap.IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; -begin - if Assigned(FOriginals) then - result := FOriginals.IndexOf(BGRALayerOriginalEntry(AOriginal)) - else - result := -1; -end; - -{ TBGRACustomLayeredBitmap } - -function TBGRACustomLayeredBitmap.GetLinearBlend: boolean; -begin - result := FLinearBlend; -end; - -function TBGRACustomLayeredBitmap.GetSelectionVisible: boolean; -begin - result := (FSelectionScanner <> nil) and (FSelectionLayerIndex >= 0) and - (FSelectionLayerIndex < NbLayers) and FSelectionRect.IntersectsWith(rect(0,0,Width,Height)); -end; - -function TBGRACustomLayeredBitmap.GetMemDirectory: TMemDirectory; -begin - if FMemDirectory = nil then - begin - FMemDirectory:= TMemDirectory.Create; - FMemDirectoryOwned := true; - end; - result := FMemDirectory; -end; - -function TBGRACustomLayeredBitmap.GetDefaultBlendingOperation: TBlendOperation; -begin - result := boTransparent; -end; - -function TBGRACustomLayeredBitmap.GetHasMemFiles: boolean; -begin - result := assigned(FMemDirectory) and (FMemDirectory.Count > 0); -end; - -function TBGRACustomLayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid; -begin - result := GUID_NULL; -end; - -function TBGRACustomLayeredBitmap.GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus; -begin - result := orsProof; -end; - -function TBGRACustomLayeredBitmap.GetOriginalCount: integer; -begin - result := 0; -end; - -function TBGRACustomLayeredBitmap.GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal; -begin - result := nil; - raise exception.Create('Not implemented'); -end; - -function TBGRACustomLayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean; -begin - result := true; -end; - -function TBGRACustomLayeredBitmap.GetOriginalByIndexLoaded(AIndex: integer): boolean; -begin - result := true; -end; - -function TBGRACustomLayeredBitmap.GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny; -begin - result := nil; -end; - -function TBGRACustomLayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; -begin - result := nil; -end; - -function TBGRACustomLayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean; -begin - result := true; -end; - -function TBGRACustomLayeredBitmap.GetLayerOriginalMatrix(layer: integer): TAffineMatrix; -begin - result := AffineMatrixIdentity; -end; - -procedure TBGRACustomLayeredBitmap.SetLinearBlend(AValue: boolean); -begin - Unfreeze; - FLinearBlend := AValue; -end; - -procedure TBGRACustomLayeredBitmap.SetMemDirectory(AValue: TMemDirectory); -begin - if AValue = FMemDirectory then exit; - if FMemDirectoryOwned then FMemDirectory.Free; - FMemDirectory := AValue; - FMemDirectoryOwned := false; -end; - -function TBGRACustomLayeredBitmap.GetLayerName(layer: integer): string; -begin - result := 'Layer' + inttostr(layer+1); -end; - -{$hints off} -function TBGRACustomLayeredBitmap.GetLayerOffset(layer: integer): TPoint; -begin - //optional function - result := Point(0,0); -end; -{$hints on} - -{$hints off} -function TBGRACustomLayeredBitmap.GetLayerBitmapDirectly(layer: integer - ): TBGRABitmap; -begin - //optional function - result:= nil; -end; - -function TBGRACustomLayeredBitmap.GetLayerFrozenRange(layer: integer): integer; -var i: integer; -begin - for i := 0 to high(FFrozenRange) do - if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then - begin - result := i; - exit; - end; - result := -1; -end; - -function TBGRACustomLayeredBitmap.GetLayerFrozen(layer: integer): boolean; -var i: integer; -begin - for i := 0 to high(FFrozenRange) do - if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then - begin - result := true; - exit; - end; - result := false; -end; - -function TBGRACustomLayeredBitmap.GetLayerUniqueId(layer: integer): integer; -begin - result := layer; -end; - -procedure TBGRACustomLayeredBitmap.SetLayerFrozen(layer: integer; - AValue: boolean); -begin - //nothing -end; - -function TBGRACustomLayeredBitmap.RangeIntersect(first1, last1, first2, - last2: integer): boolean; -begin - result := (first1 <= last2) and (last1 >= first2); -end; - -procedure TBGRACustomLayeredBitmap.RemoveFrozenRange(index: integer); -var j,i: integer; -begin - for j := FFrozenRange[index].firstLayer to FFrozenRange[index].lastLayer do - SetLayerFrozen(j,False); - FFrozenRange[index].image.Free; - for i := index to high(FFrozenRange)-1 do - FFrozenRange[i] := FFrozenRange[i+1]; - setlength(FFrozenRange,length(FFrozenRange)-1); -end; - -function TBGRACustomLayeredBitmap.ContainsFrozenRange(first, last: integer): boolean; -var i: integer; -begin - for i := 0 to high(FFrozenRange) do - if (FFrozenRange[i].firstLayer = first) and (FFrozenRange[i].lastLayer = last) then - begin - result := true; - exit; - end; - result := false; -end; - -function TBGRACustomLayeredBitmap.GetLayerDrawMode(AIndex: integer): TDrawMode; -begin - if (BlendOperation[AIndex] = boTransparent) and not LinearBlend then - result := dmDrawWithTransparency - else result := dmLinearBlend; -end; - -function TBGRACustomLayeredBitmap.GetEmpty: boolean; -begin - result := (NbLayers = 0) and (Width = 0) and (Height = 0); -end; - -function TBGRACustomLayeredBitmap.IndexOfOriginal(const AGuid: TGuid): integer; -begin - result := -1; -end; - -function TBGRACustomLayeredBitmap.IndexOfOriginal( - AOriginal: TBGRALayerCustomOriginal): integer; -begin - result := -1; -end; - -procedure TBGRACustomLayeredBitmap.SetWidth(Value: Integer); -begin - //nothing -end; - -procedure TBGRACustomLayeredBitmap.SetHeight(Value: Integer); -begin - //nothing -end; - -function TBGRACustomLayeredBitmap.GetTransparent: Boolean; -begin - result := true; -end; - -procedure TBGRACustomLayeredBitmap.SetTransparent(Value: Boolean); -begin - //nothing -end; - -procedure TBGRACustomLayeredBitmap.SaveToFile(const filenameUTF8: string); -var bmp: TBGRABitmap; - ext: string; - temp: TBGRALayeredBitmap; - i: integer; - stream: TFileStreamUTF8; -begin - ext := UTF8LowerCase(ExtractFileExt(filenameUTF8)); - for i := 0 to high(LayeredBitmapWriters) do - if '.'+LayeredBitmapWriters[i].extension = ext then - begin - temp := LayeredBitmapWriters[i].theClass.Create; - try - temp.Assign(self); - temp.SaveToFile(filenameUTF8); - finally - temp.Free; - end; - exit; - end; - - //when using "data" extension, simply serialize - if (ext='.dat') or (ext='.data') then - begin - if Assigned(LayeredBitmapLoadFromStreamProc) then - begin - stream := TFileStreamUTF8.Create(filenameUTF8, fmCreate); - try - LayeredBitmapSaveToStreamProc(stream, self); - finally - stream.Free; - end; - end else - raise exception.Create('Enable layer serialization by calling BGRAStreamLayers.RegisterStreamLayers'); - end else - begin - bmp := ComputeFlatImage; - try - bmp.SaveToFileUTF8(filenameUTF8); - finally - bmp.Free; - end; - end; -end; - -procedure TBGRACustomLayeredBitmap.SaveToStream(Stream: TStream); -begin - if Assigned(LayeredBitmapSaveToStreamProc) then - LayeredBitmapSaveToStreamProc(Stream, self) - else - raise exception.Create('Call BGRAStreamLayers.RegisterStreamLayers first'); -end; - -procedure TBGRACustomLayeredBitmap.SaveToStreamAs(Stream: TStream; - AExtension: string); -var bmp: TBGRABitmap; - ext: string; - format: TBGRAImageFormat; - temp: TBGRALayeredBitmap; - i: integer; -begin - ext := UTF8LowerCase(AExtension); - if ext[1] <> '.' then ext := '.'+ext; - - for i := 0 to high(LayeredBitmapWriters) do - if '.'+LayeredBitmapWriters[i].extension = ext then - begin - temp := LayeredBitmapWriters[i].theClass.Create; - try - temp.Assign(self, true, true); - temp.SaveToStream(Stream); - finally - temp.Free; - end; - exit; - end; - - format := SuggestImageFormat(ext); - bmp := ComputeFlatImage; - try - bmp.SaveToStreamAs(Stream, format); - finally - bmp.Free; - end; -end; - -constructor TBGRACustomLayeredBitmap.Create; -begin - FFrozenRange := nil; - FLinearBlend:= True; - FMemDirectory := nil; - FMemDirectoryOwned:= false; - FSelectionDrawMode:= dmDrawWithTransparency; - FSelectionLayerIndex:= -1; - FSelectionRect:= EmptyRect; - FSelectionScanner:= nil; - FSelectionScannerOffset:= Point(0,0); -end; - -{$hints on} - -function TBGRACustomLayeredBitmap.ToString: ansistring; -var - i: integer; -begin - Result := 'LayeredBitmap' + LineEnding + LineEnding; - for i := 0 to NbLayers - 1 do - begin - AppendStr(Result, LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding); - end; -end; - -procedure TBGRACustomLayeredBitmap.DiscardSelection; -begin - fillchar(FSelectionScanner, sizeof(FSelectionScanner), 0); - FSelectionRect := EmptyRect; - FSelectionLayerIndex := -1; - FSelectionScannerOffset:= Point(0,0); -end; - -function TBGRACustomLayeredBitmap.ComputeFlatImage(ASeparateXorMask: boolean): TBGRABitmap; -begin - result := ComputeFlatImage(rect(0,0,Width,Height), 0, NbLayers - 1, ASeparateXorMask); -end; - -function TBGRACustomLayeredBitmap.ComputeFlatImage(firstLayer, - lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap; -begin - result := ComputeFlatImage(rect(0,0,Width,Height), firstLayer,LastLayer,ASeparateXorMask); -end; - -function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect; - ASeparateXorMask: boolean): TBGRABitmap; -begin - result := ComputeFlatImage(ARect,0, NbLayers - 1, ASeparateXorMask); -end; - -destructor TBGRACustomLayeredBitmap.Destroy; -begin - DiscardSelection; - Clear; -end; - -function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap; -var - i,j: integer; - destEmpty: boolean; - -begin - if (firstLayer < 0) or (lastLayer > NbLayers-1) then - raise ERangeError.Create('Layer index out of bounds'); - If (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then - begin - result := TBGRABitmap.Create(0,0); - exit; - end; - Result := TBGRABitmap.Create(ARect.Right-ARect.Left, ARect.Bottom-ARect.Top); - destEmpty := true; - if SelectionVisible then Unfreeze(SelectionLayerIndex); - i := firstLayer; - while i <= lastLayer do - begin - if LayerFrozen[i] then - begin - j := GetLayerFrozenRange(i); - if j <> -1 then - begin - if i = 0 then - Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmSet) else - if not FFrozenRange[j].linearBlend then - Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmDrawWithTransparency) - else - Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmLinearBlend); - i := FFrozenRange[j].lastLayer+1; - destEmpty := false; - continue; - end; - end; - if DrawLayer(result, -ARect.Left, -ARect.Top, i, ASeparateXorMask, destEmpty) then - destEmpty := false; - inc(i); - end; - if result.XorMask <> nil then - AlphaFillInline(result.XorMask.Data, 0, result.XorMask.NbPixels); -end; - -procedure TBGRACustomLayeredBitmap.Draw(ACanvas: TCanvas; const Rect: TRect); -var temp: TBGRABitmap; -begin - if (Rect.Right <= Rect.Left) or (Rect.Bottom <= Rect.Top) then exit; - if (Rect.Right-Rect.Left = Width) and (Rect.Bottom-Rect.Top = Height) then - Draw(ACanvas, Rect.Left,Rect.Top) else - begin - temp := ComputeFlatImage; - BGRAReplace(temp,temp.Resample(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top)); - temp.Draw(ACanvas, Rect.Left,Rect.Top, False); - temp.Free; - end; -end; - -procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer); -begin - Draw(Canvas,x,y,0,NbLayers-1); -end; - -procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer; firstLayer, lastLayer: integer); -var temp: TBGRABitmap; -begin - temp := ComputeFlatImage(firstLayer,lastLayer); - temp.Draw(Canvas,x,y,False); - temp.Free; -end; - -procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer); -begin - Draw(Dest, x, y, 0, NbLayers-1); -end; - -procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer; - ASeparateXorMask: boolean; ADestinationEmpty: boolean); -begin - Draw(Dest, x, y, 0, NbLayers-1, ASeparateXorMask, ADestinationEmpty); -end; - -procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; AX, AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean); -var - temp: TBGRABitmap; - i,j: integer; - NewClipRect: TRect; -begin - NewClipRect := TRect.Intersect(rect(AX,AY,AX+Width,AY+Height), Dest.ClipRect); - if NewClipRect.IsEmpty then exit; - - for i := firstLayer to lastLayer do - if LayerVisible[i] and - (not (BlendOperation[i] in[boTransparent,boLinearBlend]) or - ( (SelectionLayerIndex = i) and SelectionVisible - and (SelectionDrawMode <> GetLayerDrawMode(i)) ) ) then - begin - temp := ComputeFlatImage(rect(NewClipRect.Left-AX,NewClipRect.Top-AY,NewClipRect.Right-AX,NewClipRect.Bottom-AY), ASeparateXorMask); - if ADestinationEmpty then - Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmSet) else - if self.LinearBlend then - Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmLinearBlend) - else Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmDrawWithTransparency); - temp.Free; - exit; - end; - - i := firstLayer; - while i <= lastLayer do - begin - if LayerFrozen[i] then - begin - j := GetLayerFrozenRange(i); - if j <> -1 then - begin - if ADestinationEmpty then - Dest.PutImage(AX, AY, FFrozenRange[j].image, dmSet) else - if not FFrozenRange[j].linearBlend then - Dest.PutImage(AX, AY, FFrozenRange[j].image, dmDrawWithTransparency) - else Dest.PutImage(AX, AY, FFrozenRange[j].image, dmLinearBlend); - i := FFrozenRange[j].lastLayer+1; - ADestinationEmpty := false; - continue; - end; - end; - if DrawLayer(Dest, AX,AY, i, ASeparateXorMask, ADestinationEmpty) then - ADestinationEmpty := false; - inc(i); - end; -end; - -function TBGRACustomLayeredBitmap.DrawLayer(Dest: TBGRABitmap; X, Y: Integer; - AIndex: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean): boolean; -type IntArray4 = array[1..4] of integer; - - function MergeSort(const ATab: IntArray4): IntArray4; - var - posA, posB, pos: Integer; - begin - posA := 1; - posB := 3; - pos := 1; - while (posA <= 2) and (posB <= 4) do - begin - if ATab[posA] <= ATab[posB] then - begin - result[pos] := ATab[posA]; - inc(posA); - end else - begin - result[pos] := ATab[posB]; - inc(posB); - end; - inc(pos); - end; - while posA <= 2 do - begin - result[pos] := ATab[posA]; - inc(posA); inc(pos); - end; - while posB <= 4 do - begin - result[pos] := ATab[posB]; - inc(posB); inc(pos); - end; - end; - -var - opacity: Byte; - - procedure Blend(ADestRect: TRect; AScan: IBGRAScanner; AScanOfsX, AScanOfsY: integer; ABlendOp: TBlendOperation); - begin - //XOR mask - if (ABlendOp = boXor) and ASeparateXorMask then - begin - Dest.NeedXorMask; - Dest.XorMask.BlendImageOver(ADestRect, AScan, AScanOfsX, AScanOfsY, ABlendOp, opacity, LinearBlend); - end else - //first layer is simply the background - if ADestinationEmpty and (ABlendOp <> boMask) then - begin - Dest.FillRect(ADestRect, AScan, dmSet, Point(AScanOfsX, AScanOfsY)); - Dest.ApplyGlobalOpacity(ADestRect, opacity); - end - else - Dest.BlendImageOver(ADestRect, AScan, AScanOfsX, AScanOfsY, ABlendOp, opacity, LinearBlend); - end; - -var - tempLayer: TBGRABitmap; - tempLayerScanOfs, selScanOfs: TPoint; - blendOp: TBlendOperation; - - procedure BlendBoth(ATile: TRect); - var - mergeBuf: PByte; - pTemp: PByte; - tempStride, rowSize, destStride: PtrInt; - tileWidth, yb: LongInt; - pDest: PByte; - begin - tileWidth := ATile.Width; - rowSize := tileWidth * sizeof(TBGRAPixel); - if not ADestinationEmpty then - getmem(mergeBuf, rowSize) - else mergeBuf := nil; - try - if tempLayer.LineOrder = riloTopToBottom then - tempStride := tempLayer.RowSize else tempStride := -tempLayer.RowSize; - pTemp := tempLayer.GetPixelAddress(ATile.Left + tempLayerScanOfs.X, - ATile.Top + tempLayerScanOfs.Y); - pDest := Dest.GetPixelAddress(ATile.Left, ATile.Top); - if Dest.LineOrder = riloTopToBottom then - destStride := Dest.RowSize else destStride := -Dest.RowSize; - if ADestinationEmpty then - begin - for yb := ATile.Top to ATile.Bottom-1 do - begin - move(pTemp^, pDest^, rowSize); - SelectionScanner.ScanMoveTo(ATile.Left + selScanOfs.X, yb + selScanOfs.Y); - ScannerPutPixels(SelectionScanner, PBGRAPixel(pDest), tileWidth, SelectionDrawMode); - inc(pTemp, tempStride); - inc(pDest, destStride); - end; - Dest.ApplyGlobalOpacity(ATile, opacity); - end else - begin - for yb := ATile.Top to ATile.Bottom-1 do - begin - move(pTemp^, mergeBuf^, rowSize); - SelectionScanner.ScanMoveTo(ATile.Left + selScanOfs.X, yb + selScanOfs.Y); - ScannerPutPixels(SelectionScanner, PBGRAPixel(mergeBuf), tileWidth, SelectionDrawMode); - BlendPixelsOver(PBGRAPixel(pDest), PBGRAPixel(mergeBuf), - blendOp, tileWidth, opacity, LinearBlend); - inc(pTemp, tempStride); - inc(pDest, destStride); - end; - end; - finally - freemem(mergeBuf); - end; - end; - -var - mustFreeCopy, containsSel, containsLayer: Boolean; - ofs: TPoint; - rSel, oldClip, rLayer, rTile: TRect; - xTab,yTab: IntArray4; - xb, yb: Integer; -begin - if not LayerVisible[AIndex] then exit(false); - opacity := LayerOpacity[AIndex]; - if opacity = 0 then exit(false); - - tempLayer := GetLayerBitmapDirectly(AIndex); - if tempLayer <> nil then mustFreeCopy := false else - begin - mustFreeCopy := true; - tempLayer := GetLayerBitmapCopy(AIndex); - end; - - ofs := LayerOffset[AIndex]; - oldClip := Dest.IntersectClip(rect(X,Y,X+self.Width,Y+self.Height)); - - if (SelectionLayerIndex = AIndex) and SelectionVisible then - begin - rSel := SelectionRect; - rSel.Offset(X, Y); - rSel.Intersect(Dest.ClipRect); - end else - rSel := EmptyRect; - - if Assigned(tempLayer) then - begin - rLayer := RectWithSize(ofs.x + X, ofs.y + Y, tempLayer.Width, tempLayer.Height); - rLayer.Intersect(Dest.ClipRect); - end else - rLayer := EmptyRect; - - if (tempLayer <> nil) and (not rLayer.IsEmpty or not rSel.IsEmpty) then - begin - if AIndex = 0 then blendOp := boTransparent else blendOp := BlendOperation[AIndex]; - tempLayerScanOfs := Point(-(ofs.X+X), -(ofs.Y+Y)); - - if rSel.IsEmpty then - Blend(rLayer, tempLayer, tempLayerScanOfs.X, tempLayerScanOfs.y, blendOp) - else - begin - selScanOfs := Point(SelectionScannerOffset.X - X, SelectionScannerOffset.Y - Y); - - xTab[1] := rSel.Left; yTab[1] := rSel.Top; - xTab[2] := rSel.Right; yTab[2] := rSel.Bottom; - xTab[3] := rLayer.Left; yTab[3] := rLayer.Top; - xTab[4] := rLayer.Right; yTab[4] := rLayer.Bottom; - xTab := MergeSort(xTab); yTab := MergeSort(yTab); - - for yb := 1 to 3 do - begin - rTile.Top := yTab[yb]; - rTile.Bottom := yTab[yb+1]; - if rTile.Bottom > rTile.Top then - for xb := 1 to 3 do - begin - rTile.Left := xTab[xb]; - rTile.Right := xTab[xb+1]; - if rTile.Right > rTile.Left then - begin - containsSel := rTile.IntersectsWith(rSel); - containsLayer := rTile.IntersectsWith(rLayer); - if containsLayer then - begin - if not containsSel then - Blend(rTile, tempLayer, tempLayerScanOfs.X, tempLayerScanOfs.y, blendOp) - else - BlendBoth(rTile); - end else - if containsSel then - Blend(rTile, SelectionScanner, selScanOfs.X, selScanOfs.Y, blendOp) - end; - end; - end; - end; - - result := true; - end else - result := false; - - Dest.ClipRect := oldClip; - if mustFreeCopy then tempLayer.Free; -end; - -procedure TBGRACustomLayeredBitmap.FreezeExceptOneLayer(layer: integer); -begin - if (layer < 0) or (layer >= NbLayers) then - begin - Freeze; - exit; - end; - Unfreeze(layer,layer); - if layer > 1 then - Freeze(0,layer-1); - if layer < NbLayers-2 then - Freeze(layer+1,NbLayers-1); -end; - -procedure TBGRACustomLayeredBitmap.Freeze(firstLayer, lastLayer: integer); - - procedure DoFreeze(first,last: integer; linear: boolean); - var i,nbVisible: integer; - computedImage: TBGRABitmap; - begin - if last <= first then exit; //at least 2 frozen layers - nbVisible := 0; - for i := first to last do - if LayerVisible[i] and (LayerOpacity[i] > 0) then inc(nbVisible); - if nbvisible < 2 then exit; //at least 2 frozen layers - - if ContainsFrozenRange(first,last) then exit; //already frozen - Unfreeze(first,last); - - computedImage := ComputeFlatImage(first,last); //must compute before layers are considered as frozen - setlength(FFrozenRange, length(FFrozenRange)+1); - with FFrozenRange[high(FFrozenRange)] do - begin - firstLayer := first; - lastLayer:= last; - image := computedImage; - linearBlend := linear; - end; - for i := first to last do - SetLayerFrozen(i,True); - end; - -var j: integer; - start: integer; - linear,nextLinear: boolean; -begin - start := -1; - linear := false; //to avoid hint - for j := firstlayer to lastLayer do - if ((BlendOperation[j] in [boTransparent,boLinearBlend]) or (start = 0) or ((firstlayer= 0) and (j=0))) - and (not SelectionVisible or (j <> SelectionLayerIndex)) then - begin - nextLinear := (BlendOperation[j] = boLinearBlend) or self.LinearBlend; - if start = -1 then - begin - start := j; - linear := nextLinear; - end else - begin - if linear <> nextLinear then - begin - DoFreeze(start,j-1,linear); - start := j; - linear := nextLinear; - end; - end; - end else - begin - if start <> -1 then - begin - DoFreeze(start,j-1,linear); - start := -1; - end; - end; - if start <> -1 then - DoFreeze(start,lastLayer,linear); -end; - -procedure TBGRACustomLayeredBitmap.Freeze; -begin - Freeze(0,NbLayers-1); -end; - -procedure TBGRACustomLayeredBitmap.Unfreeze; -begin - Unfreeze(0,NbLayers-1); -end; - -procedure TBGRACustomLayeredBitmap.Unfreeze(layer: integer); -begin - Unfreeze(layer,layer); -end; - -procedure TBGRACustomLayeredBitmap.Unfreeze(firstLayer, lastLayer: integer); -var i: integer; -begin - for i := high(FFrozenRange) downto 0 do - if RangeIntersect(firstLayer,lastLayer,FFrozenRange[i].firstLayer,FFrozenRange[i].lastLayer) then - RemoveFrozenRange(i); -end; - -procedure TBGRACustomLayeredBitmap.NotifyLoaded; -begin - //nothing -end; - -procedure TBGRACustomLayeredBitmap.NotifySaving; -begin - //nothing -end; - -procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass); -begin - setlength(LayeredBitmapReaders,length(LayeredBitmapReaders)+1); - with LayeredBitmapReaders[high(LayeredBitmapReaders)] do - begin - extension:= UTF8LowerCase(AExtensionUTF8); - theClass := AReader; - end; -end; - -function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap; -var - i: Integer; -begin - AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8); - if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then - AExtensionUTF8:= '.'+AExtensionUTF8; - for i := 0 to high(LayeredBitmapWriters) do - if '.'+LayeredBitmapWriters[i].extension = AExtensionUTF8 then - begin - result := LayeredBitmapWriters[i].theClass.Create; - exit; - end; - result := nil; -end; - -function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap; -var - i: Integer; -begin - AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8); - if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then - AExtensionUTF8:= '.'+AExtensionUTF8; - for i := 0 to high(LayeredBitmapReaders) do - if '.'+LayeredBitmapReaders[i].extension = AExtensionUTF8 then - begin - result := LayeredBitmapReaders[i].theClass.Create; - exit; - end; - result := nil; -end; - -procedure OnLayeredBitmapLoadFromStreamStart; -begin - OnLayeredBitmapLoadStart(''); -end; - -procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string); -var i: Integer; -begin - with LayeredBitmapLoadEvents do if Assigned(OnStart) then - for i := 0 to OnStart.Count-1 do OnStart[i](AFilenameUTF8); -end; - -procedure OnLayeredBitmapLoadProgress(APercentage: integer); -var i: Integer; -begin - with LayeredBitmapLoadEvents do if Assigned(OnProgress) then - for i := 0 to OnProgress.Count-1 do OnProgress[i](APercentage); -end; - -procedure OnLayeredBitmapLoaded; -var i: Integer; -begin - with LayeredBitmapLoadEvents do if Assigned(OnDone) then - for i := 0 to OnDone.Count-1 do OnDone[i]; -end; - -procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; - AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc); -begin - with LayeredBitmapLoadEvents do begin - if (AStart <> nil) and ((OnStart = nil) or (OnStart.IndexOf(AStart) = -1)) then - begin - if OnStart = nil then OnStart := TOnLayeredBitmapLoadStartProcList.Create; - OnStart.Add(AStart); - end; - if (AProgress <> nil) and ((OnProgress = nil) or (OnProgress.IndexOf(AProgress) = -1)) then - begin - if OnProgress = nil then OnProgress := TOnLayeredBitmapLoadProgressProcList.Create; - OnProgress.Add(AProgress); - end; - if (ADone <> nil) and ((OnDone = nil) or (OnDone.IndexOf(ADone) = -1)) then - begin - if OnDone = nil then OnDone := TOnLayeredBitmapLoadedProcList.Create; - OnDone.Add(ADone); - end; - end; -end; - -procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; - AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc); -begin - with LayeredBitmapLoadEvents do begin - if Assigned(OnStart) then OnStart.Remove(AStart); - if Assigned(OnProgress) then OnProgress.Remove(AProgress); - if Assigned(OnDone) then OnDone.Remove(ADone); - end; -end; - -procedure OnLayeredBitmapSaveToStreamStart; -begin - OnLayeredBitmapSaveStart(''); -end; - -procedure OnLayeredBitmapSaveStart(AFilenameUTF8: string); -var i: Integer; -begin - with LayeredBitmapSaveEvents do if Assigned(OnStart) then - for i := 0 to OnStart.Count-1 do OnStart[i](AFilenameUTF8); -end; - -procedure OnLayeredBitmapSaveProgress(APercentage: integer); -var i: Integer; -begin - with LayeredBitmapSaveEvents do if Assigned(OnProgress) then - for i := 0 to OnProgress.Count-1 do OnProgress[i](APercentage); -end; - -procedure OnLayeredBitmapSaved; -var i: Integer; -begin - with LayeredBitmapSaveEvents do if Assigned(OnDone) then - for i := 0 to OnDone.Count-1 do OnDone[i]; -end; - -procedure RegisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; - AProgress: TOnLayeredBitmapSaveProgressProc; ADone: TOnLayeredBitmapSavedProc); -begin - with LayeredBitmapSaveEvents do begin - if (AStart <> nil) and ((OnStart = nil) or (OnStart.IndexOf(AStart) = -1)) then - begin - if OnStart = nil then OnStart := TOnLayeredBitmapSaveStartProcList.Create; - OnStart.Add(AStart); - end; - if (AProgress <> nil) and ((OnProgress = nil) or (OnProgress.IndexOf(AProgress) = -1)) then - begin - if OnProgress = nil then OnProgress := TOnLayeredBitmapSaveProgressProcList.Create; - OnProgress.Add(AProgress); - end; - if (ADone <> nil) and ((OnDone = nil) or (OnDone.IndexOf(ADone) = -1)) then - begin - if OnDone = nil then OnDone := TOnLayeredBitmapSavedProcList.Create; - OnDone.Add(ADone); - end; - end; -end; - -procedure UnregisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; - AProgress: TOnLayeredBitmapSaveProgressProc; ADone: TOnLayeredBitmapSavedProc); -begin - with LayeredBitmapSaveEvents do begin - if Assigned(OnStart) then OnStart.Remove(AStart); - if Assigned(OnProgress) then OnProgress.Remove(AProgress); - if Assigned(OnDone) then OnDone.Remove(ADone); - end; -end; - -procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass); -begin - while (length(AExtensionUTF8)>0) and (AExtensionUTF8[1]='.') do delete(AExtensionUTF8,1,1); - setlength(LayeredBitmapWriters,length(LayeredBitmapWriters)+1); - with LayeredBitmapWriters[high(LayeredBitmapWriters)] do - begin - extension:= UTF8LowerCase(AExtensionUTF8); - theClass := AWriter; - end; -end; - -initialization - - NextLayerUniqueId := 1; - -finalization - - with LayeredBitmapLoadEvents do begin - OnStart.Free; - OnProgress.Free; - OnDone.Free; - end; - with LayeredBitmapSaveEvents do begin - OnStart.Free; - OnProgress.Free; - OnDone.Free; - end; - -end. - diff --git a/components/bgrabitmap/bgralazpaint.pas b/components/bgrabitmap/bgralazpaint.pas deleted file mode 100644 index ac99c45..0000000 --- a/components/bgrabitmap/bgralazpaint.pas +++ /dev/null @@ -1,264 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRALazPaint; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRALayers, BGRABitmapTypes, BGRAReadLzp, BGRAWriteLzp, - BGRALzpCommon, FPimage; - -type - TLzpCompression = BGRALzpCommon.TLzpCompression; - - { TBGRALazPaintImage } - - TBGRALazPaintImage = class(TBGRALayeredBitmap) - private - FSelectedLayerIndex: integer; - protected - procedure InternalLoadFromStream(AStream: TStream); - procedure InternalSaveToStream(AStream: TStream); - public - constructor Create; overload; override; - constructor Create(AWidth, AHeight: integer); overload; override; - procedure LoadFromStream(AStream: TStream); override; - procedure LoadFromFile(const filenameUTF8: string); override; - procedure SaveToStream(AStream: TStream); override; - procedure SaveToFile(const filenameUTF8: string); override; - property SelectedLayerIndex: integer read FSelectedLayerIndex write FSelectedLayerIndex; - end; - - { TBGRAWriterLazPaintWithLayers } - - TBGRAWriterLazPaintWithLayers = class(TBGRAWriterLazPaint) - protected - FLayers: TBGRALayeredBitmap; - FSelectedLayerIndex: integer; - FCompression: TLzpCompression; - function GetNbLayers: integer; override; - function InternalWriteLayers(Str: TStream; {%H-}Img: TFPCustomImage): boolean; override; - public - constructor Create(ALayers: TBGRALayeredBitmap); overload; - property SelectedLayerIndex: integer read FSelectedLayerIndex write FSelectedLayerIndex; - property Compression: TLzpCompression read FCompression write FCompression; - end; - - { TBGRAReaderLazPaintWithLayers } - - TBGRAReaderLazPaintWithLayers = class(TBGRAReaderLazPaint) - protected - FLayers: TBGRALayeredBitmap; - FLayersLoaded: boolean; - FSelectedLayerIndex: integer; - procedure InternalReadLayers(str: TStream; {%H-}Img: TFPCustomImage); override; - public - constructor Create(ALayers: TBGRALayeredBitmap); overload; - property LayersLoaded: boolean read FLayersLoaded; - property SelectedLayerIndex: integer read FSelectedLayerIndex; - end; - -procedure RegisterLazPaintFormat; - -implementation - -uses BGRAStreamLayers, BGRABitmap, BGRAUTF8; - -{ TBGRALazPaintImage } - -constructor TBGRALazPaintImage.Create; -begin - inherited Create; - RegisterLazPaintFormat; - FSelectedLayerIndex:= 0; -end; - -constructor TBGRALazPaintImage.Create(AWidth, AHeight: integer); -begin - inherited Create(AWidth, AHeight); - RegisterLazPaintFormat; - FSelectedLayerIndex:= 0; -end; - -procedure TBGRALazPaintImage.LoadFromStream(AStream: TStream); -begin - OnLayeredBitmapLoadFromStreamStart; - try - InternalLoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - end; -end; - -procedure TBGRALazPaintImage.InternalLoadFromStream(AStream: TStream); -var - {%H-}header: TLazPaintImageHeader; - bmp: TBGRACustomBitmap; - reader: TBGRAReaderLazPaintWithLayers; -begin - AStream.ReadBuffer({%H-}header, sizeof(header)); - LazPaintImageHeader_SwapEndianIfNeeded(header); - AStream.Position:= AStream.Position-sizeof(header); - - //use shortcut if possible - if (header.magic = LAZPAINT_MAGIC_HEADER) and (header.zero1 = 0) - and (header.layersOffset >= sizeof(header)) then - begin - AStream.Position:= AStream.Position+header.layersOffset; - LoadLayersFromStream(AStream, FSelectedLayerIndex, false, self, True); - end else - begin - reader := TBGRAReaderLazPaintWithLayers.Create(self); - try - bmp := BGRABitmapFactory.Create; - bmp.LoadFromStream(AStream, reader); - if reader.LayersLoaded then - begin - bmp.Free; - end else - begin - Clear; - SetSize(bmp.Width,bmp.Height); - AddOwnedLayer(bmp as TBGRABitmap); - LayerName[0] := reader.Caption; - end; - SelectedLayerIndex:= reader.SelectedLayerIndex; - finally - reader.Free; - end; - end; -end; - -procedure TBGRALazPaintImage.LoadFromFile(const filenameUTF8: string); -var AStream: TFileStreamUTF8; -begin - AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); - OnLayeredBitmapLoadStart(filenameUTF8); - try - LoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - AStream.Free; - end; -end; - -procedure TBGRALazPaintImage.SaveToFile(const filenameUTF8: string); -var AStream: TFileStreamUTF8; -begin - AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate or fmShareDenyWrite); - OnLayeredBitmapSaveStart(filenameUTF8); - try - InternalSaveToStream(AStream); - finally - OnLayeredBitmapSaved; - AStream.Free; - end; -end; - -procedure TBGRALazPaintImage.SaveToStream(AStream: TStream); -begin - OnLayeredBitmapSaveToStreamStart; - try - InternalSaveToStream(AStream); - finally - OnLayeredBitmapSaved; - end; -end; - -procedure TBGRALazPaintImage.InternalSaveToStream(AStream: TStream); -var - writer: TBGRAWriterLazPaint; - flat: TBGRACustomBitmap; -begin - if NbLayers = 0 then - raise exception.Create('File cannot be empty'); - - writer := nil; - flat := nil; - try - if (NbLayers > 1) or (LayerOpacity[0] <> 255) or not LayerVisible[0] or (BlendOperation[0]<>boTransparent) - or (OriginalCount <> 0) then - begin - writer := TBGRAWriterLazPaintWithLayers.Create(self); - writer.Caption := 'Preview'; - TBGRAWriterLazPaintWithLayers(writer).SelectedLayerIndex := self.SelectedLayerIndex; - end else - begin - writer := TBGRAWriterLazPaint.Create; - writer.Caption := LayerName[0]; - end; - - writer.IncludeThumbnail:= true; - flat := ComputeFlatImage; - flat.SaveToStream(AStream, writer); - finally - writer.Free; - flat.Free; - end; -end; - -{ TBGRAReaderLazPaintWithLayers } - -procedure TBGRAReaderLazPaintWithLayers.InternalReadLayers(str: TStream; - Img: TFPCustomImage); -begin - if Assigned(FLayers) then - begin - if CheckStreamForLayers(str) then - begin - LoadLayersFromStream(str, FSelectedLayerIndex, false, FLayers, True); - FLayersLoaded := true; - end; - end; -end; - -constructor TBGRAReaderLazPaintWithLayers.Create(ALayers: TBGRALayeredBitmap); -begin - FLayersLoaded := false; - FLayers := ALayers; - FSelectedLayerIndex:= -1; -end; - -{ TBGRAWriterLazPaintWithLayers } - -function TBGRAWriterLazPaintWithLayers.GetNbLayers: integer; -begin - if Assigned(FLayers) then - Result:= FLayers.NbLayers - else - Result := 1; -end; - -function TBGRAWriterLazPaintWithLayers.InternalWriteLayers(Str: TStream; - Img: TFPCustomImage): boolean; -begin - If Assigned(FLayers) then - begin - SaveLayersToStream(str, FLayers, FSelectedLayerIndex, FCompression, True); - Result:=true; - end - else result := False; -end; - -constructor TBGRAWriterLazPaintWithLayers.Create(ALayers: TBGRALayeredBitmap); -begin - inherited Create; - FLayers := ALayers; - FSelectedLayerIndex:= 0; - FCompression:= lzpRLE; - IncludeThumbnail:= true; -end; - -var AlreadyRegistered: boolean; - -procedure RegisterLazPaintFormat; -begin - if AlreadyRegistered then exit; - RegisterLayeredBitmapReader('lzp', TBGRALazPaintImage); - RegisterLayeredBitmapWriter('lzp', TBGRALazPaintImage); - AlreadyRegistered:= True; -end; - -end. - diff --git a/components/bgrabitmap/bgralazresource.pas b/components/bgrabitmap/bgralazresource.pas deleted file mode 100644 index c552b33..0000000 --- a/components/bgrabitmap/bgralazresource.pas +++ /dev/null @@ -1,416 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRALazResource; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAMultiFileType; - -type - { TLazResourceEntry } - - TLazResourceEntry = class(TMultiFileEntry) - private - procedure Serialize(ADestination: TStream); - protected - FName: utf8string; - FValueType: utf8string; - FContent: TStream; - function GetName: utf8string; override; - procedure SetName(AValue: utf8string); override; - function GetExtension: utf8string; override; - function GetFileSize: int64; override; - public - constructor Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string; AContent: TStream); - destructor Destroy; override; - function CopyTo(ADestination: TStream): int64; override; - function GetStream: TStream; override; - end; - - { TFormDataEntry } - - TFormDataEntry = class(TLazResourceEntry) - protected - FTextContent: TStream; - procedure RequireTextContent; - function GetExtension: utf8string; override; - function GetFileSize: int64; override; - public - constructor Create(AContainer: TMultiFileContainer; AName: utf8string; ABinaryContent: TStream); - destructor Destroy; override; - function CopyTo(ADestination: TStream): int64; override; - end; - - { TLazResourceContainer } - - TLazResourceContainer = class(TMultiFileContainer) - protected - function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override; - public - procedure LoadFromStream(AStream: TStream); override; - procedure SaveToStream(ADestination: TStream); override; - end; - -implementation - -uses LResources, BGRAUTF8; - -{ TFormDataEntry } - -procedure TFormDataEntry.RequireTextContent; -begin - if FTextContent = nil then - begin - FTextContent:= TMemoryStream.Create; - FContent.Position:= 0; - LRSObjectBinaryToText(FContent, FTextContent); - end; -end; - -function TFormDataEntry.GetExtension: utf8string; -begin - Result:= 'lfm'; -end; - -function TFormDataEntry.GetFileSize: int64; -begin - RequireTextContent; - Result:= FTextContent.Size; -end; - -constructor TFormDataEntry.Create(AContainer: TMultiFileContainer; - AName: utf8string; ABinaryContent: TStream); -begin - inherited Create(AContainer,AName,'FORMDATA',ABinaryContent); -end; - -destructor TFormDataEntry.Destroy; -begin - FreeAndNil(FTextContent); - inherited Destroy; -end; - -function TFormDataEntry.CopyTo(ADestination: TStream): int64; -begin - RequireTextContent; - if FTextContent.Size = 0 then - result := 0 - else - begin - FTextContent.Position:= 0; - result := ADestination.CopyFrom(FTextContent,FTextContent.Size); - end; -end; - -{ TLazResourceEntry } - -procedure TLazResourceEntry.Serialize(ADestination: TStream); -begin - FContent.Position := 0; - BinaryToLazarusResourceCode(FContent, ADestination, Name, FValueType); -end; - -function TLazResourceEntry.GetName: utf8string; -begin - Result:= FName; -end; - -procedure TLazResourceEntry.SetName(AValue: utf8string); -begin - if AValue = FName then exit; - if Container.IndexOf(AVAlue, Extension) <> -1 then - raise Exception.Create('Name is already used for this extension'); - FName := AValue; -end; - -function TLazResourceEntry.GetExtension: utf8string; -begin - Result:= FValueType; -end; - -function TLazResourceEntry.GetFileSize: int64; -begin - Result:= FContent.Size; -end; - -destructor TLazResourceEntry.Destroy; -begin - FreeAndNil(FContent); - inherited Destroy; -end; - -constructor TLazResourceEntry.Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string; - AContent: TStream); -begin - inherited Create(AContainer); - FName := AName; - FValueType := UTF8UpperCase(AValueType); - FContent := AContent; -end; - -function TLazResourceEntry.CopyTo(ADestination: TStream): int64; -begin - if FContent.Size = 0 then - result := 0 - else - begin - FContent.Position:= 0; - result := ADestination.CopyFrom(FContent, FContent.Size); - end; -end; - -function TLazResourceEntry.GetStream: TStream; -begin - Result:= FContent; -end; - -{ TLazResourceContainer } - -procedure TLazResourceContainer.LoadFromStream(AStream: TStream); -const - entryStart = 'LazarusResources.Add('; - entryEnd = ');'; - whiteSpace = [' ',#9,#10,#13,#26]; -var - fileContent: String; - filePos : integer; - - procedure SkipWhitespace; - begin - while (filePos <= length(fileContent)) and (fileContent[filePos] in whiteSpace) do inc(filePos); - end; - - procedure SkipComma; - begin - SkipWhitespace; - if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then - inc(filePos) - else - raise Exception.Create('Comma expected'); - end; - - function ParseString(ignoreCommas: boolean): TStream; - var - expectPlus: boolean; - - procedure AppendChar(c: char); - begin - result.WriteByte(ord(c)); - end; - - function ParseNumber: integer; - var numberStart, errPos: integer; - s: String; - begin - numberStart:= filePos; - if (filePos <= length(fileContent)) and (fileContent[filePos] = '$') then - begin - inc(filePos); - while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9','a'..'f','A'..'F']) do inc(filePos); - end else - begin - while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9']) do inc(filePos); - end; - s := copy(fileContent,numberStart,filePos-numberStart); - val(s, result, errPos); - if errPos <> 0 then - raise exception.Create('Invalid number "' + s + '"'); - end; - - function ParseStringPart: boolean; - var charCode: integer; - begin - SkipWhitespace; - if filePos <= length(fileContent) then - begin - if expectPlus then - if fileContent[filePos] <> '+' then - begin - result := false; - expectPlus := false; - exit; - end else - inc(filePos); - - case fileContent[filePos] of - '+': raise exception.Create('Unexpected "+"'); - '''': begin - inc(filePos); - while (filePos <= length(fileContent)) do - begin - if fileContent[filePos] = '''' then - begin - inc(filePos); - if (filePos <= length(fileContent)) and (fileContent[filePos] = '''') then - begin - AppendChar(''''); - inc(filePos); - end - else break; - end else - if fileContent[filePos] in[#10,#13] then - raise Exception.Create('Unexpected end of line') - else - begin - AppendChar(fileContent[filePos]); - inc(filePos); - end; - end; - if (filePos <= length(fileContent)) and (fileContent[filePos] = '#') then - expectPlus := false - else - expectPlus := true; - result := true; - end; - '#': begin - inc(filePos); - charCode := ParseNumber; - if (charCode < 0) or (charCode > 255) then - raise exception.Create('Character code out of bounds'); - AppendChar(chr(charCode)); - if (filePos <= length(fileContent)) and (fileContent[filePos] in['#','''']) then - expectPlus := false - else - expectPlus := true; - result := true; - end; - else - begin - result := false; - expectPlus := false; - end; - end; - end - else - begin - result := false; - expectPlus := false; - end; - end; - - begin - result := TMemoryStream.Create; - expectPlus := false; - if not ParseStringPart then raise exception.Create('Expecting string'); - repeat - if ignoreCommas then - begin - SkipWhitespace; - if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then - begin - inc(filePos); - expectPlus := false; - end; - end; - until not ParseStringPart; - end; - - procedure ReadContent; - var - bytesRead: integer; - begin - setlength(fileContent,AStream.Size-AStream.Position); - bytesRead := AStream.Read(fileContent[1],length(fileContent)); - setlength(fileContent, bytesRead); - filePos := 1; - end; - - function StreamToUTF8String(AStream: TStream): utf8String; - begin - setlength(result, AStream.Size); - AStream.Position := 0; - AStream.Read(result[1], length(result)); - AStream.Free; - end; - -var - entryName: utf8string; - entryType: utf8string; - entryContent: TStream; - inArray: boolean; - -begin - Clear; - ReadContent; - while filePos <= length(fileContent) do - begin - if (upcase(fileContent[filePos]) = upcase(entryStart[1])) and - (CompareText(copy(fileContent,filePos,length(entryStart)),entryStart)=0) then - begin - inc(filePos, length(entryStart)); - entryName := StreamToUTF8String(ParseString(false)); - SkipComma; - entryType := StreamToUTF8String(ParseString(false)); - SkipComma; - - SkipWhitespace; - if (filePos <= length(fileContent)) and (fileContent[filePos] = '[') then - begin - inArray := true; - inc(filePos); - end else - inArray := false; - entryContent := ParseString(inArray); - SkipWhitespace; - if inArray then - begin - if (filePos <= length(fileContent)) and (fileContent[filePos] = ']') then - inc(filePos) - else - raise exception.Create('Expecting "]"'); - end; - - if entryType = 'FORMDATA' then - AddEntry(TFormDataEntry.Create(self,entryName,entryContent)) - else - AddEntry(TLazResourceEntry.Create(self,entryName,entryType,entryContent)); - - if (filePos+length(entryEnd)-1 <= length(fileContent)) and (CompareText(copy(fileContent,filePos,length(entryEnd)),entryEnd)=0) then - inc(filePos,length(entryEnd)) - else - raise exception.Create('Expecting "'+entryEnd+'"'); - end else - if fileContent[filePos] in whiteSpace then - inc(filePos) - else - raise exception.Create('Unexpected character "'+fileContent[filePos]+'"'); - end; -end; - -function TLazResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string; - AContent: TStream): TMultiFileEntry; -var - binContent: TMemoryStream; -begin - if UTF8CompareText(AExtension,'lfm')=0 then - begin - binContent := TMemoryStream.Create; - try - AContent.Position:= 0; - LRSObjectTextToBinary(AContent, binContent); - result := TFormDataEntry.Create(self,AName,binContent); - except - on ex:Exception do - begin - binContent.Free; - result := nil; - end; - end; - AContent.Free; - end - else - result := TLazResourceEntry.Create(self,AName,UTF8UpperCase(AExtension),AContent); -end; - -procedure TLazResourceContainer.SaveToStream(ADestination: TStream); -var - i: Integer; -begin - for i := 0 to Count-1 do - TLazResourceEntry(Entry[i]).Serialize(ADestination); -end; - -end. - diff --git a/components/bgrabitmap/bgralclbitmap.pas b/components/bgrabitmap/bgralclbitmap.pas deleted file mode 100644 index 2f8b909..0000000 --- a/components/bgrabitmap/bgralclbitmap.pas +++ /dev/null @@ -1,997 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRALCLBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, Graphics, GraphType, BGRABitmapTypes, BGRADefaultBitmap; - -type - { TBGRALCLBitmap } - - TBGRALCLBitmap = class(TBGRADefaultBitmap) - protected - function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; - AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; override; - function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; - procedure DoLoadFromBitmap; override; - procedure RebuildBitmap; override; - function CreatePtrBitmap(AWidth, AHeight: integer; AData: PBGRAPixel - ): TBGRAPtrBitmap; override; - procedure AssignRasterImage(ARaster: TRasterImage); virtual; - procedure ExtractXorMask; - public - procedure Assign(Source: TPersistent); override; - procedure LoadFromResource(AFilename: string; AOptions: TBGRALoadingOptions); overload; override; - procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; - procedure LoadFromDevice({%H-}DC: HDC); override; - procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; - procedure TakeScreenshotOfPrimaryMonitor; override; - procedure TakeScreenshot({%H-}ARect: TRect); override; - end; - - { TBGRALCLPtrBitmap } - - TBGRALCLPtrBitmap = class(TBGRAPtrBitmap) - - procedure RebuildBitmap; override; - function CreatePtrBitmap(AWidth, AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; override; - function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; - function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte; - AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean - =True): boolean; override; - public - procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; - procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - end; - -type - - { TBitmapTracker } - - TBitmapTracker = class(TBitmap) - protected - FUser: TBGRADefaultBitmap; - procedure Changed(Sender: TObject); override; - public - constructor Create(AUser: TBGRADefaultBitmap); overload; - end; - -implementation - -uses BGRAText, LCLType, LCLIntf, FPimage; - -{ TBitmapTracker } - -constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap); -begin - FUser := AUser; - inherited Create; -end; - -procedure TBitmapTracker.Changed(Sender: TObject); -begin - if FUser <> nil then - FUser.NotifyBitmapChange; - inherited Changed(Sender); -end; - -type - TCopyPixelProc = procedure (psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); - -procedure ApplyMask1bit(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); -var currentBit: byte; -begin - currentBit := 1; - while count > 0 do - begin - if psrc^ and currentBit <> 0 then pdest^.alpha := 0; - inc(pdest); - if currentBit = 128 then - begin - currentBit := 1; - inc(psrc); - end else - currentBit := currentBit shl 1; - dec(count); - end; -end; - -procedure ApplyMask1bitRev(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); -var currentBit: byte; -begin - currentBit := 128; - while count > 0 do - begin - if psrc^ and currentBit <> 0 then pdest^.alpha := 0; - inc(pdest); - if currentBit = 1 then - begin - currentBit := 128; - inc(psrc); - end else - currentBit := currentBit shr 1; - dec(count); - end; -end; - -procedure CopyFromBW_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; defaultOpacity: byte); -var currentBit: byte; -begin - currentBit := 1; - while count > 0 do - begin - if psrc^ and currentBit <> 0 then - pdest^ := BGRAWhite - else - pdest^ := BGRABlack; - pdest^.alpha := DefaultOpacity; - inc(pdest); - if currentBit = 128 then - begin - currentBit := 1; - inc(psrc); - end else - currentBit := currentBit shl 1; - dec(count); - end; -end; - -procedure CopyFromBW_SetAlphaBitRev(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; defaultOpacity: byte); -var currentBit: byte; -begin - currentBit := 128; - while count > 0 do - begin - if psrc^ and currentBit <> 0 then - pdest^ := BGRAWhite - else - pdest^ := BGRABlack; - pdest^.alpha := DefaultOpacity; - inc(pdest); - if currentBit = 1 then - begin - currentBit := 128; - inc(psrc); - end else - currentBit := currentBit shr 1; - dec(count); - end; -end; - -procedure CopyFrom24Bit(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -begin - while count > 0 do - begin - PWord(pdest)^ := PWord(psrc)^; - (PByte(pdest)+2)^ := (psrc+2)^; - pdest^.alpha := DefaultOpacity; - inc(psrc,sourcePixelSize); - inc(pdest); - dec(count); - end; -end; - -procedure CopyFrom24Bit_SwapRedBlue(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -begin - while count > 0 do - begin - PByte(pdest)^ := (psrc+2)^; - (PByte(pdest)+1)^ := (psrc+1)^; - (PByte(pdest)+2)^ := psrc^; - pdest^.alpha := DefaultOpacity; - inc(psrc,sourcePixelSize); - inc(pdest); - dec(count); - end; -end; - -procedure CopyFromARGB_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); -begin - while count > 0 do - begin - PLongWord(pdest)^ := ((PByte(psrc)+3)^ shl TBGRAPixel_BlueShift) or - ((PByte(psrc)+2)^ shl TBGRAPixel_GreenShift) or - ((PByte(psrc)+1)^ shl TBGRAPixel_RedShift) or - (PByte(psrc)^ shl TBGRAPixel_AlphaShift); - dec(count); - inc(pdest); - inc(psrc, sourcePixelSize); - end; -end; - -procedure CopyFromARGB_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -begin - while count > 0 do - begin - PLongWord(pdest)^ := ((PByte(psrc)+3)^ shl TBGRAPixel_BlueShift) or - ((PByte(psrc)+2)^ shl TBGRAPixel_GreenShift) or - ((PByte(psrc)+1)^ shl TBGRAPixel_RedShift) or - (DefaultOpacity shl TBGRAPixel_AlphaShift); - inc(psrc, sourcePixelSize); - inc(pdest); - dec(count); - end; -end; - -procedure CopyFromARGB_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -const ARGB_ColorMask = {$IFDEF ENDIAN_LITTLE}$FFFFFF00{$ELSE}$00FFFFFF{$ENDIF}; - ARGB_RedShift = {$IFDEF ENDIAN_LITTLE}8{$ELSE}16{$ENDIF}; - ARGB_GreenShift = {$IFDEF ENDIAN_LITTLE}16{$ELSE}8{$ENDIF}; - ARGB_BlueShift = {$IFDEF ENDIAN_LITTLE}24{$ELSE}0{$ENDIF}; -var - sourceval: UInt32or64; - alphaValue: UInt32or64; - OpacityOrMask: UInt32or64; -begin - OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; - while count > 0 do - begin - sourceval := plongword(psrc)^; - alphaValue := {$IFDEF ENDIAN_LITTLE}sourceval and $ff{$ELSE}sourceval shr 24{$ENDIF}; - if (alphaValue = 0) and ((sourceval and ARGB_ColorMask) <> 0) then //if not black but transparent - begin - PLongWord(pdest)^ := (((sourceval shr ARGB_BlueShift) and $ff) shl TBGRAPixel_BlueShift) or - (((sourceval shr ARGB_GreenShift) and $ff) shl TBGRAPixel_GreenShift) or - (((sourceval shr ARGB_RedShift) and $ff) shl TBGRAPixel_RedShift) or - OpacityOrMask; - end else - begin - PLongWord(pdest)^ := (((sourceval shr ARGB_BlueShift) and $ff) shl TBGRAPixel_BlueShift) or - (((sourceval shr ARGB_GreenShift) and $ff) shl TBGRAPixel_GreenShift) or - (((sourceval shr ARGB_RedShift) and $ff) shl TBGRAPixel_RedShift) or - (alphaValue shl TBGRAPixel_AlphaShift); - end; - dec(count); - inc(pdest); - inc(psrc, sourcePixelSize); - end; -end; - -const - BGRA_AlphaMask = 255 shl TBGRAPixel_AlphaShift; - BGRA_RedMask = 255 shl TBGRAPixel_RedShift; - BGRA_GreenMask = 255 shl TBGRAPixel_GreenShift; - BGRA_BlueMask = 255 shl TBGRAPixel_BlueShift; - BGRA_ColorMask = BGRA_RedMask or BGRA_GreenMask or BGRA_BlueMask; - -procedure CopyFrom32Bit_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); -begin - if sourcePixelSize = 4 then - move(psrc^,pdest^,count*sizeof(TBGRAPixel)) - else - begin - while count > 0 do - begin - PLongWord(pdest)^ := PLongWord(psrc)^; - dec(count); - inc(pdest); - inc(psrc, sourcePixelSize); - end; - end; -end; - -procedure CopyFrom32Bit_SwapRedBlue_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte); -var srcValue: UInt32or64; -begin - while count > 0 do - begin - srcValue := PLongWord(psrc)^; - PLongWord(pdest)^ := (srcValue and not (BGRA_RedMask or BGRA_BlueMask)) - or (((srcValue and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift) - or (((srcValue and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift); - dec(count); - inc(pdest); - inc(psrc, sourcePixelSize); - end; -end; - -procedure CopyFrom32Bit_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -var - OpacityOrMask: UInt32or64; -begin - OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; - while count > 0 do - begin - PLongWord(pdest)^ := (PLongWord(psrc)^ and not BGRA_AlphaMask) or OpacityOrMask; - inc(psrc, sourcePixelSize); - inc(pdest); - dec(count); - end; -end; - -procedure CopyFrom32Bit_SwapRedBlue_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -begin - while count > 0 do - begin - pdest^.red := PBGRAPixel(psrc)^.blue; - pdest^.green := PBGRAPixel(psrc)^.green; - pdest^.blue := PBGRAPixel(psrc)^.red; - pdest^.alpha := DefaultOpacity; //use default opacity - inc(psrc, sourcePixelSize); - inc(pdest); - dec(count); - end; -end; - -procedure CopyFrom32Bit_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -var sourceval: UInt32or64; - OpacityOrMask : UInt32or64; -begin - OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; - while count > 0 do - begin - sourceval := plongword(psrc)^; - if ((sourceVal shr TBGRAPixel_AlphaShift) and $ff = 0) and ((sourceval and BGRA_ColorMask) <> 0) then //if not black but transparent - plongword(pdest)^ := (sourceval and BGRA_ColorMask) or OpacityOrMask //use default opacity - else - plongword(pdest)^ := plongword(psrc)^; - dec(count); - inc(pdest); - inc(psrc, sourcePixelSize); - end; -end; - -procedure CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte); -var sourceval: UInt32or64; - OpacityOrMask : UInt32or64; -begin - OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift; - while count > 0 do - begin - sourceval := plongword(psrc)^; - if ((sourceVal shr TBGRAPixel_AlphaShift) and $ff = 0) and ((sourceval and BGRA_ColorMask) <> 0) then //if not black but transparent - plongword(pdest)^ := (((sourceval and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift) - or (((sourceval and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift) - or (sourceval and BGRA_GreenMask) - or OpacityOrMask - else - plongword(pdest)^ := (((sourceval and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift) - or (((sourceval and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift) - or (sourceval and (BGRA_GreenMask or BGRA_AlphaMask)); - dec(count); - inc(pdest); - inc(psrc, sourcePixelSize); - end; -end; - -procedure DoCopyProc(ADestination: TBGRACustomBitmap; ACopyProc: TCopyPixelProc; AData: PByte; ABytesPerLine, ABitsPerPixel: integer; ALineOrder: TRawImageLineOrder; ADefaultOpacity: byte); -var - n: integer; - psource_byte, pdest_byte, - psource_first, pdest_first: PByte; - psource_delta, pdest_delta: integer; -begin - if (ALineOrder = ADestination.LineOrder) and - (ABytesPerLine = (ABitsPerPixel shr 3) * LongWord(ADestination.Width)) then - ACopyProc(AData, ADestination.Data, ADestination.NbPixels, ABitsPerPixel shr 3, ADefaultOpacity) - else - begin - if ALineOrder = riloTopToBottom then - begin - psource_first := AData; - psource_delta := ABytesPerLine; - end else - begin - psource_first := AData + (ADestination.Height-1) * ABytesPerLine; - psource_delta := -ABytesPerLine; - end; - - if ADestination.LineOrder = riloTopToBottom then - begin - pdest_first := PByte(ADestination.Data); - pdest_delta := ADestination.Width*sizeof(TBGRAPixel); - end else - begin - pdest_first := PByte(ADestination.Data) + (ADestination.Height-1)*ADestination.Width*sizeof(TBGRAPixel); - pdest_delta := -ADestination.Width*sizeof(TBGRAPixel); - end; - - psource_byte := psource_first; - pdest_byte := pdest_first; - for n := ADestination.Height-1 downto 0 do - begin - ACopyProc(psource_byte, PBGRAPixel(pdest_byte), ADestination.Width, ABitsPerPixel shr 3, ADefaultOpacity); - inc(psource_byte, psource_delta); - inc(pdest_byte, pdest_delta); - end; - end; -end; - -procedure ApplyRawImageMask(ADestination: TBGRACustomBitmap; const ARawImage: TRawImage); -var - copyProc: TCopyPixelProc; -begin - if (ARawImage.Description.MaskBitsPerPixel = 1) and (ARawImage.Mask <> nil) then - begin - if ARawImage.Description.BitOrder = riboBitsInOrder then - copyProc := @ApplyMask1bit - else - copyProc := @ApplyMask1bitRev; - DoCopyProc(ADestination, copyProc, ARawImage.Mask, ARawImage.Description.MaskBytesPerLine, ARawImage.Description.MaskBitsPerPixel, ARawImage.Description.LineOrder, 0); - ADestination.InvalidateBitmap; - end; -end; - -{ Load raw image data. It must be 32bit, 24 bits or 1bit per pixel} -function LoadFromRawImageImplementation(ADestination: TBGRADefaultBitmap; const ARawImage: TRawImage; - DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; RaiseErrorOnInvalidPixelFormat: boolean): boolean; -var - mustSwapRedBlue: boolean; - copyProc: TCopyPixelProc; - nbColorChannels: integer; - - function FormatError(message: string): boolean; - begin - if RaiseErrorOnInvalidPixelFormat then - raise Exception.Create('Invalid raw image format. ' + message) - else - result := false; - end; - -begin - if (ARawImage.Description.Width <> LongWord(ADestination.Width)) or - (ARawImage.Description.Height <> LongWord(ADestination.Height)) then - raise Exception.Create('Bitmap size is inconsistent'); - - if (ADestination.Height=0) or (ADestination.Width=0) then - begin - result := true; - exit; - end; - - if ARawImage.Description.BitsPerPixel = 1 then - begin - if ARawImage.Description.BitOrder = riboBitsInOrder then - copyProc := @CopyFromBW_SetAlpha - else - copyProc := @CopyFromBW_SetAlphaBitRev; - DefaultOpacity := 255; - end else - begin - if ((ARawImage.Description.BitsPerPixel and 7) <> 0) then - begin - result := FormatError(IntToStr(ARawImage.Description.Depth) + 'bit found but multiple of 8bit expected'); - exit; - end; - - if (ARawImage.Description.BitsPerPixel < 24) then - begin - result := FormatError(IntToStr(ARawImage.Description.Depth) + 'bit found but at least 24bit expected'); - exit; - end; - - nbColorChannels := 0; - if (ARawImage.Description.RedPrec > 0) then inc(nbColorChannels); - if (ARawImage.Description.GreenPrec > 0) then inc(nbColorChannels); - if (ARawImage.Description.BluePrec > 0) then inc(nbColorChannels); - - if (nbColorChannels < 3) then - begin - result := FormatError('One or more color channel is missing (RGB expected)'); - exit; - end; - - //channels are in ARGB order - if (ARawImage.Description.BitsPerPixel >= 32) and - (ARawImage.Description.AlphaPrec = 8) and - (((ARawImage.Description.AlphaShift = 0) and - (ARawImage.Description.RedShift = 8) and - (ARawImage.Description.GreenShift = 16) and - (ARawImage.Description.BlueShift = 24) and - (ARawImage.Description.ByteOrder = riboLSBFirst)) or - ((ARawImage.Description.AlphaShift = ARawImage.Description.BitsPerPixel - 8) and - (ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 16) and - (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 24) and - (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 32) and - (ARawImage.Description.ByteOrder = riboMSBFirst))) then - begin - if AlwaysReplaceAlpha then - copyProc := @CopyFromARGB_SetAlpha - else if DefaultOpacity = 0 then - copyProc := @CopyFromARGB_KeepAlpha - else - copyProc := @CopyFromARGB_ReplaceZeroAlpha; - end - else //channels are in ARGB order but alpha is not used - if (ARawImage.Description.BitsPerPixel >= 32) and - (ARawImage.Description.AlphaPrec = 0) and - (((ARawImage.Description.RedShift = 8) and - (ARawImage.Description.GreenShift = 16) and - (ARawImage.Description.BlueShift = 24) and - (ARawImage.Description.ByteOrder = riboLSBFirst)) or - ((ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 16) and - (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 24) and - (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 32) and - (ARawImage.Description.ByteOrder = riboMSBFirst))) then - begin - DefaultOpacity := 255; - copyProc := @CopyFromARGB_SetAlpha; - end - else - begin - //channels are in RGB order (alpha channel may follow) - if (ARawImage.Description.BitsPerPixel >= 24) and - (((ARawImage.Description.RedShift = 0) and - (ARawImage.Description.GreenShift = 8) and - (ARawImage.Description.BlueShift = 16) and - (ARawImage.Description.ByteOrder = riboLSBFirst)) or - ((ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 8) and - (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 16) and - (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 24) and - (ARawImage.Description.ByteOrder = riboMSBFirst))) then - begin - mustSwapRedBlue:= not TBGRAPixel_RGBAOrder; - end - else - //channels are in BGR order (alpha channel may follow) - if (ARawImage.Description.BitsPerPixel >= 24) and - (((ARawImage.Description.BlueShift = 0) and - (ARawImage.Description.GreenShift = 8) and - (ARawImage.Description.RedShift = 16) and - (ARawImage.Description.ByteOrder = riboLSBFirst)) or - ((ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 8) and - (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 16) and - (ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 24) and - (ARawImage.Description.ByteOrder = riboMSBFirst))) then - begin - mustSwapRedBlue:= TBGRAPixel_RGBAOrder; - end - else - begin - result := FormatError('BitsPerPixel: ' + IntToStr(ARawImage.Description.BitsPerPixel) + ', ' - + 'RedShit: ' + IntToStr(ARawImage.Description.RedShift) + ', Prec: ' + IntToStr(ARawImage.Description.RedPrec)+ ', ' - + 'GreenShit: ' + IntToStr(ARawImage.Description.GreenShift) + ', Prec: ' + IntToStr(ARawImage.Description.GreenPrec)+ ', ' - + 'BlueShift: ' + IntToStr(ARawImage.Description.BlueShift) + ', Prec: ' + IntToStr(ARawImage.Description.BluePrec)+ ', ' - + 'AlphaShift: ' + IntToStr(ARawImage.Description.AlphaShift) + ', Prec: ' + IntToStr(ARawImage.Description.AlphaPrec) ); - exit; - end; - - if not mustSwapRedBlue then - begin - if ARawImage.Description.BitsPerPixel = 24 then - copyProc := @CopyFrom24Bit - else - if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then - copyProc := @CopyFrom32Bit_SetAlpha - else if DefaultOpacity = 0 then - copyProc := @CopyFrom32Bit_KeepAlpha - else - copyProc := @CopyFrom32Bit_ReplaceZeroAlpha; - end else - begin - if ARawImage.Description.BitsPerPixel = 24 then - copyProc := @CopyFrom24Bit_SwapRedBlue - else - if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then - copyProc := @CopyFrom32Bit_SwapRedBlue_SetAlpha - else if DefaultOpacity = 0 then - copyProc := @CopyFrom32Bit_SwapRedBlue_KeepAlpha - else - copyProc := @CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha; - end; - end; - end; - - DoCopyProc(ADestination, copyProc, ARawImage.Data, ARawImage.Description.BytesPerLine, ARawImage.Description.BitsPerPixel, ARawImage.Description.LineOrder, DefaultOpacity); - ADestination.InvalidateBitmap; - - ApplyRawImageMask(ADestination, ARawImage); - result := true; -end; - -{ Draw BGRA data to a canvas with transparency } -procedure DataDrawTransparentImplementation(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - Temp: TBitmap; - RawImage: TRawImage; - BitmapHandle, MaskHandle: HBitmap; -begin - RawImage.Init; - RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight); - RawImage.Description.LineOrder := ALineOrder; - RawImage.Data := PByte(AData); - RawImage.DataSize := AWidth * AHeight * sizeof(TBGRAPixel); - if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then - raise FPImageException.Create('Failed to create bitmap handle'); - Temp := TBitmap.Create; - Temp.Handle := BitmapHandle; - Temp.MaskHandle := MaskHandle; - ACanvas.StretchDraw(Rect, Temp); - Temp.Free; -end; - -{ Draw BGRA data to a canvas without transparency } -procedure DataDrawOpaqueImplementation(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - Temp: TBitmap; - RawImage: TRawImage; - BitmapHandle, MaskHandle: HBitmap; - CreateResult: boolean; - tempShift: byte; -begin - if (AHeight = 0) or (AWidth = 0) then - exit; - - RawImage.Init; - RawImage.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth,AHeight); - RawImage.Description.LineOrder := ALineOrder; - RawImage.Description.LineEnd := rileDWordBoundary; - RawImage.Data := PByte(AData); - RawImage.DataSize:= AWidth*AHeight*sizeof(TBGRAPixel); - if TBGRAPixel_RGBAOrder then - begin - tempShift := RawImage.Description.RedShift; - RawImage.Description.RedShift := RawImage.Description.BlueShift; - RawImage.Description.BlueShift := tempShift; - end; - CreateResult := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False); - - if not CreateResult then - raise FPImageException.Create('Failed to create bitmap handle'); - - Temp := TBitmap.Create; - Temp.Handle := BitmapHandle; - Temp.MaskHandle := MaskHandle; - ACanvas.StretchDraw(Rect, Temp); - Temp.Free; -end; - -procedure GetImageFromCanvasImplementation(ADestination: TBGRADefaultBitmap; CanvasSource: TCanvas; x, y: integer); -var - bmp: TBitmap; - subBmp: TBGRACustomBitmap; - subRect: TRect; - cw,ch: integer; -begin - cw := CanvasSource.Width; - ch := CanvasSource.Height; - if (x < 0) or (y < 0) or (x+ADestination.Width > cw) or - (y+ADestination.Height > ch) then - begin - ADestination.FillTransparent; - if (x+ADestination.Width <= 0) or (y+ADestination.Height <= 0) or - (x >= cw) or (y >= ch) then - exit; - - if (x > 0) then subRect.Left := x else subRect.Left := 0; - if (y > 0) then subRect.Top := y else subRect.Top := 0; - if (x+ADestination.Width > cw) then subRect.Right := cw else - subRect.Right := x+ADestination.Width; - if (y+ADestination.Height > ch) then subRect.Bottom := ch else - subRect.Bottom := y+ADestination.Height; - - subBmp := ADestination.NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top); - subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top); - ADestination.PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet); - subBmp.Free; - exit; - end; - bmp := TBitmap.Create; - bmp.PixelFormat := pf24bit; - bmp.Width := ADestination.Width; - bmp.Height := ADestination.Height; - bmp.Canvas.CopyRect(rect(0, 0, ADestination.Width, ADestination.Height), CanvasSource, - rect(x, y, x + ADestination.Width, y + ADestination.Height)); - LoadFromRawImageImplementation(ADestination, bmp.RawImage, 255, True, False); - bmp.Free; - ADestination.InvalidateBitmap; -end; - -{ TBGRALCLPtrBitmap } - -procedure TBGRALCLPtrBitmap.RebuildBitmap; -var - RawImage: TRawImage; - BitmapHandle, MaskHandle: HBitmap; -begin - if FBitmap <> nil then - FBitmap.Free; - - FBitmap := TBitmapTracker.Create(self); - - if (FWidth > 0) and (FHeight > 0) then - begin - RawImage.Init; - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - RawImage.Description.Init_BPP32_R8G8B8A8_BIO_TTB(FWidth, FHeight) - else - RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight); - {$POP} - RawImage.Description.LineOrder := FLineOrder; - RawImage.Data := FDataByte; - RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel); - if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then - raise FPImageException.Create('Failed to create bitmap handle'); - FBitmap.Handle := BitmapHandle; - FBitmap.MaskHandle := MaskHandle; - end; - - FBitmap.Canvas.AntialiasingMode := amOff; -end; - -function TBGRALCLPtrBitmap.CreatePtrBitmap(AWidth, AHeight: integer; - AData: PBGRAPixel): TBGRAPtrBitmap; -begin - Result:= TBGRALCLPtrBitmap.Create(AWidth,AHeight,AData); -end; - -function TBGRALCLPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; -begin - result := TLCLFontRenderer.Create; -end; - -function TBGRALCLPtrBitmap.LoadFromRawImage(ARawImage: TRawImage; - DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; - RaiseErrorOnInvalidPixelFormat: boolean): boolean; -begin - DiscardBitmapChange; - result := LoadFromRawImageImplementation(self,ARawImage,DefaultOpacity,AlwaysReplaceAlpha,RaiseErrorOnInvalidPixelFormat); -end; - -procedure TBGRALCLPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, - y: integer); -begin - DiscardBitmapChange; - GetImageFromCanvasImplementation(self,CanvasSource,x,y); -end; - -procedure TBGRALCLPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - DataDrawTransparentImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); -end; - -procedure TBGRALCLPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - DataDrawOpaqueImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); -end; - -function TBGRALCLBitmap.LoadFromRawImage(ARawImage: TRawImage; - DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; - RaiseErrorOnInvalidPixelFormat: boolean): boolean; -begin - DiscardBitmapChange; - result := LoadFromRawImageImplementation(self,ARawImage,DefaultOpacity,AlwaysReplaceAlpha,RaiseErrorOnInvalidPixelFormat); -end; - -function TBGRALCLBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; -begin - result := TLCLFontRenderer.Create; -end; - -procedure TBGRALCLBitmap.DoLoadFromBitmap; -begin - if FBitmap <> nil then - begin - LoadFromRawImage(FBitmap.RawImage, FCanvasOpacity); - if FAlphaCorrectionNeeded then DoAlphaCorrection; - end; -end; - -procedure TBGRALCLBitmap.RebuildBitmap; -var - RawImage: TRawImage; - BitmapHandle, MaskHandle: HBitmap; -begin - if FBitmap <> nil then - FBitmap.Free; - - FBitmap := TBitmapTracker.Create(self); - - if (FWidth > 0) and (FHeight > 0) then - begin - RawImage.Init; - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - RawImage.Description.Init_BPP32_R8G8B8A8_BIO_TTB(FWidth, FHeight) - else - RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight); - {$POP} - RawImage.Description.LineOrder := FLineOrder; - RawImage.Data := FDataByte; - RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel); - if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then - raise FPImageException.Create('Failed to create bitmap handle'); - FBitmap.Handle := BitmapHandle; - FBitmap.MaskHandle := MaskHandle; - end; - - FBitmap.Canvas.AntialiasingMode := amOff; -end; - -function TBGRALCLBitmap.CreatePtrBitmap(AWidth, AHeight: integer; - AData: PBGRAPixel): TBGRAPtrBitmap; -begin - Result:= TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData); -end; - -procedure TBGRALCLBitmap.Assign(Source: TPersistent); -begin - if Source is TRasterImage then - begin - AssignRasterImage(TRasterImage(Source)); - end else - inherited Assign(Source); - - if Source is TCursorImage then - begin - HotSpot := TCursorImage(Source).HotSpot; - ExtractXorMask; - end - else if Source is TIcon then - begin - HotSpot := Point(0,0); - ExtractXorMask; - end; -end; - -procedure TBGRALCLBitmap.LoadFromResource(AFilename: string; - AOptions: TBGRALoadingOptions); -var - icon: TCustomIcon; - ext: String; -begin - if BGRAResource.IsWinResource(AFilename) then - begin - ext:= Uppercase(ExtractFileExt(AFilename)); - if (ext = '.ICO') or (ext = '.CUR') then - begin - if ext= '.ICO' then icon := TIcon.Create - else icon := TCursorImage.Create; - try - icon.LoadFromResourceName(HInstance, ChangeFileExt(AFilename,'')); - icon.Current:= icon.GetBestIndexForSize(Size(65536,65536)); - self.AssignRasterImage(icon); - finally - icon.Free; - end; - exit; - end; - end; - - inherited LoadFromResource(AFilename, AOptions); -end; - -procedure TBGRALCLBitmap.AssignRasterImage(ARaster: TRasterImage); -var TempBmp: TBitmap; -begin - DiscardBitmapChange; - SetSize(ARaster.Width, ARaster.Height); - if LoadFromRawImage(ARaster.RawImage,0,False,False) then - begin - If Empty then - begin - AlphaFill(255); // if bitmap seems to be empty, assume - // it is an opaque bitmap without alpha channel - ApplyRawImageMask(self, ARaster.RawImage); - end; - end else - if (ARaster is TBitmap) or (ARaster is TCustomIcon) then - begin //try to convert - TempBmp := TBitmap.Create; - TempBmp.Width := ARaster.Width; - TempBmp.Height := ARaster.Height; - TempBmp.Canvas.Draw(0,0,ARaster); - try - LoadFromRawImage(TempBmp.RawImage,255,False,true); - ApplyRawImageMask(self, ARaster.RawImage); - finally - TempBmp.Free; - end; - end else - raise Exception.Create('Unable to convert image to 24 bit'); -end; - -procedure TBGRALCLBitmap.ExtractXorMask; -var - y, x: Integer; - p: PBGRAPixel; -begin - DiscardXorMask; - for y := 0 to Height-1 do - begin - p := ScanLine[y]; - for x := 0 to Width-1 do - begin - if (p^.alpha = 0) and (PLongWord(p)^<>0) then - begin - NeedXorMask; - XorMask.SetPixel(x,y, p^); - end; - inc(p); - end; - end; -end; - -procedure TBGRALCLBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - DataDrawTransparentImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); -end; - -procedure TBGRALCLBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - DataDrawOpaqueImplementation(ACanvas, ARect, AData, ALineOrder, AWidth, AHeight); -end; - -procedure TBGRALCLBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer - ); -begin - DiscardBitmapChange; - GetImageFromCanvasImplementation(self,CanvasSource,x,y); -end; - -procedure TBGRALCLBitmap.LoadFromDevice(DC: HDC); -var - rawImage: TRawImage; - sourceSize: TPoint; -begin - sourceSize := Point(0,0); - GetDeviceSize(DC, sourceSize); - if (sourceSize.x = 0) or (sourceSize.y = 0) then - begin - SetSize(0,0); - exit; - end; - try - if not RawImage_FromDevice(rawImage, DC, rect(0,0,sourceSize.x,sourceSize.y)) then - raise Exception.Create('Cannot get raw image from device'); - SetSize(rawImage.Description.Width, rawImage.Description.Height); - LoadFromRawImage(rawImage,255); - finally - rawImage.FreeData; - end; -end; - -procedure TBGRALCLBitmap.LoadFromDevice(DC: HDC; ARect: TRect); -var - rawImage: TRawImage; -begin - if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then - begin - SetSize(0,0); - exit; - end; - try - if not RawImage_FromDevice(rawImage, DC, ARect) then - raise Exception.Create('Cannot get raw image from device'); - SetSize(rawImage.Description.Width, rawImage.Description.Height); - LoadFromRawImage(rawImage,255); - finally - rawImage.FreeData; - end; -end; - -procedure TBGRALCLBitmap.TakeScreenshotOfPrimaryMonitor; -var primaryDC: THandle; -begin - primaryDC := LCLIntf.GetDC(0); - LoadFromDevice(primaryDC); - LCLIntf.ReleaseDC(0, primaryDC); -end; - -procedure TBGRALCLBitmap.TakeScreenshot(ARect: TRect); -var primaryDC: THandle; -begin - primaryDC := LCLIntf.GetDC(0); - LoadFromDevice(primaryDC, ARect); - LCLIntf.ReleaseDC(0, primaryDC); -end; - -end. - diff --git a/components/bgrabitmap/bgralzpcommon.pas b/components/bgrabitmap/bgralzpcommon.pas deleted file mode 100644 index 4d991de..0000000 --- a/components/bgrabitmap/bgralzpcommon.pas +++ /dev/null @@ -1,643 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRALzpCommon; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils; - -const - LAZPAINT_COMPRESSION_MODE_ZSTREAM = 1; - LAZPAINT_COMPRESSION_MODE_RLE = 2; - LAZPAINT_COMPRESSION_MASK = 255; - LAZPAINT_THUMBNAIL_PNG = 256; - LAZPAINT_MAGIC_HEADER : array[0..7] of char = 'LazPaint'; - - LazpaintChannelGreenFromRed = 1; - LazpaintChannelBlueFromRed = 2; - LazpaintChannelBlueFromGreen = 4; - LazpaintChannelNoAlpha = 8; - LazpaintPalettedRGB = 16; - - LazPaintThumbMaxWidth = 128; - LazPaintThumbMaxHeight = 128; - -type - TLzpCompression = (lzpZStream, //slower and not necessarily better - lzpRLE); //custom RLE for lzp files - - { TLazPaintImageHeader } - - TLazPaintImageHeader = packed record - magic: packed array[0..7] of char; - zero1, headerSize: LongWord; - width, height, nbLayers, previewOffset: LongWord; - zero2, compressionMode, reserved1, layersOffset: LongWord; - end; - -procedure LazPaintImageHeader_SwapEndianIfNeeded(AHeader: TLazPaintImageHeader); - -//routines to compress and uncompress byte-sized values (you need to -//separate the channels to obtain any compression) - -procedure EncodeLazRLE(var sourceBuffer; size:PtrInt; ADest: TStream); -function DecodeLazRLE(ASource: TStream; var destBuffer; availableOutputSize: PtrInt; availableInputSize: int64 = -1): PtrInt; - -implementation - -const //flag to distinguish ranges of opcodes - simpleRepetitionFlag = $00; // $01..$3f: normal repetition - packedRepetitionFlag = $40; // $41..$5f: packed repetition - repetitionOf0Flag = $60; // $60..$6f: repeat 1..16 zeros - repetitionOf255Flag = $70; // $70..$7f: repeat 1..16 values of 255 - simpleDumpFlag = $80; // $81: dump of size as byte+64, $82..$bf: simple dump (2..63) - packedDumpFlag = $c0; // $c3..$df: packed dump (3..31) - packedDumpFromLastFlag= $e0; // $e2..$fe: packed dump from last packed dump value (2..30) - - //special opcodes - wordRepetitionOpCode = $00; //followed by word and then a value to repeat - byteRepetitionOpCode = $40; //followed by byte (add 64 to it to get the repetition count) and then a value to repeat - previousWordSizeRepetitionOpCode = $80; //use the last value of opcode $00 so only followed by value to repeat - previousByteSizeRepetitionOpCode = $c0; //use the last value of opcode $80 so only followed by value to repeat - endOfStreamOpCode = $e0; //end of RLE stream (not necessarily the end of the image) - - //for future use but must not be accepted in the input stream - {%H-}reservedOpCode1 = $c1; - {%H-}reservedOpCode2 = $c2; - {%H-}reservedOpCode3 = $e1; - - {%H-}optionalOpCode = $ff; //for future use but should be ignored if not recognized - - //numeric information - maxNormalRepetition = 63; - maxSmallRepCount = 31 * 4; // sets of four packed repetition - maxDumpCount = 255+32; - - maxRepetition = 65535; // normal: 1..63, byte+64: 64..319, word-sized: 0..65535 - minSmallRep = 1; - maxSmallRep = minSmallRep+3; - - -procedure EncodeLazRLE(var sourceBuffer; size:PtrInt; ADest: TStream); -const BufferSize = 4096; -var - buffer: array[0..BufferSize-1] of byte; - bufferPos: integer; - smallRepetitions: array[0..maxSmallRepCount-1] of record - value: Int32or64; - count: Int32or64; //minSmallRep..maxSmallRep - end; - smallRepetitionsCount, smallRepTotal: Int32or64; - previousWordSizeRepetition, previousByteSizeRepetition: Int32or64; - lastPackedDumpValue: Int32or64; - - procedure FlushBuffer; - begin - ADest.WriteBuffer(buffer, BufferSize); - bufferPos := 0; - end; - - procedure WriteByte(b: byte); inline; - begin - buffer[bufferPos] := b; - inc(bufferPos); - if bufferPos = BufferSize then FlushBuffer; - end; - - procedure WriteBytes(p: PByte; ACount: integer); - var - writeCount: Integer; - begin - while bufferPos+ACount >= BufferSize do - begin - writeCount := BufferSize-bufferPos; - move(p^, buffer[bufferPos], writeCount); - inc(p, writeCount); - bufferPos := BufferSize; - dec(ACount, writeCount); - FlushBuffer; - end; - if ACount > 0 then - begin - move(p^, buffer[bufferPos], ACount); - inc(bufferPos, ACount); - end; - end; - - procedure OutputNormalRepetition(AValue,ACount: Int32or64); - begin - If (ACount < 1) or (ACount > maxNormalRepetition) then - raise exception.Create('Invalid count'); - - if (AValue = 0) and (ACount <= 16) then - begin - WriteByte((ACount-1) or repetitionOf0Flag); - end else - if (AValue = 255) and (ACount <= 16) then - begin - WriteByte((ACount-1) or repetitionOf255Flag); - end else - begin - WriteByte(ACount or simpleRepetitionFlag); - WriteByte(AValue); - end; - end; - - procedure FlushSmallRepetitions; - var i,j: Int32or64; - packedCount: Int32or64; - smallOutput: Int32or64; - begin - if smallRepetitionsCount = 0 then exit; - if smallRepetitionsCount >= 4 then - begin - smallOutput:= smallRepetitionsCount and not 3; - WriteByte(packedRepetitionFlag or (smallOutput shr 2)); - packedCount := 0; - for i := 0 to smallOutput-1 do - begin - packedCount := packedCount + ((smallRepetitions[i].count-minSmallRep) shl ((i and 3) shl 1)); - if (i and 3) = 3 then - begin - WriteByte(packedCount); - for j := i-3 to i do - WriteByte(smallRepetitions[j].value); - packedCount:= 0; - end; - end; - for i := smallOutput to smallRepetitionsCount-1 do - OutputNormalRepetition(smallRepetitions[i].value,smallRepetitions[i].count); - end else - begin - for i := 0 to smallRepetitionsCount-1 do - OutputNormalRepetition(smallRepetitions[i].value,smallRepetitions[i].count); - end; - smallRepetitionsCount := 0; - smallRepTotal := 0; - end; - - procedure OutputRepetition(AValue,ACount: Int32or64; AAccumulate: boolean = true); - begin - if AAccumulate and (ACount >= minSmallRep) and (ACount <= maxSmallRep) and (maxSmallRepCount>0) then - begin - if (smallRepetitionsCount> 0) and (smallRepetitions[smallRepetitionsCount-1].value = AValue) and - (smallRepetitions[smallRepetitionsCount-1].count+ACount <= maxSmallRepCount) then - begin - inc(smallRepetitions[smallRepetitionsCount-1].count, ACount); - exit; - end; - if smallRepetitionsCount = maxSmallRepCount then - FlushSmallRepetitions; - if smallRepetitionsCount and 3 = 0 then smallRepTotal := 0; - smallRepetitions[smallRepetitionsCount].value := AValue; - smallRepetitions[smallRepetitionsCount].count := ACount; - inc(smallRepetitionsCount); - inc(smallRepTotal, ACount); - end else - begin - flushSmallRepetitions; - if ACount <= maxNormalRepetition then - OutputNormalRepetition(AValue,ACount) else - begin - if ACount = previousWordSizeRepetition then - begin - WriteByte(previousWordSizeRepetitionOpCode); - WriteByte(AValue); - end else - if ACount = previousByteSizeRepetition then - begin - WriteByte(previousByteSizeRepetitionOpCode); - WriteByte(AValue); - end else - if ACount <= 64+255 then - begin - WriteByte(byteRepetitionOpCode); - WriteByte(ACount-64); - WriteByte(AValue); - previousByteSizeRepetition := ACount; - end else - if ACount <= 65535 then - begin - WriteByte(wordRepetitionOpCode); - WriteByte(ACount shr 8); - WriteByte(ACount and 255); - WriteByte(AValue); - previousWordSizeRepetition := ACount; - end else - raise exception.Create('Invalid count'); - end; - end; - end; - - procedure DumpNoPack(P: PByte; ACount: Int32or64); - begin - if ACount = 0 then exit; - if ACount = 1 then - begin - OutputNormalRepetition(p^,1); - exit; - end; - If (ACount < 0) or (ACount > maxDumpCount) then - raise exception.Create('Invalid count'); - - if ACount > 63 then - begin - if ACount > 255+64 then - raise exception.Create('Invalid count'); - WriteByte($01 or simpleDumpFlag); - WriteByte(ACount-64); - end else - WriteByte(ACount or simpleDumpFlag); - - WriteBytes(p, ACount); - end; - - procedure DumpPacked(p : PByte; ACount: Int32or64); - var diffLast: integer; - packedValues: array[0..31] of Int32or64; - nbPackedValues, idx: Int32or64; - - begin - if ACount = 0 then exit else - if ACount = 1 then - begin - OutputNormalRepetition(p^,1); - exit; - end else - if ACount = 2 then - begin - DumpNoPack(p, ACount); - exit; - end; - If (ACount < 3) or (ACount > maxDumpCount) then - raise exception.Create('Invalid count'); - - diffLast := p^ - lastPackedDumpValue; - if (diffLast < -7) or (diffLast > 7) then - begin - if ACount > 31 then - begin - DumpPacked(p, 31); - DumpPacked(p+31, ACount-31); - exit; - end; - WriteByte(ACount or packedDumpFlag); - lastPackedDumpValue:= p^; - WriteByte(lastPackedDumpValue); - dec(ACount); - inc(p); - end else - if ACount > 30 then - begin - while ACount > 30 do - begin - DumpPacked(p, 30); - inc(p,30); - dec(ACount,30); - end; - DumpPacked(p, ACount); - exit; - end else - WriteByte(ACount or packedDumpFromLastFlag); - - nbPackedValues := 0; - while ACount >0 do - begin - packedValues[nbPackedValues] := (p^ - lastPackedDumpValue + 8) and 15; - inc(nbPackedValues); - lastPackedDumpValue := p^; - inc(p); - dec(ACount); - end; - - idx := 0; - while idx < nbPackedValues do - begin - if idx+1 = nbPackedValues then - begin - WriteByte(packedValues[idx] shl 4); - break; - end; - WriteByte((packedValues[idx] shl 4) + packedValues[idx+1]); - inc(idx,2); - end; - end; - - procedure Dump(p: PByte; ACount: Int32or64); - const smallestPackedDump = 5; - smallestPackedDumpTail = 3; - var - diffVal,i: Int32or64; - fitPackStart: Int32or64; - p2: PByte; - begin - if ACount >= smallestPackedDump then - begin - p2 := p+1; - fitPackStart := -1; - for i := 1 to ACount-1 do - begin - diffVal := p2^ - (p2-1)^; - if diffVal > 128 then dec(diffVal,256) - else if diffVal < -128 then inc(diffVal,256); - if (diffVal > 7) or (diffVal < -7) then - begin - if (fitPackStart <> -1) and - ((i-fitPackStart+1 >= smallestPackedDump) or - ((i-fitPackStart+1 >= smallestPackedDumpTail) and - (fitPackStart = 1) )) then - begin - DumpNoPack(p, fitPackStart-1); - DumpPacked(p+(fitPackStart-1), i-fitPackStart+1); - Dump(p+i, ACount-i); - exit; - end; - fitPackStart := -1; - end else - if fitPackStart = -1 then fitPackStart := i; - inc(p2); - end; - if (fitPackStart <> -1) and (ACount-fitPackStart+1 >= smallestPackedDumpTail) then - begin - DumpNoPack(p,fitPackStart-1); - DumpPacked(p+(fitPackStart-1), ACount-fitPackStart+1); - exit; - end; - ACount := ACount; - end; - DumpNoPack(p, ACount); - end; - -var - psrc,psrcBefore: PByte; - curValue: Int32or64; - curCount: Int32or64; -begin - if size = 0 then exit; - psrc := @sourceBuffer; - if psrc = nil then - raise exception.Create('Source buffer not provided'); - bufferPos := 0; - curValue := psrc^; - curCount := 1; - inc(psrc); - dec(size); - smallRepetitionsCount := 0; - smallRepTotal := 0; - previousWordSizeRepetition := 0; - previousByteSizeRepetition := 0; - lastPackedDumpValue:= $80; - while size > 0 do - begin - if (psrc^ = curValue) and (curCount < maxRepetition) then - begin - inc(curCount); - dec(size); - inc(psrc); - end else - if (curCount > 1) or (((smallRepetitionsCount and 3) <> 0) and (smallRepTotal >= 5)) then - begin - outputRepetition(curValue,curCount); - curCount := 1; - curValue := psrc^; - dec(size); - inc(psrc); - end else //curCount = 1 - begin - psrcBefore := psrc-1; - inc(psrc); - inc(curCount); - dec(size); - while (curCount < maxDumpCount) and (size>0) and - ( (psrc^ <> (psrc-1)^) or ((size>1) and ((psrc+1)^ <> (psrc-1)^)) ) do //eat doubles too - begin - inc(psrc); - inc(curCount); - dec(size); - if (curCount > 12) and ((psrc-1)^ = (psrc-2)^) and - ((psrc-3)^ = (psrc-4)^) and ((psrc-5)^ = (psrc-6)^) then //three doubles - begin - dec(psrc,6); - dec(curCount,6); - inc(size,6); - break; - end; - end; - if (size > 1) and (psrc^ = (psrc-1)^) and ((psrc+1)^ = psrc^) then //repetition coming - begin - dec(psrc); - dec(curCount); - inc(size); - end; - FlushSmallRepetitions; - if curCount = 1 then OutputRepetition(psrcBefore^,1) else - if curCount > 1 then Dump(psrcBefore, curCount); - if size > 0 then - begin - curValue := psrc^; - curCount := 1; - inc(psrc); - dec(size); - end else - begin - curCount := 0; - break; - end; - end; - end; - if curCount > 0 then OutputRepetition(curValue,curCount); - FlushSmallRepetitions; - WriteByte(endOfStreamOpCode); - FlushBuffer; -end; - -function DecodeLazRLE(ASource: TStream; var destBuffer; availableOutputSize: PtrInt; availableInputSize: int64 = -1): PtrInt; -const MaxBufferSize = 1024; -var - opCode: Int32or64; - pdest: PByte; - lastRepeatWordSize, lastRepeatByteSize: Int32or64; - lastPackedDumpValue: Int32or64; - - Buffer: packed array of byte; - BufferPos, BufferSize: Int32or64; - BufferStartLocation: Int64; - - procedure OutputOverflow(AWanted: PtrInt; AFunctionName: string); - var position: int64; - begin - position := ASource.Position - BufferSize + BufferPos; - raise exception.Create('Output buffer overflow. Current position is ' + IntToStr(result)+' out of '+ IntToStr(availableOutputSize)+ - ' and '+IntToStr(AWanted)+' is required by '+AFunctionName+'. ' + - 'The absolute input position is '+IntToStr(position)+' which is ' + inttostr(position-BufferStartLocation) + ' from start.'); - end; - - function ReduceAvailableInputSize(AWanted: PtrInt): PtrInt; - begin - if availableInputSize <> -1 then - begin - if AWanted>availableInputSize then - result := availableInputSize - else - result := AWanted; - dec(availableInputSize, result); - end else - result := AWanted; - end; - - function GetByteFromNextBuffer: byte; - begin - if BufferSize = 0 then - result := $e0 - else - begin - BufferSize := ASource.Read(Buffer[0],ReduceAvailableInputSize(length(Buffer))); - BufferPos := 0; - if BufferPos < BufferSize then - begin - result := Buffer[BufferPos]; - inc(BufferPos); - end else - result := $e0; - end; - end; - - function GetNextBufferByte: byte; inline; - begin - if BufferPos < BufferSize then - begin - result := Buffer[BufferPos]; - inc(BufferPos); - end else - result := GetByteFromNextBuffer; - end; - - procedure RepeatValue(AValue: Int32or64; ACount: Int32or64); - begin - if result+ACount > availableOutputSize then OutputOverflow(ACount,'RepeatValue'); - fillchar(pdest^, ACount, AValue); - inc(pdest, ACount); - inc(result, ACount); - end; - - procedure PackedRepeatValues(ACount: Int32or64); - var packedCount: Int32or64; - begin - while ACount > 0 do - begin - packedCount := GetNextBufferByte; - RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); - packedCount:= packedCount shr 2; - RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); - packedCount:= packedCount shr 2; - RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); - packedCount:= packedCount shr 2; - RepeatValue(GetNextBufferByte, (packedCount and 3) + 1); - dec(ACount); - end; - end; - - procedure DumpValues(ACount: Int32or64); - begin - if result+ACount > availableOutputSize then OutputOverflow(ACount, 'DumpValues'); - inc(result, ACount); - while ACount > 0 do - begin - pdest^ := GetNextBufferByte; - inc(pdest); - dec(ACount); - end; - end; - - procedure PackedDumpValues(ACount: Int32or64); - var packedData: Int32or64; - begin - if result+ACount > availableOutputSize then OutputOverflow(ACount, 'PackedDumpValues'); - inc(result, ACount); - while ACount > 0 do - begin - packedData := GetNextBufferByte; - lastPackedDumpValue := (lastPackedDumpValue + (packedData shr 4) - 8) and 255; - pdest^ := lastPackedDumpValue; - if ACount >= 2 then - begin - lastPackedDumpValue := (lastPackedDumpValue + (packedData and 15) - 8) and 255; - (pdest+1)^ := lastPackedDumpValue; - inc(pdest,2); - dec(ACount,2); - end else - begin - inc(pdest); - dec(ACount); - end; - lastPackedDumpValue:= (pdest-1)^; - end; - end; -begin - BufferStartLocation:= ASource.Position; - setLength(Buffer,MaxBufferSize); - BufferSize := ASource.Read(Buffer[0],ReduceAvailableInputSize(length(Buffer))); - BufferPos := 0; - - pdest := @destBuffer; - result := 0; - lastPackedDumpValue:= $80; - try - repeat - opCode := GetNextBufferByte; - case opCode of - wordRepetitionOpCode: begin - lastRepeatWordSize:= GetNextBufferByte shl 8; - inc(lastRepeatWordSize, GetNextBufferByte); - RepeatValue(GetNextBufferByte, lastRepeatWordSize); - end; - previousWordSizeRepetitionOpCode: RepeatValue(GetNextBufferByte, lastRepeatWordSize); - byteRepetitionOpCode: begin - lastRepeatByteSize:= GetNextBufferByte + 64; - RepeatValue(GetNextBufferByte, lastRepeatByteSize); - end; - previousByteSizeRepetitionOpCode: RepeatValue(GetNextBufferByte, lastRepeatByteSize); - - $01..$3f: RepeatValue(GetNextBufferByte, opCode); - $41..$5f: PackedRepeatValues(opCode - $40); - $60..$6f: RepeatValue($00, opCode - $60 + 1); - $70..$7f: RepeatValue($FF, opCode - $70 + 1); - $81: DumpValues(GetNextBufferByte+64); - $82..$bf: DumpValues(opCode - $80); - $c3..$df: begin - lastPackedDumpValue := GetNextBufferByte; - RepeatValue(lastPackedDumpValue, 1); - PackedDumpValues(opCode - $c0 - 1); - end; - $e2..$fe: PackedDumpValues(opCode - $e0); - - reservedOpCode1, reservedOpCode2, reservedOpCode3: raise exception.Create('Unexpected opcode'); - endOfStreamOpCode, optionalOpCode: ; - end; - until opCode = endOfStreamOpCode; - finally - ASource.Position:= ASource.Position-BufferSize+BufferPos; - end; -end; - -{ TLazPaintImageHeader } - -procedure LazPaintImageHeader_SwapEndianIfNeeded(AHeader: TLazPaintImageHeader); -begin - with AHeader do - begin - headerSize := LEtoN(headerSize); - width := LEtoN(width); - height := LEtoN(height); - nbLayers := LEtoN(nbLayers); - height := LEtoN(height); - previewOffset := LEtoN(previewOffset); - compressionMode := LEtoN(compressionMode); - layersOffset := LEtoN(layersOffset); - end; -end; - - -end. diff --git a/components/bgrabitmap/bgramacbitmap.pas b/components/bgrabitmap/bgramacbitmap.pas deleted file mode 100644 index d0a90f3..0000000 --- a/components/bgrabitmap/bgramacbitmap.pas +++ /dev/null @@ -1,84 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAMacBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRALCLBitmap, BGRAGraphics, BGRABitmapTypes; - -type - - { TBGRAMacBitmap } - - TBGRAMacBitmap = class(TBGRALCLBitmap) - procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - end; - -implementation - -uses LCLType, GraphType, LCLIntf, FPimage; - -procedure DataDrawOpaqueImplementation(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -type - PARGB = ^TARGB; - TARGB = packed record - alpha,red,green,blue: byte; - end; - -var - Temp: TBitmap; - RawImage: TRawImage; - BitmapHandle, MaskHandle: HBitmap; - CreateResult: boolean; - psrc: PBGRAPixel; - pdest: PARGB; - n: Integer; -begin - if (AHeight = 0) or (AWidth = 0) then - exit; - - RawImage.Init; - RawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth,AHeight); - RawImage.Description.Depth := 24; - RawImage.Description.AlphaPrec := 0; - RawImage.Description.LineOrder := ALineOrder; - RawImage.Description.LineEnd := rileDWordBoundary; - RawImage.CreateData(False); - psrc := PBGRAPixel(AData); - pdest := PARGB(RawImage.Data); - for n := AWidth*AHeight-1 downto 0 do - begin - pdest^.alpha := 255; - pdest^.red := psrc^.red; - pdest^.green := psrc^.green; - pdest^.blue := psrc^.blue; - inc(pdest); - inc(psrc); - end; - CreateResult := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False); - RawImage.FreeData; - - if not CreateResult then - raise FPImageException.Create('Failed to create bitmap handle'); - - Temp := TBitmap.Create; - Temp.Handle := BitmapHandle; - Temp.MaskHandle := MaskHandle; - ACanvas.StretchDraw(Rect, Temp); - Temp.Free; -end; - -{ TBGRAMacBitmap } - -procedure TBGRAMacBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - DataDrawOpaqueImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight); -end; - -end. - diff --git a/components/bgrabitmap/bgramatrix3d.pas b/components/bgrabitmap/bgramatrix3d.pas deleted file mode 100644 index f0ddc70..0000000 --- a/components/bgrabitmap/bgramatrix3d.pas +++ /dev/null @@ -1,900 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAMatrix3D; - -{$mode objfpc}{$H+} - -{$i bgrasse.inc} - -{$ifdef CPUI386} - {$asmmode intel} -{$ENDIF} -{$ifdef cpux86_64} - {$asmmode intel} -{$ENDIF} - -interface - -uses - BGRABitmapTypes, BGRASSE, - BGRATransform; - -type - TMatrix3D = packed array[1..3,1..4] of single; - TMatrix4D = packed array[1..4,1..4] of single; - TProjection3D = packed record - Zoom, Center: TPointF; - end; - TComputeProjectionFunc = function(AViewCoord: TPoint3D_128): TPointF of object; - -operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D; -operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128; -function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128; -operator*(A,B: TMatrix3D): TMatrix3D; - -function Matrix3D(m11,m12,m13,m14, m21,m22,m23,m24, m31,m32,m33,m34: single): TMatrix3D; overload; -function Matrix3D(vx,vy,vz,ofs: TPoint3D): TMatrix3D; overload; -function Matrix3D(vx,vy,vz,ofs: TPoint3D_128): TMatrix3D; overload; -function MatrixIdentity3D: TMatrix3D; -function MatrixInverse3D(A: TMatrix3D): TMatrix3D; -function MatrixTranslation3D(ofs: TPoint3D): TMatrix3D; -function MatrixScale3D(size: TPoint3D): TMatrix3D; -function MatrixRotateX(angle: single): TMatrix3D; -function MatrixRotateY(angle: single): TMatrix3D; -function MatrixRotateZ(angle: single): TMatrix3D; - -operator *(const A, B: TMatrix4D): TMatrix4D; -function MatrixIdentity4D: TMatrix4D; -function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D; - -{$IFDEF BGRASSE_AVAILABLE} -procedure Matrix3D_SSE_Load(const A: TMatrix3D); -procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); -procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); -procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); -procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); -{$ENDIF} - -implementation - -procedure multiplyVect3(const A : TMatrix3D; const vx,vy,vz,vt: single; out outx,outy,outz: single); -begin - outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4]; - outy := vx * A[2,1] + vy * A[2,2] + vz * A[2,3] + vt * A[2,4]; - outz := vx * A[3,1] + vy * A[3,2] + vz * A[3,3] + vt * A[3,4]; -end; - -procedure multiplyVect4(const A : TMatrix4D; const vx,vy,vz,vt: single; out outx,outy,outz,outt: single); -begin - outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4]; - outy := vx * A[2,1] + vy * A[2,2] + vz * A[2,3] + vt * A[2,4]; - outz := vx * A[3,1] + vy * A[3,2] + vz * A[3,3] + vt * A[3,4]; - outt := vx * A[4,1] + vy * A[4,2] + vz * A[4,3] + vt * A[4,4]; -end; - -operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D; -begin - result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3] + A[1,4]; - result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3] + A[2,4]; - result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3] + A[3,4]; -end; - -operator*(const A, B: TMatrix4D): TMatrix4D; -begin - multiplyVect4(A, B[1,1],B[2,1],B[3,1],B[4,1], result[1,1],result[2,1],result[3,1],result[4,1]); - multiplyVect4(A, B[1,2],B[2,2],B[3,2],B[4,2], result[1,2],result[2,2],result[3,2],result[4,2]); - multiplyVect4(A, B[1,3],B[2,3],B[3,3],B[4,3], result[1,3],result[2,3],result[3,3],result[4,3]); - multiplyVect4(A, B[1,4],B[2,4],B[3,4],B[4,4], result[1,4],result[2,4],result[3,4],result[4,4]); -end; - -function MatrixIdentity4D: TMatrix4D; -begin - result[1,1] := 1; result[2,1] := 0; result[3,1] := 0; result[4,1] := 0; - result[1,2] := 0; result[2,2] := 1; result[3,2] := 0; result[4,2] := 0; - result[1,3] := 0; result[2,3] := 0; result[3,3] := 1; result[4,3] := 0; - result[1,4] := 0; result[2,4] := 0; result[3,4] := 0; result[4,4] := 1; -end; - -function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D; -begin - result[1,1] := AValue[1,1]; result[2,1] := AValue[1,2]; result[3,1] := 0; result[4,1] := AValue[1,3]; - result[1,2] := AValue[2,1]; result[2,2] := AValue[2,2]; result[3,2] := 0; result[4,2] := AValue[2,3]; - result[1,3] := 0; result[2,3] := 0; result[3,3] := 1; result[4,3] := 0; - result[1,4] := 0; result[2,4] := 0; result[3,4] := 0; result[4,4] := 1; -end; - -{$IFDEF BGRASSE_AVAILABLE} -var SingleConst1 : single = 1; - - procedure Matrix3D_SSE_Load(const A: TMatrix3D); - begin - {$IFDEF cpux86_64} - asm - mov rax, A - movups xmm5, [rax] - movups xmm6, [rax+16] - movups xmm7, [rax+32] - end; - {$ELSE} - asm - mov eax, A - movups xmm5, [eax] - movups xmm6, [eax+16] - movups xmm7, [eax+32] - end; - {$ENDIF} - end; - -procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); -var oldMt: single; -begin - oldMt := M.t; - M.t := SingleConst1; - {$IFDEF cpux86_64} - asm - mov rax, M - movaps xmm0, [rax] - - mov rax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [rax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [rax+4], xmm2 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [rax+8], xmm0 - end; - {$ELSE} - asm - mov eax, M - movaps xmm0, [eax] - - mov eax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [eax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [eax+4], xmm2 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [eax+8], xmm0 - end; - {$ENDIF} - M.t := oldMt; - N.t := 0; -end; - -procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128); -var oldMt: single; -begin - oldMt := M.t; - M.t := SingleConst1; - {$IFDEF cpux86_64} - asm - mov rax, M - movaps xmm0, [rax] - - mov rax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [rax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [rax+4], xmm2 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [rax+8], xmm0 - end; - {$ELSE} - asm - mov eax, M - movaps xmm0, [eax] - - mov eax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [eax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [eax+4], xmm2 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [eax+8], xmm0 - end; - {$ENDIF} - M.t := oldMt; -end; - -procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned( - var M: TPoint3D_128; out N: TPoint3D_128); -begin - {$IFDEF cpux86_64} - asm - mov rax, M - movaps xmm0, [rax] - - mov rax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [rax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [rax+4], xmm2 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [rax+8], xmm0 - end; - {$ELSE} - asm - mov eax, M - movaps xmm0, [eax] - - mov eax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [eax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - //mix1 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $4e - addps xmm2, xmm3 - //mix2 - movaps xmm3, xmm2 - shufps xmm3, xmm3, $11 - addps xmm2, xmm3 - - movss [eax+4], xmm2 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [eax+8], xmm0 - end; - {$ENDIF} -end; - -procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned( - var M: TPoint3D_128; out N: TPoint3D_128); -begin - {$IFDEF cpux86_64} - asm - mov rax, M - movaps xmm0, [rax] - - mov rax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [rax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [rax+4], xmm2 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [rax+8], xmm0 - end; - {$ELSE} - asm - mov eax, M - movaps xmm0, [eax] - - mov eax, N - - movaps xmm2,xmm0 - mulps xmm2,xmm5 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [eax], xmm2 - - movaps xmm2,xmm0 - mulps xmm2,xmm6 - haddps xmm2,xmm2 - haddps xmm2,xmm2 - movss [eax+4], xmm2 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [eax+8], xmm0 - end; - {$ENDIF} -end; - -{$ENDIF} - -operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128; -{$IFDEF BGRASSE_AVAILABLE}var oldMt: single; - resultAddr: pointer;{$ENDIF} -begin - {$IFDEF BGRASSE_AVAILABLE} - if UseSSE then - begin - oldMt := M.t; - M.t := SingleConst1; - resultAddr := @result; - {$IFDEF cpux86_64} - if UseSSE3 then - asm - mov rax, A - movups xmm5, [rax] - movups xmm6, [rax+16] - movups xmm7, [rax+32] - - mov rax, M - movups xmm0, [rax] - - mov rax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [rax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [rax+4], xmm4 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [rax+8], xmm0 - end else - asm - mov rax, A - movups xmm5, [rax] - movups xmm6, [rax+16] - movups xmm7, [rax+32] - - mov rax, M - movups xmm0, [rax] - - mov rax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [rax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [rax+4], xmm4 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [rax+8], xmm0 - end; - {$ELSE} - if UseSSE3 then - asm - mov eax, A - movups xmm5, [eax] - movups xmm6, [eax+16] - movups xmm7, [eax+32] - - mov eax, M - movups xmm0, [eax] - - mov eax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [eax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [eax+4], xmm4 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [eax+8], xmm0 - end else - asm - mov eax, A - movups xmm5, [eax] - movups xmm6, [eax+16] - movups xmm7, [eax+32] - - mov eax, M - movups xmm0, [eax] - - mov eax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [eax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [eax+4], xmm4 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [eax+8], xmm0 - end; - {$ENDIF} - M.t := oldMt; - result.t := 0; - end else - {$ENDIF} - begin - result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3] + A[1,4]; - result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3] + A[2,4]; - result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3] + A[3,4]; - result.t := 0; - end; -end; - -function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128; -{$IFDEF BGRASSE_AVAILABLE}var resultAddr: pointer;{$ENDIF} -begin - {$IFDEF BGRASSE_AVAILABLE} - if UseSSE then - begin - resultAddr := @result; - {$IFDEF cpux86_64} - if UseSSE3 then - asm - mov rax, A - movups xmm5, [rax] - movups xmm6, [rax+16] - movups xmm7, [rax+32] - - mov rax, M - movups xmm0, [rax] - - mov rax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [rax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [rax+4], xmm4 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [rax+8], xmm0 - end else - asm - mov rax, A - movups xmm5, [rax] - movups xmm6, [rax+16] - movups xmm7, [rax+32] - - mov rax, M - movups xmm0, [rax] - - mov rax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [rax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [rax+4], xmm4 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [rax+8], xmm0 - end; - {$ELSE} - if UseSSE3 then - asm - mov eax, A - movups xmm5, [eax] - movups xmm6, [eax+16] - movups xmm7, [eax+32] - - mov eax, M - movups xmm0, [eax] - - mov eax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [eax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - haddps xmm4,xmm4 - haddps xmm4,xmm4 - movss [eax+4], xmm4 - - mulps xmm0,xmm7 - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [eax+8], xmm0 - end else - asm - mov eax, A - movups xmm5, [eax] - movups xmm6, [eax+16] - movups xmm7, [eax+32] - - mov eax, M - movups xmm0, [eax] - - mov eax, resultAddr - - movaps xmm4,xmm0 - mulps xmm4,xmm5 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [eax], xmm4 - - movaps xmm4,xmm0 - mulps xmm4,xmm6 - //mix1 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $4e - addps xmm4, xmm3 - //mix2 - movaps xmm3, xmm4 - shufps xmm3, xmm3, $11 - addps xmm4, xmm3 - - movss [eax+4], xmm4 - - mulps xmm0,xmm7 - //mix1 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $4e - addps xmm0, xmm3 - //mix2 - movaps xmm3, xmm0 - shufps xmm3, xmm3, $11 - addps xmm0, xmm3 - - movss [eax+8], xmm0 - end; - {$ENDIF} - end else - {$ENDIF} - begin - result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3]; - result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3]; - result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3]; - result.t := 0; - end; -end; - -operator*(A,B: TMatrix3D): TMatrix3D; -begin - multiplyVect3(A, B[1,1],B[2,1],B[3,1],0, result[1,1],result[2,1],result[3,1]); - multiplyVect3(A, B[1,2],B[2,2],B[3,2],0, result[1,2],result[2,2],result[3,2]); - multiplyVect3(A, B[1,3],B[2,3],B[3,3],0, result[1,3],result[2,3],result[3,3]); - multiplyVect3(A, B[1,4],B[2,4],B[3,4],1, result[1,4],result[2,4],result[3,4]); -end; - -function MatrixIdentity3D: TMatrix3D; -begin - result := Matrix3D( 1,0,0,0, - 0,1,0,0, - 0,0,1,0); -end; - -function Matrix3D(m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, - m34: single): TMatrix3D; -begin - result[1,1] := m11; - result[1,2] := m12; - result[1,3] := m13; - result[1,4] := m14; - - result[2,1] := m21; - result[2,2] := m22; - result[2,3] := m23; - result[2,4] := m24; - - result[3,1] := m31; - result[3,2] := m32; - result[3,3] := m33; - result[3,4] := m34; -end; - -function MatrixInverse3D(A: TMatrix3D): TMatrix3D; -var ofs: TPoint3D; -begin - ofs := Point3D(A[1,4],A[2,4],A[3,4]); - - result[1,1] := A[1,1]; - result[1,2] := A[2,1]; - result[1,3] := A[3,1]; - result[1,4] := 0; - - result[2,1] := A[1,2]; - result[2,2] := A[2,2]; - result[2,3] := A[3,2]; - result[2,4] := 0; - - result[3,1] := A[1,3]; - result[3,2] := A[2,3]; - result[3,3] := A[3,3]; - result[3,4] := 0; - - result := result*MatrixTranslation3D(-ofs); -end; - -function Matrix3D(vx, vy, vz, ofs: TPoint3D): TMatrix3D; -begin - result := Matrix3D(vx.x, vy.x, vz.x, ofs.x, - vx.y, vy.y, vz.y, ofs.y, - vx.z, vy.z, vz.z, ofs.z); -end; - -function Matrix3D(vx, vy, vz, ofs: TPoint3D_128): TMatrix3D; -begin - result := Matrix3D(vx.x, vy.x, vz.x, ofs.x, - vx.y, vy.y, vz.y, ofs.y, - vx.z, vy.z, vz.z, ofs.z); -end; - -function MatrixTranslation3D(ofs: TPoint3D): TMatrix3D; -begin - result := Matrix3D(1,0,0,ofs.x, - 0,1,0,ofs.Y, - 0,0,1,ofs.z); -end; - -function MatrixScale3D(size: TPoint3D): TMatrix3D; -begin - result := Matrix3D(size.x,0,0,0, - 0,size.y,0,0, - 0,0,size.z,0); -end; - -function MatrixRotateX(angle: single): TMatrix3D; -begin - result := Matrix3D( 1, 0, 0, 0, - 0, cos(angle), sin(angle), 0, - 0, -sin(angle), cos(angle), 0); -end; - -function MatrixRotateY(angle: single): TMatrix3D; -begin - result := Matrix3D( cos(angle), 0, -sin(angle), 0, - 0, 1, 0, 0, - sin(angle), 0, cos(angle), 0); -end; - -function MatrixRotateZ(angle: single): TMatrix3D; -begin - result := Matrix3D( cos(angle), sin(angle), 0, 0, - -sin(angle), cos(angle), 0, 0, - 0, 0, 1, 0); -end; - -end. - diff --git a/components/bgrabitmap/bgramemdirectory.pas b/components/bgrabitmap/bgramemdirectory.pas deleted file mode 100644 index 045b1e3..0000000 --- a/components/bgrabitmap/bgramemdirectory.pas +++ /dev/null @@ -1,697 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAMemDirectory; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAMultiFileType, fgl; - -const - MemDirectoryFileHeader = 'TMemDirectory'#26#0#0; - MemDirectoryEntry_FlagDirectory = 1; //entry is a directory - MemDirectoryEntry_FlagCompressed = 2; //the stream is compressed - MemDirectoryEntry_FlagSmallEntryPacked = $8000; //name and size <= 255 - -type - TMemDirectory = class; - TEntryFilename = BGRAMultiFileType.TEntryFilename; - -type - TMemDirectoryPath = specialize TFPGList; - - { TMemDirectoryEntry } - - TMemDirectoryEntry = class(TMultiFileEntry) - private - FStream: TStream; - function GetIsCompressed: boolean; - function GetCompressedSize: int64; - function GetIsDirectory: boolean; - procedure SetIsCompressed(AValue: boolean); - procedure LoadExtraFromEmbeddedStream(ADataStream: TStream; AStartPos: int64); - procedure SaveToEmbeddedStream(AEntryStream, ADataStream: TStream; AStartPos: int64; out uncompressedSize: int64); - protected - FFlags: Word; - FName,FExtension: utf8String; - FUncompressedSize: int64; - FEmbeddedStreamPos: int64; - FMemDirectory: TMemDirectory; - function GetName: utf8string; override; - procedure SetName(AValue: utf8string); override; - function GetFileSize: int64; override; - function GetExtension: utf8string; override; - function InternalCopyTo({%H-}ADestination: TStream): int64; - public - function CopyTo({%H-}ADestination: TStream): int64; override; - function GetStream: TStream; override; - constructor Create(AContainer: TMultiFileContainer; AFilename: TEntryFilename; AUncompressedStream: TStream; AOwnStream: boolean); overload; - constructor CreateDirectory(AContainer: TMultiFileContainer; AFilename: TEntryFilename); - constructor CreateFromData(AContainer: TMultiFileContainer; AFilename: TEntryFilename; AStream: TStream; AOwnStream: boolean; AUncompressedSize: int64; AFlags: Word); - destructor Destroy; override; - property EmbeddedStreamPos: int64 read FEmbeddedStreamPos write FEmbeddedStreamPos; - property IsCompressed: boolean read GetIsCompressed write SetIsCompressed; - property IsDirectory: boolean read GetIsDirectory; - property CompressedSize: int64 read GetCompressedSize; - property Flags: Word read FFlags; - property MemDirectory: TMemDirectory read FMemDirectory; - end; - - TMemDirectory = class(TMultiFileContainer) - private - FParentDirectory: TMemDirectory; - function GetEntryCompressed(AIndex: integer): boolean; - function GetIsDirectory(AIndex: integer): boolean; - function GetDirectory(AIndex: integer): TMemDirectory; - procedure SetEntryCompressed(AIndex: integer; AValue: boolean); - protected - function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override; - function SplitPath(APath: utf8string): TMemDirectoryPath; - public - constructor Create(AParentDirectory: TMemDirectory = nil); - function Equals(Obj: TObject): boolean; override; - procedure LoadFromStream(AStream: TStream); override; - class function CheckHeader(AStream: TStream): boolean; static; - procedure LoadFromEmbeddedStream(ARootStream, ADataStream: TStream; AStartPos: int64); - procedure SaveToStream(ADestination: TStream); override; - procedure SaveToEmbeddedStream(ARootDest, ADataDest: TStream; AStartPos: int64); - function AddDirectory(AName: utf8string; AExtension: utf8string= ''; ACaseSensitive: boolean= true): integer; - function Rename(AName: utf8string; AExtension: utf8string; ANewName: utf8string; ACaseSensitive: boolean= true): boolean; - function FindPath(APath: utf8String; ACaseSensitive: boolean = true): TMemDirectory; - function FindEntry(APath: utf8String; ACaseSensitive: boolean = true): TMemDirectoryEntry; - procedure CopyTo(ADest: TMemDirectory; ARecursive: boolean); - property IsEntryCompressed[AIndex: integer]: boolean read GetEntryCompressed write SetEntryCompressed; - property Directory[AIndex: integer]: TMemDirectory read GetDirectory; - property IsDirectory[AIndex: integer]: boolean read GetIsDirectory; - property ParentDirectory: TMemDirectory read FParentDirectory; - end; - -implementation - -uses zstream, BGRAUTF8, strutils; - -type - TDirEntryRecord = packed record - Flags: Word; - FilenameSize: Word; - Offset: int64; - end; - -{ TMemDirectory } - -function TMemDirectory.GetEntryCompressed(AIndex: integer): boolean; -begin - result := (Entry[AIndex] as TMemDirectoryEntry).IsCompressed; -end; - -function TMemDirectory.GetIsDirectory(AIndex: integer): boolean; -begin - result := (Entry[AIndex] as TMemDirectoryEntry).IsDirectory; -end; - -function TMemDirectory.GetDirectory(AIndex: integer): TMemDirectory; -begin - result := (Entry[AIndex] as TMemDirectoryEntry).MemDirectory; -end; - -procedure TMemDirectory.SetEntryCompressed(AIndex: integer; AValue: boolean); -begin - (Entry[AIndex] as TMemDirectoryEntry).IsCompressed := AValue; -end; - -function TMemDirectory.CreateEntry(AName: utf8string; AExtension: utf8string; - AContent: TStream): TMultiFileEntry; -begin - result := TMemDirectoryEntry.Create(self, EntryFilename(AName, AExtension), AContent, true); -end; - -procedure TMemDirectory.LoadFromStream(AStream: TStream); -var rootPos, rootSize: integer; - header: string; - rootStream: TStream; - startPos: Int64; -begin - startPos := AStream.Position; - setlength(header, length(MemDirectoryFileHeader)); - AStream.ReadBuffer(header[1], length(header)); - if header<>MemDirectoryFileHeader then - raise exception.Create('Invalid header'); - rootPos := LEReadInt64(AStream); - if rootPos = 0 then - raise exception.Create('Invalid root offset'); - rootSize := LEReadInt64(AStream); - if rootSize < 4 then - raise exception.Create('Invalid root size'); - AStream.Position:= rootPos + startPos; - rootStream:= TMemoryStream.Create; - try - rootStream.CopyFrom(AStream, rootSize); - LoadFromEmbeddedStream(rootStream, AStream, startPos); - finally - rootStream.Free; - end; -end; - -class function TMemDirectory.CheckHeader(AStream: TStream): boolean; -var - startPos: Int64; - header: string; -begin - startPos := AStream.Position; - setlength(header, length(MemDirectoryFileHeader)); - AStream.Read(header[1], length(header)); - result := (header=MemDirectoryFileHeader); - AStream.Position:= startPos; -end; - -procedure TMemDirectory.LoadFromEmbeddedStream(ARootStream, ADataStream: TStream; - AStartPos: int64); -var - nbEntries,i: LongInt; - entryRec: TDirEntryRecord; - filename: string; - entryData: TStream; - newEntry: TMemDirectoryEntry; - compressedSize, uncompressedSize: Int64; - -begin - Clear; - ARootStream.Position := 0; - nbEntries := LEReadLongint(ARootStream); - for i := 1 to nbEntries do - begin - ARootStream.ReadBuffer({%H-}entryRec, sizeof(entryRec)); - entryRec.Offset:= LEtoN(entryRec.Offset); - entryRec.Flags:= LEtoN(entryRec.Flags); - entryRec.FilenameSize:= LEtoN(entryRec.FilenameSize); - - if (entryRec.Flags and MemDirectoryEntry_FlagSmallEntryPacked) <> 0 then - begin - entryRec.Flags := entryRec.Flags xor MemDirectoryEntry_FlagSmallEntryPacked; - compressedSize := entryRec.FilenameSize shr 8; - uncompressedSize := compressedSize; - entryRec.FilenameSize := entryRec.FilenameSize and 255; - end else - begin - compressedSize := LEReadInt64(ARootStream); - uncompressedSize := LEReadInt64(ARootStream); - end; - - setlength(filename, entryRec.FilenameSize); - if length(filename)> 0 then - ARootStream.ReadBuffer(filename[1], entryRec.FilenameSize); - - ADataStream.Position:= entryRec.Offset + AStartPos; - entryData := TMemoryStream.Create; - try - if compressedSize <> 0 then - entryData.CopyFrom(ADataStream, compressedSize); - newEntry := TMemDirectoryEntry.CreateFromData(self, EntryFilename(filename), entryData, true, - uncompressedSize, entryRec.Flags); - newEntry.LoadExtraFromEmbeddedStream(ADataStream, AStartPos); - AddEntry(newEntry); - entryData := nil; - finally - entryData.Free; - end; - end; -end; - -procedure TMemDirectory.SaveToStream(ADestination: TStream); -var rootPos,rootSize: integer; - header: string; - rootRecPos, startPos, endPos: int64; - rootStream: TStream; -begin - startPos := ADestination.Position; - header := MemDirectoryFileHeader; - ADestination.WriteBuffer(header[1], length(header)); - - rootRecPos := ADestination.Position; - LEWriteInt64(ADestination,0); //root pos - LEWriteInt64(ADestination,0); //root size - - rootStream := TMemoryStream.Create; - try - SaveToEmbeddedStream(rootStream, ADestination, startPos); - rootStream.Position := 0; - rootPos := ADestination.Position - startPos; - rootSize := rootStream.Size; - ADestination.CopyFrom(rootStream, rootStream.Size); - FreeAndNil(rootStream); - endPos := ADestination.Position; - ADestination.Position := rootRecPos; - LEWriteInt64(ADestination, rootPos); - LEWriteInt64(ADestination, rootSize); - ADestination.Position := endPos; - finally - rootStream.Free; - end; -end; - -procedure TMemDirectory.SaveToEmbeddedStream(ARootDest, ADataDest: TStream; - AStartPos: int64); -var - entryRec: TDirEntryRecord; - entryStream: TMemoryStream; - curEntry: TMemDirectoryEntry; - filename: string; - i: Integer; - uncompressedSize: int64; -begin - LEWriteLongint(ARootDest, Count); - entryStream := TMemoryStream.Create; - try - for i := 0 to Count-1 do - begin - curEntry := Entry[i] as TMemDirectoryEntry; - entryStream.Clear; - curEntry.SaveToEmbeddedStream(entryStream, ADataDest, AStartPos, uncompressedSize); - - entryRec.Offset:= ADataDest.Position - AStartPos; - entryRec.Offset:= NtoLE(entryRec.Offset); - if curEntry.Extension <> '' then - filename := curEntry.Name+'.'+curEntry.Extension - else - filename := curEntry.Name; - - if ((curEntry.Flags and MemDirectoryEntry_FlagCompressed)=0) and - (Length(filename)<=255) and (entryStream.Size<=255) then - begin - entryRec.Flags:= curEntry.Flags or MemDirectoryEntry_FlagSmallEntryPacked; - entryRec.Flags:= NtoLE(entryRec.Flags); - entryRec.FilenameSize:= length(filename) + (entryStream.Size shl 8); - entryRec.FilenameSize := NtoLE(entryRec.FilenameSize); - ARootDest.WriteBuffer(entryRec, sizeof(entryRec)); - end else - begin - entryRec.Flags:= curEntry.Flags; - entryRec.Flags:= NtoLE(entryRec.Flags); - entryRec.FilenameSize:= length(filename); - entryRec.FilenameSize := NtoLE(entryRec.FilenameSize); - ARootDest.WriteBuffer(entryRec, sizeof(entryRec)); - LEWriteInt64(ARootDest, entryStream.Size); - LEWriteInt64(ARootDest, uncompressedSize); - end; - - if filename <> '' then - ARootDest.WriteBuffer(filename[1], length(filename)); - - entryStream.Position:= 0; - ADataDest.CopyFrom(entryStream, entryStream.Size); - end; - finally - entryStream.Free; - end; -end; - -function TMemDirectory.AddDirectory(AName: utf8string; AExtension: utf8string; - ACaseSensitive: boolean): integer; -var - newEntry: TMemDirectoryEntry; -begin - result := IndexOf(AName,AExtension,ACaseSensitive); - if result <> -1 then - begin - if not IsDirectory[result] then - raise exception.Create('There is already a file with this name and extension'); - exit; - end; - newEntry := TMemDirectoryEntry.CreateDirectory(self, EntryFilename(AName, AExtension)); - result := AddEntry(newEntry); -end; - -function TMemDirectory.Rename(AName: utf8string; AExtension: utf8string; - ANewName: utf8string; ACaseSensitive: boolean): boolean; -var - idx, i: Integer; -begin - idx := IndexOf(AName, AExtension, ACaseSensitive); - if idx = -1 then exit(false); - for i := 0 to Count-1 do - if i <> idx then - begin - if Entry[i].CompareNameAndExtension(ANewName,AExtension,ACaseSensitive) = 0 then - raise exception.Create('Name with extension already in use'); - end; - Entry[idx].Name := ANewName; - exit(true); -end; - -function TMemDirectory.FindPath(APath: utf8String; ACaseSensitive: boolean): TMemDirectory; -var - path: TMemDirectoryPath; - idxPath: integer; - idxSub: LongInt; -begin - path := SplitPath(APath); - result := self; - if path.Items[0].IsEmpty then - begin - idxPath := 1; - while Assigned(result.ParentDirectory) do result := result.ParentDirectory; - end - else - idxPath := 0; - - while idxPath < path.Count do - begin - idxSub := result.IndexOf(path[idxPath], ACaseSensitive); - if idxSub= -1 then - begin - result := nil; - break; - end; - result := result.Directory[idxSub]; - inc(idxPath); - end; - - path.Free; -end; - -function TMemDirectory.FindEntry(APath: utf8String; ACaseSensitive: boolean): TMemDirectoryEntry; -var - path: TMemDirectoryPath; - idxPath: integer; - idxSub, idxEntry: LongInt; - curDir: TMemDirectory; -begin - path := SplitPath(APath); - curDir := self; - if path.Items[0].IsEmpty then - begin - idxPath := 1; - while Assigned(curDir.ParentDirectory) do curDir := curDir.ParentDirectory; - end - else - idxPath := 0; - - while idxPath < path.Count-1 do - begin - idxSub := curDir.IndexOf(path[idxPath], ACaseSensitive); - if idxSub= -1 then - begin - curDir := nil; - break; - end; - curDir := curDir.Directory[idxSub]; - inc(idxPath); - end; - - if Assigned(curDir) and (idxPath < path.Count) then - begin - idxEntry := curDir.IndexOf(path[idxPath], ACaseSensitive); - if idxEntry = -1 then - result := nil - else - result := curDir.Entry[idxEntry] as TMemDirectoryEntry; - end - else - result := nil; - - path.Free; -end; - -procedure TMemDirectory.CopyTo(ADest: TMemDirectory; ARecursive: boolean); -var - i, idxDir: Integer; - entryContent: TMemoryStream; -begin - for i := 0 to Count-1 do - if IsDirectory[i] and ARecursive then - begin - idxDir := ADest.AddDirectory(Entry[i].Name,Entry[i].Extension); - Directory[i].CopyTo(ADest.Directory[idxDir], true); - end else - begin - entryContent := TMemoryStream.Create; - Entry[i].CopyTo(entryContent); - ADest.Add(Entry[i].Name,Entry[i].Extension,entryContent,false,true); - end; -end; - -function TMemDirectory.SplitPath(APath: utf8string): TMemDirectoryPath; -var idx,idxSlash: integer; -begin - result := TMemDirectoryPath.Create; - idx := 1; - repeat - idxSlash := PosEx('/',APath,idx); - if idxSlash = 0 then - begin - result.Add(EntryFilename(copy(APath, idx, length(APath)-idx+1))); - break; - end else - begin - result.Add(EntryFilename(copy(APath, idx, idxSlash-idx))); - idx := idxSlash+1; - end; - until false; -end; - -constructor TMemDirectory.Create(AParentDirectory: TMemDirectory); -begin - inherited Create; - FParentDirectory := AParentDirectory; -end; - -function TMemDirectory.Equals(Obj: TObject): boolean; -var - other: TMemDirectory; - i, j: Integer; - data,otherData: TMemoryStream; - different: Boolean; -begin - if Obj = self then exit(true); - if not (Obj is TMemDirectory) then exit(false); - other := TMemDirectory(Obj); - if other.Count <> Count then exit(false); - for i := 0 to Count-1 do - begin - j := other.IndexOf(Entry[i].Name,Entry[i].Extension,true); - if j = -1 then exit(false); - if IsDirectory[i] then - begin - if not other.IsDirectory[j] then exit(false); - if not other.Directory[j].Equals(Directory[i]) then exit(false); - end else - if Entry[i].FileSize <> other.Entry[j].FileSize then exit(false) - else - begin - data := TMemoryStream.Create; - otherData := TMemoryStream.Create; - Entry[i].CopyTo(data); - other.Entry[j].CopyTo(otherData); - different := not CompareMem(data.Memory, otherData.Memory, data.Size); - data.Free; - otherData.Free; - if different then exit(false); - end; - end; - result := true; -end; - -{ TMemDirectoryEntry } - -function TMemDirectoryEntry.GetIsCompressed: boolean; -begin - result := (FFlags and MemDirectoryEntry_FlagCompressed) <> 0; -end; - -function TMemDirectoryEntry.GetCompressedSize: int64; -begin - if not IsDirectory and Assigned(FStream) then - result := FStream.Size - else - result := 0; -end; - -function TMemDirectoryEntry.GetIsDirectory: boolean; -begin - result := (FFlags and MemDirectoryEntry_FlagDirectory) <> 0; -end; - -procedure TMemDirectoryEntry.SetIsCompressed(AValue: boolean); -var compressedStream,decompressed: TMemoryStream; - compression: Tcompressionstream; -begin - if AValue = IsCompressed then exit; - - if Assigned(FStream) then - begin - if AValue then //compress - begin - compressedStream := TMemoryStream.Create; - compression := nil; - try - compression := Tcompressionstream.create(cldefault, compressedStream, true); - FStream.Position := 0; - compression.CopyFrom(FStream,FStream.Size); - FStream.Free; - FStream := compressedStream; - compressedStream := nil; - FFlags := FFlags xor MemDirectoryEntry_FlagCompressed; - finally - compression.Free; - compressedStream.Free; - end; - end else - begin //decompress - decompressed := TMemoryStream.Create; - try - InternalCopyTo(decompressed); - FStream.Free; - FStream := decompressed; - decompressed := nil; - FFlags := FFlags xor MemDirectoryEntry_FlagCompressed; - finally - decompressed.Free; - end; - end; - end else - FFlags := FFlags xor MemDirectoryEntry_FlagCompressed; -end; - -function TMemDirectoryEntry.GetName: utf8string; -begin - result := FName; -end; - -procedure TMemDirectoryEntry.SetName(AValue: utf8string); -begin - while AValue[length(AValue)] = '.' do delete(AValue, length(AValue), 1); - FName := AValue; -end; - -function TMemDirectoryEntry.GetFileSize: int64; -begin - if IsDirectory then - result := 0 - else - Result:= FUncompressedSize; -end; - -function TMemDirectoryEntry.GetExtension: utf8string; -begin - Result:= FExtension; -end; - -function TMemDirectoryEntry.InternalCopyTo(ADestination: TStream): int64; -var - decomp: Tdecompressionstream; -begin - if not Assigned(FStream) then exit(0); - if IsCompressed then - begin - FStream.Position := 0; - decomp := Tdecompressionstream.Create(FStream,true); - try - result := ADestination.CopyFrom(decomp,FUncompressedSize); - finally - decomp.Free; - end; - end else - begin - FStream.Position := 0; - result := ADestination.CopyFrom(FStream, FStream.Size); - end; -end; - -function TMemDirectoryEntry.CopyTo(ADestination: TStream): int64; -begin - if IsDirectory then exit(0); - result := InternalCopyTo(ADestination); -end; - -function TMemDirectoryEntry.GetStream: TStream; -begin - if IsCompressed then - raise exception.Create('Stream cannot be accessed directly because it is compressed') - else - result := FStream; -end; - -constructor TMemDirectoryEntry.Create(AContainer: TMultiFileContainer; AFilename: TEntryFilename; - AUncompressedStream: TStream; AOwnStream: boolean); -begin - CreateFromData(AContainer, AFilename, AUncompressedStream, AOwnStream, AUncompressedStream.Size, 0); -end; - -constructor TMemDirectoryEntry.CreateFromData(AContainer: TMultiFileContainer; AFilename: TEntryFilename; - AStream: TStream; AOwnStream: boolean; - AUncompressedSize: int64; AFlags: Word); -begin - inherited Create(AContainer); - Name := AFilename.Name; - FExtension:= AFilename.Extension; - if AOwnStream then - FStream := AStream - else - begin - FStream := TMemoryStream.Create; - AStream.Position:= 0; - FStream.CopyFrom(AStream, AStream.Size); - end; - FUncompressedSize:= AUncompressedSize; - FFlags:= AFlags; - FMemDirectory := nil; -end; - -procedure TMemDirectoryEntry.SaveToEmbeddedStream(AEntryStream, ADataStream: TStream; - AStartPos: int64; out uncompressedSize: int64); -var - entryStartPos: Int64; -begin - if IsDirectory then - begin - if not Assigned(FMemDirectory) then - raise exception.Create('Directory not allocated'); - FreeAndNil(FStream); - IsCompressed:= false; - entryStartPos := AEntryStream.Position; - FMemDirectory.SaveToEmbeddedStream(AEntryStream, ADataStream, AStartPos); - uncompressedSize:= AEntryStream.Position - entryStartPos; - end else - if Assigned(FStream) then - begin - FStream.Position:= 0; - AEntryStream.CopyFrom(FStream, FStream.Size); - uncompressedSize:= FUncompressedSize; - end; -end; - -procedure TMemDirectoryEntry.LoadExtraFromEmbeddedStream(ADataStream: TStream; - AStartPos: int64); -begin - if IsDirectory and Assigned(FStream) then - begin - IsCompressed:= false; - if not Assigned(FMemDirectory) then - FMemDirectory := TMemDirectory.Create(Container as TMemDirectory); - FMemDirectory.LoadFromEmbeddedStream(FStream, ADataStream, AStartPos); - FreeAndNil(FStream); - end; -end; - -constructor TMemDirectoryEntry.CreateDirectory(AContainer: TMultiFileContainer; - AFilename: TEntryFilename); -begin - Name := AFilename.Name; - FExtension:= AFilename.Extension; - FStream := nil; - FUncompressedSize:= 0; - FFlags := MemDirectoryEntry_FlagDirectory; - FContainer := AContainer; - FMemDirectory := TMemDirectory.Create(Container as TMemDirectory); -end; - -destructor TMemDirectoryEntry.Destroy; -begin - FStream.Free; - FMemDirectory.Free; - inherited Destroy; -end; - -end. - diff --git a/components/bgrabitmap/bgramsegui.inc b/components/bgrabitmap/bgramsegui.inc deleted file mode 100644 index ad59c8e..0000000 --- a/components/bgrabitmap/bgramsegui.inc +++ /dev/null @@ -1,349 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type - TColor = msegraphutils.colorty; - -const - clNone = msegraphutils.cl_none; - clDefault = msegraphutils.cl_default; - clBlack = msegraphutils.cl_black; - clWhite = msegraphutils.cl_white; - -function ColorToRGB(c: TColor): TColor; -function clRgbBtnHighlight: TColor; -function clRgbBtnShadow: TColor; -function GetScreenDPIX: integer; -function GetScreenDPIY: integer; - -type - {* How to draw the end of line } - TPenEndCap = msegraphics.capstylety; - -const - {** Draw a half-disk at the end of the line. The diameter of the disk is - equal to the pen width. } - pecRound = msegraphics.cs_round; - {** Draw a half-square. The size of the square is equal to the pen width. - This is visually equivalent to extend the line of half the pen width } - pecSquare = msegraphics.cs_projecting; - {** The line ends exactly at the end point } - pecFlat = msegraphics.cs_butt; - -type - {* How to join segments. This makes sense only for geometric pens (that - have a certain width) } - TPenJoinStyle = msegraphics.joinstylety; - -const - {** Segments are joined by filling the gap with an arc } - pjsRound = msegraphics.js_round; - {** Segments are joind by filling the gap with an intermediary segment } - pjsBevel = msegraphics.js_bevel; - {** Segments are joined by extending them up to their intersection. - There is a miter limit so that if the intersection is too far, - an intermediary segment is used } - pjsMiter = msegraphics.js_miter; - -type - {* Style to use for the pen. The unit for the pattern is the width of the - line } - TPenStyle = msegraphics.dashesstringty; - TPenMode = msegraphics.rasteropty; - -const - {** Pen is continuous } - psSolid = TPenStyle(''); - {** Pen is dashed. The dash have a length of 3 unit and the gaps of 1 unit } - psDash = TPenStyle(#3#1); - {** Pen is dotted. The dots have a length of 1 unit and the gaps of 1 unit } - psDot = TPenStyle(#1#1); - {** Pattern is a dash of length 3 followed by a dot of length 1, separated by a gap of length 1 } - psDashDot = TPenStyle(#3#1#1#1); - {** Dash of length 3, and two dots of length 1 } - psDashDotDot = TPenStyle(#3#1#1#1#1#1); - - //the following are not directly compatible with mseGUI - {** Pen is not drawn } - psClear = TPenStyle(#0#0); - {** Custom pattern used } - psPattern = TPenStyle(#0#0#0#0); - - pmBlack = msegraphics.rop_clear; - pmWhite = msegraphics.rop_set; - pmNop = msegraphics.rop_nop; - pmNot = msegraphics.rop_not; - pmCopy = msegraphics.rop_copy; - pmNotCopy = msegraphics.rop_notcopy; - pmMergePenNot = msegraphics.rop_notor; - pmMaskPenNot = msegraphics.rop_notand; - pmMergeNotPen = msegraphics.rop_ornot; - pmMaskNotPen = msegraphics.rop_andnot; - pmMerge = msegraphics.rop_or; - pmNotMerge = msegraphics.rop_nor; - pmMask = msegraphics.rop_and; - pmNotMask = msegraphics.rop_nand; - pmXor = msegraphics.rop_xor; - pmNotXor = msegraphics.rop_notxor; - -type - TPen = class - private - FColor: TColor; - FMode: TPenMode; - FEndCap: TPenEndCap; - FJoinStyle: TPenJoinStyle; - FStyle: TPenStyle; - FWidth: integer; - public - constructor Create; - {** Color of the pen } - property Color: TColor read FColor write FColor; - {** Operation done on pixels } - property Mode: TPenMode read FMode write FMode; - {** End cap of the pen: how to draw the ends of the lines } - property EndCap: TPenEndCap read FEndCap write FEndCap; - {** Join style: how to join the segments of a polyline } - property JoinStyle: TPenJoinStyle read FJoinStyle write FJoinStyle; - {** Pen style: solid, dash, dot... } - property Style : TPenStyle read FStyle write FStyle; - {** Pen width in pixels } - property Width : Integer read FWidth write FWidth; - end; - - TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal, - bsBDiagonal, bsCross, bsDiagCross, bsImage, bsPattern); - -type - { TBrush } - {* A class describing a brush } - TBrush = class - private - FColor: TColor; - FStyle: TBrushStyle; - public - constructor Create; - {** Color of the brush } - property Color: TColor read FColor write FColor; - {** Style of the brush: solid, diagonal lines, horizontal lines... } - property Style: TBrushStyle read FStyle write FStyle; - end; - -type - {$DEFINE TCanvas} - TCanvas = msegraphics.tcanvas; - {$DEFINE TBitmap} - TBitmap = msebitmap.tbitmap; - TRawImage = TBitmap; - TFont = msegraphics.tfont; - {$DEFINE TFontStyle} - TFontStyle = msegraphutils.fontstylety; - TFontStyles = msegraphutils.fontstylesty; - - TBitmapHelper = class helper for TBitmap - private - function GetTransparent: boolean; - function GetTransparentMode: TTransparentMode; - function GetTransparentColor: TColor; - public - class function Create: TBitmap; overload; - property Transparent: boolean read GetTransparent; - property TransparentMode: TTransparentMode read GetTransparentMode; - property TransparentColor: TColor read GetTransparentColor; - end; - - TCanvasHelper = class helper for TCanvas - procedure Draw(X,Y: integer; AGraphic: TGraphic); overload; - procedure StretchDraw(ARect: TRect; AGraphic: TGraphic); overload; - procedure Draw(X,Y: integer; ABitmap: TBitmap); overload; - procedure StretchDraw(ARect: TRect; ABitmap: TBitmap); overload; - end; - - {$DEFINE TFontQuality} - TFontQuality = (fqDefault, fqNonAntialiased, fqAntialiased, fqCleartype); - - TFontHelper = class helper for TFont - private - function GetOrientation: integer; - procedure SetOrientation(AOrientation: integer); - function GetFontQuality: TFontQuality; - procedure SetFontQuality(AQuality: TFontQuality); - function GetHeightHelper: integer; - procedure SetHeightHelper(AHeight: integer); - public - property Orientation: integer read GetOrientation write SetOrientation; - property Quality: TFontQuality read GetFontQuality write SetFontQuality; - property Height: integer read GetHeightHelper write SetHeightHelper; - end; - -const - fsBold = msegraphutils.fs_bold; - fsItalic = msegraphutils.fs_italic; - fsUnderline = msegraphutils.fs_underline; - fsStrikeOut = msegraphutils.fs_strikeout; - -operator :=(AClassesPoint: TClassesPoint): TPoint; -operator :=(AMSERect: TMSERect): TRect; -operator :=(ARect: TRect): TMSERect; -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} -function ColorToRGB(c: TColor): TColor; -var triple: rgbtriplety; -begin - triple := msegraphics.colortorgb(c); - result := msegraphics.rgbtocolor(triple.red, triple.green, triple.blue); -end; - -function clRgbBtnHighlight: TColor; -begin - result := ColorToRGB(msegraphutils.cl_highlight); -end; - -function clRgbBtnShadow: TColor; -begin - result := ColorToRGB(msegraphutils.cl_shadow); -end; - -function GetScreenDPIX: integer; -begin - result := 96; -end; - -function GetScreenDPIY: integer; -begin - result := 96; -end; - -{ TPen } - -constructor TPen.Create; -begin - inherited Create; - Mode := pmCopy; - Style := psSolid; - Width := 1; - Color := cl_black; - EndCap:= pecRound; - JoinStyle:= pjsRound; -end; - -{ TBrush } - -constructor TBrush.Create; -begin - Color := cl_white; - Style := bsSolid; -end; - -operator :=(AClassesPoint: TClassesPoint): TPoint; -begin - result.x := AClassesPoint.X; - result.y := AClassesPoint.Y; -end; - -operator :=(AMSERect: TMSERect): TRect; -begin - result.Left := AMSERect.x; - result.Top := AMSERect.y; - result.Right:= AMSERect.x + AMSERect.cx; - result.Bottom:= AMSERect.y + AMSERect.cy; -end; - -operator :=(ARect: TRect): TMSERect; -begin - result.x := ARect.Left; - result.y := ARect.Top; - result.cx := ARect.Right - ARect.Left; - result.cy := ARect.Bottom - ARect.Top; -end; - -class function TBitmapHelper.Create: TBitmap; -begin - result := TBitmap.Create(bmk_rgb); -end; - -function TBitmapHelper.GetTransparent: boolean; -begin - result := TransparentColor <> clNone; -end; - -function TBitmapHelper.GetTransparentMode: TTransparentMode; -begin - if TMaskedBitmap(self).TransparentColor = clDefault then - result := tmAuto - else - result := tmFixed; -end; - -function TBitmapHelper.GetTransparentColor: TColor; -begin - if self is TMaskedBitmap then - result := TMaskedBitmap(self).TransparentColor - else result := clNone; -end; - -procedure TCanvasHelper.Draw(X,Y: integer; ABitmap: TBitmap); -begin - ABitmap.Paint(Self, Point(X,Y)); -End; - -procedure TCanvasHelper.StretchDraw(ARect: TRect; ABitmap: TBitmap); -begin - ABitmap.Paint(Self, ARect); -End; - -procedure TCanvasHelper.Draw(X,Y: integer; AGraphic: TGraphic); -begin - AGraphic.Draw(self, rect(x,y,x+AGraphic.Width,y+AGraphic.Height)); -End; - -procedure TCanvasHelper.StretchDraw(ARect: TRect; AGraphic: TGraphic); -begin - AGraphic.Draw(self, ARect); -End; - -function TFontHelper.GetOrientation: integer; -begin - result := 0; -end; - -procedure TFontHelper.SetOrientation(AOrientation: integer); -begin - if AOrientation <> 0 then - raise exception.Create('Only orientation 0 allowed at font level'); -end; - -function TFontHelper.GetFontQuality: TFontQuality; -begin - if foo_antialiased2 in options then result := fqClearType else - if foo_antialiased in options then result := fqAntialiased else - if foo_nonantialiased in options then result := fqNonAntialiased else - result := fqDefault; -end; - -procedure TFontHelper.SetFontQuality(AQuality: TFontQuality); -begin - options := options - [foo_nonantialiased, foo_antialiased, foo_antialiased2]; - case AQuality of - fqNonAntialiased: options := options + [foo_nonantialiased]; - fqAntialiased: options := options + [foo_antialiased]; - fqClearType: options := options + [foo_antialiased2]; - end; -end; - -function TFontHelper.GetHeightHelper: integer; -begin - result := round(inherited Height * 1.5); -end; - -procedure TFontHelper.SetHeightHelper(AHeight: integer); -begin - if AHeight < 0 then - inherited Height := -AHeight - else - inherited Height := round(AHeight/1.5); -end; - -{$ENDIF} diff --git a/components/bgrabitmap/bgramsegui_text.inc b/components/bgrabitmap/bgramsegui_text.inc deleted file mode 100644 index d39fde7..0000000 --- a/components/bgrabitmap/bgramsegui_text.inc +++ /dev/null @@ -1,80 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -procedure BitmapTextOut(ABitmap: TBitmap; ACoord: TPoint; AText: string); -var sUTF16: UnicodeString; -begin - sUTF16 := UTF8ToUTF16(AText); - inc(ACoord.Y, ABitmap.Canvas.Font.GlyphHeight-1); - ABitmap.Canvas.DrawString(sUTF16, ACoord); -end; - -procedure BitmapTextOutAngle(ABitmap: TBitmap; ACoord: TPoint; AText: string; AOrientation: integer); -var sUTF16: UnicodeString; - angleRad: single; - ofs, center: TPointF; -begin - angleRad := AOrientation*Pi/1800; - ofs := PointF(ACoord.X, ACoord.Y) + - PointF(sin(angleRad), cos(angleRad))*(ABitmap.Canvas.Font.GlyphHeight-1); - sUTF16 := UTF8ToUTF16(AText); - center := PointF(ABitmap.Canvas.GetStringWidth(sUTF16)/2, - ABitmap.Canvas.Font.Height/2); - ABitmap.Canvas.DrawString(sUTF16, Point(round(ofs.X), round(ofs.Y)), - nil, false, angleRad); -end; - -procedure BitmapTextRect(ABitmap: TBitmap; ARect: TRect; ACoord: TPoint; - AText: string; const AStyle: TTextStyle); -var sUTF16: UnicodeString; -begin - sUTF16 := UTF8ToUTF16(AText); - case AStyle.Alignment of - taRightJustify: ACoord.X := ARect.Right - ABitmap.Canvas.GetStringWidth(sUTF16); - taCenter: ACoord.X := ARect.Left + (ARect.Width - ABitmap.Canvas.GetStringWidth(sUTF16)) div 2; - end; - case AStyle.Layout of - tlBottom: ACoord.Y := ARect.Bottom - ABitmap.Canvas.Font.Height; - tlCenter: ACoord.Y := ARect.Top + (ARect.Height - ABitmap.Canvas.Font.Height) div 2; - end; - inc(ACoord.Y, ABitmap.Canvas.Font.GlyphHeight-1); - ABitmap.Canvas.DrawString(sUTF16, ACoord); -end; - -function BitmapTextExtent(ABitmap: TBitmap; AText: string): TSize; -var sUTF16: UnicodeString; -begin - sUTF16 := UTF8ToUTF16(AText); - result := Size(ABitmap.Canvas.GetStringWidth(sUTF16), ABitmap.Canvas.Font.Height); -end; - -function BitmapTextExtentAngle(ABitmap: TBitmap; AText: string; AOrientation: integer): TSize; -begin - result := BitmapTextExtent(ABitmap, AText); -end; - -function BitmapTextFitInfo(ABitmap: TBitmap; AText: string; AMaxWidth: integer): integer; -var - bytePos, charLen: integer; - sUTF16: UnicodeString; -begin - result := 0; - bytePos := 1; - while bytePos <= length(AText) do - begin - charLen := UTF8CharacterLength(@AText[bytePos]); - sUTF16 := UTF8ToUTF16(copy(AText, 1, bytePos+charLen-1)); - if ABitmap.Canvas.GetStringWidth(sUTF16) > AMaxWidth then break; - inc(result); - inc(bytePos,charLen); - end; -end; - -function BitmapTextFitInfoAngle(ABitmap: TBitmap; AText: string; - AMaxWidth: integer; AOrientation: integer): integer; -begin - result := BitmapTextFitInfo(ABitmap, AText, AMaxWidth); -end; - -procedure BitmapFillRect(ABitmap: TBitmap; ARect: TRect; AColor: TColor); -begin - ABitmap.Canvas.FillRect(ARect, AColor); -end; diff --git a/components/bgrabitmap/bgramsegui_uses.inc b/components/bgrabitmap/bgramsegui_uses.inc deleted file mode 100644 index c54e7af..0000000 --- a/components/bgrabitmap/bgramsegui_uses.inc +++ /dev/null @@ -1 +0,0 @@ -uses BGRAClasses, FPimage, msegraphics, msegraphutils, msebitmap; diff --git a/components/bgrabitmap/bgramseguibitmap.pas b/components/bgrabitmap/bgramseguibitmap.pas deleted file mode 100644 index 06394f0..0000000 --- a/components/bgrabitmap/bgramseguibitmap.pas +++ /dev/null @@ -1,255 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAMSEguiBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap, - BGRAText, msebitmap; - -type - - { TBGRAMSEguiBitmap } - - TBGRAMSEguiBitmap = class(TBGRADefaultBitmap) - protected - procedure CopyDataToBitmap(AData: Pointer; AWidth,AHeight: integer; ALineOrder: TRawImageLineOrder; ABitmap: TBitmap); - procedure RebuildBitmap; override; - procedure DoLoadFromBitmap; override; - function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; - function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte; - {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean - =True): boolean; override; - procedure FreeBitmap; override; - procedure NotAvailable; - procedure InternalAssignBitmapPixels(ASource: TBitmap); - function GetCanvas: TCanvas; override; - public - procedure Assign(ASource: TPersistent); override; - destructor Destroy; override; - procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available - procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; - {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; - procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; - {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; - procedure TakeScreenshot({%H-}ARect: TRect); override; //not available - procedure TakeScreenshotOfPrimaryMonitor; override; //not available - procedure LoadFromDevice({%H-}DC: HDC); override; //not available - procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available - end; - -type - { TBitmapTracker } - - TBitmapTracker = class(TMaskedBitmap) - protected - FUser: TBGRADefaultBitmap; - procedure DoChange; override; - public - constructor Create(AUser: TBGRADefaultBitmap); overload; - end; - -implementation - -uses msegraphics, msegraphutils, math; - -{ TBitmapTracker } - -constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap); -begin - FUser := AUser; - inherited Create(bmk_rgb); -end; - -procedure TBitmapTracker.DoChange; -begin - if FUser <> nil then - FUser.NotifyBitmapChange; - inherited DoChange; -end; - -{ TBGRAMSEguiBitmap } - -procedure TBGRAMSEguiBitmap.CopyDataToBitmap(AData: Pointer; AWidth,AHeight: integer; ALineOrder: TRawImageLineOrder; ABitmap: TBitmap); -var - ppix: PLongword; - pbmp: PLongword; - pmask: PByte; - x,y,yBmp : integer; - setMask: boolean; -begin - ABitmap.Size := Size(AWidth, AHeight); - ppix := AData; - pmask := nil; - if ABitmap is TMaskedBitmap then - begin - setMask := true; - TMaskedBitmap(ABitmap).Masked := true; - TMaskedBitmap(ABitmap).MaskKind := bmk_gray; - end else - setMask := false; - for y := 0 to Height-1 do - begin - if ALineOrder = riloTopToBottom then - yBmp := y else yBmp := Height-1-y; - pbmp := ABitmap.Scanline[yBmp]; - if setMask then pmask := TMaskedBitmap(ABitmap).Mask.Scanline[yBmp]; - for x := 0 to Width-1 do - begin - pbmp^ := ppix^ and $ffffff; - if setMask then - begin - pmask^ := ppix^ shr 24; - inc(pmask); - end; - inc(ppix); - inc(pbmp); - end; - end; -end; - -procedure TBGRAMSEguiBitmap.RebuildBitmap; -begin - if FBitmap = nil then - FBitmap := TBitmapTracker.Create(self); - - CopyDataToBitmap(Data, Width, Height, LineOrder, FBitmap); -end; - -procedure TBGRAMSEguiBitmap.InternalAssignBitmapPixels(ASource: TBitmap); -var - ppix,pbmp: PLongword; - pmask: PByte; - getMask: boolean; - x,y,wm1: integer; -begin - if ASource is TMaskedBitmap then - getMask := TMaskedBitmap(ASource).Masked - else getMask := false; - wm1 := min(Width-1, ASource.Width-1); - for y := 0 to min(Height-1, ASource.Height-1) do - begin - ppix := plongword(GetScanlineFast(y)); - pbmp := ASource.Scanline[y]; - if getMask then pmask := TMaskedBitmap(ASource).Mask.Scanline[y]; - for x := 0 to wm1 do - begin - if getMask then - begin - ppix^ := (pbmp^ and $ffffff) or (pmask^ shl 24); - inc(pmask); - end else - ppix^ := (pbmp^ and $ffffff) or $ff000000; - inc(ppix); - inc(pbmp); - end; - end; -end; - -function TBGRAMSEguiBitmap.GetCanvas: TCanvas; -begin - result := inherited GetCanvas; - NotifyBitmapChange; -end; - -procedure TBGRAMSEguiBitmap.Assign(ASource: TPersistent); -var bmp: TBitmap; -begin - if ASource is TBitmap then - begin - bmp := TBitmap(ASource); - SetSize(bmp.Width, bmp.Height); - InternalAssignBitmapPixels(bmp); - InvalidateBitmap; - end else - inherited Assign(ASource); -end; - -procedure TBGRAMSEguiBitmap.DoLoadFromBitmap; -begin - if Assigned(FBitmap) then - InternalAssignBitmapPixels(FBitmap); -end; - -function TBGRAMSEguiBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; -begin - result := TMSEFontRenderer.Create; -end; - -function TBGRAMSEguiBitmap.LoadFromRawImage(ARawImage: TRawImage; - DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; - RaiseErrorOnInvalidPixelFormat: boolean): boolean; -begin - self.Assign(ARawImage); - result := true; -end; - -procedure TBGRAMSEguiBitmap.FreeBitmap; -begin - FreeAndNil(FBitmap); -end; - -procedure TBGRAMSEguiBitmap.NotAvailable; -begin - raise exception.Create('Function not available with MSEgui'); -end; - -destructor TBGRAMSEguiBitmap.Destroy; -begin - inherited Destroy; -end; - -procedure TBGRAMSEguiBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, - y: integer); -begin - (Bitmap as TMaskedBitmap).Masked := false; - Bitmap.Canvas.CopyArea(CanvasSource, MakeRect(x,y,Bitmap.Width,Bitmap.Height), - Point(0,0)); -end; - -procedure TBGRAMSEguiBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - bmp: TMaskedBitmap; -begin - bmp := TMaskedBitmap.Create(bmk_rgb); - CopyDataToBitmap(Data, Width, Height, ALineOrder, bmp); - bmp.Paint(ACanvas, Rect); - bmp.Free; -end; - -procedure TBGRAMSEguiBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - bmp: TBitmap; -begin - bmp := TBitmap.Create(bmk_rgb); - CopyDataToBitmap(AData, AWidth, AHeight, ALineOrder, bmp); - bmp.Paint(ACanvas, Rect); - bmp.Free; -end; - -procedure TBGRAMSEguiBitmap.TakeScreenshot(ARect: TRect); -begin - NotAvailable; -end; - -procedure TBGRAMSEguiBitmap.TakeScreenshotOfPrimaryMonitor; -begin - NotAvailable; -end; - -procedure TBGRAMSEguiBitmap.LoadFromDevice(DC: HDC); -begin - NotAvailable; -end; - -procedure TBGRAMSEguiBitmap.LoadFromDevice(DC: HDC; ARect: TRect); -begin - NotAvailable; -end; - -end. - diff --git a/components/bgrabitmap/bgramultifiletype.pas b/components/bgrabitmap/bgramultifiletype.pas deleted file mode 100644 index faa5cb2..0000000 --- a/components/bgrabitmap/bgramultifiletype.pas +++ /dev/null @@ -1,500 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAMultiFileType; - -{$mode objfpc}{$H+} -{$MODESWITCH ADVANCEDRECORDS} - -interface - -uses - BGRAClasses, SysUtils, fgl; - -type - - { TEntryFilename } - - TEntryFilename = record - private - FExtension: utf8string; - FName: utf8string; - function GetFilename: utf8string; - function GetIsEmpty: boolean; - procedure SetExtension(AValue: utf8string); - procedure SetFilename(AValue: utf8string); - procedure SetName(AValue: utf8string); - public - class operator =(const AValue1,AValue2: TEntryFilename): boolean; - property Filename: utf8string read GetFilename write SetFilename; - property Name: utf8string read FName write SetName; - property Extension: utf8string read FExtension write SetExtension; - property IsEmpty: boolean read GetIsEmpty; - end; - -function EntryFilename(AName,AExtension: string): TEntryFilename; overload; -function EntryFilename(AFilename: string): TEntryFilename; overload; - -type - TMultiFileContainer = class; - - { TMultiFileEntry } - - TMultiFileEntry = class - protected - FContainer: TMultiFileContainer; - function GetName: utf8string; virtual; abstract; - procedure SetName(AValue: utf8string); virtual; abstract; - function GetFileSize: int64; virtual; - function GetExtension: utf8string; virtual; - public - constructor Create(AContainer: TMultiFileContainer); - function CopyTo({%H-}ADestination: TStream): int64; virtual; - function GetStream: TStream; virtual; - function CompareNameAndExtension(AName: utf8string; AExtension: utf8string; ACaseSensitive: boolean = true): integer; - property Name: utf8string read GetName write SetName; - property Extension: utf8string read GetExtension; - property FileSize: int64 read GetFileSize; - property Container: TMultiFileContainer read FContainer; - end; - - TMultiFileEntryList = specialize TFPGList; - - { TMultiFileContainer } - - TMultiFileContainer = class(TPersistent) - private - FEntries: TMultiFileEntryList; - protected - procedure Init; virtual; - function AddEntry(AEntry: TMultiFileEntry; AIndex: integer = -1): integer; - function GetCount: integer; - function GetEntry(AIndex: integer): TMultiFileEntry; - function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; virtual; abstract; - function GetRawString(AIndex: integer): RawByteString; - function GetRawStringByFilename(AFilename: string): RawByteString; - procedure SetRawString(AIndex: integer; AValue: RawByteString); - procedure SetRawStringByFilename(AFilename: string; AValue: RawByteString); - public - constructor Create; overload; - constructor Create(AFilename: utf8string); overload; - constructor Create(AStream: TStream); overload; - constructor Create(AStream: TStream; AStartPos: Int64); overload; - procedure Assign(Source: TPersistent); override; - function Add(AName: utf8string; AExtension: utf8string; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload; - function Add(AName: utf8string; AExtension: utf8string; AContent: RawByteString; AOverwrite: boolean = false): integer; overload; - function Add(AFilename: TEntryFilename; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload; - function Add(AFilename: TEntryFilename; AContent: RawByteString; AOverwrite: boolean = false): integer; overload; - procedure Clear; virtual; - destructor Destroy; override; - procedure LoadFromFile(AFilename: utf8string); - procedure LoadFromStream(AStream: TStream); virtual; abstract; - procedure LoadFromResource(AFilename: string); virtual; - procedure SaveToFile(AFilename: utf8string); - procedure SaveToStream(ADestination: TStream); virtual; abstract; - procedure Remove(AEntry: TMultiFileEntry); virtual; - procedure Delete(AIndex: integer); overload; virtual; - function Delete(AName: utf8string; AExtension: utf8string; ACaseSensitive: boolean = True): boolean; overload; - function Delete(AFilename: TEntryFilename; ACaseSensitive: boolean = True): boolean; overload; - function IndexOf(AEntry: TMultiFileEntry): integer; overload; - function IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean = True): integer; overload; virtual; - function IndexOf(AFilename: TEntryFilename; ACaseSensitive: boolean = True): integer; overload; - property Count: integer read GetCount; - property Entry[AIndex: integer]: TMultiFileEntry read GetEntry; - property RawString[AIndex: integer]: RawByteString read GetRawString write SetRawString; - property RawStringByFilename[AFilename: string]: RawByteString read GetRawStringByFilename write SetRawStringByFilename; - end; - -implementation - -uses BGRAUTF8, strutils, BGRABitmapTypes; - -{ TEntryFilename } - -function TEntryFilename.GetFilename: utf8string; -begin - if Extension = '' then - result := Name - else - result := Name+'.'+Extension; -end; - -function TEntryFilename.GetIsEmpty: boolean; -begin - result := (FName='') and (FExtension = ''); -end; - -procedure TEntryFilename.SetExtension(AValue: utf8string); -var - i: Integer; -begin - if FExtension=AValue then Exit; - for i := 1 to length(AValue) do - if AValue[i] in ['.','/'] then - raise Exception.Create('Invalid extension'); - FExtension:=AValue; -end; - -procedure TEntryFilename.SetFilename(AValue: utf8string); -var - idxDot: SizeInt; -begin - idxDot := RPos('.',AValue); - if idxDot = 0 then - begin - Name := AValue; - Extension := ''; - end - else - begin - Name := copy(AValue,1,idxDot-1); - Extension := copy(AValue,idxDot+1,length(AValue)-idxDot); - end; -end; - -procedure TEntryFilename.SetName(AValue: utf8string); -var - i: Integer; -begin - if FName=AValue then Exit; - for i := 1 to length(AValue) do - if AValue[i] = '/' then - raise Exception.Create('Invalid name'); - FName:=AValue; -end; - -function EntryFilename(AName, AExtension: string): TEntryFilename; -begin - result.Name := AName; - result.Extension:= AExtension; -end; - -function EntryFilename(AFilename: string): TEntryFilename; -begin - result.Filename:= AFilename; -end; - -class operator TEntryFilename.=(const AValue1, AValue2: TEntryFilename): boolean; -begin - result := (AValue1.Name = AValue2.Name) and (AValue1.Extension = AValue2.Extension); -end; - -{ TMultiFileEntry } - -function TMultiFileEntry.GetFileSize: int64; -begin - result := 0; -end; - -function TMultiFileEntry.GetExtension: utf8string; -begin - result := ''; -end; - -constructor TMultiFileEntry.Create(AContainer: TMultiFileContainer); -begin - FContainer := AContainer; -end; - -function TMultiFileEntry.CopyTo(ADestination: TStream): int64; -begin - result := 0; -end; - -function TMultiFileEntry.GetStream: TStream; -begin - result := nil; -end; - -function TMultiFileEntry.CompareNameAndExtension(AName: utf8string; - AExtension: utf8string; ACaseSensitive: boolean): integer; -begin - if ACaseSensitive then - result := CompareStr(AName, Name) - else - result := UTF8CompareText(AName, Name); - - if result = 0 then - result := UTF8CompareText(AExtension, Extension); -end; - -{ TMultiFileContainer } - -function TMultiFileContainer.GetCount: integer; -begin - if Assigned(FEntries) then - result := FEntries.Count - else - result := 0; -end; - -function TMultiFileContainer.GetEntry(AIndex: integer): TMultiFileEntry; -begin - result := FEntries[AIndex]; -end; - -function TMultiFileContainer.GetRawString(AIndex: integer): RawByteString; -var s: TMemoryStream; -begin - s := TMemoryStream.Create; - try - Entry[AIndex].CopyTo(s); - setlength(result, s.Size); - if length(result)>0 then - move(s.Memory^, result[1], length(result)); - finally - s.Free; - end; -end; - -function TMultiFileContainer.GetRawStringByFilename(AFilename: string - ): RawByteString; -var - idx: Integer; -begin - idx := IndexOf(EntryFilename(AFilename)); - if idx = -1 then - result := '' - else - result := GetRawString(idx); -end; - -procedure TMultiFileContainer.SetRawString(AIndex: integer; - AValue: RawByteString); -begin - with Entry[AIndex] do - Add(Name, Extension, AValue, true); -end; - -procedure TMultiFileContainer.SetRawStringByFilename(AFilename: string; - AValue: RawByteString); -var - f: TEntryFilename; -begin - f := EntryFilename(AFilename); - Add(f.Name,f.Extension,AValue,true); -end; - -procedure TMultiFileContainer.Init; -begin - FEntries := TMultiFileEntryList.Create; -end; - -function TMultiFileContainer.AddEntry(AEntry: TMultiFileEntry; AIndex: integer): integer; -begin - if not Assigned(FEntries) then - raise exception.Create('Entry list not created'); - if (AIndex >= 0) and (AIndex < FEntries.Count) then - begin - FEntries.Insert(AIndex, AEntry); - result := AIndex; - end - else - result := FEntries.Add(AEntry); -end; - -constructor TMultiFileContainer.Create; -begin - Init; -end; - -constructor TMultiFileContainer.Create(AFilename: utf8string); -begin - Init; - LoadFromFile(AFilename); -end; - -constructor TMultiFileContainer.Create(AStream: TStream); -begin - Init; - LoadFromStream(AStream); -end; - -constructor TMultiFileContainer.Create(AStream: TStream; AStartPos: Int64); -begin - Init; - AStream.Position := AStartPos; - LoadFromStream(AStream); -end; - -procedure TMultiFileContainer.Assign(Source: TPersistent); -var - other: TMultiFileContainer; - otherEntry, newEntry: TMultiFileEntry; - i: Integer; - content: TMemoryStream; -begin - if Source is TMultiFileContainer then - begin - Clear; - other := TMultiFileContainer(Source); - for i := 0 to other.Count-1 do - begin - content := TMemoryStream.Create; - otherEntry := other.Entry[i]; - otherEntry.CopyTo(content); - newEntry := CreateEntry(otherEntry.Name, otherEntry.Extension, content); - if not Assigned(newEntry) then - raise exception.Create('Unable to create entry'); - AddEntry(newEntry); - end; - end else - inherited Assign(Source); -end; - -function TMultiFileContainer.Add(AName: utf8string; AExtension: utf8string; - AContent: TStream; AOverwrite: boolean; AOwnStream: boolean): integer; -var - index: Integer; - newEntry: TMultiFileEntry; - contentCopy: TMemoryStream; -begin - index := IndexOf(AName,AExtension); - if index <> -1 then - begin - if AOverwrite then - Delete(index) - else - raise Exception.Create('Duplicate entry'); - end; - if not AOwnStream then - begin - AContent.Position:= 0; - contentCopy := TMemoryStream.Create; - contentCopy.CopyFrom(AContent, AContent.Size); - newEntry := CreateEntry(AName, AExtension, contentCopy); - end else - newEntry := CreateEntry(AName, AExtension, AContent); - if Assigned(newEntry) then - result := AddEntry(newEntry, index) - else - raise exception.Create('Unable to create entry'); -end; - -function TMultiFileContainer.Add(AName: utf8string; AExtension: utf8string; - AContent: RawByteString; AOverwrite: boolean): integer; -var stream: TMemoryStream; -begin - stream := TMemoryStream.Create; - if length(AContent) > 0 then stream.Write(AContent[1],length(AContent)); - result := Add(AName,AExtension,stream,AOverwrite); -end; - -function TMultiFileContainer.Add(AFilename: TEntryFilename; AContent: TStream; - AOverwrite: boolean; AOwnStream: boolean): integer; -begin - result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite, AOwnStream); -end; - -function TMultiFileContainer.Add(AFilename: TEntryFilename; - AContent: RawByteString; AOverwrite: boolean): integer; -begin - result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite); -end; - -destructor TMultiFileContainer.Destroy; -begin - Clear; - FreeAndNil(FEntries); - inherited Destroy; -end; - -procedure TMultiFileContainer.LoadFromFile(AFilename: utf8string); -var stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(AFilename, fmOpenRead); - LoadFromStream(stream); - stream.Free; -end; - -procedure TMultiFileContainer.LoadFromResource(AFilename: string); -var - stream: TStream; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - LoadFromStream(stream); - finally - stream.Free; - end; -end; - -procedure TMultiFileContainer.SaveToFile(AFilename: utf8string); -var stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(AFilename, fmCreate); - SaveToStream(stream); - stream.Free; -end; - -procedure TMultiFileContainer.Remove(AEntry: TMultiFileEntry); -var - index: Integer; -begin - index := IndexOf(AEntry); - if index = -1 then - raise exception.Create('Entry not found'); - Delete(index); -end; - -procedure TMultiFileContainer.Delete(AIndex: integer); -begin - if (AIndex >= 0) and (AIndex < Count) then - begin - Entry[AIndex].Free; - FEntries.Delete(AIndex); - end else - raise ERangeError.Create('Index out of bounds'); -end; - -function TMultiFileContainer.Delete(AName: utf8string; AExtension: utf8string; - ACaseSensitive: boolean): boolean; -var - index: Integer; -begin - index := IndexOf(AName, AExtension, ACaseSensitive); - if index = -1 then - result := false - else - begin - Delete(index); - result := true; - end; -end; - -function TMultiFileContainer.Delete(AFilename: TEntryFilename; - ACaseSensitive: boolean): boolean; -begin - result := Delete(AFilename.Name,AFilename.Extension,ACaseSensitive); -end; - -function TMultiFileContainer.IndexOf(AEntry: TMultiFileEntry): integer; -begin - result := FEntries.IndexOf(AEntry); -end; - -function TMultiFileContainer.IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean): integer; -var - i: Integer; -begin - for i := 0 to Count-1 do - if Entry[i].CompareNameAndExtension(AName, AExtenstion, ACaseSensitive) = 0 then - exit(i); - result := -1; -end; - -function TMultiFileContainer.IndexOf(AFilename: TEntryFilename; - ACaseSensitive: boolean): integer; -begin - result := IndexOf(AFilename.Name,AFilename.Extension,ACaseSensitive); -end; - -procedure TMultiFileContainer.Clear; -var - i: Integer; -begin - for i := 0 to FEntries.Count-1 do - FEntries.Items[i].Free; - FEntries.Clear; -end; - -end. - diff --git a/components/bgrabitmap/bgranogui.inc b/components/bgrabitmap/bgranogui.inc deleted file mode 100644 index eb1ef96..0000000 --- a/components/bgrabitmap/bgranogui.inc +++ /dev/null @@ -1,80 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type - TColor = type LongInt; - {$warnings off} - TRawImage = class(TFPMemoryImage) - procedure BGRASetSizeAndTransparency(AWidth,AHeight: Integer; {%H-}ATransparent: boolean); - constructor Create; - end; - {$warnings on} - TGUICanvas = class(TFPImageCanvas) - procedure DrawImage(x,y: integer; AImage: TFPCustomImage); - end; - -const - clNone = TColor($1FFFFFFF); - clDefault = TColor($20000000); - clBlack = TColor($000000); - clMaroon = TColor($000080); - clGreen = TColor($008000); - clOlive = TColor($008080); - clNavy = TColor($800000); - clPurple = TColor($800080); - clTeal = TColor($808000); - clGray = TColor($808080); - clSilver = TColor($C0C0C0); - clRed = TColor($0000FF); - clLime = TColor($00FF00); - clYellow = TColor($00FFFF); - clBlue = TColor($FF0000); - clFuchsia = TColor($FF00FF); - clAqua = TColor($FFFF00); - clLtGray = TColor($C0C0C0); // clSilver alias - clDkGray = TColor($808080); // clGray alias - clWhite = TColor($FFFFFF); - - clRgbBtnHighlight = TColor($E0E0E0); - clRgbBtnShadow = TColor($808080); - -function ColorToRGB(c: TColor): TColor; inline; - -function GetScreenDPIX: integer; -function GetScreenDPIY: integer; - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} -procedure TRawImage.BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean); -begin - SetSize(AWidth,AHeight); -end; - -constructor TRawImage.Create; -begin - inherited Create(0,0); -end; - -procedure TGUICanvas.DrawImage(x,y: integer; AImage: TFPCustomImage); -begin - Draw(x,y, AImage); -end; - -function ColorToRGB(c: TColor): TColor; inline; -begin - result := c; -end; - -function GetScreenDPIX: integer; -begin - result := 96; -end; - -function GetScreenDPIY: integer; -begin - result := 96; -end; - -{$ENDIF} diff --git a/components/bgrabitmap/bgranogui_uses.inc b/components/bgrabitmap/bgranogui_uses.inc deleted file mode 100644 index 9c4e4fd..0000000 --- a/components/bgrabitmap/bgranogui_uses.inc +++ /dev/null @@ -1 +0,0 @@ -uses BGRAClasses, FPImage, FPCanvas, FPImgCanv; diff --git a/components/bgrabitmap/bgranoguibitmap.pas b/components/bgrabitmap/bgranoguibitmap.pas deleted file mode 100644 index e7b9218..0000000 --- a/components/bgrabitmap/bgranoguibitmap.pas +++ /dev/null @@ -1,163 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRANoGUIBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap, - BGRAFreeType, EasyLazFreeType, LazFreeTypeFontCollection, - BGRACanvas; - -type - - { TBGRANoGUIBitmap } - - TBGRANoGUIBitmap = class(TBGRADefaultBitmap) - private - FPseudoCanvas: TBGRACanvas; - function GetPseudoCanvas: TBGRACanvas; - protected - procedure RebuildBitmap; override; - function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; - function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte; - {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean - =True): boolean; override; - procedure Init; override; - procedure FreeBitmap; override; - procedure NotAvailable; - public - destructor Destroy; override; - class procedure AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean = false); static; - class procedure AddFreeTypeFontFile(AFilename: string; AUTF8: boolean = false); static; - procedure Draw(ACanvas: TCanvas; x, y: integer; {%H-}Opaque: boolean=True); override; - procedure Draw(ACanvas: TCanvas; Rect: TRect; {%H-}Opaque: boolean=True); override; - procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available - procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; - {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; - procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer; - {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; - procedure TakeScreenshot({%H-}ARect: TRect); override; //not available - procedure TakeScreenshotOfPrimaryMonitor; override; //not available - procedure LoadFromDevice({%H-}DC: HDC); override; //not available - procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available - property Canvas: TBGRACanvas read GetPseudoCanvas; - end; - -implementation - -{ TBGRANoGUIBitmap } - -function TBGRANoGUIBitmap.GetPseudoCanvas: TBGRACanvas; -begin - if FPseudoCanvas = nil then - begin - FPseudoCanvas := TBGRACanvas.Create(self); - FPseudoCanvas.AntialiasingMode := amOff; - end; - result := FPseudoCanvas; -end; - -procedure TBGRANoGUIBitmap.RebuildBitmap; -begin - //nothing -end; - -function TBGRANoGUIBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer; -begin - result := TBGRAFreeTypeFontRenderer.Create; -end; - -function TBGRANoGUIBitmap.LoadFromRawImage(ARawImage: TRawImage; - DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; - RaiseErrorOnInvalidPixelFormat: boolean): boolean; -begin - NotAvailable; - result := false; -end; - -procedure TBGRANoGUIBitmap.Init; -begin - inherited Init; - FontAntialias:= true; -end; - -procedure TBGRANoGUIBitmap.FreeBitmap; -begin - //nothing -end; - -procedure TBGRANoGUIBitmap.NotAvailable; -begin - raise exception.Create('Function not available without GUI'); -end; - -destructor TBGRANoGUIBitmap.Destroy; -begin - FreeAndNil(FPseudoCanvas); - inherited Destroy; -end; - -class procedure TBGRANoGUIBitmap.AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean); -begin - if AUTF8 then ADirectory:= Utf8ToAnsi(ADirectory); - EasyLazFreeType.FontCollection.AddFolder(ADirectory); -end; - -class procedure TBGRANoGUIBitmap.AddFreeTypeFontFile(AFilename: string; AUTF8: boolean); -begin - if AUTF8 then AFilename:= Utf8ToAnsi(AFilename); - EasyLazFreeType.FontCollection.AddFile(AFilename); -end; - -procedure TBGRANoGUIBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); -begin - ACanvas.GUICanvas.Draw(x,y,self); -end; - -procedure TBGRANoGUIBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); -begin - ACanvas.GUICanvas.StretchDraw(Rect.Left,Rect.Top,Rect.Right-Rect.Left,Rect.Bottom-Rect.Top,self); -end; - -procedure TBGRANoGUIBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, - y: integer); -begin - NotAvailable; -end; - -procedure TBGRANoGUIBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - NotAvailable; -end; - -procedure TBGRANoGUIBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -begin - NotAvailable; -end; - -procedure TBGRANoGUIBitmap.TakeScreenshot(ARect: TRect); -begin - NotAvailable; -end; - -procedure TBGRANoGUIBitmap.TakeScreenshotOfPrimaryMonitor; -begin - NotAvailable; -end; - -procedure TBGRANoGUIBitmap.LoadFromDevice(DC: HDC); -begin - NotAvailable; -end; - -procedure TBGRANoGUIBitmap.LoadFromDevice(DC: HDC; ARect: TRect); -begin - NotAvailable; -end; - -end. - diff --git a/components/bgrabitmap/bgraopengl.pas b/components/bgrabitmap/bgraopengl.pas deleted file mode 100644 index fc16c76..0000000 --- a/components/bgrabitmap/bgraopengl.pas +++ /dev/null @@ -1,2006 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAOpenGL; - -{$mode objfpc}{$H+} -{$I bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, FPimage, BGRAGraphics, - BGRAOpenGLType, BGRASpriteGL, BGRACanvasGL, GL, GLext, GLU, BGRABitmapTypes, - BGRAFontGL, BGRASSE, BGRAMatrix3D; - -type - TBGLCustomCanvas = BGRACanvasGL.TBGLCustomCanvas; - TBGLSprite = TBGLDefaultSprite; - IBGLTexture = BGRAOpenGLType.IBGLTexture; - IBGLFont = BGRAOpenGLType.IBGLFont; - IBGLRenderedFont = BGRAFontGL.IBGLRenderedFont; - TOpenGLResampleFilter = BGRAOpenGLType.TOpenGLResampleFilter; - TOpenGLBlendMode = BGRAOpenGLType.TOpenGLBlendMode; - TBGLPath = BGRACanvasGL.TBGLPath; - TWaitForGPUOption = BGRAOpenGLType.TWaitForGPUOption; - TBGLCustomElementArray = BGRACanvasGL.TBGLCustomElementArray; - TBGLCustomArray = BGRACanvasGL.TBGLCustomArray; - TOpenGLPrimitive = BGRAOpenGLType.TOpenGLPrimitive; - TTextLayout = BGRAGraphics.TTextLayout; - -const - tlTop = BGRAGraphics.tlTop; - tlCenter = BGRAGraphics.tlCenter; - tlBottom = BGRAGraphics.tlBottom; - -type - { TBGLContext } - - TBGLContext = object - private - function GetHeight: integer; - function GetWidth: integer; - public - Canvas: TBGLCustomCanvas; - Sprites: TBGLCustomSpriteEngine; - property Width: integer read GetWidth; - property Height: integer read GetHeight; - end; - - { TBGLFrameBuffer } - - TBGLFrameBuffer = class(TBGLCustomFrameBuffer) - protected - FHeight: integer; - FMatrix: TAffineMatrix; - FProjectionMatrix: TMatrix4D; - FTexture: IBGLTexture; - FFrameBufferId, FRenderBufferId: GLuint; - FWidth: integer; - FSettingMatrices: boolean; - function GetTexture: IBGLTexture; override; - function GetHandle: pointer; override; - function GetHeight: integer; override; - function GetMatrix: TAffineMatrix; override; - function GetProjectionMatrix: TMatrix4D; override; - function GetWidth: integer; override; - procedure SetMatrix(AValue: TAffineMatrix); override; - procedure SetProjectionMatrix(AValue: TMatrix4D); override; - public - constructor Create(AWidth,AHeight: integer); - function MakeTextureAndFree: IBGLTexture; override; - destructor Destroy; override; - end; - -const - orfBox = BGRAOpenGLType.orfBox; - orfLinear = BGRAOpenGLType.orfLinear; - obmNormal = BGRAOpenGLType.obmNormal; - obmAdd = BGRAOpenGLType.obmAdd; - obmMultiply = BGRAOpenGLType.obmMultiply; - wfgQueueAllCommands = BGRAOpenGLType.wfgQueueAllCommands; - wfgFinishAllCommands = BGRAOpenGLType.wfgFinishAllCommands; - opPoints = BGRAOpenGLType.opPoints; - opLineStrip = BGRAOpenGLType.opLineStrip; - opLineLoop = BGRAOpenGLType.opLineLoop; - opLines = BGRAOpenGLType.opLines; - opTriangleStrip = BGRAOpenGLType.opTriangleStrip; - opTriangleFan = BGRAOpenGLType.opTriangleFan; - opTriangles = BGRAOpenGLType.opTriangles; - -type - { TBGLBitmap } - - TBGLBitmap = class(TBGLCustomBitmap) - protected - function GetOpenGLMaxTexSize: integer; override; - public - function NewBitmap: TBGLBitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer): TBGLBitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGLBitmap; overload; override; - function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGLBitmap; overload; override; - function NewBitmap(Filename: string): TBGLBitmap; overload; override; - function NewBitmap(Filename: string; AIsUtf8: boolean): TBGLBitmap; overload; override; - function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGLBitmap; overload; override; - function NewBitmap(AFPImage: TFPCustomImage): TBGLBitmap; overload; override; - function NewReference: TBGLBitmap; override; - function GetUnique: TBGLBitmap; override; - function Duplicate(DuplicateProperties: Boolean = False): TBGLBitmap; overload; override; - function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean) : TBGLBitmap; overload; override; - function GetPart(const ARect: TRect): TBGLBitmap; override; - function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel; - AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGLBitmap; override; - function Resample(newWidth, newHeight: integer; - mode: TResampleMode = rmFineResample): TBGLBitmap; override; - function FilterSmartZoom3(Option: TMedianOption): TBGLBitmap; override; - function FilterMedian(Option: TMedianOption): TBGLBitmap; override; - function FilterSmooth: TBGLBitmap; override; - function FilterSharpen(Amount: single = 1): TBGLBitmap; overload; override; - function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGLBitmap; overload; override; - function FilterContour(AGammaCorrection: boolean = false): TBGLBitmap; override; - function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGLBitmap; override; - function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; - function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; - function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; - function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGLBitmap; overload; override; - function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGLBitmap; overload; override; - function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGLBitmap; overload; override; - function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGLBitmap; overload; override; - function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGLBitmap; overload; override; - function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGLBitmap; overload; override; - function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGLBitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean): TBGLBitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGLBitmap; overload; override; - function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGLBitmap; overload; override; - function FilterGrayscale: TBGLBitmap; overload; override; - function FilterGrayscale(ABounds: TRect): TBGLBitmap; overload; override; - function FilterNormalize(eachChannel: boolean = True): TBGLBitmap; overload; override; - function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGLBitmap; overload; override; - function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGLBitmap; override; - function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGLBitmap; override; - function FilterSphere: TBGLBitmap; override; - function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGLBitmap; overload; override; - function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGLBitmap; overload; override; - function FilterCylinder: TBGLBitmap; override; - function FilterPlane: TBGLBitmap; override; - end; - -function BGLTexture(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer): IBGLTexture; overload; -function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture; overload; -function BGLTexture(ABitmap: TBitmap): IBGLTexture; overload; -function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture; overload; -function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture; overload; -function BGLTexture(AFilenameUTF8: string): IBGLTexture; overload; -function BGLTexture(AFilenameUTF8: string; AWidth, AHeight: integer; AResampleFilter: TResampleFilter = rfBox): IBGLTexture; overload; -function BGLTexture(AStream: TStream): IBGLTexture; overload; - -function BGLSpriteEngine: TBGLCustomSpriteEngine; - -function BGLCanvas: TBGLCustomCanvas; - -procedure BGLViewPort(AWidth,AHeight: integer); overload; -procedure BGLViewPort(AWidth,AHeight: integer; AColor: TBGRAPixel); overload; - -function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload; -function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AColor: TBGRAPixel; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload; -function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AColor: TBGRAPixel; {%H-}AOutlineColor: TBGRAPixel; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload; -function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; ARenderer: TBGRACustomFontRenderer; ARendererOwned: boolean = true): IBGLRenderedFont; overload; - -type - { TBGLElementArray } - - TBGLElementArray = class(TBGLCustomElementArray) - protected - FElements: packed array of GLuint; - FBuffer: GLuint; - function GetCount: integer; override; - public - constructor Create(const AElements: array of integer); override; - procedure Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable); override; - destructor Destroy; override; - end; - - { TBGLArray } - - TBGLArray = class(TBGLCustomArray) - protected - FBufferAddress: pointer; - FCount: integer; - FRecordSize: integer; - function GetCount: integer; override; - function GetRecordSize: integer; override; - public - constructor Create(ABufferAddress: Pointer; ACount: integer; ARecordSize: integer); override; - destructor Destroy; override; - end; - -implementation - -uses BGRABlurGL, BGRATransform{$IFDEF BGRABITMAP_USE_LCL}, BGRAText, BGRATextFX{$ENDIF}; - -type - TBlendFuncSeparateProc = procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF Windows} stdcall; {$ELSE} cdecl; {$ENDIF} - -function PrimitiveToOpenGL(AValue: TOpenGLPrimitive): GLenum; -begin - case AValue of - opPoints: result := GL_POINTS; - opLineStrip: result := GL_LINE_STRIP; - opLineLoop: result := GL_LINE_LOOP; - opLines: result := GL_LINES; - opTriangleStrip: result := GL_TRIANGLE_STRIP; - opTriangleFan: result := GL_TRIANGLE_FAN; - opTriangles: result := GL_TRIANGLES; - else - raise exception.Create('Unknown primitive type'); - end; -end; - -procedure NeedOpenGL2_0; -begin - if glUseProgram = nil then - begin - if not Load_GL_version_2_0 then - raise exception.Create('Cannot load OpenGL 2.0'); - end; -end; - -function CheckOpenGL2_0: boolean; -begin - if glUseProgram = nil then - begin - result := Load_GL_version_2_0; - end - else - result := true; -end; - -var - BGLCanvasInstance: TBGLCustomCanvas; - glBlendFuncSeparate: TBlendFuncSeparateProc; - glBlendFuncSeparateFetched: boolean; - -const - GL_COMBINE_ARB = $8570; - GL_COMBINE_RGB_ARB = $8571; - GL_SOURCE0_RGB_ARB = $8580; - GL_PRIMARY_COLOR_ARB = $8577; - -type - { TBGLTexture } - - TBGLTexture = class(TBGLCustomTexture) - protected - FFlipX,FFlipY: Boolean; - - function GetOpenGLMaxTexSize: integer; override; - function CreateOpenGLTexture(ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; RGBAOrder: boolean): TBGLTextureHandle; override; - procedure UpdateOpenGLTexture(ATexture: TBGLTextureHandle; ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth,AActualHeight: integer; RGBAOrder: boolean); override; - class function SupportsBGRAOrder: boolean; override; - procedure SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); override; - procedure ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; FramesX: Integer=1; FramesY: Integer=1); override; - function GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; override; - function GetEmptyTexture: TBGLTextureHandle; override; - procedure FreeOpenGLTexture(ATexture: TBGLTextureHandle); override; - procedure UpdateGLResampleFilter(ATexture: TBGLTextureHandle; AFilter: TOpenGLResampleFilter); override; - - procedure InternalSetColor(const AColor: TBGRAPixel); - procedure DoDrawTriangleOrQuad(const APoints: array of TPointF; - const APointsZ: array of Single; const APoints3D: array of TPoint3D_128; - const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; - const AColors: array of TColorF); override; - procedure DoDraw(pt1,pt2,pt3,pt4: TPointF; AColor: TBGRAPixel); - procedure DoStretchDraw(x,y,w,h: single; AColor: TBGRAPixel); override; - procedure DoStretchDrawAngle(x,y,w,h,angleDeg: single; rotationCenter: TPointF; AColor: TBGRAPixel); override; - procedure DoDrawAffine(Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); override; - procedure Init(ATexture: TBGLTextureHandle; AWidth,AHeight: integer; AOwned: boolean); override; - procedure NotifyInvalidFrameSize; override; - procedure NotifyErrorLoadingFile(AFilenameUTF8: string); override; - - function NewEmpty: TBGLCustomTexture; override; - function NewFromTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): TBGLCustomTexture; override; - function Duplicate: TBGLCustomTexture; override; - - public - procedure ToggleFlipX; override; - procedure ToggleFlipY; override; - procedure Bind(ATextureNumber: integer); override; - function FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture; override; - function FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; override; - - end; - - POpenGLTexture = ^TOpenGLTexture; - TOpenGLTexture = record - ID: GLuint; - AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight: integer; - FramesCoord: array of array[0..3] of TPointF; - end; - - { TBGLCanvas } - - TBGLCanvas = class(TBGLCustomCanvas) - protected - FMatrix: TAffineMatrix; - FProjectionMatrix: TMatrix4D; - FBlendMode: TOpenGLBlendMode; - FLighting: TBGLCustomLighting; - FFaceCulling: TFaceCulling; - - function GetLighting: TBGLCustomLighting; override; - - function GetMatrix: TAffineMatrix; override; - procedure SetMatrix(const AValue: TAffineMatrix); override; - function GetProjectionMatrix: TMatrix4D; override; - procedure SetProjectionMatrix(const AValue: TMatrix4D); override; - - function GetFaceCulling: TFaceCulling; override; - procedure SetFaceCulling(AValue: TFaceCulling); override; - - procedure InternalSetColor(const AColor: TBGRAPixel); override; - procedure InternalSetColorF(const AColor: TColorF); override; - - procedure InternalStartPutPixel(const pt: TPointF); override; - procedure InternalStartPolyline(const pt: TPointF); override; - procedure InternalStartPolygon(const pt: TPointF); override; - procedure InternalStartTriangleFan(const pt: TPointF); override; - procedure InternalContinueShape(const pt: TPointF); overload; override; - - procedure InternalContinueShape(const pt: TPoint3D); overload; override; - procedure InternalContinueShape(const pt: TPoint3D_128); overload; override; - procedure InternalContinueShape(const pt, normal: TPoint3D_128); overload; override; - - procedure InternalEndShape; override; - - procedure InternalStartBlend; override; - procedure InternalEndBlend; override; - - procedure InternalStartBlendTriangles; override; - procedure InternalStartBlendQuads; override; - procedure InternalEndBlendTriangles; override; - procedure InternalEndBlendQuads; override; - - procedure EnableScissor(AValue: TRect); override; - procedure DisableScissor; override; - - function GetBlendMode: TOpenGLBlendMode; override; - procedure SetBlendMode(AValue: TOpenGLBlendMode); override; - - procedure SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); override; - public - destructor Destroy; override; - procedure Fill(AColor: TBGRAPixel); override; - procedure StartZBuffer; override; - procedure EndZBuffer; override; - procedure WaitForGPU(AOption: TWaitForGPUOption); override; - function GetImage(x, y, w, h: integer): TBGRACustomBitmap; override; - function CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer; override; - end; - - { TBGLLighting } - - TBGLLighting = class(TBGLCustomLighting) - protected - FLightUsage: array[0..7] of boolean; - FCurrentSpecularIndex: single; - FAmbiantLightF: TColorF; - FBuiltInLighting: boolean; - function MakeShaderObject(AShaderType: GLenum; ASource: string): GLuint; - function AddLight(AColor: TColorF): integer; - function GetSupportShaders: boolean; override; - procedure SetAmbiantLightF(AAmbiantLight: TColorF); override; - function GetAmbiantLightF: TColorF; override; - function GetBuiltInLightingEnabled: boolean; override; - procedure SetBuiltInLightingEnabled(AValue: boolean); override; - public - constructor Create; - function AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer; override; - function AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer; override; - procedure ClearLights; override; - function RemoveLight(AIndex: integer): boolean; override; - procedure SetSpecularIndex(AIndex: integer); override; - - function MakeVertexShader(ASource: string): LongWord; override; - function MakeFragmentShader(ASource: string): LongWord; override; - function MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord; override; - procedure UseProgram(AProgram: LongWord); override; - procedure DeleteShaderObject(AShader: LongWord); override; - procedure DeleteShaderProgram(AProgram: LongWord); override; - function GetUniformVariable(AProgram: LongWord; AName: string): LongWord; override; - function GetAttribVariable(AProgram: LongWord; AName: string): LongWord; override; - procedure SetUniformSingle(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); override; - procedure SetUniformInteger(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); override; - procedure BindAttribute(AAttribute: TAttributeVariable); override; - procedure UnbindAttribute(AAttribute: TAttributeVariable); override; - end; - -{ TBGLFrameBuffer } - -procedure TBGLFrameBuffer.SetMatrix(AValue: TAffineMatrix); -begin - if FSettingMatrices then Exit; - FSettingMatrices := true; - FMatrix:=AValue; - if FCanvas <> nil then - TBGLCustomCanvas(FCanvas).Matrix := AValue; - FSettingMatrices := false; -end; - -function TBGLFrameBuffer.GetMatrix: TAffineMatrix; -begin - result := FMatrix; -end; - -function TBGLFrameBuffer.GetTexture: IBGLTexture; -begin - result := FTexture.FlipY; -end; - -function TBGLFrameBuffer.GetHandle: pointer; -begin - result := @FFrameBufferId; -end; - -function TBGLFrameBuffer.GetHeight: integer; -begin - result := FHeight; -end; - -function TBGLFrameBuffer.GetProjectionMatrix: TMatrix4D; -begin - result := FProjectionMatrix; -end; - -function TBGLFrameBuffer.GetWidth: integer; -begin - result := FWidth; -end; - -procedure TBGLFrameBuffer.SetProjectionMatrix(AValue: TMatrix4D); -begin - if FSettingMatrices then Exit; - FSettingMatrices := true; - FProjectionMatrix:= AValue; - if FCanvas <> nil then - TBGLCustomCanvas(FCanvas).ProjectionMatrix := AValue; - FSettingMatrices := false; -end; - -constructor TBGLFrameBuffer.Create(AWidth, AHeight: integer); -var frameBufferStatus: GLenum; -begin - if not Load_GL_version_3_0 then - raise exception.Create('Cannot load OpenGL 3.0'); - - FWidth := AWidth; - FHeight := AHeight; - - FTexture := BGLTextureFactory.Create(nil,AWidth,AHeight,AWidth,AHeight); - - //depth and stencil - glGenRenderbuffers(1, @FRenderBufferId); - glBindRenderbuffer(GL_RENDERBUFFER, FRenderBufferId); - glRenderbufferStorage(GL_RENDERBUFFER, GL_DEPTH24_STENCIL8, AWidth,AHeight); - glBindRenderbuffer(GL_RENDERBUFFER, 0); - - glGenFramebuffers(1, @FFrameBufferId); - glBindFramebuffer(GL_FRAMEBUFFER, FFrameBufferId); - - glFramebufferTexture2D(GL_FRAMEBUFFER, GL_COLOR_ATTACHMENT0, GL_TEXTURE_2D, PGLuint(FTexture.Handle)^, 0); - glFramebufferRenderbuffer(GL_FRAMEBUFFER, GL_DEPTH_STENCIL_ATTACHMENT, GL_RENDERBUFFER, FFrameBufferId); - - frameBufferStatus:= glCheckFramebufferStatus(GL_FRAMEBUFFER); - glBindFramebuffer(GL_FRAMEBUFFER, 0); - - if frameBufferStatus <> GL_FRAMEBUFFER_COMPLETE then - begin - glDeleteFramebuffers(1, @FFrameBufferId); - glDeleteRenderbuffers(1, @FRenderBufferId); - FTexture := nil; - raise exception.Create('Error ' + inttostr(frameBufferStatus) + ' while initializing frame buffer'); - end; - - UseOrthoProjection; - Matrix := AffineMatrixIdentity; -end; - -function TBGLFrameBuffer.MakeTextureAndFree: IBGLTexture; -begin - result := FTexture; - FTexture := nil; - Free; -end; - -destructor TBGLFrameBuffer.Destroy; -begin - glDeleteFramebuffers(1, @FFrameBufferId); - glDeleteRenderbuffers(1, @FRenderBufferId); - FTexture := nil; - - inherited Destroy; -end; - -procedure ApplyBlendMode(ABlendMode: TOpenGLBlendMode); -var - srcBlend : LongWord; - dstBlend : LongWord; -begin - case ABlendMode of - obmAdd: - begin - srcBlend := GL_SRC_ALPHA; - dstBlend := GL_ONE; - end; - obmMultiply: - begin - srcBlend := GL_ZERO; - dstBlend := GL_SRC_COLOR; - end - else - begin - srcBlend := GL_SRC_ALPHA; - dstBlend := GL_ONE_MINUS_SRC_ALPHA; - end; - end; - if not glBlendFuncSeparateFetched then - begin - glBlendFuncSeparate := TBlendFuncSeparateProc(wglGetProcAddress('glBlendFuncSeparate')); - glBlendFuncSeparateFetched := true; - end; - if Assigned(glBlendFuncSeparate) then - glBlendFuncSeparate( srcBlend, dstBlend, GL_ONE, GL_ONE_MINUS_SRC_ALPHA ) - else - glBlendFunc( srcBlend, dstBlend ); -end; - -function BGLTexture(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, - ActualWidth, ActualHeight: integer): IBGLTexture; -begin - result := TBGLTexture.Create(ARGBAData,AllocatedWidth, AllocatedHeight, - ActualWidth, ActualHeight); -end; - -function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture; -begin - result := TBGLTexture.Create(AFPImage); -end; - -function BGLTexture(ABitmap: TBitmap): IBGLTexture; -begin - result := TBGLTexture.Create(ABitmap); -end; - -function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture; -begin - result := TBGLTexture.Create(AWidth,AHeight,Color); -end; - -function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture; -begin - result := TBGLTexture.Create(AWidth,AHeight,Color); -end; - -function BGLTexture(AFilenameUTF8: string): IBGLTexture; -begin - result := TBGLTexture.Create(AFilenameUTF8); -end; - -function BGLTexture(AFilenameUTF8: string; AWidth, AHeight: integer; AResampleFilter: TResampleFilter): IBGLTexture; -begin - result := TBGLTexture.Create(AFilenameUTF8, AWidth, AHeight, AResampleFilter); -end; - -function BGLTexture(AStream: TStream): IBGLTexture; -begin - result := TBGLTexture.Create(AStream); -end; - -function BGLSpriteEngine: TBGLCustomSpriteEngine; -begin - result := BGRASpriteGL.BGLSpriteEngine; -end; - -procedure BGLViewPort(AWidth, AHeight: integer; AColor: TBGRAPixel); -begin - BGLViewPort(AWidth,AHeight); - BGLCanvas.Fill(AColor); -end; - -function BGLFont(AName: string; AEmHeight: integer; AStyle: TFontStyles = []): IBGLRenderedFont; -begin - {$IFDEF BGRABITMAP_USE_LCL} - result := BGLFont(AName, AEmHeight, TLCLFontRenderer.Create); - result.Style := AStyle; - {$ELSE} - result := nil; - raise exception.Create('LCL renderer not available'); - {$ENDIF} -end; - -function BGLFont(AName: string; AEmHeight: integer; AColor: TBGRAPixel; - AStyle: TFontStyles): IBGLRenderedFont; -begin - {$IFDEF BGRABITMAP_USE_LCL} - result := BGLFont(AName, AEmHeight, TLCLFontRenderer.Create); - result.Color := AColor; - result.Style := AStyle; - {$ELSE} - result := nil; - raise exception.Create('LCL renderer not available'); - {$ENDIF} -end; - -function BGLFont(AName: string; AEmHeight: integer; AColor: TBGRAPixel; - AOutlineColor: TBGRAPixel; AStyle: TFontStyles = []): IBGLRenderedFont; -{$IFDEF BGRABITMAP_USE_LCL} -var renderer: TBGRATextEffectFontRenderer; -begin - renderer := TBGRATextEffectFontRenderer.Create; - renderer.OuterOutlineOnly:= true; - renderer.OutlineColor := AOutlineColor; - renderer.OutlineVisible := true; - result := BGLFont(AName, AEmHeight, renderer, true); - result.Color := AColor; - result.Style := AStyle; -end; -{$ELSE} -begin - result := nil; - raise exception.Create('LCL renderer not available'); -end; -{$ENDIF} - -function BGLFont(AName: string; AEmHeight: integer; - ARenderer: TBGRACustomFontRenderer; - ARendererOwned: boolean): IBGLRenderedFont; -var f: TBGLRenderedFont; -begin - f:= TBGLRenderedFont.Create(ARenderer, ARendererOwned); - f.Name := AName; - f.EmHeight := AEmHeight; - result := f; -end; - -function BGLCanvas: TBGLCustomCanvas; -begin - result := BGLCanvasInstance; -end; - -procedure BGLViewPort(AWidth, AHeight: integer); -begin - BGLCanvas.Width := AWidth; - BGLCanvas.Height := AHeight; - BGLCanvas.UseOrthoProjection; - BGLCanvas.Matrix := AffineMatrixIdentity; - BGLCanvas.FaceCulling := fcNone; -end; - -{ TBGLArray } - -function TBGLArray.GetCount: integer; -begin - result := FCount; -end; - -function TBGLArray.GetRecordSize: integer; -begin - result := FRecordSize; -end; - -constructor TBGLArray.Create(ABufferAddress: pointer; ACount: integer; - ARecordSize: integer); -var b: GLuint; -begin - NeedOpenGL2_0; - FBufferAddress:= ABufferAddress; - FCount := ACount; - FRecordSize:= ARecordSize; - glGenBuffers(1, @b); - FBuffer := b; - glBindBuffer(GL_ARRAY_BUFFER, FBuffer); - glBufferData(GL_ARRAY_BUFFER, FCount*FRecordSize, FBufferAddress, GL_STATIC_DRAW); -end; - -destructor TBGLArray.Destroy; -var b: GLuint; -begin - b := FBuffer; - glDeleteBuffers(1, @b); - inherited Destroy; -end; - -{ TBGLElementArray } - -function TBGLElementArray.GetCount: integer; -begin - result := length(FElements); -end; - -constructor TBGLElementArray.Create(const AElements: array of integer); -var bufferSize: integer; - i: Int32or64; -begin - NeedOpenGL2_0; - setlength(FElements,length(AElements)); - bufferSize := length(FElements)*sizeof(integer); - for i := 0 to high(FElements) do - FElements[i] := AElements[i]; - glGenBuffers(1, @FBuffer); - glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, FBuffer); - glBufferData(GL_ELEMENT_ARRAY_BUFFER, bufferSize, @FElements[0], GL_STATIC_DRAW); -end; - -procedure TBGLElementArray.Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable); -var - i: Int32or64; -begin - for i := 0 to high(AAttributes) do - ACanvas.Lighting.BindAttribute(AAttributes[i]); - - glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, FBuffer); - glDrawElements(PrimitiveToOpenGL(APrimitive), Count, GL_UNSIGNED_INT, nil); - - for i := 0 to high(AAttributes) do - ACanvas.Lighting.UnbindAttribute(AAttributes[i]); -end; - -destructor TBGLElementArray.Destroy; -begin - glDeleteBuffers(1, @FBuffer); - inherited Destroy; -end; - -{ TBGLLighting } - -procedure TBGLLighting.SetAmbiantLightF(AAmbiantLight: TColorF); -begin - FAmbiantLightF := AAmbiantLight; - glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @AAmbiantLight); -end; - -constructor TBGLLighting.Create; -begin - FAmbiantLightF := ColorF(1,1,1,1); -end; - -function TBGLLighting.AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer; -var - v: TPoint3D_128; -begin - result := AddLight(AColor); - if result <> -1 then - begin - v := Point3D_128(APosition); - v.t := 1; - glLightfv(GL_LIGHT0 + result, GL_POSITION, @v); - glLightf(GL_LIGHT0 + result, GL_CONSTANT_ATTENUATION, 0); - glLightf(GL_LIGHT0 + result, GL_LINEAR_ATTENUATION, ALinearAttenuation); - glLightf(GL_LIGHT0 + result, GL_QUADRATIC_ATTENUATION, AQuadraticAttenuation); - end; -end; - -procedure TBGLLighting.ClearLights; -var - i: Integer; -begin - for i := 0 to High(FLightUsage) do - if FLightUsage[i] then - RemoveLight(i); -end; - -function TBGLLighting.AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer; -var - v: TPoint3D_128; -begin - result := AddLight(AColor); - if result <> -1 then - begin - v := Point3D_128(ADirection); - Normalize3D_128(v); - v.t := 0; - glLightfv(GL_LIGHT0 + result, GL_POSITION, @v); - end; -end; - -procedure TBGLLighting.SetSpecularIndex(AIndex: integer); -var c: TColorF; - newIndex: single; -begin - newIndex := AIndex*0.5; - if newIndex < 0 then newIndex := 0; - if newIndex > 128 then newIndex := 128; - if newIndex <> FCurrentSpecularIndex then - begin - if newIndex = 0 then - c := ColorF(0,0,0,1) - else - c := ColorF(1,1,1,1); - glMaterialf(GL_FRONT_AND_BACK, GL_SHININESS, newIndex); - glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @c); - FCurrentSpecularIndex := newIndex; - end; -end; - -function TBGLLighting.MakeVertexShader(ASource: string): LongWord; -begin - result := MakeShaderObject(GL_VERTEX_SHADER, ASource); -end; - -function TBGLLighting.MakeFragmentShader(ASource: string): LongWord; -begin - result := MakeShaderObject(GL_FRAGMENT_SHADER, ASource); -end; - -function TBGLLighting.GetAmbiantLightF: TColorF; -begin - result := FAmbiantLightF; -end; - -function TBGLLighting.GetBuiltInLightingEnabled: boolean; -begin - result := FBuiltInLighting; -end; - -procedure TBGLLighting.SetBuiltInLightingEnabled(AValue: boolean); -begin - if AValue = FBuiltInLighting then exit; - FBuiltInLighting:= AValue; - if AValue then - begin - glEnable(GL_LIGHTING); - glShadeModel(GL_SMOOTH); - glEnable(GL_COLOR_MATERIAL); - glColorMaterial(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE); - glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @FAmbiantLightF); - glLightModelf(GL_LIGHT_MODEL_LOCAL_VIEWER, 0); - glLightModelf(GL_LIGHT_MODEL_TWO_SIDE,1); - end else - begin - glDisable(GL_LIGHTING); - end; -end; - -function TBGLLighting.MakeShaderObject(AShaderType: GLenum; ASource: string - ): GLuint; -var - psource: pchar; - sourceLen: GLint; - shaderId: GLuint; - shaderOk: GLint; - log: string; - logLen: GLint; -begin - NeedOpenGL2_0; - - if ASource = '' then - raise exception.Create('Empty code file provided'); - - shaderId := glCreateShader(AShaderType); - psource := @ASource[1]; - sourceLen := length(ASource); - glShaderSource(shaderId, 1, @psource, @sourceLen); - glCompileShader(shaderId); - - glGetShaderiv(shaderId, GL_COMPILE_STATUS, @shaderOk); - if not (shaderOk <> 0) then - begin - //retrieve error log - glGetShaderiv(shaderId, GL_INFO_LOG_LENGTH, @logLen); - setlength(log, logLen); - if logLen > 0 then - glGetShaderInfoLog(shaderId, logLen, nil, @log[1]); - - glDeleteShader(shaderId); - raise exception.Create('Failed to compile shader: ' + log); - end; - result := shaderId; -end; - -function TBGLLighting.AddLight(AColor: TColorF): integer; -var - i: Integer; - black: TColorF; -begin - for i := 0 to high(FLightUsage) do - if not FLightUsage[i] then - begin - result := i; - FLightUsage[i] := true; - black := ColorF(0,0,0,1); - glLightfv(GL_LIGHT0 + i, GL_AMBIENT, @black); - glLightfv(GL_LIGHT0 + i, GL_DIFFUSE, @AColor); - glLightfv(GL_LIGHT0 + i, GL_SPECULAR, @AColor); - glEnable(GL_LIGHT0 + i); - exit; - end; - result := -1; -end; - -function TBGLLighting.GetSupportShaders: boolean; -begin - result := CheckOpenGL2_0; -end; - -function TBGLLighting.MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord; -var - programOk: GLint; - shaderProgram: GLuint; - log: string; - logLen: GLint; -begin - NeedOpenGL2_0; - - shaderProgram := glCreateProgram(); - glAttachShader(shaderProgram, AVertexShader); - glAttachShader(shaderProgram, AFragmentShader); - glLinkProgram(shaderProgram); - - glGetProgramiv(shaderProgram, GL_LINK_STATUS, @programOk); - if not (programOk <> 0) then - begin - //retrieve error log - glGetProgramiv(shaderProgram, GL_INFO_LOG_LENGTH, @logLen); - setlength(log, logLen); - if logLen > 0 then - glGetProgramInfoLog(shaderProgram, logLen, nil, @log[1]); - - glDeleteProgram(shaderProgram); - raise exception.Create('Failed to link shader program: ' + log); - end; - result := shaderProgram; -end; - -procedure TBGLLighting.UseProgram(AProgram: LongWord); -begin - NeedOpenGL2_0; - glUseProgram(AProgram); -end; - -procedure TBGLLighting.DeleteShaderObject(AShader: LongWord); -begin - NeedOpenGL2_0; - if AShader<> 0 then - glDeleteShader(AShader); -end; - -procedure TBGLLighting.DeleteShaderProgram(AProgram: LongWord); -begin - NeedOpenGL2_0; - if AProgram<> 0 then - glDeleteProgram(AProgram); -end; - -function TBGLLighting.GetUniformVariable(AProgram: LongWord; AName: string): LongWord; -begin - NeedOpenGL2_0; - result := glGetUniformLocation(AProgram, @AName[1]); -end; - -function TBGLLighting.GetAttribVariable(AProgram: LongWord; AName: string): LongWord; -begin - NeedOpenGL2_0; - result := glGetAttribLocation(AProgram, @AName[1]); -end; - -procedure TBGLLighting.SetUniformSingle(AVariable: LongWord; - const AValue; AElementCount, AComponentCount: integer); -begin - NeedOpenGL2_0; - case AComponentCount of - 1: glUniform1fv(AVariable, AElementCount, @AValue); - 2: glUniform2fv(AVariable, AElementCount, @AValue); - 3: glUniform3fv(AVariable, AElementCount, @AValue); - 4: glUniform4fv(AVariable, AElementCount, @AValue); - 9: glUniformMatrix3fv(AVariable, AElementCount, GL_FALSE, @AValue); - 16: glUniformMatrix4fv(AVariable, AElementCount, GL_FALSE, @AValue); - else - raise exception.Create('Unexpected number of components'); - end; -end; - -procedure TBGLLighting.SetUniformInteger(AVariable: LongWord; - const AValue; AElementCount, AComponentCount: integer); -begin - NeedOpenGL2_0; - case AComponentCount of - 1: glUniform1iv(AVariable, AElementCount, @AValue); - 2: glUniform2iv(AVariable, AElementCount, @AValue); - 3: glUniform3iv(AVariable, AElementCount, @AValue); - 4: glUniform4iv(AVariable, AElementCount, @AValue); - else - raise exception.Create('Unexpected number of components'); - end; -end; - -procedure TBGLLighting.BindAttribute(AAttribute: TAttributeVariable); -var t: GLenum; -begin - glBindBuffer(GL_ARRAY_BUFFER, AAttribute.Source.Handle); - if AAttribute.IsFloat then - t := GL_FLOAT - else - t := GL_INT; - glVertexAttribPointer(AAttribute.Handle, AAttribute.VectorSize,t,GL_FALSE, - AAttribute.Source.RecordSize, {%H-}pointer(PtrInt(AAttribute.RecordOffset))); - glEnableVertexAttribArray(AAttribute.Handle); -end; - -procedure TBGLLighting.UnbindAttribute(AAttribute: TAttributeVariable); -begin - glDisableVertexAttribArray(AAttribute.Handle); -end; - -function TBGLLighting.RemoveLight(AIndex: integer): boolean; -begin - if (AIndex >= 0) and (AIndex <= high(FLightUsage)) and - FLightUsage[AIndex] then - begin - glDisable(GL_LIGHT0 + AIndex); - FLightUsage[AIndex] := false; - result := true; - end - else - result := false; -end; - -{ TBGLContext } - -function TBGLContext.GetHeight: integer; -begin - if Assigned(Canvas) then - result := Canvas.Height - else - result := 0; -end; - -function TBGLContext.GetWidth: integer; -begin - if Assigned(Canvas) then - result := Canvas.Width - else - result := 0; -end; - -{ TBGLCanvas } - -function TBGLCanvas.GetLighting: TBGLCustomLighting; -begin - if FLighting = nil then - FLighting := TBGLLighting.Create; - result := FLighting; -end; - -function TBGLCanvas.GetMatrix: TAffineMatrix; -begin - if ActiveFrameBuffer <> nil then - result := ActiveFrameBuffer.Matrix - else - result := FMatrix; -end; - -procedure TBGLCanvas.SetMatrix(const AValue: TAffineMatrix); -var m: TMatrix4D; -begin - glMatrixMode(GL_MODELVIEW); - m := AffineMatrixToMatrix4D(AValue); - glLoadMatrixf(@m); - - if ActiveFrameBuffer <> nil then - ActiveFrameBuffer.Matrix := AValue - else - FMatrix := AValue; -end; - -function TBGLCanvas.GetProjectionMatrix: TMatrix4D; -begin - if ActiveFrameBuffer <> nil then - result := ActiveFrameBuffer.ProjectionMatrix - else - result := FProjectionMatrix; -end; - -procedure TBGLCanvas.SetProjectionMatrix(const AValue: TMatrix4D); -begin - glMatrixMode(GL_PROJECTION); - glLoadMatrixf(@AValue); - glMatrixMode(GL_MODELVIEW); - - if ActiveFrameBuffer <> nil then - ActiveFrameBuffer.ProjectionMatrix := AValue - else - FProjectionMatrix := AValue; -end; - -function TBGLCanvas.GetFaceCulling: TFaceCulling; -begin - result := FFaceCulling; -end; - -procedure TBGLCanvas.SetFaceCulling(AValue: TFaceCulling); -begin - if AValue = FFaceCulling then exit; - if FFaceCulling = fcNone then - glEnable(GL_CULL_FACE); - case AValue of - fcNone: glDisable(GL_CULL_FACE); - fcKeepCW: glFrontFace(GL_CW); - fcKeepCCW: glFrontFace(GL_CCW); - end; - FFaceCulling:= AValue; -end; - -procedure TBGLCanvas.InternalStartPutPixel(const pt: TPointF); -begin - glBegin(GL_POINTS); - glVertex2fv(@pt); -end; - -procedure TBGLCanvas.InternalStartPolyline(const pt: TPointF); -begin - glBegin(GL_LINE_STRIP); - glVertex2fv(@pt); -end; - -procedure TBGLCanvas.InternalStartPolygon(const pt: TPointF); -begin - glBegin(GL_LINE_LOOP); - glVertex2fv(@pt); -end; - -procedure TBGLCanvas.InternalStartTriangleFan(const pt: TPointF); -begin - glBegin(GL_TRIANGLE_FAN); - glVertex2fv(@pt); -end; - -procedure TBGLCanvas.InternalContinueShape(const pt: TPointF); -begin - glVertex2fv(@pt); -end; - -procedure TBGLCanvas.InternalContinueShape(const pt: TPoint3D); -begin - glVertex3fv(@pt); -end; - -procedure TBGLCanvas.InternalContinueShape(const pt: TPoint3D_128); -begin - glVertex3fv(@pt); -end; - -procedure TBGLCanvas.InternalContinueShape(const pt, normal: TPoint3D_128); -begin - glNormal3fv(@normal); - glVertex3fv(@pt); -end; - -procedure TBGLCanvas.InternalEndShape; -begin - glEnd(); -end; - -procedure TBGLCanvas.InternalSetColor(const AColor: TBGRAPixel); -begin - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - glColor4ubv(@AColor) - else - glColor4ub(AColor.red,AColor.green,AColor.blue,AColor.alpha); - {$POP} -end; - -procedure TBGLCanvas.InternalSetColorF(const AColor: TColorF); -begin - glColor4fv(@AColor[1]); -end; - -procedure TBGLCanvas.InternalStartBlend; -begin - glEnable(GL_BLEND); - ApplyBlendMode(BlendMode); -end; - -procedure TBGLCanvas.InternalEndBlend; -begin - glDisable(GL_BLEND); -end; - -procedure TBGLCanvas.InternalStartBlendTriangles; -begin - InternalStartBlend; - glBegin(GL_TRIANGLES); -end; - -procedure TBGLCanvas.InternalStartBlendQuads; -begin - InternalStartBlend; - glBegin(GL_QUADS); -end; - -procedure TBGLCanvas.InternalEndBlendTriangles; -begin - InternalEndShape; - InternalEndBlend; -end; - -procedure TBGLCanvas.InternalEndBlendQuads; -begin - InternalEndShape; - InternalEndBlend; -end; - -procedure TBGLCanvas.Fill(AColor: TBGRAPixel); -begin - glClearColor(AColor.Red/255, AColor.green/255, AColor.blue/255, AColor.alpha/255); - glClear(GL_COLOR_BUFFER_BIT); -end; - -procedure TBGLCanvas.StartZBuffer; -begin - glEnable(GL_DEPTH_TEST); - glClear(GL_DEPTH_BUFFER_BIT); -end; - -procedure TBGLCanvas.EndZBuffer; -begin - glDisable(GL_DEPTH_TEST); -end; - -procedure TBGLCanvas.WaitForGPU(AOption: TWaitForGPUOption); -begin - case AOption of - wfgQueueAllCommands: glFlush; - wfgFinishAllCommands: glFinish; - end; -end; - -function TBGLCanvas.GetImage(x, y, w, h: integer): TBGRACustomBitmap; -begin - NeedOpenGL2_0; - result := BGRABitmapFactory.Create(w,h); - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - glReadPixels(x,self.Height-y-h, w,h, GL_RGBA, GL_UNSIGNED_BYTE, result.Data) - else - glReadPixels(x,self.Height-y-h, w,h, GL_BGRA, GL_UNSIGNED_BYTE, result.Data); - {$POP} -end; - -function TBGLCanvas.CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer; -begin - Result:= TBGLFrameBuffer.Create(AWidth,AHeight); -end; - -procedure TBGLCanvas.EnableScissor(AValue: TRect); -begin - glScissor(AValue.left,Height-AValue.bottom,AValue.right-AValue.left,AValue.Bottom-AValue.Top); - glEnable(GL_SCISSOR_TEST); -end; - -procedure TBGLCanvas.DisableScissor; -begin - glDisable(GL_SCISSOR_TEST); -end; - -function TBGLCanvas.GetBlendMode: TOpenGLBlendMode; -begin - result := FBlendMode; -end; - -procedure TBGLCanvas.SetBlendMode(AValue: TOpenGLBlendMode); -begin - FBlendMode := AValue; -end; - -procedure TBGLCanvas.SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); -var - m: TMatrix4D; -begin - if AValue = ActiveFrameBuffer then exit; - inherited SetActiveFrameBuffer(AValue); - if AValue = nil then - glBindFramebuffer(GL_FRAMEBUFFER, 0) - else - glBindFramebuffer(GL_FRAMEBUFFER, PGLuint(AValue.Handle)^); - - glViewPort(0,0,Width,Height); - - glMatrixMode(GL_PROJECTION); - m := ProjectionMatrix; - glLoadMatrixf(@m); - - glMatrixMode(GL_MODELVIEW); - m := AffineMatrixToMatrix4D(Matrix); - glLoadMatrixf(@m); -end; - -destructor TBGLCanvas.Destroy; -begin - FLighting.Free; - inherited Destroy; -end; - -{ TBGLTexture } - -function TBGLTexture.GetOpenGLMaxTexSize: integer; -begin - result := 0; - glGetIntegerv( GL_MAX_TEXTURE_SIZE, @result ); -end; - -function TBGLTexture.CreateOpenGLTexture(ARGBAData: PLongWord; - AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; - RGBAOrder: boolean): TBGLTextureHandle; -var p: POpenGLTexture; - providedFormat: GLenum; -begin - if RGBAOrder then providedFormat:= GL_RGBA else providedFormat:= GL_BGRA; - New(p); - p^.AllocatedWidth := AAllocatedWidth; - p^.AllocatedHeight := AAllocatedHeight; - p^.ActualWidth := AActualWidth; - p^.ActualHeight := AActualHeight; - - glGenTextures( 1, @p^.ID ); - glBindTexture( GL_TEXTURE_2D, p^.ID ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR ); - glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, AAllocatedWidth, AAllocatedHeight, 0, providedFormat, GL_UNSIGNED_BYTE, ARGBAData ); - result := p; -end; - -procedure TBGLTexture.UpdateOpenGLTexture(ATexture: TBGLTextureHandle; - ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, - AActualHeight: integer; RGBAOrder: boolean); -var providedFormat: GLenum; -begin - if RGBAOrder then providedFormat:= GL_RGBA else providedFormat:= GL_BGRA; - SetOpenGLTextureSize(ATexture, AAllocatedWidth,AAllocatedHeight, AActualWidth,AActualHeight); - glBindTexture( GL_TEXTURE_2D, TOpenGLTexture(ATexture^).ID ); - glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, AAllocatedWidth, AAllocatedHeight, 0, providedFormat, GL_UNSIGNED_BYTE, ARGBAData ); -end; - -class function TBGLTexture.SupportsBGRAOrder: boolean; -begin - Result:= true; -end; - -procedure TBGLTexture.SetOpenGLTextureSize(ATexture: TBGLTextureHandle; - AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); -begin - with TOpenGLTexture(ATexture^) do - begin - ActualWidth := AActualWidth; - ActualHeight:= AActualHeight; - AllocatedWidth := AAllocatedWidth; - AllocatedHeight := AAllocatedHeight; - end; -end; - -procedure TBGLTexture.ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; - FramesX: Integer; FramesY: Integer); -var U,V: Single; - tX, tY, fU, fV : Single; - ix,iy,i: Integer; -begin - with TOpenGLTexture(ATexture^) do - begin - if AllocatedWidth = 0 then - U := 1 - else - U := ActualWidth/AllocatedWidth; - if AllocatedHeight = 0 then - V := 1 - else - V := ActualHeight/AllocatedHeight; - - if FramesX < 1 then FramesX := 1; - if FramesY < 1 then FramesY := 1; - - SetLength( FramesCoord, FramesX * FramesY + 1 ); - fU := U / FramesX; - fV := V / FramesY; - - FramesCoord[ 0, 0 ].X := 0; - FramesCoord[ 0, 0 ].Y := 0; - FramesCoord[ 0, 1 ].X := U; - FramesCoord[ 0, 1 ].Y := 0; - FramesCoord[ 0, 2 ].X := U; - FramesCoord[ 0, 2 ].Y := V; - FramesCoord[ 0, 3 ].X := 0; - FramesCoord[ 0, 3 ].Y := V; - - ix := 1; - iy := 1; - for i := 1 to FramesX * FramesY do - begin - tX := ix * fU; - tY := iy * fV; - - FramesCoord[ i, 0 ].X := tX - fU; - FramesCoord[ i, 0 ].Y := tY - fV; - - FramesCoord[ i, 1 ].X := tX; - FramesCoord[ i, 1 ].Y := tY - fV; - - FramesCoord[ i, 2 ].X := tX; - FramesCoord[ i, 2 ].Y := tY; - - FramesCoord[ i, 3 ].X := tX - fU; - FramesCoord[ i, 3 ].Y := tY; - - inc(ix); - if ix > FramesX then - begin - ix := 1; - inc(iy); - end; - end; - - end; -end; - -function TBGLTexture.GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; -begin - if ATexture = nil then - result := 0 - else - begin - result := Length(TOpenGLTexture(ATexture^).FramesCoord); - if result > 0 then dec(result); //first frame is whole picture - end; -end; - -function TBGLTexture.GetEmptyTexture: TBGLTextureHandle; -begin - result := nil; -end; - -procedure TBGLTexture.FreeOpenGLTexture(ATexture: TBGLTextureHandle); -begin - glDeleteTextures( 1, @TOpenGLTexture(ATexture^).ID ); - Dispose(POpenGLTexture(ATexture)); -end; - -procedure TBGLTexture.UpdateGLResampleFilter(ATexture: TBGLTextureHandle; - AFilter: TOpenGLResampleFilter); -begin - glBindTexture( GL_TEXTURE_2D, TOpenGLTexture(ATexture^).ID ); - if AFilter = orfLinear then - begin - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR ); - end else - begin - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST ); - end; -end; - -procedure TBGLTexture.InternalSetColor(const AColor: TBGRAPixel); -begin - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - glColor4ubv(@AColor) - else - glColor4ub(AColor.red,AColor.green,AColor.blue,AColor.alpha); - {$POP} -end; - -procedure TBGLTexture.DoDrawTriangleOrQuad(const APoints: array of TPointF; - const APointsZ: array of Single; const APoints3D: array of TPoint3D_128; - const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; - const AColors: array of TColorF); -var - i: Integer; - factorX,factorY: single; -begin - if (FOpenGLTexture = nil) or (Width = 0) or (Height = 0) then exit; - with TOpenGLTexture(FOpenGLTexture^) do - begin - glEnable( GL_BLEND ); - - glEnable( GL_TEXTURE_2D ); - glBindTexture( GL_TEXTURE_2D, ID ); - - if FIsMask then - begin - glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB ); - glTexEnvi( GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_REPLACE ); - glTexEnvi( GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PRIMARY_COLOR_ARB ); - end else - glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE ); - - ApplyBlendMode(BlendMode); - - factorX := 1/Width; - factorY := 1/Height; - - if length(AColors) = 0 then - glColor4f(1,1,1,1); - - if length(APoints3D) <> 0 then - begin - if length(APoints3D) = 3 then - glBegin( GL_TRIANGLES ) - else - glBegin( GL_QUADS ); - - for i := 0 to high(APoints3D) do - begin - if length(AColors) <> 0 then glColor4fv( @AColors[i] ); - glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY ); - if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] ); - glVertex3fv( @APoints3D[i] ); - end; - end else - begin - if length(APoints) = 3 then - glBegin( GL_TRIANGLES ) - else - glBegin( GL_QUADS ); - - if length(APointsZ) <> 0 then - begin - for i := 0 to high(APoints) do - begin - if length(AColors) <> 0 then glColor4fv( @AColors[i] ); - glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY ); - if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] ); - glVertex3f( APoints[i].x, APoints[i].y, APointsZ[i] ); - end; - end else - begin - for i := 0 to high(APoints) do - begin - if length(AColors) <> 0 then glColor4fv( @AColors[i] ); - glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY ); - if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] ); - glVertex2fv( @APoints[i] ); - end; - end; - end; - - glEnd; - glDisable( GL_TEXTURE_2D ); - glDisable( GL_BLEND ); - end; -end; - -procedure TBGLTexture.DoDraw(pt1, pt2, pt3, pt4: TPointF; AColor: TBGRAPixel); -type - TTexCoordIndex = array[0..3] of integer; -const - FLIP_TEXCOORD : array[ 0..3 ] of TTexCoordIndex = ( ( 0, 1, 2, 3 ), ( 1, 0, 3, 2 ), ( 3, 2, 1, 0 ), ( 2, 3, 0, 1 ) ); -var - coordFlip: TTexCoordIndex; -begin - if (FOpenGLTexture = nil) or (FFrame < 0) or (FFrame > FrameCount) then exit; - with TOpenGLTexture(FOpenGLTexture^) do - begin - glEnable( GL_BLEND ); - glEnable( GL_TEXTURE_2D ); - glBindTexture( GL_TEXTURE_2D, ID ); - - if FIsMask then - begin - glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB ); - glTexEnvi( GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_REPLACE ); - glTexEnvi( GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PRIMARY_COLOR_ARB ); - end else - glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE ); - - ApplyBlendMode(BlendMode); - - coordFlip := FLIP_TEXCOORD[ Integer(FFlipX) + Integer(FFlipY)*2 ]; - - glBegin( GL_QUADS ); - - if GradientColors then - InternalSetColor(FGradTopLeft) - else - InternalSetColor(AColor); - - glTexCoord2fv( @FramesCoord[FFrame,coordFlip[0]] ); - glVertex2fv( @pt1 ); - - if GradientColors then - InternalSetColor(FGradTopRight); - - glTexCoord2fv( @FramesCoord[FFrame,coordFlip[1]] ); - glVertex2fv( @pt2 ); - - if GradientColors then - InternalSetColor(FGradBottomRight); - - glTexCoord2fv( @FramesCoord[FFrame,coordFlip[2]] ); - glVertex2fv( @pt3 ); - - if GradientColors then - InternalSetColor(FGradBottomLeft); - - glTexCoord2fv( @FramesCoord[FFrame,coordFlip[3]] ); - glVertex2fv( @pt4 ); - - glEnd; - glDisable( GL_TEXTURE_2D ); - glDisable( GL_BLEND ); - end; -end; - -procedure TBGLTexture.DoStretchDraw(x, y, w, h: single; AColor: TBGRAPixel); -begin - DoDraw(PointF(x, y), PointF(x+w, y), PointF(x+w, y+h), PointF(x, y+h), AColor); -end; - -procedure TBGLTexture.DoStretchDrawAngle(x, y, w, h, angleDeg: single; - rotationCenter: TPointF; AColor: TBGRAPixel); -var - m : TAffineMatrix; -begin - m := AffineMatrixTranslation(rotationCenter.X,rotationCenter.Y)* - AffineMatrixRotationDeg(angleDeg)* - AffineMatrixTranslation(-rotationCenter.X,-rotationCenter.Y); - DoDraw(m*PointF(x, y), m*PointF(x+w, y), m*PointF(x+w, y+h), m*PointF(x, y+h), AColor); -end; - -procedure TBGLTexture.DoDrawAffine(Origin, HAxis, VAxis: TPointF; - AColor: TBGRAPixel); -begin - DoDraw(Origin, HAxis, HAxis+(VAxis-Origin), VAxis, AColor); -end; - -procedure TBGLTexture.ToggleFlipX; -begin - FFlipX := not FFlipX; -end; - -procedure TBGLTexture.ToggleFlipY; -begin - FFlipY := not FFlipY; -end; - -procedure TBGLTexture.Bind(ATextureNumber: integer); -begin - if (ATextureNumber < 0) or (ATextureNumber > 31) then - raise exception.Create('Texture number out of bounds'); - if (glActiveTexture = nil) then - begin - if not Load_GL_version_1_3 then - raise exception.Create('Cannot load OpenGL 1.3'); - end; - glActiveTexture(GL_TEXTURE0 + ATextureNumber); - glBindTexture(GL_TEXTURE_2D, POpenGLTexture(FOpenGLTexture)^.ID); - if ATextureNumber<>0 then - glActiveTexture(GL_TEXTURE0); -end; - -function TBGLTexture.FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture; -var shader: TBGLCustomShader; - blurName: string; -begin - blurName := 'TBGLBlurShader(' + RadialBlurTypeToStr[ABlurType] + ')'; - shader := BGLCanvas.Lighting.Shader[blurName]; - if shader = nil then - begin - shader := TBGLBlurShader.Create(BGLCanvas, ABlurType); - BGLCanvas.Lighting.Shader[blurName] := shader; - end; - with (shader as TBGLBlurShader) do - begin - Radius := ARadius; - Direction := ADirection; - result := FilterBlurMotion(self); - end; -end; - -function TBGLTexture.FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; -var shader: TBGLCustomShader; - blurName: String; -begin - blurName := 'TBGLBlurShader(' + RadialBlurTypeToStr[ABlurType] + ')'; - shader := BGLCanvas.Lighting.Shader[blurName]; - if shader = nil then - begin - shader := TBGLBlurShader.Create(BGLCanvas, ABlurType); - BGLCanvas.Lighting.Shader[blurName] := shader; - end; - with (shader as TBGLBlurShader) do - begin - Radius := ARadius; - result := FilterBlurRadial(self); - end; -end; - -procedure TBGLTexture.Init(ATexture: TBGLTextureHandle; AWidth, - AHeight: integer; AOwned: boolean); -begin - inherited Init(ATexture, AWidth, AHeight, AOwned); - FFlipX := false; - FFlipY := false; - FBlendMode := obmNormal; -end; - -procedure TBGLTexture.NotifyInvalidFrameSize; -begin - raise exception.Create('Invalid frame size'); -end; - -procedure TBGLTexture.NotifyErrorLoadingFile(AFilenameUTF8: string); -begin - raise exception.Create('Error loading file "'+AFilenameUTF8+'"'); -end; - -function TBGLTexture.NewEmpty: TBGLCustomTexture; -begin - result := TBGLTexture.Create; -end; - -function TBGLTexture.NewFromTexture(ATexture: TBGLTextureHandle; AWidth, - AHeight: integer): TBGLCustomTexture; -begin - result := TBGLTexture.Create(ATexture,AWidth,AHeight); -end; - -function TBGLTexture.Duplicate: TBGLCustomTexture; -begin - Result:= inherited Duplicate; - TBGLTexture(result).FFlipX := FFlipX; - TBGLTexture(result).FFlipY := FFlipY; -end; - -{ TBGLBitmap } - -function TBGLBitmap.GetOpenGLMaxTexSize: integer; -begin - result := 0; - glGetIntegerv( GL_MAX_TEXTURE_SIZE, @result ); -end; - -function TBGLBitmap.NewBitmap: TBGLBitmap; -begin - Result:=inherited NewBitmap as TBGLBitmap; -end; - -function TBGLBitmap.NewBitmap(AWidth, AHeight: integer): TBGLBitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight) as TBGLBitmap; -end; - -function TBGLBitmap.NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel - ): TBGLBitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGLBitmap; -end; - -function TBGLBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer - ): TBGLBitmap; -begin - Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGLBitmap; -end; - -function TBGLBitmap.NewBitmap(Filename: string): TBGLBitmap; -begin - Result:=inherited NewBitmap(Filename) as TBGLBitmap; -end; - -function TBGLBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGLBitmap; -begin - Result:=inherited NewBitmap(Filename, AIsUtf8) as TBGLBitmap; -end; - -function TBGLBitmap.NewBitmap(Filename: string; AIsUtf8: boolean; - AOptions: TBGRALoadingOptions): TBGLBitmap; -begin - Result:=inherited NewBitmap(Filename, AIsUtf8, AOptions) as TBGLBitmap; -end; - -function TBGLBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGLBitmap; -begin - Result:=inherited NewBitmap(AFPImage) as TBGLBitmap; -end; - -function TBGLBitmap.NewReference: TBGLBitmap; -begin - Result:=inherited NewReference as TBGLBitmap; -end; - -function TBGLBitmap.GetUnique: TBGLBitmap; -begin - Result:=inherited GetUnique as TBGLBitmap; -end; - -function TBGLBitmap.Duplicate(DuplicateProperties: Boolean): TBGLBitmap; -begin - Result:=inherited Duplicate(DuplicateProperties) as TBGLBitmap; -end; - -function TBGLBitmap.Duplicate(DuplicateProperties, DuplicateXorMask: Boolean): TBGLBitmap; -begin - Result:=inherited Duplicate(DuplicateProperties, DuplicateXorMask) as TBGLBitmap; -end; - -function TBGLBitmap.GetPart(const ARect: TRect): TBGLBitmap; -begin - Result:=inherited GetPart(ARect) as TBGLBitmap; -end; - -function TBGLBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, - ABackgroundColor: TBGRAPixel; AWidth: integer; AHeight: integer; - APenWidth: single): TBGLBitmap; -begin - Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor, - ABackgroundColor, AWidth, AHeight, APenWidth) as TBGLBitmap; -end; - -function TBGLBitmap.Resample(newWidth, newHeight: integer; mode: TResampleMode - ): TBGLBitmap; -begin - Result:=inherited Resample(newWidth, newHeight, mode) as TBGLBitmap; -end; - -function TBGLBitmap.FilterSmartZoom3(Option: TMedianOption): TBGLBitmap; -begin - Result:=inherited FilterSmartZoom3(Option) as TBGLBitmap; -end; - -function TBGLBitmap.FilterMedian(Option: TMedianOption): TBGLBitmap; -begin - Result:=inherited FilterMedian(Option) as TBGLBitmap; -end; - -function TBGLBitmap.FilterSmooth: TBGLBitmap; -begin - Result:=inherited FilterSmooth as TBGLBitmap; -end; - -function TBGLBitmap.FilterSharpen(Amount: single): TBGLBitmap; -begin - Result:=inherited FilterSharpen(Amount) as TBGLBitmap; -end; - -function TBGLBitmap.FilterSharpen(ABounds: TRect; Amount: single): TBGLBitmap; -begin - Result:=inherited FilterSharpen(ABounds, Amount) as TBGLBitmap; -end; - -function TBGLBitmap.FilterContour(AGammaCorrection: boolean = false): TBGLBitmap; -begin - Result:=inherited FilterContour(AGammaCorrection) as TBGLBitmap; -end; - -function TBGLBitmap.FilterPixelate(pixelSize: integer; useResample: boolean; - filter: TResampleFilter): TBGLBitmap; -begin - Result:=inherited FilterPixelate(pixelSize, useResample, filter) as TBGLBitmap; -end; - -function TBGLBitmap.FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGLBitmap; -begin - Result:=inherited FilterBlurRadial(radius, blurType) as TBGLBitmap; -end; - -function TBGLBitmap.FilterBlurRadial(const ABounds: TRect; radius: single; - blurType: TRadialBlurType): TBGLBitmap; -begin - Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TBGLBitmap; -end; - -function TBGLBitmap.FilterBlurRadial(radiusX, radiusY: single; - blurType: TRadialBlurType): TBGLBitmap; -begin - Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TBGLBitmap; -end; - -function TBGLBitmap.FilterBlurRadial(const ABounds: TRect; radiusX, - radiusY: single; blurType: TRadialBlurType): TBGLBitmap; -begin - Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TBGLBitmap; -end; - -function TBGLBitmap.FilterBlurMotion(distance: single; angle: single; - oriented: boolean): TBGLBitmap; -begin - Result:=inherited FilterBlurMotion(distance, angle, oriented) as TBGLBitmap; -end; - -function TBGLBitmap.FilterBlurMotion(const ABounds: TRect; distance: single; - angle: single; oriented: boolean): TBGLBitmap; -begin - Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TBGLBitmap; -end; - -function TBGLBitmap.FilterCustomBlur(mask: TCustomUniversalBitmap): TBGLBitmap; -begin - Result:=inherited FilterCustomBlur(mask) as TBGLBitmap; -end; - -function TBGLBitmap.FilterCustomBlur(const ABounds: TRect; - mask: TCustomUniversalBitmap): TBGLBitmap; -begin - Result:=inherited FilterCustomBlur(ABounds, mask) as TBGLBitmap; -end; - -function TBGLBitmap.FilterEmboss(angle: single; AStrength: integer; - AOptions: TEmbossOptions): TBGLBitmap; -begin - Result:=inherited FilterEmboss(angle, AStrength, AOptions) as TBGLBitmap; -end; - -function TBGLBitmap.FilterEmboss(angle: single; ABounds: TRect; - AStrength: integer; AOptions: TEmbossOptions): TBGLBitmap; -begin - Result:=inherited FilterEmboss(angle, ABounds, AStrength, AOptions) as TBGLBitmap; -end; - -function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean): TBGLBitmap; -begin - Result:=inherited FilterEmbossHighlight(FillSelection) as TBGLBitmap; -end; - -function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean; - BorderColor: TBGRAPixel): TBGLBitmap; -begin - Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor) as TBGLBitmap; -end; - -function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean; - BorderColor: TBGRAPixel; var Offset: TPoint): TBGLBitmap; -begin - Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor, Offset) as TBGLBitmap; -end; - -function TBGLBitmap.FilterGrayscale: TBGLBitmap; -begin - Result:=inherited FilterGrayscale as TBGLBitmap; -end; - -function TBGLBitmap.FilterGrayscale(ABounds: TRect): TBGLBitmap; -begin - Result:=inherited FilterGrayscale(ABounds) as TBGLBitmap; -end; - -function TBGLBitmap.FilterNormalize(eachChannel: boolean): TBGLBitmap; -begin - Result:=inherited FilterNormalize(eachChannel) as TBGLBitmap; -end; - -function TBGLBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean - ): TBGLBitmap; -begin - Result:=inherited FilterNormalize(ABounds, eachChannel) as TBGLBitmap; -end; - -function TBGLBitmap.FilterRotate(origin: TPointF; angle: single; - correctBlur: boolean): TBGLBitmap; -begin - Result:=inherited FilterRotate(origin, angle, correctBlur) as TBGLBitmap; -end; - -function TBGLBitmap.FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean - ): TBGLBitmap; -begin - Result:=inherited FilterAffine(AMatrix, correctBlur) as TBGLBitmap; -end; - -function TBGLBitmap.FilterSphere: TBGLBitmap; -begin - Result:=inherited FilterSphere as TBGLBitmap; -end; - -function TBGLBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; - ATurn: Single; AExponent: Single): TBGLBitmap; -begin - Result:=inherited FilterTwirl(ACenter, ARadius, ATurn, AExponent) as TBGLBitmap; -end; - -function TBGLBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint; - ARadius: Single; ATurn: Single; AExponent: Single): TBGLBitmap; -begin - Result:=inherited FilterTwirl(ABounds, ACenter, ARadius, ATurn, AExponent) as TBGLBitmap; -end; - -function TBGLBitmap.FilterCylinder: TBGLBitmap; -begin - Result:=inherited FilterCylinder as TBGLBitmap; -end; - -function TBGLBitmap.FilterPlane: TBGLBitmap; -begin - Result:=inherited FilterPlane as TBGLBitmap; -end; - -initialization - - BGLBitmapFactory := TBGLBitmap; - BGLTextureFactory := TBGLTexture; - BGRASpriteGL.BGLSpriteEngine := TBGLDefaultSpriteEngine.Create; - BGLCanvasInstance := TBGLCanvas.Create; - -finalization - - BGLCanvasInstance.Free; - BGLCanvasInstance := nil; - BGRASpriteGL.BGLSpriteEngine.Free; - BGRASpriteGL.BGLSpriteEngine := nil; - -end. - diff --git a/components/bgrabitmap/bgraopengl3d.pas b/components/bgrabitmap/bgraopengl3d.pas deleted file mode 100644 index b25e5da..0000000 --- a/components/bgrabitmap/bgraopengl3d.pas +++ /dev/null @@ -1,1017 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAOpenGL3D; - -{$mode objfpc}{$H+} - -interface - -uses BGRABitmapTypes, - BGRASceneTypes, BGRASSE, - BGRAClasses, BGRAMatrix3D, - BGRACanvasGL, - BGRAScene3D, - BGRAOpenGLType, - BGRATransform, - BGRARenderer3D; - -type - TAttributeVariable = BGRACanvasGL.TAttributeVariable; - - TBGLShader3D = class; - - { TBGLLighting3D } - - TBGLLighting3D = class - private - procedure SetUseBuiltIn(AValue: boolean); - protected - FCanvas: TBGLCustomCanvas; - FLights: TList; - FAmbiantLight: TColorF; - FShaderLightingCode: string; - FUseBuiltIn: boolean; - procedure Init; - public - constructor Create(ACanvas: TBGLCustomCanvas; AAmbiantLight: TColorF; ALights: TList); - procedure SetSpecularIndex(AIndex: Integer); - destructor Destroy; override; - property ShaderLightingCode: string read FShaderLightingCode; - property UseOpenGLBuiltInLighting: boolean read FUseBuiltIn write SetUseBuiltIn; - end; - - { TBGLRenderer3D } - - TBGLRenderer3D = class(TCustomRenderer3D) - protected - FCanvas: TBGLCustomCanvas; - FHasZBuffer: Boolean; - FGlobalScale: single; - FOptions: TRenderingOptions; - FFactorZ, FAddZ: single; - FLightingGL: TBGLLighting3D; - FLights: TList; - FAmbiantLight: TColorF; - FFar: single; - FOldCulling: TFaceCulling; - FOldMatrix: TAffineMatrix; - FOldProjection, FProjectionMatrix: TMatrix4D; - FShader, FShaderWithTexture: TBGLCustomShader; - FBGRAShader: TBGRAShader3D; - FShadedColorsF: array of TColorF; - FShadedColors: array of TBGRAPixel; - function GetHasZBuffer: boolean; override; - function GetGlobalScale: single; override; - function GetSurfaceWidth: integer; override; - function GetSurfaceHeight: integer; override; - procedure SetProjection(const AValue: TProjection3D); override; - function GetHandlesNearClipping: boolean; override; - function GetHandlesFaceCulling: boolean; override; - procedure InitLighting(AUseOpenGLBuiltInLighting: boolean); - public - constructor Create(ACanvas: TBGLCustomCanvas; - AScene: TBGRAScene3D; AFar: single); - function RenderFace(var ADescription: TFaceRenderingDescription; - {%H-}AComputeCoordinate: TComputeProjectionFunc): boolean; override; - destructor Destroy; override; - property Canvas: TBGLCustomCanvas read FCanvas; - end; - - { TBGLScene3D } - - TBGLScene3D = class(TBGRAScene3D) - protected - function LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; override; - public - procedure RenderGL(ACanvas: TBGLCustomCanvas; AMaxZ: single = 1000); virtual; - end; - - { TUniformVariable } - - TUniformVariable = object - private - FProgram: TBGLShader3D; - FVariable: LongWord; - procedure Init(AProgram: TBGLShader3D; AVariable: LongWord); - end; - - { TUniformVariableSingle } - - TUniformVariableSingle = object(TUniformVariable) - private - FValue: single; - procedure SetValue(const AValue: single); - public - procedure Update; - property Value: single read FValue write SetValue; - end; - - { TUniformVariablePointF } - - TUniformVariablePointF = object(TUniformVariable) - private - FValue: TPointF; - procedure SetValue(const AValue: TPointF); - public - procedure Update; - property Value: TPointF read FValue write SetValue; - end; - - { TUniformVariablePoint3D } - - TUniformVariablePoint3D = object(TUniformVariable) - private - FValue: TPoint3D; - procedure SetValue(const AValue: TPoint3D); - public - procedure Update; - property Value: TPoint3D read FValue write SetValue; - end; - - { TUniformVariableInteger } - - TUniformVariableInteger = object(TUniformVariable) - private - FValue: Integer; - procedure SetValue(const AValue: Integer); - public - procedure Update; - property Value: Integer read FValue write SetValue; - end; - - { TUniformVariablePoint } - - TUniformVariablePoint = object(TUniformVariable) - private - FValue: TPoint; - procedure SetValue(const AValue: TPoint); - public - procedure Update; - property Value: TPoint read FValue write SetValue; - end; - - { TUniformVariableMatrix4D } - - TUniformVariableMatrix4D = object(TUniformVariable) - private - FValue: TMatrix4D; - procedure SetValue(const AValue: TMatrix4D); - public - procedure Update; - property Value: TMatrix4D read FValue write SetValue; - end; - - { TAttributeVariableSingle } - - TAttributeVariableSingle = object(TAttributeVariable) - protected - procedure Init(AProgram: TObject; AAttribute: LongWord); - end; - - { TAttributeVariablePointF } - - TAttributeVariablePointF = object(TAttributeVariable) - protected - procedure Init(AProgram: TObject; AAttribute: LongWord); - end; - - { TAttributeVariablePoint3D } - - TAttributeVariablePoint3D = object(TAttributeVariable) - protected - procedure Init(AProgram: TObject; AAttribute: LongWord); - end; - - { TAttributeVariableInteger } - - TAttributeVariableInteger = object(TAttributeVariable) - protected - procedure Init(AProgram: TObject; AAttribute: LongWord); - end; - - { TAttributeVariablePoint } - - TAttributeVariablePoint = object(TAttributeVariable) - protected - procedure Init(AProgram: TObject; AAttribute: LongWord); - end; - - { TBGLShader3D } - - TBGLShader3D = class(TBGLCustomShader) - protected - FUsed: boolean; - FCanvas: TBGLCustomCanvas; - FLighting: TBGLCustomLighting; - FVertexShaderSource, - FFragmentShaderSource: string; - FVertexShader, - FFragmentShader, - FProgram: LongWord; - function GetUniformVariableSingle(AName: string): TUniformVariableSingle; - function GetUniformVariablePointF(AName: string): TUniformVariablePointF; - function GetUniformVariablePoint3D(AName: string): TUniformVariablePoint3D; - function GetUniformVariableInteger(AName: string): TUniformVariableInteger; - function GetUniformVariablePoint(AName: string): TUniformVariablePoint; - function GetUniformVariableMatrix4D(AName: string): TUniformVariableMatrix4D; - function GetAttributeVariableInteger(AName: string): TAttributeVariableInteger; - function GetAttributeVariablePoint(AName: string): TAttributeVariablePoint; - function GetAttributeVariableSingle(AName: string): TAttributeVariableSingle; - function GetAttributeVariablePointF(AName: string): TAttributeVariablePointF; - function GetAttributeVariablePoint3D(AName: string): TAttributeVariablePoint3D; - procedure SetUniformSingle(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); - procedure SetUniformInteger(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); - procedure CheckUsage(AUsing: boolean); - procedure StartUse; override; - procedure EndUse; override; - property Canvas: TBGLCustomCanvas read FCanvas; - public - constructor Create(ACanvas: TBGLCustomCanvas; AVertexShaderSource: string; - AFragmentShaderSource: string; AVaryingVariables: string = ''; - AVersion: string = '120'); - destructor Destroy; override; - property UniformSingle[AName: string]: TUniformVariableSingle read GetUniformVariableSingle; - property UniformPointF[AName: string]: TUniformVariablePointF read GetUniformVariablePointF; - property UniformPoint3D[AName: string]: TUniformVariablePoint3D read GetUniformVariablePoint3D; - property UniformInteger[AName: string]: TUniformVariableInteger read GetUniformVariableInteger; - property UniformPoint[AName: string]: TUniformVariablePoint read GetUniformVariablePoint; - property UniformMatrix4D[AName: string]: TUniformVariableMatrix4D read GetUniformVariableMatrix4D; - property AttributeSingle[AName: string]: TAttributeVariableSingle read GetAttributeVariableSingle; - property AttributePointF[AName: string]: TAttributeVariablePointF read GetAttributeVariablePointF; - property AttributePoint3D[AName: string]: TAttributeVariablePoint3D read GetAttributeVariablePoint3D; - property AttributeInteger[AName: string]: TAttributeVariableInteger read GetAttributeVariableInteger; - property AttributePoint[AName: string]: TAttributeVariablePoint read GetAttributeVariablePoint; - property IsUsed: boolean read FUsed; - end; - -function ProjectionToOpenGL(AProj: TProjection3D; ANear, AFar: Single): TMatrix4D; - -implementation - -uses SysUtils, BGRAColorInt; - -type - - { TShaderWithTexture } - - TShaderWithTexture = class(TBGLShader3D) - private - function GetTexture: integer; - procedure SetTexture(AValue: integer); - protected - FTextureUniform: TUniformVariableInteger; - procedure StartUse; override; - public - class function GetCodeForTextureColor: string; static; - constructor Create(ACanvas: TBGLCustomCanvas; AFragmentShader: string; ATexture: integer = 0); - property Texture: integer read GetTexture write SetTexture; - end; - -function ProjectionToOpenGL(AProj: TProjection3D; ANear, AFar: Single): TMatrix4D; -begin - result[1,1] := AProj.Zoom.X; result[2,1] := 0; result[3,1] := -(AProj.Center.x + 0.5); result[4,1] := 0; - result[1,2] := 0; result[2,2] := AProj.Zoom.Y; result[3,2] := -(AProj.Center.y + 0.5); result[4,2] := 0; - result[1,3] := 0; result[2,3] := 0; result[3,3] := -2/(AFar-ANear); result[4,3] := -1 - AFar*result[3,3]; - result[1,4] := 0; result[2,4] := 0; result[3,4] := -1; result[4,4] := 0; -end; - -{ TUniformVariableMatrix4D } - -procedure TUniformVariableMatrix4D.SetValue(const AValue: TMatrix4D); -begin - if CompareMem(@AValue, @FValue, sizeof(FValue)) then Exit; - FValue:=AValue; - if FProgram.IsUsed then Update; -end; - -procedure TUniformVariableMatrix4D.Update; -begin - FProgram.SetUniformSingle(FVariable, FValue, 1, 16); -end; - -{ TShaderWithTexture } - -function TShaderWithTexture.GetTexture: integer; -begin - result := FTextureUniform.Value; -end; - -procedure TShaderWithTexture.SetTexture(AValue: integer); -begin - FTextureUniform.Value := AValue; -end; - -procedure TShaderWithTexture.StartUse; -begin - inherited StartUse; - FTextureUniform.Update; -end; - -class function TShaderWithTexture.GetCodeForTextureColor: string; -begin - result := 'texture2D(texture, texture_coordinate)'; -end; - -constructor TShaderWithTexture.Create(ACanvas: TBGLCustomCanvas; - AFragmentShader: string; ATexture: integer); -begin - inherited Create(ACanvas, - 'void main(void) ' + - '{ ' + - ' gl_Position = gl_ProjectionMatrix * gl_Vertex; ' + - ' texture_coordinate = vec2(gl_MultiTexCoord0); ' + - ' N = gl_Normal; ' + - ' V = vec3(gl_Vertex); ' + - '} ', - - 'uniform sampler2D texture; ' + - AFragmentShader, - - 'varying vec2 texture_coordinate; ' + - 'varying vec3 N; ' + - 'varying vec3 V; '); - FTextureUniform := UniformInteger['texture']; - Texture := ATexture; -end; - -{ TAttributeVariablePoint3D } - -procedure TAttributeVariablePoint3D.Init(AProgram: TObject; AAttribute: LongWord); -begin - inherited Init(AProgram,AAttribute,3,True); -end; - -{ TAttributeVariablePointF } - -procedure TAttributeVariablePointF.Init(AProgram: TObject; AAttribute: LongWord); -begin - inherited Init(AProgram,AAttribute,2,True); -end; - -{ TAttributeVariableInteger } - -procedure TAttributeVariableInteger.Init(AProgram: TObject; AAttribute: LongWord); -begin - inherited Init(AProgram,AAttribute,1,False); -end; - -{ TAttributeVariablePoint } - -procedure TAttributeVariablePoint.Init(AProgram: TObject; AAttribute: LongWord); -begin - inherited Init(AProgram,AAttribute,2,False); -end; - -{ TAttributeVariableSingle } - -procedure TAttributeVariableSingle.Init(AProgram: TObject; AAttribute: LongWord); -begin - inherited Init(AProgram,AAttribute,1,True); -end; - -{ TUniformVariablePoint } - -procedure TUniformVariablePoint.SetValue(const AValue: TPoint); -begin - if (FValue.x=AValue.x) and (FValue.y=AValue.y) then Exit; - FValue:=AValue; - if FProgram.IsUsed then Update; -end; - -procedure TUniformVariablePoint.Update; -begin - FProgram.SetUniformInteger(FVariable, FValue, 1, 2); -end; - -{ TUniformVariableInteger } - -procedure TUniformVariableInteger.SetValue(const AValue: Integer); -begin - if FValue=AValue then Exit; - FValue:=AValue; - if FProgram.IsUsed then Update; -end; - -procedure TUniformVariableInteger.Update; -begin - FProgram.SetUniformInteger(FVariable, FValue, 1, 1); -end; - -{ TUniformVariablePoint3D } - -procedure TUniformVariablePoint3D.SetValue(const AValue: TPoint3D); -begin - if (FValue.x=AValue.x) and (FValue.y=AValue.y) and (FValue.z=AValue.z) then Exit; - FValue:=AValue; - if FProgram.IsUsed then Update; -end; - -procedure TUniformVariablePoint3D.Update; -begin - FProgram.SetUniformSingle(FVariable, FValue, 1, 3); -end; - -{ TUniformVariablePointF } - -procedure TUniformVariablePointF.SetValue(const AValue: TPointF); -begin - if (FValue.x=AValue.x) and (FValue.y=AValue.y) then Exit; - FValue:=AValue; - if FProgram.IsUsed then Update; -end; - -procedure TUniformVariablePointF.Update; -begin - FProgram.SetUniformSingle(FVariable, FValue, 1, 2); -end; - -{ TUniformVariableSingle } - -procedure TUniformVariableSingle.SetValue(const AValue: single); -begin - if FValue=AValue then Exit; - FValue:=AValue; - if FProgram.IsUsed then Update; -end; - -procedure TUniformVariableSingle.Update; -begin - FProgram.SetUniformSingle(FVariable, FValue, 1, 1); -end; - -{ TUniformVariable } - -procedure TUniformVariable.Init(AProgram: TBGLShader3D; AVariable: LongWord); -begin - FProgram := AProgram; - FVariable := AVariable; -end; - -{ TBGLShader3D } - -function TBGLShader3D.GetUniformVariableSingle(AName: string): TUniformVariableSingle; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetUniformVariablePointF(AName: string): TUniformVariablePointF; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetUniformVariablePoint3D(AName: string): TUniformVariablePoint3D; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetUniformVariableInteger(AName: string): TUniformVariableInteger; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetUniformVariablePoint(AName: string): TUniformVariablePoint; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetUniformVariableMatrix4D(AName: string): TUniformVariableMatrix4D; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetUniformVariable(FProgram, AName)); - {$pop} -end; - -procedure TBGLShader3D.CheckUsage(AUsing: boolean); -begin - if AUsing <> FUsed then - begin - if FUsed then raise exception.Create('Shader is in use') else - raise exception.Create('Shader is not in use'); - end; -end; - -function TBGLShader3D.GetAttributeVariableSingle(AName: string): TAttributeVariableSingle; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetAttributeVariablePointF(AName: string): TAttributeVariablePointF; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetAttributeVariablePoint3D(AName: string): TAttributeVariablePoint3D; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetAttributeVariableInteger(AName: string): TAttributeVariableInteger; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); - {$pop} -end; - -function TBGLShader3D.GetAttributeVariablePoint(AName: string): TAttributeVariablePoint; -begin - {$push}{$hints off} - fillchar(result,sizeof(result),0); - result.Init(self, FCanvas.Lighting.GetAttribVariable(FProgram, AName)); - {$pop} -end; - -procedure TBGLShader3D.SetUniformSingle(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); -begin - CheckUsage(True); - FCanvas.Lighting.SetUniformSingle(AVariable, AValue, AElementCount, AComponentCount); -end; - -procedure TBGLShader3D.SetUniformInteger(AVariable: LongWord; const AValue; AElementCount: integer; AComponentCount: integer); -begin - CheckUsage(True); - FCanvas.Lighting.SetUniformInteger(AVariable, AValue, AElementCount, AComponentCount); -end; - -constructor TBGLShader3D.Create(ACanvas: TBGLCustomCanvas; - AVertexShaderSource: string; AFragmentShaderSource: string; - AVaryingVariables: string; AVersion: string); -begin - FCanvas := ACanvas; - FLighting := FCanvas.Lighting; - FVertexShaderSource:= '#version ' + AVersion + #10 + AVaryingVariables + #10 + AVertexShaderSource; - FFragmentShaderSource:= '#version ' + AVersion + #10 + AVaryingVariables + #10 + AFragmentShaderSource; - FVertexShader := 0; - FFragmentShader := 0; - FProgram := 0; - try - FVertexShader := FLighting.MakeVertexShader(FVertexShaderSource); - FFragmentShader := FLighting.MakeFragmentShader(FFragmentShaderSource); - FProgram := FLighting.MakeShaderProgram(FVertexShader,FFragmentShader); - except on ex:Exception do - begin - FLighting.DeleteShaderProgram(FProgram); - FLighting.DeleteShaderObject(FFragmentShader); - FLighting.DeleteShaderObject(FVertexShader); - raise ex; - end; - end; -end; - -destructor TBGLShader3D.Destroy; -begin - if IsUsed then raise exception.Create('Shader is still in use'); - inherited Destroy; -end; - -procedure TBGLShader3D.StartUse; -begin - CheckUsage(False); - FLighting.UseProgram(FProgram); - FUsed:= True; -end; - -procedure TBGLShader3D.EndUse; -begin - CheckUsage(True); - FLighting.UseProgram(0); - FUsed:= False; -end; - -{ TBGLLighting3D } - -procedure TBGLLighting3D.SetUseBuiltIn(AValue: boolean); -begin - if FUseBuiltIn=AValue then Exit; - FUseBuiltIn:=AValue; - FCanvas.Lighting.BuiltInLightingEnabled := FUseBuiltIn; -end; - -procedure TBGLLighting3D.Init; -var - i: Integer; - v: TPoint3D; - int: single; - num: string; - minInt: string; - colorMult: TColorF; -begin - FShaderLightingCode:= - 'void main(void) ' + - '{ ' + - ' vec3 L, H; float d; float sat, sumUnsat; vec4 color, clampedColor; vec4 unsat; ' + - ' vec3 Idiff = vec3(gl_LightModel.ambient); ' + - ' vec4 Ispec = vec4(0,0,0,0); ' + - ' vec3 NN = normalize(N); '; - with FCanvas.Lighting do - begin - AmbiantLightF := FAmbiantLight; - for i := 0 to FLights.Count-1 do - with TBGRALight3D(FLights[i]) do - begin - str(GetMinIntensity,minInt); - if IsDirectional then - begin - v := -GetDirection; - v.z := -v.z; - num := IntToStr(AddDirectionalLight(GetColorF, v)); - str(GetMinIntensity,minInt); - AppendStr(FShaderLightingCode, - ' L = gl_LightSource['+num+'].position.xyz; ' + - ' Idiff += vec3(gl_LightSource['+num+'].diffuse * max(dot(NN,L), '+minInt+') ); ' + - ' if (gl_FrontMaterial.shininess > 0) { ' + - ' H = normalize(L + vec3(0,0,1)); ' + - ' Ispec += gl_LightSource['+num+'].specular * pow(abs(dot(NN,H)), gl_FrontMaterial.shininess*2); ' + - ' } '); - end - else - begin - int := GetIntensity*0.75; - if int > 0 then - begin - v := GetPosition; - v.z := -v.z; - colorMult := GetColorF * ColorF(int,int,int,1); - num := IntToStr(AddPointLight(colorMult, v, 0,1)); - str(GetMinIntensity/int,minInt); - AppendStr(FShaderLightingCode, - ' L = (gl_LightSource['+num+'].position.xyz - V).xyz; ' + - ' d = length(L); ' + - ' L *= 1/d; ' + - ' Idiff += vec3(gl_LightSource['+num+'].diffuse * max(dot(NN,L)/(d*d), '+minInt+') ); ' + - ' if (gl_FrontMaterial.shininess > 0) { ' + - ' H = normalize(L + vec3(0,0,1)); ' + - ' Ispec += gl_LightSource['+num+'].specular * pow(abs(dot(NN,H))/(d*d), gl_FrontMaterial.shininess*2); ' + - ' } '); - end; - end; - - end; - end; - AppendStr(FShaderLightingCode, - ' color = #color# * vec4(Idiff,1) + Ispec; ' + - ' clampedColor = clamp(color,0,1); ' + - ' sat = dot( color - clampedColor, vec4(1) ); ' + - ' if (sat > 0) { ' + - ' unsat = vec4(1) - clampedColor; ' + - ' sumUnsat = unsat[0]+unsat[1]+unsat[2]; ' + - ' if (sumUnsat > 0) { ' + - ' sat *= max(max(unsat[0],unsat[1]),unsat[2]) / sumUnsat; ' + - ' gl_FragColor = clamp(color + vec4(sat,sat,sat,0),0,1); ' + - ' } ' + - ' else gl_FragColor = clampedColor; ' + - ' } ' + - ' else gl_FragColor = clampedColor; ' + - '} '); -end; - -constructor TBGLLighting3D.Create(ACanvas: TBGLCustomCanvas; AAmbiantLight: TColorF; ALights: TList); -begin - FCanvas := ACanvas; - FLights := ALights; - FAmbiantLight := AAmbiantLight; - Init; -end; - -procedure TBGLLighting3D.SetSpecularIndex(AIndex: Integer); -begin - FCanvas.Lighting.SetSpecularIndex(AIndex); -end; - -destructor TBGLLighting3D.Destroy; -begin - FCanvas.Lighting.SetSpecularIndex(0); - FCanvas.Lighting.ClearLights; - UseOpenGLBuiltInLighting := false; - inherited Destroy; -end; - -{ TBGLScene3D } - -function TBGLScene3D.LoadBitmapFromFileUTF8(AFilenameUTF8: string - ): TBGRACustomBitmap; -begin - if BGLBitmapFactory <> nil then - Result:= BGLBitmapFactory.Create(AFilenameUTF8,True) - else - result := inherited LoadBitmapFromFileUTF8(AFilenameUTF8); -end; - -procedure TBGLScene3D.RenderGL(ACanvas: TBGLCustomCanvas; AMaxZ: single); -var - renderer: TBGLRenderer3D; -begin - renderer := TBGLRenderer3D.Create(ACanvas, self, AMaxZ); - Render(renderer); - renderer.Free; -end; - -{ TBGLRenderer3D } - -function TBGLRenderer3D.GetHasZBuffer: boolean; -begin - result := FHasZBuffer; -end; - -function TBGLRenderer3D.GetGlobalScale: single; -begin - result := FGlobalScale; -end; - -function TBGLRenderer3D.GetSurfaceWidth: integer; -begin - result := FCanvas.Width; -end; - -function TBGLRenderer3D.GetSurfaceHeight: integer; -begin - result := FCanvas.Height; -end; - -{$PUSH}{$OPTIMIZATION OFF} //avoid internal error 2012090607 -procedure TBGLRenderer3D.SetProjection(const AValue: TProjection3D); -begin - inherited SetProjection(AValue); - FProjectionMatrix := ProjectionToOpenGL(AValue, FOptions.MinZ, FFar) * - OrthoProjectionToOpenGL(0,0,FCanvas.Width,FCanvas.Height); - FCanvas.ProjectionMatrix := FProjectionMatrix; -end; -{$POP} - -function TBGLRenderer3D.GetHandlesNearClipping: boolean; -begin - result := true; -end; - -function TBGLRenderer3D.GetHandlesFaceCulling: boolean; -begin - result := FShader <> nil; -end; - -procedure TBGLRenderer3D.InitLighting(AUseOpenGLBuiltInLighting: boolean); -var - fragmentShaderCode: string; -begin - if not Assigned(FLightingGL) then - begin - FLightingGL := TBGLLighting3D.Create(FCanvas, FAmbiantLight, FLights); - - if (FOptions.LightingInterpolation <> liLowQuality) and FCanvas.Lighting.SupportShaders then - begin - fragmentShaderCode := StringReplace(FLightingGL.ShaderLightingCode, '#color#', 'gl_Color', []); - FShader := FCanvas.Lighting.Shader[fragmentShaderCode]; - if (FShader = nil) and FCanvas.Lighting.SupportShaders then - begin - FShader := TBGLShader3D.Create(FCanvas, - 'void main(void) ' + - '{ ' + - ' gl_Position = gl_ProjectionMatrix * gl_Vertex; ' + - ' gl_FrontColor = gl_Color; ' + - ' gl_BackColor = gl_Color; ' + - ' N = gl_Normal; ' + - ' V = vec3(gl_Vertex); ' + - '} ', - - fragmentShaderCode, - - 'varying vec3 N; ' + - 'varying vec3 V; '); - FCanvas.Lighting.Shader[fragmentShaderCode] := FShader; - end; - - fragmentShaderCode := StringReplace(FLightingGL.ShaderLightingCode, '#color#', TShaderWithTexture.GetCodeForTextureColor, []); - FShaderWithTexture := FCanvas.Lighting.Shader[fragmentShaderCode]; - if (FShaderWithTexture = nil) and FCanvas.Lighting.SupportShaders then - begin - FShaderWithTexture := TShaderWithTexture.Create(FCanvas, fragmentShaderCode, 0); - FCanvas.Lighting.Shader[fragmentShaderCode] := FShaderWithTexture; - end; - end else - begin - FLightingGL.UseOpenGLBuiltInLighting := AUseOpenGLBuiltInLighting; - if not AUseOpenGLBuiltInLighting then - FBGRAShader := TBGRAShader3D.Create(FAmbiantLight, FLights); - end; - end; -end; - -constructor TBGLRenderer3D.Create(ACanvas: TBGLCustomCanvas; - AScene: TBGRAScene3D; AFar: single); -begin - FCanvas := ACanvas; - FOptions := AScene.RenderingOptions; - FLights := AScene.MakeLightList; - FAmbiantLight := AScene.AmbiantLightColorF; - FGlobalScale:= 1; - FHasZBuffer := FOptions.PerspectiveMode = pmZBuffer; - FFactorZ := -2/(FFar-FOptions.MinZ); - FAddZ := -1 - FFar*FFactorZ; - FFar := AFar; - if FHasZBuffer then ACanvas.StartZBuffer; - FOldCulling:= FCanvas.FaceCulling; - FOldMatrix := FCanvas.Matrix; - FCanvas.ResetTransform; - FOldProjection := FCanvas.ProjectionMatrix; - FCanvas.ProjectionMatrix := MatrixIdentity4D; - - FShader := nil; - FShaderWithTexture := nil; - - InitLighting(False); -end; - -function TBGLRenderer3D.RenderFace(var ADescription: TFaceRenderingDescription; - AComputeCoordinate: TComputeProjectionFunc): boolean; -var - NormalCenter3D,PtCenter3D: TPoint3D_128; - ColorCenter: TBGRAPixel; - - procedure ComputeCenter; - var j: Int32or64; - begin - with ADescription do - begin - PtCenter3D := Point3D_128_Zero; - NormalCenter3D := Point3D_128_Zero; - for j := 0 to NbVertices-1 do - begin - PtCenter3D.Offset(Positions3D[j]); - NormalCenter3D.Offset(Normals3D[j]); - end; - PtCenter3D.Scale(1/NbVertices); - Normalize3D_128(NormalCenter3D); - ColorCenter := MergeBGRA(slice(Colors,NbVertices)); - end; - end; - -var tex: IBGLTexture; - i,j: Int32or64; -begin - result := true; - - if not ProjectionDefined then - raise exception.Create('Projection must be defined before drawing faces'); - - If ADescription.Texture <> nil then - tex := ADescription.Texture.GetTextureGL as IBGLTexture - else - tex := nil; - - with ADescription do - begin - if ADescription.Biface then - FCanvas.FaceCulling := fcNone - else - FCanvas.FaceCulling := fcKeepCW; - - if ADescription.Material.GetSpecularOn then - FLightingGL.SetSpecularIndex(ADescription.Material.GetSpecularIndex) - else - FLightingGL.SetSpecularIndex(0); - - if tex <> nil then - begin - FCanvas.Lighting.ActiveShader := FShaderWithTexture; - - if Assigned(FBGRAShader) then - begin - FBGRAShader.Prepare(ADescription); - - if length(FShadedColorsF) < NbVertices then - setlength(FShadedColorsF, NbVertices); - for i := 0 to NbVertices-1 do - FShadedColorsF[i] := BGRAToColorF(ColorIntToBGRA(FBGRAShader.Int65536Apply(Positions3D[i],Normals3D[i],BGRAWhite), true), false); - - for i := 0 to NbVertices-1 do - Positions3D[i].z := -Positions3D[i].z; - - if NbVertices = 3 then - tex.DrawTriangle(slice(Positions3D,3),slice(TexCoords,3),slice(FShadedColorsF,3)) - else if NbVertices = 4 then - tex.DrawQuad(slice(Positions3D,4),slice(TexCoords,4),slice(FShadedColorsF,4)); - end else - begin - for i := 0 to NbVertices-1 do - begin - Positions3D[i].z := -Positions3D[i].z; - Normals3D[i].z := -Normals3D[i].z; - end; - - if NbVertices = 3 then - tex.DrawTriangle(slice(Positions3D,3),slice(Normals3D,3),slice(TexCoords,3)) - else if NbVertices = 4 then - tex.DrawQuad(slice(Positions3D,4),slice(Normals3D,4),slice(TexCoords,4)); - end; - end - else - begin - FCanvas.Lighting.ActiveShader := FShader; - - if Assigned(FBGRAShader) then - begin - FBGRAShader.Prepare(ADescription); - - if length(FShadedColors) < NbVertices then - setlength(FShadedColors, NbVertices); - for i := 0 to NbVertices-1 do - FShadedColors[i] := FBGRAShader.Apply(Positions3D[i],Normals3D[i],Colors[i]); - - if NbVertices > 4 then - begin - ComputeCenter; - ColorCenter := FBGRAShader.Apply(PtCenter3D,NormalCenter3D,MergeBGRA(slice(Colors,NbVertices))); - - for i := 0 to NbVertices-1 do - Positions3D[i].z := -Positions3D[i].z; - PtCenter3D.z := -PtCenter3D.z; - - i := NbVertices-1; - for j := 0 to NbVertices-1 do - begin - FCanvas.FillTrianglesLinearColor( - [Positions3D[i],Positions3D[j],PtCenter3D], - [FShadedColors[i],FShadedColors[j],ColorCenter]); - i := j; - end; - end else - begin - for i := 0 to NbVertices-1 do - Positions3D[i].z := -Positions3D[i].z; - - if NbVertices = 3 then - FCanvas.FillTrianglesLinearColor(slice(Positions3D,3),slice(FShadedColors,3)) - else if NbVertices = 4 then - FCanvas.FillQuadsLinearColor(slice(Positions3D,4),slice(FShadedColors,4)); - end; - end else - begin - for i := 0 to NbVertices-1 do - begin - Positions3D[i].z := -Positions3D[i].z; - Normals3D[i].z := -Normals3D[i].z; - end; - - if NbVertices > 4 then - begin - ComputeCenter; - - i := NbVertices-1; - for j := 0 to NbVertices-1 do - begin - FCanvas.FillTrianglesLinearColor( - [Positions3D[i],Positions3D[j],PtCenter3D], - [Normals3D[i],Normals3D[j],NormalCenter3D], - [Colors[i],Colors[j],ColorCenter]); - i := j; - end; - end else - begin - if NbVertices = 3 then - FCanvas.FillTrianglesLinearColor(slice(Positions3D,3),slice(Normals3D,3),slice(Colors,3)) - else if NbVertices = 4 then - FCanvas.FillQuadsLinearColor(slice(Positions3D,4),slice(Normals3D,4),slice(Colors,4)); - end; - end; - end; - end; -end; - -destructor TBGLRenderer3D.Destroy; -begin - FreeAndNil(FBGRAShader); - FCanvas.Lighting.ActiveShader := nil; - FCanvas.ProjectionMatrix := FOldProjection; - FCanvas.Matrix := FOldMatrix; - FCanvas.FaceCulling := FOldCulling; - FreeAndNil(FLightingGL); - if FHasZBuffer then FCanvas.EndZBuffer; - FLights.Free; - inherited Destroy; -end; - - -end. diff --git a/components/bgrabitmap/bgraopengltype.pas b/components/bgrabitmap/bgraopengltype.pas deleted file mode 100644 index 668b0b2..0000000 --- a/components/bgrabitmap/bgraopengltype.pas +++ /dev/null @@ -1,1753 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAOpenGLType; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAGraphics, BGRABitmap, BGRABitmapTypes, - FPimage, BGRAClasses, SysUtils, BGRATransform, - BGRASSE, BGRAMatrix3D; - -type - TBGLTextureHandle = type Pointer; - TOpenGLResampleFilter = (orfBox,orfLinear); - TOpenGLBlendMode = (obmNormal, obmAdd, obmMultiply); - TWaitForGPUOption = (wfgQueueAllCommands, wfgFinishAllCommands); - TFaceCulling = BGRABitmapTypes.TFaceCulling; - TOpenGLPrimitive = (opPoints,opLineStrip,opLineLoop,opLines, - opTriangleStrip,opTriangleFan,opTriangles); - -const - fcNone = BGRABitmapTypes.fcNone; - fcKeepCW = BGRABitmapTypes.fcKeepCW; - fcKeepCCW = BGRABitmapTypes.fcKeepCCW; - -type - - { IBGLFont } - - IBGLFont = interface - function GetClipped: boolean; - function GetPadding: TRectF; - function GetUseGradientColors: boolean; - function GetHorizontalAlign: TAlignment; - function GetJustify: boolean; - function GetScale: single; - function GetStepX: single; - function GetVerticalAlign: TTextLayout; - procedure SetClipped(AValue: boolean); - procedure SetPadding(AValue: TRectF); - procedure SetUseGradientColors(AValue: boolean); - procedure SetHorizontalAlign(AValue: TAlignment); - procedure SetJustify(AValue: boolean); - procedure SetScale(AValue: single); - procedure SetStepX(AValue: single); - procedure SetVerticalAlign(AValue: TTextLayout); - procedure TextOut(X, Y: Single; const Text : UTF8String); overload; - procedure TextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; - procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; - procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - function TextWidth(const Text: UTF8String): single; - function TextHeight(const Text: UTF8String): single; overload; - function TextHeight(const Text: UTF8String; AWidth: single): single; overload; - procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); - - property Scale: single read GetScale write SetScale; - property StepX: single read GetStepX write SetStepX; - property Justify: boolean read GetJustify write SetJustify; - property Clipped: boolean read GetClipped write SetClipped; - property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign; - property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign; - property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; - property Padding: TRectF read GetPadding write SetPadding; - end; - - { TBGLCustomFont } - - TBGLCustomFont = class(TInterfacedObject, IBGLFont) - protected - FScale, FStepX: single; - FPadding: TRectF; - FFlags: LongWord; - FHorizontalAlign: TAlignment; - FVerticalAlign: TTextLayout; - FJustify: boolean; - procedure Init; virtual; - function LoadFromFile(AFilename: UTF8String): boolean; virtual; abstract; - procedure FreeMemoryOnDestroy; virtual; - - function GetScale: single; virtual; - function GetStepX: single; virtual; - procedure SetScale(AValue: single); virtual; - procedure SetStepX(AValue: single); virtual; - function GetPadding: TRectF; - procedure SetPadding(AValue: TRectF); virtual; - - function GetHorizontalAlign: TAlignment; virtual; - function GetJustify: boolean; virtual; - function GetVerticalAlign: TTextLayout; virtual; - procedure SetHorizontalAlign(AValue: TAlignment); virtual; - procedure SetJustify(AValue: boolean); virtual; - procedure SetVerticalAlign(AValue: TTextLayout); virtual; - - function GetClipped: boolean; virtual; abstract; - function GetUseGradientColors: boolean; virtual; abstract; - procedure SetClipped(AValue: boolean); virtual; abstract; - procedure SetUseGradientColors(AValue: boolean); virtual; abstract; - - procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); virtual; abstract; - procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); virtual; abstract; - - function GetDefaultColor: TBGRAPixel; virtual; - procedure SwapRectIfNeeded(var ARect: TRectF); overload; - procedure SwapRectIfNeeded(var ARect: TRect); overload; - public - constructor Create(AFilename: UTF8String); - procedure FreeMemory; virtual; - destructor Destroy; override; - procedure TextOut(X, Y: Single; const Text : UTF8String); overload; - procedure TextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; - procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; - procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; - procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRect; const Text : UTF8String); overload; - procedure TextRect(ARect: TRect; const Text : UTF8String; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRect; const Text : UTF8String; AVertAlign: TTextLayout); overload; - procedure TextRect(ARect: TRect; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRect; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; - procedure TextRect(ARect: TRect; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload; - procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - function TextWidth(const Text: UTF8String): single; virtual; abstract; - function TextHeight(const Text: UTF8String): single; overload; virtual; abstract; - function TextHeight(const Text: UTF8String; AWidth: single): single; overload; virtual; abstract; - procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); virtual; abstract; - - property Scale: single read GetScale write SetScale; - property StepX: single read GetStepX write SetStepX; - property Justify: boolean read GetJustify write SetJustify; - property Clipped: boolean read GetClipped write SetClipped; - property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign; - property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign; - property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; - property Padding: TRectF read GetPadding write SetPadding; - end; - - { IBGLTexture } - - IBGLTexture = interface ['{BF2FF051-EBC6-4102-8268-37A9D0297B92}'] - function GetFlipX: IBGLTexture; - function GetFlipY: IBGLTexture; - function GetFrame(AIndex: integer): IBGLTexture; - function GetFrameCount: integer; - function GetFrameHeight: integer; - function GetFrameWidth: integer; - function GetHeight: integer; - function GetImageCenter: TPointF; - function GetMask: IBGLTexture; - function GetOpenGLBlendMode: TOpenGLBlendMode; - function GetOpenGLTexture: TBGLTextureHandle; - function GetResampleFilter: TOpenGLResampleFilter; - function GetUseGradientColors: boolean; - function GetWidth: integer; - - procedure SetFrameSize(x,y: integer); - procedure SetImageCenter(const AValue: TPointF); - procedure SetOpenGLBlendMode(AValue: TOpenGLBlendMode); - procedure SetResampleFilter(AValue: TOpenGLResampleFilter); - procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); - procedure SetUseGradientColors(AValue: boolean); - procedure Update(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true); - procedure ToggleFlipX; - procedure ToggleFlipY; - procedure ToggleMask; - function FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture; - function FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; - procedure SetFrame(AIndex: integer); - procedure FreeMemory; - procedure Bind(ATextureNumber: integer); - - procedure Draw(x,y: single; AAlpha: byte = 255); overload; - procedure Draw(x,y: single; AColor: TBGRAPixel); overload; - procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure StretchDraw(x,y,w,h: single; AAlpha: byte = 255); overload; - procedure StretchDraw(x,y,w,h: single; AColor: TBGRAPixel); overload; - procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; - procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; - procedure DrawAngle(x,y,angleDeg: single; AAlpha: byte = 255); overload; - procedure DrawAngle(x,y,angleDeg: single; AColor: TBGRAPixel); overload; - procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AAlpha: byte = 255); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AColor: TBGRAPixel); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AAlpha: byte = 255); overload; - procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); overload; - procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload; - procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload; - procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - - property Width: integer read GetWidth; - property Height: integer read GetHeight; - property FrameCount: integer read GetFrameCount; - property Frame[AIndex: integer]: IBGLTexture read GetFrame; - property FrameWidth: integer read GetFrameWidth; - property FrameHeight: integer read GetFrameHeight; - property FlipX: IBGLTexture read GetFlipX; - property FlipY: IBGLTexture read GetFlipY; - property Mask: IBGLTexture read GetMask; - property Handle: TBGLTextureHandle read GetOpenGLTexture; - property ImageCenter: TPointF read GetImageCenter write SetImageCenter; - property ResampleFilter: TOpenGLResampleFilter read GetResampleFilter write SetResampleFilter; - property BlendMode: TOpenGLBlendMode read GetOpenGLBlendMode write SetOpenGLBlendMode; - property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; - end; - - { TBGLCustomBitmap } - - TBGLCustomBitmap = class(TBGRABitmap) - protected - FActualWidth,FActualHeight, - FAllocatedWidth,FAllocatedHeight: integer; - FTextureInvalidated: boolean; - FActualRect: TRect; - FTexture: IBGLTexture; - procedure Init; override; - function GetTexture: IBGLTexture; virtual; - function GetOpenGLMaxTexSize: integer; virtual; abstract; - procedure NotifySizeTooBigForOpenGL; virtual; - procedure NotifyOpenGLContextNotCreatedYet; virtual; - function GetTextureGL: IUnknown; override; - procedure SwapRedBlueWithoutInvalidate(ARect: TRect); - procedure SetClipRect(const AValue: TRect); override; - public - procedure InvalidateBitmap; override; - procedure Fill(const c: TBGRAPixel); override; - procedure NoClip; override; - destructor Destroy; override; - procedure SwapRedBlue; overload; override; - function Resample(newWidth, newHeight: integer; mode: TResampleMode=rmFineResample): TBGLCustomBitmap; override; - procedure ApplyGlobalOpacity(alpha: byte); overload; override; - procedure ReplaceColor(before, after: TColor); overload; override; - procedure ReplaceColor(const ABefore, AAfter: TBGRAPixel); overload; override; - procedure ReplaceTransparent(const AAfter: TBGRAPixel); overload; override; - procedure SetSize(AWidth, AHeight: integer); override; - property Width: integer read FActualWidth; - property Height: integer read FActualHeight; - property AllocatedWidth: integer read FAllocatedWidth; - property AllocatedHeight: integer read FAllocatedHeight; - function MakeTextureAndFree: IBGLTexture; - property Texture: IBGLTexture read GetTexture; - property MaxTextureSize: integer read GetOpenGLMaxTexSize; - end; - - { TBGLCustomTexture } - - TBGLCustomTexture = class(TInterfacedObject, IBGLTexture) - private - function GetFlipX: IBGLTexture; - function GetFlipY: IBGLTexture; - function GetFrame(AIndex: integer): IBGLTexture; - function GetFrameCount: integer; - function GetFrameHeight: integer; - function GetFrameWidth: integer; - function GetHeight: integer; - function GetMask: IBGLTexture; - function GetOpenGLBlendMode: TOpenGLBlendMode; - function GetOpenGLTexture: TBGLTextureHandle; - function GetWidth: integer; - function GetImageCenter: TPointF; - procedure SetImageCenter(const AValue: TPointF); - function GetResampleFilter: TOpenGLResampleFilter; - procedure SetOpenGLBlendMode(AValue: TOpenGLBlendMode); - procedure SetResampleFilter(AValue: TOpenGLResampleFilter); - protected - FOpenGLTexture: TBGLTextureHandle; - FOpenGLTextureOwned: boolean; - FResampleFilter: TOpenGLResampleFilter; - FWidth,FHeight: integer; - FImageCenter: TPointF; - FFrame: integer; - FFrameWidth,FFrameHeight: integer; - FIsMask: boolean; - FGradTopLeft, FGradTopRight, FGradBottomRight, FGradBottomLeft: TBGRAPixel; - FUseGradientColor: boolean; - FBlendMode: TOpenGLBlendMode; - - function GetOpenGLMaxTexSize: integer; virtual; abstract; - function CreateOpenGLTexture(ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; RGBAOrder: boolean): TBGLTextureHandle; virtual; abstract; - procedure UpdateOpenGLTexture(ATexture: TBGLTextureHandle; ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth,AActualHeight: integer; RGBAOrder: boolean); virtual; abstract; - class function SupportsBGRAOrder: boolean; virtual; - procedure SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); virtual; abstract; - procedure ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; FramesX: Integer=1; FramesY: Integer=1); virtual; abstract; - function GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; virtual; abstract; - function GetEmptyTexture: TBGLTextureHandle; virtual; abstract; - procedure FreeOpenGLTexture(ATexture: TBGLTextureHandle); virtual; abstract; - procedure UpdateGLResampleFilter(ATexture: TBGLTextureHandle; AFilter: TOpenGLResampleFilter); virtual; abstract; - function GetUseGradientColors: boolean; virtual; - procedure SetUseGradientColors(AValue: boolean); virtual; - - procedure DoDrawTriangleOrQuad(const {%H-}Points: array of TPointF; - const {%H-}APointsZ: array of Single; const {%H-}APoints3D: array of TPoint3D_128; - const {%H-}ANormals3D: array of TPoint3D_128; const {%H-}TexCoords: array of TPointF; - const {%H-}AColors: array of TColorF); virtual; - procedure DoStretchDraw(x,y,w,h: single; AColor: TBGRAPixel); virtual; abstract; - procedure DoStretchDrawAngle(x,y,w,h,angleDeg: single; rotationCenter: TPointF; AColor: TBGRAPixel); virtual; abstract; - procedure DoDrawAffine(Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); virtual; abstract; - function NewEmpty: TBGLCustomTexture; virtual; abstract; - function NewFromTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): TBGLCustomTexture; virtual; abstract; - procedure NotifyInvalidFrameSize; virtual; - procedure NotifyErrorLoadingFile({%H-}AFilename: string); virtual; - - procedure Init(ATexture: TBGLTextureHandle; AWidth,AHeight: integer; AOwned: boolean); virtual; - function Duplicate: TBGLCustomTexture; virtual; - procedure FreeMemoryOnDestroy; virtual; - - procedure InitEmpty; - procedure InitFromData(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean); - procedure InitFromStream(AStream: TStream); - public - destructor Destroy; override; - constructor Create; overload; - constructor Create(ATexture: TBGLTextureHandle; AWidth,AHeight: integer); overload; - constructor Create(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true); overload; - constructor Create(AFPImage: TFPCustomImage); overload; - constructor Create(ABitmap: TBitmap); overload; - constructor Create(AWidth, AHeight: integer; Color: TColor); overload; - constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); overload; - constructor Create(AFilenameUTF8: string); overload; - constructor Create(AFilenameUTF8: string; AWidth,AHeight: integer; AResampleFilter: TResampleFilter); overload; - constructor Create(AStream: TStream); overload; - procedure ToggleFlipX; virtual; abstract; - procedure ToggleFlipY; virtual; abstract; - procedure ToggleMask; virtual; - function FilterBlurMotion({%H-}ARadius: single; {%H-}ABlurType: TRadialBlurType; {%H-}ADirection: TPointF): IBGLTexture; virtual; - function FilterBlurRadial({%H-}ARadius: single; {%H-}ABlurType: TRadialBlurType): IBGLTexture; virtual; - - procedure SetFrameSize(x,y: integer); - procedure Update(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true); - procedure SetFrame(AIndex: integer); - procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); - procedure FreeMemory; - procedure Bind({%H-}ATextureNumber: integer); virtual; - - procedure Draw(x,y: single; AAlpha: byte = 255); overload; - procedure Draw(x,y: single; AColor: TBGRAPixel); overload; - procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure StretchDraw(x,y,w,h: single; AAlpha: byte = 255); overload; - procedure StretchDraw(x,y,w,h: single; AColor: TBGRAPixel); overload; - procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; - procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; - procedure DrawAngle(x,y,angleDeg: single; AAlpha: byte = 255); overload; - procedure DrawAngle(x,y,angleDeg: single; AColor: TBGRAPixel); overload; - procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AAlpha: byte = 255); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AColor: TBGRAPixel); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload; - procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload; - procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AAlpha: byte = 255); overload; - procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); overload; - procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload; - procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload; - procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload; - procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload; - - property Width: integer read GetWidth; - property Height: integer read GetHeight; - property FrameCount: integer read GetFrameCount; - property Frame[AIndex: integer]: IBGLTexture read GetFrame; - property FrameWidth: integer read GetFrameWidth; - property FrameHeight: integer read GetFrameHeight; - property FlipX: IBGLTexture read GetFlipX; - property FlipY: IBGLTexture read GetFlipY; - property Mask: IBGLTexture read GetMask; - property Handle: TBGLTextureHandle read GetOpenGLTexture; - property ResampleFilter: TOpenGLResampleFilter read GetResampleFilter write SetResampleFilter; - property BlendMode: TOpenGLBlendMode read GetOpenGLBlendMode write SetOpenGLBlendMode; - property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors; - end; - - { TBGLCustomFrameBuffer } - - TBGLCustomFrameBuffer = class - protected - FCanvas: pointer; - function GetTexture: IBGLTexture; virtual; abstract; - function GetHandle: pointer; virtual; abstract; - function GetMatrix: TAffineMatrix; virtual; abstract; - function GetHeight: integer; virtual; abstract; - function GetProjectionMatrix: TMatrix4D; virtual; abstract; - function GetWidth: integer; virtual; abstract; - procedure SetMatrix(AValue: TAffineMatrix); virtual; abstract; - procedure SetProjectionMatrix(AValue: TMatrix4D); virtual; abstract; - - public - procedure UseOrthoProjection; overload; virtual; - procedure UseOrthoProjection(AMinX,AMinY,AMaxX,AMaxY: single); overload; virtual; - function MakeTextureAndFree: IBGLTexture; virtual; - - procedure SetCanvas(ACanvas: Pointer); //for internal use - property Matrix: TAffineMatrix read GetMatrix write SetMatrix; - property ProjectionMatrix: TMatrix4D read GetProjectionMatrix write SetProjectionMatrix; - property Width: integer read GetWidth; - property Height: integer read GetHeight; - property Handle: pointer read GetHandle; - property Texture: IBGLTexture read GetTexture; - end; - -type - TBGLBitmapAny = class of TBGLCustomBitmap; - TBGLTextureAny = class of TBGLCustomTexture; - -var - BGLBitmapFactory : TBGLBitmapAny; - BGLTextureFactory: TBGLTextureAny; - -function OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY: Single): TMatrix4D; -function GetPowerOfTwo( Value : Integer ) : Integer; - -implementation - -uses BGRAFilterScanner; - -procedure TBGLCustomFrameBuffer.UseOrthoProjection; -begin - ProjectionMatrix := OrthoProjectionToOpenGL(0,0,Width,Height); -end; - -procedure TBGLCustomFrameBuffer.UseOrthoProjection(AMinX, AMinY, AMaxX, AMaxY: single); -begin - ProjectionMatrix := OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY); -end; - -function TBGLCustomFrameBuffer.MakeTextureAndFree: IBGLTexture; -begin - result := nil; - raise exception.create('Not implemented'); -end; - -procedure TBGLCustomFrameBuffer.SetCanvas(ACanvas: Pointer); -begin - FCanvas := ACanvas; -end; - -function OrthoProjectionToOpenGL(AMinX, AMinY, AMaxX, AMaxY: Single): TMatrix4D; -var sx,sy: single; -begin - sx := 2/(AMaxX-AMinX); - sy := 2/(AMaxY-AMinY); - result[1,1] := sx; result[2,1] := 0; result[3,1] := 0; result[4,1] := -1 - AMinX*sx; - result[1,2] := 0; result[2,2] := -sy; result[3,2] := 0; result[4,2] := 1 + AMinY*sy; - result[1,3] := 0; result[2,3] := 0; result[3,3] := -1; result[4,3] := 0; - result[1,4] := 0; result[2,4] := 0; result[3,4] := 0; result[4,4] := 1; -end; - -function GetPowerOfTwo( Value : Integer ) : Integer; -begin - Result := Value - 1; - Result := Result or ( Result shr 1 ); - Result := Result or ( Result shr 2 ); - Result := Result or ( Result shr 4 ); - Result := Result or ( Result shr 8 ); - Result := Result or ( Result shr 16 ); - Result := Result + 1; -end; - -{ TBGLCustomTexture } - -function TBGLCustomTexture.GetFlipX: IBGLTexture; -begin - result := Duplicate; - result.ToggleFlipX; -end; - -function TBGLCustomTexture.GetFlipY: IBGLTexture; -begin - result := Duplicate; - result.ToggleFlipY; -end; - -function TBGLCustomTexture.GetFrame(AIndex: integer): IBGLTexture; -var fc: integer; -begin - fc := GetFrameCount; - if fc <= 1 then - result := self - else - begin - if (AIndex < 1) or (AIndex > fc) then - result := NewEmpty - else - begin - result := Duplicate; - result.SetFrame(AIndex); - end; - end; -end; - -function TBGLCustomTexture.GetFrameCount: integer; -begin - result := GetOpenGLFrameCount(FOpenGLTexture); -end; - -function TBGLCustomTexture.GetFrameHeight: integer; -begin - result := FFrameHeight; -end; - -function TBGLCustomTexture.GetFrameWidth: integer; -begin - result := FFrameWidth; -end; - -function TBGLCustomTexture.GetHeight: integer; -begin - result := FHeight; -end; - -function TBGLCustomTexture.GetMask: IBGLTexture; -begin - result := Duplicate; - result.ToggleMask; -end; - -function TBGLCustomTexture.GetOpenGLBlendMode: TOpenGLBlendMode; -begin - result := FBlendMode; -end; - -function TBGLCustomTexture.GetOpenGLTexture: TBGLTextureHandle; -begin - result := FOpenGLTexture; -end; - -function TBGLCustomTexture.GetUseGradientColors: boolean; -begin - result := FUseGradientColor; -end; - -function TBGLCustomTexture.GetWidth: integer; -begin - result := FWidth; -end; - -function TBGLCustomTexture.GetImageCenter: TPointF; -begin - result := FImageCenter; -end; - -procedure TBGLCustomTexture.SetImageCenter(const AValue: TPointF); -begin - FImageCenter := AValue; -end; - -function TBGLCustomTexture.GetResampleFilter: TOpenGLResampleFilter; -begin - result := FResampleFilter; -end; - -procedure TBGLCustomTexture.SetOpenGLBlendMode(AValue: TOpenGLBlendMode); -begin - FBlendMode := AValue; -end; - -procedure TBGLCustomTexture.SetResampleFilter(AValue: TOpenGLResampleFilter); -begin - if AValue <> FResampleFilter then - begin - FResampleFilter:= AValue; - UpdateGLResampleFilter(FOpenGLTexture, AValue); - end; -end; - -class function TBGLCustomTexture.SupportsBGRAOrder: boolean; -begin - result := false; -end; - -procedure TBGLCustomTexture.SetUseGradientColors(AValue: boolean); -begin - FUseGradientColor := AValue; -end; - -procedure TBGLCustomTexture.DoDrawTriangleOrQuad( - const Points: array of TPointF; const APointsZ: array of Single; - const APoints3D: array of TPoint3D_128; - const ANormals3D: array of TPoint3D_128; const TexCoords: array of TPointF; - const AColors: array of TColorF); -begin - raise Exception.Create('Not implemented'); -end; - -procedure TBGLCustomTexture.ToggleMask; -begin - FIsMask := not FIsMask; -end; - -function TBGLCustomTexture.FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; - ADirection: TPointF): IBGLTexture; -begin - result := nil; - raise exception.Create('Not implemented'); -end; - -function TBGLCustomTexture.FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; -begin - result := nil; - raise exception.Create('Not implemented'); -end; - -procedure TBGLCustomTexture.Update(ARGBAData: PLongWord; AllocatedWidth, - AllocatedHeight, ActualWidth, ActualHeight: integer; RGBAOrder: boolean); -begin - UpdateOpenGLTexture(FOpenGLTexture, ARGBAData, AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight,RGBAOrder); - ComputeOpenGLFramesCoord(FOpenGLTexture, round(FWidth/FFrameWidth),round(FWidth/FFrameHeight)); - FWidth := ActualWidth; - FHeight := ActualHeight; - FImageCenter := PointF(FWidth*0.5,FHeight*0.5); -end; - -procedure TBGLCustomTexture.SetFrame(AIndex: integer); -begin - if (AIndex >= 1) and (AIndex <= GetFrameCount) then - begin - FFrame := AIndex; - FWidth := FFrameWidth; - FHeight:= FFrameHeight; - FImageCenter := PointF(FWidth*0.5,FHeight*0.5); - end; -end; - -procedure TBGLCustomTexture.SetGradientColors(ATopLeft, ATopRight, - ABottomRight, ABottomLeft: TBGRAPixel); -begin - FGradTopLeft := ATopLeft; - FGradTopRight := ATopRight; - FGradBottomLeft := ABottomLeft; - FGradBottomRight := ABottomRight; - GradientColors := true; -end; - -procedure TBGLCustomTexture.FreeMemory; -begin - if FOpenGLTextureOwned then - begin - FreeOpenGLTexture(FOpenGLTexture); - FOpenGLTexture := GetEmptyTexture; - FOpenGLTextureOwned := false; - end; -end; - -procedure TBGLCustomTexture.Bind(ATextureNumber: integer); -begin - raise Exception.Create('Not implemented'); -end; - -procedure TBGLCustomTexture.NotifyInvalidFrameSize; -begin - // -end; - -procedure TBGLCustomTexture.NotifyErrorLoadingFile(AFilename: string); -begin - // -end; - -procedure TBGLCustomTexture.Init(ATexture: TBGLTextureHandle; AWidth, - AHeight: integer; AOwned: boolean); -begin - FOpenGLTexture:= ATexture; - FWidth := AWidth; - FHeight := AHeight; - FImageCenter := PointF(FWidth*0.5,FHeight*0.5); - FFrame:= 0; - FFrameWidth := AWidth; - FFrameHeight := AHeight; - FIsMask:= false; - FOpenGLTextureOwned := AOwned; -end; - -function TBGLCustomTexture.Duplicate: TBGLCustomTexture; -begin - result := NewFromTexture(FOpenGLTexture, FWidth, FHeight); - result.FFrame := FFrame; - result.FFrameWidth := FFrameWidth; - result.FFrameHeight := FFrameHeight; - result.FIsMask := FIsMask; - result.FResampleFilter := FResampleFilter; - result.FGradTopLeft := FGradTopLeft; - result.FGradTopRight := FGradTopRight; - result.FGradBottomRight := FGradBottomRight; - result.FGradBottomLeft := FGradBottomLeft; - result.FUseGradientColor := FUseGradientColor; - result.FBlendMode := FBlendMode; -end; - -procedure TBGLCustomTexture.FreeMemoryOnDestroy; -begin - FreeMemory; -end; - -procedure TBGLCustomTexture.InitEmpty; -begin - Init(GetEmptyTexture,0,0,False); -end; - -procedure TBGLCustomTexture.InitFromData(ARGBAData: PLongWord; - AllocatedWidth, AllocatedHeight, ActualWidth, ActualHeight: integer; - RGBAOrder: boolean); -var tex: TBGLTextureHandle; - MaxTexSize: integer; -begin - MaxTexSize := GetOpenGLMaxTexSize; - if ( AllocatedWidth > MaxTexSize ) or ( AllocatedHeight > MaxTexSize ) or - (AllocatedWidth <= 0) or (AllocatedHeight <= 0) then - InitEmpty - else - begin - tex := CreateOpenGLTexture(ARGBAData,AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight,RGBAOrder); - FResampleFilter := orfLinear; - ComputeOpenGLFramesCoord(tex); - Init(tex,ActualWidth,ActualHeight,True); - end; -end; - -procedure TBGLCustomTexture.InitFromStream(AStream: TStream); -var bmp: TBGLCustomBitmap; -begin - bmp := nil; - try - bmp := BGLBitmapFactory.Create(AStream); - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; - InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height,TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); - except - InitEmpty; - end; - bmp.Free; -end; - -destructor TBGLCustomTexture.Destroy; -begin - FreeMemoryOnDestroy; - inherited Destroy; -end; - -constructor TBGLCustomTexture.Create; -begin - InitEmpty; -end; - -constructor TBGLCustomTexture.Create(ATexture: TBGLTextureHandle; AWidth, - AHeight: integer); -begin - Init(ATexture, AWidth,AHeight, False); -end; - -constructor TBGLCustomTexture.Create(ARGBAData: PLongWord; AllocatedWidth, - AllocatedHeight, ActualWidth, ActualHeight: integer; RGBAOrder: boolean); -begin - InitFromData(ARGBAData,AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight,RGBAOrder); -end; - -constructor TBGLCustomTexture.Create(AFPImage: TFPCustomImage); -var bmp: TBGLCustomBitmap; -begin - if (AFPImage is TBGRACustomBitmap) and - (AFPImage.Width = GetPowerOfTwo(AFPImage.Width)) and - (AFPImage.Height = GetPowerOfTwo(AFPImage.Height)) then - begin - with TBGRACustomBitmap(AFPImage) do - begin - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then SwapRedBlue; - if LineOrder = riloBottomToTop then VerticalFlip; - InitFromData(PLongWord(Data), Width,Height, Width,Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); - if LineOrder = riloBottomToTop then VerticalFlip; - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then SwapRedBlue; - end; - end else - begin - bmp := BGLBitmapFactory.Create(AFPImage); - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; - InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); - bmp.Free; - end; -end; - -constructor TBGLCustomTexture.Create(ABitmap: TBitmap); -var bmp: TBGLCustomBitmap; -begin - bmp := BGLBitmapFactory.Create(ABitmap); - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; - InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); - bmp.Free; -end; - -constructor TBGLCustomTexture.Create(AWidth, AHeight: integer; Color: TColor); -var bmp: TBGLCustomBitmap; -begin - bmp := BGLBitmapFactory.Create(AWidth,AHeight,Color); - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; - InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); - bmp.Free; -end; - -constructor TBGLCustomTexture.Create(AWidth, AHeight: integer; - Color: TBGRAPixel); -var bmp: TBGLCustomBitmap; -begin - bmp := BGLBitmapFactory.Create(AWidth,AHeight,Color); - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; - InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); - bmp.Free; -end; - -constructor TBGLCustomTexture.Create(AFilenameUTF8: string); -var bmp: TBGLCustomBitmap; -begin - bmp := nil; - try - bmp := BGLBitmapFactory.Create(AFilenameUTF8, True); - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; - InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder); - except - InitEmpty; - NotifyErrorLoadingFile(AFilenameUTF8); - end; - bmp.Free; -end; - -constructor TBGLCustomTexture.Create(AFilenameUTF8: string; AWidth, - AHeight: integer; AResampleFilter: TResampleFilter); -var bmp, temp: TBGLCustomBitmap; -begin - bmp := nil; - try - bmp := BGLBitmapFactory.Create(AFilenameUTF8, True); - if (bmp.Width <> AWidth) or (bmp.Height <> AHeight) then - begin - if AResampleFilter = rfBox then - temp := bmp.Resample(AWidth,AHeight,rmSimpleStretch) as TBGLCustomBitmap - else - begin - bmp.ResampleFilter := AResampleFilter; - temp := bmp.Resample(AWidth,AHeight) as TBGLCustomBitmap; - end; - bmp.Free; - bmp := temp; - temp := nil; - end; - if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue; - InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder); - except - InitEmpty; - NotifyErrorLoadingFile(AFilenameUTF8); - end; - bmp.Free; -end; - -constructor TBGLCustomTexture.Create(AStream: TStream); -begin - InitFromStream(AStream); -end; - -procedure TBGLCustomTexture.SetFrameSize(x, y: integer); -begin - if (FWidth = 0) or (FHeight = 0) then exit; - if (x <= 0) or (y <= 0) or (x > FWidth) or (y > FHeight) then - begin - NotifyInvalidFrameSize; - exit; - end; - ComputeOpenGLFramesCoord(FOpenGLTexture, FWidth div x,FHeight div y); - FFrameWidth:= x; - FFrameHeight:= y; -end; - -procedure TBGLCustomTexture.Draw(x, y: single; AAlpha: byte); -begin - DoStretchDraw(x,y,FWidth,FHeight,BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.Draw(x, y: single; AColor: TBGRAPixel); -begin - DoStretchDraw(x,y,FWidth,FHeight,AColor); -end; - -procedure TBGLCustomTexture.Draw(x, y: single; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; AAlpha: byte); -begin - Draw(x,y, AHorizAlign, AVertAlign, BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.Draw(x, y: single; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; AColor: TBGRAPixel); -begin - StretchDraw(x,y, FWidth,FHeight, AHorizAlign,AVertAlign, AColor); -end; - -procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; AAlpha: byte); -begin - DoStretchDraw(x,y,w,h, BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; - AColor: TBGRAPixel); -begin - DoStretchDraw(x,y,w,h,AColor); -end; - -procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte); -begin - StretchDraw(x,y,w,h, AHorizAlign,AVertAlign, BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); -begin - case AHorizAlign of - taCenter: DecF(x, w*0.5); - taRightJustify: DecF(x, w-1); - end; - case AVertAlign of - tlCenter: DecF(y, h*0.5); - tlBottom: DecF(y, h); - end; - DoStretchDraw(x,y,w,h,AColor); -end; - -procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; - const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte); -begin - StretchDrawAngle(x,y,FWidth,FHeight,angleDeg,imageCenter,ARestoreOffsetAfterRotation,BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; - const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); -begin - StretchDrawAngle(x,y,FWidth,FHeight,angleDeg,imageCenter,ARestoreOffsetAfterRotation,AColor); -end; - -procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; AAlpha: byte); -begin - StretchDrawAngle(x,y, FWidth,FHeight, angleDeg, AAlpha); -end; - -procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; AColor: TBGRAPixel); -begin - StretchDrawAngle(x,y, FWidth,FHeight, angleDeg, AColor); -end; - -procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte); -begin - StretchDrawAngle(x,y,FWidth,FHeight,angleDeg, AHorizAlign, AVertAlign, AAlpha); -end; - -procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); -begin - StretchDrawAngle(x,y,FWidth,FHeight, angleDeg, AHorizAlign, AVertAlign, AColor); -end; - -procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; - const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte); -begin - StretchDrawAngle(x,y,w,h,angleDeg,imageCenter,ARestoreOffsetAfterRotation,BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; - const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); -var - rotationCenter: TPointF; -begin - if (FWidth=0) or (FHeight = 0) then exit; - rotationCenter := PointF(imageCenter.x*w/FWidth, imageCenter.y*h/FHeight); - if not ARestoreOffsetAfterRotation then - begin - DecF(x, rotationCenter.x); - DecF(y, rotationCenter.y); - end; - DoStretchDrawAngle(x,y,w,h,angleDeg,rotationCenter+PointF(x,y),AColor); -end; - -procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; AAlpha: byte); -begin - StretchDrawAngle(x, y, w,h, angleDeg, FImageCenter, True, BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; - AColor: TBGRAPixel); -begin - StretchDrawAngle(x, y, w,h, angleDeg, FImageCenter, True, AColor); -end; - -procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte); -begin - StretchDrawAngle(x,y,w,h,angleDeg, AHorizAlign, AVertAlign, BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); -var imageCenter: TPointF; -begin - case AHorizAlign of - taCenter: imageCenter.x := FWidth*0.5; - taRightJustify: imageCenter.x := FWidth; - else imageCenter.x := 0; - end; - case AVertAlign of - tlCenter: imageCenter.y := FHeight*0.5; - tlBottom: imageCenter.y := FHeight; - else imageCenter.y := 0; - end; - StretchDrawAngle(x,y,w,h, angleDeg, imageCenter, False, AColor); -end; - -procedure TBGLCustomTexture.DrawAffine(const Origin, HAxis, VAxis: TPointF; - AAlpha: byte); -begin - {$PUSH}{$OPTIMIZATION OFF} - DoDrawAffine(Origin,HAxis,VAxis, BGRA(255,255,255,AAlpha)); - {$POP} -end; - -procedure TBGLCustomTexture.DrawAffine(const Origin, HAxis, VAxis: TPointF; - AColor: TBGRAPixel); -begin - {$PUSH}{$OPTIMIZATION OFF} - DoDrawAffine(Origin,HAxis,VAxis, AColor); - {$POP} -end; - -procedure TBGLCustomTexture.DrawAffine(x, y: single; - const AMatrix: TAffineMatrix; AAlpha: byte); -begin - DoDrawAffine(AMatrix*PointF(0,0) + PointF(x,y), AMatrix*PointF(Width,0) + PointF(x,y), - AMatrix*PointF(0,Height) + PointF(x,y), BGRA(255,255,255,AAlpha)); -end; - -procedure TBGLCustomTexture.DrawAffine(x, y: single; - const AMatrix: TAffineMatrix; AColor: TBGRAPixel); -begin - DoDrawAffine(AMatrix*PointF(0,0) + PointF(x,y), AMatrix*PointF(Width,0) + PointF(x,y), - AMatrix*PointF(0,Height) + PointF(x,y), AColor); -end; - -procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; - const ATexCoords: array of TPointF); -begin - if (length(APoints) = 3) and (length(ATexCoords) = 3) then - DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; - const ATexCoords: array of TPointF; const AColors: array of TColorF); -begin - if (length(APoints) = 3) and (length(ATexCoords) = 3) - and (length(AColors) = 3) then - DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,AColors); -end; - -procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; - const APointsZ: array of Single; const ATexCoords: array of TPointF); -begin - if (length(APoints) = 3) and (length(ATexCoords) = 3) - and (length(APointsZ) = 3) then - DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF; - const APointsZ: array of Single; const ATexCoords: array of TPointF; - const AColors: array of TColorF); -begin - if (length(APoints) = 3) and (length(ATexCoords) = 3) - and (length(APointsZ) = 3) and (length(AColors) = 3) then - DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,AColors); -end; - -procedure TBGLCustomTexture.DrawTriangle( - const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); -begin - if (length(APoints3D) = 3) and (length(ATexCoords) = 3) then - DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawTriangle( - const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; - const AColors: array of TColorF); -begin - if (length(APoints3D) = 3) and (length(ATexCoords) = 3) - and (length(AColors) = 3) then - DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,AColors); -end; - -procedure TBGLCustomTexture.DrawTriangle(const APoints3D: array of TPoint3D_128; - const ANormals3D: array of TPoint3D_128; - const ATexCoords: array of TPointF); -begin - if (length(APoints3D) = 3) and (length(ATexCoords) = 3) - and (length(ANormals3D) = 3) then - DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawTriangle(const APoints3D: array of TPoint3D_128; - const ANormals3D: array of TPoint3D_128; - const ATexCoords: array of TPointF; const AColors: array of TColorF); -begin - if (length(APoints3D) = 3) and (length(ATexCoords) = 3) - and (length(ANormals3D) = 3) - and (length(AColors) = 3) then - DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,AColors); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; - const ATexCoords: array of TPointF); -begin - if (length(APoints) = 4) and (length(ATexCoords) = 4) then - DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; - const ATexCoords: array of TPointF; const AColors: array of TColorF); -begin - if (length(APoints) = 4) and (length(ATexCoords) = 4) - and (length(AColors) = 4) then - DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords, AColors); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; - const APointsZ: array of Single; const ATexCoords: array of TPointF); -begin - if (length(APoints) = 4) and (length(ATexCoords) = 4) - and (length(APointsZ) = 4) then - DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF; - const APointsZ: array of Single; const ATexCoords: array of TPointF; - const AColors: array of TColorF); -begin - if (length(APoints) = 4) and (length(ATexCoords) = 4) - and (length(APointsZ) = 4) and (length(AColors) = 4) then - DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,AColors); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; - const ATexCoords: array of TPointF); -begin - if (length(APoints3D) = 4) and (length(ATexCoords) = 4) then - DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; - const ATexCoords: array of TPointF; const AColors: array of TColorF); -begin - if (length(APoints3D) = 4) and (length(ATexCoords) = 4) - and (length(AColors) = 4) then - DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,AColors); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; - const ANormals3D: array of TPoint3D_128; - const ATexCoords: array of TPointF); -begin - if (length(APoints3D) = 4) and (length(ATexCoords) = 4) - and (length(ANormals3D) = 4) then - DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,[]); -end; - -procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128; - const ANormals3D: array of TPoint3D_128; - const ATexCoords: array of TPointF; const AColors: array of TColorF); -begin - if (length(APoints3D) = 4) and (length(ATexCoords) = 4) - and (length(ANormals3D) = 4) - and (length(AColors) = 4) then - DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,AColors); -end; - -{ TBGLCustomFont } - -function TBGLCustomFont.GetScale: single; -begin - result := FScale; -end; - -function TBGLCustomFont.GetStepX: single; -begin - result := FStepX; -end; - -procedure TBGLCustomFont.SetScale(AValue: single); -begin - FScale:= AValue; -end; - -procedure TBGLCustomFont.SetStepX(AValue: single); -begin - FStepX:= AValue; -end; - -function TBGLCustomFont.GetHorizontalAlign: TAlignment; -begin - result := FHorizontalAlign; -end; - -function TBGLCustomFont.GetJustify: boolean; -begin - result := FJustify; -end; - -function TBGLCustomFont.GetVerticalAlign: TTextLayout; -begin - result := FVerticalAlign; -end; - -procedure TBGLCustomFont.SetHorizontalAlign(AValue: TAlignment); -begin - FHorizontalAlign:= AValue; -end; - -procedure TBGLCustomFont.SetJustify(AValue: boolean); -begin - FJustify:= AValue; -end; - -procedure TBGLCustomFont.SetVerticalAlign(AValue: TTextLayout); -begin - FVerticalAlign := AValue; -end; - -function TBGLCustomFont.GetDefaultColor: TBGRAPixel; -begin - result := BGRAWhite; -end; - -procedure TBGLCustomFont.SwapRectIfNeeded(var ARect: TRectF); -var temp: single; -begin - if ARect.Right < ARect.Left then - begin - temp := ARect.Left; - ARect.Left := ARect.Right; - ARect.Right := temp; - end; - if ARect.Bottom < ARect.Top then - begin - temp := ARect.Top; - ARect.Top := ARect.Bottom; - ARect.Bottom := temp; - end; -end; - -procedure TBGLCustomFont.SwapRectIfNeeded(var ARect: TRect); -var temp: integer; -begin - if ARect.Right < ARect.Left then - begin - temp := ARect.Left; - ARect.Left := ARect.Right; - ARect.Right := temp; - end; - if ARect.Bottom < ARect.Top then - begin - temp := ARect.Top; - ARect.Top := ARect.Bottom; - ARect.Bottom := temp; - end; -end; - -procedure TBGLCustomFont.SetPadding(AValue: TRectF); -begin - FPadding:=AValue; -end; - -function TBGLCustomFont.GetPadding: TRectF; -begin - result := FPadding; -end; - -procedure TBGLCustomFont.Init; -begin - FScale:= 1; - FStepX:= 0; - FHorizontalAlign:= taLeftJustify; - FVerticalAlign:= tlTop; - FJustify:= false; - FPadding := RectF(1,1,1,1); -end; - -procedure TBGLCustomFont.FreeMemoryOnDestroy; -begin - FreeMemory; -end; - -procedure TBGLCustomFont.FreeMemory; -begin - -end; - -constructor TBGLCustomFont.Create(AFilename: UTF8String); -begin - Init; - LoadFromFile(AFilename); -end; - -destructor TBGLCustomFont.Destroy; -begin - FreeMemoryOnDestroy; - inherited Destroy; -end; - -procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String); -begin - DoTextOut(X,Y,Text,GetDefaultColor); -end; - -procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String; - AColor: TBGRAPixel); -begin - DoTextOut(X,Y,Text,AColor); -end; - -procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String; - AHorizAlign: TAlignment; AVertAlign: TTextLayout); -begin - TextOut(X,Y,Text,AHorizAlign,AVertAlign,GetDefaultColor); -end; - -procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); -var PrevHorizAlign: TAlignment; - PrevVertAlign: TTextLayout; -begin - PrevHorizAlign:= GetHorizontalAlign; - PrevVertAlign:= GetVerticalAlign; - SetHorizontalAlign(AHorizAlign); - SetVerticalAlign(AVertAlign); - DoTextOut(X,Y,Text,AColor); - SetHorizontalAlign(PrevHorizAlign); - SetVerticalAlign(PrevVertAlign); -end; - -procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; - const Text: UTF8String); -begin - DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,GetDefaultColor); -end; - -procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; - const Text: UTF8String; AColor: TBGRAPixel); -begin - DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor); -end; - -procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; - const Text: UTF8String; AVertAlign: TTextLayout); -begin - TextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AVertAlign,GetDefaultColor); -end; - -procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; - const Text: UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); -var PrevVertAlign: TTextLayout; -begin - PrevVertAlign:= GetVerticalAlign; - SetVerticalAlign(AVertAlign); - DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor); - SetVerticalAlign(PrevVertAlign); -end; - -procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; - const Text: UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout); -begin - TextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AHorizAlign,AVertAlign,GetDefaultColor); -end; - -procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single; - const Text: UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; - AColor: TBGRAPixel); -var PrevHorizAlign: TAlignment; - PrevVertAlign: TTextLayout; - PrevJustify: boolean; -begin - PrevHorizAlign:= GetHorizontalAlign; - PrevVertAlign:= GetVerticalAlign; - PrevJustify := GetJustify; - SetHorizontalAlign(AHorizAlign); - SetVerticalAlign(AVertAlign); - SetJustify(False); - DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor); - SetHorizontalAlign(PrevHorizAlign); - SetVerticalAlign(PrevVertAlign); - SetJustify(PrevJustify); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; - AColor: TBGRAPixel); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AColor); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; - AVertAlign: TTextLayout); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AVertAlign); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; - AVertAlign: TTextLayout; AColor: TBGRAPixel); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AVertAlign, AColor); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; - AHorizAlign: TAlignment; AVertAlign: TTextLayout); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AHorizAlign, AVertAlign); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AHorizAlign, AVertAlign, AColor); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; - AColor: TBGRAPixel); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AColor); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; - AVertAlign: TTextLayout); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AVertAlign); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; - AVertAlign: TTextLayout; AColor: TBGRAPixel); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AVertAlign, AColor); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; - AHorizAlign: TAlignment; AVertAlign: TTextLayout); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AHorizAlign, AVertAlign); -end; - -procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); -begin - SwapRectIfNeeded(ARect); - with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text, - AHorizAlign, AVertAlign, AColor); -end; - -{ TBGLCustomBitmap } - -procedure TBGLCustomBitmap.Init; -begin - inherited Init; - FTextureInvalidated := true; - FActualRect := rect(0,0,0,0); - FScanWidth := 0; - FScanHeight:= 0; - FTexture := nil; - FLineOrder := riloTopToBottom; -end; - -function TBGLCustomBitmap.GetTexture: IBGLTexture; -begin - if (Width = 0) or (Height = 0) then - result := BGLTextureFactory.Create - else - begin - if FTextureInvalidated then - begin - FTextureInvalidated := false; - if not TBGRAPixel_RGBAOrder and not BGLTextureFactory.SupportsBGRAOrder then SwapRedBlueWithoutInvalidate(Rect(0,0,Width,Height)); - if FTexture = nil then - FTexture := BGLTextureFactory.Create(PLongWord(self.Data), AllocatedWidth,AllocatedHeight, Width,Height, TBGRAPixel_RGBAOrder or not BGLTextureFactory.SupportsBGRAOrder) - else - FTexture.Update(PLongWord(self.Data), AllocatedWidth,AllocatedHeight, Width,Height, TBGRAPixel_RGBAOrder or not BGLTextureFactory.SupportsBGRAOrder); - if not TBGRAPixel_RGBAOrder and not BGLTextureFactory.SupportsBGRAOrder then SwapRedBlueWithoutInvalidate(Rect(0,0,Width,Height)); - end; - result := FTexture; - end; -end; - -procedure TBGLCustomBitmap.NotifySizeTooBigForOpenGL; -begin - raise exception.Create('Size too big for OpenGL'); -end; - -procedure TBGLCustomBitmap.NotifyOpenGLContextNotCreatedYet; -begin - raise exception.Create('OpenGL context has not been created yet'); -end; - -function TBGLCustomBitmap.GetTextureGL: IUnknown; -begin - Result:=GetTexture; -end; - -procedure TBGLCustomBitmap.SwapRedBlueWithoutInvalidate(ARect: TRect); -var y: Int32or64; - p: PBGRAPixel; -begin - if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit; - for y := ARect.Top to ARect.Bottom-1 do - begin - p := GetScanlineFast(y)+ARect.Left; - TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(p,p, ARect.Right-ARect.Left, False); - end; -end; - -procedure TBGLCustomBitmap.InvalidateBitmap; -begin - inherited InvalidateBitmap; - FTextureInvalidated := true; -end; - -procedure TBGLCustomBitmap.Fill(const c: TBGRAPixel); -var oldClip: TRect; -begin - oldClip := ClipRect; - NoClip; - FillRect(ClipRect, c, dmSet); - ClipRect := oldClip; -end; - -procedure TBGLCustomBitmap.NoClip; -begin - ClipRect := FActualRect; -end; - -destructor TBGLCustomBitmap.Destroy; -begin - if FTexture <> nil then - begin - //always free the memory of the texture - FTexture.FreeMemory; - FTexture := nil; - end; - inherited Destroy; -end; - -procedure TBGLCustomBitmap.SwapRedBlue; -var previousClip : TRect; -begin - previousClip := ClipRect; - NoClip; - SwapRedBlue(rect(0,0,Width,Height)); - ClipRect := previousClip; -end; - -function TBGLCustomBitmap.Resample(newWidth, newHeight: integer; - mode: TResampleMode): TBGLCustomBitmap; -var temp,resampled: TBGRACustomBitmap; -begin - temp := TBGRABitmap.Create(FActualWidth,FActualHeight); - temp.PutImage(-FActualRect.Left,-FActualRect.Top, self, dmSet); - temp.ResampleFilter := ResampleFilter; - resampled := temp.Resample(NewWidth,NewHeight,mode); - temp.Free; - Result:= NewBitmap(resampled) as TBGLCustomBitmap; - resampled.Free; -end; - -procedure TBGLCustomBitmap.ApplyGlobalOpacity(alpha: byte); -var oldClip: TRect; -begin - oldClip := ClipRect; - NoClip; - ApplyGlobalOpacity(FActualRect,alpha); - ClipRect := oldClip; -end; - -procedure TBGLCustomBitmap.ReplaceColor(before, after: TColor); -var oldClip: TRect; -begin - oldClip := ClipRect; - NoClip; - ReplaceColor(FActualRect, before, after); - ClipRect := oldClip; -end; - -procedure TBGLCustomBitmap.ReplaceColor(const ABefore, AAfter: TBGRAPixel); -var oldClip: TRect; -begin - oldClip := ClipRect; - NoClip; - ReplaceColor(FActualRect, ABefore, AAfter); - ClipRect := oldClip; -end; - -procedure TBGLCustomBitmap.ReplaceTransparent(const AAfter: TBGRAPixel); -var oldClip: TRect; -begin - oldClip := ClipRect; - NoClip; - ReplaceTransparent(FActualRect,AAfter); - ClipRect := oldClip; -end; - -procedure TBGLCustomBitmap.SetClipRect(const AValue: TRect); -var r: TRect; -begin - r := TRect.Intersect(AValue, FActualRect); - inherited SetClipRect(r); -end; - -procedure TBGLCustomBitmap.SetSize(AWidth, AHeight: integer); -var AllocatedWidthNeeded,AllocatedHeightNeeded, - MaxTexSize: Integer; -begin - if AWidth < 0 then AWidth := 0; - if AHeight < 0 then AHeight := 0; - if (AWidth = Width) and (AHeight = Height) then exit; - AllocatedWidthNeeded := GetPowerOfTwo(AWidth); - AllocatedHeightNeeded := GetPowerOfTwo(AHeight); - MaxTexSize := GetOpenGLMaxTexSize; - if (AllocatedWidthNeeded > MaxTexSize) or - (AllocatedHeightNeeded > MaxTexSize) then - begin - if MaxTexSize = 0 then - NotifyOpenGLContextNotCreatedYet - else - NotifySizeTooBigForOpenGL; - if AllocatedWidthNeeded > MaxTexSize then - begin - AllocatedWidthNeeded := MaxTexSize; - AWidth := MaxTexSize; - end; - if AllocatedHeightNeeded > MaxTexSize then - begin - AllocatedHeightNeeded := MaxTexSize; - AHeight := MaxTexSize; - end; - end; - FActualWidth := AWidth; - FActualHeight := AHeight; - FAllocatedWidth := AllocatedWidthNeeded; - FAllocatedHeight := AllocatedHeightNeeded; - FActualRect := rect(0,0,FActualWidth,FActualHeight); - if (FAllocatedWidth <> inherited Width) or - (FAllocatedHeight <> inherited Height) then - inherited SetSize(FAllocatedWidth, FAllocatedHeight); - inherited NoClip; - inherited FillRect(Width,0,FAllocatedWidth,Height, BGRAPixelTransparent, dmSet); - inherited FillRect(0,Height,FAllocatedWidth,FAllocatedHeight, BGRAPixelTransparent, dmSet); - NoClip; - FScanWidth := Width; - FScanHeight:= Height; - FTextureInvalidated:= true; -end; - -function TBGLCustomBitmap.MakeTextureAndFree: IBGLTexture; -begin - result := Texture; - FTexture := nil; - Free; -end; - -end. - diff --git a/components/bgrabitmap/bgraopenraster.pas b/components/bgrabitmap/bgraopenraster.pas deleted file mode 100644 index 0a25221..0000000 --- a/components/bgrabitmap/bgraopenraster.pas +++ /dev/null @@ -1,1139 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAOpenRaster; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRALayers, zipper, DOM, BGRABitmap, BGRALayerOriginal, - BGRASVGShapes, FPImage, BGRASVG; - -const - OpenRasterMimeType = 'image/openraster'; //do not change, it's part of the file format - OpenRasterSVGDefaultDPI = 90; - -type - - { TBGRAOpenRasterDocument } - - TBGRAOpenRasterDocument = class(TBGRALayeredBitmap) - private - FFiles: array of record - Filename: string; - Stream: TMemoryStream; - end; - FStackXML: TXMLDocument; - FZipInputStream: TStream; - procedure SetMimeType(AValue: string); - protected - Procedure ZipOnCreateStream(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); - Procedure ZipOnDoneStream(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); - Procedure ZipOnOpenInputStream(Sender : TObject; var AStream : TStream); - Procedure ZipOnCloseInputStream(Sender : TObject; var AStream : TStream); - procedure ClearFiles; - function GetMemoryStream(AFilename: string): TMemoryStream; - procedure SetMemoryStream(AFilename: string; AStream: TMemoryStream); - function AddLayerFromMemoryStream(ALayerFilename: string): integer; - function CopyRasterLayerToMemoryStream(ALayerIndex: integer; ALayerFilename: string): boolean; - procedure CopySVGToMemoryStream(ASVG: TBGRASVG; ASVGMatrix: TAffineMatrix; AOutFilename: string; out AOffset: TPoint); - function CopyBitmapToMemoryStream(ABitmap: TBGRABitmap; AFilename: string): boolean; - procedure SetMemoryStreamAsString(AFilename: string; AContent: string); - function GetMemoryStreamAsString(AFilename: string): string; - procedure UnzipFromStream(AStream: TStream; AFileList: TStrings = nil); - procedure UnzipFromFile(AFilenameUTF8: string); - procedure ZipToFile(AFilenameUTF8: string); - procedure ZipToStream(AStream: TStream); - procedure CopyThumbnailToMemoryStream(AMaxWidth, AMaxHeight: integer); - procedure AnalyzeZip; virtual; - procedure PrepareZipToSave; virtual; - function GetMimeType: string; override; - procedure InternalLoadFromStream(AStream: TStream); - procedure InternalSaveToStream(AStream: TStream); - - public - constructor Create; overload; override; - constructor Create(AWidth, AHeight: integer); overload; override; - procedure Clear; override; - function CheckMimeType(AStream: TStream): boolean; - procedure LoadFlatImageFromStream(AStream: TStream; - out ANbLayers: integer; - out ABitmap: TBGRABitmap); - procedure LoadFromStream(AStream: TStream); override; - procedure LoadFromFile(const filenameUTF8: string); override; - procedure SaveToStream(AStream: TStream); override; - procedure SaveToFile(const filenameUTF8: string); override; - property MimeType : string read GetMimeType write SetMimeType; - property StackXML : TXMLDocument read FStackXML; - end; - - { TFPReaderOpenRaster } - - TFPReaderOpenRaster = class(TFPCustomImageReader) - private - FWidth,FHeight,FNbLayers: integer; - protected - function InternalCheck(Stream: TStream): boolean; override; - procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; - public - property Width: integer read FWidth; - property Height: integer read FHeight; - property NbLayers: integer read FNbLayers; - end; - - { TFPWriterOpenRaster } - - TFPWriterOpenRaster = class(TFPCustomImageWriter) - protected - procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override; - end; - -procedure RegisterOpenRasterFormat; - -implementation - -uses XMLRead, XMLWrite, BGRABitmapTypes, zstream, BGRAUTF8, - UnzipperExt, BGRASVGOriginal, BGRATransform, BGRASVGType, math; - -const - MergedImageFilename = 'mergedimage.png'; - LayerStackFilename = 'stack.xml'; - -function IsZipStream(stream: TStream): boolean; -var - header: packed array[0..1] of char; - SavePos: int64; -begin - Result := False; - try - if stream.Position + 2 < Stream.Size then - begin - header := #0#0; - SavePos := stream.Position; - stream.Read(header, 2); - stream.Position := SavePos; - if (header[0] = 'P') and (header[1] = 'K') then - Result := True; - end; - except - on ex: Exception do ; - end; -end; - -{ TFPWriterOpenRaster } - -procedure TFPWriterOpenRaster.InternalWrite(Str: TStream; Img: TFPCustomImage); -var doc: TBGRAOpenRasterDocument; - tempBmp: TBGRABitmap; - x,y: integer; - -begin - doc := TBGRAOpenRasterDocument.Create; - if Img is TBGRABitmap then doc.AddLayer(Img as TBGRABitmap) else - begin - tempBmp := TBGRABitmap.Create(img.Width,img.Height); - for y := 0 to Img.Height-1 do - for x := 0 to img.Width-1 do - tempBmp.SetPixel(x,y, FPColorToBGRA(img.Colors[x,y])); - doc.AddOwnedLayer(tempBmp); - end; - doc.SaveToStream(Str); - doc.Free; -end; - -{ TFPReaderOpenRaster } - -function TFPReaderOpenRaster.InternalCheck(Stream: TStream): boolean; -var magic: packed array[0..3] of byte; - OldPos,BytesRead: Int64; - doc : TBGRAOpenRasterDocument; -begin - Result:=false; - if Stream=nil then exit; - oldPos := stream.Position; - {$PUSH}{$HINTS OFF} - BytesRead := Stream.Read({%H-}magic,sizeof(magic)); - {$POP} - stream.Position:= OldPos; - if BytesRead<>sizeof(magic) then exit; - if (magic[0] = $50) and (magic[1] = $4b) and (magic[2] = $03) and (magic[3] = $04) then - begin - doc := TBGRAOpenRasterDocument.Create; - result := doc.CheckMimeType(Stream); - doc.Free; - end; -end; - -procedure TFPReaderOpenRaster.InternalRead(Stream: TStream; Img: TFPCustomImage); -var - layeredImage: TBGRAOpenRasterDocument; - flat: TBGRABitmap; - x,y: integer; -begin - FWidth := 0; - FHeight:= 0; - FNbLayers:= 0; - layeredImage := TBGRAOpenRasterDocument.Create; - try - layeredImage.LoadFlatImageFromStream(Stream, FNbLayers, flat); - if Assigned(flat) then - begin - FWidth := flat.Width; - FHeight := flat.Height; - end else - begin - layeredImage.LoadFromStream(Stream); - flat := layeredImage.ComputeFlatImage; - FWidth:= layeredImage.Width; - FHeight:= layeredImage.Height; - FNbLayers:= layeredImage.NbLayers; - end; - try - if Img is TBGRACustomBitmap then - TBGRACustomBitmap(img).Assign(flat) - else - begin - Img.SetSize(flat.Width,flat.Height); - for y := 0 to flat.Height-1 do - for x := 0 to flat.Width-1 do - Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y)); - end; - finally - flat.free; - end; - FreeAndNil(layeredImage); - except - on ex: Exception do - begin - layeredImage.Free; - raise Exception.Create('Error while loading OpenRaster file. ' + ex.Message); - end; - end; -end; - -{ TBGRAOpenRasterDocument } - -procedure TBGRAOpenRasterDocument.AnalyzeZip; - - function CountLayersRec(stackNode: TDOMNode): integer; - var i: integer; - layerNode: TDOMNode; - begin - result := 0; - for i := stackNode.ChildNodes.Length-1 downto 0 do - begin - layerNode:= stackNode.ChildNodes[i]; - if (layerNode.NodeName = 'layer') and Assigned(layerNode.Attributes) then - inc(result) else - if (layerNode.NodeName = 'stack') then - inc(result, CountLayersRec(layerNode)); - end; - end; - -var - totalLayerCount, doneLayerCount: integer; - - procedure AddLayersRec(stackNode: TDOMNode); - var i,j : integer; - layerNode, attr: TDOMNode; - idx,x,y: integer; - float: double; - errPos: integer; - opstr : string; - gammastr: string; - begin - for i := stackNode.ChildNodes.Length-1 downto 0 do - begin - OnLayeredBitmapLoadProgress(doneLayerCount*100 div totalLayerCount); - layerNode:= stackNode.ChildNodes[i]; - if layerNode.NodeName = 'stack' then - AddLayersRec(layerNode) else - if (layerNode.NodeName = 'layer') and Assigned(layerNode.Attributes) then - begin - attr := layerNode.Attributes.GetNamedItem('src'); - idx := AddLayerFromMemoryStream(UTF8Encode(attr.NodeValue)); - if idx <> -1 then - begin - x := 0; - y := 0; - gammastr := ''; - for j := 0 to layerNode.Attributes.Length-1 do - begin - attr := layerNode.Attributes[j]; - if lowercase(attr.NodeName) = 'opacity' then - begin - val(attr.NodeValue, float, errPos); - if errPos = 0 then - begin - if float < 0 then float := 0; - if float > 1 then float := 1; - LayerOpacity[idx] := round(float*255); - end; - end else - if lowercase(attr.NodeName) = 'gamma-correction' then - gammastr := string(attr.NodeValue) else - if lowercase(attr.NodeName) = 'visibility' then - LayerVisible[idx] := (attr.NodeValue = 'visible') or (attr.NodeValue = 'yes') or (attr.NodeValue = '1') else - if (lowercase(attr.NodeName) = 'x') or (lowercase(attr.NodeName) = 'y') then - begin - val(attr.NodeValue, float, errPos); - if errPos = 0 then - begin - if float < -(MaxInt shr 1) then float := -(MaxInt shr 1); - if float > (MaxInt shr 1) then float := (MaxInt shr 1); - if (lowercase(attr.NodeName) = 'x') then x := round(float); - if (lowercase(attr.NodeName) = 'y') then y := round(float); - end; - end else - if lowercase(attr.NodeName) = 'name' then - LayerName[idx] := UTF8Encode(attr.NodeValue) else - if lowercase(attr.NodeName) = 'composite-op' then - begin - opstr := StringReplace(lowercase(string(attr.NodeValue)),'_','-',[rfReplaceAll]); - if (pos(':',opstr) = 0) and (opstr <> 'xor') then opstr := 'svg:'+opstr; - //parse composite op - if (opstr = 'svg:src-over') or (opstr = 'krita:dissolve') then - BlendOperation[idx] := boTransparent else - if opstr = 'svg:lighten' then - BlendOperation[idx] := boLighten else - if opstr = 'svg:screen' then - BlendOperation[idx] := boScreen else - if opstr = 'svg:color-dodge' then - BlendOperation[idx] := boColorDodge else - if (opstr = 'svg:color-burn') or (opstr = 'krita:gamma_dark'){approx} then - BlendOperation[idx] := boColorBurn else - if opstr = 'svg:darken' then - BlendOperation[idx] := boDarken else - if (opstr = 'svg:plus') or (opstr = 'svg:add') or (opstr = 'krita:linear_dodge') then - BlendOperation[idx] := boLinearAdd else - if (opstr = 'svg:multiply') or (opstr = 'krita:bumpmap') then - BlendOperation[idx] := boMultiply else - if opstr = 'svg:overlay' then - BlendOperation[idx] := boOverlay else - if opstr = 'svg:soft-light' then - BlendOperation[idx] := boSvgSoftLight else - if opstr = 'svg:hard-light' then - BlendOperation[idx] := boHardLight else - if opstr = 'svg:difference' then - BlendOperation[idx] := boLinearDifference else - if (opstr = 'krita:inverse-subtract') or (opstr = 'krita:linear-burn') then - BlendOperation[idx] := boLinearSubtractInverse else - if opstr = 'krita:subtract' then - BlendOperation[idx] := boLinearSubtract else - if (opstr = 'svg:difference') or - (opstr = 'krita:equivalence') then - BlendOperation[idx] := boLinearDifference else - if (opstr = 'svg:exclusion') or - (opstr = 'krita:exclusion') then - BlendOperation[idx] := boLinearExclusion else - if opstr = 'krita:divide' then - BlendOperation[idx] := boDivide else - if opstr = 'bgra:soft-light' then - BlendOperation[idx] := boSoftLight else - if opstr = 'bgra:nice-glow' then - BlendOperation[idx] := boNiceGlow else - if opstr = 'bgra:glow' then - BlendOperation[idx] := boGlow else - if opstr = 'bgra:reflect' then - BlendOperation[idx] := boReflect else - if opstr = 'bgra:negation' then - BlendOperation[idx] := boLinearNegation else - if (opstr = 'bgra:xor') or (opstr = 'xor') then - BlendOperation[idx] := boXor else - if opstr = 'bgra:mask' then - BlendOperation[idx] := boMask else - if opstr = 'bgra:linear-multiply-saturation' then - BlendOperation[idx] := boLinearMultiplySaturation else - if opstr = 'svg:hue' then - BlendOperation[idx] := boCorrectedHue else - if opstr = 'svg:color' then - BlendOperation[idx] := boCorrectedColor else - if opstr = 'svg:luminosity' then - BlendOperation[idx] := boCorrectedLightness else - if opstr = 'svg:saturation' then - BlendOperation[idx] := boCorrectedSaturation else - if opstr = 'krita:hue-hsl' then - BlendOperation[idx] := boLinearHue else - if opstr = 'krita:color-hsl' then - BlendOperation[idx] := boLinearColor else - if opstr = 'krita:lightness' then - BlendOperation[idx] := boLinearLightness else - if opstr = 'krita:saturation-hsl' then - BlendOperation[idx] := boLinearSaturation else - begin - //messagedlg('Unknown blend operation : ' + attr.NodeValue,mtInformation,[mbOk],0); - BlendOperation[idx] := boTransparent; - end; - end; - end; - if LayerOriginalGuid[idx] <> GUID_NULL then - begin - LayerOriginalMatrix[idx] := AffineMatrixTranslation(x,y)*LayerOriginalMatrix[idx]; - RenderLayerFromOriginal(idx); - end else LayerOffset[idx] := point(x,y); - if (gammastr = 'yes') or (gammastr = 'on') then - begin - case BlendOperation[idx] of - boLinearAdd: BlendOperation[idx] := boAdditive; - boOverlay: BlendOperation[idx] := boDarkOverlay; - boLinearDifference: BlendOperation[idx] := boDifference; - boLinearExclusion: BlendOperation[idx] := boExclusion; - boLinearSubtract: BlendOperation[idx] := boSubtract; - boLinearSubtractInverse: BlendOperation[idx] := boSubtractInverse; - boLinearNegation: BlendOperation[idx] := boNegation; - end; - end else - if (gammastr = 'no') or (gammastr = 'off') then - if BlendOperation[idx] = boTransparent then - BlendOperation[idx] := boLinearBlend; //explicit linear blending - end; - inc(doneLayerCount); - end; - end; - end; - -var StackStream: TMemoryStream; - imageNode, stackNode, attr: TDOMNode; - i,w,h: integer; - -begin - inherited Clear; - - if MimeType <> OpenRasterMimeType then - raise Exception.Create('Invalid mime type'); - - StackStream := GetMemoryStream(LayerStackFilename); - if StackStream = nil then - raise Exception.Create('Layer stack not found'); - - ReadXMLFile(FStackXML, StackStream); - - imageNode := StackXML.FindNode('image'); - if imagenode = nil then - raise Exception.Create('Image node not found'); - - w := 0; - h := 0; - LinearBlend := true; - - if Assigned(imageNode.Attributes) then - for i:=0 to imageNode.Attributes.Length-1 do - begin - attr := imagenode.Attributes[i]; - if lowercase(attr.NodeName) = 'w' then - w := strToInt(string(attr.NodeValue)) else - if lowercase(attr.NodeName) = 'h' then - h := strToInt(string(attr.NodeValue)) else - if lowercase(attr.NodeName) = 'gamma-correction' then - linearBlend := (attr.NodeValue = 'no') or (attr.NodeValue = '0'); - end; - - SetSize(w,h); - - stackNode := imageNode.FindNode('stack'); - if stackNode = nil then - raise Exception.Create('Stack node not found'); - - totalLayerCount := CountLayersRec(stackNode); - doneLayerCount := 0; - AddLayersRec(stackNode); -end; - -procedure TBGRAOpenRasterDocument.PrepareZipToSave; - -var i: integer; - imageNode,stackNode,layerNode: TDOMElement; - layerFilename,strval: string; - stackStream: TMemoryStream; - ofs, wantedOfs: TPoint; - fileAdded: Boolean; - svg: TBGRASVG; - m: TAffineMatrix; -begin - ClearFiles; - MimeType := OpenRasterMimeType; - FStackXML := TXMLDocument.Create; - imageNode := TDOMElement(StackXML.CreateElement('image')); - StackXML.AppendChild(imageNode); - imageNode.SetAttribute('w',widestring(inttostr(Width))); - imageNode.SetAttribute('h',widestring(inttostr(Height))); - if LinearBlend then - imageNode.SetAttribute('gamma-correction','no') - else - imageNode.SetAttribute('gamma-correction','yes'); - - stackNode := TDOMElement(StackXML.CreateElement('stack')); - imageNode.AppendChild(stackNode); - SetMemoryStreamAsString('stack.xml',''); //to put it before image data - - CopyThumbnailToMemoryStream(256,256); - - for i := NbLayers-1 downto 0 do - begin - OnLayeredBitmapSaveProgress(round((NbLayers-1-i) * 100 / NbLayers)); - if (LayerOriginalGuid[i] <> GUID_NULL) and LayerOriginalKnown[i] and - LayerOriginalClass[i].CanConvertToSVG then - begin - layerFilename := 'data/layer'+inttostr(i)+'.svg'; - if LayerOriginal[i].IsInfiniteSurface then - begin - svg := LayerOriginal[i].ConvertToSVG(LayerOriginalMatrix[i], wantedOfs) as TBGRASVG; - m := AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y); - svg.WidthAsPixel := self.Width; - svg.HeightAsPixel := self.Height; - end else - begin - svg := LayerOriginal[i].ConvertToSVG(AffineMatrixIdentity, wantedOfs) as TBGRASVG; - m := LayerOriginalMatrix[i] - * AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y); - end; - try - CopySVGToMemoryStream(svg, m, layerFilename, ofs); - fileAdded := true; - finally - svg.Free; - end; - end else - begin - layerFilename := 'data/layer'+inttostr(i)+'.png'; - ofs := LayerOffset[i]; - fileAdded := CopyRasterLayerToMemoryStream(i, layerFilename); - end; - - if fileAdded then - begin - layerNode := StackXML.CreateElement('layer'); - stackNode.AppendChild(layerNode); - layerNode.SetAttribute('name', UTF8Decode(LayerName[i])); - str(LayerOpacity[i]/255:0:3,strval); - layerNode.SetAttribute('opacity',widestring(strval)); - layerNode.SetAttribute('src',widestring(layerFilename)); - if LayerVisible[i] then - layerNode.SetAttribute('visibility','visible') - else - layerNode.SetAttribute('visibility','hidden'); - layerNode.SetAttribute('x',widestring(inttostr(ofs.x))); - layerNode.SetAttribute('y',widestring(inttostr(ofs.y))); - strval := ''; - case BlendOperation[i] of - boLighten: strval := 'svg:lighten'; - boScreen: strval := 'svg:screen'; - boAdditive, boLinearAdd: strval := 'svg:add'; - boColorDodge: strval := 'svg:color-dodge'; - boColorBurn : strval := 'svg:color-burn'; - boDarken: strval := 'svg:darken'; - boMultiply: strval := 'svg:multiply'; - boOverlay, boDarkOverlay: strval := 'svg:overlay'; - boSoftLight: strval := 'bgra:soft-light'; - boHardLight: strval := 'svg:hard-light'; - boDifference,boLinearDifference: strval := 'svg:difference'; - boLinearSubtractInverse, boSubtractInverse: strval := 'krita:inverse_subtract'; - boLinearSubtract, boSubtract: strval := 'krita:subtract'; - boExclusion, boLinearExclusion: strval := 'svg:exclusion'; - boDivide: strval := 'krita:divide'; - boNiceGlow: strval := 'bgra:nice-glow'; - boGlow: strval := 'bgra:glow'; - boReflect: strval := 'bgra:reflect'; - boLinearNegation,boNegation: strval := 'bgra:negation'; - boXor: strval := 'bgra:xor'; - boSvgSoftLight: strval := 'svg:soft-light'; - boMask: strval := 'bgra:mask'; - boLinearMultiplySaturation: strval := 'bgra:linear-multiply-saturation'; - boCorrectedHue: strval := 'svg:hue'; - boCorrectedColor: strval := 'svg:color'; - boCorrectedLightness: strval := 'svg:luminosity'; - boCorrectedSaturation: strval := 'svg:saturation'; - boLinearHue: strval := 'krita:hue_hsl'; - boLinearColor: strval := 'krita:color_hsl'; - boLinearLightness: strval := 'krita:lightness'; - boLinearSaturation: strval := 'krita:saturation_hsl'; - else strval := 'svg:src-over'; - end; - layerNode.SetAttribute('composite-op',widestring(strval)); - if BlendOperation[i] <> boTransparent then //in 'transparent' case, linear blending depends on general setting - begin - if BlendOperation[i] in[boAdditive,boDarkOverlay,boDifference,boSubtractInverse, - boSubtract,boExclusion,boNegation] then - strval := 'yes' else strval := 'no'; - layerNode.SetAttribute('gamma-correction',widestring(strval)); - end; - end; - end; - OnLayeredBitmapSaveProgress(100); - StackStream := TMemoryStream.Create; - WriteXMLFile(StackXML, StackStream); - SetMemoryStream('stack.xml',StackStream); -end; - -procedure TBGRAOpenRasterDocument.LoadFromFile(const filenameUTF8: string); -var AStream: TFileStreamUTF8; -begin - AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); - OnLayeredBitmapLoadStart(filenameUTF8); - try - InternalLoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - AStream.Free; - end; -end; - -procedure TBGRAOpenRasterDocument.SaveToStream(AStream: TStream); -begin - OnLayeredBitmapSaveToStreamStart; - try - InternalSaveToStream(AStream); - finally - OnLayeredBitmapSaved; - end; -end; - -procedure TBGRAOpenRasterDocument.SaveToFile(const filenameUTF8: string); -begin - OnLayeredBitmapSaveStart(filenameUTF8); - try - PrepareZipToSave; - ZipToFile(filenameUTF8); - finally - OnLayeredBitmapSaved; - ClearFiles; - end; -end; - -procedure TBGRAOpenRasterDocument.InternalSaveToStream(AStream: TStream); -begin - try - PrepareZipToSave; - ZipToStream(AStream); - finally - ClearFiles; - end; -end; - -function TBGRAOpenRasterDocument.GetMimeType: string; -begin - if length(FFiles)=0 then - result := OpenRasterMimeType - else - result := GetMemoryStreamAsString('mimetype'); -end; - -procedure TBGRAOpenRasterDocument.InternalLoadFromStream(AStream: TStream); -begin - try - UnzipFromStream(AStream); - AnalyzeZip; - finally - ClearFiles; - end; -end; - -constructor TBGRAOpenRasterDocument.Create; -begin - inherited Create; - RegisterOpenRasterFormat; -end; - -constructor TBGRAOpenRasterDocument.Create(AWidth, AHeight: integer); -begin - inherited Create(AWidth, AHeight); - RegisterOpenRasterFormat; -end; - -function TBGRAOpenRasterDocument.AddLayerFromMemoryStream(ALayerFilename: string): integer; -var stream: TMemoryStream; - bmp: TBGRABitmap; - orig: TBGRALayerSVGOriginal; - svg: TBGRASVG; - g: TSVGGroup; - i, svgElemCount: Integer; - origViewBox: TSVGViewBox; - elemToMove: TList; - m: TAffineMatrix; -begin - stream := GetMemoryStream(ALayerFilename); - if stream = nil then raise Exception.Create('Layer not found'); - - if SuggestImageFormat(ALayerFilename) = ifSvg then - begin - svg := TBGRASVG.Create; - svg.DefaultDpi:= OpenRasterSVGDefaultDPI; - try - svg.LoadFromStream(stream); - except - on ex:exception do - begin - svg.Free; - raise exception.Create('SVG layer format error'); - end; - end; - g := nil; - svgElemCount := 0; - for i := 0 to svg.Content.ElementCount-1 do - if svg.Content.IsSVGElement[i] then - begin - inc(svgElemCount); - if svg.Content.ElementObject[i] is TSVGGroup then - g := TSVGGroup(svg.Content.ElementObject[i]); - end; - - if (svgElemCount = 1) and Assigned(g) and - g.DOMElement.hasAttribute('bgra:originalViewBox') then - begin - svg.ContainerWidthAsPixel:= Width; - svg.ContainerHeightAsPixel:= Height; - origViewBox := TSVGViewBox.Parse(g.DOMElement.GetAttribute('bgra:originalViewBox')); - m := svg.GetStretchPresentationMatrix(cuPixel) * g.matrix[cuPixel] * - AffineMatrixTranslation(origViewBox.min.x, origViewBox.min.y); - g.DOMElement.RemoveAttribute('bgra:originalViewBox'); - for i := svg.Content.ElementCount-1 downto 0 do - if svg.Content.ElementObject[i] <> g then - svg.Content.RemoveElement(svg.Content.ElementObject[i]); - elemToMove := TList.Create; - for i := 0 to g.Content.ElementCount-1 do - elemToMove.Add(g.Content.ElementObject[i]); - for i := 0 to elemToMove.Count-1 do - svg.Content.BringElement(TObject(elemToMove[i]), g.Content); - elemToMove.Free; - svg.Content.RemoveElement(g); - svg.ViewBox := origViewBox; - svg.WidthAsPixel:= origViewBox.size.x; - svg.HeightAsPixel:= origViewBox.size.y; - end else - m := AffineMatrixIdentity; - orig := TBGRALayerSVGOriginal.Create; - orig.SetSVG(svg, Width, Height); - result := AddLayerFromOwnedOriginal(orig); - LayerOriginalMatrix[result] := m; - end else - begin - bmp := TBGRABitmap.Create; - try - bmp.LoadFromStream(stream); - except - on ex: exception do - begin - bmp.Free; - raise exception.Create('Raster layer format error'); - end; - end; - result := AddOwnedLayer(bmp); - end; - LayerName[result] := ExtractFileName(ALayerFilename); -end; - -function TBGRAOpenRasterDocument.CopyRasterLayerToMemoryStream(ALayerIndex: integer; - ALayerFilename: string): boolean; -var - bmp: TBGRABitmap; - mustFreeBmp: boolean; -begin - result := false; - bmp := LayerBitmap[ALayerIndex]; - if bmp <> nil then mustFreeBmp := false - else - begin - bmp := GetLayerBitmapCopy(ALayerIndex); - if bmp = nil then exit; - mustFreeBmp:= true; - end; - - result := CopyBitmapToMemoryStream(bmp,ALayerFilename); - if mustFreeBmp then bmp.Free; -end; - -procedure TBGRAOpenRasterDocument.CopySVGToMemoryStream( - ASVG: TBGRASVG; ASVGMatrix: TAffineMatrix; AOutFilename: string; out AOffset: TPoint); - - function IsIntegerTranslation(m: TAffineMatrix; out ofs: TPoint): boolean; - begin - ofs := Point(round(m[1,3]), round(m[2,3])); - result := IsAffineMatrixTranslation(m) and - (abs(round(m[1,3]) - ofs.x) < 1e-4) and - (abs(round(m[2,3]) - ofs.y) < 1e-4); - end; - - procedure StoreSVG(ASVG: TBGRASVG); - var - memStream: TMemoryStream; - w, h: Single; - begin - memStream := TMemoryStream.Create; - try - w := ASVG.WidthAsPixel; - h := ASVG.HeightAsPixel; - //ensure we are not using units affected by DPI - ASVG.ConvertToUnit(cuCustom); - ASVG.WidthAsPixel := w; - ASVG.HeightAsPixel := h; - ASVG.SaveToStream(memStream); - SetMemoryStream(AOutFilename,memstream); - except - on ex: Exception do - begin - memStream.Free; - raise exception.Create(ex.Message); - end; - end; - end; - - procedure StoreTransformedSVG(out AOffset: TPoint); - var - box, transfBox: TAffineBox; - newSvg: TBGRASVG; - newBounds: TRectF; - rootElems: TList; - i: Integer; - g: TSVGGroup; - newViewBox, origViewBox: TSVGViewBox; - presentMatrix: TAffineMatrix; - begin - newSvg := ASVG.Duplicate; - presentMatrix := ASVGMatrix * newSvg.GetStretchPresentationMatrix(cuPixel); - rootElems := TList.Create; - try - origViewBox := newSvg.ViewBox; - with origViewBox do - box := TAffineBox.AffineBox(RectWithSizeF(min.x, min.y, size.x, size.y)); - transfBox := presentMatrix * box; - newBounds := RectF(transfBox.RectBounds); - AOffset := Point(round(newBounds.Left), round(newBounds.Top)); - newBounds.Offset(-AOffset.X, -AOffset.Y); - presentMatrix := AffineMatrixTranslation(-AOffset.X, -AOffset.Y) * presentMatrix; - for i := 0 to newSvg.Content.ElementCount-1 do - rootElems.Add(newSvg.Content.ElementObject[i]); - g := newSvg.Content.AppendGroup; - for i := 0 to rootElems.Count-1 do - g.Content.BringElement(TObject(rootElems[i]), newSvg.Content); - g.matrix[cuPixel] := presentMatrix; - g.DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format'); - g.DOMElement.SetAttribute('bgra:originalViewBox', origViewBox.ToString); - newSvg.WidthAsPixel:= newBounds.Width; - newSvg.HeightAsPixel:= newBounds.Height; - newViewBox.min := newBounds.TopLeft; - newViewBox.size := PointF(newBounds.Width, newBounds.Height); - newSvg.ViewBox := newViewBox; - StoreSVG(newSvg); - finally - rootElems.Free; - newSvg.Free; - end; - end; - -begin - if IsIntegerTranslation(ASVGMatrix, AOffset) then - StoreSVG(ASVG) - else StoreTransformedSVG(AOffset); -end; - -function TBGRAOpenRasterDocument.CopyBitmapToMemoryStream(ABitmap: TBGRABitmap; - AFilename: string): boolean; -var - memStream: TMemoryStream; -begin - result := false; - memstream := TMemoryStream.Create; - try - ABitmap.SaveToStreamAsPng(memStream); - SetMemoryStream(AFilename,memstream); - result := true; - except - on ex: Exception do - begin - memStream.Free; - end; - end; -end; - -procedure TBGRAOpenRasterDocument.SetMemoryStreamAsString(AFilename: string; - AContent: string); -var strstream: TStringStream; - memstream: TMemoryStream; -begin - strstream:= TStringStream.Create(AContent); - memstream := TMemoryStream.Create; - strstream.Position := 0; - memstream.CopyFrom(strstream, strstream.Size); - strstream.Free; - SetMemoryStream(AFilename, memstream); -end; - -function TBGRAOpenRasterDocument.GetMemoryStreamAsString(AFilename: string): string; -var stream: TMemoryStream; - str: TStringStream; -begin - stream := GetMemoryStream(AFilename); - str := TStringStream.Create(''); - str.CopyFrom(stream,stream.Size); - result := str.DataString; - str.Free; -end; - -procedure TBGRAOpenRasterDocument.UnzipFromStream(AStream: TStream; - AFileList: TStrings = nil); -var unzip: TUnZipper; -begin - ClearFiles; - unzip := TUnZipper.Create; - try - unzip.OnCreateStream := @ZipOnCreateStream; - unzip.OnDoneStream := @ZipOnDoneStream; - unzip.OnOpenInputStream := @ZipOnOpenInputStream; - unzip.OnCloseInputStream := @ZipOnCloseInputStream; - FZipInputStream := AStream; - if Assigned(AFileList) then - begin - if AFileList.Count > 0 then - unzip.UnZipFiles(AFileList); - end else - unzip.UnZipAllFiles; - finally - FZipInputStream := nil; - unzip.Free; - end; -end; - -procedure TBGRAOpenRasterDocument.UnzipFromFile(AFilenameUTF8: string); -var unzip: TUnZipper; -begin - ClearFiles; - unzip := TUnZipper.Create; - try - unzip.FileName := Utf8ToAnsi(AFilenameUTF8); - unzip.OnCreateStream := @ZipOnCreateStream; - unzip.OnDoneStream := @ZipOnDoneStream; - unzip.UnZipAllFiles; - finally - unzip.Free; - end; -end; - -procedure TBGRAOpenRasterDocument.ZipToFile(AFilenameUTF8: string); -var - stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); - try - ZipToStream(stream); - finally - stream.Free; - end; -end; - -procedure TBGRAOpenRasterDocument.ZipToStream(AStream: TStream); -var zip: TZipper; - i: integer; - tempFile: String; -begin - zip := TZipper.Create; - tempFile := ChangeFileExt(GetTempFileName, ''); - if ExtractFileExt(tempFile) = '.tmp' then - tempFile := ChangeFileExt(tempFile, ''); - zip.FileName:= tempFile; - try - for i := 0 to high(FFiles) do - begin - FFiles[i].Stream.Position:= 0; - zip.Entries.AddFileEntry(FFiles[i].Stream,FFiles[i].Filename).CompressionLevel := clnone; - end; - zip.SaveToStream(AStream); - finally - zip.Free; - end; -end; - -procedure TBGRAOpenRasterDocument.CopyThumbnailToMemoryStream(AMaxWidth,AMaxHeight: integer); -var thumbnail: TBGRABitmap; - w,h: integer; -begin - if (Width = 0) or (Height = 0) then exit; - thumbnail := ComputeFlatImage; - CopyBitmapToMemoryStream(thumbnail,MergedImageFilename); - if (thumbnail.Width > AMaxWidth) or - (thumbnail.Height > AMaxHeight) then - begin - if thumbnail.Width > AMaxWidth then - begin - w := AMaxWidth; - h := round(thumbnail.Height* (w/thumbnail.Width)); - end else - begin - w := thumbnail.Width; - h := thumbnail.Height; - end; - if h > AMaxHeight then - begin - h := AMaxHeight; - w := round(thumbnail.Width* (h/thumbnail.Height)); - end; - BGRAReplace(thumbnail, thumbnail.Resample(w,h)); - end; - CopyBitmapToMemoryStream(thumbnail,'Thumbnails/thumbnail.png'); - thumbnail.Free; -end; - -procedure TBGRAOpenRasterDocument.Clear; -begin - ClearFiles; - inherited Clear; -end; - -function TBGRAOpenRasterDocument.CheckMimeType(AStream: TStream): boolean; -var unzip: TUnzipperStreamUtf8; - mimeTypeFound: string; - oldPos: int64; -begin - result := false; - unzip := TUnzipperStreamUtf8.Create; - oldPos := AStream.Position; - try - unzip.InputStream := AStream; - mimeTypeFound := unzip.UnzipFileToString('mimetype'); - if mimeTypeFound = OpenRasterMimeType then result := true; - except - end; - unzip.Free; - astream.Position:= OldPos; -end; - -procedure TBGRAOpenRasterDocument.LoadFlatImageFromStream(AStream: TStream; out - ANbLayers: integer; out ABitmap: TBGRABitmap); -var fileList: TStringList; - imgStream, stackStream: TMemoryStream; - imageNode, stackNode: TDOMNode; - i: integer; -begin - fileList := TStringList.Create; - fileList.Add(MergedImageFilename); - fileList.Add(LayerStackFilename); - imgStream := nil; - try - UnzipFromStream(AStream, fileList); - imgStream := GetMemoryStream(MergedImageFilename); - if imgStream = nil then - ABitmap := nil - else - ABitmap := TBGRABitmap.Create(imgStream); - ANbLayers := 1; - - stackStream := GetMemoryStream(LayerStackFilename); - ReadXMLFile(FStackXML, StackStream); - imageNode := StackXML.FindNode('image'); - if Assigned(imagenode) then - begin - stackNode := imageNode.FindNode('stack'); - if Assigned(stackNode) then - begin - ANbLayers:= 0; - for i := stackNode.ChildNodes.Length-1 downto 0 do - begin - if stackNode.ChildNodes[i].NodeName = 'layer' then - inc(ANbLayers); - end; - end; - end; - - finally - fileList.Free; - ClearFiles; - end; -end; - -procedure TBGRAOpenRasterDocument.LoadFromStream(AStream: TStream); -begin - OnLayeredBitmapLoadFromStreamStart; - try - InternalLoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - end; -end; - -procedure TBGRAOpenRasterDocument.SetMimeType(AValue: string); -begin - SetMemoryStreamAsString('mimetype',AValue); -end; - -procedure TBGRAOpenRasterDocument.ZipOnCreateStream(Sender: TObject; var AStream: TStream; - AItem: TFullZipFileEntry); -var MemStream: TMemoryStream; -begin - MemStream := TMemoryStream.Create; - SetMemoryStream(AItem.ArchiveFileName, MemStream); - AStream := MemStream; -end; - -{$hints off} -procedure TBGRAOpenRasterDocument.ZipOnDoneStream(Sender: TObject; var AStream: TStream; - AItem: TFullZipFileEntry); -begin - //do nothing, files stay in memory -end; -{$hints on} - -procedure TBGRAOpenRasterDocument.ZipOnOpenInputStream(Sender: TObject; - var AStream: TStream); -begin - AStream := FZipInputStream; -end; - -procedure TBGRAOpenRasterDocument.ZipOnCloseInputStream(Sender: TObject; - var AStream: TStream); -begin - AStream := nil; //avoid freeing -end; - -procedure TBGRAOpenRasterDocument.ClearFiles; -var i: integer; -begin - for i := 0 to high(FFiles) do - ffiles[i].Stream.Free; - FFiles := nil; - FreeAndNil(FStackXML); -end; - -function TBGRAOpenRasterDocument.GetMemoryStream(AFilename: string): TMemoryStream; -var i: integer; -begin - for i := 0 to high(FFiles) do - if ffiles[i].Filename = AFilename then - begin - result := FFiles[i].Stream; - result.Position:= 0; - exit; - end; - result := nil; -end; - -procedure TBGRAOpenRasterDocument.SetMemoryStream(AFilename: string; - AStream: TMemoryStream); -var i: integer; -begin - for i := 0 to high(FFiles) do - if ffiles[i].Filename = AFilename then - begin - FreeAndNil(FFiles[i].Stream); - FFiles[i].Stream := AStream; - exit; - end; - setlength(FFiles, length(FFiles)+1); - FFiles[high(FFiles)].Filename := AFilename; - FFiles[high(FFiles)].Stream := AStream; -end; - -var AlreadyRegistered: boolean; - -procedure RegisterOpenRasterFormat; -begin - if AlreadyRegistered then exit; - ImageHandlers.RegisterImageReader ('OpenRaster', 'ora', TFPReaderOpenRaster); - RegisterLayeredBitmapReader('ora', TBGRAOpenRasterDocument); - RegisterLayeredBitmapWriter('ora', TBGRAOpenRasterDocument); - //TPicture.RegisterFileFormat('ora', 'OpenRaster', TBGRAOpenRasterDocument); - DefaultBGRAImageReader[ifOpenRaster] := TFPReaderOpenRaster; - DefaultBGRAImageWriter[ifOpenRaster] := TFPWriterOpenRaster; - AlreadyRegistered:= True; -end; - -end. - diff --git a/components/bgrabitmap/bgrapaintnet.pas b/components/bgrabitmap/bgrapaintnet.pas deleted file mode 100644 index f205689..0000000 --- a/components/bgrabitmap/bgrapaintnet.pas +++ /dev/null @@ -1,660 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAPaintNet; - -{$mode objfpc}{$H+} - -interface - -{ This unit reads Paint.NET files. It needs BGRADNetDeserial to deserialize binary .Net objects. - - A Paint.NET image consists in three parts : - - Xml header - - Binary serialized information (contains layer information) - - Compressed data (pixel data) - - The class TPaintDotNetFile do not read the Xml header. ComputeFlatImage builds the resulting image - by using blending operations to merge layers. - - The unit registers a TFPCustomImageReader so that it can be read by any image reading function of FreePascal, - and also registers a reader for BGRALayers } - -uses - BGRAClasses, SysUtils, BGRADNetDeserial, FPImage, BGRABitmapTypes, BGRABitmap, BGRALayers; - -type - - { TPaintDotNetFile } - - TPaintDotNetFile = class(TBGRACustomLayeredBitmap) - public - procedure LoadFromFile(const filenameUTF8: string); override; - procedure LoadFromStream(stream: TStream); override; - procedure Clear; override; - function ToString: ansistring; override; - function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override; - constructor Create; override; - protected - procedure InternalLoadFromStream(stream: TStream); - function GetWidth: integer; override; - function GetHeight: integer; override; - function GetNbLayers: integer; override; - function GetBlendOperation(Layer: integer): TBlendOperation; override; - function GetLayerVisible(layer: integer): boolean; override; - function GetLayerOpacity(layer: integer): byte; override; - function GetLayerName(layer: integer): string; override; - private - Content: TDotNetDeserialization; - Document: TSerializedClass; - Layers: TSerializedClass; - LayerData: array of TMemoryStream; - function InternalGetLayer(num: integer): TSerializedClass; - function InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation; - function InternalGetLayerName(layer: TSerializedClass): string; - function InternalGetLayerVisible(layer: TSerializedClass): boolean; - function InternalGetLayerOpacity(layer: TSerializedClass): byte; - function LayerDataSize(numLayer: integer): int64; - procedure LoadLayer(dest: TMemoryStream; src: TStream; uncompressedSize: int64); - end; - - { TFPReaderPaintDotNet } - - TFPReaderPaintDotNet = class(TFPCustomImageReader) - private - FWidth,FHeight,FNbLayers: integer; - protected - function InternalCheck(Stream: TStream): boolean; override; - procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; - public - property Width: integer read FWidth; - property Height: integer read FHeight; - property NbLayers: integer read FNbLayers; - end; - -function IsPaintDotNetFile(filename: string): boolean; -function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean; -function IsPaintDotNetStream(stream: TStream): boolean; -function LoadPaintDotNetFile(filename: string): TBGRABitmap; -function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap; - -procedure RegisterPaintNetFormat; - -implementation - -uses zstream, Math, BGRAUTF8; - -{$hints off} -function BEReadLongword(Stream: TStream): LongWord; -begin - Stream.Read(Result, sizeof(Result)); - Result := BEtoN(Result); -end; - -{$hints on} - -{$hints off} -function BEReadLongint(Stream: TStream): longint; -begin - Stream.Read(Result, sizeof(Result)); - Result := BEtoN(Result); -end; - -function IsPaintDotNetFile(filename: string): boolean; -var - stream: TFileStreamUTF8; -begin - Result := False; - if FileExists(filename) then - begin - stream := TFileStreamUTF8.Create(SysToUTF8(filename), fmOpenRead); - Result := IsPaintDotNetStream(stream); - stream.Free; - end; -end; - -function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean; -var - stream: TFileStreamUTF8; -begin - Result := False; - if FileExistsUTF8(filenameUTF8) then - begin - stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead); - Result := IsPaintDotNetStream(stream); - stream.Free; - end; -end; - -function IsPaintDotNetStream(stream: TStream): boolean; -var - header: packed array[0..3] of char; - SavePos: int64; -begin - Result := False; - try - if stream.Position + 4 < Stream.Size then - begin - header := #0#0#0#0; - SavePos := stream.Position; - stream.Read(header, 4); - stream.Position := SavePos; - if (header[0] = 'P') and (header[1] = 'D') and (header[2] = 'N') and - (header[3] = '3') then - Result := True; - end; - except - on ex: Exception do ; - end; -end; - -function LoadPaintDotNetFile(filename: string): TBGRABitmap; -begin - result := LoadPaintDotNetFileUTF8(SysToUTF8(filename)); -end; - -function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap; -var - pdn: TPaintDotNetFile; -begin - pdn := TPaintDotNetFile.Create; - Result := nil; - try - pdn.LoadFromFile(filenameUTF8); - Result := pdn.ComputeFlatImage; - pdn.Free; - except - on ex: Exception do - begin - FreeAndNil(Result); - pdn.Free; - raise Exception.Create('Error while loading Paint.NET file. ' + ex.Message); - end; - end; -end; - -function LoadPaintDotNetStream(stream: TStream): TBGRABitmap; -var - pdn: TPaintDotNetFile; -begin - pdn := TPaintDotNetFile.Create; - Result := nil; - try - pdn.LoadFromStream(stream); - Result := pdn.ComputeFlatImage; - pdn.Free; - except - on ex: Exception do - begin - FreeAndNil(Result); - pdn.Free; - raise Exception.Create('Error while loading Paint.NET stream. ' + ex.Message); - end; - end; -end; - -{$hints on} - -{ TFPReaderPaintDotNet } - -function TFPReaderPaintDotNet.InternalCheck(Stream: TStream): boolean; -begin - result := IsPaintDotNetStream(stream); -end; - -procedure TFPReaderPaintDotNet.InternalRead(Stream: TStream; Img: TFPCustomImage); -var - pdn: TPaintDotNetFile; - flat: TBGRABitmap; - x,y: integer; -begin - FWidth := 0; - FHeight:= 0; - FNbLayers:= 0; - pdn := TPaintDotNetFile.Create; - try - pdn.LoadFromStream(Stream); - flat := pdn.ComputeFlatImage; - try - FWidth:= pdn.Width; - FHeight:= pdn.Height; - FNbLayers:= pdn.NbLayers; - - if Img is TBGRACustomBitmap then - TBGRACustomBitmap(Img).Assign(flat) else - begin - Img.SetSize(pdn.Width,pdn.Height); - for y := 0 to pdn.Height-1 do - for x := 0 to pdn.Width-1 do - Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y)); - end; - finally - flat.free; - end; - pdn.Free; - except - on ex: Exception do - begin - pdn.Free; - raise Exception.Create('Error while loading Paint.NET file. ' + ex.Message); - end; - end; -end; - -{ TPaintDotNetFile } - -procedure TPaintDotNetFile.LoadFromFile(const filenameUTF8: string); -var - stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead); - OnLayeredBitmapLoadStart(filenameUTF8); - try - InternalLoadFromStream(stream); - finally - OnLayeredBitmapLoaded; - stream.Free; - end; -end; - -procedure TPaintDotNetFile.LoadFromStream(stream: TStream); -begin - OnLayeredBitmapLoadFromStreamStart; - try - InternalLoadFromStream(stream); - finally - OnLayeredBitmapLoaded; - end; -end; - -procedure TPaintDotNetFile.InternalLoadFromStream(stream: TStream); -var - header: packed array[0..3] of char; - XmlHeaderSize: integer; - CompressionFormat: word; - i: integer; -begin - Clear; - header := #0#0#0#0; - stream.Read(header, 4); - if (header[0] <> 'P') or (header[1] <> 'D') or (header[2] <> 'N') or - (header[3] <> '3') then - raise Exception.Create('Invalid header'); - XmlHeaderSize := 0; - stream.Read(XmlHeaderSize, 3); - XmlheaderSize := LEtoN(XmlheaderSize); - if Stream.Position + XmlHeaderSize > stream.Size then - raise Exception.Create('Xml header size error'); - Stream.Position:= Stream.Position + XmlHeaderSize; - {$hints off} - stream.ReadBuffer(CompressionFormat, sizeof(CompressionFormat)); - {$hints on} - CompressionFormat := LEToN(CompressionFormat); - Content := TDotNetDeserialization.Create; - case Compressionformat of - $0100: Content.LoadFromStream(Stream); - $8b1f: raise Exception.Create('Serialized data decompression not handled'); - else - raise Exception.Create('Unknown compression format (' + - IntToStr(Compressionformat) + ')'); - end; - Document := Content.FindClass('Document'); - if Document <> nil then - Layers := Content.GetObjectField(Document, 'layers') as TSerializedClass; - SetLength(LayerData, NbLayers); - for i := 0 to NbLayers - 1 do - begin - OnLayeredBitmapLoadProgress((i+1)*100 div NbLayers); - LayerData[i] := TMemoryStream.Create; - LoadLayer(LayerData[i], Stream, LayerDataSize(i)); - end; - OnLayeredBitmapLoadProgress(100); -end; - -function TPaintDotNetFile.ToString: ansistring; -var - i, j, nbbytes: integer; - b: byte; -begin - Result := 'Paint.Net document' + LineEnding + LineEnding; - AppendStr(Result, Content.ToString); - for i := 0 to NbLayers - 1 do - begin - AppendStr(Result, LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding); - AppendStr(Result, '[ '); - LayerData[i].Position := 0; - if LayerData[i].Size > 256 then - nbbytes := 256 - else - nbbytes := LayerData[i].Size; - for j := 0 to nbbytes - 1 do - begin - {$hints off} - LayerData[i].ReadBuffer(b, 1); - {$hints on} - AppendStr(Result, IntToHex(b, 2) + ' '); - end; - if LayerData[i].Size > nbbytes then - AppendStr(Result, '...'); - AppendStr(Result, ']' + lineending); - end; -end; - -constructor TPaintDotNetFile.Create; -begin - inherited Create; - Content := nil; - Document := nil; - Layers := nil; - LinearBlend := True; - RegisterPaintNetFormat; -end; - -procedure TPaintDotNetFile.Clear; -var - i: integer; -begin - FreeAndNil(content); - document := nil; - Layers := nil; - for i := 0 to high(LayerData) do - LayerData[i].Free; - setLength(LayerData, 0); -end; - -function TPaintDotNetFile.GetWidth: integer; -begin - if Document = nil then - Result := 0 - else - Result := StrToInt(Content.GetSimpleField(Document, 'width')); -end; - -function TPaintDotNetFile.GetHeight: integer; -begin - if Document = nil then - Result := 0 - else - Result := StrToInt(Content.GetSimpleField(Document, 'height')); -end; - -function TPaintDotNetFile.GetNbLayers: integer; -begin - if Layers = nil then - Result := 0 - else - Result := StrToInt(Content.GetSimpleField(Layers, '_size')); -end; - -function TPaintDotNetFile.GetBlendOperation(Layer: integer): TBlendOperation; -begin - Result := InternalGetBlendOperation(InternalGetLayer(layer)); -end; - -function TPaintDotNetFile.GetLayerVisible(layer: integer): boolean; -begin - Result := InternalGetLayerVisible(InternalGetLayer(layer)); -end; - -function TPaintDotNetFile.GetLayerOpacity(layer: integer): byte; -begin - Result := InternalGetLayerOpacity(InternalGetLayer(layer)); -end; - -function TPaintDotNetFile.GetLayerName(layer: integer): string; -begin - Result := InternalGetLayerName(InternalGetLayer(layer)); -end; - -function TPaintDotNetFile.GetLayerBitmapCopy(layer: integer): TBGRABitmap; -begin - if (layer < 0) or (layer >= NbLayers) then - raise Exception.Create('Index out of bounds'); - - Result := TBGRABitmap.Create(Width, Height); - if int64(Result.NbPixels) * 4 <> LayerData[layer].Size then - begin - Result.Free; - raise Exception.Create('Inconsistent layer data size'); - end - else - begin - layerData[layer].Position := 0; - layerData[layer].Read(Result.Data^, LayerData[layer].Size); - if TBGRAPixel_RGBAOrder then result.SwapRedBlue; - Result.InvalidateBitmap; - - if Result.LineOrder = riloBottomToTop then - Result.VerticalFlip; - end; -end; - -function TPaintDotNetFile.InternalGetLayerName(layer: TSerializedClass): string; -var - prop: TCustomSerializedObject; -begin - if layer = nil then - Result := '' - else - begin - prop := Content.GetObjectField(layer, 'Layer+properties'); - if prop = nil then - Result := '' - else - begin - Result := Content.GetSimpleField(prop, 'name'); - end; - end; -end; - -function TPaintDotNetFile.LayerDataSize(numLayer: integer): int64; -var - layer, surface, scan0: TCustomSerializedObject; -begin - layer := InternalGetLayer(numLayer); - if layer = nil then - Result := 0 - else - begin - surface := Content.GetObjectField(layer, 'surface'); - if surface = nil then - Result := 0 - else - begin - scan0 := Content.GetObjectField(surface, 'scan0'); - Result := StrToInt64(Content.GetSimpleField(scan0, 'length64')); - end; - end; -end; - -procedure TPaintDotNetFile.LoadLayer(dest: TMemoryStream; src: TStream; - uncompressedSize: int64); -var - CompressionFlag: byte; - maxChunkSize, decompressedChunkSize, compressedChunkSize: LongWord; - chunks: array of TMemoryStream; - numChunk: integer; - chunkCount, i: integer; - decomp: Tdecompressionstream; - nextPos: int64; - -begin - {$hints off} - src.ReadBuffer(CompressionFlag, 1); - {$hints on} - if CompressionFlag = 1 then - dest.CopyFrom(src, uncompressedSize) - else - if CompressionFlag = 0 then - begin - maxChunkSize := BEReadLongword(src); - if maxChunkSize < 4 then - raise Exception.Create('Invalid max chunk size'); - chunkCount := (uncompressedSize + maxChunkSize - 1) div maxChunkSize; - setlength(chunks, chunkCount); - for i := 0 to ChunkCount - 1 do - begin - numChunk := BEReadLongint(src); - if (numChunk < 0) or (numChunk >= chunkCount) then - raise Exception.Create('Chunk number out of bounds'); - compressedChunkSize := BEReadLongword(src); - nextPos := src.Position + compressedChunkSize; - src.Position := src.Position + 10; //skip gzip header - decompressedChunkSize := - min(maxChunkSize, uncompressedSize - int64(numChunk) * int64(maxChunkSize)); - decomp := Tdecompressionstream.Create(src, True); - chunks[numChunk] := TMemoryStream.Create; - chunks[numChunk].CopyFrom(decomp, decompressedChunkSize); - FreeAndNil(decomp); - src.Position := nextPos; - end; - for i := 0 to ChunkCount - 1 do - begin - chunks[i].Position := 0; - dest.CopyFrom(chunks[i], chunks[i].size); - chunks[i].Free; - end; - setlength(chunks, 0); - end - else - raise Exception('Unknown compression flag (' + IntToStr(CompressionFlag) + ')'); -end; - -function TPaintDotNetFile.InternalGetLayer(num: integer): TSerializedClass; -var - layerList: TCustomSerializedObject; -begin - if Layers = nil then - raise Exception.Create('No layers available') - else - if (num < 0) or (num >= NbLayers) then - raise Exception.Create('Layer index out of bounds') - else - begin - layerList := Content.GetObjectField(Layers, '_items'); - Result := Content.GetObject(layerList.FieldAsString[num]) as TSerializedClass; - end; -end; - -function TPaintDotNetFile.InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation; -var - prop, blendOp: TCustomSerializedObject; - blendName: string; -begin - if layer = nil then - Result := boTransparent - else - begin - prop := Content.GetObjectField(layer, 'properties'); - if prop = nil then - Result := boTransparent - else - begin - blendOp := Content.GetObjectField(prop, 'blendOp'); - if blendOp = nil then - Result := boTransparent - else - begin - blendName := blendOp.TypeAsString; - if (pos('+', blendName) <> 0) then - Delete(blendName, 1, pos('+', blendName)); - if copy(blendName, length(blendName) - length('BlendOp') + - 1, length('BlendOp')) = 'BlendOp' then - Delete(blendName, length(blendName) - length('BlendOp') + - 1, length('BlendOp')); - - if blendName = 'Normal' then - Result := boTransparent - else - if blendName = 'Multiply' then - Result := boLinearMultiply - else - if blendName = 'Additive' then - Result := boLinearAdd - else - if blendName = 'ColorBurn' then - Result := boColorBurn - else - if blendName = 'ColorDodge' then - Result := boColorDodge - else - if blendName = 'Reflect' then - Result := boReflect - else - if blendName = 'Glow' then - Result := boGlow - else - if blendName = 'Overlay' then - Result := boOverlay - else - if blendName = 'Difference' then - Result := boLinearDifference - else - if blendName = 'Negation' then - Result := boLinearNegation - else - if blendName = 'Lighten' then - Result := boLighten - else - if blendName = 'Darken' then - Result := boDarken - else - if blendName = 'Screen' then - Result := boScreen - else - if blendName = 'Xor' then - Result := boXor - else - Result := boTransparent; - end; - end; - end; -end; - -function TPaintDotNetFile.InternalGetLayerVisible(layer: TSerializedClass): boolean; -var - prop: TCustomSerializedObject; -begin - if layer = nil then - Result := False - else - begin - prop := Content.GetObjectField(layer, 'Layer+properties'); - if prop = nil then - Result := False - else - begin - Result := (Content.GetSimpleField(prop, 'visible') = 'True'); - end; - end; -end; - -function TPaintDotNetFile.InternalGetLayerOpacity(layer: TSerializedClass): byte; -var - prop: TCustomSerializedObject; -begin - if layer = nil then - Result := 0 - else - begin - prop := Content.GetObjectField(layer, 'Layer+properties'); - if prop = nil then - Result := 0 - else - begin - Result := StrToInt(Content.GetSimpleField(prop, 'opacity')); - end; - end; -end; - -var AlreadyRegistered: boolean; - -procedure RegisterPaintNetFormat; -begin - if AlreadyRegistered then exit; - ImageHandlers.RegisterImageReader ('Paint.NET image', 'pdn', TFPReaderPaintDotNet); - RegisterLayeredBitmapReader('pdn', TPaintDotNetFile); - //TPicture.RegisterFileFormat('pdn', 'Paint.NET image', TPaintDotNetFile); - DefaultBGRAImageReader[ifPaintDotNet] := TFPReaderPaintDotNet; - AlreadyRegistered := true; -end; - -end. diff --git a/components/bgrabitmap/bgrapalette.pas b/components/bgrabitmap/bgrapalette.pas deleted file mode 100644 index d083627..0000000 --- a/components/bgrabitmap/bgrapalette.pas +++ /dev/null @@ -1,1408 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAPalette; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, Avl_Tree, BGRABitmapTypes, FPimage; - -const - MaxLastAddedColors = 10; - -type - TBGRAPaletteFormat = integer; - -const - palUnknown : TBGRAPaletteFormat = 0; - palPaintDotNet : TBGRAPaletteFormat = 1; - palGimp : TBGRAPaletteFormat = 2; - palAdobeSwatchExchange : TBGRAPaletteFormat = 3; - palKOffice : TBGRAPaletteFormat = 4; - palJascPSP : TBGRAPaletteFormat = 5; - palCustom : TBGRAPaletteFormat = 100; - -type - TBGRAIndexedPaletteEntry = packed record - Color: TBGRAPixel; - Index: UInt32; - end; - PBGRAIndexedPaletteEntry = ^TBGRAIndexedPaletteEntry; - TBGRAWeightedPaletteEntry = packed record - Color: TBGRAPixel; - Weight: UInt32; - end; - PBGRAWeightedPaletteEntry = ^TBGRAWeightedPaletteEntry; - ArrayOfWeightedColor = array of TBGRAWeightedPaletteEntry; - - TBGRAPixelComparer = function (p1,p2 : PBGRAPixel): boolean; - - { TBGRACustomPalette } - - TBGRACustomPalette = class - private - function GetDominantColor: TBGRAPixel; - protected - function GetCount: integer; virtual; abstract; - function GetColorByIndex(AIndex: integer): TBGRAPixel; virtual; abstract; - public - function ContainsColor(AValue: TBGRAPixel): boolean; virtual; abstract; - function IndexOfColor(AValue: TBGRAPixel): integer; virtual; abstract; - function GetAsArrayOfColor: ArrayOfTBGRAPixel; virtual; abstract; - function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; virtual; abstract; - procedure AssignTo(AImage: TFPCustomImage); overload; - procedure AssignTo(APalette: TFPPalette); overload; - property DominantColor: TBGRAPixel read GetDominantColor; - property Count: integer read GetCount; - property Color[AIndex: integer]: TBGRAPixel read GetColorByIndex; - end; - -type - { TBGRAAvgLvlPalette } - - TBGRAAvgLvlPalette = class(TBGRACustomPalette) - protected - FTree: TAVLTree; - FArray: array of PBGRAPixel; - FLastAddedColors: packed array[0..MaxLastAddedColors-1] of PBGRAPixel; - FLastAddedColorCount: integer; - function GetCount: integer; override; - function GetColorByIndex(AIndex: integer): TBGRAPixel; override; - procedure FreeEntry(AEntry: PBGRAPixel); virtual; abstract; - procedure NeedArray; virtual; - procedure ClearArray; virtual; - procedure AddLastColor(AColor: PBGRAPixel); - function GetLastColor(AValue: TBGRAPixel): PBGRAPixel; - procedure ClearLastColors; - public - constructor Create; overload; - function ContainsColor(AValue: TBGRAPixel): boolean; override; - function IndexOfColor(AValue: TBGRAPixel): integer; override; - procedure Clear; virtual; - destructor Destroy; override; - function GetAsArrayOfColor: ArrayOfTBGRAPixel; override; - function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; - end; - - { TBGRAPalette } - - TBGRAPalette = class(TBGRAAvgLvlPalette) - protected - function CreateEntry(AColor: TBGRAPixel): PBGRAPixel; virtual; - procedure FreeEntry(AEntry: PBGRAPixel); override; - procedure IncludePixel(PPixel: PBGRAPixel); virtual; - procedure ExceptionUnknownPaletteFormat; - procedure ExceptionInvalidPaletteFormat; - public - constructor Create(ABitmap: TBGRACustomBitmap); overload; virtual; - constructor Create(APalette: TBGRACustomPalette); overload; virtual; - constructor Create(AColors: ArrayOfTBGRAPixel); overload; virtual; - constructor Create(AColors: ArrayOfWeightedColor); overload; virtual; - function AddColor(AValue: TBGRAPixel): boolean; virtual; - procedure AddColors(ABitmap: TBGRACustomBitmap); overload; virtual; - procedure AddColors(APalette: TBGRACustomPalette); overload; virtual; - function RemoveColor(AValue: TBGRAPixel): boolean; virtual; - procedure LoadFromFile(AFilenameUTF8: string); virtual; - procedure LoadFromStream(AStream: TStream; AFormat: TBGRAPaletteFormat); virtual; - procedure LoadFromResource(AFilename: string; AFormat: TBGRAPaletteFormat); - procedure SaveToFile(AFilenameUTF8: string); virtual; - procedure SaveToStream(AStream: TStream; AFormat: TBGRAPaletteFormat); virtual; - function DetectPaletteFormat(AStream: TStream): TBGRAPaletteFormat; overload; virtual; - function DetectPaletteFormat(AFilenameUTF8: string): TBGRAPaletteFormat; overload; - function SuggestPaletteFormat(AFilenameUTF8: string): TBGRAPaletteFormat; virtual; - end; - - { TBGRAIndexedPalette } - - TBGRAIndexedPalette = class(TBGRAPalette) - private - FCurrentIndex: UInt32; - protected - procedure NeedArray; override; - function CreateEntry(AColor: TBGRAPixel): PBGRAPixel; override; - procedure FreeEntry(AEntry: PBGRAPixel); override; - public - function RemoveColor({%H-}AValue: TBGRAPixel): boolean; override; - function IndexOfColor(AValue: TBGRAPixel): integer; override; - procedure Clear; override; - end; - - { TBGRAWeightedPalette } - - TBGRAWeightedPalette = class(TBGRAPalette) - private - protected - function CreateEntry(AColor: TBGRAPixel): PBGRAPixel; override; - procedure FreeEntry(AEntry: PBGRAPixel); override; - function GetWeightByIndex(AIndex: Integer): UInt32; virtual; - procedure IncludePixel(PPixel: PBGRAPixel); override; - public - constructor Create(AColors: ArrayOfWeightedColor); override; - function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; - function IncColor(AValue: TBGRAPixel; out NewWeight: UInt32): boolean; - function DecColor(AValue: TBGRAPixel; out NewWeight: UInt32): boolean; - property Weight[AIndex: Integer]: UInt32 read GetWeightByIndex; - end; - - { TBGRAReferencePalette } - - TBGRAReferencePalette = class(TBGRAAvgLvlPalette) - protected - procedure FreeEntry({%H-}AEntry: PBGRAPixel); override; - public - function AddColor(AValue: PBGRAPixel): boolean; - function RemoveColor(AValue: PBGRAPixel): boolean; - end; - - { TBGRACustomApproxPalette } - - TBGRACustomApproxPalette = class(TBGRACustomPalette) - private - function FindNearestColorIgnoreAlpha(AValue: TBGRAPixel): TBGRAPixel; inline; - function FindNearestColorIndexIgnoreAlpha(AValue: TBGRAPixel): integer; inline; - protected - function GetWeightByIndex({%H-}AIndex: Integer): UInt32; virtual; - public - function FindNearestColor(AValue: TBGRAPixel; AIgnoreAlpha: boolean): TBGRAPixel; overload; - function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; overload; virtual; abstract; - function FindNearestColorIndex(AValue: TBGRAPixel; AIgnoreAlpha: boolean): integer; overload; - function FindNearestColorIndex(AValue: TBGRAPixel): integer; overload; virtual; abstract; - property Weight[AIndex: Integer]: UInt32 read GetWeightByIndex; - end; - - { TBGRA16BitPalette } - - TBGRA16BitPalette = class(TBGRACustomApproxPalette) - protected - function GetCount: integer; override; - function GetColorByIndex(AIndex: integer): TBGRAPixel; override; - public - function ContainsColor(AValue: TBGRAPixel): boolean; override; - function IndexOfColor(AValue: TBGRAPixel): integer; override; - function GetAsArrayOfColor: ArrayOfTBGRAPixel; override; - function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override; - function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override; - function FindNearestColorIndex(AValue: TBGRAPixel): integer; override; - end; - - { TBGRACustomColorQuantizer } - - TBGRACustomColorQuantizer = class - protected - function GetDominantColor: TBGRAPixel; virtual; - function GetPalette: TBGRACustomApproxPalette; virtual; abstract; - function GetSourceColor(AIndex: integer): TBGRAPixel; virtual; abstract; - function GetSourceColorCount: Integer; virtual; abstract; - function GetReductionColorCount: integer; virtual; abstract; - procedure SetReductionColorCount(AValue: Integer); virtual; abstract; - public - constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); overload; virtual; abstract; - constructor Create(AColors: array of TBGRAPixel; ASeparateAlphaChannel: boolean); overload; - constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload; virtual; abstract; - constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); overload; virtual; abstract; - constructor Create(AColors: array of TBGRAPixel; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); overload; - constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); overload; virtual; abstract; - procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect); overload; virtual; abstract; - procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap); overload; - function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload; virtual; abstract; - function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap; overload; - procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string); overload; - procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string; AFormat: TBGRAImageFormat); overload; - procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat); virtual; abstract; - function GetDitheredBitmapIndexedData(ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; overload; - function GetDitheredBitmapIndexedData(ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): Pointer; overload; - function GetDitheredBitmapIndexedData(ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; - ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; overload; virtual; abstract; - property SourceColorCount: Integer read GetSourceColorCount; - property SourceColor[AIndex: integer]: TBGRAPixel read GetSourceColor; - property ReductionColorCount: Integer read GetReductionColorCount write SetReductionColorCount; - property ReducedPalette: TBGRACustomApproxPalette read GetPalette; - property DominantColor: TBGRAPixel read GetDominantColor; - end; - - TBGRAColorQuantizerAny = class of TBGRACustomColorQuantizer; - -var - BGRAColorQuantizerFactory: TBGRAColorQuantizerAny; - -function BGRARequiredBitDepth(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption): integer; overload; -function BGRARequiredBitDepth(APalette: TBGRACustomPalette): integer; overload; - -type - TPaletteReaderProc = function(APalette: TBGRAPalette; AStream: TStream): boolean; - TPaletteWriterProc = procedure(APalette: TBGRAPalette; AStream: TStream); - TCheckPaletteFormatProc = function(ABuf256: string): boolean; - -procedure BGRARegisterPaletteFormat(AFormatIndex: TBGRAPaletteFormat; AExtension: string; ADescription: string; - AReadProc: TPaletteReaderProc; AWriteProc: TPaletteWriterProc; ACheckFormatProc: TCheckPaletteFormatProc); -function BGRARegisteredPaletteFormatFilter(AAllSupportedDescription: string) : string; - -procedure ArrayOfWeightedColor_QuickSort(AColors: ArrayOfWeightedColor; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); - -procedure ArrayOfWeightedColor_InsertionSort(AColors: ArrayOfWeightedColor; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); - -procedure ArrayOfTBGRAPixel_QuickSort(AColors: ArrayOfTBGRAPixel; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); - -procedure ArrayOfTBGRAPixel_InsertionSort(AColors: ArrayOfTBGRAPixel; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); - -implementation - -uses BGRAUTF8, bufstream; - -function IsDWordGreater(p1, p2: PBGRAPixel): boolean; -begin - result := LongWord(p1^) > LongWord(p2^); -end; - -const - InsertionSortLimit = 10; - -procedure ArrayOfWeightedColor_InsertionSort(AColors: ArrayOfWeightedColor; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); -var i,j,insertPos: Int32or64; - compared: TBGRAWeightedPaletteEntry; -begin - if AComparer = nil then AComparer := @IsDWordGreater; - for i := AMinIndex+1 to AMaxIndex do - begin - insertPos := i; - compared := AColors[i]; - while (insertPos > AMinIndex) and AComparer(@AColors[insertPos-1].Color,@compared.Color) do - dec(insertPos); - if insertPos <> i then - begin - for j := i downto insertPos+1 do - AColors[j] := AColors[j-1]; - AColors[insertPos] := compared; - end; - end; -end; - -procedure ArrayOfWeightedColor_QuickSort(AColors: ArrayOfWeightedColor; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); -var Pivot: TBGRAPixel; - CurMin,CurMax,i : Int32or64; - - procedure Swap(a,b: Int32or64); - var Temp: TBGRAWeightedPaletteEntry; - begin - if a = b then exit; - Temp := AColors[a]; - AColors[a] := AColors[b]; - AColors[b] := Temp; - end; -begin - if AComparer = nil then AComparer := @IsDWordGreater; - if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then - begin - ArrayOfWeightedColor_InsertionSort(AColors,AMinIndex,AMaxIndex,AComparer); - exit; - end; - Pivot := AColors[(AMinIndex+AMaxIndex) shr 1].Color; - CurMin := AMinIndex; - CurMax := AMaxIndex; - i := CurMin; - while i < CurMax do - begin - if AComparer(@AColors[i].Color, @Pivot) then - begin - Swap(i, CurMax); - dec(CurMax); - end else - begin - if AComparer(@Pivot, @AColors[i].Color) then - begin - Swap(i, CurMin); - inc(CurMin); - end; - inc(i); - end; - end; - if AComparer(@Pivot, @AColors[i].Color) then - begin - Swap(i, CurMin); - inc(CurMin); - end; - if CurMin > AMinIndex then ArrayOfWeightedColor_QuickSort(AColors,AMinIndex,CurMin,AComparer); - if CurMax < AMaxIndex then ArrayOfWeightedColor_QuickSort(AColors,CurMax,AMaxIndex,AComparer); -end; - -procedure ArrayOfTBGRAPixel_InsertionSort(AColors: ArrayOfTBGRAPixel; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); -var i,j,insertPos: Int32or64; - compared: TBGRAPixel; -begin - if AComparer = nil then AComparer := @IsDWordGreater; - for i := AMinIndex+1 to AMaxIndex do - begin - insertPos := i; - compared := AColors[i]; - while (insertPos > AMinIndex) and AComparer(@AColors[insertPos-1],@compared) do - dec(insertPos); - if insertPos <> i then - begin - for j := i downto insertPos+1 do - AColors[j] := AColors[j-1]; - AColors[insertPos] := compared; - end; - end; -end; - -procedure ArrayOfTBGRAPixel_QuickSort(AColors: ArrayOfTBGRAPixel; AMinIndex, - AMaxIndex: Int32or64; AComparer: TBGRAPixelComparer = nil); -var Pivot: TBGRAPixel; - CurMin,CurMax,i : Int32or64; - - procedure Swap(a,b: Int32or64); - var Temp: TBGRAPixel; - begin - if a = b then exit; - Temp := AColors[a]; - AColors[a] := AColors[b]; - AColors[b] := Temp; - end; -begin - if AComparer = nil then AComparer := @IsDWordGreater; - if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then - begin - ArrayOfTBGRAPixel_InsertionSort(AColors,AMinIndex,AMaxIndex,AComparer); - exit; - end; - Pivot := AColors[(AMinIndex+AMaxIndex) shr 1]; - CurMin := AMinIndex; - CurMax := AMaxIndex; - i := CurMin; - while i < CurMax do - begin - if AComparer(@AColors[i], @Pivot) then - begin - Swap(i, CurMax); - dec(CurMax); - end else - begin - if AComparer(@Pivot, @AColors[i]) then - begin - Swap(i, CurMin); - inc(CurMin); - end; - inc(i); - end; - end; - if AComparer(@Pivot, @AColors[i]) then - begin - Swap(i, CurMin); - inc(CurMin); - end; - if CurMin > AMinIndex then ArrayOfTBGRAPixel_QuickSort(AColors,AMinIndex,CurMin,AComparer); - if CurMax < AMaxIndex then ArrayOfTBGRAPixel_QuickSort(AColors,CurMax,AMaxIndex,AComparer); -end; - -{$i paletteformats.inc} - -function BGRARequiredBitDepth(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption): integer; -var - palette: TBGRAPalette; - p: PBGRAPixel; - i: Int32or64; - transparentEntry: boolean; -begin - palette := TBGRAPalette.Create; - p := ABitmap.Data; - transparentEntry := false; - if AAlpha = acIgnore then - begin - for i := ABitmap.NbPixels-1 downto 0 do - begin - palette.AddColor(BGRA(p^.red,p^.green,p^.blue)); - inc(p); - if palette.Count > 256 then break; - end; - end else - if AAlpha = acTransparentEntry then - begin - for i := ABitmap.NbPixels-1 downto 0 do - begin - if p^.alpha < 128 then - transparentEntry:= true - else - palette.AddColor(BGRA(p^.red,p^.green,p^.blue)); - inc(p); - if palette.Count > 256 then break; - end; - end else - begin - for i := ABitmap.NbPixels-1 downto 0 do - begin - palette.AddColor(p^); - inc(p); - if palette.Count > 256 then break; - end; - end; - - if palette.Count+byte(transparentEntry) > 256 then - begin - if (AAlpha = acFullChannelInPalette) and ABitmap.HasTransparentPixels then - result := 32 - else - if (AAlpha = acTransparentEntry) and ABitmap.HasTransparentPixels then - result := 25 - else - result := 24; - end else - begin - result := 8; - while (result > 0) and (1 shl (result shr 1) >= palette.Count) do result := result shr 1; - end; - palette.Free; -end; - -function BGRARequiredBitDepth(APalette: TBGRACustomPalette): integer; -var i: integer; - hasTransp: boolean; -begin - if APalette.Count > 256 then - begin - hasTransp := false; - for i := 0 to APalette.Count-1 do - if APalette.Color[i].alpha <> 255 then - begin - hasTransp:= true; - break; - end; - if hasTransp then - result := 32 - else - result := 24; - end else - begin - result := 8; - while (result > 0) and (1 shl (result shr 1) >= APalette.Count) do result := result shr 1; - end; -end; - -{ TBGRA16BitPalette } - -function TBGRA16BitPalette.GetCount: integer; -begin - result := 65537; -end; - -function TBGRA16BitPalette.GetColorByIndex(AIndex: integer): TBGRAPixel; -begin - if (AIndex >= 65536) or (AIndex < 0) then - result := BGRAPixelTransparent - else - result := Color16BitToBGRA(AIndex); -end; - -function TBGRA16BitPalette.ContainsColor(AValue: TBGRAPixel): boolean; -begin - if AValue.alpha = 0 then - result := true - else - result := (AValue.alpha = 255) and (FindNearestColor(AValue)=AValue); -end; - -function TBGRA16BitPalette.IndexOfColor(AValue: TBGRAPixel): integer; -var idx: integer; -begin - if AValue.Alpha = 0 then - result := 65536 - else - begin - idx := BGRAToColor16Bit(AValue); - if Color16BitToBGRA(idx)=AValue then - result := idx - else - result := -1; - end; -end; - -function TBGRA16BitPalette.GetAsArrayOfColor: ArrayOfTBGRAPixel; -begin - result := nil; - raise exception.Create('Palette too big'); -end; - -function TBGRA16BitPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; -begin - result := nil; - raise exception.Create('Palette too big'); -end; - -function TBGRA16BitPalette.FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; -begin - if AValue.alpha = 0 then result := BGRAPixelTransparent - else - result := GetColorByIndex(BGRAToColor16Bit(AValue)); -end; - -function TBGRA16BitPalette.FindNearestColorIndex(AValue: TBGRAPixel): integer; -begin - result := BGRAToColor16Bit(AValue); -end; - -{ TBGRAIndexedPalette } - -procedure TBGRAIndexedPalette.NeedArray; -var Node: TAVLTreeNode; - n: UInt32; -begin - n := Count; - if UInt32(length(FArray)) <> n then - begin - setLength(FArray,n); - for Node in FTree do - with PBGRAIndexedPaletteEntry(Node.Data)^ do - begin - if Index < n then //index is unsigned so always >= 0 - FArray[Index] := @Color; - end; - end; -end; - -function TBGRAIndexedPalette.CreateEntry(AColor: TBGRAPixel): PBGRAPixel; -begin - result := PBGRAPixel(GetMem(sizeOf(TBGRAIndexedPaletteEntry))); - result^ := AColor; - PBGRAIndexedPaletteEntry(result)^.Index := FCurrentIndex; - Inc(FCurrentIndex); -end; - -procedure TBGRAIndexedPalette.FreeEntry(AEntry: PBGRAPixel); -begin - FreeMem(AEntry); -end; - -function TBGRAIndexedPalette.RemoveColor(AValue: TBGRAPixel): boolean; -begin - Result:= false; - raise exception.Create('It is not possible to remove a color from an indexed palette'); -end; - -function TBGRAIndexedPalette.IndexOfColor(AValue: TBGRAPixel): integer; -Var Node: TAVLTreeNode; -begin - Node := FTree.Find(@AValue); - if Assigned(Node) then - result := PBGRAIndexedPaletteEntry(Node.Data)^.Index - else - result := -1; -end; - -procedure TBGRAIndexedPalette.Clear; -begin - inherited Clear; - FCurrentIndex := 0; -end; - -{ TBGRACustomColorQuantizer } - -function TBGRACustomColorQuantizer.GetDominantColor: TBGRAPixel; -begin - result := ReducedPalette.DominantColor; -end; - -constructor TBGRACustomColorQuantizer.Create(AColors: array of TBGRAPixel; - ASeparateAlphaChannel: boolean); -var palette: TBGRAPalette; - i: Integer; -begin - palette := TBGRAPalette.Create; - for i := 0 to high(AColors) do - palette.AddColor(AColors[i]); - Create(palette, ASeparateAlphaChannel); - palette.Free; -end; - -constructor TBGRACustomColorQuantizer.Create(AColors: array of TBGRAPixel; - ASeparateAlphaChannel: boolean; AReductionColorCount: integer); -var palette: TBGRAPalette; - i: Integer; -begin - palette := TBGRAPalette.Create; - for i := 0 to high(AColors) do - palette.AddColor(AColors[i]); - Create(palette, ASeparateAlphaChannel, AReductionColorCount); - palette.Free; -end; - -procedure TBGRACustomColorQuantizer.ApplyDitheringInplace( - AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap); -begin - ApplyDitheringInplace(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height)); -end; - -function TBGRACustomColorQuantizer.GetDitheredBitmap( - AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap - ): TBGRACustomBitmap; -begin - result := GetDitheredBitmap(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height)); -end; - -procedure TBGRACustomColorQuantizer.SaveBitmapToFile( - AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; - AFilenameUTF8: string); -begin - SaveBitmapToFile(AAlgorithm, ABitmap, AFilenameUTF8, SuggestImageFormat(AFilenameUTF8)); -end; - -procedure TBGRACustomColorQuantizer.SaveBitmapToFile( - AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; - AFilenameUTF8: string; AFormat: TBGRAImageFormat); -var - stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate); - try - SaveBitmapToStream(AAlgorithm, ABitmap, stream, AFormat); - finally - stream.Free; - end; -end; - -function TBGRACustomColorQuantizer.GetDitheredBitmapIndexedData( - ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; - out AScanlineSize: PtrInt): Pointer; -begin - result := GetDitheredBitmapIndexedData(ABitDepth, - {$IFDEF ENDIAN_LITTLE}riboLSBFirst{$ELSE}riboMSBFirst{$endif}, - AAlgorithm, ABitmap, AScanlineSize); -end; - -function TBGRACustomColorQuantizer.GetDitheredBitmapIndexedData( - ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; - ABitmap: TBGRACustomBitmap): Pointer; -var dummy: PtrInt; -begin - result := GetDitheredBitmapIndexedData(ABitDepth, AAlgorithm, ABitmap, dummy); -end; - -{ TBGRACustomPalette } - -function TBGRACustomPalette.GetDominantColor: TBGRAPixel; -var - w: ArrayOfWeightedColor; - i: Integer; - maxWeight, totalWeight: UInt32; -begin - result := BGRAWhite; - maxWeight := 0; - w := GetAsArrayOfWeightedColor; - totalWeight:= 0; - for i := 0 to high(w) do - inc(totalWeight, w[i].Weight); - for i := 0 to high(w) do - if (w[i].Weight > maxWeight) and (BGRAToGSBA(w[i].Color).saturation > 16000) then - begin - maxWeight:= w[i].Weight; - result := w[i].Color; - end; - if maxWeight > totalWeight div 20 then exit; - for i := 0 to high(w) do - if (w[i].Weight > maxWeight) and (BGRAToGSBA(w[i].Color).lightness < 56000) and (BGRAToGSBA(w[i].Color).lightness > 16000) then - begin - maxWeight:= w[i].Weight; - result := w[i].Color; - end; - if maxWeight > 0 then exit; - for i := 0 to high(w) do - if (w[i].Weight > maxWeight) then - begin - maxWeight:= w[i].Weight; - result := w[i].Color; - end; -end; - -procedure TBGRACustomPalette.AssignTo(AImage: TFPCustomImage); -begin - AImage.UsePalette := true; - AssignTo(AImage.Palette); -end; - -procedure TBGRACustomPalette.AssignTo(APalette: TFPPalette); -var i: integer; -begin - APalette.Clear; - APalette.Capacity := Count; - for i := 0 to Count-1 do - APalette.Color[i] := BGRAToFPColor(Color[i]); -end; - -{ TBGRACustomApproxPalette } - -function TBGRACustomApproxPalette.FindNearestColorIgnoreAlpha(AValue: TBGRAPixel): TBGRAPixel; -var saveAlpha: byte; -begin - if AValue.alpha = 0 then - result := BGRAPixelTransparent - else - begin - saveAlpha := AValue.alpha; - AValue.alpha := 255; - result := FindNearestColor(AValue); - result.alpha := saveAlpha; - end; -end; - -function TBGRACustomApproxPalette.FindNearestColorIndexIgnoreAlpha( - AValue: TBGRAPixel): integer; -begin - if AValue.alpha = 0 then - result := -1 - else - begin - AValue.alpha := 255; - result := FindNearestColorIndex(AValue); - end; -end; - -function TBGRACustomApproxPalette.GetWeightByIndex(AIndex: Integer): UInt32; -begin - result := 1; -end; - -function TBGRACustomApproxPalette.FindNearestColor(AValue: TBGRAPixel; AIgnoreAlpha: boolean): TBGRAPixel; -begin - if AIgnoreAlpha then - result := FindNearestColorIgnoreAlpha(AValue) - else - result := FindNearestColor(AValue); -end; - -function TBGRACustomApproxPalette.FindNearestColorIndex(AValue: TBGRAPixel; - AIgnoreAlpha: boolean): integer; -begin - if AIgnoreAlpha then - result := FindNearestColorIndexIgnoreAlpha(AValue) - else - result := FindNearestColorIndex(AValue); -end; - -{ TBGRAWeightedPalette } - -function TBGRAWeightedPalette.GetWeightByIndex(AIndex: Integer): UInt32; -begin - NeedArray; - if (AIndex >= 0) and (AIndex < length(FArray)) then - result := PBGRAWeightedPaletteEntry(FArray[AIndex])^.Weight - else - raise ERangeError.Create('Index out of bounds'); -end; - -procedure TBGRAWeightedPalette.IncludePixel(PPixel: PBGRAPixel); -var dummy: UInt32; -begin - IncColor(PPixel^,dummy); -end; - -constructor TBGRAWeightedPalette.Create(AColors: ArrayOfWeightedColor); -var - i: Integer; -begin - inherited Create; - for i := 0 to high(AColors) do - with AColors[i] do IncColor(Color,Weight); -end; - -function TBGRAWeightedPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; -var - i: Int32or64; -begin - NeedArray; - setlength(result, length(FArray)); - for i := 0 to high(result) do - result[i] := PBGRAWeightedPaletteEntry(FArray[i])^; -end; - -function TBGRAWeightedPalette.CreateEntry(AColor: TBGRAPixel): PBGRAPixel; -begin - result := PBGRAPixel(GetMem(sizeOf(TBGRAWeightedPaletteEntry))); - result^ := AColor; - PBGRAWeightedPaletteEntry(result)^.Weight := 1; -end; - -procedure TBGRAWeightedPalette.FreeEntry(AEntry: PBGRAPixel); -begin - FreeMem(AEntry); -end; - -function TBGRAWeightedPalette.IncColor(AValue: TBGRAPixel; out NewWeight: UInt32 - ): boolean; -Var Node: TAVLTreeNode; - Entry: PBGRAPixel; -begin - Entry := GetLastColor(AValue); - if Entry <> nil then - begin - NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight+1; - PBGRAWeightedPaletteEntry(Entry)^.Weight := NewWeight; - result := false; - exit; - end; - Node := FTree.Find(@AValue); - if Assigned(Node) then - begin - Entry := PBGRAPixel(Node.Data); - NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight+1; - PBGRAWeightedPaletteEntry(Entry)^.Weight := NewWeight; - AddLastColor(Entry); - result := false; - end - else - begin - Entry := CreateEntry(AValue); - FTree.Add(Entry); - ClearArray; - NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight; - AddLastColor(Entry); - result := true; - end; -end; - -function TBGRAWeightedPalette.DecColor(AValue: TBGRAPixel; out NewWeight: UInt32 - ): boolean; -var - Node : TAVLTreeNode; - Entry: PBGRAPixel; -begin - Node := FTree.Find(@AValue); - if Assigned(Node) then - begin - Entry := PBGRAPixel(Node.Data); - NewWeight := PBGRAWeightedPaletteEntry(Entry)^.Weight; - if NewWeight >= 2 then - begin - dec(NewWeight); - PBGRAWeightedPaletteEntry(Entry)^.Weight := NewWeight; - end - else - begin - NewWeight := 0; - FreeEntry(Entry); - FTree.Delete(Node); - ClearArray; - ClearLastColors; - end; - result := true; - end else - begin - result := false; - NewWeight := 0; - end; -end; - -{ TBGRAReferencePalette } - -procedure TBGRAReferencePalette.FreeEntry(AEntry: PBGRAPixel); -begin - //nothing -end; - -function TBGRAReferencePalette.AddColor(AValue: PBGRAPixel): boolean; -begin - if Assigned(GetLastColor(AValue^)) then - begin - result := false; - exit; - end; - AddLastColor(AValue); - if Assigned(FTree.Find(AValue)) then - begin - result := false; - end - else - begin - result := true; - FTree.Add(AValue); - ClearArray; - end; -end; - -function TBGRAReferencePalette.RemoveColor(AValue: PBGRAPixel): boolean; -var - Node : TAVLTreeNode; -begin - Node := FTree.Find(AValue); - if Assigned(Node) then - begin - FTree.Delete(Node); - result := true; - ClearArray; - ClearLastColors; - end else - result := false; -end; - -function PaletteOnCompareItems(Data1, Data2: Pointer): integer; -var gray1, gray2: UInt32or64; - c1, c2: TBGRAPixel; -begin - c1 := PBGRAPixel(Data1)^; - c2 := PBGRAPixel(Data2)^; - if c1.alpha < c2.alpha then - result := -1 - else if c1.alpha > c2.alpha then - result := 1 - else - begin - gray1 := (GammaExpansionTab[c1.red] shl 8)+(GammaExpansionTab[c1.green] shl 9)+(GammaExpansionTab[c1.blue] shl 7); - gray2 := (GammaExpansionTab[c2.red] shl 8)+(GammaExpansionTab[c2.green] shl 9)+(GammaExpansionTab[c2.blue] shl 7); - if gray1gray2 then - result := 1 - else - begin - if c1.green > c2.green then - result := 1 - else if c1.green < c2.green then - result := -1 - else if c1.red > c2.red then - result := 1 - else if c1.red < c2.red then - result := -1 - else if c1.blue > c2.blue then - result := 1 - else if c1.blue < c2.blue then - result := -1 - else - result := 0; - end; - end; -end; - -{ TBGRAAvgLvlPalette } - -constructor TBGRAAvgLvlPalette.Create; -begin - FTree := TAVLTree.Create; - FTree.OnCompare := @PaletteOnCompareItems; -end; - -destructor TBGRAAvgLvlPalette.Destroy; -begin - Clear; - FreeAndNil(FTree); - inherited Destroy; -end; - -function TBGRAAvgLvlPalette.GetAsArrayOfColor: ArrayOfTBGRAPixel; -var i: Int32or64; -begin - NeedArray; - setlength(result, Length(FArray)); - for i := 0 to high(result) do - result[i] := FArray[i]^; -end; - -function TBGRAAvgLvlPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor; -var i: Int32or64; -begin - NeedArray; - setlength(result, Length(FArray)); - for i := 0 to high(result) do - with result[i] do - begin - Color := FArray[i]^; - Weight:= 1; - end; -end; - -procedure TBGRAAvgLvlPalette.Clear; -var Node: TAVLTreeNode; -begin - For Node in FTree do - FreeEntry(PBGRAPixel(Node.Data)); - FTree.Clear; - ClearArray; - FLastAddedColorCount := 0; -end; - -function TBGRAAvgLvlPalette.GetCount: integer; -begin - result := FTree.Count; -end; - -function TBGRAAvgLvlPalette.ContainsColor(AValue: TBGRAPixel): boolean; -Var Node: TAVLTreeNode; -begin - if Assigned(GetLastColor(AValue)) then - begin - result := true; - exit; - end; - Node := FTree.Find(@AValue); - result := Assigned(Node); - if result then AddLastColor(PBGRAPixel(Node.Data)); -end; - -function TBGRAAvgLvlPalette.IndexOfColor(AValue: TBGRAPixel): integer; -Var Node: TAVLTreeNode; -begin - Node := FTree.Find(@AValue); - if Assigned(Node) then - begin - result := 0; - Node := Node.Left; - while Assigned(Node) do - begin - inc(result); - Node := Node.Left; - end; - end else - result := -1; -end; - -function TBGRAAvgLvlPalette.GetColorByIndex(AIndex: integer): TBGRAPixel; -begin - NeedArray; - if (AIndex >= 0) and (AIndex < length(FArray)) then - result := FArray[AIndex]^ - else - raise ERangeError.Create('Index out of bounds'); -end; - -procedure TBGRAAvgLvlPalette.NeedArray; -var Node: TAVLTreeNode; - i,n: integer; -begin - n := Count; - if length(FArray) <> n then - begin - setLength(FArray,n); - i := 0; - for Node in FTree do - begin - if i >= n then break; - FArray[i] := PBGRAPixel(Node.Data); - inc(i); - end; - end; -end; - -procedure TBGRAAvgLvlPalette.ClearArray; -begin - FArray := nil; -end; - -procedure TBGRAAvgLvlPalette.AddLastColor(AColor: PBGRAPixel); -begin - if FLastAddedColorCount < MaxLastAddedColors then - begin - FLastAddedColors[FLastAddedColorCount] := AColor; - inc(FLastAddedColorCount); - end else - begin - move(FLastAddedColors[1],FLastAddedColors[0],(FLastAddedColorCount-1)*sizeof(PBGRAPixel)); - FLastAddedColors[FLastAddedColorCount-1] := AColor; - end; -end; - -function TBGRAAvgLvlPalette.GetLastColor(AValue: TBGRAPixel): PBGRAPixel; -var - i: Int32or64; -begin - for i := FLastAddedColorCount-1 downto 0 do - if PLongWord(FLastAddedColors[i])^ = LongWord(AValue) then - begin - result := FLastAddedColors[i]; - exit; - end; - result := nil; -end; - -procedure TBGRAAvgLvlPalette.ClearLastColors; -begin - FLastAddedColorCount := 0; -end; - -{ TBGRAPalette } - -function TBGRAPalette.CreateEntry(AColor: TBGRAPixel): PBGRAPixel; -begin - result := PBGRAPixel(GetMem(sizeOf(TBGRAPixel))); - result^ := AColor; -end; - -procedure TBGRAPalette.FreeEntry(AEntry: PBGRAPixel); -begin - FreeMem(AEntry); -end; - -procedure TBGRAPalette.IncludePixel(PPixel: PBGRAPixel); -begin - AddColor(PPixel^); -end; - -procedure TBGRAPalette.ExceptionUnknownPaletteFormat; -begin - raise Exception.Create('Unknown palette format'); -end; - -procedure TBGRAPalette.ExceptionInvalidPaletteFormat; -begin - raise Exception.Create('Invalid palette format'); -end; - -constructor TBGRAPalette.Create(ABitmap: TBGRACustomBitmap); -var p: PBGRAPixel; - n: integer; -begin - inherited Create; - n:= ABitmap.NbPixels; - p := ABitmap.Data; - while n > 0 do - begin - IncludePixel(p); - inc(p); - dec(n); - end; -end; - -constructor TBGRAPalette.Create(APalette: TBGRACustomPalette); -begin - inherited Create; - AddColors(APalette); -end; - -constructor TBGRAPalette.Create(AColors: ArrayOfTBGRAPixel); -var - i: Integer; -begin - inherited Create; - for i := 0 to high(AColors) do - AddColor(AColors[i]); -end; - -constructor TBGRAPalette.Create(AColors: ArrayOfWeightedColor); -var - i: Integer; -begin - inherited Create; - for i := 0 to high(AColors) do - AddColor(AColors[i].Color); -end; - -function TBGRAPalette.AddColor(AValue: TBGRAPixel): boolean; -Var Node: TAVLTreeNode; - Entry: PBGRAPixel; -begin - if Assigned(GetLastColor(AValue)) then - begin - result := false; - exit; - end; - Node := FTree.Find(@AValue); - if Assigned(Node) then - begin - AddLastColor(PBGRAPixel(Node.Data)); - result := false; - end - else - begin - result := true; - Entry := CreateEntry(AValue); - FTree.Add(Entry); - ClearArray; - AddLastColor(Entry); - end; -end; - -procedure TBGRAPalette.AddColors(ABitmap: TBGRACustomBitmap); -var p: PBGRAPixel; - n: integer; -begin - n := ABitmap.NbPixels; - p := ABitmap.Data; - while n > 0 do - begin - AddColor(p^); - inc(p); - dec(n); - end; -end; - -procedure TBGRAPalette.AddColors(APalette: TBGRACustomPalette); -var i: Int32or64; -begin - for i := 0 to APalette.Count- 1 do - AddColor(APalette.Color[i]); -end; - -function TBGRAPalette.RemoveColor(AValue: TBGRAPixel): boolean; -var - Node : TAVLTreeNode; -begin - Node := FTree.Find(@AValue); - if Assigned(Node) then - begin - FreeEntry(Node.Data); - FTree.Delete(Node); - result := true; - ClearArray; - ClearLastColors; - end else - result := false; -end; - -procedure TBGRAPalette.LoadFromFile(AFilenameUTF8: string); -var - stream: TFileStreamUTF8; - format: TBGRAPaletteFormat; -begin - format := DetectPaletteFormat(AFilenameUTF8); - if format = palUnknown then - begin - ExceptionUnknownPaletteFormat; - exit; - end; - stream:= TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead); - try - LoadFromStream(stream, format); - finally - stream.Free; - end; -end; - -procedure TBGRAPalette.LoadFromStream(AStream: TStream; - AFormat: TBGRAPaletteFormat); -var buf: TReadBufStream; - handled: boolean; - i: Integer; -begin - RegisterDefaultPaletteFormats; - Clear; - buf := TReadBufStream.Create(AStream); - try - handled := false; - for i := 0 to High(PaletteFormats) do - if PaletteFormats[i].formatIndex = AFormat then - begin - if not PaletteFormats[i].reader(self, AStream) then - ExceptionInvalidPaletteFormat; - handled := true; - break; - end; - if not handled then ExceptionUnknownPaletteFormat; - finally - buf.Free; - end; -end; - -procedure TBGRAPalette.LoadFromResource(AFilename: string; AFormat: TBGRAPaletteFormat); -var - stream: TStream; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - LoadFromStream(stream, AFormat); - finally - stream.Free; - end; -end; - -procedure TBGRAPalette.SaveToFile(AFilenameUTF8: string); -var - stream: TFileStreamUTF8; -begin - stream:= TFileStreamUTF8.Create(AFilenameUTF8,fmCreate); - try - SaveToStream(stream, SuggestPaletteFormat(AFilenameUTF8)); - finally - stream.Free; - end; -end; - -procedure TBGRAPalette.SaveToStream(AStream: TStream; - AFormat: TBGRAPaletteFormat); -var buf: TWriteBufStream; - handled: boolean; - i: Integer; -begin - RegisterDefaultPaletteFormats; - buf := TWriteBufStream.Create(AStream); - try - handled := false; - for i := 0 to High(PaletteFormats) do - if PaletteFormats[i].formatIndex = AFormat then - begin - PaletteFormats[i].writer(self, AStream); - handled := true; - break; - end; - if not handled then ExceptionUnknownPaletteFormat; - finally - buf.Free; - end; -end; - -function TBGRAPalette.DetectPaletteFormat(AStream: TStream): TBGRAPaletteFormat; -var buf: string; - oldPos: int64; - i: Integer; -begin - result := palUnknown; - setlength(buf,256); - fillchar(buf[1],length(buf),#0); - oldPos := AStream.Position; - AStream.Read(buf[1],length(buf)); - AStream.Position := oldPos; - if length(buf)>0 then - begin - RegisterDefaultPaletteFormats; - for i := 0 to high(PaletteFormats) do - if PaletteFormats[i].checkFormat(buf) then - begin - result := PaletteFormats[i].formatIndex; - exit; - end; - end; -end; - -function TBGRAPalette.DetectPaletteFormat(AFilenameUTF8: string - ): TBGRAPaletteFormat; -var stream: TFileStreamUTF8; -begin - result := SuggestPaletteFormat(AFilenameUTF8); - if not FileExists(AFilenameUTF8) then exit; - try - stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); - except - exit; - end; - try - result := DetectPaletteFormat(stream); - if result = palUnknown then - result := SuggestPaletteFormat(AFilenameUTF8); - finally - stream.Free; - end; -end; - -function TBGRAPalette.SuggestPaletteFormat(AFilenameUTF8: string - ): TBGRAPaletteFormat; -var ext: string; - i: Integer; -begin - RegisterDefaultPaletteFormats; - ext := ExtractFileExt(AFilenameUTF8); - if ext <> '' then - begin - for i := 0 to high(PaletteFormats) do - if CompareText(PaletteFormats[i].ext,ext) = 0 then - begin - result := PaletteFormats[i].formatIndex; - exit; - end; - end; - result := palUnknown; -end; - -end. - diff --git a/components/bgrabitmap/bgrapath.pas b/components/bgrabitmap/bgrapath.pas deleted file mode 100644 index 07bd687..0000000 --- a/components/bgrabitmap/bgrapath.pas +++ /dev/null @@ -1,3118 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAPath; - -{$mode objfpc}{$H+} - -interface - -//todo: tangent interpolation - -{ There are different conventions for angles. - - First is about the unit. It can be one of the following: - - degrees (0..360) - - radian (0..2*Pi) - - tenth of degrees (0..3600) - - from 0 to 65536 - - Second is about the origin. It can be one of the following: - - right-most position (this is the default origin for radian and 65536) - - top-most position (this is the default origin for degrees) - - Third is about the sign. It can be one of the following: - - positive is clockwise (this is the default for degrees) - - positive is counterclockwise (this is the default for radian and 65536) - - TBGRAPath and TBGRACanvas2D follow HTML5 convention which is: - (radian, right-most, clockwise) that can be shortened to (radian, clockwise) - because right-most is the default for radian. This is abbreviated as "radCW". - - When radian are CCW, it is also specified in order to make it clear, even - if it is the default convention in mathematics. - - In order to make things easier, there are some functions that accept angles - in degrees. The convention used here is the usual degree convention: - (degrees, top-most, clockwise) that can be shortened to (degree) - because top-most and clockwise is the default for degrees. - - } - -uses - BGRABitmapTypes, BGRATransform; - -const - DefaultDeviation = 0.1; - -type - TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath, - peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, - peClosedSpline); - - TBGRAPathDrawProc = BGRABitmapTypes.TBGRAPathDrawProc; - TBGRAPathFillProc = BGRABitmapTypes.TBGRAPathFillProc; - - TBGRAPath = class; - - { TBGRAPathCursor } - - TBGRAPathCursor = class(TBGRACustomPathCursor) - protected - FPath: TBGRAPath; - FDataPos: IntPtr; - FAcceptedDeviation: single; - FPathLength: single; - FPathLengthComputed: boolean; - FBounds: TRectF; - FBoundsComputed: boolean; - FArcPos: Single; - - FStartCoordinate: TPointF; - FEndCoordinate: TPointF; - FLoopClosedShapes,FLoopPath: boolean; - - FCurrentElementType: TBGRAPathElementType; - FCurrentElement: Pointer; - FCurrentElementArcPos, - FCurrentElementArcPosScale: single; - FCurrentElementStartCoord, - FCurrentElementEndCoord: TPointF; - FCurrentElementLength: single; - FCurrentElementPoints: array of TPointF; - FCurrentSegment: Int32or64; - FCurrentSegmentPos: single; - function GoToNextElement(ACanJump: boolean): boolean; - function GoToPreviousElement(ACanJump: boolean): boolean; - procedure MoveToEndOfElement; - procedure MoveForwardInElement(ADistance: single); - procedure MoveBackwardInElement(ADistance: single); - function NeedPolygonalApprox: boolean; - procedure OnPathFree; virtual; - - function GetLoopClosedShapes: boolean; override; - function GetLoopPath: boolean; override; - function GetStartCoordinate: TPointF; override; - procedure SetLoopClosedShapes(AValue: boolean); override; - procedure SetLoopPath(AValue: boolean); override; - - function GetArcPos: single; override; - function GetCurrentTangent: TPointF; override; - procedure SetArcPos(AValue: single); override; - function GetBounds: TRectF; override; - function GetPathLength: single; override; - procedure PrepareCurrentElement; virtual; - function GetCurrentCoord: TPointF; override; - function GetPath: TBGRAPath; virtual; - public - constructor Create(APath: TBGRAPath; AAcceptedDeviation: single = DefaultDeviation); - function MoveForward(ADistance: single; ACanJump: boolean = true): single; override; - function MoveBackward(ADistance: single; ACanJump: boolean = true): single; override; - destructor Destroy; override; - property CurrentCoordinate: TPointF read GetCurrentCoord; - property CurrentTangent: TPointF read GetCurrentTangent; - property Position: single read GetArcPos write SetArcPos; - property PathLength: single read GetPathLength; - property Path: TBGRAPath read GetPath; - property Bounds: TRectF read GetBounds; - property StartCoordinate: TPointF read GetStartCoordinate; - property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes; - property LoopPath: boolean read GetLoopPath write SetLoopPath; - property AcceptedDeviation: single read FAcceptedDeviation; - end; - - { TBGRAPath } - - TBGRAPath = class(TBGRACustomPath) - protected - FData: PByte; - FDataCapacity: PtrInt; - FDataPos: PtrInt; - FLastSubPathElementType, FLastStoredElementType: TBGRAPathElementType; - FLastMoveToDataPos: PtrInt; - FLastCoord,FLastTransformedCoord, - FSubPathStartCoord, FSubPathTransformedStartCoord: TPointF; - FExpectedTransformedControlPoint: TPointF; - FMatrix: TAffineMatrix; //this matrix must have a base of vectors - //orthogonal, of same length and with positive - //orientation in order to preserve arcs - FScale,FAngleRadCW: single; - FCursors: array of TBGRAPathCursor; - FInternalDrawOffset: TPointF; - procedure OnModify; - procedure OnMatrixChange; - procedure NeedSpace(count: integer); - function AllocateElement(AElementType: TBGRAPathElementType; - AExtraBytes: PtrInt = 0): Pointer; - procedure Init; - procedure DoClear; - function CheckElementType(AElementType: TBGRAPathElementType): boolean; - function GoToNextElement(var APos: PtrInt): boolean; - function GoToPreviousElement(var APos: PtrInt): boolean; - function PeekNextElement(APos: PtrInt): TBGRAPathElementType; - function GetElementStartCoord(APos: PtrInt): TPointF; - function GetElementEndCoord(APos: PtrInt): TPointF; - function GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single; - procedure GetElementAt(APos: PtrInt; - out AElementType: TBGRAPathElementType; out AElement: pointer); - function GetSvgString: string; virtual; - procedure SetSvgString(const AValue: string); virtual; - procedure RegisterCursor(ACursor: TBGRAPathCursor); - procedure UnregisterCursor(ACursor: TBGRAPathCursor); - function SetLastCoord(ACoord: TPointF): TPointF; inline; - procedure ClearLastCoord; - procedure BezierCurveFromTransformed(tcp1, cp2, pt:TPointF); - procedure QuadraticCurveFromTransformed(tcp, pt: TPointF); - function LastCoordDefined: boolean; inline; - function GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF; - function getPoints: ArrayOfTPointF; overload;override; - function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload;override; - function getLength: single; override; - function getCursor: TBGRACustomPathCursor; override; - procedure InternalDraw(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer); - procedure BitmapDrawSubPathProc(const APoints: array of TPointF; AClosed: boolean; AData: pointer); - function CorrectAcceptedDeviation(AAcceptedDeviation: single; const AMatrix: TAffineMatrix): single; - public - constructor Create; overload; override; - constructor Create(ASvgString: string); overload; - constructor Create(const APoints: ArrayOfTPointF); overload; - constructor Create(APath: IBGRAPath); overload; - destructor Destroy; override; - procedure beginPath; override; - procedure beginSubPath; - procedure closePath; override; - procedure translate(x,y: single); - procedure resetTransform; - procedure rotate(angleRadCW: single); overload; - procedure rotateDeg(angleDeg: single); overload; - procedure rotate(angleRadCW: single; center: TPointF); overload; - procedure rotateDeg(angleDeg: single; center: TPointF); overload; - procedure scale(factor: single); - procedure moveTo(x,y: single); overload; - procedure lineTo(x,y: single); overload; - procedure moveTo(constref pt: TPointF); overload; override; - procedure lineTo(constref pt: TPointF); overload; override; - procedure polyline(const pts: array of TPointF); - procedure polylineTo(const pts: array of TPointF); override; - procedure polygon(const pts: array of TPointF); - procedure quadraticCurveTo(cpx,cpy,x,y: single); overload; - procedure quadraticCurveTo(constref cp,pt: TPointF); overload; override; - procedure quadraticCurve(const curve: TQuadraticBezierCurve); overload; - procedure quadraticCurve(p1,cp,p2: TPointF); overload; - procedure smoothQuadraticCurveTo(x,y: single); overload; - procedure smoothQuadraticCurveTo(const pt: TPointF); overload; - procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload; - procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); overload; override; - procedure bezierCurve(const curve: TCubicBezierCurve); overload; - procedure bezierCurve(p1,cp1,cp2,p2: TPointF); overload; - procedure smoothBezierCurveTo(cp2x,cp2y,x,y: single); overload; - procedure smoothBezierCurveTo(const cp2,pt: TPointF); overload; - procedure rect(x,y,w,h: single); - procedure roundRect(x,y,w,h,radius: single); - procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; - procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single); overload; - procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single; anticlockwise: boolean); overload; - procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single); overload; - procedure arcTo(x1, y1, x2, y2, radius: single); overload; - procedure arcTo(const p1,p2: TPointF; radius: single); overload; - procedure arc(constref arcDef: TArcDef); overload; override; - procedure arc(cx, cy, rx,ry: single; xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload; - procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; - procedure arcTo(rx,ry, xAngleRadCW: single; largeArc, anticlockwise: boolean; x,y:single); overload; - procedure copyTo(dest: IBGRAPath); override; - procedure addPath(const AValue: string); overload; - procedure addPath(source: IBGRAPath); overload; - procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); override; - procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); override; - property SvgString: string read GetSvgString write SetSvgString; - function ComputeLength(AAcceptedDeviation: single = DefaultDeviation): single; - function ToPoints(AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; - function ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; - function IsEmpty: boolean; - function GetBounds(AAcceptedDeviation: single = DefaultDeviation): TRectF; - procedure SetPoints(const APoints: ArrayOfTPointF); - procedure stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; override; - procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; override; - procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer = nil); overload; - procedure fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload; - procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; override; - procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; override; - procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer = nil); overload; - function CreateCursor(AAcceptedDeviation: single = DefaultDeviation): TBGRAPathCursor; - procedure Fit(ARect: TRectF; AAcceptedDeviation: single = DefaultDeviation); - procedure FitInto(ADest: TBGRAPath; ARect: TRectF; AAcceptedDeviation: single = DefaultDeviation); - end; - -{----------------------- Spline ------------------} - -function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single; -function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; -function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; -function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; -function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; -function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -function ComputeClosedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AEndCoeff: single = 0.25; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -function ComputeOpenedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AEndCoeff: single = 0.25; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -function ClosedSplineStartPoint(const points: array of TPointF; Style: TSplineStyle): TPointF; -function ComputeEasyBezier(const curve: TEasyBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; - -{ Compute points to draw an antialiased ellipse } -function ComputeEllipse(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; -function ComputeEllipse(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; -function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; overload; -function ComputeArc65536(AOrigin, AXAxis, AYAxis: TPointF; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; overload; -function ComputeArcRad(x, y, rx, ry: single; startRadCCW,endRadCCW: single; quality: single = 1): ArrayOfTPointF; overload; -function ComputeArcRad(AOrigin, AXAxis, AYAxis: TPointF; startRadCCW,endRadCCW: single; quality: single = 1): ArrayOfTPointF; overload; -function ComputeArc(const arc: TArcDef; quality: single = 1): ArrayOfTPointF; -function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; -function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; - -function Html5ArcTo(const p0, p1, p2: TPointF; radius: single): TArcDef; -function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc, - anticlockwise: boolean; const p1: TPointF): TArcDef; -function ArcStartPoint(const arc: TArcDef): TPointF; -function ArcEndPoint(const arc: TArcDef): TPointF; -function IsLargeArc(const arc: TArcDef): boolean; - -implementation - -uses Math, BGRAClasses, BGRAResample, SysUtils; - -type - TStrokeData = record - Bitmap: TBGRACustomBitmap; - Texture: IBGRAScanner; - Color: TBGRAPixel; - Width: Single; - end; - - PPathElementHeader = ^TPathElementHeader; - TPathElementHeader = record - ElementType: TBGRAPathElementType; - PreviousElementType: TBGRAPathElementType; - end; - PMoveToElement = ^TMoveToElement; - TMoveToElement = record - StartCoordinate: TPointF; - LoopDataPos: PtrInt; //if the path is closed - end; - PClosePathElement = ^TClosePathElement; - TClosePathElement = type TMoveToElement; - PQuadraticBezierToElement = ^TQuadraticBezierToElement; - TQuadraticBezierToElement = record - ControlPoint, Destination: TPointF; - end; - PCubicBezierToElement = ^TCubicBezierToElement; - TCubicBezierToElement = record - ControlPoint1, ControlPoint2, Destination: TPointF; - end; - PArcElement = ^TArcElement; - TArcElement = TArcDef; - - PSplineElement = ^TSplineElement; - TSplineElement = record - SplineStyle: TSplineStyle; - NbControlPoints: integer; - end; - -const - PathElementSize : array[TBGRAPathElementType] of PtrInt = - (0, Sizeof(TMoveToElement), Sizeof(TClosePathElement), sizeof(TPointF), - sizeof(TQuadraticBezierToElement), sizeof(TCubicBezierToElement), - sizeof(TArcElement), sizeof(TSplineElement)+sizeof(integer), - sizeof(TSplineElement)+sizeof(integer)); - -function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single; -var - a0, a1, a2, a3: single; - t2: single; -begin - t2 := t * t; - a0 := y3 - y2 - y0 + y1; - a1 := y0 - y1 - a0; - a2 := y2 - y0; - a3 := y1; - Result := a0 * t * t2 + a1 * t2 + a2 * t + a3; -end; - -function ComputeCurvePartPrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = DefaultDeviation): integer; -var - len: single; -begin - len := sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y); - len := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)); - len := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)); - Result := round(sqrt(sqrt(len)/AAcceptedDeviation) * 0.9); - if Result<=0 then Result:=1; -end; - -function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; -begin - result := curve.ToPoints(AAcceptedDeviation); -end; - -function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload; -begin - result := curve.ToPoints(AAcceptedDeviation); -end; - -function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -var - curves: array of array of TPointF; - nb: integer; - lastPt: TPointF; - i: Integer; - j: Integer; - - procedure AddPt(pt: TPointF); inline; - begin - result[nb]:= pt; - inc(nb); - lastPt := pt; - end; - - function EqLast(pt: TPointF): boolean; - begin - result := (pt.x = lastPt.x) and (pt.y = lastPt.y); - end; - -begin - if length(spline)= 0 then - begin - setlength(result,0); - exit; - end; - setlength(curves, length(spline)); - for i := 0 to high(spline) do - curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation); - nb := length(curves[0]); - lastPt := curves[0][high(curves[0])]; - for i := 1 to high(curves) do - begin - inc(nb,length(curves[i])); - if EqLast(curves[i][0]) then dec(nb); - lastPt := curves[i][high(curves[i])]; - end; - setlength(result,nb); - nb := 0; - for j := 0 to high(curves[0]) do - AddPt(curves[0][j]); - for i := 1 to high(curves) do - begin - if not EqLast(curves[i][0]) then AddPt(curves[i][0]); - for j := 1 to high(curves[i]) do - AddPt(curves[i][j]); - end; -end; - -function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve; - AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -var - curves: array of array of TPointF; - nb: integer; - lastPt: TPointF; - i: Integer; - j: Integer; - - procedure AddPt(pt: TPointF); inline; - begin - result[nb]:= pt; - inc(nb); - lastPt := pt; - end; - - function EqLast(pt: TPointF): boolean; - begin - result := (pt.x = lastPt.x) and (pt.y = lastPt.y); - end; - -begin - if length(spline)= 0 then - begin - setlength(result,0); - exit; - end; - setlength(curves, length(spline)); - for i := 0 to high(spline) do - curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation); - nb := length(curves[0]); - lastPt := curves[0][high(curves[0])]; - for i := 1 to high(curves) do - begin - inc(nb,length(curves[i])); - if EqLast(curves[i][0]) then dec(nb); - lastPt := curves[i][high(curves[i])]; - end; - setlength(result,nb); - nb := 0; - for j := 0 to high(curves[0]) do - AddPt(curves[0][j]); - for i := 1 to high(curves) do - begin - if not EqLast(curves[i][0]) then AddPt(curves[i][0]); - for j := 1 to high(curves[i]) do - AddPt(curves[i][j]); - end; -end; - -function InternalComputeClosedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -var - i, j, nb, idx, pre: integer; - ptPrev, ptPrev2, ptNext, ptNext2: TPointF; - t: single; - kernel: TWideKernelFilter; - -begin - if AStyle = ssEasyBezier then - begin - result := ComputeEasyBezier(EasyBezierCurve(APoints, AStart, ACount, true, cmCurve)); - exit; - end; - - if ACount <= 2 then - begin - setlength(result, ACount); - for i := 0 to high(result) do - result[i] := APoints[AStart + i]; - exit; - end; - - nb := 1; - for i := 0 to ACount-1 do - begin - ptPrev2 := APoints[(i + ACount - 1) mod ACount + AStart]; - ptPrev := APoints[i + AStart]; - ptNext := APoints[(i + 1) mod ACount + AStart]; - ptNext2 := APoints[(i + 2) mod ACount + AStart]; - inc(nb, ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation) ); - end; - - kernel := CreateInterpolator(AStyle); - setlength(Result, nb); - idx := 0; - for i := 0 to ACount-1 do - begin - ptPrev2 := APoints[(i + ACount - 1) mod ACount + AStart]; - ptPrev := APoints[i+ AStart]; - ptNext := APoints[(i + 1) mod ACount + AStart]; - ptNext2 := APoints[(i + 2) mod ACount + AStart]; - pre := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation); - if i=0 then - j := 0 - else - j := 1; - while j <= pre do - begin - t := j/pre; - result[idx] := ptPrev2*kernel.Interpolation(t+1) + ptPrev*kernel.Interpolation(t) + - ptNext*kernel.Interpolation(t-1) + ptNext2*kernel.Interpolation(t-2); - Inc(idx); - inc(j); - end; - end; - kernel.Free; -end; - -function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -var - nbParts, partIndex, start, i: integer; - parts: array of array of TPointF; -begin - nbParts := 1; - for i := 0 to high(APoints) do - if isEmptyPointF(APoints[i]) then inc(nbParts); - if nbParts = 1 then - exit(InternalComputeClosedSpline(APoints, 0, length(APoints), AStyle, AAcceptedDeviation)); - setlength(parts, nbParts); - partIndex := 0; - start := 0; - for i := 0 to high(APoints) do - if isEmptyPointF(APoints[i]) then - begin - parts[partIndex] := InternalComputeClosedSpline(APoints, start, i-start, AStyle, AAcceptedDeviation); - inc(partIndex); - start := i+1; - end; - parts[partIndex] := InternalComputeClosedSpline(APoints, start, length(APoints)-start, AStyle, AAcceptedDeviation); - result := ConcatPointsF(parts, true); -end; - -function InternalComputeOpenedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AEndCoeff: single; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -var - i, j, nb, idx, pre: integer; - ptPrev, ptPrev2, ptNext, ptNext2: TPointF; - t: single; - kernel: TWideKernelFilter; -begin - if AStyle = ssEasyBezier then - begin - result := ComputeEasyBezier(EasyBezierCurve(APoints, AStart, ACount, false, cmCurve)); - exit; - end; - - if ACount <= 2 then - begin - setlength(result, ACount); - for i := 0 to high(result) do - result[i] := APoints[AStart + i]; - exit; - end; - if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then AEndCoeff := 0; - if AEndCoeff < -0.3 then AEndCoeff := -0.3; - - nb := 1; - for i := 0 to ACount - 2 do - begin - ptPrev := APoints[AStart + i]; - ptNext := APoints[AStart + i + 1]; - if i=0 then - ptPrev2 := (ptPrev+(ptNext+APoints[AStart + i + 2])*AEndCoeff)*(1/(1+2*AEndCoeff)) - else - ptPrev2 := APoints[AStart + i - 1]; - if i = ACount - 2 then - ptNext2 := (ptNext+(ptPrev+APoints[AStart + i - 1])*AEndCoeff)*(1/(1+2*AEndCoeff)) - else - ptNext2 := APoints[AStart + i + 2]; - inc(nb, ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation) ); - end; - - kernel := CreateInterpolator(AStyle); - if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then - begin - inc(nb,2); - setlength(Result, nb); - result[0] := APoints[AStart]; - idx := 1; - end else - begin - idx := 0; - setlength(Result, nb); - end; - for i := 0 to ACount - 2 do - begin - ptPrev := APoints[AStart + i]; - ptNext := APoints[AStart + i + 1]; - if i=0 then - ptPrev2 := (ptPrev+(ptNext+APoints[i + 2 + AStart])*AEndCoeff)*(1/(1+2*AEndCoeff)) - else - ptPrev2 := APoints[AStart + i - 1]; - if i = ACount - 2 then - ptNext2 := (ptNext+(ptPrev+APoints[i - 1 + AStart])*AEndCoeff)*(1/(1+2*AEndCoeff)) - else - ptNext2 := APoints[AStart + i + 2]; - pre := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation); - if i=0 then - begin - j := 0; - end else j := 1; - while j <= pre do - begin - t := j/pre; - result[idx] := ptPrev2*kernel.Interpolation(t+1) + ptPrev*kernel.Interpolation(t) + - ptNext*kernel.Interpolation(t-1) + ptNext2*kernel.Interpolation(t-2); - Inc(idx); - inc(j); - end; - end; - kernel.Free; - if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then - result[idx] := APoints[AStart + ACount - 1]; -end; - -function ComputeClosedSpline(const APoints: array of TPointF; AStart, - ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single): ArrayOfTPointF; -var - i: Integer; -begin - if (AStart < 0) or (AStart + ACount > length(APoints)) then - raise exception.Create('Index out of bounds'); - for i := 0 to ACount-1 do - if IsEmptyPointF(APoints[AStart + i]) then - raise exception.Create('Unexpected empty point'); - result := InternalComputeClosedSpline(APoints, AStart, ACount, AStyle, AAcceptedDeviation); -end; - -function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AEndCoeff: single; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; -var - nbParts, partIndex, start, i: integer; - parts: array of array of TPointF; -begin - nbParts := 1; - for i := 0 to high(APoints) do - if isEmptyPointF(APoints[i]) then inc(nbParts); - if nbParts = 1 then - exit(InternalComputeOpenedSpline(APoints, 0, length(APoints), AStyle, AEndCoeff, AAcceptedDeviation)); - setlength(parts, nbParts); - partIndex := 0; - start := 0; - for i := 0 to high(APoints) do - if isEmptyPointF(APoints[i]) then - begin - parts[partIndex] := InternalComputeOpenedSpline(APoints, start, i-start, AStyle, AEndCoeff, AAcceptedDeviation); - inc(partIndex); - start := i+1; - end; - parts[partIndex] := InternalComputeOpenedSpline(APoints, start, length(APoints)-start, AStyle, AEndCoeff, AAcceptedDeviation); - result := ConcatPointsF(parts, true); -end; - -function ComputeOpenedSpline(const APoints: array of TPointF; AStart, - ACount: integer; AStyle: TSplineStyle; AEndCoeff: single; - AAcceptedDeviation: single): ArrayOfTPointF; -var - i: Integer; -begin - if (AStart < 0) or (AStart + ACount > length(APoints)) then - raise exception.Create('Index out of bounds'); - for i := 0 to ACount-1 do - if IsEmptyPointF(APoints[AStart + i]) then - raise exception.Create('Unexpected empty point'); - result := InternalComputeOpenedSpline(APoints, AStart, ACount, AStyle, AEndCoeff, AAcceptedDeviation); -end; - -function ClosedSplineStartPoint(const points: array of TPointF; - Style: TSplineStyle): TPointF; -var - kernel: TWideKernelFilter; - ptPrev2: TPointF; - ptPrev: TPointF; - ptNext: TPointF; - ptNext2: TPointF; -begin - if Style = ssEasyBezier then - begin - result := EasyBezierCurve(points, true, cmCurve).CurveStartPoint; - end else - begin - if length(points) = 0 then - result := EmptyPointF - else - if length(points)<=2 then - result := points[0] - else - begin - kernel := CreateInterpolator(style); - ptPrev2 := points[high(points)]; - ptPrev := points[0]; - ptNext := points[1]; - ptNext2 := points[2]; - result := ptPrev2*kernel.Interpolation(1) + ptPrev*kernel.Interpolation(0) + - ptNext*kernel.Interpolation(-1) + ptNext2*kernel.Interpolation(-2); - kernel.free; - end; - end; -end; - -function ComputeEasyBezier(const curve: TEasyBezierCurve; - AAcceptedDeviation: single): ArrayOfTPointF; -var - path: TBGRAPath; -begin - path := TBGRAPath.Create; - curve.CopyToPath(path); - result := path.ToPoints(AAcceptedDeviation); - path.Free; -end; - -function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single): ArrayOfTPointF; -var i,nb: integer; - arclen: integer; - pos: word; -begin - if end65536 > start65536 then - arclen := end65536-start65536 else - arclen := 65536-(start65536-end65536); - - if quality < 0 then quality := 0; - - nb := round(((rx+ry)*2*quality+8)*arclen/65536) and not 3; - if arclen <= 16384 then - begin - if nb < 2 then nb := 2; - end else - if arclen <= 32768 then - begin - if nb < 3 then nb := 3; - end else - if arclen <= 32768+16384 then - begin - if nb < 4 then nb := 4; - end else - if nb < 5 then nb := 5; - - if nb > arclen+1 then nb := arclen+1; - - setlength(result,nb); - for i := 0 to nb-1 do - begin - {$PUSH}{$R-} - pos := start65536+int64(i)*arclen div (int64(nb)-1); - {$POP} - result[i] := PointF(x+rx*(Cos65536(pos)-32768)/32768, - y-ry*(Sin65536(pos)-32768)/32768); - end; -end; - -function ComputeEllipse(x, y, rx, ry: single; quality: single): ArrayOfTPointF; -begin - result := ComputeArc65536(x,y,rx,ry,0,0,quality); -end; - -function ComputeEllipse(AOrigin, AXAxis, AYAxis: TPointF; quality: single): ArrayOfTPointF; -begin - result := ComputeArcRad(AOrigin, AXAxis, AYAxis, 0,0, quality); -end; - -function ComputeArc65536(AOrigin, AXAxis, AYAxis: TPointF; start65536, - end65536: word; quality: single): ArrayOfTPointF; -begin - //go back temporarily to radians - result := ComputeArcRad(AOrigin,AXAxis,AYAxis, start65536*Pi/326768, end65536*Pi/326768, quality); -end; - -function ComputeArcRad(x, y, rx, ry: single; startRadCCW, endRadCCW: single; - quality: single): ArrayOfTPointF; -var - start65536, end65536: Int64; -begin - start65536 := round(startRadCCW*32768/Pi); - end65536 := round(endRadCCW*32768/Pi); - //if arc is very small but non zero, it is not a circle - if (start65536 = end65536) and (startRadCCW <> endRadCCW) then - setlength(result,2) else - result := ComputeArc65536(x,y,rx,ry,start65536 and $ffff,end65536 and $ffff,quality); - result[0] := PointF(x+cos(startRadCCW)*rx,y-sin(startRadCCW)*ry); - result[high(result)] := PointF(x+cos(endRadCCW)*rx,y-sin(endRadCCW)*ry); -end; - -function ComputeArcRad(AOrigin, AXAxis, AYAxis: TPointF; startRadCCW,endRadCCW: single; quality: single): ArrayOfTPointF; -var - u, v: TPointF; - lenU, lenV: Single; - m: TAffineMatrix; - i: Integer; -begin - u := AXAxis-AOrigin; - lenU := VectLen(u); - v := AYAxis-AOrigin; - lenV := VectLen(v); - if (lenU = 0) and (lenV = 0) then exit(PointsF([AOrigin])); - - result := ComputeArcRad(0, 0, lenU, lenV, startRadCCW, endRadCCW, quality); - - if lenU <> 0 then u.Scale(1/lenU); - if lenV <> 0 then v.Scale(1/lenV); - m := AffineMatrix(u, v, AOrigin); - for i := 0 to high(result) do - result[i] := m*result[i]; -end; - -function ComputeArc(const arc: TArcDef; quality: single): ArrayOfTPointF; -var startAngle,endAngle: single; - i,n: integer; - temp: TPointF; - m: TAffineMatrix; -begin - startAngle := -arc.startAngleRadCW; - endAngle:= -arc.endAngleRadCW; - if not arc.anticlockwise then - begin - result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,endAngle,startAngle,quality); - n := length(result); - if n>1 then - for i := 0 to (n-2) div 2 do - begin - temp := result[i]; - result[i] := result[n-1-i]; - result[n-1-i] := temp; - end; - end else - result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,startAngle,endAngle,quality); - if arc.xAngleRadCW <> 0 then - begin - m := AffineMatrixTranslation(arc.center.x,arc.center.y)*AffineMatrixRotationRad(-arc.xAngleRadCW)*AffineMatrixTranslation(-arc.center.x,-arc.center.y); - for i := 0 to high(result) do - result[i] := m*result[i]; - end; -end; - -function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single): ArrayOfTPointF; -begin - result := ComputeRoundRect(x1,y1,x2,y2,rx,ry,[],quality); -end; - -function ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; - options: TRoundRectangleOptions; quality: single): ArrayOfTPointF; -var q0,q1,q2,q3,q4: array of TPointF; - temp: Single; -begin - if x1 > x2 then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - if y1 > y2 then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; - rx := abs(rx); - ry := abs(ry); - if 2*rx > x2-x1 then - rx := (x2-x1)/2; - if 2*ry > y2-y1 then - ry := (y2-y1)/2; - - q0 := PointsF([PointF(x2,(y1+y2)/2)]); - - if rrTopRightBevel in options then - q1 := PointsF([PointF(x2,y1+ry),PointF(x2-rx,y1)]) else - if rrTopRightSquare in options then - q1 := PointsF([PointF(x2,y1)]) - else - q1 := ComputeArc65536(x2-rx,y1+ry,rx,ry,0,16384,quality); - - if rrTopLeftBevel in options then - q2 := PointsF([PointF(x1+rx,y1),PointF(x1,y1+ry)]) else - if rrTopLeftSquare in options then - q2 := PointsF([PointF(x1,y1)]) - else - q2 := ComputeArc65536(x1+rx,y1+ry,rx,ry,16384,32768,quality); - - if rrBottomLeftBevel in options then - q3 := PointsF([PointF(x1,y2-ry),PointF(x1+rx,y2)]) else - if rrBottomLeftSquare in options then - q3 := PointsF([PointF(x1,y2)]) - else - q3 := ComputeArc65536(x1+rx,y2-ry,rx,ry,32768,32768+16384,quality); - - if rrBottomRightBevel in options then - q4 := PointsF([PointF(x2-rx,y2),PointF(x2,y2-ry)]) else - if rrBottomRightSquare in options then - q4 := PointsF([PointF(x2,y2)]) - else - q4 := ComputeArc65536(x2-rx,y2-ry,rx,ry,32768+16384,0,quality); - - result := ConcatPointsF([q0,q1,q2,q3,q4]); -end; - -function Html5ArcTo(const p0, p1, p2: TPointF; radius: single - ): TArcDef; -var p3,p4,an,bn,cn,c: TPointF; - dir, a2, b2, c2, cosx, sinx, d: single; - anticlockwise: boolean; -begin - result.center := p1; - result.radius := PointF(0,0); - result.xAngleRadCW:= 0; - result.startAngleRadCW := 0; - result.endAngleRadCW:= 0; - result.anticlockwise:= false; - - radius := abs(radius); - if (p0 = p1) or (p1 = p2) or (radius = 0) then exit; - - dir := (p2.x-p1.x)*(p0.y-p1.y) + (p2.y-p1.y)*(p1.x-p0.x); - if dir = 0 then exit; - - a2 := (p0.x-p1.x)*(p0.x-p1.x) + (p0.y-p1.y)*(p0.y-p1.y); - b2 := (p1.x-p2.x)*(p1.x-p2.x) + (p1.y-p2.y)*(p1.y-p2.y); - c2 := (p0.x-p2.x)*(p0.x-p2.x) + (p0.y-p2.y)*(p0.y-p2.y); - cosx := (a2+b2-c2)/(2*sqrt(a2*b2)); - - sinx := sqrt(1 - cosx*cosx); - if (sinx = 0) or (cosx = 1) then exit; - d := radius / ((1 - cosx) / sinx); - - an := (p1-p0)*(1/sqrt(a2)); - bn := (p1-p2)*(1/sqrt(b2)); - p3 := p1 - an*d; - p4 := p1 - bn*d; - anticlockwise := (dir < 0); - - cn := PointF(an.y,-an.x)*radius; - if not anticlockwise then cn := -cn; - c := p3 + cn; - - result.center := c; - result.radius:= PointF(radius,radius); - result.startAngleRadCW := arctan2((p3.y-c.y), (p3.x-c.x)); - result.endAngleRadCW := arctan2((p4.y-c.y), (p4.x-c.x)); - result.anticlockwise:= anticlockwise; -end; - -function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc, - anticlockwise: boolean; const p1: TPointF): TArcDef; -var - p0p,cp: TPointF; - cross1,cross2,lambda: single; -begin - if (rx=0) or (ry=0) or (p0 = p1) then - begin - result.radius := PointF(0,0); - result.xAngleRadCW:= 0; - result.anticlockwise := false; - result.endAngleRadCW := 0; - result.startAngleRadCW:= 0; - result.center := p1; - exit; - end; - result.xAngleRadCW := xAngleRadCW; - result.anticlockwise := anticlockwise; - p0p := AffineMatrixRotationRad(xAngleRadCW)*( (p0-p1)*0.5 ); - - //ensure radius is big enough - lambda := sqr(p0p.x/rx) + sqr(p0p.y/ry); - if lambda > 1 then - begin - lambda := sqrt(lambda); - rx := rx * lambda; - ry := ry * lambda; - end; - result.radius := PointF(rx,ry); - - //compute center - cross2 := sqr(rx*p0p.y) + sqr(ry*p0p.x); - cross1 := sqr(rx*ry); - if cross1 <= cross2 then - cp := PointF(0,0) - else - cp := sqrt((cross1-cross2)/cross2)* - PointF(rx*p0p.y/ry, -ry*p0p.x/rx); - if largeArc <> anticlockwise then cp := -cp; - - result.center := AffineMatrixRotationRad(-xAngleRadCW)*cp + - (p0+p1)*0.5; - result.startAngleRadCW := arctan2((p0p.y-cp.y)/ry,(p0p.x-cp.x)/rx); - result.endAngleRadCW := arctan2((-p0p.y-cp.y)/ry,(-p0p.x-cp.x)/rx); -end; - -function ArcStartPoint(const arc: TArcDef): TPointF; -begin - result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.startAngleRadCW)*arc.radius.x, - sin(arc.startAngleRadCW)*arc.radius.y) + arc.center; -end; - -function ArcEndPoint(const arc: TArcDef): TPointF; -begin - result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.endAngleRadCW)*arc.radius.x, - sin(arc.endAngleRadCW)*arc.radius.y) + arc.center; -end; - -function IsLargeArc(const arc: TArcDef): boolean; -var diff,a1,a2: single; -begin - a1 := arc.startAngleRadCW - floor(arc.startAngleRadCW/(2*Pi))*(2*Pi); - a2 := arc.endAngleRadCW - floor(arc.endAngleRadCW/(2*Pi))*(2*Pi); - if not arc.anticlockwise then - diff := a2 - a1 - else - diff := a1 - a2; - result := (diff < 0) or (diff >= Pi); -end; - -{ TBGRAPathCursor } - -function TBGRAPathCursor.GetCurrentCoord: TPointF; -begin - case FCurrentElementType of - peNone: result := EmptyPointF; - peMoveTo,peLineTo,peCloseSubPath: - if FCurrentElementLength <= 0 then - result := FCurrentElementStartCoord - else - result := FCurrentElementStartCoord + (FCurrentElementEndCoord-FCurrentElementStartCoord)*(FCurrentElementArcPos/FCurrentElementLength); - peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline: - begin - NeedPolygonalApprox; - if FCurrentSegment >= high(FCurrentElementPoints) then - result := FCurrentElementEndCoord - else - result := FCurrentElementPoints[FCurrentSegment]+ - (FCurrentElementPoints[FCurrentSegment+1]- - FCurrentElementPoints[FCurrentSegment])*FCurrentSegmentPos; - end; - else - raise Exception.Create('Unknown element type'); - end; -end; - -function TBGRAPathCursor.GetPath: TBGRAPath; -begin - if not Assigned(FPath) then - raise exception.Create('Path does not exist'); - result := FPath; -end; - -procedure TBGRAPathCursor.MoveToEndOfElement; -begin - FCurrentElementArcPos := FCurrentElementLength; - if not NeedPolygonalApprox then exit; - if length(FCurrentElementPoints) > 1 then - begin - FCurrentSegment := high(FCurrentElementPoints)-1; - FCurrentSegmentPos := 1; - end else - begin - FCurrentSegment := high(FCurrentElementPoints); - FCurrentSegmentPos := 0; - end; -end; - -procedure TBGRAPathCursor.MoveForwardInElement(ADistance: single); -var segLen,rightSpace,remaining: single; -begin - if not NeedPolygonalApprox then exit; - ADistance := ADistance * FCurrentElementArcPosScale; - remaining := ADistance; - while remaining > 0 do - begin - if FCurrentSegment < high(FCurrentElementPoints) then - segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment]) - else - segLen := 0; - rightSpace := segLen*(1-FCurrentSegmentPos); - if (segLen > 0) and (remaining <= rightSpace) then - begin - IncF(FCurrentSegmentPos, remaining/segLen); - exit; - end else - begin - DecF(remaining, rightSpace); - if FCurrentSegment < high(FCurrentElementPoints)-1 then - begin - inc(FCurrentSegment); - FCurrentSegmentPos := 0; - end else - begin - FCurrentSegmentPos := 1; - exit; - end; - end; - end; -end; - -procedure TBGRAPathCursor.MoveBackwardInElement(ADistance: single); -var - segLen,leftSpace,remaining: Single; -begin - if not NeedPolygonalApprox then exit; - ADistance := ADistance * FCurrentElementArcPosScale; - remaining := ADistance; - while remaining > 0 do - begin - if FCurrentSegment < high(FCurrentElementPoints) then - segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment]) - else - segLen := 0; - leftSpace := segLen*FCurrentSegmentPos; - if (segLen > 0) and (remaining <= leftSpace) then - begin - DecF(FCurrentSegmentPos, remaining/segLen); - exit; - end else - begin - DecF(remaining, leftSpace); - if FCurrentSegment > 0 then - begin - dec(FCurrentSegment); - FCurrentSegmentPos := 1; - end else - begin - FCurrentSegmentPos := 0; - exit; - end; - end; - end; -end; - -function TBGRAPathCursor.NeedPolygonalApprox: boolean; -begin - if not (FCurrentElementType in[peQuadraticBezierTo,peCubicBezierTo,peArc, - peOpenedSpline,peClosedSpline]) - then - begin - result := false; - exit; - end; - result := true; - if FCurrentElementPoints = nil then - begin - FCurrentElementPoints := Path.GetPolygonalApprox(FDataPos, FAcceptedDeviation, True); - if FCurrentElementType = peQuadraticBezierTo then - begin - if FCurrentElementLength <> 0 then - FCurrentElementArcPosScale := PolylineLen(FCurrentElementPoints)/FCurrentElementLength; - end; - end; -end; - -function TBGRAPathCursor.GetArcPos: single; -var pos: PtrInt; -begin - if FArcPos = EmptySingle then - begin - FArcPos := FCurrentElementArcPos; - pos := FDataPos; - while Path.GoToPreviousElement(pos) do - IncF(FArcPos, Path.GetElementLength(pos, FAcceptedDeviation)); - end; - result := FArcPos; -end; - -function TBGRAPathCursor.GetCurrentTangent: TPointF; -var idxStart,idxEnd: integer; - seg: TPointF; -begin - while FCurrentElementLength <= 0 do - begin - if not GoToNextElement(False) then - begin - result := EmptyPointF; - exit; - end; - end; - case FCurrentElementType of - peMoveTo,peLineTo,peCloseSubPath: - result := (FCurrentElementEndCoord-FCurrentElementStartCoord)*(1/FCurrentElementLength); - peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline: - begin - NeedPolygonalApprox; - idxStart := FCurrentSegment; - if idxStart >= high(FCurrentElementPoints) then - idxStart:= high(FCurrentElementPoints)-1; - idxEnd := idxStart+1; - if idxStart < 0 then - begin - result := EmptyPointF; - exit; - end; - seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart]; - while (seg.x = 0) and (seg.y = 0) and (idxEnd < high(FCurrentElementPoints)) do - begin - inc(idxEnd); - seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart]; - end; - while (seg.x = 0) and (seg.y = 0) and (idxStart > 0) do - begin - dec(idxStart); - seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart]; - end; - if (seg.x = 0) and (seg.y = 0) then - result := EmptyPointF - else - result := seg*(1/VectLen(seg)); - end; - else result := EmptyPointF; - end; -end; - -procedure TBGRAPathCursor.SetArcPos(AValue: single); -var oldLoopClosedShapes,oldLoopPath: boolean; -begin - if GetArcPos=AValue then Exit; - if (AValue > PathLength) and (PathLength <> 0) then - AValue := AValue - trunc(AValue/PathLength)*PathLength - else if (AValue < 0) then - AValue := AValue + (trunc(-AValue/PathLength)+1)*PathLength; - oldLoopClosedShapes:= LoopClosedShapes; - oldLoopPath:= LoopPath; - LoopClosedShapes:= false; - LoopPath:= false; - MoveForward(AValue-GetArcPos, True); - LoopClosedShapes:= oldLoopClosedShapes; - LoopPath:= oldLoopPath; -end; - -function TBGRAPathCursor.GetPathLength: single; -begin - if not FPathLengthComputed then - begin - FPathLength := Path.ComputeLength(FAcceptedDeviation); - FPathLengthComputed := true; - end; - result := FPathLength; -end; - -procedure TBGRAPathCursor.OnPathFree; -begin - FPath := nil; -end; - -function TBGRAPathCursor.GetLoopClosedShapes: boolean; -begin - result := FLoopClosedShapes; -end; - -function TBGRAPathCursor.GetLoopPath: boolean; -begin - result := FLoopPath; -end; - -function TBGRAPathCursor.GetStartCoordinate: TPointF; -begin - result := FStartCoordinate; -end; - -procedure TBGRAPathCursor.SetLoopClosedShapes(AValue: boolean); -begin - FLoopClosedShapes := AValue; -end; - -procedure TBGRAPathCursor.SetLoopPath(AValue: boolean); -begin - FLoopPath := AValue; -end; - -procedure TBGRAPathCursor.PrepareCurrentElement; -begin - Path.GetElementAt(FDataPos, FCurrentElementType, FCurrentElement); - FCurrentElementLength := 0; - FCurrentElementArcPos := 0; - FCurrentElementPoints := nil; - FCurrentSegment := 0; - FCurrentSegmentPos := 0; - FCurrentElementArcPosScale := 1; - if FCurrentElementType = peNone then - begin - FCurrentElementStartCoord := EmptyPointF; - FCurrentElementEndCoord := EmptyPointF; - end - else - begin - FCurrentElementStartCoord := Path.GetElementStartCoord(FDataPos); - case FCurrentElementType of - peLineTo, peCloseSubPath: - begin - FCurrentElementEndCoord := PPointF(FCurrentElement)^; - FCurrentElementLength := VectLen(FCurrentElementEndCoord - FCurrentElementStartCoord); - end; - peQuadraticBezierTo: with PQuadraticBezierToElement(FCurrentElement)^ do - begin - FCurrentElementEndCoord := Destination; - FCurrentElementLength := BGRABitmapTypes.BezierCurve(FCurrentElementStartCoord,ControlPoint,Destination).ComputeLength; - end; - peCubicBezierTo,peArc,peOpenedSpline,peClosedSpline: - begin - NeedPolygonalApprox; - FCurrentElementEndCoord := FCurrentElementPoints[high(FCurrentElementPoints)]; - FCurrentElementLength := PolylineLen(FCurrentElementPoints); - end; - else - FCurrentElementEndCoord := FCurrentElementStartCoord; - end; - end; -end; - -function TBGRAPathCursor.GetBounds: TRectF; -begin - if not FBoundsComputed then - begin - FBounds:= Path.GetBounds(FAcceptedDeviation); - FBoundsComputed := true; - end; - result := FBounds; -end; - -function TBGRAPathCursor.GoToNextElement(ACanJump: boolean): boolean; -begin - if (FCurrentElementType = peCloseSubPath) and - (PClosePathElement(FCurrentElement)^.LoopDataPos <> -1) and - ( FLoopClosedShapes or - (FLoopPath and (PClosePathElement(FCurrentElement)^.LoopDataPos = 0)) - ) then - begin - if PClosePathElement(FCurrentElement)^.LoopDataPos <> FDataPos then - begin - result := true; - FDataPos := PClosePathElement(FCurrentElement)^.LoopDataPos; - FArcPos := EmptySingle; - PrepareCurrentElement; - end else - result := false; - end; - if not ACanJump and ((FCurrentElementType = peCloseSubPath) - or (Path.PeekNextElement(FDataPos) = peMoveTo)) then - begin - result := false; - exit; - end; - if Path.GoToNextElement(FDataPos) then - begin - result := true; - PrepareCurrentElement; - end - else - begin - if ACanJump and FLoopPath and (FDataPos > 0) then - begin - result := true; - FDataPos := 0; - FArcPos := EmptySingle; - PrepareCurrentElement; - end else - result := false; - end; -end; - -function TBGRAPathCursor.GoToPreviousElement(ACanJump: boolean): boolean; -var lastElemPos: IntPtr; -begin - if (FCurrentElementType = peMoveTo) and (PMoveToElement(FCurrentElement)^.LoopDataPos <> -1) and - ( FLoopClosedShapes or - (FLoopPath and (FDataPos = 0)) - ) then - with PMoveToElement(FCurrentElement)^ do - begin - if LoopDataPos <> -1 then - begin - result := true; - FDataPos := LoopDataPos; - FArcPos := EmptySingle; - PrepareCurrentElement; - end; - end; - if not ACanJump and (FCurrentElementType = peMoveTo) then - begin - result := false; - exit; - end; - if Path.GoToPreviousElement(FDataPos) then - begin - result := true; - PrepareCurrentElement; - end - else - begin - if FLoopPath then - begin - lastElemPos := FPath.FDataPos; - if (lastElemPos > 0) and FPath.GoToPreviousElement(lastElemPos) then - begin - if lastElemPos > 0 then - begin - result := true; - FDataPos := lastElemPos; - PrepareCurrentElement; - FArcPos := EmptySingle; - exit; - end; - end; - end; - result := false; - end; -end; - -constructor TBGRAPathCursor.Create(APath: TBGRAPath; AAcceptedDeviation: single); -begin - FPath := APath; - FPathLengthComputed := false; - FBoundsComputed:= false; - FDataPos := 0; - FArcPos:= 0; - FAcceptedDeviation:= AAcceptedDeviation; - Path.RegisterCursor(self); - PrepareCurrentElement; - - FStartCoordinate := FCurrentElementStartCoord; - if isEmptyPointF(FStartCoordinate) then - raise exception.Create('Path does not has a starting coordinate'); - FEndCoordinate := Path.FLastTransformedCoord; - if isEmptyPointF(FEndCoordinate) then - raise exception.Create('Path does not has an ending coordinate'); -end; - -function TBGRAPathCursor.MoveForward(ADistance: single; ACanJump: boolean): single; -var newArcPos,step,remaining: single; -begin - if ADistance < 0 then - begin - result := -MoveBackward(-ADistance, ACanJump); - exit; - end; - result := 0; - remaining := ADistance; - while remaining > 0 do - begin - newArcPos := FCurrentElementArcPos + remaining; - if newArcPos > FCurrentElementLength then - begin - step := FCurrentElementLength - FCurrentElementArcPos; - IncF(result, step); - DecF(remaining, step); - if not GoToNextElement(ACanJump) then - begin - MoveForwardInElement(step); - FCurrentElementArcPos := FCurrentElementLength; - FArcPos := PathLength; - exit; - end; - end else - begin - MoveForwardInElement(remaining); - FCurrentElementArcPos := newArcPos; - result := ADistance; - break; - end; - end; - if FArcPos <> EmptySingle then - IncF(FArcPos, result); -end; - -function TBGRAPathCursor.MoveBackward(ADistance: single; ACanJump: boolean = true): single; -var - remaining: Single; - newArcPos: Single; - step: Single; -begin - if ADistance = 0 then - begin - result := 0; - exit; - end; - if ADistance < 0 then - begin - result := -MoveForward(-ADistance, ACanJump); - exit; - end; - result := 0; - remaining := ADistance; - while remaining > 0 do - begin - newArcPos := FCurrentElementArcPos - remaining; - if newArcPos < 0 then - begin - step := FCurrentElementArcPos; - IncF(result, step); - DecF(remaining, step); - if not GoToPreviousElement(ACanJump) then - begin - MoveBackwardInElement(step); - FCurrentElementArcPos := 0; - FArcPos := 0; - exit; - end else - MoveToEndOfElement; - end else - begin - MoveBackwardInElement(remaining); - FCurrentElementArcPos := newArcPos; - result := ADistance; - break; - end; - end; - if FArcPos <> EmptySingle then - DecF(FArcPos, result); -end; - -destructor TBGRAPathCursor.Destroy; -begin - if Assigned(FPath) then - begin - FPath.UnregisterCursor(self); - end; - inherited Destroy; -end; - -{ TBGRAPath } - -function TBGRAPath.ComputeLength(AAcceptedDeviation: single): single; -var pos: PtrInt; -begin - pos := 0; - result := 0; - repeat - IncF(result, GetElementLength(pos, AAcceptedDeviation)); - until not GoToNextElement(pos); -end; - -function TBGRAPath.ToPoints(AAcceptedDeviation: single): ArrayOfTPointF; -var sub: array of ArrayOfTPointF; - temp: ArrayOfTPointF; - nbSub,nbPts,curPt,curSub: Int32or64; - startPos,pos: PtrInt; - elemType: TBGRAPathElementType; - elem: pointer; -begin - pos := 0; - nbSub := 0; - repeat - GetElementAt(pos, elemType, elem); - if elem = nil then break; - case elemType of - peMoveTo,peLineTo,peCloseSubPath: begin - inc(nbSub); - while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do - GoToNextElement(pos); - end; - peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub); - end; - until not GoToNextElement(pos); - - pos := 0; - setlength(sub, nbSub); - curSub := 0; - repeat - GetElementAt(pos, elemType, elem); - if elem = nil then break; - case elemType of - peMoveTo,peLineTo,peCloseSubPath: begin - startPos := pos; - if (elemType = peMoveTo) and (curSub > 0) then - nbPts := 2 - else - nbPts := 1; - while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do - begin - GoToNextElement(pos); - inc(nbPts); - end; - setlength(temp, nbPts); - pos := startPos; - if (elemType = peMoveTo) and (curSub > 0) then - begin - temp[0] := EmptyPointF; - temp[1] := PPointF(elem)^; - curPt := 2; - end else - begin - temp[0] := PPointF(elem)^; - curPt := 1; - end; - while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do - begin - GoToNextElement(pos); - GetElementAt(pos, elemType, elem); - temp[curPt] := PPointF(elem)^; - inc(curPt); - end; - sub[curSub] := temp; - inc(curSub); - temp := nil; - end; - peQuadraticBezierTo,peCubicBezierTo,peArc, - peOpenedSpline, peClosedSpline: - begin - sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False); - inc(curSub); - end; - end; - until not GoToNextElement(pos) or (curSub = nbSub); - result := ConcatPointsF(sub); -end; - -function TBGRAPath.ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single): ArrayOfTPointF; -begin - AAcceptedDeviation:= CorrectAcceptedDeviation(AAcceptedDeviation,AMatrix); - result := ToPoints(AAcceptedDeviation); - if not IsAffineMatrixIdentity(AMatrix) then - result := AMatrix*result; -end; - -function TBGRAPath.IsEmpty: boolean; -begin - result := FDataPos = 0; -end; - -function TBGRAPath.GetBounds(AAcceptedDeviation: single): TRectF; -var empty: boolean; - pos: PtrInt; - elemType: TBGRAPathElementType; - elem: pointer; - temp: array of TPointF; - i: integer; - - procedure Include(pt: TPointF); - begin - if empty then - begin - result.TopLeft := pt; - result.BottomRight := pt; - empty := false; - end else - begin - if pt.x < result.Left then result.Left := pt.x - else if pt.x > result.Right then result.Right := pt.x; - if pt.y < result.Top then result.Top := pt.y - else if pt.y > result.Bottom then result.Bottom := pt.y; - end; - end; - - procedure IncludeRect(r: TRectF); - begin - Include(r.TopLeft); - Include(r.BottomRight); - end; - -begin - empty := true; - result := RectF(0,0,0,0); - pos := 0; - repeat - GetElementAt(pos, elemType, elem); - if elem = nil then break; - case elemType of - peMoveTo,peLineTo,peCloseSubPath: begin - Include(PPointF(elem)^); - while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do - begin - GoToNextElement(pos); - GetElementAt(pos, elemType, elem); - Include(PPointF(elem)^); - end; - end; - peCubicBezierTo: - with PCubicBezierToElement(elem)^ do - IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint1,ControlPoint2,Destination).GetBounds); - peQuadraticBezierTo: - with PQuadraticBezierToElement(elem)^ do - IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint,Destination).GetBounds); - peArc, peOpenedSpline, peClosedSpline: - begin - temp := GetPolygonalApprox(pos, AAcceptedDeviation, False); - for i := 0 to high(temp) do - Include(temp[i]); - end; - end; - until not GoToNextElement(pos); - if empty then raise exception.Create('Path is empty'); -end; - -procedure TBGRAPath.SetPoints(const APoints: ArrayOfTPointF); -var i: integer; - nextIsMoveTo: boolean; - startPoint: TPointF; -begin - beginPath; - if length(APoints) = 0 then exit; - NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(APoints)); - nextIsMoveTo:= true; - startPoint := EmptyPointF; - for i := 0 to high(APoints) do - begin - if isEmptyPointF(APoints[i]) then - nextIsMoveTo:= true - else - if nextIsMoveTo then - begin - startPoint := APoints[i]; - moveTo(startPoint); - nextIsMoveTo:= false; - end - else - begin - with APoints[i] do - if (x = startPoint.x) and (y = startPoint.y) then - closePath - else - lineTo(APoints[i]); - end; - end; -end; - -procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; - AWidth: single; AAcceptedDeviation: single); -begin - stroke(ABitmap,AffineMatrixIdentity,AColor,AWidth,AAcceptedDeviation); -end; - -procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; - AWidth: single; AAcceptedDeviation: single); -begin - stroke(ABitmap,AffineMatrixIdentity,ATexture,AWidth,AAcceptedDeviation); -end; - -procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single; - AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single); -begin - stroke(ABitmap,AffineMatrixTranslation(x,y),AColor,AWidth,AAcceptedDeviation); -end; - -procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single; - ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single); -begin - stroke(ABitmap,AffineMatrixTranslation(x,y),ATexture,AWidth,AAcceptedDeviation); -end; - -procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; - AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single); -var data: TStrokeData; -begin - data.Bitmap := ABitmap; - data.Texture := nil; - data.Color := AColor; - data.Width := AWidth; - InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data); -end; - -procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; - ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single); -var data: TStrokeData; -begin - data.Bitmap := ABitmap; - data.Texture := ATexture; - data.Color := BGRAPixelTransparent; - data.Width := AWidth; - InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data); -end; - -procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); -begin - stroke(ADrawProc, AffineMatrixIdentity, DefaultDeviation, AData); -end; - -procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc; - const AMatrix: TAffineMatrix; AData: pointer); -begin - stroke(ADrawProc, AMatrix, DefaultDeviation, AData); -end; - -procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc; - const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer); -begin - InternalDraw(ADrawProc,AMatrix,AAcceptedDeviation,AData); -end; - -procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; - AAcceptedDeviation: single); -begin - fill(ABitmap,AffineMatrixIdentity,AColor,AAcceptedDeviation); -end; - -procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; - AAcceptedDeviation: single); -begin - fill(ABitmap,AffineMatrixIdentity,ATexture,AAcceptedDeviation); -end; - -procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single; - AColor: TBGRAPixel; AAcceptedDeviation: single); -begin - fill(ABitmap,AffineMatrixTranslation(x,y),AColor,AAcceptedDeviation); -end; - -procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single; - ATexture: IBGRAScanner; AAcceptedDeviation: single); -begin - fill(ABitmap,AffineMatrixTranslation(x,y),ATexture,AAcceptedDeviation); -end; - -procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; - AColor: TBGRAPixel; AAcceptedDeviation: single); -begin - ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), AColor); -end; - -procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; - ATexture: IBGRAScanner; AAcceptedDeviation: single); -begin - ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), ATexture); -end; - -procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; AData: pointer); -begin - fill(AFillProc, AffineMatrixIdentity, DefaultDeviation, AData); -end; - -procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; - const AMatrix: TAffineMatrix; AData: pointer); -begin - fill(AFillProc, AMatrix, DefaultDeviation, AData); -end; - -procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; - AAcceptedDeviation: single; AData: pointer); -begin - AFillProc(ToPoints(AMatrix,AAcceptedDeviation), AData); -end; - -function TBGRAPath.CreateCursor(AAcceptedDeviation: single): TBGRAPathCursor; -begin - result := TBGRAPathCursor.Create(self, AAcceptedDeviation); -end; - -procedure TBGRAPath.Fit(ARect: TRectF; AAcceptedDeviation: single); -var - temp: TBGRAPath; -begin - temp := TBGRAPath.Create; - copyTo(temp); - temp.FitInto(self, ARect, AAcceptedDeviation); - temp.Free; -end; - -procedure TBGRAPath.FitInto(ADest: TBGRAPath; ARect: TRectF; - AAcceptedDeviation: single); -var bounds: TRectF; - zoomX,zoomY: single; -begin - bounds := GetBounds(AAcceptedDeviation); - ADest.beginPath; - ADest.translate((ARect.Left+ARect.Right)*0.5, (ARect.Bottom+ARect.Top)*0.5); - if bounds.Right-bounds.Left <> 0 then - begin - zoomX := (ARect.Right-ARect.Left)/(bounds.Right-bounds.Left); - if bounds.Bottom-bounds.Top > 0 then - begin - zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top); - if zoomY < zoomX then ADest.scale(zoomY) else ADest.scale(zoomX); - end else - ADest.scale(zoomX); - end else - if bounds.Bottom-bounds.Top > 0 then - begin - zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top); - ADest.scale(zoomY); - end; - ADest.translate(-(bounds.Left+bounds.Right)*0.5, -(bounds.Bottom+bounds.Top)*0.5); - copyTo(ADest); - ADest.resetTransform; -end; - -function TBGRAPath.GetSvgString: string; -const RadToDeg = 180/Pi; -var - formats: TFormatSettings; - lastPosF: TPointF; - implicitCommand: char; - - function FloatToString(value: single): string; - begin - result := FloatToStrF(value,ffGeneral,7,0,formats)+' '; - end; - - function CoordToString(const pt: TPointF): string; - begin - lastPosF := pt; - result := FloatToString(pt.x)+FloatToString(pt.y); - end; - - function BoolToString(value: boolean): string; - begin - if value then - result := '1 ' else result := '0 '; - end; - - procedure addCommand(command: char; parameters: string); - begin - if result <> '' then AppendStr(Result, ' '); //optional whitespace - if command <> implicitCommand then AppendStr(Result, command); - AppendStr(Result, trim(parameters)); - if command = 'M' then implicitCommand:= 'L' - else if command = 'm' then implicitCommand:= 'l' - else if command in['z','Z'] then implicitCommand:= #0 - else implicitCommand := command; - end; - -var elemType: TBGRAPathElementType; - elem: pointer; - a: PArcElement; - Pos: PtrInt; - p1: TPointF; - pts: array of TPointF; - i: integer; -begin - formats := DefaultFormatSettings; - formats.DecimalSeparator := '.'; - - result := ''; - Pos := 0; - lastPosF := EmptyPointF; - implicitCommand := #0; - repeat - GetElementAt(Pos, elemType, elem); - if elem = nil then break; - case elemType of - peMoveTo: addCommand('M',CoordToString(PPointF(elem)^)); - peLineTo: addCommand('L',CoordToString(PPointF(elem)^)); - peCloseSubPath: addCommand('z',''); - peQuadraticBezierTo: - with PQuadraticBezierToElement(elem)^ do - addCommand('Q',CoordToString(ControlPoint)+CoordToString(Destination)); - peCubicBezierTo: - with PCubicBezierToElement(elem)^ do - addCommand('C',CoordToString(ControlPoint1)+ - CoordToString(ControlPoint2)+CoordToString(Destination)); - peArc: - begin - a := PArcElement(elem); - p1 := ArcStartPoint(a^); - if isEmptyPointF(lastPosF) or (p1 <> lastPosF) then - addCommand('L',CoordToString(p1)); - addCommand('A',CoordToString(a^.radius)+ - FloatToString(a^.xAngleRadCW*RadToDeg)+ - BoolToString(IsLargeArc(a^))+ - BoolToString(not a^.anticlockwise)+ - CoordToString(ArcEndPoint(a^))); - end; - peOpenedSpline, peClosedSpline: - begin - pts := GetPolygonalApprox(Pos, DefaultDeviation,True); - for i := 0 to high(pts) do - begin - if isEmptyPointF(lastPosF) then - addCommand('M',CoordToString(pts[i])) - else - addCommand('L',CoordToString(pts[i])); - end; - end; - end; - until not GoToNextElement(Pos); -end; - -procedure TBGRAPath.SetSvgString(const AValue: string); -begin - resetTransform; - beginPath; - addPath(AValue); -end; - -procedure TBGRAPath.RegisterCursor(ACursor: TBGRAPathCursor); -begin - setlength(FCursors, length(FCursors)+1); - FCursors[high(FCursors)] := ACursor; -end; - -procedure TBGRAPath.UnregisterCursor(ACursor: TBGRAPathCursor); -var - i,j: Integer; -begin - for i := high(FCursors) downto 0 do - if FCursors[i] = ACursor then - begin - for j := i to high(FCursors)-1 do - FCursors[j] := FCursors[j+1]; - setlength(FCursors, length(FCursors)-1); - exit; - end; -end; - -function TBGRAPath.SetLastCoord(ACoord: TPointF): TPointF; -begin - FLastCoord := ACoord; - FLastTransformedCoord := FMatrix*ACoord; - result := FLastTransformedCoord; -end; - -procedure TBGRAPath.ClearLastCoord; -begin - FLastCoord := EmptyPointF; - FLastTransformedCoord := EmptyPointF; -end; - -procedure TBGRAPath.BezierCurveFromTransformed(tcp1, cp2, pt: TPointF); -begin - with PCubicBezierToElement(AllocateElement(peCubicBezierTo))^ do - begin - ControlPoint1 := tcp1; - ControlPoint2 := FMatrix*cp2; - Destination := SetLastCoord(pt); - FExpectedTransformedControlPoint := Destination + (Destination-ControlPoint2); - end; -end; - -procedure TBGRAPath.QuadraticCurveFromTransformed(tcp, pt: TPointF); -begin - with PQuadraticBezierToElement(AllocateElement(peQuadraticBezierTo))^ do - begin - ControlPoint := tcp; - Destination := SetLastCoord(pt); - FExpectedTransformedControlPoint := Destination+(Destination-ControlPoint); - end; -end; - -function TBGRAPath.LastCoordDefined: boolean; -begin - result := not isEmptyPointF(FLastTransformedCoord); -end; - -function TBGRAPath.GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF; -var pts: ArrayOfTPointF; - elemType: TBGRAPathElementType; - elem: pointer; - pt : TPointF; - i: Int32or64; -begin - GetElementAt(APos, elemType, elem); - case elemType of - peQuadraticBezierTo: - with PQuadraticBezierToElement(elem)^ do - result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint); - peCubicBezierTo: - with PCubicBezierToElement(elem)^ do - result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint); - peArc: - begin - result := ComputeArc(PArcElement(elem)^, DefaultDeviation/AAcceptedDeviation); - pt := GetElementStartCoord(APos); - if pt <> result[0] then - begin - setlength(result, length(result)+1); - for i := high(result) downto 1 do - result[i] := result[i-1]; - result[0] := pt; - end; - end; - peOpenedSpline, peClosedSpline: - with PSplineElement(elem)^ do - begin - setlength(pts, NbControlPoints); - move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF)); - if elemType = peOpenedSpline then - result := ComputeOpenedSpline(pts, SplineStyle, 0.25, AAcceptedDeviation) - else - result := ComputeClosedSpline(pts, SplineStyle, AAcceptedDeviation); - end; - end; -end; - -function TBGRAPath.getPoints: ArrayOfTPointF; -begin - result := ToPoints; -end; - -function TBGRAPath.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; -begin - result := ToPoints(AMatrix); -end; - -function TBGRAPath.getLength: single; -begin - result := ComputeLength; -end; - -function TBGRAPath.getCursor: TBGRACustomPathCursor; -begin - result := CreateCursor; -end; - -procedure TBGRAPath.InternalDraw(ADrawProc: TBGRAPathDrawProc; - const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer); -var - nbSub: Int32or64; - - procedure OutputSub(subPathStartPos, subPathEndPos: IntPtr); - var - sub: array of ArrayOfTPointF; - temp: ArrayOfTPointF; - startPos,pos,nbPts,curPt,curSub: Int32or64; - elemType: TBGRAPathElementType; - elem: pointer; - begin - pos := subPathStartPos; - setlength(sub, nbSub); - curSub := 0; - while (pos <= subPathEndPos) and (curSub < nbSub) do - begin - GetElementAt(pos, elemType, elem); - if elem = nil then break; - case elemType of - peMoveTo,peLineTo,peCloseSubPath: begin - startPos := pos; - if (elemType = peMoveTo) and (curSub > 0) then - nbPts := 2 - else - nbPts := 1; - while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do - begin - GoToNextElement(pos); - inc(nbPts); - end; - setlength(temp, nbPts); - pos := startPos; - if (elemType = peMoveTo) and (curSub > 0) then - begin - temp[0] := EmptyPointF; - temp[1] := PPointF(elem)^; - curPt := 2; - end else - begin - temp[0] := PPointF(elem)^; - curPt := 1; - end; - while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do - begin - GoToNextElement(pos); - GetElementAt(pos, elemType, elem); - temp[curPt] := PPointF(elem)^; - inc(curPt); - end; - sub[curSub] := temp; - inc(curSub); - temp := nil; - end; - peQuadraticBezierTo,peCubicBezierTo,peArc, - peOpenedSpline, peClosedSpline: - begin - sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False); - inc(curSub); - end; - end; - GoToNextElement(pos); - end; - temp := ConcatPointsF(sub); - if not IsAffineMatrixIdentity(AMatrix) then - temp := AMatrix*temp; - if (elemType = peCloseSubPath) or ((curSub = 2) and (elemType = peClosedSpline)) then - ADrawProc(temp, True, AData) - else - ADrawProc(temp, False, AData); - end; - -var - subPathStartPos: IntPtr; - prevPos,pos: PtrInt; - elemType: TBGRAPathElementType; - elem: pointer; -begin - AAcceptedDeviation := CorrectAcceptedDeviation(AAcceptedDeviation, AMatrix); - pos := 0; - nbSub := 0; - subPathStartPos := pos; - repeat - prevPos := pos; - GetElementAt(pos, elemType, elem); - if elem = nil then - begin - pos := prevPos; - break; - end; - if (elemType = peMoveTo) and (nbSub > 0) then - begin - OutputSub(subPathStartPos,prevPos); - nbSub := 0; - subPathStartPos := pos; - end; - case elemType of - peMoveTo,peLineTo,peCloseSubPath: begin - inc(nbSub); - while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do - GoToNextElement(pos); - end; - peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub); - end; - until not GoToNextElement(pos); - if nbSub > 0 then OutputSub(subPathStartPos,pos); -end; - -procedure TBGRAPath.addPath(const AValue: string); -var p: integer; - numberError: boolean; - startCoord,lastCoord: TPointF; - - function parseFloat: single; - var numberStart: integer; - errPos: integer; - decimalFind: boolean; - - procedure parseFloatInternal; - begin - if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p); - decimalFind:= false; - while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do - begin - if AValue[p] = '.' then - if decimalFind then - Break - else - decimalFind:= true; - inc(p); - end; - end; - - begin - while (p <= length(AValue)) and (AValue[p] in[#0..#32,',']) do inc(p); - numberStart:= p; - parseFloatInternal; - if (p <= length(AValue)) and (AValue[p] in['e','E']) then - begin - inc(p); - parseFloatInternal; - end; - val(copy(AValue,numberStart,p-numberStart),result,errPos); - if errPos <> 0 then numberError := true; - end; - - function parseCoord(relative: boolean): TPointF; - begin - result.x := parseFloat; - result.y := parseFloat; - if relative and not isEmptyPointF(lastCoord) then result.Offset(lastCoord); - if isEmptyPointF(lastCoord) then startCoord := result; - end; - -var - command,implicitCommand: char; - relative: boolean; - c1,c2,p1: TPointF; - a: TArcDef; - largeArc: boolean; -begin - BeginSubPath; - lastCoord := EmptyPointF; - startCoord := EmptyPointF; - p := 1; - implicitCommand:= #0; - while p <= length(AValue) do - begin - command := AValue[p]; - if (command in['0'..'9','.','+','-']) and (implicitCommand <> #0) then - command := implicitCommand - else - begin - inc(p); - end; - relative := (command = lowerCase(command)); - numberError := false; - if upcase(command) in ['L','H','V','C','S','Q','T','A'] then - implicitCommand:= command; //by default the command repeats - case upcase(command) of - 'Z': begin - closePath; - implicitCommand:= #0; - lastCoord := startCoord; - end; - 'M': begin - p1 := parseCoord(relative); - if not numberError then - begin - moveTo(p1); - lastCoord := p1; - startCoord := p1; - end; - if relative then implicitCommand:= 'l' else - implicitCommand:= 'L'; - end; - 'L': begin - p1 := parseCoord(relative); - if not numberError then - begin - lineTo(p1); - lastCoord := p1; - end; - end; - 'H': begin - if not isEmptyPointF(lastCoord) then - begin - p1 := lastCoord; - if relative then IncF(p1.x, parseFloat) - else p1.x := parseFloat; - end else - begin - p1 := PointF(parseFloat,0); - lastCoord := p1; - startCoord := p1; - end; - if not numberError then - begin - lineTo(p1); - lastCoord := p1; - end; - end; - 'V': begin - if not isEmptyPointF(lastCoord) then - begin - p1 := lastCoord; - if relative then IncF(p1.y, parseFloat) - else p1.y := parseFloat; - end else - begin - p1 := PointF(0,parseFloat); - lastCoord := p1; - startCoord := p1; - end; - if not numberError then - begin - lineTo(p1); - lastCoord := p1; - end; - end; - 'C': begin - c1 := parseCoord(relative); - c2 := parseCoord(relative); - p1 := parseCoord(relative); - if not numberError then - begin - bezierCurveTo(c1,c2,p1); - lastCoord := p1; - end; - end; - 'S': begin - c2 := parseCoord(relative); - p1 := parseCoord(relative); - if not numberError then - begin - smoothBezierCurveTo(c2,p1); - lastCoord := p1; - end; - end; - 'Q': begin - c1 := parseCoord(relative); - p1 := parseCoord(relative); - if not numberError then - begin - quadraticCurveTo(c1,p1); - lastCoord := p1; - end; - end; - 'T': begin - p1 := parseCoord(relative); - if not numberError then - begin - smoothQuadraticCurveTo(p1); - lastCoord := p1; - end; - end; - 'A': - begin - a.radius.x := parseFloat; - a.radius.y := parseFloat; - a.xAngleRadCW := parseFloat*Pi/180; - largeArc := parseFloat<>0; - a.anticlockwise:= parseFloat=0; - p1 := parseCoord(relative); - if not numberError then - begin - arcTo(a.radius.x,a.radius.y,a.xAngleRadCW,largeArc,a.anticlockwise,p1.x,p1.y); - lastCoord := p1; - end; - end; - end; - end; -end; - -procedure TBGRAPath.addPath(source: IBGRAPath); -begin - source.copyTo(self); -end; - -procedure TBGRAPath.openedSpline(const pts: array of TPointF; - style: TSplineStyle); -var elem: PSplineElement; - i: Int32or64; - p: PPointF; -begin - if length(pts) = 0 then exit; - for i := 0 to high(pts) do - if isEmptyPointF(pts[i]) then - raise exception.Create('Unexpected empty point'); - if length(pts) <= 2 then - begin - polyline(pts); - exit; - end; - if not LastCoordDefined then moveTo(pts[0]); - elem := AllocateElement(peOpenedSpline, length(pts)*sizeof(TPointF)); - elem^.NbControlPoints := length(pts); - elem^.SplineStyle := style; - p := PPointF(elem+1); - for i := 0 to high(pts)-1 do - begin - p^ := FMatrix*pts[i]; - inc(p); - end; - p^ := SetLastCoord(pts[high(pts)]); - inc(p); - PInteger(p)^ := length(pts); -end; - -procedure TBGRAPath.closedSpline(const pts: array of TPointF; - style: TSplineStyle); -var elem: PSplineElement; - i: Int32or64; - p: PPointF; -begin - if length(pts) = 0 then exit; - for i := 0 to high(pts) do - if isEmptyPointF(pts[i]) then - raise exception.Create('Unexpected empty point'); - if not LastCoordDefined then moveTo(ClosedSplineStartPoint(pts, style)); - if length(pts) <= 2 then exit; - elem := AllocateElement(peClosedSpline, length(pts)*sizeof(TPointF)); - elem^.NbControlPoints := length(pts); - elem^.SplineStyle := style; - p := PPointF(elem+1); - for i := 0 to high(pts) do - begin - p^ := FMatrix*pts[i]; - inc(p); - end; - PInteger(p)^ := length(pts); -end; - -procedure TBGRAPath.BitmapDrawSubPathProc(const APoints: array of TPointF; - AClosed: boolean; AData: pointer); -begin - with TStrokeData(AData^) do - if AClosed then - begin - if Texture <> nil then - Bitmap.DrawPolygonAntialias(APoints, Texture, Width) - else - Bitmap.DrawPolygonAntialias(APoints, Color, Width); - end else - begin - if Texture <> nil then - Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Texture, Width) - else - Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Color, Width); - end; -end; - -function TBGRAPath.CorrectAcceptedDeviation(AAcceptedDeviation: single; - const AMatrix: TAffineMatrix): single; -var maxZoom: single; -begin - //determine the zoom of the matrix - maxZoom := Max(VectLen(PointF(AMatrix[1,1],AMatrix[2,1])), - VectLen(PointF(AMatrix[1,2],AMatrix[2,2]))); - //make the accepted deviation smaller if the matrix zooms to avoid that - // curves would look angular - if maxZoom = 0 then - result:= 1e10 - else - result := AAcceptedDeviation / maxZoom; -end; - -procedure TBGRAPath.OnModify; -begin - if length(FCursors)> 0 then - raise Exception.Create('You cannot modify the path when there are cursors'); -end; - -procedure TBGRAPath.OnMatrixChange; -begin - //transformed coord are not changed, - //but original coords are lost in the process. - //this has a consequence when using - //arc functions that rely on the previous - //coordinate - FLastCoord := EmptyPointF; - FSubPathStartCoord := EmptyPointF; -end; - -procedure TBGRAPath.NeedSpace(count: integer); -begin - OnModify; - inc(count, 4); //avoid memory error - if FDataPos + count > FDataCapacity then - begin - FDataCapacity := (FDataCapacity shl 1)+8; - if FDataPos + count + 8 > FDataCapacity then - FDataCapacity := FDataPos + count + 8; - ReAllocMem(FData, FDataCapacity); - end; -end; - -function TBGRAPath.AllocateElement(AElementType: TBGRAPathElementType; - AExtraBytes: PtrInt): Pointer; -var t: PtrInt; -begin - if not (AElementType in [succ(peNone)..high(TBGRAPathElementType)]) then - raise exception.Create('Invalid element type'); - OnModify; - t := PathElementSize[AElementType]+AExtraBytes; - NeedSpace(SizeOf(TPathElementHeader)+t); - with PPathElementHeader(FData+FDataPos)^ do - begin - ElementType:= AElementType; - PreviousElementType := FLastStoredElementType; - end; - result := FData+(FDataPos+SizeOf(TPathElementHeader)); - FLastSubPathElementType:= AElementType; - FLastStoredElementType:= AElementType; - Inc(FDataPos, sizeof(TPathElementHeader)+t); -end; - -procedure TBGRAPath.Init; -begin - FData := nil; - FDataCapacity := 0; - FLastMoveToDataPos := -1; - beginPath; - resetTransform; -end; - -function TBGRAPath.GoToNextElement(var APos: PtrInt): boolean; -var newPos: PtrInt; - p: PSplineElement; - elemType: TBGRAPathElementType; -begin - if APos >= FDataPos then - result := false - else - begin - elemType := PPathElementHeader(FData+APos)^.ElementType; - newPos := APos + sizeof(TPathElementHeader) + PathElementSize[elemType]; - if elemType in[peOpenedSpline,peClosedSpline] then - begin - p := PSplineElement(FData+(APos+sizeof(TPathElementHeader))); - inc(newPos, p^.NbControlPoints * sizeof(TPointF) ); //extra - end; - if newPos < FDataPos then - begin - result := true; - APos := newPos; - if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or - not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then - raise exception.Create('Internal structure error'); - end - else - result := false; - end; -end; - -function TBGRAPath.GoToPreviousElement(var APos: PtrInt): boolean; -var lastElemType: TBGRAPathElementType; -begin - if APos <= 0 then - result := false - else - begin - result := true; - if (APos = FDataPos) then - lastElemType := FLastStoredElementType - else - lastElemType := PPathElementHeader(FData+APos)^.PreviousElementType; - - if lastElemType in [peOpenedSpline,peClosedSpline] then - dec(APos, (PInteger(FData+APos)-1)^ *sizeof(TPointF)); //extra - dec(APos, sizeof(TPathElementHeader) + PathElementSize[lastElemType]); - - if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or - not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then - raise exception.Create('Internal structure error'); - end; -end; - -function TBGRAPath.PeekNextElement(APos: PtrInt): TBGRAPathElementType; -begin - if not GoToNextElement(APos) then - result := peNone - else - result := PPathElementHeader(FData+APos)^.ElementType; -end; - -function TBGRAPath.GetElementStartCoord(APos: PtrInt): TPointF; -var - elemType: TBGRAPathElementType; - elem: pointer; -begin - GetElementAt(APos, elemType, elem); - case elemType of - peNone: raise exception.Create('No element'); - peMoveTo: result := PPointF(elem)^; - else - begin - if not GoToPreviousElement(APos) then - raise exception.Create('No previous element') - else - begin - result := GetElementEndCoord(APos); - end; - end; - end; -end; - -function TBGRAPath.GetElementEndCoord(APos: PtrInt): TPointF; -var elemType: TBGRAPathElementType; - elem: pointer; -begin - GetElementAt(APos, elemType, elem); - case elemType of - peMoveTo,peLineTo,peCloseSubPath: result := PPointF(elem)^; - peQuadraticBezierTo: result := PQuadraticBezierToElement(elem)^.Destination; - peCubicBezierTo: result := PCubicBezierToElement(elem)^.Destination; - peArc: result := ArcEndPoint(PArcElement(elem)^); - peClosedSpline: result := PPointF(PSplineElement(elem)+1)^; - peOpenedSpline: result := (PPointF(PSplineElement(elem)+1)+(PSplineElement(elem)^.NbControlPoints-1))^; - else - result := EmptyPointF; - end; -end; - -function TBGRAPath.GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single; -var elemType: TBGRAPathElementType; - elem: pointer; - pts: array of TPointF; -begin - GetElementAt(APos, elemType, elem); - case elemType of - peMoveTo: result := 0; - peLineTo,peCloseSubPath: result := VectLen(PPointF(elem)^ - GetElementStartCoord(APos))*FScale; - peQuadraticBezierTo: with PQuadraticBezierToElement(elem)^ do - result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ComputeLength; - peCubicBezierTo: with PCubicBezierToElement(elem)^ do - result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ComputeLength(AAcceptedDeviation); - peArc: begin - result := VectLen(ArcStartPoint(PArcElement(elem)^) - GetElementStartCoord(APos)); - IncF(result, PolylineLen(ComputeArc(PArcElement(elem)^, DefaultDeviation/AAcceptedDeviation))); - end; - peClosedSpline,peOpenedSpline: - begin - pts := GetPolygonalApprox(APos, AAcceptedDeviation, true); - result := PolylineLen(pts) + VectLen(pts[0]-GetElementStartCoord(APos)); - end - else - result := 0; - end; -end; - -procedure TBGRAPath.GetElementAt(APos: PtrInt; out - AElementType: TBGRAPathElementType; out AElement: pointer); -begin - if APos >= FDataPos then - begin - AElementType := peNone; - AElement := nil; - end else - begin - AElementType:= PPathElementHeader(FData+APos)^.ElementType; - AElement := FData+(APos+sizeof(TPathElementHeader)); - end; -end; - -constructor TBGRAPath.Create; -begin - Init; -end; - -constructor TBGRAPath.Create(ASvgString: string); -begin - Init; - SvgString:= ASvgString; -end; - -constructor TBGRAPath.Create(const APoints: ArrayOfTPointF); -begin - Init; - SetPoints(APoints); -end; - -constructor TBGRAPath.Create(APath: IBGRAPath); -begin - Init; - APath.copyTo(self); -end; - -destructor TBGRAPath.Destroy; -var i: integer; -begin - for I := 0 to high(FCursors) do - FCursors[i].OnPathFree; - if Assigned(FData) then - begin - FreeMem(FData); - FData := nil; - end; - inherited Destroy; -end; - -procedure TBGRAPath.beginPath; -begin - DoClear; -end; - -procedure TBGRAPath.beginSubPath; -begin - OnModify; - FLastSubPathElementType := peNone; - ClearLastCoord; - FSubPathStartCoord := EmptyPointF; - FExpectedTransformedControlPoint := EmptyPointF; -end; - -procedure TBGRAPath.DoClear; -begin - OnModify; - FDataPos := 0; - BeginSubPath; -end; - -function TBGRAPath.CheckElementType(AElementType: TBGRAPathElementType): boolean; -begin - result := AElementType <= high(TBGRAPathElementType); -end; - -procedure TBGRAPath.closePath; -var - moveToType: TBGRAPathElementType; - moveToElem: pointer; -begin - if (FLastSubPathElementType <> peNone) and (FLastSubPathElementType <> peCloseSubPath) then - begin - with PClosePathElement(AllocateElement(peCloseSubPath))^ do - begin - StartCoordinate := FSubPathTransformedStartCoord; - LoopDataPos := FLastMoveToDataPos; - end; - if FLastMoveToDataPos <> -1 then - begin - GetElementAt(FLastMoveToDataPos,moveToType,moveToElem); - PMoveToElement(moveToElem)^.LoopDataPos := FDataPos; - FLastMoveToDataPos:= -1; - end; - FLastCoord := FSubPathStartCoord; - FLastTransformedCoord := FSubPathTransformedStartCoord; - end; -end; - -procedure TBGRAPath.translate(x, y: single); -begin - OnMatrixChange; - FMatrix := FMatrix * AffineMatrixTranslation(x,y); -end; - -procedure TBGRAPath.resetTransform; -begin - OnMatrixChange; - FMatrix := AffineMatrixIdentity; - FAngleRadCW := 0; - FScale:= 1; -end; - -procedure TBGRAPath.rotate(angleRadCW: single); -begin - OnMatrixChange; - FMatrix := FMatrix * AffineMatrixRotationRad(-angleRadCW); - IncF(FAngleRadCW, angleRadCW); -end; - -procedure TBGRAPath.rotateDeg(angleDeg: single); -const degToRad = Pi/180; -begin - rotate(angleDeg*degToRad); -end; - -procedure TBGRAPath.rotate(angleRadCW: single; center: TPointF); -begin - translate(center.x,center.y); - rotate(angleRadCW); - translate(-center.x,-center.y); -end; - -procedure TBGRAPath.rotateDeg(angleDeg: single; center: TPointF); -begin - translate(center.x,center.y); - rotateDeg(angleDeg); - translate(-center.x,-center.y); -end; - -procedure TBGRAPath.scale(factor: single); -begin - OnMatrixChange; - FMatrix := FMatrix * AffineMatrixScale(factor,factor); - FScale := FScale * factor; -end; - -procedure TBGRAPath.moveTo(x, y: single); -begin - moveTo(PointF(x,y)); -end; - -procedure TBGRAPath.lineTo(x, y: single); -begin - lineTo(PointF(x,y)); -end; - -procedure TBGRAPath.moveTo(constref pt: TPointF); -begin - if FLastSubPathElementType <> peMoveTo then - begin - FLastMoveToDataPos:= FDataPos; - with PMoveToElement(AllocateElement(peMoveTo))^ do - begin - StartCoordinate := SetLastCoord(pt); - LoopDataPos := -1; - end - end else - PMoveToElement(FData+(FDataPos-Sizeof(TMoveToElement)))^.StartCoordinate := SetLastCoord(pt); - FSubPathStartCoord := FLastCoord; - FSubPathTransformedStartCoord := FLastTransformedCoord; -end; - -procedure TBGRAPath.lineTo(constref pt: TPointF); -var lastTransfCoord, newTransfCoord: TPointF; -begin - if LastCoordDefined then - begin - lastTransfCoord := FLastTransformedCoord; - newTransfCoord := SetLastCoord(pt); - if newTransfCoord <> lastTransfCoord then - PPointF(AllocateElement(peLineTo))^ := newTransfCoord; - end else - moveTo(pt); -end; - -procedure TBGRAPath.polyline(const pts: array of TPointF); -var i: integer; -begin - if length(pts) = 0 then exit; - NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts)); - moveTo(pts[0]); - for i := 1 to high(pts) do lineTo(pts[i]); -end; - -procedure TBGRAPath.polylineTo(const pts: array of TPointF); -var i: integer; -begin - NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts)); - for i := 0 to high(pts) do lineTo(pts[i]); -end; - -procedure TBGRAPath.polygon(const pts: array of TPointF); -var lastPt: integer; -begin - if length(pts) = 0 then exit; - lastPt := high(pts); - while (lastPt > 1) and (pts[lastPt] = pts[0]) do dec(lastPt); - if lastPt <> high(pts) then - polyline(slice(pts,lastPt+1)) - else - polyline(pts); - closePath; -end; - -procedure TBGRAPath.quadraticCurveTo(cpx, cpy, x, y: single); -begin - quadraticCurveTo(PointF(cpx,cpy),PointF(x,y)); -end; - -procedure TBGRAPath.quadraticCurveTo(constref cp, pt: TPointF); -begin - if LastCoordDefined then - QuadraticCurveFromTransformed(FMatrix*cp, pt) else - begin - lineTo(pt); - FExpectedTransformedControlPoint := FMatrix*(pt+(pt-cp)); - end; -end; - -procedure TBGRAPath.bezierCurveTo(cp1x, cp1y, cp2x, cp2y, x, y: single); -begin - bezierCurveTo(PointF(cp1x,cp1y),PointF(cp2x,cp2y),PointF(x,y)); -end; - -procedure TBGRAPath.bezierCurveTo(constref cp1, cp2, pt: TPointF); -begin - if not LastCoordDefined then moveTo(cp1); - BezierCurveFromTransformed(FMatrix*cp1, cp2, pt); -end; - -procedure TBGRAPath.bezierCurve(const curve: TCubicBezierCurve); -begin - moveTo(curve.p1); - bezierCurveTo(curve.c1,curve.c2,curve.p2); -end; - -procedure TBGRAPath.bezierCurve(p1, cp1, cp2, p2: TPointF); -begin - moveTo(p1); - bezierCurveTo(cp1,cp2,p2); -end; - -procedure TBGRAPath.smoothBezierCurveTo(cp2x, cp2y, x, y: single); -begin - smoothBezierCurveTo(PointF(cp2x,cp2y),PointF(x,y)); -end; - -procedure TBGRAPath.smoothBezierCurveTo(const cp2, pt: TPointF); -begin - if (FLastSubPathElementType = peCubicBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then - BezierCurveFromTransformed(FExpectedTransformedControlPoint,cp2,pt) - else if LastCoordDefined then - BezierCurveFromTransformed(FLastTransformedCoord,cp2,pt) - else - bezierCurveTo(cp2,cp2,pt); -end; - -procedure TBGRAPath.quadraticCurve(const curve: TQuadraticBezierCurve); -begin - moveTo(curve.p1); - quadraticCurveTo(curve.c,curve.p2); -end; - -procedure TBGRAPath.quadraticCurve(p1, cp, p2: TPointF); -begin - moveTo(p1); - quadraticCurveTo(cp,p2); -end; - -procedure TBGRAPath.smoothQuadraticCurveTo(x, y: single); -begin - smoothQuadraticCurveTo(PointF(x,y)); -end; - -procedure TBGRAPath.smoothQuadraticCurveTo(const pt: TPointF); -begin - if (FLastSubPathElementType = peQuadraticBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then - QuadraticCurveFromTransformed(FExpectedTransformedControlPoint,pt) - else if LastCoordDefined then - QuadraticCurveFromTransformed(FLastTransformedCoord,pt) - else - quadraticCurveTo(pt,pt); -end; - -procedure TBGRAPath.rect(x, y, w, h: single); -begin - moveTo(x,y); - lineTo(x+w,y); - lineTo(x+w,y+h); - lineTo(x,y+h); - closePath; -end; - -procedure TBGRAPath.roundRect(x, y, w, h, radius: single); -begin - if radius <= 0 then - begin - rect(x,y,w,h); - exit; - end; - if (w <= 0) or (h <= 0) then exit; - if radius*2 > w then radius := w/2; - if radius*2 > h then radius := h/2; - moveTo(x+radius,y); - arcTo(PointF(x+w,y),PointF(x+w,y+h), radius); - arcTo(PointF(x+w,y+h),PointF(x,y+h), radius); - arcTo(PointF(x,y+h),PointF(x,y), radius); - arcTo(PointF(x,y),PointF(x+w,y), radius); - closePath; -end; - -procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single; - anticlockwise: boolean); -begin - arc(cx,cy,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise); -end; - -procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single); -begin - arc(cx,cy,radius,startAngleRadCW,endAngleRadCW,false); -end; - -procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single; - anticlockwise: boolean); -const degToRad = Pi/180; -begin - arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad,anticlockwise); -end; - -procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single); -const degToRad = Pi/180; -begin - arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad); -end; - -procedure TBGRAPath.arcTo(x1, y1, x2, y2, radius: single); -begin - arcTo(PointF(x1,y1), PointF(x2,y2), radius); -end; - -procedure TBGRAPath.arcTo(const p1, p2: TPointF; radius: single); -var p0 : TPointF; -begin - if IsEmptyPointF(FLastCoord) then - p0 := p1 else p0 := FLastCoord; - arc(Html5ArcTo(p0,p1,p2,radius)); -end; - -procedure TBGRAPath.arc(constref arcDef: TArcDef); -var transformedArc: TArcElement; -begin - if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then - lineTo(arcDef.center) - else - begin - if not LastCoordDefined then - moveTo(ArcStartPoint(arcDef)); - transformedArc.anticlockwise := arcDef.anticlockwise; - transformedArc.startAngleRadCW := arcDef.startAngleRadCW; - transformedArc.endAngleRadCW := arcDef.endAngleRadCW; - transformedArc.center := FMatrix*arcDef.center; - transformedArc.radius := arcDef.radius*FScale; - transformedArc.xAngleRadCW := arcDef.xAngleRadCW+FAngleRadCW; - PArcElement(AllocateElement(peArc))^ := transformedArc; - {$PUSH}{$OPTIMIZATION OFF} - SetLastCoord(ArcEndPoint(arcDef)); - {$POP} - end; -end; - -procedure TBGRAPath.arc(cx, cy, rx, ry: single; xAngleRadCW, startAngleRadCW, - endAngleRadCW: single); -begin - arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false)); -end; - -procedure TBGRAPath.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; - anticlockwise: boolean); -begin - arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise)); -end; - -procedure TBGRAPath.arcTo(rx, ry, xAngleRadCW: single; largeArc, - anticlockwise: boolean; x, y: single); -begin - if IsEmptyPointF(FLastCoord) then - moveTo(x,y) - else - arc(SvgArcTo(FLastCoord, rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y))); -end; - -procedure TBGRAPath.copyTo(dest: IBGRAPath); -var pos: IntPtr; - elemType: TBGRAPathElementType; - elem: Pointer; - pts: array of TPointF; -begin - pos := 0; - repeat - GetElementAt(pos, elemType, elem); - if elem = nil then break; - case elemType of - peMoveTo: dest.moveTo(PPointF(elem)^); - peLineTo: dest.lineTo(PPointF(elem)^); - peCloseSubPath: dest.closePath; - peQuadraticBezierTo: - with PQuadraticBezierToElement(elem)^ do - dest.quadraticCurveTo(ControlPoint,Destination); - peCubicBezierTo: - with PCubicBezierToElement(elem)^ do - dest.bezierCurveTo(ControlPoint1,ControlPoint2,Destination); - peArc: dest.arc(PArcElement(elem)^); - peOpenedSpline, peClosedSpline: - begin - with PSplineElement(elem)^ do - begin - setlength(pts, NbControlPoints); - move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF)); - if elemType = peOpenedSpline then - dest.openedSpline(pts, SplineStyle) - else - dest.closedSpline(pts, SplineStyle); - pts := nil; - end; - end; - end; - until not GoToNextElement(pos); -end; - -initialization - - BGRAPathFactory := TBGRAPath; - -end. - diff --git a/components/bgrabitmap/bgrapen.pas b/components/bgrabitmap/bgrapen.pas deleted file mode 100644 index 2d07d84..0000000 --- a/components/bgrabitmap/bgrapen.pas +++ /dev/null @@ -1,1324 +0,0 @@ -unit BGRAPen; - -{$mode objfpc}{$H+} - -interface - -{ This unit handles pen style and width, as well as line caps and join styles. - - A line consists in two points. - A polyline consists in one or more lines, defined by two points or more than two points - A poly-polyline consists in a series of polylines, defined by polyline points separated by empty points (see EmptyPointF) } - -uses - SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATransform; - -var //predefined pen styles - SolidPenStyle, DashPenStyle, DotPenStyle, DashDotPenStyle, DashDotDotPenStyle, ClearPenStyle: TBGRAPenStyle; - -type - TPenJoinStyle = BGRAGraphics.TPenJoinStyle; - TPenEndCap = BGRAGraphics.TPenEndCap; - - { TBGRAPenStroker } - - TBGRAPenStroker = class(TBGRACustomPenStroker) - protected - { Pen style can be defined by PenStyle property of by CustomPenStyle property. - When PenStyle property is assigned, CustomPenStyle property is assigned the actual - pen pattern. } - FCustomPenStyle: TBGRAPenStyle; - FPenStyle: TPenStyle; - FArrow: TBGRACustomArrow; - FArrowOwned: boolean; - FOriginalStrokeMatrix,FStrokeMatrix,FStrokeMatrixInverse: TAffineMatrix; - FStrokeZoom: single; - FStrokeMatrixIdentity: boolean; - FLineCap: TPenEndCap; - FJoinStyle: TPenJoinStyle; - FMiterLimit: single; - - function GetArrow: TBGRACustomArrow; override; - function GetArrowOwned: boolean; override; - function GetCustomPenStyle: TBGRAPenStyle; override; - function GetJoinStyle: TPenJoinStyle; override; - function GetLineCap: TPenEndCap; override; - function GetMiterLimit: single; override; - function GetPenStyle: TPenStyle; override; - function GetStrokeMatrix: TAffineMatrix; override; - procedure SetArrow(AValue: TBGRACustomArrow); override; - procedure SetArrowOwned(AValue: boolean); override; - procedure SetCustomPenStyle(AValue: TBGRAPenStyle); override; - procedure SetJoinStyle(AValue: TPenJoinStyle); override; - procedure SetLineCap(AValue: TPenEndCap); override; - procedure SetMiterLimit(AValue: single); override; - procedure SetPenStyle(AValue: TPenStyle); override; - procedure SetStrokeMatrix(const AValue: TAffineMatrix); override; - public - constructor Create; - destructor Destroy; override; - function ComputePolyline(const APoints: array of TPointF; AWidth: single; AClosedCap: boolean = true): ArrayOfTPointF; overload; override; - function ComputePolyline(const APoints: array of TPointF; AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean = true): ArrayOfTPointF; overload; override; - function ComputePolylineAutocycle(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; override; - function ComputePolygon(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; override; - - end; - - TBGRAPolyLineOption = (plRoundCapOpen, //specifies that the line ending is opened - plCycle, //specifies that it is a polygon - plAutoCycle, //specifies that a cycle must be used if the last point is the first point - plNoStartCap, - plNoEndCap); - TBGRAPolyLineOptions = set of TBGRAPolyLineOption; - TComputeArrowHeadProc = function(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF of object; - -{ Compute the path for a polyline } -function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single; - pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; - options: TBGRAPolyLineOptions; miterLimit: single = 2; arrow: TBGRACustomArrow = nil): ArrayOfTPointF; - -{ Compute the path for a poly-polyline } -function ComputeWidePolyPolylinePoints(const linepts: array of TPointF; width: single; - pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; - options: TBGRAPolyLineOptions; miterLimit: single = 2; arrow: TBGRACustomArrow = nil): ArrayOfTPointF; - -{--------------------- Pixel line procedures --------------------------} -{ These procedures take integer coordinates as parameters and do not handle pen styles and width. - They are faster and can be useful for drawing a simple frame } - -//aliased version -procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode = dmDrawWithTransparency); deprecated; -procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); deprecated; - -//antialiased version -procedure BGRADrawLineAntialias({%H-}dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; - c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean = false); overload; deprecated; -procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; - calpha: byte; DrawLastPixel: boolean); overload; deprecated; - -//antialiased version with bicolor dashes (to draw a frame) -procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; - c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean = false); overload; deprecated; - -//length added to ensure accepable alpha join (using TBGRAMultishapeFiller is still better) -function GetAlphaJoinFactor(alpha: byte): single; - -//create standard brush texture -function CreateBrushTexture(prototype: TBGRACustomBitmap; brushstyle: TBrushStyle; PatternColor, BackgroundColor: TBGRAPixel; - width: integer = 8; height: integer = 8; penwidth: single = 1): TBGRACustomBitmap; - -//check special pen styles -function IsSolidPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; -function IsClearPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; -function DuplicatePenStyle(ACustomPenStyle: array of single): TBGRAPenStyle; -function PenStyleEqual(AStyle1, AStyle2: TBGRAPenStyle): boolean; -function BGRAToPenStyle(ACustomPenStyle: TBGRAPenStyle): TPenStyle; -function PenStyleToBGRA(APenStyle: TPenStyle): TBGRAPenStyle; - -implementation - -uses math, BGRAClasses, BGRAPath; - -procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; - c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode); -begin - dest.DrawLine(x1,y1,x2,y2, c,DrawLastPixel, ADrawMode); -end; - -procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, - y2: integer; alpha: byte; DrawLastPixel: boolean); -begin - dest.EraseLine(x1,y1,x2,y2,alpha,DrawLastPixel); -end; - -procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; - c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean); -var - b: TUniversalBrush; -begin - if c.alpha = 0 then exit; - if LinearBlend then - dest.SolidBrush(b, c,dmLinearBlend) - else - dest.SolidBrush(b, c,dmDrawWithTransparency); - dest.DrawLineAntialias(x1,y1,x2,y2, b,DrawLastPixel); -end; - -procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, - y2: integer; calpha: byte; DrawLastPixel: boolean); -begin - dest.EraseLineAntialias(x1,y1,x2,y2,calpha,DrawLastPixel); -end; - -procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; - c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean); -var - b1, b2: TUniversalBrush; -begin - if (c1.alpha=0) and (c2.alpha=0) then exit; - if LinearBlend then - begin - dest.SolidBrush(b1, c1,dmLinearBlend); - dest.SolidBrush(b2, c2,dmLinearBlend); - end - else - begin - dest.SolidBrush(b1, c1,dmDrawWithTransparency); - dest.SolidBrush(b2, c2,dmDrawWithTransparency); - end; - dest.DrawLineAntialias(x1,y1,x2,y2, b1,b2, dashLen,dashPos,DrawLastPixel); -end; - -function GetAlphaJoinFactor(alpha: byte): single; -var t: single; -begin - if alpha = 255 then result := 1 else - begin - result := (power(20,alpha/255)-1)/19*0.5; - t := power(alpha/255,40); - result := result*(1-t)+t*0.82; - end; -end; - -function CreateBrushTexture(prototype: TBGRACustomBitmap; brushstyle: TBrushStyle; - PatternColor, BackgroundColor: TBGRAPixel; width: integer = 8; height: integer = 8; penwidth: single = 1): TBGRACustomBitmap; -begin - result := prototype.CreateBrushTexture(brushstyle, PatternColor, BackgroundColor, width,height, penwidth); -end; - -function IsSolidPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; -begin - result := ACustomPenStyle = nil; -end; - -function IsClearPenStyle(ACustomPenStyle: TBGRAPenStyle): boolean; -begin - if (length(ACustomPenStyle)=1) and (ACustomPenStyle[0]=0) then - result := true - else - result := false; -end; - -function DuplicatePenStyle(ACustomPenStyle: array of single): TBGRAPenStyle; -var - i: Integer; -begin - setlength(result,length(ACustomPenStyle)); - for i := 0 to high(result) do - result[i]:= ACustomPenStyle[i]; -end; - -function BGRAToPenStyle(ACustomPenStyle: TBGRAPenStyle): TPenStyle; -begin - if IsSolidPenStyle(ACustomPenStyle) then exit(psSolid); - if IsClearPenStyle(ACustomPenStyle) then exit(psClear); - if PenStyleEqual(ACustomPenStyle, DashPenStyle) then exit(psDash); - if PenStyleEqual(ACustomPenStyle, DotPenStyle) then exit(psDot); - if PenStyleEqual(ACustomPenStyle, DashDotPenStyle) then exit(psDashDot); - if PenStyleEqual(ACustomPenStyle, DashDotDotPenStyle) then exit(psDashDotDot); - exit(psPattern); -end; - -function PenStyleToBGRA(APenStyle: TPenStyle): TBGRAPenStyle; -begin - Case APenStyle of - psSolid: result := SolidPenStyle; - psDash: result := DashPenStyle; - psDot: result := DotPenStyle; - psDashDot: result := DashDotPenStyle; - psDashDotDot: result := DashDotDotPenStyle; - else result := ClearPenStyle; - end; -end; - -function PenStyleEqual(AStyle1, AStyle2: TBGRAPenStyle): boolean; -var - i: Integer; -begin - if length(AStyle1)<>length(AStyle2) then exit(false); - for i := 0 to high(AStyle1) do - if AStyle1[i] <> AStyle2[i] then exit(false); - exit(true); -end; - -procedure ApplyPenStyle(const leftPts, rightPts: array of TPointF; const penstyle: TBGRAPenStyle; - width: single; var posstyle: single; out styledPts: ArrayOfTPointF); -var - styleIndex :integer; - remainingDash: single; - - procedure NextStyleIndex; - begin - inc(styleIndex); - if styleIndex = length(penstyle) then - styleIndex := 0; - IncF(remainingDash, penstyle[styleindex]); - end; - -var - dashStartIndex: integer; - dashLeftStartPos,dashRightStartPos : TPointF; - betweenDash: boolean; - - procedure StartDash(index: integer; t: single); - begin - dashStartIndex := index; - if t = 0 then - begin - dashLeftStartPos := leftPts[index]; - dashRightStartPos := rightPts[index]; - end else - begin - dashLeftStartPos := leftPts[index] + (leftPts[index+1]-leftPts[index])*t; - dashRightStartPos := rightPts[index] + (rightPts[index+1]-rightPts[index])*t; - end; - betweenDash := false; - end; - -var - nbStyled: integer; - - procedure AddPt(pt: TPointF); - begin - if (nbStyled = 0) or (pt <> styledPts[nbStyled-1]) then - begin - if nbStyled = length(styledPts) then - setlength(styledPts,nbStyled*2+4); - styledPts[nbStyled] := pt; - inc(nbStyled); - end; - end; - - procedure StartPolygon; - begin - if nbStyled > 0 then AddPt(EmptyPointF); - end; - - procedure EndDash(index: integer; t: single); - var dashLeftEndPos,dashRightEndPos: TPointF; - i: Integer; - begin - if t=0 then - begin - dashLeftEndPos := leftPts[index]; - dashRightEndPos := rightPts[index]; - end else - begin - dashLeftEndPos := leftPts[index] + (leftPts[index+1]-leftPts[index])*t; - dashRightEndPos := rightPts[index] + (rightPts[index+1]-rightPts[index])*t; - end; - StartPolygon; - AddPt(dashLeftStartPos); - for i := dashStartIndex+1 to index do - AddPt(leftPts[i]); - AddPt(dashLeftEndPos); - AddPt(dashRightEndPos); - for i := index downto dashStartIndex+1 do - AddPt(rightPts[i]); - AddPt(dashRightStartPos); - betweenDash := true; - end; - -var - i,nb: integer; - styleLength: single; - len,lenDone: single; - -begin - nbStyled := 0; - styledPts := nil; - if IsClearPenStyle(penstyle) then exit; - if IsSolidPenStyle(penstyle) then - begin - for i := 0 to high(leftPts) do AddPt(leftPts[i]); - for i := high(rightPts) downto 0 do AddPt(rightPts[i]); - setlength(styledPts,nbStyled); - exit; - end; - if length(leftPts) <> length(rightPts) then - raise Exception.Create('Dimension mismatch'); - nb := length(leftPts); - if length(penstyle) mod 2 <> 0 then - raise Exception.Create('Pen style must contain an even number of values'); - styleLength := 0; - styleIndex := -1; - remainingDash := 0; - betweenDash := false; - for i := 0 to high(penstyle) do - if penstyle[i] <= 0 then - raise Exception.Create('Invalid pen dash length') - else - begin - IncF(styleLength, penstyle[i]); - if styleLength >= posstyle then - begin - styleIndex := i; - remainingDash := styleLength-posstyle; - break; - end; - end; - if styleIndex = -1 then - begin - styleIndex := 0; - remainingDash := penstyle[0]; - end; - - if styleIndex mod 2 = 0 then - StartDash(0, 0) else - betweenDash := true; - for i := 0 to nb-2 do - begin - len := (sqrt(sqr(leftPts[i+1].x-leftPts[i].x) + sqr(leftPts[i+1].y-leftPts[i].y))+ - sqrt(sqr(rightPts[i+1].x-rightPts[i].x) + sqr(rightPts[i+1].y-rightPts[i].y)))/(2*width); - lenDone := 0; - while lenDone < len do - begin - if len-lenDone < remainingDash then - begin - DecF(remainingDash, len-lenDone); - if remainingDash = 0 then NextStyleIndex; - lenDone := len; - end else - if betweenDash then - begin - IncF(lenDone, remainingDash); - StartDash(i, lenDone/len); - remainingDash := 0; - NextStyleIndex; - end else - begin - IncF(lenDone, remainingDash); - EndDash(i, lenDone/len); - remainingDash := 0; - NextStyleIndex; - end; - end; - end; - if not betweenDash then - EndDash(nb-1,0); - setlength(styledPts,nbStyled); -end; - -function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single; - pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; - options: TBGRAPolyLineOptions; miterLimit: single; arrow: TBGRACustomArrow): ArrayOfTPointF; -const oneOver512 = 1/512; -var - startArrowPos, startArrowDir, endArrowPos, endArrowDir: TPointF; - startArrowLinePos, endArrowLinePos: single; - borders : array of record - leftSide,rightSide: TLineDef; - len: single; - leftDir: TPointF; - end; - compPts: array of TPointF; - nbCompPts: integer; - revCompPts: array of TPointF; - nbRevCompPts: integer; - pts: array of TPointF; - roundPrecision: integer; - hw: single; //half-width - - procedure AddPt(normal,rev: TPointF); overload; - begin - if (nbCompPts > 0) and (compPts[nbCompPts-1]=normal) and - (nbRevCompPts > 0) and (revCompPts[nbRevCompPts-1]=rev) then exit; - - if nbCompPts = length(compPts) then - setlength(compPts, length(compPts)*2); - compPts[nbCompPts] := normal; - inc(nbCompPts); - - if nbRevCompPts = length(revCompPts) then - setlength(revCompPts, length(revCompPts)*2); - revCompPts[nbRevCompPts] := rev; - inc(nbRevCompPts); - end; - - procedure AddPt(xnormal,ynormal: single; xrev,yrev: single); overload; - begin - AddPt(PointF(xnormal,ynormal),PointF(xrev,yrev)); - end; - - procedure AddRoundCap(origin: TPointF; dir: TPointF; fromCenter: boolean; flipped: boolean= false); - var i: integer; - a,s,c: single; - offset,flipvalue: single; - begin - if fromCenter then offset := 0 else offset := -Pi/2; - if flipped then flipvalue := -1 else flipvalue := 1; - for i := 1 to RoundPrecision do - begin - a := i/(RoundPrecision+1)*Pi/2 + offset; - s := sin(a)*hw*flipvalue; - c := cos(a)*hw; - AddPt( PointF(origin.x+ dir.x*c - dir.y*s, origin.y + dir.y*c + dir.x*s), - PointF(origin.x+ dir.x*c + dir.y*s, origin.y + dir.y*c - dir.x*s) ); - end; - end; - - procedure AddRoundCapAlphaJoin(origin: TPointF; dir: TPointF; fromCenter: boolean; flipped: boolean= false); - var i: integer; - a,s,c: single; - offset,flipvalue: single; - t,alphaFactor: single; //antialiasing join - begin - if fromCenter then offset := 0 else offset := -Pi/2; - if flipped then flipvalue := -1 else flipvalue := 1; - - alphaFactor := GetAlphaJoinFactor(pencolor.alpha); - - for i := 1 to RoundPrecision do - begin - a := i/(RoundPrecision+1)*Pi/2 + offset; - s := sin(a)*hw*flipvalue; - c := cos(a); - t := (1 - c) * (0.2 + alphaFactor*0.3) + alphaFactor; - c := c * hw; - AddPt( PointF(origin.x+ dir.x*(c-t) - dir.y*s, origin.y + dir.y*(c-t) + dir.x*s), - PointF(origin.x+ dir.x*(c-t) + dir.y*s, origin.y + dir.y*(c-t) - dir.x*s) ); - end; - end; - - function ComputeRoundJoin(origin, pt1,pt2: TPointF): ArrayOfTPointF; - var a1,a2: single; - da: single; - precision,i: integer; - begin - a1 := arctan2(pt1.y-origin.y,pt1.x-origin.x); - a2 := arctan2(pt2.y-origin.y,pt2.x-origin.x); - if a2-a1 > Pi then DecF(a2, 2*Pi); - if a1-a2 > Pi then DecF(a1, 2*Pi); - if a2=a1 then - begin - setlength(result,1); - result[0] := pt1; - exit; - end; - da := a2-a1; - precision := round( sqrt( sqr(pt2.x-pt1.x)+sqr(pt2.y-pt1.y) ) ) +2; - setlength(result,precision); - for i := 0 to precision-1 do - result[i] := origin + PointF( cos(a1+i/(precision-1)*da)*hw, - sin(a1+i/(precision-1)*da)*hw ); - end; - -var - joinLeft,joinRight: array of TPointF; - nbJoinLeft,nbJoinRight: integer; - - procedure SetJoinLeft(joinpts: array of TPointF); - var i: integer; - begin - nbJoinLeft := length(joinpts); - if length(joinLeft) < nbJoinLeft then setlength(joinLeft,length(joinLeft)+nbJoinLeft+2); - for i := 0 to nbJoinLeft-1 do - joinLeft[i] := joinpts[i]; - end; - - procedure SetJoinRight(joinpts: array of TPointF); - var i: integer; - begin - nbJoinRight := length(joinpts); - if length(joinRight) < nbJoinRight then setlength(joinRight,length(joinRight)+nbJoinRight+2); - for i := 0 to nbJoinRight-1 do - joinRight[i] := joinpts[i]; - end; - - procedure AddJoin(index: integer); - var len,i: integer; - begin - len := nbJoinLeft; - if nbJoinRight > len then - len := nbJoinRight; - if len = 0 then exit; - if (len > 1) and (index <> -1) then - begin - if nbJoinLeft=1 then - AddPt(joinLeft[0], joinLeft[0] - 2*borders[Index].leftDir) else - if nbJoinRight=1 then - AddPt( joinRight[0] + 2* borders[index].leftDir, joinRight[0]); - end; - for i := 0 to len-1 do - begin - AddPt(joinLeft[i*nbJoinLeft div len], - joinRight[i*nbJoinRight div len]); - end; - if (len > 1) and (index <> -1) then - begin - if nbJoinLeft=1 then - AddPt(joinLeft[0], joinLeft[0] - 2*borders[index+1].leftDir) else - if nbJoinRight=1 then - AddPt(joinRight[0]+2*borders[index+1].leftDir, joinRight[0]); - end; - end; - -var - NbPolyAcc: integer; - - procedure FlushLine(lastPointIndex: integer); - var - enveloppe: arrayOfTPointF; - posstyle: single; - i,idxInsert: Integer; - begin - if lastPointIndex <> -1 then - AddPt( pts[lastPointIndex] + borders[lastPointIndex-1].leftDir, - pts[lastPointIndex] - borders[lastPointIndex-1].leftDir); - - if (lastPointIndex = high(pts)) and (linecap = pecRound) and not (plNoEndCap in options) then - begin - if not (plRoundCapOpen in options) then - AddRoundCap(pts[high(pts)],borders[high(pts)-1].leftSide.dir,false) - else - AddRoundCapAlphaJoin(pts[high(pts)], - -borders[high(pts)-1].leftSide.dir, false,true); - end; - posstyle := 0; - ApplyPenStyle(slice(compPts,nbCompPts),slice(revCompPts,nbRevCompPts),penstyle,width,posstyle,enveloppe); - - if Result=nil then - begin - Result := enveloppe; - NbPolyAcc := length(enveloppe); - end - else - if enveloppe <> nil then - begin - if NbPolyAcc +1+length(enveloppe) > length(Result) then - setlength(Result, length(Result)*2+1+length(enveloppe)); - - idxInsert := NbPolyAcc+1; - Result[idxInsert-1] := EmptyPointF; - for i := 0 to high(enveloppe) do - Result[idxInsert+i]:= enveloppe[i]; - inc(NbPolyAcc, length(enveloppe)+1); - end; - - nbCompPts := 0; - nbRevCompPts := 0; - end; - - procedure CycleFlush; - var idx: integer; - begin - if Result = nil then - begin - if (nbCompPts > 1) and (nbRevCompPts > 1) then - begin - compPts[0] := compPts[nbCompPts-1]; - revCompPts[0] := revCompPts[nbRevCompPts-1]; - end; - FlushLine(-1); - end else - begin - if (nbCompPts >= 1) and (nbRevCompPts >= 1) and (NbPolyAcc >= 2) then - begin - Result[0] := compPts[nbCompPts-1]; - idx := 0; - while (idx < high(Result)) and (not isEmptyPointF(Result[idx+1])) do inc(idx); - Result[idx] := revCompPts[nbRevCompPts-1]; - end; - FlushLine(-1); - end; - end; - - procedure FinalizeArray; - var arrowStartData, arrowEndData: ArrayOfTPointF; - finalNb,i,delta: integer; - hasStart,hasEnd: boolean; - begin - if assigned(arrow) and not isEmptyPointF(startArrowPos) then - arrowStartData := arrow.ComputeStartAt(startArrowPos, startArrowDir, width, startArrowLinePos) - else - arrowStartData := nil; - if assigned(arrow) and not isEmptyPointF(endArrowPos) then - arrowEndData := arrow.ComputeEndAt(endArrowPos, endArrowDir, width, endArrowLinePos) - else - arrowEndData := nil; - hasStart := length(arrowStartData)>0; - hasEnd := length(arrowEndData)>0; - finalNb := NbPolyAcc; - if hasStart then - begin - delta := length(arrowStartData)+1; - inc(finalNb, delta); - end else delta := 0; - if hasEnd then inc(finalNb, length(arrowEndData)+1); - SetLength(Result, finalNb); - if hasStart then - begin - for i := NbPolyAcc-1 downto 0 do - result[i+delta] := result[i]; - result[delta-1] := EmptyPointF; - for i := 0 to high(arrowStartData) do - result[i] := arrowStartData[i]; - end; - if hasEnd then - begin - inc(delta, NbPolyAcc+1); - result[delta-1] := EmptyPointF; - for i := 0 to high(arrowEndData) do - result[i+delta] := arrowEndData[i]; - end; - end; - -var - i: integer; - dir: TPointF; - leftInter,rightInter,diff: TPointF; - len,maxMiter: single; - littleBorder: TLineDef; - turn,maxDiff: single; - nbPts: integer; - ShouldFlushLine, HasLittleBorder, NormalRestart: Boolean; - pt1,pt2,pt3,pt4: TPointF; - linePos: single; - startArrowDone,endArrowDone: boolean; - wantedStartArrowPos,wantedEndArrowPos: single; - -begin - Result := nil; - - if (length(linepts)=0) or (width = 0) then exit; - if IsClearPenStyle(penstyle) then exit; - for i := 0 to high(linepts) do - if isEmptyPointF(linepts[i]) then - begin - result := ComputeWidePolyPolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrow); - exit; - end; - - if (plAutoCycle in options) and (length(linepts) >= 2) and (linepts[0]=linepts[high(linepts)]) then - options := options + [plCycle]; - if plNoEndCap in options then options := options - [plRoundCapOpen]; - - hw := width / 2; - case joinstyle of - pjsBevel,pjsRound: maxMiter := hw*1.001; - pjsMiter: if miterLimit < 1.001 then maxMiter := hw*1.001 else - maxMiter := hw*miterLimit; - else - raise Exception.Create('Unknown join style'); - end; - - roundPrecision := round(hw)+2; - - nbPts := 0; - setlength(pts, length(linepts)+2); - for i := 0 to high(linepts) do - if (nbPts = 0) or (abs(linepts[i].x-pts[nbPts-1].x)>oneOver512) or (abs(linepts[i].y-pts[nbPts-1].y)>oneOver512) then - begin - pts[nbPts]:= linePts[i]; - inc(nbPts); - end; - if (nbPts > 1) and (plCycle in options) and - (abs(pts[0].x-pts[nbPts-1].x)<=oneOver512) and - (abs(pts[0].y-pts[nbPts-1].y)<=oneOver512) then dec(nbPts); - if (plCycle in options) and (nbPts > 2) then - begin - if (pts[nbPts-1] <> pts[0]) then - begin - pts[nbPts] := pts[0]; - inc(nbPts); - end; - pts[nbPts] := pts[1]; - inc(nbPts); - end else - exclude(options, plCycle); - - setlength(pts,nbPts); - - if nbPts = 1 then - begin - if (linecap <> pecFlat) and ((linecap <> pecRound) or not (plRoundCapOpen in options)) then - result := ComputeEllipse(pts[0].x,pts[0].y,hw,hw); - exit; - end; - - startArrowDir := EmptyPointF; - startArrowPos := EmptyPointF; - endArrowDir := EmptyPointF; - endArrowPos := EmptyPointF; - if Assigned(arrow) then - begin - wantedStartArrowPos:= arrow.StartOffsetX; - wantedEndArrowPos:= arrow.EndOffsetX; - startArrowDone := not arrow.IsStartDefined; - endArrowDone := not arrow.IsEndDefined; - end - else - begin - wantedStartArrowPos:= 0; - wantedEndArrowPos:= 0; - startArrowDone := true; - endArrowDone := true; - end; - - //init computed points arrays - setlength(compPts, length(pts)*2+4); - setlength(revCompPts, length(pts)*2+4); //reverse order array - nbCompPts := 0; - nbRevCompPts := 0; - NbPolyAcc := 0; - - if not endArrowDone then - begin - wantedEndArrowPos:= -wantedEndArrowPos*width; - linePos := 0; - for i := high(pts) downto 1 do - begin - dir := pts[i-1]-pts[i]; - len := VectLen(dir); - dir.Scale(1/len); - if not endArrowDone and (linePos+len >= wantedEndArrowPos) then - begin - endArrowPos := pts[i]; - endArrowDir := -dir; - endArrowLinePos := -linePos/width; - endArrowDone := true; - break; - end; - IncF(linePos, len); - end; - end; - - wantedStartArrowPos:= -wantedStartArrowPos*width; - linePos := 0; - //compute borders - setlength(borders, length(pts)-1); - for i := 0 to high(pts)-1 do - begin - dir := pts[i+1]-pts[i]; - len := VectLen(dir); - dir.Scale(1/len); - if not startArrowDone and (linePos+len >= wantedStartArrowPos) then - begin - startArrowPos := pts[i]; - startArrowDir := -dir; - startArrowLinePos := -linePos/width; - startArrowDone := true; - end; - if (linecap = pecSquare) and ((not (plNoStartCap in options) and (i=0)) or - (not (plNoEndCap in options) and (i=high(pts)-1))) then //for square cap, just start and end further - begin - if i=0 then - pts[0].Offset(dir*(-hw)); - - if (i=high(pts)-1) then - pts[high(pts)].Offset(dir*hw); - - //length changed - dir := pts[i+1]-pts[i]; - len := VectLen(dir); - dir.Scale(1/len); - end else - if not (plNoStartCap in options) and (linecap = pecRound) and (i=0) and not (plCycle in options) then - AddRoundCap(pts[0], -dir ,true); - - borders[i].len := len; - borders[i].leftDir := PointF(dir.y*hw,-dir.x*hw); - borders[i].leftSide.origin := pts[i] + borders[i].leftDir; - borders[i].leftSide.dir := dir; - borders[i].rightSide.origin := pts[i] - borders[i].leftDir; - borders[i].rightSide.dir := dir; - IncF(linePos, len); - end; - - //first points - AddPt( pts[0] + borders[0].leftDir, - pts[0] - borders[0].leftDir ); - - setlength(joinLeft,1); - setlength(joinRight,1); - ShouldFlushLine := False; - //between first and last points - for i := 0 to high(pts)-2 do - begin - HasLittleBorder := false; - - //determine u-turn - turn := borders[i].leftSide.dir * borders[i+1].leftSide.dir; - if turn < -0.99999 then - begin - if joinstyle <> pjsRound then - begin - littleBorder.origin := pts[i+1] + borders[i].leftSide.dir*maxMiter; - littleBorder.dir := borders[i].leftDir; - HasLittleBorder := true; - nbJoinLeft := 0; - nbJoinRight:= 0; - ShouldFlushLine := True; - end else - begin - pt1 := pts[i+1] + borders[i].leftDir; - pt2 := pts[i+1] + borders[i].leftSide.dir*hw; - SetJoinLeft(ComputeRoundJoin(pts[i+1],pt1,pt2)); - pt1 := pts[i+1] - borders[i].leftDir; - SetJoinRight(ComputeRoundJoin(pts[i+1],pt1,pt2)); - AddJoin(-1); - FlushLine(-1); - nbJoinLeft := 0; - nbJoinRight:= 0; - AddPt(pts[i+1]+borders[i+1].leftDir, - pts[i+1]-borders[i+1].leftDir); - end; - end else - if turn > 0.99999 then //straight line - begin - pt1 := pts[i+1] + borders[i].leftDir; - pt2 := pts[i+2] + borders[i+1].leftDir; - SetJoinLeft([pt1, (pt1+pt2)*(1/2),pt2]); - - pt1 := pts[i+1] - borders[i].leftDir; - pt2 := pts[i+2] - borders[i+1].leftDir; - SetJoinRight([pt1,(pt1+pt2)*(1/2),pt2]); - end else - begin - //determine turning left or right - turn := borders[i].leftSide.dir.x*borders[i+1].leftSide.dir.y - borders[i].leftSide.dir.y*borders[i+1].leftSide.dir.x; - - maxDiff := borders[i].len; - if borders[i+1].len < maxDiff then - maxDiff := borders[i+1].len; - if penstyle <> nil then - if maxDiff > 2*width then maxDiff := 2*width; - maxDiff := sqrt(sqr(maxDiff)+sqr(hw)); - - //leftside join - leftInter := IntersectLine( borders[i].leftSide, borders[i+1].leftSide ); - diff := leftInter-pts[i+1]; - len := sqrt(diff*diff); - if (len > maxMiter) and (turn >= 0) then //if miter too far - begin - diff.Scale(1/len); - if joinstyle <> pjsRound then - begin - //compute little border - littleBorder.origin := pts[i+1]+diff*maxMiter; - littleBorder.dir := PointF(diff.y,-diff.x); - HasLittleBorder := true; - - //intersect with each border - pt1 := IntersectLine(borders[i].leftSide, littleBorder); - pt2 := IntersectLine(borders[i+1].leftSide, littleBorder); - SetJoinLeft( [pt1, pt2] ); - end else - begin - //perpendicular - pt1 := PointF(pts[i+1].x+borders[i].leftSide.dir.y*hw, - pts[i+1].y-borders[i].leftSide.dir.x*hw); - pt2 := PointF(pts[i+1].x+borders[i+1].leftSide.dir.y*hw, - pts[i+1].y-borders[i+1].leftSide.dir.x*hw); - SetJoinLeft(ComputeRoundJoin(pts[i+1],pt1,pt2)); - end; - end else - if (len > maxDiff) and (turn <= 0) then //if inner intersection too far - begin - ShouldFlushLine := True; - nbJoinLeft := 0; - end else - begin - if (turn > 0) and (len > 1.0001*hw) then - SetJoinLeft([leftInter,leftInter]) else - begin - nbJoinLeft := 1; - joinLeft[0] := leftInter; - end; - end; - - //rightside join - rightInter := IntersectLine( borders[i].rightSide, borders[i+1].rightSide ); - diff := rightInter-pts[i+1]; - len := VectLen(diff); - if (len > maxMiter) and (turn <= 0) then //if miter too far - begin - diff.Scale(1/len); - - if joinstyle <> pjsRound then - begin - //compute little border - littleBorder.origin := pts[i+1] + diff*maxMiter; - littleBorder.dir := PointF(diff.y, -diff.x); - HasLittleBorder := true; - - //intersect with each border - pt1 := IntersectLine(borders[i].rightSide, littleBorder); - pt2 := IntersectLine(borders[i+1].rightSide, littleBorder); - SetJoinRight( [pt1, pt2] ); - end else - begin - //perpendicular - pt1 := PointF(pts[i+1].x-borders[i].rightSide.dir.y*hw, - pts[i+1].y+borders[i].rightSide.dir.x*hw); - pt2 := PointF(pts[i+1].x-borders[i+1].rightSide.dir.y*hw, - pts[i+1].y+borders[i+1].rightSide.dir.x*hw); - SetJoinRight(ComputeRoundJoin(pts[i+1],pt1,pt2)); - end; - end else - if (len > maxDiff) and (turn >= 0) then //if inner intersection too far - begin - ShouldFlushLine := True; - nbJoinRight := 0; - end else - begin - if (turn < 0) and (len > 1.0001*hw) then - SetJoinRight([rightInter,rightInter]) else - begin - nbJoinRight := 1; - joinRight[0] := rightInter; - end; - end; - end; - - if ShouldFlushLine then - begin - NormalRestart := True; - if HasLittleBorder then - begin - if turn >= 0 then - begin - //intersect with each border - pt1 := IntersectLine(borders[i].leftSide, littleBorder); - pt2 := IntersectLine(borders[i+1].leftSide, littleBorder); - pt3 := pts[i+1] - borders[i].leftDir; - pt4 := pts[i+1] + borders[i].leftDir; - - AddPt(pt4,pt3); - AddPt(pt1,pt2); - end else - begin - //intersect with each border - pt1 := IntersectLine(borders[i+1].rightSide, littleBorder); - pt2 := IntersectLine(borders[i].rightSide, littleBorder); - pt3 := pts[i+1] + borders[i].leftDir; - pt4 := pts[i+1] - borders[i].leftDir; - - AddPt(pt3,pt4); - AddPt(pt1,pt2); - end; - - FlushLine(-1); - - AddPt(pt2,pt1); - end else - if joinstyle = pjsRound then - begin - - if {(penstyle= nil) and} (turn > 0) then - begin - pt1 := pts[i+1] + borders[i].leftDir; - pt2 := pts[i+1] + borders[i+1].leftDir; - pt3 := pts[i+1] - borders[i].leftDir; - pt4 := pts[i+1]; - - SetJoinLeft([pt1,pt1]); - SetJoinRight([pt3,pt4]); - AddJoin(-1); - - SetJoinLeft(ComputeRoundJoin(pts[i+1],pt1,pt2)); - nbJoinRight := 1; - joinRight[0] := pt4; - AddJoin(-1); - FlushLine(-1); - end else - if {(penstyle= nil) and} (turn < 0) then - begin - pt1 := pts[i+1] - borders[i].leftDir; - pt2 := pts[i+1] - borders[i+1].leftDir; - pt3 := pts[i+1] + borders[i].leftDir; - pt4 := pts[i+1]; - - SetJoinRight([pt1,pt1]); - SetJoinLeft([pt3,pt4]); - AddJoin(-1); - - SetJoinRight(ComputeRoundJoin(pts[i+1],pt1,pt2)); - nbJoinLeft := 1; - joinLeft[0] := pt4; - AddJoin(-1); - FlushLine(-1); - end else - if (nbCompPts > 1) and (nbRevCompPts > 1) then - begin - pt1 := pts[i+1]+borders[i].leftDir; - pt2 := pts[i+1]-borders[i].leftDir; - AddPt( pt1, pt2 ); - FlushLine(-1); - end else - begin - FlushLine(i+1); - end; - end else - begin - FlushLine(i+1); - if turn > 0 then - AddPt( leftInter, pts[i+1]+borders[i].leftDir ) else - if turn < 0 then - AddPt( pts[i+1] - borders[i].leftDir, rightInter ); - end; - - If NormalRestart then - AddPt(pts[i+1]+borders[i+1].leftDir, - pts[i+1]-borders[i+1].leftDir); - - ShouldFlushLine := false; - end else - AddJoin(i); - end; - - if plCycle in options then - CycleFlush - else - FlushLine(high(pts)); - - FinalizeArray; -end; - -function ComputeWidePolyPolylinePoints(const linepts: array of TPointF; - width: single; pencolor: TBGRAPixel; linecap: TPenEndCap; - joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle; - options: TBGRAPolyLineOptions; miterLimit: single; arrow: TBGRACustomArrow): ArrayOfTPointF; - -var - results: array of array of TPointF; - nbResults,nbTotalPts: integer; - - procedure AddWidePolyline(startIndex,endIndexP1: integer); - var - tempWidePolyline: array of TPointF; - subPts: array of TPointF; - j : integer; - begin - if endIndexP1 > startIndex then - begin - setlength(subPts,endIndexP1-startIndex); - for j := startIndex to endIndexP1-1 do - subPts[j-startIndex] := linepts[j]; - tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrow); - if length(results) = nbresults then - setlength(results,(nbresults+1)*2); - results[nbResults] := tempWidePolyline; - if nbResults <> 0 then inc(nbTotalPts); - inc(nbResults); - inc(nbTotalPts,length(tempWidePolyline)); - end; - end; - -var - start,i,j: integer; - -begin - start := 0; - nbResults := 0; - nbTotalPts := 0; - for i := 0 to high(linepts) do - if isEmptyPointF(linepts[i]) then - begin - AddWidePolyline(start,i); - start := i+1; - end; - AddWidePolyline(start,length(linepts)); - - setlength(result, nbTotalPts); - start := 0; - for i := 0 to nbResults-1 do - begin - if i <> 0 then - begin - result[start] := EmptyPointF; - inc(start); - end; - for j := 0 to high(results[i]) do - begin - result[start] := results[i][j]; - inc(start); - end; - end; -end; - -{ TBGRAPenStroker } - -function TBGRAPenStroker.GetArrow: TBGRACustomArrow; -begin - result := FArrow; -end; - -function TBGRAPenStroker.GetArrowOwned: boolean; -begin - result := FArrowOwned; -end; - -function TBGRAPenStroker.GetCustomPenStyle: TBGRAPenStyle; -begin - result := DuplicatePenStyle(FCustomPenStyle); -end; - -function TBGRAPenStroker.GetJoinStyle: TPenJoinStyle; -begin - result := FJoinStyle; -end; - -function TBGRAPenStroker.GetLineCap: TPenEndCap; -begin - result := FLineCap; -end; - -function TBGRAPenStroker.GetMiterLimit: single; -begin - result := FMiterLimit; -end; - -function TBGRAPenStroker.GetPenStyle: TPenStyle; -begin - result := FPenStyle; -end; - -function TBGRAPenStroker.GetStrokeMatrix: TAffineMatrix; -begin - result := FOriginalStrokeMatrix; -end; - -procedure TBGRAPenStroker.SetArrow(AValue: TBGRACustomArrow); -begin - FArrow := AValue; -end; - -procedure TBGRAPenStroker.SetArrowOwned(AValue: boolean); -begin - FArrowOwned := AValue; -end; - -procedure TBGRAPenStroker.SetCustomPenStyle(AValue: TBGRAPenStyle); -begin - if PenStyleEqual(FCustomPenStyle,AValue) then Exit; - FCustomPenStyle:= DuplicatePenStyle(AValue); - FPenStyle:= BGRAToPenStyle(AValue); -end; - -procedure TBGRAPenStroker.SetJoinStyle(AValue: TPenJoinStyle); -begin - FJoinStyle:= AValue; -end; - -procedure TBGRAPenStroker.SetLineCap(AValue: TPenEndCap); -begin - FLineCap:= AValue; -end; - -procedure TBGRAPenStroker.SetMiterLimit(AValue: single); -begin - FMiterLimit := AValue; -end; - -procedure TBGRAPenStroker.SetStrokeMatrix(const AValue: TAffineMatrix); -begin - if FOriginalStrokeMatrix=AValue then Exit; - FOriginalStrokeMatrix:=AValue; - FStrokeMatrix := AValue; - FStrokeMatrix[1,3] := 0; - FStrokeMatrix[2,3] := 0; - FStrokeZoom := max(VectLen(PointF(FStrokeMatrix[1,1],FStrokeMatrix[2,1])), - VectLen(PointF(FStrokeMatrix[1,2],FStrokeMatrix[2,2]))); - if FStrokeZoom > 0 then - FStrokeMatrix := FStrokeMatrix * AffineMatrixScale(1/FStrokeZoom,1/FStrokeZoom); - if IsAffineMatrixInversible(FStrokeMatrix) then - FStrokeMatrixInverse := AffineMatrixInverse(FStrokeMatrix) - else - begin - FStrokeMatrixInverse := AffineMatrixIdentity; - FStrokeMatrix := AffineMatrixIdentity; - end; - FStrokeMatrixIdentity := IsAffineMatrixIdentity(FStrokeMatrix); -end; - -procedure TBGRAPenStroker.SetPenStyle(AValue: TPenStyle); -begin - if (FPenStyle=AValue) or (AValue=psPattern) then Exit; - FCustomPenStyle := PenStyleToBGRA(AValue); - FPenStyle := AValue; -end; - -constructor TBGRAPenStroker.Create; -begin - Style := psSolid; - LineCap := pecRound; - JoinStyle := pjsBevel; - MiterLimit := 2; - fillchar(FOriginalStrokeMatrix,sizeof(FOriginalStrokeMatrix),0); - StrokeMatrix := AffineMatrixIdentity; -end; - -destructor TBGRAPenStroker.Destroy; -begin - if ArrowOwned then FreeAndNil(FArrow); - inherited Destroy; -end; - -function TBGRAPenStroker.ComputePolyline(const APoints: array of TPointF; - AWidth: single; AClosedCap: boolean): ArrayOfTPointF; -var - c: TBGRAPixel; -begin - if not AClosedCap then - c := BGRAWhite //needed for alpha junction - else - c := BGRAPixelTransparent; - - if FStrokeMatrixIdentity then - result := ComputePolyline(APoints,AWidth*FStrokeZoom,c,AClosedCap) - else - result := FStrokeMatrix*ComputePolyline(FStrokeMatrixInverse*APoints,AWidth*FStrokeZoom,c,AClosedCap); -end; - -function TBGRAPenStroker.ComputePolyline(const APoints: array of TPointF; - AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean): ArrayOfTPointF; -var options: TBGRAPolyLineOptions; -begin - options := []; - if Assigned(Arrow) and Arrow.IsStartDefined then include(options, plNoStartCap); - if Assigned(Arrow) and Arrow.IsEndDefined then include(options, plNoEndCap); - if not AClosedCap then include(options, plRoundCapOpen); - if FStrokeMatrixIdentity then - result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, APenColor, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow) - else - result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, APenColor, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow); -end; - -function TBGRAPenStroker.ComputePolylineAutocycle( - const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; -var options: TBGRAPolyLineOptions; -begin - options := [plAutoCycle]; - if Assigned(Arrow) and Arrow.IsStartDefined then include(options, plNoStartCap); - if Assigned(Arrow) and Arrow.IsEndDefined then include(options, plNoEndCap); - if FStrokeMatrixIdentity then - result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow) - else - result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow) -end; - -function TBGRAPenStroker.ComputePolygon(const APoints: array of TPointF; - AWidth: single): ArrayOfTPointF; -begin - if FStrokeMatrixIdentity then - result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, [plCycle], MiterLimit) - else - result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, [plCycle], MiterLimit); -end; - -initialization - - //special pen styles - SolidPenStyle := nil; - - setlength(ClearPenStyle,1); - ClearPenStyle[0] := 0; - - DashPenStyle := BGRAPenStyle(3,1); - DotPenStyle := BGRAPenStyle(1,1); - DashDotPenStyle := BGRAPenStyle(3,1,1,1); - DashDotDotPenStyle := BGRAPenStyle(3,1,1,1,1,1); - -end. - diff --git a/components/bgrabitmap/bgraphongtypes.pas b/components/bgrabitmap/bgraphongtypes.pas deleted file mode 100644 index e5e86ea..0000000 --- a/components/bgrabitmap/bgraphongtypes.pas +++ /dev/null @@ -1,85 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAPhongTypes; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes; - -type - -{ TCustomPhongShading } - - TCustomPhongShading = class - protected - FLightPosition3D: TPoint3D; - function GetLightPosition: TPoint; - procedure SetLightPosition(AValue: TPoint); - function GetLightPositionF: TPointF; - procedure SetLightPositionF(AValue: TPointF); - function GetLightPositionZ: integer; - procedure SetLightPositionZ(AValue: integer); - - public - - { Render the specified map on the destination bitmap with one solid color. Map altitude - indicate the global height of the map. } - procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - Color : TBGRAPixel); overload; virtual; abstract; - - { Render with a color map of the same size as the height map. Map altitude - indicate the global height of the map. } - procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorMap : TBGRACustomBitmap); overload; virtual; abstract; - - { Render with a scanner. Map altitude - indicate the global height of the map. } - procedure DrawScan(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer; - ColorScan : IBGRAScanner); virtual; abstract; - - property LightPosition: TPoint read GetLightPosition write SetLightPosition; - property LightPositionZ: integer read GetLightPositionZ write SetLightPositionZ; - property LightPositionF: TPointF read GetLightPositionF write SetLightPositionF; - property LightPosition3D: TPoint3D read FLightPosition3D write FLightPosition3D; - end; - -implementation - -{ TCustomPhongShading } - -function TCustomPhongShading.GetLightPositionF: TPointF; -begin - result := PointF(FLightPosition3D.X,FLightPosition3D.Y); -end; - -procedure TCustomPhongShading.SetLightPositionF(AValue: TPointF); -begin - FLightPosition3D.X := AValue.X; - FLightPosition3D.Y := AValue.Y; -end; - -function TCustomPhongShading.GetLightPosition: TPoint; -begin - result := Point(round(FLightPosition3D.X),round(FLightPosition3D.Y)); -end; - -procedure TCustomPhongShading.SetLightPosition(AValue: TPoint); -begin - FLightPosition3D.X := AValue.X; - FLightPosition3D.Y := AValue.Y; -end; - -function TCustomPhongShading.GetLightPositionZ: integer; -begin - result := round(FLightPosition3D.Z); -end; - -procedure TCustomPhongShading.SetLightPositionZ(AValue: integer); -begin - FLightPosition3D.Z := AValue; -end; - -end. - diff --git a/components/bgrabitmap/bgraphoxo.pas b/components/bgrabitmap/bgraphoxo.pas deleted file mode 100644 index b9a51f7..0000000 --- a/components/bgrabitmap/bgraphoxo.pas +++ /dev/null @@ -1,602 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAPhoxo; - -{$mode objfpc}{$H+} - -interface - -uses - BGRABitmapTypes, FPImage, BGRALayers, BGRABitmap, BGRAClasses, SysUtils, BMPcomn; - -const - PhoxoHeaderMagic : packed array[1..4] of char = 'oXo '; - PhoxoBlock_CanvasSize = 1; - PhoxoBlock_Layer = 2; - PhoxoBlock_TextLayer = 3; - PhoxoBlock_DPI = 4; - PhoxoBlock_LayerCaption = 5; - PhoxoBlock_LazPaintBlendMode = 128; - PhoxoBlock_EndOfFile = 255; - -type - TPhoxoHeader = packed record - magic: packed array[1..4] of char; - version: LongWord; - end; - - TPhoxoBlockHeader = packed record - blockType : LongWord; - blockSize : LongWord; - end; - - TPhoxoLayerHeader = packed record - layerVisible: LongWord; - layerLimited: LongWord; - opacityPercent: LongWord; - bmpHeader: TBitMapInfoHeader; - redMask,greenMask,blueMask: LongWord; - end; - - { TBGRAPhoxoDocument } - - TBGRAPhoxoDocument = class(TBGRALayeredBitmap) - private - FDPIX,FDPIY: integer; - protected - function GetMimeType: string; override; - procedure AddLayerFromPhoxoData(const ABlockHeader: TPhoxoBlockHeader; ABlockData: PByte); - procedure InternalLoadFromStream(AStream: TStream); - procedure InternalSaveToStream(AStream: TStream); - public - constructor Create; overload; override; - constructor Create(AWidth, AHeight: integer); overload; override; - procedure LoadFromStream(AStream: TStream); override; - procedure LoadFromFile(const filenameUTF8: string); override; - procedure SaveToStream(AStream: TStream); override; - procedure SaveToFile(const filenameUTF8: string); override; - class function CheckFormat(Stream: TStream; ARestorePosition: boolean): boolean; static; - class function ReadBlock(Stream: TStream; out AHeader: TPhoxoBlockHeader; out ABlockData: PByte): boolean; static; - property DPIX: integer read FDPIX; - property DPIY: integer read FDPIY; - end; - - { TBGRAReaderOXO } - - TBGRAReaderOXO = class(TFPCustomImageReader) - private - FWidth,FHeight,FNbLayers: integer; - FDPIX,FDPIY: integer; - protected - function InternalCheck(Stream: TStream): boolean; override; - procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; - public - property Width: integer read FWidth; - property Height: integer read FHeight; - property NbLayers: integer read FNbLayers; - property DPIX: integer read FDPIX; - property DPIY: integer read FDPIY; - end; - - { TBGRAWriterOXO } - - TBGRAWriterOXO = class(TFPCustomImageWriter) - protected - procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override; - end; - -procedure RegisterPhoxoFormat; - -implementation - -uses BGRAUTF8; - -var AlreadyRegistered: boolean; - -function ComputeRowStride(AWidth,ABitsPerPixel: Longword): Longword; -begin - result := ((AWidth * ABitsPerPixel + 31) div 32)*4; -end; - -procedure SwapLayerHeaderIfNeeded(var ALayerHeader: TPhoxoLayerHeader); -begin - with ALayerHeader do - begin - layerVisible := LEtoN(layerVisible); - layerLimited := LEtoN(layerLimited); - opacityPercent := LEtoN(opacityPercent); - {$IFNDEF ENDIAN_LITTLE}SwapBMPInfoHeader(bmpHeader);{$ENDIF} - end; -end; - -procedure RegisterPhoxoFormat; -begin - if AlreadyRegistered then exit; - ImageHandlers.RegisterImageReader ('PhoXo', 'oXo', TBGRAReaderOXO); - RegisterLayeredBitmapReader('oXo', TBGRAPhoxoDocument); - RegisterLayeredBitmapWriter('oXo', TBGRAPhoxoDocument); - DefaultBGRAImageReader[ifPhoxo] := TBGRAReaderOXO; - DefaultBGRAImageWriter[ifPhoxo] := TBGRAWriterOXO; - AlreadyRegistered:= True; -end; - -{ TBGRAWriterOXO } - -procedure TBGRAWriterOXO.InternalWrite(Str: TStream; Img: TFPCustomImage); -var doc: TBGRAPhoxoDocument; - tempBmp: TBGRABitmap; - x,y: integer; -begin - doc := TBGRAPhoxoDocument.Create; - if Img is TBGRABitmap then doc.AddLayer(Img as TBGRABitmap) else - begin - tempBmp := TBGRABitmap.Create(img.Width,img.Height); - for y := 0 to Img.Height-1 do - for x := 0 to img.Width-1 do - tempBmp.SetPixel(x,y, FPColorToBGRA(img.Colors[x,y])); - doc.AddOwnedLayer(tempBmp); - end; - doc.SaveToStream(Str); - doc.Free; -end; - -{ TBGRAReaderOXO } - -function TBGRAReaderOXO.InternalCheck(Stream: TStream): boolean; -begin - result := TBGRAPhoxoDocument.CheckFormat(Stream,True); -end; - -procedure TBGRAReaderOXO.InternalRead(Stream: TStream; Img: TFPCustomImage); -var layeredImage: TBGRAPhoxoDocument; - flat: TBGRABitmap; - x,y: integer; -begin - FWidth := 0; - FHeight:= 0; - FNbLayers:= 0; - FDPIX := 0; - FDPIY := 0; - layeredImage := TBGRAPhoxoDocument.Create; - try - layeredImage.LoadFromStream(Stream); - flat := layeredImage.ComputeFlatImage; - try - FWidth:= layeredImage.Width; - FHeight:= layeredImage.Height; - FNbLayers:= layeredImage.NbLayers; - FDPIX := layeredImage.DPIX; - FDPIY := layeredImage.DPIY; - if Img is TBGRACustomBitmap then - TBGRACustomBitmap(img).Assign(flat) - else - begin - Img.SetSize(flat.Width,flat.Height); - for y := 0 to flat.Height-1 do - for x := 0 to flat.Width-1 do - Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y)); - end; - finally - flat.free; - end; - finally - layeredImage.Free; - end; -end; - -{ TBGRAPhoxoDocument } - -function TBGRAPhoxoDocument.GetMimeType: string; -begin - Result:= 'image/phoxo'; -end; - -procedure TBGRAPhoxoDocument.AddLayerFromPhoxoData( - const ABlockHeader: TPhoxoBlockHeader; ABlockData: PByte); -var - layerHeader: TPhoxoLayerHeader; - rawImageSize: LongWord; - rowStride: LongWord; - remaining: LongWord; - bmp: TBGRABitmap; - layerIndex,y,x: integer; - pSrc: PByte; - pDest: PBGRAPixel; -begin - remaining := ABlockHeader.blockSize; - if remaining < sizeof(TPhoxoLayerHeader) then raise EFormatError.Create('Block too small'); - move(ABlockData^, {%H-}layerHeader, sizeof(layerHeader)); - inc(ABlockData, sizeof(layerHeader)); - dec(remaining, sizeof(layerHeader)); - SwapLayerHeaderIfNeeded(layerHeader); - - if layerHeader.bmpHeader.Compression <> BI_RGB then raise EFormatError.Create('Compression not supported'); - if (layerHeader.bmpHeader.Width < 0) or (layerHeader.bmpHeader.Height < 0) then - raise EFormatError.Create('Invalid image size'); - if int64(layerHeader.bmpHeader.Width)*layerHeader.bmpHeader.Height > maxLongint div 4 then - raise EOutOfMemory.Create('Image too big'); - rowStride := ComputeRowStride(layerHeader.bmpHeader.Width,layerHeader.bmpHeader.BitCount); - rawImageSize := rowStride * layerHeader.bmpHeader.Height; - - if rawImageSize > remaining then - raise EFormatError.Create('Invalid image size'); - - bmp := TBGRABitmap.Create(layerHeader.bmpHeader.Width, layerHeader.bmpHeader.Height); - layerIndex := AddOwnedLayer(bmp, (layerHeader.opacityPercent*255 + 50) div 100); - LayerVisible[layerIndex] := (layerHeader.layerVisible = 1); - - case layerHeader.bmpHeader.BitCount of - 8: begin - for y := bmp.Height-1 downto 0 do - begin - pSrc := ABlockData + (bmp.Height-1 - y)*rowStride; - pDest := bmp.ScanLine[y]; - for x := bmp.Width-1 downto 0 do - begin - pDest^ := BGRA(pSrc^,pSrc^,pSrc^); - inc(pDest); - inc(pSrc,3); - end; - end; - end; - 24: begin - for y := bmp.Height-1 downto 0 do - begin - pSrc := ABlockData + (bmp.Height-1 - y)*rowStride; - pDest := bmp.ScanLine[y]; - for x := bmp.Width-1 downto 0 do - begin - pDest^ := BGRA((pSrc+2)^,(pSrc+1)^,pSrc^); - inc(pDest); - inc(pSrc,3); - end; - end; - end; - 32: begin - move(ABlockData^, bmp.Data^, sizeof(TBGRAPixel)*bmp.NbPixels); - if bmp.LineOrder = riloTopToBottom then bmp.VerticalFlip; - if TBGRAPixel_RGBAOrder then bmp.SwapRedBlue; - end; - else - raise EFormatError.Create('Unsupported bit depth'); - end; - - inc(ABlockData, rawImageSize); - dec(remaining, rawImageSize); - if remaining >= 8 then - begin - LayerOffset[layerIndex] := Point(LEtoN(PLongInt(ABlockData)^),LEtoN((PLongInt(ABlockData)+1)^)); - inc(ABlockData, 8); - dec(remaining, 8); - end; -end; - -constructor TBGRAPhoxoDocument.Create; -begin - inherited Create; - RegisterPhoxoFormat; -end; - -constructor TBGRAPhoxoDocument.Create(AWidth, AHeight: integer); -begin - inherited Create(AWidth, AHeight); - RegisterPhoxoFormat; -end; - -procedure TBGRAPhoxoDocument.LoadFromStream(AStream: TStream); -begin - OnLayeredBitmapLoadFromStreamStart; - try - InternalLoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - end; -end; - -procedure TBGRAPhoxoDocument.InternalLoadFromStream(AStream: TStream); -var blockHeader: TPhoxoBlockHeader; - blockData: PByte; - wCaption: widestring; - i: Integer; -begin - if not CheckFormat(AStream,False) then - raise EFormatError.Create('File header is invalid'); - Clear; - FDPIX := 0; - FDPIY := 0; - blockData := nil; - repeat - if not ReadBlock(AStream, blockHeader,blockData) then - begin - if NbLayers = 0 then - raise EFormatError.Create('Error reading block from file') - else - break; - end; - try - case blockHeader.blockType of - PhoxoBlock_CanvasSize: - begin - if blockHeader.blockSize < 8 then raise EFormatError.Create('Block too small'); - SetSize(LEtoN(PLongWord(blockData)^),LEtoN((PLongWord(blockData)+1)^)); - end; - PhoxoBlock_DPI: - begin - if blockHeader.blockSize >= 8 then - begin - FDPIX := LEtoN(PLongWord(blockData)^); - FDPIY := LEtoN((PLongWord(blockData)+1)^); - end; - end; - PhoxoBlock_Layer, PhoxoBlock_TextLayer: - AddLayerFromPhoxoData(blockHeader,blockData); - PhoxoBlock_LayerCaption: - begin - if (blockHeader.blockSize >= 2) and (NbLayers > 0) then - begin - setlength(wCaption, blockHeader.blockSize div 2); - for i := 1 to length(wCaption) do - Word(wCaption[i]) := LEtoN((PWord(blockData)+i-1)^); - if wCaption[1] = #1 then Delete(wCaption,1,1); - LayerName[NbLayers-1] := UTF8Encode(wCaption); - - end; - end; - PhoxoBlock_LazPaintBlendMode: - begin - if (blockHeader.blockSize >= 2) and (NbLayers > 0) then - begin - setlength(wCaption, blockHeader.blockSize div 2); - for i := 1 to length(wCaption) do - Word(wCaption[i]) := LEtoN((PWord(blockData)+i-1)^); - BlendOperation[NbLayers-1] := StrToBlendOperation(UTF8Encode(wCaption)); - end; - end; - end; - finally - FreeMem(blockData); - end; - until blockHeader.blockType = PhoxoBlock_EndOfFile; -end; - -procedure TBGRAPhoxoDocument.LoadFromFile(const filenameUTF8: string); -var AStream: TFileStreamUTF8; -begin - AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); - OnLayeredBitmapLoadStart(filenameUTF8); - try - InternalLoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - AStream.Free; - end; -end; - -procedure TBGRAPhoxoDocument.SaveToStream(AStream: TStream); -begin - OnLayeredBitmapSaveToStreamStart; - try - InternalSaveToStream(AStream); - finally - OnLayeredBitmapSaved; - end; -end; - -procedure TBGRAPhoxoDocument.SaveToFile(const filenameUTF8: string); -var AStream: TFileStreamUTF8; -begin - AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate or fmShareDenyWrite); - OnLayeredBitmapSaveStart(filenameUTF8); - try - InternalSaveToStream(AStream); - finally - OnLayeredBitmapSaved; - AStream.Free; - end; -end; - -procedure TBGRAPhoxoDocument.InternalSaveToStream(AStream: TStream); - - procedure WriteFileHeader; - var fileHeader: TPhoxoHeader; - begin - fileHeader.magic := PhoxoHeaderMagic; - fileHeader.version := 1; - fileHeader.version := NtoLE(fileHeader.version); - AStream.WriteBuffer(fileHeader, sizeof(fileHeader)); - end; - - procedure WriteBlockHeader(blockType: LongWord; blockSize: LongWord); - var blockHeader: TPhoxoBlockHeader; - begin - blockHeader.blockType := NtoLE(blockType); - blockHeader.blockSize := NtoLE(blockSize); - AStream.WriteBuffer(blockHeader, sizeof(blockHeader)); - end; - - procedure WriteLongInt(value: longint); - begin - value := NtoLE(value); - AStream.WriteBuffer(value, sizeof(value)); - end; - - procedure WriteLayer(index: integer); - var wCaption: widestring; - pCaption: PWord; - - layerHeader: TPhoxoLayerHeader; - rowStride: LongWord; - - temp,pdest: PByte; - i,x,y: integer; - psrc: PBGRAPixel; - begin - if LayerVisible[index] then - layerHeader.layerVisible := 1 - else - layerHeader.layerVisible := 0; - layerHeader.layerLimited:= 0; - layerHeader.opacityPercent := (LayerOpacity[index]*100 + 127) div 255; - with layerHeader.bmpHeader do - begin - Size := $28; - Width := self.LayerBitmap[index].Width; - Height := self.LayerBitmap[index].Height; - Planes := 1; - BitCount := 32; //24-bit does not seem to be supported - Compression := BI_RGB; - SizeImage := 0; - XPelsPerMeter := 0; - YPelsPerMeter := 0; - ClrUsed := 0; - ClrImportant := 0; - end; - layerHeader.redMask := 0; - layerHeader.greenMask := 0; - layerHeader.blueMask := 0; - - rowStride := ComputeRowStride(layerHeader.bmpHeader.Width, layerHeader.bmpHeader.BitCount); - - WriteBlockHeader(PhoxoBlock_Layer, sizeof(layerHeader) + rowStride*layerHeader.bmpHeader.Height + sizeof(TPoint)); - SwapLayerHeaderIfNeeded(layerHeader); - AStream.WriteBuffer(layerHeader,sizeof(layerHeader)); - SwapLayerHeaderIfNeeded(layerHeader); - - case layerHeader.bmpHeader.BitCount of - 32: begin - if TBGRAPixel_RGBAOrder then self.LayerBitmap[index].SwapRedBlue; - for y := self.LayerBitmap[index].Height-1 downto 0 do - AStream.WriteBuffer(self.LayerBitmap[index].ScanLine[y]^, rowStride); - if TBGRAPixel_RGBAOrder then self.LayerBitmap[index].SwapRedBlue; - end; - 24: begin - GetMem(temp, rowStride); - fillchar(temp^, rowStride, 0); - try - for y := self.LayerBitmap[index].Height-1 downto 0 do - begin - psrc := self.LayerBitmap[index].ScanLine[y]; - pdest := temp; - for x := self.LayerBitmap[index].Width-1 downto 0 do - begin - pdest^ := psrc^.blue; inc(pdest); - pdest^ := psrc^.green; inc(pdest); - pdest^ := psrc^.red; inc(pdest); - inc(psrc); - end; - AStream.WriteBuffer(temp^, rowstride); - end; - finally - FreeMem(temp); - end; - end - else - raise exception.Create('Internal error'); - end; - - WriteLongInt(LayerOffset[index].X); - WriteLongInt(LayerOffset[index].Y); - - if LayerName[index]<>'' then - begin - wCaption := UTF8ToUTF16(LayerName[index]); - WriteBlockHeader(PhoxoBlock_LayerCaption, length(wCaption)*2); - getmem(pCaption, length(wCaption)*2); - try - for i := 1 to length(wCaption) do - (pCaption+i-1)^ := NtoLE(Word(wCaption[i])); - AStream.WriteBuffer(pCaption^, length(wCaption)*2); - finally - freemem(pCaption); - end; - end; - - if BlendOperation[index] <> boTransparent then - begin - wCaption := UTF8ToUTF16(BlendOperationStr[BlendOperation[index]]); - WriteBlockHeader(PhoxoBlock_LazPaintBlendMode, length(wCaption)*2); - getmem(pCaption, length(wCaption)*2); - try - for i := 1 to length(wCaption) do - (pCaption+i-1)^ := NtoLE(Word(wCaption[i])); - AStream.WriteBuffer(pCaption^, length(wCaption)*2); - finally - freemem(pCaption); - end; - end; - end; - -var - i: Integer; -begin - WriteFileHeader; - - WriteBlockHeader(PhoxoBlock_CanvasSize, 8); - WriteLongInt(Width); - WriteLongInt(Height); - - if (DPIX <> 0) and (DPIY <> 0) then - begin - WriteBlockHeader(PhoxoBlock_DPI, 8); - WriteLongInt(DPIX); - WriteLongInt(DPIY); - end; - - for i := 0 to NbLayers-1 do - begin - OnLayeredBitmapSaveProgress(round(i*100/NbLayers)); - WriteLayer(i); - end; - OnLayeredBitmapSaveProgress(100); - - WriteBlockHeader(PhoxoBlock_EndOfFile,0); -end; - -class function TBGRAPhoxoDocument.CheckFormat(Stream: TStream; ARestorePosition: boolean): boolean; -var header: TPhoxoHeader; - oldPos: int64; -begin - oldPos := Stream.Position; - if Stream.Read({%H-}header,sizeof(header))<>sizeof(header) then - result := false else - begin - header.version:= LEtoN(header.version); - if (header.magic <> PhoxoHeaderMagic) or (header.version <> 1) then - result := false - else - result := true; - end; - if ARestorePosition then Stream.Position:= oldPos; -end; - -class function TBGRAPhoxoDocument.ReadBlock(Stream: TStream; out - AHeader: TPhoxoBlockHeader; out ABlockData: PByte): boolean; -begin - ABlockData := nil; - if Stream.Read({%H-}AHeader,sizeof(AHeader)) <> sizeof(AHeader) then - begin - AHeader.blockType := 0; - AHeader.blockSize := 0; - result := false; - exit; - end; - AHeader.blockType := LEtoN(AHeader.blockType); - AHeader.blockSize := LEtoN(AHeader.blockSize); - if Stream.Position + AHeader.blockSize > Stream.Size then - begin - AHeader.blockSize := 0; - result := false; - exit; - end; - GetMem(ABlockData, AHeader.blockSize); - if Stream.Read(ABlockData^, AHeader.blockSize) <> AHeader.blockSize then - begin - FreeMem(ABlockData); - AHeader.blockSize := 0; - result := false; - exit; - end; - result := true; -end; - -end. - diff --git a/components/bgrabitmap/bgrapixel.inc b/components/bgrabitmap/bgrapixel.inc deleted file mode 100644 index 82a48f6..0000000 --- a/components/bgrabitmap/bgrapixel.inc +++ /dev/null @@ -1,744 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{=== Pixel types and functions ===} - -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type - {* Pointer for direct pixel access. Data is stored as a sequence of ''TBGRAPixel''. - See [[BGRABitmap tutorial 4]] } - PBGRAPixel = ^TBGRAPixel; - - {$IFNDEF BGRABITMAP_BGRAPIXEL} - {$IFDEF BGRABITMAP_USE_LCL} - {$IFDEF LCLgtk} - {$DEFINE BGRABITMAP_RGBAPIXEL} - {$ENDIF} - {$IFDEF LCLgtk2} - {$DEFINE BGRABITMAP_RGBAPIXEL} - {$ENDIF} - {$IFDEF DARWIN} - {$IFNDEF LCLQt} - {$DEFINE BGRABITMAP_RGBAPIXEL} - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ENDIF} - - {* Each pixel is a sequence of 4 bytes containing blue, green, red and alpha channel. - Values range from 0 to 255, color is in sRGB colorspace. The alpha value of 0 - is transparent and 255 is opaque. In the bitmap data, when the pixel is fully transparent, - the RGB values are supposed to be set to zero. } - - { TBGRAPixel } - - TBGRAPixel = packed record - private - function GetClassIntensity: word; - function GetClassLightness: word; - procedure SetClassIntensity(AValue: word); - procedure SetClassLightness(AValue: word); - public - {$IFDEF BGRABITMAP_RGBAPIXEL} - red, green, blue, alpha: byte; - {$ELSE} - blue, green, red, alpha: byte; - {$ENDIF} - procedure FromRGB(ARed,AGreen,ABlue: Byte; AAlpha: Byte = 255); - procedure FromColor(AColor: TColor; AAlpha: Byte = 255); - procedure FromString(AStr: string); - procedure FromFPColor(AColor: TFPColor); - procedure ToRGB(out ARed,AGreen,ABlue,AAlpha: Byte); overload; - procedure ToRGB(out ARed,AGreen,ABlue: Byte); overload; - function ToColor: TColor; - function ToString: string; - function ToGrayscale(AGammaCorrection: boolean = true): TBGRAPixel; - function ToFPColor: TFPColor; - function EqualsExactly(constref AColor: TBGRAPixel): boolean; - class Operator := (Source: TBGRAPixel): TColor; - class Operator := (Source: TColor): TBGRAPixel; - property Intensity: word read GetClassIntensity write SetClassIntensity; - property Lightness: word read GetClassLightness write SetClassLightness; - end; - TBGRAPixelBuffer = packed array of TBGRAPixel; - -procedure AllocateBGRAPixelBuffer(var ABuffer: TBGRAPixelBuffer; ASize: integer); - -const - {$IFDEF BGRABITMAP_RGBAPIXEL} - TBGRAPixel_RGBAOrder = True; - TBGRAPixel_RedByteOffset = 0; - TBGRAPixel_GreenByteOffset = 1; - TBGRAPixel_BlueByteOffset = 2; - {$ELSE} - TBGRAPixel_RGBAOrder = False; - TBGRAPixel_BlueByteOffset = 0; - TBGRAPixel_GreenByteOffset = 1; - TBGRAPixel_RedByteOffset = 2; - {$ENDIF} - TBGRAPixel_AlphaByteOffset = 3; - {$IFDEF ENDIAN_LITTLE} - TBGRAPixel_RedShift = TBGRAPixel_RedByteOffset*8; - TBGRAPixel_GreenShift = TBGRAPixel_GreenByteOffset*8; - TBGRAPixel_BlueShift = TBGRAPixel_BlueByteOffset*8; - TBGRAPixel_AlphaShift = TBGRAPixel_AlphaByteOffset*8; - {$ELSE} - TBGRAPixel_RedShift = 24 - TBGRAPixel_RedByteOffset*8; - TBGRAPixel_GreenShift = 24 - TBGRAPixel_GreenByteOffset*8; - TBGRAPixel_BlueShift = 24 - TBGRAPixel_BlueByteOffset*8; - TBGRAPixel_AlphaShift = 24 - TBGRAPixel_AlphaByteOffset*8; - {$ENDIF} - - {** Creates a pixel with given RGBA values } - function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload; inline; - {** Creates a opaque pixel with given RGB values } - function BGRA(red, green, blue: byte): TBGRAPixel; overload; inline; - {** Checks if two pixels are equal. If they are both transparent, - RGB values are ignored } - operator = (const c1, c2: TBGRAPixel): boolean; inline; - {** Returns the intensity of a pixel. The intensity is the - maximum value reached by any component } - function GetIntensity(c: TBGRAPixel): word; inline; - {** Sets the intensity of a pixel } - function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel; - {** Returns the lightness of a pixel. The lightness is the - perceived brightness, 0 being black and 65535 being white } - function GetLightness(c: TBGRAPixel): word; overload; - {** Sets the lightness of a pixel } - function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel; overload; - {** Sets the lightness quickly, by fading towards black if ''lightness'' is - less than 32768, and fading towards white if ''lightness'' is more - than 32768 } - function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline; - {** Sets the intensity quickly, by fading towards black if ''lightness'' is - less than 32768, and multiplying all components if ''lightness'' is more - than 32768. In case of saturation, it fades towards white } - function ApplyIntensityFast(color: TBGRAPixel; lightness: LongWord): TBGRAPixel; - {** Combines two lightnesses together. A value of 32768 is neutral. The - result may exceed 65535 } - function CombineLightness(lightness1,lightness2: Int32or64): Int32or64; - {** Converts a color into grayscale } - function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel; - function BGRAToGrayscaleLinear(c: TBGRAPixel): TBGRAPixel; - {** Create a gray color with the given ''lightness'' } - function GrayscaleToBGRA(lightness: word): TBGRAPixel; - {** Merge two colors without gamma correction } - function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; overload; - {** Merge two colors without gamma correction. ''weight1'' and ''weight2'' - indicates the weight of the color barycentre } - function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; weight2: integer): TBGRAPixel; overload; - {** Merge two colors with gamma correction. ''weight1'' and ''weight2'' - indicates the weight of the color barycentre } - function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel; weight2: byte): TBGRAPixel; - {** Converts a ''TColor'' value into an opaque pixel } - function ColorToBGRA(color: TColor): TBGRAPixel; overload; - {** Converts a ''TColor'' value into a pixel with given ''opacity'' } - function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload; - {** Converts a pixel into a TColor value, discarding the alpha value } - function BGRAToColor(c: TBGRAPixel): TColor; - function FastRoundDiv257(valueWord: LongWord): byte; inline; - {** Converts a ''TFPColor'' value into a pixel. Note that even if - ''TFPColor'' have 16-bit values, they are not considered as - gamma expanded } - function FPColorToBGRA(AValue: TFPColor): TBGRAPixel; - {** Converts a pixel into a ''TFPColor'' } - function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline; - function Color16BitToBGRA(AColor: Word): TBGRAPixel; - function BGRAToColor16Bit(const AColor: TBGRAPixel): Word; - {** Computes the difference (with gamma correction) between two pixels, - taking into account all dimensions, including transparency. The - result ranges from 0 to 65535 } - function BGRAWordDiff(c1, c2: TBGRAPixel): word; - {** Computes the difference (with gamma correction) between two pixels, - taking into account all dimensions, including transparency. The - result ranges from 0 to 255 } - function BGRADiff(c1, c2: TBGRAPixel): byte; - function FastBGRALinearDiff(c1,c2: TBGRAPixel): byte; - function FastBGRAExpandedDiff(c1,c2: TBGRAPixel): word; - -type - {* Array of pixels } - ArrayOfTBGRAPixel = array of TBGRAPixel; - {** Merge given colors without gamma correction } - function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel; overload; - -{ Get height [0..1] stored in a TBGRAPixel } -function MapHeight(Color: TBGRAPixel): Single; - -{ Get TBGRAPixel to store height [0..1] } -function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel; - -type - {* Possible modes when drawing a pixel over another one } - TDrawMode = ( - {** The pixel is replaced } - dmSet, - {** The pixel is replaced if the pixel over has an alpha value of 255 } - dmSetExceptTransparent, - {** The pixel is blend over the other one according to alpha values, - however no gamma correction is applied. In other words, the color - space is assumed to be linear } - dmLinearBlend, - {** The pixel is blend over the other one according to alpha values, - and a gamma correction is applied. In other word, the color - space is assumed to be sRGB } - dmDrawWithTransparency, - {** Values of all channels are combined with Xor. This is useful to - compute the binary difference, however it is not something that makes - much sense to display on the screen } - dmXor); - -const - {** An alias for the linear blend, because it is faster than blending - with gamma correction } - dmFastBlend = dmLinearBlend; - -type - {* Advanced blending modes. See [http://www.brighthub.com/multimedia/photography/articles/18301.aspx Paint.NET blend modes] - and [http://www.pegtop.net/delphi/articles/blendmodes/ Formulas]. Blending layers has two steps. The first one is - to apply the blend operations listed below, and the second is the actual merging of the colors } - TBlendOperation = ( - {** Simple blend, except that it forces a linear merge so it is equivalent to ''dmLinearBlend'' } - boLinearBlend, - {** Simple blend. It is equivalent to ''dmLinearBlend'' or ''dmDrawWithTransparency'' } - boTransparent, - {** Lighting blend modes (tends to increase the luminosity) } - boLighten, boScreen, boAdditive, boLinearAdd, boColorDodge, boDivide, boNiceGlow, boSoftLight, boHardLight, - {** Masking blend modes (tends to decrease the luminosity) } - boGlow, boReflect, boOverlay, boDarkOverlay, boDarken, boMultiply, boColorBurn, - {** Difference blend modes } - boDifference, boLinearDifference, boExclusion, boLinearExclusion, boSubtract, boLinearSubtract, boSubtractInverse, boLinearSubtractInverse, - {** Negation blend modes } - boNegation, boLinearNegation, - {** Xor blend mode. It is sightly different from ''dmXor'' because the alpha value is used like in other blends modes } - boXor, - {** SVG implementation of soft light **} - boSvgSoftLight, - {** Apply mask **} - boMask, - {** Standard HSL colorspace } - boLinearMultiplySaturation, boLinearHue, boLinearColor, boLinearLightness, boLinearSaturation, - {** Corrected HSL colorspace (GSB) } - boCorrectedHue, boCorrectedColor, boCorrectedLightness, boCorrectedSaturation - ); - -const - {** Alias to glow that express that this blend mode masks the part where the top layer is black } - boGlowMask = boGlow; - {** Alias because linear or non linear multiply modes are identical } - boLinearMultiply = boMultiply; - {** Alias to express that dark overlay is simply an overlay with gamma correction } - boNonLinearOverlay = boDarkOverlay; - -const - {** String constants for blend modes } - BlendOperationStr : array[TBlendOperation] of string - = ('LinearBlend', 'Transparent', - 'Lighten', 'Screen', 'Additive', 'LinearAdd', 'ColorDodge', 'Divide', 'NiceGlow', 'SoftLight', 'HardLight', - 'Glow', 'Reflect', 'Overlay', 'DarkOverlay', 'Darken', 'Multiply', 'ColorBurn', - 'Difference', 'LinearDifference', 'Exclusion', 'LinearExclusion', 'Subtract', 'LinearSubtract', 'SubtractInverse', 'LinearSubtractInverse', - 'Negation', 'LinearNegation', 'Xor', 'SvgSoftLight', 'Mask', 'LinearMultiplySaturation', - 'LinearHue', 'LinearColor', 'LinearLightness', 'LinearSaturation', - 'CorrectedHue', 'CorrectedColor', 'CorrectedLightness', 'CorrectedSaturation'); - - {** Returns the blend mode expressed by the string } - function StrToBlendOperation(str: string): TBlendOperation; - -type - {* Specifies how a palette handles the alpha channel } - TAlphaChannelPaletteOption = ( - {** The alpha channel is ignored. The alpha channel is considered to be stored elsewhere } - acIgnore, - {** One entry is allocated the fully transparent color } - acTransparentEntry, - {** The alpha channel is fully embedded in the palette so that a color is identified by its four RGBA channels } - acFullChannelInPalette); - - {* Dithering algorithms that specifies how to handle colors that are not found in the palette } - TDitheringAlgorithm = ( - {** The nearest color is to be used instead } - daNearestNeighbor, - {** The nearest color may be used however another color may be used to compensate for the error, - following Floyd-Steinberg algorithm } - daFloydSteinberg); - -{$DEFINE INCLUDE_INTERFACE} -{$i basiccolorspace.inc} - -{$DEFINE INCLUDE_INTERFACE} -{$i extendedcolorspace.inc} - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$i basiccolorspace.inc} - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$i extendedcolorspace.inc} - -function StrToBlendOperation(str: string): TBlendOperation; -var op: TBlendOperation; -begin - result := boTransparent; - str := LowerCase(str); - for op := low(TBlendOperation) to high(TBlendOperation) do - if str = LowerCase(BlendOperationStr[op]) then - begin - result := op; - exit; - end; -end; - -{************************** Color functions **************************} - -procedure AllocateBGRAPixelBuffer(var ABuffer: TBGRAPixelBuffer; ASize: integer); -begin - if ASize > length(ABuffer) then - setlength(ABuffer, max(length(ABuffer)*2,ASize)); -end; - -function BGRA(red, green, blue, alpha: byte): TBGRAPixel; -begin - LongWord(result) := (red shl TBGRAPixel_RedShift) or - (green shl TBGRAPixel_GreenShift) or - (blue shl TBGRAPixel_BlueShift) or - (alpha shl TBGRAPixel_AlphaShift); -end; - -function BGRA(red, green, blue: byte): TBGRAPixel; overload; -begin - LongWord(result) := (red shl TBGRAPixel_RedShift) or - (green shl TBGRAPixel_GreenShift) or - (blue shl TBGRAPixel_BlueShift) or - (255 shl TBGRAPixel_AlphaShift); -end; - -operator = (const c1, c2: TBGRAPixel): boolean; -begin - if (c1.alpha = 0) and (c2.alpha = 0) then - Result := True - else - Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and - (c1.green = c2.green) and (c1.blue = c2.blue); -end; - -function GetIntensity(c: TBGRAPixel): word; -begin - Result := c.red; - if c.green > Result then - Result := c.green; - if c.blue > Result then - Result := c.blue; - result := GammaExpansionTab[Result]; -end; - -function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel; -begin - result := GammaCompression(SetIntensity(GammaExpansion(c),intensity)); -end; - -function GetLightness(c: TBGRAPixel): word; -begin - result := GetLightness(GammaExpansion(c)); -end; - -function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel; -begin - result := GammaCompression(SetLightness(GammaExpansion(c),lightness)); -end; - -function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; -var - r,g,b: word; - lightness256: byte; -begin - if lightness <= 32768 then - begin - if lightness = 32768 then - result := color else - begin - lightness256 := GammaCompressionTab[lightness shl 1]; - result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8, - color.blue * lightness256 shr 8, color.alpha); - end; - end else - begin - if lightness = 65535 then - result := BGRA(255,255,255,color.alpha) else - begin - dec(lightness, 32767); - r := GammaExpansionTab[color.red]; - g := GammaExpansionTab[color.green]; - b := GammaExpansionTab[color.blue]; - result := BGRA(GammaCompressionTab[ r + (not r)*lightness shr 15 ], - GammaCompressionTab[ g + (not g)*lightness shr 15 ], - GammaCompressionTab[ b + (not b)*lightness shr 15 ], - color.alpha); - end; - end; -end; - -function ApplyIntensityFast(color: TBGRAPixel; lightness: LongWord): TBGRAPixel; -var - maxValue,invMaxValue,r,g,b: LongWord; - lightness256: byte; -begin - if lightness <= 32768 then - begin - if lightness = 32768 then - result := color else - begin - lightness256 := GammaCompressionTab[lightness shl 1]; - result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8, - color.blue * lightness256 shr 8, color.alpha); - end; - end else - begin - r := CombineLightness(GammaExpansionTab[color.red], lightness); - g := CombineLightness(GammaExpansionTab[color.green], lightness); - b := CombineLightness(GammaExpansionTab[color.blue], lightness); - maxValue := r; - if g > maxValue then maxValue := g; - if b > maxValue then maxValue := b; - if maxValue <= 65535 then - result := BGRA(GammaCompressionTab[r], - GammaCompressionTab[g], - GammaCompressionTab[b], - color.alpha) - else - begin - invMaxValue := (LongWord(2147483647)+LongWord(maxValue-1)) div maxValue; - maxValue := (maxValue-65535) shr 1; - r := r*invMaxValue shr 15 + maxValue; - g := g*invMaxValue shr 15 + maxValue; - b := b*invMaxValue shr 15 + maxValue; - if r >= 65535 then result.red := 255 else - result.red := GammaCompressionTab[r]; - if g >= 65535 then result.green := 255 else - result.green := GammaCompressionTab[g]; - if b >= 65535 then result.blue := 255 else - result.blue := GammaCompressionTab[b]; - result.alpha := color.alpha; - end; - end; -end; - -function CombineLightness(lightness1,lightness2: Int32or64): Int32or64; -{$ifdef CPUI386} {$asmmode intel} assembler; - asm - imul edx - shl edx, 17 - shr eax, 15 - or edx, eax - mov result, edx - end; -{$ELSE} -begin - if (lightness1 < 0) xor (lightness2 < 0) then - result := -(int64(-lightness1)*lightness2 shr 15) - else - result := int64(lightness1)*lightness2 shr 15; -end; -{$ENDIF} - -// Conversion to grayscale by taking into account -// different color weights -function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel; -var - ec: TExpandedPixel; - gray: word; - cgray: byte; -begin - if c.alpha = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - //gamma expansion - ec := GammaExpansion(c); - //gray composition - gray := (ec.red * redWeightShl10 + ec.green * greenWeightShl10 + - ec.blue * blueWeightShl10 + 512) shr 10; - //gamma compression - cgray := GammaCompressionTab[gray]; - Result.red := cgray; - Result.green := cgray; - Result.blue := cgray; - Result.alpha := c.alpha; -end; - -function BGRAToGrayscaleLinear(c: TBGRAPixel): TBGRAPixel; -var - gray: byte; -begin - if c.alpha = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - //gray composition - gray := (c.red * redWeightShl10 + c.green * greenWeightShl10 + - c.blue * blueWeightShl10 + 512) shr 10; - //gamma compression - Result.red := gray; - Result.green := gray; - Result.blue := gray; - Result.alpha := c.alpha; -end; - -function GrayscaleToBGRA(lightness: word): TBGRAPixel; -begin - result.red := GammaCompressionTab[lightness]; - result.green := result.red; - result.blue := result.red; - result.alpha := $ff; -end; - -{ Merge linearly two colors of same importance } -function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; -var c12: LongWord; -begin - if (c1.alpha = 0) then - Result := c2 - else - if (c2.alpha = 0) then - Result := c1 - else - begin - c12 := c1.alpha + c2.alpha; - Result.red := (c1.red * c1.alpha + c2.red * c2.alpha + c12 shr 1) div c12; - Result.green := (c1.green * c1.alpha + c2.green * c2.alpha + c12 shr 1) div c12; - Result.blue := (c1.blue * c1.alpha + c2.blue * c2.alpha + c12 shr 1) div c12; - Result.alpha := (c12 + 1) shr 1; - end; -end; - -function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; - weight2: integer): TBGRAPixel; -var - f1,f2,f12: int64; -begin - if (weight1 = 0) or (c1.alpha = 0) then - begin - if (weight2 = 0) or (c2.alpha = 0) then - result := BGRAPixelTransparent - else - Result := c2 - end - else - if (weight2 = 0) or (c2.alpha = 0) then - Result := c1 - else - if (weight1+weight2 = 0) then - Result := BGRAPixelTransparent - else - begin - f1 := int64(c1.alpha)*weight1; - f2 := int64(c2.alpha)*weight2; - f12 := f1+f2; - if f12 = 0 then - result := BGRAPixelTransparent - else - begin - Result.red := (c1.red * f1 + c2.red * f2 + f12 shr 1) div f12; - Result.green := (c1.green * f1 + c2.green * f2 + f12 shr 1) div f12; - Result.blue := (c1.blue * f1 + c2.blue * f2 + f12 shr 1) div f12; - {$hints off} - Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2); - {$hints on} - end; - end; -end; - -function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel; - weight2: byte): TBGRAPixel; -var - w1,w2,f1,f2,f12,a: UInt32or64; -begin - w1 := weight1; - w2 := weight2; - if (w1 = 0) or (c1.alpha = 0) then - begin - if (w2 = 0) or (c2.alpha = 0) then - result := BGRAPixelTransparent - else - Result := c2 - end - else - if (w2 = 0) or (c2.alpha = 0) then - Result := c1 - else - begin - f1 := c1.alpha*w1; - f2 := c2.alpha*w2; - a := (f1+f2 + ((w1+w2) shr 1)) div (w1+w2); - if a = 0 then - begin - result := BGRAPixelTransparent; - exit; - end else - Result.alpha := a; - {$IFNDEF CPU64} - if (f1 >= 32768) or (f2 >= 32768) then - begin - f1 := f1 shr 1; - f2 := f2 shr 1; - end; - {$ENDIF} - f12 := f1+f2; - Result.red := GammaCompressionTab[(GammaExpansionTab[c1.red] * f1 + GammaExpansionTab[c2.red] * f2) div f12]; - Result.green := GammaCompressionTab[(GammaExpansionTab[c1.green] * f1 + GammaExpansionTab[c2.green] * f2) div f12]; - Result.blue := GammaCompressionTab[(GammaExpansionTab[c1.blue] * f1 + GammaExpansionTab[c2.blue] * f2) div f12]; - end; -end; - -{ Convert a TColor value to a TBGRAPixel value } -{$PUSH}{$R-} -function ColorToBGRA(color: TColor): TBGRAPixel; overload; -begin - if (color < 0) or (color > $ffffff) then color := ColorToRGB(color); - RedGreenBlue(color, Result.red,Result.green,Result.blue); - Result.alpha := 255; -end; - -function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload; -begin - if (color < 0) or (color > $ffffff) then color := ColorToRGB(color); - RedGreenBlue(color, Result.red,Result.green,Result.blue); - Result.alpha := opacity; -end; -{$POP} - -function BGRAToColor(c: TBGRAPixel): TColor; -begin - Result := RGBToColor(c.red, c.green, c.blue); -end; - -function FastRoundDiv257(valueWord: LongWord): byte; inline; -begin - result := LongWord(valueWord + 127 - (valueWord shr 8)) shr 8; -end; - -{ Conversion from TFPColor to TBGRAPixel assuming TFPColor - is already gamma compressed } -function FPColorToBGRA(AValue: TFPColor): TBGRAPixel; -begin - with AValue do - Result := BGRA(FastRoundDiv257(red), FastRoundDiv257(green), FastRoundDiv257(blue), alpha shr 8); -end; - -function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline; -begin - result.red := AValue.red shl 8 + AValue.red; - result.green := AValue.green shl 8 + AValue.green; - result.blue := AValue.blue shl 8 + AValue.blue; - result.alpha := AValue.alpha shl 8 + AValue.alpha; -end; - -function Color16BitToBGRA(AColor: Word): TBGRAPixel; -begin - result := BGRA( ((AColor and $F800) shr 11)*255 div 31, - ((AColor and $07e0) shr 5)*255 div 63, - (AColor and $001f)*255 div 31 ); -end; - -function BGRAToColor16Bit(const AColor: TBGRAPixel): Word; -begin - result := (((AColor.Red * 31 + 64) div 255) shl 11) + - (((AColor.green * 63 + 64) div 255) shl 5) + - ((AColor.blue * 31 + 64) div 255); -end; - -function BGRAWordDiff(c1, c2: TBGRAPixel): word; -begin - if c1 = c2 then result := 0 - else result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)); -end; - -function BGRADiff(c1,c2: TBGRAPixel): byte; -begin - if c1 = c2 then result := 0 - else result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)) shr 8; -end; - -function FastBGRALinearDiff(c1, c2: TBGRAPixel): byte; -begin - result := max(min((abs(c1.red-c2.red)+(abs(c1.green-c2.green) shl 1)+abs(c1.blue-c2.blue)) shr 2, - min(c1.alpha,c2.alpha)), abs(c1.alpha-c2.alpha)); -end; - -function FastBGRAExpandedDiff(c1, c2: TBGRAPixel): word; -var wa1,wa2: word; -begin - wa1 := c1.alpha shl 8 + c1.alpha; - wa2 := (c2.alpha shl 8) + c2.alpha; - result := max(min((abs(GammaExpansionTab[c1.red]-GammaExpansionTab[c2.red])+ - (abs(GammaExpansionTab[c1.green]-GammaExpansionTab[c2.green]) shl 1)+ - abs(GammaExpansionTab[c1.blue]-GammaExpansionTab[c2.blue])) shr 2, - min(wa1,wa2)), - abs(wa1-wa2)); -end; - -function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel; -var - sumR,sumG,sumB,sumA: UInt32or64; - i: integer; -begin - if length(colors)<=0 then - begin - result := BGRAPixelTransparent; - exit; - end; - sumR := 0; - sumG := 0; - sumB := 0; - sumA := 0; - for i := 0 to high(colors) do - with colors[i] do - begin - inc(sumR, red*alpha); - inc(sumG, green*alpha); - inc(sumB, blue*alpha); - inc(sumA, alpha); - end; - if sumA > 0 then - begin - result.red := (sumR + sumA shr 1) div sumA; - result.green := (sumG + sumA shr 1) div sumA; - result.blue := (sumB + sumA shr 1) div sumA; - result.alpha := sumA div LongWord(length(colors)); - end - else - result := BGRAPixelTransparent; -end; - -function MapHeight(Color: TBGRAPixel): Single; -var intval: integer; -begin - intval := color.Green shl 16 + color.red shl 8 + color.blue; - result := intval*5.960464832810452e-8; -end; - -function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel; -var intval: integer; -begin - if Height >= 1 then result := BGRA(255,255,255,alpha) else - if Height <= 0 then result := BGRA(0,0,0,alpha) else - begin - intval := round(Height*16777215); - {$PUSH}{$R-} - result := BGRA(intval shr 8,intval shr 16,intval,alpha); - {$POP} - end; -end; -{$ENDIF} - -{$IFDEF INCLUDE_INIT} -{$UNDEF INCLUDE_INIT} - BGRASetGamma(); - - {$DEFINE INCLUDE_INITIALIZATION} - {$i extendedcolorspace.inc} -{$ENDIF} diff --git a/components/bgrabitmap/bgrapolygon.pas b/components/bgrabitmap/bgrapolygon.pas deleted file mode 100644 index 7833465..0000000 --- a/components/bgrabitmap/bgrapolygon.pas +++ /dev/null @@ -1,1585 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAPolygon; - -{$mode objfpc}{$H+} - -{ This unit contains polygon drawing functions and spline functions. - - Shapes are drawn using a TBGRACustomFillInfo object, which calculates the - intersection of an horizontal line and the polygon. - - Various shapes are handled : - - TFillPolyInfo : polygon scanned in any order - - TSimpleFillPolyInfo : polygon with few points - - TOnePassFillPolyInfo : polygon scanned from top to bottom - - TFillEllipseInfo : ellipse - - TFillBorderEllipseInfo : ellipse border - - TFillRoundRectangleInfo : round rectangle (or other corners) - - TFillBorderRoundRectInfo : round rectangle border - - Various fill modes : - - Alternate : each time there is an intersection, it enters or go out of the polygon - - Winding : filled when the sum of ascending and descending intersection is non zero - - Color : fill with a color defined as a TBGRAPixel argument - - Erase : erase with an alpha in the TBGRAPixel argument - - Texture : draws a texture with the IBGRAScanner argument - - Various border handling : - - aliased : one horizontal line intersection is calculated per pixel in the vertical loop - - antialiased : more lines are calculated and a density is computed by adding them together - - multi-polygon antialiasing and superposition (TBGRAMultiShapeFiller) : same as above but - by combining multiple polygons at the same time, and optionally subtracting top polygons - } - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAFillInfo, BGRAPath; - -procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; - c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false); -procedure FillShapeAliased(bmp: TCustomUniversalBitmap; shapeInfo: TBGRACustomFillInfo; - brush: TUniversalBrush; Alpha: Word; NonZeroWinding: boolean; AliasingIncludeBottomRight: Boolean= false); -procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF; - c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true); -procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap; const points: array of TPointF; - scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true); -procedure FillPolyAliased(bmp: TCustomUniversalBitmap; const points: array of TPointF; - brush: TUniversalBrush; Alpha: Word; NonZeroWinding: boolean; APixelCenteredCoordinates: boolean = true); - -procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; - c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false); -procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; - c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode); -procedure FillShapeAntialias(bmp: TCustomUniversalBitmap; shapeInfo: TBGRACustomFillInfo; - brush: TUniversalBrush; NonZeroWinding: boolean); -procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; - scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false); -procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF; - c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); -procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap; const points: array of TPointF; - scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); -procedure FillPolyAntialias(bmp: TCustomUniversalBitmap; const points: array of TPointF; - brush: TUniversalBrush; NonZeroWinding: boolean; APixelCenteredCoordinates: boolean = true); - -type - - { TBGRAMultishapeFiller } - - TBGRAMultishapeFiller = class - protected - nbShapes: integer; - shapes: array of record - info: TBGRACustomFillInfo; - internalInfo: boolean; - texture: IBGRAScanner; - internalTexture: TObject; - color: TExpandedPixel; - bounds: TRect; - fillMode: TFillMode; - fillModeOverride: boolean; - end; - function AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel): integer; overload; - function CheckRectangleBorderBounds(var x1, y1, x2, y2: single; w: single): boolean; - procedure InternalAddStroke(const APoints: array of TPointF; AClosed: boolean; AData: Pointer); - public - FillMode : TFillMode; - PolygonOrder: TPolygonOrder; - Antialiasing: Boolean; - AliasingIncludeBottomRight: Boolean; - constructor Create; - destructor Destroy; override; - function AddShape(AShape: TBGRACustomFillInfo; AColor: TBGRAPixel): integer; overload; - function AddShape(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner): integer; overload; - function AddPolygon(const points: array of TPointF; AColor: TBGRAPixel): integer; overload; - function AddPolygon(const points: array of TPointF; ATexture: IBGRAScanner): integer; overload; - procedure AddPathStroke(APath: TBGRAPath; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); overload; - procedure AddPathStroke(APath: TBGRAPath; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); overload; - procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); overload; - procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); overload; - function AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel): integer; overload; - function AddPathFill(APath: TBGRAPath; ATexture: IBGRAScanner): integer; overload; - function AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel): integer; overload; - function AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner): integer; overload; - function AddPolylineStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; - function AddPolylineStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; - function AddPolygonStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; - function AddPolygonStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload; - function AddTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, c2, c3: TBGRAPixel): integer; - function AddTriangleLinearMapping(pt1, pt2, pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF): integer; - procedure AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, c2, c3, c4: TBGRAPixel); - procedure AddQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, {%H-}tex3, tex4: TPointF; - ACulling: TFaceCulling = fcNone); - procedure AddQuadPerspectiveMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); - function AddEllipse(x, y, rx, ry: single; AColor: TBGRAPixel): integer; overload; - function AddEllipse(x, y, rx, ry: single; ATexture: IBGRAScanner): integer; overload; - function AddEllipseBorder(x, y, rx, ry, w: single; AColor: TBGRAPixel): integer; overload; - function AddEllipseBorder(x, y, rx, ry, w: single; ATexture: IBGRAScanner): integer; overload; - function AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []): integer; overload; - function AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []): integer; overload; - function AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []): integer; overload; - function AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []): integer; overload; - function AddRectangle(x1, y1, x2, y2: single; AColor: TBGRAPixel): integer; overload; - function AddRectangle(x1, y1, x2, y2: single; ATexture: IBGRAScanner): integer; overload; - function AddRectangleBorder(x1, y1, x2, y2, w: single; AColor: TBGRAPixel): integer; overload; - function AddRectangleBorder(x1, y1, x2, y2, w: single; ATexture: IBGRAScanner): integer; overload; - procedure OverrideFillMode(AShapeIndex: integer; AFillMode: TFillMode); - procedure Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency); - property ShapeCount: integer read nbShapes; - end; - -procedure FillEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, ry: single; ABrush: TUniversalBrush); -procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single; - c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false); -procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry: single; - scan: IBGRAScanner; LinearBlend: boolean = false); - -procedure BorderEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, ry, w: single; ABrush: TUniversalBrush); -procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; - c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false); -procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; - scan: IBGRAScanner; LinearBlend: boolean = false); - -procedure BorderEllipse(bmp: TCustomUniversalBitmap; x, y, rx, ry, w: single; ABrush: TUniversalBrush; AAlpha: word = 65535); -procedure BorderEllipse(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; - c: TBGRAPixel; EraseMode: boolean; drawmode: TDrawMode); -procedure BorderEllipseWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; - scan: IBGRAScanner; drawmode: TDrawMode); - -procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single; - options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); -procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single; - options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); - -procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single; - options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); -procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single; - options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true); - -procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single; - options: TRoundRectangleOptions; bordercolor,fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean; APixelCenteredCoordinates: boolean = true); - -implementation - -uses Math, BGRABlend, BGRAGradientScanner, BGRATransform; - -procedure AnyBrush(out ABrush: TUniversalBrush; ABmp: TBGRACustomBitmap; ACol: TBGRAPixel; - AEraseMode: boolean; AScan: IBGRAScanner; ADrawmode: TDrawMode); -begin - if AScan <> nil then - ABmp.ScannerBrush(ABrush, AScan, ADrawmode) - else - begin - if AEraseMode then ABmp.EraseBrush(ABrush, ACol.alpha + (ACol.alpha shl 8)) - else ABmp.SolidBrush(ABrush, ACol, ADrawmode);; - end; -end; - -procedure AnyBrush(out ABrush: TUniversalBrush; ABmp: TBGRACustomBitmap; ACol: TBGRAPixel; - AEraseMode: boolean; AScan: IBGRAScanner; ALinearBlend: boolean); -begin - if ALinearBlend then AnyBrush(ABrush,ABmp,ACol,AEraseMode,AScan,dmLinearBlend) - else AnyBrush(ABrush,ABmp,ACol,AEraseMode,AScan,dmDrawWithTransparency); -end; - -procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; - c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false); -var - bFill: TUniversalBrush; -begin - AnyBrush(bFill, bmp, c,EraseMode,scan,drawmode); - FillShapeAliased(bmp, shapeInfo, bFill,65535,NonZeroWinding,AliasingIncludeBottomRight); -end; - -procedure FillShapeAliased(bmp: TCustomUniversalBitmap; - shapeInfo: TBGRACustomFillInfo; brush: TUniversalBrush; Alpha: Word; - NonZeroWinding: boolean; AliasingIncludeBottomRight: Boolean); -var - inter: array of TIntersectionInfo; - nbInter: integer; - - miny, maxy, minx, maxx: integer; - yb, i: integer; - x1, x2: single; - ix1, ix2: integer; - pdest: PByte; - AliasingOfs: TPointF; - ctx: TUniBrushContext; - -begin - if brush.DoesNothing or (Alpha=0) then exit; - If not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp.ClipRect) then exit; - inter := shapeInfo.CreateIntersectionArray; - - if AliasingIncludeBottomRight then - AliasingOfs := PointF(0.0001, 0.0001) else - AliasingOfs := PointF(0,0); - bmp.LoadFromBitmapIfNeeded; - - //vertical scan - for yb := miny to maxy do - begin - //find intersections - shapeInfo.ComputeAndSort( yb+0.5-AliasingOfs.Y, inter, nbInter, NonZeroWinding); - - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX+AliasingOfs.X; - x2 := inter[i + i+ 1].interX+AliasingOfs.X; - - if x1 <> x2 then - begin - ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); - if ix1 <= ix2 then - begin - //render scanline - pdest := bmp.GetPixelAddress(ix1,yb); - brush.MoveTo(@ctx, pdest, ix1,yb); - brush.PutNextPixels(@ctx, Alpha, ix2-ix1+1); - end; - end; - end; - end; - - shapeInfo.FreeIntersectionArray(inter); - bmp.InvalidateBitmap; -end; - -procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF; - c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp, c,EraseMode,nil,drawmode); - FillPolyAliased(bmp, points, b, 65535, NonZeroWinding, APixelCenteredCoordinates); -end; - -procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap; - const points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp, BGRAPixelTransparent,false,scan,drawmode); - FillPolyAliased(bmp, points, b, 65535, NonZeroWinding, APixelCenteredCoordinates); -end; - -procedure FillPolyAliased(bmp: TCustomUniversalBitmap; - const points: array of TPointF; brush: TUniversalBrush; Alpha: Word; - NonZeroWinding: boolean; APixelCenteredCoordinates: boolean); -var - info: TCustomFillPolyInfo; -begin - if brush.DoesNothing or (length(points) < 3) then exit; - if length(points)<=10 then - info := TSimpleFillPolyInfo.Create(points, APixelCenteredCoordinates) - else - info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates); - FillShapeAliased(bmp, info, brush, Alpha, NonZeroWinding); - info.Free; -end; - -////////////////////////////////////////////////////////////////////////////// - -procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo; - c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false); -var - drawMode: TDrawMode; -begin - if LinearBlend then drawMode := dmLinearBlend else drawMode := dmDrawWithTransparency; - FillShapeAntialias(bmp, shapeInfo, c, EraseMode, scan, NonZeroWinding, drawmode); -end; - -procedure FillShapeAntialias(bmp: TBGRACustomBitmap; - shapeInfo: TBGRACustomFillInfo; c: TBGRAPixel; EraseMode: boolean; - scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode); -var - bFill: TUniversalBrush; -begin - AnyBrush(bFill, bmp, c,EraseMode,scan,drawmode); - FillShapeAntialias(bmp, shapeInfo, bFill,NonZeroWinding); -end; - -procedure FillShapeAntialias(bmp: TCustomUniversalBitmap; - shapeInfo: TBGRACustomFillInfo; brush: TUniversalBrush; - NonZeroWinding: boolean); -const oneOver512 = 1/512; -var - inter: array of TIntersectionInfo; - nbInter: integer; - - firstScan, lastScan: record - inter: array of TIntersectionInfo; - nbInter: integer; - sliceIndex: integer; - end; - - miny, maxy, minx, maxx, - densMinX, densMaxX: integer; - joinDensity, nextJoinDensity: boolean; - - density: PDensity; - - xb, yb, yc, i: integer; - tempDensity: UInt32or64; - - x1, x2, x1b,x2b: single; - ix1, ix2, drawCount: integer; - pdens: PDensity; - - curvedSeg,optimised: boolean; - temp: Single; - pDest: PByte; - ctx: TUniBrushContext; - - function GetYScan(num: integer): single; inline; - begin - result := yb + (num * 2 + 1) / (AntialiasPrecision * 2); - end; - - procedure SubTriangleDensity(x1,density1, x2, density2: single); - var ix1,ix2,n: integer; - slope: single; - function densityAt(x: single): single; inline; - begin - result := (x-x1)*slope+density1; - end; - var - curdens: single; - pdens: pdensity; - newvalue: Int32or64; - begin - if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then - begin - slope := (density2-density1)/(x2-x1); - if x1 < minx then - begin - density1 := densityAt(minx); - x1 := minx; - end; - if x2 >= maxx + 1 then - begin - density2 := densityAt(maxx+1); - x2 := maxx + 1; - end; - ix1 := floor(x1); - ix2 := floor(x2); - - if ix1 = ix2 then - begin - newValue := (density + (ix1 - minx))^ - round((x2 - x1)*(density1+density2)/2); - if newValue < 0 then newValue := 0; - if newValue > 256 then newValue := 256; - (density + (ix1 - minx))^ := newValue - end - else - begin - newValue := (density + (ix1 - minx))^ - round((1 - (x1 - ix1))*(density1+densityAt(ix1+1))/2) ; - if newValue < 0 then newValue := 0; - if newValue > 256 then newValue := 256; - (density + (ix1 - minx))^ := newValue; - if (ix2 <= maxx) then - begin - newValue := (density + (ix2 - minx))^ - round((x2 - ix2)*(density2+densityAt(ix2))/2); - if newValue < 0 then newValue := 0; - if newValue > 256 then newValue := 256; - (density + (ix2 - minx))^ := newValue; - end; - end; - if ix2 > ix1 + 1 then - begin - curdens := densityAt(ix1+1.5); - pdens := density + (ix1+1 - minx); - for n := ix2-1-(ix1+1) downto 0 do - begin - newValue := pdens^ - round(curdens); - if newValue < 0 then newValue := 0; - if newValue > 256 then newValue := 256; - pdens^ := newValue; - IncF(curdens, slope); - inc(pdens); - end; - end; - end; - end; - -begin - If brush.DoesNothing or not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp.ClipRect) then exit; - bmp.LoadFromBitmapIfNeeded; - - inter := shapeInfo.CreateIntersectionArray; - getmem(density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety - - curvedSeg := shapeInfo.SegmentsCurved; - if not curvedSeg then - begin - firstScan.inter := shapeInfo.CreateIntersectionArray; - lastScan.inter := shapeInfo.CreateIntersectionArray; - end; - - //vertical scan - for yb := miny to maxy do - begin - //mean density - fillchar(density^,(maxx-minx+1)*sizeof(TDensity),0); - - densMinX := maxx+1; - densMaxX := minx-1; - - if not curvedSeg then - begin - with firstScan do - begin - shapeInfo.ComputeAndSort(yb+1/256,inter,nbInter,NonZeroWinding); - sliceIndex:= shapeInfo.GetSliceIndex; - end; - with lastScan do - begin - shapeInfo.ComputeAndSort(yb+255/256,inter,nbInter,NonZeroWinding); - sliceIndex:= shapeInfo.GetSliceIndex; - end; - if (firstScan.sliceIndex = lastScan.sliceIndex) and (firstScan.nbInter = lastScan.nbInter) then - begin - optimised := true; - for i := 0 to firstScan.nbInter-1 do - if firstScan.inter[i].numSegment <> lastScan.inter[i].numSegment then - begin - optimised := false; - break; - end; - end else - optimised := false; - - if optimised then - begin - nextJoinDensity := false; - for i := 0 to firstScan.nbinter div 2 - 1 do - begin - joinDensity := nextJoinDensity; - x1 := firstScan.inter[i+i].interX; - x1b := lastScan.inter[i+i].interX; - x2 := firstScan.inter[i+i+1].interX; - x2b := lastScan.inter[i+i+1].interX; - nextJoinDensity := not ((i+i+2 >= firstScan.nbInter) or - ((firstScan.inter[i+i+2].interX >= x2+1) and - (lastScan.inter[i+i+2].interX >= x2b+1))); - if (abs(x1-x1b)= maxx+1 then - begin - x2 := maxx+1; - ix2 := maxx; - end else - ix2 := floor(x2); - if ix2 > maxx then ix2 := maxx; - - if ix1>ix2 then continue; - pDest := bmp.GetPixelAddress(ix1,yb); - brush.MoveTo(@ctx,pDest,ix1,yb); - if ix1=ix2 then - begin - tempDensity:= round((x2-x1)*65535); - brush.PutNextPixels(@ctx,tempDensity,1); - end else - begin - tempDensity:= round((ix1+1-x1)*65535); - brush.PutNextPixels(@ctx,tempDensity,1); - inc(ix1); - - tempDensity:= round((x2-ix2)*65535); - if tempDensity < 65535 then - begin - dec(ix2); - if ix2 >= ix1 then brush.PutNextPixels(@ctx,65535,ix2-ix1+1); - brush.PutNextPixels(@ctx,tempDensity,1); - end else - brush.PutNextPixels(@ctx,65535,ix2-ix1+1); - end; - continue; - end else - begin - if (x1 > x1b) then - begin - temp := x1; - x1 := x1b; - x1b := temp; - end; - if (x2 < x2b) then - begin - temp := x2; - x2 := x2b; - x2b := temp; - end; - - {$DEFINE INCLUDE_FILLDENSITY} - {$DEFINE PARAM_SINGLESEGMENT} - {$i density256.inc} - SubTriangleDensity(x1,256,x1b,0); - SubTriangleDensity(x2b,0,x2,256); - end; - end; - end else - begin - for yc := 0 to AntialiasPrecision - 1 do - begin - //find intersections - shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding); - - {$DEFINE INCLUDE_FILLDENSITY} - {$i density256.inc} - end; - end; - end else - begin - optimised := false; - //precision scan - for yc := 0 to AntialiasPrecision - 1 do - begin - //find intersections - shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding); - - {$DEFINE INCLUDE_FILLDENSITY} - {$i density256.inc} - end; - end; - - if optimised then - {$DEFINE INCLUDE_RENDERDENSITY} - {$i density256.inc} - else - {$DEFINE INCLUDE_RENDERDENSITY} - {$define PARAM_ANTIALIASINGFACTOR} - {$i density256.inc} - end; - - shapeInfo.FreeIntersectionArray(inter); - - if not curvedSeg then - begin - with firstScan do - begin - for i := 0 to high(inter) do - inter[i].free; - end; - with lastScan do - begin - for i := 0 to high(inter) do - inter[i].free; - end; - end; - freemem(density); - - bmp.InvalidateBitmap; -end; - -procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap; - shapeInfo: TBGRACustomFillInfo; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean); -begin - FillShapeAntialias(bmp,shapeInfo,BGRAPixelTransparent,False,scan,NonZeroWinding,LinearBlend); -end; - -procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF; - c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp,c,EraseMode,nil,LinearBlend); - FillPolyAntialias(bmp, points, b, NonZeroWinding, APixelCenteredCoordinates); -end; - -procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap; - const points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp,BGRAPixelTransparent,false,scan,LinearBlend); - FillPolyAntialias(bmp, points, b, NonZeroWinding, APixelCenteredCoordinates); -end; - -procedure FillPolyAntialias(bmp: TCustomUniversalBitmap; - const points: array of TPointF; brush: TUniversalBrush; - NonZeroWinding: boolean; APixelCenteredCoordinates: boolean); -var - info: TCustomFillPolyInfo; -begin - if brush.DoesNothing or (length(points) < 3) then exit; - info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates); - FillShapeAntialias(bmp, info, brush, NonZeroWinding); - info.Free; -end; - -//////////////////////////////////////////////////////////////////////// - -{ TBGRAMultishapeFiller } - -type - TPathStrokeData = record - Stroker: TBGRACustomPenStroker; - Texture: IBGRAScanner; - Color: TBGRAPixel; - Width: Single; - end; - -function TBGRAMultishapeFiller.AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel): integer; -begin - if length(shapes) = nbShapes then - setlength(shapes, (length(shapes)+1)*2); - result := nbShapes; - inc(nbShapes); - - with shapes[result] do - begin - info := AInfo; - internalInfo:= AInternalInfo; - texture := ATexture; - internalTexture:= AInternalTexture; - color := GammaExpansion(AColor); - fillModeOverride:= false; - end; -end; - -function TBGRAMultishapeFiller.CheckRectangleBorderBounds(var x1, y1, x2, - y2: single; w: single): boolean; -var temp: single; -begin - if x1 > x2 then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - if y1 > y2 then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; - result := (x2-x1 > w) and (y2-y1 > w); -end; - -procedure TBGRAMultishapeFiller.InternalAddStroke( - const APoints: array of TPointF; AClosed: boolean; AData: Pointer); -var pts: ArrayOfTPointF; - idxShape: Integer; -begin - with TPathStrokeData(AData^) do - begin - if AClosed then - pts := Stroker.ComputePolygon(APoints, Width) - else - pts := Stroker.ComputePolylineAutoCycle(APoints, Width); - if Texture <> nil then - idxShape := AddPolygon(pts, Texture) - else - idxShape := AddPolygon(pts, Color); - OverrideFillMode(idxShape, fmWinding); - end; -end; - -constructor TBGRAMultishapeFiller.Create; -begin - nbShapes := 0; - shapes := nil; - PolygonOrder := poNone; - Antialiasing := True; - AliasingIncludeBottomRight := False; -end; - -destructor TBGRAMultishapeFiller.Destroy; -var - i: Integer; -begin - for i := 0 to nbShapes-1 do - begin - if shapes[i].internalInfo then shapes[i].info.free; - shapes[i].texture := nil; - if shapes[i].internalTexture <> nil then shapes[i].internalTexture.Free; - end; - shapes := nil; - inherited Destroy; -end; - -function TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo; - AColor: TBGRAPixel): integer; -begin - result := AddShape(AShape,False,nil,nil,AColor); -end; - -function TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo; - ATexture: IBGRAScanner): integer; -begin - result := AddShape(AShape,False,ATexture,nil,BGRAPixelTransparent); -end; - -function TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF; - AColor: TBGRAPixel): integer; -begin - if length(points) <= 2 then exit(-1); - result := AddShape(TOnePassFillPolyInfo.Create(points),True,nil,nil,AColor); -end; - -function TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF; - ATexture: IBGRAScanner): integer; -begin - if length(points) <= 2 then exit(-1); - result := AddShape(TOnePassFillPolyInfo.Create(points),True,ATexture,nil,BGRAPixelTransparent); -end; - -procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; - AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); -begin - AddPathStroke(APath,AffineMatrixIdentity,AColor,AWidth,AStroker); -end; - -procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; - ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); -begin - AddPathStroke(APath,AffineMatrixIdentity,ATexture,AWidth,AStroker); -end; - -procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; - AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; - AStroker: TBGRACustomPenStroker); -var data: TPathStrokeData; -begin - data.Stroker := AStroker; - data.Color := AColor; - data.Texture := nil; - data.Width := AWidth; - APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data); -end; - -procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath; - AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; - AStroker: TBGRACustomPenStroker); -var data: TPathStrokeData; -begin - data.Stroker := AStroker; - data.Color := BGRAPixelTransparent; - data.Texture := ATexture; - data.Width := AWidth; - APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data); -end; - -function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel): integer; -begin - result := AddPolygon(APath.ToPoints, AColor); -end; - -function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; - ATexture: IBGRAScanner): integer; -begin - result := AddPolygon(APath.ToPoints, ATexture); -end; - -function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; - AMatrix: TAffineMatrix; AColor: TBGRAPixel): integer; -begin - result := AddPolygon(APath.ToPoints(AMatrix), AColor); -end; - -function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; - AMatrix: TAffineMatrix; ATexture: IBGRAScanner): integer; -begin - result := AddPolygon(APath.ToPoints(AMatrix), ATexture); -end; - -function TBGRAMultishapeFiller.AddPolylineStroke( - const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; - AStroker: TBGRACustomPenStroker): integer; -begin - result := AddPolygon(AStroker.ComputePolyline(points,AWidth,AColor), AColor); -end; - -function TBGRAMultishapeFiller.AddPolylineStroke( - const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; - AStroker: TBGRACustomPenStroker): integer; -begin - result := AddPolygon(AStroker.ComputePolyline(points,AWidth), ATexture); -end; - -function TBGRAMultishapeFiller.AddPolygonStroke(const points: array of TPointF; - AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; -begin - result := AddPolygon(AStroker.ComputePolygon(points,AWidth), AColor); -end; - -function TBGRAMultishapeFiller.AddPolygonStroke(const points: array of TPointF; - ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker - ): integer; -begin - result := AddPolygon(AStroker.ComputePolygon(points,AWidth), ATexture); -end; - -function TBGRAMultishapeFiller.AddTriangleLinearColor(pt1, pt2, pt3: TPointF; - c1, c2, c3: TBGRAPixel): integer; -var grad: TBGRAGradientTriangleScanner; -begin - if (c1 = c2) and (c2 = c3) then - result := AddPolygon([pt1,pt2,pt3],c1) - else - begin - grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3); - result := AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent); - end; -end; - -function TBGRAMultishapeFiller.AddTriangleLinearMapping(pt1, pt2, pt3: TPointF; - texture: IBGRAScanner; tex1, tex2, tex3: TPointF): integer; -var - mapping: TBGRATriangleLinearMapping; -begin - mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3); - result := AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,mapping,mapping,BGRAPixelTransparent); -end; - -procedure TBGRAMultishapeFiller.AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; - c1, c2, c3, c4: TBGRAPixel); -var - center: TPointF; - centerColor: TBGRAPixel; -begin - if (c1 = c2) and (c2 = c3) and (c3 = c4) then - AddPolygon([pt1,pt2,pt3,pt4],c1) - else - begin - center := (pt1+pt2+pt3+pt4)*(1/4); - centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)), - MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) ); - AddTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor); - AddTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor); - AddTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor); - AddTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor); - end; -end; - -procedure TBGRAMultishapeFiller.AddQuadLinearMapping(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; - ACulling: TFaceCulling); -var - mapping: TBGRAQuadLinearScanner; -begin - mapping := TBGRAQuadLinearScanner.Create(texture, - [tex1,tex2,tex3,tex4], - [pt1,pt2,pt3,pt4]); - mapping.Culling := ACulling; - mapping.Padding := true; - AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,mapping,mapping,BGRAPixelTransparent); -end; - -procedure TBGRAMultishapeFiller.AddQuadPerspectiveMapping(pt1, pt2, pt3, - pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); -var persp: TBGRAPerspectiveScannerTransform; -begin - persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]); - AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,persp,persp,BGRAPixelTransparent); -end; - -function TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single; - AColor: TBGRAPixel): integer; -begin - result := AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,nil,nil,AColor); -end; - -function TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single; - ATexture: IBGRAScanner): integer; -begin - result := AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,ATexture,nil,BGRAPixelTransparent); -end; - -function TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single; - AColor: TBGRAPixel): integer; -begin - result := AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,nil,nil,AColor); -end; - -function TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single; - ATexture: IBGRAScanner): integer; -begin - result := AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,ATexture,nil,BGRAPixelTransparent); -end; - -function TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx, - ry: single; AColor: TBGRAPixel; options: TRoundRectangleOptions): integer; -begin - result := AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True,nil,nil,AColor); -end; - -function TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx, - ry: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions): integer; -begin - result := AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True, - ATexture,nil,BGRAPixelTransparent); -end; - -function TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, - w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions): integer; -begin - result := AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True, - nil,nil,AColor); -end; - -function TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, - w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions): integer; -begin - result := AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True, - ATexture,nil,BGRAPixelTransparent); -end; - -function TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single; - AColor: TBGRAPixel): integer; -begin - result := AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],AColor); -end; - -function TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single; - ATexture: IBGRAScanner): integer; -begin - result := AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],ATexture); -end; - -function TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2, w: single; - AColor: TBGRAPixel): integer; -var hw : single; -begin - hw := w/2; - if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then - result := AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,AColor) else - result := AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF, - PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],AColor); -end; - -function TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2, w: single; - ATexture: IBGRAScanner): integer; -var hw : single; -begin - hw := w/2; - if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then - result := AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,ATexture) else - result := AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF, - PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],ATexture); -end; - -procedure TBGRAMultishapeFiller.OverrideFillMode(AShapeIndex: integer; - AFillMode: TFillMode); -begin - if AShapeIndex < 0 then exit; - if AShapeIndex >= nbShapes then raise exception.Create('Index out of bounds'); - shapes[AShapeIndex].fillMode := AFillMode; - shapes[AShapeIndex].fillModeOverride := true; -end; - -procedure TBGRAMultishapeFiller.Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency); -var - shapeRow: array of record - density: PDensity; - densMinx,densMaxx: integer; - nbInter: integer; - inter: array of TIntersectionInfo; - end; - shapeRowsList: array of integer; - NbShapeRows: integer; - miny, maxy, minx, maxx, - rowminx, rowmaxx: integer; - - procedure SubstractScanlines(src,dest: integer); - var i: integer; - - procedure SubstractSegment(srcseg: integer); - var x1,x2, x3,x4: single; - j: integer; - - procedure AddSegment(xa,xb: single); - var nb: PInteger; - begin - nb := @shapeRow[dest].nbinter; - if length(shapeRow[dest].inter) < nb^+2 then - setlength(shapeRow[dest].inter, nb^*2+2); - with shapeRow[dest] do - begin - if inter[nb^] = nil then inter[nb^] := shapes[dest].info.CreateIntersectionInfo; - inter[nb^].interX := xa; - if inter[nb^+1] = nil then inter[nb^+1] := shapes[dest].info.CreateIntersectionInfo; - inter[nb^+1].interX := xb; - end; - inc(nb^,2); - end; - - begin - x1 := shapeRow[src].inter[(srcseg-1)*2].interX; - x2 := shapeRow[src].inter[srcseg*2-1].interX; - for j := shapeRow[dest].nbInter div 2 downto 1 do - begin - x3 := shapeRow[dest].inter[(j-1)*2].interX; - x4 := shapeRow[dest].inter[j*2-1].interX; - if (x2 <= x3) or (x1 >= x4) then continue; //not overlapping - if (x1 <= x3) and (x2 >= x4) then - shapeRow[dest].inter[j*2-1].interX := x3 //empty - else - if (x1 <= x3) and (x2 < x4) then - shapeRow[dest].inter[(j-1)*2].interX := x2 //remove left part - else - if (x1 > x3) and (x2 >= x4) then - shapeRow[dest].inter[j*2-1].interX := x1 else //remove right part - begin - //[x1,x2] is inside [x3,x4] - shapeRow[dest].inter[j*2-1].interX := x1; //left part - AddSegment(x2,x4); - end; - end; - end; - - begin - for i := 1 to shapeRow[src].nbInter div 2 do - SubstractSegment(i); - end; - -var - AliasingOfs: TPointF; - useAA: boolean; - - procedure AddOneLineDensity(cury: single); - var - i,k: integer; - ix1,ix2: integer; - x1,x2: single; - begin - for k := 0 to NbShapeRows-1 do - with shapeRow[shapeRowsList[k]], shapes[shapeRowsList[k]] do - begin - //find intersections - info.ComputeAndSort(cury, inter, nbInter, fillMode=fmWinding); - nbInter := nbInter and not 1; //even - end; - - case PolygonOrder of - poLastOnTop: begin - for k := 1 to NbShapeRows-1 do - if shapeRow[shapeRowsList[k]].nbInter > 0 then - for i := 0 to k-1 do - SubstractScanlines(shapeRowsList[k],shapeRowsList[i]); - end; - poFirstOnTop: begin - for k := 0 to NbShapeRows-2 do - if shapeRow[shapeRowsList[k]].nbInter > 0 then - for i := k+1 to NbShapeRows-1 do - SubstractScanlines(shapeRowsList[k],shapeRowsList[i]); - end; - end; - - for k := 0 to NbShapeRows-1 do - with shapeRow[shapeRowsList[k]] do - begin - //fill density - if not useAA then - begin - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX; - x2 := inter[i + i + 1].interX; - ComputeAliasedRowBounds(x1+AliasingOfs.X,x2+AliasingOfs.X,minx,maxx,ix1,ix2); - - if ix1 < densMinx then densMinx := ix1; - if ix2 > densMaxx then densMaxx := ix2; - - if ix2 >= ix1 then - FillWord(density[ix1-minx],ix2-ix1+1,256); - end; - end else - {$DEFINE INCLUDE_FILLDENSITY} - {$i density256.inc} - end; - - for k := 0 to NbShapeRows-1 do - with shapeRow[shapeRowsList[k]] do - begin - if densMinX < rowminx then rowminx := densMinX; - if densMaxX > rowmaxx then rowmaxx := densMaxX; - end; - end; - -type - TCardinalSum = record - sumR,sumG,sumB,sumA: LongWord; - end; - -var - MultiEmpty: boolean; - bounds: TRect; - - xb, yb, yc, k: integer; - pdest: PBGRAPixel; - - curSum,nextSum: ^TCardinalSum; - sums: array of TCardinalSum; - curAlpha: byte; - - pdens: PDensity; - w: UInt32or64; - ec: TExpandedPixel; - count: integer; - ScanNextFunc: function: TBGRAPixel of object; - -begin - if nbShapes = 0 then exit; - for k := 0 to nbShapes-1 do - if not shapes[k].fillModeOverride then shapes[k].fillMode:= fillMode; - - useAA := Antialiasing and (ADrawMode in [dmDrawWithTransparency,dmLinearBlend]); - if nbShapes = 1 then - begin - if useAA then - FillShapeAntialias(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,shapes[0].fillMode = fmWinding, ADrawMode=dmLinearBlend) else - FillShapeAliased(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,shapes[0].fillMode = fmWinding, ADrawMode, - AliasingIncludeBottomRight); - exit; - end; - bounds := Rect(0,0,0,0); - MultiEmpty := True; - for k := 0 to nbShapes-1 do - begin - If BGRAShapeComputeMinMax(shapes[k].info,minx,miny,maxx,maxy,dest) then - begin - shapes[k].bounds := rect(minx,miny,maxx+1,maxy+1); - if MultiEmpty then - begin - MultiEmpty := False; - bounds := shapes[k].bounds; - end else - begin - if minx < bounds.left then bounds.left := minx; - if miny < bounds.top then bounds.top := miny; - if maxx >= bounds.right then bounds.right := maxx+1; - if maxy >= bounds.bottom then bounds.bottom := maxy+1; - end; - end else - shapes[k].bounds := rect(0,0,0,0); - end; - if MultiEmpty then exit; - minx := bounds.left; - miny := bounds.top; - maxx := bounds.right-1; - maxy := bounds.bottom-1; - - setlength(shapeRow, nbShapes); - for k := 0 to nbShapes-1 do - begin - shapeRow[k].inter := shapes[k].info.CreateIntersectionArray; - getmem(shapeRow[k].density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety - end; - - if AliasingIncludeBottomRight then - AliasingOfs := PointF(0.0001,0.0001) else - AliasingOfs := PointF(0,0); - - setlength(sums,maxx-minx+1); - setlength(shapeRowsList, nbShapes); - - //vertical scan - for yb := miny to maxy do - begin - rowminx := maxx+1; - rowmaxx := minx-1; - - //init shape rows - NbShapeRows := 0; - for k := 0 to nbShapes-1 do - if (yb >= shapes[k].bounds.top) and (yb < shapes[k].bounds.Bottom) then - begin - shapeRowsList[NbShapeRows] := k; - inc(NbShapeRows); - - fillchar(shapeRow[k].density^,(maxx-minx+1)*sizeof(TDensity),0); - shapeRow[k].densMinx := maxx+1; - shapeRow[k].densMaxx := minx-1; - end; - - If useAA then - begin - //precision scan - for yc := 0 to AntialiasPrecision - 1 do - AddOneLineDensity( yb + (yc * 2 + 1) / (AntialiasPrecision * 2) ); - end else - begin - AddOneLineDensity( yb + 0.5 - AliasingOfs.Y ); - end; - - if rowminx < minx then rowminx := minx; - if rowmaxx > maxx then rowmaxx := maxx; - - if rowminx <= rowmaxx then - begin - FillChar(sums[rowminx-minx],(rowmaxx-rowminx+1)*sizeof(sums[0]),0); - - if useAA then - {$define PARAM_ANTIALIASINGFACTOR} - {$i multishapeline.inc} - else - {$i multishapeline.inc}; - - pdest := dest.ScanLine[yb] + rowminx; - xb := rowminx; - nextSum := @sums[xb-minx]; - case ADrawMode of - dmDrawWithTransparency: - while xb <= rowmaxx do - begin - curSum := nextSum; - inc(nextSum); - with curSum^ do - begin - if sumA <> 0 then - begin - ec.red := (sumR+sumA shr 1) div sumA; - ec.green := (sumG+sumA shr 1) div sumA; - ec.blue := (sumB+sumA shr 1) div sumA; - if sumA > 255 then curAlpha := 255 else curAlpha := sumA; - ec.alpha := curAlpha shl 8 + curAlpha; - count := 1; - while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) - and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do - begin - inc(xb); - inc(nextSum); - inc(count); - end; - if count = 1 then - DrawExpandedPixelInlineNoAlphaCheck(pdest,ec,curAlpha) else - DrawExpandedPixelsInline(pdest, ec, count ); - inc(pdest,count-1); - end; - end; - inc(xb); - inc(pdest); - end; - - dmLinearBlend: - while xb <= rowmaxx do - begin - curSum := nextSum; - inc(nextSum); - with curSum^ do - begin - if sumA <> 0 then - begin - ec.red := (sumR+sumA shr 1) div sumA; - ec.green := (sumG+sumA shr 1) div sumA; - ec.blue := (sumB+sumA shr 1) div sumA; - if sumA > 255 then curAlpha := 255 else curAlpha := sumA; - ec.alpha := curAlpha shl 8 + curAlpha; - count := 1; - while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) - and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do - begin - inc(xb); - inc(nextSum); - inc(count); - end; - if count = 1 then - DrawPixelInlineNoAlphaCheck(pdest,GammaCompression(ec)) else - begin - DrawPixelsInline(pdest, GammaCompression(ec), count ); - inc(pdest,count-1); - end; - end; - end; - inc(xb); - inc(pdest); - end; - - dmXor: - while xb <= rowmaxx do - begin - curSum := nextSum; - inc(nextSum); - with curSum^ do - begin - if sumA <> 0 then - begin - ec.red := (sumR+sumA shr 1) div sumA; - ec.green := (sumG+sumA shr 1) div sumA; - ec.blue := (sumB+sumA shr 1) div sumA; - if sumA > 255 then curAlpha := 255 else curAlpha := sumA; - ec.alpha := curAlpha shl 8 + curAlpha; - count := 1; - while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) - and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do - begin - inc(xb); - inc(nextSum); - inc(count); - end; - XorInline(pdest,GammaCompression(ec),count); - inc(pdest,count-1); - end; - end; - inc(xb); - inc(pdest); - end; - - dmSet: - while xb <= rowmaxx do - begin - curSum := nextSum; - inc(nextSum); - with curSum^ do - begin - if sumA <> 0 then - begin - ec.red := (sumR+sumA shr 1) div sumA; - ec.green := (sumG+sumA shr 1) div sumA; - ec.blue := (sumB+sumA shr 1) div sumA; - if sumA > 255 then curAlpha := 255 else curAlpha := sumA; - ec.alpha := curAlpha shl 8 + curAlpha; - count := 1; - while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) - and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do - begin - inc(xb); - inc(nextSum); - inc(count); - end; - FillInline(pdest,GammaCompression(ec),count); - inc(pdest,count-1); - end; - end; - inc(xb); - inc(pdest); - end; - - dmSetExceptTransparent: - while xb <= rowmaxx do - begin - curSum := nextSum; - inc(nextSum); - with curSum^ do - begin - if sumA >= 255 then - begin - ec.red := (sumR+sumA shr 1) div sumA; - ec.green := (sumG+sumA shr 1) div sumA; - ec.blue := (sumB+sumA shr 1) div sumA; - if sumA > 255 then curAlpha := 255 else curAlpha := sumA; - ec.alpha := curAlpha shl 8 + curAlpha; - count := 1; - while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB) - and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do - begin - inc(xb); - inc(nextSum); - inc(count); - end; - FillInline(pdest,GammaCompression(ec),count); - inc(pdest,count-1); - end; - end; - inc(xb); - inc(pdest); - end; - - end; - end; - - end; - - for k := 0 to nbShapes-1 do - begin - freemem(shapeRow[k].density); - shapes[k].info.FreeIntersectionArray(shapeRow[k].inter); - end; - - dest.InvalidateBitmap; -end; - -////////////////////////////////////////////////////////////////////////////// - -procedure FillEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, - ry: single; ABrush: TUniversalBrush); -var - info: TFillEllipseInfo; -begin - if ABrush.DoesNothing or (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then exit; - info := TFillEllipseInfo.Create(x, y, rx, ry); - FillShapeAntialias(bmp, info, ABrush, False); - info.Free; -end; - -procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single; - c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp,c,EraseMode,nil,LinearBlend); - FillEllipseAntialias(bmp, x,y,rx,ry, b); -end; - -procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, - ry: single; scan: IBGRAScanner; LinearBlend: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp, BGRAPixelTransparent,false,scan,LinearBlend); - FillEllipseAntialias(bmp, x,y,rx,ry, b); -end; - -procedure BorderEllipseAntialias(bmp: TCustomUniversalBitmap; x, y, rx, ry, - w: single; ABrush: TUniversalBrush); -var - info: TFillBorderEllipseInfo; -begin - if ABrush.DoesNothing or (w=0) or (x = EmptySingle) or (y = EmptySingle) then exit; - info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w); - FillShapeAntialias(bmp, info, ABrush, False); - info.Free; -end; - -procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; - c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp,c,EraseMode,nil,LinearBlend); - BorderEllipseAntialias(bmp, x,y,rx,ry,w,b); -end; - -procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, - ry, w: single; scan: IBGRAScanner; LinearBlend: boolean); -var - b: TUniversalBrush; -begin - AnyBrush(b, bmp,BGRAPixelTransparent,false,scan,LinearBlend); - BorderEllipseAntialias(bmp, x,y,rx,ry,w,b); -end; - -procedure BorderEllipse(bmp: TCustomUniversalBitmap; x, y, rx, ry, w: single; - ABrush: TUniversalBrush; AAlpha: word); -var - info: TFillBorderEllipseInfo; -begin - if ABrush.DoesNothing or ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then exit; - info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w); - FillShapeAliased(bmp, info, ABrush, AAlpha, False); - info.Free; -end; - -procedure BorderEllipse(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single; - c: TBGRAPixel; EraseMode: boolean; drawmode: TDrawMode); -var - bFill: TUniversalBrush; -begin - AnyBrush(bFill, bmp, c,EraseMode,nil,drawmode); - BorderEllipse(bmp, x,y,rx,ry,w,bFill); -end; - -procedure BorderEllipseWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, - w: single; scan: IBGRAScanner; drawmode: TDrawMode); -var - bFill: TUniversalBrush; -begin - bmp.ScannerBrush(bFill, scan,drawMode); - BorderEllipse(bmp, x,y,rx,ry,w,bFill); -end; - -procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, - rx, ry: single; options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); -var - info: TFillRoundRectangleInfo; -begin - if (x1 = x2) or (y1 = y2) then exit; - info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options, APixelCenteredCoordinates); - FillShapeAntialias(bmp, info, c, EraseMode,nil, False, LinearBlend); - info.Free; -end; - -procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, - y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions; - scan: IBGRAScanner; LinearBlend: boolean; APixelCenteredCoordinates: boolean); -var - info: TFillRoundRectangleInfo; -begin - if (x1 = x2) or (y1 = y2) then exit; - info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options, APixelCenteredCoordinates); - FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend); - info.Free; -end; - -procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, - y2, rx, ry, w: single; options: TRoundRectangleOptions; c: TBGRAPixel; - EraseMode: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean); -var - info: TFillShapeInfo; - oldLinear: boolean; -begin - if w=0 then exit; - if ((rx=0) or (ry=0)) and not EraseMode then - begin - oldLinear := bmp.LinearAntialiasing; - bmp.LinearAntialiasing := LinearBlend; - bmp.RectangleAntialias(x1,y1,x2,y2,c,w); - bmp.LinearAntialiasing := oldLinear; - exit; - end; - info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates); - FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend); - info.Free; -end; - -procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, - y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; - scan: IBGRAScanner; LinearBlend: boolean; APixelCenteredCoordinates: boolean); -var - info: TFillBorderRoundRectInfo; - oldLinear: Boolean; -begin - if w=0 then exit; - if (rx=0) or (ry=0) then - begin - oldLinear := bmp.LinearAntialiasing; - bmp.LinearAntialiasing := LinearBlend; - bmp.RectangleAntialias(x1,y1,x2,y2,scan,w); - bmp.LinearAntialiasing := oldLinear; - exit; - end; - info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates); - FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend); - info.Free; -end; - -procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, - x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; bordercolor, - fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean; APixelCenteredCoordinates: boolean); -var - info: TFillBorderRoundRectInfo; - multi: TBGRAMultishapeFiller; -begin - if (rx = 0) or (ry = 0) then exit; - info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates); - if not EraseMode then - begin - multi := TBGRAMultishapeFiller.Create; - if filltexture <> nil then - multi.AddShape(info.innerBorder, filltexture) else - multi.AddShape(info.innerBorder, fillcolor); - if w<>0 then - begin - if bordertexture <> nil then - multi.AddShape(info, bordertexture) else - multi.AddShape(info, bordercolor); - end; - multi.Draw(bmp); - multi.Free; - end else - begin - FillShapeAntialias(bmp, info.innerBorder, fillcolor, EraseMode, nil, False, False); - FillShapeAntialias(bmp, info, bordercolor, EraseMode, nil, False, False); - end; - info.Free; -end; - -end. diff --git a/components/bgrabitmap/bgrapolygonaliased.pas b/components/bgrabitmap/bgrapolygonaliased.pas deleted file mode 100644 index 350b013..0000000 --- a/components/bgrabitmap/bgrapolygonaliased.pas +++ /dev/null @@ -1,982 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAPolygonAliased; - -{$mode objfpc}{$H+} - -{$i bgrasse.inc} - -interface - -{ This unit provides fast aliased polygon routines. - - To do aliased drawing, only one line is intersected with polygons for each output scanline. - Along with intersection coordinates, color and texture coordinates are computed using - linear interpolation. Inverse values are used for projective transform. } - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRASSE; - -type - //segment information for linear color - TLinearColorInfo = record - Color, ColorSlopes: TColorF; - end; - PLinearColorInfo = ^TLinearColorInfo; - ArrayOfTColorF = array of TColorF; - - //add a color information to intersection info - TLinearColorGradientIntersectionInfo = class(TIntersectionInfo) - Color: TColorF; - end; - - { TPolygonLinearColorGradientInfo } - - TPolygonLinearColorGradientInfo = class(TOnePassFillPolyInfo) - protected - FColors: array of TColorF; - procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, - ANumSegment: integer; dy: single; AData: pointer); override; - public - constructor Create(const points: array of TPointF; const Colors: array of TBGRAPixel); - function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; - function CreateIntersectionInfo: TIntersectionInfo; override; - end; - -procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearColorGradientInfo; - NonZeroWinding: boolean); overload; -procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; - const Colors: array of TBGRAPixel; NonZeroWinding: boolean); overload; - -type - //segment information for linear color - TPerspectiveColorInfo = record - ColorDivZ, ColorSlopesDivZ: TColorF; - InvZ, InvZSlope: single; - end; - PPerspectiveColorInfo = ^TPerspectiveColorInfo; - - //add a color information to intersection info - TPerspectiveColorGradientIntersectionInfo = class(TIntersectionInfo) - ColorDivZ: TColorF; - coordInvZ: single; - end; - - { TPolygonPerspectiveColorGradientInfo } - - TPolygonPerspectiveColorGradientInfo = class(TOnePassFillPolyInfo) - protected - FColors: array of TColorF; - FPointsZ: array of single; - procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, - ANumSegment: integer; dy: single; AData: pointer); override; - public - constructor Create(const points: array of TPointF; const pointsZ: array of single; const Colors: array of TBGRAPixel); - function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; - function CreateIntersectionInfo: TIntersectionInfo; override; - end; - -procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveColorGradientInfo; - NonZeroWinding: boolean; zbuffer: psingle = nil); overload; -procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; - const pointsZ: array of single; const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; - -type - //segment information for linear texture - TLinearTextureInfo = record - TexCoord: TPointF; - TexCoordSlopes: TPointF; - lightness: single; - lightnessSlope: single; - end; - PLinearTextureInfo = ^TLinearTextureInfo; - - //add a texture coordinate to intersection info - TLinearTextureMappingIntersectionInfo = class(TIntersectionInfo) - texCoord: TPointF; - lightness: word; - end; - - { TPolygonLinearTextureMappingInfo } - - TPolygonLinearTextureMappingInfo = class(TOnePassFillPolyInfo) - protected - FTexCoords: array of TPointF; - FLightnesses: array of Word; - procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, - ANumSegment: integer; dy: single; AData: pointer); override; - public - constructor Create(const points: array of TPointF; const texCoords: array of TPointF); overload; - constructor Create(const points: array of TPointF; const texCoords: array of TPointF; const lightnesses: array of word); overload; - function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; - function CreateIntersectionInfo: TIntersectionInfo; override; - end; - -procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo; - texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload; - -procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload; -procedure PolygonLinearTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean); overload; - -type - //segment information for perspective texture. Use inverse Z and slopes. - TPerspectiveTextureInfo = record - InvZ,InvZSlope: Single; - TexCoordDivByZ: TPointF; - TexCoordDivByZSlopes: TPointF; - lightness: single; - lightnessSlope: single; - Position3D, Normal3D: TPoint3D_128; - Position3DSlope, Normal3DSlope: TPoint3D_128; - end; - PPerspectiveTextureInfo = ^TPerspectiveTextureInfo; - - //add a texture coordinate and depth to intersection info (stored as inverse) - TPerspectiveTextureMappingIntersectionInfo = class(TIntersectionInfo) - texCoordDivByZ: TPointF; - coordInvZ: single; - lightness: word; - Position3D, Normal3D: TPoint3D_128; - end; - - { TPolygonPerspectiveTextureMappingInfo } - - TPolygonPerspectiveTextureMappingInfo = class(TOnePassFillPolyInfo) - protected - FTexCoords: array of TPointF; - FPointsZ: array of single; - FLightnesses: array of Word; - procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, - ANumSegment: integer; dy: single; AData: pointer); override; - public - constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF); overload; - constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF; const lightnesses: array of word); overload; - function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; - function CreateIntersectionInfo: TIntersectionInfo; override; - end; - - { TPolygonPerspectiveMappingShaderInfo } - - TPolygonPerspectiveMappingShaderInfo = class(TOnePassFillPolyInfo) - protected - FTexCoords: array of TPointF; - FPositions3D, FNormals3D: array of TPoint3D_128; - procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, - ANumSegment: integer; dy: single; AData: pointer); override; - public - constructor Create(const points: array of TPointF; const points3D: array of TPoint3D; const normals: array of TPoint3D; const texCoords: array of TPointF); overload; - constructor Create(const points: array of TPointF; const points3D: array of TPoint3D_128; const normals: array of TPoint3D_128; const texCoords: array of TPointF); overload; - function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override; - function CreateIntersectionInfo: TIntersectionInfo; override; - end; - - TShaderFunction3D = function (Context: PBasicLightingContext; Color: TBGRAPixel): TBGRAPixel of object; - -procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveTextureMappingInfo; - texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; -procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; -procedure PolygonPerspectiveTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean; zbuffer: psingle = nil); overload; - -procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveMappingShaderInfo; - texture: IBGRAScanner; TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; - solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload; -procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D; - const normals: array of TPoint3D; texture: IBGRAScanner; const texCoords: array of TPointF; - TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; - solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload; -procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D_128; - const normals: array of TPoint3D_128; texture: IBGRAScanner; const texCoords: array of TPointF; - TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; - solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload; - -{ Aliased round rectangle } -procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer; - DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency; - skipFill: boolean = false); overload; -procedure BGRARoundRectAliased(dest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; - DX, DY: integer; const BorderColor, FillColor: TUniversalBrush; AAlpha: Word; skipBorder: boolean = false; skipFill: boolean = false); overload; -procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer; - DX, DY: integer; FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency); - -implementation - -uses Math, BGRABlend, BGRAPolygon; - -{ TPolygonPerspectiveColorGradientInfo } - -procedure TPolygonPerspectiveColorGradientInfo.SetIntersectionValues( - AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; - dy: single; AData: pointer); -var - info: PPerspectiveColorInfo; -begin - AInter.SetValues(AInterX,AWinding,ANumSegment); - info := PPerspectiveColorInfo(AData); - TPerspectiveColorGradientIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ; - TPerspectiveColorGradientIntersectionInfo(AInter).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy; -end; - -constructor TPolygonPerspectiveColorGradientInfo.Create( - const points: array of TPointF; const pointsZ: array of single; - const Colors: array of TBGRAPixel); -var - i: Integer; - ec: TExpandedPixel; -begin - if (length(Colors) <> length(points)) or (length(points) <> length(pointsZ)) then - raise Exception.Create('Dimensions mismatch'); - inherited Create(points); - - SetLength(FColors, length(FPoints)); - SetLength(FPointsZ, length(FPoints)); - for i := 0 to high(FPoints) do - begin - ec := GammaExpansion(Colors[FPoints[i].originalIndex]); - FColors[i] := ColorF(ec.red,ec.green,ec.blue,ec.alpha); - FPointsZ[i] := pointsZ[FPoints[i].originalIndex]; - end; -end; - -function TPolygonPerspectiveColorGradientInfo.CreateSegmentData(numPt, nextPt: integer; - ASeg: PCustomPointRecord): pointer; -var - info: PPerspectiveColorInfo; - InvTy: single; - CurColorDivByZ,NextColorDivByZ: TColorF; - CurInvZ,NextInvZ: single; -begin - New(info); - InvTy := 1/(ASeg^.y2-ASeg^.y); - CurInvZ := 1/FPointsZ[numPt]; - CurColorDivByZ := FColors[numPt]*CurInvZ; - NextInvZ := 1/FPointsZ[nextPt]; - NextColorDivByZ := FColors[nextPt]*NextInvZ; - - info^.ColorSlopesDivZ := (NextColorDivByZ - CurColorDivByZ)*InvTy; - info^.ColorDivZ := CurColorDivByZ; - - info^.InvZSlope := (NextInvZ-CurInvZ)*InvTy; - info^.InvZ := CurInvZ; - - Result:= info; -end; - -function TPolygonPerspectiveColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo; -begin - Result:= TPerspectiveColorGradientIntersectionInfo.Create; -end; - -{ TPolygonLinearColorGradientInfo } - -procedure TPolygonLinearColorGradientInfo.SetIntersectionValues( - AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; - dy: single; AData: pointer); -var - info: PLinearColorInfo; -begin - AInter.SetValues(AInterX,AWinding,ANumSegment); - info := PLinearColorInfo(AData); - TLinearColorGradientIntersectionInfo(AInter).color := info^.Color + info^.ColorSlopes*dy; -end; - -constructor TPolygonLinearColorGradientInfo.Create( - const points: array of TPointF; const Colors: array of TBGRAPixel); -var - i: Integer; - ec: TExpandedPixel; -begin - if length(Colors) <> length(points) then - raise Exception.Create('Dimensions mismatch'); - - inherited Create(Points); - setlength(FColors, length(FPoints)); - for i := 0 to high(FColors) do - begin - ec := GammaExpansion(Colors[FPoints[i].originalIndex]); - FColors[i] := ColorF(ec.red,ec.green,ec.blue,ec.alpha); - end; -end; - -function TPolygonLinearColorGradientInfo.CreateSegmentData(numPt, nextPt: integer; - ASeg: PCustomPointRecord): pointer; -var - info: PLinearColorInfo; - ty: single; -begin - New(info); - ty := ASeg^.y2 - ASeg^.y; - info^.ColorSlopes := (FColors[nextPt] - FColors[numPt])*(1/ty); - info^.Color := FColors[numPt]; - Result:= info; -end; - -function TPolygonLinearColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo; -begin - Result:= TLinearColorGradientIntersectionInfo.Create; -end; - -procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; - polyInfo: TPolygonLinearColorGradientInfo; NonZeroWinding: boolean); -var - inter: array of TIntersectionInfo; - nbInter: integer; - - procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer; - x1: Single; c1: TColorF; x2: Single; c2: TColorF); - var - colorPos: TColorF; - colorStep: TColorF; - t: single; - pdest: PBGRAPixel; - i: LongInt; - ec: TExpandedPixel; - {%H-}cInt: packed record - r,g,b,a: integer; - end; - {$IFDEF BGRASSE_AVAILABLE} c: TBGRAPixel; {$ENDIF} - begin - t := ((ix1+0.5)-x1)/(x2-x1); - colorPos := c1 + (c2-c1)*t; - colorStep := (c2-c1)*(1/(x2-x1)); - pdest := bmp.ScanLine[yb]+ix1; - - {$IFDEF BGRASSE_AVAILABLE} {$asmmode intel} - If UseSSE then - begin - asm - movups xmm4, colorPos - movups xmm5, colorStep - end; - If UseSSE2 then - begin - for i := ix1 to ix2 do - begin - asm - cvtps2dq xmm0,xmm4 - movups cInt, xmm0 - addps xmm4,xmm5 - end; - c.red := GammaCompressionTab[cInt.r]; - c.green := GammaCompressionTab[cInt.g]; - c.blue := GammaCompressionTab[cInt.b]; - c.alpha := GammaCompressionTab[cInt.a]; - DrawPixelInlineWithAlphaCheck(pdest, c); - inc(pdest); - end; - end else - begin - for i := ix1 to ix2 do - begin - asm - movups colorPos, xmm4 - addps xmm4,xmm5 - end; - ec.red := round(colorPos[1]); - ec.green := round(colorPos[2]); - ec.blue := round(colorPos[3]); - ec.alpha := round(colorPos[4]); - DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); - inc(pdest); - end; - end; - end else - {$ENDIF} - for i := ix1 to ix2 do - begin - ec.red := round(colorPos[1]); - ec.green := round(colorPos[2]); - ec.blue := round(colorPos[3]); - ec.alpha := round(colorPos[4]); - DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); - colorPos := colorPos + colorStep; - inc(pdest); - end; - end; - -var - miny, maxy, minx, maxx: integer; - - yb, i: integer; - x1, x2: single; - - ix1, ix2: integer; - -begin - If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; - inter := polyInfo.CreateIntersectionArray; - - //vertical scan - for yb := miny to maxy do - begin - //find intersections - polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding); - - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX; - x2 := inter[i + i+ 1].interX; - - if x1 <> x2 then - begin - ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); - if ix1 <= ix2 then - DrawGradientLine(yb,ix1,ix2, - x1,TLinearColorGradientIntersectionInfo(inter[i+i]).Color, - x2,TLinearColorGradientIntersectionInfo(inter[i+i+1]).Color); - end; - end; - end; - - polyInfo.FreeIntersectionArray(inter); - bmp.InvalidateBitmap; -end; - -procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; - const points: array of TPointF; const Colors: array of TBGRAPixel; - NonZeroWinding: boolean); -var polyInfo: TPolygonLinearColorGradientInfo; -begin - polyInfo := TPolygonLinearColorGradientInfo.Create(points,Colors); - PolygonLinearColorGradientAliased(bmp,polyInfo,NonZeroWinding); - polyInfo.Free; -end; - -{ TPolygonLinearTextureMappingInfo } - -procedure TPolygonLinearTextureMappingInfo.SetIntersectionValues( - AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; - dy: single; AData: pointer); -var - info: PLinearTextureInfo; -begin - AInter.SetValues(AInterX,AWinding,ANumSegment); - info := PLinearTextureInfo(AData); - TLinearTextureMappingIntersectionInfo(AInter).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy; - if FLightnesses<>nil then - TLinearTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy) - else - TLinearTextureMappingIntersectionInfo(AInter).lightness := 32768; -end; - -constructor TPolygonLinearTextureMappingInfo.Create(const points: array of TPointF; - const texCoords: array of TPointF); -var - i: Integer; -begin - if length(texCoords) <> length(points) then - raise Exception.Create('Dimensions mismatch'); - inherited Create(points); - SetLength(FTexCoords, length(FPoints)); - for i := 0 to high(FPoints) do - FTexCoords[i] := texCoords[FPoints[i].originalIndex]; -end; - -constructor TPolygonLinearTextureMappingInfo.Create( - const points: array of TPointF; const texCoords: array of TPointF; - const lightnesses: array of word); -var - i: Integer; -begin - if (length(texCoords) <> length(points)) or (length(lightnesses) <> length(points)) then - raise Exception.Create('Dimensions mismatch'); - inherited Create(points); - SetLength(FTexCoords, length(FPoints)); - setlength(FLightnesses, length(FPoints)); - for i := 0 to high(FPoints) do - begin - FTexCoords[i] := texCoords[FPoints[i].originalIndex]; - FLightnesses[i] := lightnesses[FPoints[i].originalIndex]; - end; -end; - -function TPolygonLinearTextureMappingInfo.CreateSegmentData(numPt, nextPt: integer; - ASeg: PCustomPointRecord): pointer; -var - info: PLinearTextureInfo; - ty: single; -begin - New(info); - ty := ASeg^.y2-ASeg^.y; - info^.TexCoordSlopes := (FTexCoords[nextPt] - FTexCoords[numPt])*(1/ty); - info^.TexCoord := FTexCoords[numPt]; - if FLightnesses <> nil then - begin - info^.lightnessSlope := (FLightnesses[nextPt] - FLightnesses[numPt])*(1/ty); - info^.lightness := FLightnesses[numPt]; - end else - begin - info^.lightness := 32768; - info^.lightnessSlope := 0; - end; - Result:= info; -end; - -function TPolygonLinearTextureMappingInfo.CreateIntersectionInfo: TIntersectionInfo; -begin - result := TLinearTextureMappingIntersectionInfo.Create; -end; - -{$hints off} - -procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; - polyInfo: TPolygonPerspectiveColorGradientInfo; NonZeroWinding: boolean; zbuffer: psingle); -var - inter: array of TIntersectionInfo; - nbInter: integer; - - procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer; - x1: Single; info1: TPerspectiveColorGradientIntersectionInfo; x2: Single; info2: TPerspectiveColorGradientIntersectionInfo); - var - diff,colorPos,{%H-}colorPosByZ: TColorF; - colorStep: TColorF; - t: single; - pdest: PBGRAPixel; - i: LongInt; - ec: TExpandedPixel; - invDx: single; - z,invZ,InvZStep: single; - r,g,b,a: integer; - {$IFDEF BGRASSE_AVAILABLE}minVal,maxVal: single; - cInt: packed record - r,g,b,a: integer; - end; - c: TBGRAPixel;{$ENDIF} - zbufferpos: psingle; - - begin - invDx := 1/(x2-x1); - t := ((ix1+0.5)-x1)*InvDx; - diff := info2.ColorDivZ-info1.ColorDivZ; - colorPos := info1.ColorDivZ + diff*t; - colorStep := diff*InvDx; - invZ := info1.coordInvZ + (info2.coordInvZ-info1.coordInvZ)*t; - InvZStep := (info2.coordInvZ-info1.coordInvZ)*InvDx; - pdest := bmp.ScanLine[yb]+ix1; - if zbuffer <> nil then - begin - {$DEFINE PARAM_USEZBUFFER} - zbufferpos := zbuffer + yb*bmp.Width + ix1; - {$IFDEF BGRASSE_AVAILABLE} - If UseSSE then - begin - {$DEFINE PARAM_USESSE} - If UseSSE2 then - begin - {$DEFINE PARAM_USESSE2} - {$i perspectivecolorscan.inc} - {$UNDEF PARAM_USESSE2} - end else - begin - {$i perspectivecolorscan.inc} - end; - {$UNDEF PARAM_USESSE} - end else - {$ENDIF} - begin - {$i perspectivecolorscan.inc} - end; - {$UNDEF PARAM_USEZBUFFER} - end else - begin - {$IFDEF BGRASSE_AVAILABLE} - If UseSSE then - begin - {$DEFINE PARAM_USESSE} - If UseSSE2 then - begin - {$DEFINE PARAM_USESSE2} - {$i perspectivecolorscan.inc} - {$UNDEF PARAM_USESSE2} - end else - begin - {$i perspectivecolorscan.inc} - end; - {$UNDEF PARAM_USESSE} - end else - {$ENDIF} - begin - {$i perspectivecolorscan.inc} - end; - end; - end; - -var - miny, maxy, minx, maxx: integer; - - yb, i: integer; - x1, x2: single; - - ix1, ix2: integer; - -begin - If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; - inter := polyInfo.CreateIntersectionArray; - - //vertical scan - for yb := miny to maxy do - begin - //find intersections - polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding); - - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX; - x2 := inter[i + i+ 1].interX; - - if x1 <> x2 then - begin - ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); - if ix1 <= ix2 then - DrawGradientLine(yb,ix1,ix2, - x1,TPerspectiveColorGradientIntersectionInfo(inter[i+i]), - x2,TPerspectiveColorGradientIntersectionInfo(inter[i+i+1])); - end; - end; - end; - - polyInfo.FreeIntersectionArray(inter); - bmp.InvalidateBitmap; -end; - -procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; - const points: array of TPointF; const pointsZ: array of single; - const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle); -var polyInfo: TPolygonPerspectiveColorGradientInfo; -begin - polyInfo := TPolygonPerspectiveColorGradientInfo.Create(points,pointsZ,Colors); - PolygonPerspectiveColorGradientAliased(bmp,polyInfo,NonZeroWinding,zbuffer); - polyInfo.Free; -end; - -procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo; - texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean); -var - inter: array of TIntersectionInfo; - nbInter: integer; - scanAtFunc: function(X,Y: Single): TBGRAPixel of object; - scanAtIntegerFunc: function(X,Y: integer): TBGRAPixel of object; - - procedure DrawTextureLineWithoutLight(yb: integer; ix1: integer; ix2: integer; - info1,info2: TLinearTextureMappingIntersectionInfo; - WithInterpolation: boolean); - {$i lineartexscan.inc} - - procedure DrawTextureLineWithLight(yb: integer; ix1: integer; ix2: integer; - info1,info2: TLinearTextureMappingIntersectionInfo; - WithInterpolation: boolean); - {$define PARAM_USELIGHTING} - {$i lineartexscan.inc} - -var - miny, maxy, minx, maxx: integer; - - yb, i: integer; - x1, x2: single; - - ix1, ix2: integer; - -begin - If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; - - scanAtFunc := @texture.ScanAt; - scanAtIntegerFunc := @texture.ScanAtInteger; - - inter := polyInfo.CreateIntersectionArray; - - //vertical scan - for yb := miny to maxy do - begin - //find intersections - polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding); - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX; - x2 := inter[i + i+ 1].interX; - - if x1 <> x2 then - begin - ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); - if ix1 <= ix2 then - begin - if (TLinearTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and - (TLinearTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then - DrawTextureLineWithoutLight(yb,ix1,ix2, - TLinearTextureMappingIntersectionInfo(inter[i+i]), - TLinearTextureMappingIntersectionInfo(inter[i+i+1]), - TextureInterpolation) - else - DrawTextureLineWithLight(yb,ix1,ix2, - TLinearTextureMappingIntersectionInfo(inter[i+i]), - TLinearTextureMappingIntersectionInfo(inter[i+i+1]), - TextureInterpolation); - end; - end; - end; - end; - - polyInfo.FreeIntersectionArray(inter); - bmp.InvalidateBitmap; -end; -{$hints on} - -procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; - const points: array of TPointF; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean); -var polyInfo: TPolygonLinearTextureMappingInfo; -begin - polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords); - PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding); - polyInfo.Free; -end; - -procedure PolygonLinearTextureMappingAliasedWithLightness( - bmp: TBGRACustomBitmap; const points: array of TPointF; - texture: IBGRAScanner; const texCoords: array of TPointF; - TextureInterpolation: Boolean; lightnesses: array of word; - NonZeroWinding: boolean); -var polyInfo: TPolygonLinearTextureMappingInfo; -begin - polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords,lightnesses); - PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding); - polyInfo.Free; -end; - -{$i polyaliaspersp.inc} - -{From LazRGBGraphics} -procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer; - DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency; - skipFill: boolean = false); -var - bBorder, bFill: TUniversalBrush; - skipBorder: Boolean; -begin - dest.SolidBrush(bBorder, BorderColor, ADrawMode); - skipBorder := ((ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and (BorderColor.alpha=0)) - or ((ADrawMode = dmSetExceptTransparent) and (BorderColor.alpha<>255)) - or ((ADrawMode = dmXor) and (PLongWord(@BorderColor)^=0)); - - if FillTexture <> nil then - dest.ScannerBrush(bFill, FillTexture, ADrawMode) - else - begin - dest.SolidBrush(bFill, FillColor, ADrawMode); - skipFill := (skipFill or (ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and (FillColor.alpha=0)) - or ((ADrawMode = dmSetExceptTransparent) and (FillColor.alpha<>255)) - or ((ADrawMode = dmXor) and (PLongWord(@FillColor)^=0)); - end; - - BGRARoundRectAliased(dest, X1,Y1,X2,Y2, DX,DY, bBorder, bFill, 65535, skipBorder,skipFill); -end; - -procedure BGRARoundRectAliased(dest: TCustomUniversalBitmap; X1, Y1, X2, - Y2: integer; DX, DY: integer; const BorderColor, FillColor: TUniversalBrush; - AAlpha: Word; skipBorder: boolean; skipFill: boolean); -var - CX, CY, CX1, CY1, A, B, NX, NY: single; - X, Y, EX, EY: integer; - LX1, LY1: integer; - LX2, LY2: integer; - DivSqrA, DivSqrB: single; - I, J, S: integer; - EdgeList: array of TPoint; - temp: integer; - LX, LY: integer; - RowStart,RowEnd: integer; - - procedure AddEdge(X, Y: integer); - begin - If (Y > High(EdgeList)) or (Y < 0) then exit; - if (EdgeList[Y].X = -1) or (X < EdgeList[Y].X) then - EdgeList[Y].X := X; - if (EdgeList[Y].Y = -1) or (X > EdgeList[Y].Y) then - EdgeList[Y].Y := X; - end; - -begin - if AAlpha = 0 then exit; - if BorderColor.DoesNothing then skipBorder:= true; - if FillColor.DoesNothing then skipFill:= true; - if skipBorder and skipFill then exit; - if (x1 > x2) then - begin - temp := x1; - x1 := x2; - x2 := temp; - end; - if (y1 > y2) then - begin - temp := y1; - y1 := y2; - y2 := temp; - end; - if (x2 - x1 <= 0) or (y2 - y1 <= 0) then exit; - LX := x2 - x1 - DX; - LY := y2 - y1 - DY; - if LX < 0 then LX := 0; - if LY < 0 then LY := 0; - Dec(x2); - Dec(y2); - - if (X1 = X2) and (Y1 = Y2) then - begin - if not skipBorder then - dest.DrawPixel(X1, Y1, BorderColor, AAlpha); - Exit; - end; - if (X2 - X1 = 1) or (Y2 - Y1 = 1) then - begin - if not skipBorder then - dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, AAlpha); - Exit; - end; - if (LX > X2 - X1) or (LY > Y2 - Y1) then - begin - if not skipBorder then - dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, AAlpha); - if not skipFill then - dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, AAlpha); - Exit; - end; - - SetLength(EdgeList, Ceil((Y2 - Y1 + 1) / 2)); - for I := 0 to Pred(High(EdgeList)) do - EdgeList[I] := Point(-1, -1); - EdgeList[High(EdgeList)] := Point(0, 0); - - A := (X2 - X1 + 1 - LX) / 2; - B := (Y2 - Y1 + 1 - LY) / 2; - CX := (X2 + X1 + 1) / 2; - CY := (Y2 + Y1 + 1) / 2; - - CX1 := X2 + 1 - A - Floor(CX); - CY1 := Y2 + 1 - B - Floor(CY); - - EX := Floor(Sqr(A) / Sqrt(Sqr(A) + Sqr(B)) + Frac(A)); - EY := Floor(Sqr(B) / Sqrt(Sqr(A) + Sqr(B)) + Frac(B)); - - DivSqrA := 1 / Sqr(A); - DivSqrB := 1 / Sqr(B); - - NY := B; - AddEdge(Floor(CX1), Round(CY1 + B) - 1); - for X := 1 to Pred(EX) do - begin - NY := B * Sqrt(1 - Sqr(X + 0.5 - Frac(A)) * DivSqrA); - - AddEdge(Floor(CX1) + X, Round(CY1 + NY) - 1); - end; - - LX1 := Floor(CX1) + Pred(EX); - LY1 := Round(CY1 + NY) - 1; - - NX := A; - AddEdge(Round(CX1 + A) - 1, Floor(CY1)); - for Y := 1 to Pred(EY) do - begin - NX := A * Sqrt(1 - Sqr(Y + 0.5 - Frac(B)) * DivSqrB); - - AddEdge(Round(CX1 + NX) - 1, Floor(CY1) + Y); - end; - - LX2 := Round(CX1 + NX) - 1; - LY2 := Floor(CY1) + Pred(EY); - - if Abs(LX1 - LX2) > 1 then - begin - if Abs(LY1 - LY2) > 1 then - AddEdge(LX1 + 1, LY1 - 1) - else - AddEdge(LX1 + 1, LY1); - end - else - if Abs(LY1 - LY2) > 1 then - AddEdge(LX2, LY1 - 1); - - for I := 0 to High(EdgeList) do - begin - if EdgeList[I].X = -1 then - EdgeList[I] := Point(Round(CX1 + A) - 1, Round(CX1 + A) - 1) - else - Break; - end; - - J := 0; - while J < Length(EdgeList) do - begin - if (J = 0) and (Frac(CY) > 0) then - begin - if not skipBorder then - for I := EdgeList[J].X to EdgeList[J].Y do - begin - dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha); - dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor, AAlpha); - end; - - if not SkipFill then - dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) + - Pred(EdgeList[J].X), FillColor, AAlpha); - end - else - if (J = High(EdgeList)) then - begin - if Frac(CX) > 0 then - S := -EdgeList[J].Y - else - S := -Succ(EdgeList[J].Y); - - if not skipBorder then - for I := S to EdgeList[J].Y do - begin - dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha); - dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor, AAlpha); - end; - end - else - begin - if not skipBorder then - for I := EdgeList[J].X to EdgeList[J].Y do - begin - dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha); - dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor, AAlpha); - if Floor(CX) + I <> Ceil(CX) - Succ(I) then - begin - dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor, AAlpha); - dest.DrawPixel(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor, AAlpha); - end; - end; - - if not SkipFill then - begin - RowStart := Ceil(CX) - EdgeList[J].X; - RowEnd := Floor(CX) + Pred(EdgeList[J].X); - if RowEnd >= RowStart then - begin - dest.HorizLine(RowStart, Floor(CY) + J, - RowEnd, FillColor, AAlpha); - dest.HorizLine(RowStart, Ceil(CY) - Succ(J), - RowEnd, FillColor, AAlpha); - end; - end; - - end; - Inc(J); - end; -end; - -procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, - Y2: integer; DX, DY: integer; FillColor: TBGRAPixel; - FillTexture: IBGRAScanner; ADrawMode: TDrawMode); -var - fi: TFillRoundRectangleInfo; -begin - fi := TFillRoundRectangleInfo.Create(x1,y1,x2,y2,dx/2,dy/2,[rrDefault],false); - FillShapeAliased(dest, fi, FillColor, false, FillTexture, true, ADrawMode); - fi.Free; -end; - -end. - diff --git a/components/bgrabitmap/bgraqt5bitmap.pas b/components/bgrabitmap/bgraqt5bitmap.pas deleted file mode 100644 index 6981750..0000000 --- a/components/bgrabitmap/bgraqt5bitmap.pas +++ /dev/null @@ -1,169 +0,0 @@ -{ - /**************************************************************************\ - bgraqtbitmap.pas - ----------------- - This unit should NOT be added to the 'uses' clause. - It contains patches for Qt5. - - **************************************************************************** - * * - * This file is part of BGRABitmap library which is distributed under the * - * modified LGPL. * - * * - * See the file COPYING.modifiedLGPL.txt, included in this distribution, * - * for details about the copyright. * - * * - * This program is distributed in the hope that it will be useful, * - * but WITHOUT ANY WARRANTY; without even the implied warranty of * - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * - * * - **************************************************************************** -} - -//=== ct9999 a modifications for CodeTyphon Studio ============= - -unit BGRAQt5Bitmap; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, BGRALCLBitmap, Graphics, - GraphType, BGRABitmapTypes; - -type - { TBGRAQtBitmap } - - TBGRAQtBitmap = class(TBGRALCLBitmap) - private - procedure SlowDrawTransparent(ABitmap: TBGRACustomBitmap; - ACanvas: TCanvas; ARect: TRect); - public - procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); - override; - procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override; - procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override; - procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); - override; - procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; - end; - -implementation - -uses LCLType, - LCLIntf, IntfGraphics, - qt5objects, qt5, - FPImage; - -procedure TBGRAQtBitmap.SlowDrawTransparent(ABitmap: TBGRACustomBitmap; - ACanvas: TCanvas; ARect: TRect); -begin - ACanvas.StretchDraw(ARect, ABitmap.Bitmap); -end; - -procedure TBGRAQtBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - Temp: TBGRALCLPtrBitmap; -begin - Temp := TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData); - Temp.LineOrder := ALineOrder; - SlowDrawTransparent(Temp, ACanvas, Rect); - Temp.Free; -end; - -procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); -begin - if self = nil then - exit; - if Opaque then - DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data, FLineOrder, - FWidth, FHeight) - else - SlowDrawTransparent(Self, ACanvas, Rect(X, Y, X + Width, Y + Height)); -end; - -procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); -begin - if self = nil then - exit; - if Opaque then - DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight) - else - SlowDrawTransparent(Self, ACanvas, Rect); -end; - -procedure TBGRAQtBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - Temp: TBitmap; - RawImage: TRawImage; - BitmapHandle, MaskHandle: HBitmap; - CreateSuccess: boolean; -begin - if (AHeight = 0) or (AWidth = 0) then - exit; - - RawImage.Init; - if TBGRAPixel_RGBAOrder then - RawImage.Description.Init_BPP32_R8G8B8A8_BIO_TTB(AWidth, AHeight) //== ct9999 FIX ============= - else - RawImage.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight); - RawImage.Description.LineOrder := ALineOrder; - RawImage.Description.LineEnd := rileDWordBoundary; - RawImage.Data := PByte(AData); - RawImage.DataSize := AWidth * AHeight * Sizeof(TBGRAPixel); - CreateSuccess := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False); - - if not CreateSuccess then - raise FPImageException.Create('Failed to create bitmap handle'); - Temp := TBitmap.Create; - Temp.Handle := BitmapHandle; - Temp.MaskHandle := MaskHandle; - ACanvas.StretchDraw(Rect, Temp); - Temp.Free; -end; - -procedure TBGRAQtBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); -var - bmp: TBitmap; - Ofs: TPoint; - SrcX, SrcY: integer; - dcSource, dcDest: TQtDeviceContext; - B: Boolean; -begin - DiscardBitmapChange; - bmp := TBitmap.Create; - bmp.PixelFormat := pf24bit; - bmp.Width := Width; - bmp.Height := Height; - dcDest := TQtDeviceContext(bmp.Canvas.handle); - - dcSource := TQtDeviceContext(CanvasSource.Handle); - LCLIntf.GetWindowOrgEx(CanvasSource.Handle, @Ofs); - - SrcX := x + Ofs.X; - SrcY := y + Ofs.Y; - - if (dcSource.vImage <> nil) and (dcSource.vImage.Handle <> nil) then - begin - // we must stop painting on device - B := QPainter_isActive(dcDest.Widget); - if B then - QPainter_end(dcDest.Widget); - TQtImage(bmp.Handle).CopyFrom(dcSource.vImage.Handle, - SrcX, SrcY, Width, Height); - if B then - QPainter_begin(dcDest.Widget, TQtImage(bmp.Handle).Handle); - end; - - LoadFromRawImage(bmp.RawImage, 255, True); - bmp.Free; - InvalidateBitmap; -end; - -end. - diff --git a/components/bgrabitmap/bgraqtbitmap.pas b/components/bgrabitmap/bgraqtbitmap.pas deleted file mode 100644 index 91d569d..0000000 --- a/components/bgrabitmap/bgraqtbitmap.pas +++ /dev/null @@ -1,158 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - /**************************************************************************\ - bgraqtbitmap.pas - ----------------- - This unit should NOT be added to the 'uses' clause. - It contains patches for Qt. -} - -unit BGRAQtBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRALCLBitmap, Graphics, - GraphType, BGRABitmapTypes; - -type - { TBGRAQtBitmap } - - TBGRAQtBitmap = class(TBGRALCLBitmap) - private - procedure SlowDrawTransparent(ABitmap: TBGRACustomBitmap; - ACanvas: TCanvas; ARect: TRect); - public - procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override; - procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override; - procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; - end; - -implementation - -uses LCLType, - LCLIntf, IntfGraphics, - qtobjects, {$ifdef LCLqt5}qt5{$else}qt4{$endif}, - FPImage; - -procedure TBGRAQtBitmap.SlowDrawTransparent(ABitmap: TBGRACustomBitmap; - ACanvas: TCanvas; ARect: TRect); -begin - ACanvas.StretchDraw(ARect, ABitmap.Bitmap); -end; - -procedure TBGRAQtBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - Temp: TBGRALCLPtrBitmap; -begin - Temp := TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData); - Temp.LineOrder := ALineOrder; - SlowDrawTransparent(Temp, ACanvas, Rect); - Temp.Free; -end; - -procedure TBGRAQtBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -{$IFDEF DARWIN} -var - psrc,pdest: PBGRAPixel; - bmp: TBGRAQtBitmap; - x, y: integer; -{$ENDIF} -begin - {$IFDEF DARWIN} - bmp := TBGRAQtBitmap.Create(AWidth,AHeight); - try - if ALineOrder = riloTopToBottom then psrc := AData - else psrc := PBGRAPixel(AData) + (AWidth*(AHeight-1)); - for y := 0 to AHeight-1 do - begin - pdest := bmp.ScanLine[y]; - for x := 0 to AWidth-1 do - begin - pdest^.red := psrc^.red; - pdest^.green:= psrc^.green; - pdest^.blue := psrc^.blue; - pdest^.alpha := 255; - inc(psrc); - inc(pdest); - end; - if ALineOrder = riloBottomToTop then dec(psrc, 2*AWidth); - end; - bmp.Draw(ACanvas, ARect, false); - finally - bmp.Free; - end; - {$ELSE} - inherited DataDrawOpaque(ACanvas, ARect, AData, ALineOrder, AWidth, AHeight); - {$ENDIF} -end; - -procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); -begin - if self = nil then - exit; - if Opaque then - DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data, FLineOrder, - FWidth, FHeight) - else - SlowDrawTransparent(Self, ACanvas, Rect(X, Y, X + Width, Y + Height)); -end; - -procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); -begin - if self = nil then - exit; - if Opaque then - DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight) - else - SlowDrawTransparent(Self, ACanvas, Rect); -end; - -procedure TBGRAQtBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); -var - bmp: TBitmap; - Ofs: TPoint; - SrcX, SrcY: integer; - dcSource, dcDest: TQtDeviceContext; - B: Boolean; -begin - DiscardBitmapChange; - bmp := TBitmap.Create; - bmp.PixelFormat := pf24bit; - bmp.Width := Width; - bmp.Height := Height; - dcDest := TQtDeviceContext(bmp.Canvas.handle); - - dcSource := TQtDeviceContext(CanvasSource.Handle); - LCLIntf.GetWindowOrgEx(CanvasSource.Handle, @Ofs); - - SrcX := x + Ofs.X; - SrcY := y + Ofs.Y; - - if (dcSource.vImage <> nil) and (dcSource.vImage.Handle <> nil) then - begin - // we must stop painting on device - B := QPainter_isActive(dcDest.Widget); - if B then - QPainter_end(dcDest.Widget); - TQtImage(bmp.Handle).CopyFrom(dcSource.vImage.Handle, - SrcX, SrcY, Width, Height); - if B then - QPainter_begin(dcDest.Widget, TQtImage(bmp.Handle).Handle); - end; - - LoadFromRawImage(bmp.RawImage, 255, True); - bmp.Free; - InvalidateBitmap; -end; - -end. - diff --git a/components/bgrabitmap/bgrareadbmp.pas b/components/bgrabitmap/bgrareadbmp.pas deleted file mode 100644 index 49d0435..0000000 --- a/components/bgrabitmap/bgrareadbmp.pas +++ /dev/null @@ -1,1112 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{*****************************************************************************} -{ - This original file was part of the Free Pascal's "Free Components Library". - Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team - - BMP reader implementation modified by circular. -} -{*****************************************************************************} -{ 08/2005 by Giulio Bernardi: - - Added support for 16 and 15 bpp bitmaps. - - If we have bpp <= 8 make an indexed image instead of converting it to RGB - - Support for RLE4 and RLE8 decoding - - Support for top-down bitmaps - - 03/2014 by circular: - - RLE optimisation using a read buffer - - direct access to pixels with TBGRABitmap - - vertical shrink option with MinifyHeight,WantedHeight,OutputHeight (useful for thumbnails) - 01/2017 by circular: - - support for OS/2 1.x format - - support for headerless files -} - -{$mode objfpc} -{$h+} - -unit BGRAReadBMP; - -interface - -uses FPImage, BGRAClasses, SysUtils, BMPcomn, BGRABitmapTypes; - -type - TBMPTransparencyOption = (toAuto, toTransparent, toOpaque); - TBitMapInfoHeader = BMPcomn.TBitMapInfoHeader; - TBitMapFileHeader = BMPcomn.TBitMapFileHeader; - TOS2BitmapHeader = packed record - bcSize: LongWord; - bcWidth: Word; - bcHeight: Word; - bcPlanes: Word; - bcBitCount: Word; - end; - TMinimumBitmapHeader = packed record - Size:longint; - Width:longint; - Height:longint; - Planes:word; - BitCount:word; - end; - TBitmapSubFormat = (bsfWithFileHeader, bsfHeaderless, bsfHeaderlessWithMask); - TReadScanlineProc = procedure(Row : Integer; Stream : TStream) of object; - TWriteScanlineProc = procedure(Row : Integer; Img : TFPCustomImage) of object; - TProgressProc = procedure(Percent: integer; var ShouldContinue: boolean) of object; - - - { TBGRAReaderBMP } - - TBGRAReaderBMP = class (TBGRAImageReader) - Private - DeltaX, DeltaY : integer; // Used for the never-used delta option in RLE - TopDown : boolean; // If set, bitmap is stored top down instead of bottom up - Procedure FreeBufs; // Free (and nil) buffers. - protected - ReadSize : Integer; // Size (in bytes) of 1 scanline. - BFH: TBitMapFileHeader; // The file header - BFI: TBitMapInfoHeader; // The header as read from the stream. - FPaletteEntrySize: integer; // 4 for Windows, 3 for OS/2 1.x - FPalette : PFPcolor; // Buffer with Palette entries. (useless now) - FBGRAPalette : PBGRAPixel; - LineBuf : PByte; // Buffer for 1 scanline. Can be Byte, Word, TColorRGB or TColorRGBA - RedMask, GreenMask, BlueMask : LongWord; //Used if Compression=bi_bitfields - RedShift, GreenShift, BlueShift : shortint; - FOutputHeight: integer; - FOriginalHeight: Integer; - FTransparencyOption: TBMPTransparencyOption; - FBuffer: packed array of byte; - FBufferPos, FBufferSize: integer; - FBufferStream: TStream; - FHasAlphaValues: boolean; - FMaskData: PByte; - FMaskDataSize: integer; - // SetupRead will allocate the needed buffers, and read the colormap if needed. - procedure SetupRead(nPalette, nRowBits: Integer; Stream : TStream); virtual; - function CountBits(Value : byte) : shortint; - function ShiftCount(Mask : LongWord) : shortint; - function ExpandColor(value : LongWord) : TFPColor; - function ExpandColorBGRA(value : LongWord) : TBGRAPixel; - procedure ExpandRLE8ScanLine(Row : Integer; Stream : TStream); - procedure ExpandRLE4ScanLine(Row : Integer; Stream : TStream); - procedure ReadScanLine(Row : Integer; Stream : TStream); virtual; - procedure SkipScanLine(Row : Integer; Stream : TStream); virtual; - procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); virtual; - procedure WriteScanLineBGRA(Row : Integer; Img : TFPCustomImage); virtual; - procedure ReadMaskLine({%H-}Row : Integer; Stream : TStream); virtual; - procedure SkipMaskLine({%H-}Row : Integer; Stream : TStream); virtual; - procedure WriteMaskLine(Row : Integer; Img : TFPCustomImage); virtual; - // required by TFPCustomImageReader - procedure InternalRead (Stream:TStream; Img:TFPCustomImage); override; - function InternalCheck (Stream:TStream) : boolean; override; - procedure InitReadBuffer(AStream: TStream; ASize: integer); - procedure CloseReadBuffer; - function GetNextBufferByte: byte; - procedure MakeOpaque(Img: TFPCustomImage); - procedure LoadMask(Stream:TStream; Img:TFPCustomImage; var ShouldContinue: boolean); - procedure MainProgressProc(Percent: integer; var ShouldContinue: boolean); - procedure ImageVerticalLoop(Stream:TStream; Img:TFPCustomImage; - ReadProc, SkipProc: TReadScanlineProc; WriteProc: TWriteScanlineProc; - ProgressProc: TProgressProc; var ShouldContinue: boolean); - public - MinifyHeight,WantedHeight: integer; - Hotspot: TPoint; - Subformat: TBitmapSubFormat; - constructor Create; override; - destructor Destroy; override; - property OriginalHeight: integer read FOriginalHeight; - property OutputHeight: integer read FOutputHeight; - property TransparencyOption: TBMPTransparencyOption read FTransparencyOption write FTransparencyOption; - function GetQuickInfo(AStream: TStream): TQuickImageInfo; override; - function GetBitmapDraft(AStream: TStream; {%H-}AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override; - end; - -function MakeBitmapFileHeader(AData: TStream): TBitMapFileHeader; - -implementation - -uses math; - -function MakeBitmapFileHeader(AData: TStream): TBitMapFileHeader; -var header: PBitMapInfoHeader; - headerSize: integer; - extraSize: integer; - os2header: TOS2BitmapHeader; -begin - AData.Position := 0; - headerSize := LEtoN(AData.ReadDWord); - if headerSize = sizeof(TOS2BitmapHeader) then //OS2 1.x - begin - AData.ReadBuffer({%H-}os2header,sizeof(os2header)); - if LEtoN(os2header.bcBitCount) in [1,2,4,8] then - begin - extraSize := 3*(1 shl LEtoN(os2header.bcBitCount)); - end else - extraSize := 0; - result.bfType:= Word('BM'); - result.bfSize := NtoLE(Integer(sizeof(TBitMapFileHeader) + AData.Size)); - result.bfReserved:= 0; - result.bfOffset := NtoLE(Integer(sizeof(TBitMapFileHeader) + headerSize + extraSize)); - end else - begin - if (headerSize < 16) or (headerSize > AData.Size) or (headerSize > 1024) then - raise exception.Create('Invalid header size'); - getmem(header, headerSize); - try - fillchar(header^, headerSize,0); - header^.Size := NtoLE(headerSize); - AData.ReadBuffer((PByte(header)+4)^, headerSize-4); - if LEtoN(header^.Compression) = BI_BITFIELDS then - extraSize := 4*3 - else if LEtoN(header^.BitCount) in [1,2,4,8] then - begin - if header^.ClrUsed > 0 then - extraSize := 4*header^.ClrUsed - else - extraSize := 4*(1 shl header^.BitCount); - end else - extraSize := 0; - result.bfType:= Word('BM'); - result.bfSize := NtoLE(Integer(sizeof(TBitMapFileHeader) + AData.Size)); - result.bfReserved:= 0; - result.bfOffset := NtoLE(Integer(sizeof(TBitMapFileHeader) + headerSize + extraSize)); - finally - freemem(header); - end; - end; -end; - -function RGBAToFPColor(Const RGBA: TColorRGBA) : TFPcolor; -begin - with Result, RGBA do - begin - Red :=(R shl 8) or R; - Green :=(G shl 8) or G; - Blue :=(B shl 8) or B; - Alpha :=(A shl 8) or A - end; -end; - -Function RGBToFPColor(Const RGB : TColorRGB) : TFPColor; - -begin - with Result,RGB do - begin {Use only the high byte to convert the color} - Red := (R shl 8) + R; - Green := (G shl 8) + G; - Blue := (B shl 8) + B; - Alpha := AlphaOpaque; - end; -end; - -constructor TBGRAReaderBMP.Create; - -begin - inherited create; - FTransparencyOption := toTransparent; - Subformat:= bsfWithFileHeader; -end; - -destructor TBGRAReaderBMP.Destroy; - -begin - FreeBufs; - inherited destroy; -end; - -function TBGRAReaderBMP.GetQuickInfo(AStream: TStream): TQuickImageInfo; -var headerSize: LongWord; - os2header: TOS2BitmapHeader; - minHeader: TMinimumBitmapHeader; - totalDepth: integer; - headerPos: int64; -begin - {$PUSH}{$HINTS OFF}fillchar({%H-}result, sizeof({%H-}result), 0);{$POP} - headerPos := AStream.Position; - if AStream.Read({%H-}headerSize, sizeof(headerSize)) <> sizeof(headerSize) then exit; - headerSize := LEtoN(headerSize); - - //check presence of file header - if (headerSize and $ffff) = BMmagic then - begin - inc(headerPos, sizeof(TBitMapFileHeader)); - AStream.Position := headerPos; - if AStream.Read(headerSize, sizeof(headerSize)) <> sizeof(headerSize) then exit; - headerSize := LEtoN(headerSize); - end; - - AStream.Position := headerPos; - - if headerSize = sizeof(TOS2BitmapHeader) then //OS2 1.x - begin - if AStream.Read({%H-}os2header, sizeof(os2header)) <> sizeof(os2header) then exit; - result.width := LEtoN(os2header.bcWidth); - result.height := LEtoN(os2header.bcHeight); - result.colorDepth := LEtoN(os2header.bcBitCount); - result.alphaDepth := 0; - end - else - if headerSize >= sizeof(minHeader) then - begin - if AStream.Read({%H-}minHeader, sizeof(minHeader)) <> sizeof(minHeader) then exit; - result.width := LEtoN(minHeader.Width); - result.height := LEtoN(minHeader.Height); - totalDepth := LEtoN(minHeader.BitCount); - if totalDepth > 24 then - begin - result.colorDepth:= 24; - result.alphaDepth:= 8; - end else - begin - result.colorDepth := totalDepth; - result.alphaDepth:= 0; - end; - end else - begin - result.width := 0; - result.height:= 0; - result.colorDepth:= 0; - result.alphaDepth:= 0; - end; -end; - -function TBGRAReaderBMP.GetBitmapDraft(AStream: TStream; AMaxWidth, - AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap; -var - bmpFormat: TBGRAReaderBMP; - prevStreamPos: Int64; -begin - bmpFormat:= TBGRAReaderBMP.Create; - bmpFormat.Subformat:= Subformat; - bmpFormat.MinifyHeight := AMaxHeight*2; - result := BGRABitmapFactory.Create; - prevStreamPos := AStream.Position; - try - result.LoadFromStream(AStream, bmpFormat); - AOriginalWidth:= result.Width; - AOriginalHeight:= bmpFormat.OriginalHeight; - finally - bmpFormat.Free; - AStream.Position := prevStreamPos; - end; -end; - -procedure TBGRAReaderBMP.FreeBufs; -begin - If (LineBuf<>Nil) then - begin - FreeMem(LineBuf); - LineBuf:=Nil; - end; - If (FPalette<>Nil) then - begin - FreeMem(FPalette); - FPalette:=Nil; - end; - If (FBGRAPalette<>Nil) then - begin - FreeMem(FBGRAPalette); - FBGRAPalette:=Nil; - end; -end; - -{ Counts how many bits are set } -function TBGRAReaderBMP.CountBits(Value : byte) : shortint; -var i,bits : shortint; -begin - bits:=0; - for i:=0 to 7 do - begin - if (value mod 2)<>0 then inc(bits); - value:=value shr 1; - end; - Result:=bits; -end; - -{ If compression is bi_bitfields, there could be arbitrary masks for colors. - Although this is not compatible with windows9x it's better to know how to read these bitmaps - We must determine how to switch the value once masked - Example: 0000 0111 1110 0000, if we shr 5 we have 00XX XXXX for the color, but these bits must be the - highest in the color, so we must shr (5-(8-6))=3, and we have XXXX XX00. - A negative value means "shift left" } -function TBGRAReaderBMP.ShiftCount(Mask : LongWord) : shortint; -var tmp : shortint; -begin - tmp:=0; - if Mask=0 then - begin - Result:=0; - exit; - end; - - while (Mask mod 2)=0 do { rightmost bit is 0 } - begin - inc(tmp); - Mask:= Mask shr 1; - end; - tmp:=tmp-(8-CountBits(Mask and $FF)); - Result:=tmp; -end; - -function TBGRAReaderBMP.ExpandColor(value : LongWord) : TFPColor; -var tmpr, tmpg, tmpb : LongWord; - col : TColorRGB; -begin - {$IFDEF ENDIAN_BIG} - value:=swap(value); - {$ENDIF} - tmpr:=value and RedMask; - tmpg:=value and GreenMask; - tmpb:=value and BlueMask; - if RedShift < 0 then col.R:=byte(tmpr shl (-RedShift)) - else col.R:=byte(tmpr shr RedShift); - if GreenShift < 0 then col.G:=byte(tmpg shl (-GreenShift)) - else col.G:=byte(tmpg shr GreenShift); - if BlueShift < 0 then col.B:=byte(tmpb shl (-BlueShift)) - else col.B:=byte(tmpb shr BlueShift); - Result:=RGBToFPColor(col); -end; - -function TBGRAReaderBMP.ExpandColorBGRA(value: LongWord): TBGRAPixel; -var tmpr, tmpg, tmpb : LongWord; -begin - {$IFDEF ENDIAN_BIG} - value:=swap(value); - {$ENDIF} - tmpr:=value and RedMask; - tmpg:=value and GreenMask; - tmpb:=value and BlueMask; - if RedShift < 0 then result.red:=byte(tmpr shl (-RedShift)) - else result.red:=byte(tmpr shr RedShift); - if GreenShift < 0 then result.green:=byte(tmpg shl (-GreenShift)) - else result.green:=byte(tmpg shr GreenShift); - if BlueShift < 0 then result.blue:=byte(tmpb shl (-BlueShift)) - else result.blue:=byte(tmpb shr BlueShift); - result.alpha:= 255; -end; - -procedure TBGRAReaderBMP.SetupRead(nPalette, nRowBits: Integer; Stream : TStream); - -var - ColInfo: ARRAY OF TColorRGBA; - ColInfo3: packed array of TColorRGB; - i,colorPresent: Integer; - -begin - if ((BFI.Compression=BI_RGB) and (BFI.BitCount=16)) then { 5 bits per channel, fixed mask } - begin - RedMask:=$7C00; RedShift:=7; - GreenMask:=$03E0; GreenShift:=2; - BlueMask:=$001F; BlueShift:=-3; - end - else if ((BFI.Compression=BI_BITFIELDS) and (BFI.BitCount in [16,32])) then { arbitrary mask } - begin - Stream.Read(RedMask,4); - Stream.Read(GreenMask,4); - Stream.Read(BlueMask,4); - {$IFDEF ENDIAN_BIG} - RedMask:=swap(RedMask); - GreenMask:=swap(GreenMask); - BlueMask:=swap(BlueMask); - {$ENDIF} - RedShift:=ShiftCount(RedMask); - GreenShift:=ShiftCount(GreenMask); - BlueShift:=ShiftCount(BlueMask); - end - else if nPalette>0 then - begin - GetMem(FPalette, nPalette*SizeOf(TFPColor)); - GetMem(FBGRAPalette, nPalette*SizeOf(TBGRAPixel)); - SetLength(ColInfo, nPalette); - if BFI.ClrUsed>0 then - colorPresent:= min(BFI.ClrUsed,nPalette) - else - colorPresent:= nPalette; - if FPaletteEntrySize = 3 then - begin - setlength(ColInfo3, nPalette); - Stream.Read(ColInfo3[0],colorPresent*SizeOf(TColorRGB)); - for i := 0 to colorPresent-1 do - ColInfo[i].RGB := ColInfo3[i]; - end - else - begin - Stream.Read(ColInfo[0],colorPresent*SizeOf(TColorRGBA)); - end; - for i := 0 to High(ColInfo) do - begin - FPalette[i] := RGBToFPColor(ColInfo[i].RGB); - FBGRAPalette[i]:= FPColorToBGRA(FPalette[i]); - end - end - else if BFI.ClrUsed>0 then { Skip palette } - {$PUSH}{$HINTS OFF} - Stream.Position := Stream.Position + BFI.ClrUsed*SizeOf(TColorRGBA); - {$POP} - ReadSize:=((nRowBits + 31) div 32) shl 2; - GetMem(LineBuf,ReadSize); -end; - -procedure TBGRAReaderBMP.InternalRead(Stream:TStream; Img:TFPCustomImage); - -Var - i, pallen : Integer; - BadCompression : boolean; - WriteScanlineProc: TWriteScanlineProc; - headerSize: LongWord; - os2header: TOS2BitmapHeader; - shouldContinue: boolean; - -begin - shouldContinue:=true; - Progress(psStarting,0,false,EmptyRect,'',shouldContinue); - if not shouldContinue then exit; - - headerSize := LEtoN(Stream.ReadDWord); - fillchar({%H-}BFI,SizeOf(BFI),0); - if headerSize = sizeof(TOS2BitmapHeader) then - begin - fillchar({%H-}os2header,SizeOf(os2header),0); - Stream.Read(os2header.bcWidth,min(SizeOf(os2header),headerSize)-sizeof(LongWord)); - BFI.Size := 16; - BFI.Width := LEtoN(os2header.bcWidth); - BFI.Height := LEtoN(os2header.bcHeight); - BFI.Planes := LEtoN(os2header.bcPlanes); - BFI.BitCount := LEtoN(os2header.bcBitCount); - FPaletteEntrySize:= 3; - end else - begin - Stream.Read(BFI.Width,min(SizeOf(BFI),headerSize)-sizeof(LongWord)); - {$IFDEF ENDIAN_BIG} - SwapBMPInfoHeader(BFI); - {$ENDIF} - BFI.Size := headerSize; - FPaletteEntrySize:= 4; - end; - { This will move past any junk after the BFI header } - Stream.Position:=Stream.Position-SizeOf(BFI)+BFI.Size; - with BFI do - begin - BadCompression:=false; - if ((Compression=BI_RLE4) and (BitCount<>4)) then BadCompression:=true; - if ((Compression=BI_RLE8) and (BitCount<>8)) then BadCompression:=true; - if ((Compression=BI_BITFIELDS) and (not (BitCount in [16,32]))) then BadCompression:=true; - if not (Compression in [BI_RGB..BI_BITFIELDS]) then BadCompression:=true; - if BadCompression then - raise FPImageException.Create('Bad BMP compression mode'); - TopDown:=(Height<0); - Height:=abs(Height); - FOriginalHeight := Height; - if (TopDown and (not (Compression in [BI_RGB,BI_BITFIELDS]))) then - raise FPImageException.Create('Top-down bitmaps cannot be compressed'); - Img.SetSize(0,0); - if BitCount<=8 then - begin - Img.UsePalette:=true; - Img.Palette.Clear; - end - else Img.UsePalette:=false; - Case BFI.BitCount of - 1 : { Monochrome } - SetupRead(2,Width,Stream); - 4 : - SetupRead(16,Width*4,Stream); - 8 : - SetupRead(256,Width*8,Stream); - 16 : - SetupRead(0,Width*8*2,Stream); - 24: - SetupRead(0,Width*8*3,Stream); - 32: - SetupRead(0,Width*8*4,Stream); - else raise exception.Create('Invalid bit depth ('+inttostr(BFI.BitCount)+')'); - end; - end; - if Subformat = bsfHeaderlessWithMask then BFI.Height := BFI.Height div 2; - Try - { Note: it would be better to Fill the image palette in setupread instead of creating FPalette. - FPalette is indeed useless but we cannot remove it since it's not private :\ } - pallen:=0; - if BFI.BitCount<=8 then - if BFI.ClrUsed>0 then pallen:=BFI.ClrUsed - else pallen:=(1 shl BFI.BitCount); - if pallen>0 then - begin - if FPalette = nil then raise exception.Create('Internal error: palette object not initialized'); - Img.Palette.Count:=pallen; - for i:=0 to pallen-1 do - Img.Palette.Color[i]:=FPalette[i]; - end; - if (MinifyHeight > 0) and (MinifyHeight < BFI.Height) then FOutputHeight:= MinifyHeight else - if WantedHeight > 0 then FOutputHeight:= WantedHeight else - FOutputHeight:= BFI.Height; - - if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then InitReadBuffer(Stream,2048); - FHasAlphaValues:= false; - - Img.SetSize(BFI.Width,FOutputHeight); - - if Img is TBGRACustomBitmap then - WriteScanlineProc := @WriteScanLineBGRA else - WriteScanlineProc := @WriteScanLine; - - ImageVerticalLoop(Stream, Img, @ReadScanLine, @SkipScanLine, WriteScanlineProc, - @MainProgressProc, shouldContinue); - - if shouldContinue then - begin - if not FHasAlphaValues and (TransparencyOption = toAuto) and (BFI.BitCount = 32) then - MakeOpaque(Img); - if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer; - - if Subformat = bsfHeaderlessWithMask then LoadMask(Stream,Img, shouldContinue); - - Progress(psEnding,100,false,EmptyRect,'',shouldContinue); - end; - - finally - FreeBufs; - end; -end; - -procedure TBGRAReaderBMP.ExpandRLE8ScanLine(Row : Integer; Stream : TStream); -var i,j,k : integer; - b0, b1 : byte; -begin - i:=0; - while true do - begin - { let's see if we must skip pixels because of delta... } - if DeltaY<>-1 then - begin - if Row=DeltaY then j:=DeltaX { If we are on the same line, skip till DeltaX } - else j:=ReadSize; { else skip up to the end of this line } - while (i0 then { number of repetitions } - begin - if b0+i>ReadSize then - raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); - j:=i+b0; - while (iReadSize then - raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); - for k := b1-1 downto 0 do - Begin - LineBuf[i] := GetNextBufferByte; - Inc(i); - end; - { aligned on 2 bytes boundary: every group starts on a 2 bytes boundary, but absolute group - could end on odd address if there is a odd number of elements, so we pad it } - if (b1 mod 2)<>0 then GetNextBufferByte; - end; - end; - end; -end; - -procedure TBGRAReaderBMP.ExpandRLE4ScanLine(Row : Integer; Stream : TStream); -var i,j,tmpsize : integer; - b0, b1 : byte; - nibline : pbyte; { temporary array of nibbles } - even : boolean; -begin - tmpsize:=ReadSize*2; { ReadSize is in bytes, while nibline is made of nibbles, so it's 2*readsize long } - getmem(nibline,tmpsize); - if nibline=nil then - raise FPImageException.Create('Out of memory'); - try - i:=0; - while true do - begin - { let's see if we must skip pixels because of delta... } - if DeltaY<>-1 then - begin - if Row=DeltaY then j:=DeltaX { If we are on the same line, skip till DeltaX } - else j:=tmpsize; { else skip up to the end of this line } - while (i0 then { number of repetitions } - begin - if b0+i>tmpsize then - raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); - even:=true; - j:=i+b0; - while (itmpsize then - raise FPImageException.Create('Bad BMP RLE chunk at row '+inttostr(row)+', col '+inttostr(i)+', file offset $'+inttohex(Stream.Position,16) ); - j:=i+b1; - even:=true; - while (i0 then GetNextBufferByte; - end; - end; - end; - { pack the nibline into the linebuf } - for i:=0 to ReadSize-1 do - LineBuf[i]:=(NibLine[i*2] shl 4) or NibLine[i*2+1]; - finally - FreeMem(nibline) - end; -end; - -procedure TBGRAReaderBMP.ReadScanLine(Row : Integer; Stream : TStream); -begin - if BFI.Compression=BI_RLE8 then ExpandRLE8ScanLine(Row,Stream) - else if BFI.Compression=BI_RLE4 then ExpandRLE4ScanLine(Row,Stream) - else Stream.Read(LineBuf[0],ReadSize); -end; - -procedure TBGRAReaderBMP.SkipScanLine(Row: Integer; Stream: TStream); -begin - if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then ReadScanLine(Row,Stream) - else Stream.Position := Stream.Position+ReadSize; -end; - -procedure TBGRAReaderBMP.WriteScanLine(Row : Integer; Img : TFPCustomImage); - -Var - Column : Integer; - c: TFPColor; -begin - Case BFI.BitCount of - 1 : - for Column:=0 to Img.Width-1 do - if ((LineBuf[Column div 8] shr (7-(Column and 7)) ) and 1) <> 0 then - img.Pixels[Column,Row]:=1 - else - img.Pixels[Column,Row]:=0; - 4 : - for Column:=0 to img.Width-1 do - img.Pixels[Column,Row]:=(LineBuf[Column div 2] shr (((Column+1) and 1)*4)) and $0f; - 8 : - for Column:=0 to img.Width-1 do - img.Pixels[Column,Row]:=LineBuf[Column]; - 16 : - for Column:=0 to img.Width-1 do - img.colors[Column,Row]:=ExpandColor(PWord(LineBuf)[Column]); - 24 : - for Column:=0 to img.Width-1 do - img.colors[Column,Row]:=RGBToFPColor(PColorRGB(LineBuf)[Column]); - 32 : - for Column:=0 to img.Width-1 do - if BFI.Compression=BI_BITFIELDS then - img.colors[Column,Row]:=ExpandColor(PLongWord(LineBuf)[Column]) - else - begin - if FTransparencyOption = toOpaque then - img.colors[Column,Row]:=RGBToFPColor(PColorRGB(PColorRGBA(LineBuf)+Column)^) - else - begin - c := RGBAToFPColor(PColorRGBA(LineBuf)[Column]); - if c.alpha <> 0 then FHasAlphaValues:= true; - img.colors[Column,Row]:= c; - end; - end; - end; -end; - -procedure TBGRAReaderBMP.WriteScanLineBGRA(Row: Integer; Img: TFPCustomImage); - -Var - Column : Integer; - PDest: PBGRAPixel; - PSrc: PByte; -begin - PDest := TBGRACustomBitmap(Img).ScanLine[Row]; - Case BFI.BitCount of - 1 : - for Column:=0 to Img.Width-1 do - begin - if ((LineBuf[Column div 8] shr (7-(Column and 7)) ) and 1) <> 0 then - PDest^ := FBGRAPalette[1] - else - PDest^ := FBGRAPalette[0]; - inc(PDest); - end; - 4 : - for Column:=0 to img.Width-1 do - begin - PDest^ := FBGRAPalette[(LineBuf[Column div 2] shr (((Column+1) and 1)*4)) and $0f]; - inc(PDest); - end; - 8 : - for Column:=0 to img.Width-1 do - begin - PDest^ := FBGRAPalette[LineBuf[Column]]; - inc(PDest); - end; - 16 : - for Column:=0 to img.Width-1 do - begin - PDest^ :=ExpandColorBGRA(PWord(LineBuf)[Column]); - inc(PDest); - end; - 24 : begin - PSrc := LineBuf; - for Column:=0 to img.Width-1 do - begin - PDest^ := BGRA((Psrc+2)^,(Psrc+1)^,(Psrc)^); - inc(PDest); - inc(PSrc,3); - end; - end; - 32 : - if BFI.Compression=BI_BITFIELDS then - begin - for Column:=0 to img.Width-1 do - begin - PDest^:=ExpandColorBGRA(PLongWord(LineBuf)[Column]); - inc(PDest); - end; - end else - if FTransparencyOption = toOpaque then - begin - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - begin - PSrc := LineBuf; - for Column:=0 to img.Width-1 do - begin - PDest^:= BGRA((PSrc)^,(PSrc+1)^,(PSrc+2)^); - inc(PDest); - Inc(PSrc,4); - end; - end - else - begin - PSrc := LineBuf; - for Column:=0 to img.Width-1 do - begin - PDest^:= BGRA((PSrc+2)^,(PSrc+1)^,(PSrc+1)^); - inc(PDest); - Inc(PSrc,4); - end; - end; - {$POP} - end else - begin - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - begin - PSrc := LineBuf; - for Column:=0 to img.Width-1 do - begin - PDest^:= BGRA((PSrc+2)^,(PSrc+1)^,(PSrc)^,(PSrc+3)^); - if PDest^.alpha <> 0 then FHasAlphaValues:= true; - inc(PDest); - Inc(PSrc,4); - end; - end - else - begin - PSrc := LineBuf; - for Column:=0 to img.Width-1 do - begin - PDest^ := PBGRAPixel(PSrc)^; - if PDest^.alpha <> 0 then FHasAlphaValues:= true; - inc(PDest); - Inc(PSrc,4); - end; - end; - {$POP} - end; - end; -end; - -procedure TBGRAReaderBMP.ReadMaskLine(Row: Integer; Stream: TStream); -begin - FillChar(FMaskData^, FMaskDataSize, 0); - Stream.Read(FMaskData^, FMaskDataSize); -end; - -procedure TBGRAReaderBMP.SkipMaskLine(Row: Integer; Stream: TStream); -begin - Stream.Position := Stream.Position+FMaskDataSize; -end; - -procedure TBGRAReaderBMP.WriteMaskLine(Row: Integer; Img: TFPCustomImage); -var x, maskPos: integer; - bit: byte; - bmp: TBGRACustomBitmap; - pimg: PBGRAPixel; -begin - if Img is TBGRACustomBitmap then - bmp := TBGRACustomBitmap(Img) - else - exit; - - maskPos := 0; - bit := $80; - pimg := bmp.ScanLine[Row]; - for x := 0 to bmp.Width-1 do - begin - if (FMaskData[maskPos] and bit) <> 0 then //if AND mask is non zero, value is kept - begin - if pimg^.alpha = 255 then - begin - pimg^.alpha := 0; - if LongWord(pimg^) <> 0 then - begin - bmp.NeedXorMask; - bmp.XorMask.SetPixel(x,Row,pimg^); - end; - end; - end; - inc(pimg); - bit := bit shr 1; - if bit = 0 then - begin - bit := $80; - inc(maskPos); - end; - end; -end; - -function TBGRAReaderBMP.InternalCheck (Stream:TStream) : boolean; -begin - fillchar(BFH, sizeof(BFH), 0); - if Subformat in [bsfHeaderless,bsfHeaderlessWithMask] then - begin - result := true; - Hotspot := Point(0,0); - end else - begin - if stream.Read(BFH,SizeOf(BFH)) <> sizeof(BFH) then - begin - result := false; - exit; - end; - Hotspot := Point(LEtoN(PWord(@BFH.bfReserved)^),LEtoN((PWord(@BFH.bfReserved)+1)^)); - {$IFDEF ENDIAN_BIG} - SwapBMPFileHeader(BFH); - {$ENDIF} - With BFH do - Result:=(bfType=BMmagic); // Just check magic number - end; -end; - -procedure TBGRAReaderBMP.InitReadBuffer(AStream: TStream; ASize: integer); -begin - setLength(FBuffer,ASize); - FBufferSize := AStream.Read(FBuffer[0],ASize); - FBufferPos := 0; - FBufferStream := AStream; -end; - -procedure TBGRAReaderBMP.CloseReadBuffer; -begin - FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos; -end; - -function TBGRAReaderBMP.GetNextBufferByte: byte; -begin - if FBufferPos < FBufferSize then - begin - result := FBuffer[FBufferPos]; - inc(FBufferPos); - end else - if FBufferSize = 0 then - result := 0 - else - begin - FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer)); - FBufferPos := 0; - if FBufferPos < FBufferSize then - begin - result := FBuffer[FBufferPos]; - inc(FBufferPos); - end else - result := 0; - end; -end; - -procedure TBGRAReaderBMP.MakeOpaque(Img: TFPCustomImage); -var c: TFPColor; - x,y: Int32or64; -begin - if Img is TBGRACustomBitmap then - TBGRACustomBitmap(Img).AlphaFill(255) - else - for y := 0 to Img.Height-1 do - for x := 0 to Img.Width-1 do - begin - c := Img.Colors[x,y]; - c.alpha := alphaOpaque; - Img.Colors[x,y] := c; - end; -end; - -procedure TBGRAReaderBMP.LoadMask(Stream: TStream; Img: TFPCustomImage; var ShouldContinue: boolean); -begin - if Img is TBGRACustomBitmap then TBGRACustomBitmap(Img).DiscardXorMask; - FMaskDataSize := ((Img.Width+31) div 32)*4; //padded to LongWord - getmem(FMaskData, FMaskDataSize); - try - ImageVerticalLoop(Stream,Img, @ReadMaskLine, @SkipMaskLine, @WriteMaskLine, nil, ShouldContinue); - finally - freemem(FMaskData); - FMaskData := nil; - FMaskDataSize := 0; - end; -end; - -procedure TBGRAReaderBMP.MainProgressProc(Percent: integer; - var ShouldContinue: boolean); -begin - Progress(psRunning,Percent,false,EmptyRect,'',ShouldContinue); -end; - -procedure TBGRAReaderBMP.ImageVerticalLoop(Stream: TStream; - Img: TFPCustomImage; ReadProc, SkipProc: TReadScanlineProc; - WriteProc: TWriteScanlineProc; ProgressProc: TProgressProc; - var ShouldContinue: boolean); -var - prevPercent, percent, percentAdd : byte; - percentMod : LongWord; - percentAcc, percentAccAdd : LongWord; - PrevSourceRow,SourceRow, SourceRowDelta, SourceLastRow: integer; - SourceRowAdd: integer; - SourceRowAcc,SourceRowMod: integer; - SourceRowAccAdd: integer; - OutputLastRow, OutputRow, OutputRowDelta: integer; -begin - if OutputHeight <= 0 then exit; - - percent:=0; - percentMod:= OutputHeight; - percentAdd := 100 div percentMod; - percentAcc:= percentMod div 2; - percentAccAdd := 100 mod percentMod; - - DeltaX:=-1; DeltaY:=-1; - if TopDown then - begin - SourceRowDelta := 1; - SourceRow := 0; - SourceLastRow := BFI.Height-1; - end else - begin - SourceRowDelta := -1; - SourceRow := BFI.Height-1; - SourceLastRow := 0; - end; - OutputRowDelta:= SourceRowDelta; - - SourceRowMod := OutputHeight; - SourceRowAdd := (BFI.Height div SourceRowMod)*SourceRowDelta; - SourceRowAcc := SourceRowMod div 2; - SourceRowAccAdd := BFI.Height mod SourceRowMod; - If TopDown then - begin - OutputRow := 0; - OutputLastRow := OutputHeight-1; - end - else - begin - OutputRow := OutputHeight-1; - OutputLastRow := 0; - end; - - PrevSourceRow := SourceRow-SourceRowDelta; - - while ShouldContinue and (SourceRow <> SourceLastRow+SourceRowDelta) do - begin - while PrevSourceRow <> SourceRow do - begin - inc(PrevSourceRow, SourceRowDelta); - if PrevSourceRow = SourceRow then - ReadProc(PrevSourceRow,Stream) - else - SkipProc(PrevSourceRow,Stream); - end; - WriteProc(OutputRow,Img); - if OutputRow = OutputLastRow then break; - - inc(OutputRow,OutputRowDelta); - inc(SourceRow,SourceRowAdd); - inc(SourceRowAcc,SourceRowAccAdd); - if SourceRowAcc >= SourceRowMod then - begin - dec(SourceRowAcc,SourceRowMod); - Inc(SourceRow,SourceRowDelta); - end; - - prevPercent := percent; - inc(percent,percentAdd); - inc(percentAcc,percentAccAdd); - if percentAcc>=percentMod then - begin - dec(percentAcc, percentMod); - inc(percent); - end; - if (percent<>prevPercent) and Assigned(ProgressProc) then ProgressProc(percent, ShouldContinue); - end; -end; - -initialization - - DefaultBGRAImageReader[ifBmp] := TBGRAReaderBMP; - -end. diff --git a/components/bgrabitmap/bgrareadbmpmiomap.pas b/components/bgrabitmap/bgrareadbmpmiomap.pas deleted file mode 100644 index a4978cc..0000000 --- a/components/bgrabitmap/bgrareadbmpmiomap.pas +++ /dev/null @@ -1,260 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAReadBmpMioMap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPimage, BGRABitmapTypes; - -const - MioMapMagicValue = 'RL'; - MioMapTransparentColor = $F81F; - -type - TMioHeader = packed record - magic: packed array[1..2] of char; - format: word; - width,height,nbColors,nbChunks: word; - end; - - TPixelArray = array of TBGRAPixel; - - { TBGRAReaderBmpMioMap } - - TBGRAReaderBmpMioMap = class(TFPCustomImageReader) - private - function ReadHeader(Stream: TStream; out header: TMioHeader): boolean; - function ReadPalette(Stream: TStream; nbColors: integer; alphaChannel: boolean): TPixelArray; - procedure UncompressChunks(Stream: TStream; nbChunks: integer; palette: TPixelArray; img: TFPCustomImage); - public - procedure InternalRead (Stream:TStream; Img:TFPCustomImage); override; - function InternalCheck (Stream:TStream) : boolean; override; - end; - -function MioMapToBGRA(AColor: Word): TBGRAPixel; -function BGRAToMioMap(const AColor: TBGRAPixel): Word; -function MioMapToAlpha(AValue: Byte): Byte; -function AlphaToMioMap(AValue: Byte): Byte; - -implementation - -uses bufstream; - -function MioMapToBGRA(AColor: Word): TBGRAPixel; -begin - if AColor = MioMapTransparentColor then - result := BGRAPixelTransparent - else - result := Color16BitToBGRA(AColor); -end; - -function BGRAToMioMap(const AColor: TBGRAPixel): Word; -begin - if AColor.alpha < 7 then - result := MioMapTransparentColor - else - begin - result := BGRAToColor16Bit(AColor); - if result = MioMapTransparentColor then dec(result); - end; -end; - -function MioMapToAlpha(AValue: Byte): Byte; -begin - result := AValue*255 div 32; -end; - -function AlphaToMioMap(AValue: Byte): Byte; -begin - result := (AValue*32 + 64) div 255; -end; - -{ TBGRAReaderBmpMioMap } - -function TBGRAReaderBmpMioMap.ReadHeader(Stream: TStream; out header: TMioHeader - ): boolean; -begin - result := false; - fillchar({%H-}header,sizeof(header),0); - if stream.Read(header, sizeof(header))<> sizeof(header) then exit; - if header.magic <> MioMapMagicValue then exit; - header.format:= LEtoN(header.format); - header.width:= LEtoN(header.width); - header.height:= LEtoN(header.height); - header.nbColors:= LEtoN(header.nbColors); - header.nbChunks:= LEtoN(header.nbChunks); - if header.format > 1 then exit; - result := true; -end; - -function TBGRAReaderBmpMioMap.ReadPalette(Stream: TStream; nbColors: integer; - alphaChannel: boolean): TPixelArray; -var mioPalette: packed array of word; - nbColorsRead,i: integer; - colorValue: word; - alphaPalette: packed array of byte; -begin - setlength(mioPalette, nbColors); - setlength(result,nbColors); - nbColorsRead:= Stream.Read({%H-}mioPalette[0], nbColors*2) div 2; - for i := 0 to nbColorsRead-1 do - begin - colorValue := LEtoN(mioPalette[i]); - result[i] := MioMapToBGRA(colorValue); - end; - for i := nbColorsRead to nbColors-1 do - result[i] := BGRAPixelTransparent; - if alphaChannel then - begin - setlength(alphaPalette,nbColors); - Stream.Read(alphaPalette[0],nbColors); - for i := 0 to nbColors-1 do - if mioPalette[i] <> MioMapTransparentColor then - result[i].alpha := MioMapToAlpha(alphaPalette[i]); - end; -end; - -procedure TBGRAReaderBmpMioMap.UncompressChunks(Stream: TStream; nbChunks: integer; - palette: TPixelArray; img: TFPCustomImage); -var i,maxChunkSize: integer; - chunkSizes: array of integer; - chunkData: packed array of byte; - pos,bytesRead: integer; - palLen: integer; - x,y: integer; - p: PBGRAPixel; - colorOffset: integer; - b: byte; - w,h: integer; - - procedure UncompressPixel(colorNumber, repeatCount: integer); - var - c: TBGRAPixel; - begin - if colorNumber >= palLen then - c := BGRAPixelTransparent - else - c := palette[colorNumber]; - while (repeatCount > 0) and (y < h) do - begin - if p <> nil then - begin - p^ := c; - inc(p); - end else - img.Colors[x,y] := BGRAToFPColor(c); - inc(x); - if x = w then - begin - x := 0; - inc(y); - if p <> nil then - begin - if y >= h then p := nil - else - p := TBGRACustomBitmap(Img).ScanLine[y]; - end; - end; - dec(repeatCount); - end; - end; - -begin - palLen := length(palette); - if (img.Width = 0) or (img.Height = 0) or (palLen = 0) then exit; - - maxChunkSize := 1; - setlength(chunkSizes, nbChunks); - for i := 0 to nbChunks-1 do - begin - if stream.read({%H-}b,1)=0 then b := 0; - if b < 255 then - begin - chunkSizes[i] := b; - end else - begin - if stream.read(b,1)=0 then b := 0; - chunkSizes[i] := b shl 8; - if stream.read(b,1)=0 then b := 0; - inc(chunkSizes[i], b); - end; - if chunkSizes[i]>maxChunkSize then - maxChunkSize := chunkSizes[i]; - end; - - setlength(chunkData, maxChunkSize); - x := 0; - y := 0; - w := img.Width; - h := img.Height; - colorOffset:= 0; - if Img is TBGRACustomBitmap then - begin - p := TBGRACustomBitmap(Img).ScanLine[y]; - TBGRACustomBitmap(Img).FillTransparent; - end - else - p := nil; - for i:= 0 to nbChunks-1 do - begin - bytesRead := Stream.Read(chunkData[0], chunkSizes[i]); - pos := 0; - while pos < bytesRead do - begin - if (chunkData[pos] = $FE) and (pos+2 < bytesRead) then - begin - UncompressPixel(chunkData[pos+1]+colorOffset,chunkData[pos+2]); - inc(pos,3); - end else - if (chunkData[pos] = $ff) and (pos+1 < bytesRead) then - begin - UncompressPixel(0,chunkData[pos+1]); - inc(pos,2); - end else - if (chunkData[pos] = $fd) and (pos+2 < bytesRead) then - begin - colorOffset:= chunkData[pos+1] + (chunkData[pos+2] shl 8); - inc(pos,3); - end else - if chunkData[pos] = 0 then - begin - UncompressPixel(0,1); - inc(pos); - end else - begin - UncompressPixel(chunkData[pos]+colorOffset,1); - inc(pos); - end; - end; - end; -end; - -procedure TBGRAReaderBmpMioMap.InternalRead(Stream: TStream; Img: TFPCustomImage); -var header: TMioHeader; - palette: TPixelArray; - buf: TReadBufStream; -begin - if not ReadHeader(stream, header) then exit; - buf := TReadBufStream.Create(Stream,1024); - Img.SetSize(header.width,header.height); - palette := ReadPalette(stream, header.nbColors, header.format = 1); - UncompressChunks(stream,header.nbChunks, palette, Img); - buf.Free; -end; - -function TBGRAReaderBmpMioMap.InternalCheck(Stream: TStream): boolean; -var OldPosition : int64; - dummy: TMioHeader; -begin - OldPosition:= stream.Position; - result := ReadHeader(stream, dummy); - stream.Position:= OldPosition; -end; - -initialization - - DefaultBGRAImageReader[ifBmpMioMap] := TBGRAReaderBmpMioMap; - -end. diff --git a/components/bgrabitmap/bgrareadgif.pas b/components/bgrabitmap/bgrareadgif.pas deleted file mode 100644 index e14a03e..0000000 --- a/components/bgrabitmap/bgrareadgif.pas +++ /dev/null @@ -1,381 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ This unit provides some optimisations of TFPReaderGif: decompression algorithm and direct pixel access of TBGRABitmap. - Note: to read an animation use TBGRAAnimatedGif instead. } - -unit BGRAReadGif; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPimage, FPReadGif; - -type - PGifRGB = ^TGifRGB; - - { TBGRAReaderGif } - - TBGRAReaderGif = class(TFPReaderGif) - protected - procedure ReadPaletteAtOnce(Stream: TStream; Size: integer); - procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; - function ReadScanLine(Stream: TStream): boolean; override; - function WriteScanLineBGRA(Img: TFPCustomImage): Boolean; virtual; - end; - -implementation - -uses BGRABitmapTypes; - -{ TBGRAReaderGif } - -procedure TBGRAReaderGif.ReadPaletteAtOnce(Stream: TStream; Size: integer); -Var - RGBEntries, RGBEntry : PGifRGB; - I : Integer; - c : TFPColor; -begin - FPalette.count := 0; - getmem(RGBEntries, sizeof(TGifRGB)*Size); - Stream.Read(RGBEntries^, sizeof(TGifRGB)*Size); - For I:=0 To Size-1 Do - Begin - RGBEntry := RGBEntries+I; - With c do - begin - Red:=RGBEntry^.Red or (RGBEntry^.Red shl 8); - Green:=RGBEntry^.Green or (RGBEntry^.Green shl 8); - Blue:=RGBEntry^.Blue or (RGBEntry^.Blue shl 8); - Alpha:=alphaOpaque; - end; - FPalette.Add(C); - End; - FreeMem(RGBEntries); -end; - -procedure TBGRAReaderGif.InternalRead(Stream: TStream; Img: TFPCustomImage); -var - Introducer:byte; - ColorTableSize :Integer; - ContProgress: Boolean; -begin - FPalette:=nil; - FScanLine:=nil; - try - ContProgress:=true; - Progress(psStarting, 0, False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - - FPalette := TFPPalette.Create(0); - - Stream.Position:=0; - // header - Stream.Read(FHeader,SizeOf(FHeader)); - Progress(psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - - // Endian Fix Mantis 8541. Gif is always little endian - {$IFDEF ENDIAN_BIG} - with FHeader do - begin - ScreenWidth := LEtoN(ScreenWidth); - ScreenHeight := LEtoN(ScreenHeight); - end; - {$ENDIF} - // global palette - if (FHeader.Packedbit and $80) <> 0 then - begin - ColorTableSize := FHeader.Packedbit and 7 + 1; - ReadPaletteAtOnce(stream, 1 shl ColorTableSize); - end; - - // skip extensions - Repeat - Introducer:=SkipBlock(Stream); - until (Introducer = $2C) or (Introducer = $3B); - - // descriptor - Stream.Read(FDescriptor, SizeOf(FDescriptor)); - {$IFDEF ENDIAN_BIG} - with FDescriptor do - begin - Left := LEtoN(Left); - Top := LEtoN(Top); - Width := LEtoN(Width); - Height := LEtoN(Height); - end; - {$ENDIF} - // local palette - if (FDescriptor.Packedbit and $80) <> 0 then - begin - ColorTableSize := FDescriptor.Packedbit and 7 + 1; - ReadPaletteAtOnce(stream, 1 shl ColorTableSize); - end; - - // parse header - if not AnalyzeHeader then exit; - - // create image - if Assigned(OnCreateImage) then - OnCreateImage(Self,Img); - Img.SetSize(FWidth,FHeight); - - // read pixels - if not ReadScanLine(Stream) then exit; - if Img is TBGRACustomBitmap then - begin - if not WriteScanLineBGRA(Img) then exit; - end else - if not WriteScanLine(Img) then exit; - - // ToDo: read further images - finally - FreeAndNil(FPalette); - ReAllocMem(FScanLine,0); - end; - Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress); -end; - -function TBGRAReaderGif.ReadScanLine(Stream: TStream): Boolean; -var - OldPos, - UnpackedSize, - PackedSize:longint; - I: Integer; - Data, - Bits, - Code: LongWord; - SourcePtr: PByte; - InCode: LongWord; - - CodeSize: LongWord; - CodeMask: LongWord; - FreeCode: LongWord; - OldCode: LongWord; - Prefix: array[0..4095] of LongWord; - Suffix, - Stack: array [0..4095] of Byte; - StackPointer, StackTop: PByte; - StackSize: integer; - DataComp, - Target: PByte; - {%H-}B, - {%H-}FInitialCodeSize, - FirstChar: Byte; - ClearCode, - EOICode: Word; - ContProgress: Boolean; - -begin - DataComp:=nil; - ContProgress:=true; - try - // read dictionary size - Stream.read({%H-}FInitialCodeSize, 1); - - // search end of compressor table - OldPos:=Stream.Position; - PackedSize := 0; - Repeat - Stream.read({%H-}B, 1); - if B > 0 then - begin - inc(PackedSize, B); - Stream.Seek(B, soFromCurrent); - end; - until B = 0; - - Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)), - False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit(false); - - Getmem(DataComp, PackedSize); - // read compressor table - SourcePtr:=DataComp; - Stream.Position:=OldPos; - Repeat - Stream.read(B, 1); - if B > 0 then - begin - Stream.ReadBuffer(SourcePtr^, B); - Inc(SourcePtr,B); - end; - until B = 0; - - Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)), - False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit(false); - - SourcePtr:=DataComp; - Target := FScanLine; - CodeSize := FInitialCodeSize + 1; - ClearCode := 1 shl FInitialCodeSize; - EOICode := ClearCode + 1; - FreeCode := ClearCode + 2; - OldCode := 4096; - CodeMask := (1 shl CodeSize) - 1; - UnpackedSize:=FWidth * FHeight; - for I := 0 to ClearCode - 1 do - begin - Prefix[I] := 4096; - Suffix[I] := I; - end; - StackTop := @Stack[high(Stack)]; - StackPointer := StackTop; - FirstChar := 0; - Data := 0; - Bits := 0; - // LZW decompression gif - while (UnpackedSize > 0) and (PackedSize > 0) do - begin - Inc(Data, SourcePtr^ shl Bits); - Inc(Bits, 8); - while Bits >= CodeSize do - begin - Code := Data and CodeMask; - Data := Data shr CodeSize; - Dec(Bits, CodeSize); - if Code = EOICode then Break; - if Code = ClearCode then - begin - CodeSize := FInitialCodeSize + 1; - CodeMask := (1 shl CodeSize) - 1; - FreeCode := ClearCode + 2; - OldCode := 4096; - Continue; - end; - if Code > FreeCode then Break; - if OldCode = 4096 then - begin - FirstChar := Suffix[Code]; - Target^ := FirstChar; - Inc(Target); - Dec(UnpackedSize); - OldCode := Code; - Continue; - end; - InCode := Code; - if Code = FreeCode then - begin - StackPointer^ := FirstChar; - dec(StackPointer); - Code := OldCode; - end; - while Code > ClearCode do - begin - StackPointer^ := Suffix[Code]; - dec(StackPointer); - Code := Prefix[Code]; - end; - FirstChar := Suffix[Code]; - StackPointer^ := FirstChar; - dec(StackPointer); - Prefix[FreeCode] := OldCode; - Suffix[FreeCode] := FirstChar; - if (FreeCode = CodeMask) and - (CodeSize < 12) then - begin - Inc(CodeSize); - CodeMask := (1 shl CodeSize) - 1; - end; - if FreeCode < 4095 then Inc(FreeCode); - OldCode := InCode; - StackSize := StackTop-StackPointer; - if StackSize > 0 then - begin - Move((StackPointer+1)^, Target^, StackSize); - inc(Target, StackSize); - StackPointer:= StackTop; - dec(UnpackedSize, StackSize); - end; - end; - Inc(SourcePtr); - Dec(PackedSize); - end; - Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)), - False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit(false); - finally - if DataComp<>nil then - FreeMem(DataComp); - end; - Result:=true; -end; - -function TBGRAReaderGif.WriteScanLineBGRA(Img: TFPCustomImage): Boolean; -Var - Row, Col,i : Integer; - Pass, Every : byte; - P : PByte; - PBGRAPalette: PBGRAPixel; - PDest: PBGRAPixel; - function IsMultiple(NumberA, NumberB: Integer): Boolean; - begin - Result := (NumberA >= NumberB) and - (NumberB > 0) and - (NumberA mod NumberB = 0); - end; -begin - Result:=false; - P:=FScanLine; - getmem(PBGRAPalette, (FPalette.Count)*sizeof(TBGRAPixel)); - for i := 0 to FPalette.Count-1 do PBGRAPalette[i] := FPColorToBGRA(FPalette.Color[i]); - If FInterlace then - begin - For Pass := 1 to 4 do - begin - Case Pass of - 1 : begin - Row := 0; - Every := 8; - end; - 2 : begin - Row := 4; - Every := 8; - end; - 3 : begin - Row := 2; - Every := 4; - end; - else{4} - begin - Row := 1; - Every := 2; - end; - end; - Repeat - PDest := TBGRACustomBitmap(Img).ScanLine[Row]; - for Col:=Img.Width-1 downto 0 do - begin - PDest^ := PBGRAPalette[P^]; - Inc(P); - Inc(PDest); - end; - Inc(Row, Every); - until Row >= Img.Height; - end; - end - else - begin - for Row:=0 to Img.Height-1 do - begin - PDest := TBGRACustomBitmap(Img).ScanLine[Row]; - for Col:=Img.Width-1 downto 0 do - begin - PDest^ := PBGRAPalette[P^]; - Inc(P); - Inc(PDest); - end; - end; - end; - FreeMem(PBGRAPalette); - Result:=true; -end; - - -initialization - - DefaultBGRAImageReader[ifGif] := TBGRAReaderGif; - -end. diff --git a/components/bgrabitmap/bgrareadico.pas b/components/bgrabitmap/bgrareadico.pas deleted file mode 100644 index aaacce9..0000000 --- a/components/bgrabitmap/bgrareadico.pas +++ /dev/null @@ -1,149 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAReadIco; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, FPimage{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF}; - -type - {$IFDEF BGRABITMAP_USE_LCL}TCustomIconClass = class of TCustomIcon;{$ENDIF} - TByteSet = set of byte; - - { TBGRAReaderIcoOrCur } - - TBGRAReaderIcoOrCur = class(TFPCustomImageReader) - protected - procedure InternalRead({%H-}Str: TStream; {%H-}Img: TFPCustomImage); override; - function InternalCheck(Str: TStream): boolean; override; - function ExpectedMagic: TByteSet; virtual; abstract; - {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; virtual; abstract;{$ENDIF} - public - WantedWidth, WantedHeight : integer; - end; - - TBGRAReaderIco = class(TBGRAReaderIcoOrCur) - protected - function ExpectedMagic: TByteSet; override; - {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; override;{$ENDIF} - end; - - { TBGRAReaderCur } - - TBGRAReaderCur = class(TBGRAReaderIcoOrCur) - protected - function ExpectedMagic: TByteSet; override; - {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; override;{$ENDIF} - end; - -implementation - -uses BGRABitmapTypes{$IFNDEF BGRABITMAP_USE_LCL}, BGRAIconCursor{$ENDIF}; - -{ TBGRAReaderCur } - -function TBGRAReaderCur.ExpectedMagic: TByteSet; -begin - result := [2]; -end; - -{$IFDEF BGRABITMAP_USE_LCL}function TBGRAReaderCur.LazClass: TCustomIconClass; -begin - result := TCursorImage; -end;{$ENDIF} - -{ TBGRAReaderIco } - -function TBGRAReaderIco.ExpectedMagic: TByteSet; -begin - result := [1,2]; -end; - -{$IFDEF BGRABITMAP_USE_LCL}function TBGRAReaderIco.LazClass: TCustomIconClass; -begin - result := TIcon; -end;{$ENDIF} - -{ TBGRAReaderIcoOrCur } - -procedure TBGRAReaderIcoOrCur.InternalRead(Str: TStream; Img: TFPCustomImage); -{$IFDEF BGRABITMAP_USE_LCL} -var ico: TCustomIcon; i,bestIdx: integer; - height,width: word; format:TPixelFormat; - bestHeight,bestWidth: integer; maxFormat: TPixelFormat; - compWidth,compHeight: integer; -begin - if WantedWidth > 0 then compWidth:= WantedWidth else compWidth:= 65536; - if WantedHeight > 0 then compHeight:= WantedHeight else compHeight:= 65536; - ico := LazClass.Create; - try - ico.LoadFromStream(Str); - bestIdx := -1; - bestHeight := 0; - bestWidth := 0; - maxFormat := pfDevice; - for i := 0 to ico.Count-1 do - begin - ico.GetDescription(i,format,height,width); - if (bestIdx = -1) or (abs(height-compHeight)+abs(width-compWidth) < abs(bestHeight-compHeight)+abs(bestWidth-compWidth)) or - ((height = bestHeight) and (width = bestWidth) and (format > maxFormat)) then - begin - bestIdx := i; - bestHeight := height; - bestWidth := width; - maxFormat := format; - end; - end; - if (bestIdx = -1) or (bestWidth = 0) or (bestHeight = 0) then - raise exception.Create('No adequate icon found') else - begin - ico.Current := bestIdx; - Img.Assign(ico); - end; - finally - ico.free; - end; -end; -{$ELSE} -var icoCur: TBGRAIconCursor; - compWidth,compHeight: integer; - bmp: TBGRACustomBitmap; -begin - if WantedWidth > 0 then compWidth:= WantedWidth else compWidth:= 65536; - if WantedHeight > 0 then compHeight:= WantedHeight else compHeight:= 65536; - icoCur := TBGRAIconCursor.Create(Str); - try - bmp := icoCur.GetBestFitBitmap(compWidth,compHeight); - try - Img.Assign(bmp); - finally - bmp.Free; - end; - finally - icoCur.Free; - end; -end; -{$ENDIF} - -function TBGRAReaderIcoOrCur.InternalCheck(Str: TStream): boolean; -var {%H-}magic: packed array[0..5] of byte; - oldPos: int64; -begin - oldPos := str.Position; - result := (str.Read({%H-}magic,sizeof(magic)) = sizeof(magic)); - str.Position:= oldPos; - if result then - result := (magic[0] = $00) and (magic[1] = $00) and (magic[2] in ExpectedMagic) and (magic[3] = $00) and - (magic[4] + (magic[5] shl 8) > 0); -end; - -initialization - - DefaultBGRAImageReader[ifIco] := TBGRAReaderIco; - DefaultBGRAImageReader[ifCur] := TBGRAReaderCur; - -end. - diff --git a/components/bgrabitmap/bgrareadjpeg.pas b/components/bgrabitmap/bgrareadjpeg.pas deleted file mode 100644 index 40d8996..0000000 --- a/components/bgrabitmap/bgrareadjpeg.pas +++ /dev/null @@ -1,63 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAReadJpeg; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPReadJPEG; - -type - TJPEGScale = FPReadJPEG.TJPEGScale; - TJPEGReadPerformance = FPReadJPEG.TJPEGReadPerformance; - -const - jsFullSize = FPReadJPEG.jsFullSize; - jsHalf = FPReadJPEG.jsHalf; - jsQuarter = FPReadJPEG.jsQuarter; - jsEighth = FPReadJPEG.jsEighth; - - jpBestQuality = FPReadJPEG.jpBestQuality; - jpBestSpeed = FPReadJPEG.jpBestSpeed; - -type - { TBGRAReaderJpeg } - - TBGRAReaderJpeg = class(TFPReaderJPEG) - constructor Create; override; - protected - function InternalCheck(Str: TStream): boolean; override; - end; - -implementation - -uses BGRABitmapTypes; - -{ TBGRAReaderJpeg } - -constructor TBGRAReaderJpeg.Create; -begin - inherited Create; - Performance := jpBestQuality; -end; - -function TBGRAReaderJpeg.InternalCheck(Str: TStream): boolean; -var {%H-}magic: packed array[0..3] of byte; - OldPos,BytesRead:int64; -begin - Result:=false; - if Str=nil then exit; - OldPos:= str.Position; - BytesRead := str.Read({%H-}magic,sizeof(magic)); - str.Position:=OldPos; - if BytesRead<>sizeof(magic) then exit; - if (magic[0] = $ff) and (magic[1] = $d8) and (magic[2] = $ff) and (magic[3] >= $c0) then result := true; -end; - -initialization - - DefaultBGRAImageReader[ifJpeg] := TBGRAReaderJpeg; - -end. - diff --git a/components/bgrabitmap/bgrareadlzp.pas b/components/bgrabitmap/bgrareadlzp.pas deleted file mode 100644 index cc0eb80..0000000 --- a/components/bgrabitmap/bgrareadlzp.pas +++ /dev/null @@ -1,377 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAReadLzp; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPimage, BGRALzpCommon, BGRABitmapTypes, BGRABitmap; - -type - - { TBGRAReaderLazPaint } - - TBGRAReaderLazPaint = class(TFPCustomImageReader) - private - FHeight: integer; - FNbLayers: integer; - FWidth: integer; - FCaption: string; - FDimensionsAlreadyFetched: boolean; - protected - procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; - procedure InternalReadLayers({%H-}str: TStream;{%H-}Img: TFPCustomImage); virtual; - procedure InternalReadCompressableBitmap(str: TStream; Img: TFPCustomImage); virtual; - function InternalCheck(Str: TStream): boolean; override; - public - WantThumbnail: boolean; - class procedure LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string); static; - property Width: integer read FWidth; - property Height: integer read FHeight; - property NbLayers: integer read FNbLayers; - property Caption: string read FCaption; - end; - -implementation - -uses BGRACompressableBitmap, BGRAReadPng; - -{ TBGRAReaderLazPaint } - -procedure TBGRAReaderLazPaint.InternalRead(Str: TStream; Img: TFPCustomImage); -var - {%H-}header: TLazPaintImageHeader; - oldPos: int64; - png: TBGRAReaderPNG; - -begin - FCaption := ''; - FWidth:= 0; - FHeight:= 0; - FNbLayers:= 0; - FDimensionsAlreadyFetched:= false; - oldPos := str.Position; - str.ReadBuffer({%H-}header.magic,sizeof(header.magic)); - if header.magic = LAZPAINT_MAGIC_HEADER then - begin - str.ReadBuffer(header.zero1, sizeof(header)-sizeof(header.magic)); - LazPaintImageHeader_SwapEndianIfNeeded(header); - if (header.zero1 <> 0) or (header.zero2 <> 0) or - (header.headerSize < $30) then raise exception.Create('Invalid file format'); - FWidth:= header.width; - FHeight:= header.height; - FNbLayers:= header.nbLayers; - FDimensionsAlreadyFetched:= true; - - if WantThumbnail and ((header.compressionMode and LAZPAINT_THUMBNAIL_PNG) <> 0) then - begin - str.Position:= oldPos+header.headerSize; - png := TBGRAReaderPNG.create; - try - png.ImageRead(Str,Img); - except - png.Free; - raise exception.Create('Invalid file format'); - end; - png.free; - exit; - end; - - if ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_ZSTREAM) and - ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_RLE) then raise exception.Create('Compression mode not supported'); - - str.Position:= oldPos+header.previewOffset; - if (header.compressionMode and LAZPAINT_COMPRESSION_MASK) = LAZPAINT_COMPRESSION_MODE_RLE then - LoadRLEImage(Str, Img, FCaption) - else - InternalReadCompressableBitmap(str,Img); - - if header.layersOffset > 0 then - begin - Str.Position:= oldPos+header.layersOffset; - InternalReadLayers(Str,Img); - end; - end else - begin - str.Position:= oldPos; - InternalReadCompressableBitmap(str,Img); - if (Str.Position < Str.Size) and (FCaption = 'Preview') then InternalReadLayers(Str,Img); - end; -end; - -procedure TBGRAReaderLazPaint.InternalReadLayers(str: TStream; - Img: TFPCustomImage); -begin - //not implemented here -end; - -procedure TBGRAReaderLazPaint.InternalReadCompressableBitmap(str: TStream; - Img: TFPCustomImage); -var - compressed: TBGRACompressableBitmap; - bmp: TBGRABitmap; -begin - compressed := TBGRACompressableBitmap.Create; - try - compressed.ReadFromStream(Str); - bmp := compressed.GetBitmap; - try - FCaption := compressed.Caption; - if (Img is TBGRACustomBitmap) then - TBGRACustomBitmap(Img).Assign(bmp) - else - Img.Assign(bmp); - if not FDimensionsAlreadyFetched then - begin - FDimensionsAlreadyFetched := true; - FWidth:= bmp.width; - FHeight:= bmp.height; - FNbLayers:= 1; - end; - finally - bmp.Free; - end; - finally - compressed.Free; - end; -end; - -function TBGRAReaderLazPaint.InternalCheck(Str: TStream): boolean; -var {%H-}magic: packed array[0..7] of byte; - magicAsText: string; - oldPos: int64; -begin - oldPos := str.Position; - result := (str.Read({%H-}magic,sizeof(magic)) = sizeof(magic)); - str.Position:= oldPos; - setlength(magicAsText, sizeof(magic)); - move(magic[0], magicAsText[1], sizeof(magic)); - result := (copy(magicAsText,1,8) = 'LazPaint') or - (((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and - ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0)); -end; - -class procedure TBGRAReaderLazPaint.LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string); -var channelFlags: byte; - w,h,NbPixels,nameLen,channelStreamSize: LongWord; - nextPosition: int64; - PIndexed,PRed,PGreen,PBlue,PAlpha, - PCurRed, PCurGreen, PCurBlue, PCurAlpha: PByte; - PDest: PBGRAPixel; - x,y: LongWord; - c: TFPColor; - n,NbNonTransp: LongWord; - a,index: Int32or64; - ColorTab: packed array[0..256*3-1] of byte; -begin - w := LEtoN(str.ReadDWord); - h := LEtoN(str.ReadDWord); - nameLen := LEtoN(str.ReadDWord); - setlength(ACaption, nameLen); - {$PUSH}{$RANGECHECKS OFF} - str.ReadBuffer(ACaption[1], nameLen); - {$POP} - channelFlags := str.ReadByte; - NbPixels := w*h; - - PRed := nil; - PGreen := nil; - PBlue := nil; - PAlpha := nil; - - try - if (channelFlags and LazpaintChannelNoAlpha) = 0 then - begin - Getmem(PAlpha, NbPixels); - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - if (channelStreamSize > 0) and (NbPixels > 0) then DecodeLazRLE(Str, PAlpha^, NbPixels); - Str.Position:= nextPosition; - - NbNonTransp := 0; - PCurAlpha := PAlpha; - for n := NbPixels-1 downto 0 do - begin - if PCurAlpha^ <> 0 then inc(NbNonTransp); - inc(PCurAlpha); - end; - end else - NbNonTransp:= NbPixels; - - if NbNonTransp > 0 then - begin - if (channelFlags and LazpaintPalettedRGB) <> 0 then - begin - Getmem(PIndexed, NbNonTransp); - try - Getmem(PRed, NbNonTransp); - Getmem(PGreen, NbNonTransp); - Getmem(PBlue, NbNonTransp); - fillchar({%H-}ColorTab,sizeof(ColorTab),0); - - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - DecodeLazRLE(Str, colorTab[0], 256); - Str.Position:= nextPosition; - - if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then - move(ColorTab[0],colorTab[256], 256) - else - begin - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - DecodeLazRLE(Str, colorTab[256], 256); - Str.Position:= nextPosition; - end; - if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then - move(ColorTab[0],colorTab[512], 256) - else if (channelFlags and LazpaintChannelBlueFromGreen) <> 0 then - move(ColorTab[256],colorTab[512], 256) - else - begin - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - DecodeLazRLE(Str, colorTab[512], 256); - Str.Position:= nextPosition; - end; - - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - DecodeLazRLE(Str, PIndexed^, NbNonTransp); - Str.Position:= nextPosition; - - for n := 0 to NbNonTransp-1 do - begin - index := (PIndexed+n)^; - (PRed+n)^ := colorTab[index]; - (PGreen+n)^ := colorTab[index+256]; - (PBlue+n)^ := colorTab[index+512]; - end; - finally - FreeMem(PIndexed); - end; - end else - begin - Getmem(PRed, NbNonTransp); - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - DecodeLazRLE(Str, PRed^, NbNonTransp); - Str.Position:= nextPosition; - - if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then PGreen := PRed else - begin - Getmem(PGreen, NbNonTransp); - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - DecodeLazRLE(Str, PGreen^, NbNonTransp); - Str.Position:= nextPosition; - end; - - if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then PBlue := PRed else - if (channelFlags and LazPaintChannelBlueFromGreen) <> 0 then PBlue := PGreen else - begin - Getmem(PBlue, NbNonTransp); - channelStreamSize := LEtoN(str.ReadDWord); - nextPosition:= str.Position+channelStreamSize; - DecodeLazRLE(Str, PBlue^, NbNonTransp); - Str.Position:= nextPosition; - end; - end; - end; - - Img.SetSize(w,h); - - if NbNonTransp > 0 then - begin - PCurRed := PRed; - PCurGreen := PGreen; - PCurBlue := PBlue; - PCurAlpha := PAlpha; - - if Img is TBGRACustomBitmap then - begin - If PCurAlpha = nil then - begin - for y := 0 to h-1 do - begin - PDest := TBGRACustomBitmap(Img).ScanLine[y]; - for x := w-1 downto 0 do - begin - PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^); - inc(PCurBlue); - inc(PCurGreen); - inc(PCurRed); - inc(PDest); - end; - end; - end else - for y := 0 to h-1 do - begin - PDest := TBGRACustomBitmap(Img).ScanLine[y]; - for x := w-1 downto 0 do - begin - if PCurAlpha^ = 0 then - PDest^ := BGRAPixelTransparent - else - begin - PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^,PCurAlpha^); - inc(PCurBlue); - inc(PCurGreen); - inc(PCurRed); - end; - inc(PDest); - inc(PCurAlpha); - end; - end; - end else - begin - a := 255; - for y := 0 to h-1 do - for x := 0 to w-1 do - begin - if PCurAlpha <> nil then - begin - a := PCurAlpha^; - inc(PCurAlpha); - end; - if a = 0 then - begin - img.Colors[x,y] := colTransparent; - end else - begin - c.red := PCurRed^ + (PCurRed^ shl 8); - c.green := PCurGreen^ + (PCurGreen^ shl 8); - c.blue := PCurBlue^ + (PCurBlue^ shl 8); - c.alpha := a + (a shl 8); - Img.Colors[x,y] := c; - inc(PCurBlue); - inc(PCurGreen); - inc(PCurRed); - end; - end; - end; - end else - begin - if Img is TBGRACustomBitmap then - TBGRACustomBitmap(Img).FillTransparent else - begin - for y := 0 to h-1 do - for x := 0 to w-1 do - img.Colors[x,y] := colTransparent; - end; - end; - finally - If Assigned(PAlpha) then FreeMem(PAlpha); - if Assigned(PBlue) and (PBlue <> PGreen) and (PBlue <> PRed) then FreeMem(PBlue); - if Assigned(PGreen) and (PGreen <> PRed) then FreeMem(PGreen); - If Assigned(PRed) then FreeMem(PRed); - end; -end; - -initialization - - if DefaultBGRAImageReader[ifLazPaint] = nil then - DefaultBGRAImageReader[ifLazPaint] := TBGRAReaderLazPaint; - -end. diff --git a/components/bgrabitmap/bgrareadpcx.pas b/components/bgrabitmap/bgrareadpcx.pas deleted file mode 100644 index 1f84933..0000000 --- a/components/bgrabitmap/bgrareadpcx.pas +++ /dev/null @@ -1,228 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ This unit provides some optimisations of TFPReaderPCX: decompression using a read buffer. - It also fixes the progress message and the InternalCheck. } - -unit BGRAReadPCX; - -{$mode objfpc}{$H+} - -interface - -uses FPImage, BGRAClasses, SysUtils, FPReadPCX; - -type - - { TBGRAReaderPCX } - - TBGRAReaderPCX = class(TFPReaderPCX) - protected - FBuffer: packed array of byte; - FBufferPos, FBufferSize: integer; - FBufferStream: TStream; - function InternalCheck(Stream: TStream): boolean; override; - procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; - procedure ReadScanLine({%H-}Row: integer; Stream: TStream); override; - procedure WriteScanLine(Row: integer; Img: TFPCustomImage); override; - procedure InitReadBuffer(AStream: TStream; ASize: integer); - procedure CloseReadBuffer; - function GetNextBufferByte: byte; - end; - -implementation - -uses BGRABitmapTypes; - -procedure TBGRAReaderPCX.ReadScanLine(Row: integer; Stream: TStream); -var - P: PByte; - B: UInt32or64; - bytes, Count: UInt32or64; -begin - if FLineSize <= 0 then exit; - P := FScanLine; - bytes := FLineSize; - if Compressed then - begin - while bytes > 0 do - begin - B := GetNextBufferByte; - if (B < $c0) then - Count := 1 - else - begin - Count := B - $c0; - B := GetNextBufferByte; - end; - if Count = 0 then continue else - if Count = 1 then - begin - P^ := B; - Inc(P); - Dec(bytes); - end else - begin - if Count > bytes then Count := bytes; - fillchar(p^, count, B); - Inc(p, count); - dec(bytes, count); - end; - end; - end - else - Stream.ReadBuffer(FScanLine^, FLineSize); -end; - -procedure TBGRAReaderPCX.InternalRead(Stream: TStream; Img: TFPCustomImage); -var - H, Row: integer; - continue: boolean; - emptyRect: TRect; -begin - emptyRect := rect(0,0,0,0); - continue := True; - Progress(psStarting, 0, False, emptyRect, '', continue); - Stream.Read(Header, SizeOf(Header)); - AnalyzeHeader(Img); - case BytesPerPixel of - 1: CreateBWPalette(Img); - 4: CreatePalette16(Img); - 8: ReadPalette(stream, Img); - else - if (Header.PaletteType = 2) then - CreateGrayPalette(Img); - end; - H := Img.Height; - if Compressed then InitReadBuffer(Stream,2048); - for Row := 0 to H - 1 do - begin - ReadScanLine(Row, Stream); - WriteScanLine(Row, Img); - Progress(psRunning, (Row+1) div H, False, emptyRect, '', continue); - end; - if Compressed then CloseReadBuffer; - Progress(psEnding, 100, False, emptyRect, '', continue); - freemem(FScanLine); -end; - -procedure TBGRAReaderPCX.WriteScanLine(Row: integer; Img: TFPCustomImage); -var - Col: integer; - C: TFPColor; - P, P1, P2, P3: PByte; - Z2: word; - color: byte; -begin - C.Alpha := AlphaOpaque; - P := FScanLine; - Z2 := Header.BytesPerLine; - begin - case BytesPerPixel of - 1: - begin - for Col := 0 to Img.Width - 1 do - begin - if (P[col div 8] and (128 shr (col mod 8))) <> 0 then - Img.Colors[Col, Row] := Img.Palette[1] - else - Img.Colors[Col, Row] := Img.Palette[0]; - end; - end; - 4: - begin - P1 := P; - Inc(P1, Z2); - P2 := P; - Inc(P2, Z2 * 2); - P3 := P; - Inc(P3, Z2 * 3); - for Col := 0 to Img.Width - 1 do - begin - color := 0; - if (P[col div 8] and (128 shr (col mod 8))) <> 0 then - Inc(color, 1); - if (P1[col div 8] and (128 shr (col mod 8))) <> 0 then - Inc(color, 1 shl 1); - if (P2[col div 8] and (128 shr (col mod 8))) <> 0 then - Inc(color, 1 shl 2); - if (P3[col div 8] and (128 shr (col mod 8))) <> 0 then - Inc(color, 1 shl 3); - Img.Colors[Col, Row] := Img.Palette[color]; - end; - end; - 8: - begin - for Col := 0 to Img.Width - 1 do - begin - Img.Colors[Col, Row] := Img.Palette[P[Col]]; - end; - end; - 24: - begin - for Col := 0 to Img.Width - 1 do - begin - with C do - begin - Red := P[col] or (P[col] shl 8); - Blue := P[col + Z2 * 2] or (P[col + Z2 * 2] shl 8); - Green := P[col + Z2] or (P[col + Z2] shl 8); - Alpha := alphaOpaque; - end; - Img[col, row] := C; - end; - end; - end; - end; -end; - -procedure TBGRAReaderPCX.InitReadBuffer(AStream: TStream; ASize: integer); -begin - setLength(FBuffer,ASize); - FBufferSize := AStream.Read(FBuffer[0],ASize); - FBufferPos := 0; - FBufferStream := AStream; -end; - -procedure TBGRAReaderPCX.CloseReadBuffer; -begin - FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos; -end; - -function TBGRAReaderPCX.GetNextBufferByte: byte; -begin - if FBufferPos < FBufferSize then - begin - result := FBuffer[FBufferPos]; - inc(FBufferPos); - end else - if FBufferSize = 0 then - result := 0 - else - begin - FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer)); - FBufferPos := 0; - if FBufferPos < FBufferSize then - begin - result := FBuffer[FBufferPos]; - inc(FBufferPos); - end else - result := 0; - end; -end; - -function TBGRAReaderPCX.InternalCheck({%H-}Stream: TStream): boolean; -var - {%H-}magic: packed array[0..3] of byte; - oldPos: Int64; -begin - oldPos:= stream.Position; - result := stream.Read({%H-}magic,SizeOf(magic)) = sizeof(magic); - stream.Position:= oldPos; - if result then - result := (magic[0] in[$0a,$0c,$cd]) and (magic[1] in [0,2,3,4,5]) and (magic[2] in[0,1]) and (magic[3] in[1,2,4,8]) -end; - -initialization - - DefaultBGRAImageReader[ifPcx] := TBGRAReaderPCX; - -end. diff --git a/components/bgrabitmap/bgrareadpng.pas b/components/bgrabitmap/bgrareadpng.pas deleted file mode 100644 index a65c61f..0000000 --- a/components/bgrabitmap/bgrareadpng.pas +++ /dev/null @@ -1,1452 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - This file is originally part of the Free Pascal run time library. - Copyright (c) 2003 by the Free Pascal development team - - PNG reader implementation modified by circular. - - ********************************************************************** - - Optimisations applied: - - using "const" parameter for TColorData - - direct pixel access with TBGRABitmap when possible - - some fixes of hints and of initializations - - vertical shrink option with MinifyHeight, OriginalHeight and VerticalShrinkFactor (useful for thumbnails) - } -{$mode objfpc}{$h+} -unit BGRAReadPng; - -interface - -uses - SysUtils,BGRAClasses, FPImage, FPImgCmn, PNGComn, ZStream, BGRABitmapTypes; - -Type - - TSetPixelProc = procedure (x,y:integer; const CD : TColordata) of object; - TConvertColorProc = function (const CD:TColorData) : TFPColor of object; - TBGRAConvertColorProc = function (const CD:TColorData) : TBGRAPixel of object; - THandleScanLineProc = procedure (const y : integer; const ScanLine : PByteArray) of object; - - { TBGRAReaderPNG } - - TBGRAReaderPNG = class (TBGRAImageReader) - private - FHeader : THeaderChunk; - ZData : TMemoryStream; // holds compressed data until all blocks are read - Decompress : TDeCompressionStream; // decompresses the data - FPltte : boolean; // if palette is used - FCountScanlines : EightLong; //Number of scanlines to process for each pass - FScanLineLength : EightLong; //Length of scanline for each pass - FCurrentPass : byte; - ByteWidth : byte; // number of bytes to read for pixel information - BitsUsed : EightLong; // bitmasks to use to split a byte into smaller parts - BitShift : byte; // shift right to do of the bits extracted with BitsUsed for 1 element - CountBitsUsed : byte; // number of bit groups (1 pixel) per byte (when bytewidth = 1) - //CFmt : TColorFormat; // format of the colors to convert from - StartX,StartY, DeltaX,DeltaY, StartPass,EndPass : integer; // number and format of passes - FPalette : TFPPalette; - FSetPixel : TSetPixelProc; - FConvertColor : TConvertColorProc; - FBGRAConvertColor : TBGRAConvertColorProc; - FHandleScanLine: THandleScanLineProc; - FVerticalShrinkMask: LongWord; - FVerticalShrinkShr: Integer; - FGammaCorrection: single; - FGammaCorrectionTable: packed array of word; - FGammaCorrectionTableComputed: boolean; - function GetOriginalHeight: integer; - function GetOriginalWidth: integer; - function GetVerticalShrinkFactor: integer; - function ReadChunk: boolean; - procedure HandleData; - procedure HandleUnknown; - function ColorGray1 (const CD:TColorData) : TFPColor; - function ColorGray2 (const CD:TColorData) : TFPColor; - function ColorGray4 (const CD:TColorData) : TFPColor; - function ColorGray8 (const CD:TColorData) : TFPColor; - function ColorGray16 (const CD:TColorData) : TFPColor; - function ColorGrayAlpha8 (const CD:TColorData) : TFPColor; - function ColorGrayAlpha16 (const CD:TColorData) : TFPColor; - function ColorColor8 (const CD:TColorData) : TFPColor; - function ColorColor16 (const CD:TColorData) : TFPColor; - function ColorColorAlpha8 (const CD:TColorData) : TFPColor; - function ColorColorAlpha16 (const CD:TColorData) : TFPColor; - function CheckGammaCorrection: boolean; - procedure ApplyGammaCorrection(var AColor: TFPColor); - - function BGRAColorGray1 (const CD:TColorData) : TBGRAPixel; - function BGRAColorGray2 (const CD:TColorData) : TBGRAPixel; - function BGRAColorGray4 (const CD:TColorData) : TBGRAPixel; - function BGRAColorGray8 (const CD:TColorData) : TBGRAPixel; - function BGRAColorGray16 (const CD:TColorData) : TBGRAPixel; - function BGRAColorGrayAlpha8 (const CD:TColorData) : TBGRAPixel; - function BGRAColorGrayAlpha16 (const CD:TColorData) : TBGRAPixel; - function BGRAColorColor8 (const CD:TColorData) : TBGRAPixel; - function BGRAColorColor16 (const CD:TColorData) : TBGRAPixel; - function BGRAColorColorAlpha8 (const CD:TColorData) : TBGRAPixel; - function BGRAColorColorAlpha16 (const CD:TColorData) : TBGRAPixel; - protected - Chunk : TChunk; - UseTransparent, EndOfFile : boolean; - TransparentDataValue : TColorData; - UsingBitGroup : byte; - DataIndex : LongWord; - DataBytes : TColorData; - procedure HandleChunk; virtual; - procedure HandlePalette; virtual; - procedure HandleAlpha; virtual; - procedure HandleStdRGB; virtual; - procedure HandleGamma; virtual; - function CalcX (relX:integer) : integer; - function CalcY (relY:integer) : integer; - function CalcColor(const ScanLine : PByteArray): TColorData; - procedure HandleScanLine (const y : integer; const ScanLine : PByteArray); virtual; - procedure BGRAHandleScanLine(const y: integer; const ScanLine: PByteArray); - procedure BGRAHandleScanLineTr(const y: integer; const ScanLine: PByteArray); - procedure DoDecompress; virtual; - procedure SetPalettePixel (x,y:integer; const CD : TColordata); - procedure SetPalColPixel (x,y:integer; const CD : TColordata); - procedure SetColorPixel (x,y:integer; const CD : TColordata); - procedure SetColorTrPixel (x,y:integer; const CD : TColordata); - procedure SetBGRAColorPixel (x,y:integer; const CD : TColordata); - procedure SetBGRAColorTrPixel (x,y:integer; const CD : TColordata); - function DecideSetPixel : TSetPixelProc; virtual; - procedure InternalRead ({%H-}Str:TStream; Img:TFPCustomImage); override; - function InternalCheck (Str:TStream) : boolean; override; - //property ColorFormat : TColorformat read CFmt; - property ConvertColor : TConvertColorProc read FConvertColor; - property CurrentPass : byte read FCurrentPass; - property Pltte : boolean read FPltte; - property ThePalette : TFPPalette read FPalette; - property Header : THeaderChunk read FHeader; - property CountScanlines : EightLong read FCountScanlines; - property ScanLineLength : EightLong read FScanLineLength; - public - MinifyHeight: integer; - constructor create; override; - destructor destroy; override; - property VerticalShrinkFactor: integer read GetVerticalShrinkFactor; - property OriginalWidth: integer read GetOriginalWidth; - property OriginalHeight: integer read GetOriginalHeight; - function GetQuickInfo(AStream: TStream): TQuickImageInfo; override; - function GetBitmapDraft(AStream: TStream; {%H-}AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override; - end; - -implementation - -uses math; - -const StartPoints : array[0..7, 0..1] of word = - ((0,0),(0,0),(4,0),(0,4),(2,0),(0,2),(1,0),(0,1)); - Delta : array[0..7,0..1] of word = - ((1,1),(8,8),(8,8),(4,8),(4,4),(2,4),(2,2),(1,2)); - BitsUsed1Depth : EightLong = ($80,$40,$20,$10,$08,$04,$02,$01); - BitsUsed2Depth : EightLong = ($C0,$30,$0C,$03,0,0,0,0); - BitsUsed4Depth : EightLong = ($F0,$0F,0,0,0,0,0,0); - -constructor TBGRAReaderPNG.create; -begin - inherited; - chunk.acapacity := 0; - chunk.data := nil; - UseTransparent := False; -end; - -destructor TBGRAReaderPNG.destroy; -begin - with chunk do - if acapacity > 0 then - freemem (data); - inherited; -end; - -function TBGRAReaderPNG.GetQuickInfo(AStream: TStream): TQuickImageInfo; -const headerChunkSize = 13; -var - {%H-}FileHeader : packed array[0..7] of byte; - {%H-}ChunkHeader : TChunkHeader; - {%H-}HeaderChunk : THeaderChunk; -begin - {$PUSH}{$HINTS OFF}fillchar({%H-}result, sizeof({%H-}result), 0);{$POP} - if AStream.Read({%H-}FileHeader, sizeof(FileHeader))<> sizeof(FileHeader) then exit; - if QWord(FileHeader) <> QWord(PNGComn.Signature) then exit; - if AStream.Read({%H-}ChunkHeader, sizeof(ChunkHeader))<> sizeof(ChunkHeader) then exit; - if ChunkHeader.CType <> ChunkTypes[ctIHDR] then exit; - if BEtoN(ChunkHeader.CLength) < headerChunkSize then exit; - if AStream.Read({%H-}HeaderChunk, headerChunkSize) <> headerChunkSize then exit; - result.width:= BEtoN(HeaderChunk.Width); - result.height:= BEtoN(HeaderChunk.height); - case HeaderChunk.ColorType and 3 of - 0,3: {grayscale, palette} - if HeaderChunk.BitDepth > 8 then - result.colorDepth := 8 - else - result.colorDepth := HeaderChunk.BitDepth; - - 2: {color} result.colorDepth := HeaderChunk.BitDepth*3; - end; - if (HeaderChunk.ColorType and 4) = 4 then - result.alphaDepth := HeaderChunk.BitDepth - else - result.alphaDepth := 0; -end; - -function TBGRAReaderPNG.GetBitmapDraft(AStream: TStream; AMaxWidth, - AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap; -var - png: TBGRAReaderPNG; -begin - png:= TBGRAReaderPNG.Create; - result := BGRABitmapFactory.Create; - try - png.MinifyHeight := AMaxHeight; - result.LoadFromStream(AStream, png); - AOriginalWidth:= result.Width; - AOriginalHeight:= png.OriginalHeight; - finally - png.Free; - end; -end; - -function TBGRAReaderPNG.ReadChunk: boolean; -var {%H-}ChunkHeader : TChunkHeader; - readCRC : LongWord; - l : LongWord; -begin - TheStream.Read ({%H-}ChunkHeader,sizeof(ChunkHeader)); - with chunk do - begin - // chunk header - with ChunkHeader do - begin - {$IFDEF ENDIAN_LITTLE} - alength := swap(CLength); - {$ELSE} - alength := CLength; - {$ENDIF} - ReadType := CType; - end; - aType := low(TChunkTypes); - while (aType < high(TChunkTypes)) and (ChunkTypes[aType] <> ReadType) do - inc (aType); - if alength > MaxChunkLength then - raise PNGImageException.Create ('Invalid chunklength'); - if alength > acapacity then - begin - if acapacity > 0 then - freemem (data); - GetMem (data, alength); - acapacity := alength; - end; - l := TheStream.read (data^, alength); - if l <> alength then - raise PNGImageException.Create ('Chunk length exceeds stream length'); - readCRC := 0; - TheStream.Read (readCRC, sizeof(ReadCRC)); - l := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType)); - l := CalculateCRC (l, data^, alength); - {$IFDEF ENDIAN_LITTLE} - l := swap(l xor All1Bits); - {$ELSE} - l := l xor All1Bits; - {$ENDIF} - if ReadCRC <> l then - begin - //if chunk is essential, then raise an error - if ReadType[0] = upcase(ReadType[0]) then - raise PNGImageException.Create ('CRC check failed') - else - result := false; - end - else result := true; - end; -end; - -function TBGRAReaderPNG.GetVerticalShrinkFactor: integer; -begin - result := 1 shl FVerticalShrinkShr; -end; - -function TBGRAReaderPNG.GetOriginalHeight: integer; -begin - result := Header.height; -end; - -function TBGRAReaderPNG.GetOriginalWidth: integer; -begin - result := header.Width; -end; - -procedure TBGRAReaderPNG.HandleData; -var OldSize : LongWord; -begin - OldSize := ZData.size; - ZData.Size := OldSize; - ZData.Size := ZData.Size + Chunk.aLength; - ZData.Write (chunk.Data^, chunk.aLength); -end; - -procedure TBGRAReaderPNG.HandleAlpha; - procedure PaletteAlpha; - var r : integer; - a : word; - c : TFPColor; - begin - with chunk do - begin - if alength > LongWord(ThePalette.count) then - raise PNGImageException.create ('To much alpha values for palette'); - for r := 0 to alength-1 do - begin - c := ThePalette[r]; - a := data^[r]; - c.alpha := (a shl 8) + a; - ThePalette[r] := c; - end; - end; - end; - procedure TransparentGray; - var {%H-}a : word; - begin - move (chunk.data^[0], {%H-}a, 2); - {$IFDEF ENDIAN_LITTLE} - a := swap (a); - {$ENDIF} - TransparentDataValue := a; - UseTransparent := True; - end; - procedure TransparentColor; - var d : byte; - {%H-}r,{%H-}g,{%H-}b : word; - a : TColorData; - begin - with chunk do - begin - move (data^[0], {%H-}r, 2); - move (data^[2], {%H-}g, 2); - move (data^[4], {%H-}b, 2); - end; - {$IFDEF ENDIAN_LITTLE} - r := swap (r); - g := swap (g); - b := swap (b); - {$ENDIF} - d := header.bitdepth; - a := (TColorData(b) shl d) shl d; - a := a + (TColorData(g) shl d) + r; - TransparentDataValue := a; - UseTransparent := True; - end; -begin - case header.ColorType of - 3 : PaletteAlpha; - 0 : TransparentGray; - 2 : TransparentColor; - end; -end; - -procedure TBGRAReaderPNG.HandleStdRGB; -begin - FGammaCorrection:= 1; - FGammaCorrectionTableComputed:= false; -end; - -procedure TBGRAReaderPNG.HandleGamma; -var - invGammaInt: Longword; -begin - invGammaInt := BEtoN(PLongword(chunk.data)^); - FGammaCorrection:= invGammaInt/45455; { 1/2.2 is default } - FGammaCorrectionTableComputed:= false; -end; - -procedure TBGRAReaderPNG.HandlePalette; -var r : LongWord; - c : TFPColor; - t : word; -begin - if header.colortype = 3 then - with chunk do - begin - if TheImage.UsePalette then - FPalette := TheImage.Palette - else - FPalette := TFPPalette.Create(0); - c.Alpha := AlphaOpaque; - if (aLength mod 3) > 0 then - raise PNGImageException.Create ('Impossible length for PLTE-chunk'); - r := 0; - ThePalette.count := 0; - while r < alength do - begin - t := data^[r]; - c.red := t + (t shl 8); - inc (r); - t := data^[r]; - c.green := t + (t shl 8); - inc (r); - t := data^[r]; - c.blue := t + (t shl 8); - inc (r); - ApplyGammaCorrection(c); - ThePalette.Add (c); - end; - end; -end; - -procedure TBGRAReaderPNG.SetPalettePixel (x,y:integer; const CD : TColordata); -begin // both PNG and Img have palette - TheImage.Pixels[x,y] := CD; -end; - -procedure TBGRAReaderPNG.SetPalColPixel (x,y:integer; const CD : TColordata); -begin // PNG with palette, Img without - TheImage.Colors[x,y] := ThePalette[CD]; -end; - -procedure TBGRAReaderPNG.SetColorPixel (x,y:integer; const CD : TColordata); -var c : TFPColor; -begin // both PNG and Img work without palette, and no transparency colordata - // c := ConvertColor (CD,CFmt); - c := ConvertColor (CD); - ApplyGammaCorrection(c); - TheImage.Colors[x,y] := c; -end; - -procedure TBGRAReaderPNG.SetColorTrPixel (x,y:integer; const CD : TColordata); -var c : TFPColor; -begin // both PNG and Img work without palette, and there is a transparency colordata - //c := ConvertColor (CD,CFmt); - c := ConvertColor (CD); - ApplyGammaCorrection(c); - if TransparentDataValue = CD then - c.alpha := alphaTransparent; - TheImage.Colors[x,y] := c; -end; - -procedure TBGRAReaderPNG.SetBGRAColorPixel(x, y: integer; const CD: TColordata); -var c: TBGRAPixel; -begin - c := FBGRAConvertColor(CD); - if c.alpha = 0 then TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent) - else TBGRACustomBitmap(TheImage).SetPixel(x,y,c); -end; - -procedure TBGRAReaderPNG.SetBGRAColorTrPixel(x, y: integer; const CD: TColordata); -var c: TBGRAPixel; -begin - if TransparentDataValue = CD then - TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent) else - begin - c := FBGRAConvertColor(CD); - if c.alpha = 0 then TBGRACustomBitmap(TheImage).SetPixel(x,y,BGRAPixelTransparent) - else TBGRACustomBitmap(TheImage).SetPixel(x,y,c); - end; -end; - -function TBGRAReaderPNG.DecideSetPixel : TSetPixelProc; -begin - if Pltte then - if TheImage.UsePalette then - result := @SetPalettePixel - else - result := @SetPalColPixel - else - if UseTransparent then - begin - if TheImage is TBGRACustomBitmap then - result := @SetBGRAColorTrPixel - else - result := @SetColorTrPixel - end - else - begin - if TheImage is TBGRACustomBitmap then - result := @SetBGRAColorPixel - else - result := @SetColorPixel - end; -end; - -function TBGRAReaderPNG.CalcX (relX:integer) : integer; -begin - result := StartX + (relX * deltaX); -end; - -function TBGRAReaderPNG.CalcY (relY:integer) : integer; -begin - result := StartY + (relY * deltaY); -end; - -function TBGRAReaderPNG.CalcColor(const ScanLine : PByteArray): TColorData; -var cd : LongWord; - r : word; - p : pbyte; -begin - if UsingBitGroup = 0 then - begin - Databytes := 0; - if Header.BitDepth = 16 then - begin - p := @Databytes; - for r:=0 to bytewidth shr 1 - 1 do - begin - p^ := ScanLine^[Dataindex+(r shl 1)+1]; - (p+1)^ := ScanLine^[Dataindex+(r shl 1)]; - inc(p,2); - end; - end - else move (ScanLine^[DataIndex], Databytes, bytewidth); - {$IFDEF ENDIAN_BIG} - Databytes:=swap(Databytes); - {$ENDIF} - inc (DataIndex,bytewidth); - end; - if bytewidth = 1 then - begin - cd := (Databytes and BitsUsed[UsingBitGroup]); - result := cd shr ((CountBitsUsed-UsingBitGroup-1) * BitShift); - inc (UsingBitgroup); - if UsingBitGroup >= CountBitsUsed then - UsingBitGroup := 0; - end - else - result := Databytes; -end; - -procedure TBGRAReaderPNG.HandleScanLine (const y : integer; const ScanLine : PByteArray); -var x, rx : integer; - c : TColorData; -begin - UsingBitGroup := 0; - DataIndex := 0; - X := StartX; - if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then - case ByteWidth of - 1: if BitsUsed[0] = $ff then - begin - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - FSetPixel (x,y,ScanLine^[DataIndex]); - Inc(X, deltaX); - inc(DataIndex); - end; - exit; - end; - 2: begin - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - {$IFDEF ENDIAN_BIG} - FSetPixel (x,y,swap(PWord(@ScanLine^[DataIndex])^)); - {$ELSE} - FSetPixel (x,y,PWord(@ScanLine^[DataIndex])^); - {$ENDIF} - Inc(X, deltaX); - inc(DataIndex,2); - end; - exit; - end; - 4: begin - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - {$IFDEF ENDIAN_BIG} - FSetPixel (x,y,swap(PLongWord(@ScanLine^[DataIndex])^)); - {$ELSE} - FSetPixel (x,y,PLongWord(@ScanLine^[DataIndex])^); - {$ENDIF} - Inc(X, deltaX); - inc(DataIndex,4); - end; - exit; - end; - 8: begin - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - {$IFDEF ENDIAN_BIG} - FSetPixel (x,y,swap(PQWord(@ScanLine^[DataIndex])^)); - {$ELSE} - FSetPixel (x,y,PQWord(@ScanLine^[DataIndex])^); - {$ENDIF} - Inc(X, deltaX); - inc(DataIndex,8); - end; - exit; - end; - end; - - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - c := CalcColor(ScanLine); - FSetPixel (x,y,c); - Inc(X, deltaX); - end -end; - -procedure TBGRAReaderPNG.BGRAHandleScanLine (const y : integer; const ScanLine : PByteArray); -var rx : integer; - pdest: PBGRAPixel; -begin - UsingBitGroup := 0; - DataIndex := 0; - {$PUSH}{$RANGECHECKS OFF} //because PByteArray is limited to 32767 - if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then - case ByteWidth of - 1: if BitsUsed[0] = $ff then - begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - pdest^ := FBGRAConvertColor(ScanLine^[DataIndex]); - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - Inc(pdest, deltaX); - inc(DataIndex); - end; - exit; - end; - 2: begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - pdest^ := FBGRAConvertColor( - {$IFDEF ENDIAN_BIG} - swap(PWord(@ScanLine^[DataIndex])^) - {$ELSE} - PWord(@ScanLine^[DataIndex])^ - {$ENDIF} ); - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - Inc(pdest, deltaX); - inc(DataIndex,2); - end; - exit; - end; - 3: begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - pdest^.red := ScanLine^[DataIndex]; - pdest^.green := ScanLine^[DataIndex+1]; - pdest^.blue := ScanLine^[DataIndex+2]; - pdest^.alpha := 255; - Inc(pdest, deltaX); - inc(DataIndex, 3); - end; - exit; - end; - 4: begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - pdest^ := FBGRAConvertColor( - {$IFDEF ENDIAN_BIG} - swap(PLongWord(@ScanLine^[DataIndex])^) - {$ELSE} - PLongWord(@ScanLine^[DataIndex])^ - {$ENDIF} ); - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - Inc(pdest, deltaX); - inc(DataIndex,4); - end; - exit; - end; - end; - {$POP} - - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - pdest^ := FBGRAConvertColor(CalcColor(ScanLine)); - Inc(pdest, deltaX); - end -end; - -procedure TBGRAReaderPNG.BGRAHandleScanLineTr(const y: integer; - const ScanLine: PByteArray); -var rx : integer; - c : TColorData; - pdest: PBGRAPixel; -begin - UsingBitGroup := 0; - DataIndex := 0; - if (UsingBitGroup = 0) and (Header.BitDepth <> 16) then - case ByteWidth of - 1: if BitsUsed[0] = $ff then - begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - c := ScanLine^[DataIndex]; - if c = TransparentDataValue then - pdest^ := BGRAPixelTransparent else - begin - pdest^ := FBGRAConvertColor(c); - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - end; - Inc(pdest, deltaX); - inc(DataIndex); - end; - exit; - end; - 2: begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - c := - {$IFDEF ENDIAN_BIG} - swap(PWord(@ScanLine^[DataIndex])^) - {$ELSE} - PWord(@ScanLine^[DataIndex])^ - {$ENDIF} ; - if c = TransparentDataValue then - pdest^ := BGRAPixelTransparent else - begin - pdest^ := FBGRAConvertColor(c); - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - end; - Inc(pdest, deltaX); - inc(DataIndex,2); - end; - exit; - end; - 4: begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - c := - {$IFDEF ENDIAN_BIG} - swap(PLongWord(@ScanLine^[DataIndex])^) - {$ELSE} - PLongWord(@ScanLine^[DataIndex])^ - {$ENDIF} ; - if c = TransparentDataValue then - pdest^ := BGRAPixelTransparent else - begin - pdest^ := FBGRAConvertColor(c); - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - end; - Inc(pdest, deltaX); - inc(DataIndex,4); - end; - exit; - end; - 8: begin - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - c := - {$IFDEF ENDIAN_BIG} - swap(PQWord(@ScanLine^[DataIndex])^) - {$ELSE} - PQWord(@ScanLine^[DataIndex])^ - {$ENDIF} ; - if c = TransparentDataValue then - pdest^ := BGRAPixelTransparent else - begin - pdest^ := FBGRAConvertColor(c); - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - end; - Inc(pdest, deltaX); - inc(DataIndex,8); - end; - exit; - end; - end; - - pdest := TBGRACustomBitmap(TheImage).ScanLine[y]+StartX; - for rx := 0 to ScanlineLength[CurrentPass]-1 do - begin - c := CalcColor(ScanLine); - if c = TransparentDataValue then - pdest^ := BGRAPixelTransparent - else pdest^ := FBGRAConvertColor(c); - Inc(pdest, deltaX); - end -end; - -function TBGRAReaderPNG.ColorGray1(const CD: TColorData): TFPColor; -begin - if CD = 0 then - result := colBlack - else - result := colWhite; -end; - -function TBGRAReaderPNG.ColorGray2(const CD: TColorData): TFPColor; -var c : UInt32or64; -begin - c := CD and 3; - c := c + (c shl 2); - c := c + (c shl 4); - c := c + (c shl 8); - with result do - begin - red := c; - green := c; - blue := c; - alpha := alphaOpaque; - end; -end; - -function TBGRAReaderPNG.ColorGray4(const CD: TColorData): TFPColor; -var c : UInt32or64; -begin - c := CD and $F; - c := c + (c shl 4); - c := c + (c shl 8); - with result do - begin - red := c; - green := c; - blue := c; - alpha := alphaOpaque; - end; -end; - -function TBGRAReaderPNG.ColorGray8(const CD: TColorData): TFPColor; -var c : UInt32or64; -begin - c := CD and $FF; - c := c + (c shl 8); - with result do - begin - red := c; - green := c; - blue := c; - alpha := alphaOpaque; - end; -end; - -function TBGRAReaderPNG.ColorGray16(const CD: TColorData): TFPColor; -var c : UInt32or64; -begin - c := CD and $FFFF; - with result do - begin - red := c; - green := c; - blue := c; - alpha := alphaOpaque; - end; -end; - -function TBGRAReaderPNG.ColorGrayAlpha8 (const CD:TColorData) : TFPColor; -var c : UInt32or64; -begin - c := CD and $00FF; - c := c + (c shl 8); - with result do - begin - red := c; - green := c; - blue := c; - c := CD and $FF00; - alpha := c + (c shr 8); - end; -end; - -function TBGRAReaderPNG.ColorGrayAlpha16 (const CD:TColorData) : TFPColor; -var c : UInt32or64; -begin - c := CD and $FFFF; - with result do - begin - red := c; - green := c; - blue := c; - alpha := (CD shr 16) and $FFFF; - end; -end; - -function TBGRAReaderPNG.ColorColor8 (const CD:TColorData) : TFPColor; -var c : UInt32or64; -begin - with result do - begin - c := CD and $FF; - red := c + (c shl 8); - c := (CD shr 8) and $FF; - green := c + (c shl 8); - c := (CD shr 16) and $FF; - blue := c + (c shl 8); - alpha := alphaOpaque; - end; -end; - -function TBGRAReaderPNG.ColorColor16 (const CD:TColorData) : TFPColor; -begin - with result do - begin - red := CD and $FFFF; - green := (CD shr 16) and $FFFF; - blue := (CD shr 32) and $FFFF; - alpha := alphaOpaque; - end; -end; - -function TBGRAReaderPNG.ColorColorAlpha8 (const CD:TColorData) : TFPColor; -var c : UInt32or64; -begin - with result do - begin - c := CD and $FF; - red := c + (c shl 8); - c := (CD shr 8) and $FF; - green := c + (c shl 8); - c := (CD shr 16) and $FF; - blue := c + (c shl 8); - c := (CD shr 24) and $FF; - alpha := c + (c shl 8); - end; -end; - -function TBGRAReaderPNG.ColorColorAlpha16 (const CD:TColorData) : TFPColor; -begin - with result do - begin - red := CD and $FFFF; - green := (CD shr 16) and $FFFF; - blue := (CD shr 32) and $FFFF; - alpha := (CD shr 48) and $FFFF; - end; -end; - -function TBGRAReaderPNG.CheckGammaCorrection: boolean; -var - i: Integer; -begin - if not FGammaCorrectionTableComputed then - begin - if abs(FGammaCorrection-1) < 0.01 then - begin - FGammaCorrectionTable := nil; - end else - begin - setlength(FGammaCorrectionTable, 65536); - FGammaCorrectionTable[0] := 0; - i := 1; - while i <= 65535 do - begin - if i+3 <= 65535 then - begin - FGammaCorrectionTable[i+3] := Round(Power((i+3)/65535, FGammaCorrection)*65535); - FGammaCorrectionTable[i] := (FGammaCorrectionTable[i-1]*3+FGammaCorrectionTable[i+3]+2) shr 2; - FGammaCorrectionTable[i+1] := (FGammaCorrectionTable[i-1]+FGammaCorrectionTable[i+3]+1) shr 1; - FGammaCorrectionTable[i+2] := (FGammaCorrectionTable[i-1]+FGammaCorrectionTable[i+3]*3+2) shr 2; - inc(i,4); - end else - begin - FGammaCorrectionTable[i] := Round(Power(i/65535, FGammaCorrection)*65535); - inc(i); - end; - end; - end; - FGammaCorrectionTableComputed:= true; - end; - result := FGammaCorrectionTable<>nil; -end; - -procedure TBGRAReaderPNG.ApplyGammaCorrection(var AColor: TFPColor); -begin - if FGammaCorrectionTable<>nil then - begin - AColor.red := FGammaCorrectionTable[AColor.red]; - AColor.green := FGammaCorrectionTable[AColor.green]; - AColor.blue := FGammaCorrectionTable[AColor.blue]; - end; -end; - -function TBGRAReaderPNG.BGRAColorGray1(const CD: TColorData): TBGRAPixel; -begin - if CD = 0 then - result := BGRABlack - else - result := BGRAWhite; -end; - -function TBGRAReaderPNG.BGRAColorGray2(const CD: TColorData): TBGRAPixel; -var c : UInt32or64; -begin - c := CD and 3; - c := c + (c shl 2); - c := c + (c shl 4); - result := BGRA(c,c,c); -end; - -function TBGRAReaderPNG.BGRAColorGray4(const CD: TColorData): TBGRAPixel; -var c : UInt32or64; -begin - c := CD and $F; - c := c + (c shl 4); - result := BGRA(c,c,c); -end; - -function TBGRAReaderPNG.BGRAColorGray8(const CD: TColorData): TBGRAPixel; -var c : UInt32or64; -begin - c := CD and $FF; - result := BGRA(c,c,c); -end; - -function TBGRAReaderPNG.BGRAColorGray16(const CD: TColorData): TBGRAPixel; -var c : UInt32or64; -begin - c := (CD shr 8) and $FF; - result := BGRA(c,c,c); -end; - -function TBGRAReaderPNG.BGRAColorGrayAlpha8(const CD: TColorData): TBGRAPixel; -var c : UInt32or64; -begin - c := CD and $00FF; - result := BGRA(c,c,c,(CD shr 8) and $FF); -end; - -function TBGRAReaderPNG.BGRAColorGrayAlpha16(const CD: TColorData): TBGRAPixel; -var c : UInt32or64; -begin - c := (CD shr 8) and $FF; - result := BGRA(c,c,c,(CD shr 24) and $FF); -end; - -function TBGRAReaderPNG.BGRAColorColor8(const CD: TColorData): TBGRAPixel; -var temp: LongWord; -begin - temp := CD; - result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff); -end; - -function TBGRAReaderPNG.BGRAColorColor16(const CD: TColorData): TBGRAPixel; -begin - result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF); -end; - -function TBGRAReaderPNG.BGRAColorColorAlpha8(const CD: TColorData): TBGRAPixel; -var temp: LongWord; -begin - temp := CD; - result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff, temp shr 24); -end; - -function TBGRAReaderPNG.BGRAColorColorAlpha16(const CD: TColorData): TBGRAPixel; -begin - result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF, CD shr 56); -end; - -procedure TBGRAReaderPNG.DoDecompress; - - procedure initVars; - var r,d : integer; - begin - with Header do - begin - if interlace=0 then - begin - StartPass := 0; - EndPass := 0; - FCountScanlines[0] := Height; - FScanLineLength[0] := Width; - end - else - begin - StartPass := 1; - EndPass := 7; - for r := 1 to 7 do - begin - d := Height div delta[r,1]; - if (height mod delta[r,1]) > startpoints[r,1] then - inc (d); - FCountScanlines[r] := d; - d := width div delta[r,0]; - if (width mod delta[r,0]) > startpoints[r,0] then - inc (d); - FScanLineLength[r] := d; - end; - end; - Fpltte := (ColorType = 3); - case colortype of - 0 : case Bitdepth of - 1 : begin - FConvertColor := @ColorGray1; //CFmt := cfMono; - FBGRAConvertColor := @BGRAColorGray1; //CFmt := cfMono; - ByteWidth := 1; - end; - 2 : begin - FConvertColor := @ColorGray2; //CFmt := cfGray2; - FBGRAConvertColor := @BGRAColorGray2; //CFmt := cfGray2; - ByteWidth := 1; - end; - 4 : begin - FConvertColor := @ColorGray4; //CFmt := cfGray4; - FBGRAConvertColor := @BGRAColorGray4; //CFmt := cfGray4; - ByteWidth := 1; - end; - 8 : begin - FConvertColor := @ColorGray8; //CFmt := cfGray8; - FBGRAConvertColor := @BGRAColorGray8; //CFmt := cfGray8; - ByteWidth := 1; - end; - 16 : begin - FConvertColor := @ColorGray16; //CFmt := cfGray16; - FBGRAConvertColor := @BGRAColorGray16; //CFmt := cfGray16; - ByteWidth := 2; - end; - end; - 2 : if BitDepth = 8 then - begin - FConvertColor := @ColorColor8; //CFmt := cfBGR24 - FBGRAConvertColor := @BGRAColorColor8; //CFmt := cfBGR24 - ByteWidth := 3; - end - else - begin - FConvertColor := @ColorColor16; //CFmt := cfBGR48; - FBGRAConvertColor := @BGRAColorColor16; //CFmt := cfBGR48; - ByteWidth := 6; - end; - 3 : if BitDepth = 16 then - ByteWidth := 2 - else - ByteWidth := 1; - 4 : if BitDepth = 8 then - begin - FConvertColor := @ColorGrayAlpha8; //CFmt := cfGrayA16 - FBGRAConvertColor := @BGRAColorGrayAlpha8; //CFmt := cfGrayA16 - ByteWidth := 2; - end - else - begin - FConvertColor := @ColorGrayAlpha16; //CFmt := cfGrayA32; - FBGRAConvertColor := @BGRAColorGrayAlpha16; //CFmt := cfGrayA32; - ByteWidth := 4; - end; - 6 : if BitDepth = 8 then - begin - FConvertColor := @ColorColorAlpha8; //CFmt := cfABGR32 - FBGRAConvertColor := @BGRAColorColorAlpha8; //CFmt := cfABGR32 - ByteWidth := 4; - end - else - begin - FConvertColor := @ColorColorAlpha16; //CFmt := cfABGR64; - FBGRAConvertColor := @BGRAColorColorAlpha16; //CFmt := cfABGR64; - ByteWidth := 8; - end; - end; - //ByteWidth := BytesNeeded[CFmt]; - case BitDepth of - 1 : begin - CountBitsUsed := 8; - BitShift := 1; - BitsUsed := BitsUsed1Depth; - end; - 2 : begin - CountBitsUsed := 4; - BitShift := 2; - BitsUsed := BitsUsed2Depth; - end; - 4 : begin - CountBitsUsed := 2; - BitShift := 4; - BitsUsed := BitsUsed4Depth; - end; - 8 : begin - CountBitsUsed := 1; - BitShift := 0; - BitsUsed[0] := $FF; - end; - end; - end; - end; - - procedure FilterSub(p: PByte; Count: Int32or64; bw: Int32or64); - begin - inc(p,bw); - dec(Count,bw); - while Count > 0 do - begin - {$push}{$r-} - inc(p^, (p-bw)^); - {$pop} - inc(p); - dec(Count); - end; - end; - - procedure FilterUp(p,pPrev: PByte; Count: UInt32or64); - var Count4: Int32or64; - begin - Count4 := Count shr 2; - dec(Count, Count4 shl 2); - while Count4 > 0 do - begin - {$push}{$r-}{$q-} - PLongWord(p)^ := (((PLongWord(pPrev)^ and $00FF00FF) + (PLongWord(p)^ and $00FF00FF)) and $00FF00FF) - or (((PLongWord(pPrev)^ and $FF00FF00) + (PLongWord(p)^ and $FF00FF00)) and $FF00FF00); - {$pop} - inc(p,4); - inc(pPrev,4); - dec(Count4); - end; - while Count > 0 do - begin - {$push}{$r-} - inc(p^, pPrev^); - {$pop} - - inc(p); - inc(pPrev); - dec(Count); - end; - end; - - procedure FilterAverage(p,pPrev: PByte; Count: UInt32or64; bw: Int32or64); - var CountBW: Int32or64; - begin - CountBW := bw; - dec(Count,CountBW); - while CountBW > 0 do - begin - {$push}{$r-} - inc(p^, pPrev^ shr 1); - {$pop} - inc(p); - inc(pPrev); - dec(CountBW); - end; - - while Count > 0 do - begin - {$push}{$r-} - inc(p^, (pPrev^+(p-bw)^) shr 1); - {$pop} - inc(p); - inc(pPrev); - dec(Count); - end; - end; - - procedure FilterPaeth(p,pPrev: PByte; Count: UInt32or64; bw: Int32or64); - var - rx, dl, dp, dlp : Int32or64; - diag,left: UInt32or64; - begin - for rx := 0 to bw-1 do - begin - {$push}{$r-} - inc(p^, pPrev^); - {$pop} - inc(p); - inc(pPrev); - end; - dec(Count,bw); - while Count > 0 do - begin - diag := (pPrev-bw)^; - left := (p - bw)^; - dl := pPrev^ - Int32or64(diag); - dp := Int32or64(left) - Int32or64(diag); - dlp := abs(dl+dp); - if dl < 0 then dl := -dl; - if dp < 0 then dp := -dp; - {$push}{$r-} - if dp <= dlp then - begin - if dl <= dp then - inc(p^, left) - else - inc(p^, pPrev^) - end - else - if dl <= dlp then - inc(p^, left) - else - inc(p^, diag); - {$pop} - inc(p); - inc(pPrev); - dec(Count); - end; - end; - - procedure Decode; - var y, rp, ry, l : Int32or64; - lf : byte; - switchLine, currentLine, previousLine : pByteArray; - begin - FSetPixel := DecideSetPixel; - if not Pltte and (TheImage is TBGRACustomBitmap) and - not CheckGammaCorrection then - begin - if UseTransparent then - FHandleScanLine := @BGRAHandleScanLineTr - else - FHandleScanLine := @BGRAHandleScanLine; - end else - FHandleScanLine := @HandleScanLine; - for rp := StartPass to EndPass do - begin - FCurrentPass := rp; - StartX := StartPoints[rp,0]; - StartY := StartPoints[rp,1]; - DeltaX := Delta[rp,0]; - DeltaY := Delta[rp,1]; - if bytewidth = 1 then - begin - l := (ScanLineLength[rp] div CountBitsUsed); - if (ScanLineLength[rp] mod CountBitsUsed) > 0 then - inc (l); - end - else - l := ScanLineLength[rp]*ByteWidth; - if (l>0) then - begin - GetMem (previousLine, l); - GetMem (currentLine, l); - fillchar (currentLine^,l,0); - try - for ry := 0 to CountScanlines[rp]-1 do - begin - switchLine := currentLine; - currentLine := previousLine; - previousLine := switchLine; - Y := StartY + (ry * deltaY); - lf := 0; - Decompress.Read (lf, sizeof(lf)); - Decompress.Read (currentLine^, l); - - case lf of - 1: FilterSub(PByte(currentLine), l, ByteWidth); - 2: FilterUp(PByte(currentLine), PByte(previousLine), l); - 3: FilterAverage(PByte(currentLine), PByte(previousLine), l, ByteWidth); - 4: FilterPaeth(PByte(currentLine), PByte(previousLine), l, ByteWidth); - end; - - if FVerticalShrinkShr <> 0 then - begin - if (y and FVerticalShrinkMask) = 0 then - FHandleScanLine (y shr FVerticalShrinkShr, currentLine); - end else - FHandleScanLine (y, currentLine); - end; - finally - freemem (previousLine); - freemem (currentLine); - end; - end; - end; - end; - -begin - InitVars; - DeCode; -end; - -procedure TBGRAReaderPNG.HandleChunk; -begin - case chunk.AType of - ctIHDR : raise PNGImageException.Create ('Second IHDR chunk found'); - ctPLTE : HandlePalette; - ctIDAT : HandleData; - ctIEND : EndOfFile := True; - cttRNS : HandleAlpha; - ctsRGB : HandleStdRGB; - ctgAMA : HandleGamma; - else HandleUnknown; - end; -end; - -procedure TBGRAReaderPNG.HandleUnknown; -begin - if (chunk.readtype[0] in ['A'..'Z']) then - raise PNGImageException.Create('Critical chunk '+chunk.readtype+' not recognized'); -end; - -procedure TBGRAReaderPNG.InternalRead (Str:TStream; Img:TFPCustomImage); -var outputHeight: integer; -begin - {$ifdef FPC_Debug_Image} - if Str<>TheStream then - writeln('WARNING: TBGRAReaderPNG.InternalRead Str<>TheStream'); - {$endif} - with Header do - begin - FVerticalShrinkShr := 0; - FVerticalShrinkMask := 0; - FGammaCorrection := 1; - FGammaCorrectionTableComputed:= false; - outputHeight := Height; - if MinifyHeight <> 0 then - begin - while (outputHeight shr 1 >= MinifyHeight) and (FVerticalShrinkShr < 8) do - begin - outputHeight:= outputHeight shr 1; - Inc(FVerticalShrinkShr); - end; - FVerticalShrinkMask:= (1 shl FVerticalShrinkShr)-1; - outputHeight := (Height+FVerticalShrinkMask) shr FVerticalShrinkShr; - end; - Img.SetSize (Width, outputHeight); - end; - ZData := TMemoryStream.Create; - try - EndOfFile := false; - while not EndOfFile do - begin - if ReadChunk then - HandleChunk; - end; - ZData.position:=0; - Decompress := TDecompressionStream.Create (ZData); - try - DoDecompress; - finally - Decompress.Free; - end; - finally - ZData.Free; - if not img.UsePalette and assigned(FPalette) then - begin - FPalette.Free; - end; - end; -end; - -function TBGRAReaderPNG.InternalCheck (Str:TStream) : boolean; -var {%H-}SigCheck : array[0..7] of byte; - r : integer; -begin - try - // Check Signature - if Str.Read({%H-}SigCheck, SizeOf(SigCheck)) <> SizeOf(SigCheck) then - raise PNGImageException.Create('This is not PNG-data'); - for r := 0 to 7 do - begin - If SigCheck[r] <> Signature[r] then - raise PNGImageException.Create('This is not PNG-data'); - end; - // Check IHDR - ReadChunk; - if chunk.aType <> ctIHDR then - raise PNGImageException.Create('Header chunk expected but '+chunk.ReadType+' found'); - fillchar(FHeader, sizeof(FHeader), 0); - move (chunk.data^, FHeader, min(sizeof(Header), chunk.alength)); - with header do - begin - {$IFDEF ENDIAN_LITTLE} - Width := swap(width); - height := swap (height); - {$ENDIF} - result := (width > 0) and (height > 0) and (compression = 0) - and (filter = 0) and (Interlace in [0,1]); - end; - except - result := false; - end; -end; - -initialization - - DefaultBGRAImageReader[ifPng] := TBGRAReaderPNG; - -end. - diff --git a/components/bgrabitmap/bgrareadpsd.pas b/components/bgrabitmap/bgrareadpsd.pas deleted file mode 100644 index 97c2371..0000000 --- a/components/bgrabitmap/bgrareadpsd.pas +++ /dev/null @@ -1,620 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - The original file was part of the Free Pascal run time library. - Copyright (c) 2008 by the Free Pascal development team - - Psd reader for fpImage modified by circular. - - ********************************************************************** - - 03/2014 changes by circular : - - added MinifyHeight,WantedHeight and OutputHeight (useful for thumbnails) -} -unit BGRAReadPSD; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPimage, FPReadPSD; - -type - { TBGRAReaderPSD } - - TBGRAReaderPSD = class(TFPReaderPSD) - private - FCompressed: boolean; - protected - FScanLines : array of PByte; - FInputLine : array of record - StreamOffset: Int64; - Size: PtrInt; - end; - FOutputHeight: integer; - function ReadPalette(Stream: TStream): boolean; - procedure AnalyzeHeader; - procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; - function ReadScanLine(Stream: TStream; AInputSize: PtrInt; AChannel: integer): boolean; overload; - procedure WriteScanLine(Img: TFPCustomImage; Row: integer); overload; - function InternalCheck(Stream: TStream) : boolean; override; - public - MinifyHeight,WantedHeight: integer; - constructor Create; override; - property Compressed: Boolean read FCompressed; - property OutputHeight: integer read FOutputHeight; - end; - -implementation - -uses BGRABitmapTypes; - -function clamp(AValue, AMax: integer): integer; -begin - if AValue < 0 then result := 0 else - if AValue > AMax then result := AMax else - result := AValue;; -end; - -function CMYKtoRGB ( C : TFPColor): TFPColor; -var r,g,b: integer; -begin - r := $ffff - c.red + c.green div 10 + c.blue div 10 - c.alpha; - g := $ffff + c.red div 10 - c.green + c.blue div 10 - c.alpha; - b := $ffff + c.red div 10 + c.green div 10 - c.blue - c.alpha; - result.red := clamp(r, 65535); - result.green := clamp(g, 65535); - result.blue := clamp(b, 65535); - Result.alpha:=alphaOpaque; -end; - -function fInv(t: single): single; -begin - if t > 6/29 then result := t*t*t else - result := 3*(6/29)*(6/29)*(t-4/29); -end; - -function Csrgb(linear: single): single; -begin - if linear <= 0.0031308 then - result := 12.92*linear else - result := (1+0.055)*exp(ln(linear)*(1/2.4)) - 0.055; -end; - -function LabToRGB(L,a,b: single):TFPColor; overload; -var r,g,blue: single; -begin - if a < 0 then - r := L + a + 0.25*b - else - r := L + 0.75*a + 0.25*b; - g := L - 0.25*a; - blue := L - b; - Result.red:= clamp(round((r)*65535),65535); - Result.green:= clamp(round((g)*65535),65535); - Result.blue:= clamp(round((blue)*65535),65535); - result.alpha := 65535; -end; - -function LabToRGB(const Lab:TLab):TFPColor; overload; -var L: single; -begin - L := 1/255*Lab.L; - result := LabToRGB(L,(Lab.a-128)/127,(Lab.b-128)/127); -end; - -{ TBGRAReaderPSD } - -function TBGRAReaderPSD.ReadPalette(Stream: TStream): boolean; -Var - I : Integer; - c : TFPColor; - OldPos: Integer; - BufSize:Longint; - {%H-}PalBuf: array[0..767] of Byte; - ContProgress: Boolean; -begin - Result:=false; - ThePalette.count := 0; - OldPos := Stream.Position; - BufSize:=0; - Stream.Read(BufSize, SizeOf(BufSize)); - BufSize:=BEtoN(BufSize); - Stream.Read({%H-}PalBuf, BufSize); - ContProgress:=true; - Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - For I:=0 To BufSize div 3 Do - Begin - With c do - begin - Red:=PalBuf[I] shl 8; - Green:=PalBuf[I+(BufSize div 3)] shl 8; - Blue:=PalBuf[I+(BufSize div 3)* 2] shl 8; - Alpha:=alphaOpaque; - end; - ThePalette.Add(C); - End; - Stream.Position := OldPos; - Result:=true; -end; - -procedure TBGRAReaderPSD.AnalyzeHeader; -var channel: integer; -begin - With FHeader do - begin - Depth:=BEtoN(Depth); - if (Signature <> '8BPS') then - Raise Exception.Create('Unknown/Unsupported PSD image type'); - Channels:=BEtoN(Channels); - if Channels > 4 then - FBytesPerPixel:=Depth*4 - else - FBytesPerPixel:=Depth*Channels; - Mode:=BEtoN(Mode); - FWidth:=BEtoN(Columns); - FHeight:=BEtoN(Rows); - FChannelCount:=Channels; - FLineSize:=(PtrInt(FWidth)*Depth+7) div 8; - setlength(FScanLines, FChannelCount); - for channel := 0 to FChannelCount-1 do - GetMem(FScanLines[channel],FLineSize); - end; -end; - -procedure TBGRAReaderPSD.InternalRead(Stream: TStream; Img: TFPCustomImage); -var - H,HOutput,InputLineIndex,LenOfLineIndex,channel: Integer; - LenOfLineFactor: PtrInt; - BufSize:LongWord; - Encoding:word; - ContProgress: Boolean; - CurOffset: int64; - PrevOutputRow, OutputRow, OutputRowAdd, OutputRowAcc, OutputRowAccAdd, OutputRowMod: integer; -begin - FScanLines:=nil; - FPalette:=nil; - try - Stream.Position:=0; - ContProgress:=true; - Progress(FPimage.psStarting, 0, False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - // read header - Stream.Read(FHeader, SizeOf(FHeader)); - Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - AnalyzeHeader; - Case FHeader.Mode of - 0:begin // Bitmap (monochrome) - FPalette := TFPPalette.Create(0); - CreateBWPalette; - end; - 1, 8:begin // Gray-scale - FPalette := TFPPalette.Create(0); - CreateGrayPalette; - end; - 2:begin // Indexed color (palette color) - FPalette := TFPPalette.Create(0); - if not ReadPalette(stream) then exit; - end; - end; - - if Assigned(OnCreateImage) then - OnCreateImage(Self,Img); - - if (MinifyHeight > 0) and (FHeight > MinifyHeight) then - FOutputHeight:= MinifyHeight - else - if WantedHeight > 0 then - FOutputHeight:= WantedHeight - else - FOutputHeight:= FHeight; - Img.SetSize(FWidth,FOutputHeight); - - // color palette - BufSize:=0; - Stream.Read(BufSize, SizeOf(BufSize)); - BufSize:=BEtoN(BufSize); - Stream.Seek(BufSize, soCurrent); - // color data block - Stream.Read(BufSize, SizeOf(BufSize)); - BufSize:=BEtoN(BufSize); - Stream.Read(FColorDataBlock, SizeOf(FColorDataBlock)); - Stream.Seek(BufSize-SizeOf(FColorDataBlock), soCurrent); - // mask - Stream.Read(BufSize, SizeOf(BufSize)); - BufSize:=BEtoN(BufSize); - Stream.Seek(BufSize, soCurrent); - // compression type - Encoding:=0; - Stream.Read(Encoding, SizeOf(Encoding)); - FCompressed:=BEtoN(Encoding) = 1; - if BEtoN(Encoding)>1 then - Raise Exception.Create('Unknown compression type'); - If FCompressed then - begin - SetLength(FLengthOfLine, FHeight * FChannelCount); - Stream.ReadBuffer(FLengthOfLine[0], 2 * Length(FLengthOfLine)); - Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - if not (FHeader.Mode in [0, 2]) then - LenOfLineFactor := FHeader.Depth div 8 - else - LenOfLineFactor := 1; - end else - begin - FLengthOfLine := nil; - end; - - setlength(FInputLine, FHeight * FChannelCount); - CurOffset := Stream.Position; - H := 0; - channel := 0; - InputLineIndex:= 0; - for LenOfLineIndex := 0 to FHeight * FChannelCount-1 do - begin - FInputLine[InputLineIndex].StreamOffset := CurOffset; - if FLengthOfLine <> nil then - FInputLine[InputLineIndex].Size := BEtoN(FLengthOfLine[LenOfLineIndex])*LenOfLineFactor else - FInputLine[InputLineIndex].Size := FLineSize; - inc(CurOffset, FInputLine[InputLineIndex].Size); - inc(H); - Inc(InputLineIndex, FChannelCount); - if H = FHeight then - begin - H := 0; - Inc(channel); - InputLineIndex:= channel; - end; - end; - - InputLineIndex := 0; - PrevOutputRow := -1; - OutputRow := 0; - OutputRowAdd := FOutputHeight div FHeight; - OutputRowMod:= FHeight; - OutputRowAccAdd := FOutputHeight mod FHeight; - OutputRowAcc:= 0; - - For H := 0 to FHeight - 1 do - begin - if OutputRow > PrevOutputRow then - begin - for channel := 0 to FChannelCount-1 do - begin - Stream.Position := FInputLine[InputLineIndex].StreamOffset; - ReadScanLine(Stream, FInputLine[InputLineIndex].Size, channel); - Inc(InputLineIndex); - end; - For HOutput:= PrevOutputRow+1 to OutputRow do WriteScanLine(Img, HOutput); - Progress(FPimage.psRunning, round((H+1)*99.0 / (FHeight * FChannelCount)), False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - end else inc(InputLineIndex, FChannelCount); - - PrevOutputRow:= OutputRow; - Inc(OutputRow, OutputRowAdd); - Inc(OutputRowAcc, OutputRowAccAdd); - if OutputRowAcc> OutputRowMod then - begin - dec(OutputRowAcc, OutputRowMod); - inc(OutputRow); - end; - end; - Progress(FPimage.psRunning, 100, False, Rect(0,0,0,0), '', ContProgress); - if not ContProgress then exit; - - {$ifdef FPC_Debug_Image} - WriteLn('TBGRAReaderPSD.InternalRead AAA1 ',Stream.position,' ',Stream.size); - {$endif} - finally - FreeAndNil(FPalette); - for channel := 0 to FChannelCount-1 do - ReAllocMem(FScanLines[channel],0); - end; - Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress); -end; - -function TBGRAReaderPSD.ReadScanLine(Stream: TStream; AInputSize: PtrInt; - AChannel: integer): boolean; -Var - P : PByte; - B : Byte; - I, left : PtrInt; - N : Shortint; - Count:integer; - buf, PBuf: PByte; -begin - Result:=false; - If Not Compressed then - Stream.ReadBuffer(FScanLines[AChannel]^,FLineSize) - else - begin - getmem(buf, AInputSize); - if stream.Read(buf^,AInputSize) <> AInputSize then - begin - freemem(buf); - result := false; - exit; - end; - P:=FScanLines[AChannel]; - left := FLineSize; - i:=AInputSize; - PBuf := buf; - repeat - Count:=0; - N:= PShortInt(PBuf)^; - inc(PBuf); - dec(i); - If N = -128 then - else - if N < 0 then - begin - Count:=-N+1; - if Count > left then Count := left; - dec(left,Count); - B:= PBuf^; - Inc(PBuf); - dec(i); - fillchar(p^,count,B); - inc(p,count); - end - else - begin - Count:=N+1; - if Count > left then Count := left; - dec(left,Count); - Move(PBuf^, P^, Count); - Inc(PBuf, Count); - inc(p, count); - dec(i, count); - end; - until (i <= 0) or (left <= 0); - freemem(buf); - end; - Result:=true; -end; - -function Value32To16(p: PLongWord; gamma: single): Word; -var v: single; -begin - v := (BEtoN(P^) - 1024000000)/40960000; - if v <= 0 then result := 0 else - if v >= 1 then result := 65535 else - result := round(exp(ln(v)*gamma)*65535); -end; - -procedure TBGRAReaderPSD.WriteScanLine(Img: TFPCustomImage; Row: integer); -Var - Col : Integer; - C : TFPColor; - P, P1, P2, P3 : PByte; - Lab : TLab; -begin - C.Alpha:=AlphaOpaque; - P:=FScanLines[0]; - begin - case FBytesPerPixel of - 1 : begin - for Col:=0 to Img.Width-1 do - if (P[col div 8] and (128 shr (col mod 8))) <> 0 then - Img.Colors[Col,Row]:=ThePalette[0] - else - Img.Colors[Col,Row]:=ThePalette[1]; - end; - 8 : begin - for Col:=0 to Img.Width-1 do - begin - Img.Colors[Col,Row]:=ThePalette[P[0]]; - inc(p); - end; - end; - 16 : if (FHeader.Mode = 1) or (FHeader.Mode = 8) then - begin - if FChannelCount = 1 then - for Col:=0 to Img.Width-1 do - begin - C.Red:=BEtoN(PWord(P)^); - C.green:=C.Red; - C.blue:=C.Red; - C.alpha:=65535; - Img[col, row] := C; - Inc(P,2); - end else - if FChannelCount = 2 then - begin - P1:=FScanLines[1]; - for Col:=0 to Img.Width-1 do - begin - C.Red:=P^ shl 8 + P^; - C.green:=C.Red; - C.blue:=C.Red; - C.alpha:=p1^ shl 8 + P1^; - Img[col, row] := C; - Inc(P); - Inc(P1); - end; - end; - end else - begin - for Col:=0 to Img.Width-1 do - begin - Img.Colors[Col,Row]:=ThePalette[BEtoN(PWord(P)^)]; - inc(p,2); - end; - end; - 24 : if FChannelCount>=3 then - begin - P1:=FScanLines[1]; - P2:=FScanLines[2]; - for Col:=0 to Img.Width-1 do - begin - if (FHeader.Mode =9) then - begin - Lab.L:=P[0]; - Lab.a:=P1[0]; - Lab.b:=P2[0]; - C:=LabToRGB(Lab); - end - else - With C do - begin - Red:=P[0] or (P[0] shl 8); - green:=P1[0] or (P1[0] shl 8); - blue:=P2[0] or (P2[0] shl 8); - alpha:=alphaOpaque; - end; - Inc(P); - Inc(P1); - Inc(P2); - Img[col, row] := C; - end; - end; - 32 : if (FHeader.Mode = 1) or (FHeader.Mode = 8) then - begin - if FChannelCount = 1 then - for Col:=0 to Img.Width-1 do - begin - C.Red:=Value32To16(PLongWord(P),1.3); - C.green:=C.Red; - C.blue:=C.Red; - C.alpha:=65535; - Img[col, row] := C; - Inc(P,4); - end else - if FChannelCount = 2 then - begin - P1:=FScanLines[1]; - for Col:=0 to Img.Width-1 do - begin - C.Red:=BEtoN(PWord(P)^); - C.green:=C.Red; - C.blue:=C.Red; - C.alpha:=BEtoN(PWord(p1)^); - Img[col, row] := C; - Inc(P,2); - Inc(P1,2); - end; - end; - end else - if FChannelCount >= 4 then - begin - P1:=FScanLines[1]; - P2:=FScanLines[2]; - P3:=FScanLines[3]; - for Col:=0 to Img.Width-1 do - begin - if (FHeader.Mode =4) then - begin - P^ := 255 - P^; - P1^ := 255 - P1^; - P2^ := 255 - P2^; - P3^ := 255 - P3^; - end; - C.Red:=P[0] or (P[0] shl 8); - C.green:=P1[0] or (P1[0] shl 8); - C.blue:=P2[0] or (P2[0] shl 8); - C.alpha:=P3[0] or (P3[0] shl 8); - if (FHeader.Mode =4) then C:=CMYKtoRGB(C); // CMYK to RGB - Img[col, row] := C; - Inc(P); - Inc(P1); - Inc(P2); - Inc(P3); - end; - end; - 48 :if FChannelCount = 3 then - begin - P1:=FScanLines[1]; - P2:=FScanLines[2]; - C.alpha:=alphaOpaque; - for Col:=0 to Img.Width-1 do - begin - if (FHeader.Mode =9) then - C := LabToRGB(BEtoN(PWord(P)^)/65535, (BEtoN(PWord(P1)^)-32768)/32767, (BEtoN(PWord(P2)^)-32768)/32767) - else - With C do - begin - Red:=BEtoN(PWord(P)^); - green:=BEtoN(PWord(P1)^); - blue:=BEtoN(PWord(P2)^); - end; - Inc(P,2); - Inc(P1,2); - Inc(P2,2); - Img[col, row] := C; - end; - end; - 64 : if FChannelCount = 4 then - begin - P1:=FScanLines[1]; - P2:=FScanLines[2]; - P3:=FScanLines[3]; - for Col:=0 to Img.Width-1 do - begin - C.Red:=BEtoN(PWord(P)^); - C.green:=BEtoN(PWord(P1)^); - C.blue:=BEtoN(PWord(P2)^); - C.alpha:=BEtoN(PWord(P3)^); - if (FHeader.Mode =4) then - begin - C.red:=$ffff-C.red; - C.green:=$ffff-C.green; - C.blue:=$ffff-C.blue; - C.alpha:=$ffff-C.alpha; - end; - if (FHeader.Mode =4) then C:=CMYKtoRGB(C); // CMYK to RGB - Img[col, row] := C; - Inc(P,2); - Inc(P1,2); - Inc(P2,2); - Inc(P3,2); - end; - end; - 96 :if FChannelCount = 3 then - begin - P1:=FScanLines[1]; - P2:=FScanLines[2]; - C.alpha:=alphaOpaque; - for Col:=0 to Img.Width-1 do - begin - With C do - begin - Red:=Value32To16(PLongWord(P),2.7); - green:=Value32To16(PLongWord(P1),2.7); - blue:=Value32To16(PLongWord(P2),2.7); - end; - Inc(P,4); - Inc(P1,4); - Inc(P2,4); - Img[col, row] := C; - end; - end; - end; - end; -end; - -function TBGRAReaderPSD.InternalCheck(Stream: TStream): boolean; -var - OldPos: Int64; -begin - try - OldPos:=Stream.Position; - Stream.Read(FHeader,SizeOf(FHeader)); - Result:=(FHeader.Signature = '8BPS'); - Stream.Position:=OldPos; - except - Result:=False; - end; -end; - -constructor TBGRAReaderPSD.Create; -begin - inherited Create; -end; - -initialization - - DefaultBGRAImageReader[ifPsd] := TBGRAReaderPSD; - -end. diff --git a/components/bgrabitmap/bgrareadtga.pas b/components/bgrabitmap/bgrareadtga.pas deleted file mode 100644 index 303b750..0000000 --- a/components/bgrabitmap/bgrareadtga.pas +++ /dev/null @@ -1,192 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{*****************************************************************************} -{ - The original file is part of the Free Pascal's "Free Components Library". - Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team - - Targa reader implementation modified by circular. -} -{*****************************************************************************} - -{ - 22/11/2007 Modified by Laurent Jacques for support all format } - -{$mode objfpc} -{$h+} - -unit BGRAReadTGA; - -interface - -uses FPReadTGA, FPimage, BGRAClasses; - -type - { TBGRAReaderTarga } - - TBGRAReaderTarga = class (TFPReaderTarga) - protected - FBuffer: packed array of byte; - FBufferPos, FBufferSize: integer; - FBufferStream: TStream; - procedure ReadScanLine({%H-}Row: Integer; Stream: TStream); override; - procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); override; - procedure InitReadBuffer(AStream: TStream; ASize: integer); - procedure CloseReadBuffer; - function GetNextBufferByte: byte; - end; - -Implementation - -uses BGRABitmapTypes, targacmn; - -procedure TBGRAReaderTarga.ReadScanLine(Row: Integer; Stream: TStream); -Var - P : PByte; - B : Byte; - I,J : Integer; - PixelSizeInBytesMinus1: integer; - -begin - If Not Compressed then - Stream.ReadBuffer(FScanLine^,FLineSize) - else - begin - InitReadBuffer(Stream, 2048); - P:=FScanLine; - PixelSizeInBytesMinus1 := (BytesPerPixel shr 3)-1; - For I:=0 to ToWord(Header.Width)-1 do - begin - If (FPixelCount>0) then - Dec(FPixelCount) - else - begin - Dec(FBlockCount); - If (FBlockCount<0) then - begin - B := GetNextBufferByte; - If (B and $80)<>0 then - begin - FPixelCount:=B and $7F; - FblockCount:=0; - end - else - FBlockCount:=B and $7F - end; - For J:=0 to PixelSizeInBytesMinus1 do - FLastPixel[j] := GetNextBufferByte; - end; - For J:=0 to PixelSizeInBytesMinus1 do - begin - P[0]:=FLastPixel[j]; - Inc(P); - end; - end; - CloseReadBuffer; - end; -end; - -Procedure TBGRAReaderTarga.WriteScanLine(Row : Integer; Img : TFPCustomImage); -Var - Col : Integer; - Value : UInt32or64; - P : PByte; - PDest: PBGRAPixel; - -begin - P:=FScanLine; - PDest := TBGRACustomBitmap(img).ScanLine[Row]; - Case Header.ImgType of - TARGA_INDEXED_IMAGE - : for Col:=Img.width-1 downto 0 do - begin - PDest^ := FPColorToBGRA(FPalette[P^]); - Inc(PDest); - Inc(P); - end; - TARGA_TRUECOLOR_IMAGE - : if (BytesPerPixel = 32) and (AlphaBits = 8) then - Move(P^,PDest^,Img.Width*sizeof(TBGRAPixel)) else - if (BytesPerPixel = 24) then - begin - for Col:=Img.Width-1 downto 0 do - begin - PDest^ := BGRA((P+2)^,(P+1)^,P^); - inc(Pdest); - Inc(p,3); - end; - end - else if (BytesPerPixel in[8,16]) then - for Col:= Img.Width-1 to 0 do - begin - Value:=P[0]; - inc(P); - Value:=value or (P[0] shl 8); - PDest^ := BGRA(((value)shr 10) shl 3,((value)shr 5) shl 3,((value)) shl 3); - Inc(PDest); - Inc(P); - end; - TARGA_GRAY_IMAGE - : case BytesPerPixel of - 8 : for Col:=Img.width-1 downto 0 do - begin - PDest^ := FPColorToBGRA(FPalette[P^]); - Inc(PDest); - Inc(P); - end; - 16 : for Col:=0 to Img.width-1 do - begin - With PDest^ do - begin - blue:=FPalette[P^].blue shr 8; - green:=FPalette[P^].green shr 8; - red:=FPalette[P^].red shr 8; - Inc(P); - if alphaBits = 8 then alpha := P^ else - alpha:=255; - Inc(P); - end; - inc(PDest); - end; - end; - end; -end; - -procedure TBGRAReaderTarga.InitReadBuffer(AStream: TStream; ASize: integer); -begin - setLength(FBuffer,ASize); - FBufferSize := AStream.Read(FBuffer[0],ASize); - FBufferPos := 0; - FBufferStream := AStream; -end; - -procedure TBGRAReaderTarga.CloseReadBuffer; -begin - FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos; -end; - -function TBGRAReaderTarga.GetNextBufferByte: byte; -begin - if FBufferPos < FBufferSize then - begin - result := FBuffer[FBufferPos]; - inc(FBufferPos); - end else - if FBufferSize = 0 then - result := 0 - else - begin - FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer)); - FBufferPos := 0; - if FBufferPos < FBufferSize then - begin - result := FBuffer[FBufferPos]; - inc(FBufferPos); - end else - result := 0; - end; -end; - -initialization - - DefaultBGRAImageReader[ifTarga] := TBGRAReaderTarga; - -end. diff --git a/components/bgrabitmap/bgrareadtiff.pas b/components/bgrabitmap/bgrareadtiff.pas deleted file mode 100644 index 9990364..0000000 --- a/components/bgrabitmap/bgrareadtiff.pas +++ /dev/null @@ -1,2863 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - The original file is part of the Free Pascal run time library. - Copyright (c) 2012-2013 by the Free Pascal development team - - Tiff reader for fpImage modified by circular. - - ********************************************************************** - - Working: - Sample bitdepth: 1, 4, 8, 12, 16 - Color format: black and white, grayscale, RGB, colormap, L*a*b* - Alpha channel: none, premultiplied, separated - Compression: packbits, LZW, deflate - Endian-ness: little endian and big endian - Orientation: any corner can be (0,0) and x/y can be flipped - Planar configuration: 1 (channels together) - Fill order: any (for 1 bit per sample images) - Skipping thumbnail by reading biggest image - Multiple images - Strips and tiles - - ToDo: - Compression: FAX, Jpeg... - Color format: YCbCr, ITU L*a*b* - PlanarConfiguration: 2 (one chunk for each channel) - bigtiff 64bit offsets - XMP tag 700 - ICC profile tag 34675 - - Not to do: - Separate mask (deprecated) - -} -unit BGRAReadTiff; - -{$mode objfpc}{$H+} - -{$inline on} - -interface - -uses - Math, BGRAClasses, SysUtils, ctypes, zinflate, zbase, FPimage, FPTiffCmn, - BGRABitmapTypes; - -type - TBGRAReaderTiff = class; - - TTiffCreateCompatibleImgEvent = procedure(Sender: TBGRAReaderTiff; - ImgFileDir: TTiffIFD) of object; - - TTiffCheckIFDOrder = ( - tcioSmart, - tcioAlways, - tcioNever - ); - - { TBGRAReaderTiff } - - TBGRAReaderTiff = class(TFPCustomImageReader) - private - FCheckIFDOrder: TTiffCheckIFDOrder; - FFirstIFDStart: LongWord; - FOnCreateImage: TTiffCreateCompatibleImgEvent; - {$ifdef FPC_Debug_Image} - FDebug: boolean; - {$endif} - FIFDList: TFPList; - FReverseEndian: Boolean; - fStartPos: int64; - s: TStream; - function GetImages(Index: integer): TTiffIFD; - procedure TiffError(Msg: string); - procedure SetStreamPos(p: LongWord); - function ReadTiffHeader(QuickTest: boolean; out IFDStart: LongWord): boolean; // returns IFD: offset to first IFD - function ReadIFD(Start: LongWord; IFD: TTiffIFD): LongWord;// Image File Directory - procedure ReadDirectoryEntry(var EntryTag: Word; IFD: TTiffIFD); - function ReadEntryUnsigned: LongWord; - function ReadEntrySigned: Cint32; - function ReadEntryRational: TTiffRational; - function ReadEntryString: string; - function ReadByte: Byte; - function ReadWord: Word; - function ReadDWord: LongWord; - procedure ReadValues(StreamPos: LongWord; - out EntryType: word; out EntryCount: LongWord; - out Buffer: Pointer; out ByteCount: PtrUInt); - procedure ReadShortOrLongValues(StreamPos: LongWord; - out Buffer: PLongWord; out Count: LongWord); - procedure ReadShortValues(StreamPos: LongWord; - out Buffer: PWord; out Count: LongWord); - procedure ReadImageSampleProperties(IFD: TTiffIFD; out AlphaChannel: integer; out PremultipliedAlpha: boolean; - out SampleCnt: LongWord; out SampleBits: PWord; out SampleBitsPerPixel: LongWord; - out PaletteCnt: LongWord; out PaletteValues: PWord); - procedure ReadImgValue(BitCount: Word; - var Run: Pointer; var BitPos: Byte; FillOrder: LongWord; - Predictor: word; var LastValue: word; out Value: Word); - function FixEndian(w: Word): Word; inline; - function FixEndian(d: LongWord): LongWord; inline; - procedure SetFPImgExtras(CurImg: TFPCustomImage; IFD: TTiffIFD); - procedure DecodePackBits(var Buffer: Pointer; var Count: PtrInt); - procedure DecodeLZW(var Buffer: Pointer; var Count: PtrInt); - procedure DecodeDeflate(var Buffer: Pointer; var Count: PtrInt; ExpectedCount: PtrInt); - protected - procedure InternalRead(Str: TStream; AnImage: TFPCustomImage); override; - function InternalCheck(Str: TStream): boolean; override; - procedure DoCreateImage(ImgFileDir: TTiffIFD); virtual; - public - constructor Create; override; - destructor Destroy; override; - procedure Clear; - - procedure LoadFromStream(aStream: TStream; AutoClear: boolean = true); //load all images (you need to handle OnCreateImage event and assign ImgFileDir.Img) - {$ifdef FPC_Debug_Image} - property Debug: boolean read FDebug write FDebug; - {$endif} - property OnCreateImage: TTiffCreateCompatibleImgEvent read FOnCreateImage - write FOnCreateImage; - property CheckIFDOrder: TTiffCheckIFDOrder read FCheckIFDOrder write FCheckIFDOrder; //check order of IFD entries or not - function FirstImg: TTiffIFD; - function GetBiggestImage: TTiffIFD; - function ImageCount: integer; - property Images[Index: integer]: TTiffIFD read GetImages; default; - - public //advanced - ImageList: TFPList; // list of TTiffIFD - procedure LoadHeaderFromStream(aStream: TStream); - procedure LoadIFDsFromStream; // call LoadHeaderFromStream before - procedure LoadImageFromStream(Index: integer); // call LoadIFDsFromStream before - procedure LoadImageFromStream(IFD: TTiffIFD); // call LoadIFDsFromStream before - procedure ReleaseStream; - property StartPos: int64 read fStartPos; - property TheStream: TStream read s; - property FirstIFDStart: LongWord read FFirstIFDStart; - end; - -procedure DecompressPackBits(Buffer: Pointer; Count: PtrInt; - out NewBuffer: Pointer; out NewCount: PtrInt); -procedure DecompressLZW(Buffer: Pointer; Count: PtrInt; - out NewBuffer: PByte; out NewCount: PtrInt); -function DecompressDeflate(Compressed: PByte; CompressedCount: LongWord; - out Decompressed: PByte; var DecompressedCount: LongWord; - ErrorMsg: PAnsiString = nil): boolean; - -implementation - -function CMYKToFPColor(C,M,Y,K: Word): TFPColor; -var R, G, B : LongWord; -begin - R := $ffff - ((LongWord(C)*($ffff-LongWord(K))) shr 16) - LongWord(K) ; - G := $ffff - ((LongWord(M)*($ffff-LongWord(K))) shr 16) - LongWord(K) ; - B := $ffff - ((LongWord(Y)*($ffff-LongWord(K))) shr 16) - LongWord(K) ; - Result := FPColor(R and $ffff,G and $ffff,B and $ffff); -end ; - -procedure TBGRAReaderTiff.TiffError(Msg: string); -begin - Msg:=Msg+' at position '+IntToStr(s.Position); - if fStartPos>0 then - Msg:=Msg+' (TiffPosition='+IntToStr(fStartPos)+')'; - raise Exception.Create(Msg); -end; - -function TBGRAReaderTiff.GetImages(Index: integer): TTiffIFD; -begin - Result:=TTiffIFD(ImageList[Index]); -end; - -procedure TBGRAReaderTiff.ReadImageSampleProperties(IFD: TTiffIFD; - out AlphaChannel: integer; out PremultipliedAlpha: boolean; - out SampleCnt: LongWord; out SampleBits: PWord; out SampleBitsPerPixel: LongWord; - out PaletteCnt: LongWord; out PaletteValues: PWord); -var - BytesPerPixel: Word; - i: Integer; - ExtraSampleCnt, RegularSampleCnt: LongWord; - ExtraSamples: PWord; -begin - ReadShortValues(IFD.BitsPerSample, SampleBits, SampleCnt); - if SampleCnt<>IFD.SamplesPerPixel then - begin - ReAllocMem(SampleBits, 0); - TiffError('Samples='+IntToStr(SampleCnt)+' <> SamplesPerPixel='+IntToStr(IFD - .SamplesPerPixel)); - end; - - BytesPerPixel:=0; - SampleBitsPerPixel:=0; - PaletteCnt:= 0; - PaletteValues:= nil; - - AlphaChannel:= -1; - PremultipliedAlpha:= false; - IFD.AlphaBits:= 0; - - //looking for alpha channel in extra samples - if IFD.ExtraSamples>0 then - ReadShortValues(IFD.ExtraSamples, ExtraSamples, ExtraSampleCnt) - else begin - ExtraSamples := nil; - ExtraSampleCnt:= 0; - end; - - if ExtraSampleCnt>=SampleCnt then - begin - ReAllocMem(SampleBits, 0); - ReAllocMem(ExtraSamples, 0); - TiffError('Samples='+IntToStr(SampleCnt)+' ExtraSampleCnt='+IntToStr( - ExtraSampleCnt)); - end; - - RegularSampleCnt := SampleCnt - ExtraSampleCnt; - - for i:=0 to ExtraSampleCnt-1 do begin - if ExtraSamples[i] in [1, 2] then begin - AlphaChannel := RegularSampleCnt+i; - PremultipliedAlpha:= ExtraSamples[i]=1; - IFD.AlphaBits:=SampleBits[AlphaChannel]; - end; - end; - - ReAllocMem(ExtraSamples, 0); //end of extra samples - - for i:=0 to SampleCnt-1 do begin - if SampleBits[i]>16 then - TiffError('Samples bigger than 16 bit not supported'); - if not (SampleBits[i] in [1, 4, 8, 12, 16]) then - TiffError('Only samples of 1, 4, 8, 12 and 16 bit are supported'); - if (i <> 0) and ((SampleBits[i] = 1) xor (SampleBits[0] = 1)) then - TiffError('Cannot mix 1 bit samples with other sample sizes'); - inc(SampleBitsPerPixel, SampleBits[i]); - end; - - BytesPerPixel:= SampleBitsPerPixel div 8; - IFD.BytesPerPixel:=BytesPerPixel; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('BytesPerPixel=', BytesPerPixel); - {$endif} - - case IFD.PhotoMetricInterpretation of - 0, 1: - begin - if RegularSampleCnt<>1 then - TiffError('gray images expect one sample per pixel, but found '+ - IntToStr(SampleCnt)); - - IFD.GrayBits:=SampleBits[0]; - end; - 2: - begin - if (RegularSampleCnt<>3) and (RegularSampleCnt<>4) then - TiffError('rgb(a) images expect three or four samples per pixel, but found '+ - IntToStr(SampleCnt)); - - IFD.RedBits:=SampleBits[0]; - IFD.GreenBits:=SampleBits[1]; - IFD.BlueBits:=SampleBits[2]; - if RegularSampleCnt=4 then begin - if (AlphaChannel <> -1) then - TiffError('Alpha channel specified twice'); - AlphaChannel:= 3; - PremultipliedAlpha:= false; - IFD.AlphaBits:=SampleBits[AlphaChannel]; - end; - end; - 3: - begin - if RegularSampleCnt<>1 then - TiffError('palette images expect one sample per pixel, but found '+ - IntToStr(SampleCnt)); - - if IFD.ColorMap > 0 then - begin - ReadShortValues(IFD.ColorMap, PaletteValues, PaletteCnt); - if PaletteCnt <> (1 shl SampleBits[0])*3 then - begin - ReAllocMem(PaletteValues, 0); - TiffError('Palette size mismatch'); - end; - end else - TiffError('Palette not supplied') - end; - 4: - begin - if RegularSampleCnt<>1 then - TiffError('mask images expect one sample per pixel, but found '+ - IntToStr(SampleCnt)); - TiffError('Mask images not handled'); - end; - 5: - begin - if RegularSampleCnt<>4 then - TiffError('cmyk images expect four samples per pixel, but found '+ - IntToStr(SampleCnt)); - - IFD.RedBits:=SampleBits[0]; //cyan - IFD.GreenBits:=SampleBits[1]; //magenta - IFD.BlueBits:=SampleBits[2]; //yellow - IFD.GrayBits:=SampleBits[3]; //black - PremultipliedAlpha:= false; - end; - 8,9: - begin - if (RegularSampleCnt<>1) and (RegularSampleCnt<>3) then - TiffError('L*a*b* colorspace needs either one component for grayscale or three components, but found '+inttostr(RegularSampleCnt)); - if RegularSampleCnt = 3 then - begin - IFD.GreenBits:=SampleBits[0]; - if (IFD.GreenBits <> 8) and (IFD.GreenBits <> 16) then TiffError('Only 8 bit and 16 bit depth allowed for L* component'); - IFD.RedBits:=SampleBits[1]; - IFD.BlueBits:=SampleBits[2]; //in fact inverse blue so more like yellow - if ((IFD.RedBits <> 8) and (IFD.RedBits <> 16)) - or ((IFD.BlueBits <> 8) and (IFD.BlueBits <> 16)) then TiffError('Only 8 bit and 16 bit depth allowed for a* and b* component'); - end else - begin - IFD.GrayBits:=SampleBits[0]; - if (IFD.GrayBits <> 8) and (IFD.GrayBits <> 16) then TiffError('Only 8 bit and 16 bit depth allowed for L* component'); - end; - PremultipliedAlpha:= false; - end - else - TiffError('Photometric interpretation not handled (' + inttostr(IFD.PhotoMetricInterpretation)+')'); - end; -end; - -procedure TBGRAReaderTiff.SetFPImgExtras(CurImg: TFPCustomImage; IFD: TTiffIFD); -begin - ClearTiffExtras(CurImg); - // set Tiff extra attributes - CurImg.Extra[TiffPhotoMetric]:=IntToStr(IFD.PhotoMetricInterpretation); - //writeln('TBGRAReaderTiff.SetFPImgExtras PhotoMetric=',CurImg.Extra[TiffPhotoMetric]); - if IFD.Artist<>'' then - CurImg.Extra[TiffArtist]:=IFD.Artist; - if IFD.Copyright<>'' then - CurImg.Extra[TiffCopyright]:=IFD.Copyright; - if IFD.DocumentName<>'' then - CurImg.Extra[TiffDocumentName]:=IFD.DocumentName; - if IFD.DateAndTime<>'' then - CurImg.Extra[TiffDateTime]:=IFD.DateAndTime; - if IFD.HostComputer<>'' then - CurImg.Extra[TiffHostComputer]:=IFD.HostComputer; - if IFD.ImageDescription<>'' then - CurImg.Extra[TiffImageDescription]:=IFD.ImageDescription; - if IFD.Make_ScannerManufacturer<>'' then - CurImg.Extra[TiffMake_ScannerManufacturer]:=IFD.Make_ScannerManufacturer; - if IFD.Model_Scanner<>'' then - CurImg.Extra[TiffModel_Scanner]:=IFD.Model_Scanner; - if IFD.Software<>'' then - CurImg.Extra[TiffSoftware]:=IFD.Software; - if not (IFD.Orientation in [1..8]) then - IFD.Orientation:=1; - CurImg.Extra[TiffOrientation]:=IntToStr(IFD.Orientation); - if IFD.ResolutionUnit<>0 then - CurImg.Extra[TiffResolutionUnit]:=IntToStr(IFD.ResolutionUnit); - if (IFD.XResolution.Numerator<>0) or (IFD.XResolution.Denominator<>0) then - CurImg.Extra[TiffXResolution]:=TiffRationalToStr(IFD.XResolution); - if (IFD.YResolution.Numerator<>0) or (IFD.YResolution.Denominator<>0) then - CurImg.Extra[TiffYResolution]:=TiffRationalToStr(IFD.YResolution); - CurImg.Extra[TiffRedBits]:=IntToStr(IFD.RedBits); - CurImg.Extra[TiffGreenBits]:=IntToStr(IFD.GreenBits); - CurImg.Extra[TiffBlueBits]:=IntToStr(IFD.BlueBits); - CurImg.Extra[TiffGrayBits]:=IntToStr(IFD.GrayBits); - CurImg.Extra[TiffAlphaBits]:=IntToStr(IFD.AlphaBits); - if IFD.PageCount>0 then begin - CurImg.Extra[TiffPageNumber]:=IntToStr(IFD.PageNumber); - CurImg.Extra[TiffPageCount]:=IntToStr(IFD.PageCount); - end; - if IFD.PageName<>'' then - CurImg.Extra[TiffPageName]:=IFD.PageName; - if IFD.ImageIsThumbNail then - CurImg.Extra[TiffIsThumbnail]:='1'; - if IFD.ImageIsMask then - CurImg.Extra[TiffIsMask]:='1'; - if IFD.Compression<>TiffCompressionNone then - CurImg.Extra[TiffCompression]:=IntToStr(IFD.Compression); - - {$ifdef FPC_Debug_Image} - if Debug then - WriteTiffExtras('SetFPImgExtras', CurImg); - {$endif} -end; - -procedure TBGRAReaderTiff.ReadImgValue(BitCount: Word; - var Run: Pointer; var BitPos: Byte; FillOrder: LongWord; - Predictor: word; var LastValue: word; out Value: Word); -var - BitNumber: byte; - Byte1, Byte2: byte; -begin - case BitCount of - 1: - begin - if FillOrder = 2 then - BitNumber:=BitPos //Leftmost pixel starts with bit 0 - else - BitNumber:=7-BitPos; //Leftmost pixel starts with bit 7 - Value:=((PCUInt8(Run)^) and (1 shl BitNumber) shr BitNumber); - inc(BitPos); - if BitPos = 8 then - begin - BitPos := 0; - inc(Run); //next byte when all bits read - end; - if Predictor = 2 then Value := (LastValue+Value) and 1; - LastValue:=Value; - if Value > 0 then Value := $ffff; - end; - 4: - begin - if BitPos = 0 then - begin - Value := PCUInt8(Run)^ shr 4; - BitPos := 4; - end - else - begin - Value := PCUInt8(Run)^ and 15; - BitPos := 0; - Inc(Run); - end; - if Predictor = 2 then Value := (LastValue+Value) and $f; - LastValue:=Value; - Value := Value + (value shl 4) + (value shl 8) + (value shl 12); - end; - 8: - begin - Value:=PCUInt8(Run)^; - inc(Run); - if Predictor = 2 then Value := (LastValue+Value) and $ff; - LastValue:=Value; - Value:=Value shl 8+Value; - end; - 12: - begin - Byte1 := PCUInt8(Run)^; - Byte2 := PCUInt8(Run+1)^; - if BitPos = 0 then begin - Value := (Byte1 shl 4) or (Byte2 shr 4); - inc(Run); - BitPos := 4; - end else begin - Value := ((Byte1 and $0F) shl 8) or Byte2; - inc(Run, 2); - BitPos := 0; - end; - if Predictor = 2 then Value := (LastValue+Value) and $fff; - LastValue:=Value; - Value := (Value shl 4) + (Value shr 8); - end; - 16: - begin - Value:=FixEndian(PCUInt16(Run)^); - inc(Run,2); - if Predictor = 2 then Value := (LastValue+Value) and $ffff; - LastValue:=Value; - end; - end; -end; - -procedure TBGRAReaderTiff.SetStreamPos(p: LongWord); -var - NewPosition: int64; -begin - NewPosition:=Int64(p)+fStartPos; - if NewPosition>s.Size then - TiffError('Offset outside of stream'); - s.Position:=NewPosition; -end; - -procedure TBGRAReaderTiff.LoadFromStream(aStream: TStream; AutoClear: boolean); -var - i: Integer; - aContinue: Boolean; -begin - if AutoClear then - Clear; - aContinue:=true; - Progress(psStarting, 0, False, Rect(0,0,0,0), '', aContinue); - if not aContinue then exit; - LoadHeaderFromStream(aStream); - LoadIFDsFromStream; - for i := 0 to ImageCount-1 do - begin - Progress(psRunning, (i+1)*100 div (ImageCount+1), False, Rect(0,0,0,0), - IntToStr(i+1)+'/'+IntToStr(ImageCount), aContinue); - LoadImageFromStream(i); - end; - Progress(psEnding, 100, False, Rect(0,0,0,0), '', aContinue); - ReleaseStream; -end; - -procedure TBGRAReaderTiff.LoadHeaderFromStream(aStream: TStream); -begin - FFirstIFDStart:=0; - s:=aStream; - fStartPos:=s.Position; - ReadTiffHeader(false,FFirstIFDStart); -end; - -procedure TBGRAReaderTiff.LoadIFDsFromStream; -var - i,j: Integer; - IFDStart: LongWord; - IFD: TTiffIFD; -begin - IFDStart:=FirstIFDStart; - i:=0; - while IFDStart>0 do begin - for j := 0 to i-1 do - if Images[j].IFDStart = IFDStart then exit; //IFD cycle detected - - if ImageCount=i then - begin - IFD := TTiffIFD.Create; - ImageList.Add(IFD); - end else - IFD:=Images[i]; - IFDStart:=ReadIFD(IFDStart, IFD); - inc(i); - end; -end; - -function TBGRAReaderTiff.FirstImg: TTiffIFD; -begin - Result:=nil; - if (ImageList=nil) or (ImageList.Count=0) then exit; - Result:=TTiffIFD(ImageList[0]); -end; - -function TBGRAReaderTiff.GetBiggestImage: TTiffIFD; -var - Size: Int64; - IFD: TTiffIFD; - CurSize: int64; - i: Integer; -begin - Result:=nil; - Size:=0; - for i:=0 to ImageCount-1 do begin - IFD:=Images[i]; - CurSize:=Int64(IFD.ImageWidth)*IFD.ImageHeight; - if CurSize 65535 then - TiffError('expected PhotometricInterpretation, but found '+IntToStr(UValue)); - IFD.PhotoMetricInterpretation:=UValue; - {$ifdef FPC_Debug_Image} - if Debug then begin - write('TBGRAReaderTiff.ReadDirectoryEntry Tag 262: PhotometricInterpretation='); - case IFD.PhotoMetricInterpretation of - 0: write('0=bilevel grayscale 0 is white'); - 1: write('1=bilevel grayscale 0 is black'); - 2: write('2=RGB 0,0,0 is black'); - 3: write('3=Palette color'); - 4: write('4=Transparency Mask'); - 5: write('5=CMYK 8bit'); - 8: write('8=L*a*b* with a and b [-128;127]'); - 9: write('9=L*a*b* with a and b [0;255]'); - end; - writeln; - end; - {$endif} - end; - 263: - begin - // Tresholding - UValue:=ReadEntryUnsigned; - case UValue of - 1: ; // no dithering or halftoning was applied - 2: ; // an ordered dithering or halftoning was applied - 3: ; // a randomized dithering or halftoning was applied - else - TiffError('expected Tresholding, but found '+IntToStr(UValue)); - end; - IFD.Tresholding:=UValue; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 263: Tresholding=',IFD.Tresholding); - {$endif} - end; - 264: - begin - // CellWidth - IFD.CellWidth:=ReadEntryUnsigned; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 264: CellWidth=',IFD.CellWidth); - {$endif} - end; - 265: - begin - // CellLength - IFD.CellLength:=ReadEntryUnsigned; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 265: CellLength=',IFD.CellLength); - {$endif} - end; - 266: - begin - // FillOrder - UValue:=ReadEntryUnsigned; - case UValue of - 1: IFD.FillOrder:=1; // left to right = high to low - 2: IFD.FillOrder:=2; // left to right = low to high - else - TiffError('expected FillOrder, but found '+IntToStr(UValue)); - end; - {$ifdef FPC_Debug_Image} - if Debug then begin - write('TBGRAReaderTiff.ReadDirectoryEntry Tag 266: FillOrder=',IntToStr(IFD.FillOrder),'='); - case IFD.FillOrder of - 1: write('left to right = high to low'); - 2: write('left to right = low to high'); - end; - writeln; - end; - {$endif} - end; - 269: - begin - // DocumentName - IFD.DocumentName:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 269: DocumentName=',IFD.DocumentName); - {$endif} - end; - 270: - begin - // ImageDescription - IFD.ImageDescription:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 270: ImageDescription=',IFD.ImageDescription); - {$endif} - end; - 271: - begin - // Make - scanner manufacturer - IFD.Make_ScannerManufacturer:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 271: Make_ScannerManufacturer=',IFD.Make_ScannerManufacturer); - {$endif} - end; - 272: - begin - // Model - scanner model - IFD.Model_Scanner:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 272: Model_Scanner=',IFD.Model_Scanner); - {$endif} - end; - 273: - begin - // StripOffsets (store offset to entity, not the actual contents of the offsets) - IFD.StripOffsets:=GetPos; //Store position of entity so we can look up multiple offsets later - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 273: StripOffsets, offset for entry=',IFD.StripOffsets); - {$endif} - end; - 274: - begin - // Orientation - UValue:=ReadEntryUnsigned; - case UValue of - 1: ;// 0,0 is left, top - 2: ;// 0,0 is right, top - 3: ;// 0,0 is right, bottom - 4: ;// 0,0 is left, bottom - 5: ;// 0,0 is top, left (rotated) - 6: ;// 0,0 is top, right (rotated) - 7: ;// 0,0 is bottom, right (rotated) - 8: ;// 0,0 is bottom, left (rotated) - else - TiffError('expected Orientation, but found '+IntToStr(UValue)); - end; - IFD.Orientation:=UValue; - {$ifdef FPC_Debug_Image} - if Debug then begin - write('TBGRAReaderTiff.ReadDirectoryEntry Tag 274: Orientation=',IntToStr(IFD.Orientation),'='); - case IFD.Orientation of - 1: write('0,0 is left, top'); - 2: write('0,0 is right, top'); - 3: write('0,0 is right, bottom'); - 4: write('0,0 is left, bottom'); - 5: write('0,0 is top, left (rotated)'); - 6: write('0,0 is top, right (rotated)'); - 7: write('0,0 is bottom, right (rotated)'); - 8: write('0,0 is bottom, left (rotated)'); - end; - writeln; - end; - {$endif} - end; - 277: - begin - // SamplesPerPixel - IFD.SamplesPerPixel:=ReadEntryUnsigned; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 277: SamplesPerPixel=',IFD.SamplesPerPixel); - {$endif} - end; - 278: - begin - // RowsPerStrip - UValue:=ReadEntryUnsigned; - if UValue=0 then - TiffError('expected RowsPerStrip, but found '+IntToStr(UValue)); - IFD.RowsPerStrip:=UValue; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 278: RowsPerStrip=',IFD.RowsPerStrip); - {$endif} - end; - 279: - begin - // StripByteCounts (the number of bytes in each strip). - // We're storing the position of the tag, not the various bytecounts themselves - IFD.StripByteCounts:=GetPos; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 279: StripByteCounts, offset for entry=',IFD.StripByteCounts); - {$endif} - end; - 280: - begin - // MinSampleValue - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 280: skipping MinSampleValue'); - {$endif} - end; - 281: - begin - // MaxSampleValue - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 281: skipping MaxSampleValue'); - {$endif} - end; - 282: - begin - // XResolution - IFD.XResolution:=ReadEntryRational; - {$ifdef FPC_Debug_Image} - try - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 282: XResolution=',IFD.XResolution.Numerator,'/',IFD.XResolution.Denominator,'=',IFD.XResolution.Numerator/IFD.XResolution.Denominator); - except - //ignore division by 0 - end; - {$endif} - end; - 283: - begin - // YResolution - IFD.YResolution:=ReadEntryRational; - {$ifdef FPC_Debug_Image} - try - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 283: YResolution=',IFD.YResolution.Numerator,'/',IFD.YResolution.Denominator,'=',IFD.YResolution.Numerator/IFD.YResolution.Denominator); - except - //ignore division by 0 - end; {$endif} - end; - 284: - begin - // PlanarConfiguration - SValue:=ReadEntrySigned; - case SValue of - TiffPlanarConfigurationChunky: ; // 1 - TiffPlanarConfigurationPlanar: ; // 2 - else - TiffError('expected PlanarConfiguration, but found '+IntToStr(SValue)); - end; - IFD.PlanarConfiguration:=SValue; - {$ifdef FPC_Debug_Image} - if Debug then begin - write('TBGRAReaderTiff.ReadDirectoryEntry Tag 284: PlanarConfiguration='); - case SValue of - TiffPlanarConfigurationChunky: write('chunky format'); - TiffPlanarConfigurationPlanar: write('planar format'); - end; - writeln; - end; - {$endif} - end; - 285: - begin - // PageName - IFD.PageName:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 285: PageName="'+IFD.PageName+'"'); - {$endif} - end; - 288: - begin - // FreeOffsets - // The free bytes in a tiff file are described with FreeByteCount and FreeOffsets - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 288: skipping FreeOffsets'); - {$endif} - end; - 289: - begin - // FreeByteCount - // The free bytes in a tiff file are described with FreeByteCount and FreeOffsets - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 289: skipping FreeByteCount'); - {$endif} - end; - 290: - begin - // GrayResponseUnit - // precision of GrayResponseCurve - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 290: skipping GrayResponseUnit'); - {$endif} - end; - 291: - begin - // GrayResponseCurve - // the optical density for each possible pixel value - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 291: skipping GrayResponseCurve'); - {$endif} - end; - 296: - begin - // fResolutionUnit - UValue:=ReadEntryUnsigned; - case UValue of - 1: IFD.ResolutionUnit:=1; // none - 2: IFD.ResolutionUnit:=2; // inch - 3: IFD.ResolutionUnit:=3; // centimeter - else - TiffError('expected ResolutionUnit, but found '+IntToStr(UValue)); - end; - {$ifdef FPC_Debug_Image} - if Debug then begin - write('TBGRAReaderTiff.ReadDirectoryEntry Tag 296: ResolutionUnit='); - case IFD.ResolutionUnit of - 1: write('none'); - 2: write('inch'); - 3: write('centimeter'); - end; - writeln; - end; - {$endif} - end; - 297: - begin - // page number (starting at 0) and total number of pages - UValue:=GetPos; - ReadShortValues(UValue,WordBuffer,Count); - try - if Count<>2 then begin - {$ifdef FPC_Debug_Image} - if Debug then begin - write('TBGRAReaderTiff.ReadDirectoryEntry Tag 297: PageNumber/Count: '); - for i:=0 to Count-1 do - write(IntToStr(WordBuffer[i]),' '); - writeln; - end; - {$endif} - TiffError('PageNumber Count=2 expected, but found '+IntToStr(Count)); - end; - IFD.PageNumber:=WordBuffer[0]; - IFD.PageCount:=WordBuffer[1]; - if IFD.PageNumber>=IFD.PageCount then begin - // broken order => repair - UValue:=IFD.PageNumber; - IFD.PageNumber:=IFD.PageCount; - IFD.PageCount:=UValue; - end; - finally - ReAllocMem(WordBuffer,0); - end; - {$ifdef FPC_Debug_Image} - if Debug then begin - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 297: PageNumber=',IFD.PageNumber,'/',IFD.PageCount); - end; - {$endif} - end; - 305: - begin - // Software - IFD.Software:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 305: Software="',IFD.Software,'"'); - {$endif} - end; - 306: - begin - // DateAndTime - IFD.DateAndTime:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 306: DateAndTime="',IFD.DateAndTime,'"'); - {$endif} - end; - 315: - begin - // Artist - IFD.Artist:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 315: Artist="',IFD.Artist,'"'); - {$endif} - end; - 316: - begin - // HostComputer - IFD.HostComputer:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 316: HostComputer="',IFD.HostComputer,'"'); - {$endif} - end; - 317: - begin - // Predictor - UValue:=word(ReadEntryUnsigned); - case UValue of - 1: ; - 2: ; - else TiffError('expected Predictor, but found '+IntToStr(UValue)); - end; - IFD.Predictor:=UValue; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 317: Predictor="',IFD.Predictor,'"'); - {$endif} - end; - 320: - begin - // ColorMap: N = 3*2^BitsPerSample - IFD.ColorMap:=GetPos; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 320: skipping ColorMap'); - {$endif} - end; - 322: - begin - // TileWidth - IFD.TileWidth:=ReadEntryUnsigned; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 322: TileWidth=',IFD.TileWidth); - {$endif} - if IFD.TileWidth=0 then - TiffError('TileWidth=0'); - end; - 323: - begin - // TileLength = TileHeight - IFD.TileLength:=ReadEntryUnsigned; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 323: TileLength=',IFD.TileLength); - {$endif} - if IFD.TileLength=0 then - TiffError('TileLength=0'); - end; - 324: - begin - // TileOffsets - IFD.TileOffsets:=GetPos; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 324: TileOffsets=',IFD.TileOffsets); - {$endif} - if IFD.TileOffsets=0 then - TiffError('TileOffsets=0'); - end; - 325: - begin - // TileByteCounts - IFD.TileByteCounts:=GetPos; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 325: TileByteCounts=',IFD.TileByteCounts); - {$endif} - if IFD.TileByteCounts=0 then - TiffError('TileByteCounts=0'); - end; - 338: - begin - // ExtraSamples: if SamplesPerPixel is bigger than PhotometricInterpretation - // then ExtraSamples is an array defining the extra samples - // 0=unspecified - // 1=alpha (premultiplied) - // 2=alpha (unassociated) - IFD.ExtraSamples:=GetPos; - {$ifdef FPC_Debug_Image} - if Debug then begin - ReadShortValues(IFD.ExtraSamples,WordBuffer,Count); - write('TBGRAReaderTiff.ReadDirectoryEntry Tag 338: ExtraSamples: '); - for i:=0 to Count-1 do - write(IntToStr(WordBuffer[i]),' '); - writeln; - ReAllocMem(WordBuffer,0); - end; - {$endif} - end; - 347: - begin - // ToDo: JPEGTables - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 347: skipping JPEG Tables'); - {$endif} - end; - 512: - begin - // ToDo: JPEGProc - // short - // 1 = baseline sequential - // 14 = lossless process with Huffman encoding - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 512: skipping JPEGProc'); - {$endif} - end; - 513: - begin - // ToDo: JPEGInterchangeFormat - // long - // non zero: start of start of image SOI marker - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 513: skipping JPEGInterchangeFormat'); - {$endif} - end; - 514: - begin - // ToDo: JPEGInterchangeFormatLength - // long - // length in bytes of 513 - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 514: skipping JPEGInterchangeFormatLength'); - {$endif} - end; - 515: - begin - // ToDo: JPEGRestartInterval - // short - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 515: skipping JPEGRestartInterval'); - {$endif} - end; - 517: - begin - // ToDo: JPEGLosslessPredictor - // short - // Count: SamplesPerPixels - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 517: skipping JPEGLosslessPredictor'); - {$endif} - end; - 518: - begin - // ToDo: JPEGPointTransforms - // short - // Count: SamplesPerPixels - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 518: skipping JPEGPointTransforms'); - {$endif} - end; - 519: - begin - // ToDo: JPEGQTables - // long - // Count: SamplesPerPixels - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 519: skipping JPEGQTables'); - {$endif} - end; - 520: - begin - // ToDo: JPEGDCTables - // long - // Count: SamplesPerPixels - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 520: skipping JPEGDCTables'); - {$endif} - end; - 521: - begin - // ToDo: JPEGACTables - // long - // Count: SamplesPerPixels - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 521: skipping JPEGACTables'); - {$endif} - end; - 530: - begin - // ToDo: YCbCrSubSampling alias ChromaSubSampling - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 530: skipping YCbCrSubSampling alias ChromaSubSampling'); - {$endif} - end; - 700: - begin - // ToDo: XMP - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 700: skipping XMP'); - {$endif} - end; - 33432: - begin - // Copyright - IFD.Copyright:=ReadEntryString; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 33432: Copyright="',IFD.Copyright,'"'); - {$endif} - end; - 34675: - begin - // ToDo: ICC Profile - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag 34675: skipping ICC profile'); - {$endif} - end; - else - begin - EntryType:=ReadWord; - EntryCount:=ReadDWord; - EntryStart:=ReadDWord; - if (EntryType=0) and (EntryCount=0) and (EntryStart=0) then ; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.ReadDirectoryEntry Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart); - {$endif} - end; - end; -end; - -function TBGRAReaderTiff.ReadEntryUnsigned: LongWord; -var - EntryCount: LongWord; - EntryType: Word; -begin - Result:=0; - EntryType:=ReadWord; - EntryCount:=ReadDWord; - if EntryCount<>1 then - TiffError('EntryCount=1 expected, but found '+IntToStr(EntryCount)); - //writeln('TBGRAReaderTiff.ReadEntryUnsigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]); - case EntryType of - 1: begin - // byte: 8bit unsigned - Result:=ReadByte; - end; - 3: begin - // short: 16bit unsigned - Result:=ReadWord; - end; - 4: begin - // long: 32bit unsigned long - Result:=ReadDWord; - end; - else - TiffError('expected single unsigned value, but found type='+IntToStr(EntryType)); - end; -end; - -function TBGRAReaderTiff.ReadEntrySigned: Cint32; -var - EntryCount: LongWord; - EntryType: Word; -begin - Result:=0; - EntryType:=ReadWord; - EntryCount:=ReadDWord; - if EntryCount<>1 then - TiffError('EntryCount+1 expected, but found '+IntToStr(EntryCount)); - //writeln('TBGRAReaderTiff.ReadEntrySigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]); - case EntryType of - 1: begin - // byte: 8bit unsigned - Result:=cint8(ReadByte); - end; - 3: begin - // short: 16bit unsigned - Result:=cint16(ReadWord); - end; - 4: begin - // long: 32bit unsigned long - Result:=cint32(ReadDWord); - end; - 6: begin - // sbyte: 8bit signed - Result:=cint8(ReadByte); - end; - 8: begin - // sshort: 16bit signed - Result:=cint16(ReadWord); - end; - 9: begin - // slong: 32bit signed long - Result:=cint32(ReadDWord); - end; - else - TiffError('expected single signed value, but found type='+IntToStr(EntryType)); - end; -end; - -function TBGRAReaderTiff.ReadEntryRational: TTiffRational; -var - EntryCount: LongWord; - EntryStart: LongWord; - EntryType: Word; -begin - Result:=TiffRational0; - EntryType:=ReadWord; - EntryCount:=ReadDWord; - if EntryCount<>1 then - TiffError('EntryCount+1 expected, but found '+IntToStr(EntryCount)); - //writeln('TBGRAReaderTiff.ReadEntryUnsigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]); - case EntryType of - 1: begin - // byte: 8bit unsigned - Result.Numerator:=ReadByte; - end; - 3: begin - // short: 16bit unsigned - Result.Numerator:=ReadWord; - end; - 4: begin - // long: 32bit unsigned long - Result.Numerator:=ReadDWord; - end; - 5: begin - // rational: Two longs: numerator + denominator - // this does not fit into 4 bytes - EntryStart:=ReadDWord; - SetStreamPos(EntryStart); - Result.Numerator:=ReadDWord; - Result.Denominator:=ReadDWord; - end; - else - TiffError('expected rational unsigned value, but found type='+IntToStr(EntryType)); - end; -end; - -function TBGRAReaderTiff.ReadEntryString: string; -var - EntryType: Word; - EntryCount: LongWord; - EntryStart: LongWord; -begin - Result:=''; - EntryType:=ReadWord; - if EntryType<>2 then - TiffError('asciiz expected, but found '+IntToStr(EntryType)); - EntryCount:=ReadDWord; - SetLength(Result,EntryCount-1); - if EntryCount>4 then begin - // long string -> next 4 LongWord is the offset - EntryStart:=ReadDWord; - SetStreamPos(EntryStart); - s.Read(Result[1],EntryCount-1); - end else begin - // short string -> stored directly in the next 4 bytes - if Result<>'' then - s.Read(Result[1],length(Result)); - // skip rest of 4 bytes - if length(Result)<4 then - s.Read(EntryStart,4-length(Result)); - end; -end; - -function TBGRAReaderTiff.ReadByte: Byte; -begin - Result:=s.ReadByte; -end; - -function TBGRAReaderTiff.ReadWord: Word; -begin - Result:=FixEndian(s.ReadWord); -end; - -function TBGRAReaderTiff.ReadDWord: LongWord; -begin - Result:=FixEndian(s.ReadDWord); -end; - -procedure TBGRAReaderTiff.ReadValues(StreamPos: LongWord; out EntryType: word; out - EntryCount: LongWord; out Buffer: Pointer; out ByteCount: PtrUInt); -var - EntryStart: LongWord; -begin - Buffer:=nil; - ByteCount:=0; - EntryType:=0; - EntryCount:=0; - SetStreamPos(StreamPos); - ReadWord; // skip tag - EntryType:=ReadWord; - EntryCount:=ReadDWord; - if EntryCount=0 then exit; - case EntryType of - 1,6,7: ByteCount:=EntryCount; // byte - 2: ByteCount:=EntryCount; // asciiz - 3,8: ByteCount:=2*EntryCount; // short - 4,9: ByteCount:=4*EntryCount; // long - 5,10: ByteCount:=8*EntryCount; // rational - 11: ByteCount:=4*EntryCount; // single - 12: ByteCount:=8*EntryCount; // double - else - TiffError('invalid EntryType '+IntToStr(EntryType)); - end; - if ByteCount>4 then begin - EntryStart:=ReadDWord; - SetStreamPos(EntryStart); - end; - GetMem(Buffer,ByteCount); - s.Read(Buffer^,ByteCount); -end; - -procedure TBGRAReaderTiff.ReadShortOrLongValues(StreamPos: LongWord; out - Buffer: PLongWord; out Count: LongWord); -var - p: Pointer; - ByteCount: PtrUInt; - EntryType: word; - i: LongWord; -begin - Buffer:=nil; - Count:=0; - p:=nil; - try - ReadValues(StreamPos,EntryType,Count,p,ByteCount); - if Count=0 then exit; - if EntryType=3 then begin - // short - GetMem(Buffer,SizeOf(LongWord)*Count); - for i:=0 to Count-1 do - Buffer[i]:=FixEndian(PWord(p)[i]); - end else if EntryType=4 then begin - // long - Buffer:=p; - p:=nil; - if FReverseEndian then - for i:=0 to Count-1 do - Buffer[i]:=FixEndian(PLongWord(Buffer)[i]); - end else - TiffError('only short or long allowed'); - finally - if p<>nil then FreeMem(p); - end; -end; - -procedure TBGRAReaderTiff.ReadShortValues(StreamPos: LongWord; out Buffer: PWord; - out Count: LongWord); -var - p: Pointer; - ByteCount: PtrUInt; - EntryType: word; - i: LongWord; -begin - Buffer:=nil; - Count:=0; - p:=nil; - try - ReadValues(StreamPos,EntryType,Count,p,ByteCount); - //writeln('ReadShortValues ',FReverseEndian,' ',EntryType,' Count=',Count,' ByteCount=',ByteCount); - if Count=0 then exit; - if EntryType=3 then begin - // short - Buffer:=p; - p:=nil; - if FReverseEndian then - for i:=0 to Count-1 do - Buffer[i]:=FixEndian(Buffer[i]); - //for i:=0 to Count-1 do writeln(i,' ',Buffer[i]); - end else - TiffError('only short allowed, but found '+IntToStr(EntryType)); - finally - if p<>nil then FreeMem(p); - end; -end; - -procedure TBGRAReaderTiff.LoadImageFromStream(Index: integer); -var - IFD: TTiffIFD; -begin - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.LoadImageFromStream Index=',Index); - {$endif} - IFD:=Images[Index]; - LoadImageFromStream(IFD); -end; - -procedure TBGRAReaderTiff.LoadImageFromStream(IFD: TTiffIFD); -var - SampleCnt: LongWord; - SampleBits: PWord; - ChannelValues, LastChannelValues: array of word; - All8Bit, All16Bit: boolean; - - procedure CheckBitCount; - var - Channel: LongWord; - begin - All8Bit := true; - All16Bit := true; - for Channel := 0 to SampleCnt-1 do - begin - if SampleBits[Channel] <> 8 then All8Bit:= false; - if SampleBits[Channel] <> 16 then All16Bit:= false; - end; - end; - -var - PaletteCnt,PaletteStride: LongWord; - PaletteValues: PWord; - - AlphaChannel: integer; - PremultipliedAlpha: boolean; - - procedure InitColor; - var Channel: LongWord; - begin - SetLength(ChannelValues, SampleCnt); - SetLength(LastChannelValues, SampleCnt); - for Channel := 0 to SampleCnt-1 do - LastChannelValues[Channel] := 0; - end; - - procedure ReadNext16BitData(var Run: Pointer); - var Channel: PtrUInt; - begin - if FReverseEndian then - begin - if IFD.Predictor=2 then - begin - for Channel := 0 to SampleCnt-1 do - begin - {$PUSH}{$Q-} - Inc(ChannelValues[Channel],Swap(Word(Run^))); - {$POP} - inc(Run, 2); - end; - end else - begin - for Channel := 0 to SampleCnt-1 do - begin - ChannelValues[Channel] := Swap(Word(Run^)); - inc(Run, 2); - end; - end; - end else - begin - if IFD.Predictor=2 then - begin - for Channel := 0 to SampleCnt-1 do - begin - {$PUSH}{$Q-} - Inc(ChannelValues[Channel],Word(Run^)); - {$POP} - inc(Run, 2); - end; - end else - begin - for Channel := 0 to SampleCnt-1 do - begin - ChannelValues[Channel] := Word(Run^); - inc(Run, 2); - end; - end; - end; - end; - - procedure ReadNext8BitData(var Run: Pointer); - var Channel: PtrUInt; - begin - if IFD.Predictor=2 then - begin - for Channel := 0 to SampleCnt-1 do - begin - {$PUSH}{$Q-} - LastChannelValues[Channel] := (LastChannelValues[Channel]+Byte(Run^)) and $ff; - ChannelValues[Channel] := LastChannelValues[Channel]+(LastChannelValues[Channel] shl 8); - {$POP} - inc(Run); - end; - end else - begin - for Channel := 0 to SampleCnt-1 do - begin - ChannelValues[Channel] := Byte(Run^)+(Byte(Run^) shl 8); - inc(Run); - end; - end; - end; - - procedure ReadNextPixelData(var Run: Pointer; var BitPos: byte); - var Channel: LongWord; - begin - for Channel := 0 to SampleCnt-1 do - ReadImgValue(SampleBits[Channel], Run,BitPos,IFD.FillOrder, - IFD.Predictor,LastChannelValues[Channel], - ChannelValues[Channel]); - end; - - procedure GetPixelAsLab(out lab: TLabA); - begin - lab.L := 0; - lab.a := 0; - lab.b := 0; - lab.alpha := 1; - - case IFD.PhotoMetricInterpretation of - 8: begin - case IFD.GrayBits of - 8,16: lab.L := ChannelValues[0]*(100/65535); - 0:begin - lab.L := ChannelValues[0]*(100/65535); - case IFD.RedBits of - 16: lab.a := SmallInt(ChannelValues[1])/256; - 8: lab.a := ShortInt(ChannelValues[1] shr 8); - end; - case IFD.BlueBits of - 16: lab.b := SmallInt(ChannelValues[2])/256; - 8: lab.b := ShortInt(ChannelValues[2] shr 8); - end; - end; - end; - end; - 9: begin - case IFD.GrayBits of - 16: lab.L := ChannelValues[0]*(100/65280); - 8: lab.L := ChannelValues[0]*(100/65535); - 0:begin - case IFD.GreenBits of - 16: lab.L := ChannelValues[0]*(100/65280); - 8: lab.L := ChannelValues[0]*(100/65535); - end; - case IFD.RedBits of - 16: lab.a := (ChannelValues[1]-32768)/256; - 8: lab.a := (ChannelValues[1] shr 8)-128; - end; - case IFD.BlueBits of - 16: lab.b := (ChannelValues[2]-32768)/256; - 8: lab.b := (ChannelValues[2] shr 8)-128; - end; - end; - end; - end; - //10: ITULAB: ITU L*a*b* - //32844: LOGL: CIE Log2(L) - //32845: LOGLUV: CIE Log2(L) (u',v') - else - TiffError('PhotometricInterpretation='+IntToStr(IFD.PhotoMetricInterpretation)+' not supported'); - end; - - if AlphaChannel >= 0 then - lab.alpha:= ChannelValues[AlphaChannel]/65535; - end; - -var - FPColorValue: TFPColor; - - procedure GetPixelAsFPColor; - var PaletteIndex: LongWord; - GrayValue: Word; - lab: TLabA; - begin - if IFD.PhotoMetricInterpretation >= 8 then - begin - GetPixelAsLab(lab); - FPColorValue.FromLabA(lab); - exit; - end; - - case IFD.PhotoMetricInterpretation of - 0,1: // 0:bilevel grayscale 0 is white; 1:0 is black - begin - GrayValue := ChannelValues[0]; - if IFD.PhotoMetricInterpretation=0 then - GrayValue:=$ffff-GrayValue; - FPColorValue.red := GrayValue; - FPColorValue.green:= GrayValue; - FPColorValue.blue := GrayValue; - FPColorValue.alpha := alphaOpaque; - end; - - 2: // RGB(A) - begin - FPColorValue.red := ChannelValues[0]; - FPColorValue.green:= ChannelValues[1]; - FPColorValue.blue := ChannelValues[2]; - FPColorValue.alpha := alphaOpaque; - end; - - 3: //3 Palette/color map indexed - begin - PaletteIndex := ChannelValues[0] shr (16 - SampleBits[0]); - FPColorValue.red := PaletteValues[PaletteIndex]; - FPColorValue.green:= PaletteValues[PaletteIndex+PaletteStride]; - FPColorValue.blue := PaletteValues[PaletteIndex+2*PaletteStride]; - FPColorValue.alpha := alphaOpaque; - end; - - //4 Mask/holdout mask (obsolete by TIFF 6.0 specification) - - 5: // CMYK plus optional alpha - FPColorValue:=CMYKToFPColor(ChannelValues[0],ChannelValues[1],ChannelValues[2],ChannelValues[3]); - - //6: YCBCR: CCIR 601 - else - TiffError('PhotometricInterpretation='+IntToStr(IFD.PhotoMetricInterpretation)+' not supported'); - end; - - if AlphaChannel >= 0 then - begin - FPColorValue.alpha:= ChannelValues[AlphaChannel]; - if PremultipliedAlpha and (FPColorValue.alpha <> alphaOpaque) and (FPColorValue.alpha <> 0) then - begin - FPColorValue.red := (FPColorValue.red * alphaOpaque + FPColorValue.alpha div 2) div FPColorValue.alpha; - FPColorValue.green := (FPColorValue.green * alphaOpaque + FPColorValue.alpha div 2) div FPColorValue.alpha; - FPColorValue.blue := (FPColorValue.blue * alphaOpaque + FPColorValue.alpha div 2) div FPColorValue.alpha; - end; - end; - end; - -var - ChunkOffsets: PLongWord; - ChunkByteCounts: PLongWord; - Chunk: PByte; - ChunkCount: LongWord; - ChunkIndex: LongWord; - CurCount: LongWord; - CurOffset: LongWord; - CurByteCnt: PtrInt; - Run: PByte; - BitPos: Byte; - x, y, cx, cy, dx1,dy1, dx2,dy2, sx, sy: integer; - SampleBitsPerPixel: LongWord; - CurFPImg: TFPCustomImage; - aContinue, ConvertFromLab: Boolean; - ExpectedChunkLength: PtrInt; - ChunkType: TTiffChunkType; - TilesAcross, TilesDown: LongWord; - ChunkLeft, ChunkTop, ChunkWidth, ChunkHeight: LongWord; - ChunkBytesPerLine: LongWord; - - LabArray: array of TLabA; - ConversionFromLab: TBridgedConversion; - DestStride: PtrInt; - PDest: PByte; - CurPixelValue: TBGRAPixel; - - procedure ComputeDestStride; - begin - DestStride := dy1*TCustomUniversalBitmap(CurFPImg).RowSize; - if TCustomUniversalBitmap(CurFPImg).LineOrder = riloBottomToTop then - DestStride := -DestStride; - inc(DestStride, dx1*PtrInt(TCustomUniversalBitmap(CurFPImg).Colorspace.GetSize)); - end; - -begin - if (IFD.ImageWidth=0) or (IFD.ImageHeight=0) then - exit; - - if IFD.PhotoMetricInterpretation=High(IFD.PhotoMetricInterpretation) then - TiffError('missing PhotometricInterpretation'); - if IFD.BitsPerSample=0 then - TiffError('missing BitsPerSample'); - if IFD.TileWidth>0 then begin - ChunkType:=tctTile; - if IFD.TileLength=0 then - TiffError('missing TileLength'); - if IFD.TileOffsets=0 then - TiffError('missing TileOffsets'); - if IFD.TileByteCounts=0 then - TiffError('missing TileByteCounts'); - end else begin - ChunkType:=tctStrip; - if IFD.RowsPerStrip=0 then - TiffError('missing RowsPerStrip'); - if IFD.StripOffsets=0 then - TiffError('missing StripOffsets'); - if IFD.StripByteCounts=0 then - TiffError('missing StripByteCounts'); - end; - - if IFD.PlanarConfiguration > 1 then - TiffError('Planar configuration not handled'); - - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.LoadImageFromStream reading ...'); - {$endif} - - ChunkOffsets:=nil; - ChunkByteCounts:=nil; - Chunk:=nil; - SampleBits:=nil; - try - // read chunk starts and sizes - if ChunkType=tctTile then begin - TilesAcross:=(IFD.ImageWidth+IFD.TileWidth-1) div IFD.TileWidth; - TilesDown:=(IFD.ImageHeight+IFD.TileLength-1) div IFD.TileLength; - {$ifdef FPC_Debug_Image} - if Debug then - writeln('TBGRAReaderTiff.LoadImageFromStream TilesAcross=',TilesAcross,' TilesDown=',TilesDown); - {$endif} - ChunkCount := TilesAcross * TilesDown; - ReadShortOrLongValues(IFD.TileOffsets,ChunkOffsets,CurCount); - if CurCount 2) then - begin - ComputeDestStride; - PDest := TBGRACustomBitmap(CurFPImg).GetPixelAddress(sx,sy); - if (IFD.PhotoMetricInterpretation = 0) and (SampleCnt = 1) then - begin - for cx:=0 to ChunkWidth-1 do begin - PBGRAPixel(PDest)^.red:= FastRoundDiv257(not (PWord(Run)^)); - PBGRAPixel(PDest)^.green:= PBGRAPixel(PDest)^.red; - PBGRAPixel(PDest)^.blue:= PBGRAPixel(PDest)^.red; - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run, 2); - inc(PDest, DestStride); - end; - end else - if (IFD.PhotoMetricInterpretation = 1) and (SampleCnt = 1) then - begin - for cx:=0 to ChunkWidth-1 do begin - PBGRAPixel(PDest)^.red:= FastRoundDiv257(PWord(Run)^); - PBGRAPixel(PDest)^.green:= PBGRAPixel(PDest)^.red; - PBGRAPixel(PDest)^.blue:= PBGRAPixel(PDest)^.red; - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run, 2); - inc(PDest, DestStride); - end; - end else - if (IFD.PhotoMetricInterpretation = 2) and (SampleCnt = 3) then - begin - for cx:=0 to ChunkWidth-1 do begin - PBGRAPixel(PDest)^.red:= FastRoundDiv257(PWord(Run)^); - PBGRAPixel(PDest)^.green:= FastRoundDiv257(PWord(Run+2)^); - PBGRAPixel(PDest)^.blue:= FastRoundDiv257(PWord(Run+4)^); - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run, 6); - inc(PDest, DestStride); - end; - end else - for cx:=0 to ChunkWidth-1 do begin - ReadNext16BitData(Run); - GetPixelAsFPColor; - PBGRAPixel(PDest)^.red:= FastRoundDiv257(FPColorValue.red); - PBGRAPixel(PDest)^.green:= FastRoundDiv257(FPColorValue.green); - PBGRAPixel(PDest)^.blue:= FastRoundDiv257(FPColorValue.blue); - PBGRAPixel(PDest)^.alpha:= FastRoundDiv257(FPColorValue.alpha); - inc(PDest, DestStride); - end; - end else - for cx:=0 to ChunkWidth-1 do begin - ReadNext16BitData(Run); - GetPixelAsFPColor; - CurFPImg.Colors[x,y]:= FPColorValue; - // next column - inc(x,dx1); - inc(y,dy1); - end; - end else - if All8Bit then - begin - if CurFPImg is TBGRACustomBitmap then - begin - ComputeDestStride; - PDest := TBGRACustomBitmap(CurFPImg).GetPixelAddress(sx,sy); - if (IFD.PhotoMetricInterpretation = 0) and (SampleCnt = 1) then - begin - if IFD.Predictor = 2 then - begin - CurPixelValue := BGRAPixelTransparent; - for cx:=0 to ChunkWidth-1 do begin - {$PUSH}{$R-}inc(CurPixelValue.green, run^);{$POP} - PBGRAPixel(PDest)^.red:= not CurPixelValue.green; - PBGRAPixel(PDest)^.green:= not CurPixelValue.green; - PBGRAPixel(PDest)^.blue:= not CurPixelValue.green; - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run); - inc(PDest, DestStride); - end; - end else - for cx:=0 to ChunkWidth-1 do begin - PBGRAPixel(PDest)^.red:= not (Run^); - PBGRAPixel(PDest)^.green:= not (Run^); - PBGRAPixel(PDest)^.blue:= not (Run^); - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run); - inc(PDest, DestStride); - end; - end else - if (IFD.PhotoMetricInterpretation = 1) and (SampleCnt = 1) then - begin - if IFD.Predictor = 2 then - begin - CurPixelValue := BGRAPixelTransparent; - for cx:=0 to ChunkWidth-1 do begin - {$PUSH}{$R-}inc(CurPixelValue.green, run^);{$POP} - PBGRAPixel(PDest)^.red:= CurPixelValue.green; - PBGRAPixel(PDest)^.green:= CurPixelValue.green; - PBGRAPixel(PDest)^.blue:= CurPixelValue.green; - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run); - inc(PDest, DestStride); - end; - end else - for cx:=0 to ChunkWidth-1 do begin - PBGRAPixel(PDest)^.red:= Run^; - PBGRAPixel(PDest)^.green:= Run^; - PBGRAPixel(PDest)^.blue:= Run^; - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run); - inc(PDest, DestStride); - end; - end else - if (IFD.PhotoMetricInterpretation = 2) and (SampleCnt = 3) then - begin - if IFD.Predictor = 2 then - begin - CurPixelValue := BGRAPixelTransparent; - for cx:=0 to ChunkWidth-1 do begin - {$PUSH}{$R-}inc(CurPixelValue.red, run^);{$POP} - {$PUSH}{$R-}inc(CurPixelValue.green, (run+1)^);{$POP} - {$PUSH}{$R-}inc(CurPixelValue.blue, (run+2)^);{$POP} - PBGRAPixel(PDest)^.red:= CurPixelValue.red; - PBGRAPixel(PDest)^.green:= CurPixelValue.green; - PBGRAPixel(PDest)^.blue:= CurPixelValue.blue; - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run,3); - inc(PDest, DestStride); - end; - end else - for cx:=0 to ChunkWidth-1 do begin - PBGRAPixel(PDest)^.red:= Run^; - PBGRAPixel(PDest)^.green:= (Run+1)^; - PBGRAPixel(PDest)^.blue:= (Run+2)^; - PBGRAPixel(PDest)^.alpha:= 255; - inc(Run,3); - inc(PDest, DestStride); - end; - end else - for cx:=0 to ChunkWidth-1 do begin - ReadNext8BitData(Run); - GetPixelAsFPColor; - PBGRAPixel(PDest)^.red:= FPColorValue.red shr 8; - PBGRAPixel(PDest)^.green:= FPColorValue.green shr 8; - PBGRAPixel(PDest)^.blue:= FPColorValue.blue shr 8; - PBGRAPixel(PDest)^.alpha:= FPColorValue.alpha shr 8; - inc(PDest, DestStride); - end; - end else - for cx:=0 to ChunkWidth-1 do begin - ReadNext8BitData(Run); - GetPixelAsFPColor; - CurFPImg.Colors[x,y]:= FPColorValue; - // next column - inc(x,dx1); - inc(y,dy1); - end; - end else - begin - for cx:=0 to ChunkWidth-1 do begin - ReadNextPixelData(Run,BitPos); - GetPixelAsFPColor; - CurFPImg.Colors[x,y]:= FPColorValue; - // next column - inc(x,dx1); - inc(y,dy1); - end; - end; - end; - - // next line - inc(sx,dx2); - inc(sy,dy2); - end; - // next chunk - end; - finally - ReAllocMem(SampleBits,0); - ReAllocMem(ChunkOffsets,0); - ReAllocMem(ChunkByteCounts,0); - ReAllocMem(Chunk,0); - ReAllocMem(PaletteValues,0); - end; -end; - -procedure TBGRAReaderTiff.ReleaseStream; -begin - s := nil; -end; - -function TBGRAReaderTiff.FixEndian(w: Word): Word; inline; -begin - if FReverseEndian then - Result:= SwapEndian(w) - else - result:= w; -end; - -function TBGRAReaderTiff.FixEndian(d: LongWord): LongWord; inline; -begin - if FReverseEndian then - Result:= SwapEndian(d) - else - result:= d; -end; - -procedure TBGRAReaderTiff.DecodePackBits(var Buffer: Pointer; var Count: PtrInt); -var - NewBuffer: Pointer; - NewCount: PtrInt; -begin - DecompressPackBits(Buffer,Count,NewBuffer,NewCount); - FreeMem(Buffer); - Buffer:=NewBuffer; - Count:=NewCount; -end; - -procedure TBGRAReaderTiff.DecodeLZW(var Buffer: Pointer; var Count: PtrInt); -var - NewBuffer: Pointer; - NewCount: PtrInt; -begin - DecompressLZW(Buffer,Count,NewBuffer,NewCount); - FreeMem(Buffer); - Buffer:=NewBuffer; - Count:=NewCount; -end; - -procedure TBGRAReaderTiff.DecodeDeflate(var Buffer: Pointer; var Count: PtrInt; - ExpectedCount: PtrInt); -var - NewBuffer: PByte; - NewCount: LongWord; - ErrorMsg: String; -begin - ErrorMsg:=''; - NewBuffer:=nil; - try - NewCount:=ExpectedCount; - if not DecompressDeflate(Buffer,Count,NewBuffer,NewCount,@ErrorMsg) then - TiffError(ErrorMsg); - FreeMem(Buffer); - Buffer:=NewBuffer; - Count:=NewCount; - NewBuffer:=nil; - finally - ReAllocMem(NewBuffer,0); - end; -end; - -procedure TBGRAReaderTiff.InternalRead(Str: TStream; AnImage: TFPCustomImage); -// read the biggest image -var - aContinue: Boolean; - BestIFD: TTiffIFD; -begin - Clear; - - // read header - aContinue:=true; - Progress(psStarting, 0, False, Rect(0,0,0,0), '', aContinue); - if not aContinue then exit; - LoadHeaderFromStream(Str); - LoadIFDsFromStream; - - // find the biggest image - BestIFD := GetBiggestImage; - Progress(psRunning, 25, False, Rect(0,0,0,0), '', aContinue); - if not aContinue then exit; - - // read image - if Assigned(BestIFD) then begin - BestIFD.Img := AnImage; - LoadImageFromStream(BestIFD); - end; - - // end - Progress(psEnding, 100, False, Rect(0,0,0,0), '', aContinue); -end; - -function TBGRAReaderTiff.InternalCheck(Str: TStream): boolean; -var - IFDStart: LongWord; -begin - try - s:=Str; - fStartPos:=s.Position; - Result:=ReadTiffHeader(true,IFDStart) and (IFDStart<>0); - s.Position:=fStartPos; - except - Result:=false; - end; -end; - -procedure TBGRAReaderTiff.DoCreateImage(ImgFileDir: TTiffIFD); -begin - if Assigned(OnCreateImage) then - OnCreateImage(Self,ImgFileDir); -end; - -constructor TBGRAReaderTiff.Create; -begin - ImageList:=TFPList.Create; -end; - -destructor TBGRAReaderTiff.Destroy; -begin - Clear; - FreeAndNil(ImageList); - inherited Destroy; -end; - -procedure TBGRAReaderTiff.Clear; -var - i: Integer; - Img: TTiffIFD; -begin - for i:=ImageCount-1 downto 0 do begin - Img:=Images[i]; - ImageList.Delete(i); - Img.Free; - end; - FReverseEndian:=false; - FreeAndNil(FIFDList); -end; - -procedure DecompressPackBits(Buffer: Pointer; Count: PtrInt; out - NewBuffer: Pointer; out NewCount: PtrInt); -{ Algorithm: - while not got the expected number of bytes - read one byte n - if n in 0..127 copy the next n+1 bytes - else if n in -127..-1 then copy the next byte 1-n times - else continue - end -} -var - p: Pcint8; - n: cint8; - d: pcint8; - i,j: integer; - EndP: Pcint8; -begin - // compute NewCount - NewCount:=0; - NewBuffer:=nil; - if Count=0 then exit; - p:=Pcint8(Buffer); - EndP:=p+Count; - while p CodeBufferLength do - begin - if SrcPos >= Count then - begin - result := EoiCode; - exit; - end; - If BigEndian then - CodeBuffer := (CodeBuffer shl 8) or PByte(Buffer)[SrcPos] - else - CodeBuffer := CodeBuffer or (LongWord(PByte(Buffer)[SrcPos]) shl CodeBufferLength); - Inc(SrcPos); - Inc(CodeBufferLength, 8); - end; - - if BigEndian then - begin - result := CodeBuffer shr (CodeBufferLength-CurBitLength); - Dec(CodeBufferLength, CurBitLength); - CodeBuffer := CodeBuffer and ((1 shl CodeBufferLength) - 1); - end else - begin - result := CodeBuffer and ((1 shl CurBitLength)-1); - Dec(CodeBufferLength, CurBitLength); - CodeBuffer := CodeBuffer shr CurBitLength; - end; - end; - - procedure ClearTable; - var - i: Integer; - begin - for i:=0 to TableCount-1 do - if Table[i].Data <> @Table[i].ShortData then - ReAllocMem(Table[i].Data,0); - TableCount:=0; - end; - - procedure InitializeTable; - begin - CurBitLength:=9; - ClearTable; - end; - - function IsInTable(Code: word): boolean; - begin - Result:=Code<258+TableCount; - end; - - procedure WriteStringFromCode(Code: integer; AddFirstChar: boolean = false); - var - s: TLZWString; - begin - //WriteLn('WriteStringFromCode Code=',Code,' AddFirstChar=',AddFirstChar,' x=',(NewCount div 4) mod IFD.ImageWidth,' y=',(NewCount div 4) div IFD.ImageWidth,' PixelByte=',NewCount mod 4); - if Code<256 then begin - // write byte - s.ShortData[0] := code; - s.Data:=@s.ShortData; - s.Count:=1; - end else if Code>=258 then begin - // write string - if Code-258>=TableCount then - Error('LZW code out of bounds'); - s:=Table[Code-258]; - end else - Error('LZW code out of bounds'); - if NewCount+s.Count+1>NewCapacity then begin - NewCapacity:=NewCapacity*2+8; - ReAllocMem(NewBuffer,NewCapacity); - end; - System.Move(s.Data^,NewBuffer[NewCount],s.Count); - //for i:=0 to s.Count-1 do write(HexStr(NewBuffer[NewCount+i],2)); // debug - inc(NewCount,s.Count); - if AddFirstChar then begin - NewBuffer[NewCount]:=s.Data^; - //write(HexStr(NewBuffer[NewCount],2)); // debug - inc(NewCount); - end; - //writeln(',WriteStringFromCode'); // debug - end; - - procedure AddStringToTable(Code, AddFirstCharFromCode: integer); - // add string from code plus first character of string from code as new string - var - s1, s2: TLZWString; - p: PByte; - NewCount: integer; - begin - //WriteLn('AddStringToTable Code=',Code,' FCFCode=',AddFirstCharFromCode,' TableCount=',TableCount); - //check whether can store more codes or not - if TableCount=high(Table)+1 then exit; - // find string 1 - if Code<256 then begin - // string is byte - s1.ShortData[0] := code; - s1.Data:=@s1.ShortData; - s1.Count:=1; - end else if Code>=258 then begin - // normal string - if Code-258>=TableCount then - Error('LZW code out of bounds'); - s1:=Table[Code-258]; - end else - Error('LZW code out of bounds'); - // find string 2 - if AddFirstCharFromCode<256 then begin - // string is byte - s2.ShortData[0] := AddFirstCharFromCode; - s2.Data:=@s2.ShortData; - s2.Count:=1; - end else begin - // normal string - if AddFirstCharFromCode-258>=TableCount then - Error('LZW code out of bounds'); - s2:=Table[AddFirstCharFromCode-258]; - end; - // set new table entry - NewCount := s1.Count+1; - Table[TableCount].Count:= NewCount; - if NewCount > 4 then - begin - p:=nil; - GetMem(p,NewCount); - end else - p := @Table[TableCount].ShortData; - Table[TableCount].Data:=p; - System.Move(s1.Data^,p^,s1.Count); - // add first character from string 2 - p[s1.Count]:=s2.Data^; - // increase TableCount - inc(TableCount); - case TableCount+258+TableMargin of - 512,1024,2048: begin - //check if there is room for a greater code - if (Count-SrcPos) shl 3 + integer(CodeBufferLength) > integer(CurBitLength) then - inc(CurBitLength); - end; - end; - end; - -begin - NewBuffer:=nil; - NewCount:=0; - if Count=0 then exit; - //WriteLn('DecompressLZW START Count=',Count); - //for SrcPos:=0 to 19 do - // write(HexStr(PByte(Buffer)[SrcPos],2)); - //writeln(); - - NewCapacity:=Count*2; - ReAllocMem(NewBuffer,NewCapacity); - - if PByte(Buffer)[0] = $80 then - begin - BigEndian := true; //endian-ness of LZW is not necessarily consistent with the rest of the file - TableMargin := 1; //keep one free code to be able to write EOI code - end else - begin - BigEndian := false; - TableMargin := 0; - end; - SrcPos:=0; - CurBitLength:=9; - CodeBufferLength := 0; - CodeBuffer := 0; - TableCount:=0; - OldCode := NoCode; - try - repeat - Code:=GetNextCode; - //WriteLn('DecompressLZW Code=',Code); - if Code=EoiCode then break; - if Code=ClearCode then begin - InitializeTable; - Code:=GetNextCode; - //WriteLn('DecompressLZW after clear Code=',Code); - if Code=EoiCode then break; - if Code=ClearCode then - Error('LZW code out of bounds'); - WriteStringFromCode(Code); - OldCode:=Code; - end else begin - if Code NoCode then - AddStringToTable(OldCode,Code); - OldCode:=Code; - end else if (Code=TableCount+258) and (OldCode <> NoCode) then begin - WriteStringFromCode(OldCode,true); - AddStringToTable(OldCode,OldCode); - OldCode:=Code; - end else - Error('LZW code out of bounds'); - end; - until false; - finally - ClearTable; - end; - - ReAllocMem(NewBuffer,NewCount); -end; - -function DecompressDeflate(Compressed: PByte; CompressedCount: LongWord; - out Decompressed: PByte; var DecompressedCount: LongWord; - ErrorMsg: PAnsiString = nil): boolean; -var - stream : z_stream; - err : integer; -begin - Result:=false; - - //writeln('DecompressDeflate START'); - Decompressed:=nil; - if CompressedCount=0 then begin - DecompressedCount:=0; - exit; - end; - - err := inflateInit(stream{%H-}); - if err <> Z_OK then begin - if ErrorMsg<>nil then - ErrorMsg^:='inflateInit failed'; - exit; - end; - - // set input = compressed data - stream.avail_in := CompressedCount; - stream.next_in := Compressed; - - // set output = decompressed data - if DecompressedCount=0 then - DecompressedCount:=CompressedCount; - Getmem(Decompressed,DecompressedCount); - stream.avail_out := DecompressedCount; - stream.next_out := Decompressed; - - // Finish the stream - while TRUE do begin - //writeln('run: total_in=',stream.total_in,' avail_in=',stream.avail_in,' total_out=',stream.total_out,' avail_out=',stream.avail_out); - if (stream.avail_out=0) then begin - // need more space - if DecompressedCount<128 then - DecompressedCount:=DecompressedCount+128 - else if DecompressedCount>High(DecompressedCount)-1024 then begin - if ErrorMsg<>nil then - ErrorMsg^:='inflate decompression failed, because not enough space'; - exit; - end else - DecompressedCount:=DecompressedCount*2; - ReAllocMem(Decompressed,DecompressedCount); - stream.next_out:=Decompressed+stream.total_out; - stream.avail_out:=DecompressedCount-stream.total_out; - end; - err := inflate(stream, Z_NO_FLUSH); - if err = Z_STREAM_END then - break; - if err<>Z_OK then begin - if ErrorMsg<>nil then - ErrorMsg^:='inflate finish failed'; - exit; - end; - end; - - //writeln('decompressed: total_in=',stream.total_in,' total_out=',stream.total_out); - DecompressedCount:=stream.total_out; - ReAllocMem(Decompressed,DecompressedCount); - - err := inflateEnd(stream); - if err<>Z_OK then begin - if ErrorMsg<>nil then - ErrorMsg^:='inflateEnd failed'; - exit; - end; - Result:=true; -end; - -initialization - DefaultBGRAImageReader[ifTiff] := TBGRAReaderTiff; - -end. - diff --git a/components/bgrabitmap/bgrareadwebp.pas b/components/bgrabitmap/bgrareadwebp.pas deleted file mode 100644 index a921f98..0000000 --- a/components/bgrabitmap/bgrareadwebp.pas +++ /dev/null @@ -1,151 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAReadWebP; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPImage; - -type - TWebPHeader = record - RIFFCode: array[1..4] of char; - FileSize: LongWord; - WebPCode: array[1..4] of char; - end; - - { TBGRAReaderWebP } - - TBGRAReaderWebP = class(TFPCustomImageReader) - protected - function ReadHeader(Str: TStream): TWebPHeader; - procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; - function InternalCheck(Str: TStream): boolean; override; - end; - -implementation - -uses libwebp{$ifdef linux}, linuxlib{$endif}, BGRABitmapTypes; - -var - MyLibWebPLoaded: boolean; - -procedure NeedLibWebP; -begin - if not MyLibWebPLoaded then - begin - if not LibWebPLoad({$ifdef linux}FindLinuxLibrary('libwebp.so', 6){$endif}) then - raise exception.Create('Cannot find libwebp library ('+LibWebPFilename+')'); - MyLibWebPLoaded:= true; - end; -end; - -{ TBGRAReaderWebP } - -function TBGRAReaderWebP.ReadHeader(Str: TStream): TWebPHeader; -begin - fillchar({%H-}result, sizeof({%H-}result), 0); - Str.Read(result, sizeof(result)); - result.FileSize:= LEtoN(result.FileSize); -end; - -procedure TBGRAReaderWebP.InternalRead(Str: TStream; Img: TFPCustomImage); -const - CopySize = 65536; -var - header: TWebPHeader; - oldPos: Int64; - mem, p: PByte; - totalSize, remain: LongWord; - toRead, w, h, x, y: integer; - loadInto: TBGRACustomBitmap; - pbgra: PBGRAPixel; - ok: Boolean; -begin - NeedLibWebP; - - oldPos := Str.Position; - header := ReadHeader(Str); - if (header.RIFFCode <> 'RIFF') or (header.WebPCode <> 'WEBP') then - raise exception.Create('Invalid header'); - Str.Position:= OldPos; - totalSize := header.FileSize+8; - getmem(mem, totalSize); - loadInto := nil; - try - p := mem; - remain := totalSize; - while remain > 0 do - begin - if remain > CopySize then toRead := CopySize else - toRead := remain; - Str.ReadBuffer(p^, toRead); - inc(p, toRead); - dec(remain, toRead); - end; - - if WebPGetInfo(mem, totalSize, @w, @h) = 0 then - raise exception.Create('Invalid WebP header'); - - Img.SetSize(w, h); - if Img is TBGRACustomBitmap then - loadInto := TBGRACustomBitmap(Img) - else - loadInto := BGRABitmapFactory.Create(w,h); - {$PUSH}{$WARNINGS OFF} - if TBGRAPixel_RGBAOrder then - ok := WebPDecodeRGBAInto(mem, totalSize, loadInto.DataByte, loadInto.RowSize*h, loadInto.RowSize)<>nil - else - ok := WebPDecodeBGRAInto(mem, totalSize, loadInto.DataByte, loadInto.RowSize*h, loadInto.RowSize)<>nil; - {$POP} - loadInto.InvalidateBitmap; - if not ok then raise exception.Create('Error decoding WebP'); - if loadInto.LineOrder = riloBottomToTop then loadInto.VerticalFlip; - if Img <> loadInto then - begin - for y := 0 to h-1 do - begin - pbgra := loadInto.ScanLine[y]; - for x := 0 to w-1 do - begin - Img.Colors[x,y] := pbgra^.ToFPColor; - inc(pbgra); - end; - end; - end; - finally - if Assigned(loadInto) and (loadInto <> Img) then loadInto.Free; - freemem(mem); - end; -end; - -function TBGRAReaderWebP.InternalCheck(Str: TStream): boolean; -var - oldPos: Int64; - header: TWebPHeader; -begin - oldPos := Str.Position; - try - header := ReadHeader(Str); - result := (header.RIFFCode = 'RIFF') and (header.WebPCode = 'WEBP') and - (header.FileSize <= $FFFFFFF6) and (header.FileSize <= Str.Size-Str.Position+4); - finally - Str.Position:= OldPos; - end; -end; - -initialization - - DefaultBGRAImageReader[ifWebP] := TBGRAReaderWebP; - -finalization - - if MyLibWebPLoaded then - begin - LibWebPUnload; - MyLibWebPLoaded:= false; - end; - -end. - diff --git a/components/bgrabitmap/bgrareadxpm.pas b/components/bgrabitmap/bgrareadxpm.pas deleted file mode 100644 index a9b23ab..0000000 --- a/components/bgrabitmap/bgrareadxpm.pas +++ /dev/null @@ -1,91 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAReadXPM; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPReadXPM, FPimage; - -type - - { TBGRAReaderXPM } - - TBGRAReaderXPM = class(TFPReaderXPM) - protected - procedure InternalRead(Str: TStream; Img: TFPCustomImage); override; - function InternalCheck(Str: TStream): boolean; override; - public - class procedure ConvertToXPM3(ASource: TStream; ADestination: TStream); static; - end; - -implementation - -uses BGRABitmapTypes; - -{ TBGRAReaderXPM } - -procedure TBGRAReaderXPM.InternalRead(Str: TStream; Img: TFPCustomImage); -var tempStream: TMemoryStream; -begin - tempStream := TMemoryStream.Create; - try - ConvertToXPM3(Str, tempStream); - tempStream.Position:= 0; - try - img.UsePalette := true; - inherited InternalRead(tempStream, Img); - finally - end; - finally - tempStream.free; - end; -end; - -function TBGRAReaderXPM.InternalCheck(Str: TStream): boolean; -var {%H-}magic : array[0..5] of char; - l : integer; - prevPos: int64; -begin - try - prevPos := str.Position; - l := str.Read ({%H-}magic[0],sizeof(magic)); - str.Position:= prevPos; - result := (l = sizeof(magic)) and (magic = '! XPM2'); - if not result then result := inherited InternalCheck(Str) - except - result := false; - end; -end; - -class procedure TBGRAReaderXPM.ConvertToXPM3(ASource: TStream; - ADestination: TStream); -var - lst: TStringList; - i : integer; -begin - lst := TStringList.Create; - try - lst.LoadFromStream(ASource); - if (lst[0] = '! XPM2') and (lst.count > 1) then - begin - lst[0] := '/* XPM */'; - lst.Insert(1, 'static char * data[] = {'); - for i := 2 to lst.Count-2 do - lst[i] := '"' + lst[i] + '",'; - lst[lst.count-1] := '"' + lst[lst.count-1] + '"'; - lst.Add('}'); - end; - lst.SaveToStream(ADestination); - finally - lst.free; - end; -end; - -initialization - - DefaultBGRAImageReader[ifXPixMap] := TBGRAReaderXPM; - -end. - diff --git a/components/bgrabitmap/bgrarenderer3d.pas b/components/bgrabitmap/bgrarenderer3d.pas deleted file mode 100644 index d31f34a..0000000 --- a/components/bgrabitmap/bgrarenderer3d.pas +++ /dev/null @@ -1,842 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRARenderer3D; - -{$mode objfpc}{$H+} - -interface - -uses BGRABitmapTypes, - BGRASceneTypes, BGRASSE, - BGRAPolygon, BGRAColorInt, - BGRAClasses, BGRAMatrix3D, - BGRAPolygonAliased; - -type - TInt65536ShaderFunction3D = function (Context: PBasicLightingContext; Color: TBGRAPixel): TColorInt65536 of object; - - { TBGRAShader3D } - - TBGRAShader3D = class - protected - FAmbiantLightness: integer; - FAmbiantLightColor: TColorInt65536; - FUseAmbiantColor: boolean; - FLights: TList; - FContextBlock: TMemoryBlockAlign128; - FShaderFunc: TShaderFunction3D; - FInt65536ShaderFunc: TInt65536ShaderFunction3D; - FContext: PBasicLightingContext; - FOnlyDirectionalLights: boolean; - FWhiteMaterial: boolean; - - procedure ComputeDiffuseLightness(Context: PSceneLightingContext); inline; - procedure ComputeDiffuseLight(Context: PSceneLightingContext); inline; - procedure ComputeDiffuseAndSpecularLight(Context: PSceneLightingContext); inline; - - function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; - function ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; - function ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; - function ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; - function ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; - - function Int65536ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; - function Int65536ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; - function Int65536ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; - function Int65536ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; - function Int65536ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; - public - constructor Create(const AAmbiantLightColorF: TColorF; ALights: TList); - destructor Destroy; override; - function Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; AColor: TBGRAPixel): TBGRAPixel; - function Int65536Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; AColor: TBGRAPixel): TColorInt65536; - procedure Prepare(constref ADescription: TFaceRenderingDescription); - property ShaderFunction: TShaderFunction3D read FShaderFunc; - property Int65536ShaderFunction: TInt65536ShaderFunction3D read FInt65536ShaderFunc; - property Context: PBasicLightingContext read FContext; - property OnlyDirectionalLights: boolean read FOnlyDirectionalLights; - end; - - { TBGRARenderer3D } - - TBGRARenderer3D = class(TCustomRenderer3D) - protected - FColorGradientTempBmp: TBGRACustomBitmap; - FZBuffer: PSingle; - FOutputSurface, FRenderSurface: TBGRACustomBitmap; - FRenderSurfaceMultisample: Integer; - FMultishapeFiller: TBGRAMultishapeFiller; - FOptions: TRenderingOptions; - FShader: TBGRAShader3D; - FDepths: array of single; - FLightings: array of word; - - FShadedColors: array of TBGRAPixel; - FSameShadedColors: boolean; - - FCenter: record - proj: TPointF; - pos3D,normal3D: TPoint3D_128; - color: TBGRAPixel; - end; - - function GetHasZBuffer: boolean; override; - function GetGlobalScale: single; override; - function GetSurfaceWidth: integer; override; - function GetSurfaceHeight: integer; override; - function GetHandlesNearClipping: boolean; override; - function GetHandlesFaceCulling: boolean; override; - public - constructor Create(AOutputSurface: TBGRACustomBitmap; - ARenderingOptions: TRenderingOptions; - AAmbiantLightColorF: TColorF; - ALights: TList); - function RenderFace(var ADescription: TFaceRenderingDescription; - AComputeCoordinate: TComputeProjectionFunc): boolean; override; - destructor Destroy; override; - end; - -implementation - -uses SysUtils, BGRAResample; - -{ TBGRAShader3D } - -constructor TBGRAShader3D.Create(const AAmbiantLightColorF: TColorF; - ALights: TList); -var - j: Integer; -begin - FAmbiantLightColor := ColorFToColorInt65536(AAmbiantLightColorF); - FAmbiantLightness := round((AAmbiantLightColorF[1]+AAmbiantLightColorF[2]+AAmbiantLightColorF[3])/3*32768); - FUseAmbiantColor:= (FAmbiantLightColor.r <> FAmbiantLightColor.g) or (FAmbiantLightColor.g <> FAmbiantLightColor.b); - FLights := ALights; - FContextBlock := TMemoryBlockAlign128.Create(sizeof(TSceneLightingContext)); - FOnlyDirectionalLights:= true; - for j := 0 to FLights.Count-1 do - if not TBGRALight3D(FLights[j]).IsDirectional then FOnlyDirectionalLights := false; -end; - -destructor TBGRAShader3D.Destroy; -begin - FreeAndNil(FContextBlock); - inherited Destroy; -end; - -function TBGRAShader3D.Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; - AColor: TBGRAPixel): TBGRAPixel; -begin - with Context^ do - begin - Position := APosition; - Normal := ANormal; - end; - result := ShaderFunction(Context,AColor); -end; - -function TBGRAShader3D.Int65536Apply(APosition: TPoint3D_128; - ANormal: TPoint3D_128; AColor: TBGRAPixel): TColorInt65536; -begin - with Context^ do - begin - Position := APosition; - Normal := ANormal; - end; - result := Int65536ShaderFunction(Context,AColor); -end; - -procedure TBGRAShader3D.Prepare(constref - ADescription: TFaceRenderingDescription); -var - UseDiffuseColor: Boolean; - j: Integer; - ctx: PSceneLightingContext; -begin - with ADescription do - begin - FWhiteMaterial:= Texture <> nil; - if Material.GetSpecularOn then - begin - FShaderFunc := TShaderFunction3D(@ApplyLightingWithDiffuseAndSpecularColor); - FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithDiffuseAndSpecularColor); - end else - begin - UseDiffuseColor := FUseAmbiantColor; - if not UseDiffuseColor then - begin - with Material.GetDiffuseColorInt do - UseDiffuseColor := (r <> g) or (g <> b); - if not UseDiffuseColor and Material.GetAutoDiffuseColor then - begin - for j := 0 to FLights.Count-1 do - if TBGRALight3D(FLights[j]).GetColoredLight then - begin - UseDiffuseColor := true; - break; - end; - end; - end; - if UseDiffuseColor then - begin - FShaderFunc := TShaderFunction3D(@ApplyLightingWithDiffuseColor); - FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithDiffuseColor); - end else - begin - if FLights.Count = 0 then - begin - if FAmbiantLightness = 32768 then - begin - FShaderFunc := TShaderFunction3D(@ApplyNoLighting); - FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyNoLighting); - end else - begin - FShaderFunc := TShaderFunction3D(@ApplyLightingWithAmbiantLightnessOnly); - FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithAmbiantLightnessOnly); - end; - end else - begin - FShaderFunc := TShaderFunction3D(@ApplyLightingWithLightness); - FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithLightness); - end; - end; - end; - - ctx := PSceneLightingContext( FContextBlock.Data ); - ctx^.material := Material; - ctx^.LightThroughFactor := LightThroughFactor; - ctx^.LightThrough := ctx^.LightThroughFactor > 0; - ctx^.SaturationHighF := Material.GetSaturationHigh; - ctx^.SaturationLowF := Material.GetSaturationLow; - ctx^.SaturationHigh := round(Material.GetSaturationHigh*32768); - ctx^.SaturationLow := round(Material.GetSaturationLow*32768); - FContext := PBasicLightingContext(ctx); - end; -end; - -procedure TBGRAShader3D.ComputeDiffuseLightness( - Context: PSceneLightingContext); -var i: Int32or64; -begin - Context^.lightness := FAmbiantLightness; - - i := FLights.Count-1; - while i >= 0 do - begin - TBGRALight3D(FLights[i]).ComputeDiffuseLightness(Context); - dec(i); - end; -end; - -procedure TBGRAShader3D.ComputeDiffuseLight(Context: PSceneLightingContext); -var i: Int32or64; - m: TBGRAMaterial3D; -begin - m := TBGRAMaterial3D(Context^.material); - - if FWhiteMaterial or m.GetAutoAmbiantColor then - Context^.diffuseColor := FAmbiantLightColor - else - Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt; - - i := FLights.Count-1; - while i >= 0 do - begin - TBGRALight3D(FLights[i]).ComputeDiffuseColor(Context); - dec(i); - end; - - Context^.diffuseColor.a := 65536; -end; - -procedure TBGRAShader3D.ComputeDiffuseAndSpecularLight( - Context: PSceneLightingContext); -var i: Int32or64; - m: TBGRAMaterial3D; -begin - m := TBGRAMaterial3D(Context^.material); - - if FWhiteMaterial or m.GetAutoAmbiantColor then - Context^.diffuseColor := FAmbiantLightColor - else - Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt; - Context^.specularColor := ColorInt65536(0,0,0,0); - - i := FLights.Count-1; - while i >= 0 do - begin - TBGRALight3D(FLights[i]).ComputeDiffuseAndSpecularColor(Context); - dec(i); - end; - - Context^.diffuseColor.a := 65536; -end; - -function TBGRAShader3D.ApplyNoLighting(Context: PSceneLightingContext; - Color: TBGRAPixel): TBGRAPixel; -var - m: TBGRAMaterial3D; -begin - m := TBGRAMaterial3D(Context^.material); - - if FWhiteMaterial or m.GetAutoAmbiantColor then - result := Color - else - result := ColorIntToBGRA(BGRAToColorInt(Color,True)*m.GetAmbiantColorInt,True); -end; - -function TBGRAShader3D.ApplyLightingWithAmbiantLightnessOnly( - Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; -var - m: TBGRAMaterial3D; -begin - m := TBGRAMaterial3D(Context^.material); - - if not FWhiteMaterial and not m.GetAutoAmbiantColor then - Color := ColorIntToBGRA(BGRAToColorInt(Color,True)* m.GetAmbiantColorInt,True); - - if FAmbiantLightness <= 0 then - result := BGRA(0,0,0,color.alpha) - else - result := ApplyIntensityFast(Color, FAmbiantLightness); -end; - -function TBGRAShader3D.ApplyLightingWithLightness(Context: PSceneLightingContext; - Color: TBGRAPixel): TBGRAPixel; -var - m: TBGRAMaterial3D; -begin - ComputeDiffuseLightness(Context); - - m := TBGRAMaterial3D(Context^.material); - if not FWhiteMaterial and not m.GetAutoSimpleColor then - Color := ColorIntToBGRA(BGRAToColorInt(Color,True)*m.GetSimpleColorInt,True); - - with Context^ do - if Lightness <= 0 then - result := BGRA(0,0,0,color.alpha) - else - begin - if Lightness <= SaturationLow then - result := ApplyIntensityFast(Color, Lightness) - else if Lightness >= SaturationHigh then - result := BGRA(255,255,255,color.alpha) - else - result := ApplyLightnessFast( ApplyIntensityFast(Color, SaturationLow), - (Lightness - SaturationLow)*32767 div (SaturationHigh-SaturationLow)+32768 ); - end; -end; - -function TBGRAShader3D.ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; - Color: TBGRAPixel): TBGRAPixel; -begin - ComputeDiffuseLight(Context); - result := ColorIntToBGRA(BGRAToColorInt(Color,True)*Context^.diffuseColor,True); -end; - -function TBGRAShader3D.ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; - Color: TBGRAPixel): TBGRAPixel; -begin - ComputeDiffuseAndSpecularLight(Context); - result := ColorIntToBGRA(BGRAToColorInt(Color,True)*Context^.diffuseColor + Context^.specularColor,True); -end; - -function TBGRAShader3D.Int65536ApplyNoLighting(Context: PSceneLightingContext; - Color: TBGRAPixel): TColorInt65536; -var - m: TBGRAMaterial3D; -begin - m := TBGRAMaterial3D(Context^.material); - - if not FWhiteMaterial and not m.GetAutoAmbiantColor then - result := BGRAToColorInt(Color,True)* m.GetAmbiantColorInt - else - result := BGRAToColorInt(Color,True); -end; - -function TBGRAShader3D.Int65536ApplyLightingWithAmbiantLightnessOnly( - Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; -var - m: TBGRAMaterial3D; - MaterialColor: TColorInt65536; -begin - m := TBGRAMaterial3D(Context^.material); - - if not FWhiteMaterial and not m.GetAutoAmbiantColor then - MaterialColor := BGRAToColorInt(Color,True)* m.GetAmbiantColorInt - else - MaterialColor := BGRAToColorInt(Color,True); - - if FAmbiantLightness <= 0 then - result := ColorInt65536(0,0,0,MaterialColor.a) - else - result := MaterialColor * - ColorInt65536(FAmbiantLightness shl 1,FAmbiantLightness shl 1,FAmbiantLightness shl 1,65536); -end; - -function TBGRAShader3D.Int65536ApplyLightingWithLightness( - Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; -var - MaterialColor: TColorInt65536; - m: TBGRAMaterial3D; - Extra: Int32or64; -begin - ComputeDiffuseLightness(Context); - - m := TBGRAMaterial3D(Context^.material); - if not FWhiteMaterial and not m.GetAutoSimpleColor then - MaterialColor := BGRAToColorInt(Color,True)*m.GetSimpleColorInt - else - MaterialColor := BGRAToColorInt(Color,True); - - with Context^ do - if Lightness <= 0 then - result := ColorInt65536(0,0,0,MaterialColor.a) - else - begin - if Lightness <= SaturationLow then - result := MaterialColor * ColorInt65536(Lightness shl 1,Lightness shl 1,Lightness shl 1,65536) - else if Lightness >= SaturationHigh then - result := ColorInt65536(65536,65536,65536,MaterialColor.a) - else - begin - result := MaterialColor * ColorInt65536(Lightness shl 1,Lightness shl 1,Lightness shl 1,65536); - Extra := (Lightness - SaturationLow)*65536 div (SaturationHigh-SaturationLow); - inc(result.r, Extra); - inc(result.g, Extra); - inc(result.b, Extra); - end; - end; -end; - -function TBGRAShader3D.Int65536ApplyLightingWithDiffuseColor( - Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; -begin - ComputeDiffuseLight(Context); - result := BGRAToColorInt(Color,True)*Context^.diffuseColor; -end; - -function TBGRAShader3D.Int65536ApplyLightingWithDiffuseAndSpecularColor( - Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536; -begin - ComputeDiffuseAndSpecularLight(Context); - result := BGRAToColorInt(Color,True)*Context^.diffuseColor + Context^.specularColor; -end; - -{ TBGRARenderer3D } - -function TBGRARenderer3D.GetHasZBuffer: boolean; -begin - result := Assigned(FZBuffer); -end; - -function TBGRARenderer3D.GetGlobalScale: single; -begin - result := FRenderSurfaceMultisample; -end; - -function TBGRARenderer3D.GetSurfaceWidth: integer; -begin - result := FOutputSurface.Width; -end; - -function TBGRARenderer3D.GetSurfaceHeight: integer; -begin - result := FOutputSurface.Height; -end; - -function TBGRARenderer3D.GetHandlesNearClipping: boolean; -begin - result := false; -end; - -function TBGRARenderer3D.GetHandlesFaceCulling: boolean; -begin - result := false; -end; - -constructor TBGRARenderer3D.Create(AOutputSurface: TBGRACustomBitmap; - ARenderingOptions: TRenderingOptions; - AAmbiantLightColorF: TColorF; - ALights: TList); -begin - if AOutputSurface = nil then - raise exception.Create('No surface specified'); - FOutputSurface := AOutputSurface; - FOptions := ARenderingOptions; - - if (FOptions.AntialiasingMode = am3dResample) - and (FOptions.AntialiasingResampleLevel > 1) then - begin - FRenderSurface := FOutputSurface.NewBitmap(FOutputSurface.Width*FOptions.AntialiasingResampleLevel, - FOutputSurface.Height*FOptions.AntialiasingResampleLevel); - FRenderSurfaceMultisample := FOptions.AntialiasingResampleLevel; - end else - begin - FRenderSurface := FOutputSurface; - FRenderSurfaceMultisample := 1; - end; - - FColorGradientTempBmp := FRenderSurface.NewBitmap(2,2); - FColorGradientTempBmp.ScanInterpolationFilter := rfLinear; - - if FOptions.PerspectiveMode = pmZBuffer then - begin - Getmem(FZBuffer, FRenderSurface.NbPixels*sizeof(single)); - FillDWord(FZBuffer^, FRenderSurface.NbPixels, LongWord(single(0))); - end - else - FZBuffer := nil; - - if (FOptions.AntialiasingMode = am3dMultishape) and - (FOptions.PerspectiveMode <> pmZBuffer) then - begin - FMultishapeFiller := TBGRAMultishapeFiller.Create; - FMultishapeFiller.PolygonOrder := poLastOnTop; - end - else - FMultishapeFiller := nil; - - FShader := TBGRAShader3D.Create(AAmbiantLightColorF, ALights); -end; - -function TBGRARenderer3D.RenderFace(var ADescription: TFaceRenderingDescription; - AComputeCoordinate: TComputeProjectionFunc): boolean; - - procedure ComputeCenter; - var j: Int32or64; - begin - with ADescription do - begin - with FCenter do - begin - ClearPoint3D_128(pos3D); - ClearPoint3D_128(normal3D); - color := MergeBGRA(slice(Colors,NbVertices)); - end; - for j := 0 to NbVertices-1 do - begin - FCenter.pos3D.Offset(Positions3D[j]); - FCenter.normal3D.Offset(Normals3D[j]); - end; - with FCenter do - begin - pos3D.Scale(1/NbVertices); - Normalize3D_128(normal3D); - end; - end; - FCenter.proj := AComputeCoordinate(FCenter.pos3D); - end; - - procedure DrawFaceWithShader; - var - j,k: Int32or64; - SameColor: boolean; - begin - with ADescription do - begin - if Texture <> nil then - begin - BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, - slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices), - Texture,slice(TexCoords,NbVertices),FOptions.TextureInterpolation, - FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); - exit; - end; - - SameColor := True; - for j := 1 to NbVertices-1 do - if (Colors[j]<>Colors[j-1]) then SameColor := False; - - if SameColor then - begin - BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, - slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),nil, - slice(TexCoords,NbVertices),False,FShader.ShaderFunction,True,Colors[0],FZBuffer,FShader.Context); - end else - if NbVertices = 3 then - begin - FColorGradientTempBmp.SetPixel(0,0,Colors[0]); - FColorGradientTempBmp.SetPixel(1,0,Colors[1]); - FColorGradientTempBmp.SetPixel(0,1,Colors[2]); - FColorGradientTempBmp.SetPixel(1,1,MergeBGRA(Colors[1],Colors[2])); - BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, - slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),FColorGradientTempBmp, - [PointF(0,0),PointF(1,0),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); - end else - if NbVertices = 4 then - begin - FColorGradientTempBmp.SetPixel(0,0,Colors[0]); - FColorGradientTempBmp.SetPixel(1,0,Colors[1]); - FColorGradientTempBmp.SetPixel(1,1,Colors[2]); - FColorGradientTempBmp.SetPixel(0,1,Colors[3]); - BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, - slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),FColorGradientTempBmp, - [PointF(0,0),PointF(1,0),PointF(1,1),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); - end else - if NbVertices >= 3 then - begin //split into triangles - ComputeCenter; - k := NbVertices-1; - for j := 0 to NbVertices-1 do - begin - FColorGradientTempBmp.SetPixel(0,0,Colors[k]); - FColorGradientTempBmp.SetPixel(1,0,Colors[j]); - FColorGradientTempBmp.SetPixel(0,1,FCenter.color); - FColorGradientTempBmp.SetPixel(1,1,MergeBGRA(Colors[j],FCenter.color)); - BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface, - [Projections[k],Projections[j],FCenter.proj], [Positions3D[k],Positions3D[j],FCenter.pos3D], - [Normals3D[k],Normals3D[j],FCenter.normal3D], FColorGradientTempBmp, - [PointF(0,0),PointF(1,0),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context); - k := j; - end; - end; - end; - end; - - procedure ComputeShadedColors; - var - j: Int32or64; - begin - with ADescription do - begin - //Vertex lighting interpolation (low-quality Gouraud, low-quality Phong) - if length(FShadedColors) < NbVertices then - setlength(FShadedColors, NbVertices); - - for j := 0 to NbVertices-1 do - FShadedColors[j] := FShader.Apply(Positions3D[j],Normals3D[j],Colors[j]); - - FSameShadedColors := True; - for j := 1 to NbVertices-1 do - if (FShadedColors[j]<>FShadedColors[j-1]) then - begin - FSameShadedColors := False; - break; - end; - end; - end; - - procedure DrawWithMultishape; - var shadedCenter: TBGRAPixel; - j,k: Int32or64; - begin - with ADescription do - begin - if Texture <> nil then - begin - if (FOptions.PerspectiveMode <> pmLinearMapping) and (NbVertices=4) then - FMultishapeFiller.AddQuadPerspectiveMapping( - Projections[0],Projections[1],Projections[2],Projections[3], - Texture,TexCoords[0],TexCoords[1],TexCoords[2],TexCoords[3]) - else - if NbVertices>=3 then - begin - for j := 0 to NbVertices-3 do - FMultishapeFiller.AddTriangleLinearMapping( - Projections[j],Projections[j+1],Projections[j+2], - Texture,TexCoords[j],TexCoords[j+1],TexCoords[j+2]); - end; - end - else - begin - ComputeShadedColors; - - if FSameShadedColors then - FMultishapeFiller.AddPolygon(slice(Projections,NbVertices),FShadedColors[0]) - else - if NbVertices=3 then - FMultishapeFiller.AddTriangleLinearColor( - Projections[0],Projections[1],Projections[2], - FShadedColors[0],FShadedColors[1],FShadedColors[2]) - else - if NbVertices>=3 then - begin //split into triangles - ComputeCenter; - shadedCenter := FShader.Apply(FCenter.pos3D,FCenter.normal3D,FCenter.color); - k := NbVertices-1; - for j := 0 to NbVertices-1 do - begin - FMultishapeFiller.AddTriangleLinearColor( - Projections[k],Projections[j],FCenter.proj, - FShadedColors[k],FShadedColors[j],shadedCenter); - k := j; - end; - end; - end; - end; - end; - - procedure DrawAliasedColoredFace; - var j,k: integer; - shadedCenter: TBGRAPixel; - begin - with ADescription do - begin - ComputeShadedColors; - - if FSameShadedColors then - begin - if FOptions.PerspectiveMode = pmZBuffer then - BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, slice(Projections,NbVertices), - slice(FDepths,NbVertices), slice(FShadedColors,NbVertices),True,FZBuffer) - else - FRenderSurface.FillPoly(slice(Projections,NbVertices),FShadedColors[0],dmDrawWithTransparency); - end - else - begin - if NbVertices > 4 then - begin //split into triangles - ComputeCenter; - shadedCenter := FShader.Apply(FCenter.pos3D,FCenter.normal3D,FCenter.color); - k := NbVertices-1; - if FOptions.PerspectiveMode = pmLinearMapping then - begin - for j := 0 to NbVertices-1 do - begin - FRenderSurface.FillPolyLinearColor([Projections[k],Projections[j],FCenter.proj],[FShadedColors[k],FShadedColors[j],shadedCenter]); - k := j; - end; - end else - begin - for j := 0 to NbVertices-1 do - begin - BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, [Projections[k],Projections[j],FCenter.proj], - [FDepths[k],FDepths[j],FCenter.pos3D.z], [FShadedColors[k],FShadedColors[j],shadedCenter],True,FZBuffer); - k := j; - end; - end; - end else - begin - if FOptions.PerspectiveMode = pmLinearMapping then - FRenderSurface.FillPolyLinearColor(slice(Projections,NbVertices),slice(FShadedColors,NbVertices)) - else - BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, slice(Projections,NbVertices), - slice(FDepths,NbVertices), slice(FShadedColors,NbVertices),True,FZBuffer); - end; - end; - end; - end; - - procedure DrawWithoutShader; - var - noLighting: Boolean; - j: Int32or64; - begin - with ADescription do - begin - if length(FDepths) < NbVertices then - setlength(FDepths, NbVertices); - for j := 0 to NbVertices-1 do - FDepths[j] := Positions3D[j].z; - - if Texture <> nil then - begin - noLighting := True; - if length(FLightings) < NbVertices then - setlength(FLightings, NbVertices); - for j := 0 to NbVertices-1 do - begin - FLightings[j] := FShader.Int65536Apply(Positions3D[j],Normals3D[j],BGRAWhite).g div 2; - if abs(FLightings[j]-32768) > 1 then noLighting := false; - end; - - if noLighting then - begin - if FOptions.PerspectiveMode <> pmLinearMapping then - FRenderSurface.FillPolyPerspectiveMapping(slice(Projections,NbVertices), - slice(FDepths,NbVertices),Texture,slice(TexCoords,NbVertices), - FOptions.TextureInterpolation, FZBuffer) - else - FRenderSurface.FillPolyLinearMapping(slice(Projections,NbVertices), - Texture,slice(TexCoords,NbVertices),FOptions.TextureInterpolation); - end else - begin - if FOptions.PerspectiveMode <> pmLinearMapping then - FRenderSurface.FillPolyPerspectiveMappingLightness( - slice(Projections,NbVertices),slice(FDepths,NbVertices),Texture, - slice(TexCoords,NbVertices),slice(FLightings,NbVertices), - FOptions.TextureInterpolation, FZBuffer) - else - FRenderSurface.FillPolyLinearMappingLightness( - slice(Projections,NbVertices),Texture,slice(TexCoords,NbVertices), - slice(FLightings,NbVertices),FOptions.TextureInterpolation); - end; - end - else - DrawAliasedColoredFace; //already low-quality shaded - end; - end; - -var - j: integer; - SkipShader: boolean; -begin - result := true; - FShader.Prepare(ADescription); - with ADescription do - begin - //high-quality lighting interpolation, necessary for Phong and high-quality Gouraud - if ( (FOptions.LightingInterpolation = liAlwaysHighQuality) or - ((FOptions.LightingInterpolation = liSpecularHighQuality) and Material.GetSpecularOn) ) - and (NormalsMode <> lnNone) then - begin - //if there are only directional lights and all the normals are the same, - //then the lighting will be uniform so we can skip the shader - if FShader.OnlyDirectionalLights then - begin - SkipShader := true; - for j := 1 to NbVertices-1 do - if Normals3D[j] <> Normals3D[j-1] then - begin - SkipShader := false; - break; - end; - end else - SkipShader := false; - - if not SkipShader then - begin - DrawFaceWithShader; - exit; - end; - end; - - if Assigned(FMultishapeFiller) then //high-quality antialiasing - DrawWithMultishape - else - DrawWithoutShader; - end; -end; - -destructor TBGRARenderer3D.Destroy; -begin - FreeAndNil(FShader); - - if Assigned(FMultishapeFiller) then - begin - FMultishapeFiller.Draw(FRenderSurface); - FreeAndNil(FMultishapeFiller); - end; - - if FZBuffer <> nil then - begin - FreeMem(FZBuffer); - FZBuffer := nil; - end; - - FreeAndNil(FColorGradientTempBmp); - - if FRenderSurfaceMultisample > 1 then - begin - BGRAResample.DownSamplePutImage(FRenderSurface, - FRenderSurfaceMultisample,FRenderSurfaceMultisample, - FOutputSurface, 0,0, dmDrawWithTransparency); - FreeAndNil(FRenderSurface); - FRenderSurfaceMultisample := 1; - end - else - FRenderSurface := nil; - - inherited Destroy; -end; - -end. diff --git a/components/bgrabitmap/bgraresample.pas b/components/bgrabitmap/bgraresample.pas deleted file mode 100644 index 6c435b5..0000000 --- a/components/bgrabitmap/bgraresample.pas +++ /dev/null @@ -1,1532 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAResample; - -{$mode objfpc}{$H+} - -interface - -{ This unit provides resampling functions, i.e. resizing of bitmaps with or - without interpolation filters. - - SimpleStretch does a boxed resample with limited antialiasing. - - FineResample uses floating point coordinates to get an antialiased resample. - It can use minimal interpolation (4 pixels when upsizing) for simple interpolation - filters (linear and cosine-like) or wide kernel resample for complex interpolation. - In this cas, it calls WideKernelResample. - - WideKernelResample can be called by custom filter kernel, derived - from TWideKernelFilter. It is slower of course than simple interpolation. } - -uses - SysUtils, BGRABitmapTypes; - -{------------------------------- Simple stretch ------------------------------------} - -function SimpleStretch(bmp: TBGRACustomBitmap; - NewWidth, NewHeight: integer): TBGRACustomBitmap; -procedure StretchPutImage(bmp: TBGRACustomBitmap; - NewWidth, NewHeight: integer; dest: TBGRACustomBitmap; OffsetX,OffsetY: Integer; ADrawMode: TDrawMode; AOpacity: byte; ANoTransition: boolean = false); -procedure DownSamplePutImage(source: TBGRACustomBitmap; factorX,factorY: integer; dest: TBGRACustomBitmap; OffsetX,OffsetY: Integer; ADrawMode: TDrawMode); -function DownSample(source: TBGRACustomBitmap; factorX,factorY: integer): TBGRACustomBitmap; - -{---------------------------- Interpolation filters --------------------------------} - -function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single; -function FineInterpolation256(t256: integer; ResampleFilter: TResampleFilter): integer; - -type - TWideKernelFilter = class - function Interpolation(t: single): single; virtual; abstract; - function ShouldCheckRange: boolean; virtual; abstract; - function KernelWidth: single; virtual; abstract; - end; - - TMitchellKernel = class(TWideKernelFilter) - function Interpolation(t: single): single; override; - function ShouldCheckRange: boolean; override; - function KernelWidth: single; override; - end; - - { TSplineKernel } - - TSplineKernel = class(TWideKernelFilter) - public - Coeff: single; - constructor Create; overload; - constructor Create(ACoeff: single); overload; - function Interpolation(t: single): single; override; - function ShouldCheckRange: boolean; override; - function KernelWidth: single; override; - end; - - { TCubicKernel } - - TCubicKernel = class(TWideKernelFilter) - function pow3(x: single): single; inline; - function Interpolation(t: single): single; override; - function ShouldCheckRange: boolean; override; - function KernelWidth: single; override; - end; - - { TLanczosKernel } - - TLanczosKernel = class(TWideKernelFilter) - private - FNumberOfLobes: integer; - FFactor: ValReal; - procedure SetNumberOfLobes(AValue: integer); - public - constructor Create(ANumberOfLobes: integer); - function Interpolation(t: single): single; override; - function ShouldCheckRange: boolean; override; - function KernelWidth: single; override; - - property NumberOfLobes : integer read FNumberOfLobes write SetNumberOfLobes; - end; - -function CreateInterpolator(style: TSplineStyle): TWideKernelFilter; - -{-------------------------------- Fine resample ------------------------------------} - -function FineResample(bmp: TBGRACustomBitmap; - NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap; - -function WideKernelResample(bmp: TBGRACustomBitmap; - NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap; - -implementation - -uses Math, BGRABlend, BGRAClasses; - -function SimpleStretch(bmp: TBGRACustomBitmap; - newWidth, newHeight: integer): TBGRACustomBitmap; -begin - if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then - begin - Result := bmp.Duplicate; - exit; - end; - Result := bmp.NewBitmap(NewWidth, NewHeight); - StretchPutImage(bmp, newWidth,newHeight, result, 0,0, dmSet, 255); -end; - -procedure StretchPutImage(bmp: TBGRACustomBitmap; NewWidth, NewHeight: integer; - dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode; AOpacity: byte; ANoTransition: boolean); -type - TTransitionState = (tsNone, tsPlain, tsLeft, tsMiddle, tsRight); -var - x_src,y_src, y_src2, prev_y_src, prev_y_src2: Int32or64; - inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src, - acc_x_src2, acc_y_src2: Int32or64; - x_dest, y_dest: Int32or64; - - PDest, PSrc1, PSrc2: PBGRAPixel; - vertColors: packed array[1..2] of TBGRAPixel; - DeltaSrcX: Int32or64; - targetRect: TRect; - tempData: PBGRAPixel; - prevHorizTransition,horizTransition,prevVertTransition,vertTransition: TTransitionState; - horizSlightlyDifferent,vertSlightlyDifferent: boolean; - - procedure LinearMix(PSrc: PBGRAPixel; DeltaSrc: integer; AccSrcQuarter: boolean; - PDest: PBGRAPixel; slightlyDifferent: boolean; var transition: TTransitionState); - var - asum: Int32or64; - a1,a2: Int32or64; - newTransition: TTransitionState; - begin - if (DeltaSrc=0) or ANoTransition then - begin - PDest^ := PSrc^; - transition:= tsPlain; - end - else - begin - if slightlyDifferent then - begin - if AccSrcQuarter then newTransition:= tsRight else - newTransition:= tsLeft; - end else - newTransition:= tsMiddle; - - if (newTransition = tsMiddle) or ((newTransition = tsRight) and (transition = tsLeft)) or - ((newTransition = tsLeft) and (transition = tsRight)) then - begin - transition:= tsMiddle; - if ADrawMode = dmXor then - begin - pdest^.alpha := (psrc^.alpha + (psrc+DeltaSrc)^.alpha + 1) shr 1; - pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red + 1) shr 1; - pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green + 1) shr 1; - pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue + 1) shr 1; - end else - begin - asum := psrc^.alpha + (psrc+DeltaSrc)^.alpha; - if asum = 0 then - pdest^ := BGRAPixelTransparent - else if asum = 510 then - begin - pdest^.alpha := 255; - pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red + 1) shr 1; - pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green + 1) shr 1; - pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue + 1) shr 1; - end else - begin - pdest^.alpha := asum shr 1; - a1 := psrc^.alpha; - a2 := (psrc+DeltaSrc)^.alpha; - pdest^.red := (psrc^.red*a1 + (psrc+DeltaSrc)^.red*a2 + (asum shr 1)) div asum; - pdest^.green := (psrc^.green*a1 + (psrc+DeltaSrc)^.green*a2 + (asum shr 1)) div asum; - pdest^.blue := (psrc^.blue*a1 + (psrc+DeltaSrc)^.blue*a2 + (asum shr 1)) div asum; - end; - end; - end else - if newTransition = tsRight then - begin - transition := tsRight; - if ADrawMode = dmXor then - begin - pdest^.alpha := (psrc^.alpha + (psrc+DeltaSrc)^.alpha*3 + 2) shr 2; - pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red*3 + 2) shr 2; - pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green*3 + 2) shr 2; - pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue*3 + 2) shr 2; - end else - begin - asum := psrc^.alpha + (psrc+DeltaSrc)^.alpha*3; - if asum = 0 then - pdest^ := BGRAPixelTransparent - else if asum = 1020 then - begin - pdest^.alpha := 255; - pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red*3 + 2) shr 2; - pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green*3 + 2) shr 2; - pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue*3 + 2) shr 2; - end else - begin - pdest^.alpha := asum shr 2; - a1 := psrc^.alpha; - a2 := (psrc+DeltaSrc)^.alpha; - pdest^.red := (psrc^.red*a1 + (psrc+DeltaSrc)^.red*a2*3 + (asum shr 1)) div asum; - pdest^.green := (psrc^.green*a1 + (psrc+DeltaSrc)^.green*a2*3 + (asum shr 1)) div asum; - pdest^.blue := (psrc^.blue*a1 + (psrc+DeltaSrc)^.blue*a2*3 + (asum shr 1)) div asum; - end; - end; - end else - begin - transition:= tsLeft; - if ADrawMode = dmXor then - begin - pdest^.alpha := (psrc^.alpha*3 + (psrc+DeltaSrc)^.alpha + 2) shr 2; - pdest^.red := (psrc^.red*3 + (psrc+DeltaSrc)^.red + 2) shr 2; - pdest^.green := (psrc^.green*3 + (psrc+DeltaSrc)^.green + 2) shr 2; - pdest^.blue := (psrc^.blue*3 + (psrc+DeltaSrc)^.blue + 2) shr 2; - end else - begin - asum := psrc^.alpha*3 + (psrc+DeltaSrc)^.alpha; - if asum = 0 then - pdest^ := BGRAPixelTransparent - else if asum = 1020 then - begin - pdest^.alpha := 255; - pdest^.red := (psrc^.red*3 + (psrc+DeltaSrc)^.red + 2) shr 2; - pdest^.green := (psrc^.green*3 + (psrc+DeltaSrc)^.green + 2) shr 2; - pdest^.blue := (psrc^.blue*3 + (psrc+DeltaSrc)^.blue + 2) shr 2; - end else - begin - pdest^.alpha := asum shr 2; - a1 := psrc^.alpha; - a2 := (psrc+DeltaSrc)^.alpha; - pdest^.red := (psrc^.red*a1*3 + (psrc+DeltaSrc)^.red*a2 + (asum shr 1)) div asum; - pdest^.green := (psrc^.green*a1*3 + (psrc+DeltaSrc)^.green*a2 + (asum shr 1)) div asum; - pdest^.blue := (psrc^.blue*a1*3 + (psrc+DeltaSrc)^.blue*a2 + (asum shr 1)) div asum; - end; - end; - end; - end; - end; - -begin - if (newWidth <= 0) or (newHeight <= 0) or (bmp.Width <= 0) - or (bmp.Height <= 0) then - exit; - - targetRect := rect(0,0,NewWidth,NewHeight); - if OffsetX < dest.ClipRect.Left then targetRect.Left:= dest.ClipRect.Left-OffsetX; - if OffsetY < dest.ClipRect.Top then targetRect.Top:= dest.ClipRect.Top-OffsetY; - if OffsetX+NewWidth > dest.ClipRect.Right then targetRect.Right := dest.ClipRect.Right-OffsetX; - if OffsetY+NewHeight > dest.ClipRect.Bottom then targetRect.Bottom := dest.ClipRect.Bottom-OffsetY; - if (targetRect.Right <= targetRect.Left) or (targetRect.Bottom <= targetRect.Top) then exit; - - bmp.LoadFromBitmapIfNeeded; - - if (ADrawMode <> dmSet) or (AOpacity <> 255) then - getmem(tempData, (targetRect.Right-targetRect.Left)*sizeof(TBGRAPixel) ) - else - tempData := nil; - - inc_x_src := bmp.Width div newwidth; - mod_x_src := bmp.Width mod newwidth; - inc_y_src := bmp.Height div newheight; - mod_y_src := bmp.Height mod newheight; - - prev_y_src := -1; - prev_y_src2 := -1; - - acc_y_src := targetRect.Top*mod_y_src; - y_src := targetRect.Top*inc_y_src + (acc_y_src div NewHeight); - acc_y_src := acc_y_src mod NewHeight; - - y_src := y_src+ (bmp.Height div 4) div newheight; - acc_y_src := acc_y_src+ (bmp.Height div 4) mod newheight; - - y_src2 := y_src+ (bmp.Height div 2) div newheight; - acc_y_src2 := acc_y_src+ (bmp.Height div 2) mod newheight; - if acc_y_src2 > NewHeight then - begin - dec(acc_y_src2, NewHeight); - inc(y_src2); - end; - horizSlightlyDifferent := (NewWidth > bmp.Width*2 div 3) and (NewWidth < bmp.Width*4 div 3); - prevVertTransition:= tsNone; - vertSlightlyDifferent := (NewHeight > bmp.Height*2 div 3) and (NewHeight < bmp.Height*4 div 3); - for y_dest := targetRect.Top to targetRect.Bottom - 1 do - begin - if (y_src = prev_y_src) and (y_src2 = prev_y_src2) and not vertSlightlyDifferent then - begin - if tempData = nil then - move((dest.ScanLine[y_dest-1+OffsetY]+OffsetX+targetRect.Left)^,(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left)^,(targetRect.Right-targetRect.Left)*sizeof(TBGRAPixel)) - else - PutPixels(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left,tempData,targetRect.right-targetRect.left,ADrawMode,AOpacity); - end else - begin - if tempData = nil then - PDest := dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left - else - PDest := tempData; - PSrc1 := bmp.Scanline[y_src]; - - acc_x_src := targetRect.Left*mod_x_src; - x_src := targetRect.Left*inc_x_src + (acc_x_src div NewWidth); - acc_x_src := acc_x_src mod NewWidth; - - x_src := x_src+ (bmp.Width div 4) div NewWidth; - acc_x_src := acc_x_src+ (bmp.Width div 4) mod NewWidth; - - DeltaSrcX := (bmp.Width div 2) div NewWidth; - acc_x_src2 := acc_x_src+ (bmp.Width div 2) mod NewWidth; - if acc_x_src2 > NewWidth then - begin - dec(acc_x_src2, NewWidth); - inc(DeltaSrcX); - end; - inc(Psrc1, x_src); - prevHorizTransition := tsNone; - - if y_src2=y_src then - begin - horizTransition:= prevHorizTransition; - for x_dest := targetRect.left to targetRect.right - 1 do - begin - LinearMix(psrc1, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, PDest, horizSlightlyDifferent, horizTransition); - - Inc(PSrc1, inc_x_src); - Inc(acc_x_src, mod_x_src); - if acc_x_src >= newWidth then - begin - Dec(acc_x_src, newWidth); - Inc(PSrc1); - dec(DeltaSrcX); - end; - Inc(acc_x_src2, mod_x_src); - if acc_x_src2 >= newWidth then - begin - Dec(acc_x_src2, newWidth); - Inc(DeltaSrcX); - end; - inc(PDest); - end; - prevVertTransition:= tsPlain; - end else - begin - PSrc2 := bmp.Scanline[y_src2]+x_src; - for x_dest := targetRect.left to targetRect.right - 1 do - begin - horizTransition:= prevHorizTransition; - LinearMix(psrc1, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, @vertColors[1], horizSlightlyDifferent, horizTransition); - horizTransition:= prevHorizTransition; - LinearMix(psrc2, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, @vertColors[2], horizSlightlyDifferent, horizTransition); - prevHorizTransition:= horizTransition; - vertTransition:= prevVertTransition; - LinearMix(@vertColors[1],1,acc_y_src2 >= NewHeight shr 2,PDest,vertSlightlyDifferent,vertTransition); - - Inc(PSrc1, inc_x_src); - Inc(PSrc2, inc_x_src); - Inc(acc_x_src, mod_x_src); - if acc_x_src >= newWidth then - begin - Dec(acc_x_src, newWidth); - Inc(PSrc1); - Inc(PSrc2); - dec(DeltaSrcX); - end; - Inc(acc_x_src2, mod_x_src); - if acc_x_src2 >= newWidth then - begin - Dec(acc_x_src2, newWidth); - Inc(DeltaSrcX); - end; - inc(PDest); - end; - prevVertTransition:= vertTransition; - end; - - if tempData <> nil then - PutPixels(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left,tempData,targetRect.right-targetRect.left,ADrawMode,AOpacity); - end; - - prev_y_src := y_src; - prev_y_src2 := y_src2; - - Inc(y_src, inc_y_src); - Inc(acc_y_src, mod_y_src); - if acc_y_src >= newheight then - begin - Dec(acc_y_src, newheight); - Inc(y_src); - end; - - Inc(y_src2, inc_y_src); - Inc(acc_y_src2, mod_y_src); - if acc_y_src2 >= newheight then - begin - Dec(acc_y_src2, newheight); - Inc(y_src2); - end; - end; - dest.InvalidateBitmap; - if Assigned(tempData) then FreeMem(tempData); -end; - -procedure DownSamplePutImage2(source: TBGRACustomBitmap; - dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode); -const factorX = 2; factorY = 2; nbi= factorX*factorY; -var xb,yb,ys: Int32or64; - pdest: PBGRAPixel; - psrc1,psrc2: PBGRAPixel; - asum,maxsum: UInt32or64; - newWidth,newHeight: Int32or64; - r,g,b: UInt32or64; -begin - if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then - raise exception.Create('Source size must be a multiple of factorX and factorY'); - newWidth := source.Width div factorX; - newHeight := source.Height div factorY; - ys := 0; - maxsum := 255*Int32or64(factorX)*Int32or64(factorY); - for yb := 0 to newHeight-1 do - begin - pdest := dest.ScanLine[yb+OffsetY]+OffsetX; - psrc1 := source.Scanline[ys]; inc(ys); - psrc2 := source.Scanline[ys]; inc(ys); - for xb := newWidth-1 downto 0 do - begin - asum := 0; - asum := psrc1^.alpha + psrc2^.alpha + (psrc1+1)^.alpha + (psrc2+1)^.alpha; - if asum = maxsum then - begin - pdest^.alpha := 255; - r := psrc1^.red + psrc2^.red + (psrc1+1)^.red + (psrc2+1)^.red; - g := psrc1^.green + psrc2^.green + (psrc1+1)^.green + (psrc2+1)^.green; - b := psrc1^.blue + psrc2^.blue + (psrc1+1)^.blue + (psrc2+1)^.blue; - inc(psrc1,factorX); inc(psrc2,factorX); - pdest^.red := (r + (nbi shr 1)) shr 2; - pdest^.green := (g + (nbi shr 1)) shr 2; - pdest^.blue := (b + (nbi shr 1)) shr 2; - end else - if ADrawMode <> dmSetExceptTransparent then - begin - if asum = 0 then - begin - if ADrawMode = dmSet then - pdest^ := BGRAPixelTransparent; - inc(psrc1,factorX); inc(psrc2,factorX); - end - else - begin - r := psrc1^.red*psrc1^.alpha + psrc2^.red*psrc2^.alpha + (psrc1+1)^.red*(psrc1+1)^.alpha + (psrc2+1)^.red*(psrc2+1)^.alpha; - g := psrc1^.green*psrc1^.alpha + psrc2^.green*psrc2^.alpha + (psrc1+1)^.green*(psrc1+1)^.alpha + (psrc2+1)^.green*(psrc2+1)^.alpha; - b := psrc1^.blue*psrc1^.alpha + psrc2^.blue*psrc2^.alpha + (psrc1+1)^.blue*(psrc1+1)^.alpha + (psrc2+1)^.blue*(psrc2+1)^.alpha; - inc(psrc1,factorX); inc(psrc2,factorX); - if ADrawMode = dmSet then - begin - pdest^.alpha := (asum + (nbi shr 1)) shr 2; - pdest^.red := (r + (asum shr 1)) div asum; - pdest^.green := (g + (asum shr 1)) div asum; - pdest^.blue := (b + (asum shr 1)) div asum; - end - else - begin - if ADrawMode = dmDrawWithTransparency then - DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum, - (g + (asum shr 1)) div asum, - (b + (asum shr 1)) div asum, - (asum + (nbi shr 1)) shr 2)) else - if ADrawMode = dmFastBlend then - FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum, - (g + (asum shr 1)) div asum, - (b + (asum shr 1)) div asum, - (asum + (nbi shr 1)) shr 2)); - end; - end; - end; - inc(pdest); - end; - end; -end; - -procedure DownSamplePutImage3(source: TBGRACustomBitmap; - dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode); -const factorX = 3; factorY = 3; nbi= factorX*factorY; -var xb,yb,ys: Int32or64; - pdest: PBGRAPixel; - psrc1,psrc2,psrc3: PBGRAPixel; - asum,maxsum: UInt32or64; - newWidth,newHeight: Int32or64; - r,g,b: UInt32or64; -begin - if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then - raise exception.Create('Source size must be a multiple of factorX and factorY'); - newWidth := source.Width div factorX; - newHeight := source.Height div factorY; - ys := 0; - maxsum := 255*Int32or64(factorX)*Int32or64(factorY); - for yb := 0 to newHeight-1 do - begin - pdest := dest.ScanLine[yb+OffsetY]+OffsetX; - psrc1 := source.Scanline[ys]; inc(ys); - psrc2 := source.Scanline[ys]; inc(ys); - psrc3 := source.Scanline[ys]; inc(ys); - for xb := newWidth-1 downto 0 do - begin - asum := 0; - asum := psrc1^.alpha + psrc2^.alpha + psrc3^.alpha - + (psrc1+1)^.alpha + (psrc2+1)^.alpha + (psrc3+1)^.alpha - + (psrc1+2)^.alpha + (psrc2+2)^.alpha + (psrc3+2)^.alpha; - if asum = maxsum then - begin - pdest^.alpha := 255; - r := psrc1^.red + psrc2^.red + psrc3^.red - + (psrc1+1)^.red + (psrc2+1)^.red + (psrc3+1)^.red - + (psrc1+2)^.red + (psrc2+2)^.red + (psrc3+2)^.red; - g := psrc1^.green + psrc2^.green + psrc3^.green - + (psrc1+1)^.green + (psrc2+1)^.green + (psrc3+1)^.green - + (psrc1+2)^.green + (psrc2+2)^.green + (psrc3+2)^.green; - b := psrc1^.blue + psrc2^.blue + psrc3^.blue - + (psrc1+1)^.blue + (psrc2+1)^.blue + (psrc3+1)^.blue - + (psrc1+2)^.blue + (psrc2+2)^.blue + (psrc3+2)^.blue; - inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX); - pdest^.red := (r + (nbi shr 1)) div 9; - pdest^.green := (g + (nbi shr 1)) div 9; - pdest^.blue := (b + (nbi shr 1)) div 9; - end else - if ADrawMode <> dmSetExceptTransparent then - begin - if asum = 0 then - begin - if ADrawMode = dmSet then - pdest^ := BGRAPixelTransparent; - inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX); - end - else - begin - r := psrc1^.red*psrc1^.alpha + psrc2^.red*psrc2^.alpha + psrc3^.red*psrc3^.alpha - + (psrc1+1)^.red*(psrc1+1)^.alpha + (psrc2+1)^.red*(psrc2+1)^.alpha + (psrc3+1)^.red*(psrc3+1)^.alpha - + (psrc1+2)^.red*(psrc1+2)^.alpha + (psrc2+2)^.red*(psrc2+2)^.alpha + (psrc3+2)^.red*(psrc3+2)^.alpha; - g := psrc1^.green*psrc1^.alpha + psrc2^.green*psrc2^.alpha + psrc3^.green*psrc3^.alpha - + (psrc1+1)^.green*(psrc1+1)^.alpha + (psrc2+1)^.green*(psrc2+1)^.alpha + (psrc3+1)^.green*(psrc3+1)^.alpha - + (psrc1+2)^.green*(psrc1+2)^.alpha + (psrc2+2)^.green*(psrc2+2)^.alpha + (psrc3+2)^.green*(psrc3+2)^.alpha; - b := psrc1^.blue*psrc1^.alpha + psrc2^.blue*psrc2^.alpha + psrc3^.blue*psrc3^.alpha - + (psrc1+1)^.blue*(psrc1+1)^.alpha + (psrc2+1)^.blue*(psrc2+1)^.alpha + (psrc3+1)^.blue*(psrc3+1)^.alpha - + (psrc1+2)^.blue*(psrc1+2)^.alpha + (psrc2+2)^.blue*(psrc2+2)^.alpha + (psrc3+2)^.blue*(psrc3+2)^.alpha; - inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX); - if ADrawMode = dmSet then - begin - pdest^.alpha := (asum + (nbi shr 1)) div 9; - pdest^.red := (r + (asum shr 1)) div asum; - pdest^.green := (g + (asum shr 1)) div asum; - pdest^.blue := (b + (asum shr 1)) div asum; - end - else - begin - if ADrawMode = dmDrawWithTransparency then - DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum, - (g + (asum shr 1)) div asum, - (b + (asum shr 1)) div asum, - (asum + (nbi shr 1)) div 9)) else - if ADrawMode = dmFastBlend then - FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum, - (g + (asum shr 1)) div asum, - (b + (asum shr 1)) div asum, - (asum + (nbi shr 1)) div 9)); - end; - end; - end; - inc(pdest); - end; - end; -end; - -procedure DownSamplePutImage(source: TBGRACustomBitmap; factorX, factorY: integer; - dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode); -var xb,yb,ys,iy,ix: Int32or64; - pdest,psrci: PBGRAPixel; - psrc: array of PBGRAPixel; - asum,maxsum: UInt32or64; - newWidth,newHeight: Int32or64; - r,g,b,nbi: UInt32or64; -begin - if ADrawMode = dmXor then raise exception.Create('dmXor drawmode not supported'); - if (factorX = 2) and (factorY = 2) then - begin - DownSamplePutImage2(source,dest,OffsetX,OffsetY,ADrawMode); - exit; - end; - if (factorX = 3) and (factorY = 3) then - begin - DownSamplePutImage3(source,dest,OffsetX,OffsetY,ADrawMode); - exit; - end; - if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then - raise exception.Create('Source size must be a multiple of factorX and factorY'); - newWidth := source.Width div factorX; - newHeight := source.Height div factorY; - ys := 0; - maxsum := 255*Int32or64(factorX)*Int32or64(factorY); - nbi := factorX*factorY; - setlength(psrc, factorY); - for yb := 0 to newHeight-1 do - begin - pdest := dest.ScanLine[yb+OffsetY]+OffsetX; - for iy := factorY-1 downto 0 do - begin - psrc[iy] := source.Scanline[ys]; - inc(ys); - end; - for xb := newWidth-1 downto 0 do - begin - asum := 0; - for iy := factorY-1 downto 0 do - begin - psrci := psrc[iy]; - for ix := factorX-1 downto 0 do - inc(asum, (psrci+ix)^.alpha); - end; - if asum = maxsum then - begin - pdest^.alpha := 255; - r := 0; - g := 0; - b := 0; - for iy := factorY-1 downto 0 do - for ix := factorX-1 downto 0 do - begin - with psrc[iy]^ do - begin - inc(r, red); - inc(g, green); - inc(b, blue); - end; - inc(psrc[iy]); - end; - pdest^.red := (r + (nbi shr 1)) div nbi; - pdest^.green := (g + (nbi shr 1)) div nbi; - pdest^.blue := (b + (nbi shr 1)) div nbi; - end else - if ADrawMode <> dmSetExceptTransparent then - begin - if asum = 0 then - begin - if ADrawMode = dmSet then - pdest^ := BGRAPixelTransparent; - for iy := factorY-1 downto 0 do - inc(psrc[iy],factorX); - end - else - begin - r := 0; - g := 0; - b := 0; - for iy := factorY-1 downto 0 do - for ix := factorX-1 downto 0 do - begin - with psrc[iy]^ do - begin - inc(r, red*alpha); - inc(g, green*alpha); - inc(b, blue*alpha); - end; - inc(psrc[iy]); - end; - if ADrawMode = dmSet then - begin - pdest^.alpha := (asum + (nbi shr 1)) div nbi; - pdest^.red := (r + (asum shr 1)) div asum; - pdest^.green := (g + (asum shr 1)) div asum; - pdest^.blue := (b + (asum shr 1)) div asum; - end - else - begin - if ADrawMode = dmDrawWithTransparency then - DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum, - (g + (asum shr 1)) div asum, - (b + (asum shr 1)) div asum, - (asum + (nbi shr 1)) div nbi)) else - if ADrawMode = dmFastBlend then - FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum, - (g + (asum shr 1)) div asum, - (b + (asum shr 1)) div asum, - (asum + (nbi shr 1)) div nbi)); - end; - end; - end; - inc(pdest); - end; - end; -end; - -function DownSample(source: TBGRACustomBitmap; factorX, factorY: integer): TBGRACustomBitmap; -begin - if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then - raise exception.Create('Source size must be a multiple of factorX and factorY'); - result := source.NewBitmap(source.Width div factorX, source.Height div factorY); - DownSamplePutImage(source,factorX,factorY,result,0,0,dmSet); -end; - -{---------------------------- Interpolation filters ----------------------------------------} - -function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single; -begin - if ResampleFilter <= rfLinear then - begin - if ResampleFilter = rfBox then - begin - result := round(t); - end else - result := t; - end else - begin - if t <= 0.5 then - result := t*t*2 else - result := 1-(1-t)*(1-t)*2; - if ResampleFilter <> rfCosine then result := (result+t)*0.5; - end; -end; - -function FineInterpolation256(t256: integer; ResampleFilter: TResampleFilter): integer; -begin - if ResampleFilter <= rfLinear then - begin - if ResampleFilter = rfBox then - begin - if t256 < 128 then - result := 0 - else - result := 256; - end - else - result := t256; - end else - begin - if t256 <= 128 then - result := (t256*t256) shr 7 else - result := 256 - (((256-t256)*(256-t256)) shr 7); - if ResampleFilter <> rfCosine then result := (result+t256) shr 1; - end; -end; - -{ TCubicKernel } - -function TCubicKernel.pow3(x: single): single; -begin - if x <= 0.0 then - result:=0.0 - else - result:=x * x * x; -end; - -function TCubicKernel.Interpolation(t: single): single; -const globalfactor = 1/6; -begin - if t > 2 then - result := 0 - else - result:= globalfactor * - (pow3(t + 2 ) - 4 * pow3(t + 1 ) + 6 * pow3(t ) - 4 * pow3(t - 1 ) ); -end; - -function TCubicKernel.ShouldCheckRange: boolean; -begin - Result:= false; -end; - -function TCubicKernel.KernelWidth: single; -begin - Result:= 2; -end; - -{ TMitchellKernel } - -function TMitchellKernel.Interpolation(t: single): single; -var - tt, ttt: single; -const OneEighteenth = 1 / 18; -begin - t := Abs(t); - tt := Sqr(t); - ttt := tt * t; - if t < 1 then Result := (21 * ttt - 36 * tt + 16 ) * OneEighteenth - else if t < 2 then Result := (- 7 * ttt + 36 * tt - 60 * t + 32) * OneEighteenth - else Result := 0; -end; - -function TMitchellKernel.ShouldCheckRange: Boolean; -begin - Result := True; -end; - -function TMitchellKernel.KernelWidth: single; -begin - Result := 2; -end; - -{ TSplineKernel } - -constructor TSplineKernel.Create; -begin - coeff := 0.5; -end; - -constructor TSplineKernel.Create(ACoeff: single); -begin - Coeff := ACoeff; -end; - -function TSplineKernel.Interpolation(t: single): single; -var - tt, ttt: single; -begin - t := Abs(t); - tt := Sqr(t); - ttt := tt * t; - if t < 1 then - Result := (2 - Coeff) * ttt - (3 - Coeff) * tt + 1 - else if t < 2 then - Result := -Coeff * (ttt - 5 * tt + 8 * t - 4) - else - Result := 0; -end; - -function TSplineKernel.ShouldCheckRange: Boolean; -begin - Result := True; -end; - -function TSplineKernel.KernelWidth: single; -begin - Result := 2; -end; - -{ TLanczosKernel } -{ by stab } -procedure TLanczosKernel.SetNumberOfLobes(AValue: integer); -begin - if AValue < 1 then AValue := 1; - if FNumberOfLobes=AValue then Exit; - FNumberOfLobes:=AValue; - if AValue = 1 then FFactor := 1.5 else FFactor := AValue; -end; - -constructor TLanczosKernel.Create(ANumberOfLobes: integer); -begin - NumberOfLobes:= ANumberOfLobes; -end; - -function TLanczosKernel.Interpolation(t: single): single; -var Pi_t: ValReal; -begin - if t = 0 then - Result := 1 - else if t < FNumberOfLobes then - begin - Pi_t := pi * t; - Result := FFactor * sin(Pi_t) * sin(Pi_t / FNumberOfLobes) / - (Pi_t * Pi_t) - end - else - Result := 0; -end; - -function TLanczosKernel.ShouldCheckRange: boolean; -begin - Result := True; -end; - -function TLanczosKernel.KernelWidth: single; -begin - Result := FNumberOfLobes; -end; - -{--------------------------------------------- Fine resample ------------------------------------------------} - -function FineResampleLarger(bmp: TBGRACustomBitmap; - newWidth, newHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap; -type - TInterpolationEntry = record - isrc1,isrc2,factCorr: integer; - end; -var - yb, xb: integer; - pdest,psrc1,psrc2: PBGRAPixel; - xsrc, ysrc, xfactor, yfactor: double; - xTab,yTab: array of TInterpolationEntry; - xInfo,yInfo: TInterpolationEntry; - cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel; - factHoriz, factVert: single; - fUpLeft, fUpRight, fLowLeft, fLowRight: integer; - faUpLeft, faUpRight, faLowLeft, faLowRight: integer; - rSum, gSum, bSum, aSum: integer; - temp: TBGRACustomBitmap; -begin - if (newWidth < bmp.Width) or (newHeight < bmp.Height) then - raise ERangeError.Create('FineResampleLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')'); - - if (newWidth = 0) or (newHeight = 0) then - begin - Result := bmp.NewBitmap(NewWidth, NewHeight); - exit; - end; - - bmp.LoadFromBitmapIfNeeded; - - if (bmp.Width = 1) and (bmp.Height = 1) then - begin - Result := bmp.NewBitmap(NewWidth, NewHeight); - Result.Fill(bmp.GetPixel(0, 0)); - exit; - end - else - if bmp.Width = 1 then - begin - temp := bmp.NewBitmap(2, bmp.Height); - temp.PutImage(0, 0, bmp, dmSet); - temp.PutImage(1, 0, bmp, dmSet); - Result := FineResampleLarger(temp, 2, newHeight, ResampleFilter); - temp.Free; - temp := Result; - Result := SimpleStretch(temp, newWidth,temp.Height); - temp.Free; - exit; - end - else - if bmp.Height = 1 then - begin - temp := bmp.NewBitmap(bmp.Width, 2); - temp.PutImage(0, 0, bmp, dmSet); - temp.PutImage(0, 1, bmp, dmSet); - Result := FineResampleLarger(temp, newWidth, 2, ResampleFilter); - temp.Free; - temp := Result; - Result := SimpleStretch(temp, temp.Width,newHeight); - temp.Free; - exit; - end; - - Result := bmp.NewBitmap(NewWidth, NewHeight); - yfactor := (bmp.Height - 1) / (newHeight - 1); - xfactor := (bmp.Width - 1) / (newWidth - 1); - - setlength(yTab, newHeight); - for yb := 0 to newHeight - 1 do - begin - ysrc := yb * yfactor; - factVert := frac(ysrc); - yTab[yb].isrc1 := floor(ysrc); - yTab[yb].isrc2 := min(bmp.Height-1, ceil(ysrc)); - yTab[yb].factCorr := round(FineInterpolation(factVert,ResampleFilter)*256); - end; - setlength(xTab, newWidth); - for xb := 0 to newWidth - 1 do - begin - xsrc := xb * xfactor; - factHoriz := frac(xsrc); - xTab[xb].isrc1 := floor(xsrc); - xTab[xb].isrc2 := min(bmp.Width-1,ceil(xsrc)); - xTab[xb].factCorr := round(FineInterpolation(factHoriz,ResampleFilter)*256); - end; - - for yb := 0 to newHeight - 1 do - begin - pdest := Result.Scanline[yb]; - yInfo := yTab[yb]; - psrc1 := bmp.scanline[yInfo.isrc1]; - psrc2 := bmp.scanline[yInfo.isrc2]; - for xb := 0 to newWidth - 1 do - begin - xInfo := xTab[xb]; - - cUpLeft := (psrc1 + xInfo.isrc1)^; - cUpRight := (psrc1 + xInfo.isrc2)^; - cLowLeft := (psrc2 + xInfo.isrc1)^; - cLowRight := (psrc2 + xInfo.isrc2)^; - - fLowRight := (xInfo.factCorr * yInfo.factCorr + 128) shr 8; - fLowLeft := yInfo.factCorr - fLowRight; - fUpRight := xInfo.factCorr - fLowRight; - fUpLeft := (256 - xInfo.factCorr) - fLowLeft; - - faUpLeft := fUpLeft * cUpLeft.alpha; - faUpRight := fUpRight * cUpRight.alpha; - faLowLeft := fLowLeft * cLowLeft.alpha; - faLowRight := fLowRight * cLowRight.alpha; - - rSum := cUpLeft.red * faUpLeft + cUpRight.red * faUpRight + - cLowLeft.red * faLowLeft + cLowRight.red * faLowRight; - gSum := cUpLeft.green * faUpLeft + cUpRight.green * faUpRight + - cLowLeft.green * faLowLeft + cLowRight.green * faLowRight; - bSum := cUpLeft.blue * faUpLeft + cUpRight.blue * faUpRight + - cLowLeft.blue * faLowLeft + cLowRight.blue * faLowRight; - aSum := cUpLeft.alpha * fUpLeft + cUpRight.alpha * fUpRight + - cLowLeft.alpha * fLowLeft + cLowRight.alpha * fLowRight; - - if aSum = 0 then - pdest^ := BGRAPixelTransparent - else - pdest^ := BGRA((rSum + aSum shr 1) div aSum, (gSum + aSum shr 1) div aSum, - (bSum + aSum shr 1) div aSum, (aSum + 128) shr 8); - Inc(pdest); - - end; - end; -end; - -function FineResampleSmaller(bmp: TBGRACustomBitmap; - newWidth, newHeight: integer): TBGRACustomBitmap; -var - yb, xb, yb2, xb2: integer; - pdest, psrc: PBGRAPixel; - lineDelta, delta: integer; - xsrc1, ysrc1, xsrc2, ysrc2, xfactor, yfactor: double; - ixsrc1, ixsrc2, iysrc1, iysrc2, ixsrc1p1, ixsrc2m1, iysrc1p1, iysrc2m1: integer; - cBorder, cFull, cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel; - factHoriz1, factHoriz2, factVert1, factVert2, Sum, fUpLeft, fUpRight, - fLowLeft, fLowRight, faUpLeft, faUpRight, faLowLeft, faLowRight: single; - rSum, gSum, bSum, aSum: double; -begin - if (newWidth > bmp.Width) or (newHeight > bmp.Height) then - raise ERangeError.Create('FineResampleSmaller: New dimensions must be smaller or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')'); - Result := bmp.NewBitmap(NewWidth, NewHeight); - if (newWidth = 0) or (newHeight = 0) or (bmp.Width = 0) or (bmp.Height = 0) then - exit; - - bmp.LoadFromBitmapIfNeeded; - - if bmp.lineOrder = riloTopToBottom then - lineDelta := bmp.Width - else - lineDelta := -bmp.Width; - - yfactor := bmp.Height / newHeight; - xfactor := bmp.Width / newWidth; - for yb := 0 to newHeight - 1 do - begin - pdest := Result.Scanline[yb]; - ysrc1 := yb * yfactor; - ysrc2 := (yb + 1) * yfactor; - iysrc1 := trunc(ysrc1); - if (int(ysrc2) = int(ysrc1)) or (ysrc2 = iysrc1 + 1) then - begin - iysrc2 := iysrc1; - factVert1 := 1; - factVert2 := 0; - end - else - begin - iysrc2 := trunc(ysrc2); - factVert1 := 1 - frac(ysrc1); - factVert2 := frac(ysrc2); - end; - for xb := 0 to newWidth - 1 do - begin - xsrc1 := xb * xfactor; - xsrc2 := (xb + 1) * xfactor; - ixsrc1 := trunc(xsrc1); - if (int(xsrc2) = int(xsrc1)) or (xsrc2 = ixsrc1 + 1) then - begin - ixsrc2 := ixsrc1; - factHoriz1 := 1; - factHoriz2 := 0; - end - else - begin - ixsrc2 := trunc(xsrc2); - factHoriz1 := 1 - frac(xsrc1); - factHoriz2 := frac(xsrc2); - end; - - cUpLeft := bmp.GetPixel(ixsrc1, iysrc1); - cUpRight := bmp.GetPixel(ixsrc2, iysrc1); - cLowLeft := bmp.GetPixel(ixsrc1, iysrc2); - cLowRight := bmp.GetPixel(ixsrc2, iysrc2); - - fUpLeft := factHoriz1 * factVert1; - fUpRight := factHoriz2 * factVert1; - fLowLeft := factHoriz1 * factVert2; - fLowRight := factHoriz2 * factVert2; - - faUpLeft := fUpLeft * cUpLeft.alpha; - faUpRight := fUpRight * cUpRight.alpha; - faLowLeft := fLowLeft * cLowLeft.alpha; - faLowRight := fLowRight * cLowRight.alpha; - - Sum := fUpLeft + fUpRight + fLowLeft + fLowRight; - rSum := cUpLeft.red * faUpLeft + cUpRight.red * faUpRight + - cLowLeft.red * faLowLeft + cLowRight.red * faLowRight; - gSum := cUpLeft.green * faUpLeft + cUpRight.green * faUpRight + - cLowLeft.green * faLowLeft + cLowRight.green * faLowRight; - bSum := cUpLeft.blue * faUpLeft + cUpRight.blue * faUpRight + - cLowLeft.blue * faLowLeft + cLowRight.blue * faLowRight; - aSum := cUpLeft.alpha * fUpLeft + cUpRight.alpha * fUpRight + - cLowLeft.alpha * fLowLeft + cLowRight.alpha * fLowRight; - - ixsrc1p1 := ixsrc1 + 1; - ixsrc2m1 := ixsrc2 - 1; - iysrc1p1 := iysrc1 + 1; - iysrc2m1 := iysrc2 - 1; - - if ixsrc2m1 >= ixsrc1p1 then - begin - psrc := bmp.scanline[iysrc1] + ixsrc1p1; - for xb2 := ixsrc1p1 to ixsrc2m1 do - begin - cBorder := psrc^; - Inc(psrc); - IncF(rSum, cBorder.red * cBorder.alpha * factVert1); - IncF(gSum, cBorder.green * cBorder.alpha * factVert1); - IncF(bSum, cBorder.blue * cBorder.alpha * factVert1); - IncF(aSum, cBorder.alpha * factVert1); - IncF(Sum, factVert1); - end; - - if (factVert2 <> 0) and (iysrc2 < bmp.Height) then - begin - psrc := bmp.scanline[iysrc2] + ixsrc1p1; - for xb2 := ixsrc1p1 to ixsrc2m1 do - begin - cBorder := psrc^; - Inc(psrc); - IncF(rSum, cBorder.red * cBorder.alpha * factVert2); - IncF(gSum, cBorder.green * cBorder.alpha * factVert2); - IncF(bSum, cBorder.blue * cBorder.alpha * factVert2); - IncF(aSum, cBorder.alpha * factVert2); - IncF(Sum, factVert2); - end; - end; - end; - - if iysrc2m1 >= iysrc1p1 then - begin - psrc := bmp.scanline[iysrc1p1] + ixsrc1; - for yb2 := iysrc1p1 to iysrc2m1 do - begin - cBorder := psrc^; - Inc(psrc, lineDelta); - IncF(rSum, cBorder.red * cBorder.alpha * factHoriz1); - IncF(gSum, cBorder.green * cBorder.alpha * factHoriz1); - IncF(bSum, cBorder.blue * cBorder.alpha * factHoriz1); - IncF(aSum, cBorder.alpha * factHoriz1); - IncF(Sum, factHoriz1); - end; - - if (factHoriz2 <> 0) and (ixsrc2 < bmp.Width) then - begin - psrc := bmp.scanline[iysrc1p1] + ixsrc2; - for yb2 := iysrc1p1 to iysrc2m1 do - begin - cBorder := psrc^; - Inc(psrc, lineDelta); - IncF(rSum, cBorder.red * cBorder.alpha * factHoriz2); - IncF(gSum, cBorder.green * cBorder.alpha * factHoriz2); - IncF(bSum, cBorder.blue * cBorder.alpha * factHoriz2); - IncF(aSum, cBorder.alpha * factHoriz2); - IncF(Sum, factHoriz2); - end; - end; - end; - - if (ixsrc2m1 >= ixsrc1p1) and (iysrc2m1 >= iysrc1p1) then - begin - delta := lineDelta - (ixsrc2m1 - ixsrc1p1 + 1); - psrc := bmp.scanline[iysrc1p1] + ixsrc1p1; - for yb2 := iysrc1p1 to iysrc2m1 do - begin - for xb2 := ixsrc1p1 to ixsrc2m1 do - begin - cFull := psrc^; - IncF(rSum, cFull.red * cFull.alpha); - IncF(gSum, cFull.green * cFull.alpha); - IncF(bSum, cFull.blue * cFull.alpha); - IncF(aSum, cFull.alpha); - IncF(Sum, 1); - Inc(psrc); - end; - Inc(psrc, delta); - end; - end; - - if aSum = 0 then - pdest^ := BGRAPixelTransparent - else - pdest^ := BGRA(round(rSum / aSum), round(gSum / aSum), - round(bSum / aSum), round(aSum / Sum)); - Inc(pdest); - - end; - end; -end; - -function CreateInterpolator(style: TSplineStyle): TWideKernelFilter; -begin - case Style of - ssInside, ssInsideWithEnds: result := TCubicKernel.Create; - ssCrossing, ssCrossingWithEnds: result := TMitchellKernel.Create; - ssOutside: result := TSplineKernel.Create(0.5); - ssRoundOutside: result := TSplineKernel.Create(0.75); - ssVertexToSide: result := TSplineKernel.Create(1); - ssEasyBezier: raise Exception.Create('EasyBezier does not have an interpolator'); - else - raise Exception.Create('Unknown spline style'); - end; -end; - -function FineResample(bmp: TBGRACustomBitmap; - NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap; -var - temp, newtemp: TBGRACustomBitmap; - tempFilter1,tempFilter2: TWideKernelFilter; -begin - if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then - begin - Result := bmp.Duplicate; - exit; - end; - case ResampleFilter of - rfBicubic: //blur - begin - tempFilter1 := TCubicKernel.Create; - result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); - tempFilter1.Free; - exit; - end; - rfMitchell: - begin - tempFilter1 := TMitchellKernel.Create; - result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); - tempFilter1.Free; - exit; - end; - rfSpline: - begin - tempFilter1 := TSplineKernel.Create; - result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); - tempFilter1.Free; - exit; - end; - rfLanczos2,rfLanczos3,rfLanczos4: - begin - tempFilter1 := TLanczosKernel.Create(ord(ResampleFilter)-ord(rfLanczos2)+2); - result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1); - tempFilter1.Free; - exit; - end; - rfBestQuality: - begin - tempFilter1 := TSplineKernel.Create; - tempFilter2 := TMitchellKernel.Create; - result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter2,tempFilter1); - tempFilter1.Free; - tempFilter2.Free; - exit; - end; - end; - - if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then - Result := FineResampleLarger(bmp, NewWidth, NewHeight, ResampleFilter) - else - if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then - Result := FineResampleSmaller(bmp, NewWidth, NewHeight) - else - begin - temp := bmp; - - if NewWidth < bmp.Width then - begin - newtemp := FineResampleSmaller(temp, NewWidth, temp.Height); - if (temp <> bmp) then - temp.Free; - temp := newtemp; - end; - - if NewHeight < bmp.Height then - begin - newtemp := FineResampleSmaller(temp, temp.Width, NewHeight); - if (temp <> bmp) then - temp.Free; - temp := newtemp; - end; - - if NewWidth > bmp.Width then - begin - newtemp := FineResampleLarger(temp, NewWidth, temp.Height, ResampleFilter); - if (temp <> bmp) then - temp.Free; - temp := newtemp; - end; - - if NewHeight > bmp.Height then - begin - newtemp := FineResampleLarger(temp, temp.Width, NewHeight, ResampleFilter); - if (temp <> bmp) then - temp.Free; - temp := newtemp; - end; - - if temp <> bmp then - Result := temp - else - Result := bmp.Duplicate; - end; -end; - -{------------------------ Wide kernel filtering adapted from Graphics32 ---------------------------} - -function Constrain(const Value, Lo, Hi: Integer): Integer; -begin - if Value < Lo then - Result := Lo - else if Value > Hi then - Result := Hi - else - Result := Value; -end; - -type - TPointRec = record - Pos: Integer; - Weight: Single; - end; - - TCluster = array of TPointRec; - TMappingTable = array of TCluster; - -{$warnings off} -function BuildMappingTable( - DstLo, DstHi: Integer; - ClipLo, ClipHi: Integer; - SrcLo, SrcHi: Integer; - KernelSmaller,KernelLarger: TWideKernelFilter): TMappingTable; -Const FullEdge = false; -var - SrcW, DstW, ClipW: Integer; - FilterWidth: Single; - Scale, OldScale: Single; - Center: Single; - Left, Right: Integer; - I, J, K: Integer; - Weight: Single; -begin - SrcW := SrcHi - SrcLo; - DstW := DstHi - DstLo; - ClipW := ClipHi - ClipLo; - if SrcW = 0 then - begin - Result := nil; - Exit; - end - else if SrcW = 1 then - begin - SetLength(Result, ClipW); - for I := 0 to ClipW - 1 do - begin - SetLength(Result[I], 1); - Result[I][0].Pos := 0; - Result[I][0].Weight := 1; - end; - Exit; - end; - SetLength(Result, ClipW); - if ClipW = 0 then Exit; - - if FullEdge then Scale := DstW / SrcW - else Scale := (DstW - 1) / (SrcW - 1); - - K := 0; - - if Scale = 0 then - begin - SetLength(Result[0], 1); - Result[0][0].Pos := (SrcLo + SrcHi) div 2; - Result[0][0].Weight := 1; - end - else if Scale < 1 then - begin - FilterWidth := KernelSmaller.KernelWidth; - OldScale := Scale; - Scale := 1 / Scale; - FilterWidth := FilterWidth * Scale; - for I := 0 to ClipW - 1 do - begin - if FullEdge then - Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale - else - Center := SrcLo + (I - DstLo + ClipLo) * Scale; - Left := Floor(Center - FilterWidth); - Right := Ceil(Center + FilterWidth); - for J := Left to Right do - begin - Weight := KernelSmaller.Interpolation((Center - J) * OldScale) * OldScale; - if Weight <> 0 then - begin - K := Length(Result[I]); - SetLength(Result[I], K + 1); - Result[I][K].Pos := Constrain(J, SrcLo, SrcHi - 1); - Result[I][K].Weight := Weight; - end; - end; - if Length(Result[I]) = 0 then - begin - SetLength(Result[I], 1); - Result[I][0].Pos := Floor(Center); - Result[I][0].Weight := 1; - end; - end; - end - else // scale > 1 - begin - FilterWidth := KernelLarger.KernelWidth; - Scale := 1 / Scale; - for I := 0 to ClipW - 1 do - begin - if FullEdge then - Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale - else - Center := SrcLo + (I - DstLo + ClipLo) * Scale; - Left := Floor(Center - FilterWidth); - Right := Ceil(Center + FilterWidth); - for J := Left to Right do - begin - Weight := KernelLarger.Interpolation(Center - j); - if Weight <> 0 then - begin - K := Length(Result[I]); - SetLength(Result[I], k + 1); - Result[I][K].Pos := Constrain(j, SrcLo, SrcHi - 1); - Result[I][K].Weight := Weight; - end; - end; - end; - end; -end; -{$warnings on} - -function WideKernelResample(bmp: TBGRACustomBitmap; - NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap; -type - TSum = record - sumR,sumG,sumB,sumA: single; - end; - -var - mapX,mapY: TMappingTable; - xb,yb,xc,yc,MapXLoPos,MapXHiPos: integer; - clusterX,clusterY: TCluster; - verticalSum: array of TSum; - scanlinesSrc: array of PBGRAPixel; - sum: TSum; - c: TBGRAPixel; - w,wa: single; - pdest: PBGRAPixel; -begin - result := bmp.NewBitmap(NewWidth,NewHeight); - if (NewWidth=0) or (NewHeight=0) then exit; - mapX := BuildMappingTable(0,NewWidth,0,NewWidth,0,bmp.Width,ResampleFilterSmaller,ResampleFilterLarger); - mapY := BuildMappingTable(0,NewHeight,0,NewHeight,0,bmp.Height,ResampleFilterSmaller,ResampleFilterLarger); - - MapXLoPos := MapX[0][0].Pos; - MapXHiPos := MapX[NewWidth - 1][High(MapX[NewWidth - 1])].Pos; - - setlength(verticalSum, MapXHiPos-MapXLoPos+1); - - setlength(scanlinesSrc, bmp.Height); - for yb := 0 to bmp.Height-1 do - scanlinesSrc[yb] := bmp.ScanLine[yb]; - - for yb := 0 to NewHeight-1 do - begin - clusterY := mapY[yb]; - - for xb := MapXLoPos to MapXHiPos do - begin - fillchar(verticalSum[xb - MapXLoPos],sizeof(verticalSum[xb - MapXLoPos]),0); - for yc := 0 to high(clusterY) do - with verticalSum[xb - MapXLoPos] do - begin - c := (scanlinesSrc[clusterY[yc].Pos]+xb)^; - w := clusterY[yc].Weight; - wa := w * c.alpha; - IncF(sumA, wa); - IncF(sumR, c.red * wa); - IncF(sumG, c.green * wa); - IncF(sumB, c.blue * wa); - end; - end; - - pdest := result.Scanline[yb]; - - for xb := 0 to NewWidth-1 do - begin - clusterX := mapX[xb]; - {$hints off} - fillchar(sum,sizeof(sum),0); - {$hints on} - for xc := 0 to high(clusterX) do - begin - w := clusterX[xc].Weight; - with verticalSum[ClusterX[xc].Pos - MapXLoPos] do - begin - IncF(sum.sumA, sumA*w); - IncF(sum.sumR, sumR*w); - IncF(sum.sumG, sumG*w); - IncF(sum.sumB, sumB*w); - end; - end; - - if sum.sumA < 0.5 then - pdest^ := BGRAPixelTransparent else - begin - c.red := constrain(round(sum.sumR/sum.sumA),0,255); - c.green := constrain(round(sum.sumG/sum.sumA),0,255); - c.blue := constrain(round(sum.sumB/sum.sumA),0,255); - if sum.sumA > 255 then - c.alpha := 255 else - c.alpha := round(sum.sumA); - pdest^ := c; - end; - inc(pdest); - end; - end; - -end; - -end. - diff --git a/components/bgrabitmap/bgrascanner.inc b/components/bgrabitmap/bgrascanner.inc deleted file mode 100644 index 5af3648..0000000 --- a/components/bgrabitmap/bgrascanner.inc +++ /dev/null @@ -1,266 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type - TBGRACustomBitmap = class; - -{=== IBGRAScanner ===} - {* Interface for a scanner. A scanner is like an image, but its content - has no limit and it can be calculated on the fly. It is like a - infinite readonly image. - * - * Note: it must not implement reference counting even if it is an interface - * - * ''TBGRACustomBitmap'' implements this interface and the content is repeated - horizontally and vertically. There are also various classes - in ''BGRAGradientScanner'' unit that generate gradients on the fly and - in ''BGRATransform'' unit that provide geometrical transformations of images } - IBGRAScanner = interface - {** Move to the position (''X'',''Y'') for the next call to ''ScanNextPixel'' } - procedure ScanMoveTo(X,Y: Integer); - {** Scan the pixel at the current location and increments ''X'' } - function ScanNextPixel: TBGRAPixel; - function ScanNextExpandedPixel: TExpandedPixel; - {** Scan at any location using floating point coordinates } - function ScanAt(X,Y: Single): TBGRAPixel; - function ScanAtExpanded(X,Y: Single): TExpandedPixel; - {** Scan at any location using integer coordinates } - function ScanAtInteger(X,Y: integer): TBGRAPixel; - function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel; - {** Copy a row of pixels from ''X'' to ''X''+''count''-1 to a specified destination - ''pdest''. ''mode'' indicates how to combine with existing data } - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); - procedure ScanSkipPixels(ACount: integer); - {** Returns True if the function ''ScanPutPixels'' is available. Otherwise - you need to call ''ScanNextPixel'' and combine pixels for example - with ''SetPixel'' } - function IsScanPutPixelsDefined: boolean; - {** Returns the corresponding OpenGL texture. The value is ''nil'' if no texture is associated. **} - function GetTextureGL: IUnknown; - function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; - function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; - function ProvidesScanline(ARect: TRect): boolean; - function GetScanlineAt(X,Y: integer): PBGRAPixel; - function GetScanCustomColorspace: TColorspaceAny; - procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer); - procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); - function ScanAtIntegerMask(X,Y: integer): TByteMask; - function ScanAtMask(X,Y: Single): TByteMask; - end; - - {** A type of function of a scanner that returns the content at floating point coordinates } - TScanAtFunction = function (X,Y: Single): TBGRAPixel of object; - {** A type of function of a scanner that returns the content at integer coordinates } - TScanAtIntegerFunction = function (X,Y: Integer): TBGRAPixel of object; - {** A type of function of a scanner that returns the next pixel } - TScanNextPixelFunction = function: TBGRAPixel of object; - - { TBGRACustomScanner } - {* Base class for implementing ''IBGRAScanner'' interface } - TBGRACustomScanner = class(IBGRAScanner) - private - FCurX,FCurY: integer; - FOwnCur: boolean; - FChunk: packed array[0..3] of TExpandedPixel; - public - function ScanAtInteger(X,Y: integer): TBGRAPixel; virtual; - function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel; virtual; - procedure ScanMoveTo(X,Y: Integer); virtual; - function ScanNextPixel: TBGRAPixel; virtual; - function ScanNextExpandedPixel: TExpandedPixel; virtual; - function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract; - function ScanAtExpanded(X,Y: Single): TExpandedPixel; virtual; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual; - procedure ScanSkipPixels(ACount: integer); virtual; - function IsScanPutPixelsDefined: boolean; virtual; - function GetTextureGL: IUnknown; virtual; - function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; virtual; - function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; virtual; - function ProvidesScanline({%H-}ARect: TRect): boolean; virtual; - function GetScanlineAt({%H-}X,{%H-}Y: integer): PBGRAPixel; virtual; - function GetScanCustomColorspace: TColorspaceAny; virtual; - procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer); virtual; - procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); virtual; - function ScanAtIntegerMask(X,Y: integer): TByteMask; virtual; - function ScanAtMask(X,Y: Single): TByteMask; virtual; - protected - function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - end; -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} -{ TBGRACustomScanner } -{ The abstract class record the position so that a derived class - need only to redefine ScanAt } - -function TBGRACustomScanner.ScanAtInteger(X, Y: integer): TBGRAPixel; -begin - result := ScanAt(X,Y); -end; - -function TBGRACustomScanner.ScanAtIntegerExpanded(X, Y: integer - ): TExpandedPixel; -begin - result := GammaExpansion(ScanAtInteger(X,Y)); -end; - -procedure TBGRACustomScanner.ScanMoveTo(X, Y: Integer); -begin - FCurX := X; - FCurY := Y; - FOwnCur := true; -end; - -{ Call ScanAt to determine pixel value } -function TBGRACustomScanner.ScanNextPixel: TBGRAPixel; -begin - result := ScanAt(FCurX,FCurY); - Inc(FCurX); -end; - -function TBGRACustomScanner.ScanNextExpandedPixel: TExpandedPixel; -begin - result := GammaExpansion(ScanNextPixel); -end; - -function TBGRACustomScanner.ScanAtExpanded(X, Y: Single): TExpandedPixel; -begin - result := GammaExpansion(ScanAt(X,Y)); -end; - -{$hints off} -procedure TBGRACustomScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; - mode: TDrawMode); -begin - //do nothing -end; - -procedure TBGRACustomScanner.ScanSkipPixels(ACount: integer); -begin - if FOwnCur then inc(FCurX, ACount) - else - begin - while ACount > 0 do - begin - ScanNextPixel; - dec(ACount); - end; - end; -end; - -{$hints on} - -function TBGRACustomScanner.IsScanPutPixelsDefined: boolean; -begin - result := false; -end; - -function TBGRACustomScanner.GetTextureGL: IUnknown; -begin - result := nil; -end; - -function TBGRACustomScanner.GetImageBoundsWithin(const ARect: TRect; - Channel: TChannel; ANothingValue: Byte): TRect; -begin - result := InternalGetImageBoundsWithin(nil,self,ARect,[Channel],ANothingValue); -end; - -function TBGRACustomScanner.GetImageBoundsWithin(const ARect: TRect; - Channels: TChannels; ANothingValue: Byte): TRect; -begin - result := InternalGetImageBoundsWithin(nil,self,ARect,Channels,ANothingValue); -end; - -function TBGRACustomScanner.ProvidesScanline(ARect: TRect): boolean; -begin - result := false; -end; - -function TBGRACustomScanner.GetScanlineAt(X, Y: integer): PBGRAPixel; -begin - result := nil; -end; - -function TBGRACustomScanner.GetScanCustomColorspace: TColorspaceAny; -begin - result := TExpandedPixelColorspace; -end; - -procedure TBGRACustomScanner.ScanNextCustomChunk(var ACount: integer; out - APixels: Pointer); -var - i: Integer; - p: PExpandedPixel; -begin - if ACount > length(FChunk) then ACount := length(FChunk); - p := @FChunk[low(FChunk)]; - APixels := p; - for i := ACount-1 downto 0 do - begin - p^ := ScanNextExpandedPixel; - inc(p); - end; -end; - -procedure TBGRACustomScanner.ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); -var - cs: TColorspaceAny; - pPixels: Pointer; -begin - cs := GetScanCustomColorspace; - if cs = TBGRAPixelColorspace then - begin - ScanNextCustomChunk(ACount, pPixels); - AMask := @PBGRAPixel(pPixels)^.green; - AStride := sizeof(TBGRAPixel); - end else - if cs = TByteMaskColorspace then - begin - ScanNextCustomChunk(ACount, pPixels); - AMask := PByteMask(pPixels); - AStride := sizeof(TByteMask); - end else - raise exception.Create('This scanner does not provide a mask.'); -end; - -function TBGRACustomScanner.ScanAtIntegerMask(X,Y: integer): TByteMask; -begin - if GetScanCustomColorspace = TBGRAPixelColorspace then - result := ScanAtInteger(X,Y).green - else - result := ScanAtMask(X,Y); -end; - -function TBGRACustomScanner.ScanAtMask(X,Y: Single): TByteMask; -begin - if GetScanCustomColorspace = TBGRAPixelColorspace then - result := ScanAt(X,Y).green - else - raise exception.Create('This scanner does not provide a mask.'); -end; - -{ Interface gateway } -function TBGRACustomScanner.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - if GetInterface(iid, obj) then - Result := S_OK - else - Result := longint(E_NOINTERFACE); -end; - -{ There is no automatic reference counting, but it is compulsory to define these functions } -function TBGRACustomScanner._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -function TBGRACustomScanner._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -{$ENDIF} \ No newline at end of file diff --git a/components/bgrabitmap/bgrascene3d.pas b/components/bgrabitmap/bgrascene3d.pas deleted file mode 100644 index 3ca41b8..0000000 --- a/components/bgrabitmap/bgrascene3d.pas +++ /dev/null @@ -1,1643 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAScene3D; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, BGRAColorInt, - BGRASSE, BGRAMatrix3D, - BGRASceneTypes, BGRARenderer3D; - -type - TProjection3D = BGRAMatrix3D.TProjection3D; - TLightingNormal3D = BGRASceneTypes.TLightingNormal3D; - TLightingInterpolation3D = BGRASceneTypes.TLightingInterpolation3D; - TAntialiasingMode3D = BGRASceneTypes.TAntialiasingMode3D; - TPerspectiveMode3D = BGRASceneTypes.TPerspectiveMode3D; - TRenderingOptions = BGRASceneTypes.TRenderingOptions; - - IBGRAVertex3D = BGRASceneTypes.IBGRAVertex3D; - IBGRANormal3D = BGRASceneTypes.IBGRANormal3D; - IBGRALight3D = BGRASceneTypes.IBGRALight3D; - IBGRADirectionalLight3D = BGRASceneTypes.IBGRADirectionalLight3D; - IBGRAPointLight3D = BGRASceneTypes.IBGRAPointLight3D; - IBGRAMaterial3D = BGRASceneTypes.IBGRAMaterial3D; - IBGRAFace3D = BGRASceneTypes.IBGRAFace3D; - IBGRAPart3D = BGRASceneTypes.IBGRAPart3D; - IBGRAObject3D = BGRASceneTypes.IBGRAObject3D; - - arrayOfIBGRAVertex3D = BGRASceneTypes.arrayOfIBGRAVertex3D; - -const - lnNone = BGRASceneTypes.lnNone; - lnFace = BGRASceneTypes.lnFace; - lnVertex = BGRASceneTypes.lnVertex; - lnFaceVertexMix = BGRASceneTypes.lnFaceVertexMix; - - liLowQuality = BGRASceneTypes.liLowQuality; - liSpecularHighQuality = BGRASceneTypes.liSpecularHighQuality; - liAlwaysHighQuality = BGRASceneTypes.liAlwaysHighQuality; - - am3dNone = BGRASceneTypes.am3dNone; - am3dMultishape = BGRASceneTypes.am3dMultishape; - am3dResample = BGRASceneTypes.am3dResample; - - pmLinearMapping = BGRASceneTypes.pmLinearMapping; - pmPerspectiveMapping = BGRASceneTypes.pmPerspectiveMapping; - pmZBuffer = BGRASceneTypes.pmZBuffer; - -type - - { TCamera3D } - - TCamera3D = class - private - procedure ComputeMatrix; - function GetLookWhere: TPoint3D; - function GetMatrix: TMatrix3D; - function GetViewPoint: TPoint3D; - procedure SetMatrix(AValue: TMatrix3D); - procedure SetViewPoint(AValue: TPoint3D); - protected - FMatrix: TMatrix3D; - FMatrixComputed: boolean; - FViewPoint: TPoint3D_128; - FLookWhere, FTopDir: TPoint3D_128; - public - procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); - procedure LookDown(angleDeg: single); - procedure LookLeft(angleDeg: single); - procedure LookRight(angleDeg: single); - procedure LookUp(angleDeg: single); - property ViewPoint: TPoint3D read GetViewPoint write SetViewPoint; - property LookWhere: TPoint3D read GetLookWhere; - property Matrix: TMatrix3D read GetMatrix write SetMatrix; - end; - - { TBGRAScene3D } - - TBGRAScene3D = class - private - FSurface: TBGRACustomBitmap; //destination of software renderer - FViewCenter: TPointF; //where origin is drawn - FAutoViewCenter: boolean; //use middle of the screen - FZoom: TPointF; //how much the drawing is zoomed - FAutoZoom: Boolean; //display 1 as 80% of surface size - FProjection: TProjection3D; //current projection - FRenderedFaceCount: integer; //current counter of rendered faces - - FCamera: TCamera3D; - - FObjects: array of IBGRAObject3D; - FObjectCount: integer; - FMaterials: array of IBGRAMaterial3D; - FMaterialCount: integer; - FDefaultMaterial : IBGRAMaterial3D; - - FAmbiantLightColorF: TColorF; //lightness without light sources - FLights: TList; //individual light sources - - function GetAmbiantLightColorF: TColorF; - function GetAmbiantLightness: single; - function GetAmbiantLightColor: TBGRAPixel; - function GetFaceCount: integer; - function GetLight(AIndex: integer): IBGRALight3D; - function GetLightCount: integer; - function GetMaterial(AIndex: integer): IBGRAMaterial3D; - function GetNormalCount: integer; - function GetObject(AIndex: integer): IBGRAObject3D; - function GetVertexCount: integer; - function GetViewCenter: TPointF; - function GetViewPoint: TPoint3D; - function GetZoom: TPointF; - procedure SetAmbiantLightColorF(const AValue: TColorF); - procedure SetAmbiantLightness(const AValue: single); - procedure SetAmbiantLightColor(const AValue: TBGRAPixel); - procedure SetAutoViewCenter(const AValue: boolean); - procedure SetAutoZoom(const AValue: boolean); - procedure SetViewCenter(const AValue: TPointF); - procedure SetViewPoint(const AValue: TPoint3D); - procedure ComputeView(ScaleX,ScaleY: single); - function ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF; - procedure AddObject(AObj: IBGRAObject3D); - procedure AddLight(ALight: TObject); - procedure AddMaterial(AMaterial: IBGRAMaterial3D); - procedure Init; - - protected - FRenderer: TCustomRenderer3D; - FMaterialLibrariesFetched: array of string; - FTexturesFetched: array of record - Name: string; - Bitmap: TBGRACustomBitmap; - end; - procedure UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); virtual; - function LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; virtual; - function FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner; virtual; - procedure HandleFetchException(AException: Exception); virtual; - procedure DoRender; virtual; - procedure DoClear; virtual; - function GetRenderWidth: integer; - function GetRenderHeight: integer; - procedure OnMaterialTextureChanged({%H-}ASender: TObject); virtual; - procedure SetDefaultMaterial(AValue: IBGRAMaterial3D); - procedure InvalidateMaterial; - - public - DefaultLightingNormal: TLightingNormal3D; - RenderingOptions: TRenderingOptions; - UnknownColor: TBGRAPixel; - FetchDirectory: string; - FetchThrowsException: boolean; - - constructor Create; overload; - constructor Create(ASurface: TBGRACustomBitmap); overload; - destructor Destroy; override; - procedure Clear; virtual; - function FetchObject(AName: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; - procedure FetchMaterials(ALibraryName: string); virtual; - function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; - function LoadObjectFromFileUTF8(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; - function LoadObjectFromStream(AStream: TStream; SwapFacesOrientation: boolean = true): IBGRAObject3D; - procedure LoadMaterialsFromFile(AFilename: string); - procedure LoadMaterialsFromFileUTF8(AFilename: string); - procedure LoadMaterialsFromStream(AStream: TStream); - procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); - procedure LookLeft(angleDeg: single); - procedure LookRight(angleDeg: single); - procedure LookUp(angleDeg: single); - procedure LookDown(angleDeg: single); - procedure Render; overload; virtual; - procedure Render(ARenderer: TCustomRenderer3D); overload; - function CreateObject: IBGRAObject3D; overload; - function CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; overload; - function CreateObject(AColor: TBGRAPixel): IBGRAObject3D; overload; - function CreateSphere(ARadius: Single; AHorizPrecision: integer = 8; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; - function CreateSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer = 8; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; - function CreateHalfSphere(ARadius: Single; AHorizPrecision: integer = 6; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; - function CreateHalfSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer = 6; AVerticalPrecision : integer = 6): IBGRAObject3D; overload; - procedure RemoveObject(AObject: IBGRAObject3D); - function AddDirectionalLight(ADirection: TPoint3D; ALightness: single = 1; AMinIntensity : single = 0): IBGRADirectionalLight3D; overload; - function AddDirectionalLight(ADirection: TPoint3D; AColor: TBGRAPixel; AMinIntensity: single = 0): IBGRADirectionalLight3D; overload; - function AddPointLight(AVertex: IBGRAVertex3D; AOptimalDistance: single; ALightness: single = 1; AMinIntensity : single = 0): IBGRAPointLight3D; overload; - function AddPointLight(AVertex: IBGRAVertex3D; AOptimalDistance: single; AColor: TBGRAPixel; AMinIntensity: single = 0): IBGRAPointLight3D; overload; - procedure RemoveLight(ALight: IBGRALight3D); - procedure SetZoom(value: Single); overload; - procedure SetZoom(value: TPointF); overload; - function CreateMaterial: IBGRAMaterial3D; overload; - function CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D; overload; - function GetMaterialByName(AName: string): IBGRAMaterial3D; - procedure UpdateMaterials; virtual; - procedure UpdateMaterial(AMaterialName: string); virtual; - procedure ForEachVertex(ACallback: TVertex3DCallback); - procedure ForEachFace(ACallback: TFace3DCallback); - function MakeLightList: TList; - - property ViewCenter: TPointF read GetViewCenter write SetViewCenter; - property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter; - property AutoZoom: boolean read FAutoZoom write SetAutoZoom; - property Surface: TBGRACustomBitmap read FSurface write FSurface; - property Object3D[AIndex: integer]: IBGRAObject3D read GetObject; - property Object3DCount: integer read FObjectCount; - property VertexCount: integer read GetVertexCount; - property NormalCount: integer read GetNormalCount; - property FaceCount: integer read GetFaceCount; - property Zoom: TPointF read GetZoom write SetZoom; - property AmbiantLightness: single read GetAmbiantLightness write SetAmbiantLightness; - property AmbiantLightColor: TBGRAPixel read GetAmbiantLightColor write SetAmbiantLightColor; - property AmbiantLightColorF: TColorF read GetAmbiantLightColorF write SetAmbiantLightColorF; - property LightCount: integer read GetLightCount; - property Light[AIndex: integer]: IBGRALight3D read GetLight; - property ViewPoint: TPoint3D read GetViewPoint write SetViewPoint; - property RenderedFaceCount : integer read FRenderedFaceCount; - property Material[AIndex: integer] : IBGRAMaterial3D read GetMaterial; - property MaterialCount: integer read FMaterialCount; - property Camera: TCamera3D read FCamera; - property DefaultMaterial: IBGRAMaterial3D read FDefaultMaterial write SetDefaultMaterial; - end; - -implementation - -uses BGRACoordPool3D, BGRAUTF8; - -{$i lightingclasses3d.inc} -{$i vertex3d.inc} -{$i face3d.inc} -{$i part3d.inc} -{$i object3d.inc} -{$i shapes3d.inc} - -{ TCamera3D } - -function TCamera3D.GetLookWhere: TPoint3D; -begin - result := Point3D(FLookWhere); -end; - -function TCamera3D.GetMatrix: TMatrix3D; -begin - if not FMatrixComputed then - begin - ComputeMatrix; - FMatrixComputed := true; - end; - result := FMatrix; -end; - -function TCamera3D.GetViewPoint: TPoint3D; -begin - result := Point3D(FViewPoint); -end; - -procedure TCamera3D.SetMatrix(AValue: TMatrix3D); -begin - FMatrix := AValue; - FMatrixComputed:= true; - FViewPoint := Point3D_128(FMatrix[1,4],FMatrix[2,4],FMatrix[3,4]); -end; - -procedure TCamera3D.SetViewPoint(AValue: TPoint3D); -begin - FViewPoint := Point3D_128(AValue); - FMatrix[1,4] := FViewPoint.x; - FMatrix[2,4] := FViewPoint.y; - FMatrix[3,4] := FViewPoint.z; - FMatrixComputed := false; -end; - -procedure TCamera3D.ComputeMatrix; -var ZDir, XDir, YDir: TPoint3D_128; -begin - if IsPoint3D_128_Zero(FTopDir) then exit; - YDir := -FTopDir; - Normalize3D_128(YDir); - - ZDir := FLookWhere-FViewPoint; - if IsPoint3D_128_Zero(ZDir) then exit; - Normalize3D_128(ZDir); - - VectProduct3D_128(YDir,ZDir,XDir); - VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir - Normalize3D_128(XDir); - Normalize3D_128(YDir); - - FMatrix := Matrix3D(XDir,YDir,ZDir,FViewPoint); - FMatrix := MatrixInverse3D(FMatrix); -end; - -procedure TCamera3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); -begin - FLookWhere := Point3D_128(AWhere); - FTopDir := Point3D_128(ATopDir); - FMatrixComputed := false; -end; - -procedure TCamera3D.LookLeft(angleDeg: single); -var m,inv: TMatrix3D; -begin - inv := MatrixInverse3D(Matrix); - m := MatrixRotateY(angleDeg*Pi/180); - FLookWhere := inv*m*Matrix*FLookWhere; - FMatrixComputed := false; -end; - -procedure TCamera3D.LookRight(angleDeg: single); -begin - LookLeft(-angleDeg); -end; - -procedure TCamera3D.LookUp(angleDeg: single); -var m,inv: TMatrix3D; -begin - inv := MatrixInverse3D(Matrix); - m := MatrixRotateX(-angleDeg*Pi/180); - FLookWhere := inv*m*Matrix*FLookWhere; - FMatrixComputed := false; -end; - -procedure TCamera3D.LookDown(angleDeg: single); -begin - LookUp(-angleDeg); -end; - - -{ TBGRAScene3D } - -function TBGRAScene3D.GetViewCenter: TPointF; -begin - if FAutoViewCenter then - begin - result := PointF((GetRenderWidth-1)/2,(GetRenderHeight-1)/2) - end - else - result := FViewCenter; -end; - -function TBGRAScene3D.GetViewPoint: TPoint3D; -begin - result := Camera.ViewPoint; -end; - -function TBGRAScene3D.GetZoom: TPointF; -var size: single; -begin - if FAutoZoom then - begin - Size := sqrt(GetRenderWidth*GetRenderHeight)*0.8; - if Size = 0 then - result := PointF(1,1) - else - result := PointF(size,size); - end else - result := FZoom; -end; - -procedure TBGRAScene3D.SetAmbiantLightColorF(const AValue: TColorF); -begin - FAmbiantLightColorF := AValue; -end; - -procedure TBGRAScene3D.SetAmbiantLightness(const AValue: single); -begin - FAmbiantLightColorF := ColorF(AValue, AValue, AValue, 1); -end; - -procedure TBGRAScene3D.SetAmbiantLightColor(const AValue: TBGRAPixel); -begin - FAmbiantLightColorF := ColorInt65536ToColorF(BGRAToColorInt(AValue,True)); -end; - -function TBGRAScene3D.GetObject(AIndex: integer): IBGRAObject3D; -begin - if (AIndex < 0) or (AIndex >= FObjectCount) then - raise exception.Create('Index out of bounds'); - result := FObjects[AIndex]; -end; - -function TBGRAScene3D.GetVertexCount: integer; -var i: integer; -begin - result := 0; - for i := 0 to Object3DCount-1 do - inc(result, Object3D[i].TotalVertexCount); -end; - -function TBGRAScene3D.GetAmbiantLightColor: TBGRAPixel; -begin - result := ColorIntToBGRA(ColorFToColorInt65536(FAmbiantLightColorF),True); -end; - -function TBGRAScene3D.GetFaceCount: integer; -var i: integer; -begin - result := 0; - for i := 0 to Object3DCount-1 do - inc(result, Object3D[i].FaceCount); -end; - -function TBGRAScene3D.GetLight(AIndex: integer): IBGRALight3D; -begin - if (AIndex < 0) or (AIndex >= FLights.Count) then - result := nil - else - result := TBGRALight3D(FLights[AIndex]); -end; - -function TBGRAScene3D.GetLightCount: integer; -begin - result := FLights.Count; -end; - -function TBGRAScene3D.GetMaterial(AIndex: integer): IBGRAMaterial3D; -begin - if (AIndex < 0) or (AIndex >= FMaterialCount) then - raise exception.Create('Index out of bounds'); - result := FMaterials[AIndex]; -end; - -function TBGRAScene3D.GetNormalCount: integer; -var i: integer; -begin - result := 0; - for i := 0 to Object3DCount-1 do - inc(result, Object3D[i].TotalNormalCount); -end; - -function TBGRAScene3D.GetAmbiantLightness: single; -begin - result := (FAmbiantLightColorF[1]+FAmbiantLightColorF[2]+FAmbiantLightColorF[3])/3; -end; - -function TBGRAScene3D.GetAmbiantLightColorF: TColorF; -begin - result := FAmbiantLightColorF; -end; - -procedure TBGRAScene3D.SetAutoViewCenter(const AValue: boolean); -begin - if FAutoViewCenter=AValue then exit; - if not AValue then - FViewCenter := ViewCenter; - FAutoViewCenter:=AValue; -end; - -procedure TBGRAScene3D.SetAutoZoom(const AValue: boolean); -begin - if FAutoZoom=AValue then exit; - if not AValue then - FZoom := Zoom; - FAutoZoom:=AValue; -end; - -procedure TBGRAScene3D.SetDefaultMaterial(AValue: IBGRAMaterial3D); -begin - if FDefaultMaterial=AValue then Exit; - FDefaultMaterial:=AValue; - InvalidateMaterial; -end; - -procedure TBGRAScene3D.SetViewCenter(const AValue: TPointF); -begin - FViewCenter := AValue; - FAutoViewCenter:= False; -end; - -procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D); -begin - Camera.ViewPoint := AValue; -end; - -procedure TBGRAScene3D.AddObject(AObj: IBGRAObject3D); -begin - if FObjectCount = length(FObjects) then - setlength(FObjects, FObjectCount*2+1); - FObjects[FObjectCount] := AObj; - inc(FObjectCount); -end; - -procedure TBGRAScene3D.AddLight(ALight: TObject); -begin - FLights.Add(ALight); - IBGRALight3D(TBGRALight3D(ALight))._AddRef; -end; - -procedure TBGRAScene3D.AddMaterial(AMaterial: IBGRAMaterial3D); -begin - if FMaterialCount = length(FMaterials) then - setlength(FMaterials, FMaterialCount*2+1); - FMaterials[FMaterialCount] := AMaterial; - inc(FMaterialCount); -end; - -procedure TBGRAScene3D.Init; -begin - UnknownColor := BGRA(0,128,255); - FAutoZoom := True; - FAutoViewCenter := True; - - FCamera := TCamera3D.Create; - Camera.ViewPoint := Point3D(0,0,-100); - Camera.LookAt(Point3D(0,0,0), Point3D(0,-1,0)); - with RenderingOptions do - begin - TextureInterpolation := False; - PerspectiveMode := pmPerspectiveMapping; - LightingInterpolation := liSpecularHighQuality; - AntialiasingMode := am3dNone; - AntialiasingResampleLevel := 2; - end; - AmbiantLightness := 1; - AmbiantLightColor := BGRAWhite; - DefaultLightingNormal := lnFaceVertexMix; - FLights := TList.Create; - FRenderedFaceCount:= 0; - FMaterialCount := 0; - FObjectCount := 0; - DefaultMaterial := CreateMaterial; - RenderingOptions.MinZ := 1; -end; - -constructor TBGRAScene3D.Create; -begin - Init; -end; - -constructor TBGRAScene3D.Create(ASurface: TBGRACustomBitmap); -begin - FSurface := ASurface; - Init; -end; - -destructor TBGRAScene3D.Destroy; -var - i: Integer; -begin - DoClear; - FreeAndNil(FLights); - FreeAndNil(FCamera); - for i := 0 to high(FTexturesFetched) do - FTexturesFetched[i].Bitmap.Free; - inherited Destroy; -end; - -procedure TBGRAScene3D.Clear; -begin - DoClear; - DefaultMaterial := CreateMaterial; -end; - -function TBGRAScene3D.FetchObject(AName: string; SwapFacesOrientation: boolean - ): IBGRAObject3D; -begin - if FetchDirectory = '' then raise exception.Create('Please define first the FetchDirectory'); - try - result := LoadObjectFromFileUTF8(ConcatPaths([FetchDirectory,AName]), SwapFacesOrientation); - except - on ex:Exception do - HandleFetchException(ex); - end; -end; - -procedure TBGRAScene3D.UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); - - function ParseColor(text: string): TBGRAPixel; - var - color,tempColor: TBGRAPixel; - begin - color := UnknownColor; - - if copy(text,1,2) = 'dk' then - begin - tempcolor := ParseColor(copy(text,3,length(text)-2)); - tempcolor := MergeBGRA(tempcolor,3,BGRABlack,1); - color := StrToBGRA('dark'+copy(text,3,length(text)-2),tempcolor); - end; - if copy(text,1,2) = 'lt' then - begin - tempcolor := ParseColor(copy(text,3,length(text)-2)); - tempcolor := MergeBGRA(tempcolor,3,BGRAWhite,1); - color := StrToBGRA('light'+copy(text,3,length(text)-2),tempcolor); - end; - Color := StrToBGRA(StringReplace(text,'deep','dark',[]),Color); - Color := StrToBGRA(StringReplace(text,'dark','deep',[]),Color); - Color := StrToBGRA(text,Color); - result := color; - end; - -var - mat: IBGRAMaterial3D; - c: TBGRAPixel; -begin - mat := GetMaterialByName(AMaterialName); - if mat = nil then - begin - mat := CreateMaterial; - mat.Name := AMaterialName; - c := ParseColor(AMaterialName); - mat.AmbiantColor := c; - mat.DiffuseColor := c; - end; - AFace.Material := mat; -end; - -function TBGRAScene3D.LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; -begin - result := BGRABitmapFactory.Create(AfileNameUTF8,True); -end; - -function TBGRAScene3D.FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner; -var - i: Integer; - bmp: TBGRACustomBitmap; -begin - bmp := nil; - for i := 0 to high(FTexturesFetched) do - if FTexturesFetched[i].Name = AName then - begin - bmp := FTexturesFetched[i].Bitmap; - result := bmp; - texSize := PointF(bmp.Width,bmp.Height); - exit; - end; - if FetchDirectory <> '' then - begin - try - bmp := LoadBitmapFromFileUTF8(ConcatPaths([FetchDirectory,AName])); - except - on ex:Exception do - HandleFetchException(ex); - end; - end; - if bmp = nil then - begin - result := nil; - texSize := PointF(1,1); - end else - begin - setlength(FTexturesFetched, length(FTexturesFetched)+1); - FTexturesFetched[high(FTexturesFetched)].Name := AName; - FTexturesFetched[high(FTexturesFetched)].Bitmap := bmp; - result := bmp; - texSize := PointF(bmp.Width,bmp.Height); - end; -end; - -procedure TBGRAScene3D.FetchMaterials(ALibraryName: string); -var - i: Integer; -begin - if FetchDirectory <> '' then - begin - for i := 0 to high(FMaterialLibrariesFetched) do - if FMaterialLibrariesFetched[i]=ALibraryName then exit; - setlength(FMaterialLibrariesFetched,length(FMaterialLibrariesFetched)+1); - FMaterialLibrariesFetched[high(FMaterialLibrariesFetched)] := ALibraryName; - try - LoadMaterialsFromFile(ConcatPaths([FetchDirectory,ALibraryName])); - except - on ex:Exception do - HandleFetchException(ex); - end; - end; -end; - -procedure TBGRAScene3D.HandleFetchException(AException: Exception); -begin - if FetchThrowsException then - raise AException; -end; - -procedure TBGRAScene3D.DoClear; -var i: integer; -begin - for i := 0 to FLights.Count-1 do - TBGRALight3D(FLights[i]).ReleaseInterface; - FLights.Clear; - - for i := 0 to FObjectCount-1 do - begin - FObjects[i].Clear; - FObjects[i] := nil; - end; - FObjects := nil; - FObjectCount := 0; - - FMaterials := nil; - FMaterialCount := 0; - DefaultMaterial := nil; -end; - -function TBGRAScene3D.GetRenderWidth: integer; -begin - if Assigned(FRenderer) then - result := FRenderer.SurfaceWidth - else - if Assigned(FSurface) then - result := FSurface.Width - else - result := 0; -end; - -function TBGRAScene3D.GetRenderHeight: integer; -begin - if Assigned(FRenderer) then - result := FRenderer.SurfaceHeight - else - if Assigned(FSurface) then - result := FSurface.Height - else - result := 0; -end; - -procedure TBGRAScene3D.OnMaterialTextureChanged(ASender: TObject); -begin - InvalidateMaterial; -end; - -procedure TBGRAScene3D.InvalidateMaterial; -var - i: Integer; -begin - for i := 0 to FObjectCount-1 do - FObjects[i].InvalidateMaterial; -end; - -function TBGRAScene3D.LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean): IBGRAObject3D; -begin - result := LoadObjectFromFileUTF8(SysToUTF8(AFilename), SwapFacesOrientation); -end; - -function TBGRAScene3D.LoadObjectFromFileUTF8(AFilename: string; - SwapFacesOrientation: boolean): IBGRAObject3D; -var source: TFileStreamUTF8; -begin - source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite); - try - result := LoadObjectFromStream(source,SwapFacesOrientation); - finally - source.free; - end; -end; - -function TBGRAScene3D.LoadObjectFromStream(AStream: TStream; - SwapFacesOrientation: boolean): IBGRAObject3D; -var s: string; - secondValue,thirdValue: string; - - function GetNextToken: string; - var idxStart,idxEnd,idxSlash: integer; - begin - idxStart := 1; - while (idxStart <= length(s)) and (s[idxStart]in[' ',#9]) do inc(idxStart); - if idxStart > length(s) then - begin - result := ''; - exit; - end; - idxEnd := idxStart; - while (idxEnd < length(s)) and not (s[idxEnd+1]in[' ',#9]) do inc(idxEnd); - result := copy(s,idxStart, idxEnd-idxStart+1); - delete(s,1,idxEnd); - idxSlash := pos('/',result); - if idxSlash <> 0 then - begin - secondValue:= copy(result,idxSlash+1,length(result)-idxSlash); - result := copy(result,1,idxSlash-1); - idxSlash:= pos('/',secondValue); - if idxSlash <> 0 then - begin - thirdValue:= copy(secondValue,idxSlash+1,length(secondValue)-idxSlash); - secondValue:= copy(secondValue,1,idxSlash-1); - end else - thirdValue:= ''; - end else - begin - secondValue:= ''; - thirdValue:= ''; - end; - end; - -type - TFaceVertexExtra = record - normal: IBGRANormal3D; - texCoord: TPointF; - end; - -var lineType : string; - x,y,z : single; - code : integer; - faceVertices: array of IBGRAVertex3D; - faceExtra: array of TFaceVertexExtra; - NbFaceVertices,v,v2,v3,i: integer; - tempV: IBGRAVertex3D; - tempN: TFaceVertexExtra; - materialname: string; - face: IBGRAFace3D; - lines: TStringList; - lineIndex: integer; - texCoords: array of TPointF; - nbTexCoords: integer; - -begin - lines := TStringList.Create; - lines.LoadFromStream(AStream); - result := CreateObject; - faceVertices := nil; - faceExtra := nil; - NbFaceVertices:= 0; - materialname := 'default'; - lineIndex := 0; - texCoords := nil; - nbTexCoords:= 0; - while lineIndex < lines.Count do - begin - s := lines[lineIndex]; - if pos('#',s) <> 0 then - s := copy(s,1,pos('#',s)-1); - inc(lineIndex); - lineType := GetNextToken; - if lineType = 'v' then - begin - val(GetNextToken,x,code); - val(GetNextToken,y,code); - val(GetNextToken,z,code); - result.MainPart.Add(x,y,z); - end else - if lineType = 'vt' then - begin - val(GetNextToken,x,code); - val(GetNextToken,y,code); - if nbTexCoords >= length(texCoords) then - setlength(texCoords, length(texCoords)*2+1); - texCoords[nbTexCoords] := PointF(x,y); - inc(nbTexCoords); - end else - if lineType = 'vn' then - begin - val(GetNextToken,x,code); - val(GetNextToken,y,code); - val(GetNextToken,z,code); - result.MainPart.AddNormal(x,y,z); - result.LightingNormal := lnVertex; - end else - if lineType = 'mtllib' then - FetchMaterials(trim(s)) - else - if lineType = 'usemtl' then - materialname := trim(s) - else - if lineType = 'f' then - begin - NbFaceVertices:= 0; - repeat - val(GetNextToken,v,code); - if (code = 0) and (v < 0) then v := result.MainPart.VertexCount+1+v; - if (code = 0) and (v >= 1) and (v <= result.MainPart.VertexCount) then - begin - if length(faceVertices) = NbFaceVertices then - begin - setlength(faceVertices, length(faceVertices)*2+1); - setlength(faceExtra, length(faceExtra)*2+1); - end; - faceVertices[NbFaceVertices] := result.MainPart.Vertex[v-1]; - val(secondValue,v2,code); - if (code = 0) and (v2 < 0) then v2 := nbTexCoords+1+v2; - if (code = 0) and (v2 >= 1) and (v2-1 < nbTexCoords) then - faceExtra[NbFaceVertices].texCoord := texCoords[v2-1] - else if nbTexCoords > v-1 then - faceExtra[NbFaceVertices].texCoord := texCoords[v-1] - else - faceExtra[NbFaceVertices].texCoord := PointF(0,0); - val(thirdValue,v3,code); - if (code = 0) and (v3 < 0) then v3 := result.MainPart.NormalCount+1+v3; - if code = 0 then - faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v3-1] - else if result.MainPart.NormalCount > v-1 then - faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v-1] - else - faceExtra[NbFaceVertices].normal := nil; - inc(NbFaceVertices); - end else break; - until false; - if NbFaceVertices > 2 then - begin - if SwapFacesOrientation then - for i := 0 to NbFaceVertices div 2-1 do - begin - tempV := faceVertices[i]; - faceVertices[i] := faceVertices[NbFaceVertices-1-i]; - faceVertices[NbFaceVertices-1-i] := tempV; - tempN := faceExtra[i]; - faceExtra[i] := faceExtra[NbFaceVertices-1-i]; - faceExtra[NbFaceVertices-1-i] := tempN; - end; - face := result.AddFace(slice(faceVertices,NbFaceVertices)); - for i := 0 to NbFaceVertices-1 do - begin - face.SetNormal(i, faceExtra[i].normal); - face.SetTexCoord(i, faceExtra[i].texCoord); - end; - face.MaterialName := materialname; - end; - end; - end; - lines.Free; -end; - -procedure TBGRAScene3D.LoadMaterialsFromFile(AFilename: string); -var source: TFileStreamUTF8; -begin - source := TFileStreamUTF8.Create(SysToUTF8(AFilename),fmOpenRead,fmShareDenyWrite); - try - LoadMaterialsFromStream(source); - finally - source.free; - end; -end; - -procedure TBGRAScene3D.LoadMaterialsFromFileUTF8(AFilename: string); -var source: TFileStreamUTF8; -begin - source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite); - try - LoadMaterialsFromStream(source); - finally - source.free; - end; -end; - -procedure TBGRAScene3D.LoadMaterialsFromStream(AStream: TStream); -var - s: String; - - function GetNextToken: string; - var idxStart,idxEnd: integer; - begin - idxStart := 1; - while (idxStart <= length(s)) and (s[idxStart]in[#9,' ']) do inc(idxStart); - if idxStart > length(s) then - begin - result := ''; - exit; - end; - idxEnd := idxStart; - while (idxEnd < length(s)) and not (s[idxEnd+1]in[#9,' ']) do inc(idxEnd); - result := copy(s,idxStart, idxEnd-idxStart+1); - delete(s,1,idxEnd); - end; - - function GetSingle: single; - var {%H-}code: integer; - begin - val(GetNextToken,result,{%H-}code); - end; - - function GetColorF: TColorF; - var r,g,b: single; - {%H-}code: integer; - begin - val(GetNextToken,r,{%H-}code); - val(GetNextToken,g,{%H-}code); - val(GetNextToken,b,{%H-}code); - result := ColorF(r,g,b,1); - end; - -var - lines: TStringList; - lineIndex: integer; - lineType: String; - currentMaterial: IBGRAMaterial3D; - materialName: string; - texZoom: TPointF; - v: single; - -begin - lines := TStringList.Create; - lines.LoadFromStream(AStream); - lineIndex := 0; - while lineIndex < lines.Count do - begin - s := lines[lineIndex]; - if pos('#',s) <> 0 then - s := copy(s,1,pos('#',s)-1); - inc(lineIndex); - lineType := GetNextToken; - if lineType = 'newmtl' then - begin - materialName := trim(s); - currentMaterial := GetMaterialByName(materialName); - if currentMaterial = nil then - begin - currentMaterial := CreateMaterial; - currentMaterial.Name := materialName; - end; - end else - if currentMaterial <> nil then - begin - if lineType = 'Ka' then currentMaterial.AmbiantColorF := GetColorF else - if lineType = 'Kd' then currentMaterial.DiffuseColorF := GetColorF else - if lineType = 'Ks' then currentMaterial.SpecularColorF := GetColorF else - if (lineType = 'map_Ka') or (lineType = 'map_Kd') then - begin - currentMaterial.Texture := FetchTexture(trim(s),texZoom); - texZoom.y := -texZoom.y; - currentMaterial.TextureZoom := texZoom; - end else - if lineType = 'Ns' then currentMaterial.SpecularIndex := round(GetSingle) else - if lineType = 'd' then - begin - v := GetSingle; - if v > 1 then - currentMaterial.SimpleAlpha := 255 - else if v < 0 then - currentMaterial.SimpleAlpha := 0 - else - currentMaterial.SimpleAlpha := round(v*255); - end; - end; - end; - lines.Free; -end; - -procedure TBGRAScene3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); -begin - Camera.LookAt(AWhere,ATopDir); -end; - -procedure TBGRAScene3D.LookLeft(angleDeg: single); -begin - Camera.LookLeft(angleDeg); -end; - -procedure TBGRAScene3D.LookRight(angleDeg: single); -begin - Camera.LookRight(angleDeg); -end; - -procedure TBGRAScene3D.LookUp(angleDeg: single); -begin - Camera.LookUp(angleDeg); -end; - -procedure TBGRAScene3D.LookDown(angleDeg: single); -begin - Camera.LookDown(angleDeg); -end; - -procedure TBGRAScene3D.Render; -begin - FRenderer := TBGRARenderer3D.Create(FSurface, RenderingOptions, - FAmbiantLightColorF, - FLights); - DoRender; - FreeAndNil(FRenderer); -end; - -procedure TBGRAScene3D.Render(ARenderer: TCustomRenderer3D); -begin - FRenderer := ARenderer; - DoRender; - FRenderer := nil; -end; - -procedure TBGRAScene3D.ComputeView(ScaleX,ScaleY: single); -var - i: Integer; -begin - FProjection.Zoom := Zoom; - FProjection.Zoom.X := FProjection.Zoom.X * ScaleX; - FProjection.Zoom.Y := FProjection.Zoom.Y * ScaleY; - FProjection.Center := ViewCenter; - FProjection.Center.X := FProjection.Center.X * ScaleX; - FProjection.Center.Y := FProjection.Center.Y * ScaleY; - for i := 0 to FObjectCount-1 do - FObjects[i].ComputeWithMatrix(Camera.Matrix, FProjection); -end; - -function TBGRAScene3D.ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF; -var InvZ: single; -begin - if AViewCoord.z > 0 then - begin - InvZ := 1/AViewCoord.z; - result := PointF(AViewCoord.x*InvZ*FProjection.Zoom.x + FProjection.Center.x, - AViewCoord.y*InvZ*FProjection.Zoom.Y + FProjection.Center.y); - end else - result := PointF(0,0); -end; - -type - arrayOfTBGRAFace3D = array of TBGRAFace3D; - -procedure InsertionSortFaces(var a: arrayOfTBGRAFace3D); -var i,j: integer; - temp: TBGRAFace3D; -begin - for i := 1 to high(a) do - begin - Temp := a[i]; - j := i; - while (j>0) and (a[j-1].ViewCenterZ > Temp.ViewCenterZ) do - begin - a[j] := a[j-1]; - dec(j); - end; - a[j] := Temp; - end; -end; - -function PartitionFaces(var a: arrayOfTBGRAFace3D; left,right: integer): integer; - - procedure Swap(idx1,idx2: integer); inline; - var temp: TBGRAFace3D; - begin - temp := a[idx1]; - a[idx1] := a[idx2]; - a[idx2] := temp; - end; - -var pivotIndex: integer; - pivotValue: TBGRAFace3D; - storeIndex: integer; - i: integer; - -begin - pivotIndex := left + random(right-left+1); - pivotValue := a[pivotIndex]; - swap(pivotIndex,right); - storeIndex := left; - for i := left to right-1 do - if a[i].ViewCenterZ <= pivotValue.ViewCenterZ then - begin - swap(i,storeIndex); - inc(storeIndex); - end; - swap(storeIndex,right); - result := storeIndex; -end; - -procedure QuickSortFaces(var a: arrayOfTBGRAFace3D; left,right: integer); -var pivotNewIndex: integer; -begin - if right > left+9 then - begin - pivotNewIndex := PartitionFaces(a,left,right); - QuickSortFaces(a,left,pivotNewIndex-1); - QuickSortFaces(a,pivotNewIndex+1,right); - end; -end; - -procedure SortFaces(var a: arrayOfTBGRAFace3D); -begin - if length(a) < 10 then InsertionSortFaces(a) else - begin - QuickSortFaces(a,0,high(a)); - InsertionSortFaces(a); - end; -end; - -function IsPolyVisible(const p : array of TPointF; ori: integer = 1) : boolean; -var i: integer; -begin - i := 0; - while i<=high(p)-2 do - begin - if ori* - ( (p[i+1].x-p[i].x)*(p[i+2].y-p[i].y) - - (p[i+1].y-p[i].y)*(p[i+2].x-p[i].x)) > 0 then - begin - result := true; - exit; - end; - inc(i); - end; - result := false; -end; - -procedure TBGRAScene3D.DoRender; -var - LFaces: array of TBGRAFace3D; - LFaceOpaque: array of boolean; - LFaceCount: integer; - - procedure PrepareFaces; - var i,j, LFaceIndex: integer; - obj: IBGRAObject3D; - begin - LFaces := nil; - LFaceCount := 0; - for i := 0 to FObjectCount-1 do - begin - obj := FObjects[i]; - inc(LFaceCount, obj.GetFaceCount); - obj.Update; - end; - setlength(LFaces, LFaceCount); - LFaceIndex := 0; - for i := 0 to FObjectCount-1 do - with FObjects[i] do - begin - for j := 0 to GetFaceCount-1 do - begin - LFaces[LFaceIndex] := TBGRAFace3D(GetFace(j).GetAsObject); - inc(LFaceIndex); - end; - end; - end; - -var - faceDesc: TFaceRenderingDescription; - LVertices: array of TBGRAVertex3D; - - procedure DrawFace(numFace: integer); - var - j,k: Integer; - VCount,NewVCount: integer; - NegNormals: boolean; - LastVisibleVertex: integer; - - procedure AddZIntermediate(n1,n2: integer); - var t: single; - v1,v2: TBGRAVertex3D; - begin - v1 := LVertices[n1]; - v2 := LVertices[n2]; - t := (RenderingOptions.MinZ - v1.ViewCoord.z)/(v2.ViewCoord.z - v1.ViewCoord.z); - LVertices[NewVCount] := nil; //computed - - faceDesc.Colors[NewVCount] := MergeBGRA(faceDesc.Colors[n1],round((1-t)*65536),faceDesc.Colors[n2],round(t*65536)); - faceDesc.TexCoords[NewVCount] := faceDesc.TexCoords[n1]*(1-t) + faceDesc.TexCoords[n2]*t; - faceDesc.Positions3D[NewVCount] := faceDesc.Positions3D[n1]*(1-t) + faceDesc.Positions3D[n2]*t; - faceDesc.Normals3D[NewVCount] := faceDesc.Normals3D[n1]*(1-t) + faceDesc.Normals3D[n2]*t; - faceDesc.Projections[NewVCount] := ComputeCoordinate(faceDesc.Positions3D[NewVCount]); - inc(NewVCount); - end; - - procedure LoadVertex(idxL: integer; idxV: integer); - var vertexDesc: PBGRAFaceVertexDescription; - tempV: TBGRAVertex3D; - begin - with LFaces[numFace] do - begin - vertexDesc := VertexDescription[idxV]; - with vertexDesc^ do - begin - tempV := TBGRAVertex3D(vertex.GetAsObject); - LVertices[idxL] := tempV; - - faceDesc.Colors[idxL] := ActualColor; - faceDesc.TexCoords[idxL] := ActualTexCoord; - - with tempV.CoordData^ do - begin - faceDesc.Positions3D[idxL] := viewCoord; - facedesc.Normals3D[idxL] := viewNormal; - faceDesc.Projections[idxL] := projectedCoord; - end; - if Normal <> nil then - facedesc.Normals3D[idxL] := Normal.ViewNormal_128; - Normalize3D_128(facedesc.Normals3D[idxL]); - end; - end; - end; - - begin - with LFaces[numFace] do - begin - VCount := VertexCount; - if VCount < 3 then exit; - - faceDesc.NormalsMode := Object3D.LightingNormal; - - faceDesc.Material := ActualMaterial; - if faceDesc.Material = nil then exit; - faceDesc.Texture := ActualTexture; - - if length(LVertices) < VCount+3 then //keep margin for z-clip - begin - setlength(LVertices, (VCount+3)*2); - setlength(faceDesc.Colors, length(LVertices)); - setlength(faceDesc.TexCoords, length(LVertices)); - setlength(faceDesc.Projections, length(LVertices)); - setlength(faceDesc.Positions3D, length(LVertices)); - setlength(faceDesc.Normals3D, length(LVertices)); - end; - - if FRenderer.HandlesNearClipping then - begin - for j := 0 to VCount-1 do - LoadVertex(j,j); - end else - begin - NewVCount := 0; - LastVisibleVertex := -1; - for k := VCount-1 downto 0 do - if Vertex[k].ViewCoordZ >= RenderingOptions.MinZ then - begin - LastVisibleVertex := k; - break; - end; - if LastVisibleVertex = -1 then exit; - - k := VCount-1; - for j := 0 to VCount-1 do - begin - if Vertex[j].ViewCoordZ >= RenderingOptions.MinZ then - begin - if k <> LastVisibleVertex then //one or more vertices is out - begin - LoadVertex(NewVCount+1, LastVisibleVertex); - LoadVertex(NewVCount+2, (LastVisibleVertex+1) mod VertexCount); - AddZIntermediate(NewVCount+1,NewVCount+2); - - LoadVertex(NewVCount+1, j); - LoadVertex(NewVCount+2, k); - - AddZIntermediate(NewVCount+1,NewVCount+2); - inc(NewVCount); - end else - begin - LoadVertex(NewVCount, j); - inc(NewVCount); - end; - LastVisibleVertex := j; - end; - k := j; - end; - VCount := NewVCount; - if VCount < 3 then exit; //after z-clipping - end; - - if not FRenderer.HandlesFaceCulling then - begin - if not IsPolyVisible(slice(faceDesc.Projections,VCount)) then - begin - if not Biface then exit; - NegNormals := True; - end else - begin - NegNormals := False; - end; - end else - NegNormals := false; - - //compute normals - case faceDesc.NormalsMode of - lnFace: for j := 0 to VCount-1 do - faceDesc.Normals3D[j] := ViewNormal_128; - lnFaceVertexMix: - for j := 0 to VCount-1 do - begin - faceDesc.Normals3D[j].Offset(ViewNormal_128); - Normalize3D_128(faceDesc.Normals3D[j]); - end; - end; - if NegNormals then - for j := 0 to VCount-1 do - faceDesc.Normals3D[j] := -faceDesc.Normals3D[j]; - - if LightThroughFactorOverride then - faceDesc.LightThroughFactor := LightThroughFactor - else - faceDesc.LightThroughFactor := faceDesc.Material.GetLightThroughFactor; - - faceDesc.NbVertices:= VCount; - faceDesc.Biface := Biface; - - if FRenderer.RenderFace(faceDesc, @ComputeCoordinate) then - inc(FRenderedFaceCount); - end; - end; - -var i,j: integer; - -begin - FRenderedFaceCount:= 0; - - PrepareFaces; - ComputeView(FRenderer.GlobalScale,FRenderer.GlobalScale); - FRenderer.Projection := FProjection; - - SortFaces(LFaces); - LVertices := nil; - - //if there is a Z-Buffer, it is possible to avoid drawing things that - //are hidden by opaque faces by drawing first all opaque faces - if FRenderer.HasZBuffer then - begin - setlength(LFaceOpaque, length(LFaces)); - for i := 0 to High(LFaces) do - begin - if (LFaces[i].Texture = nil) then - begin - LFaceOpaque[i] := true; - with LFaces[i] do - for j := 0 to VertexCount-1 do - if VertexColor[j].alpha <> 255 then - begin - LFaceOpaque[i] := false; - break; - end; - end else - LFaceOpaque[i] := true; - end; - - //draw near opaque faces first - for i := 0 to High(LFaces) do - if LFaceOpaque[i] then DrawFace(i); - - //draw other faces - for i := High(LFaces) downto 0 do - if not LFaceOpaque[i] then DrawFace(i); - end else - begin - for i := High(LFaces) downto 0 do - DrawFace(i); - end; -end; - -function TBGRAScene3D.CreateObject: IBGRAObject3D; -begin - result := TBGRAObject3D.Create(self); - AddObject(result); -end; - -function TBGRAScene3D.CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; -begin - result := TBGRAObject3D.Create(self); - result.Texture := ATexture; - AddObject(result); -end; - -function TBGRAScene3D.CreateObject(AColor: TBGRAPixel): IBGRAObject3D; -begin - result := TBGRAObject3D.Create(self); - result.Color := AColor; - AddObject(result); -end; - -function TBGRAScene3D.CreateSphere(ARadius: Single; AHorizPrecision: integer; AVerticalPrecision : integer): IBGRAObject3D; -begin - result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision); - AddObject(result); -end; - -function TBGRAScene3D.CreateSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer; AVerticalPrecision : integer): IBGRAObject3D; -begin - result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision); - result.Color := AColor; - AddObject(result); -end; - -function TBGRAScene3D.CreateHalfSphere(ARadius: Single; - AHorizPrecision: integer; AVerticalPrecision: integer): IBGRAObject3D; -begin - result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision, True); - AddObject(result); -end; - -function TBGRAScene3D.CreateHalfSphere(ARadius: Single; AColor: TBGRAPixel; - AHorizPrecision: integer; AVerticalPrecision: integer): IBGRAObject3D; -begin - result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision, True); - result.Color := AColor; - AddObject(result); -end; - -procedure TBGRAScene3D.RemoveObject(AObject: IBGRAObject3D); -var - i,j: Integer; -begin - for i := FObjectCount-1 downto 0 do - if FObjects[i] = AObject then - begin - dec(FObjectCount); - FObjects[i] := nil; - for j := i to FObjectCount-1 do - FObjects[j] := FObjects[j+1]; - end; -end; - -function TBGRAScene3D.AddDirectionalLight(ADirection: TPoint3D; - ALightness: single; AMinIntensity: single): IBGRADirectionalLight3D; -var lightObj: TBGRADirectionalLight3D; -begin - lightObj := TBGRADirectionalLight3D.Create(ADirection); - result := lightObj; - result.ColorF := ColorF(ALightness,ALightness,ALightness,1); - result.MinIntensity := AMinIntensity; - AddLight(lightObj); -end; - -function TBGRAScene3D.AddPointLight(AVertex: IBGRAVertex3D; - AOptimalDistance: single; ALightness: single; AMinIntensity: single - ): IBGRAPointLight3D; -var lightObj: TBGRAPointLight3D; -begin - lightObj := TBGRAPointLight3D.Create(AVertex, ALightness*sqr(AOptimalDistance)); - result := lightObj; - result.MinIntensity := AMinIntensity; - AddLight(lightObj); -end; - -function TBGRAScene3D.AddDirectionalLight(ADirection: TPoint3D; - AColor: TBGRAPixel; AMinIntensity: single): IBGRADirectionalLight3D; -var lightObj: TBGRADirectionalLight3D; -begin - lightObj := TBGRADirectionalLight3D.Create(ADirection); - result := lightObj; - result.MinIntensity := AMinIntensity; - result.Color := AColor; - AddLight(lightObj); -end; - -function TBGRAScene3D.AddPointLight(AVertex: IBGRAVertex3D; - AOptimalDistance: single; AColor: TBGRAPixel; AMinIntensity: single - ): IBGRAPointLight3D; -var lightObj: TBGRAPointLight3D; -begin - lightObj := TBGRAPointLight3D.Create(AVertex,sqr(AOptimalDistance)); - result := lightObj; - result.Color := AColor; - result.MinIntensity := AMinIntensity; - AddLight(lightObj); -end; - -procedure TBGRAScene3D.RemoveLight(ALight: IBGRALight3D); -var idx: integer; -begin - idx := FLights.IndexOf(ALight.GetAsObject); - if idx <> -1 then - begin - ALight._Release; - FLights.Delete(Idx); - end; -end; - -procedure TBGRAScene3D.SetZoom(value: Single); -begin - SetZoom(PointF(value,value)); -end; - -procedure TBGRAScene3D.SetZoom(value: TPointF); -begin - FZoom := value; - FAutoZoom := false; -end; - -function TBGRAScene3D.CreateMaterial: IBGRAMaterial3D; -var m: TBGRAMaterial3D; -begin - m := TBGRAMaterial3D.Create; - m.OnTextureChanged := @OnMaterialTextureChanged; - result := m; - AddMaterial(result); -end; - -function TBGRAScene3D.CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D; -var m: TBGRAMaterial3D; -begin - m := TBGRAMaterial3D.Create; - m.SetSpecularIndex(ASpecularIndex); - m.SetSpecularColor(BGRAWhite); - m.OnTextureChanged := @OnMaterialTextureChanged; - result := m; - AddMaterial(result); -end; - -function TBGRAScene3D.GetMaterialByName(AName: string): IBGRAMaterial3D; -var i: integer; -begin - for i := 0 to MaterialCount-1 do - if AName = Material[i].Name then - begin - result := Material[i]; - exit; - end; - result := nil; -end; - -procedure TBGRAScene3D.UpdateMaterials; -var i,j: integer; - obj: IBGRAObject3D; - face: IBGRAFace3D; -begin - for i := 0 to Object3DCount-1 do - begin - obj := Object3D[i]; - for j := 0 to obj.FaceCount-1 do - begin - face := obj.Face[j]; - if face.MaterialName <> '' then - UseMaterial(face.MaterialName,face); - end; - end; -end; - -procedure TBGRAScene3D.UpdateMaterial(AMaterialName: string); -var i,j: integer; - obj: IBGRAObject3D; - face: IBGRAFace3D; -begin - for i := 0 to Object3DCount-1 do - begin - obj := Object3D[i]; - for j := 0 to obj.FaceCount-1 do - begin - face := obj.Face[j]; - if face.MaterialName = AMaterialName then - UseMaterial(face.MaterialName,face); - end; - end; -end; - -procedure TBGRAScene3D.ForEachVertex(ACallback: TVertex3DCallback); -var i: integer; -begin - for i := 0 to Object3DCount-1 do - Object3D[i].ForEachVertex(ACallback); -end; - -procedure TBGRAScene3D.ForEachFace(ACallback: TFace3DCallback); -var i: integer; -begin - for i := 0 to Object3DCount-1 do - Object3D[i].ForEachFace(ACallback); -end; - -function TBGRAScene3D.MakeLightList: TList; -var i: integer; -begin - result := TList.Create; - for i := 0 to FLights.Count-1 do - result.Add(FLights[i]); -end; - -initialization - - Randomize; - -end. - diff --git a/components/bgrabitmap/bgrascenetypes.pas b/components/bgrabitmap/bgrascenetypes.pas deleted file mode 100644 index b06e33b..0000000 --- a/components/bgrabitmap/bgrascenetypes.pas +++ /dev/null @@ -1,1199 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASceneTypes; - -{$mode objfpc}{$H+} - -interface - -uses BGRABitmapTypes, BGRASSE, BGRAMatrix3D, BGRAColorInt; - -type - TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix); - TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality); - TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample); - TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer); - - TRenderingOptions = record - LightingInterpolation: TLightingInterpolation3D; - AntialiasingMode: TAntialiasingMode3D; - AntialiasingResampleLevel: integer; - PerspectiveMode: TPerspectiveMode3D; - TextureInterpolation: boolean; - MinZ: single; - end; - - PSceneLightingContext = ^TSceneLightingContext; - TSceneLightingContext = packed record - basic: TBasicLightingContext; - {128} diffuseColor, {144} specularColor: TColorInt65536; - {160} vL, {176} dummy: TPoint3D_128; - {192} vH: TPoint3D_128; - {208} lightness: integer; - {212} material : TObject; - LightThroughFactor: single; - LightThrough: LongBool; - SaturationLow: integer; - SaturationLowF: single; - SaturationHigh: integer; - SaturationHighF: single; - end; - - TBox3D = record - min,max: TPoint3D; - end; - - IBGRAVertex3D = interface; - - { IBGRALight3D } - - IBGRALight3D = interface ['{85C683B6-07AC-4B8D-9324-06BC22882433}'] - procedure ComputeDiffuseLightness(Context: PSceneLightingContext); - procedure ComputeDiffuseColor(Context: PSceneLightingContext); - procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); - - function GetColor: TBGRAPixel; - function GetColoredLight: boolean; - function GetColorF: TColorF; - function GetColorInt: TColorInt65536; - function GetLightnessF: single; - function GetAsObject: TObject; - procedure SetColor(const AValue: TBGRAPixel); - procedure SetColorF(const AValue: TColorF); - procedure SetColorInt(const AValue: TColorInt65536); - property Color: TBGRAPixel read GetColor write SetColor; - property ColorF: TColorF read GetColorF write SetColorF; - property ColorInt: TColorInt65536 read GetColorInt write SetColorInt; - property LightnessF: single read GetLightnessF; - property ColoredLight: boolean read GetColoredLight; - - function GetMinIntensity: single; - procedure SetMinIntensity(const AValue: single); - property MinIntensity: single read GetMinIntensity write SetMinIntensity; - function IsDirectional: boolean; - end; - - IBGRAPointLight3D = interface(IBGRALight3D) ['{C939900D-DDD6-49F0-B1E9-E29F94FDB4C8}'] - function GetVertex: IBGRAVertex3D; - procedure SetVertex(const AValue: IBGRAVertex3D); - property Vertex: IBGRAVertex3D read GetVertex write SetVertex; - end; - - IBGRADirectionalLight3D = interface(IBGRALight3D) ['{8D575CEE-8DD2-46FB-9BCC-17DE3DAAF53D}'] - function GetDirection: TPoint3D; - procedure SetDirection(const AValue: TPoint3D); - property Direction: TPoint3D read GetDirection write SetDirection; - end; - - { IBGRAMaterial3D } - - IBGRAMaterial3D = interface - function GetAmbiantAlpha: byte; - function GetAutoAmbiantColor: boolean; - function GetAutoDiffuseColor: boolean; - function GetAutoSimpleColor: boolean; - function GetAutoSpecularColor: boolean; - function GetAmbiantColor: TBGRAPixel; - function GetAmbiantColorF: TColorF; - function GetAmbiantColorInt: TColorInt65536; - function GetDiffuseAlpha: byte; - function GetDiffuseColor: TBGRAPixel; - function GetDiffuseColorF: TColorF; - function GetDiffuseColorInt: TColorInt65536; - function GetLightThroughFactor: single; - function GetName: string; - function GetSaturationHigh: single; - function GetSaturationLow: single; - function GetSimpleAlpha: byte; - function GetSimpleColor: TBGRAPixel; - function GetSimpleColorF: TColorF; - function GetSimpleColorInt: TColorInt65536; - function GetSpecularColor: TBGRAPixel; - function GetSpecularColorF: TColorF; - function GetSpecularColorInt: TColorInt65536; - function GetSpecularIndex: integer; - function GetSpecularOn: boolean; - function GetTexture: IBGRAScanner; - function GetTextureZoom: TPointF; - function GetAsObject: TObject; - - procedure SetAmbiantAlpha(AValue: byte); - procedure SetAutoDiffuseColor(const AValue: boolean); - procedure SetAutoSpecularColor(const AValue: boolean); - procedure SetAmbiantColor(const AValue: TBGRAPixel); - procedure SetAmbiantColorF(const AValue: TColorF); - procedure SetAmbiantColorInt(const AValue: TColorInt65536); - procedure SetDiffuseAlpha(AValue: byte); - procedure SetDiffuseColor(const AValue: TBGRAPixel); - procedure SetDiffuseColorF(const AValue: TColorF); - procedure SetDiffuseColorInt(const AValue: TColorInt65536); - procedure SetLightThroughFactor(const AValue: single); - procedure SetName(const AValue: string); - procedure SetSaturationHigh(const AValue: single); - procedure SetSaturationLow(const AValue: single); - procedure SetSimpleAlpha(AValue: byte); - procedure SetSimpleColor(AValue: TBGRAPixel); - procedure SetSimpleColorF(AValue: TColorF); - procedure SetSimpleColorInt(AValue: TColorInt65536); - procedure SetSpecularColor(const AValue: TBGRAPixel); - procedure SetSpecularColorF(const AValue: TColorF); - procedure SetSpecularColorInt(const AValue: TColorInt65536); - procedure SetSpecularIndex(const AValue: integer); - procedure SetTexture(AValue: IBGRAScanner); - procedure SetTextureZoom(AValue: TPointF); - - property AutoSimpleColor: boolean read GetAutoSimpleColor; - property SimpleColor: TBGRAPixel read GetSimpleColor write SetSimpleColor; - property SimpleColorF: TColorF read GetSimpleColorF write SetSimpleColorF; - property SimpleColorInt: TColorInt65536 read GetSimpleColorInt write SetSimpleColorInt; - property SimpleAlpha: byte read GetSimpleAlpha write SetSimpleAlpha; - - property AmbiantColor: TBGRAPixel read GetAmbiantColor write SetAmbiantColor; - property AmbiantColorF: TColorF read GetAmbiantColorF write SetAmbiantColorF; - property AmbiantColorInt: TColorInt65536 read GetAmbiantColorInt write SetAmbiantColorInt; - property AutoAmbiantColor: boolean read GetAutoAmbiantColor; - property AmbiantAlpha: byte read GetAmbiantAlpha write SetAmbiantAlpha; - property Texture: IBGRAScanner read GetTexture write SetTexture; - property TextureZoom: TPointF read GetTextureZoom write SetTextureZoom; - - property DiffuseColor: TBGRAPixel read GetDiffuseColor write SetDiffuseColor; - property DiffuseColorF: TColorF read GetDiffuseColorF write SetDiffuseColorF; - property DiffuseColorInt: TColorInt65536 read GetDiffuseColorInt write SetDiffuseColorInt; - property AutoDiffuseColor: boolean read GetAutoDiffuseColor write SetAutoDiffuseColor; - property DiffuseAlpha: byte read GetDiffuseAlpha write SetDiffuseAlpha; - property SaturationLow: single read GetSaturationLow write SetSaturationLow; - property SaturationHigh: single read GetSaturationHigh write SetSaturationHigh; - - property SpecularColor: TBGRAPixel read GetSpecularColor write SetSpecularColor; - property SpecularColorF: TColorF read GetSpecularColorF write SetSpecularColorF; - property SpecularColorInt: TColorInt65536 read GetSpecularColorInt write SetSpecularColorInt; - property AutoSpecularColor: boolean read GetAutoSpecularColor write SetAutoSpecularColor; - property SpecularIndex: integer read GetSpecularIndex write SetSpecularIndex; - property SpecularOn: boolean read GetSpecularOn; - - property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor; - property Name: string read GetName write SetName; - end; - - { IBGRANormal3D } - - IBGRANormal3D = interface - function GetCustomNormal: TPoint3D; - function GetCustomNormal_128: TPoint3D_128; - function GetViewNormal: TPoint3D; - function GetViewNormal_128: TPoint3D_128; - procedure SetCustomNormal(AValue: TPoint3D); - procedure SetCustomNormal_128(AValue: TPoint3D_128); - procedure SetViewNormal(AValue: TPoint3D); - procedure SetViewNormal_128(AValue: TPoint3D_128); - property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; - property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; - property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; - property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; - end; - - { IBGRAVertex3D } - - IBGRAVertex3D = interface - function GetColor: TBGRAPixel; - function GetCustomFlags: LongWord; - function GetCustomNormal: TPoint3D; - function GetCustomNormal_128: TPoint3D_128; - function GetLight: Single; - function GetProjectedCoord: TPointF; - function GetUsage: integer; - function GetViewNormal: TPoint3D; - function GetViewNormal_128: TPoint3D_128; - function GetParentColor: Boolean; - function GetSceneCoord: TPoint3D; - function GetSceneCoord_128: TPoint3D_128; - function GetTexCoord: TPointF; - function GetViewCoord: TPoint3D; - function GetViewCoord_128: TPoint3D_128; - procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D); - function GetViewCoordZ: single; - procedure SetColor(const AValue: TBGRAPixel); - procedure SetCustomFlags(AValue: LongWord); - procedure SetCustomNormal(AValue: TPoint3D); - procedure SetCustomNormal_128(AValue: TPoint3D_128); - procedure SetLight(const AValue: Single); - procedure SetProjectedCoord(const AValue: TPointF); - procedure SetViewNormal(const AValue: TPoint3D); - procedure SetViewNormal_128(const AValue: TPoint3D_128); - procedure SetParentColor(const AValue: Boolean); - procedure SetSceneCoord(const AValue: TPoint3D); - procedure SetSceneCoord_128(const AValue: TPoint3D_128); - procedure SetTexCoord(const AValue: TPointF); - procedure SetViewCoord(const AValue: TPoint3D); - procedure SetViewCoord_128(const AValue: TPoint3D_128); - procedure NormalizeViewNormal; - procedure AddViewNormal(const AValue: TPoint3D_128); - property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord; - property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128; - property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord; - property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128; - property ViewCoordZ: single read GetViewCoordZ; - property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord; - property TexCoord: TPointF read GetTexCoord write SetTexCoord; - property Color: TBGRAPixel read GetColor write SetColor; - property ParentColor: Boolean read GetParentColor write SetParentColor; - property Light: Single read GetLight write SetLight; - property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; - property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; - property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; - property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; - property Usage: integer read GetUsage; - property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags; - function GetAsObject: TObject; - end; - - arrayOfIBGRAVertex3D = array of IBGRAVertex3D; - TVertex3DCallback = procedure(AVertex: IBGRAVertex3D) of object; - - { IBGRAPart3D } - - IBGRAPart3D = interface - procedure Clear(ARecursive: boolean); - function Add(x,y,z: single): IBGRAVertex3D; overload; - function Add(pt: TPoint3D): IBGRAVertex3D; overload; - function Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; overload; - function Add(pt: TPoint3D_128): IBGRAVertex3D; overload; - function Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; overload; - function AddNormal(x,y,z: single): IBGRANormal3D; overload; - function AddNormal(pt: TPoint3D): IBGRANormal3D; overload; - function AddNormal(pt: TPoint3D_128): IBGRANormal3D; overload; - function Add(const coords: array of single): arrayOfIBGRAVertex3D; overload; - function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; overload; - function Add(const pts_128: array of TPoint3D_128): arrayOfIBGRAVertex3D; overload; - procedure Add(const pts: array of IBGRAVertex3D); overload; - procedure Add(AVertex: IBGRAVertex3D); overload; - function GetTotalNormalCount: integer; - function IndexOf(AVertex: IBGRAVertex3D): integer; - procedure RemoveVertex(Index: integer); - procedure RemoveNormal(Index: integer); - function GetBoundingBox: TBox3D; - function GetMatrix: TMatrix3D; - function GetPart(AIndex: Integer): IBGRAPart3D; - function GetPartCount: integer; - function GetRadius: single; - function GetVertex(AIndex: Integer): IBGRAVertex3D; - function GetVertexCount: integer; - function GetNormal(AIndex: Integer): IBGRANormal3D; - function GetNormalCount: integer; - function GetTotalVertexCount: integer; - function GetContainer: IBGRAPart3D; - procedure ResetTransform; - procedure Scale(size: single; Before: boolean = true); overload; - procedure Scale(x,y,z: single; Before: boolean = true); overload; - procedure Scale(size: TPoint3D; Before: boolean = true); overload; - procedure SetMatrix(const AValue: TMatrix3D); - procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); - procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); - procedure Translate(x,y,z: single; Before: boolean = true); overload; - procedure Translate(ofs: TPoint3D; Before: boolean = true); overload; - procedure RotateXDeg(angle: single; Before: boolean = true); - procedure RotateYDeg(angle: single; Before: boolean = true); - procedure RotateZDeg(angle: single; Before: boolean = true); - procedure RotateXRad(angle: single; Before: boolean = true); - procedure RotateYRad(angle: single; Before: boolean = true); - procedure RotateZRad(angle: single; Before: boolean = true); - procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); - function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF; - procedure NormalizeViewNormal; - procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); - procedure RemoveUnusedVertices; - function CreatePart: IBGRAPart3D; - procedure ForEachVertex(ACallback: TVertex3DCallback); - property VertexCount: integer read GetVertexCount; - property NormalCount: integer read GetNormalCount; - property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex; - property Normal[AIndex: Integer]: IBGRANormal3D read GetNormal write SetNormal; - property Matrix: TMatrix3D read GetMatrix write SetMatrix; - property PartCount: integer read GetPartCount; - property Part[AIndex: Integer]: IBGRAPart3D read GetPart; - property Radius: single read GetRadius; - property BoundingBox: TBox3D read GetBoundingBox; - property TotalVertexCount: integer read GetTotalVertexCount; - property TotalNormalCount: integer read GetTotalNormalCount; - property Container: IBGRAPart3D read GetContainer; - end; - - IBGRAObject3D = interface; - - { IBGRAFace3D } - - IBGRAFace3D = interface - procedure FlipFace; - function AddVertex(AVertex: IBGRAVertex3D): integer; - function GetBiface: boolean; - function GetCustomFlags: LongWord; - function GetLightThroughFactorOverride: boolean; - function GetMaterial: IBGRAMaterial3D; - function GetMaterialName: string; - function GetObject3D: IBGRAObject3D; - function GetParentTexture: boolean; - function GetTexCoord(AIndex: Integer): TPointF; - function GetTexCoordOverride(AIndex: Integer): boolean; - function GetTexture: IBGRAScanner; - function GetVertex(AIndex: Integer): IBGRAVertex3D; - function GetNormal(AIndex: Integer): IBGRANormal3D; - function GetVertexColor(AIndex: Integer): TBGRAPixel; - function GetVertexColorOverride(AIndex: Integer): boolean; - function GetVertexCount: integer; - function GetViewCenter: TPoint3D; - function GetViewCenter_128: TPoint3D_128; - function GetViewCenterZ: single; - function GetViewNormal: TPoint3D; - function GetViewNormal_128: TPoint3D_128; - function GetLightThroughFactor: single; - procedure SetCustomFlags(AValue: LongWord); - procedure SetLightThroughFactor(const AValue: single); - procedure SetBiface(const AValue: boolean); - procedure SetLightThroughFactorOverride(const AValue: boolean); - procedure SetMaterial(const AValue: IBGRAMaterial3D); - procedure SetMaterialName(const AValue: string); - procedure SetParentTexture(const AValue: boolean); - procedure SetTexCoord(AIndex: Integer; const AValue: TPointF); - procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean); - procedure SetTexture(const AValue: IBGRAScanner); - procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); - procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); - procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel); - procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean); - procedure ComputeViewNormalAndCenter; - procedure ComputeVertexColors; - procedure UpdateMaterial; - procedure SetColor(AColor: TBGRAPixel); - property Texture: IBGRAScanner read GetTexture write SetTexture; - property ParentTexture: boolean read GetParentTexture write SetParentTexture; - property VertexCount: integer read GetVertexCount; - property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex; - property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor; - property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride; - property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord; - property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride; - property ViewNormal: TPoint3D read GetViewNormal; - property ViewNormal_128: TPoint3D_128 read GetViewNormal_128; - property ViewCenter: TPoint3D read GetViewCenter; - property ViewCenter_128: TPoint3D_128 read GetViewCenter_128; - property ViewCenterZ: single read GetViewCenterZ; - property Object3D: IBGRAObject3D read GetObject3D; - property Biface: boolean read GetBiface write SetBiface; - property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor; - property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride; - property Material: IBGRAMaterial3D read GetMaterial write SetMaterial; - property MaterialName: string read GetMaterialName write SetMaterialName; - function GetAsObject: TObject; - property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags; - end; - - TFace3DCallback = procedure(AFace: IBGRAFace3D) of object; - - { IBGRAObject3D } - - IBGRAObject3D = interface - procedure Clear; - function GetColor: TBGRAPixel; - function GetFace(AIndex: integer): IBGRAFace3D; - function GetFaceCount: integer; - function GetMaterial: IBGRAMaterial3D; - function GetRefCount: integer; - function GetTotalNormalCount: integer; - function GetTotalVertexCount: integer; - function GetLight: Single; - function GetLightingNormal: TLightingNormal3D; - function GetParentLighting: boolean; - function GetTexture: IBGRAScanner; - function GetMainPart: IBGRAPart3D; - function GetScene: TObject; - procedure SetColor(const AValue: TBGRAPixel); - procedure SetLight(const AValue: Single); - procedure SetLightingNormal(const AValue: TLightingNormal3D); - procedure SetMaterial(const AValue: IBGRAMaterial3D); - procedure SetParentLighting(const AValue: boolean); - procedure SetTexture(const AValue: IBGRAScanner); - procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D); - procedure RemoveUnusedVertices; - procedure InvalidateColor; - procedure InvalidateMaterial; - procedure ForEachVertex(ACallback: TVertex3DCallback); - procedure ForEachFace(ACallback: TFace3DCallback); - function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; - function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D; overload; - procedure Update; - procedure SetBiface(AValue : boolean); - procedure SeparatePart(APart: IBGRAPart3D); - property MainPart: IBGRAPart3D read GetMainPart; - property Texture: IBGRAScanner read GetTexture write SetTexture; - property Light: Single read GetLight write SetLight; - property Color: TBGRAPixel read GetColor write SetColor; - property Face[AIndex: integer]: IBGRAFace3D read GetFace; - property FaceCount: integer read GetFaceCount; - property LightingNormal: TLightingNormal3D read GetLightingNormal write SetLightingNormal; - property ParentLighting: boolean read GetParentLighting write SetParentLighting; - property TotalVertexCount: integer read GetTotalVertexCount; - property TotalNormalCount: integer read GetTotalNormalCount; - property Material: IBGRAMaterial3D read GetMaterial write SetMaterial; - property Scene: TObject read GetScene; - property RefCount: integer read GetRefCount; - end; - - TBGRAMaterialTextureChangedEvent = procedure(ASender: TObject) of object; - - { TBGRAMaterial3D } - - TBGRAMaterial3D = class(TInterfacedObject, IBGRAMaterial3D) - private - FName: string; - FAutoSimpleColor,FAutoAmbiantColor,FAutoDiffuseColor,FAutoSpecularColor: boolean; - FSimpleColorInt, FAmbiantColorInt, FDiffuseColorInt: TColorInt65536; - FDiffuseLightness: integer; - - FSpecularColorInt: TColorInt65536; - FSpecularIndex: integer; - FSpecularOn: boolean; - - FSaturationLowF: single; - FSaturationHighF: single; - FLightThroughFactor: single; - - FTexture: IBGRAScanner; - FTextureZoom: TPointF; - FOnTextureChanged: TBGRAMaterialTextureChangedEvent; - - //phong precalc - FPowerTable: array of single; - FPowerTableSize, FPowerTableExp2: integer; - FPowerTableSizeF: single; - - procedure UpdateSpecular; - procedure UpdateSimpleColor; - procedure ComputePowerTable; - public - constructor Create; - destructor Destroy; override; - - function GetAutoAmbiantColor: boolean; - function GetAutoDiffuseColor: boolean; - function GetAutoSpecularColor: boolean; - function GetAutoSimpleColor: boolean; - function GetAmbiantAlpha: byte; - function GetAmbiantColor: TBGRAPixel; - function GetAmbiantColorF: TColorF; - function GetAmbiantColorInt: TColorInt65536; - function GetDiffuseAlpha: byte; - function GetDiffuseColor: TBGRAPixel; - function GetDiffuseColorF: TColorF; - function GetDiffuseColorInt: TColorInt65536; - function GetLightThroughFactor: single; - function GetSpecularColor: TBGRAPixel; - function GetSpecularColorF: TColorF; - function GetSpecularColorInt: TColorInt65536; - function GetSpecularIndex: integer; - function GetSaturationHigh: single; - function GetSaturationLow: single; - function GetSimpleAlpha: byte; - function GetSimpleColor: TBGRAPixel; - function GetSimpleColorF: TColorF; - function GetSimpleColorInt: TColorInt65536; - function GetTextureZoom: TPointF; - function GetSpecularOn: boolean; - function GetAsObject: TObject; - function GetName: string; - - procedure SetAutoAmbiantColor(const AValue: boolean); - procedure SetAutoDiffuseColor(const AValue: boolean); - procedure SetAutoSpecularColor(const AValue: boolean); - procedure SetAmbiantAlpha(AValue: byte); - procedure SetAmbiantColor(const AValue: TBGRAPixel); - procedure SetAmbiantColorF(const AValue: TColorF); - procedure SetAmbiantColorInt(const AValue: TColorInt65536); - procedure SetDiffuseAlpha(AValue: byte); - procedure SetDiffuseColor(const AValue: TBGRAPixel); - procedure SetDiffuseColorF(const AValue: TColorF); - procedure SetDiffuseColorInt(const AValue: TColorInt65536); - procedure SetLightThroughFactor(const AValue: single); - procedure SetSpecularColor(const AValue: TBGRAPixel); - procedure SetSpecularColorF(const AValue: TColorF); - procedure SetSpecularColorInt(const AValue: TColorInt65536); - procedure SetSpecularIndex(const AValue: integer); virtual; - procedure SetSaturationHigh(const AValue: single); - procedure SetSaturationLow(const AValue: single); - procedure SetSimpleAlpha(AValue: byte); - procedure SetSimpleColor(AValue: TBGRAPixel); - procedure SetSimpleColorF(AValue: TColorF); - procedure SetSimpleColorInt(AValue: TColorInt65536); - procedure SetTextureZoom(AValue: TPointF); - procedure SetName(const AValue: string); - - function GetTexture: IBGRAScanner; - procedure SetTexture(AValue: IBGRAScanner); - - procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536); - procedure ComputeDiffuseColor(Context: PSceneLightingContext; const DiffuseIntensity: single; const ALightColor: TColorInt65536); - procedure ComputeDiffuseLightness(Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer); - - property OnTextureChanged: TBGRAMaterialTextureChangedEvent read FOnTextureChanged write FOnTextureChanged; - - end; - - TFaceRenderingDescription = record - NormalsMode: TLightingNormal3D; - - Material: TBGRAMaterial3D; - Texture: IBGRAScanner; - LightThroughFactor: single; - Biface: boolean; - - NbVertices: Integer; - Projections: array of TPointF; - Colors: array of TBGRAPixel; - Positions3D, Normals3D: array of TPoint3D_128; - TexCoords: array of TPointF; - end; - - { TCustomRenderer3D } - - TCustomRenderer3D = class - private - FProjection: TProjection3D; - FProjectionDefined: boolean; - function GetProjectionDefined: boolean; - protected - function GetGlobalScale: single; virtual; abstract; - function GetHasZBuffer: boolean; virtual; abstract; - function GetHandlesNearClipping: boolean; virtual; abstract; - function GetHandlesFaceCulling: boolean; virtual; abstract; - function GetSurfaceWidth: integer; virtual; abstract; - function GetSurfaceHeight: integer; virtual; abstract; - procedure SetProjection(const AValue: TProjection3D); virtual; - public - function RenderFace(var ADescription: TFaceRenderingDescription; - AComputeCoordinate: TComputeProjectionFunc): boolean; virtual; abstract; - property GlobalScale: single read GetGlobalScale; - property HasZBuffer: boolean read GetHasZBuffer; - property SurfaceWidth: integer read GetSurfaceWidth; - property SurfaceHeight: integer read GetSurfaceHeight; - property Projection: TProjection3D read FProjection write SetProjection; - property ProjectionDefined: boolean read GetProjectionDefined; - property HandlesNearClipping: boolean read GetHandlesNearClipping; - property HandlesFaceCulling: boolean read GetHandlesFaceCulling; - end; - - { TBGRALight3D } - - TBGRALight3D = class(TInterfacedObject,IBGRALight3D) - protected - FMinIntensity: single; - FColorInt: TColorInt65536; - FViewVector : TPoint3D_128; - FLightness: integer; - public - constructor Create; - destructor Destroy; override; - procedure ReleaseInterface; - - procedure ComputeDiffuseLightness(Context: PSceneLightingContext); virtual; abstract; - procedure ComputeDiffuseColor(Context: PSceneLightingContext); virtual; abstract; - procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); virtual; abstract; - - function GetLightnessF: single; - function GetColor: TBGRAPixel; - function GetColorF: TColorF; - function GetColorInt: TColorInt65536; - function GetAsObject: TObject; - procedure SetColor(const AValue: TBGRAPixel); - procedure SetColorF(const AValue: TColorF); - procedure SetColorInt(const AValue: TColorInt65536); - function GetColoredLight: boolean; - - function GetMinIntensity: single; - procedure SetMinIntensity(const AValue: single); - function IsDirectional: boolean; virtual; abstract; - - function GetIntensity: single; virtual; - function GetPosition: TPoint3D; virtual; - function GetDirection: TPoint3D; virtual; - end; - -implementation - -{ TCustomRenderer3D } - -function TCustomRenderer3D.GetProjectionDefined: boolean; -begin - result := FProjectionDefined; -end; - -{$PUSH}{$OPTIMIZATION OFF} // avoids internal error 2012090607 -procedure TCustomRenderer3D.SetProjection(const AValue: TProjection3D); -begin - FProjection := AValue; - FProjectionDefined := true; -end; -{$POP} - -{ TBGRAMaterial3D } - -procedure TBGRAMaterial3D.UpdateSpecular; -begin - FAutoSpecularColor := (FSpecularColorInt.r = 65536) and (FSpecularColorInt.g = 65536) and (FSpecularColorInt.b = 65536) and (FSpecularColorInt.a = 65536); - FSpecularOn := (FSpecularIndex > 0) and ((FSpecularColorInt.r <> 0) or (FSpecularColorInt.g <> 0) or (FSpecularColorInt.b <> 0) or - FAutoSpecularColor); -end; - -procedure TBGRAMaterial3D.UpdateSimpleColor; -begin - FSimpleColorInt := (FAmbiantColorInt+FDiffuseColorInt)*32768; - FAutoSimpleColor := (FSimpleColorInt.r = 65536) and (FSimpleColorInt.g = 65536) and (FSimpleColorInt.b = 65536) and (FSimpleColorInt.a = 65536); -end; - -procedure TBGRAMaterial3D.ComputePowerTable; -var i: integer; - Exponent: single; -begin - //exponent computed by squares - Exponent := 1; - FPowerTableExp2 := 0; - While Exponent*FPowerTableSize/16 < FSpecularIndex do - begin - Exponent := Exponent * 2; - Inc(FPowerTableExp2); - end; - - //remaining exponent - setlength(FPowerTable,FPowerTableSize+3); - FPowerTable[0] := 0; //out of bound - FPowerTable[1] := 0; //image of zero - for i := 1 to FPowerTableSize do // ]0;1] - FPowerTable[i+1] := Exp(ln(i/(FPowerTableSize-1))*FSpecularIndex/Exponent); - FPowerTable[FPowerTableSize+2] := 1; //out of bound -end; - -constructor TBGRAMaterial3D.Create; -begin - SetAmbiantColorInt(ColorInt65536(65536,65536,65536)); - SetDiffuseColorInt(ColorInt65536(65536,65536,65536)); - FSpecularIndex := 10; - SetSpecularColorInt(ColorInt65536(0,0,0)); - FLightThroughFactor:= 0; - SetSaturationLow(2); - SetSaturationHigh(3); - - FTexture := nil; - FTextureZoom := PointF(1,1); - - FPowerTableSize := 128; - FPowerTableSizeF := FPowerTableSize; - FPowerTable := nil; -end; - -destructor TBGRAMaterial3D.Destroy; -begin - inherited Destroy; -end; - -function TBGRAMaterial3D.GetAutoAmbiantColor: boolean; -begin - result := FAutoAmbiantColor; -end; - -procedure TBGRAMaterial3D.SetDiffuseAlpha(AValue: byte); -begin - if AValue = 0 then - FDiffuseColorInt.a := 0 - else - FDiffuseColorInt.a := AValue*257+1; - UpdateSimpleColor; -end; - -function TBGRAMaterial3D.GetAutoDiffuseColor: boolean; -begin - result := FAutoDiffuseColor; -end; - -function TBGRAMaterial3D.GetAutoSpecularColor: boolean; -begin - result := FAutoSpecularColor; -end; - -function TBGRAMaterial3D.GetAutoSimpleColor: boolean; -begin - result := FAutoSimpleColor; -end; - -function TBGRAMaterial3D.GetAmbiantAlpha: byte; -var v: integer; -begin - if FAmbiantColorInt.a < 128 then - result := 0 - else - begin - v := (FAmbiantColorInt.a-128) shr 8; - if v > 255 then v := 255; - result := v; - end; -end; - -function TBGRAMaterial3D.GetAmbiantColor: TBGRAPixel; -begin - result := ColorIntToBGRA(FAmbiantColorInt,True); -end; - -function TBGRAMaterial3D.GetAmbiantColorF: TColorF; -begin - result := ColorInt65536ToColorF(FAmbiantColorInt); -end; - -function TBGRAMaterial3D.GetAmbiantColorInt: TColorInt65536; -begin - result := FAmbiantColorInt; -end; - -function TBGRAMaterial3D.GetDiffuseAlpha: byte; -var v: integer; -begin - if FDiffuseColorInt.a < 128 then - result := 0 - else - begin - v := (FDiffuseColorInt.a-128) shr 8; - if v > 255 then v := 255; - result := v; - end; -end; - -function TBGRAMaterial3D.GetDiffuseColor: TBGRAPixel; -begin - result := ColorIntToBGRA(FDiffuseColorInt,True); -end; - -function TBGRAMaterial3D.GetDiffuseColorF: TColorF; -begin - result := ColorInt65536ToColorF(FDiffuseColorInt); -end; - -function TBGRAMaterial3D.GetDiffuseColorInt: TColorInt65536; -begin - result := FDiffuseColorInt; -end; - -function TBGRAMaterial3D.GetLightThroughFactor: single; -begin - result := FLightThroughFactor; -end; - -function TBGRAMaterial3D.GetSpecularColor: TBGRAPixel; -begin - result := ColorIntToBGRA(FSpecularColorInt,True); -end; - -function TBGRAMaterial3D.GetSpecularColorF: TColorF; -begin - result := ColorInt65536ToColorF(FSpecularColorInt); -end; - -function TBGRAMaterial3D.GetSpecularColorInt: TColorInt65536; -begin - result := FSpecularColorInt; -end; - -function TBGRAMaterial3D.GetSpecularIndex: integer; -begin - result := FSpecularIndex; -end; - -function TBGRAMaterial3D.GetSaturationHigh: single; -begin - result := FSaturationHighF; -end; - -function TBGRAMaterial3D.GetSaturationLow: single; -begin - result := FSaturationLowF; -end; - -function TBGRAMaterial3D.GetSimpleAlpha: byte; -begin - result := (GetAmbiantAlpha + GetDiffuseAlpha) shr 1; -end; - -function TBGRAMaterial3D.GetSimpleColor: TBGRAPixel; -begin - result := ColorIntToBGRA(GetSimpleColorInt,True); -end; - -function TBGRAMaterial3D.GetSimpleColorF: TColorF; -begin - result := ColorInt65536ToColorF(GetSimpleColorInt); -end; - -function TBGRAMaterial3D.GetSimpleColorInt: TColorInt65536; -begin - result := (GetAmbiantColorInt + GetDiffuseColorInt)*32768; -end; - -function TBGRAMaterial3D.GetTexture: IBGRAScanner; -begin - result := FTexture; -end; - -function TBGRAMaterial3D.GetTextureZoom: TPointF; -begin - result := FTextureZoom; -end; - -procedure TBGRAMaterial3D.SetAutoAmbiantColor(const AValue: boolean); -begin - If AValue then - SetAmbiantColorInt(ColorInt65536(65536,65536,65536)); -end; - -procedure TBGRAMaterial3D.SetAutoDiffuseColor(const AValue: boolean); -begin - If AValue then - SetDiffuseColorInt(ColorInt65536(65536,65536,65536)); -end; - -procedure TBGRAMaterial3D.SetAutoSpecularColor(const AValue: boolean); -begin - If AValue then - SetSpecularColorInt(ColorInt65536(65536,65536,65536)); -end; - -procedure TBGRAMaterial3D.SetAmbiantAlpha(AValue: byte); -begin - if AValue = 0 then - FAmbiantColorInt.a := 0 - else - FAmbiantColorInt.a := AValue*257+1; - UpdateSimpleColor; -end; - -procedure TBGRAMaterial3D.SetAmbiantColor(const AValue: TBGRAPixel); -begin - FAmbiantColorInt := BGRAToColorInt(AValue,True); - FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536); - UpdateSimpleColor; -end; - -procedure TBGRAMaterial3D.SetAmbiantColorF(const AValue: TColorF); -begin - FAmbiantColorInt := ColorFToColorInt65536(AValue); - FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536); - UpdateSimpleColor; -end; - -procedure TBGRAMaterial3D.SetAmbiantColorInt(const AValue: TColorInt65536); -begin - FAmbiantColorInt := AValue; - FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536); - UpdateSimpleColor; -end; - -procedure TBGRAMaterial3D.SetDiffuseColor(const AValue: TBGRAPixel); -begin - FDiffuseColorInt := BGRAToColorInt(AValue,True); - FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6; - FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536); - UpdateSimpleColor; -end; - -procedure TBGRAMaterial3D.SetDiffuseColorF(const AValue: TColorF); -begin - FDiffuseColorInt := ColorFToColorInt65536(AValue); - FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6; - FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536); - UpdateSimpleColor; -end; - -procedure TBGRAMaterial3D.SetDiffuseColorInt(const AValue: TColorInt65536); -begin - FDiffuseColorInt := AValue; - FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6; - FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536); - UpdateSimpleColor; -end; - -procedure TBGRAMaterial3D.SetLightThroughFactor(const AValue: single); -begin - FLightThroughFactor:= AValue; -end; - -procedure TBGRAMaterial3D.SetSpecularColor(const AValue: TBGRAPixel); -begin - FSpecularColorInt := BGRAToColorInt(AValue,True); - UpdateSpecular; -end; - -procedure TBGRAMaterial3D.SetSpecularColorF(const AValue: TColorF); -begin - FSpecularColorInt := ColorFToColorInt65536(AValue); - UpdateSpecular; -end; - -procedure TBGRAMaterial3D.SetSpecularColorInt(const AValue: TColorInt65536); -begin - FSpecularColorInt := AValue; - UpdateSpecular; -end; - -procedure TBGRAMaterial3D.SetSpecularIndex(const AValue: integer); -begin - FSpecularIndex := AValue; - UpdateSpecular; - - FPowerTable := nil; -end; - -procedure TBGRAMaterial3D.SetSaturationHigh(const AValue: single); -begin - FSaturationHighF:= AValue; -end; - -procedure TBGRAMaterial3D.SetSaturationLow(const AValue: single); -begin - FSaturationLowF:= AValue; -end; - -procedure TBGRAMaterial3D.SetSimpleAlpha(AValue: byte); -begin - SetAmbiantAlpha(AValue); - SetDiffuseAlpha(AValue); -end; - -procedure TBGRAMaterial3D.SetSimpleColor(AValue: TBGRAPixel); -begin - SetAmbiantColor(AValue); - SetDiffuseColor(AValue); -end; - -procedure TBGRAMaterial3D.SetSimpleColorF(AValue: TColorF); -begin - SetAmbiantColorF(AValue); - SetDiffuseColorF(AValue); -end; - -procedure TBGRAMaterial3D.SetSimpleColorInt(AValue: TColorInt65536); -begin - SetAmbiantColorInt(AValue); - SetDiffuseColorInt(AValue); -end; - -procedure TBGRAMaterial3D.SetTexture(AValue: IBGRAScanner); -begin - If AValue <> FTexture then - begin - FTexture := AValue; - if Assigned(FOnTextureChanged) then - FOnTextureChanged(self); - end; -end; - -procedure TBGRAMaterial3D.SetTextureZoom(AValue: TPointF); -begin - if AValue <> FTextureZoom then - begin - FTextureZoom := AValue; - if Assigned(FOnTextureChanged) then - FOnTextureChanged(self); - end; -end; - -function TBGRAMaterial3D.GetName: string; -begin - result := FName; -end; - -procedure TBGRAMaterial3D.SetName(const AValue: string); -begin - FName := AValue; -end; - -function TBGRAMaterial3D.GetSpecularOn: boolean; -begin - result := FSpecularOn; -end; - -function TBGRAMaterial3D.GetAsObject: TObject; -begin - result := self; -end; - -procedure TBGRAMaterial3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536); -var - NH,PowerTablePos: single; //keep first for asm - - NnH: single; - PowerTableFPos: single; - PowerTableIPos,i: Int32or64; -begin - if SpecularCosine <= 0 then - NnH := 0 - else - if SpecularCosine >= 1 then - NnH := 1 else - begin - NH := SpecularCosine; - if FPowerTable = nil then ComputePowerTable; - {$IFDEF CPUI386} {$asmmode intel} - i := FPowerTableExp2; - if i > 0 then - begin - PowerTablePos := FPowerTableSize; - asm - db $d9,$45,$f0 //flds NH - mov ecx,i - @loop: - db $dc,$c8 //fmul st,st(0) - dec ecx - jnz @loop - db $d8,$4d,$ec //fmuls PowerTablePos - db $d9,$5d,$ec //fstps PowerTablePos - end; - end - else - PowerTablePos := NH*FPowerTableSize; - {$ELSE} - PowerTablePos := NH; - for i := FPowerTableExp2-1 downto 0 do - PowerTablePos := PowerTablePos*PowerTablePos; - PowerTablePos := PowerTablePos * FPowerTableSize; - {$ENDIF} - PowerTableIPos := round(PowerTablePos+0.5); - PowerTableFPos := PowerTablePos-PowerTableIPos; - NnH := FPowerTable[PowerTableIPos]*(1-PowerTableFPos)+FPowerTable[PowerTableIPos+1]*PowerTableFPos; - end; //faster than NnH := exp(FSpecularIndex*ln(NH)); ! - - if FAutoDiffuseColor then - Context^.diffuseColor := Context^.diffuseColor + ALightColor*round(DiffuseIntensity*65536) - else - Context^.diffuseColor := Context^.diffuseColor + ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536); - - if FAutoSpecularColor then - Context^.specularColor := Context^.specularColor + ALightColor*round(SpecularIntensity* NnH*65536) - else - Context^.specularColor := Context^.specularColor + ALightColor*FSpecularColorInt*round(SpecularIntensity* NnH*65536); -end; - -procedure TBGRAMaterial3D.ComputeDiffuseColor(Context: PSceneLightingContext; - const DiffuseIntensity: single; const ALightColor: TColorInt65536); -begin - if FAutoDiffuseColor then - Context^.diffuseColor := Context^.diffuseColor + ALightColor*round(DiffuseIntensity*65536) - else - Context^.diffuseColor := Context^.diffuseColor + ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536); -end; - -procedure TBGRAMaterial3D.ComputeDiffuseLightness( - Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer); -begin - if FAutoDiffuseColor then - begin - if ALightLightness <> 32768 then - inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,ALightLightness) ) - else - inc(Context^.lightness, DiffuseLightnessTerm32768 ); - end else - begin - if FDiffuseLightness <> 32768 then - inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,CombineLightness(FDiffuseLightness,ALightLightness)) ) - else - inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,ALightLightness) ); - end; -end; - -{ TBGRALight3D } - -constructor TBGRALight3D.Create; -begin - SetColorF(ColorF(1,1,1,1)); - FViewVector := Point3D_128(0,0,-1); - FMinIntensity:= 0; -end; - -destructor TBGRALight3D.Destroy; -begin - inherited Destroy; -end; - -procedure TBGRALight3D.ReleaseInterface; -begin - _Release; -end; - -function TBGRALight3D.GetLightnessF: single; -begin - result := FLightness/32768; -end; - -function TBGRALight3D.GetColor: TBGRAPixel; -begin - result := ColorIntToBGRA(FColorInt,True); -end; - -function TBGRALight3D.GetColorF: TColorF; -begin - result := ColorInt65536ToColorF(FColorInt); -end; - -function TBGRALight3D.GetColorInt: TColorInt65536; -begin - result := FColorInt; -end; - -function TBGRALight3D.GetAsObject: TObject; -begin - result := self; -end; - -procedure TBGRALight3D.SetColor(const AValue: TBGRAPixel); -begin - SetColorInt(BGRAToColorInt(AValue,True)); -end; - -procedure TBGRALight3D.SetColorF(const AValue: TColorF); -begin - SetColorInt(ColorFToColorInt65536(AValue)); -end; - -procedure TBGRALight3D.SetColorInt(const AValue: TColorInt65536); -begin - FColorInt := AValue; - FLightness:= (AValue.r+AValue.g+AValue.b) div 6; -end; - -function TBGRALight3D.GetColoredLight: boolean; -begin - result := (FColorInt.r <> FColorInt.g) or (FColorInt.g <> FColorInt.b); -end; - -function TBGRALight3D.GetMinIntensity: single; -begin - result := FMinIntensity; -end; - -procedure TBGRALight3D.SetMinIntensity(const AValue: single); -begin - FMinIntensity := AValue; -end; - -function TBGRALight3D.GetIntensity: single; -begin - result := 1; -end; - -function TBGRALight3D.GetPosition: TPoint3D; -begin - result := Point3D(0,0,0); -end; - -function TBGRALight3D.GetDirection: TPoint3D; -begin - result := Point3D(0,0,0); -end; - -end. diff --git a/components/bgrabitmap/bgraslicescaling.pas b/components/bgrabitmap/bgraslicescaling.pas deleted file mode 100644 index 3884b0c..0000000 --- a/components/bgrabitmap/bgraslicescaling.pas +++ /dev/null @@ -1,778 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASliceScaling; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmap, BGRABitmapTypes, IniFiles; - -type - TMargins = record - top, right, bottom, left: integer; - end; - TSlicePosition = (spTopLeft, spTop, spTopRight, spLeft, spMiddle, spRight, - spBottomLeft, spBottom, spBottomRight); - TSliceBitmapArray = array[TSlicePosition] of TBGRABitmap; - TSliceRectArray = array[TSlicePosition] of TRect; - TSliceRepeatPosition = (srpTop, srpLeft, srpMiddleHorizontal, - srpMiddleVertical, srpRight, srpBottom); - TSliceRepeatArray = array[TSliceRepeatPosition] of boolean; - -const - SliceRepeatPositionStr : array[TSliceRepeatPosition] of string = - ('Top','Left','MiddleHorizontal','MiddleVertical','Right','Bottom'); - -function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins; - -type - - { TBGRASliceScaling } - - TBGRASliceScaling = class - private - FSliceRectArray: TSliceRectArray; - FSliceBitmapArray: TSliceBitmapArray; - FSliceRepeat: TSliceRepeatArray; - FBitmap: TBGRABitmap; - FBitmapOwned: boolean; - FBitmapSourceRect: TRect; - FMargins: TMargins; - FDrawMode: TDrawMode; - FResampleMode: TResampleMode; - FResampleFilter: TResampleFilter; - function GetBitmapHeight: integer; - function GetBitmapWidth: integer; - function GetSlice(APosition: TSlicePosition): TBGRABitmap; - function GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean; - function GetSliceRepeatAsString: string; - procedure SetBitmap(AValue: TBGRABitmap); - procedure SetBitmapSourceRect(AValue: TRect); - procedure SetDrawMode(AValue: TDrawMode); - procedure SetResampleFilter(AValue: TResampleFilter); - procedure SetResampleMode(AValue: TResampleMode); - procedure SetSliceRepeat(Aposition: TSliceRepeatPosition; AValue: boolean); - procedure SetSliceRepeatAsString(AValue: string); - protected - // Stuff - procedure UpdateSliceRectArray; - function ComputeSliceRectArray(ARect: TRect): TSliceRectArray; - procedure SliceScalingDraw(ADest: TBGRABitmap; ADestRect: TRect; - DrawGrid: boolean = False); - procedure Init; - procedure ClearBitmapArray; - public - // Create an instance and stores the bitmap, either as a reference to a TBGRABitmap from the caller, - // or as a local owned copy in other cases - constructor Create(ABitmap: TBGRABitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false); overload; - constructor Create(ABitmap: TBitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; - constructor Create(AFilename: string; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; - constructor Create(AFilename: string; AIsUtf8: boolean; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; - constructor Create(AStream: TStream; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; - constructor Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false); overload; - constructor Create(ABitmap: TBitmap); overload; - constructor Create(AFilename: string); overload; - constructor Create(AFilename: string; AIsUtf8: boolean); overload; - constructor Create(AStream: TStream); overload; - constructor Create; overload; - procedure SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload; - procedure SetMargins(AMargins: TMargins); overload; - destructor Destroy; override; - public - procedure NotifyBitmapChanged; //to notify the source bitmap has changed - //so new bitmaps should be used - // Draw - procedure Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean = False); overload; - procedure Draw(ABitmap: TBGRABitmap; ALeft, ATop, AWidth, AHeight: integer; - DrawGrid: boolean = False); overload; - procedure AutodetectRepeat; - public - // Property - property DrawMode: TDrawMode read FDrawMode write SetDrawMode; - property ResampleMode: TResampleMode read FResampleMode write SetResampleMode; - property ResampleFilter: TResampleFilter read FResampleFilter - write SetResampleFilter; - property BitmapWidth: integer read GetBitmapWidth; - property BitmapHeight: integer read GetBitmapHeight; - property BitmapSource: TBGRABitmap read FBitmap write SetBitmap; - property BitmapSourceRect: TRect read FBitmapSourceRect write SetBitmapSourceRect; - property Margins: TMargins read FMargins write SetMargins; - property SliceBitmap[APosition: TSlicePosition]: TBGRABitmap read GetSlice; - property SliceRepeat[Aposition: TSliceRepeatPosition]: boolean - read GetSliceRepeat write SetSliceRepeat; - property SliceRepeatAsString: string read GetSliceRepeatAsString write SetSliceRepeatAsString; - end; - - TSliceScalingArray = array of TBGRASliceScaling; - TSliceScalingDirection = (sdHorizontal, sdVertical); - TBGRABitmapArray = array of TBGRABitmap; - - { TBGRAMultiSliceScaling } - - TBGRAMultiSliceScaling = class - private - FSliceScalingArray: TSliceScalingArray; - FBitmapOwned: boolean; - FBitmap: TBGRABitmap; - function GetCount: integer; - procedure SetFSliceScalingArray(AValue: TSliceScalingArray); - public - constructor Create(ABitmap: TBGRABitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection; ABitmapOwner: boolean = false); overload; - constructor Create(ABitmap: TBitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); overload; - constructor Create(ABitmapFilename: string; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); overload; - constructor Create(ABitmapFilename: string; AIsUtf8: boolean; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); overload; - constructor Create(AStream: TStream; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); overload; - destructor Destroy; override; - constructor Create(AIniFilename, ASection: string; AIsUtf8Filename: boolean= false); overload; - public - procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap; - ARect: TRect; DrawGrid: boolean = False); overload; - procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap; - ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean = False); overload; - public - property Count: integer read GetCount; - property SliceScalingArray: TSliceScalingArray - read FSliceScalingArray write SetFSliceScalingArray; - end; - -implementation - -uses BGRAUTF8; - -function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins; -begin - Result.top := atop; - Result.right := aright; - Result.bottom := abottom; - Result.left := aleft; -end; - -{ TBGRAMultiSliceScaling } - -procedure TBGRAMultiSliceScaling.SetFSliceScalingArray(AValue: TSliceScalingArray); -begin - if FSliceScalingArray = AValue then - Exit; - FSliceScalingArray := AValue; -end; - -function TBGRAMultiSliceScaling.GetCount: integer; -begin - result := length(FSliceScalingArray); -end; - -constructor TBGRAMultiSliceScaling.Create(ABitmap: TBGRABitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection; ABitmapOwner: boolean = false); -var - i: integer; - ItemWidth,ItemHeight,ItemStepX,ItemStepY: integer; -begin - FBitmap := ABitmap; - FBitmapOwned := ABitmapOwner; - ItemWidth := ABitmap.Width; - ItemHeight := ABitmap.Height; - ItemStepX := 0; - ItemStepY := 0; - case Direction of - sdVertical: begin - ItemHeight:= ABitmap.Height div NumberOfItems; - ItemStepY := ItemHeight; - end; - sdHorizontal: - begin - ItemWidth:= ABitmap.Width div NumberOfItems; - ItemStepX := ItemWidth; - end; - end; - - SetLength(FSliceScalingArray, NumberOfItems); - for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do - begin - FSliceScalingArray[i] := TBGRASliceScaling.Create(ABitmap, - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); - FSliceScalingArray[i].BitmapSourceRect := rect(ItemStepX*i,ItemStepY*i,ItemStepX*i+ItemWidth,ItemStepY*i+ItemHeight); - end; -end; - -constructor TBGRAMultiSliceScaling.Create(ABitmap: TBitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); -begin - Create(TBGRABitmap.Create(ABitmap), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, - NumberOfItems, Direction, True); -end; - -constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); -begin - Create(TBGRABitmap.Create(ABitmapFilename), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, - NumberOfItems, Direction, True); -end; - -constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string; AIsUtf8: boolean; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); -begin - Create(TBGRABitmap.Create(ABitmapFilename,AIsUtf8), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, - NumberOfItems, Direction, True); -end; - -constructor TBGRAMultiSliceScaling.Create(AStream: TStream; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer; - Direction: TSliceScalingDirection); -begin - Create(TBGRABitmap.Create(AStream), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, - NumberOfItems, Direction, True); -end; - -destructor TBGRAMultiSliceScaling.Destroy; -var - i: integer; -begin - for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do - FSliceScalingArray[i].Free; - if FBitmapOwned then FBitmap.Free; - - inherited Destroy; -end; - -constructor TBGRAMultiSliceScaling.Create(AIniFilename, ASection: string; - AIsUtf8Filename: boolean); -var - i: integer; - temp: TMemIniFile; - Direction: TSliceScalingDirection; - defaultRepeat: string; - IniPathUTF8,BitmapFilename: string; -begin - if AIsUtf8Filename then - begin - if not FileExistsUTF8(AIniFilename) then exit; - temp := TMemIniFile.Create(UTF8ToSys(AIniFilename)); - IniPathUTF8 := ExtractFilePath(AIniFilename); - end else - begin - if not FileExists(AIniFilename) then exit; - temp := TMemIniFile.Create(AIniFilename); - IniPathUTF8 := SysToUTF8(ExtractFilePath(AIniFilename)); - end; - - if temp.ReadBool(ASection, 'HorizontalDirection', False) then - Direction := sdHorizontal - else - Direction := sdVertical; - - BitmapFilename := temp.ReadString(ASection, 'Bitmap', ''); - if (copy(BitmapFilename,1,2) = '.\') or (copy(BitmapFilename,1,2) = './') then - BitmapFilename := IniPathUTF8+SysToUTF8(copy(BitmapFilename,3,Length(BitmapFilename)-2)); - Create( - BitmapFilename,True, - temp.ReadInteger(ASection, 'MarginTop', 0), - temp.ReadInteger(ASection, 'MarginRight', 0), - temp.ReadInteger(ASection, 'MarginBottom', 0), - temp.ReadInteger(ASection, 'MarginLeft', 0), - temp.ReadInteger(ASection, 'NumberOfItems', 1), - Direction); - - defaultRepeat := temp.ReadString(ASection, 'Repeat', 'Auto'); - for i := 0 to High(FSliceScalingArray) do - FSliceScalingArray[i].SliceRepeatAsString := temp.ReadString(ASection, 'Repeat'+IntToStr(i+1), defaultRepeat); - - temp.Free; -end; - -procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap; - ARect: TRect; DrawGrid: boolean); -begin - if (ItemNumber < 0) or (ItemNumber >= Count) then exit; - FSliceScalingArray[ItemNumber].Draw(ABitmap, ARect, DrawGrid); -end; - -procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap; - ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean); -begin - if (ItemNumber < 0) or (ItemNumber >= Count) then exit; - FSliceScalingArray[ItemNumber].Draw(ABitmap, ALeft, ATop, AWidth, AHeight, DrawGrid); -end; - -{ TBGRASliceScaling } - -procedure TBGRASliceScaling.SetDrawMode(AValue: TDrawMode); -begin - if FDrawMode = AValue then - Exit; - FDrawMode := AValue; -end; - -procedure TBGRASliceScaling.SetBitmap(AValue: TBGRABitmap); -begin - if FBitmap = AValue then - Exit; - if FBitmapOwned then - FBitmap.Free; - FBitmap := AValue; - FBitmapOwned := False; - UpdateSliceRectArray; -end; - -procedure TBGRASliceScaling.SetBitmapSourceRect(AValue: TRect); -begin - if (FBitmapSourceRect.Left=AValue.Left) and - (FBitmapSourceRect.Right=AValue.Right) and - (FBitmapSourceRect.Top=AValue.Top) and - (FBitmapSourceRect.Bottom=AValue.Bottom) then Exit; - FBitmapSourceRect:=AValue; - UpdateSliceRectArray; -end; - -function TBGRASliceScaling.GetSlice(APosition: TSlicePosition): TBGRABitmap; -begin - if FSliceBitmapArray[APosition] = nil then - with FSliceRectArray[APosition] do - begin - FSliceBitmapArray[APosition] := TBGRABitmap.Create(right - left, bottom - top); - FSliceBitmapArray[APosition].PutImage(-left, -top, FBitmap, dmSet); - end; - Result := FSliceBitmapArray[APosition]; -end; - -function TBGRASliceScaling.GetBitmapHeight: integer; -begin - result := FBitmapSourceRect.Bottom - FBitmapSourceRect.Top; -end; - -function TBGRASliceScaling.GetBitmapWidth: integer; -begin - result := FBitmapSourceRect.Right - FBitmapSourceRect.Left; -end; - -function TBGRASliceScaling.GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean; -begin - Result := FSliceRepeat[Aposition]; -end; - -function TBGRASliceScaling.GetSliceRepeatAsString: string; -var p: TSliceRepeatPosition; -begin - result := ''; - for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do - if SliceRepeat[p] then - begin - if result <> '' then AppendStr(result, '+'); - AppendStr(result, SliceRepeatPositionStr[p]); - end; -end; - -procedure TBGRASliceScaling.SetResampleFilter(AValue: TResampleFilter); -begin - if FResampleFilter = AValue then - Exit; - FResampleFilter := AValue; -end; - -procedure TBGRASliceScaling.SetResampleMode(AValue: TResampleMode); -begin - if FResampleMode = AValue then - Exit; - FResampleMode := AValue; -end; - -procedure TBGRASliceScaling.SetSliceRepeat(Aposition: TSliceRepeatPosition; - AValue: boolean); -begin - FSliceRepeat[Aposition] := AValue; -end; - -procedure TBGRASliceScaling.SetSliceRepeatAsString(AValue: string); -var p: TSliceRepeatPosition; - attr: string; - idx: integer; -begin - AValue := trim(AValue); - if compareText(AValue,'All')=0 then - begin - for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do - SliceRepeat[p] := true; - exit; - end; - for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do - SliceRepeat[p] := false; - if compareText(AValue,'None')=0 then exit; - - while AValue <> '' do - begin - idx := pos('+',AValue); - if idx <> 0 then - begin - attr := copy(AValue,1,idx-1); - delete(AValue,1,idx); - end else - begin - attr := AValue; - AValue := ''; - end; - for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do - if CompareText(SliceRepeatPositionStr[p],attr)=0 then - begin - SliceRepeat[p] := true; - attr := ''; - break; - end; - if compareText(attr,'Auto')=0 then AutodetectRepeat else - if attr <> '' then - raise exception.Create('Unknown slice repeat attribute ('+attr+')'); - end; -end; - -procedure TBGRASliceScaling.UpdateSliceRectArray; -begin - ClearBitmapArray; - if FBitmap = nil then exit; - FSliceRectArray := ComputeSliceRectArray(FBitmapSourceRect); -end; - -function TBGRASliceScaling.ComputeSliceRectArray(ARect: TRect): TSliceRectArray; -var - Width, Height: integer; - pos: TSlicePosition; - lMargins: TMargins; - ratio: single; -begin - Width := ARect.Right - ARect.Left; - Height := ARect.Bottom - ARect.Top; - if (Width <= 0) or (Height <= 0) then - raise Exception.Create('Empty rectangle'); - - lMargins := FMargins; - if lMargins.top < 0 then - lMargins.top := 0; - if lMargins.right < 0 then - lMargins.right := 0; - if lMargins.bottom < 0 then - lMargins.bottom := 0; - if lMargins.left < 0 then - lMargins.left := 0; - if lmargins.left + lMargins.right >= Width then - begin - ratio := Width / (lmargins.left + lMargins.right + 1); - lMargins.left := trunc(lMargins.left * ratio); - lMargins.right := trunc(lMargins.right * ratio); - end; - if lmargins.top + lMargins.bottom >= Height then - begin - ratio := Height / (lmargins.top + lMargins.bottom + 1); - lMargins.top := trunc(lMargins.top * ratio); - lMargins.bottom := trunc(lMargins.bottom * ratio); - end; - with lMargins do - begin - Result[spTopLeft] := rect(0, 0, Left, Top); - Result[spTop] := rect(Left, 0, Width - Right, Top); - Result[spTopRight] := rect(Width - Right, 0, Width, Top); - Result[spLeft] := rect(0, Top, Left, Height - Bottom); - Result[spMiddle] := rect(Left, Top, Width - Right, Height - Bottom); - Result[spRight] := rect(Width - Right, Top, Width, Height - Bottom); - Result[spBottomLeft] := rect(0, Height - Bottom, Left, Height); - Result[spBottom] := rect(Left, Height - Bottom, Width - Right, Height); - Result[spBottomRight] := rect(Width - Right, Height - Bottom, Width, Height); - end; - for pos := low(TSlicePosition) to high(TSlicePosition) do - Result[pos].Offset(ARect.Left, ARect.Top); -end; - -procedure TBGRASliceScaling.SliceScalingDraw(ADest: TBGRABitmap; - ADestRect: TRect; DrawGrid: boolean); -var - pos: TSlicePosition; - tempBGRA: TBGRABitmap; - DestSliceRect: TSliceRectArray; - repeatSlice: boolean; -begin - if (ADestRect.Right <= ADestRect.Left) or (ADestRect.Bottom <= ADestRect.Top) then - exit; - DestSliceRect := ComputeSliceRectArray(ADestRect); - for pos := Low(TSlicePosition) to High(TSlicePosition) do - begin - with DestSliceRect[pos] do - begin - if (right > left) and (bottom > top) then - begin - case pos of - spTop: repeatSlice := SliceRepeat[srpTop]; - spRight: repeatSlice := SliceRepeat[srpRight]; - spBottom: repeatSlice := SliceRepeat[srpBottom]; - spLeft: repeatSlice := SliceRepeat[srpLeft]; - spMiddle: repeatSlice := - SliceRepeat[srpMiddleHorizontal] and SliceRepeat[srpMiddleVertical]; - else - repeatSlice := False; - end; - //simple copy - if (right - left = FSliceRectArray[pos].right - FSliceRectArray[pos].left) and - (bottom - top = FSliceRectArray[pos].bottom - FSliceRectArray[pos].top) then - begin - FBitmap.ScanOffset := - point(FSliceRectArray[pos].left - left, FSliceRectArray[pos].top - top); - ADest.FillRect(left, top, right, bottom, FBitmap, FDrawMode); - end - else - //repeat in both direction - if repeatSlice then - begin - tempBGRA := SliceBitmap[pos]; - tempBGRA.ScanOffset := point(-left, -top); - ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode); - end - else - //resample in both directions (or in one direction if the other direction has the same size) - if (pos <> spMiddle) or (not SliceRepeat[srpMiddleHorizontal] and - not SliceRepeat[srpMiddleVertical]) then - begin - SliceBitmap[pos].ResampleFilter := ResampleFilter; - tempBGRA := SliceBitmap[pos].Resample(right - left, bottom - top, FResampleMode); - ADest.PutImage(left, top, tempBGRA, FDrawMode); - tempBGRA.Free; - end - else //one dimension resample, other dimension resample - begin - SliceBitmap[pos].ResampleFilter := ResampleFilter; - if not SliceRepeat[srpMiddleHorizontal] then - tempBGRA := SliceBitmap[pos].Resample( - right - left, SliceBitmap[pos].Height, FResampleMode) - else - tempBGRA := SliceBitmap[pos].Resample( - SliceBitmap[pos].Width, bottom - top, FResampleMode); - tempBGRA.ScanOffset := point(-left, -top); - ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode); - tempBGRA.Free; - end; - end; - end; - end; - if DrawGrid then - begin - ADest.DrawLineAntialias(DestSliceRect[spTop].left, DestSliceRect[spTop].top, - DestSliceRect[spBottom].left, DestSliceRect[spBottom].bottom, - BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); - ADest.DrawLineAntialias(DestSliceRect[spTop].right - 1, DestSliceRect[spTop].top, - DestSliceRect[spBottom].right - 1, DestSliceRect[spBottom].bottom, - BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); - ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].top, - DestSliceRect[spRight].right, DestSliceRect[spRight].top, - BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); - ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].bottom - 1, - DestSliceRect[spRight].right, DestSliceRect[spRight].bottom - 1, - BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False); - end; -end; - -procedure TBGRASliceScaling.Init; -var - pos: TSliceRepeatPosition; -begin - FBitmap := nil; - FBitmapOwned := False; - for pos := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do - FSliceRepeat[pos] := False; - SetMargins(0, 0, 0, 0); - FBitmapSourceRect := rect(0,0,0,0); - DrawMode := dmDrawWithTransparency; - ResampleMode := rmFineResample; - ResampleFilter := rfHalfCosine; -end; - -procedure TBGRASliceScaling.ClearBitmapArray; -var - pos: TSlicePosition; -begin - for pos := low(TSlicePosition) to high(TSlicePosition) do - FreeAndNil(FSliceBitmapArray[pos]); -end; - -constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false); -begin - Create(ABitmap, ABitmapOwner); - SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); -end; - -constructor TBGRASliceScaling.Create(ABitmap: TBitmap; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); -begin - Create(ABitmap); - SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); -end; - -constructor TBGRASliceScaling.Create(AFilename: string; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); -begin - Create(AFilename); - SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); -end; - -constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); -begin - Create(AFilename, AIsUtf8); - SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); -end; - -constructor TBGRASliceScaling.Create(AStream: TStream; - AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); -begin - Create(AStream); - SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft); -end; - -constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false); -begin - Init; - FBitmap := ABitmap; - FBitmapOwned := ABitmapOwner; - FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); -end; - -constructor TBGRASliceScaling.Create(ABitmap: TBitmap); -begin - Init; - FBitmap := TBGRABitmap.Create(ABitmap); - FBitmapOwned := True; - FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); -end; - -constructor TBGRASliceScaling.Create(AFilename: string); -begin - Init; - FBitmap := TBGRABitmap.Create(AFilename); - FBitmapOwned := True; - FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); -end; - -constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean); -begin - Init; - FBitmap := TBGRABitmap.Create(AFilename,AIsUtf8); - FBitmapOwned := True; - FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); -end; - -constructor TBGRASliceScaling.Create(AStream: TStream); -begin - Init; - FBitmap := TBGRABitmap.Create(AStream); - FBitmapOwned := True; - FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height); -end; - -constructor TBGRASliceScaling.Create; -begin - Init; -end; - -procedure TBGRASliceScaling.SetMargins(AMarginTop, AMarginRight, - AMarginBottom, AMarginLeft: integer); -begin - SetMargins(BGRASliceScaling.Margins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft)); -end; - -procedure TBGRASliceScaling.SetMargins(AMargins: TMargins); -begin - if (AMargins.top <> FMargins.top) or (AMargins.right <> FMargins.right) or - (AMargins.bottom <> FMargins.bottom) or (AMargins.left <> FMargins.left) then - begin - FMargins := AMargins; - UpdateSliceRectArray; - end; -end; - -destructor TBGRASliceScaling.Destroy; -begin - ClearBitmapArray; - if FBitmapOwned then - FreeAndNil(FBitmap); - inherited Destroy; -end; - -procedure TBGRASliceScaling.NotifyBitmapChanged; -begin - ClearBitmapArray; -end; - -procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean); -begin - SliceScalingDraw(ABitmap, ARect, DrawGrid); -end; - -procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap; - ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean); -begin - Draw(ABitmap, rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight), DrawGrid); -end; - -procedure TBGRASliceScaling.AutodetectRepeat; -var - middleSlice: TBGRABitmap; - x, y: integer; - p: PBGRAPixel; - c0: TBGRAPixel; - isRepeating: boolean; -begin - middleSlice := SliceBitmap[spMiddle]; - isRepeating := True; - for y := 0 to middleSlice.Height - 1 do - begin - p := middleSlice.ScanLine[y]; - c0 := p^; - for x := middleSlice.Width - 1 downto 0 do - begin - if p^ <> c0 then - begin - isRepeating := False; - break; - end; - Inc(p); - end; - if not isRepeating then - break; - end; - if isRepeating then - SliceRepeat[srpMiddleHorizontal] := True; - - isRepeating := True; - for x := 0 to middleSlice.Width - 1 do - begin - c0 := middleSlice.GetPixel(x, 0); - for y := middleSlice.Height - 1 downto 1 do - begin - if middleSlice.GetPixel(x, y) <> c0 then - begin - isRepeating := False; - break; - end; - end; - if not isRepeating then - break; - end; - if isRepeating then - SliceRepeat[srpMiddleVertical] := True; -end; - -end. diff --git a/components/bgrabitmap/bgraspritegl.pas b/components/bgrabitmap/bgraspritegl.pas deleted file mode 100644 index b97068e..0000000 --- a/components/bgrabitmap/bgraspritegl.pas +++ /dev/null @@ -1,586 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASpriteGL; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAOpenGLType, - BGRABitmapTypes; - -type - { TBGLCustomSprite } - - TBGLCustomSprite = class - protected - FHandle: Pointer; - FTexture: IBGLTexture; - FFrameLoopStart: integer; - FFrameLoopEnd : integer; - procedure SetFrameLoopEnd(AValue: integer); - procedure SetFrameLoopStart(AValue: integer); - function GetHorizontalAlign: TAlignment; virtual; abstract; - function GetVerticalAlign: TTextLayout; virtual; abstract; - procedure SetHorizontalAlign(AValue: TAlignment); virtual; abstract; - procedure SetVerticalAlign(AValue: TTextLayout); virtual; abstract; - function GetAlpha: Integer; virtual; abstract; - function GetAngle: Single; virtual; abstract; - function GetColor: TBGRAPixel; virtual; abstract; - function GetActualFrame: Single; virtual; abstract; - function GetFrame: Single; - function GetH: Single; virtual; abstract; - function GetLayer: Integer; virtual; abstract; - function GetLocation: TPointF; virtual; - function GetVisible: Boolean; virtual; - function GetW: Single; virtual; abstract; - function GetX: Single; virtual; abstract; - function GetY: Single; virtual; abstract; - function GetTexture: IBGLTexture; virtual; - function GetHandle: Pointer; virtual; - procedure SetAlpha(AValue: Integer); virtual; abstract; - procedure SetAngle(AValue: Single); virtual; abstract; - procedure SetColor(AValue: TBGRAPixel); virtual; abstract; - procedure SetFrame(AValue: Single); - procedure SetActualFrame(AValue: Single); virtual; abstract; - procedure SetH(AValue: Single); virtual; abstract; - procedure SetLayer(AValue: Integer); virtual; abstract; - procedure SetLocation(AValue: TPointF); virtual; - procedure SetW(AValue: Single); virtual; abstract; - procedure SetVisible({%H-}AValue: boolean); virtual; - procedure SetX(AValue: Single); virtual; abstract; - procedure SetY(AValue: Single); virtual; abstract; - procedure CreateHandle({%H-}ATexture: IBGLTexture; {%H-}ALayer: Integer); virtual; - procedure OnInit; virtual; - public - constructor Create(ATexture: IBGLTexture; ALayer: integer); - destructor Destroy; override; - procedure OnDraw; virtual; - procedure OnElapse({%H-}AElapsedMs: integer); virtual; - procedure OnTimer; virtual; - procedure QueryDestroy; virtual; abstract; - property Layer : Integer read GetLayer write SetLayer; - property Location: TPointF read GetLocation write SetLocation; - property X : Single read GetX write SetX; - property Y : Single read GetY write SetY; - property W : Single read GetW write SetW; - property H : Single read GetH write SetH; - property Angle : Single read GetAngle write SetAngle; - property Frame : Single read GetFrame write SetFrame; - property FrameLoopStart : integer read FFrameLoopStart write SetFrameLoopStart; - property FrameLoopEnd : integer read FFrameLoopEnd write SetFrameLoopEnd; - property Alpha : Integer read GetAlpha write SetAlpha; - property Color : TBGRAPixel read GetColor write SetColor; - property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign; - property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign; - property Visible : Boolean read GetVisible write SetVisible; - property Texture : IBGLTexture read GetTexture; - property Handle : Pointer read GetHandle; - end; - - { TBGLDefaultSprite } - - TBGLDefaultSprite = class(TBGLCustomSprite) - protected - FColor : TBGRAPixel; - FLocation,FSize: TPointF; - FAngle,FFrame : single; - FHorizontalAlign: TAlignment; - FVerticalAlign: TTextLayout; - FQueryDestroy: boolean; - FLayer: integer; - FHidden: boolean; - function GetHorizontalAlign: TAlignment; override; - function GetVerticalAlign: TTextLayout; override; - procedure SetHorizontalAlign(AValue: TAlignment); override; - procedure SetVerticalAlign(AValue: TTextLayout); override; - function GetAlpha: Integer; override; - function GetAngle: Single; override; - function GetColor: TBGRAPixel; override; - function GetDestroy: Boolean; - function GetActualFrame: Single; override; - function GetH: Single; override; - function GetLayer: Integer; override; - function GetVisible: Boolean; override; - function GetW: Single; override; - function GetX: Single; override; - function GetY: Single; override; - procedure SetAlpha(AValue: Integer); override; - procedure SetAngle(AValue: Single); override; - procedure SetColor(AValue: TBGRAPixel); override; - procedure SetDestroy(AValue: Boolean); - procedure SetActualFrame(AValue: Single); override; - procedure SetH(AValue: Single); override; - procedure SetLayer(AValue: Integer); override; - procedure SetVisible(AValue: boolean); override; - procedure SetW(AValue: Single); override; - procedure SetX(AValue: Single); override; - procedure SetY(AValue: Single); override; - procedure CreateHandle({%H-}ATexture: IBGLTexture; {%H-}ALayer: Integer); override; - public - procedure QueryDestroy; override; - end; - - { TBGLCustomSpriteEngine } - - TBGLCustomSpriteEngine = class - protected - function GetSprite(AIndex: integer): TBGLCustomSprite; virtual; abstract; - function GetCount: integer; virtual; abstract; - public - procedure Add(ASprite: TBGLCustomSprite); virtual; abstract; - procedure Remove(ASprite: TBGLCustomSprite); virtual; abstract; - procedure OnDraw; virtual; abstract; - procedure OnTimer; virtual; abstract; - procedure OnElapse(AElapsedMs: integer); virtual; abstract; - procedure Clear; virtual; abstract; - procedure Delete(AIndex: integer); virtual; abstract; - property Count: Integer read GetCount; - property Sprite[AIndex: integer]: TBGLCustomSprite read GetSprite; - end; - - { TBGLDefaultSpriteEngine } - - TBGLDefaultSpriteEngine = class(TBGLCustomSpriteEngine) - protected - FSpriteRemoved: TBGLCustomSprite; - FSprites: array of TBGLDefaultSprite; - FSpritesCount: integer; - function GetSprite(AIndex: integer): TBGLCustomSprite; override; - function GetCount: integer; override; - public - constructor Create; - procedure Add(ASprite: TBGLCustomSprite); override; - procedure Remove(ASprite: TBGLCustomSprite); override; - procedure OnDraw; override; - procedure OnTimer; override; - procedure OnElapse(AElapsedMs: integer); override; - procedure Clear; override; - procedure Delete(AIndex: integer); override; - end; - -var - BGLSpriteEngine : TBGLCustomSpriteEngine; - -implementation - -{ TBGLDefaultSpriteEngine } - -function TBGLDefaultSpriteEngine.GetSprite(AIndex: integer): TBGLCustomSprite; -begin - if (AIndex < 0) or (Aindex >= Count) then - raise ERangeError.Create('Index out of bounds'); - result := FSprites[AIndex]; -end; - -function TBGLDefaultSpriteEngine.GetCount: integer; -begin - result := FSpritesCount; -end; - -constructor TBGLDefaultSpriteEngine.Create; -begin - FSpritesCount := 0; -end; - -procedure TBGLDefaultSpriteEngine.Add(ASprite: TBGLCustomSprite); -var - i: Integer; -begin - if ASprite = nil then exit; - if not (ASprite is TBGLDefaultSprite) then - raise exception.Create('Invalid class'); - for i := 0 to Count-1 do - if FSprites[i] = ASprite then exit; - if Count = length(FSprites) then - setlength(FSprites, length(FSprites)*2 + 1); - FSprites[Count] := TBGLDefaultSprite(ASprite); - Inc(FSpritesCount); -end; - -procedure TBGLDefaultSpriteEngine.Remove(ASprite: TBGLCustomSprite); -var - i: Integer; -begin - if ASprite = FSpriteRemoved then exit; - for i := 0 to Count-1 do - if FSprites[i] = ASprite then - begin - Delete(i); - exit; - end; -end; - -procedure TBGLDefaultSpriteEngine.OnDraw; -var i: integer; -begin - for i := 0 to Count-1 do - FSprites[i].OnDraw; -end; - -procedure TBGLDefaultSpriteEngine.OnTimer; -var i,j,k: integer; - temp: TBGLDefaultSprite; -begin - for i := 0 to Count-1 do - FSprites[i].OnTimer; - for i := Count-1 downto 0 do - if FSprites[i].FQueryDestroy then - Delete(i); - for i := 1 to Count-1 do - begin - j := i; - while (j > 0) and (FSprites[j-1].Layer > FSprites[i].Layer) do dec(j); - if j <> i then - begin - temp := FSprites[i]; - for k := i downto j+1 do - FSprites[k] := FSprites[k-1]; - FSprites[j] := temp; - end; - end; -end; - -procedure TBGLDefaultSpriteEngine.OnElapse(AElapsedMs: integer); -var i,j,k: integer; - temp: TBGLDefaultSprite; -begin - for i := 0 to Count-1 do - FSprites[i].OnElapse(AElapsedMs); - for i := Count-1 downto 0 do - if FSprites[i].FQueryDestroy then - Delete(i); - for i := 1 to Count-1 do - begin - j := i; - while (j > 0) and (FSprites[j-1].Layer > FSprites[i].Layer) do dec(j); - if j <> i then - begin - temp := FSprites[i]; - for k := i downto j+1 do - FSprites[k] := FSprites[k-1]; - FSprites[j] := temp; - end; - end; -end; - -procedure TBGLDefaultSpriteEngine.Clear; -var i: integer; -begin - for i := 0 to Count-1 do - begin - FSpriteRemoved := FSprites[i]; - FSpriteRemoved.Free; - FSpriteRemoved := nil; - end; - FSprites := nil; - FSpritesCount := 0; -end; - -procedure TBGLDefaultSpriteEngine.Delete(AIndex: integer); -var i: integer; -begin - if (AIndex < 0) or (AIndex >= Count) then exit; - FSpriteRemoved := FSprites[AIndex]; - for i := AIndex to Count-1 do - FSprites[i] := FSprites[i+1]; - dec(FSpritesCount); - if FSpritesCount <= length(FSprites) div 2 then - setlength(FSprites,FSpritesCount); - FSpriteRemoved.Free; - FSpriteRemoved := nil; -end; - -{ TBGLDefaultSprite } - -function TBGLDefaultSprite.GetHorizontalAlign: TAlignment; -begin - result := FHorizontalAlign; -end; - -function TBGLDefaultSprite.GetVerticalAlign: TTextLayout; -begin - result := FVerticalAlign; -end; - -procedure TBGLDefaultSprite.SetHorizontalAlign(AValue: TAlignment); -begin - FHorizontalAlign:= AValue; -end; - -procedure TBGLDefaultSprite.SetVerticalAlign(AValue: TTextLayout); -begin - FVerticalAlign := AValue; -end; - -function TBGLDefaultSprite.GetAlpha: Integer; -begin - result := FColor.alpha; -end; - -function TBGLDefaultSprite.GetAngle: Single; -begin - result := FAngle; -end; - -function TBGLDefaultSprite.GetColor: TBGRAPixel; -begin - result := FColor; -end; - -function TBGLDefaultSprite.GetDestroy: Boolean; -begin - result := FQueryDestroy; -end; - -function TBGLDefaultSprite.GetActualFrame: Single; -begin - result := FFrame; -end; - -function TBGLDefaultSprite.GetH: Single; -begin - result := FSize.Y; -end; - -function TBGLDefaultSprite.GetLayer: Integer; -begin - result := FLayer; -end; - -function TBGLDefaultSprite.GetVisible: Boolean; -begin - Result:= not FHidden; -end; - -function TBGLDefaultSprite.GetW: Single; -begin - result := FSize.X; -end; - -function TBGLDefaultSprite.GetX: Single; -begin - result := FLocation.X; -end; - -function TBGLDefaultSprite.GetY: Single; -begin - result := FLocation.Y; -end; - -procedure TBGLDefaultSprite.SetAlpha(AValue: Integer); -begin - FColor.Alpha := AValue; -end; - -procedure TBGLDefaultSprite.SetAngle(AValue: Single); -begin - FAngle:= AValue; -end; - -procedure TBGLDefaultSprite.SetColor(AValue: TBGRAPixel); -begin - FColor := AValue; -end; - -procedure TBGLDefaultSprite.SetDestroy(AValue: Boolean); -begin - FQueryDestroy:= AValue; -end; - -procedure TBGLDefaultSprite.SetActualFrame(AValue: Single); -begin - FFrame:= AValue; -end; - -procedure TBGLDefaultSprite.SetH(AValue: Single); -begin - FSize.Y := AValue; -end; - -procedure TBGLDefaultSprite.SetLayer(AValue: Integer); -begin - FLayer:= AValue; -end; - -procedure TBGLDefaultSprite.SetVisible(AValue: boolean); -begin - FHidden := not AValue; -end; - -procedure TBGLDefaultSprite.SetW(AValue: Single); -begin - FSize.X := AValue; -end; - -procedure TBGLDefaultSprite.SetX(AValue: Single); -begin - FLocation.X := AValue; -end; - -procedure TBGLDefaultSprite.SetY(AValue: Single); -begin - FLocation.Y := AValue; -end; - -procedure TBGLDefaultSprite.CreateHandle(ATexture: IBGLTexture; ALayer: Integer); -begin - inherited CreateHandle(ATexture, ALayer); - FQueryDestroy := false; - FLayer:= ALayer; -end; - -procedure TBGLDefaultSprite.QueryDestroy; -begin - SetDestroy(True); -end; - -{ TBGLCustomSprite } - -function TBGLCustomSprite.GetTexture: IBGLTexture; -begin - result := FTexture; -end; - -function TBGLCustomSprite.GetHandle: Pointer; -begin - result := FHandle; -end; - -procedure TBGLCustomSprite.SetFrame(AValue: Single); -var loopLength: integer; -begin - if (FrameLoopEnd <> 0) and (FrameLoopStart <> 0) then - begin - loopLength := FrameLoopEnd-FrameLoopStart+1; - if AValue >= FrameLoopEnd+0.49 then - begin - if loopLength <= 1 then - AValue := FrameLoopEnd+0.49 - else - begin - DecF(AValue, Trunc((AValue-(FrameLoopStart-0.5))/loopLength)*loopLength); - if AValue > FrameLoopEnd+0.49 then AValue := FrameLoopStart-0.49; - if AValue < FrameLoopStart-0.49 then AValue := FrameLoopStart-0.49; - end; - end else - if AValue < FrameLoopStart-0.49 then - begin - if loopLength <= 1 then - AValue := FrameLoopStart-0.49 - else - begin - IncF(AValue, Trunc((FrameLoopEnd+0.5-AValue)/loopLength)*loopLength); - if AValue > FrameLoopEnd+0.49 then AValue := FrameLoopEnd+0.49; - if AValue < FrameLoopStart-0.49 then AValue := FrameLoopEnd+0.49; - end; - end; - end; - SetActualFrame(AValue); -end; - -procedure TBGLCustomSprite.SetFrameLoopEnd(AValue: integer); -begin - FFrameLoopEnd := AValue; - if FFrameLoopEnd < FFrameLoopStart then - FFrameLoopStart := FFrameLoopEnd; -end; - -procedure TBGLCustomSprite.SetFrameLoopStart(AValue: integer); -begin - FFrameLoopStart := AValue; - if FFrameLoopStart > FFrameLoopEnd then - FFrameLoopEnd := FFrameLoopStart; -end; - -function TBGLCustomSprite.GetFrame: Single; -begin - result := GetActualFrame; -end; - -function TBGLCustomSprite.GetLocation: TPointF; -begin - result := PointF(X,Y); -end; - -function TBGLCustomSprite.GetVisible: Boolean; -begin - result := true; -end; - -procedure TBGLCustomSprite.SetLocation(AValue: TPointF); -begin - X := AValue.X; - Y := AValue.Y; -end; - -procedure TBGLCustomSprite.SetVisible(AValue: boolean); -begin - raise ENotImplemented.Create('Not implemented in base class'); -end; - -procedure TBGLCustomSprite.CreateHandle(ATexture: IBGLTexture; ALayer: Integer); -begin - FHandle := nil; -end; - -procedure TBGLCustomSprite.OnInit; -begin - //nothing -end; - -constructor TBGLCustomSprite.Create(ATexture: IBGLTexture; ALayer: integer); -begin - CreateHandle(ATexture,ALayer); - FTexture := ATexture; - Layer := ALayer; - if ATexture = nil then - begin - W := 0; - H := 0; - end else - begin - W := ATexture.FrameWidth; - H := ATexture.FrameHeight; - end; - HorizontalAlign := taLeftJustify; - VerticalAlign:= tlTop; - Color := BGRAWhite; - FrameLoopStart := 1; - FrameLoopEnd := 0; - OnInit; - BGLSpriteEngine.Add(self); -end; - -destructor TBGLCustomSprite.Destroy; -begin - if Assigned(BGLSpriteEngine) then - BGLSpriteEngine.Remove(self); - inherited Destroy; -end; - -procedure TBGLCustomSprite.OnDraw; -var NumFrame: integer; -begin - if Visible and (Texture <> nil) then - begin - NumFrame := Trunc(Frame+0.5); - if Angle <> 0 then - Texture.Frame[NumFrame].StretchDrawAngle(X,Y,W,H,Angle,HorizontalAlign,VerticalAlign, Color) - else - Texture.Frame[NumFrame].StretchDraw(X,Y,W,H,HorizontalAlign,VerticalAlign, Color) - end; -end; - -procedure TBGLCustomSprite.OnElapse(AElapsedMs: integer); -begin - //override if you want to handle time as continuous flow. It is recommended to use floating point positions in this case. -end; - -procedure TBGLCustomSprite.OnTimer; -begin - //override if you want to handle time as discrete frames with fixed time interval -end; - -end. - diff --git a/components/bgrabitmap/bgrasse.inc b/components/bgrabitmap/bgrasse.inc deleted file mode 100644 index a52c86b..0000000 --- a/components/bgrabitmap/bgrasse.inc +++ /dev/null @@ -1,28 +0,0 @@ -{$IFDEF SSE_LOADV} - {$UNDEF SSE_LOADV} - {$ifdef cpux86_64} - mov rax,v - movups xmm1,[rax] - {$else} - mov eax,v - movups xmm1,[eax] - {$endif} -{$ELSE} - {$IFDEF SSE_SAVEV} - {$UNDEF SSE_SAVEV} - {$ifdef cpux86_64} - mov rax,v - movups [rax],xmm1 - {$else} - mov eax,v - movups [eax],xmm1 - {$endif} - {$ELSE} - {$IFDEF CPUI386} - {$DEFINE BGRASSE_AVAILABLE} - {$ENDIF} - {$IFDEF cpux86_64} - {$DEFINE BGRASSE_AVAILABLE} - {$ENDIF} - {$ENDIF} -{$ENDIF} \ No newline at end of file diff --git a/components/bgrabitmap/bgrasse.pas b/components/bgrabitmap/bgrasse.pas deleted file mode 100644 index 274229f..0000000 --- a/components/bgrabitmap/bgrasse.pas +++ /dev/null @@ -1,656 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASSE; - -{$mode objfpc}{$H+} - -{$i bgrasse.inc} -{$modeswitch advancedrecords} - -interface - -{begin //param: eax, edx, ecx //float: eax ecx edx - //flds $d9 - //fadds $d8 - //fstps $d9 +$18 - //fmuls $d8 +$08 - //fsubrs $d8 +$28 - //offset +$40 $..} -uses - BGRABitmapTypes {$ifdef CPUI386}, cpu, mmx{$endif}; - -const FLAG_ENABLED_SSE = true; - -var UseSSE, UseSSE2, UseSSE3 : boolean; - -{$ifdef CPUI386} - {$asmmode intel} -{$ENDIF} -{$ifdef cpux86_64} - {$asmmode intel} -{$ENDIF} - -{$ifdef BGRASSE_AVAILABLE} - //SSE rotate singles - const Shift231 = 1 + 8; - Shift312 = 2 + 16; -{$endif} - -type - - { TPoint3D_128 } - - TPoint3D_128 = packed record - x,y,z,t: single; - procedure Offset(const point3D_128: TPoint3D_128); - procedure Scale(AScale: single); - end; - PPoint3D_128 = ^TPoint3D_128; - - function Point3D(const point3D_128: TPoint3D_128): TPoint3D; inline; overload; - function Point3D_128(const point3D: TPoint3D): TPoint3D_128; inline; overload; - function Point3D_128(const pointF: TPointF): TPoint3D_128; inline; overload; - function Point3D_128(x,y,z: single): TPoint3D_128; inline; overload; - function Point3D_128(x,y,z,t: single): TPoint3D_128; inline; overload; - procedure Normalize3D_128_SqLen(var v: TPoint3D_128; out SqLen: single); - operator * (const v1: TPoint3D_128; const factor: single): TPoint3D_128; - operator + (constref v1,v2: TPoint3D_128): TPoint3D_128; - operator - (const v1,v2: TPoint3D_128): TPoint3D_128; - operator - (const v: TPoint3D_128): TPoint3D_128; inline; - operator = (const v1,v2: TPoint3D_128): boolean; inline; - procedure ClearPoint3D_128(out v: TPoint3D_128); - {$IFDEF BGRASSE_AVAILABLE} - procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128); - {$ENDIF} - function IsPoint3D_128_Zero(const v: TPoint3D_128): boolean; inline; - -var - Add3D_Aligned : procedure (var dest: TPoint3D_128; constref src: TPoint3D_128); - Normalize3D_128 : procedure (var v: TPoint3D_128); - VectProduct3D_128 : procedure (const u,v: TPoint3D_128; out w: TPoint3D_128); - DotProduct3D_128 : function (constref v1,v2: TPoint3D_128): single; - -const - Point3D_128_Zero : TPoint3D_128 = (x:0; y:0; z:0; t:0); - -type - - { TMemoryBlockAlign128 } - - TMemoryBlockAlign128 = class - private - FContainer: Pointer; - FData: Pointer; - public - constructor Create(size: integer); - destructor Destroy; override; - property Data: pointer read FData; - end; - - PBasicLightingContext = ^TBasicLightingContext; - TBasicLightingContext = packed record - {0} Position, {16} Normal: TPoint3D_128; - {32} PositionInvZ, {48} NormalInvZ: TPoint3D_128; - {64} PositionStepInvZ, {80} NormalStepInvZ: TPoint3D_128; - {96} dummy4: single; - {100} dummy3: LongBool; - {104} dummy1: LongWord; - {108} dummy2: LongWord; - {112} dummy: packed array[0..15]of byte; - end; {128} - -const ExtendedLightingContextSize = 128; - -implementation - -{ TPoint3D_128 } - -procedure TPoint3D_128.Offset(const point3D_128: TPoint3D_128); -begin - self.x := self.x + point3D_128.x; - self.y := self.y + point3D_128.y; - self.z := self.z + point3D_128.z; -end; - -procedure TPoint3D_128.Scale(AScale: single); -begin - self.x := self.x * AScale; - self.y := self.y * AScale; - self.z := self.z * AScale; -end; - -function Point3D(const point3D_128: TPoint3D_128): TPoint3D; inline; overload; -begin - result.x := point3D_128.x; - result.y := point3D_128.y; - result.z := point3D_128.z; -end; - -function Point3D_128(const point3D: TPoint3D): TPoint3D_128; inline; overload; -begin - result.x := point3D.x; - result.y := point3D.y; - result.z := point3D.z; - result.t := 0; -end; - -function Point3D_128(const pointF: TPointF): TPoint3D_128; -begin - result.x := pointF.x; - result.y := pointF.y; - result.z := 0; - result.t := 0; -end; - -function Point3D_128(x,y,z: single): TPoint3D_128; inline; overload; -begin - result.x := x; - result.y := y; - result.z := z; - result.t := 0; -end; - -function Point3D_128(x,y,z,t: single): TPoint3D_128; inline; overload; -begin - result.x := x; - result.y := y; - result.z := z; - result.t := t; -end; - -operator + (constref v1,v2: TPoint3D_128): TPoint3D_128; -{$ifdef CPUI386} assembler; -asm - db $d9, $00 //flds [eax] - db $d8, $02 //fadds [edx] - db $d9, $19 //fstps [ecx] - - db $d9, $40, $04 //flds [eax+4] - db $d8, $42, $04 //fadds [edx+4] - db $d9, $59, $04 //fstps [ecx+4] - - db $d9, $40, $08 //flds [eax+8] - db $d8, $42, $08 //fadds [edx+8] - db $d9, $59, $08 //fstps [ecx+8] - - xor eax,eax - mov [ecx+12],eax -end; -{$else} -begin - result.x := v1.x+v2.x; - result.y := v1.y+v2.y; - result.z := v1.z+v2.z; - result.t := 0; -end; -{$endif} - -{$ifdef BGRASSE_AVAILABLE} -procedure Add3D_AlignedSSE(var dest: TPoint3D_128; constref src: TPoint3D_128); assembler; -asm - movaps xmm0, [dest] - movups xmm1, [src] - addps xmm0, xmm1 - movaps [dest], xmm0 -end; -{$endif} - -procedure Add3D_NoSSE(var dest: TPoint3D_128; constref src: TPoint3D_128); -{$ifdef CPUI386} assembler; -asm - db $d9, $00 //flds [eax] - db $d8, $02 //fadds [edx] - db $d9, $18 //fstps [eax] - - db $d9, $40, $04 //flds [eax+4] - db $d8, $42, $04 //fadds [edx+4] - db $d9, $58, $04 //fstps [eax+4] - - db $d9, $40, $08 //flds [eax+8] - db $d8, $42, $08 //fadds [edx+8] - db $d9, $58, $08 //fstps [eax+8] -end; -{$else} -begin - dest.x := dest.x + src.x; - dest.y := dest.y + src.y; - dest.z := dest.z + src.z; -end; -{$endif} - -operator - (const v1,v2: TPoint3D_128): TPoint3D_128; -{$ifdef CPUI386} assembler; -asm - db $d9, $02 //flds [edx] - db $d8, $28 //fsubrs [eax] - db $d9, $19 //fstps [ecx] - - db $d9, $42, $04 //flds [edx+4] - db $d8, $68, $04 //fsubrs [eax+4] - db $d9, $59, $04 //fstps [ecx+4] - - db $d9, $42, $08 //flds [edx+8] - db $d8, $68, $08 //fsubrs [eax+8] - db $d9, $59, $08 //fstps [ecx+8] - - xor eax,eax - mov [ecx+12],eax -end; -{$else} -begin - result.x := v1.x-v2.x; - result.y := v1.y-v2.y; - result.z := v1.z-v2.z; - result.t := 0; -end; -{$endif} - -operator-(const v: TPoint3D_128): TPoint3D_128; inline; -begin - result.x := -v.x; - result.y := -v.y; - result.z := -v.z; - result.t := 0; -end; - -operator=(const v1, v2: TPoint3D_128): boolean; inline; -begin - result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z); -end; - -procedure ClearPoint3D_128(out v: TPoint3D_128); -{$ifdef cpux86_64} assembler; -asm - push rbx - mov rax,v - xor rbx,rbx - mov [rax],rbx - mov [rax+8],rbx - pop rbx -end; -{$else} - {$ifdef CPUI386} assembler; - asm - push ebx - mov eax,v - xor ebx,ebx - mov [eax],ebx - mov [eax+4],ebx - mov [eax+8],ebx - pop ebx - end; - {$else} - var p: PLongWord; - begin - p := @v; - p^ := 0; - inc(p); - p^ := 0; - inc(p); - p^ := 0; - end; - {$endif} -{$endif} - -procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128); -{$ifdef BGRASSE_AVAILABLE} assembler; - asm - xorps xmm0,xmm0 - {$ifdef cpux86_64} - mov rax,v - movaps [rax],xmm0 - {$else} - mov eax,v - movaps [eax],xmm0 - {$endif} - end; -{$else} -var p: PLongWord; -begin - p := @v; - p^ := 0; - inc(p); - p^ := 0; - inc(p); - p^ := 0; -end; -{$endif} - -function IsPoint3D_128_Zero(const v: TPoint3D_128): boolean; -begin - result := (v.x=0) and (v.y=0) and (v.z=0); -end; - -operator * (const v1: TPoint3D_128; const factor: single): TPoint3D_128; -{$ifdef CPUI386} assembler; -asm - db $d9, $00 //flds [eax] - db $d8, $4d, $08 //fmuls [ebp+8] - db $d9, $1a //fstps [edx] - - db $d9, $40, $04 //flds [eax+4] - db $d8, $4d, $08 //fmuls [ebp+8] - db $d9, $5a, $04 //fstps [edx+4] - - db $d9, $40, $08 //flds [eax+8] - db $d8, $4d, $08 //fmuls [ebp+8] - db $d9, $5a, $08 //fstps [edx+8] - - xor eax,eax - mov [edx+12],eax -end; -{$else} -begin - result.x := v1.x*factor; - result.y := v1.y*factor; - result.z := v1.z*factor; - result.t := 0; -end; -{$endif} - -{$ifdef BGRASSE_AVAILABLE} -function DotProduct3D_128_SSE3(constref v1,v2: TPoint3D_128): single; assembler; -asm - movups xmm0, [v1] - movups xmm1, [v2] - mulps xmm0, xmm1 - - haddps xmm0,xmm0 - haddps xmm0,xmm0 - movss [result], xmm0 -end; -{$endif} - -function DotProduct3D_128_NoSSE(constref v1,v2: TPoint3D_128): single; -begin - result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z; -end; - -procedure Normalize3D_128_NoSSE(var v: TPoint3D_128); -var len2: single; -begin - len2 := DotProduct3D_128_NoSSE(v,v); - if len2 = 0 then exit; - v.Scale( 1/sqrt(len2) ); -end; - -{$ifdef BGRASSE_AVAILABLE} -procedure Normalize3D_128_SSE1(var v: TPoint3D_128); -var len2: single; -begin - asm - {$DEFINE SSE_LOADV}{$i bgrasse.inc} - movaps xmm2, xmm1 - mulps xmm2, xmm2 - - //mix1 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $4e - addps xmm2, xmm7 - //mix2 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $11 - addps xmm2, xmm7 - - movss len2, xmm2 - end; - if (len2 = 0) then exit; - if len2 < 1e-6 then //out of bounds for SSE instruction - begin - v.Scale( 1/sqrt(len2) ); - end else - asm - rsqrtps xmm2, xmm2 - mulps xmm1, xmm2 //apply - {$DEFINE SSE_SAVEV}{$i bgrasse.inc} - end; -end; -{$endif} - -{$ifdef BGRASSE_AVAILABLE} -procedure Normalize3D_128_SSE3(var v: TPoint3D_128); -var len2: single; -begin - asm - {$DEFINE SSE_LOADV}{$i bgrasse.inc} - movaps xmm2, xmm1 - mulps xmm2, xmm2 - - haddps xmm2,xmm2 - haddps xmm2,xmm2 - - movss len2, xmm2 - end; - if (len2 = 0) then exit; - if len2 < 1e-6 then //out of bounds for SSE instruction - begin - v.Scale( 1/sqrt(len2) ); - end else - asm - rsqrtps xmm2, xmm2 - mulps xmm1, xmm2 //apply - {$DEFINE SSE_SAVEV}{$i bgrasse.inc} - end; -end; -{$endif} - -procedure Normalize3D_128_SqLen(var v: TPoint3D_128; out SqLen: single); -begin - {$ifdef BGRASSE_AVAILABLE} - if UseSSE then - begin - asm - {$DEFINE SSE_LOADV}{$i bgrasse.inc} - movaps xmm2, xmm1 - mulps xmm2, xmm2 - end; - if UseSSE3 then - asm - haddps xmm2,xmm2 - haddps xmm2,xmm2 - {$ifdef cpux86_64} - mov rax, SqLen - movss [rax], xmm2 - {$else} - mov eax, SqLen - movss [eax], xmm2 - {$endif} - end else - asm - //mix1 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $4e - addps xmm2, xmm7 - //mix2 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $11 - addps xmm2, xmm7 - {$ifdef cpux86_64} - mov rax, SqLen - movss [rax], xmm2 - {$else} - mov eax, SqLen - movss [eax], xmm2 - {$endif} - end; - if SqLen = 0 then exit; - if SqLen < 1e-6 then //out of bounds for SSE instruction - begin - v.Scale( 1/sqrt(SqLen) ); - end else - asm - rsqrtps xmm2, xmm2 - mulps xmm1, xmm2 //apply - {$DEFINE SSE_SAVEV}{$i bgrasse.inc} - end; - end - else -{$endif} - begin - SqLen := DotProduct3D_128_NoSSE(v,v); - if SqLen = 0 then exit; - v.Scale( 1/sqrt(SqLen) ); - end; -end; - -procedure VectProduct3D_128_NoSSE(const u,v: TPoint3D_128; out w: TPoint3D_128); -begin - w.x := u.y*v.z-u.z*v.y; - w.y := u.z*v.x-u.x*v.z; - w.z := u.x*v.Y-u.y*v.x; - w.t := 0; -end; - -{$ifdef BGRASSE_AVAILABLE} -procedure VectProduct3D_128_SSE(constref u,v: TPoint3D_128; out w: TPoint3D_128); assembler; -asm - {$ifdef cpux86_64} - mov rax,u - movups xmm6,[rax] - {$else} - mov eax,u - movups xmm6,[eax] - {$endif} - movaps xmm4, xmm6 - shufps xmm6, xmm6, Shift231 - - {$ifdef cpux86_64} - mov rax,v - movups xmm7,[rax] - {$else} - mov eax,v - movups xmm7,[eax] - {$endif} - movaps xmm5,xmm7 - shufps xmm7, xmm7, Shift312 - - movaps xmm3,xmm6 - mulps xmm3,xmm7 - - shufps xmm4, xmm4, Shift312 - shufps xmm5, xmm5, Shift231 - - mulps xmm4,xmm5 - subps xmm3,xmm4 - - {$ifdef cpux86_64} - mov rax,w - movups [rax],xmm3 - {$else} - mov eax,w - movups [eax],xmm3 - {$endif} -end; - -{$endif} - -{ TMemoryBlockAlign128 } - -{$hints off} -constructor TMemoryBlockAlign128.Create(size: integer); -{$IFDEF BGRASSE_AVAILABLE} -var - delta: PtrUInt; -begin - getmem(FContainer, size+15); - delta := PtrUInt(FContainer) and 15; - if delta <> 0 then delta := 16-delta; - FData := pbyte(FContainer)+delta; -end; -{$ELSE} -begin - getmem(FContainer, size); - FData := FContainer; -end; -{$ENDIF} -{$hints on} - -destructor TMemoryBlockAlign128.Destroy; -begin - freemem(FContainer); - inherited Destroy; -end; - -{$ifdef BGRASSE_AVAILABLE} -function sse3_support : boolean; - - var - _ecx : longint; - - begin - {$IFDEF CPUI386} - if cpuid_support then - begin - asm - push ebx - mov eax,1 - cpuid - mov _ecx,ecx - pop ebx - end; - sse3_support:=(_ecx and 1)<>0; - end - else - sse3_support:=false; - {$ELSE} - asm - push rbx - mov eax,1 - cpuid - mov _ecx,ecx - pop rbx - end; - sse3_support:=(_ecx and 1)<>0; - {$ENDIF} - end; -{$endif} - -initialization - - {$ifdef CPUI386} - UseSSE := is_sse_cpu and FLAG_ENABLED_SSE; - {$else} - {$ifdef cpux86_64} - UseSSE := FLAG_ENABLED_SSE; - {$else} - UseSSE := false; - {$endif} - {$endif} - - {$IFDEF BGRASSE_AVAILABLE} - if UseSSE then - begin - {$ifdef cpux86_64} - UseSSE2 := true; - {$else} - UseSSE2 := is_sse2_cpu; - {$endif} - UseSSE3 := sse3_support; - - Add3D_Aligned := @Add3D_AlignedSSE; - VectProduct3D_128 := @VectProduct3D_128_NoSSE; //VectProduct3D_128_SSE is slower (due to access penalty?) - if UseSSE3 then - begin - Normalize3D_128 := @Normalize3D_128_SSE3; - DotProduct3D_128 := @DotProduct3D_128_NoSSE; //DotProduct3D_128_SSE3 is slower (due to access penalty?) - end - else - begin - Normalize3D_128 := @Normalize3D_128_SSE1; - DotProduct3D_128 := @DotProduct3D_128_NoSSE; - end; - end - else - {$ENDIF} - begin - UseSSE := false; - UseSSE2 := false; - UseSSE3 := false; - - Add3D_Aligned := @Add3D_NoSSE; - Normalize3D_128 := @Normalize3D_128_NoSSE; - VectProduct3D_128 := @VectProduct3D_128_NoSSE; - DotProduct3D_128 := @DotProduct3D_128_NoSSE; - end; - -end. - diff --git a/components/bgrabitmap/bgrastreamlayers.pas b/components/bgrabitmap/bgrastreamlayers.pas deleted file mode 100644 index 75f8e3c..0000000 --- a/components/bgrabitmap/bgrastreamlayers.pas +++ /dev/null @@ -1,393 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAStreamLayers; - -{$mode objfpc}{$H+} -{$MODESWITCH ADVANCEDRECORDS} - -interface - -uses - BGRAClasses, SysUtils, BGRALayers, BGRABitmap, BGRALzpCommon, BGRAMemDirectory; - -function CheckStreamForLayers(AStream: TStream): boolean; -function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean = false; - ADestination: TBGRALayeredBitmap = nil; AProgress: boolean = false): TBGRALayeredBitmap; -procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap; ASelectedLayerIndex: integer; - ACompression: TLzpCompression = lzpZStream; AProgress: boolean = false); -procedure SaveLayerBitmapToStream(AStream: TStream; ABitmap: TBGRABitmap; ACaption: string; ACompression: TLzpCompression = lzpZStream); -function LoadLayerBitmapFromStream(AStream: TStream; ACompression: TLzpCompression = lzpZStream) : TBGRABitmap; -procedure RegisterStreamLayers; - -implementation - -uses BGRABitmapTypes, BGRACompressableBitmap, zstream, BGRAReadLzp, BGRAWriteLzp, - BGRAUTF8, Math; - -type - PLayerHeader = ^TLayerHeader; - - { TLayerHeader } - - TLayerHeader = packed record - LayerOption, BlendOp, - LayerOfsX, LayerOfsY, - LayerUniqueId, LayerOpacity: Longint; - LayerBitmapSize: int64; - OriginalGuid: TGuid; - OriginalMatrix: TAffineMatrix; - procedure FixEndian; - end; - -{ TLayerHeader } - -procedure TLayerHeader.FixEndian; -begin - LayerOption := NtoLE(LayerOption); - BlendOp := NtoLE(BlendOp); - LayerOfsX := NtoLE(LayerOfsX); - LayerOfsY := NtoLE(LayerOfsY); - LayerUniqueId := NtoLE(LayerUniqueId); - LayerOpacity := NtoLE(LayerOpacity); - LayerBitmapSize := NtoLE(LayerBitmapSize); - OriginalGuid.D1 := NtoBE(OriginalGuid.D1); - OriginalGuid.D2 := NtoBE(OriginalGuid.D2); - OriginalGuid.D3 := NtoBE(OriginalGuid.D3); - LongWord(OriginalMatrix[1,1]) := NtoLE(LongWord(OriginalMatrix[1,1])); - LongWord(OriginalMatrix[2,1]) := NtoLE(LongWord(OriginalMatrix[2,1])); - LongWord(OriginalMatrix[1,2]) := NtoLE(LongWord(OriginalMatrix[1,2])); - LongWord(OriginalMatrix[2,2]) := NtoLE(LongWord(OriginalMatrix[2,2])); - LongWord(OriginalMatrix[1,3]) := NtoLE(LongWord(OriginalMatrix[1,3])); - LongWord(OriginalMatrix[2,3]) := NtoLE(LongWord(OriginalMatrix[2,3])); -end; - -procedure SaveLayeredBitmapToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); -begin - SaveLayersToStream(AStream,ALayers,-1); -end; - -procedure LoadLayeredBitmapFromStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap); -var selectedIndex: integer; -begin - if not CheckStreamForLayers(AStream) then - begin - if Assigned(ALayers) then ALayers.Clear; - end - else - LoadLayersFromStream(AStream,selectedIndex,false,ALayers as TBGRALayeredBitmap); -end; - -const - StreamHeader = 'TBGRALayeredBitmap'#26#0; - StreamMaxLayerCount = 4096; - StreamMaxHeaderSize = 256; - -function CheckStreamForLayers(AStream: TStream): boolean; -var - OldPosition: Int64; - HeaderFound: string; -begin - result := false; - OldPosition:= AStream.Position; - try - SetLength(HeaderFound, length(StreamHeader)); - SetLength(HeaderFound, AStream.Read(HeaderFound[1], length(HeaderFound))); - if HeaderFound = StreamHeader then - result := true; - except - on ex: exception do - begin - //nothing - end; - end; - AStream.Position:= OldPosition; -end; - -procedure RenameLayersToUniqueId(ALayers: TBGRACustomLayeredBitmap); -var - layerDir: TMemDirectory; - i: Integer; -begin - layerDir := ALayers.MemDirectory.FindPath('layers'); - if Assigned(layerDir) then - begin - for i := 0 to ALayers.NbLayers-1 do - layerDir.Rename('layer'+inttostr(i+1), '', inttostr(ALayers.LayerUniqueId[i])); - end; -end; - -procedure RenameLayersToIndex(ALayers: TBGRACustomLayeredBitmap); -var - layerDir: TMemDirectory; - i: Integer; -begin - layerDir := ALayers.MemDirectory.FindPath('layers'); - if Assigned(layerDir) then - begin - for i := 0 to ALayers.NbLayers-1 do - layerDir.Rename(inttostr(ALayers.LayerUniqueId[i]), '', 'layer'+inttostr(i+1)); - end; -end; - -function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean; - ADestination: TBGRALayeredBitmap; AProgress: boolean): TBGRALayeredBitmap; -var - OldPosition: Int64; - HeaderFound: string; - NbLayers, canvasWidth, canvasHeight: LongInt; - HeaderSize, LayerHeaderSize: LongInt; - LayerStackStartPosition, LayerHeaderPosition, - LayerBitmapPosition, LayerEndPosition, MemDirPos: Int64; - StackOption: LongInt; - Layer: TBGRABitmap; - i,LayerIndex: integer; - LayerName: string; - Compression: TLzpCompression; - LayerBlendOp: TBlendOperation; - LayerIdFound: boolean; - h: TLayerHeader; -begin - if Assigned(ADestination) then - begin - result := ADestination; - result.Clear; - end else - result := TBGRALayeredBitmap.Create; - OldPosition:= AStream.Position; - SetLength(HeaderFound, length(StreamHeader)); - try - //format identifier - SetLength(HeaderFound, AStream.Read(HeaderFound[1], length(HeaderFound))); - if HeaderFound <> StreamHeader then - raise exception.Create('Invalid header'); - - //header size - HeaderSize:= LEReadLongint(AStream); - if (HeaderSize < 12) or (HeaderSize > StreamMaxHeaderSize) then - raise exception.Create('Invalid header size'); - LayerStackStartPosition := AStream.Position + HeaderSize; - - NbLayers:= LEReadLongint(AStream); - if (NbLayers < 0) or (NbLayers > StreamMaxLayerCount) then - raise exception.Create('Invalid layer count'); - - ASelectedLayerIndex:= LEReadLongint(AStream); - if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= NbLayers) then - raise exception.Create('Selected layer out of bounds'); - - StackOption := LEReadLongint(AStream); - result.LinearBlend := (StackOption and 1) = 1; - if (StackOption and 2) = 2 then Compression := lzpRLE else Compression:= lzpZStream; - - if headerSize >= 20 then - begin - canvasWidth := LEReadLongint(AStream); - canvasHeight := LEReadLongint(AStream); - result.SetSize(canvasWidth,canvasHeight); - end; - - if headerSize >= 28 then - begin - MemDirPos := LEReadInt64(AStream); - end else MemDirPos := 0; - //end of header - - if MemDirPos <> 0 then - begin - AStream.Position:= MemDirPos+OldPosition; - result.MemDirectory.LoadFromStream(AStream); - end else - result.MemDirectory.Clear; - - AStream.Position:= LayerStackStartPosition; - for i := 0 to NbLayers-1 do - begin - if AProgress then OnLayeredBitmapLoadProgress(round(i*100/NbLayers)); - LayerHeaderSize:= LEReadLongint(AStream); - - LayerHeaderPosition := AStream.Position; - LayerBitmapPosition := LayerHeaderPosition + LayerHeaderSize; - LayerEndPosition := -1; - - fillchar({%H-}h, sizeof(h), 0); - h.LayerOption := 1; //visible - h.BlendOp:= integer(result.DefaultBlendingOperation); - h.LayerOpacity := 65535; //opaque - h.LayerUniqueId:= maxLongint; - h.FixEndian; - - AStream.ReadBuffer(h, min(LayerHeaderSize, sizeof(h))); - h.FixEndian; - - if h.BlendOp > ord(high(TBlendOperation)) then - LayerBlendOp := result.DefaultBlendingOperation - else - LayerBlendOp:= TBlendOperation(h.BlendOp); - - LayerIdFound := h.LayerUniqueId <> maxLongint; - - if h.LayerBitmapSize > 0 then - LayerEndPosition:= LayerBitmapPosition+h.LayerBitmapSize; - - AStream.Position:= LayerBitmapPosition; - Layer := LoadLayerBitmapFromStream(AStream, Compression); - LayerName := Layer.Caption; - LayerIndex := result.AddOwnedLayer(Layer); - Layer := nil; - - result.LayerName[LayerIndex] := LayerName; - result.LayerVisible[LayerIndex] := (h.LayerOption and 1) = 1; - result.BlendOperation[LayerIndex]:= LayerBlendOp; - result.LayerOffset[LayerIndex] := Point(h.LayerOfsX,h.LayerOfsY); - if ALoadLayerUniqueIds and LayerIdFound then - result.LayerUniqueId[LayerIndex] := h.LayerUniqueId; - result.LayerOpacity[LayerIndex] := h.LayerOpacity shr 8; - result.LayerOriginalGuid[LayerIndex] := h.OriginalGuid; - result.LayerOriginalMatrix[LayerIndex] := h.OriginalMatrix; - result.LayerOriginalRenderStatus[layerIndex] := orsProof; - - if LayerEndPosition <> -1 then AStream.Position := LayerEndPosition; - end; - if AProgress then OnLayeredBitmapLoadProgress(100); - - RenameLayersToUniqueId(result); - result.NotifyLoaded; - except - on ex: Exception do - begin - AStream.Position := OldPosition; - if not Assigned(ADestination) then result.Free; - raise ex; - end; - end; -end; - -procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap; - ASelectedLayerIndex: integer; ACompression: TLzpCompression; AProgress: boolean); -var - StackOption: longint; - i: integer; - DirectoryOffsetPos, EndPos: int64; - LayerHeaderPosition: int64; - LayerBitmapPosition,BitmapSize, startPos: int64; - bitmap: TBGRABitmap; - h: TLayerHeader; -begin - if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= ALayers.NbLayers) then - raise exception.Create('Selected layer out of bounds'); - - ALayers.NotifySaving; - - startPos := AStream.Position; - AStream.Write(StreamHeader[1], length(StreamHeader)); - LEWriteLongint(AStream, 28); //header size - LEWriteLongint(AStream, ALayers.NbLayers); - LEWriteLongint(AStream, ASelectedLayerIndex); - StackOption := 0; - if ALayers.LinearBlend then StackOption := StackOption or 1; - if ACompression = lzpRLE then StackOption:= StackOption or 2; - LEWriteLongint(AStream, StackOption); - LEWriteLongint(AStream, ALayers.Width); - LEWriteLongint(AStream, ALayers.Height); - DirectoryOffsetPos := AStream.Position; - LEWriteInt64(AStream, 0); - //end of header - - for i := 0 to ALayers.NbLayers-1 do - begin - if AProgress then OnLayeredBitmapSaveProgress(round(i*100/ALayers.NbLayers)); - LEWriteLongint(AStream, sizeof(h)); - LayerHeaderPosition := AStream.Position; - - bitmap := ALayers.GetLayerBitmapDirectly(i); //do it before to ensure update from original - - h.LayerOption:= 0; - if ALayers.LayerVisible[i] then h.LayerOption:= h.LayerOption or 1; - h.BlendOp:= Longint(ALayers.BlendOperation[i]); - h.LayerOfsX:= ALayers.LayerOffset[i].x; - h.LayerOfsY:= ALayers.LayerOffset[i].y; - h.LayerUniqueId:= ALayers.LayerUniqueId[i]; - h.LayerOpacity:= integer(ALayers.LayerOpacity[i])*$101; - h.LayerBitmapSize := 0; - h.OriginalGuid := ALayers.LayerOriginalGuid[i]; - h.OriginalMatrix := ALayers.LayerOriginalMatrix[i]; - h.FixEndian; - AStream.WriteBuffer(h, sizeof(h)); - //end of layer header - - LayerBitmapPosition:=AStream.Position; - if bitmap <> nil then - SaveLayerBitmapToStream(AStream, bitmap, ALayers.LayerName[i], ACompression) - else - begin - bitmap := ALayers.GetLayerBitmapCopy(i); - SaveLayerBitmapToStream(AStream, bitmap, ALayers.LayerName[i], ACompression); - bitmap.free; - end; - - BitmapSize := AStream.Position - LayerBitmapPosition; - - //store back the bitmap size - AStream.Position:= LayerHeaderPosition + (PByte(@PLayerHeader(nil)^.LayerBitmapSize)-PByte(nil)); - LEWriteInt64(AStream, BitmapSize); - - AStream.Position:= LayerBitmapPosition+BitmapSize; - end; - if AProgress then OnLayeredBitmapSaveProgress(100); - - EndPos:= AStream.Position; - if ALayers.HasMemFiles then - begin - AStream.Position := DirectoryOffsetPos; - LEWriteInt64(AStream,EndPos-startPos); - AStream.Position:= EndPos; - RenameLayersToIndex(ALayers); - ALayers.MemDirectory.SaveToStream(AStream); - RenameLayersToUniqueId(ALayers); - end; -end; - -procedure SaveLayerBitmapToStream(AStream: TStream; ABitmap: TBGRABitmap; ACaption: string; ACompression: TLzpCompression); -var Compressed: TBGRACompressableBitmap; -begin - if ACompression = lzpZStream then - begin - Compressed := TBGRACompressableBitmap.Create(ABitmap); - Compressed.Caption := ACaption; - Compressed.CompressionLevel:= cldefault; - Compressed.WriteToStream(AStream); - Compressed.Free; - end else - TBGRAWriterLazPaint.WriteRLEImage(AStream, ABitmap, ACaption); -end; - -function LoadLayerBitmapFromStream(AStream: TStream; ACompression: TLzpCompression): TBGRABitmap; -var Compressed: TBGRACompressableBitmap; - captionFound: string; -begin - if ACompression = lzpZStream then - begin - Compressed := TBGRACompressableBitmap.Create; - Compressed.ReadFromStream(AStream); - result := Compressed.GetBitmap; - Compressed.Free; - end else - begin - result := TBGRABitmap.Create; - TBGRAReaderLazPaint.LoadRLEImage(AStream, result, captionFound); - result.Caption := captionFound; - end; -end; - -procedure RegisterStreamLayers; -begin - LayeredBitmapSaveToStreamProc := @SaveLayeredBitmapToStream; - LayeredBitmapLoadFromStreamProc := @LoadLayeredBitmapFromStream; - LayeredBitmapCheckStreamProc := @CheckStreamForLayers; -end; - -initialization - - RegisterStreamLayers; - -end. - diff --git a/components/bgrabitmap/bgrasvg.pas b/components/bgrabitmap/bgrasvg.pas deleted file mode 100644 index b427138..0000000 --- a/components/bgrabitmap/bgrasvg.pas +++ /dev/null @@ -1,1330 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASVG; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, DOM, BGRAUnits, BGRASVGShapes, - BGRACanvas2D, BGRASVGType, FPimage; - -{ An SVG file has a width and height which describe the viewport size. It is not however really - the size of the content. The latter is defined as a rectangle called viewbox. There are thus - various ways of drawing an SVG file. If the viewbox is not specified, then it is a rectangle - with origin (0,0) and with the same size as the viewport. In this case, a pixel in the viewbox - corresponds to a pixel in the viewport. Otherwise, viewbox is scaled to fit the viewport. - - ------ Different DPIs ----------------- - - The default DPI of the SVG file is the DPI used to convert between pixel units and other units - like centimeters or inches. In general, this should not be used to scale the image, because it - can make the SVG measures inconsistent. It should rather be set to the DPI which was used - internally and which should be 96 according to CSS specifications. Some programs however - use a different DPI so it can be useful to change it according to the source program. - - The destination DPI that can be specified when drawing can be used to scale the SVG. For example - you can prepare your SVG to be at the correct size for 96 DPI display and then draw them - on a display for which the apparent DPI is different (this can be set systemwide on Windows and - Linux). - - ------ Various ways of scaling -------- - - There are various functions to draw and also to get the presentation matrix. The latter is - a matrix, not including the translation to x and y, that contains all transforms to apply - to the viewbox coordinates. The drawing functions are Draw and StretchDraw and to get the - presentation matrix the functions are GetPresentationMatrix and GetStretchPresentationMatrix - respectively. - - Drawing in user coordinates, i.e. without taking account of the viewbox or viewport size. One - can achieve this by calling the Draw function with an x and y coordinates and a destination - unit/DPI. You would do that only if you want to make use of the viewbox offset or - if you already have applied all necessary transforms. The corresponding presentation matrix - is the identity. - - Drawing with a specific alignment in user coordinates. This can be done by calling Draw - with horizontal and vertical alignment, x and y coordinates to align to, a destination unit/DPI - and Scaled set to False. - - Drawing with a specific alignment, scaled to view port units. This will draw the SVG at its - expected size but apply the alignment you want. This is what you would want to do if you - want to customize the alignment. One can achieve this as above but by specifying the Scaled - parameter to True. - - Drawing inside a specified rectangle, not preserving the aspect ratio. In this case, you - want a certain size and the original size does not matter much. The viewbox of the SVG is - stretched to fit the rectangle. One can achieve this by calling StretchDraw with the - specified rectangle and the UseSvgAspectRatio to False. - - Drawing inside a rectangle, using the parameter of the SVG about the aspect ratio. In this case, - the SVG may either be stretched as before, scaled to fit the rectangle or scaled to cover it. - Also the SVG may be set with a certain horizontal and vertical alignment within the rectangle. - One can draw this way by calling StretchDraw with the UseSvgAspectRatio set to True. - You would typically use this method to show the SVG as it was intended to look like but in - a custom container by suppling WidthAsPixel and HeightAsPixel for the rectangle size. - - Drawing inside a rectangle, preserving the aspect ratio. In this case, you call StretchDraw with - a horizontal and vertical alignment, the rectangle and the Slice parameter. When Slice is set - to False, the viewbox will fit the rectangle. If Slice is to True then the viewbox may overflow - the rectangle so that it covers the whole surface. Using this function, one can have control - over the way the SVG is scaled. Slice is useful for background. - - Drawing inside a rectangle of the size defined by the SVG. That will draw the SVG as it is - supposed to look like. One can do that by calling StretchDraw with a unit parameter. You would - typically use pixel units and this will draw to the size WidthAsPixel by HeightAsPixel. - - } - -type - TCSSUnit = BGRAUnits.TCSSUnit; - -const - cuCustom = BGRAUnits.cuCustom; - cuPixel = BGRAUnits.cuPixel; - cuCentimeter = BGRAUnits.cuCentimeter; - cuMillimeter = BGRAUnits.cuMillimeter; - cuInch = BGRAUnits.cuInch; - cuPica = BGRAUnits.cuPica; - cuPoint = BGRAUnits.cuPoint; - cuFontEmHeight = BGRAUnits.cuFontEmHeight; - cuFontXHeight = BGRAUnits.cuFontXHeight; - cuPercent = BGRAUnits.cuPercent; - -type - - { TSVGUnits } - - TSVGUnits = class(TCSSUnitConverter) - private - FOnRecompute: TSVGRecomputeEvent; - procedure Recompute; - procedure SetOnRecompute(AValue: TSVGRecomputeEvent); - protected - FSvg: TDOMElement; - FContainerHeight: TFloatWithCSSUnit; - FContainerWidth: TFloatWithCSSUnit; - FDefaultDpi: PSingle; - - //fetched or computed - FViewBox: TSVGViewBox; - FPreserveAspectRatio: TSVGPreserveAspectRatio; - FViewPortSize, FProportionalViewSize, FStretchedViewSize: TSVGSize; - - procedure SetContainerHeight(AValue: TFloatWithCSSUnit); - procedure SetContainerWidth(AValue: TFloatWithCSSUnit); - function GetDpiX: single; override; - function GetDpiY: single; override; - function GetCustomOrigin: TPointF; - procedure SetCustomOrigin(AValue: TPointF); - procedure SetViewBox(AValue: TSVGViewBox); - public - procedure SetDefaultDpiAndOrigin; - constructor Create(ASvg: TDOMElement; ADefaultDpi: PSingle); - function GetStretchRectF(AViewPort: TRectF; const par: TSVGPreserveAspectRatio): TRectF; - property ViewBox: TSVGViewBox read FViewBox write SetViewBox; - property ViewPortSize: TSVGSize read FViewPortSize; - property ProportionalViewSize: TSVGSize read FProportionalViewSize; - property PreserveAspectRatio: TSVGPreserveAspectRatio read FPreserveAspectRatio; - property StretchedViewSize: TSVGSize read FStretchedViewSize; - property CustomOrigin: TPointF read GetCustomOrigin write SetCustomOrigin; - property ContainerWidth: TFloatWithCSSUnit read FContainerWidth write SetContainerWidth; - property ContainerHeight: TFloatWithCSSUnit read FContainerHeight write SetContainerHeight; - property OnRecompute: TSVGRecomputeEvent read FOnRecompute write SetOnRecompute; - end; - - { TBGRASVG } - - TBGRASVG = class(TSVGCustomElement) - private - function GetComputedHeight: TFloatWithCSSUnit; - function GetComputedWidth: TFloatWithCSSUnit; - function GetContainerHeight: TFloatWithCSSUnit; - function GetContainerHeightAsPixel: single; - function GetContainerWidth: TFloatWithCSSUnit; - function GetContainerWidthAsPixel: single; - function GetFontSize: TFloatWithCSSUnit; - function GetHeight: TFloatWithCSSUnit; - function GetHeightAsCm: single; - function GetHeightAsInch: single; - function GetHeightAsPixel: single; - function GetLayer(AIndex: integer): TSVGGroup; - function GetLayerCount: integer; - function GetPreserveAspectRatio: TSVGPreserveAspectRatio; - function GetUnits: TSVGUnits; - function GetUTF8String: utf8string; - function GetViewBox: TSVGViewBox; overload; - function GetViewBox(AUnit: TCSSUnit): TSVGViewBox; overload; - procedure GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox); - function GetViewMin(AUnit: TCSSUnit): TPointF; - function GetViewSize(AUnit: TCSSUnit): TPointF; - function GetVisualHeight: TFloatWithCSSUnit; - function GetVisualHeightAsPixel: single; - function GetVisualWidth: TFloatWithCSSUnit; - function GetVisualWidthAsPixel: single; - function GetWidth: TFloatWithCSSUnit; - function GetWidthAsCm: single; - function GetWidthAsInch: single; - function GetWidthAsPixel: single; - function GetZoomable: boolean; - procedure SetContainerHeight(AValue: TFloatWithCSSUnit); - procedure SetContainerHeightAsPixel(AValue: single); - procedure SetContainerWidth(AValue: TFloatWithCSSUnit); - procedure SetContainerWidthAsPixel(AValue: single); - procedure SetDefaultDpi(AValue: single); - procedure SetFontSize(AValue: TFloatWithCSSUnit); - procedure SetHeight(AValue: TFloatWithCSSUnit); - procedure SetHeightAsCm(AValue: single); - procedure SetHeightAsInch(AValue: single); - procedure SetHeightAsPixel(AValue: single); - procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); - procedure SetUTF8String(AValue: utf8string); - procedure SetViewBox(AValue: TSVGViewBox); - procedure SetWidth(AValue: TFloatWithCSSUnit); - procedure SetWidthAsCm(AValue: single); - procedure SetWidthAsInch(AValue: single); - procedure SetWidthAsPixel(AValue: single); - procedure SetZoomable(AValue: boolean); - protected - FXml: TXMLDocument; - FDefaultDpi: single; - FContent: TSVGContent; - FDataLink: TSVGDataLink; - procedure Init(ACreateEmpty: boolean); - function GetViewBoxAlignment(AHorizAlign: TAlignment; AVertAlign: TTextLayout; AUnit: TCSSUnit): TPointF; - function GetViewBoxScale: TPointF; - procedure UnitsRecompute(Sender: TObject); - procedure SetAttribute(AName: string; AValue: string); override; - public - constructor Create; overload; - constructor Create(AWidth,AHeight: single; AUnit: TCSSUnit); overload; - constructor Create(AFilenameUTF8: string); overload; - constructor Create(AStream: TStream); overload; - constructor CreateFromString(AUTF8String: string); - destructor Destroy; override; - function Duplicate: TBGRASVG; - procedure CropToViewBox(AScale: single = 1); - procedure LoadFromFile(AFilenameUTF8: string); - procedure LoadFromStream(AStream: TStream; AURI: UnicodeString = 'stream:'); - procedure LoadFromResource(AFilename: string); - procedure SaveToFile(AFilenameUTF8: string); - procedure SaveToStream(AStream: TStream); - procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit = cuPixel); overload; - procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: single); overload; - procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: TPointF); overload; - procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; AUnit: TCSSUnit = cuPixel; AScale: boolean = true); overload; - procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: single; AScale: boolean = true); overload; - procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: TPointF; AScale: boolean = true); overload; - procedure StretchDraw(ACanvas2d: TBGRACanvas2D; x,y,w,h: single; useSvgAspectRatio: boolean = false); overload; - procedure StretchDraw(ACanvas2d: TBGRACanvas2D; r: TRectF; useSvgAspectRatio: boolean = false); overload; - procedure StretchDraw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); overload; - procedure StretchDraw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; x,y,w,h: single; ASlice: boolean = false); overload; - procedure StretchDraw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; r: TRectF; ASlice: boolean = false); overload; - function GetStretchRectF(AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y,w,h: single; ASlice: boolean = false): TRectF; overload; - function GetStretchRectF(x,y,w,h: single): TRectF; overload; - function GetPresentationMatrix(AHorizAlign: TAlignment; AVertAlign: TTextLayout; - AUnit: TCSSUnit; AScale: boolean): TAffineMatrix; - function GetStretchPresentationMatrix(w,h: single; useSvgAspectRatio: boolean = false): TAffineMatrix; overload; - function GetStretchPresentationMatrix(AHorizAlign: TAlignment; AVertAlign: TTextLayout; w,h: single; ASlice: boolean = false): TAffineMatrix; overload; - function GetStretchPresentationMatrix(AUnit: TCSSUnit): TAffineMatrix; overload; - function FindElementById(AID: string): TSVGElement; overload; - function FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; overload; - procedure ConvertToUnit(AUnit: TCSSUnit); override; //except Width, Height, ContainerWidth, ContainerHeight - property AsUTF8String: utf8string read GetUTF8String write SetUTF8String; - property Units: TSVGUnits read GetUnits; - property FontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize; - property Width: TFloatWithCSSUnit read GetWidth write SetWidth; - property Height: TFloatWithCSSUnit read GetHeight write SetHeight; - property ComputedWidth: TFloatWithCSSUnit read GetComputedWidth; - property ComputedHeight: TFloatWithCSSUnit read GetComputedHeight; - property WidthAsPixel: single read GetWidthAsPixel write SetWidthAsPixel; - property HeightAsPixel: single read GetHeightAsPixel write SetHeightAsPixel; - property WidthAsCm: single read GetWidthAsCm write SetWidthAsCm; - property HeightAsCm: single read GetHeightAsCm write SetHeightAsCm; - property WidthAsInch: single read GetWidthAsInch write SetWidthAsInch; - property HeightAsInch: single read GetHeightAsInch write SetHeightAsInch; - property ContainerWidth: TFloatWithCSSUnit read GetContainerWidth write SetContainerWidth; - property ContainerWidthAsPixel: single read GetContainerWidthAsPixel write SetContainerWidthAsPixel; - property ContainerHeight: TFloatWithCSSUnit read GetContainerHeight write SetContainerHeight; - property ContainerHeightAsPixel: single read GetContainerHeightAsPixel write SetContainerHeightAsPixel; - property Zoomable: boolean read GetZoomable write SetZoomable; - property ViewBox: TSVGViewBox read GetViewBox write SetViewBox; - property ViewBoxInUnit[AUnit: TCSSUnit]: TSVGViewBox read GetViewBox; - property ViewMinInUnit[AUnit: TCSSUnit]: TPointF read GetViewMin; - property ViewSizeInUnit[AUnit: TCSSUnit]: TPointF read GetViewSize; - property VisualWidth: TFloatWithCSSUnit read GetVisualWidth; - property VisualHeight: TFloatWithCSSUnit read GetVisualHeight; - property VisualWidthAsPixel: single read GetVisualWidthAsPixel; - property VisualHeightAsPixel: single read GetVisualHeightAsPixel; - property Attribute[AName: string]: string read GetAttribute write SetAttribute; - property AttributeDef[AName: string; ADefault: string]: string read GetAttribute; - property DefaultDpi: single read FDefaultDpi write SetDefaultDpi; //this is not saved in the SVG file - property Content: TSVGContent read FContent; - property DataLink: TSVGDataLink read FDataLink;//(for test or internal info) - property preserveAspectRatio: TSVGPreserveAspectRatio read GetPreserveAspectRatio write SetPreserveAspectRatio; - property Layer[AIndex: integer]: TSVGGroup read GetLayer; - property LayerCount: integer read GetLayerCount; - end; - - { TFPReaderSVG } - - TFPReaderSVG = class(TBGRAImageReader) - private - FRenderDpi: single; - FWidth,FHeight: integer; - FScale: single; - protected - function InternalCheck(Stream: TStream): boolean; override; - procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override; - public - constructor Create; override; - function GetQuickInfo(AStream: TStream): TQuickImageInfo; override; - function GetBitmapDraft(AStream: TStream; AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override; - property RenderDpi: single read FRenderDpi write FRenderDpi; - property Width: integer read FWidth; - property Height: integer read FHeight; - property Scale: single read FScale write FScale; - end; - -procedure RegisterSvgFormat; - -implementation - -uses XMLRead, XMLWrite, BGRAUTF8, math, xmltextreader, URIParser, BGRATransform; - -const SvgNamespace = 'http://www.w3.org/2000/svg'; - -{ TFPReaderSVG } - -function TFPReaderSVG.InternalCheck(Stream: TStream): boolean; -var - magic: array[1..6] of char; - prevPos: int64; - count: LongInt; -begin - prevPos := Stream.Position; - count := Stream.Read({%H-}magic, sizeof(magic)); - Stream.Position:= prevPos; - result:= (count = sizeof(magic)) and ((magic = 'Img then - begin - Img.SetSize(bgra.Width,bgra.Height); - for y := 0 to bgra.Height-1 do - begin - p := bgra.ScanLine[y]; - for x := 0 to bgra.Width-1 do - begin - Img.Colors[x,y] := BGRAToFPColor(p^); - inc(p); - end; - end; - end; - FWidth:= bgra.Width; - FHeight:= bgra.Height; - finally - if bgra<>Img then bgra.Free; - svg.Free; - end; -end; - -constructor TFPReaderSVG.Create; -begin - inherited Create; - FRenderDpi:= 96; - FScale := 1; -end; - -function TFPReaderSVG.GetQuickInfo(AStream: TStream): TQuickImageInfo; -var - svg: TBGRASVG; - vsize: TPointF; -begin - svg := TBGRASVG.Create(AStream); - svg.DefaultDpi:= RenderDpi; - vsize := svg.GetViewSize(cuPixel); - svg.Free; - result.Width:= ceil(vsize.x); - result.Height:= ceil(vsize.y); - result.AlphaDepth:= 8; - result.ColorDepth:= 24; -end; - -function TFPReaderSVG.GetBitmapDraft(AStream: TStream; AMaxWidth, - AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap; -var - svg: TBGRASVG; - vsize: TPointF; - c2d: TBGRACanvas2D; - ratio: Single; -begin - svg := TBGRASVG.Create(AStream); - result := nil; - try - svg.DefaultDpi:= RenderDpi; - if svg.preserveAspectRatio.Preserve then - vsize := svg.GetViewSize(cuPixel) - else vsize := PointF(svg.WidthAsPixel, svg.HeightAsPixel); - AOriginalWidth:= ceil(vsize.x); - AOriginalHeight:= ceil(vsize.y); - if (vsize.x = 0) or (vsize.y = 0) then exit; - ratio := min(AMaxWidth/vsize.x, AMaxHeight/vsize.y); - result := BGRABitmapFactory.Create(ceil(vsize.x*ratio),ceil(vsize.y*ratio)); - if ratio <> 0 then - begin - c2d := TBGRACanvas2D.Create(result); - svg.StretchDraw(c2d, 0,0,result.width,result.height); - c2d.Free; - end; - finally - svg.Free; - end; -end; - -var AlreadyRegistered: boolean; - -procedure RegisterSvgFormat; -begin - if AlreadyRegistered then exit; - ImageHandlers.RegisterImageReader ('Scalable Vector Graphic', 'svg', TFPReaderSVG); - AlreadyRegistered:= True; -end; - -function TSVGUnits.GetCustomOrigin: TPointF; -begin - result := FViewBox.min; -end; - -procedure TSVGUnits.SetCustomOrigin(AValue: TPointF); -var newViewBox: TSVGViewBox; -begin - newViewBox := ViewBox; - newViewBox.min := AValue; - ViewBox := newViewBox; -end; - -procedure TSVGUnits.Recompute; -begin - FViewBox:= TSVGViewBox.Parse( FSvg.GetAttribute('viewBox') ); - FPreserveAspectRatio := TSVGPreserveAspectRatio.Parse( FSvg.GetAttribute('preserveAspectRatio') ); - FViewPortSize.width := parseValue(FSvg.GetAttribute('width'), FloatWithCSSUnit(FViewBox.size.x, cuPixel)); - FViewPortSize.height := parseValue(FSvg.GetAttribute('height'), FloatWithCSSUnit(FViewBox.size.y, cuPixel)); - - //view port defined as percentage of container - if FViewPortSize.width.CSSUnit = cuPercent then - begin - FViewPortSize.width.value := FViewPortSize.width.value/100*FContainerWidth.value; - FViewPortSize.width.CSSUnit := FContainerWidth.CSSUnit; - end; - if FViewPortSize.height.CSSUnit = cuPercent then - begin - FViewPortSize.height.value := FViewPortSize.height.value/100*FContainerHeight.value; - FViewPortSize.height.CSSUnit := FContainerHeight.CSSUnit; - end; - - //ensure same unit for width and height - if FViewPortSize.width.CSSUnit <> FViewPortSize.height.CSSUnit then - FViewPortSize.height := ConvertHeight(FViewPortSize.height, FViewPortSize.width.CSSUnit, 0); - - //if not viewbox is specified, it is equal to the viewport - if (FViewBox.size.x <= 0) and (FViewBox.size.y <= 0) then - begin - FViewBox.min := PointF(0, 0); - FViewBox.size.x := ConvertWidth(FViewPortSize.width, cuPixel, 0).value; - FViewBox.size.y := ConvertHeight(FViewPortSize.height, cuPixel, 0).value; - end; - - //compute stretching for default SVG aspect ratio (meet) - FProportionalViewSize := FViewPortSize; - with GetStretchRectF(RectF(0,0,FViewPortSize.width.value,FViewPortSize.height.value), - TSVGPreserveAspectRatio.DefaultValue) do - begin - FProportionalViewSize.width.value := Width; - FProportionalViewSize.height.value := Height; - end; - - //compute stretching according to specified SVG aspect ratio (can be slice or none) - FStretchedViewSize := FViewPortSize; - with GetStretchRectF(RectF(0,0,FViewPortSize.width.value,FViewPortSize.height.value), - PreserveAspectRatio) do - begin - FStretchedViewSize.width.value := Width; - FStretchedViewSize.height.value := Height; - end; - - ViewBoxWidth := FloatWithCSSUnit(FViewBox.size.x, cuPixel); - ViewBoxHeight := FloatWithCSSUnit(FViewBox.size.y, cuPixel); - - if Assigned(FOnRecompute) then FOnRecompute(self); -end; - -procedure TSVGUnits.SetOnRecompute(AValue: TSVGRecomputeEvent); -begin - if FOnRecompute=AValue then Exit; - FOnRecompute:=AValue; -end; - -procedure TSVGUnits.SetContainerHeight(AValue: TFloatWithCSSUnit); -begin - if CompareMem(@FContainerHeight,@AValue,sizeof(TFloatWithCSSUnit)) then Exit; - FContainerHeight:=AValue; - Recompute; -end; - -procedure TSVGUnits.SetContainerWidth(AValue: TFloatWithCSSUnit); -begin - if CompareMem(@FContainerWidth,@AValue,sizeof(TFloatWithCSSUnit)) then Exit; - FContainerWidth:=AValue; - Recompute; -end; - -procedure TSVGUnits.SetDefaultDpiAndOrigin; -begin - FSvg.RemoveAttribute('viewBox'); - Recompute; -end; - -procedure TSVGUnits.SetViewBox(AValue: TSVGViewBox); -begin - FSvg.SetAttribute('viewBox', formatValue(AValue.min.x)+' '+ - formatValue(AValue.min.y)+' '+ - formatValue(AValue.size.x)+' '+ - formatValue(AValue.size.y)); - Recompute; -end; - -function TSVGUnits.GetDpiX: single; -begin - result := FDefaultDpi^; -end; - -function TSVGUnits.GetDpiY: single; -begin - result := FDefaultDpi^; -end; - -constructor TSVGUnits.Create(ASvg: TDOMElement; ADefaultDpi: PSingle); -begin - FSvg := ASvg; - FDefaultDpi := ADefaultDpi; - FContainerWidth := FloatWithCSSUnit(640,cuPixel); - FContainerHeight := FloatWithCSSUnit(480,cuPixel); - Recompute; -end; - -function TSVGUnits.GetStretchRectF(AViewPort: TRectF; const par: TSVGPreserveAspectRatio): TRectF; -var w0,h0,w,h: single; -begin - result := AViewPort; - w0 := AViewPort.Width; - h0 := AViewPort.Height; - - if par.Preserve and - (FViewBox.size.x > 0) and (FViewBox.size.y > 0) and - (w0 > 0) and (h0 > 0) then - begin - w := w0; - h := h0; - - //viewBox wider than viewSize - if (FViewBox.size.x/FViewBox.size.y > w/h) xor par.Slice then - begin - h := w * FViewBox.size.y / FViewBox.size.x; - result.Bottom := result.Top+h; - end else - begin - w := h * FViewBox.size.x / FViewBox.size.y; - result.Right := result.Left+w; - end; - case par.HorizAlign of - taCenter: result.Offset((w0-w)/2, 0); - taRightJustify: result.Offset(w0-w, 0); - end; - case par.VertAlign of - tlCenter: result.Offset(0, (h0-h)/2); - tlBottom: result.Offset(0, h0-h); - end; - end; -end; - -{ TBGRASVG } - -function TBGRASVG.GetComputedHeight: TFloatWithCSSUnit; -begin - result := Units.ViewPortSize.height; -end; - -function TBGRASVG.GetComputedWidth: TFloatWithCSSUnit; -begin - result := Units.ViewPortSize.width; -end; - -function TBGRASVG.GetVisualHeight: TFloatWithCSSUnit; -begin - result := Units.StretchedViewSize.height; -end; - -function TBGRASVG.GetVisualHeightAsPixel: single; -begin - result := Units.ConvertHeight(VisualHeight, cuPixel).value; -end; - -function TBGRASVG.GetVisualWidth: TFloatWithCSSUnit; -begin - result := Units.StretchedViewSize.width; -end; - -function TBGRASVG.GetContainerHeight: TFloatWithCSSUnit; -begin - result := Units.ContainerHeight; -end; - -function TBGRASVG.GetContainerHeightAsPixel: single; -begin - result := Units.ConvertHeight(Units.ContainerHeight, cuPixel).value; -end; - -function TBGRASVG.GetContainerWidth: TFloatWithCSSUnit; -begin - result := Units.ContainerWidth; -end; - -function TBGRASVG.GetContainerWidthAsPixel: single; -begin - result := Units.ConvertWidth(Units.ContainerWidth, cuPixel).value; -end; - -function TBGRASVG.GetFontSize: TFloatWithCSSUnit; -begin - result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false); -end; - -function TBGRASVG.GetHeight: TFloatWithCSSUnit; -begin - result := TCSSUnitConverter.parseValue(Attribute['height'],FloatWithCSSUnit(Units.ViewBox.size.y,cuCustom)); - if result.CSSUnit = cuCustom then result.CSSUnit:= cuPixel; -end; - -function TBGRASVG.GetHeightAsCm: single; -begin - result := FUnits.ConvertHeight(ComputedHeight,cuCentimeter).value; -end; - -function TBGRASVG.GetHeightAsInch: single; -begin - result := FUnits.ConvertHeight(ComputedHeight,cuInch).value; -end; - -function TBGRASVG.GetHeightAsPixel: single; -begin - result := FUnits.ConvertHeight(ComputedHeight,cuPixel).value; -end; - -function TBGRASVG.GetLayer(AIndex: integer): TSVGGroup; -var - i: Integer; -begin - result := nil; - for i := 0 to Content.ElementCount-1 do - begin - if (Content.ElementObject[i] is TSVGGroup) and - TSVGGroup(Content.Element[i]).IsLayer then - begin - if AIndex = 0 then exit(TSVGGroup(Content.Element[i])); - dec(AIndex); - end; - end; -end; - -function TBGRASVG.GetLayerCount: integer; -var - i: Integer; -begin - result := 0; - for i := 0 to Content.ElementCount-1 do - begin - if (Content.ElementObject[i] is TSVGGroup) and - TSVGGroup(Content.Element[i]).IsLayer then - inc(result); - end; -end; - -function TBGRASVG.GetPreserveAspectRatio: TSVGPreserveAspectRatio; -begin - result := Units.PreserveAspectRatio; -end; - -function TBGRASVG.GetStretchPresentationMatrix(AHorizAlign: TAlignment; - AVertAlign: TTextLayout; w, h: single; ASlice: boolean): TAffineMatrix; -var - rF: TRectF; -begin - with GetViewBoxAlignment(taLeftJustify, tlTop, cuPixel) do - result := AffineMatrixTranslation(x, y); - rF := GetStretchRectF(AHorizAlign, AVertAlign, 0, 0, w, h, ASlice); - with Units.ViewBox do - begin - if size.x > 0 then result := AffineMatrixScale(rF.Width/size.x, 1) * result; - if size.y > 0 then result := AffineMatrixScale(1, rF.Height/size.y) * result; - end; - result := AffineMatrixTranslation(rF.Left, rF.Top) * result; -end; - -function TBGRASVG.GetStretchPresentationMatrix(AUnit: TCSSUnit): TAffineMatrix; -var - w, h: TFloatWithCSSUnit; -begin - w := ComputedWidth; - h := ComputedHeight; - result := GetStretchPresentationMatrix(Units.ConvertWidth(w, AUnit).value, - Units.ConvertHeight(h, AUnit).value, true); -end; - -function TBGRASVG.GetUnits: TSVGUnits; -begin - result := TSVGUnits(FUnits); -end; - -function TBGRASVG.GetUTF8String: utf8string; -var str: TMemoryStream; -begin - str := TMemoryStream.Create; - SaveToStream(str); - setlength(result, str.Size); - str.Position := 0; - str.Read(result[1], length(result)); - str.Free; -end; - -function TBGRASVG.GetViewBox: TSVGViewBox; -begin - result := Units.ViewBox; -end; - -function TBGRASVG.GetViewBox(AUnit: TCSSUnit): TSVGViewBox; -begin - GetViewBoxIndirect(AUnit,result); -end; - -procedure TBGRASVG.GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox); -begin - with Units.ViewBox do - begin - AViewBox.min := FUnits.ConvertCoord(min,cuCustom,AUnit); - AViewBox.size := FUnits.ConvertCoord(size,cuCustom,AUnit); - end; -end; - -function TBGRASVG.GetViewMin(AUnit: TCSSUnit): TPointF; -var - vb: TSVGViewBox; -begin - GetViewBoxIndirect(AUnit,vb); - result:= vb.min; -end; - -function TBGRASVG.GetViewSize(AUnit: TCSSUnit): TPointF; -var - vb: TSVGViewBox; -begin - GetViewBoxIndirect(AUnit,vb); - result:= vb.size; -end; - -function TBGRASVG.GetVisualWidthAsPixel: single; -begin - result := Units.ConvertWidth(VisualWidth, cuPixel).value; -end; - -function TBGRASVG.GetWidth: TFloatWithCSSUnit; -begin - result := TCSSUnitConverter.parseValue(Attribute['width'],FloatWithCSSUnit(Units.ViewBox.size.x,cuCustom)); - if result.CSSUnit = cuCustom then result.CSSUnit := cuPixel; -end; - -function TBGRASVG.GetWidthAsCm: single; -begin - result := FUnits.ConvertWidth(ComputedWidth,cuCentimeter).value; -end; - -function TBGRASVG.GetWidthAsInch: single; -begin - result := FUnits.ConvertWidth(ComputedWidth,cuInch).value; -end; - -function TBGRASVG.GetWidthAsPixel: single; -begin - result := FUnits.ConvertWidth(ComputedWidth,cuPixel).value; -end; - -function TBGRASVG.GetZoomable: boolean; -begin - result := AttributeDef['zoomAndPan','magnify']<>'disable'; -end; - -procedure TBGRASVG.SetContainerHeight(AValue: TFloatWithCSSUnit); -begin - if AValue.CSSUnit = cuPercent then raise exception.Create('Container width cannot be expressed as percentage'); - Units.ContainerHeight := AValue; -end; - -procedure TBGRASVG.SetContainerHeightAsPixel(AValue: single); -begin - ContainerHeight := FloatWithCSSUnit(AValue, cuPixel); -end; - -procedure TBGRASVG.SetContainerWidth(AValue: TFloatWithCSSUnit); -begin - if AValue.CSSUnit = cuPercent then raise exception.Create('Container width cannot be expressed as percentage'); - Units.ContainerWidth := AValue; -end; - -procedure TBGRASVG.SetContainerWidthAsPixel(AValue: single); -begin - ContainerWidth := FloatWithCSSUnit(AValue, cuPixel); -end; - -procedure TBGRASVG.SetAttribute(AName: string; AValue: string); -begin - AName := trim(AName); - if compareText(AName,'viewBox')= 0 then AName := 'viewBox' else - if compareText(AName,'width')=0 then AName := 'width' else - if compareText(AName,'height')=0 then AName := 'height'; - inherited SetAttribute(AName,AValue); - if (AName = 'viewBox') or (AName = 'width') or (AName = 'height') then - Units.Recompute; -end; - -procedure TBGRASVG.SetDefaultDpi(AValue: single); -begin - if FDefaultDpi=AValue then Exit; - FDefaultDpi:=AValue; - Units.Recompute; -end; - -procedure TBGRASVG.SetFontSize(AValue: TFloatWithCSSUnit); -begin - SetVerticalAttributeWithUnit('font-size', AValue); -end; - -procedure TBGRASVG.SetHeight(AValue: TFloatWithCSSUnit); -begin - if AValue.CSSUnit = cuPixel then AValue.CSSUnit := cuCustom; - Attribute['height'] := TCSSUnitConverter.formatValue(AValue); - Units.Recompute; -end; - -procedure TBGRASVG.SetHeightAsCm(AValue: single); -begin - Height := FloatWithCSSUnit(AValue,cuCentimeter); -end; - -procedure TBGRASVG.SetHeightAsInch(AValue: single); -begin - Height := FloatWithCSSUnit(AValue,cuInch); -end; - -procedure TBGRASVG.SetHeightAsPixel(AValue: single); -begin - Height := FloatWithCSSUnit(AValue,cuPixel); -end; - -procedure TBGRASVG.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); -begin - Attribute['preserveAspectRatio'] := AValue.ToString; - Units.Recompute; -end; - -procedure TBGRASVG.SetUTF8String(AValue: utf8string); -var str: TMemoryStream; -begin - str:= TMemoryStream.Create; - str.Write(AValue[1],length(AValue)); - str.Position:= 0; - LoadFromStream(str); - str.Free; -end; - -{$PUSH}{$OPTIMIZATION OFF} //avoids Internal error 2012090607 -procedure TBGRASVG.SetViewBox(AValue: TSVGViewBox); -begin - Units.ViewBox := AValue; -end; -{$POP} - -procedure TBGRASVG.SetWidth(AValue: TFloatWithCSSUnit); -begin - if AValue.CSSUnit = cuPixel then AValue.CSSUnit := cuCustom; - Attribute['width'] := TCSSUnitConverter.formatValue(AValue); - Units.Recompute; -end; - -procedure TBGRASVG.SetWidthAsCm(AValue: single); -begin - Width := FloatWithCSSUnit(AValue,cuCentimeter); -end; - -procedure TBGRASVG.SetWidthAsInch(AValue: single); -begin - Width := FloatWithCSSUnit(AValue,cuInch); -end; - -procedure TBGRASVG.SetWidthAsPixel(AValue: single); -begin - Width := FloatWithCSSUnit(AValue,cuPixel); -end; - -procedure TBGRASVG.SetZoomable(AValue: boolean); -begin - if AValue then - Attribute['zoomAndPan'] := 'magnify' - else - Attribute['zoomAndPan'] := 'disable'; -end; - -procedure TBGRASVG.Init(ACreateEmpty: boolean); -begin - FDefaultDpi := 96; //web browser default - if ACreateEmpty then - begin - FXml := TXMLDocument.Create; - FDomElem := FXml.CreateElement('svg'); - FUnits := TSVGUnits.Create(FDomElem,@FDefaultDpi); - Units.OnRecompute:= @UnitsRecompute; - FDataLink := TSVGDataLink.Create(nil); - FContent := TSVGContent.Create(FDomElem,FUnits,FDataLink); - FXml.AppendChild(FDomElem); - end; -end; - -function TBGRASVG.GetViewBoxAlignment(AHorizAlign: TAlignment; - AVertAlign: TTextLayout; AUnit: TCSSUnit): TPointF; -var vb: TSVGViewBox; -begin - GetViewBoxIndirect(AUnit, vb); - with vb do - begin - case AHorizAlign of - taCenter: result.x := -(min.x+size.x*0.5); - taRightJustify: result.x := -(min.x+size.x); - else - {taLeftJustify:} result.x := -min.x; - end; - case AVertAlign of - tlCenter: result.y := -(min.y+size.y*0.5); - tlBottom: result.y := -(min.y+size.y); - else - {tlTop:} result.y := -min.y; - end; - end; -end; - -function TBGRASVG.GetViewBoxScale: TPointF; -var - svs: TSVGSize; - vb: TSVGViewBox; -begin - svs := Units.StretchedViewSize; - vb := ViewBox; - if vb.size.x <> 0 then - result.x := Units.ConvertWidth(svs.width, cuPixel).value / vb.size.x - else result.x := 1; - if vb.size.y <> 0 then - result.y := Units.ConvertHeight(svs.Height, cuPixel).value / vb.size.y - else result.y := 1; -end; - -procedure TBGRASVG.UnitsRecompute(Sender: TObject); -begin - FContent.Recompute; -end; - -constructor TBGRASVG.Create; -begin - Init(True); -end; - -constructor TBGRASVG.Create(AWidth, AHeight: single; AUnit: TCSSUnit); -begin - Init(True); - Width := FloatWithCSSUnit(AWidth,AUnit); - Height := FloatWithCSSUnit(AHeight,AUnit); -end; - -constructor TBGRASVG.Create(AFilenameUTF8: string); -begin - Init(False); - LoadFromFile(AFilenameUTF8); -end; - -constructor TBGRASVG.Create(AStream: TStream); -begin - Init(False); - LoadFromStream(AStream); -end; - -constructor TBGRASVG.CreateFromString(AUTF8String: string); -begin - Init(False); - AsUTF8String:= AUTF8String; -end; - -destructor TBGRASVG.Destroy; -begin - FreeAndNil(FContent); - FreeAndNil(FDataLink); - FreeAndNil(FUnits); - FDomElem:= nil; - FreeAndNil(FXml); - inherited Destroy; -end; - -function TBGRASVG.Duplicate: TBGRASVG; -var - stream: TMemoryStream; - svg: TBGRASVG; -begin - stream := TMemoryStream.Create; - svg := nil; - try - SaveToStream(stream); - stream.Position:= 0; - svg := TBGRASVG.Create; - svg.DefaultDpi:= DefaultDpi; - svg.LoadFromStream(stream); - result := svg; - svg := nil; - finally - svg.Free; - stream.Free - end; -end; - -procedure TBGRASVG.CropToViewBox(AScale: single); -var w,h: single; -begin - w:= VisualWidthAsPixel * AScale; - h:= VisualHeightAsPixel * AScale; - ViewBox := Units.ViewBox; // make sure viewbox is explicit - WidthAsPixel:= w; - HeightAsPixel:= h; -end; - -procedure TBGRASVG.LoadFromFile(AFilenameUTF8: string); -var stream: TStream; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(stream, UTF8ToUTF16(FilenameToURI(AFilenameUTF8))); - finally - stream.Free; - end; -end; - -procedure TBGRASVG.LoadFromStream(AStream: TStream; AURI: UnicodeString); -var xml: TXMLDocument; - root: TDOMNode; - byteOrderMark: packed array[1..3] of byte; - startPos: int64; - parser: TDOMParser; - source: TXMLInputSource; -begin - //skip utf8 byte order mark - startPos:= AStream.Position; - if AStream.Read({%H-}byteOrderMark,sizeof(byteOrderMark)) = 3 then - begin - if (byteOrderMark[1] = $ef) and (byteOrderMark[2] = $bb) and (byteOrderMark[3] = $bf) then - inc(startPos, 3); - end; - AStream.Position:= startPos; - source := TXMLInputSource.Create(AStream); - source.BaseURI:= AURI; - parser := TDOMParser.Create; - parser.Options.PreserveWhitespace:= true; - try - parser.Parse(source, xml); - finally - parser.Free; - source.Free; - end; - root := xml.FirstChild; - while (root <> nil) and not (root is TDOMElement) do root := root.NextSibling; - if root = nil then - begin - xml.Free; - raise exception.Create('Root node not found'); - end; - FreeAndNil(FContent); - FreeAndNil(FDataLink); - FreeAndNil(FUnits); - FreeAndNil(FXml); - FXml := xml; - FDomElem := root as TDOMElement; - FUnits := TSVGUnits.Create(FDomElem,@FDefaultDpi); - Units.OnRecompute:= @UnitsRecompute; - FDataLink := TSVGDataLink.Create(nil); - FContent := TSVGContent.Create(FDomElem,FUnits,FDataLink); -end; - -procedure TBGRASVG.LoadFromResource(AFilename: string); -var - stream: TStream; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - LoadFromStream(stream); - finally - stream.Free; - end; -end; - -procedure TBGRASVG.SaveToFile(AFilenameUTF8: string); -var stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate); - try - SaveToStream(stream); - finally - stream.free; - end; -end; - -procedure TBGRASVG.SaveToStream(AStream: TStream); -begin - if Attribute['xmlns'] = '' then Attribute['xmlns'] := SvgNamespace; - if (NamespaceURI['xlink'] = '') and NeedNamespace('xlink') then - NamespaceURI['xlink'] := 'http://www.w3.org/1999/xlink'; - WriteXMLFile(FXml, AStream); -end; - -procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; x, y: single; AUnit: TCSSUnit; AScale: boolean); -var prevMatrix: TAffineMatrix; -begin - prevMatrix := ACanvas2d.matrix; - ACanvas2d.translate(x,y); - if AScale then - with GetViewBoxScale do ACanvas2d.scale(x, y); - with GetViewBoxAlignment(AHorizAlign,AVertAlign,cuPixel) do ACanvas2d.translate(x,y); - Draw(ACanvas2d, 0,0, AUnit); - ACanvas2d.matrix := prevMatrix; -end; - -procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; x, y: single; destDpi: single; AScale: boolean); -begin - Draw(ACanvas2d, AHorizAlign,AVertAlign, x,y, PointF(destDpi,destDpi), AScale); -end; - -procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; x, y: single; destDpi: TPointF; AScale: boolean); -begin - ACanvas2d.save; - ACanvas2d.translate(x,y); - ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY); - if AScale then - with GetViewBoxScale do ACanvas2d.scale(x, y); - with GetViewBoxAlignment(AHorizAlign,AVertAlign, cuPixel) do ACanvas2d.translate(x,y); - Draw(ACanvas2d, 0,0, cuPixel); - ACanvas2d.restore; -end; - -procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); -var prevLinearBlend: boolean; - prevFontSize: TFloatWithCSSUnit; -begin - prevLinearBlend:= ACanvas2d.linearBlend; - acanvas2d.linearBlend := true; - ACanvas2d.save; - ACanvas2d.translate(x,y); - ACanvas2d.strokeMatrix := ACanvas2d.matrix; - prevFontSize := EnterFontSize(true); - Content.Draw(ACanvas2d,AUnit); - ExitFontSize(prevFontSize); - ACanvas2d.restore; - ACanvas2d.linearBlend := prevLinearBlend; -end; - -procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: single); -begin - Draw(ACanvas2d, x,y, PointF(destDpi,destDpi)); -end; - -procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: TPointF); -begin - ACanvas2d.save; - ACanvas2d.translate(x,y); - ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY); - Draw(ACanvas2d, 0,0, cuPixel); - ACanvas2d.restore; -end; - -procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y, w, h: single; useSvgAspectRatio: boolean); -var vb: TSVGViewBox; -begin - if useSvgAspectRatio then - begin - with preserveAspectRatio do - StretchDraw(ACanvas2d, HorizAlign, VertAlign, x,y,w,h, Slice); - exit; - end; - ACanvas2d.save; - ACanvas2d.translate(x,y); - ACanvas2d.strokeResetTransform; - GetViewBoxIndirect(cuPixel,vb); - with vb do - begin - ACanvas2d.translate(-min.x,-min.y); - if size.x <> 0 then - ACanvas2d.scale(w/size.x,1); - if size.y <> 0 then - ACanvas2d.scale(1,h/size.y); - end; - Draw(ACanvas2d, 0,0, cuPixel); - ACanvas2d.restore; -end; - -procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; r: TRectF; useSvgAspectRatio: boolean); -begin - StretchDraw(ACanvas2d, r.Left, r.Top, r.Width, r.Height, useSvgAspectRatio); -end; - -procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); -var - w, h: TFloatWithCSSUnit; -begin - w := ComputedWidth; - h := ComputedHeight; - StretchDraw(ACanvas2d, x, y, Units.ConvertWidth(w, AUnit).value, - Units.ConvertHeight(h, AUnit).value, true); -end; - -procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; x, y, w, h: single; - ASlice: boolean); -var r: TRectF; -begin - r := GetStretchRectF(AHorizAlign,AVertAlign, x, y, w, h, ASlice); - StretchDraw(ACanvas2d, r); -end; - -procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; r: TRectF; ASlice: boolean); -begin - StretchDraw(ACanvas2d, AHorizAlign, AVertAlign, r.Left, r.Top, r.Width, r.Height, ASlice); -end; - -function TBGRASVG.GetStretchRectF(x,y,w,h: single): TRectF; -begin - result := Units.GetStretchRectF(RectWithSizeF(x,y,w,h), preserveAspectRatio); -end; - -function TBGRASVG.GetPresentationMatrix(AHorizAlign: TAlignment; - AVertAlign: TTextLayout; AUnit: TCSSUnit; AScale: boolean): TAffineMatrix; -begin - with GetViewBoxAlignment(AHorizAlign, AVertAlign, AUnit) do - result := AffineMatrixTranslation(x, y); - if AScale then - with GetViewBoxScale do - result := AffineMatrixScale(x, y) * result; -end; - -function TBGRASVG.GetStretchPresentationMatrix(w, h: single; - useSvgAspectRatio: boolean): TAffineMatrix; -var - rF: TRectF; -begin - if not useSvgAspectRatio then - begin - with GetViewBoxAlignment(taLeftJustify, tlTop, cuPixel) do - result := AffineMatrixTranslation(x, y); - with Units.ViewBox do - begin - if size.x > 0 then result := AffineMatrixScale(w/size.x, 1) * result; - if size.y > 0 then result := AffineMatrixScale(1, h/size.y) * result; - end; - end else - begin - with GetViewBoxAlignment(taLeftJustify, tlTop, cuPixel) do - result := AffineMatrixTranslation(x, y); - rF := GetStretchRectF(0,0,w,h); - with Units.ViewBox do - begin - if size.x > 0 then result := AffineMatrixScale(rF.Width/size.x, 1) * result; - if size.y > 0 then result := AffineMatrixScale(1, rF.Height/size.y) * result; - end; - result := AffineMatrixTranslation(rF.Left, rF.Top) * result; - end; -end; - -function TBGRASVG.GetStretchRectF(AHorizAlign: TAlignment; - AVertAlign: TTextLayout; x, y, w, h: single; ASlice: boolean): TRectF; -var - aspect: TSVGPreserveAspectRatio; -begin - aspect.HorizAlign:= AHorizAlign; - aspect.VertAlign:= AVertAlign; - aspect.Preserve:= true; - aspect.Slice:= ASlice; - result := Units.GetStretchRectF(RectWithSizeF(x, y, w, h), aspect); -end; - -function TBGRASVG.FindElementById(AID: string): TSVGElement; -begin - result := DataLink.FindElementById(AId, TSVGElement); -end; - -function TBGRASVG.FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; -begin - result := DataLink.FindElementById(AId, AClass); -end; - -procedure TBGRASVG.ConvertToUnit(AUnit: TCSSUnit); -var - prevFontSize: TFloatWithCSSUnit; -begin - prevFontSize := Units.CurrentFontEmHeight; - Units.CurrentFontEmHeight := Units.RootFontEmHeight; - if HasAttribute('font-size') then - SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit)); - Units.CurrentFontEmHeight := prevFontSize; - - prevFontSize := EnterFontSize(true); - inherited ConvertToUnit(AUnit); - Content.ConvertToUnit(AUnit); - ExitFontSize(prevFontSize); -end; - -initialization - - DefaultBGRAImageReader[ifSvg] := TFPReaderSVG; - -end. - diff --git a/components/bgrabitmap/bgrasvgoriginal.pas b/components/bgrabitmap/bgrasvgoriginal.pas deleted file mode 100644 index e7774e3..0000000 --- a/components/bgrabitmap/bgrasvgoriginal.pas +++ /dev/null @@ -1,702 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASVGOriginal; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, BGRASVG, BGRATransform, - BGRALayerOriginal, BGRAUnits, BGRALayers; - -type - TBGRALayerSVGOriginal = class; - - { TBGRASVGOriginalDiff } - - TBGRASVGOriginalDiff = class(TBGRAOriginalDiff) - protected - FContentVersionBefore,FContentVersionAfter: integer; - FSvgStreamBefore,FSvgStreamAfter: TMemoryStream; - FDpiBefore, FDpiAfter: single; - public - constructor Create(AFromOriginal: TBGRALayerSVGOriginal); - procedure ComputeDiff(AToOriginal: TBGRALayerSVGOriginal); - procedure Apply(AOriginal: TBGRALayerCustomOriginal); override; - procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override; - function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override; - procedure Append(ADiff: TBGRAOriginalDiff); override; - function IsIdentity: boolean; override; - destructor Destroy; override; - end; - - { TBGRALayerSVGOriginal } - - TBGRALayerSVGOriginal = class(TBGRALayerCustomOriginal) - private - function GetDPI: single; - function GetSvgHeight: single; - function GetSvgWidth: single; - procedure SetDPI(AValue: single); - protected - FSVG: TBGRASVG; - FPresentationMatrix: TAffineMatrix; - FDiff: TBGRASVGOriginalDiff; - FContentVersion: integer; - procedure BeginUpdate; - procedure EndUpdate; - procedure ComputePresentation(AContainerWidth, AContainerHeight: integer; AScaleDPI: single); - public - constructor Create; override; - destructor Destroy; override; - procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override; - function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix): TRect; override; - procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override; - procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override; - procedure LoadFromStream(AStream: TStream); override; - procedure SaveSVGToStream(AStream: TStream); - procedure SetSVG(ASVG: TBGRASVG; AContainerWidth: integer = 640; - AContainerHeight: integer = 480; AScaleDPI: single = 1); - procedure LoadSVGFromStream(AStream: TStream; AContainerWidth: integer = 640; - AContainerHeight: integer = 480; AScaleDPI: single = 1); - function GetSVGCopy: TBGRASVG; - class function StorageClassName: RawByteString; override; - class function CanConvertToSVG: boolean; override; - function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TBGRASVG; override; - property Width: single read GetSvgWidth; - property Height: single read GetSvgHeight; - property DPI: single read GetDPI write SetDPI; - property PresentationMatrix: TAffineMatrix read FPresentationMatrix; - end; - - { TBGRALayeredSVG } - - TBGRALayeredSVG = class(TBGRALayeredBitmap) - protected - function GetMimeType: string; override; - procedure InternalLoadFromStream(AStream: TStream); - procedure InternalSaveToStream(AStream: TStream); - public - ContainerWidth, ContainerHeight, DefaultSvgDPI, DPI: integer; - DefaultLayerName: string; - constructor Create; overload; override; - constructor Create(AWidth, AHeight: integer); overload; override; - procedure LoadFromStream(AStream: TStream); override; - procedure LoadFromFile(const filenameUTF8: string); override; - procedure SaveToStream(AStream: TStream); override; - procedure SaveToFile(const filenameUTF8: string); override; - end; - -implementation - -uses BGRACanvas2D, BGRAMemDirectory, BGRAUTF8, BGRASVGShapes, math, BGRASVGType, - BGRAVectorize; - -{ TBGRASVGOriginalDiff } - -constructor TBGRASVGOriginalDiff.Create(AFromOriginal: TBGRALayerSVGOriginal); -begin - if Assigned(AFromOriginal.FSVG) then - begin - FSvgStreamBefore := TMemoryStream.Create; - AFromOriginal.FSVG.SaveToStream(FSvgStreamBefore); - end; - FContentVersionBefore:= AFromOriginal.FContentVersion; - FDpiBefore:= AFromOriginal.DPI; -end; - -procedure TBGRASVGOriginalDiff.ComputeDiff(AToOriginal: TBGRALayerSVGOriginal); -begin - FreeAndNil(FSvgStreamAfter); - if Assigned(AToOriginal.FSVG) then - begin - FSvgStreamAfter := TMemoryStream.Create; - AToOriginal.FSVG.SaveToStream(FSvgStreamAfter); - end; - FContentVersionAfter:= AToOriginal.FContentVersion; - FDpiAfter:= AToOriginal.DPI; -end; - -procedure TBGRASVGOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal); -var - orig: TBGRALayerSVGOriginal; -begin - orig := AOriginal as TBGRALayerSVGOriginal; - if Assigned(FSvgStreamAfter) then - begin - FSvgStreamAfter.Position:= 0; - orig.FSVG.LoadFromStream(FSvgStreamAfter); - end else - orig.FSVG.Content.Clear; - orig.FContentVersion := FContentVersionAfter; -end; - -procedure TBGRASVGOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal); -var - orig: TBGRALayerSVGOriginal; -begin - orig := AOriginal as TBGRALayerSVGOriginal; - if Assigned(FSvgStreamBefore) then - begin - FSvgStreamBefore.Position:= 0; - orig.FSVG.LoadFromStream(FSvgStreamBefore); - end else - orig.FSVG.Content.Clear; - orig.FContentVersion := FContentVersionBefore; -end; - -function TBGRASVGOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean; -begin - result := (ADiff is TBGRASVGOriginalDiff) and - (TBGRASVGOriginalDiff(ADiff).FContentVersionAfter >= FContentVersionAfter); -end; - -procedure TBGRASVGOriginalDiff.Append(ADiff: TBGRAOriginalDiff); -var - next: TBGRASVGOriginalDiff; -begin - next := ADiff as TBGRASVGOriginalDiff; - if next.FContentVersionAfter < FContentVersionAfter then - raise exception.Create('Cannot append diff made before this one.'); - FDpiAfter:= next.FDpiAfter; - FreeAndNil(FSvgStreamAfter); - if Assigned(next.FSvgStreamAfter) then - begin - FSvgStreamAfter := TMemoryStream.Create; - next.FSvgStreamAfter.Position:= 0; - FSvgStreamAfter.CopyFrom(next.FSvgStreamAfter, next.FSvgStreamAfter.Size); - end; - FContentVersionAfter:= next.FContentVersionAfter; -end; - -function TBGRASVGOriginalDiff.IsIdentity: boolean; -begin - result := (FDpiBefore = FDpiAfter) and - ( ((FSvgStreamBefore=nil) and (FSvgStreamAfter=nil)) or - (Assigned(FSvgStreamBefore) and Assigned(FSvgStreamAfter) and - (FSvgStreamBefore.Size = FSvgStreamAfter.Size) and - CompareMem(FSvgStreamBefore.Memory,FSvgStreamAfter.Memory,FSvgStreamBefore.Size)) ); -end; - -destructor TBGRASVGOriginalDiff.Destroy; -begin - FSvgStreamBefore.Free; - inherited Destroy; -end; - -{ TBGRALayerSVGOriginal } - -function TBGRALayerSVGOriginal.GetDPI: single; -begin - result := FSVG.DefaultDpi; -end; - -function TBGRALayerSVGOriginal.GetSvgHeight: single; -begin - result := FSVG.HeightAsPixel; -end; - -function TBGRALayerSVGOriginal.GetSvgWidth: single; -begin - result := FSVG.WidthAsPixel; -end; - -procedure TBGRALayerSVGOriginal.SetDPI(AValue: single); -begin - BeginUpdate; - FSVG.DefaultDpi:= AValue; - EndUpdate; -end; - -procedure TBGRALayerSVGOriginal.BeginUpdate; -begin - if DiffExpected and (FDiff=nil) then - FDiff := TBGRASVGOriginalDiff.Create(self); -end; - -procedure TBGRALayerSVGOriginal.EndUpdate; -begin - if Assigned(FDiff) then FDiff.ComputeDiff(self); - NotifyChange(FDiff); - FDiff := nil; -end; - -procedure TBGRALayerSVGOriginal.ComputePresentation(AContainerWidth, AContainerHeight: integer; - AScaleDPI: single); -var - compWidth, compHeight: single; -begin - FSVG.Units.ContainerWidth := FloatWithCSSUnit(AContainerWidth / AScaleDPI, cuPixel); - FSVG.Units.ContainerHeight := FloatWithCSSUnit(AContainerHeight / AScaleDPI, cuPixel); - compWidth := FSVG.WidthAsPixel; - compHeight := FSVG.HeightAsPixel; - FSVG.WidthAsPixel := compWidth * AScaleDPI; - FSVG.HeightAsPixel := compHeight * AScaleDPI; - FPresentationMatrix := FSVG.GetStretchPresentationMatrix(cuPixel); -end; - -constructor TBGRALayerSVGOriginal.Create; -begin - inherited Create; - FSVG := TBGRASVG.Create; - FContentVersion := 0; -end; - -destructor TBGRALayerSVGOriginal.Destroy; -begin - FSVG.Free; - FDiff.Free; - inherited Destroy; -end; - -procedure TBGRALayerSVGOriginal.Render(ADest: TBGRABitmap; - AMatrix: TAffineMatrix; ADraft: boolean); -var - c2D: TBGRACanvas2D; -begin - if Assigned(FSVG) then - begin - c2D := TBGRACanvas2D.Create(ADest); - c2D.transform(AMatrix*FPresentationMatrix); - c2D.fontRenderer := TBGRAVectorizedFontRenderer.Create; - if ADraft then c2D.antialiasing := false; - FSVG.Draw(c2D, 0, 0, cuPixel); - c2D.Free; - end; -end; - -function TBGRALayerSVGOriginal.GetRenderBounds(ADestRect: TRect; - AMatrix: TAffineMatrix): TRect; -var - aff: TAffineBox; - r: TRectF; -begin - if Assigned(FSVG) then - begin - with FSVG.ViewBox do - r := RectWithSizeF(min.x, min.y, size.x, size.y); - aff := AMatrix * FPresentationMatrix * TAffineBox.AffineBox(r); - result := aff.RectBounds; - end else - result := EmptyRect; -end; - -procedure TBGRALayerSVGOriginal.LoadFromStorage( - AStorage: TBGRACustomOriginalStorage); -var svgStream: TMemoryStream; - valDpi: Single; -begin - svgStream := TMemoryStream.Create; - try - if AStorage.ReadFile('content.svg', svgStream) then - begin - if not Assigned(FSVG) then FSVG := TBGRASVG.Create; - svgStream.Position:= 0; - FSVG.LoadFromStream(svgStream); - end else - begin - FreeAndNil(FSVG); - FSVG := TBGRASVG.Create; - end; - FPresentationMatrix := FSVG.GetStretchPresentationMatrix(cuPixel); - FContentVersion:= AStorage.Int['content-version']; - finally - svgStream.Free; - end; - valDpi := AStorage.Float['dpi']; - if valDpi <> EmptySingle then - FSVG.DefaultDpi:= valDpi; -end; - -procedure TBGRALayerSVGOriginal.SaveToStorage( - AStorage: TBGRACustomOriginalStorage); -var svgStream: TMemoryStream; -begin - if Assigned(FSVG) then - begin - if FContentVersion > AStorage.Int['content-version'] then - begin - svgStream := TMemoryStream.Create; - try - FSVG.SaveToStream(svgStream); - AStorage.WriteFile('content.svg', svgStream, true, true); - svgStream := nil; - AStorage.Int['content-version'] := FContentVersion; - finally - svgStream.Free; - end; - end; - AStorage.Float['dpi'] := FSVG.DefaultDpi; - end; -end; - -procedure TBGRALayerSVGOriginal.LoadFromStream(AStream: TStream); -begin - if TMemDirectory.CheckHeader(AStream) then - inherited LoadFromStream(AStream) - else - LoadSVGFromStream(AStream); -end; - -procedure TBGRALayerSVGOriginal.SaveSVGToStream(AStream: TStream); -begin - FSVG.SaveToStream(AStream); -end; - -procedure TBGRALayerSVGOriginal.SetSVG(ASVG: TBGRASVG; AContainerWidth: integer; - AContainerHeight: integer; AScaleDPI: single); -begin - BeginUpdate; - FSVG.Free; - FSVG := ASVG; - ComputePresentation(AContainerWidth, AContainerHeight, AScaleDPI); - Inc(FContentVersion); - EndUpdate; -end; - -procedure TBGRALayerSVGOriginal.LoadSVGFromStream(AStream: TStream; AContainerWidth: integer; - AContainerHeight: integer; AScaleDPI: single); -begin - BeginUpdate; - FSVG.LoadFromStream(AStream); - ComputePresentation(AContainerWidth, AContainerHeight, AScaleDPI); - Inc(FContentVersion); - EndUpdate; -end; - -function TBGRALayerSVGOriginal.GetSVGCopy: TBGRASVG; -begin - result := FSVG.Duplicate; -end; - -class function TBGRALayerSVGOriginal.StorageClassName: RawByteString; -begin - result := 'svg'; -end; - -class function TBGRALayerSVGOriginal.CanConvertToSVG: boolean; -begin - Result:= true; -end; - -function TBGRALayerSVGOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TBGRASVG; -begin - if not IsAffineMatrixIdentity(AMatrix) then - raise exception.Create('Matrix not valid for SVG original'); - AOffset := Point(0,0); - Result:= GetSVGCopy; -end; - -{ TBGRALayeredSVG } - -function TBGRALayeredSVG.GetMimeType: string; -begin - Result:= 'image/svg+xml'; -end; - -procedure TBGRALayeredSVG.InternalLoadFromStream(AStream: TStream); -var - svg, svgLayer: TBGRASVG; - visualWidth, visualHeight: single; - svgOrig: TBGRALayerSVGOriginal; - idx, i, j: Integer; - layer: TSVGGroup; - prefix: String; - originalViewBox: TSVGViewBox; - m: TAffineMatrix; -begin - svg := TBGRASVG.Create; - try - svg.DefaultDpi := DefaultSvgDPI; - svg.LoadFromStream(AStream); - svg.Units.ContainerWidth := FloatWithCSSUnit(ContainerWidth / DPI * svg.DefaultDpi, cuPixel); - svg.Units.ContainerHeight := FloatWithCSSUnit(ContainerHeight / DPI * svg.DefaultDpi, cuPixel); - svg.CropToViewBox(DPI / svg.DefaultDpi); - visualWidth := svg.WidthAsPixel; - visualHeight := svg.HeightAsPixel; - Clear; - SetSize(floor(visualWidth + 0.95),floor(visualHeight + 0.95)); - if svg.LayerCount > 0 then - begin - for i := 0 to svg.LayerCount-1 do - begin - layer := svg.Layer[i]; - svgLayer := TBGRASVG.Create; - svgLayer.DefaultDpi:= svg.DefaultDpi; - svgLayer.WidthAsPixel := visualWidth; - svgLayer.HeightAsPixel := visualHeight; - for j := 0 to svg.NamespaceCount-1 do - begin - prefix := svg.NamespacePrefix[j]; - svgLayer.NamespaceURI[prefix] := svg.NamespaceURI[prefix]; - end; - try - svgLayer.ViewBox := svg.ViewBox; - if layer.DOMElement.hasAttribute('bgra:originalViewBox') then - begin - originalViewBox := TSVGViewBox.Parse(layer.DOMElement.GetAttribute('bgra:originalViewBox')); - svgLayer.WidthAsPixel := originalViewBox.size.x; - svgLayer.HeightAsPixel := originalViewBox.size.y; - svgLayer.ViewBox := originalViewBox; - m := layer.matrix[cuPixel] * AffineMatrixTranslation(originalViewBox.min.x, originalViewBox.min.y); - end else - m := layer.matrix[cuPixel]; - for j := 0 to svg.Content.IndexOfElement(layer)-1 do - if svg.Content.ElementObject[j] is TSVGDefine then - svgLayer.Content.CopyElement(svg.Content.ElementObject[j]); - for j := 0 to layer.Content.ElementCount-1 do - svgLayer.Content.CopyElement(layer.Content.ElementObject[j]); - svgOrig := TBGRALayerSVGOriginal.Create; - svgOrig.SetSVG(svgLayer); - svgLayer := nil; - idx := AddLayerFromOwnedOriginal(svgOrig); - LayerName[idx] := layer.Name; - LayerVisible[idx] := layer.Visible; - LayerOpacity[idx] := min(255,max(0,round(layer.opacity*255))); - BlendOperation[idx] := layer.mixBlendMode; - LayerOriginalMatrix[idx] := m; - RenderLayerFromOriginal(idx); - finally - svgLayer.Free; - end; - end; - end else - begin - svgOrig := TBGRALayerSVGOriginal.Create; - svgOrig.SetSVG(svg); - svg := nil; - idx := AddLayerFromOwnedOriginal(svgOrig); - LayerName[idx] := DefaultLayerName+'1'; - RenderLayerFromOriginal(idx); - end; - finally - svg.Free; - end; -end; - -procedure TBGRALayeredSVG.InternalSaveToStream(AStream: TStream); - - procedure StoreLayerBitmap(ABitmap: TBGRABitmap; AOwned: boolean; const AMatrix: TAffineMatrix; - ADestElem: TSVGCustomElement; AContent: TSVGContent); - var - img: TSVGImage; - ab: TAffineBox; - vb: TSVGViewBox; - begin - ab := AMatrix * TAffineBox.AffineBox(PointF(0, 0), PointF(ABitmap.Width, 0), PointF(0, ABitmap.Height)); - - img := AContent.AppendImage(AMatrix[1,3], AMatrix[2, 3], ABitmap.Width, ABitmap.Height, ABitmap, AOwned); - img.matrix[cuCustom] := AffineMatrixLinear(AMatrix); - - if ADestElem is TSVGGroup then - with TSVGGroup(ADestElem) do - begin - with ab.RectBounds do - begin - vb.min := PointF(Left, Top); - vb.size := PointF(Width, Height); - end; - DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format'); - DOMElement.SetAttribute('bgra:originalViewBox', vb.ToString); - end; - end; - - procedure StoreLayer(ALayerIndex: integer; ASVG: TBGRASVG; ADestElem: TSVGCustomElement; - ADest: TSVGContent; out AMatrix: TAffineMatrix); - var - c: TBGRALayerOriginalAny; - bmp, part: TBGRABitmap; - layerSvg: TBGRASVG; - i: Integer; - prefix: String; - origViewBox: TSVGViewBox; - wantedOfs: TPoint; - r: TRect; - begin - AMatrix := AffineMatrixIdentity; - if LayerOriginalKnown[ALayerIndex] then - c:= LayerOriginalClass[ALayerIndex] - else c := nil; - - if Assigned(c) and c.CanConvertToSVG then - begin - if LayerOriginal[ALayerIndex].IsInfiniteSurface then - begin - layerSvg := LayerOriginal[ALayerIndex].ConvertToSVG(LayerOriginalMatrix[ALayerIndex], - wantedOfs) as TBGRASVG; - layerSvg.WidthAsPixel:= Self.Width; - layerSvg.HeightAsPixel:= Self.Height; - AMatrix := AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y); - end else - begin - layerSvg := LayerOriginal[ALayerIndex].ConvertToSVG(AffineMatrixIdentity, - wantedOfs) as TBGRASVG; - AMatrix:= LayerOriginalMatrix[ALayerIndex] - * AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y) - * layerSvg.GetStretchPresentationMatrix(cuPixel); - end; - origViewBox := layerSvg.ViewBox; - try - layerSvg.ConvertToUnit(cuCustom); - if ADestElem is TSVGGroup then - with TSVGGroup(ADestElem) do - begin - DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format'); - DOMElement.SetAttribute('bgra:originalViewBox', origViewBox.ToString); - end; - for i := 0 to layerSvg.Content.ElementCount-1 do - ADest.CopyElement(layerSvg.Content.ElementObject[i]); - for i := 0 to layerSvg.NamespaceCount-1 do - begin - prefix := layerSvg.NamespacePrefix[i]; - ASVG.NamespaceURI[prefix] := layerSvg.NamespaceURI[prefix]; - end; - finally - layerSvg.Free; - end; - end else - begin - r := LayerBitmap[ALayerIndex].GetImageBounds; - if (r.Left = 0) and (r.Top = 0) and (r.Width = LayerBitmap[ALayerIndex].Width) and - (r.Height = LayerBitmap[ALayerIndex].Height) then - StoreLayerBitmap(LayerBitmap[ALayerIndex], false, - AffineMatrixTranslation(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y), ADestElem, ADest) - else - begin - part := LayerBitmap[ALayerIndex].GetPart(r); - StoreLayerBitmap(part, true, - AffineMatrixTranslation(LayerOffset[ALayerIndex].X + r.Left, - LayerOffset[ALayerIndex].Y + r.Top), ADestElem, ADest) - end; - end; - end; - -var - svg: TBGRASVG; - vb : TSVGViewBox; - i,j: Integer; - g: TSVGGroup; - m: TAffineMatrix; - identifiers, newIdentifiers: TStringList; -begin - svg := TBGRASVG.Create; - identifiers := nil; - newIdentifiers := nil; - try - svg.WidthAsPixel := Width; - svg.HeightAsPixel := Height; - vb.min := PointF(0, 0); - vb.size := PointF(Width, Height); - svg.ViewBox := vb; - if (NbLayers = 1) and (LayerOpacity[0] = 255) and LayerVisible[0] and - (LayerOriginalGuid[0] = GUID_NULL) then - begin - StoreLayer(0, svg, svg, svg.Content, m); - end else - begin - svg.NamespaceURI['inkscape'] := 'http://www.inkscape.org/namespaces/inkscape'; - identifiers := TStringList.Create; - newIdentifiers := TStringList.Create; - for i := 0 to NbLayers-1 do - begin - g := svg.Content.AppendGroup; - g.IsLayer := true; - g.Name:= LayerName[i]; - g.opacity:= LayerOpacity[i]/255; - g.Visible:= LayerVisible[i]; - g.mixBlendMode:= BlendOperation[i]; - StoreLayer(i, svg, g, g.Content, m); - g.matrix[cuPixel] := m; - identifiers.Clear; - g.ListIdentifiers(identifiers); - newIdentifiers.Clear; - for j := 0 to identifiers.Count-1 do - newIdentifiers.Add('layer'+inttostr(i+1)+'-'+identifiers[j]); - g.RenameIdentifiers(identifiers, newIdentifiers); - end; - end; - svg.SaveToStream(AStream); - finally - newIdentifiers.Free; - identifiers.Free; - svg.Free; - end; -end; - -constructor TBGRALayeredSVG.Create; -begin - inherited Create; - ContainerWidth:= 640; - ContainerHeight:= 480; - DefaultLayerName := 'Layer'; - DPI := 96; - DefaultSvgDPI:= 96; -end; - -constructor TBGRALayeredSVG.Create(AWidth, AHeight: integer); -begin - inherited Create(AWidth, AHeight); - ContainerWidth:= 640; - ContainerHeight:= 480; - DefaultLayerName := 'Layer'; -end; - -procedure TBGRALayeredSVG.LoadFromStream(AStream: TStream); -begin - OnLayeredBitmapLoadFromStreamStart; - try - InternalLoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - end; -end; - -procedure TBGRALayeredSVG.LoadFromFile(const filenameUTF8: string); -var AStream: TFileStreamUTF8; -begin - AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite); - OnLayeredBitmapLoadStart(filenameUTF8); - try - LoadFromStream(AStream); - finally - OnLayeredBitmapLoaded; - AStream.Free; - end; -end; - -procedure TBGRALayeredSVG.SaveToStream(AStream: TStream); -begin - OnLayeredBitmapSaveToStreamStart; - try - InternalSaveToStream(AStream); - finally - OnLayeredBitmapSaved; - end; -end; - -procedure TBGRALayeredSVG.SaveToFile(const filenameUTF8: string); -var AStream: TFileStreamUTF8; -begin - AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate); - OnLayeredBitmapSaveStart(filenameUTF8); - try - InternalSaveToStream(AStream); - finally - OnLayeredBitmapSaved; - AStream.Free; - end; -end; - -procedure RegisterLayeredSvgFormat; -begin - RegisterLayeredBitmapReader('svg', TBGRALayeredSVG); - RegisterLayeredBitmapWriter('svg', TBGRALayeredSVG); -end; - -initialization - - RegisterLayerOriginal(TBGRALayerSVGOriginal); - RegisterLayeredSvgFormat; - -end. - diff --git a/components/bgrabitmap/bgrasvgshapes.pas b/components/bgrabitmap/bgrasvgshapes.pas deleted file mode 100644 index e048ec9..0000000 --- a/components/bgrabitmap/bgrasvgshapes.pas +++ /dev/null @@ -1,4748 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASVGShapes; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAUnits, DOM, BGRAPath, BGRABitmapTypes, - BGRACanvas2D, BGRASVGType, BGRAGraphics; - -type - TSVGContent = class; - - { TSVGElementWithContent } - - TSVGElementWithContent = class(TSVGElement) - protected - FContent: TSVGContent; - FSubDatalink: TSVGDataLink; - class function OwnDatalink: boolean; virtual; - procedure SetDatalink(AValue: TSVGDataLink); override; - public - constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; - constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; - procedure ListIdentifiers(AResult: TStringList); override; - procedure RenameIdentifiers(AFrom, ATo: TStringList); override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - destructor Destroy; override; - procedure Recompute; override; - property Content: TSVGContent read FContent; - end; - - TSVGGradient = class; - - { TSVGElementWithGradient } - - TSVGElementWithGradient = class(TSVGElement) - private - FFillGradientElement, FStrokeGradientElement: TSVGGradient; - FGradientElementsDefined, FRegisteredToDatalink: boolean; - FFillCanvasGradient, FStrokeCanvasGradient: IBGRACanvasGradient2D; - procedure DatalinkOnLink(Sender: TObject; AElement: TSVGElement; - ALink: boolean); - function EvaluatePercentage(fu: TFloatWithCSSUnit): single; { fu is a percentage of a number [0.0..1.0] } - function GetFillGradientElement: TSVGGradient; - function GetStrokeGradientElement: TSVGGradient; - procedure ResetGradients; - procedure FindGradientElements; - protected - procedure Initialize; override; - procedure AddStopElements(ASVGGradient: TSVGGradient; canvas: IBGRACanvasGradient2D); - function CreateCanvasLinearGradient(ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; - const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; - function CreateCanvasRadialGradient(ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; - const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; - procedure ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); override; - procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); override; - procedure SetDatalink(AValue: TSVGDataLink); override; - procedure SetFill(AValue: string); override; - procedure SetStroke(AValue: string); override; - public - destructor Destroy; override; - procedure InitializeGradient(ACanvas2d: TBGRACanvas2D; - const origin: TPointF; const w,h: single; AUnit: TCSSUnit); - property FillGradientElement: TSVGGradient read GetFillGradientElement; - property StrokeGradientElement: TSVGGradient read GetStrokeGradientElement; - end; - - { TSVGLine } - - TSVGLine = class(TSVGElement) - private - function GetX1: TFloatWithCSSUnit; - function GetX2: TFloatWithCSSUnit; - function GetY1: TFloatWithCSSUnit; - function GetY2: TFloatWithCSSUnit; - procedure SetX1(AValue: TFloatWithCSSUnit); - procedure SetX2(AValue: TFloatWithCSSUnit); - procedure SetY1(AValue: TFloatWithCSSUnit); - procedure SetY2(AValue: TFloatWithCSSUnit); - protected - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property x1: TFloatWithCSSUnit read GetX1 write SetX1; - property y1: TFloatWithCSSUnit read GetY1 write SetY1; - property x2: TFloatWithCSSUnit read GetX2 write SetX2; - property y2: TFloatWithCSSUnit read GetY2 write SetY2; - end; - - { TSVGRectangle } - - TSVGRectangle = class(TSVGElementWithGradient) - private - function GetX: TFloatWithCSSUnit; - function GetY: TFloatWithCSSUnit; - function GetWidth: TFloatWithCSSUnit; - function GetHeight: TFloatWithCSSUnit; - function GetRX: TFloatWithCSSUnit; - function GetRY: TFloatWithCSSUnit; - procedure SetX(AValue: TFloatWithCSSUnit); - procedure SetY(AValue: TFloatWithCSSUnit); - procedure SetWidth(AValue: TFloatWithCSSUnit); - procedure SetHeight(AValue: TFloatWithCSSUnit); - procedure SetRX(AValue: TFloatWithCSSUnit); - procedure SetRY(AValue: TFloatWithCSSUnit); - protected - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property x: TFloatWithCSSUnit read GetX write SetX; - property y: TFloatWithCSSUnit read GetY write SetY; - property width: TFloatWithCSSUnit read GetWidth write SetWidth; - property height: TFloatWithCSSUnit read GetHeight write SetHeight; - property rx: TFloatWithCSSUnit read GetRX write SetRX; - property ry: TFloatWithCSSUnit read GetRY write SetRY; - end; - - { TSVGCircle } - - TSVGCircle = class(TSVGElementWithGradient) - private - function GetCX: TFloatWithCSSUnit; - function GetCY: TFloatWithCSSUnit; - function GetR: TFloatWithCSSUnit; - procedure SetCX(AValue: TFloatWithCSSUnit); - procedure SetCY(AValue: TFloatWithCSSUnit); - procedure SetR(AValue: TFloatWithCSSUnit); - protected - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property cx: TFloatWithCSSUnit read GetCX write SetCX; - property cy: TFloatWithCSSUnit read GetCY write SetCY; - property r: TFloatWithCSSUnit read GetR write SetR; - end; - - { TSVGEllipse } - - TSVGEllipse = class(TSVGElementWithGradient) - private - function GetCX: TFloatWithCSSUnit; - function GetCY: TFloatWithCSSUnit; - function GetRX: TFloatWithCSSUnit; - function GetRY: TFloatWithCSSUnit; - procedure SetCX(AValue: TFloatWithCSSUnit); - procedure SetCY(AValue: TFloatWithCSSUnit); - procedure SetRX(AValue: TFloatWithCSSUnit); - procedure SetRY(AValue: TFloatWithCSSUnit); - protected - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property cx: TFloatWithCSSUnit read GetCX write SetCX; - property cy: TFloatWithCSSUnit read GetCY write SetCY; - property rx: TFloatWithCSSUnit read GetRX write SetRX; - property ry: TFloatWithCSSUnit read GetRY write SetRY; - end; - - { TSVGPath } - - TSVGPath = class(TSVGElementWithGradient) - private - FPath: TBGRAPath; - FBoundingBox: TRectF; - FBoundingBoxComputed: boolean; - function GetBoundingBoxF: TRectF; - function GetPath: TBGRAPath; - function GetPathLength: TFloatWithCSSUnit; - function GetData: string; - procedure SetPathLength(AValue: TFloatWithCSSUnit); - procedure SetData(AValue: string); - protected - function GetDOMElement: TDOMElement; override; - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; - constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; - destructor Destroy; override; - property d: string read GetData write SetData; - property path: TBGRAPath read GetPath; - property pathLength: TFloatWithCSSUnit read GetPathLength write SetPathLength; - property boundingBoxF: TRectF read GetBoundingBoxF; - end; - - { TSVGPolypoints } - - TSVGPolypoints = class(TSVGElementWithGradient) - private - FBoundingBox: TRectF; - FBoundingBoxComputed: boolean; - function GetBoundingBoxF: TRectF; - function GetClosed: boolean; - function GetPoints: string; - function GetPointsF: ArrayOfTPointF; - procedure SetPoints(AValue: string); - procedure SetPointsF(AValue: ArrayOfTPointF); - procedure ComputeBoundingBox(APoints: ArrayOfTPointF); - protected - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - public - constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; AClosed: boolean; ADataLink: TSVGDataLink); overload; - destructor Destroy; override; - property points: string read GetPoints write SetPoints; - property pointsF: ArrayOfTPointF read GetPointsF write SetPointsF; - property closed: boolean read GetClosed; - property boundingBoxF: TRectF read GetBoundingBoxF; - end; - - { TSVGTextElement } - - TSVGTextElement = class(TSVGElementWithGradient); - - { TSVGTextElementWithContent } - - TSVGTextElementWithContent = class(TSVGTextElement) - protected - FContent: TSVGContent; - public - constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; - constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override; - destructor Destroy; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property Content: TSVGContent read FContent; - end; - - { TSVGTextPositioning } - - TSVGTextPositioning = class(TSVGTextElementWithContent) - private - function GetX: ArrayOfTFloatWithCSSUnit; - function GetY: ArrayOfTFloatWithCSSUnit; - function GetDX: ArrayOfTFloatWithCSSUnit; - function GetDY: ArrayOfTFloatWithCSSUnit; - function GetRotate: ArrayOfTSVGNumber; - procedure SetX(AValue: ArrayOfTFloatWithCSSUnit); - procedure SetY(AValue: ArrayOfTFloatWithCSSUnit); - procedure SetDX(AValue: ArrayOfTFloatWithCSSUnit); - procedure SetDY(AValue: ArrayOfTFloatWithCSSUnit); - procedure SetRotate(AValue: ArrayOfTSVGNumber); - public - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property x: ArrayOfTFloatWithCSSUnit read GetX write SetX; - property y: ArrayOfTFloatWithCSSUnit read GetY write SetY; - property dx: ArrayOfTFloatWithCSSUnit read GetDX write SetDX; - property dy: ArrayOfTFloatWithCSSUnit read GetDY write SetDY; - property rotate: ArrayOfTSVGNumber read GetRotate write SetRotate; - end; - - { TSVGTRef } - - TSVGTRef = class(TSVGTextElement) - private - function GetXlinkHref: string; - procedure SetXlinkHref(AValue: string); - public - class function GetDOMTag: string; override; - property xlinkHref: string read GetXlinkHref write SetXlinkHref; - end; - - ArrayOfTextParts = array of record - Level: integer; - BaseElement: TSVGElement; - Text: string; - SplitPos: integer; - AbsoluteCoord: TPointF; - PartStartCoord, PartEndCoord: TPointF; - Bounds: TRectF; - PosUnicode: integer; - InheritedRotation: single; - end; - - { TSVGText } - - TSVGText = class(TSVGTextPositioning) - private - FInGetSimpleText: boolean; - function GetFontBold: boolean; - function GetFontFamily: string; - function GetFontFamilyList: ArrayOfString; - function GetFontItalic: boolean; - function GetFontSize: TFloatWithCSSUnit; - function GetFontStyle: string; - function GetFontStyleLCL: TFontStyles; - function GetFontWeight: string; - function GetSimpleText: string; - function GetTextAnchor: TSVGTextAnchor; - function GetTextDirection: TSVGTextDirection; - function GetTextDecoration: string; - function GetTextLength: TFloatWithCSSUnit; - function GetLengthAdjust: TSVGLengthAdjust; - procedure SetFontBold(AValue: boolean); - procedure SetFontFamily(AValue: string); - procedure SetFontFamilyList(AValue: ArrayOfString); - procedure SetFontItalic(AValue: boolean); - procedure SetFontSize(AValue: TFloatWithCSSUnit); - procedure SetFontStyle(AValue: string); - procedure SetFontStyleLCL(AValue: TFontStyles); - procedure SetFontWeight(AValue: string); - procedure SetSimpleText(AValue: string); - procedure SetTextAnchor(AValue: TSVGTextAnchor); - procedure SetTextDirection(AValue: TSVGTextDirection); - procedure SetTextDecoration(AValue: string); - procedure SetTextLength(AValue: TFloatWithCSSUnit); - procedure SetLengthAdjust(AValue: TSVGLengthAdjust); - protected - procedure InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit; - ADraw: boolean; AAllTextBounds: TRectF; - var APosition: TPointF; - var ATextParts: ArrayOfTextParts); overload; - procedure InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit; - ADraw: boolean; AAllTextBounds: TRectF; - var APosition: TPointF; - var ATextParts: ArrayOfTextParts; ALevel: integer; - AStartPart, AEndPart: integer); overload; - procedure InternalDrawOrComputePart(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit; - AText: string; APosUnicode: integer; AInheritedRotation: single; - ADraw: boolean; AAllTextBounds: TRectF; - var APosition: TPointF; out ABounds: TRectF); - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - procedure CleanText(var ATextParts: ArrayOfTextParts); - function GetTRefContent(AElement: TSVGTRef): string; - function GetAllText(AInheritedRotation: single): ArrayOfTextParts; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property textLength: TFloatWithCSSUnit read GetTextLength write SetTextLength; - property lengthAdjust: TSVGLengthAdjust read GetLengthAdjust write SetLengthAdjust; - property SimpleText: string read GetSimpleText write SetSimpleText; - property fontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize; - property fontFamily: string read GetFontFamily write SetFontFamily; - property fontFamilyList: ArrayOfString read GetFontFamilyList write SetFontFamilyList; - property fontWeight: string read GetFontWeight write SetFontWeight; - property fontStyle: string read GetFontStyle write SetFontStyle; - property fontStyleLCL: TFontStyles read GetFontStyleLCL write SetFontStyleLCL; - property textDecoration: string read GetTextDecoration write SetTextDecoration; - property fontBold: boolean read GetFontBold write SetFontBold; - property fontItalic: boolean read GetFontItalic write SetFontItalic; - property textAnchor: TSVGTextAnchor read GetTextAnchor write SetTextAnchor; - property textDirection: TSVGTextDirection read GetTextDirection write SetTextDirection; - end; - - { TSVGTSpan } - - TSVGTSpan = class(TSVGText) - public - class function GetDOMTag: string; override; - end; - - { TSVGTextPath } - - TSVGTextPath = class(TSVGTextElementWithContent) - private - function GetStartOffset: TFloatWithCSSUnit; - function GetMethod: TSVGTextPathMethod; - function GetSpacing: TSVGTextPathSpacing; - function GetXlinkHref: string; - procedure SetStartOffset(AValue: TFloatWithCSSUnit); - procedure SetMethod(AValue: TSVGTextPathMethod); - procedure SetSpacing(AValue: TSVGTextPathSpacing); - procedure SetXlinkHref(AValue: string); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property startOffset: TFloatWithCSSUnit read GetStartOffset write SetStartOffset; - property method: TSVGTextPathMethod read GetMethod write SetMethod; - property spacing: TSVGTextPathSpacing read GetSpacing write SetSpacing; - property xlinkHref: string read GetXlinkHref write SetXlinkHref; - end; - - { TSVGAltGlyph } - - TSVGAltGlyph = class(TSVGTextElementWithContent) - private - function GetGlyphRef: string; - function GetFormat: string; - function GetXlinkHref: string; - procedure SetGlyphRef(AValue: string); - procedure SetFormat(AValue: string); - procedure SetXlinkHref(AValue: string); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - property glyphRef: string read GetGlyphRef write SetGlyphRef; - property format: string read GetFormat write SetFormat; - property xlinkHref: string read GetXlinkHref write SetXlinkHref; - end; - - { TSVGAltGlyphDef } - - TSVGAltGlyphDef = class(TSVGTextElementWithContent) - public - class function GetDOMTag: string; override; - end; - - { TSVGAltGlyphItem } - - TSVGAltGlyphItem = class(TSVGTextElementWithContent) - public - class function GetDOMTag: string; override; - end; - - { TSVGGlyphRef } - - TSVGGlyphRef = class(TSVGTextElement) - private - function GetX: TSVGNumber; - function GetY: TSVGNumber; - function GetDx: TSVGNumber; - function GetDy: TSVGNumber; - function GetGlyphRef: string; - function GetFormat: string; - function GetXlinkHref: string; - procedure SetX(AValue: TSVGNumber); - procedure SetY(AValue: TSVGNumber); - procedure SetDx(AValue: TSVGNumber); - procedure SetDy(AValue: TSVGNumber); - procedure SetGlyphRef(AValue: string); - procedure SetFormat(AValue: string); - procedure SetXlinkHref(AValue: string); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - property x: TSVGNumber read GetX write SetX; - property y: TSVGNumber read GetY write SetY; - property dx: TSVGNumber read GetDx write SetDx; - property dy: TSVGNumber read GetDy write SetDy; - property glyphRef: string read GetGlyphRef write SetGlyphRef; - property format: string read GetFormat write SetFormat; - property xlinkHref: string read GetXlinkHref write SetXlinkHref; - end; - - { TSVGClipPath } - - TSVGClipPath = class(TSVGElement) - private - function GetExternalResourcesRequired: boolean; - function GetClipPathUnits: TSVGObjectUnits; - procedure SetExternalResourcesRequired(AValue: boolean); - procedure SetClipPathUnits(AValue: TSVGObjectUnits); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - property externalResourcesRequired: boolean - read GetExternalResourcesRequired write SetExternalResourcesRequired; - property clipPathUnits: TSVGObjectUnits read GetClipPathUnits write SetClipPathUnits; - end; - - { TSVGColorProfile } - - TSVGColorProfile = class(TSVGElement) - private - function GetLocal: string; - function GetName: string; - function GetRenderingIntent: TSVGRenderingIntent; - function GetXlinkHref: string; - procedure SetLocal(AValue: string); - procedure SetName(AValue: string); - procedure SetRenderingIntent(AValue: TSVGRenderingIntent); - procedure SetXlinkHref(AValue: string); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - property local: string read GetLocal write SetLocal; - property name: string read GetName write SetName; - property renderingIntent: TSVGRenderingIntent read GetRenderingIntent write SetRenderingIntent; - property xlinkHref: string read GetXlinkHref write SetXlinkHref; - end; - - { TSVGImage } - - TSVGImage = class(TSVGElement) - private - function GetBitmap: TBGRACustomBitmap; - function GetExternalResourcesRequired: boolean; - function GetImageRendering: TSVGImageRendering; - function GetX: TFloatWithCSSUnit; - function GetY: TFloatWithCSSUnit; - function GetWidth: TFloatWithCSSUnit; - function GetHeight: TFloatWithCSSUnit; - function GetPreserveAspectRatio: TSVGPreserveAspectRatio; - function GetXlinkHref: string; - procedure SetExternalResourcesRequired(AValue: boolean); - procedure SetImageRendering(AValue: TSVGImageRendering); - procedure SetX(AValue: TFloatWithCSSUnit); - procedure SetY(AValue: TFloatWithCSSUnit); - procedure SetWidth(AValue: TFloatWithCSSUnit); - procedure SetHeight(AValue: TFloatWithCSSUnit); - procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); - procedure SetXlinkHref(AValue: string); - protected - FBitmap: TBGRACustomBitmap; - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; - ADataLink: TSVGDataLink); overload; override; - constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; - ADataLink: TSVGDataLink); overload; override; - destructor Destroy; override; - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - procedure SetBitmap(AValue: TBGRACustomBitmap; AOwned: boolean); overload; - procedure SetBitmap(AStream: TStream; AMimeType: string); overload; - property externalResourcesRequired: boolean - read GetExternalResourcesRequired write SetExternalResourcesRequired; - property x: TFloatWithCSSUnit read GetX write SetX; - property y: TFloatWithCSSUnit read GetY write SetY; - property width: TFloatWithCSSUnit read GetWidth write SetWidth; - property height: TFloatWithCSSUnit read GetHeight write SetHeight; - property imageRendering: TSVGImageRendering read GetImageRendering write SetImageRendering; - property preserveAspectRatio: TSVGPreserveAspectRatio - read GetPreserveAspectRatio write SetPreserveAspectRatio; - property xlinkHref: string read GetXlinkHref write SetXlinkHref; - property Bitmap: TBGRACustomBitmap read GetBitmap; - end; - - { TSVGPattern } - - TSVGPattern = class(TSVGImage) - private - function GetPatternUnits: TSVGObjectUnits; - function GetPatternContentUnits: TSVGObjectUnits; - function GetPatternTransform: string; - function GetViewBox: TSVGViewBox; - procedure SetPatternUnits(AValue: TSVGObjectUnits); - procedure SetPatternContentUnits(AValue: TSVGObjectUnits); - procedure SetPatternTransform(AValue: string); - procedure SetViewBox(AValue: TSVGViewBox); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - property patternUnits: TSVGObjectUnits read GetPatternUnits write SetPatternUnits; - property patternContentUnits: TSVGObjectUnits - read GetPatternContentUnits write SetPatternContentUnits; - property patternTransform: string read GetPatternTransform write SetPatternTransform; - property viewBox: TSVGViewBox read GetViewBox write SetViewBox; - end; - - { TSVGMarker } - - TSVGMarker = class(TSVGElement) - private - function GetExternalResourcesRequired: boolean; - function GetViewBox: TSVGViewBox; - function GetPreserveAspectRatio: TSVGPreserveAspectRatio; - function GetRefX: TFloatWithCSSUnit; - function GetRefY: TFloatWithCSSUnit; - function GetMarkerWidth: TFloatWithCSSUnit; - function GetMarkerHeight: TFloatWithCSSUnit; - function GetMarkerUnits: TSVGMarkerUnits; - function GetOrient: TSVGOrient; - procedure SetExternalResourcesRequired(AValue: boolean); - procedure SetViewBox(AValue: TSVGViewBox); - procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); - procedure SetRefX(AValue: TFloatWithCSSUnit); - procedure SetRefY(AValue: TFloatWithCSSUnit); - procedure SetMarkerWidth(AValue: TFloatWithCSSUnit); - procedure SetMarkerHeight(AValue: TFloatWithCSSUnit); - procedure SetMarkerUnits(AValue: TSVGMarkerUnits); - procedure SetOrient(AValue: TSVGOrient); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property externalResourcesRequired: boolean - read GetExternalResourcesRequired write SetExternalResourcesRequired; - property viewBox: TSVGViewBox read GetViewBox write SetViewBox; - property preserveAspectRatio: TSVGPreserveAspectRatio - read GetPreserveAspectRatio write SetPreserveAspectRatio; - property refX: TFloatWithCSSUnit read GetRefX write SetRefX; - property refY: TFloatWithCSSUnit read GetRefY write SetRefY; - property markerWidth: TFloatWithCSSUnit read GetMarkerWidth write SetMarkerWidth; - property markerHeight: TFloatWithCSSUnit read GetMarkerHeight write SetMarkerHeight; - property markerUnits: TSVGMarkerUnits read GetMarkerUnits write SetMarkerUnits; - property orient: TSVGOrient read GetOrient write SetOrient; - end; - - { TSVGMask } - - TSVGMask = class(TSVGElement) - private - function GetExternalResourcesRequired: boolean; - function GetX: TFloatWithCSSUnit; - function GetY: TFloatWithCSSUnit; - function GetWidth: TFloatWithCSSUnit; - function GetHeight: TFloatWithCSSUnit; - function GetMaskUnits: TSVGObjectUnits; - function GetMaskContentUnits: TSVGObjectUnits; - procedure SetExternalResourcesRequired(AValue: boolean); - procedure SetX(AValue: TFloatWithCSSUnit); - procedure SetY(AValue: TFloatWithCSSUnit); - procedure SetWidth(AValue: TFloatWithCSSUnit); - procedure SetHeight(AValue: TFloatWithCSSUnit); - procedure SetMaskUnits(AValue: TSVGObjectUnits); - procedure SetMaskContentUnits(AValue: TSVGObjectUnits); - protected - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property externalResourcesRequired: boolean - read GetExternalResourcesRequired write SetExternalResourcesRequired; - property x: TFloatWithCSSUnit read GetX write SetX; - property y: TFloatWithCSSUnit read GetY write SetY; - property width: TFloatWithCSSUnit read GetWidth write SetWidth; - property height: TFloatWithCSSUnit read GetHeight write SetHeight; - property maskUnits: TSVGObjectUnits read GetMaskUnits write SetMaskUnits; - property maskContentUnits: TSVGObjectUnits - read GetMaskContentUnits write SetMaskContentUnits; - end; - - TConvMethod = (cmNone,cmHoriz,cmVertical,cmOrtho); - - { TSVGGradient } - - TSVGGradient = class(TSVGElementWithContent) - private - function GetColorInterpolation: TSVGColorInterpolation; - function GetGradientMatrix(AUnit: TCSSUnit): TAffineMatrix; - function GetGradientTransform: string; - function GetGradientUnits: TSVGObjectUnits; - function GetHRef: string; - function GetSpreadMethod: TSVGSpreadMethod; - procedure SetColorInterpolation(AValue: TSVGColorInterpolation); - procedure SetGradientMatrix(AUnit: TCSSUnit; AValue: TAffineMatrix); - procedure SetGradientTransform(AValue: string); - procedure SetGradientUnits(AValue: TSVGObjectUnits); - procedure SetHRef(AValue: string); - procedure SetSpreadMethod(AValue: TSVGSpreadMethod); - protected - InheritedGradients: TSVGElementList;//(for HRef) - procedure Initialize; override; - function GetInheritedAttribute(AValue: string; - AConvMethod: TConvMethod; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; - public - destructor Destroy; override; - procedure ScanInheritedGradients(const forceScan: boolean = false); - property hRef: string read GetHRef write SetHRef; - property gradientUnits: TSVGObjectUnits read GetGradientUnits write SetGradientUnits; - property gradientTransform: string read GetGradientTransform write SetGradientTransform; - property gradientMatrix[AUnit: TCSSUnit]: TAffineMatrix read GetGradientMatrix write SetGradientMatrix; - property spreadMethod: TSVGSpreadMethod read GetSpreadMethod write SetSpreadMethod; - property colorInterpolation: TSVGColorInterpolation read GetColorInterpolation write SetColorInterpolation; - end; - - { TSVGGradientLinear } - - { TSVGLinearGradient } - - TSVGLinearGradient = class(TSVGGradient) - private - function GetX1: TFloatWithCSSUnit; - function GetX2: TFloatWithCSSUnit; - function GetY1: TFloatWithCSSUnit; - function GetY2: TFloatWithCSSUnit; - procedure SetX1(AValue: TFloatWithCSSUnit); - procedure SetX2(AValue: TFloatWithCSSUnit); - procedure SetY1(AValue: TFloatWithCSSUnit); - procedure SetY2(AValue: TFloatWithCSSUnit); - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property x1: TFloatWithCSSUnit read GetX1 write SetX1; - property y1: TFloatWithCSSUnit read GetY1 write SetY1; - property x2: TFloatWithCSSUnit read GetX2 write SetX2; - property y2: TFloatWithCSSUnit read GetY2 write SetY2; - end; - - { TSVGRadialGradient } - - TSVGRadialGradient = class(TSVGGradient) - private - function GetCX: TFloatWithCSSUnit; - function GetCY: TFloatWithCSSUnit; - function GetR: TFloatWithCSSUnit; - function GetFX: TFloatWithCSSUnit; - function GetFY: TFloatWithCSSUnit; - function GetFR: TFloatWithCSSUnit; - procedure SetCX(AValue: TFloatWithCSSUnit); - procedure SetCY(AValue: TFloatWithCSSUnit); - procedure SetR(AValue: TFloatWithCSSUnit); - procedure SetFX(AValue: TFloatWithCSSUnit); - procedure SetFY(AValue: TFloatWithCSSUnit); - procedure SetFR(AValue: TFloatWithCSSUnit); - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property cx: TFloatWithCSSUnit read GetCX write SetCX; - property cy: TFloatWithCSSUnit read GetCY write SetCY; - property r: TFloatWithCSSUnit read GetR write SetR; - property fx: TFloatWithCSSUnit read GetFX write SetFX; - property fy: TFloatWithCSSUnit read GetFY write SetFY; - property fr: TFloatWithCSSUnit read GetFR write SetFR; - end; - - { TSVGStopGradient } - - TSVGStopGradient = class(TSVGElement) - private - function GetOffset: TFloatWithCSSUnit; - function GetStopColor: TBGRAPixel; - function GetStopOpacity: single; - procedure SetOffset(AValue: TFloatWithCSSUnit); - procedure SetStopColor(AValue: TBGRAPixel); - procedure SetStopOpacity(AValue: single); - public - class function GetDOMTag: string; override; - property offset: TFloatWithCSSUnit read GetOffset write SetOffset; - property stopColor: TBGRAPixel read GetStopColor write SetStopColor; - property stopOpacity: single read GetStopOpacity write SetStopOpacity; - end; - - { TSVGDefine } - - TSVGDefine = class(TSVGElementWithContent) - public - class function GetDOMTag: string; override; - end; - - { TSVGGroup } - - TSVGGroup = class(TSVGElementWithContent) - private - function GetFontSize: TFloatWithCSSUnit; - function GetIsLayer: boolean; - function GetName: string; - procedure SetFontSize(AValue: TFloatWithCSSUnit); - procedure SetIsLayer(AValue: boolean); - procedure SetName(AValue: string); - protected - procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override; - class function OwnDatalink: boolean; override; - property fontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize; - public - class function GetDOMTag: string; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - property IsLayer: boolean read GetIsLayer write SetIsLayer; - property Name: string read GetName write SetName; - end; - - { TSVGLink } - - TSVGLink = class(TSVGGroup) - private - function GetTarget: string; - function GetXlinkHref: string; - function GetXlinkTitle: string; - procedure SetTarget(AValue: string); - procedure SetXlinkHref(AValue: string); - procedure SetXlinkTitle(AValue: string); - public - class function GetDOMTag: string; override; - property XlinkHref: string read GetXlinkHref write SetXlinkHref; - property XlinkTitle: string read GetXlinkTitle write SetXlinkTitle; - property Target: string read GetTarget write SetTarget; - end; - - { TSVGStyle } - - TSVGRuleset = record - selector, - declarations: string; - end; - ArrayOfTSVGStyleItem = packed array of TSVGRuleset; - - TSVGStyle = class(TSVGElement) - private - FRulesets: ArrayOfTSVGStyleItem; - function GetRulesetCount: integer; - procedure Parse(const s: String); - function IsValidRulesetIndex(const AIndex: integer): boolean; - function GetRuleset(const AIndex: integer): TSVGRuleset; - procedure SetRuleset(const AIndex: integer; sr: TSVGRuleset); - function Find(ARuleset: TSVGRuleset): integer; overload; - protected - procedure Initialize; override; - public - class function GetDOMTag: string; override; - constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; override; - destructor Destroy; override; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - function Count: Integer; - function Find(const AName: string): integer; overload; - function Add(ARuleset: TSVGRuleset): integer; - procedure Remove(ARuleset: TSVGRuleset); - procedure Clear; - procedure ReParse; - property Ruleset[AIndex: integer]: TSVGRuleset read GetRuleset write SetRuleset; - property RulesetCount: integer read GetRulesetCount; - end; - - { TSVGContent } - - TSVGContent = class - protected - FDataLink: TSVGDataLink; - FDomElem: TDOMElement; - FDoc: TDOMDocument; - FElements: TFPList; - FUnits: TCSSUnitConverter; - function GetDOMNode(AElement: TObject): TDOMNode; - function GetElementDOMNode(AIndex: integer): TDOMNode; - procedure AppendElement(AElement: TObject); overload; - function ExtractElementAt(AIndex: integer): TObject; - procedure InsertElementBefore(AElement: TSVGElement; ASuccessor: TSVGElement); - function GetElement(AIndex: integer): TSVGElement; - function GetElementObject(AIndex: integer): TObject; - function GetIsSVGElement(AIndex: integer): boolean; - function GetElementCount: integer; - function GetUnits: TCSSUnitConverter; - function TryCreateElementFromNode(ANode: TDOMNode): TObject; virtual; - public - constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; - ADataLink: TSVGDataLink); - destructor Destroy; override; - procedure Clear; - procedure ConvertToUnit(AUnit: TCSSUnit); - procedure Recompute; - procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit); overload; - procedure Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); overload; - function AppendElement(ASVGType: TSVGFactory): TSVGElement; overload; - procedure BringElement(AElement: TObject; AFromContent: TSVGContent); overload; - procedure CopyElement(AElement: TObject); - procedure RemoveElement(AElement: TObject); - function AppendDOMText(AText: string): TDOMText; - function AppendDefine: TSVGDefine; - function AppendLinearGradient(x1,y1,x2,y2: single; AIsPercent: boolean): TSVGLinearGradient; overload; - function AppendLinearGradient(x1,y1,x2,y2: single; AUnit: TCSSUnit): TSVGLinearGradient; overload; - function AppendRadialGradient(cx,cy,r,fx,fy,fr: single; AIsPercent: boolean): TSVGRadialGradient; overload; - function AppendRadialGradient(cx,cy,r,fx,fy,fr: single; AUnit: TCSSUnit): TSVGRadialGradient; overload; - function AppendStop(AColor: TBGRAPixel; AOffset: single; AIsPercent: boolean): TSVGStopGradient; - function AppendLine(x1,y1,x2,y2: single; AUnit: TCSSUnit = cuCustom): TSVGLine; overload; - function AppendLine(p1,p2: TPointF; AUnit: TCSSUnit = cuCustom): TSVGLine; overload; - function AppendCircle(cx,cy,r: single; AUnit: TCSSUnit = cuCustom): TSVGCircle; overload; - function AppendCircle(c: TPointF; r: single; AUnit: TCSSUnit = cuCustom): TSVGCircle; overload; - function AppendEllipse(cx,cy,rx,ry: single; AUnit: TCSSUnit = cuCustom): TSVGEllipse; overload; - function AppendEllipse(c,r: TPointF; AUnit: TCSSUnit = cuCustom): TSVGEllipse; overload; - function AppendPath(data: string; AUnit: TCSSUnit = cuCustom): TSVGPath; overload; - function AppendPath(path: TBGRAPath; AUnit: TCSSUnit = cuCustom): TSVGPath; overload; - function AppendPolygon(const points: array of single; AUnit: TCSSUnit = cuCustom): TSVGPolypoints; overload; - function AppendPolygon(const points: array of TPointF; AUnit: TCSSUnit = cuCustom): TSVGPolypoints; overload; - function AppendRect(x,y,width,height: single; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; - function AppendRect(origin,size: TPointF; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; - function AppendImage(x,y,width,height: single; ABitmap: TBGRACustomBitmap; ABitmapOwned: boolean; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; - function AppendImage(origin,size: TPointF; ABitmap: TBGRACustomBitmap; ABitmapOwned: boolean; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; - function AppendImage(x,y,width,height: single; ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; - function AppendImage(origin,size: TPointF; ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit = cuCustom): TSVGImage; overload; - function AppendText(x,y: single; AText: string; AUnit: TCSSUnit = cuCustom): TSVGText; overload; - function AppendText(origin: TPointF; AText: string; AUnit: TCSSUnit = cuCustom): TSVGText; overload; - function AppendTextSpan(AText: string): TSVGTSpan; - function AppendRoundRect(x,y,width,height,rx,ry: single; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; - function AppendRoundRect(origin,size,radius: TPointF; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload; - function AppendGroup: TSVGGroup; - function IndexOfElement(AElement: TObject): integer; - property ElementCount: integer read GetElementCount; - property Element[AIndex: integer]: TSVGElement read GetElement; - property ElementObject[AIndex: integer]: TObject read GetElementObject; - property ElementDOMNode[AIndex: integer]: TDOMNode read GetElementDOMNode; - property IsSVGElement[AIndex: integer]: boolean read GetIsSVGElement; - property Units: TCSSUnitConverter read GetUnits; - end; - -function GetSVGFactory(ATagName: string): TSVGFactory; -function CreateSVGElementFromNode(AElement: TDOMElement; AUnits: TCSSUnitConverter; - ADataLink: TSVGDataLink): TSVGElement; - -implementation - -uses BGRATransform, BGRAUTF8, base64, BGRAGradientScanner; - -function GetSVGFactory(ATagName: string): TSVGFactory; -var tag: string; -begin - tag := LowerCase(ATagName); - if tag='line' then - result := TSVGLine else - if tag='rect' then - result := TSVGRectangle else - if tag='circle' then - result := TSVGCircle else - if tag='ellipse' then - result := TSVGEllipse else - if tag='path' then - result := TSVGPath else - if (tag='polygon') or (tag='polyline') then - result := TSVGPolypoints else - if tag='text' then - result := TSVGText else - if tag='tspan' then - result := TSVGTSpan else - if tag='tref' then - result := TSVGTRef else - if tag='textpath' then - result := TSVGTextPath else - if tag='altglyph' then - result := TSVGAltGlyph else - if tag='altglyphdef' then - result := TSVGAltGlyphDef else - if tag='altglyphitem' then - result := TSVGAltGlyphItem else - if tag='glyphref' then - result := TSVGGlyphRef else - if tag='clippath' then - result := TSVGClipPath else - if tag='colorprofile' then - result := TSVGColorProfile else - if tag='image' then - result := TSVGImage else - if tag='pattern' then - result := TSVGPattern else - if tag='marker' then - result := TSVGMarker else - if tag='mask' then - result := TSVGMask else - if tag='lineargradient' then - result := TSVGLinearGradient else - if tag='radialgradient' then - result := TSVGRadialGradient else - if tag='stop' then - result := TSVGStopGradient else - if tag='defs' then - result := TSVGDefine else - if tag='g' then - result := TSVGGroup else - if tag='a' then - result := TSVGLink else - if tag='style' then - result := TSVGStyle else - result := TSVGElement; -end; - -function CreateSVGElementFromNode(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink): TSVGElement; -var - factory: TSVGFactory; -begin - factory := GetSVGFactory(AElement.TagName); - result := factory.Create(AElement,AUnits,ADataLink); -end; - -{ TSVGDefine } - -class function TSVGDefine.GetDOMTag: string; -begin - Result:= 'defs'; -end; - -{ TSVGLink } - -function TSVGLink.GetTarget: string; -begin - result := Attribute['target']; -end; - -function TSVGLink.GetXlinkHref: string; -begin - result := Attribute['xlink:href']; -end; - -function TSVGLink.GetXlinkTitle: string; -begin - result := Attribute['xlink:title']; -end; - -procedure TSVGLink.SetTarget(AValue: string); -begin - Attribute['target'] := AValue; -end; - -procedure TSVGLink.SetXlinkHref(AValue: string); -begin - Attribute['xlink:href'] := AValue; -end; - -procedure TSVGLink.SetXlinkTitle(AValue: string); -begin - Attribute['xlink:title'] := AValue; -end; - -class function TSVGLink.GetDOMTag: string; -begin - Result:= 'a'; -end; - -{ TSVGElementWithContent } - -class function TSVGElementWithContent.OwnDatalink: boolean; -begin - result := false; -end; - -procedure TSVGElementWithContent.SetDatalink(AValue: TSVGDataLink); -var - i: Integer; -begin - inherited SetDatalink(AValue); - if not OwnDatalink then - begin - for i := 0 to FContent.ElementCount-1 do - if FContent.IsSVGElement[i] then - FContent.Element[i].DataLink := AValue; - FContent.FDataLink := AValue; - end else - FSubDatalink.Parent := AValue; -end; - -constructor TSVGElementWithContent.Create(ADocument: TDOMDocument; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(ADocument, AUnits, ADataLink); - if OwnDatalink then - FSubDataLink := TSVGDataLink.Create(ADataLink) - else FSubDatalink := ADataLink; - FContent := TSVGContent.Create(FDomElem,AUnits,FSubDataLink); -end; - -constructor TSVGElementWithContent.Create(AElement: TDOMElement; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(AElement, AUnits, ADataLink); - if OwnDatalink then - FSubDataLink := TSVGDataLink.Create(ADataLink) - else FSubDatalink := ADataLink; - FContent := TSVGContent.Create(AElement,AUnits,FSubDataLink); -end; - -procedure TSVGElementWithContent.ListIdentifiers(AResult: TStringList); -var - i: Integer; -begin - inherited ListIdentifiers(AResult); - for i := 0 to Content.ElementCount-1 do - if Content.IsSVGElement[i] then - Content.Element[i].ListIdentifiers(AResult); -end; - -procedure TSVGElementWithContent.RenameIdentifiers(AFrom, ATo: TStringList); -var - i: Integer; -begin - inherited RenameIdentifiers(AFrom, ATo); - for i := 0 to Content.ElementCount-1 do - if Content.IsSVGElement[i] then - Content.Element[i].RenameIdentifiers(AFrom, ATo); -end; - -procedure TSVGElementWithContent.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - Content.ConvertToUnit(AUnit); -end; - -destructor TSVGElementWithContent.Destroy; -begin - FreeAndNil(FContent); - if OwnDatalink then FreeAndNil(FSubDatalink); - inherited Destroy; -end; - -procedure TSVGElementWithContent.Recompute; -begin - FContent.Recompute; - inherited Recompute; -end; - -{ TSVGElementWithGradient } - -procedure TSVGElementWithGradient.Initialize; -begin - inherited Initialize; - FRegisteredToDatalink:= false; - ResetGradients; -end; - -procedure TSVGElementWithGradient.ResetGradients; -begin - if FGradientElementsDefined then - begin - if Assigned(DataLink) and FRegisteredToDatalink then - begin - DataLink.RegisterLinkListener(@DatalinkOnLink, false); - FRegisteredToDatalink := false; - end; - FGradientElementsDefined := false; - end; - FFillGradientElement := nil; - FStrokeGradientElement := nil; - FFillCanvasGradient := nil; - FStrokeCanvasGradient := nil; -end; - -procedure TSVGElementWithGradient.FindGradientElements; -var - fillNotFound, strokeNotFound: boolean; -begin - if Assigned(FDataLink) then - begin - if FRegisteredToDatalink then - begin - FDataLink.RegisterLinkListener(@DatalinkOnLink, false); - FRegisteredToDatalink := false; - end; - FFillGradientElement := TSVGGradient(FDataLink.FindElementByRef(fill, true, TSVGGradient, fillNotFound)); - FStrokeGradientElement := TSVGGradient(FDataLink.FindElementByRef(stroke, true, TSVGGradient, strokeNotFound)); - if Assigned(FFillGradientElement) or fillNotFound or - Assigned(FStrokeGradientElement) or strokeNotFound then - begin - FDatalink.RegisterLinkListener(@DatalinkOnLink, true); - FRegisteredToDatalink := true; - end; - end else - begin - FFillGradientElement := nil; - FStrokeGradientElement := nil; - end; - if FFillGradientElement <> nil then - FFillGradientElement.ScanInheritedGradients; - if FStrokeGradientElement <> nil then - FStrokeGradientElement.ScanInheritedGradients; - FGradientElementsDefined:= true; -end; - -function TSVGElementWithGradient.EvaluatePercentage(fu: TFloatWithCSSUnit): single; -begin - Result:= fu.value; - if fu.CSSUnit <> cuPercent then - begin - if Result < 0 then - Result:= 0 - else if Result > 1 then - Result:= 1; - Result:= Result * 100; - end; -end; - -procedure TSVGElementWithGradient.DatalinkOnLink(Sender: TObject; - AElement: TSVGElement; ALink: boolean); -begin - if not ALink then - begin - if (AElement = FFillGradientElement) or (AElement = FStrokeGradientElement) then - ResetGradients; - end else - if ALink then - if FGradientElementsDefined and ((FFillGradientElement = nil) or (FStrokeGradientElement = nil)) then - ResetGradients; -end; - -function TSVGElementWithGradient.GetFillGradientElement: TSVGGradient; -begin - if not FGradientElementsDefined then - FindGradientElements; - result := FFillGradientElement; -end; - -function TSVGElementWithGradient.GetStrokeGradientElement: TSVGGradient; -begin - if not FGradientElementsDefined then - FindGradientElements; - result := FStrokeGradientElement; -end; - -procedure TSVGElementWithGradient.AddStopElements(ASVGGradient: TSVGGradient; canvas: IBGRACanvasGradient2D); - - function AddStopElementFrom(el: TSVGElement): integer; - var - i: integer; - begin - if el is TSVGGradient then - begin - if el.HasAttribute('color-interpolation') then - canvas.gammaCorrection:= TSVGGradient(el).colorInterpolation = sciLinearRGB; - if el.HasAttribute('spreadMethod') then - case TSVGGradient(el).spreadMethod of - ssmReflect: canvas.repetition := grReflect; - ssmRepeat: canvas.repetition := grRepeat; - else canvas.repetition:= grPad; - end; - end; - result:= 0; - with (el as TSVGGradient).Content do - for i:= 0 to ElementCount-1 do - if IsSVGElement[i] and (Element[i] is TSVGStopGradient) then - with TSVGStopGradient(Element[i]) do - begin - canvas.addColorStop(EvaluatePercentage(offset)/100, stopColor); - Inc(result); - end; - end; - -var - i: integer; -begin - if not Assigned(ASVGGradient) then exit; - with ASVGGradient.InheritedGradients do - for i:= 0 to Count-1 do - AddStopElementFrom(Items[i]); -end; - -function TSVGElementWithGradient.CreateCanvasLinearGradient( - ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; - const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; -var p1,p2: TPointF; - g: TSVGLinearGradient; - m: TAffineMatrix; -begin - g := ASVGGradient as TSVGLinearGradient; - if g.gradientUnits = souObjectBoundingBox then - begin - p1.x:= EvaluatePercentage(g.x1)/100; - p1.y:= EvaluatePercentage(g.y1)/100; - p2.x:= EvaluatePercentage(g.x2)/100; - p2.y:= EvaluatePercentage(g.y2)/100; - m := ACanvas2d.matrix; - ACanvas2d.translate(origin.x,origin.y); - ACanvas2d.scale(w,h); - ACanvas2d.transform(g.gradientMatrix[cuCustom]); - result:= ACanvas2d.createLinearGradient(p1,p2); - ACanvas2d.matrix := m; - end else - begin - p1.x:= Units.ConvertWidth(g.x1,AUnit,w).value; - p1.y:= Units.ConvertHeight(g.y1,AUnit,h).value; - p2.x:= Units.ConvertWidth(g.x2,AUnit,w).value; - p2.y:= Units.ConvertHeight(g.y2,AUnit,h).value; - m := ACanvas2d.matrix; - ACanvas2d.transform(g.gradientMatrix[AUnit]); - result:= ACanvas2d.createLinearGradient(p1,p2); - ACanvas2d.matrix := m; - end; - - AddStopElements(ASVGGradient, result); -end; - -function TSVGElementWithGradient.CreateCanvasRadialGradient( - ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; const origin: TPointF; - const w, h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D; -var c,f: TPointF; - r,fr: single; - g: TSVGRadialGradient; - m: TAffineMatrix; - - procedure CheckFocalAndCreate(c: TPointF; r: single; f: TPointF; fr: single); - var u: TPointF; - d: single; - begin - u := f-c; - d := VectLen(u); - if d >= r then - begin - u.Scale( (r/d)*0.99999 ); - f := c+u; - end; - result:= ACanvas2d.createRadialGradient(c,r,f,fr,true); - AddStopElements(ASVGGradient, result); - end; - -begin - g := ASVGGradient as TSVGRadialGradient; - if g.gradientUnits = souObjectBoundingBox then - begin - c.x:= EvaluatePercentage(g.cx)/100; - c.y:= EvaluatePercentage(g.cy)/100; - r:= abs(EvaluatePercentage(g.r))/100; - f.x:= EvaluatePercentage(g.fx)/100; - f.y:= EvaluatePercentage(g.fy)/100; - fr:= abs(EvaluatePercentage(g.fr))/100; - - m := ACanvas2d.matrix; - ACanvas2d.translate(origin.x,origin.y); - ACanvas2d.scale(w,h); - ACanvas2d.transform(g.gradientMatrix[cuCustom]); - CheckFocalAndCreate(c,r,f,fr); - ACanvas2d.matrix := m; - end else - begin - c.x:= Units.ConvertWidth(g.cx, AUnit, w).value; - c.y:= Units.ConvertHeight(g.cy, AUnit, h).value; - r:= abs(Units.ConvertOrtho(g.r, AUnit, w, h).value); - f.x:= Units.ConvertWidth(g.fx, AUnit, w).value; - f.y:= Units.ConvertHeight(g.fy, AUnit, h).value; - fr:= abs(Units.ConvertOrtho(g.fr, AUnit, w, h).value); - - m := ACanvas2d.matrix; - ACanvas2d.transform(g.gradientMatrix[AUnit]); - CheckFocalAndCreate(c,r,f,fr); - ACanvas2d.matrix := m; - end; -end; - -procedure TSVGElementWithGradient.InitializeGradient(ACanvas2d: TBGRACanvas2D; - const origin: TPointF; const w,h: single; AUnit: TCSSUnit); -begin - if FillGradientElement <> nil then - begin - if FillGradientElement is TSVGLinearGradient then - FFillCanvasGradient := CreateCanvasLinearGradient(ACanvas2d, FillGradientElement, origin, w,h, AUnit) - else if FillGradientElement is TSVGRadialGradient then - FFillCanvasGradient := CreateCanvasRadialGradient(ACanvas2d, FillGradientElement, origin, w,h, AUnit); - end; - if StrokeGradientElement <> nil then - begin - if StrokeGradientElement is TSVGLinearGradient then - FStrokeCanvasGradient := CreateCanvasLinearGradient(ACanvas2d, StrokeGradientElement, origin, w,h, AUnit) - else if StrokeGradientElement is TSVGRadialGradient then - FStrokeCanvasGradient := CreateCanvasRadialGradient(ACanvas2d, StrokeGradientElement, origin, w,h, AUnit); - end; -end; - -procedure TSVGElementWithGradient.ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); -begin - inherited ApplyFillStyle(ACanvas2D,AUnit); - if Assigned(FFillCanvasGradient) then - ACanvas2D.fillStyle(FFillCanvasGradient); -end; - -procedure TSVGElementWithGradient.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; - AUnit: TCSSUnit); -begin - inherited ApplyStrokeStyle(ACanvas2D,AUnit); - if Assigned(FStrokeCanvasGradient) then - ACanvas2D.strokeStyle(FStrokeCanvasGradient); -end; - -procedure TSVGElementWithGradient.SetDatalink(AValue: TSVGDataLink); -begin - ResetGradients; - inherited SetDatalink(AValue); -end; - -procedure TSVGElementWithGradient.SetFill(AValue: string); -begin - ResetGradients; - inherited SetFill(AValue); -end; - -procedure TSVGElementWithGradient.SetStroke(AValue: string); -begin - ResetGradients; - inherited SetStroke(AValue); -end; - -destructor TSVGElementWithGradient.Destroy; -begin - ResetGradients; - inherited Destroy; -end; - -{ TSVGTextElementWithContent } - -constructor TSVGTextElementWithContent.Create(ADocument: TDOMDocument; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(ADocument, AUnits, ADataLink); - FContent := TSVGContent.Create(FDomElem,AUnits,ADataLink); -end; - -constructor TSVGTextElementWithContent.Create(AElement: TDOMElement; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(AElement, AUnits, ADataLink); - FContent := TSVGContent.Create(AElement,AUnits,ADataLink); -end; - -destructor TSVGTextElementWithContent.Destroy; -begin - FreeAndNil(FContent); - inherited Destroy; -end; - -procedure TSVGTextElementWithContent.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - Content.ConvertToUnit(AUnit); -end; - -{ TSVGTextPositioning } - -function TSVGTextPositioning.GetX: ArrayOfTFloatWithCSSUnit; -begin - result := ArrayOfHorizAttributeWithUnitInherit['x',False]; -end; - -function TSVGTextPositioning.GetY: ArrayOfTFloatWithCSSUnit; -begin - result := ArrayOfVerticalAttributeWithUnitInherit['y',False]; -end; - -function TSVGTextPositioning.GetDx: ArrayOfTFloatWithCSSUnit; -begin - result := ArrayOfHorizAttributeWithUnitInherit['dx',False]; -end; - -function TSVGTextPositioning.GetDy: ArrayOfTFloatWithCSSUnit; -begin - result := ArrayOfVerticalAttributeWithUnitInherit['dy',False]; -end; - -function TSVGTextPositioning.GetRotate: ArrayOfTSVGNumber; -begin - result := ArrayOfAttributeNumberInherit['rotate',False]; -end; - -procedure TSVGTextPositioning.SetX(AValue: ArrayOfTFloatWithCSSUnit); -begin - ArrayOfHorizAttributeWithUnit['x'] := AValue; -end; - -procedure TSVGTextPositioning.SetY(AValue: ArrayOfTFloatWithCSSUnit); -begin - ArrayOfVerticalAttributeWithUnit['y'] := AValue; -end; - -procedure TSVGTextPositioning.SetDx(AValue: ArrayOfTFloatWithCSSUnit); -begin - ArrayOfHorizAttributeWithUnit['dx'] := AValue; -end; - -procedure TSVGTextPositioning.SetDy(AValue: ArrayOfTFloatWithCSSUnit); -begin - ArrayOfVerticalAttributeWithUnit['dy'] := AValue; -end; - -procedure TSVGTextPositioning.SetRotate(AValue: ArrayOfTSVGNumber); -begin - ArrayOfAttributeNumber['rotate'] := AValue; -end; - -procedure TSVGTextPositioning.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); - if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); - if HasAttribute('dx') then dx := Units.ConvertWidth(dx, AUnit); - if HasAttribute('dy') then dy := Units.ConvertHeight(dy, AUnit); -end; - -{ TSVGText } - -function TSVGText.GetFontBold: boolean; -var valueText: string; -begin - valueText := trim(fontWeight); - result := (valueText = 'bold') or (valueText = 'bolder') or - (valueText = '600') or (valueText = '700') or (valueText = '800') or - (valueText = '900'); -end; - -function TSVGText.GetFontFamily: string; -begin - result := AttributeOrStyleDef['font-family', 'sans-serif']; -end; - -function TSVGText.GetFontFamilyList: ArrayOfString; -begin - result := TBGRACanvas2D.StrToFontNameList(AttributeOrStyle['font-family']); -end; - -function TSVGText.GetFontItalic: boolean; -var valueText: string; -begin - valueText := trim(fontStyle); - result := (valueText = 'oblique') or (valueText = 'italic'); -end; - -function TSVGText.GetFontSize: TFloatWithCSSUnit; -begin - result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false); -end; - -function TSVGText.GetFontStyle: string; -begin - result := AttributeOrStyleDef['font-style','normal']; -end; - -function TSVGText.GetFontStyleLCL: TFontStyles; -var - s: String; -begin - result := []; - if fontBold then include(result, fsBold); - if fontItalic then include(result, fsItalic); - s := ' '+textDecoration+' '; - if pos('underline',s) <> 0 then include(result, fsUnderline); - if pos('line-through',s) <> 0 then include(result, fsStrikeOut); -end; - -function TSVGText.GetFontWeight: string; -begin - result := AttributeOrStyleDef['font-weight','normal']; -end; - -function TSVGText.GetSimpleText: string; -var - i: Integer; -begin - if FInGetSimpleText then exit(''); //avoid reentrance - FInGetSimpleText := true; - result := ''; - for i := 0 to FContent.ElementCount-1 do - if FContent.IsSVGElement[i] then - begin - if FContent.Element[i] is TSVGTRef then - AppendStr(result, GetTRefContent(TSVGTRef(FContent.Element[i])) ) - else - if FContent.Element[i] is TSVGText then - AppendStr(result, TSVGText(FContent.Element[i]).SimpleText); - end else - begin - if FContent.ElementDOMNode[i] is TDOMText then - AppendStr(result, UTF16ToUTF8(TDOMText(FContent.ElementDOMNode[i]).Data)); - end; - FInGetSimpleText := false; -end; - -function TSVGText.GetTextAnchor: TSVGTextAnchor; -begin - case AttributeOrStyleDef['text-anchor','start'] of - 'middle': result := staMiddle; - 'end': result := staEnd; - else result := staStart; - end; -end; - -function TSVGText.GetTextDirection: TSVGTextDirection; -begin - if AttributeOrStyle['direction'] = 'rtl' then - result := stdRtl - else - result := stdLtr; -end; - -function TSVGText.GetTextDecoration: string; -begin - result := AttributeOrStyleDef['text-decoration','none']; -end; - -function TSVGText.GetTextLength: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnitDef['textLength']; -end; - -function TSVGText.GetLengthAdjust: TSVGLengthAdjust; -var - valueText: string; -begin - valueText := trim(Attribute['lengthAdjust','spacing']); - if valueText = 'spacing' then - result := slaSpacing - else - result := slaSpacingAndGlyphs; -end; - -procedure TSVGText.SetFontBold(AValue: boolean); -begin - if AValue then fontWeight:= 'bold' else fontWeight:= 'normal'; -end; - -procedure TSVGText.SetFontFamily(AValue: string); -begin - Attribute['font-family'] := AValue; - RemoveStyle('font-family'); -end; - -procedure TSVGText.SetFontFamilyList(AValue: ArrayOfString); -begin - fontFamily := TBGRACanvas2D.FontNameListToStr(AValue); -end; - -procedure TSVGText.SetFontItalic(AValue: boolean); -begin - if AValue then fontStyle:= 'italic' else fontStyle:= 'normal'; -end; - -procedure TSVGText.SetFontSize(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['font-size'] := AValue; -end; - -procedure TSVGText.SetFontStyle(AValue: string); -begin - Attribute['font-style'] := AValue; - RemoveStyle('font-style'); -end; - -procedure TSVGText.SetFontStyleLCL(AValue: TFontStyles); -var - s: String; -begin - fontItalic:= fsItalic in AValue; - fontBold:= fsBold in AValue; - s := ''; - if fsUnderline in AValue then AppendStr(s, 'underline '); - if fsStrikeOut in AValue then AppendStr(s, 'line-through '); - textDecoration:= trim(s); -end; - -procedure TSVGText.SetFontWeight(AValue: string); -begin - Attribute['font-weight'] := AValue; - RemoveStyle('font-weight'); -end; - -procedure TSVGText.SetTextAnchor(AValue: TSVGTextAnchor); -begin - case AValue of - staMiddle: Attribute['text-anchor'] := 'middle'; - staEnd: Attribute['text-anchor'] := 'end'; - else {staStart} Attribute['text-anchor'] := 'start'; - end; -end; - -procedure TSVGText.SetTextDirection(AValue: TSVGTextDirection); -begin - if AValue = stdLtr then - Attribute['direction'] := 'ltr' - else - Attribute['direction'] := 'rtl'; -end; - -procedure TSVGText.SetSimpleText(AValue: string); -begin - Content.Clear; - if AValue = '' then exit; - Content.appendDOMText(AValue); -end; - -procedure TSVGText.SetTextDecoration(AValue: string); -begin - Attribute['text-decoration'] := AValue; - RemoveStyle('text-decoration'); -end; - -procedure TSVGText.SetTextLength(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['textLength'] := AValue; - RemoveStyle('textLength'); -end; - -procedure TSVGText.SetLengthAdjust(AValue: TSVGLengthAdjust); -begin - if AValue = slaSpacing then - Attribute['lengthAdjust'] := 'spacing' - else - Attribute['lengthAdjust'] := 'spacingAndGlyphs'; - RemoveStyle('lengthAdjust'); -end; - -procedure TSVGText.InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; - AUnit: TCSSUnit; ADraw: boolean; AAllTextBounds: TRectF; - var APosition: TPointF; var ATextParts: ArrayOfTextParts); -begin - if not ADraw then ATextParts[0].AbsoluteCoord := APosition; - InternalDrawOrCompute(ACanvas2d, AUnit, ADraw, AAllTextBounds, APosition, ATextParts, 0,0,high(ATextParts)); -end; - -procedure TSVGText.InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; - AUnit: TCSSUnit; ADraw: boolean; AAllTextBounds: TRectF; - var APosition: TPointF; var ATextParts: ArrayOfTextParts; - ALevel: integer; AStartPart, AEndPart: integer); -var - prevFontSize: TFloatWithCSSUnit; - ax, ay, adx, ady: ArrayOfTFloatWithCSSUnit; - i, subStartPart, subEndPart, subLevel: integer; - subElem: TSVGText; - partBounds: TRectF; -begin - if AStartPart > AEndPart then exit; - - prevFontSize := EnterFontSize; - - if not ADraw then - begin - ax := Units.ConvertWidth(x,AUnit); - ay := Units.ConvertHeight(y,AUnit); - if length(ax)>0 then APosition.x := ax[0].value; - if length(ay)>0 then APosition.y := ay[0].value; - if (length(ax)>0) or (length(ay)>0) then - ATextParts[AStartPart].AbsoluteCoord := APosition; - end else - APosition := ATextParts[AStartPart].AbsoluteCoord; - - adx := Units.ConvertWidth(dx,AUnit); - ady := Units.ConvertHeight(dy,AUnit); - if length(adx)>0 then IncF(APosition.x, adx[0].value); - if length(ady)>0 then IncF(APosition.y, ady[0].value); - - i := AStartPart; - while i <= AEndPart do - begin - if ATextParts[i].Level > ALevel then - begin - subStartPart := i; - subEndPart := i; - subElem := TSVGText(ATextParts[subStartPart].BaseElement); - subLevel := ATextParts[subStartPart].Level; - while (subEndPart < AEndPart) and - ( ((ATextParts[subEndPart+1].Level = subLevel) and (ATextParts[subEndPart+1].BaseElement = subElem)) or - (ATextParts[subEndPart+1].Level > subLevel) ) do - inc(subEndPart); - subElem.InternalDrawOrCompute( - ACanvas2d, AUnit, ADraw, AAllTextBounds, APosition, - ATextParts, subLevel, subStartPart, subEndPart); - i := subEndPart+1; - end - else - begin - if not ADraw then - ATextParts[i].PartStartCoord := APosition - else - APosition := ATextParts[i].PartStartCoord; - - if ATextParts[i].Text <>'' then - InternalDrawOrComputePart(ACanvas2d, AUnit, ATextParts[i].Text, ATextParts[i].PosUnicode, - ATextParts[i].InheritedRotation, ADraw, AAllTextBounds, APosition, partBounds) - else - partBounds := EmptyRectF; - - if not ADraw then - begin - ATextParts[i].PartEndCoord := APosition; - ATextParts[i].Bounds := partBounds; - end - else - APosition := ATextParts[i].PartEndCoord; - - inc(i); - end; - end; - - ExitFontSize(prevFontSize); -end; - -procedure TSVGText.InternalDrawOrComputePart(ACanvas2d: TBGRACanvas2D; - AUnit: TCSSUnit; AText: string; APosUnicode: integer; AInheritedRotation: single; - ADraw: boolean; AAllTextBounds: TRectF; var APosition: TPointF; out ABounds: TRectF); -var - ts: TCanvas2dTextSize; - fs: TFontStyles; - dir: TSVGTextDirection; - deco: String; - fh: TFloatWithCSSUnit; - rotations: ArrayOfTSVGNumber; - glyphSizes: array of single; - glyphByGlyph: Boolean; - cursor: TGlyphCursorUtf8; - glyph: TGlyphUtf8; - posGlyph: integer; - curPos: TPointF; - curRotation, firstRotation: single; - posUnicode, i: integer; - adx, ady, ax, ay: ArrayOfTFloatWithCSSUnit; -begin - fh := Units.CurrentFontEmHeight; - ACanvas2d.fontEmHeight := Units.ConvertHeight(fh, AUnit).value; - ACanvas2d.fontName := fontFamily; - fs := []; - if fontBold then include(fs, fsBold); - if fontItalic then include(fs, fsItalic); - deco := ' '+textDecoration+' '; - if pos(' line-through ',deco)<>0 then include(fs, fsStrikeOut); - if pos(' underline ',deco)<>0 then include(fs, fsUnderline); - ACanvas2d.fontStyle := fs; - dir := textDirection; - case dir of - stdRtl: ACanvas2d.direction:= fbmRightToLeft; - else {stdLtr} ACanvas2d.direction:= fbmLeftToRight; - end; - ACanvas2d.textBaseline:= 'alphabetic'; - - rotations := rotate; - if (length(rotations) <> 0) and - (APosUnicode >= length(rotations)) then - begin - firstRotation := rotations[high(rotations)]; - glyphByGlyph:= true; - end else - begin - firstRotation:= AInheritedRotation; - glyphByGlyph:= firstRotation <> 0; - end; - for i := APosUnicode to APosUnicode + UTF8Length(AText) - 1 do - if i >= length(rotations) then break else - if rotations[i] <> 0 then glyphByGlyph := true; - ax := x; - ay := y; - adx := dx; - ady := dy; - for i := APosUnicode + 1 to APosUnicode + UTF8Length(AText) - 1 do - begin - if (i < length(ax)) or (i < length(ay)) then glyphByGlyph:= true; - if (i < length(adx)) and (adx[i].value <> 0) then glyphByGlyph := true; - if (i < length(ady)) and (ady[i].value <> 0) then glyphByGlyph := true; - end; - - if glyphByGlyph then - begin - ts.width:= 0; - ts.height := 0; - cursor := TGlyphCursorUtf8.New(AText, ACanvas2d.direction); - setlength(glyphSizes, length(AText)); //more than enough - posGlyph := 0; - repeat - glyph := cursor.GetNextGlyph; - if glyph.Empty then break; - with ACanvas2d.measureText(glyph.GlyphUtf8) do - begin - incF(ts.Width, width); - if height > ts.Height then ts.Height := height; - glyphSizes[posGlyph] := width; - end; - inc(posGlyph); - until false; - end else - begin - ts := ACanvas2d.measureText(AText); - glyphSizes := nil; - end; - - if dir = stdRtl then DecF(APosition.x, ts.width); - - ABounds := RectF(APosition.x,APosition.y,APosition.x+ts.width,APosition.y+ts.height); - if ADraw then - begin - ACanvas2d.beginPath; - InitializeGradient(ACanvas2d, AAllTextBounds.TopLeft, AAllTextBounds.Width,AAllTextBounds.Height,AUnit); - if glyphByGlyph then - begin - curPos := APosition; - curRotation := firstRotation; - posGlyph := 0; - cursor := TGlyphCursorUtf8.New(AText, ACanvas2d.direction); - repeat - glyph := cursor.GetNextGlyph; - if glyph.Empty then break; - posUnicode := APosUnicode + UTF8Length(copy(AText, 1, glyph.ByteOffset)); - if posUnicode < length(rotations) then - curRotation := rotations[posUnicode]; - ACanvas2d.save; - ACanvas2d.translate(curPos.x, curPos.y); - ACanvas2d.rotate(curRotation*Pi/180); - if glyph.Mirrored then - begin - if glyph.MirroredGlyphUtf8 <> '' then - ACanvas2d.text(glyph.GlyphUtf8, 0, 0) else - begin - ACanvas2d.translate(glyphSizes[posGlyph], 0); - ACanvas2d.scale(-1,0); - ACanvas2d.text(glyph.GlyphUtf8, 0, 0); - end; - end else - ACanvas2d.text(glyph.GlyphUtf8, 0, 0); - ACanvas2d.restore; - IncF(curPos.x, glyphSizes[posGlyph]); - for i := 1 to UTF8Length(copy(AText, glyph.ByteOffset+1, glyph.ByteSize)) do - begin - if posUnicode + i < length(ax) then curPos.x := Units.ConvertWidth(ax[posUnicode + i], AUnit).value; - if posUnicode + i < length(ay) then curPos.y := Units.ConvertHeight(ay[posUnicode + i], AUnit).value; - if posUnicode + i < length(adx) then incF(curPos.x, Units.ConvertWidth(adx[posUnicode + i], AUnit).value); - if posUnicode + i < length(ady) then incF(curPos.y, Units.ConvertHeight(ady[posUnicode + i], AUnit).value); - end; - inc(posGlyph); - until false; - end else - ACanvas2d.text(AText,APosition.x,APosition.y); - Paint(ACanvas2D, AUnit); - end; - - if dir = stdLtr then IncF(APosition.x, ts.width); -end; - -procedure TSVGText.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - allTextBounds: TRectF; - textParts: ArrayOfTextParts; - anchor: TSVGTextAnchor; - - procedure DoAlignText(AStartPart,AEndPart: integer); - var - advance,ofs: single; - j: Integer; - begin - advance := textParts[AEndPart].PartEndCoord.x - textParts[AStartPart].AbsoluteCoord.x; - ofs := 0; - - case anchor of - staMiddle: ofs := (-1/2)*advance; - staEnd: ofs := -advance; - else ofs := 0; - end; - - for j := AStartPart to AEndPart do - begin - if not isEmptyPointF(textParts[j].AbsoluteCoord) then IncF(textParts[j].AbsoluteCoord.x, ofs); - if not isEmptyPointF(textParts[j].PartStartCoord) then IncF(textParts[j].PartStartCoord.x, ofs); - if not isEmptyPointF(textParts[j].PartEndCoord) then IncF(textParts[j].PartEndCoord.x, ofs); - if not IsEmptyRectF(textParts[j].Bounds) then textParts[j].Bounds.Offset(ofs,0); - end; - end; - -var - i, absStartIndex: Integer; - pos: TPointF; -begin - textParts := GetAllText(0); - CleanText(textParts); - if length(textParts)>0 then - begin - pos := PointF(0,0); - InternalDrawOrCompute(ACanvas2d, AUnit, False, EmptyRectF, pos, textParts); - - anchor := textAnchor; - - absStartIndex := -1; - for i := 0 to high(textParts) do - begin - if not IsEmptyPointF(textParts[i].AbsoluteCoord) then - begin - if absStartIndex <> -1 then DoAlignText(absStartIndex,i-1); - absStartIndex := i; - end; - end; - if absStartIndex <> -1 then DoAlignText(absStartIndex,high(textParts)); - - allTextBounds := EmptyRectF; - for i := 0 to high(textParts) do - allTextBounds := allTextBounds.Union(textParts[i].Bounds); - - pos := PointF(0,0); - InternalDrawOrCompute(ACanvas2d, AUnit, True, allTextBounds, pos, textParts); - end; -end; - -procedure TSVGText.CleanText(var ATextParts: ArrayOfTextParts); -var wasSpace: boolean; - wasSpaceBeforePartIdx: integer; - i,j: integer; - k,l, startPos, endPosP1: integer; - fullText, cleanedText: string; -begin - wasSpace := false; - wasSpaceBeforePartIdx:= -1; - fullText := ''; - for k := 0 to high(ATextParts) do - AppendStr(fullText, ATextParts[k].Text); - - setlength(cleanedText, length(fullText)); - j := 0; - k := 0; - for i := 1 to length(fullText) do - begin - if not (fullText[i] in[#0..#32]) and wasSpace and (j>0) then - begin - inc(j); - cleanedText[j] := ' '; - if wasSpaceBeforePartIdx <> -1 then - for l := wasSpaceBeforePartIdx to k-1 do - inc(ATextParts[l].SplitPos); - wasSpace:= false; - end; - while (k < length(ATextParts)) and (i = ATextParts[k].SplitPos) do - begin - if wasSpace and (wasSpaceBeforePartIdx = -1) then - wasSpaceBeforePartIdx:= k; - ATextParts[k].SplitPos := j+1; - inc(k); - end; - if fullText[i] in[#0..#32] then - wasSpace := true - else - begin - inc(j); - cleanedText[j] := fullText[i]; - wasSpace := false; - wasSpaceBeforePartIdx := -1; - end; - end; - while k < length(ATextParts) do - begin - ATextParts[k].SplitPos := j+1; - inc(k); - end; - setlength(cleanedText, j); - - for k := 0 to high(ATextParts) do - begin - startPos := ATextParts[k].SplitPos; - if k = high(ATextParts) then endPosP1 := j+1 else - endPosP1 := ATextParts[k+1].SplitPos; - ATextParts[k].Text:= copy(cleanedText, startPos, endPosP1 - startPos); - end; -end; - -function TSVGText.GetTRefContent(AElement: TSVGTRef): string; -var - refText: TSVGText; -begin - if Assigned(FDataLink) then - refText := TSVGText(FDataLink.FindElementByRef(AElement.xlinkHref, TSVGText)) - else refText := nil; - if Assigned(refText) then result := refText.SimpleText else result := ''; -end; - -function TSVGText.GetAllText(AInheritedRotation: single): ArrayOfTextParts; -var - idxOut,curLen: Integer; - posUnicode: integer; - - procedure AppendPart(AText: string); - begin - if (idxOut > 0) and (result[idxOut-1].Text = '') - and (result[idxOut-1].BaseElement = self) then dec(idxOut); - result[idxOut].Level := 0; - result[idxOut].BaseElement:= self; - result[idxOut].Text := AText; - result[idxOut].SplitPos:= curLen+1; - result[idxOut].AbsoluteCoord := EmptyPointF; - result[idxOut].PartStartCoord := EmptyPointF; - result[idxOut].Bounds := EmptyRectF; - result[idxOut].PosUnicode := posUnicode; - result[idxOut].InheritedRotation:= AInheritedRotation; - inc(curLen, length(AText)); - inc(idxOut); - inc(posUnicode, UTF8Length(AText)); - end; - -var - i,j: integer; - svgElem: TSVGElement; - subParts: ArrayOfTextParts; - node: TDOMNode; - rotations: ArrayOfTSVGNumber; - inheritedRotation: TSVGNumber; - -begin - setlength(result, Content.ElementCount+1); - idxOut := 0; - curLen := 0; - posUnicode := 0; - AppendPart(''); //needed when there is a sub part to know the base element - for i := 0 to Content.ElementCount-1 do - begin - if Content.IsSVGElement[i] then - begin - svgElem := Content.Element[i]; - if svgElem is TSVGTRef then - AppendPart(GetTRefContent(TSVGTRef(svgElem))) - else - if svgElem is TSVGText then - begin - rotations := rotate; - if posUnicode = 0 then inheritedRotation:= AInheritedRotation else - if posUnicode-1 >= length(rotations) then - begin - if rotations <> nil then - inheritedRotation:= rotations[high(rotations)] - else inheritedRotation := 0; - end else - inheritedRotation := rotations[posUnicode-1]; - subParts := TSVGText(svgElem).GetAllText(inheritedRotation); - if length(subParts) > 0 then - begin - setlength(result, length(result)+length(subParts)-1); - for j := 0 to high(subParts) do - begin - result[idxOut] := subParts[j]; - inc(result[idxOut].Level); - result[idxOut].SplitPos:= curLen+1; - inc(curLen, length(result[idxOut].Text)); - inc(idxOut); - end; - end else - AppendPart(''); - end; - end else - begin - node := Content.ElementDOMNode[i]; - if node is TDOMText then - AppendPart(UTF16ToUTF8(TDOMText(node).Data)); - end; - end; - setlength(result, idxOut); -end; - -class function TSVGText.GetDOMTag: string; -begin - Result:= 'text'; -end; - -procedure TSVGText.ConvertToUnit(AUnit: TCSSUnit); -var - prevFontSize: TFloatWithCSSUnit; -begin - prevFontSize := EnterFontSize; - inherited ConvertToUnit(AUnit); - if HasAttribute('textLength') then textLength := Units.ConvertWidth(textLength, AUnit); - if HasAttribute('font-size') then - SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit)); - ExitFontSize(prevFontSize); -end; - -{ TSVGTSpan } - -class function TSVGTSpan.GetDOMTag: string; -begin - Result:= 'tspan'; -end; - -{ TSVGTRef } - -function TSVGTRef.GetXlinkHref: string; -begin - result := Attribute['xlink:href']; -end; - -procedure TSVGTRef.SetXlinkHref(AValue: string); -begin - Attribute['xlink:href'] := AValue; -end; - -class function TSVGTRef.GetDOMTag: string; -begin - Result:= 'tref'; -end; - -{ TSVGTextPath } - -function TSVGTextPath.GetStartOffset: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnitDef['startOffset']; -end; - -function TSVGTextPath.GetMethod: TSVGTextPathMethod; -var - valueText: string; -begin - valueText := trim(Attribute['method','align']); - if valueText = 'align' then - result := stpmAlign - else - result := stpmStretch; -end; - -function TSVGTextPath.GetSpacing: TSVGTextPathSpacing; -var - valueText: string; -begin - valueText := trim(Attribute['spacing','exact']); - if valueText = 'exact' then - result := stpsExact - else - result := stpsAuto; -end; - -function TSVGTextPath.GetXlinkHref: string; -begin - result := Attribute['xlink:href']; -end; - -procedure TSVGTextPath.SetStartOffset(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['startOffset'] := AValue; - RemoveStyle('startOffset'); -end; - -procedure TSVGTextPath.SetMethod(AValue: TSVGTextPathMethod); -begin - if AValue = stpmAlign then - Attribute['method'] := 'align' - else - Attribute['method'] := 'stretch'; - RemoveStyle('method'); -end; - -procedure TSVGTextPath.SetSpacing(AValue: TSVGTextPathSpacing); -begin - if AValue = stpsExact then - Attribute['spacing'] := 'exact' - else - Attribute['spacing'] := 'auto'; - RemoveStyle('spacing'); -end; - -procedure TSVGTextPath.SetXlinkHref(AValue: string); -begin - Attribute['xlink:href'] := AValue; -end; - -procedure TSVGTextPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGTextPath.GetDOMTag: string; -begin - Result:= 'textpath'; -end; - -procedure TSVGTextPath.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('startOffset') then startOffset := Units.ConvertWidth(startOffset, AUnit); -end; - -{ TSVGAltGlyph } - -function TSVGAltGlyph.GetGlyphRef: string; -begin - result := Attribute['glyphRef','']; -end; - -function TSVGAltGlyph.GetFormat: string; -begin - result := Attribute['format','']; -end; - -function TSVGAltGlyph.GetXlinkHref: string; -begin - result := Attribute['xlink:href']; -end; - -procedure TSVGAltGlyph.SetGlyphRef(AValue: string); -begin - Attribute['glyphRef'] := AValue; -end; - -procedure TSVGAltGlyph.SetFormat(AValue: string); -begin - Attribute['format'] := AValue; -end; - -procedure TSVGAltGlyph.SetXlinkHref(AValue: string); -begin - Attribute['xlink:href'] := AValue; -end; - -procedure TSVGAltGlyph.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGAltGlyph.GetDOMTag: string; -begin - Result:= 'altglyph'; -end; - -{ TSVGAltGlyphDef } - -class function TSVGAltGlyphDef.GetDOMTag: string; -begin - Result:= 'altglyphdef'; -end; - -{ TSVGAltGlyphItem } - -class function TSVGAltGlyphItem.GetDOMTag: string; -begin - Result:= 'altglyphitem'; -end; - -{ TSVGGlyphRef } - -function TSVGGlyphRef.GetX: TSVGNumber; -begin - result := HorizAttribute['x']; -end; - -function TSVGGlyphRef.GetY: TSVGNumber; -begin - result := VerticalAttribute['y']; -end; - -function TSVGGlyphRef.GetDx: TSVGNumber; -begin - result := HorizAttribute['dx']; -end; - -function TSVGGlyphRef.GetDy: TSVGNumber; -begin - result := VerticalAttribute['dy']; -end; - -function TSVGGlyphRef.GetGlyphRef: string; -begin - result := Attribute['glyphRef','']; -end; - -function TSVGGlyphRef.GetFormat: string; -begin - result := Attribute['format','']; -end; - -function TSVGGlyphRef.GetXlinkHref: string; -begin - result := Attribute['xlink:href']; -end; - -procedure TSVGGlyphRef.SetX(AValue: TSVGNumber); -begin - HorizAttribute['x'] := AValue; -end; - -procedure TSVGGlyphRef.SetY(AValue: TSVGNumber); -begin - VerticalAttribute['y'] := AValue; -end; - -procedure TSVGGlyphRef.SetDx(AValue: TSVGNumber); -begin - HorizAttribute['dx'] := AValue; -end; - -procedure TSVGGlyphRef.SetDy(AValue: TSVGNumber); -begin - HorizAttribute['dy'] := AValue; -end; - -procedure TSVGGlyphRef.SetGlyphRef(AValue: string); -begin - Attribute['glyphRef'] := AValue; -end; - -procedure TSVGGlyphRef.SetFormat(AValue: string); -begin - Attribute['format'] := AValue; -end; - -procedure TSVGGlyphRef.SetXlinkHref(AValue: string); -begin - Attribute['xlink:href'] := AValue; -end; - -procedure TSVGGlyphRef.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGGlyphRef.GetDOMTag: string; -begin - Result:= 'glyphref'; -end; - -{ TSVGClipPath } - -function TSVGClipPath.GetExternalResourcesRequired: boolean; -begin - if Attribute['externalResourcesRequired'] = 'true' then - result := true - else - result := false; -end; - -function TSVGClipPath.GetClipPathUnits: TSVGObjectUnits; -begin - if Attribute['clipPathUnits'] = 'objectBoundingBox' then - result := souObjectBoundingBox - else - result := souUserSpaceOnUse; -end; - -procedure TSVGClipPath.SetExternalResourcesRequired(AValue: boolean); -begin - if AValue then - Attribute['ExternalResourcesRequired'] := 'true' - else - Attribute['ExternalResourcesRequired'] := 'false'; -end; - -procedure TSVGClipPath.SetClipPathUnits(AValue: TSVGObjectUnits); -begin - if AValue = souUserSpaceOnUse then - Attribute['clipPathUnits'] := 'userSpaceOnUse' - else - Attribute['clipPathUnits'] := 'objectBoundingBox'; -end; - -procedure TSVGClipPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGClipPath.GetDOMTag: string; -begin - Result:= 'clippath'; -end; - -{ TSVGColorProfile } - -function TSVGColorProfile.GetLocal: string; -begin - result := Attribute['local']; -end; - -function TSVGColorProfile.GetName: string; -begin - result := Attribute['name']; -end; - -function TSVGColorProfile.GetRenderingIntent: TSVGRenderingIntent; -var - s: string; -begin - s := Attribute['rendering-intent','auto']; - if s = 'auto' then - result := sriAuto - else if s = 'perceptual' then - result := sriPerceptual - else if s = 'relative-colorimetric' then - result := sriRelativeColorimetric - else if s = 'saturation' then - result := sriSaturation - else { 'absolute-colorimetric' } - result := sriAbsoluteColorimetric; -end; - -function TSVGColorProfile.GetXlinkHref: string; -begin - result := Attribute['xlink:href']; -end; - -procedure TSVGColorProfile.SetLocal(AValue: string); -begin - Attribute['local'] := AValue; -end; - -procedure TSVGColorProfile.SetName(AValue: string); -begin - Attribute['name'] := AValue; -end; - -procedure TSVGColorProfile.SetRenderingIntent(AValue: TSVGRenderingIntent); -begin - if AValue = sriAuto then - Attribute['rendering-intent'] := 'auto' - else if AValue = sriPerceptual then - Attribute['rendering-intent'] := 'perceptual' - else if AValue = sriRelativeColorimetric then - Attribute['rendering-intent'] := 'relative-colorimetric' - else if AValue = sriSaturation then - Attribute['rendering-intent'] := 'saturation' - else { sriAbsoluteColorimetric } - Attribute['rendering-intent'] := 'absolute-colorimetric' -end; - -procedure TSVGColorProfile.SetXlinkHref(AValue: string); -begin - Attribute['xlink:href'] := AValue; -end; - -procedure TSVGColorProfile.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGColorProfile.GetDOMTag: string; -begin - Result:= 'colorprofile'; -end; - -{ TSVGImage } - -function TSVGImage.GetBitmap: TBGRACustomBitmap; -var - s: String; - posDelim: SizeInt; - stream64: TStringStream; - decoder: TBase64DecodingStream; - byteStream: TMemoryStream; -begin - if FBitmap = nil then - begin - FBitmap := BGRABitmapFactory.Create; - s := xlinkHref; - if copy(s,1,5) = 'data:' then - begin - posDelim := pos(';', s); - if posDelim > 0 then - begin - if copy(s, posDelim+1, 7) = 'base64,' then - begin - byteStream := TMemoryStream.Create; - try - stream64 := TStringStream.Create(s); - try - stream64.Position:= posDelim+7; - decoder := TBase64DecodingStream.Create(stream64, bdmMIME); - try - byteStream.CopyFrom(decoder, decoder.Size); - byteStream.Position:= 0; - finally - decoder.Free; - end; - finally - stream64.Free; - end; - try - FBitmap.LoadFromStream(byteStream); - except - on ex: exception do - begin - //image discarded if error - FBitmap.SetSize(0, 0); - end; - end; - finally - byteStream.Free; - end; - end; - end; - end; - end; - result := FBitmap; -end; - -function TSVGImage.GetExternalResourcesRequired: boolean; -begin - if Attribute['externalResourcesRequired'] = 'true' then - result := true - else - result := false; -end; - -function TSVGImage.GetImageRendering: TSVGImageRendering; -var s: string; -begin - s := AttributeOrStyle['image-rendering']; - if (s = 'smooth') or (s = 'optimizeQuality') then result := sirSmooth - else if s = 'high-quality' then result := sirHighQuality - else if s = 'crisp-edges' then result := sirCrispEdges - else if (s = 'pixelated') or (s = 'optimizeSpeed') then result := sirPixelated - else result := sirAuto; -end; - -function TSVGImage.GetX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['x']; -end; - -function TSVGImage.GetY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['y']; -end; - -function TSVGImage.GetWidth: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['width']; -end; - -function TSVGImage.GetHeight: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['height']; -end; - -function TSVGImage.GetPreserveAspectRatio: TSVGPreserveAspectRatio; -begin - result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']); -end; - -function TSVGImage.GetXlinkHref: string; -begin - result := Attribute['xlink:href']; -end; - -procedure TSVGImage.SetBitmap(AValue: TBGRACustomBitmap; AOwned: boolean); -var - byteStream: TMemoryStream; -begin - if AValue = FBitmap then exit; - FreeAndNil(FBitmap); - if AOwned then - FBitmap := AValue - else FBitmap := AValue.Duplicate; - if FBitmap = nil then - begin - FDomElem.RemoveAttribute('xlink:href'); - FDomElem.RemoveAttribute('href'); - exit; - end; - byteStream := TMemoryStream.Create; - try - FBitmap.SaveToStreamAsPng(byteStream); - SetBitmap(byteStream, 'image/png'); - finally - byteStream.Free; - end; -end; - -procedure TSVGImage.SetBitmap(AStream: TStream; AMimeType: string); -var - s: TStringStream; - encoder: TBase64EncodingStream; -begin - s := TStringStream.Create('data:'+AMimeType+';base64,'); - encoder := nil; - try - encoder := TBase64EncodingStream.Create(s); - s.Position:= s.Size; - AStream.Position := 0; - encoder.CopyFrom(AStream, AStream.Size); - encoder.Flush; - xlinkHref:= s.DataString; - finally - encoder.Free; - s.Free; - end; -end; - -procedure TSVGImage.SetExternalResourcesRequired(AValue: boolean); -begin - if AValue then - Attribute['ExternalResourcesRequired'] := 'true' - else - Attribute['ExternalResourcesRequired'] := 'false'; -end; - -procedure TSVGImage.SetImageRendering(AValue: TSVGImageRendering); -var s: string; -begin - case AValue of - sirSmooth: s := 'smooth'; - sirHighQuality: s := 'high-quality'; - sirCrispEdges: s := 'crisp-edges'; - sirPixelated: s := 'pixelated'; - else {sirAuto} s := 'auto'; - end; -end; - -procedure TSVGImage.SetX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['x'] := AValue; -end; - -procedure TSVGImage.SetY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['y'] := AValue; -end; - -procedure TSVGImage.SetWidth(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['width'] := AValue; -end; - -procedure TSVGImage.SetHeight(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['height'] := AValue; -end; - -procedure TSVGImage.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); -begin - Attribute['preserveAspectRatio'] := AValue.ToString; -end; - -procedure TSVGImage.SetXlinkHref(AValue: string); -begin - if xlinkHref = AValue then exit; - Attribute['xlink:href'] := AValue; - FreeAndNil(FBitmap); -end; - -procedure TSVGImage.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - aspect: TSVGPreserveAspectRatio; - coord: TPointF; - w, h: single; - ratioBitmap: single; - ratioPresentation: Single; - visualW, visualH: single; - filter: TResampleFilter; -begin - coord := PointF(Units.ConvertWidth(x, AUnit).value, - Units.ConvertHeight(y, AUnit).value); - w := Units.ConvertWidth(width, AUnit).value; - h := Units.ConvertHeight(height, AUnit).value; - if (w = 0) or (h = 0) or Bitmap.Empty then exit; - case imageRendering of - sirAuto, sirCrispEdges: filter := rfHalfCosine; - sirPixelated: filter := rfBox; - else filter := rfLinear; - end; - aspect := preserveAspectRatio; - if not aspect.Preserve then - ACanvas2d.drawImage(Bitmap, coord.x, coord.y, w, h, filter) - else - begin - ratioBitmap := Bitmap.Width/Bitmap.Height; - ratioPresentation := w/h; - if (ratioBitmap >= ratioPresentation) xor aspect.Slice then - begin - visualW := w; - visualH := visualW / ratioBitmap; - end else - begin - visualH := h; - visualW := visualH * ratioBitmap; - end; - case aspect.HorizAlign of - taRightJustify: IncF(coord.x, w - visualW); - taCenter: IncF(coord.x, (w - visualW)/2); - end; - case aspect.VertAlign of - tlBottom: IncF(coord.y, h - visualH); - tlCenter: IncF(coord.y, (h - visualH)/2); - end; - ACanvas2d.drawImage(FBitmap, coord.x, coord.y, visualW, visualH, filter); - end; -end; - -constructor TSVGImage.Create(ADocument: TDOMDocument; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(ADocument, AUnits, ADataLink); - FBitmap:= nil; -end; - -constructor TSVGImage.Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; - ADataLink: TSVGDataLink); -begin - inherited Create(AElement, AUnits, ADataLink); - FBitmap:= nil; -end; - -destructor TSVGImage.Destroy; -begin - FBitmap.Free; - inherited Destroy; -end; - -class function TSVGImage.GetDOMTag: string; -begin - Result:= 'image'; -end; - -procedure TSVGImage.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); - if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); - if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit); - if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit); -end; - -{ TSVGPattern } - -function TSVGPattern.GetPatternUnits: TSVGObjectUnits; -begin - if Attribute['patternUnits'] = 'userSpaceOnUse' then - result := souUserSpaceOnUse - else - result := souObjectBoundingBox; -end; - -function TSVGPattern.GetPatternContentUnits: TSVGObjectUnits; -begin - if Attribute['patternContentUnits'] = 'objectBoundingBox' then - result := souObjectBoundingBox - else - result := souUserSpaceOnUse; -end; - -function TSVGPattern.GetPatternTransform: string; -begin - result := Attribute['patternTransform']; -end; - -function TSVGPattern.GetViewBox: TSVGViewBox; -begin - result := TSVGViewBox.Parse(Attribute['viewBox']); -end; - -procedure TSVGPattern.SetPatternUnits(AValue: TSVGObjectUnits); -begin - if AValue = souUserSpaceOnUse then - Attribute['patternUnits'] := 'userSpaceOnUse' - else - Attribute['patternUnits'] := 'objectBoundingBox'; -end; - -procedure TSVGPattern.SetPatternContentUnits(AValue: TSVGObjectUnits); -begin - if AValue = souUserSpaceOnUse then - Attribute['patternContentUnits'] := 'userSpaceOnUse' - else - Attribute['patternContentUnits'] := 'objectBoundingBox'; -end; - -procedure TSVGPattern.SetPatternTransform(AValue: string); -begin - Attribute['patternTransform'] := AValue; -end; - -procedure TSVGPattern.SetViewBox(AValue: TSVGViewBox); -begin - Attribute['viewBox'] := AValue.ToString; -end; - -procedure TSVGPattern.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGPattern.GetDOMTag: string; -begin - Result:= 'pattern'; -end; - -{ TSVGMarker } - -function TSVGMarker.GetExternalResourcesRequired: boolean; -begin - if Attribute['externalResourcesRequired'] = 'true' then - result := true - else - result := false; -end; - -function TSVGMarker.GetViewBox: TSVGViewBox; -begin - result := TSVGViewBox.Parse(Attribute['viewBox']); -end; - -function TSVGMarker.GetPreserveAspectRatio: TSVGPreserveAspectRatio; -begin - result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']); -end; - -function TSVGMarker.GetRefX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['refX']; -end; - -function TSVGMarker.GetRefY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['refY']; -end; - -function TSVGMarker.GetMarkerWidth: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['markerWidth']; -end; - -function TSVGMarker.GetMarkerHeight: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['markerHeight']; -end; - -function TSVGMarker.GetMarkerUnits: TSVGMarkerUnits; -begin - if Attribute['markerUnits','strokeWidth'] = 'strokeWidth' then - result := smuStrokeWidth - else - result := smuUserSpaceOnUse; -end; - -function TSVGMarker.GetOrient: TSVGOrient; -var - err: integer; - s: string; -begin - s := Attribute['orient','0']; - result.angle := 0; - if s = 'auto' then - result.auto := soaAuto - else if s = 'auto-start-reverse' then - result.auto := soaAutoReverse - else - begin - result.auto := soaNone; - Val(s, result.angle, err); - if err <> 0 then - raise Exception('conversion error: '+IntToStr(err)+#13+'"'+s+'"'); - end; -end; - -procedure TSVGMarker.SetExternalResourcesRequired(AValue: boolean); -begin - if AValue then - Attribute['ExternalResourcesRequired'] := 'true' - else - Attribute['ExternalResourcesRequired'] := 'false'; -end; - -procedure TSVGMarker.SetViewBox(AValue: TSVGViewBox); -begin - Attribute['viewBox'] := AValue.ToString; -end; - -procedure TSVGMarker.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); -begin - Attribute['preserveAspectRatio'] := AValue.ToString; -end; - -procedure TSVGMarker.SetRefX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['refX'] := AValue; -end; - -procedure TSVGMarker.SetRefY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['refY'] := AValue; -end; - -procedure TSVGMarker.SetMarkerWidth(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['markerWidth'] := AValue; -end; - -procedure TSVGMarker.SetMarkerHeight(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['markerHeight'] := AValue; -end; - -procedure TSVGMarker.SetMarkerUnits(AValue: TSVGMarkerUnits); -begin - if AValue = smuStrokeWidth then - Attribute['markerUnits'] := 'strokeWidth' - else - Attribute['markerUnits'] := 'useSpaceOnUse'; -end; - -procedure TSVGMarker.SetOrient(AValue: TSVGOrient); -var - s: string; -begin - if AValue.auto = soaAuto then - s := 'auto' - else if AValue.auto = soaAutoReverse then - s := 'auto-start-reverse' - else - s := FloatToStr(AValue.angle); - Attribute['orient'] := s; -end; - -procedure TSVGMarker.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGMarker.GetDOMTag: string; -begin - Result:= 'marker'; -end; - -procedure TSVGMarker.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('refX') then refX := Units.ConvertWidth(refX, AUnit); - if HasAttribute('refY') then refY := Units.ConvertHeight(refY, AUnit); - if HasAttribute('markerWidth') then markerWidth := Units.ConvertWidth(markerWidth, AUnit); - if HasAttribute('markerHeight') then markerHeight := Units.ConvertHeight(markerHeight, AUnit); -end; - -{ TSVGMask } - -function TSVGMask.GetExternalResourcesRequired: boolean; -begin - if Attribute['externalResourcesRequired'] = 'true' then - result := true - else - result := false; -end; - -function TSVGMask.GetX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['x']; -end; - -function TSVGMask.GetY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['y']; -end; - -function TSVGMask.GetWidth: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['width']; -end; - -function TSVGMask.GetHeight: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['height']; -end; - -function TSVGMask.GetMaskUnits: TSVGObjectUnits; -begin - if Attribute['maskUnits'] = 'objectBoundingBox' then - result := souObjectBoundingBox - else - result := souUserSpaceOnUse; -end; - -function TSVGMask.GetMaskContentUnits: TSVGObjectUnits; -begin - if Attribute['maskContentUnits'] = 'objectBoundingBox' then - result := souObjectBoundingBox - else - result := souUserSpaceOnUse; -end; - -procedure TSVGMask.SetExternalResourcesRequired(AValue: boolean); -begin - if AValue then - Attribute['ExternalResourcesRequired'] := 'true' - else - Attribute['ExternalResourcesRequired'] := 'false'; -end; - -procedure TSVGMask.SetX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['x'] := AValue; -end; - -procedure TSVGMask.SetY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['y'] := AValue; -end; - -procedure TSVGMask.SetWidth(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['width'] := AValue; -end; - -procedure TSVGMask.SetHeight(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['height'] := AValue; -end; - -procedure TSVGMask.SetMaskUnits(AValue: TSVGObjectUnits); -begin - if AValue = souUserSpaceOnUse then - Attribute['maskUnits'] := 'userSpaceOnUse' - else - Attribute['maskUnits'] := 'objectBoundingBox'; -end; - -procedure TSVGMask.SetMaskContentUnits(AValue: TSVGObjectUnits); -begin - if AValue = souUserSpaceOnUse then - Attribute['maskContentUnits'] := 'userSpaceOnUse' - else - Attribute['maskContentUnits'] := 'objectBoundingBox'; -end; - -procedure TSVGMask.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //todo -end; - -class function TSVGMask.GetDOMTag: string; -begin - Result:= 'mask'; -end; - -procedure TSVGMask.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); - if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); - if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit); - if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit); -end; - -{ TSVGGroup } - -function TSVGGroup.GetFontSize: TFloatWithCSSUnit; -begin - result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false); -end; - -function TSVGGroup.GetIsLayer: boolean; -begin - result := (Attribute['inkscape:groupmode'] = 'layer') -end; - -function TSVGGroup.GetName: string; -begin - result := Attribute['inkscape:label']; -end; - -procedure TSVGGroup.SetFontSize(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['font-size'] := AValue; -end; - -procedure TSVGGroup.SetIsLayer(AValue: boolean); -begin - if AValue = GetIsLayer then exit; - if AValue then - Attribute['inkscape:groupmode'] := 'layer' - else Attribute['inkscape:groupmode'] := ''; -end; - -procedure TSVGGroup.SetName(AValue: string); -begin - Attribute['inkscape:label'] := AValue; -end; - -procedure TSVGGroup.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - prevFontSize: TFloatWithCSSUnit; -begin - prevFontSize := EnterFontSize; - FContent.Draw(ACanvas2d, AUnit); - ExitFontSize(prevFontSize); -end; - -class function TSVGGroup.OwnDatalink: boolean; -begin - Result:= true; -end; - -class function TSVGGroup.GetDOMTag: string; -begin - Result:= 'g'; -end; - -procedure TSVGGroup.ConvertToUnit(AUnit: TCSSUnit); -var - prevFontSize: TFloatWithCSSUnit; -begin - if HasAttribute('font-size') then - SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit)); - prevFontSize := EnterFontSize; - inherited ConvertToUnit(AUnit); - ExitFontSize(prevFontSize); -end; - -{ TSVGStyle } - -constructor TSVGStyle.Create(AElement: TDOMElement; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(AElement, AUnits, ADataLink); - Parse(AElement.TextContent); -end; - -procedure TSVGStyle.Initialize; -begin - inherited Initialize; - Clear; -end; - -class function TSVGStyle.GetDOMTag: string; -begin - Result:= 'style'; -end; - -destructor TSVGStyle.Destroy; -begin - Clear; - inherited Destroy; -end; - -procedure TSVGStyle.ConvertToUnit(AUnit: TCSSUnit); -var - declarations: String; - - function GetPropertyValue(AName: string; out AValue: TFloatWithCSSUnit): boolean; - var valueStr: string; - begin - valueStr := GetPropertyFromStyleDeclarationBlock(declarations, AName, ''); - if valueStr <> '' then - begin - AValue := Units.parseValue(valueStr, FloatWithCSSUnit(0, cuCustom)); - result := true; - end else - begin - AValue := FloatWithCSSUnit(0, cuCustom); - result := false; - end; - end; - - procedure SetPropertyValue(AName: string; AValue: TFloatWithCSSUnit); - begin - UpdateStyleDeclarationBlock(declarations, AName, Units.formatValue(AValue)); - end; - -var - i: Integer; - value: TFloatWithCSSUnit; -begin - inherited ConvertToUnit(AUnit); - for i := 0 to RulesetCount-1 do - begin - declarations := Ruleset[i].declarations; - if GetPropertyValue('stroke-width', value) then - SetPropertyValue('stroke-width', Units.ConvertOrtho(value, AUnit)); - if GetPropertyValue('stroke-dash-offset', value) then - SetPropertyValue('stroke-dash-offset', Units.ConvertOrtho(value, AUnit)); - if GetPropertyValue('font-size', value) then - SetPropertyValue('font-size', Units.ConvertHeight(value, AUnit)); - FRulesets[i].declarations := declarations; - end; -end; - -procedure TSVGStyle.Parse(const s: String); - - function IsValidDeclarationBlock(const sa: string): boolean; - var - i: integer; - begin - //(for case example "{ ; ;}") - for i:= 1 to Length(sa) do - if not (sa[i] in [' ',';']) then - exit(true); - result:= false; - end; - -const - EmptyRuleset: TSVGRuleset = (selector: ''; declarations: ''); -var - i,l,pg: integer; - st: String; - rec: TSVGRuleset; -begin - (* - Example of internal style block - circle {..} - circle.type1 {..} - .pic1 {..} - *) - Clear; - l:= 0; - pg:= 0; - st:= ''; - rec:= EmptyRuleset; - for i:= 1 to Length(s) do - begin - if s[i] = '{' then - begin - Inc(pg); - if (pg = 1) and (Length(st) <> 0) then - begin - rec.selector:= Trim(st); - st:= ''; - end; - end - else if s[i] = '}' then - begin - Dec(pg); - if (pg = 0) and (Length(st) <> 0) then - begin - if IsValidDeclarationBlock(st) then - begin - rec.declarations:= Trim(st); - Inc(l); - SetLength(FRulesets,l); - FRulesets[l-1]:= rec; - rec:= EmptyRuleset; - end; - st:= ''; - end; - end - else - st:= st + s[i]; - end; -end; - -function TSVGStyle.GetRulesetCount: integer; -begin - result := Length(FRulesets); -end; - -function TSVGStyle.IsValidRulesetIndex(const AIndex: integer): boolean; -begin - result:= (AIndex >= 0) and (AIndex < Length(FRulesets)); -end; - -function TSVGStyle.GetRuleset(const AIndex: integer): TSVGRuleset; -begin - if IsValidRulesetIndex(AIndex) then - result:= FRulesets[AIndex] - else - raise exception.Create(rsInvalidIndex); -end; - -procedure TSVGStyle.SetRuleset(const AIndex: integer; sr: TSVGRuleset); -begin - if IsValidRulesetIndex(AIndex) then - FRulesets[AIndex]:= sr - else - raise exception.Create(rsInvalidIndex); -end; - -function TSVGStyle.Count: Integer; -begin - result:= Length(FRulesets); -end; - -function TSVGStyle.Find(ARuleset: TSVGRuleset): integer; -var - i: integer; -begin - for i:= 0 to Length(FRulesets)-1 do - with FRulesets[i] do - if (selector = ARuleset.selector) and - (declarations = ARuleset.declarations) then - begin - result:= i; - Exit; - end; - result:= -1; -end; - -function TSVGStyle.Find(const AName: string): integer; -var - i: integer; -begin - for i:= 0 to Length(FRulesets)-1 do - with FRulesets[i] do - if selector = AName then - begin - result:= i; - Exit; - end; - result:= -1; -end; - -function TSVGStyle.Add(ARuleset: TSVGRuleset): integer; -var - l: integer; -begin - l:= Length(FRulesets); - SetLength(FRulesets,l+1); - FRulesets[l]:= ARuleset; - result:= l; -end; - -procedure TSVGStyle.Remove(ARuleset: TSVGRuleset); -var - l,p: integer; -begin - p:= Find(ARuleset); - l:= Length(FRulesets); - if p <> -1 then - begin - Finalize(FRulesets[p]); - System.Move(FRulesets[p+1], FRulesets[p], (l-p)*SizeOf(TSVGRuleset)); - SetLength(FRulesets,l-1); - end; -end; - -procedure TSVGStyle.Clear; -begin - SetLength(FRulesets,0); -end; - -procedure TSVGStyle.ReParse; -begin - Parse(FDomElem.TextContent); -end; - -{ TSVGRectangle } - -function TSVGRectangle.GetX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['x']; -end; - -function TSVGRectangle.GetY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['y']; -end; - -function TSVGRectangle.GetWidth: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['width']; -end; - -function TSVGRectangle.GetHeight: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['height']; -end; - -function TSVGRectangle.GetRX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['rx']; -end; - -function TSVGRectangle.GetRY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['ry']; -end; - -procedure TSVGRectangle.SetX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['x'] := AValue; -end; - -procedure TSVGRectangle.SetY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['y'] := AValue; -end; - -procedure TSVGRectangle.SetWidth(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['width'] := AValue; -end; - -procedure TSVGRectangle.SetHeight(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['height'] := AValue; -end; - -procedure TSVGRectangle.SetRX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['rx'] := AValue; -end; - -procedure TSVGRectangle.SetRY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['ry'] := AValue; -end; - -class function TSVGRectangle.GetDOMTag: string; -begin - Result:= 'rect'; -end; - -procedure TSVGRectangle.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit); - if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit); - if HasAttribute('rx') then rx := Units.ConvertWidth(rx, AUnit); - if HasAttribute('ry') then ry := Units.ConvertHeight(ry, AUnit); - if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit); - if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit); -end; - -procedure TSVGRectangle.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - vx,vy,vw,vh: Single; -begin - if not isStrokeNone or not isFillNone then - begin - vx:= Units.ConvertWidth(x,AUnit).value; - vy:= Units.ConvertHeight(y,AUnit).value; - vw:= Units.ConvertWidth(width,AUnit).value; - vh:= Units.ConvertHeight(height,AUnit).value; - ACanvas2d.beginPath; - ACanvas2d.roundRect(vx,vy, vw,vh, - Units.ConvertWidth(rx,AUnit).value,Units.ConvertHeight(ry,AUnit).value); - InitializeGradient(ACanvas2d, PointF(vx,vy),vw,vh,AUnit); - Paint(ACanvas2D,AUnit); - end; -end; - -{ TSVGPolypoints } - -function TSVGPolypoints.GetClosed: boolean; -begin - result := FDomElem.TagName = 'polygon'; -end; - -function TSVGPolypoints.GetBoundingBoxF: TRectF; -begin - if not FBoundingBoxComputed then - ComputeBoundingBox(pointsF); - result := FBoundingBox; -end; - -function TSVGPolypoints.GetPoints: string; -begin - result := Attribute['points']; -end; - -function TSVGPolypoints.GetPointsF: ArrayOfTPointF; -var parser: TSVGParser; - nbcoord,i: integer; -begin - parser:=TSVGParser.Create(points); - nbcoord := 0; - repeat - parser.ParseFloat; - if not parser.NumberError then - inc(nbcoord); - until parser.NumberError or parser.Done; - parser.ClearError; - setlength(Result,nbcoord div 2); - parser.Position := 1; - for i := 0 to high(result) do - begin - result[i].x := parser.ParseFloat; - result[i].y := parser.ParseFloat; - end; - parser.Free; -end; - -procedure TSVGPolypoints.SetPoints(AValue: string); -begin - Attribute['points'] := AValue; -end; - -procedure TSVGPolypoints.SetPointsF(AValue: ArrayOfTPointF); -var s: string; - i: integer; -begin - s:= ''; - for i := 0 to high(AValue) do - begin - if s <> '' then AppendStr(s, ' '); - with AValue[i] do - AppendStr(s, TCSSUnitConverter.formatValue(x)+' '+TCSSUnitConverter.formatValue(y)); - end; - points := s; - ComputeBoundingBox(AValue); -end; - -procedure TSVGPolypoints.ComputeBoundingBox(APoints: ArrayOfTPointF); -var - i: Integer; -begin - if length(APoints) > 1 then - begin - with APoints[0] do - FBoundingBox:= RectF(x,y,x,y); - for i:= 1 to high(APoints) do - with APoints[i] do - begin - if x < FBoundingBox.Left then - FBoundingBox.Left:= x - else if x > FBoundingBox.Right then - FBoundingBox.Right:= x; - if y < FBoundingBox.Top then - FBoundingBox.Top:= y - else if y > FBoundingBox.Bottom then - FBoundingBox.Bottom:= y; - end; - FBoundingBoxComputed := true; - end else - begin - FBoundingBox := RectF(0,0,0,0); - FBoundingBoxComputed := true; - end; -end; - -constructor TSVGPolypoints.Create(ADocument: TDOMDocument; - AUnits: TCSSUnitConverter; AClosed: boolean; ADataLink: TSVGDataLink); -begin - inherited Create(ADocument, AUnits, ADataLink); - if AClosed then - Init(ADocument, 'polygon', AUnits) - else - Init(ADocument, 'polyline', AUnits); -end; - -destructor TSVGPolypoints.Destroy; -begin - inherited Destroy; -end; - -procedure TSVGPolypoints.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - prevMatrix: TAffineMatrix; - pts: ArrayOfTPointF; -begin - if isFillNone and isStrokeNone then exit; - if AUnit <> cuCustom then - begin - prevMatrix := ACanvas2d.matrix; - ACanvas2d.scale(Units.ConvertWidth(1,cuCustom,AUnit), - Units.ConvertHeight(1,cuCustom,AUnit)); - InternalDraw(ACanvas2d, cuCustom); - ACanvas2d.matrix:= prevMatrix; - end else - begin - ACanvas2d.beginPath; - pts := pointsF; - ACanvas2d.polylineTo(pts); - if closed then ACanvas2d.closePath; - - with boundingBoxF do - InitializeGradient(ACanvas2d, - PointF(Left,Top),abs(Right-Left),abs(Bottom-Top),AUnit); - Paint(ACanvas2D, AUnit); - end; -end; - -{ TSVGPath } - -function TSVGPath.GetPathLength: TFloatWithCSSUnit; -begin - result := OrthoAttributeWithUnit['pathLength']; -end; - -function TSVGPath.GetPath: TBGRAPath; -begin - if FPath = nil then - FPath := TBGRAPath.Create(Attribute['d']); - result := FPath; -end; - -function TSVGPath.GetBoundingBoxF: TRectF; -begin - if not FBoundingBoxComputed then - begin - FBoundingBox := path.GetBounds; - FBoundingBoxComputed := true; - end; - result := FBoundingBox; -end; - -function TSVGPath.GetData: string; -begin - if FPath = nil then - result := Attribute['d'] - else - result := FPath.SvgString; -end; - -procedure TSVGPath.SetPathLength(AValue: TFloatWithCSSUnit); -begin - OrthoAttributeWithUnit['pathLength'] := AValue; -end; - -procedure TSVGPath.SetData(AValue: string); -begin - if FPath = nil then - Attribute['d'] := AValue - else - FPath.SvgString := AValue; - FBoundingBoxComputed := false; -end; - -function TSVGPath.GetDOMElement: TDOMElement; -begin - if FPath <> nil then Attribute['d'] := FPath.SvgString; - Result:=inherited GetDOMElement; -end; - -constructor TSVGPath.Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(ADocument, AUnits, ADataLink); - FPath := nil; - FBoundingBoxComputed := false; - FBoundingBox := rectF(0,0,0,0); -end; - -constructor TSVGPath.Create(AElement: TDOMElement; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - inherited Create(AElement, AUnits, ADataLink); - FPath := nil; - FBoundingBoxComputed := false; - FBoundingBox := rectF(0,0,0,0); -end; - -destructor TSVGPath.Destroy; -begin - FreeAndNil(FPath); - inherited Destroy; -end; - -procedure TSVGPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - prevMatrix: TAffineMatrix; -begin - if isFillNone and isStrokeNone then exit; - if AUnit <> cuCustom then - begin - prevMatrix := ACanvas2d.matrix; - ACanvas2d.scale(Units.ConvertWidth(1,cuCustom,AUnit), - Units.ConvertHeight(1,cuCustom,AUnit)); - InternalDraw(ACanvas2d, cuCustom); - ACanvas2d.matrix:= prevMatrix; - end else - begin - ACanvas2d.path(path); - if Assigned(FillGradientElement) or Assigned(StrokeGradientElement) then - with boundingBoxF do - InitializeGradient(ACanvas2d, - PointF(Left,Top),abs(Right-Left),abs(Bottom-Top),AUnit); - Paint(ACanvas2D, AUnit); - end; -end; - -class function TSVGPath.GetDOMTag: string; -begin - Result:= 'path'; -end; - -{ TSVGEllipse } - -function TSVGEllipse.GetCX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['cx']; -end; - -function TSVGEllipse.GetCY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['cy']; -end; - -function TSVGEllipse.GetRX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['rx']; -end; - -function TSVGEllipse.GetRY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['ry']; -end; - -procedure TSVGEllipse.SetCX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['cx'] := AValue; -end; - -procedure TSVGEllipse.SetCY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['cy'] := AValue; -end; - -procedure TSVGEllipse.SetRX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['rx'] := AValue; -end; - -procedure TSVGEllipse.SetRY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['ry'] := AValue; -end; - -procedure TSVGEllipse.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - vcx,vcy,vrx,vry: Single; -begin - if not isFillNone or not isStrokeNone then - begin - vcx:= Units.ConvertWidth(cx,AUnit).value; - vcy:= Units.ConvertHeight(cy,AUnit).value; - vrx:= Units.ConvertWidth(rx,AUnit).value; - vry:= Units.ConvertHeight(ry,AUnit).value; - ACanvas2d.beginPath; - ACanvas2d.ellipse(vcx,vcy,vrx,vry); - InitializeGradient(ACanvas2d, PointF(vcx-vrx,vcy-vry),vrx*2,vry*2,AUnit); - Paint(ACanvas2D, AUnit); - end; -end; - -class function TSVGEllipse.GetDOMTag: string; -begin - Result:= 'ellipse'; -end; - -procedure TSVGEllipse.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('cx') then cx := Units.ConvertWidth(cx, AUnit); - if HasAttribute('cy') then cy := Units.ConvertHeight(cy, AUnit); - if HasAttribute('rx') then rx := Units.ConvertWidth(rx, AUnit); - if HasAttribute('ry') then ry := Units.ConvertHeight(ry, AUnit); -end; - -{ TSVGCircle } - -function TSVGCircle.GetCX: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['cx']; -end; - -function TSVGCircle.GetCY: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['cy']; -end; - -function TSVGCircle.GetR: TFloatWithCSSUnit; -begin - result := OrthoAttributeWithUnit['r']; -end; - -procedure TSVGCircle.SetCX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['cx'] := AValue; -end; - -procedure TSVGCircle.SetCY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['cy'] := AValue; -end; - -procedure TSVGCircle.SetR(AValue: TFloatWithCSSUnit); -begin - OrthoAttributeWithUnit['r'] := AValue; -end; - -procedure TSVGCircle.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var - vcx,vcy,vr: Single; -begin - if not isFillNone or not isStrokeNone then - begin - vcx:= Units.ConvertWidth(cx,AUnit).value; - vcy:= Units.ConvertHeight(cy,AUnit).value; - vr:= Units.ConvertOrtho(r,AUnit).value; - ACanvas2d.beginPath; - ACanvas2d.circle(vcx,vcy,vr); - InitializeGradient(ACanvas2d, PointF(vcx-vr,vcy-vr),vr*2,vr*2,AUnit); - Paint(ACanvas2d, AUnit); - end; -end; - -class function TSVGCircle.GetDOMTag: string; -begin - Result:= 'circle'; -end; - -procedure TSVGCircle.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('cx') then cx := Units.ConvertWidth(cx, AUnit); - if HasAttribute('cy') then cy := Units.ConvertHeight(cy, AUnit); - if HasAttribute('r') then r := Units.ConvertOrtho(r, AUnit); -end; - -{ TSVGLine } - -function TSVGLine.GetX1: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['x1']; -end; - -function TSVGLine.GetX2: TFloatWithCSSUnit; -begin - result := HorizAttributeWithUnit['x2']; -end; - -function TSVGLine.GetY1: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['y1']; -end; - -function TSVGLine.GetY2: TFloatWithCSSUnit; -begin - result := VerticalAttributeWithUnit['y2']; -end; - -procedure TSVGLine.SetX1(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['x1'] := AValue; -end; - -procedure TSVGLine.SetX2(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['x2'] := AValue; -end; - -procedure TSVGLine.SetY1(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['y1'] := AValue; -end; - -procedure TSVGLine.SetY2(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['y2'] := AValue; -end; - -procedure TSVGLine.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - if not isStrokeNone then - begin - ApplyStrokeStyle(ACanvas2D,AUnit); - ACanvas2d.beginPath; - ACanvas2d.moveTo(Units.ConvertWidth(x1,AUnit).value,Units.ConvertHeight(y1,AUnit).value); - ACanvas2d.lineTo(Units.ConvertWidth(x2,AUnit).value,Units.ConvertHeight(y2,AUnit).value); - ACanvas2d.stroke; - end; -end; - -class function TSVGLine.GetDOMTag: string; -begin - Result:= 'line'; -end; - -procedure TSVGLine.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if HasAttribute('x1') then x1 := Units.ConvertWidth(x1, AUnit); - if HasAttribute('y1') then y1 := Units.ConvertHeight(y1, AUnit); - if HasAttribute('x2') then x2 := Units.ConvertWidth(x2, AUnit); - if HasAttribute('y2') then y2 := Units.ConvertHeight(y2, AUnit); -end; - -{ TSVGGradient } //## - -function TSVGGradient.GetHRef: string; -begin - result := Attribute['xlink:href']; -end; - -function TSVGGradient.GetSpreadMethod: TSVGSpreadMethod; -var - s: String; -begin - s := Attribute['spreadMethod']; - if s = 'reflect' then result := ssmReflect - else if s = 'repeat' then result := ssmRepeat - else result := ssmPad; -end; - -procedure TSVGGradient.SetColorInterpolation(AValue: TSVGColorInterpolation); -begin - if AValue = sciLinearRGB then - Attribute['color-interpolation'] := 'linearRGB' - else Attribute['color-interpolation'] := 'sRGB'; -end; - -procedure TSVGGradient.SetGradientMatrix(AUnit: TCSSUnit; AValue: TAffineMatrix); -begin - if not IsAffineMatrixIdentity(AValue) then - gradientTransform := MatrixToTransform(AValue, AUnit) - else FDomElem.RemoveAttribute('gradientTransform'); -end; - -procedure TSVGGradient.SetGradientTransform(AValue: string); -begin - Attribute['gradientTransform'] := AValue; -end; - -function TSVGGradient.GetGradientUnits: TSVGObjectUnits; -begin - if Attribute['gradientUnits','objectBoundingBox'] = 'userSpaceOnUse' then - result := souUserSpaceOnUse - else - result := souObjectBoundingBox; -end; - -function TSVGGradient.GetGradientTransform: string; -begin - result := Attribute['gradientTransform']; -end; - -function TSVGGradient.GetColorInterpolation: TSVGColorInterpolation; -begin - if Attribute['color-interpolation'] = 'linearRGB' then - result := sciLinearRGB - else result := sciStdRGB; -end; - -function TSVGGradient.GetGradientMatrix(AUnit: TCSSUnit): TAffineMatrix; -begin - result := TransformToMatrix(gradientTransform, AUnit); -end; - -procedure TSVGGradient.SetGradientUnits(AValue: TSVGObjectUnits); -begin - if AValue = souUserSpaceOnUse then - Attribute['gradientUnits'] := 'userSpaceOnUse' - else - Attribute['gradientUnits'] := 'objectBoundingBox'; -end; - -procedure TSVGGradient.SetHRef(AValue: string); -begin - Attribute['xlink:href'] := AValue; -end; - -procedure TSVGGradient.SetSpreadMethod(AValue: TSVGSpreadMethod); -var - s: String; -begin - case AValue of - ssmReflect: s := 'reflect'; - ssmRepeat: s := 'repeat'; - else s := 'pad'; - end; - Attribute['spreadMethod'] := s; -end; - -procedure TSVGGradient.Initialize; -begin - inherited; - InheritedGradients:= TSVGElementList.Create; -end; - -function TSVGGradient.GetInheritedAttribute(AValue: string; - AConvMethod: TConvMethod; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -var - i: integer; - el: TSVGGradient; - invalidDef: TFloatWithCSSUnit; -begin - invalidDef:= FloatWithCSSUnit(EmptySingle,cuPercent); - //find valid inherited Attribute (start from "self": item[0]) - for i:= 0 to InheritedGradients.Count-1 do - begin - el:= TSVGGradient( InheritedGradients[i] ); - with el do - begin - if AConvMethod = cmHoriz then - result:= HorizAttributeWithUnitDef[AValue,invalidDef] - else if AConvMethod = cmVertical then - result:= VerticalAttributeWithUnitDef[AValue,invalidDef] - else if AConvMethod = cmOrtho then - result:= OrthoAttributeWithUnitDef[AValue,invalidDef] - else - result:= AttributeWithUnitDef[AValue,invalidDef]; - - if (result.value <> invalidDef.value) or - (result.CSSUnit <> invalidDef.CSSUnit) then - exit; - end; - end; - result:= ADefault; -end; - -destructor TSVGGradient.Destroy; -begin - FreeAndNil(InheritedGradients); - inherited Destroy; -end; - -procedure TSVGGradient.ScanInheritedGradients(const forceScan: boolean = false); -var - el: TSVGGradient; -begin - //(if list empty = not scan) - if (InheritedGradients.Count <> 0) and (not forceScan) then - exit; - - InheritedGradients.Clear; - InheritedGradients.Add(Self);//(important) - if FDataLink = nil then exit; - el:= Self; - while el.hRef <> '' do - begin - el := TSVGGradient(FDataLink.FindElementByRef(el.hRef, TSVGGradient)); - if Assigned(el) then InheritedGradients.Add(el); - end; -end; - -{ TSVGLinearGradient } - -function TSVGLinearGradient.GetX1: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('x1',cmNone,FloatWithCSSUnit(0,cuPercent)); -end; - -function TSVGLinearGradient.GetX2: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('x2',cmNone,FloatWithCSSUnit(100,cuPercent)); -end; - -function TSVGLinearGradient.GetY1: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('y1',cmNone,FloatWithCSSUnit(0,cuPercent)); -end; - -function TSVGLinearGradient.GetY2: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('y2',cmNone,FloatWithCSSUnit(0,cuPercent)); -end; - -procedure TSVGLinearGradient.SetX1(AValue: TFloatWithCSSUnit); -begin - AttributeWithUnit['x1']:= AValue; -end; - -procedure TSVGLinearGradient.SetX2(AValue: TFloatWithCSSUnit); -begin - AttributeWithUnit['x2']:= AValue; -end; - -procedure TSVGLinearGradient.SetY1(AValue: TFloatWithCSSUnit); -begin - AttributeWithUnit['y1']:= AValue; -end; - -procedure TSVGLinearGradient.SetY2(AValue: TFloatWithCSSUnit); -begin - AttributeWithUnit['y2']:= AValue; -end; - -class function TSVGLinearGradient.GetDOMTag: string; -begin - Result:= 'linearGradient'; -end; - -procedure TSVGLinearGradient.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if gradientUnits = souUserSpaceOnUse then - begin - if HasAttribute('x1') then x1 := Units.ConvertWidth(HorizAttributeWithUnit['x1'], AUnit); - if HasAttribute('y1') then y1 := Units.ConvertHeight(VerticalAttributeWithUnit['y1'], AUnit); - if HasAttribute('x2') then x2 := Units.ConvertWidth(HorizAttributeWithUnit['x2'], AUnit); - if HasAttribute('y2') then y2 := Units.ConvertHeight(VerticalAttributeWithUnit['y2'], AUnit); - end; -end; - -{ TSVGRadialGradient } - -function TSVGRadialGradient.GetCX: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('cx',cmHoriz,FloatWithCSSUnit(50,cuPercent)); -end; - -function TSVGRadialGradient.GetCY: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('cy',cmVertical,FloatWithCSSUnit(50,cuPercent)); -end; - -function TSVGRadialGradient.GetR: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('r',cmOrtho,FloatWithCSSUnit(50,cuPercent)); -end; - -function TSVGRadialGradient.GetFX: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('fx',cmHoriz,cx); -end; - -function TSVGRadialGradient.GetFY: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('fy',cmVertical,cy); -end; - -function TSVGRadialGradient.GetFR: TFloatWithCSSUnit; -begin - result := GetInheritedAttribute('fr',cmHoriz,FloatWithCSSUnit(0,cuPercent)); -end; - -procedure TSVGRadialGradient.SetCX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['cx'] := AValue; -end; - -procedure TSVGRadialGradient.SetCY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['cy'] := AValue; -end; - -procedure TSVGRadialGradient.SetR(AValue: TFloatWithCSSUnit); -begin - OrthoAttributeWithUnit['r'] := AValue; -end; - -procedure TSVGRadialGradient.SetFX(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['fx'] := AValue; -end; - -procedure TSVGRadialGradient.SetFY(AValue: TFloatWithCSSUnit); -begin - VerticalAttributeWithUnit['fy'] := AValue; -end; - -procedure TSVGRadialGradient.SetFR(AValue: TFloatWithCSSUnit); -begin - OrthoAttributeWithUnit['fr'] := AValue; -end; - -class function TSVGRadialGradient.GetDOMTag: string; -begin - Result:= 'radialGradient'; -end; - -procedure TSVGRadialGradient.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - if gradientUnits = souUserSpaceOnUse then - begin - if HasAttribute('cx') then cx := Units.ConvertWidth(HorizAttributeWithUnit['cx'], AUnit); - if HasAttribute('cy') then cy := Units.ConvertHeight(VerticalAttributeWithUnit['cy'], AUnit); - if HasAttribute('fx') then fx := Units.ConvertWidth(HorizAttributeWithUnit['fx'], AUnit); - if HasAttribute('fy') then fy := Units.ConvertHeight(VerticalAttributeWithUnit['fy'], AUnit); - if HasAttribute('r') then r := Units.ConvertOrtho(OrthoAttributeWithUnit['r'], AUnit); - if HasAttribute('fr') then fr := Units.ConvertOrtho(OrthoAttributeWithUnit['fr'], AUnit); - end; -end; - -{ TSVGStopGradient } - -function TSVGStopGradient.GetOffset: TFloatWithCSSUnit; -begin - result := AttributeWithUnit['offset']; -end; - -function TSVGStopGradient.GetStopColor: TBGRAPixel; -begin - result := StrToBGRA(AttributeOrStyleDef['stop-color','black']); - result.alpha := round(result.alpha*stopOpacity); -end; - -function TSVGStopGradient.GetStopOpacity: single; -var errPos: integer; -begin - val(AttributeOrStyleDef['stop-opacity','1'], result, errPos); - if errPos <> 0 then result := 1 else - if result < 0 then result := 0 else - if result > 1 then result := 1; -end; - -procedure TSVGStopGradient.SetOffset(AValue: TFloatWithCSSUnit); -begin - AttributeWithUnit['offset'] := AValue; -end; - -procedure TSVGStopGradient.SetStopColor(AValue: TBGRAPixel); -begin - stopOpacity:= AValue.alpha/255; - AValue.alpha:= 255; - Attribute['stop-color'] := Lowercase(BGRAToStr(AValue, CSSColors, 0, true, true)); - RemoveStyle('stop-color'); -end; - -procedure TSVGStopGradient.SetStopOpacity(AValue: single); -begin - Attribute['stop-opacity'] := Units.formatValue(AValue); - RemoveStyle('stop-opacity'); -end; - -class function TSVGStopGradient.GetDOMTag: string; -begin - Result:= 'stop'; -end; - -{ TSVGContent } - -function TSVGContent.GetElement(AIndex: integer): TSVGElement; -begin - result := TObject(FElements.Items[AIndex]) as TSVGElement; -end; - -function TSVGContent.GetElementObject(AIndex: integer): TObject; -begin - result := TObject(FElements.Items[AIndex]); -end; - -function TSVGContent.GetElementCount: integer; -begin - result := FElements.Count; -end; - -function TSVGContent.GetUnits: TCSSUnitConverter; -begin - result := FUnits; -end; - -function TSVGContent.TryCreateElementFromNode(ANode: TDOMNode): TObject; -begin - if ANode is TDOMElement then - result := CreateSVGElementFromNode(TDOMElement(ANode),FUnits,FDataLink) - else - result := ANode; -end; - -function TSVGContent.GetIsSVGElement(AIndex: integer): boolean; -begin - result := TObject(FElements[AIndex]) is TSVGElement; -end; - -function TSVGContent.GetElementDOMNode(AIndex: integer): TDOMNode; -begin - result := GetDOMNode(TObject(FElements[AIndex])); -end; - -function TSVGContent.GetDOMNode(AElement: TObject): TDOMNode; -begin - if AElement is TDOMNode then - result := TDOMNode(AElement) - else if AElement is TSVGElement then - result := TSVGElement(AElement).DOMElement - else - raise exception.Create('Unexpected element type'); -end; - -procedure TSVGContent.AppendElement(AElement: TObject); -begin - FDomElem.AppendChild(GetDOMNode(AElement)); - FElements.Add(AElement); - if AElement is TSVGElement then - TSVGElement(AElement).DataLink := FDataLink; -end; - -function TSVGContent.ExtractElementAt(AIndex: integer): TObject; -begin - result := ElementObject[AIndex]; - if result is TSVGElement then - begin - TSVGElement(result).DataLink := nil; - FElements.Delete(AIndex); - FDomElem.RemoveChild(TSVGElement(result).DOMElement); - end else - if result is TDOMNode then - FDomElem.RemoveChild(TDOMNode(result)) - else - raise exception.Create('Unexpected element type'); -end; - -procedure TSVGContent.InsertElementBefore(AElement: TSVGElement; - ASuccessor: TSVGElement); -var idx: integer; -begin - idx := FElements.IndexOf(ASuccessor); - if idx <> -1 then - begin - FElements.Insert(idx,AElement); - FDomElem.InsertBefore(GetDOMNode(AElement), GetDOMNode(ASuccessor)); - AElement.DataLink := FDataLink; - end - else - AppendElement(AElement); -end; - -constructor TSVGContent.Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; - ADataLink: TSVGDataLink); -var cur: TDOMNode; - elem: TObject; -begin - FDoc := AElement.OwnerDocument; - FDomElem := AElement; - FDataLink := ADataLink; - FElements := TFPList.Create; - FUnits := AUnits; - cur := FDomElem.FirstChild; - while cur <> nil do - begin - elem := TryCreateElementFromNode(cur); - if Assigned(elem) then FElements.Add(elem); - cur := cur.NextSibling; - end; -end; - -destructor TSVGContent.Destroy; -var i:integer; -begin - for i := ElementCount-1 downto 0 do - if not (ElementObject[i] is TDOMNode) then - ElementObject[i].Free; - FreeAndNil(FElements); - inherited Destroy; -end; - -procedure TSVGContent.Clear; -var - i: Integer; -begin - for i := 0 to ElementCount-1 do - if IsSVGElement[i] then Element[i].Free; - FElements.Clear; - while Assigned(FDomElem.FirstChild) do - FDomElem.RemoveChild(FDomElem.FirstChild); -end; - -procedure TSVGContent.ConvertToUnit(AUnit: TCSSUnit); -var i: integer; -begin - for i := 0 to ElementCount-1 do - if IsSVGElement[i] then - Element[i].ConvertToUnit(AUnit); -end; - -procedure TSVGContent.Recompute; -var - i: Integer; -begin - for i := 0 to ElementCount-1 do - if IsSVGElement[i] then - Element[i].Recompute; -end; - -procedure TSVGContent.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit); -var prevMatrix: TAffineMatrix; -begin - if (x<>0) or (y<>0) then - begin - prevMatrix := ACanvas2d.matrix; - ACanvas2d.translate(x,y); - Draw(ACanvas2d, AUnit); - ACanvas2d.matrix := prevMatrix; - end else - Draw(ACanvas2d, AUnit); -end; - -procedure TSVGContent.Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var i: integer; -begin - for i := 0 to ElementCount-1 do - if IsSVGElement[i] then - Element[i].Draw(ACanvas2d, AUnit); -end; - -function TSVGContent.AppendElement(ASVGType: TSVGFactory): TSVGElement; -begin - result := ASVGType.Create(FDoc,Units,FDataLink); - AppendElement(result); -end; - -procedure TSVGContent.BringElement(AElement: TObject; - AFromContent: TSVGContent); -var - idx: Integer; -begin - idx := AFromContent.IndexOfElement(AElement); - if idx = -1 then raise exception.Create('Cannot find element in content'); - AFromContent.ExtractElementAt(idx); - AppendElement(AElement); -end; - -procedure TSVGContent.CopyElement(AElement: TObject); -var - nodeCopy: TDOMNode; - objCopy: TObject; -begin - if AElement is TSVGElement then - nodeCopy := TSVGElement(AElement).DOMElement.CloneNode(true, FDoc) - else if AElement is TDOMNode then - nodeCopy := TDOMNode(AElement).CloneNode(true, FDoc) - else - raise exception.Create('Unexpected element type'); - - FDomElem.AppendChild(nodeCopy); - objCopy := TryCreateElementFromNode(nodeCopy); - if Assigned(objCopy) then FElements.Add(objCopy); -end; - -procedure TSVGContent.RemoveElement(AElement: TObject); -var - idx: Integer; -begin - idx := IndexOfElement(AElement); - if idx = -1 then exit; - if AElement is TSVGElement then - begin - ExtractElementAt(idx); - TSVGElement(AElement).DOMElement.Free; - AElement.Free; - end else - if AElement is TDOMNode then - begin - ExtractElementAt(idx); - TDOMNode(AElement).Free; - end else - raise exception.Create('Unexpected element type'); -end; - -function TSVGContent.AppendDOMText(AText: string): TDOMText; -begin - result := TDOMText.Create(FDomElem.OwnerDocument); - result.Data:= AText; - AppendElement(result); -end; - -function TSVGContent.AppendDefine: TSVGDefine; -begin - result := TSVGDefine.Create(FDoc,Units,FDataLink); - AppendElement(result); -end; - -function TSVGContent.AppendLinearGradient(x1, y1, x2, y2: single; AIsPercent: boolean): TSVGLinearGradient; -var - u: TCSSUnit; -begin - result := TSVGLinearGradient.Create(FDoc,Units,FDataLink); - result.gradientUnits:= souObjectBoundingBox; - if AIsPercent then u := cuPercent else u := cuCustom; - result.x1 := FloatWithCSSUnit(x1, u); - result.x2 := FloatWithCSSUnit(x2, u); - result.y1 := FloatWithCSSUnit(y1, u); - result.y2 := FloatWithCSSUnit(y2, u); - AppendElement(result); -end; - -function TSVGContent.AppendLinearGradient(x1, y1, x2, y2: single; - AUnit: TCSSUnit): TSVGLinearGradient; -begin - result := TSVGLinearGradient.Create(FDoc,Units,FDataLink); - result.gradientUnits:= souUserSpaceOnUse; - result.x1 := FloatWithCSSUnit(x1, AUnit); - result.x2 := FloatWithCSSUnit(x2, AUnit); - result.y1 := FloatWithCSSUnit(y1, AUnit); - result.y2 := FloatWithCSSUnit(y2, AUnit); - AppendElement(result); -end; - -function TSVGContent.AppendRadialGradient(cx, cy, r, fx, fy, fr: single; - AIsPercent: boolean): TSVGRadialGradient; -var - u: TCSSUnit; -begin - result := TSVGRadialGradient.Create(FDoc,Units,FDataLink); - result.gradientUnits:= souObjectBoundingBox; - if AIsPercent then u := cuPercent else u := cuCustom; - result.cx := FloatWithCSSUnit(cx, u); - result.cy := FloatWithCSSUnit(cy, u); - result.r := FloatWithCSSUnit(r, u); - result.fx := FloatWithCSSUnit(fx, u); - result.fy := FloatWithCSSUnit(fy, u); - result.fr := FloatWithCSSUnit(fr, u); - AppendElement(result); -end; - -function TSVGContent.AppendRadialGradient(cx, cy, r, fx, fy, fr: single; - AUnit: TCSSUnit): TSVGRadialGradient; -begin - result := TSVGRadialGradient.Create(FDoc,Units,FDataLink); - result.gradientUnits:= souUserSpaceOnUse; - result.cx := FloatWithCSSUnit(cx, AUnit); - result.cy := FloatWithCSSUnit(cy, AUnit); - result.r := FloatWithCSSUnit(r, AUnit); - result.fx := FloatWithCSSUnit(fx, AUnit); - result.fy := FloatWithCSSUnit(fy, AUnit); - result.fr := FloatWithCSSUnit(fr, AUnit); - AppendElement(result); -end; - -function TSVGContent.AppendStop(AColor: TBGRAPixel; AOffset: single; - AIsPercent: boolean): TSVGStopGradient; -begin - result := TSVGStopGradient.Create(FDoc,Units,FDataLink); - if AIsPercent then - result.Offset := FloatWithCSSUnit(AOffset, cuPercent) - else result.Offset := FloatWithCSSUnit(AOffset, cuCustom); - result.stopColor := AColor; - AppendElement(result); -end; - -function TSVGContent.AppendLine(x1, y1, x2, y2: single; AUnit: TCSSUnit - ): TSVGLine; -begin - result := TSVGLine.Create(FDoc,Units,FDataLink); - result.x1 := FloatWithCSSUnit(x1,AUnit); - result.y1 := FloatWithCSSUnit(y1,AUnit); - result.x2 := FloatWithCSSUnit(x2,AUnit); - result.y2 := FloatWithCSSUnit(y2,AUnit); - AppendElement(result); -end; - -function TSVGContent.AppendLine(p1, p2: TPointF; AUnit: TCSSUnit): TSVGLine; -begin - result := AppendLine(p1.x,p1.y,p2.x,p2.y,AUnit); -end; - -function TSVGContent.AppendCircle(cx, cy, r: single; AUnit: TCSSUnit - ): TSVGCircle; -begin - result := TSVGCircle.Create(FDoc,Units,FDataLink); - result.cx := FloatWithCSSUnit(cx,AUnit); - result.cy := FloatWithCSSUnit(cy,AUnit); - result.r := FloatWithCSSUnit(r,AUnit); - AppendElement(result); -end; - -function TSVGContent.AppendCircle(c: TPointF; r: single; AUnit: TCSSUnit - ): TSVGCircle; -begin - result := AppendCircle(c.x,c.y,r,AUnit); -end; - -function TSVGContent.AppendEllipse(cx, cy, rx, ry: single; AUnit: TCSSUnit - ): TSVGEllipse; -begin - result := TSVGEllipse.Create(FDoc,Units,FDataLink); - result.cx := FloatWithCSSUnit(cx,AUnit); - result.cy := FloatWithCSSUnit(cy,AUnit); - result.rx := FloatWithCSSUnit(rx,AUnit); - result.ry := FloatWithCSSUnit(ry,AUnit); - AppendElement(result); -end; - -function TSVGContent.AppendEllipse(c, r: TPointF; AUnit: TCSSUnit): TSVGEllipse; -begin - result := AppendEllipse(c.x,c.y,r.x,r.y,AUnit); -end; - -function TSVGContent.AppendPath(data: string; AUnit: TCSSUnit): TSVGPath; -var tempPath: TBGRAPath; -begin - if AUnit <> cuCustom then - begin - tempPath := TBGRAPath.Create(data); - result := AppendPath(tempPath, AUnit); - tempPath.Free; - end else - begin - result := TSVGPath.Create(FDoc,Units,FDataLink); - result.d := data; - AppendElement(result); - end; -end; - -function TSVGContent.AppendPath(path: TBGRAPath; AUnit: TCSSUnit): TSVGPath; -begin - result := TSVGPath.Create(FDoc,Units,FDataLink); - result.path.scale(Units.ConvertWidth(1,AUnit,cuCustom)); - path.copyTo(result.path); - AppendElement(result); -end; - -function TSVGContent.AppendPolygon(const points: array of single; - AUnit: TCSSUnit): TSVGPolypoints; -var - pts: ArrayOfTPointF; - i: integer; -begin - result := TSVGPolypoints.Create(FDoc,FUnits,true,FDataLink); - setlength(pts, length(points) div 2); - for i := 0 to high(pts) do - pts[i] := Units.ConvertCoord(PointF(points[i shl 1],points[(i shl 1)+1]),AUnit,cuCustom); - result.pointsF := pts; - AppendElement(result); -end; - -function TSVGContent.AppendPolygon(const points: array of TPointF; - AUnit: TCSSUnit): TSVGPolypoints; -var - pts: ArrayOfTPointF; - i: integer; -begin - result := TSVGPolypoints.Create(FDoc,FUnits,true,FDataLink); - setlength(pts, length(points)); - for i := 0 to high(pts) do - pts[i] := Units.ConvertCoord(points[i],AUnit,cuCustom); - result.pointsF := pts; - AppendElement(result); -end; - -function TSVGContent.AppendRect(x, y, width, height: single; AUnit: TCSSUnit - ): TSVGRectangle; -begin - result := TSVGRectangle.Create(FDoc,Units,FDataLink); - result.x := FloatWithCSSUnit(x,AUnit); - result.y := FloatWithCSSUnit(y,AUnit); - result.width := FloatWithCSSUnit(width,AUnit); - result.height := FloatWithCSSUnit(height,AUnit); - AppendElement(result); -end; - -function TSVGContent.AppendRect(origin, size: TPointF; AUnit: TCSSUnit - ): TSVGRectangle; -begin - result := AppendRect(origin.x,origin.y,size.x,size.y,AUnit); -end; - -function TSVGContent.AppendImage(x, y, width, height: single; ABitmap: TBGRACustomBitmap; - ABitmapOwned: boolean; AUnit: TCSSUnit): TSVGImage; -begin - result := TSVGImage.Create(FDoc,Units,FDataLink); - result.x := FloatWithCSSUnit(x, AUnit); - result.y := FloatWithCSSUnit(y, AUnit); - result.width := FloatWithCSSUnit(width, AUnit); - result.height := FloatWithCSSUnit(height, AUnit); - result.SetBitmap(ABitmap, ABitmapOwned); - AppendElement(result); -end; - -function TSVGContent.AppendImage(origin, size: TPointF; ABitmap: TBGRACustomBitmap; - ABitmapOwned: boolean; AUnit: TCSSUnit): TSVGImage; -begin - result := AppendImage(origin.x,origin.y,size.x,size.y,ABitmap,ABitmapOwned,AUnit); -end; - -function TSVGContent.AppendImage(x, y, width, height: single; - ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit): TSVGImage; -begin - result := TSVGImage.Create(FDoc,Units,FDataLink); - result.x := FloatWithCSSUnit(x, AUnit); - result.y := FloatWithCSSUnit(y, AUnit); - result.width := FloatWithCSSUnit(width, AUnit); - result.height := FloatWithCSSUnit(height, AUnit); - result.SetBitmap(ABitmapStream, AMimeType); - AppendElement(result); -end; - -function TSVGContent.AppendImage(origin, size: TPointF; ABitmapStream: TStream; - AMimeType: string; AUnit: TCSSUnit): TSVGImage; -begin - result := AppendImage(origin.x,origin.y,size.x,size.y,ABitmapStream,AMimeType,AUnit); -end; - -function TSVGContent.AppendText(x, y: single; AText: string; AUnit: TCSSUnit - ): TSVGText; -var - a: ArrayOfTFloatWithCSSUnit; -begin - result := TSVGText.Create(FDoc,Units,FDataLink); - setlength(a,1); - try - a[0] := FloatWithCSSUnit(x,AUnit); - result.x := a; - a[0] := FloatWithCSSUnit(y,AUnit); - result.y := a; - finally - setlength(a,0); - end; - if AText <> '' then - result.SimpleText:= AText; - AppendElement(result); -end; - -function TSVGContent.AppendText(origin: TPointF; AText: string; AUnit: TCSSUnit - ): TSVGText; -begin - result := AppendText(origin.x,origin.y,AText,AUnit); -end; - -function TSVGContent.AppendTextSpan(AText: string): TSVGTSpan; -begin - result := TSVGTSpan.Create(FDoc,Units,FDataLink); - result.SimpleText:= AText; - AppendElement(result); -end; - -function TSVGContent.AppendRoundRect(x, y, width, height, rx, ry: single; - AUnit: TCSSUnit): TSVGRectangle; -begin - result := TSVGRectangle.Create(FDoc,Units,FDataLink); - result.x := FloatWithCSSUnit(x,AUnit); - result.y := FloatWithCSSUnit(y,AUnit); - result.width := FloatWithCSSUnit(width,AUnit); - result.height := FloatWithCSSUnit(height,AUnit); - result.rx := FloatWithCSSUnit(rx,AUnit); - result.ry := FloatWithCSSUnit(ry,AUnit); - AppendElement(result); -end; - -function TSVGContent.AppendRoundRect(origin, size, radius: TPointF; - AUnit: TCSSUnit): TSVGRectangle; -begin - result := AppendRoundRect(origin.x,origin.y,size.x,size.y,radius.x,radius.y,AUnit); -end; - -function TSVGContent.AppendGroup: TSVGGroup; -begin - result := TSVGGroup.Create(FDoc, Units, FDataLink); - AppendElement(result); -end; - -function TSVGContent.IndexOfElement(AElement: TObject): integer; -begin - result := FElements.IndexOf(AElement); -end; - -end. - diff --git a/components/bgrabitmap/bgrasvgtype.pas b/components/bgrabitmap/bgrasvgtype.pas deleted file mode 100644 index 57ed4ee..0000000 --- a/components/bgrabitmap/bgrasvgtype.pas +++ /dev/null @@ -1,2468 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRASVGType; - -{$mode objfpc}{$H+} -{$MODESWITCH ADVANCEDRECORDS} - -interface - -uses - BGRAClasses, SysUtils, BGRATransform, BGRABitmapTypes, BGRAUnits, - DOM, BGRACanvas2D, fgl, BGRAGraphics; - -type - ArrayOfFloat = array of single; - ArrayOfString = array of string; - - TSVGElement = class; - TSVGElementList = specialize TFPGList; - TSVGElementDictionary = specialize TFPGMap; - TSVGFactory = class of TSVGElement; - - TSVGFillMode = ( - sfmEvenOdd = Ord(fmAlternate), - sfmNonZero = Ord(fmWinding) - ); - - TSVGPaintOrder = ( - spoFillStrokeMarkers, - spoFillMarkersStroke, - spoStrokeFillMarkers, - spoStrokeMarkersFill, - spoMarkersFillStroke, - spoMarkersStrokeFill - ); - - TSVGLengthAdjust = ( - slaSpacing, - slaSpacingAndGlyphs - ); - - TSVGTextPathMethod = ( - stpmAlign, - stpmStretch - ); - - TSVGTextPathSpacing = ( - stpsAuto, - stpsExact - ); - - TSVGTextAnchor = ( - staStart, - staMiddle, - staEnd - ); - - TSVGTextDirection = ( - stdLtr, - stdRtl - ); - - TSVGObjectUnits = ( - souUserSpaceOnUse, - souObjectBoundingBox - ); - - TSVGSpreadMethod = ( - ssmPad, - ssmReflect, - ssmRepeat - ); - - TSVGColorInterpolation = ( - sciStdRGB, - sciLinearRGB - ); - - TSVGImageRendering = ( - sirAuto, - sirSmooth, - sirHighQuality, - sirCrispEdges, - sirPixelated - ); - - TSVGRenderingIntent = ( - sriAuto, - sriPerceptual, - sriRelativeColorimetric, - sriSaturation, - sriAbsoluteColorimetric - ); - - TSVGMarkerUnits = ( - smuStrokeWidth, - smuUserSpaceOnUse - ); - - TSVGOrientAuto = (soaNone,soaAuto,soaAutoReverse); - TSVGOrient = record - auto: TSVGOrientAuto; - angle: TSVGNumber; - end; - - TFindStyleState = (fssNotSearched, - fssNotFound, - fssFound); - TStyleAttribute = record - attr : string; - pos : integer; - end; - ArrayOfTStyleAttribute = array of TStyleAttribute; - - { TSVGViewBox } - - TSVGViewBox = record - min, size: TPointF; - function ToString: string; - class function Parse(AValue: string): TSVGViewBox; static; - class function DefaultValue: TSVGViewBox; static; - end; - TSVGSize = record - width, height: TFloatWithCSSUnit; - end; - - { TSVGPreserveAspectRatio } - - TSVGPreserveAspectRatio = record - Preserve, Slice: boolean; - HorizAlign: TAlignment; - VertAlign: TTextLayout; - function ToString: string; - class function Parse(AValue: string): TSVGPreserveAspectRatio; static; - class function DefaultValue: TSVGPreserveAspectRatio; static; - end; - - TSVGRecomputeEvent = procedure(Sender: TObject) of object; - TSVGLinkEvent = procedure(Sender: TObject; AElement: TSVGElement; ALink: boolean) of object; - TSVGLinkListeners = specialize TFPGList; - - { TSVGDataLink } - - TSVGDataLink = class - private - FElements: TSVGElementDictionary; - FStyles: TSVGElementList; - FParent: TSVGDataLink; - FChildren: TList; - FLinkListeners: TSVGLinkListeners; - function GetElement(AIndex: integer): TSVGElement; - function GetStyle(AIndex: integer): TSVGElement; - function IsValidIndex(const AIndex: integer; list: TSVGElementList): boolean; - function FindTo(el: TSVGElement; list: TSVGElementList): integer; - procedure NotifyLink(AElement: TSVGElement; ALink: boolean); - procedure SetParent(AValue: TSVGDataLink); - public - constructor Create(AParent: TSVGDataLink); - destructor Destroy; override; - - function ElementCount: integer; - function StyleCount: integer; - function FindElement(el: TSVGElement): integer; - function FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; - function FindElementByRef(ARef: string; AClass: TSVGFactory): TSVGElement; - function FindElementByRef(ARef: string; ANeedUrl: boolean; AClass: TSVGFactory; out ANotFound: boolean): TSVGElement; - function FindStyle(el: TSVGElement): integer; - function IsLinkElement(el: TSVGElement): boolean; - function IsLinkStyle(el: TSVGElement): boolean; - function IsLink(el: TSVGElement): boolean; - function Link(el: TSVGElement): integer; - procedure Unlink(el: TSVGElement); - procedure UnlinkAll; - procedure RegisterLinkListener(AHandler: TSVGLinkEvent; ARegister: boolean); - - property Styles[ID: integer]: TSVGElement read GetStyle; - property Elements[AIndex: integer]: TSVGElement read GetElement; - property Parent: TSVGDataLink read FParent write SetParent; - end; - - { TSVGCustomElement } - - TSVGCustomElement = class - protected - FDomElem: TDOMElement; - FUnits: TCSSUnitConverter; - function GetDOMElement: TDOMElement; virtual; - - function GetAttributeFromElement(ANode: TDOMElement; AName: string; ACanInherit: boolean): string; - function GetAttribute(AName: string; ADefault: string; ACanInherit: boolean): string; overload; - function GetAttribute(AName: string; ADefault: string): string; overload; - function GetAttribute(AName: string): string; overload; - function GetAttributeNumber(AName: string; ADefault: TSVGNumber): TSVGNumber; overload; - function GetArrayOfAttributeNumber(AName: string): ArrayOfTSVGNumber; - function GetArrayOfAttributeNumber(AName: string; ACanInherit: boolean): ArrayOfTSVGNumber; - function GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; - function GetAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload; - function GetArrayOfAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; - function GetArrayOfAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - - function GetHorizAttribute(AName: string; ADefault: TSVGNumber): TSVGNumber; - function GetHorizAttribute(AName: string): TSVGNumber; - function GetHorizAttributeWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; - function GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit; - function GetArrayOfHorizAttributeWithUnit(AName: string; - ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; - function GetArrayOfHorizAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - - function GetVerticalAttribute(AName: string; ADefault: TSVGNumber): TSVGNumber; - function GetVerticalAttribute(AName: string): TSVGNumber; - function GetVerticalAttributeWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; - function GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit; - function GetArrayOfVerticalAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - function GetArrayOfVerticalAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; - - function GetOrthoAttributeWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; - function GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit; - function GetArrayOfOrthoAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - function GetArrayOfOrthoAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; - - function GetAttributeOrStyle(AName,ADefault: string; ACanInherit: boolean): string; overload; - function GetAttributeOrStyle(AName,ADefault: string): string; overload; - function GetAttributeOrStyle(AName: string): string; overload; - function GetHorizAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; - function GetArrayOfHorizAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - function GetOrthoAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; - function GetArrayOfOrthoAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - function GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; overload; - function GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; - function GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit; overload; - function GetArrayOfAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - function GetVerticalAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; overload; - function GetVerticalAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; - function GetArrayOfVerticalAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; - - function GetNamespaceCount: integer; - function GetNamespacePrefix(AIndex: integer): string; - function GetNamespaceURI(APrefix: string): string; - - class function GetPropertyFromStyleDeclarationBlock(ABlock: string; - AProperty: string; ADefault: string): string; - class procedure LocateStyleDeclaration(AText: string; AProperty: string; - out AStartPos, AColonPos, AValueLength: integer); - class procedure UpdateStyleDeclarationBlock(var ABlock: string; AProperty: string; AValue: string); - class function RemovePropertyFromDeclarationBlock(var ABlock: string; AProperty: string): boolean; - function GetInlineStyle(const AName,ADefault: string): string; - function GetInlineStyleWithUnit(const AName: string): TFloatWithCSSUnit; overload; - function GetInlineStyleWithUnit(const AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; - function GetStyleFromStyleSheet(const {%H-}AName,ADefault: string): string; virtual; - function GetStyle(const AName,ADefault: string): string; overload; - function GetStyle(const AName: string): string; overload; - - procedure SetAttribute(AName: string; AValue: TSVGNumber); virtual; overload; - procedure SetAttribute(AName: string; AValue: string); virtual; overload; - procedure SetAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); - procedure SetArrayOfAttributeWithUnit(AName: string; const AValue: ArrayOfTFloatWithCSSUnit); - - procedure SetHorizAttribute(AName: string; AValue: TSVGNumber); - procedure SetHorizAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); - procedure SetArrayOfHorizAttributeWithUnit(AName: string; - AValue: ArrayOfTFloatWithCSSUnit); - - procedure SetVerticalAttribute(AName: string; AValue: TSVGNumber); - procedure SetArrayOfAttributeNumber(AName: string; AValue: ArrayOfTSVGNumber); - procedure SetVerticalAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); - procedure SetArrayOfVerticalAttributeWithUnit(AName: string; AValue: ArrayOfTFloatWithCSSUnit); - - procedure SetOrthoAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit); - procedure SetArrayOfOrthoAttributeWithUnit(AName: string; AValue: ArrayOfTFloatWithCSSUnit); - - procedure SetNamespaceURI(APrefix: string; AValue: string); - - procedure SetInlineStyle(AName: string; AValue: string); overload; - procedure SetInlineStyle(AName: string; AValue: TFloatWithCSSUnit); overload; - public - procedure RemoveStyle(const AName: string); - function HasAttribute(AName: string): boolean; - function HasInlineStyle(AName: string): boolean; - - procedure ConvertToUnit(AUnit: TCSSUnit); virtual; - function EnterFontSize(AIsRoot: boolean = false): TFloatWithCSSUnit; virtual; - procedure ExitFontSize(APrevFontSize: TFloatWithCSSUnit); virtual; - - function MatrixToTransform(m: TAffineMatrix; AFromUnit: TCSSUnit): string; - function TransformToMatrix(ATransform: string; AToUnit: TCSSUnit): TAffineMatrix; - - procedure RemoveNamespace(APrefix: string); - function NeedNamespace(APrefix: string): boolean; - property NamespaceURI[APrefix: string]: string read GetNamespaceURI write SetNamespaceURI; - property NamespacePrefix[AIndex: integer]: string read GetNamespacePrefix; - property NamespaceCount: integer read GetNamespaceCount; - - property Style[AName: string]: string read GetStyle write SetInlineStyle; - property StyleDef[AName,ADefault: string]: string read GetStyle; - end; - - { TSVGElement } - - TSVGElement = class(TSVGCustomElement) - private - FImportStyleState: TFindStyleState; - FImportedStyles: ArrayOfTStyleAttribute; - function GetClipPath: string; - function GetFill: string; - function GetFillColor: TBGRAPixel; - function GetFillOpacity: single; - function GetFillRule: string; - function GetIsFillNone: boolean; - function GetIsStrokeNone: boolean; - function GetMatrix(AUnit: TCSSUnit): TAffineMatrix; - function GetMixBlendMode: TBlendOperation; - function GetOpacity: single; - function GetPaintOrder: TSVGPaintOrder; - function GetStroke: string; - function GetStrokeColor: TBGRAPixel; - function GetStrokeLineCap: string; - function GetStrokeLineCapLCL: TPenEndCap; - function GetStrokeLineJoin: string; - function GetStrokeLineJoinLCL: TPenJoinStyle; - function GetStrokeMiterLimit: single; - function GetStrokeOpacity: single; - function GetStrokeWidth: TFloatWithCSSUnit; - function GetStrokeDashArray: string; - function GetStrokeDashArrayF: ArrayOfFloat; - function GetStrokeDashOffset: TFloatWithCSSUnit; - function GetTransform: string; - function GetID: string; - function GetClassAttr: string; - function GetVisible: boolean; - procedure SetClipPath(AValue: string); - procedure SetFillColor(AValue: TBGRAPixel); - procedure SetFillOpacity(AValue: single); - procedure SetFillRule(AValue: string); - procedure SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix); - procedure SetMixBlendMode(AValue: TBlendOperation); - procedure SetOpacity(AValue: single); - procedure SetPaintOrder(AValue: TSVGPaintOrder); - procedure SetStrokeColor(AValue: TBGRAPixel); - procedure SetStrokeLineCap(AValue: string); - procedure SetStrokeLineCapLCL(AValue: TPenEndCap); - procedure SetStrokeLineJoin(AValue: string); - procedure SetStrokeLineJoinLCL(AValue: TPenJoinStyle); - procedure SetStrokeMiterLimit(AValue: single); - procedure SetStrokeOpacity(AValue: single); - procedure SetStrokeWidth(AValue: TFloatWithCSSUnit); - procedure SetStrokeDashArray(AValue: string); - procedure SetStrokeDashArrayF(AValue: ArrayOfFloat); - procedure SetStrokeDashOffset(AValue: TFloatWithCSSUnit); - procedure SetTransform(AValue: string); - procedure SetID(AValue: string); - procedure SetClassAttr(AValue: string); - function FindStyleElementInternal(const classStr: string; - out attributesStr: string): integer; - procedure ImportStyles; - procedure SetVisible(AValue: boolean); - protected - FDataLink: TSVGDataLink; - procedure Init(ADocument: TDOMDocument; ATag: string; AUnits: TCSSUnitConverter); overload; - procedure Init(AElement: TDOMElement; AUnits: TCSSUnitConverter); overload; - procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual; - function GetStyleFromStyleSheet(const AName,ADefault: string): string; override; - procedure ApplyFillStyle(ACanvas2D: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual; - procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); virtual; - procedure SetDatalink(AValue: TSVGDataLink); virtual; - procedure SetFill(AValue: string); virtual; - procedure SetStroke(AValue: string); virtual; - procedure Initialize; virtual; - procedure Paint(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); - public - constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual; - constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual; - class function GetDOMTag: string; virtual; - destructor Destroy; override; - procedure ListIdentifiers(AResult: TStringList); virtual; - procedure RenameIdentifiers(AFrom, ATo: TStringList); virtual; - procedure ConvertToUnit(AUnit: TCSSUnit); override; - procedure Recompute; virtual; - procedure Draw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); - procedure fillNone; - procedure strokeNone; - procedure strokeDashArrayNone; - procedure transformNone; - function fillMode: TSVGFillMode; - property DataLink: TSVGDataLink read FDataLink write SetDataLink; - property DOMElement: TDOMElement read GetDOMElement; - property Units: TCSSUnitConverter read FUnits; - property ID: string read GetID write SetID; - property classAttr: string read GetClassAttr write SetClassAttr; - property transform: string read GetTransform write SetTransform; - property matrix[AUnit: TCSSUnit]: TAffineMatrix read GetMatrix write SetMatrix; - property isFillNone: boolean read GetIsFillNone; - property isStrokeNone: boolean read GetIsStrokeNone; - property stroke: string read GetStroke write SetStroke; - property strokeWidth: TFloatWithCSSUnit read GetStrokeWidth write SetStrokeWidth; - property strokeColor: TBGRAPixel read GetStrokeColor write SetStrokeColor; - property strokeOpacity: single read GetStrokeOpacity write SetStrokeOpacity; - property strokeMiterLimit: single read GetStrokeMiterLimit write SetStrokeMiterLimit; - property strokeLineJoin: string read GetStrokeLineJoin write SetStrokeLineJoin; - property strokeLineJoinLCL: TPenJoinStyle read GetStrokeLineJoinLCL write SetStrokeLineJoinLCL; - property strokeLineCap: string read GetStrokeLineCap write SetStrokeLineCap; - property strokeLineCapLCL: TPenEndCap read GetStrokeLineCapLCL write SetStrokeLineCapLCL; - property strokeDashArray: string read GetStrokeDashArray write SetStrokeDashArray; - property strokeDashArrayF: ArrayOfFloat read GetStrokeDashArrayF write SetStrokeDashArrayF; - property strokeDashOffset: TFloatWithCSSUnit read GetStrokeDashOffset write SetStrokeDashOffset; - property fill: string read GetFill write SetFill; - property fillColor: TBGRAPixel read GetFillColor write SetFillColor; - property fillOpacity: single read GetFillOpacity write SetFillOpacity; - property fillRule: string read GetFillRule write SetFillRule; - property paintOrder: TSVGPaintOrder read GetPaintOrder write SetPaintOrder; - property mixBlendMode: TBlendOperation read GetMixBlendMode write SetMixBlendMode; - property opacity: single read GetOpacity write SetOpacity; - property clipPath: string read GetClipPath write SetClipPath; - property Visible: boolean read GetVisible write SetVisible; - - property Attribute[AName: string]: string read GetAttribute write SetAttribute; - property AttributeDef[AName,ADefault: string]: string read GetAttribute; - property AttributeOrStyleDef[AName,ADefault: string]: string read GetAttributeOrStyle; - property AttributeOrStyle[AName: string]: string read GetAttributeOrStyle; - property AttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetAttributeWithUnit; - property AttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetAttributeWithUnit write SetAttributeWithUnit; - property ArrayOfAttributeWithUnitInherit[AName: string; ACanInherit: boolean]: ArrayOfTFloatWithCSSUnit read GetArrayOfAttributeWithUnit; - property ArrayOfAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfAttributeWithUnit write SetArrayOfAttributeWithUnit; - - property ArrayOfAttributeNumberInherit[AName: string; ACanInherit: boolean]: ArrayOfTSVGNumber read GetArrayOfAttributeNumber; - property ArrayOfAttributeNumber[AName: string]: ArrayOfTSVGNumber read GetArrayOfAttributeNumber write SetArrayOfAttributeNumber; - - property HorizAttributeDef[AName: string; ADefault: TSVGNumber]: TSVGNumber read GetHorizAttribute; - property HorizAttribute[AName: string]: TSVGNumber read GetHorizAttribute write SetHorizAttribute; - property HorizAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeWithUnit; - property HorizAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetHorizAttributeWithUnit write SetHorizAttributeWithUnit; - property HorizAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeOrStyleWithUnit; - property ArrayOfHorizAttributeWithUnitInherit[AName: string; ACanInherit: boolean]: ArrayOfTFloatWithCSSUnit read GetArrayOfHorizAttributeWithUnit; - property ArrayOfHorizAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfHorizAttributeWithUnit write SetArrayOfHorizAttributeWithUnit; - property ArrayOfHorizAttributeOrStyleWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfHorizAttributeOrStyleWithUnit; - - property VerticalAttributeDef[AName: string; ADefault: TSVGNumber]: TSVGNumber read GetVerticalAttribute; - property VerticalAttribute[AName: string]: TSVGNumber read GetVerticalAttribute write SetVerticalAttribute; - property VerticalAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit; - property VerticalAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit write SetVerticalAttributeWithUnit; - property VerticalAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeOrStyleWithUnit; - property ArrayOfVerticalAttributeWithUnitInherit[AName: string; ACanInherit: boolean]: ArrayOfTFloatWithCSSUnit read GetArrayOfVerticalAttributeWithUnit; - property ArrayOfVerticalAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfVerticalAttributeWithUnit write SetArrayOfVerticalAttributeWithUnit; - property ArrayOfVerticalAttributeOrStyleWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfVerticalAttributeOrStyleWithUnit; - - property OrthoAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit; - property OrthoAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit write SetOrthoAttributeWithUnit; - property OrthoAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeOrStyleWithUnit; - property ArrayOfOrthoAttributeWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfOrthoAttributeWithUnit write SetArrayOfOrthoAttributeWithUnit; - property ArrayOfOrthoAttributeOrStyleWithUnit[AName: string]: ArrayOfTFloatWithCSSUnit read GetArrayOfOrthoAttributeOrStyleWithUnit; - end; - - { TSVGParser } - - TSVGParser = class - private - function GetDone: boolean; - protected - FPos: integer; - FNumberError: boolean; - FText: string; - public - constructor Create(AText: string); - function ParseFloat: single; - function ParseId: string; - function ParseSymbol: char; - function ParseTransform: TAffineMatrix; - procedure SkipSymbol(ASymbol: char); - procedure SkipUpToSymbol(ASymbol:char); - procedure ClearError; - property Position: integer read FPos write FPos; - property NumberError: boolean read FNumberError; - property Text: string read FText; - property Done: boolean read GetDone; - end; - - resourcestring - rsInvalidIndex = 'Invalid index'; - -implementation - -uses BGRASVGShapes; - -{ TSVGCustomElement } - -function TSVGCustomElement.GetNamespaceCount: integer; -var - i: Integer; - name: string; -begin - result := 0; - for i := 0 to FDomElem.Attributes.Length-1 do - begin - name := FDomElem.Attributes.Item[i].NodeName; - if name.StartsWith('xmlns:') then inc(result); - end; -end; - -function TSVGCustomElement.GetNamespacePrefix(AIndex: integer): string; -var - i: Integer; - name: string; -begin - if AIndex < 0 then exit(''); - result := ''; - for i := 0 to FDomElem.Attributes.Length-1 do - begin - name := FDomElem.Attributes.Item[i].NodeName; - if name.StartsWith('xmlns:') then - begin - if AIndex > 0 then dec(AIndex) - else exit(name.Substring(6)); - end; - end; -end; - -function TSVGCustomElement.GetNamespaceURI(APrefix: string): string; -begin - result := GetAttribute('xmlns:' + APrefix); -end; - -procedure TSVGCustomElement.SetNamespaceURI(APrefix: string; AValue: string); -begin - if AValue = '' then FDomElem.RemoveAttribute('xmlns:' + APrefix) - else SetAttribute('xmlns:' + APrefix, AValue); -end; - -function TSVGCustomElement.GetDOMElement: TDOMElement; -begin - result := FDomElem; -end; - -function TSVGCustomElement.GetAttributeOrStyle(AName, ADefault: string; - ACanInherit: boolean): string; -var - curNode: TDOMElement; - styleDecl: DOMString; -begin - result := GetInlineStyle(AName,''); - if result = '' then - begin - result := GetStyleFromStyleSheet(AName,''); - if result = '' then - begin - result := GetAttributeFromElement(FDomElem, AName, false); - if (result = 'currentColor') and (AName <> 'color') then - begin - AName := 'color'; - result := GetAttributeFromElement(FDomElem, AName, false); - end; - - if result = '' then - begin - if ACanInherit then - begin - curNode := FDomElem; - while true do - begin - if curNode.ParentNode is TDOMElement then - curNode := TDOMElement(curNode.ParentNode) - else break; - - styleDecl := curNode.GetAttribute('style'); - result := GetPropertyFromStyleDeclarationBlock(styleDecl, AName, ''); - if result <> '' then exit; - result := GetAttributeFromElement(curNode, AName, false); - if (result = 'currentColor') and (AName <> 'color') then - begin - curNode := FDomElem; - AName := 'color'; - continue; - end; - if result <> '' then exit; - end; - end; - result := ADefault; - end; - end; - end; -end; - -function TSVGCustomElement.GetAttributeOrStyle(AName, ADefault: string): string; -begin - result := GetAttributeOrStyle(AName, ADefault, true); -end; - -function TSVGCustomElement.GetAttributeOrStyle(AName: string): string; -begin - result:= GetAttributeOrStyle(AName,''); -end; - -function TSVGCustomElement.GetHorizAttributeOrStyleWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := GetAttributeOrStyleWithUnit(AName,ADefault); -end; - -function TSVGCustomElement.GetArrayOfHorizAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfAttributeOrStyleWithUnit(AName); -end; - -function TSVGCustomElement.GetOrthoAttributeOrStyleWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := GetAttributeOrStyleWithUnit(AName,ADefault); -end; - -function TSVGCustomElement.GetArrayOfOrthoAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfAttributeOrStyleWithUnit(AName); -end; - -class procedure TSVGCustomElement.LocateStyleDeclaration(AText: string; AProperty: string; out AStartPos, - AColonPos, AValueLength: integer); -var i: integer; - curStart,curColon,curValueLength: integer; - - function CheckShouldReturnResult: boolean; - begin - if Trim(Copy(AText,curStart,curColon-curStart)) = AProperty then - begin - AStartPos:= curStart; - AColonPos:= curColon; - AValueLength:= curValueLength; - result := true - end - else - result := false - end; - -begin - AProperty := Trim(AProperty); - AStartPos := -1; - AColonPos := -1; - AValueLength:= -1; - curStart := -1; - curColon := -1; - curValueLength := -1; - for i := 1 to length(AText) do - begin - if curStart = -1 then - begin - if AText[i] in['-','_','a'..'z','A'..'Z','\'] then - begin - curStart := i; - curColon := -1; - end; - end else - if curColon = -1 then - begin - if AText[i] = ':' then - begin - curColon := i; - curValueLength:= -1; - end; - end else - if AText[i] = ';' then - begin - curValueLength := i-(curColon+1); - if CheckShouldReturnResult then exit; - curStart := -1; - curColon := -1; - curValueLength:= -1; - end; - end; - if curColon <> -1 then - begin - curValueLength:= length(AText)-(curColon+1)+1; - if CheckShouldReturnResult then exit; - end; -end; - -class procedure TSVGCustomElement.UpdateStyleDeclarationBlock(var ABlock: string; - AProperty: string; AValue: string); -var - startPos, colonPos, valueLength: integer; -begin - if pos(';',AValue)<>0 then - raise exception.Create('Invalid character in value'); - if pos(':',AProperty)<>0 then - raise exception.Create('Invalid character in name'); - LocateStyleDeclaration(ABlock, AProperty, startPos,colonPos, valueLength); - if valueLength <> -1 then - begin - delete(ABlock, colonPos+1, valueLength); - insert(' '+Trim(AValue), ABlock, colonPos+1); - end else - begin - while (length(ABlock) > 0) and (ABlock[length(ABlock)] in[' ',#9,#10,#12,#13]) do - delete(ABlock, length(ABlock), 1); - if length(ABlock)>0 then - begin - if ABlock[length(ABlock)] <> ';' then AppendStr(ABlock, '; '); - end; - AppendStr(ABlock, AProperty+': '+AValue); - end; -end; - -class function TSVGCustomElement.RemovePropertyFromDeclarationBlock( - var ABlock: string; AProperty: string): boolean; -var - startPos, colonPos, valueLength: integer; -begin - LocateStyleDeclaration(ABlock, AProperty, startPos,colonPos, valueLength); - if valueLength <> -1 then - begin - delete(ABlock, startPos, colonPos+valueLength-startPos); - while (length(ABlock)>=startPos) and (ABlock[startPos] in[' ',#9,#10,#12,#13]) do delete(ABlock,startPos,1); - if (length(ABlock)>=startPos) and (ABlock[startPos] = ';') then delete(ABlock,startPos,1); - result := true; - end else - result := false; -end; - -class function TSVGCustomElement.GetPropertyFromStyleDeclarationBlock(ABlock: string; - AProperty: string; ADefault: string): string; -var - startPos, colonPos, valueLength: integer; -begin - LocateStyleDeclaration(ABlock, AProperty, startPos,colonPos, valueLength); - if valueLength <> -1 then - result := trim(copy(ABlock, colonPos+1, valueLength)) - else - result := ADefault; -end; - -function TSVGCustomElement.GetInlineStyle(const AName, ADefault: string - ): string; -var - styleDecl: String; -begin - styleDecl := GetAttribute('style','',False); - result := GetPropertyFromStyleDeclarationBlock(styleDecl, AName, ADefault); -end; - -function TSVGCustomElement.GetInlineStyleWithUnit(const AName: string): TFloatWithCSSUnit; -begin - result := GetInlineStyleWithUnit(AName, FloatWithCSSUnit(0, cuCustom)); -end; - -function TSVGCustomElement.GetInlineStyleWithUnit(const AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := TCSSUnitConverter.parseValue(GetInlineStyle(AName, ''), ADefault); -end; - -function TSVGCustomElement.GetStyleFromStyleSheet(const AName, ADefault: string): string; -begin - result := ADefault; -end; - -function TSVGCustomElement.GetStyle(const AName, ADefault: string): string; -var - curNode: TDOMElement; - styleDecl: DOMString; -begin - result:= GetInlineStyle(AName,''); - if result <> '' then exit; - - result := GetStyleFromStyleSheet(AName,''); - if result <> '' then exit; - - curNode := FDomElem; - while true do - begin - if curNode.ParentNode is TDOMElement then - curNode := TDOMElement(curNode.ParentNode) - else break; - - styleDecl := curNode.GetAttribute('style'); - result := GetPropertyFromStyleDeclarationBlock(styleDecl, AName, ''); - if result <> '' then exit; - end; - - result := ADefault; -end; - -function TSVGCustomElement.GetStyle(const AName: string): string; -begin - result:= GetStyle(AName,''); -end; - -function TSVGCustomElement.GetAttributeFromElement(ANode: TDOMElement; - AName: string; ACanInherit: boolean): string; -begin - repeat - if ((AName = 'xlink:href') or (AName = 'xlink:title')) and - not ANode.hasAttribute(AName) and ANode.hasAttribute(AName.Substring(6)) then - result := Trim(ANode.GetAttribute(AName.Substring(6))) - else result := Trim(ANode.GetAttribute(AName)); - - if result = 'inherit' then result := ''; - if (result = '') and ACanInherit and - (ANode.ParentNode is TDOMElement) then - ANode := ANode.ParentNode as TDOMElement - else - ANode := nil; - until ANode = nil; -end; - -function TSVGCustomElement.GetAttribute(AName: string; ADefault: string; - ACanInherit: boolean): string; -begin - result := GetAttributeFromElement(FDomElem, AName, ACanInherit); - if result = '' then result := ADefault else - if (result = 'currentColor') and (AName <> 'color') then - result := GetAttribute('color', ADefault, ACanInherit); -end; - -function TSVGCustomElement.GetAttribute(AName: string; ADefault: string): string; -begin - result := GetAttribute(AName, ADefault, False); -end; - -function TSVGCustomElement.GetAttribute(AName: string): string; -begin - result:= GetAttribute(AName,''); -end; - -function TSVGCustomElement.GetAttributeNumber(AName: string; ADefault: TSVGNumber): TSVGNumber; -begin - result := TCSSUnitConverter.parseValue(GetAttribute(AName),ADefault); -end; - -function TSVGCustomElement.GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := TCSSUnitConverter.parseValue(GetAttribute(AName),ADefault); -end; - -function TSVGCustomElement.GetAttributeWithUnit(AName: string): TFloatWithCSSUnit; -begin - result := GetAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); -end; - -function TSVGCustomElement.GetAttributeOrStyleWithUnit(AName: string; - ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; -var - valueText: string; -begin - valueText := GetAttributeOrStyle(AName, '', ACanInherit); - result := TCSSUnitConverter.parseValue(valueText,ADefault); -end; - -function TSVGCustomElement.GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := GetAttributeOrStyleWithUnit(AName, ADefault, True); -end; - -function TSVGCustomElement.GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit; -begin - result := GetAttributeOrStyleWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); -end; - -function TSVGCustomElement.GetVerticalAttributeOrStyleWithUnit(AName: string; - ADefault: TFloatWithCSSUnit; ACanInherit: boolean): TFloatWithCSSUnit; -begin - result := GetAttributeOrStyleWithUnit(AName,ADefault,ACanInherit); -end; - -function TSVGCustomElement.GetVerticalAttributeOrStyleWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := GetVerticalAttributeOrStyleWithUnit(AName,ADefault,true); -end; - -function TSVGCustomElement.GetArrayOfVerticalAttributeOrStyleWithUnit( - AName: string): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfAttributeOrStyleWithUnit(AName); -end; - -procedure TSVGCustomElement.SetInlineStyle(AName: string; AValue: string); -var - declarationBlock: string; -begin - declarationBlock := GetAttribute('style','',false); - UpdateStyleDeclarationBlock(declarationBlock, AName, AValue); - SetAttribute('style', declarationBlock); -end; - -procedure TSVGCustomElement.SetInlineStyle(AName: string; - AValue: TFloatWithCSSUnit); -begin - SetInlineStyle(AName, FUnits.formatValue(AValue)); -end; - -function TSVGCustomElement.GetOrthoAttributeWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := GetAttributeWithUnit(AName,ADefault); -end; - -function TSVGCustomElement.GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit; -begin - result := GetOrthoAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); -end; - -function TSVGCustomElement.GetHorizAttribute(AName: string; - ADefault: TSVGNumber): TSVGNumber; -var value: TFloatWithCSSUnit; -begin - value.value := GetAttributeNumber(AName,ADefault); - value.CSSUnit := cuPixel; - result := value.value; -end; - -function TSVGCustomElement.GetHorizAttribute(AName: string): TSVGNumber; -begin - result := GetHorizAttribute(AName,0); -end; - -function TSVGCustomElement.GetHorizAttributeWithUnit(AName: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := GetAttributeWithUnit(AName,ADefault); -end; - -function TSVGCustomElement.GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit; -begin - result := GetHorizAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); -end; - -function TSVGCustomElement.GetArrayOfAttributeNumber(AName: string): ArrayOfTSVGNumber; -begin - result := GetArrayOfAttributeNumber(AName,true); -end; - -function TSVGCustomElement.GetArrayOfAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; -begin - result := TCSSUnitConverter.parseArrayOfValuesWithUnit(GetAttribute(AName,'',ACanInherit)); -end; - -function TSVGCustomElement.GetArrayOfAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfAttributeWithUnit(AName,true); -end; - -function TSVGCustomElement.GetArrayOfAttributeOrStyleWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; -var - valueText: string; -begin - valueText := GetAttributeOrStyle(AName); - result := TCSSUnitConverter.parseArrayOfValuesWithUnit(valueText); -end; - -function TSVGCustomElement.GetArrayOfOrthoAttributeWithUnit(AName: string; - ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfAttributeWithUnit(AName, ACanInherit); -end; - -function TSVGCustomElement.GetArrayOfOrthoAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfOrthoAttributeWithUnit(AName, true); -end; - -function TSVGCustomElement.GetArrayOfHorizAttributeWithUnit(AName: string; ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfAttributeWithUnit(AName,ACanInherit); -end; - -function TSVGCustomElement.GetArrayOfHorizAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfHorizAttributeWithUnit(AName,true); -end; - -function TSVGCustomElement.GetArrayOfVerticalAttributeWithUnit(AName: string; - ACanInherit: boolean): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfAttributeWithUnit(AName,ACanInherit); -end; - -function TSVGCustomElement.GetArrayOfAttributeNumber(AName: string; - ACanInherit: boolean): ArrayOfTSVGNumber; -begin - result := TCSSUnitConverter.parseArrayOfNumbers(GetAttribute(AName,'',ACanInherit)); -end; - -function TSVGCustomElement.GetVerticalAttribute(AName: string; ADefault: TSVGNumber): TSVGNumber; -begin - result := GetAttributeNumber(AName,ADefault); -end; - -function TSVGCustomElement.GetVerticalAttribute(AName: string): TSVGNumber; -begin - result := GetVerticalAttribute(AName,0); -end; - -function TSVGCustomElement.GetVerticalAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -begin - result := GetAttributeWithUnit(AName,ADefault); -end; - -function TSVGCustomElement.GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit; -begin - result := GetVerticalAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom)); -end; - -function TSVGCustomElement.GetArrayOfVerticalAttributeWithUnit(AName: string): ArrayOfTFloatWithCSSUnit; -begin - result := GetArrayOfVerticalAttributeWithUnit(AName, True); -end; - -procedure TSVGCustomElement.SetAttribute(AName: string; AValue: TSVGNumber); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.SetAttribute(AName: string; AValue: string); -begin - if ((AName = 'xlink:href') or (AName = 'xlink:title')) and - not FDomElem.hasAttribute(AName) and FDomElem.hasAttribute(AName.Substring(6)) then - FDomElem.SetAttribute(AName.Substring(6), AValue) - else - FDomElem.SetAttribute(AName,AValue); -end; - -procedure TSVGCustomElement.SetAttributeWithUnit(AName: string; - AValue: TFloatWithCSSUnit); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.SetHorizAttribute(AName: string; - AValue: TSVGNumber); -begin - SetAttribute(AName, AValue); -end; - -procedure TSVGCustomElement.SetHorizAttributeWithUnit(AName: string; - AValue: TFloatWithCSSUnit); -begin - SetAttributeWithUnit(AName, AValue); -end; - -procedure TSVGCustomElement.SetArrayOfHorizAttributeWithUnit(AName: string; - AValue: ArrayOfTFloatWithCSSUnit); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.SetVerticalAttribute(AName: string; - AValue: TSVGNumber); -begin - SetAttribute(AName, AValue) -end; - -procedure TSVGCustomElement.SetArrayOfAttributeNumber(AName: string; - AValue: ArrayOfTSVGNumber); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.SetArrayOfAttributeWithUnit(AName: string; - const AValue: ArrayOfTFloatWithCSSUnit); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.SetVerticalAttributeWithUnit(AName: string; - AValue: TFloatWithCSSUnit); -begin - SetAttributeWithUnit(AName, AValue); -end; - -procedure TSVGCustomElement.SetArrayOfVerticalAttributeWithUnit(AName: string; - AValue: ArrayOfTFloatWithCSSUnit); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.SetOrthoAttributeWithUnit(AName: string; - AValue: TFloatWithCSSUnit); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.SetArrayOfOrthoAttributeWithUnit(AName: string; - AValue: ArrayOfTFloatWithCSSUnit); -begin - SetAttribute(AName, TCSSUnitConverter.formatValue(AValue)); -end; - -procedure TSVGCustomElement.RemoveStyle(const AName: string); -var - declarationBlock: string; -begin - declarationBlock := GetAttribute('style','',false); - if RemovePropertyFromDeclarationBlock(declarationBlock, AName) then - SetAttribute('style', declarationBlock); -end; - -function TSVGCustomElement.HasAttribute(AName: string): boolean; -begin - result := FDomElem.hasAttribute(AName); -end; - -function TSVGCustomElement.HasInlineStyle(AName: string): boolean; -begin - result := trim(GetInlineStyle(AName, '')) <> ''; //an empty declaration is illegal -end; - -procedure TSVGCustomElement.ConvertToUnit(AUnit: TCSSUnit); -begin - if HasInlineStyle('stroke-width') then - SetInlineStyle('stroke-width', FUnits.ConvertWidth(GetInlineStyleWithUnit('stroke-width'), AUnit)); - if HasInlineStyle('stroke-dash-offset') then - SetInlineStyle('stroke-dash-offset', FUnits.ConvertWidth(GetInlineStyleWithUnit('stroke-dash-offset'), AUnit)); - if HasInlineStyle('font-size') then - SetInlineStyle('font-size', FUnits.ConvertHeight(GetInlineStyleWithUnit('font-size'), AUnit)); -end; - -function TSVGCustomElement.EnterFontSize(AIsRoot: boolean): TFloatWithCSSUnit; -var - fs: TFloatWithCSSUnit; -begin - result := FUnits.CurrentFontEmHeight; - if AIsRoot then FUnits.CurrentFontEmHeight := FUnits.RootFontEmHeight; - fs := GetAttributeOrStyleWithUnit('font-size', FUnits.CurrentFontEmHeight, false); - if fs.CSSUnit in [cuFontEmHeight,cuFontXHeight] then - fs := FUnits.ConvertHeight(fs, cuCustom); - FUnits.CurrentFontEmHeight:= fs; -end; - -procedure TSVGCustomElement.ExitFontSize(APrevFontSize: TFloatWithCSSUnit); -begin - FUnits.CurrentFontEmHeight := APrevFontSize; -end; - -procedure TSVGCustomElement.RemoveNamespace(APrefix: string); -begin - NamespaceURI['APrefix'] := ''; -end; - -function TSVGCustomElement.NeedNamespace(APrefix: string): boolean; -var - prefixColon: DOMString; - - function NeedNamespaceRec(ANode: TDOMElement): boolean; - var - i: Integer; - begin - for i := 0 to ANode.Attributes.Length-1 do - if copy(ANode.Attributes[i].NodeName, 1, length(prefixColon)) = prefixColon then - exit(true); - - for i := 0 to ANode.ChildNodes.Length-1 do - if (ANode.ChildNodes[i] is TDOMElement) and - NeedNamespaceRec(ANode.ChildNodes[i] as TDOMElement) then - exit(true); - - result := false; - end; - -begin - prefixColon := APrefix+':'; - result := NeedNamespaceRec(FDomElem); -end; - -function TSVGCustomElement.MatrixToTransform(m: TAffineMatrix; - AFromUnit: TCSSUnit): string; -var s: string; - translateStr: string; -begin - translateStr := 'translate('+FUnits.formatValue(FUnits.ConvertWidth(m[1,3],AFromUnit,cuCustom))+' '+ - FUnits.formatValue(FUnits.ConvertHeight(m[2,3],AFromUnit,cuCustom))+')'; - if IsAffineMatrixTranslation(m) then - begin - if IsAffineMatrixIdentity(m) then - result := '' - else result := translateStr; - end else - begin - if (m[1,3] <> 0) or (m[2,3] <> 0) then - begin - s := translateStr; - m[1,3] := 0; - m[2,3] := 0; - end else - s := ''; - if IsAffineMatrixScale(m) then - result := trim(s+' scale('+FUnits.formatValue(m[1,1])+' '+FUnits.formatValue(m[2,2])+')') - else - result := trim(s+' matrix('+FUnits.formatValue(m[1,1])+' '+FUnits.formatValue(m[2,1])+' '+ - FUnits.formatValue(m[1,2])+' '+FUnits.formatValue(m[2,2])+' ' + - FUnits.formatValue(m[1,3])+' '+FUnits.formatValue(m[2,3])+')'); - end; -end; - -function TSVGCustomElement.TransformToMatrix(ATransform: string; - AToUnit: TCSSUnit): TAffineMatrix; -var parser: TSVGParser; -begin - if Trim(ATransform) = '' then - begin - result := AffineMatrixIdentity; - exit; - end; - parser := TSVGParser.Create(ATransform); - result := parser.ParseTransform; - result[1,3] := FUnits.ConvertWidth(result[1,3], cuCustom, AToUnit); - result[2,3] := FUnits.ConvertHeight(result[2,3], cuCustom, AToUnit); - parser.Free; -end; - -{ TSVGViewBox } - -function TSVGViewBox.ToString: string; -begin - result := - TCSSUnitConverter.formatValue(min.x)+' '+ - TCSSUnitConverter.formatValue(min.y)+' '+ - TCSSUnitConverter.formatValue(size.x)+' '+ - TCSSUnitConverter.formatValue(size.y); -end; - -class function TSVGViewBox.Parse(AValue: string): TSVGViewBox; - - function parseNextFloat: single; - var - idxSpace,{%H-}errPos: integer; - begin - idxSpace:= pos(' ',AValue); - if idxSpace <> 0 then - val(copy(AValue,1,idxSpace-1),result,errPos) - else - result := 0; - delete(AValue,1,idxSpace); - while (AValue <> '') and (AValue[1] = ' ') do delete(AValue,1,1); - end; - -begin - AValue := trim(AValue)+' '; - with result do - begin - min.x := parseNextFloat; - min.y := parseNextFloat; - size.x := parseNextFloat; - size.y := parseNextFloat; - end; -end; - -class function TSVGViewBox.DefaultValue: TSVGViewBox; -begin - with result do - begin - min.x := 0; - min.y := 0; - size.x := 0; - size.y := 0; - end; -end; - -{ TSVGPreserveAspectRatio } - -function TSVGPreserveAspectRatio.ToString: string; -begin - if not Preserve then result := 'none' else - begin - result := ''; - case HorizAlign of - taCenter: AppendStr(result, 'xMid'); - taRightJustify: AppendStr(result, 'xMax'); - else AppendStr(result, 'xMin'); - end; - case VertAlign of - tlCenter: AppendStr(result, 'YMid'); - tlBottom: AppendStr(result, 'YMax'); - else AppendStr(result, 'YMin'); - end; - if Slice then AppendStr(result, ' slice') - else AppendStr(result, ' meet'); - end; -end; - -class function TSVGPreserveAspectRatio.Parse(AValue: string - ): TSVGPreserveAspectRatio; -var p: TSVGParser; - id: string; -begin - p := TSVGParser.Create(AValue); - result := DefaultValue; - repeat - id := p.ParseId; - if id = 'none' then - begin - result.Preserve := false; - //set other parameters for intermediate value of ViewSize (before stretching non-proportionaly) - result.Slice := false; - result.HorizAlign := taCenter; - result.VertAlign := tlCenter; - exit; - end else - if id = 'slice' then result.Slice := true - else if (length(id)=8) and (id[1] = 'x') and (id[5] = 'Y') then - begin - case copy(id,2,3) of - 'Min': result.HorizAlign := taLeftJustify; - 'Mid': result.HorizAlign := taCenter; - 'Max': result.HorizAlign := taRightJustify; - end; - case copy(id,6,3) of - 'Min': result.VertAlign := tlTop; - 'Mid': result.VertAlign := tlCenter; - 'Max': result.VertAlign := tlBottom; - end; - end; - until id = ''; - p.Free; -end; - -class function TSVGPreserveAspectRatio.DefaultValue: TSVGPreserveAspectRatio; -begin - result.Preserve := true; - result.Slice := false; - result.HorizAlign := taCenter; - result.VertAlign := tlCenter; -end; - -{ TSVGParser } - -function TSVGParser.GetDone: boolean; -begin - result := FPos>length(FText) -end; - -constructor TSVGParser.Create(AText: string); -begin - FNumberError:= false; - FPos := 1; - FText := AText; -end; - -function TSVGParser.ParseFloat: single; -var numberStart: integer; - errPos: integer; -begin - while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); - numberStart:= FPos; - if (FPos <= length(FText)) and (FText[FPos] in['+','-']) then inc(FPos); - while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','.']) do inc(FPos); - if (FPos <= length(FText)) and (FText[FPos] in['e','E']) then inc(FPos); - if (FPos <= length(FText)) and (FText[FPos] in['+','-']) then inc(FPos); - while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','.']) do inc(FPos); - if FPos = numberStart then - begin - FNumberError := true; - result := 0; - end - else - begin - val(copy(FText,numberStart,FPos-numberStart),result,errPos); - if errPos <> 0 then FNumberError := true; - end; -end; - -function TSVGParser.ParseId: string; -var idStart: integer; -begin - while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); - idStart:= FPos; - if (FPos <= length(FText)) and (FText[FPos] in['A'..'Z','a'..'z']) then inc(FPos); - while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','A'..'Z','a'..'z','_']) do inc(FPos); - result := copy(FText,idStart,FPos-idStart); -end; - -function TSVGParser.ParseSymbol: char; -begin - while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); - if (FPos <= length(FText)) and not (FText[FPos] in['A'..'Z','a'..'z','0'..'9']) then - begin - result := FText[FPos]; - inc(FPos); - end else - result := #0; -end; - -function TSVGParser.ParseTransform: TAffineMatrix; -var - kind: String; - m : TAffineMatrix; - angle,tx,ty: single; -begin - result := AffineMatrixIdentity; - while not Done do - begin - kind := ParseId; - if kind = '' then break; - if ParseSymbol <> '(' then break; - if compareText(kind,'matrix')=0 then - begin - m[1,1] := ParseFloat; - SkipSymbol(','); - m[2,1] := ParseFloat; - SkipSymbol(','); - m[1,2] := ParseFloat; - SkipSymbol(','); - m[2,2] := ParseFloat; - SkipSymbol(','); - m[1,3] := ParseFloat; - SkipSymbol(','); - m[2,3] := ParseFloat; - result := result * m; - end else - if compareText(kind,'translate')=0 then - begin - tx := ParseFloat; - SkipSymbol(','); - ty := ParseFloat; - result := result * AffineMatrixTranslation(tx,ty); - end else - if compareText(kind,'scale')=0 then - begin - tx := ParseFloat; - SkipSymbol(','); - ClearError; - ty := ParseFloat; - if NumberError then ty := tx; - result := result * AffineMatrixScale(tx,ty); - end else - if compareText(kind,'rotate')=0 then - begin - angle := ParseFloat; - SkipSymbol(','); - tx := ParseFloat; - SkipSymbol(','); - ty := ParseFloat; - result := result * AffineMatrixTranslation(tx,ty)* - AffineMatrixRotationDeg(angle)* - AffineMatrixTranslation(-tx,-ty); - end else - if compareText(kind,'skewx')=0 then - begin - angle := ParseFloat; - result := result * AffineMatrixSkewXDeg(angle); - end else - if compareText(kind,'skewy')=0 then - begin - angle := ParseFloat; - result := result * AffineMatrixSkewYDeg(angle); - end; - SkipUpToSymbol(')'); - end; -end; - -procedure TSVGParser.SkipSymbol(ASymbol: char); -begin - while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos); - if (FPos <= length(FText)) and (FText[FPos] = ASymbol) then inc(FPos); -end; - -procedure TSVGParser.SkipUpToSymbol(ASymbol: char); -begin - while (FPos <= length(FText)) and (FText[FPos]<>ASymbol) do inc(FPos); - if (FPos <= length(FText)) and (FText[FPos]=ASymbol) then inc(FPos); -end; - -procedure TSVGParser.ClearError; -begin - FNumberError:= false; -end; - -{ TSVGDataLink } - -constructor TSVGDataLink.Create(AParent: TSVGDataLink); -begin - FElements:= TSVGElementDictionary.Create; - FElements.Sorted := true; - FStyles:= TSVGElementList.Create; - FParent := AParent; - if Assigned(FParent) then FParent.FChildren.Add(self); - FLinkListeners := TSVGLinkListeners.Create; - FChildren := TList.Create; -end; - -destructor TSVGDataLink.Destroy; -var - i: Integer; -begin - for i := FChildren.Count-1 downto 0 do - TSVGDatalink(FChildren[i]).Parent := nil; - Parent := nil; - FreeAndNil(FChildren); - FreeAndNil(FLinkListeners); - FreeAndNil(FElements); - FreeAndNil(FStyles); - inherited Destroy; -end; - -function TSVGDataLink.GetElement(AIndex: integer): TSVGElement; -begin - if (AIndex < 0) or (AIndex > FElements.Count) then - raise exception.Create(rsInvalidIndex); - result:= FElements.Data[AIndex]; -end; - -function TSVGDataLink.GetStyle(AIndex: integer): TSVGElement; -begin - if not IsValidIndex(AIndex,FStyles) then - raise exception.Create(rsInvalidIndex); - result:= FStyles[AIndex]; -end; - -function TSVGDataLink.IsValidIndex(const AIndex: integer; list: TSVGElementList): boolean; -begin - result:= (AIndex >= 0) and (AIndex < list.Count); -end; - -function TSVGDataLink.FindTo(el: TSVGElement; list: TSVGElementList): integer; -begin - result := list.IndexOf(el); -end; - -procedure TSVGDataLink.NotifyLink(AElement: TSVGElement; ALink: boolean); -var - i: Integer; - temp: array of TSVGLinkEvent; -begin - // make copy because listeners might change the list - SetLength(temp, FLinkListeners.Count); - for i:= 0 to high(temp) do - temp[i] := FLinkListeners.Items[i]; - for i := 0 to high(temp) do - temp[i](self, AElement, ALink); - // children datalinks may use the element - for i := FChildren.Count-1 downto 0 do - TSVGDataLink(FChildren[i]).NotifyLink(AElement, ALink); -end; - -procedure TSVGDataLink.SetParent(AValue: TSVGDataLink); - // notify link change for all elements and parent elements - procedure NotifyLinkRec(ADatalink: TSVGDataLink; ALink: boolean); - var - i: Integer; - begin - if ADatalink = nil then exit; - for i := 0 to ADatalink.ElementCount-1 do - NotifyLink(ADatalink.Elements[i], ALink); - NotifyLinkRec(ADatalink.Parent, ALink); - end; -begin - if FParent=AValue then Exit; - NotifyLinkRec(FParent, False); - if Assigned(FParent) then FParent.FChildren.Remove(self); - FParent:=AValue; - if Assigned(FParent) then FParent.FChildren.Add(self); - NotifyLinkRec(FParent, True); -end; - -function TSVGDataLink.FindElement(el: TSVGElement): integer; -begin - result:= FElements.IndexOfData(el); -end; - -function TSVGDataLink.FindStyle(el: TSVGElement): integer; -begin - result:= FindTo(el,FStyles); -end; - -function TSVGDataLink.ElementCount: integer; -begin - result:= FElements.Count; -end; - -function TSVGDataLink.StyleCount: integer; -begin - result:= FStyles.Count; -end; - -function TSVGDataLink.IsLinkElement(el: TSVGElement): boolean; -begin - result:= FindElement(el) <> -1; -end; - -function TSVGDataLink.IsLinkStyle(el: TSVGElement): boolean; -begin - result:= FindStyle(el) <> -1; -end; - -function TSVGDataLink.IsLink(el: TSVGElement): boolean; -begin - result:= IsLinkStyle(el) or IsLinkElement(el); -end; - -function TSVGDataLink.Link(el: TSVGElement): integer; -begin - if el.ID <> '' then - begin - if FElements.IndexOf(el.ID)<>-1 then exit(-1); - result := FElements.Add(el.ID, el); - end else - result := -1; - - if el is TSVGStyle then - FStyles.Add(el); - - NotifyLink(el, true); -end; - -procedure TSVGDataLink.Unlink(el: TSVGElement); -var - index: integer; -begin - index:= FindElement(el); - if index = -1 then exit; - - if el is TSVGStyle then - FStyles.Remove(el); - - FElements.Delete(index); - NotifyLink(el, false); -end; - -procedure TSVGDataLink.UnlinkAll; -begin - FStyles.Clear; - FElements.Clear; -end; - -procedure TSVGDataLink.RegisterLinkListener(AHandler: TSVGLinkEvent; - ARegister: boolean); -begin - if ARegister then - FLinkListeners.Add(AHandler) - else FLinkListeners.Remove(AHandler); -end; - -function TSVGDataLink.FindElementById(AID: string; AClass: TSVGFactory): TSVGElement; -var - index: Integer; -begin - index := FElements.IndexOf(AId); - if index = -1 then - begin - if Assigned(Parent) then - result := Parent.FindElementById(AID, AClass) - else result := nil - end - else - begin - result := FElements.Data[index]; - if not (result is AClass) then result := nil; - end; -end; - -function StringStartsWith(AText, AStart: string): boolean; -begin - Result:= (AStart<>'') and (StrLComp(PChar(AStart),PChar(AText),length(AStart))=0); -end; - -function TSVGDataLink.FindElementByRef(ARef: string; AClass: TSVGFactory): TSVGElement; -var - notFound: boolean; -begin - result := FindElementByRef(ARef, false, AClass, notFound); -end; - -function TSVGDataLink.FindElementByRef(ARef: string; ANeedUrl: boolean; AClass: TSVGFactory; - out ANotFound: boolean): TSVGElement; -begin - if StringStartsWith(ARef,'url(#') then - begin - result := FindElementById(System.Copy(ARef,6,Length(ARef)-6), AClass); - ANotFound := (result = nil); - end - else if not ANeedUrl and StringStartsWith(ARef,'#') then - begin - result := FindElementById(System.Copy(ARef,2,Length(ARef)-1), AClass); - ANotFound := (result = nil); - end - else - begin - ANotFound := false; - exit(nil); - end; -end; - -{ TSVGElement } - -function TSVGElement.GetClipPath: string; -begin - result := AttributeOrStyle['clip-path']; -end; - -function TSVGElement.GetFill: string; -begin - result := AttributeOrStyleDef['fill','black']; -end; - -function TSVGElement.GetFillColor: TBGRAPixel; -begin - result := StrToBGRA(fill,BGRABlack); - result.alpha := round(result.alpha*fillOpacity*opacity); - if result.alpha = 0 then result := BGRAPixelTransparent; -end; - -function TSVGElement.GetFillOpacity: single; -var errPos: integer; -begin - val(AttributeOrStyleDef['fill-opacity','1'], result, errPos); - if errPos <> 0 then result := 1 else - if result < 0 then result := 0 else - if result > 1 then result := 1; -end; - -function TSVGElement.GetFillRule: string; -begin - result := AttributeOrStyleDef['fill-rule','nonzero']; -end; - -function TSVGElement.GetIsFillNone: boolean; -begin - result := compareText(trim(fill),'none')=0; -end; - -function TSVGElement.GetIsStrokeNone: boolean; -var strokeStr: string; -begin - strokeStr := stroke; - result := (trim(strokeStr)='') or (compareText(trim(strokeStr),'none')=0); -end; - -function TSVGElement.GetMatrix(AUnit: TCSSUnit): TAffineMatrix; -begin - result := TransformToMatrix(transform, AUnit); -end; - -function TSVGElement.GetMixBlendMode: TBlendOperation; -var - opstr: String; -begin - opstr := AttributeOrStyle['mix-blend-mode']; - if opstr = 'lighten' then - result := boLighten else - if opstr = 'screen' then - result := boScreen else - if opstr = 'color-dodge' then - result := boColorDodge else - if opstr = 'color-burn' then - result := boColorBurn else - if opstr = 'darken' then - result := boDarken else - if (opstr = 'plus') or (opstr = 'add') then - result := boLinearAdd else - if opstr = 'multiply' then - result := boMultiply else - if opstr = 'overlay' then - result := boOverlay else - if opstr = 'soft-light' then - result := boSvgSoftLight else - if opstr = 'hard-light' then - result := boHardLight else - if opstr = 'difference' then - result := boLinearDifference else - if opstr = 'difference' then - result := boLinearDifference else - if opstr = 'exclusion' then - result := boLinearExclusion else - if opstr = 'hue' then - result := boCorrectedHue else - if opstr = 'color' then - result := boCorrectedColor else - if opstr = 'luminosity' then - result := boCorrectedLightness else - if opstr = 'saturation' then - result := boCorrectedSaturation - else - result := boTransparent; -end; - -function TSVGElement.GetOpacity: single; -var errPos: integer; -begin - val(AttributeOrStyleDef['opacity','1'], result, errPos); - if errPos <> 0 then result := 1 else - if result < 0 then result := 0 else - if result > 1 then result := 1; -end; - -function TSVGElement.GetPaintOrder: TSVGPaintOrder; -var - parser: TSVGParser; - - function GetNext: integer; - var - id: String; - begin - id := parser.ParseId; - if id = 'fill' then exit(0) - else if id = 'stroke' then exit(1) - else if id = 'markers' then exit(2) - else if id = '' then exit(-1) - else result := GetNext; - end; - -var - s: string; -begin - s := AttributeOrStyle['paint-order', 'normal']; - if s = 'normal' then exit(spoFillStrokeMarkers); - parser := TSVGParser.Create(s); - case GetNext of - 0: case GetNext of - 2: result := spoFillMarkersStroke; - else result := spoFillStrokeMarkers; - end; - 1: case GetNext of - 2: result := spoStrokeMarkersFill; - else result := spoStrokeFillMarkers; - end; - 2: case GetNext of - 1: result := spoMarkersStrokeFill; - else result := spoMarkersFillStroke; - end; - else - result := spoFillStrokeMarkers; - end; - parser.Free; -end; - -function TSVGElement.GetStroke: string; -begin - result := AttributeOrStyleDef['stroke','none']; -end; - -function TSVGElement.GetStrokeColor: TBGRAPixel; -begin - result := StrToBGRA(stroke); - result.alpha := round(result.alpha*strokeOpacity*opacity); - if result.alpha = 0 then result := BGRAPixelTransparent; -end; - -function TSVGElement.GetStrokeLineCap: string; -begin - result := AttributeOrStyleDef['stroke-linecap','butt']; -end; - -function TSVGElement.GetStrokeLineCapLCL: TPenEndCap; -var - s: String; -begin - s := strokeLineCap; - if s = 'round' then result := pecRound - else if s = 'square' then result := pecSquare - else result := pecFlat; -end; - -function TSVGElement.GetStrokeLineJoin: string; -begin - result := AttributeOrStyleDef['stroke-linejoin','miter']; -end; - -function TSVGElement.GetStrokeLineJoinLCL: TPenJoinStyle; -var - s: String; -begin - s := strokeLineJoin; - if s = 'bevel' then result := pjsBevel - else if s = 'miter' then result := pjsMiter - else result := pjsRound; -end; - -function TSVGElement.GetStrokeMiterLimit: single; -var errPos: integer; -begin - val(AttributeOrStyleDef['stroke-miterlimit','4'], result, errPos); - if errPos <> 0 then result := 4 else - if result < 1 then result := 1; -end; - -function TSVGElement.GetStrokeOpacity: single; -var errPos: integer; -begin - val(AttributeOrStyleDef['stroke-opacity','1'], result, errPos); - if errPos <> 0 then result := 1 else - if result < 0 then result := 0 else - if result > 1 then result := 1; -end; - -function TSVGElement.GetStrokeWidth: TFloatWithCSSUnit; -begin - result := OrthoAttributeOrStyleWithUnit['stroke-width',FloatWithCSSUnit(1,cuCustom)]; -end; - -function TSVGElement.GetStrokeDashArray: string; -begin - result := AttributeOrStyleDef['stroke-dasharray','none']; -end; - -function TSVGElement.GetStrokeDashArrayF: ArrayOfFloat; -var - parser: TSVGParser; - nvalue,i: integer; - s_array: String; -begin - s_array:= strokeDashArray; - if s_array = 'none' then - begin - setlength(Result,0); - exit; - end; - parser:=TSVGParser.Create(s_array); - nvalue := 0; - repeat - parser.ParseFloat; - if not parser.NumberError then - inc(nvalue); - until parser.NumberError or parser.Done; - parser.ClearError; - setlength(Result,nvalue); - parser.Position := 1; - for i := 0 to high(result) do - result[i] := parser.ParseFloat; - parser.Free; -end; - -function TSVGElement.GetStrokeDashOffset: TFloatWithCSSUnit; -begin - result := OrthoAttributeOrStyleWithUnit['stroke-dashoffset', - FloatWithCSSUnit(0,cuCustom)]; -end; - -function TSVGElement.GetStyleFromStyleSheet(const AName, ADefault: string): string; -var - i: Integer; -begin - if FImportStyleState = fssNotSearched then ImportStyles; - if FImportStyleState <> fssNotFound then - for i:= Length(FImportedStyles)-1 downto 0 do - begin - result:= GetPropertyFromStyleDeclarationBlock(FImportedStyles[i].attr, AName, ''); - if result <> '' then exit; - end; - result := inherited GetStyleFromStyleSheet(AName, ADefault); -end; - -function TSVGElement.GetTransform: string; -begin - result := Attribute['transform']; -end; - -function TSVGElement.GetID: string; -begin - result := Attribute['xml:id']; - if result = '' then result := Attribute['id']; -end; - -function TSVGElement.GetClassAttr: string; -begin - result := Attribute['class']; -end; - -function TSVGElement.GetVisible: boolean; -begin - result := (AttributeOrStyle['display'] <> 'none'); -end; - -procedure TSVGElement.SetDatalink(AValue: TSVGDataLink); -begin - if Assigned(FDataLink) then FDataLink.Unlink(self); - FDataLink := AValue; - if Assigned(FDataLink) then FDataLink.Link(self); -end; - -procedure TSVGElement.SetClipPath(AValue: string); -begin - Attribute['clip-path'] := AValue; - RemoveStyle('clip-path'); -end; - -procedure TSVGElement.SetFill(AValue: string); -begin - Attribute['fill'] := AValue; - RemoveStyle('fill'); -end; - -procedure TSVGElement.SetFillColor(AValue: TBGRAPixel); -begin - fillOpacity:= AValue.alpha/255; - AValue.alpha:= 255; - fill := LowerCase(BGRAToStr(AValue, CSSColors, 0, true, true)); -end; - -procedure TSVGElement.SetFillOpacity(AValue: single); -begin - Attribute['fill-opacity'] := Units.formatValue(AValue); - RemoveStyle('fill-opacity'); -end; - -procedure TSVGElement.SetFillRule(AValue: string); -begin - Attribute['fill-rule'] := AValue; - RemoveStyle('fill-rule'); -end; - -procedure TSVGElement.SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix); -begin - if not IsAffineMatrixIdentity(AValue) then - transform := MatrixToTransform(AValue, AUnit) - else transformNone; -end; - -procedure TSVGElement.SetMixBlendMode(AValue: TBlendOperation); -var - opstr: String; -begin - case AValue of - boLighten: opstr := 'lighten'; - boScreen: opstr := 'screen'; - boColorDodge: opstr := 'color-dodge'; - boColorBurn: opstr := 'color-burn'; - boDarken: opstr := 'darken'; - boLinearAdd: opstr := 'add'; - boMultiply: opstr := 'multiply'; - boOverlay: opstr := 'overlay'; - boSvgSoftLight: opstr := 'soft-light'; - boHardLight: opstr := 'hard-light'; - boLinearDifference: opstr := 'difference'; - boLinearExclusion: opstr := 'exclusion'; - boCorrectedHue: opstr := 'hue'; - boCorrectedColor: opstr := 'color'; - boCorrectedLightness: opstr := 'luminosity'; - boCorrectedSaturation: opstr := 'saturation'; - else {boTransparent} - begin - RemoveStyle('mix-blend-mode'); - FDomElem.RemoveAttribute('mix-blend-mode'); - exit; - end; - end; - Style['mix-blend-mode'] := opstr; - FDomElem.RemoveAttribute('mix-blend-mode'); -end; - -procedure TSVGElement.SetOpacity(AValue: single); -begin - Attribute['opacity'] := Units.formatValue(AValue); - RemoveStyle('opacity'); -end; - -procedure TSVGElement.SetPaintOrder(AValue: TSVGPaintOrder); -var - s: String; -begin - case AValue of - spoFillStrokeMarkers: s := 'normal'; - spoFillMarkersStroke: s := 'fill markers'; - spoStrokeFillMarkers: s := 'stroke'; - spoStrokeMarkersFill: s := 'stroke markers'; - spoMarkersFillStroke: s := 'markers'; - spoMarkersStrokeFill: s := 'markers stroke'; - end; - Attribute['paint-order'] := s; - RemoveStyle('paint-order'); -end; - -procedure TSVGElement.SetStroke(AValue: string); -begin - Attribute['stroke'] := AValue; - RemoveStyle('stroke'); -end; - -procedure TSVGElement.SetStrokeColor(AValue: TBGRAPixel); -begin - strokeOpacity:= AValue.alpha/255; - AValue.alpha:= 255; - stroke := Lowercase(BGRAToStr(AValue, CSSColors, 0, true, true)); -end; - -procedure TSVGElement.SetStrokeLineCap(AValue: string); -begin - Attribute['stroke-linecap'] := AValue; - RemoveStyle('stroke-linecap'); -end; - -procedure TSVGElement.SetStrokeLineCapLCL(AValue: TPenEndCap); -begin - case AValue of - pecRound: strokeLineCap:= 'round'; - pecSquare: strokeLineCap:= 'square'; - else strokeLineCap:= 'butt'; - end; -end; - -procedure TSVGElement.SetStrokeLineJoin(AValue: string); -begin - Attribute['stroke-linejoin'] := AValue; - RemoveStyle('stroke-linejoin'); -end; - -procedure TSVGElement.SetStrokeLineJoinLCL(AValue: TPenJoinStyle); -begin - case AValue of - pjsBevel: strokeLineJoin:= 'bevel'; - pjsMiter: strokeLineJoin:= 'miter'; - else strokeLineJoin:= 'round'; - end; -end; - -procedure TSVGElement.SetStrokeMiterLimit(AValue: single); -begin - if AValue < 1 then AValue := 1; - Attribute['stroke-miterlimit'] := Units.formatValue(AValue); - RemoveStyle('stroke-miterlimit'); -end; - -procedure TSVGElement.SetStrokeOpacity(AValue: single); -begin - Attribute['stroke-opacity'] := Units.formatValue(AValue); - RemoveStyle('stroke-opacity'); -end; - -procedure TSVGElement.SetStrokeWidth(AValue: TFloatWithCSSUnit); -begin - HorizAttributeWithUnit['stroke-width'] := AValue; - RemoveStyle('stroke-width'); -end; - -procedure TSVGElement.SetStrokeDashArray(AValue: string); -begin - Attribute['stroke-dasharray'] := AValue; - RemoveStyle('stroke-dasharray'); -end; - -procedure TSVGElement.SetStrokeDashArrayF(AValue: ArrayOfFloat); -var - s: string; - i: integer; -begin - if length(AValue) = 0 then - begin - strokeDashArrayNone; - exit; - end; - s:= ''; - for i := 0 to high(AValue) do - begin - if s <> '' then AppendStr(s, ' '); - AppendStr(s, TCSSUnitConverter.formatValue(AValue[i])+' '); - end; - strokeDashArray := s; -end; - -procedure TSVGElement.SetStrokeDashOffset(AValue: TFloatWithCSSUnit); -begin - OrthoAttributeWithUnit['stroke-dashoffset'] := AValue; - RemoveStyle('stroke-dashoffset'); -end; - -procedure TSVGElement.SetTransform(AValue: string); -begin - Attribute['transform'] := AValue; -end; - -procedure TSVGElement.SetID(AValue: string); -begin - if AValue = ID then exit; - if Assigned(DataLink) then DataLink.Unlink(self); - if Attribute['xml:id']<>'' then - Attribute['xml:id'] := AValue - else - Attribute['id'] := AValue; - if Assigned(DataLink) then DataLink.Link(self); -end; - -procedure TSVGElement.SetClassAttr(AValue: string); -begin - Attribute['class'] := AValue; -end; - -procedure TSVGElement.Init(ADocument: TDOMDocument; ATag: string; - AUnits: TCSSUnitConverter); -begin - if ATag='' then - raise exception.Create('Cannot create a generic element'); - - FDomElem := ADocument.CreateElement(ATag); - FUnits := AUnits; - if Assigned(FDataLink) then FDataLink.Link(self); -end; - -procedure TSVGElement.Init(AElement: TDOMElement; - AUnits: TCSSUnitConverter); -begin - FDomElem := AElement; - FUnits := AUnits; - if Assigned(FDataLink) then FDataLink.Link(self); -end; - -procedure TSVGElement.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -begin - //nothing -end; - -procedure TSVGElement.ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); -begin - ACanvas2D.fillStyle(fillColor); - - ACanvas2D.fillMode := TFillMode(fillMode); -end; - -procedure TSVGElement.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); -var - a: ArrayOfFloat; - lw: single; - i: Integer; -begin - ACanvas2d.strokeStyle(strokeColor); - lw := Units.ConvertWidth(strokeWidth,AUnit).value; - ACanvas2d.lineWidth := lw; - ACanvas2d.lineCap := strokeLineCap; - ACanvas2d.lineJoin := strokeLineJoin; - ACanvas2d.miterLimit := strokeMiterLimit; - - a:= strokeDashArrayF; - if (Length(a) <> 0) and (lw > 0) then - begin - for i := 0 to high(a) do - a[i] := a[i] / lw; - ACanvas2d.lineStyle(a); - end - else - ACanvas2d.lineStyle(psSolid); -end; - -procedure TSVGElement.Initialize; -begin - SetLength(FImportedStyles,0); - FImportStyleState := fssNotSearched; -end; - -procedure TSVGElement.Paint(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); - procedure DoFill; - begin - if not isFillNone then - begin - ApplyFillStyle(ACanvas2D,AUnit); - ACanvas2d.fill; - end; - end; - procedure DoStroke; - begin - if not isStrokeNone then - begin - ApplyStrokeStyle(ACanvas2D,AUnit); - ACanvas2d.stroke; - end; - end; -begin - if paintOrder in [spoFillStrokeMarkers, spoFillMarkersStroke, spoMarkersFillStroke] then - begin - DoFill; - DoStroke; - end else - begin - DoStroke; - DoFill; - end; -end; - -constructor TSVGElement.Create(AElement: TDOMElement; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - FDataLink:= ADataLink; - Initialize; - Init(AElement,AUnits); -end; - -constructor TSVGElement.Create(ADocument: TDOMDocument; - AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); -begin - FDataLink:= ADataLink; - Initialize; - Init(ADocument, GetDOMTag, AUnits); -end; - -class function TSVGElement.GetDOMTag: string; -begin - result := ''; -end; - -destructor TSVGElement.Destroy; -begin - SetLength(FImportedStyles,0); - if Assigned(FDataLink) then FDataLink.Unlink(self); - inherited Destroy; -end; - -procedure TSVGElement.ListIdentifiers(AResult: TStringList); -var - myId: String; -begin - myId := Id; - if (myId <> '') and (AResult.IndexOf(myId) = -1) then - AResult.Add(myId); -end; - -procedure TSVGElement.RenameIdentifiers(AFrom, ATo: TStringList); -var - idx: Integer; - strokeDone, fillDone, clipDone, HrefDone: boolean; - before, after: String; -begin - if AFrom.Count <> ATo.Count then raise exception.Create('Identifier list size mismatch'); - idx := AFrom.IndexOf(Id); - if idx <> -1 then Id := ATo[idx]; - strokeDone := false; - fillDone:= false; - clipDone:= false; - HrefDone:= false; - for idx := 0 to AFrom.Count-1 do - begin - before := 'url(#' + AFrom[idx] + ')'; - after := 'url(#' + ATo[idx] + ')'; - if not strokeDone and (stroke = before) then - begin stroke := after; strokeDone := true; end; - if not fillDone and (fill = before) then - begin fill := after; fillDone := true; end; - if not clipDone and (clipPath = before) then - begin clipPath := after; clipDone := true; end; - if not hrefDone and (Attribute['xlink:href'] = before) then - begin Attribute['xlink:href'] := after; hrefDone := true; end; - end; -end; - -procedure TSVGElement.ConvertToUnit(AUnit: TCSSUnit); -begin - inherited ConvertToUnit(AUnit); - FImportStyleState:= fssNotSearched; - if HasAttribute('stroke-width') then - SetAttributeWithUnit('stroke-width', Units.ConvertWidth(GetAttributeWithUnit('stroke-width'), AUnit)); - if HasAttribute('stroke-dash-offset') then - SetAttributeWithUnit('stroke-dash-offset', Units.ConvertWidth(GetAttributeWithUnit('stroke-dash-offset'), AUnit)); -end; - -procedure TSVGElement.Recompute; -begin - -end; - -procedure TSVGElement.Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); -var prevMatrix: TAffineMatrix; -begin - if not Visible then exit; - prevMatrix := ACanvas2d.matrix; - ACanvas2d.transform(matrix[AUnit]); - InternalDraw(ACanvas2d,AUnit); - ACanvas2d.matrix := prevMatrix; -end; - -procedure TSVGElement.fillNone; -begin - fill := 'none'; -end; - -procedure TSVGElement.strokeNone; -begin - stroke := 'none'; -end; - -procedure TSVGElement.strokeDashArrayNone; -begin - strokeDashArray := 'none'; -end; - -procedure TSVGElement.transformNone; -begin - FDomElem.RemoveAttribute('transform'); -end; - -function TSVGElement.fillMode: TSVGFillMode; -begin - if fillRule = 'evenodd' then - result := sfmEvenOdd - else - result := sfmNonZero; -end; - -function TSVGElement.FindStyleElementInternal(const classStr: string; - out attributesStr: string): integer; -var - i: integer; -begin - attributesStr:= ''; - with FDataLink do - for i:= 0 to StyleCount-1 do - begin - result:= (Styles[i] as TSVGStyle).Find(classStr); - if result <> -1 then - begin - attributesStr:= (Styles[i] as TSVGStyle).Ruleset[result].declarations; - Exit; - end; - end; - result:= -1; -end; - -procedure TSVGElement.ImportStyles; - - procedure AddStyle(const s: string; const id: integer); - var - l: integer; - begin - FImportStyleState:= fssFound; - l:= Length(FImportedStyles); - SetLength(FImportedStyles,l+1); - with FImportedStyles[l] do - begin - attr:= s; - pos:= id; - end; - end; - -var - fid: integer; - tag,styleC,s: string; -begin - FImportStyleState:= fssNotFound; - SetLength(FImportedStyles,0); - tag:= FDomElem.TagName; - styleC:= classAttr; - (* - if style element is: - - and circle declare: - - - FImportedStyles[0] = 'fill:blue; fill-opacity: 0.4;' - FImportedStyles[1] = 'fill:yellow;' - - fill-opacity for "style1" = 0.4 not default 1! - *) - - //Find as: "[tag]" example "circle" - fid:= FindStyleElementInternal(tag,s); - if fid <> -1 then - AddStyle(s,fid); - if styleC <> '' then - begin - //Find as: "[tag].[class]" example "circle.style1" - fid:= FindStyleElementInternal(tag+'.'+styleC,s); - if fid <> -1 then - AddStyle(s,fid) - else - begin - //Find as: ".[class]" example ".style1" - fid:= FindStyleElementInternal('.'+styleC,s); - if fid <> -1 then - AddStyle(s,fid); - end; - end; -end; - -procedure TSVGElement.SetVisible(AValue: boolean); -begin - if AValue <> Visible then - Style['display'] := 'inline'; - FDomElem.RemoveAttribute('display'); -end; - -end. - diff --git a/components/bgrabitmap/bgratext.pas b/components/bgrabitmap/bgratext.pas deleted file mode 100644 index 385b782..0000000 --- a/components/bgrabitmap/bgratext.pas +++ /dev/null @@ -1,1870 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAText; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -{$IFDEF LINUX} - {$DEFINE SYSTEM_RENDERER_IS_FINE} - {$DEFINE SYSTEM_CLEARTYPE_RENDERER_IS_FINE} - {$DEFINE RENDER_TEXT_ON_TBITMAP} -{$ENDIF} -{$IFDEF FREEBSD} - {$DEFINE SYSTEM_RENDERER_IS_FINE} - {$DEFINE SYSTEM_CLEARTYPE_RENDERER_IS_FINE} -{$ENDIF} -{$IFDEF DARWIN} - {$DEFINE SYSTEM_RENDERER_IS_FINE} - {$DEFINE RENDER_TEXT_ON_TBITMAP} -{$ENDIF} -{$IFDEF WINDOWS} - {$IFNDEF LEGACY_FONT_VERTICAL_OFFSET} - {$DEFINE FIX_FONT_VERTICAL_OFFSET} - {$ENDIF} -{$ENDIF} -{$IFDEF BGRABITMAP_USE_MSEGUI} - {$DEFINE RENDER_TEXT_ON_TBITMAP} -{$ENDIF} - -{ - Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType - - This unit provides basic text rendering functions using system renderer - (LCL or MSEgui). - - Text functions use a temporary bitmap where the operating system text drawing - is used. Then it is scaled down (if antialiasing is activated) and colored. - - These routines are rather slow, so you may use other font renderers - like TBGRATextEffectFontRenderer in BGRATextFX if you want to use LCL fonts, - or, if you have TrueType fonts files, you may use TBGRAFreeTypeFontRenderer - in BGRAFreeType. } - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAPen, BGRAGrayscaleMask - {$IFDEF LCL},InterfaceBase, LCLVersion{$ENDIF}; - -const - RenderTextOnBitmap = {$IFDEF RENDER_TEXT_ON_TBITMAP}true{$ELSE}false{$ENDIF}; - -type - TWordBreakHandler = BGRABitmapTypes.TWordBreakHandler; - - { TBGRASystemFontRenderer } - - TBGRASystemFontRenderer = class(TBGRACustomFontRenderer) - protected - FFont: TFont; //font parameters - FWordBreakHandler: TWordBreakHandler; - FOwnUnderline: boolean; - procedure UpdateFont; virtual; - function InternalTextSize(sUTF8: string; AShowPrefix: boolean): TSize; - function InternalTextSizeAngle(sUTF8: string; AShowPrefix: boolean; AOrientation: integer): TSize; virtual; - procedure InternalTextWordBreak(ADest: TBGRACustomBitmap; ATextUTF8: string; - x, y, AMaxWidth: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean); - procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; ATexture: IBGRAScanner); - procedure InternalTextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; - align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); - procedure InternalTextOutAngle(ADest: TBGRACustomBitmap; x, y: single; AOrientation: integer; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; - align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); virtual; - procedure InternalTextOutEllipse(ADest: TBGRACustomBitmap; x, y, availableWidth: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; - align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); - procedure InternalSplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string; out ALineEndingBreak: boolean; - AWordBreak: TWordBreakHandler); overload; - procedure InternalSplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string; - AWordBreak: TWordBreakHandler); overload; - function InternalGetFontPixelMetric: TFontPixelMetric; - procedure DefaultWorkBreakHandler(var ABeforeUTF8, AAfterUTF8: string); - public - OverrideUnderlineDecoration: boolean; // draw unerline according to computed font pixel metric instead of using system rendering of underline - procedure SplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string); - function GetFontPixelMetric: TFontPixelMetric; override; - function FontExists(AName: string): boolean; override; - class function PatchSystemFontName(AName: string): string; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; override; - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; override; - procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean = false); overload; - procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean = false); overload; - function TextSize(sUTF8: string): TSize; overload; override; - function TextSizeAngle(sUTF8: string; orientationTenthDegCCW: integer): TSize; override; - function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; - function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; - constructor Create; - destructor Destroy; override; - property OnWordBreak: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; - end; - -{$IFDEF BGRABITMAP_USE_MSEGUI} - TMSEFontRenderer = class(TBGRASystemFontRenderer); -{$ELSE} - TLCLFontRenderer = class(TBGRASystemFontRenderer); -{$ENDIF} - -function CleanTextOutString(s: string): string; //this works with UTF8 strings as well -function RemoveLineEnding(var s: string; indexByte: integer): boolean; //this works with UTF8 strings however the index is the byte index -function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; - -procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string; - c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0; - ShowPrefix: boolean = false; RightToLeft: boolean = false); - -procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientationTenthDegCCW: integer; - sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0); - -procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; xf, yf: single; - sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0); - -function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; -function BGRATextSizeAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; -function BGRATextFitInfo(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; -function BGRATextFitInfoAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; -function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: integer): TSize; -function BGRAOriginalTextSizeAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; -function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; - out actualAntialiasingLevel: integer; out extraVerticalMarginDueToRotation: integer): TSize; -function BGRAOriginalTextSizeExAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; - out actualAntialiasingLevel: integer; out extraVerticalMarginDueToRotation: integer): TSize; - -function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload; -function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF; overload; -function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload; -function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight, AXHeight: single): ArrayOfTPointF; overload; - -function GetFontHeightSign: integer; -function FontEmHeightSign: integer; -function FontFullHeightSign: integer; -function SystemFontAvailable: boolean; -function GetFineClearTypeAuto: TBGRAFontQuality; -function FixSystemFontFullHeight({%H-}AFontName: string; AFontHeight: integer): integer; - -{$IFDEF LCL} -function LCLFontAvailable: boolean; -function FixLCLFontFullHeight(AFontName: string; AFontHeight: integer): integer; -{$ENDIF} - -procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true); -procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true); -procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x,y: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; KeepRGBOrder: boolean=true); - -const FontAntialiasingLevel = {$IFDEF SYSTEM_RENDERER_IS_FINE}3{$ELSE}6{$ENDIF}; -const FontDefaultQuality = fqAntialiased; -const IsLclFontRendererFine = {$IFDEF SYSTEM_RENDERER_IS_FINE}true{$ELSE}false{$ENDIF}; - -function GetLCLFontPixelMetric(AFont: TFont): TFontPixelMetric; - -var - BGRATextOutImproveReadabilityProc : procedure (bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode); - -procedure BitmapTextOut(ABitmap: TBitmap; ACoord: TPoint; AText: string); -procedure BitmapTextOutAngle(ABitmap: TBitmap; ACoord: TPoint; AText: string; AOrientation: integer); -procedure BitmapTextRect(ABitmap: TBitmap; ARect: TRect; ACoord: TPoint; - AText: string; const AStyle: TTextStyle); -function BitmapTextExtent(ABitmap: TBitmap; AText: string): TSize; -function BitmapTextExtentAngle(ABitmap: TBitmap; AText: string; AOrientation: integer): TSize; -function BitmapTextFitInfo(ABitmap: TBitmap; AText: string; AMaxWidth: integer): integer; -function BitmapTextFitInfoAngle(ABitmap: TBitmap; AText: string; AMaxWidth: integer; AOrientation: integer): integer; -procedure BitmapFillRect(ABitmap: TBitmap; ARect: TRect; AColor: TColor); - -implementation - -uses Math, BGRATransform, BGRABlend, BGRAUTF8, BGRAUnicode, BGRATextBidi - {$IFDEF LCL}, Forms{$IF lcl_fullversion >= 1070000}, lclplatformdef{$ENDIF}{$ENDIF}; - -const MaxPixelMetricCount = 100; - -var - SystemFontDisabledValue: boolean; - fqFineClearTypeComputed: boolean; - fqFineClearTypeValue: TBGRAFontQuality; - FontHeightSignComputed: boolean; - FontHeightSignValue: integer; - FontPixelMetricArray: array[0..MaxPixelMetricCount-1] of record - usage: integer; - name: string; - height: integer; - italic: boolean; - bold: boolean; - metric: TFontPixelMetric; - end; - FontPixelMetricCount: integer; - -{$IFDEF BGRABITMAP_USE_MSEGUI} -{$i bgramsegui_text.inc} -{$ELSE} -procedure BitmapTextOut(ABitmap: TBitmap; ACoord: TPoint; AText: string); -begin - ABitmap.Canvas.Brush.Style := bsClear; - ABitmap.Canvas.TextOut(ACoord.X, ACoord.Y, AText); -end; - -procedure BitmapTextOutAngle(ABitmap: TBitmap; ACoord: TPoint; AText: string; AOrientation: integer); -begin - ABitmap.Canvas.Font.Orientation := AOrientation; - BitmapTextOut(ABitmap, ACoord, AText); -end; - -procedure BitmapTextRect(ABitmap: TBitmap; ARect: TRect; ACoord: TPoint; - AText: string; const AStyle: TTextStyle); -begin - ABitmap.Canvas.Brush.Style := bsClear; - {$IFDEF DARWIN} - if AStyle.RightToLeft then AText := UTF8EmbedDirection(AText, true); - {$ENDIF} - ABitmap.Canvas.TextRect(ARect, ACoord.X, ACoord.Y, AText, AStyle); -end; - -function BitmapTextExtent(ABitmap: TBitmap; AText: string): TSize; -begin - {$IFDEF DARWIN} - AText := StringReplace(AText, ' ', UTF8_NO_BREAK_SPACE, [rfReplaceAll]); - {$ENDIF} - result := ABitmap.Canvas.TextExtent(AText); -end; - -function BitmapTextExtentAngle(ABitmap: TBitmap; AText: string; AOrientation: integer): TSize; -begin - ABitmap.Canvas.Font.Orientation := AOrientation; - result := BitmapTextExtent(ABitmap, AText); -end; - -function BitmapTextFitInfo(ABitmap: TBitmap; AText: string; AMaxWidth: integer): integer; -begin - {$IFDEF DARWIN} - AText := StringReplace(AText, ' ', UTF8_NO_BREAK_SPACE, [rfReplaceAll]); - {$ENDIF} - result := ABitmap.Canvas.TextFitInfo(AText, AMaxWidth); -end; - -function BitmapTextFitInfoAngle(ABitmap: TBitmap; AText: string; AMaxWidth: integer; AOrientation: integer): integer; -begin - ABitmap.Canvas.Font.Orientation := AOrientation; - result := BitmapTextFitInfo(ABitmap, AText, AMaxWidth); -end; - -procedure BitmapFillRect(ABitmap: TBitmap; ARect: TRect; AColor: TColor); -begin - ABitmap.Canvas.Brush.Style := bsSolid; - ABitmap.Canvas.Brush.Color := AColor; - ABitmap.Canvas.Pen.Style := psClear; - ABitmap.Canvas.FillRect(ARect); -end; -{$ENDIF} - -procedure ComputeFontVerticalBounds(text: string; font: TFont; out top, bottom, totalHeight: integer); -var - xb,yb: integer; - pmask: PBGRAPixel; - nbPix: array of integer; - nbCur: integer; - mean: integer; - mask: TBGRACustomBitmap; - size: TSize; -begin - if not SystemFontAvailable then - begin - top := 0; - bottom := 0; - totalHeight := 0; - exit; - end; - size := BGRAOriginalTextSize(font,fqSystem,text,FontAntialiasingLevel); - mask := BGRABitmapFactory.Create(size.cx,size.cy,BGRABlack); - mask.Canvas.Font := font; - mask.Canvas.Font.Quality := fqAntialiased; - mask.Canvas.Font.Color := clWhite; - mask.Canvas.Font.Style := font.style * [fsBold,fsItalic]; - BitmapTextOut(mask.Bitmap, Point(0,0), text); - top := -1; - bottom := -1; - totalHeight:= mask.Height; - - mean := 0; - setlength(nbPix, mask.Height); - for yb := 0 to mask.Height-1 do - begin - pmask := mask.scanline[yb]; - nbCur := 0; - for xb := 0 to mask.Width-1 do - begin - if (pmask^.green > 0) then inc(nbCur); - inc(pmask); - end; - nbPix[yb] := nbCur; - inc(mean,nbCur); - end; - mean := (mean+ (mask.Height div 2)) div mask.Height; - - for yb := 0 to high(nbPix) do - begin - if nbPix[yb]> mean div 3 then - begin - if top = -1 then top := yb - else bottom := yb+1; - end; - end; - mask.Free; -end; - -function ComputeFontPixelMetric(AFont: TFont): TFontPixelMetric; -begin - ComputeFontVerticalBounds('acemu',AFont,result.xLine,result.Baseline,result.Lineheight); - ComputeFontVerticalBounds('gDjSO',AFont,result.CapLine,result.DescentLine,result.Lineheight); - if result.xLine = -1 then result.xLine := result.CapLine else - if result.CapLine = -1 then result.CapLine := result.xLine; - if result.DescentLine = -1 then result.DescentLine := result.Baseline else - if result.Baseline = -1 then result.Baseline := result.DescentLine; - result.Defined := (result.xLine <> -1) and (result.CapLine <> -1) and (result.Baseline <> -1) and (result.DescentLine <> -1) and - (result.Lineheight <> -1); -end; - -function ComparePixelMetric(index: integer; font: TFont): integer; -begin - if (index < 0) or (index >= FontPixelMetricCount) then - result := 0 - else - begin - with FontPixelMetricArray[index] do - if (name = font.Name) and (height = font.Height) then - result := 0 else - if (height > font.Height) then - result := 1 else - if (height < font.Height) then - result := -1 else - if name > font.Name then - result := 1 else - if name < font.Name then - result := -1 - else result := 0; - end; -end; - -procedure FindPixelMetricPos(AFont: TFont; out startPos,endPos: integer); -var middle,iStart,iEnd: integer; -begin - if FontPixelMetricCount = 0 then - begin - startPos := 0; - endPos := 0; - end; - iStart:= 0; - iEnd:= FontPixelMetricCount; - while iStart < iEnd do - begin - middle := (iStart+iEnd) div 2; - if ComparePixelMetric(middle,AFont) >= 0 then - iEnd := middle - else - iStart := middle+1; - end; - startPos := iStart; - - iStart:= startPos; - iEnd:= FontPixelMetricCount; - while iStart < iEnd do - begin - middle := (iStart+iEnd) div 2; - if ComparePixelMetric(middle,AFont) <= 0 then - iStart := middle+1 - else - iEnd := middle; - end; - endPos := iEnd; -end; - -procedure RemoveOldPixelMetric; -var sum,nb,i: integer; -begin - if FontPixelMetricCount = 0 then exit; - sum := 0; - for i := 0 to FontPixelMetricCount-1 do - inc(sum, FontPixelMetricArray[i].usage); - sum := sum div FontPixelMetricCount; - nb := 0; - for i := 0 to FontPixelMetricCount-1 do - begin - if FontPixelMetricArray[i].usage > sum then - begin - FontPixelMetricArray[nb] := FontPixelMetricArray[i]; - inc(nb); - end; - end; - FontPixelMetricCount := nb; -end; - -function GetLCLFontPixelMetric(AFont: TFont): TFontPixelMetric; -var i,startPos,endPos: integer; - prevHeight,fixHeight: integer; -begin - if (AFont.Height < -200) or (AFont.Height > 150) then - begin - prevHeight := AFont.Height; - if AFont.Height < 0 then - fixHeight := -200 - else - fixHeight := 150; - AFont.Height := fixHeight; - result := GetLCLFontPixelMetric(AFont); - AFont.Height := prevHeight; - - result.Baseline := round(result.Baseline/fixHeight*prevHeight); - result.CapLine := round(result.CapLine/fixHeight*prevHeight); - result.DescentLine := round(result.DescentLine/fixHeight*prevHeight); - result.Lineheight := round(result.Lineheight/fixHeight*prevHeight); - result.xLine := round(result.xLine/fixHeight*prevHeight); - exit; - end; - - FindPixelMetricPos(AFont,startPos,endPos); - for i := startPos to endPos-1 do - if (FontPixelMetricArray[i].bold = AFont.bold) and - (FontPixelMetricArray[i].italic = AFont.Italic) then - begin - result := FontPixelMetricArray[i].metric; - inc(FontPixelMetricArray[i].usage); - exit; - end; - if FontPixelMetricCount = MaxPixelMetricCount then RemoveOldPixelMetric; - for i := FontPixelMetricCount downto endPos+1 do - FontPixelMetricArray[i] := FontPixelMetricArray[i-1]; - inc(FontPixelMetricCount); - with FontPixelMetricArray[endPos]do - begin - italic := AFont.Italic; - bold := AFont.Bold; - usage := 1; - name := AFont.Name; - height:= AFont.Height; - metric := ComputeFontPixelMetric(AFont); - result := metric; - end; -end; - -const DefaultFontHeightSign = -1; - -function BGRATextUnderline(ATopLeft: TPointF; - AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; -begin - result := BGRATextUnderline(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine); -end; - -function BGRATextUnderline(ATopLeft: TPointF; - AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF; -var height,y: single; -begin - height := AEmHeight*0.080; - y := ATopLeft.y+ABaseline+1.6*height; - result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y), - PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter, - SolidPenStyle, []); -end; - -function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; - AMetrics: TFontPixelMetric): ArrayOfTPointF; -begin - result := BGRATextStrikeOut(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine,AMetrics.Baseline-AMetrics.xLine); -end; - -function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline, - AEmHeight, AXHeight: single): ArrayOfTPointF; -var height,y: single; -begin - height := AEmHeight*0.075; - y := ATopLeft.y+ABaseline-AXHeight*0.5; - result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y), - PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter, - SolidPenStyle, []); -end; - -function GetFontHeightSign: integer; -var - HeightP1, HeightM1: integer; - tempBmp: TBitmap; -begin - if SystemFontDisabledValue then - begin - result := DefaultFontHeightSign; - exit; - end; - - if FontHeightSignComputed then - begin - result := FontHeightSignValue; - exit; - end; - - if {$IFDEF LCL}WidgetSet.LCLPlatform = lpNoGUI{$ELSE}False{$ENDIF} then - begin - SystemFontDisabledValue:= True; - result := -1; - exit; - end; - - tempBmp := nil; - try - tempBmp := TBitmap.Create; - tempBmp.Width := 30; - tempBmp.Height := 30; - tempBmp.Canvas.Font.Name := 'Arial'; - tempBmp.Canvas.Font.Style := []; - tempBmp.Canvas.Font.Height := 20; - HeightP1 := BitmapTextExtent(tempBmp, 'Hg').cy; - tempBmp.Canvas.Font.Height := -20; - HeightM1 := BitmapTextExtent(tempBmp, 'Hg').cy; - - if HeightP1 > HeightM1 then - FontHeightSignValue := 1 - else - FontHeightSignValue := -1; - - FontHeightSignComputed := true; - result := FontHeightSignValue; - except - on ex: Exception do - begin - SystemFontDisabledValue := True; - result := -1; - end; - end; - tempBmp.Free; -end; - -function GetFineClearTypeAuto: TBGRAFontQuality; -var - lclBmp: TBitmap; - bgra: TBGRACustomBitmap; - x,y: integer; -begin - if fqFineClearTypeComputed then - begin - result:= fqFineClearTypeValue; - exit; - end; - result := fqFineAntialiasing; - if not SystemFontDisabledValue and not ({$IFDEF LCL}WidgetSet.LCLPlatform = lpNoGUI{$ELSE}False{$ENDIF}) then - begin - lclBmp := TBitmap.Create; - lclBmp.Width := 1; - lclBmp.Height := 1; - lclBmp.Canvas.Font.Height := -50; - lclBmp.Canvas.Font.Quality := fqCleartype; - lclBmp.Canvas.Font.Color := clBlack; - with BitmapTextExtent(lclBmp, '/') do - begin - lclBmp.Width := cx; - lclBmp.Height := cy; - end; - BitmapFillRect(lclBmp, rect(0,0,lclBmp.Width,lclBmp.Height), clWhite); - BitmapTextOut(lclBmp, Point(0,0), '/'); - bgra:= BGRABitmapFactory.Create(lclBmp); - x:= bgra.Width div 2; - for y := 0 to bgra.Height-1 do - with bgra.GetPixel(x,y) do - if (red<>blue) then - begin - if blue < red then - result:= fqFineClearTypeRGB - else - result:= fqFineClearTypeBGR; - break; - end else - if (green = 0) then break; - bgra.Free; - lclBmp.Free; - end; - fqFineClearTypeValue := result; - fqFineClearTypeComputed:= true; -end; - -{$IFNDEF WINDOWS} -var LCLFontFullHeightRatio : array of record - FontName: string; - Ratio: single; - end; -{$ENDIF} - -function FixSystemFontFullHeight(AFontName: string; AFontHeight: integer): integer; -{$IFNDEF WINDOWS} -const TestHeight = 200; -var - i: Integer; - ratio : single; - f: TFont; - h: LongInt; -begin - if (AFontHeight = 0) or - (AFontHeight*FontEmHeightSign > 0) then - result := AFontHeight - else - begin - ratio := EmptySingle; - for i := 0 to high(LCLFontFullHeightRatio) do - if CompareText(AFontName, LCLFontFullHeightRatio[i].FontName)=0 then - begin - ratio := LCLFontFullHeightRatio[i].Ratio; - break; - end; - if ratio = EmptySingle then - begin - f := TFont.Create; - f.Quality := fqDefault; - f.Name := AFontName; - f.Height := FontFullHeightSign*TestHeight; - h := BGRATextSize(f, fqSystem, 'Hg', 1).cy; - f.Free; - if h = 0 then ratio := 1 - else ratio := TestHeight/h; - - setlength(LCLFontFullHeightRatio, length(LCLFontFullHeightRatio)+1); - LCLFontFullHeightRatio[high(LCLFontFullHeightRatio)].FontName:= AFontName; - LCLFontFullHeightRatio[high(LCLFontFullHeightRatio)].Ratio:= ratio; - end; - result := round(AFontHeight*ratio); - end; -end; -{$ELSE} -begin - result := AFontHeight; -end; -{$ENDIF} - -{$IFDEF LCL} -function LCLFontAvailable: boolean; -begin - result := SystemFontAvailable; -end; - -function FixLCLFontFullHeight(AFontName: string; AFontHeight: integer): integer; -begin - result := FixSystemFontFullHeight(AFontName, AFontHeight); -end; -{$ENDIF} - -function FontEmHeightSign: integer; -begin - result := GetFontHeightSign; -end; - -function FontFullHeightSign: integer; -begin - result := -FontEmHeightSign; -end; - -function SystemFontAvailable: boolean; -begin - if not FontHeightSignComputed then GetFontHeightSign; - result := not SystemFontDisabledValue; -end; - -procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x, - y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; - texture: IBGRAScanner; RGBOrder: boolean); -begin - BGRAGrayscaleMask.BGRAFillClearTypeGrayscaleMask(dest,x,y,xThird,mask,color,texture,RGBOrder); -end; - -procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean); -begin - BGRABlend.BGRAFillClearTypeMask(dest,x,y,xThird,mask,color,texture,RGBOrder); -end; - -procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer; - mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; - KeepRGBOrder: boolean); -begin - BGRABlend.BGRAFillClearTypeRGBMask(dest,x,y,mask,color,texture,KeepRGBOrder); -end; - -function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; - sUTF8: string; CustomAntialiasingLevel: Integer; - out actualAntialiasingLevel: integer; - out extraVerticalMarginDueToRotation: integer): TSize; -begin - result := BGRAOriginalTextSizeExAngle(Font, Font.Orientation, Quality, sUTF8, - CustomAntialiasingLevel, actualAntialiasingLevel, extraVerticalMarginDueToRotation); -end; - -function BGRAOriginalTextSizeExAngle(Font: TFont; AOrientation: integer; - Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; - out actualAntialiasingLevel: integer; - out extraVerticalMarginDueToRotation: integer): TSize; -var - tempBmp: TBitmap; -begin - actualAntialiasingLevel:= CustomAntialiasingLevel; - extraVerticalMarginDueToRotation := 0; - if not SystemFontAvailable then - result := Size(0,0) - else - begin - tempBmp := nil; - try - tempBmp := TBitmap.Create; - tempBmp.Canvas.Font := Font; - if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then - begin - tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel; - end else - begin - tempBmp.Canvas.Font.Height := Font.Height; - actualAntialiasingLevel:= 1; - end; - result := BitmapTextExtentAngle(tempBmp, sUTF8, AOrientation); - if Font.Orientation <> 0 then - begin - tempBmp.Canvas.Font.Orientation:= 0; - extraVerticalMarginDueToRotation := result.cy - - BitmapTextExtentAngle(tempBmp, sUTF8, AOrientation).cy; - end; - except - on ex: exception do - begin - result := Size(0,0); - SystemFontDisabledValue := True; - end; - end; - tempBmp.Free; - end; -end; - -function BGRATextFitInfo(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; - CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; -begin - result := BGRATextFitInfoAngle(Font, Font.Orientation, Quality, sUTF8, - CustomAntialiasingLevel, AMaxWidth); -end; - -function BGRATextFitInfoAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; - CustomAntialiasingLevel: Integer; AMaxWidth: integer): integer; -var - actualAntialiasingLevel{$IFDEF LCL}{$IF lcl_fullversion < 1070000}, len1{$ENDIF}{$ENDIF}: Integer; - tempBmp: TBitmap; -begin - if (AMaxWidth = 0) or (length(sUTF8)=0) then exit(0); - actualAntialiasingLevel:= CustomAntialiasingLevel; - if not SystemFontAvailable then - result := 0 - else - begin - tempBmp := nil; - try - tempBmp := TBitmap.Create; - tempBmp.Canvas.Font := Font; - if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then - begin - tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel; - end else - begin - tempBmp.Canvas.Font.Height := Font.Height; - actualAntialiasingLevel:= 1; - end; - {$IFDEF LCL}{$IF lcl_fullversion < 1070000} - len1 := BitmapTextExtentAngle(tempBmp, - copy(sUTF8,1,UTF8CharacterLength(@sUTF8[1])), - AOrientation).cx; - if len1 > AMaxWidth*actualAntialiasingLevel then exit(0); - {$ENDIF}{$ENDIF} - result := BitmapTextFitInfoAngle(tempBmp, sUTF8, - AMaxWidth*actualAntialiasingLevel, AOrientation); - except - on ex: exception do - begin - result := 0; - SystemFontDisabledValue := True; - end; - end; - tempBmp.Free; - end; -end; - -function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; - sUTF8: string; CustomAntialiasingLevel: Integer): TSize; -begin - result := BGRAOriginalTextSizeAngle(Font, Font.Orientation, Quality, sUTF8, - CustomAntialiasingLevel); -end; - -function BGRAOriginalTextSizeAngle(Font: TFont; AOrientation: integer; - Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; -var actualAntialiasingLevel, extraMargin: integer; -begin - result := BGRAOriginalTextSizeExAngle(Font, AOrientation, Quality, sUTF8, - CustomAntialiasingLevel, actualAntialiasingLevel, extraMargin); - {$IFDEF FIX_FONT_VERTICAL_OFFSET} - if extraMargin > 0 then dec(result.cy, extraMargin); - {$ENDIF} -end; - -function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; -begin - result := BGRATextSizeAngle(Font, Font.Orientation, Quality, sUTF8, CustomAntialiasingLevel); -end; - -function BGRATextSizeAngle(Font: TFont; AOrientation: integer; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize; -begin - {$IFDEF SYSTEM_RENDERER_IS_FINE} - if Quality = fqFineAntialiasing then Quality:= fqSystem; - {$ENDIF} - result := BGRAOriginalTextSizeAngle(Font, AOrientation, Quality, sUTF8, CustomAntialiasingLevel); - if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then - begin - result.cx := ceil(Result.cx/CustomAntialiasingLevel); - result.cy := ceil(Result.cy/CustomAntialiasingLevel); - end; -end; - -function RemovePrefix(sUTF8: string): string; -var i,resLen: integer; -begin - setlength(result, length(sUTF8)); - resLen := 0; - i := 1; - while i <= length(sUTF8) do - begin - if sUTF8[i] = '&' then - begin // double ('&&') indicate single char '&' - if (i < length(sUTF8)) and (sUTF8[i+1] = '&') then - begin - inc(resLen); - result[resLen] := '&'; - inc(i,2); - end else - // single indicate underline - inc(i); - end else - begin - inc(resLen); - result[resLen] := sUTF8[i]; - inc(i); - end; - end; - setlength(result,resLen); -end; - -procedure FilterOriginalText(Quality: TBGRAFontQuality; CustomAntialiasingLevel: Integer; var temp: TBGRACustomBitmap; - out grayscaleMask: TGrayscaleMask); -var - n: integer; - maxAlpha: UInt32or64; - pb: PByte; - multiplyX: integer; - resampled: TBGRACustomBitmap; -begin - grayscaleMask := nil; - case Quality of - fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing: - begin - if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then multiplyX:= 3 else multiplyX:= 1; - if (temp.Height < CustomAntialiasingLevel*8) and (temp.Height >= CustomAntialiasingLevel*3) then - begin - temp.ResampleFilter := rfSpline; - resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel),rmFineResample); - grayscaleMask := TGrayscaleMask.Create(resampled,cGreen); - FreeAndNil(resampled); - end else - grayscaleMask := TGrayscaleMask.CreateDownSample(temp, round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel)); - FreeAndNil(temp); - - maxAlpha := 0; - pb := grayscaleMask.Data; - for n := grayscaleMask.NbPixels - 1 downto 0 do - begin - if Pb^ > maxAlpha then maxAlpha := Pb^; - Inc(pb); - end; - if (maxAlpha <> 0) and (maxAlpha <> 255) then - begin - pb := grayscaleMask.Data; - for n := grayscaleMask.NbPixels - 1 downto 0 do - begin - pb^:= pb^ * 255 div maxAlpha; - Inc(pb); - end; - end; - end; - fqSystem: - begin - grayscaleMask := TGrayscaleMask.Create(temp, cGreen); - FreeAndNil(temp); - {$IFNDEF LINUX} - pb := grayscaleMask.Data; - for n := grayscaleMask.NbPixels - 1 downto 0 do - begin - pb^:= GammaExpansionTab[pb^] shr 8; - Inc(pb); - end; - {$ENDIF} - end; - end; -end; - -function CleanTextOutString(s: string): string; -begin - result := BGRABitmapTypes.CleanTextOutString(s); -end; - -function RemoveLineEnding(var s: string; indexByte: integer): boolean; -begin - result := BGRABitmapTypes.RemoveLineEnding(s, indexByte); -end; - -function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean; -begin - result := BGRABitmapTypes.RemoveLineEndingUTF8(sUTF8,indexUTF8); -end; - -procedure BGRAInternalRenderText(dest: TBGRACustomBitmap; Quality: TBGRAFontQuality; grayscale: TGrayscaleMask; temp: TBGRACustomBitmap; - x,y,xThird: integer; c: TBGRAPixel; tex: IBGRAScanner); -begin - if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB,fqSystemClearType] then - begin - if grayscale <> nil then - BGRAFillClearTypeGrayscaleMask(dest,x,y,xThird, grayscale,c,tex,Quality=fqFineClearTypeRGB) - else if temp <> nil then - BGRAFillClearTypeRGBMask(dest,x,y, temp,c,tex); - end - else - begin - if grayscale <> nil then - begin - if tex <> nil then - grayscale.DrawAsAlpha(dest, x, y, tex) else - grayscale.DrawAsAlpha(dest, x, y, c); - end - else if temp <> nil then - dest.PutImage(x, y, temp, dmDrawWithTransparency); - end; -end; - -procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string; - c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0; - ShowPrefix: boolean = false; RightToLeft: boolean = false); -var - size: TSize; - sizeFactor, extraVerticalMargin: integer; - xMarginF: single; - style: TTextStyle; - noPrefix: string; -begin - if not SystemFontAvailable then exit; - - if CustomAntialiasingLevel = 0 then - CustomAntialiasingLevel:= FontAntialiasingLevel; - - if Font.Orientation mod 3600 <> 0 then - begin - BGRATextOutAngle(bmp,Font,Quality,xf,yf,Font.Orientation,sUTF8,c,tex,align); - exit; - end; - - {$IFDEF SYSTEM_RENDERER_IS_FINE} - if (Quality in [fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR]) and - (BGRATextSize(Font, fqSystem, 'Hg', 1).cy >= 13) then - begin - if Quality = fqFineAntialiasing then Quality := fqSystem; - {$IFDEF SYSTEM_CLEARTYPE_RENDERER_IS_FINE} - if Quality = GetFineClearTypeAuto then Quality := fqSystemClearType; - {$ENDIF} - end; - {$ENDIF} - - if ShowPrefix then - noPrefix := RemovePrefix(sUTF8) - else - noPrefix := sUTF8; - - size := BGRAOriginalTextSizeEx(Font,Quality,noPrefix,CustomAntialiasingLevel,sizeFactor,extraVerticalMargin); - if (size.cx = 0) or (size.cy = 0) then - exit; - - if (size.cy >= 144) and (Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (CustomAntialiasingLevel > 4) then - begin - CustomAntialiasingLevel:= 4; - size := BGRAOriginalTextSizeEx(Font,Quality,noPrefix,CustomAntialiasingLevel,sizeFactor,extraVerticalMargin); - end; - - case align of - taLeftJustify: ; - taCenter: DecF(xf, size.cx/2/sizeFactor); - taRightJustify: DecF(xf, size.cx/sizeFactor); - end; - - xMarginF := size.cy/sizeFactor; - fillchar({%H-}style,sizeof(style),0); - style.SingleLine := true; - style.Alignment := taLeftJustify; - style.Layout := tlTop; - style.RightToLeft := RightToLeft; - style.ShowPrefix := ShowPrefix; - BGRATextRect(bmp, Font, Quality, - rect(floor(xf-xMarginF), floor(yf)-1, ceil(xf+size.cx/sizeFactor+xMarginF), ceil(yf+size.cy/sizeFactor)+1), - xf,yf, sUTF8, style, c, tex, sizeFactor); -end; - -procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; - orientationTenthDegCCW: integer; - sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0); -var - posF: TPointF; - x,y: integer; - deltaX,deltaY: integer; - size: TSize; - temp: TBGRACustomBitmap; - TopLeft,TopRight,BottomRight,BottomLeft: TPointF; - Top,dy: Single; - Left: Single; - cosA,sinA: single; - rotBounds: TRect; - sizeFactor, extraVerticalMargin: integer; - TempFont: TFont; - oldOrientation: integer; - grayscale:TGrayscaleMask; - {$IFDEF RENDER_TEXT_ON_TBITMAP} - tempLCL: TBitmap; - {$ENDIF} - - procedure rotBoundsAdd(pt: TPointF); - begin - if pt.x < Left then Left := pt.x; - if pt.y < Top then Top := pt.y; - if floor(pt.X) < rotBounds.Left then rotBounds.Left := floor(pt.X/sizeFactor)*sizeFactor; - if floor(pt.Y) < rotBounds.Top then rotBounds.Top := floor(pt.Y/sizeFactor)*sizeFactor; - if ceil(pt.X) > rotBounds.Right then rotBounds.Right := ceil(pt.X/sizeFactor)*sizeFactor; - if ceil(pt.Y) > rotBounds.Bottom then rotBounds.Bottom := ceil(pt.Y/sizeFactor)*sizeFactor; - end; - -begin - if not SystemFontAvailable then exit; - - if CustomAntialiasingLevel = 0 then - CustomAntialiasingLevel:= FontAntialiasingLevel; - - if orientationTenthDegCCW mod 3600 = 0 then - begin - oldOrientation := Font.Orientation; - Font.Orientation := 0; - BGRATextOut(bmp,Font,Quality,xf,yf,sUTF8,c,tex,align); - Font.Orientation := oldOrientation; - exit; - end; - TempFont := TFont.Create; - TempFont.Assign(Font); - TempFont.Height := Font.Height; - size := BGRAOriginalTextSizeExAngle(TempFont,orientationTenthDegCCW,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor, extraVerticalMargin); - if (size.cx = 0) or (size.cy = 0) then - begin - tempFont.Free; - exit; - end; - {$IFDEF FIX_FONT_VERTICAL_OFFSET} - if extraVerticalMargin > 0 then - dy := -extraVerticalMargin*0.5 -1 - else - dy := 0; - {$ELSE} - dy := 0; - {$ENDIF} - tempFont.Free; - - cosA := cos(orientationTenthDegCCW*Pi/1800); - sinA := sin(orientationTenthDegCCW*Pi/1800); - TopLeft := PointF(sinA*dy,cosA*dy); - posF := PointF(xf,yf); - posF.Offset( TopLeft * (1/sizeFactor) ); - TopRight := TopLeft + PointF(cosA*size.cx,-sinA*size.cx); - BottomRight := TopRight + PointF(sinA*size.cy,cosA*size.cy); - BottomLeft := TopLeft + PointF(sinA*size.cy,cosA*size.cy); - rotBounds := rect(0,0,0,0); - Top := 0; - Left := 0; - rotBoundsAdd(TopRight); - rotBoundsAdd(BottomRight); - rotBoundsAdd(BottomLeft); - inc(rotBounds.Right); - inc(rotBounds.Bottom); - - posF.Offset( Left/sizeFactor, Top/sizeFactor ); - case align of - taLeftJustify: ; - taCenter: - posF.Offset( -TopRight*(1/(2*sizeFactor)) ); - taRightJustify: - posF.Offset( -TopRight*(1/sizeFactor) ); - end; - x := floor(posF.x); - deltaX := round((posF.x - x)*sizeFactor); - y := floor(posF.y); - deltaY := round((posF.y - y)*sizeFactor); - if deltaX <> 0 then inc(rotBounds.Right, sizeFactor); - if deltaY <> 0 then inc(rotBounds.Bottom, sizeFactor); - - {$IFDEF RENDER_TEXT_ON_TBITMAP} - tempLCL := TBitmap.Create; - tempLCL.Width := rotBounds.Right-rotBounds.Left; - tempLCL.Height := rotBounds.Bottom-rotBounds.Top; - BitmapFillRect(tempLCL, Rect(0,0,tempLCL.Width,tempLCL.Height), clBlack); - with tempLCL do begin - {$ELSE} - temp := BGRABitmapFactory.Create(rotBounds.Right-rotBounds.Left,rotBounds.Bottom-rotBounds.Top, BGRABlack); - with temp do begin - {$ENDIF} - Canvas.Font := Font; - Canvas.Font.Color := clWhite; - Canvas.Font.Height := round(Font.Height*sizeFactor); - BitmapTextOutAngle({$IFDEF RENDER_TEXT_ON_TBITMAP}tempLCL{$ELSE}temp.Bitmap{$ENDIF}, - Point(-rotBounds.Left+deltaX, -rotBounds.Top+deltaY), sUTF8, - orientationTenthDegCCW); - end; - {$IFDEF RENDER_TEXT_ON_TBITMAP} - temp := BGRABitmapFactory.create(tempLCL,False); - tempLCL.Free; - {$ENDIF} - - FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale); - BGRAInternalRenderText(bmp, Quality, grayscale,temp, x,y,0, c,tex); - temp.Free; - grayscale.Free; -end; - -procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; xf, yf: single; - sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0); -var - lim: TRect; - tx, ty: integer; - temp: TBGRACustomBitmap; - sizeFactor: integer; - cr: TRect; - grayscale:TGrayscaleMask; - {$IFDEF RENDER_TEXT_ON_TBITMAP} - tempLCL: TBitmap; - {$ENDIF} -begin - if not SystemFontAvailable then exit; - - if CustomAntialiasingLevel = 0 then - CustomAntialiasingLevel:= FontAntialiasingLevel; - - cr := bmp.ClipRect; - if ARect.Left < cr.Left then - lim.Left := cr.Left else lim.Left := ARect.Left; - if ARect.Top < cr.Top then - lim.Top := cr.Top else lim.Top := ARect.Top; - if ARect.Right > cr.Right then - lim.Right := cr.Right else lim.Right := ARect.Right; - if ARect.Bottom > cr.Bottom then - lim.Bottom := cr.Bottom else lim.Bottom := ARect.Bottom; - - tx := lim.Right - lim.Left; - ty := lim.Bottom - lim.Top; - if (tx <= 0) or (ty <= 0) then - exit; - - {$IFDEF SYSTEM_RENDERER_IS_FINE} - if (Quality in [fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR]) and - (BGRATextSize(Font, fqSystem, 'Hg', 1).cy >= 13) then - begin - if Quality = fqFineAntialiasing then Quality := fqSystem; - {$IFDEF SYSTEM_CLEARTYPE_RENDERER_IS_FINE} - if Quality = GetFineClearTypeAuto then Quality := fqSystemClearType; - {$ENDIF} - end; - {$ENDIF} - - if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then - sizeFactor := CustomAntialiasingLevel - else - sizeFactor := 1; - - {$IFDEF RENDER_TEXT_ON_TBITMAP} - tempLCL := TBitmap.Create; - tempLCL.Width := tx*sizeFactor; - tempLCL.Height := ty*sizeFactor; - BitmapFillRect(tempLCL, Rect(0,0,tempLCL.Width,tempLCL.Height), clBlack); - with tempLCL do begin - {$ELSE} - temp := BGRABitmapFactory.Create(tx*sizeFactor, ty*sizeFactor, BGRABlack); - with temp do begin - {$ENDIF} - Canvas.Font := Font; - Canvas.Font.Orientation := 0; - if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then Canvas.Font.Height := Font.Height*CustomAntialiasingLevel - else Canvas.Font.Height := Font.Height; - Canvas.Font.Color := clWhite; - BitmapTextRect({$IFDEF RENDER_TEXT_ON_TBITMAP}tempLCL{$ELSE}temp.Bitmap{$ENDIF}, rect(lim.Left-ARect.Left, lim.Top-ARect.Top, - (ARect.Right-ARect.Left)*sizeFactor, (ARect.Bottom-ARect.Top)*sizeFactor), - Point(round((xf - lim.Left)*sizeFactor), round((yf - lim.Top)*sizeFactor)), - sUTF8, style); - end; - {$IFDEF RENDER_TEXT_ON_TBITMAP} - temp := BGRABitmapFactory.create(tempLCL,False); - tempLCL.Free; - {$ENDIF} - - FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale); - BGRAInternalRenderText(bmp, Quality, grayscale,temp, lim.left,lim.top,0, c,tex); - temp.Free; - grayscale.Free; -end; - -{ TBGRASystemFontRenderer } - -{ Update font properties to internal TFont object } -procedure TBGRASystemFontRenderer.UpdateFont; -var fixedHeight: integer; - fs: TFontStyles; - patchedName: String; -begin - patchedName := PatchSystemFontName(FontName); - if FFont.Name <> patchedName then - FFont.Name := patchedName; - fs := FontStyle; - if (OverrideUnderlineDecoration or (CompareText(Trim(patchedName),'FreeSans')=0) or - (CompareText(Trim(patchedName),'FreeMono')=0) or (CompareText(Trim(patchedName),'FreeSerif')=0)) - and (fsUnderline in fs) then - begin - Exclude(fs, fsUnderline); - FOwnUnderline := true; - end else - FOwnUnderline := false; - if FFont.Style <> fs then - FFont.Style := fs; - if FontEmHeight < 0 then - fixedHeight := FixSystemFontFullHeight(patchedName, FontEmHeight * FontEmHeightSign) - else - fixedHeight := FontEmHeight * FontEmHeightSign; - if FFont.Height <> fixedHeight then - FFont.Height := fixedHeight; - if FontQuality = fqSystemClearType then - FFont.Quality := fqCleartype - else - FFont.Quality := FontDefaultQuality; -end; - -function TBGRASystemFontRenderer.InternalTextSize(sUTF8: string; - AShowPrefix: boolean): TSize; -begin - result := InternalTextSizeAngle(sUTF8, AShowPrefix, FontOrientation); -end; - -function TBGRASystemFontRenderer.InternalTextSizeAngle(sUTF8: string; - AShowPrefix: boolean; AOrientation: integer): TSize; -begin - if AShowPrefix then sUTF8 := RemovePrefix(sUTF8); - result := BGRAText.BGRATextSizeAngle(FFont, AOrientation, FontQuality, - sUTF8, FontAntialiasingLevel); - if (result.cy >= 24) - and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) - and (FontAntialiasingLevel > 4) then - result := BGRAText.BGRATextSizeAngle(FFont, AOrientation, FontQuality, - sUTF8, 4); -end; - -procedure TBGRASystemFontRenderer.SplitText(var ATextUTF8: string; - AMaxWidth: integer; out ARemainsUTF8: string); -var WordBreakHandler: TWordBreakHandler; -begin - UpdateFont; - if Assigned(FWordBreakHandler) then - WordBreakHandler := FWordBreakHandler - else - WordBreakHandler := @DefaultWorkBreakHandler; - - InternalSplitText(ATextUTF8, AMaxWidth, ARemainsUTF8, WordBreakHandler); -end; - -function TBGRASystemFontRenderer.GetFontPixelMetric: TFontPixelMetric; -begin - UpdateFont; - result := InternalGetFontPixelMetric; -end; - -function TBGRASystemFontRenderer.FontExists(AName: string): boolean; -var - i: Integer; -begin - {$IFDEF LCL} - for i := 0 to Screen.Fonts.Count-1 do - if CompareText(Screen.Fonts[i], AName) = 0 then exit(true); - result := false; - {$ELSE} - result := true; - {$ENDIF} -end; - -class function TBGRASystemFontRenderer.PatchSystemFontName(AName: string): string; -begin - if AName = 'serif' then - result := {$IFDEF DARWIN}'Times'{$ELSE}'serif'{$ENDIF} - else if AName = 'monospace' then - result := {$IFDEF DARWIN}'Courier'{$ELSE}{$IFDEF LINUX}'DejaVu Sans Mono'{$ELSE}'monospace'{$ENDIF}{$ENDIF} - else result := AName; -end; - -procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; - sUTF8: string; c: TBGRAPixel; align: TAlignment); -begin - UpdateFont; - InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,c,nil,align,false,false); -end; - -procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; - align: TAlignment; ARightToLeft: boolean); -begin - UpdateFont; - InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,c,nil,align,false,ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; - sUTF8: string; texture: IBGRAScanner; align: TAlignment); -begin - UpdateFont; - InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,BGRAPixelTransparent,texture,align,false,false); -end; - -procedure TBGRASystemFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientationTenthDegCCW: integer; sUTF8: string; - texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); -begin - UpdateFont; - InternalTextOutAngle(ADest,x,y,orientationTenthDegCCW,sUTF8,BGRAPixelTransparent,texture,align,false,ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; - texture: IBGRAScanner; align: TAlignment); -begin - UpdateFont; - InternalTextOut(ADest, x,y, sUTF8, BGRAPixelTransparent,texture, align); -end; - -procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; - align: TAlignment); -begin - UpdateFont; - InternalTextOut(ADest, x,y, sUTF8, c,nil, align); -end; - -procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; - ARightToLeft: boolean); -begin - UpdateFont; - InternalTextOut(ADest, x,y, sUTF8, BGRAPixelTransparent,texture, align, - False, ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; - ARightToLeft: boolean); -begin - UpdateFont; - InternalTextOut(ADest, x,y, sUTF8, c,nil, align, false, ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; - style: TTextStyle; c: TBGRAPixel); -begin - UpdateFont; - InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil); -end; - -procedure TBGRASystemFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; - style: TTextStyle; texture: IBGRAScanner); -begin - UpdateFont; - InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture); -end; - -procedure TBGRASystemFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap; - AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean); -begin - UpdateFont; - InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,AColor,nil,AHorizAlign,AVertAlign,ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap; - AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; - AHorizAlign: TAlignment; AVertAlign: TTextLayout; ARightToLeft: boolean); -begin - UpdateFont; - InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,BGRAPixelTransparent,ATexture,AHorizAlign,AVertAlign,ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.InternalTextWordBreak( - ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer; - AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; - AVertAlign: TTextLayout; ARightToLeft: boolean); -var remains, part, curText,nextText: string; - stepX,stepY: integer; - lines: TStringList; - i: integer; - lineShift: single; - WordBreakHandler: TWordBreakHandler; - lineEndingBreak: boolean; - bidiLayout: TBidiTextLayout; - bidiAlign: TBidiTextAlignment; -begin - if (ATextUTF8 = '') or (AMaxWidth <= 0) then exit; - - if Assigned(FWordBreakHandler) then - WordBreakHandler := FWordBreakHandler - else - WordBreakHandler := @DefaultWorkBreakHandler; - - if ContainsBidiIsolateOrFormattingUTF8(ATextUTF8) or - (pos(UTF8_LINE_SEPARATOR, ATextUTF8) <> 0) then - begin - bidiLayout := TBidiTextLayout.Create(self, ATextUTF8, ARightToLeft); - bidiLayout.WordBreakHandler:= WordBreakHandler; - bidiLayout.AvailableWidth := AMaxWidth; - case AHorizAlign of - taLeftJustify: bidiAlign:= btaLeftJustify; - taRightJustify: begin - bidiAlign:= btaRightJustify; - dec(x, AMaxWidth); - end - else - begin - bidiAlign:= btaCenter; - dec(x, AMaxWidth div 2); - end; - end; - for i := 0 to bidiLayout.ParagraphCount-1 do - bidiLayout.ParagraphAlignment[i] := bidiAlign; - case AVertAlign of - tlBottom: bidiLayout.TopLeft := PointF(x, y - bidiLayout.TotalTextHeight); - tlCenter: bidiLayout.TopLeft := PointF(x, y - bidiLayout.TotalTextHeight/2); - end; - if ATexture <> nil then bidiLayout.DrawText(ADest, ATexture) - else bidiLayout.DrawText(ADest, AColor); - bidiLayout.Free; - exit; - end; - - stepX := 0; - stepY := TextSize('Hg').cy; - - lines := TStringList.Create; - curText := ATextUTF8; - repeat - InternalSplitText(curText, AMaxWidth, remains, lineEndingBreak, WordBreakHandler); - part := curText; - if not lineEndingBreak then - // append following direction to part - case GetFirstStrongBidiClassUTF8(remains) of - ubcLeftToRight: if ARightToLeft then AppendStr(part, UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK)); - ubcRightToLeft,ubcArabicLetter: if not ARightToLeft then AppendStr(part, UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK)); - end; - lines.Add(part); - // prefix next part with previous direction - nextText := remains; - if not lineEndingBreak then - case GetLastStrongBidiClassUTF8(curText) of - ubcLeftToRight: if ARightToLeft then nextText := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK) + nextText; - ubcRightToLeft,ubcArabicLetter: if not ARightToLeft then nextText := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK) + nextText; - end; - curText := nextText; - until remains = ''; - if AVertAlign = tlCenter then lineShift := lines.Count/2 - else if AVertAlign = tlBottom then lineShift := lines.Count - else lineShift := 0; - - dec(X, round(stepX*lineShift)); - dec(Y, round(stepY*lineShift)); - for i := 0 to lines.Count-1 do - begin - InternalTextOut(ADest,x,y,lines[i],AColor,ATexture,AHorizAlign,false,ARightToLeft); - inc(X, stepX); - inc(Y, stepY); - end; - lines.Free; -end; - -procedure TBGRASystemFontRenderer.InternalTextRect(ADest: TBGRACustomBitmap; - ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; - ATexture: IBGRAScanner); -var - oldOrientation: integer; - previousClip, intersected: TRect; - lines: TStringList; - iStart,i,h: integer; - availableWidth: integer; -begin - if sUTF8='' then exit; - previousClip := ADest.ClipRect; - if style.Clipping then - begin - intersected := TRect.Intersect(previousClip, ARect); - if intersected.IsEmpty then exit; - ADest.ClipRect := intersected; - end; - if style.SystemFont then FFont.Name := 'default'; - - if not (style.Alignment in[taCenter,taRightJustify]) then ARect.Left := x; - if not (style.Layout in[tlCenter,tlBottom]) then ARect.top := y; - if (ARect.Right <= ARect.Left) and style.Clipping then - begin - ADest.ClipRect := previousClip; - exit; - end; - if style.Layout = tlCenter then Y := (ARect.Top+ARect.Bottom) div 2 else - if style.Layout = tlBottom then Y := ARect.Bottom else - Y := ARect.Top; - if style.Alignment = taCenter then X := (ARect.Left+ARect.Right) div 2 else - if style.Alignment = taRightJustify then X := ARect.Right else - X := ARect.Left; - oldOrientation := FontOrientation; - FontOrientation := 0; - if style.Wordbreak then - begin - if style.ShowPrefix then sUTF8 := RemovePrefix(sUTF8); //prefix not handled - InternalTextWordBreak(ADest,sUTF8,X,Y,ARect.Right-ARect.Left,c,ATexture, - style.Alignment,style.Layout,style.RightToLeft); - end - else - begin - lines := nil; - iStart := 1; - - if not style.SingleLine then - begin - i := iStart; - while i <= length(sUTF8) do - begin - if sUTF8[i] in[#13,#10] then - begin - if not assigned(lines) then lines := TStringList.Create; - lines.add(copy(sUTF8,iStart,i-iStart)); - if (sUTF8[i]=#13) and (i < length(sUTF8)) and (sUTF8[i+1]=#10) then inc(i); - iStart := i+1 - end; - inc(i); - end; - end; - - if style.Alignment = taLeftJustify then - availableWidth := ARect.Right-X - else - availableWidth := ARect.Right-ARect.Left; - if availableWidth < 0 then availableWidth:= 0; - - if lines = nil then //only one line - begin - if style.Layout = tlCenter then dec(Y, InternalTextSize(sUTF8,style.ShowPrefix).cy div 2); - if style.Layout = tlBottom then dec(Y, InternalTextSize(sUTF8,style.ShowPrefix).cy); - if style.EndEllipsis then - InternalTextOutEllipse(ADest,X,Y,availableWidth,sUTF8,c,ATexture,style.Alignment, - style.ShowPrefix,style.RightToLeft) - else - InternalTextOut(ADest,X,Y,sUTF8,c,ATexture,style.Alignment, - style.ShowPrefix,style.RightToLeft); - end else - begin //multiple lines - lines.add(copy(sUTF8, iStart, length(sUTF8)-iStart+1)); - h := InternalTextSize('Hg',False).cy; - if style.Layout = tlCenter then dec(Y, h*lines.Count div 2); - if style.Layout = tlBottom then dec(Y, h*lines.Count); - for i := 0 to lines.Count-1 do - begin - if style.EndEllipsis then - InternalTextOutEllipse(ADest,X,Y,availableWidth,lines[i],c,ATexture,style.Alignment, - style.ShowPrefix,style.RightToLeft) - else - InternalTextOut(ADest,X,Y,lines[i],c,ATexture,style.Alignment, - style.ShowPrefix,style.RightToLeft); - inc(Y,h); - end; - lines.Free; - end; - - end; - - FontOrientation := oldOrientation; - if style.Clipping then - ADest.ClipRect := previousClip; -end; - -procedure TBGRASystemFontRenderer.InternalTextOut(ADest: TBGRACustomBitmap; x, - y: single; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; - align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); -begin - InternalTextOutAngle(ADest, x,y, FontOrientation, sUTF8, c, texture, - align, ASHowPrefix, ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.InternalTextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; AOrientation: integer; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; - align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); -var mode : TBGRATextOutImproveReadabilityMode; - s: TSize; - pts: ArrayOfTPointF; - m: TAffineMatrix; - i: Integer; -begin - if sUTF8='' then exit; - {$IF defined(LINUX) or defined(DARWIN)} - //help LCL detect the correct direction - case GetFirstStrongBidiClassUTF8(sUTF8) of - ubcRightToLeft, ubcArabicLetter: if not ARightToLeft then sUTF8 := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK) + sUTF8; - else - begin //suppose left-to-right - if ARightToLeft then sUTF8 := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK) + sUTF8; - end; - end; - {$ENDIF} - if Assigned(BGRATextOutImproveReadabilityProc) and - (FontQuality in[{$IFNDEF SYSTEM_RENDERER_IS_FINE}fqFineAntialiasing,{$ENDIF} - fqFineClearTypeBGR,fqFineClearTypeRGB]) and - (AOrientation mod 3600 = 0) then - begin - case FontQuality of - fqFineClearTypeBGR: mode := irClearTypeBGR; - fqFineClearTypeRGB: mode := irClearTypeRGB; - else - mode := irNormal; - end; - if AShowPrefix then sUTF8 := RemovePrefix(sUTF8); //prefix not handled - BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,c,texture,align,mode); - end else - begin - if AOrientation = 0 then - BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,c,texture,align, - 0,AShowPrefix,ARightToLeft) - else - BGRAText.BGRATextOutAngle(ADest,FFont,FontQuality,x,y,AOrientation, - sUTF8,c,texture,align,0); - end; - if FOwnUnderline then - begin - s := InternalTextSizeAngle(sUTF8, AShowPrefix, AOrientation); - pts := BGRATextUnderline(PointF(x,y),s.cx,InternalGetFontPixelMetric); - if AOrientation mod 3600 <> 0 then - begin - m := AffineMatrixTranslation(x,y)* - AffineMatrixRotationDeg(-AOrientation/10)* - AffineMatrixTranslation(-x,-y); - for i := 0 to high(pts) do - pts[i] := m*pts[i]; - end; - if texture<>nil then - ADest.FillPolyAntialias(pts, texture, false) - else - ADest.FillPolyAntialias(pts, c, false); - end; -end; - -procedure TBGRASystemFontRenderer.InternalTextOutEllipse( - ADest: TBGRACustomBitmap; x, y, availableWidth: single; sUTF8: string; - c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; - AShowPrefix: boolean; ARightToLeft: boolean); -var remain: string; -begin - if sUTF8='' then exit; - if InternalTextSize(sUTF8,AShowPrefix).cx > availableWidth then - begin - InternalSplitText(sUTF8, round(availableWidth - InternalTextSize('...',AShowPrefix).cx), remain, nil); - AppendStr(sUTF8, '...'); - end; - InternalTextOut(ADest,x,y,sUTF8,c,texture,align,AShowPrefix,ARightToLeft); -end; - -procedure TBGRASystemFontRenderer.InternalSplitText(var ATextUTF8: string; - AMaxWidth: integer; out ARemainsUTF8: string; out ALineEndingBreak: boolean; AWordBreak: TWordBreakHandler); -var p,skipCount, charLen: integer; - zeroWidth: boolean; - u: LongWord; -begin - ALineEndingBreak:= false; - if ATextUTF8= '' then - begin - ARemainsUTF8 := ''; - exit; - end; - if RemoveLineEnding(ATextUTF8,1) then - begin - ARemainsUTF8:= ATextUTF8; - ATextUTF8 := ''; - ALineEndingBreak:= true; - exit; - end; - if InternalTextSize(ATextUTF8, false).cx <= AMaxWidth then - begin - for p := 1 to length(ATextUTF8) do - begin - if RemoveLineEnding(ATextUTF8,p) then - begin - ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); - ATextUTF8 := copy(ATextUTF8,1,p-1); - ALineEndingBreak:= true; - exit; - end; - end; - ARemainsUTF8 := ''; - exit; - end; - - if AMaxWidth <= 0 then - skipCount := 0 - else - skipCount := BGRATextFitInfo(FFont, FontQuality, ATextUTF8, FontAntialiasingLevel, AMaxWidth); - - if skipCount <= 0 then skipCount := 1; - - p := 1; - zeroWidth := true; - repeat - charLen := UTF8CharacterLength(@ATextUTF8[p]); - u := UTF8CodepointToUnicode(@ATextUTF8[p], charLen); - if not IsZeroWidthUnicode(u) then - zeroWidth:= false; - inc(p, charLen); //UTF8 chars may be more than 1 byte long - dec(skipCount); - - if RemoveLineEnding(ATextUTF8,p) then - begin - ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); - ATextUTF8 := copy(ATextUTF8,1,p-1); - ALineEndingBreak:= true; - exit; - end; - until ((skipCount <= 0) and not zeroWidth) or (p >= length(ATextUTF8)+1); - - ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); - ATextUTF8 := copy(ATextUTF8,1,p-1); //this includes the whole last UTF8 char - if Assigned(AWordBreak) then AWordBreak(ATextUTF8,ARemainsUTF8); -end; - -procedure TBGRASystemFontRenderer.InternalSplitText(var ATextUTF8: string; - AMaxWidth: integer; out ARemainsUTF8: string; AWordBreak: TWordBreakHandler); -var lineEndingBreak: boolean; -begin - InternalSplitText(ATextUTF8,AMaxWidth,ARemainsUTF8,lineEndingBreak,AWordBreak); -end; - -function TBGRASystemFontRenderer.InternalGetFontPixelMetric: TFontPixelMetric; -var fxFont: TFont; -begin - if FontQuality in[fqSystem,fqSystemClearType] then - result := GetLCLFontPixelMetric(FFont) - else - begin - FxFont := TFont.Create; - FxFont.Assign(FFont); - FxFont.Height := fxFont.Height*FontAntialiasingLevel; - Result:= GetLCLFontPixelMetric(FxFont); - if Result.Baseline <> -1 then Result.Baseline:= round((Result.Baseline-1)/FontAntialiasingLevel); - if Result.CapLine <> -1 then Result.CapLine:= round(Result.CapLine/FontAntialiasingLevel); - if Result.DescentLine <> -1 then Result.DescentLine:= round((Result.DescentLine-1)/FontAntialiasingLevel); - if Result.Lineheight <> -1 then Result.Lineheight:= round(Result.Lineheight/FontAntialiasingLevel); - if Result.xLine <> -1 then Result.xLine:= round(Result.xLine/FontAntialiasingLevel); - FxFont.Free; - end; -end; - -procedure TBGRASystemFontRenderer.DefaultWorkBreakHandler(var ABeforeUTF8, - AAfterUTF8: string); -begin - BGRADefaultWordBreakHandler(ABeforeUTF8,AAfterUTF8); -end; - -function TBGRASystemFontRenderer.TextSize(sUTF8: string): TSize; -var oldOrientation: integer; -begin - oldOrientation:= FontOrientation; - FontOrientation:= 0; - UpdateFont; - result := InternalTextSize(sUTF8,False); - FontOrientation:= oldOrientation; -end; - -function TBGRASystemFontRenderer.TextSizeAngle(sUTF8: string; - orientationTenthDegCCW: integer): TSize; -var oldOrientation: integer; -begin - oldOrientation:= FontOrientation; - FontOrientation:= orientationTenthDegCCW; - UpdateFont; - result := InternalTextSize(sUTF8,False); - FontOrientation:= oldOrientation; -end; - -function TBGRASystemFontRenderer.TextSize(sUTF8: string; - AMaxWidth: integer; ARightToLeft: boolean): TSize; -var - remains: string; - h, i, w: integer; - WordBreakHandler: TWordBreakHandler; - layout: TBidiTextLayout; -begin - UpdateFont; - - if Assigned(FWordBreakHandler) then - WordBreakHandler := FWordBreakHandler - else - WordBreakHandler := @DefaultWorkBreakHandler; - - if ContainsBidiIsolateOrFormattingUTF8(sUTF8) then - begin - layout := TBidiTextLayout.Create(self, sUTF8, ARightToLeft); - layout.WordBreakHandler:= WordBreakHandler; - layout.AvailableWidth := AMaxWidth; - for i := 0 to layout.ParagraphCount-1 do - layout.ParagraphAlignment[i] := btaLeftJustify; - result.cx := 0; - for i := 0 to layout.PartCount-1 do - begin - w := ceil(layout.PartRectF[i].Right); - if w > result.cx then result.cx := w; - end; - result.cy := ceil(layout.TotalTextHeight); - layout.Free; - end else - begin - result.cx := 0; - result.cy := 0; - h := InternalTextSize('Hg',False).cy; - repeat - InternalSplitText(sUTF8, AMaxWidth, remains, WordBreakHandler); - with InternalTextSize(sUTF8, false) do - if cx > result.cx then result.cx := cx; - inc(result.cy, h); - sUTF8 := remains; - until remains = ''; - end; -end; - -function TBGRASystemFontRenderer.TextFitInfo(sUTF8: string; AMaxWidth: integer - ): integer; -begin - UpdateFont; - result := BGRATextFitInfo(FFont, FontQuality, sUTF8, FontAntialiasingLevel, AMaxWidth); -end; - -constructor TBGRASystemFontRenderer.Create; -begin - FFont := TFont.Create; -end; - -destructor TBGRASystemFontRenderer.Destroy; -begin - FFont.Free; - inherited Destroy; -end; - -initialization - - fqFineClearType := @GetFineClearTypeAuto; - -end. - diff --git a/components/bgrabitmap/bgratextbidi.pas b/components/bgrabitmap/bgratextbidi.pas deleted file mode 100644 index 774d506..0000000 --- a/components/bgrabitmap/bgratextbidi.pas +++ /dev/null @@ -1,3487 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRATextBidi; - -{$mode objfpc}{$H+} -{$MODESWITCH ADVANCEDRECORDS} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, BGRAUTF8, BGRAUnicode, BGRATransform, - BGRAUnicodeText; - -type - TBrokenLinesChangedEvent = procedure(ASender: TObject; AParagraphIndex: integer; - ASubBrokenStart, ASubBrokenChangedCountBefore, ASubBrokenChangedCountAfter: integer; - ASubBrokenTotalCountBefore, ASubBrokenTotalCountAfter: integer) of object; - TParagraphLayoutSplitEvent = procedure(ASender: TObject; AParagraphIndex: integer; - ASubBrokenIndex, ACharIndex: integer) of object; - - { TBidiCaretPos } - - TBidiCaretPos = record - PartIndex: integer; - - Top, Bottom: TPointF; - RightToLeft: boolean; - - PreviousTop, PreviousBottom: TPointF; - PreviousRightToLeft: boolean; - - procedure Transform(AMatrix: TAffineMatrix); - end; - - PPartInfo = ^TPartInfo; - - { TPartInfo } - - TPartInfo = record - brokenLineIndex: integer; - startIndex, endIndex: integer; - bidiLevel: byte; - modified: bytebool; - rectF: TRectF; - posCorrection: TPointF; - function IsRightToLeft: boolean; - end; - - PBrokenLineInfo = ^TBrokenLineInfo; - - { TBrokenLineInfo } - - TBrokenLineInfo = record - unbrokenLineIndex: integer; - startIndex, endIndex: integer; - bidiLevel: byte; - rectF: TRectF; - usedWidth: single; - firstPartIndex: integer; - parts: array of TPartInfo; - partCount: integer; - function IsRightToLeft: boolean; - end; - - PParagraphInfo = ^TParagraphInfo; - TParagraphInfo = record - alignment: TBidiTextAlignment; - layoutComputed, overflow: boolean; - rectF: TRectF; - firstBrokenLineIndex: integer; - firstPartIndex: integer; - brokenLines: array of TBrokenLineInfo; - brokenLineCount: integer; - end; - - TBidiTextLayout = class; - - { TPartEnumerator } - - TPartEnumerator = record - private - FJustCreated: boolean; - FParagraphIndex: integer; - FBrokenLineIndex: integer; - FPartIndex: integer; - FLayout: TBidiTextLayout; - FSubBrokenIndex: integer; - FSubBrokenCount: integer; - FCurBroken: PBrokenLineInfo; - FSubPartIndex: integer; - FSubPartCount: integer; - FEndPartIndex: integer; - function GetPartInfo: PPartInfo; - procedure Update; - public - class function New(ALayout: TBidiTextLayout; AParagraphIndex: integer; - ASubBrokenIndex: integer; ASubPartIndex: integer; AEndPartIndex: integer): TPartEnumerator; static; - function GetNext: boolean; - property Layout: TBidiTextLayout read FLayout; - property ParagraphIndex: integer read FParagraphIndex; - property BrokenLineIndex: integer read FBrokenLineIndex; - property PartIndex: integer read FPartIndex; - property PartInfo: PPartInfo read GetPartInfo; - property BrokenLineInfo: PBrokenLineInfo read FCurBroken; - end; - - { TBidiTextLayout } - - TBidiTextLayout = class - private - FAvailableHeight: single; - FAvailableWidth: single; - FClipMargin: integer; - FOnBrokenLinesChanged: TBrokenLinesChangedEvent; - FOnParagraphChanged: TParagraphEvent; - FOnParagraphDeleted: TParagraphEvent; - FOnParagraphMergedWithNext: TParagraphEvent; - FOnParagraphSplit: TParagraphLayoutSplitEvent; - FOnParagraphVerticalTrimChanged: TParagraphEvent; - FParagraphSpacingAbove: single; - FParagraphSpacingBelow: single; - FTopLeft: TPointF; - FMatrix, FMatrixInverse: TAffineMatrix; - FTabSize: Single; - FWordBreakHandler: TWordBreakHandler; - function GetBrokenLineAffineBox(AIndex: integer): TAffineBox; - function GetBrokenLineCount: integer; - function GetBrokenLineEndCaret(AIndex: integer): TBidiCaretPos; - function GetBrokenLineEndPart(AIndex: integer): integer; - function GetBrokenLineStartPart(AIndex: integer): integer; - function GetBrokenLineUntransformedEndCaret(AIndex: integer): TBidiCaretPos; - function GetBrokenLineEndIndex(AIndex: integer): integer; - function GetBrokenLineParagraphIndex(AIndex: integer): integer; - function GetBrokenLineUnbrokenIndex(AIndex: integer): integer; - function GetBrokenLineInfo(AIndex: integer): PBrokenLineInfo; - function GetBrokenLineRectF(AIndex: integer): TRectF; - function GetBrokenLineRightToLeft(AIndex: integer): boolean; - function GetBrokenLineStartCaret(AIndex: integer): TBidiCaretPos; - function GetBrokenLineUntransformedStartCaret(AIndex: integer): TBidiCaretPos; - function GetBrokenLineStartIndex(AIndex: integer): integer; - function GetBrokenLineUsedWidth(AIndex: integer): single; - function GetCharCount: integer; - function GetFontBidiMode: TFontBidiMode; - function GetLayoutComputed: boolean; - function GetLineHeight: single; - function GetMatrix: TAffineMatrix; - function GetMatrixInverse: TAffineMatrix; - function GetParagraphAffineBox(AIndex: integer): TAffineBox; - function GetParagraphAlignment(AIndex: integer): TBidiTextAlignment; - function GetParagraphCount: integer; - function GetParagraphEndBrokenLine(AIndex: integer): integer; - function GetParagraphEndIndex(AIndex: integer): integer; - function GetParagraphEndIndexBeforeParagraphSeparator(AIndex: integer): integer; - function GetParagraphEndPart(AIndex: integer): integer; - function GetParagraphInfo(AIndex: integer): PParagraphInfo; - function GetParagraphRectF(AIndex: integer): TRectF; - function GetParagraphRightToLeft(AIndex: integer): boolean; - function GetParagraphStartBrokenLine(AIndex: integer): integer; - function GetParagraphStartIndex(AIndex: integer): integer; - function GetParagraphStartPart(AIndex: integer): integer; - function GetPartAffineBox(AIndex: integer): TAffineBox; - function GetPartBrokenLineIndex(AIndex: integer): integer; - function GetPartCount: integer; - function GetPartEnumerator(AFirstPart: integer): TPartEnumerator; - function GetPartEnumerator(AFirstPart, ALastPartPlus1: integer): TPartEnumerator; - function GetPartInfo(AIndex: integer): PPartInfo; - function GetPartEndIndex(AIndex: integer): integer; - function GetPartRectF(AIndex: integer): TRectF; - function GetPartRightToLeft(AIndex: integer): boolean; - function GetPartStartIndex(AIndex: integer): integer; - function GetText: string; - function GetTotalTextHeight: single; - function GetUnicodeChar(APosition0: integer): LongWord; - function GetUsedWidth: single; - function GetUTF8Char(APosition0: integer): string4; - procedure SetAvailableHeight(AValue: single); - procedure SetAvailableWidth(AValue: single); - procedure SetFontBidiMode(AValue: TFontBidiMode); - procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); - procedure SetParagraphAlignment(AIndex: integer; AValue: TBidiTextAlignment); - procedure SetParagraphSpacingAbove(AValue: single); - procedure SetParagraphSpacingBelow(AValue: single); - procedure SetTabSize(AValue: single); - procedure SetTopLeft(AValue: TPointF); - procedure ComputeMatrix; - protected - FAnalysis: TUnicodeAnalysis; - FRenderer: TBGRACustomFontRenderer; - FLineHeight: single; - - FParagraph: array of TParagraphInfo; - FComputedBrokenLineCount: integer; - FComputedPartCount: integer; - - FColor: TBGRAPixel; - FTexture: IBGRAScanner; - - function TextSizeBidiOverride(sUTF8: string; ARightToLeft: boolean): TPointF; - function TextSizeBidiOverrideSplit(AStartIndex, AEndIndex: integer; ARightToLeft: boolean; ASplitIndex: integer): TPointF; - function TextFitInfoBidiOverride(sUTF8: string; AWidth: single; ARightToLeft: boolean): integer; - function GetFontFullHeight: single; - function GetFontBaseline: single; - function GetFontOrientation: single; - procedure TextOutBidiOverride(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; ARightToLeft: boolean); - procedure TextPathBidiOverride(ADest: IBGRAPath; x, y: single; sUTF8: string; ARightToLeft: boolean); - - procedure AddPart(AStartIndex, AEndIndex: integer; ABidiLevel: byte; ARectF: TRectF; APosCorrection: TPointF; ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); - function GetPartStartCaret(APartIndex: integer): TBidiCaretPos; - function GetPartEndCaret(APartIndex: integer): TBidiCaretPos; - function GetUntransformedPartStartCaret(APartIndex: integer): TBidiCaretPos; - function GetUntransformedPartStartCaret(APartIndex: integer; APrevPart, APart: PPartInfo): TBidiCaretPos; - function GetUntransformedPartEndCaret(APartIndex: integer): TBidiCaretPos; - function GetUntransformedPartEndCaret(APartIndex: integer; APart: PPartInfo): TBidiCaretPos; - function GetUntransformedParagraphAt(APosition: TPointF): integer; overload; - - function GetSameLevelString(startIndex,endIndex: integer): string; overload; - function GetSameLevelString(startIndex,endIndex: integer; out nonDiscardedCount: integer): string; overload; - function ComputeBidiTree(AMaxWidth: single; startIndex, endIndex: integer; bidiLevel: byte): TBidiTree; - procedure AddPartsFromTree(APos: TPointF; ATree: TBidiTree; fullHeight, baseLine: single; ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); - procedure Init(ATextUTF8: string; ABidiMode: TFontBidiMode); virtual; - procedure ComputeLayout; virtual; - procedure CheckTextLayout; - procedure NeedLayout; - procedure InvalidateParagraphLayout(AParagraphIndex: integer); - procedure InternalInvalidateParagraphLayout(AParagraphIndex: integer); - procedure OffsetParagraph(AParagraphIndex: integer; ADeltaY: single; ADeltaBroken, ADeltaPart: integer); - procedure OffsetParagraphCharIndex(AParagraphIndex: integer; ADeltaChar: integer); - procedure TrimParagraphLayoutVertically(AParagraphIndex: integer); - procedure InternalDrawText(ADest: TBGRACustomBitmap); - procedure InternalPathText(ADest: IBGRAPath); overload; - procedure InternalPathText(ADest: IBGRAPath; AClipRect: TRect); overload; - procedure InternalDrawTextParts(ADest: TBGRACustomBitmap; AFirstPart, ALastPartPlus1: integer); - procedure InternalPathTextParts(ADest: IBGRAPath; AFirstPart, ALastPartPlus1: integer); overload; - procedure InternalPathTextParts(ADest: IBGRAPath; AClipRect: TRect; AFirstPart, ALastPartPlus1: integer); overload; - procedure InternalRangeError; - - //unicode analysis events - procedure BidiModeChanged({%H-}ASender: TObject); - procedure CharDeleted({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharStart, {%H-}ACharCount: integer); - procedure CharInserted({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharStart, {%H-}ACharCount: integer); - procedure AnalysisChanged({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharStart, {%H-}ACharCount: integer); - procedure ParagraphDeleted({%H-}ASender: TObject; AParagraphIndex: integer); - procedure ParagraphMergedWithNext({%H-}ASender: TObject; AParagraphIndex: integer); - procedure ParagraphSplit({%H-}ASender: TObject; AParagraphIndex: integer; {%H-}ACharIndex: integer); - procedure InternalParagraphDeleted(AParagraphIndex: integer); - property LayoutComputed: boolean read GetLayoutComputed; - public - constructor Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string); overload; - constructor Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string; ARightToLeft: boolean); overload; - constructor Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string; AFontBidiMode: TFontBidiMode); overload; - destructor Destroy; override; - procedure SetLayout(ARect: TRectF); - procedure InvalidateLayout; - procedure ComputeLayoutIfNeeded; - function AddOverrideIfNecessary(var sUTF8: string; ARightToLeft: boolean): boolean; - function GetTextPart(APartIndex: integer; AAddOverrideIfNecessary: boolean): string; - - procedure DrawText(ADest: TBGRACustomBitmap); overload; - procedure DrawText(ADest: TBGRACustomBitmap; AColor: TBGRAPixel); overload; - procedure DrawText(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner); overload; - procedure PathText(ADest: IBGRAPath); - procedure PathText(ADest: IBGRAPath; AClipRect: TRect); - procedure DrawTextParts(ADest: TBGRACustomBitmap; AFirstPart, ALastPartPlus1: integer); overload; - procedure DrawTextParts(ADest: TBGRACustomBitmap; AColor: TBGRAPixel; AFirstPart, ALastPartPlus1: integer); overload; - procedure DrawTextParts(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner; AFirstPart, ALastPartPlus1: integer); overload; - procedure PathTextParts(ADest: IBGRAPath; AFirstPart, ALastPartPlus1: integer); overload; - procedure PathTextParts(ADest: IBGRAPath; AClipRect: TRect; AFirstPart, ALastPartPlus1: integer); overload; - procedure DrawParagraphs(ADest: TBGRACustomBitmap; AFirstPara, ALastParaPlus1: integer); overload; - procedure DrawParagraphs(ADest: TBGRACustomBitmap; AColor: TBGRAPixel; AFirstPara, ALastParaPlus1: integer); overload; - procedure DrawParagraphs(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner; AFirstPara, ALastParaPlus1: integer); overload; - procedure PathParagraphs(ADest: IBGRAPath; AFirstPara, ALastParaPlus1: integer); overload; - procedure PathParagraphs(ADest: IBGRAPath; AClipRect: TRect; AFirstPara, ALastParaPlus1: integer); overload; - procedure DrawBrokenLines(ADest: TBGRACustomBitmap; AFirstBroken, ALastBrokenPlus1: integer); overload; - procedure DrawBrokenLines(ADest: TBGRACustomBitmap; AColor: TBGRAPixel; AFirstBroken, ALastBrokenPlus1: integer); overload; - procedure DrawBrokenLines(ADest: TBGRACustomBitmap; ATexture: IBGRAScanner; AFirstBroken, ALastBrokenPlus1: integer); overload; - procedure PathBrokenLines(ADest: IBGRAPath; AFirstBroken, ALastBrokenPlus1: integer); overload; - procedure PathBrokenLines(ADest: IBGRAPath; AClipRect: TRect; AFirstBroken, ALastBrokenPlus1: integer); overload; - - procedure DrawCaret(ADest: TBGRACustomBitmap; ACharIndex: integer; AMainColor, ASecondaryColor: TBGRAPixel); - procedure DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, AEndIndex: integer; - AFillColor: TBGRAPixel; ABorderColor: TBGRAPixel; APenWidth: single); overload; - procedure DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, AEndIndex: integer; - AFillColor: TBGRAPixel); overload; - - function GetCaret(ACharIndex: integer): TBidiCaretPos; - function GetUntransformedCaret(ACharIndex: integer): TBidiCaretPos; - function GetCharIndexAt(APosition: TPointF): integer; - function GetTextEnveloppe(AStartIndex, AEndIndex: integer; APixelCenteredCoordinates: boolean = true; AMergeBoxes: boolean = true; AVerticalClip: boolean = false): ArrayOfTPointF; - function GetUntransformedTextEnveloppe(AStartIndex, AEndIndex: integer; APixelCenteredCoordinates: boolean = true; AMergeBoxes: boolean = true; AVerticalClip: boolean = false): ArrayOfTPointF; - function GetParagraphAt(ACharIndex: Integer): integer; overload; - function GetParagraphAt(APosition: TPointF): integer; overload; - function GetBrokenLineAt(ACharIndex: integer): integer; - - function InsertText(ATextUTF8: string; APosition: integer): integer; - function InsertLineSeparator(APosition: integer): integer; - function DeleteText(APosition, ACount: integer): integer; - function DeleteTextBefore(APosition, ACount: integer): integer; - function CopyText(APosition, ACount: integer): string; - function CopyTextBefore(APosition, ACount: integer): string; - function IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; - function IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; - function FindTextAbove(AFromPosition: integer): integer; - function FindTextBelow(AFromPosition: integer): integer; - - property CharCount: integer read GetCharCount; - property UTF8Char[APosition0: integer]: string4 read GetUTF8Char; - property UnicodeChar[APosition0: integer]: LongWord read GetUnicodeChar; - - property BrokenLineCount: integer read GetBrokenLineCount; - property BrokenLineParagraphIndex[AIndex: integer]: integer read GetBrokenLineParagraphIndex; - property BrokenLineUnbrokenIndex[AIndex: integer]: integer read GetBrokenLineUnbrokenIndex; - property BrokenLineStartIndex[AIndex: integer]: integer read GetBrokenLineStartIndex; - property BrokenLineEndIndex[AIndex: integer]: integer read GetBrokenLineEndIndex; - property BrokenLineStartPart[AIndex: integer]: integer read GetBrokenLineStartPart; - property BrokenLineEndPart[AIndex: integer]: integer read GetBrokenLineEndPart; - property BrokenLineRectF[AIndex: integer]: TRectF read GetBrokenLineRectF; - property BrokenLineUsedWidth[AIndex: integer]: single read GetBrokenLineUsedWidth; - property BrokenLineAffineBox[AIndex: integer]: TAffineBox read GetBrokenLineAffineBox; - property BrokenLineRightToLeft[AIndex: integer]: boolean read GetBrokenLineRightToLeft; - property BrokenLineStartCaret[AIndex: integer]: TBidiCaretPos read GetBrokenLineStartCaret; - property BrokenLineEndCaret[AIndex: integer]: TBidiCaretPos read GetBrokenLineEndCaret; - property OnBrokenLinesChanged: TBrokenLinesChangedEvent read FOnBrokenLinesChanged write FOnBrokenLinesChanged; - - property PartCount: integer read GetPartCount; - property PartStartIndex[AIndex: integer]: integer read GetPartStartIndex; - property PartEndIndex[AIndex: integer]: integer read GetPartEndIndex; - property PartBrokenLineIndex[AIndex: integer]: integer read GetPartBrokenLineIndex; - property PartStartCaret[AIndex: integer]: TBidiCaretPos read GetPartStartCaret; - property PartEndCaret[AIndex: integer]: TBidiCaretPos read GetPartEndCaret; - property PartRectF[AIndex: integer]: TRectF read GetPartRectF; - property PartAffineBox[AIndex: integer]: TAffineBox read GetPartAffineBox; - property PartRightToLeft[AIndex: integer]: boolean read GetPartRightToLeft; - - property TopLeft: TPointF read FTopLeft write SetTopLeft; - property AvailableWidth: single read FAvailableWidth write SetAvailableWidth; - property AvailableHeight: single read FAvailableHeight write SetAvailableHeight; - property TabSize: single read FTabSize write SetTabSize; - property ParagraphSpacingAbove: single read FParagraphSpacingAbove write SetParagraphSpacingAbove; - property ParagraphSpacingBelow: single read FParagraphSpacingBelow write SetParagraphSpacingBelow; - property ParagraphRectF[AIndex: integer]: TRectF read GetParagraphRectF; - property ParagraphAffineBox[AIndex: integer]: TAffineBox read GetParagraphAffineBox; - property ParagraphAlignment[AIndex: integer]: TBidiTextAlignment read GetParagraphAlignment write SetParagraphAlignment; - property ParagraphStartIndex[AIndex: integer]: integer read GetParagraphStartIndex; - property ParagraphEndIndex[AIndex: integer]: integer read GetParagraphEndIndex; - property ParagraphEndIndexBeforeParagraphSeparator[AIndex: integer]: integer read GetParagraphEndIndexBeforeParagraphSeparator; - property ParagraphRightToLeft[AIndex: integer]: boolean read GetParagraphRightToLeft; - property ParagraphStartPart[AIndex: integer]: integer read GetParagraphStartPart; - property ParagraphEndPart[AIndex: integer]: integer read GetParagraphEndPart; - property ParagraphStartBrokenLine[AIndex: integer]: integer read GetParagraphStartBrokenLine; - property ParagraphEndBrokenLine[AIndex: integer]: integer read GetParagraphEndBrokenLine; - property ParagraphCount: integer read GetParagraphCount; - property OnParagraphDeleted : TParagraphEvent read FOnParagraphDeleted write FOnParagraphDeleted; - property OnParagraphMergedWithNext: TParagraphEvent read FOnParagraphMergedWithNext write FOnParagraphMergedWithNext; - property OnParagraphSplit: TParagraphLayoutSplitEvent read FOnParagraphSplit write FOnParagraphSplit; - property OnParagraphChanged: TParagraphEvent read FOnParagraphChanged write FOnParagraphChanged; - property OnParagraphVerticalTrimChanged: TParagraphEvent read FOnParagraphVerticalTrimChanged write FOnParagraphVerticalTrimChanged; - - property UsedWidth: single read GetUsedWidth; - property TotalTextHeight: single read GetTotalTextHeight; - property LineHeight: single read GetLineHeight; - - property Matrix: TAffineMatrix read GetMatrix; - property MatrixInverse: TAffineMatrix read GetMatrixInverse; - property TextUTF8: string read GetText; - property WordBreakHandler: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; - property ClipMargin: integer read FClipMargin write FClipMargin; // how many pixels can the text go outside of its box - - property FontRenderer: TBGRACustomFontRenderer read FRenderer write SetFontRenderer; - property FontBidiMode: TFontBidiMode read GetFontBidiMode write SetFontBidiMode; - end; - - { TBidiLayoutTree } - - TBidiLayoutTree = class(TBidiTree) - private - FBidiPos: single; - FSize: TPointF; - FTextUTF8: string; - FNonDiscardedCount: integer; - FLayout: TBidiTextLayout; - FMaxWidth: single; - function GetCumulatedBidiPos: single; - function GetHeight: single; - function GetLayout: TBidiTextLayout; - function GetMaxWidth: single; - function GetWidth: single; - procedure UpdateBranchSize; - public - constructor Create(AData: pointer; AStartIndex, AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); override; - procedure AddBranch(ABranch: TBidiTree); override; - procedure Shorten(AEndIndex: integer); override; - procedure AfterFinish; override; - function TrySplit: boolean; override; - property Layout: TBidiTextLayout read GetLayout; - property MaxWidth: single read GetMaxWidth; - property BidiPos: single read FBidiPos; - property CumulatedBidiPos: single read GetCumulatedBidiPos; - property Width: single read GetWidth; - property Height: single read GetHeight; - end; - - TBidiLayoutTreeData = record - Layout: TBidiTextLayout; - MaxWidth: single; - end; - -implementation - -uses math; - -{ TPartEnumerator } - -function TPartEnumerator.GetPartInfo: PPartInfo; -begin - if FSubPartIndex < FSubPartCount then - result := @FCurBroken^.parts[FSubPartIndex] - else - result := nil; -end; - -procedure TPartEnumerator.Update; -begin - with FLayout.FParagraph[FParagraphIndex] do - begin - FSubBrokenCount:= brokenLineCount; - FBrokenLineIndex:= FSubBrokenIndex + firstBrokenLineIndex; - if FSubBrokenIndex < brokenLineCount then - begin - FCurBroken := @brokenLines[FSubBrokenIndex]; - with FCurBroken^ do - begin - FSubPartCount:= partCount; - FPartIndex:= FSubPartIndex + firstPartIndex; - end; - end else - begin - FCurBroken := nil; - FSubPartCount:= 0; - if brokenLineCount > 0 then - FPartIndex := brokenLines[brokenLineCount-1].firstPartIndex + - brokenLines[brokenLineCount-1].partCount - else - FPartIndex := firstPartIndex; - end; - end; -end; - -class function TPartEnumerator.New(ALayout: TBidiTextLayout; - AParagraphIndex: integer; ASubBrokenIndex: integer; ASubPartIndex: integer; - AEndPartIndex: integer): TPartEnumerator; -begin - result.FLayout := ALayout; - result.FParagraphIndex:= AParagraphIndex; - result.FSubBrokenIndex:= ASubBrokenIndex; - result.FSubPartIndex:= ASubPartIndex; - result.Update; - result.FJustCreated:= true; - result.FEndPartIndex:= AEndPartIndex; -end; - -function TPartEnumerator.GetNext: boolean; -begin - if FPartIndex >= FEndPartIndex then exit(false); - if FJustCreated then - begin - FJustCreated := false; - result := (FSubPartIndex < FSubPartCount) and (FPartIndex < FEndPartIndex); - exit; - end; - if FSubPartIndex + 1 >= FSubPartCount then - begin - if FSubBrokenIndex + 1 >= FSubBrokenCount then - begin - if (FParagraphIndex + 1 >= FLayout.ParagraphCount) or - (FLayout.FParagraph[FParagraphIndex + 1].brokenLineCount = 0) then - exit(false) else - begin - inc(FPartIndex); - inc(FParagraphIndex); - FSubBrokenIndex:= 0; - FSubPartIndex:= 0; - Update; - end; - end else - begin - inc(FPartIndex); - inc(FSubBrokenIndex); - inc(FBrokenLineIndex); - FSubPartIndex:= 0; - with FLayout.FParagraph[FParagraphIndex] do - begin - FCurBroken := @brokenLines[FSubBrokenIndex]; - with FCurBroken^ do - begin - FSubPartCount:= partCount; - FPartIndex:= FSubPartIndex + firstPartIndex; - end; - end; - end; - end else - begin - inc(FPartIndex); - inc(FSubPartIndex); - end; - result := FPartIndex < FEndPartIndex; -end; - -{ TPartInfo } - -function TPartInfo.IsRightToLeft: boolean; -begin - result := odd(bidiLevel); -end; - -{ TBrokenLineInfo } - -function TBrokenLineInfo.IsRightToLeft: boolean; -begin - result := odd(bidiLevel); -end; - -{ TBidiLayoutTree } - -function TBidiLayoutTree.GetLayout: TBidiTextLayout; -begin - result := FLayout; -end; - -function TBidiLayoutTree.GetHeight: single; -begin - result := FSize.y; -end; - -function TBidiLayoutTree.GetCumulatedBidiPos: single; -begin - result := BidiPos; - if Assigned(Parent) then - IncF(result, TBidiLayoutTree(Parent).CumulatedBidiPos); -end; - -function TBidiLayoutTree.GetMaxWidth: single; -begin - result := FMaxWidth; -end; - -function TBidiLayoutTree.GetWidth: single; -begin - result := FSize.x; -end; - -procedure TBidiLayoutTree.UpdateBranchSize; -var - i: Integer; - last: TBidiLayoutTree; -begin - if not IsLeaf then - begin - //write('Update branch size from ', round(FSize.x)); - if Count = 0 then - begin - FSize := PointF(0,0) - end - else - begin - last := TBidiLayoutTree(Branch[Count-1]); - FSize.x := last.BidiPos + last.Width; - FSize.y := 0; - for i := 0 to Count-1 do - FSize.y := max(FSize.y, TBidiLayoutTree(Branch[i]).Height); - end; - //writeln(' to ', round(FSize.x), ' (',inttostr(Count),')'); - end; -end; - -constructor TBidiLayoutTree.Create(AData: pointer; AStartIndex, - AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); -begin - inherited Create(AData, AStartIndex, AEndIndex, ABidiLevel, AIsLeaf); - FLayout := TBidiLayoutTreeData(AData^).Layout; - FMaxWidth := TBidiLayoutTreeData(AData^).MaxWidth; - if IsLeaf then - begin - FTextUTF8:= Layout.GetSameLevelString(StartIndex,EndIndex, FNonDiscardedCount); - FSize := Layout.TextSizeBidiOverride(FTextUTF8, IsRightToLeft); - //writeln('Created leaf ', round(FSize.x), ' of level ',BidiLevel); - end - else - begin - //writeln('Created branch of level ',BidiLevel); - FTextUTF8:= ''; - FNonDiscardedCount:= 0; - FSize := PointF(0,0); - end; -end; - -procedure TBidiLayoutTree.AddBranch(ABranch: TBidiTree); -var - prev: TBidiLayoutTree; -begin - inherited AddBranch(ABranch); - if Count > 1 then - begin - prev := TBidiLayoutTree(Branch[Count-2]); - TBidiLayoutTree(ABranch).FBidiPos:= prev.BidiPos + prev.Width; - end; - if (TBidiLayoutTree(ABranch).Width <> 0) or - (TBidiLayoutTree(ABranch).Height <> 0) then - UpdateBranchSize; -end; - -procedure TBidiLayoutTree.Shorten(AEndIndex: integer); -begin - inherited Shorten(AEndIndex); - if IsLeaf then - begin - FTextUTF8:= Layout.GetSameLevelString(StartIndex,EndIndex, FNonDiscardedCount); - FSize := Layout.TextSizeBidiOverride(FTextUTF8, IsRightToLeft); - //writeln('Shortened leaf ', round(FSize.x)); - end else - UpdateBranchSize; -end; - -procedure TBidiLayoutTree.AfterFinish; -begin - if Assigned(Parent) then - TBidiLayoutTree(Parent).UpdateBranchSize; -end; - -function TBidiLayoutTree.TrySplit: boolean; -var - fitInfo, splitIndex: Integer; - a: TUnicodeAnalysis; - remain: Single; -begin - if not IsLeaf then exit(false); - if MaxWidth = EmptySingle then exit(false); - remain := MaxWidth - CumulatedBidiPos; - if Width > remain then - begin - fitInfo := Layout.TextFitInfoBidiOverride(FTextUTF8, remain, IsRightToLeft); - if fitInfo < FNonDiscardedCount then - begin - //writeln('Splitting leaf ',round(Width), ' (max ',round(remain),')'); - splitIndex:= StartIndex; - a:= Layout.FAnalysis; - while fitInfo > 0 do - begin - while (splitIndex < EndIndex) and a.BidiInfo[splitIndex].IsDiscardable do - Inc(splitIndex); - if splitIndex < EndIndex then inc(splitIndex); - dec(fitInfo); - end; - Shorten(splitIndex); - TBidiLayoutTree(Parent).UpdateBranchSize; - exit(true); - end; - end; - exit(false); -end; - -{ TBidiCaretPos } - -procedure TBidiCaretPos.Transform(AMatrix: TAffineMatrix); -begin - Top := AMatrix*Top; - Bottom := AMatrix*Bottom; - PreviousTop := AMatrix*PreviousTop; - PreviousBottom := AMatrix*PreviousBottom; -end; - -{ TBidiTextLayout } - -function TBidiTextLayout.GetBrokenLineAffineBox(AIndex: integer): TAffineBox; -begin - result := Matrix*TAffineBox.AffineBox(BrokenLineRectF[AIndex]); -end; - -function TBidiTextLayout.GetBrokenLineCount: integer; -begin - NeedLayout; - result := FComputedBrokenLineCount; -end; - -function TBidiTextLayout.GetBrokenLineEndCaret(AIndex: integer): TBidiCaretPos; -begin - result := GetBrokenLineUntransformedEndCaret(AIndex); - result.Transform(Matrix); -end; - -function TBidiTextLayout.GetBrokenLineEndPart(AIndex: integer): integer; -begin - with GetBrokenLineInfo(AIndex)^ do - result := firstPartIndex + partCount; -end; - -function TBidiTextLayout.GetBrokenLineStartPart(AIndex: integer): integer; -begin - result := GetBrokenLineInfo(AIndex)^.firstPartIndex; -end; - -function TBidiTextLayout.GetBrokenLineUntransformedEndCaret(AIndex: integer): TBidiCaretPos; -begin - with GetBrokenLineInfo(AIndex)^ do - begin - result.Top.y := rectF.Top; - if BrokenLineRightToLeft[AIndex] then - result.Top.x := rectF.Left - else - result.Top.x := rectF.Right; - result.Bottom.y := rectF.Bottom; - result.Bottom.x := result.Top.x; - result.RightToLeft := IsRightToLeft; - result.PartIndex:= -1; - result.PreviousTop := EmptyPointF; - result.PreviousBottom := EmptyPointF; - result.PreviousRightToLeft := result.RightToLeft; - end; -end; - -function TBidiTextLayout.GetBrokenLineEndIndex(AIndex: integer): integer; -begin - result := GetBrokenLineInfo(AIndex)^.endIndex; -end; - -function TBidiTextLayout.GetBrokenLineParagraphIndex(AIndex: integer): integer; -var - ub: Integer; -begin - ub := GetBrokenLineInfo(AIndex)^.unbrokenLineIndex; - result := FAnalysis.UnbrokenLineParagraphIndex[ub]; -end; - -function TBidiTextLayout.GetBrokenLineUnbrokenIndex(AIndex: integer): integer; -begin - result := GetBrokenLineInfo(AIndex)^.unbrokenLineIndex; -end; - -function TBidiTextLayout.GetBrokenLineInfo(AIndex: integer): PBrokenLineInfo; -var - minParaIndex, maxParaIndex, midParaIndex: integer; -begin - NeedLayout; - if (AIndex < 0) or (AIndex >= FComputedBrokenLineCount) then - raise ERangeError.Create('Invalid index'); - minParaIndex := 0; - maxParaIndex := ParagraphCount-1; - result := nil; - repeat - if minParaIndex > maxParaIndex then - InternalRangeError else - if minParaIndex = maxParaIndex then - begin - result := @FParagraph[minParaIndex].brokenLines - [AIndex - FParagraph[minParaIndex].firstBrokenLineIndex]; - exit; - end else - begin - midParaIndex := (minParaIndex + maxParaIndex + 1) shr 1; - if AIndex < FParagraph[midParaIndex].firstBrokenLineIndex then - maxParaIndex := midParaIndex-1 - else - minParaIndex := midParaIndex; - end; - until false; -end; - -function TBidiTextLayout.GetBrokenLineRectF(AIndex: integer): TRectF; -begin - result := GetBrokenLineInfo(AIndex)^.rectF; -end; - -function TBidiTextLayout.GetBrokenLineRightToLeft(AIndex: integer): boolean; -begin - result := GetBrokenLineInfo(AIndex)^.IsRightToLeft; -end; - -function TBidiTextLayout.GetBrokenLineStartCaret(AIndex: integer): TBidiCaretPos; -begin - result := GetBrokenLineUntransformedStartCaret(AIndex); - result.Transform(Matrix); -end; - -function TBidiTextLayout.GetBrokenLineUntransformedStartCaret(AIndex: integer): TBidiCaretPos; -begin - NeedLayout; - with GetBrokenLineInfo(AIndex)^ do - begin - result.Top.y := rectF.Top; - if BrokenLineRightToLeft[AIndex] then - result.Top.x := rectF.Right - else - result.Top.x := rectF.Left; - result.Bottom.y := rectF.Bottom; - result.Bottom.x := result.Top.x; - result.RightToLeft := IsRightToLeft; - result.PartIndex:= -1; - result.PreviousTop := EmptyPointF; - result.PreviousBottom := EmptyPointF; - result.PreviousRightToLeft := result.RightToLeft; - end; -end; - -function TBidiTextLayout.GetBrokenLineStartIndex(AIndex: integer): integer; -begin - result := GetBrokenLineInfo(AIndex)^.startIndex; -end; - -function TBidiTextLayout.GetBrokenLineUsedWidth(AIndex: integer): single; -begin - result := GetBrokenLineInfo(AIndex)^.usedWidth; -end; - -function TBidiTextLayout.GetCharCount: integer; -begin - result := FAnalysis.CharCount; -end; - -function TBidiTextLayout.GetFontBidiMode: TFontBidiMode; -begin - result := FAnalysis.BidiMode; -end; - -function TBidiTextLayout.GetLayoutComputed: boolean; -var - i: Integer; -begin - for i := 0 to ParagraphCount-1 do - if not FParagraph[i].layoutComputed then exit(false); - result := true; -end; - -function TBidiTextLayout.GetLineHeight: single; -begin - NeedLayout; - result := FLineHeight; -end; - -function TBidiTextLayout.GetMatrix: TAffineMatrix; -begin - NeedLayout; - result := FMatrix; -end; - -function TBidiTextLayout.GetMatrixInverse: TAffineMatrix; -begin - NeedLayout; - result := FMatrixInverse; -end; - -function TBidiTextLayout.GetParagraphAffineBox(AIndex: integer): TAffineBox; -begin - result := Matrix*TAffineBox.AffineBox(ParagraphRectF[AIndex]); -end; - -function TBidiTextLayout.GetParagraphAlignment(AIndex: integer): TBidiTextAlignment; -begin - //layout not needed - if (AIndex < 0) or (AIndex >= ParagraphCount) then - raise ERangeError.Create('Invalid index'); - result := FParagraph[AIndex].alignment; -end; - -function TBidiTextLayout.GetParagraphCount: integer; -begin - result := FAnalysis.ParagraphCount; -end; - -function TBidiTextLayout.GetParagraphEndBrokenLine(AIndex: integer): integer; -begin - if AIndex = ParagraphCount-1 then - result := BrokenLineCount - else - result := GetParagraphInfo(AIndex+1)^.firstBrokenLineIndex; -end; - -function TBidiTextLayout.GetParagraphEndIndex(AIndex: integer): integer; -begin - result := FAnalysis.ParagraphEndIndex[AIndex]; -end; - -function TBidiTextLayout.GetParagraphEndIndexBeforeParagraphSeparator(AIndex: integer): integer; -begin - result := FAnalysis.ParagraphEndIndexBeforeParagraphSeparator[AIndex]; -end; - -function TBidiTextLayout.GetParagraphEndPart(AIndex: integer): integer; -begin - if AIndex = ParagraphCount-1 then - result := PartCount - else - result := GetParagraphInfo(AIndex+1)^.firstPartIndex; -end; - -function TBidiTextLayout.GetParagraphInfo(AIndex: integer): PParagraphInfo; -begin - NeedLayout; - if (AIndex < 0) or (AIndex >= ParagraphCount) then - raise ERangeError.Create('Paragraph index out of bounds'); - result := @FParagraph[AIndex]; -end; - -function TBidiTextLayout.GetParagraphRectF(AIndex: integer): TRectF; -begin - result := GetParagraphInfo(AIndex)^.rectF; -end; - -function TBidiTextLayout.GetParagraphRightToLeft(AIndex: integer): boolean; -begin - result := FAnalysis.ParagraphRightToLeft[AIndex]; -end; - -function TBidiTextLayout.GetParagraphStartBrokenLine(AIndex: integer): integer; -begin - result := GetParagraphInfo(AIndex)^.firstBrokenLineIndex; -end; - -function TBidiTextLayout.GetParagraphStartIndex(AIndex: integer): integer; -begin - result := FAnalysis.ParagraphStartIndex[AIndex]; -end; - -function TBidiTextLayout.GetParagraphStartPart(AIndex: integer): integer; -begin - result := GetParagraphInfo(AIndex)^.firstPartIndex; -end; - -function TBidiTextLayout.GetPartAffineBox(AIndex: integer): TAffineBox; -begin - result := Matrix*TAffineBox.AffineBox(PartRectF[AIndex]); -end; - -function TBidiTextLayout.GetPartBrokenLineIndex(AIndex: integer): integer; -begin - result := GetPartInfo(AIndex)^.brokenLineIndex; -end; - -function TBidiTextLayout.GetPartCount: integer; -begin - NeedLayout; - result := FComputedPartCount; -end; - -function TBidiTextLayout.GetPartEnumerator(AFirstPart: integer): TPartEnumerator; -begin - result := GetPartEnumerator(AFirstPart, FComputedPartCount); -end; - -function TBidiTextLayout.GetPartEnumerator(AFirstPart, ALastPartPlus1: integer): TPartEnumerator; -var - minParaIndex,maxParaIndex,midParaIndex: integer; - minBrokenIndex, maxBrokenIndex, midBrokenIndex: Integer; -begin - if (AFirstPart < 0) or (AFirstPart > FComputedPartCount) or - (ALastPartPlus1 < 0) or (ALastPartPlus1 > FComputedPartCount) then - raise ERangeError.Create('Invalid start index'); - minParaIndex:= 0; - maxParaIndex:= ParagraphCount - 1; - repeat - if minParaIndex > maxParaIndex then - InternalRangeError else - if minParaIndex = maxParaIndex then - with FParagraph[minParaIndex] do - begin - if brokenLineCount = 0 then - begin - result := TPartEnumerator.New(self, minParaIndex, 0, 0, ALastPartPlus1); - exit; - end; - minBrokenIndex := 0; - maxBrokenIndex := brokenLineCount-1; - repeat - if minBrokenIndex > maxBrokenIndex then - InternalRangeError else - if minBrokenIndex = maxBrokenIndex then - begin - result := TPartEnumerator.New(self, minParaIndex, minBrokenIndex, - AFirstPart - brokenLines[minBrokenIndex].firstPartIndex, - ALastPartPlus1); - exit; - end else - begin - midBrokenIndex := (minBrokenIndex + maxBrokenIndex + 1) shr 1; - if AFirstPart < brokenLines[midBrokenIndex].firstPartIndex then - maxBrokenIndex := midBrokenIndex-1 - else - minBrokenIndex := midBrokenIndex; - end; - until false; - end else - begin - midParaIndex := (minParaIndex + maxParaIndex + 1) shr 1; - if AFirstPart < FParagraph[midParaIndex].firstPartIndex then - maxParaIndex := midParaIndex-1 - else - minParaIndex := midParaIndex; - end; - until false; -end; - - -function TBidiTextLayout.GetPartInfo(AIndex: integer): PPartInfo; -var - partEnum: TPartEnumerator; -begin - partEnum := GetPartEnumerator(AIndex); - if not partEnum.GetNext then raise ERangeError.Create('Invalid index'); - result := partEnum.PartInfo; -end; - -function TBidiTextLayout.GetPartEndIndex(AIndex: integer): integer; -begin - result := GetPartInfo(AIndex)^.endIndex; -end; - -function TBidiTextLayout.GetPartRectF(AIndex: integer): TRectF; -begin - result := GetPartInfo(AIndex)^.rectF; -end; - -function TBidiTextLayout.GetPartRightToLeft(AIndex: integer): boolean; -begin - result := GetPartInfo(AIndex)^.IsRightToLeft; -end; - -function TBidiTextLayout.GetPartStartIndex(AIndex: integer): integer; -begin - result := GetPartInfo(AIndex)^.startIndex; -end; - -function TBidiTextLayout.GetText: string; -begin - result := FAnalysis.TextUTF8; -end; - -function TBidiTextLayout.GetTotalTextHeight: single; -begin - NeedLayout; - result := FParagraph[ParagraphCount-1].rectF.Bottom - FParagraph[0].rectF.Top; -end; - -function TBidiTextLayout.GetUnicodeChar(APosition0: integer): LongWord; -begin - result := FAnalysis.UnicodeChar[APosition0]; -end; - -function TBidiTextLayout.GetUsedWidth: single; -var - i: Integer; -begin - result := 0; - for i := 0 to BrokenLineCount-1 do - result := max(result, BrokenLineUsedWidth[i]); -end; - -function TBidiTextLayout.GetUTF8Char(APosition0: integer): string4; -begin - result := FAnalysis.UTF8Char[APosition0]; -end; - -procedure TBidiTextLayout.SetAvailableHeight(AValue: single); -var - i: Integer; -begin - if FAvailableHeight=AValue then Exit; - FAvailableHeight:=AValue; - for i := 0 to ParagraphCount-1 do - TrimParagraphLayoutVertically(i); -end; - -procedure TBidiTextLayout.SetAvailableWidth(AValue: single); -begin - if FAvailableWidth=AValue then Exit; - FAvailableWidth:=AValue; - InvalidateLayout; -end; - -procedure TBidiTextLayout.SetFontBidiMode(AValue: TFontBidiMode); -begin - FAnalysis.BidiMode := AValue; -end; - -procedure TBidiTextLayout.SetFontRenderer(AValue: TBGRACustomFontRenderer); -begin - if FRenderer=AValue then Exit; - FRenderer:=AValue; - InvalidateLayout; -end; - -procedure TBidiTextLayout.SetParagraphAlignment(AIndex: integer; - AValue: TBidiTextAlignment); -var - brokenCount: Integer; -begin - if (AIndex < 0) or (AIndex >= ParagraphCount) then - raise ERangeError.Create('Paragraph index out of bounds'); - FParagraph[AIndex].alignment := AValue; - InvalidateParagraphLayout(AIndex); - if Assigned(FOnBrokenLinesChanged) then - begin - brokenCount := FParagraph[AIndex].brokenLineCount; - FOnBrokenLinesChanged(self, AIndex, 0, brokenCount, brokenCount, - brokenCount, brokenCount); - end; -end; - -procedure TBidiTextLayout.SetParagraphSpacingAbove(AValue: single); -begin - if FParagraphSpacingAbove=AValue then Exit; - FParagraphSpacingAbove:=AValue; - InvalidateLayout; -end; - -procedure TBidiTextLayout.SetParagraphSpacingBelow(AValue: single); -begin - if FParagraphSpacingBelow=AValue then Exit; - FParagraphSpacingBelow:=AValue; - InvalidateLayout; -end; - -procedure TBidiTextLayout.SetTabSize(AValue: single); -begin - if FTabSize=AValue then Exit; - FTabSize:=AValue; - InvalidateLayout; -end; - -procedure TBidiTextLayout.SetTopLeft(AValue: TPointF); -begin - if FTopLeft=AValue then Exit; - FTopLeft:=AValue; - if LayoutComputed then ComputeMatrix; -end; - -procedure TBidiTextLayout.ComputeMatrix; -begin - FMatrix := AffineMatrixTranslation(FTopLeft.x, FTopLeft.y)*AffineMatrixRotationDeg(-GetFontOrientation); - FMatrixInverse := AffineMatrixInverse(FMatrix); -end; - -procedure TBidiTextLayout.BidiModeChanged(ASender: TObject); -begin - InvalidateLayout; -end; - -procedure TBidiTextLayout.CharDeleted(ASender: TObject; - AParagraphIndex: integer; ACharStart, ACharCount: integer); -var - i, charEnd, j, partIndex: Integer; - curPart: PPartInfo; -begin - InvalidateParagraphLayout(AParagraphIndex); - charEnd := ACharStart + ACharCount; - with FParagraph[AParagraphIndex] do - begin - for j := 0 to brokenLineCount-1 do - with brokenLines[j] do - begin - // is broken line affected ? - if (startIndex < charEnd) and (endIndex > ACharStart) then - begin - for partIndex := 0 to partCount-1 do - begin - curPart := @parts[partIndex]; - // is part affected ? - if (curPart^.startIndex < charEnd) - or (curPart^.endIndex > ACharStart) then - begin - curPart^.modified := true; - // is part completely deleted ? - if (curPart^.startIndex >= ACharStart) and - (curPart^.endIndex <= charEnd) then - begin - curPart^.startIndex := ACharStart; - curPart^.endIndex := ACharStart; - end else - begin - // part partially deleted - if curPart^.startIndex < ACharStart then - curPart^.endIndex := ACharStart - else if curPart^.endIndex > charEnd then - begin - curPart^.startIndex := charEnd - ACharCount; - dec(curPart^.endIndex, ACharCount); - end; - end; - end else - if curPart^.startIndex >= charEnd then // part located after deletion - begin - dec(curPart^.startIndex, ACharCount); - dec(curPart^.endIndex, ACharCount); - end; - end; - dec(endIndex, ACharCount); - end else - if startIndex >= charEnd then // broken line located after deletion - begin - dec(startIndex, ACharCount); - dec(endIndex, ACharCount); - for partIndex := 0 to partCount-1 do - begin - curPart := @parts[partIndex]; - dec(curPart^.startIndex, ACharCount); - dec(curPart^.endIndex, ACharCount); - end; - end; - end; - end; - for i := AParagraphIndex + 1 to high(FParagraph) do - OffsetParagraphCharIndex(i, -ACharCount); -end; - -function TBidiTextLayout.TextSizeBidiOverride(sUTF8: string; - ARightToLeft: boolean): TPointF; -begin - AddOverrideIfNecessary(sUTF8, ARightToLeft); - result := FRenderer.TextSizeAngleF(sUTF8, FRenderer.FontOrientation); -end; - -procedure TBidiTextLayout.ParagraphSplit(ASender: TObject; - AParagraphIndex: integer; ACharIndex: integer); -var - i, j, subBrokenIndex, brokenMoveCount: Integer; - curPara, nextPara: PParagraphInfo; -begin - if (AParagraphIndex < 0) or (AParagraphIndex > high(FParagraph)) then - raise exception.Create('Paragrah index out of bounds (0 <= '+inttostr(AParagraphIndex)+' <= '+inttostr(high(FParagraph))+')'); - - setlength(FParagraph, length(FParagraph)+1); - for i := high(FParagraph) downto AParagraphIndex+2 do - FParagraph[i] := FParagraph[i-1]; - - curPara := @FParagraph[AParagraphIndex]; - nextPara := @FParagraph[AParagraphIndex+1]; - - subBrokenIndex := curPara^.brokenLineCount; - for j := 0 to curPara^.brokenLineCount-1 do - if (curPara^.brokenLines[j].startIndex <= ACharIndex) and - (curPara^.brokenLines[j].endIndex > ACharIndex) then - begin - subBrokenIndex := j; - break; - end else - if (curPara^.brokenLines[j].startIndex > ACharIndex) then - begin - subBrokenIndex := max(j-1, 0); - break; - end; - brokenMoveCount := curPara^.brokenLineCount - (subBrokenIndex + 1); - if brokenMoveCount < 0 then brokenMoveCount := 0; - - nextPara^.alignment := curPara^.alignment; - nextPara^.layoutComputed := false; - nextPara^.overflow := curPara^.overflow; - nextPara^.rectF := EmptyRectF; - nextPara^.firstBrokenLineIndex:= curPara^.firstBrokenLineIndex + curPara^.brokenLineCount - brokenMoveCount; - if brokenMoveCount > 0 then - nextPara^.firstPartIndex := curPara^.brokenLines[curPara^.brokenLineCount - brokenMoveCount].firstPartIndex - else - begin - if curPara^.brokenLineCount > 0 then - with curPara^.brokenLines[curPara^.brokenLineCount - 1] do - nextPara^.firstPartIndex := firstPartIndex + partCount - else nextPara^.firstPartIndex := curPara^.firstPartIndex; - end; - nextPara^.brokenLineCount:= brokenMoveCount; - setlength(nextPara^.brokenLines, brokenMoveCount); - for j := 0 to brokenMoveCount - 1 do - nextPara^.brokenLines[j] := curPara^.brokenLines[curPara^.brokenLineCount - brokenMoveCount + j]; - dec(curPara^.brokenLineCount, brokenMoveCount); - InternalInvalidateParagraphLayout(AParagraphIndex); - InternalInvalidateParagraphLayout(AParagraphIndex+1); - if Assigned(FOnParagraphSplit) then - FOnParagraphSplit(self, AParagraphIndex, subBrokenIndex, ACharIndex); -end; - -procedure TBidiTextLayout.InternalParagraphDeleted(AParagraphIndex: integer); -var - i, deltaBroken, deltaPart: Integer; - deltaY: Single; -begin - if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then exit; - deltaY := -FParagraph[AParagraphIndex].rectF.Height; - deltaBroken := -FParagraph[AParagraphIndex].brokenLineCount; - deltaPart := 0; - for i := 0 to FParagraph[AParagraphIndex].brokenLineCount-1 do - dec(deltaPart, FParagraph[AParagraphIndex].brokenLines[i].partCount); - - for i := AParagraphIndex to high(FParagraph)-1 do - begin - FParagraph[i] := FParagraph[i+1]; - OffsetParagraph(i, deltaY, deltaBroken, deltaPart); - end; - setlength(FParagraph, length(FParagraph)-1); - inc(FComputedBrokenLineCount, deltaBroken); - inc(FComputedPartCount, deltaPart); -end; - -procedure TBidiTextLayout.CharInserted(ASender: TObject; - AParagraphIndex: integer; ACharStart, ACharCount: integer); -var - i, j, partIndex: Integer; -begin - InvalidateParagraphLayout(AParagraphIndex); - with FParagraph[AParagraphIndex] do - begin - for j := 0 to brokenLineCount-1 do - with brokenLines[j] do - begin - // is broken line affected - if (ACharStart >= startIndex) and (ACharStart < endIndex) then - begin - for partIndex := 0 to partCount-1 do - with parts[partIndex] do - begin - // is part affected - if (ACharStart > startIndex) and (ACharStart < endIndex) then - begin - modified := true; - inc(endIndex, ACharCount); - end else - if (ACharStart <= startIndex) then // part located after insertion - begin - inc(startIndex, ACharCount); - inc(endIndex, ACharCount); - end; - end; - inc(endIndex, ACharCount); - end else - if (ACharStart <= StartIndex) then // broken line located after insertion - begin - inc(startIndex, ACharCount); - inc(endIndex, ACharCount); - for partIndex := 0 to partCount-1 do - with parts[partIndex] do - begin - inc(startIndex, ACharCount); - inc(endIndex, ACharCount); - end; - end; - end; - end; - for i := AParagraphIndex + 1 to high(FParagraph) do - OffsetParagraphCharIndex(i, ACharCount); -end; - -procedure TBidiTextLayout.AnalysisChanged(ASender: TObject; - AParagraphIndex: integer; ACharStart, ACharCount: integer); -begin - InvalidateParagraphLayout(AParagraphIndex); -end; - -procedure TBidiTextLayout.ParagraphMergedWithNext(ASender: TObject; - AParagraphIndex: integer); -var - i, mergedBrokenLineCount, prevBrokenLineCount: Integer; - curPara: PParagraphInfo; -begin - if (AParagraphIndex < 0) or (AParagraphIndex >= high(FParagraph)) then - InternalRangeError; - curPara := @FParagraph[AParagraphIndex]; - prevBrokenLineCount := curPara^.brokenLineCount; - mergedBrokenLineCount := prevBrokenLineCount + FParagraph[AParagraphIndex+1].brokenLineCount; - if length(curPara^.brokenLines) < mergedBrokenLineCount then - setlength(curPara^.brokenLines, mergedBrokenLineCount); - for i := 0 to FParagraph[AParagraphIndex+1].brokenLineCount-1 do - curPara^.brokenLines[prevBrokenLineCount + i] := - FParagraph[AParagraphIndex+1].brokenLines[i]; - curPara^.brokenLineCount := mergedBrokenLineCount; - curPara^.rectF.Bottom:= FParagraph[AParagraphIndex+1].rectF.Bottom; - curPara^.overflow := curPara^.overflow or FParagraph[AParagraphIndex+1].overflow; - for i := AParagraphIndex + 1 to high(FParagraph)-1 do - FParagraph[i] := FParagraph[i+1]; - setlength(FParagraph, length(FParagraph) - 1); - InternalInvalidateParagraphLayout(AParagraphIndex); - if Assigned(FOnParagraphMergedWithNext) then - FOnParagraphMergedWithNext(self, AParagraphIndex); -end; - -procedure TBidiTextLayout.ParagraphDeleted(ASender: TObject; - AParagraphIndex: integer); -begin - InternalParagraphDeleted(AParagraphIndex); - If Assigned(FOnParagraphDeleted) then - FOnParagraphDeleted(self, AParagraphIndex); -end; - -function TBidiTextLayout.TextSizeBidiOverrideSplit(AStartIndex, AEndIndex: integer; - ARightToLeft: boolean; ASplitIndex: integer): TPointF; -var checkIndex: integer; - s: String; -begin - if ASplitIndex <= AStartIndex then - begin - s := FAnalysis.CopyTextUTF8(AStartIndex, AEndIndex-AStartIndex); - result := TextSizeBidiOverride(s, ARightToLeft); - result.x := 0; - exit; - end; - - s := FAnalysis.CopyTextUTF8(AStartIndex, ASplitIndex-AStartIndex); - checkIndex := ASplitIndex-1; - while (checkIndex > AStartIndex) and - FAnalysis.BidiInfo[checkIndex].IsLigatureTransparent do dec(checkIndex); - if (ARightToLeft and FAnalysis.BidiInfo[checkIndex].HasLigatureLeft) or - (not ARightToLeft and FAnalysis.BidiInfo[checkIndex].HasLigatureRight) then - s := s+UnicodeCharToUTF8(UNICODE_ZERO_WIDTH_JOINER); - result := TextSizeBidiOverride(s, ARightToLeft); -end; - -function TBidiTextLayout.TextFitInfoBidiOverride(sUTF8: string; AWidth: single; - ARightToLeft: boolean): integer; -var - over: Boolean; - i: Integer; - p, pStart, pEnd: PChar; - u: LongWord; -begin - if sUTF8 = '' then exit(0); - over := AddOverrideIfNecessary(sUTF8, ARightToLeft); - - result := FRenderer.TextFitInfoF(sUTF8, AWidth); - if over then dec(result); - - //check that position is not a combining mark - pEnd := @sUTF8[length(sUTF8)]; - pStart := @sUTF8[1]; - if over then inc(pStart, UTF8CharacterLength(pStart)); - p := @sUTF8[1]; - for i := 1 to result do - begin - inc(p, UTF8CharacterLength(p)); - if p > pEnd then break; - end; - if p <= pEnd then - begin - while (result > 0) and (p > pStart) do - begin - u := UTF8CodepointToUnicode(p, UTF8CharacterLength(p)); - if GetUnicodeBidiClassEx(u) = ubcCombiningLeftToRight then - begin - dec(p); - while (p >= pStart) and (p^ in[#$80..#$BF]) do dec(p); - dec(result); - end else - break; - end; - end; -end; - -function TBidiTextLayout.GetFontFullHeight: single; -begin - result := FRenderer.TextSizeAngleF('Hg', FRenderer.FontOrientation).y; -end; - -function TBidiTextLayout.GetFontBaseline: single; -begin - result := FRenderer.GetFontPixelMetric.Baseline; -end; - -function TBidiTextLayout.GetFontOrientation: single; -begin - result := FRenderer.FontOrientation*0.1; -end; - -procedure TBidiTextLayout.TextOutBidiOverride(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; ARightToLeft: boolean); -begin - if sUTF8 = #9 then exit; - AddOverrideIfNecessary(sUTF8, ARightToLeft); - - if FTexture <> nil then - FRenderer.TextOut(ADest, x,y, sUTF8, FTexture, taLeftJustify, ARightToLeft) - else - FRenderer.TextOut(ADest, x,y, sUTF8, FColor, taLeftJustify, ARightToLeft); -end; - -procedure TBidiTextLayout.TextPathBidiOverride(ADest: IBGRAPath; x, - y: single; sUTF8: string; ARightToLeft: boolean); -begin - if sUTF8 = #9 then exit; - AddOverrideIfNecessary(sUTF8, ARightToLeft); - - FRenderer.CopyTextPathTo(ADest, x,y, sUTF8, taLeftJustify, ARightToLeft) -end; - -function TBidiTextLayout.AddOverrideIfNecessary(var sUTF8: string; - ARightToLeft: boolean): boolean; -var - p: PChar; - pEnd: Pointer; - add, hasStrong: boolean; - charLen: Integer; - u: LongWord; - curBidi: TUnicodeBidiClass; - isSpacing: boolean; -begin - if sUTF8 = '' then exit(false); - isSpacing:= true; - p := @sUTF8[1]; - pEnd := p + length(sUTF8); - add := false; - hasStrong := false; - while p < pEnd do - begin - charLen := UTF8CharacterLength(p); - if (charLen = 0) or (p+charLen > pEnd) then break; - u := UTF8CodepointToUnicode(p, charLen); - curBidi := GetUnicodeBidiClass(u); - if curBidi <> ubcWhiteSpace then isSpacing:= false; - if curBidi in[ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then - hasStrong := true; - if (curBidi = ubcLeftToRight) and ARightToLeft then - begin - add := true; - break; - end else - if (curBidi in[ubcRightToLeft,ubcArabicLetter]) and not ARightToLeft then - begin - add := true; - break; - end; - inc(p,charLen); - end; - if not hasStrong and ARightToLeft and not isSpacing then add := true; - if add then - begin - if ARightToLeft then - sUTF8 := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_OVERRIDE)+ sUTF8 - else - sUTF8 := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_OVERRIDE)+ sUTF8; - exit(true); - end - else exit(false); -end; - -function TBidiTextLayout.GetTextPart(APartIndex: integer; - AAddOverrideIfNecessary: boolean): string; -begin - result := FAnalysis.CopyTextUTF8(PartStartIndex[APartIndex], - PartEndIndex[APartIndex] - PartStartIndex[APartIndex]); - if AAddOverrideIfNecessary then - AddOverrideIfNecessary(result, PartRightToLeft[APartIndex]); -end; - -procedure TBidiTextLayout.AddPart(AStartIndex, AEndIndex: integer; - ABidiLevel: byte; ARectF: TRectF; APosCorrection: TPointF; - ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); -begin - if ABrokenLine^.partCount >= length(ABrokenLine^.parts) then - setlength(ABrokenLine^.parts, length(ABrokenLine^.parts)*2+8); - - with ABrokenLine^.parts[ABrokenLine^.partCount] do - begin - startIndex:= AStartIndex; - endIndex:= AEndIndex; - bidiLevel := ABidiLevel; - rectF := ARectF; - posCorrection := APosCorrection; - brokenLineIndex:= ABrokenLineIndex; - modified := false; - end; - inc(ABrokenLine^.partCount) -end; - -function TBidiTextLayout.GetSameLevelString(startIndex, endIndex: integer): string; -var - nonDiscardedCount: integer; -begin - result := GetSameLevelString(startIndex,endIndex,nonDiscardedCount); -end; - -function TBidiTextLayout.GetSameLevelString(startIndex, endIndex: integer; out nonDiscardedCount: integer): string; -begin - result := FAnalysis.CopyTextUTF8DiscardChars(startIndex, endIndex, nonDiscardedCount); -end; - -function TBidiTextLayout.ComputeBidiTree(AMaxWidth: single; startIndex, - endIndex: integer; bidiLevel: byte): TBidiTree; -var - data: TBidiLayoutTreeData; -begin - data.MaxWidth := AMaxWidth; - data.Layout := self; - result := FAnalysis.CreateBidiTree(TBidiLayoutTree, @data, startIndex, endIndex, bidiLevel); -end; - -constructor TBidiTextLayout.Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string); -begin - Init(sUTF8, fbmAuto); - FRenderer := AFontRenderer; -end; - -constructor TBidiTextLayout.Create(AFontRenderer: TBGRACustomFontRenderer; sUTF8: string; ARightToLeft: boolean); -begin - if ARightToLeft then - Init(sUTF8, fbmRightToLeft) - else - Init(sUTF8, fbmLeftToRight); - FRenderer := AFontRenderer; -end; - -constructor TBidiTextLayout.Create(AFontRenderer: TBGRACustomFontRenderer; - sUTF8: string; AFontBidiMode: TFontBidiMode); -begin - Init(sUTF8, AFontBidiMode); - FRenderer := AFontRenderer; -end; - -destructor TBidiTextLayout.Destroy; -begin - FAnalysis.Free; - inherited Destroy; -end; - -procedure TBidiTextLayout.SetLayout(ARect: TRectF); -begin - TopLeft := ARect.TopLeft; - AvailableWidth:= ARect.Width; - AvailableHeight:= ARect.Height; -end; - -procedure TBidiTextLayout.InvalidateLayout; -var - i: Integer; -begin - for i := 0 to ParagraphCount-1 do - InvalidateParagraphLayout(i); -end; - -procedure TBidiTextLayout.ComputeLayoutIfNeeded; -begin - if not LayoutComputed then ComputeLayout; -end; - -procedure TBidiTextLayout.InvalidateParagraphLayout(AParagraphIndex: integer); -begin - InternalInvalidateParagraphLayout(AParagraphIndex); - if Assigned(FOnParagraphChanged) then - FOnParagraphChanged(self, AParagraphIndex); -end; - -procedure TBidiTextLayout.InternalInvalidateParagraphLayout( - AParagraphIndex: integer); -begin - if (AParagraphIndex >= 0) and (AParagraphIndex <= high(FParagraph)) then - FParagraph[AParagraphIndex].layoutComputed := false; -end; - -procedure TBidiTextLayout.OffsetParagraph(AParagraphIndex: integer; - ADeltaY: single; ADeltaBroken, ADeltaPart: integer); -var subBrokenIndex: integer; - curBroken: PBrokenLineInfo; - partIndex: integer; -begin - if (ADeltaY = 0) and (ADeltaBroken = 0) and (ADeltaPart = 0) then exit; - with FParagraph[AParagraphIndex] do - begin - rectF.Offset(0, ADeltaY); - inc(firstBrokenLineIndex, ADeltaBroken); - inc(firstPartIndex, ADeltaPart); - for subBrokenIndex := 0 to brokenLineCount-1 do - begin - curBroken := @brokenLines[subBrokenIndex]; - curBroken^.rectF.Offset(0, ADeltaY); - inc(curBroken^.firstPartIndex, ADeltaPart); - for partIndex := 0 to curBroken^.partCount-1 do - with curBroken^.parts[partIndex] do - begin - inc(brokenLineIndex, ADeltaBroken); - rectF.Offset(0, ADeltaY); - end; - end; - if ADeltaY <> 0 then - TrimParagraphLayoutVertically(AParagraphIndex); - end; -end; - -procedure TBidiTextLayout.OffsetParagraphCharIndex(AParagraphIndex: integer; - ADeltaChar: integer); -var - j, k: Integer; -begin - with FParagraph[AParagraphIndex] do - begin - for j := 0 to brokenLineCount-1 do - with brokenLines[j] do - begin - inc(startIndex, ADeltaChar); - inc(endIndex, ADeltaChar); - for k := 0 to partCount-1 do - begin - inc(parts[k].startIndex, ADeltaChar); - inc(parts[k].endIndex, ADeltaChar); - end; - end; - end; -end; - -procedure TBidiTextLayout.TrimParagraphLayoutVertically(AParagraphIndex: integer); -var - subBrokenIndex, nextDeltaBroken, nextDeltaPart, i: Integer; -begin - if (AvailableHeight = EmptySingle) or (AParagraphIndex < 0) or - (AParagraphIndex > high(FParagraph)) then exit; - with FParagraph[AParagraphIndex] do - begin - if not layoutComputed then exit; - if overflow and (rectF.Bottom < AvailableHeight) then - begin - layoutComputed:= false; - if Assigned(FOnParagraphVerticalTrimChanged) then - FOnParagraphVerticalTrimChanged(self, AParagraphIndex); - end else - if (rectF.Bottom > AvailableHeight) then - begin - for subBrokenIndex := 0 to brokenLineCount-1 do - begin - //there must be at least one broken line in the text - if (AParagraphIndex = 0) and (subBrokenIndex = 0) then continue; - if brokenLines[subBrokenIndex].rectF.Top >= AvailableHeight then - begin - nextDeltaBroken := 0; - nextDeltaPart := 0; - for i := subBrokenIndex to brokenLineCount-1 do - begin - dec(nextDeltaBroken); - dec(nextDeltaPart, brokenLines[i].partCount); - end; - brokenLineCount := subBrokenIndex; - for i := AParagraphIndex+1 to ParagraphCount-1 do - OffsetParagraph(i, 0, nextDeltaBroken, nextDeltaPart); - inc(FComputedPartCount, nextDeltaPart); - inc(FComputedBrokenLineCount, nextDeltaBroken); - overflow := true; - if subBrokenIndex > 0 then - rectF.Bottom := brokenLines[subBrokenIndex-1].rectF.Bottom + ParagraphSpacingBelow*FLineHeight - else rectF.Bottom := rectF.Top + ParagraphSpacingAbove*FLineHeight; - if Assigned(FOnParagraphVerticalTrimChanged) then - FOnParagraphVerticalTrimChanged(self, AParagraphIndex); - break; - end; - end; - end; - end; -end; - -procedure TBidiTextLayout.DrawText(ADest: TBGRACustomBitmap); -begin - DrawText(ADest, BGRABlack); -end; - -procedure TBidiTextLayout.DrawText(ADest: TBGRACustomBitmap; AColor: TBGRAPixel); -begin - FColor := AColor; - InternalDrawText(ADest); -end; - -procedure TBidiTextLayout.DrawText(ADest: TBGRACustomBitmap; - ATexture: IBGRAScanner); -begin - FColor := BGRAWhite; - FTexture := ATexture; - InternalDrawText(ADest); - FTexture := nil; -end; - -procedure TBidiTextLayout.PathText(ADest: IBGRAPath); -begin - InternalPathText(ADest); -end; - -procedure TBidiTextLayout.PathText(ADest: IBGRAPath; AClipRect: TRect); -begin - InternalPathText(ADest, AClipRect); -end; - -procedure TBidiTextLayout.DrawTextParts(ADest: TBGRACustomBitmap; AFirstPart, - ALastPartPlus1: integer); -begin - DrawTextParts(ADest, BGRABlack, AFirstPart, ALastPartPlus1); -end; - -procedure TBidiTextLayout.DrawTextParts(ADest: TBGRACustomBitmap; - AColor: TBGRAPixel; AFirstPart, ALastPartPlus1: integer); -begin - FColor := AColor; - InternalDrawTextParts(ADest, AFirstPart, ALastPartPlus1); -end; - -procedure TBidiTextLayout.DrawTextParts(ADest: TBGRACustomBitmap; - ATexture: IBGRAScanner; AFirstPart, ALastPartPlus1: integer); -begin - FColor := BGRAWhite; - FTexture := ATexture; - InternalDrawTextParts(ADest, AFirstPart, ALastPartPlus1); - FTexture := nil; -end; - -procedure TBidiTextLayout.PathTextParts(ADest: IBGRAPath; AFirstPart, - ALastPartPlus1: integer); -begin - InternalPathTextParts(ADest, AFirstPart, ALastPartPlus1); -end; - -procedure TBidiTextLayout.PathTextParts(ADest: IBGRAPath; AClipRect: TRect; - AFirstPart, ALastPartPlus1: integer); -begin - InternalPathTextParts(ADest, AClipRect, AFirstPart, ALastPartPlus1); -end; - -procedure TBidiTextLayout.DrawParagraphs(ADest: TBGRACustomBitmap; - AFirstPara, ALastParaPlus1: integer); -begin - if ALastParaPlus1 <= AFirstPara then exit; - DrawTextParts(ADest, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); -end; - -procedure TBidiTextLayout.DrawParagraphs(ADest: TBGRACustomBitmap; - AColor: TBGRAPixel; AFirstPara, ALastParaPlus1: integer); -begin - if ALastParaPlus1 <= AFirstPara then exit; - DrawTextParts(ADest, AColor, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); -end; - -procedure TBidiTextLayout.DrawParagraphs(ADest: TBGRACustomBitmap; - ATexture: IBGRAScanner; AFirstPara, ALastParaPlus1: integer); -begin - if ALastParaPlus1 <= AFirstPara then exit; - DrawTextParts(ADest, ATexture, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); -end; - -procedure TBidiTextLayout.PathParagraphs(ADest: IBGRAPath; AFirstPara, - ALastParaPlus1: integer); -begin - if ALastParaPlus1 <= AFirstPara then exit; - PathTextParts(ADest, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); -end; - -procedure TBidiTextLayout.PathParagraphs(ADest: IBGRAPath; AClipRect: TRect; - AFirstPara, ALastParaPlus1: integer); -begin - if ALastParaPlus1 <= AFirstPara then exit; - PathTextParts(ADest, AClipRect, ParagraphStartPart[AFirstPara], ParagraphEndPart[ALastParaPlus1-1]); -end; - -procedure TBidiTextLayout.DrawBrokenLines(ADest: TBGRACustomBitmap; - AFirstBroken, ALastBrokenPlus1: integer); -begin - if ALastBrokenPlus1 <= AFirstBroken then exit; - DrawTextParts(ADest, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); -end; - -procedure TBidiTextLayout.DrawBrokenLines(ADest: TBGRACustomBitmap; - AColor: TBGRAPixel; AFirstBroken, ALastBrokenPlus1: integer); -begin - if ALastBrokenPlus1 <= AFirstBroken then exit; - DrawTextParts(ADest, AColor, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); - -end; - -procedure TBidiTextLayout.DrawBrokenLines(ADest: TBGRACustomBitmap; - ATexture: IBGRAScanner; AFirstBroken, ALastBrokenPlus1: integer); -begin - if ALastBrokenPlus1 <= AFirstBroken then exit; - DrawTextParts(ADest, ATexture, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); -end; - -procedure TBidiTextLayout.PathBrokenLines(ADest: IBGRAPath; AFirstBroken, - ALastBrokenPlus1: integer); -begin - if ALastBrokenPlus1 <= AFirstBroken then exit; - PathTextParts(ADest, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); -end; - -procedure TBidiTextLayout.PathBrokenLines(ADest: IBGRAPath; AClipRect: TRect; - AFirstBroken, ALastBrokenPlus1: integer); -begin - if ALastBrokenPlus1 <= AFirstBroken then exit; - PathTextParts(ADest, AClipRect, BrokenLineStartPart[AFirstBroken], BrokenLineEndPart[ALastBrokenPlus1-1]); -end; - -procedure TBidiTextLayout.ComputeLayout; -var curLineHeight, baseLine, tabPixelSize: single; - paraIndex, ubIndex, i,j, nextTabIndex, splitIndex: Integer; - curPara: PParagraphInfo; - brokenIndex, partIndex: integer; - curBroken: PBrokenLineInfo; - lineStart, subStart, lineEnd: integer; - paraSpacingAbove, paraSpacingBelow, correctedBaseLine: single; - paraRTL, needNewLine: boolean; - partStr, remainStr: string; - pos: TPointF; - curBidiPos,endBidiPos,nextTabBidiPos, availWidth0, remainWidth: single; - tabSectionStart, tabSectionCount: integer; - tabSection: array of record - startIndex, endIndex: integer; - bidiPos: single; - tree: TBidiLayoutTree; - end; - alignment: TAlignment; - paraBidiLevel: Byte; - r: TRectF; - u: LongWord; - nextTree: TBidiLayoutTree; - oldBrokenLines: array of TBrokenLineInfo; - oldBrokenLineCount: integer; - - procedure AddTabSection(startIndex,endIndex: integer; tree: TBidiLayoutTree); - begin - if tabSectionCount >= length(tabSection) then setlength(tabSection, length(tabSection)*2+4); - tabSection[tabSectionCount].startIndex:= startIndex; - tabSection[tabSectionCount].endIndex:= endIndex; - tabSection[tabSectionCount].bidiPos:= curBidiPos; - tabSection[tabSectionCount].tree := tree; - inc(tabSectionCount); - end; - - procedure StartBrokenLine(ACharStart: integer; ACharEnd: integer; ABidiLevel: byte; AWidth, AHeight: single); - begin - if curPara^.brokenLineCount >= length(curPara^.brokenLines) then - setlength(curPara^.brokenLines, length(curPara^.brokenLines)*2+4); - - curBroken := @curPara^.brokenLines[curPara^.brokenLineCount]; - curBroken^.unbrokenLineIndex := ubIndex; - curBroken^.startIndex:= ACharStart; - curBroken^.endIndex:= ACharEnd; - curBroken^.bidiLevel := ABidiLevel; - curBroken^.firstPartIndex:= partIndex+1; - curBroken^.usedWidth:= AWidth; - - if FAvailableWidth <> EmptySingle then - curBroken^.rectF := RectF(0,pos.y,FAvailableWidth,pos.y+AHeight) - else - begin - case alignment of - taRightJustify: curBroken^.rectF := RectF(-AWidth,pos.y,0,pos.y+AHeight); - taCenter: curBroken^.rectF := RectF(-AWidth*0.5,pos.y,AWidth*0.5,pos.y+AHeight); - else {taLeftJustify} - curBroken^.rectF := RectF(0,pos.y,AWidth,pos.y+AHeight); - end; - end; - - if FAvailableWidth = EmptySingle then - begin - if FParagraph[paraIndex].rectF.Left = EmptySingle then - begin - FParagraph[paraIndex].rectF.Left := curBroken^.rectF.left; - FParagraph[paraIndex].rectF.Right := curBroken^.rectF.Right; - end else - begin - if FParagraph[paraIndex].rectF.Left < curBroken^.rectF.left then - FParagraph[paraIndex].rectF.Left := curBroken^.rectF.left; - if FParagraph[paraIndex].rectF.Right > curBroken^.rectF.Right then - FParagraph[paraIndex].rectF.Right := curBroken^.rectF.Right; - end; - end; - - inc(curPara^.brokenLineCount); - inc(brokenIndex); - end; - - procedure DoneBrokenLine; - begin - inc(partIndex, curBroken^.partCount); - IncF(pos.y, curBroken^.rectF.Height); - end; - - procedure ClearTabSections; - var - i: Integer; - begin - tabSectionCount := 0; - for i := 0 to high(tabSection) do - FreeAndNil(tabSection[i].tree); - end; - - procedure UpdateQuickSearch; - begin - FComputedPartCount:= partIndex + 1; - FComputedBrokenLineCount:= brokenIndex + 1; - end; - - procedure Finished; - begin - ClearTabSections; - UpdateQuickSearch; - CheckTextLayout; - end; - - procedure StartParagraph(AParagraphIndex: integer); - begin - curPara := @FParagraph[AParagraphIndex]; - curPara^.overflow := false; - curPara^.firstBrokenLineIndex:= brokenIndex + 1; - curPara^.firstPartIndex := partIndex + 1; - - oldBrokenLineCount:= curPara^.brokenLineCount; - oldBrokenLines:= curPara^.brokenLines; - curPara^.brokenLines := nil; - curPara^.brokenLineCount:= 0; - - curPara^.rectF.Top := pos.y; - curPara^.rectF.Bottom := pos.y; - if FAvailableWidth <> EmptySingle then - begin - curPara^.rectF.Left := 0; - curPara^.rectF.Right := FAvailableWidth; - end else - begin - curPara^.rectF.Left := EmptySingle; - curPara^.rectF.Right := EmptySingle; - end; - paraRTL := ParagraphRightToLeft[AParagraphIndex]; - if FAvailableWidth <> EmptySingle then - alignment := BidiTextAlignmentToAlignment(curPara^.alignment, paraRTL) - else - alignment := taLeftJustify; - end; - - procedure DoneParagraph(AParagraphIndex: integer); - var - firstBrokenIndex, lastBrokenIndexFromEnd: Integer; - newBroken, oldBroken: PBrokenLineInfo; - - function BrokenDifferent: boolean; - var - i: integer; - oldPart, newPart: PPartInfo; - begin - if (oldBroken^.startIndex <> newBroken^.startIndex) or - (oldBroken^.endIndex <> newBroken^.endIndex) or - (oldBroken^.bidiLevel <> newBroken^.bidiLevel) or - (oldBroken^.partCount <> newBroken^.partCount) then exit(true); - for i := 0 to oldBroken^.partCount-1 do - begin - oldPart := @oldBroken^.parts[i]; - newPart := @newBroken^.parts[i]; - if oldPart^.modified then exit(true); - if (oldPart^.startIndex <> newPart^.startIndex) or - (oldPart^.endIndex <> newPart^.endIndex) or - (oldPart^.bidiLevel <> newPart^.bidiLevel) then exit(true); - end; - result := false; - end; - begin - curPara^.layoutComputed := true; - if Assigned(FOnBrokenLinesChanged) then - begin - firstBrokenIndex := 0; - while (firstBrokenIndex < oldBrokenLineCount) and - (firstBrokenIndex < curPara^.brokenLineCount) do - begin - oldBroken := @oldBrokenLines[firstBrokenIndex]; - newBroken := @curPara^.brokenLines[firstBrokenIndex]; - if BrokenDifferent then break; - inc(firstBrokenIndex); - end; - lastBrokenIndexFromEnd := 0; - while (oldBrokenLineCount - lastBrokenIndexFromEnd - 1 > firstBrokenIndex) and - (curPara^.brokenLineCount - lastBrokenIndexFromEnd - 1 > firstBrokenIndex) do - begin - oldBroken := @oldBrokenLines[oldBrokenLineCount - lastBrokenIndexFromEnd - 1]; - newBroken := @curPara^.brokenLines[curPara^.brokenLineCount - lastBrokenIndexFromEnd - 1]; - if BrokenDifferent then break; - inc(lastBrokenIndexFromEnd); - end; - if Assigned(FOnBrokenLinesChanged) and - ((curPara^.brokenLineCount <> oldBrokenLineCount) or - (firstBrokenIndex < oldBrokenLineCount)) then - begin - FOnBrokenLinesChanged(self, AParagraphIndex, firstBrokenIndex, - oldBrokenLineCount - lastBrokenIndexFromEnd - firstBrokenIndex, - curPara^.brokenLineCount - lastBrokenIndexFromEnd - firstBrokenIndex, - oldBrokenLineCount, curPara^.brokenLineCount); - end; - end; - end; - -begin - FLineHeight:= GetFontFullHeight; - baseLine := GetFontBaseline; - ComputeMatrix; - - paraSpacingAbove := ParagraphSpacingAbove * FLineHeight; - paraSpacingBelow := ParagraphSpacingBelow * FLineHeight; - if FAvailableWidth <> EmptySingle then - availWidth0 := FAvailableWidth - else - availWidth0:= 0; - - tabPixelSize := TabSize*TextSizeBidiOverride(' ',False).x; - tabSection := nil; - pos := PointF(0,0); - brokenIndex := -1; - curBroken:= nil; - partIndex := -1; - - for paraIndex := 0 to ParagraphCount-1 do - begin - curPara := @FParagraph[paraIndex]; - if curPara^.layoutComputed then - begin - OffsetParagraph(paraIndex, pos.y - curPara^.rectF.Top, - brokenIndex+1 - curPara^.firstBrokenLineIndex, - partIndex+1 - curPara^.firstPartIndex); - if curPara^.layoutComputed then - begin - pos.y := FParagraph[paraIndex].rectF.Bottom; - inc(brokenIndex, curPara^.brokenLineCount); - for i := 0 to curPara^.brokenLineCount-1 do - inc(partIndex, curPara^.brokenLines[i].partCount); - continue; - end; - end; - - StartParagraph(paraIndex); - IncF(pos.y, paraSpacingAbove); - curPara^.rectF.Bottom:= pos.y; - - for ubIndex := FAnalysis.ParagraphFirstUnbrokenLine[paraIndex] to FAnalysis.ParagraphLastUnbrokenLinePlusOne[paraIndex]-1 do - begin - if (FAvailableHeight <> EmptySingle) and (pos.y >= FAvailableHeight) and - (ubIndex <> 0) {there must be at least one broken line} then - begin - curPara^.overflow:= true; - curPara^.rectF.Bottom := pos.y; - DoneParagraph(paraIndex); - for i := paraIndex+1 to high(FParagraph) do - begin - StartParagraph(i); - curPara^.overflow:= true; - DoneParagraph(i); - end; - Finished; - exit; - end; - - lineStart := FAnalysis.UnbrokenLineStartIndex[ubIndex]; - lineEnd := FAnalysis.UnbrokenLineEndIndex[ubIndex]; - if lineStart < lineEnd then - paraBidiLevel := FAnalysis.BidiInfo[lineStart].ParagraphBidiLevel - else - paraBidiLevel := 0; - - if lineEnd > lineStart then - begin - u := UnicodeChar[lineEnd-1]; - case u of - UNICODE_LINE_SEPARATOR, UNICODE_PARAGRAPH_SEPARATOR, UNICODE_NEXT_LINE: dec(lineEnd); - 13,10: - begin - dec(lineEnd); - if lineEnd > lineStart then - begin - u := UnicodeChar[lineEnd-1]; - if (u = 13) or (u = 10) then dec(lineEnd); - end; - end; - end; - end; - - subStart := lineStart; - - //empty paragraph - if subStart = lineEnd then - begin - StartBrokenLine(subStart, lineEnd, paraBidiLevel, 0, FLineHeight); - - case alignment of - taRightJustify: pos.x := availWidth0; - taCenter: pos.x := availWidth0*0.5; - else {taLeftJustify} - pos.x := 0; - end; - AddPart(subStart, lineEnd, paraBidiLevel, - RectF(pos.x, curBroken^.rectF.Top, - pos.x, curBroken^.rectF.Bottom), - PointF(0,0), brokenIndex, curBroken); - - DoneBrokenLine; - end else - //break lines - while subStart < lineEnd do - begin - //split into sections according to tabs - ClearTabSections; - curBidiPos := 0; - tabSectionStart := subStart; - tabSectionCount := 0; - curLineHeight := FLineHeight; - - while tabSectionStart < lineEnd do - begin - needNewLine := false; - while (tabSectionStart < lineEnd) and (FAnalysis.UnicodeChar[tabSectionStart] = 9) do - begin - if tabPixelSize = 0 then inc(tabSectionStart) - else - begin - nextTabBidiPos := tabPixelSize* (floor(curBidiPos / tabPixelSize + 1e-6)+1); - if (FAvailableWidth = EmptySingle) or (nextTabBidiPos <= FAvailableWidth) or (tabSectionStart = subStart) then - begin - AddTabSection(tabSectionStart, tabSectionStart+1, nil); - inc(tabSectionStart); - curBidiPos := nextTabBidiPos; - end else - begin - //if tab is last char then go to the end of the line - if tabSectionStart = lineEnd-1 then - begin - AddTabSection(tabSectionStart, lineEnd, nil); - inc(tabSectionStart); - curBidiPos := FAvailableWidth; - needNewLine := true; - break; - end - else //otherwise a new line is needed before the tab - begin - needNewLine := true; - break; - end; - end; - end; - end; - if needNewLine then - begin - splitIndex:= tabSectionStart; - break; - end; - - nextTabIndex := tabSectionStart; - while (nextTabIndex < lineEnd) and (FAnalysis.UnicodeChar[nextTabIndex] <> 9) do inc(nextTabIndex); - if FAvailableWidth = EmptySingle then - remainWidth := EmptySingle - else - remainWidth := FAvailableWidth - curBidiPos; - nextTree := TBidiLayoutTree(ComputeBidiTree(remainWidth, tabSectionStart, nextTabIndex, paraBidiLevel)); - splitIndex := nextTree.EndIndex; - - AddTabSection(tabSectionStart, splitIndex, nextTree); - - if splitIndex < nextTabIndex then - begin - if (tabSectionCount = 1) and (splitIndex = tabSectionStart) then - begin - inc(splitIndex); - while (splitIndex < nextTabIndex) and not FAnalysis.BidiInfo[splitIndex].IsMulticharStart do inc(splitIndex); - end; - partStr := FAnalysis.CopyTextUTF8(tabSectionStart, splitIndex-tabSectionStart); - remainStr := FAnalysis.CopyTextUTF8(splitIndex, nextTabIndex-splitIndex); - if tabSectionCount > 1 then partStr := ' '+partStr; - if Assigned(FWordBreakHandler) then - FWordBreakHandler(partStr, remainStr) - else - BGRADefaultWordBreakHandler(partStr, remainStr); - if tabSectionCount > 1 then delete(partStr,1,1); - - splitIndex:= tabSectionStart + UTF8Length(partStr); - - //section is deleted - if splitIndex = tabSectionStart then - begin - dec(tabSectionCount); - //tabSectionStart stay the same - end - else - begin - //section is extended - if splitIndex > nextTree.EndIndex then - begin - nextTree := TBidiLayoutTree(ComputeBidiTree(EmptySingle, tabSectionStart, splitIndex, paraBidiLevel)); - tabSection[tabSectionCount-1].tree.Free; - tabSection[tabSectionCount-1].tree := nextTree; - end - else - begin //otherwise the section is split - nextTree.Shorten(splitIndex); - tabSection[tabSectionCount-1].endIndex:= splitIndex; - end; - - IncF(curBidiPos, nextTree.Width); - if nextTree.Height > curLineHeight then curLineHeight := nextTree.Height; - - tabSectionStart := splitIndex; - while (tabSectionStart < nextTabIndex) and IsUnicodeSpace(FAnalysis.UnicodeChar[tabSectionStart]) do inc(tabSectionStart); - end; - break; - end else - begin - IncF(curBidiPos, nextTree.Width); - if nextTree.Height > curLineHeight then curLineHeight := nextTree.Height; - tabSectionStart := splitIndex; - end; - end; - - // add broken line info - StartBrokenLine(subStart, splitIndex, paraBidiLevel, curBidiPos, curLineHeight); - - subStart := tabSectionStart; - - case alignment of - taRightJustify: - if paraRTL then - pos.x := availWidth0 - else - pos.x := availWidth0 - curBidiPos; - taCenter: - if paraRTL then - pos.x := (availWidth0 + curBidiPos)*0.5 - else - pos.x := (availWidth0 - curBidiPos)*0.5; - else {taLeftJustify} - if paraRTL then - pos.x := curBidiPos - else - pos.x := 0; - end; - - if FLineHeight <> 0 then - correctedBaseLine := baseLine*curLineHeight/FLineHeight - else - correctedBaseLine:= 0; - - for j := 0 to tabSectionCount-1 do - begin - if not Assigned(tabSection[j].tree) then - begin - if j = tabSectionCount-1 then - endBidiPos:= curBidiPos - else - endBidiPos:= tabSection[j+1].bidiPos; - - if paraRTL then - r := RectF(pos.x-endBidiPos, pos.y, pos.x-tabSection[j].bidiPos, pos.y+curLineHeight) - else - r := RectF(pos.x+tabSection[j].bidiPos, pos.y, pos.x+endBidiPos, pos.y+curLineHeight); - - AddPart(tabSection[j].startIndex, tabSection[j].endIndex, paraBidiLevel, r, PointF(0,0), brokenIndex, curBroken); - end - else - begin - if paraRTL then - AddPartsFromTree(pos - PointF(tabSection[j].bidiPos,0), tabSection[j].tree, curLineHeight, correctedBaseLine, brokenIndex, curBroken) - else - AddPartsFromTree(pos + PointF(tabSection[j].bidiPos,0), tabSection[j].tree, curLineHeight, correctedBaseLine, brokenIndex, curBroken) - end; - end; - - DoneBrokenLine; - if (FAvailableHeight <> EmptySingle) and (pos.y >= FAvailableHeight) then - begin - curPara^.overflow := true; - break; - end; - end; - end; - IncF(pos.y, paraSpacingBelow); - curPara^.rectF.Bottom := pos.y; - DoneParagraph(paraIndex); - end; - Finished; -end; - -procedure TBidiTextLayout.CheckTextLayout; -var - i, charIndex, partIndex, j, k, curBrokenLineEndIndex: Integer; -begin - charIndex := 0; - partIndex := 0; - if length(FParagraph) <> ParagraphCount then - raise exception.Create('Number of paragraph mismatch ' + inttostr(length(FParagraph)) + - '/' + inttostr(ParagraphCount)); - for i := 0 to ParagraphCount-1 do - begin - if not FParagraph[i].layoutComputed then - raise exception.Create('Layout not computed for paragraph ' + inttostr(i)); - if i > 0 then - begin - if FParagraph[i].firstBrokenLineIndex < FParagraph[i-1].firstBrokenLineIndex then - raise exception.Create('Broken index is not ascending'); - if FParagraph[i].firstBrokenLineIndex <> FParagraph[i-1].firstBrokenLineIndex - + FParagraph[i-1].brokenLineCount then - raise exception.Create('Expecting at least one broken line'); - if FParagraph[i].firstPartIndex < FParagraph[i-1].firstPartIndex then - raise exception.Create('Part index is not ascending'); - if FParagraph[i].firstPartIndex <> partIndex then - raise exception.Create('Part index is not consistent between paragraphs'); - end else - begin - if FParagraph[i].firstPartIndex <> 0 then - raise exception.Create('First part index is expected to be 0'); - if FParagraph[i].firstBrokenLineIndex <> 0 then - raise exception.Create('First broken index is expected to be 0'); - if (FParagraph[i].brokenLineCount > 0) and - (FParagraph[i].brokenLines[0].firstPartIndex <> FParagraph[i].firstPartIndex) then - raise exception.Create('Inconsistent part index between paragraph and first broken line'); - end; - with FParagraph[i] do - for j := 0 to brokenLineCount-1 do - begin - if brokenLines[j].firstPartIndex <> partIndex then - raise exception.Create('Inconsistent first part index of broken line (' + - inttostr(brokenLines[j].firstPartIndex) + ' expecting ' + - inttostr(partIndex) + ' for broken line ' + - inttostr(firstBrokenLineIndex + j) + ')'); - inc(partIndex, brokenLines[j].partCount); - if brokenLines[j].startIndex < charIndex then - raise exception.Create('Inconsistent first char index of broken line (' + - inttostr(brokenLines[j].startIndex) + ' expecting at least ' + - inttostr(charIndex) + ' for broken line ' + - inttostr(firstBrokenLineIndex + j) + ' and paragraph ' + inttostr(i) + ')'); - with brokenLines[j] do - begin - curBrokenLineEndIndex := endIndex; - for k := 0 to partCount-1 do - with parts[k] do - begin - if startIndex < charIndex then - raise exception.Create('Inconsistent first char index of part'); - if endIndex > curBrokenLineEndIndex then - raise exception.Create('Last char index of part out of broken line range'); - charIndex := endIndex; - end; - end; - charIndex := brokenLines[j].endIndex; - end; - end; - if charIndex > CharCount then - raise exception.Create('Last char index of broken line out of bounds (' + - inttostr(charIndex)+' > '+inttostr(CharCount) + ')'); -end; - -procedure TBidiTextLayout.NeedLayout; -begin - if not LayoutComputed then ComputeLayout; -end; - -procedure TBidiTextLayout.InternalDrawText(ADest: TBGRACustomBitmap); -begin - InternalDrawTextParts(ADest, 0, PartCount); -end; - -procedure TBidiTextLayout.InternalPathText(ADest: IBGRAPath); -begin - InternalPathTextParts(ADest, 0, PartCount); -end; - -procedure TBidiTextLayout.InternalPathText(ADest: IBGRAPath; AClipRect: TRect); -begin - InternalPathTextParts(ADest, AClipRect, 0, PartCount); -end; - -procedure TBidiTextLayout.InternalDrawTextParts(ADest: TBGRACustomBitmap; - AFirstPart, ALastPartPlus1: integer); -var - part: PPartInfo; - enumPart: TPartEnumerator; - r: TRectF; - b: TRect; - pos: TPointF; -begin - NeedLayout; - enumPart := GetPartEnumerator(AFirstPart, ALastPartPlus1); - while enumPart.GetNext do begin - part := enumPart.PartInfo; - r := part^.rectF; - DecF(r.Left, LineHeight/2 + FClipMargin); - DecF(r.Top, FClipMargin); - IncF(r.Right, LineHeight/2 + FClipMargin); - IncF(r.Bottom, FClipMargin); - b := (Matrix*TAffineBox.AffineBox(r)).RectBounds; - if not b.IntersectsWith(ADest.ClipRect) then continue; - pos := Matrix*(part^.rectF.TopLeft + part^.posCorrection); - TextOutBidiOverride(ADest, pos.x, pos.y, - FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex), - part^.IsRightToLeft); - end; -end; - -procedure TBidiTextLayout.InternalPathTextParts(ADest: IBGRAPath; AFirstPart, - ALastPartPlus1: integer); -var - part: PPartInfo; - pos: TPointF; - enumPart: TPartEnumerator; -begin - NeedLayout; - enumPart := GetPartEnumerator(AFirstPart, ALastPartPlus1); - while enumPart.GetNext do begin - part := enumPart.PartInfo; - pos := Matrix*(part^.rectF.TopLeft + part^.posCorrection); - TextPathBidiOverride(ADest, pos.x, pos.y, - FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex), - part^.IsRightToLeft); - end; -end; - -procedure TBidiTextLayout.InternalPathTextParts(ADest: IBGRAPath; - AClipRect: TRect; AFirstPart, ALastPartPlus1: integer); -var - part: PPartInfo; - enumPart: TPartEnumerator; - r: TRectF; - b: TRect; - pos: TPointF; -begin - NeedLayout; - enumPart := GetPartEnumerator(AFirstPart, ALastPartPlus1); - while enumPart.GetNext do begin - part := enumPart.PartInfo; - r := part^.rectF; - DecF(r.Left, LineHeight/2 + FClipMargin); - DecF(r.Top, FClipMargin); - IncF(r.Right, LineHeight/2 + FClipMargin); - IncF(r.Bottom, FClipMargin); - b := (Matrix*TAffineBox.AffineBox(r)).RectBounds; - if not b.IntersectsWith(AClipRect) then continue; - pos := Matrix*(part^.rectF.TopLeft + part^.posCorrection); - TextPathBidiOverride(ADest, pos.x, pos.y, - FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex), - part^.IsRightToLeft); - end; -end; - -procedure TBidiTextLayout.InternalRangeError; -begin - raise ERangeError.Create('Internal error'); -end; - -procedure TBidiTextLayout.DrawCaret(ADest: TBGRACustomBitmap; - ACharIndex: integer; AMainColor, ASecondaryColor: TBGRAPixel); - - procedure DrawSingleCaret(ATop,ABottom: TPointF; ARightToLeft, AShowDir: boolean; AColor: TBGRAPixel); - var u,v: TPointF; - triSize,len: single; - begin - //hinting depending on orientation - if abs(ATop.x - ABottom.x) < abs(ATop.y - ABottom.y) then - begin - ATop.x := round(ATop.x); - ABottom.x := round(ABottom.x); - end - else - begin - ATop.y := round(ATop.y); - ABottom.y := round(ABottom.y); - end; - u := ABottom-ATop; - len := VectLen(u); - if len > 0 then - begin - u := (1/len)*u; - v := PointF(u.y,-u.x); - if AShowDir then - begin - triSize := len*0.2; - if ARightToLeft then - ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop - triSize*v, ATop - v + triSize*u, ABottom - v]), AColor, false) - else - ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop + triSize*v, ATop + triSize*u + v, ABottom + v]), AColor, False) - end - else - begin - if len > 10 then - begin - if ARightToLeft then - ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop - 2*v, ABottom - 2*v]), AColor, False) - else - ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop + 2*v, ABottom + 2*v]), AColor, False) - end - else - begin - if ARightToLeft then - ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop - v, ABottom - v]), AColor, False) - else - ADest.FillPolyAntialias(PointsF([ABottom, ATop, ATop + v, ABottom + v]), AColor, False) - end; - end; - end else - ADest.DrawPixel(round(ATop.x),round(ATop.y), AColor); - end; - -var - caret: TBidiCaretPos; - showDir: Boolean; -begin - NeedLayout; - - caret := GetCaret(ACharIndex); - showDir := not isEmptyPointF(caret.PreviousTop) and (caret.RightToLeft <> caret.PreviousRightToLeft); - if not isEmptyPointF(caret.Top) then DrawSingleCaret(caret.Top, caret.Bottom, caret.RightToLeft, showDir, AMainColor); - if not isEmptyPointF(caret.PreviousTop) then DrawSingleCaret(caret.PreviousTop, caret.PreviousBottom, caret.PreviousRightToLeft, showDir, ASecondaryColor); -end; - -procedure TBidiTextLayout.DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, - AEndIndex: integer; AFillColor: TBGRAPixel; ABorderColor: TBGRAPixel; APenWidth: single); -var - env: ArrayOfTPointF; -begin - NeedLayout; - - if AStartIndex = AEndIndex then exit; - env := GetTextEnveloppe(AStartIndex,AEndIndex, False, True); - ADest.FillPolyAntialias(env, AFillColor, False); - if (ABorderColor.alpha <> 0) and (APenWidth > 0) then - ADest.DrawPolygonAntialias(env, ABorderColor, APenWidth); -end; - -procedure TBidiTextLayout.DrawSelection(ADest: TBGRACustomBitmap; AStartIndex, - AEndIndex: integer; AFillColor: TBGRAPixel); -begin - DrawSelection(ADest, AStartIndex,AEndIndex, AFillColor, BGRAPixelTransparent, 0); -end; - -function TBidiTextLayout.GetCaret(ACharIndex: integer): TBidiCaretPos; -begin - result := GetUntransformedCaret(ACharIndex); - result.Transform(Matrix); -end; - -function TBidiTextLayout.GetUntransformedCaret(ACharIndex: integer): TBidiCaretPos; -var - i, blIndex, lastPartIndex: Integer; - w: Single; - bl: PBrokenLineInfo; - part: PPartInfo; -begin - NeedLayout; - - if (ACharIndex < 0) or (ACharIndex > CharCount) then - raise ERangeError.Create('Invalid index'); - - if (PartCount > 0) and (ACharIndex >= PartEndIndex[PartCount-1]) then - begin - result := GetUntransformedPartEndCaret(PartCount-1); - exit; - end; - - result.PartIndex := -1; - result.Top := EmptyPointF; - result.Bottom := EmptyPointF; - result.RightToLeft := false; - result.PreviousTop := EmptyPointF; - result.PreviousBottom := EmptyPointF; - result.PreviousRightToLeft := false; - - blIndex := GetBrokenLineAt(ACharIndex); - bl := GetBrokenLineInfo(blIndex); - if blIndex <> -1 then - begin - lastPartIndex := bl^.firstPartIndex + bl^.partCount - 1; - for i := bl^.firstPartIndex to lastPartIndex do - begin - part := @bl^.parts[i - bl^.firstPartIndex]; - if ACharIndex <= part^.startIndex then - begin - result := GetUntransformedPartStartCaret(i); - exit; - end else - if (ACharIndex > part^.startIndex) and (ACharIndex <= part^.endIndex) then - begin - if (i < FComputedPartCount-1) and (ACharIndex = part^.startIndex) then - begin - result := GetUntransformedPartStartCaret(i+1); - exit; - end else - begin - if ACharIndex = part^.endIndex then - begin - result := GetUntransformedPartEndCaret(i); - exit; - end else - begin - w := TextSizeBidiOverrideSplit(part^.startIndex, part^.endIndex, part^.IsRightToLeft, ACharIndex).x; - - if part^.IsRightToLeft then - result.Top := PointF(part^.rectF.Right - w, part^.rectF.Top) - else result.Top := PointF(part^.rectF.Left + w, part^.rectF.Top); - result.Bottom := result.Top + PointF(0, part^.rectF.Height); - - result.RightToLeft := part^.IsRightToLeft; - result.PreviousRightToLeft := result.RightToLeft; - result.PartIndex := i; - end; - exit; - end; - end else - if i = lastPartIndex then - begin - result := GetUntransformedPartEndCaret(i); - exit; - end; - end; - end; - - if ACharIndex = 0 then - begin - result.Top := PointF(0,0); - result.Bottom := PointF(0,FLineHeight); - result.RightToLeft := false; - result.PreviousTop := EmptyPointF; - result.PreviousBottom := EmptyPointF; - result.PreviousRightToLeft := false; - result.PartIndex := 0; - end; -end; - -function TBidiTextLayout.GetCharIndexAt(APosition: TPointF): integer; -var - brokenIndex,j, fit: Integer; - u,u2: LongWord; - axis, origin: TPointF; - len, w, curW, newW: Single; - str: String; - curIndex, newIndex, paraIndex: integer; - untransformedPos: TPointF; - para: PParagraphInfo; - curBroken: PBrokenLineInfo; - part: PPartInfo; - ab: TAffineBox; -begin - NeedLayout; - untransformedPos := FMatrixInverse*APosition; - paraIndex := GetUntransformedParagraphAt(untransformedPos); - para := @FParagraph[paraIndex]; - - if untransformedPos.Y < para^.rectF.Top then - exit(ParagraphStartIndex[paraIndex]); - - if untransformedPos.Y >= para^.rectF.Bottom then - exit(ParagraphEndIndex[paraIndex]); - - for brokenIndex := 0 to para^.brokenLineCount-1 do - begin - curBroken := @para^.brokenLines[brokenIndex]; - if untransformedPos.Y < curBroken^.rectF.Bottom then - begin - if untransformedPos.Y < curBroken^.rectF.Top then - exit(curBroken^.startIndex); - - //before part - if curBroken^.partCount > 0 then - begin - if (curBroken^.IsRightToLeft and (untransformedPos.x >= curBroken^.parts[0].rectF.Right)) or - (not curBroken^.IsRightToLeft and (untransformedPos.x < curBroken^.parts[0].rectF.Left)) then - exit(curBroken^.startIndex) - end; - - for j := 0 to curBroken^.partCount-1 do - begin - part := @curBroken^.parts[j]; - ab := Matrix*TAffineBox.AffineBox(part^.rectF); - if ab.Contains(APosition) then - begin - if part^.IsRightToLeft then - begin - axis := ab.TopLeft - ab.TopRight; - origin := ab.TopRight; - end else - begin - axis := ab.TopRight - ab.TopLeft; - origin := ab.TopLeft; - end; - len := VectLen(axis); - if len > 0 then - begin - w := ((APosition-origin)*axis)/len; - //if there is just one char, it is the whole part - if part^.endIndex = part^.startIndex + 1 then - begin - if w > 0.5*len then - exit(part^.endIndex) - else - exit(part^.startIndex); - end; - - str := FAnalysis.CopyTextUTF8(part^.startIndex, part^.endIndex - part^.startIndex); - fit := TextFitInfoBidiOverride(str, w, part^.IsRightToLeft); - curIndex := part^.startIndex+fit; - if curIndex > part^.endIndex then curIndex:= part^.endIndex; - if curIndex = 0 then curW := 0 - else curW := TextSizeBidiOverrideSplit(part^.startIndex, part^.endIndex, part^.IsRightToLeft, curIndex).x; - while (curW < w) and (curIndex < part^.endIndex) do - begin - newIndex := curIndex+1; - while (newIndex < part^.endIndex) and not FAnalysis.BidiInfo[newIndex].IsMulticharStart do inc(newIndex); - newW := TextSizeBidiOverrideSplit(part^.startIndex, part^.endIndex, part^.IsRightToLeft, newIndex).x; - if newW >= w then - begin - if (curW+newW)*0.5 + 1 < w then curIndex := newIndex; - break; - end else - begin - curW := newW; - curIndex := newIndex; - end; - end; - exit(curIndex); - end; - exit(part^.startIndex); - end; - end; - - //after part - result := curBroken^.endIndex; - if result > curBroken^.startIndex then - begin - u := GetUnicodeChar(result-1); - if IsUnicodeParagraphSeparator(u) or (u = UNICODE_LINE_SEPARATOR) then - begin - dec(result); - if (result > curBroken^.startIndex) and (u = 13) or (u = 10) then - begin - u2 := GetUnicodeChar(result-1); - if (u2 <> u) and ((u2 = 13) or (u2 = 10)) then dec(result); - end; - end; - end; - exit; - end; - end; - - exit(ParagraphEndIndexBeforeParagraphSeparator[paraIndex]); -end; - -function TBidiTextLayout.GetTextEnveloppe(AStartIndex, AEndIndex: integer; APixelCenteredCoordinates: boolean; AMergeBoxes: boolean; AVerticalClip: boolean): ArrayOfTPointF; -var - i: Integer; - m: TAffineMatrix; -begin - result := GetUntransformedTextEnveloppe(AStartIndex,AEndIndex,false,AMergeBoxes,AVerticalClip); - if APixelCenteredCoordinates then m := AffineMatrixTranslation(-0.5,0.5)*Matrix else m := Matrix; - for i := 0 to high(result) do - result[i] := m*result[i]; -end; - -function TBidiTextLayout.GetUntransformedTextEnveloppe(AStartIndex, - AEndIndex: integer; APixelCenteredCoordinates: boolean; AMergeBoxes: boolean; AVerticalClip: boolean): ArrayOfTPointF; -var - startCaret, endCaret: TBidiCaretPos; - vertResult: array of record - box: TAffineBox; - joinPrevious: boolean; - end; - - procedure AppendVertResult(ABox: TAffineBox; ARightToLeft: boolean); - begin - if AVerticalClip and (AvailableHeight <> EmptySingle) then - begin - if (ABox.TopLeft.y >= AvailableHeight) or (ABox.TopRight.y >= AvailableHeight) then exit; - if ABox.BottomLeft.y > AvailableHeight then ABox.BottomLeft.y := AvailableHeight; - end; - - if ARightToLeft then - ABox := TAffineBox.AffineBox(ABox.TopRight,ABox.TopLeft,ABox.BottomRight); - - if AMergeBoxes and (vertResult <> nil) and (ABox.TopLeft = vertResult[high(vertResult)].box.BottomLeft) and - (ABox.TopRight = vertResult[high(vertResult)].box.BottomRight) then - vertResult[high(vertResult)].box := - TAffineBox.AffineBox(vertResult[high(vertResult)].box.TopLeft, vertResult[high(vertResult)].box.TopRight, ABox.BottomLeft) - else - begin - setlength(vertResult, length(vertResult)+1); - vertResult[high(vertResult)].box := ABox; - if high(vertResult)>0 then - vertResult[high(vertResult)].joinPrevious:= AMergeBoxes and ((VectLen(ABox.TopLeft-vertResult[high(vertResult)-1].box.BottomLeft)<1e-3) or - (VectLen(ABox.TopRight-vertResult[high(vertResult)-1].box.BottomRight)<1e-3)) - else - vertResult[high(vertResult)].joinPrevious:= false; - end; - end; - - procedure AppendComplexSelection; - var - horizResult: array of TAffineBox; - - procedure AppendHorizResult(AStartTop, AEndTop, AEndBottom, AStartBottom: TPointF; ARightToLeft: boolean); - var - temp: TPointF; - - procedure TryMergeBefore; - begin - while length(horizResult)>=2 do - begin - if (horizResult[high(horizResult)].TopRight = horizResult[high(horizResult)-1].TopLeft) and - (horizResult[high(horizResult)].BottomRight = horizResult[high(horizResult)-1].BottomLeft) then - begin - horizResult[high(horizResult)-1] := TAffineBox.AffineBox(horizResult[high(horizResult)].TopLeft, - horizResult[high(horizResult)-1].TopRight, - horizResult[high(horizResult)].BottomLeft); - setlength(horizResult, length(horizResult)-1); - end else - if (horizResult[high(horizResult)].TopLeft = horizResult[high(horizResult)-1].TopRight) and - (horizResult[high(horizResult)].BottomLeft = horizResult[high(horizResult)-1].BottomRight) then - begin - horizResult[high(horizResult)-1] := TAffineBox.AffineBox(horizResult[high(horizResult)-1].TopLeft, - horizResult[high(horizResult)].TopRight, - horizResult[high(horizResult)-1].BottomLeft); - setlength(horizResult, length(horizResult)-1); - end else - break; - end; - end; - - begin - if ARightToLeft then - begin - temp := AStartTop; - AStartTop := AEndTop; - AEndTop := temp; - - temp := AStartBottom; - AStartBottom := AEndBottom; - AEndBottom := temp; - end; - - if AMergeBoxes and (horizResult <> nil) and (AStartTop = horizResult[high(horizResult)].TopRight) - and (AStartBottom = horizResult[high(horizResult)].BottomRight) then - begin - horizResult[high(horizResult)] := TAffineBox.AffineBox(horizResult[high(horizResult)].TopLeft,AEndTop,horizResult[high(horizResult)].BottomLeft); - TryMergeBefore; - end - else - if AMergeBoxes and (horizResult <> nil) and (AEndTop = horizResult[high(horizResult)].TopLeft) - and (AEndBottom = horizResult[high(horizResult)].BottomLeft) then - begin - horizResult[high(horizResult)] := TAffineBox.AffineBox(AStartTop,horizResult[high(horizResult)].TopRight,AStartBottom); - TryMergeBefore; - end - else - begin - setlength(horizResult, length(horizResult)+1); - horizResult[high(horizResult)] := TAffineBox.AffineBox(AStartTop, AEndTop, AStartBottom); - end; - end; - - procedure FlushHorizResult; - var - idx, j: Integer; - begin - if horizResult <> nil then - begin - AppendVertResult(horizResult[0], false); - if length(horizResult)>1 then //additional boxes are added without vertical join - begin - idx := length(vertResult); - setlength(vertResult, length(vertResult)+length(horizResult)-1); - for j := 1 to high(horizResult) do - begin - vertResult[idx+j-1].box := horizResult[j]; - vertResult[idx+j-1].joinPrevious := false; - end; - end; - horizResult := nil; - end; - end; - - var - curPartStartCaret, curPartEndCaret, - lineStartCaret, lineEndCaret, curPartCaret: TBidiCaretPos; - curBrokenIndex, curParaIndex, prevParaIndex, j, - brokenLineLastPartIndexPlus1, curPartIndex: integer; - r: TRectF; - partEnum: TPartEnumerator; - prevPart, curPart: PPartInfo; - curBroken: PBrokenLineInfo; - - begin - horizResult := nil; - partEnum := GetPartEnumerator(startCaret.PartIndex, endCaret.PartIndex + 1); - curPart := nil; - curParaIndex := -1; - - if partEnum.GetNext then - while true do - begin - prevParaIndex := curParaIndex; - prevPart := curPart; - curParaIndex := partEnum.ParagraphIndex; - curPart := partEnum.PartInfo; - curPartIndex := partEnum.PartIndex; - curBroken := partEnum.BrokenLineInfo; - curBrokenIndex := partEnum.BrokenLineIndex; - - //space between paragraph - if (curPartIndex > startCaret.PartIndex) and (ParagraphSpacingAbove+ParagraphSpacingBelow <> 0) then - begin - if (curParaIndex > 0) and (prevParaIndex = curParaIndex-1) then - begin - FlushHorizResult; - - r := RectF(ParagraphRectF[curParaIndex-1].Left, ParagraphRectF[curParaIndex-1].Bottom - ParagraphSpacingBelow*FLineHeight, - ParagraphRectF[curParaIndex-1].Right, ParagraphRectF[curParaIndex-1].Bottom); - AppendVertResult(TAffineBox.AffineBox(r), False); - - r := RectF(ParagraphRectF[curParaIndex].Left, ParagraphRectF[curParaIndex].Top, - ParagraphRectF[curParaIndex].Right, ParagraphRectF[curParaIndex].Top + ParagraphSpacingAbove*FLineHeight); - AppendVertResult(TAffineBox.AffineBox(r), False); - end; - end; - - //whole broken line selected - brokenLineLastPartIndexPlus1 := curBroken^.firstPartIndex + curBroken^.partCount; - if (curPartIndex = curBroken^.firstPartIndex) and - ((curPartIndex > startCaret.PartIndex) or (AStartIndex = curPart^.startIndex)) and - (endCaret.PartIndex >= brokenLineLastPartIndexPlus1) then - begin - FlushHorizResult; - - lineStartCaret := GetBrokenLineUntransformedStartCaret(curBrokenIndex); - lineEndCaret := GetBrokenLineUntransformedEndCaret(curBrokenIndex); - AppendVertResult(TAffineBox.AffineBox(lineStartCaret.Top,lineEndCaret.Top,lineStartCaret.Bottom), BrokenLineRightToLeft[curBrokenIndex]); - - //skip broken line - for j := curPartIndex to brokenLineLastPartIndexPlus1-2 do - partEnum.GetNext; - if not partEnum.GetNext then break; - end else - begin - if curPartIndex > startCaret.PartIndex then - curPartStartCaret := GetUntransformedPartStartCaret(curPartIndex, prevPart, curPart) - else curPartStartCaret := startCaret; - - if curPartIndex < endCaret.PartIndex then - curPartEndCaret := GetUntransformedPartEndCaret(curPartIndex, curPart) - else curPartEndCaret := endCaret; - - //start of lines - if (curPartIndex > startCaret.PartIndex) and (prevPart^.brokenLineIndex <> curBrokenIndex) then - begin - FlushHorizResult; - - lineStartCaret := GetBrokenLineUntransformedStartCaret(curBrokenIndex); - if curBroken^.IsRightToLeft = curPart^.IsRightToLeft then - AppendHorizResult(lineStartCaret.Top, curPartStartCaret.Top, - curPartStartCaret.Bottom, lineStartCaret.Bottom, - BrokenLineRightToLeft[curBrokenIndex]) - else - AppendHorizResult(lineStartCaret.Top, curPartEndCaret.Top, - curPartEndCaret.Bottom, lineStartCaret.Bottom, - curBroken^.IsRightToLeft); - end; - - //text parts - AppendHorizResult(curPartStartCaret.Top, curPartEndCaret.Top, - curPartEndCaret.Bottom, curPartStartCaret.Bottom, - curPart^.IsRightToLeft); - - //end of lines - if not partEnum.GetNext then break; - - if (partEnum.BrokenLineIndex <> curBrokenIndex) then - begin - lineEndCaret := GetBrokenLineUntransformedEndCaret(curBrokenIndex); - if curBroken^.IsRightToLeft = curPart^.IsRightToLeft then - curPartCaret := GetUntransformedPartEndCaret(curPartIndex) - else - curPartCaret := GetUntransformedPartStartCaret(curPartIndex); - AppendHorizResult(curPartCaret.Top, lineEndCaret.Top, - lineEndCaret.Bottom, curPartCaret.Bottom, curBroken^.IsRightToLeft) - end; - end; - - end; - - FlushHorizResult; - end; - -var - temp: integer; - i,j, idxOut, k: integer; - -begin - NeedLayout; - - vertResult := nil; - - if AStartIndex > AEndIndex then - begin - temp := AStartIndex; - AStartIndex:= AEndIndex; - AEndIndex:= temp; - end; - startCaret := GetUntransformedCaret(AStartIndex); - endCaret := GetUntransformedCaret(AEndIndex); - if not isEmptyPointF(endCaret.PreviousTop) then - begin - endCaret.Top := endCaret.PreviousTop; endCaret.PreviousTop := EmptyPointF; - endCaret.Bottom := endCaret.PreviousBottom; endCaret.PreviousBottom := EmptyPointF; - endCaret.RightToLeft := endCaret.PreviousRightToLeft; - if endCaret.PartIndex <> -1 then dec(endCaret.PartIndex); - end; - - if startCaret.PartIndex = endCaret.PartIndex then - begin - if not isEmptyPointF(startCaret.Top) and not isEmptyPointF(endCaret.Top) then - AppendVertResult(TAffineBox.AffineBox(startCaret.Top,endCaret.Top,startCaret.Bottom), startCaret.RightToLeft); - end else - AppendComplexSelection; - - if APixelCenteredCoordinates then - for i := 0 to high(vertResult) do - vertResult[i].box.Offset(-0.5, -0.5); - - if vertResult <> nil then - begin - setlength(result, length(vertResult)*5 - 1); //maximum point count - idxOut := 0; - i := 0; - while i <= high(vertResult) do - begin - if i > 0 then - begin - result[idxOut] := EmptyPointF; - inc(idxOut); - end; - result[idxOut] := vertResult[i].box.TopLeft; inc(idxOut); - result[idxOut] := vertResult[i].box.TopRight; inc(idxOut); - result[idxOut] := vertResult[i].box.BottomRight; inc(idxOut); - j := i; - while (j CharCount) then raise exception.Create('Position out of bounds'); - paraMinIndex := 0; - paraMaxIndex := ParagraphCount-1; - repeat - if paraMinIndex > paraMaxIndex then - InternalRangeError else - if paraMinIndex = paraMaxIndex then - with FParagraph[paraMinIndex] do - begin - brokenMinIndex := 0; - brokenMaxIndex := brokenLineCount-1; - repeat - if brokenMinIndex > brokenMaxIndex then InternalRangeError else - if brokenMinIndex = brokenMaxIndex then - begin - result := brokenMinIndex + firstBrokenLineIndex; - exit; - end else - begin - brokenMidIndex := (brokenMinIndex + brokenMaxIndex + 1) shr 1; - if ACharIndex < brokenLines[brokenMidIndex].startIndex then - brokenMaxIndex := brokenMidIndex-1 - else brokenMinIndex := brokenMidIndex; - end; - until false; - end else - begin - paraMidIndex := (paraMinIndex + paraMaxIndex + 1) shr 1; - if ACharIndex < ParagraphStartIndex[paraMidIndex] then - paraMaxIndex := paraMidIndex-1 - else paraMinIndex := paraMidIndex; - end; - until false; -end; - -function TBidiTextLayout.InsertText(ATextUTF8: string; APosition: integer): integer; -begin - result := FAnalysis.InsertText(ATextUTF8,APosition); -end; - -function TBidiTextLayout.InsertLineSeparator(APosition: integer): integer; -begin - result := InsertText(UnicodeCharToUTF8(UNICODE_LINE_SEPARATOR), APosition); -end; - -function TBidiTextLayout.DeleteText(APosition, ACount: integer): integer; -begin - result := FAnalysis.DeleteText(APosition, ACount); -end; - -function TBidiTextLayout.DeleteTextBefore(APosition, ACount: integer): integer; -begin - result := FAnalysis.DeleteTextBefore(APosition, ACount); -end; - -function TBidiTextLayout.CopyText(APosition, ACount: integer): string; -begin - ACount := IncludeNonSpacingChars(APosition, ACount); - result := FAnalysis.CopyTextUTF8(APosition, ACount); -end; - -function TBidiTextLayout.CopyTextBefore(APosition, ACount: integer): string; -begin - ACount := IncludeNonSpacingCharsBefore(APosition, ACount); - result := FAnalysis.CopyTextUTF8(APosition-ACount, ACount); -end; - -function TBidiTextLayout.IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; -begin - result := FAnalysis.IncludeNonSpacingChars(APosition,ACount,AIncludeCombiningMarks); -end; - -function TBidiTextLayout.IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; -begin - result := FAnalysis.IncludeNonSpacingCharsBefore(APosition,ACount,AIncludeCombiningMarks); -end; - -function TBidiTextLayout.FindTextAbove(AFromPosition: integer): integer; -var - curPos: TBidiCaretPos; - bIndex: LongInt; - pt: TPointF; -begin - curPos := GetUntransformedCaret(AFromPosition); - bIndex := PartBrokenLineIndex[curPos.PartIndex]; - if (bIndex > 0) and not isEmptyPointF(curPos.Top) then - begin - dec(bIndex); - pt := PointF(curPos.Top.x, (BrokenLineRectF[bIndex].Top+BrokenLineRectF[bIndex].Bottom)*0.5); - result := GetCharIndexAt(Matrix*pt); - end else - exit(-1); -end; - -function TBidiTextLayout.FindTextBelow(AFromPosition: integer): integer; -var - curPos: TBidiCaretPos; - bIndex: LongInt; - pt: TPointF; -begin - curPos := GetUntransformedCaret(AFromPosition); - bIndex := PartBrokenLineIndex[curPos.PartIndex]; - if (bIndex < BrokenLineCount-1) and not isEmptyPointF(curPos.Top) then - begin - inc(bIndex); - pt := PointF(curPos.Top.x, (BrokenLineRectF[bIndex].Top+BrokenLineRectF[bIndex].Bottom)*0.5); - result := GetCharIndexAt(Matrix*pt); - end else - exit(-1); -end; - -function TBidiTextLayout.GetPartStartCaret(APartIndex: integer): TBidiCaretPos; -begin - result := GetUntransformedPartStartCaret(APartIndex); - result.Transform(Matrix) -end; - -function TBidiTextLayout.GetPartEndCaret(APartIndex: integer): TBidiCaretPos; -begin - result := GetUntransformedPartEndCaret(APartIndex); - result.Transform(Matrix); -end; - -function TBidiTextLayout.GetUntransformedPartStartCaret(APartIndex: integer): TBidiCaretPos; -var - prevPart, part: PPartInfo; - partEnum: TPartEnumerator; -begin - if (APartIndex < 0) or (APartIndex > PartCount) then - raise ERangeError.Create('Invalid index'); - - if APartIndex > 0 then - begin - partEnum := GetPartEnumerator(APartIndex - 1); - if not partEnum.GetNext then InternalRangeError; - prevPart := partEnum.PartInfo; - if not partEnum.GetNext then InternalRangeError; - part := partEnum.PartInfo; - end else - begin - prevPart := nil; - part := GetPartInfo(APartIndex); - end; - - result := GetUntransformedPartStartCaret(APartIndex, prevPart, part); -end; - -function TBidiTextLayout.GetUntransformedPartStartCaret(APartIndex: integer; - APrevPart, APart: PPartInfo): TBidiCaretPos; -begin - result.PartIndex := APartIndex; - - if APart^.IsRightToLeft then - result.Top := PointF(APart^.rectF.Right, APart^.rectF.Top) - else - result.Top := PointF(APart^.rectF.Left, APart^.rectF.Top); - result.Bottom := result.Top + PointF(0, APart^.rectF.Height); - - result.RightToLeft := APart^.IsRightToLeft; - - if (APartIndex > 0) and (APrevPart^.endIndex = APart^.startIndex) and - (BrokenLineUnbrokenIndex[APrevPart^.brokenLineIndex] = - BrokenLineUnbrokenIndex[APart^.brokenLineIndex]) then - begin - if APrevPart^.IsRightToLeft then - result.PreviousTop := PointF(APrevPart^.rectF.Left, APrevPart^.rectF.Top) - else - result.PreviousTop := PointF(APrevPart^.rectF.Right, APrevPart^.rectF.Top); - result.PreviousBottom := result.PreviousTop + PointF(0, APrevPart^.rectF.Height); - result.PreviousRightToLeft := APrevPart^.IsRightToLeft; - end else - begin - result.PreviousTop := EmptyPointF; - result.PreviousBottom := EmptyPointF; - result.PreviousRightToLeft := result.RightToLeft; - end; -end; - -function TBidiTextLayout.GetUntransformedPartEndCaret(APartIndex: integer): TBidiCaretPos; -var - part: PPartInfo; -begin - part := GetPartInfo(APartIndex); - result := GetUntransformedPartEndCaret(APartIndex, part); -end; - -function TBidiTextLayout.GetUntransformedPartEndCaret(APartIndex: integer; - APart: PPartInfo): TBidiCaretPos; -begin - result.PartIndex := APartIndex; - - if APart^.IsRightToLeft then - result.Top := PointF(APart^.rectF.Left, APart^.rectF.Top) - else - result.Top := PointF(APart^.rectF.Right, APart^.rectF.Top); - result.Bottom := result.Top + PointF(0, APart^.rectF.Height); - result.RightToLeft := APart^.IsRightToLeft; - - result.PreviousTop := EmptyPointF; - result.PreviousBottom := EmptyPointF; - result.PreviousRightToLeft := result.RightToLeft; -end; - -function TBidiTextLayout.GetUntransformedParagraphAt(APosition: TPointF): integer; - - procedure FindRec(AFirstParaIndex, ALastParaIndex: integer); - var - midIndex: Integer; - begin - midIndex := (AFirstParaIndex + ALastParaIndex) shr 1; - if APosition.y < FParagraph[midIndex].rectF.Top then - begin - if midIndex <= AFirstParaIndex then - begin - result := AFirstParaIndex; - exit; - end; - FindRec(AFirstParaIndex, midIndex-1); - end - else if APosition.y >= FParagraph[midIndex].rectF.Bottom then - begin - if midIndex >= ALastParaIndex then - begin - result := ALastParaIndex; - exit; - end; - FindRec(midIndex+1, ALastParaIndex); - end - else - begin - result := midIndex; - exit; - end; - end; - -begin - NeedLayout; - result := 0; - FindRec(0, ParagraphCount-1); -end; - -procedure TBidiTextLayout.AddPartsFromTree(APos: TPointF; ATree: TBidiTree; - fullHeight, baseLine: single; ABrokenLineIndex: integer; ABrokenLine: PBrokenLineInfo); -var - i: Integer; - root, branch: TBidiLayoutTree; - dy: Single; -begin - root := TBidiLayoutTree(ATree); - if root.IsLeaf then - begin - if (root.Height <> fullHeight) and (fullHeight <> 0) then - begin - dy := baseLine * (1 - root.Height/fullHeight); - end else - dy := 0; - if odd(root.BidiLevel) then - begin - DecF(APos.x, root.Width); - AddPart(root.StartIndex, root.EndIndex, root.BidiLevel, - RectF(APos.x, APos.y, APos.x+root.Width, APos.y+fullHeight), PointF(0,dy), ABrokenLineIndex, ABrokenLine); - end else - begin - AddPart(root.StartIndex, root.EndIndex, root.BidiLevel, - RectF(APos.x, APos.y, APos.x+root.Width, APos.y+fullHeight), PointF(0,dy), ABrokenLineIndex, ABrokenLine); - IncF(APos.x, root.Width); - end; - end else - begin - for i := 0 to root.Count-1 do - begin - branch := TBidiLayoutTree(root.Branch[i]); - if odd(root.BidiLevel) then - begin - if odd(branch.BidiLevel) then - begin - AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); - DecF(APos.x, branch.Width); - end else - begin - DecF(APos.x, branch.Width); - AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); - end; - end else - begin - if odd(branch.BidiLevel) then - begin - IncF(APos.x, branch.Width); - AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); - end else - begin - AddPartsFromTree(APos, branch, fullHeight, baseLine, ABrokenLineIndex, ABrokenLine); - IncF(APos.x, branch.Width); - end; - end; - end; - end; -end; - -procedure TBidiTextLayout.Init(ATextUTF8: string; ABidiMode: TFontBidiMode); -var - i: Integer; -begin - FComputedBrokenLineCount:= 0; - FComputedPartCount:= 0; - FTopLeft := PointF(0,0); - FAvailableWidth:= EmptySingle; - FAvailableHeight:= EmptySingle; - FTabSize := 8; - FParagraphSpacingAbove:= 0; - FParagraphSpacingBelow:= 0; - FMatrix := AffineMatrixIdentity; - FClipMargin := 0; - FColor := BGRABlack; - FTexture := nil; - FWordBreakHandler:= nil; - FAnalysis := TUnicodeAnalysis.Create(ATextUTF8, ABidiMode); - FAnalysis.OnBidiModeChanged:= @BidiModeChanged; - FAnalysis.OnCharDeleted:= @CharDeleted; - FAnalysis.OnParagraphDeleted:=@ParagraphDeleted; - FAnalysis.OnParagraphMergedWithNext:=@ParagraphMergedWithNext; - FAnalysis.OnCharInserted:=@CharInserted; - FAnalysis.OnParagraphSplit:=@ParagraphSplit; - FAnalysis.OnAnalysisChanged:= @AnalysisChanged; - SetLength(FParagraph, FAnalysis.ParagraphCount); - for i := 0 to high(FParagraph) do - begin - FParagraph[i].rectF := EmptyRectF; - FParagraph[i].alignment:= btaNatural; - FParagraph[i].layoutComputed := false; - end; -end; - -end. - diff --git a/components/bgrabitmap/bgratextfx.pas b/components/bgrabitmap/bgratextfx.pas deleted file mode 100644 index 8766deb..0000000 --- a/components/bgrabitmap/bgratextfx.pas +++ /dev/null @@ -1,902 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRATextFX; - -{$mode objfpc}{$H+} - -{ - Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType - - This unit provide text effects. The simplest way to render effects is to use TBGRATextEffectFontRenderer class. - To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions - to draw text like TBGRABitmap.TextOut will use the chosen renderer. To set the effects, keep a variable containing - the TBGRATextEffectFontRenderer class and modify ShadowVisible and other effects parameters. - - The TBGRATextEffectFontRenderer class makes use of other classes depending on the situation. For example, - TBGRATextEffect, which is also in this unit, provides effects on a text mask. But the renderer also uses - BGRAVectorize unit in order to have big texts or to rotate them at will. - - Note that you may need TBGRATextEffect if you want to have more control over text effects, especially - if you always draw the same text. Keeping the same TBGRATextEffect object will avoid creating the text - mask over and over again. - - TextShadow function is a simple function to compute an image containing a text with shadow. - -} - -interface - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAPhongTypes, BGRAText, - BGRACustomTextFX, BGRAVectorize; - -type - TBGRATextEffect = class; - - { TBGRATextEffectFontRenderer } - - TBGRATextEffectFontRenderer = class(TBGRASystemFontRenderer) - private - function GetShaderLightPosition: TPoint; - function GetShaderLightPositionF: TPointF; - function GetVectorizedRenderer: TBGRAVectorizedFontRenderer; - procedure SetShaderLightPosition(const AValue: TPoint); - procedure SetShaderLightPositionF(const AValue: TPointF); - protected - FShaderOwner: boolean; - FShader: TCustomPhongShading; - FVectorizedRenderer: TBGRAVectorizedFontRenderer; - function ShadowActuallyVisible :boolean; - function ShaderActuallyActive: boolean; - function OutlineActuallyVisible: boolean; - procedure Init; - function VectorizedFontNeeded(AOrientation: integer): boolean; - procedure InternalTextOutAngle(ADest: TBGRACustomBitmap; x, y: single; AOrientation: integer; sUTF8: string; c: TBGRAPixel; texture: IBGRAScanner; - align: TAlignment; AShowPrefix: boolean = false; ARightToLeft: boolean = false); override; - public - ShaderActive: boolean; - - ShadowVisible: boolean; - ShadowColor: TBGRAPixel; - ShadowRadius: integer; - ShadowOffset: TPoint; - ShadowQuality: TRadialBlurType; - - OutlineColor: TBGRAPixel; - OutlineWidth: single; - OutlineVisible,OuterOutlineOnly: boolean; - OutlineJoin: TPenJoinStyle; - OutlineTexture: IBGRAScanner; - constructor Create; overload; - constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean); overload; - destructor Destroy; override; - function TextSize(sUTF8: string): TSize; overload; override; - function TextSizeAngle(sUTF8: string; orientationTenthDegCCW: integer): TSize; override; - function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; - function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; - property Shader: TCustomPhongShading read FShader; - property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition; - property ShaderLightPositionF: TPointF read GetShaderLightPositionF write SetShaderLightPositionF; - property VectorizedFontRenderer: TBGRAVectorizedFontRenderer read GetVectorizedRenderer; - end; - - { TBGRATextEffect } - - TBGRATextEffect = class(TBGRACustomTextEffect) - protected - procedure InitImproveReadability(AText: string; Font: TFont; SubOffsetX,SubOffsetY: single); - procedure Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer); - procedure InitWithFontName(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); - public - constructor Create(AText: string; Font: TFont; Antialiasing: boolean); overload; - constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload; - constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer); overload; - constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean); overload; - constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload; - constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean); overload; - constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single); overload; - end; - -function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel; - AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True; AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap; - -procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode); - -implementation - -uses BGRAGradientScanner, Math, BGRAGrayscaleMask, BGRAPath, BGRATransform, - BGRAPolygon, BGRAPen; - -procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode); -var - useClearType,clearTypeRGBOrder: boolean; - metric: TFontPixelMetric; - deltaX: single; - x,y,yb,cury,fromy: integer; - toAdd: integer; - lines: array[0..3] of integer; - parts: array[0..3] of TGrayscaleMask; - n,nbLines: integer; - alphaMax: UInt32or64; - pmask: PByte; - fx: TBGRATextEffect; - FxFont: TFont; - prevCenter, newCenter, diffCenter: single; - xThird: integer; - -begin - useClearType:= mode in[irClearTypeRGB,irClearTypeBGR]; - clearTypeRGBOrder := mode <> irClearTypeBGR; - deltaX := xf-floor(xf); - x := round(floor(xf)); - - FxFont := TFont.Create; - FxFont.Assign(AFont); - FxFont.Height := fxFont.Height*FontAntialiasingLevel; - metric := GetLCLFontPixelMetric(FxFont); - if not metric.Defined or (metric.Lineheight < 8*FontAntialiasingLevel) or (metric.Lineheight >= 24*FontAntialiasingLevel) then - begin - fxFont.Free; - if useClearType then - begin - if ClearTypeRGBOrder then - BGRATextOut(bmp, AFont, fqFineClearTypeRGB, xf,yf, text, color, tex, align) - else - BGRATextOut(bmp, AFont, fqFineClearTypeBGR, xf,yf, text, color, tex, align) - end else - BGRATextOut(bmp, AFont, fqFineAntialiasing, xf,yf, text, color, tex, align); - exit; - end; - - if (metric.Baseline-metric.xLine) mod FontAntialiasingLevel >= FontAntialiasingLevel div 3 then - begin - toAdd := FontAntialiasingLevel- ((metric.Baseline-metric.xLine) mod FontAntialiasingLevel); - for yb := 1 to toAdd div 2 do - begin - if metric.xLine > 0 then dec(metric.xLine); - if metric.Baseline < metric.Lineheight then inc(metric.Baseline); - end; - end; - if metric.CapLine >= metric.xLine then metric.CapLine := -1 else - begin - if (metric.xLine-metric.CapLine) mod FontAntialiasingLevel >= FontAntialiasingLevel div 2 then - begin - toAdd := FontAntialiasingLevel - (metric.xLine-metric.CapLine) mod FontAntialiasingLevel; - dec(metric.CapLine, toAdd); - if metric.CapLine <= 0 then metric.CapLine := -1; - end; - end; - - nbLines := 0; - lines[nbLines] := metric.CapLine+1; - inc(nbLines); - lines[nbLines] := metric.xLine+1; - inc(nbLines); - lines[nbLines] := metric.Baseline+1; - inc(nbLines); - lines[nbLines] := metric.Lineheight+1; - inc(nbLines); - - if not useClearType then - fx := TBGRATextEffect.Create(text,FxFont,False,deltaX*FontAntialiasingLevel,0,FontAntialiasingLevel,FontAntialiasingLevel) else - fx := TBGRATextEffect.Create(text,FxFont,False,0,0,3,0); - - if fx.TextMask = nil then - begin - fx.Free; - FxFont.Free; - exit; - end; - alphaMax := 0; - prevCenter := 0; - newCenter := 0; - for yb := 0 to nbLines-1 do - begin - if yb= 0 then fromy := 0 - else fromy := lines[yb-1]; - - if lines[yb] > fromy then - begin - if useClearType then - parts[yb] := TGrayscaleMask.CreateDownSample(fx.TextMask, - round(fx.TextMask.Width / FontAntialiasingLevel * 3), - round((lines[yb] - fromy) / FontAntialiasingLevel), - rect(0, fromy, fx.TextMask.Width, lines[yb]) ) - else - parts[yb] := TGrayscaleMask.CreateDownSample(fx.TextMask, - round(fx.TextMask.Width / FontAntialiasingLevel), - round((lines[yb] - fromy) / FontAntialiasingLevel), - rect(0, fromy, fx.TextMask.Width, lines[yb]) ); - - if alphaMax < 255 then - begin - pmask := parts[yb].Data; - for n := parts[yb].NbPixels-1 downto 0 do - begin - if pmask^ > alphaMax then alphaMax := pmask^; - inc(pmask); - end; - end; - - if yb < 2 then - begin - IncF(newCenter, parts[yb].Height); - IncF(prevCenter, lines[yb]-fromy); - end else - if yb = 2 then - begin - IncF(newCenter, parts[yb].Height/2); - IncF(prevCenter, (lines[yb]-fromy)/2); - end; - end else - parts[yb] := nil; - end; - - prevCenter := prevCenter / FontAntialiasingLevel; - diffCenter := prevCenter-newCenter; - y := round( yf + diffCenter ); - - xThird := 0; - if useClearType then - begin - case align of - taCenter: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel+deltaX)*3); - taRightJustify: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel+deltaX)*3); - else xThird:= xThird+round((fx.TextMaskOffset.x/FontAntialiasingLevel+deltaX)*3); - end; - end else - begin - case align of - taCenter: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel); - taRightJustify: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel); - else x:= x+round(fx.TextMaskOffset.x/FontAntialiasingLevel); - end; - end; - cury := y+round(fx.TextMaskOffset.y/FontAntialiasingLevel); - for yb := 0 to nbLines-1 do - if parts[yb] <> nil then - begin - if (alphaMax > 0) and (alphaMax < 255) then - begin - pmask := parts[yb].data; - for n := parts[yb].NbPixels-1 downto 0 do - begin - pmask^ := pmask^*255 div alphaMax; - inc(pmask); - end; - end; - if useClearType then - BGRAFillClearTypeGrayscaleMask(bmp,x,cury,xThird,parts[yb],color,tex,ClearTypeRGBOrder) - else if mode = irMask then - parts[yb].Draw(bmp,x,cury) - else - begin - if tex <> nil then - parts[yb].DrawAsAlpha(bmp,x,cury,tex) else - parts[yb].DrawAsAlpha(bmp,x,cury,color); - end; - inc(cury,parts[yb].Height); - parts[yb].Free; - end; - - fx.Free; - FxFont.Free; -end; - -procedure BGRAReplace(var Destination: TBGRACustomBitmap; Temp: TObject); -begin - Destination.Free; - Destination := Temp as TBGRACustomBitmap; -end; - -function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel; - AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True; - AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap; -var - bmpOut,bmpSdw: TBGRACustomBitmap; OutTxtSize: TSize; OutX,OutY: Integer; -begin - bmpOut:= BGRABitmapFactory.Create(AWidth,AHeight); - bmpOut.FontAntialias:= True; - bmpOut.FontHeight:= AFontHeight; - bmpOut.FontStyle:= AFontStyle; - bmpOut.FontName:= AFontName; - bmpOut.FontQuality:= AFontQuality; - - OutTxtSize:= bmpOut.TextSize(AText); - OutX:= Round(AWidth/2) - Round(OutTxtSize.cx/2); - OutY:= Round(AHeight/2) - Round(OutTxtSize.cy/2); - - bmpSdw:= BGRABitmapFactory.Create(OutTxtSize.cx+2*ARadius,OutTxtSize.cy+2*ARadius); - bmpSdw.FontAntialias:= True; - bmpSdw.FontHeight:= AFontHeight; - bmpSdw.FontStyle:= AFontStyle; - bmpSdw.FontName:= AFontName; - bmpSdw.FontQuality:= AFontQuality; - - bmpSdw.TextOut(ARadius,ARadius,AText,AShadowColor); - BGRAReplace(bmpSdw,bmpSdw.FilterBlurRadial(ARadius,rbFast)); - bmpOut.PutImage(OutX+AOffSetX-ARadius,OutY+AOffSetY-ARadius,bmpSdw,dmDrawWithTransparency); - bmpSdw.Free; - - if AShowText = True then bmpOut.TextOut(OutX,OutY,AText,ATextColor); - - Result:= bmpOut; -end; - -{ TBGRATextEffectFontRenderer } - -function TBGRATextEffectFontRenderer.GetShaderLightPosition: TPoint; -begin - if FShader = nil then - result := point(0,0) - else - result := FShader.LightPosition; -end; - -function TBGRATextEffectFontRenderer.GetShaderLightPositionF: TPointF; -begin - if FShader = nil then - result := pointF(0,0) - else - result := FShader.LightPositionF; -end; - -function TBGRATextEffectFontRenderer.GetVectorizedRenderer: TBGRAVectorizedFontRenderer; -begin - FVectorizedRenderer.FontEmHeight := FontEmHeight; - FVectorizedRenderer.FontName := FontName; - FVectorizedRenderer.FontOrientation:= FontOrientation; - FVectorizedRenderer.FontQuality := FontQuality; - FVectorizedRenderer.FontStyle:= FontStyle; - - FVectorizedRenderer.ShadowColor := ShadowColor; - FVectorizedRenderer.ShadowVisible := ShadowVisible; - FVectorizedRenderer.ShadowOffset := ShadowOffset; - FVectorizedRenderer.ShadowRadius := ShadowRadius; - - FVectorizedRenderer.OutlineColor := OutlineColor; - FVectorizedRenderer.OutlineVisible := OutlineVisible; - FVectorizedRenderer.OutlineWidth := OutlineWidth; - FVectorizedRenderer.OutlineTexture := OutlineTexture; - FVectorizedRenderer.OuterOutlineOnly := OuterOutlineOnly; - FVectorizedRenderer.OutlineJoin := OutlineJoin; - result := FVectorizedRenderer; -end; - -procedure TBGRATextEffectFontRenderer.SetShaderLightPosition(const AValue: TPoint); -begin - if FShader <> nil then - FShader.LightPosition := AValue; -end; - -procedure TBGRATextEffectFontRenderer.SetShaderLightPositionF(const AValue: TPointF); -begin - if FShader <> nil then - FShader.LightPositionF := AValue; -end; - -function TBGRATextEffectFontRenderer.ShadowActuallyVisible: boolean; -begin - result := ShadowVisible and (ShadowColor.alpha <> 0); -end; - -function TBGRATextEffectFontRenderer.ShaderActuallyActive: boolean; -begin - result := (FShader <> nil) and ShaderActive; -end; - -function TBGRATextEffectFontRenderer.OutlineActuallyVisible: boolean; -begin - result := (OutlineWidth <> 0) and ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible; -end; - -procedure TBGRATextEffectFontRenderer.Init; -begin - ShaderActive := true; - - ShadowColor := BGRABlack; - ShadowVisible := false; - ShadowOffset := Point(5,5); - ShadowRadius := 5; - ShadowQuality:= rbFast; - - OutlineColor := BGRAPixelTransparent; - OutlineVisible := True; - OutlineWidth:= DefaultOutlineWidth; - OuterOutlineOnly:= false; - OutlineJoin := pjsMiter; - FVectorizedRenderer := TBGRAVectorizedFontRenderer.Create; -end; - -function TBGRATextEffectFontRenderer.VectorizedFontNeeded(AOrientation: integer): boolean; - function IsBigFont: boolean; - var textsz: TSize; - begin - textsz := inherited InternalTextSize('Hg',False); - result := (not OutlineActuallyVisible and (textsz.cy >= 24)) or - (OutlineActuallyVisible and (textsz.cy > 42)); - end; -var bAntialiasing, bSpecialOutline, bOriented, bEffectVectorizedSupported: boolean; -begin - bAntialiasing := FontQuality in [fqFineAntialiasing,fqFineClearTypeRGB,fqFineClearTypeBGR]; - bSpecialOutline:= OutlineActuallyVisible and (abs(OutlineWidth) <> DefaultOutlineWidth); - bOriented := AOrientation <> 0; - bEffectVectorizedSupported := OutlineActuallyVisible or ShadowActuallyVisible or ShaderActuallyActive; - result := bSpecialOutline or - (bAntialiasing and IsBigFont) or - (bOriented and bEffectVectorizedSupported); -end; - -procedure TBGRATextEffectFontRenderer.InternalTextOutAngle( - ADest: TBGRACustomBitmap; x, y: single; AOrientation: integer; sUTF8: string; - c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; - AShowPrefix: boolean = false; ARightToLeft: boolean = false); - - procedure DrawFX(fx: TBGRATextEffect; x,y: single; outline: boolean); - procedure DoOutline; - begin - if OutlineActuallyVisible then - begin - if OutlineTexture <> nil then - fx.DrawOutline(ADest,round(x),round(y), OutlineTexture, align) - else - fx.DrawOutline(ADest,round(x),round(y), OutlineColor, align); - end; - end; - begin - if ShadowActuallyVisible then - begin - fx.ShadowQuality := ShadowQuality; - fx.DrawShadow(ADest,round(x)+ShadowOffset.X,round(y)+ShadowOffset.Y,ShadowRadius,ShadowColor, align); - end; - if outline and OuterOutlineOnly then DoOutline; - if texture <> nil then - begin - if ShaderActuallyActive then - fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture, align) - else - fx.Draw(ADest,round(x),round(y), texture, align); - end else - begin - if ShaderActuallyActive then - fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), c, align) - else - fx.Draw(ADest,round(x),round(y), c, align); - end; - if outline and not OuterOutlineOnly then DoOutline; - end; - - procedure ComplexVectorized; - var - p: TBGRAPath; - w: single; - f: TBGRAMultishapeFiller; - s: TBGRAPenStroker; - mask, shaded: TBGRACustomBitmap; - boundsF: TRectF; - b: TRect; - fx: TBGRATextEffect; - oldShaderLightPos: TPoint; - h: integer; - begin - p := TBGRAPath.Create; - try - p.translate(x-0.5,y-0.5); - p.rotateDeg(-AOrientation/10); - VectorizedFontRenderer.CopyTextPathTo(p,0,0,sUTF8,align,ARightToLeft); - if abs(OutlineWidth) < 3 then - w := abs(OutlineWidth)*2/3 - else - w := abs(OutlineWidth)-1; - if p.IsEmpty then - boundsF := EmptyRectF - else - begin - boundsF := p.GetBounds; - DecF(boundsF.Left, 1); - DecF(boundsF.Top, 1); - IncF(boundsF.Right, 1); - IncF(boundsF.Bottom, 1); - if ShadowActuallyVisible then - begin - DecF(boundsF.Left, ShadowRadius); - DecF(boundsF.Top, ShadowRadius); - IncF(boundsF.Right, ShadowRadius); - IncF(boundsF.Bottom, ShadowRadius); - end; - boundsF := TRectF.Intersect(boundsF, RectF(0,0,ADest.Width,ADest.Height)); - end; - if not boundsF.IsEmpty then - begin - with boundsF do - b := rect(floor(left),floor(top),ceil(right),ceil(bottom)); - shaded := nil; - try - if ShaderActuallyActive or ShadowActuallyVisible then - begin - mask := BGRABitmapFactory.Create(b.Width,b.Height,BGRABlack); - try - mask.LinearAntialiasing:= true; - mask.FillPath(p, AffineMatrixTranslation(-b.Left,-b.Top), BGRAWhite); - fx := TBGRATextEffect.Create(mask, false, mask.Width,mask.Height, Point(0,0)); - if ShaderActuallyActive then - begin - shaded := ADest.NewBitmap(mask.Width,mask.Height); - oldShaderLightPos := Shader.LightPosition; - Shader.LightPosition := Point(Shader.LightPosition.X - b.Left, - Shader.LightPosition.Y - b.Top); - h := VectorizedFontRenderer.TextSize('Hg').cy; - if texture <> nil then - fx.DrawShaded(shaded, 0,0, Shader, round(h*0.05), texture, taLeftJustify) - else - fx.DrawShaded(shaded, 0,0, Shader, round(h*0.05), c, taLeftJustify); - Shader.LightPosition := oldShaderLightPos; - shaded.AlphaFill(255); - shaded.ScanOffset := Point(-b.Left,-b.Top); - end; - if ShadowActuallyVisible then - begin - fx.ShadowQuality := ShadowQuality; - fx.DrawShadow(ADest,b.Left+ShadowOffset.X,b.Top+ShadowOffset.Y,ShadowRadius,ShadowColor, taLeftJustify); - end; - fx.Free; - finally - mask.Free; - end; - end; - s := nil; - f := TBGRAMultishapeFiller.Create; - if shaded<>nil then - f.AddPathFill(p, shaded) else - if texture<>nil then - f.AddPathFill(p, texture) - else - f.AddPathFill(p, c); - if OutlineActuallyVisible then - begin - s := TBGRAPenStroker.Create; - f.AddPathStroke(p, OutlineColor, w, s); - end; - if OuterOutlineOnly then - f.PolygonOrder:= poFirstOnTop - else - f.PolygonOrder:= poLastOnTop; - if ADest.LinearAntialiasing then - f.Draw(ADest, dmLinearBlend) - else - f.Draw(ADest, dmDrawWithTransparency); - f.Free; - s.Free; - finally - shaded.Free; - end; - end; - finally - p.Free; - end; - end; - -var fx: TBGRATextEffect; -begin - if VectorizedFontNeeded(AOrientation) then - begin - if ShaderActuallyActive or ShadowActuallyVisible then - ComplexVectorized else - begin - if texture<>nil then - VectorizedFontRenderer.TextOutAngle(ADest,x,y,AOrientation,sUTF8,texture,align,ARightToLeft) - else - VectorizedFontRenderer.TextOutAngle(ADest,x,y,AOrientation,sUTF8,c,align,ARightToLeft); - end; - end else - if (AOrientation = 0) and (ShaderActuallyActive or ShadowActuallyVisible or OutlineActuallyVisible) then - begin - fx := TBGRATextEffect.Create(sUTF8, FFont, - FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB], - x-floor(x), y-floor(y)); - DrawFX(fx, x,y, true); - fx.Free; - end else - inherited InternalTextOutAngle(ADest,x,y,AOrientation,sUTF8,c,texture,align,AShowPrefix,ARightToLeft); -end; - -constructor TBGRATextEffectFontRenderer.Create; -begin - inherited Create; - FShader := nil; - FShaderOwner:= false; - Init; -end; - -constructor TBGRATextEffectFontRenderer.Create(AShader: TCustomPhongShading; - AShaderOwner: boolean); -begin - inherited Create; - Init; - FShader := AShader; - FShaderOwner := AShaderOwner; -end; - -destructor TBGRATextEffectFontRenderer.Destroy; -begin - if FShaderOwner then FShader.Free; - FVectorizedRenderer.Free; - inherited Destroy; -end; - -function TBGRATextEffectFontRenderer.TextSize(sUTF8: string): TSize; -begin - if VectorizedFontNeeded(0) then - result := VectorizedFontRenderer.TextSize(sUTF8) - else - result := inherited TextSize(sUTF8); -end; - -function TBGRATextEffectFontRenderer.TextSizeAngle(sUTF8: string; - orientationTenthDegCCW: integer): TSize; -begin - if VectorizedFontNeeded(orientationTenthDegCCW) then - result := VectorizedFontRenderer.TextSizeAngle(sUTF8, orientationTenthDegCCW) - else - result := inherited TextSizeAngle(sUTF8, orientationTenthDegCCW); -end; - -function TBGRATextEffectFontRenderer.TextSize(sUTF8: string; - AMaxWidth: integer; ARightToLeft: boolean): TSize; -begin - if VectorizedFontNeeded(FontOrientation) then - result := VectorizedFontRenderer.TextSize(sUTF8, AMaxWidth, ARightToLeft) - else - result := inherited TextSize(sUTF8, AMaxWidth, ARightToLeft); -end; - -function TBGRATextEffectFontRenderer.TextFitInfo(sUTF8: string; - AMaxWidth: integer): integer; -begin - if VectorizedFontNeeded(FontOrientation) then - result := VectorizedFontRenderer.TextFitInfo(sUTF8, AMaxWidth) - else - result := inherited TextFitInfo(sUTF8, AMaxWidth) -end; - -{ TBGRATextEffect } - -procedure TBGRATextEffect.InitImproveReadability(AText: string; Font: TFont; - SubOffsetX, SubOffsetY: single); -var size: TSize; - overhang: integer; - temp: TBGRACustomBitmap; -begin - FShadowQuality:= rbFast; - if SubOffsetX < 0 then SubOffsetX := 0; - if SubOffsetY < 0 then SubOffsetY := 0; - size := BGRATextSize(Font, fqFineAntialiasing, AText, FontAntialiasingLevel); - FTextSize := size; - if size.cy = 0 then FTextSize.cy := BGRATextSize(Font, fqFineAntialiasing, 'Hg', FontAntialiasingLevel).cy; - overhang := size.cy div 2; - inc(size.cx, 2*overhang + ceil(SubOffsetX) ); - inc(size.cy, 2 + ceil(SubOffsetY) ); - - FOffset := Point(-overhang,-1); //include overhang - temp := BGRABitmapFactory.Create(size.cx, size.cy, BGRABlack); - BGRATextOutImproveReadability(temp, Font, overhang+SubOffsetX,1+SubOffsetY, AText, BGRAWhite, nil, taLeftJustify, irMask); - FTextMask := TGrayscaleMask.Create; - FTextMask.CopyFrom(temp, cGreen); - temp.Free; -end; - -constructor TBGRATextEffect.Create(AText: string; Font: TFont; - Antialiasing: boolean; SubOffsetX,SubOffsetY: single); -begin - Init(AText, Font, Antialiasing, SubOffsetX, SubOffsetY, 0,0); -end; - -constructor TBGRATextEffect.Create(AText: string; Font: TFont; - Antialiasing: boolean; SubOffsetX, SubOffsetY: single; GrainX, GrainY: Integer - ); -begin - Init(AText, Font, Antialiasing, SubOffsetX, SubOffsetY, GrainX, GrainY); -end; - -constructor TBGRATextEffect.Create(AText: string; AFontName: string; - AFullHeight: integer; Antialiasing: boolean); -begin - InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, 0, 0); -end; - -constructor TBGRATextEffect.Create(AText: string; AFontName: string; - AFullHeight: integer; Antialiasing: boolean; SubOffsetX, SubOffsetY: single); -begin - InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, SubOffsetX, SubOffsetY); -end; - -constructor TBGRATextEffect.Create(AText: string; AFontName: string; - AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean); -begin - InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, 0, 0); -end; - -constructor TBGRATextEffect.Create(AText: string; AFontName: string; - AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX, - SubOffsetY: single); -begin - InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, SubOffsetX, SubOffsetY); -end; - -procedure TBGRATextEffect.Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer); -const FXAntialiasingLevel = FontAntialiasingLevel; -var temp: TBGRACustomBitmap; - tempBmp: TBitmap; - size: TSize; - p: PByte; - n,v,maxAlpha: integer; - alpha: byte; - sizeX,sizeY: integer; - onePixel: integer; - quality: TBGRAFontQuality; - iSubX,iSubY: integer; -begin - if IsLclFontRendererFine then Antialiasing := false; - FShadowQuality := rbFast; - if Antialiasing and Assigned(BGRATextOutImproveReadabilityProc) then - begin - InitImproveReadability(AText, Font, SubOffsetX,SubOffsetY); - exit; - end; - if Antialiasing and not IsLclFontRendererFine then - quality := fqFineAntialiasing - else - quality := fqSystem; - size := BGRAOriginalTextSize(Font,quality,AText,FXAntialiasingLevel); - if (size.cx = 0) or (size.cy = 0) then - begin - size := BGRATextSize(Font,quality,'Hg',FXAntialiasingLevel); - FTextSize.cx := 0; - FTextSize.cy := size.cy; - FOffset := Point(0,0); - exit; - end; - FTextSize := size; - - sizeX := size.cx+size.cy; - sizeY := size.cy; - - iSubX := 0; - iSubY := 0; - if SubOffsetX < 0 then SubOffsetX := 0; - if SubOffsetY < 0 then SubOffsetY := 0; - - if Antialiasing then - begin - sizeX := (sizeX + FXAntialiasingLevel-1); - dec(sizeX, sizeX mod FXAntialiasingLevel); - - sizeY := (sizeY + FXAntialiasingLevel-1); - dec(sizeY, sizeY mod FXAntialiasingLevel); - - if SubOffsetX <> 0 then - begin - inc(sizeX, ceil(SubOffsetX*FXAntialiasingLevel) ); - iSubX := round(SubOffsetX*FXAntialiasingLevel); - end; - if SubOffsetY <> 0 then - begin - inc(sizeY, ceil(SubOffsetY*FXAntialiasingLevel) ); - iSubY := round(SubOffsetY*FXAntialiasingLevel); - end; - - OnePixel := FXAntialiasingLevel; - end else - begin - OnePixel := 1; - - if SubOffsetX <> 0 then - begin - iSubX := round(SubOffsetX); - inc(sizeX, iSubX); - end; - if SubOffsetY <> 0 then - begin - iSubY := round(SubOffsetY); - inc(sizeY, iSubY); - end; - end; - FOffset := Point(-size.cy div 2,-OnePixel); //include overhang - - if GrainX > 0 then - begin - SizeX := SizeX+ (GrainX-1); - dec(SizeX, SizeX mod GrainX); - end; - if GrainY > 0 then - begin - SizeY := SizeY+ (GrainY-1); - dec(SizeY, SizeY mod GrainY); - end; - if RenderTextOnBitmap then - begin - tempBmp := TBitmap.Create; - tempBmp.Width := sizeX; - tempBmp.Height := sizeY+2*OnePixel; - BitmapFillRect(tempBmp, rect(0,0,tempBmp.Width,tempBmp.Height), clBlack); - tempBmp.Canvas.Font := Font; - tempBmp.Canvas.Font.Orientation := 0; - tempBmp.Canvas.Font.Height := Font.Height*OnePixel; - tempBmp.Canvas.Font.Color := clWhite; - tempBmp.Canvas.Font.Quality := FontDefaultQuality; - BitmapTextOut(tempBmp, Point(-FOffset.X+iSubX, -FOffset.Y+iSubY), AText); - temp := BGRABitmapFactory.Create(tempBmp); - tempBmp.Free; - end else - begin - temp := BGRABitmapFactory.Create(sizeX, sizeY+2*OnePixel,clBlack); - temp.Canvas.Font := Font; - temp.Canvas.Font.Orientation := 0; - temp.Canvas.Font.Height := Font.Height*OnePixel; - temp.Canvas.Font.Color := clWhite; - temp.Canvas.Font.Quality := FontDefaultQuality; - BitmapTextOut(temp.Bitmap, Point(-FOffset.X+iSubX, -FOffset.Y+iSubY), AText); - end; - - if Antialiasing then - begin - FTextSize.cx := round(FTextSize.cx/FXAntialiasingLevel); - FTextSize.cy := round(FTextSize.cy/FXAntialiasingLevel); - FOffset := Point(round(FOffset.X/FXAntialiasingLevel),round(FOffset.Y/FXAntialiasingLevel)); - - FTextMask := TGrayscaleMask.CreateDownSample(temp, round(temp.width/FXAntialiasingLevel), - round(temp.Height/FXAntialiasingLevel)); - temp.Free; - - maxAlpha := 0; - p := FTextMask.Data; - for n := FTextMask.NbPixels - 1 downto 0 do - begin - alpha := P^; - if alpha > maxAlpha then maxAlpha := alpha; - Inc(p); - end; - if maxAlpha <> 0 then - begin - p := FTextMask.Data; - for n := FTextMask.NbPixels - 1 downto 0 do - begin - p^:= integer(p^ * 255) div maxAlpha; - Inc(p); - end; - end; - end - else - begin - FTextMask := TGrayscaleMask.Create(temp, cGreen); - temp.Free; - - p := FTextMask.data; - for n := FTextMask.NbPixels-1 downto 0 do - p^ := GammaExpansionTab[p^] shr 8; - end; -end; - -procedure TBGRATextEffect.InitWithFontName(AText: string; AFontName: string; - AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX, SubOffsetY: single); -var lFont: TFont; -begin - lFont := TFont.Create; - lFont.Name := AFontName; - lFont.Height := AFullHeight * FontFullHeightSign; - lFont.Style := AStyle; - Init(AText, lFont, Antialiasing, SubOffsetX, SubOffsetY, 0,0); - lFont.Free; -end; - -constructor TBGRATextEffect.Create(AText: string; Font: TFont; - Antialiasing: boolean); -begin - Init(AText, Font, Antialiasing, 0,0,0,0); -end; - -initialization - - BGRATextOutImproveReadabilityProc := @BGRATextOutImproveReadability; - -end. - diff --git a/components/bgrabitmap/bgrathumbnail.pas b/components/bgrabitmap/bgrathumbnail.pas deleted file mode 100644 index ce1d7ec..0000000 --- a/components/bgrabitmap/bgrathumbnail.pas +++ /dev/null @@ -1,520 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAThumbnail; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmap, BGRABitmapTypes, FPimage; - -function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; overload; -function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AFormat: TBGRAImageFormat; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; overload; -function GetFileThumbnail(AFilenameUTF8: string; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetStreamThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ASuggestedExtensionUTF8: string = ''; ADest: TBGRABitmap= nil): TBGRABitmap; overload; -function GetStreamThumbnail(AStream: TStream; AReader: TFPCustomImageReader; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; overload; - -function GetOpenRasterThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetLazPaintThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetPhoxoThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetJpegThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetPsdThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetPngThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetPaintDotNetThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetBmpThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetCurThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; - -function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetTargaThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetTiffThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetGifThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetXwdThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetXPixMapThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -function GetBmpMioMapThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; - -procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean = false); -procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean; AScale: single); - -var - ImageCheckersColor1,ImageCheckersColor2 : TBGRAPixel; - IconCheckersColor1,IconCheckersColor2 : TBGRAPixel; - CheckersScale: single = 1; - -implementation - -uses base64, BGRAUTF8, - DOM, XMLRead, BGRAReadJPEG, BGRAReadPng, BGRAReadGif, BGRAReadBMP, - BGRAReadPSD, BGRAReadIco, UnzipperExt, BGRAReadLzp; - -procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; - AIconCheckers: boolean); -begin - DrawThumbnailCheckers(bmp, ARect, AIconCheckers, CheckersScale); -end; - -procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean; AScale: single); -begin - if AIconCheckers then - bmp.DrawCheckers(ARect, IconCheckersColor1, IconCheckersColor2, round(8*AScale), round(8*AScale)) - else - bmp.DrawCheckers(ARect, ImageCheckersColor1, ImageCheckersColor2, round(8*AScale), round(8*AScale)); -end; - -function InternalGetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; - ADest: TBGRABitmap; AVerticalShrink: single = 1; AHorizShrink: single = 1; AShowHotSpot: boolean = false; ADarkCheckers: boolean = false): TBGRABitmap; -var - factorX, factorY, factor: single; - xIcon,yIcon,wIcon,hIcon: Integer; - hotspot: TPoint; -begin - result := nil; - try - if (ABitmap <> nil) and (ABitmap.Width <> 0) and (ABitmap.Height <> 0) then - begin - If Assigned(ADest) then - begin - result := ADest; - result.SetSize(AWidth,AHeight); - result.Fill(ABackColor); - end else - result := TBGRABitmap.Create(AWidth,AHeight,ABackColor); - factorX := result.Width/(ABitmap.Width*AHorizShrink); - factorY := result.Height/(ABitmap.Height*AVerticalShrink); - if factorX < factorY then factor := factorX else factor := factorY; - wIcon := round(ABitmap.Width*AHorizShrink*factor); - if wIcon = 0 then wIcon := 1; - hIcon := round(ABitmap.Height*AVerticalShrink*factor); - if hIcon = 0 then hIcon := 1; - xIcon:= (result.Width-wIcon) div 2; - yIcon:= (result.Height-hIcon) div 2; - if ACheckers then DrawThumbnailCheckers(result,Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ADarkCheckers,CheckersScale); - if AShowHotSpot and (wIcon > 0) and (hIcon > 0) then - begin - hotspot := Point(xIcon+ABitmap.HotSpot.X*wIcon div ABitmap.Width,yIcon+ABitmap.HotSpot.Y*hIcon div ABitmap.Height); - result.HorizLine(xIcon,hotspot.y-1,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency); - result.HorizLine(xIcon,hotspot.y,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency); - result.HorizLine(xIcon,hotspot.y+1,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency); - result.VertLine(hotspot.x-1,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency); - result.VertLine(hotspot.x,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency); - result.VertLine(hotspot.x+1,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency); - end; - if (ABackColor.alpha <> 0) or ACheckers then - result.StretchPutImage(Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ABitmap,dmDrawWithTransparency) else - result.StretchPutImage(Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ABitmap,dmSet); - if AShowHotSpot and (wIcon > 0) and (hIcon > 0) then - begin - result.HorizLine(xIcon,yIcon+ABitmap.HotSpot.Y*hIcon div ABitmap.Height,xIcon+wIcon-1,BGRA(255,0,255,96),dmDrawWithTransparency); - result.VertLine(xIcon+ABitmap.HotSpot.X*wIcon div ABitmap.Width,yIcon,yIcon+hIcon-1,BGRA(255,0,255,96),dmDrawWithTransparency); - end; - end; - except - end; -end; - -function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap = nil; - AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; -begin - result := InternalGetBitmapThumbnail(ABitmap,AWidth,AHeight,ABackColor,ACheckers,ADest,AVerticalShrink,AHorizShrink, - false,false); -end; - -function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AFormat: TBGRAImageFormat; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap = nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; -begin - result := InternalGetBitmapThumbnail(ABitmap,AWidth,AHeight,ABackColor,ACheckers,ADest,AVerticalShrink,AHorizShrink, - AFormat = ifCur, AFormat in[ifCur,ifIco]); - -end; - -function GetFileThumbnail(AFilenameUTF8: string; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var stream: TFileStreamUTF8; -begin - result := nil; - try - stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite); - except - exit; - end; - try - result := GetStreamThumbnail(stream, AWidth,AHeight,ABackColor,ACheckers,ExtractFileExt(AFilenameUTF8),ADest); - finally - stream.free; - end; -end; - -function GetStreamThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ASuggestedExtensionUTF8: string; - ADest: TBGRABitmap): TBGRABitmap; -var - ff: TBGRAImageFormat; - reader: TFPCustomImageReader; -begin - ff := DetectFileFormat(AStream,ASuggestedExtensionUTF8); - case ff of - ifJpeg: result := GetJpegThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - ifIco: result := GetIcoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - ifCur: result := GetCurThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - ifPaintDotNet: result := GetPaintDotNetThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - ifLazPaint: result := GetLazPaintThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - ifOpenRaster: result := GetOpenRasterThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - ifPhoxo: result := GetPhoxoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - ifPsd: result := GetPsdThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest); - else - begin - if (ff = ifUnknown) or (DefaultBGRAImageReader[ff] = nil) then - result := nil - else - begin - result := nil; - reader := nil; - try - reader := CreateBGRAImageReader(ff); - result := GetStreamThumbnail(AStream, reader, AWidth, AHeight, ABackColor, ACheckers, ADest); - finally - reader.Free; - end; - end; - end; - end; -end; - -function GetStreamThumbnail(AStream: TStream; AReader: TFPCustomImageReader; - AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; - ADest: TBGRABitmap): TBGRABitmap; -var - bmp: TBGRACustomBitmap; - AOriginalWidth, AOriginalHeight: integer; -begin - if AReader is TBGRAImageReader then - begin - bmp := nil; - try - bmp := TBGRAImageReader(AReader).GetBitmapDraft(AStream, AWidth,AHeight, AOriginalWidth,AOriginalHeight); - if Assigned(bmp) and (bmp.Height <> 0) and (bmp.Width <> 0) then - result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest, - AOriginalHeight/bmp.Height, AOriginalWidth/bmp.Width); - except - result := nil; - end; - bmp.free; - exit; - end; - - bmp := TBGRABitmap.Create; - try - bmp.LoadFromStream(AStream, AReader); - except - FreeAndNil(bmp); - end; - if bmp = nil then - result := nil - else - begin - result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest); - bmp.Free; - end; -end; - -function GetOpenRasterThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - unzip: TUnzipperStreamUtf8; - png: TMemoryStream; -begin - result := nil; - unzip := TUnzipperStreamUtf8.Create; - try - unzip.InputStream := AStream; - png := TMemoryStream.Create; - try - if unzip.UnzipFileToStream('Thumbnails\thumbnail.png', png, False) then - begin - png.Position:= 0; - result := GetPngThumbnail(png,AWidth,AHeight,ABackColor,ACheckers,ADest); - end else - begin - png.Clear; - if unzip.UnzipFileToStream('mergedimage.png', png, False) then - begin - png.Position:= 0; - result := GetPngThumbnail(png,AWidth,AHeight,ABackColor,ACheckers,ADest); - end; - end; - finally - png.Free; - end; - except - end; - unzip.Free; -end; - -function GetLazPaintThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TBGRAReaderLazPaint; -begin - reader:= TBGRAReaderLazPaint.Create; - reader.WantThumbnail := true; - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); - reader.Free; -end; - -function GetPhoxoThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - if DefaultBGRAImageReader[ifPhoxo] = nil then - result := nil - else - begin - reader := CreateBGRAImageReader(ifPhoxo); - result := GetStreamThumbnail(AStream, reader, AWidth,AHeight,ABackColor,ACheckers,ADest); - reader.Free; - end; -end; - -function GetJpegThumbnail(AStream: TStream; AWidth, AHeight: integer - ; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - jpeg: TBGRAReaderJpeg; -begin - jpeg := TBGRAReaderJpeg.Create; - jpeg.Performance := jpBestSpeed; - jpeg.MinWidth := AWidth; - jpeg.MinHeight := AHeight; - result := GetStreamThumbnail(AStream, jpeg, AWidth,AHeight,ABackColor,ACheckers,ADest); - jpeg.Free; -end; - -function GetPsdThumbnail(AStream: TStream; AWidth, AHeight: integer - ; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - psd: TBGRAReaderPSD; - bmp: TBGRABitmap; -begin - psd:= TBGRAReaderPSD.Create; - psd.MinifyHeight:= AHeight; - bmp := TBGRABitmap.Create; - try - bmp.LoadFromStream(AStream, psd); - except - FreeAndNil(bmp); - end; - if bmp = nil then - result := nil - else - begin - result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest, psd.Height/bmp.Height); - bmp.Free; - end; - psd.Free; -end; - -function GetPngThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap; -var - pngFormat: TBGRAReaderPNG; -begin - pngFormat:= TBGRAReaderPNG.Create; - result:= GetStreamThumbnail(AStream, pngFormat, AWidth,AHeight, ABackColor, ACheckers, ADest); - pngFormat.Free; -end; - -function GetPaintDotNetThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - {%H-}magic: packed array[0..6] of byte; - xmlHeader: TMemoryStream; - xmlHeaderSize: longint; - doc: TXMLDocument; - custom,thumb,pngNode: TDOMNode; - png64: TStringStream; - decode64: TBase64DecodingStream; -begin - result := nil; - if AStream.Read({%H-}magic,sizeof(magic)) <> sizeof(magic) then exit; - if chr(magic[0])+chr(magic[1])+chr(magic[2])+chr(magic[3]) <> 'PDN3' then exit; - xmlHeaderSize := magic[4] + (magic[5] shl 8) + (magic[6] shl 16); - if xmlHeaderSize >= 10*1024*1024 then exit; - xmlHeader:= TMemoryStream.Create; - try - if xmlHeader.CopyFrom(AStream,xmlHeaderSize) <> xmlHeaderSize then - begin - xmlHeader.Free; - exit; - end; - except - xmlHeader.Free; - exit; - end; - xmlHeader.Position := 0; - try - XMLRead.ReadXMLFile(doc, xmlHeader); - except - xmlHeader.Free; - exit; - end; - xmlHeader.Free; - try - custom := doc.DocumentElement.FindNode('custom'); - if Assigned(custom) then - begin - thumb := custom.FindNode('thumb'); - if Assigned(thumb) then - begin - pngNode := thumb.Attributes.GetNamedItem('png'); - if Assigned(pngNode) then - begin - png64 := TStringStream.Create(string(pngNode.NodeValue)); - try - png64.Position := 0; - decode64 := TBase64DecodingStream.Create(png64); - try - result := GetPngThumbnail(decode64,AWidth,AHeight,ABackColor,ACheckers, ADest); - finally - decode64.Free; - end; - finally - png64.free; - end; - end; - end; - end; - except - end; - doc.Free; -end; - -function GetBmpThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - bmpFormat: TBGRAReaderBMP; -begin - bmpFormat:= TBGRAReaderBMP.Create; - result:= GetStreamThumbnail(AStream, bmpFormat, AWidth,AHeight, ABackColor, ACheckers, ADest); - bmpFormat.Free; -end; - -function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TBGRAReaderIco; - icoBmp: TBGRABitmap; -begin - result := nil; - reader := TBGRAReaderIco.Create; - reader.WantedWidth:= AWidth; - reader.WantedHeight:= AHeight; - icoBmp := TBGRABitmap.Create; - try - icoBmp.LoadFromStream(AStream, reader); - result := GetBitmapThumbnail(icoBmp, ifIco, AWidth, AHeight, ABackColor, ACheckers, ADest); - except - end; - icoBmp.Free; - reader.Free; -end; - -function GetCurThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TBGRAReaderCur; - icoBmp: TBGRABitmap; -begin - result := nil; - reader := TBGRAReaderCur.Create; - reader.WantedWidth:= AWidth; - reader.WantedHeight:= AHeight; - icoBmp := TBGRABitmap.Create; - try - icoBmp.LoadFromStream(AStream, reader); - result := GetBitmapThumbnail(icoBmp, ifCur, AWidth, AHeight, ABackColor, ACheckers, ADest); - except - end; - icoBmp.Free; - reader.Free; -end; - -function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - reader:= CreateBGRAImageReader(ifPcx); - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); - reader.Free; -end; - -function GetTargaThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - reader:= CreateBGRAImageReader(ifTarga); - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers, ADest); - reader.Free; -end; - -function GetTiffThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - reader:= CreateBGRAImageReader(ifTiff); - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); - reader.Free; -end; - -function GetGifThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - reader:= CreateBGRAImageReader(ifGif); - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers, ADest); - reader.Free; -end; - -function GetXwdThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - reader:= CreateBGRAImageReader(ifXwd); - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers, ADest); - reader.Free; -end; - -function GetXPixMapThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - reader:= CreateBGRAImageReader(ifXPixMap); - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); - reader.Free; -end; - -function GetBmpMioMapThumbnail(AStream: TStream; AWidth, AHeight: integer; - ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap; -var - reader: TFPCustomImageReader; -begin - reader:= CreateBGRAImageReader(ifBmpMioMap); - result := GetStreamThumbnail(AStream,reader,AWidth,AHeight,ABackColor,ACheckers,ADest); - reader.Free; -end; - -initialization - - IconCheckersColor1 := BGRA(140,180,180); - IconCheckersColor2 := BGRA(80,140,140); - - ImageCheckersColor1 := BGRA(255,255,255); - ImageCheckersColor2 := BGRA(220,220,220); - -end. diff --git a/components/bgrabitmap/bgratransform.pas b/components/bgrabitmap/bgratransform.pas deleted file mode 100644 index 87b5e6c..0000000 --- a/components/bgrabitmap/bgratransform.pas +++ /dev/null @@ -1,2051 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRATransform; - -{$mode objfpc} - -interface - -{ This unit contains bitmap transformations as classes and the TAffineMatrix record and functions. } - -uses - BGRAClasses, SysUtils, BGRABitmapTypes; - -type - { Contains an affine matrix, i.e. a matrix to transform linearly and translate TPointF coordinates } - TAffineMatrix = BGRABitmapTypes.TAffineMatrix; - { Contains an affine base and information on the resulting box } - TAffineBox = BGRABitmapTypes.TAffineBox; - - { TBGRAAffineScannerTransform allow to transform any scanner. To use it, - create this object with a scanner as parameter, call transformation - procedures, and finally, use the newly created object as a scanner. - - You can transform a gradient or a bitmap. See TBGRAAffineBitmapTransform - for bitmap specific transformation. } - - { TBGRAAffineScannerTransform } - - TBGRAAffineScannerTransform = class(TBGRACustomScanner) - protected - FScanner: IBGRAScanner; - FScanAtFunc: TScanAtFunction; - FCur: TPointF; - FEmptyMatrix: Boolean; - FMatrix: TAffineMatrix; - procedure SetMatrix(AMatrix: TAffineMatrix); - function InternalScanCurrentPixel: TBGRAPixel; virtual; - function GetViewMatrix: TAffineMatrix; - procedure SetViewMatrix(AValue: TAffineMatrix); - public - GlobalOpacity: Byte; - constructor Create(AScanner: IBGRAScanner); - procedure Reset; - procedure Invert; - procedure Translate(OfsX,OfsY: Single); - procedure RotateDeg(AngleCW: Single); - procedure RotateRad(AngleCCW: Single); - procedure MultiplyBy(AMatrix: TAffineMatrix); - procedure Fit(Origin,HAxis,VAxis: TPointF); virtual; - procedure Scale(sx,sy: single); overload; - procedure Scale(factor: single); overload; - function GetScanCustomColorspace: TColorspaceAny; override; - procedure ScanMoveTo(X, Y: Integer); override; - procedure ScanMoveToF(X, Y: single); inline; - function ScanNextPixel: TBGRAPixel; override; - procedure ScanSkipPixels(ACount: integer); override; - function ScanAt(X, Y: Single): TBGRAPixel; override; - property Matrix: TAffineMatrix read FMatrix write SetMatrix; - property ViewMatrix: TAffineMatrix read GetViewMatrix write SetViewMatrix; - end; - - { If you don't want the bitmap to repeats itself, or want to specify the - resample filter, or want to fit easily the bitmap on axes, - use TBGRAAffineBitmapTransform instead of TBGRAAffineScannerTransform } - - { TBGRAAffineBitmapTransform } - - TBGRAAffineBitmapTransform = class(TBGRAAffineScannerTransform) - protected - FBitmap: TBGRACustomBitmap; - FRepeatImageX,FRepeatImageY: boolean; - FResampleFilter : TResampleFilter; - FBuffer: PBGRAPixel; - FBufferSize: Int32or64; - FIncludeEdges: boolean; - procedure Init(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean= false; ARepeatImageY: Boolean= false; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); - public - constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImage: Boolean= false; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); overload; - constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean; ARepeatImageY: Boolean; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); overload; - destructor Destroy; override; - function InternalScanCurrentPixel: TBGRAPixel; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - function IsScanPutPixelsDefined: boolean; override; - procedure Fit(Origin, HAxis, VAxis: TPointF); override; - end; - - { TBGRAQuadLinearScanner } - - TBGRAQuadLinearScanner = class(TBGRACustomScanner) - private - FPadding: boolean; - FPoints,FVectors: array[0..3] of TPointF; - FInvLengths,FDets: array[0..3] of single; - FCoeffs: array[0..3] of TPointF; - aa,bb0,cc0,inv2aa: double; - FSource: IBGRAScanner; - FSourceMatrix: TAffineMatrix; - FUVVector: TPointF; - - ScanParaBB, ScanParaCC, ScanParaBBInv: double; - - ScanVertV0,ScanVertVStep0,ScanVertDenom0,ScanVertDenomStep0: double; - - FHasC1, FHasC2: boolean; - FShowC1, FShowC2: boolean; - FScanFunc: TScanNextPixelFunction; - FCurXF,FCurYF: single; - FBuffer: PBGRAPixel; - FBufferSize: Int32or64; - FTextureInterpolation: Boolean; - function GetCulling: TFaceCulling; - function ScanNone: TBGRAPixel; - function ScanGeneral: TBGRAPixel; - procedure PrepareScanVert0; - function ScanVert0: TBGRAPixel; - procedure PrepareScanPara; - function ScanPara: TBGRAPixel; - procedure GetTexColorAt(u,v: Single; out AColor: TBGRAPixel; out AIsPadding: boolean); inline; - function GetTexColorAt(u,v: Single; detNeg: boolean): TBGRAPixel; inline; - procedure ScanMoveToF(X,Y: single); inline; - procedure SetCulling(AValue: TFaceCulling); - procedure Init(ASource: IBGRAScanner; const APoints: array of TPointF; - ATextureInterpolation: boolean); - public - function ScanAt(X, Y: Single): TBGRAPixel; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - function IsScanPutPixelsDefined: boolean; override; - procedure ScanMoveTo(X, Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - procedure ScanSkipPixels(ACount: integer); override; - constructor Create(ASource: IBGRAScanner; - ASourceMatrix: TAffineMatrix; const APoints: array of TPointF; - ATextureInterpolation: boolean = true); overload; - constructor Create(ASource: IBGRAScanner; - const ATexCoords: array of TPointF; const APoints: array of TPointF; - ATextureInterpolation: boolean = true); overload; - destructor Destroy; override; - property Culling: TFaceCulling read GetCulling write SetCulling; - property Padding: boolean read FPadding write FPadding; - end; - - { TBGRABitmapScanner } - - TBGRABitmapScanner = class(TBGRACustomScanner) - protected - FSource: TBGRACustomBitmap; - FRepeatX,FRepeatY: boolean; - FScanline: PBGRAPixel; - FCurX: integer; - FOrigin: TPoint; - public - constructor Create(ASource: TBGRACustomBitmap; ARepeatX,ARepeatY: boolean; AOrigin: TPoint); - procedure ScanMoveTo(X, Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - function ScanAt(X, Y: Single): TBGRAPixel; override; - procedure ScanSkipPixels(ACount: integer); override; - end; - - { TBGRAExtendedBorderScanner } - - TBGRAExtendedBorderScanner = class(TBGRACustomScanner) - protected - FSource: IBGRAScanner; - FBounds: TRect; - public - constructor Create(ASource: IBGRAScanner; ABounds: TRect); - function ScanAt(X,Y: Single): TBGRAPixel; override; - end; - - { TBGRAScannerOffset } - - TBGRAScannerOffset = class(TBGRACustomScanner) - protected - FSource: IBGRAScanner; - FOffset: TPoint; - public - constructor Create(ASource: IBGRAScanner; AOffset: TPoint); - destructor Destroy; override; - procedure ScanMoveTo(X, Y: Integer); override; - function ScanNextPixel: TBGRAPixel; override; - function ScanAt(X, Y: Single): TBGRAPixel; override; - function IsScanPutPixelsDefined: boolean; override; - procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override; - procedure ScanSkipPixels(ACount: integer); override; - end; - - -{---------------------- Affine matrix functions -------------------} -//fill a matrix -function AffineMatrix(m11,m12,m13,m21,m22,m23: single): TAffineMatrix; overload; -function AffineMatrix(AU,AV: TPointF; ATranslation: TPointF): TAffineMatrix; overload; - -//matrix multiplication -operator *(M,N: TAffineMatrix): TAffineMatrix; -operator =(M,N: TAffineMatrix): boolean; - -//matrix multiplication by a vector (apply transformation to that vector) -operator *(M: TAffineMatrix; V: TPointF): TPointF; -operator *(M: TAffineMatrix; A: array of TPointF): ArrayOfTPointF; -operator *(M: TAffineMatrix; ab: TAffineBox): TAffineBox; - -//check if matrix is inversible -function IsAffineMatrixInversible(M: TAffineMatrix): boolean; - -//check if the matrix is a translation (including the identity) -function IsAffineMatrixTranslation(M: TAffineMatrix): boolean; - -//check if the matrix is a scaling (including a projection i.e. with factor 0) -function IsAffineMatrixScale(M: TAffineMatrix): boolean; - -//check if the matrix is the identity -function IsAffineMatrixIdentity(M: TAffineMatrix): boolean; - -//compute inverse (check if inversible before) -function AffineMatrixInverse(M: TAffineMatrix): TAffineMatrix; - -//define a translation matrix -function AffineMatrixTranslation(OfsX,OfsY: Single): TAffineMatrix; - -//define a scaling matrix -function AffineMatrixScale(sx,sy: single): TAffineMatrix; -function AffineMatrixScaledRotation(ASourceVector, ATargetVector: TPointF): TAffineMatrix; -function AffineMatrixScaledRotation(ASourcePoint, ATargetPoint, AOrigin: TPointF): TAffineMatrix; - -function AffineMatrixSkewXDeg(AngleCW: single): TAffineMatrix; -function AffineMatrixSkewYDeg(AngleCW: single): TAffineMatrix; -function AffineMatrixSkewXRad(AngleCCW: single): TAffineMatrix; -function AffineMatrixSkewYRad(AngleCCW: single): TAffineMatrix; - -//define a linear matrix -function AffineMatrixLinear(v1,v2: TPointF): TAffineMatrix; overload; -function AffineMatrixLinear(const AMatrix: TAffineMatrix): TAffineMatrix; overload; - -//define a rotation matrix (positive radians are counter-clockwise) -//(assuming the y-axis is pointing down) -function AffineMatrixRotationRad(AngleCCW: Single): TAffineMatrix; - -//Positive degrees are clockwise -//(assuming the y-axis is pointing down) -function AffineMatrixRotationDeg(AngleCW: Single): TAffineMatrix; - -//define the identity matrix (that do nothing) -function AffineMatrixIdentity: TAffineMatrix; - -function IsAffineMatrixOrthogonal(M: TAffineMatrix): boolean; -function IsAffineMatrixScaledRotation(M: TAffineMatrix): boolean; - -type - { TBGRATriangleLinearMapping is a scanner that provides - an optimized transformation for linear texture mapping - on triangles } - - { TBGRATriangleLinearMapping } - - TBGRATriangleLinearMapping = class(TBGRACustomScanner) - protected - FScanner: IBGRAScanner; - FMatrix: TAffineMatrix; - FTexCoord1,FDiff2,FDiff3,FStep: TPointF; - FCurTexCoord: TPointF; - FScanAtFunc: TScanAtFunction; - public - constructor Create(AScanner: IBGRAScanner; pt1,pt2,pt3: TPointF; tex1,tex2,tex3: TPointF); - procedure ScanMoveTo(X,Y: Integer); override; - procedure ScanMoveToF(X,Y: Single); - function ScanAt(X,Y: Single): TBGRAPixel; override; - function ScanNextPixel: TBGRAPixel; override; - procedure ScanSkipPixels(ACount: integer); override; - end; - -type - TPerspectiveTransform = class; - - { TBGRAPerspectiveScannerTransform } - - TBGRAPerspectiveScannerTransform = class(TBGRACustomScanner) - private - FTexture: IBGRAScanner; - FMatrix: TPerspectiveTransform; - FScanAtProc: TScanAtFunction; - function GetIncludeOppositePlane: boolean; - procedure SetIncludeOppositePlane(AValue: boolean); - public - constructor Create(texture: IBGRAScanner; texCoord1,texCoord2: TPointF; const quad: array of TPointF); overload; - constructor Create(texture: IBGRAScanner; const texCoordsQuad: array of TPointF; const quad: array of TPointF); overload; - destructor Destroy; override; - procedure ScanMoveTo(X, Y: Integer); override; - function ScanAt(X, Y: Single): TBGRAPixel; override; - function ScanNextPixel: TBGRAPixel; override; - procedure ScanSkipPixels(ACount: integer); override; - property IncludeOppositePlane: boolean read GetIncludeOppositePlane write SetIncludeOppositePlane; - end; - - { TPerspectiveTransform } - - TPerspectiveTransform = class - private - sx ,shy ,w0 ,shx ,sy ,w1 ,tx ,ty ,w2 : single; - scanDenom,scanNumX,scanNumY: single; - FOutsideValue: TPointF; - FIncludeOppositePlane: boolean; - procedure Init; - public - constructor Create; overload; - constructor Create(x1,y1,x2,y2: single; const quad: array of TPointF); overload; - constructor Create(const quad: array of TPointF; x1,y1,x2,y2: single); overload; - constructor Create(const srcQuad,destQuad: array of TPointF); overload; - function MapQuadToQuad(const srcQuad,destQuad: array of TPointF): boolean; - function MapRectToQuad(x1,y1,x2,y2: single; const quad: array of TPointF): boolean; - function MapQuadToRect(const quad: array of TPointF; x1,y1,x2,y2: single): boolean; - function MapSquareToQuad(const quad: array of TPointF): boolean; - function MapQuadToSquare(const quad: array of TPointF): boolean; - procedure AssignIdentity; - function Invert: boolean; - procedure Translate(dx,dy: single); - procedure MultiplyBy(a: TPerspectiveTransform); - procedure PremultiplyBy(b: TPerspectiveTransform); - function Duplicate: TPerspectiveTransform; - function Apply(pt: TPointF): TPointF; - procedure ScanMoveTo(x,y:single); - function ScanNext: TPointF; - procedure ScanSkip(ACount: integer); - property OutsideValue: TPointF read FOutsideValue write FOutsideValue; - property IncludeOppositePlane: boolean read FIncludeOppositePlane write FIncludeOppositePlane; - end; - -type - { TBGRATwirlScanner applies a twirl transformation. - - Note : this scanner handles integer coordinates only, so - any further transformation applied after this one may not - render correctly. } - - { TBGRATwirlScanner } - - TBGRATwirlScanner = Class(TBGRACustomScanner) - protected - FScanner: IBGRAScanner; - FScanAtFunc: TScanAtFunction; - FCenter: TPoint; - FTurn, FRadius, FExponent: Single; - public - constructor Create(AScanner: IBGRAScanner; ACenter: TPoint; ARadius: single; ATurn: single = 1; AExponent: single = 3); - function ScanAt(X, Y: Single): TBGRAPixel; override; - property Radius: Single read FRadius; - property Center: TPoint read FCenter; - property Exponent: Single read FExponent; - end; - - { TBGRASphereDeformationScanner } - - TBGRASphereDeformationScanner = Class(TBGRACustomScanner) - protected - FScanner: IBGRAScanner; - FScanAtFunc: TScanAtFunction; - FCenter: TPointF; - FRadiusX, FRadiusY: Single; - public - constructor Create(AScanner: IBGRAScanner; ACenter: TPointF; ARadiusX,ARadiusY: single); - function ScanAt(X, Y: Single): TBGRAPixel; override; - property RadiusX: Single read FRadiusX; - property RadiusY: Single read FRadiusY; - end; - - { TBGRAVerticalCylinderDeformationScanner } - - TBGRAVerticalCylinderDeformationScanner = Class(TBGRACustomScanner) - protected - FScanner: IBGRAScanner; - FScanAtFunc: TScanAtFunction; - FCenterX: single; - FRadiusX: Single; - public - constructor Create(AScanner: IBGRAScanner; ACenterX: single; ARadiusX: single); - function ScanAt(X, Y: Single): TBGRAPixel; override; - property RadiusX: Single read FRadiusX; - end; - - -implementation - -uses BGRABlend, Math; - -function AffineMatrix(m11, m12, m13, m21, m22, m23: single): TAffineMatrix; -begin - result[1,1] := m11; - result[1,2] := m12; - result[1,3] := m13; - result[2,1] := m21; - result[2,2] := m22; - result[2,3] := m23; -end; - -function AffineMatrix(AU, AV: TPointF; ATranslation: TPointF): TAffineMatrix; -begin - result:= AffineMatrix(AU.x, AV.x, ATranslation.x, - AU.y, AV.y, ATranslation.y); -end; - -operator *(M, N: TAffineMatrix): TAffineMatrix; -begin - result[1,1] := M[1,1]*N[1,1] + M[1,2]*N[2,1]; - result[1,2] := M[1,1]*N[1,2] + M[1,2]*N[2,2]; - result[1,3] := M[1,1]*N[1,3] + M[1,2]*N[2,3] + M[1,3]; - - result[2,1] := M[2,1]*N[1,1] + M[2,2]*N[2,1]; - result[2,2] := M[2,1]*N[1,2] + M[2,2]*N[2,2]; - result[2,3] := M[2,1]*N[1,3] + M[2,2]*N[2,3] + M[2,3]; -end; - -operator=(M, N: TAffineMatrix): boolean; -begin - result := CompareMem(@M,@N,SizeOf(TAffineMatrix)); -end; - -operator*(M: TAffineMatrix; V: TPointF): TPointF; -begin - if isEmptyPointF(V) then - result := EmptyPointF - else - begin - result.X := V.X*M[1,1]+V.Y*M[1,2]+M[1,3]; - result.Y := V.X*M[2,1]+V.Y*M[2,2]+M[2,3]; - end; -end; - -operator*(M: TAffineMatrix; A: array of TPointF): ArrayOfTPointF; -var - i: Int32or64; - ofs: TPointF; -begin - setlength(result, length(A)); - if IsAffineMatrixTranslation(M) then - begin - ofs := PointF(M[1,3],M[2,3]); - for i := 0 to high(A) do - result[i] := A[i]+ofs; - end else - for i := 0 to high(A) do - result[i] := M*A[i]; -end; - -operator*(M: TAffineMatrix; ab: TAffineBox): TAffineBox; -begin - result.TopLeft := M*ab.TopLeft; - result.TopRight := M*ab.TopRight; - result.BottomLeft := M*ab.BottomLeft; -end; - -function IsAffineMatrixInversible(M: TAffineMatrix): boolean; -begin - result := M[1,1]*M[2,2]-M[1,2]*M[2,1] <> 0; -end; - -function IsAffineMatrixTranslation(M: TAffineMatrix): boolean; -begin - result := (m[1,1]=1) and (m[1,2]=0) and (m[2,1] = 0) and (m[2,2]=1); -end; - -function IsAffineMatrixScale(M: TAffineMatrix): boolean; -begin - result := (M[1,3]=0) and (M[2,3]=0) and - (M[1,2]=0) and (M[2,1]=0); -end; - -function IsAffineMatrixIdentity(M: TAffineMatrix): boolean; -begin - result := IsAffineMatrixTranslation(M) and (M[1,3]=0) and (M[2,3]=0); -end; - -function AffineMatrixInverse(M: TAffineMatrix): TAffineMatrix; -var det,f: single; - linearInverse: TAffineMatrix; -begin - det := M[1,1]*M[2,2]-M[1,2]*M[2,1]; - if det = 0 then - raise Exception.Create('Not inversible'); - f := 1/det; - linearInverse := AffineMatrix(M[2,2]*f,-M[1,2]*f,0, - -M[2,1]*f,M[1,1]*f,0); - result := linearInverse * AffineMatrixTranslation(-M[1,3],-M[2,3]); -end; - -function AffineMatrixTranslation(OfsX, OfsY: Single): TAffineMatrix; -begin - result := AffineMatrix(1, 0, OfsX, - 0, 1, OfsY); -end; - -function AffineMatrixScale(sx, sy: single): TAffineMatrix; -begin - result := AffineMatrix(sx, 0, 0, - 0, sy, 0); -end; - -function AffineMatrixScaledRotation(ASourceVector, ATargetVector: TPointF): TAffineMatrix; -var - prevScale, newScale, scale: Single; - u1,v1,u2,v2,w: TPointF; -begin - prevScale := VectLen(ASourceVector); - newScale := VectLen(ATargetVector); - if (prevScale = 0) or (newScale = 0) then - result := AffineMatrixIdentity - else - begin - scale := newScale/prevScale; - u1 := ASourceVector*(1/prevScale); - v1 := PointF(-u1.y,u1.x); - w := ATargetVector*(1/newScale); - u2 := PointF(w*u1, w*v1); - v2 := PointF(-u2.y,u2.x); - result := AffineMatrix(scale*u2,scale*v2,PointF(0,0)); - end; -end; - -function AffineMatrixScaledRotation(ASourcePoint, ATargetPoint, AOrigin: TPointF): TAffineMatrix; -begin - result := AffineMatrixTranslation(AOrigin.x,AOrigin.y)* - AffineMatrixScaledRotation(ASourcePoint-AOrigin, ATargetPoint-AOrigin)* - AffineMatrixTranslation(-AOrigin.x,-AOrigin.y); -end; - -function AffineMatrixSkewXDeg(AngleCW: single): TAffineMatrix; -begin - result := AffineMatrix(1,tan(AngleCW*Pi/180),0, - 0, 1, 0); -end; - -function AffineMatrixSkewYDeg(AngleCW: single): TAffineMatrix; -begin - result := AffineMatrix(1, 0, 0, - tan(AngleCW*Pi/180), 1, 0) -end; - -function AffineMatrixSkewXRad(AngleCCW: single): TAffineMatrix; -begin - - result := AffineMatrix(1,tan(-AngleCCW),0, - 0, 1, 0); -end; - -function AffineMatrixSkewYRad(AngleCCW: single): TAffineMatrix; -begin - result := AffineMatrix(1, 0, 0, - tan(-angleCCW), 1, 0) -end; - -function AffineMatrixLinear(v1,v2: TPointF): TAffineMatrix; -begin - result := AffineMatrix(v1.x, v2.x, 0, - v1.y, v2.y, 0); -end; - -function AffineMatrixLinear(const AMatrix: TAffineMatrix): TAffineMatrix; -begin - result := AffineMatrix(AMatrix[1,1],AMatrix[1,2],0, - AMatrix[2,1],AMatrix[2,2],0); -end; - -function AffineMatrixRotationRad(AngleCCW: Single): TAffineMatrix; -begin - result := AffineMatrix(cos(AngleCCW), sin(AngleCCW), 0, - -sin(AngleCCW), cos(AngleCCW), 0); -end; - -function AffineMatrixRotationDeg(AngleCW: Single): TAffineMatrix; -const DegToRad = -Pi/180; -begin - result := AffineMatrixRotationRad(AngleCW*DegToRad); -end; - -function AffineMatrixIdentity: TAffineMatrix; -begin - result := AffineMatrix(1, 0, 0, - 0, 1, 0); -end; - -function IsAffineMatrixOrthogonal(M: TAffineMatrix): boolean; -begin - result := PointF(M[1,1],M[2,1])*PointF(M[1,2],M[2,2]) = 0; -end; - -function IsAffineMatrixScaledRotation(M: TAffineMatrix): boolean; -begin - result := IsAffineMatrixOrthogonal(M) and - (VectLen(PointF(M[1,1],M[2,1]))=VectLen(PointF(M[1,2],M[2,2]))); -end; - -{ TBGRAVerticalCylinderDeformationScanner } - -constructor TBGRAVerticalCylinderDeformationScanner.Create( - AScanner: IBGRAScanner; ACenterX: single; ARadiusX: single); -begin - FScanner := AScanner; - FScanAtFunc := @FScanner.ScanAt; - FCenterX := ACenterX; - FRadiusX := ARadiusX; -end; - -function TBGRAVerticalCylinderDeformationScanner.ScanAt(X, Y: Single): TBGRAPixel; -var - xn,len,fact: Single; -begin - xn := (x - FCenterX) / FRadiusX; - len := abs(xn); - if (len <= 1) then - begin - if (len > 0) then - begin - fact := 1 / len * arcsin(len) / (Pi / 2); - xn := xn * fact; - end; - result := FScanAtFunc(xn * FRadiusX + FCenterX, y); - end - else - result := BGRAPixelTransparent; -end; - -{ TBGRASphereDeformationScanner } - -constructor TBGRASphereDeformationScanner.Create(AScanner: IBGRAScanner; - ACenter: TPointF; ARadiusX, ARadiusY: single); -begin - FScanner := AScanner; - FScanAtFunc := @FScanner.ScanAt; - FCenter := ACenter; - FRadiusX := ARadiusX; - FRadiusY := ARadiusY; -end; - -function TBGRASphereDeformationScanner.ScanAt(X, Y: Single): TBGRAPixel; -var - xn, yn, len,fact: Single; -begin - xn := (x - FCenter.X) / FRadiusX; - yn := (y - FCenter.Y) / FRadiusY; - len := sqrt(sqr(xn) + sqr(yn)); - if (len <= 1) then - begin - if (len > 0) then - begin - fact := 1 / len * arcsin(len) / (Pi / 2); - xn := xn * fact; - yn := yn * fact; - end; - result := FScanAtFunc(xn * FRadiusX + FCenter.X, yn * FRadiusY + FCenter.Y); - end - else - result := BGRAPixelTransparent; -end; - -{ TBGRAExtendedBorderScanner } - -constructor TBGRAExtendedBorderScanner.Create(ASource: IBGRAScanner; - ABounds: TRect); -begin - FSource := ASource; - FBounds := ABounds; -end; - -function TBGRAExtendedBorderScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - if x < FBounds.Left then x := FBounds.Left; - if y < FBounds.Top then y := FBounds.Top; - if x > FBounds.Right-1 then x := FBounds.Right-1; - if y > FBounds.Bottom-1 then y := FBounds.Bottom-1; - result := FSource.ScanAt(X,Y); -end; - -{ TBGRAScannerOffset } - -constructor TBGRAScannerOffset.Create(ASource: IBGRAScanner; AOffset: TPoint); -begin - FSource := ASource; - FOffset := AOffset; -end; - -destructor TBGRAScannerOffset.Destroy; -begin - fillchar(FSource,sizeof(FSource),0); - inherited Destroy; -end; - -procedure TBGRAScannerOffset.ScanMoveTo(X, Y: Integer); -begin - FSource.ScanMoveTo(X-FOffset.X,Y-FOffset.Y); -end; - -function TBGRAScannerOffset.ScanNextPixel: TBGRAPixel; -begin - Result:=FSource.ScanNextPixel; -end; - -function TBGRAScannerOffset.ScanAt(X, Y: Single): TBGRAPixel; -begin - Result:=FSource.ScanAt(X - FOffset.X, Y - FOffset.Y); -end; - -function TBGRAScannerOffset.IsScanPutPixelsDefined: boolean; -begin - Result:=FSource.IsScanPutPixelsDefined; -end; - -procedure TBGRAScannerOffset.ScanPutPixels(pdest: PBGRAPixel; count: integer; - mode: TDrawMode); -begin - FSource.ScanPutPixels(pdest, count, mode); -end; - -procedure TBGRAScannerOffset.ScanSkipPixels(ACount: integer); -begin - FSource.ScanSkipPixels(ACount); -end; - -{ TBGRABitmapScanner } - -constructor TBGRABitmapScanner.Create(ASource: TBGRACustomBitmap; ARepeatX, - ARepeatY: boolean; AOrigin: TPoint); -begin - FSource := ASource; - FRepeatX := ARepeatX; - FRepeatY := ARepeatY; - FScanline := nil; - FOrigin := AOrigin; -end; - -procedure TBGRABitmapScanner.ScanMoveTo(X, Y: Integer); -begin - if (FSource.NbPixels = 0) then - begin - FScanline := nil; - exit; - end; - Inc(Y,FOrigin.Y); - if FRepeatY then Y := PositiveMod(Y,FSource.Height); - if (Y < 0) or (Y >= FSource.Height) then - begin - FScanline := nil; - exit; - end; - FScanline := FSource.Scanline[Y]; - FCurX := X+FOrigin.X; - if FRepeatX then FCurX := PositiveMod(FCurX, FSource.Width); -end; - -function TBGRABitmapScanner.ScanNextPixel: TBGRAPixel; -begin - if (FScanline = nil) then - begin - result := BGRAPixelTransparent; - exit; - end; - if FRepeatX then - begin - result := (FScanline+FCurX)^; - inc(FCurX); - if FCurX = FSource.Width then FCurX := 0; - end else - begin - if (FCurX >= FSource.Width) then - begin - result := BGRAPixelTransparent; - exit; - end; - if FCurX < 0 then - result := BGRAPixelTransparent - else - result := (FScanline+FCurX)^; - inc(FCurX); - end; -end; - -function TBGRABitmapScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - Result := FSource.GetPixelCycle(X+FOrigin.X,Y+FOrigin.Y,rfLinear,FRepeatX,FRepeatY); -end; - -procedure TBGRABitmapScanner.ScanSkipPixels(ACount: integer); -begin - if FScanLine <> nil then - begin - inc(FCurX, ACount); - if FCurX > FSource.Width then FCurX := PositiveMod(FCurX, FSource.Width); - end; -end; - -{ TBGRATriangleLinearMapping } - -constructor TBGRATriangleLinearMapping.Create(AScanner: IBGRAScanner; pt1, pt2, - pt3: TPointF; tex1, tex2, tex3: TPointF); -begin - FScanner := AScanner; - FScanAtFunc := @FScanner.ScanAt; - - FMatrix := AffineMatrix(pt2.X-pt1.X, pt3.X-pt1.X, 0, - pt2.Y-pt1.Y, pt3.Y-pt1.Y, 0); - if not IsAffineMatrixInversible(FMatrix) then - FMatrix := AffineMatrix(0,0,0,0,0,0) - else - FMatrix := AffineMatrixInverse(FMatrix) * AffineMatrixTranslation(-pt1.x,-pt1.y); - - FTexCoord1 := tex1; - FDiff2 := tex2-tex1; - FDiff3 := tex3-tex1; - FStep := FDiff2*FMatrix[1,1]+FDiff3*FMatrix[2,1]; -end; - -procedure TBGRATriangleLinearMapping.ScanMoveTo(X, Y: Integer); -begin - ScanMoveToF(X, Y); -end; - -procedure TBGRATriangleLinearMapping.ScanMoveToF(X, Y: Single); -var - Cur: TPointF; -begin - Cur := FMatrix*PointF(X,Y); - FCurTexCoord := FTexCoord1+FDiff2*Cur.X+FDiff3*Cur.Y; -end; - -function TBGRATriangleLinearMapping.ScanAt(X, Y: Single): TBGRAPixel; -begin - ScanMoveToF(X,Y); - result := ScanNextPixel; -end; - -function TBGRATriangleLinearMapping.ScanNextPixel: TBGRAPixel; -begin - result := FScanAtFunc(FCurTexCoord.X,FCurTexCoord.Y); - FCurTexCoord.Offset(FStep); -end; - -procedure TBGRATriangleLinearMapping.ScanSkipPixels(ACount: integer); -begin - FCurTexCoord.Offset(FStep*ACount); -end; - -{ TBGRAAffineScannerTransform } - -constructor TBGRAAffineScannerTransform.Create(AScanner: IBGRAScanner); -begin - FScanner := AScanner; - FScanAtFunc := @FScanner.ScanAt; - GlobalOpacity := 255; - Reset; -end; - -procedure TBGRAAffineScannerTransform.Reset; -begin - FMatrix := AffineMatrixIdentity; - FEmptyMatrix := False; -end; - -procedure TBGRAAffineScannerTransform.Invert; -begin - if not FEmptyMatrix and IsAffineMatrixInversible(FMatrix) then - FMatrix := AffineMatrixInverse(FMatrix) else - FEmptyMatrix := True; -end; - -function TBGRAAffineScannerTransform.GetViewMatrix: TAffineMatrix; -begin - if FEmptyMatrix then - result := AffineMatrixIdentity - else - result := AffineMatrixInverse(FMatrix); -end; - -procedure TBGRAAffineScannerTransform.SetViewMatrix(AValue: TAffineMatrix); -begin - Matrix := AValue; - Invert; -end; - -procedure TBGRAAffineScannerTransform.SetMatrix(AMatrix: TAffineMatrix); -begin - FEmptyMatrix := False; - FMatrix := AMatrix; -end; - -//transformations are inverted because the effect on the resulting image -//is the inverse of the transformation. This is due to the fact -//that the matrix is applied to source coordinates, not destination coordinates -procedure TBGRAAffineScannerTransform.Translate(OfsX, OfsY: Single); -begin - MultiplyBy(AffineMatrixTranslation(-OfsX,-OfsY)); -end; - -procedure TBGRAAffineScannerTransform.RotateDeg(AngleCW: Single); -begin - MultiplyBy(AffineMatrixRotationDeg(-AngleCW)); -end; - -procedure TBGRAAffineScannerTransform.RotateRad(AngleCCW: Single); -begin - MultiplyBy(AffineMatrixRotationRad(-AngleCCW)); -end; - -procedure TBGRAAffineScannerTransform.MultiplyBy(AMatrix: TAffineMatrix); -begin - FMatrix := FMatrix * AMatrix; -end; - -procedure TBGRAAffineScannerTransform.Fit(Origin, HAxis, VAxis: TPointF); -begin - SetMatrix(AffineMatrix(HAxis.X-Origin.X, VAxis.X-Origin.X, 0, - HAxis.Y-Origin.Y, VAxis.Y-Origin.Y, 0)); - Invert; - Translate(Origin.X,Origin.Y); -end; - -procedure TBGRAAffineScannerTransform.Scale(sx, sy: single); -begin - if (sx=0) or (sy=0) then - begin - FEmptyMatrix := True; - exit; - end; - - MultiplyBy(AffineMatrixScale(1/sx,1/sy)); -end; - -procedure TBGRAAffineScannerTransform.Scale(factor: single); -begin - Scale(factor,factor); -end; - -function TBGRAAffineScannerTransform.GetScanCustomColorspace: TColorspaceAny; -begin - Result:= TBGRAPixelColorspace; -end; - -procedure TBGRAAffineScannerTransform.ScanMoveTo(X, Y: Integer); -begin - ScanMoveToF(X,Y); -end; - -procedure TBGRAAffineScannerTransform.ScanMoveToF(X, Y: single); -begin - FCur := FMatrix * PointF(X,Y); -end; - -function TBGRAAffineScannerTransform.InternalScanCurrentPixel: TBGRAPixel; -begin - if FEmptyMatrix then - begin - result := BGRAPixelTransparent; - exit; - end; - result := FScanAtFunc(FCur.X,FCur.Y); -end; - -function TBGRAAffineScannerTransform.ScanNextPixel: TBGRAPixel; -begin - result := InternalScanCurrentPixel; - FCur.Offset(FMatrix[1,1], FMatrix[2,1]); - if GlobalOpacity <> 255 then result.alpha := ApplyOpacity(result.alpha,GlobalOpacity); -end; - -procedure TBGRAAffineScannerTransform.ScanSkipPixels(ACount: integer); -begin - FCur.Offset(FMatrix[1,1]*ACount, FMatrix[2,1]*ACount); -end; - -function TBGRAAffineScannerTransform.ScanAt(X, Y: Single): TBGRAPixel; -begin - ScanMoveToF(X,Y); - result := InternalScanCurrentPixel; - if GlobalOpacity <> 255 then result.alpha := ApplyOpacity(result.alpha,GlobalOpacity); -end; - -{ TBGRAQuadLinearScanner } - -function TBGRAQuadLinearScanner.GetTexColorAt(u, v: Single; detNeg: boolean - ): TBGRAPixel; -var isPadding: boolean; -begin - if detNeg then - begin - if not FShowC2 then - begin - result := BGRAPixelTransparent; - exit; - end; - end else - if not FShowC1 then - begin - result := BGRAPixelTransparent; - exit; - end; - GetTexColorAt(u,v,result,isPadding); -end; - -procedure TBGRAQuadLinearScanner.ScanMoveToF(X, Y: single); -begin - if not (FHasC1 and FShowC1) and not (FHasC2 and FShowC2) then - begin - FScanFunc := @ScanNone; - exit; - end; - FCurXF := X; - FCurYF := Y; - if (FVectors[0].x = 0) and (FVectors[2].x = 0) then - begin - PrepareScanVert0; - FScanFunc := @ScanVert0; - end else - if aa = 0 then - begin - PrepareScanPara; - FScanFunc := @ScanPara - end - else - FScanFunc := @ScanGeneral; -end; - -procedure TBGRAQuadLinearScanner.SetCulling(AValue: TFaceCulling); -begin - FShowC1 := AValue in [fcKeepCW,fcNone]; - FShowC2 := AValue in [fcKeepCCW,fcNone]; -end; - -procedure TBGRAQuadLinearScanner.Init(ASource: IBGRAScanner; - const APoints: array of TPointF; ATextureInterpolation: boolean); -var - i: Int32or64; - v: TPointF; - len: single; -begin - if length(APoints)<>4 then - raise exception.Create('Expecting 4 points'); - FTextureInterpolation:= ATextureInterpolation; - FSource := ASource; - FSourceMatrix := AffineMatrixIdentity; - FUVVector := PointF(0,0); - for i := 0 to 3 do - begin - FPoints[i] := APoints[i]; - v := APoints[(i+1) mod 4] - APoints[i]; - len := sqrt(v*v); - if len > 0 then FInvLengths[i] := 1/len - else FInvLengths[i] := 0; - FVectors[i] := v*FInvLengths[i]; - end; - - FCoeffs[0] := FPoints[0]; - FCoeffs[1] := FPoints[1]-FPoints[0]; - FCoeffs[2] := FPoints[3]-FPoints[0]; - FCoeffs[3] := FPoints[0]+FPoints[2]-FPoints[1]-FPoints[3]; - - aa := VectDet(FCoeffs[3],FCoeffs[2]); - bb0 := VectDet(FCoeffs[3],FCoeffs[0]) + VectDet(FCoeffs[1],FCoeffs[2]); - cc0 := VectDet(FCoeffs[1],FCoeffs[0]); - for i := 0 to 3 do - FDets[i] := VectDet(FVectors[i],FVectors[(i+1) mod 4]); - if aa <> 0 then inv2aa := 1/(2*aa) else inv2aa := 1; - - FShowC1 := true; - FShowC2 := true; - - FHasC1 := false; - FHasC2 := false; - for i := 0 to 3 do - if FDets[i] > 0 then FHasC1 := true - else if FDets[i] < 0 then FHasC2 := true; - - FBuffer := nil; - FBufferSize := 0; - - ScanMoveToF(0,0); -end; - -function TBGRAQuadLinearScanner.ScanAt(X, Y: Single): TBGRAPixel; -begin - ScanMoveToF(X,Y); - Result:= FScanFunc(); -end; - -procedure TBGRAQuadLinearScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer; - mode: TDrawMode); -var - n: Int32or64; - p: PBGRAPixel; -begin - if mode = dmSet then - p := pdest - else - begin - if count > FBufferSize then - begin - FBufferSize := count; - ReAllocMem(FBuffer, FBufferSize*sizeof(TBGRAPixel)); - end; - p := FBuffer; - end; - for n := count-1 downto 0 do - begin - p^ := FScanFunc(); - inc(p); - end; - if mode <> dmSet then PutPixels(pdest,FBuffer,count,mode,255); -end; - -function TBGRAQuadLinearScanner.IsScanPutPixelsDefined: boolean; -begin - result := true; -end; - -procedure TBGRAQuadLinearScanner.ScanMoveTo(X, Y: Integer); -begin - ScanMoveToF(X,Y); -end; - -function TBGRAQuadLinearScanner.ScanNextPixel: TBGRAPixel; -begin - Result:= FScanFunc(); -end; - -procedure TBGRAQuadLinearScanner.ScanSkipPixels(ACount: integer); -begin - ScanMoveToF(FCurXF+ACount,FCurYF); -end; - -function TBGRAQuadLinearScanner.ScanGeneral: TBGRAPixel; -var u1,u2,v1,v2,x,y: double; - bb,cc,det,delta,denom: double; - mergeC1,mergeC2: boolean; - isPad1,isPad2: boolean; - c1,c2: TBGRAPixel; -begin - x := FCurXF; - y := FCurYF; - IncF(FCurXF, 1); - if (Y = FPoints[0].y) and (FVectors[0].y = 0) then - begin - if FVectors[0].x = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - u1 := (X - FPoints[0].x)/(FPoints[1].x-FPoints[0].x); - result := GetTexColorAt(u1,0,FDets[0]<0); - exit; - end; - if (X = FPoints[1].x) and (FVectors[1].x = 0) then - begin - if FVectors[1].y = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - v1 := (Y - FPoints[1].y)/(FPoints[2].y-FPoints[1].y); - result := GetTexColorAt(0,v1,FDets[1]<0); - end; - if (Y = FPoints[2].y) and (FVectors[2].y = 0) then - begin - if FVectors[2].x = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - u1 := (X - FPoints[3].x)/(FPoints[2].x-FPoints[3].x); - result := GetTexColorAt(u1,1,FDets[2]<0); - end; - if (X = FPoints[3].x) and (FVectors[3].x = 0) then - begin - if FVectors[3].y = 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - v1 := (Y - FPoints[0].y)/(FPoints[3].y-FPoints[0].y); - result := GetTexColorAt(0,v1,FDets[3]<0); - end; - - bb := bb0 + x*FCoeffs[3].y - y*FCoeffs[3].x; - cc := cc0 + x*FCoeffs[1].y - y*FCoeffs[1].x; - if cc = 0 then - begin - v1 := -bb*2*inv2aa; - denom := FCoeffs[1].x+FCoeffs[3].x*v1; - if denom = 0 then - begin - result := BGRAPixelTransparent; - exit; - end - else - u1 := (x-FCoeffs[0].x-FCoeffs[2].x*v1)/denom; - - result := GetTexColorAt(u1,v1,bb<0); - end else - begin - delta := bb*bb - 4*aa*cc; - - if delta < 0 then - begin - result := BGRAPixelTransparent; - exit; - end; - det := sqrt(delta); - - if FHasC1 and FShowC1 then - begin - mergeC1 := true; - v1 := (-bb+det)*inv2aa; - if v1 = 0 then - u1 := (FVectors[0]*FInvLengths[0])*(PointF(x,y)-FPoints[0]) - else if v1 = 1 then - u1 := 1 - (FVectors[2]*FInvLengths[2])*(PointF(x,y)-FPoints[2]) - else - begin - denom := FCoeffs[1].x+FCoeffs[3].x*v1; - if abs(denom)<1e-6 then - begin - u1 := (bb+det)*inv2aa; - denom := FCoeffs[1].y+FCoeffs[3].y*u1; - if denom = 0 then mergeC1 := false - else v1 := (y-FCoeffs[0].y-FCoeffs[2].y*u1)/denom; - end - else u1 := (x-FCoeffs[0].x-FCoeffs[2].x*v1)/denom; - end; - end else - begin - u1 := 0; - v1 := 0; - mergeC1 := false; - end; - - if FHasC2 and FShowC2 then - begin - mergeC2 := true; - v2 := (-bb-det)*inv2aa; - if v2 = 0 then - u2 := (FVectors[0]*FInvLengths[0])*(PointF(x,y)-FPoints[0]) - else if v2 = 1 then - u2 := 1 - (FVectors[2]*FInvLengths[2])*(PointF(x,y)-FPoints[2]) - else - begin - denom := FCoeffs[1].x+FCoeffs[3].x*v2; - if abs(denom)<1e-6 then - begin - u2 := (bb-det)*inv2aa; - denom := FCoeffs[1].y+FCoeffs[3].y*u2; - if denom = 0 then mergeC2 := false - else v2 := (y-FCoeffs[0].y-FCoeffs[2].y*u2)/denom; - end - else u2 := (x-FCoeffs[0].x-FCoeffs[2].x*v2)/denom; - end; - end else - begin - u2 := 0; - v2 := 0; - mergeC2 := false; - end; - - if mergeC1 then - begin - if mergeC2 then - begin - GetTexColorAt(u1,v1,c1,isPad1); - GetTexColorAt(u2,v2,c2,isPad2); - if isPad1 then - begin - if isPad2 then result := MergeBGRA(c1,c2) - else result := c2; - end else - begin - if isPad2 then result := c1 - else result := MergeBGRA(c1,c2); - end; - end - else GetTexColorAt(u1,v1,result,isPad1); - end - else - if mergeC2 then - GetTexColorAt(u2,v2,result,isPad2) - else result := BGRAPixelTransparent; - end; -end; - -function TBGRAQuadLinearScanner.GetCulling: TFaceCulling; -begin - if FShowC1 and FShowC2 then - result := fcNone - else if FShowC1 then - result := fcKeepCW - else - result := fcKeepCCW; -end; - -function TBGRAQuadLinearScanner.ScanNone: TBGRAPixel; -begin - result := BGRAPixelTransparent; -end; - -procedure TBGRAQuadLinearScanner.PrepareScanVert0; -begin - if (FVectors[1].x <> 0) then - begin - ScanVertVStep0 := 1/(FPoints[2].x-FPoints[1].x); - ScanVertV0 := (FCurXF-FPoints[1].x)*ScanVertVStep0; - ScanVertDenom0 := (FPoints[1].y-FPoints[0].y)*(1-ScanVertV0) + (FPoints[2].y-FPoints[3].y)*ScanVertV0; - ScanVertDenomStep0 := (FPoints[2].y-FPoints[3].y-FPoints[1].y+FPoints[0].y)*ScanVertVStep0; - end - else - begin - ScanVertV0 := 0; - ScanVertVStep0 := EmptySingle; - end; -end; - -function TBGRAQuadLinearScanner.ScanVert0: TBGRAPixel; -var u: single; - isPad: boolean; -begin - IncF(FCurXF, 1); - if ScanVertVStep0 = EmptySingle then - begin - result := BGRAPixelTransparent; - exit; - end; - if ScanVertDenom0 = 0 then - result := BGRAPixelTransparent - else - begin - u := (FCurYF-(FPoints[0].y*(1-ScanVertV0) + FPoints[3].y*ScanVertV0))/ScanVertDenom0; - GetTexColorAt(u,ScanVertV0,result,isPad); - end; - IncF(ScanVertV0, ScanVertVStep0); - IncF(ScanVertDenom0, ScanVertDenomStep0); -end; - -procedure TBGRAQuadLinearScanner.PrepareScanPara; -begin - ScanParaBB := bb0 + FCurXF*FCoeffs[3].y - FCurYF*FCoeffs[3].x; - ScanParaCC := cc0 + FCurXF*FCoeffs[1].y - FCurYF*FCoeffs[1].x; - if ScanParaBB <> 0 then - ScanParaBBInv := 1/ScanParaBB - else - ScanParaBBInv := 1; -end; - -function TBGRAQuadLinearScanner.ScanPara: TBGRAPixel; -var - u,v,denom: Single; - isPad: boolean; -begin - IncF(FCurXF, 1); - - if ScanParaBB = 0 then - result := BGRAPixelTransparent - else - begin - v := -ScanParaCC*ScanParaBBInv; - denom := FCoeffs[1].x+FCoeffs[3].x*v; - if denom = 0 then - result := BGRAPixelTransparent - else - begin - u := (FCurXF-1-FCoeffs[0].x-FCoeffs[2].x*v)/denom; - GetTexColorAt(u,v,result,isPad); - end; - end; - - if FCoeffs[3].y <> 0 then - begin - IncF(ScanParaBB, FCoeffs[3].y); - if ScanParaBB <> 0 then - ScanParaBBInv := 1/ScanParaBB - else - ScanParaBBInv := 1; - end; - IncF(ScanParaCC, FCoeffs[1].y); -end; - -procedure TBGRAQuadLinearScanner.GetTexColorAt(u,v: Single; out AColor: TBGRAPixel; out AIsPadding: boolean); -begin - AIsPadding:= false; - if u < 0 then begin if Padding then begin u := 0; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; - if u > 1 then begin if Padding then begin u := 1; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; - if v < 0 then begin if Padding then begin v := 0; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; - if v > 1 then begin if Padding then begin v := 1; AIsPadding := true end else begin AColor := BGRAPixelTransparent; exit end end; - with (FSourceMatrix * PointF(u,v) + FUVVector*(u*v)) do - if FTextureInterpolation then - AColor := FSource.ScanAt(x,y) - else - AColor := FSource.ScanAtInteger(System.round(x),System.round(y)); -end; - -constructor TBGRAQuadLinearScanner.Create(ASource: IBGRAScanner; - ASourceMatrix: TAffineMatrix; const APoints: array of TPointF; - ATextureInterpolation: boolean); -begin - Init(ASource, APoints, ATextureInterpolation); - FSourceMatrix := ASourceMatrix; -end; - -constructor TBGRAQuadLinearScanner.Create(ASource: IBGRAScanner; - const ATexCoords: array of TPointF; const APoints: array of TPointF; - ATextureInterpolation: boolean); -begin - Init(ASource, APoints, ATextureInterpolation); - FSourceMatrix := AffineMatrixTranslation(ATexCoords[0].x,ATexCoords[0].y)* - AffineMatrixLinear(ATexCoords[1]-ATexCoords[0],ATexCoords[3]-ATexCoords[0]); - FUVVector := ATexCoords[2] - (ATexCoords[1]+ATexCoords[3]-ATexCoords[0]); -end; - -destructor TBGRAQuadLinearScanner.Destroy; -begin - freemem(FBuffer); - inherited Destroy; -end; - -{ TBGRAAffineBitmapTransform } - -procedure TBGRAAffineBitmapTransform.Init(ABitmap: TBGRACustomBitmap; - ARepeatImageX: Boolean; ARepeatImageY: Boolean; - AResampleFilter: TResampleFilter; AIncludeEdges: boolean = false); -begin - if (ABitmap.Width = 0) or (ABitmap.Height = 0) then - raise Exception.Create('Empty image'); - inherited Create(ABitmap); - FBitmap := ABitmap; - FRepeatImageX := ARepeatImageX; - FRepeatImageY := ARepeatImageY; - FResampleFilter:= AResampleFilter; - FBuffer := nil; - FBufferSize:= 0; - FIncludeEdges := AIncludeEdges; -end; - -constructor TBGRAAffineBitmapTransform.Create(ABitmap: TBGRACustomBitmap; - ARepeatImage: Boolean; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false); -begin - Init(ABitmap,ARepeatImage,ARepeatImage,AResampleFilter,AIncludeEdges); -end; - -constructor TBGRAAffineBitmapTransform.Create(ABitmap: TBGRACustomBitmap; - ARepeatImageX: Boolean; ARepeatImageY: Boolean; - AResampleFilter: TResampleFilter; AIncludeEdges: boolean = false); -begin - Init(ABitmap,ARepeatImageX,ARepeatImageY,AResampleFilter,AIncludeEdges); -end; - -destructor TBGRAAffineBitmapTransform.Destroy; -begin - FreeMem(FBuffer); -end; - -function TBGRAAffineBitmapTransform.InternalScanCurrentPixel: TBGRAPixel; -begin - if FEmptyMatrix then - begin - result := BGRAPixelTransparent; - exit; - end; - result := FBitmap.GetPixelCycle(FCur.X,FCur.Y,FResampleFilter,FRepeatImageX,FRepeatImageY); -end; - -procedure TBGRAAffineBitmapTransform.ScanPutPixels(pdest: PBGRAPixel; - count: integer; mode: TDrawMode); -const PrecisionShift = {$IFDEF CPU64}24{$ELSE}12{$ENDIF}; - Precision = 1 shl PrecisionShift; -var p: PBGRAPixel; - n: integer; - posXPrecision, posYPrecision: Int32or64; - deltaXPrecision,deltaYPrecision: Int32or64; - ix,iy,shrMask,w,h: Int32or64; - py0: PByte; - deltaRow: Int32or64; -begin - w := FBitmap.Width; - h := FBitmap.Height; - if (w = 0) or (h = 0) then exit; - - if GlobalOpacity = 0 then - begin - if mode = dmSet then - FillDWord(pdest^, count, LongWord(BGRAPixelTransparent)); - FCur.Offset(FMatrix[1,1]*count, FMatrix[2,1]*count); - exit; - end; - - posXPrecision := round(FCur.X*Precision); - deltaXPrecision:= round(FMatrix[1,1]*Precision); - posYPrecision := round(FCur.Y*Precision); - deltaYPrecision:= round(FMatrix[2,1]*Precision); - shrMask := -1; - shrMask := shrMask shr PrecisionShift; - shrMask := not shrMask; - - if mode = dmSet then - p := pdest - else - begin - if count > FBufferSize then - begin - FBufferSize := count; - ReAllocMem(FBuffer, FBufferSize*sizeof(TBGRAPixel)); - end; - p := FBuffer; - end; - - if FResampleFilter = rfBox then - begin - inc(posXPrecision, Precision shr 1); - inc(posYPrecision, Precision shr 1); - py0 := PByte(FBitmap.ScanLine[0]); - if FBitmap.LineOrder = riloTopToBottom then - deltaRow := FBitmap.Width*sizeof(TBGRAPixel) else - deltaRow := -FBitmap.Width*sizeof(TBGRAPixel); - if FRepeatImageX or FRepeatImageY then - begin - for n := count-1 downto 0 do - begin - if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; - if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; - if FRepeatImageX then ix := PositiveMod(ix,w); - if FRepeatImageY then iy := PositiveMod(iy,h); - if (ix < 0) or (iy < 0) or (ix >= w) or (iy >= h) then - p^ := BGRAPixelTransparent - else - p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^; - inc(p); - inc(posXPrecision, deltaXPrecision); - inc(posYPrecision, deltaYPrecision); - end; - end else - begin - for n := count-1 downto 0 do - begin - if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; - if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; - if (ix < 0) or (iy < 0) or (ix >= w) or (iy >= h) then - p^ := BGRAPixelTransparent - else - p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^; - inc(p); - inc(posXPrecision, deltaXPrecision); - inc(posYPrecision, deltaYPrecision); - end; - end; - end else - begin - if FRepeatImageX and FRepeatImageY then - begin - for n := count-1 downto 0 do - begin - if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; - if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; - p^ := FBitmap.GetPixelCycle256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter); - inc(p); - inc(posXPrecision, deltaXPrecision); - inc(posYPrecision, deltaYPrecision); - end; - end else - if FRepeatImageX or FRepeatImageY then - begin - for n := count-1 downto 0 do - begin - if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; - if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; - p^ := FBitmap.GetPixelCycle256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter, FRepeatImageX,FRepeatImageY); - inc(p); - inc(posXPrecision, deltaXPrecision); - inc(posYPrecision, deltaYPrecision); - end; - end else - begin - for n := count-1 downto 0 do - begin - if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift; - if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift; - p^ := FBitmap.GetPixel256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter); - inc(p); - inc(posXPrecision, deltaXPrecision); - inc(posYPrecision, deltaYPrecision); - end; - end; - end; - - if GlobalOpacity < 255 then - begin - if mode = dmSet then - p := pdest - else - p := FBuffer; - for n := count-1 downto 0 do - begin - p^.alpha := ApplyOpacity(p^.alpha,GlobalOpacity); - if p^.alpha = 0 then p^ := BGRAPixelTransparent; - inc(p); - end; - end; - - if mode <> dmSet then PutPixels(pdest,FBuffer,count,mode,255); - FCur.Offset(FMatrix[1,1]*count, FMatrix[2,1]*count); -end; - -function TBGRAAffineBitmapTransform.IsScanPutPixelsDefined: boolean; -begin - Result:=true; -end; - -procedure TBGRAAffineBitmapTransform.Fit(Origin, HAxis, VAxis: TPointF); -begin - if (FBitmap.Width = 0) or (FBitmap.Height = 0) then exit; - Matrix := AffineMatrix(HAxis.X-Origin.X, VAxis.X-Origin.X, Origin.X, - HAxis.Y-Origin.Y, VAxis.Y-Origin.Y, Origin.Y); - Invert; - if FIncludeEdges then - begin - Matrix := AffineMatrixTranslation(-0.5,-0.5)*AffineMatrixScale(FBitmap.Width,FBitmap.Height)*Matrix; - end else - Matrix := AffineMatrixScale(FBitmap.Width-1,FBitmap.Height-1)*Matrix; -end; - -{ TBGRAPerspectiveScannerTransform } - -function TBGRAPerspectiveScannerTransform.GetIncludeOppositePlane: boolean; -begin - if FMatrix = nil then - result := false - else - result := FMatrix.IncludeOppositePlane; -end; - -procedure TBGRAPerspectiveScannerTransform.SetIncludeOppositePlane( - AValue: boolean); -begin - if FMatrix <> nil then - FMatrix.IncludeOppositePlane := AValue; -end; - -constructor TBGRAPerspectiveScannerTransform.Create(texture: IBGRAScanner; texCoord1,texCoord2: TPointF; const quad: array of TPointF); -begin - if DoesQuadIntersect(quad[0],quad[1],quad[2],quad[3]) or not IsConvex(quad,False) or (texCoord1.x = texCoord2.x) or (texCoord1.y = texCoord2.y) then - FMatrix := nil - else - begin - FMatrix := TPerspectiveTransform.Create(quad,texCoord1.x,texCoord1.y,texCoord2.x,texCoord2.y); - FMatrix.OutsideValue := EmptyPointF; - end; - FTexture := texture; - FScanAtProc:= @FTexture.ScanAt; -end; - -constructor TBGRAPerspectiveScannerTransform.Create(texture: IBGRAScanner; - const texCoordsQuad: array of TPointF; const quad: array of TPointF); -begin - if DoesQuadIntersect(quad[0],quad[1],quad[2],quad[3]) or not IsConvex(quad,False) or - DoesQuadIntersect(texCoordsQuad[0],texCoordsQuad[1],texCoordsQuad[2],texCoordsQuad[3]) or not IsConvex(texCoordsQuad,False) then - FMatrix := nil - else - begin - FMatrix := TPerspectiveTransform.Create(quad,texCoordsQuad); - FMatrix.OutsideValue := EmptyPointF; - end; - FTexture := texture; - FScanAtProc:= @FTexture.ScanAt; -end; - -destructor TBGRAPerspectiveScannerTransform.Destroy; -begin - FMatrix.free; - inherited Destroy; -end; - -procedure TBGRAPerspectiveScannerTransform.ScanMoveTo(X, Y: Integer); -begin - if FMatrix = nil then exit; - FMatrix.ScanMoveTo(X,Y); -end; - -function TBGRAPerspectiveScannerTransform.ScanAt(X, Y: Single): TBGRAPixel; -var ptSource: TPointF; -begin - if FMatrix = nil then - result := BGRAPixelTransparent else - begin - ptSource := FMatrix.Apply(PointF(X,Y)); - if ptSource.x = EmptySingle then - result := BGRAPixelTransparent - else - Result:= FScanAtProc(ptSource.X, ptSource.Y); - end; -end; - -function TBGRAPerspectiveScannerTransform.ScanNextPixel: TBGRAPixel; -var ptSource: TPointF; -begin - if FMatrix = nil then - result := BGRAPixelTransparent else - begin - ptSource := FMatrix.ScanNext; - if ptSource.x = EmptySingle then - result := BGRAPixelTransparent - else - Result:= FScanAtProc(ptSource.X, ptSource.Y); - end; -end; - -procedure TBGRAPerspectiveScannerTransform.ScanSkipPixels(ACount: integer); -begin - if FMatrix<>nil then FMatrix.ScanSkip(ACount); -end; - -{ TPerspectiveTransform } - -procedure TPerspectiveTransform.Init; -begin - FOutsideValue := PointF(0,0); - FIncludeOppositePlane:= True; -end; - -constructor TPerspectiveTransform.Create; -begin - Init; - AssignIdentity; -end; - -constructor TPerspectiveTransform.Create(x1, y1, x2, y2: single; - const quad: array of TPointF); -begin - Init; - MapRectToQuad(x1 ,y1 ,x2 ,y2 ,quad ); -end; - -constructor TPerspectiveTransform.Create(const quad: array of TPointF; x1, y1, - x2, y2: single); -begin - Init; - MapQuadToRect(quad, x1,y1,x2,y2); -end; - -constructor TPerspectiveTransform.Create(const srcQuad, - destQuad: array of TPointF); -begin - Init; - MapQuadToQuad(srcQuad,destQuad); -end; - -{ Map a quad to quad. First compute quad to square, and then square to quad. } -function TPerspectiveTransform.MapQuadToQuad(const srcQuad, - destQuad: array of TPointF): boolean; -var - p : TPerspectiveTransform; -begin - if not MapQuadToSquare(srcQuad ) then - begin - result:=false; - exit; - end; - - p := TPerspectiveTransform.Create; - if not p.MapSquareToQuad(destQuad) then - begin - p.Free; - result:=false; - exit; - end; - - //combine both transformations - MultiplyBy(p); - p.Free; - result:=true; -end; - -//Map a rectangle to a quad. Make a polygon for the rectangle, and map it. -function TPerspectiveTransform.MapRectToQuad(x1, y1, x2, y2: single; - const quad: array of TPointF): boolean; -begin - result := MapQuadToQuad([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)], quad); -end; - -//Map a quad to a rectangle. Make a polygon for the rectangle, and map the quad into it. -function TPerspectiveTransform.MapQuadToRect(const quad: array of TPointF; x1, - y1, x2, y2: single): boolean; -begin - result := MapQuadToQuad(quad, [PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)]); -end; - -//Map a square to a quad -function TPerspectiveTransform.MapSquareToQuad(const quad: array of TPointF): boolean; -var - d,d1,d2: TPointF; - den ,u ,v : double; - -begin - d := quad[0]-quad[1]+quad[2]-quad[3]; - - if (d.x = 0.0 ) and - (d.y = 0.0 ) then - begin - // Affine case (parallelogram) - sx :=quad[1].x - quad[0].x; - shy:=quad[1].y - quad[0].y; - w0 :=0.0; - shx:=quad[2].x - quad[1].x; - sy :=quad[2].y - quad[1].y; - w1 :=0.0; - tx :=quad[0].x; - ty :=quad[0].y; - w2 :=1.0; - - end - else - begin - d1 := quad[1]-quad[2]; - d2 := quad[3]-quad[2]; - den:=d1.x * d2.y - d2.x * d1.y; - - if den = 0.0 then - begin - // Singular case - sx :=0.0; - shy:=0.0; - w0 :=0.0; - shx:=0.0; - sy :=0.0; - w1 :=0.0; - tx :=0.0; - ty :=0.0; - w2 :=0.0; - result:=false; - exit; - end; - - // General case - u:=(d.x * d2.y - d.y * d2.x ) / den; - v:=(d.y * d1.x - d.x * d1.y ) / den; - - sx :=quad[1].x - quad[0].x + u * quad[1].x; - shy:=quad[1].y - quad[0].y + u * quad[1].y; - w0 :=u; - shx:=quad[3].x - quad[0].x + v * quad[3].x; - sy :=quad[3].y - quad[0].y + v * quad[3].y; - w1 :=v; - tx :=quad[0].x; - ty :=quad[0].y; - w2 :=1.0; - - end; - - result:=true; - -end; - -//Map a quad to a square. Compute mapping from square to quad, then invert. -function TPerspectiveTransform.MapQuadToSquare(const quad: array of TPointF): boolean; -begin - if not MapSquareToQuad(quad ) then - result:=false - else - result := Invert; -end; - -procedure TPerspectiveTransform.AssignIdentity; -begin - sx :=1; - shy:=0; - w0 :=0; - shx:=0; - sy :=1; - w1 :=0; - tx :=0; - ty :=0; - w2 :=1; -end; - -function TPerspectiveTransform.Invert: boolean; -var - d0, d1, d2, d : double; - copy : TPerspectiveTransform; - -begin - d0:= sy * w2 - w1 * ty; - d1:= w0 * ty - shy * w2; - d2:= shy * w1 - w0 * sy; - d := sx * d0 + shx * d1 + tx * d2; - - if d = 0.0 then - begin - sx := 0.0; - shy:= 0.0; - w0 := 0.0; - shx:= 0.0; - sy := 0.0; - w1 := 0.0; - tx := 0.0; - ty := 0.0; - w2 := 0.0; - result:= false; - exit; - end; - - d:= 1.0 / d; - - copy := Duplicate; - - sx :=d * d0; - shy:=d * d1; - w0 :=d * d2; - shx:=d * (copy.w1 * copy.tx - copy.shx * copy.w2 ); - sy :=d * (copy.sx * copy.w2 - copy.w0 * copy.tx ); - w1 :=d * (copy.w0 * copy.shx - copy.sx * copy.w1 ); - tx :=d * (copy.shx * copy.ty - copy.sy * copy.tx ); - ty :=d * (copy.shy * copy.tx - copy.sx * copy.ty ); - w2 :=d * (copy.sx * copy.sy - copy.shy * copy.shx ); - - copy.free; - - result:=true; -end; - -procedure TPerspectiveTransform.Translate(dx, dy: single); -begin - tx:=tx + dx; - ty:=ty + dy; -end; - -procedure TPerspectiveTransform.MultiplyBy(a: TPerspectiveTransform); -var b: TPerspectiveTransform; -begin - b := Duplicate; - sx :=a.sx * b.sx + a.shx * b.shy + a.tx * b.w0; - shx:=a.sx * b.shx + a.shx * b.sy + a.tx * b.w1; - tx :=a.sx * b.tx + a.shx * b.ty + a.tx * b.w2; - shy:=a.shy * b.sx + a.sy * b.shy + a.ty * b.w0; - sy :=a.shy * b.shx + a.sy * b.sy + a.ty * b.w1; - ty :=a.shy * b.tx + a.sy * b.ty + a.ty * b.w2; - w0 :=a.w0 * b.sx + a.w1 * b.shy + a.w2 * b.w0; - w1 :=a.w0 * b.shx + a.w1 * b.sy + a.w2 * b.w1; - w2 :=a.w0 * b.tx + a.w1 * b.ty + a.w2 * b.w2; - b.Free; -end; - -procedure TPerspectiveTransform.PremultiplyBy(b: TPerspectiveTransform); -var - a : TPerspectiveTransform; - begin - a := Duplicate; - sx :=a.sx * b.sx + a.shx * b.shy + a.tx * b.w0; - shx:=a.sx * b.shx + a.shx * b.sy + a.tx * b.w1; - tx :=a.sx * b.tx + a.shx * b.ty + a.tx * b.w2; - shy:=a.shy * b.sx + a.sy * b.shy + a.ty * b.w0; - sy :=a.shy * b.shx + a.sy * b.sy + a.ty * b.w1; - ty :=a.shy * b.tx + a.sy * b.ty + a.ty * b.w2; - w0 :=a.w0 * b.sx + a.w1 * b.shy + a.w2 * b.w0; - w1 :=a.w0 * b.shx + a.w1 * b.sy + a.w2 * b.w1; - w2 :=a.w0 * b.tx + a.w1 * b.ty + a.w2 * b.w2; - a.Free; -end; - -function TPerspectiveTransform.Duplicate: TPerspectiveTransform; -begin - result := TPerspectiveTransform.Create; - result.sx :=sx; - result.shy:=shy; - result.w0 :=w0; - result.shx:=shx; - result.sy :=sy; - result.w1 :=w1; - result.tx :=tx; - result.ty :=ty; - result.w2 :=w2; -end; - -function TPerspectiveTransform.Apply(pt: TPointF): TPointF; -var - m : single; -begin - m:= pt.x * w0 + pt.y * w1 + w2; - if (m=0) or (not FIncludeOppositePlane and (m < 0)) then - result := FOutsideValue - else - begin - m := 1/m; - result.x := m * (pt.x * sx + pt.y * shx + tx ); - result.y := m * (pt.x * shy + pt.y * sy + ty ); - end; -end; - -procedure TPerspectiveTransform.ScanMoveTo(x, y: single); -begin - ScanDenom := x * w0 + y * w1 + w2; - ScanNumX := x * sx + y * shx + tx; - scanNumY := x * shy + y * sy + ty; -end; - -function TPerspectiveTransform.ScanNext: TPointF; -var m: single; -begin - if (ScanDenom = 0) or (not FIncludeOppositePlane and (ScanDenom < 0)) then - result := FOutsideValue - else - begin - m := 1/scanDenom; - result.x := m * ScanNumX; - result.y := m * scanNumY; - end; - IncF(ScanDenom, w0); - IncF(ScanNumX, sx); - IncF(scanNumY, shy); -end; - -procedure TPerspectiveTransform.ScanSkip(ACount: integer); -begin - IncF(ScanDenom, w0*ACount); - IncF(ScanNumX, sx*ACount); - IncF(scanNumY, shy*ACount); -end; - -{ TBGRATwirlScanner } - -constructor TBGRATwirlScanner.Create(AScanner: IBGRAScanner; ACenter: TPoint; ARadius: single; ATurn: single = 1; AExponent: single = 3); -begin - FScanner := AScanner; - FScanAtFunc := @FScanner.ScanAt; - FCenter := ACenter; - FTurn := ATurn; - FRadius := ARadius; - FExponent := AExponent; -end; - -function TBGRATwirlScanner.ScanAt(X, Y: Single): TBGRAPixel; -var p: TPoint; - d: single; - a,cosa,sina: integer; -begin - p := Point(Round(X)-FCenter.X,Round(Y)-FCenter.Y); - if (abs(p.x) < FRadius) and (abs(p.Y) < FRadius) then - begin - d := sqrt(p.x*p.x+p.y*p.y); - if d < FRadius then - begin - d := (FRadius-d)/FRadius; - if FExponent <> 1 then d := exp(ln(d)*FExponent); - a := round(d*FTurn*65536); - cosa := Cos65536(a)-32768; - sina := Sin65536(a)-32768; - result := FScanner.ScanAt((p.x*cosa+p.y*sina)/32768 + FCenter.X, - (-p.x*sina+p.y*cosa)/32768 + FCenter.Y); - exit; - end; - end; - result := FScanAtFunc(X,Y); -end; - -end. - diff --git a/components/bgrabitmap/bgratypewriter.pas b/components/bgrabitmap/bgratypewriter.pas deleted file mode 100644 index f99437c..0000000 --- a/components/bgrabitmap/bgratypewriter.pas +++ /dev/null @@ -1,1293 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRATypewriter; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, Avl_Tree, BGRABitmapTypes, BGRACanvas2D, BGRATransform; - -type - TGlyphBoxes = array of record - Glyph: string; - Box: TAffineBox; - end; - - { TBGRAGlyph } - - TBGRAGlyph = class - protected - FIdentifier: string; - procedure WriteHeader(AStream: TStream; AName: string; AContentSize: longint); - class procedure ReadHeader(AStream: TStream; out AName: string; out AContentSize: longint); static; - function ContentSize: integer; virtual; - function HeaderName: string; virtual; - procedure WriteContent(AStream: TStream); virtual; - procedure ReadContent(AStream: TStream); virtual; - public - Width,Height: single; - constructor Create(AIdentifier: string); virtual; - constructor Create(AStream: TStream); virtual; - procedure Path({%H-}ADest: IBGRAPath; {%H-}AMatrix: TAffineMatrix; {%H-}AReverse: boolean= false); virtual; - property Identifier: string read FIdentifier; - procedure SaveToStream(AStream: TStream); - class function LoadFromStream(AStream: TStream): TBGRAGlyph; static; - end; - - TKerningInfo = class - IdLeft, IdRight: string; - KerningOffset: single; - end; - - TGlyphPointCurveMode= TEasyBezierCurveMode; - -const - cmAuto = TEasyBezierCurveMode.cmAuto; - cmCurve = TEasyBezierCurveMode.cmCurve; - cmAngle = TEasyBezierCurveMode.cmAngle; - -type - { TBGRAPolygonalGlyph } - - TBGRAPolygonalGlyph = class(TBGRAGlyph) - private - function GetClosed: boolean; - function GetMinimumDotProduct: single; - function GetPoint(AIndex: integer): TPointF; - function GetPointCount: integer; - procedure SetClosed(AValue: boolean); - procedure SetMinimumDotProduct(AValue: single); - procedure SetPoint(AIndex: integer; AValue: TPointF); - procedure SetQuadraticCurves(AValue: boolean); - protected - FQuadraticCurves: boolean; - FEasyBezier: TEasyBezierCurve; - function ContentSize: integer; override; - function HeaderName: string; override; - procedure WriteContent(AStream: TStream); override; - procedure ReadContent(AStream: TStream); override; - function PointTransformMatrix(APoint: PPointF; AData: pointer): TPointF; - procedure Init; - public - Offset: TPointF; - constructor Create(AIdentifier: string); override; - constructor Create(AStream: TStream); override; - constructor Create(AStream: TStream; AQuadratic: boolean); - procedure SetPoints(const APoints: array of TPointF); overload; - procedure SetPoints(const APoints: array of TPointF; const ACurveMode: array of TGlyphPointCurveMode); overload; - procedure Path(ADest: IBGRAPath; AMatrix: TAffineMatrix; AReverse: boolean = false); override; - property QuadraticCurves: boolean read FQuadraticCurves write SetQuadraticCurves; - property Closed: boolean read GetClosed write SetClosed; - property MinimumDotProduct: single read GetMinimumDotProduct write SetMinimumDotProduct; - property Point[AIndex: integer]: TPointF read GetPoint write SetPoint; - property PointCount: integer read GetPointCount; - end; - - TBGRACustomTypeWriterHeader = record - HeaderName: String; - NbGlyphs: integer; - end; - - TBGRAGlyphDisplayInfo = record - Glyph: TBGRAGlyph; - Matrix: TAffineMatrix; - Mirrored, RTL: WordBool; - end; - - TBGRATextDisplayInfo = array of TBGRAGlyphDisplayInfo; - TBrowseGlyphCallbackFlag = (gcfMirrored, gcfMerged, gcfRightToLeft, gcfKerning); - TBrowseGlyphCallbackFlags = set of TBrowseGlyphCallbackFlag; - TBrowseGlyphCallback = procedure(ATextUTF8: string; AGlyph: TBGRAGlyph; - AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean) of object; - - TTextFitInfoCallbackData = record - WidthAccumulator, MaxWidth: single; - CharCount: integer; - ByteCount: integer; - PrevGlyphId: string; - end; - - TDisplayInfoCallbackData = record - Align: TBGRATypeWriterAlignment; - Matrix: TAffineMatrix; - Info: TBGRATextDisplayInfo; - InfoIndex: integer; - PrevGlyphId: string; - end; - - TTextSizeCallbackData = record - Size: TPointF; - PrevGlyphId: string; - end; - - { TBGRACustomTypeWriter } - - TBGRACustomTypeWriter = class - private - FBidiMode: TFontBidiMode; - FGlyphs: TAVLTree; - FKerningInfos: TAVLTree; - procedure GlyphCallbackForDisplayInfo({%H-}ATextUTF8: string; - AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out - AContinue: boolean); - procedure GlyphCallbackForTextFitInfoBeforeTransform(ATextUTF8: string; - AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); - procedure SetBidiMode(AValue: TFontBidiMode); - procedure GlyphCallbackForTextSizeBeforeTransform({%H-}ATextUTF8: string; - AGlyph: TBGRAGlyph; {%H-}AFlags: TBrowseGlyphCallbackFlags; AData: pointer; out AContinue: boolean); - protected - TypeWriterMatrix: TAffineMatrix; - function FindGlyph(AIdentifier: string): TAVLTreeNode; - function GetGlyph(AIdentifier: string): TBGRAGlyph; virtual; - procedure SetGlyph(AIdentifier: string; AValue: TBGRAGlyph); - function GetDisplayInfo(ATextUTF8: string; X,Y: Single; - AAlign: TBGRATypeWriterAlignment): TBGRATextDisplayInfo; - procedure GlyphPath(ADest: TBGRACanvas2D; AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft; AMirrored: boolean = false); - procedure DrawLastPath(ADest: TBGRACanvas2D); - procedure ClearGlyphs; - procedure RemoveGlyph(AIdentifier: string); - procedure AddGlyph(AGlyph: TBGRAGlyph); - function GetGlyphMatrix(AGlyph: TBGRAGlyph; X,Y: Single; AAlign: TBGRATypeWriterAlignment): TAffineMatrix; - function GetTextMatrix(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment): TAffineMatrix; - property Glyph[AIdentifier: string]: TBGRAGlyph read GetGlyph write SetGlyph; - function CustomHeaderSize: integer; virtual; - procedure WriteCustomHeader(AStream: TStream); virtual; - function ReadCustomTypeWriterHeader(AStream: TStream): TBGRACustomTypeWriterHeader; - procedure ReadAdditionalHeader({%H-}AStream: TStream); virtual; - function HeaderName: string; virtual; - procedure BrowseGlyphs(ATextUTF8: string; ACallback: TBrowseGlyphCallback; AData: pointer; ADisplayOrder: boolean); - procedure BrowseAllGlyphs(ACallback: TBrowseGlyphCallback; AData: pointer); - function FindKerning(AIdLeft, AIdRight: string): TAVLTreeNode; - function GetKerningOffset(AIdBefore, AIdAfter: string; ARightToLeft: boolean): single; virtual; - function ComputeKerning(AIdLeft, AIdRight: string): single; virtual; - public - OutlineMode: TBGRATypeWriterOutlineMode; - DrawGlyphsSimultaneously : boolean; - SubstituteBidiBracket: boolean; - LigatureWithF: boolean; - constructor Create; - function GetTextSizeBeforeTransform(ATextUTF8 :string): TPointF; - procedure TextFitInfoBeforeTransform(ATextUTF8: string; AMaxWidth: single; out ACharCount, AByteCount: integer; out AUsedWidth: single); - procedure SaveGlyphsToFile(AFilenameUTF8: string); - procedure SaveGlyphsToStream(AStream: TStream); - procedure LoadGlyphsFromFile(AFilenameUTF8: string); - procedure LoadGlyphsFromStream(AStream: TStream); - procedure DrawGlyph(ADest: TBGRACanvas2D; AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft; AMirrored: boolean = false); - procedure DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); virtual; - procedure CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); virtual; - function GetGlyphBox(AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TAffineBox; - function GetTextBox(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TAffineBox; - function GetTextGlyphBoxes(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes; - procedure NeedGlyphRange(AUnicodeFrom, AUnicodeTo: LongWord); - procedure NeedGlyphAnsiRange; - destructor Destroy; override; - property BidiMode: TFontBidiMode read FBidiMode write SetBidiMode; - end; - -function ComputeEasyBezier(APoints: array of TPointF; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; overload; -function ComputeEasyBezier(APoints: array of TPointF; ACurveMode: array of TGlyphPointCurveMode; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; overload; - -implementation - -uses BGRAUTF8, BGRAUnicode, math; - -procedure LEWritePointF(Stream: TStream; AValue: TPointF); -begin - LEWriteSingle(Stream,AValue.x); - LEWriteSingle(Stream,AValue.y); -end; - -function LEReadPointF(Stream: TStream): TPointF; -begin - result.x := LEReadSingle(Stream); - result.y := LEReadSingle(Stream); -end; - -function ComputeEasyBezier(APoints: array of TPointF; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; -var - glyph: TBGRAPolygonalGlyph; - canvas2D: TBGRACanvas2D; - i: integer; -begin - if length(APoints) <= 2 then - begin - setlength(result, length(APoints)); - for i := 0 to high(result) do - result[i] := APoints[i]; - exit; - end; - glyph := TBGRAPolygonalGlyph.Create(''); - glyph.QuadraticCurves := true; - glyph.Closed:= AClosed; - glyph.MinimumDotProduct := AMinimumDotProduct; - glyph.SetPoints(APoints); - canvas2D := TBGRACanvas2D.Create(nil); - canvas2D.pixelCenteredCoordinates := true; - glyph.Path(canvas2D,AffineMatrixIdentity); - glyph.Free; - result := canvas2D.currentPath; - canvas2D.free; -end; - -function ComputeEasyBezier(APoints: array of TPointF; - ACurveMode: array of TGlyphPointCurveMode; AClosed: boolean; - AMinimumDotProduct: single): ArrayOfTPointF; -var - glyph: TBGRAPolygonalGlyph; - canvas2D: TBGRACanvas2D; - i: integer; -begin - if length(APoints) <= 2 then - begin - setlength(result, length(APoints)); - for i := 0 to high(result) do - result[i] := APoints[i]; - exit; - end; - glyph := TBGRAPolygonalGlyph.Create(''); - glyph.QuadraticCurves := true; - glyph.Closed:= AClosed; - glyph.MinimumDotProduct := AMinimumDotProduct; - glyph.SetPoints(APoints, ACurveMode); - canvas2D := TBGRACanvas2D.Create(nil); - canvas2D.pixelCenteredCoordinates := true; - glyph.Path(canvas2D,AffineMatrixIdentity); - glyph.Free; - result := canvas2D.currentPath; - canvas2D.free; -end; - -{ TBGRAPolygonalGlyph } - -function TBGRAPolygonalGlyph.GetClosed: boolean; -begin - result := FEasyBezier.Closed; -end; - -function TBGRAPolygonalGlyph.GetMinimumDotProduct: single; -begin - result := FEasyBezier.MinimumDotProduct; -end; - -function TBGRAPolygonalGlyph.GetPoint(AIndex: integer): TPointF; -begin - result := FEasyBezier.Point[AIndex]; -end; - -function TBGRAPolygonalGlyph.GetPointCount: integer; -begin - result := FEasyBezier.PointCount; -end; - -procedure TBGRAPolygonalGlyph.SetClosed(AValue: boolean); -begin - FEasyBezier.Closed := AValue; -end; - -procedure TBGRAPolygonalGlyph.SetMinimumDotProduct(AValue: single); -begin - FEasyBezier.MinimumDotProduct := AValue; -end; - -procedure TBGRAPolygonalGlyph.SetPoint(AIndex: integer; AValue: TPointF); -begin - FEasyBezier.Point[AIndex] := AValue; -end; - -procedure TBGRAPolygonalGlyph.SetQuadraticCurves(AValue: boolean); -begin - if FQuadraticCurves=AValue then Exit; - FQuadraticCurves:=AValue; -end; - -function TBGRAPolygonalGlyph.ContentSize: integer; -begin - Result:= (inherited ContentSize) + sizeof(single)*2 + 4 + sizeof(single)*2*PointCount; -end; - -function TBGRAPolygonalGlyph.HeaderName: string; -begin - if FQuadraticCurves then - Result:='TBGRAEasyBezierGlyph' - else - Result:='TBGRAPolygonalGlyph' -end; - -procedure TBGRAPolygonalGlyph.WriteContent(AStream: TStream); -var i: integer; -begin - inherited WriteContent(AStream); - LEWritePointF(AStream, Offset); - LEWriteLongint(AStream,PointCount); - for i := 0 to PointCount-1 do - LEWritePointF(AStream, FEasyBezier.Point[i]); - if FQuadraticCurves then - for i := 0 to PointCount-1 do - LEWriteLongint(AStream, ord(FEasyBezier.CurveMode[i])); -end; - -procedure TBGRAPolygonalGlyph.ReadContent(AStream: TStream); -var i: integer; - tempPts: array of TPointF; - flags: LongInt; -begin - inherited ReadContent(AStream); - Offset := LEReadPointF(AStream); - SetLength(tempPts, LEReadLongint(AStream)); - for i := 0 to high(tempPts) do - tempPts[i] := LEReadPointF(AStream); - SetPoints(tempPts); - if FQuadraticCurves then - begin - for i := 0 to high(tempPts) do - begin - flags := LEReadLongint(AStream); - FEasyBezier.CurveMode[i] := TEasyBezierCurveMode(flags and 255); - end; - end; -end; - -function TBGRAPolygonalGlyph.PointTransformMatrix(APoint: PPointF; - AData: pointer): TPointF; -begin - result := TAffineMatrix(AData^) * APoint^; -end; - -procedure TBGRAPolygonalGlyph.Init; -begin - FEasyBezier.Init; - Closed := True; - Offset := PointF(0,0); - FQuadraticCurves:= False; -end; - -constructor TBGRAPolygonalGlyph.Create(AIdentifier: string); -begin - Init; - inherited Create(AIdentifier); -end; - -constructor TBGRAPolygonalGlyph.Create(AStream: TStream); -begin - Init; - inherited Create(AStream); -end; - -constructor TBGRAPolygonalGlyph.Create(AStream: TStream; AQuadratic: boolean); -begin - Init; - FQuadraticCurves:= AQuadratic; - inherited Create(AStream); -end; - -procedure TBGRAPolygonalGlyph.SetPoints(const APoints: array of TPointF); -begin - FEasyBezier.SetPoints(APoints, cmAuto); -end; - -procedure TBGRAPolygonalGlyph.SetPoints(const APoints: array of TPointF; - const ACurveMode: array of TGlyphPointCurveMode); -begin - if length(APoints) <> length(ACurveMode) then - raise exception.Create('Dimension mismatch'); - FEasyBezier.SetPoints(APoints, ACurveMode); -end; - -procedure TBGRAPolygonalGlyph.Path(ADest: IBGRAPath; AMatrix: TAffineMatrix; - AReverse: boolean); -var - nextMove: boolean; - - procedure DoPoint(AIndex: integer); - begin - if isEmptyPointF(Point[AIndex]) then - begin - if not nextMove and Closed then ADest.closePath; - nextMove := true; - end else - begin - if nextMove then - begin - ADest.moveTo(AMatrix*Point[AIndex]); - nextMove := false; - end else - ADest.lineTo(AMatrix*Point[AIndex]); - end; - end; - -var - i: integer; -begin - AMatrix := AMatrix*AffineMatrixTranslation(Offset.X,Offset.Y); - if not FQuadraticCurves then - begin - nextMove := true; - if AReverse then - begin - for i := PointCount-1 downto 0 do - DoPoint(i); - end else - for i := 0 to PointCount-1 do - DoPoint(i); - if not nextmove and Closed then ADest.closePath; - end else - FEasyBezier.CopyToPath(ADest, @PointTransformMatrix, @AMatrix, AReverse); -end; - -{ TBGRAGlyph } - -procedure TBGRAGlyph.WriteHeader(AStream: TStream; AName: string; - AContentSize: longint); -begin - LEWriteByte(AStream, length(AName)); - AStream.Write(AName[1],length(AName)); - LEWriteLongint(AStream, AContentSize); -end; - -class procedure TBGRAGlyph.ReadHeader(AStream: TStream; out AName: string; out - AContentSize: longint); -var NameLength: integer; -begin - NameLength := LEReadByte(AStream); - setlength(AName,NameLength); - AStream.Read(AName[1],length(AName)); - AContentSize := LEReadLongint(AStream); -end; - -function TBGRAGlyph.ContentSize: integer; -begin - result := 4+length(FIdentifier)+sizeof(single)*2; -end; - -function TBGRAGlyph.HeaderName: string; -begin - result := 'TBGRAGlyph'; -end; - -procedure TBGRAGlyph.WriteContent(AStream: TStream); -begin - LEWriteLongint(AStream,length(FIdentifier)); - AStream.Write(FIdentifier[1],length(FIdentifier)); - LEWriteSingle(AStream,Width); - LEWriteSingle(AStream,Height); -end; - -procedure TBGRAGlyph.ReadContent(AStream: TStream); -var lIdentifierLength: integer; -begin - lIdentifierLength:= LEReadLongint(AStream); - setlength(FIdentifier, lIdentifierLength); - AStream.Read(FIdentifier[1],length(FIdentifier)); - Width := LEReadSingle(AStream); - Height := LEReadSingle(AStream); -end; - -constructor TBGRAGlyph.Create(AIdentifier: string); -begin - FIdentifier:= AIdentifier; -end; - -constructor TBGRAGlyph.Create(AStream: TStream); -begin - ReadContent(AStream); -end; - -procedure TBGRAGlyph.Path(ADest: IBGRAPath; AMatrix: TAffineMatrix; - AReverse: boolean); -begin - //nothing -end; - -procedure TBGRAGlyph.SaveToStream(AStream: TStream); -begin - WriteHeader(AStream, HeaderName, ContentSize); - WriteContent(AStream); -end; - -class function TBGRAGlyph.LoadFromStream(AStream: TStream) : TBGRAGlyph; -var lName: string; - lContentSize: integer; - EndPosition: Int64; -begin - ReadHeader(AStream,lName,lContentSize); - EndPosition := AStream.Position + lContentSize; - if lName = 'TBGRAPolygonalGlyph' then - result := TBGRAPolygonalGlyph.Create(AStream) - else if lName = 'TBGRAEasyBezierGlyph' then - result := TBGRAPolygonalGlyph.Create(AStream, true) - else if lName = 'TBGRAGlyph' then - result := TBGRAGlyph.Create(AStream) - else - raise exception.Create('Unknown glyph type (' + lName + ')'); - AStream.Position:= EndPosition; -end; - -function CompareGlyphNode(Data1, Data2: Pointer): integer; -begin - result := CompareStr(TBGRAGlyph(Data1).Identifier,TBGRAGlyph(Data2).Identifier); -end; - -function CompareKerningInfo(Data1, Data2: Pointer): integer; -begin - result := CompareStr(TKerningInfo(Data1).IdLeft, TKerningInfo(Data2).IdLeft); - if result = 0 then - result := CompareStr(TKerningInfo(Data1).IdRight, TKerningInfo(Data2).IdRight); -end; - -{ TBGRACustomTypeWriter } - -function TBGRACustomTypeWriter.GetGlyph(AIdentifier: string): TBGRAGlyph; -var Node: TAVLTreeNode; -begin - Node := FindGlyph(AIdentifier); - if Node = nil then - result := nil - else - result := TBGRAGlyph(Node.Data); -end; - -procedure TBGRACustomTypeWriter.SetGlyph(AIdentifier: string; AValue: TBGRAGlyph); -var Node: TAVLTreeNode; -begin - if AValue.Identifier <> AIdentifier then - raise exception.Create('Identifier mismatch'); - Node := FindGlyph(AIdentifier); - if Node <> nil then - begin - if pointer(AValue) <> Node.Data then - TBGRAGlyph(Node.Data).Free; - Node.Data := AValue; - end else - FGlyphs.Add(pointer(AValue)); -end; - -procedure TBGRACustomTypeWriter.SetBidiMode(AValue: TFontBidiMode); -begin - if FBidiMode=AValue then Exit; - FBidiMode:=AValue; -end; - -procedure TBGRACustomTypeWriter.GlyphCallbackForTextFitInfoBeforeTransform( - ATextUTF8: string; AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; - AData: Pointer; out AContinue: boolean); -var - newWidth: Single; - partialCharCount, charLen: Integer; - p,pEnd: PChar; -begin - AContinue := true; - with TTextFitInfoCallbackData(AData^) do - begin - newWidth := WidthAccumulator+AGlyph.Width; - if gcfKerning in AFlags then - IncF(newWidth, GetKerningOffset(PrevGlyphId, AGlyph.Identifier, gcfRightToLeft in AFlags)); - if newWidth < MaxWidth then - begin - WidthAccumulator := newWidth; - inc(ByteCount, length(ATextUTF8)); - inc(CharCount, UTF8Length(ATextUTF8)); - end else - begin - AContinue := false; - if gcfMerged in AFlags then - begin - partialCharCount := Trunc(UTF8Length(ATextUTF8)*(MaxWidth-WidthAccumulator)/AGlyph.Width); - p := @ATextUTF8[1]; - pEnd := p+length(ATextUTF8); - while (p 0) do - begin - charLen := UTF8CharacterLength(p); - inc(p, charLen); - inc(ByteCount, charLen); - inc(CharCount); - dec(partialCharCount); - end; - end; - end; - PrevGlyphId:= AGlyph.Identifier; - end; -end; - -procedure TBGRACustomTypeWriter.GlyphCallbackForDisplayInfo(ATextUTF8: string; - AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); -var - m2: TAffineMatrix; - kerning: Single; -begin - with TDisplayInfoCallbackData(AData^) do - begin - if gcfKerning in AFlags then - begin - if gcfRightToLeft in AFlags then - kerning := GetKerningOffset(AGlyph.Identifier, PrevGlyphId, gcfRightToLeft in AFlags) - else kerning := GetKerningOffset(PrevGlyphId, AGlyph.Identifier, gcfRightToLeft in AFlags); - Matrix := Matrix*AffineMatrixTranslation(kerning,0); - end; - - if Align in [twaLeft,twaMiddle,twaRight] then - m2 := Matrix*AffineMatrixTranslation(0,-AGlyph.Height/2) else - if Align in [twaBottomLeft,twaBottom,twaBottomRight] then - m2 := Matrix*AffineMatrixTranslation(0,-AGlyph.Height) - else - m2 := Matrix; - - if gcfMirrored in AFlags then - m2 := m2*AffineMatrixTranslation(AGlyph.Width,0)*AffineMatrixScale(-1,1); - - Info[InfoIndex].Glyph := AGlyph; - Info[InfoIndex].Mirrored:= gcfMirrored in AFlags; - Info[InfoIndex].RTL := gcfRightToLeft in AFlags; - Info[InfoIndex].Matrix := m2; - - Matrix := Matrix*AffineMatrixTranslation(AGlyph.Width,0); - inc(InfoIndex); - PrevGlyphId := AGlyph.Identifier; - end; - AContinue:= true; -end; - -function TBGRACustomTypeWriter.FindGlyph(AIdentifier: string): TAVLTreeNode; -var Comp: integer; - Node: TAVLTreeNode; -begin - Node:=FGlyphs.Root; - while (Node<>nil) do begin - Comp:=CompareStr(AIdentifier,TBGRAGlyph(Node.Data).Identifier); - if Comp=0 then break; - if Comp<0 then begin - Node:=Node.Left - end else begin - Node:=Node.Right - end; - end; - result := Node; -end; - -constructor TBGRACustomTypeWriter.Create; -begin - FGlyphs := TAVLTree.Create(@CompareGlyphNode); - TypeWriterMatrix := AffineMatrixIdentity; - OutlineMode:= twoFill; - DrawGlyphsSimultaneously := false; - FKerningInfos := nil; -end; - -function TBGRACustomTypeWriter.GetTextSizeBeforeTransform(ATextUTF8: string): TPointF; -var data: TTextSizeCallbackData; -begin - data.Size := PointF(0,0); - data.PrevGlyphId:= ''; - BrowseGlyphs(ATextUTF8, @GlyphCallbackForTextSizeBeforeTransform, @data, false); - result := data.Size; -end; - -procedure TBGRACustomTypeWriter.TextFitInfoBeforeTransform(ATextUTF8: string; AMaxWidth: single; - out ACharCount, AByteCount: integer; out AUsedWidth: single); -var - data: TTextFitInfoCallbackData; -begin - data.WidthAccumulator:= 0; - data.MaxWidth := AMaxWidth; - data.CharCount:= 0; - data.ByteCount:= 0; - data.PrevGlyphId:= ''; - BrowseGlyphs(ATextUTF8, @GlyphCallbackForTextFitInfoBeforeTransform, @data, false); - ACharCount:= data.CharCount; - AByteCount:= data.ByteCount; - AUsedWidth:= data.WidthAccumulator; -end; - -procedure TBGRACustomTypeWriter.DrawGlyph(ADest: TBGRACanvas2D; - AIdentifier: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment; AMirrored: boolean); -begin - GlyphPath(ADest, AIdentifier, X,Y, AAlign, AMirrored); - DrawLastPath(ADest); -end; - -procedure TBGRACustomTypeWriter.DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; - X, Y: Single; AAlign: TBGRATypeWriterAlignment); -var - di: TBGRATextDisplayInfo; - i: Integer; -begin - di := GetDisplayInfo(ATextUTF8,x,y,AAlign); - - if (OutlineMode <> twoPath) and not DrawGlyphsSimultaneously then - begin - //draw each glyph - for i := 0 to high(di) do - begin - ADest.beginPath; - di[i].Glyph.Path(ADest, di[i].Matrix, di[i].Mirrored); - DrawLastPath(ADest); - end; - end else - begin - ADest.beginPath; - for i := 0 to high(di) do - di[i].Glyph.Path(ADest, di[i].Matrix, di[i].Mirrored); - DrawLastPath(ADest); - end; -end; - -procedure TBGRACustomTypeWriter.CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); -var - i: integer; - di: TBGRATextDisplayInfo; -begin - di := GetDisplayInfo(ATextUTF8,x,y,AAlign); - for i := 0 to high(di) do - di[i].Glyph.Path(ADest, di[i].Matrix, di[i].Mirrored); -end; - -function TBGRACustomTypeWriter.GetGlyphBox(AIdentifier: string; X, Y: Single; - AAlign: TBGRATypeWriterAlignment): TAffineBox; -var g: TBGRAGlyph; - m: TAffineMatrix; -begin - g := GetGlyph(AIdentifier); - if g = nil then result := TAffineBox.EmptyBox else - begin - m := GetGlyphMatrix(g,X,Y,AAlign); - result := TAffineBox.AffineBox(m*PointF(0,0),m*PointF(g.Width,0),m*PointF(0,g.Height)); - end; -end; - -function TBGRACustomTypeWriter.GetTextBox(ATextUTF8: string; X, Y: Single; - AAlign: TBGRATypeWriterAlignment): TAffineBox; -var - m: TAffineMatrix; - size: TPointF; -begin - if ATextUTF8 = '' then result := TAffineBox.EmptyBox else - begin - size := GetTextSizeBeforeTransform(ATextUTF8); - m := AffineMatrixTranslation(X,Y)*TypeWriterMatrix; - if AAlign in[twaTop,twaMiddle,twaBottom] then m := m*AffineMatrixTranslation(-size.x/2,0) else - if AAlign in[twaTopRight, twaRight, twaBottomRight] then m := m*AffineMatrixTranslation(-size.x,0); - if AAlign in [twaLeft,twaMiddle,twaRight] then m := m*AffineMatrixTranslation(0,-size.y/2) else - if AAlign in [twaBottomLeft,twaBottom,twaBottomRight] then m := m*AffineMatrixTranslation(0,-size.y); - result := TAffineBox.AffineBox(m*PointF(0,0),m*PointF(size.x,0),m*PointF(0,size.y)); - end; -end; - -function TBGRACustomTypeWriter.GetTextGlyphBoxes(ATextUTF8: string; X, Y: Single; - AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; -var - di: TBGRATextDisplayInfo; - i: Integer; -begin - di := GetDisplayInfo(ATextUTF8, X,Y, AAlign); - setlength(result, length(di)); - for i := 0 to high(result) do - with di[i] do - begin - result[i].Glyph := Glyph.Identifier; - result[i].Box := TAffineBox.AffineBox(Matrix*PointF(0,0),Matrix*PointF(Glyph.Width,0),Matrix*PointF(0,Glyph.Height)); - end; -end; - -procedure TBGRACustomTypeWriter.NeedGlyphRange(AUnicodeFrom, AUnicodeTo: LongWord); -var c: LongWord; -begin - for c := AUnicodeFrom to AUnicodeTo do - GetGlyph(UnicodeCharToUTF8(c)); -end; - -procedure TBGRACustomTypeWriter.NeedGlyphAnsiRange; -var i: integer; -begin - for i := 0 to 255 do - GetGlyph(AnsiToUtf8(chr(i))); -end; - -function TBGRACustomTypeWriter.GetDisplayInfo(ATextUTF8: string; X, - Y: Single; AAlign: TBGRATypeWriterAlignment): TBGRATextDisplayInfo; -var - data: TDisplayInfoCallbackData; -begin - data.Align := AAlign; - data.Matrix := GetTextMatrix(ATextUTF8, X,Y,AAlign); - setlength(data.Info, UTF8Length(ATextUTF8)); - data.InfoIndex := 0; - data.PrevGlyphId:= ''; - BrowseGlyphs(ATextUTF8, @GlyphCallbackForDisplayInfo, @data, true); - setlength(data.Info, data.InfoIndex); - result := data.Info; -end; - -procedure TBGRACustomTypeWriter.GlyphPath(ADest: TBGRACanvas2D; AIdentifier: string; - X, Y: Single; AAlign: TBGRATypeWriterAlignment; AMirrored: boolean); -var g: TBGRAGlyph; -begin - ADest.beginPath; - g := GetGlyph(AIdentifier); - if g = nil then exit; - if AMirrored then - g.Path(ADest, GetGlyphMatrix(g,X,Y,AAlign), AMirrored) - else - g.Path(ADest, GetGlyphMatrix(g,X,Y,AAlign)*AffineMatrixTranslation(g.Width,0)*AffineMatrixScale(-1,1), AMirrored); -end; - -procedure TBGRACustomTypeWriter.DrawLastPath(ADest: TBGRACanvas2D); -begin - case OutlineMode of - twoPath: ; - twoFill: ADest.fill; - twoStroke: ADest.stroke; - twoFillOverStroke: ADest.fillOverStroke; - twoStrokeOverFill: ADest.strokeOverFill; - twoFillThenStroke: begin ADest.fill; ADest.stroke; end; - twoStrokeThenFill: begin ADest.stroke; ADest.fill; end; - end; -end; - -procedure TBGRACustomTypeWriter.ClearGlyphs; -begin - FGlyphs.FreeAndClear; - if Assigned(FKerningInfos) then - FKerningInfos.FreeAndClear; -end; - -procedure TBGRACustomTypeWriter.RemoveGlyph(AIdentifier: string); -var Node: TAVLTreeNode; -begin - Node := FindGlyph(AIdentifier); - if Node <> nil then FGlyphs.FreeAndDelete(Node); -end; - -procedure TBGRACustomTypeWriter.AddGlyph(AGlyph: TBGRAGlyph); -begin - Glyph[AGlyph.Identifier] := AGlyph; -end; - -procedure TBGRACustomTypeWriter.SaveGlyphsToStream(AStream: TStream); -var - Enumerator: TAVLTreeNodeEnumerator; -begin - LEWriteLongint(AStream,CustomHeaderSize); - WriteCustomHeader(AStream); - - Enumerator := FGlyphs.GetEnumerator; - while Enumerator.MoveNext do - TBGRAGlyph(Enumerator.Current.Data).SaveToStream(AStream); - Enumerator.Free; -end; - -procedure TBGRACustomTypeWriter.LoadGlyphsFromFile(AFilenameUTF8: string); -var Stream: TFileStreamUTF8; -begin - Stream := nil; - try - Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead); - LoadGlyphsFromStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TBGRACustomTypeWriter.LoadGlyphsFromStream(AStream: TStream); -var Header: TBGRACustomTypeWriterHeader; - i: integer; - g: TBGRAGlyph; - HeaderSize: integer; - GlyphStartPosition: Int64; -begin - HeaderSize := LEReadLongint(AStream); - GlyphStartPosition:= AStream.Position+HeaderSize; - Header := ReadCustomTypeWriterHeader(AStream); - if header.HeaderName <> HeaderName then - raise exception.Create('Invalid file format ("'+header.HeaderName+'" should be "'+HeaderName+'")'); - ReadAdditionalHeader(AStream); - AStream.Position:= GlyphStartPosition; - for i := 0 to Header.NbGlyphs-1 do - begin - g := TBGRAGlyph.LoadFromStream(AStream); - AddGlyph(g); - end; -end; - -procedure TBGRACustomTypeWriter.SaveGlyphsToFile(AFilenameUTF8: string); -var Stream: TFileStreamUTF8; -begin - Stream := nil; - try - Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate or fmOpenWrite); - SaveGlyphsToStream(Stream); - finally - Stream.Free; - end; -end; - -function TBGRACustomTypeWriter.GetGlyphMatrix(AGlyph: TBGRAGlyph; X, Y: Single; - AAlign: TBGRATypeWriterAlignment): TAffineMatrix; -var tGlyph: TPointF; -begin - if AGlyph = nil then - begin - result := AffineMatrixIdentity; - exit; - end; - tGlyph := PointF(0,0); - if AAlign in [twaTop,twaMiddle,twaBottom] then DecF(tGlyph.X, AGlyph.Width/2); - if AAlign in [twaTopRight,twaRight,twaBottomRight] then DecF(tGlyph.X, AGlyph.Width); - if AAlign in [twaLeft,twaMiddle,twaRight] then DecF(tGlyph.Y, AGlyph.Height/2); - if AAlign in [twaBottomLeft,twaBottom,twaBottomRight] then DecF(tGlyph.Y, AGlyph.Height); - result := AffineMatrixTranslation(X,Y)*TypeWriterMatrix*AffineMatrixTranslation(tGlyph.X,tGlyph.Y); -end; - -function TBGRACustomTypeWriter.GetTextMatrix(ATextUTF8: string; X, Y: Single; - AAlign: TBGRATypeWriterAlignment): TAffineMatrix; -var - tGlyph, size: TPointF; -begin - tGlyph := PointF(0,0); - if not (AAlign in [twaLeft,twaTopLeft,twaBottomLeft]) then - begin - size := GetTextSizeBeforeTransform(ATextUTF8); - if AAlign in[twaTop,twaMiddle,twaBottom] then tGlyph.X := -size.x/2 else - if AAlign in[twaTopRight, twaRight, twaBottomRight] then tGlyph.X := -size.x; - end; - result := AffineMatrixTranslation(X,Y)*TypeWriterMatrix*AffineMatrixTranslation(tGlyph.X,tGlyph.Y); -end; - -function TBGRACustomTypeWriter.CustomHeaderSize: integer; -begin - result := 1+length(HeaderName)+4; -end; - -procedure TBGRACustomTypeWriter.WriteCustomHeader(AStream: TStream); -var lHeaderName: string; -begin - lHeaderName:= HeaderName; - LEWriteByte(AStream,length(lHeaderName)); - AStream.Write(lHeaderName[1],length(lHeaderName)); - LEWriteLongint(AStream,FGlyphs.Count); -end; - -function TBGRACustomTypeWriter.ReadCustomTypeWriterHeader(AStream: TStream - ): TBGRACustomTypeWriterHeader; -begin - setlength(result.HeaderName, LEReadByte(AStream)); - AStream.Read(result.HeaderName[1],length(result.HeaderName)); - result.NbGlyphs:= LEReadLongint(AStream); -end; - -procedure TBGRACustomTypeWriter.ReadAdditionalHeader(AStream: TStream); -begin - //nothing -end; - -function TBGRACustomTypeWriter.HeaderName: string; -begin - result := 'TBGRACustomTypeWriter'; -end; - -procedure TBGRACustomTypeWriter.BrowseGlyphs(ATextUTF8: string; - ACallback: TBrowseGlyphCallback; AData: pointer; ADisplayOrder: boolean); -type - TCharInfo = record - charStart, charEnd: integer; - bidiInfo: PUnicodeBidiInfo; - end; - function CharEquals(const info: TCharInfo; text: string): boolean; - var - i: Integer; - begin - if info.charEnd-info.charStart >= length(text) then - begin - for i := 1 to length(text) do - if ATextUTF8[info.charStart+i-1] <> text[i] then exit(false); - result := true; - end else - result := false; - end; -var - bidiArray: TBidiUTF8Array; - charInfo: array of TCharInfo; - - procedure OrderedCharInfo; - var - displayOrder: TUnicodeDisplayOrder; - bidiIdx, orderIndex, nb: integer; - begin - displayOrder := GetUTF8DisplayOrder(bidiArray); - orderIndex := 0; - nb := 0; - for orderIndex := 0 to high(displayOrder) do - if bidiArray[displayOrder[orderIndex]].BidiInfo.IsMulticharStart then inc(nb); - setlength(charInfo, nb); - nb := 0; - for orderIndex := 0 to high(displayOrder) do - if bidiArray[displayOrder[orderIndex]].BidiInfo.IsMulticharStart then - begin - bidiIdx := displayOrder[orderIndex]; - charInfo[nb].charStart := bidiArray[bidiIdx].Offset+1; - charInfo[nb].bidiInfo := @bidiArray[bidiIdx].BidiInfo; - while (bidiIdx < high(bidiArray)) and - not bidiArray[bidiIdx+1].BidiInfo.IsMulticharStart do inc(bidiIdx); - if bidiIdx < high(bidiArray) then charInfo[nb].charEnd := bidiArray[bidiIdx+1].Offset+1 - else charInfo[nb].charEnd := length(ATextUTF8)+1; - inc(nb); - end; - end; - - procedure UnorderedCharInfo; - var - i,nb: Integer; - begin - nb := 0; - i := 0; - while i <= high(bidiArray) do - begin - if not bidiArray[i].BidiInfo.IsRemoved then - begin - inc(nb); - while (i < high(bidiArray)) and not bidiArray[i+1].BidiInfo.IsMulticharStart do inc(i); - end; - inc(i); - end; - setlength(charInfo,nb); - nb := 0; - i := 0; - while i <= high(bidiArray) do - begin - if not bidiArray[i].BidiInfo.IsRemoved then - begin - charInfo[nb].charStart := bidiArray[i].Offset+1; - charInfo[nb].bidiInfo:= @bidiArray[i].BidiInfo; - while (i < high(bidiArray)) and not bidiArray[i+1].BidiInfo.IsMulticharStart do inc(i); - if i < high(bidiArray) then charInfo[nb].charEnd := bidiArray[i+1].Offset+1 - else charInfo[nb].charEnd := length(ATextUTF8)+1; - inc(nb); - end; - inc(i); - end; - end; - -var - cur,curStart: integer; - curRTL,curRTLScript,curLigatureLeft,curLigatureRight,merged: boolean; - - procedure TryMerge(const AChars: array of string); - var - i: Integer; - match: Boolean; - begin - if merged or (cur-1+length(AChars) > length(charInfo)) then exit; - if length(AChars)<=1 then raise exception.Create('Expecting several characters'); - match := true; - if not ADisplayOrder and curRTL then - begin - for i := 0 to high(AChars) do - if not CharEquals(charInfo[cur-1+high(AChars)-i], AChars[i]) then match := false; - end else - for i := 0 to high(AChars) do - if not CharEquals(charInfo[cur-1+i], AChars[i]) then match := false; - if match then - begin - inc(cur, length(AChars)-1); - if not ADisplayOrder and curRTL then - curLigatureLeft:= charInfo[cur-1].bidiInfo^.HasLigatureLeft - else - curLigatureRight:= charInfo[cur-1].bidiInfo^.HasLigatureRight; - merged := true; - end; - end; - -var - nextchar,glyphId: string; - g: TBGRAGlyph; - u: LongWord; - shouldContinue: boolean; - flags: TBrowseGlyphCallbackFlags; - i,charDestPos,charLen: integer; - prevGlyphId: string; - prevRTL: boolean; - bracketInfo: TUnicodeBracketInfo; -begin - if ATextUTF8 = '' then exit; - - bidiArray := AnalyzeBidiUTF8(ATextUTF8, BidiMode); - if ADisplayOrder then OrderedCharInfo else UnorderedCharInfo; - - cur := 0; - prevGlyphId:= ''; - prevRTL := false; - while cur < length(charInfo) do - begin - curStart := cur; - curRTL:= charInfo[cur].bidiInfo^.IsRightToLeft; - curRTLScript := charInfo[cur].bidiInfo^.IsRightToLeftScript; - curLigatureLeft:= charInfo[cur].bidiInfo^.HasLigatureLeft; - curLigatureRight:= charInfo[cur].bidiInfo^.HasLigatureRight; - merged := false; - inc(cur); - TryMerge(['f','f','i']); - TryMerge(['f','f','l']); - TryMerge(['f','f']); - TryMerge(['f','i']); - TryMerge(['f','l']); - TryMerge([UTF8_ARABIC_ALEPH,UTF8_ARABIC_LAM]); - TryMerge([UTF8_ARABIC_ALEPH_HAMZA_ABOVE,UTF8_ARABIC_LAM]); - TryMerge([UTF8_ARABIC_ALEPH_HAMZA_BELOW,UTF8_ARABIC_LAM]); - TryMerge([UTF8_ARABIC_ALEPH_MADDA_ABOVE,UTF8_ARABIC_LAM]); - //text extract correspond to the unordered actual sequence of characters - setlength(nextchar, max(charInfo[curStart].charEnd, charInfo[cur-1].charEnd) - -min(charInfo[curStart].charStart, charInfo[cur-1].charStart)); - move(ATextUTF8[min(charInfo[curStart].charStart, charInfo[cur-1].charStart)], nextchar[1], length(nextchar)); - //glyph direction corresponds to script direction - if (curRTL and not ADisplayOrder) <> curRTLScript then - begin - setlength(glyphId, length(nextChar)); - charDestPos := 1; - for i := cur-1 downto curStart do - begin - charLen := charInfo[i].charEnd-charInfo[i].charStart; - move(ATextUTF8[charInfo[i].charStart], glyphId[charDestPos], charLen); - inc(charDestPos, charLen); - end; - end else - begin - setlength(glyphId, length(nextChar)); - charDestPos := 1; - for i := curStart to cur-1 do - begin - charLen := charInfo[i].charEnd-charInfo[i].charStart; - move(ATextUTF8[charInfo[i].charStart], glyphId[charDestPos], charLen); - inc(charDestPos, charLen); - end; - end; - glyphId := UTF8Ligature(glyphId, curRTLScript, curLigatureLeft, curLigatureRight); - flags := []; - if merged then include(flags, gcfMerged); - if curRTL then include(flags, gcfRightToLeft); - if curRTL and charInfo[curStart].bidiInfo^.IsMirrored and (UTF8Length(glyphId)=1) then - begin - u := UTF8CodepointToUnicode(pchar(glyphId), length(glyphId)); - if SubstituteBidiBracket then - begin - bracketInfo := GetUnicodeBracketInfo(u); - if bracketInfo.OpeningBracket = u then - glyphId := UnicodeCharToUTF8(bracketInfo.ClosingBracket) - else if bracketInfo.ClosingBracket = u then - glyphId := UnicodeCharToUTF8(bracketInfo.OpeningBracket) - else - include(flags, gcfMirrored); - end else - include(flags, gcfMirrored); - end; - g := GetGlyph(glyphId); - if g <> nil then - begin - if (prevGlyphId <> '') and (curRTL = prevRTL) then include(flags, gcfKerning); - ACallback(nextchar, g, flags, AData, shouldContinue); - prevGlyphId := glyphId; - prevRTL := curRTL; - if not shouldContinue then break; - end; - end; -end; - -procedure TBGRACustomTypeWriter.BrowseAllGlyphs( - ACallback: TBrowseGlyphCallback; AData: pointer); -var - g: TAVLTreeNode; - shouldContinue: boolean; -begin - g := FGlyphs.FindLowest; - shouldContinue:= true; - while Assigned(g) and shouldContinue do - begin - ACallback(TBGRAGlyph(g.Data).Identifier, TBGRAGlyph(g.Data), [], - AData, shouldContinue); - g := g.Right; - end; -end; - -procedure TBGRACustomTypeWriter.GlyphCallbackForTextSizeBeforeTransform( - ATextUTF8: string; AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; - AData: pointer; out AContinue: boolean); -var - gSizeY: Single; -begin - with TTextSizeCallbackData(AData^) do - begin - if gcfKerning in AFlags then - incF(size.x, GetKerningOffset(PrevGlyphId, AGlyph.Identifier, gcfRightToLeft in AFlags) ); - IncF(Size.x, AGlyph.Width); - gSizeY := AGlyph.Height; - if gSizeY > Size.y then Size.y := gSizeY; - PrevGlyphId:= AGlyph.Identifier; - end; - AContinue:= true; -end; - -function TBGRACustomTypeWriter.FindKerning(AIdLeft, AIdRight: string): TAVLTreeNode; -var Comp: integer; - Node: TAVLTreeNode; -begin - if not Assigned(FKerningInfos) then exit(nil); - Node:=FKerningInfos.Root; - while (Node<>nil) do begin - Comp:=CompareStr(AIdLeft,TKerningInfo(Node.Data).IdLeft); - if Comp=0 then - Comp:=CompareStr(AIdRight,TKerningInfo(Node.Data).IdRight); - if Comp=0 then break; - if Comp<0 then begin - Node:=Node.Left - end else begin - Node:=Node.Right - end; - end; - result := Node; -end; - -function TBGRACustomTypeWriter.GetKerningOffset(AIdBefore, AIdAfter: string; ARightToLeft: boolean): single; -var - temp: String; - node: TAVLTreeNode; - info: TKerningInfo; -begin - if ARightToLeft then - begin - temp := AIdBefore; - AIdBefore := AIdAfter; - AIdAfter := temp; - end; - if FKerningInfos = nil then - FKerningInfos := TAVLTree.Create(@CompareKerningInfo); - node := FindKerning(AIdBefore, AIdAfter); - if Assigned(node) then - result := TKerningInfo(node.Data).KerningOffset - else - begin - result := ComputeKerning(AIdBefore, AIdAfter); - info := TKerningInfo.Create; - info.IdLeft:= AIdBefore; - info.IdRight:= AIdAfter; - info.KerningOffset:= result; - FKerningInfos.Add(Pointer(info)); - end; -end; - -function TBGRACustomTypeWriter.ComputeKerning(AIdLeft, AIdRight: string): single; -begin - result := 0; -end; - -destructor TBGRACustomTypeWriter.Destroy; -begin - if Assigned(FKerningInfos) then - begin - FKerningInfos.FreeAndClear; - FKerningInfos.Free; - end; - FGlyphs.FreeAndClear; - FGlyphs.Free; - inherited Destroy; -end; - -end. - diff --git a/components/bgrabitmap/bgraunicode.pas b/components/bgrabitmap/bgraunicode.pas deleted file mode 100644 index 5962e71..0000000 --- a/components/bgrabitmap/bgraunicode.pas +++ /dev/null @@ -1,1301 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAUnicode; -{ Implementation of Unicode bidi algorithm } -{ Author: circular } - -{$mode objfpc}{$H+} -{$modeswitch advancedrecords} - -interface - -uses - BGRAClasses, SysUtils; - -type - TUnicodeBidiClass = (ubcBoundaryNeutral, ubcSegmentSeparator, ubcParagraphSeparator, ubcWhiteSpace, ubcOtherNeutrals, - ubcCommonSeparator, ubcNonSpacingMark, - ubcLeftToRight, ubcEuropeanNumber, ubcEuropeanNumberSeparator, ubcEuropeanNumberTerminator, - ubcRightToLeft, ubcArabicLetter, ubcArabicNumber, - ubcUnknown, - ubcCombiningLeftToRight, //ubcLeftToRight in Mc category - ubcMirroredNeutral); //ubcOtherNeutrals with Mirrored property - TUnicodeJoiningType = (ujtNonJoining{U}, ujtTransparent{T}, ujtRightJoining{R}, ujtLeftJoining{L}, - ujtDualJoining{D}, ujtJoinCausing{C}); - TFontBidiMode = (fbmAuto, fbmLeftToRight, fbmRightToLeft); - -const - ubcNeutral = [ubcSegmentSeparator, ubcParagraphSeparator, ubcWhiteSpace, ubcOtherNeutrals]; - - BIDI_FLAG_REMOVED = 1; //RLE, LRE, RLO, LRO, PDF and BN are supposed to be removed - BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH = 2; //implicit end of paragraph (paragraph spacing below due to end of text) - BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH = 4; //explicit end of paragraph (paragraph spacing below due to paragraph split) - BIDI_FLAG_END_OF_LINE = 8; //line break
- BIDI_FLAG_LIGATURE_RIGHT = 16; //joins to the letter on the right (possible for joining type R and D) - BIDI_FLAG_LIGATURE_LEFT = 32; //joins to the letter on the left (possible for joining type L and D) - BIDI_FLAG_LIGATURE_BOUNDARY = 64; //zero-width joiner or non-joiner - BIDI_FLAG_LIGATURE_TRANSPARENT = 128; //does not affect ligature - BIDI_FLAG_RTL_SCRIPT = 256; //script is written from right to left (arabic, N'Ko...) - BIDI_FLAG_NON_SPACING_MARK = 512; //it is a non-spacing mark - BIDI_FLAG_COMBINING_LEFT = 1024; //this letter is to be combined to the left of previous letter - BIDI_FLAG_COMBINING_RIGHT = 2048; //this letter is to be combined to the right of previous letter - BIDI_FLAG_MULTICHAR_START = 4096; //start of a multichar (letter + non spacing marks, non spacing marks) - BIDI_FLAG_MIRRORED = 8192; //the glyph is mirrored when in RTL text - -type - PUnicodeBidiInfo = ^TUnicodeBidiInfo; - - { TUnicodeBidiInfo } - - TUnicodeBidiInfo = packed record - private - function GetDiscardable: boolean; - function GetEndOfLine: boolean; - function GetEndOfParagraph: boolean; - function GetExplicitEndOfParagraph: boolean; - function GetHasLigatureLeft: boolean; - function GetHasLigatureRight: boolean; - function GetImplicitEndOfParagraph: boolean; - function GetIsCombiningLeft: boolean; - function GetIsCombiningRight: boolean; - function GetIsMirrored: boolean; - function GetLigatureBoundary: boolean; - function GetLigatureTransparent: boolean; - function GetMulticharStart: boolean; - function GetNonSpacingMark: boolean; - function GetRemoved: boolean; - function GetRightToLeft: boolean; - function GetParagraphRightToLeft: boolean; - function GetRightToLeftScript: boolean; - public - ParagraphBidiLevel, BidiLevel: byte; - Flags: Word; - class operator =(const AInfo1, AInfo2: TUnicodeBidiInfo): boolean; - property IsRemoved: boolean read GetRemoved; - property IsRightToLeft: boolean read GetRightToLeft; - property IsParagraphRightToLeft: boolean read GetParagraphRightToLeft; - property IsEndOfLine: boolean read GetEndOfLine; - property IsEndOfParagraph: boolean read GetEndOfParagraph; - property IsExplicitEndOfParagraph: boolean read GetExplicitEndOfParagraph; - property IsImplicitEndOfParagraph: boolean read GetImplicitEndOfParagraph; - property HasLigatureRight: boolean read GetHasLigatureRight; - property HasLigatureLeft: boolean read GetHasLigatureLeft; - property IsLigatureBoundary: boolean read GetLigatureBoundary; - property IsLigatureTransparent: boolean read GetLigatureTransparent; - property IsDiscardable: boolean read GetDiscardable; - property IsRightToLeftScript: boolean read GetRightToLeftScript; - property IsNonSpacingMark: boolean read GetNonSpacingMark; - property IsCombiningLeft: boolean read GetIsCombiningLeft; - property IsCombiningRight: boolean read GetIsCombiningRight; - property IsMulticharStart: boolean read GetMulticharStart; - property IsMirrored: boolean read GetIsMirrored; - end; - - TUnicodeBidiArray = packed array of TUnicodeBidiInfo; - TUnicodeDisplayOrder = array of integer; - -const - //maximum nesting level of isolates and bidi-formatting blocks (char bidi level can actually be higher due to char properties) - UNICODE_MAX_BIDI_DEPTH = 125; - - UNICODE_NO_BREAK_SPACE = $A0; - UNICODE_LINE_SEPARATOR = $2028; //equivalent of
- UNICODE_PARAGRAPH_SEPARATOR = $2029; //equivalent of

- UNICODE_NEXT_LINE = $0085; //equivalent of CRLF - - //characters that split lines into top-level bidi blocks - UNICODE_LEFT_TO_RIGHT_ISOLATE = $2066; - UNICODE_RIGHT_TO_LEFT_ISOLATE = $2067; - UNICODE_FIRST_STRONG_ISOLATE = $2068; - UNICODE_POP_DIRECTIONAL_ISOLATE = $2069; - - //characters that split into bidi sub-blocks (called "formatting") - UNICODE_LEFT_TO_RIGHT_EMBEDDING = $202A; - UNICODE_RIGHT_TO_LEFT_EMBEDDING = $202B; - UNICODE_LEFT_TO_RIGHT_OVERRIDE = $202D; - UNICODE_RIGHT_TO_LEFT_OVERRIDE = $202E; - UNICODE_POP_DIRECTIONAL_FORMATTING = $202C; - - //characters that mark direction without splitting the bidi block - UNICODE_LEFT_TO_RIGHT_MARK = $200E; - UNICODE_RIGHT_TO_LEFT_MARK = $200F; - UNICODE_ARABIC_LETTER_MARK = $061C; - - //data separators - UNICODE_INFORMATION_SEPARATOR_FOUR = $001C; //end-of-file - UNICODE_INFORMATION_SEPARATOR_THREE = $001D; //section separator - UNICODE_INFORMATION_SEPARATOR_TWO = $001E; //record separator, kind of equivalent to paragraph separator - UNICODE_INFORMATION_SEPARATOR_ONE = $001F; //field separator, kind of equivalent to Tab - - //zero-width - UNICODE_ZERO_WIDTH_SPACE = $200B; - UNICODE_ZERO_WIDTH_NON_JOINER = $200C; - UNICODE_ZERO_WIDTH_NO_BREAK_SPACE = $FEFF; //byte order mark - UNICODE_ZERO_WIDTH_JOINER = $200D; - UNICODE_COMBINING_GRAPHEME_JOINER = $034F; - - //arabic letters - UNICODE_ARABIC_TATWEEL = $0640; //horizontal line that makes a ligature with most letters - - //ideographic punctuation - UNICODE_IDEOGRAPHIC_COMMA = $3001; - UNICODE_IDEOGRAPHIC_FULL_STOP = $3002; - UNICODE_FULLWIDTH_COMMA = $FF0C; - UNICODE_HORIZONTAL_ELLIPSIS = $2026; - - //bracket equivalence - UNICODE_RIGHT_POINTING_ANGLE_BRACKET = $232A; - UNICODE_RIGHT_ANGLE_BRACKET = $3009; - -type //bracket matching - TUnicodeBracketInfo = record - IsBracket: boolean; - OpeningBracket,ClosingBracket: LongWord; - end; - -{ Returns the Bidi class as defined by Unicode used to determine text direction } -function GetUnicodeBidiClass(u: LongWord): TUnicodeBidiClass; -{ Same as above but returns additional classes: ubcCombiningLeftToRight and ubcMirroredNeutral } -function GetUnicodeBidiClassEx(u: LongWord): TUnicodeBidiClass; -function GetUnicodeBracketInfo(u: LongWord): TUnicodeBracketInfo; -{ Returns how the letter can be joined to the surrounding letters (for example in arabic) } -function GetUnicodeJoiningType(u: LongWord): TUnicodeJoiningType; -{ Returns the Combining class defined by unicode for non-spacing marks and combining marks - or 255 if the character is not to be combined } -function GetUnicodeCombiningClass(u: LongWord): byte; -function IsZeroWidthUnicode(u: LongWord): boolean; -{ Returns if the symbol can be mirrored horizontally for right-to-left text } -function IsUnicodeMirrored(u: LongWord): boolean; -function IsUnicodeParagraphSeparator(u: LongWord): boolean; -function IsUnicodeCrLf(u: LongWord): boolean; -function IsUnicodeSpace(u: LongWord): boolean; -function IsUnicodeIsolateOrFormatting(u: LongWord): boolean; -function IsModifierCombiningMark(u: LongWord): boolean; - -{ Analyze unicode and return bidi levels for each character. - baseDirection can be either UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE or UNICODE_FIRST_STRONG_ISOLATE } -function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; baseDirection: LongWord): TUnicodeBidiArray; -function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; ABidiMode: TFontBidiMode): TUnicodeBidiArray; - -{ Determine diplay order, provided the display surface is horizontally infinite } -function GetUnicodeDisplayOrder(const AInfo: TUnicodeBidiArray): TUnicodeDisplayOrder; overload; -function GetUnicodeDisplayOrder(ALevels: PByte; ACount: integer): TUnicodeDisplayOrder; overload; -function GetUnicodeDisplayOrder(ABidiInfo: PUnicodeBidiInfo; AStride, ACount: integer): TUnicodeDisplayOrder; overload; - -implementation - -{$i generatedunicode.inc} - -function GetUnicodeCombiningClass(u: LongWord): byte; -var - minIndex, maxIndex, midIndex: Integer; - compU: LongWord; -begin - minIndex := 0; - maxIndex := high(UnicodeCombiningInfos); - repeat - midIndex := (minIndex+maxIndex) shr 1; - compU := UnicodeCombiningInfos[midIndex].u; - if u = compU then exit(UnicodeCombiningInfos[midIndex].c) else - if u < compU then maxIndex := midIndex-1 - else minIndex := midIndex+1; - until maxIndex < minIndex; - result := 255; //not combining -end; - -function GetUnicodeBidiClass(u: LongWord): TUnicodeBidiClass; -begin - result := GetUnicodeBidiClassEx(u); - if result = ubcMirroredNeutral then result := ubcOtherNeutrals - else if result = ubcCombiningLeftToRight then result := ubcLeftToRight; -end; - -function IsUnicodeMirrored(u: LongWord): boolean; -begin - result := GetUnicodeBidiClassEx(u) = ubcMirroredNeutral; -end; - -function IsZeroWidthUnicode(u: LongWord): boolean; -begin - case u of - UNICODE_ZERO_WIDTH_SPACE, UNICODE_ZERO_WIDTH_NON_JOINER, - UNICODE_ZERO_WIDTH_JOINER, UNICODE_ZERO_WIDTH_NO_BREAK_SPACE, - UNICODE_LEFT_TO_RIGHT_MARK,UNICODE_RIGHT_TO_LEFT_MARK, - UNICODE_ARABIC_LETTER_MARK: result := true; - else result := false; - end; -end; - -function IsUnicodeParagraphSeparator(u: LongWord): boolean; -begin - case u of - $0A, $0D, UNICODE_NEXT_LINE, UNICODE_PARAGRAPH_SEPARATOR, - UNICODE_INFORMATION_SEPARATOR_FOUR, UNICODE_INFORMATION_SEPARATOR_THREE, UNICODE_INFORMATION_SEPARATOR_TWO: result := true; - else result := false; - end; -end; - -function IsUnicodeCrLf(u: LongWord): boolean; -begin - result := (u=10) or (u=13); -end; - -function IsUnicodeSpace(u: LongWord): boolean; -begin - result := GetUnicodeBidiClass(u) = ubcWhiteSpace; -end; - -function IsUnicodeIsolateOrFormatting(u: LongWord): boolean; -begin - case u of - UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE, - UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, - UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(true) - else exit(false); - end; -end; - -function IsModifierCombiningMark(u: LongWord): boolean; -begin - case u of - $0654,$0655,$0658,$06DC,$06E3,$06E7,$06E8,$08D3,$08F3: exit(true); - else exit(false); - end; -end; - -{ TUnicodeBidiInfo } - -function TUnicodeBidiInfo.GetDiscardable: boolean; -begin - result := IsRemoved and not IsLigatureBoundary; -end; - -function TUnicodeBidiInfo.GetEndOfLine: boolean; -begin - result := (Flags and BIDI_FLAG_END_OF_LINE) <> 0; -end; - -function TUnicodeBidiInfo.GetEndOfParagraph: boolean; -begin - result := (Flags and (BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH or BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH)) <> 0; -end; - -function TUnicodeBidiInfo.GetExplicitEndOfParagraph: boolean; -begin - result := (Flags and BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH) <> 0; -end; - -function TUnicodeBidiInfo.GetHasLigatureLeft: boolean; -begin - result := (Flags and BIDI_FLAG_LIGATURE_LEFT) <> 0; -end; - -function TUnicodeBidiInfo.GetHasLigatureRight: boolean; -begin - result := (Flags and BIDI_FLAG_LIGATURE_RIGHT) <> 0; -end; - -function TUnicodeBidiInfo.GetImplicitEndOfParagraph: boolean; -begin - result := (Flags and BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH) <> 0; -end; - -function TUnicodeBidiInfo.GetIsCombiningLeft: boolean; -begin - result := (Flags and BIDI_FLAG_COMBINING_LEFT) <> 0; -end; - -function TUnicodeBidiInfo.GetIsCombiningRight: boolean; -begin - result := (Flags and BIDI_FLAG_COMBINING_RIGHT) <> 0; -end; - -function TUnicodeBidiInfo.GetIsMirrored: boolean; -begin - result := (Flags and BIDI_FLAG_MIRRORED) <> 0; -end; - -function TUnicodeBidiInfo.GetLigatureBoundary: boolean; -begin - result := (Flags and BIDI_FLAG_LIGATURE_BOUNDARY) <> 0; -end; - -function TUnicodeBidiInfo.GetLigatureTransparent: boolean; -begin - result := (Flags and BIDI_FLAG_LIGATURE_TRANSPARENT) <> 0; -end; - -function TUnicodeBidiInfo.GetMulticharStart: boolean; -begin - result := (Flags and BIDI_FLAG_MULTICHAR_START) <> 0; -end; - -function TUnicodeBidiInfo.GetNonSpacingMark: boolean; -begin - result := (Flags and BIDI_FLAG_NON_SPACING_MARK) <> 0; -end; - -function TUnicodeBidiInfo.GetRemoved: boolean; -begin - result := (Flags and BIDI_FLAG_REMOVED) <> 0; -end; - -function TUnicodeBidiInfo.GetRightToLeft: boolean; -begin - result := Odd(BidiLevel); -end; - -function TUnicodeBidiInfo.GetParagraphRightToLeft: boolean; -begin - result := Odd(ParagraphBidiLevel); -end; - -function TUnicodeBidiInfo.GetRightToLeftScript: boolean; -begin - result := (Flags and BIDI_FLAG_RTL_SCRIPT) <> 0; -end; - -class operator TUnicodeBidiInfo.=(const AInfo1, AInfo2: TUnicodeBidiInfo - ): boolean; -begin - result := (AInfo1.BidiLevel = AInfo2.BidiLevel) and - (AInfo1.Flags = AInfo2.Flags) and - (AInfo1.ParagraphBidiLevel = AInfo2.ParagraphBidiLevel); -end; - -function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; baseDirection: LongWord): TUnicodeBidiArray; -type - TUnicodeAnalysisElement = record - bidiClass: TUnicodeBidiClass; - prevInIsolate, nextInIsolate: integer; //next index in current isolate - end; - TUnicodeAnalysisArray = array of TUnicodeAnalysisElement; - -var - a: TUnicodeAnalysisArray; - - procedure ResolveWeakTypes(startIndex, afterEndIndex: integer; startOfSequence, {%H-}endOfSequence: TUnicodeBidiClass); - var - curIndex,backIndex: Integer; - latestStrongClass, prevClass: TUnicodeBidiClass; - begin - //rules W1 and W2 - prevClass := startOfSequence; - latestStrongClass:= prevClass; - curIndex := startIndex; - while curIndex <> afterEndIndex do - begin - if not result[curIndex].IsRemoved then - begin - case a[curIndex].bidiClass of - ubcNonSpacingMark: a[curIndex].bidiClass:= prevClass; - ubcEuropeanNumber: if latestStrongClass = ubcArabicLetter then a[curIndex].bidiClass:= ubcArabicNumber; - end; - case u[curIndex] of - UNICODE_LEFT_TO_RIGHT_ISOLATE, - UNICODE_RIGHT_TO_LEFT_ISOLATE, - UNICODE_FIRST_STRONG_ISOLATE, - UNICODE_POP_DIRECTIONAL_ISOLATE: prevClass := ubcOtherNeutrals; - else prevClass := a[curIndex].bidiClass; - end; - if prevClass in [ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then latestStrongClass:= prevClass; - end; - curIndex := a[curIndex].nextInIsolate; - end; - - // rule W4 and W5 - prevClass := startOfSequence; - curIndex := startIndex; - while curIndex <> afterEndIndex do - begin - if not result[curIndex].IsRemoved then - begin - case a[curIndex].bidiClass of - ubcArabicLetter: a[curIndex].bidiClass := ubcRightToLeft; - ubcEuropeanNumber: - begin - backIndex := curIndex; - while backIndex > startIndex do - begin - dec(backIndex); - if result[backIndex].IsRemoved then continue; - if a[backIndex].bidiClass = ubcEuropeanNumberTerminator then - a[backIndex].bidiClass := ubcEuropeanNumber - else break; - end; - end; - ubcEuropeanNumberSeparator: - if (prevClass = ubcEuropeanNumber) and (a[curIndex].nextInIsolate <> afterEndIndex) and - (a[a[curIndex].nextInIsolate].bidiClass = ubcEuropeanNumber) then - a[curIndex].bidiClass:= ubcEuropeanNumber; - ubcCommonSeparator: - if (prevClass in[ubcEuropeanNumber,ubcArabicNumber]) and (a[curIndex].nextInIsolate <> afterEndIndex) and - (a[a[curIndex].nextInIsolate].bidiClass = prevClass) then - a[curIndex].bidiClass:= prevClass; - ubcEuropeanNumberTerminator: - if prevClass = ubcEuropeanNumber then - a[curIndex].bidiClass:= ubcEuropeanNumber; - end; - prevClass := a[curIndex].bidiClass; - end; - - curIndex := a[curIndex].nextInIsolate; - end; - - // rule W6 and W7 - curIndex := startIndex; - latestStrongClass := startOfSequence; - while curIndex <> afterEndIndex do - begin - if not result[curIndex].IsRemoved then - begin - case a[curIndex].bidiClass of - ubcEuropeanNumberSeparator,ubcEuropeanNumberTerminator,ubcCommonSeparator: a[curIndex].bidiClass := ubcOtherNeutrals; - ubcLeftToRight,ubcRightToLeft,ubcArabicLetter: latestStrongClass:= a[curIndex].bidiClass; - ubcEuropeanNumber: if latestStrongClass = ubcLeftToRight then a[curIndex].bidiClass := ubcLeftToRight; - end; - end; - curIndex := a[curIndex].nextInIsolate; - end; - end; - - procedure ResolveNeutrals(startIndex, afterEndIndex: integer; startOfSequence, endOfSequence: TUnicodeBidiClass); - var - curIndex,prevIndex,previewIndex: Integer; - curRTL, include, rightToLeftEmbedding: Boolean; - bidiClass: TUnicodeBidiClass; - begin - rightToLeftEmbedding := odd(result[startIndex].BidiLevel); - curIndex := startIndex; - curRTL := startOfSequence in [ubcRightToLeft,ubcArabicLetter]; - while curIndex <> afterEndIndex do - begin - case a[curIndex].bidiClass of - ubcLeftToRight: curRTL := false; - ubcRightToLeft,ubcArabicLetter,ubcArabicNumber,ubcEuropeanNumber: curRTL := true; - else - if curRTL <> rightToLeftEmbedding then - begin - //determine whether following neutral chars are included in reverse direction - prevIndex := curIndex; - previewIndex := a[curIndex].nextInIsolate; - include := false; - while previewIndex <> afterEndIndex do //uses endOfSequence for overflow - begin - if previewIndex = afterEndIndex then - bidiClass:= endOfSequence - else - bidiClass:= a[previewIndex].bidiClass; - case bidiClass of - ubcLeftToRight: - begin - include := not curRTL; - break; - end; - ubcRightToLeft,ubcArabicLetter,ubcArabicNumber,ubcEuropeanNumber: - begin - include := curRTL; - break; - end; - end; - prevIndex := previewIndex; - previewIndex := a[previewIndex].nextInIsolate; - end; - if previewIndex = afterEndIndex then previewIndex := prevIndex; - if include then - begin - while curIndex <> previewIndex do - begin - if a[curIndex].bidiClass = ubcBoundaryNeutral then - result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; //supposed to be removed for rendering - - if a[curIndex].bidiClass in (ubcNeutral+[ubcBoundaryNeutral,ubcUnknown]) then - begin - if curRTL then a[curIndex].bidiClass := ubcRightToLeft - else a[curIndex].bidiClass := ubcLeftToRight; - end; - - curIndex := a[curIndex].nextInIsolate; - end; - end else - curRTL := rightToLeftEmbedding; - end; - end; - - if a[curIndex].bidiClass = ubcBoundaryNeutral then - result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; //supposed to be removed for rendering - - if a[curIndex].bidiClass in (ubcNeutral+[ubcBoundaryNeutral,ubcUnknown]) then - begin - if curRTL then a[curIndex].bidiClass := ubcRightToLeft - else a[curIndex].bidiClass := ubcLeftToRight; - end; - - curIndex := a[curIndex].nextInIsolate; - end; - end; - - procedure ResolveBrackets(startIndex, afterEndIndex: integer; startOfSequence, {%H-}endOfSequence: TUnicodeBidiClass); - type TBracketPair = record - openIndex,closeIndex: integer; - end; - var - bracketPairs: array of TBracketPair; - bracketPairCount: integer; - rightToLeft: boolean; - - procedure SortBracketPairs; - var - i,j,k: Integer; - temp: TBracketPair; - begin - for i := 1 to bracketPairCount-1 do - begin - for j := 0 to i-1 do - if bracketPairs[j].openIndex > bracketPairs[i].openIndex then - begin - temp := bracketPairs[i]; - for k := i downto j+1 do - bracketPairs[k] := bracketPairs[k-1]; - bracketPairs[j] := temp; - end; - end; - end; - - procedure FindBrackets; // rule BD16 - const MAX_BRACKET_STACK = 63; - var - bracketStack: array[0..MAX_BRACKET_STACK-1] of record - bracketCharInfo: TUnicodeBracketInfo; - index: integer; - end; - bracketStackPos,peekPos: integer; - curIndex: integer; - curBracket: TUnicodeBracketInfo; - begin - bracketPairCount := 0; - bracketStackPos := 0; - bracketStack[0].index := -1; //avoid warning - curIndex := startIndex; - while curIndex <> afterEndIndex do - begin - if a[curIndex].bidiClass = ubcOtherNeutrals then - begin - curBracket := GetUnicodeBracketInfo(u[curIndex]); - if curBracket.IsBracket then - begin - // found opening bracket - if curBracket.OpeningBracket = u[curIndex] then - begin - if bracketStackPos <= high(bracketStack) then - begin - bracketStack[bracketStackPos].bracketCharInfo := curBracket; - bracketStack[bracketStackPos].index := curIndex; - inc(bracketStackPos); - end else - break; - end else - begin - for peekPos := bracketStackPos-1 downto 0 do - if (bracketStack[peekPos].bracketCharInfo.ClosingBracket = u[curIndex]) or - ((bracketStack[peekPos].bracketCharInfo.ClosingBracket = UNICODE_RIGHT_ANGLE_BRACKET) and (u[curIndex] = UNICODE_RIGHT_POINTING_ANGLE_BRACKET)) or - ((bracketStack[peekPos].bracketCharInfo.ClosingBracket = UNICODE_RIGHT_POINTING_ANGLE_BRACKET) and (u[curIndex] = UNICODE_RIGHT_ANGLE_BRACKET)) then - begin - bracketStackPos := peekPos; - if bracketPairCount >= length(bracketPairs) then - setlength(bracketPairs, bracketPairCount*2 + 8); - bracketPairs[bracketPairCount].openIndex := bracketStack[peekPos].index; - bracketPairs[bracketPairCount].closeIndex := curIndex; - inc(bracketPairCount); - break; - end; - end; - end; - end; - curIndex := a[curIndex].nextInIsolate; - end; - end; - - procedure SetCharClass(index: integer; newClass: TUnicodeBidiClass); - begin - a[index].bidiClass:= newClass; - index := a[index].nextInIsolate; - while (index <> afterEndIndex) and (GetUnicodeBidiClass(u[index]) = ubcNonSpacingMark) do - begin - a[index].bidiClass := newClass; - index := a[index].nextInIsolate; - end; - end; - - procedure ResolveBrackets; // rule N0 - var - i, curIndex: Integer; - sameDirection, oppositeDirection, oppositeContext: boolean; - begin - for i := 0 to bracketPairCount-1 do - begin - curIndex := bracketPairs[i].openIndex+1; - sameDirection:= false; - oppositeDirection:= false; - while curIndex <> bracketPairs[i].closeIndex do - begin - Assert((curIndex >= startIndex) and (curIndex < length(a)), 'Expecting valid index'); - case a[curIndex].bidiClass of - ubcLeftToRight: - if not rightToLeft then - begin - sameDirection := true; - break; - end else oppositeDirection:= true; - ubcRightToLeft,ubcArabicLetter,ubcEuropeanNumber,ubcArabicNumber: - if rightToLeft then - begin - sameDirection := true; - break; - end else oppositeDirection:= true; - end; - curIndex := a[curIndex].nextInIsolate; - end; - if sameDirection then - begin - if rightToLeft then - begin - SetCharClass(bracketPairs[i].openIndex, ubcRightToLeft); - SetCharClass(bracketPairs[i].closeIndex, ubcRightToLeft); - end else - begin - SetCharClass(bracketPairs[i].openIndex, ubcLeftToRight); - SetCharClass(bracketPairs[i].closeIndex, ubcLeftToRight); - end; - end else - if oppositeDirection then - begin - curIndex := a[bracketPairs[i].openIndex].prevInIsolate; - oppositeContext := false; - while curIndex >= startIndex do - begin - case a[curIndex].bidiClass of - ubcRightToLeft,ubcArabicLetter,ubcEuropeanNumber,ubcArabicNumber: - begin - oppositeContext := not rightToLeft; - break; - end; - ubcLeftToRight: - begin - oppositeContext := rightToLeft; - break; - end; - end; - curIndex := a[curIndex].prevInIsolate; - end; - if rightToLeft xor oppositeContext then - begin - SetCharClass(bracketPairs[i].openIndex, ubcRightToLeft); - SetCharClass(bracketPairs[i].closeIndex, ubcRightToLeft); - end else - begin - SetCharClass(bracketPairs[i].openIndex, ubcLeftToRight); - SetCharClass(bracketPairs[i].closeIndex, ubcLeftToRight); - end; - end; - end; - end; - - begin - rightToLeft:= startOfSequence in[ubcRightToLeft,ubcArabicLetter]; - FindBrackets; - SortBracketPairs; - ResolveBrackets; - end; - - procedure ResolveLigature(startIndex: integer); - var - prevJoiningType, joiningType: TUnicodeJoiningType; - prevJoiningTypeBidilevel: byte; - prevJoiningTypeIndex: integer; - curIndex: Integer; - begin - prevJoiningType := ujtNonJoining; - prevJoiningTypeIndex := -1; - prevJoiningTypeBidilevel:= 0; - curIndex := startIndex; - while curIndex <> -1 do - begin - if prevJoiningTypeBidilevel <> result[curIndex].BidiLevel then - prevJoiningType := ujtNonJoining; - if result[curIndex].IsNonSpacingMark then - joiningType := ujtTransparent //NSM are always joining-transparent - else joiningType := GetUnicodeJoiningType(u[curIndex]); - if joiningType = ujtTransparent then - result[curIndex].Flags:= result[curIndex].Flags or BIDI_FLAG_LIGATURE_TRANSPARENT; - if result[curIndex].IsRightToLeft then - begin - if (joiningType in[ujtRightJoining,ujtDualJoining]) - and (prevJoiningType in[ujtLeftJoining,ujtDualJoining,ujtJoinCausing]) then - result[curIndex].Flags:= result[curIndex].Flags or BIDI_FLAG_LIGATURE_RIGHT; - if (prevJoiningType in[ujtLeftJoining,ujtDualJoining]) and (prevJoiningTypeIndex <> -1) and - (joiningType in[ujtRightJoining,ujtDualJoining,ujtJoinCausing]) then - result[prevJoiningTypeIndex].Flags:= result[prevJoiningTypeIndex].Flags or BIDI_FLAG_LIGATURE_LEFT; - end else - begin - if (joiningType in[ujtLeftJoining,ujtDualJoining]) - and (prevJoiningType in[ujtRightJoining,ujtDualJoining,ujtJoinCausing]) then - result[curIndex].Flags:= result[curIndex].Flags or BIDI_FLAG_LIGATURE_LEFT; - if (prevJoiningType in[ujtRightJoining,ujtDualJoining]) and (prevJoiningTypeIndex <> -1) and - (joiningType in[ujtLeftJoining,ujtDualJoining,ujtJoinCausing]) then - result[prevJoiningTypeIndex].Flags:= result[prevJoiningTypeIndex].Flags or BIDI_FLAG_LIGATURE_RIGHT; - end; - if joiningType <> ujtTransparent then - begin - prevJoiningType := joiningType; - prevJoiningTypeIndex:= curIndex; - prevJoiningTypeBidilevel:= result[curIndex].BidiLevel; - end; - curIndex := a[curIndex].nextInIsolate; - end; - end; - - procedure AnalyzeSequence(startIndex, afterEndIndex: integer; sos, eos: TUnicodeBidiClass); - begin - if afterEndIndex = startIndex then exit; - ResolveWeakTypes(startIndex, afterEndIndex, sos, eos); - ResolveBrackets(startIndex, afterEndIndex, sos, eos); - ResolveNeutrals(startIndex, afterEndIndex, sos, eos); - end; - - procedure SameLevelRuns(startIndex: integer); - var - curBidiLevel: byte; - latestIndex,curIndex, curStartIndex: Integer; - curSos,eos: TUnicodeBidiClass; - begin - curIndex := startIndex; - while (curIndex<>-1) and result[curIndex].IsRemoved do - curIndex := a[curIndex].nextInIsolate; - if curIndex = -1 then exit; - - curStartIndex:= curIndex; - curBidiLevel := result[curIndex].bidiLevel; - if odd(curBidiLevel) then curSos := ubcRightToLeft else curSos := ubcLeftToRight; - latestIndex := -1; - while curIndex <> -1 do - begin - if not result[curIndex].IsRemoved then - begin - if (latestIndex <> -1) and (result[curIndex].bidiLevel <> curBidiLevel) then - begin - if result[curIndex].bidiLevel > curBidiLevel then - begin - if odd(result[curIndex].bidiLevel) then eos := ubcRightToLeft else eos := ubcLeftToRight; - end else - begin - if odd(curBidiLevel) then eos := ubcRightToLeft else eos := ubcLeftToRight; - end; - - AnalyzeSequence(curStartIndex, a[latestIndex].nextInIsolate, curSos, eos); - - curSos := eos; - curBidiLevel:= result[curIndex].bidiLevel; - curStartIndex:= curIndex; - end; - latestIndex := curIndex; - end; - - if (a[curIndex].nextInIsolate = -1) and (latestIndex<>-1) then - begin - if odd(result[latestIndex].bidiLevel) then eos := ubcRightToLeft else eos := ubcLeftToRight; - AnalyzeSequence(curStartIndex, a[latestIndex].nextInIsolate, curSos, eos); - break; - end; - - curIndex := a[curIndex].nextInIsolate; - end; - end; - - //analyse bidi formatting of an embedding or an override block - procedure AnalyzeFormattingBlocks(startIndex, lastIndex: integer; minBidiLevel: byte; formattingCode: LongWord); - var curIndex, nextIndex, levelIncrease: integer; - subFormatBeforeStart, subFormatStart, formatNesting: integer; - subFormatCode: LongWord; - begin - case formattingCode of - UNICODE_LEFT_TO_RIGHT_OVERRIDE,UNICODE_LEFT_TO_RIGHT_EMBEDDING: - if odd(minBidiLevel) then inc(minBidiLevel); - UNICODE_RIGHT_TO_LEFT_OVERRIDE,UNICODE_RIGHT_TO_LEFT_EMBEDDING: - if not odd(minBidiLevel) then inc(minBidiLevel); - end; - nextIndex := startIndex; - repeat - Assert(nextIndex >= 0, 'Expecting valid index'); - curIndex := nextIndex; - nextIndex := a[curIndex].nextInIsolate; - result[curIndex].bidiLevel := minBidiLevel; - - //apply override - if formattingCode = UNICODE_LEFT_TO_RIGHT_OVERRIDE then a[curIndex].bidiClass := ubcLeftToRight - else if formattingCode = UNICODE_RIGHT_TO_LEFT_OVERRIDE then a[curIndex].bidiClass := ubcRightToLeft; - - case u[curIndex] of - UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, - UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: - begin - result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; - case u[curIndex] of - UNICODE_LEFT_TO_RIGHT_OVERRIDE,UNICODE_LEFT_TO_RIGHT_EMBEDDING: - if odd(minBidiLevel) then levelIncrease := 1 - else levelIncrease := 2; - UNICODE_RIGHT_TO_LEFT_OVERRIDE,UNICODE_RIGHT_TO_LEFT_EMBEDDING: - if odd(minBidiLevel) then levelIncrease := 2 - else levelIncrease := 1; - else levelIncrease:= 2; - end; - if minBidiLevel <= UNICODE_MAX_BIDI_DEPTH-levelIncrease-1 then - begin - subFormatCode:= u[curIndex]; - subFormatBeforeStart := curIndex; - subFormatStart := nextIndex; - formatNesting:= 1; - while formatNesting > 0 do - begin - //sub-format ends because no more chars - if curIndex = lastIndex then - begin - if curIndex <> subFormatBeforeStart then - AnalyzeFormattingBlocks(subFormatStart, curIndex, minBidiLevel+levelIncrease, subFormatCode); - break; - end; - - Assert(nextIndex >= 0, 'Expecting valid index'); - case u[nextIndex] of - UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, - UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: inc(formatNesting); - UNICODE_POP_DIRECTIONAL_FORMATTING: - begin - dec(formatNesting); - if formatNesting = 0 then - begin - //sub-format ends because enough matching pop chars found - if curIndex <> subFormatBeforeStart then - AnalyzeFormattingBlocks(subFormatStart, curIndex, minBidiLevel+levelIncrease, subFormatCode); - - curIndex := nextIndex; - nextIndex := a[curIndex].nextInIsolate; - result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; - break; - end; - end; - end; - - curIndex := nextIndex; - nextIndex := a[curIndex].nextInIsolate; - end; - end; - end; - UNICODE_POP_DIRECTIONAL_FORMATTING: //ignored when no matching formatting code - begin - result[curIndex].Flags := result[curIndex].Flags OR BIDI_FLAG_REMOVED; - end; - end; - until curIndex = lastIndex; - end; - - procedure ResolveImplicitLevels(startIndex: integer); // rule I1 and I2 - var - curIndex: Integer; - begin - curIndex := startIndex; - while curIndex <> -1 do - begin - case a[curIndex].bidiClass of - ubcRightToLeft,ubcArabicLetter: - if not Odd(result[curIndex].bidiLevel) then inc(result[curIndex].bidiLevel); - ubcEuropeanNumber,ubcArabicNumber: - if Odd(result[curIndex].bidiLevel) then inc(result[curIndex].bidiLevel) - else inc(result[curIndex].bidiLevel, 2); - ubcLeftToRight: if Odd(result[curIndex].bidiLevel) then inc(result[curIndex].bidiLevel); - end; - curIndex := a[curIndex].nextInIsolate; - end; - end; - - procedure ResetEndOfParagraphLevels(startIndex: integer); // rule L1 - var - prevIndex,curIndex: Integer; - - procedure TweakWhiteSpaceBefore(index: integer); - var - isWhiteSpaceOrIsolate: boolean; - begin - while index <> -1 do - begin - case u[index] of - UNICODE_FIRST_STRONG_ISOLATE, UNICODE_POP_DIRECTIONAL_ISOLATE, - UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE: - isWhiteSpaceOrIsolate:= true; - else - isWhiteSpaceOrIsolate:= GetUnicodeBidiClass(u[index]) = ubcWhiteSpace; - end; - if isWhiteSpaceOrIsolate then - result[index].bidiLevel := result[index].ParagraphBidiLevel - else - break; - index := a[index].prevInIsolate; - end; - end; - - begin - prevIndex := -1; - curIndex := startIndex; - while curIndex <> -1 do - begin - case GetUnicodeBidiClass(u[curIndex]) of - ubcSegmentSeparator, ubcParagraphSeparator: - begin - result[curIndex].bidiLevel := result[curIndex].ParagraphBidiLevel; - TweakWhiteSpaceBefore(prevIndex); - end; - end; - prevIndex := curIndex; - curIndex := a[curIndex].nextInIsolate; - end; - TweakWhiteSpaceBefore(prevIndex); - end; - - function DetermineIsolateDirectionFromFirstStrongClass(startIndex: integer): LongWord; - var - curIndex: Integer; - begin - curIndex := startIndex; - while curIndex <> -1 do - begin - Assert(curIndex >= 0, 'Expecting valid index'); - case a[curIndex].bidiClass of - ubcLeftToRight: exit(UNICODE_LEFT_TO_RIGHT_ISOLATE); - ubcRightToLeft,ubcArabicLetter: exit(UNICODE_RIGHT_TO_LEFT_ISOLATE); - end; - case u[curIndex] of - UNICODE_LEFT_TO_RIGHT_OVERRIDE: exit(UNICODE_LEFT_TO_RIGHT_ISOLATE); - UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(UNICODE_RIGHT_TO_LEFT_ISOLATE); - end; - curIndex := a[curIndex].nextInIsolate; - end; - result := UNICODE_LEFT_TO_RIGHT_ISOLATE; - end; - - procedure LinkCharsInIsolate(startIndex: integer; charCount: integer; out endIndex : integer); - var - curIndex,isolateStackPos, - prevIndex: Integer; - begin - a[startIndex].prevInIsolate := -1; - prevIndex := -1; - curIndex := startIndex; - isolateStackPos:= 0; - while curIndex < startIndex+charCount do - begin - if u[curIndex] = UNICODE_POP_DIRECTIONAL_ISOLATE then - if isolateStackPos > 0 then dec(isolateStackPos); - - if isolateStackPos = 0 then - begin - if prevIndex<>-1 then a[prevIndex].nextInIsolate := curIndex; - a[curIndex].prevInIsolate := prevIndex; - - prevIndex := curIndex; - end; - - case u[curIndex] of - UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE: inc(isolateStackPos); - end; - inc(curIndex); - end; - a[prevIndex].nextInIsolate := -1; - endIndex := prevIndex; - end; - - //split isolates in order to format them independently - procedure AnalyzeIsolates(startIndex: integer; charCount: integer; isolateDirection: LongWord; minBidiLevel: byte = 0; - isParagraph: boolean = false); - var curIndex, endIndex: integer; - nextIndex: integer; - subBidiLevel, levelIncrease: byte; - subIsolateStart: integer; - subIsolateDirection: LongWord; - begin - if charCount = 0 then exit; - Assert(startIndex>=0, 'Invalid start index'); - - LinkCharsInIsolate(startIndex, charCount, endIndex); - - if isolateDirection = UNICODE_FIRST_STRONG_ISOLATE then - isolateDirection := DetermineIsolateDirectionFromFirstStrongClass(startIndex); - - case isolateDirection of - UNICODE_LEFT_TO_RIGHT_ISOLATE: if Odd(minBidiLevel) then inc(minBidiLevel); - UNICODE_RIGHT_TO_LEFT_ISOLATE: if not Odd(minBidiLevel) then inc(minBidiLevel); - else - raise EInvalidOperation.Create('Unknown isolate direction'); - end; - - if isParagraph then - begin - curIndex := startIndex; - while curIndex <> -1 do - begin - result[curIndex].ParagraphBidiLevel := minBidiLevel; - curIndex := a[curIndex].nextInIsolate; - end; - end; - - case isolateDirection of - UNICODE_LEFT_TO_RIGHT_ISOLATE: AnalyzeFormattingBlocks(startIndex, endIndex, minBidiLevel, UNICODE_LEFT_TO_RIGHT_EMBEDDING); - UNICODE_RIGHT_TO_LEFT_ISOLATE: AnalyzeFormattingBlocks(startIndex, endIndex, minBidiLevel, UNICODE_RIGHT_TO_LEFT_EMBEDDING); - end; - - SameLevelRuns(startIndex); - ResolveImplicitLevels(startIndex); - ResolveLigature(startIndex); - - if isParagraph then - ResetEndOfParagraphLevels(startIndex); - - //analyse sub-isolates - curIndex := startIndex; - while curIndex <> -1 do - begin - Assert(curIndex >= 0, 'Expecting valid index'); - case u[curIndex] of - UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE: - begin - subBidiLevel := result[curIndex].bidiLevel; - nextIndex := a[curIndex].nextInIsolate; - if nextIndex <> -1 then - begin - if result[nextIndex].bidiLevel > subBidiLevel then - subBidiLevel:= result[nextIndex].bidiLevel; - end; - if ((isolateDirection = UNICODE_LEFT_TO_RIGHT_ISOLATE) and - (u[curIndex] = UNICODE_RIGHT_TO_LEFT_ISOLATE)) or - ((isolateDirection = UNICODE_LEFT_TO_RIGHT_ISOLATE) and - (u[curIndex] = UNICODE_RIGHT_TO_LEFT_ISOLATE)) then - levelIncrease := 1 - else - levelIncrease:= 2; - if subBidiLevel+levelIncrease <= UNICODE_MAX_BIDI_DEPTH-1 then - begin - subIsolateDirection := u[curIndex]; - subIsolateStart:= curIndex+1; - curIndex := nextIndex; - - //sub-isolates ends because no more chars - if curIndex = -1 then - begin - AnalyzeIsolates(subIsolateStart, startIndex+charCount-subIsolateStart, subIsolateDirection, subBidiLevel+1); - break; - end else - begin - AnalyzeIsolates(subIsolateStart, curIndex-subIsolateStart, subIsolateDirection, subBidiLevel+1); - continue; - end; - end; - end; - end; - curIndex := a[curIndex].nextInIsolate; - end; - end; - - //split UTF8 string into paragraphs - procedure SplitParagraphs; - var - lineStartIndex, curIndex: integer; - begin - curIndex := 0; - lineStartIndex := curIndex; - while curIndex < ALength do - begin - if a[curIndex].bidiClass = ubcParagraphSeparator then - begin - //skip second CRLF char - if IsUnicodeCrLf(u[curIndex]) and (curIndex+1 < ALength) and - IsUnicodeCrLf(u[curIndex+1]) and (u[curIndex+1] <> u[curIndex]) then - begin - inc(curIndex); - result[curIndex].Flags := result[curIndex].Flags and not BIDI_FLAG_MULTICHAR_START; - end; - - result[curIndex].Flags := result[curIndex].Flags or BIDI_FLAG_EXPLICIT_END_OF_PARAGRAPH; - - AnalyzeIsolates(lineStartIndex, curIndex+1-lineStartIndex, baseDirection, 0, true); - lineStartIndex := curIndex+1; - end; - inc(curIndex); - end; - if curIndex > lineStartIndex then - begin - result[curIndex-1].Flags := result[curIndex-1].Flags or BIDI_FLAG_IMPLICIT_END_OF_PARAGRAPH; - AnalyzeIsolates(lineStartIndex, curIndex-lineStartIndex, baseDirection, 0, true); - end; - end; - -var i: integer; - classEx: TUnicodeBidiClass; -begin - setlength(a, ALength); - setlength(result, ALength); - if ALength > 0 then - begin - for i := 0 to high(a) do - begin - classEx := GetUnicodeBidiClassEx(u[i]); - case classEx of - ubcMirroredNeutral: - begin - result[i].Flags := result[i].Flags or BIDI_FLAG_MIRRORED; - a[i].bidiClass := ubcOtherNeutrals; - end; - ubcCombiningLeftToRight: - begin - case GetUnicodeCombiningClass(u[i]) of - 208, 224: result[i].Flags := result[i].Flags OR BIDI_FLAG_COMBINING_LEFT; - 210, 226, 9: result[i].Flags := result[i].Flags OR BIDI_FLAG_COMBINING_RIGHT; - 0: result[i].Flags := result[i].Flags OR BIDI_FLAG_COMBINING_LEFT OR BIDI_FLAG_COMBINING_RIGHT; - end; - a[i].bidiClass := ubcLeftToRight; - end; - otherwise - a[i].bidiClass := classEx; - end; - case u[i] of - UNICODE_LINE_SEPARATOR: //line separator within paragraph - result[i].Flags := result[i].Flags or BIDI_FLAG_END_OF_LINE; - UNICODE_ZERO_WIDTH_JOINER, UNICODE_ZERO_WIDTH_NON_JOINER: - result[i].Flags := result[i].Flags OR BIDI_FLAG_LIGATURE_BOUNDARY; - end; - case a[i].bidiClass of - ubcArabicLetter,ubcArabicNumber,ubcRightToLeft: - result[i].Flags := result[i].Flags OR BIDI_FLAG_RTL_SCRIPT; - ubcNonSpacingMark: result[i].Flags := result[i].Flags OR BIDI_FLAG_NON_SPACING_MARK; - end; - if (result[i].Flags and (BIDI_FLAG_NON_SPACING_MARK or BIDI_FLAG_COMBINING_LEFT - or BIDI_FLAG_COMBINING_RIGHT) = 0) or - (i = 0) or (a[i-1].bidiClass in [ubcSegmentSeparator, ubcParagraphSeparator]) then - result[i].Flags := result[i].Flags OR BIDI_FLAG_MULTICHAR_START; - end; - SplitParagraphs; - end; -end; - -function AnalyzeBidiUnicode(u: PLongWord; ALength: integer; - ABidiMode: TFontBidiMode): TUnicodeBidiArray; -begin - case ABidiMode of - fbmLeftToRight: result := AnalyzeBidiUnicode(u, ALength, UNICODE_LEFT_TO_RIGHT_ISOLATE); - fbmRightToLeft: result := AnalyzeBidiUnicode(u, ALength, UNICODE_RIGHT_TO_LEFT_ISOLATE); - else - {fbmAuto} result := AnalyzeBidiUnicode(u, ALength, UNICODE_FIRST_STRONG_ISOLATE); - end; -end; - -function GetUnicodeDisplayOrder(const AInfo: TUnicodeBidiArray): TUnicodeDisplayOrder; -begin - if length(AInfo)=0 then - result := nil - else - result := GetUnicodeDisplayOrder(@AInfo[0], sizeof(TUnicodeBidiInfo), length(AInfo)); -end; - -function GetUnicodeDisplayOrder(ALevels: PByte; ACount: integer): TUnicodeDisplayOrder; - - procedure DetermineDisplayOrderRec(AOffset: integer; AStartIndex, ABlockCount: integer; AEmbeddingLevel: byte); - var minLevel: byte; - blockIndex,subStartIndex,subCount, subOffset: integer; - begin - //writeln('DetermineDisplayOrderRec('+inttostr(AOffset)+'/'+inttostr(ACount)+',' + inttostr(AStartIndex) +',*' +inttostr(ABlockCount)+','+inttostr(AEmbeddingLevel)+')'); - blockIndex := 0; - subStartIndex := 0; //avoid warning - while blockIndex < ABlockCount do - begin - Assert(AOffset < ACount, 'Offset out of bounds'); - if ALevels[AOffset] = AEmbeddingLevel then - begin - if odd(AEmbeddingLevel) then - result[AStartIndex+ABlockCount-1-blockIndex] := AOffset - else - result[AStartIndex+blockIndex] := AOffset; - inc(AOffset); - inc(blockIndex); - end else - begin - if not odd(AEmbeddingLevel) then - subStartIndex := AStartIndex+blockIndex; - subOffset := AOffset; - minLevel := ALevels[AOffset]; - inc(AOffset); - inc(blockIndex); - subCount := 1; - while true do - begin - if (blockIndex < ABlockCount) and (ALevels[AOffset] > AEmbeddingLevel) then - begin - Assert(AOffset < ACount, 'Offset out of bounds'); - if ALevels[AOffset] < minLevel then - minLevel:= ALevels[AOffset]; - inc(AOffset); - inc(blockIndex); - inc(subCount); - end else - begin - if odd(AEmbeddingLevel) then - subStartIndex := AStartIndex+ABlockCount-1-(blockIndex-1); - DetermineDisplayOrderRec(subOffset, subStartIndex, subCount, minLevel); - break; - end; - end; - end; - end; - end; - -begin - setlength(result, ACount); - DetermineDisplayOrderRec(0, 0, ACount, 0); -end; - -function GetUnicodeDisplayOrder(ABidiInfo: PUnicodeBidiInfo; AStride, ACount: integer): TUnicodeDisplayOrder; -var - levels: packed array of byte; - originalIndices: array of integer; - index,len, i: integer; - p: PByte; -begin - len := 0; - p := PByte(ABidiInfo); - for i := 0 to ACount-1 do - begin - if not PUnicodeBidiInfo(p)^.IsRemoved then inc(len); - inc(p, AStride); - end; - if len = 0 then - result := nil - else - begin - setlength(levels, len); - setlength(originalIndices, len); - p := PByte(ABidiInfo); - index := 0; - for i := 0 to ACount-1 do - begin - if not PUnicodeBidiInfo(p)^.IsRemoved then - begin - levels[index] := PUnicodeBidiInfo(p)^.BidiLevel; - originalIndices[index] := i; - inc(index); - end; - inc(p, AStride); - end; - result := GetUnicodeDisplayOrder(@levels[0], len); - for i := 0 to len-1 do - result[i] := originalIndices[result[i]]; - end; -end; - -end. - diff --git a/components/bgrabitmap/bgraunicodetext.pas b/components/bgrabitmap/bgraunicodetext.pas deleted file mode 100644 index 3686c1a..0000000 --- a/components/bgrabitmap/bgraunicodetext.pas +++ /dev/null @@ -1,960 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAUnicodeText; - -{$mode objfpc}{$H+} -{ $DEFINE DEBUG} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, BGRAUnicode, BGRAUTF8; - -type - TDeleteCharEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharStart, ACharCount: integer) of object; - TInsertCharEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharStart, ACharCount: integer) of object; - TParagraphEvent = procedure(ASender: TObject; AParagraphIndex: integer) of object; - TParagraphSplitEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharIndex: integer) of object; - TAnalysisChangedEvent = procedure(ASender: TObject; AParagraphIndex: integer; ACharStart, ACharCount: integer) of object; - - { TBidiTree } - - TBidiTree = class - private - FParent: TBidiTree; - FData: pointer; - FStartIndex, FEndIndex: integer; - FBidiLevel: byte; - FBranches: TList; - FIsLeaf: boolean; - function GetBranch(AIndex: integer): TBidiTree; - function GetCount: integer; - function GetIsRightToLeft: boolean; - public - constructor Create(AData: pointer; AStartIndex, AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); virtual; - destructor Destroy; override; - procedure AfterFinish; virtual; - procedure AddBranch(ABranch: TBidiTree); virtual; - procedure Shorten(AEndIndex: integer); virtual; - function TrySplit: boolean; virtual; - property StartIndex: integer read FStartIndex; - property EndIndex: integer read FEndIndex; - property BidiLevel: byte read FBidiLevel; - property IsRightToLeft: boolean read GetIsRightToLeft; - property Parent: TBidiTree read FParent; - property IsLeaf: boolean read FIsLeaf; - property Count: integer read GetCount; - property Branch[AIndex: integer]: TBidiTree read GetBranch; - property Data: pointer read FData; - end; - - TBidiTreeAny = class of TBidiTree; - - { TUnicodeAnalysis } - - TUnicodeAnalysis = class - private - FOnAnalysisChanged: TAnalysisChangedEvent; - FOnBidiModeChanged: TNotifyEvent; - FOnCharDeleted: TDeleteCharEvent; - FOnCharInserted: TInsertCharEvent; - FOnParagraphMergedWithNext: TParagraphEvent; - FOnParagraphDeleted: TParagraphEvent; - FOnParagraphSplit: TParagraphSplitEvent; - function GetParagraphRightToLeft(AIndex: integer): boolean; - protected - FText: string; - FCharCount: integer; - FBidi: TBidiUTF8Array; - FParagraph: array of record - firstUnbrokenLineIndex: integer; - end; - FParagraphCount: integer; - - FUnbrokenLine: array of record - startIndex: integer; - paragraphIndex: integer; - end; - FUnbrokenLineCount: integer; - - FBidiMode: TFontBidiMode; - procedure Analyze; - procedure CheckTextAnalysis; - function GetUnbrokenLineParagraphIndex(AIndex: integer): integer; - function GetUnbrokenLineStartIndex(AIndex: integer): integer; - function GetUnbrokenLineEndIndex(AIndex: integer): integer; - function GetParagraphEndIndex(AIndex: integer): integer; - function GetParagraphEndIndexBeforeParagraphSeparator(AIndex: integer): integer; - function GetParagraphFirstUnbrokenLine(AIndex: integer): integer; - function GetParagraphLastUnbrokenLinePlusOne(AIndex: integer): integer; - function GetParagraphStartIndex(AIndex: integer): integer; - function GetUnicodeChar(APosition0: integer): LongWord; - function GetUTF8Char(APosition0: integer): string4; - function GetBidiInfo(APosition0: integer): TUnicodeBidiInfo; - procedure SetBidiMode(AValue: TFontBidiMode); - - procedure InternalDeleteBidiAndUTF8(ABidiStart, ABidiCount: integer); - procedure InternalDeleteParagraph(AParagraphIndex: integer); - procedure InternalDeleteText(APosition, ACount: integer); - procedure InternalDeleteWithinParagraph(AParagraphIndex: integer; - APosition, ACount: integer; AUpdateBidi: boolean); - function InternalInsertText(APosition: integer; - const ANewBidi: TBidiUTF8Array; ANewTextUTF8: string): integer; - procedure InternalMergeParagraphWithNext(AParagraphIndex: integer); - procedure InternalSplitParagraph(AParagraphIndex: integer); - procedure InternalUpdateBidiIsolate(AParagraphIndex: integer; ABidiStart, ABidiCount: integer); - procedure InternalUpdateUnbrokenLines(AParagraphIndex: integer); - procedure CreateBidiTreeRec(ABidiTreeFactory: TBidiTreeAny; AData: pointer; ABidiTree: TBidiTree); - procedure CheckCharRange(AStartIndex, AEndIndex: integer; AMinIndex, AMaxIndex: integer); - public - constructor Create(ATextUTF8: string; ABidiMode: TFontBidiMode); - function GetParagraphAt(ACharIndex: integer): integer; - function CopyTextUTF8(AStartIndex, ACount: integer): string; - function CopyTextUTF8DiscardChars(AStartIndex,AEndIndex: integer; out ANonDiscardedCount: integer): string; - function InsertText(ATextUTF8: string; APosition: integer): integer; - function DeleteText(APosition, ACount: integer): integer; - function DeleteTextBefore(APosition, ACount: integer): integer; - function IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; - function IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean = true): integer; - function CreateBidiTree(ABidiTreeFactory: TBidiTreeAny; AData: pointer; AStartIndex, AEndIndex: integer; - AEmbeddingBidiLevel: integer): TBidiTree; - - property TextUTF8: string read FText; - property UTF8Char[APosition0: integer]: string4 read GetUTF8Char; - property UnicodeChar[APosition0: integer]: LongWord read GetUnicodeChar; - property BidiInfo[APosition0: integer]: TUnicodeBidiInfo read GetBidiInfo; - property CharCount: integer read FCharCount; - property UnbrokenLineCount: integer read FUnbrokenLineCount; - property UnbrokenLineStartIndex[AIndex: integer]: integer read GetUnbrokenLineStartIndex; - property UnbrokenLineEndIndex[AIndex: integer]: integer read GetUnbrokenLineEndIndex; - property UnbrokenLineParagraphIndex[AIndex: integer]: integer read GetUnbrokenLineParagraphIndex; - property ParagraphCount: integer read FParagraphCount; - property ParagraphFirstUnbrokenLine[AIndex:integer] : integer read GetParagraphFirstUnbrokenLine; - property ParagraphLastUnbrokenLinePlusOne[AIndex:integer] : integer read GetParagraphLastUnbrokenLinePlusOne; - property ParagraphStartIndex[AIndex: integer]: integer read GetParagraphStartIndex; - property ParagraphEndIndex[AIndex: integer]: integer read GetParagraphEndIndex; - property ParagraphEndIndexBeforeParagraphSeparator[AIndex: integer]: integer read GetParagraphEndIndexBeforeParagraphSeparator; - property ParagraphRightToLeft[AIndex: integer]: boolean read GetParagraphRightToLeft; - property BidiMode: TFontBidiMode read FBidiMode write SetBidiMode; - property OnBidiModeChanged: TNotifyEvent read FOnBidiModeChanged write FOnBidiModeChanged; - property OnCharDeleted: TDeleteCharEvent read FOnCharDeleted write FOnCharDeleted; - property OnCharInserted: TInsertCharEvent read FOnCharInserted write FOnCharInserted; - property OnParagraphDeleted: TParagraphEvent read FOnParagraphDeleted write FOnParagraphDeleted; - property OnParagraphMergedWithNext: TParagraphEvent read FOnParagraphMergedWithNext write FOnParagraphMergedWithNext; - property OnParagraphSplit: TParagraphSplitEvent read FOnParagraphSplit write FOnParagraphSplit; - property OnAnalysisChanged: TAnalysisChangedEvent read FOnAnalysisChanged write FOnAnalysisChanged; - end; - -implementation - -uses math; - -{ TBidiTree } - -function TBidiTree.GetCount: integer; -begin - if Assigned(FBranches) then - result:= FBranches.Count - else - result := 0; -end; - -function TBidiTree.GetIsRightToLeft: boolean; -begin - result := odd(BidiLevel); -end; - -function TBidiTree.GetBranch(AIndex: integer): TBidiTree; -begin - if (AIndex < 0) or (AIndex >= Count) then raise exception.Create('Branch index out of bounds'); - result := TBidiTree(FBranches[AIndex]); -end; - -constructor TBidiTree.Create(AData: pointer; AStartIndex, AEndIndex: integer; ABidiLevel: byte; AIsLeaf: boolean); -begin - FData := AData; - FParent := nil; - FStartIndex:= AStartIndex; - FEndIndex:= AEndIndex; - FBidiLevel:= ABidiLevel; - FBranches:= nil; - FIsLeaf:= AIsLeaf; -end; - -destructor TBidiTree.Destroy; -var - i: Integer; -begin - if Assigned(FBranches) then - begin - for i := 0 to FBranches.Count-1 do - TBidiTree(FBranches[i]).Free; - FBranches.Free; - end; - inherited Destroy; -end; - -procedure TBidiTree.AfterFinish; -begin - // -end; - -procedure TBidiTree.AddBranch(ABranch: TBidiTree); -begin - if IsLeaf then raise exception.Create('A leaf cannot have branches'); - if Assigned(ABranch.Parent) then raise exception.Create('Branch already has a parent'); - ABranch.FParent := self; - if FBranches = nil then FBranches := TList.Create; - FBranches.Add(ABranch); -end; - -procedure TBidiTree.Shorten(AEndIndex: integer); -var - i: Integer; -begin - if AEndIndex = EndIndex then exit; - if AEndIndex > EndIndex then raise exception.Create('Cannot extend the branch'); - if AEndIndex < StartIndex then raise exception.Create('End index before start'); - for i := Count-1 downto 0 do - if AEndIndex <= Branch[i].StartIndex then - begin - Branch[i].Free; - FBranches.Delete(i); - end else - if AEndIndex < Branch[i].EndIndex then - Branch[i].Shorten(AEndIndex); - FEndIndex:= AEndIndex; -end; - -function TBidiTree.TrySplit: boolean; -begin - result := false; -end; - -{ TUnicodeAnalysis } - -function TUnicodeAnalysis.GetParagraphFirstUnbrokenLine(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); - result := FParagraph[AIndex].firstUnbrokenLineIndex; -end; - -procedure TUnicodeAnalysis.SetBidiMode(AValue: TFontBidiMode); -var - i, bidiStart, bidiCount: LongInt; -begin - if FBidiMode=AValue then Exit; - FBidiMode:=AValue; - for i := 0 to ParagraphCount-1 do - begin - bidiStart := ParagraphStartIndex[i]; - bidiCount := ParagraphEndIndex[i]-bidiStart; - InternalUpdateBidiIsolate(i, bidiStart, bidiCount); - end; - if Assigned(FOnBidiModeChanged) then FOnBidiModeChanged(self); -end; - -function TUnicodeAnalysis.GetParagraphEndIndex(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); - result := FUnbrokenLine[FParagraph[AIndex+1].firstUnbrokenLineIndex].startIndex; - -end; - -function TUnicodeAnalysis.GetParagraphEndIndexBeforeParagraphSeparator( - AIndex: integer): integer; -var - u: LongWord; -begin - result := GetParagraphEndIndex(AIndex); - if (result > 0) and (AIndex < ParagraphCount) then // last paragraph separator would be temporary before split - begin - u := UnicodeChar[result-1]; - if (result>0) and IsUnicodeParagraphSeparator(u) then - begin - dec(result); - if IsUnicodeCrLf(u) and (result>0) and IsUnicodeCrLf(UnicodeChar[result-1]) and - (UnicodeChar[result-1] <> u) then dec(result); - end; - end; -end; - -function TUnicodeAnalysis.GetParagraphStartIndex(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); - result := FUnbrokenLine[FParagraph[AIndex].firstUnbrokenLineIndex].startIndex; -end; - -function TUnicodeAnalysis.GetUnbrokenLineParagraphIndex(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= UnbrokenLineCount) then raise exception.Create('Unbroken line index out of bounds'); - result := FUnbrokenLine[AIndex].paragraphIndex; -end; - -function TUnicodeAnalysis.GetBidiInfo(APosition0: integer): TUnicodeBidiInfo; -begin - if (APosition0 < 0) or (APosition0 >= CharCount) then raise ERangeError.Create('Char position out of bounds'); - result := FBidi[APosition0].BidiInfo; -end; - -function TUnicodeAnalysis.GetUnbrokenLineStartIndex(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= UnbrokenLineCount) then raise exception.Create('Unbroken line index out of bounds'); - result := FUnbrokenLine[AIndex].startIndex; -end; - -function TUnicodeAnalysis.GetParagraphLastUnbrokenLinePlusOne(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= ParagraphCount) then raise ERangeError.Create('Paragraph index out of bounds'); - result := FParagraph[AIndex+1].firstUnbrokenLineIndex; -end; - -function TUnicodeAnalysis.GetUnbrokenLineEndIndex(AIndex: integer): integer; -begin - if (AIndex < 0) or (AIndex >= UnbrokenLineCount) then raise exception.Create('Unbroken line index out of bounds'); - result := FUnbrokenLine[AIndex+1].startIndex; -end; - -function TUnicodeAnalysis.GetParagraphRightToLeft(AIndex: integer): boolean; -var - firstUnbroken, startIndex: Integer; -begin - if (AIndex < 0) or (AIndex >= ParagraphCount) then - raise ERangeError.Create('Paragraph index out of bounds'); - - firstUnbroken := ParagraphFirstUnbrokenLine[AIndex]; - startIndex := UnbrokenLineStartIndex[firstUnbroken]; - if startIndex < CharCount then - result := odd(BidiInfo[startIndex].ParagraphBidiLevel) - else - result := BidiMode = fbmRightToLeft; -end; - -procedure TUnicodeAnalysis.Analyze; -var - lineIndex, i: Integer; - curParaIndex: integer; -begin - FBidi:= AnalyzeBidiUTF8(FText, FBidiMode); - FCharCount := length(FBidi); - - FUnbrokenLineCount := 1; - FParagraphCount := 1; - for i := 0 to high(FBidi) do - begin - if FBidi[i].BidiInfo.IsEndOfLine or FBidi[i].BidiInfo.IsExplicitEndOfParagraph then - begin - if FBidi[i].BidiInfo.IsExplicitEndOfParagraph then inc(FParagraphCount); - inc(FUnbrokenLineCount); - end; - end; - - curParaIndex := 0; - lineIndex := 0; - setlength(FParagraph, FParagraphCount+1); - FParagraph[curParaIndex].firstUnbrokenLineIndex:= lineIndex; - setlength(FUnbrokenLine, FUnbrokenLineCount+1); - FUnbrokenLine[lineIndex].startIndex := 0; - FUnbrokenLine[lineIndex].paragraphIndex := curParaIndex; - inc(lineIndex); - for i := 0 to high(FBidi) do - begin - if FBidi[i].BidiInfo.IsEndOfLine or FBidi[i].BidiInfo.IsExplicitEndOfParagraph then - begin - if FBidi[i].BidiInfo.IsExplicitEndOfParagraph then - begin - inc(curParaIndex); - FParagraph[curParaIndex].firstUnbrokenLineIndex:= lineIndex; - end; - FUnbrokenLine[lineIndex].startIndex := i+1; - FUnbrokenLine[lineIndex].paragraphIndex := curParaIndex; - inc(lineIndex); - end; - end; - FParagraph[curParaIndex+1].firstUnbrokenLineIndex:= lineIndex; - FUnbrokenLine[lineIndex].startIndex := length(FBidi); - FUnbrokenLine[lineIndex].paragraphIndex:= curParaIndex+1; - - setlength(FBidi, length(FBidi)+1); - FBidi[High(FBidi)].Offset := length(FText); -end; - -constructor TUnicodeAnalysis.Create(ATextUTF8: string; ABidiMode: TFontBidiMode); -begin - FText:= ATextUTF8; - FBidiMode:= ABidiMode; - Analyze; -end; - -function TUnicodeAnalysis.GetParagraphAt(ACharIndex: integer): integer; - procedure FindRec(AFirstParagraphIndex, ALastParagraphIndex: integer); - var - midIndex: Integer; - begin - if ALastParagraphIndex= ParagraphStartIndex[midIndex+1]) then - FindRec(midIndex+1, ALastParagraphIndex) - else - begin - result := midIndex; - exit; - end; - end; - -begin - if (ACharIndex < 0) or (ACharIndex > CharCount) then raise exception.Create('Position out of bounds'); - FindRec(0, ParagraphCount-1); -end; - -function TUnicodeAnalysis.CopyTextUTF8(AStartIndex, ACount: integer): string; -begin - if (AStartIndex < 0) or (AStartIndex+ACount > CharCount) then - raise exception.Create('Char range out of bounds [' + inttostr(AStartIndex) + '..' + - inttostr(AStartIndex+ACount) + '] out of [0..' + inttostr(CharCount) + ']'); - result := copy(FText, FBidi[AStartIndex].Offset+1, FBidi[AStartIndex+ACount].Offset-FBidi[AStartIndex].Offset) -end; - -function TUnicodeAnalysis.CopyTextUTF8DiscardChars(AStartIndex, - AEndIndex: integer; out ANonDiscardedCount: integer): string; -var i, len, charLen: integer; -begin - CheckCharRange(AStartIndex, AEndIndex, 0, CharCount); - - ANonDiscardedCount:= 0; - len := 0; - for i := AStartIndex to AEndIndex-1 do - if not FBidi[i].BidiInfo.IsDiscardable then - begin - inc(len, FBidi[i+1].Offset - FBidi[i].Offset); - inc(ANonDiscardedCount); - end; - - setlength(result, len); - len := 0; - for i := AStartIndex to AEndIndex-1 do - if not FBidi[i].BidiInfo.IsDiscardable then - begin - charLen := FBidi[i+1].Offset - FBidi[i].Offset; - move(FText[FBidi[i].Offset+1], result[len+1], charLen); - inc(len, charLen); - end; -end; - -function TUnicodeAnalysis.InsertText(ATextUTF8: string; APosition: integer): integer; -var - newBidi: TBidiUTF8Array; -begin - if (APosition < 0) or (APosition > CharCount) then raise exception.Create('Position out of bounds'); - if length(ATextUTF8)=0 then exit(0); - - newBidi:= AnalyzeBidiUTF8(ATextUTF8, FBidiMode); - result:= InternalInsertText(APosition, newBidi, ATextUTF8); -end; - -function TUnicodeAnalysis.DeleteText(APosition, ACount: integer): integer; -begin - ACount := IncludeNonSpacingChars(APosition, ACount); - if ACount = 0 then exit(0); - InternalDeleteText(APosition, ACount); - result := ACount; -end; - -function TUnicodeAnalysis.DeleteTextBefore(APosition, ACount: integer): integer; -begin - ACount := IncludeNonSpacingCharsBefore(APosition, ACount, False); - if ACount = 0 then exit(0); - InternalDeleteText(APosition-ACount, ACount); - result := ACount; -end; - -function TUnicodeAnalysis.IncludeNonSpacingChars(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; -begin - if (APosition < 0) or (APosition > CharCount) then raise exception.Create('Position out of bounds'); - if APosition+ACount > CharCount then raise exception.Create('Exceed end of text'); - - //keep Cr/Lf pair together and non spacing marks after last char together - while (APosition+ACount < CharCount) and - not (BidiInfo[APosition+ACount].IsMulticharStart - or (not AIncludeCombiningMarks and - (BidiInfo[APosition+ACount].IsCombiningLeft - or BidiInfo[APosition+ACount].IsCombiningRight) - ) - ) do inc(ACount); - - result := ACount; -end; - -function TUnicodeAnalysis.IncludeNonSpacingCharsBefore(APosition, ACount: integer; AIncludeCombiningMarks: boolean): integer; -begin - if (APosition < 0) or (APosition > CharCount) then raise exception.Create('Position out of bounds'); - if APosition-ACount < 0 then raise exception.Create('Exceed start of text'); - if ACount = 0 then exit(0); - - //keep before non spacing marks until real char together - while (APosition-ACount > 0) and - not (BidiInfo[APosition-ACount].IsMulticharStart - or (not AIncludeCombiningMarks and - (BidiInfo[APosition-ACount].IsCombiningLeft - or BidiInfo[APosition-ACount].IsCombiningRight) - ) - ) do inc(ACount); - - result := ACount; -end; - -function TUnicodeAnalysis.CreateBidiTree(ABidiTreeFactory: TBidiTreeAny; - AData: pointer; AStartIndex, AEndIndex: integer; AEmbeddingBidiLevel: integer): TBidiTree; -begin - result := ABidiTreeFactory.Create(AData, AStartIndex, AEndIndex, AEmbeddingBidiLevel, false); - CreateBidiTreeRec(ABidiTreeFactory, AData, result); -end; - -procedure TUnicodeAnalysis.CreateBidiTreeRec(ABidiTreeFactory: TBidiTreeAny; AData: pointer; ABidiTree: TBidiTree); -var - startIndex, endIndex, i: integer; - subLevel: byte; - subStart: integer; - subTree: TBidiTree; -begin - startIndex := ABidiTree.StartIndex; - endIndex:= ABidiTree.EndIndex; - - while (startIndex < endIndex) and FBidi[startIndex].BidiInfo.IsDiscardable do inc(startIndex); - while (startIndex < endIndex) and FBidi[endIndex-1].BidiInfo.IsDiscardable do dec(endIndex); - if endIndex = startIndex then exit; - - i := startIndex; - while i < endIndex do - begin - if not FBidi[i].BidiInfo.IsDiscardable then - begin - if FBidi[i].BidiInfo.BidiLevel > ABidiTree.BidiLevel then - begin - subStart := i; - subLevel := FBidi[i].BidiInfo.BidiLevel; - inc(i); - while (i < endIndex) and (FBidi[i].BidiInfo.BidiLevel > ABidiTree.BidiLevel) do - begin - if FBidi[i].BidiInfo.BidiLevel < subLevel then - subLevel := FBidi[i].BidiInfo.BidiLevel; - inc(i); - end; - - subTree := ABidiTreeFactory.Create(AData, subStart, i, subLevel, false); - ABidiTree.AddBranch(subTree); - CreateBidiTreeRec(ABidiTreeFactory, AData, subTree); - subTree.AfterFinish; - if subTree.EndIndex < i then - begin - ABidiTree.Shorten(subTree.EndIndex); - exit; - end; - end else - begin - subStart:= i; - inc(i); - while (i < endIndex) and (FBidi[i].BidiInfo.BidiLevel = ABidiTree.BidiLevel) do inc(i); - - subTree := ABidiTreeFactory.Create(AData, subStart, i, ABidiTree.BidiLevel, true); - ABidiTree.AddBranch(subTree); - if subTree.TrySplit then - begin - ABidiTree.Shorten(subTree.EndIndex); - exit; - end; - end; - - end else - inc(i); - end; -end; - -procedure TUnicodeAnalysis.CheckCharRange(AStartIndex, AEndIndex: integer; - AMinIndex, AMaxIndex: integer); -begin - if AEndIndex AMaxIndex) then - raise exception.Create('Char range out of bounds ['+inttostr(AStartIndex)+','+IntToStr(AEndIndex)+'] > ['+inttostr(AMinIndex)+','+IntToStr(AMaxIndex)+']'); -end; - -procedure TUnicodeAnalysis.CheckTextAnalysis; -var - i: Integer; -begin - for i := 1 to high(FBidi)-1 do - if (FBidi[i].Offset <= 0) or (FBidi[i].Offset > length(FText)-1) then - raise exception.Create('UTF8 offset out of range for char '+inttostr(i)); - if (length(FBidi)>0) and ((FBidi[0].Offset <> 0) or (FBidi[high(FBidi)].Offset <> length(FText))) then - raise exception.Create('Unexpected UTF8 offset'); - for i := 0 to high(FUnbrokenLine) do - begin - if (i > 0) and (FUnbrokenLine[i].startIndex < FUnbrokenLine[i-1].startIndex) then - raise exception.Create('Unbroken line position must be increasing'); - if (i > 0) and (FUnbrokenLine[i].paragraphIndex < FUnbrokenLine[i-1].paragraphIndex) then - raise exception.Create('Unbroken line paragraph must be increasing'); - if (i > 0) and (FUnbrokenLine[i].paragraphIndex > FUnbrokenLine[i-1].paragraphIndex+1) then - raise exception.Create('Unbroken line must not skip paragraph'); - end; - if (length(FUnbrokenLine)>0) and ((FUnbrokenLine[0].paragraphIndex <> 0) - or (FUnbrokenLine[High(FUnbrokenLine)].paragraphIndex <> high(FParagraph))) then - raise exception.Create('Unexpected paragraph index'); - for i := 0 to high(FParagraph) do - begin - if (i > 0) and (FParagraph[i].firstUnbrokenLineIndex <= FParagraph[i-1].firstUnbrokenLineIndex) then - raise exception.Create('Paragraph unbroken line index must be strictly increasing'); - end; - if (length(FParagraph)>0) and ((FParagraph[0].firstUnbrokenLineIndex <> 0) or - (FParagraph[high(FParagraph)].firstUnbrokenLineIndex <> high(FUnbrokenLine))) then - raise exception.Create('Unexpected paragraph unbroken line index'); -end; - -function TUnicodeAnalysis.GetUnicodeChar(APosition0: integer): LongWord; -var p : PChar; - charLen, startOfs: Integer; -begin - if (APosition0 < 0) or (APosition0 >= CharCount) then raise ERangeError.Create('Char position out of bounds'); - startOfs := FBidi[APosition0].Offset; - p := @FText[startOfs+1]; - charLen := FBidi[APosition0+1].Offset - startOfs; - result := UTF8CodepointToUnicode(p, charLen); -end; - -function TUnicodeAnalysis.GetUTF8Char(APosition0: integer): string4; -begin - if (APosition0 < 0) or (APosition0 >= CharCount) then raise ERangeError.Create('Char position out of bounds'); - result := copy(FText, FBidi[APosition0].Offset+1, FBidi[APosition0+1].Offset-FBidi[APosition0].Offset); -end; - -procedure TUnicodeAnalysis.InternalDeleteText(APosition, ACount: integer); -var - i, delStart: Integer; - hasParaSep: Boolean; - indexBeforeSep: LongInt; -begin - for i := ParagraphCount-1 downto 0 do - if (APosition < ParagraphEndIndex[i]) and (APosition+ACount > ParagraphStartIndex[i]) then - begin - indexBeforeSep := ParagraphEndIndexBeforeParagraphSeparator[i]; - hasParaSep := indexBeforeSep<>ParagraphEndIndex[i]; - - if (i < ParagraphCount-1) and hasParaSep and (APosition+ACount > indexBeforeSep) then //paragraph separator removed - begin - if APosition <= ParagraphStartIndex[i] then - InternalDeleteParagraph(i) - else - begin - delStart := max(APosition,ParagraphStartIndex[i]); - InternalDeleteWithinParagraph(i, delStart, min(APosition+ACount,indexBeforeSep)-delStart, False); - InternalMergeParagraphWithNext(i); - end; - end else - begin - delStart := max(APosition,ParagraphStartIndex[i]); - InternalDeleteWithinParagraph(i, delStart, min(APosition+ACount,ParagraphEndIndex[i])-delStart, True); - end; - end; - {$IFDEF DEBUG}CheckTextAnalysis;{$ENDIF} -end; - -procedure TUnicodeAnalysis.InternalDeleteParagraph(AParagraphIndex: integer); -var - unbrokenStart, unbrokenEnd, unbrokenCount: Integer; - bidiStart, bidiCount, i: LongInt; -begin - if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then - raise ERangeError.Create('Paragraph index out of bounds'); - - unbrokenStart := FParagraph[AParagraphIndex].firstUnbrokenLineIndex; - unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; - unbrokenCount := unbrokenEnd-unbrokenStart; - - bidiStart := ParagraphStartIndex[AParagraphIndex]; - bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; - InternalDeleteBidiAndUTF8(bidiStart, bidiCount); - - for i := unbrokenStart to high(FUnbrokenLine)-unbrokenCount do - begin - FUnbrokenLine[i] := FUnbrokenLine[i+unbrokenCount]; - dec(FUnbrokenLine[i].paragraphIndex); - dec(FUnbrokenLine[i].startIndex, bidiCount); - end; - setlength(FUnbrokenLine, length(FUnbrokenLine)-unbrokenCount); - dec(FUnbrokenLineCount, unbrokenCount); - - for i := AParagraphIndex+1 to ParagraphCount do - dec(FParagraph[i].firstUnbrokenLineIndex, unbrokenCount); - if Assigned(FOnCharDeleted) then FOnCharDeleted(self, AParagraphIndex, bidiStart, bidiCount); - - for i := AParagraphIndex to ParagraphCount-1 do - FParagraph[i] := FParagraph[i+1]; - dec(FParagraphCount); - setlength(FParagraph, FParagraphCount+1); - if Assigned(FOnParagraphDeleted) then FOnParagraphDeleted(self, AParagraphIndex); -end; - -procedure TUnicodeAnalysis.InternalDeleteWithinParagraph( - AParagraphIndex: integer; APosition, ACount: integer; AUpdateBidi: boolean); -var - unbrokenEnd: Integer; - bidiStart, bidiCount: LongInt; - i: integer; -begin - if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then - raise ERangeError.Create('Paragraph index out of bounds'); - - InternalDeleteBidiAndUTF8(APosition, ACount); - - unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; - for i := unbrokenEnd to high(FUnbrokenLine) do - dec(FUnbrokenLine[i].startIndex, ACount); - - bidiStart := ParagraphStartIndex[AParagraphIndex]; - bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; - - if AUpdateBidi then InternalUpdateBidiIsolate(AParagraphIndex, bidiStart, bidiCount); - InternalUpdateUnbrokenLines(AParagraphIndex); - - if Assigned(FOnCharDeleted) then FOnCharDeleted(self, AParagraphIndex, APosition, ACount); -end; - -procedure TUnicodeAnalysis.InternalMergeParagraphWithNext(AParagraphIndex: integer); -var - indexBeforeSep, bidiStart, bidiCount, i: LongInt; - hasParaSep: Boolean; - unbrokenEnd: Integer; -begin - if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount-1) then - raise ERangeError.Create('Paragraph index out of bounds'); - - indexBeforeSep := ParagraphEndIndexBeforeParagraphSeparator[AParagraphIndex]; - hasParaSep := indexBeforeSep<>ParagraphEndIndex[AParagraphIndex]; - if not hasParaSep then exit; - - bidiStart := indexBeforeSep; - bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; - InternalDeleteBidiAndUTF8(bidiStart, bidiCount); - if Assigned(FOnCharDeleted) then - FOnCharDeleted(self, AParagraphIndex, bidiStart, bidiCount); - - unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; - for i := unbrokenEnd to high(FUnbrokenLine)-1 do - begin - FUnbrokenLine[i] := FUnbrokenLine[i+1]; - dec(FUnbrokenLine[i].paragraphIndex); - dec(FUnbrokenLine[i].startIndex, bidiCount); - end; - setlength(FUnbrokenLine, length(FUnbrokenLine)-1); - dec(FUnbrokenLineCount); - - for i := AParagraphIndex+1 to high(FParagraph)-1 do - begin - FParagraph[i] := FParagraph[i+1]; - dec(FParagraph[i].firstUnbrokenLineIndex); - end; - setlength(FParagraph, length(FParagraph)-1); - dec(FParagraphCount); - - bidiStart := ParagraphStartIndex[AParagraphIndex]; - bidiCount := ParagraphEndIndex[AParagraphIndex]-bidiStart; - InternalUpdateBidiIsolate(AParagraphIndex, bidiStart, bidiCount); - - if Assigned(FOnParagraphMergedWithNext) then - FOnParagraphMergedWithNext(self, AParagraphIndex); -end; - -procedure TUnicodeAnalysis.InternalDeleteBidiAndUTF8(ABidiStart, - ABidiCount: integer); -var - utf8Start, utf8Count, bidiEnd, i: Integer; -begin - if ABidiCount = 0 then exit; - if ABidiCount < 0 then raise exception.Create('Bidi count must be positive'); - bidiEnd := ABidiStart+ABidiCount; - CheckCharRange(ABidiStart, bidiEnd, 0, CharCount); - - utf8Start := FBidi[ABidiStart].Offset+1; - if bidiEnd >= CharCount then - utf8Count := length(FText) - (utf8Start-1) - else - utf8Count := FBidi[bidiEnd].Offset - (utf8Start-1); - delete(FText, utf8Start, utf8Count); - - for i := ABidiStart to high(FBidi)-ABidiCount do - begin - FBidi[i] := FBidi[i+ABidiCount]; - dec(FBidi[i].Offset, utf8Count); - end; - setlength(FBidi, length(FBidi)-ABidiCount); - dec(FCharCount, ABidiCount); -end; - -procedure TUnicodeAnalysis.InternalUpdateBidiIsolate(AParagraphIndex: integer; ABidiStart, ABidiCount: integer); -var - utf8Start, utf8Count, bidiEnd, i: Integer; - newBidi: TBidiUTF8Array; - startDiff,endDiff: integer; -begin - if ABidiCount = 0 then exit; - if ABidiCount < 0 then raise exception.Create('Bidi count must be positive'); - bidiEnd := ABidiStart+ABidiCount; - CheckCharRange(ABidiStart, bidiEnd, 0, CharCount); - - utf8Start := FBidi[ABidiStart].Offset+1; - if bidiEnd >= CharCount then - utf8Count := length(FText) - (utf8Start-1) - else - utf8Count := FBidi[bidiEnd].Offset - (utf8Start-1); - - newBidi:= AnalyzeBidiUTF8(copy(FText, utf8Start, utf8Count), FBidiMode); - - startDiff := maxLongint; - endDiff := -maxLongint; - for i := 0 to min(ABidiCount, length(newBidi))-1 do - if FBidi[ABidiStart+i].BidiInfo <> newBidi[i].BidiInfo then - begin - if i < startDiff then startDiff := i; - if i > endDiff then endDiff := i; - FBidi[ABidiStart+i] := newBidi[i]; - inc(FBidi[ABidiStart+i].Offset, utf8Start-1); - end; - if Assigned(OnAnalysisChanged) and (endDiff >= startDiff) then - OnAnalysisChanged(self, AParagraphIndex, startDiff, endDiff); -end; - -procedure TUnicodeAnalysis.InternalUpdateUnbrokenLines(AParagraphIndex: integer); -var - newUnbrokenCount, unbrokenStart, unbrokenEnd, unbrokenCount, - unbrokenDelta, curUnbrokenIndex: Integer; - bidiStart, bidiEnd, i: LongInt; -begin - if (AParagraphIndex < 0) or (AParagraphIndex >= ParagraphCount) then - raise ERangeError.Create('Paragraph index out of bounds'); - - bidiStart := ParagraphStartIndex[AParagraphIndex]; - if AParagraphIndex = ParagraphCount-1 then - bidiEnd := ParagraphEndIndex[AParagraphIndex] - else - bidiEnd := ParagraphEndIndexBeforeParagraphSeparator[AParagraphIndex]; - unbrokenStart := FParagraph[AParagraphIndex].firstUnbrokenLineIndex; - unbrokenEnd := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex; - unbrokenCount := unbrokenEnd-unbrokenStart; - - newUnbrokenCount := 1; - for i := bidiStart to bidiEnd-1 do - if FBidi[i].BidiInfo.IsEndOfLine or - FBidi[i].BidiInfo.IsExplicitEndOfParagraph then inc(newUnbrokenCount); - - if newUnbrokenCount < unbrokenCount then - begin - unbrokenDelta := unbrokenCount-newUnbrokenCount; - for i := unbrokenEnd-unbrokenDelta to high(FUnbrokenLine)-unbrokenDelta do - FUnbrokenLine[i] := FUnbrokenLine[i+unbrokenDelta]; - setlength(FUnbrokenLine, length(FUnbrokenLine)-unbrokenDelta); - dec(FUnbrokenLineCount, unbrokenDelta); - end else - if newUnbrokenCount > unbrokenCount then - begin - unbrokenDelta := newUnbrokenCount-unbrokenCount; - setlength(FUnbrokenLine, length(FUnbrokenLine)+unbrokenDelta); - inc(FUnbrokenLineCount, unbrokenDelta); - for i := high(FUnbrokenLine) downto unbrokenEnd+unbrokenDelta do - FUnbrokenLine[i] := FUnbrokenLine[i-unbrokenDelta]; - end; - for i := AParagraphIndex+1 to high(FParagraph) do - inc(FParagraph[i].firstUnbrokenLineIndex, newUnbrokenCount-unbrokenCount); - - curUnbrokenIndex := unbrokenStart; - FUnbrokenLine[curUnbrokenIndex].startIndex:= bidiStart; - FUnbrokenLine[curUnbrokenIndex].paragraphIndex:= AParagraphIndex; - for i := bidiStart to bidiEnd-1 do - begin - if FBidi[i].BidiInfo.IsEndOfLine or - FBidi[i].BidiInfo.IsExplicitEndOfParagraph then // paragraph separator before split - begin - inc(curUnbrokenIndex); - FUnbrokenLine[curUnbrokenIndex].startIndex := i+1; - FUnbrokenLine[curUnbrokenIndex].paragraphIndex:= AParagraphIndex; - end; - end; -end; - -function TUnicodeAnalysis.InternalInsertText(APosition: integer; - const ANewBidi: TBidiUTF8Array; ANewTextUTF8: string): integer; -var - utf8Start, utf8Count, - prevCharCount, bidiCount, paraBidiStart, paraBidiCount, - i, unbrokenEnd, paraIndex: integer; -begin - if (APosition < 0) or (APosition>CharCount) then - raise exception.Create('Position out of bounds'); - if length(ANewBidi)=0 then exit; - - prevCharCount:= CharCount; - paraIndex := GetParagraphAt(APosition); - bidiCount := length(ANewBidi); - - utf8Start := FBidi[APosition].Offset+1; - utf8Count := length(ANewTextUTF8); - Insert(ANewTextUTF8, FText, utf8Start); - - setlength(FBidi, length(FBidi)+bidiCount); - for i := high(FBidi) downto APosition+bidiCount do - begin - FBidi[i] := FBidi[i-bidiCount]; - inc(FBidi[i].Offset, utf8Count); - end; - for i := 0 to high(ANewBidi) do - begin - FBidi[APosition+i] := ANewBidi[i]; - inc(FBidi[APosition+i].Offset, utf8Start-1); - end; - inc(FCharCount, bidiCount); - - unbrokenEnd := FParagraph[paraIndex+1].firstUnbrokenLineIndex; - for i := unbrokenEnd to high(FUnbrokenLine) do - inc(FUnbrokenLine[i].startIndex, bidiCount); - - paraBidiStart := ParagraphStartIndex[paraIndex]; - paraBidiCount := ParagraphEndIndex[paraIndex]-paraBidiStart; - InternalUpdateBidiIsolate(paraIndex, paraBidiStart, paraBidiCount); - - InternalUpdateUnbrokenLines(paraIndex); - if Assigned(FOnCharInserted) then - FOnCharInserted(self, paraIndex, APosition, bidiCount); - - InternalSplitParagraph(paraIndex); - {$IFDEF DEBUG}CheckTextAnalysis;{$ENDIF} - result := CharCount-prevCharCount; -end; - -procedure TUnicodeAnalysis.InternalSplitParagraph(AParagraphIndex: integer); -var - i, unbrokenStart, unbrokenEndIncl, j, paraIndex: integer; -begin - unbrokenStart := FParagraph[AParagraphIndex].firstUnbrokenLineIndex; - unbrokenEndIncl := FParagraph[AParagraphIndex+1].firstUnbrokenLineIndex-1; - for i := unbrokenStart+1 to unbrokenEndIncl do - begin - if (FUnbrokenLine[i].startIndex > 0) and - FBidi[FUnbrokenLine[i].startIndex-1].BidiInfo.IsExplicitEndOfParagraph then - begin - paraIndex := FUnbrokenLine[i].paragraphIndex; - setlength(FParagraph, length(FParagraph)+1); - inc(FParagraphCount); - for j := high(FParagraph) downto paraIndex+2 do - FParagraph[j] := FParagraph[j-1]; - FParagraph[paraIndex+1].firstUnbrokenLineIndex:= i; - for j := i to high(FUnbrokenLine) do - inc(FUnbrokenLine[j].paragraphIndex); - - if Assigned(OnParagraphSplit) then - OnParagraphSplit(self, paraIndex, FUnbrokenLine[i].startIndex); - end; - end; -end; - -end. - diff --git a/components/bgrabitmap/bgraunits.pas b/components/bgrabitmap/bgraunits.pas deleted file mode 100644 index 27d469d..0000000 --- a/components/bgrabitmap/bgraunits.pas +++ /dev/null @@ -1,572 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAUnits; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, BGRABitmapTypes; - -type - TSVGNumber = single;//double - ArrayOfTSVGNumber = array of TSVGNumber; - - TCSSUnit = (cuCustom, cuPixel, - cuCentimeter, cuMillimeter, - cuInch, cuPica, cuPoint, - cuFontEmHeight, cuFontXHeight, cuPercent); - TFloatWithCSSUnit = record - value: single; - CSSUnit: TCSSUnit; - end; - - ArrayOfTFloatWithCSSUnit = array of TFloatWithCSSUnit; - - -function FloatWithCSSUnit(AValue: single; AUnit: TCSSUnit): TFloatWithCSSUnit; - -const - CSSUnitShortName: array[TCSSUnit] of string = - ('','px', - 'cm','mm', - 'in','pc','pt', - 'em','ex','%'); - -type - { TCSSUnitConverter } - - TCSSUnitConverter = class - protected - FViewBoxHeight: TFloatWithCSSUnit; - FViewBoxWidth: TFloatWithCSSUnit; - FViewBoxHeightInUnit: array[TCSSUnit] of single; - FViewBoxWidthInUnit: array[TCSSUnit] of single; - FCurrentFontEmHeight: TFloatWithCSSUnit; - function GetRootFontEmHeight: TFloatWithCSSUnit; - function GetDefaultUnitHeight: TFloatWithCSSUnit; virtual; - function GetDefaultUnitWidth: TFloatWithCSSUnit; virtual; - function GetDpiX: single; virtual; - function GetDpiY: single; virtual; - function GetFontEmHeight: TFloatWithCSSUnit; virtual; - function GetFontXHeight: TFloatWithCSSUnit; virtual; - procedure SetViewBoxHeight(AValue: TFloatWithCSSUnit); - procedure SetViewBoxWidth(AValue: TFloatWithCSSUnit); - property FontEmHeight: TFloatWithCSSUnit read GetFontEmHeight; - property FontXHeight: TFloatWithCSSUnit read GetFontXHeight; - property DefaultUnitWidth: TFloatWithCSSUnit read GetDefaultUnitWidth; - property DefaultUnitHeight: TFloatWithCSSUnit read GetDefaultUnitHeight; - public - constructor Create; - function ConvertOrtho(xy: single; sourceUnit, destUnit: TCSSUnit): single; overload; - function ConvertOrtho(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit): TFloatWithCSSUnit; overload; - function ConvertWidth(x: single; sourceUnit, destUnit: TCSSUnit): single; overload; - function ConvertHeight(y: single; sourceUnit, destUnit: TCSSUnit): single; overload; - function ConvertWidth(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit): TFloatWithCSSUnit; overload; - function ConvertHeight(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit): TFloatWithCSSUnit; overload; - function ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; overload; - function ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; overload; - function ConvertCoord(pt: TPointF; sourceUnit, destUnit: TCSSUnit): TPointF; overload; - function GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit): TAffineMatrix; overload; - function Convert(xy: single; sourceUnit, destUnit: TCSSUnit; dpi: single; containerSize: single = 0): single; - function ConvertOrtho(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TFloatWithCSSUnit; overload; - function ConvertWidth(x: single; sourceUnit, destUnit: TCSSUnit; containerWidth: single): single; overload; - function ConvertHeight(y: single; sourceUnit, destUnit: TCSSUnit; containerHeight: single): single; overload; - function ConvertWidth(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit; containerWidth: single): TFloatWithCSSUnit; overload; - function ConvertHeight(AValue: TFloatWithCSSUnit; destUnit: TCSSUnit; containerHeight: single): TFloatWithCSSUnit; overload; - function ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit; containerWidth: single): ArrayOfTFloatWithCSSUnit; overload; - function ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; destUnit: TCSSUnit; containerHeight: single): ArrayOfTFloatWithCSSUnit; overload; - function ConvertCoord(pt: TPointF; sourceUnit, destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TPointF; overload; - function GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit; containerWidth: single; containerHeight: single): TAffineMatrix; overload; - class function parseValue(AValue: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload; static; - class function parseValue(AValue: string; ADefault: single): single; overload; static; - class function parseArrayOfNumbers(AValue: string): ArrayOfTSVGNumber; overload; static; - class function parseArrayOfValuesWithUnit(AValue: string): ArrayOfTFloatWithCSSUnit; overload; static; - class function formatValue(AValue: TFloatWithCSSUnit; APrecision: integer = 7): string; overload; static; - class function formatValue(AValue: single; APrecision: integer = 7): string; overload; static; - class function formatValue(AValue: ArrayOfTSVGNumber; APrecision: integer = 7): string; overload; static; - class function formatValue(AValue: ArrayOfTFloatWithCSSUnit; APrecision: integer = 7): string; overload; static; - property ViewBoxWidth: TFloatWithCSSUnit read FViewBoxWidth write SetViewBoxWidth; - property ViewBoxHeight: TFloatWithCSSUnit read FViewBoxHeight write SetViewBoxHeight; - property DpiX: single read GetDpiX; - property DpiY: single read GetDpiY; - property CurrentFontEmHeight: TFloatWithCSSUnit read FCurrentFontEmHeight write FCurrentFontEmHeight; - property RootFontEmHeight: TFloatWithCSSUnit read GetRootFontEmHeight; - end; - -implementation - -uses BGRATransform; - -var - formats: TFormatSettings; - -const InchFactor: array[TCSSUnit] of integer = - (9600, 9600, - 254, 2540, - 100, 600, 7200, - 0, 0, 0); - -function FloatWithCSSUnit(AValue: single; AUnit: TCSSUnit): TFloatWithCSSUnit; -begin - result.value:= AValue; - result.CSSUnit:= AUnit; -end; - -{ TCSSUnitConverter } - -procedure TCSSUnitConverter.SetViewBoxHeight(AValue: TFloatWithCSSUnit); -var - u: TCSSUnit; -begin - if (FViewBoxHeight.value=AValue.value) and - (FViewBoxHeight.CSSUnit=AValue.CSSUnit) then Exit; - FViewBoxHeight:=AValue; - for u := low(TCSSUnit) to high(TCSSUnit) do - FViewBoxHeightInUnit[u] := ConvertHeight(FViewBoxHeight, u, 0).value; -end; - -procedure TCSSUnitConverter.SetViewBoxWidth(AValue: TFloatWithCSSUnit); -var - u: TCSSUnit; -begin - if (FViewBoxWidth.value=AValue.value) and - (FViewBoxWidth.CSSUnit=AValue.CSSUnit) then Exit; - FViewBoxWidth:=AValue; - for u := low(TCSSUnit) to high(TCSSUnit) do - FViewBoxWidthInUnit[u] := ConvertWidth(FViewBoxWidth, u, 0).value; -end; - -function TCSSUnitConverter.GetRootFontEmHeight: TFloatWithCSSUnit; -begin - result := FloatWithCSSUnit(12, cuPoint); -end; - -function TCSSUnitConverter.GetFontEmHeight: TFloatWithCSSUnit; -begin - result := FCurrentFontEmHeight; -end; - -function TCSSUnitConverter.GetFontXHeight: TFloatWithCSSUnit; -begin - result := FCurrentFontEmHeight; - result.value := result.value * 0.5; //approximation -end; - -function TCSSUnitConverter.GetDefaultUnitHeight: TFloatWithCSSUnit; -begin - result := FloatWithCSSUnit(1,cuPixel); -end; - -function TCSSUnitConverter.GetDefaultUnitWidth: TFloatWithCSSUnit; -begin - result := FloatWithCSSUnit(1,cuPixel); -end; - -function TCSSUnitConverter.GetDpiX: single; -begin - result := 96; -end; - -function TCSSUnitConverter.GetDpiY: single; -begin - result := 96; -end; - -function TCSSUnitConverter.Convert(xy: single; sourceUnit, destUnit: TCSSUnit; - dpi: single; containerSize: single): single; -var sourceFactor, destFactor: integer; -begin - //fallback values for cuCustom as pixels - if sourceUnit = cuCustom then sourceUnit := cuPixel; - if destUnit = cuCustom then destUnit := cuPixel; - if (sourceUnit = destUnit) then - result := xy - else - if sourceUnit = cuPercent then - begin - result := xy/100*containerSize; - end else - if sourceUnit = cuFontEmHeight then - begin - with FontEmHeight do result := Convert(xy*value,CSSUnit, destUnit, dpi); - end else - if sourceUnit = cuFontXHeight then - begin - with FontXHeight do result := Convert(xy*value,CSSUnit, destUnit, dpi); - end else - if destUnit = cuFontEmHeight then - begin - with ConvertHeight(FontEmHeight, sourceUnit) do - if value = 0 then result := 0 else result := xy/value; - end else - if destUnit = cuFontXHeight then - begin - with ConvertHeight(FontXHeight, sourceUnit) do - if value = 0 then result := 0 else result := xy/value; - end else - if sourceUnit = cuPixel then - begin - if dpi = 0 then result := 0 - else result := xy*(InchFactor[destUnit]/(dpi*100)); - end else - if destUnit = cuPixel then - begin - if dpi = 0 then result := 0 - else result := xy*((dpi*100)/InchFactor[sourceUnit]); - end else - begin - sourceFactor := InchFactor[sourceUnit]; - destFactor := InchFactor[destUnit]; - if (sourceFactor = 0) or (destFactor = 0) then - result := 0 - else - result := xy*(destFactor/sourceFactor); - end; -end; - -function TCSSUnitConverter.ConvertOrtho(AValue: TFloatWithCSSUnit; - destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TFloatWithCSSUnit; -begin - result.value := (ConvertWidth(AValue.value, AValue.CSSUnit, destUnit, containerWidth) + - ConvertHeight(AValue.value, AValue.CSSUnit, destUnit, containerHeight)) / 2; - result.CSSUnit:= destUnit; -end; - -function TCSSUnitConverter.ConvertWidth(x: single; sourceUnit, - destUnit: TCSSUnit; containerWidth: single): single; -begin - if sourceUnit = destUnit then - result := x - else if sourceUnit = cuCustom then - with DefaultUnitWidth do - begin - result := x*ConvertWidth(value,CSSUnit, destUnit, containerWidth) - end - else if sourceUnit = cuPercent then - begin - result := x/100*containerWidth; - end - else if destUnit = cuCustom then - with ConvertWidth(DefaultUnitWidth,sourceUnit) do - begin - if value = 0 then - result := 0 - else - result := x/value; - end else - result := Convert(x, sourceUnit, destUnit, DpiX, containerWidth); -end; - -function TCSSUnitConverter.ConvertHeight(y: single; sourceUnit, - destUnit: TCSSUnit; containerHeight: single): single; -begin - if sourceUnit = cuCustom then - with DefaultUnitHeight do - begin - result := y*ConvertHeight(value,CSSUnit, destUnit, containerHeight) - end - else if sourceUnit = cuPercent then - begin - result := y/100*containerHeight; - end - else if destUnit = cuCustom then - with ConvertHeight(DefaultUnitHeight,sourceUnit) do - begin - if value = 0 then - result := 0 - else - result := y/value; - end else - result := Convert(y, sourceUnit, destUnit, DpiY, containerHeight); -end; - -function TCSSUnitConverter.ConvertWidth(AValue: TFloatWithCSSUnit; - destUnit: TCSSUnit; containerWidth: single): TFloatWithCSSUnit; -begin - result.CSSUnit := destUnit; - result.value:= ConvertWidth(AValue.value,AValue.CSSUnit,destUnit,containerWidth); -end; - -function TCSSUnitConverter.ConvertHeight(AValue: TFloatWithCSSUnit; - destUnit: TCSSUnit; containerHeight: single): TFloatWithCSSUnit; -begin - result.CSSUnit := destUnit; - result.value:= ConvertHeight(AValue.value,AValue.CSSUnit,destUnit,containerHeight); -end; - -function TCSSUnitConverter.ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; - destUnit: TCSSUnit; containerWidth: single): ArrayOfTFloatWithCSSUnit; -var - i: integer; -begin - for i := low(AValue) to high(AValue) do - AValue[i]:= ConvertWidth(AValue[i],destUnit,containerWidth); - result := AValue; -end; - -function TCSSUnitConverter.ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; - destUnit: TCSSUnit; containerHeight: single): ArrayOfTFloatWithCSSUnit; -var - i: integer; -begin - for i := low(AValue) to high(AValue) do - AValue[i]:= ConvertHeight(AValue[i],destUnit,containerHeight); - result := AValue; -end; - -function TCSSUnitConverter.ConvertCoord(pt: TPointF; sourceUnit, - destUnit: TCSSUnit; containerWidth: single; containerHeight: single): TPointF; -begin - result.x := ConvertWidth(pt.x, sourceUnit, destUnit, containerWidth); - result.y := ConvertHeight(pt.y, sourceUnit, destUnit, containerHeight); -end; - -function TCSSUnitConverter.GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit; - containerWidth: single; containerHeight: single): TAffineMatrix; -var - ptUnit: TPointF; -begin - ptUnit := ConvertCoord(PointF(1, 1), AFromUnit, AToUnit, containerWidth, containerHeight); - result := AffineMatrixScale(ptUnit.x, ptUnit.y); -end; - -class function TCSSUnitConverter.parseValue(AValue: string; - ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; -var cssUnit: TCSSUnit; - errPos: integer; -begin - AValue := trim(AValue); - result.CSSUnit:= cuCustom; - for cssUnit := succ(cuCustom) to high(cssUnit) do - if (length(AValue)>=length(CSSUnitShortName[cssUnit])) and - (CompareText(copy(AValue,length(AValue)-length(CSSUnitShortName[cssUnit])+1,length(CSSUnitShortName[cssUnit])), - CSSUnitShortName[cssUnit])=0) then - begin - AValue := copy(AValue,1,length(AValue)-length(CSSUnitShortName[cssUnit])); - result.CSSUnit := cssUnit; - break; - end; - val(AValue,result.value,errPos); - if errPos <> 0 then - result := ADefault; -end; - -class function TCSSUnitConverter.parseValue(AValue: string; ADefault: single): single; -var - errPos: integer; -begin - AValue := trim(AValue); - val(AValue,result,errPos); - if errPos <> 0 then - result := ADefault; -end; - -class function TCSSUnitConverter.parseArrayOfNumbers(AValue: string): ArrayOfTSVGNumber; -var - i, l,p: integer; - - procedure CanAddToArray; - var - len: integer; - begin - if l <> 0 then - begin - len := length(result); - setlength(result,len+1); - result[len] := parseValue( copy(AValue,p,l), 0); - end; - end; - -begin - AValue := trim(AValue); - if AValue = '' then exit(nil); - - setlength(result,0); - p:= 1; - l:= 0; - for i := 1 to length(AValue) do - begin - if AValue[i] in [#9,#10,#13,#32,#44] then - begin - CanAddToArray; - p:= i+1; - l:= 0; - end - else - Inc(l); - end; - CanAddToArray; -end; - -class function TCSSUnitConverter.parseArrayOfValuesWithUnit(AValue: string): ArrayOfTFloatWithCSSUnit; -var - i, l,p: integer; - def: TFloatWithCSSUnit; - - procedure CanAddToArray; - var - len: integer; - begin - if l <> 0 then - begin - len := length(result); - setlength(result,len+1); - result[len] := parseValue( copy(AValue,p,l), def); - end; - end; - -begin - AValue := trim(AValue); - if AValue = '' then exit(nil); - - def := FloatWithCSSUnit(0, cuCustom); - setlength(result,0); - p:= 1; - l:= 0; - for i := 1 to length(AValue) do - begin - if AValue[i] in [#9,#10,#13,#32,#44] then - begin - CanAddToArray; - p:= i+1; - l:= 0; - end - else - Inc(l); - end; - CanAddToArray; -end; - -class function TCSSUnitConverter.formatValue(AValue: TFloatWithCSSUnit; APrecision: integer = 7): string; -begin - result := FloatToStrF(AValue.value,ffGeneral,APrecision,0,formats)+CSSUnitShortName[AValue.CSSUnit]; -end; - -class function TCSSUnitConverter.formatValue(AValue: single; APrecision: integer - ): string; -begin - result := FloatToStrF(AValue,ffGeneral,APrecision,0,formats); -end; - -class function TCSSUnitConverter.formatValue(AValue: ArrayOfTSVGNumber; APrecision: integer = 7): string; -var - i, len: integer; -begin - len:= length(AValue); - if len = 0 then - result:= '' - else if len = 1 then - result:= formatValue(AValue[0], APrecision) - else - begin - result:= ''; - for i := 0 to len-1 do - begin - result:= result + formatValue(AValue[i], APrecision); - if i <> (len-1) then - result:= result + ', '; - end; - end; -end; - -class function TCSSUnitConverter.formatValue(AValue: ArrayOfTFloatWithCSSUnit; APrecision: integer = 7): string; -var - i, len: integer; -begin - len:= length(AValue); - if len = 0 then - result:= '' - else if len = 1 then - result:= formatValue(AValue[0], APrecision) - else - begin - result:= ''; - for i := 0 to len-1 do - begin - result:= result + formatValue(AValue[i], APrecision); - if i <> (len-1) then - result:= result + ', '; - end; - end; -end; - -constructor TCSSUnitConverter.Create; -begin - inherited; - FCurrentFontEmHeight:= GetRootFontEmHeight; - ViewBoxWidth := FloatWithCSSUnit(0, cuPixel); - ViewBoxHeight := FloatWithCSSUnit(0, cuPixel); -end; - -function TCSSUnitConverter.ConvertOrtho(xy: single; sourceUnit, - destUnit: TCSSUnit): single; -begin - result := (ConvertWidth(xy, sourceUnit, destUnit) + - ConvertHeight(xy, sourceUnit, destUnit)) / 2; -end; - -function TCSSUnitConverter.ConvertOrtho(AValue: TFloatWithCSSUnit; - destUnit: TCSSUnit): TFloatWithCSSUnit; -begin - result.value := (ConvertWidth(AValue.value, AValue.CSSUnit, destUnit) + - ConvertHeight(AValue.value, AValue.CSSUnit, destUnit)) / 2; - result.CSSUnit:= destUnit; -end; - -function TCSSUnitConverter.ConvertWidth(x: single; sourceUnit, - destUnit: TCSSUnit): single; -begin - result := ConvertWidth(x, sourceUnit, destUnit, FViewBoxWidthInUnit[destUnit]); -end; - -function TCSSUnitConverter.ConvertHeight(y: single; sourceUnit, - destUnit: TCSSUnit): single; -begin - result := ConvertHeight(y, sourceUnit, destUnit, FViewBoxHeightInUnit[destUnit]); -end; - -function TCSSUnitConverter.ConvertWidth(AValue: TFloatWithCSSUnit; - destUnit: TCSSUnit): TFloatWithCSSUnit; -begin - result := ConvertWidth(AValue, destUnit, FViewBoxWidthInUnit[destUnit]); -end; - -function TCSSUnitConverter.ConvertHeight(AValue: TFloatWithCSSUnit; - destUnit: TCSSUnit): TFloatWithCSSUnit; -begin - result := ConvertHeight(AValue, destUnit, FViewBoxHeightInUnit[destUnit]); -end; - -function TCSSUnitConverter.ConvertWidth(AValue: ArrayOfTFloatWithCSSUnit; - destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; -begin - result := ConvertWidth(AValue, destUnit, FViewBoxWidthInUnit[destUnit]); -end; - -function TCSSUnitConverter.ConvertHeight(AValue: ArrayOfTFloatWithCSSUnit; - destUnit: TCSSUnit): ArrayOfTFloatWithCSSUnit; -begin - result := ConvertHeight(AValue, destUnit, FViewBoxHeightInUnit[destUnit]); -end; - -function TCSSUnitConverter.ConvertCoord(pt: TPointF; sourceUnit, - destUnit: TCSSUnit): TPointF; -begin - result := ConvertCoord(pt, sourceUnit, destUnit, - FViewBoxWidthInUnit[destUnit], FViewBoxHeightInUnit[destUnit]); -end; - -function TCSSUnitConverter.GetConversionMatrix(AFromUnit, AToUnit: TCSSUnit): TAffineMatrix; -begin - result := GetConversionMatrix(AFromUnit, AToUnit, - FViewBoxWidthInUnit[AToUnit], FViewBoxHeightInUnit[AToUnit]); -end; - -initialization - - formats := DefaultFormatSettings; - formats.DecimalSeparator := '.'; - -end. - diff --git a/components/bgrabitmap/bgrautf8.pas b/components/bgrabitmap/bgrautf8.pas deleted file mode 100644 index 8415793..0000000 --- a/components/bgrabitmap/bgrautf8.pas +++ /dev/null @@ -1,1509 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAUTF8; - -{$mode objfpc}{$H+} -{$i bgrabitmap.inc} - -interface - -uses - BGRAClasses, SysUtils, math, BGRAUnicode{$IFDEF BGRABITMAP_USE_LCL}, lazutf8classes{$ENDIF}; - -const - UTF8_ARABIC_ALEPH = 'ا'; - UTF8_ARABIC_ALEPH_HAMZA_BELOW = 'Ø¥'; - UTF8_ARABIC_ALEPH_HAMZA_ABOVE = 'Ø£'; - UTF8_ARABIC_ALEPH_MADDA_ABOVE = 'Ø¢'; - UTF8_ARABIC_LAM = 'Ù„'; - UTF8_NO_BREAK_SPACE = ' '; - UTF8_ZERO_WIDTH_NON_JOINER = '‌'; - UTF8_ZERO_WIDTH_JOINER = 'â€'; - UTF8_LINE_SEPARATOR = #$E2#$80#$A8; //equivalent of
- UTF8_PARAGRAPH_SEPARATOR = #$E2#$80#$A9; //equivalent of

- UTF8_NEXT_LINE = #$C2#$85; //equivalent of CRLF - -{$IFDEF BGRABITMAP_USE_LCL} -type - TFileStreamUTF8 = lazutf8classes.TFileStreamUTF8; - TStringListUTF8 = lazutf8classes.TStringListUTF8; -{$ELSE} -type - TFileStreamUTF8 = class(THandleStream) - private - FFileName: utf8string; - public - constructor Create(const AFileName: utf8string; Mode: Word); overload; - constructor Create(const AFileName: utf8string; Mode: Word; Rights: LongWord); overload; - destructor Destroy; override; - property FileName: utf8string Read FFilename; - end; - - TStringListUTF8 = class(TStringList) - protected - function DoCompareText(const s1,s2 : string) : PtrInt; override; - public - procedure LoadFromFile(const FileName: string); override; - procedure SaveToFile(const FileName: string); override; - end; -{$ENDIF} - -procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string); -procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string); - -function UTF8ToSys(const s: string): string; -function SysToUTF8(const s: string): string; - -function UTF8LowerCase(const s: string): string; -function UTF8UpperCase(const s: string): string; - -function UTF8CompareStr(const S1, S2: string): Integer; -function UTF8CompareText(const S1, S2: string): Integer; - -function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar; - -function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle; -function FileCreateUTF8(Const FileName : string) : THandle; overload; -function FileCreateUTF8(Const FileName : string; Rights: LongWord) : THandle; overload; -function FileExistsUTF8(Const FileName : string): boolean; -function DeleteFileUTF8(Const FileName : string): boolean; -function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint; -function FindNextUTF8(var Rslt: TSearchRec): Longint; -procedure FindCloseUTF8(var F: TSearchrec); - -type - string4 = string[4]; - TUnicodeArray = packed array of LongWord; - TIntegerArray = array of integer; - -function UTF8CharacterLength(p: PChar): integer; -function UTF8Length(const s: string): PtrInt; overload; -function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; overload; -function UnicodeCharToUTF8(u: LongWord): string4; -function UTF8ReverseString(const s: string): string; -function UTF8CodepointToUnicode(p: PChar; ACodePointLen: integer): LongWord; -function UTF8ToUTF16(const S: AnsiString): UnicodeString; -function UTF16ToUTF8(const S: UnicodeString): AnsiString; -procedure UTF8ToUnicodeArray(const sUTF8: string; out u: TUnicodeArray; out ofs: TIntegerArray); - -type - TBidiUTF8Info = packed record - Offset: Integer; - BidiInfo: TUnicodeBidiInfo; - end; - TBidiUTF8Array = packed array of TBidiUTF8Info; - TUnicodeDisplayOrder = BGRAUnicode.TUnicodeDisplayOrder; - TUnicodeBidiInfo = BGRAUnicode.TUnicodeBidiInfo; - -function GetBidiClassUTF8(P: PChar): TUnicodeBidiClass; -function GetFirstStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; -function GetLastStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; -function IsRightToLeftUTF8(const sUTF8: string): boolean; -function IsZeroWidthUTF8(const sUTF8: string): boolean; -function AddParagraphBidiUTF8(s: string; ARightToLeft: boolean): string; -function AnalyzeBidiUTF8(const sUTF8: string): TBidiUTF8Array; overload; -function AnalyzeBidiUTF8(const sUTF8: string; ABidiMode: TFontBidiMode): TBidiUTF8Array; overload; -function AnalyzeBidiUTF8(const sUTF8: string; ARightToLeft: boolean): TBidiUTF8Array; overload; -function GetUTF8DisplayOrder(const ABidi: TBidiUTF8Array): TUnicodeDisplayOrder; -function ContainsBidiIsolateOrFormattingUTF8(const sUTF8: string): boolean; - -function UTF8OverrideDirection(const sUTF8: string; ARightToLeft: boolean): string; -function UTF8EmbedDirection(const sUTF8: string; ARightToLeft: boolean): string; -function UTF8Ligature(const sUTF8: string; ARightToLeft: boolean; ALigatureLeft, ALigatureRight: boolean): string; - -type - - { TGlyphUtf8 } - - TGlyphUtf8 = record - private - function GetEmpty: boolean; - public - GlyphUtf8, MirroredGlyphUtf8: string; - RightToLeft, Mirrored, Merged: boolean; - ByteOffset, ByteSize: integer; - property Empty: boolean read GetEmpty; - end; - - { TGlyphCursorUtf8 } - - TGlyphCursorUtf8 = record - private - sUTF8: string; - currentChar: string; - currentOffset: integer; - currentBidiInfo: TUnicodeBidiInfo; - bidiArray: TBidiUTF8Array; - displayOrder: TUnicodeDisplayOrder; - displayIndex: Integer; - procedure NextMultichar; - procedure PeekMultichar; - public - class function New(const textUTF8: string; ABidiMode: TFontBidiMode): TGlyphCursorUtf8; static; - function GetNextGlyph: TGlyphUtf8; - procedure Rewind; - function EndOfString: boolean; - end; - -//little endian stream functions -function LEReadInt64(Stream: TStream): int64; -procedure LEWriteInt64(Stream: TStream; AValue: int64); -function LEReadLongint(Stream: TStream): longint; -procedure LEWriteLongint(Stream: TStream; AValue: LongInt); -function LEReadByte(Stream: TStream): byte; -procedure LEWriteByte(Stream: TStream; AValue: Byte); -function LEReadSingle(Stream: TStream): single; -procedure LEWriteSingle(Stream: TStream; AValue: single); - -implementation - -{$IFDEF BGRABITMAP_USE_LCL} -uses LazFileUtils, LazUtf8; - -procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string); -begin - lazutf8classes.LoadStringsFromFileUTF8(List,FileName); -end; - -procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string); -begin - lazutf8classes.SaveStringsToFileUTF8(List,FileName); -end; - -function UTF8ToSys(const s: string): string; -begin - result := LazUtf8.UTF8ToSys(s); -end; - -function SysToUTF8(const s: string): string; -begin - result := LazUtf8.SysToUTF8(s); -end; - -function UTF8LowerCase(const s: string): string; -begin - result := LazUtf8.UTF8LowerCase(s); -end; - -function UTF8UpperCase(const s: string): string; -begin - result := LazUtf8.UTF8UpperCase(s); -end; - -function UTF8CompareStr(const S1, S2: string): Integer; -begin - result := LazUtf8.UTF8CompareStr(S1,S2); -end; - -function UTF8CompareText(const S1, S2: string): Integer; -begin - result := LazUtf8.UTF8CompareText(S1,S2); -end; - -function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle; -begin - result := LazFileUtils.FileOpenUTF8(FileName, Mode); -end; - -function FileCreateUTF8(Const FileName : string) : THandle; overload; -begin - result := LazFileUtils.FileCreateUTF8(FileName); -end; - -function FileCreateUTF8(Const FileName : string; Rights: LongWord) : THandle; overload; -begin - result := LazFileUtils.FileCreateUTF8(FileName, Rights); -end; - -function FileExistsUTF8(Const FileName : string): boolean; -begin - result := LazFileUtils.FileExistsUTF8(FileName); -end; - -function DeleteFileUTF8(const FileName: string): boolean; -begin - result := LazFileUtils.DeleteFileUTF8(FileName); -end; - -function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec - ): Longint; -begin - result := LazFileUtils.FindFirstUTF8(Path,Attr,Rslt); -end; - -function FindNextUTF8(var Rslt: TSearchRec): Longint; -begin - result := LazFileUtils.FindNextUTF8(Rslt); -end; - -procedure FindCloseUTF8(var F: TSearchrec); -begin - LazFileUtils.FindCloseUTF8(F); -end; - -function UTF8CharacterLength(p: PChar): integer; -begin - result := LazUtf8.UTF8CharacterLength(p); -end; - -function UTF8Length(const s: string): PtrInt; -begin - result := LazUtf8.UTF8Length(s); -end; - -function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; -begin - result := LazUtf8.UTF8Length(p, ByteCount); -end; - -function UnicodeCharToUTF8(u: LongWord): string4; -begin - result := LazUtf8.UnicodeToUTF8(u); -end; - -function UTF8ToUTF16(const S: AnsiString): UnicodeString; -begin - result := LazUTf8.UTF8ToUTF16(s); -end; - -function UTF16ToUTF8(const S: UnicodeString): AnsiString; -begin - result := LazUTf8.UTF16ToUTF8(s); -end; - -{$ELSE} - -procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string); -var - uList: TStringListUTF8; -begin - if List is TStringListUTF8 then - begin - List.LoadFromFile(FileName); - exit; - end; - uList:=TStringListUTF8.Create; - try - uList.LoadFromFile(FileName); - List.Assign(uList); - finally - uList.Free; - end; -end; - -procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string); -var - uList: TStringListUTF8; -begin - if List is TStringListUTF8 then - begin - List.SaveToFile(FileName); - exit; - end; - uList:=TStringListUTF8.Create; - try - uList.Assign(List); - uList.SaveToFile(FileName); - finally - uList.Free; - end; -end; - -function UTF8LowerCase(const s: string): string; -begin - result := UTF8Encode(UnicodeLowerCase(UTF8Decode(s))); -end; - -function UTF8UpperCase(const s: string): string; -begin - result := UTF8Encode(UnicodeUpperCase(UTF8Decode(s))); -end; - -function UTF8CompareStr(const S1, S2: string): Integer; -begin - Result := SysUtils.CompareStr(S1, S2); -end; - -function UTF8CompareText(const S1, S2: string): Integer; -begin - Result := UnicodeCompareText(UTF8Decode(S1), UTF8Decode(S2)); -end; - -function FileOpenUTF8(const FileName: string; Mode: Integer): THandle; -begin - result := FileOpen(UTF8ToSys(FileName),Mode); -end; - -function FileCreateUTF8(const FileName: string): THandle; -begin - result := FileCreate(UTF8ToSys(FileName)); -end; - -function FileCreateUTF8(const FileName: string; Rights: LongWord): THandle; -begin - result := FileCreate(UTF8ToSys(FileName),Rights); -end; - -function FileExistsUTF8(const FileName: string): boolean; -begin - result := FileExists(UTF8ToSys(FileName)); -end; - -function DeleteFileUTF8(const FileName: string): boolean; -begin - result := DeleteFile(UTF8ToSys(FileName)); -end; - -function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec - ): Longint; -begin - result := FindFirst(UTF8ToSys(Path),Attr,Rslt); - Rslt.Name := SysToUTF8(Rslt.Name); -end; - -function FindNextUTF8(var Rslt: TSearchRec): Longint; -begin - result := FindNext(Rslt); - if result = 0 then - Rslt.Name := SysToUTF8(Rslt.Name); -end; - -procedure FindCloseUTF8(var F: TSearchrec); -begin - FindClose(F); -end; - -function UTF8ToSys(const s: string): string; -begin - result := Utf8ToAnsi(s); -end; - -function SysToUTF8(const s: string): string; -begin - result := AnsiToUtf8(s); -end; - -function UTF8CharacterLength(p: PChar): integer; -begin - if p<>nil then begin - if ord(p^)<%11000000 then begin - // regular single byte character (#0 is a character, this is pascal ;) - Result:=1; - end - else begin - // multi byte - if ((ord(p^) and %11100000) = %11000000) then begin - // could be 2 byte character - if (ord(p[1]) and %11000000) = %10000000 then - Result:=2 - else - Result:=1; - end - else if ((ord(p^) and %11110000) = %11100000) then begin - // could be 3 byte character - if ((ord(p[1]) and %11000000) = %10000000) - and ((ord(p[2]) and %11000000) = %10000000) then - Result:=3 - else - Result:=1; - end - else if ((ord(p^) and %11111000) = %11110000) then begin - // could be 4 byte character - if ((ord(p[1]) and %11000000) = %10000000) - and ((ord(p[2]) and %11000000) = %10000000) - and ((ord(p[3]) and %11000000) = %10000000) then - Result:=4 - else - Result:=1; - end - else - Result:=1; - end; - end else - Result:=0; -end; - -function UTF8Length(const s: string): PtrInt; -begin - Result:=UTF8Length(PChar(s),length(s)); -end; - -function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; -var - CharLen: LongInt; -begin - Result:=0; - while (ByteCount>0) do begin - inc(Result); - CharLen:=UTF8CharacterLength(p); - inc(p,CharLen); - dec(ByteCount,CharLen); - end; -end; - -function UnicodeToUTF8Inline(CodePoint: LongWord; Buf: PChar): integer; -begin - case CodePoint of - 0..$7f: - begin - Result:=1; - Buf[0]:=char(byte(CodePoint)); - end; - $80..$7ff: - begin - Result:=2; - Buf[0]:=char(byte($c0 or (CodePoint shr 6))); - Buf[1]:=char(byte($80 or (CodePoint and $3f))); - end; - $800..$ffff: - begin - Result:=3; - Buf[0]:=char(byte($e0 or (CodePoint shr 12))); - Buf[1]:=char(byte((CodePoint shr 6) and $3f) or $80); - Buf[2]:=char(byte(CodePoint and $3f) or $80); - end; - $10000..$10ffff: - begin - Result:=4; - Buf[0]:=char(byte($f0 or (CodePoint shr 18))); - Buf[1]:=char(byte((CodePoint shr 12) and $3f) or $80); - Buf[2]:=char(byte((CodePoint shr 6) and $3f) or $80); - Buf[3]:=char(byte(CodePoint and $3f) or $80); - end; - else - Result:=0; - end; -end; - -function UnicodeCharToUTF8(u: LongWord): string4; -begin - result[0] := chr(UnicodeToUTF8Inline(u,@result[1])); -end; - -constructor TFileStreamUTF8.Create(const AFileName: utf8string; Mode: Word); -var - lHandle: THandle; -begin - FFileName:= AFileName; - if Mode = fmcreate then - lHandle:= FileCreateUTF8(AFileName) - else - lHandle:= FileOpenUTF8(AFileName, Mode); - - If (THandle(lHandle)=feInvalidHandle) then - begin - if Mode = fmCreate then - raise EFCreateError.createfmt({SFCreateError}'Unable to create file "%s"', [AFileName]) - else - raise EFOpenError.Createfmt({SFOpenError}'Unable to open file "%s"', [AFilename]); - end - else - inherited Create(lHandle); -end; - -constructor TFileStreamUTF8.Create(const AFileName: utf8string; Mode: Word; Rights: LongWord); -var - lHandle: THandle; -begin - FFileName:=AFileName; - if Mode=fmcreate then - lHandle:=FileCreateUTF8(AFileName,Rights) - else - lHandle:=FileOpenUTF8(AFileName,Mode); - - if (THandle(lHandle)=feInvalidHandle) then - begin - if Mode=fmcreate then - raise EFCreateError.createfmt({SFCreateError}'Unable to create file "%s"',[AFileName]) - else - raise EFOpenError.Createfmt({SFOpenError}'Unable to open file "%s"',[AFilename]); - end - else - inherited Create(lHandle); -end; - -destructor TFileStreamUTF8.Destroy; -begin - FileClose(Handle); -end; - -function TStringListUTF8.DoCompareText(const s1, s2: string): PtrInt; -begin - if CaseSensitive then - Result:= UTF8CompareStr(s1,s2) - else - Result:= UTF8CompareText(s1,s2); -end; - -procedure TStringListUTF8.LoadFromFile(const FileName: string); -var - TheStream: TFileStreamUTF8; -begin - TheStream:= TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(TheStream); - finally - TheStream.Free; - end; -end; - -procedure TStringListUTF8.SaveToFile(const FileName: string); -var - TheStream: TFileStreamUTF8; -begin - TheStream:=TFileStreamUTF8.Create(FileName,fmCreate); - try - SaveToStream(TheStream); - finally - TheStream.Free; - end; -end; - -{copied from LazUTF8 - ------------------------------------------------------------------------------} -type - TConvertResult = (trNoError, trNullSrc, trNullDest, trDestExhausted, - trInvalidChar, trUnfinishedChar); - - TConvertOption = (toInvalidCharError, toInvalidCharToSymbol, - toUnfinishedCharError, toUnfinishedCharToSymbol); - TConvertOptions = set of TConvertOption; - -{ ------------------------------------------------------------------------------ - Name: ConvertUTF8ToUTF16 - Params: Dest - Pointer to destination string - DestWideCharCount - Wide char count allocated in destination string - Src - Pointer to source string - SrcCharCount - Char count allocated in source string - Options - Conversion options, if none is set, both - invalid and unfinished source chars are skipped - - toInvalidCharError - Stop on invalid source char and report - error - toInvalidCharToSymbol - Replace invalid source chars with '?' - toUnfinishedCharError - Stop on unfinished source char and - report error - toUnfinishedCharToSymbol - Replace unfinished source char with '?' - - ActualWideCharCount - Actual wide char count converted from source - string to destination string - Returns: - trNoError - The string was successfully converted without - any error - trNullSrc - Pointer to source string is nil - trNullDest - Pointer to destination string is nil - trDestExhausted - Destination buffer size is not big enough to hold - converted string - trInvalidChar - Invalid source char has occurred - trUnfinishedChar - Unfinished source char has occurred - - Converts the specified UTF-8 encoded string to UTF-16 encoded (system endian) - ------------------------------------------------------------------------------} -function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt; - Src: PChar; SrcCharCount: SizeUInt; Options: TConvertOptions; - out ActualWideCharCount: SizeUInt): TConvertResult; -var - DestI, SrcI: SizeUInt; - B1, B2, B3, B4: Byte; - W: Word; - C: LongWord; - - function UnfinishedCharError: Boolean; - begin - if toUnfinishedCharToSymbol in Options then - begin - Dest[DestI] := System.WideChar('?'); - Inc(DestI); - Result := False; - end - else - if toUnfinishedCharError in Options then - begin - ConvertUTF8ToUTF16 := trUnfinishedChar; - Result := True; - end - else Result := False; - end; - - function InvalidCharError(Count: SizeUInt): Boolean; inline; - begin - if not (toInvalidCharError in Options) then - begin - if toInvalidCharToSymbol in Options then - begin - Dest[DestI] := System.WideChar('?'); - Inc(DestI); - end; - - Dec(SrcI, Count); - - // skip trailing UTF-8 char bytes - while (Count > 0) do - begin - if (Byte(Src[SrcI]) and %11000000) <> %10000000 then Break; - Inc(SrcI); - Dec(Count); - end; - - Result := False; - end - else - if toInvalidCharError in Options then - begin - ConvertUTF8ToUTF16 := trUnfinishedChar; - Result := True; - end; - end; - -begin - ActualWideCharCount := 0; - - if not Assigned(Src) then - begin - Result := trNullSrc; - Exit; - end; - - if not Assigned(Dest) then - begin - Result := trNullDest; - Exit; - end; - SrcI := 0; - DestI := 0; - - while (DestI < DestWideCharCount) and (SrcI < SrcCharCount) do - begin - B1 := Byte(Src[SrcI]); - Inc(SrcI); - - if B1 < 128 then // single byte UTF-8 char - begin - Dest[DestI] := System.WideChar(B1); - Inc(DestI); - end - else - begin - if SrcI >= SrcCharCount then - if UnfinishedCharError then Exit(trInvalidChar) - else Break; - - B2 := Byte(Src[SrcI]); - Inc(SrcI); - - if (B1 and %11100000) = %11000000 then // double byte UTF-8 char - begin - if (B2 and %11000000) = %10000000 then - begin - Dest[DestI] := System.WideChar(((B1 and %00011111) shl 6) or (B2 and %00111111)); - Inc(DestI); - end - else // invalid character, assume single byte UTF-8 char - if InvalidCharError(1) then Exit(trInvalidChar); - end - else - begin - if SrcI >= SrcCharCount then - if UnfinishedCharError then Exit(trInvalidChar) - else Break; - - B3 := Byte(Src[SrcI]); - Inc(SrcI); - - if (B1 and %11110000) = %11100000 then // triple byte UTF-8 char - begin - if ((B2 and %11000000) = %10000000) and ((B3 and %11000000) = %10000000) then - begin - W := ((B1 and %00011111) shl 12) or ((B2 and %00111111) shl 6) or (B3 and %00111111); - if (W < $D800) or (W > $DFFF) then // to single wide char UTF-16 char - begin - Dest[DestI] := System.WideChar(W); - Inc(DestI); - end - else // invalid UTF-16 character, assume double byte UTF-8 char - if InvalidCharError(2) then Exit(trInvalidChar); - end - else // invalid character, assume double byte UTF-8 char - if InvalidCharError(2) then Exit(trInvalidChar); - end - else - begin - if SrcI >= SrcCharCount then - if UnfinishedCharError then Exit(trInvalidChar) - else Break; - - B4 := Byte(Src[SrcI]); - Inc(SrcI); - - if ((B1 and %11111000) = %11110000) and ((B2 and %11000000) = %10000000) - and ((B3 and %11000000) = %10000000) and ((B4 and %11000000) = %10000000) then - begin // 4 byte UTF-8 char - C := ((B1 and %00011111) shl 18) or ((B2 and %00111111) shl 12) - or ((B3 and %00111111) shl 6) or (B4 and %00111111); - // to double wide char UTF-16 char - Dest[DestI] := System.WideChar($D800 or ((C - $10000) shr 10)); - Inc(DestI); - if DestI >= DestWideCharCount then Break; - Dest[DestI] := System.WideChar($DC00 or ((C - $10000) and %0000001111111111)); - Inc(DestI); - end - else // invalid character, assume triple byte UTF-8 char - if InvalidCharError(3) then Exit(trInvalidChar); - end; - end; - end; - end; - - if DestI >= DestWideCharCount then - begin - DestI := DestWideCharCount - 1; - Result := trDestExhausted; - end - else - Result := trNoError; - - Dest[DestI] := #0; - ActualWideCharCount := DestI + 1; -end; - -function UTF8ToUTF16(const P: PChar; ByteCnt: SizeUInt): UnicodeString; -var - L: SizeUInt; -begin - if ByteCnt=0 then - exit(''); - SetLength(Result, ByteCnt); - // wide chars of UTF-16 <= bytes of UTF-8 string - if ConvertUTF8ToUTF16(PWideChar(Result), Length(Result) + 1, P, ByteCnt, - [toInvalidCharToSymbol], L) = trNoError - then SetLength(Result, L - 1) - else Result := ''; -end; - -{------------------------------------------------------------------------------ - Name: UTF8ToUTF16 - Params: S - Source UTF-8 string - Returns: UTF-16 encoded string - - Converts the specified UTF-8 encoded string to UTF-16 encoded (system endian) - Avoid copying the result string since on windows a widestring requires a full - copy - ------------------------------------------------------------------------------} -function UTF8ToUTF16(const S: AnsiString): UnicodeString; -begin - Result:=UTF8ToUTF16(PChar(S),length(S)); -end; - -{------------------------------------------------------------------------------ - Name: ConvertUTF16ToUTF8 - Params: Dest - Pointer to destination string - DestCharCount - Char count allocated in destination string - Src - Pointer to source string - SrcWideCharCount - Wide char count allocated in source string - Options - Conversion options, if none is set, both - invalid and unfinished source chars are skipped. - See ConvertUTF8ToUTF16 for details. - - ActualCharCount - Actual char count converted from source - string to destination string - Returns: See ConvertUTF8ToUTF16 - - Converts the specified UTF-16 encoded string (system endian) to UTF-8 encoded - ------------------------------------------------------------------------------} -function ConvertUTF16ToUTF8(Dest: PChar; DestCharCount: SizeUInt; - Src: PWideChar; SrcWideCharCount: SizeUInt; Options: TConvertOptions; - out ActualCharCount: SizeUInt): TConvertResult; -var - DestI, SrcI: SizeUInt; - W1, W2: Word; - C: LongWord; - - function UnfinishedCharError: Boolean; - begin - if toUnfinishedCharToSymbol in Options then - begin - Dest[DestI] := Char('?'); - Inc(DestI); - Result := False; - end - else - if toUnfinishedCharError in Options then - begin - ConvertUTF16ToUTF8 := trUnfinishedChar; - Result := True; - end - else Result := False; - end; - - function InvalidCharError(Count: SizeUInt): Boolean; inline; - begin - if not (toInvalidCharError in Options) then - begin - if toInvalidCharToSymbol in Options then - begin - Dest[DestI] := Char('?'); - Inc(DestI); - end; - - Dec(SrcI, Count); - // skip trailing UTF-16 wide char - if (Word(Src[SrcI]) and $FC00) = $DC00 then Inc(SrcI); - - Result := False; - end - else - if toInvalidCharError in Options then - begin - ConvertUTF16ToUTF8 := trUnfinishedChar; - Result := True; - end; - end; - -begin - ActualCharCount := 0; - - if not Assigned(Src) then - begin - Result := trNullSrc; - Exit; - end; - - if not Assigned(Dest) then - begin - Result := trNullDest; - Exit; - end; - SrcI := 0; - DestI := 0; - - while (DestI < DestCharCount) and (SrcI < SrcWideCharCount) do - begin - W1 := Word(Src[SrcI]); - Inc(SrcI); - - if (W1 < $D800) or (W1 > $DFFF) then // single wide char UTF-16 char - begin - if W1 < $0080 then // to single byte UTF-8 char - begin - Dest[DestI] := Char(W1); - Inc(DestI); - end - else - if W1 < $0800 then // to double byte UTF-8 char - begin - Dest[DestI] := Char(%11000000 or ((W1 and %11111000000) shr 6)); - Inc(DestI); - if DestI >= DestCharCount then Break; - Dest[DestI] := Char(%10000000 or (W1 and %111111)); - Inc(DestI); - end - else - begin // to triple byte UTF-8 char - Dest[DestI] := Char(%11100000 or ((W1 and %1111000000000000) shr 12)); - Inc(DestI); - if DestI >= DestCharCount then Break; - Dest[DestI] := Char(%10000000 or ((W1 and %111111000000) shr 6)); - Inc(DestI); - if DestI >= DestCharCount then Break; - Dest[DestI] := Char(%10000000 or (W1 and %111111)); - Inc(DestI); - end; - end - else - begin - if SrcI >= SrcWideCharCount then - if UnfinishedCharError then Exit(trInvalidChar) - else Break; - - W2 := Word(Src[SrcI]); - Inc(SrcI); - - if (W1 and $F800) = $D800 then // double wide char UTF-16 char - begin - if (W2 and $FC00) = $DC00 then - begin - C := (W1 - $D800) shl 10 + (W2 - $DC00) + $10000; - - // to 4 byte UTF-8 char - Dest[DestI] := Char(%11110000 or (C shr 18)); - Inc(DestI); - if DestI >= DestCharCount then Break; - Dest[DestI] := Char(%10000000 or ((C and $3F000) shr 12)); - Inc(DestI); - if DestI >= DestCharCount then Break; - Dest[DestI] := Char(%10000000 or ((C and %111111000000) shr 6)); - Inc(DestI); - if DestI >= DestCharCount then Break; - Dest[DestI] := Char(%10000000 or (C and %111111)); - Inc(DestI); - end - else // invalid character, assume single wide char UTF-16 char - if InvalidCharError(1) then Exit(trInvalidChar); - end - else // invalid character, assume single wide char UTF-16 char - if InvalidCharError(1) then Exit(trInvalidChar); - end; - end; - - if DestI >= DestCharCount then - begin - DestI := DestCharCount - 1; - Result := trDestExhausted; - end - else - Result := trNoError; - - Dest[DestI] := #0; - ActualCharCount := DestI + 1; -end; - -function UTF16ToUTF8(const P: PWideChar; WideCnt: SizeUInt): AnsiString; -var - L: SizeUInt; -begin - if WideCnt=0 then - exit(''); - - SetLength(Result, WideCnt * 3); - // bytes of UTF-8 <= 3 * wide chars of UTF-16 string - // e.g. %11100000 10100000 10000000 (UTF-8) is $0800 (UTF-16) - if ConvertUTF16ToUTF8(PChar(Result), Length(Result) + 1, P, WideCnt, - [toInvalidCharToSymbol], L) = trNoError then - begin - SetLength(Result, L - 1); - end else - Result := ''; -end; - -{------------------------------------------------------------------------------ - Name: UTF16ToUTF8 - Params: S - Source UTF-16 string (system endian) - Returns: UTF-8 encoded string - - Converts the specified UTF-16 encoded string (system endian) to UTF-8 encoded - ------------------------------------------------------------------------------} -function UTF16ToUTF8(const S: UnicodeString): AnsiString; -begin - Result := UTF16ToUTF8(PWideChar(S),length(S)); -end; - -{end of copy from LazUTF8 - ------------------------------------------------------------------------------} - -{$ENDIF} - -function UTF8ReverseString(const s: string): string; -var - pSrc,pDest,pEnd: PChar; - charLen: Integer; -begin - if s = '' then - begin - result := ''; - exit; - end; - setlength(result, length(s)); - pDest := @result[1] + length(result); - pSrc := @s[1]; - pEnd := pSrc+length(s); - while pSrc < pEnd do - begin - charLen := UTF8CharacterLength(pSrc); - if (charLen = 0) or (pSrc+charLen > pEnd) then break; - dec(pDest, charLen); - move(pSrc^, pDest^, charLen); - inc(pSrc, charLen); - end; -end; - -function UTF8CodepointToUnicode(p: PChar; ACodePointLen: integer): LongWord; -begin - case ACodePointLen of - 0: result := 0; - 1: result := ord(p^); - 2: result := ((ord(p^) and %00011111) shl 6) or (ord(p[1]) and %00111111); - 3: result := ((ord(p^) and %00011111) shl 12) or ((ord(p[1]) and %00111111) shl 6) - or (ord(p[2]) and %00111111); - 4: result := ((ord(p^) and %00001111) shl 18) or ((ord(p[1]) and %00111111) shl 12) - or ((ord(p[2]) and %00111111) shl 6) or (ord(p[3]) and %00111111); - else - raise exception.Create('Invalid code point length'); - end; -end; - -function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar; -var - CharLen: LongInt; -begin - Result:=UTF8Str; - if Result<>nil then begin - while (CharIndex>0) and (Len>0) do begin - CharLen:=UTF8CharacterLength(Result); - dec(Len,CharLen); - dec(CharIndex); - inc(Result,CharLen); - end; - if (CharIndex<>0) or (Len<0) then - Result:=nil; - end; -end; - -function GetBidiClassUTF8(P: PChar): TUnicodeBidiClass; -begin - result := GetUnicodeBidiClass(UTF8CodepointToUnicode(P, UTF8CharacterLength(p))); -end; - -function GetFirstStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; -var - p,pEnd: PChar; - charLen: Integer; - u: LongWord; - curBidi: TUnicodeBidiClass; - isolateNesting: integer; -begin - if sUTF8 = '' then exit(ubcUnknown); - p := @sUTF8[1]; - pEnd := p + length(sUTF8); - isolateNesting:= 0; - while p < pEnd do - begin - charLen := UTF8CharacterLength(p); - if (charLen = 0) or (p+charLen > pEnd) then break; - u := UTF8CodepointToUnicode(p, charLen); - case u of - UNICODE_POP_DIRECTIONAL_ISOLATE: if isolateNesting > 0 then dec(isolateNesting); - UNICODE_LEFT_TO_RIGHT_OVERRIDE: exit(ubcLeftToRight); - UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(ubcRightToLeft); - end; - curBidi := GetUnicodeBidiClass(u); - if isolateNesting = 0 then - begin - if curBidi in[ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then - exit(curBidi); - end; - case u of - UNICODE_FIRST_STRONG_ISOLATE, UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE: inc(isolateNesting); - end; - if curBidi = ubcParagraphSeparator then isolateNesting:= 0; - inc(p,charLen); - end; - exit(ubcUnknown); -end; - -function GetLastStrongBidiClassUTF8(const sUTF8: string): TUnicodeBidiClass; -var - p,pEnd: PChar; - charLen: Integer; - u: LongWord; - curBidi: TUnicodeBidiClass; - isolateNesting: integer; -begin - if sUTF8 = '' then exit(ubcUnknown); - p := @sUTF8[1]; - pEnd := p + length(sUTF8); - isolateNesting:= 0; - result := ubcUnknown; - while p < pEnd do - begin - charLen := UTF8CharacterLength(p); - if (charLen = 0) or (p+charLen > pEnd) then break; - u := UTF8CodepointToUnicode(p, charLen); - case u of - UNICODE_POP_DIRECTIONAL_ISOLATE: if isolateNesting > 0 then dec(isolateNesting); - end; - curBidi := GetUnicodeBidiClass(u); - if isolateNesting = 0 then - begin - if curBidi in[ubcLeftToRight,ubcRightToLeft,ubcArabicLetter] then - result := curBidi; - end; - case u of - UNICODE_FIRST_STRONG_ISOLATE, UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE: inc(isolateNesting); - end; - if curBidi = ubcParagraphSeparator then isolateNesting:= 0; - inc(p,charLen); - end; -end; - -function IsRightToLeftUTF8(const sUTF8: string): boolean; -begin - result := GetFirstStrongBidiClassUTF8(sUTF8) in[ubcRightToLeft,ubcArabicLetter]; -end; - -function IsZeroWidthUTF8(const sUTF8: string): boolean; -var - p,pEnd: PChar; - charLen: Integer; - u: LongWord; -begin - if sUTF8 = '' then exit(true); - p := @sUTF8[1]; - pEnd := p + length(sUTF8); - while p < pEnd do - begin - charLen := UTF8CharacterLength(p); - if (charLen = 0) or (p+charLen > pEnd) then break; - u := UTF8CodepointToUnicode(p, charLen); - if not IsZeroWidthUnicode(u) then exit(false); - inc(p,charLen); - end; - exit(true); -end; - -function AddParagraphBidiUTF8(s: string; ARightToLeft: boolean): string; -var - i,curParaStart: Integer; - - procedure CheckParagraph; - var - para,newPara: string; - paraRTL: boolean; - begin - if i > curParaStart then - begin - para := copy(s,curParaStart,i-curParaStart); - paraRTL := GetFirstStrongBidiClassUTF8(para) in[ubcRightToLeft,ubcArabicLetter]; - //detected paragraph does not match overall RTL option - if paraRTL <> ARightToLeft then - begin - if not paraRTL then - newPara := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK)+para+UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_MARK) - else - newPara := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK)+para+UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_MARK); - inc(i, length(newPara)-length(para)); - delete(s, curParaStart, length(para)); - insert(newPara, s, curParaStart); - end; - end; - end; - -var - charLen: integer; - u: LongWord; - -begin - i := 1; - curParaStart := 1; - while i <= length(s) do - begin - charLen := UTF8CharacterLength(@s[i]); - u := UTF8CodepointToUnicode(@s[i], charLen); - if IsUnicodeParagraphSeparator(u) then - begin - CheckParagraph; - //skip end of line - inc(i); - //skip second CRLF - if ((u = 10) or (u = 13)) and (i <= length(s)) and (s[i] in[#13,#10]) and (s[i]<>s[i-1]) then inc(i); - curParaStart := i; - end else - inc(i); - end; - CheckParagraph; - result := s; -end; - -procedure UTF8ToUnicodeArray(const sUTF8: string; out u: TUnicodeArray; out ofs: TIntegerArray); -var - index,len,charLen: integer; - p,pStart,pEnd: PChar; -begin - if sUTF8 = '' then - begin - u := nil; - ofs := nil; - end - else - begin - pStart := @sUTF8[1]; - pEnd := pStart + length(sUTF8); - p := pStart; - len := 0; - while p < pEnd do - begin - charLen := UTF8CharacterLength(p); - inc(len); - inc(p,charLen); - end; - - setlength(u, len); - setlength(ofs, len); - p := pStart; - index := 0; - while p < pEnd do - begin - charLen := UTF8CharacterLength(p); - u[index] := UTF8CodepointToUnicode(p, charLen); - ofs[index] := p - pStart; - inc(index); - inc(p,charLen); - end; - end; -end; - -function AnalyzeBidiUTF8(const sUTF8: string; ABidiMode: TFontBidiMode): TBidiUTF8Array; -var - u: TUnicodeArray; - ofs: TIntegerArray; - a: TUnicodeBidiArray; - i: Integer; -begin - if sUTF8 = '' then - result := nil - else - begin - UTF8ToUnicodeArray(sUTF8, u, ofs); - a := AnalyzeBidiUnicode(@u[0], length(u), ABidiMode); - setlength(result, length(u)); - for i := 0 to high(result) do - begin - result[i].Offset:= ofs[i]; - result[i].BidiInfo := a[i]; - end; - end; -end; - -function AnalyzeBidiUTF8(const sUTF8: string; ARightToLeft: boolean): TBidiUTF8Array; -begin - if ARightToLeft then - result := AnalyzeBidiUTF8(sUTF8, fbmRightToLeft) - else result := AnalyzeBidiUTF8(sUTF8, fbmLeftToRight); -end; - -function AnalyzeBidiUTF8(const sUTF8: string): TBidiUTF8Array; -begin - result := AnalyzeBidiUTF8(sUTF8, fbmAuto) -end; - -function GetUTF8DisplayOrder(const ABidi: TBidiUTF8Array): TUnicodeDisplayOrder; -begin - if length(ABidi) = 0 then - result := nil - else - result := GetUnicodeDisplayOrder(@ABidi[0].BidiInfo, sizeof(TBidiUTF8Info), length(ABidi)); -end; - -function ContainsBidiIsolateOrFormattingUTF8(const sUTF8: string): boolean; -var - p,pEnd: PChar; - charLen: Integer; - u: LongWord; -begin - if sUTF8 = '' then exit(false); - p := @sUTF8[1]; - pEnd := p + length(sUTF8); - while p < pEnd do - begin - charLen := UTF8CharacterLength(p); - if (charLen = 0) or (p+charLen > pEnd) then break; - u := UTF8CodepointToUnicode(p, charLen); - case u of - UNICODE_LEFT_TO_RIGHT_ISOLATE, UNICODE_RIGHT_TO_LEFT_ISOLATE, UNICODE_FIRST_STRONG_ISOLATE, - UNICODE_LEFT_TO_RIGHT_EMBEDDING, UNICODE_RIGHT_TO_LEFT_EMBEDDING, - UNICODE_LEFT_TO_RIGHT_OVERRIDE, UNICODE_RIGHT_TO_LEFT_OVERRIDE: exit(true); - end; - inc(p,charLen); - end; - exit(false); -end; - -function UTF8OverrideDirection(const sUTF8: string; ARightToLeft: boolean): string; -begin - if ARightToLeft then - result := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_OVERRIDE) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING) - else - result := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_OVERRIDE) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING); -end; - -function UTF8EmbedDirection(const sUTF8: string; ARightToLeft: boolean): string; -begin - if ARightToLeft then - result := UnicodeCharToUTF8(UNICODE_RIGHT_TO_LEFT_EMBEDDING) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING) - else - result := UnicodeCharToUTF8(UNICODE_LEFT_TO_RIGHT_EMBEDDING) + sUTF8 + UnicodeCharToUTF8(UNICODE_POP_DIRECTIONAL_FORMATTING); -end; - -function UTF8Ligature(const sUTF8: string; ARightToLeft: boolean; - ALigatureLeft, ALigatureRight: boolean): string; -begin - result := sUTF8; - if (ALigatureRight and ARightToLeft) or - (ALigatureLeft and not ARightToLeft) then - result := UTF8_ZERO_WIDTH_JOINER + result; - if (ALigatureLeft and ARightToLeft) or - (ALigatureRight and not ARightToLeft) then - result := result + UTF8_ZERO_WIDTH_JOINER; -end; - -//little endian stream functions -function LEReadInt64(Stream: TStream): int64; -begin - Result := 0; - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -procedure LEWriteInt64(Stream: TStream; AValue: int64); -begin - AValue := NtoLE(AValue); - stream.Write(AValue, sizeof(AValue)); -end; - -function LEReadLongint(Stream: TStream): longint; -begin - Result := 0; - stream.Read(Result, sizeof(Result)); - Result := LEtoN(Result); -end; - -procedure LEWriteLongint(Stream: TStream; AValue: LongInt); -begin - AValue := NtoLE(AValue); - stream.Write(AValue, sizeof(AValue)); -end; - -function LEReadByte(Stream: TStream): byte; -begin - Result := 0; - stream.Read(Result, sizeof(Result)); -end; - -procedure LEWriteByte(Stream: TStream; AValue: Byte); -begin - stream.Write(AValue, sizeof(AValue)); -end; - -function LEReadSingle(Stream: TStream): single; -var - ResultAsDWord : LongWord absolute result; -begin - ResultAsDWord := 0; - stream.Read(ResultAsDWord, sizeof(Result)); - ResultAsDWord := LEtoN(ResultAsDWord); -end; - -procedure LEWriteSingle(Stream: TStream; AValue: single); -var - ValueAsDWord : LongWord absolute AValue; -begin - ValueAsDWord := NtoLE(ValueAsDWord); - stream.Write(ValueAsDWord, sizeof(AValue)); -end; - -{ TGlyphUtf8 } - -function TGlyphUtf8.GetEmpty: boolean; -begin - result := GlyphUtf8 = ''; -end; - -{ TGlyphCursorUtf8 } - -class function TGlyphCursorUtf8.New(const textUTF8: string; ABidiMode: TFontBidiMode): TGlyphCursorUtf8; -begin - result.sUTF8 := textUTF8; - result.bidiArray := AnalyzeBidiUTF8(result.sUTF8, ABidiMode); - result.displayOrder := GetUTF8DisplayOrder(result.bidiArray); - result.Rewind; -end; - -function TGlyphCursorUtf8.GetNextGlyph: TGlyphUtf8; -var - rtlScript, ligatureLeft, ligatureRight: Boolean; - u: LongWord; - bracketInfo: TUnicodeBracketInfo; -begin - if EndOfString then - begin - result.GlyphUtf8:= ''; - result.RightToLeft:= false; - result.Mirrored:= false; - result.MirroredGlyphUtf8:= ''; - exit; - end; - PeekMultichar; - NextMultichar; - result.GlyphUtf8 := currentChar; - result.RightToLeft := currentBidiInfo.IsRightToLeft; - result.Mirrored := currentBidiInfo.IsMirrored; - result.MirroredGlyphUtf8:= ''; - result.ByteOffset := currentOffset; - result.ByteSize := length(currentChar); - result.Merged:= false; - if result.Mirrored then - begin - u := UTF8CodepointToUnicode(pchar(currentChar), - min(UTF8CharacterLength(pchar(currentChar)), length(currentChar))); - bracketInfo := GetUnicodeBracketInfo(u); - if bracketInfo.OpeningBracket = u then - result.MirroredGlyphUtf8 := UnicodeCharToUTF8(bracketInfo.ClosingBracket) - else if bracketInfo.ClosingBracket = u then - result.MirroredGlyphUtf8 := UnicodeCharToUTF8(bracketInfo.OpeningBracket); - end else - begin - rtlScript := currentBidiInfo.IsRightToLeftScript; - ligatureRight := currentBidiInfo.HasLigatureRight; - ligatureLeft := currentBidiInfo.HasLigatureLeft; - if (currentChar.StartsWith(UTF8_ARABIC_ALEPH) or - currentChar.StartsWith(UTF8_ARABIC_ALEPH_HAMZA_BELOW) or - currentChar.StartsWith(UTF8_ARABIC_ALEPH_HAMZA_ABOVE) or - currentChar.StartsWith(UTF8_ARABIC_ALEPH_MADDA_ABOVE)) and - not EndOfString then - begin - PeekMultichar; - if currentChar.StartsWith(UTF8_ARABIC_LAM) then - begin - result.GlyphUtf8 := currentChar + result.GlyphUtf8; - result.ByteOffset:= Min(result.ByteOffset, currentOffset); - inc(result.ByteSize, length(currentChar)); - result.Merged := true; - ligatureRight := currentBidiInfo.HasLigatureRight; - NextMultichar; - end; - end; - result.GlyphUtf8 := UTF8Ligature(result.GlyphUtf8, rtlScript, ligatureLeft, ligatureRight); - end; -end; - -procedure TGlyphCursorUtf8.Rewind; -begin - displayIndex := 0; - while (displayIndex < length(displayOrder)) - and not bidiArray[displayOrder[displayIndex]].BidiInfo.IsMulticharStart do - inc(displayIndex); -end; - -procedure TGlyphCursorUtf8.NextMultichar; -begin - inc(displayIndex); - while (displayIndex < length(displayOrder)) - and not bidiArray[displayOrder[displayIndex]].BidiInfo.IsMulticharStart do - inc(displayIndex); -end; - -procedure TGlyphCursorUtf8.PeekMultichar; -var - startIndex, nextIndex, charLen, startOffset: Integer; -begin - startIndex := displayOrder[displayIndex]; - startOffset := bidiArray[startIndex].Offset; - currentBidiInfo := bidiArray[startIndex].BidiInfo; - nextIndex := startIndex+1; - while (nextIndex < length(bidiArray)) - and not bidiArray[nextIndex].BidiInfo.IsMulticharStart do - inc(nextIndex); - if nextIndex >= length(bidiArray) then - charLen := length(sUTF8) - startOffset - else - charLen := bidiArray[nextIndex].Offset - startOffset; - setlength(currentChar, charLen); - if charLen > 0 then move(sUTF8[startOffset+1], currentChar[1], charLen); - currentOffset := startOffset; -end; - -function TGlyphCursorUtf8.EndOfString: boolean; -begin - result := displayIndex >= length(displayOrder); -end; - -end. - diff --git a/components/bgrabitmap/bgravectorize.pas b/components/bgrabitmap/bgravectorize.pas deleted file mode 100644 index 300d5d2..0000000 --- a/components/bgrabitmap/bgravectorize.pas +++ /dev/null @@ -1,2405 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAVectorize; - -{$mode objfpc}{$H+} - -interface - -{ - Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType - - This unit provides vectorizers : - - VectorizeMonochrome function vectorizes a back'n'white image - - TBGRAVectorizedFont allows to vectorize and to load vectorized font and draw them - - TBGRAVectorizedFontRenderer class works like other font renderers, i.e., it can - be assigned to the FontRenderer property. You can use it in two different modes : - - if you supply a directory, it will look for *.glyphs files in it to load fonts - - if you don't supply a directory, fonts will be vectorized from LCL - - Note that unless you want to supply your own glyphs files, you don't need - to use explicitely this renderer, because TBGRATextEffectFontRenderer will - make use of it if necessary, according to effects parameters used. -} - -uses - BGRAClasses, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATypewriter, - BGRATransform, BGRACanvas2D, BGRAText; - -//vectorize a monochrome bitmap -function VectorizeMonochrome(ASource: TBGRACustomBitmap; AZoom: single; APixelCenteredCoordinates: boolean; - AWhiteBackground: boolean = true; ADiagonalFillPercent: single = 66; AIntermediateDiagonals: boolean = true): ArrayOfTPointF; -function VectorizeMonochrome(ASource: TBGRACustomBitmap; ARect: TRect; AZoom: single; APixelCenteredCoordinates: boolean; - AWhiteBackground: boolean = true; ADiagonalFillPercent: single = 66; AIntermediateDiagonals: boolean = true): ArrayOfTPointF; - -type - TBGRAVectorizedFont = class; - - //this is the class to assign to FontRenderer property of TBGRABitmap - { TBGRAVectorizedFontRenderer } - - TBGRAVectorizedFontRenderer = class(TBGRACustomFontRenderer) - protected - FVectorizedFontArray: array of record - FontName: string; - FontStyle: TFontStyles; - VectorizedFont: TBGRAVectorizedFont; - end; - FVectorizedFont: TBGRAVectorizedFont; - FCanvas2D: TBGRACanvas2D; - FDirectoryUTF8: string; - function OutlineActuallyVisible: boolean; - procedure UpdateFont; - function GetCanvas2D(ASurface: TBGRACustomBitmap): TBGRACanvas2D; - procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; texture: IBGRAScanner); - procedure InternalCopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment; ABidiMode: TFontBidiMode); - procedure InternalTextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; ABidiMode: TFontBidiMode); - procedure Init; - public - MinFontResolution, MaxFontResolution: integer; - QuadraticCurves: boolean; - - OutlineVisible: boolean; - OutlineWidth: single; - OutlineColor: TBGRAPixel; - OutlineTexture: IBGRAScanner; - OuterOutlineOnly: boolean; - OutlineJoin: TPenJoinStyle; - - ShadowVisible: boolean; - ShadowColor: TBGRAPixel; - ShadowRadius: integer; - ShadowOffset: TPoint; - - constructor Create; overload; - constructor Create(ADirectoryUTF8: string); overload; - function GetFontPixelMetric: TFontPixelMetric; override; - function GetFontPixelMetricF: TFontPixelMetricF; override; - function FontExists(AName: string): boolean; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); overload; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; - procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); overload; override; - procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override; - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); overload; override; - procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); overload; override; - procedure CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment); override; - procedure CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment; ARightToLeft: boolean); override; - function HandlesTextPath: boolean; override; - function TextSize(sUTF8: string): TSize; overload; override; - function TextSizeF(sUTF8: string): TPointF; overload; override; - function TextSize(sUTF8: string; AMaxWidth: integer; {%H-}ARightToLeft: boolean): TSize; overload; override; - function TextSizeF(sUTF8: string; AMaxWidthF: single; {%H-}ARightToLeft: boolean): TPointF; overload; override; - function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override; - function TextFitInfoF(sUTF8: string; AMaxWidthF: single): integer; override; - destructor Destroy; override; - end; - - TGlyphSizes = array of record - Text, Glyph: String; - Width,Height: single; - end; - TGlyphSizesCallbackData = record - Sizes: TGlyphSizes; - Count: integer; - end; - - TBGRAVectorizedFontHeader = record - Name: string; - Style: TFontStyles; - EmHeightRatio: single; - Resolution: integer; - PixelMetric: TFontPixelMetric; - end; - TBGRAGlyphsInfo = record - Name: string; - Style: TFontStyles; - NbGlyphs: integer; - end; - - { TBGRAVectorizedFont } - - TBGRAVectorizedFont = class(TBGRACustomTypeWriter) - private - FName : string; - FStyle: TFontStyles; - FResolution: integer; - FFont: TFont; - FBuffer: TBGRACustomBitmap; - FFullHeight: single; - FFontMatrix: TAffineMatrix; - FOrientation: single; - FQuadraticCurves: boolean; - FItalicSlope: single; - FWordBreakHandler: TWordBreakHandler; - FDirectory: string; - FDirectoryContent: array of record - Filename: string; - FontName: string; - FontStyle: TFontStyles; - end; - FFontEmHeightRatioComputed: boolean; - FFontEmHeightRatio: single; - FFontPixelMetric: TFontPixelMetric; - FFontPixelMetricComputed: boolean; - FFontFound: boolean; - function GetEmHeight: single; - function GetFontPixelMetric: TFontPixelMetric; - function GetLCLHeight: single; - function GetVectorizeLCL: boolean; - procedure SetEmHeight(AValue: single); - procedure SetItalicSlope(AValue: single); - procedure SetLCLHeight(AValue: single); - procedure SetOrientation(AValue: single); - procedure SetQuadraticCurves(AValue: boolean); - procedure SetResolution(AValue: integer); - procedure SetFontMatrix(AValue: TAffineMatrix); - procedure SetFullHeight(AValue: single); - procedure SetName(AValue: string); - procedure SetStyle(AValue: TFontStyles); - function GetFontEmHeightRatio: single; - procedure SetVectorizeLCL(AValue: boolean); - procedure GlyphCallbackForGlyphSizes(ATextUTF8: string; AGlyph: TBGRAGlyph; - {%H-}AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); - procedure UpdateQuadraticCallback({%H-}ATextUTF8: string; AGlyph: TBGRAGlyph; - {%H-}AFlags: TBrowseGlyphCallbackFlags; {%H-}AData: Pointer; out AContinue: boolean); - protected - procedure UpdateFont; - procedure UpdateMatrix; - function GetGlyph(AIdentifier: string): TBGRAGlyph; override; - procedure DefaultWordBreakHandler(var ABefore, AAfter: string); - procedure Init(AVectorize: boolean); - function CustomHeaderSize: integer; override; - procedure WriteCustomHeader(AStream: TStream); override; - procedure ReadAdditionalHeader(AStream: TStream); override; - function ReadVectorizedFontHeader(AStream: TStream): TBGRAVectorizedFontHeader; - function HeaderName: string; override; - procedure SetDirectory(const AValue: string); - function ComputeKerning(AIdLeft, AIdRight: string): single; override; - public - UnderlineDecoration,StrikeOutDecoration: boolean; - constructor Create; overload; - constructor Create(AVectorizeLCL: boolean); overload; - destructor Destroy; override; - function GetGlyphSize(AIdentifier:string): TPointF; - function GetTextGlyphSizes(ATextUTF8:string): TGlyphSizes; - function GetTextSize(ATextUTF8:string): TPointF; - function TextFitInfo(ATextUTF8: string; AMaxWidth: single): integer; - procedure SplitText(var ATextUTF8: string; AMaxWidth: single; out ARemainsUTF8: string); - procedure DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft); override; - procedure CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X, Y: Single; - AAlign: TBGRATypeWriterAlignment=twaTopLeft); override; - procedure DrawTextWordBreak(ADest: TBGRACanvas2D; ATextUTF8: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft); - procedure DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft); overload; - procedure DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft); overload; - function GetTextWordBreakGlyphBoxes(ATextUTF8: string; X,Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes; - function GetTextRectGlyphBoxes(ATextUTF8: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes; overload; - function GetTextRectGlyphBoxes(ATextUTF8: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes; overload; - procedure UpdateDirectory; - function LoadGlyphsInfo(AFilenameUTF8: string): TBGRAGlyphsInfo; - - property Resolution: integer read FResolution write SetResolution; - property Style: TFontStyles read FStyle write SetStyle; - property Name: string read FName write SetName; - property LCLHeight: single read GetLCLHeight write SetLCLHeight; - property EmHeight: single read GetEmHeight write SetEmHeight; - property FullHeight: single read FFullHeight write SetFullHeight; - property FontMatrix: TAffineMatrix read FFontMatrix write SetFontMatrix; - property Orientation: single read FOrientation write SetOrientation; - property QuadraticCurves: boolean read FQuadraticCurves write SetQuadraticCurves; - property ItalicSlope: single read FItalicSlope write SetItalicSlope; - property OnWordBreak: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler; - property Directory: string read FDirectory write SetDirectory; - property FontEmHeightRatio: single read GetFontEmHeightRatio; - property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric; - property FontFound: boolean read FFontFound; - property VectorizeLCL: boolean read GetVectorizeLCL write SetVectorizeLCL; - end; - -implementation - -uses BGRAUTF8{$IFDEF LCL}, Forms{$ENDIF}; - -function VectorizeMonochrome(ASource: TBGRACustomBitmap; ARect: TRect; AZoom: single; APixelCenteredCoordinates: boolean; - AWhiteBackground: boolean; ADiagonalFillPercent: single; AIntermediateDiagonals: boolean): ArrayOfTPointF; -const unitShift = 6; - iHalf = 1 shl (unitShift-1); - iUnit = 1 shl unitShift; -var - iDiag,iOut: integer; - n: integer; - factor: single; - offset: single; - p,pprev,pnext : PBGRAPixel; - x,y,ix,iy: integer; - points: array of record - coord: tpoint; - prev,next: integer; - drawn,{shouldRemove,}removed,done: boolean; - end; - nbPoints:integer; - PointsPreviousLineStart,PointsCurrentLineStart: integer; - cur: packed array[1..9] of boolean; - ortho: array of array of boolean; - - polygonF: array of TPointF; - - function CheckPixel(const APixel: TBGRAPixel): boolean; inline; - begin - result := (APixel.green <= 128) xor not AWhiteBackground; - end; - - function AddPoint(x,y,APrev,ANext: integer): integer; - begin - if nbpoints = length(points) then - setlength(points, nbpoints*2+1); - result := nbpoints; - with points[result] do - begin - coord := point(x,y); - prev := APrev; - next := ANext; - drawn := false; - removed := false; -// shouldRemove := false; - end; - inc(nbpoints); - end; - - function InsertPoint(x,y,APrev,ANext: integer): integer; - begin - if nbpoints = length(points) then - setlength(points, nbpoints*2+1); - result := nbpoints; - with points[result] do - begin - coord := point(x,y); - prev := APrev; - next := ANext; - drawn := false; - removed := false; -// shouldRemove := false; - end; - if APrev<>-1 then points[APrev].next := result; - if ANext<>-1 then points[ANext].prev := result; - inc(nbpoints); - end; - - procedure RemovePoint(idx: integer); - begin - points[idx].removed:= true; - if points[idx].prev <> -1 then points[points[idx].prev].next := points[idx].next; - if points[idx].next <> -1 then points[points[idx].next].prev := points[idx].prev; - end; - - procedure AddLine(x1,y1,x2,y2: integer); overload; - var i,j,k: integer; - begin - for i := PointsPreviousLineStart to nbpoints-1 do - if (points[i].coord.x = x2) and (points[i].coord.y = y2) and (points[i].prev = -1) then - begin - for j := i+1 to nbpoints-1 do - if (points[j].coord.x = x1) and (points[j].coord.y = y1) and (points[j].next = -1) then - begin - points[j].next := i; - points[i].prev := j; - exit; - end; - k := addpoint(x1,y1,-1,i); - points[i].prev := k; - exit; - end else - if (points[i].coord.x = x1) and (points[i].coord.y = y1) and (points[i].next = -1) then - begin - for j := i+1 to nbpoints-1 do - if (points[j].coord.x = x2) and (points[j].coord.y = y2) and (points[j].prev = -1) then - begin - points[j].prev := i; - points[i].next := j; - exit; - end; - k := addpoint(x2,y2,i,-1); - points[i].next := k; - exit; - end; - k := addpoint(x1,y1,-1,-1); - points[k].next := addpoint(x2,y2,k,-1); - end; - procedure AddLine(x1,y1,x2,y2,x3,y3: integer); overload; - begin - AddLine(x1,y1,x2,y2); - AddLine(x2,y2,x3,y3); - end; - procedure AddLine(x1,y1,x2,y2,x3,y3,x4,y4: integer); overload; - begin - AddLine(x1,y1,x2,y2); - AddLine(x2,y2,x3,y3); - AddLine(x3,y3,x4,y4); - end; - procedure AddLine(x1,y1,x2,y2,x3,y3,x4,y4,x5,y5: integer); overload; - begin - AddLine(x1,y1,x2,y2); - AddLine(x2,y2,x3,y3); - AddLine(x3,y3,x4,y4); - AddLine(x4,y4,x5,y5); - end; - - procedure AddPolygon(nStart: integer); - - procedure Rewind(out cycle: boolean); - var cur: integer; - begin - cur := nStart; - cycle := false; - while (points[cur].prev <> -1) do - begin - cur := points[cur].prev; - if cur = nStart then - begin - cycle := true; //identify cycle - break; - end; - end; - nStart := cur; - end; - - function aligned(start1,end1,start2,end2: integer): boolean; - var - u,v: TPointF; - lu,lv: single; - begin - if (start1=-1) or (end1=-1) or (start2=-1) or (end2=-1) then - begin - result :=false; - exit; - end; - u := pointF(points[end1].coord.x - points[start1].coord.x, points[end1].coord.y - points[start1].coord.y); - lu := sqrt(u*u); - if lu <> 0 then u.Scale(1/lu); - v := pointF(points[end2].coord.x - points[start2].coord.x, points[end2].coord.y - points[start2].coord.y); - lv := sqrt(v*v); - if lv <> 0 then v.Scale(1/lv); - - result := u*v > 0.999; - end; - - function angle45(prev,cur,next: integer): boolean; - var - u,v: TPointF; - lu,lv,dp: single; - begin - if (prev=-1) or (cur=-1) or (next=-1) then - begin - result :=false; - exit; - end; - u := pointF(points[next].coord.x - points[cur].coord.x, points[next].coord.y - points[cur].coord.y); - lu := sqrt(u*u); - if lu <> 0 then u.Scale(1/lu); - v := pointF(points[cur].coord.x - points[prev].coord.x, points[cur].coord.y - points[prev].coord.y); - lv := sqrt(v*v); - if lv <> 0 then v.Scale(1/lv); - - dp := u*v; - result := (dp > 0.70) and (dp < 0.72); - end; - - procedure RemoveAligned; - var cur,prev,next: integer; - begin - cur := nStart; - prev := -1; - while not points[cur].removed do - begin - next := points[cur].next; - //remove aligned points - if (prev <> -1) and aligned(prev,cur,cur,next) then - RemovePoint(cur) - else - prev := cur; - cur := next; - - if next = nStart then - begin - next := points[cur].next; - if (prev <> -1) and (next <> prev) then - if aligned(prev,cur,cur,next) then - begin - RemovePoint(cur); - nStart := next; - end; - break; //cycle - end; - end; - end; - - procedure MakePolygon(cycle: boolean); - var ptsF: array of TPointF; - nbPtsF: integer; - nb,nb2,cur,i: integer; - begin - cur := nStart; - nb := 0; - nb2 := 0; - repeat - if not points[cur].removed then inc(nb); - inc(nb2); - cur := points[cur].next; - until (cur = -1) or (cur = nStart) or (nb2 > nbPoints); - if (nb2 > nbPoints) or (nb <= 2) then exit; - - setlength(ptsF,nb); - cur := nStart; - nbPtsF := 0; - repeat - with points[cur] do - if not removed then - begin - ptsF[nbPtsF] := pointf(coord.x*factor+offset,coord.y*factor+offset); - points[cur].drawn := true; - inc(nbPtsF); - end; - cur := points[cur].next; - until (cur = -1) or (cur = nStart); - - if cycle then - begin - if polygonF = nil then - polygonF := ptsF else - begin - cur := length(polygonF); - setlength(polygonF, length(polygonF)+length(ptsF)+1); - polygonF[cur] := EmptyPointF; - for i := 0 to high(ptsF) do - begin - inc(cur); - polygonF[cur] := ptsF[i]; - end; - end; - end; - ptsF := nil; - //Bitmap.DrawPolyLineAntialias(ptsF,BGRABlack,1); - end; - - function segabslength(cur,next: integer): integer; - var - tx,ty: integer; - begin - if (cur = -1) or (next = -1) then result := 0 - else - begin - tx := abs(points[next].coord.x - points[cur].coord.x); - ty := abs(points[next].coord.y - points[cur].coord.y); - if tx > ty then result := tx else result := ty; - end; - end; - - function getnext(cur: integer): integer; - begin - result := cur; - if result <> -1 then - begin - repeat - result := points[result].next; - if result = cur then result := -1; - until (result = -1) or not points[result].removed; - end; - end; - - function getprev(cur: integer): integer; - begin - result := cur; - if result <> -1 then - begin - repeat - result := points[result].prev; - if result = cur then result := -1; - until (result = -1) or not points[result].removed; - end; - end; - - procedure NiceLines; - var cur2, next,next2, startIdx, endIdx: integer; - nb: integer; - u: TPoint; - - function SameDirection(p1,p2: integer): boolean; - var - v: TPoint; - begin - v := Point(points[p2].coord.x-points[p1].coord.x, - points[p2].coord.y-points[p1].coord.y); - result := (v.x*u.y - v.y*u.x = 0) and (v.x*u.x + v.y*u.y > 0); - end; - - function GetSide(p1,p2: integer): integer; - var - v: TPoint; - begin - v := Point(points[p2].coord.x-points[p1].coord.x, - points[p2].coord.y-points[p1].coord.y); - result := v.x*u.y - v.y*u.x; - if result < 0 then result := -1 else if result > 0 then result := 1; - end; - - procedure DoNiceLines(DoDiag: boolean); - var cur, nbSegs, i: integer; - isDiag: Boolean; - segs: array of record - p1,p2: TPoint; - abslen: integer; - end; - - begin - for cur := 0 to nb-1 do - if not points[cur].removed and not points[cur].done then - begin - next := getnext(cur); - isDiag := (points[next].coord.x <> points[cur].coord.x) and - (points[next].coord.y <> points[cur].coord.y); - if (segabslength(cur,next) > iUnit) and (DoDiag xor (not isDiag)) then - begin - startIdx := cur; - endIdx := next; - u := Point(points[next].coord.x-points[cur].coord.x, - points[next].coord.y-points[cur].coord.y); - nbsegs := 1; - - if (u.x <> 0) or (u.y <> 0) then - begin - repeat - next := getnext(endIdx); - next2 := getnext(next); - if (next<>startIdx) and (next2<>startIdx) and angle45(getprev(endIdx),endIdx,next) and - (segabslength(endIdx,next) < 2*iUnit) and SameDirection(next,next2) then - begin - endIdx := next2; - inc(nbsegs); - end - else - break; - until false; - - repeat - next := getprev(startIdx); - next2 := getprev(next); - if (next<>endIdx) and (next2<>endIdx) and angle45(getnext(startIdx),startIdx,next) and - (segabslength(startIdx,next) < 2*iUnit) and SameDirection(next2,next) then - begin - startIdx := next2; - inc(nbsegs); - end - else - break; - until false; - - setlength(segs, nbSegs); - cur2 := startIdx; - for i := 0 to nbSegs-1 do - begin - next := getnext(cur2); - segs[i].p1 := points[cur2].coord; - segs[i].p2 := points[next].coord; - segs[i].abslen := segabslength(cur2,next); - points[cur2].done := true; - points[next].done := true; - if cur2 <> startIdx then RemovePoint(cur2); - - if next = endIdx then break - else - begin - cur2 := getnext(next); - RemovePoint(next); - end; - end; - - cur2 := startIdx; - for i := 0 to nbSegs-2 do - begin - if i <> 0 then - cur2 := InsertPoint( (segs[i].p1.x+segs[i].p2.x) div 2, - (segs[i].p1.y+segs[i].p2.y) div 2, - cur2, endIdx); - if abs(segs[i].abslen-segs[i+1].abslen) > iHalf then - cur2 := InsertPoint( (segs[i].p2.x+segs[i+1].p1.x) div 2, - (segs[i].p2.y+segs[i+1].p1.y) div 2, - cur2, endIdx); - end; - end; - end; - end; - end; - - procedure Init; - var cur: integer; - begin - u := Point(0,0); - nb := nbPoints; - for cur := 0 to nb-1 do - points[cur].done := false; - end; - - begin - Init; - DoNiceLines(false); - DoNiceLines(true); - end; - - var cycle: boolean; - begin - //rewind - Rewind(cycle); - RemoveAligned; - if AIntermediateDiagonals then NiceLines; - MakePolygon(cycle); - end; - - function GetBoundsWithin: TRect; - var p: PBGRAPixel; - yb, xb, xb2, maxx, maxy, minx, miny: LongInt; - begin - maxx := ARect.Left-1; - maxy := ARect.Top-1; - minx := ARect.Right; - miny := ARect.Bottom; - for yb := ARect.Top to ARect.Bottom-1 do - begin - p := ASource.ScanLine[yb] + ARect.Left; - for xb := ARect.Left to ARect.Right - 1 do - begin - if CheckPixel(p^) then - begin - if xb < minx then minx := xb; - if yb < miny then miny := yb; - if xb > maxx then maxx := xb; - if yb > maxy then maxy := yb; - - inc(p, ARect.Right-1-xb); - for xb2 := ARect.Right-1 downto xb+1 do - begin - if CheckPixel(p^) then - begin - if xb2 > maxx then maxx := xb2; - break; - end; - dec(p); - end; - break; - end; - Inc(p); - end; - end; - if minx > maxx then Result := EmptyRect - else - begin - Result.left := minx; - Result.top := miny; - Result.right := maxx + 1; - Result.bottom := maxy + 1; - end; - end; - - function IsRectFull: boolean; - var - yb, xb: LongInt; - p: PBGRAPixel; - begin - for yb := ARect.Top to ARect.Bottom-1 do - begin - p := ASource.ScanLine[yb] + ARect.Left; - for xb := ARect.Left to ARect.Right - 1 do - begin - if not CheckPixel(p^) then exit(false); - inc(p); - end; - end; - result := true; - end; - -begin - ARect.Intersect( rect(0,0,ASource.Width,ASource.Height) ); - if ARect.IsEmpty then exit(nil); - ARect := GetBoundsWithin; - if ARect.IsEmpty then exit(nil); - - factor := AZoom; - offset := AZoom*0.5; - if APixelCenteredCoordinates then DecF(Offset, 0.5); - - if IsRectFull then - begin - result := PointsF([PointF((ARect.Left-0.5)*factor+offset, (ARect.Top-0.5)*factor+offset), - PointF((ARect.Left-0.5)*factor+offset, (ARect.Bottom-0.5)*factor+offset), - PointF((ARect.Right-0.5)*factor+offset, (ARect.Bottom-0.5)*factor+offset), - PointF((ARect.Right-0.5)*factor+offset, (ARect.Top-0.5)*factor+offset)]); - exit; - end; - - iDiag := round((ADiagonalFillPercent-50)/100 * iHalf)*2; //even rounding to keep alignment with iOut - iOut := (iHalf-iDiag) div 2; - - nbpoints := 0; - points := nil; - polygonF := nil; - - setlength(ortho,ARect.Height,ARect.Width); - for y := 0 to ARect.Height-1 do - begin - if y = 0 then - pprev := nil - else - pprev := ASource.ScanLine[ARect.Top+y-1]+ARect.Left; - p := ASource.ScanLine[ARect.Top+y]+ARect.Left; - if y = ARect.Height-1 then - pnext := nil - else - pnext := ASource.ScanLine[ARect.Top+y+1]+ARect.Left; - - {$hints off} - fillchar(cur,sizeof(cur),0); - {$hints on} - cur[6] := CheckPixel(p^); inc(p); - if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; - if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; - for x := 0 to ARect.Width-1 do - begin - cur[1] := cur[2]; - cur[2] := cur[3]; - cur[4] := cur[5]; - cur[5] := cur[6]; - cur[7] := cur[8]; - cur[8] := cur[9]; - - if x = ARect.Width-1 then - begin - cur[6]:= false; - cur[9]:= false; - cur[3]:= false; - end else - begin - cur[6] := CheckPixel(p^); inc(p); - if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; - if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; - end; - - ortho[y,x] := (cur[5] and not cur[7] and not cur[9] and not cur[3] and not cur[1]); - if (not cur[5] and (cur[4] xor cur[6]) and (cur[8] xor cur[2]) and - (ord(cur[1])+ord(cur[3])+ord(cur[7])+ord(cur[9]) = 3)) then - begin - if (not cur[6] and not cur[9] and not cur[8] and (CheckPixel(ASource.getPixel(x-1,y-2)) or CheckPixel(ASource.getPixel(x+2,y+1).green)) ) or - (not cur[8] and not cur[7] and not cur[4] and (CheckPixel(ASource.getPixel(x-2,y+1)) or CheckPixel(ASource.getPixel(x+1,y-2).green)) ) or - (not cur[4] and not cur[1] and not cur[2] and (CheckPixel(ASource.getPixel(x+1,y+2)) or CheckPixel(ASource.getPixel(x-2,y-1).green)) ) or - (not cur[2] and not cur[3] and not cur[6] and (CheckPixel(ASource.getPixel(x-1,y+2)) or CheckPixel(ASource.getPixel(x+2,y-1).green)) ) then - ortho[y,x] := true; - end; - { or - (cur[5] and cur[4] and cur[6] and cur[2] and cur[8] and (Ord(cur[1])+ord(cur[3])+ord(cur[7])+ord(cur[9]) = 3))}; - //if ortho[y,x] then AddPoint(x shl unitShift,y shl unitShift,-1,-1); - end; - end; - - PointsCurrentLineStart := nbPoints; - for y := 0 to ARect.Height-1 do - begin - iy := (y+ARect.Top) shl unitShift; - - PointsPreviousLineStart := PointsCurrentLineStart; - PointsCurrentLineStart := nbPoints; - if y = 0 then - pprev := nil - else - pprev := ASource.ScanLine[ARect.Top+y-1]+ARect.Left; - p := ASource.ScanLine[ARect.Top+y]+ARect.Left; - if y = ARect.Height-1 then - pnext := nil - else - pnext := ASource.ScanLine[ARect.Top+y+1]+ARect.Left; - - {$hints off} - fillchar(cur,sizeof(cur),0); - {$hints on} - cur[6] := CheckPixel(p^); inc(p); - if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; - if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; - ix := ARect.Left shl unitShift; - for x := 0 to ARect.Width-1 do - begin - cur[1] := cur[2]; - cur[2] := cur[3]; - cur[4] := cur[5]; - cur[5] := cur[6]; - cur[7] := cur[8]; - cur[8] := cur[9]; - - if x = ARect.Width-1 then - begin - cur[6]:= false; - cur[9]:= false; - cur[3]:= false; - end else - begin - cur[6] := CheckPixel(p^); inc(p); - if pprev <> nil then begin cur[9] := CheckPixel(pprev^); inc(pprev); end; - if pnext <> nil then begin cur[3] := CheckPixel(pnext^); inc(pnext); end; - end; - - if cur[5] then - begin - if not cur[1] and not cur[2] and not cur[3] and not cur[4] and not cur[6] and not cur[7] and not cur[8] and not cur[9] then - begin - if iDiag > 0 then - begin - AddLine(ix-iHalf,iy-iDiag,ix-iDiag,iy-iHalf,ix+iDiag,iy-iHalf,ix+iHalf,iy-iDiag,ix+iHalf,iy+iDiag); - AddLine(ix+iHalf,iy+iDiag,ix+iDiag,iy+iHalf,ix-iDiag,iy+iHalf,ix-iHalf,iy+iDiag,ix-iHalf,iy-iDiag); - end else - begin - AddLine(ix-iHalf,iy,ix,iy-iHalf,ix+iHalf,iy); - AddLine(ix+iHalf,iy,ix,iy+iHalf,ix-iHalf,iy); - end; - end else - if cur[6] and not cur[9] and not cur[8] then - begin - if cur[7] then - begin - if not ortho[y-1,x] then - begin - if ortho[y,x-1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - AddLine(ix+iHalf,iy-iHalf,ix+iDiag,iy-iHalf,ix-iOut,iy-iUnit+iOut); - end; - end else - if cur[4] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - if cur[1] then AddLine(ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut) else - if cur[2] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - if cur[3] then - begin - if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut) - end else - AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf); - end; - if cur[8] and not cur[7] and not cur[4] then - begin - if cur[1] then - begin - if not ortho[y,x-1] then - begin - if ortho[y+1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy-iDiag,ix-iUnit+iOut,iy+iOut); - end; - end else - if cur[2] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - if cur[3] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut) else - if cur[6] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - if cur[9] then - begin - if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut) - end else - AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf); - end; - if cur[4] and not cur[1] and not cur[2] then - begin - if cur[3] then - begin - if not ortho[y+1,x] then - begin - if ortho[y,x+1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - AddLine(ix-iHalf,iy+iHalf,ix-iDiag,iy+iHalf,ix+iOut,iy+iUnit-iOut); - end; - end else - if cur[6] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - if cur[9] then AddLine(ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut) else - if cur[8] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - if cur[7] then - begin - if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut) - end else - AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf); - end; - if cur[2] and not cur[3] and not cur[6] then - begin - if cur[9] then - begin - if not ortho[y,x+1] then - begin - if ortho[y-1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy+iDiag,ix+iUnit-iOut,iy-iOut); - end; - end else - if cur[8] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - if cur[7] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut) else - if cur[4] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - if cur[1] then - begin - if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix-iHalf,iy+iHalf) else - AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut) - end else - AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf); - end; - - if cur[3] and not cur[6] then - begin - if cur[9] then - begin - if ortho[y+1,x] and ortho[y-1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - if ortho[y+1,x] and not ortho[y-1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy+iDiag,ix+iUnit-iOut,iy-iOut) else - if not ortho[y+1,x] and ortho[y-1,x] then AddLine(ix+iUnit-iOut,iy+iOut,ix+iHalf,iy-iDiag,ix+iHalf,iy-iHalf) else - AddLine(ix+iUnit-iOut,iy+iOut,ix+iUnit-iOut*2,iy,ix+iUnit-iOut,iy-iOut); - end else - if cur[8] then - begin - if not ortho[y,x+1] then - if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - AddLine(ix+iUnit-iOut,iy+iOut,ix+iHalf,iy-iDiag,ix+iHalf,iy-iHalf) - end else - if cur[7] then - begin - if ortho[y+1,x] and ortho[y,x-1] then - AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - if ortho[y+1,x] and not ortho[y,x-1] then - AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut) else - if not ortho[y+1,x] and ortho[y,x-1] then - AddLine(ix+iUnit-iOut,iy+iOut, ix+iDiag,iy-iHalf, ix-iHalf,iy-iHalf) else - AddLine(ix+iUnit-iOut,iy+iOut,ix-iOut,iy-iUnit+iOut) - end else - if cur[4] then AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iHalf,iy-iHalf) else - if cur[1] then - begin - if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut); - end else - if cur[2] then - begin - if ortho[y+1,x] then AddLine(ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf); - end else - AddLine(ix+iUnit-iOut,iy+iOut,ix+iDiag,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut); - end; - - if cur[9] and not cur[8] then - begin - if cur[7] then - begin - if ortho[y,x+1] and ortho[y,x-1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - if ortho[y,x+1] and not ortho[y,x-1] then AddLine(ix+iHalf,iy-iHalf,ix+iDiag,iy-iHalf,ix-iOut,iy-iUnit+iOut) else - if not ortho[y,x+1] and ortho[y,x-1] then AddLine(ix+iOut,iy-iUnit+iOut,ix-iDiag,iy-iHalf,ix-iHalf,iy-iHalf) else - AddLine(ix+iOut,iy-iUnit+iOut,ix,iy-iUnit+iOut*2,ix-iOut,iy-iUnit+iOut); - end else - if cur[4] then - begin - if not ortho[y-1,x] then - if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - AddLine(ix+iOut,iy-iUnit+iOut,ix-iDiag,iy-iHalf,ix-iHalf,iy-iHalf) - end else - if cur[1] then - begin - if ortho[y,x+1] and ortho[y+1,x] then - AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - if ortho[y,x+1] and not ortho[y+1,x] then - AddLine(ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut) else - if not ortho[y,x+1] and ortho[y+1,x] then - AddLine(ix+iOut,iy-iUnit+iOut, ix-iHalf,iy-iDiag, ix-iHalf,iy+iHalf) else - AddLine(ix+iOut,iy-iUnit+iOut,ix-iUnit+iOut,iy+iOut) - end else - if cur[2] then AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iHalf) else - if cur[3] then - begin - if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut); - end else - if cur[6] then - begin - if ortho[y,x+1] then AddLine(ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf); - end else - AddLine(ix+iOut,iy-iUnit+iOut,ix-iHalf,iy-iDiag,ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut); - end; - - if cur[7] and not cur[4] then - begin - if cur[1] then - begin - if ortho[y-1,x] and ortho[y+1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - if ortho[y-1,x] and not ortho[y+1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy-iDiag,ix-iUnit+iOut,iy+iOut) else - if not ortho[y-1,x] and ortho[y+1,x] then AddLine(ix-iUnit+iOut,iy-iOut,ix-iHalf,iy+iDiag,ix-iHalf,iy+iHalf) else - AddLine(ix-iUnit+iOut,iy-iOut,ix-iUnit+iOut*2,iy,ix-iUnit+iOut,iy+iOut); - end else - if cur[2] then - begin - if not ortho[y,x-1] then - if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf) else - AddLine(ix-iUnit+iOut,iy-iOut,ix-iHalf,iy+iDiag,ix-iHalf,iy+iHalf) - end else - if cur[3] then - begin - if ortho[y-1,x] and ortho[y,x+1] then - AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - if ortho[y-1,x] and not ortho[y,x+1] then - AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iDiag,ix+iOut,iy+iUnit-iOut) else - if not ortho[y-1,x] and ortho[y,x+1] then - AddLine(ix-iUnit+iOut,iy-iOut, ix-iDiag,iy+iHalf, ix+iHalf,iy+iHalf) else - AddLine(ix-iUnit+iOut,iy-iOut,ix+iOut,iy+iUnit-iOut) - end else - if cur[6] then AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iHalf,iy+iHalf) else - if cur[9] then - begin - if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut); - end else - if cur[8] then - begin - if ortho[y-1,x] then AddLine(ix-iHalf,iy-iHalf,ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf); - end else - AddLine(ix-iUnit+iOut,iy-iOut,ix-iDiag,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut); - end; - - if cur[1] and not cur[2] then - begin - if cur[3] then - begin - if ortho[y,x-1] and ortho[y,x+1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - if ortho[y,x-1] and not ortho[y,x+1] then AddLine(ix-iHalf,iy+iHalf,ix-iDiag,iy+iHalf,ix+iOut,iy+iUnit-iOut) else - if not ortho[y,x-1] and ortho[y,x+1] then AddLine(ix-iOut,iy+iUnit-iOut,ix+iDiag,iy+iHalf,ix+iHalf,iy+iHalf) else - AddLine(ix-iOut,iy+iUnit-iOut,ix,iy+iUnit-iOut*2,ix+iOut,iy+iUnit-iOut); - end else - if cur[6] then - begin - if not ortho[y+1,x] then - if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf) else - AddLine(ix-iOut,iy+iUnit-iOut,ix+iDiag,iy+iHalf,ix+iHalf,iy+iHalf) - end else - if cur[9] then - begin - if ortho[y,x-1] and ortho[y-1,x] then - AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf) else - if ortho[y,x-1] and not ortho[y-1,x] then - AddLine(ix-iHalf,iy+iHalf,ix+iDiag,iy+iHalf,ix+iUnit-iOut,iy-iOut) else - if not ortho[y,x-1] and ortho[y-1,x] then - AddLine(ix-iOut,iy+iUnit-iOut, ix+iHalf,iy+iDiag, ix+iHalf,iy-iHalf) else - AddLine(ix-iOut,iy+iUnit-iOut,ix+iUnit-iOut,iy-iOut) - end else - if cur[8] then AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iHalf) else - if cur[7] then - begin - if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iDiag,ix-iOut,iy-iUnit+iOut); - end else - if cur[4] then - begin - if ortho[y,x-1] then AddLine(ix-iHalf,iy+iHalf,ix+iHalf,iy+iHalf,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf) else - AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iHalf,ix-iHalf,iy-iHalf); - end else - AddLine(ix-iOut,iy+iUnit-iOut,ix+iHalf,iy+iDiag,ix+iHalf,iy-iHalf,ix-iDiag,iy-iHalf,ix-iUnit+iOut,iy+iOut); - end; - end else - if ortho[y,x] then - begin - if not cur[9] then AddLine(ix+iHalf,iy+iHalf,ix-iHalf,iy+iHalf,ix-iHalf,iy-iHalf) else - if not cur[7] then AddLine(ix+iHalf,iy-iHalf,ix+iHalf,iy+iHalf,ix-iHalf,iy+iHalf) else - if not cur[1] then AddLine(ix-iHalf,iy-iHalf,ix+iHalf,iy-iHalf,ix+iHalf,iy+iHalf) else - if not cur[3] then AddLine(ix-iHalf,iy+iHalf,ix-iHalf,iy-iHalf,ix+iHalf,iy-iHalf); - end; - inc(ix,iUnit); - end; - end; - - factor := factor / iUnit; - - for n := 0 to nbPoints-1 do - with points[n] do - if not drawn and not removed then - AddPolygon(n); - - result := polygonF; -end; - -function VectorizeMonochrome(ASource: TBGRACustomBitmap; - AZoom: single; APixelCenteredCoordinates: boolean; AWhiteBackground: boolean; - ADiagonalFillPercent: single; AIntermediateDiagonals: boolean): ArrayOfTPointF; -begin - result := VectorizeMonochrome(ASource, rect(0,0,ASource.Width,ASource.Height), AZoom, APixelCenteredCoordinates, - AWhiteBackground, ADiagonalFillPercent, AIntermediateDiagonals); -end; - -{ TBGRAVectorizedFontRenderer } - -function TBGRAVectorizedFontRenderer.OutlineActuallyVisible: boolean; -begin - result := OutlineVisible and (abs(OutlineWidth) > 0) and (OutlineColor.Alpha <> 0) or (OutlineTexture <> nil); -end; - -procedure TBGRAVectorizedFontRenderer.UpdateFont; -var i,neededResolution: integer; -begin - FVectorizedFont := nil; - FontName := Trim(FontName); - for i := 0 to high(FVectorizedFontArray) do - if (CompareText(FVectorizedFontArray[i].FontName,FontName)=0) and - (FVectorizedFontArray[i].FontStyle = FontStyle) then - begin - FVectorizedFont := FVectorizedFontArray[i].VectorizedFont; - break; - end; - - if FVectorizedFont = nil then - begin - FVectorizedFont:= TBGRAVectorizedFont.Create(False); - FVectorizedFont.Name := FontName; - FVectorizedFont.Style := FontStyle - [fsUnderline]; - FVectorizedFont.UnderlineDecoration := fsUnderline in FontStyle; - FVectorizedFont.Directory := FDirectoryUTF8; - if not FVectorizedFont.FontFound and SystemFontAvailable then - begin - FVectorizedFont.VectorizeLCL := True; - FVectorizedFont.Name := TBGRASystemFontRenderer.PatchSystemFontName(FontName); - end; - Setlength(FVectorizedFontArray,length(FVectorizedFontArray)+1); - FVectorizedFontArray[high(FVectorizedFontArray)].FontName := FontName; - FVectorizedFontArray[high(FVectorizedFontArray)].FontStyle := FontStyle; - FVectorizedFontArray[high(FVectorizedFontArray)].VectorizedFont := FVectorizedFont; - end; - if FontEmHeight > 0 then - FVectorizedFont.EmHeight := FontEmHeightF - else - FVectorizedFont.FullHeight:= -FontEmHeightF; - if OutlineActuallyVisible then - begin - if OuterOutlineOnly then - FVectorizedFont.OutlineMode := twoFillOverStroke - else - FVectorizedFont.OutlineMode := twoStrokeOverFill; - end - else FVectorizedFont.OutlineMode := twoFill; - FVectorizedFont.QuadraticCurves := (FVectorizedFont.FullHeight > FVectorizedFont.Resolution*1.2) and QuadraticCurves; - if FVectorizedFont.VectorizeLCL then - begin - neededResolution := trunc((FVectorizedFont.FullHeight+80)/50)*50; - if neededResolution < MinFontResolution then neededResolution := MinFontResolution; - if neededResolution > MaxFontResolution then neededResolution := MaxFontResolution; - if FVectorizedFont.Resolution < neededResolution then FVectorizedFont.Resolution:= neededResolution; - end; -end; - -function TBGRAVectorizedFontRenderer.GetCanvas2D(ASurface: TBGRACustomBitmap - ): TBGRACanvas2D; -begin - if (FCanvas2D = nil) or (FCanvas2D.surface <> ASurface) then - begin - FCanvas2D.Free; - FCanvas2D := TBGRACanvas2D.Create(ASurface); - end; - result := FCanvas2D; - FCanvas2D.antialiasing:= FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]; - FCanvas2D.lineJoinLCL := OutlineJoin; - if OutlineTexture <> nil then - FCanvas2D.strokeStyle(OutlineTexture) - else - FCanvas2D.strokeStyle(OutlineColor); - if abs(OutlineWidth) < 3 then - FCanvas2D.lineWidth := abs(OutlineWidth)*2/3 - else - FCanvas2D.lineWidth := abs(OutlineWidth)-1; - if not ShadowVisible then - FCanvas2D.shadowColor(BGRAPixelTransparent) - else - begin - FCanvas2D.shadowColor(ShadowColor); - FCanvas2D.shadowBlur:= ShadowRadius; - FCanvas2D.shadowOffset := PointF(ShadowOffset.X,ShadowOffset.Y); - end; -end; - -procedure TBGRAVectorizedFontRenderer.InternalTextRect( - ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; - style: TTextStyle; c: TBGRAPixel; texture: IBGRAScanner); -var - twAlign : TBGRATypeWriterAlignment; - c2D: TBGRACanvas2D; - intersectedClip,previousClip: TRect; -begin - previousClip := ADest.ClipRect; - if style.Clipping then - begin - intersectedClip := TRect.Intersect(previousClip, ARect); - if intersectedClip.IsEmpty then exit; - ADest.ClipRect := intersectedClip; - end; - UpdateFont; - if style.RightToLeft then - FVectorizedFont.BidiMode := fbmRightToLeft - else - FVectorizedFont.BidiMode := fbmLeftToRight; - FVectorizedFont.Orientation := 0; - case style.Alignment of - taCenter: case style.Layout of - tlCenter: twAlign := twaMiddle; - tlBottom: twAlign := twaBottom; - else twAlign:= twaTop; - end; - taRightJustify: - case style.Layout of - tlCenter: twAlign := twaRight; - tlBottom: twAlign := twaBottomRight; - else twAlign := twaTopRight; - end; - else - case style.Layout of - tlCenter: twAlign := twaLeft; - tlBottom: twAlign := twaBottomLeft; - else twAlign:= twaTopLeft; - end; - end; - c2D := GetCanvas2D(ADest); - if texture = nil then - c2D.fillStyle(c) - else - c2D.fillStyle(texture); - if style.Wordbreak then - FVectorizedFont.DrawTextRect(c2D, sUTF8, x-0.5,y-0.5,ARect.Right-0.5,ARect.Bottom-0.5, twAlign) - else - begin - case style.Layout of - tlCenter: y := (ARect.Top+ARect.Bottom) div 2; - tlBottom: y := ARect.Bottom; - end; - case style.Alignment of - taCenter: FVectorizedFont.DrawText(c2D, sUTF8, (ARect.Left+ARect.Right-1)/2,y-0.5, twAlign); - taRightJustify: FVectorizedFont.DrawText(c2D, sUTF8, ARect.Right-0.5,y-0.5, twAlign); - else - FVectorizedFont.DrawText(c2D, sUTF8, x-0.5,y-0.5, twAlign); - end; - end; - if style.Clipping then - ADest.ClipRect := previousClip; -end; - -procedure TBGRAVectorizedFontRenderer.InternalCopyTextPathTo(ADest: IBGRAPath; - x, y: single; s: string; align: TAlignment; ABidiMode: TFontBidiMode); -var - twAlign : TBGRATypeWriterAlignment; - ofs: TPointF; -begin - UpdateFont; - FVectorizedFont.BidiMode := ABidiMode; - FVectorizedFont.Orientation := 0; - case align of - taCenter: twAlign:= twaMiddle; - taRightJustify: twAlign := twaRight; - else twAlign:= twaLeft; - end; - ofs := PointF(x,y); - ofs.Offset(0, FVectorizedFont.FullHeight*0.5); - FVectorizedFont.CopyTextPathTo(ADest, s, ofs.x,ofs.y, twAlign); -end; - -procedure TBGRAVectorizedFontRenderer.InternalTextOutAngle( - ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; - c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment; - ABidiMode: TFontBidiMode); -var - twAlign : TBGRATypeWriterAlignment; - c2D: TBGRACanvas2D; - ofs: TPointF; -begin - UpdateFont; - FVectorizedFont.Orientation := orientation; - FVectorizedFont.BidiMode := ABidiMode; - case align of - taCenter: twAlign:= twaMiddle; - taRightJustify: twAlign := twaRight; - else twAlign:= twaLeft; - end; - c2D := GetCanvas2D(ADest); - if Assigned(texture) then - c2D.fillStyle(texture) - else - c2D.fillStyle(c); - ofs := PointF(x,y); - ofs.Offset( AffineMatrixRotationDeg(-orientation*0.1)*PointF(0,FVectorizedFont.FullHeight*0.5) ); - FVectorizedFont.DrawText(c2D, s, ofs.x,ofs.y, twAlign); -end; - -procedure TBGRAVectorizedFontRenderer.Init; -begin - FVectorizedFontArray := nil; - FDirectoryUTF8 := ''; - - OutlineVisible:= True; - OutlineColor := BGRAPixelTransparent; - OuterOutlineOnly := false; - OutlineJoin := pjsMiter; - - ShadowColor := BGRABlack; - ShadowVisible := false; - ShadowOffset := Point(5,5); - ShadowRadius := 5; - - MaxFontResolution := 300; -end; - -constructor TBGRAVectorizedFontRenderer.Create; -begin - Init; -end; - -constructor TBGRAVectorizedFontRenderer.Create(ADirectoryUTF8: string); -begin - Init; - FDirectoryUTF8 := ADirectoryUTF8; -end; - -function TBGRAVectorizedFontRenderer.GetFontPixelMetric: TFontPixelMetric; -var factor: single; -begin - UpdateFont; - result := FVectorizedFont.FontPixelMetric; - if FVectorizedFont.Resolution > 0 then - begin - factor := FVectorizedFont.FullHeight/FVectorizedFont.Resolution; - result.Baseline := round(result.Baseline*factor); - result.CapLine := round(result.CapLine*factor); - result.Lineheight := round(result.Lineheight*factor); - result.DescentLine := round(result.DescentLine*factor); - result.xLine := round(result.xLine*factor); - end; -end; - -function TBGRAVectorizedFontRenderer.GetFontPixelMetricF: TFontPixelMetricF; -var factor: single; - fpm: TFontPixelMetric; -begin - UpdateFont; - fpm := FVectorizedFont.FontPixelMetric; - result.Defined := fpm.Defined; - if FVectorizedFont.Resolution > 0 then - factor := FVectorizedFont.FullHeight/FVectorizedFont.Resolution - else factor := 1; - result.Baseline := fpm.Baseline*factor; - result.CapLine := fpm.CapLine*factor; - result.Lineheight := fpm.Lineheight*factor; - result.DescentLine := fpm.DescentLine*factor; - result.xLine := fpm.xLine*factor; -end; - -function TBGRAVectorizedFontRenderer.FontExists(AName: string): boolean; -var - i: Integer; -begin - {$IFDEF LCL} - for i := 0 to Screen.Fonts.Count-1 do - if CompareText(Screen.Fonts[i], AName) = 0 then exit(true); - result := false; - {$ELSE} - result := true; - {$ENDIF} -end; - -procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); -begin - InternalTextOutAngle(ADest,x,y,orientation,s,c,nil,align,fbmAuto); -end; - -procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment; - ARightToLeft: boolean); -begin - if ARightToLeft then - InternalTextOutAngle(ADest,x,y,orientation,s,c,nil,align,fbmRightToLeft) - else - InternalTextOutAngle(ADest,x,y,orientation,s,c,nil,align,fbmLeftToRight); -end; - -procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientation: integer; s: string; texture: IBGRAScanner; - align: TAlignment); -begin - InternalTextOutAngle(ADest,x,y,orientation,s,BGRAPixelTransparent,texture,align,fbmAuto); -end; - -procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, - y: single; orientation: integer; s: string; texture: IBGRAScanner; - align: TAlignment; ARightToLeft: boolean); -begin - if ARightToLeft then - InternalTextOutAngle(ADest,x,y,orientation,s,BGRAPixelTransparent,texture,align,fbmRightToLeft) - else - InternalTextOutAngle(ADest,x,y,orientation,s,BGRAPixelTransparent,texture,align,fbmLeftToRight); -end; - -procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; s: string; texture: IBGRAScanner; align: TAlignment); -begin - TextOutAngle(ADest,x,y,FontOrientation,s,texture,align); -end; - -procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; s: string; texture: IBGRAScanner; align: TAlignment; - ARightToLeft: boolean); -begin - TextOutAngle(ADest,x,y,FontOrientation,s,texture,align,ARightToLeft); -end; - -procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; s: string; c: TBGRAPixel; align: TAlignment); -begin - TextOutAngle(ADest,x,y,FontOrientation,s,c,align); -end; - -procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, - y: single; s: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); -begin - TextOutAngle(ADest,x,y,FontOrientation,s,c,align,ARightToLeft); -end; - -procedure TBGRAVectorizedFontRenderer.TextRect(ADest: TBGRACustomBitmap; - ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); -begin - InternalTextRect(ADest,ARect,x,y,s,style,c,nil); -end; - -procedure TBGRAVectorizedFontRenderer.TextRect(ADest: TBGRACustomBitmap; - ARect: TRect; x, y: integer; s: string; style: TTextStyle; - texture: IBGRAScanner); -begin - InternalTextRect(ADest,ARect,x,y,s,style,BGRAPixelTransparent,texture); -end; - -procedure TBGRAVectorizedFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment); -begin - InternalCopyTextPathTo(ADest, x,y, s, align, fbmAuto); -end; - -procedure TBGRAVectorizedFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, - y: single; s: string; align: TAlignment; ARightToLeft: boolean); -begin - if ARightToLeft then - InternalCopyTextPathTo(ADest, x,y, s, align, fbmRightToLeft) - else - InternalCopyTextPathTo(ADest, x,y, s, align, fbmLeftToRight); -end; - -function TBGRAVectorizedFontRenderer.HandlesTextPath: boolean; -begin - Result:= true; -end; - -function TBGRAVectorizedFontRenderer.TextSize(sUTF8: string): TSize; -var sizeF: TPointF; -begin - sizeF := TextSizeF(sUTF8); - result.cx := round(sizeF.x); - result.cy := round(sizeF.y); -end; - -function TBGRAVectorizedFontRenderer.TextSizeF(sUTF8: string): TPointF; -begin - UpdateFont; - FVectorizedFont.BidiMode := fbmAuto; - result := FVectorizedFont.GetTextSize(sUTF8); -end; - -function TBGRAVectorizedFontRenderer.TextSize(sUTF8: string; - AMaxWidth: integer; ARightToLeft: boolean): TSize; -begin - with TextSizeF(sUTF8, AMaxWidth, ARightToLeft) do - result := Size(system.Round(x),system.Round(y)); -end; - -function TBGRAVectorizedFontRenderer.TextSizeF(sUTF8: string; - AMaxWidthF: single; ARightToLeft: boolean): TPointF; -var - remains: string; - w,h: single; -begin - UpdateFont; - FVectorizedFont.BidiMode := fbmAuto; - result.x := 0; - result.y := 0; - h := FVectorizedFont.FullHeight; - repeat - FVectorizedFont.SplitText(sUTF8, AMaxWidthF, remains); - w := FVectorizedFont.GetTextSize(sUTF8).x; - if w > result.x then result.x := w; - IncF(result.y, h); - sUTF8 := remains; - until remains = ''; -end; - -function TBGRAVectorizedFontRenderer.TextFitInfo(sUTF8: string; - AMaxWidth: integer): integer; -begin - UpdateFont; - FVectorizedFont.BidiMode := fbmAuto; - result := FVectorizedFont.TextFitInfo(sUTF8, AMaxWidth); -end; - -function TBGRAVectorizedFontRenderer.TextFitInfoF(sUTF8: string; - AMaxWidthF: single): integer; -begin - UpdateFont; - FVectorizedFont.BidiMode := fbmAuto; - result := FVectorizedFont.TextFitInfo(sUTF8, AMaxWidthF); -end; - -destructor TBGRAVectorizedFontRenderer.Destroy; -var i: integer; -begin - FCanvas2D.Free; - for i := 0 to high(FVectorizedFontArray) do - FVectorizedFontArray[i].VectorizedFont.Free; - FVectorizedFontArray := nil; - inherited Destroy; -end; - -{ TBGRAVectorizedFont } - -procedure TBGRAVectorizedFont.SetResolution(AValue: integer); -begin - if FResolution=AValue then Exit; - FResolution:=AValue; - UpdateFont; -end; - -procedure TBGRAVectorizedFont.SetOrientation(AValue: single); -begin - if FOrientation=AValue then Exit; - FOrientation:=AValue; - UpdateMatrix; -end; - -procedure TBGRAVectorizedFont.SetItalicSlope(AValue: single); -begin - if FItalicSlope=AValue then Exit; - FItalicSlope:=AValue; - UpdateMatrix; -end; - -procedure TBGRAVectorizedFont.SetLCLHeight(AValue: single); -begin - if (AValue > 0) xor (FontEmHeightSign < 0) then - EmHeight := abs(AValue) - else - FullHeight := abs(AValue); -end; - -function TBGRAVectorizedFont.GetEmHeight: single; -begin - result := FullHeight * FontEmHeightRatio; -end; - -function TBGRAVectorizedFont.GetFontPixelMetric: TFontPixelMetric; -begin - if not FFontPixelMetricComputed and (FFont <> nil) then - begin - FFontPixelMetric := BGRAText.GetLCLFontPixelMetric(FFont); - FFontPixelMetricComputed := true; - end; - result := FFontPixelMetric; -end; - -function TBGRAVectorizedFont.GetLCLHeight: single; -begin - result := FullHeight * FontFullHeightSign; -end; - -function TBGRAVectorizedFont.GetVectorizeLCL: boolean; -begin - result := FFont <> nil; -end; - -procedure TBGRAVectorizedFont.GlyphCallbackForGlyphSizes(ATextUTF8: string; AGlyph: TBGRAGlyph; - AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); -begin - with TGlyphSizesCallbackData(AData^) do - begin - if Count = length(Sizes) then - setlength(Sizes, 2*Count+1); - Sizes[Count].Text := ATextUTF8; - if AGlyph<>nil then - begin - Sizes[Count].Glyph:= AGlyph.Identifier; - Sizes[Count].Width:= AGlyph.Width*FullHeight; - Sizes[Count].Height:= AGlyph.Height*FullHeight; - end else - begin - Sizes[Count].Glyph:= ''; - Sizes[Count].Width:= 0; - Sizes[Count].Height:= 0; - end; - inc(Count); - end; - AContinue:= true; -end; - -procedure TBGRAVectorizedFont.UpdateQuadraticCallback(ATextUTF8: string; - AGlyph: TBGRAGlyph; AFlags: TBrowseGlyphCallbackFlags; AData: Pointer; out AContinue: boolean); -begin - if AGlyph is TBGRAPolygonalGlyph then - TBGRAPolygonalGlyph(AGlyph).QuadraticCurves:= FQuadraticCurves; - AContinue := true; -end; - -procedure TBGRAVectorizedFont.SetEmHeight(AValue: single); -begin - if FontEmHeightRatio > 0 then - FullHeight := AValue / FontEmHeightRatio; -end; - -procedure TBGRAVectorizedFont.SetQuadraticCurves(AValue: boolean); -begin - if FQuadraticCurves=AValue then Exit; - FQuadraticCurves:=AValue; - BrowseAllGlyphs(@UpdateQuadraticCallback, nil); -end; - -procedure TBGRAVectorizedFont.SetFontMatrix(AValue: TAffineMatrix); -begin - FFontMatrix:=AValue; - UpdateMatrix; -end; - -procedure TBGRAVectorizedFont.SetFullHeight(AValue: single); -begin - if FFullHeight=AValue then Exit; - FFullHeight:=AValue; - UpdateMatrix; -end; - -procedure TBGRAVectorizedFont.SetName(AValue: string); -begin - if FName=AValue then Exit; - FName:=AValue; - UpdateFont; -end; - -procedure TBGRAVectorizedFont.SetStyle(AValue: TFontStyles); -begin - if FStyle=AValue then Exit; - FStyle:=AValue; - UpdateFont; - SubstituteBidiBracket:= fsItalic in AValue; -end; - -function TBGRAVectorizedFont.GetFontEmHeightRatio: single; -var - lEmHeight, lFullHeight: single; - OldHeight: integer; -begin - if not FFontEmHeightRatioComputed then - begin - if FFont <> nil then - begin - OldHeight := FFont.Height; - FFont.Height := FontEmHeightSign * 100; - lEmHeight := BGRATextSize(FFont, fqSystem, 'Hg', 1).cy; - FFont.Height := FixSystemFontFullHeight(FFont.Name, FontFullHeightSign * 100); - lFullHeight := BGRATextSize(FFont, fqSystem, 'Hg', 1).cy; - if lEmHeight = 0 then - FFontEmHeightRatio := 1 - else - FFontEmHeightRatio := lFullHeight/lEmHeight; - FFontEmHeightRatioComputed := true; - FFont.Height := OldHeight; - end else - begin - result := 1; - exit; - end; - end; - result := FFontEmHeightRatio; -end; - -procedure TBGRAVectorizedFont.SetVectorizeLCL(AValue: boolean); -begin - if AValue then - begin - if FFont = nil then - FFont := TFont.Create; - end else - begin - if FFont <> nil then - FreeAndNil(FFont); - end; - UpdateFont; -end; - -procedure TBGRAVectorizedFont.UpdateFont; -var i: integer; - bestIndex, bestDistance: integer; - distance: integer; -begin - if FFont <> nil then - begin - ClearGlyphs; - FFont.Name := TBGRASystemFontRenderer.PatchSystemFontName(FName); - FFont.Style := FStyle; - FFont.Height := FixSystemFontFullHeight(FFont.Name, FontFullHeightSign * FResolution); - FFont.Quality := fqNonAntialiased; - FFontEmHeightRatio := 1; - FFontEmHeightRatioComputed := false; - fillchar(FFontPixelMetric,sizeof(FFontPixelMetric),0); - FFontPixelMetricComputed := false; - FFontFound := True; - end else - begin - bestIndex := -1; - bestDistance := 1000; - for i := 0 to high(FDirectoryContent) do - begin - if CompareText(FDirectoryContent[i].FontName,FName) = 0 then - begin - distance := 0; - if (fsBold in FDirectoryContent[i].FontStyle) xor (fsBold in FStyle) then inc(distance, 10); - if (fsItalic in FDirectoryContent[i].FontStyle) xor (fsItalic in FStyle) then inc(distance, 5); - if (fsStrikeOut in FDirectoryContent[i].FontStyle) xor (fsStrikeOut in FStyle) then inc(distance, 1); - if (fsUnderline in FDirectoryContent[i].FontStyle) xor (fsUnderline in FStyle) then inc(distance, 1); - if (bestIndex = -1) or (distance < bestDistance) then - begin - bestIndex := i; - bestDistance := distance; - if FDirectoryContent[i].FontStyle = FStyle then break; - end; - end; - end; - if bestIndex <> -1 then - begin - if not (fsItalic in FDirectoryContent[bestIndex].FontStyle) and (fsItalic in FStyle) then - ItalicSlope := 0.25 - else if (fsItalic in FDirectoryContent[bestIndex].FontStyle) and not (fsItalic in FStyle) then - ItalicSlope := -0.25 - else - ItalicSlope := 0; - - UnderlineDecoration := not (fsUnderline in FDirectoryContent[bestIndex].FontStyle) and (fsUnderline in FStyle); - StrikeOutDecoration := not (fsStrikeOut in FDirectoryContent[bestIndex].FontStyle) and (fsStrikeOut in FStyle); - - ClearGlyphs; - LoadGlyphsFromFile(FDirectoryContent[bestIndex].Filename); - FFontFound := True; - end else - FFontFound := false; - end; -end; - -procedure TBGRAVectorizedFont.UpdateMatrix; -begin - TypeWriterMatrix := FFontMatrix*AffineMatrixRotationDeg(-Orientation*0.1)*AffineMatrixScale(FFullHeight,FFullHeight)*AffineMatrixLinear(PointF(1,0),PointF(-FItalicSlope,1)); -end; - -constructor TBGRAVectorizedFont.Create; -begin - inherited Create; - Init(True); -end; - -constructor TBGRAVectorizedFont.Create(AVectorizeLCL: boolean); -begin - inherited Create; - Init(AVectorizeLCL); -end; - -destructor TBGRAVectorizedFont.Destroy; -begin - FFont.Free; - FBuffer.Free; - inherited Destroy; -end; - -function TBGRAVectorizedFont.GetGlyphSize(AIdentifier: string): TPointF; -var g: TBGRAGlyph; -begin - g := GetGlyph(AIdentifier); - if g = nil then result := EmptyPointF else - result := PointF(g.Width*FullHeight,g.Height*FullHeight); -end; - -function TBGRAVectorizedFont.GetTextGlyphSizes(ATextUTF8: string): TGlyphSizes; -var - data: TGlyphSizesCallbackData; -begin - data.Count:= 0; - setlength(data.Sizes, UTF8Length(ATextUTF8)); - BrowseGlyphs(ATextUTF8, @GlyphCallbackForGlyphSizes, @data, false); - setlength(data.Sizes, data.Count); - result := data.Sizes; -end; - -function TBGRAVectorizedFont.GetTextSize(ATextUTF8: string): TPointF; -begin - result := GetTextSizeBeforeTransform(ATextUTF8)*FullHeight; -end; - -function TBGRAVectorizedFont.TextFitInfo(ATextUTF8: string; AMaxWidth: single): integer; -var - charCount, byteCount: integer; - usedWidth: single; -begin - if FullHeight=0 then result := UTF8Length(ATextUTF8) else - begin - TextFitInfoBeforeTransform(ATextUTF8, AMaxWidth/FullHeight, charCount, byteCount, usedWidth); - result := charCount; - end; -end; - -procedure TBGRAVectorizedFont.SplitText(var ATextUTF8: string; AMaxWidth: single; - out ARemainsUTF8: string); -var - pstr: pchar; - p,left,charlen: integer; - totalWidth: single; - firstChar: boolean; - nextchar: string; - g: TBGRAGlyph; -begin - totalWidth := 0; - if ATextUTF8 = '' then - begin - ARemainsUTF8 := ''; - exit; - end else - begin - p := 1; - pstr := @ATextUTF8[1]; - left := length(ATextUTF8); - firstChar := true; - while left > 0 do - begin - if RemoveLineEnding(ATextUTF8,p) then - begin - ARemainsUTF8 := copy(ATextUTF8,p,length(ATextUTF8)-p+1); - ATextUTF8 := copy(ATextUTF8,1,p-1); - exit; - end; - - charlen := UTF8CharacterLength(pstr); - setlength(nextchar, charlen); - move(pstr^, nextchar[1], charlen); - inc(pstr,charlen); - - g := GetGlyph(nextchar); - if g <> nil then - begin - IncF(totalWidth, g.Width*FullHeight); - if not firstChar and (totalWidth > AMaxWidth) then - begin - ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1); - ATextUTF8 := copy(ATextUTF8,1,p-1); - if Assigned(FWordBreakHandler) then - FWordBreakHandler(ATextUTF8,ARemainsUTF8) else - DefaultWordBreakHandler(ATextUTF8,ARemainsUTF8); - exit; - end; - end; - - dec(left,charlen); - inc(p,charlen); - firstChar := false; - end; - end; - ARemainsUTF8 := ''; //no split -end; - -procedure TBGRAVectorizedFont.DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X, - Y: Single; AAlign: TBGRATypeWriterAlignment); -var underlinePoly: ArrayOfTPointF; - m: TAffineMatrix; - i: integer; - deltaY: single; -begin - inherited DrawText(ADest, ATextUTF8, X, Y, AAlign); - if AAlign in [twaBottom,twaBottomLeft,twaBottomRight] then deltaY := -1 else - if AAlign in [twaLeft,twaMiddle,twaRight] then deltaY := -0.5 else - deltaY := 0; - if UnderlineDecoration and (Resolution > 0) then - begin - underlinePoly := BGRATextUnderline(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, - (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution); - if underlinePoly <> nil then - begin - m := GetTextMatrix(ATextUTF8, X,Y,AAlign); - for i := 0 to high(underlinePoly) do - underlinePoly[i] := m*underlinePoly[i]; - if OutlineMode <> twoPath then ADest.beginPath; - ADest.moveTo(m*underlinePoly[high(underlinePoly)]); - for i := high(underlinePoly)-1 downto 0 do - ADest.lineTo(m*underlinePoly[i]); - DrawLastPath(ADest); - end; - end; - if StrikeOutDecoration and (Resolution > 0) then - begin - underlinePoly := BGRATextStrikeOut(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, - (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution, (FontPixelMetric.Baseline-FontPixelMetric.xLine)/Resolution); - if underlinePoly <> nil then - begin - m := GetTextMatrix(ATextUTF8, X,Y,AAlign); - for i := 0 to high(underlinePoly) do - underlinePoly[i] := m*underlinePoly[i]; - if OutlineMode <> twoPath then ADest.beginPath; - ADest.moveTo(m*underlinePoly[high(underlinePoly)]); - for i := high(underlinePoly)-1 downto 0 do - ADest.lineTo(m*underlinePoly[i]); - DrawLastPath(ADest); - end; - end; -end; - -procedure TBGRAVectorizedFont.CopyTextPathTo(ADest: IBGRAPath; - ATextUTF8: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment); -var underlinePoly: ArrayOfTPointF; - m: TAffineMatrix; - i: integer; - deltaY: single; -begin - inherited CopyTextPathTo(ADest,ATextUTF8, X, Y, AAlign); - if AAlign in [twaBottom,twaBottomLeft,twaBottomRight] then deltaY := -1 else - if AAlign in [twaLeft,twaMiddle,twaRight] then deltaY := -0.5 else - deltaY := 0; - if UnderlineDecoration and (Resolution > 0) then - begin - underlinePoly := BGRATextUnderline(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, - (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution); - if underlinePoly <> nil then - begin - m := GetTextMatrix(ATextUTF8, X,Y,AAlign); - ADest.moveTo(m*underlinePoly[high(underlinePoly)]); - for i := high(underlinePoly)-1 downto 0 do - ADest.lineTo(m*underlinePoly[i]); - ADest.closePath; - end; - end; - if StrikeOutDecoration and (Resolution > 0) then - begin - underlinePoly := BGRATextStrikeOut(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution, - (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution, (FontPixelMetric.Baseline-FontPixelMetric.xLine)/Resolution); - if underlinePoly <> nil then - begin - m := GetTextMatrix(ATextUTF8, X,Y,AAlign); - ADest.moveTo(m*underlinePoly[high(underlinePoly)]); - for i := high(underlinePoly)-1 downto 0 do - ADest.lineTo(m*underlinePoly[i]); - ADest.closePath; - end; - end; -end; - -procedure TBGRAVectorizedFont.DrawTextWordBreak(ADest: TBGRACanvas2D; - ATextUTF8: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment); -var ARemains: string; - pos,step: TPointF; - lines: TStringList; - i: integer; - lineShift: single; - oldItalicSlope: single; - lineAlignment: TBGRATypeWriterAlignment; -begin - if (ATextUTF8 = '') or (MaxWidth <= 0) then exit; - - oldItalicSlope:= ItalicSlope; - ItalicSlope := 0; - pos := PointF(X,Y); - step := TypeWriterMatrix*PointF(0,1); - ItalicSlope := oldItalicSlope; - - if AAlign in[twaTop,twaMiddle,twaBottom] then - lineAlignment := twaMiddle - else if AAlign in[twaTopLeft,twaLeft,twaBottomLeft] then - begin - if ItalicSlope < 0 then - lineAlignment:= twaTopLeft - else - lineAlignment := twaBottomLeft; - end else - begin - if ItalicSlope < 0 then - lineAlignment := twaBottomRight - else - lineAlignment := twaTopRight; - end; - - if AAlign in[twaTopLeft,twaTop,twaTopRight] then - begin - case lineAlignment of - twaMiddle: lineShift := 0.5; - twaBottomLeft,twaBottomRight: lineShift := 1; - twaTopRight,twaTopLeft : lineShift := 0; - end; - pos.Offset(step*lineShift); - repeat - SplitText(ATextUTF8, MaxWidth, ARemains); - DrawText(ADest,ATextUTF8,pos.X,pos.Y,lineAlignment); - ATextUTF8 := ARemains; - pos.Offset(step); - until ARemains = ''; - end else - begin - lines := TStringList.Create; - repeat - SplitText(ATextUTF8, MaxWidth, ARemains); - lines.Add(ATextUTF8); - ATextUTF8 := ARemains; - until ARemains = ''; - if AAlign in[twaLeft,twaMiddle,twaRight] then lineShift := lines.Count/2-0.5 - else if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then lineShift := lines.Count-0.5 - else lineShift := -0.5; - - case lineAlignment of - twaMiddle: ; - twaBottomLeft,twaBottomRight: DecF(lineShift, 0.5); - twaTopRight,twaTopLeft : IncF(lineShift, 0.5); - end; - - pos.Offset(step*(-lineShift)); - for i := 0 to lines.Count-1 do - begin - DrawText(ADest,lines[i],pos.X,pos.Y,lineAlignment); - pos.Offset(step); - end; - lines.Free; - end; -end; - -procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; - X1, Y1, X2, Y2: Single; AAlign: TBGRATypeWriterAlignment); -var X,Y: single; - oldOrientation: single; -begin - if X2 <= X1 then exit; - if AAlign in[twaTopLeft,twaTop,twaTopRight] then Y := Y1 else - if AAlign in[twaLeft,twaMiddle,twaRight] then Y := (Y1+Y2)/2 else - if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then Y := Y2; - if AAlign in[twaLeft,twaTopLeft,twaBottomLeft] then X := X1 else - if AAlign in[twaTop,twaMiddle,twaBottom] then X := (X1+X2)/2 else - if AAlign in[twaRight,twaTopRight,twaBottomRight] then X := X2; - oldOrientation:= Orientation; - Orientation:= 0; - DrawTextWordBreak(ADest,ATextUTF8,X,Y,X2-X1,AAlign); - Orientation:= oldOrientation; -end; - -procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; - ATopLeft, ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment); -begin - DrawTextRect(ADest,ATextUTF8,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign); -end; - -function TBGRAVectorizedFont.GetTextWordBreakGlyphBoxes(ATextUTF8: string; X, Y, - MaxWidth: Single; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; -var ARemains: string; - pos,step: TPointF; - lines: TStringList; - i: integer; - lineShift: single; - oldItalicSlope: single; - tempArray: array of TGlyphBoxes; - tempPos,j: integer; - lineAlignment: TBGRATypeWriterAlignment; -begin - result := nil; - if ATextUTF8 = '' then exit; - - oldItalicSlope:= ItalicSlope; - ItalicSlope := 0; - pos := PointF(X,Y); - step := TypeWriterMatrix*PointF(0,1); - ItalicSlope := oldItalicSlope; - - if AAlign in[twaTop,twaMiddle,twaBottom] then - lineAlignment := twaMiddle - else if AAlign in[twaTopLeft,twaLeft,twaBottomLeft] then - begin - if ItalicSlope < 0 then - lineAlignment:= twaTopLeft - else - lineAlignment := twaBottomLeft; - end else - begin - if ItalicSlope < 0 then - lineAlignment := twaBottomRight - else - lineAlignment := twaTopRight; - end; - - lines := TStringList.Create; - repeat - SplitText(ATextUTF8, MaxWidth, ARemains); - lines.Add(ATextUTF8); - ATextUTF8 := ARemains; - until ARemains = ''; - - if AAlign in[twaLeft,twaMiddle,twaRight] then lineShift := lines.Count/2-0.5 - else if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then lineShift := lines.Count-0.5 - else lineShift := -0.5; - - case lineAlignment of - twaMiddle: ; - twaBottomLeft, twaBottomRight: DecF(lineShift, 0.5); - twaTopRight,twaTopLeft : IncF(lineShift, 0.5); - end; - - pos.Offset(step*(-lineShift)); - setlength(tempArray, lines.Count); - tempPos := 0; - for i := 0 to lines.Count-1 do - begin - tempArray[i] := GetTextGlyphBoxes(lines[i],pos.X,pos.Y,lineAlignment); - inc(tempPos, length(tempArray[i])); - pos.Offset(step); - end; - lines.Free; - setlength(result, tempPos); - tempPos := 0; - for i := 0 to high(tempArray) do - for j := 0 to high(tempArray[i]) do - begin - result[tempPos] := tempArray[i][j]; - inc(tempPos); - end; -end; - -function TBGRAVectorizedFont.GetTextRectGlyphBoxes(ATextUTF8: string; X1, Y1, X2, - Y2: Single; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; -var X,Y,oldOrientation: single; -begin - if X2 <= X1 then - begin - result := nil; - exit; - end; - if AAlign in[twaTopLeft,twaTop,twaTopRight] then Y := Y1 else - if AAlign in[twaLeft,twaMiddle,twaRight] then Y := (Y1+Y2)/2 else - if AAlign in[twaBottomLeft,twaBottom,twaBottomRight] then Y := Y2; - if AAlign in[twaLeft,twaTopLeft,twaBottomLeft] then X := X1 else - if AAlign in[twaTop,twaMiddle,twaBottom] then X := (X1+X2)/2 else - if AAlign in[twaRight,twaTopRight,twaBottomRight] then X := X2; - oldOrientation:= Orientation; - Orientation:= 0; - result := GetTextWordBreakGlyphBoxes(ATextUTF8,X,Y,X2-X1,AAlign); - Orientation:= oldOrientation; -end; - -function TBGRAVectorizedFont.GetTextRectGlyphBoxes(ATextUTF8: string; ATopLeft, - ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes; -begin - result := GetTextRectGlyphBoxes(ATextUTF8,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign); -end; - -procedure TBGRAVectorizedFont.UpdateDirectory; -var - NbFiles: integer; - SearchRec: TSearchRec; - Info: TBGRAGlyphsInfo; - Fullname: string; -begin - NbFiles := 0; - FDirectoryContent := nil; - if FDirectory = '' then exit; - if (length(FDirectory) > 0) and not (FDirectory[length(FDirectory)] in AllowDirectorySeparators) then - AppendStr(FDirectory, DirectorySeparator); - if FindFirstUTF8(FDirectory +'*.glyphs', faAnyFile, SearchRec) = 0 then - repeat - {$PUSH}{$WARNINGS OFF} - if (faDirectory or faVolumeId or faSysFile) and SearchRec.Attr = 0 then - {$POP} - begin - Fullname := FDirectory+SearchRec.Name; - Info := LoadGlyphsInfo(Fullname); - if (info.Name <> '') and (info.NbGlyphs > 0) then - begin - if NbFiles = length(FDirectoryContent) then - setlength(FDirectoryContent,2*NbFiles+1); - FDirectoryContent[NbFiles].Filename:= Fullname; - FDirectoryContent[NbFiles].FontName:= info.Name; - FDirectoryContent[NbFiles].FontStyle:= info.Style; - inc(NbFiles); - end; - end; - until FindNext(SearchRec) <> 0; - FindClose(SearchRec); - SetLength(FDirectoryContent,NbFiles); -end; - -function TBGRAVectorizedFont.LoadGlyphsInfo(AFilenameUTF8: string): TBGRAGlyphsInfo; -var Stream: TFileStreamUTF8; - twHeader: TBGRACustomTypeWriterHeader; - vfHeader: TBGRAVectorizedFontHeader; -begin - result.Name := ''; - result.NbGlyphs := 0; - result.Style := []; - Stream := nil; - try - Stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead); - Stream.Position := 4; - twHeader := ReadCustomTypeWriterHeader(Stream); - result.NbGlyphs := twHeader.NbGlyphs; - if twHeader.HeaderName = HeaderName then - begin - vfHeader := ReadVectorizedFontHeader(Stream); - result.Name := vfHeader.Name; - result.Style:= vfHeader.Style; - end; - except - on ex:exception do - begin - - end; - end; - Stream.Free; -end; - -function TBGRAVectorizedFont.GetGlyph(AIdentifier: string): TBGRAGlyph; -var size: TSize; - g: TBGRAPolygonalGlyph; - pts: array of TPointF; - dx,dy: Integer; -begin - Result:=inherited GetGlyph(AIdentifier); - if (result = nil) and (FResolution > 0) and (FFont <> nil) then - begin - g := TBGRAPolygonalGlyph.Create(AIdentifier); - size := BGRATextSize(FFont, fqSystem, AIdentifier, 1); - dx := FResolution div 2; - dy := FResolution div 2; - FBuffer.SetSize(size.cx+2*dx,FResolution+2*dy); - FBuffer.Fill(BGRAWhite); - BGRATextOut(FBuffer, FFont, fqSystem, dx,dy, AIdentifier, BGRABlack, nil, taLeftJustify); - pts := VectorizeMonochrome(FBuffer,1/FResolution,False,true,50); - g.SetPoints(pts); - g.QuadraticCurves := FQuadraticCurves; - g.Width := size.cx/FResolution; - g.Height := 1; - g.Offset := PointF(-dx/FResolution,-dy/FResolution); - SetGlyph(AIdentifier,g); - result := g; - end else - if (result <> nil) and (result is TBGRAPolygonalGlyph) then - TBGRAPolygonalGlyph(result).QuadraticCurves := FQuadraticCurves; -end; - -procedure TBGRAVectorizedFont.DefaultWordBreakHandler(var ABefore,AAfter: string); -begin - BGRADefaultWordBreakHandler(ABefore,AAfter); -end; - -procedure TBGRAVectorizedFont.Init(AVectorize: boolean); -begin - FName := 'Arial'; - FStyle := []; - FFontMatrix := AffineMatrixIdentity; - FOrientation := 0; - FResolution := 100; - FFontEmHeightRatio := 1; - FFontEmHeightRatioComputed := false; - if AVectorize then - FFont := TFont.Create - else - FFont := nil; - FBuffer := BGRABitmapFactory.Create; - FFullHeight := 20; - FItalicSlope := 0; - LigatureWithF := true; - UpdateFont; - UpdateMatrix; - FWordBreakHandler:= nil; -end; - -function TBGRAVectorizedFont.CustomHeaderSize: integer; -begin - Result:= (inherited CustomHeaderSize) + 4+length(FName)+4 + sizeof(single) + 4 + 5*4; -end; - -procedure TBGRAVectorizedFont.WriteCustomHeader(AStream: TStream); -var metric: TFontPixelMetric; -begin - inherited WriteCustomHeader(AStream); - LEWriteLongint(AStream, length(FName)); - AStream.Write(FName[1],length(FName)); - LEWriteLongint(AStream, integer(FStyle)); - LEWriteSingle(AStream, FontEmHeightRatio); - LEWriteLongint(AStream, Resolution); - metric := FontPixelMetric; - LEWriteLongint(AStream, metric.Baseline); - LEWriteLongint(AStream, metric.xLine); - LEWriteLongint(AStream, metric.CapLine); - LEWriteLongint(AStream, metric.DescentLine); - LEWriteLongint(AStream, metric.Lineheight); -end; - -procedure TBGRAVectorizedFont.ReadAdditionalHeader(AStream: TStream); -var Header: TBGRAVectorizedFontHeader; -begin - inherited ReadAdditionalHeader(AStream); - Header := ReadVectorizedFontHeader(AStream); - FName := Header.Name; - FStyle := Header.Style; - if header.EmHeightRatio <> 0 then - begin - FFontEmHeightRatio := Header.EmHeightRatio; - FFontEmHeightRatioComputed := true; - end else - begin - FFontEmHeightRatio := 1; - FFontEmHeightRatioComputed := false; - end; - FFontPixelMetric := Header.PixelMetric; - FFontPixelMetricComputed := True; - if FFont = nil then - FResolution := Header.Resolution; -end; - -function TBGRAVectorizedFont.ReadVectorizedFontHeader(AStream: TStream): TBGRAVectorizedFontHeader; -var lNameLength: integer; -begin - lNameLength := LEReadLongint(AStream); - setlength(result.Name, lNameLength); - AStream.Read(result.Name[1],length(result.Name)); - result.Style := TFontStyles(LEReadLongint(AStream)); - result.EmHeightRatio:= LEReadSingle(AStream); - result.Resolution := LEReadLongint(AStream); - result.PixelMetric.Baseline := LEReadLongint(AStream); - result.PixelMetric.xLine := LEReadLongint(AStream); - result.PixelMetric.CapLine := LEReadLongint(AStream); - result.PixelMetric.DescentLine := LEReadLongint(AStream); - result.PixelMetric.Lineheight := LEReadLongint(AStream); - result.PixelMetric.Defined := result.PixelMetric.Lineheight > 0; -end; - -function TBGRAVectorizedFont.HeaderName: string; -begin - Result:= 'TBGRAVectorizedFont'; -end; - -procedure TBGRAVectorizedFont.SetDirectory(const AValue: string); -begin - if Trim(AValue) = Trim(FDirectory) then exit; - FDirectory := Trim(AValue); - UpdateDirectory; - UpdateFont; -end; - -function TBGRAVectorizedFont.ComputeKerning(AIdLeft, AIdRight: string): single; -var - together: String; -begin - if Resolution = 0 then exit(0); - if IsRightToLeftUTF8(AIdLeft) then - begin - if IsRightToLeftUTF8(AIdRight) then - together := AIdRight + AIdLeft - else - together := UTF8OverrideDirection(AIdRight + AIdLeft, true); - end else - together := AIdLeft + AIdRight; - result := BGRATextSize(FFont, fqSystem, together, 1).cx/Resolution - - Glyph[AIdLeft].Width - Glyph[AIdRight].Width; -end; - -end. - diff --git a/components/bgrabitmap/bgrawinbitmap.pas b/components/bgrabitmap/bgrawinbitmap.pas deleted file mode 100644 index 10bc5fb..0000000 --- a/components/bgrabitmap/bgrawinbitmap.pas +++ /dev/null @@ -1,263 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - /**************************************************************************\ - bgrawinbitmap.pas - ----------------- - This unit should NOT be added to the 'uses' clause. - It contains accelerations for Windows. Notably, it - provides direct access to bitmap data. -} - -unit BGRAWinBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRALCLBitmap, Windows, Graphics, GraphType; - -type - { TBGRAWinBitmap } - - TBGRAWinBitmap = class(TBGRALCLBitmap) - private - procedure AlphaCorrectionNeeded; - protected - DIB_SectionHandle: HBITMAP; - FReversed: boolean; - function DIBitmapInfo(AWidth, AHeight: integer): TBitmapInfo; - - procedure ReallocData; override; - procedure FreeData; override; - - procedure RebuildBitmap; override; - procedure FreeBitmap; override; - - procedure Init; override; - function GetBitmap: TBitmap; override; - - public - procedure LoadFromBitmapIfNeeded; override; - procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean=True); overload; override; - procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; override; - procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer; - ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override; - procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override; - end; - -implementation - -uses BGRADefaultBitmap, BGRABitmapTypes; - -type - { TWinBitmapTracker } - - TWinBitmapTracker = class(TBitmap) - protected - FUser: TBGRAWinBitmap; - procedure Changed(Sender: TObject); override; - public - constructor Create(AUser: TBGRAWinBitmap); overload; - property User: TBGRAWinBitmap read FUser write FUser; - end; - -procedure TWinBitmapTracker.Changed(Sender: TObject); -begin - if FUser <> nil then - FUser.AlphaCorrectionNeeded; - inherited Changed(Sender); -end; - -constructor TWinBitmapTracker.Create(AUser: TBGRAWinBitmap); -begin - FUser := AUser; - inherited Create; -end; - -{ TBGRAWinBitmap } - -procedure TBGRAWinBitmap.FreeData; -begin - if DIB_SectionHandle <> 0 then - begin - FreeBitmap; - DeleteObject(DIB_SectionHandle); - FDataByte := nil; - DIB_SectionHandle := 0; - end; -end; - -procedure TBGRAWinBitmap.RebuildBitmap; -begin - if FBitmap = nil then - begin - FBitmap := TWinBitmapTracker.Create(nil); - FBitmap.Handle := DIB_SectionHandle; - TWinBitmapTracker(FBitmap).User := self; - end; -end; - -procedure TBGRAWinBitmap.FreeBitmap; -begin - if FBitmap <> nil then - begin - TWinBitmapTracker(FBitmap).User := nil; - FBitmap.ReleaseHandle; - FBitmap.Free; - FBitmap := nil; - end; -end; - -procedure TBGRAWinBitmap.Init; -begin - inherited Init; - FLineOrder := riloBottomToTop; -end; - -function TBGRAWinBitmap.GetBitmap: TBitmap; -begin - Result:=inherited GetBitmap; - if (LineOrder = riloTopToBottom) and not FReversed then - begin - VerticalFlip; - FReversed:= true; - end; -end; - -procedure TBGRAWinBitmap.LoadFromBitmapIfNeeded; -begin - if FReversed then - begin - FReversed := false; - VerticalFlip; - end; - if FAlphaCorrectionNeeded then - begin - DoAlphaCorrection; - end; -end; - -procedure TBGRAWinBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean); -begin - if self = nil then exit; - Draw(ACanvas, BGRAClasses.Rect(x,y,x+Width,y+Height), Opaque); -end; - -procedure TBGRAWinBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean); -var - info: TBITMAPINFO; -begin - if (self = nil) or (Width = 0) or (Height = 0) then exit; - if TBGRAPixel_RGBAOrder then SwapRedBlue; - if Opaque then - begin - info := DIBitmapInfo(Width, Height); - if LineOrder = riloTopToBottom then - StretchDIBits(ACanvas.Handle, Rect.Left, Rect.Bottom, Rect.Right - - Rect.Left, Rect.Top - Rect.Bottom, - 0, 0, Width, Height, Data, info, DIB_RGB_COLORS, SRCCOPY) - else - StretchDIBits(ACanvas.Handle, Rect.Left, Rect.Top, Rect.Right - - Rect.Left, Rect.Bottom - Rect.Top, - 0, 0, Width, Height, Data, info, DIB_RGB_COLORS, SRCCOPY); - end - else - begin - if Empty then exit; - if LineOrder = riloTopToBottom then VerticalFlip; - LoadFromBitmapIfNeeded; - ACanvas.StretchDraw(Rect, Bitmap); - if LineOrder = riloTopToBottom then VerticalFlip; - end; - if TBGRAPixel_RGBAOrder then SwapRedBlue; -end; - -procedure TBGRAWinBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; - AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); -var - info: TBITMAPINFO; - IsFlipped: boolean; - Temp: TBGRAPtrBitmap; -begin - Temp := nil; - IsFlipped := False; - if ALineOrder = riloTopToBottom then - begin - Temp := TBGRAPtrBitmap.Create(AWidth, AHeight, AData); - Temp.VerticalFlip; - IsFlipped := True; - end; - if TBGRAPixel_RGBAOrder then - begin - if Temp = nil then - Temp := TBGRAPtrBitmap.Create(AWidth, AHeight, AData); - Temp.SwapRedBlue; - end; - - info := DIBitmapInfo(AWidth, AHeight); - StretchDIBits(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right - - ARect.Left, ARect.Bottom - ARect.Top, - 0, 0, AWidth, AHeight, AData, info, DIB_RGB_COLORS, SRCCOPY); - - if Temp <> nil then - begin - if TBGRAPixel_RGBAOrder then Temp.SwapRedBlue; - if IsFlipped then - Temp.VerticalFlip; - Temp.Free; - end; -end; - -procedure TBGRAWinBitmap.AlphaCorrectionNeeded; -begin - FAlphaCorrectionNeeded := True; -end; - -function TBGRAWinBitmap.DIBitmapInfo(AWidth, AHeight: integer): TBitmapInfo; -begin - with {%H-}Result.bmiHeader do - begin - biSize := sizeof(Result.bmiHeader); - biWidth := AWidth; - biHeight := AHeight; - biPlanes := 1; - biBitCount := 32; - biCompression := BI_RGB; - biSizeImage := 0; - biXPelsPerMeter := 0; - biYPelsPerMeter := 0; - biClrUsed := 0; - biClrImportant := 0; - end; -end; - -procedure TBGRAWinBitmap.ReallocData; -var - ScreenDC: HDC; - info: TBitmapInfo; -begin - FreeData; - if (Width <> 0) and (Height <> 0) then - begin - ScreenDC := GetDC(0); - info := DIBitmapInfo(Width, Height); - DIB_SectionHandle := CreateDIBSection(ScreenDC, info, DIB_RGB_COLORS, FDataByte, 0, 0); - - if (NbPixels > 0) and (FDataByte = nil) then - raise EOutOfMemory.Create('TBGRAWinBitmap.ReallocBitmap: Windows error ' + - IntToStr(GetLastError)); - - ReleaseDC(0, ScreenDC); - end; - InvalidateBitmap; -end; - -procedure TBGRAWinBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); -begin - self.Canvas.CopyRect(BGRAClasses.rect(0, 0, Width, Height), CanvasSource, - BGRAClasses.rect(X, Y, X + Width, Y + Height)); -end; - -end. - diff --git a/components/bgrabitmap/bgrawinresource.pas b/components/bgrabitmap/bgrawinresource.pas deleted file mode 100644 index 478588d..0000000 --- a/components/bgrabitmap/bgrawinresource.pas +++ /dev/null @@ -1,1165 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAWinResource; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRAMultiFileType, BGRABitmapTypes, BGRAReadBMP; - -const - RT_CURSOR = 1; - RT_BITMAP = 2; - RT_ICON = 3; - - RT_MENU = 4; - RT_DIALOG = 5; - RT_STRING = 6; - RT_FONTDIR = 7; - RT_FONT = 8; - RT_ACCELERATOR = 9; - RT_RCDATA = 10; - RT_MESSAGETABLE = 11; - - RT_GROUP = 11; - RT_GROUP_CURSOR = RT_GROUP + RT_CURSOR; - RT_GROUP_ICON = RT_GROUP + RT_ICON; - - RT_VERSION = 16; - RT_ANICURSOR = 21; - RT_ANIICON = 22; - RT_HTML = 23; - RT_MANIFEST = 24; - - ICON_OR_CURSOR_FILE_ICON_TYPE = 1; - ICON_OR_CURSOR_FILE_CURSOR_TYPE = 2; - -type - TNameOrId = record - Id: integer; - Name: utf8string; - end; - - { TResourceInfo } - - TResourceInfo = object - DataVersion: LongWord; - MemoryFlags: Word; - LanguageId: Word; - Version: LongWord; - Characteristics: LongWord; - procedure SwapIfNecessary; - end; - - TWinResourceContainer = class; - - { TCustomResourceEntry } - - TCustomResourceEntry = class(TMultiFileEntry) - private - class function GetNextEntry(AContainer: TMultiFileContainer; AStream: TStream): TCustomResourceEntry; static; - procedure Serialize(ADestination: TStream); - protected - FTypeNameOrId: TNameOrId; - FEntryNameOrId: TNameOrId; - FResourceInfo: TResourceInfo; - FReferenceCount: integer; - function GetName: utf8string; override; - procedure SetName(AValue: utf8string); override; - function GetId: integer; - procedure SetId(AValue: integer); - function GetTypeId: integer; - function GetTypeName: utf8string; - procedure IncrementReferences; virtual; - procedure DecrementReferences; virtual; - procedure SerializeHeader(ADestination: TStream); virtual; - procedure SerializeData(ADestination: TStream); virtual; abstract; - function GetDataSize: integer; virtual; abstract; - function GetLanguageId: integer; - procedure SetLanguageId(AValue: integer); - public - constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); - function GetStream: TStream; override; - property Id: integer read GetId write SetId; - property TypeName: utf8string read GetTypeName; - property TypeId: integer read GetTypeId; - property LanguageId: integer read GetLanguageId write SetLanguageId; - end; - - { TUnformattedResourceEntry } - - TUnformattedResourceEntry = class(TCustomResourceEntry) - protected - FDataStream: TStream; - function GetFileSize: int64; override; - function GetDataSize: integer; override; - procedure SerializeData(ADestination: TStream); override; - function GetExtension: utf8string; override; - public - constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); - destructor Destroy; override; - function CopyTo(ADestination: TStream): int64; override; - function GetStream: TStream; override; - end; - - { TBitmapResourceEntry } - - TBitmapResourceEntry = class(TUnformattedResourceEntry) - protected - function GetFileSize: int64; override; - function GetExtension: utf8string; override; - public - constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); - function CopyTo(ADestination: TStream): int64; override; - procedure CopyFrom(ASource: TStream); - end; - - { TGroupIconHeader } - - TGroupIconHeader = object - Reserved, ResourceType, ImageCount: Word; - procedure SwapIfNecessary; - end; - TGroupIconDirEntry = packed record - Width, Height, Colors, Reserved: byte; - //stored in little endian - case byte of - 0: (Variable: LongWord; ImageSize: LongWord; ImageId: Word); - 1: (Planes, BitsPerPixel: Word); - 2: (HotSpotX, HotSpotY: Word); - end; - TIconFileDirEntry = packed record - Width, Height, Colors, Reserved: byte; - //stored in little endian - case byte of - 0: (Variable: LongWord; ImageSize: LongWord; ImageOffset: LongWord); - 1: (Planes, BitsPerPixel: Word); - 2: (HotSpotX, HotSpotY: Word); - end; - - { TGroupIconOrCursorEntry } - - TGroupIconOrCursorEntry = class(TCustomResourceEntry) - private - function GetNbIcons: integer; - protected - FGroupIconHeader: TGroupIconHeader; - FDirectory: packed array of TGroupIconDirEntry; - function GetFileSize: int64; override; - function GetDataSize: integer; override; - procedure SerializeData(ADestination: TStream); override; - procedure IncrementReferences; override; - procedure DecrementReferences; override; - function ExpectedResourceType: word; virtual; abstract; - public - constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); - constructor Create(AContainer: TMultiFileContainer; ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); - procedure Clear; - function CopyTo(ADestination: TStream): int64; override; - procedure CopyFrom(ASource: TStream); - property NbIcons: integer read GetNbIcons; - end; - - { TGroupIconEntry } - - TGroupIconEntry = class(TGroupIconOrCursorEntry) - protected - function GetExtension: utf8string; override; - function ExpectedResourceType: word; override; - public - constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); - constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); - end; - - { TGroupCursorEntry } - - TGroupCursorEntry = class(TGroupIconOrCursorEntry) - protected - function GetExtension: utf8string; override; - function ExpectedResourceType: word; override; - public - constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; ADataStream: TStream); - constructor Create(AContainer: TMultiFileContainer; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); - end; - - { TWinResourceContainer } - - TWinResourceContainer = class(TMultiFileContainer) - private - function InternalFind(const AEntry: TNameOrId; const AType: TNameOrId; ALanguageId: integer = 0): TCustomResourceEntry; - procedure AddHidden(AEntry: TCustomResourceEntry); - function GetMaxId(AType: TNameOrId): integer; - procedure IncrementReferenceOf(ANameId, ATypeId: integer); - procedure DecrementReferenceOf(ANameId, ATypeId: integer); - protected - FHiddenEntries: TMultiFileEntryList; - procedure Init; override; - procedure ClearHiddenEntries; - procedure RemoveHidden(AEntry: TCustomResourceEntry); - function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream; ALanguageId: integer): TMultiFileEntry; overload; - function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override; - public - procedure Clear; override; - destructor Destroy; override; - procedure Delete(AIndex: integer); override; - procedure LoadFromStream(AStream: TStream); override; - function IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean = True): integer; override; - function IndexOf(AName: utf8string; AExtenstion: utf8string; ALanguageId: integer; ACaseSensitive: boolean = True): integer; overload; - procedure SaveToStream(ADestination: TStream); override; - end; - -implementation - -uses Math, BGRAUTF8; - -operator =(const ANameOrId1, ANameOrId2: TNameOrId): boolean; -begin - if (ANameOrId1.Id < 0) then - result := (ANameOrId2.Id < 0) and (ANameOrId2.Name = ANameOrId1.Name) - else - result := ANameOrId2.Id = ANameOrId1.Id; -end; - -function NameOrId(AName: string): TNameOrId; overload; -begin - result.Id := -1; - result.Name := AName; -end; - -function NameOrId(AId: integer): TNameOrId; overload; -begin - result.Id := AId; - result.Name := IntToStr(AId); -end; - -{ TGroupCursorEntry } - -function TGroupCursorEntry.GetExtension: utf8string; -begin - Result:= 'cur'; -end; - -function TGroupCursorEntry.ExpectedResourceType: word; -begin - result := ICON_OR_CURSOR_FILE_CURSOR_TYPE; -end; - -constructor TGroupCursorEntry.Create(AContainer: TMultiFileContainer; - AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; - ADataStream: TStream); -begin - inherited Create(AContainer,NameOrId(RT_GROUP_CURSOR),AEntryNameOrId,AResourceInfo,ADataStream); -end; - -constructor TGroupCursorEntry.Create(AContainer: TMultiFileContainer; - AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); -begin - inherited Create(AContainer,NameOrId(RT_GROUP_CURSOR),AEntryNameOrId,AResourceInfo); -end; - -{ TGroupIconEntry } - -function TGroupIconEntry.GetExtension: utf8string; -begin - Result:= 'ico'; -end; - -function TGroupIconEntry.ExpectedResourceType: word; -begin - result := ICON_OR_CURSOR_FILE_ICON_TYPE; -end; - -constructor TGroupIconEntry.Create(AContainer: TMultiFileContainer; - AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; - ADataStream: TStream); -begin - inherited Create(AContainer,NameOrId(RT_GROUP_ICON),AEntryNameOrId,AResourceInfo,ADataStream); -end; - -constructor TGroupIconEntry.Create(AContainer: TMultiFileContainer; - AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo); -begin - inherited Create(AContainer,NameOrId(RT_GROUP_ICON),AEntryNameOrId,AResourceInfo); -end; - -{ TGroupIconHeader } - -procedure TGroupIconHeader.SwapIfNecessary; -begin - Reserved := LEtoN(Reserved); - ResourceType := LEtoN(ResourceType); - ImageCount := LEtoN(ImageCount); -end; - -{ TGroupIconOrCursorEntry } - -function TGroupIconOrCursorEntry.GetNbIcons: integer; -begin - result := FGroupIconHeader.ImageCount; -end; - -function TGroupIconOrCursorEntry.GetFileSize: int64; -var - i: Integer; -begin - Result:= sizeof(FGroupIconHeader) + sizeof(TIconFileDirEntry)*NbIcons; - for i := 0 to NbIcons-1 do - inc(Result, LEtoN(FDirectory[i].ImageSize) ); -end; - -function TGroupIconOrCursorEntry.GetDataSize: integer; -begin - result := sizeof(FGroupIconHeader) + sizeof(TGroupIconDirEntry)*NbIcons; -end; - -procedure TGroupIconOrCursorEntry.SerializeData(ADestination: TStream); -begin - FGroupIconHeader.SwapIfNecessary; - try - ADestination.WriteBuffer(FGroupIconHeader, sizeof(FGroupIconHeader)); - finally - FGroupIconHeader.SwapIfNecessary; - end; - ADestination.WriteBuffer(FDirectory[0], sizeof(TGroupIconDirEntry)*NbIcons); -end; - -procedure TGroupIconOrCursorEntry.IncrementReferences; -var - i: Integer; -begin - for i := 0 to NbIcons-1 do - TWinResourceContainer(Container).IncrementReferenceOf(LEtoN(FDirectory[i].ImageId), TypeId - RT_GROUP); -end; - -procedure TGroupIconOrCursorEntry.DecrementReferences; -var - i: Integer; -begin - for i := 0 to NbIcons-1 do - TWinResourceContainer(Container).DecrementReferenceOf(LEtoN(FDirectory[i].ImageId), TypeId - RT_GROUP); -end; - -constructor TGroupIconOrCursorEntry.Create(AContainer: TMultiFileContainer; - ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; - ADataStream: TStream); -begin - inherited Create(AContainer,ATypeNameOrId,AEntryNameOrId,AResourceInfo); - - ADataStream.ReadBuffer(FGroupIconHeader, sizeof(FGroupIconHeader)); - FGroupIconHeader.SwapIfNecessary; - if FGroupIconHeader.ResourceType <> ExpectedResourceType then - raise exception.Create('Unexpected group type'); - - if ADataStream.Position + NbIcons*sizeof(TGroupIconDirEntry) > ADataStream.Size then - raise exception.Create('Directory dimension mismatch'); - setlength(FDirectory, NbIcons); - ADataStream.ReadBuffer(FDirectory[0], NbIcons*sizeof(TGroupIconDirEntry)); - ADataStream.Free; -end; - -constructor TGroupIconOrCursorEntry.Create(AContainer: TMultiFileContainer; - ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; - const AResourceInfo: TResourceInfo); -begin - inherited Create(AContainer,ATypeNameOrId,AEntryNameOrId,AResourceInfo); - - FGroupIconHeader.Reserved := 0; - FGroupIconHeader.ResourceType := ExpectedResourceType; - FGroupIconHeader.ImageCount := 0; -end; - -procedure TGroupIconOrCursorEntry.Clear; -begin - DecrementReferences; - FDirectory := nil; - FGroupIconHeader.ImageCount := 0; -end; - -function TGroupIconOrCursorEntry.CopyTo(ADestination: TStream): int64; -var - fileDir: packed array of TIconFileDirEntry; - offset, written, i: integer; - iconEntry: TCustomResourceEntry; - iconEntrySize: LongWord; - iconData: TMemoryStream; - copyCount: Int64; - subType: TNameOrId; - - procedure FillZero(ACount: integer); - var - Zero: packed array[0..255] of byte; - begin - if ACount <= 0 then exit; - FillChar({%H-}Zero, Sizeof(Zero), 0); - while ACount > 0 do - begin - ADestination.WriteBuffer(Zero, Min(ACount, sizeof(Zero))); - Dec(ACount, Min(ACount, sizeof(Zero))); - end; - end; - -begin - result:= 0; - FGroupIconHeader.SwapIfNecessary; - try - ADestination.WriteBuffer(FGroupIconHeader, sizeof(FGroupIconHeader)); - finally - FGroupIconHeader.SwapIfNecessary; - end; - Inc(result, sizeof(FGroupIconHeader)); - - offset := result+sizeof(TIconFileDirEntry)*NbIcons; - setlength(fileDir, NbIcons); - for i := 0 to NbIcons-1 do - begin - move(FDirectory[i], fileDir[i], 12); - fileDir[i].ImageOffset := NtoLE(offset); - inc(offset, fileDir[i].ImageSize); - end; - - ADestination.WriteBuffer(fileDir[0], sizeof(TIconFileDirEntry)*NbIcons); - inc(result, sizeof(TIconFileDirEntry)*NbIcons); - - subType := NameOrId(TypeId - RT_GROUP); - for i := 0 to NbIcons-1 do - begin - iconEntry := (Container as TWinResourceContainer).InternalFind(NameOrId(LEtoN(FDirectory[i].ImageId)),subType); //no language for icons - iconEntrySize := LEtoN(FDirectory[i].ImageSize); - if iconEntry = nil then - FillZero(iconEntrySize) else - begin - iconData := TMemoryStream.Create; - try - iconEntry.CopyTo(IconData); - iconData.Position:= 0; - copyCount := Min(IconData.Size, iconEntrySize); - if copyCount > 0 then written := ADestination.CopyFrom(IconData, copyCount) - else written := 0; - FillZero(iconEntrySize-written); - finally - IconData.Free; - end; - end; - inc(result, iconEntrySize); - end; -end; - -procedure TGroupIconOrCursorEntry.CopyFrom(ASource: TStream); -var - tempGroup: TGroupIconHeader; - fileDir: packed array of TIconFileDirEntry; - iconStream: array of TMemoryStream; - startPos: int64; - maxId, i: integer; - iconEntry: TUnformattedResourceEntry; - resourceInfo: TResourceInfo; - subType: TNameOrId; -begin - startPos := ASource.Position; - ASource.ReadBuffer({%H-}tempGroup, sizeof(tempGroup)); - tempGroup.SwapIfNecessary; - if tempGroup.ResourceType <> ExpectedResourceType then - raise exception.Create('Unexpected resource type'); - - if ASource.Position + sizeof(TIconFileDirEntry)*tempGroup.ImageCount > ASource.Size then - raise exception.Create('Directory dimension mismatch'); - - setlength(fileDir, tempGroup.ImageCount); - ASource.ReadBuffer(fileDir[0], sizeof(TIconFileDirEntry)*tempGroup.ImageCount); - - try - setlength(iconStream, tempGroup.ImageCount); - for i := 0 to tempGroup.ImageCount-1 do - begin - ASource.Position:= startPos + LEtoN(fileDir[i].ImageOffset); - iconStream[i] := TMemoryStream.Create; - iconStream[i].CopyFrom(ASource, LEtoN(fileDir[i].ImageSize)); - end; - - subType := NameOrId(self.TypeId - RT_GROUP); - maxId := TWinResourceContainer(Container).GetMaxId(subType); - - Clear; - FGroupIconHeader.ImageCount := tempGroup.ImageCount; - setlength(FDirectory, tempGroup.ImageCount); - fillchar({%H-}resourceInfo,sizeof(resourceInfo),0); - for i := 0 to tempGroup.ImageCount-1 do - begin - move(fileDir[i], FDirectory[i], 12); - inc(maxId); - FDirectory[i].ImageId := maxId; - iconEntry := TUnformattedResourceEntry.Create(Container, subType, NameOrId(maxId), resourceInfo, iconStream[i]); - iconStream[i] := nil; - TWinResourceContainer(Container).AddHidden(iconEntry); - end; - - finally - for i := 0 to high(iconStream) do - iconStream[i].Free; - iconStream := nil; - end; -end; - -{ TBitmapResourceEntry } - -function TBitmapResourceEntry.GetFileSize: int64; -begin - result := sizeof(TBitMapFileHeader)+FDataStream.Size; -end; - -function TBitmapResourceEntry.GetExtension: utf8string; -begin - Result:= 'bmp'; -end; - -constructor TBitmapResourceEntry.Create(AContainer: TMultiFileContainer; - AEntryNameOrId: TNameOrId; const AResourceInfo: TResourceInfo; - ADataStream: TStream); -begin - inherited Create(AContainer, NameOrId(RT_BITMAP), AEntryNameOrId, AResourceInfo, ADataStream); -end; - -function TBitmapResourceEntry.CopyTo(ADestination: TStream): int64; -var fileHeader: TBitMapFileHeader; -begin - result := 0; - FDataStream.Position := 0; - fileHeader := MakeBitmapFileHeader(FDataStream); - ADestination.WriteBuffer(fileHeader, sizeof(fileHeader)); - inc(result, sizeof(fileHeader) ); - FDataStream.Position := 0; - inc(result, ADestination.CopyFrom(FDataStream, FDataStream.Size) ); -end; - -procedure TBitmapResourceEntry.CopyFrom(ASource: TStream); -var - fileHeader: TBitMapFileHeader; - dataSize: integer; -begin - ASource.ReadBuffer({%H-}fileHeader, sizeof(fileHeader)); - if fileHeader.bfType <> Word('BM') then - raise exception.Create('Invalid file header'); - dataSize := LEtoN(fileHeader.bfSize) - sizeof(fileHeader); - if ASource.Position + dataSize > ASource.Size then - raise exception.Create('Invalid file size'); - - FDataStream.Free; - FDataStream := TMemoryStream.Create; - FDataStream.CopyFrom(ASource, dataSize); -end; - -{ TUnformattedResourceEntry } - -function TUnformattedResourceEntry.GetFileSize: int64; -begin - Result:= FDataStream.Size; -end; - -function TUnformattedResourceEntry.GetDataSize: integer; -begin - result := FDataStream.Size; -end; - -procedure TUnformattedResourceEntry.SerializeData(ADestination: TStream); -begin - if FDataStream.Size > 0 then - begin - FDataStream.Position := 0; - ADestination.CopyFrom(FDataStream, FDataStream.Size); - end; -end; - -function TUnformattedResourceEntry.GetExtension: utf8string; -var format: TBGRAImageFormat; -begin - case TypeId of - RT_MANIFEST: result := 'manifest'; - RT_HTML: result := 'html'; - RT_RCDATA: - begin - FDataStream.Position:= 0; - format := DetectFileFormat(FDataStream); - if format = ifUnknown then - result := 'dat' - else - result := SuggestImageExtension(format); - end; - RT_ANICURSOR: result := 'ani'; - else - if TypeName = 'ANICURSOR' then - result := 'ani' - else - result := ''; - end; -end; - -constructor TUnformattedResourceEntry.Create(AContainer: TMultiFileContainer; - ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; - const AResourceInfo: TResourceInfo; ADataStream: TStream); -begin - inherited Create(AContainer,ATypeNameOrId,AEntryNameOrId,AResourceInfo); - FDataStream := ADataStream; -end; - -destructor TUnformattedResourceEntry.Destroy; -begin - FreeAndNil(FDataStream); - inherited Destroy; -end; - -function TUnformattedResourceEntry.CopyTo(ADestination: TStream): int64; -begin - if FDataStream.Size > 0 then - begin - FDataStream.Position := 0; - result := ADestination.CopyFrom(FDataStream, FDataStream.Size) - end - else - result := 0; -end; - -function TUnformattedResourceEntry.GetStream: TStream; -begin - Result:= FDataStream; -end; - -{ TResourceInfo } - -procedure TResourceInfo.SwapIfNecessary; -begin - DataVersion := LEtoN(DataVersion); - MemoryFlags := LEtoN(MemoryFlags); - LanguageId := LEtoN(LanguageId); - Version := LEtoN(Version); - Characteristics := LEtoN(Characteristics); -end; - -{ TCustomResourceEntry } - -function TCustomResourceEntry.GetId: integer; -begin - result := FEntryNameOrId.Id; -end; - -function TCustomResourceEntry.GetTypeId: integer; -begin - result := FTypeNameOrId.Id; -end; - -function GetDWord(var ASource: PByte; var ARemainingBytes: Integer): LongWord; -begin - if ARemainingBytes >= 4 then - begin - result := LEtoN(PLongWord(ASource)^); - inc(ASource, 4); - dec(ARemainingBytes, 4); - end else - begin - result := 0; - inc(ASource, ARemainingBytes); - ARemainingBytes:= 0; - end; -end; - -function GetWord(var ASource: PByte; var ARemainingBytes: Integer): Word; -begin - if ARemainingBytes >= 2 then - begin - result := LEtoN(PWord(ASource)^); - inc(ASource, 2); - dec(ARemainingBytes, 2); - end else - begin - result := 0; - inc(ASource, ARemainingBytes); - ARemainingBytes:= 0; - end; -end; - -function GetNameOrId(var ASource: PByte; var ARemainingBytes: Integer): TNameOrId; -var curChar: Word; - pstart: PByte; -begin - pstart := ASource; - curChar := GetWord(ASource,ARemainingBytes); - if curChar = $ffff then - begin - result.Id := GetWord(ASource,ARemainingBytes); - result.Name := IntToStr(result.Id); - end else - begin - while curChar <> 0 do - curChar := GetWord(ASource,ARemainingBytes); - result.Id := -1; - result.Name := UTF8Encode(WideCharLenToString(PWideChar(pstart), (ASource-pstart) div 2 -1)); - end; -end; - -function TCustomResourceEntry.GetLanguageId: integer; -begin - result := FResourceInfo.LanguageId; -end; - -class function TCustomResourceEntry.GetNextEntry(AContainer: TMultiFileContainer; AStream: TStream): TCustomResourceEntry; -var - entrySize, headerSize, remaining, padding: Integer; - headerData: Pointer; - pHeaderData: PByte; - typeNameOrId: TNameOrId; - entryNameOrId: TNameOrId; - info: TResourceInfo; - dataStream: TMemoryStream; - dummy: LongWord; -begin - result := nil; - if AStream.Position + 16 < AStream.Size then - begin - entrySize := LEtoN(AStream.ReadDWord); - headerSize := LEtoN(AStream.ReadDWord); - if headerSize < 16 then - raise exception.Create('Header too small'); - remaining := ((headerSize-8) + 3) and not 3; - if AStream.Position + remaining + entrySize > AStream.Size then - raise exception.Create('Data would be outside of stream'); - - GetMem(headerData, remaining); - try - AStream.ReadBuffer(headerData^, remaining); - pHeaderData := PByte(headerData); - typeNameOrId := GetNameOrId(pHeaderData, remaining); - entryNameOrId := GetNameOrId(pHeaderData, remaining); - padding := (4 - (PtrUInt(pHeaderData-PByte(headerData)) and 3)) and 3; - inc(pHeaderData, padding); - dec(remaining, padding); - - FillChar({%H-}info, SizeOf(info), 0); - Move(pHeaderData^, info, Min(Sizeof(info), remaining)); - info.SwapIfNecessary; - - dataStream := TMemoryStream.Create; - if entrySize > 0 then dataStream.CopyFrom(AStream, entrySize); - padding := ((entrySize+3) and not 3) - entrySize; - if padding > 0 then AStream.Read({%H-}dummy, padding); - finally - FreeMem(headerData); - end; - - dataStream.Position := 0; - case typeNameOrId.Id of - RT_BITMAP: result := TBitmapResourceEntry.Create(AContainer,entryNameOrId,info,dataStream); - RT_GROUP_ICON: result := TGroupIconEntry.Create(AContainer,entryNameOrId,info,dataStream); - RT_GROUP_CURSOR: result := TGroupCursorEntry.Create(AContainer,entryNameOrId,info,dataStream); - else - result := TUnformattedResourceEntry.Create(AContainer,typeNameOrId,entryNameOrId,info,dataStream); - end; - end; -end; - -procedure WriteNameOrId(ADestination: TStream; ANameOrId: TNameOrId); -var buffer: PUnicodeChar; - maxLen,actualLen: integer; -begin - if ANameOrId.Id < 0 then - begin - maxLen := length(ANameOrId.Name)*2 + 1; - getmem(buffer, maxLen*sizeof(UnicodeChar)); - try - fillchar(buffer^, maxLen*sizeof(UnicodeChar), 0); - actualLen := Utf8ToUnicode(buffer, maxLen, @ANameOrId.Name[1], length(ANameOrId.Name)); - ADestination.WriteBuffer(buffer^, actualLen*sizeof(UnicodeChar)); - finally - freemem(buffer); - end; - end else - begin - ADestination.WriteWord($ffff); - ADestination.WriteWord(NtoLE(Word(ANameOrId.Id))); - end; -end; - -procedure TCustomResourceEntry.Serialize(ADestination: TStream); -var zero: LongWord; - padding: integer; -begin - SerializeHeader(ADestination); - SerializeData(ADestination); - padding := (4-(GetDataSize and 3)) and 3; - if padding > 0 then - begin - zero := 0; - ADestination.WriteBuffer(zero, padding); - end; -end; - -procedure TCustomResourceEntry.SetLanguageId(AValue: integer); -begin - if (AValue >= 0) and (AValue <= 65535) then - begin - if AValue = LanguageId then exit; - if FTypeNameOrId.Id >= 0 then - begin - if TWinResourceContainer(Container).InternalFind(FEntryNameOrId, FTypeNameOrId, AValue) <> nil then - raise exception.Create('Language id already used for this resource'); - end else - raise exception.Create('Language id cannot be specified for custom types'); - FEntryNameOrId.Id := AValue; - FEntryNameOrId.Name := IntToStr(AValue); - end - else - raise ERangeError.Create('Id out of bounds'); -end; - -procedure TCustomResourceEntry.SerializeHeader(ADestination: TStream); -var - entryHeader: record - EntrySize: integer; - HeaderSize: integer; - end; - headerStream: TMemoryStream; -begin - entryHeader.EntrySize := LEtoN(GetDataSize); - headerStream := TMemoryStream.Create; - try - WriteNameOrId(headerStream,FTypeNameOrId); - WriteNameOrId(headerStream,FEntryNameOrId); - if headerStream.Position and 3 = 2 then headerStream.WriteWord(0); - FResourceInfo.SwapIfNecessary; - try - headerStream.WriteBuffer(FResourceInfo, sizeof(FResourceInfo)); - finally - FResourceInfo.SwapIfNecessary; - end; - entryHeader.HeaderSize := LEtoN(integer(headerStream.Size+8)); - headerStream.Position:= 0; - ADestination.WriteBuffer(entryHeader, sizeof(entryHeader)); - ADestination.CopyFrom(headerStream, headerStream.Size); - if headerStream.Size and 3 = 2 then ADestination.WriteWord(0); - finally - headerStream.Free; - end; -end; - -constructor TCustomResourceEntry.Create(AContainer: TMultiFileContainer; - ATypeNameOrId: TNameOrId; AEntryNameOrId: TNameOrId; - const AResourceInfo: TResourceInfo); -begin - inherited Create(AContainer); - FTypeNameOrId := ATypeNameOrId; - FEntryNameOrId := AEntryNameOrId; - FResourceInfo := AResourceInfo; -end; - -function TCustomResourceEntry.GetStream: TStream; -begin - result := nil; - raise exception.Create('Stream not available'); -end; - -procedure TCustomResourceEntry.SetId(AValue: integer); -begin - if (AValue >= 0) and (AValue <= 65535) then - begin - if AValue = FEntryNameOrId.Id then exit; - if TWinResourceContainer(Container).InternalFind(NameOrId(AValue), FTypeNameOrId, LanguageId) <> nil then - raise exception.Create('Id already used for this resource type'); - FEntryNameOrId.Id := AValue; - FEntryNameOrId.Name := IntToStr(AValue); - end - else - raise ERangeError.Create('Id out of bounds'); -end; - -function TCustomResourceEntry.GetName: utf8string; -begin - Result:= FEntryNameOrId.Name; -end; - -procedure TCustomResourceEntry.SetName(AValue: utf8string); -begin - if FEntryNameOrId = NameOrId(AValue) then exit; - if TWinResourceContainer(Container).InternalFind(NameOrId(AValue), FTypeNameOrId, LanguageId) <> nil then - raise exception.Create('Name already used for this resource type'); - FEntryNameOrId.Name := AValue; - FEntryNameOrId.Id := -1; -end; - -function TCustomResourceEntry.GetTypeName: utf8string; -begin - result := FTypeNameOrId.Name; -end; - -procedure TCustomResourceEntry.IncrementReferences; -begin - //nothing -end; - -procedure TCustomResourceEntry.DecrementReferences; -begin - //nothing -end; - -{ TWinResourceContainer } - -procedure TWinResourceContainer.LoadFromStream(AStream: TStream); -var curEntry: TCustomResourceEntry; - i: Integer; -begin - Clear; - repeat - curEntry := TCustomResourceEntry.GetNextEntry(self, AStream); - if curEntry <> nil then - begin - if curEntry.TypeId in [RT_ICON,RT_CURSOR] then - FHiddenEntries.Add(curEntry) - else - AddEntry(curEntry); - end; - until curEntry = nil; - for i := 0 to Count-1 do - TCustomResourceEntry(Entry[i]).IncrementReferences; -end; - -function TWinResourceContainer.IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean): integer; -begin - result := IndexOf(AName, AExtenstion, 0, ACaseSensitive); -end; - -function TWinResourceContainer.IndexOf(AName: utf8string; AExtenstion: utf8string; - ALanguageId: integer; ACaseSensitive: boolean): integer; -var - i: Integer; - entryId, errPos: integer; -begin - if AExtenstion = '' then - begin - result := -1; - exit; - end; - if ACaseSensitive then - begin - for i := 0 to Count-1 do - if (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Id < 0) and - (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Name = AName) and - (UTF8CompareText(Entry[i].Extension,AExtenstion) = 0) and - (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then - begin - result := i; - exit; - end; - end else - for i := 0 to Count-1 do - if (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Id < 0) and - (UTF8CompareText(TCustomResourceEntry(Entry[i]).FEntryNameOrId.Name,AName) = 0) and - (UTF8CompareText(Entry[i].Extension,AExtenstion) = 0) and - (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then - begin - result := i; - exit; - end; - val(AName, entryId, errPos); - if (errPos = 0) and (entryId >= 0) then - begin - for i := 0 to Count-1 do - if (TCustomResourceEntry(Entry[i]).FEntryNameOrId.Id = entryId) and - (UTF8CompareText(Entry[i].Extension,AExtenstion) = 0) and - (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then - begin - result := i; - exit; - end; - end; - result := -1; -end; - -procedure TWinResourceContainer.Init; -begin - inherited Init; - FHiddenEntries := TMultiFileEntryList.Create; -end; - -procedure TWinResourceContainer.ClearHiddenEntries; -var i: integer; -begin - if Assigned(FHiddenEntries) then - begin - for i := 0 to FHiddenEntries.Count-1 do - FHiddenEntries[i].Free; - FHiddenEntries.Clear; - end; -end; - -procedure TWinResourceContainer.RemoveHidden(AEntry: TCustomResourceEntry); -var - index: LongInt; -begin - if Assigned(FHiddenEntries) then - begin - index := FHiddenEntries.IndexOf(AEntry); - if index <> -1 then - begin - AEntry.Free; - FHiddenEntries.Delete(index); - end; - end; -end; - -function TWinResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string; - AContent: TStream; ALanguageId: integer): TMultiFileEntry; -var - resourceInfo: TResourceInfo; - entryName: TNameOrId; - errPos: integer; -begin - FillChar({%H-}resourceInfo, sizeof(resourceInfo), 0); - resourceInfo.LanguageId := ALanguageId; - val(AName, entryName.Id, errPos); - if (errPos = 0) and (entryName.Id >= 0) then - entryName.Name := IntToStr(entryName.Id) - else - begin - entryName.Id := -1; - entryName.Name := AName; - end; - - case UTF8LowerCase(AExtension) of - 'ico': begin - result := TGroupIconEntry.Create(self, entryName, resourceInfo); - AContent.Position:= 0; - TGroupIconEntry(result).CopyFrom(AContent); - AContent.Free; - end; - 'cur': begin - result := TGroupCursorEntry.Create(self, entryName, resourceInfo); - AContent.Position:= 0; - TGroupCursorEntry(result).CopyFrom(AContent); - AContent.Free; - end; - 'bmp': begin - result := TBitmapResourceEntry.Create(self, entryName, resourceInfo, AContent); - AContent.Position:= 0; - TBitmapResourceEntry(result).CopyFrom(AContent); - AContent.Free; - end; - 'dat': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_RCDATA), entryName, resourceInfo, AContent); - 'html','htm': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_HTML), entryName, resourceInfo, AContent); - 'manifest': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_MANIFEST), entryName, resourceInfo, AContent); - 'ani': result := TUnformattedResourceEntry.Create(self, NameOrId(RT_ANICURSOR), entryName, resourceInfo, AContent); - else - case SuggestImageFormat('.'+AExtension) of - ifUnknown: raise exception.Create('Unhandled file extension'); - else - result := TUnformattedResourceEntry.Create(self, NameOrId(RT_RCDATA), entryName, resourceInfo, AContent); - end; - end; -end; - -function TWinResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string; - AContent: TStream): TMultiFileEntry; -begin - result := CreateEntry(AName, AExtension, AContent, 0); -end; - -procedure TWinResourceContainer.Clear; -begin - ClearHiddenEntries; - inherited Clear; -end; - -destructor TWinResourceContainer.Destroy; -begin - ClearHiddenEntries; - FreeAndNil(FHiddenEntries); - inherited Destroy; -end; - -procedure TWinResourceContainer.Delete(AIndex: integer); -begin - if (AIndex >= 0) and (AIndex < Count) then - TCustomResourceEntry(Entry[AIndex]).DecrementReferences; - inherited Delete(AIndex); -end; - -procedure TWinResourceContainer.SaveToStream(ADestination: TStream); -var - i: Integer; -begin - for i := 0 to Count-1 do - TCustomResourceEntry(Entry[i]).Serialize(ADestination); - for i := 0 to FHiddenEntries.Count-1 do - TCustomResourceEntry(FHiddenEntries.Items[i]).Serialize(ADestination); -end; - -function TWinResourceContainer.InternalFind(const AEntry: TNameOrId; - const AType: TNameOrId; ALanguageId: integer): TCustomResourceEntry; -var i: integer; -begin - if Assigned(FHiddenEntries) and (ALanguageId = 0) and (AType.Id >= 0) then - begin - for i := 0 to FHiddenEntries.Count-1 do - if (TCustomResourceEntry(FHiddenEntries.Items[i]).FEntryNameOrId = AEntry) and - (TCustomResourceEntry(FHiddenEntries.Items[i]).FTypeNameOrId = AType) then - begin - result := TCustomResourceEntry(FHiddenEntries.Items[i]); - exit; - end; - end; - for i := 0 to Count-1 do - if (TCustomResourceEntry(Entry[i]).FEntryNameOrId = AEntry) and - (TCustomResourceEntry(Entry[i]).FTypeNameOrId = AType) and - (TCustomResourceEntry(Entry[i]).LanguageId = ALanguageId) then - begin - result := TCustomResourceEntry(Entry[i]); - exit; - end; - result := nil; -end; - -procedure TWinResourceContainer.AddHidden(AEntry: TCustomResourceEntry); -begin - FHiddenEntries.Add(AEntry); -end; - -function TWinResourceContainer.GetMaxId(AType: TNameOrId): integer; -var i: integer; -begin - result := 0; - if Assigned(FHiddenEntries) and (AType.Id >= 0) then - begin - for i := 0 to FHiddenEntries.Count-1 do - if (TCustomResourceEntry(FHiddenEntries.Items[i]).FTypeNameOrId = AType) then - begin - if TCustomResourceEntry(FHiddenEntries.Items[i]).Id > result then result := TCustomResourceEntry(FHiddenEntries.Items[i]).Id; - end; - end; - for i := 0 to Count-1 do - if (TCustomResourceEntry(Entry[i]).FTypeNameOrId = AType) then - begin - if TCustomResourceEntry(Entry[i]).Id > result then result := TCustomResourceEntry(Entry[i]).Id; - end; -end; - -procedure TWinResourceContainer.IncrementReferenceOf(ANameId, ATypeId: integer); -var - item: TCustomResourceEntry; -begin - item := InternalFind(NameOrId(ANameId), NameOrId(ATypeId)); - if Assigned(item) then inc(item.FReferenceCount); -end; - -procedure TWinResourceContainer.DecrementReferenceOf(ANameId, ATypeId: integer); -var - item: TCustomResourceEntry; -begin - item := InternalFind(NameOrId(ANameId), NameOrId(ATypeId)); - if Assigned(item) then - begin - if item.FReferenceCount > 1 then - dec(item.FReferenceCount) - else - RemoveHidden(item); - end; -end; - -end. - diff --git a/components/bgrabitmap/bgrawritebmpmiomap.pas b/components/bgrabitmap/bgrawritebmpmiomap.pas deleted file mode 100644 index 42053ac..0000000 --- a/components/bgrabitmap/bgrawritebmpmiomap.pas +++ /dev/null @@ -1,390 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAWriteBmpMioMap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPimage, BGRABitmapTypes, BGRAReadBmpMioMap; - -type - - { TBGRAWriterBmpMioMap } - - TBGRAWriterBmpMioMap = class (TFPCustomImageWriter) - protected - FHeader: TMioHeader; - FPalette: packed array of record - ColorValue: Word; - AlphaValue: Byte; - Padding: Byte; - end; - FPaletteIndexes: packed array[0..65535] of Int32or64; - FPaletteOffset: Int32or64; - FPaletteAlpha: boolean; - FChunks: array of TMemoryStream; - FCurrentChunk: TMemoryStream; - FMaxChunkSize: Word; - function IndexOfColor(const AColor: TBGRAPixel): Int32or64; - procedure InitHeader(Img: TFPCustomImage); - procedure InitPalette; - procedure InitChunks; - procedure FlushChunk; - procedure FreeChunks; - procedure NeedChunk; - procedure AppendToChunks(const Buffer; Count: integer); - procedure BuildPaletteAndChunks(Img: TFPCustomImage); - procedure WriteHeader(Str: TStream); - procedure WritePalette(Str: TStream); - procedure WriteChunks(Str: TStream); - procedure ReadScanline(Img: TFPCustomImage; Y: integer; ADest: PBGRAPixel); - procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override; - public - constructor Create; override; - property MaxChunkSize: Word read FMaxChunkSize write FMaxChunkSize; - end; - -implementation - -{ TBGRAWriterBmpMioMap } - -function TBGRAWriterBmpMioMap.IndexOfColor(const AColor: TBGRAPixel): Int32or64; -var searchedColorValue: Word; - searchedAlphaValue: Byte; - i,startSearch,endSearch: Int32or64; -begin - searchedColorValue:= BGRAToMioMap(AColor); - searchedAlphaValue:= AlphaToMioMap(AColor.alpha); - if length(FPalette)>0 then - begin - with FPalette[0] do - begin - if (ColorValue = searchedColorValue) and - (AlphaValue = searchedAlphaValue) then - begin - result := 0; - exit; - end; - end; - end; - - startSearch:= FPaletteOffset+1; - endSearch:= FPaletteOffset+$FC; - if endSearch >= FHeader.nbColors then - endSearch:= FHeader.nbColors-1; - for i := startSearch to endSearch do - with FPalette[i] do - begin - if (ColorValue = searchedColorValue) - and (AlphaValue = searchedAlphaValue) then - begin - result := i; - exit; - end; - end; - - result := FPaletteIndexes[searchedColorValue]; - if (result <> -1) and (FPalette[result].AlphaValue <> searchedAlphaValue) then - result := -1; - - if result = -1 then - begin - if fheader.nbColors = 65535 then - raise exception.Create('Too many colors'); - result := fheader.nbColors; - inc(FHeader.nbColors); - if length(FPalette) <= result then - setlength(FPalette, length(FPalette)*2 + 128); - with FPalette[result] do - begin - ColorValue := searchedColorValue; - AlphaValue := searchedAlphaValue; - end; - FPaletteIndexes[searchedColorValue] := result; - if (searchedAlphaValue > 0) and (searchedAlphaValue < 32) then - FPaletteAlpha := true; - end; -end; - -procedure TBGRAWriterBmpMioMap.InitHeader(Img: TFPCustomImage); -begin - if (Img.Width > 65535) or (Img.Height > 65535) then - raise exception.Create('Image too big to be saved in Bmp MioMap format'); - FHeader.magic := MioMapMagicValue; - fheader.format:= 0; - FHeader.width := Img.Width; - FHeader.height := img.Height; - FHeader.nbColors := 0; - FHeader.nbChunks := 0; -end; - -procedure TBGRAWriterBmpMioMap.InitPalette; -var i: Int32or64; -begin - for i := 0 to high(FPaletteIndexes) do - FPaletteIndexes[i] := -1; - FPaletteOffset := 0; - FPaletteAlpha := false; - IndexOfColor(BGRAPixelTransparent); //define transparent color as zero -end; - -procedure TBGRAWriterBmpMioMap.InitChunks; -begin - FCurrentChunk := nil; -end; - -procedure TBGRAWriterBmpMioMap.FlushChunk; -begin - if FCurrentChunk <> nil then - begin - setlength(FChunks, length(FChunks)+1); - FChunks[high(FChunks)] := FCurrentChunk; - FCurrentChunk := nil; - inc(FHeader.nbChunks); - end; -end; - -procedure TBGRAWriterBmpMioMap.FreeChunks; -var - i: Integer; -begin - FreeAndNil(FCurrentChunk); - for i := 0 to high(FChunks) do - FChunks[i].Free; - FChunks := nil; -end; - -procedure TBGRAWriterBmpMioMap.NeedChunk; -begin - if FCurrentChunk = nil then - begin - if FHeader.nbChunks = 65535 then - raise exception.Create('Too many chunks'); - FCurrentChunk := TMemoryStream.Create; - end; -end; - -procedure TBGRAWriterBmpMioMap.AppendToChunks(const Buffer; Count: integer); -begin - if Count > 65535 then - raise exception.Create('Buffer too big'); - NeedChunk; - if FCurrentChunk.Size + Count > MaxChunkSize then - begin - FlushChunk; - NeedChunk; - end; - FCurrentChunk.WriteBuffer(Buffer,Count); -end; - -procedure TBGRAWriterBmpMioMap.BuildPaletteAndChunks(Img: TFPCustomImage); -var y,w: Int32or64; - PData,PDataEnd: PBGRAPixel; - p: PBGRAPixel; - currentColorIndex, - nextColorIndex, - repCount: Int32or64; - b: byte; - changeOfsRec: packed record - valFD: byte; - valLo: byte; - valHi: byte; - end; - repRec: packed record - valFE: byte; - relativeColorIndex: byte; - count: byte; - end; - repZeroRec: packed record - valFF: byte; - count: byte; - end; - -begin - w := Img.Width; - getmem(PData, w*sizeof(TBGRAPixel)); - try - PDataEnd := PData+w; - for y := 0 to Img.Height-1 do - begin - ReadScanline(Img,Y,PData); - p := PData; - while p < PDataEnd do - begin - currentColorIndex:= IndexOfColor(p^); - nextColorIndex := currentColorIndex; - repCount:= 1; - inc(p); - while p < PDataEnd do - begin - nextColorIndex:= IndexOfColor(p^); - if nextColorIndex = currentColorIndex then - begin - inc(p); - inc(repCount); - if repCount = 255 then break; - end - else - break; - end; - if currentColorIndex = 0 then - begin - if repCount = 1 then - begin - b := 0; - AppendToChunks(b,1); - end else - begin - repZeroRec.valFF := $ff; - repZeroRec.count := repCount; - AppendToChunks(repZeroRec, sizeof(repZeroRec)); - end; - end else - begin - if (currentColorIndex < FPaletteOffset+1) - or (currentColorIndex > FPaletteOffset+$FC) then - begin - if (abs(nextColorIndex-currentColorIndex) < $FC) then - begin - FPaletteOffset := (nextColorIndex+currentColorIndex) div 2 - 126; - end else - FPaletteOffset := currentColorIndex-126; - if FPaletteOffset < 0 then FPaletteOffset := 0; - changeOfsRec.valFD := $fd; - changeOfsRec.valLo := FPaletteOffset and 255; - changeOfsRec.valHi := FPaletteOffset shr 8; - AppendToChunks(changeOfsRec,sizeof(changeOfsRec)); - end; - if (currentColorIndex < FPaletteOffset+1) - or (currentColorIndex > FPaletteOffset+$FC) then - raise exception.Create('Index out of range'); - if repCount = 1 then - begin - b := currentColorIndex-FPaletteOffset; - AppendToChunks(b,1); - end else - if repCount = 2 then - begin - b := currentColorIndex-FPaletteOffset; - AppendToChunks(b,1); - AppendToChunks(b,1); - end else - begin - repRec.valFE:= $FE; - repRec.count := repCount; - repRec.relativeColorIndex := currentColorIndex-FPaletteOffset; - AppendToChunks(repRec, sizeof(repRec)); - end; - end; - end; - FlushChunk; - end; - finally - freemem(PData); - end; -end; - -procedure TBGRAWriterBmpMioMap.WriteChunks(Str: TStream); -var - bigChunkDef: packed record - val255: byte; - valHi: byte; - valLo: byte; - end; - i: Int32or64; -begin - for i := 0 to high(FChunks) do - begin - if FChunks[i].Size > 254 then - begin - bigChunkDef.val255 := 255; - bigChunkDef.valHi := FChunks[i].Size shr 8; - bigChunkDef.valLo := FChunks[i].Size and 255; - Str.WriteBuffer(bigChunkDef, sizeof(bigChunkDef)); - end else - Str.WriteByte(FChunks[i].Size); - end; - for i := 0 to high(FChunks) do - begin - FChunks[i].Position := 0; - if Str.CopyFrom(FChunks[i],FChunks[i].Size) <> FChunks[i].Size then - raise exception.Create('Unable to write chunk'); - end; -end; - -procedure TBGRAWriterBmpMioMap.WriteHeader(Str: TStream); -var header: TMioHeader; -begin - if FPaletteAlpha then FHeader.format := 1; - FlushChunk; - - header := FHeader; - header.format:= NtoLE(header.format); - header.width:= NtoLE(header.width); - header.height:= NtoLE(header.height); - header.nbColors:= NtoLE(header.nbColors); - header.nbChunks:= NtoLE(header.nbChunks); - Str.WriteBuffer(header, sizeof(header)); -end; - -procedure TBGRAWriterBmpMioMap.WritePalette(Str: TStream); -var - colors: packed array of Word; - alphas: packed array of byte; - i: Int32or64; -begin - setlength(Colors, FHeader.nbColors); - for i := 0 to FHeader.nbColors-1 do - colors[i] := NtoLE(FPalette[i].ColorValue); - Str.WriteBuffer(colors[0], length(Colors)*sizeof(word)); - if FPaletteAlpha then - begin - setlength(alphas, FHeader.nbColors); - for i := 0 to FHeader.nbColors-1 do - alphas[i] := FPalette[i].AlphaValue; - Str.WriteBuffer(alphas[0], length(alphas)*sizeof(byte)); - end; -end; - -procedure TBGRAWriterBmpMioMap.ReadScanline(Img: TFPCustomImage; Y: integer; - ADest: PBGRAPixel); -var - i: Int32or64; -begin - if Img is TBGRACustomBitmap then - Move(TBGRACustomBitmap(Img).ScanLine[Y]^, ADest^, Img.Width*sizeof(TBGRAPixel)) - else - begin - for i := 0 to Img.Width-1 do - (ADest+i)^ := FPColorToBGRA(Img.Colors[y,i]); - end; -end; - -procedure TBGRAWriterBmpMioMap.InternalWrite(Str: TStream; Img: TFPCustomImage); -begin - try - InitHeader(Img); - InitPalette; - InitChunks; - BuildPaletteAndChunks(Img); - WriteHeader(Str); - WritePalette(Str); - WriteChunks(Str); - finally - FreeChunks; - end; -end; - -constructor TBGRAWriterBmpMioMap.Create; -begin - inherited Create; - MaxChunkSize := 254; -end; - -initialization - - DefaultBGRAImageWriter[ifBmpMioMap] := TBGRAWriterBmpMioMap; - -end. - diff --git a/components/bgrabitmap/bgrawritelzp.pas b/components/bgrabitmap/bgrawritelzp.pas deleted file mode 100644 index cff2638..0000000 --- a/components/bgrabitmap/bgrawritelzp.pas +++ /dev/null @@ -1,430 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAWriteLzp; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPimage, BGRALzpCommon, BGRABitmapTypes, BGRABitmap; - -type - { TBGRAWriterLazPaint } - - TBGRAWriterLazPaint = class(TFPCustomImageWriter) - private - function GetCompression: TLzpCompression; - function GetIncludeThumbnail: boolean; - procedure SetCompression(AValue: TLzpCompression); - procedure SetIncludeThumbnail(AValue: boolean); - function WriteThumbnail(Str: TStream; Img: TFPCustomImage): boolean; - protected - CompressionMode: LongWord; - procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override; - function InternalWriteLayers({%H-}Str: TStream; {%H-}Img: TFPCustomImage): boolean; virtual; - function GetNbLayers: integer; virtual; - public - Caption: string; - constructor Create; override; - class procedure WriteRLEImage(Str: TStream; Img: TFPCustomImage; ACaption: string= ''); static; - property Compression: TLzpCompression read GetCompression write SetCompression; - property IncludeThumbnail: boolean read GetIncludeThumbnail write SetIncludeThumbnail; - end; - -implementation - -uses BGRACompressableBitmap; - -{ TBGRAWriterLazPaint } - -function TBGRAWriterLazPaint.WriteThumbnail(Str: TStream; Img: TFPCustomImage): boolean; -var w,h: integer; - thumbStream: TStream; - OldResampleFilter: TResampleFilter; - thumbnail: TBGRACustomBitmap; -begin - result := false; - if not (Img is TBGRACustomBitmap) then exit; - if (Img.Width > LazpaintThumbMaxWidth) or - (Img.Height > LazpaintThumbMaxHeight) then - begin - if Img.Width > LazpaintThumbMaxWidth then - begin - w := LazpaintThumbMaxWidth; - h := round(Img.Height* (w/Img.Width)); - end else - begin - w := Img.Width; - h := Img.Height; - end; - if h > LazpaintThumbMaxHeight then - begin - h := LazpaintThumbMaxHeight; - w := round(Img.Width* (h/Img.Height)); - end; - OldResampleFilter:= TBGRACustomBitmap(Img).ResampleFilter; - TBGRACustomBitmap(Img).ResampleFilter:= rfMitchell; - thumbnail := TBGRACustomBitmap(Img).Resample(w,h,rmFineResample); - TBGRACustomBitmap(Img).ResampleFilter := OldResampleFilter; - - try - thumbStream := TMemoryStream.Create; - try - thumbnail.SaveToStreamAsPng(thumbStream); - thumbStream.Position:= 0; - Str.CopyFrom(thumbStream, thumbStream.Size); - result := true; - finally - thumbStream.Free; - end; - finally - thumbnail.Free; - end; - end else - begin - thumbStream := TMemoryStream.Create; - try - TBGRACustomBitmap(Img).SaveToStreamAsPng(thumbStream); - thumbStream.Position:= 0; - Str.CopyFrom(thumbStream, thumbStream.Size); - result := true; - finally - thumbStream.Free; - end; - end; -end; - -function TBGRAWriterLazPaint.GetCompression: TLzpCompression; -begin - if (CompressionMode and LAZPAINT_COMPRESSION_MASK) = LAZPAINT_COMPRESSION_MODE_ZSTREAM then - result := lzpZStream - else - result := lzpRLE; -end; - -function TBGRAWriterLazPaint.GetIncludeThumbnail: boolean; -begin - result := (CompressionMode and LAZPAINT_THUMBNAIL_PNG) <> 0; -end; - -procedure TBGRAWriterLazPaint.SetCompression(AValue: TLzpCompression); -begin - if AValue = lzpZStream then - CompressionMode := (CompressionMode and not LAZPAINT_COMPRESSION_MASK) or LAZPAINT_COMPRESSION_MODE_ZSTREAM - else - CompressionMode := (CompressionMode and not LAZPAINT_COMPRESSION_MASK) or LAZPAINT_COMPRESSION_MODE_RLE; -end; - -procedure TBGRAWriterLazPaint.SetIncludeThumbnail(AValue: boolean); -begin - if AValue then - CompressionMode := CompressionMode or LAZPAINT_THUMBNAIL_PNG else - CompressionMode := CompressionMode and not LAZPAINT_THUMBNAIL_PNG; -end; - -procedure TBGRAWriterLazPaint.InternalWrite(Str: TStream; Img: TFPCustomImage); -var {%H-}header: TLazPaintImageHeader; - compBmp: TBGRACompressableBitmap; - startPos, endPos: int64; -begin - startPos := str.Position; - fillchar({%H-}header,sizeof(header),0); - header.magic := LAZPAINT_MAGIC_HEADER; - header.zero1 := 0; - header.headerSize:= sizeof(header); - header.width := Img.Width; - header.height := img.Height; - header.nbLayers:= GetNbLayers; - header.previewOffset:= 0; - header.zero2 := 0; - header.compressionMode:= CompressionMode; - header.reserved1:= 0; - header.layersOffset:= 0; - LazPaintImageHeader_SwapEndianIfNeeded(header); - str.WriteBuffer(header,sizeof(header)); - LazPaintImageHeader_SwapEndianIfNeeded(header); - - if IncludeThumbnail then - if not WriteThumbnail(Str, Img) then - begin - IncludeThumbnail := false; - header.compressionMode:= CompressionMode; //update field for thumbnail - end; - - header.previewOffset:= Str.Position - startPos; - if Compression = lzpRLE then - WriteRLEImage(Str, Img, Caption) - else - begin - compBmp := TBGRACompressableBitmap.Create(Img as TBGRABitmap); - compBmp.Caption := Caption; - compBmp.WriteToStream(Str); - compBmp.Free; - end; - - endPos := str.Position; - if InternalWriteLayers(Str, Img) then - begin - header.layersOffset := endPos - startPos; - endPos := str.Position; - end; - - str.Position:= startPos; - LazPaintImageHeader_SwapEndianIfNeeded(header); - str.WriteBuffer(header,sizeof(header)); - str.Position:= endPos; -end; - -function TBGRAWriterLazPaint.InternalWriteLayers(Str: TStream; - Img: TFPCustomImage): boolean; -begin - result := false; -end; - -function TBGRAWriterLazPaint.GetNbLayers: integer; -begin - result := 1; -end; - -constructor TBGRAWriterLazPaint.Create; -begin - inherited Create; - CompressionMode:= LAZPAINT_COMPRESSION_MODE_RLE; -end; - -class procedure TBGRAWriterLazPaint.WriteRLEImage(Str: TStream; - Img: TFPCustomImage; ACaption: string); -const PossiblePlanes = 4; -var - PPlane,PPlaneCur: array[0..PossiblePlanes-1] of PByte; - CompressedPlane: array[0..PossiblePlanes-1] of TMemoryStream; - NbPixels, NbNonTranspPixels, NbOpaquePixels: integer; - Colors: array[0..255] of Int32or64; - ColorCount: Int32or64; - CompressedRGB: array[0..3] of TMemoryStream; - ColorTab: packed array[0..256*3-1] of byte; - Indexed: PByte; - NonRGBSize,RGBSize: int64; - - procedure OutputPlane(AIndex: integer); - begin - str.WriteDWord(NtoLE(LongWord(CompressedPlane[AIndex].Size))); - CompressedPlane[AIndex].Position:= 0; - str.CopyFrom(CompressedPlane[AIndex],CompressedPlane[AIndex].Size); - end; - - procedure OutputRGB(AIndex: integer); - begin - str.WriteDWord(NtoLE(LongWord(CompressedRGB[AIndex].Size))); - CompressedRGB[AIndex].Position:= 0; - str.CopyFrom(CompressedRGB[AIndex],CompressedRGB[AIndex].Size); - end; - - function BuildPalette: boolean; - var n,i: Int32or64; - lastColor,color,colorIndex: Int32or64; - found: boolean; - begin - ColorCount := 0; - ColorIndex := 0; - lastColor := -1; - GetMem(Indexed, NbNonTranspPixels); - for n := 0 to NbNonTranspPixels-1 do - begin - color := (PPlane[0]+n)^+ ((PPlane[1]+n)^ shl 8)+ ((PPlane[2]+n)^ shl 16); - if color = lastColor then - begin - (Indexed+n)^ := ColorIndex; - continue; - end; - found := false; - for i := 0 to ColorCount-1 do - begin - if colors[i] = color then - begin - found := true; - ColorIndex := i; - break; - end; - end; - if not found then - begin - inc(ColorCount); - if ColorCount > 256 then - begin - result := false; - ReAllocMem(Indexed,0); - exit; - end; - colors[colorCount-1] := color; - ColorIndex := ColorCount-1; - end; - (Indexed+n)^ := ColorIndex; - lastColor := color; - end; - result := true; - end; - -var - i,x,y: integer; - PlaneFlags: Byte; - a: Int32or64; - psrc: PBGRAPixel; - -begin - NbPixels := Img.Width*img.Height; - - for i := 0 to PossiblePlanes-1 do - begin - getmem(PPlane[i],NbPixels); - PPlaneCur[i] := PPlane[i]; - CompressedPlane[i] := nil; - end; - - NbNonTranspPixels := 0; - NbOpaquePixels:= 0; - if img is TBGRACustomBitmap then - begin - for y := 0 to img.Height-1 do - begin - psrc := TBGRACustomBitmap(img).ScanLine[y]; - for x := img.Width-1 downto 0 do - begin - with psrc^ do - begin - PPlaneCur[3]^ := alpha; - inc(PPlaneCur[3]); - if alpha = 0 then begin inc(psrc); continue; end; - if alpha = 255 then inc(NbOpaquePixels); - - inc(NbNonTranspPixels); - PPlaneCur[0]^ := red; - PPlaneCur[1]^ := green; - PPlaneCur[2]^ := blue; - inc(PPlaneCur[0]); - inc(PPlaneCur[1]); - inc(PPlaneCur[2]); - end; - inc(psrc); - end; - end; - end else - for y := 0 to img.Height-1 do - for x := 0 to img.Width-1 do - begin - with img.Colors[x,y] do - begin - a := alpha shr 8; - PPlaneCur[3]^ := a; - inc(PPlaneCur[3]); - if a = 0 then continue; - if a = 255 then inc(NbOpaquePixels); - - inc(NbNonTranspPixels); - PPlaneCur[0]^ := red shr 8; - PPlaneCur[1]^ := green shr 8; - PPlaneCur[2]^ := blue shr 8; - inc(PPlaneCur[0]); - inc(PPlaneCur[1]); - inc(PPlaneCur[2]); - end; - end; - - PlaneFlags := 0; - if NbOpaquePixels = NbPixels then PlaneFlags := PlaneFlags or LazpaintChannelNoAlpha; - if CompareMem(PPlane[1],PPlane[0],NbNonTranspPixels) then PlaneFlags := PlaneFlags or LazpaintChannelGreenFromRed; - if CompareMem(PPlane[2],PPlane[0],NbNonTranspPixels) then PlaneFlags := PlaneFlags or LazpaintChannelBlueFromRed else - if CompareMem(PPlane[2],PPlane[1],NbNonTranspPixels) then PlaneFlags := PlaneFlags or LazpaintChannelBlueFromGreen; - - //if we cannot reduce to one plane, maybe we will have more luck with a palette - for i := 0 to 3 do CompressedRGB[i] := nil; - Indexed := nil; - RGBSize := 0; - if ((PlaneFlags and LazpaintChannelGreenFromRed) = 0) or - ((PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) = 0) and (NbNonTranspPixels > 0) then - begin - if BuildPalette then - begin - if ColorCount shl 1 < NbNonTranspPixels then - begin - fillchar({%H-}ColorTab, sizeof(ColorTab), 0); - for i := 0 to ColorCount-1 do - begin - colorTab[i] := Colors[i] and 255; - colorTab[i+256] := (Colors[i] shr 8) and 255; - colorTab[i+512] := (Colors[i] shr 16) and 255; - end; - CompressedRGB[0] := TMemoryStream.Create; - EncodeLazRLE(colorTab[0], ColorCount, CompressedRGB[0]); - if (PlaneFlags and LazpaintChannelGreenFromRed) = 0 then - begin - CompressedRGB[1] := TMemoryStream.Create; - EncodeLazRLE(colorTab[256], ColorCount, CompressedRGB[1]); - end; - if (PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) = 0 then - begin - CompressedRGB[2] := TMemoryStream.Create; - EncodeLazRLE(colorTab[512], ColorCount, CompressedRGB[2]); - end; - CompressedRGB[3] := TMemoryStream.Create; - EncodeLazRLE(Indexed^,NbNonTranspPixels,CompressedRGB[3]); - - for i := 0 to 3 do - if CompressedRGB[i] <> nil then - inc(RGBSize,CompressedRGB[i].Size); - end; - ReAllocMem(Indexed,0); - end; - end; - - if (PlaneFlags and LazpaintChannelGreenFromRed) <> 0 then ReAllocMem(PPlane[1],0); - if (PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) <> 0 then ReAllocMem(PPlane[2],0); - - NonRGBSize := 0; - for i := 0 to PossiblePlanes-1 do - if PPlane[i] <> nil then - begin - CompressedPlane[i] := TMemoryStream.Create; - if i = 3 then - EncodeLazRLE(PPlane[i]^, NbPixels,CompressedPlane[i]) - else - EncodeLazRLE(PPlane[i]^, NbNonTranspPixels,CompressedPlane[i]); - inc(NonRGBSize, CompressedPlane[i].Size); - end; - - if (CompressedRGB[3] <> nil) and (NonRGBSize > RGBSize) then - PlaneFlags:= PlaneFlags or LazpaintPalettedRGB; - - str.WriteDWord(NtoLE(LongWord(img.width))); - str.WriteDWord(NtoLE(LongWord(img.Height))); - str.WriteDWord(NtoLE(LongWord(length(ACaption)))); - if length(ACaption)>0 then str.WriteBuffer(ACaption[1],length(ACaption)); - str.WriteByte(PlaneFlags); - - if (PlaneFlags and LazpaintChannelNoAlpha) = 0 then OutputPlane(3); - if (PlaneFlags and LazpaintPalettedRGB) <> 0 then - begin - for i := 0 to 3 do - if CompressedRGB[i] <> nil then - OutputRGB(i); - end else - begin - OutputPlane(0); - if (PlaneFlags and LazpaintChannelGreenFromRed) = 0 then OutputPlane(1); - if (PlaneFlags and (LazpaintChannelBlueFromRed or LazpaintChannelBlueFromGreen)) = 0 then OutputPlane(2); - end; - - for i := 0 to PossiblePlanes-1 do - begin - freemem(PPlane[i]); - CompressedPlane[i].Free; - end; - for i := 0 to 3 do - CompressedRGB[i].Free; -end; - -initialization - - DefaultBGRAImageWriter[ifLazPaint] := TBGRAWriterLazPaint; - -end. diff --git a/components/bgrabitmap/bgrawritepng.pas b/components/bgrabitmap/bgrawritepng.pas deleted file mode 100644 index 4613e09..0000000 --- a/components/bgrabitmap/bgrawritepng.pas +++ /dev/null @@ -1,965 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - The original file is part of the Free Pascal run time library. - Copyright (c) 2003 by the Free Pascal development team - - PNG writer class modified by circular. - - ********************************************************************** - - Fix for images with grayscale and alpha, - and for images with transparent pixels - } -unit BGRAWritePNG; - -{$mode objfpc}{$H+} - -interface - - -uses sysutils, BGRAClasses, FPImage, FPImgCmn, PNGcomn, ZStream, BGRABitmapTypes; - -type - THeaderChunk = packed record - Width, height : LongWord; - BitDepth, ColorType, Compression, Filter, Interlace : byte; - end; - - TGetPixelFunc = function (x,y : LongWord) : TColorData of object; - TGetPixelBGRAFunc = function (p: PBGRAPixel) : TColorData of object; - - TColorFormatFunction = function (color:TFPColor) : TColorData of object; - - { TBGRAWriterPNG } - - TBGRAWriterPNG = class (TBGRACustomWriterPNG) - private - FUsetRNS, FCompressedText, FWordSized, FIndexed, - FUseAlpha, FGrayScale : boolean; - FByteWidth : byte; - FChunk : TChunk; - CFmt : TColorFormat; // format of the colors to convert from - FFmtColor : TColorFormatFunction; - FTransparentColor : TFPColor; - FTransparentColorOk: boolean; - FSwitchLine, FCurrentLine, FPreviousLine : pByteArray; - FPalette : TFPPalette; - OwnsPalette : boolean; - FHeader : THeaderChunk; - FGetPixel : TGetPixelFunc; - FGetPixelBGRA : TGetPixelBGRAFunc; - FDatalineLength : LongWord; - ZData : TMemoryStream; // holds uncompressed data until all blocks are written - Compressor : TCompressionStream; // compresses the data - FCompressionLevel : TCompressionLevel; - procedure WriteChunk; - function GetColorPixel (x,y:LongWord) : TColorData; - function GetPalettePixel (x,y:LongWord) : TColorData; - function GetColPalPixel (x,y:LongWord) : TColorData; - function GetColorPixelBGRA (p: PBGRAPixel) : TColorData; - function GetPalettePixelBGRA (p: PBGRAPixel) : TColorData; - function GetColPalPixelBGRA (p: PBGRAPixel) : TColorData; - procedure InitWriteIDAT; - procedure Gatherdata; - procedure WriteCompressedData; - procedure FinalWriteIDAT; - protected - property Header : THeaderChunk read FHeader; - procedure InternalWrite ({%H-}Str:TStream; {%H-}Img:TFPCustomImage); override; - function GetUseAlpha: boolean; override; - procedure SetUseAlpha(AValue: boolean); override; - procedure WriteIHDR; virtual; - procedure WritePLTE; virtual; - procedure WritetRNS; virtual; - procedure WriteIDAT; virtual; - procedure WriteTexts; virtual; - procedure WriteIEND; virtual; - function CurrentLine (x:LongWord) : byte; inline; - function PrevSample (x:LongWord): byte; inline; - function PreviousLine (x:LongWord) : byte; inline; - function PrevLinePrevSample (x:LongWord): byte; inline; - function DoFilter (LineFilter:byte;index:LongWord; b:byte) : byte; virtual; - procedure SetChunkLength (aValue : LongWord); - procedure SetChunkType (ct : TChunkTypes); overload; - procedure SetChunkType (ct : TChunkCode); overload; - function DecideGetPixel : TGetPixelFunc; virtual; - function DecideGetPixelBGRA : TGetPixelBGRAFunc; virtual; - procedure DetermineHeader (var AHeader : THeaderChunk); virtual; - function DetermineFilter ({%H-}Current, {%H-}Previous:PByteArray; {%H-}linelength:LongWord):byte; virtual; - procedure FillScanLine (y : integer; ScanLine : pByteArray); virtual; - function ColorDataGrayB(color:TFPColor) : TColorData; - function ColorDataColorB(color:TFPColor) : TColorData; - function ColorDataGrayW(color:TFPColor) : TColorData; - function ColorDataColorW(color:TFPColor) : TColorData; - function ColorDataGrayAB(color:TFPColor) : TColorData; - function ColorDataColorAB(color:TFPColor) : TColorData; - function ColorDataGrayAW(color:TFPColor) : TColorData; - function ColorDataColorAW(color:TFPColor) : TColorData; - property ChunkDataBuffer : pByteArray read FChunk.data; - property UsetRNS : boolean read FUsetRNS; - property SingleTransparentColor : TFPColor read FTransparentColor; - property SingleTransparentColorOk : boolean read FTransparentColorOk; - property ThePalette : TFPPalette read FPalette; - property ColorFormat : TColorformat read CFmt; - property ColorFormatFunc : TColorFormatFunction read FFmtColor; - property byteWidth : byte read FByteWidth; - property DatalineLength : LongWord read FDatalineLength; - public - constructor create; override; - destructor destroy; override; - property GrayScale : boolean read FGrayscale write FGrayScale; - property Indexed : boolean read FIndexed write FIndexed; - property CompressedText : boolean read FCompressedText write FCompressedText; - property WordSized : boolean read FWordSized write FWordSized; - property CompressionLevel : TCompressionLevel read FCompressionLevel write FCompressionLevel; - end; - -implementation - -constructor TBGRAWriterPNG.create; -begin - inherited; - Fchunk.acapacity := 0; - Fchunk.data := nil; - FGrayScale := False; - FIndexed := False; - FCompressedText := True; - FWordSized := False; - FUseAlpha := True; - FCompressionLevel:=clDefault; -end; - -destructor TBGRAWriterPNG.destroy; -begin - if OwnsPalette then FreeAndNil(FPalette); - with Fchunk do - if acapacity > 0 then - freemem (data); - inherited; -end; - -procedure TBGRAWriterPNG.WriteChunk; -var chead : TChunkHeader; - c : LongWord; -begin - with FChunk do - begin - {$IFDEF ENDIAN_LITTLE} - chead.CLength := swap (alength); - {$ELSE} - chead.CLength := alength; - {$ENDIF} - if (ReadType = '') then - if atype <> ctUnknown then - chead.CType := ChunkTypes[aType] - else - raise PNGImageException.create ('Doesn''t have a chunktype to write') - else - chead.CType := ReadType; - c := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType)); - c := CalculateCRC (c, data^, alength); - {$IFDEF ENDIAN_LITTLE} - crc := swap(c xor All1Bits); - {$ELSE} - crc := c xor All1Bits; - {$ENDIF} - with TheStream do - begin - Write (chead, sizeof(chead)); - Write (data^[0], alength); - Write (crc, sizeof(crc)); - end; - end; -end; - -procedure TBGRAWriterPNG.SetChunkLength(aValue : LongWord); -begin - with Fchunk do - begin - alength := aValue; - if aValue > acapacity then - begin - if acapacity > 0 then - freemem (data); - GetMem (data, alength); - acapacity := alength; - end; - end; -end; - -procedure TBGRAWriterPNG.SetChunkType (ct : TChunkTypes); -begin - with Fchunk do - begin - aType := ct; - ReadType := ChunkTypes[ct]; - end; -end; - -procedure TBGRAWriterPNG.SetChunkType (ct : TChunkCode); -begin - with FChunk do - begin - ReadType := ct; - aType := low(TChunkTypes); - while (aType < high(TChunkTypes)) and (ChunkTypes[aType] <> ct) do - inc (aType); - end; -end; - -function TBGRAWriterPNG.CurrentLine(x:LongWord):byte; -begin - result := FCurrentLine^[x]; -end; - -function TBGRAWriterPNG.PrevSample (x:LongWord): byte; -begin - if x < byteWidth then - result := 0 - else - result := FCurrentLine^[x - bytewidth]; -end; - -function TBGRAWriterPNG.PreviousLine (x:LongWord) : byte; -begin - result := FPreviousline^[x]; -end; - -function TBGRAWriterPNG.PrevLinePrevSample (x:LongWord): byte; -begin - if x < byteWidth then - result := 0 - else - result := FPreviousLine^[x - bytewidth]; -end; - -function TBGRAWriterPNG.DoFilter(LineFilter:byte;index:LongWord; b:byte) : byte; -var diff : byte; - procedure FilterSub; - begin - diff := PrevSample(index); - end; - procedure FilterUp; - begin - diff := PreviousLine(index); - end; - procedure FilterAverage; - var l, p : word; - begin - l := PrevSample(index); - p := PreviousLine(index); - Diff := (l + p) div 2; - end; - procedure FilterPaeth; - var dl, dp, dlp : word; // index for previous and distances for: - l, p, lp : byte; // r:predictor, Left, Previous, LeftPrevious - r : integer; - begin - l := PrevSample(index); - lp := PrevLinePrevSample(index); - p := PreviousLine(index); - r := Int32or64(l) + Int32or64(p) - Int32or64(lp); - dl := abs (r - l); - dlp := abs (r - lp); - dp := abs (r - p); - if (dl <= dp) and (dl <= dlp) then - diff := l - else if dp <= dlp then - diff := p - else - diff := lp; - end; -begin - case LineFilter of - 0 : diff := 0; - 1 : FilterSub; - 2 : FilterUp; - 3 : FilterAverage; - 4 : FilterPaeth; - end; - if diff > b then - result := (b + $100 - diff) - else - result := b - diff; -end; - -procedure TBGRAWriterPNG.DetermineHeader (var AHeader : THeaderChunk); -var c : integer; - - function ReducedColorEquals(const c1,c2: TFPColor): boolean; - var g1,g2: word; - begin - if FGrayScale then - begin - g1 := CalculateGray(c1); - g2 := CalculateGray(c2); - if fwordsized then - result := (g1 = g2) - else - result := (g1 shr 8 = g2 shr 8); - end else - begin - if FWordSized then - result := (c1.red = c2.red) and (c1.green = c2.green) and (c1.blue = c2.blue) - else - result := (c1.red shr 8 = c2.red shr 8) and (c1.green shr 8 = c2.green shr 8) and (c1.blue shr 8 = c2.blue shr 8); - end; - end; - - function CountAlphas : integer; - var none, half : boolean; - maxTransparentAlpha: word; - - procedure CountFromPalettedImage; - var - p : integer; - a : word; - c : TFPColor; - begin - with TheImage.Palette do - begin - p := count-1; - FTransparentColor.alpha := alphaOpaque; - while (p >= 0) do - begin - c := color[p]; - a := c.Alpha; - if a < FTransparentColor.alpha then //we're looking for the most transparent color - FTransparentColor := c; - if a <= maxTransparentAlpha then none := true - else if a <> alphaOpaque then half := true; - dec (p); - end; - - //check transparent color is used consistently - FTransparentColorOk := true; - p := count-1; - while (p >= 0) do - begin - c := color[p]; - if c.alpha > maxTransparentAlpha then - begin - if ReducedColorEquals(c, FTransparentColor) then - begin - FTransparentColorOk := false; - break; - end; - end - else - begin - if not ReducedColorEquals(c, FTransparentColor) then - begin - FTransparentColorOk := false; - break; - end; - end; - dec(p); - end; - end; - end; - - procedure CountFromRGBImage; - var - a : word; - c : TFPColor; - x,y : longint; // checks on < 0 - begin - with TheImage do - begin - x := width-1; - y := height-1; - FTransparentColor.alpha := alphaOpaque; - while (y >= 0) and not half do //we stop if we already need a full alpha - begin - c := colors[x,y]; - a := c.Alpha; - if a < FTransparentColor.alpha then //we're looking for the most transparent color - FTransparentColor := c; - if a <= maxTransparentAlpha then none := true - else if a <> alphaOpaque then half := true; - dec (x); - if (x < 0) then - begin - dec (y); - x := width-1; - end; - end; - - //check transparent color is used consistently - FTransparentColorOk := true; - x := width-1; - y := height-1; - while (y >= 0) do - begin - c := colors[x,y]; - if c.alpha > maxTransparentAlpha then - begin - if ReducedColorEquals(c, FTransparentColor) then - begin - FTransparentColorOk := false; - break; - end; - end - else - begin - if not ReducedColorEquals(c, FTransparentColor) then - begin - FTransparentColorOk := false; - break; - end; - end; - dec (x); - if (x < 0) then - begin - dec (y); - x := width-1; - end; - end; - end; - end; - - begin - FTransparentColorOk := false; - if FWordSized then maxTransparentAlpha := 0 - else maxTransparentAlpha := $00ff; - half := false; - none := false; - with TheImage do - if UsePalette then - CountFromPalettedImage - else - CountFromRGBImage; - - if half then - result := 3 - else - if none then - begin - if FTransparentColorOk then - result := 2 - else - result := 3; - end - else - result := 1; - end; - procedure DetermineColorFormat; - begin - with AHeader do - case colortype of - 0 : if FWordSized then - begin - FFmtColor := @ColorDataGrayW; - FByteWidth := 2; - //CFmt := cfGray16 - end - else - begin - FFmtColor := @ColorDataGrayB; - FByteWidth := 1; - //CFmt := cfGray8; - end; - 2 : if FWordSized then - begin - FFmtColor := @ColorDataColorW; - FByteWidth := 6; - //CFmt := cfBGR48 - end - else - begin - FFmtColor := @ColorDataColorB; - FByteWidth := 3; - //CFmt := cfBGR24; - end; - 4 : if FWordSized then - begin - FFmtColor := @ColorDataGrayAW; - FByteWidth := 4; - //CFmt := cfGrayA32 - end - else - begin - FFmtColor := @ColorDataGrayAB; - FByteWidth := 2; - //CFmt := cfGrayA16; - end; - 6 : if FWordSized then - begin - FFmtColor := @ColorDataColorAW; - FByteWidth := 8; - //CFmt := cfABGR64 - end - else - begin - FFmtColor := @ColorDataColorAB; - FByteWidth := 4; - //CFmt := cfABGR32; - end; - end; - end; -begin - with AHeader do - begin - {$IFDEF ENDIAN_LITTLE} - // problem: TheImage has integer width, PNG header LongWord width. - // Integer Swap can give negative value - Width := swap (LongWord(TheImage.Width)); - height := swap (LongWord(TheImage.Height)); - {$ELSE} - Width := TheImage.Width; - height := TheImage.Height; - {$ENDIF} - if FUseAlpha then - c := CountAlphas - else - c := 0; - if FIndexed then - begin - if OwnsPalette then FreeAndNil(FPalette); - OwnsPalette := not TheImage.UsePalette; - if OwnsPalette then - begin - FPalette := TFPPalette.Create (16); - FPalette.Build (TheImage); - end - else - FPalette := TheImage.Palette; - if ThePalette.count > 256 then - raise PNGImageException.Create ('Too many colors to use indexed PNG color type'); - ColorType := 3; - FUsetRNS := C > 1; - BitDepth := 8; - FByteWidth := 1; - end - else - begin - if c = 3 then - ColorType := 4; - FUsetRNS := (c = 2); - if not FGrayScale then - ColorType := ColorType + 2; - if FWordSized then - BitDepth := 16 - else - BitDepth := 8; - DetermineColorFormat; - end; - Compression := 0; - Filter := 0; - Interlace := 0; - end; -end; - -procedure TBGRAWriterPNG.WriteIHDR; -begin - // signature for PNG - TheStream.writeBuffer(Signature,sizeof(Signature)); - // Determine all settings for filling the header - fillchar(fheader,sizeof(fheader),#0); - DetermineHeader (FHeader); - // write the header chunk - SetChunkLength (sizeof(FHeader)); - move (FHeader, ChunkDataBuffer^, sizeof(FHeader)); - SetChunkType (ctIHDR); - WriteChunk; -end; - -{ Color convertions } - -function TBGRAWriterPNG.ColorDataGrayB(color:TFPColor) : TColorData; -var t : word; -begin - t := CalculateGray (color); - result := hi(t); -end; - -function TBGRAWriterPNG.ColorDataGrayW(color:TFPColor) : TColorData; -begin - result := CalculateGray (color); -end; - -function TBGRAWriterPNG.ColorDataGrayAB(color:TFPColor) : TColorData; -begin - result := ColorDataGrayB (color); - result := (color.Alpha and $ff00) or result; -end; - -function TBGRAWriterPNG.ColorDataGrayAW(color:TFPColor) : TColorData; -begin - result := ColorDataGrayW (color); - result := (color.Alpha shl 16) or result; -end; - -function TBGRAWriterPNG.ColorDataColorB(color:TFPColor) : TColorData; -begin - {$PUSH}{$HINTS OFF} - with color do - result := hi(red) + (green and $FF00) + (hi(blue) shl 16); - {$POP} -end; - -function TBGRAWriterPNG.ColorDataColorW(color:TFPColor) : TColorData; -begin - {$PUSH}{$HINTS OFF} - with color do - result := red + (green shl 16) + (qword(blue) shl 32); - {$POP} -end; - -function TBGRAWriterPNG.ColorDataColorAB(color:TFPColor) : TColorData; -begin - {$PUSH}{$HINTS OFF} - with color do - result := hi(red) + (green and $FF00) + (hi(blue) shl 16) + (hi(alpha) shl 24); - {$POP} -end; - -function TBGRAWriterPNG.ColorDataColorAW(color:TFPColor) : TColorData; -begin - {$PUSH}{$HINTS OFF} - with color do - result := red + (green shl 16) + (qword(blue) shl 32) + (qword(alpha) shl 48); - {$POP} -end; - -{ Data making routines } - -function TBGRAWriterPNG.GetColorPixel (x,y:LongWord) : TColorData; -begin - result := FFmtColor (TheImage[x,y]); -end; - -function TBGRAWriterPNG.GetPalettePixel (x,y:LongWord) : TColorData; -begin - result := TheImage.Pixels[x,y]; -end; - -function TBGRAWriterPNG.GetColPalPixel (x,y:LongWord) : TColorData; -begin - result := ThePalette.IndexOf (TheImage.Colors[x,y]); -end; - -function TBGRAWriterPNG.GetColorPixelBGRA(p: PBGRAPixel): TColorData; -begin - result := FFmtColor(p^.ToFPColor); -end; - -function TBGRAWriterPNG.GetPalettePixelBGRA(p: PBGRAPixel): TColorData; -begin - result := TheImage.Palette.IndexOf(p^.ToFPColor); -end; - -function TBGRAWriterPNG.GetColPalPixelBGRA(p: PBGRAPixel): TColorData; -begin - result := ThePalette.IndexOf(p^.ToFPColor); -end; - -function TBGRAWriterPNG.DecideGetPixel : TGetPixelFunc; -begin - case Fheader.colortype of - 3 : if TheImage.UsePalette then - result := @GetPalettePixel - else result := @GetColPalPixel; - else result := @GetColorPixel; - end; -end; - -function TBGRAWriterPNG.DecideGetPixelBGRA: TGetPixelBGRAFunc; -begin - case Fheader.colortype of - 3 : if TheImage.UsePalette then - result := @GetPalettePixelBGRA - else result := @GetColPalPixelBGRA; - else result := @GetColorPixelBGRA; - end; -end; - -procedure TBGRAWriterPNG.WritePLTE; -var r,t : integer; - c : TFPColor; -begin - with ThePalette do - begin - SetChunkLength (count*3); - SetChunkType (ctPLTE); - t := 0; - For r := 0 to count-1 do - begin - c := Color[r]; - ChunkdataBuffer^[t] := c.red div 256; - inc (t); - ChunkdataBuffer^[t] := c.green div 256; - inc (t); - ChunkdataBuffer^[t] := c.blue div 256; - inc (t); - end; - end; - WriteChunk; -end; - -procedure TBGRAWriterPNG.InitWriteIDAT; -begin - FDatalineLength := TheImage.Width*ByteWidth; - GetMem (FPreviousLine, FDatalineLength); - GetMem (FCurrentLine, FDatalineLength); - fillchar (FCurrentLine^,FDatalineLength,0); - ZData := TMemoryStream.Create; - Compressor := TCompressionStream.Create (FCompressionLevel,ZData); - FGetPixel := DecideGetPixel; - FGetPixelBGRA := DecideGetPixelBGRA; -end; - -procedure TBGRAWriterPNG.FinalWriteIDAT; -begin - ZData.Free; - FreeMem (FPreviousLine); - FreeMem (FCurrentLine); -end; - -function TBGRAWriterPNG.DetermineFilter (Current, Previous:PByteArray; linelength:LongWord) : byte; -begin - result := 0; -end; - -procedure TBGRAWriterPNG.FillScanLine (y : integer; ScanLine : pByteArray); -var x : integer; - cd : TColorData; - r, index : LongWord; - b : byte; - p : PBGRAPixel; -begin - index := 0; - if TheImage is TBGRACustomBitmap then - begin - p := TBGRACustomBitmap(TheImage).ScanLine[y]; - if FHeader.BitDepth <> 16 then - case FByteWidth of - 1: for x := pred(TheImage.Width) downto 0 do - begin - cd := FGetPixelBGRA(p); - ScanLine^[index] := cd; - inc (index); - inc(p); - end; - 2: for x := pred(TheImage.Width) downto 0 do - begin - cd := FGetPixelBGRA(p); - ScanLine^[index] := cd and $ff; - ScanLine^[index+1] := cd shr 8; - inc (index,2); - inc(p); - end; - 3: for x := pred(TheImage.Width) downto 0 do - begin - ScanLine^[index] := p^.red; - ScanLine^[index+1] := p^.green; - ScanLine^[index+2] := p^.blue; - inc (index,3); - inc(p); - end; - 4: for x := pred(TheImage.Width) downto 0 do - begin - ScanLine^[index] := p^.red; - ScanLine^[index+1] := p^.green; - ScanLine^[index+2] := p^.blue; - ScanLine^[index+3] := p^.alpha; - inc (index,4); - inc(p); - end; - else raise exception.Create('Unexpected byte width'); - end else - for x := pred(TheImage.Width) downto 0 do - begin - cd := FGetPixelBGRA(p); - {$IFDEF ENDIAN_BIG} - cd:=swap(cd); - {$ENDIF} - move (cd, ScanLine^[index], FBytewidth); - if WordSized then - begin - r := 0; - while (r+1 < FByteWidth) do - begin - b := Scanline^[index+r+1]; - Scanline^[index+r+1] := Scanline^[index+r]; - Scanline^[index+r] := b; - inc (r,2); - end; - end; - inc (index, FByteWidth); - inc(p); - end; - end - else - for x := 0 to pred(TheImage.Width) do - begin - cd := FGetPixel (x,y); - {$IFDEF ENDIAN_BIG} - cd:=swap(cd); - {$ENDIF} - move (cd, ScanLine^[index], FBytewidth); - if WordSized then - begin - r := 0; - while (r+1 < FByteWidth) do - begin - b := Scanline^[index+r+1]; - Scanline^[index+r+1] := Scanline^[index+r]; - Scanline^[index+r] := b; - inc (r,2); - end; - end; - inc (index, FByteWidth); - end; -end; - -procedure TBGRAWriterPNG.Gatherdata; -var x,y : integer; - lf : byte; -begin - for y := 0 to pred(TheImage.height) do - begin - FSwitchLine := FCurrentLine; - FCurrentLine := FPreviousLine; - FPreviousLine := FSwitchLine; - FillScanLine (y, FCurrentLine); - lf := DetermineFilter (FCurrentLine, FpreviousLine, FDataLineLength); - if lf <> 0 then - for x := 0 to FDatalineLength-1 do - FCurrentLine^[x] := DoFilter (lf, x, FCurrentLine^[x]); - Compressor.Write (lf, sizeof(lf)); - Compressor.Write (FCurrentLine^, FDataLineLength); - end; -end; - -procedure TBGRAWriterPNG.WriteCompressedData; -var l : LongWord; -begin - Compressor.Free; // Close compression and finish the writing in ZData - l := ZData.position; - ZData.position := 0; - SetChunkLength(l); - SetChunkType (ctIDAT); - ZData.Read (ChunkdataBuffer^, l); - WriteChunk; -end; - -procedure TBGRAWriterPNG.WriteIDAT; -begin - InitWriteIDAT; - GatherData; - WriteCompressedData; - FinalWriteIDAT; -end; - -procedure TBGRAWriterPNG.WritetRNS; - procedure PaletteAlpha; - var r : integer; - begin - with TheImage.palette do - begin - // search last palette entry with transparency - r := count; - repeat - dec (r); - until (r < 0) or (color[r].alpha <> alphaOpaque); - if r >= 0 then // there is at least 1 transparent color - begin - // from this color we go to the first palette entry - SetChunkLength (r+1); - repeat - chunkdatabuffer^[r] := (color[r].alpha shr 8); - dec (r); - until (r < 0); - end; - writechunk; - end; - end; - procedure GrayAlpha; - var g : word; - begin - SetChunkLength(2); - if WordSized then - g := CalculateGray (SingleTransparentColor) - else - g := hi (CalculateGray(SingleTransparentColor)); - {$IFDEF ENDIAN_LITTLE} - g := swap (g); - {$ENDIF} - move (g,ChunkDataBuffer^[0],2); - WriteChunk; - end; - procedure ColorAlpha; - var g : TFPColor; - begin - SetChunkLength(6); - g := SingleTransparentColor; - with g do - if WordSized then - begin - {$IFDEF ENDIAN_LITTLE} - red := swap (red); - green := swap (green); - blue := swap (blue); - {$ENDIF} - move (g, ChunkDatabuffer^[0], 6); - end - else - begin - ChunkDataBuffer^[0] := 0; - ChunkDataBuffer^[1] := red shr 8; - ChunkDataBuffer^[2] := 0; - ChunkDataBuffer^[3] := green shr 8; - ChunkDataBuffer^[4] := 0; - ChunkDataBuffer^[5] := blue shr 8; - end; - WriteChunk; - end; -begin - SetChunkType (cttRNS); - case fheader.colortype of - 6,4 : raise PNGImageException.create ('tRNS chunk forbidden for full alpha channels'); - 3 : PaletteAlpha; - 2 : ColorAlpha; - 0 : GrayAlpha; - end; -end; - -procedure TBGRAWriterPNG.WriteTexts; -begin -end; - -procedure TBGRAWriterPNG.WriteIEND; -begin - SetChunkLength(0); - SetChunkType (ctIEND); - WriteChunk; -end; - -procedure TBGRAWriterPNG.InternalWrite (Str:TStream; Img:TFPCustomImage); -begin - WriteIHDR; - if Fheader.colorType = 3 then - WritePLTE; - if FUsetRNS then - WritetRNS; - WriteIDAT; - WriteTexts; - WriteIEND; -end; - -function TBGRAWriterPNG.GetUseAlpha: boolean; -begin - result := FUseAlpha; -end; - -procedure TBGRAWriterPNG.SetUseAlpha(AValue: boolean); -begin - FUseAlpha := AValue; -end; - -initialization - - DefaultBGRAImageWriter[ifPng] := TBGRAWriterPNG; - -end. diff --git a/components/bgrabitmap/bgrawritetiff.pas b/components/bgrabitmap/bgrawritetiff.pas deleted file mode 100644 index 060e1e3..0000000 --- a/components/bgrabitmap/bgrawritetiff.pas +++ /dev/null @@ -1,1023 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ - The original file is part of the Free Pascal run time library. - Copyright (c) 2012 by the Free Pascal development team - - Tiff writer for fpImage modified by circular. - - ********************************************************************** - - Working: - Grayscale 8,16bit (optional alpha), - RGB 8,16bit (optional alpha), - Orientation, - multiple images, pages - thumbnail - Compression: deflate - - ToDo: - Compression: LZW, packbits, jpeg, ... - Planar - ColorMap - separate mask - fillorder - not needed by baseline tiff reader - bigtiff 64bit offsets - endian - currently using system endianess - orientation with rotation -} -unit BGRAWriteTiff; - -{$mode objfpc}{$H+} - -interface - -uses - Math, BGRAClasses, SysUtils, zbase, zdeflate, FPimage, FPTiffCmn, - BGRABitmapTypes; - -type - - { TTiffWriterEntry } - - TTiffWriterEntry = class - public - Tag: Word; - EntryType: Word; - Count: LongWord; - Data: Pointer; - DataPos: LongWord; - Bytes: LongWord; - destructor Destroy; override; - end; - - TTiffWriterChunk = record - Data: Pointer; - Bytes: LongWord; - end; - PTiffWriterChunk = ^TTiffWriterChunk; - - { TTiffWriterChunkOffsets } - - TTiffWriterChunkOffsets = class(TTiffWriterEntry) - public - Chunks: PTiffWriterChunk; - ChunkByteCounts: TTiffWriterEntry; - constructor Create(ChunkType: TTiffChunkType); - destructor Destroy; override; - procedure SetCount(NewCount: LongWord); - end; - - { TBGRAWriterTiff } - - TBGRAWriterTiff = class(TFPCustomImageWriter) - private - FPremultiplyRGB: boolean; - FSaveCMYKAsRGB: boolean; - fStartPos: Int64; - FEntries: TFPList; // list of TFPList of TTiffWriterEntry - fStream: TStream; - fPosition: LongWord; - procedure ClearEntries; - procedure WriteTiff; - procedure WriteHeader; - procedure WriteIFDs; - procedure WriteEntry(Entry: TTiffWriterEntry); - procedure WriteData; - procedure WriteEntryData(Entry: TTiffWriterEntry); - procedure WriteBuf(var Buf; Count: LongWord); - procedure WriteWord(w: Word); - procedure WriteDWord(d: LongWord); - protected - procedure InternalWrite(Stream: TStream; Img: TFPCustomImage); override; - procedure AddEntryString(Tag: word; const s: string); - procedure AddEntryShort(Tag: word; Value: Word); - procedure AddEntryLong(Tag: word; Value: LongWord); - procedure AddEntryShortOrLong(Tag: word; Value: LongWord); - procedure AddEntryRational(Tag: word; const Value: TTiffRational); - procedure AddEntry(Tag: Word; EntryType: Word; EntryCount: LongWord; - Data: Pointer; Bytes: LongWord; - CopyData: boolean = true); - procedure AddEntry(Entry: TTiffWriterEntry); - procedure TiffError(Msg: string); - procedure EncodeDeflate(var Buffer: Pointer; var Count: LongWord); - public - constructor Create; override; - destructor Destroy; override; - procedure Clear; - procedure AddImage(Img: TFPCustomImage); - procedure SaveToStream(Stream: TStream); - property SaveCMYKAsRGB: boolean read FSaveCMYKAsRGB write FSaveCMYKAsRGB; - property PremultiplyRGB: boolean read FPremultiplyRGB write FPremultiplyRGB; - end; - -function CompareTiffWriteEntries(Entry1, Entry2: Pointer): integer; - -function CompressDeflate(InputData: PByte; InputCount: LongWord; - out Compressed: PByte; var CompressedCount: LongWord; - ErrorMsg: PAnsiString = nil): boolean; - -implementation - -function CompareTiffWriteEntries(Entry1, Entry2: Pointer): integer; -begin - Result:=integer(TTiffWriterEntry(Entry1).Tag)-integer(TTiffWriterEntry(Entry2).Tag); -end; - -function CompressDeflate(InputData: PByte; InputCount: LongWord; out - Compressed: PByte; var CompressedCount: LongWord; ErrorMsg: PAnsiString - ): boolean; -var - stream : z_stream; - err : integer; -begin - Result:=false; - //writeln('CompressDeflate START'); - Compressed:=nil; - if InputCount=0 then begin - CompressedCount:=0; - exit(true); - end; - - err := deflateInit(stream{%H-}, Z_DEFAULT_COMPRESSION); - if err <> Z_OK then begin - if ErrorMsg<>nil then - ErrorMsg^:='deflateInit failed'; - exit; - end; - - // set input = InputData data - stream.avail_in := InputCount; - stream.next_in := InputData; - - // set output = compressed data - if CompressedCount=0 then - CompressedCount:=InputCount; - GetMem(Compressed,CompressedCount); - stream.avail_out := CompressedCount; - stream.next_out := Compressed; - - err := deflate(stream, Z_NO_FLUSH); - if err<>Z_OK then begin - if ErrorMsg<>nil then - ErrorMsg^:='deflate failed'; - exit; - end; - - while TRUE do begin - //writeln('run: total_in=',stream.total_in,' avail_in=',stream.avail_in,' total_out=',stream.total_out,' avail_out=',stream.avail_out); - if (stream.avail_out=0) then begin - // need more space - if CompressedCount<128 then - CompressedCount:=CompressedCount+128 - else if CompressedCount>High(CompressedCount)-1024 then begin - if ErrorMsg<>nil then - ErrorMsg^:='deflate compression failed, because not enough space'; - exit; - end else - CompressedCount:=CompressedCount+1024; - ReAllocMem(Compressed,CompressedCount); - stream.next_out:=Compressed+stream.total_out; - stream.avail_out:=CompressedCount-stream.total_out; - end; - err := deflate(stream, Z_FINISH); - if err = Z_STREAM_END then - break; - if err<>Z_OK then begin - if ErrorMsg<>nil then - ErrorMsg^:='deflate finish failed'; - exit; - end; - end; - - //writeln('compressed: total_in=',stream.total_in,' total_out=',stream.total_out); - CompressedCount:=stream.total_out; - ReAllocMem(Compressed,CompressedCount); - - err := deflateEnd(stream); - if err<>Z_OK then begin - if ErrorMsg<>nil then - ErrorMsg^:='deflateEnd failed'; - exit; - end; - Result:=true; -end; - -{ TBGRAWriterTiff } - -procedure TBGRAWriterTiff.WriteWord(w: Word); -begin - if fStream<>nil then - fStream.WriteWord(w); - inc(fPosition,2); -end; - -procedure TBGRAWriterTiff.WriteDWord(d: LongWord); -begin - if fStream<>nil then - fStream.WriteDWord(d); - inc(fPosition,4); -end; - -procedure TBGRAWriterTiff.ClearEntries; -var - i: Integer; - List: TFPList; - j: Integer; -begin - for i:=FEntries.Count-1 downto 0 do begin - List:=TFPList(FEntries[i]); - for j:=List.Count-1 downto 0 do - TObject(List[j]).Free; - List.Free; - end; - FEntries.Clear; -end; - -procedure TBGRAWriterTiff.WriteTiff; -begin - {$IFDEF FPC_Debug_Image} - writeln('TBGRAWriterTiff.WriteTiff fStream=',fStream<>nil); - {$ENDIF} - fPosition:=0; - WriteHeader; - WriteIFDs; - WriteData; -end; - -procedure TBGRAWriterTiff.WriteHeader; -var - EndianMark: String; -begin - EndianMark:={$IFDEF FPC_BIG_ENDIAN}'MM'{$ELSE}'II'{$ENDIF}; - WriteBuf(EndianMark[1],2); - WriteWord(42); - WriteDWord(8); -end; - -procedure TBGRAWriterTiff.WriteIFDs; -var - i: Integer; - List: TFPList; - j: Integer; - Entry: TTiffWriterEntry; - NextIFDPos: LongWord; -begin - for i:=0 to FEntries.Count-1 do begin - List:=TFPList(FEntries[i]); - // write count - {$IFDEF FPC_Debug_Image} - writeln('TBGRAWriterTiff.WriteIFDs List=',i,' Count=',List.Count); - {$ENDIF} - WriteWord(List.Count); - // write array of entries - for j:=0 to List.Count-1 do begin - Entry:=TTiffWriterEntry(List[j]); - WriteEntry(Entry); - end; - // write position of next IFD - if i= 8 then - begin - WriteNextLabPixel(AColor); - exit; - end; - - case IFD.PhotoMetricInterpretation of - 0,1: // grayscale - begin - Value:=(LongWord(AColor.red)+AColor.green+AColor.blue) div 3; - if ExtraSample=1 then Value := Value*AColor.alpha div 65535; - if IFD.PhotoMetricInterpretation=0 then Value:=$ffff-Value;// 0 is white - WriteValue(Run, Value, GrayBits); - WriteValue(Run, AColor.alpha, AlphaBits); - end; - 2: // RGB - begin - Value := AColor.red; - if ExtraSample=1 then Value := Value*AColor.alpha div 65535; - WriteValue(Run, Value, RedBits); - Value := AColor.green; - if ExtraSample=1 then Value := Value*AColor.alpha div 65535; - WriteValue(Run, Value, GreenBits); - Value := AColor.blue; - if ExtraSample=1 then Value := Value*AColor.alpha div 65535; - WriteValue(Run, Value, BlueBits); - WriteValue(Run, AColor.alpha, AlphaBits); - end; - else raise exception.Create('Photometric interpretation not handled'); - end; - end; - -begin - ChunkOffsets:=nil; - Chunk:=nil; - IFD:=TTiffIFD.Create; - try - // add new list of entries - CurEntries:=TFPList.Create; - FEntries.Add(CurEntries); - - IFD.ReadFPImgExtras(Img); - if SaveCMYKAsRGB and (IFD.PhotoMetricInterpretation=5) then - IFD.PhotoMetricInterpretation:=2; - if (Img.Extra[TiffPhotoMetric]='') and (Img is TCustomUniversalBitmap) then - begin - if cfHasImaginaryColors in TCustomUniversalBitmap(Img).Colorspace.GetFlags then - IFD.PhotoMetricInterpretation := 8; - end; - - if Img.Extra[TiffCompression]='' then - IFD.Compression:= TiffCompressionDeflateZLib; - - if not (IFD.PhotoMetricInterpretation in [0,1,2,8,9]) then - TiffError('PhotoMetricInterpretation="'+Img.Extra[TiffPhotoMetric]+'" not supported'); - - GrayBits:=0; - RedBits:=0; - GreenBits:=0; - BlueBits:=0; - AlphaBits:=0; - ExtraSample:=0; - defaultColorBits := GetDefaultColorBits; - case IFD.PhotoMetricInterpretation of - 0,1: - begin - GrayBits:=StrToIntDef(Img.Extra[TiffGrayBits], defaultColorBits); - BitsPerSample[0]:=GrayBits; - SamplesPerPixel:=1; - end; - 2: - begin - RedBits:=StrToIntDef(Img.Extra[TiffRedBits], defaultColorBits); - GreenBits:=StrToIntDef(Img.Extra[TiffGreenBits], defaultColorBits); - BlueBits:=StrToIntDef(Img.Extra[TiffBlueBits], defaultColorBits); - BitsPerSample[0]:=RedBits; - BitsPerSample[1]:=GreenBits; - BitsPerSample[2]:=BlueBits; - SamplesPerPixel:=3; - end; - 8,9: - begin - RedBits:=StrToIntDef(Img.Extra[TiffRedBits], defaultColorBits); - GreenBits:=StrToIntDef(Img.Extra[TiffGreenBits], defaultColorBits); - BlueBits:=StrToIntDef(Img.Extra[TiffBlueBits], defaultColorBits); - BitsPerSample[0]:=GreenBits; - if (RedBits=0) and (BlueBits=0) then SamplesPerPixel := 1 - else - begin - SamplesPerPixel:= 3; - if RedBits=0 then RedBits := BlueBits else - if BlueBits=0 then BlueBits := RedBits; - BitsPerSample[1]:= RedBits; - BitsPerSample[2]:= BlueBits; - end; - end; - end; - AlphaBits:= StrToIntDef(Img.Extra[TiffAlphaBits],GetDefaultAlphaBits); - if AlphaBits>0 then begin - BitsPerSample[SamplesPerPixel]:=AlphaBits; - inc(SamplesPerPixel); - if PremultiplyRGB and (IFD.PhotoMetricInterpretation<=2) then - ExtraSample := 1 - else - ExtraSample := 2; - end; - - ImgWidth:=Img.Width; - ImgHeight:=Img.Height; - Compression:=IFD.Compression; - case Compression of - TiffCompressionNone, - TiffCompressionDeflateZLib: ; - else - {$ifdef FPC_DEBUG_IMAGE} - writeln('TBGRAWriterTiff.AddImage unsupported compression '+TiffCompressionName(Compression)+', using deflate instead.'); - {$endif} - Compression:=TiffCompressionDeflateZLib; - end; - - if IFD.Orientation in [1..4] then begin - OrientedWidth:=ImgWidth; - OrientedHeight:=ImgHeight; - end else begin - // rotated - OrientedWidth:=ImgHeight; - OrientedHeight:=ImgWidth; - end; - - {$IFDEF FPC_Debug_Image} - writeln('TBGRAWriterTiff.AddImage PhotoMetricInterpretation=',IFD.PhotoMetricInterpretation); - writeln('TBGRAWriterTiff.AddImage ImageWidth=',ImgWidth,' ImageHeight=',ImgHeight); - writeln('TBGRAWriterTiff.AddImage Orientation=',IFD.Orientation); - writeln('TBGRAWriterTiff.AddImage ResolutionUnit=',IFD.ResolutionUnit); - writeln('TBGRAWriterTiff.AddImage XResolution=',TiffRationalToStr(IFD.XResolution)); - writeln('TBGRAWriterTiff.AddImage YResolution=',TiffRationalToStr(IFD.YResolution)); - writeln('TBGRAWriterTiff.AddImage GrayBits=',GrayBits,' RedBits=',RedBits,' GreenBits=',GreenBits,' BlueBits=',BlueBits,' AlphaBits=',AlphaBits); - writeln('TBGRAWriterTiff.AddImage Compression=',TiffCompressionName(Compression)); - writeln('TBGRAWriterTiff.AddImage Page=',IFD.PageNumber,'/',IFD.PageCount); - {$ENDIF} - - // required meta entries - AddEntryShortOrLong(256,ImgWidth); - AddEntryShortOrLong(257,ImgHeight); - AddEntryShort(259,Compression); - AddEntryShort(262,IFD.PhotoMetricInterpretation); - AddEntryShort(274,IFD.Orientation); - AddEntryShort(296,IFD.ResolutionUnit); - AddEntryRational(282,IFD.XResolution); - AddEntryRational(283,IFD.YResolution); - // BitsPerSample (required) - AddEntry(258,3,SamplesPerPixel,@BitsPerSample[0],SamplesPerPixel*2); - AddEntryShort(277,SamplesPerPixel); - if ExtraSample<>0 then AddEntryShort(338, ExtraSample); - - // BitsPerPixel, BytesPerLine - BitsPerPixel:=0; - for i:=0 to SamplesPerPixel-1 do - inc(BitsPerPixel,BitsPerSample[i]); - BytesPerLine:=(BitsPerPixel*OrientedWidth+7) div 8; - - // optional entries - NewSubFileType:=0; - if IFD.ImageIsThumbNail then inc(NewSubFileType,1); - if IFD.ImageIsPage then inc(NewSubFileType,2); - if IFD.ImageIsMask then inc(NewSubFileType,4); - if NewSubFileType>0 then - AddEntryLong(254,NewSubFileType); - if IFD.DocumentName<>'' then - AddEntryString(269,IFD.DocumentName); - if IFD.ImageDescription<>'' then - AddEntryString(270,IFD.ImageDescription); - if IFD.Make_ScannerManufacturer<>'' then - AddEntryString(271,IFD.Make_ScannerManufacturer); - if IFD.Model_Scanner<>'' then - AddEntryString(272,IFD.Model_Scanner); - if IFD.Software<>'' then - AddEntryString(305,IFD.Software); - if IFD.DateAndTime<>'' then - AddEntryString(306,IFD.DateAndTime); - if IFD.Artist<>'' then - AddEntryString(315,IFD.Artist); - if IFD.HostComputer<>'' then - AddEntryString(316,IFD.HostComputer); - if IFD.PageCount>0 then begin - Shorts[0]:=IFD.PageNumber; - Shorts[1]:=IFD.PageCount; - AddEntry(297,3,2,@Shorts[0],2*SizeOf(Word)); - end; - if IFD.PageName<>'' then - AddEntryString(285,IFD.PageName); - if IFD.Copyright<>'' then - AddEntryString(33432,IFD.Copyright); - - // chunks - ChunkType:=tctStrip; - if IFD.TileWidth>0 then begin - AddEntryShortOrLong(322,IFD.TileWidth); - AddEntryShortOrLong(323,IFD.TileLength); - ChunkType:=tctTile; - end else begin - // RowsPerStrip (required) - if OrientedWidth=0 then - IFD.RowsPerStrip:=8 - else - IFD.RowsPerStrip:=8192 div BytesPerLine; - if IFD.RowsPerStrip<1 then - IFD.RowsPerStrip:=1; - {$IFDEF FPC_Debug_Image} - writeln('TBGRAWriterTiff.AddImage BitsPerPixel=',BitsPerPixel,' OrientedWidth=',OrientedWidth,' BytesPerLine=',BytesPerLine,' RowsPerStrip=',IFD.RowsPerStrip); - {$ENDIF} - AddEntryShortOrLong(278,IFD.RowsPerStrip); - end; - - // tags for Offsets and ByteCounts - ChunkOffsets:=TTiffWriterChunkOffsets.Create(ChunkType); - AddEntry(ChunkOffsets); - AddEntry(ChunkOffsets.ChunkByteCounts); - - labArray := nil; - if (Img is TCustomUniversalBitmap) and - (IFD.PhotoMetricInterpretation >= 8) then - begin - ConvertToLab := true; - ConversionToLab := TCustomUniversalBitmap(Img).Colorspace.GetBridgedConversion(TLabAColorspace); - end else - ConvertToLab := false; - - if (OrientedHeight>0) and (OrientedWidth>0) then begin - if ChunkType=tctTile then begin - TilesAcross:=(OrientedWidth+IFD.TileWidth{%H-}-1) div IFD.TileWidth; - TilesDown:=(OrientedHeight+IFD.TileLength{%H-}-1) div IFD.TileLength; - ChunkCount:=TilesAcross*TilesDown; - {$IFDEF FPC_Debug_Image} - writeln('TBGRAWriterTiff.AddImage BitsPerPixel=',BitsPerPixel,' OrientedWidth=',OrientedWidth,' OrientedHeight=',OrientedHeight,' TileWidth=',IFD.TileWidth,' TileLength=',IFD.TileLength,' TilesAcross=',TilesAcross,' TilesDown=',TilesDown,' ChunkCount=',ChunkCount); - {$ENDIF} - end else begin - ChunkCount:=(OrientedHeight+IFD.RowsPerStrip{%H-}-1) div IFD.RowsPerStrip; - end; - ChunkOffsets.SetCount(ChunkCount); - // create chunks - for ChunkIndex:=0 to ChunkCount-1 do begin - if ChunkType=tctTile then begin - ChunkLeft:=(ChunkIndex mod TilesAcross)*IFD.TileWidth; - ChunkTop:=(ChunkIndex div TilesAcross)*IFD.TileLength; - ChunkWidth:=Min(IFD.TileWidth,OrientedWidth-ChunkLeft); - ChunkHeight:=Min(IFD.TileLength,OrientedHeight-ChunkTop); - // boundary tiles are padded to a full tile - // the padding is filled with 0 and compression will get rid of it - ChunkBytesPerLine:=(BitsPerPixel*IFD.TileWidth+7) div 8; - ChunkBytes:=ChunkBytesPerLine*IFD.TileLength; - end else begin - ChunkLeft:=0; - ChunkTop:=IFD.RowsPerStrip*ChunkIndex; - ChunkWidth:=OrientedWidth; - ChunkHeight:=Min(IFD.RowsPerStrip,OrientedHeight-ChunkTop); - ChunkBytesPerLine:=BytesPerLine; - ChunkBytes:=ChunkBytesPerLine*ChunkHeight; - end; - GetMem(Chunk,ChunkBytes); - FillByte(Chunk^,ChunkBytes,0); // fill unused bytes with 0 to help compression - - // Orientation - if IFD.Orientation in [1..4] then begin - sx:=ChunkLeft; sy:=ChunkTop; - dy1 := 0; dx2 := 0; - case IFD.Orientation of - 1: begin dx1:=1; dy2:=1; end;// 0,0 is left, top - 2: begin sx:=OrientedWidth-sx-1; dx1:=-1; dy2:=1; end;// 0,0 is right, top - 3: begin sx:=OrientedWidth-sx-1; dx1:=-1; sy:=OrientedHeight-sy-1; dy2:=-1; end;// 0,0 is right, bottom - 4: begin dx1:=1; sy:=OrientedHeight-sy-1; dy2:=-1; end;// 0,0 is left, bottom - end; - end else begin - // rotated - sx:=ChunkTop; sy:=ChunkLeft; - dx1 := 0; dy2 := 0; - case IFD.Orientation of - 5: begin dx2:=1; dy1:=1; end;// 0,0 is top, left (rotated) - 6: begin dx2:=1; sy:=OrientedWidth-sy-1; dy1:=-1; end;// 0,0 is top, right (rotated) - 7: begin sx:=OrientedHeight-sx-1; dx2:=-1; sy:=OrientedWidth-sy-1; dy1:=-1; end;// 0,0 is bottom, right (rotated) - 8: begin sx:=OrientedHeight-sx-1; dx2:=-1; dy1:=1; end;// 0,0 is bottom, left (rotated) - end; - end; - //writeln('TBGRAWriterTiff.AddImage Chunk=',ChunkIndex,'/',ChunkCount,' ChunkBytes=',ChunkBytes,' ChunkRect=',ChunkLeft,',',ChunkTop,',',ChunkWidth,'x',ChunkHeight,' x=',x,' y=',y,' dx=',dx,' dy=',dy); - for cy:=0 to ChunkHeight-1 do begin - Run:=Chunk+cy*ChunkBytesPerLine; - - if ConvertToLab then - begin - if ChunkWidth > Length(labArray) then setlength(labArray, ChunkWidth); - sourceStride := TCustomUniversalBitmap(Img).RowSize*dy1; - if TCustomUniversalBitmap(Img).LineOrder = riloBottomToTop then - sourceStride := -sourceStride; - inc(sourceStride, dx1*PtrInt(TCustomUniversalBitmap(Img).Colorspace.GetSize) ); - ConversionToLab.Convert( TCustomUniversalBitmap(Img).GetPixelAddress(sx,sy), - @labArray[0], ChunkWidth, sourceStride, sizeof(TLabA), nil); - for cx := 0 to ChunkWidth-1 do - WriteNextLabPixel(labArray[cx]); - end else - begin - x := sx; - y := sy; - for cx:=0 to ChunkWidth-1 do begin - WriteNextPixel(Img.Colors[x,y]); - inc(x,dx1); - inc(y,dy1); - end; - end; - - inc(sx,dx2); - inc(sy,dy2); - end; - - // compress - case Compression of - TiffCompressionDeflateZLib: EncodeDeflate(Chunk,ChunkBytes); - end; - - ChunkOffsets.Chunks[ChunkIndex].Data:=Chunk; - ChunkOffsets.Chunks[ChunkIndex].Bytes:=ChunkBytes; - // next chunk - end; - // created chunks - end; - - CurEntries.Sort(@CompareTiffWriteEntries); - finally - IFD.Free; - end; -end; - -procedure TBGRAWriterTiff.SaveToStream(Stream: TStream); -begin - fStartPos:=Stream.Position; - // simulate write to compute offsets - fStream:=nil; - WriteTiff; - // write to stream - fStream:=Stream; - WriteTiff; - fStream:=nil; -end; - -procedure TBGRAWriterTiff.InternalWrite(Stream: TStream; Img: TFPCustomImage); -begin - AddImage(Img); - SaveToStream(Stream); -end; - -procedure TBGRAWriterTiff.AddEntryString(Tag: word; const s: string); -begin - if s<>'' then - AddEntry(Tag,2,length(s)+1,@s[1],length(s)+1) - else - AddEntry(Tag,2,0,nil,0); -end; - -procedure TBGRAWriterTiff.AddEntryShort(Tag: word; Value: Word); -begin - AddEntry(Tag,3,1,@Value,2); -end; - -procedure TBGRAWriterTiff.AddEntryLong(Tag: word; Value: LongWord); -begin - AddEntry(Tag,4,1,@Value,4); -end; - -procedure TBGRAWriterTiff.AddEntryShortOrLong(Tag: word; Value: LongWord); -begin - if Value<=High(Word) then - AddEntryShort(Tag,Value) - else - AddEntryLong(Tag,Value); -end; - -procedure TBGRAWriterTiff.AddEntryRational(Tag: word; const Value: TTiffRational - ); -begin - AddEntry(Tag,5,1,@Value,8); -end; - -procedure TBGRAWriterTiff.AddEntry(Tag: Word; EntryType: Word; EntryCount: LongWord; - Data: Pointer; Bytes: LongWord; CopyData: boolean); -var - Entry: TTiffWriterEntry; -begin - Entry:=TTiffWriterEntry.Create; - Entry.Tag:=Tag; - Entry.EntryType:=EntryType; - Entry.Count:=EntryCount; - if CopyData then begin - if Bytes>0 then begin - GetMem(Entry.Data,Bytes); - System.Move(Data^,Entry.Data^,Bytes); - end else begin - Entry.Data:=nil; - end; - end else - Entry.Data:=Data; - Entry.Bytes:=Bytes; - AddEntry(Entry); -end; - -procedure TBGRAWriterTiff.AddEntry(Entry: TTiffWriterEntry); -var - List: TFPList; -begin - List:=TFPList(FEntries[FEntries.Count-1]); - List.Add(Entry); -end; - -procedure TBGRAWriterTiff.TiffError(Msg: string); -begin - raise Exception.Create('TBGRAWriterTiff.TiffError: '+Msg); -end; - -procedure TBGRAWriterTiff.EncodeDeflate(var Buffer: Pointer; var Count: LongWord); -var - NewBuffer: PByte; - NewCount: LongWord; - ErrorMsg: String; -begin - ErrorMsg:=''; - NewBuffer:=nil; - try - NewCount:=Count; - if not CompressDeflate(Buffer,Count,NewBuffer,NewCount,@ErrorMsg) then - TiffError(ErrorMsg); - FreeMem(Buffer); - Buffer:=NewBuffer; - Count:=NewCount; - NewBuffer:=nil; - finally - ReAllocMem(NewBuffer,0); - end; -end; - -constructor TBGRAWriterTiff.Create; -begin - inherited Create; - FEntries:=TFPList.Create; - FSaveCMYKAsRGB:= true; - FPremultiplyRGB:= false; -end; - -destructor TBGRAWriterTiff.Destroy; -begin - Clear; - FreeAndNil(FEntries); - inherited Destroy; -end; - -procedure TBGRAWriterTiff.Clear; -begin - ClearEntries; -end; - -{ TTiffWriterEntry } - -destructor TTiffWriterEntry.Destroy; -begin - ReAllocMem(Data,0); - inherited Destroy; -end; - -{ TTiffWriterChunkOffsets } - -constructor TTiffWriterChunkOffsets.Create(ChunkType: TTiffChunkType); -begin - EntryType:=4; // long - ChunkByteCounts:=TTiffWriterEntry.Create; - ChunkByteCounts.EntryType:=4; // long - if ChunkType=tctTile then begin - Tag:=324; // TileOffsets - ChunkByteCounts.Tag:=325; // TileByteCounts - end else begin - Tag:=273; // StripOffsets - ChunkByteCounts.Tag:=279; // StripByteCounts - end; -end; - -destructor TTiffWriterChunkOffsets.Destroy; -var - i: Integer; -begin - if Chunks<>nil then begin - for i:=0 to Count-1 do - ReAllocMem(Chunks[i].Data,0); - ReAllocMem(Chunks,0); - end; - inherited Destroy; -end; - -procedure TTiffWriterChunkOffsets.SetCount(NewCount: LongWord); -var - Size: LongWord; -begin - {$IFDEF FPC_Debug_Image} - writeln('TTiffWriteStripOffsets.SetCount OldCount=',Count,' NewCount=',NewCount); - {$ENDIF} - Count:=NewCount; - Size:=Count*SizeOf(TTiffWriterChunk); - ReAllocMem(Chunks,Size); - if Size>0 then FillByte(Chunks^,Size,0); - Size:=Count*SizeOf(LongWord); - // Offsets - ReAllocMem(Data,Size); - if Size>0 then FillByte(Data^,Size,0); - Bytes:=Size; - // ByteCounts - ReAllocMem(ChunkByteCounts.Data,Size); - if Size>0 then FillByte(ChunkByteCounts.Data^,Size,0); - ChunkByteCounts.Count:=Count; - ChunkByteCounts.Bytes:=Size; -end; - -initialization - if ImageHandlers.ImageWriter[TiffHandlerName]=nil then - ImageHandlers.RegisterImageWriter (TiffHandlerName, 'tif;tiff', TBGRAWriterTiff); - DefaultBGRAImageWriter[ifTiff] := TBGRAWriterTiff; - -end. diff --git a/components/bgrabitmap/bgrawritewebp.pas b/components/bgrabitmap/bgrawritewebp.pas deleted file mode 100644 index 05ece31..0000000 --- a/components/bgrabitmap/bgrawritewebp.pas +++ /dev/null @@ -1,119 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit BGRAWriteWebP; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPimage; - -type - { TBGRAWriterWebP } - - TBGRAWriterWebP = class(TFPCustomImageWriter) - protected - FLossless: boolean; - FQualityPercent: Single; - procedure InternalWrite(Stream: TStream; Img: TFPCustomImage); override; - public - constructor Create; override; - property QualityPercent: single read FQualityPercent write FQualityPercent; - { If Lossless is set to True, the QualityPercent property is ignored } - property Lossless: boolean read FLossless write FLossless; - - end; - -implementation - -uses libwebp{$ifdef linux}, linuxlib{$endif}, BGRABitmapTypes; - -var - MyLibWebPLoaded: boolean; - -procedure NeedLibWebP; -begin - if not MyLibWebPLoaded then - begin - if not LibWebPLoad({$ifdef linux}FindLinuxLibrary('libwebp.so', 6){$endif}) then - raise exception.Create('Cannot find libwebp library ('+LibWebPFilename+')'); - MyLibWebPLoaded:= true; - end; -end; - -{ TBGRAWriterWebP } - -procedure TBGRAWriterWebP.InternalWrite(Stream: TStream; Img: TFPCustomImage); -const - CopySize = 65536; -var - saveFrom: TBGRACustomBitmap; - outSize, remain, toWrite: LongWord; - outData, p: PByte; -begin - NeedLibWebP; - saveFrom := BGRABitmapFactory.Create(Img); - outData := nil; - try - if saveFrom.LineOrder = riloBottomToTop then - saveFrom.VerticalFlip; - - {$PUSH}{$WARNINGS OFF} - if Lossless then - begin - if TBGRAPixel_RGBAOrder then - outSize := WebPEncodeLosslessRGBA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, - saveFrom.RowSize, outData{%H-}) - else - outSize := WebPEncodeLosslessBGRA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, - saveFrom.RowSize, outData{%H-}); - end else - begin - if TBGRAPixel_RGBAOrder then - outSize := WebPEncodeRGBA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, - saveFrom.RowSize, QualityPercent, outData{%H-}) - else - outSize := WebPEncodeBGRA(saveFrom.DataByte, saveFrom.Width, saveFrom.Height, - saveFrom.RowSize, QualityPercent, outData{%H-}); - end; - {$POP} - if outSize = 0 then - raise exception.Create('Error encoding WebP'); - - remain := outSize; - p := outData; - while remain > 0 do - begin - if remain > CopySize then toWrite := CopySize - else toWrite := remain; - Stream.WriteBuffer(p^, toWrite); - inc(p, toWrite); - dec(remain, toWrite); - end; - finally - if Assigned(outData) then WebPFree(outData); - saveFrom.Free; - end; -end; - -constructor TBGRAWriterWebP.Create; -begin - inherited Create; - FQualityPercent := 100; - FLossless:= True; -end; - -initialization - - DefaultBGRAImageWriter[ifWebP] := TBGRAWriterWebP; - -finalization - - if MyLibWebPLoaded then - begin - LibWebPUnload; - MyLibWebPLoaded:= false; - end; - -end. - diff --git a/components/bgrabitmap/blendpixelinline.inc b/components/bgrabitmap/blendpixelinline.inc deleted file mode 100644 index 015ffcf..0000000 --- a/components/bgrabitmap/blendpixelinline.inc +++ /dev/null @@ -1,1312 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -function ByteLinearMultiplyInline(a, b: byte): byte; -begin - if b = 255 then exit(a) else - begin - if b >= 128 then inc(b); - Result := (a * b) shr 8; - end; -end; - -procedure LinearMultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearMultiplyInline(dest^.red, c.red); - dest^.green := ByteLinearMultiplyInline(dest^.green, c.green); - dest^.blue := ByteLinearMultiplyInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearMultiplyInline(dest^.red, c.red) * - destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearMultiplyInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearMultiplyInline(dest^.blue, c.blue) * - destalpha + c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -{$hints off} -function ByteAddInline(a, b: byte): byte; -var - temp: LongWord; -begin - temp := LongWord(GammaExpansionTab[a]) + LongWord(GammaExpansionTab[b]); - if temp > 65535 then - temp := 65535; - Result := GammaCompressionTab[temp]; -end; -{$hints on} - -function ByteLinearAddInline(a, b: byte): byte; -var - temp: integer; -begin - temp := integer(a) + integer(b); - if temp > 255 then - temp := 255; - Result := temp; -end; - -procedure AddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteAddInline(dest^.red, c.red); - dest^.green := ByteAddInline(dest^.green, c.green); - dest^.blue := ByteAddInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := ByteAddInline(dest^.red * destalpha shr 8, c.red); - dest^.green := ByteAddInline(dest^.green * destalpha shr 8, c.green); - dest^.blue := ByteAddInline(dest^.blue * destalpha shr 8, c.blue); - dest^.alpha := c.alpha; - end; -end; - -procedure LinearAddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearAddInline(dest^.red, c.red); - dest^.green := ByteLinearAddInline(dest^.green, c.green); - dest^.blue := ByteLinearAddInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := ByteLinearAddInline(dest^.red * destalpha shr 8, c.red); - dest^.green := ByteLinearAddInline(dest^.green * destalpha shr 8, c.green); - dest^.blue := ByteLinearAddInline(dest^.blue * destalpha shr 8, c.blue); - dest^.alpha := c.alpha; - end; -end; - -function ByteBurnInline(a, b: byte): byte; inline; -var - temp: integer; -begin - if b = 0 then - Result := 0 - else - begin - temp := 255 - (((255 - a) shl 8) div b); - if temp < 0 then - Result := 0 - else - Result := temp; - end; -end; - -procedure ColorBurnPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteBurnInline(dest^.red, c.red); - dest^.green := ByteBurnInline(dest^.green, c.green); - dest^.blue := ByteBurnInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteBurnInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteBurnInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteBurnInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -{$hints off} -function ByteDodgeInline(a, b: byte): byte; inline; -var - temp: integer; -begin - if b = 255 then - Result := 255 - else - begin - temp := (a shl 8) div (not b); - if temp > 255 then - Result := 255 - else - Result := temp; - end; -end; -{$hints on} - -procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteDodgeInline(dest^.red, c.red); - dest^.green := ByteDodgeInline(dest^.green, c.green); - dest^.blue := ByteDodgeInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteDodgeInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteDodgeInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteDodgeInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -{$hints off} -function ByteDivideInline(a, b: byte): byte; inline; -var - temp: integer; -begin - if b = 0 then - Result := 255 - else if b = 255 then - exit(a) - else - begin - if b >= 128 then inc(b); - temp := ((a shl 8) + (b shr 1)) div b; - if temp > 255 then - Result := 255 - else - Result := temp; - end; -end; -{$hints on} - -procedure DividePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteDivideInline(dest^.red, c.red); - dest^.green := ByteDivideInline(dest^.green, c.green); - dest^.blue := ByteDivideInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteDivideInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteDivideInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteDivideInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -{$hints off} -function ByteNonLinearReflectInline(a, b: byte): byte; inline; -var - temp: LongWord; - wa,wb: word; -begin - if b = 255 then - Result := 255 - else - begin - wa := GammaExpansionTab[a]; - wb := GammaExpansionTab[b]; - temp := wa * wa div (not wb); - if temp >= 65535 then - Result := 255 - else - Result := GammaCompressionTab[ temp ]; - end; -end; - -function ByteReflectInline(a, b: byte): byte; inline; -var - temp: integer; -begin - if b = 255 then - Result := 255 - else - begin - temp := a * a div (not b); - if temp > 255 then - Result := 255 - else - Result := temp; - end; -end; -{$hints on} - -procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteReflectInline(dest^.red, c.red); - dest^.green := ByteReflectInline(dest^.green, c.green); - dest^.blue := ByteReflectInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteReflectInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteReflectInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteReflectInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -procedure GlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteReflectInline(c.red, dest^.red); - dest^.green := ByteReflectInline(c.green, dest^.green); - dest^.blue := ByteReflectInline(c.blue, dest^.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteReflectInline(c.red, dest^.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteReflectInline(c.red, dest^.red); - dest^.green := ByteReflectInline(c.green, dest^.green); - dest^.blue := ByteReflectInline(c.blue, dest^.blue); - end else - begin - dest^.red := (ByteReflectInline(c.red, dest^.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - end; - - if (c.red > c.green) and (c.red > c.blue) then - dest^.alpha := c.red else - if (c.green > c.blue) then - dest^.alpha := c.green else - dest^.alpha := c.blue; - dest^.alpha := ApplyOpacity(GammaExpansionTab[dest^.alpha] shr 8,c.alpha); -end; - -procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteNonLinearReflectInline(dest^.red, c.red); - dest^.green := ByteNonLinearReflectInline(dest^.green, c.green); - dest^.blue := ByteNonLinearReflectInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteNonLinearReflectInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteNonLinearReflectInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteNonLinearReflectInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -{$hints off} -function ByteOverlayInline(a, b: byte): byte; inline; -var wa,wb: word; -begin - wa := GammaExpansionTab[a]; - wb := GammaExpansionTab[b]; - if wa < 32768 then - Result := GammaCompressionTab[ (wa * wb) shr 15 ] - else - Result := GammaCompressionTab[ 65535 - ((not wa) * (not wb) shr 15) ]; -end; -{$hints on} - -function ByteLinearOverlayInline(a, b: byte): byte; inline; -begin - if a < 128 then - Result := (a * b) shr 7 - else - Result := 255 - ((not a) * (not b) shr 7); -end; - -procedure OverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteOverlayInline(dest^.red, c.red); - dest^.green := ByteOverlayInline(dest^.green, c.green); - dest^.blue := ByteOverlayInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteOverlayInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteOverlayInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteOverlayInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearOverlayInline(dest^.red, c.red); - dest^.green := ByteLinearOverlayInline(dest^.green, c.green); - dest^.blue := ByteLinearOverlayInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearOverlayInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearOverlayInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearOverlayInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteDifferenceInline(a, b: byte): byte; inline; -begin - Result := GammaCompressionTab[abs(integer(GammaExpansionTab[a]) - - integer(GammaExpansionTab[b]))]; -end; - -procedure DifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteDifferenceInline(dest^.red, c.red); - dest^.green := ByteDifferenceInline(dest^.green, c.green); - dest^.blue := ByteDifferenceInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteDifferenceInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteDifferenceInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteDifferenceInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteLinearDifferenceInline(a, b: byte): byte; inline; -begin - Result := abs(a - b); -end; - -procedure LinearDifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearDifferenceInline(dest^.red, c.red); - dest^.green := ByteLinearDifferenceInline(dest^.green, c.green); - dest^.blue := ByteLinearDifferenceInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearDifferenceInline(dest^.red, c.red) * - destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearDifferenceInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearDifferenceInline(dest^.blue, c.blue) * - destalpha + c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteExclusionInline(a, b: byte): byte; inline; -var aw,bw: word; -begin - aw := GammaExpansionTab[a]; - bw := GammaExpansionTab[b]; - {$HINTS OFF} - Result := GammaCompressionTab[aw+bw-(LongWord(aw)*LongWord(bw) shr 15)]; - {$HINTS ON} -end; - -procedure ExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteExclusionInline(dest^.red, c.red); - dest^.green := ByteExclusionInline(dest^.green, c.green); - dest^.blue := ByteExclusionInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteExclusionInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteExclusionInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteExclusionInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteLinearExclusionInline(a, b: byte): byte; inline; -begin - {$HINTS OFF} - Result := a+b-(a*b shr 7); - {$HINTS ON} -end; - -procedure LinearExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearExclusionInline(dest^.red, c.red); - dest^.green := ByteLinearExclusionInline(dest^.green, c.green); - dest^.blue := ByteLinearExclusionInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearExclusionInline(dest^.red, c.red) * - destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearExclusionInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearExclusionInline(dest^.blue, c.blue) * - destalpha + c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteLinearSubtractInline(a, b: byte): byte; inline; -begin - if b >= a then - result := 0 - else - result := a-b; -end; - -procedure LinearSubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearSubtractInline(dest^.red, c.red); - dest^.green := ByteLinearSubtractInline(dest^.green, c.green); - dest^.blue := ByteLinearSubtractInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearSubtractInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearSubtractInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearSubtractInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -procedure LinearSubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearSubtractInline(dest^.red, not c.red); - dest^.green := ByteLinearSubtractInline(dest^.green, not c.green); - dest^.blue := ByteLinearSubtractInline(dest^.blue, not c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearSubtractInline(dest^.red, not c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearSubtractInline(dest^.green, not c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearSubtractInline(dest^.blue, not c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteSubtractInline(a, b: byte): byte; inline; -begin - if b >= a then - result := 0 - else - result := GammaCompressionTab[integer(GammaExpansionTab[a]) - - integer(GammaExpansionTab[b])]; -end; - -procedure SubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteSubtractInline(dest^.red, c.red); - dest^.green := ByteSubtractInline(dest^.green, c.green); - dest^.blue := ByteSubtractInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteSubtractInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteSubtractInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteSubtractInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteSubtractInverseInline(a, b: byte): byte; inline; -var aw,bw: word; -begin - aw := GammaExpansionTab[a]; - bw := not GammaExpansionTab[b]; - if bw >= aw then - result := 0 - else - result := GammaCompressionTab[aw-bw]; -end; - -procedure SubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteSubtractInverseInline(dest^.red, c.red); - dest^.green := ByteSubtractInverseInline(dest^.green, c.green); - dest^.blue := ByteSubtractInverseInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteSubtractInverseInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteSubtractInverseInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteSubtractInverseInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteNegationInline(a, b: byte): byte; inline; -var - sum: integer; -begin - sum := integer(GammaExpansionTab[a]) + integer(GammaExpansionTab[b]); - if sum > 65535 then - sum := 131071 - sum; - Result := GammaCompressionTab[sum]; -end; - -function ByteLinearNegationInline(a, b: byte): byte; inline; -var - sum: integer; -begin - sum := integer(a) + integer(b); - if sum > 255 then - Result := 511 - sum - else - Result := sum; -end; - -procedure NegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteNegationInline(dest^.red, c.red); - dest^.green := ByteNegationInline(dest^.green, c.green); - dest^.blue := ByteNegationInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteNegationInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteNegationInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteNegationInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -procedure LinearNegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLinearNegationInline(dest^.red, c.red); - dest^.green := ByteLinearNegationInline(dest^.green, c.green); - dest^.blue := ByteLinearNegationInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearNegationInline(dest^.red, c.red) * - destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearNegationInline(dest^.green, c.green) * - destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearNegationInline(dest^.blue, c.blue) * - destalpha + c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteLightenInline(a, b: byte): byte; inline; -begin - if a > b then - Result := a - else - Result := b; -end; - -procedure LightenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteLightenInline(dest^.red, c.red); - dest^.green := ByteLightenInline(dest^.green, c.green); - dest^.blue := ByteLightenInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLightenInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteLightenInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLightenInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteDarkenInline(a, b: byte): byte; inline; -begin - if a < b then - Result := a - else - Result := b; -end; - -procedure DarkenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteDarkenInline(dest^.red, c.red); - dest^.green := ByteDarkenInline(dest^.green, c.green); - dest^.blue := ByteDarkenInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteDarkenInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteDarkenInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteDarkenInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -{$hints off} -function ScreenByteInline(a, b: byte): byte; -begin - Result := 255 - ((not a) * (not b) shr 8); -end; -{$hints on} - -procedure ScreenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ScreenByteInline(dest^.red, c.red); - dest^.green := ScreenByteInline(dest^.green, c.green); - dest^.blue := ScreenByteInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ScreenByteInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ScreenByteInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ScreenByteInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteSoftLightInline(a,b: byte): byte; inline; -begin - result := ((not a)*b shr 7 + a)*a div 255; -end; - -procedure SoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteSoftLightInline(dest^.red, c.red); - dest^.green := ByteSoftLightInline(dest^.green, c.green); - dest^.blue := ByteSoftLightInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteSoftLightInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteSoftLightInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteSoftLightInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteSvgSoftLightInline(a,b: byte): byte; inline; -begin - if b <= 128 then - result := a - (((256 - b-b)*a shr 8)*(not a) shr 8) - else - begin - dec(b, 128); - if a <= 64 then - result := a + ((b+b) * UInt32or64(a*7 - ((a shl 2)*(a shl 2 + 256)*UInt32or64(256 - a) shr 16)) shr 8) - else - result := a + ((b+b+1) * UInt32or64(ByteSqrt(a)-a) shr 8); - end; -end; - -procedure SvgSoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteSvgSoftLightInline(dest^.red, c.red); - dest^.green := ByteSvgSoftLightInline(dest^.green, c.green); - dest^.blue := ByteSvgSoftLightInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteSvgSoftLightInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteSvgSoftLightInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteSvgSoftLightInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -function ByteHardLightInline(a,b: byte): byte; inline; -begin - if b <= 128 then - result := a*b shr 7 - else - result := 255 - ((not a)*(not b) shr 7); -end; - -procedure HardLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := ByteHardLightInline(dest^.red, c.red); - dest^.green := ByteHardLightInline(dest^.green, c.green); - dest^.blue := ByteHardLightInline(dest^.blue, c.blue); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteHardLightInline(dest^.red, c.red) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteHardLightInline(dest^.green, c.green) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteHardLightInline(dest^.blue, c.blue) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -procedure BlendXorPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - if destalpha = 255 then - begin - dest^.red := dest^.red xor c.red; - dest^.green := dest^.green xor c.green; - dest^.blue := dest^.blue xor c.blue; - dest^.alpha := c.alpha; - end else - begin - dest^.red := ((dest^.red xor c.red) * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := ((dest^.green xor c.green) * destalpha + c.green * - (not destalpha)) shr 8; - dest^.blue := ((dest^.blue xor c.blue) * destalpha + c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; -end; - -procedure BlendMaskPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -const alphaMax = 255*7; -var alpha: byte; -begin - alpha := (c.green shl 2) + (c.red shl 1) + c.blue; - alpha := alpha*c.alpha + (255*7)*(not c.alpha); - alpha := (alpha + (alphaMax shr 1)) div alphaMax; - if alpha = 0 then dest^ := BGRAPixelTransparent - else dest^.alpha := alpha; -end; - -function ByteLinearMultiplySaturationInline(a,b,l: byte): byte; inline; -begin - if b = 255 then - result := a - else if b = 0 then - result := l - else - result := (a-l)*b div 255 + l; -end; - -procedure LinearMultiplySaturationInline(dest: PBGRAPixel; c: TBGRAPixel); inline; -var - destalpha: byte; - mini,maxi,l: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - mini := dest^.red; maxi := dest^.red; - if dest^.green < mini then mini := dest^.green else - if dest^.green > maxi then maxi := dest^.green; - if dest^.blue < mini then mini := dest^.blue else - if dest^.blue > maxi then maxi := dest^.blue; - l := (mini+maxi) div 2; - - if destalpha = 255 then - begin - dest^.red := ByteLinearMultiplySaturationInline(dest^.red, c.red, l); - dest^.green := ByteLinearMultiplySaturationInline(dest^.green, c.green, l); - dest^.blue := ByteLinearMultiplySaturationInline(dest^.blue, c.blue, l); - dest^.alpha := c.alpha; - end else - begin - dest^.red := (ByteLinearMultiplySaturationInline(dest^.red, c.red, l) * destalpha + - c.red * (not destalpha)) shr 8; - dest^.green := (ByteLinearMultiplySaturationInline(dest^.green, c.green, l) * destalpha + - c.green * (not destalpha)) shr 8; - dest^.blue := (ByteLinearMultiplySaturationInline(dest^.blue, c.blue, l) * destalpha + - c.blue * (not destalpha)) shr 8; - dest^.alpha := c.alpha; - end; - end; -end; - -procedure LinearHueInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; - srcHSLA, destHSLA: TStdHSLA; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - srcHSLA := c.ToStdHSLA; - destHSLA := dest^.ToStdHSLA; - - destHSLA.hue := srcHSLA.hue; - destHSLA.alpha:= srcHSLA.alpha; - dest^ := destHSLA; - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; - -procedure LinearColorInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; - srcHSLA, destHSLA: TStdHSLA; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - srcHSLA := c.ToStdHSLA; - destHSLA := dest^.ToStdHSLA; - srcHSLA.lightness := destHSLA.lightness; - dest^ := srcHSLA; - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; - -procedure LinearLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; - destHSLA: TStdHSLA; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - destHSLA := dest^.ToStdHSLA; - destHSLA.lightness := c.ToStdHSLA.lightness; - dest^ := destHSLA; - dest^.alpha := c.alpha; - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; - -procedure LinearSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; - destHSLA: TStdHSLA; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - destHSLA := dest^.ToStdHSLA; - if destHSLA.saturation <> 0 then - begin - destHSLA.saturation:= c.ToStdHSLA.saturation; - dest^ := destHSLA; - end; - dest^.alpha := c.alpha; - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; - -procedure CorrectedHueInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; - srcGSBA, destGSBA: TGSBAPixel; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - srcGSBA := c.ToGSBAPixel; - destGSBA := dest^.ToGSBAPixel; - destGSBA.hue := srcGSBA.hue; - destGSBA.alpha:= srcGSBA.alpha; - dest^ := destGSBA; - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; - -procedure CorrectedColorInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - dest^ := SetLightness(c, dest^.Lightness); - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; - -procedure CorrectedLightnessInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - dest^ := SetLightness(dest^, c.Lightness); - dest^.alpha := c.alpha; - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; - -procedure CorrectedSaturationInline(dest: PBGRAPixel; c: TBGRAPixel); -var - destalpha: byte; - destGSBA: TGSBAPixel; -begin - destalpha := dest^.alpha; - if destalpha = 0 then - begin - dest^ := c - end else - begin - destGSBA := dest^.ToGSBAPixel; - if destGSBA.saturation <> 0 then - begin - destGSBA.saturation:= c.ToGSBAPixel.saturation; - dest^ := destGSBA; - end; - dest^.alpha := c.alpha; - - if destalpha <> 255 then - begin - dest^.red := (dest^.red * destalpha + c.red * (not destalpha)) shr 8; - dest^.green := (dest^.green * destalpha + c.green * (not destalpha)) shr 8; - dest^.blue := (dest^.blue * destalpha + c.blue * (not destalpha)) shr 8; - end; - end; -end; diff --git a/components/bgrabitmap/blendpixels.inc b/components/bgrabitmap/blendpixels.inc deleted file mode 100644 index ba55e70..0000000 --- a/components/bgrabitmap/blendpixels.inc +++ /dev/null @@ -1,497 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -procedure FastBlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - FastBlendPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DrawTransparentPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearMultiplyPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearMultiplyPixelInline(pdest, psrc^); //same look with non linear - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure AddPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - AddPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearAddPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearAddPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ColorBurnPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - ColorBurnPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ColorDodgePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - ColorDodgePixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DividePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - DividePixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ReflectPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - ReflectPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure GlowPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - GlowPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure NiceGlowPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - NiceGlowPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure OverlayPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - OverlayPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearOverlayPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearOverlayPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DifferencePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - DifferencePixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearDifferencePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearDifferencePixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ExclusionPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - ExclusionPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearExclusionPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearExclusionPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSubtractPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearSubtractPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSubtractInversePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearSubtractInversePixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SubtractPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - SubtractPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SubtractInversePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - SubtractInversePixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure NegationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - NegationPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearNegationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearNegationPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LightenPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LightenPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DarkenPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - DarkenPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ScreenPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - ScreenPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SoftLightPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - SoftLightPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SvgSoftLightPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - SvgSoftLightPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure HardLightPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - HardLightPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure BlendXorPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - BlendXorPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure BlendMaskPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - BlendMaskPixelInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearMultiplySaturationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearMultiplySaturationInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearHuePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearHueInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearColorPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearColorInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearLightnessPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearLightnessInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSaturationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - LinearSaturationInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedHuePixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - CorrectedHueInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedColorPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - CorrectedColorInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedLightnessPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - CorrectedLightnessInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedSaturationPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); -begin - while Count > 0 do - begin - CorrectedSaturationInline(pdest, psrc^); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -type - TBlendPixelsProc = procedure(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer); - -const - BlendPixelsProc: array[TBlendOperation] of TBlendPixelsProc = - ( @FastBlendPixels, @DrawTransparentPixels, - @LightenPixels, @ScreenPixels, @AddPixels, @LinearAddPixels, @ColorDodgePixels, @DividePixels, @NiceGlowPixels, @SoftLightPixels, @HardLightPixels, - @GlowPixels, @ReflectPixels, @LinearOverlayPixels, @OverlayPixels, @DarkenPixels, @LinearMultiplyPixels, @ColorBurnPixels, - @DifferencePixels, @LinearDifferencePixels, @ExclusionPixels, @LinearExclusionPixels, @SubtractPixels, @LinearSubtractPixels, - @SubtractInversePixels, @LinearSubtractInversePixels, @NegationPixels, @LinearNegationPixels, @BlendXorPixels, @SvgSoftLightPixels, - @BlendMaskPixels, @LinearMultiplySaturationPixels, @LinearHuePixels, @LinearColorPixels, @LinearLightnessPixels, @LinearSaturationPixels, - @CorrectedHuePixels, @CorrectedColorPixels, @CorrectedLightnessPixels, @CorrectedSaturationPixels); - -procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; - blendOp: TBlendOperation; Count: integer; excludeChannels: TChannels = []); -const BufSize = 8; -var - destBuf: array[0..BufSize-1] of TBGRAPixel; - i: PtrInt; -begin - if (excludeChannels = [cRed,cGreen,cBlue,cAlpha]) or - ((blendOp = boMask) and (cAlpha in excludeChannels)) then exit; - - if excludeChannels = [] then - BlendPixelsProc[blendOp](pdest, psrc, count) else - begin - while Count >= BufSize do - begin - move(pdest^, {%H-}destBuf, sizeof(destBuf)); - BlendPixelsProc[blendOp](@destBuf, psrc, BufSize); - for i := 0 to BufSize-1 do - begin - if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; - if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; - if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; - if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; - inc(pdest); - end; - dec(count, BufSize); - end; - if count > 0 then - begin - move(pdest^, {%H-}destBuf, count*sizeof(TBGRAPixel)); - BlendPixelsProc[blendOp](@destBuf, psrc, count); - for i := 0 to count-1 do - begin - if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; - if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; - if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; - if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; - inc(pdest); - end; - end; - end; -end; - diff --git a/components/bgrabitmap/blendpixelsover.inc b/components/bgrabitmap/blendpixelsover.inc deleted file mode 100644 index dd9cc22..0000000 --- a/components/bgrabitmap/blendpixelsover.inc +++ /dev/null @@ -1,1154 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{************************* blend over ***************************} - -procedure FastBlendPixelsWithOpacity(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -begin - while Count > 0 do - begin - FastBlendPixelInline(pdest, psrc^, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DrawPixelsWithOpacity(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -begin - while Count > 0 do - begin - DrawPixelInlineWithAlphaCheck(pdest, psrc^, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearMultiplyPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearMultiplyPixelInline(@temp, psrc^); //same look with non linear - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearMultiplyPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearMultiplyPixelInline(@temp, psrc^); //same look with non linear - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure AddPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - AddPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure AddPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - AddPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearAddPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearAddPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearAddPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearAddPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ColorBurnPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ColorBurnPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ColorBurnPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ColorBurnPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ColorDodgePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ColorDodgePixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ColorDodgePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ColorDodgePixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DividePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - DividePixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DividePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - DividePixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ReflectPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ReflectPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ReflectPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ReflectPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure GlowPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - GlowPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure GlowPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - GlowPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure NiceGlowPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - NiceGlowPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure NiceGlowPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - NiceGlowPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure OverlayPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - OverlayPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure OverlayPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - OverlayPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearOverlayPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearOverlayPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearOverlayPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearOverlayPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DifferencePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - DifferencePixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DifferencePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - DifferencePixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearDifferencePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearDifferencePixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearDifferencePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearDifferencePixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ExclusionPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ExclusionPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ExclusionPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ExclusionPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearExclusionPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearExclusionPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearExclusionPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearExclusionPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSubtractPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearSubtractPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSubtractPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearSubtractPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSubtractInversePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearSubtractInversePixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSubtractInversePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearSubtractInversePixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SubtractPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SubtractPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SubtractPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SubtractPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SubtractInversePixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SubtractInversePixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SubtractInversePixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SubtractInversePixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure NegationPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - NegationPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure NegationPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - NegationPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearNegationPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearNegationPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearNegationPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearNegationPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LightenPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LightenPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LightenPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LightenPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DarkenPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - DarkenPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure DarkenPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - DarkenPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ScreenPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ScreenPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure ScreenPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - ScreenPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SoftLightPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SoftLightPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SvgSoftLightPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SvgSoftLightPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SoftLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SoftLightPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure SvgSoftLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - SvgSoftLightPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure HardLightPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - HardLightPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure HardLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - HardLightPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure BlendXorPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - BlendXorPixelInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure BlendXorPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - BlendXorPixelInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure MaskPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -const alphaMax = 255*7*255; -var - alpha, opacity256: UInt32or64; - newAlpha: byte; -begin - if Opacity >= 128 then opacity256 := Opacity+1 else opacity256 := Opacity; - while Count > 0 do - begin - if pdest^.alpha > 0 then - begin - alpha := (psrc^.green shl 2) + (psrc^.red shl 1) + psrc^.blue; - alpha := alpha*psrc^.alpha + (255*7)*(not psrc^.alpha); - newAlpha := (pdest^.alpha * alpha + (alphaMax shr 1)) div alphaMax; - pdest^.alpha := (pdest^.alpha*UInt32or64(256 - opacity256) + newAlpha*opacity256) shr 8; - if pdest^.alpha = 0 then pdest^ := BGRAPixelTransparent; - end; - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearMultiplySaturationLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearMultiplySaturationInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearHueLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearHueInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearColorLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearColorInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearLightnessLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearLightnessInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSaturationLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearSaturationInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedHueLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedHueInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedColorLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedColorInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedLightnessLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedLightnessInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedSaturationLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedSaturationInline(@temp, psrc^); - FastBlendPixelInline(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearMultiplySaturationDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearMultiplySaturationInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearHueDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearHueInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearColorDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearColorInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearLightnessDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearLightnessInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure LinearSaturationDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - LinearSaturationInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedHueDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedHueInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedColorDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedColorInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedLightnessDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedLightnessInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -procedure CorrectedSaturationDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); -var temp: TBGRAPixel; -begin - while Count > 0 do - begin - temp := pdest^; - CorrectedSaturationInline(@temp, psrc^); - DrawPixelInlineWithAlphaCheck(pdest, temp, opacity); - Inc(pdest); - Inc(psrc); - Dec(Count); - end; -end; - -{************************** table ****************************************} - -type - TBlendPixelsOverProc = procedure(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte); - -const - BlendPixelsOverProc: array[Boolean, TBlendOperation] of TBlendPixelsOverProc = - ( (@FastBlendPixelsWithOpacity, @DrawPixelsWithOpacity, - @LightenPixelsDrawOver, @ScreenPixelsDrawOver, @AddPixelsDrawOver, @LinearAddPixelsDrawOver, @ColorDodgePixelsDrawOver, @DividePixelsDrawOver, @NiceGlowPixelsDrawOver, @SoftLightPixelsDrawOver, @HardLightPixelsDrawOver, - @GlowPixelsDrawOver, @ReflectPixelsDrawOver, @LinearOverlayPixelsDrawOver, @OverlayPixelsDrawOver, @DarkenPixelsDrawOver, @LinearMultiplyPixelsDrawOver, @ColorBurnPixelsDrawOver, - @DifferencePixelsDrawOver, @LinearDifferencePixelsDrawOver, @ExclusionPixelsDrawOver, @LinearExclusionPixelsDrawOver, @SubtractPixelsDrawOver, @LinearSubtractPixelsDrawOver, - @SubtractInversePixelsDrawOver, @LinearSubtractInversePixelsDrawOver, @NegationPixelsDrawOver, @LinearNegationPixelsDrawOver, @BlendXorPixelsDrawOver, @SvgSoftLightPixelsDrawOver, - @MaskPixelsDrawOver, @LinearMultiplySaturationDrawOver, @LinearHueDrawOver, @LinearColorDrawOver, @LinearLightnessDrawOver, @LinearSaturationDrawOver, - @CorrectedHueDrawOver, @CorrectedColorDrawOver, @CorrectedLightnessDrawOver, @CorrectedSaturationDrawOver), - (@FastBlendPixelsWithOpacity, @FastBlendPixelsWithOpacity, - @LightenPixelsLinearOver, @ScreenPixelsLinearOver, @AddPixelsLinearOver, @LinearAddPixelsLinearOver, @ColorDodgePixelsLinearOver, @DividePixelsLinearOver, @NiceGlowPixelsLinearOver, @SoftLightPixelsLinearOver, @HardLightPixelsLinearOver, - @GlowPixelsLinearOver, @ReflectPixelsLinearOver, @LinearOverlayPixelsLinearOver, @OverlayPixelsLinearOver, @DarkenPixelsLinearOver, @LinearMultiplyPixelsLinearOver, @ColorBurnPixelsLinearOver, - @DifferencePixelsLinearOver, @LinearDifferencePixelsLinearOver, @ExclusionPixelsLinearOver, @LinearExclusionPixelsLinearOver, @SubtractPixelsLinearOver, @LinearSubtractPixelsLinearOver, - @SubtractInversePixelsLinearOver, @LinearSubtractInversePixelsLinearOver, @NegationPixelsLinearOver, @LinearNegationPixelsLinearOver, @BlendXorPixelsLinearOver, @SvgSoftLightPixelsLinearOver, - @MaskPixelsDrawOver, @LinearMultiplySaturationLinearOver, @CorrectedHueLinearOver, @LinearColorLinearOver, @LinearLightnessLinearOver, @LinearSaturationLinearOver, - @CorrectedHueLinearOver, @CorrectedColorLinearOver, @CorrectedLightnessLinearOver, @CorrectedSaturationLinearOver)); - -{************************* calling procedure ***************************} - -procedure BlendPixelsOver(pdest: PBGRAPixel; psrc: PBGRAPixel; - blendOp: TBlendOperation; Count: integer; opacity: byte; linearBlend: boolean; excludeChannels: TChannels = []); -const BufSize = 8; -var - destBuf: array[0..BufSize-1] of TBGRAPixel; - i: PtrInt; - blendProc: TBlendPixelsOverProc; -begin - if (excludeChannels = [cRed,cGreen,cBlue,cAlpha]) or - ((blendOp = boMask) and (cAlpha in excludeChannels)) or - (opacity = 0) then exit; - - blendProc := BlendPixelsOverProc[linearblend, blendOp]; - if excludeChannels = [] then - blendProc(pdest, psrc, count, opacity) else - begin - while Count >= BufSize do - begin - move(pdest^, {%H-}destBuf, sizeof(destBuf)); - blendProc(@destBuf, psrc, BufSize, opacity); - for i := 0 to BufSize-1 do - begin - if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; - if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; - if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; - if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; - inc(pdest); - end; - dec(count, BufSize); - end; - if count > 0 then - begin - move(pdest^, {%H-}destBuf, count*sizeof(TBGRAPixel)); - blendProc(@destBuf, psrc, count, opacity); - for i := 0 to count-1 do - begin - if not (cRed in excludeChannels) then pdest^.red := destBuf[i].red; - if not (cGreen in excludeChannels) then pdest^.green := destBuf[i].green; - if not (cBlue in excludeChannels) then pdest^.blue := destBuf[i].blue; - if not (cAlpha in excludeChannels) then pdest^.alpha := destBuf[i].alpha; - inc(pdest); - end; - end; - end; -end; - diff --git a/components/bgrabitmap/blurbox.inc b/components/bgrabitmap/blurbox.inc deleted file mode 100644 index 5afbf60..0000000 --- a/components/bgrabitmap/blurbox.inc +++ /dev/null @@ -1,464 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -procedure IncAcc(var ADest: TAccumulator; ADelta: TAccumulator); inline; -begin - {$IFDEF PARAM_USE_INC64} - inc64(ADest, ADelta); - {$ELSE} - inc(ADest, ADelta); - {$ENDIF} -end; -procedure DecAcc(var ADest: TAccumulator; ADelta: TAccumulator); inline; -begin - {$IFDEF PARAM_USE_INC64} - dec64(ADest, ADelta); - {$ELSE} - dec(ADest, ADelta); - {$ENDIF} -end; - -type - TVertical = record red,green,blue,alpha,count: TAccumulator; end; - PVertical = ^TVertical; -var - verticals: PVertical; - left,right,width,height: Int32or64; - iRadiusX,iRadiusY: Int32or64; - factExtraX,factExtraY: UInt32or64; - - procedure PrepareVerticals; - var - xb,yb: Int32or64; - psrc,p: PByte; - pvert : PVertical; - {%H-}a2: UInt32or64; - delta: PtrInt; - srcPixSize: Integer; - begin - delta := ASource.RowSize; - if ASource.LineOrder = riloBottomToTop then delta := -delta; - srcPixSize := ASource.Colorspace.GetSize; - - fillchar(verticals^, width*sizeof(TVertical), 0); - psrc := ASource.GetPixelAddress(left,ABounds.Top); - pvert := verticals; - if factExtraY = 0 then - begin - for xb := left to right-1 do - begin - p := psrc; - for yb := 0 to iRadiusY-1 do - begin - if yb = height then break; - {$IFDEF PARAM_BYTEMASK} - IncAcc(pvert^.green, p^); - IncAcc(pvert^.alpha, 1); - {$ELSE} - with PBGRAPixel(p)^ do - if alpha <> 0 then - begin - a2 := alpha; - {$HINTS OFF} - IncAcc(pvert^.red, red * a2); - IncAcc(pvert^.green, green * a2); - IncAcc(pvert^.blue, blue * a2); - IncAcc(pvert^.alpha, a2); - {$HINTS ON} - end; - {$ENDIF} - inc(pvert^.count); - inc(p, delta); - end; - inc(pvert); - inc(psrc, srcPixSize); - end; - end else - begin - for xb := left to right-1 do - begin - p := psrc; - for yb := 0 to iRadiusY-1 do - begin - if yb = height then break; - {$IFDEF PARAM_BYTEMASK} - IncAcc(pvert^.green, p^ * factMainY); - IncAcc(pvert^.alpha, factMainY); - {$ELSE} - with PBGRAPixel(p)^ do - if alpha <> 0 then - begin - a2 := alpha * factMainY; - {$HINTS OFF} - IncAcc(pvert^.red, red * a2); - IncAcc(pvert^.green, green * a2); - IncAcc(pvert^.blue, blue * a2); - IncAcc(pvert^.alpha, a2); - {$HINTS ON} - end; - {$ENDIF} - inc(pvert^.count, factMainY); - inc(p, delta); - end; - if iRadiusY < height then - begin - {$IFDEF PARAM_BYTEMASK} - IncAcc(pvert^.green, p^ * factExtraY); - IncAcc(pvert^.alpha, factExtraY); - {$ELSE} - with PBGRAPixel(p)^ do - if alpha <> 0 then - begin - a2 := alpha * factExtraY; - {$HINTS OFF} - IncAcc(pvert^.red, red * a2); - IncAcc(pvert^.green, green * a2); - IncAcc(pvert^.blue, blue * a2); - IncAcc(pvert^.alpha, a2); - {$HINTS ON} - end; - {$ENDIF} - inc(pvert^.count, factExtraY); - end; - inc(pvert); - inc(psrc, srcPixSize); - end; - end; - end; - - procedure NextVerticals(y: integer); - var - psrc0,psrc1,psrc2,psrc3: PByte; - pvert : PVertical; - xb: Int32or64; - {%H-}a2: UInt32or64; - srcPixSize: Integer; - begin - pvert := verticals; - if y-iRadiusY-1 >= ABounds.Top then - psrc1 := ASource.GetPixelAddress(left, y-iRadiusY-1) - else - psrc1 := nil; - if y+iRadiusY < ABounds.Bottom then - psrc2 := ASource.GetPixelAddress(left, y+iRadiusY) - else - psrc2 := nil; - srcPixSize := ASource.Colorspace.GetSize; - if factExtraY = 0 then - begin - for xb := width-1 downto 0 do - begin - if psrc1 <> nil then - begin - {$IFDEF PARAM_BYTEMASK} - DecAcc(pvert^.green, psrc1^); - DecAcc(pvert^.alpha, 1); - {$ELSE} - with PBGRAPixel(psrc1)^ do - if alpha <> 0 then - begin - {$HINTS OFF} - DecAcc(pvert^.red, red * alpha); - DecAcc(pvert^.green, green * alpha); - DecAcc(pvert^.blue, blue * alpha); - DecAcc(pvert^.alpha, alpha); - {$HINTS ON} - end; - {$ENDIF} - dec(pvert^.count); - inc(psrc1,srcPixSize); - end; - if psrc2 <> nil then - begin - {$IFDEF PARAM_BYTEMASK} - IncAcc(pvert^.green, psrc2^); - IncAcc(pvert^.alpha, 1); - {$ELSE} - with PBGRAPixel(psrc2)^ do - if alpha <> 0 then - begin - {$HINTS OFF} - IncAcc(pvert^.red, red * alpha); - IncAcc(pvert^.green, green * alpha); - IncAcc(pvert^.blue, blue * alpha); - IncAcc(pvert^.alpha, alpha); - {$HINTS ON} - end; - {$ENDIF} - inc(pvert^.count); - inc(psrc2,srcPixSize); - end; - inc(pvert); - end; - end else - begin - if y-iRadiusY-2 >= ABounds.Top then - psrc0 := ASource.GetPixelAddress(left,y-iRadiusY-2) - else - psrc0 := nil; - if y+iRadiusY+1 < ABounds.Bottom then - psrc3 := ASource.GetPixelAddress(left,y+iRadiusY+1) - else - psrc3 := nil; - for xb := width-1 downto 0 do - begin - if psrc0 <> nil then - begin - {$IFDEF PARAM_BYTEMASK} - DecAcc(pvert^.green, psrc0^*factExtraY); - DecAcc(pvert^.alpha, factExtraY); - {$ELSE} - with PBGRAPixel(psrc0)^ do - if alpha <> 0 then - begin - a2 := alpha*factExtraY; - {$HINTS OFF} - DecAcc(pvert^.red, red * a2); - DecAcc(pvert^.green, green * a2); - DecAcc(pvert^.blue, blue * a2); - DecAcc(pvert^.alpha, a2); - {$HINTS ON} - end; - {$ENDIF} - dec(pvert^.count,factExtraY); - inc(psrc0,srcPixSize); - end; - if psrc1 <> nil then - begin - {$IFDEF PARAM_BYTEMASK} - DecAcc(pvert^.green, psrc1^*(factMainY - factExtraY)); - DecAcc(pvert^.alpha, (factMainY - factExtraY)); - {$ELSE} - with PBGRAPixel(psrc1)^ do - if alpha <> 0 then - begin - a2 := alpha*(factMainY - factExtraY); - {$HINTS OFF} - DecAcc(pvert^.red, red * a2); - DecAcc(pvert^.green, green * a2); - DecAcc(pvert^.blue, blue * a2); - DecAcc(pvert^.alpha, a2); - {$HINTS ON} - end; - {$ENDIF} - dec(pvert^.count, factMainY - factExtraY); - inc(psrc1,srcPixSize); - end; - if psrc2 <> nil then - begin - {$IFDEF PARAM_BYTEMASK} - IncAcc(pvert^.green, psrc2^*(factMainY - factExtraY)); - IncAcc(pvert^.alpha, (factMainY - factExtraY)); - {$ELSE} - with PBGRAPixel(psrc2)^ do - if alpha <> 0 then - begin - a2 := alpha*(factMainY - factExtraY); - {$HINTS OFF} - IncAcc(pvert^.red, red * a2); - IncAcc(pvert^.green, green * a2); - IncAcc(pvert^.blue, blue * a2); - IncAcc(pvert^.alpha, a2); - {$HINTS ON} - end; - {$ENDIF} - inc(pvert^.count, factMainY - factExtraY); - inc(psrc2,srcPixSize); - end; - if psrc3 <> nil then - begin - {$IFDEF PARAM_BYTEMASK} - IncAcc(pvert^.green, psrc3^*factExtraY); - IncAcc(pvert^.alpha, factExtraY); - {$ELSE} - with PBGRAPixel(psrc3)^ do - if alpha <> 0 then - begin - a2 := alpha*factExtraY; - {$HINTS OFF} - IncAcc(pvert^.red, red * a2); - IncAcc(pvert^.green, green * a2); - IncAcc(pvert^.blue, blue * a2); - IncAcc(pvert^.alpha, a2); - {$HINTS ON} - end; - {$ENDIF} - inc(pvert^.count,factExtraY); - inc(psrc3,srcPixSize); - end; - inc(pvert); - end; - end; - end; - - procedure MainLoop; - var - xb,yb,xdest: Int32or64; - pdest: PByte; - pvert : PVertical; - sumRed,sumGreen,sumBlue,sumAlpha,sumCount, - sumRed2,sumGreen2,sumBlue2,sumAlpha2,sumCount2, - {%H-}sumRed3,sumGreen3,{%H-}sumBlue3,sumAlpha3,{%H-}sumCount3: TAccumulator; - destPixSize: Integer; - begin - destPixSize := ADestination.Colorspace.GetSize; - for yb := ABounds.Top to ABounds.Bottom-1 do - begin - NextVerticals(yb); - if Assigned(ACheckShouldStop) and ACheckShouldStop(yb) then exit; - pdest := ADestination.GetPixelAddress(left,yb); - sumRed := 0; - sumGreen := 0; - sumBlue := 0; - sumAlpha := 0; - sumCount := 0; - pvert := verticals; - for xb := 0 to iRadiusX-1 do - begin - if xb = width then break; - IncAcc(sumRed, pvert^.red); - IncAcc(sumGreen, pvert^.green); - IncAcc(sumBlue, pvert^.blue); - IncAcc(sumAlpha, pvert^.alpha); - IncAcc(sumCount, pvert^.count); - inc(pvert); - end; - if factExtraX <> 0 then - begin - for xdest := 0 to width-1 do - begin - sumRed2 := 0; - sumGreen2 := 0; - sumBlue2 := 0; - sumAlpha2 := 0; - sumCount2 := 0; - if xdest-iRadiusX-1 >= 0 then - begin - pvert := verticals+(xdest-iRadiusX-1); - DecAcc(sumRed, pvert^.red); - DecAcc(sumGreen, pvert^.green); - DecAcc(sumBlue, pvert^.blue); - DecAcc(sumAlpha, pvert^.alpha); - DecAcc(sumCount, pvert^.count); - - IncAcc(sumRed2, pvert^.red); - IncAcc(sumGreen2, pvert^.green); - IncAcc(sumBlue2, pvert^.blue); - IncAcc(sumAlpha2, pvert^.alpha); - IncAcc(sumCount2, pvert^.count); - end; - if xdest+iRadiusX < width then - begin - pvert := verticals+(xdest+iRadiusX); - IncAcc(sumRed, pvert^.red); - IncAcc(sumGreen, pvert^.green); - IncAcc(sumBlue, pvert^.blue); - IncAcc(sumAlpha, pvert^.alpha); - IncAcc(sumCount, pvert^.count); - end; - if xdest+iRadiusX+1 < width then - begin - pvert := verticals+(xdest+iRadiusX+1); - IncAcc(sumRed2, pvert^.red); - IncAcc(sumGreen2, pvert^.green); - IncAcc(sumBlue2, pvert^.blue); - IncAcc(sumAlpha2, pvert^.alpha); - IncAcc(sumCount2, pvert^.count); - end; - sumAlpha3 := sumAlpha*factMainX + sumAlpha2*factExtraX; - {$IFDEF PARAM_BYTEMASK} - if sumAlpha3 > 0 then - begin - sumGreen3 := sumGreen*factMainX + sumGreen2*factExtraX; - pdest^ := (sumGreen3+(sumAlpha3 shr 1)) div sumAlpha3; - end else pdest^ := 0; - {$ELSE} - begin - sumCount3 := sumCount*factMainX + sumCount2*factExtraX; - if (sumAlpha3 >= (sumCount3+1) shr 1) and (sumCount3 > 0) then - with PBGRAPixel(pdest)^ do - begin - sumRed3 := sumRed*factMainX + sumRed2*factExtraX; - sumGreen3 := sumGreen*factMainX + sumGreen2*factExtraX; - sumBlue3 := sumBlue*factMainX + sumBlue2*factExtraX; - red := (sumRed3+(sumAlpha3 shr 1)) div sumAlpha3; - green := (sumGreen3+(sumAlpha3 shr 1)) div sumAlpha3; - blue := (sumBlue3+(sumAlpha3 shr 1)) div sumAlpha3; - alpha := (sumAlpha3+(sumCount3 shr 1)) div sumCount3; - end else - PBGRAPixel(pdest)^ := BGRAPixelTransparent; - end; - {$ENDIF} - inc(pdest, destPixSize); - end; - end else - begin - for xdest := 0 to width-1 do - begin - if xdest-iRadiusX-1 >= 0 then - begin - pvert := verticals+(xdest-iRadiusX-1); - DecAcc(sumRed, pvert^.red); - DecAcc(sumGreen, pvert^.green); - DecAcc(sumBlue, pvert^.blue); - DecAcc(sumAlpha, pvert^.alpha); - DecAcc(sumCount, pvert^.count); - end; - if xdest+iRadiusX < width then - begin - pvert := verticals+(xdest+iRadiusX); - IncAcc(sumRed, pvert^.red); - IncAcc(sumGreen, pvert^.green); - IncAcc(sumBlue, pvert^.blue); - IncAcc(sumAlpha, pvert^.alpha); - IncAcc(sumCount, pvert^.count); - end; - {$IFDEF PARAM_BYTEMASK} - if sumAlpha > 0 then - pdest^ := (sumGreen+(sumAlpha shr 1)) div sumAlpha - else pdest^ := 0; - {$ELSE} - if (sumAlpha >= (sumCount+1) shr 1) then - with PBGRAPixel(pdest)^ do - begin - red := (sumRed+(sumAlpha shr 1)) div sumAlpha; - green := (sumGreen+(sumAlpha shr 1)) div sumAlpha; - blue := (sumBlue+(sumAlpha shr 1)) div sumAlpha; - alpha := (sumAlpha+(sumCount shr 1)) div sumCount; - end else - PBGRAPixel(pdest)^ := BGRAPixelTransparent; - {$ENDIF} - inc(pdest, destPixSize); - end; - end; - end; - end; - -begin - if (ABounds.Right <= ABounds.Left) or (ABounds.Bottom <= ABounds.Top) then exit; - iRadiusX := floor(ARadiusX+0.5/factMainX); - iRadiusY := floor(ARadiusY+0.5/factMainY); - factExtraX := trunc(frac(ARadiusX+0.5/factMainX)*factMainX); - factExtraY := trunc(frac(ARadiusY+0.5/factMainY)*factMainY); - - if (iRadiusX <= 0) and (iRadiusY <= 0) and (factExtraX <= 0) and (factExtraY <= 0) then - begin - oldClip := ADestination.IntersectClip(ABounds); - ADestination.PutImage(0,0,ASource,dmSet); - ADestination.ClipRect := oldClip; - exit; - end; - left := ABounds.left; - right := ABounds.right; - width := right-left; - height := ABounds.bottom-ABounds.top; - ASource.LoadFromBitmapIfNeeded; - - getmem(verticals, width*sizeof(TVertical)); - try - PrepareVerticals; - MainLoop; - finally - freemem(verticals); - end; -end; -{$UNDEF PARAM_BYTEMASK} -{$UNDEF PARAM_USE_INC64} diff --git a/components/bgrabitmap/blurfast.inc b/components/bgrabitmap/blurfast.inc deleted file mode 100644 index f703fac..0000000 --- a/components/bgrabitmap/blurfast.inc +++ /dev/null @@ -1,233 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception - -var - blurRowY,blurRowX: packed array of UInt32or64; - iRadiusX,iRadiusY: Int32or64; - weightFactor: UInt32or64; - - { Compute weights of pixels in a row } - procedure ComputeBlurRow; - var - i: Int32or64; - ofs: single; - begin - SetLength(blurRowX, 2*iRadiusX+1); - if frac(radiusX)=0 then ofs := 1 else ofs := frac(radiusX); - for i := 0 to iRadiusX do - begin - blurRowX[i] := round((i+ofs)*weightFactor); - blurRowX[high(blurRowX)-i] := blurRowX[i]; - end; - SetLength(blurRowY, 2*iRadiusY+1); - if frac(radiusY)=0 then ofs := 1 else ofs := frac(radiusY); - for i := 0 to iRadiusY do - begin - blurRowY[i] := round((i+ofs)*weightFactor); - blurRowY[high(blurRowY)-i] := blurRowY[i]; - end; - end; - - -var - srcDelta,srcPixSize, - verticalWeightShift, horizontalWeightShift: Int32or64; - ys1,ys2: Int32or64; - - { Compute blur result in a vertical direction } - procedure ComputeVerticalRow(psrc: PByte; var sums: TRowSum; pw: PNativeUInt; count: Int32or64); - begin - while count > 0 do - with sums do - begin - dec(count); - AccumulatePixel(psrc, pw^, sums, verticalWeightShift); - inc(pw); - inc(psrc,srcDelta); - end; - end; - -var - psum, psumEnd: PRowSum; - sums: packed array of TRowSum; - sumStartIndex: Int32or64; - total: TRowSum; - extendedTotal: TExtendedRowSum; - yb,xb,xs,x,xEnd: Int32or64; - pw: PNativeUInt; - psrc, pdest: PByte; - bmpWidth,bmpHeight : Int32or64; - accumulationFactor: double; - bounds: TRect; - highSum: Int32or64; - tempDest: TCustomUniversalBitmap; - destPixSize: Integer; - -begin - radiusX := round(radiusX*10)*0.1; - radiusY := round(radiusY*10)*0.1; - if (radiusX <= 0) and (radiusY <= 0) then - begin - ADestination.PutImage(0,0,bmp,dmSet); - exit; - end; - iRadiusX := ceil(radiusX); - iRadiusY := ceil(radiusY); - if (frac(radiusX)=0) and (frac(radiusY)=0) then - weightFactor:= 1 - else - weightFactor:= 10; - bmpWidth := bmp.Width; - bmpHeight := bmp.Height; - //create output - if (ADestination.Width <> bmp.Width) or (ADestination.Height <> bmp.Height) then - raise exception.Create('Dimension mismatch'); - bounds := bmp.GetImageBounds; - if bounds.IsEmpty then exit; - bounds.Left := max(0, bounds.Left - iRadiusX); - bounds.Top := max(0, bounds.Top - iRadiusY); - bounds.Right := min(bmp.Width, bounds.Right + iRadiusX); - bounds.Bottom := min(bmp.Height, bounds.Bottom + iRadiusY); - bounds.Intersect(ABounds); - if bounds.IsEmpty then exit; - - if radiusX*radiusY >= 100 then - begin - tempDest := ADestination.NewBitmap; - tempDest.SetSize(ADestination.Width,ADestination.Height); - FilterBlurBox(bmp,bounds,radiusX/3.2,radiusY/3.2,tempDest); - FilterBlurBox(tempDest,bounds,radiusX/2.9,radiusY/2.9,ADestination); - FilterBlurBox(ADestination,bounds,radiusX/3.2,radiusY/3.2,tempDest); - FilterBlurBox(tempDest,bounds,radiusX/2.3,radiusY/2.3,ADestination, ACheckShouldStop); - tempDest.Free; - exit; - end; - - accumulationFactor := (iRadiusY+2)*(iRadiusY+1) div 2 + (iRadiusY+1)*iRadiusY div 2; - accumulationFactor := accumulationFactor * sqr(weightFactor); - verticalWeightShift := 0; - while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do - begin - inc(verticalWeightShift); - accumulationFactor := accumulationFactor * 0.5; - end; - horizontalWeightShift:= 0; - accumulationFactor := accumulationFactor * - ((iRadiusX+2)*(iRadiusX+1) div 2 + (iRadiusX+1)*iRadiusX div 2) * - sqr(weightFactor); - while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do - begin - inc(horizontalWeightShift); - accumulationFactor := accumulationFactor * 0.5; - end; - ComputeBlurRow; - //current vertical sums - setlength(sums, 2*iRadiusX+1); - highSum := high(Sums); - psumEnd := @sums[highSum]; - inc(psumEnd); - if bmp.LineOrder = riloTopToBottom then - srcDelta := bmp.RowSize else srcDelta := -bmp.RowSize; - srcPixSize := bmp.Colorspace.GetSize; - destPixSize := ADestination.Colorspace.GetSize; - bmp.LoadFromBitmapIfNeeded; - - xEnd := bounds.left-iRadiusX+highSum; - if xEnd >= bmpWidth then xEnd := bmpWidth-1; - //loop through destination bitmap - for yb := bounds.top to bounds.bottom-1 do - begin - if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break; - //evalute available vertical range - if yb - iRadiusY < 0 then - ys1 := iRadiusY - yb - else - ys1 := 0; - if yb + iRadiusY >= bmpHeight then - ys2 := bmpHeight-1 - yb + iRadiusY - else - ys2 := 2*iRadiusY; - - { initial vertical rows are computed here. Later, - for each pixel, vertical sums are shifted, so there - is only one vertical sum to calculate } - fillchar(sums[0],sizeof(TRowSum)*length(sums),0); - x := bounds.left-iRadiusX; - if x < 0 then - begin - xs := -x; - x := 0; - end else - xs := 0; - psrc := bmp.GetPixelAddress(x, yb-iRadiusY+ys1); - psum := @sums[xs]; - pw := @blurRowY[ys1]; - while true do - begin - ComputeVerticalRow(psrc,psum^,pw,ys2-ys1+1); - inc(x); - inc(psrc, srcPixSize); - if x > xEnd then break; - inc(psum); - end; - sumStartIndex := 0; - - pdest := ADestination.GetPixelAddress(bounds.Left, yb); - for xb := bounds.left to bounds.right-1 do - begin - //add vertical rows - pw := @blurRowX[0]; - psum := @sums[sumStartIndex]; - if horizontalWeightShift > 4 then - begin //we don't want to loose too much precision - fillchar({%H-}extendedTotal,sizeof(extendedTotal),0); - for xs := highSum downto 0 do - begin - AccumulateExtended(extendedTotal, psum, pw^); - inc(pw); - inc(psum); - if psum >= psumEnd then pSum := @sums[0]; - end; - ComputeExtendedAverage(extendedTotal, pdest); - end else - if horizontalWeightShift > 0 then - begin //lossy but efficient way - fillchar({%H-}total,sizeof(total),0); - for xs := highSum downto 0 do - begin - AccumulateShr(total, psum, pw^, horizontalWeightShift); - inc(pw); - inc(psum); - if psum >= psumEnd then pSum := @sums[0]; - end; - ComputeClampedAverage(total, pdest); - end else - begin //normal way - {$hints off} - fillchar(total,sizeof(total),0); - {$hints on} - for xs := highSum downto 0 do - begin - AccumulateNormal(total, psum, pw^); - inc(pw); - inc(psum); - if psum >= psumEnd then pSum := @sums[0]; - end; - ComputeAverage(total, pdest) - end; - inc(pdest, destPixSize); - //shift vertical rows - psum := @sums[sumStartIndex]; - fillchar(psum^,sizeof(TRowSum),0); - if x < bmpWidth then - begin - ComputeVerticalRow(psrc,psum^,@blurRowY[ys1],ys2-ys1+1); - inc(x); - inc(psrc, srcPixSize); - end; - inc(sumStartIndex); - if sumStartIndex > highSum then sumStartIndex := 0; - end; - end; - ADestination.InvalidateBitmap; -end; - diff --git a/components/bgrabitmap/blurnormal.inc b/components/bgrabitmap/blurnormal.inc deleted file mode 100644 index 0d7cc76..0000000 --- a/components/bgrabitmap/blurnormal.inc +++ /dev/null @@ -1,253 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -type - PWeightedPixel = ^TWeightedPixel; - TWeightedPixel = packed record - Coord: TPoint; - Weight: Int32or64; - PtrOfs: Int32or64; - end; - -var - maskWidth,maskHeight: integer; - blurOfs: TPoint; - ppixel: PWeightedPixel; - Pixel: array of TWeightedPixel; - PixelArrayLineStart: array of integer; - DiffPixel: array of TWeightedPixel; - DiffPixelArrayLineStart: array of integer; - - bmpWidth,bmpHeight: Int32or64; - - procedure LoadMask(out ABlurOfs: TPoint); - var x,y,n: Int32or64; - tempWeight: Int32or64; - diffMask: array of packed array of Int32or64; - p: PByteMask; - qty,pStride: integer; - srcLineDelta, srcPixSize, srcLineOfs: PtrInt; - begin - ABlurOfs := point(blurMask.Width shr 1, blurMask.Height shr 1); - - //count number of non empty pixels - maskWidth := blurMask.Width; - maskHeight := blurMask.Height; - n := 0; - for y:= 0 to maskHeight-1 do - begin - blurMask.ScanMoveTo(0,Y); - x := maskWidth; - while x > 0 do - begin - qty := x; - blurMask.ScanNextMaskChunk(qty, p, pStride); - dec(x, qty); - while qty > 0 do - begin - if p^.gray <> 0 then inc(n); - inc(p, pStride); - dec(qty); - end; - end; - end; - - //initialize arrays - setlength(diffMask, maskHeight, maskWidth+1); - for y := 0 to maskHeight - 1 do - fillchar(diffMask[y,0], (maskWidth+1)*sizeof(Int32or64), 0); - - if bmp.LineOrder = riloTopToBottom then - srcLineDelta := bmp.RowSize else - srcLineDelta := -bmp.RowSize; - srcPixSize := bmp.Colorspace.GetSize; - - setlength(Pixel, n); - setlength(PixelArrayLineStart, maskHeight+1); //stores the first pixel of each line - n := 0; - //compute mask variations and initial mask pixel list - srcLineOfs := (0-ABlurOfs.Y)*srcLineDelta; - for y := 0 to maskHeight - 1 do - begin - PixelArrayLineStart[y] := n; - blurMask.ScanMoveTo(0,Y); - x := 0; - while x < maskWidth do - begin - qty := maskWidth - x; - blurMask.ScanNextMaskChunk(qty, p, pStride); - while qty > 0 do - begin - tempWeight := p^.gray; - dec(diffMask[y,x], tempWeight); - inc(diffMask[y,x+1], tempWeight); - - if tempWeight <> 0 then - begin - Pixel[n].Weight := tempWeight; - Pixel[n].Coord := Point(x,y); - Pixel[n].PtrOfs := srcLineOfs + (x-ABlurOfs.X)*srcPixSize; - Inc(n); - end; - inc(x); - inc(p, pStride); - dec(qty); - end; - end; - inc(srcLineOfs, srcLineDelta); - end; - PixelArrayLineStart[maskHeight] := n; - - //count number of diff pixels - n := 0; - for y := 0 to maskHeight - 1 do - for x := 0 to maskWidth do - if diffMask[y,x] <> 0 then Inc(n); - - //initialize arrays - setlength(DiffPixel, n); - setlength(DiffPixelArrayLineStart, maskHeight+1); //stores the first pixel of each diff line - n := 0; - //compute diff pixel list - srcLineOfs := (0-ABlurOfs.Y)*srcLineDelta; - for y := 0 to maskHeight - 1 do - begin - DiffPixelArrayLineStart[y] := n; - for x := 0 to maskWidth do - begin - tempWeight := diffMask[y,x]; - if tempWeight <> 0 then - begin - DiffPixel[n].Weight := tempWeight; - DiffPixel[n].Coord := Point(x-1,y); - DiffPixel[n].PtrOfs := srcLineOfs + (x-ABlurOfs.X-1)*srcPixSize; - Inc(n); - end; - end; - inc(srcLineOfs, srcLineDelta); - end; - DiffPixelArrayLineStart[maskHeight] := n; - end; - - function PrepareScan(AWantedBounds: TRect; out AClippedBounds: TRect): boolean; - begin - //evaluate required bounds taking blur radius into acount - AClippedBounds := bmp.GetImageBounds; - if AClippedBounds.IsEmpty then - begin - result := false; - exit; - end; - AClippedBounds.Left := max(0, AClippedBounds.Left - blurOfs.X); - AClippedBounds.Top := max(0, AClippedBounds.Top - blurOfs.Y); - AClippedBounds.Right := min(bmpWidth, AClippedBounds.Right + maskWidth - 1 - blurOfs.X); - AClippedBounds.Bottom := min(bmpHeight, AClippedBounds.Bottom + maskHeight - 1 - blurOfs.Y); - AClippedBounds.Intersect(AWantedBounds); - - if AClippedBounds.IsEmpty then - begin - result := false; - exit; - end; - - result := true; - end; - -var - bounds: TRect; - yb, xb: Int32or64; - mindy, maxdy, n, nStart, nCount, nDiffStart, nDiffCount: Int32or64; - bmpX,bmpXBase,bmpYBase: Int32or64; - pdest : PByte; - psrc : PByte; - srcPixSize,destPixSize: integer; - -begin - bmpWidth := bmp.Width; - bmpHeight:= bmp.Height; - bmp.LoadFromBitmapIfNeeded; - - if (ADestination.Width <> bmpWidth) or (ADestination.Height <> bmpHeight) then - raise exception.Create('Dimension mismatch'); - - LoadMask(blurOfs); - if not PrepareScan(ABounds, bounds) then exit; //nothing to do - - bmpYBase := bounds.Top - blurOfs.Y; - srcPixSize := bmp.Colorspace.GetSize; - destPixSize := ADestination.Colorspace.GetSize; - - //loop through destination - for yb := bounds.Top to bounds.Bottom - 1 do - begin - if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break; - psrc := bmp.GetPixelAddress(bounds.Left, yb); - pdest := ADestination.GetPixelAddress(bounds.Left, yb); - //compute vertical range - mindy := max(-blurOfs.Y, -yb); - maxdy := min(blurMask.Height - 1 - blurOfs.Y, bmpHeight - 1 - yb); - - AClearSum(AData); - - bmpXBase := bounds.Left-blurOfs.X; - nStart := PixelArrayLineStart[mindy+blurOfs.Y]; - nCount := PixelArrayLineStart[maxdy+blurOfs.Y+1]-nStart; - ppixel:= @Pixel[nStart]; - //go through pixel list of the current vertical range - for n := nCount-1 downto 0 do - begin - bmpX := bmpXBase+ppixel^.Coord.x; - //check horizontal range - if (bmpX >= 0) and (bmpX < bmpWidth) then - AAccumulate(AData, psrc + ppixel^.PtrOfs, ppixel^.Weight); - inc(ppixel); - end; - AComputeAverage(AData, pdest); - - nDiffStart := DiffPixelArrayLineStart[mindy+blurOfs.Y]; - nDiffCount := DiffPixelArrayLineStart[maxdy+blurOfs.Y+1]-nDiffStart; - - if nDiffCount < nCount then - begin - for xb := bounds.Left+1 to Bounds.Right - 1 do - begin - Inc(pdest, destPixSize); - inc(bmpXBase); - inc(psrc, srcPixSize); - - ppixel:= @DiffPixel[nDiffStart]; - for n := nDiffCount-1 downto 0 do - begin - bmpX := bmpXBase+ppixel^.Coord.x; - if (bmpX >= 0) and (bmpX < bmpWidth) then - AAccumulate(AData, psrc + ppixel^.PtrOfs, ppixel^.Weight); - inc(ppixel); - end; - AComputeAverage(AData, pDest); - end; - end else - begin - for xb := bounds.Left+1 to Bounds.Right - 1 do - begin - Inc(pdest, destPixSize); - inc(bmpXBase); - inc(psrc, srcPixSize); - - AClearSum(AData); - - ppixel:= @Pixel[nStart]; - for n := nCount-1 downto 0 do - begin - bmpX := bmpXBase+ppixel^.Coord.x; - //check horizontal range - if (bmpX >= 0) and (bmpX < bmpWidth) then - AAccumulate(AData, psrc + ppixel^.PtrOfs, ppixel^.Weight); - inc(ppixel); - end; - AComputeAverage(AData, pdest); - end; - end; - - inc(bmpYBase); - end; - ADestination.InvalidateBitmap; -end; - diff --git a/components/bgrabitmap/csscolorconst.inc b/components/bgrabitmap/csscolorconst.inc deleted file mode 100644 index d5a6c39..0000000 --- a/components/bgrabitmap/csscolorconst.inc +++ /dev/null @@ -1,888 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{=== Color definitions ===} - -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -var - {* This is the value used for transparent pixels. In theory, any - color with alpha = 0 is transparent, however it is recommended to - use all other channels to zero as well. } - BGRAPixelTransparent: TBGRAPixel; - ExpandedPixelTransparent: TExpandedPixel; - - {* [#FFFFFF] White opaque } - BGRAWhite: TBGRAPixel; - {* [#000000] Black opaque } - BGRABlack: TBGRAPixel; - -const - {* This color [#000001] looks just like black. It is needed for drawing black - shapes using the ''Canvas'' property of ''TBGRABitmap''. This is a standard - ''TCanvas'' and when drawing with pure black (''clBlack''), there is no way to know if - something has been drawn or if it is transparent } - clBlackOpaque = TColor($010000); - -var - //VGA colors - VGABlack,VGAGray,VGASilver,VGAWhite, - VGAMaroon,VGARed,VGAPurple,VGAFuchsia, - VGAGreen,VGALime,VGAOlive,VGAYellow, - VGANavy,VGABlue,VGATeal,VGAAqua: TBGRAPixel; - - //Red colors - CSSIndianRed,CSSLightCoral,CSSSalmon,CSSDarkSalmon, - CSSRed,CSSCrimson,CSSFireBrick,CSSDarkRed: TBGRAPixel; - //Pink colors - CSSPink,CSSLightPink,CSSHotPink,CSSDeepPink, - CSSMediumVioletRed,CSSPaleVioletRed: TBGRAPixel; - //Orange colors - CSSLightSalmon,CSSCoral,CSSTomato,CSSOrangeRed, - CSSDarkOrange,CSSOrange: TBGRAPixel; - //Yellow colors - CSSGold,CSSYellow,CSSLightYellow,CSSLemonChiffon, - CSSLightGoldenrodYellow,CSSPapayaWhip,CSSMoccasin,CSSPeachPuff, - CSSPaleGoldenrod,CSSKhaki,CSSDarkKhaki: TBGRAPixel; - //Purple colors - CSSLavender,CSSThistle,CSSPlum,CSSViolet, - CSSOrchid,CSSFuchsia,CSSMagenta,CSSMediumOrchid, - CSSMediumPurple,CSSBlueViolet,CSSDarkViolet,CSSDarkOrchid, - CSSDarkMagenta,CSSPurple,CSSIndigo,CSSDarkSlateBlue, - CSSSlateBlue,CSSMediumSlateBlue: TBGRAPixel; - //Green colors - CSSGreenYellow,CSSChartreuse,CSSLawnGreen,CSSLime, - CSSLimeGreen,CSSPaleGreen,CSSLightGreen,CSSMediumSpringGreen, - CSSSpringGreen,CSSMediumSeaGreen,CSSSeaGreen,CSSForestGreen, - CSSGreen,CSSDarkGreen,CSSYellowGreen,CSSOliveDrab, - CSSOlive,CSSDarkOliveGreen,CSSMediumAquamarine,CSSDarkSeaGreen, - CSSLightSeaGreen,CSSDarkCyan,CSSTeal: TBGRAPixel; - //Blue/Cyan colors - CSSAqua,CSSCyan,CSSLightCyan,CSSPaleTurquoise, - CSSAquamarine,CSSTurquoise,CSSMediumTurquoise,CSSDarkTurquoise, - CSSCadetBlue,CSSSteelBlue,CSSLightSteelBlue,CSSPowderBlue, - CSSLightBlue,CSSSkyBlue,CSSLightSkyBlue,CSSDeepSkyBlue, - CSSDodgerBlue,CSSCornflowerBlue,CSSRoyalBlue,CSSBlue, - CSSMediumBlue,CSSDarkBlue,CSSNavy,CSSMidnightBlue: TBGRAPixel; - //Brown colors - CSSCornsilk, CSSBlanchedAlmond, CSSBisque, CSSNavajoWhite, - CSSWheat, CSSBurlyWood, CSSTan, CSSRosyBrown, - CSSSandyBrown, CSSGoldenrod, CSSDarkGoldenrod, CSSPeru, - CSSChocolate, CSSSaddleBrown, CSSSienna, CSSBrown, - CSSMaroon: TBGRAPixel; - //White colors - CSSWhite, CSSSnow, CSSHoneydew, CSSMintCream, - CSSAzure, CSSAliceBlue, CSSGhostWhite, CSSWhiteSmoke, - CSSSeashell, CSSBeige, CSSOldLace, CSSFloralWhite, - CSSIvory, CSSAntiqueWhite, CSSLinen, CSSLavenderBlush, - CSSMistyRose: TBGRAPixel; - //Gray colors - CSSGainsboro, CSSLightGray, CSSSilver, CSSDarkGray, - CSSGray, CSSDimGray, CSSLightSlateGray, CSSSlateGray, - CSSDarkSlateGray, CSSBlack: TBGRAPixel; - -type - TBGRAColorDefinition = record - Name: string; - Color: TBGRAPixel; - end; - - { TBGRAColorList } - {* Contains a fixed list of colors } - TBGRAColorList = class - protected - FFinished: boolean; - FNbColors: integer; - FColors: array of TBGRAColorDefinition; - function GetByIndex(Index: integer): TBGRAPixel; - function GetByName(Name: string): TBGRAPixel; - function GetName(Index: integer): string; - procedure Add(Name: string; out Color: TBGRAPixel; red,green,blue: byte); overload; - public - {** Creates an empty color list } - constructor Create; - {** Add a color to the list } - procedure Add(Name: string; const Color: TBGRAPixel); overload; - {** Ends the color list and prevents further modifications } - procedure Finished; - {** Returns the index of a color with a given name } - function IndexOf(Name: string): integer; - {** Returns the index of a color. Colors are considered to match if - the difference is less than or equal to ''AMaxDiff'' } - function IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer; - - {** Gets the color associated with a color name } - property ByName[Name: string]: TBGRAPixel read GetByName; - {** Gets the color at the specified index } - property ByIndex[Index: integer]: TBGRAPixel read GetByIndex; default; - {** Gets the name of the color at the specified index } - property Name[Index: integer]: string read GetName; - {** Gets the number of colors } - property Count: integer read FNbColors; - end; - -var - {* List of VGA colors: - * [#000000] Black, [#808080] Gray, [#C0C0C0] Silver, [#FFFFFF] White, - * [#800000] Maroon, [#FF0000] Red, [#800080] Purple, [#FF00FF] Fuchsia, - * [#008000] Green, [#00FF00] Lime, [#808000] Olive, [#FFFF00] Yellow, - * [#000080] Navy, [#0000FF] Blue, [#008080] Teal, [#00FFFF] Aqua. - * Shortcut constants are provided: [#000000] ''VGABlack'', [#808080] ''VGAGray''... } - VGAColors: TBGRAColorList; - {* List of [https://www.w3schools.com/cssref/css_colors.asp web colors]. - Shortcut constants are provided: [#000000] ''CSSBlack'', [#FF0000] ''CSSRed''... } - CSSColors: TBGRAColorList; - -{------------------- string conversion ------------------------} - -{* Converts a ''TBGRAPixel'' value into a string, using color names provided in ''AColorList'', and - considering that a color matches in the color list if its difference is within ''AMaxDiff'' } -function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList = nil; - AMaxDiff: Word= 0; AOptionalAlpha: boolean = false; AHashTagPrefix: boolean = false): string; -{* Converts a fully defined string into a ''TBGRAPixel'' value. Color names from ''VGAColors'' and ''CSSColors'' - are used if there is an exact match } -function StrToBGRA(str: string): TBGRAPixel; overload; -{* Converts a string into a ''TBGRAPixel'' value. If the value is not fully defined or that - there is an error, ''DefaultColor'' is returned. - Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. } -function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel; overload; -{* Converts a string into a ''TBGRAPixel'' value. If the value is not fully defined, missing channels (expressed with '?') - are filled with fallbackValues. You can check if there was an error with the provided boolean. - Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. } -function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out error: boolean): TBGRAPixel; -{* Converts a string into a ''TBGRAPixel'' value into ''parsedValue''. ''parsedValue'' is not changed if - some channels are missing (expressed with '?'). You can check if there was an error with the provided boolean. - Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. } -procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean); -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} -{ TBGRAColorList } - -function TBGRAColorList.GetByIndex(Index: integer): TBGRAPixel; -begin - if (Index < 0) or (Index >= FNbColors) then - result := BGRAPixelTransparent - else - result := FColors[Index].Color; -end; - -function TBGRAColorList.GetByName(Name: string): TBGRAPixel; -var i: integer; -begin - i := IndexOf(Name); - if i = -1 then - result := BGRAPixelTransparent - else - result := FColors[i].Color; -end; - -function TBGRAColorList.GetName(Index: integer): string; -begin - if (Index < 0) or (Index >= FNbColors) then - result := '' - else - result := FColors[Index].Name; -end; - -procedure TBGRAColorList.Add(Name: string; out Color: TBGRAPixel; red, green, - blue: byte); -begin - Color := BGRA(red,green,blue); - Add(Name,Color); -end; - -constructor TBGRAColorList.Create; -begin - FNbColors:= 0; - FColors := nil; - FFinished:= false; -end; - -procedure TBGRAColorList.Add(Name: string; const Color: TBGRAPixel); -begin - if FFinished then - raise Exception.Create('This list is already finished'); - if length(FColors) = FNbColors then - SetLength(FColors, FNbColors*2+1); - FColors[FNbColors].Name := Name; - FColors[FNbColors].Color := Color; - inc(FNbColors); -end; - -procedure TBGRAColorList.Finished; -begin - if FFinished then exit; - FFinished := true; - SetLength(FColors, FNbColors); -end; - -function TBGRAColorList.IndexOf(Name: string): integer; -var i: integer; -begin - for i := 0 to FNbColors-1 do - if CompareText(Name, FColors[i].Name) = 0 then - begin - result := i; - exit; - end; - result := -1; -end; - -function TBGRAColorList.IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer; -var i: integer; - MinDiff,CurDiff: Word; -begin - if AMaxDiff = 0 then - begin - for i := 0 to FNbColors-1 do - if AColor = FColors[i].Color then - begin - result := i; - exit; - end; - result := -1; - end else - begin - MinDiff := AMaxDiff; - result := -1; - for i := 0 to FNbColors-1 do - begin - CurDiff := BGRAWordDiff(AColor,FColors[i].Color); - if CurDiff <= MinDiff then - begin - result := i; - MinDiff := CurDiff; - if MinDiff = 0 then exit; - end; - end; - end; -end; - -{------------------- string conversion ---------------------------------} - -{ Write a color in hexadecimal format RRGGBBAA or using the name in a color list } -function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList; - AMaxDiff: Word; AOptionalAlpha: boolean; AHashTagPrefix: boolean): string; -var idx: integer; -begin - if Assigned(AColorList) then - begin - idx := AColorList.IndexOfColor(c, AMaxDiff); - if idx<> -1 then - begin - result := AColorList.Name[idx]; - exit; - end; - end; - if AOptionalAlpha and (c.alpha = 255) then - result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2) - else - result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2); - if AHashTagPrefix then result := '#' + result; -end; - -type - arrayOfString = array of string; - -function SimpleParseFuncParam(str: string; var flagError: boolean): arrayOfString; -var idxOpen,start,cur: integer; -begin - result := nil; - idxOpen := pos('(',str); - if idxOpen = 0 then - begin - start := 1; - //find first space - while (start <= length(str)) and (str[start]<>' ') do inc(start); - end else - start := idxOpen+1; - cur := start; - while cur <= length(str) do - begin - if str[cur] in[',',')'] then - begin - setlength(result,length(result)+1); - result[high(result)] := trim(copy(str,start,cur-start)); - start := cur+1; - if str[cur] = ')' then exit; - end; - inc(cur); - end; - if idxOpen <> 0 then flagError := true; //should exit on ')' - if start <= length(str) then - begin - setlength(result,length(result)+1); - result[high(result)] := copy(str,start,length(str)-start+1); - end; -end; - -function ParseColorValue(str: string; var flagError: boolean): byte; -var pourcent,unclipped,{%H-}errPos: integer; - pourcentF: single; - pourcentStr: string; -begin - if str = '' then result := 0 else - begin - if str[length(str)]='%' then - begin - pourcentStr := copy(str,1,length(str)-1); - val(pourcentStr,pourcent,errPos); - if errPos <> 0 then - begin - val(pourcentStr,pourcentF,errPos); - if errPos <> 0 then - begin - flagError := true; - result := 0; - end - else - begin - if pourcentF < 0 then result := 0 else - if pourcentF > 100 then result := 255 else - result := round(pourcentF*255 / 100); - end; - end else - begin - if pourcent < 0 then result := 0 else - if pourcent > 100 then result := 255 else - result := pourcent*255 div 100; - end; - end else - begin - val(str,unclipped,errPos); - if errPos <> 0 then flagError := true; - if unclipped < 0 then result := 0 else - if unclipped > 255 then result := 255 else - result := unclipped; - end; - end; -end; - -//this function returns the parsed value only if it contains no error nor missing values, otherwise -//it returns BGRAPixelTransparent -function StrToBGRA(str: string): TBGRAPixel; -var missingValues, error: boolean; -begin - result := BGRABlack; - TryStrToBGRA(str, result, missingValues, error); - if missingValues or error then result := BGRAPixelTransparent; -end; - -//this function changes the content of parsedValue depending on available and parsable information. -//set parsedValue to the fallback values before calling this function. -//missing values are expressed by empty string or by '?', for example 'rgb(255,?,?,?)' will change only the red value. -//note that if alpha is not expressed by the string format, it will be opaque. So 'rgb(255,?,?)' will change the red value and the alpha value. -//the last parameter of rgba() is a floating point number where 1 is opaque and 0 is transparent. -procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean); -var errPos: integer; - values: array of string; - alphaF: single; - idx: integer; -begin - str := Trim(str); - error := false; - if (str = '') or (str = '?') then - begin - missingValues := true; - exit; - end else - missingValues := false; - str := StringReplace(lowerCase(str),'grey','gray',[]); - - //VGA color names - idx := VGAColors.IndexOf(str); - if idx <> -1 then - begin - parsedValue := VGAColors[idx]; - exit; - end; - if str='transparent' then parsedValue := BGRAPixelTransparent else - begin - //check CSS color - idx := CSSColors.IndexOf(str); - if idx <> -1 then - begin - parsedValue := CSSColors[idx]; - exit; - end; - - //CSS RGB notation - if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') or - (copy(str,1,4)='rgb ') or (copy(str,1,5)='rgba ') then - begin - values := SimpleParseFuncParam(str,error); - if (length(values)=3) or (length(values)=4) then - begin - if (values[0] <> '') and (values[0] <> '?') then - parsedValue.red := ParseColorValue(values[0], error) - else - missingValues := true; - if (values[1] <> '') and (values[1] <> '?') then - parsedValue.green := ParseColorValue(values[1], error) - else - missingValues := true; - if (values[2] <> '') and (values[2] <> '?') then - parsedValue.blue := ParseColorValue(values[2], error) - else - missingValues := true; - if length(values)=4 then - begin - if (values[3] <> '') and (values[3] <> '?') then - begin - val(values[3],alphaF,errPos); - if errPos <> 0 then - begin - parsedValue.alpha := 255; - error := true; - end - else - begin - if alphaF < 0 then - parsedValue.alpha := 0 else - if alphaF > 1 then - parsedValue.alpha := 255 - else - parsedValue.alpha := round(alphaF*255); - end; - end else - missingValues := true; - end else - parsedValue.alpha := 255; - end else - error := true; - exit; - end; - - //remove HTML notation header - if str[1]='#' then delete(str,1,1); - - //add alpha if missing (if you want an undefined alpha use '??' or '?') - if length(str)=6 then AppendStr(str, 'FF') - else if length(str)=3 then AppendStr(str, 'F'); - - //hex notation - if length(str)=8 then - begin - if copy(str,1,2) <> '??' then - begin - val('$'+copy(str,1,2),parsedValue.red,errPos); - if errPos <> 0 then error := true; - end else missingValues := true; - if copy(str,3,2) <> '??' then - begin - val('$'+copy(str,3,2),parsedValue.green,errPos); - if errPos <> 0 then error := true; - end else missingValues := true; - if copy(str,5,2) <> '??' then - begin - val('$'+copy(str,5,2),parsedValue.blue,errPos); - if errPos <> 0 then error := true; - end else missingValues := true; - if copy(str,7,2) <> '??' then - begin - val('$'+copy(str,7,2),parsedValue.alpha,errPos); - if errPos <> 0 then - begin - error := true; - parsedValue.alpha := 255; - end; - end else missingValues := true; - end else - if length(str)=4 then - begin - if str[1] <> '?' then - begin - val('$'+str[1],parsedValue.red,errPos); - if errPos <> 0 then error := true; - parsedValue.red := parsedValue.red * $11; - end else missingValues := true; - if str[2] <> '?' then - begin - val('$'+str[2],parsedValue.green,errPos); - if errPos <> 0 then error := true; - parsedValue.green := parsedValue.green * $11; - end else missingValues := true; - if str[3] <> '?' then - begin - val('$'+str[3],parsedValue.blue,errPos); - if errPos <> 0 then error := true; - parsedValue.blue := parsedValue.blue * $11; - end else missingValues := true; - if str[4] <> '?' then - begin - val('$'+str[4],parsedValue.alpha,errPos); - if errPos <> 0 then - begin - error := true; - parsedValue.alpha := 255; - end else - parsedValue.alpha := parsedValue.alpha * $11; - end else missingValues := true; - end else - error := true; //string format not recognised - end; - -end; - -//this function returns the values that can be read from the string, otherwise -//it fills the gaps with the fallback values. The error boolean is True only -//if there was invalid values, it is not set to True if there was missing values. -function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out - error: boolean): TBGRAPixel; -var missingValues: boolean; -begin - result := fallbackValues; - TryStrToBGRA(str, result, missingValues, error); -end; - -{ Read a color, for example in hexadecimal format RRGGBB(AA) or RGB(A). Partial colors are not accepted by this function. } -function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel; -var missingValues, error: boolean; -begin - result := BGRABlack; - TryStrToBGRA(str, result, missingValues, error); - if missingValues or error then result := DefaultColor; -end; - -function BlueGreenRedToBGRA(blue,green,red: byte): TBGRAPixel; -begin - result := BGRA(red,green,blue); -end; - -{$ENDIF} - -{$IFDEF INCLUDE_INIT} -{$UNDEF INCLUDE_INIT} - BGRAPixelTransparent := BGRA(0,0,0,0); - ExpandedPixelTransparent := BGRAPixelTransparent.ToExpanded; - BGRAWhite := BGRA(255,255,255); - BGRABlack := BGRA(0,0,0); - - VGAColors := TBGRAColorList.Create; - VGAColors.Add('Black',VGABlack,0,0,0); - VGAColors.Add('Gray',VGAGray,128,128,128); - VGAColors.Add('Silver',VGASilver,192,192,192); - VGAColors.Add('White',VGAWhite,255,255,255); - VGAColors.Add('Maroon',VGAMaroon,128,0,0); - VGAColors.Add('Red',VGARed,255,0,0); - VGAColors.Add('Purple',VGAPurple,128,0,128); - VGAColors.Add('Fuchsia',VGAFuchsia,255,0,255); - VGAColors.Add('Green',VGAGreen,0,128,0); - VGAColors.Add('Lime',VGALime,0,255,0); - VGAColors.Add('Olive',VGAOlive,128,128,0); - VGAColors.Add('Yellow',VGAYellow,255,255,0); - VGAColors.Add('Navy',VGANavy,0,0,128); - VGAColors.Add('Blue',VGABlue,0,0,255); - VGAColors.Add('Teal',VGATeal,0,128,128); - VGAColors.Add('Aqua',VGAAqua,0,255,255); - VGAColors.Finished; - - //Red colors - CSSIndianRed:= BlueGreenRedToBGRA(92, 92, 205); - CSSLightCoral:= BlueGreenRedToBGRA(128, 128, 240); - CSSSalmon:= BlueGreenRedToBGRA(114, 128, 250); - CSSDarkSalmon:= BlueGreenRedToBGRA(122, 150, 233); - CSSRed:= BlueGreenRedToBGRA(0, 0, 255); - CSSCrimson:= BlueGreenRedToBGRA(60, 20, 220); - CSSFireBrick:= BlueGreenRedToBGRA(34, 34, 178); - CSSDarkRed:= BlueGreenRedToBGRA(0, 0, 139); - - //Pink colors - CSSPink:= BlueGreenRedToBGRA(203, 192, 255); - CSSLightPink:= BlueGreenRedToBGRA(193, 182, 255); - CSSHotPink:= BlueGreenRedToBGRA(180, 105, 255); - CSSDeepPink:= BlueGreenRedToBGRA(147, 20, 255); - CSSMediumVioletRed:= BlueGreenRedToBGRA(133, 21, 199); - CSSPaleVioletRed:= BlueGreenRedToBGRA(147, 112, 219); - - //Orange colors - CSSLightSalmon:= BlueGreenRedToBGRA(122, 160, 255); - CSSCoral:= BlueGreenRedToBGRA(80, 127, 255); - CSSTomato:= BlueGreenRedToBGRA(71, 99, 255); - CSSOrangeRed:= BlueGreenRedToBGRA(0, 69, 255); - CSSDarkOrange:= BlueGreenRedToBGRA(0, 140, 255); - CSSOrange:= BlueGreenRedToBGRA(0, 165, 255); - - //Yellow colors - CSSGold:= BlueGreenRedToBGRA(0, 215, 255); - CSSYellow:= BlueGreenRedToBGRA(0, 255, 255); - CSSLightYellow:= BlueGreenRedToBGRA(224, 255, 255); - CSSLemonChiffon:= BlueGreenRedToBGRA(205, 250, 255); - CSSLightGoldenrodYellow:= BlueGreenRedToBGRA(210, 250, 250); - CSSPapayaWhip:= BlueGreenRedToBGRA(213, 239, 255); - CSSMoccasin:= BlueGreenRedToBGRA(181, 228, 255); - CSSPeachPuff:= BlueGreenRedToBGRA(185, 218, 255); - CSSPaleGoldenrod:= BlueGreenRedToBGRA(170, 232, 238); - CSSKhaki:= BlueGreenRedToBGRA(140, 230, 240); - CSSDarkKhaki:= BlueGreenRedToBGRA(107, 183, 189); - - //Purple colors - CSSLavender:= BlueGreenRedToBGRA(250, 230, 230); - CSSThistle:= BlueGreenRedToBGRA(216, 191, 216); - CSSPlum:= BlueGreenRedToBGRA(221, 160, 221); - CSSViolet:= BlueGreenRedToBGRA(238, 130, 238); - CSSOrchid:= BlueGreenRedToBGRA(214, 112, 218); - CSSFuchsia:= BlueGreenRedToBGRA(255, 0, 255); - CSSMagenta:= BlueGreenRedToBGRA(255, 0, 255); - CSSMediumOrchid:= BlueGreenRedToBGRA(211, 85, 186); - CSSMediumPurple:= BlueGreenRedToBGRA(219, 112, 147); - CSSBlueViolet:= BlueGreenRedToBGRA(226, 43, 138); - CSSDarkViolet:= BlueGreenRedToBGRA(211, 0, 148); - CSSDarkOrchid:= BlueGreenRedToBGRA(204, 50, 153); - CSSDarkMagenta:= BlueGreenRedToBGRA(139, 0, 139); - CSSPurple:= BlueGreenRedToBGRA(128, 0, 128); - CSSIndigo:= BlueGreenRedToBGRA(130, 0, 75); - CSSDarkSlateBlue:= BlueGreenRedToBGRA(139, 61, 72); - CSSSlateBlue:= BlueGreenRedToBGRA(205, 90, 106); - CSSMediumSlateBlue:= BlueGreenRedToBGRA(238, 104, 123); - - //Green colors - CSSGreenYellow:= BlueGreenRedToBGRA(47, 255, 173); - CSSChartreuse:= BlueGreenRedToBGRA(0, 255, 127); - CSSLawnGreen:= BlueGreenRedToBGRA(0, 252, 124); - CSSLime:= BlueGreenRedToBGRA(0, 255, 0); - CSSLimeGreen:= BlueGreenRedToBGRA(50, 205, 50); - CSSPaleGreen:= BlueGreenRedToBGRA(152, 251, 152); - CSSLightGreen:= BlueGreenRedToBGRA(144, 238, 144); - CSSMediumSpringGreen:= BlueGreenRedToBGRA(154, 250, 0); - CSSSpringGreen:= BlueGreenRedToBGRA(127, 255, 0); - CSSMediumSeaGreen:= BlueGreenRedToBGRA(113, 179, 60); - CSSSeaGreen:= BlueGreenRedToBGRA(87, 139, 46); - CSSForestGreen:= BlueGreenRedToBGRA(34, 139, 34); - CSSGreen:= BlueGreenRedToBGRA(0, 128, 0); - CSSDarkGreen:= BlueGreenRedToBGRA(0, 100, 0); - CSSYellowGreen:= BlueGreenRedToBGRA(50, 205, 154); - CSSOliveDrab:= BlueGreenRedToBGRA(35, 142, 107); - CSSOlive:= BlueGreenRedToBGRA(0, 128, 128); - CSSDarkOliveGreen:= BlueGreenRedToBGRA(47, 107, 85); - CSSMediumAquamarine:= BlueGreenRedToBGRA(170, 205, 102); - CSSDarkSeaGreen:= BlueGreenRedToBGRA(143, 188, 143); - CSSLightSeaGreen:= BlueGreenRedToBGRA(170, 178, 32); - CSSDarkCyan:= BlueGreenRedToBGRA(139, 139, 0); - CSSTeal:= BlueGreenRedToBGRA(128, 128, 0); - - //Blue/Cyan colors - CSSAqua:= BlueGreenRedToBGRA(255, 255, 0); - CSSCyan:= BlueGreenRedToBGRA(255, 255, 0); - CSSLightCyan:= BlueGreenRedToBGRA(255, 255, 224); - CSSPaleTurquoise:= BlueGreenRedToBGRA(238, 238, 175); - CSSAquamarine:= BlueGreenRedToBGRA(212, 255, 127); - CSSTurquoise:= BlueGreenRedToBGRA(208, 224, 64); - CSSMediumTurquoise:= BlueGreenRedToBGRA(204, 209, 72); - CSSDarkTurquoise:= BlueGreenRedToBGRA(209, 206, 0); - CSSCadetBlue:= BlueGreenRedToBGRA(160, 158, 95); - CSSSteelBlue:= BlueGreenRedToBGRA(180, 130, 70); - CSSLightSteelBlue:= BlueGreenRedToBGRA(222, 196, 176); - CSSPowderBlue:= BlueGreenRedToBGRA(230, 224, 176); - CSSLightBlue:= BlueGreenRedToBGRA(230, 216, 173); - CSSSkyBlue:= BlueGreenRedToBGRA(235, 206, 135); - CSSLightSkyBlue:= BlueGreenRedToBGRA(250, 206, 135); - CSSDeepSkyBlue:= BlueGreenRedToBGRA(255, 191, 0); - CSSDodgerBlue:= BlueGreenRedToBGRA(255, 144, 30); - CSSCornflowerBlue:= BlueGreenRedToBGRA(237, 149, 100); - CSSRoyalBlue:= BlueGreenRedToBGRA(255, 105, 65); - CSSBlue:= BlueGreenRedToBGRA(255, 0, 0); - CSSMediumBlue:= BlueGreenRedToBGRA(205, 0, 0); - CSSDarkBlue:= BlueGreenRedToBGRA(139, 0, 0); - CSSNavy:= BlueGreenRedToBGRA(128, 0, 0); - CSSMidnightBlue:= BlueGreenRedToBGRA(112, 25, 25); - - //Brown colors - CSSCornsilk:= BlueGreenRedToBGRA(220, 248, 255); - CSSBlanchedAlmond:= BlueGreenRedToBGRA(205, 235, 255); - CSSBisque:= BlueGreenRedToBGRA(196, 228, 255); - CSSNavajoWhite:= BlueGreenRedToBGRA(173, 222, 255); - CSSWheat:= BlueGreenRedToBGRA(179, 222, 245); - CSSBurlyWood:= BlueGreenRedToBGRA(135, 184, 222); - CSSTan:= BlueGreenRedToBGRA(140, 180, 210); - CSSRosyBrown:= BlueGreenRedToBGRA(143, 143, 188); - CSSSandyBrown:= BlueGreenRedToBGRA(96, 164, 244); - CSSGoldenrod:= BlueGreenRedToBGRA(32, 165, 218); - CSSDarkGoldenrod:= BlueGreenRedToBGRA(11, 134, 184); - CSSPeru:= BlueGreenRedToBGRA(63, 133, 205); - CSSChocolate:= BlueGreenRedToBGRA(30, 105, 210); - CSSSaddleBrown:= BlueGreenRedToBGRA(19, 69, 139); - CSSSienna:= BlueGreenRedToBGRA(45, 82, 160); - CSSBrown:= BlueGreenRedToBGRA(42, 42, 165); - CSSMaroon:= BlueGreenRedToBGRA(0, 0, 128); - - //White colors - CSSWhite:= BlueGreenRedToBGRA(255, 255, 255); - CSSSnow:= BlueGreenRedToBGRA(250, 250, 255); - CSSHoneydew:= BlueGreenRedToBGRA(240, 255, 250); - CSSMintCream:= BlueGreenRedToBGRA(250, 255, 245); - CSSAzure:= BlueGreenRedToBGRA(255, 255, 240); - CSSAliceBlue:= BlueGreenRedToBGRA(255, 248, 240); - CSSGhostWhite:= BlueGreenRedToBGRA(255, 248, 248); - CSSWhiteSmoke:= BlueGreenRedToBGRA(245, 245, 245); - CSSSeashell:= BlueGreenRedToBGRA(255, 245, 238); - CSSBeige:= BlueGreenRedToBGRA(220, 245, 245); - CSSOldLace:= BlueGreenRedToBGRA(230, 245, 253); - CSSFloralWhite:= BlueGreenRedToBGRA(240, 250, 255); - CSSIvory:= BlueGreenRedToBGRA(240, 255, 255); - CSSAntiqueWhite:= BlueGreenRedToBGRA(215, 235, 250); - CSSLinen:= BlueGreenRedToBGRA(230, 240, 250); - CSSLavenderBlush:= BlueGreenRedToBGRA(245, 240, 255); - CSSMistyRose:= BlueGreenRedToBGRA(255, 228, 255); - - //Gray colors - CSSGainsboro:= BlueGreenRedToBGRA(220, 220, 220); - CSSLightGray:= BlueGreenRedToBGRA(211, 211, 211); - CSSSilver:= BlueGreenRedToBGRA(192, 192, 192); - CSSDarkGray:= BlueGreenRedToBGRA(169, 169, 169); - CSSGray:= BlueGreenRedToBGRA(128, 128, 128); - CSSDimGray:= BlueGreenRedToBGRA(105, 105, 105); - CSSLightSlateGray:= BlueGreenRedToBGRA(153, 136, 119); - CSSSlateGray:= BlueGreenRedToBGRA(144, 128, 112); - CSSDarkSlateGray:= BlueGreenRedToBGRA(79, 79, 47); - CSSBlack:= BlueGreenRedToBGRA(0, 0, 0); - - CSSColors := TBGRAColorList.Create; - CSSColors.Add('AliceBlue',CSSAliceBlue); - CSSColors.Add('AntiqueWhite',CSSAntiqueWhite); - CSSColors.Add('Aqua',CSSAqua); - CSSColors.Add('Aquamarine',CSSAquamarine); - CSSColors.Add('Azure',CSSAzure); - CSSColors.Add('Beige',CSSBeige); - CSSColors.Add('Bisque',CSSBisque); - CSSColors.Add('Black',CSSBlack); - CSSColors.Add('BlanchedAlmond',CSSBlanchedAlmond); - CSSColors.Add('Blue',CSSBlue); - CSSColors.Add('BlueViolet',CSSBlueViolet); - CSSColors.Add('Brown',CSSBrown); - CSSColors.Add('BurlyWood',CSSBurlyWood); - CSSColors.Add('CadetBlue',CSSCadetBlue); - CSSColors.Add('Chartreuse',CSSChartreuse); - CSSColors.Add('Chocolate',CSSChocolate); - CSSColors.Add('Coral',CSSCoral); - CSSColors.Add('CornflowerBlue',CSSCornflowerBlue); - CSSColors.Add('Cornsilk',CSSCornsilk); - CSSColors.Add('Crimson',CSSCrimson); - CSSColors.Add('Cyan',CSSCyan); - CSSColors.Add('DarkBlue',CSSDarkBlue); - CSSColors.Add('DarkCyan',CSSDarkCyan); - CSSColors.Add('DarkGoldenrod',CSSDarkGoldenrod); - CSSColors.Add('DarkGray',CSSDarkGray); - CSSColors.Add('DarkGreen',CSSDarkGreen); - CSSColors.Add('DarkKhaki',CSSDarkKhaki); - CSSColors.Add('DarkMagenta',CSSDarkMagenta); - CSSColors.Add('DarkOliveGreen',CSSDarkOliveGreen); - CSSColors.Add('DarkOrange',CSSDarkOrange); - CSSColors.Add('DarkOrchid',CSSDarkOrchid); - CSSColors.Add('DarkRed',CSSDarkRed); - CSSColors.Add('DarkSalmon',CSSDarkSalmon); - CSSColors.Add('DarkSeaGreen',CSSDarkSeaGreen); - CSSColors.Add('DarkSlateBlue',CSSDarkSlateBlue); - CSSColors.Add('DarkSlateGray',CSSDarkSlateGray); - CSSColors.Add('DarkTurquoise',CSSDarkTurquoise); - CSSColors.Add('DarkViolet',CSSDarkViolet); - CSSColors.Add('DeepPink',CSSDeepPink); - CSSColors.Add('DeepSkyBlue',CSSDeepSkyBlue); - CSSColors.Add('DimGray',CSSDimGray); - CSSColors.Add('DodgerBlue',CSSDodgerBlue); - CSSColors.Add('FireBrick',CSSFireBrick); - CSSColors.Add('FloralWhite',CSSFloralWhite); - CSSColors.Add('ForestGreen',CSSForestGreen); - CSSColors.Add('Fuchsia',CSSFuchsia); - CSSColors.Add('Gainsboro',CSSGainsboro); - CSSColors.Add('GhostWhite',CSSGhostWhite); - CSSColors.Add('Gold',CSSGold); - CSSColors.Add('Goldenrod',CSSGoldenrod); - CSSColors.Add('Gray',CSSGray); - CSSColors.Add('Green',CSSGreen); - CSSColors.Add('GreenYellow',CSSGreenYellow); - CSSColors.Add('Honeydew',CSSHoneydew); - CSSColors.Add('HotPink',CSSHotPink); - CSSColors.Add('IndianRed',CSSIndianRed); - CSSColors.Add('Indigo',CSSIndigo); - CSSColors.Add('Ivory',CSSIvory); - CSSColors.Add('Khaki',CSSKhaki); - CSSColors.Add('Lavender',CSSLavender); - CSSColors.Add('LavenderBlush',CSSLavenderBlush); - CSSColors.Add('LawnGreen',CSSLawnGreen); - CSSColors.Add('LemonChiffon',CSSLemonChiffon); - CSSColors.Add('LightBlue',CSSLightBlue); - CSSColors.Add('LightCoral',CSSLightCoral); - CSSColors.Add('LightCyan',CSSLightCyan); - CSSColors.Add('LightGoldenrodYellow',CSSLightGoldenrodYellow); - CSSColors.Add('LightGray',CSSLightGray); - CSSColors.Add('LightGreen',CSSLightGreen); - CSSColors.Add('LightPink',CSSLightPink); - CSSColors.Add('LightSalmon',CSSLightSalmon); - CSSColors.Add('LightSeaGreen',CSSLightSeaGreen); - CSSColors.Add('LightSkyBlue',CSSLightSkyBlue); - CSSColors.Add('LightSlateGray',CSSLightSlateGray); - CSSColors.Add('LightSteelBlue',CSSLightSteelBlue); - CSSColors.Add('LightYellow',CSSLightYellow); - CSSColors.Add('Lime',CSSLime); - CSSColors.Add('LimeGreen',CSSLimeGreen); - CSSColors.Add('Linen',CSSLinen); - CSSColors.Add('Magenta',CSSMagenta); - CSSColors.Add('Maroon',CSSMaroon); - CSSColors.Add('MediumAquamarine',CSSMediumAquamarine); - CSSColors.Add('MediumBlue',CSSMediumBlue); - CSSColors.Add('MediumOrchid',CSSMediumOrchid); - CSSColors.Add('MediumPurple',CSSMediumPurple); - CSSColors.Add('MediumSeaGreen',CSSMediumSeaGreen); - CSSColors.Add('MediumSlateBlue',CSSMediumSlateBlue); - CSSColors.Add('MediumSpringGreen',CSSMediumSpringGreen); - CSSColors.Add('MediumTurquoise',CSSMediumTurquoise); - CSSColors.Add('MediumVioletRed',CSSMediumVioletRed); - CSSColors.Add('MidnightBlue',CSSMidnightBlue); - CSSColors.Add('MintCream',CSSMintCream); - CSSColors.Add('MistyRose',CSSMistyRose); - CSSColors.Add('Moccasin',CSSMoccasin); - CSSColors.Add('NavajoWhite',CSSNavajoWhite); - CSSColors.Add('Navy',CSSNavy); - CSSColors.Add('OldLace',CSSOldLace); - CSSColors.Add('Olive',CSSOlive); - CSSColors.Add('OliveDrab',CSSOliveDrab); - CSSColors.Add('Orange',CSSOrange); - CSSColors.Add('OrangeRed',CSSOrangeRed); - CSSColors.Add('Orchid',CSSOrchid); - CSSColors.Add('PaleGoldenrod',CSSPaleGoldenrod); - CSSColors.Add('PaleGreen',CSSPaleGreen); - CSSColors.Add('PaleTurquoise',CSSPaleTurquoise); - CSSColors.Add('PaleVioletRed',CSSPaleVioletRed); - CSSColors.Add('PapayaWhip',CSSPapayaWhip); - CSSColors.Add('PeachPuff',CSSPeachPuff); - CSSColors.Add('Peru',CSSPeru); - CSSColors.Add('Pink',CSSPink); - CSSColors.Add('Plum',CSSPlum); - CSSColors.Add('PowderBlue',CSSPowderBlue); - CSSColors.Add('Purple',CSSPurple); - CSSColors.Add('Red',CSSRed); - CSSColors.Add('RosyBrown',CSSRosyBrown); - CSSColors.Add('RoyalBlue',CSSRoyalBlue); - CSSColors.Add('SaddleBrown',CSSSaddleBrown); - CSSColors.Add('Salmon',CSSSalmon); - CSSColors.Add('SandyBrown',CSSSandyBrown); - CSSColors.Add('SeaGreen',CSSSeaGreen); - CSSColors.Add('Seashell',CSSSeashell); - CSSColors.Add('Sienna',CSSSienna); - CSSColors.Add('Silver',CSSSilver); - CSSColors.Add('SkyBlue',CSSSkyBlue); - CSSColors.Add('SlateBlue',CSSSlateBlue); - CSSColors.Add('SlateGray',CSSSlateGray); - CSSColors.Add('Snow',CSSSnow); - CSSColors.Add('SpringGreen',CSSSpringGreen); - CSSColors.Add('SteelBlue',CSSSteelBlue); - CSSColors.Add('Tan',CSSTan); - CSSColors.Add('Teal',CSSTeal); - CSSColors.Add('Thistle',CSSThistle); - CSSColors.Add('Tomato',CSSTomato); - CSSColors.Add('Turquoise',CSSTurquoise); - CSSColors.Add('Violet',CSSViolet); - CSSColors.Add('Wheat',CSSWheat); - CSSColors.Add('White',CSSWhite); - CSSColors.Add('WhiteSmoke',CSSWhiteSmoke); - CSSColors.Add('Yellow',CSSYellow); - CSSColors.Add('YellowGreen',CSSYellowGreen); - CSSColors.Finished; -{$ENDIF} - -{$IFDEF INCLUDE_FINAL} -{$UNDEF INCLUDE_FINAL} - CSSColors.Free; - VGAColors.Free; -{$ENDIF} diff --git a/components/bgrabitmap/density256.inc b/components/bgrabitmap/density256.inc deleted file mode 100644 index fd132a4..0000000 --- a/components/bgrabitmap/density256.inc +++ /dev/null @@ -1,98 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_FILLDENSITY} -{$UNDEF INCLUDE_FILLDENSITY} - - {$IFNDEF PARAM_SINGLESEGMENT} - begin - { this loops fill one scanline of densities by adding 256 for full horizontal pixels } - - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX; - x2 := inter[i + i + 1].interX; - {$ENDIF} - - if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then - begin - if x1 < minx then - x1 := minx; - if x2 >= maxx + 1 then - x2 := maxx + 1; - ix1 := floor(x1); - ix2 := floor(x2); - - //here it may go one pixel further if x2 is an integer - if ix1 < densMinx then densMinx := ix1; - if ix2 > densMaxx then densMaxx := ix2; - - if ix1 = ix2 then - inc( (density + (ix1 - minx))^, round((x2-ix2)*256) - round((x1-ix1)*256) ) - else - begin - inc( (density + (ix1 - minx))^, 256 - round((x1 - ix1)*256) ); - if (ix2 <= maxx) then - inc( (density + (ix2 - minx))^, round((x2 - ix2)*256) ); - end; - if ix2 > ix1 + 1 then - begin - AddDensity(density, ix1+1 - minx, ix2-(ix1+1), 256); - end; - end; - - {$IFNDEF PARAM_SINGLESEGMENT} - end; - end; - {$ENDIF} - -{$UNDEF PARAM_SINGLESEGMENT} -{$ENDIF} - -{$IFDEF INCLUDE_RENDERDENSITY} -{$UNDEF INCLUDE_RENDERDENSITY} - begin - if densMinX <= densMaxX then - begin - if densMinX < minx then densMinX := minx; - if densMaxX > maxx then densMaxX := maxx; - xb := densMinX; - pdens := density + (densMinX-minx); - pDest := bmp.GetPixelAddress(densMinX,yb); - brush.MoveTo(@ctx, pDest,xb,yb); - while xb<=densMaxX do - begin - tempDensity:= pDens^; - inc(pDens); - inc(xb); - drawCount := 1; - if tempDensity>=256{$ifdef PARAM_ANTIALIASINGFACTOR} shl AntialiasPrecisionShift{$endif} then - begin - while (xb<=densMaxX) and (pDens^ >= 256{$ifdef PARAM_ANTIALIASINGFACTOR} shl AntialiasPrecisionShift{$endif}) do - begin - inc(xb); - inc(pDens); - inc(drawCount); - end; - brush.PutNextPixels(@ctx, 65535, drawCount); - end else - begin - while (xb<=densMaxX) and (pDens^ = tempDensity) do - begin - inc(xb); - inc(pDens); - inc(drawCount); - end; - if tempDensity = 0 then - brush.PutNextPixels(@ctx, 0, drawCount ) - else - begin - dec(tempDensity); - brush.PutNextPixels(@ctx, (tempDensity shl (8{$ifdef PARAM_ANTIALIASINGFACTOR}-AntialiasPrecisionShift{$endif})) - + (tempDensity{$ifdef PARAM_ANTIALIASINGFACTOR} shr (2*AntialiasPrecisionShift){$endif}), drawCount ); - end; - end; - end; - end; - end - -{$undef PARAM_ANTIALIASINGFACTOR} -{$ENDIF} diff --git a/components/bgrabitmap/expandedbitmap.pas b/components/bgrabitmap/expandedbitmap.pas deleted file mode 100644 index 1c23368..0000000 --- a/components/bgrabitmap/expandedbitmap.pas +++ /dev/null @@ -1,762 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit ExpandedBitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; - -type - - { TExpandedBitmap } - - TExpandedBitmap = class(specialize TGenericUniversalBitmap) - protected - function InternalNew: TCustomUniversalBitmap; override; - procedure AssignTransparentPixel(out ADest); override; - public - class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TExpandedPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - end; - -const - ExpandedPixelTransparent : TExpandedPixel = (red:0; green:0; blue:0; alpha:0); - -operator = (const c1, c2: TExpandedPixel): boolean; inline; - -implementation - -uses XYZABitmap; - -operator = (const c1, c2: TExpandedPixel): boolean; -begin - if (c1.alpha = 0) and (c2.alpha = 0) then - Result := True - else - Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and - (c1.green = c2.green) and (c1.blue = c2.blue); -end; - -procedure ExpandedSolidBrushSkipPixels({%H-}AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -begin - inc(PExpandedPixel(AContextData^.Dest), ACount); -end; - -procedure ExpandedChunkSetPixels( - ASource: PExpandedPixel; ADest: PExpandedPixel; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; - finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + ((ASource^.alpha*alphaOver+32768) shr 16); - if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.alpha:= finalAlpha; - ADest^.red := (ADest^.red*residualAlpha + - ASource^.red*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.green := (ADest^.green*residualAlpha + - ASource^.green*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.blue := (ADest^.blue*residualAlpha + - ASource^.blue*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure ExpandedSolidBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PExpandedPixel; -begin - pDest := PExpandedPixel(AContextData^.Dest); - ExpandedChunkSetPixels( PExpandedPixel(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -procedure ExpandedChunkDrawPixels( - ASource: PExpandedPixel; ADest: PExpandedPixel; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver, srcAlphaOver, finalAlpha, finalAlphaDiv2, residualAlpha: UInt32or64; -begin - if AAlpha=0 then exit; - if AAlpha >= 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - srcAlphaOver := (ASource^.alpha*alphaOver+32768) shr 16; - if srcAlphaOver >= 65535 then - ADest^ := ASource^ - else - begin - if srcAlphaOver >= 32768 then inc(srcAlphaOver); - residualAlpha := (ADest^.alpha*UInt32or64(65536-srcAlphaOver)+32768) shr 16; - finalAlpha := residualAlpha + srcAlphaOver; - if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - ADest^.alpha:= finalAlpha; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.red := (ADest^.red*residualAlpha + - ASource^.red*srcAlphaOver + finalAlphaDiv2) div finalAlpha; - ADest^.green := (ADest^.green*residualAlpha + - ASource^.green*srcAlphaOver + finalAlphaDiv2) div finalAlpha; - ADest^.blue := (ADest^.blue*residualAlpha + - ASource^.blue*srcAlphaOver + finalAlphaDiv2) div finalAlpha; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; -end; - -procedure ExpandedSolidBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PExpandedPixel; -begin - pDest := PExpandedPixel(AContextData^.Dest); - ExpandedChunkDrawPixels( PExpandedPixel(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -procedure ExpandedChunkXorPixels( - ASource: PExpandedPixel; ADest: PExpandedPixel; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; - finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; - xored: TExpandedPixel; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - PQWord(ADest)^ := PQWord(ADest)^ xor PQWord(ASource)^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - PQWord(@xored)^ := PQWord(ADest)^ xor PQWord(ASource)^; - residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + ((xored.alpha*alphaOver+32768) shr 16); - if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.alpha:= finalAlpha; - ADest^.red := (ADest^.red*residualAlpha + - xored.red*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.green := (ADest^.green*residualAlpha + - xored.green*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.blue := (ADest^.blue*residualAlpha + - xored.blue*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure ExpandedSolidBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PExpandedPixel; -begin - pDest := PExpandedPixel(AContextData^.Dest); - ExpandedChunkXorPixels( PExpandedPixel(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -type - PExpandedPixelScannerBrushFixedData = ^TExpandedScannerBrushFixedData; - TExpandedScannerBrushFixedData = record - Scanner: Pointer; //avoid ref count by using pointer type - OffsetX, OffsetY: integer; - Conversion: TBridgedConversion; - end; - -procedure ExpandedScannerBrushInitContext(AFixedData: Pointer; - AContextData: PUniBrushContext); -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, - AContextData^.Ofs.Y + OffsetY); -end; - -procedure ExpandedScannerConvertBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PExpandedPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TExpandedPixel; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); - ExpandedChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedScannerChunkBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PExpandedPixel; - qty: Integer; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - ExpandedChunkSetPixels(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedChunkSetPixelsExceptTransparent( - ASource: PExpandedPixel; ADest: PExpandedPixel; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; - finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - if ASource^.alpha = 65535 then ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - if ASource^.alpha = 65535 then - begin - residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + AAlpha; - if finalAlpha <= 0 then ADest^ := ExpandedPixelTransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.alpha:= finalAlpha; - ADest^.red := (ADest^.red*residualAlpha + - ASource^.red*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.green := (ADest^.green*residualAlpha + - ASource^.green*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.blue := (ADest^.blue*residualAlpha + - ASource^.blue*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure ExpandedScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PExpandedPixel; - qty: Integer; - psrc: Pointer; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - ExpandedChunkSetPixelsExceptTransparent(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PExpandedPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TExpandedPixel; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); - ExpandedChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedScannerChunkBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - qty: Integer; - pDest: PExpandedPixel; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - ExpandedChunkDrawPixels(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedScannerConvertBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PExpandedPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TExpandedPixel; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); - ExpandedChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedScannerChunkBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - qty: Integer; - pDest: PExpandedPixel; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - ExpandedChunkXorPixels(PExpandedPixel(psrc), pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedScannerConvertBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PExpandedPixel; - qty, pixSize: Integer; - buf: packed array[0..7] of TExpandedPixel; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TExpandedPixel), nil); - ExpandedChunkXorPixels(@buf, pDest, AAlpha, qty, sizeof(TExpandedPixel) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure ExpandedMaskBrushApply(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PExpandedPixel; - qty, maskStride: Integer; - pMask: PByteMask; - factor: UInt32or64; -begin - with PExpandedPixelScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - if AAlpha = 65535 then - begin - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - if pMask^.gray >= 128 then - pDest^.alpha := (pDest^.alpha*(pMask^.gray+1)) shr 8 - else pDest^.alpha := pDest^.alpha*pMask^.gray shr 8; - if pDest^.alpha = 0 then pDest^ := ExpandedPixelTransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end else - begin - factor := AAlpha + (AAlpha shr 8) + (AAlpha shr 14); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.alpha := (pDest^.alpha*((factor*pMask^.gray+128) shr 8)) shr 16; - if pDest^.alpha = 0 then pDest^ := ExpandedPixelTransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end; - PExpandedPixel(AContextData^.Dest) := pDest; - end; -end; - -procedure ExpandedAlphaBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PExpandedPixel; - alphaOver, residualAlpha, finalAlpha: UInt32or64; -begin - if AAlpha=0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - if AAlpha=65535 then - begin - finalAlpha := PWord(AFixedData)^; - while ACount > 0 do - begin - pDest^.alpha := finalAlpha; - inc(pDest); - dec(ACount); - end; - end else - begin - if AAlpha >= 32768 then alphaOver := AAlpha+1 - else alphaOver := AAlpha; - while ACount > 0 do - begin - residualAlpha := (pDest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + (PWord(AFixedData)^*alphaOver+32768) shr 16; - if finalAlpha > 65535 then finalAlpha := 65535; - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - end; - PExpandedPixel(AContextData^.Dest) := pDest; -end; - -procedure ExpandedAlphaBrushErasePixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PExpandedPixel; - alphaMul, finalAlpha: UInt32or64; -begin - if AAlpha=0 then - begin - inc(PExpandedPixel(AContextData^.Dest), ACount); - exit; - end; - pDest := PExpandedPixel(AContextData^.Dest); - if AAlpha<>65535 then - alphaMul := 65535-((PWord(AFixedData)^*AAlpha+32767) div 65535) - else - alphaMul := 65535-PWord(AFixedData)^; - if alphaMul >= 32768 then inc(alphaMul); - while ACount > 0 do - begin - finalAlpha := (pDest^.alpha*alphaMul+32768) shr 16; - if finalAlpha <= 0 then pDest^ := ExpandedPixelTransparent else - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - PExpandedPixel(AContextData^.Dest) := pDest; -end; - -{ TExpandedBitmap } - -function TExpandedBitmap.InternalNew: TCustomUniversalBitmap; -begin - Result:= TExpandedBitmap.Create; -end; - -procedure TExpandedBitmap.AssignTransparentPixel(out ADest); -begin - TExpandedPixel(ADest) := ExpandedPixelTransparent; -end; - -class procedure TExpandedBitmap.SolidBrush(out ABrush: TUniversalBrush; - const AColor: TExpandedPixel; ADrawMode: TDrawMode); -begin - ABrush.Colorspace:= TExpandedPixelColorspace; - PExpandedPixel(@ABrush.FixedData)^ := AColor; - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSetPixels; - - dmSetExceptTransparent: - if AColor.alpha < 65535 then - ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSkipPixels - else - begin - ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSetPixels; - ABrush.DoesNothing := true; - end; - - dmDrawWithTransparency,dmLinearBlend: - if AColor.alpha<=0 then - begin - ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSkipPixels; - ABrush.DoesNothing := true; - end - else if AColor.alpha>=1 then - ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSetPixels - else - ABrush.InternalPutNextPixels:= @ExpandedSolidBrushDrawPixels; - - dmXor: if PQWord(@AColor)^ = 0 then - begin - ABrush.InternalPutNextPixels:= @ExpandedSolidBrushSkipPixels; - ABrush.DoesNothing := true; - end else - ABrush.InternalPutNextPixels:= @ExpandedSolidBrushXorPixels; - end; -end; - -class procedure TExpandedBitmap.ScannerBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; ADrawMode: TDrawMode; - AOffsetX: integer; AOffsetY: integer); -var - sourceSpace: TColorspaceAny; -begin - ABrush.Colorspace:= TExpandedPixelColorspace; - with PExpandedPixelScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @ExpandedScannerBrushInitContext; - sourceSpace := AScanner.GetScanCustomColorspace; - if sourceSpace = TExpandedPixelColorspace then - begin - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushDrawPixels; - dmXor: ABrush.InternalPutNextPixels:= @ExpandedScannerChunkBrushXorPixels; - end; - end else - begin - with PExpandedPixelScannerBrushFixedData(@ABrush.FixedData)^ do - Conversion := sourceSpace.GetBridgedConversion(TExpandedPixelColorspace); - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushDrawPixels; - dmXor: ABrush.InternalPutNextPixels:= @ExpandedScannerConvertBrushXorPixels; - end; - end; -end; - -class procedure TExpandedBitmap.MaskBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); -begin - ABrush.Colorspace:= TExpandedPixelColorspace; - with PExpandedPixelScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @ExpandedScannerBrushInitContext; - ABrush.InternalPutNextPixels:= @ExpandedMaskBrushApply; -end; - -class procedure TExpandedBitmap.EraseBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, ExpandedPixelTransparent, dmDrawWithTransparency); - exit; - end; - ABrush.Colorspace:= TExpandedPixelColorspace; - PWord(@ABrush.FixedData)^ := AAlpha; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @ExpandedAlphaBrushErasePixels; -end; - -class procedure TExpandedBitmap.AlphaBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, ExpandedPixelTransparent, dmSet); - exit; - end; - ABrush.Colorspace:= TExpandedPixelColorspace; - PWord(@ABrush.FixedData)^ := AAlpha; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @ExpandedAlphaBrushSetPixels; -end; - -end. - diff --git a/components/bgrabitmap/extendedcolorspace.inc b/components/bgrabitmap/extendedcolorspace.inc deleted file mode 100644 index 7bbd22a..0000000 --- a/components/bgrabitmap/extendedcolorspace.inc +++ /dev/null @@ -1,1454 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} - -type - TSpectralLocusPoint = record - W,X,Y,Z: Single; - end; - TIlluminantSpectrumPoint = record - W,Y: Single; - end; - -{$I spectraldata.inc} - -type - PXYZReferenceWhite = ^TXYZReferenceWhite; - TXYZReferenceWhite = packed record - X, Y, Z: single; - ObserverAngle: integer; - Illuminant: string; - L,M,S: single; - end; - - TCustomColorspace = class; - TColorspaceAny = class of TCustomColorspace; - - TColorspaceConvertArrayProc = procedure(ASource: pointer; ADest: Pointer; ACount: integer; - ASourceStride:integer; ADestStride:integer; AReferenceWhite: PXYZReferenceWhite); - - { TBridgedConversion } - - TBridgedConversion = record - ConvertToBridge,FinalConvert: TColorspaceConvertArrayProc; - procedure Convert(ASource: pointer; ADest: Pointer; ACount: integer; - ASourceStride:integer; ADestStride:integer; AReferenceWhite: PXYZReferenceWhite); inline; - end; - - TColorTransparency = (ctFullyTransparent, ctSemiTransparent, ctFullyOpaque); - TColorspaceFlag = (cfFixedReferenceWhite, // ex: sRGB, AdobeRGB fixed at D65 - cfMovableReferenceWhite, // XYZ - cfReferenceWhiteIndependent, // L*a*b*, LCh - cfHasImaginaryColors); // XYZ, L*a*b*, LCh - TColorspaceFlags = set of TColorspaceFlag; - - { TCustomColorspace } - - TCustomColorspace = class - class function GetChannelName(AIndex: integer): string; virtual; abstract; - class function GetChannelCount: integer; virtual; abstract; - class function IndexOfChannel(AName: string): integer; - class function IndexOfAlphaChannel: integer; virtual; abstract; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; virtual; abstract; - class function GetMaxValue(AIndex: integer): single; virtual; abstract; - class function GetMinValue(AIndex: integer): single; virtual; abstract; - class function GetChannelBitDepth(AIndex: integer): byte; virtual; abstract; - class function GetName: string; virtual; abstract; - class function GetSize: integer; virtual; abstract; - class function GetChannel(AColor: Pointer; AIndex: integer): single; virtual; abstract; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); virtual; abstract; - class procedure Convert(const ASource; out ADest; ADestColorspace: TColorspaceAny; - ACount: integer = 1; AReferenceWhite: PXYZReferenceWhite = nil); - class function GetDirectConversion(ADestColorspace: TColorspaceAny): TColorspaceConvertArrayProc; - class function GetBridgedConversion(ADestColorspace: TColorspaceAny): TBridgedConversion; - class function GetFlags: TColorspaceFlags; virtual; abstract; - end; - - { ColorspaceCollection } - - ColorspaceCollection = class - protected - class var FColorspaces : array of TColorspaceAny; - class var FColorspaceCount: integer; - class var FColorspaceConversions: array of array of TColorspaceConvertArrayProc; - public - class function GetCount: integer; static; - class function GetItem(AIndex: integer): TColorspaceAny; static; - class function IndexOf(AColorspace: TColorspaceAny): integer; static; - class procedure Add(AColorspace: TColorspaceAny); static; - class procedure AddConversion(ASource: TColorspaceAny; ADest: TColorspaceAny; AConversion: TColorspaceConvertArrayProc); static; - class function GetDirectConversion(ASource: TColorspaceAny; ADest: TColorspaceAny): TColorspaceConvertArrayProc; static; - class function GetBridgedConversion(ASource: TColorspaceAny; ADest: TColorspaceAny): TBridgedConversion; static; - end; - -type {* How to handle overflow when converting from XYZ } - TColorspaceOverflow = - {** Colors outside of target colorspace are converted to transparent } - (xroClipToTarget, - {** Each color channel is saturated independently (hue may be lost) } - xroSaturateEachChannel, - {** Hue is preserved by reducing intensity or saturation } - xroPreserveHue); - -var - XYZToRGBOverflowMin : TColorspaceOverflow = xroSaturateEachChannel; - XYZToRGBOverflowMax : TColorspaceOverflow = xroSaturateEachChannel; - -{$DEFINE INCLUDE_INTERFACE} -{$I generatedcolorspace.inc} - -function BGRAToMask(const ABGRAPixel: TBGRAPixel): TByteMask; -function ExpandedPixelToByteMask(const AExpandedPixel: TExpandedPixel): TByteMask; -function MaskToBGRA(const AMask: TByteMask; AAlpha: byte = 255): TBGRAPixel; -function ByteMaskToExpandedPixel(const AMask: TByteMask; AAlpha: byte = 255): TExpandedPixel; -function StdRGBAToBGRAPixel(const AStdRGBA: TStdRGBA): TBGRAPixel; -function BGRAPixelToStdRGBA(const ABGRAPixel: TBGRAPixel): TStdRGBA; -function LinearRGBAToExpandedPixel(const ALinearRGBA: TLinearRGBA): TExpandedPixel; -function ExpandedPixelToLinearRGBA(const AExpandedPixel: TExpandedPixel): TLinearRGBA; -function ExpandedPixelToStdRGBA(const AExpandedPixel: TExpandedPixel): TStdRGBA; -function GammaCompressionWF(AValue: Word): single; -function StdRGBAToExpandedPixel(const AStdRGBA: TStdRGBA): TExpandedPixel; -function GammaExpansionFW(AValue: single): word; -function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA): TXYZA; overload; -function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; overload; -function XYZAToLinearRGBA(const AXYZA: TXYZA): TLinearRGBA; overload; -function XYZAToLinearRGBA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA; overload; -function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel): TWordXYZA; overload; -function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA; overload; -function XYZAToWordXYZA(const AXYZA: TXYZA): TWordXYZA; -function WordXYZAToXYZA(const AWordXYZA: TWordXYZA): TXYZA; -function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA): TExpandedPixel; overload; -function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel; overload; -function XYZAToLabA(const AXYZA: TXYZA): TLabA; overload; -function XYZAToLabA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLabA; overload; -function LabAToXYZA(const ALabA: TLabA): TXYZA; overload; -function LabAToXYZA(const ALabA: TLabA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; overload; -function StdRGBAToLinearRGBA(const AStdRGBA: TStdRGBA): TLinearRGBA; -function LinearRGBAToStdRGBA(const ALinearRGBA: TLinearRGBA): TStdRGBA; -function StdRGBAToStdHSLA(const AStdRGBA: TStdRGBA): TStdHSLA; -function StdHSLAToStdRGBA(const AStdHSLA: TStdHSLA): TStdRGBA; -function StdRGBAToStdHSVA(const AStdRGBA: TStdRGBA): TStdHSVA; -function StdHSVAToStdRGBA(const AStdHSVA: TStdHSVA): TStdRGBA; -function StdHSLAToStdHSVA(const AStdHSLA: TStdHSLA): TStdHSVA; -function StdHSVAToStdHSLA(const AStdHSVA: TStdHSVA): TStdHSLA; -function StdRGBAToStdCMYK(const AStdRGBA: TStdRGBA): TStdCMYK; -function StdCMYKToStdRGBA(const AStdCMYK: TStdCMYK; AAlpha: Single = 1): TStdRGBA; -function LabAToLChA(const ALabA: TLabA): TLChA; -function LChAToLabA(const ALChA: TLChA): TLabA; -function AdobeRGBAToXYZA(const ASource: TAdobeRGBA): TXYZA; overload; -function AdobeRGBAToXYZA(const ASource: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; overload; -function XYZAToAdobeRGBA(const AXYZA: TXYZA): TAdobeRGBA; overload; -function XYZAToAdobeRGBA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA; overload; -function SpectrumRangeReflectToXYZA(reflectance,wavelen1,wavelen2,alpha: single): TXYZA; -procedure XYZToLMS(const X,Y,Z: Single; out L,M,S: single); -procedure LMSToXYZ(const L,M,S: Single; out X,Y,Z: single); -procedure ChromaticAdaptXYZ(var X,Y,Z: single; const AFrom, ATo: TXYZReferenceWhite); inline; -procedure ChromaticAdaptWordXYZ(var X,Y,Z: word; const AFrom, ATo: TXYZReferenceWhite); inline; - -procedure SetReferenceWhite(AObserverAngle: integer; AIlluminant: string); overload; -procedure SetReferenceWhite(AReferenceWhite: TXYZReferenceWhite); overload; -function GetReferenceWhite: TXYZReferenceWhite; overload; -function GetReferenceWhiteIndirect: PXYZReferenceWhite; overload; -function GetReferenceWhite(AObserverAngle: integer; AIlluminant: string): TXYZReferenceWhite; overload; -function GetReferenceWhiteIndirect(AObserverAngle: integer; AIlluminant: string): PXYZReferenceWhite; overload; - -procedure AddReferenceWhite(const AReferenceWhite: TXYZReferenceWhite); overload; -procedure AddReferenceWhite(AObserverAngle: integer; AIlluminant: string; AX, AY, AZ: single); overload; -function GetReferenceWhiteCount: integer; -function GetReferenceWhiteByIndex(AIndex: integer): TXYZReferenceWhite; - -var - ReferenceWhite2D50, ReferenceWhite2D65, ReferenceWhite2E: TXYZReferenceWhite; - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -{ TBridgedConversion } - -procedure TBridgedConversion.Convert(ASource: pointer; ADest: Pointer; - ACount: integer; ASourceStride: integer; ADestStride: integer; - AReferenceWhite: PXYZReferenceWhite); -const - bufSize = 512; - bufCount = 512 div sizeof(TExpandedPixel); -var - buf: array[0..bufSize-1] of byte; - psrc, pdest: PByte; -begin - if Assigned(ConvertToBridge) then - begin - psrc := PByte(ASource); - pdest := PByte(ADest); - while ACount > 0 do - begin - if ACount > bufCount then - begin - ConvertToBridge(psrc, @buf, bufCount, ASourceStride, sizeof(TExpandedPixel), AReferenceWhite); - FinalConvert(@buf, pdest, bufCount, sizeof(TExpandedPixel), ADestStride, AReferenceWhite); - inc(psrc, ASourceStride*bufCount); - inc(pdest, ADestStride*bufCount); - dec(ACount,bufCount); - end - else - begin - ConvertToBridge(psrc, @buf, ACount, ASourceStride, sizeof(TExpandedPixel), AReferenceWhite); - FinalConvert(@buf, pdest, ACount, sizeof(TExpandedPixel), ADestStride, AReferenceWhite); - break; - end; - end; - end else - FinalConvert(ASource,ADest,ACount,ASourceStride,ADestStride,AReferenceWhite); -end; - -{ TCustomColorspace } - -class function TCustomColorspace.IndexOfChannel(AName: string): integer; -var - i: Integer; -begin - for i := 0 to GetChannelCount-1 do - if GetChannelName(i) = AName then exit(i); - exit(-1); -end; - -class procedure TCustomColorspace.Convert(const ASource; - out ADest; ADestColorspace: TColorspaceAny; - ACount: integer; AReferenceWhite: PXYZReferenceWhite); -var - conv: TBridgedConversion; -begin - if self = TCustomColorspace then - raise exception.Create('Cannot convert from abstract colorspace'); - if self = ADestColorspace then - move(ASource, {%H-}ADest, self.GetSize * ACount) - else - begin - conv := ColorspaceCollection.GetBridgedConversion(self, ADestColorspace); - conv.Convert(@ASource,@ADest,ACount,self.GetSize,ADestColorspace.GetSize,AReferenceWhite); - end; -end; - -class function TCustomColorspace.GetDirectConversion(ADestColorspace: TColorspaceAny): TColorspaceConvertArrayProc; -begin - result := ColorspaceCollection.GetDirectConversion(self, ADestColorspace); -end; - -class function TCustomColorspace.GetBridgedConversion( - ADestColorspace: TColorspaceAny): TBridgedConversion; -begin - result := ColorspaceCollection.GetBridgedConversion(self, ADestColorspace); -end; - -{ ColorspaceCollection } - -class function ColorspaceCollection.GetCount: integer; -begin - result := FColorspaceCount; -end; - -class function ColorspaceCollection.GetItem(AIndex: integer): TColorspaceAny; -begin - if (AIndex < 0) or (AIndex >= FColorspaceCount) then - raise ERangeError.Create('Index out of bounds'); - result := FColorspaces[AIndex]; -end; - -class function ColorspaceCollection.IndexOf(AColorspace: TColorspaceAny): integer; -var - i: Integer; -begin - for i := 0 to FColorspaceCount-1 do - if FColorspaces[i] = AColorspace then exit(i); - result := -1; -end; - -class procedure ColorspaceCollection.Add(AColorspace: TColorspaceAny); -var - i: Integer; -begin - for i := 0 to high(FColorspaces) do - if FColorspaces[i] = AColorspace then exit; - - if FColorspaceCount >= length(FColorspaces) then - setlength(FColorspaces, FColorspaceCount*2+8); - FColorspaces[FColorspaceCount] := AColorspace; - inc(FColorspaceCount); -end; - -class procedure ColorspaceCollection.AddConversion(ASource: TColorspaceAny; - ADest: TColorspaceAny; AConversion: TColorspaceConvertArrayProc); -var - idxSource, idxDest: Integer; -begin - idxSource := IndexOf(ASource); - if idxSource = -1 then raise exception.Create('Colorspace not registered'); - idxDest := IndexOf(ADest); - if idxDest = -1 then raise exception.Create('Colorspace not registered'); - if idxSource >= length(FColorspaceConversions) then - setlength(FColorspaceConversions, FColorspaceCount+4); - if idxDest >= length(FColorspaceConversions[idxSource]) then - setlength(FColorspaceConversions[idxSource], FColorspaceCount+4); - FColorspaceConversions[idxSource][idxDest] := AConversion; -end; - -procedure CopyColorsAny(ASource: pointer; ADest: Pointer; ACount: integer; - {%H-}ASourceStride:integer; ADestStride:integer; {%H-}AReferenceWhite: PXYZReferenceWhite); -begin - move(ASource^, ADest^, ADestStride * ACount); -end; - -class function ColorspaceCollection.GetDirectConversion(ASource: TColorspaceAny; - ADest: TColorspaceAny): TColorspaceConvertArrayProc; -var - idxSource, idxDest: Integer; -begin - if ASource = ADest then - exit(@CopyColorsAny); - - idxSource := IndexOf(ASource); - if idxSource = -1 then raise exception.Create('Colorspace not registered'); - idxDest := IndexOf(ADest); - if idxDest = -1 then raise exception.Create('Colorspace not registered'); - - if (idxSource < length(FColorspaceConversions)) and - (idxDest < length(FColorspaceConversions[idxSource])) then - result := FColorspaceConversions[idxSource][idxDest] - else - result := nil; -end; - -class function ColorspaceCollection.GetBridgedConversion( - ASource: TColorspaceAny; ADest: TColorspaceAny): TBridgedConversion; -begin - result.FinalConvert:= GetDirectConversion(ASource,ADest); - if result.FinalConvert<>nil then - begin // direct conversion so no bridge needed - result.ConvertToBridge:= nil; - end else - begin - result.ConvertToBridge:= GetDirectConversion(ASource,TExpandedPixelColorspace); - if result.ConvertToBridge=nil then raise exception.Create('Cannot convert '+ASource.GetName+' to bridge'); - result.FinalConvert:= GetDirectConversion(TExpandedPixelColorspace,ADest); - if result.FinalConvert=nil then raise exception.Create('Cannot convert '+ADest.GetName+' from bridge'); - end; -end; - -var - CurrentReferenceWhite: TXYZReferenceWhite; - ReferenceWhiteArray: array of TXYZReferenceWhite; - -function Clamp(const V, Min, Max: single): single; -begin - Result := V; - if Result < Min then - Result := Min - else if Result > Max then - Result := Max - else Result := V; -end; - -function ClampInt(V, Min, Max: integer): integer; -begin - Result := V; - if Result < Min then - Result := Min - else if Result > Max then - Result := Max - else Result := V; -end; - -function PositiveModSingle(x, cycle: single): single; -begin - if (x < 0) or (x >= cycle) then - Result := x - cycle * floor(x / cycle) - else - result := x; -end; - -procedure PrepareReferenceWhiteArray; -begin - //Source:http://www.easyrgb.com/index.php?X=MATH&H=15#text15 - //domestic, tungsten-filament lighting - AddReferenceWhite(2, 'A', 1.09850, 1.00, 0.35585); - AddReferenceWhite(10, 'A', 1.11144, 1.00, 0.35200); - //deprecated daylight - AddReferenceWhite(2, 'C', 0.98074, 1.00, 1.18232); - AddReferenceWhite(10, 'C', 0.97285, 1.00, 1.16145); - //daylight - AddReferenceWhite(2, 'D50', 0.96422, 1.00, 0.82521); - AddReferenceWhite(10, 'D50', 0.96720, 1.00, 0.81427); - AddReferenceWhite(2, 'D55', 0.95682, 1.00, 0.92149); - AddReferenceWhite(10, 'D55', 0.95799, 1.00, 0.90926); - AddReferenceWhite(2, 'D65', 0.95047, 1.00, 1.08883); - AddReferenceWhite(10, 'D65', 0.94811, 1.00, 1.07304); - AddReferenceWhite(2, 'D75', 0.94972, 1.00, 1.22638); - AddReferenceWhite(10, 'D75', 0.94416, 1.00, 1.20641); - //equal energy - AddReferenceWhite(2, 'E', 1,1,1); - AddReferenceWhite(10, 'E', 1,1,1); - //fluorescent light - AddReferenceWhite(2, 'F2', 0.99187, 1.00, 0.67395); - AddReferenceWhite(10, 'F2', 1.03280, 1.00, 0.69026); - AddReferenceWhite(2, 'F7', 0.95044, 1.00, 1.08755); - AddReferenceWhite(10, 'F7', 0.95792, 1.00, 1.07687); - AddReferenceWhite(2, 'F11', 1.00966, 1.00, 0.64370); - AddReferenceWhite(10, 'F11', 1.03866, 1.00, 0.65627); -end; - -procedure SetReferenceWhite(AObserverAngle: integer; AIlluminant: string); -var - rp: TXYZReferenceWhite; - i: integer; -begin - for i := 0 to Length(ReferenceWhiteArray) - 1 do - begin - rp := ReferenceWhiteArray[i]; - if (rp.ObserverAngle = AObserverAngle) and (rp.Illuminant = AIlluminant) then - begin - CurrentReferenceWhite := rp; - Break; - end; - end; -end; - -procedure SetReferenceWhite(AReferenceWhite: TXYZReferenceWhite); -begin - CurrentReferenceWhite := AReferenceWhite; -end; - -function GetReferenceWhite: TXYZReferenceWhite; -begin - Result := CurrentReferenceWhite; -end; - -function GetReferenceWhiteIndirect: PXYZReferenceWhite; -begin - result := @CurrentReferenceWhite; -end; - -function GetReferenceWhite(AObserverAngle: integer; AIlluminant: string): TXYZReferenceWhite; -var - p: PXYZReferenceWhite; -begin - p := GetReferenceWhiteIndirect(AObserverAngle, AIlluminant); - if p = nil then raise exception.Create('Reference white not found'); - result := p^; -end; - -function GetReferenceWhiteIndirect(AObserverAngle: integer; AIlluminant: string): PXYZReferenceWhite; -var - rp: PXYZReferenceWhite; - i: integer; -begin - for i := 0 to Length(ReferenceWhiteArray) - 1 do - begin - rp := @ReferenceWhiteArray[i]; - if (rp^.ObserverAngle = AObserverAngle) and (rp^.Illuminant = AIlluminant) then - begin - result := rp; - exit; - end; - end; - result := nil; -end; - -procedure AddReferenceWhite(const AReferenceWhite: TXYZReferenceWhite); -begin - if GetReferenceWhiteIndirect(AReferenceWhite.ObserverAngle, AReferenceWhite.Illuminant)<>nil then - raise exception.Create('Reference white already defined'); - SetLength(ReferenceWhiteArray, Length(ReferenceWhiteArray) + 1); - ReferenceWhiteArray[Length(ReferenceWhiteArray) - 1] := AReferenceWhite; - with ReferenceWhiteArray[Length(ReferenceWhiteArray) - 1] do - XYZToLMS(X,Y,Z, L,M,S); -end; - -procedure AddReferenceWhite(AObserverAngle: integer; AIlluminant: string; AX, AY, AZ: single); -var - rp: TXYZReferenceWhite; -begin - rp.Illuminant := AIlluminant; - rp.ObserverAngle := AObserverAngle; - rp.X := AX; - rp.Y := AY; - rp.Z := AZ; - AddReferenceWhite(rp); -end; - -function GetReferenceWhiteCount: integer; -begin - result := length(ReferenceWhiteArray); -end; - -function GetReferenceWhiteByIndex(AIndex: integer): TXYZReferenceWhite; -begin - if (AIndex < 0) or (AIndex >= length(ReferenceWhiteArray)) then - raise ERangeError.Create('Index out of bounds'); - result := ReferenceWhiteArray[AIndex]; -end; - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I generatedcolorspace.inc} - -function BGRAToMask(const ABGRAPixel: TBGRAPixel): TByteMask; -var - ec: TExpandedPixel; -begin - ec := GammaExpansion(ABGRAPixel); - result.gray:= (ec.red * redWeightShl10 + ec.green * greenWeightShl10 + - ec.blue * blueWeightShl10 + (1 shl 9)) shr 18; -end; - -function ExpandedPixelToByteMask(const AExpandedPixel: TExpandedPixel): TByteMask; -begin - result.gray:= (AExpandedPixel.red * redWeightShl10 + AExpandedPixel.green * greenWeightShl10 + - AExpandedPixel.blue * blueWeightShl10 + (1 shl 9)) shr 18; -end; - -function MaskToBGRA(const AMask: TByteMask; AAlpha: byte): TBGRAPixel; -begin - result.red := GammaCompressionTab[AMask.gray+(AMask.gray shl 8)]; - result.green := result.red; - result.blue := result.red; - result.alpha := AAlpha; -end; - -function ByteMaskToExpandedPixel(const AMask: TByteMask; AAlpha: byte = 255): TExpandedPixel; -begin - result.red := AMask.gray+(AMask.gray shl 8); - result.green := result.red; - result.blue := result.red; - result.alpha := AAlpha; -end; - -function StdRGBAToBGRAPixel(const AStdRGBA: TStdRGBA): TBGRAPixel; -begin - with AStdRGBA do - begin - result.red := ClampInt(round(red * 255), 0, 255); - result.green := ClampInt(round(green * 255), 0, 255); - result.blue := ClampInt(round(blue * 255), 0, 255); - result.alpha := ClampInt(round(alpha * 255), 0, 255); - end; -end; - -function BGRAPixelToStdRGBA(const ABGRAPixel: TBGRAPixel): TStdRGBA; -const oneOver255 = 1/255; -begin - with ABGRAPixel do - begin - result.red := red * oneOver255; - result.green := green * oneOver255; - result.blue := blue * oneOver255; - result.alpha := alpha * oneOver255; - end; -end; - -function LinearRGBAToExpandedPixel(const ALinearRGBA: TLinearRGBA): TExpandedPixel; -begin - with ALinearRGBA do - begin - result.red := ClampInt(round(red * 65535), 0, 65535); - result.green := ClampInt(round(green * 65535), 0, 65535); - result.blue := ClampInt(round(blue * 65535), 0, 65535); - result.alpha := ClampInt(round(alpha * 65535), 0, 65535); - end; -end; - -function ExpandedPixelToLinearRGBA(const AExpandedPixel: TExpandedPixel): TLinearRGBA; -begin - with AExpandedPixel do - begin - result.red := red / 65535; - result.green := green / 65535; - result.blue := blue / 65535; - result.alpha := alpha / 65535; - end; -end; - -function GammaCompressionWF(AValue: Word): single; -const - oneOver255 = 1/255; -var - compByte: Byte; - reExp, reExp2: Word; -begin - if AValue=0 then exit(0) else - if AValue=65535 then exit(1) else - begin - compByte := GammaCompressionTab[AValue]; - reExp := GammaExpansionTab[compByte]; - if reExp = AValue then - result := compByte * oneOver255 - else - if reExp < AValue then - begin - reExp2 := GammaExpansionTabHalf[compByte]; - if reExp2<>reExp then - result := (compByte + (AValue-reExp)/(reExp2-reExp)*0.5)*oneOver255; - end else - begin - reExp2 := GammaExpansionTabHalf[compByte-1]; - if reExp2<>reExp then - result := (compByte - (reExp-AValue)/(reExp-reExp2)*0.5)*oneOver255; - end; - end; -end; - -function ExpandedPixelToStdRGBA(const AExpandedPixel: TExpandedPixel): TStdRGBA; -begin - result.red := GammaCompressionWF(AExpandedPixel.red); - result.green := GammaCompressionWF(AExpandedPixel.green); - result.blue := GammaCompressionWF(AExpandedPixel.blue); - result.alpha := AExpandedPixel.alpha/65535; -end; - -function GammaExpansionFW(AValue: single): word; -const - fracShift = 10; - intRange = 255 shl fracShift; - fracAnd = (1 shl fracShift)-1; - fracHalf = 1 shl (fracShift-1); - fracQuarter = 1 shl (fracShift-2); -var - valInt, byteVal, fracPart: integer; - half: Word; -begin - if AValue <= 0 then exit(0) - else if AValue >= 1 then exit(65535); - - valInt := round(AValue*intRange); - byteVal := valInt shr fracShift; - fracPart := valInt and fracAnd; - if fracPart >= fracHalf then - begin - result := GammaExpansionTab[byteVal+1]; - half := GammaExpansionTabHalf[byteVal]; - dec(result, ((result-half)*((1 shl fracShift)-fracPart)+fracQuarter) shr (fracShift-1)); - end - else - begin - result := GammaExpansionTab[byteVal]; - if fracPart > 0 then - begin - half := GammaExpansionTabHalf[byteVal]; - inc(result, ((half-result)*fracPart+fracQuarter) shr (fracShift-1)); - end; - end; -end; - -function StdRGBAToExpandedPixel(const AStdRGBA: TStdRGBA): TExpandedPixel; -begin - result.red := GammaExpansionFW(AStdRGBA.red); - result.green := GammaExpansionFW(AStdRGBA.green); - result.blue := GammaExpansionFW(AStdRGBA.blue); - result.alpha:= round(AStdRGBA.alpha*65535); -end; - -function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA): TXYZA; -begin - result := LinearRGBAToXYZA(ALinearRGBA, GetReferenceWhiteIndirect^); -end; - -function LinearRGBAToXYZA(const ALinearRGBA: TLinearRGBA; - const AReferenceWhite: TXYZReferenceWhite): TXYZA; -begin - if AReferenceWhite.Illuminant = 'D50' then - begin - with ALinearRGBA do - begin - result.X := red * 0.4360746 + green * 0.3850649 + blue * 0.1430804; - result.Y := red * 0.2225045 + green * 0.7168786 + blue * 0.0606169; - result.Z := red * 0.0139322 + green * 0.0971045 + blue * 0.7141733; - end; - result.ChromaticAdapt(ReferenceWhite2D50, AReferenceWhite); - end else - begin - with ALinearRGBA do - begin - result.X := red * 0.4124564 + green * 0.3575761 + blue * 0.1804375; - result.Y := red * 0.2126729 + green * 0.7151522 + blue * 0.0721750; - result.Z := red * 0.0193339 + green * 0.1191920 + blue * 0.9503041; - end; - result.ChromaticAdapt(ReferenceWhite2D65, AReferenceWhite); - end; - Result.alpha := ALinearRGBA.alpha; -end; - -function XYZAToLinearRGBA(const AXYZA: TXYZA): TLinearRGBA; -begin - result := XYZAToLinearRGBA(AXYZA, GetReferenceWhiteIndirect^); -end; - -function XYZAToLinearRGBA(const AXYZA: TXYZA; - const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA; -var - minVal, lightVal, maxVal: single; - ad: TXYZA; -begin - ad := AXYZA; - if AReferenceWhite.Illuminant = 'D50' then - begin - ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D50); - with ad do - begin - result.red := X * 3.1338561 + Y * (-1.6168667) + Z * (-0.4906146); - result.green := X * (-0.9787684) + Y * 1.9161415 + Z * 0.0334540; - result.blue := X * 0.0719453 + Y * (-0.2289914) + Z * 1.4052427; - end; - end else - begin - ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D65); - with ad do - begin - result.red := X * 3.2404542 + Y * (-1.5371385) + Z * (-0.4985314); - result.green := X * (-0.9692660) + Y * 1.8760108 + Z * 0.0415560; - result.blue := X * 0.0556434 + Y * (-0.2040259) + Z * 1.0572252; - end; - end; - if ( (XYZToRGBOverflowMin = xroClipToTarget) and ((result.red < 0) or - (result.green < 0) or (result.blue < 0)) ) or - ( (XYZToRGBOverflowMax = xroClipToTarget) and ((result.red > 1) or - (result.green > 1) or (result.blue > 1)) ) then - begin - result.red := 0; - result.green := 0; - result.blue := 0; - result.alpha := 0; - exit; - end; - case XYZToRGBOverflowMin of - xroPreserveHue: begin - minVal := min(min(result.red,result.green),result.blue); - if minVal<0 then - begin - lightVal := result.red*0.299+result.green*0.587+result.blue*0.114; - if lightVal <= 0 then - begin - result.red := 0; - result.green := 0; - result.blue := 0; - end else - begin - result.red := (result.red-minVal)*lightVal/(lightVal-minVal); - result.green := (result.green-minVal)*lightVal/(lightVal-minVal); - result.blue := (result.blue-minVal)*lightVal/(lightVal-minVal); - end; - end; - end; - end; - case XYZToRGBOverflowMax of - xroPreserveHue: - begin - maxVal := max(max(result.red,result.green),result.blue); - if maxVal > 1 then - begin - result.red := result.red/maxVal; - result.green := result.green/maxVal; - result.blue := result.blue/maxVal; - end; - end; - xroSaturateEachChannel: - begin - if result.red > 1 then result.red := 1; - if result.green > 1 then result.green := 1; - if result.blue > 1 then result.blue := 1; - end; - end; - if XYZToRGBOverflowMin = xroSaturateEachChannel then - begin - if result.red < 0 then result.red := 0; - if result.green < 0 then result.green := 0; - if result.blue < 0 then result.blue := 0; - end; - Result.alpha := AXYZA.alpha; -end; - -function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel): TWordXYZA; overload; -begin - result := ExpandedPixelToWordXYZA(AExpandedPixel, GetReferenceWhiteIndirect^); -end; - -function ExpandedPixelToWordXYZA(const AExpandedPixel: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA; overload; -begin - if AReferenceWhite.Illuminant = 'D50' then - begin - with AExpandedPixel do - begin - result.X := ClampInt(round((red * 0.4360746 + green * 0.3850649 + blue * 0.1430804)*(50000/65535)),0,65535); - result.Y := ClampInt(round((red * 0.2225045 + green * 0.7168786 + blue * 0.0606169)*(50000/65535)),0,65535); - result.Z := ClampInt(round((red * 0.0139322 + green * 0.0971045 + blue * 0.7141733)*(50000/65535)),0,65535); - end; - result.ChromaticAdapt(ReferenceWhite2D50, AReferenceWhite); - end else - begin - with AExpandedPixel do - begin - result.X := ClampInt(round((red * 0.4124564 + green * 0.3575761 + blue * 0.1804375)*(50000/65535)),0,65535); - result.Y := ClampInt(round((red * 0.2126729 + green * 0.7151522 + blue * 0.0721750)*(50000/65535)),0,65535); - result.Z := ClampInt(round((red * 0.0193339 + green * 0.1191920 + blue * 0.9503041)*(50000/65535)),0,65535); - end; - result.ChromaticAdapt(ReferenceWhite2D65, AReferenceWhite); - end; - Result.alpha := AExpandedPixel.alpha; -end; - -function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA): TExpandedPixel; overload; -begin - result := WordXYZAToExpandedPixel(AXYZA, GetReferenceWhiteIndirect^); -end; - -function WordXYZAToExpandedPixel(const AXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel; overload; -var - minVal, lightVal, maxVal, - r,g,b, valRangeDiv2: Int32or64; - ad: TWordXYZA; -begin - ad := AXYZA; - if AReferenceWhite.Illuminant = 'D50' then - begin - ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D50); - with ad do - begin - r := round((X * 3.1338561 + Y * (-1.6168667) + Z * (-0.4906146))*(65535/50000)); - g := round((X * (-0.9787684) + Y * 1.9161415 + Z * 0.0334540)*(65535/50000)); - b := round((X * 0.0719453 + Y * (-0.2289914) + Z * 1.4052427)*(65535/50000)); - end; - end else - begin - ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D65); - with ad do - begin - r := round((X * 3.2404542 + Y * (-1.5371385) + Z * (-0.4985314))*(65535/50000)); - g := round((X * (-0.9692660) + Y * 1.8760108 + Z * 0.0415560)*(65535/50000)); - b := round((X * 0.0556434 + Y * (-0.2040259) + Z * 1.0572252)*(65535/50000)); - end; - end; - if ( (XYZToRGBOverflowMin = xroClipToTarget) and ((r < 0) or - (g < 0) or (b < 0)) ) or - ( (XYZToRGBOverflowMax = xroClipToTarget) and ((r > 65535) or - (g > 65535) or (b > 65535)) ) then - begin - result.red := 0; - result.green := 0; - result.blue := 0; - result.alpha := 0; - exit; - end; - case XYZToRGBOverflowMin of - xroPreserveHue: begin - minVal := min(min(r,g),b); - if minVal<0 then - begin - lightVal := r*redWeightShl10 + g*greenWeightShl10 - + b*blueWeightShl10; - if lightVal <= 0 then - begin - result.red := 0; - result.green := 0; - result.blue := 0; - Result.alpha := AXYZA.alpha; - exit; - end else - begin - lightVal := (lightVal+512) shr 10; - valRangeDiv2 := (lightVal-minVal) shr 1; - r := (int64(r-minVal)*lightVal+valRangeDiv2) div (lightVal-minVal); - g := (int64(g-minVal)*lightVal+valRangeDiv2) div (lightVal-minVal); - b := (int64(b-minVal)*lightVal+valRangeDiv2) div (lightVal-minVal); - end; - end; - end; - end; - case XYZToRGBOverflowMax of - xroPreserveHue: - begin - maxVal := max(max(r,g),b); - if maxVal > 65535 then - begin - r := (int64(r)*65535+(maxVal shr 1)) div maxVal; - g := (int64(g)*65535+(maxVal shr 1)) div maxVal; - b := (int64(b)*65535+(maxVal shr 1)) div maxVal; - end; - end; - xroSaturateEachChannel: - begin - if r > 65535 then r := 65535; - if g > 65535 then g := 65535; - if b > 65535 then b := 65535; - end; - end; - if XYZToRGBOverflowMin = xroSaturateEachChannel then - begin - if r < 0 then r := 0; - if g < 0 then g := 0; - if b < 0 then b := 0; - end; - result.red := r; - result.green := g; - result.blue := b; - Result.alpha := AXYZA.alpha; -end; - -function XYZAToWordXYZA(const AXYZA: TXYZA): TWordXYZA; -begin - result.X := ClampInt(round(AXYZA.X*50000),0,65535); - result.Y := ClampInt(round(AXYZA.Y*50000),0,65535); - result.Z := ClampInt(round(AXYZA.Z*50000),0,65535); - result.alpha := round(AXYZA.alpha*65535); -end; - -function WordXYZAToXYZA(const AWordXYZA: TWordXYZA): TXYZA; -const oneOver50000 = 1/50000; -begin - result.X := AWordXYZA.X*oneOver50000; - result.Y := AWordXYZA.Y*oneOver50000; - result.Z := AWordXYZA.Z*oneOver50000; - result.alpha:= AWordXYZA.alpha*(1/65535); -end; - -function XYZAToLabA(const AXYZA: TXYZA): TLabA; -begin - Result := XYZAToLabA(AXYZA, GetReferenceWhiteIndirect^); -end; - -function XYZAToLabA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLabA; -var - xp, yp, zp: double; -begin - xp := AXYZA.X / AReferenceWhite.X; - yp := AXYZA.Y / AReferenceWhite.Y; - zp := AXYZA.Z / AReferenceWhite.Z; - if xp > 0.008856 then - xp := Power(xp, 1 / 3) - else - xp := (7.787 * xp) + 0.138; - if yp > 0.008856 then - yp := Power(yp, 1 / 3) - else - yp := (7.787 * yp) + 0.138; - if zp > 0.008856 then - zp := Power(zp, 1 / 3) - else - zp := (7.787 * zp) + 0.138; - - result.L := Clamp((116 * yp) - 16, 0, 100); - result.a := 500 * (xp - yp); - result.b := 200 * (yp - zp); - Result.Alpha := AXYZA.alpha; -end; - -function LabAToXYZA(const ALabA: TLabA): TXYZA; -begin - Result := LabAToXYZA(ALabA, GetReferenceWhiteIndirect^); -end; - -function LabAToXYZA(const ALabA: TLabA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; -var - xp, yp, zp: double; -begin - yp := (ALabA.L + 16) / 116; - xp := ALabA.a / 500 + yp; - zp := yp - ALabA.b / 200; - if yp > 0.2069 then - yp := IntPower(yp, 3) - else - yp := (yp - 0.138) / 7.787; - if xp > 0.2069 then - xp := IntPower(xp, 3) - else - xp := (xp - 0.138) / 7.787; - if zp > 0.2069 then - zp := IntPower(zp, 3) - else - zp := (zp - 0.138) / 7.787; - Result.X := AReferenceWhite.X * xp; - Result.Y := AReferenceWhite.Y * yp; - Result.Z := AReferenceWhite.Z * zp; - Result.alpha := ALabA.Alpha; -end; - -function StdRGBAToStdHSVA(const AStdRGBA: TStdRGBA): TStdHSVA; -var - Delta, mini: single; -begin - with AStdRGBA do - begin - result.value := max(max(red, green), blue); - mini := min(min(red, green), blue); - Delta := result.value - mini; - - if result.value = 0.0 then - result.saturation := 0 - else - result.saturation := Delta / result.value; - - if result.saturation = 0.0 then - result.hue := 0 - else - begin - if red = result.value then - result.hue := 60.0 * (green - blue) / Delta - else - if green = result.value then - result.hue := 120.0 + 60.0 * (blue - red) / Delta - else - {if blue = result.value then} - result.hue := 240.0 + 60.0 * (red - green) / Delta; - - if result.hue < 0.0 then - IncF(result.hue, 360.0); - end; - result.alpha := alpha; - end; -end; - -function StdHSVAToStdRGBA(const AStdHSVA: TStdHSVA): TStdRGBA; -var - C, X, M, rp, gp, bp, sp, vp: single; - h360: single; -begin - vp := AStdHSVA.value; - sp := AStdHSVA.saturation; - C := Vp * sp; - h360 := PositiveModSingle(AStdHSVA.hue, 360); - X := C * (1 - abs(PositiveModSingle(h360 / 60, 2) - 1)); - m := vp - c; - rp := 0; - gp := 0; - bp := 0; - case floor(h360) of - -1..59: - begin - rp := C; - gp := X; - bp := 0; - end; - 60..119: - begin - rp := X; - gp := C; - bp := 0; - end; - 120..179: - begin - rp := 0; - gp := C; - bp := X; - end; - 180..239: - begin - rp := 0; - gp := X; - bp := C; - end; - 240..299: - begin - rp := X; - gp := 0; - bp := C; - end; - 300..359: - begin - rp := C; - gp := 0; - bp := X; - end; - end; - result.red := rp + m; - result.green := gp + m; - result.blue := bp + m; - result.alpha := AStdHSVA.alpha; -end; - -function StdHSLAToStdHSVA(const AStdHSLA: TStdHSLA): TStdHSVA; -var - s, l, v: single; -begin - Result.hue := AStdHSLA.hue; - s := AStdHSLA.saturation; - l := AStdHSLA.lightness; - v := (2 * l + s * (1 - abs(2 * l - 1))) / 2; - if v <> 0 then - Result.saturation := 2 * (v - l) / v - else - Result.saturation := 0; - Result.value := v; -end; - -function StdHSVAToStdHSLA(const AStdHSVA: TStdHSVA): TStdHSLA; -var - s, v, l: single; -begin - Result.hue := AStdHSVA.hue; - s := AStdHSVA.saturation; - v := AStdHSVA.value; - l := 0.5 * v * (2 - s); - if l <> 0 then - Result.saturation := v * s / (1 - abs(2 * l - 1)) - else - Result.saturation := 0; - Result.lightness := l; -end; - -function StdRGBAToStdCMYK(const AStdRGBA: TStdRGBA): TStdCMYK; -begin - with AStdRGBA do - begin - result.K := 1 - max(max(red, green), blue); - if result.K >= 1 then - begin - result.C := 0; - result.M := 0; - result.Y := 0; - end - else - begin - result.C := 1 - red / (1 - result.K); - result.M := 1 - green / (1 - result.K); - result.Y := 1 - blue / (1 - result.K); - end; - end; -end; - -function StdCMYKToStdRGBA(const AStdCMYK: TStdCMYK; AAlpha: Single = 1): TStdRGBA; -begin - with AStdCMYK do - begin - result.red := (1 - C) * (1 - K); - result.green := (1 - M) * (1 - K); - result.blue := (1 - Y) * (1 - K); - result.alpha := AAlpha; - end; -end; - -function LabAToLChA(const ALabA: TLabA): TLChA; -var - a, b, HRad: single; -begin - a := ALabA.a; - b := ALabA.b; - HRad := ArcTan2(b, a); - if HRad >= 0 then - result.H := (HRad / PI) * 180 - else - result.H := 360 - (ABS(HRad) / PI) * 180; - result.L := ALabA.L; - result.C := SQRT(a*a + b*b); - result.alpha := ALabA.Alpha; -end; - -function LChAToLabA(const ALChA: TLChA): TLabA; -begin - result.L := ALChA.L; - result.a := cos(DegToRad(ALChA.h)) * ALChA.C; - result.b := sin(DegToRad(ALChA.h)) * ALChA.C; - result.Alpha:= ALChA.alpha; -end; - -function AdobeRGBAToXYZA(const ASource: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite): TXYZA; -var R,G,B: single; -begin - R := GammaExpansionTab[ASource.red]/65535; - G := GammaExpansionTab[ASource.green]/65535; - B := GammaExpansionTab[ASource.blue]/65535; - if AReferenceWhite.Illuminant = 'D50' then - begin - result.X := R*0.6097559 + G*0.2052401 + B*0.1492240; - result.Y := R*0.3111242 + G*0.6256560 + B*0.0632197; - result.Z := R*0.0194811 + G*0.0608902 + B*0.7448387; - result.ChromaticAdapt(ReferenceWhite2D50, AReferenceWhite); - end else - begin - result.X := R*0.5767309 + G*0.1855540 + B*0.1881852; - result.Y := R*0.2973769 + G*0.6273491 + B*0.0752741; - result.Z := R*0.0270343 + G*0.0706872 + B*0.9911085; - result.ChromaticAdapt(ReferenceWhite2D65, AReferenceWhite); - end; - result.alpha := ASource.alpha/255; -end; - -function AdobeRGBAToXYZA(const ASource: TAdobeRGBA): TXYZA; -begin - result := AdobeRGBAToXYZA(ASource, GetReferenceWhiteIndirect^); -end; - -function XYZAToAdobeRGBA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA; -var R,G,B: single; - ad: TXYZA; -begin - ad := AXYZA; - if AReferenceWhite.Illuminant = 'D50' then - begin - ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D50); - with ad do - begin - R := Clamp(1.9624274*X - 0.6105343*Y - 0.3413404*Z,0,1); - G := Clamp(-0.9787684*X + 1.9161415*Y + 0.0334540*Z,0,1); - B := Clamp(0.0286869*X - 0.1406752*Y + 1.3487655*Z,0,1); - end; - end else - begin - ad.ChromaticAdapt(AReferenceWhite, ReferenceWhite2D65); - with ad do - begin - R := Clamp(2.0413690*X - 0.5649464*Y - 0.3446944*Z,0,1); - G := Clamp(-0.9692660*X + 1.8760108*Y + 0.0415560*Z,0,1); - B := Clamp(0.0134474*X - 0.1183897*Y + 1.0154096*Z,0,1); - end; - end; - result.red := GammaCompressionTab[round(R*65535)]; - result.green := GammaCompressionTab[round(G*65535)]; - result.blue := GammaCompressionTab[round(B*65535)]; - result.alpha := ClampInt(round(AXYZA.alpha*255),0,255); -end; - -function XYZAToAdobeRGBA(const AXYZA: TXYZA): TAdobeRGBA; -begin - result := XYZAToAdobeRGBA(AXYZA, GetReferenceWhiteIndirect^); -end; - -function StdRGBAToLinearRGBA(const AStdRGBA: TStdRGBA): TLinearRGBA; -var - ec: TExpandedPixel; -begin - ec := StdRGBAToExpandedPixel(AStdRGBA); - result := ExpandedPixelToLinearRGBA(ec); - result.alpha := AStdRGBA.alpha; -end; - -function LinearRGBAToStdRGBA(const ALinearRGBA: TLinearRGBA): TStdRGBA; -var - ec: TExpandedPixel; -begin - ec := LinearRGBAToExpandedPixel(ALinearRGBA); - result := ExpandedPixelToStdRGBA(ec); - result.alpha := ALinearRGBA.alpha; -end; - -function StdRGBAToStdHSLA(const AStdRGBA: TStdRGBA): TStdHSLA; -var - d, cmax, cmin: double; -begin - with AStdRGBA do - begin - cmax := Max(red, Max(green, blue)); - cmin := Min(red, Min(green, blue)); - result.lightness := (cmax + cmin) / 2; - - if cmax = cmin then - begin - result.hue := 0; - result.saturation := 0; - end - else - begin - d := cmax - cmin; - if result.lightness < 0.5 then - result.saturation := d / (cmax + cmin) - else - result.saturation := d / (2 - cmax - cmin); - - if red = cmax then - result.hue := (green - blue) / d - else - if green = cmax then - result.hue := 2 + (blue - red) / d - else - result.hue := 4 + (red - green) / d; - if result.hue < 0 then IncF(result.hue, 6); - result.hue := result.hue * 60; - end; - result.alpha := alpha; - end; -end; - -function StdHSLAToStdRGBA(const AStdHSLA: TStdHSLA): TStdRGBA; -var - C, X, M, rp, gp, bp, sp, lp, h360: single; -begin - lp := AStdHSLA.lightness; - sp := AStdHSLA.saturation; - C := (1 - abs(2 * Lp - 1)) * Sp; - h360 := PositiveModSingle(AStdHSLA.hue, 360); - X := C * (1 - abs(PositiveModSingle(h360 / 60, 2) - 1)); - m := Lp - C / 2; - rp := 0; - gp := 0; - bp := 0; - case floor(h360) of - -1..59: - begin - rp := C; - gp := X; - bp := 0; - end; - 60..119: - begin - rp := X; - gp := C; - bp := 0; - end; - 120..179: - begin - rp := 0; - gp := C; - bp := X; - end; - 180..239: - begin - rp := 0; - gp := X; - bp := C; - end; - 240..299: - begin - rp := X; - gp := 0; - bp := C; - end; - 300..359: - begin - rp := C; - gp := 0; - bp := X; - end; - end; - result.red := rp + m; - result.green := gp + m; - result.blue := bp + m; - result.alpha := AStdHSLA.alpha; -end; - -function SpectrumRangeReflectToXYZA(reflectance,wavelen1,wavelen2,alpha: single): TXYZA; -var isEqualEnergy: boolean; - fromRefWhite: PXYZReferenceWhite; - - function GetIlluminantSpectrum(AIndex: integer): single; - begin - if isEqualEnergy then result := 1 else - result := IlluminantSpectrumD65[AIndex].Y; - end; - - procedure IncludeWavelength(fromWavelen, toWavelen: single); - var i: integer; - factor, ill: single; - begin - for i := 0 to high(SpectralLocus) do - if (SpectralLocus[i].W+2.5 >= fromWavelen) and - (SpectralLocus[i].W-2.5 < toWavelen) then - begin - factor := 1; - if SpectralLocus[i].W-2.5 < fromWavelen then - DecF(factor, (fromWavelen - (SpectralLocus[i].W-2.5))/5); - if SpectralLocus[i].W+2.5 > toWavelen then - DecF(factor, ((SpectralLocus[i].W+2.5) - toWavelen)/5); - if factor > 0 then - begin - ill := GetIlluminantSpectrum(i); - IncF(result.X, SpectralLocus[i].X*factor*ill); - IncF(result.Y, SpectralLocus[i].Y*factor*ill); - IncF(result.Z, SpectralLocus[i].Z*factor*ill); - end; - end; - end; - -var - minWavelen, maxWavelen, ill: single; - totalXYZ: TXYZA; - i: Integer; -begin - result.X := 0; - result.Y := 0; - result.Z := 0; - result.alpha:= alpha; - - with GetReferenceWhiteIndirect^ do - isEqualEnergy := (X = 1) and (Y = 1) and (Z = 1); - if isEqualEnergy then fromRefWhite := @ReferenceWhite2E - else fromRefWhite := @ReferenceWhite2D65; - - totalXYZ := BGRABlack; - for i := 0 to high(SpectralLocus) do - begin - ill := GetIlluminantSpectrum(i); - IncF(totalXYZ.X, SpectralLocus[i].X*ill); - IncF(totalXYZ.Y, SpectralLocus[i].Y*ill); - IncF(totalXYZ.Z, SpectralLocus[i].Z*ill); - end; - - minWavelen := SpectralLocus[0].W; - maxWavelen := SpectralLocus[high(SpectralLocus)].W; - - if wavelen1 <= minWavelen then wavelen1 := minWavelen-2.5; - if wavelen2 >= maxWavelen then wavelen2 := maxWavelen+2.5; - - if wavelen2 > wavelen1 then - IncludeWavelength(wavelen1, wavelen2) - else - begin - IncludeWavelength(wavelen1, maxWavelen+2.5); - IncludeWavelength(minWavelen-2.5, wavelen2); - end; - - result.X := result.X * fromRefWhite^.X/totalXYZ.X * reflectance; - result.Y := result.Y * fromRefWhite^.Y/totalXYZ.Y * reflectance; - result.Z := result.Z * fromRefWhite^.Z/totalXYZ.Z * reflectance; - result.ChromaticAdapt(fromRefWhite^, GetReferenceWhiteIndirect^); -end; - -procedure XYZToLMS(const X,Y,Z: Single; out L,M,S: single); -begin - L := max(0.8951*X+0.2664*Y-0.1615*Z, 0); - M := max(-0.7502*X+1.7135*Y+0.0367*Z, 0); - S := max(0.0389*X-0.0685*Y+1.0296*Z, 0); -end; - -procedure LMSToXYZ(const L,M,S: Single; out X,Y,Z: single); -begin - X := 0.98699*L-0.14705*M+0.16006*S; - Y := 0.43230*L+0.51836*M+0.04933*S; - Z := -0.00853*L+0.04004*M+0.96849*S; -end; - -procedure ChromaticAdaptXYZ(var X,Y,Z: Single; const AFrom, ATo: TXYZReferenceWhite); -var - L, M, S: single; -begin - if (AFrom.L=ATo.L) and (AFrom.M=ATo.M) and (AFrom.S=ATo.S) then exit; - XYZToLMS(X,Y,Z, L,M,S); - L := L * ATo.L/AFrom.L; - M := M * ATo.M/AFrom.M; - S := S * ATo.S/AFrom.S; - LMSToXYZ(L,M,S, X,Y,Z); -end; - -procedure ChromaticAdaptWordXYZ(var X,Y,Z: Word; const AFrom, ATo: TXYZReferenceWhite); -const oneOver50000 = 1/50000; -var Xf,Yf,Zf: Single; -begin - Xf := X*oneOver50000; - Yf := Y*oneOver50000; - Zf := Z*oneOver50000; - ChromaticAdaptXYZ(Xf,Yf,Zf, AFrom,ATo); - X := min(round(Xf*50000),65535); - Y := min(round(Yf*50000),65535); - Z := min(round(Zf*50000),65535); -end; - -{$ENDIF} - -{$IFDEF INCLUDE_INITIALIZATION} -{$UNDEF INCLUDE_INITIALIZATION} - - PrepareReferenceWhiteArray; - ReferenceWhite2D50 := GetReferenceWhite(2, 'D50'); - ReferenceWhite2D65 := GetReferenceWhite(2, 'D65'); - ReferenceWhite2E := GetReferenceWhite(2, 'E'); - SetReferenceWhite(ReferenceWhite2D50); - - {$DEFINE INCLUDE_INITIALIZATION} - {$I generatedcolorspace.inc} - -{$ENDIF} diff --git a/components/bgrabitmap/face3d.inc b/components/bgrabitmap/face3d.inc deleted file mode 100644 index 6bdfc20..0000000 --- a/components/bgrabitmap/face3d.inc +++ /dev/null @@ -1,505 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -type - PBGRAFaceVertexDescription = ^TBGRAFaceVertexDescription; - TBGRAFaceVertexDescription = record - Vertex: IBGRAVertex3D; - Normal: IBGRANormal3D; - Color: TBGRAPixel; - TexCoord: TPointF; - ColorOverride: boolean; - TexCoordOverride: boolean; - ActualColor: TBGRAPixel; - ActualTexCoord: TPointF; - end; - - { TBGRAFace3D } - - TBGRAFace3D = class(TInterfacedObject,IBGRAFace3D) - private - FVertices: packed array of TBGRAFaceVertexDescription; - FVertexCount: integer; - FTexture, FActualTexture: IBGRAScanner; - FMaterial: IBGRAMaterial3D; - FActualMaterial: TBGRAMaterial3D; - FMaterialName: string; - FParentTexture: boolean; - FViewNormal: TPoint3D_128; - FViewCenter: TPoint3D_128; - FObject3D : IBGRAObject3D; - FBiface: boolean; - FLightThroughFactor: single; - FLightThroughFactorOverride: boolean; - FCustomFlags: LongWord; - function GetCustomFlags: LongWord; - function GetVertexDescription(AIndex : integer): PBGRAFaceVertexDescription; - procedure SetCustomFlags(AValue: LongWord); - procedure ComputeActualVertexColor(AIndex: integer); - procedure ComputeActualTexCoord(AMinIndex, AMaxIndex: integer); - procedure UpdateTexture; - public - function GetObject3D: IBGRAObject3D; - constructor Create(AObject3D: IBGRAObject3D; AVertices: array of IBGRAVertex3D); - destructor Destroy; override; - procedure ComputeVertexColors; - procedure UpdateMaterial; - procedure FlipFace; - function AddVertex(AVertex: IBGRAVertex3D): integer; - function GetParentTexture: boolean; - function GetTexture: IBGRAScanner; - function GetVertex(AIndex: Integer): IBGRAVertex3D; - function GetVertexColor(AIndex: Integer): TBGRAPixel; - function GetVertexColorOverride(AIndex: Integer): boolean; - function GetVertexCount: integer; - function GetNormal(AIndex: Integer): IBGRANormal3D; - function GetMaterial: IBGRAMaterial3D; - function GetMaterialName: string; - function GetTexCoord(AIndex: Integer): TPointF; - function GetTexCoordOverride(AIndex: Integer): boolean; - function GetViewNormal: TPoint3D; - function GetViewNormal_128: TPoint3D_128; - function GetViewCenter: TPoint3D; - function GetViewCenter_128: TPoint3D_128; - function GetViewCenterZ: single; - function GetBiface: boolean; - function GetLightThroughFactor: single; - function GetLightThroughFactorOverride: boolean; - procedure SetParentTexture(const AValue: boolean); - procedure SetTexture(const AValue: IBGRAScanner); - procedure SetColor(AColor: TBGRAPixel); - procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel); - procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean); - procedure SetTexCoord(AIndex: Integer; const AValue: TPointF); - procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean); - procedure SetBiface(const AValue: boolean); - procedure SetLightThroughFactor(const AValue: single); - procedure SetLightThroughFactorOverride(const AValue: boolean); - procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); - procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); - procedure ComputeViewNormalAndCenter; - procedure SetMaterial(const AValue: IBGRAMaterial3D); - procedure SetMaterialName(const AValue: string); - function GetAsObject: TObject; - property Texture: IBGRAScanner read GetTexture write SetTexture; - property ParentTexture: boolean read GetParentTexture write SetParentTexture; - property VertexCount: integer read GetVertexCount; - property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex; - property Normal[AIndex: Integer]: IBGRANormal3D read GetNormal write SetNormal; - property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor; - property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride; - property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord; - property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride; - property ViewNormal: TPoint3D read GetViewNormal; - property ViewNormal_128: TPoint3D_128 read GetViewNormal_128; - property ViewCenter: TPoint3D read GetViewCenter; - property ViewCenter_128: TPoint3D_128 read GetViewCenter_128; - property ViewCenterZ: single read GetViewCenterZ; - property Object3D: IBGRAObject3D read GetObject3D; - property Biface: boolean read GetBiface write SetBiface; - property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor; - property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride; - property Material: IBGRAMaterial3D read GetMaterial write SetMaterial; - property ActualMaterial: TBGRAMaterial3D read FActualMaterial; - property ActualTexture: IBGRAScanner read FActualTexture; - property VertexDescription[AIndex : integer]: PBGRAFaceVertexDescription read GetVertexDescription; - property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags; - end; - -{ TBGRAFace3D } - -function TBGRAFace3D.GetVertexDescription(AIndex : integer - ): PBGRAFaceVertexDescription; -begin - result := @FVertices[AIndex]; -end; - -function TBGRAFace3D.GetCustomFlags: LongWord; -begin - result := FCustomFlags; -end; - -function TBGRAFace3D.GetNormal(AIndex: Integer): IBGRANormal3D; -begin - result := FVertices[AIndex].Normal; -end; - -procedure TBGRAFace3D.SetCustomFlags(AValue: LongWord); -begin - FCustomFlags:= AValue; -end; - -procedure TBGRAFace3D.ComputeActualVertexColor(AIndex: integer); -begin - with FVertices[AIndex] do - begin - if ColorOverride then - ActualColor := Color - else - if Vertex.ParentColor then - ActualColor := FObject3D.Color - else - ActualColor := Vertex.Color; - end; -end; - -procedure TBGRAFace3D.ComputeActualTexCoord(AMinIndex, AMaxIndex: integer); -var - i: Integer; - zoom: TPointF; - m: IBGRAMaterial3D; -begin - m := ActualMaterial; - if m <> nil then zoom := m.TextureZoom - else zoom := PointF(1,1); - for i := AMinIndex to AMaxIndex do - with FVertices[i] do - begin - if TexCoordOverride then - ActualTexCoord := TexCoord - else - ActualTexCoord := Vertex.TexCoord; - ActualTexCoord.x := ActualTexCoord.x * zoom.x; - ActualTexCoord.y := ActualTexCoord.y * zoom.y; - end; -end; - -procedure TBGRAFace3D.UpdateTexture; -begin - if FParentTexture then - begin - FActualTexture := nil; - if FActualMaterial <> nil then - FActualTexture := FActualMaterial.GetTexture; - if FActualTexture = nil then - FActualTexture := FObject3D.Texture - end - else - FActualTexture := FTexture; -end; - -procedure TBGRAFace3D.SetNormal(AIndex: Integer; AValue: IBGRANormal3D); -begin - FVertices[AIndex].Normal := AValue; -end; - -function TBGRAFace3D.GetObject3D: IBGRAObject3D; -begin - result := FObject3D; -end; - -constructor TBGRAFace3D.Create(AObject3D: IBGRAObject3D; - AVertices: array of IBGRAVertex3D); -var - i: Integer; -begin - FObject3D := AObject3D; - FBiface := false; - FParentTexture := True; - FLightThroughFactor:= 0; - FLightThroughFactorOverride:= false; - - UpdateMaterial; - - SetLength(FVertices, length(AVertices)); - for i:= 0 to high(AVertices) do - AddVertex(AVertices[i]); -end; - -destructor TBGRAFace3D.Destroy; -begin - FMaterial := nil; - fillchar(FTexture,sizeof(FTexture),0); - fillchar(FActualTexture,sizeof(FActualTexture),0); - inherited Destroy; -end; - -procedure TBGRAFace3D.ComputeVertexColors; -var - i: Integer; -begin - for i := 0 to FVertexCount-1 do - ComputeActualVertexColor(i); -end; - -procedure TBGRAFace3D.UpdateMaterial; -begin - if Material <> nil then - FActualMaterial := TBGRAMaterial3D(Material.GetAsObject) - else if FObject3D.Material <> nil then - FActualMaterial := TBGRAMaterial3D(FObject3D.Material.GetAsObject) - else if TBGRAScene3D(FObject3D.Scene).DefaultMaterial <> nil then - FActualMaterial := TBGRAMaterial3D(TBGRAScene3D(FObject3D.Scene).DefaultMaterial.GetAsObject); - - UpdateTexture; - - ComputeActualTexCoord(0,FVertexCount-1); -end; - -procedure TBGRAFace3D.FlipFace; -var i: integer; - temp: TBGRAFaceVertexDescription; -begin - for i := 0 to (VertexCount div 2)-1 do - begin - temp := FVertices[i]; - FVertices[i] := FVertices[VertexCount-1-i]; - FVertices[VertexCount-1-i] := temp; - end; -end; - -function TBGRAFace3D.AddVertex(AVertex: IBGRAVertex3D): integer; -begin - if FVertexCount = length(FVertices) then - setlength(FVertices, FVertexCount*2+3); - result := FVertexCount; - with FVertices[result] do - begin - Color := BGRAWhite; - ColorOverride := false; - TexCoord := PointF(0,0); - TexCoordOverride := false; - Vertex := AVertex; - Normal := nil; - end; - ComputeActualVertexColor(result); - ComputeActualTexCoord(result,result); - inc(FVertexCount); -end; - -function TBGRAFace3D.GetParentTexture: boolean; -begin - result := FParentTexture; -end; - -function TBGRAFace3D.GetTexture: IBGRAScanner; -begin - result := FTexture; -end; - -function TBGRAFace3D.GetVertex(AIndex: Integer): IBGRAVertex3D; -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - result := FVertices[AIndex].Vertex; -end; - -procedure TBGRAFace3D.SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - FVertices[AIndex].Vertex := AValue; - ComputeActualVertexColor(AIndex); -end; - -function TBGRAFace3D.GetVertexColor(AIndex: Integer): TBGRAPixel; -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - result := FVertices[AIndex].ActualColor; -end; - -function TBGRAFace3D.GetVertexColorOverride(AIndex: Integer): boolean; -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - result := FVertices[AIndex].ColorOverride; -end; - -function TBGRAFace3D.GetVertexCount: integer; -begin - result := FVertexCount; -end; - -function TBGRAFace3D.GetMaterial: IBGRAMaterial3D; -begin - result := FMaterial; -end; - -function TBGRAFace3D.GetMaterialName: string; -begin - result := FMaterialName; -end; - -procedure TBGRAFace3D.SetParentTexture(const AValue: boolean); -begin - FParentTexture := AValue; - UpdateTexture; -end; - -procedure TBGRAFace3D.SetTexture(const AValue: IBGRAScanner); -begin - FTexture := AValue; - FParentTexture := false; - UpdateTexture; -end; - -procedure TBGRAFace3D.SetColor(AColor: TBGRAPixel); -var i: integer; -begin - for i := 0 to GetVertexCount-1 do - SetVertexColor(i,AColor); -end; - -procedure TBGRAFace3D.SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel - ); -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - with FVertices[AIndex] do - begin - Color := AValue; - ColorOverride := true; - end; - ComputeActualVertexColor(AIndex); -end; - -procedure TBGRAFace3D.SetVertexColorOverride(AIndex: Integer; - const AValue: boolean); -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - FVertices[AIndex].ColorOverride := AValue; - ComputeActualVertexColor(AIndex); -end; - -function TBGRAFace3D.GetTexCoord(AIndex: Integer): TPointF; -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - result := FVertices[AIndex].TexCoord; -end; - -function TBGRAFace3D.GetTexCoordOverride(AIndex: Integer): boolean; -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - result := FVertices[AIndex].TexCoordOverride; -end; - -procedure TBGRAFace3D.SetTexCoord(AIndex: Integer; const AValue: TPointF); -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - FVertices[AIndex].TexCoord := AValue; - FVertices[AIndex].TexCoordOverride := true; - ComputeActualTexCoord(AIndex, AIndex); -end; - -procedure TBGRAFace3D.SetTexCoordOverride(AIndex: Integer; const AValue: boolean - ); -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise Exception.Create('Index out of bounds'); - FVertices[AIndex].TexCoordOverride := AValue; -end; - -function TBGRAFace3D.GetViewNormal: TPoint3D; -begin - result := Point3D(FViewNormal); -end; - -function TBGRAFace3D.GetViewNormal_128: TPoint3D_128; -begin - result := FViewNormal; -end; - -function TBGRAFace3D.GetViewCenter: TPoint3D; -begin - result := Point3D(FViewCenter); -end; - -function TBGRAFace3D.GetViewCenter_128: TPoint3D_128; -begin - result := FViewCenter; -end; - -function TBGRAFace3D.GetViewCenterZ: single; -begin - result := FViewCenter.Z; -end; - -function TBGRAFace3D.GetBiface: boolean; -begin - result := FBiface; -end; - -procedure TBGRAFace3D.SetBiface(const AValue: boolean); -begin - FBiface := AValue; -end; - -function TBGRAFace3D.GetLightThroughFactor: single; -begin - result := FLightThroughFactor; -end; - -function TBGRAFace3D.GetLightThroughFactorOverride: boolean; -begin - result := FLightThroughFactorOverride; -end; - -procedure TBGRAFace3D.SetLightThroughFactor(const AValue: single); -begin - if AValue < 0 then - FLightThroughFactor := 0 - else - FLightThroughFactor:= AValue; - FLightThroughFactorOverride := true; -end; - -procedure TBGRAFace3D.SetLightThroughFactorOverride(const AValue: boolean); -begin - FLightThroughFactorOverride := AValue; -end; - -procedure TBGRAFace3D.ComputeViewNormalAndCenter; -var v1,v2: TPoint3D_128; - i: Integer; - p0,p1,p2: IBGRAVertex3D; -begin - if FVertexCount < 3 then - ClearPoint3D_128(FViewNormal) - else - begin - p0 := FVertices[0].Vertex; - p1 := FVertices[1].Vertex; - p2 := FVertices[2].Vertex; - v1 := p1.ViewCoord_128 - p0.ViewCoord_128; - v2 := p2.ViewCoord_128 - p1.ViewCoord_128; - VectProduct3D_128(v2,v1,FViewNormal); - Normalize3D_128(FViewNormal); - for i := 0 to FVertexCount-1 do - FVertices[i].Vertex.AddViewNormal(FViewNormal); - end; - ClearPoint3D_128(FViewCenter); - if FVertexCount > 0 then - begin - for i := 0 to FVertexCount-1 do - FViewCenter.Offset(FVertices[i].Vertex.ViewCoord_128); - FViewCenter.Scale(1/FVertexCount); - end; -end; - -procedure TBGRAFace3D.SetMaterial(const AValue: IBGRAMaterial3D); -begin - if AValue <> FMaterial then - begin - FMaterial := AValue; - UpdateMaterial; - end; -end; - -procedure TBGRAFace3D.SetMaterialName(const AValue: string); -begin - if AValue <> FMaterialName then - begin - FMaterialName := AValue; - TBGRAScene3D(FObject3D.Scene).UseMaterial(FMaterialName, self); - end; -end; - -function TBGRAFace3D.GetAsObject: TObject; -begin - result := self; -end; - - diff --git a/components/bgrabitmap/generatedcolorspace.inc b/components/bgrabitmap/generatedcolorspace.inc deleted file mode 100644 index feab5f4..0000000 --- a/components/bgrabitmap/generatedcolorspace.inc +++ /dev/null @@ -1,7103 +0,0 @@ -{ This file is generated by dev/colorspace/UnitMaker program } - -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -type - - { TStdRGBA } - - PStdRGBA = ^TStdRGBA; - TStdRGBA = packed record - red,green,blue,alpha: single; - class function New(const ARed,AGreen,ABlue,AAlpha:single): TStdRGBA;overload;static; - class function New(const ARed,AGreen,ABlue:single): TStdRGBA;overload;static; - end; - - { TAdobeRGBA } - - PAdobeRGBA = ^TAdobeRGBA; - TAdobeRGBA = packed record - red,green,blue,alpha: byte; - class function New(const ARed,AGreen,ABlue,AAlpha:byte): TAdobeRGBA;overload;static; - class function New(const ARed,AGreen,ABlue:byte): TAdobeRGBA;overload;static; - end; - - { TStdHSLA } - - PStdHSLA = ^TStdHSLA; - TStdHSLA = packed record - hue,saturation,lightness,alpha: single; - class function New(const AHue,ASaturation,ALightness,AAlpha:single): TStdHSLA;overload;static; - class function New(const AHue,ASaturation,ALightness:single): TStdHSLA;overload;static; - end; - - { TStdHSVA } - - PStdHSVA = ^TStdHSVA; - TStdHSVA = packed record - hue,saturation,value,alpha: single; - class function New(const AHue,ASaturation,AValue,AAlpha:single): TStdHSVA;overload;static; - class function New(const AHue,ASaturation,AValue:single): TStdHSVA;overload;static; - end; - - { TStdCMYK } - - PStdCMYK = ^TStdCMYK; - TStdCMYK = packed record - C,M,Y,K: single; - class function New(const ACyan,AMagenta,AYellow,ABlack:single): TStdCMYK;static; - end; - - { TByteMask } - - PByteMask = ^TByteMask; - TByteMask = packed record - gray: byte; - class function New(const AGray:byte): TByteMask;static; - end; - - { TLinearRGBA } - - PLinearRGBA = ^TLinearRGBA; - TLinearRGBA = packed record - red,green,blue,alpha: single; - class function New(const ARed,AGreen,ABlue,AAlpha:single): TLinearRGBA;overload;static; - class function New(const ARed,AGreen,ABlue:single): TLinearRGBA;overload;static; - end; - - { TXYZA } - - PXYZA = ^TXYZA; - TXYZA = packed record - X,Y,Z,alpha: single; - class function New(const AX,AY,AZ,AAlpha:single): TXYZA;overload;static; - class function New(const AX,AY,AZ:single): TXYZA;overload;static; - end; - - { TWordXYZA } - - PWordXYZA = ^TWordXYZA; - TWordXYZA = packed record - X,Y,Z,alpha: word; - class function New(const AX,AY,AZ,AAlpha:word): TWordXYZA;overload;static; - class function New(const AX,AY,AZ:word): TWordXYZA;overload;static; - end; - - { TLabA } - - PLabA = ^TLabA; - TLabA = packed record - L,a,b,alpha: single; - class function New(const ALightness,Aa,Ab,AAlpha:single): TLabA;overload;static; - class function New(const ALightness,Aa,Ab:single): TLabA;overload;static; - end; - - { TLChA } - - PLChA = ^TLChA; - TLChA = packed record - L,C,h,alpha: single; - class function New(const ALightness,AChroma,AHue,AAlpha:single): TLChA;overload;static; - class function New(const ALightness,AChroma,AHue:single): TLChA;overload;static; - end; - - { TColorColorspace } - - TColorColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency({%H-}AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TBGRAPixelColorspace } - - TBGRAPixelColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TFPColorColorspace } - - TFPColorColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TStdRGBAColorspace } - - TStdRGBAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TAdobeRGBAColorspace } - - TAdobeRGBAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TStdHSLAColorspace } - - TStdHSLAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TStdHSVAColorspace } - - TStdHSVAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TStdCMYKColorspace } - - TStdCMYKColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency({%H-}AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TByteMaskColorspace } - - TByteMaskColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency({%H-}AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TExpandedPixelColorspace } - - TExpandedPixelColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TLinearRGBAColorspace } - - TLinearRGBAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { THSLAPixelColorspace } - - THSLAPixelColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TGSBAPixelColorspace } - - TGSBAPixelColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TXYZAColorspace } - - TXYZAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TWordXYZAColorspace } - - TWordXYZAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TLabAColorspace } - - TLabAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TLChAColorspace } - - TLChAColorspace = class(TCustomColorspace) - class function GetChannelName(AIndex: integer): string; override; - class function GetChannelCount: integer; override; - class function IndexOfAlphaChannel: integer; override; - class function GetColorTransparency(AColor: Pointer): TColorTransparency; override; - class function GetMaxValue(AIndex: integer): single; override; - class function GetMinValue(AIndex: integer): single; override; - class function GetChannelBitDepth({%H-}AIndex: integer): byte; override; - class function GetName: string; override; - class function GetSize: integer; override; - class function GetChannel(AColor: Pointer; AIndex: integer): single; override; - class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override; - class function GetFlags: TColorspaceFlags; override; - end; - - { TColorHelper } - - TColorHelper = type helper for TColor - class function New(const ARed,AGreen,ABlue:byte): TColor;static; - class function Colorspace: TColorspaceAny; static; - private - function GetRed: byte; - function GetGreen: byte; - function GetBlue: byte; - procedure SetRed(AValue: byte); - procedure SetGreen(AValue: byte); - procedure SetBlue(AValue: byte); - public - function ToBGRAPixel: TBGRAPixel;overload; - function ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; - function ToFPColor: TFPColor;overload; - function ToFPColor(AAlpha: word): TFPColor;overload; - function ToStdRGBA: TStdRGBA;overload; - function ToStdRGBA(AAlpha: single): TStdRGBA;overload; - function ToAdobeRGBA: TAdobeRGBA;overload; - function ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; - function ToStdHSLA: TStdHSLA;overload; - function ToStdHSLA(AAlpha: single): TStdHSLA;overload; - function ToStdHSVA: TStdHSVA;overload; - function ToStdHSVA(AAlpha: single): TStdHSVA;overload; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel;overload; - function ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; - function ToLinearRGBA: TLinearRGBA;overload; - function ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; - function ToHSLAPixel: THSLAPixel;overload; - function ToHSLAPixel(AAlpha: word): THSLAPixel;overload; - function ToGSBAPixel: TGSBAPixel;overload; - function ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; - function ToXYZA: TXYZA;overload; - function ToXYZA(AAlpha: single): TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(AAlpha: word): TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA;overload; - function ToLabA(AAlpha: single): TLabA;overload; - function ToLChA: TLChA;overload; - function ToLChA(AAlpha: single): TLChA;overload; - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - property red: byte read GetRed write SetRed; - property green: byte read GetGreen write SetGreen; - property blue: byte read GetBlue write SetBlue; - end; - - { TBGRAPixelHelper } - - TBGRAPixelHelper = record helper(TBGRAPixelBasicHelper) for TBGRAPixel - class function New(const ARed,AGreen,ABlue,AAlpha:byte): TBGRAPixel;overload;static; - class function New(const ARed,AGreen,ABlue:byte): TBGRAPixel;overload;static; - class function Colorspace: TColorspaceAny; static; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToLinearRGBA: TLinearRGBA; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TFPColorHelper } - - TFPColorHelper = record helper(TFPColorBasicHelper) for TFPColor - class function New(const ARed,AGreen,ABlue,AAlpha:word): TFPColor;overload;static; - class function New(const ARed,AGreen,ABlue:word): TFPColor;overload;static; - class function Colorspace: TColorspaceAny; static; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToLinearRGBA: TLinearRGBA; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TStdRGBAHelper } - - TStdRGBAHelper = record helper for TStdRGBA - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel; - function ToFPColor: TFPColor; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel; - function ToLinearRGBA: TLinearRGBA; - function ToHSLAPixel: THSLAPixel; - function ToGSBAPixel: TGSBAPixel; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TAdobeRGBAHelper } - - TAdobeRGBAHelper = record helper for TAdobeRGBA - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel; - function ToFPColor: TFPColor; - function ToStdRGBA: TStdRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel; - function ToLinearRGBA: TLinearRGBA; - function ToHSLAPixel: THSLAPixel; - function ToGSBAPixel: TGSBAPixel; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TStdHSLAHelper } - - TStdHSLAHelper = record helper for TStdHSLA - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel; - function ToFPColor: TFPColor; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel; - function ToLinearRGBA: TLinearRGBA; - function ToHSLAPixel: THSLAPixel; - function ToGSBAPixel: TGSBAPixel; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TStdHSVAHelper } - - TStdHSVAHelper = record helper for TStdHSVA - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel; - function ToFPColor: TFPColor; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel; - function ToLinearRGBA: TLinearRGBA; - function ToHSLAPixel: THSLAPixel; - function ToGSBAPixel: TGSBAPixel; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TStdCMYKHelper } - - TStdCMYKHelper = record helper for TStdCMYK - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel;overload; - function ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; - function ToFPColor: TFPColor;overload; - function ToFPColor(AAlpha: word): TFPColor;overload; - function ToStdRGBA: TStdRGBA;overload; - function ToStdRGBA(AAlpha: single): TStdRGBA;overload; - function ToAdobeRGBA: TAdobeRGBA;overload; - function ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; - function ToStdHSLA: TStdHSLA;overload; - function ToStdHSLA(AAlpha: single): TStdHSLA;overload; - function ToStdHSVA: TStdHSVA;overload; - function ToStdHSVA(AAlpha: single): TStdHSVA;overload; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel;overload; - function ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; - function ToLinearRGBA: TLinearRGBA;overload; - function ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; - function ToHSLAPixel: THSLAPixel;overload; - function ToHSLAPixel(AAlpha: word): THSLAPixel;overload; - function ToGSBAPixel: TGSBAPixel;overload; - function ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; - function ToXYZA: TXYZA;overload; - function ToXYZA(AAlpha: single): TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(AAlpha: word): TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA;overload; - function ToLabA(AAlpha: single): TLabA;overload; - function ToLChA: TLChA;overload; - function ToLChA(AAlpha: single): TLChA;overload; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TByteMaskHelper } - - TByteMaskHelper = record helper for TByteMask - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel;overload; - function ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; - function ToFPColor: TFPColor;overload; - function ToFPColor(AAlpha: word): TFPColor;overload; - function ToStdRGBA: TStdRGBA;overload; - function ToStdRGBA(AAlpha: single): TStdRGBA;overload; - function ToAdobeRGBA: TAdobeRGBA;overload; - function ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; - function ToStdHSLA: TStdHSLA;overload; - function ToStdHSLA(AAlpha: single): TStdHSLA;overload; - function ToStdHSVA: TStdHSVA;overload; - function ToStdHSVA(AAlpha: single): TStdHSVA;overload; - function ToStdCMYK: TStdCMYK; - function ToExpandedPixel: TExpandedPixel;overload; - function ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; - function ToLinearRGBA: TLinearRGBA;overload; - function ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; - function ToHSLAPixel: THSLAPixel;overload; - function ToHSLAPixel(AAlpha: word): THSLAPixel;overload; - function ToGSBAPixel: TGSBAPixel;overload; - function ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; - function ToXYZA: TXYZA;overload; - function ToXYZA(AAlpha: single): TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(AAlpha: word): TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA;overload; - function ToLabA(AAlpha: single): TLabA;overload; - function ToLChA: TLChA;overload; - function ToLChA(AAlpha: single): TLChA;overload; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TExpandedPixelHelper } - - TExpandedPixelHelper = record helper(TExpandedPixelBasicHelper) for TExpandedPixel - class function New(const ARed,AGreen,ABlue,AAlpha:word): TExpandedPixel;overload;static; - class function New(const ARed,AGreen,ABlue:word): TExpandedPixel;overload;static; - class function Colorspace: TColorspaceAny; static; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToLinearRGBA: TLinearRGBA; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TLinearRGBAHelper } - - TLinearRGBAHelper = record helper for TLinearRGBA - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel; - function ToFPColor: TFPColor; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel; - function ToHSLAPixel: THSLAPixel; - function ToGSBAPixel: TGSBAPixel; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { THSLAPixelHelper } - - THSLAPixelHelper = record helper(THSLAPixelBasicHelper) for THSLAPixel - class function New(const AHue,ASaturation,ALightness,AAlpha:word): THSLAPixel;overload;static; - class function New(const AHue,ASaturation,ALightness:word): THSLAPixel;overload;static; - class function Colorspace: TColorspaceAny; static; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToLinearRGBA: TLinearRGBA; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TGSBAPixelHelper } - - TGSBAPixelHelper = record helper(TGSBAPixelBasicHelper) for TGSBAPixel - class function New(const AHue,ASaturation,ABrightness,AAlpha:word): TGSBAPixel;overload;static; - class function New(const AHue,ASaturation,ABrightness:word): TGSBAPixel;overload;static; - class function Colorspace: TColorspaceAny; static; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToLinearRGBA: TLinearRGBA; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - function ToLChA: TLChA; - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - procedure FromLChA(AValue: TLChA); - end; - - { TXYZAHelper } - - TXYZAHelper = record helper for TXYZA - class function Colorspace: TColorspaceAny; static; - procedure ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); - function ToColor: TColor;overload; - function ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; - function ToBGRAPixel: TBGRAPixel;overload; - function ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; - function ToFPColor: TFPColor;overload; - function ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; - function ToStdRGBA: TStdRGBA;overload; - function ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; - function ToAdobeRGBA: TAdobeRGBA;overload; - function ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; - function ToStdHSLA: TStdHSLA;overload; - function ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; - function ToStdHSVA: TStdHSVA;overload; - function ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; - function ToStdCMYK: TStdCMYK;overload; - function ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; - function ToByteMask: TByteMask;overload; - function ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; - function ToExpandedPixel: TExpandedPixel;overload; - function ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; - function ToLinearRGBA: TLinearRGBA;overload; - function ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; - function ToHSLAPixel: THSLAPixel;overload; - function ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; - function ToGSBAPixel: TGSBAPixel;overload; - function ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; - function ToWordXYZA: TWordXYZA; - function ToLabA: TLabA;overload; - function ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; - function ToLChA: TLChA;overload; - function ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; - procedure FromColor(AValue: TColor); overload; - procedure FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromBGRAPixel(AValue: TBGRAPixel); overload; - procedure FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromFPColor(AValue: TFPColor); overload; - procedure FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdRGBA(AValue: TStdRGBA); overload; - procedure FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromAdobeRGBA(AValue: TAdobeRGBA); overload; - procedure FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdHSLA(AValue: TStdHSLA); overload; - procedure FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdHSVA(AValue: TStdHSVA); overload; - procedure FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdCMYK(AValue: TStdCMYK); overload; - procedure FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromByteMask(AValue: TByteMask); overload; - procedure FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromExpandedPixel(AValue: TExpandedPixel); overload; - procedure FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLinearRGBA(AValue: TLinearRGBA); overload; - procedure FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromHSLAPixel(AValue: THSLAPixel); overload; - procedure FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromGSBAPixel(AValue: TGSBAPixel); overload; - procedure FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); - procedure FromLabA(AValue: TLabA); overload; - procedure FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLChA(AValue: TLChA); overload; - procedure FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; - end; - - { TWordXYZAHelper } - - TWordXYZAHelper = record helper for TWordXYZA - class function Colorspace: TColorspaceAny; static; - procedure ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); - function ToColor: TColor;overload; - function ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; - function ToBGRAPixel: TBGRAPixel;overload; - function ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; - function ToFPColor: TFPColor;overload; - function ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; - function ToStdRGBA: TStdRGBA;overload; - function ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; - function ToAdobeRGBA: TAdobeRGBA;overload; - function ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; - function ToStdHSLA: TStdHSLA;overload; - function ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; - function ToStdHSVA: TStdHSVA;overload; - function ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; - function ToStdCMYK: TStdCMYK;overload; - function ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; - function ToByteMask: TByteMask;overload; - function ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; - function ToExpandedPixel: TExpandedPixel;overload; - function ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; - function ToLinearRGBA: TLinearRGBA;overload; - function ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; - function ToHSLAPixel: THSLAPixel;overload; - function ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; - function ToGSBAPixel: TGSBAPixel;overload; - function ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; - function ToXYZA: TXYZA; - function ToLabA: TLabA;overload; - function ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; - function ToLChA: TLChA;overload; - function ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; - procedure FromColor(AValue: TColor); overload; - procedure FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromBGRAPixel(AValue: TBGRAPixel); overload; - procedure FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromFPColor(AValue: TFPColor); overload; - procedure FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdRGBA(AValue: TStdRGBA); overload; - procedure FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromAdobeRGBA(AValue: TAdobeRGBA); overload; - procedure FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdHSLA(AValue: TStdHSLA); overload; - procedure FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdHSVA(AValue: TStdHSVA); overload; - procedure FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromStdCMYK(AValue: TStdCMYK); overload; - procedure FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromByteMask(AValue: TByteMask); overload; - procedure FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromExpandedPixel(AValue: TExpandedPixel); overload; - procedure FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLinearRGBA(AValue: TLinearRGBA); overload; - procedure FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromHSLAPixel(AValue: THSLAPixel); overload; - procedure FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromGSBAPixel(AValue: TGSBAPixel); overload; - procedure FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromXYZA(AValue: TXYZA); - procedure FromLabA(AValue: TLabA); overload; - procedure FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLChA(AValue: TLChA); overload; - procedure FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; - end; - - { TLabAHelper } - - TLabAHelper = record helper for TLabA - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel; - function ToFPColor: TFPColor; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel; - function ToLinearRGBA: TLinearRGBA; - function ToHSLAPixel: THSLAPixel; - function ToGSBAPixel: TGSBAPixel; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLChA: TLChA; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLChA(AValue: TLChA); - end; - - { TLChAHelper } - - TLChAHelper = record helper for TLChA - class function Colorspace: TColorspaceAny; static; - function ToColor: TColor; - function ToBGRAPixel: TBGRAPixel; - function ToFPColor: TFPColor; - function ToStdRGBA: TStdRGBA; - function ToAdobeRGBA: TAdobeRGBA; - function ToStdHSLA: TStdHSLA; - function ToStdHSVA: TStdHSVA; - function ToStdCMYK: TStdCMYK; - function ToByteMask: TByteMask; - function ToExpandedPixel: TExpandedPixel; - function ToLinearRGBA: TLinearRGBA; - function ToHSLAPixel: THSLAPixel; - function ToGSBAPixel: TGSBAPixel; - function ToXYZA: TXYZA;overload; - function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; - function ToWordXYZA: TWordXYZA;overload; - function ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; - function ToLabA: TLabA; - procedure FromColor(AValue: TColor); - procedure FromBGRAPixel(AValue: TBGRAPixel); - procedure FromFPColor(AValue: TFPColor); - procedure FromStdRGBA(AValue: TStdRGBA); - procedure FromAdobeRGBA(AValue: TAdobeRGBA); - procedure FromStdHSLA(AValue: TStdHSLA); - procedure FromStdHSVA(AValue: TStdHSVA); - procedure FromStdCMYK(AValue: TStdCMYK); - procedure FromByteMask(AValue: TByteMask); - procedure FromExpandedPixel(AValue: TExpandedPixel); - procedure FromLinearRGBA(AValue: TLinearRGBA); - procedure FromHSLAPixel(AValue: THSLAPixel); - procedure FromGSBAPixel(AValue: TGSBAPixel); - procedure FromXYZA(AValue: TXYZA); overload; - procedure FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromWordXYZA(AValue: TWordXYZA); overload; - procedure FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; - procedure FromLabA(AValue: TLabA); - end; - -operator := (const AValue: TColor): TStdRGBA; -operator := (const AValue: TColor): TAdobeRGBA; -operator := (const AValue: TColor): TStdHSLA; -operator := (const AValue: TColor): TStdHSVA; -operator := (const AValue: TColor): TStdCMYK; -operator := (const AValue: TColor): TByteMask; -operator := (const AValue: TColor): TLinearRGBA; -operator := (const AValue: TColor): TXYZA; -operator := (const AValue: TColor): TWordXYZA; -operator := (const AValue: TColor): TLabA; -operator := (const AValue: TColor): TLChA; -operator := (const AValue: TBGRAPixel): TStdRGBA; -operator := (const AValue: TBGRAPixel): TAdobeRGBA; -operator := (const AValue: TBGRAPixel): TStdHSLA; -operator := (const AValue: TBGRAPixel): TStdHSVA; -operator := (const AValue: TBGRAPixel): TStdCMYK; -operator := (const AValue: TBGRAPixel): TByteMask; -operator := (const AValue: TBGRAPixel): TLinearRGBA; -operator := (const AValue: TBGRAPixel): TXYZA; -operator := (const AValue: TBGRAPixel): TWordXYZA; -operator := (const AValue: TBGRAPixel): TLabA; -operator := (const AValue: TBGRAPixel): TLChA; -operator := (const AValue: TFPColor): TStdRGBA; -operator := (const AValue: TFPColor): TAdobeRGBA; -operator := (const AValue: TFPColor): TStdHSLA; -operator := (const AValue: TFPColor): TStdHSVA; -operator := (const AValue: TFPColor): TStdCMYK; -operator := (const AValue: TFPColor): TByteMask; -operator := (const AValue: TFPColor): TLinearRGBA; -operator := (const AValue: TFPColor): TXYZA; -operator := (const AValue: TFPColor): TWordXYZA; -operator := (const AValue: TFPColor): TLabA; -operator := (const AValue: TFPColor): TLChA; -operator := (const AValue: TStdRGBA): TColor; -operator := (const AValue: TStdRGBA): TBGRAPixel; -operator := (const AValue: TStdRGBA): TFPColor; -operator := (const AValue: TStdRGBA): TAdobeRGBA; -operator := (const AValue: TStdRGBA): TStdHSLA; -operator := (const AValue: TStdRGBA): TStdHSVA; -operator := (const AValue: TStdRGBA): TStdCMYK; -operator := (const AValue: TStdRGBA): TByteMask; -operator := (const AValue: TStdRGBA): TExpandedPixel; -operator := (const AValue: TStdRGBA): TLinearRGBA; -operator := (const AValue: TStdRGBA): THSLAPixel; -operator := (const AValue: TStdRGBA): TGSBAPixel; -operator := (const AValue: TStdRGBA): TXYZA; -operator := (const AValue: TStdRGBA): TWordXYZA; -operator := (const AValue: TStdRGBA): TLabA; -operator := (const AValue: TStdRGBA): TLChA; -operator := (const AValue: TAdobeRGBA): TColor; -operator := (const AValue: TAdobeRGBA): TBGRAPixel; -operator := (const AValue: TAdobeRGBA): TFPColor; -operator := (const AValue: TAdobeRGBA): TStdRGBA; -operator := (const AValue: TAdobeRGBA): TStdHSLA; -operator := (const AValue: TAdobeRGBA): TStdHSVA; -operator := (const AValue: TAdobeRGBA): TStdCMYK; -operator := (const AValue: TAdobeRGBA): TByteMask; -operator := (const AValue: TAdobeRGBA): TExpandedPixel; -operator := (const AValue: TAdobeRGBA): TLinearRGBA; -operator := (const AValue: TAdobeRGBA): THSLAPixel; -operator := (const AValue: TAdobeRGBA): TGSBAPixel; -operator := (const AValue: TAdobeRGBA): TXYZA; -operator := (const AValue: TAdobeRGBA): TWordXYZA; -operator := (const AValue: TAdobeRGBA): TLabA; -operator := (const AValue: TAdobeRGBA): TLChA; -operator := (const AValue: TStdHSLA): TColor; -operator := (const AValue: TStdHSLA): TBGRAPixel; -operator := (const AValue: TStdHSLA): TFPColor; -operator := (const AValue: TStdHSLA): TStdRGBA; -operator := (const AValue: TStdHSLA): TAdobeRGBA; -operator := (const AValue: TStdHSLA): TStdHSVA; -operator := (const AValue: TStdHSLA): TStdCMYK; -operator := (const AValue: TStdHSLA): TByteMask; -operator := (const AValue: TStdHSLA): TExpandedPixel; -operator := (const AValue: TStdHSLA): TLinearRGBA; -operator := (const AValue: TStdHSLA): THSLAPixel; -operator := (const AValue: TStdHSLA): TGSBAPixel; -operator := (const AValue: TStdHSLA): TXYZA; -operator := (const AValue: TStdHSLA): TWordXYZA; -operator := (const AValue: TStdHSLA): TLabA; -operator := (const AValue: TStdHSLA): TLChA; -operator := (const AValue: TStdHSVA): TColor; -operator := (const AValue: TStdHSVA): TBGRAPixel; -operator := (const AValue: TStdHSVA): TFPColor; -operator := (const AValue: TStdHSVA): TStdRGBA; -operator := (const AValue: TStdHSVA): TAdobeRGBA; -operator := (const AValue: TStdHSVA): TStdHSLA; -operator := (const AValue: TStdHSVA): TStdCMYK; -operator := (const AValue: TStdHSVA): TByteMask; -operator := (const AValue: TStdHSVA): TExpandedPixel; -operator := (const AValue: TStdHSVA): TLinearRGBA; -operator := (const AValue: TStdHSVA): THSLAPixel; -operator := (const AValue: TStdHSVA): TGSBAPixel; -operator := (const AValue: TStdHSVA): TXYZA; -operator := (const AValue: TStdHSVA): TWordXYZA; -operator := (const AValue: TStdHSVA): TLabA; -operator := (const AValue: TStdHSVA): TLChA; -operator := (const AValue: TStdCMYK): TColor; -operator := (const AValue: TStdCMYK): TBGRAPixel; -operator := (const AValue: TStdCMYK): TFPColor; -operator := (const AValue: TStdCMYK): TStdRGBA; -operator := (const AValue: TStdCMYK): TAdobeRGBA; -operator := (const AValue: TStdCMYK): TStdHSLA; -operator := (const AValue: TStdCMYK): TStdHSVA; -operator := (const AValue: TStdCMYK): TByteMask; -operator := (const AValue: TStdCMYK): TExpandedPixel; -operator := (const AValue: TStdCMYK): TLinearRGBA; -operator := (const AValue: TStdCMYK): THSLAPixel; -operator := (const AValue: TStdCMYK): TGSBAPixel; -operator := (const AValue: TStdCMYK): TXYZA; -operator := (const AValue: TStdCMYK): TWordXYZA; -operator := (const AValue: TStdCMYK): TLabA; -operator := (const AValue: TStdCMYK): TLChA; -operator := (const AValue: TByteMask): TColor; -operator := (const AValue: TByteMask): TBGRAPixel; -operator := (const AValue: TByteMask): TFPColor; -operator := (const AValue: TByteMask): TStdRGBA; -operator := (const AValue: TByteMask): TAdobeRGBA; -operator := (const AValue: TByteMask): TStdHSLA; -operator := (const AValue: TByteMask): TStdHSVA; -operator := (const AValue: TByteMask): TStdCMYK; -operator := (const AValue: TByteMask): TExpandedPixel; -operator := (const AValue: TByteMask): TLinearRGBA; -operator := (const AValue: TByteMask): THSLAPixel; -operator := (const AValue: TByteMask): TGSBAPixel; -operator := (const AValue: TByteMask): TXYZA; -operator := (const AValue: TByteMask): TWordXYZA; -operator := (const AValue: TByteMask): TLabA; -operator := (const AValue: TByteMask): TLChA; -operator := (const AValue: TExpandedPixel): TStdRGBA; -operator := (const AValue: TExpandedPixel): TAdobeRGBA; -operator := (const AValue: TExpandedPixel): TStdHSLA; -operator := (const AValue: TExpandedPixel): TStdHSVA; -operator := (const AValue: TExpandedPixel): TStdCMYK; -operator := (const AValue: TExpandedPixel): TByteMask; -operator := (const AValue: TExpandedPixel): TLinearRGBA; -operator := (const AValue: TExpandedPixel): TXYZA; -operator := (const AValue: TExpandedPixel): TWordXYZA; -operator := (const AValue: TExpandedPixel): TLabA; -operator := (const AValue: TExpandedPixel): TLChA; -operator := (const AValue: TLinearRGBA): TColor; -operator := (const AValue: TLinearRGBA): TBGRAPixel; -operator := (const AValue: TLinearRGBA): TFPColor; -operator := (const AValue: TLinearRGBA): TStdRGBA; -operator := (const AValue: TLinearRGBA): TAdobeRGBA; -operator := (const AValue: TLinearRGBA): TStdHSLA; -operator := (const AValue: TLinearRGBA): TStdHSVA; -operator := (const AValue: TLinearRGBA): TStdCMYK; -operator := (const AValue: TLinearRGBA): TByteMask; -operator := (const AValue: TLinearRGBA): TExpandedPixel; -operator := (const AValue: TLinearRGBA): THSLAPixel; -operator := (const AValue: TLinearRGBA): TGSBAPixel; -operator := (const AValue: TLinearRGBA): TXYZA; -operator := (const AValue: TLinearRGBA): TWordXYZA; -operator := (const AValue: TLinearRGBA): TLabA; -operator := (const AValue: TLinearRGBA): TLChA; -operator := (const AValue: THSLAPixel): TStdRGBA; -operator := (const AValue: THSLAPixel): TAdobeRGBA; -operator := (const AValue: THSLAPixel): TStdHSLA; -operator := (const AValue: THSLAPixel): TStdHSVA; -operator := (const AValue: THSLAPixel): TStdCMYK; -operator := (const AValue: THSLAPixel): TByteMask; -operator := (const AValue: THSLAPixel): TLinearRGBA; -operator := (const AValue: THSLAPixel): TXYZA; -operator := (const AValue: THSLAPixel): TWordXYZA; -operator := (const AValue: THSLAPixel): TLabA; -operator := (const AValue: THSLAPixel): TLChA; -operator := (const AValue: TGSBAPixel): TStdRGBA; -operator := (const AValue: TGSBAPixel): TAdobeRGBA; -operator := (const AValue: TGSBAPixel): TStdHSLA; -operator := (const AValue: TGSBAPixel): TStdHSVA; -operator := (const AValue: TGSBAPixel): TStdCMYK; -operator := (const AValue: TGSBAPixel): TByteMask; -operator := (const AValue: TGSBAPixel): TLinearRGBA; -operator := (const AValue: TGSBAPixel): TXYZA; -operator := (const AValue: TGSBAPixel): TWordXYZA; -operator := (const AValue: TGSBAPixel): TLabA; -operator := (const AValue: TGSBAPixel): TLChA; -operator := (const AValue: TXYZA): TColor; -operator := (const AValue: TXYZA): TBGRAPixel; -operator := (const AValue: TXYZA): TFPColor; -operator := (const AValue: TXYZA): TStdRGBA; -operator := (const AValue: TXYZA): TAdobeRGBA; -operator := (const AValue: TXYZA): TStdHSLA; -operator := (const AValue: TXYZA): TStdHSVA; -operator := (const AValue: TXYZA): TStdCMYK; -operator := (const AValue: TXYZA): TByteMask; -operator := (const AValue: TXYZA): TExpandedPixel; -operator := (const AValue: TXYZA): TLinearRGBA; -operator := (const AValue: TXYZA): THSLAPixel; -operator := (const AValue: TXYZA): TGSBAPixel; -operator := (const AValue: TXYZA): TWordXYZA; -operator := (const AValue: TXYZA): TLabA; -operator := (const AValue: TXYZA): TLChA; -operator := (const AValue: TWordXYZA): TColor; -operator := (const AValue: TWordXYZA): TBGRAPixel; -operator := (const AValue: TWordXYZA): TFPColor; -operator := (const AValue: TWordXYZA): TStdRGBA; -operator := (const AValue: TWordXYZA): TAdobeRGBA; -operator := (const AValue: TWordXYZA): TStdHSLA; -operator := (const AValue: TWordXYZA): TStdHSVA; -operator := (const AValue: TWordXYZA): TStdCMYK; -operator := (const AValue: TWordXYZA): TByteMask; -operator := (const AValue: TWordXYZA): TExpandedPixel; -operator := (const AValue: TWordXYZA): TLinearRGBA; -operator := (const AValue: TWordXYZA): THSLAPixel; -operator := (const AValue: TWordXYZA): TGSBAPixel; -operator := (const AValue: TWordXYZA): TXYZA; -operator := (const AValue: TWordXYZA): TLabA; -operator := (const AValue: TWordXYZA): TLChA; -operator := (const AValue: TLabA): TColor; -operator := (const AValue: TLabA): TBGRAPixel; -operator := (const AValue: TLabA): TFPColor; -operator := (const AValue: TLabA): TStdRGBA; -operator := (const AValue: TLabA): TAdobeRGBA; -operator := (const AValue: TLabA): TStdHSLA; -operator := (const AValue: TLabA): TStdHSVA; -operator := (const AValue: TLabA): TStdCMYK; -operator := (const AValue: TLabA): TByteMask; -operator := (const AValue: TLabA): TExpandedPixel; -operator := (const AValue: TLabA): TLinearRGBA; -operator := (const AValue: TLabA): THSLAPixel; -operator := (const AValue: TLabA): TGSBAPixel; -operator := (const AValue: TLabA): TXYZA; -operator := (const AValue: TLabA): TWordXYZA; -operator := (const AValue: TLabA): TLChA; -operator := (const AValue: TLChA): TColor; -operator := (const AValue: TLChA): TBGRAPixel; -operator := (const AValue: TLChA): TFPColor; -operator := (const AValue: TLChA): TStdRGBA; -operator := (const AValue: TLChA): TAdobeRGBA; -operator := (const AValue: TLChA): TStdHSLA; -operator := (const AValue: TLChA): TStdHSVA; -operator := (const AValue: TLChA): TStdCMYK; -operator := (const AValue: TLChA): TByteMask; -operator := (const AValue: TLChA): TExpandedPixel; -operator := (const AValue: TLChA): TLinearRGBA; -operator := (const AValue: TLChA): THSLAPixel; -operator := (const AValue: TLChA): TGSBAPixel; -operator := (const AValue: TLChA): TXYZA; -operator := (const AValue: TLChA): TWordXYZA; -operator := (const AValue: TLChA): TLabA; -{$ENDIF} -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -{Converters} - -procedure ConvertColorArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := ColorToBGRA(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ColorToFPColor(const AColor: TColor;const AAlpha: word=65535): TFPColor; -begin Result := BGRAToFPColor(ColorToBGRA(AColor)); - Result.alpha := AAlpha end; - -procedure ConvertColorArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TFPColor(ADest^) := ColorToFPColor(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ColorToStdRGBA(const AColor: TColor;const AAlpha: single=1): TStdRGBA; -begin Result := BGRAPixelToStdRGBA(ColorToBGRA(AColor)); - Result.alpha := AAlpha end; - -procedure ConvertColorArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdRGBA(ADest^) := ColorToStdRGBA(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ColorToStdHSLA(const AColor: TColor;const AAlpha: single=1): TStdHSLA; -begin Result := StdRGBAToStdHSLA(BGRAPixelToStdRGBA(ColorToBGRA(AColor))); - Result.alpha := AAlpha end; - -procedure ConvertColorArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSLA(ADest^) := ColorToStdHSLA(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ColorToStdHSVA(const AColor: TColor;const AAlpha: single=1): TStdHSVA; -begin Result := StdRGBAToStdHSVA(BGRAPixelToStdRGBA(ColorToBGRA(AColor))); - Result.alpha := AAlpha end; - -procedure ConvertColorArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSVA(ADest^) := ColorToStdHSVA(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ColorToStdCMYK(const AColor: TColor): TStdCMYK; -begin Result := StdRGBAToStdCMYK(BGRAPixelToStdRGBA(ColorToBGRA(AColor))) end; - -procedure ConvertColorArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdCMYK(ADest^) := ColorToStdCMYK(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ColorToByteMask(const AColor: TColor): TByteMask; -begin Result := BGRAToMask(ColorToBGRA(AColor)) end; - -procedure ConvertColorArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := ColorToByteMask(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ColorToExpandedPixel(const AColor: TColor;const AAlpha: word=65535): TExpandedPixel; -begin Result := GammaExpansion(ColorToBGRA(AColor)); - Result.alpha := AAlpha end; - -procedure ConvertColorArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TColor); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := ColorToExpandedPixel(TColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertBGRAPixelArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := BGRAToColor(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertBGRAPixelArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TFPColor(ADest^) := BGRAToFPColor(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertBGRAPixelArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdRGBA(ADest^) := BGRAPixelToStdRGBA(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function BGRAPixelToStdHSLA(const ABGRAPixel: TBGRAPixel): TStdHSLA; -begin Result := StdRGBAToStdHSLA(BGRAPixelToStdRGBA(ABGRAPixel)) end; - -procedure ConvertBGRAPixelArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSLA(ADest^) := BGRAPixelToStdHSLA(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function BGRAPixelToStdHSVA(const ABGRAPixel: TBGRAPixel): TStdHSVA; -begin Result := StdRGBAToStdHSVA(BGRAPixelToStdRGBA(ABGRAPixel)) end; - -procedure ConvertBGRAPixelArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSVA(ADest^) := BGRAPixelToStdHSVA(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function BGRAPixelToStdCMYK(const ABGRAPixel: TBGRAPixel): TStdCMYK; -begin Result := StdRGBAToStdCMYK(BGRAPixelToStdRGBA(ABGRAPixel)) end; - -procedure ConvertBGRAPixelArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdCMYK(ADest^) := BGRAPixelToStdCMYK(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertBGRAPixelArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := BGRAToMask(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertBGRAPixelArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TBGRAPixel); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := GammaExpansion(TBGRAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function FPColorToColor(const AFPColor: TFPColor): TColor; -begin Result := BGRAToColor(FPColorToBGRA(AFPColor)) end; - -procedure ConvertFPColorArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := FPColorToColor(TFPColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertFPColorArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := FPColorToBGRA(TFPColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function FPColorToByteMask(const AFPColor: TFPColor): TByteMask; -begin Result := BGRAToMask(FPColorToBGRA(AFPColor)) end; - -procedure ConvertFPColorArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := FPColorToByteMask(TFPColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertFPColorArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TFPColor); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := FPColorToExpanded(TFPColor(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdRGBAToColor(const AStdRGBA: TStdRGBA): TColor; -begin Result := BGRAToColor(StdRGBAToBGRAPixel(AStdRGBA)) end; - -procedure ConvertStdRGBAArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := StdRGBAToColor(TStdRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdRGBAArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := StdRGBAToBGRAPixel(TStdRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdRGBAArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSLA(ADest^) := StdRGBAToStdHSLA(TStdRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdRGBAArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSVA(ADest^) := StdRGBAToStdHSVA(TStdRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdRGBAArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdCMYK(ADest^) := StdRGBAToStdCMYK(TStdRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdRGBAToByteMask(const AStdRGBA: TStdRGBA): TByteMask; -begin Result := BGRAToMask(StdRGBAToBGRAPixel(AStdRGBA)) end; - -procedure ConvertStdRGBAArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := StdRGBAToByteMask(TStdRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdRGBAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdRGBA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := StdRGBAToExpandedPixel(TStdRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function AdobeRGBAToExpandedPixel(const AAdobeRGBA: TAdobeRGBA): TExpandedPixel; -begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(AdobeRGBAToXYZA(AAdobeRGBA))) end; - -procedure ConvertAdobeRGBAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := AdobeRGBAToExpandedPixel(TAdobeRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function AdobeRGBAToLinearRGBA(const AAdobeRGBA: TAdobeRGBA): TLinearRGBA; -begin Result := XYZAToLinearRGBA(AdobeRGBAToXYZA(AAdobeRGBA)) end; - -procedure ConvertAdobeRGBAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLinearRGBA(ADest^) := AdobeRGBAToLinearRGBA(TAdobeRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertAdobeRGBAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TXYZA(ADest^) := AdobeRGBAToXYZA(TAdobeRGBA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function AdobeRGBAToWordXYZA(const AAdobeRGBA: TAdobeRGBA): TWordXYZA;overload; -begin Result := XYZAToWordXYZA(AdobeRGBAToXYZA(AAdobeRGBA)) end; - -function AdobeRGBAToWordXYZA(const AAdobeRGBA: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := XYZAToWordXYZA(AdobeRGBAToXYZA(AAdobeRGBA,AReferenceWhite)) end; - -procedure ConvertAdobeRGBAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TWordXYZA(ADest^) := AdobeRGBAToWordXYZA(TAdobeRGBA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function AdobeRGBAToLabA(const AAdobeRGBA: TAdobeRGBA): TLabA; -begin Result := XYZAToLabA(AdobeRGBAToXYZA(AAdobeRGBA)) end; - -procedure ConvertAdobeRGBAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLabA(ADest^) := AdobeRGBAToLabA(TAdobeRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function AdobeRGBAToLChA(const AAdobeRGBA: TAdobeRGBA): TLChA; -begin Result := LabAToLChA(XYZAToLabA(AdobeRGBAToXYZA(AAdobeRGBA))) end; - -procedure ConvertAdobeRGBAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TAdobeRGBA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLChA(ADest^) := AdobeRGBAToLChA(TAdobeRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSLAToColor(const AStdHSLA: TStdHSLA): TColor; -begin Result := BGRAToColor(StdRGBAToBGRAPixel(StdHSLAToStdRGBA(AStdHSLA))) end; - -procedure ConvertStdHSLAArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := StdHSLAToColor(TStdHSLA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSLAToBGRAPixel(const AStdHSLA: TStdHSLA): TBGRAPixel; -begin Result := StdRGBAToBGRAPixel(StdHSLAToStdRGBA(AStdHSLA)) end; - -procedure ConvertStdHSLAArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := StdHSLAToBGRAPixel(TStdHSLA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdHSLAArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdRGBA(ADest^) := StdHSLAToStdRGBA(TStdHSLA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdHSLAArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSVA(ADest^) := StdHSLAToStdHSVA(TStdHSLA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSLAToStdCMYK(const AStdHSLA: TStdHSLA): TStdCMYK; -begin Result := StdRGBAToStdCMYK(StdHSLAToStdRGBA(AStdHSLA)) end; - -procedure ConvertStdHSLAArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdCMYK(ADest^) := StdHSLAToStdCMYK(TStdHSLA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSLAToByteMask(const AStdHSLA: TStdHSLA): TByteMask; -begin Result := BGRAToMask(StdRGBAToBGRAPixel(StdHSLAToStdRGBA(AStdHSLA))) end; - -procedure ConvertStdHSLAArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := StdHSLAToByteMask(TStdHSLA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSLAToExpandedPixel(const AStdHSLA: TStdHSLA): TExpandedPixel; -begin Result := StdRGBAToExpandedPixel(StdHSLAToStdRGBA(AStdHSLA)) end; - -procedure ConvertStdHSLAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSLA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := StdHSLAToExpandedPixel(TStdHSLA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSVAToColor(const AStdHSVA: TStdHSVA): TColor; -begin Result := BGRAToColor(StdRGBAToBGRAPixel(StdHSVAToStdRGBA(AStdHSVA))) end; - -procedure ConvertStdHSVAArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := StdHSVAToColor(TStdHSVA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSVAToBGRAPixel(const AStdHSVA: TStdHSVA): TBGRAPixel; -begin Result := StdRGBAToBGRAPixel(StdHSVAToStdRGBA(AStdHSVA)) end; - -procedure ConvertStdHSVAArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := StdHSVAToBGRAPixel(TStdHSVA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdHSVAArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdRGBA(ADest^) := StdHSVAToStdRGBA(TStdHSVA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdHSVAArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSLA(ADest^) := StdHSVAToStdHSLA(TStdHSVA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSVAToStdCMYK(const AStdHSVA: TStdHSVA): TStdCMYK; -begin Result := StdRGBAToStdCMYK(StdHSVAToStdRGBA(AStdHSVA)) end; - -procedure ConvertStdHSVAArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdCMYK(ADest^) := StdHSVAToStdCMYK(TStdHSVA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSVAToByteMask(const AStdHSVA: TStdHSVA): TByteMask; -begin Result := BGRAToMask(StdRGBAToBGRAPixel(StdHSVAToStdRGBA(AStdHSVA))) end; - -procedure ConvertStdHSVAArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := StdHSVAToByteMask(TStdHSVA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdHSVAToExpandedPixel(const AStdHSVA: TStdHSVA): TExpandedPixel; -begin Result := StdRGBAToExpandedPixel(StdHSVAToStdRGBA(AStdHSVA)) end; - -procedure ConvertStdHSVAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdHSVA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := StdHSVAToExpandedPixel(TStdHSVA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdCMYKToColor(const AStdCMYK: TStdCMYK): TColor; -begin Result := BGRAToColor(StdRGBAToBGRAPixel(StdCMYKToStdRGBA(AStdCMYK))) end; - -procedure ConvertStdCMYKArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := StdCMYKToColor(TStdCMYK(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdCMYKToBGRAPixel(const AStdCMYK: TStdCMYK;const AAlpha: byte=255): TBGRAPixel; -begin Result := StdRGBAToBGRAPixel(StdCMYKToStdRGBA(AStdCMYK)); - Result.alpha := AAlpha end; - -procedure ConvertStdCMYKArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := StdCMYKToBGRAPixel(TStdCMYK(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertStdCMYKArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdRGBA(ADest^) := StdCMYKToStdRGBA(TStdCMYK(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdCMYKToStdHSLA(const AStdCMYK: TStdCMYK;const AAlpha: single=1): TStdHSLA; -begin Result := StdRGBAToStdHSLA(StdCMYKToStdRGBA(AStdCMYK)); - Result.alpha := AAlpha end; - -procedure ConvertStdCMYKArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSLA(ADest^) := StdCMYKToStdHSLA(TStdCMYK(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdCMYKToStdHSVA(const AStdCMYK: TStdCMYK;const AAlpha: single=1): TStdHSVA; -begin Result := StdRGBAToStdHSVA(StdCMYKToStdRGBA(AStdCMYK)); - Result.alpha := AAlpha end; - -procedure ConvertStdCMYKArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSVA(ADest^) := StdCMYKToStdHSVA(TStdCMYK(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdCMYKToByteMask(const AStdCMYK: TStdCMYK): TByteMask; -begin Result := BGRAToMask(StdRGBAToBGRAPixel(StdCMYKToStdRGBA(AStdCMYK))) end; - -procedure ConvertStdCMYKArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := StdCMYKToByteMask(TStdCMYK(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function StdCMYKToExpandedPixel(const AStdCMYK: TStdCMYK;const AAlpha: word=65535): TExpandedPixel; -begin Result := StdRGBAToExpandedPixel(StdCMYKToStdRGBA(AStdCMYK)); - Result.alpha := AAlpha end; - -procedure ConvertStdCMYKArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TStdCMYK); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := StdCMYKToExpandedPixel(TStdCMYK(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ByteMaskToColor(const AByteMask: TByteMask): TColor; -begin Result := BGRAToColor(MaskToBGRA(AByteMask)) end; - -procedure ConvertByteMaskArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := ByteMaskToColor(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertByteMaskArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := MaskToBGRA(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ByteMaskToFPColor(const AByteMask: TByteMask;const AAlpha: word=65535): TFPColor; -begin Result := BGRAToFPColor(MaskToBGRA(AByteMask)); - Result.alpha := AAlpha end; - -procedure ConvertByteMaskArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TFPColor(ADest^) := ByteMaskToFPColor(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ByteMaskToStdRGBA(const AByteMask: TByteMask;const AAlpha: single=1): TStdRGBA; -begin Result := BGRAPixelToStdRGBA(MaskToBGRA(AByteMask)); - Result.alpha := AAlpha end; - -procedure ConvertByteMaskArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdRGBA(ADest^) := ByteMaskToStdRGBA(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ByteMaskToStdHSLA(const AByteMask: TByteMask;const AAlpha: single=1): TStdHSLA; -begin Result := StdRGBAToStdHSLA(BGRAPixelToStdRGBA(MaskToBGRA(AByteMask))); - Result.alpha := AAlpha end; - -procedure ConvertByteMaskArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSLA(ADest^) := ByteMaskToStdHSLA(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ByteMaskToStdHSVA(const AByteMask: TByteMask;const AAlpha: single=1): TStdHSVA; -begin Result := StdRGBAToStdHSVA(BGRAPixelToStdRGBA(MaskToBGRA(AByteMask))); - Result.alpha := AAlpha end; - -procedure ConvertByteMaskArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSVA(ADest^) := ByteMaskToStdHSVA(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ByteMaskToStdCMYK(const AByteMask: TByteMask): TStdCMYK; -begin Result := StdRGBAToStdCMYK(BGRAPixelToStdRGBA(MaskToBGRA(AByteMask))) end; - -procedure ConvertByteMaskArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdCMYK(ADest^) := ByteMaskToStdCMYK(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertByteMaskArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TByteMask); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := ByteMaskToExpandedPixel(TByteMask(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToColor(const AExpandedPixel: TExpandedPixel): TColor; -begin Result := BGRAToColor(GammaCompression(AExpandedPixel)) end; - -procedure ConvertExpandedPixelArrayToColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TColor(ADest^) := ExpandedPixelToColor(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToBGRAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TBGRAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TBGRAPixel(ADest^) := GammaCompression(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToFPColorArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TFPColor); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TFPColor(ADest^) := ExpandedToFPColor(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToStdRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdRGBA(ADest^) := ExpandedPixelToStdRGBA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToAdobeRGBA(const AExpandedPixel: TExpandedPixel): TAdobeRGBA; -begin Result := XYZAToAdobeRGBA(LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel))) end; - -procedure ConvertExpandedPixelArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TAdobeRGBA(ADest^) := ExpandedPixelToAdobeRGBA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToStdHSLA(const AExpandedPixel: TExpandedPixel): TStdHSLA; -begin Result := StdRGBAToStdHSLA(ExpandedPixelToStdRGBA(AExpandedPixel)) end; - -procedure ConvertExpandedPixelArrayToStdHSLAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdHSLA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSLA(ADest^) := ExpandedPixelToStdHSLA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToStdHSVA(const AExpandedPixel: TExpandedPixel): TStdHSVA; -begin Result := StdRGBAToStdHSVA(ExpandedPixelToStdRGBA(AExpandedPixel)) end; - -procedure ConvertExpandedPixelArrayToStdHSVAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdHSVA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdHSVA(ADest^) := ExpandedPixelToStdHSVA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToStdCMYK(const AExpandedPixel: TExpandedPixel): TStdCMYK; -begin Result := StdRGBAToStdCMYK(ExpandedPixelToStdRGBA(AExpandedPixel)) end; - -procedure ConvertExpandedPixelArrayToStdCMYKArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TStdCMYK); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TStdCMYK(ADest^) := ExpandedPixelToStdCMYK(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToByteMaskArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TByteMask); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TByteMask(ADest^) := ExpandedPixelToByteMask(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLinearRGBA(ADest^) := ExpandedPixelToLinearRGBA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToHSLAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(THSLAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - THSLAPixel(ADest^) := ExpandedToHSLA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToGSBAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TGSBAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TGSBAPixel(ADest^) := ExpandedToGSBA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToXYZA(const AExpandedPixel: TExpandedPixel): TXYZA;overload; -begin Result := LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel)) end; - -function ExpandedPixelToXYZA(const AExpandedPixel: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel),AReferenceWhite) end; - -procedure ConvertExpandedPixelArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TXYZA(ADest^) := ExpandedPixelToXYZA(TExpandedPixel(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertExpandedPixelArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TWordXYZA(ADest^) := ExpandedPixelToWordXYZA(TExpandedPixel(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToLabA(const AExpandedPixel: TExpandedPixel): TLabA; -begin Result := XYZAToLabA(LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel))) end; - -procedure ConvertExpandedPixelArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLabA(ADest^) := ExpandedPixelToLabA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function ExpandedPixelToLChA(const AExpandedPixel: TExpandedPixel): TLChA; -begin Result := LabAToLChA(XYZAToLabA(LinearRGBAToXYZA(ExpandedPixelToLinearRGBA(AExpandedPixel)))) end; - -procedure ConvertExpandedPixelArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TExpandedPixel); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLChA(ADest^) := ExpandedPixelToLChA(TExpandedPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LinearRGBAToAdobeRGBA(const ALinearRGBA: TLinearRGBA): TAdobeRGBA; -begin Result := XYZAToAdobeRGBA(LinearRGBAToXYZA(ALinearRGBA)) end; - -procedure ConvertLinearRGBAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TAdobeRGBA(ADest^) := LinearRGBAToAdobeRGBA(TLinearRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertLinearRGBAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := LinearRGBAToExpandedPixel(TLinearRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertLinearRGBAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TXYZA(ADest^) := LinearRGBAToXYZA(TLinearRGBA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LinearRGBAToLabA(const ALinearRGBA: TLinearRGBA): TLabA; -begin Result := XYZAToLabA(LinearRGBAToXYZA(ALinearRGBA)) end; - -procedure ConvertLinearRGBAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLabA(ADest^) := LinearRGBAToLabA(TLinearRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LinearRGBAToLChA(const ALinearRGBA: TLinearRGBA): TLChA; -begin Result := LabAToLChA(XYZAToLabA(LinearRGBAToXYZA(ALinearRGBA))) end; - -procedure ConvertLinearRGBAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLinearRGBA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLChA(ADest^) := LinearRGBAToLChA(TLinearRGBA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertHSLAPixelArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(THSLAPixel); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := HSLAToExpanded(THSLAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertHSLAPixelArrayToGSBAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(THSLAPixel); ADestStride:integer=sizeOf(TGSBAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TGSBAPixel(ADest^) := HSLAToGSBA(THSLAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertGSBAPixelArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TGSBAPixel); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := GSBAToExpanded(TGSBAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertGSBAPixelArrayToHSLAPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TGSBAPixel); ADestStride:integer=sizeOf(THSLAPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - THSLAPixel(ADest^) := GSBAToHSLA(TGSBAPixel(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertXYZAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TAdobeRGBA(ADest^) := XYZAToAdobeRGBA(TXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function XYZAToExpandedPixel(const AXYZA: TXYZA): TExpandedPixel;overload; -begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(AXYZA)) end; - -function XYZAToExpandedPixel(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; -begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(AXYZA,AReferenceWhite)) end; - -procedure ConvertXYZAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TExpandedPixel(ADest^) := XYZAToExpandedPixel(TXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertXYZAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TLinearRGBA(ADest^) := XYZAToLinearRGBA(TXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertXYZAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TWordXYZA(ADest^) := XYZAToWordXYZA(TXYZA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertXYZAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TLabA(ADest^) := XYZAToLabA(TXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function XYZAToLChA(const AXYZA: TXYZA): TLChA;overload; -begin Result := LabAToLChA(XYZAToLabA(AXYZA)) end; - -function XYZAToLChA(const AXYZA: TXYZA; const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; -begin Result := LabAToLChA(XYZAToLabA(AXYZA,AReferenceWhite)) end; - -procedure ConvertXYZAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TXYZA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TLChA(ADest^) := XYZAToLChA(TXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function WordXYZAToAdobeRGBA(const AWordXYZA: TWordXYZA): TAdobeRGBA;overload; -begin Result := XYZAToAdobeRGBA(WordXYZAToXYZA(AWordXYZA)) end; - -function WordXYZAToAdobeRGBA(const AWordXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; -begin Result := XYZAToAdobeRGBA(WordXYZAToXYZA(AWordXYZA),AReferenceWhite) end; - -procedure ConvertWordXYZAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TAdobeRGBA(ADest^) := WordXYZAToAdobeRGBA(TWordXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertWordXYZAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TExpandedPixel(ADest^) := WordXYZAToExpandedPixel(TWordXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertWordXYZAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TXYZA(ADest^) := WordXYZAToXYZA(TWordXYZA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function WordXYZAToLabA(const AWordXYZA: TWordXYZA): TLabA;overload; -begin Result := XYZAToLabA(WordXYZAToXYZA(AWordXYZA)) end; - -function WordXYZAToLabA(const AWordXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; -begin Result := XYZAToLabA(WordXYZAToXYZA(AWordXYZA),AReferenceWhite) end; - -procedure ConvertWordXYZAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TLabA(ADest^) := WordXYZAToLabA(TWordXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function WordXYZAToLChA(const AWordXYZA: TWordXYZA): TLChA;overload; -begin Result := LabAToLChA(XYZAToLabA(WordXYZAToXYZA(AWordXYZA))) end; - -function WordXYZAToLChA(const AWordXYZA: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; -begin Result := LabAToLChA(XYZAToLabA(WordXYZAToXYZA(AWordXYZA),AReferenceWhite)) end; - -procedure ConvertWordXYZAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TWordXYZA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TLChA(ADest^) := WordXYZAToLChA(TWordXYZA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LabAToAdobeRGBA(const ALabA: TLabA): TAdobeRGBA; -begin Result := XYZAToAdobeRGBA(LabAToXYZA(ALabA)) end; - -procedure ConvertLabAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TAdobeRGBA(ADest^) := LabAToAdobeRGBA(TLabA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LabAToExpandedPixel(const ALabA: TLabA): TExpandedPixel; -begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(LabAToXYZA(ALabA))) end; - -procedure ConvertLabAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := LabAToExpandedPixel(TLabA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LabAToLinearRGBA(const ALabA: TLabA): TLinearRGBA; -begin Result := XYZAToLinearRGBA(LabAToXYZA(ALabA)) end; - -procedure ConvertLabAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLinearRGBA(ADest^) := LabAToLinearRGBA(TLabA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertLabAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TXYZA(ADest^) := LabAToXYZA(TLabA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LabAToWordXYZA(const ALabA: TLabA): TWordXYZA;overload; -begin Result := XYZAToWordXYZA(LabAToXYZA(ALabA)) end; - -function LabAToWordXYZA(const ALabA: TLabA; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := XYZAToWordXYZA(LabAToXYZA(ALabA,AReferenceWhite)) end; - -procedure ConvertLabAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TWordXYZA(ADest^) := LabAToWordXYZA(TLabA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertLabAArrayToLChAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLabA); ADestStride:integer=sizeOf(TLChA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLChA(ADest^) := LabAToLChA(TLabA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LChAToAdobeRGBA(const ALChA: TLChA): TAdobeRGBA; -begin Result := XYZAToAdobeRGBA(LabAToXYZA(LChAToLabA(ALChA))) end; - -procedure ConvertLChAArrayToAdobeRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TAdobeRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TAdobeRGBA(ADest^) := LChAToAdobeRGBA(TLChA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LChAToExpandedPixel(const ALChA: TLChA): TExpandedPixel; -begin Result := LinearRGBAToExpandedPixel(XYZAToLinearRGBA(LabAToXYZA(LChAToLabA(ALChA)))) end; - -procedure ConvertLChAArrayToExpandedPixelArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TExpandedPixel); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TExpandedPixel(ADest^) := LChAToExpandedPixel(TLChA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LChAToLinearRGBA(const ALChA: TLChA): TLinearRGBA; -begin Result := XYZAToLinearRGBA(LabAToXYZA(LChAToLabA(ALChA))) end; - -procedure ConvertLChAArrayToLinearRGBAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TLinearRGBA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLinearRGBA(ADest^) := LChAToLinearRGBA(TLChA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LChAToXYZA(const ALChA: TLChA): TXYZA;overload; -begin Result := LabAToXYZA(LChAToLabA(ALChA)) end; - -function LChAToXYZA(const ALChA: TLChA; const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := LabAToXYZA(LChAToLabA(ALChA),AReferenceWhite) end; - -procedure ConvertLChAArrayToXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TXYZA(ADest^) := LChAToXYZA(TLChA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -function LChAToWordXYZA(const ALChA: TLChA): TWordXYZA;overload; -begin Result := XYZAToWordXYZA(LabAToXYZA(LChAToLabA(ALChA))) end; - -function LChAToWordXYZA(const ALChA: TLChA; const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := XYZAToWordXYZA(LabAToXYZA(LChAToLabA(ALChA),AReferenceWhite)) end; - -procedure ConvertLChAArrayToWordXYZAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TWordXYZA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite; - while ACount > 0 do begin - TWordXYZA(ADest^) := LChAToWordXYZA(TLChA(ASource^), AReferenceWhite^); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -procedure ConvertLChAArrayToLabAArray(ASource: pointer; ADest: Pointer; ACount: integer; ASourceStride:integer=sizeOf(TLChA); ADestStride:integer=sizeOf(TLabA); {%H-}AReferenceWhite: PXYZReferenceWhite=nil); -begin - while ACount > 0 do begin - TLabA(ADest^) := LChAToLabA(TLChA(ASource^)); - inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end; -end; - -{ TStdRGBA } - -class function TStdRGBA.New(const ARed,AGreen,ABlue,AAlpha:single): TStdRGBA;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := AAlpha; -end; - -class function TStdRGBA.New(const ARed,AGreen,ABlue:single): TStdRGBA;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := 1; -end; - -{ TAdobeRGBA } - -class function TAdobeRGBA.New(const ARed,AGreen,ABlue,AAlpha:byte): TAdobeRGBA;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := AAlpha; -end; - -class function TAdobeRGBA.New(const ARed,AGreen,ABlue:byte): TAdobeRGBA;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := 255; -end; - -{ TStdHSLA } - -class function TStdHSLA.New(const AHue,ASaturation,ALightness,AAlpha:single): TStdHSLA;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.lightness := ALightness; - Result.alpha := AAlpha; -end; - -class function TStdHSLA.New(const AHue,ASaturation,ALightness:single): TStdHSLA;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.lightness := ALightness; - Result.alpha := 1; -end; - -{ TStdHSVA } - -class function TStdHSVA.New(const AHue,ASaturation,AValue,AAlpha:single): TStdHSVA;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.value := AValue; - Result.alpha := AAlpha; -end; - -class function TStdHSVA.New(const AHue,ASaturation,AValue:single): TStdHSVA;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.value := AValue; - Result.alpha := 1; -end; - -{ TStdCMYK } - -class function TStdCMYK.New(const ACyan,AMagenta,AYellow,ABlack:single): TStdCMYK; -begin - Result.C := ACyan; - Result.M := AMagenta; - Result.Y := AYellow; - Result.K := ABlack; -end; - -{ TByteMask } - -class function TByteMask.New(const AGray:byte): TByteMask; -begin - Result.gray := AGray; -end; - -{ TLinearRGBA } - -class function TLinearRGBA.New(const ARed,AGreen,ABlue,AAlpha:single): TLinearRGBA;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := AAlpha; -end; - -class function TLinearRGBA.New(const ARed,AGreen,ABlue:single): TLinearRGBA;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := 1; -end; - -{ TXYZA } - -class function TXYZA.New(const AX,AY,AZ,AAlpha:single): TXYZA;overload; -begin - Result.X := AX; - Result.Y := AY; - Result.Z := AZ; - Result.alpha := AAlpha; -end; - -class function TXYZA.New(const AX,AY,AZ:single): TXYZA;overload; -begin - Result.X := AX; - Result.Y := AY; - Result.Z := AZ; - Result.alpha := 1; -end; - -{ TWordXYZA } - -class function TWordXYZA.New(const AX,AY,AZ,AAlpha:word): TWordXYZA;overload; -begin - Result.X := AX; - Result.Y := AY; - Result.Z := AZ; - Result.alpha := AAlpha; -end; - -class function TWordXYZA.New(const AX,AY,AZ:word): TWordXYZA;overload; -begin - Result.X := AX; - Result.Y := AY; - Result.Z := AZ; - Result.alpha := 65535; -end; - -{ TLabA } - -class function TLabA.New(const ALightness,Aa,Ab,AAlpha:single): TLabA;overload; -begin - Result.L := ALightness; - Result.a := Aa; - Result.b := Ab; - Result.alpha := AAlpha; -end; - -class function TLabA.New(const ALightness,Aa,Ab:single): TLabA;overload; -begin - Result.L := ALightness; - Result.a := Aa; - Result.b := Ab; - Result.alpha := 1; -end; - -{ TLChA } - -class function TLChA.New(const ALightness,AChroma,AHue,AAlpha:single): TLChA;overload; -begin - Result.L := ALightness; - Result.C := AChroma; - Result.h := AHue; - Result.alpha := AAlpha; -end; - -class function TLChA.New(const ALightness,AChroma,AHue:single): TLChA;overload; -begin - Result.L := ALightness; - Result.C := AChroma; - Result.h := AHue; - Result.alpha := 1; -end; - -{ TColorColorspace } - -class function TColorColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Red'; - 1: result := 'Green'; - 2: result := 'Blue'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TColorColorspace.GetChannelCount: integer; -begin result := 3 end; - -class function TColorColorspace.IndexOfAlphaChannel: integer; -begin result := -1 end; - -class function TColorColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin result := ctFullyOpaque end; - -class function TColorColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 255; - 1: result := 255; - 2: result := 255; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TColorColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TColorColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 8 end; - -class function TColorColorspace.GetName: string; -begin result := 'Color' end; - -class function TColorColorspace.GetSize: integer; -begin result := sizeof(TColor) end; - -class function TColorColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TColor(AColor^).red; - 1: result := TColor(AColor^).green; - 2: result := TColor(AColor^).blue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TColorColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TColor(AColor^).red := Round(Clamp(AValue,0,255)); - 1: TColor(AColor^).green := Round(Clamp(AValue,0,255)); - 2: TColor(AColor^).blue := Round(Clamp(AValue,0,255)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TColorColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TBGRAPixelColorspace } - -class function TBGRAPixelColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Red'; - 1: result := 'Green'; - 2: result := 'Blue'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TBGRAPixelColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TBGRAPixelColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TBGRAPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TBGRAPixel(AColor^).alpha >= 255 then exit(ctFullyOpaque) else - if TBGRAPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TBGRAPixelColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 255; - 1: result := 255; - 2: result := 255; - 3: result := 255; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TBGRAPixelColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TBGRAPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 8 end; - -class function TBGRAPixelColorspace.GetName: string; -begin result := 'BGRAPixel' end; - -class function TBGRAPixelColorspace.GetSize: integer; -begin result := sizeof(TBGRAPixel) end; - -class function TBGRAPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TBGRAPixel(AColor^).red; - 1: result := TBGRAPixel(AColor^).green; - 2: result := TBGRAPixel(AColor^).blue; - 3: result := TBGRAPixel(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TBGRAPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TBGRAPixel(AColor^).red := Round(Clamp(AValue,0,255)); - 1: TBGRAPixel(AColor^).green := Round(Clamp(AValue,0,255)); - 2: TBGRAPixel(AColor^).blue := Round(Clamp(AValue,0,255)); - 3: TBGRAPixel(AColor^).alpha := Round(Clamp(AValue,0,255)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TBGRAPixelColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TFPColorColorspace } - -class function TFPColorColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Red'; - 1: result := 'Green'; - 2: result := 'Blue'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TFPColorColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TFPColorColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TFPColorColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TFPColor(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else - if TFPColor(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TFPColorColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 65535; - 1: result := 65535; - 2: result := 65535; - 3: result := 65535; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TFPColorColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TFPColorColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 16 end; - -class function TFPColorColorspace.GetName: string; -begin result := 'FPColor' end; - -class function TFPColorColorspace.GetSize: integer; -begin result := sizeof(TFPColor) end; - -class function TFPColorColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TFPColor(AColor^).red; - 1: result := TFPColor(AColor^).green; - 2: result := TFPColor(AColor^).blue; - 3: result := TFPColor(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TFPColorColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TFPColor(AColor^).red := Round(Clamp(AValue,0,65535)); - 1: TFPColor(AColor^).green := Round(Clamp(AValue,0,65535)); - 2: TFPColor(AColor^).blue := Round(Clamp(AValue,0,65535)); - 3: TFPColor(AColor^).alpha := Round(Clamp(AValue,0,65535)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TFPColorColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TStdRGBAColorspace } - -class function TStdRGBAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Red'; - 1: result := 'Green'; - 2: result := 'Blue'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdRGBAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TStdRGBAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TStdRGBAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TStdRGBA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else - if TStdRGBA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TStdRGBAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 1; - 1: result := 1; - 2: result := 1; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdRGBAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdRGBAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TStdRGBAColorspace.GetName: string; -begin result := 'StdRGBA' end; - -class function TStdRGBAColorspace.GetSize: integer; -begin result := sizeof(TStdRGBA) end; - -class function TStdRGBAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TStdRGBA(AColor^).red; - 1: result := TStdRGBA(AColor^).green; - 2: result := TStdRGBA(AColor^).blue; - 3: result := TStdRGBA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TStdRGBAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TStdRGBA(AColor^).red := AValue; - 1: TStdRGBA(AColor^).green := AValue; - 2: TStdRGBA(AColor^).blue := AValue; - 3: TStdRGBA(AColor^).alpha := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdRGBAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TAdobeRGBAColorspace } - -class function TAdobeRGBAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Red'; - 1: result := 'Green'; - 2: result := 'Blue'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TAdobeRGBAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TAdobeRGBAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TAdobeRGBAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TAdobeRGBA(AColor^).alpha >= 255 then exit(ctFullyOpaque) else - if TAdobeRGBA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TAdobeRGBAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 255; - 1: result := 255; - 2: result := 255; - 3: result := 255; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TAdobeRGBAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TAdobeRGBAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 8 end; - -class function TAdobeRGBAColorspace.GetName: string; -begin result := 'AdobeRGBA' end; - -class function TAdobeRGBAColorspace.GetSize: integer; -begin result := sizeof(TAdobeRGBA) end; - -class function TAdobeRGBAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TAdobeRGBA(AColor^).red; - 1: result := TAdobeRGBA(AColor^).green; - 2: result := TAdobeRGBA(AColor^).blue; - 3: result := TAdobeRGBA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TAdobeRGBAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TAdobeRGBA(AColor^).red := Round(Clamp(AValue,0,255)); - 1: TAdobeRGBA(AColor^).green := Round(Clamp(AValue,0,255)); - 2: TAdobeRGBA(AColor^).blue := Round(Clamp(AValue,0,255)); - 3: TAdobeRGBA(AColor^).alpha := Round(Clamp(AValue,0,255)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TAdobeRGBAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TStdHSLAColorspace } - -class function TStdHSLAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Hue'; - 1: result := 'Saturation'; - 2: result := 'Lightness'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSLAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TStdHSLAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TStdHSLAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TStdHSLA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else - if TStdHSLA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TStdHSLAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 360; - 1: result := 1; - 2: result := 1; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSLAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSLAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TStdHSLAColorspace.GetName: string; -begin result := 'StdHSLA' end; - -class function TStdHSLAColorspace.GetSize: integer; -begin result := sizeof(TStdHSLA) end; - -class function TStdHSLAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TStdHSLA(AColor^).hue; - 1: result := TStdHSLA(AColor^).saturation; - 2: result := TStdHSLA(AColor^).lightness; - 3: result := TStdHSLA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TStdHSLAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TStdHSLA(AColor^).hue := AValue; - 1: TStdHSLA(AColor^).saturation := AValue; - 2: TStdHSLA(AColor^).lightness := AValue; - 3: TStdHSLA(AColor^).alpha := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSLAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TStdHSVAColorspace } - -class function TStdHSVAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Hue'; - 1: result := 'Saturation'; - 2: result := 'Value'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSVAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TStdHSVAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TStdHSVAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TStdHSVA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else - if TStdHSVA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TStdHSVAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 360; - 1: result := 1; - 2: result := 1; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSVAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSVAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TStdHSVAColorspace.GetName: string; -begin result := 'StdHSVA' end; - -class function TStdHSVAColorspace.GetSize: integer; -begin result := sizeof(TStdHSVA) end; - -class function TStdHSVAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TStdHSVA(AColor^).hue; - 1: result := TStdHSVA(AColor^).saturation; - 2: result := TStdHSVA(AColor^).value; - 3: result := TStdHSVA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TStdHSVAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TStdHSVA(AColor^).hue := AValue; - 1: TStdHSVA(AColor^).saturation := AValue; - 2: TStdHSVA(AColor^).value := AValue; - 3: TStdHSVA(AColor^).alpha := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdHSVAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TStdCMYKColorspace } - -class function TStdCMYKColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Cyan'; - 1: result := 'Magenta'; - 2: result := 'Yellow'; - 3: result := 'Black'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdCMYKColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TStdCMYKColorspace.IndexOfAlphaChannel: integer; -begin result := -1 end; - -class function TStdCMYKColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin result := ctFullyOpaque end; - -class function TStdCMYKColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 1; - 1: result := 1; - 2: result := 1; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdCMYKColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdCMYKColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TStdCMYKColorspace.GetName: string; -begin result := 'StdCMYK' end; - -class function TStdCMYKColorspace.GetSize: integer; -begin result := sizeof(TStdCMYK) end; - -class function TStdCMYKColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TStdCMYK(AColor^).C; - 1: result := TStdCMYK(AColor^).M; - 2: result := TStdCMYK(AColor^).Y; - 3: result := TStdCMYK(AColor^).K; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TStdCMYKColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TStdCMYK(AColor^).C := AValue; - 1: TStdCMYK(AColor^).M := AValue; - 2: TStdCMYK(AColor^).Y := AValue; - 3: TStdCMYK(AColor^).K := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TStdCMYKColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TByteMaskColorspace } - -class function TByteMaskColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Gray'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TByteMaskColorspace.GetChannelCount: integer; -begin result := 1 end; - -class function TByteMaskColorspace.IndexOfAlphaChannel: integer; -begin result := -1 end; - -class function TByteMaskColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin result := ctFullyOpaque end; - -class function TByteMaskColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 255; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TByteMaskColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TByteMaskColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 8 end; - -class function TByteMaskColorspace.GetName: string; -begin result := 'ByteMask' end; - -class function TByteMaskColorspace.GetSize: integer; -begin result := sizeof(TByteMask) end; - -class function TByteMaskColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TByteMask(AColor^).gray; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TByteMaskColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TByteMask(AColor^).gray := Round(Clamp(AValue,0,255)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TByteMaskColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TExpandedPixelColorspace } - -class function TExpandedPixelColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Red'; - 1: result := 'Green'; - 2: result := 'Blue'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TExpandedPixelColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TExpandedPixelColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TExpandedPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TExpandedPixel(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else - if TExpandedPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TExpandedPixelColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 65535; - 1: result := 65535; - 2: result := 65535; - 3: result := 65535; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TExpandedPixelColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TExpandedPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 16 end; - -class function TExpandedPixelColorspace.GetName: string; -begin result := 'ExpandedPixel' end; - -class function TExpandedPixelColorspace.GetSize: integer; -begin result := sizeof(TExpandedPixel) end; - -class function TExpandedPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TExpandedPixel(AColor^).red; - 1: result := TExpandedPixel(AColor^).green; - 2: result := TExpandedPixel(AColor^).blue; - 3: result := TExpandedPixel(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TExpandedPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TExpandedPixel(AColor^).red := Round(Clamp(AValue,0,65535)); - 1: TExpandedPixel(AColor^).green := Round(Clamp(AValue,0,65535)); - 2: TExpandedPixel(AColor^).blue := Round(Clamp(AValue,0,65535)); - 3: TExpandedPixel(AColor^).alpha := Round(Clamp(AValue,0,65535)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TExpandedPixelColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TLinearRGBAColorspace } - -class function TLinearRGBAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Red'; - 1: result := 'Green'; - 2: result := 'Blue'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLinearRGBAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TLinearRGBAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TLinearRGBAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TLinearRGBA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else - if TLinearRGBA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TLinearRGBAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 1; - 1: result := 1; - 2: result := 1; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLinearRGBAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLinearRGBAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TLinearRGBAColorspace.GetName: string; -begin result := 'LinearRGBA' end; - -class function TLinearRGBAColorspace.GetSize: integer; -begin result := sizeof(TLinearRGBA) end; - -class function TLinearRGBAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TLinearRGBA(AColor^).red; - 1: result := TLinearRGBA(AColor^).green; - 2: result := TLinearRGBA(AColor^).blue; - 3: result := TLinearRGBA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TLinearRGBAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TLinearRGBA(AColor^).red := AValue; - 1: TLinearRGBA(AColor^).green := AValue; - 2: TLinearRGBA(AColor^).blue := AValue; - 3: TLinearRGBA(AColor^).alpha := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLinearRGBAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ THSLAPixelColorspace } - -class function THSLAPixelColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Hue'; - 1: result := 'Saturation'; - 2: result := 'Lightness'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function THSLAPixelColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function THSLAPixelColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function THSLAPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if THSLAPixel(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else - if THSLAPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function THSLAPixelColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 65535; - 1: result := 65535; - 2: result := 65535; - 3: result := 65535; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function THSLAPixelColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function THSLAPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 16 end; - -class function THSLAPixelColorspace.GetName: string; -begin result := 'HSLAPixel' end; - -class function THSLAPixelColorspace.GetSize: integer; -begin result := sizeof(THSLAPixel) end; - -class function THSLAPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := THSLAPixel(AColor^).hue; - 1: result := THSLAPixel(AColor^).saturation; - 2: result := THSLAPixel(AColor^).lightness; - 3: result := THSLAPixel(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure THSLAPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: THSLAPixel(AColor^).hue := Round(Clamp(AValue,0,65535)); - 1: THSLAPixel(AColor^).saturation := Round(Clamp(AValue,0,65535)); - 2: THSLAPixel(AColor^).lightness := Round(Clamp(AValue,0,65535)); - 3: THSLAPixel(AColor^).alpha := Round(Clamp(AValue,0,65535)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function THSLAPixelColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TGSBAPixelColorspace } - -class function TGSBAPixelColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Hue'; - 1: result := 'Saturation'; - 2: result := 'Brightness'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TGSBAPixelColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TGSBAPixelColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TGSBAPixelColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TGSBAPixel(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else - if TGSBAPixel(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TGSBAPixelColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 65535; - 1: result := 65535; - 2: result := 65535; - 3: result := 65535; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TGSBAPixelColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TGSBAPixelColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 16 end; - -class function TGSBAPixelColorspace.GetName: string; -begin result := 'GSBAPixel' end; - -class function TGSBAPixelColorspace.GetSize: integer; -begin result := sizeof(TGSBAPixel) end; - -class function TGSBAPixelColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TGSBAPixel(AColor^).hue; - 1: result := TGSBAPixel(AColor^).saturation; - 2: result := TGSBAPixel(AColor^).lightness; - 3: result := TGSBAPixel(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TGSBAPixelColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TGSBAPixel(AColor^).hue := Round(Clamp(AValue,0,65535)); - 1: TGSBAPixel(AColor^).saturation := Round(Clamp(AValue,0,65535)); - 2: TGSBAPixel(AColor^).lightness := Round(Clamp(AValue,0,65535)); - 3: TGSBAPixel(AColor^).alpha := Round(Clamp(AValue,0,65535)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TGSBAPixelColorspace.GetFlags: TColorspaceFlags; -begin result := [cfFixedReferenceWhite] end; - - -{ TXYZAColorspace } - -class function TXYZAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'X'; - 1: result := 'Y'; - 2: result := 'Z'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TXYZAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TXYZAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TXYZAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TXYZA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else - if TXYZA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TXYZAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 1; - 1: result := 1; - 2: result := 1; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TXYZAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TXYZAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TXYZAColorspace.GetName: string; -begin result := 'XYZA' end; - -class function TXYZAColorspace.GetSize: integer; -begin result := sizeof(TXYZA) end; - -class function TXYZAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TXYZA(AColor^).X; - 1: result := TXYZA(AColor^).Y; - 2: result := TXYZA(AColor^).Z; - 3: result := TXYZA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TXYZAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TXYZA(AColor^).X := AValue; - 1: TXYZA(AColor^).Y := AValue; - 2: TXYZA(AColor^).Z := AValue; - 3: TXYZA(AColor^).alpha := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TXYZAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfMovableReferenceWhite,cfHasImaginaryColors] end; - - -{ TWordXYZAColorspace } - -class function TWordXYZAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'X'; - 1: result := 'Y'; - 2: result := 'Z'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TWordXYZAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TWordXYZAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TWordXYZAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TWordXYZA(AColor^).alpha >= 65535 then exit(ctFullyOpaque) else - if TWordXYZA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TWordXYZAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 50000; - 1: result := 50000; - 2: result := 50000; - 3: result := 65535; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TWordXYZAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TWordXYZAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 16 end; - -class function TWordXYZAColorspace.GetName: string; -begin result := 'WordXYZA' end; - -class function TWordXYZAColorspace.GetSize: integer; -begin result := sizeof(TWordXYZA) end; - -class function TWordXYZAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TWordXYZA(AColor^).X; - 1: result := TWordXYZA(AColor^).Y; - 2: result := TWordXYZA(AColor^).Z; - 3: result := TWordXYZA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TWordXYZAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TWordXYZA(AColor^).X := Round(Clamp(AValue,0,50000)); - 1: TWordXYZA(AColor^).Y := Round(Clamp(AValue,0,50000)); - 2: TWordXYZA(AColor^).Z := Round(Clamp(AValue,0,50000)); - 3: TWordXYZA(AColor^).alpha := Round(Clamp(AValue,0,65535)); - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TWordXYZAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfMovableReferenceWhite,cfHasImaginaryColors] end; - - -{ TLabAColorspace } - -class function TLabAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Lightness'; - 1: result := 'a'; - 2: result := 'b'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLabAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TLabAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TLabAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TLabA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else - if TLabA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TLabAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 100; - 1: result := 142; - 2: result := 147; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLabAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := -166; - 2: result := -132; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLabAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TLabAColorspace.GetName: string; -begin result := 'LabA' end; - -class function TLabAColorspace.GetSize: integer; -begin result := sizeof(TLabA) end; - -class function TLabAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TLabA(AColor^).L; - 1: result := TLabA(AColor^).a; - 2: result := TLabA(AColor^).b; - 3: result := TLabA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TLabAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TLabA(AColor^).L := AValue; - 1: TLabA(AColor^).a := AValue; - 2: TLabA(AColor^).b := AValue; - 3: TLabA(AColor^).alpha := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLabAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfReferenceWhiteIndependent,cfHasImaginaryColors] end; - - -{ TLChAColorspace } - -class function TLChAColorspace.GetChannelName(AIndex: integer): string; -begin - case AIndex of - 0: result := 'Lightness'; - 1: result := 'Chroma'; - 2: result := 'Hue'; - 3: result := 'Alpha'; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLChAColorspace.GetChannelCount: integer; -begin result := 4 end; - -class function TLChAColorspace.IndexOfAlphaChannel: integer; -begin result := 3 end; - -class function TLChAColorspace.GetColorTransparency(AColor: Pointer): TColorTransparency; -begin - if TLChA(AColor^).alpha >= 1 then exit(ctFullyOpaque) else - if TLChA(AColor^).alpha <= 0 then exit(ctFullyTransparent) else - exit(ctSemiTransparent) -end; - -class function TLChAColorspace.GetMaxValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 100; - 1: result := 192; - 2: result := 360; - 3: result := 1; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLChAColorspace.GetMinValue(AIndex: integer): single; -begin - case AIndex of - 0: result := 0; - 1: result := 0; - 2: result := 0; - 3: result := 0; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLChAColorspace.GetChannelBitDepth(AIndex: integer): byte; -begin result := 28 end; - -class function TLChAColorspace.GetName: string; -begin result := 'LChA' end; - -class function TLChAColorspace.GetSize: integer; -begin result := sizeof(TLChA) end; - -class function TLChAColorspace.GetChannel(AColor: Pointer; AIndex: integer): single; -begin - case AIndex of - 0: result := TLChA(AColor^).L; - 1: result := TLChA(AColor^).C; - 2: result := TLChA(AColor^).h; - 3: result := TLChA(AColor^).alpha; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class procedure TLChAColorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single); -begin - case AIndex of - 0: TLChA(AColor^).L := AValue; - 1: TLChA(AColor^).C := AValue; - 2: TLChA(AColor^).h := AValue; - 3: TLChA(AColor^).alpha := AValue; - else raise ERangeError.Create('Index out of bounds'); - end; -end; - -class function TLChAColorspace.GetFlags: TColorspaceFlags; -begin result := [cfReferenceWhiteIndependent,cfHasImaginaryColors] end; - - -{ TColorHelper } - -class function TColorHelper.New(const ARed,AGreen,ABlue:byte): TColor; -begin Result := BGRAGraphics.RGBToColor(ARed,AGreen,ABlue) end; - -class function TColorHelper.Colorspace: TColorspaceAny; static; -begin result := TColorColorspace end; - -function TColorHelper.GetRed: byte; -begin result := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}(self shr 16) and $ff{$ELSE}self and $ff{$ENDIF} end; - -function TColorHelper.GetGreen: byte; -begin result := (self shr 8) and $ff end; - -function TColorHelper.GetBlue: byte; -begin result := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}self and $ff{$ELSE}(self shr 16) and $ff{$ENDIF} end; - -procedure TColorHelper.SetRed(AValue: byte); -begin self := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}LongWord(self and $00ffff) or (AValue shl 16){$ELSE}LongWord(self and $ffff00) or AValue{$ENDIF} end; - -procedure TColorHelper.SetGreen(AValue: byte); -begin self := LongWord(self and $ff00ff) or (AValue shl 8) end; - -procedure TColorHelper.SetBlue(AValue: byte); -begin self := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}LongWord(self and $ffff00) or AValue{$ELSE}LongWord(self and $00ffff) or (AValue shl 16){$ENDIF} end; - -function TColorHelper.ToBGRAPixel: TBGRAPixel;overload; -begin Result := ColorToBGRA(Self) end; - -function TColorHelper.ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; -begin result := ColorToBGRA(Self, AAlpha) end; - -function TColorHelper.ToFPColor: TFPColor;overload; -begin Result := ColorToFPColor(Self) end; - -function TColorHelper.ToFPColor(AAlpha: word): TFPColor;overload; -begin result := ColorToFPColor(Self, AAlpha) end; - -function TColorHelper.ToStdRGBA: TStdRGBA;overload; -begin Result := ColorToStdRGBA(Self) end; - -function TColorHelper.ToStdRGBA(AAlpha: single): TStdRGBA;overload; -begin result := ColorToStdRGBA(Self, AAlpha) end; - -function TColorHelper.ToAdobeRGBA: TAdobeRGBA;overload; -begin Result := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; -begin - Result := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TColorHelper.ToStdHSLA: TStdHSLA;overload; -begin Result := ColorToStdHSLA(Self) end; - -function TColorHelper.ToStdHSLA(AAlpha: single): TStdHSLA;overload; -begin result := ColorToStdHSLA(Self, AAlpha) end; - -function TColorHelper.ToStdHSVA: TStdHSVA;overload; -begin Result := ColorToStdHSVA(Self) end; - -function TColorHelper.ToStdHSVA(AAlpha: single): TStdHSVA;overload; -begin result := ColorToStdHSVA(Self, AAlpha) end; - -function TColorHelper.ToStdCMYK: TStdCMYK; -begin Result := ColorToStdCMYK(Self) end; - -function TColorHelper.ToByteMask: TByteMask; -begin Result := ColorToByteMask(Self) end; - -function TColorHelper.ToExpandedPixel: TExpandedPixel;overload; -begin Result := ColorToExpandedPixel(Self) end; - -function TColorHelper.ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; -begin result := ColorToExpandedPixel(Self, AAlpha) end; - -function TColorHelper.ToLinearRGBA: TLinearRGBA;overload; -begin Result := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; -begin - Result := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TColorHelper.ToHSLAPixel: THSLAPixel;overload; -begin Result := ExpandedToHSLA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToHSLAPixel(AAlpha: word): THSLAPixel;overload; -begin - Result := ExpandedToHSLA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TColorHelper.ToGSBAPixel: TGSBAPixel;overload; -begin Result := ExpandedToGSBA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; -begin - Result := ExpandedToGSBA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TColorHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToXYZA(AAlpha: single): TXYZA;overload; -begin - Result := ExpandedPixelToXYZA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TColorHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(ColorToExpandedPixel(Self),AReferenceWhite) end; - -function TColorHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToWordXYZA(AAlpha: word): TWordXYZA;overload; -begin - Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TColorHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(Self),AReferenceWhite) end; - -function TColorHelper.ToLabA: TLabA;overload; -begin Result := ExpandedPixelToLabA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToLabA(AAlpha: single): TLabA;overload; -begin - Result := ExpandedPixelToLabA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TColorHelper.ToLChA: TLChA;overload; -begin Result := ExpandedPixelToLChA(ColorToExpandedPixel(Self)) end; - -function TColorHelper.ToLChA(AAlpha: single): TLChA;overload; -begin - Result := ExpandedPixelToLChA(ColorToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -procedure TColorHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := BGRAToColor(AValue) end; - -procedure TColorHelper.FromFPColor(AValue: TFPColor); -begin Self := FPColorToColor(AValue) end; - -procedure TColorHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := StdRGBAToColor(AValue) end; - -procedure TColorHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedPixelToColor(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TColorHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := StdHSLAToColor(AValue) end; - -procedure TColorHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := StdHSVAToColor(AValue) end; - -procedure TColorHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := StdCMYKToColor(AValue) end; - -procedure TColorHelper.FromByteMask(AValue: TByteMask); -begin Self := ByteMaskToColor(AValue) end; - -procedure TColorHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToColor(AValue) end; - -procedure TColorHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedPixelToColor(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TColorHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToColor(HSLAToExpanded(AValue)) end; - -procedure TColorHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToColor(GSBAToExpanded(AValue)) end; - -procedure TColorHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedPixelToColor(XYZAToExpandedPixel(AValue)) end; - -procedure TColorHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToColor(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TColorHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedPixelToColor(WordXYZAToExpandedPixel(AValue)) end; - -procedure TColorHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToColor(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TColorHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedPixelToColor(LabAToExpandedPixel(AValue)) end; - -procedure TColorHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedPixelToColor(LChAToExpandedPixel(AValue)) end; - -{ TBGRAPixelHelper } - -class function TBGRAPixelHelper.New(const ARed,AGreen,ABlue,AAlpha:byte): TBGRAPixel;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := AAlpha; -end; - -class function TBGRAPixelHelper.New(const ARed,AGreen,ABlue:byte): TBGRAPixel;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := 255; -end; - -class function TBGRAPixelHelper.Colorspace: TColorspaceAny; static; -begin result := TBGRAPixelColorspace end; - -function TBGRAPixelHelper.ToStdRGBA: TStdRGBA; -begin Result := BGRAPixelToStdRGBA(Self) end; - -function TBGRAPixelHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(GammaExpansion(Self)) end; - -function TBGRAPixelHelper.ToStdHSLA: TStdHSLA; -begin Result := BGRAPixelToStdHSLA(Self) end; - -function TBGRAPixelHelper.ToStdHSVA: TStdHSVA; -begin Result := BGRAPixelToStdHSVA(Self) end; - -function TBGRAPixelHelper.ToStdCMYK: TStdCMYK; -begin Result := BGRAPixelToStdCMYK(Self) end; - -function TBGRAPixelHelper.ToByteMask: TByteMask; -begin Result := BGRAToMask(Self) end; - -function TBGRAPixelHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(GammaExpansion(Self)) end; - -function TBGRAPixelHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(GammaExpansion(Self)) end; - -function TBGRAPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(GammaExpansion(Self),AReferenceWhite) end; - -function TBGRAPixelHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(GammaExpansion(Self)) end; - -function TBGRAPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(GammaExpansion(Self),AReferenceWhite) end; - -function TBGRAPixelHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(GammaExpansion(Self)) end; - -function TBGRAPixelHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(GammaExpansion(Self)) end; - -procedure TBGRAPixelHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := StdRGBAToBGRAPixel(AValue) end; - -procedure TBGRAPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := GammaCompression(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TBGRAPixelHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := StdHSLAToBGRAPixel(AValue) end; - -procedure TBGRAPixelHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := StdHSVAToBGRAPixel(AValue) end; - -procedure TBGRAPixelHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := StdCMYKToBGRAPixel(AValue) end; - -procedure TBGRAPixelHelper.FromByteMask(AValue: TByteMask); -begin Self := MaskToBGRA(AValue) end; - -procedure TBGRAPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := GammaCompression(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TBGRAPixelHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := GammaCompression(XYZAToExpandedPixel(AValue)) end; - -procedure TBGRAPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := GammaCompression(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TBGRAPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := GammaCompression(WordXYZAToExpandedPixel(AValue)) end; - -procedure TBGRAPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := GammaCompression(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TBGRAPixelHelper.FromLabA(AValue: TLabA); -begin Self := GammaCompression(LabAToExpandedPixel(AValue)) end; - -procedure TBGRAPixelHelper.FromLChA(AValue: TLChA); -begin Self := GammaCompression(LChAToExpandedPixel(AValue)) end; - -{ TFPColorHelper } - -class function TFPColorHelper.New(const ARed,AGreen,ABlue,AAlpha:word): TFPColor;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := AAlpha; -end; - -class function TFPColorHelper.New(const ARed,AGreen,ABlue:word): TFPColor;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := 65535; -end; - -class function TFPColorHelper.Colorspace: TColorspaceAny; static; -begin result := TFPColorColorspace end; - -function TFPColorHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToByteMask: TByteMask; -begin Result := FPColorToByteMask(Self) end; - -function TFPColorHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(FPColorToExpanded(Self),AReferenceWhite) end; - -function TFPColorHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(FPColorToExpanded(Self),AReferenceWhite) end; - -function TFPColorHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(FPColorToExpanded(Self)) end; - -function TFPColorHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(FPColorToExpanded(Self)) end; - -procedure TFPColorHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := ExpandedToFPColor(StdRGBAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedToFPColor(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := ExpandedToFPColor(StdHSLAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := ExpandedToFPColor(StdHSVAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := ExpandedToFPColor(StdCMYKToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromByteMask(AValue: TByteMask); -begin Self := ByteMaskToFPColor(AValue) end; - -procedure TFPColorHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedToFPColor(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedToFPColor(XYZAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedToFPColor(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TFPColorHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedToFPColor(WordXYZAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedToFPColor(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TFPColorHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedToFPColor(LabAToExpandedPixel(AValue)) end; - -procedure TFPColorHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedToFPColor(LChAToExpandedPixel(AValue)) end; - -{ TStdRGBAHelper } - -class function TStdRGBAHelper.Colorspace: TColorspaceAny; static; -begin result := TStdRGBAColorspace end; - -function TStdRGBAHelper.ToColor: TColor; -begin Result := StdRGBAToColor(Self) end; - -function TStdRGBAHelper.ToBGRAPixel: TBGRAPixel; -begin Result := StdRGBAToBGRAPixel(Self) end; - -function TStdRGBAHelper.ToFPColor: TFPColor; -begin Result := ExpandedToFPColor(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToStdHSLA: TStdHSLA; -begin Result := StdRGBAToStdHSLA(Self) end; - -function TStdRGBAHelper.ToStdHSVA: TStdHSVA; -begin Result := StdRGBAToStdHSVA(Self) end; - -function TStdRGBAHelper.ToStdCMYK: TStdCMYK; -begin Result := StdRGBAToStdCMYK(Self) end; - -function TStdRGBAHelper.ToByteMask: TByteMask; -begin Result := StdRGBAToByteMask(Self) end; - -function TStdRGBAHelper.ToExpandedPixel: TExpandedPixel; -begin Result := StdRGBAToExpandedPixel(Self) end; - -function TStdRGBAHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToHSLAPixel: THSLAPixel; -begin Result := ExpandedToHSLA(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToGSBAPixel: TGSBAPixel; -begin Result := ExpandedToGSBA(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(Self),AReferenceWhite) end; - -function TStdRGBAHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(Self),AReferenceWhite) end; - -function TStdRGBAHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(StdRGBAToExpandedPixel(Self)) end; - -function TStdRGBAHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(StdRGBAToExpandedPixel(Self)) end; - -procedure TStdRGBAHelper.FromColor(AValue: TColor); -begin Self := ColorToStdRGBA(AValue) end; - -procedure TStdRGBAHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := BGRAPixelToStdRGBA(AValue) end; - -procedure TStdRGBAHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToStdRGBA(FPColorToExpanded(AValue)) end; - -procedure TStdRGBAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedPixelToStdRGBA(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TStdRGBAHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := StdHSLAToStdRGBA(AValue) end; - -procedure TStdRGBAHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := StdHSVAToStdRGBA(AValue) end; - -procedure TStdRGBAHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := StdCMYKToStdRGBA(AValue) end; - -procedure TStdRGBAHelper.FromByteMask(AValue: TByteMask); -begin Self := ByteMaskToStdRGBA(AValue) end; - -procedure TStdRGBAHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToStdRGBA(AValue) end; - -procedure TStdRGBAHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedPixelToStdRGBA(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TStdRGBAHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToStdRGBA(HSLAToExpanded(AValue)) end; - -procedure TStdRGBAHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToStdRGBA(GSBAToExpanded(AValue)) end; - -procedure TStdRGBAHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(AValue)) end; - -procedure TStdRGBAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdRGBAHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(AValue)) end; - -procedure TStdRGBAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdRGBAHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedPixelToStdRGBA(LabAToExpandedPixel(AValue)) end; - -procedure TStdRGBAHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedPixelToStdRGBA(LChAToExpandedPixel(AValue)) end; - -{ TAdobeRGBAHelper } - -class function TAdobeRGBAHelper.Colorspace: TColorspaceAny; static; -begin result := TAdobeRGBAColorspace end; - -function TAdobeRGBAHelper.ToColor: TColor; -begin Result := ExpandedPixelToColor(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToBGRAPixel: TBGRAPixel; -begin Result := GammaCompression(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToFPColor: TFPColor; -begin Result := ExpandedToFPColor(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToByteMask: TByteMask; -begin Result := ExpandedPixelToByteMask(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToExpandedPixel: TExpandedPixel; -begin Result := AdobeRGBAToExpandedPixel(Self) end; - -function TAdobeRGBAHelper.ToLinearRGBA: TLinearRGBA; -begin Result := AdobeRGBAToLinearRGBA(Self) end; - -function TAdobeRGBAHelper.ToHSLAPixel: THSLAPixel; -begin Result := ExpandedToHSLA(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToGSBAPixel: TGSBAPixel; -begin Result := ExpandedToGSBA(AdobeRGBAToExpandedPixel(Self)) end; - -function TAdobeRGBAHelper.ToXYZA: TXYZA;overload; -begin Result := AdobeRGBAToXYZA(Self) end; - -function TAdobeRGBAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := AdobeRGBAToXYZA(Self,AReferenceWhite) end; - -function TAdobeRGBAHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := AdobeRGBAToWordXYZA(Self) end; - -function TAdobeRGBAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := AdobeRGBAToWordXYZA(Self,AReferenceWhite) end; - -function TAdobeRGBAHelper.ToLabA: TLabA; -begin Result := AdobeRGBAToLabA(Self) end; - -function TAdobeRGBAHelper.ToLChA: TLChA; -begin Result := AdobeRGBAToLChA(Self) end; - -procedure TAdobeRGBAHelper.FromColor(AValue: TColor); -begin Self := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(AValue)) end; - -procedure TAdobeRGBAHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := ExpandedPixelToAdobeRGBA(GammaExpansion(AValue)) end; - -procedure TAdobeRGBAHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToAdobeRGBA(FPColorToExpanded(AValue)) end; - -procedure TAdobeRGBAHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := ExpandedPixelToAdobeRGBA(StdRGBAToExpandedPixel(AValue)) end; - -procedure TAdobeRGBAHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := ExpandedPixelToAdobeRGBA(StdHSLAToExpandedPixel(AValue)) end; - -procedure TAdobeRGBAHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := ExpandedPixelToAdobeRGBA(StdHSVAToExpandedPixel(AValue)) end; - -procedure TAdobeRGBAHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(AValue)) end; - -procedure TAdobeRGBAHelper.FromByteMask(AValue: TByteMask); -begin Self := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(AValue)) end; - -procedure TAdobeRGBAHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToAdobeRGBA(AValue) end; - -procedure TAdobeRGBAHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := LinearRGBAToAdobeRGBA(AValue) end; - -procedure TAdobeRGBAHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToAdobeRGBA(HSLAToExpanded(AValue)) end; - -procedure TAdobeRGBAHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToAdobeRGBA(GSBAToExpanded(AValue)) end; - -procedure TAdobeRGBAHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := XYZAToAdobeRGBA(AValue) end; - -procedure TAdobeRGBAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := XYZAToAdobeRGBA(AValue,AReferenceWhite) end; - -procedure TAdobeRGBAHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := WordXYZAToAdobeRGBA(AValue) end; - -procedure TAdobeRGBAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := WordXYZAToAdobeRGBA(AValue,AReferenceWhite) end; - -procedure TAdobeRGBAHelper.FromLabA(AValue: TLabA); -begin Self := LabAToAdobeRGBA(AValue) end; - -procedure TAdobeRGBAHelper.FromLChA(AValue: TLChA); -begin Self := LChAToAdobeRGBA(AValue) end; - -{ TStdHSLAHelper } - -class function TStdHSLAHelper.Colorspace: TColorspaceAny; static; -begin result := TStdHSLAColorspace end; - -function TStdHSLAHelper.ToColor: TColor; -begin Result := StdHSLAToColor(Self) end; - -function TStdHSLAHelper.ToBGRAPixel: TBGRAPixel; -begin Result := StdHSLAToBGRAPixel(Self) end; - -function TStdHSLAHelper.ToFPColor: TFPColor; -begin Result := ExpandedToFPColor(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToStdRGBA: TStdRGBA; -begin Result := StdHSLAToStdRGBA(Self) end; - -function TStdHSLAHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToStdHSVA: TStdHSVA; -begin Result := StdHSLAToStdHSVA(Self) end; - -function TStdHSLAHelper.ToStdCMYK: TStdCMYK; -begin Result := StdHSLAToStdCMYK(Self) end; - -function TStdHSLAHelper.ToByteMask: TByteMask; -begin Result := StdHSLAToByteMask(Self) end; - -function TStdHSLAHelper.ToExpandedPixel: TExpandedPixel; -begin Result := StdHSLAToExpandedPixel(Self) end; - -function TStdHSLAHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToHSLAPixel: THSLAPixel; -begin Result := ExpandedToHSLA(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToGSBAPixel: TGSBAPixel; -begin Result := ExpandedToGSBA(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(Self),AReferenceWhite) end; - -function TStdHSLAHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(Self),AReferenceWhite) end; - -function TStdHSLAHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(StdHSLAToExpandedPixel(Self)) end; - -function TStdHSLAHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(StdHSLAToExpandedPixel(Self)) end; - -procedure TStdHSLAHelper.FromColor(AValue: TColor); -begin Self := ColorToStdHSLA(AValue) end; - -procedure TStdHSLAHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := BGRAPixelToStdHSLA(AValue) end; - -procedure TStdHSLAHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToStdHSLA(FPColorToExpanded(AValue)) end; - -procedure TStdHSLAHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := StdRGBAToStdHSLA(AValue) end; - -procedure TStdHSLAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedPixelToStdHSLA(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TStdHSLAHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := StdHSVAToStdHSLA(AValue) end; - -procedure TStdHSLAHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := StdCMYKToStdHSLA(AValue) end; - -procedure TStdHSLAHelper.FromByteMask(AValue: TByteMask); -begin Self := ByteMaskToStdHSLA(AValue) end; - -procedure TStdHSLAHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToStdHSLA(AValue) end; - -procedure TStdHSLAHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedPixelToStdHSLA(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TStdHSLAHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToStdHSLA(HSLAToExpanded(AValue)) end; - -procedure TStdHSLAHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToStdHSLA(GSBAToExpanded(AValue)) end; - -procedure TStdHSLAHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(AValue)) end; - -procedure TStdHSLAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdHSLAHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(AValue)) end; - -procedure TStdHSLAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdHSLAHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedPixelToStdHSLA(LabAToExpandedPixel(AValue)) end; - -procedure TStdHSLAHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedPixelToStdHSLA(LChAToExpandedPixel(AValue)) end; - -{ TStdHSVAHelper } - -class function TStdHSVAHelper.Colorspace: TColorspaceAny; static; -begin result := TStdHSVAColorspace end; - -function TStdHSVAHelper.ToColor: TColor; -begin Result := StdHSVAToColor(Self) end; - -function TStdHSVAHelper.ToBGRAPixel: TBGRAPixel; -begin Result := StdHSVAToBGRAPixel(Self) end; - -function TStdHSVAHelper.ToFPColor: TFPColor; -begin Result := ExpandedToFPColor(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToStdRGBA: TStdRGBA; -begin Result := StdHSVAToStdRGBA(Self) end; - -function TStdHSVAHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToStdHSLA: TStdHSLA; -begin Result := StdHSVAToStdHSLA(Self) end; - -function TStdHSVAHelper.ToStdCMYK: TStdCMYK; -begin Result := StdHSVAToStdCMYK(Self) end; - -function TStdHSVAHelper.ToByteMask: TByteMask; -begin Result := StdHSVAToByteMask(Self) end; - -function TStdHSVAHelper.ToExpandedPixel: TExpandedPixel; -begin Result := StdHSVAToExpandedPixel(Self) end; - -function TStdHSVAHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToHSLAPixel: THSLAPixel; -begin Result := ExpandedToHSLA(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToGSBAPixel: TGSBAPixel; -begin Result := ExpandedToGSBA(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(Self),AReferenceWhite) end; - -function TStdHSVAHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(Self),AReferenceWhite) end; - -function TStdHSVAHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(StdHSVAToExpandedPixel(Self)) end; - -function TStdHSVAHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(StdHSVAToExpandedPixel(Self)) end; - -procedure TStdHSVAHelper.FromColor(AValue: TColor); -begin Self := ColorToStdHSVA(AValue) end; - -procedure TStdHSVAHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := BGRAPixelToStdHSVA(AValue) end; - -procedure TStdHSVAHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToStdHSVA(FPColorToExpanded(AValue)) end; - -procedure TStdHSVAHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := StdRGBAToStdHSVA(AValue) end; - -procedure TStdHSVAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedPixelToStdHSVA(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TStdHSVAHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := StdHSLAToStdHSVA(AValue) end; - -procedure TStdHSVAHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := StdCMYKToStdHSVA(AValue) end; - -procedure TStdHSVAHelper.FromByteMask(AValue: TByteMask); -begin Self := ByteMaskToStdHSVA(AValue) end; - -procedure TStdHSVAHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToStdHSVA(AValue) end; - -procedure TStdHSVAHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedPixelToStdHSVA(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TStdHSVAHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToStdHSVA(HSLAToExpanded(AValue)) end; - -procedure TStdHSVAHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToStdHSVA(GSBAToExpanded(AValue)) end; - -procedure TStdHSVAHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(AValue)) end; - -procedure TStdHSVAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdHSVAHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(AValue)) end; - -procedure TStdHSVAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdHSVAHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedPixelToStdHSVA(LabAToExpandedPixel(AValue)) end; - -procedure TStdHSVAHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedPixelToStdHSVA(LChAToExpandedPixel(AValue)) end; - -{ TStdCMYKHelper } - -class function TStdCMYKHelper.Colorspace: TColorspaceAny; static; -begin result := TStdCMYKColorspace end; - -function TStdCMYKHelper.ToColor: TColor; -begin Result := StdCMYKToColor(Self) end; - -function TStdCMYKHelper.ToBGRAPixel: TBGRAPixel;overload; -begin Result := StdCMYKToBGRAPixel(Self) end; - -function TStdCMYKHelper.ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; -begin result := StdCMYKToBGRAPixel(Self, AAlpha) end; - -function TStdCMYKHelper.ToFPColor: TFPColor;overload; -begin Result := ExpandedToFPColor(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToFPColor(AAlpha: word): TFPColor;overload; -begin - Result := ExpandedToFPColor(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToStdRGBA: TStdRGBA;overload; -begin Result := StdCMYKToStdRGBA(Self) end; - -function TStdCMYKHelper.ToStdRGBA(AAlpha: single): TStdRGBA;overload; -begin result := StdCMYKToStdRGBA(Self, AAlpha) end; - -function TStdCMYKHelper.ToAdobeRGBA: TAdobeRGBA;overload; -begin Result := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; -begin - Result := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToStdHSLA: TStdHSLA;overload; -begin Result := StdCMYKToStdHSLA(Self) end; - -function TStdCMYKHelper.ToStdHSLA(AAlpha: single): TStdHSLA;overload; -begin result := StdCMYKToStdHSLA(Self, AAlpha) end; - -function TStdCMYKHelper.ToStdHSVA: TStdHSVA;overload; -begin Result := StdCMYKToStdHSVA(Self) end; - -function TStdCMYKHelper.ToStdHSVA(AAlpha: single): TStdHSVA;overload; -begin result := StdCMYKToStdHSVA(Self, AAlpha) end; - -function TStdCMYKHelper.ToByteMask: TByteMask; -begin Result := StdCMYKToByteMask(Self) end; - -function TStdCMYKHelper.ToExpandedPixel: TExpandedPixel;overload; -begin Result := StdCMYKToExpandedPixel(Self) end; - -function TStdCMYKHelper.ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; -begin result := StdCMYKToExpandedPixel(Self, AAlpha) end; - -function TStdCMYKHelper.ToLinearRGBA: TLinearRGBA;overload; -begin Result := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; -begin - Result := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToHSLAPixel: THSLAPixel;overload; -begin Result := ExpandedToHSLA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToHSLAPixel(AAlpha: word): THSLAPixel;overload; -begin - Result := ExpandedToHSLA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToGSBAPixel: TGSBAPixel;overload; -begin Result := ExpandedToGSBA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; -begin - Result := ExpandedToGSBA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToXYZA(AAlpha: single): TXYZA;overload; -begin - Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(Self),AReferenceWhite) end; - -function TStdCMYKHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToWordXYZA(AAlpha: word): TWordXYZA;overload; -begin - Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(Self),AReferenceWhite) end; - -function TStdCMYKHelper.ToLabA: TLabA;overload; -begin Result := ExpandedPixelToLabA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToLabA(AAlpha: single): TLabA;overload; -begin - Result := ExpandedPixelToLabA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TStdCMYKHelper.ToLChA: TLChA;overload; -begin Result := ExpandedPixelToLChA(StdCMYKToExpandedPixel(Self)) end; - -function TStdCMYKHelper.ToLChA(AAlpha: single): TLChA;overload; -begin - Result := ExpandedPixelToLChA(StdCMYKToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -procedure TStdCMYKHelper.FromColor(AValue: TColor); -begin Self := ColorToStdCMYK(AValue) end; - -procedure TStdCMYKHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := BGRAPixelToStdCMYK(AValue) end; - -procedure TStdCMYKHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToStdCMYK(FPColorToExpanded(AValue)) end; - -procedure TStdCMYKHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := StdRGBAToStdCMYK(AValue) end; - -procedure TStdCMYKHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedPixelToStdCMYK(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TStdCMYKHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := StdHSLAToStdCMYK(AValue) end; - -procedure TStdCMYKHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := StdHSVAToStdCMYK(AValue) end; - -procedure TStdCMYKHelper.FromByteMask(AValue: TByteMask); -begin Self := ByteMaskToStdCMYK(AValue) end; - -procedure TStdCMYKHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToStdCMYK(AValue) end; - -procedure TStdCMYKHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedPixelToStdCMYK(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TStdCMYKHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToStdCMYK(HSLAToExpanded(AValue)) end; - -procedure TStdCMYKHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToStdCMYK(GSBAToExpanded(AValue)) end; - -procedure TStdCMYKHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(AValue)) end; - -procedure TStdCMYKHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdCMYKHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(AValue)) end; - -procedure TStdCMYKHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TStdCMYKHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedPixelToStdCMYK(LabAToExpandedPixel(AValue)) end; - -procedure TStdCMYKHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedPixelToStdCMYK(LChAToExpandedPixel(AValue)) end; - -{ TByteMaskHelper } - -class function TByteMaskHelper.Colorspace: TColorspaceAny; static; -begin result := TByteMaskColorspace end; - -function TByteMaskHelper.ToColor: TColor; -begin Result := ByteMaskToColor(Self) end; - -function TByteMaskHelper.ToBGRAPixel: TBGRAPixel;overload; -begin Result := MaskToBGRA(Self) end; - -function TByteMaskHelper.ToBGRAPixel(AAlpha: byte): TBGRAPixel;overload; -begin result := MaskToBGRA(Self, AAlpha) end; - -function TByteMaskHelper.ToFPColor: TFPColor;overload; -begin Result := ByteMaskToFPColor(Self) end; - -function TByteMaskHelper.ToFPColor(AAlpha: word): TFPColor;overload; -begin result := ByteMaskToFPColor(Self, AAlpha) end; - -function TByteMaskHelper.ToStdRGBA: TStdRGBA;overload; -begin Result := ByteMaskToStdRGBA(Self) end; - -function TByteMaskHelper.ToStdRGBA(AAlpha: single): TStdRGBA;overload; -begin result := ByteMaskToStdRGBA(Self, AAlpha) end; - -function TByteMaskHelper.ToAdobeRGBA: TAdobeRGBA;overload; -begin Result := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToAdobeRGBA(AAlpha: byte): TAdobeRGBA;overload; -begin - Result := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TByteMaskHelper.ToStdHSLA: TStdHSLA;overload; -begin Result := ByteMaskToStdHSLA(Self) end; - -function TByteMaskHelper.ToStdHSLA(AAlpha: single): TStdHSLA;overload; -begin result := ByteMaskToStdHSLA(Self, AAlpha) end; - -function TByteMaskHelper.ToStdHSVA: TStdHSVA;overload; -begin Result := ByteMaskToStdHSVA(Self) end; - -function TByteMaskHelper.ToStdHSVA(AAlpha: single): TStdHSVA;overload; -begin result := ByteMaskToStdHSVA(Self, AAlpha) end; - -function TByteMaskHelper.ToStdCMYK: TStdCMYK; -begin Result := ByteMaskToStdCMYK(Self) end; - -function TByteMaskHelper.ToExpandedPixel: TExpandedPixel;overload; -begin Result := ByteMaskToExpandedPixel(Self) end; - -function TByteMaskHelper.ToExpandedPixel(AAlpha: word): TExpandedPixel;overload; -begin result := ByteMaskToExpandedPixel(Self, AAlpha) end; - -function TByteMaskHelper.ToLinearRGBA: TLinearRGBA;overload; -begin Result := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToLinearRGBA(AAlpha: single): TLinearRGBA;overload; -begin - Result := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TByteMaskHelper.ToHSLAPixel: THSLAPixel;overload; -begin Result := ExpandedToHSLA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToHSLAPixel(AAlpha: word): THSLAPixel;overload; -begin - Result := ExpandedToHSLA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TByteMaskHelper.ToGSBAPixel: TGSBAPixel;overload; -begin Result := ExpandedToGSBA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToGSBAPixel(AAlpha: word): TGSBAPixel;overload; -begin - Result := ExpandedToGSBA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TByteMaskHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToXYZA(AAlpha: single): TXYZA;overload; -begin - Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TByteMaskHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(Self),AReferenceWhite) end; - -function TByteMaskHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToWordXYZA(AAlpha: word): TWordXYZA;overload; -begin - Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TByteMaskHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(Self),AReferenceWhite) end; - -function TByteMaskHelper.ToLabA: TLabA;overload; -begin Result := ExpandedPixelToLabA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToLabA(AAlpha: single): TLabA;overload; -begin - Result := ExpandedPixelToLabA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -function TByteMaskHelper.ToLChA: TLChA;overload; -begin Result := ExpandedPixelToLChA(ByteMaskToExpandedPixel(Self)) end; - -function TByteMaskHelper.ToLChA(AAlpha: single): TLChA;overload; -begin - Result := ExpandedPixelToLChA(ByteMaskToExpandedPixel(Self)); - result.alpha := AAlpha; -end; - -procedure TByteMaskHelper.FromColor(AValue: TColor); -begin Self := ColorToByteMask(AValue) end; - -procedure TByteMaskHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := BGRAToMask(AValue) end; - -procedure TByteMaskHelper.FromFPColor(AValue: TFPColor); -begin Self := FPColorToByteMask(AValue) end; - -procedure TByteMaskHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := StdRGBAToByteMask(AValue) end; - -procedure TByteMaskHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedPixelToByteMask(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TByteMaskHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := StdHSLAToByteMask(AValue) end; - -procedure TByteMaskHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := StdHSVAToByteMask(AValue) end; - -procedure TByteMaskHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := StdCMYKToByteMask(AValue) end; - -procedure TByteMaskHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToByteMask(AValue) end; - -procedure TByteMaskHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedPixelToByteMask(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TByteMaskHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToByteMask(HSLAToExpanded(AValue)) end; - -procedure TByteMaskHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToByteMask(GSBAToExpanded(AValue)) end; - -procedure TByteMaskHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedPixelToByteMask(XYZAToExpandedPixel(AValue)) end; - -procedure TByteMaskHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToByteMask(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TByteMaskHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(AValue)) end; - -procedure TByteMaskHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TByteMaskHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedPixelToByteMask(LabAToExpandedPixel(AValue)) end; - -procedure TByteMaskHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedPixelToByteMask(LChAToExpandedPixel(AValue)) end; - -{ TExpandedPixelHelper } - -class function TExpandedPixelHelper.New(const ARed,AGreen,ABlue,AAlpha:word): TExpandedPixel;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := AAlpha; -end; - -class function TExpandedPixelHelper.New(const ARed,AGreen,ABlue:word): TExpandedPixel;overload; -begin - Result.red := ARed; - Result.green := AGreen; - Result.blue := ABlue; - Result.alpha := 65535; -end; - -class function TExpandedPixelHelper.Colorspace: TColorspaceAny; static; -begin result := TExpandedPixelColorspace end; - -function TExpandedPixelHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(Self) end; - -function TExpandedPixelHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(Self) end; - -function TExpandedPixelHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(Self) end; - -function TExpandedPixelHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(Self) end; - -function TExpandedPixelHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(Self) end; - -function TExpandedPixelHelper.ToByteMask: TByteMask; -begin Result := ExpandedPixelToByteMask(Self) end; - -function TExpandedPixelHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(Self) end; - -function TExpandedPixelHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(Self) end; - -function TExpandedPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(Self,AReferenceWhite) end; - -function TExpandedPixelHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(Self) end; - -function TExpandedPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(Self,AReferenceWhite) end; - -function TExpandedPixelHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(Self) end; - -function TExpandedPixelHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(Self) end; - -procedure TExpandedPixelHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := StdRGBAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := AdobeRGBAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := StdHSLAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := StdHSVAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := StdCMYKToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromByteMask(AValue: TByteMask); -begin Self := ByteMaskToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := LinearRGBAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := XYZAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := XYZAToExpandedPixel(AValue,AReferenceWhite) end; - -procedure TExpandedPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := WordXYZAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := WordXYZAToExpandedPixel(AValue,AReferenceWhite) end; - -procedure TExpandedPixelHelper.FromLabA(AValue: TLabA); -begin Self := LabAToExpandedPixel(AValue) end; - -procedure TExpandedPixelHelper.FromLChA(AValue: TLChA); -begin Self := LChAToExpandedPixel(AValue) end; - -{ TLinearRGBAHelper } - -class function TLinearRGBAHelper.Colorspace: TColorspaceAny; static; -begin result := TLinearRGBAColorspace end; - -function TLinearRGBAHelper.ToColor: TColor; -begin Result := ExpandedPixelToColor(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToBGRAPixel: TBGRAPixel; -begin Result := GammaCompression(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToFPColor: TFPColor; -begin Result := ExpandedToFPColor(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := LinearRGBAToAdobeRGBA(Self) end; - -function TLinearRGBAHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToByteMask: TByteMask; -begin Result := ExpandedPixelToByteMask(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToExpandedPixel: TExpandedPixel; -begin Result := LinearRGBAToExpandedPixel(Self) end; - -function TLinearRGBAHelper.ToHSLAPixel: THSLAPixel; -begin Result := ExpandedToHSLA(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToGSBAPixel: TGSBAPixel; -begin Result := ExpandedToGSBA(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToXYZA: TXYZA;overload; -begin Result := LinearRGBAToXYZA(Self) end; - -function TLinearRGBAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := LinearRGBAToXYZA(Self,AReferenceWhite) end; - -function TLinearRGBAHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(Self)) end; - -function TLinearRGBAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(Self),AReferenceWhite) end; - -function TLinearRGBAHelper.ToLabA: TLabA; -begin Result := LinearRGBAToLabA(Self) end; - -function TLinearRGBAHelper.ToLChA: TLChA; -begin Result := LinearRGBAToLChA(Self) end; - -procedure TLinearRGBAHelper.FromColor(AValue: TColor); -begin Self := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(AValue)) end; - -procedure TLinearRGBAHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := ExpandedPixelToLinearRGBA(GammaExpansion(AValue)) end; - -procedure TLinearRGBAHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToLinearRGBA(FPColorToExpanded(AValue)) end; - -procedure TLinearRGBAHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := ExpandedPixelToLinearRGBA(StdRGBAToExpandedPixel(AValue)) end; - -procedure TLinearRGBAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := AdobeRGBAToLinearRGBA(AValue) end; - -procedure TLinearRGBAHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := ExpandedPixelToLinearRGBA(StdHSLAToExpandedPixel(AValue)) end; - -procedure TLinearRGBAHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := ExpandedPixelToLinearRGBA(StdHSVAToExpandedPixel(AValue)) end; - -procedure TLinearRGBAHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(AValue)) end; - -procedure TLinearRGBAHelper.FromByteMask(AValue: TByteMask); -begin Self := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(AValue)) end; - -procedure TLinearRGBAHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToLinearRGBA(AValue) end; - -procedure TLinearRGBAHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToLinearRGBA(HSLAToExpanded(AValue)) end; - -procedure TLinearRGBAHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToLinearRGBA(GSBAToExpanded(AValue)) end; - -procedure TLinearRGBAHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := XYZAToLinearRGBA(AValue) end; - -procedure TLinearRGBAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := XYZAToLinearRGBA(AValue,AReferenceWhite) end; - -procedure TLinearRGBAHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(AValue)) end; - -procedure TLinearRGBAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TLinearRGBAHelper.FromLabA(AValue: TLabA); -begin Self := LabAToLinearRGBA(AValue) end; - -procedure TLinearRGBAHelper.FromLChA(AValue: TLChA); -begin Self := LChAToLinearRGBA(AValue) end; - -{ THSLAPixelHelper } - -class function THSLAPixelHelper.New(const AHue,ASaturation,ALightness,AAlpha:word): THSLAPixel;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.lightness := ALightness; - Result.alpha := AAlpha; -end; - -class function THSLAPixelHelper.New(const AHue,ASaturation,ALightness:word): THSLAPixel;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.lightness := ALightness; - Result.alpha := 65535; -end; - -class function THSLAPixelHelper.Colorspace: TColorspaceAny; static; -begin result := THSLAPixelColorspace end; - -function THSLAPixelHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToByteMask: TByteMask; -begin Result := ExpandedPixelToByteMask(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(HSLAToExpanded(Self),AReferenceWhite) end; - -function THSLAPixelHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(HSLAToExpanded(Self),AReferenceWhite) end; - -function THSLAPixelHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(HSLAToExpanded(Self)) end; - -function THSLAPixelHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(HSLAToExpanded(Self)) end; - -procedure THSLAPixelHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := ExpandedToHSLA(StdRGBAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedToHSLA(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := ExpandedToHSLA(StdHSLAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := ExpandedToHSLA(StdHSVAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := ExpandedToHSLA(StdCMYKToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromByteMask(AValue: TByteMask); -begin Self := ExpandedToHSLA(ByteMaskToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedToHSLA(LinearRGBAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedToHSLA(XYZAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedToHSLA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure THSLAPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedToHSLA(WordXYZAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedToHSLA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure THSLAPixelHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedToHSLA(LabAToExpandedPixel(AValue)) end; - -procedure THSLAPixelHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedToHSLA(LChAToExpandedPixel(AValue)) end; - -{ TGSBAPixelHelper } - -class function TGSBAPixelHelper.New(const AHue,ASaturation,ABrightness,AAlpha:word): TGSBAPixel;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.lightness := ABrightness; - Result.alpha := AAlpha; -end; - -class function TGSBAPixelHelper.New(const AHue,ASaturation,ABrightness:word): TGSBAPixel;overload; -begin - Result.hue := AHue; - Result.saturation := ASaturation; - Result.lightness := ABrightness; - Result.alpha := 65535; -end; - -class function TGSBAPixelHelper.Colorspace: TColorspaceAny; static; -begin result := TGSBAPixelColorspace end; - -function TGSBAPixelHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToByteMask: TByteMask; -begin Result := ExpandedPixelToByteMask(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToLinearRGBA: TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToXYZA: TXYZA;overload; -begin Result := ExpandedPixelToXYZA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := ExpandedPixelToXYZA(GSBAToExpanded(Self),AReferenceWhite) end; - -function TGSBAPixelHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := ExpandedPixelToWordXYZA(GSBAToExpanded(Self),AReferenceWhite) end; - -function TGSBAPixelHelper.ToLabA: TLabA; -begin Result := ExpandedPixelToLabA(GSBAToExpanded(Self)) end; - -function TGSBAPixelHelper.ToLChA: TLChA; -begin Result := ExpandedPixelToLChA(GSBAToExpanded(Self)) end; - -procedure TGSBAPixelHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := ExpandedToGSBA(StdRGBAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := ExpandedToGSBA(AdobeRGBAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := ExpandedToGSBA(StdHSLAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := ExpandedToGSBA(StdHSVAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := ExpandedToGSBA(StdCMYKToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromByteMask(AValue: TByteMask); -begin Self := ExpandedToGSBA(ByteMaskToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := ExpandedToGSBA(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := ExpandedToGSBA(XYZAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedToGSBA(XYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TGSBAPixelHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := ExpandedToGSBA(WordXYZAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedToGSBA(WordXYZAToExpandedPixel(AValue,AReferenceWhite)) end; - -procedure TGSBAPixelHelper.FromLabA(AValue: TLabA); -begin Self := ExpandedToGSBA(LabAToExpandedPixel(AValue)) end; - -procedure TGSBAPixelHelper.FromLChA(AValue: TLChA); -begin Self := ExpandedToGSBA(LChAToExpandedPixel(AValue)) end; - -{ TXYZAHelper } - -class function TXYZAHelper.Colorspace: TColorspaceAny; static; -begin result := TXYZAColorspace end; - -procedure TXYZAHelper.ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); -begin ChromaticAdaptXYZ(self.X,self.Y,self.Z, AFrom,ATo) end; - -function TXYZAHelper.ToColor: TColor;overload; -begin Result := ExpandedPixelToColor(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; -begin Result := ExpandedPixelToColor(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToBGRAPixel: TBGRAPixel;overload; -begin Result := GammaCompression(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; -begin Result := GammaCompression(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToFPColor: TFPColor;overload; -begin Result := ExpandedToFPColor(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; -begin Result := ExpandedToFPColor(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToStdRGBA: TStdRGBA;overload; -begin Result := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; -begin Result := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToAdobeRGBA: TAdobeRGBA;overload; -begin Result := XYZAToAdobeRGBA(Self) end; - -function TXYZAHelper.ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; -begin Result := XYZAToAdobeRGBA(Self,AReferenceWhite) end; - -function TXYZAHelper.ToStdHSLA: TStdHSLA;overload; -begin Result := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; -begin Result := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToStdHSVA: TStdHSVA;overload; -begin Result := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; -begin Result := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToStdCMYK: TStdCMYK;overload; -begin Result := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; -begin Result := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToByteMask: TByteMask;overload; -begin Result := ExpandedPixelToByteMask(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; -begin Result := ExpandedPixelToByteMask(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToExpandedPixel: TExpandedPixel;overload; -begin Result := XYZAToExpandedPixel(Self) end; - -function TXYZAHelper.ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; -begin Result := XYZAToExpandedPixel(Self,AReferenceWhite) end; - -function TXYZAHelper.ToLinearRGBA: TLinearRGBA;overload; -begin Result := XYZAToLinearRGBA(Self) end; - -function TXYZAHelper.ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; -begin Result := XYZAToLinearRGBA(Self,AReferenceWhite) end; - -function TXYZAHelper.ToHSLAPixel: THSLAPixel;overload; -begin Result := ExpandedToHSLA(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; -begin Result := ExpandedToHSLA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToGSBAPixel: TGSBAPixel;overload; -begin Result := ExpandedToGSBA(XYZAToExpandedPixel(Self)) end; - -function TXYZAHelper.ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; -begin Result := ExpandedToGSBA(XYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TXYZAHelper.ToWordXYZA: TWordXYZA; -begin Result := XYZAToWordXYZA(Self) end; - -function TXYZAHelper.ToLabA: TLabA;overload; -begin Result := XYZAToLabA(Self) end; - -function TXYZAHelper.ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; -begin Result := XYZAToLabA(Self,AReferenceWhite) end; - -function TXYZAHelper.ToLChA: TLChA;overload; -begin Result := XYZAToLChA(Self) end; - -function TXYZAHelper.ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; -begin Result := XYZAToLChA(Self,AReferenceWhite) end; - -procedure TXYZAHelper.FromColor(AValue: TColor); overload; -begin Self := ExpandedPixelToXYZA(ColorToExpandedPixel(AValue)) end; - -procedure TXYZAHelper.FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(ColorToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel); overload; -begin Self := ExpandedPixelToXYZA(GammaExpansion(AValue)) end; - -procedure TXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(GammaExpansion(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromFPColor(AValue: TFPColor); overload; -begin Self := ExpandedPixelToXYZA(FPColorToExpanded(AValue)) end; - -procedure TXYZAHelper.FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(FPColorToExpanded(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromStdRGBA(AValue: TStdRGBA); overload; -begin Self := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(AValue)) end; - -procedure TXYZAHelper.FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); overload; -begin Self := AdobeRGBAToXYZA(AValue) end; - -procedure TXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := AdobeRGBAToXYZA(AValue,AReferenceWhite) end; - -procedure TXYZAHelper.FromStdHSLA(AValue: TStdHSLA); overload; -begin Self := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(AValue)) end; - -procedure TXYZAHelper.FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromStdHSVA(AValue: TStdHSVA); overload; -begin Self := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(AValue)) end; - -procedure TXYZAHelper.FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromStdCMYK(AValue: TStdCMYK); overload; -begin Self := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(AValue)) end; - -procedure TXYZAHelper.FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromByteMask(AValue: TByteMask); overload; -begin Self := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(AValue)) end; - -procedure TXYZAHelper.FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel); overload; -begin Self := ExpandedPixelToXYZA(AValue) end; - -procedure TXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(AValue,AReferenceWhite) end; - -procedure TXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA); overload; -begin Self := LinearRGBAToXYZA(AValue) end; - -procedure TXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := LinearRGBAToXYZA(AValue,AReferenceWhite) end; - -procedure TXYZAHelper.FromHSLAPixel(AValue: THSLAPixel); overload; -begin Self := ExpandedPixelToXYZA(HSLAToExpanded(AValue)) end; - -procedure TXYZAHelper.FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(HSLAToExpanded(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel); overload; -begin Self := ExpandedPixelToXYZA(GSBAToExpanded(AValue)) end; - -procedure TXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToXYZA(GSBAToExpanded(AValue),AReferenceWhite) end; - -procedure TXYZAHelper.FromWordXYZA(AValue: TWordXYZA); -begin Self := WordXYZAToXYZA(AValue) end; - -procedure TXYZAHelper.FromLabA(AValue: TLabA); overload; -begin Self := LabAToXYZA(AValue) end; - -procedure TXYZAHelper.FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := LabAToXYZA(AValue,AReferenceWhite) end; - -procedure TXYZAHelper.FromLChA(AValue: TLChA); overload; -begin Self := LChAToXYZA(AValue) end; - -procedure TXYZAHelper.FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := LChAToXYZA(AValue,AReferenceWhite) end; - -{ TWordXYZAHelper } - -class function TWordXYZAHelper.Colorspace: TColorspaceAny; static; -begin result := TWordXYZAColorspace end; - -procedure TWordXYZAHelper.ChromaticAdapt(const AFrom, ATo: TXYZReferenceWhite); -begin ChromaticAdaptWordXYZ(self.X,self.Y,self.Z, AFrom,ATo) end; - -function TWordXYZAHelper.ToColor: TColor;overload; -begin Result := ExpandedPixelToColor(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToColor(const AReferenceWhite: TXYZReferenceWhite): TColor;overload; -begin Result := ExpandedPixelToColor(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToBGRAPixel: TBGRAPixel;overload; -begin Result := GammaCompression(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToBGRAPixel(const AReferenceWhite: TXYZReferenceWhite): TBGRAPixel;overload; -begin Result := GammaCompression(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToFPColor: TFPColor;overload; -begin Result := ExpandedToFPColor(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToFPColor(const AReferenceWhite: TXYZReferenceWhite): TFPColor;overload; -begin Result := ExpandedToFPColor(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToStdRGBA: TStdRGBA;overload; -begin Result := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToStdRGBA(const AReferenceWhite: TXYZReferenceWhite): TStdRGBA;overload; -begin Result := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToAdobeRGBA: TAdobeRGBA;overload; -begin Result := WordXYZAToAdobeRGBA(Self) end; - -function TWordXYZAHelper.ToAdobeRGBA(const AReferenceWhite: TXYZReferenceWhite): TAdobeRGBA;overload; -begin Result := WordXYZAToAdobeRGBA(Self,AReferenceWhite) end; - -function TWordXYZAHelper.ToStdHSLA: TStdHSLA;overload; -begin Result := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToStdHSLA(const AReferenceWhite: TXYZReferenceWhite): TStdHSLA;overload; -begin Result := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToStdHSVA: TStdHSVA;overload; -begin Result := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToStdHSVA(const AReferenceWhite: TXYZReferenceWhite): TStdHSVA;overload; -begin Result := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToStdCMYK: TStdCMYK;overload; -begin Result := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToStdCMYK(const AReferenceWhite: TXYZReferenceWhite): TStdCMYK;overload; -begin Result := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToByteMask: TByteMask;overload; -begin Result := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToByteMask(const AReferenceWhite: TXYZReferenceWhite): TByteMask;overload; -begin Result := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToExpandedPixel: TExpandedPixel;overload; -begin Result := WordXYZAToExpandedPixel(Self) end; - -function TWordXYZAHelper.ToExpandedPixel(const AReferenceWhite: TXYZReferenceWhite): TExpandedPixel;overload; -begin Result := WordXYZAToExpandedPixel(Self,AReferenceWhite) end; - -function TWordXYZAHelper.ToLinearRGBA: TLinearRGBA;overload; -begin Result := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToLinearRGBA(const AReferenceWhite: TXYZReferenceWhite): TLinearRGBA;overload; -begin Result := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToHSLAPixel: THSLAPixel;overload; -begin Result := ExpandedToHSLA(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToHSLAPixel(const AReferenceWhite: TXYZReferenceWhite): THSLAPixel;overload; -begin Result := ExpandedToHSLA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToGSBAPixel: TGSBAPixel;overload; -begin Result := ExpandedToGSBA(WordXYZAToExpandedPixel(Self)) end; - -function TWordXYZAHelper.ToGSBAPixel(const AReferenceWhite: TXYZReferenceWhite): TGSBAPixel;overload; -begin Result := ExpandedToGSBA(WordXYZAToExpandedPixel(Self,AReferenceWhite)) end; - -function TWordXYZAHelper.ToXYZA: TXYZA; -begin Result := WordXYZAToXYZA(Self) end; - -function TWordXYZAHelper.ToLabA: TLabA;overload; -begin Result := WordXYZAToLabA(Self) end; - -function TWordXYZAHelper.ToLabA(const AReferenceWhite: TXYZReferenceWhite): TLabA;overload; -begin Result := WordXYZAToLabA(Self,AReferenceWhite) end; - -function TWordXYZAHelper.ToLChA: TLChA;overload; -begin Result := WordXYZAToLChA(Self) end; - -function TWordXYZAHelper.ToLChA(const AReferenceWhite: TXYZReferenceWhite): TLChA;overload; -begin Result := WordXYZAToLChA(Self,AReferenceWhite) end; - -procedure TWordXYZAHelper.FromColor(AValue: TColor); overload; -begin Self := ExpandedPixelToWordXYZA(ColorToExpandedPixel(AValue)) end; - -procedure TWordXYZAHelper.FromColor(AValue: TColor; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(ColorToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel); overload; -begin Self := ExpandedPixelToWordXYZA(GammaExpansion(AValue)) end; - -procedure TWordXYZAHelper.FromBGRAPixel(AValue: TBGRAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(GammaExpansion(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromFPColor(AValue: TFPColor); overload; -begin Self := ExpandedPixelToWordXYZA(FPColorToExpanded(AValue)) end; - -procedure TWordXYZAHelper.FromFPColor(AValue: TFPColor; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(FPColorToExpanded(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromStdRGBA(AValue: TStdRGBA); overload; -begin Self := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(AValue)) end; - -procedure TWordXYZAHelper.FromStdRGBA(AValue: TStdRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); overload; -begin Self := AdobeRGBAToWordXYZA(AValue) end; - -procedure TWordXYZAHelper.FromAdobeRGBA(AValue: TAdobeRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := AdobeRGBAToWordXYZA(AValue,AReferenceWhite) end; - -procedure TWordXYZAHelper.FromStdHSLA(AValue: TStdHSLA); overload; -begin Self := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(AValue)) end; - -procedure TWordXYZAHelper.FromStdHSLA(AValue: TStdHSLA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromStdHSVA(AValue: TStdHSVA); overload; -begin Self := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(AValue)) end; - -procedure TWordXYZAHelper.FromStdHSVA(AValue: TStdHSVA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromStdCMYK(AValue: TStdCMYK); overload; -begin Self := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(AValue)) end; - -procedure TWordXYZAHelper.FromStdCMYK(AValue: TStdCMYK; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromByteMask(AValue: TByteMask); overload; -begin Self := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(AValue)) end; - -procedure TWordXYZAHelper.FromByteMask(AValue: TByteMask; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel); overload; -begin Self := ExpandedPixelToWordXYZA(AValue) end; - -procedure TWordXYZAHelper.FromExpandedPixel(AValue: TExpandedPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(AValue,AReferenceWhite) end; - -procedure TWordXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA); overload; -begin Self := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(AValue)) end; - -procedure TWordXYZAHelper.FromLinearRGBA(AValue: TLinearRGBA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromHSLAPixel(AValue: THSLAPixel); overload; -begin Self := ExpandedPixelToWordXYZA(HSLAToExpanded(AValue)) end; - -procedure TWordXYZAHelper.FromHSLAPixel(AValue: THSLAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(HSLAToExpanded(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel); overload; -begin Self := ExpandedPixelToWordXYZA(GSBAToExpanded(AValue)) end; - -procedure TWordXYZAHelper.FromGSBAPixel(AValue: TGSBAPixel; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := ExpandedPixelToWordXYZA(GSBAToExpanded(AValue),AReferenceWhite) end; - -procedure TWordXYZAHelper.FromXYZA(AValue: TXYZA); -begin Self := XYZAToWordXYZA(AValue) end; - -procedure TWordXYZAHelper.FromLabA(AValue: TLabA); overload; -begin Self := LabAToWordXYZA(AValue) end; - -procedure TWordXYZAHelper.FromLabA(AValue: TLabA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := LabAToWordXYZA(AValue,AReferenceWhite) end; - -procedure TWordXYZAHelper.FromLChA(AValue: TLChA); overload; -begin Self := LChAToWordXYZA(AValue) end; - -procedure TWordXYZAHelper.FromLChA(AValue: TLChA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := LChAToWordXYZA(AValue,AReferenceWhite) end; - -{ TLabAHelper } - -class function TLabAHelper.Colorspace: TColorspaceAny; static; -begin result := TLabAColorspace end; - -function TLabAHelper.ToColor: TColor; -begin Result := ExpandedPixelToColor(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToBGRAPixel: TBGRAPixel; -begin Result := GammaCompression(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToFPColor: TFPColor; -begin Result := ExpandedToFPColor(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := LabAToAdobeRGBA(Self) end; - -function TLabAHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToByteMask: TByteMask; -begin Result := ExpandedPixelToByteMask(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToExpandedPixel: TExpandedPixel; -begin Result := LabAToExpandedPixel(Self) end; - -function TLabAHelper.ToLinearRGBA: TLinearRGBA; -begin Result := LabAToLinearRGBA(Self) end; - -function TLabAHelper.ToHSLAPixel: THSLAPixel; -begin Result := ExpandedToHSLA(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToGSBAPixel: TGSBAPixel; -begin Result := ExpandedToGSBA(LabAToExpandedPixel(Self)) end; - -function TLabAHelper.ToXYZA: TXYZA;overload; -begin Result := LabAToXYZA(Self) end; - -function TLabAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := LabAToXYZA(Self,AReferenceWhite) end; - -function TLabAHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := LabAToWordXYZA(Self) end; - -function TLabAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := LabAToWordXYZA(Self,AReferenceWhite) end; - -function TLabAHelper.ToLChA: TLChA; -begin Result := LabAToLChA(Self) end; - -procedure TLabAHelper.FromColor(AValue: TColor); -begin Self := ExpandedPixelToLabA(ColorToExpandedPixel(AValue)) end; - -procedure TLabAHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := ExpandedPixelToLabA(GammaExpansion(AValue)) end; - -procedure TLabAHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToLabA(FPColorToExpanded(AValue)) end; - -procedure TLabAHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := ExpandedPixelToLabA(StdRGBAToExpandedPixel(AValue)) end; - -procedure TLabAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := AdobeRGBAToLabA(AValue) end; - -procedure TLabAHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := ExpandedPixelToLabA(StdHSLAToExpandedPixel(AValue)) end; - -procedure TLabAHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := ExpandedPixelToLabA(StdHSVAToExpandedPixel(AValue)) end; - -procedure TLabAHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := ExpandedPixelToLabA(StdCMYKToExpandedPixel(AValue)) end; - -procedure TLabAHelper.FromByteMask(AValue: TByteMask); -begin Self := ExpandedPixelToLabA(ByteMaskToExpandedPixel(AValue)) end; - -procedure TLabAHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToLabA(AValue) end; - -procedure TLabAHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := LinearRGBAToLabA(AValue) end; - -procedure TLabAHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToLabA(HSLAToExpanded(AValue)) end; - -procedure TLabAHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToLabA(GSBAToExpanded(AValue)) end; - -procedure TLabAHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := XYZAToLabA(AValue) end; - -procedure TLabAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := XYZAToLabA(AValue,AReferenceWhite) end; - -procedure TLabAHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := WordXYZAToLabA(AValue) end; - -procedure TLabAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := WordXYZAToLabA(AValue,AReferenceWhite) end; - -procedure TLabAHelper.FromLChA(AValue: TLChA); -begin Self := LChAToLabA(AValue) end; - -{ TLChAHelper } - -class function TLChAHelper.Colorspace: TColorspaceAny; static; -begin result := TLChAColorspace end; - -function TLChAHelper.ToColor: TColor; -begin Result := ExpandedPixelToColor(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToBGRAPixel: TBGRAPixel; -begin Result := GammaCompression(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToFPColor: TFPColor; -begin Result := ExpandedToFPColor(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToStdRGBA: TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToAdobeRGBA: TAdobeRGBA; -begin Result := LChAToAdobeRGBA(Self) end; - -function TLChAHelper.ToStdHSLA: TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToStdHSVA: TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToStdCMYK: TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToByteMask: TByteMask; -begin Result := ExpandedPixelToByteMask(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToExpandedPixel: TExpandedPixel; -begin Result := LChAToExpandedPixel(Self) end; - -function TLChAHelper.ToLinearRGBA: TLinearRGBA; -begin Result := LChAToLinearRGBA(Self) end; - -function TLChAHelper.ToHSLAPixel: THSLAPixel; -begin Result := ExpandedToHSLA(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToGSBAPixel: TGSBAPixel; -begin Result := ExpandedToGSBA(LChAToExpandedPixel(Self)) end; - -function TLChAHelper.ToXYZA: TXYZA;overload; -begin Result := LChAToXYZA(Self) end; - -function TLChAHelper.ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA;overload; -begin Result := LChAToXYZA(Self,AReferenceWhite) end; - -function TLChAHelper.ToWordXYZA: TWordXYZA;overload; -begin Result := LChAToWordXYZA(Self) end; - -function TLChAHelper.ToWordXYZA(const AReferenceWhite: TXYZReferenceWhite): TWordXYZA;overload; -begin Result := LChAToWordXYZA(Self,AReferenceWhite) end; - -function TLChAHelper.ToLabA: TLabA; -begin Result := LChAToLabA(Self) end; - -procedure TLChAHelper.FromColor(AValue: TColor); -begin Self := ExpandedPixelToLChA(ColorToExpandedPixel(AValue)) end; - -procedure TLChAHelper.FromBGRAPixel(AValue: TBGRAPixel); -begin Self := ExpandedPixelToLChA(GammaExpansion(AValue)) end; - -procedure TLChAHelper.FromFPColor(AValue: TFPColor); -begin Self := ExpandedPixelToLChA(FPColorToExpanded(AValue)) end; - -procedure TLChAHelper.FromStdRGBA(AValue: TStdRGBA); -begin Self := ExpandedPixelToLChA(StdRGBAToExpandedPixel(AValue)) end; - -procedure TLChAHelper.FromAdobeRGBA(AValue: TAdobeRGBA); -begin Self := AdobeRGBAToLChA(AValue) end; - -procedure TLChAHelper.FromStdHSLA(AValue: TStdHSLA); -begin Self := ExpandedPixelToLChA(StdHSLAToExpandedPixel(AValue)) end; - -procedure TLChAHelper.FromStdHSVA(AValue: TStdHSVA); -begin Self := ExpandedPixelToLChA(StdHSVAToExpandedPixel(AValue)) end; - -procedure TLChAHelper.FromStdCMYK(AValue: TStdCMYK); -begin Self := ExpandedPixelToLChA(StdCMYKToExpandedPixel(AValue)) end; - -procedure TLChAHelper.FromByteMask(AValue: TByteMask); -begin Self := ExpandedPixelToLChA(ByteMaskToExpandedPixel(AValue)) end; - -procedure TLChAHelper.FromExpandedPixel(AValue: TExpandedPixel); -begin Self := ExpandedPixelToLChA(AValue) end; - -procedure TLChAHelper.FromLinearRGBA(AValue: TLinearRGBA); -begin Self := LinearRGBAToLChA(AValue) end; - -procedure TLChAHelper.FromHSLAPixel(AValue: THSLAPixel); -begin Self := ExpandedPixelToLChA(HSLAToExpanded(AValue)) end; - -procedure TLChAHelper.FromGSBAPixel(AValue: TGSBAPixel); -begin Self := ExpandedPixelToLChA(GSBAToExpanded(AValue)) end; - -procedure TLChAHelper.FromXYZA(AValue: TXYZA); overload; -begin Self := XYZAToLChA(AValue) end; - -procedure TLChAHelper.FromXYZA(AValue: TXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := XYZAToLChA(AValue,AReferenceWhite) end; - -procedure TLChAHelper.FromWordXYZA(AValue: TWordXYZA); overload; -begin Self := WordXYZAToLChA(AValue) end; - -procedure TLChAHelper.FromWordXYZA(AValue: TWordXYZA; const AReferenceWhite: TXYZReferenceWhite); overload; -begin Self := WordXYZAToLChA(AValue,AReferenceWhite) end; - -procedure TLChAHelper.FromLabA(AValue: TLabA); -begin Self := LabAToLChA(AValue) end; - -{Operators} - -operator := (const AValue: TColor): TStdRGBA; -begin Result := ColorToStdRGBA(AValue) end; - -operator := (const AValue: TColor): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(ColorToExpandedPixel(AValue)) end; - -operator := (const AValue: TColor): TStdHSLA; -begin Result := ColorToStdHSLA(AValue) end; - -operator := (const AValue: TColor): TStdHSVA; -begin Result := ColorToStdHSVA(AValue) end; - -operator := (const AValue: TColor): TStdCMYK; -begin Result := ColorToStdCMYK(AValue) end; - -operator := (const AValue: TColor): TByteMask; -begin Result := ColorToByteMask(AValue) end; - -operator := (const AValue: TColor): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(ColorToExpandedPixel(AValue)) end; - -operator := (const AValue: TColor): TXYZA; -begin Result := ExpandedPixelToXYZA(ColorToExpandedPixel(AValue)) end; - -operator := (const AValue: TColor): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(ColorToExpandedPixel(AValue)) end; - -operator := (const AValue: TColor): TLabA; -begin Result := ExpandedPixelToLabA(ColorToExpandedPixel(AValue)) end; - -operator := (const AValue: TColor): TLChA; -begin Result := ExpandedPixelToLChA(ColorToExpandedPixel(AValue)) end; - -operator := (const AValue: TBGRAPixel): TStdRGBA; -begin Result := BGRAPixelToStdRGBA(AValue) end; - -operator := (const AValue: TBGRAPixel): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(GammaExpansion(AValue)) end; - -operator := (const AValue: TBGRAPixel): TStdHSLA; -begin Result := BGRAPixelToStdHSLA(AValue) end; - -operator := (const AValue: TBGRAPixel): TStdHSVA; -begin Result := BGRAPixelToStdHSVA(AValue) end; - -operator := (const AValue: TBGRAPixel): TStdCMYK; -begin Result := BGRAPixelToStdCMYK(AValue) end; - -operator := (const AValue: TBGRAPixel): TByteMask; -begin Result := BGRAToMask(AValue) end; - -operator := (const AValue: TBGRAPixel): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(GammaExpansion(AValue)) end; - -operator := (const AValue: TBGRAPixel): TXYZA; -begin Result := ExpandedPixelToXYZA(GammaExpansion(AValue)) end; - -operator := (const AValue: TBGRAPixel): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(GammaExpansion(AValue)) end; - -operator := (const AValue: TBGRAPixel): TLabA; -begin Result := ExpandedPixelToLabA(GammaExpansion(AValue)) end; - -operator := (const AValue: TBGRAPixel): TLChA; -begin Result := ExpandedPixelToLChA(GammaExpansion(AValue)) end; - -operator := (const AValue: TFPColor): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TByteMask; -begin Result := FPColorToByteMask(AValue) end; - -operator := (const AValue: TFPColor): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TXYZA; -begin Result := ExpandedPixelToXYZA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TLabA; -begin Result := ExpandedPixelToLabA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TFPColor): TLChA; -begin Result := ExpandedPixelToLChA(FPColorToExpanded(AValue)) end; - -operator := (const AValue: TStdRGBA): TColor; -begin Result := StdRGBAToColor(AValue) end; - -operator := (const AValue: TStdRGBA): TBGRAPixel; -begin Result := StdRGBAToBGRAPixel(AValue) end; - -operator := (const AValue: TStdRGBA): TFPColor; -begin Result := ExpandedToFPColor(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): TStdHSLA; -begin Result := StdRGBAToStdHSLA(AValue) end; - -operator := (const AValue: TStdRGBA): TStdHSVA; -begin Result := StdRGBAToStdHSVA(AValue) end; - -operator := (const AValue: TStdRGBA): TStdCMYK; -begin Result := StdRGBAToStdCMYK(AValue) end; - -operator := (const AValue: TStdRGBA): TByteMask; -begin Result := StdRGBAToByteMask(AValue) end; - -operator := (const AValue: TStdRGBA): TExpandedPixel; -begin Result := StdRGBAToExpandedPixel(AValue) end; - -operator := (const AValue: TStdRGBA): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): THSLAPixel; -begin Result := ExpandedToHSLA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): TGSBAPixel; -begin Result := ExpandedToGSBA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): TXYZA; -begin Result := ExpandedPixelToXYZA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): TLabA; -begin Result := ExpandedPixelToLabA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdRGBA): TLChA; -begin Result := ExpandedPixelToLChA(StdRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TColor; -begin Result := ExpandedPixelToColor(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TBGRAPixel; -begin Result := GammaCompression(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TFPColor; -begin Result := ExpandedToFPColor(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TByteMask; -begin Result := ExpandedPixelToByteMask(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TExpandedPixel; -begin Result := AdobeRGBAToExpandedPixel(AValue) end; - -operator := (const AValue: TAdobeRGBA): TLinearRGBA; -begin Result := AdobeRGBAToLinearRGBA(AValue) end; - -operator := (const AValue: TAdobeRGBA): THSLAPixel; -begin Result := ExpandedToHSLA(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TGSBAPixel; -begin Result := ExpandedToGSBA(AdobeRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TAdobeRGBA): TXYZA; -begin Result := AdobeRGBAToXYZA(AValue) end; - -operator := (const AValue: TAdobeRGBA): TWordXYZA; -begin Result := AdobeRGBAToWordXYZA(AValue) end; - -operator := (const AValue: TAdobeRGBA): TLabA; -begin Result := AdobeRGBAToLabA(AValue) end; - -operator := (const AValue: TAdobeRGBA): TLChA; -begin Result := AdobeRGBAToLChA(AValue) end; - -operator := (const AValue: TStdHSLA): TColor; -begin Result := StdHSLAToColor(AValue) end; - -operator := (const AValue: TStdHSLA): TBGRAPixel; -begin Result := StdHSLAToBGRAPixel(AValue) end; - -operator := (const AValue: TStdHSLA): TFPColor; -begin Result := ExpandedToFPColor(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): TStdRGBA; -begin Result := StdHSLAToStdRGBA(AValue) end; - -operator := (const AValue: TStdHSLA): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): TStdHSVA; -begin Result := StdHSLAToStdHSVA(AValue) end; - -operator := (const AValue: TStdHSLA): TStdCMYK; -begin Result := StdHSLAToStdCMYK(AValue) end; - -operator := (const AValue: TStdHSLA): TByteMask; -begin Result := StdHSLAToByteMask(AValue) end; - -operator := (const AValue: TStdHSLA): TExpandedPixel; -begin Result := StdHSLAToExpandedPixel(AValue) end; - -operator := (const AValue: TStdHSLA): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): THSLAPixel; -begin Result := ExpandedToHSLA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): TGSBAPixel; -begin Result := ExpandedToGSBA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): TXYZA; -begin Result := ExpandedPixelToXYZA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): TLabA; -begin Result := ExpandedPixelToLabA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSLA): TLChA; -begin Result := ExpandedPixelToLChA(StdHSLAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TColor; -begin Result := StdHSVAToColor(AValue) end; - -operator := (const AValue: TStdHSVA): TBGRAPixel; -begin Result := StdHSVAToBGRAPixel(AValue) end; - -operator := (const AValue: TStdHSVA): TFPColor; -begin Result := ExpandedToFPColor(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TStdRGBA; -begin Result := StdHSVAToStdRGBA(AValue) end; - -operator := (const AValue: TStdHSVA): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TStdHSLA; -begin Result := StdHSVAToStdHSLA(AValue) end; - -operator := (const AValue: TStdHSVA): TStdCMYK; -begin Result := StdHSVAToStdCMYK(AValue) end; - -operator := (const AValue: TStdHSVA): TByteMask; -begin Result := StdHSVAToByteMask(AValue) end; - -operator := (const AValue: TStdHSVA): TExpandedPixel; -begin Result := StdHSVAToExpandedPixel(AValue) end; - -operator := (const AValue: TStdHSVA): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): THSLAPixel; -begin Result := ExpandedToHSLA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TGSBAPixel; -begin Result := ExpandedToGSBA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TXYZA; -begin Result := ExpandedPixelToXYZA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TLabA; -begin Result := ExpandedPixelToLabA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdHSVA): TLChA; -begin Result := ExpandedPixelToLChA(StdHSVAToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TColor; -begin Result := StdCMYKToColor(AValue) end; - -operator := (const AValue: TStdCMYK): TBGRAPixel; -begin Result := StdCMYKToBGRAPixel(AValue) end; - -operator := (const AValue: TStdCMYK): TFPColor; -begin Result := ExpandedToFPColor(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TStdRGBA; -begin Result := StdCMYKToStdRGBA(AValue) end; - -operator := (const AValue: TStdCMYK): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TStdHSLA; -begin Result := StdCMYKToStdHSLA(AValue) end; - -operator := (const AValue: TStdCMYK): TStdHSVA; -begin Result := StdCMYKToStdHSVA(AValue) end; - -operator := (const AValue: TStdCMYK): TByteMask; -begin Result := StdCMYKToByteMask(AValue) end; - -operator := (const AValue: TStdCMYK): TExpandedPixel; -begin Result := StdCMYKToExpandedPixel(AValue) end; - -operator := (const AValue: TStdCMYK): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): THSLAPixel; -begin Result := ExpandedToHSLA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TGSBAPixel; -begin Result := ExpandedToGSBA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TXYZA; -begin Result := ExpandedPixelToXYZA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TLabA; -begin Result := ExpandedPixelToLabA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TStdCMYK): TLChA; -begin Result := ExpandedPixelToLChA(StdCMYKToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): TColor; -begin Result := ByteMaskToColor(AValue) end; - -operator := (const AValue: TByteMask): TBGRAPixel; -begin Result := MaskToBGRA(AValue) end; - -operator := (const AValue: TByteMask): TFPColor; -begin Result := ByteMaskToFPColor(AValue) end; - -operator := (const AValue: TByteMask): TStdRGBA; -begin Result := ByteMaskToStdRGBA(AValue) end; - -operator := (const AValue: TByteMask): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): TStdHSLA; -begin Result := ByteMaskToStdHSLA(AValue) end; - -operator := (const AValue: TByteMask): TStdHSVA; -begin Result := ByteMaskToStdHSVA(AValue) end; - -operator := (const AValue: TByteMask): TStdCMYK; -begin Result := ByteMaskToStdCMYK(AValue) end; - -operator := (const AValue: TByteMask): TExpandedPixel; -begin Result := ByteMaskToExpandedPixel(AValue) end; - -operator := (const AValue: TByteMask): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): THSLAPixel; -begin Result := ExpandedToHSLA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): TGSBAPixel; -begin Result := ExpandedToGSBA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): TXYZA; -begin Result := ExpandedPixelToXYZA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): TLabA; -begin Result := ExpandedPixelToLabA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TByteMask): TLChA; -begin Result := ExpandedPixelToLChA(ByteMaskToExpandedPixel(AValue)) end; - -operator := (const AValue: TExpandedPixel): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(AValue) end; - -operator := (const AValue: TExpandedPixel): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(AValue) end; - -operator := (const AValue: TExpandedPixel): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(AValue) end; - -operator := (const AValue: TExpandedPixel): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(AValue) end; - -operator := (const AValue: TExpandedPixel): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(AValue) end; - -operator := (const AValue: TExpandedPixel): TByteMask; -begin Result := ExpandedPixelToByteMask(AValue) end; - -operator := (const AValue: TExpandedPixel): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(AValue) end; - -operator := (const AValue: TExpandedPixel): TXYZA; -begin Result := ExpandedPixelToXYZA(AValue) end; - -operator := (const AValue: TExpandedPixel): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(AValue) end; - -operator := (const AValue: TExpandedPixel): TLabA; -begin Result := ExpandedPixelToLabA(AValue) end; - -operator := (const AValue: TExpandedPixel): TLChA; -begin Result := ExpandedPixelToLChA(AValue) end; - -operator := (const AValue: TLinearRGBA): TColor; -begin Result := ExpandedPixelToColor(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TBGRAPixel; -begin Result := GammaCompression(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TFPColor; -begin Result := ExpandedToFPColor(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TAdobeRGBA; -begin Result := LinearRGBAToAdobeRGBA(AValue) end; - -operator := (const AValue: TLinearRGBA): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TByteMask; -begin Result := ExpandedPixelToByteMask(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TExpandedPixel; -begin Result := LinearRGBAToExpandedPixel(AValue) end; - -operator := (const AValue: TLinearRGBA): THSLAPixel; -begin Result := ExpandedToHSLA(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TGSBAPixel; -begin Result := ExpandedToGSBA(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TXYZA; -begin Result := LinearRGBAToXYZA(AValue) end; - -operator := (const AValue: TLinearRGBA): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(LinearRGBAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLinearRGBA): TLabA; -begin Result := LinearRGBAToLabA(AValue) end; - -operator := (const AValue: TLinearRGBA): TLChA; -begin Result := LinearRGBAToLChA(AValue) end; - -operator := (const AValue: THSLAPixel): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TByteMask; -begin Result := ExpandedPixelToByteMask(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TXYZA; -begin Result := ExpandedPixelToXYZA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TLabA; -begin Result := ExpandedPixelToLabA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: THSLAPixel): TLChA; -begin Result := ExpandedPixelToLChA(HSLAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TAdobeRGBA; -begin Result := ExpandedPixelToAdobeRGBA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TByteMask; -begin Result := ExpandedPixelToByteMask(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TXYZA; -begin Result := ExpandedPixelToXYZA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TWordXYZA; -begin Result := ExpandedPixelToWordXYZA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TLabA; -begin Result := ExpandedPixelToLabA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TGSBAPixel): TLChA; -begin Result := ExpandedPixelToLChA(GSBAToExpanded(AValue)) end; - -operator := (const AValue: TXYZA): TColor; -begin Result := ExpandedPixelToColor(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TBGRAPixel; -begin Result := GammaCompression(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TFPColor; -begin Result := ExpandedToFPColor(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TAdobeRGBA; -begin Result := XYZAToAdobeRGBA(AValue) end; - -operator := (const AValue: TXYZA): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TByteMask; -begin Result := ExpandedPixelToByteMask(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TExpandedPixel; -begin Result := XYZAToExpandedPixel(AValue) end; - -operator := (const AValue: TXYZA): TLinearRGBA; -begin Result := XYZAToLinearRGBA(AValue) end; - -operator := (const AValue: TXYZA): THSLAPixel; -begin Result := ExpandedToHSLA(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TGSBAPixel; -begin Result := ExpandedToGSBA(XYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TXYZA): TWordXYZA; -begin Result := XYZAToWordXYZA(AValue) end; - -operator := (const AValue: TXYZA): TLabA; -begin Result := XYZAToLabA(AValue) end; - -operator := (const AValue: TXYZA): TLChA; -begin Result := XYZAToLChA(AValue) end; - -operator := (const AValue: TWordXYZA): TColor; -begin Result := ExpandedPixelToColor(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TBGRAPixel; -begin Result := GammaCompression(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TFPColor; -begin Result := ExpandedToFPColor(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TAdobeRGBA; -begin Result := WordXYZAToAdobeRGBA(AValue) end; - -operator := (const AValue: TWordXYZA): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TByteMask; -begin Result := ExpandedPixelToByteMask(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TExpandedPixel; -begin Result := WordXYZAToExpandedPixel(AValue) end; - -operator := (const AValue: TWordXYZA): TLinearRGBA; -begin Result := ExpandedPixelToLinearRGBA(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): THSLAPixel; -begin Result := ExpandedToHSLA(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TGSBAPixel; -begin Result := ExpandedToGSBA(WordXYZAToExpandedPixel(AValue)) end; - -operator := (const AValue: TWordXYZA): TXYZA; -begin Result := WordXYZAToXYZA(AValue) end; - -operator := (const AValue: TWordXYZA): TLabA; -begin Result := WordXYZAToLabA(AValue) end; - -operator := (const AValue: TWordXYZA): TLChA; -begin Result := WordXYZAToLChA(AValue) end; - -operator := (const AValue: TLabA): TColor; -begin Result := ExpandedPixelToColor(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TBGRAPixel; -begin Result := GammaCompression(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TFPColor; -begin Result := ExpandedToFPColor(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TAdobeRGBA; -begin Result := LabAToAdobeRGBA(AValue) end; - -operator := (const AValue: TLabA): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TByteMask; -begin Result := ExpandedPixelToByteMask(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TExpandedPixel; -begin Result := LabAToExpandedPixel(AValue) end; - -operator := (const AValue: TLabA): TLinearRGBA; -begin Result := LabAToLinearRGBA(AValue) end; - -operator := (const AValue: TLabA): THSLAPixel; -begin Result := ExpandedToHSLA(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TGSBAPixel; -begin Result := ExpandedToGSBA(LabAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLabA): TXYZA; -begin Result := LabAToXYZA(AValue) end; - -operator := (const AValue: TLabA): TWordXYZA; -begin Result := LabAToWordXYZA(AValue) end; - -operator := (const AValue: TLabA): TLChA; -begin Result := LabAToLChA(AValue) end; - -operator := (const AValue: TLChA): TColor; -begin Result := ExpandedPixelToColor(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TBGRAPixel; -begin Result := GammaCompression(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TFPColor; -begin Result := ExpandedToFPColor(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TStdRGBA; -begin Result := ExpandedPixelToStdRGBA(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TAdobeRGBA; -begin Result := LChAToAdobeRGBA(AValue) end; - -operator := (const AValue: TLChA): TStdHSLA; -begin Result := ExpandedPixelToStdHSLA(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TStdHSVA; -begin Result := ExpandedPixelToStdHSVA(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TStdCMYK; -begin Result := ExpandedPixelToStdCMYK(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TByteMask; -begin Result := ExpandedPixelToByteMask(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TExpandedPixel; -begin Result := LChAToExpandedPixel(AValue) end; - -operator := (const AValue: TLChA): TLinearRGBA; -begin Result := LChAToLinearRGBA(AValue) end; - -operator := (const AValue: TLChA): THSLAPixel; -begin Result := ExpandedToHSLA(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TGSBAPixel; -begin Result := ExpandedToGSBA(LChAToExpandedPixel(AValue)) end; - -operator := (const AValue: TLChA): TXYZA; -begin Result := LChAToXYZA(AValue) end; - -operator := (const AValue: TLChA): TWordXYZA; -begin Result := LChAToWordXYZA(AValue) end; - -operator := (const AValue: TLChA): TLabA; -begin Result := LChAToLabA(AValue) end; - -{$ENDIF} -{$IFDEF INCLUDE_INITIALIZATION} -{$UNDEF INCLUDE_INITIALIZATION} - ColorspaceCollection.Add(TColorColorspace); - ColorspaceCollection.Add(TBGRAPixelColorspace); - ColorspaceCollection.Add(TFPColorColorspace); - ColorspaceCollection.Add(TStdRGBAColorspace); - ColorspaceCollection.Add(TAdobeRGBAColorspace); - ColorspaceCollection.Add(TStdHSLAColorspace); - ColorspaceCollection.Add(TStdHSVAColorspace); - ColorspaceCollection.Add(TStdCMYKColorspace); - ColorspaceCollection.Add(TByteMaskColorspace); - ColorspaceCollection.Add(TExpandedPixelColorspace); - ColorspaceCollection.Add(TLinearRGBAColorspace); - ColorspaceCollection.Add(THSLAPixelColorspace); - ColorspaceCollection.Add(TGSBAPixelColorspace); - ColorspaceCollection.Add(TXYZAColorspace); - ColorspaceCollection.Add(TWordXYZAColorspace); - ColorspaceCollection.Add(TLabAColorspace); - ColorspaceCollection.Add(TLChAColorspace); - ColorspaceCollection.AddConversion(TColorColorspace, TBGRAPixelColorspace, @ConvertColorArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TColorColorspace, TFPColorColorspace, @ConvertColorArrayToFPColorArray); - ColorspaceCollection.AddConversion(TColorColorspace, TStdRGBAColorspace, @ConvertColorArrayToStdRGBAArray); - ColorspaceCollection.AddConversion(TColorColorspace, TStdHSLAColorspace, @ConvertColorArrayToStdHSLAArray); - ColorspaceCollection.AddConversion(TColorColorspace, TStdHSVAColorspace, @ConvertColorArrayToStdHSVAArray); - ColorspaceCollection.AddConversion(TColorColorspace, TStdCMYKColorspace, @ConvertColorArrayToStdCMYKArray); - ColorspaceCollection.AddConversion(TColorColorspace, TByteMaskColorspace, @ConvertColorArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TColorColorspace, TExpandedPixelColorspace, @ConvertColorArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TColorColorspace, @ConvertBGRAPixelArrayToColorArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TFPColorColorspace, @ConvertBGRAPixelArrayToFPColorArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdRGBAColorspace, @ConvertBGRAPixelArrayToStdRGBAArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdHSLAColorspace, @ConvertBGRAPixelArrayToStdHSLAArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdHSVAColorspace, @ConvertBGRAPixelArrayToStdHSVAArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TStdCMYKColorspace, @ConvertBGRAPixelArrayToStdCMYKArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TByteMaskColorspace, @ConvertBGRAPixelArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TBGRAPixelColorspace, TExpandedPixelColorspace, @ConvertBGRAPixelArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TFPColorColorspace, TColorColorspace, @ConvertFPColorArrayToColorArray); - ColorspaceCollection.AddConversion(TFPColorColorspace, TBGRAPixelColorspace, @ConvertFPColorArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TFPColorColorspace, TByteMaskColorspace, @ConvertFPColorArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TFPColorColorspace, TExpandedPixelColorspace, @ConvertFPColorArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TStdRGBAColorspace, TColorColorspace, @ConvertStdRGBAArrayToColorArray); - ColorspaceCollection.AddConversion(TStdRGBAColorspace, TBGRAPixelColorspace, @ConvertStdRGBAArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TStdRGBAColorspace, TStdHSLAColorspace, @ConvertStdRGBAArrayToStdHSLAArray); - ColorspaceCollection.AddConversion(TStdRGBAColorspace, TStdHSVAColorspace, @ConvertStdRGBAArrayToStdHSVAArray); - ColorspaceCollection.AddConversion(TStdRGBAColorspace, TStdCMYKColorspace, @ConvertStdRGBAArrayToStdCMYKArray); - ColorspaceCollection.AddConversion(TStdRGBAColorspace, TByteMaskColorspace, @ConvertStdRGBAArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TStdRGBAColorspace, TExpandedPixelColorspace, @ConvertStdRGBAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TExpandedPixelColorspace, @ConvertAdobeRGBAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TLinearRGBAColorspace, @ConvertAdobeRGBAArrayToLinearRGBAArray); - ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TXYZAColorspace, @ConvertAdobeRGBAArrayToXYZAArray); - ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TWordXYZAColorspace, @ConvertAdobeRGBAArrayToWordXYZAArray); - ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TLabAColorspace, @ConvertAdobeRGBAArrayToLabAArray); - ColorspaceCollection.AddConversion(TAdobeRGBAColorspace, TLChAColorspace, @ConvertAdobeRGBAArrayToLChAArray); - ColorspaceCollection.AddConversion(TStdHSLAColorspace, TColorColorspace, @ConvertStdHSLAArrayToColorArray); - ColorspaceCollection.AddConversion(TStdHSLAColorspace, TBGRAPixelColorspace, @ConvertStdHSLAArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TStdHSLAColorspace, TStdRGBAColorspace, @ConvertStdHSLAArrayToStdRGBAArray); - ColorspaceCollection.AddConversion(TStdHSLAColorspace, TStdHSVAColorspace, @ConvertStdHSLAArrayToStdHSVAArray); - ColorspaceCollection.AddConversion(TStdHSLAColorspace, TStdCMYKColorspace, @ConvertStdHSLAArrayToStdCMYKArray); - ColorspaceCollection.AddConversion(TStdHSLAColorspace, TByteMaskColorspace, @ConvertStdHSLAArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TStdHSLAColorspace, TExpandedPixelColorspace, @ConvertStdHSLAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TStdHSVAColorspace, TColorColorspace, @ConvertStdHSVAArrayToColorArray); - ColorspaceCollection.AddConversion(TStdHSVAColorspace, TBGRAPixelColorspace, @ConvertStdHSVAArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TStdHSVAColorspace, TStdRGBAColorspace, @ConvertStdHSVAArrayToStdRGBAArray); - ColorspaceCollection.AddConversion(TStdHSVAColorspace, TStdHSLAColorspace, @ConvertStdHSVAArrayToStdHSLAArray); - ColorspaceCollection.AddConversion(TStdHSVAColorspace, TStdCMYKColorspace, @ConvertStdHSVAArrayToStdCMYKArray); - ColorspaceCollection.AddConversion(TStdHSVAColorspace, TByteMaskColorspace, @ConvertStdHSVAArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TStdHSVAColorspace, TExpandedPixelColorspace, @ConvertStdHSVAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TStdCMYKColorspace, TColorColorspace, @ConvertStdCMYKArrayToColorArray); - ColorspaceCollection.AddConversion(TStdCMYKColorspace, TBGRAPixelColorspace, @ConvertStdCMYKArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TStdCMYKColorspace, TStdRGBAColorspace, @ConvertStdCMYKArrayToStdRGBAArray); - ColorspaceCollection.AddConversion(TStdCMYKColorspace, TStdHSLAColorspace, @ConvertStdCMYKArrayToStdHSLAArray); - ColorspaceCollection.AddConversion(TStdCMYKColorspace, TStdHSVAColorspace, @ConvertStdCMYKArrayToStdHSVAArray); - ColorspaceCollection.AddConversion(TStdCMYKColorspace, TByteMaskColorspace, @ConvertStdCMYKArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TStdCMYKColorspace, TExpandedPixelColorspace, @ConvertStdCMYKArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TColorColorspace, @ConvertByteMaskArrayToColorArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TBGRAPixelColorspace, @ConvertByteMaskArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TFPColorColorspace, @ConvertByteMaskArrayToFPColorArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdRGBAColorspace, @ConvertByteMaskArrayToStdRGBAArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdHSLAColorspace, @ConvertByteMaskArrayToStdHSLAArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdHSVAColorspace, @ConvertByteMaskArrayToStdHSVAArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TStdCMYKColorspace, @ConvertByteMaskArrayToStdCMYKArray); - ColorspaceCollection.AddConversion(TByteMaskColorspace, TExpandedPixelColorspace, @ConvertByteMaskArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TColorColorspace, @ConvertExpandedPixelArrayToColorArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TBGRAPixelColorspace, @ConvertExpandedPixelArrayToBGRAPixelArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TFPColorColorspace, @ConvertExpandedPixelArrayToFPColorArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdRGBAColorspace, @ConvertExpandedPixelArrayToStdRGBAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TAdobeRGBAColorspace, @ConvertExpandedPixelArrayToAdobeRGBAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdHSLAColorspace, @ConvertExpandedPixelArrayToStdHSLAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdHSVAColorspace, @ConvertExpandedPixelArrayToStdHSVAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TStdCMYKColorspace, @ConvertExpandedPixelArrayToStdCMYKArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TByteMaskColorspace, @ConvertExpandedPixelArrayToByteMaskArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TLinearRGBAColorspace, @ConvertExpandedPixelArrayToLinearRGBAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, THSLAPixelColorspace, @ConvertExpandedPixelArrayToHSLAPixelArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TGSBAPixelColorspace, @ConvertExpandedPixelArrayToGSBAPixelArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TXYZAColorspace, @ConvertExpandedPixelArrayToXYZAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TWordXYZAColorspace, @ConvertExpandedPixelArrayToWordXYZAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TLabAColorspace, @ConvertExpandedPixelArrayToLabAArray); - ColorspaceCollection.AddConversion(TExpandedPixelColorspace, TLChAColorspace, @ConvertExpandedPixelArrayToLChAArray); - ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TAdobeRGBAColorspace, @ConvertLinearRGBAArrayToAdobeRGBAArray); - ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TExpandedPixelColorspace, @ConvertLinearRGBAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TXYZAColorspace, @ConvertLinearRGBAArrayToXYZAArray); - ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TLabAColorspace, @ConvertLinearRGBAArrayToLabAArray); - ColorspaceCollection.AddConversion(TLinearRGBAColorspace, TLChAColorspace, @ConvertLinearRGBAArrayToLChAArray); - ColorspaceCollection.AddConversion(THSLAPixelColorspace, TExpandedPixelColorspace, @ConvertHSLAPixelArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(THSLAPixelColorspace, TGSBAPixelColorspace, @ConvertHSLAPixelArrayToGSBAPixelArray); - ColorspaceCollection.AddConversion(TGSBAPixelColorspace, TExpandedPixelColorspace, @ConvertGSBAPixelArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TGSBAPixelColorspace, THSLAPixelColorspace, @ConvertGSBAPixelArrayToHSLAPixelArray); - ColorspaceCollection.AddConversion(TXYZAColorspace, TAdobeRGBAColorspace, @ConvertXYZAArrayToAdobeRGBAArray); - ColorspaceCollection.AddConversion(TXYZAColorspace, TExpandedPixelColorspace, @ConvertXYZAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TXYZAColorspace, TLinearRGBAColorspace, @ConvertXYZAArrayToLinearRGBAArray); - ColorspaceCollection.AddConversion(TXYZAColorspace, TWordXYZAColorspace, @ConvertXYZAArrayToWordXYZAArray); - ColorspaceCollection.AddConversion(TXYZAColorspace, TLabAColorspace, @ConvertXYZAArrayToLabAArray); - ColorspaceCollection.AddConversion(TXYZAColorspace, TLChAColorspace, @ConvertXYZAArrayToLChAArray); - ColorspaceCollection.AddConversion(TWordXYZAColorspace, TAdobeRGBAColorspace, @ConvertWordXYZAArrayToAdobeRGBAArray); - ColorspaceCollection.AddConversion(TWordXYZAColorspace, TExpandedPixelColorspace, @ConvertWordXYZAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TWordXYZAColorspace, TXYZAColorspace, @ConvertWordXYZAArrayToXYZAArray); - ColorspaceCollection.AddConversion(TWordXYZAColorspace, TLabAColorspace, @ConvertWordXYZAArrayToLabAArray); - ColorspaceCollection.AddConversion(TWordXYZAColorspace, TLChAColorspace, @ConvertWordXYZAArrayToLChAArray); - ColorspaceCollection.AddConversion(TLabAColorspace, TAdobeRGBAColorspace, @ConvertLabAArrayToAdobeRGBAArray); - ColorspaceCollection.AddConversion(TLabAColorspace, TExpandedPixelColorspace, @ConvertLabAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TLabAColorspace, TLinearRGBAColorspace, @ConvertLabAArrayToLinearRGBAArray); - ColorspaceCollection.AddConversion(TLabAColorspace, TXYZAColorspace, @ConvertLabAArrayToXYZAArray); - ColorspaceCollection.AddConversion(TLabAColorspace, TWordXYZAColorspace, @ConvertLabAArrayToWordXYZAArray); - ColorspaceCollection.AddConversion(TLabAColorspace, TLChAColorspace, @ConvertLabAArrayToLChAArray); - ColorspaceCollection.AddConversion(TLChAColorspace, TAdobeRGBAColorspace, @ConvertLChAArrayToAdobeRGBAArray); - ColorspaceCollection.AddConversion(TLChAColorspace, TExpandedPixelColorspace, @ConvertLChAArrayToExpandedPixelArray); - ColorspaceCollection.AddConversion(TLChAColorspace, TLinearRGBAColorspace, @ConvertLChAArrayToLinearRGBAArray); - ColorspaceCollection.AddConversion(TLChAColorspace, TXYZAColorspace, @ConvertLChAArrayToXYZAArray); - ColorspaceCollection.AddConversion(TLChAColorspace, TWordXYZAColorspace, @ConvertLChAArrayToWordXYZAArray); - ColorspaceCollection.AddConversion(TLChAColorspace, TLabAColorspace, @ConvertLChAArrayToLabAArray); -{$ENDIF} diff --git a/components/bgrabitmap/generatedunicode.inc b/components/bgrabitmap/generatedunicode.inc deleted file mode 100644 index 3a9845e..0000000 --- a/components/bgrabitmap/generatedunicode.inc +++ /dev/null @@ -1,1209 +0,0 @@ -{ This file is generated by dev/parseunicode/parseunicodeclasses program } - -function GetUnicodeBidiClassEx(u: LongWord): TUnicodeBidiClass; -begin - case u of - $00000..$07FFF: - case u of - $00000..$003FF: - case u of - $00..$08, $0E..$1B, $7F..$84, $86..$9F, $AD: result := ubcBoundaryNeutral; - $09, $0B, $1F: result := ubcSegmentSeparator; - $0A, $0D, $1C..$1E, $85: result := ubcParagraphSeparator; - $0C, $20: result := ubcWhiteSpace; - $41..$5A, $61..$7A, $AA, $B5, $BA, $C0..$D6, $D8..$F6, $F8..$2B8, $2BB..$2C1, $2D0, $2D1, - $2E0..$2E4, $2EE, $370..$373, $376, $377, $37A..$37D, $37F, $386, $388..$38A, $38C, $38E..$3A1, - $3A3..$3F5, $3F7: result := ubcLeftToRight; - $3F8..$3FF: result := ubcLeftToRight; - $30..$39, $B2, $B3, $B9: result := ubcEuropeanNumber; - $2B, $2D: result := ubcEuropeanNumberSeparator; - $23..$25, $A2..$A5, $B0, $B1: result := ubcEuropeanNumberTerminator; - $2C, $2E, $2F, $3A, $A0: result := ubcCommonSeparator; - $300..$36F: result := ubcNonSpacingMark; - $21, $22, $26, $27, $2A, $3B, $3D, $3F, $40, $5C, $5E..$60, $7C, $7E, $A1, $A6..$A9, $AC, - $AE, $AF, $B4, $B6..$B8, $BC..$BF, $D7, $F7, $2B9, $2BA, $2C2..$2CF, $2D2: result := ubcOtherNeutrals; - $2D3..$2DF, $2E5..$2ED, $2EF..$2FF, $374, $375, $37E, $384, $385, $387, $3F6: result := ubcOtherNeutrals; - $28, $29, $3C, $3E, $5B, $5D, $7B, $7D, $AB, $BB: result := ubcMirroredNeutral; - else result := ubcUnknown; - end; - $00400..$007FF: - case u of - $400..$482, $48A..$52F, $531..$556, $559..$589: result := ubcLeftToRight; - $5BE, $5C0, $5C3, $5C6, $5D0..$5EA, $5EF..$5F4, $7C0..$7EA, $7F4, $7F5, $7FA, $7FE, $7FF: result := ubcRightToLeft; - $608, $60B, $60D, $61B, $61C, $61E..$64A, $66D..$66F, $671..$6D5, $6E5, $6E6, $6EE, $6EF, - $6FA..$70D, $70F, $710, $712..$72F, $74D..$7A5, $7B1: result := ubcArabicLetter; - $6F0..$6F9: result := ubcEuropeanNumber; - $58F, $609, $60A, $66A: result := ubcEuropeanNumberTerminator; - $600..$605, $660..$669, $66B, $66C, $6DD: result := ubcArabicNumber; - $60C: result := ubcCommonSeparator; - $483..$489, $591..$5BD, $5BF, $5C1, $5C2, $5C4, $5C5, $5C7, $610..$61A, $64B..$65F, $670, - $6D6..$6DC, $6DF..$6E4, $6E7, $6E8, $6EA..$6ED, $711, $730..$74A, $7A6..$7B0, $7EB..$7F3, - $7FD: result := ubcNonSpacingMark; - $58A, $58D, $58E, $606, $607, $60E, $60F, $6DE, $6E9, $7F6..$7F9: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $00800..$00BFF: - case u of - $904..$939, $93D, $950, $958..$961, $964..$980, $985..$98C, $98F, $990, $993..$9A8, $9AA..$9B0, - $9B2, $9B6..$9B9, $9BD, $9CE, $9DC, $9DD, $9DF..$9E1, $9E6..$9F1, $9F4..$9FA, $9FC, $9FD, - $A05..$A0A, $A0F, $A10, $A13..$A28, $A2A: result := ubcLeftToRight; - $A2B..$A30, $A32, $A33, $A35, $A36, $A38, $A39, $A59..$A5C, $A5E, $A66..$A6F, $A72..$A74, - $A76, $A85..$A8D, $A8F..$A91, $A93..$AA8, $AAA..$AB0, $AB2, $AB3, $AB5..$AB9, $ABD, $AD0, - $AE0, $AE1, $AE6..$AF0, $AF9, $B05..$B0C, $B0F: result := ubcLeftToRight; - $903, $93B, $93E..$940, $949..$94C, $94E, $94F, $982, $983, $9BE..$9C0, $9C7, $9C8, $9CB, - $9CC, $9D7, $A03, $A3E..$A40, $A83, $ABE..$AC0, $AC9, $ACB, $ACC, $B02, $B03, $B3E, $B40, - $B47, $B48, $B4B, $B4C, $B57: result := ubcCombiningLeftToRight; - $B10, $B13..$B28, $B2A..$B30, $B32, $B33, $B35..$B39, $B3D, $B5C, $B5D, $B5F..$B61, $B66..$B77, - $B83, $B85..$B8A, $B8E..$B90, $B92..$B95, $B99, $B9A, $B9C, $B9E, $B9F, $BA3, $BA4, $BA8..$BAA, - $BAE..$BB9, $BD0, $BE6..$BF2: result := ubcLeftToRight; - $800..$815, $81A, $824, $828, $830..$83E, $840..$858, $85E: result := ubcRightToLeft; - $860..$86A, $8A0..$8B4, $8B6..$8C7: result := ubcArabicLetter; - $BBE, $BBF, $BC1, $BC2, $BC6..$BC8, $BCA..$BCC, $BD7: result := ubcCombiningLeftToRight; - $9F2, $9F3, $9FB, $AF1, $BF9: result := ubcEuropeanNumberTerminator; - $8E2: result := ubcArabicNumber; - $816..$819, $81B..$823, $825..$827, $829..$82D, $859..$85B, $8D3..$8E1, $8E3..$902, $93A, - $93C, $941..$948, $94D, $951..$957, $962, $963, $981, $9BC, $9C1..$9C4, $9CD, $9E2, $9E3, - $9FE, $A01, $A02, $A3C, $A41: result := ubcNonSpacingMark; - $A42, $A47, $A48, $A4B..$A4D, $A51, $A70, $A71, $A75, $A81, $A82, $ABC, $AC1..$AC5, $AC7, - $AC8, $ACD, $AE2, $AE3, $AFA..$AFF, $B01, $B3C, $B3F, $B41..$B44, $B4D, $B55, $B56, $B62, - $B63, $B82, $BC0: result := ubcNonSpacingMark; - $BCD: result := ubcNonSpacingMark; - $BF3..$BF8, $BFA: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $00C00..$00FFF: - case u of - $C05..$C0C, $C0E..$C10, $C12..$C28, $C2A..$C39, $C3D, $C58..$C5A, $C60, $C61, $C66..$C6F, - $C77, $C7F, $C80, $C84..$C8C, $C8E..$C90, $C92..$CA8, $CAA..$CB3, $CB5..$CB9, $CBD, $CBF, - $CC6, $CDE, $CE0, $CE1, $CE6..$CEF, $CF1: result := ubcLeftToRight; - $CF2, $D04..$D0C, $D0E..$D10, $D12..$D3A, $D3D, $D4E, $D4F, $D54..$D56, $D58..$D61, $D66..$D7F, - $D85..$D96, $D9A..$DB1, $DB3..$DBB, $DBD, $DC0..$DC6, $DE6..$DEF, $DF4, $E01..$E30, $E32, - $E33, $E40..$E46, $E4F..$E5B, $E81, $E82, $E84: result := ubcLeftToRight; - $E86..$E8A, $E8C..$EA3, $EA5, $EA7..$EB0, $EB2, $EB3, $EBD, $EC0..$EC4, $EC6, $ED0..$ED9, - $EDC..$EDF, $F00..$F17, $F1A..$F34, $F36, $F38, $F40..$F47, $F49..$F6C, $F85, $F88..$F8C, - $FBE..$FC5, $FC7..$FCC, $FCE..$FDA: result := ubcLeftToRight; - $C01..$C03, $C41..$C44, $C82, $C83, $CBE, $CC0..$CC4, $CC7, $CC8, $CCA, $CCB, $CD5, $CD6, - $D02, $D03, $D3E..$D40, $D46..$D48, $D4A..$D4C, $D57, $D82, $D83, $DCF..$DD1, $DD8..$DDF, - $DF2, $DF3, $F3E, $F3F, $F7F: result := ubcCombiningLeftToRight; - $E3F: result := ubcEuropeanNumberTerminator; - $C00, $C04, $C3E..$C40, $C46..$C48, $C4A..$C4D, $C55, $C56, $C62, $C63, $C81, $CBC, $CCC, - $CCD, $CE2, $CE3, $D00, $D01, $D3B, $D3C, $D41..$D44, $D4D, $D62, $D63, $D81, $DCA, $DD2..$DD4, - $DD6, $E31, $E34: result := ubcNonSpacingMark; - $E35..$E3A, $E47..$E4E, $EB1, $EB4..$EBC, $EC8..$ECD, $F18, $F19, $F35, $F37, $F39, $F71..$F7E, - $F80..$F84, $F86, $F87, $F8D..$F97, $F99..$FBC, $FC6: result := ubcNonSpacingMark; - $C78..$C7E: result := ubcOtherNeutrals; - $F3A..$F3D: result := ubcMirroredNeutral; - else result := ubcUnknown; - end; - $01000..$017FF: - case u of - $1680: result := ubcWhiteSpace; - $1000..$102A, $103F..$1055, $105A..$105D, $1061, $1065, $1066, $106E..$1070, $1075..$1081, - $108E, $1090..$1099, $109E..$10C5, $10C7, $10CD, $10D0..$1248, $124A..$124D, $1250..$1256, - $1258, $125A..$125D, $1260..$1288, $128A..$128D, $1290..$12B0, $12B2..$12B5, $12B8: result := ubcLeftToRight; - $12B9..$12BE, $12C0, $12C2..$12C5, $12C8..$12D6, $12D8..$1310, $1312..$1315, $1318..$135A, - $1360..$137C, $1380..$138F, $13A0..$13F5, $13F8..$13FD, $1401..$167F, $1681..$169A, $16A0..$16F8, - $1700..$170C, $170E..$1711, $1720..$1731, $1735, $1736, $1740..$1751, $1760..$176C, $176E..$1770, - $1780: result := ubcLeftToRight; - $1781..$17B3, $17D4..$17DA, $17DC, $17E0..$17E9: result := ubcLeftToRight; - $102B, $102C, $1031, $1038, $103B, $103C, $1056, $1057, $1062..$1064, $1067..$106D, $1083, - $1084, $1087..$108C, $108F, $109A..$109C, $17B6, $17BE..$17C5, $17C7, $17C8: result := ubcCombiningLeftToRight; - $17DB: result := ubcEuropeanNumberTerminator; - $102D..$1030, $1032..$1037, $1039, $103A, $103D, $103E, $1058, $1059, $105E..$1060, $1071..$1074, - $1082, $1085, $1086, $108D, $109D, $135D..$135F, $1712..$1714, $1732..$1734, $1752, $1753, - $1772, $1773, $17B4, $17B5, $17B7..$17BD, $17C6, $17C9..$17D3, $17DD: result := ubcNonSpacingMark; - $1390..$1399, $1400, $17F0..$17F9: result := ubcOtherNeutrals; - $169B, $169C: result := ubcMirroredNeutral; - else result := ubcUnknown; - end; - $01800..$01FFF: - case u of - $180E: result := ubcBoundaryNeutral; - $1810..$1819, $1820..$1878, $1880..$1884, $1887..$18A8, $18AA, $18B0..$18F5, $1900..$191E, - $1946..$196D, $1970..$1974, $1980..$19AB, $19B0..$19C9, $19D0..$19DA, $1A00..$1A16, $1A1E..$1A54, - $1A80..$1A89, $1A90..$1A99, $1AA0..$1AAD, $1B05..$1B33, $1B45..$1B4B, $1B50..$1B6A, $1B74..$1B7C, - $1B83: result := ubcLeftToRight; - $1923..$1926, $1929..$192B, $1930, $1931, $1933..$1938, $1A19, $1A1A, $1A55, $1A57, $1A61, - $1A63, $1A64, $1A6D..$1A72, $1B04, $1B35, $1B3B, $1B3D..$1B41, $1B43, $1B44, $1B82, $1BA1, - $1BA6, $1BA7, $1BAA, $1BE7, $1BEA..$1BEC, $1BEE: result := ubcCombiningLeftToRight; - $1B84..$1BA0, $1BAE..$1BE5, $1BFC..$1C23, $1C3B..$1C49, $1C4D..$1C88, $1C90..$1CBA, $1CBD..$1CC7, - $1CD3, $1CE9..$1CEC, $1CEE..$1CF3, $1CF5, $1CF6, $1CFA, $1D00..$1DBF, $1E00..$1F15, $1F18..$1F1D, - $1F20..$1F45, $1F48..$1F4D, $1F50..$1F57, $1F59, $1F5B, $1F5D, $1F5F: result := ubcLeftToRight; - $1F60..$1F7D, $1F80..$1FB4, $1FB6..$1FBC, $1FBE, $1FC2..$1FC4, $1FC6..$1FCC, $1FD0..$1FD3, - $1FD6..$1FDB, $1FE0..$1FEC, $1FF2..$1FF4, $1FF6..$1FFC: result := ubcLeftToRight; - $1BF2, $1BF3, $1C24..$1C2B, $1C34, $1C35, $1CE1, $1CF7: result := ubcCombiningLeftToRight; - $180B..$180D, $1885, $1886, $18A9, $1920..$1922, $1927, $1928, $1932, $1939..$193B, $1A17, - $1A18, $1A1B, $1A56, $1A58..$1A5E, $1A60, $1A62, $1A65..$1A6C, $1A73..$1A7C, $1A7F, $1AB0..$1AC0, - $1B00..$1B03, $1B34, $1B36..$1B3A, $1B3C, $1B42: result := ubcNonSpacingMark; - $1B6B..$1B73, $1B80, $1B81, $1BA2..$1BA5, $1BA8, $1BA9, $1BAB..$1BAD, $1BE6, $1BE8, $1BE9, - $1BED, $1BEF..$1BF1, $1C2C..$1C33, $1C36, $1C37, $1CD0..$1CD2, $1CD4..$1CE0, $1CE2..$1CE8, - $1CED, $1CF4, $1CF8, $1CF9, $1DC0..$1DF9, $1DFB..$1DFF: result := ubcNonSpacingMark; - $1800..$180A, $1940, $1944, $1945, $19DE..$19FF, $1FBD, $1FBF..$1FC1, $1FCD..$1FCF, $1FDD..$1FDF, - $1FED..$1FEF, $1FFD, $1FFE: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $02000..$02FFF: - case u of - $200B..$200D, $2060..$2064, $206A..$206F: result := ubcBoundaryNeutral; - $2029: result := ubcParagraphSeparator; - $2000..$200A, $2028, $205F: result := ubcWhiteSpace; - $200E, $2071, $207F, $2090..$209C, $2102, $2107, $210A..$2113, $2115, $2119..$211D, $2124, - $2126, $2128, $212A..$212D, $212F..$2139, $213C..$213F, $2145..$2149, $214E, $214F, $2160..$2188, - $2336..$237A, $2395, $249C..$24E9, $26AC: result := ubcLeftToRight; - $2800..$28FF, $2C00..$2C2E, $2C30..$2C5E, $2C60..$2CE4, $2CEB..$2CEE, $2CF2, $2CF3, $2D00..$2D25, - $2D27, $2D2D, $2D30..$2D67, $2D6F, $2D70, $2D80..$2D96, $2DA0..$2DA6, $2DA8..$2DAE, $2DB0..$2DB6, - $2DB8..$2DBE, $2DC0..$2DC6, $2DC8..$2DCE, $2DD0..$2DD6, $2DD8..$2DDE: result := ubcLeftToRight; - $200F: result := ubcRightToLeft; - $2070, $2074..$2079, $2080..$2089, $2488..$249B: result := ubcEuropeanNumber; - $207A, $207B, $208A, $208B, $2212: result := ubcEuropeanNumberSeparator; - $2030..$2034, $20A0..$20BF, $212E, $2213: result := ubcEuropeanNumberTerminator; - $202F, $2044: result := ubcCommonSeparator; - $20D0..$20F0, $2CEF..$2CF1, $2D7F, $2DE0..$2DFF: result := ubcNonSpacingMark; - $2010..$2027, $2035..$2038, $203B..$2043, $2047..$205E, $207C, $208C, $2100, $2101, $2103..$2106, - $2108, $2109, $2114, $2116..$2118, $211E..$2123, $2125, $2127, $2129, $213A, $213B, $2141..$2144, - $214A..$214D, $2150..$215F, $2189..$218B, $2190..$2200, $2205: result := ubcOtherNeutrals; - $2039, $203A, $2045, $2046, $207D, $207E, $208D, $208E, $2140, $2201..$2204, $2208..$220D, - $2211, $2215, $2216, $221A..$221D, $221F..$2222, $2224, $2226, $222B..$2233, $2239, $223B..$224C, - $2252..$2255, $225F, $2260, $2262, $2264..$226B, $226E..$228C, $228F: result := ubcMirroredNeutral; - $2206, $2207, $220E..$2210, $2214, $2217..$2219, $221E, $2223, $2225, $2227..$222A, $2234..$2238, - $223A, $224D..$2251, $2256..$225E, $2261, $2263, $226C, $226D, $228D, $228E, $2293..$2297, - $2299..$22A1, $22A4, $22A5, $22B9..$22BD, $22C0..$22C8, $22CE: result := ubcOtherNeutrals; - $22CF, $22D2..$22D5, $22EE, $22EF, $2300..$2307, $230C..$231F, $2322..$2328, $232B..$2335, - $237B..$2394, $2396..$2426, $2440..$244A, $2460..$2487, $24EA..$26AB, $26AD..$2767, $2776..$27BF, - $27C1, $27C2, $27C7, $27CA, $27CE..$27D2, $27D7..$27DB, $27DF..$27E1, $27F0..$27FF, $2900: result := ubcOtherNeutrals; - $2290..$2292, $2298, $22A2, $22A3, $22A6..$22B8, $22BE, $22BF, $22C9..$22CD, $22D0, $22D1, - $22D6..$22ED, $22F0..$22FF, $2308..$230B, $2320, $2321, $2329, $232A, $2768..$2775, $27C0, - $27C3..$27C6, $27C8, $27C9, $27CB..$27CD, $27D3..$27D6, $27DC..$27DE, $27E2..$27EF, $2983..$2998, - $299B: result := ubcMirroredNeutral; - $2901..$2982, $2999, $299A, $29A1, $29B0..$29B7, $29B9..$29BF, $29C6..$29C8, $29CA..$29CD, - $29D3, $29D6, $29D7, $29DD..$29E0, $29E2, $29E6, $29E7, $29EA..$29F3, $29FA, $29FB, $29FE..$2A09, - $2A1D, $2A22, $2A23, $2A25, $2A27, $2A28, $2A2A, $2A2F..$2A33, $2A36: result := ubcOtherNeutrals; - $299C..$29A0, $29A2..$29AF, $29B8, $29C0..$29C5, $29C9, $29CE..$29D2, $29D4, $29D5, $29D8..$29DC, - $29E1, $29E3..$29E5, $29E8, $29E9, $29F4..$29F9, $29FC, $29FD, $2A0A..$2A1C, $2A1E..$2A21, - $2A24, $2A26, $2A29, $2A2B..$2A2E, $2A34, $2A35, $2A3C..$2A3E, $2A57: result := ubcMirroredNeutral; - $2A37..$2A3B, $2A3F..$2A56, $2A59..$2A63, $2A66..$2A69, $2A6E, $2A71, $2A72, $2A75..$2A78, - $2AA4, $2AA5, $2AAE, $2AD7..$2ADB, $2ADD, $2ADF..$2AE1, $2AE7..$2AEB, $2AEF..$2AF2, $2AF4..$2AF6, - $2AFC, $2AFE..$2B73, $2B76..$2B95, $2B97..$2BFD, $2BFF, $2CE5..$2CEA, $2CF9: result := ubcOtherNeutrals; - $2CFA..$2CFF, $2E00, $2E01, $2E06..$2E08, $2E0B, $2E0E..$2E1B, $2E1E, $2E1F, $2E2A..$2E52, - $2E80..$2E99, $2E9B..$2EF3, $2F00..$2FD5, $2FF0..$2FFB: result := ubcOtherNeutrals; - $2A58, $2A64, $2A65, $2A6A..$2A6D, $2A6F, $2A70, $2A73, $2A74, $2A79..$2AA3, $2AA6..$2AAD, - $2AAF..$2AD6, $2ADC, $2ADE, $2AE2..$2AE6, $2AEC..$2AEE, $2AF3, $2AF7..$2AFB, $2AFD, $2BFE, - $2E02..$2E05, $2E09, $2E0A, $2E0C, $2E0D, $2E1C, $2E1D, $2E20..$2E29: result := ubcMirroredNeutral; - else result := ubcUnknown; - end; - else - case u of - $3000: result := ubcWhiteSpace; - $3005..$3007, $3021..$3029, $3031..$3035, $3038..$303C, $3041..$3096, $309D..$309F, $30A1..$30FA, - $30FC..$30FF, $3105..$312F, $3131..$318E, $3190..$31BF, $31F0..$321C, $3220..$324F, $3260..$327B, - $327F..$32B0, $32C0..$32CB, $32D0..$3376, $337B..$33DD, $33E0..$33FE, $3400, $4DBF, $4E00: result := ubcLeftToRight; - $302E, $302F: result := ubcCombiningLeftToRight; - $302A..$302D, $3099, $309A: result := ubcNonSpacingMark; - $3001..$3004, $3012, $3013, $301C..$3020, $3030, $3036, $3037, $303D..$303F, $309B, $309C, - $30A0, $30FB, $31C0..$31E3, $321D, $321E, $3250..$325F, $327C..$327E, $32B1..$32BF, $32CC..$32CF, - $3377..$337A, $33DE, $33DF, $33FF, $4DC0..$4DFF: result := ubcOtherNeutrals; - $3008..$3011, $3014..$301B: result := ubcMirroredNeutral; - else result := ubcUnknown; - end; - end; - $08000..$0BFFF: - case u of - $9FFC, $A000..$A48C, $A4D0..$A60C, $A610..$A62B, $A640..$A66E, $A680..$A69D, $A6A0..$A6EF, - $A6F2..$A6F7, $A722..$A787, $A789..$A7BF, $A7C2..$A7CA, $A7F5..$A801, $A803..$A805, $A807..$A80A, - $A80C..$A822, $A830..$A837, $A840..$A873, $A882..$A8B3, $A8CE..$A8D9, $A8F2..$A8FE, $A900..$A925, - $A92E: result := ubcLeftToRight; - $A92F..$A946, $A95F..$A97C, $A984..$A9B2, $A9C1..$A9CD, $A9CF..$A9D9, $A9DE..$A9E4, $A9E6..$A9FE, - $AA00..$AA28, $AA40..$AA42, $AA44..$AA4B, $AA50..$AA59, $AA5C..$AA7A, $AA7E..$AAAF, $AAB1, - $AAB5, $AAB6, $AAB9..$AABD, $AAC0, $AAC2, $AADB..$AAEA, $AAF0..$AAF4, $AB01..$AB06, $AB09: result := ubcLeftToRight; - $AB0A..$AB0E, $AB11..$AB16, $AB20..$AB26, $AB28..$AB2E, $AB30..$AB69, $AB70..$ABE2, $ABEB, - $ABF0..$ABF9, $AC00: result := ubcLeftToRight; - $A823, $A824, $A827, $A880, $A881, $A8B4..$A8C3, $A952, $A953, $A983, $A9B4, $A9B5, $A9BA, - $A9BB, $A9BE..$A9C0, $AA2F, $AA30, $AA33, $AA34, $AA4D, $AA7B, $AA7D, $AAEB, $AAEE, $AAEF, - $AAF5, $ABE3, $ABE4, $ABE6, $ABE7, $ABE9, $ABEA, $ABEC: result := ubcCombiningLeftToRight; - $A838, $A839: result := ubcEuropeanNumberTerminator; - $A66F..$A672, $A674..$A67D, $A69E, $A69F, $A6F0, $A6F1, $A802, $A806, $A80B, $A825, $A826, - $A82C, $A8C4, $A8C5, $A8E0..$A8F1, $A8FF, $A926..$A92D, $A947..$A951, $A980..$A982, $A9B3, - $A9B6..$A9B9, $A9BC, $A9BD, $A9E5, $AA29..$AA2E, $AA31, $AA32, $AA35: result := ubcNonSpacingMark; - $AA36, $AA43, $AA4C, $AA7C, $AAB0, $AAB2..$AAB4, $AAB7, $AAB8, $AABE, $AABF, $AAC1, $AAEC, - $AAED, $AAF6, $ABE5, $ABE8, $ABED: result := ubcNonSpacingMark; - $A490..$A4C6, $A60D..$A60F, $A673, $A67E, $A67F, $A700..$A721, $A788, $A828..$A82B, $A874..$A877, - $AB6A, $AB6B: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $0C000..$0FFFF: - case u of - $FEFF: result := ubcBoundaryNeutral; - $D7A3, $D7B0..$D7C6, $D7CB..$D7FB, $D800, $DB7F, $DB80, $DBFF, $DC00, $DFFF, $E000, $F8FF..$FA6D, - $FA70..$FAD9, $FB00..$FB06, $FB13..$FB17, $FF21..$FF3A, $FF41..$FF5A, $FF66..$FFBE, $FFC2..$FFC7, - $FFCA..$FFCF, $FFD2..$FFD7, $FFDA..$FFDC: result := ubcLeftToRight; - $FB1D, $FB1F..$FB28, $FB2A..$FB36, $FB38..$FB3C, $FB3E, $FB40, $FB41, $FB43, $FB44, $FB46..$FB4F: result := ubcRightToLeft; - $FB50..$FBC1, $FBD3..$FD3D, $FD50..$FD8F, $FD92..$FDC7, $FDF0..$FDFC, $FE70..$FE74, $FE76..$FEFC: result := ubcArabicLetter; - $FF10..$FF19: result := ubcEuropeanNumber; - $FB29, $FE62, $FE63, $FF0B, $FF0D: result := ubcEuropeanNumberSeparator; - $FE5F, $FE69, $FE6A, $FF03..$FF05, $FFE0, $FFE1, $FFE5, $FFE6: result := ubcEuropeanNumberTerminator; - $FE50, $FE52, $FE55, $FF0C, $FF0E, $FF0F, $FF1A: result := ubcCommonSeparator; - $FB1E, $FE00..$FE0F, $FE20..$FE2F: result := ubcNonSpacingMark; - $FD3E, $FD3F, $FDFD, $FE10..$FE19, $FE30..$FE4F, $FE51, $FE54, $FE56..$FE58, $FE60, $FE61, - $FE66, $FE68, $FE6B, $FF01, $FF02, $FF06, $FF07, $FF0A, $FF1B, $FF1D, $FF1F, $FF20, $FF3C, - $FF3E..$FF40, $FF5C, $FF5E, $FF61: result := ubcOtherNeutrals; - $FF64, $FF65, $FFE2..$FFE4, $FFE8..$FFEE, $FFF9..$FFFD: result := ubcOtherNeutrals; - $FE59..$FE5E, $FE64, $FE65, $FF08, $FF09, $FF1C, $FF1E, $FF3B, $FF3D, $FF5B, $FF5D, $FF5F, - $FF60, $FF62, $FF63: result := ubcMirroredNeutral; - else result := ubcUnknown; - end; - else - case u of - $10000..$107FF: - case u of - $10000..$1000B, $1000D..$10026, $10028..$1003A, $1003C, $1003D, $1003F..$1004D, $10050..$1005D, - $10080..$100FA, $10100, $10102, $10107..$10133, $10137..$1013F, $1018D, $1018E, $101D0..$101FC, - $10280..$1029C, $102A0..$102D0, $10300..$10323, $1032D..$1034A, $10350..$10375, $10380..$1039D, - $1039F..$103C3, $103C8..$103D5, $10400: result := ubcLeftToRight; - $10401..$1049D, $104A0..$104A9, $104B0..$104D3, $104D8..$104FB, $10500..$10527, $10530..$10563, - $1056F, $10600..$10736, $10740..$10755, $10760..$10767: result := ubcLeftToRight; - $102E1..$102FB: result := ubcEuropeanNumber; - $101FD, $102E0, $10376..$1037A: result := ubcNonSpacingMark; - $10101, $10140..$1018C, $10190..$1019C, $101A0: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $10800..$10FFF: - case u of - $10800..$10805, $10808, $1080A..$10835, $10837, $10838, $1083C, $1083F..$10855, $10857..$1089E, - $108A7..$108AF, $108E0..$108F2, $108F4, $108F5, $108FB..$1091B, $10920..$10939, $1093F, - $10980..$109B7, $109BC..$109CF, $109D2..$10A00, $10A10..$10A13, $10A15..$10A17, $10A19..$10A35, - $10A40..$10A48, $10A50..$10A58, $10A60: result := ubcRightToLeft; - $10A61..$10A9F, $10AC0..$10AE4, $10AEB..$10AF6, $10B00..$10B35, $10B40..$10B55, $10B58..$10B72, - $10B78..$10B91, $10B99..$10B9C, $10BA9..$10BAF, $10C00..$10C48, $10C80..$10CB2, $10CC0..$10CF2, - $10CFA..$10CFF, $10E80..$10EA9, $10EAD, $10EB0, $10EB1, $10F00..$10F27, $10FB0..$10FCB, - $10FE0..$10FF6: result := ubcRightToLeft; - $10D00..$10D23, $10F30..$10F45, $10F51..$10F59: result := ubcArabicLetter; - $10D30..$10D39, $10E60..$10E7E: result := ubcArabicNumber; - $10A01..$10A03, $10A05, $10A06, $10A0C..$10A0F, $10A38..$10A3A, $10A3F, $10AE5, $10AE6, - $10D24..$10D27, $10EAB, $10EAC, $10F46..$10F50: result := ubcNonSpacingMark; - $1091F, $10B39..$10B3F: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $11000..$117FF: - case u of - $11003..$11037, $11047..$1104D, $11066..$1106F, $11083..$110AF, $110BB..$110C1, $110CD, - $110D0..$110E8, $110F0..$110F9, $11103..$11126, $11136..$11144, $11147, $11150..$11172, - $11174..$11176, $11183..$111B2, $111C1..$111C8, $111CD, $111D0..$111DF, $111E1..$111F4, - $11200..$11211, $11213..$1122B, $11238..$1123D, $11280: result := ubcLeftToRight; - $11000, $11002, $11082, $110B0..$110B2, $110B7, $110B8, $1112C, $11145, $11146, $11182, - $111B3..$111B5, $111BF, $111C0, $111CE, $1122C..$1122E, $11232, $11233, $11235, $112E0..$112E2, - $11302, $11303, $1133E, $1133F, $11341..$11344, $11347, $11348, $1134B..$1134D, $11357, - $11362: result := ubcCombiningLeftToRight; - $11281..$11286, $11288, $1128A..$1128D, $1128F..$1129D, $1129F..$112A9, $112B0..$112DE, - $112F0..$112F9, $11305..$1130C, $1130F, $11310, $11313..$11328, $1132A..$11330, $11332, - $11333, $11335..$11339, $1133D, $11350, $1135D..$11361, $11400..$11434, $11447..$1145B, - $1145D, $1145F..$11461, $11480..$114AF, $114C4: result := ubcLeftToRight; - $114C5..$114C7, $114D0..$114D9, $11580..$115AE, $115C1..$115DB, $11600..$1162F, $11641..$11644, - $11650..$11659, $11680..$116AA, $116B8, $116C0..$116C9, $11700..$1171A, $11730..$1173F: result := ubcLeftToRight; - $11363, $11435..$11437, $11440, $11441, $11445, $114B0..$114B2, $114B9, $114BB..$114BE, - $114C1, $115AF..$115B1, $115B8..$115BB, $115BE, $11630..$11632, $1163B, $1163C, $1163E, - $116AC, $116AE, $116AF, $116B6, $11720, $11721, $11726: result := ubcCombiningLeftToRight; - $11001, $11038..$11046, $1107F..$11081, $110B3..$110B6, $110B9, $110BA, $11100..$11102, - $11127..$1112B, $1112D..$11134, $11173, $11180, $11181, $111B6..$111BE, $111C9..$111CC, - $111CF, $1122F..$11231, $11234, $11236, $11237, $1123E, $112DF, $112E3..$112EA, $11300, - $11301, $1133B, $1133C, $11340: result := ubcNonSpacingMark; - $11366..$1136C, $11370..$11374, $11438..$1143F, $11442..$11444, $11446, $1145E, $114B3..$114B8, - $114BA, $114BF, $114C0, $114C2, $114C3, $115B2..$115B5, $115BC, $115BD, $115BF, $115C0, - $115DC, $115DD, $11633..$1163A, $1163D, $1163F, $11640, $116AB, $116AD, $116B0..$116B5, - $116B7, $1171D: result := ubcNonSpacingMark; - $1171E, $1171F, $11722..$11725, $11727..$1172B: result := ubcNonSpacingMark; - $11052..$11065, $11660..$1166C: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $11800..$17FFF: - case u of - $11800..$1182B, $1183B, $118A0..$118F2, $118FF..$11906, $11909, $1190C..$11913, $11915, - $11916, $11918..$1192F, $1193F, $11941, $11944..$11946, $11950..$11959, $119A0..$119A7, - $119AA..$119D0, $119E1..$119E3, $11A00, $11A07, $11A08, $11A0B..$11A32, $11A3A, $11A3F..$11A46, - $11A50, $11A5C: result := ubcLeftToRight; - $1182C..$1182E, $11838, $11930..$11935, $11937, $11938, $1193D, $11940, $11942, $119D1..$119D3, - $119DC..$119DF, $119E4, $11A39, $11A57, $11A58, $11A97, $11C2F, $11C3E, $11CA9, $11CB1, - $11CB4, $11D8A..$11D8E, $11D93, $11D94, $11D96, $11EF5: result := ubcCombiningLeftToRight; - $11A5D..$11A89, $11A9A..$11AA2, $11AC0..$11AF8, $11C00..$11C08, $11C0A..$11C2E, $11C3F..$11C45, - $11C50..$11C6C, $11C70..$11C8F, $11D00..$11D06, $11D08, $11D09, $11D0B..$11D30, $11D46, - $11D50..$11D59, $11D60..$11D65, $11D67, $11D68, $11D6A..$11D89, $11D98, $11DA0..$11DA9, - $11EE0..$11EF2, $11EF7, $11EF8, $11FB0, $11FC0: result := ubcLeftToRight; - $11FC1..$11FD4, $11FFF..$12399, $12400..$1246E, $12470..$12474, $12480..$12543, $13000..$1342E, - $13430..$13438, $14400..$14646, $16800..$16A38, $16A40..$16A5E, $16A60..$16A69, $16A6E, - $16A6F, $16AD0..$16AED, $16AF5, $16B00..$16B2F, $16B37..$16B45, $16B50..$16B59, $16B5B..$16B61, - $16B63..$16B77, $16B7D..$16B8F, $16E40..$16E9A, $16F00: result := ubcLeftToRight; - $16F01..$16F4A, $16F50, $16F93..$16F9F, $16FE0, $16FE1, $16FE3, $17000: result := ubcLeftToRight; - $11EF6, $16F51..$16F87, $16FF0, $16FF1: result := ubcCombiningLeftToRight; - $11FDD..$11FE0: result := ubcEuropeanNumberTerminator; - $1182F..$11837, $11839, $1183A, $1193B, $1193C, $1193E, $11943, $119D4..$119D7, $119DA, - $119DB, $119E0, $11A01..$11A06, $11A09, $11A0A, $11A33..$11A38, $11A3B..$11A3E, $11A47, - $11A51..$11A56, $11A59..$11A5B, $11A8A..$11A96, $11A98, $11A99, $11C30..$11C36, $11C38..$11C3D, - $11C92..$11CA7, $11CAA..$11CB0, $11CB2: result := ubcNonSpacingMark; - $11CB3, $11CB5, $11CB6, $11D31..$11D36, $11D3A, $11D3C, $11D3D, $11D3F..$11D45, $11D47, - $11D90, $11D91, $11D95, $11D97, $11EF3, $11EF4, $16AF0..$16AF4, $16B30..$16B36, $16F4F, - $16F8F..$16F92, $16FE4: result := ubcNonSpacingMark; - $11FD5..$11FDC, $11FE1..$11FF1, $16FE2: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - $18000..$1DFFF: - case u of - $1BCA0..$1BCA3, $1D173..$1D17A: result := ubcBoundaryNeutral; - $187F7, $18800..$18CD5, $18D00, $18D08, $1B000..$1B11E, $1B150..$1B152, $1B164..$1B167, - $1B170..$1B2FB, $1BC00..$1BC6A, $1BC70..$1BC7C, $1BC80..$1BC88, $1BC90..$1BC99, $1BC9C, - $1BC9F, $1D000..$1D0F5, $1D100..$1D126, $1D129..$1D164, $1D16A..$1D16C, $1D183, $1D184, - $1D18C..$1D1A9, $1D1AE..$1D1E8, $1D2E0: result := ubcLeftToRight; - $1D2E1..$1D2F3, $1D360..$1D378, $1D400..$1D454, $1D456..$1D49C, $1D49E, $1D49F, $1D4A2, - $1D4A5, $1D4A6, $1D4A9..$1D4AC, $1D4AE..$1D4B9, $1D4BB, $1D4BD..$1D4C3, $1D4C5..$1D505, - $1D507..$1D50A, $1D50D..$1D514, $1D516..$1D51C, $1D51E..$1D539, $1D53B..$1D53E, $1D540..$1D544, - $1D546, $1D54A..$1D550, $1D552..$1D6A5, $1D6A8: result := ubcLeftToRight; - $1D6A9..$1D6DA, $1D6DC..$1D714, $1D716..$1D74E, $1D750..$1D788, $1D78A..$1D7C2, $1D7C4..$1D7CB, - $1D800..$1D9FF, $1DA37..$1DA3A, $1DA6D..$1DA74, $1DA76..$1DA83, $1DA85..$1DA8B: result := ubcLeftToRight; - $1D165, $1D166, $1D16D..$1D172: result := ubcCombiningLeftToRight; - $1D7CE..$1D7FF: result := ubcEuropeanNumber; - $1BC9D, $1BC9E, $1D167..$1D169, $1D17B..$1D182, $1D185..$1D18B, $1D1AA..$1D1AD, $1D242..$1D244, - $1DA00..$1DA36, $1DA3B..$1DA6C, $1DA75, $1DA84, $1DA9B..$1DA9F, $1DAA1..$1DAAF: result := ubcNonSpacingMark; - $1D200..$1D241, $1D245, $1D300..$1D356: result := ubcOtherNeutrals; - $1D6DB, $1D715, $1D74F, $1D789, $1D7C3: result := ubcMirroredNeutral; - else result := ubcUnknown; - end; - $1E000..$FFFFF: - case u of - $E0001, $E0020..$E007F: result := ubcBoundaryNeutral; - $1EC71..$1ECB4, $1ED01..$1ED3D, $1EE00..$1EE03, $1EE05..$1EE1F, $1EE21, $1EE22, $1EE24, - $1EE27, $1EE29..$1EE32, $1EE34..$1EE37, $1EE39, $1EE3B, $1EE42, $1EE47, $1EE49, $1EE4B, - $1EE4D..$1EE4F, $1EE51, $1EE52, $1EE54, $1EE57, $1EE59, $1EE5B, $1EE5D: result := ubcArabicLetter; - $1E100..$1E12C, $1E137..$1E13D, $1E140..$1E149, $1E14E, $1E14F, $1E2C0..$1E2EB, $1E2F0..$1E2F9, - $1F110..$1F12E, $1F130..$1F169, $1F170..$1F1AC, $1F1E6..$1F202, $1F210..$1F23B, $1F240..$1F248, - $1F250, $1F251, $20000, $2A6DD, $2A700, $2B734, $2B740, $2B81D, $2B820, $2CEA1, $2CEB0: result := ubcLeftToRight; - $2EBE0, $2F800..$2FA1D, $30000, $3134A, $F0000, $FFFFD: result := ubcLeftToRight; - $1E800..$1E8C4, $1E8C7..$1E8CF, $1E900..$1E943, $1E94B, $1E950..$1E959, $1E95E, $1E95F: result := ubcRightToLeft; - $1EE5F, $1EE61, $1EE62, $1EE64, $1EE67..$1EE6A, $1EE6C..$1EE72, $1EE74..$1EE77, $1EE79..$1EE7C, - $1EE7E, $1EE80..$1EE89, $1EE8B..$1EE9B, $1EEA1..$1EEA3, $1EEA5..$1EEA9, $1EEAB..$1EEBB: result := ubcArabicLetter; - $1F100..$1F10A, $1FBF0..$1FBF9: result := ubcEuropeanNumber; - $1E2FF: result := ubcEuropeanNumberTerminator; - $1E000..$1E006, $1E008..$1E018, $1E01B..$1E021, $1E023, $1E024, $1E026..$1E02A, $1E130..$1E136, - $1E2EC..$1E2EF, $1E8D0..$1E8D6, $1E944..$1E94A, $E0100..$E01EF: result := ubcNonSpacingMark; - $1EEF0, $1EEF1, $1F000..$1F02B, $1F030..$1F093, $1F0A0..$1F0AE, $1F0B1..$1F0BF, $1F0C1..$1F0CF, - $1F0D1..$1F0F5, $1F10B..$1F10F, $1F12F, $1F16A..$1F16F, $1F1AD, $1F260..$1F265, $1F300..$1F6D7, - $1F6E0..$1F6EC, $1F6F0..$1F6FC, $1F700..$1F773, $1F780..$1F7D8, $1F7E0..$1F7EB, $1F800..$1F80B, - $1F810..$1F847, $1F850..$1F859, $1F860: result := ubcOtherNeutrals; - $1F861..$1F887, $1F890..$1F8AD, $1F8B0, $1F8B1, $1F900..$1F978, $1F97A..$1F9CB, $1F9CD..$1FA53, - $1FA60..$1FA6D, $1FA70..$1FA74, $1FA78..$1FA7A, $1FA80..$1FA86, $1FA90..$1FAA8, $1FAB0..$1FAB6, - $1FAC0..$1FAC2, $1FAD0..$1FAD6, $1FB00..$1FB92, $1FB94..$1FBCA: result := ubcOtherNeutrals; - else result := ubcUnknown; - end; - else result := ubcUnknown; - end - end -end; - -function GetUnicodeBracketInfo(u: LongWord): TUnicodeBracketInfo; - procedure Bracket(AOpening,AClosing: LongWord); - begin - result.IsBracket := true; - result.OpeningBracket := AOpening; - result.ClosingBracket := AClosing; - end; -begin - case u of - $0028, $0029: Bracket($0028, $0029); - $005B, $005D: Bracket($005B, $005D); - $007B, $007D: Bracket($007B, $007D); - $0F3A, $0F3B: Bracket($0F3A, $0F3B); - $0F3C, $0F3D: Bracket($0F3C, $0F3D); - $169B, $169C: Bracket($169B, $169C); - $2045, $2046: Bracket($2045, $2046); - $207D, $207E: Bracket($207D, $207E); - $208D, $208E: Bracket($208D, $208E); - $2308, $2309: Bracket($2308, $2309); - $230A, $230B: Bracket($230A, $230B); - $2329, $232A: Bracket($2329, $232A); - $2768, $2769: Bracket($2768, $2769); - $276A, $276B: Bracket($276A, $276B); - $276C, $276D: Bracket($276C, $276D); - $276E, $276F: Bracket($276E, $276F); - $2770, $2771: Bracket($2770, $2771); - $2772, $2773: Bracket($2772, $2773); - $2774, $2775: Bracket($2774, $2775); - $27C5, $27C6: Bracket($27C5, $27C6); - $27E6, $27E7: Bracket($27E6, $27E7); - $27E8, $27E9: Bracket($27E8, $27E9); - $27EA, $27EB: Bracket($27EA, $27EB); - $27EC, $27ED: Bracket($27EC, $27ED); - $27EE, $27EF: Bracket($27EE, $27EF); - $2983, $2984: Bracket($2983, $2984); - $2985, $2986: Bracket($2985, $2986); - $2987, $2988: Bracket($2987, $2988); - $2989, $298A: Bracket($2989, $298A); - $298B, $298C: Bracket($298B, $298C); - $298D, $2990: Bracket($298D, $2990); - $298F, $298E: Bracket($298F, $298E); - $2991, $2992: Bracket($2991, $2992); - $2993, $2994: Bracket($2993, $2994); - $2995, $2996: Bracket($2995, $2996); - $2997, $2998: Bracket($2997, $2998); - $29D8, $29D9: Bracket($29D8, $29D9); - $29DA, $29DB: Bracket($29DA, $29DB); - $29FC, $29FD: Bracket($29FC, $29FD); - $2E22, $2E23: Bracket($2E22, $2E23); - $2E24, $2E25: Bracket($2E24, $2E25); - $2E26, $2E27: Bracket($2E26, $2E27); - $2E28, $2E29: Bracket($2E28, $2E29); - $3008, $3009: Bracket($3008, $3009); - $300A, $300B: Bracket($300A, $300B); - $300C, $300D: Bracket($300C, $300D); - $300E, $300F: Bracket($300E, $300F); - $3010, $3011: Bracket($3010, $3011); - $3014, $3015: Bracket($3014, $3015); - $3016, $3017: Bracket($3016, $3017); - $3018, $3019: Bracket($3018, $3019); - $301A, $301B: Bracket($301A, $301B); - $FE59, $FE5A: Bracket($FE59, $FE5A); - $FE5B, $FE5C: Bracket($FE5B, $FE5C); - $FE5D, $FE5E: Bracket($FE5D, $FE5E); - $FF08, $FF09: Bracket($FF08, $FF09); - $FF3B, $FF3D: Bracket($FF3B, $FF3D); - $FF5B, $FF5D: Bracket($FF5B, $FF5D); - $FF5F, $FF60: Bracket($FF5F, $FF60); - $FF62, $FF63: Bracket($FF62, $FF63); - else - begin - result.IsBracket := false; - result.OpeningBracket := 0; - result.ClosingBracket := 0; - end; - end; -end; - -function GetUnicodeJoiningType(u: LongWord): TUnicodeJoiningType; -begin - result := ujtNonJoining; - if u <= $001BE8 then begin - if u <= $0009CD then begin - if u <= $00072C then begin - if u <= $00069A then - case u of - $AD, $300..$36F, $483..$489, $591..$5BD, $5BF, $5C1, $5C2, $5C4, $5C5, $5C7, $610..$61A, - $61C, $64B..$65F, $670: result := ujtTransparent; - $622..$625, $627, $629, $62F..$632, $648, $671..$673, $675..$677, $688..$699: result := ujtRightJoining; - $620, $626, $628, $62A..$62E, $633..$63F, $641..$647, $649, $64A, $66E, $66F, $678..$687, - $69A: result := ujtDualJoining; - $640: result := ujtJoinCausing; - end - else - case u of - $6D6..$6DC, $6DF..$6E4, $6E7, $6E8, $6EA..$6ED, $70F, $711: result := ujtTransparent; - $6C0, $6C3..$6CB, $6CD, $6CF, $6D2, $6D3, $6D5, $6EE, $6EF, $710, $715..$719, $71E, - $728, $72A, $72C: result := ujtRightJoining; - $69B..$6BF, $6C1, $6C2, $6CC, $6CE, $6D0, $6D1, $6FA..$6FC, $6FF, $712..$714, $71A..$71D, - $71F..$727, $729, $72B: result := ujtDualJoining; - end - end else begin - if u <= $00084A then - case u of - $730..$74A, $7A6..$7B0, $7EB..$7F3, $7FD, $816..$819, $81B..$823, $825..$827, $829..$82D: result := ujtTransparent; - $72F, $74D, $759..$75B, $76B, $76C, $771, $773, $774, $778, $779, $840, $846, $847, - $849: result := ujtRightJoining; - $72D, $72E, $74E..$758, $75C..$76A, $76D..$770, $772, $775..$777, $77A..$77F, $7CA..$7EA, - $841..$845, $848, $84A: result := ujtDualJoining; - $7FA: result := ujtJoinCausing; - end - else - case u of - $859..$85B, $8D3..$8E1, $8E3..$902, $93A, $93C, $941..$948, $94D, $951..$957, $962, - $963, $981, $9BC, $9C1..$9C4, $9CD: result := ujtTransparent; - $854, $856..$858, $867, $869, $86A, $8AA..$8AC, $8AE, $8B1, $8B2, $8B9: result := ujtRightJoining; - $84B..$853, $855, $860, $862..$865, $868, $8A0..$8A9, $8AF, $8B0, $8B3, $8B4, $8B6..$8B8, - $8BA..$8C7: result := ujtDualJoining; - end - end - end else begin - if u <= $000F71 then begin - if u <= $000C3E then - case u of - $9E2, $9E3, $9FE, $A01, $A02, $A3C, $A41, $A42, $A47, $A48, $A4B..$A4D, $A51, $A70, - $A71, $A75, $A81, $A82, $ABC, $AC1..$AC5, $AC7, $AC8, $ACD, $AE2, $AE3, $AFA..$AFF, - $B01, $B3C, $B3F, $B41..$B44, $B4D, $B55, $B56, $B62, $B63, $B82, $BC0, $BCD, $C00, - $C04, $C3E: result := ujtTransparent; - end - else - case u of - $C3F, $C40, $C46..$C48, $C4A..$C4D, $C55, $C56, $C62, $C63, $C81, $CBC, $CBF, $CC6, - $CCC, $CCD, $CE2, $CE3, $D00, $D01, $D3B, $D3C, $D41..$D44, $D4D, $D62, $D63, $D81, - $DCA, $DD2..$DD4, $DD6, $E31, $E34..$E3A, $E47..$E4E, $EB1, $EB4..$EBC, $EC8..$ECD, - $F18, $F19, $F35, $F37, $F39, $F71: result := ujtTransparent; - end - end else begin - if u <= $001820 then - case u of - $F72..$F7E, $F80..$F84, $F86, $F87, $F8D..$F97, $F99..$FBC, $FC6, $102D..$1030, $1032..$1037, - $1039, $103A, $103D, $103E, $1058, $1059, $105E..$1060, $1071..$1074, $1082, $1085, - $1086, $108D, $109D, $135D..$135F, $1712..$1714, $1732..$1734, $1752, $1753, $1772, - $1773, $17B4, $17B5, $17B7..$17BD, $17C6, $17C9..$17D3, $17DD, $180B..$180D: result := ujtTransparent; - $1807, $1820: result := ujtDualJoining; - $180A: result := ujtJoinCausing; - end - else - case u of - $1885, $1886, $18A9, $1920..$1922, $1927, $1928, $1932, $1939..$193B, $1A17, $1A18, - $1A1B, $1A56, $1A58..$1A5E, $1A60, $1A62, $1A65..$1A6C, $1A73..$1A7C, $1A7F, $1AB0..$1AC0, - $1B00..$1B03, $1B34, $1B36..$1B3A, $1B3C, $1B42, $1B6B..$1B73, $1B80, $1B81, $1BA2..$1BA5, - $1BA8, $1BA9, $1BAB..$1BAD, $1BE6, $1BE8: result := ujtTransparent; - $1821..$1878, $1887..$18A8, $18AA: result := ujtDualJoining; - end - end - end - end else begin - if u <= $010FB8 then begin - if u <= $00ABE8 then begin - if u <= $00A806 then - case u of - $1BE9, $1BED, $1BEF..$1BF1, $1C2C..$1C33, $1C36, $1C37, $1CD0..$1CD2, $1CD4..$1CE0, - $1CE2..$1CE8, $1CED, $1CF4, $1CF8, $1CF9, $1DC0..$1DF9, $1DFB..$1DFF, $200B, $200E, - $200F, $202A..$202E, $2060..$2064, $206A..$206F, $20D0..$20F0, $2CEF..$2CF1, $2D7F, - $2DE0..$2DFF, $302A..$302D, $3099, $309A, $A66F..$A672, $A674..$A67D, $A69E, $A69F, - $A6F0, $A6F1, $A802, $A806: result := ujtTransparent; - $200D: result := ujtJoinCausing; - end - else - case u of - $A80B, $A825, $A826, $A82C, $A8C4, $A8C5, $A8E0..$A8F1, $A8FF, $A926..$A92D, $A947..$A951, - $A980..$A982, $A9B3, $A9B6..$A9B9, $A9BC, $A9BD, $A9E5, $AA29..$AA2E, $AA31, $AA32, - $AA35, $AA36, $AA43, $AA4C, $AA7C, $AAB0, $AAB2..$AAB4, $AAB7, $AAB8, $AABE, $AABF, - $AAC1, $AAEC, $AAED, $AAF6, $ABE5, $ABE8: result := ujtTransparent; - $A872: result := ujtLeftJoining; - $A840..$A871: result := ujtDualJoining; - end - end else begin - if u <= $010AEF then - case u of - $ABED, $FB1E, $FE00..$FE0F, $FE20..$FE2F, $FEFF, $FFF9..$FFFB, $101FD, $102E0, $10376..$1037A, - $10A01..$10A03, $10A05, $10A06, $10A0C..$10A0F, $10A38..$10A3A, $10A3F, $10AE5, $10AE6: result := ujtTransparent; - $10AC5, $10AC7, $10AC9, $10ACA, $10ACE..$10AD2, $10ADD, $10AE1, $10AE4, $10AEF: result := ujtRightJoining; - $10ACD, $10AD7: result := ujtLeftJoining; - $10AC0..$10AC4, $10AD3..$10AD6, $10AD8..$10ADC, $10ADE..$10AE0, $10AEB..$10AEE: result := ujtDualJoining; - end - else - case u of - $10D24..$10D27, $10EAB, $10EAC, $10F46..$10F50: result := ujtTransparent; - $10B81, $10B83..$10B85, $10B89, $10B8C, $10B8E, $10B8F, $10B91, $10BA9..$10BAC, $10D22, - $10F33, $10F54, $10FB4..$10FB6: result := ujtRightJoining; - $10D00: result := ujtLeftJoining; - $10B80, $10B82, $10B86..$10B88, $10B8A, $10B8B, $10B8D, $10B90, $10BAD, $10BAE, $10D01..$10D21, - $10D23, $10F30..$10F32, $10F34..$10F44, $10F51..$10F53, $10FB0, $10FB2, $10FB3, $10FB8: result := ujtDualJoining; - end - end - end else begin - if u <= $01193E then begin - if u <= $011300 then - case u of - $11001, $11038..$11046, $1107F..$11081, $110B3..$110B6, $110B9, $110BA, $11100..$11102, - $11127..$1112B, $1112D..$11134, $11173, $11180, $11181, $111B6..$111BE, $111C9..$111CC, - $111CF, $1122F..$11231, $11234, $11236, $11237, $1123E, $112DF, $112E3..$112EA, $11300: result := ujtTransparent; - $10FB9, $10FBA, $10FBD, $10FC2, $10FC3, $10FC9: result := ujtRightJoining; - $10FCB: result := ujtLeftJoining; - $10FBB, $10FBC, $10FBE, $10FBF, $10FC1, $10FC4, $10FCA: result := ujtDualJoining; - end - else - case u of - $11301, $1133B, $1133C, $11340, $11366..$1136C, $11370..$11374, $11438..$1143F, $11442..$11444, - $11446, $1145E, $114B3..$114B8, $114BA, $114BF, $114C0, $114C2, $114C3, $115B2..$115B5, - $115BC, $115BD, $115BF, $115C0, $115DC, $115DD, $11633..$1163A, $1163D, $1163F, $11640, - $116AB, $116AD, $116B0..$116B5, $116B7, $1171D..$1171F, $11722..$11725, $11727..$1172B, - $1182F..$11837, $11839, $1183A, $1193B, $1193C, $1193E: result := ujtTransparent; - end - end else begin - if u <= $016AF0 then - case u of - $11943, $119D4..$119D7, $119DA, $119DB, $119E0, $11A01..$11A0A, $11A33..$11A38, $11A3B..$11A3E, - $11A47, $11A51..$11A56, $11A59..$11A5B, $11A8A..$11A96, $11A98, $11A99, $11C30..$11C36, - $11C38..$11C3D, $11C3F, $11C92..$11CA7, $11CAA..$11CB0, $11CB2, $11CB3, $11CB5, $11CB6, - $11D31..$11D36, $11D3A, $11D3C, $11D3D, $11D3F..$11D45, $11D47, $11D90, $11D91, $11D95, - $11D97, $11EF3, $11EF4, $13430..$13438, $16AF0: result := ujtTransparent; - end - else - case u of - $16AF1..$16AF4, $16B30..$16B36, $16F4F, $16F8F..$16F92, $16FE4, $1BC9D, $1BC9E, $1BCA0..$1BCA3, - $1D167..$1D169, $1D173..$1D182, $1D185..$1D18B, $1D1AA..$1D1AD, $1D242..$1D244, $1DA00..$1DA36, - $1DA3B..$1DA6C, $1DA75, $1DA84, $1DA9B..$1DA9F, $1DAA1..$1DAAF, $1E000..$1E006, $1E008..$1E018, - $1E01B..$1E021, $1E023, $1E024, $1E026..$1E02A, $1E130..$1E136, $1E2EC..$1E2EF, $1E8D0..$1E8D6, - $1E944..$1E94B, $E0001, $E0020..$E007F, $E0100..$E01EF: result := ujtTransparent; - $1E900..$1E943: result := ujtDualJoining; - end - end - end - end -end; - -type - TUnicodeCombiningInfo = record - u: LongWord; - c: Byte; - end; -const - UnicodeCombiningInfos: array[0..2289] of TUnicodeCombiningInfo = - ( (u:$300; c:230), (u:$301; c:230), (u:$302; c:230), (u:$303; c:230), - (u:$304; c:230), (u:$305; c:230), (u:$306; c:230), (u:$307; c:230), - (u:$308; c:230), (u:$309; c:230), (u:$30A; c:230), (u:$30B; c:230), - (u:$30C; c:230), (u:$30D; c:230), (u:$30E; c:230), (u:$30F; c:230), - (u:$310; c:230), (u:$311; c:230), (u:$312; c:230), (u:$313; c:230), - (u:$314; c:230), (u:$315; c:232), (u:$316; c:220), (u:$317; c:220), - (u:$318; c:220), (u:$319; c:220), (u:$31A; c:232), (u:$31B; c:216), - (u:$31C; c:220), (u:$31D; c:220), (u:$31E; c:220), (u:$31F; c:220), - (u:$320; c:220), (u:$321; c:202), (u:$322; c:202), (u:$323; c:220), - (u:$324; c:220), (u:$325; c:220), (u:$326; c:220), (u:$327; c:202), - (u:$328; c:202), (u:$329; c:220), (u:$32A; c:220), (u:$32B; c:220), - (u:$32C; c:220), (u:$32D; c:220), (u:$32E; c:220), (u:$32F; c:220), - (u:$330; c:220), (u:$331; c:220), (u:$332; c:220), (u:$333; c:220), - (u:$334; c:1), (u:$335; c:1), (u:$336; c:1), (u:$337; c:1), (u:$338; c:1), - (u:$339; c:220), (u:$33A; c:220), (u:$33B; c:220), (u:$33C; c:220), - (u:$33D; c:230), (u:$33E; c:230), (u:$33F; c:230), (u:$340; c:230), - (u:$341; c:230), (u:$342; c:230), (u:$343; c:230), (u:$344; c:230), - (u:$345; c:240), (u:$346; c:230), (u:$347; c:220), (u:$348; c:220), - (u:$349; c:220), (u:$34A; c:230), (u:$34B; c:230), (u:$34C; c:230), - (u:$34D; c:220), (u:$34E; c:220), (u:$34F; c:0), (u:$350; c:230), - (u:$351; c:230), (u:$352; c:230), (u:$353; c:220), (u:$354; c:220), - (u:$355; c:220), (u:$356; c:220), (u:$357; c:230), (u:$358; c:232), - (u:$359; c:220), (u:$35A; c:220), (u:$35B; c:230), (u:$35C; c:233), - (u:$35D; c:234), (u:$35E; c:234), (u:$35F; c:233), (u:$360; c:234), - (u:$361; c:234), (u:$362; c:233), (u:$363; c:230), (u:$364; c:230), - (u:$365; c:230), (u:$366; c:230), (u:$367; c:230), (u:$368; c:230), - (u:$369; c:230), (u:$36A; c:230), (u:$36B; c:230), (u:$36C; c:230), - (u:$36D; c:230), (u:$36E; c:230), (u:$36F; c:230), (u:$483; c:230), - (u:$484; c:230), (u:$485; c:230), (u:$486; c:230), (u:$487; c:230), - (u:$488; c:0), (u:$489; c:0), (u:$591; c:220), (u:$592; c:230), - (u:$593; c:230), (u:$594; c:230), (u:$595; c:230), (u:$596; c:220), - (u:$597; c:230), (u:$598; c:230), (u:$599; c:230), (u:$59A; c:222), - (u:$59B; c:220), (u:$59C; c:230), (u:$59D; c:230), (u:$59E; c:230), - (u:$59F; c:230), (u:$5A0; c:230), (u:$5A1; c:230), (u:$5A2; c:220), - (u:$5A3; c:220), (u:$5A4; c:220), (u:$5A5; c:220), (u:$5A6; c:220), - (u:$5A7; c:220), (u:$5A8; c:230), (u:$5A9; c:230), (u:$5AA; c:220), - (u:$5AB; c:230), (u:$5AC; c:230), (u:$5AD; c:222), (u:$5AE; c:228), - (u:$5AF; c:230), (u:$5B0; c:10), (u:$5B1; c:11), (u:$5B2; c:12), - (u:$5B3; c:13), (u:$5B4; c:14), (u:$5B5; c:15), (u:$5B6; c:16), - (u:$5B7; c:17), (u:$5B8; c:18), (u:$5B9; c:19), (u:$5BA; c:19), - (u:$5BB; c:20), (u:$5BC; c:21), (u:$5BD; c:22), (u:$5BF; c:23), - (u:$5C1; c:24), (u:$5C2; c:25), (u:$5C4; c:230), (u:$5C5; c:220), - (u:$5C7; c:18), (u:$610; c:230), (u:$611; c:230), (u:$612; c:230), - (u:$613; c:230), (u:$614; c:230), (u:$615; c:230), (u:$616; c:230), - (u:$617; c:230), (u:$618; c:30), (u:$619; c:31), (u:$61A; c:32), - (u:$64B; c:27), (u:$64C; c:28), (u:$64D; c:29), (u:$64E; c:30), - (u:$64F; c:31), (u:$650; c:32), (u:$651; c:33), (u:$652; c:34), - (u:$653; c:230), (u:$654; c:230), (u:$655; c:220), (u:$656; c:220), - (u:$657; c:230), (u:$658; c:230), (u:$659; c:230), (u:$65A; c:230), - (u:$65B; c:230), (u:$65C; c:220), (u:$65D; c:230), (u:$65E; c:230), - (u:$65F; c:220), (u:$670; c:35), (u:$6D6; c:230), (u:$6D7; c:230), - (u:$6D8; c:230), (u:$6D9; c:230), (u:$6DA; c:230), (u:$6DB; c:230), - (u:$6DC; c:230), (u:$6DF; c:230), (u:$6E0; c:230), (u:$6E1; c:230), - (u:$6E2; c:230), (u:$6E3; c:220), (u:$6E4; c:230), (u:$6E7; c:230), - (u:$6E8; c:230), (u:$6EA; c:220), (u:$6EB; c:230), (u:$6EC; c:230), - (u:$6ED; c:220), (u:$711; c:36), (u:$730; c:230), (u:$731; c:220), - (u:$732; c:230), (u:$733; c:230), (u:$734; c:220), (u:$735; c:230), - (u:$736; c:230), (u:$737; c:220), (u:$738; c:220), (u:$739; c:220), - (u:$73A; c:230), (u:$73B; c:220), (u:$73C; c:220), (u:$73D; c:230), - (u:$73E; c:220), (u:$73F; c:230), (u:$740; c:230), (u:$741; c:230), - (u:$742; c:220), (u:$743; c:230), (u:$744; c:220), (u:$745; c:230), - (u:$746; c:220), (u:$747; c:230), (u:$748; c:220), (u:$749; c:230), - (u:$74A; c:230), (u:$7A6; c:0), (u:$7A7; c:0), (u:$7A8; c:0), (u:$7A9; c:0), - (u:$7AA; c:0), (u:$7AB; c:0), (u:$7AC; c:0), (u:$7AD; c:0), (u:$7AE; c:0), - (u:$7AF; c:0), (u:$7B0; c:0), (u:$7EB; c:230), (u:$7EC; c:230), - (u:$7ED; c:230), (u:$7EE; c:230), (u:$7EF; c:230), (u:$7F0; c:230), - (u:$7F1; c:230), (u:$7F2; c:220), (u:$7F3; c:230), (u:$7FD; c:220), - (u:$816; c:230), (u:$817; c:230), (u:$818; c:230), (u:$819; c:230), - (u:$81B; c:230), (u:$81C; c:230), (u:$81D; c:230), (u:$81E; c:230), - (u:$81F; c:230), (u:$820; c:230), (u:$821; c:230), (u:$822; c:230), - (u:$823; c:230), (u:$825; c:230), (u:$826; c:230), (u:$827; c:230), - (u:$829; c:230), (u:$82A; c:230), (u:$82B; c:230), (u:$82C; c:230), - (u:$82D; c:230), (u:$859; c:220), (u:$85A; c:220), (u:$85B; c:220), - (u:$8D3; c:220), (u:$8D4; c:230), (u:$8D5; c:230), (u:$8D6; c:230), - (u:$8D7; c:230), (u:$8D8; c:230), (u:$8D9; c:230), (u:$8DA; c:230), - (u:$8DB; c:230), (u:$8DC; c:230), (u:$8DD; c:230), (u:$8DE; c:230), - (u:$8DF; c:230), (u:$8E0; c:230), (u:$8E1; c:230), (u:$8E3; c:220), - (u:$8E4; c:230), (u:$8E5; c:230), (u:$8E6; c:220), (u:$8E7; c:230), - (u:$8E8; c:230), (u:$8E9; c:220), (u:$8EA; c:230), (u:$8EB; c:230), - (u:$8EC; c:230), (u:$8ED; c:220), (u:$8EE; c:220), (u:$8EF; c:220), - (u:$8F0; c:27), (u:$8F1; c:28), (u:$8F2; c:29), (u:$8F3; c:230), - (u:$8F4; c:230), (u:$8F5; c:230), (u:$8F6; c:220), (u:$8F7; c:230), - (u:$8F8; c:230), (u:$8F9; c:220), (u:$8FA; c:220), (u:$8FB; c:230), - (u:$8FC; c:230), (u:$8FD; c:230), (u:$8FE; c:230), (u:$8FF; c:230), - (u:$900; c:0), (u:$901; c:0), (u:$902; c:0), (u:$903; c:210), (u:$93A; c:0), - (u:$93B; c:210), (u:$93C; c:7), (u:$93E; c:210), (u:$93F; c:208), - (u:$940; c:210), (u:$941; c:0), (u:$942; c:0), (u:$943; c:0), (u:$944; c:0), - (u:$945; c:0), (u:$946; c:0), (u:$947; c:0), (u:$948; c:0), (u:$949; c:210), - (u:$94A; c:210), (u:$94B; c:210), (u:$94C; c:210), (u:$94D; c:9), - (u:$94E; c:208), (u:$94F; c:210), (u:$951; c:230), (u:$952; c:220), - (u:$953; c:230), (u:$954; c:230), (u:$955; c:0), (u:$956; c:0), - (u:$957; c:0), (u:$962; c:0), (u:$963; c:0), (u:$981; c:0), (u:$982; c:210), - (u:$983; c:210), (u:$9BC; c:7), (u:$9BE; c:210), (u:$9BF; c:208), - (u:$9C0; c:210), (u:$9C1; c:0), (u:$9C2; c:0), (u:$9C3; c:0), (u:$9C4; c:0), - (u:$9C7; c:208), (u:$9C8; c:208), (u:$9CB; c:0), (u:$9CC; c:0), - (u:$9CD; c:9), (u:$9D7; c:210), (u:$9E2; c:0), (u:$9E3; c:0), - (u:$9FE; c:230), (u:$A01; c:0), (u:$A02; c:0), (u:$A03; c:210), - (u:$A3C; c:7), (u:$A3E; c:210), (u:$A3F; c:208), (u:$A40; c:210), - (u:$A41; c:0), (u:$A42; c:0), (u:$A47; c:0), (u:$A48; c:0), (u:$A4B; c:0), - (u:$A4C; c:0), (u:$A4D; c:9), (u:$A51; c:0), (u:$A70; c:0), (u:$A71; c:0), - (u:$A75; c:0), (u:$A81; c:0), (u:$A82; c:0), (u:$A83; c:210), (u:$ABC; c:7), - (u:$ABE; c:210), (u:$ABF; c:208), (u:$AC0; c:210), (u:$AC1; c:0), - (u:$AC2; c:0), (u:$AC3; c:0), (u:$AC4; c:0), (u:$AC5; c:0), (u:$AC7; c:0), - (u:$AC8; c:0), (u:$AC9; c:210), (u:$ACB; c:210), (u:$ACC; c:210), - (u:$ACD; c:9), (u:$AE2; c:0), (u:$AE3; c:0), (u:$AFA; c:0), (u:$AFB; c:0), - (u:$AFC; c:0), (u:$AFD; c:0), (u:$AFE; c:0), (u:$AFF; c:0), (u:$B01; c:0), - (u:$B02; c:210), (u:$B03; c:210), (u:$B3C; c:7), (u:$B3E; c:210), - (u:$B3F; c:0), (u:$B40; c:210), (u:$B41; c:0), (u:$B42; c:0), (u:$B43; c:0), - (u:$B44; c:0), (u:$B47; c:208), (u:$B48; c:208), (u:$B4B; c:208), - (u:$B4C; c:208), (u:$B4D; c:9), (u:$B55; c:0), (u:$B56; c:0), - (u:$B57; c:210), (u:$B62; c:0), (u:$B63; c:0), (u:$B82; c:0), - (u:$BBE; c:210), (u:$BBF; c:210), (u:$BC0; c:0), (u:$BC1; c:210), - (u:$BC2; c:210), (u:$BC6; c:208), (u:$BC7; c:208), (u:$BC8; c:208), - (u:$BCA; c:0), (u:$BCB; c:0), (u:$BCC; c:0), (u:$BCD; c:9), (u:$BD7; c:210), - (u:$C00; c:0), (u:$C01; c:210), (u:$C02; c:210), (u:$C03; c:210), - (u:$C04; c:0), (u:$C3E; c:0), (u:$C3F; c:0), (u:$C40; c:0), (u:$C41; c:210), - (u:$C42; c:210), (u:$C43; c:210), (u:$C44; c:210), (u:$C46; c:0), - (u:$C47; c:0), (u:$C48; c:0), (u:$C4A; c:0), (u:$C4B; c:0), (u:$C4C; c:0), - (u:$C4D; c:9), (u:$C55; c:84), (u:$C56; c:91), (u:$C62; c:0), (u:$C63; c:0), - (u:$C81; c:0), (u:$C82; c:210), (u:$C83; c:210), (u:$CBC; c:7), - (u:$CBE; c:210), (u:$CC0; c:210), (u:$CC1; c:210), (u:$CC2; c:210), - (u:$CC3; c:210), (u:$CC4; c:210), (u:$CC7; c:210), (u:$CC8; c:210), - (u:$CCA; c:210), (u:$CCB; c:210), (u:$CCC; c:0), (u:$CCD; c:9), - (u:$CD5; c:210), (u:$CD6; c:210), (u:$CE2; c:0), (u:$CE3; c:0), - (u:$D00; c:0), (u:$D01; c:0), (u:$D02; c:210), (u:$D03; c:210), - (u:$D3B; c:9), (u:$D3C; c:9), (u:$D3E; c:210), (u:$D3F; c:210), - (u:$D40; c:210), (u:$D41; c:0), (u:$D42; c:0), (u:$D43; c:0), (u:$D44; c:0), - (u:$D46; c:208), (u:$D47; c:208), (u:$D48; c:208), (u:$D4A; c:0), - (u:$D4B; c:0), (u:$D4C; c:0), (u:$D4D; c:9), (u:$D57; c:210), (u:$D62; c:0), - (u:$D63; c:0), (u:$D81; c:0), (u:$D82; c:210), (u:$D83; c:210), - (u:$DCA; c:9), (u:$DCF; c:210), (u:$DD0; c:210), (u:$DD1; c:210), - (u:$DD2; c:0), (u:$DD3; c:0), (u:$DD4; c:0), (u:$DD6; c:0), (u:$DD8; c:210), - (u:$DD9; c:208), (u:$DDA; c:208), (u:$DDB; c:208), (u:$DDC; c:208), - (u:$DDD; c:208), (u:$DDE; c:208), (u:$DDF; c:210), (u:$DF2; c:210), - (u:$DF3; c:210), (u:$E31; c:0), (u:$E34; c:0), (u:$E35; c:0), (u:$E36; c:0), - (u:$E37; c:0), (u:$E38; c:103), (u:$E39; c:103), (u:$E3A; c:9), - (u:$E47; c:0), (u:$E48; c:107), (u:$E49; c:107), (u:$E4A; c:107), - (u:$E4B; c:107), (u:$E4C; c:0), (u:$E4D; c:0), (u:$E4E; c:0), (u:$EB1; c:0), - (u:$EB4; c:0), (u:$EB5; c:0), (u:$EB6; c:0), (u:$EB7; c:0), (u:$EB8; c:118), - (u:$EB9; c:118), (u:$EBA; c:9), (u:$EBB; c:0), (u:$EBC; c:0), - (u:$EC8; c:122), (u:$EC9; c:122), (u:$ECA; c:122), (u:$ECB; c:122), - (u:$ECC; c:0), (u:$ECD; c:0), (u:$F18; c:220), (u:$F19; c:220), - (u:$F35; c:220), (u:$F37; c:220), (u:$F39; c:216), (u:$F3E; c:210), - (u:$F3F; c:210), (u:$F71; c:129), (u:$F72; c:130), (u:$F73; c:0), - (u:$F74; c:132), (u:$F75; c:0), (u:$F76; c:0), (u:$F77; c:0), (u:$F78; c:0), - (u:$F79; c:0), (u:$F7A; c:130), (u:$F7B; c:130), (u:$F7C; c:130), - (u:$F7D; c:130), (u:$F7E; c:0), (u:$F7F; c:210), (u:$F80; c:130), - (u:$F81; c:0), (u:$F82; c:230), (u:$F83; c:230), (u:$F84; c:9), - (u:$F86; c:230), (u:$F87; c:230), (u:$F8D; c:0), (u:$F8E; c:0), - (u:$F8F; c:0), (u:$F90; c:0), (u:$F91; c:0), (u:$F92; c:0), (u:$F93; c:0), - (u:$F94; c:0), (u:$F95; c:0), (u:$F96; c:0), (u:$F97; c:0), (u:$F99; c:0), - (u:$F9A; c:0), (u:$F9B; c:0), (u:$F9C; c:0), (u:$F9D; c:0), (u:$F9E; c:0), - (u:$F9F; c:0), (u:$FA0; c:0), (u:$FA1; c:0), (u:$FA2; c:0), (u:$FA3; c:0), - (u:$FA4; c:0), (u:$FA5; c:0), (u:$FA6; c:0), (u:$FA7; c:0), (u:$FA8; c:0), - (u:$FA9; c:0), (u:$FAA; c:0), (u:$FAB; c:0), (u:$FAC; c:0), (u:$FAD; c:0), - (u:$FAE; c:0), (u:$FAF; c:0), (u:$FB0; c:0), (u:$FB1; c:0), (u:$FB2; c:0), - (u:$FB3; c:0), (u:$FB4; c:0), (u:$FB5; c:0), (u:$FB6; c:0), (u:$FB7; c:0), - (u:$FB8; c:0), (u:$FB9; c:0), (u:$FBA; c:0), (u:$FBB; c:0), (u:$FBC; c:0), - (u:$FC6; c:220), (u:$102B; c:210), (u:$102C; c:210), (u:$102D; c:0), - (u:$102E; c:0), (u:$102F; c:0), (u:$1030; c:0), (u:$1031; c:208), - (u:$1032; c:0), (u:$1033; c:0), (u:$1034; c:0), (u:$1035; c:0), - (u:$1036; c:0), (u:$1037; c:7), (u:$1038; c:210), (u:$1039; c:9), - (u:$103A; c:9), (u:$103B; c:210), (u:$103C; c:208), (u:$103D; c:0), - (u:$103E; c:0), (u:$1056; c:210), (u:$1057; c:210), (u:$1058; c:0), - (u:$1059; c:0), (u:$105E; c:0), (u:$105F; c:0), (u:$1060; c:0), - (u:$1062; c:210), (u:$1063; c:210), (u:$1064; c:210), (u:$1067; c:210), - (u:$1068; c:210), (u:$1069; c:210), (u:$106A; c:210), (u:$106B; c:210), - (u:$106C; c:210), (u:$106D; c:210), (u:$1071; c:0), (u:$1072; c:0), - (u:$1073; c:0), (u:$1074; c:0), (u:$1082; c:0), (u:$1083; c:210), - (u:$1084; c:208), (u:$1085; c:0), (u:$1086; c:0), (u:$1087; c:210), - (u:$1088; c:210), (u:$1089; c:210), (u:$108A; c:210), (u:$108B; c:210), - (u:$108C; c:210), (u:$108D; c:220), (u:$108F; c:210), (u:$109A; c:210), - (u:$109B; c:210), (u:$109C; c:210), (u:$109D; c:0), (u:$135D; c:230), - (u:$135E; c:230), (u:$135F; c:230), (u:$1712; c:0), (u:$1713; c:0), - (u:$1714; c:9), (u:$1732; c:0), (u:$1733; c:0), (u:$1734; c:9), - (u:$1752; c:0), (u:$1753; c:0), (u:$1772; c:0), (u:$1773; c:0), - (u:$17B4; c:0), (u:$17B5; c:0), (u:$17B6; c:210), (u:$17B7; c:0), - (u:$17B8; c:0), (u:$17B9; c:0), (u:$17BA; c:0), (u:$17BB; c:0), - (u:$17BC; c:0), (u:$17BD; c:0), (u:$17BE; c:208), (u:$17BF; c:0), - (u:$17C0; c:0), (u:$17C1; c:208), (u:$17C2; c:208), (u:$17C3; c:208), - (u:$17C4; c:0), (u:$17C5; c:0), (u:$17C6; c:0), (u:$17C7; c:210), - (u:$17C8; c:210), (u:$17C9; c:0), (u:$17CA; c:0), (u:$17CB; c:0), - (u:$17CC; c:0), (u:$17CD; c:0), (u:$17CE; c:0), (u:$17CF; c:0), - (u:$17D0; c:0), (u:$17D1; c:0), (u:$17D2; c:9), (u:$17D3; c:0), - (u:$17DD; c:230), (u:$180B; c:0), (u:$180C; c:0), (u:$180D; c:0), - (u:$1885; c:0), (u:$1886; c:0), (u:$18A9; c:228), (u:$1920; c:0), - (u:$1921; c:0), (u:$1922; c:0), (u:$1923; c:210), (u:$1924; c:210), - (u:$1925; c:210), (u:$1926; c:210), (u:$1927; c:0), (u:$1928; c:0), - (u:$1929; c:210), (u:$192A; c:210), (u:$192B; c:210), (u:$1930; c:210), - (u:$1931; c:210), (u:$1932; c:0), (u:$1933; c:210), (u:$1934; c:210), - (u:$1935; c:210), (u:$1936; c:210), (u:$1937; c:210), (u:$1938; c:210), - (u:$1939; c:222), (u:$193A; c:230), (u:$193B; c:220), (u:$1A17; c:230), - (u:$1A18; c:220), (u:$1A19; c:208), (u:$1A1A; c:210), (u:$1A1B; c:0), - (u:$1A55; c:210), (u:$1A56; c:0), (u:$1A57; c:210), (u:$1A58; c:0), - (u:$1A59; c:0), (u:$1A5A; c:0), (u:$1A5B; c:0), (u:$1A5C; c:0), - (u:$1A5D; c:0), (u:$1A5E; c:0), (u:$1A60; c:9), (u:$1A61; c:210), - (u:$1A62; c:0), (u:$1A63; c:210), (u:$1A64; c:210), (u:$1A65; c:0), - (u:$1A66; c:0), (u:$1A67; c:0), (u:$1A68; c:0), (u:$1A69; c:0), - (u:$1A6A; c:0), (u:$1A6B; c:0), (u:$1A6C; c:0), (u:$1A6D; c:210), - (u:$1A6E; c:210), (u:$1A6F; c:210), (u:$1A70; c:210), (u:$1A71; c:210), - (u:$1A72; c:210), (u:$1A73; c:0), (u:$1A74; c:0), (u:$1A75; c:230), - (u:$1A76; c:230), (u:$1A77; c:230), (u:$1A78; c:230), (u:$1A79; c:230), - (u:$1A7A; c:230), (u:$1A7B; c:230), (u:$1A7C; c:230), (u:$1A7F; c:220), - (u:$1AB0; c:230), (u:$1AB1; c:230), (u:$1AB2; c:230), (u:$1AB3; c:230), - (u:$1AB4; c:230), (u:$1AB5; c:220), (u:$1AB6; c:220), (u:$1AB7; c:220), - (u:$1AB8; c:220), (u:$1AB9; c:220), (u:$1ABA; c:220), (u:$1ABB; c:230), - (u:$1ABC; c:230), (u:$1ABD; c:220), (u:$1ABE; c:0), (u:$1ABF; c:220), - (u:$1AC0; c:220), (u:$1B00; c:0), (u:$1B01; c:0), (u:$1B02; c:0), - (u:$1B03; c:0), (u:$1B04; c:210), (u:$1B34; c:7), (u:$1B35; c:210), - (u:$1B36; c:0), (u:$1B37; c:0), (u:$1B38; c:0), (u:$1B39; c:0), - (u:$1B3A; c:0), (u:$1B3B; c:210), (u:$1B3C; c:0), (u:$1B3D; c:0), - (u:$1B3E; c:208), (u:$1B3F; c:208), (u:$1B40; c:0), (u:$1B41; c:0), - (u:$1B42; c:0), (u:$1B43; c:210), (u:$1B44; c:9), (u:$1B6B; c:230), - (u:$1B6C; c:220), (u:$1B6D; c:230), (u:$1B6E; c:230), (u:$1B6F; c:230), - (u:$1B70; c:230), (u:$1B71; c:230), (u:$1B72; c:230), (u:$1B73; c:230), - (u:$1B80; c:0), (u:$1B81; c:0), (u:$1B82; c:210), (u:$1BA1; c:210), - (u:$1BA2; c:0), (u:$1BA3; c:0), (u:$1BA4; c:0), (u:$1BA5; c:0), - (u:$1BA6; c:210), (u:$1BA7; c:210), (u:$1BA8; c:0), (u:$1BA9; c:0), - (u:$1BAA; c:9), (u:$1BAB; c:9), (u:$1BAC; c:0), (u:$1BAD; c:0), - (u:$1BE6; c:7), (u:$1BE7; c:210), (u:$1BE8; c:0), (u:$1BE9; c:0), - (u:$1BEA; c:210), (u:$1BEB; c:210), (u:$1BEC; c:210), (u:$1BED; c:0), - (u:$1BEE; c:210), (u:$1BEF; c:0), (u:$1BF0; c:0), (u:$1BF1; c:0), - (u:$1BF2; c:9), (u:$1BF3; c:9), (u:$1C24; c:210), (u:$1C25; c:210), - (u:$1C26; c:210), (u:$1C27; c:210), (u:$1C28; c:210), (u:$1C29; c:210), - (u:$1C2A; c:210), (u:$1C2B; c:210), (u:$1C2C; c:0), (u:$1C2D; c:0), - (u:$1C2E; c:0), (u:$1C2F; c:0), (u:$1C30; c:0), (u:$1C31; c:0), - (u:$1C32; c:0), (u:$1C33; c:0), (u:$1C34; c:210), (u:$1C35; c:210), - (u:$1C36; c:0), (u:$1C37; c:7), (u:$1CD0; c:230), (u:$1CD1; c:230), - (u:$1CD2; c:230), (u:$1CD4; c:1), (u:$1CD5; c:220), (u:$1CD6; c:220), - (u:$1CD7; c:220), (u:$1CD8; c:220), (u:$1CD9; c:220), (u:$1CDA; c:230), - (u:$1CDB; c:230), (u:$1CDC; c:220), (u:$1CDD; c:220), (u:$1CDE; c:220), - (u:$1CDF; c:220), (u:$1CE0; c:230), (u:$1CE1; c:210), (u:$1CE2; c:1), - (u:$1CE3; c:1), (u:$1CE4; c:1), (u:$1CE5; c:1), (u:$1CE6; c:1), - (u:$1CE7; c:1), (u:$1CE8; c:1), (u:$1CED; c:220), (u:$1CF4; c:230), - (u:$1CF7; c:210), (u:$1CF8; c:230), (u:$1CF9; c:230), (u:$1DC0; c:230), - (u:$1DC1; c:230), (u:$1DC2; c:220), (u:$1DC3; c:230), (u:$1DC4; c:230), - (u:$1DC5; c:230), (u:$1DC6; c:230), (u:$1DC7; c:230), (u:$1DC8; c:230), - (u:$1DC9; c:230), (u:$1DCA; c:220), (u:$1DCB; c:230), (u:$1DCC; c:230), - (u:$1DCD; c:234), (u:$1DCE; c:214), (u:$1DCF; c:220), (u:$1DD0; c:202), - (u:$1DD1; c:230), (u:$1DD2; c:230), (u:$1DD3; c:230), (u:$1DD4; c:230), - (u:$1DD5; c:230), (u:$1DD6; c:230), (u:$1DD7; c:230), (u:$1DD8; c:230), - (u:$1DD9; c:230), (u:$1DDA; c:230), (u:$1DDB; c:230), (u:$1DDC; c:230), - (u:$1DDD; c:230), (u:$1DDE; c:230), (u:$1DDF; c:230), (u:$1DE0; c:230), - (u:$1DE1; c:230), (u:$1DE2; c:230), (u:$1DE3; c:230), (u:$1DE4; c:230), - (u:$1DE5; c:230), (u:$1DE6; c:230), (u:$1DE7; c:230), (u:$1DE8; c:230), - (u:$1DE9; c:230), (u:$1DEA; c:230), (u:$1DEB; c:230), (u:$1DEC; c:230), - (u:$1DED; c:230), (u:$1DEE; c:230), (u:$1DEF; c:230), (u:$1DF0; c:230), - (u:$1DF1; c:230), (u:$1DF2; c:230), (u:$1DF3; c:230), (u:$1DF4; c:230), - (u:$1DF5; c:230), (u:$1DF6; c:232), (u:$1DF7; c:228), (u:$1DF8; c:228), - (u:$1DF9; c:220), (u:$1DFB; c:230), (u:$1DFC; c:233), (u:$1DFD; c:220), - (u:$1DFE; c:230), (u:$1DFF; c:220), (u:$20D0; c:230), (u:$20D1; c:230), - (u:$20D2; c:1), (u:$20D3; c:1), (u:$20D4; c:230), (u:$20D5; c:230), - (u:$20D6; c:230), (u:$20D7; c:230), (u:$20D8; c:1), (u:$20D9; c:1), - (u:$20DA; c:1), (u:$20DB; c:230), (u:$20DC; c:230), (u:$20DD; c:0), - (u:$20DE; c:0), (u:$20DF; c:0), (u:$20E0; c:0), (u:$20E1; c:230), - (u:$20E2; c:0), (u:$20E3; c:0), (u:$20E4; c:0), (u:$20E5; c:1), - (u:$20E6; c:1), (u:$20E7; c:230), (u:$20E8; c:220), (u:$20E9; c:230), - (u:$20EA; c:1), (u:$20EB; c:1), (u:$20EC; c:220), (u:$20ED; c:220), - (u:$20EE; c:220), (u:$20EF; c:220), (u:$20F0; c:230), (u:$2CEF; c:230), - (u:$2CF0; c:230), (u:$2CF1; c:230), (u:$2D7F; c:9), (u:$2DE0; c:230), - (u:$2DE1; c:230), (u:$2DE2; c:230), (u:$2DE3; c:230), (u:$2DE4; c:230), - (u:$2DE5; c:230), (u:$2DE6; c:230), (u:$2DE7; c:230), (u:$2DE8; c:230), - (u:$2DE9; c:230), (u:$2DEA; c:230), (u:$2DEB; c:230), (u:$2DEC; c:230), - (u:$2DED; c:230), (u:$2DEE; c:230), (u:$2DEF; c:230), (u:$2DF0; c:230), - (u:$2DF1; c:230), (u:$2DF2; c:230), (u:$2DF3; c:230), (u:$2DF4; c:230), - (u:$2DF5; c:230), (u:$2DF6; c:230), (u:$2DF7; c:230), (u:$2DF8; c:230), - (u:$2DF9; c:230), (u:$2DFA; c:230), (u:$2DFB; c:230), (u:$2DFC; c:230), - (u:$2DFD; c:230), (u:$2DFE; c:230), (u:$2DFF; c:230), (u:$302A; c:218), - (u:$302B; c:228), (u:$302C; c:232), (u:$302D; c:222), (u:$302E; c:224), - (u:$302F; c:224), (u:$3099; c:8), (u:$309A; c:8), (u:$A66F; c:230), - (u:$A670; c:0), (u:$A671; c:0), (u:$A672; c:0), (u:$A674; c:230), - (u:$A675; c:230), (u:$A676; c:230), (u:$A677; c:230), (u:$A678; c:230), - (u:$A679; c:230), (u:$A67A; c:230), (u:$A67B; c:230), (u:$A67C; c:230), - (u:$A67D; c:230), (u:$A69E; c:230), (u:$A69F; c:230), (u:$A6F0; c:230), - (u:$A6F1; c:230), (u:$A802; c:0), (u:$A806; c:9), (u:$A80B; c:0), - (u:$A823; c:210), (u:$A824; c:210), (u:$A825; c:0), (u:$A826; c:0), - (u:$A827; c:210), (u:$A82C; c:9), (u:$A880; c:210), (u:$A881; c:210), - (u:$A8B4; c:210), (u:$A8B5; c:210), (u:$A8B6; c:210), (u:$A8B7; c:210), - (u:$A8B8; c:210), (u:$A8B9; c:210), (u:$A8BA; c:210), (u:$A8BB; c:210), - (u:$A8BC; c:210), (u:$A8BD; c:210), (u:$A8BE; c:210), (u:$A8BF; c:210), - (u:$A8C0; c:210), (u:$A8C1; c:210), (u:$A8C2; c:210), (u:$A8C3; c:210), - (u:$A8C4; c:9), (u:$A8C5; c:0), (u:$A8E0; c:230), (u:$A8E1; c:230), - (u:$A8E2; c:230), (u:$A8E3; c:230), (u:$A8E4; c:230), (u:$A8E5; c:230), - (u:$A8E6; c:230), (u:$A8E7; c:230), (u:$A8E8; c:230), (u:$A8E9; c:230), - (u:$A8EA; c:230), (u:$A8EB; c:230), (u:$A8EC; c:230), (u:$A8ED; c:230), - (u:$A8EE; c:230), (u:$A8EF; c:230), (u:$A8F0; c:230), (u:$A8F1; c:230), - (u:$A8FF; c:0), (u:$A926; c:0), (u:$A927; c:0), (u:$A928; c:0), - (u:$A929; c:0), (u:$A92A; c:0), (u:$A92B; c:220), (u:$A92C; c:220), - (u:$A92D; c:220), (u:$A947; c:0), (u:$A948; c:0), (u:$A949; c:0), - (u:$A94A; c:0), (u:$A94B; c:0), (u:$A94C; c:0), (u:$A94D; c:0), - (u:$A94E; c:0), (u:$A94F; c:0), (u:$A950; c:0), (u:$A951; c:0), - (u:$A952; c:210), (u:$A953; c:9), (u:$A980; c:0), (u:$A981; c:0), - (u:$A982; c:0), (u:$A983; c:210), (u:$A9B3; c:7), (u:$A9B4; c:210), - (u:$A9B5; c:210), (u:$A9B6; c:0), (u:$A9B7; c:0), (u:$A9B8; c:0), - (u:$A9B9; c:0), (u:$A9BA; c:208), (u:$A9BB; c:208), (u:$A9BC; c:0), - (u:$A9BD; c:0), (u:$A9BE; c:210), (u:$A9BF; c:208), (u:$A9C0; c:9), - (u:$A9E5; c:0), (u:$AA29; c:0), (u:$AA2A; c:0), (u:$AA2B; c:0), - (u:$AA2C; c:0), (u:$AA2D; c:0), (u:$AA2E; c:0), (u:$AA2F; c:208), - (u:$AA30; c:208), (u:$AA31; c:0), (u:$AA32; c:0), (u:$AA33; c:210), - (u:$AA34; c:208), (u:$AA35; c:0), (u:$AA36; c:0), (u:$AA43; c:0), - (u:$AA4C; c:0), (u:$AA4D; c:210), (u:$AA7B; c:210), (u:$AA7C; c:0), - (u:$AA7D; c:210), (u:$AAB0; c:230), (u:$AAB2; c:230), (u:$AAB3; c:230), - (u:$AAB4; c:220), (u:$AAB7; c:230), (u:$AAB8; c:230), (u:$AABE; c:230), - (u:$AABF; c:230), (u:$AAC1; c:230), (u:$AAEB; c:210), (u:$AAEC; c:0), - (u:$AAED; c:0), (u:$AAEE; c:210), (u:$AAEF; c:210), (u:$AAF5; c:210), - (u:$AAF6; c:9), (u:$ABE3; c:210), (u:$ABE4; c:210), (u:$ABE5; c:0), - (u:$ABE6; c:210), (u:$ABE7; c:210), (u:$ABE8; c:0), (u:$ABE9; c:210), - (u:$ABEA; c:210), (u:$ABEC; c:210), (u:$ABED; c:9), (u:$FB1E; c:26), - (u:$FE00; c:0), (u:$FE01; c:0), (u:$FE02; c:0), (u:$FE03; c:0), - (u:$FE04; c:0), (u:$FE05; c:0), (u:$FE06; c:0), (u:$FE07; c:0), - (u:$FE08; c:0), (u:$FE09; c:0), (u:$FE0A; c:0), (u:$FE0B; c:0), - (u:$FE0C; c:0), (u:$FE0D; c:0), (u:$FE0E; c:0), (u:$FE0F; c:0), - (u:$FE20; c:230), (u:$FE21; c:230), (u:$FE22; c:230), (u:$FE23; c:230), - (u:$FE24; c:230), (u:$FE25; c:230), (u:$FE26; c:230), (u:$FE27; c:220), - (u:$FE28; c:220), (u:$FE29; c:220), (u:$FE2A; c:220), (u:$FE2B; c:220), - (u:$FE2C; c:220), (u:$FE2D; c:220), (u:$FE2E; c:230), (u:$FE2F; c:230), - (u:$101FD; c:220), (u:$102E0; c:220), (u:$10376; c:230), (u:$10377; c:230), - (u:$10378; c:230), (u:$10379; c:230), (u:$1037A; c:230), (u:$10A01; c:0), - (u:$10A02; c:0), (u:$10A03; c:0), (u:$10A05; c:0), (u:$10A06; c:0), - (u:$10A0C; c:0), (u:$10A0D; c:220), (u:$10A0E; c:0), (u:$10A0F; c:230), - (u:$10A38; c:230), (u:$10A39; c:1), (u:$10A3A; c:220), (u:$10A3F; c:9), - (u:$10AE5; c:230), (u:$10AE6; c:220), (u:$10D24; c:230), (u:$10D25; c:230), - (u:$10D26; c:230), (u:$10D27; c:230), (u:$10EAB; c:230), (u:$10EAC; c:230), - (u:$10F46; c:220), (u:$10F47; c:220), (u:$10F48; c:230), (u:$10F49; c:230), - (u:$10F4A; c:230), (u:$10F4B; c:220), (u:$10F4C; c:230), (u:$10F4D; c:220), - (u:$10F4E; c:220), (u:$10F4F; c:220), (u:$10F50; c:220), (u:$11000; c:210), - (u:$11001; c:0), (u:$11002; c:210), (u:$11038; c:0), (u:$11039; c:0), - (u:$1103A; c:0), (u:$1103B; c:0), (u:$1103C; c:0), (u:$1103D; c:0), - (u:$1103E; c:0), (u:$1103F; c:0), (u:$11040; c:0), (u:$11041; c:0), - (u:$11042; c:0), (u:$11043; c:0), (u:$11044; c:0), (u:$11045; c:0), - (u:$11046; c:9), (u:$1107F; c:9), (u:$11080; c:0), (u:$11081; c:0), - (u:$11082; c:210), (u:$110B0; c:210), (u:$110B1; c:210), (u:$110B2; c:210), - (u:$110B3; c:0), (u:$110B4; c:0), (u:$110B5; c:0), (u:$110B6; c:0), - (u:$110B7; c:210), (u:$110B8; c:210), (u:$110B9; c:9), (u:$110BA; c:7), - (u:$11100; c:230), (u:$11101; c:230), (u:$11102; c:230), (u:$11127; c:0), - (u:$11128; c:0), (u:$11129; c:0), (u:$1112A; c:0), (u:$1112B; c:0), - (u:$1112C; c:210), (u:$1112D; c:0), (u:$1112E; c:0), (u:$1112F; c:0), - (u:$11130; c:0), (u:$11131; c:0), (u:$11132; c:0), (u:$11133; c:9), - (u:$11134; c:9), (u:$11145; c:210), (u:$11146; c:210), (u:$11173; c:7), - (u:$11180; c:0), (u:$11181; c:0), (u:$11182; c:210), (u:$111B3; c:210), - (u:$111B4; c:210), (u:$111B5; c:210), (u:$111B6; c:0), (u:$111B7; c:0), - (u:$111B8; c:0), (u:$111B9; c:0), (u:$111BA; c:0), (u:$111BB; c:0), - (u:$111BC; c:0), (u:$111BD; c:0), (u:$111BE; c:0), (u:$111BF; c:210), - (u:$111C0; c:9), (u:$111C9; c:0), (u:$111CA; c:7), (u:$111CB; c:0), - (u:$111CC; c:0), (u:$111CE; c:210), (u:$111CF; c:0), (u:$1122C; c:210), - (u:$1122D; c:210), (u:$1122E; c:210), (u:$1122F; c:0), (u:$11230; c:0), - (u:$11231; c:0), (u:$11232; c:210), (u:$11233; c:210), (u:$11234; c:0), - (u:$11235; c:9), (u:$11236; c:7), (u:$11237; c:0), (u:$1123E; c:0), - (u:$112DF; c:0), (u:$112E0; c:210), (u:$112E1; c:210), (u:$112E2; c:210), - (u:$112E3; c:0), (u:$112E4; c:0), (u:$112E5; c:0), (u:$112E6; c:0), - (u:$112E7; c:0), (u:$112E8; c:0), (u:$112E9; c:7), (u:$112EA; c:9), - (u:$11300; c:0), (u:$11301; c:0), (u:$11302; c:210), (u:$11303; c:210), - (u:$1133B; c:7), (u:$1133C; c:7), (u:$1133E; c:210), (u:$1133F; c:210), - (u:$11340; c:0), (u:$11341; c:210), (u:$11342; c:210), (u:$11343; c:210), - (u:$11344; c:210), (u:$11347; c:210), (u:$11348; c:210), (u:$1134B; c:210), - (u:$1134C; c:210), (u:$1134D; c:9), (u:$11357; c:210), (u:$11362; c:210), - (u:$11363; c:210), (u:$11366; c:230), (u:$11367; c:230), (u:$11368; c:230), - (u:$11369; c:230), (u:$1136A; c:230), (u:$1136B; c:230), (u:$1136C; c:230), - (u:$11370; c:230), (u:$11371; c:230), (u:$11372; c:230), (u:$11373; c:230), - (u:$11374; c:230), (u:$11435; c:210), (u:$11436; c:210), (u:$11437; c:210), - (u:$11438; c:0), (u:$11439; c:0), (u:$1143A; c:0), (u:$1143B; c:0), - (u:$1143C; c:0), (u:$1143D; c:0), (u:$1143E; c:0), (u:$1143F; c:0), - (u:$11440; c:210), (u:$11441; c:210), (u:$11442; c:9), (u:$11443; c:0), - (u:$11444; c:0), (u:$11445; c:210), (u:$11446; c:7), (u:$1145E; c:230), - (u:$114B0; c:210), (u:$114B1; c:210), (u:$114B2; c:210), (u:$114B3; c:0), - (u:$114B4; c:0), (u:$114B5; c:0), (u:$114B6; c:0), (u:$114B7; c:0), - (u:$114B8; c:0), (u:$114B9; c:210), (u:$114BA; c:0), (u:$114BB; c:210), - (u:$114BC; c:210), (u:$114BD; c:210), (u:$114BE; c:210), (u:$114BF; c:0), - (u:$114C0; c:0), (u:$114C1; c:210), (u:$114C2; c:9), (u:$114C3; c:7), - (u:$115AF; c:210), (u:$115B0; c:210), (u:$115B1; c:210), (u:$115B2; c:0), - (u:$115B3; c:0), (u:$115B4; c:0), (u:$115B5; c:0), (u:$115B8; c:210), - (u:$115B9; c:210), (u:$115BA; c:210), (u:$115BB; c:210), (u:$115BC; c:0), - (u:$115BD; c:0), (u:$115BE; c:210), (u:$115BF; c:9), (u:$115C0; c:7), - (u:$115DC; c:0), (u:$115DD; c:0), (u:$11630; c:210), (u:$11631; c:210), - (u:$11632; c:210), (u:$11633; c:0), (u:$11634; c:0), (u:$11635; c:0), - (u:$11636; c:0), (u:$11637; c:0), (u:$11638; c:0), (u:$11639; c:0), - (u:$1163A; c:0), (u:$1163B; c:210), (u:$1163C; c:210), (u:$1163D; c:0), - (u:$1163E; c:210), (u:$1163F; c:9), (u:$11640; c:0), (u:$116AB; c:0), - (u:$116AC; c:210), (u:$116AD; c:0), (u:$116AE; c:210), (u:$116AF; c:210), - (u:$116B0; c:0), (u:$116B1; c:0), (u:$116B2; c:0), (u:$116B3; c:0), - (u:$116B4; c:0), (u:$116B5; c:0), (u:$116B6; c:9), (u:$116B7; c:7), - (u:$1171D; c:0), (u:$1171E; c:0), (u:$1171F; c:0), (u:$11720; c:210), - (u:$11721; c:210), (u:$11722; c:0), (u:$11723; c:0), (u:$11724; c:0), - (u:$11725; c:0), (u:$11726; c:210), (u:$11727; c:0), (u:$11728; c:0), - (u:$11729; c:0), (u:$1172A; c:0), (u:$1172B; c:9), (u:$1182C; c:210), - (u:$1182D; c:210), (u:$1182E; c:210), (u:$1182F; c:0), (u:$11830; c:0), - (u:$11831; c:0), (u:$11832; c:0), (u:$11833; c:0), (u:$11834; c:0), - (u:$11835; c:0), (u:$11836; c:0), (u:$11837; c:0), (u:$11838; c:210), - (u:$11839; c:9), (u:$1183A; c:7), (u:$11930; c:210), (u:$11931; c:210), - (u:$11932; c:210), (u:$11933; c:210), (u:$11934; c:210), (u:$11935; c:210), - (u:$11937; c:210), (u:$11938; c:210), (u:$1193B; c:0), (u:$1193C; c:0), - (u:$1193D; c:9), (u:$1193E; c:9), (u:$11940; c:210), (u:$11942; c:210), - (u:$11943; c:7), (u:$119D1; c:210), (u:$119D2; c:210), (u:$119D3; c:210), - (u:$119D4; c:0), (u:$119D5; c:0), (u:$119D6; c:0), (u:$119D7; c:0), - (u:$119DA; c:0), (u:$119DB; c:0), (u:$119DC; c:210), (u:$119DD; c:210), - (u:$119DE; c:210), (u:$119DF; c:210), (u:$119E0; c:9), (u:$119E4; c:210), - (u:$11A01; c:0), (u:$11A02; c:0), (u:$11A03; c:0), (u:$11A04; c:0), - (u:$11A05; c:0), (u:$11A06; c:0), (u:$11A09; c:0), (u:$11A0A; c:0), - (u:$11A33; c:0), (u:$11A34; c:9), (u:$11A35; c:0), (u:$11A36; c:0), - (u:$11A37; c:0), (u:$11A38; c:0), (u:$11A39; c:210), (u:$11A3B; c:0), - (u:$11A3C; c:0), (u:$11A3D; c:0), (u:$11A3E; c:0), (u:$11A47; c:9), - (u:$11A51; c:0), (u:$11A52; c:0), (u:$11A53; c:0), (u:$11A54; c:0), - (u:$11A55; c:0), (u:$11A56; c:0), (u:$11A57; c:210), (u:$11A58; c:210), - (u:$11A59; c:0), (u:$11A5A; c:0), (u:$11A5B; c:0), (u:$11A8A; c:0), - (u:$11A8B; c:0), (u:$11A8C; c:0), (u:$11A8D; c:0), (u:$11A8E; c:0), - (u:$11A8F; c:0), (u:$11A90; c:0), (u:$11A91; c:0), (u:$11A92; c:0), - (u:$11A93; c:0), (u:$11A94; c:0), (u:$11A95; c:0), (u:$11A96; c:0), - (u:$11A97; c:210), (u:$11A98; c:0), (u:$11A99; c:9), (u:$11C2F; c:210), - (u:$11C30; c:0), (u:$11C31; c:0), (u:$11C32; c:0), (u:$11C33; c:0), - (u:$11C34; c:0), (u:$11C35; c:0), (u:$11C36; c:0), (u:$11C38; c:0), - (u:$11C39; c:0), (u:$11C3A; c:0), (u:$11C3B; c:0), (u:$11C3C; c:0), - (u:$11C3D; c:0), (u:$11C3E; c:210), (u:$11C92; c:0), (u:$11C93; c:0), - (u:$11C94; c:0), (u:$11C95; c:0), (u:$11C96; c:0), (u:$11C97; c:0), - (u:$11C98; c:0), (u:$11C99; c:0), (u:$11C9A; c:0), (u:$11C9B; c:0), - (u:$11C9C; c:0), (u:$11C9D; c:0), (u:$11C9E; c:0), (u:$11C9F; c:0), - (u:$11CA0; c:0), (u:$11CA1; c:0), (u:$11CA2; c:0), (u:$11CA3; c:0), - (u:$11CA4; c:0), (u:$11CA5; c:0), (u:$11CA6; c:0), (u:$11CA7; c:0), - (u:$11CA9; c:210), (u:$11CAA; c:0), (u:$11CAB; c:0), (u:$11CAC; c:0), - (u:$11CAD; c:0), (u:$11CAE; c:0), (u:$11CAF; c:0), (u:$11CB0; c:0), - (u:$11CB1; c:210), (u:$11CB2; c:0), (u:$11CB3; c:0), (u:$11CB4; c:210), - (u:$11CB5; c:0), (u:$11CB6; c:0), (u:$11D31; c:0), (u:$11D32; c:0), - (u:$11D33; c:0), (u:$11D34; c:0), (u:$11D35; c:0), (u:$11D36; c:0), - (u:$11D3A; c:0), (u:$11D3C; c:0), (u:$11D3D; c:0), (u:$11D3F; c:0), - (u:$11D40; c:0), (u:$11D41; c:0), (u:$11D42; c:7), (u:$11D43; c:0), - (u:$11D44; c:9), (u:$11D45; c:9), (u:$11D47; c:0), (u:$11D8A; c:210), - (u:$11D8B; c:210), (u:$11D8C; c:210), (u:$11D8D; c:210), (u:$11D8E; c:210), - (u:$11D90; c:0), (u:$11D91; c:0), (u:$11D93; c:210), (u:$11D94; c:210), - (u:$11D95; c:0), (u:$11D96; c:210), (u:$11D97; c:9), (u:$11EF3; c:0), - (u:$11EF4; c:0), (u:$11EF5; c:210), (u:$11EF6; c:210), (u:$16AF0; c:1), - (u:$16AF1; c:1), (u:$16AF2; c:1), (u:$16AF3; c:1), (u:$16AF4; c:1), - (u:$16B30; c:230), (u:$16B31; c:230), (u:$16B32; c:230), (u:$16B33; c:230), - (u:$16B34; c:230), (u:$16B35; c:230), (u:$16B36; c:230), (u:$16F4F; c:0), - (u:$16F51; c:210), (u:$16F52; c:210), (u:$16F53; c:210), (u:$16F54; c:210), - (u:$16F55; c:210), (u:$16F56; c:210), (u:$16F57; c:210), (u:$16F58; c:210), - (u:$16F59; c:210), (u:$16F5A; c:210), (u:$16F5B; c:210), (u:$16F5C; c:210), - (u:$16F5D; c:210), (u:$16F5E; c:210), (u:$16F5F; c:210), (u:$16F60; c:210), - (u:$16F61; c:210), (u:$16F62; c:210), (u:$16F63; c:210), (u:$16F64; c:210), - (u:$16F65; c:210), (u:$16F66; c:210), (u:$16F67; c:210), (u:$16F68; c:210), - (u:$16F69; c:210), (u:$16F6A; c:210), (u:$16F6B; c:210), (u:$16F6C; c:210), - (u:$16F6D; c:210), (u:$16F6E; c:210), (u:$16F6F; c:210), (u:$16F70; c:210), - (u:$16F71; c:210), (u:$16F72; c:210), (u:$16F73; c:210), (u:$16F74; c:210), - (u:$16F75; c:210), (u:$16F76; c:210), (u:$16F77; c:210), (u:$16F78; c:210), - (u:$16F79; c:210), (u:$16F7A; c:210), (u:$16F7B; c:210), (u:$16F7C; c:210), - (u:$16F7D; c:210), (u:$16F7E; c:210), (u:$16F7F; c:210), (u:$16F80; c:210), - (u:$16F81; c:210), (u:$16F82; c:210), (u:$16F83; c:210), (u:$16F84; c:210), - (u:$16F85; c:210), (u:$16F86; c:210), (u:$16F87; c:210), (u:$16F8F; c:0), - (u:$16F90; c:0), (u:$16F91; c:0), (u:$16F92; c:0), (u:$16FE4; c:0), - (u:$16FF0; c:6), (u:$16FF1; c:6), (u:$1BC9D; c:0), (u:$1BC9E; c:1), - (u:$1D165; c:216), (u:$1D166; c:216), (u:$1D167; c:1), (u:$1D168; c:1), - (u:$1D169; c:1), (u:$1D16D; c:226), (u:$1D16E; c:216), (u:$1D16F; c:216), - (u:$1D170; c:216), (u:$1D171; c:216), (u:$1D172; c:216), (u:$1D17B; c:220), - (u:$1D17C; c:220), (u:$1D17D; c:220), (u:$1D17E; c:220), (u:$1D17F; c:220), - (u:$1D180; c:220), (u:$1D181; c:220), (u:$1D182; c:220), (u:$1D185; c:230), - (u:$1D186; c:230), (u:$1D187; c:230), (u:$1D188; c:230), (u:$1D189; c:230), - (u:$1D18A; c:220), (u:$1D18B; c:220), (u:$1D1AA; c:230), (u:$1D1AB; c:230), - (u:$1D1AC; c:230), (u:$1D1AD; c:230), (u:$1D242; c:230), (u:$1D243; c:230), - (u:$1D244; c:230), (u:$1DA00; c:0), (u:$1DA01; c:0), (u:$1DA02; c:0), - (u:$1DA03; c:0), (u:$1DA04; c:0), (u:$1DA05; c:0), (u:$1DA06; c:0), - (u:$1DA07; c:0), (u:$1DA08; c:0), (u:$1DA09; c:0), (u:$1DA0A; c:0), - (u:$1DA0B; c:0), (u:$1DA0C; c:0), (u:$1DA0D; c:0), (u:$1DA0E; c:0), - (u:$1DA0F; c:0), (u:$1DA10; c:0), (u:$1DA11; c:0), (u:$1DA12; c:0), - (u:$1DA13; c:0), (u:$1DA14; c:0), (u:$1DA15; c:0), (u:$1DA16; c:0), - (u:$1DA17; c:0), (u:$1DA18; c:0), (u:$1DA19; c:0), (u:$1DA1A; c:0), - (u:$1DA1B; c:0), (u:$1DA1C; c:0), (u:$1DA1D; c:0), (u:$1DA1E; c:0), - (u:$1DA1F; c:0), (u:$1DA20; c:0), (u:$1DA21; c:0), (u:$1DA22; c:0), - (u:$1DA23; c:0), (u:$1DA24; c:0), (u:$1DA25; c:0), (u:$1DA26; c:0), - (u:$1DA27; c:0), (u:$1DA28; c:0), (u:$1DA29; c:0), (u:$1DA2A; c:0), - (u:$1DA2B; c:0), (u:$1DA2C; c:0), (u:$1DA2D; c:0), (u:$1DA2E; c:0), - (u:$1DA2F; c:0), (u:$1DA30; c:0), (u:$1DA31; c:0), (u:$1DA32; c:0), - (u:$1DA33; c:0), (u:$1DA34; c:0), (u:$1DA35; c:0), (u:$1DA36; c:0), - (u:$1DA3B; c:0), (u:$1DA3C; c:0), (u:$1DA3D; c:0), (u:$1DA3E; c:0), - (u:$1DA3F; c:0), (u:$1DA40; c:0), (u:$1DA41; c:0), (u:$1DA42; c:0), - (u:$1DA43; c:0), (u:$1DA44; c:0), (u:$1DA45; c:0), (u:$1DA46; c:0), - (u:$1DA47; c:0), (u:$1DA48; c:0), (u:$1DA49; c:0), (u:$1DA4A; c:0), - (u:$1DA4B; c:0), (u:$1DA4C; c:0), (u:$1DA4D; c:0), (u:$1DA4E; c:0), - (u:$1DA4F; c:0), (u:$1DA50; c:0), (u:$1DA51; c:0), (u:$1DA52; c:0), - (u:$1DA53; c:0), (u:$1DA54; c:0), (u:$1DA55; c:0), (u:$1DA56; c:0), - (u:$1DA57; c:0), (u:$1DA58; c:0), (u:$1DA59; c:0), (u:$1DA5A; c:0), - (u:$1DA5B; c:0), (u:$1DA5C; c:0), (u:$1DA5D; c:0), (u:$1DA5E; c:0), - (u:$1DA5F; c:0), (u:$1DA60; c:0), (u:$1DA61; c:0), (u:$1DA62; c:0), - (u:$1DA63; c:0), (u:$1DA64; c:0), (u:$1DA65; c:0), (u:$1DA66; c:0), - (u:$1DA67; c:0), (u:$1DA68; c:0), (u:$1DA69; c:0), (u:$1DA6A; c:0), - (u:$1DA6B; c:0), (u:$1DA6C; c:0), (u:$1DA75; c:0), (u:$1DA84; c:0), - (u:$1DA9B; c:0), (u:$1DA9C; c:0), (u:$1DA9D; c:0), (u:$1DA9E; c:0), - (u:$1DA9F; c:0), (u:$1DAA1; c:0), (u:$1DAA2; c:0), (u:$1DAA3; c:0), - (u:$1DAA4; c:0), (u:$1DAA5; c:0), (u:$1DAA6; c:0), (u:$1DAA7; c:0), - (u:$1DAA8; c:0), (u:$1DAA9; c:0), (u:$1DAAA; c:0), (u:$1DAAB; c:0), - (u:$1DAAC; c:0), (u:$1DAAD; c:0), (u:$1DAAE; c:0), (u:$1DAAF; c:0), - (u:$1E000; c:230), (u:$1E001; c:230), (u:$1E002; c:230), (u:$1E003; c:230), - (u:$1E004; c:230), (u:$1E005; c:230), (u:$1E006; c:230), (u:$1E008; c:230), - (u:$1E009; c:230), (u:$1E00A; c:230), (u:$1E00B; c:230), (u:$1E00C; c:230), - (u:$1E00D; c:230), (u:$1E00E; c:230), (u:$1E00F; c:230), (u:$1E010; c:230), - (u:$1E011; c:230), (u:$1E012; c:230), (u:$1E013; c:230), (u:$1E014; c:230), - (u:$1E015; c:230), (u:$1E016; c:230), (u:$1E017; c:230), (u:$1E018; c:230), - (u:$1E01B; c:230), (u:$1E01C; c:230), (u:$1E01D; c:230), (u:$1E01E; c:230), - (u:$1E01F; c:230), (u:$1E020; c:230), (u:$1E021; c:230), (u:$1E023; c:230), - (u:$1E024; c:230), (u:$1E026; c:230), (u:$1E027; c:230), (u:$1E028; c:230), - (u:$1E029; c:230), (u:$1E02A; c:230), (u:$1E130; c:230), (u:$1E131; c:230), - (u:$1E132; c:230), (u:$1E133; c:230), (u:$1E134; c:230), (u:$1E135; c:230), - (u:$1E136; c:230), (u:$1E2EC; c:230), (u:$1E2ED; c:230), (u:$1E2EE; c:230), - (u:$1E2EF; c:230), (u:$1E8D0; c:220), (u:$1E8D1; c:220), (u:$1E8D2; c:220), - (u:$1E8D3; c:220), (u:$1E8D4; c:220), (u:$1E8D5; c:220), (u:$1E8D6; c:220), - (u:$1E944; c:230), (u:$1E945; c:230), (u:$1E946; c:230), (u:$1E947; c:230), - (u:$1E948; c:230), (u:$1E949; c:230), (u:$1E94A; c:7), (u:$E0100; c:0), - (u:$E0101; c:0), (u:$E0102; c:0), (u:$E0103; c:0), (u:$E0104; c:0), - (u:$E0105; c:0), (u:$E0106; c:0), (u:$E0107; c:0), (u:$E0108; c:0), - (u:$E0109; c:0), (u:$E010A; c:0), (u:$E010B; c:0), (u:$E010C; c:0), - (u:$E010D; c:0), (u:$E010E; c:0), (u:$E010F; c:0), (u:$E0110; c:0), - (u:$E0111; c:0), (u:$E0112; c:0), (u:$E0113; c:0), (u:$E0114; c:0), - (u:$E0115; c:0), (u:$E0116; c:0), (u:$E0117; c:0), (u:$E0118; c:0), - (u:$E0119; c:0), (u:$E011A; c:0), (u:$E011B; c:0), (u:$E011C; c:0), - (u:$E011D; c:0), (u:$E011E; c:0), (u:$E011F; c:0), (u:$E0120; c:0), - (u:$E0121; c:0), (u:$E0122; c:0), (u:$E0123; c:0), (u:$E0124; c:0), - (u:$E0125; c:0), (u:$E0126; c:0), (u:$E0127; c:0), (u:$E0128; c:0), - (u:$E0129; c:0), (u:$E012A; c:0), (u:$E012B; c:0), (u:$E012C; c:0), - (u:$E012D; c:0), (u:$E012E; c:0), (u:$E012F; c:0), (u:$E0130; c:0), - (u:$E0131; c:0), (u:$E0132; c:0), (u:$E0133; c:0), (u:$E0134; c:0), - (u:$E0135; c:0), (u:$E0136; c:0), (u:$E0137; c:0), (u:$E0138; c:0), - (u:$E0139; c:0), (u:$E013A; c:0), (u:$E013B; c:0), (u:$E013C; c:0), - (u:$E013D; c:0), (u:$E013E; c:0), (u:$E013F; c:0), (u:$E0140; c:0), - (u:$E0141; c:0), (u:$E0142; c:0), (u:$E0143; c:0), (u:$E0144; c:0), - (u:$E0145; c:0), (u:$E0146; c:0), (u:$E0147; c:0), (u:$E0148; c:0), - (u:$E0149; c:0), (u:$E014A; c:0), (u:$E014B; c:0), (u:$E014C; c:0), - (u:$E014D; c:0), (u:$E014E; c:0), (u:$E014F; c:0), (u:$E0150; c:0), - (u:$E0151; c:0), (u:$E0152; c:0), (u:$E0153; c:0), (u:$E0154; c:0), - (u:$E0155; c:0), (u:$E0156; c:0), (u:$E0157; c:0), (u:$E0158; c:0), - (u:$E0159; c:0), (u:$E015A; c:0), (u:$E015B; c:0), (u:$E015C; c:0), - (u:$E015D; c:0), (u:$E015E; c:0), (u:$E015F; c:0), (u:$E0160; c:0), - (u:$E0161; c:0), (u:$E0162; c:0), (u:$E0163; c:0), (u:$E0164; c:0), - (u:$E0165; c:0), (u:$E0166; c:0), (u:$E0167; c:0), (u:$E0168; c:0), - (u:$E0169; c:0), (u:$E016A; c:0), (u:$E016B; c:0), (u:$E016C; c:0), - (u:$E016D; c:0), (u:$E016E; c:0), (u:$E016F; c:0), (u:$E0170; c:0), - (u:$E0171; c:0), (u:$E0172; c:0), (u:$E0173; c:0), (u:$E0174; c:0), - (u:$E0175; c:0), (u:$E0176; c:0), (u:$E0177; c:0), (u:$E0178; c:0), - (u:$E0179; c:0), (u:$E017A; c:0), (u:$E017B; c:0), (u:$E017C; c:0), - (u:$E017D; c:0), (u:$E017E; c:0), (u:$E017F; c:0), (u:$E0180; c:0), - (u:$E0181; c:0), (u:$E0182; c:0), (u:$E0183; c:0), (u:$E0184; c:0), - (u:$E0185; c:0), (u:$E0186; c:0), (u:$E0187; c:0), (u:$E0188; c:0), - (u:$E0189; c:0), (u:$E018A; c:0), (u:$E018B; c:0), (u:$E018C; c:0), - (u:$E018D; c:0), (u:$E018E; c:0), (u:$E018F; c:0), (u:$E0190; c:0), - (u:$E0191; c:0), (u:$E0192; c:0), (u:$E0193; c:0), (u:$E0194; c:0), - (u:$E0195; c:0), (u:$E0196; c:0), (u:$E0197; c:0), (u:$E0198; c:0), - (u:$E0199; c:0), (u:$E019A; c:0), (u:$E019B; c:0), (u:$E019C; c:0), - (u:$E019D; c:0), (u:$E019E; c:0), (u:$E019F; c:0), (u:$E01A0; c:0), - (u:$E01A1; c:0), (u:$E01A2; c:0), (u:$E01A3; c:0), (u:$E01A4; c:0), - (u:$E01A5; c:0), (u:$E01A6; c:0), (u:$E01A7; c:0), (u:$E01A8; c:0), - (u:$E01A9; c:0), (u:$E01AA; c:0), (u:$E01AB; c:0), (u:$E01AC; c:0), - (u:$E01AD; c:0), (u:$E01AE; c:0), (u:$E01AF; c:0), (u:$E01B0; c:0), - (u:$E01B1; c:0), (u:$E01B2; c:0), (u:$E01B3; c:0), (u:$E01B4; c:0), - (u:$E01B5; c:0), (u:$E01B6; c:0), (u:$E01B7; c:0), (u:$E01B8; c:0), - (u:$E01B9; c:0), (u:$E01BA; c:0), (u:$E01BB; c:0), (u:$E01BC; c:0), - (u:$E01BD; c:0), (u:$E01BE; c:0), (u:$E01BF; c:0), (u:$E01C0; c:0), - (u:$E01C1; c:0), (u:$E01C2; c:0), (u:$E01C3; c:0), (u:$E01C4; c:0), - (u:$E01C5; c:0), (u:$E01C6; c:0), (u:$E01C7; c:0), (u:$E01C8; c:0), - (u:$E01C9; c:0), (u:$E01CA; c:0), (u:$E01CB; c:0), (u:$E01CC; c:0), - (u:$E01CD; c:0), (u:$E01CE; c:0), (u:$E01CF; c:0), (u:$E01D0; c:0), - (u:$E01D1; c:0), (u:$E01D2; c:0), (u:$E01D3; c:0), (u:$E01D4; c:0), - (u:$E01D5; c:0), (u:$E01D6; c:0), (u:$E01D7; c:0), (u:$E01D8; c:0), - (u:$E01D9; c:0), (u:$E01DA; c:0), (u:$E01DB; c:0), (u:$E01DC; c:0), - (u:$E01DD; c:0), (u:$E01DE; c:0), (u:$E01DF; c:0), (u:$E01E0; c:0), - (u:$E01E1; c:0), (u:$E01E2; c:0), (u:$E01E3; c:0), (u:$E01E4; c:0), - (u:$E01E5; c:0), (u:$E01E6; c:0), (u:$E01E7; c:0), (u:$E01E8; c:0), - (u:$E01E9; c:0), (u:$E01EA; c:0), (u:$E01EB; c:0), (u:$E01EC; c:0), - (u:$E01ED; c:0), (u:$E01EE; c:0), (u:$E01EF; c:0) - ); - diff --git a/components/bgrabitmap/generatedutf8.inc b/components/bgrabitmap/generatedutf8.inc deleted file mode 100644 index d3db417..0000000 --- a/components/bgrabitmap/generatedutf8.inc +++ /dev/null @@ -1,1231 +0,0 @@ -{ This file is generated by dev/parseunicode/parseunicodeclasses program } -type - TArabicJoin = (arNone, arInitial, arMedial, arFinal, arIsolated); - TUTF8Decomposition = record - de, re: string; //decomposed, recomposed UTF8 - join: TArabicJoin; - end; -const - UTF8Decomposition : array[0..1219] of TUTF8Decomposition = ( - (de:'≮'; re:'≮'; join:arNone), - (de:'≠'; re:'≠'; join:arNone), - (de:'≯'; re:'≯'; join:arNone), - (de:'AÌ€'; re:'À'; join:arNone), - (de:'AÌ'; re:'Ã'; join:arNone), - (de:'AÌ‚'; re:'Â'; join:arNone), - (de:'Ã'; re:'Ã'; join:arNone), - (de:'AÌ„'; re:'Ä€'; join:arNone), - (de:'Ă'; re:'Ä‚'; join:arNone), - (de:'Ȧ'; re:'Ȧ'; join:arNone), - (de:'Ä'; re:'Ä'; join:arNone), - (de:'Ả'; re:'Ả'; join:arNone), - (de:'AÌŠ'; re:'Ã…'; join:arNone), - (de:'AÌŒ'; re:'Ç'; join:arNone), - (de:'AÌ'; re:'È€'; join:arNone), - (de:'AÌ‘'; re:'È‚'; join:arNone), - (de:'AÌ£'; re:'Ạ'; join:arNone), - (de:'AÌ¥'; re:'Ḁ'; join:arNone), - (de:'Ą'; re:'Ä„'; join:arNone), - (de:'Ḃ'; re:'Ḃ'; join:arNone), - (de:'BÌ£'; re:'Ḅ'; join:arNone), - (de:'Ḇ'; re:'Ḇ'; join:arNone), - (de:'CÌ'; re:'Ć'; join:arNone), - (de:'CÌ‚'; re:'Ĉ'; join:arNone), - (de:'Ċ'; re:'ÄŠ'; join:arNone), - (de:'CÌŒ'; re:'ÄŒ'; join:arNone), - (de:'Ç'; re:'Ç'; join:arNone), - (de:'Ḋ'; re:'Ḋ'; join:arNone), - (de:'DÌŒ'; re:'ÄŽ'; join:arNone), - (de:'DÌ£'; re:'Ḍ'; join:arNone), - (de:'Ḑ'; re:'á¸'; join:arNone), - (de:'DÌ­'; re:'Ḓ'; join:arNone), - (de:'Ḏ'; re:'Ḏ'; join:arNone), - (de:'EÌ€'; re:'È'; join:arNone), - (de:'EÌ'; re:'É'; join:arNone), - (de:'EÌ‚'; re:'Ê'; join:arNone), - (de:'Ẽ'; re:'Ẽ'; join:arNone), - (de:'EÌ„'; re:'Ä’'; join:arNone), - (de:'Ĕ'; re:'Ä”'; join:arNone), - (de:'Ė'; re:'Ä–'; join:arNone), - (de:'Ë'; re:'Ë'; join:arNone), - (de:'Ẻ'; re:'Ẻ'; join:arNone), - (de:'EÌŒ'; re:'Äš'; join:arNone), - (de:'EÌ'; re:'È„'; join:arNone), - (de:'EÌ‘'; re:'Ȇ'; join:arNone), - (de:'EÌ£'; re:'Ẹ'; join:arNone), - (de:'Ȩ'; re:'Ȩ'; join:arNone), - (de:'Ę'; re:'Ę'; join:arNone), - (de:'EÌ­'; re:'Ḙ'; join:arNone), - (de:'EÌ°'; re:'Ḛ'; join:arNone), - (de:'Ḟ'; re:'Ḟ'; join:arNone), - (de:'GÌ'; re:'Ç´'; join:arNone), - (de:'GÌ‚'; re:'Äœ'; join:arNone), - (de:'GÌ„'; re:'Ḡ'; join:arNone), - (de:'Ğ'; re:'Äž'; join:arNone), - (de:'Ġ'; re:'Ä '; join:arNone), - (de:'GÌŒ'; re:'Ǧ'; join:arNone), - (de:'Ģ'; re:'Ä¢'; join:arNone), - (de:'HÌ‚'; re:'Ĥ'; join:arNone), - (de:'Ḣ'; re:'Ḣ'; join:arNone), - (de:'Ḧ'; re:'Ḧ'; join:arNone), - (de:'HÌŒ'; re:'Èž'; join:arNone), - (de:'HÌ£'; re:'Ḥ'; join:arNone), - (de:'Ḩ'; re:'Ḩ'; join:arNone), - (de:'HÌ®'; re:'Ḫ'; join:arNone), - (de:'IÌ€'; re:'ÃŒ'; join:arNone), - (de:'IÌ'; re:'Ã'; join:arNone), - (de:'IÌ‚'; re:'ÃŽ'; join:arNone), - (de:'Ĩ'; re:'Ĩ'; join:arNone), - (de:'IÌ„'; re:'Ī'; join:arNone), - (de:'Ĭ'; re:'Ĭ'; join:arNone), - (de:'İ'; re:'Ä°'; join:arNone), - (de:'Ï'; re:'Ã'; join:arNone), - (de:'Ỉ'; re:'Ỉ'; join:arNone), - (de:'IÌŒ'; re:'Ç'; join:arNone), - (de:'IÌ'; re:'Ȉ'; join:arNone), - (de:'IÌ‘'; re:'ÈŠ'; join:arNone), - (de:'IÌ£'; re:'Ị'; join:arNone), - (de:'Į'; re:'Ä®'; join:arNone), - (de:'IÌ°'; re:'Ḭ'; join:arNone), - (de:'JÌ‚'; re:'Ä´'; join:arNone), - (de:'KÌ'; re:'Ḱ'; join:arNone), - (de:'KÌŒ'; re:'Ǩ'; join:arNone), - (de:'KÌ£'; re:'Ḳ'; join:arNone), - (de:'Ķ'; re:'Ķ'; join:arNone), - (de:'Ḵ'; re:'Ḵ'; join:arNone), - (de:'LÌ'; re:'Ĺ'; join:arNone), - (de:'LÌŒ'; re:'Ľ'; join:arNone), - (de:'LÌ£'; re:'Ḷ'; join:arNone), - (de:'Ļ'; re:'Ä»'; join:arNone), - (de:'LÌ­'; re:'Ḽ'; join:arNone), - (de:'Ḻ'; re:'Ḻ'; join:arNone), - (de:'MÌ'; re:'Ḿ'; join:arNone), - (de:'Ṁ'; re:'á¹€'; join:arNone), - (de:'MÌ£'; re:'Ṃ'; join:arNone), - (de:'NÌ€'; re:'Ǹ'; join:arNone), - (de:'NÌ'; re:'Ń'; join:arNone), - (de:'Ñ'; re:'Ñ'; join:arNone), - (de:'Ṅ'; re:'Ṅ'; join:arNone), - (de:'NÌŒ'; re:'Ň'; join:arNone), - (de:'NÌ£'; re:'Ṇ'; join:arNone), - (de:'Ņ'; re:'Å…'; join:arNone), - (de:'NÌ­'; re:'Ṋ'; join:arNone), - (de:'Ṉ'; re:'Ṉ'; join:arNone), - (de:'OÌ€'; re:'Ã’'; join:arNone), - (de:'OÌ'; re:'Ó'; join:arNone), - (de:'OÌ‚'; re:'Ô'; join:arNone), - (de:'Õ'; re:'Õ'; join:arNone), - (de:'OÌ„'; re:'ÅŒ'; join:arNone), - (de:'Ŏ'; re:'ÅŽ'; join:arNone), - (de:'Ȯ'; re:'È®'; join:arNone), - (de:'Ö'; re:'Ö'; join:arNone), - (de:'Ỏ'; re:'Ỏ'; join:arNone), - (de:'OÌ‹'; re:'Å'; join:arNone), - (de:'OÌŒ'; re:'Ç‘'; join:arNone), - (de:'OÌ'; re:'ÈŒ'; join:arNone), - (de:'OÌ‘'; re:'ÈŽ'; join:arNone), - (de:'OÌ›'; re:'Æ '; join:arNone), - (de:'OÌ£'; re:'Ọ'; join:arNone), - (de:'Ǫ'; re:'Ǫ'; join:arNone), - (de:'PÌ'; re:'á¹”'; join:arNone), - (de:'Ṗ'; re:'á¹–'; join:arNone), - (de:'RÌ'; re:'Å”'; join:arNone), - (de:'Ṙ'; re:'Ṙ'; join:arNone), - (de:'RÌŒ'; re:'Ř'; join:arNone), - (de:'RÌ'; re:'È'; join:arNone), - (de:'RÌ‘'; re:'È’'; join:arNone), - (de:'RÌ£'; re:'Ṛ'; join:arNone), - (de:'Ŗ'; re:'Å–'; join:arNone), - (de:'Ṟ'; re:'Ṟ'; join:arNone), - (de:'SÌ'; re:'Åš'; join:arNone), - (de:'SÌ‚'; re:'Åœ'; join:arNone), - (de:'Ṡ'; re:'á¹ '; join:arNone), - (de:'SÌŒ'; re:'Å '; join:arNone), - (de:'SÌ£'; re:'á¹¢'; join:arNone), - (de:'Ș'; re:'Ș'; join:arNone), - (de:'Ş'; re:'Åž'; join:arNone), - (de:'Ṫ'; re:'Ṫ'; join:arNone), - (de:'TÌŒ'; re:'Ť'; join:arNone), - (de:'TÌ£'; re:'Ṭ'; join:arNone), - (de:'Ț'; re:'Èš'; join:arNone), - (de:'Ţ'; re:'Å¢'; join:arNone), - (de:'TÌ­'; re:'á¹°'; join:arNone), - (de:'Ṯ'; re:'á¹®'; join:arNone), - (de:'UÌ€'; re:'Ù'; join:arNone), - (de:'UÌ'; re:'Ú'; join:arNone), - (de:'UÌ‚'; re:'Û'; join:arNone), - (de:'Ũ'; re:'Ũ'; join:arNone), - (de:'UÌ„'; re:'Ū'; join:arNone), - (de:'Ŭ'; re:'Ŭ'; join:arNone), - (de:'Ü'; re:'Ãœ'; join:arNone), - (de:'Ủ'; re:'Ủ'; join:arNone), - (de:'UÌŠ'; re:'Å®'; join:arNone), - (de:'UÌ‹'; re:'Å°'; join:arNone), - (de:'UÌŒ'; re:'Ç“'; join:arNone), - (de:'UÌ'; re:'È”'; join:arNone), - (de:'UÌ‘'; re:'È–'; join:arNone), - (de:'UÌ›'; re:'Ư'; join:arNone), - (de:'UÌ£'; re:'Ụ'; join:arNone), - (de:'Ṳ'; re:'á¹²'; join:arNone), - (de:'Ų'; re:'Ų'; join:arNone), - (de:'UÌ­'; re:'Ṷ'; join:arNone), - (de:'UÌ°'; re:'á¹´'; join:arNone), - (de:'Ṽ'; re:'á¹¼'; join:arNone), - (de:'VÌ£'; re:'á¹¾'; join:arNone), - (de:'WÌ€'; re:'Ẁ'; join:arNone), - (de:'WÌ'; re:'Ẃ'; join:arNone), - (de:'WÌ‚'; re:'Å´'; join:arNone), - (de:'Ẇ'; re:'Ẇ'; join:arNone), - (de:'Ẅ'; re:'Ẅ'; join:arNone), - (de:'WÌ£'; re:'Ẉ'; join:arNone), - (de:'Ẋ'; re:'Ẋ'; join:arNone), - (de:'Ẍ'; re:'Ẍ'; join:arNone), - (de:'YÌ€'; re:'Ỳ'; join:arNone), - (de:'YÌ'; re:'Ã'; join:arNone), - (de:'YÌ‚'; re:'Ŷ'; join:arNone), - (de:'Ỹ'; re:'Ỹ'; join:arNone), - (de:'YÌ„'; re:'Ȳ'; join:arNone), - (de:'Ẏ'; re:'Ẏ'; join:arNone), - (de:'Ÿ'; re:'Ÿ'; join:arNone), - (de:'Ỷ'; re:'Ỷ'; join:arNone), - (de:'YÌ£'; re:'á»´'; join:arNone), - (de:'ZÌ'; re:'Ź'; join:arNone), - (de:'ZÌ‚'; re:'áº'; join:arNone), - (de:'Ż'; re:'Å»'; join:arNone), - (de:'ZÌŒ'; re:'Ž'; join:arNone), - (de:'ZÌ£'; re:'Ẓ'; join:arNone), - (de:'Ẕ'; re:'Ẕ'; join:arNone), - (de:'aÌ€'; re:'à'; join:arNone), - (de:'aÌ'; re:'á'; join:arNone), - (de:'aÌ‚'; re:'â'; join:arNone), - (de:'ã'; re:'ã'; join:arNone), - (de:'aÌ„'; re:'Ä'; join:arNone), - (de:'ă'; re:'ă'; join:arNone), - (de:'ȧ'; re:'ȧ'; join:arNone), - (de:'ä'; re:'ä'; join:arNone), - (de:'ả'; re:'ả'; join:arNone), - (de:'aÌŠ'; re:'Ã¥'; join:arNone), - (de:'aÌŒ'; re:'ÇŽ'; join:arNone), - (de:'aÌ'; re:'È'; join:arNone), - (de:'aÌ‘'; re:'ȃ'; join:arNone), - (de:'aÌ£'; re:'ạ'; join:arNone), - (de:'aÌ¥'; re:'á¸'; join:arNone), - (de:'ą'; re:'Ä…'; join:arNone), - (de:'ḃ'; re:'ḃ'; join:arNone), - (de:'bÌ£'; re:'ḅ'; join:arNone), - (de:'ḇ'; re:'ḇ'; join:arNone), - (de:'cÌ'; re:'ć'; join:arNone), - (de:'cÌ‚'; re:'ĉ'; join:arNone), - (de:'ċ'; re:'Ä‹'; join:arNone), - (de:'cÌŒ'; re:'Ä'; join:arNone), - (de:'ç'; re:'ç'; join:arNone), - (de:'ḋ'; re:'ḋ'; join:arNone), - (de:'dÌŒ'; re:'Ä'; join:arNone), - (de:'dÌ£'; re:'á¸'; join:arNone), - (de:'ḑ'; re:'ḑ'; join:arNone), - (de:'dÌ­'; re:'ḓ'; join:arNone), - (de:'ḏ'; re:'á¸'; join:arNone), - (de:'eÌ€'; re:'è'; join:arNone), - (de:'eÌ'; re:'é'; join:arNone), - (de:'eÌ‚'; re:'ê'; join:arNone), - (de:'ẽ'; re:'ẽ'; join:arNone), - (de:'eÌ„'; re:'Ä“'; join:arNone), - (de:'ĕ'; re:'Ä•'; join:arNone), - (de:'ė'; re:'Ä—'; join:arNone), - (de:'ë'; re:'ë'; join:arNone), - (de:'ẻ'; re:'ẻ'; join:arNone), - (de:'eÌŒ'; re:'Ä›'; join:arNone), - (de:'eÌ'; re:'È…'; join:arNone), - (de:'eÌ‘'; re:'ȇ'; join:arNone), - (de:'eÌ£'; re:'ẹ'; join:arNone), - (de:'ȩ'; re:'È©'; join:arNone), - (de:'ę'; re:'Ä™'; join:arNone), - (de:'eÌ­'; re:'ḙ'; join:arNone), - (de:'eÌ°'; re:'ḛ'; join:arNone), - (de:'ff'; re:'ff'; join:arNone), - (de:'ffi'; re:'ffi'; join:arNone), - (de:'ffl'; re:'ffl'; join:arNone), - (de:'fi'; re:'ï¬'; join:arNone), - (de:'fl'; re:'fl'; join:arNone), - (de:'ḟ'; re:'ḟ'; join:arNone), - (de:'gÌ'; re:'ǵ'; join:arNone), - (de:'gÌ‚'; re:'Ä'; join:arNone), - (de:'gÌ„'; re:'ḡ'; join:arNone), - (de:'ğ'; re:'ÄŸ'; join:arNone), - (de:'ġ'; re:'Ä¡'; join:arNone), - (de:'gÌŒ'; re:'ǧ'; join:arNone), - (de:'ģ'; re:'Ä£'; join:arNone), - (de:'hÌ‚'; re:'Ä¥'; join:arNone), - (de:'ḣ'; re:'ḣ'; join:arNone), - (de:'ḧ'; re:'ḧ'; join:arNone), - (de:'hÌŒ'; re:'ÈŸ'; join:arNone), - (de:'hÌ£'; re:'ḥ'; join:arNone), - (de:'ḩ'; re:'ḩ'; join:arNone), - (de:'hÌ®'; re:'ḫ'; join:arNone), - (de:'ẖ'; re:'ẖ'; join:arNone), - (de:'iÌ€'; re:'ì'; join:arNone), - (de:'iÌ'; re:'í'; join:arNone), - (de:'iÌ‚'; re:'î'; join:arNone), - (de:'ĩ'; re:'Ä©'; join:arNone), - (de:'iÌ„'; re:'Ä«'; join:arNone), - (de:'ĭ'; re:'Ä­'; join:arNone), - (de:'ï'; re:'ï'; join:arNone), - (de:'ỉ'; re:'ỉ'; join:arNone), - (de:'iÌŒ'; re:'Ç'; join:arNone), - (de:'iÌ'; re:'ȉ'; join:arNone), - (de:'iÌ‘'; re:'È‹'; join:arNone), - (de:'iÌ£'; re:'ị'; join:arNone), - (de:'į'; re:'į'; join:arNone), - (de:'iÌ°'; re:'ḭ'; join:arNone), - (de:'jÌ‚'; re:'ĵ'; join:arNone), - (de:'jÌŒ'; re:'Ç°'; join:arNone), - (de:'kÌ'; re:'ḱ'; join:arNone), - (de:'kÌŒ'; re:'Ç©'; join:arNone), - (de:'kÌ£'; re:'ḳ'; join:arNone), - (de:'ķ'; re:'Ä·'; join:arNone), - (de:'ḵ'; re:'ḵ'; join:arNone), - (de:'lÌ'; re:'ĺ'; join:arNone), - (de:'lÌŒ'; re:'ľ'; join:arNone), - (de:'lÌ£'; re:'ḷ'; join:arNone), - (de:'ļ'; re:'ļ'; join:arNone), - (de:'lÌ­'; re:'ḽ'; join:arNone), - (de:'ḻ'; re:'ḻ'; join:arNone), - (de:'mÌ'; re:'ḿ'; join:arNone), - (de:'ṁ'; re:'á¹'; join:arNone), - (de:'mÌ£'; re:'ṃ'; join:arNone), - (de:'nÌ€'; re:'ǹ'; join:arNone), - (de:'nÌ'; re:'Å„'; join:arNone), - (de:'ñ'; re:'ñ'; join:arNone), - (de:'ṅ'; re:'á¹…'; join:arNone), - (de:'nÌŒ'; re:'ň'; join:arNone), - (de:'nÌ£'; re:'ṇ'; join:arNone), - (de:'ņ'; re:'ņ'; join:arNone), - (de:'nÌ­'; re:'ṋ'; join:arNone), - (de:'ṉ'; re:'ṉ'; join:arNone), - (de:'oÌ€'; re:'ò'; join:arNone), - (de:'oÌ'; re:'ó'; join:arNone), - (de:'oÌ‚'; re:'ô'; join:arNone), - (de:'õ'; re:'õ'; join:arNone), - (de:'oÌ„'; re:'Å'; join:arNone), - (de:'ŏ'; re:'Å'; join:arNone), - (de:'ȯ'; re:'ȯ'; join:arNone), - (de:'ö'; re:'ö'; join:arNone), - (de:'ỏ'; re:'á»'; join:arNone), - (de:'oÌ‹'; re:'Å‘'; join:arNone), - (de:'oÌŒ'; re:'Ç’'; join:arNone), - (de:'oÌ'; re:'È'; join:arNone), - (de:'oÌ‘'; re:'È'; join:arNone), - (de:'oÌ›'; re:'Æ¡'; join:arNone), - (de:'oÌ£'; re:'á»'; join:arNone), - (de:'ǫ'; re:'Ç«'; join:arNone), - (de:'pÌ'; re:'ṕ'; join:arNone), - (de:'ṗ'; re:'á¹—'; join:arNone), - (de:'rÌ'; re:'Å•'; join:arNone), - (de:'ṙ'; re:'á¹™'; join:arNone), - (de:'rÌŒ'; re:'Å™'; join:arNone), - (de:'rÌ'; re:'È‘'; join:arNone), - (de:'rÌ‘'; re:'È“'; join:arNone), - (de:'rÌ£'; re:'á¹›'; join:arNone), - (de:'ŗ'; re:'Å—'; join:arNone), - (de:'ṟ'; re:'ṟ'; join:arNone), - (de:'sÌ'; re:'Å›'; join:arNone), - (de:'sÌ‚'; re:'Å'; join:arNone), - (de:'ṡ'; re:'ṡ'; join:arNone), - (de:'sÌŒ'; re:'Å¡'; join:arNone), - (de:'sÌ£'; re:'á¹£'; join:arNone), - (de:'ș'; re:'È™'; join:arNone), - (de:'ş'; re:'ÅŸ'; join:arNone), - (de:'ṫ'; re:'ṫ'; join:arNone), - (de:'ẗ'; re:'ẗ'; join:arNone), - (de:'tÌŒ'; re:'Å¥'; join:arNone), - (de:'tÌ£'; re:'á¹­'; join:arNone), - (de:'ț'; re:'È›'; join:arNone), - (de:'ţ'; re:'Å£'; join:arNone), - (de:'tÌ­'; re:'á¹±'; join:arNone), - (de:'ṯ'; re:'ṯ'; join:arNone), - (de:'uÌ€'; re:'ù'; join:arNone), - (de:'uÌ'; re:'ú'; join:arNone), - (de:'uÌ‚'; re:'û'; join:arNone), - (de:'ũ'; re:'Å©'; join:arNone), - (de:'uÌ„'; re:'Å«'; join:arNone), - (de:'ŭ'; re:'Å­'; join:arNone), - (de:'ü'; re:'ü'; join:arNone), - (de:'ủ'; re:'ủ'; join:arNone), - (de:'uÌŠ'; re:'ů'; join:arNone), - (de:'uÌ‹'; re:'ű'; join:arNone), - (de:'uÌŒ'; re:'Ç”'; join:arNone), - (de:'uÌ'; re:'È•'; join:arNone), - (de:'uÌ‘'; re:'È—'; join:arNone), - (de:'uÌ›'; re:'Æ°'; join:arNone), - (de:'uÌ£'; re:'ụ'; join:arNone), - (de:'ṳ'; re:'á¹³'; join:arNone), - (de:'ų'; re:'ų'; join:arNone), - (de:'uÌ­'; re:'á¹·'; join:arNone), - (de:'uÌ°'; re:'á¹µ'; join:arNone), - (de:'ṽ'; re:'á¹½'; join:arNone), - (de:'vÌ£'; re:'ṿ'; join:arNone), - (de:'wÌ€'; re:'áº'; join:arNone), - (de:'wÌ'; re:'ẃ'; join:arNone), - (de:'wÌ‚'; re:'ŵ'; join:arNone), - (de:'ẇ'; re:'ẇ'; join:arNone), - (de:'ẅ'; re:'ẅ'; join:arNone), - (de:'wÌŠ'; re:'ẘ'; join:arNone), - (de:'wÌ£'; re:'ẉ'; join:arNone), - (de:'ẋ'; re:'ẋ'; join:arNone), - (de:'ẍ'; re:'áº'; join:arNone), - (de:'yÌ€'; re:'ỳ'; join:arNone), - (de:'yÌ'; re:'ý'; join:arNone), - (de:'yÌ‚'; re:'Å·'; join:arNone), - (de:'ỹ'; re:'ỹ'; join:arNone), - (de:'yÌ„'; re:'ȳ'; join:arNone), - (de:'ẏ'; re:'áº'; join:arNone), - (de:'ÿ'; re:'ÿ'; join:arNone), - (de:'ỷ'; re:'á»·'; join:arNone), - (de:'yÌŠ'; re:'ẙ'; join:arNone), - (de:'yÌ£'; re:'ỵ'; join:arNone), - (de:'zÌ'; re:'ź'; join:arNone), - (de:'zÌ‚'; re:'ẑ'; join:arNone), - (de:'ż'; re:'ż'; join:arNone), - (de:'zÌŒ'; re:'ž'; join:arNone), - (de:'zÌ£'; re:'ẓ'; join:arNone), - (de:'ẕ'; re:'ẕ'; join:arNone), - (de:'῭'; re:'á¿­'; join:arNone), - (de:'¨Ì'; re:'Î…'; join:arNone), - (de:'῁'; re:'á¿'; join:arNone), - (de:'Ầ'; re:'Ầ'; join:arNone), - (de:'ÂÌ'; re:'Ấ'; join:arNone), - (de:'Ẫ'; re:'Ẫ'; join:arNone), - (de:'Ẩ'; re:'Ẩ'; join:arNone), - (de:'Ǟ'; re:'Çž'; join:arNone), - (de:'Ã…Ì'; re:'Ǻ'; join:arNone), - (de:'ÆÌ'; re:'Ǽ'; join:arNone), - (de:'Ǣ'; re:'Ç¢'; join:arNone), - (de:'ÇÌ'; re:'Ḉ'; join:arNone), - (de:'Ề'; re:'Ề'; join:arNone), - (de:'ÊÌ'; re:'Ế'; join:arNone), - (de:'Ễ'; re:'Ễ'; join:arNone), - (de:'Ể'; re:'Ể'; join:arNone), - (de:'ÃÌ'; re:'Ḯ'; join:arNone), - (de:'Ồ'; re:'á»’'; join:arNone), - (de:'ÔÌ'; re:'á»'; join:arNone), - (de:'Ỗ'; re:'á»–'; join:arNone), - (de:'Ổ'; re:'á»”'; join:arNone), - (de:'ÕÌ'; re:'Ṍ'; join:arNone), - (de:'Ȭ'; re:'Ȭ'; join:arNone), - (de:'Ṏ'; re:'Ṏ'; join:arNone), - (de:'Ȫ'; re:'Ȫ'; join:arNone), - (de:'ØÌ'; re:'Ǿ'; join:arNone), - (de:'Ǜ'; re:'Ç›'; join:arNone), - (de:'ÃœÌ'; re:'Ç—'; join:arNone), - (de:'Ǖ'; re:'Ç•'; join:arNone), - (de:'Ǚ'; re:'Ç™'; join:arNone), - (de:'ầ'; re:'ầ'; join:arNone), - (de:'âÌ'; re:'ấ'; join:arNone), - (de:'ẫ'; re:'ẫ'; join:arNone), - (de:'ẩ'; re:'ẩ'; join:arNone), - (de:'ǟ'; re:'ÇŸ'; join:arNone), - (de:'Ã¥Ì'; re:'Ç»'; join:arNone), - (de:'æÌ'; re:'ǽ'; join:arNone), - (de:'ǣ'; re:'Ç£'; join:arNone), - (de:'çÌ'; re:'ḉ'; join:arNone), - (de:'ề'; re:'á»'; join:arNone), - (de:'êÌ'; re:'ế'; join:arNone), - (de:'ễ'; re:'á»…'; join:arNone), - (de:'ể'; re:'ể'; join:arNone), - (de:'ïÌ'; re:'ḯ'; join:arNone), - (de:'ồ'; re:'ồ'; join:arNone), - (de:'ôÌ'; re:'ố'; join:arNone), - (de:'ỗ'; re:'á»—'; join:arNone), - (de:'ổ'; re:'ổ'; join:arNone), - (de:'õÌ'; re:'á¹'; join:arNone), - (de:'ȭ'; re:'È­'; join:arNone), - (de:'ṏ'; re:'á¹'; join:arNone), - (de:'ȫ'; re:'È«'; join:arNone), - (de:'øÌ'; re:'Ç¿'; join:arNone), - (de:'ǜ'; re:'Çœ'; join:arNone), - (de:'üÌ'; re:'ǘ'; join:arNone), - (de:'ǖ'; re:'Ç–'; join:arNone), - (de:'ǚ'; re:'Çš'; join:arNone), - (de:'Ä‚Ì€'; re:'Ằ'; join:arNone), - (de:'Ä‚Ì'; re:'Ắ'; join:arNone), - (de:'Ẵ'; re:'Ẵ'; join:arNone), - (de:'Ẳ'; re:'Ẳ'; join:arNone), - (de:'ằ'; re:'ằ'; join:arNone), - (de:'ăÌ'; re:'ắ'; join:arNone), - (de:'ẵ'; re:'ẵ'; join:arNone), - (de:'ẳ'; re:'ẳ'; join:arNone), - (de:'Ä’Ì€'; re:'Ḕ'; join:arNone), - (de:'Ä’Ì'; re:'Ḗ'; join:arNone), - (de:'Ä“Ì€'; re:'ḕ'; join:arNone), - (de:'Ä“Ì'; re:'ḗ'; join:arNone), - (de:'Ṑ'; re:'á¹'; join:arNone), - (de:'ÅŒÌ'; re:'á¹’'; join:arNone), - (de:'ÅÌ€'; re:'ṑ'; join:arNone), - (de:'ÅÌ'; re:'ṓ'; join:arNone), - (de:'Ṥ'; re:'Ṥ'; join:arNone), - (de:'ṥ'; re:'á¹¥'; join:arNone), - (de:'Ṧ'; re:'Ṧ'; join:arNone), - (de:'ṧ'; re:'ṧ'; join:arNone), - (de:'ŨÌ'; re:'Ṹ'; join:arNone), - (de:'Å©Ì'; re:'á¹¹'; join:arNone), - (de:'Ṻ'; re:'Ṻ'; join:arNone), - (de:'ṻ'; re:'á¹»'; join:arNone), - (de:'ẛ'; re:'ẛ'; join:arNone), - (de:'Ờ'; re:'Ờ'; join:arNone), - (de:'Æ Ì'; re:'Ớ'; join:arNone), - (de:'Ỡ'; re:'á» '; join:arNone), - (de:'Ở'; re:'Ở'; join:arNone), - (de:'Ợ'; re:'Ợ'; join:arNone), - (de:'Æ¡Ì€'; re:'á»'; join:arNone), - (de:'Æ¡Ì'; re:'á»›'; join:arNone), - (de:'ỡ'; re:'ỡ'; join:arNone), - (de:'ở'; re:'ở'; join:arNone), - (de:'Æ¡Ì£'; re:'ợ'; join:arNone), - (de:'Ừ'; re:'Ừ'; join:arNone), - (de:'ƯÌ'; re:'Ứ'; join:arNone), - (de:'Ữ'; re:'á»®'; join:arNone), - (de:'Ử'; re:'Ử'; join:arNone), - (de:'Ự'; re:'á»°'; join:arNone), - (de:'Æ°Ì€'; re:'ừ'; join:arNone), - (de:'Æ°Ì'; re:'ứ'; join:arNone), - (de:'ữ'; re:'ữ'; join:arNone), - (de:'ử'; re:'á»­'; join:arNone), - (de:'Æ°Ì£'; re:'á»±'; join:arNone), - (de:'Æ·ÌŒ'; re:'Ç®'; join:arNone), - (de:'Ǭ'; re:'Ǭ'; join:arNone), - (de:'Ç«Ì„'; re:'Ç­'; join:arNone), - (de:'Ǡ'; re:'Ç '; join:arNone), - (de:'ǡ'; re:'Ç¡'; join:arNone), - (de:'Ḝ'; re:'Ḝ'; join:arNone), - (de:'ḝ'; re:'á¸'; join:arNone), - (de:'Ȱ'; re:'È°'; join:arNone), - (de:'ȱ'; re:'ȱ'; join:arNone), - (de:'Ê’ÌŒ'; re:'ǯ'; join:arNone), - (de:'Ὰ'; re:'Ὰ'; join:arNone), - (de:'ΑÌ'; re:'Ά'; join:arNone), - (de:'Ᾱ'; re:'á¾¹'; join:arNone), - (de:'Ᾰ'; re:'Ᾰ'; join:arNone), - (de:'Ἀ'; re:'Ἀ'; join:arNone), - (de:'Ἁ'; re:'Ἁ'; join:arNone), - (de:'ᾼ'; re:'á¾¼'; join:arNone), - (de:'Ὲ'; re:'Ὲ'; join:arNone), - (de:'ΕÌ'; re:'Έ'; join:arNone), - (de:'Ἐ'; re:'Ἐ'; join:arNone), - (de:'Ἑ'; re:'á¼™'; join:arNone), - (de:'Ὴ'; re:'á¿Š'; join:arNone), - (de:'ΗÌ'; re:'Ή'; join:arNone), - (de:'Ἠ'; re:'Ἠ'; join:arNone), - (de:'Ἡ'; re:'Ἡ'; join:arNone), - (de:'ῌ'; re:'á¿Œ'; join:arNone), - (de:'Ὶ'; re:'á¿š'; join:arNone), - (de:'ΙÌ'; re:'Ί'; join:arNone), - (de:'Ῑ'; re:'á¿™'; join:arNone), - (de:'Ῐ'; re:'Ῐ'; join:arNone), - (de:'Ϊ'; re:'Ϊ'; join:arNone), - (de:'Ἰ'; re:'Ἰ'; join:arNone), - (de:'Ἱ'; re:'á¼¹'; join:arNone), - (de:'Ὸ'; re:'Ὸ'; join:arNone), - (de:'ΟÌ'; re:'ÎŒ'; join:arNone), - (de:'Ὀ'; re:'Ὀ'; join:arNone), - (de:'Ὁ'; re:'Ὁ'; join:arNone), - (de:'Ῥ'; re:'Ῥ'; join:arNone), - (de:'Ὺ'; re:'Ὺ'; join:arNone), - (de:'Î¥Ì'; re:'ÎŽ'; join:arNone), - (de:'Ῡ'; re:'á¿©'; join:arNone), - (de:'Ῠ'; re:'Ῠ'; join:arNone), - (de:'Ϋ'; re:'Ϋ'; join:arNone), - (de:'Ὑ'; re:'á½™'; join:arNone), - (de:'Ὼ'; re:'Ὼ'; join:arNone), - (de:'ΩÌ'; re:'Î'; join:arNone), - (de:'Ὠ'; re:'Ὠ'; join:arNone), - (de:'Ὡ'; re:'Ὡ'; join:arNone), - (de:'ῼ'; re:'ῼ'; join:arNone), - (de:'ᾴ'; re:'á¾´'; join:arNone), - (de:'ῄ'; re:'á¿„'; join:arNone), - (de:'ὰ'; re:'á½°'; join:arNone), - (de:'αÌ'; re:'ά'; join:arNone), - (de:'ᾱ'; re:'á¾±'; join:arNone), - (de:'ᾰ'; re:'á¾°'; join:arNone), - (de:'ἀ'; re:'á¼€'; join:arNone), - (de:'ἁ'; re:'á¼'; join:arNone), - (de:'ᾶ'; re:'ᾶ'; join:arNone), - (de:'ᾳ'; re:'á¾³'; join:arNone), - (de:'ὲ'; re:'á½²'; join:arNone), - (de:'εÌ'; re:'έ'; join:arNone), - (de:'ἐ'; re:'á¼'; join:arNone), - (de:'ἑ'; re:'ἑ'; join:arNone), - (de:'ὴ'; re:'á½´'; join:arNone), - (de:'ηÌ'; re:'ή'; join:arNone), - (de:'ἠ'; re:'á¼ '; join:arNone), - (de:'ἡ'; re:'ἡ'; join:arNone), - (de:'ῆ'; re:'ῆ'; join:arNone), - (de:'ῃ'; re:'ῃ'; join:arNone), - (de:'ὶ'; re:'ὶ'; join:arNone), - (de:'ιÌ'; re:'ί'; join:arNone), - (de:'ῑ'; re:'á¿‘'; join:arNone), - (de:'ῐ'; re:'á¿'; join:arNone), - (de:'ϊ'; re:'ÏŠ'; join:arNone), - (de:'ἰ'; re:'á¼°'; join:arNone), - (de:'ἱ'; re:'á¼±'; join:arNone), - (de:'ῖ'; re:'á¿–'; join:arNone), - (de:'ὸ'; re:'ὸ'; join:arNone), - (de:'οÌ'; re:'ÏŒ'; join:arNone), - (de:'ὀ'; re:'á½€'; join:arNone), - (de:'ὁ'; re:'á½'; join:arNone), - (de:'ÏÌ“'; re:'ῤ'; join:arNone), - (de:'ÏÌ”'; re:'á¿¥'; join:arNone), - (de:'Ï…Ì€'; re:'ὺ'; join:arNone), - (de:'Ï…Ì'; re:'Ï'; join:arNone), - (de:'Ï…Ì„'; re:'á¿¡'; join:arNone), - (de:'ῠ'; re:'á¿ '; join:arNone), - (de:'ϋ'; re:'Ï‹'; join:arNone), - (de:'Ï…Ì“'; re:'á½'; join:arNone), - (de:'Ï…Ì”'; re:'ὑ'; join:arNone), - (de:'Ï…Í‚'; re:'ῦ'; join:arNone), - (de:'ὼ'; re:'á½¼'; join:arNone), - (de:'ωÌ'; re:'ÏŽ'; join:arNone), - (de:'ὠ'; re:'á½ '; join:arNone), - (de:'ὡ'; re:'ὡ'; join:arNone), - (de:'ῶ'; re:'ῶ'; join:arNone), - (de:'ῳ'; re:'ῳ'; join:arNone), - (de:'ÏŠÌ€'; re:'á¿’'; join:arNone), - (de:'ÏŠÌ'; re:'Î'; join:arNone), - (de:'ÏŠÍ‚'; re:'á¿—'; join:arNone), - (de:'Ï‹Ì€'; re:'á¿¢'; join:arNone), - (de:'Ï‹Ì'; re:'ΰ'; join:arNone), - (de:'Ï‹Í‚'; re:'ῧ'; join:arNone), - (de:'ÏŽÍ…'; re:'á¿´'; join:arNone), - (de:'Ï’Ì'; re:'Ï“'; join:arNone), - (de:'ϔ'; re:'Ï”'; join:arNone), - (de:'Ї'; re:'Ї'; join:arNone), - (de:'Ð̆'; re:'Ó'; join:arNone), - (de:'Ð̈'; re:'Ó’'; join:arNone), - (de:'ГÌ'; re:'Ѓ'; join:arNone), - (de:'Ѐ'; re:'Ѐ'; join:arNone), - (de:'Ӗ'; re:'Ó–'; join:arNone), - (de:'Ё'; re:'Ð'; join:arNone), - (de:'Ӂ'; re:'Ó'; join:arNone), - (de:'Ӝ'; re:'Óœ'; join:arNone), - (de:'Ӟ'; re:'Óž'; join:arNone), - (de:'Ѝ'; re:'Ð'; join:arNone), - (de:'Ӣ'; re:'Ó¢'; join:arNone), - (de:'Й'; re:'Й'; join:arNone), - (de:'Ӥ'; re:'Ó¤'; join:arNone), - (de:'КÌ'; re:'ÐŒ'; join:arNone), - (de:'Ӧ'; re:'Ó¦'; join:arNone), - (de:'Ӯ'; re:'Ó®'; join:arNone), - (de:'Ў'; re:'ÐŽ'; join:arNone), - (de:'Ӱ'; re:'Ó°'; join:arNone), - (de:'Ӳ'; re:'Ó²'; join:arNone), - (de:'Ӵ'; re:'Ó´'; join:arNone), - (de:'Ӹ'; re:'Ó¸'; join:arNone), - (de:'Ӭ'; re:'Ó¬'; join:arNone), - (de:'ӑ'; re:'Ó‘'; join:arNone), - (de:'ӓ'; re:'Ó“'; join:arNone), - (de:'гÌ'; re:'Ñ“'; join:arNone), - (de:'ѐ'; re:'Ñ'; join:arNone), - (de:'ӗ'; re:'Ó—'; join:arNone), - (de:'ё'; re:'Ñ‘'; join:arNone), - (de:'ӂ'; re:'Ó‚'; join:arNone), - (de:'ӝ'; re:'Ó'; join:arNone), - (de:'ӟ'; re:'ÓŸ'; join:arNone), - (de:'ѝ'; re:'Ñ'; join:arNone), - (de:'ӣ'; re:'Ó£'; join:arNone), - (de:'й'; re:'й'; join:arNone), - (de:'ӥ'; re:'Ó¥'; join:arNone), - (de:'кÌ'; re:'Ñœ'; join:arNone), - (de:'ӧ'; re:'Ó§'; join:arNone), - (de:'ӯ'; re:'Ó¯'; join:arNone), - (de:'ў'; re:'Ñž'; join:arNone), - (de:'ӱ'; re:'Ó±'; join:arNone), - (de:'ӳ'; re:'Ó³'; join:arNone), - (de:'ӵ'; re:'Óµ'; join:arNone), - (de:'ӹ'; re:'Ó¹'; join:arNone), - (de:'Ñ̈'; re:'Ó­'; join:arNone), - (de:'ї'; re:'Ñ—'; join:arNone), - (de:'Ñ´Ì'; re:'Ѷ'; join:arNone), - (de:'ѵÌ'; re:'Ñ·'; join:arNone), - (de:'Ӛ'; re:'Óš'; join:arNone), - (de:'ӛ'; re:'Ó›'; join:arNone), - (de:'Ӫ'; re:'Óª'; join:arNone), - (de:'ӫ'; re:'Ó«'; join:arNone), - (de:'×Ö·'; re:'אַ'; join:arNone), - (de:'×Ö¸'; re:'אָ'; join:arNone), - (de:'×Ö¼'; re:'אּ'; join:arNone), - (de:'בּ'; re:'בּ'; join:arNone), - (de:'בֿ'; re:'ï­Œ'; join:arNone), - (de:'×’Ö¼'; re:'גּ'; join:arNone), - (de:'דּ'; re:'דּ'; join:arNone), - (de:'×”Ö¼'; re:'הּ'; join:arNone), - (de:'וֹ'; re:'ï­‹'; join:arNone), - (de:'וּ'; re:'וּ'; join:arNone), - (de:'×–Ö¼'; re:'זּ'; join:arNone), - (de:'טּ'; re:'טּ'; join:arNone), - (de:'×™Ö´'; re:'ï¬'; join:arNone), - (de:'×™Ö¼'; re:'יּ'; join:arNone), - (de:'ךּ'; re:'ךּ'; join:arNone), - (de:'×›Ö¼'; re:'כּ'; join:arNone), - (de:'×›Ö¿'; re:'ï­'; join:arNone), - (de:'לּ'; re:'לּ'; join:arNone), - (de:'מּ'; re:'מּ'; join:arNone), - (de:'× Ö¼'; re:'ï­€'; join:arNone), - (de:'סּ'; re:'ï­'; join:arNone), - (de:'×£Ö¼'; re:'ï­ƒ'; join:arNone), - (de:'פּ'; re:'ï­„'; join:arNone), - (de:'פֿ'; re:'ï­Ž'; join:arNone), - (de:'צּ'; re:'ï­†'; join:arNone), - (de:'קּ'; re:'ï­‡'; join:arNone), - (de:'רּ'; re:'ï­ˆ'; join:arNone), - (de:'שּ'; re:'ï­‰'; join:arNone), - (de:'ש×'; re:'שׁ'; join:arNone), - (de:'שׂ'; re:'שׂ'; join:arNone), - (de:'תּ'; re:'ï­Š'; join:arNone), - (de:'ײַ'; re:'ײַ'; join:arNone), - (de:'Ø¡'; re:'ﺀ'; join:arIsolated), - (de:'Ø¢'; re:'ïº'; join:arIsolated), - (de:'Ø¢'; re:'ﺂ'; join:arFinal), - (de:'Ø£'; re:'ﺃ'; join:arIsolated), - (de:'Ø£'; re:'ﺄ'; join:arFinal), - (de:'ؤ'; re:'ﺅ'; join:arIsolated), - (de:'ؤ'; re:'ﺆ'; join:arFinal), - (de:'Ø¥'; re:'ﺇ'; join:arIsolated), - (de:'Ø¥'; re:'ﺈ'; join:arFinal), - (de:'ئ'; re:'ﺉ'; join:arIsolated), - (de:'ئ'; re:'ﺊ'; join:arFinal), - (de:'ئ'; re:'ﺋ'; join:arInitial), - (de:'ئ'; re:'ﺌ'; join:arMedial), - (de:'ا'; re:'ïº'; join:arIsolated), - (de:'ا'; re:'ﺎ'; join:arFinal), - (de:'آ'; re:'Ø¢'; join:arNone), - (de:'أ'; re:'Ø£'; join:arNone), - (de:'إ'; re:'Ø¥'; join:arNone), - (de:'ب'; re:'ïº'; join:arIsolated), - (de:'ب'; re:'ïº'; join:arFinal), - (de:'ب'; re:'ﺑ'; join:arInitial), - (de:'ب'; re:'ﺒ'; join:arMedial), - (de:'Ø©'; re:'ﺓ'; join:arIsolated), - (de:'Ø©'; re:'ﺔ'; join:arFinal), - (de:'ت'; re:'ﺕ'; join:arIsolated), - (de:'ت'; re:'ﺖ'; join:arFinal), - (de:'ت'; re:'ﺗ'; join:arInitial), - (de:'ت'; re:'ﺘ'; join:arMedial), - (de:'Ø«'; re:'ﺙ'; join:arIsolated), - (de:'Ø«'; re:'ﺚ'; join:arFinal), - (de:'Ø«'; re:'ﺛ'; join:arInitial), - (de:'Ø«'; re:'ﺜ'; join:arMedial), - (de:'ج'; re:'ïº'; join:arIsolated), - (de:'ج'; re:'ﺞ'; join:arFinal), - (de:'ج'; re:'ﺟ'; join:arInitial), - (de:'ج'; re:'ﺠ'; join:arMedial), - (de:'Ø­'; re:'ﺡ'; join:arIsolated), - (de:'Ø­'; re:'ﺢ'; join:arFinal), - (de:'Ø­'; re:'ﺣ'; join:arInitial), - (de:'Ø­'; re:'ﺤ'; join:arMedial), - (de:'Ø®'; re:'ﺥ'; join:arIsolated), - (de:'Ø®'; re:'ﺦ'; join:arFinal), - (de:'Ø®'; re:'ﺧ'; join:arInitial), - (de:'Ø®'; re:'ﺨ'; join:arMedial), - (de:'د'; re:'ﺩ'; join:arIsolated), - (de:'د'; re:'ﺪ'; join:arFinal), - (de:'Ø°'; re:'ﺫ'; join:arIsolated), - (de:'Ø°'; re:'ﺬ'; join:arFinal), - (de:'ر'; re:'ﺭ'; join:arIsolated), - (de:'ر'; re:'ﺮ'; join:arFinal), - (de:'ز'; re:'ﺯ'; join:arIsolated), - (de:'ز'; re:'ﺰ'; join:arFinal), - (de:'س'; re:'ﺱ'; join:arIsolated), - (de:'س'; re:'ﺲ'; join:arFinal), - (de:'س'; re:'ﺳ'; join:arInitial), - (de:'س'; re:'ﺴ'; join:arMedial), - (de:'Ø´'; re:'ﺵ'; join:arIsolated), - (de:'Ø´'; re:'ﺶ'; join:arFinal), - (de:'Ø´'; re:'ﺷ'; join:arInitial), - (de:'Ø´'; re:'ﺸ'; join:arMedial), - (de:'ص'; re:'ﺹ'; join:arIsolated), - (de:'ص'; re:'ﺺ'; join:arFinal), - (de:'ص'; re:'ﺻ'; join:arInitial), - (de:'ص'; re:'ﺼ'; join:arMedial), - (de:'ض'; re:'ﺽ'; join:arIsolated), - (de:'ض'; re:'ﺾ'; join:arFinal), - (de:'ض'; re:'ﺿ'; join:arInitial), - (de:'ض'; re:'ﻀ'; join:arMedial), - (de:'Ø·'; re:'ï»'; join:arIsolated), - (de:'Ø·'; re:'ﻂ'; join:arFinal), - (de:'Ø·'; re:'ﻃ'; join:arInitial), - (de:'Ø·'; re:'ﻄ'; join:arMedial), - (de:'ظ'; re:'ï»…'; join:arIsolated), - (de:'ظ'; re:'ﻆ'; join:arFinal), - (de:'ظ'; re:'ﻇ'; join:arInitial), - (de:'ظ'; re:'ﻈ'; join:arMedial), - (de:'ع'; re:'ﻉ'; join:arIsolated), - (de:'ع'; re:'ﻊ'; join:arFinal), - (de:'ع'; re:'ﻋ'; join:arInitial), - (de:'ع'; re:'ﻌ'; join:arMedial), - (de:'غ'; re:'ï»'; join:arIsolated), - (de:'غ'; re:'ﻎ'; join:arFinal), - (de:'غ'; re:'ï»'; join:arInitial), - (de:'غ'; re:'ï»'; join:arMedial), - (de:'Ù'; re:'ﻑ'; join:arIsolated), - (de:'Ù'; re:'ï»’'; join:arFinal), - (de:'Ù'; re:'ﻓ'; join:arInitial), - (de:'Ù'; re:'ï»”'; join:arMedial), - (de:'Ù‚'; re:'ﻕ'; join:arIsolated), - (de:'Ù‚'; re:'ï»–'; join:arFinal), - (de:'Ù‚'; re:'ï»—'; join:arInitial), - (de:'Ù‚'; re:'ﻘ'; join:arMedial), - (de:'Ùƒ'; re:'ï»™'; join:arIsolated), - (de:'Ùƒ'; re:'ﻚ'; join:arFinal), - (de:'Ùƒ'; re:'ï»›'; join:arInitial), - (de:'Ùƒ'; re:'ﻜ'; join:arMedial), - (de:'Ù„'; re:'ï»'; join:arIsolated), - (de:'Ù„'; re:'ﻞ'; join:arFinal), - (de:'Ù„'; re:'ﻟ'; join:arInitial), - (de:'Ù„'; re:'ï» '; join:arMedial), - (de:'لآ'; re:'ﻵ'; join:arIsolated), - (de:'لآ'; re:'ﻶ'; join:arFinal), - (de:'لأ'; re:'ï»·'; join:arIsolated), - (de:'لأ'; re:'ﻸ'; join:arFinal), - (de:'لإ'; re:'ﻹ'; join:arIsolated), - (de:'لإ'; re:'ﻺ'; join:arFinal), - (de:'لا'; re:'ï»»'; join:arIsolated), - (de:'لا'; re:'ﻼ'; join:arFinal), - (de:'Ù…'; re:'ﻡ'; join:arIsolated), - (de:'Ù…'; re:'ﻢ'; join:arFinal), - (de:'Ù…'; re:'ﻣ'; join:arInitial), - (de:'Ù…'; re:'ﻤ'; join:arMedial), - (de:'Ù†'; re:'ﻥ'; join:arIsolated), - (de:'Ù†'; re:'ﻦ'; join:arFinal), - (de:'Ù†'; re:'ﻧ'; join:arInitial), - (de:'Ù†'; re:'ﻨ'; join:arMedial), - (de:'Ù‡'; re:'ﻩ'; join:arIsolated), - (de:'Ù‡'; re:'ﻪ'; join:arFinal), - (de:'Ù‡'; re:'ﻫ'; join:arInitial), - (de:'Ù‡'; re:'ﻬ'; join:arMedial), - (de:'Ùˆ'; re:'ï»­'; join:arIsolated), - (de:'Ùˆ'; re:'ï»®'; join:arFinal), - (de:'ÙˆÙ”'; re:'ؤ'; join:arNone), - (de:'Ù‰'; re:'ﯨ'; join:arInitial), - (de:'Ù‰'; re:'ﯩ'; join:arMedial), - (de:'Ù‰'; re:'ﻯ'; join:arIsolated), - (de:'Ù‰'; re:'ï»°'; join:arFinal), - (de:'ÙŠ'; re:'ï»±'; join:arIsolated), - (de:'ÙŠ'; re:'ﻲ'; join:arFinal), - (de:'ÙŠ'; re:'ﻳ'; join:arInitial), - (de:'ÙŠ'; re:'ï»´'; join:arMedial), - (de:'ÙŠÙ”'; re:'ئ'; join:arNone), - (de:'Ù±'; re:'ï­'; join:arIsolated), - (de:'Ù±'; re:'ï­‘'; join:arFinal), - (de:'Ù·'; re:'ï¯'; join:arIsolated), - (de:'Ù¹'; re:'ï­¦'; join:arIsolated), - (de:'Ù¹'; re:'ï­§'; join:arFinal), - (de:'Ù¹'; re:'ï­¨'; join:arInitial), - (de:'Ù¹'; re:'ï­©'; join:arMedial), - (de:'Ùº'; re:'ï­ž'; join:arIsolated), - (de:'Ùº'; re:'ï­Ÿ'; join:arFinal), - (de:'Ùº'; re:'ï­ '; join:arInitial), - (de:'Ùº'; re:'ï­¡'; join:arMedial), - (de:'Ù»'; re:'ï­’'; join:arIsolated), - (de:'Ù»'; re:'ï­“'; join:arFinal), - (de:'Ù»'; re:'ï­”'; join:arInitial), - (de:'Ù»'; re:'ï­•'; join:arMedial), - (de:'Ù¾'; re:'ï­–'; join:arIsolated), - (de:'Ù¾'; re:'ï­—'; join:arFinal), - (de:'Ù¾'; re:'ï­˜'; join:arInitial), - (de:'Ù¾'; re:'ï­™'; join:arMedial), - (de:'Ù¿'; re:'ï­¢'; join:arIsolated), - (de:'Ù¿'; re:'ï­£'; join:arFinal), - (de:'Ù¿'; re:'ï­¤'; join:arInitial), - (de:'Ù¿'; re:'ï­¥'; join:arMedial), - (de:'Ú€'; re:'ï­š'; join:arIsolated), - (de:'Ú€'; re:'ï­›'; join:arFinal), - (de:'Ú€'; re:'ï­œ'; join:arInitial), - (de:'Ú€'; re:'ï­'; join:arMedial), - (de:'Úƒ'; re:'ï­¶'; join:arIsolated), - (de:'Úƒ'; re:'ï­·'; join:arFinal), - (de:'Úƒ'; re:'ï­¸'; join:arInitial), - (de:'Úƒ'; re:'ï­¹'; join:arMedial), - (de:'Ú„'; re:'ï­²'; join:arIsolated), - (de:'Ú„'; re:'ï­³'; join:arFinal), - (de:'Ú„'; re:'ï­´'; join:arInitial), - (de:'Ú„'; re:'ï­µ'; join:arMedial), - (de:'Ú†'; re:'ï­º'; join:arIsolated), - (de:'Ú†'; re:'ï­»'; join:arFinal), - (de:'Ú†'; re:'ï­¼'; join:arInitial), - (de:'Ú†'; re:'ï­½'; join:arMedial), - (de:'Ú‡'; re:'ï­¾'; join:arIsolated), - (de:'Ú‡'; re:'ï­¿'; join:arFinal), - (de:'Ú‡'; re:'ﮀ'; join:arInitial), - (de:'Ú‡'; re:'ï®'; join:arMedial), - (de:'Úˆ'; re:'ﮈ'; join:arIsolated), - (de:'Úˆ'; re:'ﮉ'; join:arFinal), - (de:'ÚŒ'; re:'ﮄ'; join:arIsolated), - (de:'ÚŒ'; re:'ï®…'; join:arFinal), - (de:'Ú'; re:'ﮂ'; join:arIsolated), - (de:'Ú'; re:'ﮃ'; join:arFinal), - (de:'ÚŽ'; re:'ﮆ'; join:arIsolated), - (de:'ÚŽ'; re:'ﮇ'; join:arFinal), - (de:'Ú‘'; re:'ﮌ'; join:arIsolated), - (de:'Ú‘'; re:'ï®'; join:arFinal), - (de:'Ú˜'; re:'ﮊ'; join:arIsolated), - (de:'Ú˜'; re:'ﮋ'; join:arFinal), - (de:'Ú¤'; re:'ï­ª'; join:arIsolated), - (de:'Ú¤'; re:'ï­«'; join:arFinal), - (de:'Ú¤'; re:'ï­¬'; join:arInitial), - (de:'Ú¤'; re:'ï­­'; join:arMedial), - (de:'Ú¦'; re:'ï­®'; join:arIsolated), - (de:'Ú¦'; re:'ï­¯'; join:arFinal), - (de:'Ú¦'; re:'ï­°'; join:arInitial), - (de:'Ú¦'; re:'ï­±'; join:arMedial), - (de:'Ú©'; re:'ﮎ'; join:arIsolated), - (de:'Ú©'; re:'ï®'; join:arFinal), - (de:'Ú©'; re:'ï®'; join:arInitial), - (de:'Ú©'; re:'ﮑ'; join:arMedial), - (de:'Ú­'; re:'ﯓ'; join:arIsolated), - (de:'Ú­'; re:'ﯔ'; join:arFinal), - (de:'Ú­'; re:'ﯕ'; join:arInitial), - (de:'Ú­'; re:'ﯖ'; join:arMedial), - (de:'Ú¯'; re:'ï®’'; join:arIsolated), - (de:'Ú¯'; re:'ﮓ'; join:arFinal), - (de:'Ú¯'; re:'ï®”'; join:arInitial), - (de:'Ú¯'; re:'ﮕ'; join:arMedial), - (de:'Ú±'; re:'ﮚ'; join:arIsolated), - (de:'Ú±'; re:'ï®›'; join:arFinal), - (de:'Ú±'; re:'ﮜ'; join:arInitial), - (de:'Ú±'; re:'ï®'; join:arMedial), - (de:'Ú³'; re:'ï®–'; join:arIsolated), - (de:'Ú³'; re:'ï®—'; join:arFinal), - (de:'Ú³'; re:'ﮘ'; join:arInitial), - (de:'Ú³'; re:'ï®™'; join:arMedial), - (de:'Úº'; re:'ﮞ'; join:arIsolated), - (de:'Úº'; re:'ﮟ'; join:arFinal), - (de:'Ú»'; re:'ï® '; join:arIsolated), - (de:'Ú»'; re:'ﮡ'; join:arFinal), - (de:'Ú»'; re:'ﮢ'; join:arInitial), - (de:'Ú»'; re:'ﮣ'; join:arMedial), - (de:'Ú¾'; re:'ﮪ'; join:arIsolated), - (de:'Ú¾'; re:'ﮫ'; join:arFinal), - (de:'Ú¾'; re:'ﮬ'; join:arInitial), - (de:'Ú¾'; re:'ï®­'; join:arMedial), - (de:'Û€'; re:'ﮤ'; join:arIsolated), - (de:'Û€'; re:'ﮥ'; join:arFinal), - (de:'Û'; re:'ﮦ'; join:arIsolated), - (de:'Û'; re:'ﮧ'; join:arFinal), - (de:'Û'; re:'ﮨ'; join:arInitial), - (de:'Û'; re:'ﮩ'; join:arMedial), - (de:'ÛÙ”'; re:'Û‚'; join:arNone), - (de:'Û…'; re:'ﯠ'; join:arIsolated), - (de:'Û…'; re:'ﯡ'; join:arFinal), - (de:'Û†'; re:'ﯙ'; join:arIsolated), - (de:'Û†'; re:'ﯚ'; join:arFinal), - (de:'Û‡'; re:'ﯗ'; join:arIsolated), - (de:'Û‡'; re:'ﯘ'; join:arFinal), - (de:'Ûˆ'; re:'ﯛ'; join:arIsolated), - (de:'Ûˆ'; re:'ﯜ'; join:arFinal), - (de:'Û‰'; re:'ﯢ'; join:arIsolated), - (de:'Û‰'; re:'ﯣ'; join:arFinal), - (de:'Û‹'; re:'ﯞ'; join:arIsolated), - (de:'Û‹'; re:'ﯟ'; join:arFinal), - (de:'ÛŒ'; re:'ﯼ'; join:arIsolated), - (de:'ÛŒ'; re:'ﯽ'; join:arFinal), - (de:'ÛŒ'; re:'ﯾ'; join:arInitial), - (de:'ÛŒ'; re:'ﯿ'; join:arMedial), - (de:'Û'; re:'ﯤ'; join:arIsolated), - (de:'Û'; re:'ﯥ'; join:arFinal), - (de:'Û'; re:'ﯦ'; join:arInitial), - (de:'Û'; re:'ﯧ'; join:arMedial), - (de:'Û’'; re:'ï®®'; join:arIsolated), - (de:'Û’'; re:'ﮯ'; join:arFinal), - (de:'Û’Ù”'; re:'Û“'; join:arNone), - (de:'Û“'; re:'ï®°'; join:arIsolated), - (de:'Û“'; re:'ï®±'; join:arFinal), - (de:'Û•Ù”'; re:'Û€'; join:arNone), - (de:'क़'; re:'क़'; join:arNone), - (de:'ख़'; re:'ख़'; join:arNone), - (de:'ग़'; re:'ग़'; join:arNone), - (de:'ज़'; re:'ज़'; join:arNone), - (de:'ड़'; re:'ड़'; join:arNone), - (de:'ढ़'; re:'à¥'; join:arNone), - (de:'ऩ'; re:'ऩ'; join:arNone), - (de:'फ़'; re:'फ़'; join:arNone), - (de:'य़'; re:'य़'; join:arNone), - (de:'ऱ'; re:'ऱ'; join:arNone), - (de:'ऴ'; re:'ऴ'; join:arNone), - (de:'ড়'; re:'ড়'; join:arNone), - (de:'ঢ়'; re:'à§'; join:arNone), - (de:'য়'; re:'য়'; join:arNone), - (de:'ਖ਼'; re:'à©™'; join:arNone), - (de:'ਗ਼'; re:'à©š'; join:arNone), - (de:'ਜ਼'; re:'à©›'; join:arNone), - (de:'ਫ਼'; re:'à©ž'; join:arNone), - (de:'ਲ਼'; re:'ਲ਼'; join:arNone), - (de:'ਸ਼'; re:'ਸ਼'; join:arNone), - (de:'ଡ଼'; re:'à­œ'; join:arNone), - (de:'ଢ଼'; re:'à­'; join:arNone), - (de:'ୈ'; re:'à­ˆ'; join:arNone), - (de:'ේ'; re:'à·š'; join:arNone), - (de:'ෝ'; re:'à·'; join:arNone), - (de:'ཀྵ'; re:'ཀྵ'; join:arNone), - (de:'གྷ'; re:'གྷ'; join:arNone), - (de:'ཌྷ'; re:'à½'; join:arNone), - (de:'དྷ'; re:'དྷ'; join:arNone), - (de:'བྷ'; re:'བྷ'; join:arNone), - (de:'ཛྷ'; re:'ཛྷ'; join:arNone), - (de:'ဦ'; re:'ဦ'; join:arNone), - (de:'ᬻ'; re:'ᬻ'; join:arNone), - (de:'ᬽ'; re:'ᬽ'; join:arNone), - (de:'ᭃ'; re:'á­ƒ'; join:arNone), - (de:'Ḹ'; re:'Ḹ'; join:arNone), - (de:'ḹ'; re:'ḹ'; join:arNone), - (de:'Ṝ'; re:'Ṝ'; join:arNone), - (de:'ṝ'; re:'á¹'; join:arNone), - (de:'Ṩ'; re:'Ṩ'; join:arNone), - (de:'ṩ'; re:'ṩ'; join:arNone), - (de:'Ậ'; re:'Ậ'; join:arNone), - (de:'Ặ'; re:'Ặ'; join:arNone), - (de:'ậ'; re:'ậ'; join:arNone), - (de:'ặ'; re:'ặ'; join:arNone), - (de:'Ệ'; re:'Ệ'; join:arNone), - (de:'ệ'; re:'ệ'; join:arNone), - (de:'Ộ'; re:'Ộ'; join:arNone), - (de:'á»Ì‚'; re:'á»™'; join:arNone), - (de:'ἂ'; re:'ἂ'; join:arNone), - (de:'á¼€Ì'; re:'ἄ'; join:arNone), - (de:'ἆ'; re:'ἆ'; join:arNone), - (de:'ᾀ'; re:'á¾€'; join:arNone), - (de:'á¼Ì€'; re:'ἃ'; join:arNone), - (de:'á¼Ì'; re:'á¼…'; join:arNone), - (de:'á¼Í‚'; re:'ἇ'; join:arNone), - (de:'á¼Í…'; re:'á¾'; join:arNone), - (de:'ᾂ'; re:'ᾂ'; join:arNone), - (de:'ᾃ'; re:'ᾃ'; join:arNone), - (de:'ᾄ'; re:'ᾄ'; join:arNone), - (de:'á¼…Í…'; re:'á¾…'; join:arNone), - (de:'ᾆ'; re:'ᾆ'; join:arNone), - (de:'ᾇ'; re:'ᾇ'; join:arNone), - (de:'Ἂ'; re:'Ἂ'; join:arNone), - (de:'ἈÌ'; re:'Ἄ'; join:arNone), - (de:'Ἆ'; re:'Ἆ'; join:arNone), - (de:'ᾈ'; re:'ᾈ'; join:arNone), - (de:'Ἃ'; re:'Ἃ'; join:arNone), - (de:'ἉÌ'; re:'á¼'; join:arNone), - (de:'Ἇ'; re:'á¼'; join:arNone), - (de:'ᾉ'; re:'ᾉ'; join:arNone), - (de:'ᾊ'; re:'ᾊ'; join:arNone), - (de:'ᾋ'; re:'ᾋ'; join:arNone), - (de:'ᾌ'; re:'ᾌ'; join:arNone), - (de:'á¼Í…'; re:'á¾'; join:arNone), - (de:'ᾎ'; re:'ᾎ'; join:arNone), - (de:'á¼Í…'; re:'á¾'; join:arNone), - (de:'á¼Ì€'; re:'á¼’'; join:arNone), - (de:'á¼Ì'; re:'á¼”'; join:arNone), - (de:'ἓ'; re:'ἓ'; join:arNone), - (de:'ἑÌ'; re:'ἕ'; join:arNone), - (de:'Ἒ'; re:'Ἒ'; join:arNone), - (de:'ἘÌ'; re:'Ἔ'; join:arNone), - (de:'Ἓ'; re:'á¼›'; join:arNone), - (de:'á¼™Ì'; re:'á¼'; join:arNone), - (de:'ἢ'; re:'á¼¢'; join:arNone), - (de:'á¼ Ì'; re:'ἤ'; join:arNone), - (de:'á¼ Í‚'; re:'ἦ'; join:arNone), - (de:'á¼ Í…'; re:'á¾'; join:arNone), - (de:'ἣ'; re:'á¼£'; join:arNone), - (de:'ἡÌ'; re:'á¼¥'; join:arNone), - (de:'ἧ'; re:'ἧ'; join:arNone), - (de:'ᾑ'; re:'ᾑ'; join:arNone), - (de:'ᾒ'; re:'á¾’'; join:arNone), - (de:'ᾓ'; re:'ᾓ'; join:arNone), - (de:'ᾔ'; re:'á¾”'; join:arNone), - (de:'ᾕ'; re:'ᾕ'; join:arNone), - (de:'ᾖ'; re:'á¾–'; join:arNone), - (de:'ᾗ'; re:'á¾—'; join:arNone), - (de:'Ἢ'; re:'Ἢ'; join:arNone), - (de:'ἨÌ'; re:'Ἤ'; join:arNone), - (de:'Ἦ'; re:'á¼®'; join:arNone), - (de:'ᾘ'; re:'ᾘ'; join:arNone), - (de:'Ἣ'; re:'Ἣ'; join:arNone), - (de:'ἩÌ'; re:'á¼­'; join:arNone), - (de:'Ἧ'; re:'Ἧ'; join:arNone), - (de:'ᾙ'; re:'á¾™'; join:arNone), - (de:'ᾚ'; re:'ᾚ'; join:arNone), - (de:'ᾛ'; re:'á¾›'; join:arNone), - (de:'ᾜ'; re:'ᾜ'; join:arNone), - (de:'á¼­Í…'; re:'á¾'; join:arNone), - (de:'ᾞ'; re:'ᾞ'; join:arNone), - (de:'ᾟ'; re:'ᾟ'; join:arNone), - (de:'á¼°Ì€'; re:'á¼²'; join:arNone), - (de:'á¼°Ì'; re:'á¼´'; join:arNone), - (de:'á¼°Í‚'; re:'ἶ'; join:arNone), - (de:'ἳ'; re:'á¼³'; join:arNone), - (de:'á¼±Ì'; re:'á¼µ'; join:arNone), - (de:'ἷ'; re:'á¼·'; join:arNone), - (de:'Ἲ'; re:'Ἲ'; join:arNone), - (de:'ἸÌ'; re:'á¼¼'; join:arNone), - (de:'Ἶ'; re:'á¼¾'; join:arNone), - (de:'Ἳ'; re:'á¼»'; join:arNone), - (de:'á¼¹Ì'; re:'á¼½'; join:arNone), - (de:'Ἷ'; re:'Ἷ'; join:arNone), - (de:'ὂ'; re:'ὂ'; join:arNone), - (de:'á½€Ì'; re:'ὄ'; join:arNone), - (de:'á½Ì€'; re:'ὃ'; join:arNone), - (de:'á½Ì'; re:'á½…'; join:arNone), - (de:'Ὂ'; re:'Ὂ'; join:arNone), - (de:'ὈÌ'; re:'Ὄ'; join:arNone), - (de:'Ὃ'; re:'Ὃ'; join:arNone), - (de:'ὉÌ'; re:'á½'; join:arNone), - (de:'á½Ì€'; re:'á½’'; join:arNone), - (de:'á½Ì'; re:'á½”'; join:arNone), - (de:'á½Í‚'; re:'á½–'; join:arNone), - (de:'ὓ'; re:'ὓ'; join:arNone), - (de:'ὑÌ'; re:'ὕ'; join:arNone), - (de:'ὗ'; re:'á½—'; join:arNone), - (de:'Ὓ'; re:'á½›'; join:arNone), - (de:'á½™Ì'; re:'á½'; join:arNone), - (de:'Ὗ'; re:'Ὗ'; join:arNone), - (de:'ὢ'; re:'á½¢'; join:arNone), - (de:'á½ Ì'; re:'ὤ'; join:arNone), - (de:'á½ Í‚'; re:'ὦ'; join:arNone), - (de:'á½ Í…'; re:'á¾ '; join:arNone), - (de:'ὣ'; re:'á½£'; join:arNone), - (de:'ὡÌ'; re:'á½¥'; join:arNone), - (de:'ὧ'; re:'ὧ'; join:arNone), - (de:'ᾡ'; re:'ᾡ'; join:arNone), - (de:'ᾢ'; re:'á¾¢'; join:arNone), - (de:'ᾣ'; re:'á¾£'; join:arNone), - (de:'ᾤ'; re:'ᾤ'; join:arNone), - (de:'ᾥ'; re:'á¾¥'; join:arNone), - (de:'ᾦ'; re:'ᾦ'; join:arNone), - (de:'ᾧ'; re:'ᾧ'; join:arNone), - (de:'Ὢ'; re:'Ὢ'; join:arNone), - (de:'ὨÌ'; re:'Ὤ'; join:arNone), - (de:'Ὦ'; re:'á½®'; join:arNone), - (de:'ᾨ'; re:'ᾨ'; join:arNone), - (de:'Ὣ'; re:'Ὣ'; join:arNone), - (de:'ὩÌ'; re:'á½­'; join:arNone), - (de:'Ὧ'; re:'Ὧ'; join:arNone), - (de:'ᾩ'; re:'ᾩ'; join:arNone), - (de:'ᾪ'; re:'ᾪ'; join:arNone), - (de:'ᾫ'; re:'ᾫ'; join:arNone), - (de:'ᾬ'; re:'ᾬ'; join:arNone), - (de:'á½­Í…'; re:'á¾­'; join:arNone), - (de:'ᾮ'; re:'á¾®'; join:arNone), - (de:'ᾯ'; re:'ᾯ'; join:arNone), - (de:'á½°Í…'; re:'á¾²'; join:arNone), - (de:'á½´Í…'; re:'á¿‚'; join:arNone), - (de:'ῲ'; re:'ῲ'; join:arNone), - (de:'ᾷ'; re:'á¾·'; join:arNone), - (de:'῍'; re:'á¿'; join:arNone), - (de:'᾿Ì'; re:'á¿Ž'; join:arNone), - (de:'῏'; re:'á¿'; join:arNone), - (de:'ῇ'; re:'ῇ'; join:arNone), - (de:'ῷ'; re:'á¿·'; join:arNone), - (de:'῝'; re:'á¿'; join:arNone), - (de:'῾Ì'; re:'á¿ž'; join:arNone), - (de:'῟'; re:'á¿Ÿ'; join:arNone), - (de:'â†Ì¸'; re:'↚'; join:arNone), - (de:'↛'; re:'↛'; join:arNone), - (de:'↮'; re:'↮'; join:arNone), - (de:'â‡Ì¸'; re:'â‡'; join:arNone), - (de:'⇏'; re:'â‡'; join:arNone), - (de:'⇎'; re:'⇎'; join:arNone), - (de:'∄'; re:'∄'; join:arNone), - (de:'∉'; re:'∉'; join:arNone), - (de:'∌'; re:'∌'; join:arNone), - (de:'∤'; re:'∤'; join:arNone), - (de:'∦'; re:'∦'; join:arNone), - (de:'≁'; re:'â‰'; join:arNone), - (de:'≄'; re:'≄'; join:arNone), - (de:'≇'; re:'≇'; join:arNone), - (de:'≉'; re:'≉'; join:arNone), - (de:'â‰Ì¸'; re:'≭'; join:arNone), - (de:'≢'; re:'≢'; join:arNone), - (de:'≰'; re:'≰'; join:arNone), - (de:'≱'; re:'≱'; join:arNone), - (de:'≴'; re:'≴'; join:arNone), - (de:'≵'; re:'≵'; join:arNone), - (de:'≸'; re:'≸'; join:arNone), - (de:'≹'; re:'≹'; join:arNone), - (de:'⊀'; re:'⊀'; join:arNone), - (de:'⊁'; re:'âŠ'; join:arNone), - (de:'⋠'; re:'â‹ '; join:arNone), - (de:'⋡'; re:'â‹¡'; join:arNone), - (de:'⊄'; re:'⊄'; join:arNone), - (de:'⊅'; re:'⊅'; join:arNone), - (de:'⊈'; re:'⊈'; join:arNone), - (de:'⊉'; re:'⊉'; join:arNone), - (de:'⋢'; re:'â‹¢'; join:arNone), - (de:'⋣'; re:'â‹£'; join:arNone), - (de:'⊬'; re:'⊬'; join:arNone), - (de:'⊭'; re:'⊭'; join:arNone), - (de:'⊮'; re:'⊮'; join:arNone), - (de:'⊯'; re:'⊯'; join:arNone), - (de:'⋪'; re:'⋪'; join:arNone), - (de:'⋫'; re:'â‹«'; join:arNone), - (de:'⋬'; re:'⋬'; join:arNone), - (de:'⋭'; re:'â‹­'; join:arNone), - (de:'â«Ì¸'; re:'â«œ'; join:arNone), - (de:'ã†ã‚™'; re:'ã‚”'; join:arNone), - (de:'ã‹ã‚™'; re:'ãŒ'; join:arNone), - (de:'ãã‚™'; re:'ãŽ'; join:arNone), - (de:'ãã‚™'; re:'ã'; join:arNone), - (de:'ã‘ã‚™'; re:'ã’'; join:arNone), - (de:'ã“ã‚™'; re:'ã”'; join:arNone), - (de:'ã•ã‚™'; re:'ã–'; join:arNone), - (de:'ã—ã‚™'; re:'ã˜'; join:arNone), - (de:'ã™ã‚™'; re:'ãš'; join:arNone), - (de:'ã›ã‚™'; re:'ãœ'; join:arNone), - (de:'ãã‚™'; re:'ãž'; join:arNone), - (de:'ãŸã‚™'; re:'ã '; join:arNone), - (de:'ã¡ã‚™'; re:'ã¢'; join:arNone), - (de:'ã¤ã‚™'; re:'ã¥'; join:arNone), - (de:'ã¦ã‚™'; re:'ã§'; join:arNone), - (de:'ã¨ã‚™'; re:'ã©'; join:arNone), - (de:'ã¯ã‚™'; re:'ã°'; join:arNone), - (de:'ã¯ã‚š'; re:'ã±'; join:arNone), - (de:'ã²ã‚™'; re:'ã³'; join:arNone), - (de:'ã²ã‚š'; re:'ã´'; join:arNone), - (de:'ãµã‚™'; re:'ã¶'; join:arNone), - (de:'ãµã‚š'; re:'ã·'; join:arNone), - (de:'ã¸ã‚™'; re:'ã¹'; join:arNone), - (de:'ã¸ã‚š'; re:'ãº'; join:arNone), - (de:'ã»ã‚™'; re:'ã¼'; join:arNone), - (de:'ã»ã‚š'; re:'ã½'; join:arNone), - (de:'ã‚ã‚™'; re:'ã‚ž'; join:arNone), - (de:'ヴ'; re:'ヴ'; join:arNone), - (de:'ã‚«ã‚™'; re:'ガ'; join:arNone), - (de:'ã‚­ã‚™'; re:'ã‚®'; join:arNone), - (de:'グ'; re:'ã‚°'; join:arNone), - (de:'ゲ'; re:'ゲ'; join:arNone), - (de:'ゴ'; re:'ã‚´'; join:arNone), - (de:'ザ'; re:'ザ'; join:arNone), - (de:'ã‚·ã‚™'; re:'ジ'; join:arNone), - (de:'ズ'; re:'ズ'; join:arNone), - (de:'ゼ'; re:'ゼ'; join:arNone), - (de:'ゾ'; re:'ゾ'; join:arNone), - (de:'ã‚¿ã‚™'; re:'ダ'; join:arNone), - (de:'ãƒã‚™'; re:'ヂ'; join:arNone), - (de:'ヅ'; re:'ヅ'; join:arNone), - (de:'デ'; re:'デ'; join:arNone), - (de:'ド'; re:'ド'; join:arNone), - (de:'ãƒã‚™'; re:'ãƒ'; join:arNone), - (de:'ãƒã‚š'; re:'パ'; join:arNone), - (de:'ビ'; re:'ビ'; join:arNone), - (de:'ピ'; re:'ピ'; join:arNone), - (de:'ブ'; re:'ブ'; join:arNone), - (de:'プ'; re:'プ'; join:arNone), - (de:'ベ'; re:'ベ'; join:arNone), - (de:'ペ'; re:'ペ'; join:arNone), - (de:'ボ'; re:'ボ'; join:arNone), - (de:'ポ'; re:'ãƒ'; join:arNone), - (de:'ヷ'; re:'ヷ'; join:arNone), - (de:'ヸ'; re:'ヸ'; join:arNone), - (de:'ヹ'; re:'ヹ'; join:arNone), - (de:'ヺ'; re:'ヺ'; join:arNone), - (de:'ヾ'; re:'ヾ'; join:arNone), - (de:'ï­‰×'; re:'שּׁ'; join:arNone), - (de:'שּׂ'; re:'שּׂ'; join:arNone), - (de:'𑂚'; re:'ð‘‚š'; join:arNone), - (de:'𑂜'; re:'ð‘‚œ'; join:arNone), - (de:'𑂫'; re:'ð‘‚«'; join:arNone), - (de:'𑒻'; re:'ð‘’»'; join:arNone) - ); - diff --git a/components/bgrabitmap/geometrytypes.inc b/components/bgrabitmap/geometrytypes.inc deleted file mode 100644 index e2d04b2..0000000 --- a/components/bgrabitmap/geometrytypes.inc +++ /dev/null @@ -1,1686 +0,0 @@ -{=== Geometry types ===} - -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} -const - {* Value indicating that there is nothing in the single-precision floating point value. - It is also used as a separator in lists } - EmptySingle = single(-3.402823e38); - -type - TPoint = BGRAClasses.TPoint; - TSize = BGRAClasses.TSize; - - {* Pointer to a ''TPointF'' structure } - PPointF = ^BGRAClasses.TPointF; - {* Contains a point with single-precision floating point coordinates } - TPointF = BGRAClasses.TPointF; - {* Contains an array of points with single-precision floating point coordinates } - ArrayOfTPointF = array of TPointF; - - {* An affine matrix contains three 2D vectors: the image of x, the image of y and the translation } - TAffineMatrix = array[1..2,1..3] of single; - TRectF = BGRAClasses.TRectF; - -{$if FPC_FULLVERSION<030001} - {$define BGRA_DEFINE_TRECTHELPER} - { TRectHelper } - - TRectHelper = record helper for TRect - private - function GetHeight: integer; - function GetIsEmpty: boolean; - function GetWidth: integer; - procedure SetHeight(AValue: integer); - procedure SetWidth(AValue: integer); - public - constructor Create(Origin: TPoint; AWidth, AHeight: Longint); overload; - constructor Create(ALeft, ATop, ARight, ABottom: Longint); overload; - procedure Intersect(R: TRect); - class function Intersect(R1: TRect; R2: TRect): TRect; static; - function IntersectsWith(R: TRect): Boolean; - class function Union(R1, R2: TRect): TRect; static; - procedure Union(R: TRect); - procedure Offset(DX, DY: Longint); - procedure Inflate(DX, DY: Longint); - function Contains(const APoint: TPoint): boolean; overload; - function Contains(const ARect: TRect): boolean; overload; - property Width: integer read GetWidth write SetWidth; - property Height: integer read GetHeight write SetHeight; - property IsEmpty: boolean read GetIsEmpty; - end; - -operator=(const ARect1,ARect2: TRect): boolean; -{$endif} - -{$if (FPC_FULLVERSION<030001) or defined(BGRABITMAP_USE_MSEGUI)} -type - {$define BGRA_DEFINE_TSIZEHELPER} - { TSizeHelper } - - TSizeHelper = record helper for TSize - private - function GetHeight: integer; - function GetWidth: integer; - public - property Width: integer read GetWidth; - property Height: integer read GetHeight; - end; -{$ENDIF} - -const - EmptyPoint : TPoint = (X: -2147483648; Y: -2147483648); - -function IsEmptyPoint(const APoint: TPoint): boolean; - -type - - { TPointFHelper } - - TPointFHelper = record helper for TPointF - procedure Offset(const apt : TPointF); overload; - procedure Offset(const apt : TPoint); overload; - procedure Offset(dx,dy : longint); overload; - procedure Offset(dx,dy : single); overload; - procedure Scale(AScale: single); - procedure Normalize; - - function Ceiling: TPoint; - function Truncate: TPoint; - function Floor: TPoint; - function Round: TPoint; - function Length: Single; - function IsEmpty: boolean; - end; - -type - PRectF = ^TRectF; - - { TRectFHelper } - - TRectFHelper = record helper for TRectF - class function Intersect(const R1: TRectF; const R2: TRectF): TRectF; overload; static; - class function Union(const R1: TRectF; const R2: TRectF): TRectF; overload; static; - class function Union(const R1: TRectF; const R2: TRectF; ADiscardEmpty: boolean): TRectF; overload; static; - function Union(const r: TRectF):TRectF; overload; - function Union(const r: TRectF; ADiscardEmpty: boolean):TRectF; overload; - procedure Include(const APoint: TPointF); - function Contains(const APoint: TPointF; AIncludeBottomRight: boolean = false): boolean; - function IntersectsWith(const r: TRectF): boolean; - function IsEmpty: boolean; - end; - -const - {* A value for an empty rectangle } - EmptyRectF : TRectF = (left:0; top:0; right:0; bottom: 0); - - function RectF(Left, Top, Right, Bottom: Single): TRectF; - function RectF(const ATopLeft,ABottomRight: TPointF): TRectF; - function RectF(const ARect: TRect): TRectF; - function RectWithSizeF(left,top,width,height: Single): TRectF; - function IsEmptyRectF(const ARect:TRectF): boolean; - -type - { TAffineBox } - - TAffineBox = object - private - function GetAsPolygon: ArrayOfTPointF; - function GetBottomRight: TPointF; - function GetCenter: TPointF; - function GetHeight: single; - function GetIsEmpty: boolean; - function GetRectBounds: TRect; - function GetRectBoundsF: TRectF; - function GetSurface: single; - function GetWidth: single; - public - TopLeft, TopRight, - BottomLeft: TPointF; - class function EmptyBox: TAffineBox; static; - class function AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox; overload; static; - class function AffineBox(ARectF: TRectF): TAffineBox; overload; static; - procedure Offset(AOfsX, AOfsY: single); overload; - procedure Offset(AOfs: TPointF); overload; - procedure Inflate(AHoriz, AVert: single); //inflates along axes - function Contains(APoint: TPointF): boolean; - property RectBounds: TRect read GetRectBounds; - property RectBoundsF: TRectF read GetRectBoundsF; - property BottomRight: TPointF read GetBottomRight; - property IsEmpty: boolean read GetIsEmpty; - property AsPolygon: ArrayOfTPointF read GetAsPolygon; - property Width: single read GetWidth; - property Height: single read GetHeight; - property Surface: single read GetSurface; - property Center: TPointF read GetCenter; - end; - - const - {** Value indicating that there is an empty ''TPointF'' structure. - It is also used as a separator in lists of points } - EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38); - - {----------------- Operators for TPointF --------------------} - {** Creates a new structure with values ''x'' and ''y'' } - function PointF(x, y: single): TPointF; overload; - function PointF(pt: TPoint): TPointF; overload; - {** Checks if the structure is empty (equal to ''EmptyPointF'') } - function isEmptyPointF(const pt: TPointF): boolean; - {** Checks if both ''x'' and ''y'' are equal } - operator = (const pt1, pt2: TPointF): boolean; inline; - {** Adds ''x'' and ''y'' components separately. It is like adding vectors } - operator + (const pt1, pt2: TPointF): TPointF; inline; - {** Subtract ''x'' and ''y'' components separately. It is like subtracting vectors } - operator - (const pt1, pt2: TPointF): TPointF; inline; - {** Returns a point with opposite values for ''x'' and ''y'' components } - operator - (const pt2: TPointF): TPointF; inline; - {** Scalar product: multiplies ''x'' and ''y'' components and returns the sum } - operator * (const pt1, pt2: TPointF): single; inline; - {** Multiplies both ''x'' and ''y'' by ''factor''. It scales the vector represented by (''x'',''y'') } - operator * (const pt1: TPointF; factor: single): TPointF; inline; - {** Multiplies both ''x'' and ''y'' by ''factor''. It scales the vector represented by (''x'',''y'') } - operator * (factor: single; const pt1: TPointF): TPointF; inline; - {** Returns the length of the vector (''dx'',''dy'') } - function VectLen(dx,dy: single): single; overload; - {** Returns the length of the vector represented by (''x'',''y'') } - function VectLen(v: TPointF): single; overload; - function VectDet(v1,v2: TPointF): double; inline; - -type - TFaceCulling = (fcNone, fcKeepCW, fcKeepCCW); - - {** Creates an array of ''TPointF'' } - function PointsF(const pts: array of TPointF): ArrayOfTPointF; - {** Concatenates arrays of ''TPointF'' } - function ConcatPointsF(const APolylines: array of ArrayOfTPointF; AInsertEmptyPointInBetween: boolean = false): ArrayOfTPointF; - {** Compute the length of the polyline contained in the array. - ''AClosed'' specifies if the last point is to be joined to the first one } - function PolylineLen(const pts: array of TPointF; AClosed: boolean = false): single; - -type - {* A pen style can be dashed, dotted, etc. It is defined as a list of floating point number. - The first number is the length of the first dash, - the second number is the length of the first gap, - the third number is the length of the second dash... - It must have an even number of values. This is used as a complement - to [[BGRABitmap Types imported from Graphics|TPenStyle]] } - TBGRAPenStyle = array Of Single; - - {** Creates a pen style with the specified length for the dashes and the spaces } - function BGRAPenStyle(dash1, space1: single; dash2: single=0; space2: single = 0; dash3: single=0; space3: single = 0; dash4 : single = 0; space4 : single = 0): TBGRAPenStyle; - -type - {* Different types of spline. A spline is a series of points that are used - as control points to draw a curve. The first point and last point may - or may not be the starting and ending point } - TSplineStyle = ( - {** The curve is drawn inside the polygonal envelope without reaching the starting and ending points } - ssInside, - {** The curve is drawn inside the polygonal envelope and the starting and ending points are reached } - ssInsideWithEnds, - {** The curve crosses the polygonal envelope without reaching the starting and ending points } - ssCrossing, - {** The curve crosses the polygonal envelope and the starting and ending points are reached } - ssCrossingWithEnds, - {** The curve is outside the polygonal envelope (starting and ending points are reached) } - ssOutside, - {** The curve expands outside the polygonal envelope (starting and ending points are reached) } - ssRoundOutside, - {** The curve is outside the polygonal envelope and there is a tangeant at vertices (starting and ending points are reached) } - ssVertexToSide, - {** The curve is rounded using Bezier curves when the angle is less than or equal to 45° } - ssEasyBezier); - -type - {* Pointer to an arc definition } - PArcDef = ^TArcDef; - {* Definition of an arc of an ellipse } - TArcDef = record - {** Center of the ellipse } - center: TPointF; - {** Horizontal and vertical of the ellipse before rotation } - radius: TPointF; - {** Rotation of the ellipse } - xAngleRadCW: single; - {** Start and end angle, in radian and clockwise. See angle convention in ''BGRAPath'' } - startAngleRadCW, endAngleRadCW: single; - {** Specifies if the arc goes anticlockwise } - anticlockwise: boolean - end; - - {** Creates a structure for an arc definition } - function ArcDef(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean) : TArcDef; - -type - {* Possible options for drawing an arc of an ellipse (used in ''BGRACanvas'') } - TArcOption = ( - {** Close the path by joining the ending and starting point together } - aoClosePath, - {** Draw a pie shape by joining the ending and starting point to the center of the ellipse } - aoPie, - {** Fills the shape } - aoFillPath); - {** Set of options for drawing an arc } - TArcOptions = set of TArcOption; - - TBGRAArrowStyle = (asNone, asNormal, asCut, asTriangle, asHollowTriangle, asFlipped, asFlippedCut, asTail, asTailRepeat); - - { TBGRACustomArrow } - - TBGRACustomArrow = class - protected - function GetEndOffsetX: single; virtual; abstract; - function GetEndRepeatCount: integer; virtual; abstract; - function GetEndSizeFactor: TPointF; virtual; abstract; - function GetIsEndDefined: boolean; virtual; abstract; - function GetIsStartDefined: boolean; virtual; abstract; - function GetStartOffsetX: single; virtual; abstract; - function GetStartRepeatCount: integer; virtual; abstract; - function GetStartSizeFactor: TPointF; virtual; abstract; - procedure SetEndOffsetX(AValue: single); virtual; abstract; - procedure SetEndRepeatCount(AValue: integer); virtual; abstract; - procedure SetEndSizeFactor(AValue: TPointF); virtual; abstract; - procedure SetStartOffsetX(AValue: single); virtual; abstract; - procedure SetStartRepeatCount(AValue: integer); virtual; abstract; - procedure SetStartSizeFactor(AValue: TPointF); virtual; abstract; - function GetLineCap: TPenEndCap; virtual; abstract; - procedure SetLineCap(AValue: TPenEndCap); virtual; abstract; - public - function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; virtual; abstract; - function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; virtual; abstract; - procedure StartAsNone; virtual; abstract; - procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; - procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; - procedure StartAsTail; virtual; abstract; - procedure EndAsNone; virtual; abstract; - procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract; - procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract; - procedure EndAsTail; virtual; abstract; - property IsStartDefined: boolean read GetIsStartDefined; - property IsEndDefined: boolean read GetIsEndDefined; - property StartOffsetX: single read GetStartOffsetX write SetStartOffsetX; - property EndOffsetX: single read GetEndOffsetX write SetEndOffsetX; - property LineCap: TPenEndCap read GetLineCap write SetLineCap; - property StartSize: TPointF read GetStartSizeFactor write SetStartSizeFactor; - property EndSize: TPointF read GetEndSizeFactor write SetEndSizeFactor; - property StartRepeatCount: integer read GetStartRepeatCount write SetStartRepeatCount; - property EndRepeatCount: integer read GetEndRepeatCount write SetEndRepeatCount; - end; - - { TBGRACustomPenStroker } - - TBGRACustomPenStroker = class - protected - function GetArrow: TBGRACustomArrow; virtual; abstract; - function GetArrowOwned: boolean; virtual; abstract; - function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract; - function GetJoinStyle: TPenJoinStyle; virtual; abstract; - function GetLineCap: TPenEndCap; virtual; abstract; - function GetMiterLimit: single; virtual; abstract; - function GetPenStyle: TPenStyle; virtual; abstract; - function GetStrokeMatrix: TAffineMatrix; virtual; abstract; - procedure SetArrow(AValue: TBGRACustomArrow); virtual; abstract; - procedure SetArrowOwned(AValue: boolean); virtual; abstract; - procedure SetCustomPenStyle(AValue: TBGRAPenStyle); virtual; abstract; - procedure SetJoinStyle(AValue: TPenJoinStyle); virtual; abstract; - procedure SetLineCap(AValue: TPenEndCap); virtual; abstract; - procedure SetMiterLimit(AValue: single); virtual; abstract; - procedure SetPenStyle(AValue: TPenStyle); virtual; abstract; - procedure SetStrokeMatrix(const AValue: TAffineMatrix); virtual; abstract; - public - function ComputePolyline(const APoints: array of TPointF; AWidth: single; AClosedCap: boolean = true): ArrayOfTPointF; overload; virtual; abstract; - function ComputePolyline(const APoints: array of TPointF; AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean = true): ArrayOfTPointF; overload; virtual; abstract; - function ComputePolylineAutoCycle(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract; - function ComputePolygon(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract; - property Style: TPenStyle read GetPenStyle write SetPenStyle; - property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle; - property Arrow: TBGRACustomArrow read GetArrow write SetArrow; - property ArrowOwned: boolean read GetArrowOwned write SetArrowOwned; - property StrokeMatrix: TAffineMatrix read GetStrokeMatrix write SetStrokeMatrix; - property LineCap: TPenEndCap read GetLineCap write SetLineCap; - property JoinStyle: TPenJoinStyle read GetJoinStyle write SetJoinStyle; - property MiterLimit: single read GetMiterLimit write SetMiterLimit; - end; - -type - {* Point in 3D with single-precision floating point coordinates } - - PPoint3D = ^TPoint3D; - - { TPoint3D } - - TPoint3D = record - x,y,z: single; - procedure Offset(const point3D: TPoint3D); - procedure Scale(AScale: single); - end; - - {----------------- Operators for TPoint3D ---------------} - {** Creates a new structure with values (''x'',''y'',''z'') } - function Point3D(x,y,z: single): TPoint3D; - {** Checks if all components ''x'', ''y'' and ''z'' are equal } - operator = (const v1,v2: TPoint3D): boolean; inline; - {** Adds components separately. It is like adding vectors } - operator + (const v1,v2: TPoint3D): TPoint3D; inline; - {** Subtract components separately. It is like subtracting vectors } - operator - (const v1,v2: TPoint3D): TPoint3D; inline; - {** Returns a point with opposite values for all components } - operator - (const v: TPoint3D): TPoint3D; inline; - {** Scalar product: multiplies components and returns the sum } - operator * (const v1,v2: TPoint3D): single; inline; - {** Multiplies components by ''factor''. It scales the vector represented by (''x'',''y'',''z'') } - operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline; - {** Multiplies components by ''factor''. It scales the vector represented by (''x'',''y'',''z'') } - operator * (const factor: single; const v1: TPoint3D): TPoint3D; inline; - {** Computes the vectorial product ''w''. It is perpendicular to both ''u'' and ''v'' } - procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D); - {** Normalize the vector, i.e. scale it so that its length be 1 } - procedure Normalize3D(var v: TPoint3D); inline; - function VectLen3D(const v: TPoint3D): single; - -type - {* Defition of a line in the euclidian plane } - TLineDef = record - {** Some point in the line } - origin: TPointF; - {** Vector indicating the direction } - dir: TPointF; - end; - - {----------- Line and polygon functions -----------} - {** Computes the intersection of two lines. If they are parallel, returns - the middle of the segment between the two origins } - function IntersectLine(line1, line2: TLineDef): TPointF; overload; - {** Computes the intersection of two lines. If they are parallel, returns - the middle of the segment between the two origins. The value ''parallel'' - is set to indicate if the lines were parallel } - function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF; overload; - {** Checks if the polygon formed by the given points is convex. ''IgnoreAlign'' - specifies that if the points are aligned, it should still be considered as convex } - function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean; - function IsClockwise(const pts: array of TPointF): boolean; - {** Checks if the quad formed by the 4 given points intersects itself } - function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; - {** Checks if two segment intersect } - function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; - -type - TBGRACustomPathCursor = class; - TBGRAPathDrawProc = procedure(const APoints: array of TPointF; AClosed: boolean; AData: Pointer) of object; - TBGRAPathFillProc = procedure(const APoints: array of TPointF; AData: pointer) of object; - - {* A path is the ability to define a contour with ''moveTo'', ''lineTo''... - Even if it is an interface, it must not implement reference counting. } - IBGRAPath = interface - {** Closes the current path with a line to the starting point } - procedure closePath; - {** Moves to a location, disconnected from previous points } - procedure moveTo(constref pt: TPointF); - {** Adds a line from the current point } - procedure lineTo(constref pt: TPointF); - {** Adds a polyline from the current point } - procedure polylineTo(const pts: array of TPointF); - {** Adds a quadratic Bézier curve from the current point } - procedure quadraticCurveTo(constref cp,pt: TPointF); - {** Adds a cubic Bézier curve from the current point } - procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); - {** Adds an arc. If there is a current point, it is connected to the beginning of the arc } - procedure arc(constref arcDef: TArcDef); - {** Adds an opened spline. If there is a current point, it is connected to the beginning of the spline } - procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); - {** Adds an closed spline. If there is a current point, it is connected to the beginning of the spline } - procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); - {** Copy the content of this path to the specified destination } - procedure copyTo(dest: IBGRAPath); - {** Returns the content of the path as an array of points } - function getPoints: ArrayOfTPointF; overload; - {** Returns the content of the path as an array of points with the transformation specified by ''AMatrix'' } - function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload; - {** Calls a given draw procedure for each sub path with computed coordinates for rendering } - procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; - procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; - {** Calls a given fill procedure for each sub path with computed coordinates for rendering } - procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; - procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; - {** Returns a cursor to go through the path. The cursor must be freed by calling ''Free''. } - function getCursor: TBGRACustomPathCursor; - end; - - { TBGRACustomPath } - - TBGRACustomPath = class(IBGRAPath) - constructor Create; virtual; abstract; - procedure beginPath; virtual; abstract; - procedure closePath; virtual; abstract; - procedure moveTo(constref pt: TPointF); virtual; abstract; - procedure lineTo(constref pt: TPointF); virtual; abstract; - procedure polylineTo(const pts: array of TPointF); virtual; abstract; - procedure quadraticCurveTo(constref cp,pt: TPointF); virtual; abstract; - procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); virtual; abstract; - procedure arc(constref arcDef: TArcDef); virtual; abstract; - procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); virtual; abstract; - procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); virtual; abstract; - procedure copyTo(dest: IBGRAPath); virtual; abstract; - protected - function getPoints: ArrayOfTPointF; overload; virtual; abstract; - function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload; virtual; abstract; - procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; virtual; abstract; - procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; virtual; abstract; - procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; virtual; abstract; - procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; virtual; abstract; - function getLength: single; virtual; abstract; - function getCursor: TBGRACustomPathCursor; virtual; abstract; - protected - function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - end; - - TBGRAPathAny = class of TBGRACustomPath; - - { TBGRACustomPathCursor } - {* Class that contains a cursor to browse an existing path } - TBGRACustomPathCursor = class - protected - function GetArcPos: single; virtual; abstract; - function GetCurrentCoord: TPointF; virtual; abstract; - function GetCurrentTangent: TPointF; virtual; abstract; - function GetLoopClosedShapes: boolean; virtual; abstract; - function GetLoopPath: boolean; virtual; abstract; - function GetPathLength: single; virtual; abstract; - function GetBounds: TRectF; virtual; abstract; - function GetStartCoordinate: TPointF; virtual; abstract; - procedure SetArcPos(AValue: single); virtual; abstract; - procedure SetLoopClosedShapes(AValue: boolean); virtual; abstract; - procedure SetLoopPath(AValue: boolean); virtual; abstract; - public - {** Go forward in the path, increasing the value of ''Position''. If ''ADistance'' is negative, then - it goes backward instead. ''ACanJump'' specifies if the cursor can jump from one shape to another - without a line or an arc. Otherwise, the cursor is stuck, and the return value is less than - the value ''ADistance'' provided. If all the way has been travelled, the - return value is equal to ''ADistance'' } - function MoveForward(ADistance: single; ACanJump: boolean = true): single; virtual; abstract; - {** Go backward, decreasing the value of ''Position''. If ''ADistance'' is negative, then it goes - forward instead. ''ACanJump'' specifies if the cursor can jump from one shape to another - without a line or an arc. Otherwise, the cursor is stuck, and the return value is less than - the value ''ADistance'' provided. If all the way has been travelled, the - return value is equal to ''ADistance'' } - function MoveBackward(ADistance: single; ACanJump: boolean = true): single; virtual; abstract; - {** Returns the current coordinate in the path } - property CurrentCoordinate: TPointF read GetCurrentCoord; - {** Returns the tangent vector. It is a vector of length one that is parallel to the curve - at the current point. A normal vector is easily deduced as PointF(y,-x) } - property CurrentTangent: TPointF read GetCurrentTangent; - {** Current position in the path, as a distance along the arc from the starting point of the path } - property Position: single read GetArcPos write SetArcPos; - {** Full arc length of the path } - property PathLength: single read GetPathLength; - {** Starting coordinate of the path } - property StartCoordinate: TPointF read GetStartCoordinate; - {** Specifies if the cursor loops when there is a closed shape } - property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes; - {** Specifies if the cursor loops at the end of the path. Note that if it needs to jump to go - to the beginning, it will be only possible if the parameter ''ACanJump'' is set to True - when moving along the path } - property LoopPath: boolean read GetLoopPath write SetLoopPath; - end; - -var - BGRAPathFactory: TBGRAPathAny; - -const - {* A value for an empty rectangle } - EmptyRect : TRect = (left:0; top:0; right:0; bottom: 0); -{* Checks if a point is in a rectangle. This follows usual convention: ''r.Right'' and - ''r.Bottom'' are not considered to be included in the rectangle. } -function PtInRect(const pt: TPoint; r: TRect): boolean; overload; -{* Creates a rectangle with the specified ''width'' and ''height'' } -function RectWithSize(left,top,width,height: integer): TRect; - -{$DEFINE INCLUDE_INTERFACE} -{$I bezier.inc} - -type - {* Possible options for a round rectangle } - TRoundRectangleOption = ( - {** specify that a corner is a square (not rounded) } - rrTopLeftSquare,rrTopRightSquare,rrBottomRightSquare,rrBottomLeftSquare, - {** specify that a corner is a bevel (cut) } - rrTopLeftBevel,rrTopRightBevel,rrBottomRightBevel,rrBottomLeftBevel, - {** default option, does nothing particular } - rrDefault); - {** A set of options for a round rectangle } - TRoundRectangleOptions = set of TRoundRectangleOption; - {* Order of polygons when rendered using ''TBGRAMultiShapeFiller'' - (in unit ''BGRAPolygon'') } - TPolygonOrder = ( - {** No order, colors are mixed together } - poNone, - {** First polygon is on top } - poFirstOnTop, - {** Last polygon is on top } - poLastOnTop); - - PIntersectionInfo = ^TIntersectionInfo; - { TIntersectionInfo } - {* Contains an intersection between an horizontal line and any shape. It - is used when filling shapes } - TIntersectionInfo = class - interX: single; - winding: integer; - numSegment: integer; - procedure SetValues(AInterX: Single; AWinding, ANumSegment: integer); - end; - {** An array of intersections between an horizontal line and any shape } - ArrayOfTIntersectionInfo = array of TIntersectionInfo; - - {* Abstract class defining any shape that can be filled } - TBGRACustomFillInfo = class - public - {** Returns true if one segment number can represent a curve and - thus cannot be considered exactly straight } - function SegmentsCurved: boolean; virtual; abstract; - - {** Returns integer bounds for the shape } - function GetBounds: TRect; virtual; abstract; - - {** Check if the point is inside the shape } - function IsPointInside(x,y: single; windingMode: boolean): boolean; virtual; abstract; - - {** Create an array that will contain computed intersections. - To augment that array, use ''CreateIntersectionInfo'' for new items } - function CreateIntersectionArray: ArrayOfTIntersectionInfo; virtual; abstract; - {** Create a structure to define one single intersection } - function CreateIntersectionInfo: TIntersectionInfo; virtual; abstract; - {** Free an array of intersections } - procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); virtual; abstract; - - {** Fill an array ''inter'' with actual intersections with the shape at the y coordinate ''cury''. - ''nbInter'' receives the number of computed intersections. ''windingMode'' specifies if - the winding method must be used to determine what is inside of the shape } - procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); virtual; abstract; - - function GetSliceIndex: integer; virtual; abstract; - end; - -type - {* Shape of a gradient } - TGradientType = ( - {** The color changes along a certain vector and does not change along its perpendicular direction } - gtLinear, - {** The color changes like in ''gtLinear'' however it is symmetrical to a specified direction } - gtReflected, - {** The color changes along a diamond shape } - gtDiamond, - {** The color changes in a radial way from a given center } - gtRadial, - {** The color changes according to the angle relative to a given center } - gtAngular); -const - {** List of string to represent gradient types } - GradientTypeStr : array[TGradientType] of string - = ('Linear','Reflected','Diamond','Radial','Angular'); - {** Returns the gradient type represented by the given string } - function StrToGradientType(str: string): TGradientType; - -type - TBGRAGradientGetColorAtFunc = function(position: integer): TBGRAPixel of object; - TBGRAGradientGetColorAtFloatFunc = function(position: single): TBGRAPixel of object; - TBGRAGradientGetExpandedColorAtFunc = function(position: integer): TExpandedPixel of object; - TBGRAGradientGetExpandedColorAtFloatFunc = function(position: single): TExpandedPixel of object; - - { TBGRACustomGradient } - {* Defines a gradient of color, not specifying its shape but only the - series of colors } - TBGRACustomGradient = class - public - {** Returns the color at a given ''position''. The reference range is - from 0 to 65535, however values beyond are possible as well } - function GetColorAt(position: integer): TBGRAPixel; virtual; abstract; - function GetExpandedColorAt(position: integer): TExpandedPixel; virtual; - {** Returns the color at a given ''position''. The reference range is - from 0 to 1, however values beyond are possible as well } - function GetColorAtF(position: single): TBGRAPixel; virtual; - function GetExpandedColorAtF(position: single): TExpandedPixel; virtual; - {** Returns the average color of the gradient } - function GetAverageColor: TBGRAPixel; virtual; abstract; - function GetAverageExpandedColor: TExpandedPixel; virtual; - function GetMonochrome: boolean; virtual; abstract; - {** This property is True if the gradient contains only one color, - and thus is not really a gradient } - property Monochrome: boolean read GetMonochrome; - end; - -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -{$IFDEF BGRA_DEFINE_TRECTHELPER} -{ TRectHelper } - -function TRectHelper.GetHeight: integer; -begin - result := Bottom-Top; -end; - -function TRectHelper.GetIsEmpty: boolean; -begin - result := (Width = 0) and (Height = 0) -end; - -function TRectHelper.GetWidth: integer; -begin - result := Right-Left; -end; - -procedure TRectHelper.SetHeight(AValue: integer); -begin - Bottom := Top+AValue; -end; - -procedure TRectHelper.SetWidth(AValue: integer); -begin - Right := Left+AValue; -end; - -constructor TRectHelper.Create(Origin: TPoint; AWidth, AHeight: Longint); -begin - self.Left := Origin.X; - self.Top := Origin.Y; - self.Right := Origin.X+AWidth; - self.Bottom := Origin.Y+AHeight; -end; - -constructor TRectHelper.Create(ALeft, ATop, ARight, ABottom: Longint); -begin - self.Left := ALeft; - self.Top := ATop; - self.Right := ARight; - self.Bottom := ABottom; -end; - -procedure TRectHelper.Intersect(R: TRect); -begin - self := TRect.Intersect(self, R); -end; - -class function TRectHelper.Intersect(R1: TRect; R2: TRect): TRect; -begin - if R1.Left >= R2.Left then result.Left := R1.Left else result.Left := R2.Left; - if R1.Top >= R2.Top then result.Top := R1.Top else result.Top := R2.Top; - if R1.Right <= R2.Right then result.Right := R1.Right else result.Right := R2.Right; - if R1.Bottom <= R2.Bottom then result.Bottom := R1.Bottom else result.Bottom := R2.Bottom; - if result.IsEmpty then fillchar(result, sizeof(result), 0); -end; - -function TRectHelper.IntersectsWith(R: TRect): Boolean; -begin - Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom); -end; - -class function TRectHelper.Union(R1, R2: TRect): TRect; -begin - if R1.Left <= R2.Left then result.Left := R1.Left else result.Left := R2.Left; - if R1.Top <= R2.Top then result.Top := R1.Top else result.Top := R2.Top; - if R1.Right >= R2.Right then result.Right := R1.Right else result.Right := R2.Right; - if R1.Bottom >= R2.Bottom then result.Bottom := R1.Bottom else result.Bottom := R2.Bottom; - if result.IsEmpty then fillchar(result, sizeof(result), 0); -end; - -procedure TRectHelper.Union(R: TRect); -begin - self := TRect.Union(self, R); -end; - -procedure TRectHelper.Offset(DX, DY: Longint); -begin - Inc(Left, DX); - Inc(Top, DY); - Inc(Right, DX); - Inc(Bottom, DY); -end; - -procedure TRectHelper.Inflate(DX, DY: Longint); -begin - Dec(Left, DX); - Dec(Top, DY); - Inc(Right, DX); - Inc(Bottom, DY); -end; - -function TRectHelper.Contains(const APoint: TPoint): boolean; -begin - result := (APoint.X >= Left) and (APoint.X < Right) and - (APoint.Y >= Top) and (APoint.Y < Bottom); -end; - -function TRectHelper.Contains(const ARect: TRect): boolean; -begin - Result := (Left <= ARect.Left) and (ARect.Right <= Right) and (Top <= ARect.Top) and (ARect.Bottom <= Bottom); -end; - -operator =(const ARect1, ARect2: TRect): boolean; -begin - result:= (ARect1.Left = ARect2.Left) and (ARect1.Top = ARect2.Top) and - (ARect1.Right = ARect2.Right) and (ARect1.Bottom = ARect2.Bottom); -end; -{$ENDIF} - -{$ifdef BGRA_DEFINE_TSIZEHELPER} -{ TSizeHelper } - -function TSizeHelper.GetHeight: integer; -begin - result := cy; -end; - -function TSizeHelper.GetWidth: integer; -begin - result := cx; -end; -{$ENDIF} - -function IsEmptyPoint(const APoint: TPoint): boolean; -begin - result := (APoint.x = -2147483648) or (APoint.y = -2147483648); -end; - -procedure TPointFHelper.Offset(const apt: TPointF); -begin - if isEmptyPointF(self) then exit; - IncF(self.x, apt.x); - IncF(self.y, apt.y); -end; - -procedure TPointFHelper.Offset(const apt: TPoint); -begin - if isEmptyPointF(self) then exit; - IncF(self.x, apt.x); - IncF(self.y, apt.y); -end; - -procedure TPointFHelper.Offset(dx, dy: longint); -begin - if isEmptyPointF(self) then exit; - IncF(self.x, dx); - IncF(self.y, dy); -end; - -procedure TPointFHelper.Offset(dx, dy: single); -begin - if isEmptyPointF(self) then exit; - IncF(self.x, dx); - IncF(self.y, dy); -end; - -procedure TPointFHelper.Scale(AScale: single); -begin - if not isEmptyPointF(self) then - begin - self.x := self.x * AScale; - self.y := self.y * AScale; - end; -end; - -procedure TPointFHelper.Normalize; -var - len: Single; -begin - len := Length; - if len > 0 then self := self*(1/len); -end; - -function TPointFHelper.Ceiling: TPoint; -begin - if isEmptyPointF(self) then - result := EmptyPoint - else - begin - result.x:=ceil(x); - result.y:=ceil(y); - end; -end; - -function TPointFHelper.Truncate: TPoint; -begin - if isEmptyPointF(self) then - result := EmptyPoint - else - begin - result.x:=trunc(x); - result.y:=trunc(y); - end; -end; - -function TPointFHelper.Floor: TPoint; -begin - if isEmptyPointF(self) then - result := EmptyPoint - else - begin - result.x:=Math.floor(x); - result.y:=Math.floor(y); - end; -end; - -function TPointFHelper.Round: TPoint; -begin - if isEmptyPointF(self) then - result := EmptyPoint - else - begin - result.x:=System.round(x); - result.y:=System.round(y); - end; -end; - -function TPointFHelper.Length: Single; -begin - result:= VectLen(self); -end; - -function TPointFHelper.IsEmpty: boolean; -begin - result := isEmptyPointF(self); -end; - -class function TRectFHelper.Intersect(const R1: TRectF; const R2: TRectF): TRectF; -begin - result.left:=max(R1.left,R2.left); - result.top:=max(R1.top,R2.top); - result.right:=min(R1.right,R2.right); - result.bottom:=min(R1.bottom,R2.bottom); - if (result.left >= result.right) or (result.top >= result.bottom) then - result := EmptyRectF; -end; - -class function TRectFHelper.Union(const R1: TRectF; const R2: TRectF): TRectF; -begin - result.left:=min(R1.left,R2.left); - result.top:=min(R1.top,R2.top); - result.right:=max(R1.right,R2.right); - result.bottom:=max(R1.bottom,R2.bottom); -end; - -class function TRectFHelper.Union(const R1: TRectF; const R2: TRectF; ADiscardEmpty: boolean): TRectF; -begin - if ADiscardEmpty and IsEmptyRectF(R1) then result:= R2 else - if ADiscardEmpty and IsEmptyRectF(R2) then result:= R1 else - result := Union(R1,R2); -end; - -function TRectFHelper.Union(const r: TRectF): TRectF; -begin - result := TRectF.Union(self, r); -end; - -function TRectFHelper.Union(const r: TRectF; ADiscardEmpty: boolean): TRectF; -begin - result := TRectF.Union(self, r, ADiscardEmpty); -end; - -procedure TRectFHelper.Include(const APoint: TPointF); -begin - if APoint.x <> EmptySingle then - begin - if APoint.x < Left then Left := APoint.x else - if APoint.x > Right then Right := APoint.x; - end; - if APoint.y <> EmptySingle then - begin - if APoint.y < Top then Top := APoint.y else - if APoint.y > Bottom then Bottom := APoint.y; - end; -end; - -function TRectFHelper.Contains(const APoint: TPointF; - AIncludeBottomRight: boolean): boolean; -begin - if isEmptyPointF(APoint) then result := false else - if (APoint.x < Left) or (APoint.y < Top) then result := false else - if AIncludeBottomRight and ((APoint.x > Right) or (APoint.y > Bottom)) then result := false else - if not AIncludeBottomRight and ((APoint.x >= Right) or (APoint.y >= Bottom)) then result := false - else result := true; -end; - -function TRectFHelper.IntersectsWith(const r: TRectF): boolean; -begin - result:= not TRectF.Intersect(self, r).IsEmpty; -end; - -function TRectFHelper.IsEmpty: boolean; -begin - result:= IsEmptyRectF(self); -end; - -{ TAffineBox } - -function TAffineBox.GetAsPolygon: ArrayOfTPointF; -begin - result := PointsF([TopLeft,TopRight,BottomRight,BottomLeft]); -end; - -function TAffineBox.GetBottomRight: TPointF; -begin - if IsEmpty then - result := EmptyPointF - else - result := TopRight + (BottomLeft-TopLeft); -end; - -function TAffineBox.GetCenter: TPointF; -begin - result := (TopLeft + BottomRight)*0.5; -end; - -function TAffineBox.GetHeight: single; -begin - if isEmptyPointF(TopLeft) or isEmptyPointF(BottomLeft) then - result := 0 - else - result := VectLen(BottomLeft-TopLeft); -end; - -function TAffineBox.GetIsEmpty: boolean; -begin - result := isEmptyPointF(TopRight) or isEmptyPointF(BottomLeft) or isEmptyPointF(TopLeft); -end; - -function TAffineBox.GetRectBounds: TRect; -begin - with GetRectBoundsF do - result := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom)); -end; - -function TAffineBox.GetRectBoundsF: TRectF; -var - x1,y1,x2,y2: single; -begin - x1 := TopLeft.x; x2 := x1; - y1 := TopLeft.y; y2 := y1; - if TopRight.x > x2 then x2 := TopRight.x; - if TopRight.x < x1 then x1 := TopRight.x; - if TopRight.y > y2 then y2 := TopRight.y; - if TopRight.y < y1 then y1 := TopRight.y; - if BottomLeft.x > x2 then x2 := BottomLeft.x; - if BottomLeft.x < x1 then x1 := BottomLeft.x; - if BottomLeft.y > y2 then y2 := BottomLeft.y; - if BottomLeft.y < y1 then y1 := BottomLeft.y; - if BottomRight.x > x2 then x2 := BottomRight.x; - if BottomRight.x < x1 then x1 := BottomRight.x; - if BottomRight.y > y2 then y2 := BottomRight.y; - if BottomRight.y < y1 then y1 := BottomRight.y; - result := RectF(x1,y1,x2,y2); -end; - -function TAffineBox.GetSurface: single; -var - u, v: TPointF; - lenU, lenH: Single; -begin - u := TopRight-TopLeft; - lenU := VectLen(u); - if lenU = 0 then exit(0); - u.Scale(1/lenU); - v := BottomLeft-TopLeft; - lenH := PointF(-u.y,u.x)*v; - result := abs(lenU*lenH); -end; - -function TAffineBox.GetWidth: single; -begin - if isEmptyPointF(TopLeft) or isEmptyPointF(TopRight) then - result := 0 - else - result := VectLen(TopRight-TopLeft); -end; - -class function TAffineBox.EmptyBox: TAffineBox; -begin - result.TopLeft := EmptyPointF; - result.TopRight := EmptyPointF; - result.BottomLeft := EmptyPointF; -end; - -class function TAffineBox.AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox; -begin - result.TopLeft := ATopLeft; - result.TopRight := ATopRight; - result.BottomLeft := ABottomLeft; -end; - -class function TAffineBox.AffineBox(ARectF: TRectF): TAffineBox; -begin - result.TopLeft := ARectF.TopLeft; - result.TopRight := PointF(ARectF.Right, ARectF.Top); - result.BottomLeft := PointF(ARectF.Left, ARectF.Bottom); -end; - -procedure TAffineBox.Offset(AOfsX, AOfsY: single); -begin - TopLeft.Offset(AOfsX,AOfsY); - TopRight.Offset(AOfsX,AOfsY); - BottomLeft.Offset(AOfsX,AOfsY); -end; - -procedure TAffineBox.Offset(AOfs: TPointF); -begin - Offset(AOfs.X,AOfs.Y); -end; - -procedure TAffineBox.Inflate(AHoriz, AVert: single); -var - u, v, ofs_horiz, ofs_vert: TPointF; - lenU, lenV: Single; -begin - u := TopRight-TopLeft; - v := BottomLeft-TopLeft; - lenU := VectLen(u); - if lenU > 0 then u := u*(1/lenU); - lenV := VectLen(v); - if lenV > 0 then v := v*(1/lenV); - ofs_horiz := u*AHoriz; - ofs_vert := v*AVert; - TopLeft := TopLeft - ofs_horiz - ofs_vert; - TopRight := TopRight + ofs_horiz - ofs_vert; - BottomLeft := BottomLeft - ofs_horiz + ofs_vert; -end; - -function TAffineBox.Contains(APoint: TPointF): boolean; -var - u,v,perpU,perpV: TPointF; - posV1, posV2, posU1, posU2: single; -begin - if IsEmpty then exit(false); - - u := TopRight-TopLeft; - perpU := PointF(-u.y,u.x); - v := BottomLeft-TopLeft; - perpV := PointF(v.y,-v.x); - - //reverse normal if not in the same direction as other side - if perpU*v < 0 then - begin - perpU := -perpU; - perpV := -perpV; - end; - - //determine position along normals - posU1 := (APoint-TopLeft)*perpU; - posU2 := (APoint-BottomLeft)*perpU; - posV1 := (APoint-TopLeft)*perpV; - posV2 := (APoint-TopRight)*perpV; - - result := (posU1 >= 0) and (posU2 < 0) and (posV1 >= 0) and (posV2 < 0); -end; - -function StrToGradientType(str: string): TGradientType; -var gt: TGradientType; -begin - result := gtLinear; - str := LowerCase(str); - for gt := low(TGradientType) to high(TGradientType) do - if str = LowerCase(GradientTypeStr[gt]) then - begin - result := gt; - exit; - end; -end; - -{ TBGRACustomGradient } - -function TBGRACustomGradient.GetExpandedColorAt(position: integer - ): TExpandedPixel; -begin - result := GammaExpansion(GetColorAt(position)); -end; - -function TBGRACustomGradient.GetColorAtF(position: single): TBGRAPixel; -begin - if position = EmptySingle then exit(BGRAPixelTransparent); - position := position * 65536; - if position < low(integer) then - result := GetColorAt(low(Integer)) - else if position > high(integer) then - result := GetColorAt(high(Integer)) - else - result := GetColorAt(round(position)); -end; - -function TBGRACustomGradient.GetExpandedColorAtF(position: single): TExpandedPixel; -begin - if position = EmptySingle then exit(BGRAPixelTransparent); - position := position * 65536; - if position < low(integer) then - result := GetExpandedColorAt(low(Integer)) - else if position > high(integer) then - result := GetExpandedColorAt(high(Integer)) - else - result := GetExpandedColorAt(round(position)); -end; - -function TBGRACustomGradient.GetAverageExpandedColor: TExpandedPixel; -begin - result := GammaExpansion(GetAverageColor); -end; - -{ TIntersectionInfo } - -procedure TIntersectionInfo.SetValues(AInterX: Single; AWinding, - ANumSegment: integer); -begin - interX := AInterX; - winding := AWinding; - numSegment := ANumSegment; -end; - -{********************** TRect functions **************************} - -function PtInRect(const pt: TPoint; r: TRect): boolean; -var - temp: integer; -begin - if r.right < r.left then - begin - temp := r.left; - r.left := r.right; - r.Right := temp; - end; - if r.bottom < r.top then - begin - temp := r.top; - r.top := r.bottom; - r.bottom := temp; - end; - Result := (pt.X >= r.left) and (pt.Y >= r.top) and (pt.X < r.right) and - (pt.y < r.bottom); -end; - -function RectWithSize(left, top, width, height: integer): TRect; -begin - result.left := left; - result.top := top; - result.right := left+width; - result.bottom := top+height; -end; - -{ Make a pen style. Need an even number of values. See TBGRAPenStyle } -function BGRAPenStyle(dash1, space1: single; dash2: single; space2: single; - dash3: single; space3: single; dash4: single; space4: single): TBGRAPenStyle; -var - i: Integer; -begin - if dash4 <> 0 then - begin - setlength(result,8); - result[6] := dash4; - result[7] := space4; - result[4] := dash3; - result[5] := space3; - result[2] := dash2; - result[3] := space2; - end else - if dash3 <> 0 then - begin - setlength(result,6); - result[4] := dash3; - result[5] := space3; - result[2] := dash2; - result[3] := space2; - end else - if dash2 <> 0 then - begin - setlength(result,4); - result[2] := dash2; - result[3] := space2; - end else - begin - setlength(result,2); - end; - result[0] := dash1; - result[1] := space1; - for i := 0 to high(result) do - if result[i]=0 then - raise exception.Create('Zero is not a valid value'); -end; - -{ TBGRACustomPath } - -function TBGRACustomPath.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - if GetInterface(iid, obj) then - Result := S_OK - else - Result := longint(E_NOINTERFACE); -end; - -{ There is no automatic reference counting, but it is compulsory to define these functions } -function TBGRACustomPath._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -function TBGRACustomPath._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -function ArcDef(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; - anticlockwise: boolean): TArcDef; -begin - result.center := PointF(cx,cy); - result.radius := PointF(rx,ry); - result.xAngleRadCW:= xAngleRadCW; - result.startAngleRadCW := startAngleRadCW; - result.endAngleRadCW:= endAngleRadCW; - result.anticlockwise:= anticlockwise; -end; - -{----------------- Operators for TPoint3D ---------------} -operator = (const v1, v2: TPoint3D): boolean; inline; -begin - result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z); -end; - -operator * (const v1,v2: TPoint3D): single; inline; -begin - result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z; -end; - -operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline; -begin - result.x := v1.x*factor; - result.y := v1.y*factor; - result.z := v1.z*factor; -end; - -operator - (const v1,v2: TPoint3D): TPoint3D; inline; -begin - result.x := v1.x-v2.x; - result.y := v1.y-v2.y; - result.z := v1.z-v2.z; -end; - -operator -(const v: TPoint3D): TPoint3D; inline; -begin - result.x := -v.x; - result.y := -v.y; - result.z := -v.z; -end; - -operator + (const v1,v2: TPoint3D): TPoint3D; inline; -begin - result.x := v1.x+v2.x; - result.y := v1.y+v2.y; - result.z := v1.z+v2.z; -end; - -operator*(const factor: single; const v1: TPoint3D): TPoint3D; -begin - result.x := v1.x*factor; - result.y := v1.y*factor; - result.z := v1.z*factor; -end; - -{ TPoint3D } - -procedure TPoint3D.Offset(const point3D: TPoint3D); -begin - IncF(self.x, point3d.x); - IncF(self.y, point3d.y); - IncF(self.z, point3d.z); -end; - -procedure TPoint3D.Scale(AScale: single); -begin - self.x := self.x * AScale; - self.y := self.y * AScale; - self.z := self.z * AScale; -end; - -function Point3D(x, y, z: single): TPoint3D; -begin - result.x := x; - result.y := y; - result.z := z; -end; - -procedure Normalize3D(var v: TPoint3D); inline; -var len: double; -begin - len := v*v; - if len = 0 then exit; - len := sqrt(len); - v.x := v.x / len; - v.y := v.y / len; - v.z := v.z / len; -end; - -function VectLen3D(const v: TPoint3D): single; -begin - result := sqrt(v.x*v.x + v.y*v.y + v.z*v.z); -end; - -procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D); -begin - w.x := u.y*v.z-u.z*v.y; - w.y := u.z*v.x-u.x*v.z; - w.z := u.x*v.Y-u.y*v.x; -end; - -{----------------- Operators for TPointF --------------------} -operator =(const pt1, pt2: TPointF): boolean; -begin - result := (pt1.x = pt2.x) and (pt1.y = pt2.y); -end; - -operator -(const pt1, pt2: TPointF): TPointF; -begin - result.x := pt1.x-pt2.x; - result.y := pt1.y-pt2.y; -end; - -operator -(const pt2: TPointF): TPointF; -begin - result.x := -pt2.x; - result.y := -pt2.y; -end; - -operator +(const pt1, pt2: TPointF): TPointF; -begin - result.x := pt1.x+pt2.x; - result.y := pt1.y+pt2.y; -end; - -operator *(const pt1, pt2: TPointF): single; -begin - result := pt1.x*pt2.x + pt1.y*pt2.y; -end; - -operator *(const pt1: TPointF; factor: single): TPointF; -begin - result.x := pt1.x*factor; - result.y := pt1.y*factor; -end; - -operator *(factor: single; const pt1: TPointF): TPointF; -begin - result.x := pt1.x*factor; - result.y := pt1.y*factor; -end; - -function RectF(Left, Top, Right, Bottom: Single): TRectF; -begin - result.Left:= Left; - result.Top:= Top; - result.Right:= Right; - result.Bottom:= Bottom; -end; - -function RectF(const ATopLeft, ABottomRight: TPointF): TRectF; -begin - result.TopLeft:= ATopLeft; - result.BottomRight:= ABottomRight; -end; - -function RectF(const ARect: TRect): TRectF; -begin - result.Left := ARect.Left; - result.Top := ARect.Top; - result.Right := ARect.Right; - result.Bottom := ARect.Bottom; -end; - -function RectWithSizeF(left, top, width, height: Single): TRectF; -begin - result.Left:= Left; - result.Top:= Top; - result.Right:= left+width; - result.Bottom:= top+height; -end; - -function IsEmptyRectF(const ARect: TRectF): boolean; -begin - result:= (ARect.Width = 0) and (ARect.Height = 0); -end; - -function PointF(x, y: single): TPointF; -begin - Result.x := x; - Result.y := y; -end; - -function PointF(pt: TPoint): TPointF; -begin - if IsEmptyPoint(pt) then - result:= EmptyPointF - else - begin - Result.x := pt.x; - Result.y := pt.y; - end; -end; - -function PointsF(const pts: array of TPointF): ArrayOfTPointF; -var - i: Integer; -begin - setlength(result, length(pts)); - for i := 0 to high(pts) do result[i] := pts[i]; -end; - -function ConcatPointsF(const APolylines: array of ArrayOfTPointF; - AInsertEmptyPointInBetween: boolean): ArrayOfTPointF; -var - i,pos,count:integer; - j: Integer; -begin - count := 0; - for i := 0 to high(APolylines) do - inc(count,length(APolylines[i])); - if AInsertEmptyPointInBetween then inc(count, length(APolylines)-1); - setlength(result,count); - pos := 0; - for i := 0 to high(APolylines) do - begin - if AInsertEmptyPointInBetween and (i > 0) then - begin - result[pos] := EmptyPointF; - inc(pos); - end; - for j := 0 to high(APolylines[i]) do - begin - result[pos] := APolylines[i][j]; - inc(pos); - end; - end; -end; - -function VectLen(v: TPointF): single; -begin - if isEmptyPointF(v) then - result := EmptySingle - else - result := sqrt(v*v); -end; - -function VectDet(v1, v2: TPointF): double; -begin - result := v1.x*v2.y - v1.y*v2.x; -end; - -function VectLen(dx, dy: single): single; -begin - result := sqrt(dx*dx+dy*dy); -end; - -function PolylineLen(const pts: array of TPointF; AClosed: boolean): single; -var - i: Int32or64; -begin - result := 0; - for i := 0 to high(pts)-1 do - IncF(result, VectLen(pts[i+1] - pts[i]) ); - if AClosed then - incF(result, VectLen(pts[0] - pts[high(pts)]) ); -end; - -{ Check if a PointF structure is empty or should be treated as a list separator } -function isEmptyPointF(const pt: TPointF): boolean; -begin - Result := (pt.x = EmptySingle) and (pt.y = EmptySingle); -end; - -{----------- Line and polygon functions -----------} -{$PUSH}{$OPTIMIZATION OFF} -function IntersectLine(line1, line2: TLineDef): TPointF; -var parallel: boolean; -begin - result := IntersectLine(line1,line2,parallel); -end; -{$POP} - -function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF; - procedure SetParallel; - begin - parallel := true; - //return the center of the segment between line origins - result.x := (line1.origin.x+line2.origin.x)/2; - result.y := (line1.origin.y+line2.origin.y)/2; - end; -var pos, step: single; - n: TPointF; -begin - parallel := false; - n := PointF(-line2.dir.y, line2.dir.x); - step := line1.dir*n; - if step = 0 then begin SetParallel; exit; end; - pos := (line2.origin - line1.origin)*n; - result := line1.origin + line1.dir * (pos/step); -end; - -{ Check if a polygon is convex, i.e. it always turns in the same direction } -function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean; -var - positive,negative,zero: boolean; - product: single; - i: Integer; -begin - positive := false; - negative := false; - zero := false; - for i := 0 to high(pts) do - begin - product := (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) - - (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x); - if product > 0 then - begin - if negative then - begin - result := false; - exit; - end; - positive := true; - end else - if product < 0 then - begin - if positive then - begin - result := false; - exit; - end; - negative := true; - end else - zero := true; - end; - if not IgnoreAlign and zero then - result := false - else - result := true; -end; - -{ Check if two segments intersect } -function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; -var - seg1: TLineDef; - seg1len: single; - seg2: TLineDef; - seg2len: single; - inter: TPointF; - pos1,pos2: single; - para: boolean; - -begin - { Determine line definitions } - seg1.origin := pt1; - seg1.dir := pt2-pt1; - seg1len := VectLen(seg1.dir); - if seg1len = 0 then - begin - result := false; - exit; - end; - seg1.dir.Scale(1/seg1len); - - seg2.origin := pt3; - seg2.dir := pt4-pt3; - seg2len := VectLen(seg2.dir); - if seg2len = 0 then - begin - result := false; - exit; - end; - seg2.dir.Scale(1/seg2len); - - //obviously parallel - if seg1.dir = seg2.dir then - result := false - else - begin - //try to compute intersection - inter := IntersectLine(seg1,seg2,para); - if para then - result := false - else - begin - //check if intersections are inside the segments - pos1 := (inter-seg1.origin)*seg1.dir; - pos2 := (inter-seg2.origin)*seg2.dir; - if (pos1 >= 0) and (pos1 <= seg1len) and - (pos2 >= 0) and (pos2 <= seg2len) then - result := true - else - result := false; - end; - end; -end; - -function IsClockwise(const pts: array of TPointF): boolean; -var - i: Integer; -begin - for i := 0 to high(pts) do - begin - if (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) - - (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x) < 0 then - begin - result := false; - exit; - end; - end; - result := true; -end; - -{ Check if a quaduadrilateral intersects itself } -function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean; -begin - result := DoesSegmentIntersect(pt1,pt2,pt3,pt4) or DoesSegmentIntersect(pt2,pt3,pt4,pt1); -end; - -{$DEFINE INCLUDE_IMPLEMENTATION} -{$I bezier.inc} - -{$ENDIF} diff --git a/components/bgrabitmap/libwebp.pas b/components/bgrabitmap/libwebp.pas deleted file mode 100644 index c673cd1..0000000 --- a/components/bgrabitmap/libwebp.pas +++ /dev/null @@ -1,649 +0,0 @@ -unit libwebp; - -// Copyright 2010 Google Inc. -// -// This code is licensed under the same terms as WebM: -// Software License Agreement: http://www.webmproject.org/license/software/ -// Additional IP Rights Grant: http://www.webmproject.org/license/additional/ -// -// Delphi API by Henri Gourvest -// ----------------------------------------------------------------------------- -// This is the dynamic loader version of libwebp.pas by fredvs - -{$ALIGN ON} -{$MINENUMSIZE 4} - -interface - -uses - dynlibs; - -var - LibWebPFilename : string = - {$if defined(Win32)} - 'libwebp32.dll' - {$elseif defined(Win64)} - 'libwebp64.dll' - {$elseif defined(Darwin)} - 'libwebp.6.dylib' - {$elseif defined(Unix)} - 'libwebp.so.6' - {$else} - '' - {$endif}; - -//----------------------------------------------------------------------------- - -type -// Output colorspaces - WEBP_CSP_MODE = ( - MODE_RGB = 0, - MODE_RGBA = 1, - MODE_BGR = 2, - MODE_BGRA = 3, - MODE_YUV = 4); - -// Enumeration of the status codes - TVP8StatusCode = ( - VP8_STATUS_OK = 0, - VP8_STATUS_OUT_OF_MEMORY, - VP8_STATUS_INVALID_PARAM, - VP8_STATUS_BITSTREAM_ERROR, - VP8_STATUS_UNSUPPORTED_FEATURE, - VP8_STATUS_SUSPENDED, - VP8_STATUS_USER_ABORT, - VP8_STATUS_NOT_ENOUGH_DATA - ); - - TDecState = ( - STATE_HEADER = 0, - STATE_PARTS0 = 1, - STATE_DATA = 2, - STATE_DONE = 3, - STATE_ERROR = 4); - - // Decoding output parameters. - PWebPDecParams = ^TWebPDecParams; - TWebPDecParams = record - output: PByte; // rgb(a) or luma - u, v: PByte; // chroma u/v - top_y, top_u, top_v: PByte; // cache for the fancy upscaler - stride: Integer; // rgb(a) stride or luma stride - u_stride: Integer; // chroma-u stride - v_stride: Integer; // chroma-v stride - mode: WEBP_CSP_MODE; // rgb(a) or yuv - last_y: Integer; // coordinate of the line that was last output - output_size: Integer; // size of 'output' buffer - output_u_size: Integer; // size of 'u' buffer - output_v_size: Integer; // size of 'v' buffer - external_buffer: Integer; // If true, the output buffers are externally owned - end; - - PWebPIDecoder = ^TWebPIDecoder; - TWebPIDecoder = record - state_: TDecState; // current decoding state - w_, h_: integer; // width and height - params_: TWebPDecParams; // Params to store output info - dec_: Pointer; - end; - - // Input / Output - PVP8Io = ^VP8Io; - VP8Io = record - // set by VP8GetHeaders() - width, height: Integer; // picture dimensions, in pixels - - // set before calling put() - mb_y: Integer; // position of the current rows (in pixels) - mb_h: Integer; // number of rows in the sample - y, u, v: PByte; // rows to copy (in yuv420 format) - y_stride: Integer; // row stride for luma - uv_stride: Integer; // row stride for chroma - - opaque: Pointer; // user data - - // called when fresh samples are available. Currently, samples are in - // YUV420 format, and can be up to width x 24 in size (depending on the - // in-loop filtering level, e.g.). Should return false in case of error - // or abort request. - put: function(const io: PVP8Io): Integer; cdecl; - - // called just before starting to decode the blocks. - // Should returns 0 in case of error. - setup: function(io: PVP8Io): Integer; cdecl; - - // called just after block decoding is finished (or when an error occurred). - teardown: procedure(const io: PVP8Io); cdecl; - - // this is a recommendation for the user-side yuv->rgb converter. This flag - // is set when calling setup() hook and can be overwritten by it. It then - // can be taken into consideration during the put() method. - fancy_upscaling: Integer; - - // Input buffer. - data_size: LongWord; - data: PByte; - - // If true, in-loop filtering will not be performed even if present in the - // bitstream. Switching off filtering may speed up decoding at the expense - // of more visible blocking. Note that output will also be non-compliant - // with the VP8 specifications. - bypass_filtering: Integer; - end; - - // Main decoding object. This is an opaque structure. - PVP8Decoder = ^VP8Decoder; - VP8Decoder = record end; - -//----------------------------------------------------------------------------- -// Coding parameters - - PWebPConfig = ^TWebPConfig; - TWebPConfig = record - quality: Single; // between 0 (smallest file) and 100 (biggest) - target_size: Integer; // if non-zero, set the desired target size in bytes. - // Takes precedence over the 'compression' parameter. - target_PSNR: Single; // if non-zero, specifies the minimal distortion to - // try to achieve. Takes precedence over target_size. - method: Integer; // quality/speed trade-off (0=fast, 6=slower-better) - segments: Integer; // maximum number of segments to use, in [1..4] - sns_strength: Integer; // Spatial Noise Shaping. 0=off, 100=maximum. - filter_strength: Integer; // range: [0 = off .. 100 = strongest] - filter_sharpness: Integer; // range: [0 = off .. 7 = least sharp] - filter_type: Integer; // filtering type: 0 = simple, 1 = strong - // (only used if filter_strength > 0 or autofilter > 0) - autofilter: Integer; // Auto adjust filter's strength [0 = off, 1 = on] - pass: Integer; // number of entropy-analysis passes (in [1..10]). - - show_compressed: Integer; // if true, export the compressed picture back. - // In-loop filtering is not applied. - preprocessing: Integer; // preprocessing filter (0=none, 1=segment-smooth) - partitions: Integer; // log2(number of token partitions) in [0..3] - // Default is set to 0 for easier progressive decoding. - end; - -// Enumerate some predefined settings for WebPConfig, depending on the type -// of source picture. These presets are used when calling WebPConfigPreset(). - TWebPPreset = ( - WEBP_PRESET_DEFAULT = 0, // default preset. - WEBP_PRESET_PICTURE, // digital picture, like portrait, inner shot - WEBP_PRESET_PHOTO, // outdoor photograph, with natural lighting - WEBP_PRESET_DRAWING, // hand or line drawing, with high-contrast details - WEBP_PRESET_ICON, // small-sized colorful images - WEBP_PRESET_TEXT // text-like - ); - - PWebPPicture = ^TWebPPicture; - //TWebPPicture = record end; // main structure for I/O - - // non-essential structure for storing auxilliary statistics - PWebPAuxStats = ^TWebPAuxStats; - TWebPAuxStats = record - PSNR: array[0..3] of Single; // peak-signal-to-noise ratio for Y/U/V/All - coded_size: Integer; // final size - block_count: array[0..2] of Integer; // number of intra4/intra16/skipped macroblocks - header_bytes: array[0..1] of Integer; // approximative number of bytes spent for header - // and mode-partition #0 - residual_bytes: array[0..2, 0..3] of Integer; // approximative number of bytes spent for - // DC/AC/uv coefficients for each (0..3) segments. - segment_size: array[0..3] of Integer; // number of macroblocks in each segments - segment_quant: array[0..3] of Integer; // quantizer values for each segments - segment_level: array[0..3] of Integer; // filtering strength for each segments [0..63] - end; - - // Signature for output function. Should return 1 if writing was successful. - // data/data_size is the segment of data to write, and 'picture' is for - // reference (and so one can make use of picture->custom_ptr). - TWebPWriterFunction = function(const data: PByte; data_size: LongWord; - const picture: PWebPPicture): Integer; cdecl; - - TWebPPicture = record - // input - colorspace: Integer; // colorspace: should be 0 for now (=Y'CbCr). - width, height: Integer; // dimensions. - y, u, v: PByte; // pointers to luma/chroma planes. - y_stride, uv_stride: Integer; // luma/chroma strides. - a: PByte; // pointer to the alpha plane (unused for now). - - // output - writer: TWebPWriterFunction ; // can be NULL - custom_ptr: Pointer; // can be used by the writer. - - // map for extra information - extra_info_type: Integer; // 1: intra type, 2: segment, 3: quant - // 4: intra-16 prediction mode, - // 5: chroma prediction mode, - // 6: bit cost, 7: distortion - extra_info: PByte; // if not NULL, points to an array of size - // ((width + 15) / 16) * ((height + 15) / 16) that - // will be filled with a macroblock map, depending - // on extra_info_type. - - // where to store statistics, if not NULL: - stats: PWebPAuxStats; - end; - - -(****************************************************************************** - decode.h - Main decoding functions for WEBP images. - ******************************************************************************) - // Dynamic load : Vars that will hold our dynamically loaded functions... - - -// *************************** functions ******************************* -var - -// Return the decoder's version number, packed in hexadecimal using 8bits for -// each of major/minor/revision. E.g: v2.5.7 is 0x020507. -WebPGetDecoderVersion: function(): Integer; cdecl; - -// Retrieve basic header information: width, height. -// This function will also validate the header and return 0 in -// case of formatting error. -// Pointers *width/*height can be passed NULL if deemed irrelevant. -WebPGetInfo: function(const data: PByte; data_size: LongWord; - width, height: PInteger): Integer; cdecl; - -// Decodes WEBP images pointed to by *data and returns RGB samples, along -// with the dimensions in *width and *height. -// The returned pointer should be deleted calling free(). -// Returns NULL in case of error. -WebPDecodeRGB: function(const data: PByte; data_size: LongWord; - width, height: PInteger): PByte; cdecl; - -// Same as WebPDecodeRGB, but returning RGBA data. -WebPDecodeRGBA: function(const data: PByte; data_size: LongWord; - width, height: PInteger): PByte; cdecl; - -// This variant decode to BGR instead of RGB. -WebPDecodeBGR: function(const data: PByte; data_size: LongWord; - width, height: PInteger): PByte; cdecl; -// This variant decodes to BGRA instead of RGBA. -WebPDecodeBGRA: function(const data: PByte; data_size: LongWord; - width, height: PInteger): PByte; cdecl; - -// Decode WEBP images stored in *data in Y'UV format(*). The pointer returned is -// the Y samples buffer. Upon return, *u and *v will point to the U and V -// chroma data. These U and V buffers need NOT be free()'d, unlike the returned -// Y luma one. The dimension of the U and V planes are both (*width + 1) / 2 -// and (*height + 1)/ 2. -// Upon return, the Y buffer has a stride returned as '*stride', while U and V -// have a common stride returned as '*uv_stride'. -// Return NULL in case of error. -// (*) Also named Y'CbCr. See: http://en.wikipedia.org/wiki/YCbCr -WebPDecodeYUV: function(const data: PByte; data_size: LongWord; width, height: PInteger; - var u, v: PByte; stride, uv_stride: PInteger): PByte; cdecl; - -// Releases memory returned by the WebPDecode*() functions above. -WebPFree: procedure(const data: PByte); cdecl; - -// These three functions are variants of the above ones, that decode the image -// directly into a pre-allocated buffer 'output_buffer'. The maximum storage -// available in this buffer is indicated by 'output_buffer_size'. If this -// storage is not sufficient (or an error occurred), NULL is returned. -// Otherwise, output_buffer is returned, for convenience. -// The parameter 'output_stride' specifies the distance (in bytes) -// between scanlines. Hence, output_buffer_size is expected to be at least -// output_stride x picture-height. -WebPDecodeRGBInto: function(const data: PByte; data_size: LongWord; - output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; - -WebPDecodeRGBAInto: function(const data: PByte; data_size: LongWord; - output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; - -// BGR variants -WebPDecodeBGRInto: function(const data: PByte; data_size: LongWord; - output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; - -WebPDecodeBGRAInto: function(const data: PByte; data_size: LongWord; - output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; - -// WebPDecodeYUVInto() is a variant of WebPDecodeYUV() that operates directly -// into pre-allocated luma/chroma plane buffers. This function requires the -// strides to be passed: one for the luma plane and one for each of the -// chroma ones. The size of each plane buffer is passed as 'luma_size', -// 'u_size' and 'v_size' respectively. -// Pointer to the luma plane ('*luma') is returned or NULL if an error occurred -// during decoding (or because some buffers were found to be too small). -WebPDecodeYUVInto: function(const data: PByte; data_size: LongWord; - luma: PByte; luma_size, luma_stride: Integer; - u: PByte; u_size, u_stride: Integer; - v: PByte; v_size, v_stride: Integer): PByte; cdecl; - -//----------------------------------------------------------------------------- -// Incremental decoding -// -// This API allows streamlined decoding of partial data. -// Picture can be incrementally decoded as data become available thanks to the -// WebPIDecoder object. This object can be left in a SUSPENDED state if the -// picture is only partially decoded, pending additional input. -// Code example: -// -// WebPIDecoder* const idec = WebPINew(mode); -// while (has_more_data) { -// // ... (get additional data) -// status = WebPIAppend(idec, new_data, new_data_size); -// if (status != VP8_STATUS_SUSPENDED || -// break; -// } -// -// // The above call decodes the current available buffer. -// // Part of the image can now be refreshed by calling to -// // WebPIDecGetRGB()/WebPIDecGetYUV() etc. -// } -// WebPIDelete(idec); - -// Creates a WebPIDecoder object. Returns NULL in case of failure. -WebPINew: function(mode: WEBP_CSP_MODE): PWebPIDecoder; cdecl; - -// This function allocates and initializes an incremental-decoder object, which -// will output the r/g/b(/a) samples specified by 'mode' into a preallocated -// buffer 'output_buffer'. The size of this buffer is at least -// 'output_buffer_size' and the stride (distance in bytes between two scanlines) -// is specified by 'output_stride'. Returns NULL if the allocation failed. -WebPINewRGB: function(mode: WEBP_CSP_MODE; output_buffer: PByte; - output_buffer_size, output_stride: Integer): PWebPIDecoder; cdecl; - -// This function allocates and initializes an incremental-decoder object, which -// will output the raw luma/chroma samples into a preallocated planes. The luma -// plane is specified by its pointer 'luma', its size 'luma_size' and its stride -// 'luma_stride'. Similarly, the chroma-u plane is specified by the 'u', -// 'u_size' and 'u_stride' parameters, and the chroma-v plane by 'v', 'v_size' -// and 'v_size'. -// Returns NULL if the allocation failed. -WebPINewYUV: function(luma: PByte; luma_size, luma_stride: Integer; - u: PByte; u_size, u_stride: Integer; - v: PByte; v_size, v_stride: Integer): PWebPIDecoder; cdecl; - -// Deletes the WebpBuffer object and associated memory. Must always be called -// if WebPINew, WebPINewRGB or WebPINewYUV succeeded. -WebPIDelete: procedure(const idec: PWebPIDecoder); cdecl; - -// Copies and decodes the next available data. Returns VP8_STATUS_OK when -// the image is successfully decoded. Returns VP8_STATUS_SUSPENDED when more -// data is expected. Returns error in other cases. -WebPIAppend: function(const idec: PWebPIDecoder; const data: PByte; - data_size: LongWord): TVP8StatusCode; cdecl; - -// A variant of the above function to be used when data buffer contains -// partial data from the beginning. In this case data buffer is not copied -// to the internal memory. -// Note that the value of the 'data' pointer can change between calls to -// WebPIUpdate, for instance when the data buffer is resized to fit larger data. -WebPIUpdate: function(const idec: PWebPIDecoder; const data: PByte; - data_size: LongWord): TVP8StatusCode; cdecl; - -// Returns the RGB image decoded so far. Returns NULL if output params are not -// initialized yet. *last_y is the index of last decoded row in raster scan -// order. Some pointers (*last_y, *width etc.) can be NULL if corresponding -// information is not needed. -WebPIDecGetRGB: function(const idec: PWebPIDecoder; last_y, width, - height, stride: PInteger): PByte; cdecl; - -// Same as above function to get YUV image. Returns pointer to the luma plane -// or NULL in case of error. -WebPIDecGetYUV: function(const idec: PWebPIDecoder; last_y: PInteger; - var u, v: PByte; width, height, stride, uv_stride: PInteger): PByte; cdecl; - -(****************************************************************************** - WebP encoder: main interface - ******************************************************************************) - -// Return the encoder's version number, packed in hexadecimal using 8bits for -// each of major/minor/revision. E.g: v2.5.7 is 0x020507. -WebPGetEncoderVersion: function(): Integer; cdecl; - -//----------------------------------------------------------------------------- -// One-stop-shop call! No questions asked: - -// Returns the size of the compressed data (pointed to by *output), or 0 if -// an error occurred. The compressed data must be released by the caller -// using the call 'WebPFree(*output)'. -// These functions compress using the lossy format, and the quality_factor -// can go from 0 (smaller output, lower quality) to 100 (best quality, -// larger output). - -WebPEncodeRGB: function(const rgb: PByte; width, height, stride: Integer; - quality_factor: single; var output: PByte): LongWord; cdecl; - -WebPEncodeBGR: function(const bgr: PByte; width, height, stride: Integer; - quality_factor: Single; var output: PByte): LongWord; cdecl; - -WebPEncodeRGBA: function(const rgba: PByte; width, height, stride: Integer; - quality_factor: Single; var output: PByte): LongWord; cdecl; - -WebPEncodeBGRA: function(const bgra: PByte; width, height, stride: Integer; - quality_factor: Single; var output: PByte): LongWord; cdecl; - -// These functions are the equivalent of the above, but compressing in a -// lossless manner. Files are usually larger than lossy format, but will -// not suffer any compression loss. -// Note these functions, like the lossy versions, use the library's default -// settings. For lossless this means 'exact' is disabled. RGB values in -// transparent areas will be modified to improve compression. To avoid this, -// use WebPEncode() and set WebPConfig::exact to 1. - -WebPEncodeLosslessRGB: function(const rgb: PByte; width, height, stride: Integer; - var output: PByte): LongWord; cdecl; - -WebPEncodeLosslessBGR: function(const bgr: PByte; width, height, stride: Integer; - var output: PByte): LongWord; cdecl; - -WebPEncodeLosslessRGBA: function(const rgba: PByte; width, height, stride: Integer; - var output: PByte): LongWord; cdecl; - -WebPEncodeLosslessBGRA: function(const bgra: PByte; width, height, stride: Integer; - var output: PByte): LongWord; cdecl; - -// Should always be called, to initialize a fresh WebPConfig structure before -// modification. Returns 0 in case of version mismatch. WebPConfigInit() must -// have succeeded before using the 'config' object. -function WebPConfigInit(const config: PWebPConfig): Integer; - -// This function will initialize the configuration according to a predefined -// set of parameters (referred to by 'preset') and a given quality factor. -// This function can be called as a replacement to WebPConfigInit(). Will -// return 0 in case of error. -function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; - quality: Single): Integer; - -var -// Returns 1 if all parameters are in valid range and the configuration is OK. -WebPValidateConfig: function(const config: PWebPConfig): Integer; cdecl; - -// Should always be called, to initialize the structure. Returns 0 in case of -// version mismatch. WebPPictureInit() must have succeeded before using the -// 'picture' object. -function WebPPictureInit(const picture: PWebPPicture): Integer; - -//----------------------------------------------------------------------------- -// WebPPicture utils -var -// Convenience allocation / deallocation based on picture->width/height: -// Allocate y/u/v buffers as per width/height specification. -// Note! This function will free the previous buffer if needed. -// Returns 0 in case of memory error. -WebPPictureAlloc: function(const picture: PWebPPicture): Integer; cdecl; - -// Release memory allocated by WebPPictureAlloc() or WebPPictureImport*() -// Note that this function does _not_ free the memory pointed to by 'picture'. -WebPPictureFree: procedure(const picture: PWebPPicture); cdecl; - -// Copy the pixels of *src into *dst, using WebPPictureAlloc. -// Returns 0 in case of memory allocation error. -WebPPictureCopy: function(const src, dst: PWebPPicture): Integer; cdecl; - -// self-crops a picture to the rectangle defined by top/left/width/height. -// Returns 0 in case of memory allocation error, or if the rectangle is -// outside of the source picture. -WebPPictureCrop: function(const picture: PWebPPicture; - left, top, width, height: Integer): Integer; cdecl; - -// Colorspace conversion function. Previous buffer will be free'd, if any. -// *rgb buffer should have a size of at least height * rgb_stride. -// Returns 0 in case of memory error. -WebPPictureImportRGB: function(const picture: PWebPPicture; - const rgb: PByte; rgb_stride: Integer): Integer; cdecl; - -// Same, but for RGBA buffer. Alpha information is ignored. -WebPPictureImportRGBA: function(const picture: PWebPPicture; - const rgba: PByte; rgba_stride: Integer): Integer; cdecl; - -// Variant of the above, but taking BGR input: -WebPPictureImportBGR: function(const picture: PWebPPicture; - const bgr: PByte; bgr_stride: Integer): Integer; cdecl; - -WebPPictureImportBGRA: function(const picture: PWebPPicture; - const bgra: PByte; bgra_stride: Integer): Integer; cdecl; - -//----------------------------------------------------------------------------- -// Main call - -// Main encoding call, after config and picture have been initialiazed. -// 'picture' must be less than 16384x16384 in dimension, and the 'config' object -// must be a valid one. -// Returns false in case of error, true otherwise. -WebPEncode: function(const config: PWebPConfig; const picture: PWebPPicture): Integer; cdecl; - -WebPConfigInitInternal: function(const conf: PWebPConfig; preset: TWebPPreset; - quality: single; version: Integer): Integer; cdecl; - -// Internal, version-checked, entry point -WebPPictureInitInternal: function(const picture: PWebPPicture; version: Integer): Integer; cdecl; -{Special methods for dynamic loading of lib ...} - -var - LibWebPHandle: TLibHandle = dynlibs.NilHandle; // this will hold our handle for the lib; it functions nicely as a mutli-lib prevention unit as well... - LibWebPRefCount : LongWord = 0; // Reference counter - -function LibWebPLoaded : boolean; inline; -Function LibWebPLoad(const libfilename:string = ''): boolean; // load the lib -Procedure LibWebPUnload; // unload and frees the lib from memory : do not forget to call it before close application. - -implementation - -uses sysutils; - -// Internal, version-checked, entry point -const - WEBP_ENCODER_ABI_VERSION = $0001; - -function WebPConfigInit(const config: PWebPConfig): Integer; -begin - Result := WebPConfigInitInternal(config, WEBP_PRESET_DEFAULT, 75.0, WEBP_ENCODER_ABI_VERSION); -end; - -function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; - quality: Single): Integer; -begin - Result := WebPConfigInitInternal(config, preset, quality, WEBP_ENCODER_ABI_VERSION); -end; - -function WebPPictureInit(const picture: PWebPPicture): Integer; -begin - Result := WebPPictureInitInternal(picture, WEBP_ENCODER_ABI_VERSION); -end; - -function LibWebPLoaded: boolean; -begin - Result := (LibWebPHandle <> dynlibs.NilHandle); -end; - -Function LibWebPLoad (const libfilename:string) :boolean; -var - thelib: string; -begin - Result := False; - if LibWebPHandle<>0 then - begin - Inc(LibWebPRefCount); - result:=true {is it already there ?} - end else - begin {go & load the library} - if Length(libfilename) = 0 then - begin - thelib := LibWebPFilename; - if thelib = '' then exit(false); - thelib := ExtractFilePath(ParamStr(0)) + DirectorySeparator + thelib; - end else thelib := libfilename; - LibWebPHandle := DynLibs.SafeLoadLibrary(thelib); // obtain the handle we want - {$IFDEF WINDOWS} - // second try on Windows without 32/64 suffix - if LibWebPHandle = DynLibs.NilHandle then - begin - thelib := ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'libwebp.dll'; - LibWebPHandle := DynLibs.SafeLoadLibrary(thelib); // obtain the handle we want - end; - {$ENDIF} - if LibWebPHandle <> DynLibs.NilHandle then - begin {now we tie the functions to the VARs from above} - -Pointer(WebPGetDecoderVersion):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPGetDecoderVersion')); -Pointer(WebPGetInfo):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPGetInfo')); -Pointer(WebPDecodeRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGB')); -Pointer(WebPDecodeRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGBA')); -Pointer(WebPDecodeBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGR')); -Pointer(WebPDecodeBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGRA')); -Pointer(WebPDecodeYUV):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeYUV')); -Pointer(WebPFree):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPFree')); -Pointer(WebPDecodeRGBInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGBInto')); -Pointer(WebPDecodeRGBAInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeRGBAInto')); -Pointer(WebPDecodeBGRInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGRInto')); -Pointer(WebPDecodeBGRAInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeBGRAInto')); -Pointer(WebPDecodeYUVInto):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPDecodeYUVInto')); -Pointer(WebPINew):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPINew')); -Pointer(WebPINewRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPINewRGB')); -Pointer(WebPINewYUV):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPINewYUV')); -Pointer(WebPIDelete):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIDelete')); -Pointer(WebPIAppend):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIAppend')); -Pointer(WebPIUpdate):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIUpdate')); -Pointer(WebPIDecGetRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIDecGetRGB')); -Pointer(WebPIDecGetYUV):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPIDecGetYUV')); -Pointer(WebPGetEncoderVersion):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPGetEncoderVersion')); -Pointer(WebPEncodeRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeRGB')); -Pointer(WebPEncodeBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeBGR')); -Pointer(WebPEncodeRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeRGBA')); -Pointer(WebPEncodeBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeBGRA')); -Pointer(WebPEncodeLosslessRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessRGB')); -Pointer(WebPEncodeLosslessBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessBGR')); -Pointer(WebPEncodeLosslessRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessRGBA')); -Pointer(WebPEncodeLosslessBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncodeLosslessBGRA')); -//Pointer(WebPConfigInit):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPConfigInit')); -//Pointer(WebPConfigPreset):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPConfigPreset')); -//Pointer(WebPPictureInit):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureInit')); -Pointer(WebPPictureAlloc):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureAlloc')); -Pointer(WebPPictureFree):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureFree')); -Pointer(WebPPictureCopy):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureCopy')); -Pointer(WebPPictureCrop):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureCrop')); -Pointer(WebPPictureImportRGB):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportRGB')); -Pointer(WebPPictureImportRGBA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportRGBA')); -Pointer(WebPPictureImportBGR):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportBGR')); -Pointer(WebPPictureImportBGRA):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureImportBGRA')); -Pointer(WebPEncode):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPEncode')); -Pointer(WebPConfigInitInternal):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPConfigInitInternal')); -Pointer(WebPPictureInitInternal):=DynLibs.GetProcedureAddress(LibWebPHandle,PChar('WebPPictureInitInternal')); - - end; - Result := LibWebPLoaded; - LibWebPRefCount:=1; - end; -end; - -Procedure LibWebPUnload; -begin - // < Reference counting - if LibWebPRefCount > 0 then - dec(LibWebPRefCount); - if LibWebPRefCount > 0 then - exit; - // > - if LibWebPLoaded then - begin - DynLibs.UnloadLibrary(LibWebPHandle); - LibWebPHandle:=DynLibs.NilHandle; - end; -end; - -end. - diff --git a/components/bgrabitmap/lightingclasses3d.inc b/components/bgrabitmap/lightingclasses3d.inc deleted file mode 100644 index 409f223..0000000 --- a/components/bgrabitmap/lightingclasses3d.inc +++ /dev/null @@ -1,174 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -type - { TBGRADirectionalLight3D } - - TBGRADirectionalLight3D = class(TBGRALight3D,IBGRADirectionalLight3D) - protected - FDirection, FBetweenDirectionAndObserver: TPoint3D_128; - public - constructor Create(ADirection: TPoint3D); - function GetDirection: TPoint3D; override; - procedure SetDirection(const AValue: TPoint3D); - - procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); override; - procedure ComputeDiffuseColor(Context: PSceneLightingContext); override; - procedure ComputeDiffuseLightness(Context: PSceneLightingContext); override; - function IsDirectional: boolean; override; - end; - - { TBGRAPointLight3D } - - TBGRAPointLight3D = class(TBGRALight3D,IBGRAPointLight3D) - protected - FVertex: IBGRAVertex3D; - FIntensity: single; - public - constructor Create(AVertex: IBGRAVertex3D; AIntensity: single); - function GetIntensity: single; override; - procedure SetIntensity(const AValue: single); - - function GetVertex: IBGRAVertex3D; - procedure SetVertex(const AValue: IBGRAVertex3D); - function GetPosition: TPoint3D; override; - - procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); override; - procedure ComputeDiffuseLightness(Context: PSceneLightingContext); override; - procedure ComputeDiffuseColor(Context: PSceneLightingContext); override; - function IsDirectional: boolean; override; - end; - -{ TBGRAPointLight3D } - -constructor TBGRAPointLight3D.Create(AVertex: IBGRAVertex3D; AIntensity: single); -begin - inherited Create; - FVertex:= AVertex; - FIntensity := AIntensity; -end; - -function TBGRAPointLight3D.GetIntensity: single; -begin - result := FIntensity; -end; - -procedure TBGRAPointLight3D.SetIntensity(const AValue: single); -begin - FIntensity:= AValue; -end; - -function TBGRAPointLight3D.GetVertex: IBGRAVertex3D; -begin - result := FVertex; -end; - -procedure TBGRAPointLight3D.SetVertex(const AValue: IBGRAVertex3D); -begin - FVertex := AValue; -end; - -function TBGRAPointLight3D.GetPosition: TPoint3D; -begin - Result:= FVertex.GetViewCoord; -end; - -procedure TBGRAPointLight3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); - {$DEFINE PARAM_POINTLIGHT} - {$i phonglight.inc} - -procedure TBGRAPointLight3D.ComputeDiffuseLightness(Context: PSceneLightingContext); -const maxValue = 100*32768; -var - vect: TPoint3D_128; - dist2,intensity: single; -begin - vect := FVertex.ViewCoord_128 - Context^.basic.Position; - dist2 := DotProduct3D_128(vect,vect); - if dist2 = 0 then - TBGRAMaterial3D(Context^.material).ComputeDiffuseLightness(Context,maxValue,FLightness) - else - begin - intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity; - if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; - if intensity > 100 then intensity := 100; - if intensity < FMinIntensity then intensity := FMinIntensity; - TBGRAMaterial3D(Context^.material).ComputeDiffuseLightness(Context,round(intensity*32768),FLightness); - end; -end; - -procedure TBGRAPointLight3D.ComputeDiffuseColor(Context: PSceneLightingContext); -var - vect: TPoint3D_128; - intensity,dist2: single; -begin - vect := FVertex.ViewCoord_128 - Context^.basic.Position; - dist2 := DotProduct3D_128(vect,vect); - if dist2 = 0 then - intensity := 100 - else - begin - intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity; - if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; - if intensity > 100 then intensity := 100; - if intensity < FMinIntensity then intensity := FMinIntensity; - end; - - TBGRAMaterial3D(Context^.material).ComputeDiffuseColor(Context,intensity, FColorInt); -end; - -function TBGRAPointLight3D.IsDirectional: boolean; -begin - result := false; -end; - -{ TBGRADirectionalLight3D } - -constructor TBGRADirectionalLight3D.Create(ADirection: TPoint3D); -begin - inherited Create; - SetDirection(ADirection); -end; - -function TBGRADirectionalLight3D.GetDirection: TPoint3D; -begin - result := Point3D(-FDirection.x,-FDirection.y,-FDirection.z); -end; - -procedure TBGRADirectionalLight3D.SetDirection(const AValue: TPoint3D); -begin - FDirection := -Point3D_128(AValue.x,AValue.y,AValue.z); - Normalize3D_128(FDirection); - FBetweenDirectionAndObserver := FDirection + FViewVector; - Normalize3D_128(FBetweenDirectionAndObserver); -end; - -procedure TBGRADirectionalLight3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); - {$i phonglight.inc} - -procedure TBGRADirectionalLight3D.ComputeDiffuseColor(Context: PSceneLightingContext); -var - intensity: single; -begin - intensity:= DotProduct3D_128(Context^.basic.Normal, FDirection); - if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; - if intensity < FMinIntensity then intensity := FMinIntensity; - - TBGRAMaterial3D(Context^.material).ComputeDiffuseColor(Context,intensity,FColorInt); -end; - -procedure TBGRADirectionalLight3D.ComputeDiffuseLightness( - Context: PSceneLightingContext); -var - intensity: single; -begin - intensity:= DotProduct3D_128(Context^.basic.Normal, FDirection); - if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor; - if intensity < FMinIntensity then intensity := FMinIntensity; - - TBGRAMaterial3D(Context^.material).ComputeDiffuseLightness(Context,round(intensity*32768),FLightness); -end; - -function TBGRADirectionalLight3D.IsDirectional: boolean; -begin - result := true; -end; - diff --git a/components/bgrabitmap/linearrgbabitmap.pas b/components/bgrabitmap/linearrgbabitmap.pas deleted file mode 100644 index 6ce76e3..0000000 --- a/components/bgrabitmap/linearrgbabitmap.pas +++ /dev/null @@ -1,616 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit LinearRGBABitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; - -type - - { TLinearRGBABitmap } - - TLinearRGBABitmap = class(specialize TGenericUniversalBitmap) - protected - function InternalNew: TCustomUniversalBitmap; override; - procedure AssignTransparentPixel(out ADest); override; - public - class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TLinearRGBA; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - end; - -const - LinearRGBATransparent : TLinearRGBA = (red:0; green:0; blue:0; alpha:0); - -operator = (const c1, c2: TLinearRGBA): boolean; inline; - -implementation - -operator = (const c1, c2: TLinearRGBA): boolean; -begin - if (c1.alpha = 0) and (c2.alpha = 0) then - Result := True - else - Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and - (c1.green = c2.green) and (c1.blue = c2.blue); -end; - -procedure LinearRGBASolidBrushSkipPixels({%H-}AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -begin - inc(PLinearRGBA(AContextData^.Dest), ACount); -end; - -procedure LinearRGBAChunkSetPixels( - ASource: PLinearRGBA; ADest: PLinearRGBA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -const oneOver65535 = 1/65535; -var - alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - residualAlpha := ADest^.alpha*(1-alphaOver); - finalAlpha := residualAlpha + ASource^.alpha*alphaOver; - if finalAlpha <= 0 then ADest^ := LinearRGBATransparent else - begin - ADest^.alpha:= finalAlpha; - finalAlphaInv := 1/finalAlpha; - ADest^.red := (ADest^.red*residualAlpha + - ASource^.red*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.green := (ADest^.green*residualAlpha + - ASource^.green*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.blue := (ADest^.blue*residualAlpha + - ASource^.blue*(finalAlpha-residualAlpha) ) * finalAlphaInv; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure LinearRGBASolidBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PLinearRGBA; -begin - pDest := PLinearRGBA(AContextData^.Dest); - LinearRGBAChunkSetPixels( PLinearRGBA(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -procedure LinearRGBAChunkDrawPixels( - ASource: PLinearRGBA; ADest: PLinearRGBA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -const oneOver65535 = 1/65535; -var - alphaOver, srcAlphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; -begin - if AAlpha=0 then exit; - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - srcAlphaOver := ASource^.alpha*alphaOver; - if srcAlphaOver >= 1 then - ADest^ := ASource^ - else - begin - residualAlpha := ADest^.alpha*(1-srcAlphaOver); - finalAlpha := residualAlpha + srcAlphaOver; - if finalAlpha <= 0 then ADest^ := LinearRGBATransparent else - begin - ADest^.alpha:= finalAlpha; - finalAlphaInv := 1/finalAlpha; - ADest^.red := (ADest^.red*residualAlpha + - ASource^.red*srcAlphaOver ) * finalAlphaInv; - ADest^.green := (ADest^.green*residualAlpha + - ASource^.green*srcAlphaOver ) * finalAlphaInv; - ADest^.blue := (ADest^.blue*residualAlpha + - ASource^.blue*srcAlphaOver ) * finalAlphaInv; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; -end; - -procedure LinearRGBASolidBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PLinearRGBA; -begin - pDest := PLinearRGBA(AContextData^.Dest); - LinearRGBAChunkDrawPixels( PLinearRGBA(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -type - PLinearRGBAScannerBrushFixedData = ^TLinearRGBAScannerBrushFixedData; - TLinearRGBAScannerBrushFixedData = record - Scanner: Pointer; //avoid ref count by using pointer type - OffsetX, OffsetY: integer; - Conversion: TBridgedConversion; - end; - -procedure LinearRGBAScannerBrushInitContext(AFixedData: Pointer; - AContextData: PUniBrushContext); -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, - AContextData^.Ofs.Y + OffsetY); -end; - -procedure LinearRGBAScannerConvertBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PLinearRGBA; - qty, pixSize: Integer; - buf: packed array[0..7] of TLinearRGBA; -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TLinearRGBA), nil); - LinearRGBAChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TLinearRGBA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure LinearRGBAScannerChunkBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PLinearRGBA; - qty: Integer; -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - LinearRGBAChunkSetPixels(PLinearRGBA(psrc), pDest, AAlpha, qty, sizeof(TLinearRGBA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure LinearRGBAChunkSetPixelsExceptTransparent( - ASource: PLinearRGBA; ADest: PLinearRGBA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -const oneOver65535 = 1/65535; -var - alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - if ASource^.alpha >= 1 then - ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - if ASource^.alpha >= 1 then - begin - residualAlpha := ADest^.alpha*(1-alphaOver); - finalAlpha := residualAlpha + ASource^.alpha*alphaOver; - if finalAlpha <= 0 then ADest^ := LinearRGBATransparent else - begin - ADest^.alpha:= finalAlpha; - finalAlphaInv := 1/finalAlpha; - ADest^.red := (ADest^.red*residualAlpha + - ASource^.red*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.green := (ADest^.green*residualAlpha + - ASource^.green*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.blue := (ADest^.blue*residualAlpha + - ASource^.blue*(finalAlpha-residualAlpha) ) * finalAlphaInv; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure LinearRGBAScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PLinearRGBA; - qty: Integer; - psrc: Pointer; -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - LinearRGBAChunkSetPixelsExceptTransparent(PLinearRGBA(psrc), pDest, AAlpha, qty, sizeof(TLinearRGBA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure LinearRGBAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PLinearRGBA; - qty, pixSize: Integer; - buf: packed array[0..7] of TLinearRGBA; -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TLinearRGBA), nil); - LinearRGBAChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TLinearRGBA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure LinearRGBAScannerChunkBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - qty: Integer; - pDest: PLinearRGBA; -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - LinearRGBAChunkDrawPixels(PLinearRGBA(psrc), pDest, AAlpha, qty, sizeof(TLinearRGBA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure LinearRGBAScannerConvertBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PLinearRGBA; - qty, pixSize: Integer; - buf: packed array[0..7] of TLinearRGBA; -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TLinearRGBA), nil); - LinearRGBAChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TLinearRGBA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure LinearRGBAMaskBrushApply(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PLinearRGBA; - qty, maskStride: Integer; - pMask: PByteMask; - factor: single; -begin - with PLinearRGBAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - factor := AAlpha/(65535*255); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.alpha := pDest^.alpha*pMask^.gray*factor; - if pDest^.alpha = 0 then pDest^ := LinearRGBATransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - PLinearRGBA(AContextData^.Dest) := pDest; - end; -end; - -procedure LinearRGBAAlphaBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -const oneOver65535 = 1/65535; -var - pDest: PLinearRGBA; - alphaOver, residualAlpha, finalAlpha: single; -begin - if AAlpha=0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - if AAlpha=65535 then - begin - finalAlpha := PSingle(AFixedData)^; - while ACount > 0 do - begin - pDest^.alpha := finalAlpha; - inc(pDest); - dec(ACount); - end; - end else - begin - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - residualAlpha := pDest^.alpha*(1-alphaOver); - finalAlpha := residualAlpha + PSingle(AFixedData)^*alphaOver; - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - end; - PLinearRGBA(AContextData^.Dest) := pDest; -end; - -procedure LinearRGBAAlphaBrushErasePixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -const oneOver65535 = 1/65535; -var - pDest: PLinearRGBA; - alphaMul, finalAlpha: single; -begin - if AAlpha=0 then - begin - inc(PLinearRGBA(AContextData^.Dest), ACount); - exit; - end; - pDest := PLinearRGBA(AContextData^.Dest); - if AAlpha<>65535 then - alphaMul := 1-PSingle(AFixedData)^*AAlpha*single(oneOver65535) - else - alphaMul := 1-PSingle(AFixedData)^; - while ACount > 0 do - begin - finalAlpha := pDest^.alpha*alphaMul; - if finalAlpha <= 0 then pDest^ := LinearRGBATransparent else - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - PLinearRGBA(AContextData^.Dest) := pDest; -end; - -{ TLinearRGBABitmap } - -function TLinearRGBABitmap.InternalNew: TCustomUniversalBitmap; -begin - Result:= TLinearRGBABitmap.Create; -end; - -procedure TLinearRGBABitmap.AssignTransparentPixel(out ADest); -begin - TLinearRGBA(ADest) := LinearRGBATransparent; -end; - -class procedure TLinearRGBABitmap.SolidBrush(out ABrush: TUniversalBrush; - const AColor: TLinearRGBA; ADrawMode: TDrawMode); -begin - ABrush.Colorspace:= TLinearRGBAColorspace; - PLinearRGBA(@ABrush.FixedData)^ := AColor; - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSetPixels; - - dmSetExceptTransparent: - if AColor.alpha < 1 then - ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSkipPixels - else - begin - ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSetPixels; - ABrush.DoesNothing := true; - end; - - dmDrawWithTransparency,dmLinearBlend: - if AColor.alpha<=0 then - begin - ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end - else if AColor.alpha>=1 then - ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushSetPixels - else - ABrush.InternalPutNextPixels:= @LinearRGBASolidBrushDrawPixels; - - dmXor: raise exception.Create('Xor mode not available with floating point values'); - end; -end; - -class procedure TLinearRGBABitmap.ScannerBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; ADrawMode: TDrawMode; - AOffsetX: integer; AOffsetY: integer); -var - sourceSpace: TColorspaceAny; -begin - ABrush.Colorspace:= TLinearRGBAColorspace; - with PLinearRGBAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @LinearRGBAScannerBrushInitContext; - sourceSpace := AScanner.GetScanCustomColorspace; - if sourceSpace = TLinearRGBAColorspace then - begin - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @LinearRGBAScannerChunkBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @LinearRGBAScannerChunkBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @LinearRGBAScannerChunkBrushDrawPixels; - dmXor: raise exception.Create('Xor mode not available with floating point values'); - end; - end else - begin - with PLinearRGBAScannerBrushFixedData(@ABrush.FixedData)^ do - Conversion := sourceSpace.GetBridgedConversion(TLinearRGBAColorspace); - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @LinearRGBAScannerConvertBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @LinearRGBAScannerConvertBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @LinearRGBAScannerConvertBrushDrawPixels; - dmXor: raise exception.Create('Xor mode not available with floating point values'); - end; - end; -end; - -class procedure TLinearRGBABitmap.MaskBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); -begin - ABrush.Colorspace:= TLinearRGBAColorspace; - with PLinearRGBAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @LinearRGBAScannerBrushInitContext; - ABrush.InternalPutNextPixels:= @LinearRGBAMaskBrushApply; -end; - -class procedure TLinearRGBABitmap.EraseBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, LinearRGBATransparent, dmDrawWithTransparency); - exit; - end; - ABrush.Colorspace:= TLinearRGBAColorspace; - PSingle(@ABrush.FixedData)^ := AAlpha/65535; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @LinearRGBAAlphaBrushErasePixels; -end; - -class procedure TLinearRGBABitmap.AlphaBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, LinearRGBATransparent, dmSet); - exit; - end; - ABrush.Colorspace:= TLinearRGBAColorspace; - PSingle(@ABrush.FixedData)^ := AAlpha/65535; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @LinearRGBAAlphaBrushSetPixels; -end; - -end. - diff --git a/components/bgrabitmap/lineartexscan.inc b/components/bgrabitmap/lineartexscan.inc deleted file mode 100644 index 1724212..0000000 --- a/components/bgrabitmap/lineartexscan.inc +++ /dev/null @@ -1,114 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$i bgrasse.inc} - - var - xLen: single; //horizontal length in pixels - t: single; //initial horizontal position in [0..1] - texVect: TPointF; //texture vector between start and end of line - texPos: TPointF; //texture start position - texStep: TPointF; //texture step - intTexPos: packed record - x,y: integer; - end; - - //loop variables - pdest: PBGRAPixel; - i: LongInt; - - {$IFDEF PARAM_USELIGHTING} - light,lightStep,lightDiff,lightAcc,lightMod: word; - lightLen: integer; - - procedure NextLight; inline; - begin - light := (light+lightStep) and 65535; - inc(lightAcc,lightDiff); - if lightAcc >= lightMod then - begin - dec(lightAcc,lightMod); - light := (light + 1) and 65535; - end; - end; - {$ENDIF} - - begin - xLen := info2.interX - info1.interX; - t := ((ix1+0.5)-info1.interX)/xLen; - - texVect := info2.texCoord-info1.texCoord; - texPos := info1.texCoord + texVect*t; - texStep := texVect*(1/xLen); - - pdest := bmp.ScanLine[yb]+ix1; - - {$IFDEF PARAM_USELIGHTING} - if ix2 = ix1 then - begin - light := (info1.lightness+info2.lightness) div 2; - lightStep := 0; - lightDiff := 0; - lightMod := 1; - end - else - begin - light := info1.lightness; - lightLen := info2.lightness-info1.lightness; - if lightLen >= 0 then - begin - lightStep := lightLen div (ix2-ix1); - lightMod := ix2-ix1; - lightDiff := lightLen - lightStep*(ix2-ix1); - end else - begin - lightStep := (-lightLen+(ix2-ix1-1)) div (ix2-ix1); - lightMod := ix2-ix1; - lightDiff := lightLen + lightStep*(ix2-ix1); - lightStep := 65536 - lightStep; - end; - end; - lightAcc := lightDiff div 2; - {$ENDIF} - - {$IFDEF BGRASSE_AVAILABLE} - if UseSSE then - begin - {$DEFINE PARAM_USESSE} - if UseSSE2 then - begin - {$DEFINE PARAM_USESSE2} - if WithInterpolation then - begin - {$DEFINE PARAM_USEINTERPOLATION} - {$i lineartexscan2.inc} - {$UNDEF PARAM_USEINTERPOLATION} - end else - begin - {$i lineartexscan2.inc} - end; - {$UNDEF PARAM_USESSE2} - end else - begin - if WithInterpolation then - begin - {$DEFINE PARAM_USEINTERPOLATION} - {$i lineartexscan2.inc} - {$UNDEF PARAM_USEINTERPOLATION} - end else - begin - {$i lineartexscan2.inc} - end; - end; - {$UNDEF PARAM_USESSE} - end else - {$ENDIF} - if WithInterpolation then - begin - {$DEFINE PARAM_USEINTERPOLATION} - {$i lineartexscan2.inc} - {$UNDEF PARAM_USEINTERPOLATION} - end else - begin - {$i lineartexscan2.inc} - end; - end; -{$undef PARAM_USELIGHTING} diff --git a/components/bgrabitmap/lineartexscan2.inc b/components/bgrabitmap/lineartexscan2.inc deleted file mode 100644 index 0bb7c23..0000000 --- a/components/bgrabitmap/lineartexscan2.inc +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception - {$IFDEF PARAM_USESSE} {$asmmode intel} - asm - xorps xmm4,xmm4 - xorps xmm5,xmm5 - movlps xmm4, texPos - movlps xmm5, texStep - {$IFNDEF PARAM_USEINTERPOLATION} - {$IFDEF PARAM_USESSE2} - cvtps2dq xmm3,xmm4 - movlps intTexPos,xmm3 - {$ENDIF} - {$ENDIF} - end; - {$ENDIF} - - for i := ix1 to ix2 do - begin - DrawPixelInlineWithAlphaCheck(pdest, - {$IFDEF PARAM_USELIGHTING} ApplyLightnessFast( {$ENDIF} - {$IFDEF PARAM_USEINTERPOLATION} - scanAtFunc(texPos.x,texPos.y) - {$ELSE} - {$IFDEF PARAM_USESSE2} - scanAtIntegerFunc(intTexPos.x,intTexPos.y) - {$ELSE} - scanAtIntegerFunc(round(texPos.x),round(texPos.y)) - {$ENDIF} - {$ENDIF} - {$IFDEF PARAM_USELIGHTING} ,light) {$ENDIF} - ); - {$IFDEF PARAM_USESSE} - asm - addps xmm4,xmm5 - {$IFNDEF PARAM_USEINTERPOLATION} - {$IFDEF PARAM_USESSE2} - cvtps2dq xmm3,xmm4 - movlps intTexPos,xmm3 - {$ELSE} - movlps texPos,xmm4 - {$ENDIF} - {$ELSE} - movlps texPos,xmm4 - {$ENDIF} - end; - {$ELSE} - texPos.Offset(texStep); - {$ENDIF} - - {$IFDEF PARAM_USELIGHTING} - NextLight; - {$ENDIF} - inc(pdest); - end; diff --git a/components/bgrabitmap/linuxlib.pas b/components/bgrabitmap/linuxlib.pas deleted file mode 100644 index 623e473..0000000 --- a/components/bgrabitmap/linuxlib.pas +++ /dev/null @@ -1,114 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit linuxlib; - -{$mode objfpc}{$H+} - -{ This unit allows to find the implementation of a library from its - "linker name" whatever its version. Note that between different versions, - there may be incompatibilities (in the signature of the functions or the - record types). So make sure the functions you are calling are stable or - check the version of the library once its loaded using one of its functions. - - - Linker name - ----------- - The linker name normally can only be used when compiling a program. - It ends up with .so and does not have any version number. There isn't - necessarily a file with this name though it may be provided in the - development package (ending with -dev). - - libwebp.so - - libportaudio.so - - libtiff.so - - libpython.so - - - Soname (qualified with a version number) - ---------------------------------------- - The soname can be supplied to the LoadLibray function to load at runtime, - without specifying any path. It is the same as the linker name, but with - a version number. The file exists most of the time and it is generally - a symbolic link to the implementation (or "real name"). - - libwebp.so.6 - - libportaudio.so.2 - - libtiff.so.5 - - libpython2.7.so - - - Implementation or real name (with minor number) - ----------------------------------------------- - The real name contains the implementation. It has a minor number and - an optional release number. Most of the time, you don't need to know this - name to use the library. - - libwebp.so.6.0.2 - - libportaudio.so.2.0.0 - - libtiff.so.5.3.0 - - libpython2.7.so.1.0 - - - See: http://tldp.org/HOWTO/Program-Library-HOWTO/shared-libraries.html } - -interface - -uses - BGRAClasses, SysUtils; - -function FindLinuxLibrary(ALinkerName: string; AMinimumVersion: integer = 0): string; - -implementation - -uses process; - -function FindLinuxLibrary(ALinkerName: string; AMinimumVersion: integer): string; -const - OpenBracket = ' ('; - Arrow = ') => '; -var - dataText, s, fileName, flags, path, versionStr: string; - dataList, flagList: TStringList; - openBracketPos, arrowPos, posDot: SizeInt; - versionInt, errPos, i: integer; - maxVersionInt: integer; -begin - result := ''; - maxVersionInt := AMinimumVersion-1; - RunCommand('ldconfig', ['-p'], dataText, []); - dataList := TStringList.Create; - dataList.Text := dataText; - flagList := TStringList.Create; - for i := 0 to dataList.Count-1 do - begin - s := dataList[i]; - openBracketPos := pos(OpenBracket, s); - arrowPos := pos(Arrow,s); - if (openBracketPos <> 0) and (arrowPos <> 0) then - begin - fileName := trim(copy(s,1,openBracketPos-1)); - if fileName.StartsWith(ALinkerName+'.') then - begin - versionStr := copy(fileName, length(ALinkerName)+2, length(fileName)-length(ALinkerName)-1); - posDot := pos('.', versionStr); - if posDot > 0 then versionStr := copy(versionStr, posDot-1); - val(versionStr, versionInt, errPos); - if errPos = 0 then - begin - flags := copy(s, openBracketPos+length(OpenBracket), arrowPos-openBracketPos-length(OpenBracket)); - flagList.CommaText := flags; - if {$IFNDEF CPU64}not{$ENDIF} (flagList.IndexOf('x86-64') <> -1) then - begin - path := copy(s, arrowPos+length(Arrow), length(s)-arrowPos-length(Arrow)+1); - if versionInt > maxVersionInt then - begin - maxVersionInt := versionInt; - result := path; - end; - end; - end; - end; - end; - end; - flagList.Free; - dataList.Free; -end; - -end. - diff --git a/components/bgrabitmap/multishapeline.inc b/components/bgrabitmap/multishapeline.inc deleted file mode 100644 index 19ac4ef..0000000 --- a/components/bgrabitmap/multishapeline.inc +++ /dev/null @@ -1,65 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception - begin - for k := 0 to NbShapeRows-1 do - with shapeRow[shapeRowsList[k]],shapes[shapeRowsList[k]] do - if densMinx <= densMaxx then - begin - if densMinx < minx then densMinx := minx; - if densMaxx > maxx then densMaxx := maxx; - - if texture <> nil then - begin - texture.ScanMoveTo(densMinx,yb); - ScanNextFunc := @texture.ScanNextPixel; - pdens := density+(densMinX-minx); - for xb := densMinx to densMaxx do - with sums[xb-minx] do - begin - if pdens^ <> 0 then - begin - ec := GammaExpansion(ScanNextFunc()); - {$ifdef PARAM_ANTIALIASINGFACTOR} - w := DivByAntialiasPrecision65536(pdens^ * ec.alpha); - {$else} - w := (pdens^ * ec.alpha) shr 16; - {$endif} - if w <> 0 then - begin - inc(sumR,ec.red*w); - inc(sumG,ec.green*w); - inc(sumB,ec.blue*w); - inc(sumA,w); - end; - end else - ScanNextFunc(); - inc(pdens); - end; - end else - begin - ec := color; - pdens := density+(densMinX-minx); - for xb := densMinx to densMaxx do - with sums[xb-minx] do - begin - if pdens^ <> 0 then - begin - {$ifdef PARAM_ANTIALIASINGFACTOR} - w := DivByAntialiasPrecision65536(pdens^ * ec.alpha); - {$else} - w := (pdens^ * ec.alpha) shr 16; - {$endif} - if w <> 0 then - begin - inc(sumR,ec.red*w); - inc(sumG,ec.green*w); - inc(sumB,ec.blue*w); - inc(sumA,w); - end; - end; - inc(pdens); - end; - end; - end; - - end -{$undef PARAM_ANTIALIASINGFACTOR} diff --git a/components/bgrabitmap/object3d.inc b/components/bgrabitmap/object3d.inc deleted file mode 100644 index 59ed8ad..0000000 --- a/components/bgrabitmap/object3d.inc +++ /dev/null @@ -1,310 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{ TBGRAObject3D } - -procedure TBGRAObject3D.AddFace(AFace: IBGRAFace3D); -begin - if FFaceCount = length(FFaces) then - setlength(FFaces,FFaceCount*2+3); - FFaces[FFaceCount] := AFace; - inc(FFaceCount); -end; - -constructor TBGRAObject3D.Create(AScene: TBGRAScene3D); -begin - FColor := BGRAWhite; - FLight := 1; - FTexture := nil; - FMainPart := TBGRAPart3D.Create(self,nil); - FLightingNormal:= AScene.DefaultLightingNormal; - FParentLighting:= True; - FScene := AScene; - FFaceColorsInvalidated := true; - FMaterialInvalidated := false; -end; - -destructor TBGRAObject3D.Destroy; -begin - FMaterial := nil; - fillchar(FTexture,sizeof(FTexture),0); - inherited Destroy; -end; - -procedure TBGRAObject3D.Clear; -begin - FFaces := nil; - FFaceCount := 0; - FMainPart.Clear(True); -end; - -procedure TBGRAObject3D.InvalidateColor; -begin - FFaceColorsInvalidated := true; -end; - -procedure TBGRAObject3D.InvalidateMaterial; -begin - FMaterialInvalidated := true; -end; - -function TBGRAObject3D.GetColor: TBGRAPixel; -begin - result := FColor; -end; - -function TBGRAObject3D.GetLight: Single; -begin - result := FLight; -end; - -function TBGRAObject3D.GetTexture: IBGRAScanner; -begin - result := FTexture; -end; - -function TBGRAObject3D.GetMainPart: IBGRAPart3D; -begin - result := FMainPart; -end; - -procedure TBGRAObject3D.SetColor(const AValue: TBGRAPixel); -begin - FColor := AValue; - FTexture := nil; - InvalidateColor; -end; - -procedure TBGRAObject3D.SetLight(const AValue: Single); -begin - FLight := AValue; -end; - -procedure TBGRAObject3D.SetTexture(const AValue: IBGRAScanner); -begin - FTexture := AValue; - InvalidateMaterial; -end; - -procedure TBGRAObject3D.SetMaterial(const AValue: IBGRAMaterial3D); -begin - FMaterial := AValue; - InvalidateMaterial; -end; - -procedure TBGRAObject3D.RemoveUnusedVertices; -begin - GetMainPart.RemoveUnusedVertices; -end; - -procedure TBGRAObject3D.SeparatePart(APart: IBGRAPart3D); -var - vertexInfo: array of record - orig,dup: IBGRAVertex3D; - end; - - i,j: integer; - inPart,outPart: boolean; - idxV: integer; -begin - setlength(vertexInfo, APart.VertexCount); - for i := 0 to high(vertexInfo) do - with vertexInfo[i] do - begin - orig := APart.Vertex[i]; - dup := APart.Add(orig.SceneCoord_128); - end; - - for i := 0 to GetFaceCount-1 do - with GetFace(i) do - begin - inPart := false; - outPart := false; - for j := 0 to VertexCount-1 do - if (APart.IndexOf(Vertex[j]) <> -1) then - inPart := true - else - outPart := true; - - if inPart and not outPart then - begin - for j := 0 to VertexCount-1 do - begin - idxV := APart.IndexOf(Vertex[j]); - if idxV <> -1 then - Vertex[j] := vertexInfo[idxV].dup; - end; - end; - end; - - for i := APart.VertexCount-1 downto 0 do - APart.RemoveVertex(i); -end; - -function TBGRAObject3D.GetScene: TObject; -begin - result := FScene; -end; - -function TBGRAObject3D.GetRefCount: integer; -begin - result := RefCount; -end; - -procedure TBGRAObject3D.SetBiface(AValue: boolean); -var i: integer; -begin - for i := 0 to GetFaceCount-1 do - GetFace(i).Biface := AValue; -end; - -procedure TBGRAObject3D.ForEachVertex(ACallback: TVertex3DCallback); -begin - FMainPart.ForEachVertex(ACallback); -end; - -procedure TBGRAObject3D.ForEachFace(ACallback: TFace3DCallback); -var i: integer; -begin - for i := 0 to GetFaceCount-1 do - ACallback(GetFace(i)); -end; - -procedure TBGRAObject3D.Update; -var - i: Integer; -begin - if FParentLighting and (FLightingNormal <> FScene.DefaultLightingNormal) then - FLightingNormal := FScene.DefaultLightingNormal; - - if FFaceColorsInvalidated then - begin - for i := 0 to FFaceCount-1 do - FFaces[i].ComputeVertexColors; - FFaceColorsInvalidated := false; - end; - - if FMaterialInvalidated then - begin - for i := 0 to FFaceCount-1 do - FFaces[i].UpdateMaterial; - FMaterialInvalidated := false; - end; -end; - -function TBGRAObject3D.GetLightingNormal: TLightingNormal3D; -begin - result := FLightingNormal; -end; - -function TBGRAObject3D.GetParentLighting: boolean; -begin - result := FParentLighting; -end; - -procedure TBGRAObject3D.SetLightingNormal(const AValue: TLightingNormal3D); -begin - FLightingNormal := AValue; - FParentLighting:= False; -end; - -procedure TBGRAObject3D.SetParentLighting(const AValue: boolean); -begin - FParentLighting:= AValue; -end; - -procedure TBGRAObject3D.ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D); -var - i: Integer; -begin - FMainPart.ComputeWithMatrix(AMatrix,AProjection); - for i := 0 to FFaceCount-1 do - FFaces[i].ComputeViewNormalAndCenter; - FMainPart.NormalizeViewNormal; -end; - -function TBGRAObject3D.AddFaceReversed(const AVertices: array of IBGRAVertex3D - ): IBGRAFace3D; -var - tempVertices: array of IBGRAVertex3D; - i: Integer; -begin - setlength(tempVertices,length(AVertices)); - for i := 0 to high(tempVertices) do - tempVertices[i] := AVertices[high(AVertices)-i]; - result := AddFace(tempVertices); -end; - -function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; -begin - result := TBGRAFace3D.Create(self,AVertices); - AddFace(result); -end; - -function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; - ABiface: boolean): IBGRAFace3D; -begin - result := TBGRAFace3D.Create(self,AVertices); - result.Biface := ABiface; - AddFace(result); -end; - -function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; -var Face: IBGRAFace3D; -begin - Face := TBGRAFace3D.Create(self,AVertices); - Face.Texture := ATexture; - AddFace(Face); - result := face; -end; - -function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; - AColor: TBGRAPixel): IBGRAFace3D; -var Face: IBGRAFace3D; -begin - Face := TBGRAFace3D.Create(self,AVertices); - Face.SetColor(AColor); - Face.Texture := nil; - AddFace(Face); - result := face; -end; - -function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; - AColors: array of TBGRAPixel): IBGRAFace3D; -var - i: Integer; -begin - if length(AColors) <> length(AVertices) then - raise Exception.Create('Dimension mismatch'); - result := TBGRAFace3D.Create(self,AVertices); - for i := 0 to high(AColors) do - result.VertexColor[i] := AColors[i]; - AddFace(result); -end; - -function TBGRAObject3D.GetFace(AIndex: integer): IBGRAFace3D; -begin - if (AIndex < 0) or (AIndex >= FFaceCount) then - raise Exception.Create('Index out of bounds'); - result := FFaces[AIndex]; -end; - -function TBGRAObject3D.GetFaceCount: integer; -begin - result := FFaceCount; -end; - -function TBGRAObject3D.GetTotalVertexCount: integer; -begin - result := GetMainPart.TotalVertexCount; -end; - -function TBGRAObject3D.GetTotalNormalCount: integer; -begin - result := GetMainPart.TotalNormalCount; -end; - -function TBGRAObject3D.GetMaterial: IBGRAMaterial3D; -begin - result := FMaterial; -end; - - diff --git a/components/bgrabitmap/paletteformats.inc b/components/bgrabitmap/paletteformats.inc deleted file mode 100644 index 5687200..0000000 --- a/components/bgrabitmap/paletteformats.inc +++ /dev/null @@ -1,643 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -var - PaletteFormats : array of record - formatIndex: TBGRAPaletteFormat; - ext: string; - description: string; - reader: TPaletteReaderProc; - writer: TPaletteWriterProc; - checkFormat: TCheckPaletteFormatProc; - end; - -const - GimpPaletteHeader : string = 'GIMP Palette'; - KOfficePaletteHeader : string = 'KDE RGB Palette'; - AdobeSwatchExchangeHeader : string = 'ASEF'; - JascPaletteHeader : string = 'JASC-PAL'; - PaintDotNetPaletteHeader : string = '; paint.net Palette File'; - PaintDotNetPaletteHeaderUTF8 : string = #$EF#$BB#$BF + '; paint.net Palette File'; - -procedure SaveToStreamAsPaintDotNet(APalette: TBGRAPalette; AStream: TStream); - - procedure WriteStr(s: string); - begin - AStream.WriteBuffer(s[1],length(S)); - end; - procedure WriteStrLn(s: string); - begin - WriteStr(s+#$0D#$0A); - end; - -var - i: Integer; - -begin - WriteStrLn(PaintDotNetPaletteHeaderUTF8); - for i := 0 to APalette.Count-1 do - with APalette.Color[i] do - WriteStrLn(IntToHex(alpha,2)+IntToHex(red,2)+IntToHex(green,2)+IntToHex(blue,2)); -end; - -procedure SaveToStreamAsGimp(APalette: TBGRAPalette; AStream: TStream); - procedure WriteStr(s: string); - begin - AStream.WriteBuffer(s[1],length(S)); - end; - procedure WriteStrLn(s: string); - begin - WriteStr(s+#$0A); - end; - - procedure WriteChannelValue(AValue: byte); - var s: string; - begin - s := IntToStr(AValue); - while length(s) < 3 do s := ' '+s; - WriteStr(s); - end; - -var - i: Integer; - -begin - WriteStrLn(GimpPaletteHeader); - WriteStrLn('Name: Palette'); - WriteStrLn('Columns: 3'); - WriteStrLn('#'); - for i := 0 to APalette.Count-1 do - with APalette.Color[i] do - begin - WriteChannelValue(red); - WriteStr(' '); - WriteChannelValue(green); - WriteStr(' '); - WriteChannelValue(blue); - WriteStrLn(#$09+BGRAToStr(APalette.Color[i],CSSColors)); - end; -end; - -procedure SaveToStreamAsAdobeSwatchExchange(APalette: TBGRAPalette; AStream: TStream); - procedure WriteStr(s: string); - begin - AStream.WriteBuffer(s[1],length(S)); - end; - procedure WriteInt32(AValue: Int32); - begin - AValue := NtoBE(AValue); - AStream.WriteBuffer(AValue,sizeof(AValue)); - end; - procedure WriteInt16(AValue: Int16); - begin - AValue := NtoBE(AValue); - AStream.WriteBuffer(AValue,sizeof(AValue)); - end; - procedure WriteSingle(AValue: Single); - begin - LongWord(AValue) := BEtoN(LongWord(AValue)); - AStream.WriteBuffer(AValue,sizeof(AValue)); - end; - procedure WriteBlock(ABlockType: Int16; AContentLength: Int32); overload; - begin - WriteInt16(ABlockType); - WriteInt32(AContentLength); - end; - - procedure WriteBlock(ABlockType: Int16; AName: string; AExtraContentLength: Int32); overload; - var contentLength: Int32; - wideName: UnicodeString; - nameBuf: array of byte; - i: Integer; - begin - wideName := UTF8Decode(AName); - setlength(nameBuf, (length(wideName)+1)*2); - contentLength:= AExtraContentLength + 2 + length(nameBuf); - WriteBlock(ABlockType, contentLength); - WriteInt16(length(nameBuf) shr 1); - for i := 1 to length(wideName) do - begin - nameBuf[((i-1) shl 1)] := ord(wideName[i]) shr 8; - nameBuf[((i-1) shl 1)+1] := ord(wideName[i]) and 255; - end; - AStream.WriteBuffer(nameBuf[0],length(namebuf)); - end; - -var - i: Integer; - -begin - WriteStr(AdobeSwatchExchangeHeader+#$00#$01+#$00#$00); - WriteInt32(APalette.Count+2); //number of blocks - WriteBlock($1c0, 'Palette', 0); //group start - for i := 0 to APalette.Count-1 do - with APalette.Color[i] do - begin - WriteBlock(1, BGRAToStr(APalette.Color[i],CSSColors), 4+4*3+2); - WriteStr('RGB '); - WriteSingle(red/255); - WriteSingle(green/255); - WriteSingle(blue/255); - WriteInt16(2); //normal - end; - WriteBlock($2c0, 0); //group end -end; - -procedure SaveToStreamAsKOffice(APalette: TBGRAPalette; AStream: TStream); - procedure WriteStr(s: string); - begin - AStream.WriteBuffer(s[1],length(S)); - end; - procedure WriteStrLn(s: string); - begin - WriteStr(s+#$0A); - end; - - procedure WriteChannelValue(AValue: byte); - begin - WriteStr(IntToStr(AValue)); - end; - -var - i: Integer; - -begin - WriteStrLn(KOfficePaletteHeader); - for i := 0 to APalette.Count-1 do - with APalette.Color[i] do - begin - WriteChannelValue(red); - WriteStr(' '); - WriteChannelValue(green); - WriteStr(' '); - WriteChannelValue(blue); - WriteStrLn(#$09+BGRAToStr(APalette.Color[i],CSSColors)); - end; -end; - -procedure SaveToStreamAsJasc(APalette: TBGRAPalette; AStream: TStream); - procedure WriteStr(s: string); - begin - AStream.WriteBuffer(s[1],length(S)); - end; - procedure WriteStrLn(s: string); - begin - WriteStr(s+#$0D#$0A); - end; - -var - i: Integer; - -begin - WriteStrLn(JascPaletteHeader); - WriteStrLn('0100'); - WriteStrLn(IntToStr(APalette.Count)); - for i := 0 to APalette.Count-1 do - with APalette.Color[i] do - WriteStrLn(IntToStr(red)+' '+IntToStr(green)+' '+IntToStr(blue)); -end; - -function LoadFromStreamAsPaintDotNet(APalette: TBGRAPalette; AStream: TStream): boolean; -var lines: TStringList; - header,s: string; - idxComment: integer; - code: integer; - hexArgb: int32; - i: Integer; -begin - result := false; - lines := TStringList.Create; - try - lines.LoadFromStream(AStream); - if lines.Count = 0 then - begin - lines.Free; - exit; - end; - header := lines[0]; - if (header <> PaintDotNetPaletteHeader) and (header <> PaintDotNetPaletteHeaderUTF8) then - begin - lines.Free; - exit; - end; - - for i := 0 to lines.Count-1 do - begin - s := lines[i]; - idxComment := pos(';',s); - if idxComment<>0 then s := copy(s,1,idxComment-1); - s := trim(s); - if length(s)> 0 then - begin - val('$'+s, hexArgb, code); - if code = 0 then - APalette.AddColor(BGRA((hexArgb shr 16) and 255, - (hexArgb shr 8) and 255, - hexArgb and 255, - (hexArgb shr 24) and 255)); - end; - end; - result := true; - finally - lines.Free; - end; -end; - -function LoadFromStreamAsGimp(APalette: TBGRAPalette; AStream: TStream): boolean; -var lines,line: TStringList; - s: string; - idxComment: integer; - code: integer; - c: TBGRAPixel; - i: Integer; -begin - result := false; - lines := TStringList.Create; - line := TStringList.Create; - try - lines.LoadFromStream(AStream); - if (lines.Count < 3) or (lines[0] <> GimpPaletteHeader) or - (copy(lines[1],1,6) <> 'Name: ') or - (copy(lines[2],1,9) <> 'Columns: ') then - begin - lines.Free; - line.Free; - exit; - end; - for i := 3 to lines.Count-1 do - begin - s := lines[i]; - idxComment := pos('#',s); - if idxComment<>0 then s := copy(s,1,idxComment-1); - s := trim(s); - if length(s)> 0 then - begin - line.CommaText := s; - if line.Count >= 3 then - begin - c.alpha:= 255; - val(line[0],c.red,code); - if code <> 0 then continue; - val(line[1],c.green,code); - if code <> 0 then continue; - val(line[2],c.blue,code); - if code <> 0 then continue; - APalette.AddColor(c); - end; - end; - end; - result := true; - finally - lines.Free; - line.Free; - end; -end; - -function clamp(AValue, AMax: integer): integer; -begin - if AValue < 0 then result := 0 else - if AValue > AMax then result := AMax else - result := AValue;; -end; - -function LabToRGB(L,a,b: single): TBGRAPixel; overload; -var r,g,blue: single; -begin - if a < 0 then - r := L + a + 0.5*b - else - r := L + 0.75*a + 0.5*b; - g := L - 0.5*a; - blue := L - b; - Result.red:= clamp(round((r)*255),255); - Result.green:= clamp(round((g)*255),255); - Result.blue:= clamp(round((blue)*255),255); - result.alpha := 255; -end; - -function LoadFromStreamAsAdobeSwatchExchange(APalette: TBGRAPalette; AStream: TStream): boolean; - function ReadInt16: int16; - begin - {$PUSH}{$HINTS OFF} - AStream.Read(result, sizeof(result)); - {$POP} - result := BEtoN(result); - end; - function ReadInt32: int32; - begin - {$PUSH}{$HINTS OFF} - AStream.Read(result, sizeof(result)); - {$POP} - result := BEtoN(result); - end; - function ReadStr(ALength: integer): string; - begin - setlength(result, ALength); - ALength := AStream.Read(result[1], ALength); - setlength(result, ALength); - end; - function ReadSingle: single; - begin - {$PUSH}{$HINTS OFF} - AStream.Read(Result, sizeof(result)); - {$POP} - LongWord(Result) := BEtoN(LongWord(Result)); - end; - function DblToByte(AValue: double): byte; - begin - if AValue < 0 then result := 0 - else if AValue > 1 then result := 255 else - result := round(AValue*255); - end; - -var header: string; - nbBlocks,blockSize: int32; - blockType,nameLength: int16; - nextPos: int64; - colorFormat: string; - colorF: TColorF; - i: Integer; -begin - result := false; - header := ReadStr(length(AdobeSwatchExchangeHeader)+4); - if header <> AdobeSwatchExchangeHeader+#$00#$01+#$00#$00 then exit; - nbBlocks := ReadInt32; - for i := 0 to nbBlocks-1 do - begin - blockType := ReadInt16; - blockSize := ReadInt32; - nextPos := AStream.Position + blockSize; - if blockType = 1 then - begin - nameLength := ReadInt16; - ReadStr(nameLength*2); - colorFormat := ReadStr(4); - if colorFormat = 'RGB ' then - begin - colorF[1] := ReadSingle; - colorF[2] := ReadSingle; - colorF[3] := ReadSingle; - colorF[4] := 1; - APalette.AddColor(BGRA(DblToByte(colorF[1]),DblToByte(colorF[2]),DblToByte(colorF[3]))); - ReadInt16; //ignore color type - end else - if colorFormat = 'CMYK' then - begin - colorF[1] := ReadSingle; - colorF[2] := ReadSingle; - colorF[3] := ReadSingle; - colorF[4] := ReadSingle; - - APalette.AddColor(BGRA(DblToByte(1 - colorF[1] + ColorF[2]/10 + ColorF[3]/10 - ColorF[4]), - DblToByte(1 - colorF[2] + ColorF[1]/10 + ColorF[3]/10 - ColorF[4]), - DblToByte(1 - colorF[3] + ColorF[1]/10 + ColorF[2]/10 - ColorF[4]))); - ReadInt16; //ignore color type - end else - if colorFormat = 'LAB ' then - begin - colorF[1] := ReadSingle; - colorF[2] := ReadSingle; - colorF[3] := ReadSingle; - colorF[4] := 1; - - APalette.AddColor(LabToRGB(colorF[1],colorF[2]/128,colorF[3]/128)); - ReadInt16; //ignore color type - end else - if colorFormat = 'GRAY' then - begin - colorF[1] := ReadSingle; - colorF[2] := colorF[1]; - colorF[3] := colorF[1]; - colorF[4] := 1; - APalette.AddColor(BGRA(DblToByte(colorF[1]),DblToByte(colorF[2]),DblToByte(colorF[3]))); - ReadInt16; //ignore color type - end; - end; - if AStream.Position<>nextPos then - AStream.Position:= nextPos; - end; - result := true; -end; - -function LoadFromStreamAsKOffice(APalette: TBGRAPalette; AStream: TStream): boolean; -var lines,line: TStringList; - s: string; - idxComment: integer; - code: integer; - c: TBGRAPixel; - i: Integer; -begin - result := false; - lines := TStringList.Create; - line := TStringList.Create; - try - lines.LoadFromStream(AStream); - if (lines.Count < 1) or (lines[0] <> KOfficePaletteHeader) then - begin - lines.Free; - line.Free; - exit; - end; - for i := 3 to lines.Count-1 do - begin - s := lines[i]; - idxComment := pos('#',s); - if idxComment<>0 then s := copy(s,1,idxComment-1); - s := trim(s); - if length(s)> 0 then - begin - line.CommaText := s; - if line.Count >= 3 then - begin - c.alpha:= 255; - val(line[0],c.red,code); - if code <> 0 then continue; - val(line[1],c.green,code); - if code <> 0 then continue; - val(line[2],c.blue,code); - if code <> 0 then continue; - APalette.AddColor(c); - end; - end; - end; - result := true; - finally - lines.Free; - line.Free; - end; -end; - -function LoadFromStreamAsJasc(APalette: TBGRAPalette; AStream: TStream): boolean; -var lines,line: TStringList; - s: string; - idxComment: integer; - code: integer; - c: TBGRAPixel; - i: Integer; -begin - result := false; - lines := TStringList.Create; - line := TStringList.Create; - try - lines.LoadFromStream(AStream); - if (lines.Count < 2) or (lines[0] <> JascPaletteHeader) or - (lines[1] <> '0100') then - begin - lines.Free; - line.Free; - exit; - end; - for i := 2 to lines.Count-1 do - begin - s := lines[i]; - idxComment := pos('#',s); - if idxComment<>0 then s := copy(s,1,idxComment-1); - s := trim(s); - if length(s)> 0 then - begin - line.CommaText := s; - if line.Count >= 3 then - begin - c.alpha:= 255; - val(line[0],c.red,code); - if code <> 0 then continue; - val(line[1],c.green,code); - if code <> 0 then continue; - val(line[2],c.blue,code); - if code <> 0 then continue; - APalette.AddColor(c); - end; - end; - end; - result := true; - finally - lines.Free; - line.Free; - end; -end; - -function CheckPaletteFormatAsJasc(ABuf256: string): boolean; -begin - result := (copy(ABuf256,1,length(JascPaletteHeader)+1) = JascPaletteHeader+#$0A) or - (copy(ABuf256,1,length(JascPaletteHeader)+2) = JascPaletteHeader+#$0D#$0A); -end; - -function CheckPaletteFormatAsGimp(ABuf256: string): boolean; -begin - result := (copy(ABuf256,1,length(GimpPaletteHeader)+1) = GimpPaletteHeader+#$0A) or - (copy(ABuf256,1,length(GimpPaletteHeader)+2) = GimpPaletteHeader+#$0D#$0A); -end; - -function CheckPaletteFormatAsKOffice(ABuf256: string): boolean; -begin - result := (copy(ABuf256,1,length(KOfficePaletteHeader)+1) = KOfficePaletteHeader+#$0A) or - (copy(ABuf256,1,length(KOfficePaletteHeader)+2) = KOfficePaletteHeader+#$0D#$0A); -end; - -function CheckPaletteFormatAsPaintDotNet(ABuf256: string): boolean; -begin - result := (copy(ABuf256,1,length(PaintDotNetPaletteHeader)+1) = PaintDotNetPaletteHeader+#$0A) or - (copy(ABuf256,1,length(PaintDotNetPaletteHeader)+2) = PaintDotNetPaletteHeader+#$0D#$0A) or - (copy(ABuf256,1,length(PaintDotNetPaletteHeaderUTF8)+1) = PaintDotNetPaletteHeaderUTF8+#$0A) or - (copy(ABuf256,1,length(PaintDotNetPaletteHeaderUTF8)+2) = PaintDotNetPaletteHeaderUTF8+#$0D#$0A); -end; - -function CheckPaletteFormatAsAdobeSwatchExchange(ABuf256: string): boolean; -begin - result := copy(ABuf256,1,length(AdobeSwatchExchangeHeader)) = AdobeSwatchExchangeHeader; -end; - - -procedure RegisterDefaultPaletteFormats; forward; - -procedure BGRARegisterPaletteFormat(AFormatIndex: TBGRAPaletteFormat; AExtension: string; - ADescription: string; AReadProc: TPaletteReaderProc; AWriteProc: TPaletteWriterProc; - ACheckFormatProc: TCheckPaletteFormatProc); -var - i: Integer; -begin - RegisterDefaultPaletteFormats; - if AFormatIndex = palUnknown then - raise Exception.Create('Invalid format index'); - for i := 0 to high(PaletteFormats) do - if PaletteFormats[i].formatIndex = AFormatIndex then - with PaletteFormats[i] do - begin - ext := AExtension; - description := ADescription; - reader := AReadProc; - writer := AWriteProc; - checkFormat := ACheckFormatProc; - exit; - end; - setlength(PaletteFormats,length(PaletteFormats)+1); - with PaletteFormats[high(PaletteFormats)] do - begin - formatIndex:= AFormatIndex; - ext := AExtension; - description := ADescription; - reader := AReadProc; - writer := AWriteProc; - checkFormat := ACheckFormatProc; - end; -end; - -function BGRARegisteredPaletteFormatFilter(AAllSupportedDescription: string): string; -var allExt: TStringList; - allDesc: string; - i: Integer; -begin - result := ''; - RegisterDefaultPaletteFormats; - allExt := TStringList.Create; - allExt.CaseSensitive := false; - for i := 0 to high(PaletteFormats) do - with PaletteFormats[i] do - begin - if allExt.IndexOf(ext) = -1 then allExt.Add(ext); - if length(result)>0 then AppendStr(result, '|'); - AppendStr(result, description + ' (*'+ext+')|*'+ext); - end; - if allExt.Count > 0 then - begin - allDesc := AAllSupportedDescription + ' ('; - for i := 0 to allExt.count-1 do - begin - if i > 0 then - AppendStr(allDesc, '; '); - AppendStr(allDesc, '*' + allExt[i]); - end; - AppendStr(allDesc, ')'); - AppendStr(allDesc, '|'); - for i := 0 to allExt.count-1 do - begin - if i > 0 then - AppendStr(allDesc, '; '); - AppendStr(allDesc, '*' + allExt[i]); - end; - result := allDesc + '|' + result; - end; - allExt.Free; -end; - -var DefaultPaletteFormatsRegistered: boolean; - -procedure RegisterDefaultPaletteFormats; -begin - if DefaultPaletteFormatsRegistered then exit; - DefaultPaletteFormatsRegistered := true; - BGRARegisterPaletteFormat(palPaintDotNet, '.txt', 'Paint.NET', - @LoadFromStreamAsPaintDotNet, @SaveToStreamAsPaintDotNet, - @CheckPaletteFormatAsPaintDotNet); - BGRARegisterPaletteFormat(palGimp, '.gpl', 'GIMP', - @LoadFromStreamAsGimp, @SaveToStreamAsGimp, - @CheckPaletteFormatAsGimp); - BGRARegisterPaletteFormat(palAdobeSwatchExchange, '.ase', 'Adobe Swatch Exchange', - @LoadFromStreamAsAdobeSwatchExchange, @SaveToStreamAsAdobeSwatchExchange, - @CheckPaletteFormatAsAdobeSwatchExchange); - BGRARegisterPaletteFormat(palKOffice, '.colors', 'KOffice', - @LoadFromStreamAsKOffice, @SaveToStreamAsKOffice, - @CheckPaletteFormatAsKOffice); - BGRARegisterPaletteFormat(palJascPSP, '.pal', 'Jasc Paint Shop Pro', - @LoadFromStreamAsJasc, @SaveToStreamAsJasc, - @CheckPaletteFormatAsJasc); -end; - diff --git a/components/bgrabitmap/part3d.inc b/components/bgrabitmap/part3d.inc deleted file mode 100644 index 755d435..0000000 --- a/components/bgrabitmap/part3d.inc +++ /dev/null @@ -1,581 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -type - { TBGRAPart3D } - - TBGRAPart3D = class(TInterfacedObject,IBGRAPart3D) - private - FVertices: array of IBGRAVertex3D; - FVertexCount: integer; - FNormals: array of IBGRANormal3D; - FNormalCount: integer; - FMatrix: TMatrix3D; - FParts: array of IBGRAPart3D; - FPartCount: integer; - FContainer: IBGRAPart3D; - FCoordPool: TBGRACoordPool3D; - FNormalPool: TBGRANormalPool3D; - FObject3D: TBGRAObject3D; - public - constructor Create(AObject3D: TBGRAObject3D; AContainer: IBGRAPart3D); - destructor Destroy; override; - procedure Clear(ARecursive: boolean); - function Add(x,y,z: single): IBGRAVertex3D; overload; - function Add(pt: TPoint3D): IBGRAVertex3D; overload; - function Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; overload; - function Add(pt: TPoint3D_128): IBGRAVertex3D; overload; - function Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; overload; - function Add(const coords: array of single): arrayOfIBGRAVertex3D; overload; - function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; overload; - function Add(const pts: array of TPoint3D_128): arrayOfIBGRAVertex3D; overload; - procedure Add(const pts: array of IBGRAVertex3D); overload; - procedure Add(AVertex: IBGRAVertex3D); overload; - function AddNormal(x,y,z: single): IBGRANormal3D; overload; - function AddNormal(pt: TPoint3D): IBGRANormal3D; overload; - function AddNormal(pt: TPoint3D_128): IBGRANormal3D; overload; - procedure AddNormal(ANormal: IBGRANormal3D); overload; - procedure RemoveVertex(Index: integer); - procedure RemoveNormal(Index: integer); - function GetBoundingBox: TBox3D; - function GetRadius: single; - function GetMatrix: TMatrix3D; - function GetPart(AIndex: Integer): IBGRAPart3D; - function GetPartCount: integer; - function GetVertex(AIndex: Integer): IBGRAVertex3D; - function GetVertexCount: integer; - function GetNormal(AIndex: Integer): IBGRANormal3D; - function GetNormalCount: integer; - function GetTotalVertexCount: integer; - function GetTotalNormalCount: integer; - function GetContainer: IBGRAPart3D; - procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); - procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D); - procedure ResetTransform; - procedure Translate(x,y,z: single; Before: boolean = true); overload; - procedure Translate(ofs: TPoint3D; Before: boolean = true); overload; - procedure Scale(size: single; Before: boolean = true); overload; - procedure Scale(x,y,z: single; Before: boolean = true); overload; - procedure Scale(size: TPoint3D; Before: boolean = true); overload; - procedure RotateXDeg(angle: single; Before: boolean = true); - procedure RotateYDeg(angle: single; Before: boolean = true); - procedure RotateZDeg(angle: single; Before: boolean = true); - procedure RotateXRad(angle: single; Before: boolean = true); - procedure RotateYRad(angle: single; Before: boolean = true); - procedure RotateZRad(angle: single; Before: boolean = true); - procedure SetMatrix(const AValue: TMatrix3D); - procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); - function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF; - procedure NormalizeViewNormal; - function CreatePart: IBGRAPart3D; - procedure LookAt(ALookWhere,ATopDir: TPoint3D); - procedure RemoveUnusedVertices; - function IndexOf(AVertex: IBGRAVertex3D): integer; - procedure ForEachVertex(ACallback: TVertex3DCallback); - end; - -{ TBGRAPart3D } - -procedure TBGRAPart3D.LookAt(ALookWhere,ATopDir: TPoint3D); -var ZDir, XDir, YDir: TPoint3D_128; - ViewPoint: TPoint3D_128; - CurPart: IBGRAPart3D; - ComposedMatrix: TMatrix3D; -begin - YDir := -Point3D_128(ATopDir); - if IsPoint3D_128_Zero(YDir) then exit; - Normalize3D_128(YDir); - - ComposedMatrix := FMatrix; - CurPart := self.FContainer; - while CurPart <> nil do - begin - ComposedMatrix := CurPart.Matrix*ComposedMatrix; - CurPart := CurPart.Container; - end; - ViewPoint := ComposedMatrix*Point3D_128_Zero; - - ZDir := Point3D_128(ALookWhere)-ViewPoint; - if IsPoint3D_128_Zero(ZDir) then exit; - Normalize3D_128(ZDir); - - VectProduct3D_128(YDir,ZDir,XDir); - VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir - - FMatrix := Matrix3D(XDir,YDir,ZDir,ViewPoint); - ComposedMatrix := MatrixIdentity3D; - CurPart := self.FContainer; - while CurPart <> nil do - begin - ComposedMatrix := CurPart.Matrix*ComposedMatrix; - CurPart := CurPart.Container; - end; - FMatrix := MatrixInverse3D(ComposedMatrix)*FMatrix; -end; - -procedure TBGRAPart3D.RemoveUnusedVertices; -var - i: Integer; -begin - for i := FVertexCount-1 downto 0 do - if FVertices[i].Usage <= 2 then RemoveVertex(i); - for i := 0 to FPartCount-1 do - FParts[i].RemoveUnusedVertices; -end; - -function TBGRAPart3D.IndexOf(AVertex: IBGRAVertex3D): integer; -var i: integer; -begin - for i := 0 to FVertexCount-1 do - if FVertices[i] = AVertex then - begin - result := i; - exit; - end; - result := -1; -end; - -procedure TBGRAPart3D.ForEachVertex(ACallback: TVertex3DCallback); -var i: integer; -begin - for i := 0 to FVertexCount-1 do - ACallback(FVertices[i]); -end; - -procedure TBGRAPart3D.Add(AVertex: IBGRAVertex3D); -begin - if FVertexCount = length(FVertices) then - setlength(FVertices, FVertexCount*2+3); - FVertices[FVertexCount] := AVertex; - inc(FVertexCount); -end; - -function TBGRAPart3D.AddNormal(x, y, z: single): IBGRANormal3D; -begin - if not Assigned(FNormalPool) then FNormalPool := TBGRANormalPool3D.Create(4); - result := TBGRANormal3D.Create(FNormalPool,Point3D_128(x,y,z)); - AddNormal(result); -end; - -function TBGRAPart3D.AddNormal(pt: TPoint3D): IBGRANormal3D; -begin - if not Assigned(FNormalPool) then FNormalPool := TBGRANormalPool3D.Create(4); - result := TBGRANormal3D.Create(FNormalPool,pt); - AddNormal(result); -end; - -function TBGRAPart3D.AddNormal(pt: TPoint3D_128): IBGRANormal3D; -begin - if not Assigned(FNormalPool) then FNormalPool := TBGRANormalPool3D.Create(4); - result := TBGRANormal3D.Create(FNormalPool,pt); - AddNormal(result); -end; - -procedure TBGRAPart3D.AddNormal(ANormal: IBGRANormal3D); -begin - if FNormalCount = length(FNormals) then - setlength(FNormals, FNormalCount*2+3); - FNormals[FNormalCount] := ANormal; - inc(FNormalCount); -end; - -procedure TBGRAPart3D.RemoveVertex(Index: integer); -var i: integer; -begin - if (Index >= 0) and (Index < FVertexCount) then - begin - for i := Index to FVertexCount-2 do - FVertices[i] := FVertices[i+1]; - FVertices[FVertexCount-1] := nil; - dec(FVertexCount); - end; -end; - -procedure TBGRAPart3D.RemoveNormal(Index: integer); -var i: integer; -begin - if (Index >= 0) and (Index < FNormalCount) then - begin - for i := Index to FNormalCount-2 do - FNormals[i] := FNormals[i+1]; - FNormals[FNormalCount-1] := nil; - dec(FNormalCount); - end; -end; - -function TBGRAPart3D.GetRadius: single; -var i: integer; - pt: TPoint3D_128; - d: single; -begin - result := 0; - for i := 0 to GetVertexCount-1 do - begin - pt := GetVertex(i).SceneCoord_128; - d:= sqrt(DotProduct3D_128(pt,pt)); - if d > result then result := d; - end; -end; - -constructor TBGRAPart3D.Create(AObject3D: TBGRAObject3D; AContainer: IBGRAPart3D); -begin - FObject3D := AObject3D; - FContainer := AContainer; - FMatrix := MatrixIdentity3D; - FCoordPool := TBGRACoordPool3D.Create(4); - FNormalPool := nil; - FNormalCount:= 0; - FVertexCount := 0; -end; - -destructor TBGRAPart3D.Destroy; -begin - FVertices := nil; - FVertexCount := 0; - if FCoordPool.UsedCapacity > 0 then - raise Exception.Create('Coordinate pool still used. Please set vertex references to nil before destroying the scene.'); - FreeAndNil(FCoordPool); - if Assigned(FNormalPool) then - begin - if FNormalPool.UsedCapacity > 0 then - raise Exception.Create('Normal pool still used'); - FreeAndNil(FNormalPool); - end; - inherited Destroy; -end; - -procedure TBGRAPart3D.Clear(ARecursive: boolean); -var i: integer; -begin - FVertices := nil; - FVertexCount := 0; - FNormals := nil; - FNormalCount := 0; - if ARecursive then - begin - for i := 0 to FPartCount-1 do - FParts[i].Clear(ARecursive); - FParts := nil; - FPartCount := 0; - end; -end; - -function TBGRAPart3D.Add(x, y, z: single): IBGRAVertex3D; -begin - result := TBGRAVertex3D.Create(FObject3D,FCoordPool,Point3D(x,y,z)); - Add(result); -end; - -function TBGRAPart3D.Add(pt: TPoint3D): IBGRAVertex3D; -begin - result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); - Add(result); -end; - -function TBGRAPart3D.Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; -begin - result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); - result.CustomNormal := normal; - Add(result); -end; - -function TBGRAPart3D.Add(pt: TPoint3D_128): IBGRAVertex3D; -begin - result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); - Add(result); -end; - -function TBGRAPart3D.Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; -begin - result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt); - result.CustomNormal := Point3D(normal); - Add(result); -end; - -function TBGRAPart3D.Add(const coords: array of single - ): arrayOfIBGRAVertex3D; -var pts: array of TPoint3D; - CoordsIdx: integer; - i: Integer; -begin - if length(coords) mod 3 <> 0 then - raise exception.Create('Array size must be a multiple of 3'); - setlength(pts, length(coords) div 3); - coordsIdx := 0; - for i := 0 to high(pts) do - begin - pts[i] := Point3D(coords[CoordsIdx],coords[CoordsIdx+1],coords[CoordsIdx+2]); - inc(coordsIdx,3); - end; - result := Add(pts); -end; - -function TBGRAPart3D.Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; -var - i: Integer; -begin - setlength(result, length(pts)); - for i := 0 to high(pts) do - result[i] := TBGRAVertex3D.Create(FObject3D,FCoordPool,pts[i]); - Add(result); -end; - -function TBGRAPart3D.Add(const pts: array of TPoint3D_128 - ): arrayOfIBGRAVertex3D; -var - i: Integer; -begin - setlength(result, length(pts)); - for i := 0 to high(pts) do - result[i] := TBGRAVertex3D.Create(FObject3D,FCoordPool,pts[i]); - Add(result); -end; - -procedure TBGRAPart3D.Add(const pts: array of IBGRAVertex3D); -var - i: Integer; -begin - if FVertexCount + length(pts) > length(FVertices) then - setlength(FVertices, (FVertexCount*2 + length(pts))+1); - for i := 0 to high(pts) do - begin - FVertices[FVertexCount] := pts[i]; - inc(FVertexCount); - end; -end; - -function TBGRAPart3D.GetBoundingBox: TBox3D; -var i: integer; - pt: TPoint3D_128; -begin - if GetVertexCount > 0 then - begin - result.min := GetVertex(0).SceneCoord; - result.max := result.min; - end else - begin - result.min := Point3D(0,0,0); - result.max := Point3D(0,0,0); - exit; - end; - for i := 1 to GetVertexCount-1 do - begin - pt := GetVertex(i).SceneCoord_128; - if pt.x < result.min.x then result.min.x := pt.x else - if pt.x > result.max.x then result.max.x := pt.x; - if pt.y < result.min.y then result.min.y := pt.y else - if pt.y > result.max.y then result.max.y := pt.y; - if pt.z < result.min.z then result.min.z := pt.z else - if pt.z > result.max.z then result.max.z := pt.z; - end; -end; - -function TBGRAPart3D.GetMatrix: TMatrix3D; -begin - result := FMatrix; -end; - -function TBGRAPart3D.GetPart(AIndex: Integer): IBGRAPart3D; -begin - if (AIndex < 0) or (AIndex >= FPartCount) then - raise ERangeError.Create('Index of out bounds'); - result := FParts[AIndex]; -end; - -function TBGRAPart3D.GetPartCount: integer; -begin - result := FPartCount; -end; - -function TBGRAPart3D.GetVertex(AIndex: Integer): IBGRAVertex3D; -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise ERangeError.Create('Index of out bounds'); - result := FVertices[AIndex]; -end; - -function TBGRAPart3D.GetVertexCount: integer; -begin - result := FVertexCount; -end; - -function TBGRAPart3D.GetNormal(AIndex: Integer): IBGRANormal3D; -begin - if (AIndex < 0) or (AIndex >= FNormalCount) then - raise ERangeError.Create('Index of out bounds'); - result := FNormals[AIndex]; -end; - -function TBGRAPart3D.GetNormalCount: integer; -begin - result := FNormalCount; -end; - -function TBGRAPart3D.GetTotalVertexCount: integer; -var i: integer; -begin - result := GetVertexCount; - for i := 0 to GetPartCount-1 do - inc(result, GetPart(i).GetTotalVertexCount); -end; - -function TBGRAPart3D.GetTotalNormalCount: integer; -var i: integer; -begin - result := GetNormalCount; - for i := 0 to GetPartCount-1 do - inc(result, GetPart(i).GetTotalNormalCount); -end; - -procedure TBGRAPart3D.ResetTransform; -begin - FMatrix := MatrixIdentity3D; -end; - -procedure TBGRAPart3D.Scale(size: single; Before: boolean = true); -begin - Scale(size,size,size,Before); -end; - -procedure TBGRAPart3D.Scale(x, y, z: single; Before: boolean = true); -begin - Scale(Point3D(x,y,z),Before); -end; - -procedure TBGRAPart3D.Scale(size: TPoint3D; Before: boolean = true); -begin - if Before then - FMatrix := FMatrix * MatrixScale3D(size) - else - FMatrix := MatrixScale3D(size)*FMatrix; -end; - -procedure TBGRAPart3D.RotateXDeg(angle: single; Before: boolean = true); -begin - RotateXRad(-angle*Pi/180, Before); -end; - -procedure TBGRAPart3D.RotateYDeg(angle: single; Before: boolean = true); -begin - RotateYRad(-angle*Pi/180, Before); -end; - -procedure TBGRAPart3D.RotateZDeg(angle: single; Before: boolean = true); -begin - RotateZRad(-angle*Pi/180, Before); -end; - -procedure TBGRAPart3D.RotateXRad(angle: single; Before: boolean = true); -begin - if Before then - FMatrix := FMatrix * MatrixRotateX(angle) - else - FMatrix := MatrixRotateX(angle) * FMatrix; -end; - -procedure TBGRAPart3D.RotateYRad(angle: single; Before: boolean = true); -begin - if Before then - FMatrix := FMatrix * MatrixRotateY(angle) - else - FMatrix := MatrixRotateY(angle) * FMatrix; -end; - -procedure TBGRAPart3D.RotateZRad(angle: single; Before: boolean = true); -begin - if Before then - FMatrix := FMatrix * MatrixRotateZ(angle) - else - FMatrix := MatrixRotateZ(angle) * FMatrix; -end; - -procedure TBGRAPart3D.SetMatrix(const AValue: TMatrix3D); -begin - FMatrix := AValue; -end; - -{$PUSH}{$OPTIMIZATION OFF} //avoids Internal error 2012090607 -procedure TBGRAPart3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D); -var - i: Integer; - Composed: TMatrix3D; -begin - Composed := AMatrix* self.FMatrix; - FCoordPool.ComputeWithMatrix(Composed, AProjection); - if Assigned(FNormalPool) then FNormalPool.ComputeWithMatrix(Composed); - for i := 0 to FPartCount-1 do - FParts[i].ComputeWithMatrix(Composed,AProjection); -end; -{$POP} - -function TBGRAPart3D.ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF; -var part: IBGRAPart3D; - newViewCoord: TPoint3D_128; - InvZ: single; -begin - newViewCoord := FMatrix * ASceneCoord; - part := FContainer; - while part <> nil do - begin - newViewCoord := part.Matrix * newViewCoord; - part := part.Container; - end; - if NewViewCoord.z > 0 then - begin - InvZ := 1/NewViewCoord.z; - result := PointF(NewViewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x, - NewViewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y); - end else - result := PointF(0,0); -end; - -procedure TBGRAPart3D.NormalizeViewNormal; -var - i: Integer; -begin - for i := 0 to FVertexCount-1 do - FVertices[i].NormalizeViewNormal; - for i := 0 to FPartCount-1 do - FParts[i].NormalizeViewNormal; -end; - -procedure TBGRAPart3D.Translate(x, y, z: single; Before: boolean = true); -begin - Translate(Point3D(x,y,z),Before); -end; - -procedure TBGRAPart3D.Translate(ofs: TPoint3D; Before: boolean = true); -begin - if Before then - FMatrix := FMatrix * MatrixTranslation3D(ofs) - else - FMatrix := MatrixTranslation3D(ofs)*FMatrix; -end; - -function TBGRAPart3D.CreatePart: IBGRAPart3D; -begin - if FPartCount = length(FParts) then - setlength(FParts, FPartCount*2+1); - result := TBGRAPart3D.Create(FObject3D,self); - FParts[FPartCount] := result; - inc(FPartCount); -end; - -function TBGRAPart3D.GetContainer: IBGRAPart3D; -begin - result := FContainer; -end; - -procedure TBGRAPart3D.SetVertex(AIndex: Integer; AValue: IBGRAVertex3D); -begin - if (AIndex < 0) or (AIndex >= FVertexCount) then - raise ERangeError.Create('Index of out bounds'); - FVertices[AIndex] := AValue; -end; - -procedure TBGRAPart3D.SetNormal(AIndex: Integer; AValue: IBGRANormal3D); -begin - if (AIndex < 0) or (AIndex >= FNormalCount) then - raise ERangeError.Create('Index of out bounds'); - FNormals[AIndex] := AValue; -end; - - diff --git a/components/bgrabitmap/perspectivecolorscan.inc b/components/bgrabitmap/perspectivecolorscan.inc deleted file mode 100644 index 1355626..0000000 --- a/components/bgrabitmap/perspectivecolorscan.inc +++ /dev/null @@ -1,104 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception - {$IFDEF PARAM_USESSE} {$asmmode intel} - minVal := 0; - maxVal := 65535; - asm - movss xmm6, invZ - shufps xmm6,xmm6,0 //xmm6 = invZ - movss xmm7, invZStep - shufps xmm7,xmm7,0 //xmm7 = invZStep - movups xmm4, colorPos - movups xmm5, colorStep - - movss xmm2, minVal - shufps xmm2,xmm2,0 //xmm2 = minVal - movss xmm3, maxVal - shufps xmm3,xmm3,0 //xmm3 = maxVal - end; - - for i := ix1 to ix2 do - begin - {$IFDEF PARAM_USEZBUFFER} - if invZ > zbufferpos^ then - {$ENDIF} - begin - {$IFDEF PARAM_USEZBUFFER} - zbufferpos^ := invz; - {$ENDIF} - asm - movaps xmm0,xmm6 - rcpps xmm0,xmm0 - mulps xmm0, xmm4 - minps xmm0, xmm3 - maxps xmm0, xmm2 - {$IFDEF PARAM_USESSE2} - cvtps2dq xmm0,xmm0 - movups cInt, xmm0 - {$ELSE} - movups colorPosByZ, xmm0 - {$ENDIF} - end; - {$IFDEF PARAM_USESSE2} - c.red := GammaCompressionTab[cInt.r]; - c.green := GammaCompressionTab[cInt.g]; - c.blue := GammaCompressionTab[cInt.b]; - c.alpha := GammaCompressionTab[cInt.a]; - DrawPixelInlineWithAlphaCheck(pdest, c); - {$ELSE} - ec.red := round(colorPosByZ[1]); - ec.green := round(colorPosByZ[2]); - ec.blue := round(colorPosByZ[3]); - ec.alpha := round(colorPosByZ[4]); - DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); - {$ENDIF} - end; - asm - addps xmm6,xmm7 - addps xmm4,xmm5 - {$IFDEF PARAM_USEZBUFFER} - movss invZ,xmm6 - {$ENDIF} - end; - inc(pdest); - {$IFDEF PARAM_USEZBUFFER} - inc(zbufferpos); - {$ENDIF} - end; - {$ELSE} - for i := ix1 to ix2 do - begin - {$IFDEF PARAM_USEZBUFFER} - if invZ > zbufferpos^ then - {$ENDIF} - begin - {$IFDEF PARAM_USEZBUFFER} - zbufferpos^ := invz; - {$ENDIF} - z := 1/invZ; - r := round(z*colorPos[1]); - g := round(z*colorPos[2]); - b := round(z*colorPos[3]); - a := round(z*colorPos[4]); - if r < 0 then ec.red := 0 else - if r > 65535 then ec.red := 65535 - else ec.red := r; - if g < 0 then ec.green := 0 else - if g > 65535 then ec.green := 65535 - else ec.green := g; - if b < 0 then ec.blue := 0 else - if b > 65535 then ec.blue := 65535 - else ec.blue := b; - if a < 0 then ec.alpha := 0 else - if a > 65535 then ec.alpha := 65535 - else ec.alpha := a; - DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec)); - end; - colorPos := colorPos + colorStep; - IncF(invZ, invZStep); - inc(pdest); - {$IFDEF PARAM_USEZBUFFER} - inc(zbufferpos); - {$ENDIF} - end; - {$ENDIF} - diff --git a/components/bgrabitmap/perspectivescan.inc b/components/bgrabitmap/perspectivescan.inc deleted file mode 100644 index ac9686f..0000000 --- a/components/bgrabitmap/perspectivescan.inc +++ /dev/null @@ -1,168 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$i bgrasse.inc} - - var - //loop variables - pdest: PBGRAPixel; - i: LongInt; - - InvXLen: single; //inverse of horizontal length in pixels - t: single; //initial horizontal position in [0..1] - {$IFNDEF PARAM_USESOLIDCOLOR} - texPosByZ: TPointF; - intTexPos: packed record - x,y: integer; - end; - texPos: TPoint3D_128; //texture start position - {$ENDIF} - InvZPos: single; //Z: depth start position - - {$IFNDEF PARAM_USESOLIDCOLOR} - texStep: TPoint3D_128; //texture step - {$ENDIF} - zStep: single; //depth step - - {$IFNDEF PARAM_USESOLIDCOLOR} - texVect: TPointF; //texture vector between start and end of line - {$ENDIF} - zLen: single; //depth difference - {$IFDEF PARAM_USESHADER} - tempVect3D: TPoint3D_128; - {$ENDIF} - - {$IFNDEF PARAM_USESOLIDCOLOR} - {$DEFINE PARAM_USEZPOS} - {$ENDIF} - {$IFDEF PARAM_USESHADER} - {$DEFINE PARAM_USEZPOS} - {$ENDIF} - - {$IFDEF PARAM_USEZPOS} - zPos: single; - {$ENDIF} - - {$IFDEF PARAM_USEZBUFFER} - pzbuffer: PSingle; - {$ENDIF} - - {$IFDEF PARAM_USELIGHTING} - light,lightStep,lightDiff,lightAcc,lightMod: word; - lightLen: integer; - - procedure NextLight; inline; - begin - light := (light+lightStep) and 65535; - inc(lightAcc,lightDiff); - if lightAcc >= lightMod then - begin - dec(lightAcc,lightMod); - light := (light + 1) and 65535; - end; - end; - {$ENDIF} - - begin - InvXLen := 1/(info2.interX - info1.interX); - t := ((ix1+0.5)-info1.interX)*InvXLen; - - {$IFNDEF PARAM_USESOLIDCOLOR} - texVect := info2.texCoordDivByZ-info1.texCoordDivByZ; - texPos := Point3D_128(info1.texCoordDivByZ + texVect*t); - texStep := Point3D_128(texVect*InvXLen); - {$ENDIF} - zLen := info2.coordInvZ-info1.coordInvZ; - InvZPos := info1.coordInvZ+t*zLen; - zStep := zLen*InvXLen; - - {$IFDEF PARAM_USESHADER} - tempVect3D := info2.Position3D - info1.Position3D; - ShaderContext^.PositionInvZ := info1.Position3D + tempVect3D*t; - ShaderContext^.PositionStepInvZ := tempVect3D*InvXLen; - - tempVect3D := info2.Normal3D - info1.Normal3D; - ShaderContext^.NormalInvZ := info1.Normal3D + tempVect3D*t; - ShaderContext^.NormalStepInvZ := tempVect3D*InvXLen; - {$endif} - - pdest := bmp.ScanLine[yb]+ix1; - {$IFDEF PARAM_USEZBUFFER} - pzbuffer := zbuffer + yb*bmp.Width + ix1; - {$ENDIF} - - {$IFDEF PARAM_USELIGHTING} - if ix2 = ix1 then - begin - light := (info1.lightness+info2.lightness) div 2; - lightStep := 0; - lightDiff := 0; - lightMod := 1; - end - else - begin - light := info1.lightness; - lightLen := info2.lightness-info1.lightness; - if lightLen >= 0 then - begin - lightStep := lightLen div (ix2-ix1); - lightMod := ix2-ix1; - lightDiff := lightLen - lightStep*(ix2-ix1); - end else - begin - lightStep := (-lightLen+(ix2-ix1-1)) div (ix2-ix1); - lightMod := ix2-ix1; - lightDiff := lightLen + lightStep*(ix2-ix1); - lightStep := 65536 - lightStep; - end; - end; - lightAcc := lightDiff div 2; - {$ENDIF} - - {$IFDEF BGRASSE_AVAILABLE} - if UseSSE then - begin - {$DEFINE PARAM_USESSE} - if UseSSE3 then - begin - {$DEFINE PARAM_USESSE3} - if WithInterpolation then - begin - {$DEFINE PARAM_USEINTERPOLATION} - {$i perspectivescan2.inc} - {$UNDEF PARAM_USEINTERPOLATION} - end else - begin - {$i perspectivescan2.inc} - end; - {$UNDEF PARAM_USESSE3} - end else - begin - if WithInterpolation then - begin - {$DEFINE PARAM_USEINTERPOLATION} - {$i perspectivescan2.inc} - {$UNDEF PARAM_USEINTERPOLATION} - end else - begin - {$i perspectivescan2.inc} - end; - end; - {$UNDEF PARAM_USESSE} - end else - {$ENDIF} - begin - if WithInterpolation then - begin - {$DEFINE PARAM_USEINTERPOLATION} - {$i perspectivescan2.inc} - {$UNDEF PARAM_USEINTERPOLATION} - end else - begin - {$i perspectivescan2.inc} - end; - end; - end; -{$undef PARAM_USELIGHTING} -{$undef PARAM_USESHADER} -{$undef PARAM_USESOLIDCOLOR} -{$undef PARAM_USEZBUFFER} -{$undef PARAM_USEZPOS} diff --git a/components/bgrabitmap/perspectivescan2.inc b/components/bgrabitmap/perspectivescan2.inc deleted file mode 100644 index 87d80f9..0000000 --- a/components/bgrabitmap/perspectivescan2.inc +++ /dev/null @@ -1,205 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$i bgrasse.inc} - -{$ifdef BGRASSE_AVAILABLE}{$asmmode intel}{$endif} - {$IFDEF PARAM_USESSE} - asm - {$IFDEF PARAM_USESHADER} - {$IFDEF cpux86_64} - mov rax, ShaderContext - movaps xmm2, [rax+32] //positionInvZ - movaps xmm3, [rax+48] //normalInvZ - {$ELSE} - mov eax, ShaderContext - movaps xmm2, [eax+32] //positionInvZ - movaps xmm3, [eax+48] //normalInvZ - {$ENDIF} - {$ENDIF} - {$IFNDEF PARAM_USESOLIDCOLOR} - xorps xmm5,xmm5 - movlps xmm5, texPos - {$ENDIF} - end; - {$ENDIF} - for i := ix1 to ix2 do - begin - {$IFDEF PARAM_USESSE} - {$IFDEF PARAM_USEZBUFFER} - if InvZPos > pzbuffer^ then - begin - pzbuffer^ := InvZPos; - {$ENDIF} - asm - movss xmm4, InvZPos - rcpss xmm4,xmm4 //zPos - shufps xmm4,xmm4,0 //broadcast - - {$IFDEF PARAM_USESHADER} - {$ifdef cpux86_64} - mov rax, ShaderContext - {$else} - mov eax, ShaderContext - {$endif} - - mulps xmm2, xmm4 //positionInvZ*zPos (A) - mulps xmm3, xmm4 //normalInvZ*zPos - {$ifdef cpux86_64} - movaps [rax+0], xmm2 //(A) Position - {$else} - movaps [eax+0], xmm2 //(A) Position - {$endif} - - //normalize - movaps xmm1, xmm3 - mulps xmm3, xmm3 - - {$IFDEF PARAM_USESSE3} - haddps xmm3,xmm3 - haddps xmm3,xmm3 - {$ELSE} - //mix1 - movaps xmm7, xmm3 - shufps xmm7, xmm7, $4e - addps xmm3, xmm7 - //mix2 - movaps xmm7, xmm3 - shufps xmm7, xmm7, $11 - addps xmm3, xmm7 - {$ENDIF} - - xorps xmm7,xmm7 - comiss xmm3,xmm7 - jna @skipnormal - - rsqrtps xmm3,xmm3 - mulps xmm3, xmm1 //apply - @skipnormal: - - {$ifdef cpux86_64} - movaps [rax+16], xmm3 //Normal - {$else} - movaps [eax+16], xmm3 //Normal - {$endif} - {$ENDIF} - - {$IFNDEF PARAM_USESOLIDCOLOR} - mulps xmm5, xmm4 - {$IFDEF PARAM_USEINTERPOLATION} - movlps texPosByZ, xmm5 - {$ELSE} - cvtps2dq xmm1,xmm5 - movlps intTexPos,xmm1 - {$ENDIF} - {$ENDIF} - end; - {$ELSE} - {$IFDEF PARAM_USEZBUFFER} - if InvZPos > pzbuffer^ then - begin - pzbuffer^ := InvZPos; - {$ENDIF} - {$IFDEF PARAM_USESHADER} - zPos := 1/InvZPos; - with ShaderContext^ do - begin - Normal := NormalInvZ*zPos; - Normalize3D_128(Normal); - Position := PositionInvZ*zPos; - end; - {$ELSE} - {$IFNDEF PARAM_USESOLIDCOLOR} - zPos := 1/InvZPos; - {$ENDIF} - {$ENDIF} - {$ENDIF} - DrawPixelInlineWithAlphaCheck(pdest, - {$IFDEF PARAM_USESHADER} ShaderFunction(ShaderContext, {$ENDIF} - {$IFDEF PARAM_USELIGHTING} ApplyLightnessFast( {$ENDIF} - {$IFDEF PARAM_USESOLIDCOLOR} - solidColor - {$ELSE} - {$IFNDEF PARAM_USESSE} - {$IFDEF PARAM_USEINTERPOLATION} - scanAtFunc(texPos.x*zPos,texPos.y*zPos) - {$ELSE} - scanAtIntegerFunc(round(texPos.x*zPos),round(texPos.y*zPos)) - {$ENDIF} - {$ELSE} - {$IFDEF PARAM_USEINTERPOLATION} - scanAtFunc(texPosByZ.x,texPosByZ.y) - {$ELSE} - scanAtIntegerFunc(intTexPos.x,intTexPos.y) - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$IFDEF PARAM_USELIGHTING} ,light) {$ENDIF} - {$IFDEF PARAM_USESHADER} ) {$ENDIF} - ); - {$IFDEF PARAM_USEZBUFFER} - end; - inc(pzbuffer); - {$ENDIF} - - {$IFDEF PARAM_USESSE} - {$IFNDEF PARAM_USESOLIDCOLOR} - asm - movups xmm5, texPos - movups xmm1, texStep - end; - IncF(InvZPos, zStep); - asm - addps xmm5, xmm1 - movlps texPos, xmm5 - end; - {$ELSE} - IncF(InvZPos, zStep); - {$ENDIF} - {$ELSE} - {$IFNDEF PARAM_USESOLIDCOLOR} - IncF(texPos.x, texStep.x); - IncF(texPos.y, texStep.y); - {$ENDIF} - IncF(InvZPos, zStep); - {$ENDIF} - - {$IFDEF PARAM_USESHADER} - {$IFDEF PARAM_USESSE} - {$ifdef cpux86_64} - asm - mov rax, ShaderContext - movaps xmm2, [rax+32] //PositionInvZ - movaps xmm1, [rax+64] //PositionStepInvZ - movaps xmm3, [rax+48] //NormalInvZ - movaps xmm0, [rax+80] //NormalStepInvZ - addps xmm2, xmm1 - addps xmm3, xmm0 - movaps [rax+32], xmm2 - movaps [rax+48], xmm3 - end; - {$else} - asm - mov eax, ShaderContext - movaps xmm2, [eax+32] //PositionInvZ - movaps xmm1, [eax+64] //PositionStepInvZ - movaps xmm3, [eax+48] //NormalInvZ - movaps xmm0, [eax+80] //NormalStepInvZ - addps xmm2, xmm1 - addps xmm3, xmm0 - movaps [eax+32], xmm2 - movaps [eax+48], xmm3 - end; - {$endif} - {$ELSE} - with ShaderContext^ do - begin - PositionInvZ.Offset(PositionStepInvZ); - NormalInvZ.Offset(NormalStepInvZ); - end; - {$ENDIF} - {$ENDIF} - - {$IFDEF PARAM_USELIGHTING} - NextLight; - {$ENDIF} - inc(pdest); - end; diff --git a/components/bgrabitmap/phongdraw.inc b/components/bgrabitmap/phongdraw.inc deleted file mode 100644 index b4d771a..0000000 --- a/components/bgrabitmap/phongdraw.inc +++ /dev/null @@ -1,289 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$ifdef PARAM_PHONGSSE} - {$asmmode intel} - //SSE rotate singles - const Shift231 = 1 + 8; - Shift312 = 2 + 16; -{$endif} - -var - //Light source normal. - vL: TPoint3D_128; {xmm0} - //Light source position. - vLS: TPoint3D_128; {xmm1} - //Vector H is the unit normal to the hypothetical surface oriented - //halfway between the light direction vector (L) and the viewing vector (V). - vH: TPoint3D_128; {xmm2} - - vN: TPoint3D_128; {xmm3} // surface normal - vP: TPoint3D_128; {xmm4} // position of lighted pixel - vV: TPoint3D_128; // viewer direction -{$ifdef PARAM_PHONGSSE} - LightDestFactor4: TPoint3D_128; // for multiplication -{$endif} - - //Calculate LdotN and NnH - NH: Single; -{$ifndef PARAM_PHONGSSE} - vD: TPoint3D_128; -{$endif} - - Iw, Ic: integer; // Iw: specular intensity, Ic: ambient+diffuse intensity - sIw: single; // floating point value for Iw - - z, LdotN, NnH, - dist, distfactor, diffuseterm, specularterm: single; - eLight: TExpandedPixel; - mc,mcLeft,mcRight,mcTop,mcBottom: TBGRAPixel; ///map values - -{$ifdef PARAM_SIMPLECOLOR} - eColor: TExpandedPixel; -{$else} - {$ifndef PARAM_SCANNER} - pcolormap: PBGRAPixel; - {$endif} -{$endif} - - {$hints off} - function ComputePixel(x,y: integer; DiffuseLight, SpecularLight: Word; Alpha: Byte): TBGRAPixel; inline; - var ec: TExpandedPixel; - {$ifndef PARAM_SIMPLECOLOR} - eColor: TExpandedPixel; - {$endif} - begin - {$ifndef PARAM_SIMPLECOLOR} - {$ifdef PARAM_SCANNER} - eColor := GammaExpansion(ColorScan.ScanNextPixel); - {$else} - eColor := GammaExpansion(pcolormap^); - {$endif} - {$endif} - Alpha := ApplyOpacity(Alpha, eColor.alpha shr 8); - ec.red := (eColor.Red*DiffuseLight+eLight.Red*SpecularLight+PhongLightPrecisionDiv2) shr PhongLightPrecisionSh; - ec.green := (eColor.Green*DiffuseLight+eLight.Green*SpecularLight+PhongLightPrecisionDiv2) shr PhongLightPrecisionSh; - ec.blue := (eColor.Blue*DiffuseLight+eLight.Blue*SpecularLight+PhongLightPrecisionDiv2) shr PhongLightPrecisionSh; - ec.alpha := Alpha shl 8+Alpha; - result := GammaCompression(ec); - end; - {$hints on} - -var - minx,miny,maxx,maxy: integer; - pmap: PBGRAPixel; - pdest: PBGRAPixel; - x,y : integer; // Coordinates of point in height map. - vS1,vS2: TPoint3D_128; // surface vectors (plane) - deltaDown: Int32or64; - IsLineUp,IsLineDown: boolean; - -begin - if map = nil then exit; - {$ifndef PARAM_SIMPLECOLOR} - {$ifndef PARAM_SCANNER} - if (colorMap.Width < map.width) or (colorMap.Height < map.height) then - raise Exception.Create('Dimension mismatch'); - {$endif} - {$endif} - - if (map.width = 0) or (map.Height = 0) then exit; - if ofsX >= dest.ClipRect.Right then exit; - if ofsY >= dest.ClipRect.Bottom then exit; - if ofsX <= dest.ClipRect.Left-map.Width then exit; - if ofsY <= dest.ClipRect.Top-map.Height then exit; - - minx := 0; - miny := 0; - maxx := map.Width-1; - maxy := map.Height-1; - if ofsX < dest.clipRect.Left then minx := dest.clipRect.Left-ofsX; - if ofsY < dest.clipRect.Top then miny := dest.clipRect.Top-ofsY; - if OfsX+maxx > dest.ClipRect.Right-1 then maxx := dest.ClipRect.Right-1-ofsX; - if OfsY+maxy > dest.ClipRect.Bottom-1 then maxy := dest.ClipRect.Bottom-1-ofsY; - - eLight := GammaExpansion(LightColor); - {$ifdef PARAM_SIMPLECOLOR} - eColor := GammaExpansion(color); - {$endif} - - //light origin - vLS := Point3D_128(FLightPosition3D.X-ofsX, - FLightPosition3D.Y-ofsY, - FLightPosition3D.Z); - - //surface vectors - vS1 := Point3D_128(1,0,0); - vS2 := Point3D_128(0,1,0); - - vV := Point3D_128(0,0,1); - - dist := 0; - LdotN := 0; - NnH := 0; - - {$ifdef PARAM_PHONGSSE} - LightDestFactor4 := Point3D_128(LightDestFactor,LightDestFactor,LightDestFactor,LightDestFactor); - {$endif} - - if map.LineOrder = riloTopToBottom then - deltaDown := map.Width*sizeof(TBGRAPixel) - else - deltaDown := -map.Width*sizeof(TBGRAPixel); - for y := miny to maxy do - begin - //read map values - pmap := map.ScanLine[y]+minx; - mc := BGRAPixelTransparent; - mcRight := pmap^; - pdest := dest.ScanLine[y+ofsY]+ofsX+minx; - {$ifndef PARAM_SIMPLECOLOR} - {$ifdef PARAM_SCANNER} - ColorScan.ScanMoveTo(OfsX+minx,OfsY+Y); - {$else} - pcolormap := ColorMap.ScanLine[y]; - {$endif} - {$endif} - IsLineUp := y > 0; - IsLineDown := y < map.Height-1; - mcTop := BGRAPixelTransparent; - mcBottom := BGRAPixelTransparent; - for x := minx to maxx do - begin - mcLeft := mc; - mc := mcRight; - if x < map.width-1 then - mcRight := (pmap+1)^ else - mcRight := BGRAPixelTransparent; - if mc.alpha = 0 then - begin - {$ifndef PARAM_SIMPLECOLOR} - {$ifdef PARAM_SCANNER} - ColorScan.ScanNextPixel; - {$else} - inc(pcolormap); - {$endif} - {$endif} - inc(pdest); - inc(pmap); - continue; - end; - - //compute surface vectors - if IsLineUp then mcTop := pbgrapixel(pbyte(pmap)-deltaDown)^; - if IsLineDown then mcBottom := pbgrapixel(pbyte(pmap)+deltaDown)^; - inc(pmap); - - z := MapHeight(mc)*mapAltitude; - if mcLeft.alpha = 0 then - begin - if mcRight.alpha = 0 then - vS1.z := 0 - else - vS1.z := (MapHeight(mcRight)-MapHeight(mc))*mapAltitude*2; - end else - begin - if mcRight.alpha = 0 then - vS1.z := (MapHeight(mc)-MapHeight(mcLeft))*mapAltitude*2 - else - vS1.z := (MapHeight(mcRight)-MapHeight(mcLeft))*mapAltitude; - end; - if mcTop.alpha = 0 then - begin - if mcBottom.alpha = 0 then - vS2.z := 0 - else - vS2.z := (MapHeight(mcBottom)-MapHeight(mc))*mapAltitude*2; - end else - begin - if mcBottom.alpha = 0 then - vS2.z := (MapHeight(mc)-MapHeight(mcTop))*mapAltitude*2 - else - vS2.z := (MapHeight(mcBottom)-MapHeight(mcTop))*mapAltitude; - end; - - //position vector - vP := Point3D_128(x, y, z); - {$ifdef PARAM_PHONGSSE} - if UseSSE3 then - begin - {$DEFINE PARAM_USESSE3} - asm - movups xmm1, vLS - end; - {$i phongdrawsse.inc} - {$UNDEF PARAM_USESSE3} - end else - begin - asm - movups xmm1, vLS - end; - {$i phongdrawsse.inc} - end; - {$else} - vP := Point3D_128(x, y, z); - vL := vLS- vP*LightDestFactor; - Normalize3D_128(vL); - - //compute bisector of angle between light and observer - vH := vL + vV; - Normalize3D_128(vH); - - // compute normal vector to the surface - VectProduct3D_128(vS1,vS2,vN); - Normalize3D_128(vN); - - //Calculate LdotN and NnH - LdotN := DotProduct3D_128(vN,vL); - vD := vLS-vP; - dist := sqrt(DotProduct3D_128(vD,vD)); - - NH := DotProduct3D_128(vH,vN); - {$endif} - - if NH <= 0 then - NnH := 0 - else - NnH := exp(SpecularIndex*ln(NH)); //to be optimized - - distfactor := LightSourceIntensity / (dist*LightSourceDistanceFactor + LightSourceDistanceTerm); - - if (LdotN <= 0) then //Point is not illuminated by light source. - //Use negative diffuse for contrast - diffuseterm := distfactor * NegativeDiffusionFactor * LdotN - else - diffuseterm := distfactor * DiffusionFactor * LdotN; - Ic := round((AmbientFactor + diffuseterm)*PhongLightPrecision); - - //specular (reflection) - specularterm := distfactor * SpecularFactor * NnH; - sIw := specularterm*PhongLightPrecision; - if sIw > PhongLightPrecision then Iw := PhongLightPrecision else - Iw := round(sIw); - - //intensity bounds (0..PhongLightPrecision) - If Ic < 0 then Ic := 0; - If Ic > PhongLightPrecision then - begin - If DiffuseSaturation then - begin - Iw := Iw+(Ic-PhongLightPrecision); - if Iw > PhongLightPrecision then Iw := PhongLightPrecision; - end; - Ic := PhongLightPrecision; - end; - Ic := Ic*(PhongLightPrecision-Iw) shr PhongLightPrecisionSh; - - DrawPixelInlineWithAlphaCheck(pdest, ComputePixel(x,y,Ic,Iw,mc.alpha)); - {$ifndef PARAM_SIMPLECOLOR} - {$ifndef PARAM_SCANNER} - inc(pcolormap); - {$endif} - {$endif} - inc(pdest); //go to next pixel - end; - end; -end; - -{$undef PARAM_PHONGSSE} -{$undef PARAM_SIMPLECOLOR} -{$undef PARAM_SCANNER} - diff --git a/components/bgrabitmap/phongdrawsse.inc b/components/bgrabitmap/phongdrawsse.inc deleted file mode 100644 index 50ffc25..0000000 --- a/components/bgrabitmap/phongdrawsse.inc +++ /dev/null @@ -1,164 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -asm - //vL := vLS- vP*LightDestFactor; - movups xmm4, vP - movups xmm6,LightDestFactor4 - mulps xmm6, xmm4 //keep xmm4 = vP - movaps xmm0, xmm1 - subps xmm0, xmm6 - - movups xmm2, vV //preload xmm2 (A) - - //normalize(vL); - movaps xmm6, xmm0 //save - mulps xmm0, xmm0 - - {$IFDEF PARAM_USESSE3} - haddps xmm0,xmm0 - haddps xmm0,xmm0 - {$ELSE} - //mix1 - movaps xmm7, xmm0 - shufps xmm7, xmm7, $4e - addps xmm0, xmm7 - //mix2 - movaps xmm7, xmm0 - shufps xmm7, xmm7, $11 - addps xmm0, xmm7 - {$ENDIF} - - //1/sqrt - rsqrtps xmm0, xmm0 - mulps xmm0, xmm6 //apply - - - //vH := vL + vV; (A) - //xmm2 = vV - addps xmm2, xmm0 - - - - //vectproduct(vS1,vS2,vN); - movups xmm6, vS1 - shufps xmm6, xmm6, Shift231 - - movups xmm7, vS2 - shufps xmm7, xmm7, Shift312 - - movaps xmm3,xmm6 - mulps xmm3,xmm7 - - movups xmm6, vS1 - shufps xmm6, xmm6, Shift312 - - movups xmm7, vS2 - shufps xmm7, xmm7, Shift231 - - mulps xmm7,xmm6 - subps xmm3,xmm7 - //end of vectproduct - - - //normalize(vH); - movaps xmm6, xmm2 //save - mulps xmm2, xmm2 - - {$IFDEF PARAM_USESSE3} - haddps xmm2,xmm2 - haddps xmm2,xmm2 - {$ELSE} - //mix1 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $4e - addps xmm2, xmm7 - //mix2 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $11 - addps xmm2, xmm7 - {$ENDIF} - - //1/sqrt - rsqrtps xmm2, xmm2 - mulps xmm2, xmm6 //apply - - //normalize(vN); - movaps xmm6, xmm3 //save - mulps xmm3, xmm3 - - {$IFDEF PARAM_USESSE3} - haddps xmm3,xmm3 - haddps xmm3,xmm3 - {$ELSE} - //mix1 - movaps xmm7, xmm3 - shufps xmm7, xmm7, $4e - addps xmm3, xmm7 - //mix2 - movaps xmm7, xmm3 - shufps xmm7, xmm7, $11 - addps xmm3, xmm7 - {$ENDIF} - - //1/sqrt - rsqrtps xmm3, xmm3 - mulps xmm3, xmm6 //apply - - //LdotN := vN * vL; - movups xmm5, xmm3 - mulps xmm5, xmm0 - //mix1 - movaps xmm7, xmm5 - shufps xmm7, xmm7, $4e - addps xmm5, xmm7 - //mix2 - movaps xmm7, xmm5 - shufps xmm7, xmm7, $11 - addps xmm5, xmm7 - //:= - movss LdotN, xmm5 - - //vD := vLS-vP; - movaps xmm5, xmm1 - subps xmm5, xmm4 - - //dist := sqrt(vD*vD); - mulps xmm5, xmm5 - - {$IFDEF PARAM_USESSE3} - haddps xmm5,xmm5 - haddps xmm5,xmm5 - {$ELSE} - //mix1 - movaps xmm7, xmm5 - shufps xmm7, xmm7, $4e - addps xmm5, xmm7 - //mix2 - movaps xmm7, xmm5 - shufps xmm7, xmm7, $11 - addps xmm5, xmm7 - {$ENDIF} - - //:= sqrt - sqrtss xmm5,xmm5 - movss dist, xmm5 - - //NH := vH * vN; - movups xmm6, xmm2 - mulps xmm6, xmm3 - - {$IFDEF PARAM_USESSE3} - haddps xmm6,xmm6 - haddps xmm6,xmm6 - {$ELSE} - //mix1 - movaps xmm7, xmm6 - shufps xmm7, xmm7, $4e - addps xmm6, xmm7 - //mix2 - movaps xmm7, xmm6 - shufps xmm7, xmm7, $11 - addss xmm6, xmm7 - {$ENDIF} - //:= - movss NH, xmm6 - end; diff --git a/components/bgrabitmap/phonglight.inc b/components/bgrabitmap/phonglight.inc deleted file mode 100644 index 5fcbb65..0000000 --- a/components/bgrabitmap/phonglight.inc +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$i bgrasse.inc} -var - {%H-}dist2,LdotN,NdotH,lightEnergy,diffuse : single; -begin - {$IFDEF BGRASSE_AVAILABLE}If UseSSE then - begin - with Context^ do - begin - {$IFDEF PARAM_POINTLIGHT} - vL := FVertex.ViewCoord_128; - vH := FViewVector; - {$ELSE} - vL := FDirection; - vH := FBetweenDirectionAndObserver; - {$ENDIF} - end; - if UseSSE3 then - begin - {$DEFINE PARAM_USESSE3} - {$i phonglightsse.inc} - {$UNDEF PARAM_USESSE3} - end else - begin - {$i phonglightsse.inc} - end; - end else - {$ENDIF} - with Context^ do - begin - {$IFDEF PARAM_POINTLIGHT} - vL := FVertex.ViewCoord_128 - basic.Position; - Normalize3D_128_SqLen(vL, dist2); - //compute bisector of angle between light and observer - vH := vL + FViewVector; - Normalize3D_128(vH); - //Calculate LdotN and NnH - LdotN := DotProduct3D_128(basic.Normal, vL); - NdotH := DotProduct3D_128(basic.Normal, vH); - {$ELSE} - LdotN := DotProduct3D_128(basic.Normal, FDirection); - NdotH := DotProduct3D_128(basic.Normal, FBetweenDirectionAndObserver); - {$ENDIF} - end; - - {$IFDEF PARAM_POINTLIGHT} - if dist2 = 0 then - lightEnergy := 0 - else - lightEnergy := FIntensity / dist2; - diffuse := LdotN*lightEnergy; - {$ELSE} - lightEnergy := 1; - diffuse := LdotN; - {$ENDIF} - if diffuse < FMinIntensity then diffuse:= FMinIntensity; - - if Context^.LightThrough and (diffuse < 0) then diffuse := -diffuse*Context^.LightThroughFactor; - TBGRAMaterial3D(Context^.material).ComputeDiffuseAndSpecularColor(Context, diffuse, lightEnergy, NdotH, FColorInt); -end; - -{$UNDEF PARAM_POINTLIGHT} diff --git a/components/bgrabitmap/phonglightsse.inc b/components/bgrabitmap/phonglightsse.inc deleted file mode 100644 index 6e2bc7a..0000000 --- a/components/bgrabitmap/phonglightsse.inc +++ /dev/null @@ -1,105 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception - {$asmmode intel} - asm - {$ifdef cpux86_64} - mov rax, Context - movaps xmm0,[rax+160] //Context^.vL - movaps xmm2,[rax+192] //Context^.vH - movaps xmm1,[rax+16] //Context^.Normal - {$else} - mov eax, Context - movaps xmm0,[eax+160] //Context^.vL - movaps xmm2,[eax+192] //Context^.vH - movaps xmm1,[eax+16] //Context^.Normal - {$endif} - - {$IFDEF PARAM_POINTLIGHT} - {$ifdef cpux86_64} - movaps xmm6,[rax+0] //Context^.Position - {$else} - movaps xmm6,[eax+0] //Context^.Position - {$endif} - subps xmm0,xmm6 //xmm0 = vL - movaps xmm6, xmm0 - mulps xmm6, xmm6 - - {$IFDEF PARAM_USESSE3} - haddps xmm6,xmm6 - haddps xmm6,xmm6 - {$ELSE} - //mix1 - movaps xmm7, xmm6 - shufps xmm7, xmm7, $4e - addps xmm6, xmm7 - //mix2 - movaps xmm7, xmm6 - shufps xmm7, xmm7, $11 - addps xmm6, xmm7 - {$ENDIF} - - movss dist2, xmm6 //dist2 := vL*vL; - - rsqrtps xmm6, xmm6 - mulps xmm0, xmm6 //xmm0 = normalized vL - {$ENDIF} - - {$IFDEF PARAM_POINTLIGHT} - addps xmm2,xmm0 //vH += normalized vL - movaps xmm6, xmm2 - mulps xmm2, xmm2 - - {$IFDEF PARAM_USESSE3} - haddps xmm2,xmm2 - haddps xmm2,xmm2 - {$ELSE} - //mix1 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $4e - addps xmm2, xmm7 - //mix2 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $11 - addps xmm2, xmm7 - {$ENDIF} - - rsqrtps xmm2, xmm2 - mulps xmm2, xmm6 //xmm2 = normalized vH - {$ENDIF} - - //vL*Normal - mulps xmm0, xmm1 - //vH*Normal - mulps xmm2, xmm1 - - {$IFDEF PARAM_USESSE3} - haddps xmm0,xmm0 - haddps xmm0,xmm0 - {$ELSE} - //mix1 - movaps xmm7, xmm0 - shufps xmm7, xmm7, $4e - addps xmm0, xmm7 - //mix2 - movaps xmm7, xmm0 - shufps xmm7, xmm7, $11 - addps xmm0, xmm7 - {$ENDIF} - - {$IFDEF PARAM_USESSE3} - haddps xmm2,xmm2 - haddps xmm2,xmm2 - {$ELSE} - //mix1 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $4e - addps xmm2, xmm7 - //mix2 - movaps xmm7, xmm2 - shufps xmm7, xmm7, $11 - addps xmm2, xmm7 - {$ENDIF} - - movss LdotN, xmm0 - movss NdotH, xmm2 - end; - diff --git a/components/bgrabitmap/polyaliaspersp.inc b/components/bgrabitmap/polyaliaspersp.inc deleted file mode 100644 index d20daec..0000000 --- a/components/bgrabitmap/polyaliaspersp.inc +++ /dev/null @@ -1,605 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{*****************************************TEXTURE WITHOUT SHADING *********************************} -{with shading: second part of this file} - -{ TPolygonPerspectiveTextureMappingInfo } - -procedure TPolygonPerspectiveTextureMappingInfo.SetIntersectionValues( - AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; - dy: single; AData: pointer); -var info: PPerspectiveTextureInfo; -begin - AInter.SetValues(AInterX,AWinding,ANumSegment); - info := PPerspectiveTextureInfo(AData); - TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ; - TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy; - if FLightnesses<>nil then - TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy) - else - TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := 32768; -end; - -constructor TPolygonPerspectiveTextureMappingInfo.Create( - const points: array of TPointF; const pointsZ: array of single; - const texCoords: array of TPointF); -var - i: Integer; - lPoints: array of TPointF; - nbP: integer; -begin - if (length(texCoords) <> length(points)) or (length(pointsZ) <> length(points)) then - raise Exception.Create('Dimensions mismatch'); - - setlength(lPoints, length(points)); - SetLength(FTexCoords, length(points)); - SetLength(FPointsZ, length(points)); - nbP := 0; - for i := 0 to high(points) do - if (i=0) or (points[i].x<>points[i-1].X) or (points[i].y<>points[i-1].y) then - begin - lPoints[nbP] := points[i]; - FTexCoords[nbP] := texCoords[i]; - FPointsZ[nbP] := abs(pointsZ[i]); - inc(nbP); - end; - if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); - setlength(lPoints, nbP); - SetLength(FTexCoords, nbP); - SetLength(FPointsZ, nbP); - - inherited Create(lPoints); -end; - -constructor TPolygonPerspectiveTextureMappingInfo.Create( - const points: array of TPointF; const pointsZ: array of single; - const texCoords: array of TPointF; const lightnesses: array of word); -var - i: Integer; - lPoints: array of TPointF; - nbP: integer; -begin - if (length(texCoords) <> length(points)) or (length(pointsZ) <> length(points)) or - (length(lightnesses) <> length(points)) then - raise Exception.Create('Dimensions mismatch'); - - setlength(lPoints, length(points)); - SetLength(FTexCoords, length(points)); - SetLength(FPointsZ, length(points)); - setLength(FLightnesses, length(points)); - nbP := 0; - for i := 0 to high(points) do - if (i=0) or (points[i].x<>points[i-1].X) or (points[i].y<>points[i-1].y) then - begin - lPoints[nbP] := points[i]; - FTexCoords[nbP] := texCoords[i]; - FPointsZ[nbP] := abs(pointsZ[i]); - FLightnesses[nbP] := lightnesses[i]; - inc(nbP); - end; - if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); - setlength(lPoints, nbP); - SetLength(FTexCoords, nbP); - SetLength(FPointsZ, nbP); - SetLength(FLightnesses, nbP); - - inherited Create(lPoints); -end; - -{$hints off} - -function TPolygonPerspectiveTextureMappingInfo.CreateSegmentData(numPt, nextPt: integer; - ASeg: PCustomPointRecord): pointer; -var - info: PPerspectiveTextureInfo; - ty: single; - CurInvZ,NextInvZ: single; - CurTexCoordDivByZ: TPointF; - NextTexCoordDivByZ: TPointF; -begin - New(info); - ty := ASeg^.y2-ASeg^.y; - CurInvZ := 1/FPointsZ[numPt]; - CurTexCoordDivByZ := FTexCoords[numPt]*CurInvZ; - NextInvZ := 1/FPointsZ[nextPt]; - NextTexCoordDivByZ := FTexCoords[nextPt]*NextInvZ; - info^.TexCoordDivByZSlopes := (NextTexCoordDivByZ - CurTexCoordDivByZ)*(1/ty); - info^.TexCoordDivByZ := CurTexCoordDivByZ; - info^.InvZSlope := (NextInvZ-CurInvZ)/ty; - info^.InvZ := CurInvZ; - if FLightnesses <> nil then - begin - info^.lightnessSlope := (FLightnesses[nextPt] - FLightnesses[numPt])*(1/ty); - info^.lightness := FLightnesses[numPt]; - end else - begin - info^.lightness := 32768; - info^.lightnessSlope := 0; - end; - Result:= info; -end; -{$hints on} - -function TPolygonPerspectiveTextureMappingInfo.CreateIntersectionInfo: TIntersectionInfo; -begin - Result:= TPerspectiveTextureMappingIntersectionInfo.Create; -end; - -{$hints off} -procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; - polyInfo: TPolygonPerspectiveTextureMappingInfo; texture: IBGRAScanner; - TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle); -var - inter: array of TIntersectionInfo; - nbInter: integer; - - scanAtFunc: TScanAtFunction; - scanAtIntegerFunc: TScanAtIntegerFunction; - - procedure DrawTextureLineWithoutLight(yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$i perspectivescan.inc} - - procedure DrawTextureLineWithLight(yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USELIGHTING} - {$i perspectivescan.inc} - - procedure DrawTextureLineWithoutLightZBuffer(yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USEZBUFFER} - {$i perspectivescan.inc} - - procedure DrawTextureLineWithLightZBuffer(yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USEZBUFFER} - {$define PARAM_USELIGHTING} - {$i perspectivescan.inc} - -var - miny, maxy, minx, maxx: integer; - - yb, i : integer; - x1, x2: single; - - ix1, ix2: integer; - -begin - If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; - - inter := polyInfo.CreateIntersectionArray; - scanAtFunc := @texture.ScanAt; - scanAtIntegerFunc := @texture.ScanAtInteger; - - if zbuffer = nil then - begin - //vertical scan - for yb := miny to maxy do - begin - //find intersections - polyInfo.ComputeAndSort(yb,inter,nbInter,NonZeroWinding); - - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX; - x2 := inter[i + i+ 1].interX; - - if x1 <> x2 then - begin - ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); - if ix1 <= ix2 then - begin - if (TPerspectiveTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and - (TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then - DrawTextureLineWithoutLight(yb,ix1,ix2, - TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), - TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), - TextureInterpolation) - else - DrawTextureLineWithLight(yb,ix1,ix2, - TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), - TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), - TextureInterpolation); - end; - end; - end; - end; - end else - begin - //vertical scan - for yb := miny to maxy do - begin - //find intersections - polyInfo.ComputeAndSort(yb,inter,nbInter,NonZeroWinding); - - for i := 0 to nbinter div 2 - 1 do - begin - x1 := inter[i + i].interX; - x2 := inter[i + i+ 1].interX; - - if x1 <> x2 then - begin - ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); - if ix1 <= ix2 then - begin - if (TPerspectiveTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and - (TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then - DrawTextureLineWithoutLightZBuffer(yb,ix1,ix2, - TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), - TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), - TextureInterpolation) - else - DrawTextureLineWithLightZBuffer(yb,ix1,ix2, - TPerspectiveTextureMappingIntersectionInfo(inter[i+i]), - TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]), - TextureInterpolation); - end; - end; - end; - end; - end; - - polyInfo.FreeIntersectionArray(inter); - bmp.InvalidateBitmap; -end; -{$hints on} - -procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; - const points: array of TPointF; const pointsZ: array of single; - texture: IBGRAScanner; const texCoords: array of TPointF; - TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle); -var polyInfo: TPolygonPerspectiveTextureMappingInfo; -begin - polyInfo := TPolygonPerspectiveTextureMappingInfo.Create(points,pointsZ,texCoords); - PolygonPerspectiveTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation, NonZeroWinding, zbuffer); - polyInfo.Free; -end; - -procedure PolygonPerspectiveTextureMappingAliasedWithLightness( - bmp: TBGRACustomBitmap; const points: array of TPointF; - const pointsZ: array of single; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; - lightnesses: array of word; NonZeroWinding: boolean; zbuffer: psingle); -var polyInfo: TPolygonPerspectiveTextureMappingInfo; -begin - polyInfo := TPolygonPerspectiveTextureMappingInfo.Create(points,pointsZ,texCoords,lightnesses); - PolygonPerspectiveTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation, NonZeroWinding, zbuffer); - polyInfo.Free; -end; - -{****************************************** WITH SHADING ******************************************} - -{$hints off} -procedure PolygonPerspectiveMappingShaderAliased_DrawTextureLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USESHADER} - {$i perspectivescan.inc} - -procedure PolygonPerspectiveMappingShaderAliased_DrawSolidColorLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USESOLIDCOLOR} - {$define PARAM_USESHADER} - {$i perspectivescan.inc} - -procedure PolygonPerspectiveMappingShaderAliased_DrawTextureLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USESHADER} - {$define PARAM_USEZBUFFER} - {$i perspectivescan.inc} - -procedure PolygonPerspectiveMappingShaderAliased_DrawSolidColorLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USESOLIDCOLOR} - {$define PARAM_USESHADER} - {$define PARAM_USEZBUFFER} - {$i perspectivescan.inc} - -procedure PolygonPerspectiveMappingAliased_DrawTextureLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$i perspectivescan.inc} - -procedure PolygonPerspectiveMappingAliased_DrawSolidColorLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USESOLIDCOLOR} - {$i perspectivescan.inc} - -procedure PolygonPerspectiveMappingAliased_DrawTextureLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USEZBUFFER} - {$i perspectivescan.inc} - -procedure PolygonPerspectiveMappingAliased_DrawSolidColorLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - {$define PARAM_USESOLIDCOLOR} - {$define PARAM_USEZBUFFER} - {$i perspectivescan.inc} -{$hints on} - -{$hints off} -procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; - polyInfo: TPolygonPerspectiveMappingShaderInfo; texture: IBGRAScanner; - TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; - NonZeroWinding: boolean; solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext); -var - inter: array of TIntersectionInfo; - nbInter: integer; - - scanAtFunc: TScanAtFunction; - scanAtIntegerFunc: TScanAtIntegerFunction; - - drawFunc : procedure(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext; - solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle; - yb: integer; ix1: integer; ix2: integer; - info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean); - -var - miny, maxy, minx, maxx: integer; - - yb, i : integer; - x1, x2: single; - - ix1, ix2: integer; - shaderContextMem: TMemoryBlockAlign128; - shaderContextPtr: PBasicLightingContext; - - inter1,inter2: TPerspectiveTextureMappingIntersectionInfo; - -begin - If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit; - - inter := polyInfo.CreateIntersectionArray; - - if texture <> nil then - begin - scanAtFunc := @texture.ScanAt; - scanAtIntegerFunc := @texture.ScanAtInteger; - end else - begin - scanAtFunc := nil; - scanAtIntegerFunc := nil; - end; - - shaderContextMem := nil; - shaderContextPtr := nil; - - if ShaderFunction <> nil then - begin - if ShaderContext = nil then - begin - shaderContextMem := TMemoryBlockAlign128.Create(sizeof(TBasicLightingContext)); - shaderContextPtr := PBasicLightingContext( shaderContextMem.Data); - end - else - shaderContextPtr := shaderContext; - if texture <> nil then - begin - if zbuffer = nil then - drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawTextureLine - else - drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawTextureLineZBuffer; - end - else - begin - if zbuffer = nil then - drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawSolidColorLine - else - drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawSolidColorLineZBuffer; - end; - end else - begin - if texture <> nil then - begin - if zbuffer = nil then - drawFunc := @PolygonPerspectiveMappingAliased_DrawTextureLine - else - drawFunc := @PolygonPerspectiveMappingAliased_DrawTextureLineZBuffer; - end - else - begin - if zbuffer = nil then - drawFunc := @PolygonPerspectiveMappingAliased_DrawSolidColorLine - else - drawFunc := @PolygonPerspectiveMappingAliased_DrawSolidColorLineZBuffer; - end; - end; - - //vertical scan - for yb := miny to maxy do - begin - //find intersections - polyInfo.ComputeAndSort(yb,inter,nbInter,NonZeroWinding); - - for i := 0 to nbinter div 2 - 1 do - begin - inter1 := TPerspectiveTextureMappingIntersectionInfo(inter[i+i]); - inter2 := TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]); - x1 := inter1.interX; - x2 := inter2.interX; - - if x1 <> x2 then - begin - ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2); - if ix1 <= ix2 then - begin - drawFunc(bmp,ShaderFunction,shaderContextPtr, - solidColor,scanAtFunc,scanAtIntegerFunc,zbuffer, - yb,ix1,ix2, - inter1,inter2,TextureInterpolation); - end; - end; - end; - end; - - polyInfo.FreeIntersectionArray(inter); - bmp.InvalidateBitmap; - shaderContextMem.Free; -end; -{$hints on} - -procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; - const points: array of TPointF; const points3D: array of TPoint3D; - const normals: array of TPoint3D; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; - ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext); -var polyInfo: TPolygonPerspectiveMappingShaderInfo; -begin - polyInfo := TPolygonPerspectiveMappingShaderInfo.Create(points,points3D,normals,texCoords); - PolygonPerspectiveMappingShaderAliased(bmp,polyInfo,texture,TextureInterpolation, ShaderFunction, NonZeroWinding, solidColor, zbuffer, ShaderContext); - polyInfo.Free; -end; - -procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; - const points: array of TPointF; const points3D: array of TPoint3D_128; - const normals: array of TPoint3D_128; texture: IBGRAScanner; - const texCoords: array of TPointF; TextureInterpolation: Boolean; - ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; - solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext); -var polyInfo: TPolygonPerspectiveMappingShaderInfo; -begin - polyInfo := TPolygonPerspectiveMappingShaderInfo.Create(points,points3D,normals,texCoords); - PolygonPerspectiveMappingShaderAliased(bmp,polyInfo,texture,TextureInterpolation, ShaderFunction, NonZeroWinding, solidColor, zbuffer, ShaderContext); - polyInfo.Free; -end; - -{ TPolygonPerspectiveMappingShaderInfo } - -procedure TPolygonPerspectiveMappingShaderInfo.SetIntersectionValues( - AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; - dy: single; AData: pointer); -var info : PPerspectiveTextureInfo; -begin - AInter.SetValues(AInterX,AWinding,ANumSegment); - info := PPerspectiveTextureInfo(AData); - TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ; - TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy; - TPerspectiveTextureMappingIntersectionInfo(AInter).Position3D := info^.Position3D + info^.Position3DSlope*dy; - TPerspectiveTextureMappingIntersectionInfo(AInter).Normal3D := info^.Normal3D + info^.Normal3DSlope*dy; -end; - -constructor TPolygonPerspectiveMappingShaderInfo.Create( - const points: array of TPointF; const points3D: array of TPoint3D; - const normals: array of TPoint3D; const texCoords: array of TPointF); -var - i: Integer; - lPoints: array of TPointF; - nbP: integer; -begin - if (length(texCoords) <> length(points)) or (length(points3D) <> length(points)) or (length(normals) <> length(points)) then - raise Exception.Create('Dimensions mismatch'); - - setlength(lPoints, length(points)); - SetLength(FTexCoords, length(points)); - SetLength(FPositions3D, length(points)); - SetLength(FNormals3D, length(points)); - nbP := 0; - for i := 0 to high(points) do - if (i=0) or (points[i]<>points[i-1]) then - begin - lPoints[nbP] := points[i]; - FTexCoords[nbP] := texCoords[i]; - FPositions3D[nbP] := Point3D_128(points3D[i]); - FNormals3D[nbP] := Point3D_128(normals[i]); - inc(nbP); - end; - if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); - setlength(lPoints, nbP); - SetLength(FTexCoords, nbP); - SetLength(FPositions3D, nbP); - SetLength(FNormals3D, nbP); - - inherited Create(lPoints); -end; - -constructor TPolygonPerspectiveMappingShaderInfo.Create( - const points: array of TPointF; const points3D: array of TPoint3D_128; - const normals: array of TPoint3D_128; const texCoords: array of TPointF); -var - i: Integer; - lPoints: array of TPointF; - nbP: integer; -begin - if (length(texCoords) <> length(points)) or (length(points3D) <> length(points)) or (length(normals) <> length(points)) then - raise Exception.Create('Dimensions mismatch'); - - setlength(lPoints, length(points)); - SetLength(FTexCoords, length(points)); - SetLength(FPositions3D, length(points)); - SetLength(FNormals3D, length(points)); - nbP := 0; - for i := 0 to high(points) do - if (i=0) or (points[i]<>points[i-1]) then - begin - lPoints[nbP] := points[i]; - FTexCoords[nbP] := texCoords[i]; - FPositions3D[nbP] := points3D[i]; - FNormals3D[nbP] := normals[i]; - inc(nbP); - end; - if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP); - setlength(lPoints, nbP); - SetLength(FTexCoords, nbP); - SetLength(FPositions3D, nbP); - SetLength(FNormals3D, nbP); - - inherited Create(lPoints); -end; - -{$hints off} -function TPolygonPerspectiveMappingShaderInfo.CreateSegmentData(numPt, nextPt: integer; - ASeg: PCustomPointRecord): pointer; -var - info: PPerspectiveTextureInfo; - ty: single; - CurInvZ,NextInvZ: single; - CurTexCoordDivByZ: TPointF; - NextTexCoordDivByZ: TPointF; - - Cur3DDivByZ,Next3DDivByZ: TPoint3D_128; -begin - New(info); - ty := ASeg^.y2-ASeg^.y; - CurInvZ := FPositions3D[numPt].z; - if CurInvZ = 0 then CurInvZ := 1 else CurInvZ := 1/CurInvZ; - CurTexCoordDivByZ := FTexCoords[numPt]*CurInvZ; - NextInvZ := FPositions3D[nextPt].z; - if NextInvZ = 0 then NextInvZ := 1 else NextInvZ := 1/NextInvZ; - NextTexCoordDivByZ := FTexCoords[nextPt]*NextInvZ; - info^.TexCoordDivByZSlopes := (NextTexCoordDivByZ - CurTexCoordDivByZ)*(1/ty); - info^.TexCoordDivByZ := CurTexCoordDivByZ; - info^.InvZSlope := (NextInvZ-CurInvZ)/ty; - info^.InvZ := CurInvZ; - - Cur3DDivByZ := FPositions3D[numPt]*CurInvZ; - Next3DDivByZ := FPositions3D[nextPt]*NextInvZ; - info^.Position3DSlope := (Next3DDivByZ - Cur3DDivByZ)*(1/ty); - info^.Position3D := Cur3DDivByZ; - - Cur3DDivByZ := FNormals3D[numPt]*CurInvZ; - Next3DDivByZ := FNormals3D[nextPt]*NextInvZ; - info^.Normal3DSlope := (Next3DDivByZ - Cur3DDivByZ)*(1/ty); - info^.Normal3D := Cur3DDivByZ; - - Result:= info; -end; -{$hints on} - -function TPolygonPerspectiveMappingShaderInfo.CreateIntersectionInfo: TIntersectionInfo; -begin - Result:= TPerspectiveTextureMappingIntersectionInfo.Create; -end; - diff --git a/components/bgrabitmap/readme.txt b/components/bgrabitmap/readme.txt deleted file mode 100644 index d184ada..0000000 --- a/components/bgrabitmap/readme.txt +++ /dev/null @@ -1,10 +0,0 @@ -BGRABitmap - Drawing routines with transparency and antialiasing with Lazarus. Offers also various transforms. - -These routines allow to manipulate 32bit images in BGRA format or RGBA format (depending on the platform). - -This code is under modified LGPL (see COPYING.modifiedLGPL.txt). This means that you can link this library inside your programs for any purpose. Only the included part of the code must remain LGPL. - -If you make some improvements to this library, please notify here: -http://www.lazarus.freepascal.org/index.php/topic,12037.0.html - -Contact : circular at operamail.com \ No newline at end of file diff --git a/components/bgrabitmap/shapes3d.inc b/components/bgrabitmap/shapes3d.inc deleted file mode 100644 index 04bdd0d..0000000 --- a/components/bgrabitmap/shapes3d.inc +++ /dev/null @@ -1,79 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -type - - { TBGRASphere3D } - - TBGRASphere3D = class(TBGRAObject3D) - constructor Create(AScene: TBGRAScene3D; ARadius: single; HorizPrecision: integer = 8; VerticalPrecision : integer = 6; HalfSphere: boolean = false); - end; - -{ TBGRASphere3D } - -constructor TBGRASphere3D.Create(AScene: TBGRAScene3D; ARadius: single; HorizPrecision: integer; VerticalPrecision : integer; HalfSphere: boolean); -var prevAlpha,prevBeta,alpha,beta,NbAlpha,NbBeta: integer; - sinBeta,cosBeta: single; - sinAlpha,cosAlpha: single; - v: IBGRAPart3D; - vTop,vBottom: IBGRAVertex3D; - alphaFactor: single; - startAlpha: integer; -begin - inherited Create(AScene); - NbAlpha := HorizPrecision; - if NbAlpha < 4 then NbAlpha := 4; - NbBeta := VerticalPrecision-1; - if NbBeta < 2 then NbBeta := 2; - v := GetMainPart; - - - if halfSphere then - alphaFactor := Pi/(NbAlpha-1) - else - alphaFactor := (2*Pi)/NbAlpha; - - for beta := 1 to NbBeta-1 do - begin - sinBeta := sin(beta*Pi/NbBeta); - cosBeta := -cos(beta*Pi/NbBeta); - for alpha := 0 to NbAlpha-1 do - begin - sinAlpha := -sin(alpha*alphaFactor); - cosAlpha := -cos(alpha*alphaFactor); - v.Add( cosAlpha*sinBeta*ARadius, cosBeta*ARadius, sinAlpha*sinBeta*ARadius ); - end; - end; - - if halfSphere then - startAlpha := 1 - else - startAlpha := 0; - - vTop := v.Add(0,-ARadius,0); - prevAlpha := (startAlpha+NbAlpha-1) mod NbAlpha; - for alpha := startAlpha to NbAlpha-1 do - begin - AddFace( [v.Vertex[prevAlpha], vTop, v.Vertex[alpha]], HalfSphere ); - prevAlpha := alpha; - end; - - prevBeta := 0; - for beta := 1 to NbBeta-2 do - begin - prevAlpha := (startAlpha+NbAlpha-1) mod NbAlpha; - for alpha := startAlpha to NbAlpha-1 do - begin - AddFace( [v.Vertex[prevAlpha + prevBeta*NbAlpha], v.Vertex[alpha + prevBeta*NbAlpha], - v.Vertex[alpha + beta*NbAlpha], v.Vertex[prevAlpha + beta*NbAlpha]], HalfSphere ); - prevAlpha := alpha; - end; - prevBeta := beta; - end; - - vBottom := v.Add(0,ARadius,0); - prevAlpha := (startAlpha+NbAlpha-1) mod NbAlpha; - for alpha := startAlpha to NbAlpha-1 do - begin - AddFace( [v.Vertex[prevAlpha + prevBeta*NbAlpha], v.Vertex[alpha + prevBeta*NbAlpha], vBottom], HalfSphere ); - prevAlpha := alpha; - end; -end; diff --git a/components/bgrabitmap/spectraldata.inc b/components/bgrabitmap/spectraldata.inc deleted file mode 100644 index d464275..0000000 --- a/components/bgrabitmap/spectraldata.inc +++ /dev/null @@ -1,197 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -const //horseshoe shape of visible colors at 2° (illuminant E) - SpectralLocus: array[0..94] of TSpectralLocusPoint = - ((W:360; X:0.0001299; Y:0.000003917; Z:0.0006061), - (W:365; X:0.0002321; Y:0.000006965; Z:0.001086), - (W:370; X:0.0004149; Y:0.00001239; Z:0.001946), - (W:375; X:0.0007416; Y:0.00002202; Z:0.003486), - (W:380; X:0.001368; Y:0.000039; Z:0.006450001), - (W:385; X:0.002236; Y:0.000064; Z:0.01054999), - (W:390; X:0.004243; Y:0.00012; Z:0.02005001), - (W:395; X:0.00765; Y:0.000217; Z:0.03621), - (W:400; X:0.01431; Y:0.000396; Z:0.06785001), - (W:405; X:0.02319; Y:0.00064; Z:0.1102), - (W:410; X:0.04351; Y:0.00121; Z:0.2074), - (W:415; X:0.07763; Y:0.00218; Z:0.3713), - (W:420; X:0.13438; Y:0.004; Z:0.6456), - (W:425; X:0.21477; Y:0.0073; Z:1.0390501), - (W:430; X:0.2839; Y:0.0116; Z:1.3856), - (W:435; X:0.3285; Y:0.01684; Z:1.62296), - (W:440; X:0.34828; Y:0.023; Z:1.74706), - (W:445; X:0.34806; Y:0.0298; Z:1.7826), - (W:450; X:0.3362; Y:0.038; Z:1.77211), - (W:455; X:0.3187; Y:0.048; Z:1.7441), - (W:460; X:0.2908; Y:0.06; Z:1.6692), - (W:465; X:0.2511; Y:0.0739; Z:1.5281), - (W:470; X:0.19536; Y:0.09098; Z:1.28764), - (W:475; X:0.1421; Y:0.1126; Z:1.0419), - (W:480; X:0.09564; Y:0.13902; Z:0.8129501), - (W:485; X:0.05795001; Y:0.1693; Z:0.6162), - (W:490; X:0.03201; Y:0.20802; Z:0.46518), - (W:495; X:0.0147; Y:0.2586; Z:0.3533), - (W:500; X:0.0049; Y:0.323; Z:0.272), - (W:505; X:0.0024; Y:0.4073; Z:0.2123), - (W:510; X:0.0093; Y:0.503; Z:0.1582), - (W:515; X:0.0291; Y:0.6082; Z:0.1117), - (W:520; X:0.06327; Y:0.71; Z:0.07824999), - (W:525; X:0.1096; Y:0.7932; Z:0.05725001), - (W:530; X:0.1655; Y:0.862; Z:0.04216), - (W:535; X:0.2257499; Y:0.9148501; Z:0.02984), - (W:540; X:0.2904; Y:0.954; Z:0.0203), - (W:545; X:0.3597; Y:0.9803; Z:0.0134), - (W:550; X:0.4334499; Y:0.9949501; Z:0.008749999), - (W:555; X:0.5120501; Y:1; Z:0.005749999), - (W:560; X:0.5945; Y:0.995; Z:0.0039), - (W:565; X:0.6784; Y:0.9786; Z:0.002749999), - (W:570; X:0.7621; Y:0.952; Z:0.0021), - (W:575; X:0.8425; Y:0.9154; Z:0.0018), - (W:580; X:0.9163; Y:0.87; Z:0.001650001), - (W:585; X:0.9786; Y:0.8163; Z:0.0014), - (W:590; X:1.0263; Y:0.757; Z:0.0011), - (W:595; X:1.0567; Y:0.6949; Z:0.001), - (W:600; X:1.0622; Y:0.631; Z:0.0008), - (W:605; X:1.0456; Y:0.5668; Z:0.0006), - (W:610; X:1.0026; Y:0.503; Z:0.00034), - (W:615; X:0.9384; Y:0.4412; Z:0.00024), - (W:620; X:0.8544499; Y:0.381; Z:0.00019), - (W:625; X:0.7514; Y:0.321; Z:0.0001), - (W:630; X:0.6424; Y:0.265; Z:0.00005), - (W:635; X:0.5419; Y:0.217; Z:0.00003), - (W:640; X:0.4479; Y:0.175; Z:0.00002), - (W:645; X:0.3608; Y:0.1382; Z:0.00001), - (W:650; X:0.2835; Y:0.107; Z:0), - (W:655; X:0.2187; Y:0.0816; Z:0), - (W:660; X:0.1649; Y:0.061; Z:0), - (W:665; X:0.1212; Y:0.04458; Z:0), - (W:670; X:0.0874; Y:0.032; Z:0), - (W:675; X:0.0636; Y:0.0232; Z:0), - (W:680; X:0.04677; Y:0.017; Z:0), - (W:685; X:0.0329; Y:0.01192; Z:0), - (W:690; X:0.0227; Y:0.00821; Z:0), - (W:695; X:0.01584; Y:0.005723; Z:0), - (W:700; X:0.01135916; Y:0.004102; Z:0), - (W:705; X:0.008110916; Y:0.002929; Z:0), - (W:710; X:0.005790346; Y:0.002091; Z:0), - (W:715; X:0.004106457; Y:0.001484; Z:0), - (W:720; X:0.002899327; Y:0.001047; Z:0), - (W:725; X:0.00204919; Y:0.00074; Z:0), - (W:730; X:0.001439971; Y:0.00052; Z:0), - (W:735; X:0.0009999493; Y:0.0003611; Z:0), - (W:740; X:0.0006900786; Y:0.0002492; Z:0), - (W:745; X:0.0004760213; Y:0.0001719; Z:0), - (W:750; X:0.0003323011; Y:0.00012; Z:0), - (W:755; X:0.0002348261; Y:0.0000848; Z:0), - (W:760; X:0.0001661505; Y:0.00006; Z:0), - (W:765; X:0.000117413; Y:0.0000424; Z:0), - (W:770; X:8.307527E-05; Y:0.00003; Z:0), - (W:775; X:5.870652E-05; Y:0.0000212; Z:0), - (W:780; X:4.150994E-05; Y:0.00001499; Z:0), - (W:785; X:2.935326E-05; Y:0.0000106; Z:0), - (W:790; X:2.067383E-05; Y:7.4657E-06; Z:0), - (W:795; X:1.455977E-05; Y:5.2578E-06; Z:0), - (W:800; X:0.000010254; Y:3.7029E-06; Z:0), - (W:805; X:7.221456E-06; Y:2.6078E-06; Z:0), - (W:810; X:5.085868E-06; Y:1.8366E-06; Z:0), - (W:815; X:3.581652E-06; Y:1.2934E-06; Z:0), - (W:820; X:2.522525E-06; Y:9.1093E-07; Z:0), - (W:825; X:1.776509E-06; Y:6.4153E-07; Z:0), - (W:830; X:1.251141E-06; Y:4.5181E-07; Z:0)); - -const //D65 illuminant - IlluminantSpectrumD65: array[0..94] of TIlluminantSpectrumPoint = - ((W:360; Y:46.6383), - (W:365; Y:49.3637), - (W:370; Y:52.0891), - (W:375; Y:51.0323), - (W:380; Y:49.9755), - (W:385; Y:52.3118), - (W:390; Y:54.6482), - (W:395; Y:68.7015), - (W:400; Y:82.7549), - (W:405; Y:87.1204), - (W:410; Y:91.486), - (W:415; Y:92.4589), - (W:420; Y:93.4318), - (W:425; Y:90.057), - (W:430; Y:86.6823), - (W:435; Y:95.7736), - (W:440; Y:104.865), - (W:445; Y:110.936), - (W:450; Y:117.008), - (W:455; Y:117.41), - (W:460; Y:117.812), - (W:465; Y:116.336), - (W:470; Y:114.861), - (W:475; Y:115.392), - (W:480; Y:115.923), - (W:485; Y:112.367), - (W:490; Y:108.811), - (W:495; Y:109.082), - (W:500; Y:109.354), - (W:505; Y:108.578), - (W:510; Y:107.802), - (W:515; Y:106.296), - (W:520; Y:104.79), - (W:525; Y:106.239), - (W:530; Y:107.689), - (W:535; Y:106.047), - (W:540; Y:104.405), - (W:545; Y:104.225), - (W:550; Y:104.046), - (W:555; Y:102.023), - (W:560; Y:100), - (W:565; Y:98.1671), - (W:570; Y:96.3342), - (W:575; Y:96.0611), - (W:580; Y:95.788), - (W:585; Y:92.2368), - (W:590; Y:88.6856), - (W:595; Y:89.3459), - (W:600; Y:90.0062), - (W:605; Y:89.8026), - (W:610; Y:89.5991), - (W:615; Y:88.6489), - (W:620; Y:87.6987), - (W:625; Y:85.4936), - (W:630; Y:83.2886), - (W:635; Y:83.4939), - (W:640; Y:83.6992), - (W:645; Y:81.863), - (W:650; Y:80.0268), - (W:655; Y:80.1207), - (W:660; Y:80.2146), - (W:665; Y:81.2462), - (W:670; Y:82.2778), - (W:675; Y:80.281), - (W:680; Y:78.2842), - (W:685; Y:74.0027), - (W:690; Y:69.7213), - (W:695; Y:70.6652), - (W:700; Y:71.6091), - (W:705; Y:72.979), - (W:710; Y:74.349), - (W:715; Y:67.9765), - (W:720; Y:61.604), - (W:725; Y:65.7448), - (W:730; Y:69.8856), - (W:735; Y:72.4863), - (W:740; Y:75.087), - (W:745; Y:69.3398), - (W:750; Y:63.5927), - (W:755; Y:55.0054), - (W:760; Y:46.4182), - (W:765; Y:56.6118), - (W:770; Y:66.8054), - (W:775; Y:65.0941), - (W:780; Y:63.3828), - (W:785; Y:63.8434), - (W:790; Y:64.304), - (W:795; Y:61.8779), - (W:800; Y:59.4519), - (W:805; Y:55.7054), - (W:810; Y:51.959), - (W:815; Y:54.6998), - (W:820; Y:57.4406), - (W:825; Y:58.8765), - (W:830; Y:60.3125)); - diff --git a/components/bgrabitmap/unibitmap.inc b/components/bgrabitmap/unibitmap.inc deleted file mode 100644 index dbdc23b..0000000 --- a/components/bgrabitmap/unibitmap.inc +++ /dev/null @@ -1,3995 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} - -type - { Working area to be provided to a brush } - PUniBrushContext = ^TUniBrushContext; - TUniBrushContext = record - Dest: Pointer; //target pixels - Ofs: TPoint; //offset within image (used with textured/gradient brush) - Custom: array[0..15] of byte; //custom context information - end; - - { Additional initialization of the brush context (optional) } - TUniBrushInitContextProc = procedure - (AFixedData: Pointer; //address of brush fixed data - AContextData: PUniBrushContext); //address of brush contextual data - - { Outputs pixels from current position defined in context } - TUniBrushPutNextPixelsProc = procedure - (AFixedData: Pointer; //address of brush data - AContextData: PUniBrushContext; //address of brush contextual data - AAlpha: Word; //global alpha modifier (0 to draw nothing, - // 65535 to draw without opacity adjustment) - ACount: integer); //number of pixels to output - -const - UniversalBrushFlag_DoNothing = 1; //the brush does nothing at all and can be skipped - UniversalBrushFlag_Reserved1 = 2; - UniversalBrushFlag_Reserved2 = 4; - UniversalBrushFlag_Reserved3 = 8; - UniversalBrushFlag_Reserved4 = 16; - UniversalBrushFlag_Reserved5 = 32; - UniversalBrushFlag_Reserved6 = 64; - UniversalBrushFlag_Reserved7 = 128; - //you can define your custom flags from 256 on - -type - { TUniversalBrush } - - PUniversalBrush = ^TUniversalBrush; - TUniversalBrush = record - private - FColorspace: TColorspaceAny; - function GetDoesNothing: boolean; inline; - procedure SetColorspace(AValue: TColorspaceAny); - procedure SetDoesNothing(AValue: boolean); inline; - public - FixedData: array[0..31] of byte; - InternalInitContext: TUniBrushInitContextProc; //do not call directly - InternalPutNextPixels: TUniBrushPutNextPixelsProc; //do not call directly - Flags: LongWord; - procedure MoveTo(AContext: PUniBrushContext; ADest: pointer; AOfsX,AOfsY: integer); inline; - procedure PutNextPixels(AContext: PUniBrushContext; AAlpha: Word; ACount: integer); inline; - property Colorspace: TColorspaceAny read FColorspace write SetColorspace; - property DoesNothing: boolean read GetDoesNothing write SetDoesNothing; - end; - -type - PDefaultSolidBrushIndirectFixedData = ^TDefaultSolidBrushIndirectFixedData; - TDefaultSolidBrushIndirectFixedData = packed record - PixelSize: integer; - Color: packed array[0..23] of byte; - end; - -procedure DefaultSolidBrushIndirectSkipPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -procedure DefaultSolidBrushIndirectSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); - -type - TPathCallbackData = record - BrushAddress: PUniversalBrush; - Alpha: Word; - Width: single; - PixelCenteredCoords: boolean; - end; - - { TCustomUniversalBitmap } - - TCustomUniversalBitmap = class(TFPCustomImage, IBGRAScanner) - private - procedure PathStrokeAliasedCallback(const APoints: array of TPointF; - AClosed: boolean; AData: Pointer); - procedure PathStrokeAntialiasCallback(const APoints: array of TPointF; - AClosed: boolean; AData: Pointer); - - protected - FRefCount: integer; - FColorspace: TColorspaceAny; - FReferenceWhite: PXYZReferenceWhite; - FWidth: integer; - FHeight: integer; - FNbPixels: integer; - FPixelSize: integer; - FRowSize: PtrInt; - FDataByte: PByte; - FLineOrder: TRawImageLineOrder; - - //Scan - FScanWidth, FScanHeight: integer; //possibility to reduce the zone being scanned - FScanPtr : PByte; //current scan address - FScanCurX,FScanCurY: integer; //current scan coordinates - - FClipRect: TRect; - FConvertToFPColor, FConvertFromFPColor, - FConvertToBGRA, FConvertFromBGRA, - FConvertToExpanded, FConvertFromExpanded: TBridgedConversion; - FPenStroker: TBGRACustomPenStroker; - - {** Specifies if linear antialiasing must be used when drawing - antialiased shapes } - FAntialiasingDrawMode: TDrawMode; - - procedure Init; virtual; - procedure ReallocData; virtual; - procedure FreeData; virtual; - - {TFPCustomImage} - procedure SetInternalColor(x, y: integer; const Value: TFPColor); override; - function GetInternalColor(x, y: integer): TFPColor; override; - procedure SetInternalPixel(x, y: integer; Value: integer); override; - function GetInternalPixel(x, y: integer): integer; override; - - function CheckEmpty: boolean; virtual; - function CheckIsZero: boolean; virtual; - function GetClipRect: TRect; virtual; - function GetDataBytePtr: PByte; virtual; - function GetHasSemiTransparentPixels: boolean; virtual; - function GetHasTransparentPixels: boolean; virtual; - function GetHeight: integer; virtual; - function GetLineOrder: TRawImageLineOrder; virtual; - procedure SetLineOrder(AValue: TRawImageLineOrder); virtual; - function GetNbPixels: integer; virtual; - function GetRefCount: integer; virtual; - function GetScanLineByte(y: integer): PByte; virtual; - function GetWidth: integer; virtual; - procedure SetClipRect(const AValue: TRect); virtual; - procedure RaiseInvalidBrushColorspace; virtual; - procedure RaiseMissingUniDrawer; virtual; - function CheckHorizLineBounds(var x:int32or64; y: int32or64; var x2: int32or64): boolean; inline; - function CheckVertLineBounds(x: int32or64; var y, y2: int32or64): boolean; inline; - class function DefaultColorspace: TColorspaceAny; virtual; - function InternalDuplicate(ACopyProperties: boolean=false): TCustomUniversalBitmap; virtual; - function InternalNew: TCustomUniversalBitmap; virtual; - procedure InternalCopyPixels(ASource,ADest: PByte; ASourceStride,ADestStride: PtrInt; ACount: integer); virtual; - procedure InternalSwapPixels(ABuf1,ABuf2: PByte; AStride1,AStride2: PtrInt; ACount: integer); virtual; - procedure InternalSetPixels(ASource,ADest: PByte; ADestStride: PtrInt; ACount: integer); virtual; - procedure AssignTransparentPixel(out ADest); virtual; - function GetLinearAntialiasing: boolean; virtual; - procedure SetLinearAntialiasing(AValue: boolean); virtual; - procedure SetAntialiasingDrawMode(AValue: TDrawMode); virtual; - - public - - {** User defined caption. It does not appear on the image } - Caption: string; - - {** Method to use when filling polygons (winding or alternate). - See [[BGRABitmap Types imported from Graphics|BGRAGraphics]] } - FillMode: TFillMode; - - {** Creates an image of width and height equal to zero. In this case, - ''DataByte'' = '''nil''' } - constructor Create; overload; - constructor Create(AColorspace: TColorspaceAny; ALineOrder: TRawImageLineOrder); overload; - constructor Create(AColorspace: TColorspaceAny; AWidth, AHeight: integer; - ALineOrder: TRawImageLineOrder); overload; - - procedure Assign(Source: TPersistent); override; - function NewBitmap: TCustomUniversalBitmap; overload; virtual; - function NewBitmap(AWidth, AHeight: integer): TCustomUniversalBitmap; overload; virtual; - function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TCustomUniversalBitmap; overload; virtual; - - {** Adds a reference (this reference count is not the same as - the reference count of an interface, it changes only by - explicit calls } - function NewReference: TCustomUniversalBitmap; virtual; - {** Free a reference. When the resulting reference count gets - to zero, the image is freed. The initial reference count - is equal to 1 } - procedure FreeReference; - {** Returns an object with a reference count equal to 1. Duplicate - this bitmap if necessary } - function GetUnique: TCustomUniversalBitmap; virtual; - function Duplicate(ACopyProperties: boolean=false): TCustomUniversalBitmap; virtual; - procedure CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); virtual; - {** Get a part of the image with repetition in both directions. It means - that if the bounds are within the image, the result is just that part - of the image, but if the bounds are bigger than the image, the image - is tiled. } - function GetPart(const ARect: TRect): TCustomUniversalBitmap; virtual; - - procedure InvalidateBitmap; virtual; //call if you modify with Scanline - procedure LoadFromBitmapIfNeeded; virtual; //call to ensure that data is up to date - - {** Clear all channels of transparent pixels } - procedure ClearTransparentPixels; virtual; - - class procedure EraseBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AAlpha: Word); virtual; - class procedure AlphaBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AAlpha: Word); virtual; - procedure SolidBrushBGRA(out ABrush: TUniversalBrush; ARed,AGreen,ABlue,AAlpha: Byte; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; - procedure SolidBrushBGRA(out ABrush: TUniversalBrush; AColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; - procedure SolidBrushExpanded(out ABrush: TUniversalBrush; ARed,AGreen,ABlue,AAlpha: Word; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; - procedure SolidBrushExpanded(out ABrush: TUniversalBrush; AColor: TExpandedPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); overload; virtual; - procedure SolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; - class procedure ScannerBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AScanner: IBGRAScanner; {%H-}ADrawMode: TDrawMode = dmDrawWithTransparency; - {%H-}AOffsetX: integer = 0; {%H-}AOffsetY: integer = 0); virtual; - class procedure MaskBrush(out {%H-}ABrush: TUniversalBrush; {%H-}AScanner: IBGRAScanner; - {%H-}AOffsetX: integer = 0; {%H-}AOffsetY: integer = 0); virtual; - - {TFPCustomImage} - {** Creates a new bitmap, initialize properties and bitmap data } - constructor Create(AWidth, AHeight: integer); overload; override; - {** Sets the dimension of an existing bitmap /!\ Data can be random } - procedure SetSize(AWidth, AHeight: integer); override; - destructor Destroy; override; - - {==== Load and save files ====} - - {** Stores the image in the stream without compression nor header } - procedure Serialize(AStream: TStream); virtual; - {** Reads the image in a stream that was previously serialized } - procedure Deserialize(AStream: TStream); virtual; - {** Stores an empty image (of size zero) } - class procedure SerializeEmpty(AStream: TStream); static; - - //there are UTF8 functions that are different from standard function as those - //depend on TFPCustomImage that does not clearly handle UTF8 - - {** Load image from a file. ''filename'' is an ANSI string } - procedure LoadFromFile(const AFilename: string); overload; virtual; - procedure LoadFromFile(const AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; - {** Load image from a file with the specified image reader. ''filename'' is an ANSI string } - procedure LoadFromFile(const AFilename:String; AHandler:TFPCustomImageReader); overload; virtual; - procedure LoadFromFile(const AFilename:String; AHandler:TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; - {** Load image from a file. ''filename'' is an UTF8 string } - procedure LoadFromFileUTF8(const AFilenameUTF8: string; AOptions: TBGRALoadingOptions = []); overload; virtual; - {** Load image from a file with the specified image reader. ''filename'' is an UTF8 string } - procedure LoadFromFileUTF8(const AFilenameUTF8: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions = []); overload; virtual; - {** Load image from a stream. Format is detected automatically } - procedure LoadFromStream(AStream: TStream);overload; virtual; - procedure LoadFromStream(AStream: TStream; AOptions: TBGRALoadingOptions);overload; virtual; - {** Load image from a stream. The specified image reader is used } - procedure LoadFromStream(AStream: TStream; AHandler: TFPCustomImageReader);overload; virtual; - procedure LoadFromStream(AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);overload; virtual; - {** Load image from an embedded Lazarus resource. Format is detected automatically } - procedure LoadFromResource(AFilename: string); overload; virtual; - procedure LoadFromResource(AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; - {** Load image from an embedded Lazarus resource. The specified image reader is used } - procedure LoadFromResource(AFilename: string; AHandler: TFPCustomImageReader); overload; virtual; - procedure LoadFromResource(AFilename: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; - - {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } - procedure SaveToFile(const AFilename: string);overload; virtual; - {** Save image to a file with the specified image writer. ''filename'' is an ANSI string } - procedure SaveToFile(const AFilename: string; AHandler:TFPCustomImageWriter);overload; virtual; - {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } - procedure SaveToFileUTF8(const AFilenameUTF8: string);overload; virtual; - {** Save image to a file with the specified image writer. ''filename'' is an UTF8 string } - procedure SaveToFileUTF8(const AFilenameUTF8: string; AHandler:TFPCustomImageWriter);overload; virtual; - - {** Save image to a stream with the specified image writer }{inherited - procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter); - }{** Save image to a stream in the specified image format } - procedure SaveToStreamAs(AStream: TStream; AFormat: TBGRAImageFormat); virtual; - {** Save image to a stream in PNG format } - procedure SaveToStreamAsPng(AStream: TStream); virtual; - - {==== Clipping ====} - - {** Stop clipping (clipping rectangle becomes the whole image) } - procedure NoClip; virtual; - {** Reduce the clipping region further by intersection and returns the previous clipping rectangle } - function IntersectClip(const ARect: TRect): TRect; - {** Checks if the specified point is in the clipping rectangle ''ClipRect'' } - function PtInClipRect(x, y: int32or64): boolean; inline; - {** Check if the bounds are within the clipping rectangle and adjust the coordinates to fit - (similar to IntersectRect but may flip the coordinates) } - function CheckClippedRectBounds(var x,y,x2,y2: integer): boolean; - - {==== Basic drawing functions ====} - - {** Fill the whole image regardless of clipping rect } - procedure Fill(const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure Fill(ATexture: IBGRAScanner; AMode: TDrawMode); overload; virtual; - procedure Fill(ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); overload; virtual; - procedure FillTransparent; virtual; - procedure AlphaFill(alpha: byte); virtual; - - {** Masking } - procedure ApplyMask(mask: TCustomUniversalBitmap; AAlpha: Word = 65535); overload; - procedure ApplyMask(mask: TCustomUniversalBitmap; ARect: TRect; AAlpha: Word = 65535); overload; - procedure ApplyMask(mask: TCustomUniversalBitmap; ARect: TRect; AMaskRectTopLeft: TPoint; AAlpha: Word = 65535); overload; virtual; - procedure ApplyGlobalOpacity(alpha: byte); overload; virtual; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const ABrush: TUniversalBrush); overload; virtual; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner); overload; virtual; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode); overload; virtual; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint); overload; virtual; - - {** Fills completely a rectangle, without any border } - procedure FillRect(ALeft, ATop, ARight, ABottom: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure FillRect(const ARect: TRect; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure FillRect(ALeft, ATop, ARight, ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure FillRect(const ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure FillRect(ALeft, ATop, ARight, ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint; AAlpha: Word = 65535); overload; virtual; - procedure FillRect(const ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint; AAlpha: Word = 65535); overload; virtual; - procedure EraseRect(ALeft, ATop, ARight, ABottom: integer; alpha: byte); virtual; - procedure EraseRect(const ARect: TRect; alpha: byte); virtual; - procedure AlphaFillRect(ALeft, ATop, ARight, ABottom: integer; alpha: byte); virtual; - procedure AlphaFillRect(const ARect: TRect; alpha: byte); virtual; - procedure ApplyGlobalOpacity(ARect: TRect; alpha: byte); overload; virtual; - procedure DrawCheckers(ARect: TRect; const ABrushEven,ABrushOdd: TUniversalBrush; AGridWidth: integer = 8; AGridHeight: integer = 8); overload; virtual; - - {** Returns the address of a pixel. /!\ Does not check if the coordinates are valid. } - function GetPixelAddress(x,y: integer): PByte; virtual; - procedure SetPixelIndirect(x,y: int32or64; AColor: pointer); virtual; - procedure GetPixelIndirect(x,y: int32or64; AColor: pointer); virtual; - procedure GetPixelCycleIndirect(x,y: int32or64; AColor: pointer); virtual; - procedure DrawPixel(x,y: Int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure DrawPixel(x,y: Int32or64; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure DrawPixelF(x,y: single; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure DrawPixelF(x,y: single; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - {** Erase the content of the pixel by reducing the value of the - alpha channel. ''alpha'' specifies how much to decrease. - If the resulting alpha reaches zero, the content - is replaced by the transparent pixel } - procedure ErasePixel(x, y: int32or64; alpha: byte); virtual; - procedure ErasePixelF(x, y: single; alpha: byte); virtual; - {** Sets the alpha value at (''x'',''y''). If ''alpha'' = 0, the - pixel is replaced by the transparent pixel } - procedure AlphaPixel(x, y: int32or64; alpha: byte); virtual; - procedure AlphaPixelF(x, y: single; alpha: byte); virtual; - procedure HorizLine(x, y, x2: int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; - {** Draws an horizontal line at line ''y'' and - at columns ''x'' to ''x2'' included, using specified scanner - and the specified ''AMode'' } - procedure HorizLine(x, y, x2: int32or64; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure EraseHorizLine(x,y,x2: int32or64; alpha: byte); virtual; - procedure AlphaHorizLine(x,y,x2: int32or64; alpha: byte); virtual; - procedure VertLine(x, y, y2: int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure VertLine(x, y, y2: int32or64; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure EraseVertLine(x, y, y2: int32or64; alpha: byte); virtual; - procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); virtual; - - {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm. - ''DrawLastPixel'' specifies if (x2,y2) must be drawn. } - procedure DrawLine(x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - procedure DrawLine(x1, y1, x2, y2: integer; ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm - ''DrawLastPixel'' specifies if (x2,y2) must be drawn } - procedure DrawLineAntialias(x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - procedure DrawLineAntialias(x1, y1, x2, y2: integer; ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - {** Draws an antialiased line with two brushes as dashes of length ''ADashLen''. - ''ADashPos'' can be used to specify the start dash position and to retrieve the dash position at the end - of the line, in order to draw a polyline with consistent dashes } - procedure DrawLineAntialias(x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - procedure DrawLineAntialias(x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - - {** Erases the line from (x1,y1) to (x2,y2) using Bresenham's algorithm. - ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing - is changed and if ''alpha'' = 255, all pixels become transparent. - ''DrawListPixel'' specifies if (x2,y2) must be changed } - procedure EraseLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; - {** Erases the line from (x1,y1) to (x2,y2) width antialiasing. - ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing - is changed and if ''alpha'' = 255, all pixels become transparent. - ''DrawListPixel'' specifies if (x2,y2) must be changed } - procedure EraseLineAntialias(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; - procedure AlphaLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; - procedure AlphaLineAntialias(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; - - procedure DrawPolyLine(const points: array of TPoint; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); - procedure DrawPolyLineAntialias(const points: array of TPoint; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; - procedure DrawPolyLineAntialias(const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; - procedure ErasePolyLine(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); - procedure ErasePolyLineAntialias(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); - procedure AlphaPolyLine(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); - procedure AlphaPolyLineAntialias(const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); - - procedure DrawPolygon(const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); - procedure DrawPolygonAntialias(const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; - procedure DrawPolygonAntialias(const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word = 65535); overload; - procedure ErasePolygonOutline(const points: array of TPoint; alpha: byte); - procedure ErasePolygonOutlineAntialias(const points: array of TPoint; alpha: byte); - procedure AlphaPolygonOutline(const points: array of TPoint; alpha: byte); - procedure AlphaPolygonOutlineAntialias(const points: array of TPoint; alpha: byte); - - procedure DrawPathAliased(APath: IBGRAPath; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure DrawPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - - {==== Rectangles (integer coordinates) ====} - {* The integer coordinates of rectangles interpreted such that - that the bottom/right pixels are not drawn. The width is equal - to x2-x, and pixels are drawn from x to x2-1. If x = x2, then nothing - is drawn. See [[BGRABitmap tutorial 13|coordinate system]]. - * These functions do not take into account current pen style/cap/join. - They draw a continuous 1-pixel width border } - - {** Draw the border of a rectangle } - procedure Rectangle(x, y, x2, y2: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure Rectangle(x, y, x2, y2: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure Rectangle(const ARect: TRect; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure Rectangle(const ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - {** Draw a filled rectangle with a border } - procedure Rectangle(x, y, x2, y2: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure Rectangle(const ARect: TRect; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - - procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure EraseRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; alpha: byte); virtual; - procedure AlphaFillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; alpha: byte); virtual; - - procedure EllipseInRect(ARect: TRect; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure EllipseInRect(ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure EllipseInRect(ARect: TRect; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure FillEllipseInRect(ARect: TRect; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; - procedure FillEllipseInRect(ARect: TRect; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure EraseEllipseInRect(ARect: TRect; alpha: byte); virtual; - procedure AlphaFillEllipseInRect(ARect: TRect; alpha: byte); virtual; - - procedure FillShape(AShape: TBGRACustomFillInfo; const ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; - procedure FillShape(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word = 65535); virtual; - procedure EraseShape(AShape: TBGRACustomFillInfo; alpha: byte); virtual; - procedure AlphaFillShape(AShape: TBGRACustomFillInfo; alpha: byte); virtual; - - procedure FillPoly(const APoints: array of TPointF; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; virtual; - procedure FillPoly(const APoints: array of TPointF; ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; virtual; - procedure ErasePoly(const APoints: array of TPointF; alpha: byte; APixelCenteredCoordinates: boolean = true); virtual; - procedure AlphaFillPoly(const APoints: array of TPointF; alpha: byte; APixelCenteredCoordinates: boolean = true); virtual; - - procedure FillPathAliased(APath: IBGRAPath; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure FillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure FillPathAliased(APath: IBGRAPath; ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure FillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure ErasePathAliased(APath: IBGRAPath; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; - procedure ErasePathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; - procedure AlphaFillPathAliased(APath: IBGRAPath; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; - procedure AlphaFillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean = true); overload; - - property Colorspace: TColorspaceAny read FColorspace; - - procedure VerticalFlip; overload; virtual; - procedure VerticalFlip(ARect: TRect); overload; virtual; - procedure HorizontalFlip; overload; virtual; - procedure HorizontalFlip(ARect: TRect); overload; virtual; - procedure RotateUDInplace; overload; virtual; - procedure RotateUDInplace(ARect: TRect); overload; virtual; - - { Return a new bitmap rotated in a clock wise direction. } - function RotateCW: TCustomUniversalBitmap; virtual; - { Return a new bitmap rotated in a counter clock wise direction. } - function RotateCCW: TCustomUniversalBitmap; virtual; - { Return a new bitmap rotated 180° (upside down). } - function RotateUD: TCustomUniversalBitmap; virtual; - - {** Width of the image in pixels } - property Width: integer Read GetWidth; - {** Height of the image in pixels } - property Height: integer Read GetHeight; - - {** Size in bytes of a row of pixels } - property RowSize: PtrInt read FRowSize; - - {** Clipping rectangle for all drawing functions } - property ClipRect: TRect read GetClipRect write SetClipRect; - - property LinearAntialiasing: boolean read GetLinearAntialiasing write SetLinearAntialiasing; - property AntialiasingDrawMode: TDrawMode read FAntialiasingDrawMode write SetAntialiasingDrawMode; - - {** Total number of pixels. It is always true that ''NbPixels'' = ''Width'' * ''Height'' } - property NbPixels: integer Read GetNbPixels; - - {** Returns the address of the left-most pixel of any line. - The parameter y ranges from 0 to Height-1 } - property ScanLineByte[y: integer]: PByte Read GetScanLineByte; - - {** Indicates the order in which lines are stored in memory. - If it is equal to ''riloTopToBottom'', the first line is the top line. - If it is equal to ''riloBottomToTop'', the first line is the bottom line. - See [[BGRABitmap Miscellaneous types|miscellaneous types]] } - property LineOrder: TRawImageLineOrder Read GetLineOrder write SetLineOrder; - - {** Provides a pointer to the first pixel in memory. - Depending on the ''LineOrder'' property, this can be the top-left pixel or the bottom-left pixel. - There is no padding between scanlines. - See [[BGRABitmap tutorial 4]] } - property DataByte: PByte Read GetDataBytePtr; - - {** Number of references to this image. It is increased by the function - ''NewReference'' and decreased by the function ''FreeReference'' } - property RefCount: integer Read GetRefCount; - - {** Returns True if the bitmap only contains transparent pixels or has a size of zero } - property Empty: boolean Read CheckEmpty; - - {** Returns True if the bitmap is filled with zero values or has a size of zero } - property IsZero: boolean Read CheckIsZero; - - {** Returns True if there are transparent and so if the image would - be stored at least with an alpha channel of 1 bit } - property HasTransparentPixels: boolean Read GetHasTransparentPixels; - - {** Returns True if there are semitransparent pixels - and so if the image would be stored with an alpha channel of at least 8 bit } - property HasSemiTransparentPixels: boolean Read GetHasSemiTransparentPixels; - - {** Current reference white used for color conversion } - property ReferenceWhite: PXYZReferenceWhite read FReferenceWhite write FReferenceWhite; - - - {==== Pen style ====} - protected - function GetArrow: TBGRACustomArrow; virtual; - function GetLineCap: TPenEndCap; virtual; - function GetInternalPen: TBGRACustomPenStroker; virtual; - function GetPenStroker: TBGRACustomPenStroker; virtual; - procedure SetLineCap(AValue: TPenEndCap); virtual; - - public - {** You can use this class set pen style and generate strokes polygonal representations } - property Pen: TBGRACustomPenStroker read GetPenStroker; - {** How to draw the ends of a line (applies to arrow as well) } - property LineCap: TPenEndCap read GetLineCap write SetLineCap; - {** Properties of arrow ends } - property Arrow: TBGRACustomArrow read GetArrow; - - {==== Drawing lines and paths (floating point coordinates) ====} - {* These functions use the current pen style/cap/join. The parameter ''APenWidth'' - specifies the width of the line and the base unit for dashes. - See [[BGRABitmap tutorial 13|coordinate system]]. - * The coordinates are pixel-centered by default, so that when filling a rectangle, - if the supplied values are integers, the border will be half transparent. - If you want the border to be completely filled, you can subtract/add - 0.5 to the coordinates to include the remaining thin border. - See [[BGRABitmap tutorial 13|coordinate system]]. } - - {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join } - procedure DrawLineAntialias(x1, y1, x2, y2: single; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; - {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join. - ''texture'' specifies the source color to use when filling the line } - procedure DrawLineAntialias(x1, y1, x2, y2: single; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; - {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join. - ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, - a space is left so that the next line can fit } - procedure DrawLineAntialias(x1, y1, x2, y2: single; const ABrush: TUniversalBrush; APenWidth: single; AClosedCap: boolean); overload; virtual; - {** Same as above with ''texture'' specifying the source color to use when filling the line } - procedure DrawLineAntialias(x1, y1, x2, y2: single; ATexture: IBGRAScanner; APenWidth: single; AClosedCap: boolean); overload; virtual; - {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join } - procedure EraseLineAntialias(x1, y1, x2, y2: single; AAlpha: Byte; APenWidth: single); overload; virtual; - {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join. - ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, - a space is left so that the next line can fit } - procedure EraseLineAntialias(x1, y1, x2, y2: single; AAlpha: Byte; APenWidth: single; AClosedCap: boolean); overload; virtual; - - {** Draws a polyline using current pen style/cap/join } - procedure DrawPolyLineAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; - {** Draws a polyline using current pen style/cap/join. - ''texture'' specifies the source color to use when filling the line } - procedure DrawPolyLineAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; - {** Erases a polyline using current pen style/cap/join } - procedure ErasePolyLineAntialias(const APoints: array of TPointF; AAlpha: byte; APenWidth: single); overload; virtual; - - {** Draws a polyline using current pen style/cap/join. - ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, - a space is left so that the next line can fit } - procedure DrawPolyLineAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single; AClosedCap: boolean); overload; virtual; - procedure DrawPolyLineAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single; AClosedCap: boolean); overload; virtual; - procedure ErasePolyLineAntialias(const APoints: array of TPointF; AAlpha: byte; APenWidth: single; AClosedCap: boolean); overload; virtual; - - {** Draws a polyline using current pen style/cap/join. - The last point considered as a join with the first point if it has - the same coordinate } - procedure DrawPolyLineAntialiasAutocycle(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; - {** Draws a polygon using current pen style/cap/join. Use a texture to fill the line. - The polygon is always closed. You don't need to set the last point - to be the same as the first point } - procedure DrawPolyLineAntialiasAutocycle(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; - procedure ErasePolyLineAntialiasAutocycle(const APoints: array of TPointF; AAlpha: byte; APenWidth: single); overload; virtual; - - {** Draws a polygon using current pen style/cap/join. - The polygon is always closed. You don't need to set the last point - to be the same as the first point } - procedure DrawPolygonAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APenWidth: single); overload; virtual; - procedure DrawPolygonAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); overload; virtual; - procedure ErasePolygonOutlineAntialias(const APoints: array of TPointF; AAlpha: byte; APenWidth: single); overload; virtual; - - procedure RectangleAntialias(x, y, x2, y2: single; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; - procedure RectangleAntialias(x, y, x2, y2: single; ATexture: IBGRAScanner; AWidth: single); overload; virtual; - - {** Draws an ellipse without antialising. ''rx'' is the horizontal radius and - ''ry'' the vertical radius } - procedure Ellipse(x, y, rx, ry: single; const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word = 65535); overload; virtual; - procedure Ellipse(x, y, rx, ry: single; ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word = 65535); overload; virtual; - procedure Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - {** Draws an ellipse with antialising. ''rx'' is the horizontal radius and - ''ry'' the vertical radius } - procedure EllipseAntialias(x, y, rx, ry: single; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; - procedure EllipseAntialias(x, y, rx, ry: single; ATexture: IBGRAScanner; AWidth: single); overload; virtual; - procedure EllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; - procedure EllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; ATexture: IBGRAScanner; AWidth: single); overload; virtual; - - procedure DrawPath(APath: IBGRAPath; const ABrush: TUniversalBrush; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure DrawPath(APath: IBGRAPath; ATexture: IBGRAScanner; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure DrawPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure DrawPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; - - {==== Antialias fill ====} - procedure FillShapeAntialias(AShape: TBGRACustomFillInfo; const ABrush: TUniversalBrush); overload; virtual; - procedure FillShapeAntialias(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner); overload; virtual; - procedure EraseShapeAntialias(AShape: TBGRACustomFillInfo; AAlpha: Byte); overload; virtual; - procedure FillPolyAntialias(const APoints: array of TPointF; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillPolyAntialias(const APoints: array of TPointF; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure ErasePolyAntialias(const APoints: array of TPointF; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; - {** Fills an ellipse which axes are parallel to X and Y axes } - procedure FillEllipseAntialias(x, y, rx, ry: single; const ABrush: TUniversalBrush); overload; virtual; - procedure FillEllipseAntialias(x, y, rx, ry: single; ATexture: IBGRAScanner); overload; virtual; - {** Erases the content of an ellipse which axes are parallel to X and Y axes } - procedure EraseEllipseAntialias(x, y, rx, ry: single; AAlpha: Byte); overload; virtual; - {** Fills an ellipse with any axes } - procedure FillEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush); overload; virtual; - procedure FillEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; ATexture: IBGRAScanner); overload; virtual; - {** Erases the content of an ellipse with any axes } - procedure EraseEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; AAlpha: Byte); overload; virtual; - {** Fills a rectangle with antialiasing. Note that the pixel (x2,y2) is - included contrary to integer coordinates. For example (-0.5,-0.5,0.5,0.5) - with pixel-centered coords fills one pixel } - procedure FillRectAntialias(x, y, x2, y2: single; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillRectAntialias(x, y, x2, y2: single; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure EraseRectAntialias(x, y, x2, y2: single; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillRectAntialias(const ARectF: TRectF; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillRectAntialias(const ARectF: TRectF; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure EraseRectAntialias(const ARectF: TRectF; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillRoundRectAntialias(x, y, x2, y2, rx, ry: single; const ABrush: TUniversalBrush; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillRoundRectAntialias(x, y, x2, y2, rx, ry: single; ATexture: IBGRAScanner; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure EraseRoundRectAntialias(x, y, x2, y2, rx, ry: single; AAlpha: Byte; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillPath(APath: IBGRAPath; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillPath(APath: IBGRAPath; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure ErasePath(APath: IBGRAPath; AAlpha: Byte; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure ErasePath(APath: IBGRAPath; const AMatrix: TAffineMatrix; AAlpha: byte; APixelCenteredCoordinates: boolean = true); overload; virtual; - - protected {==== 'IBGRAScanner'' interface ====} - function ProvidesScanline({%H-}ARect: TRect): boolean; virtual; - function GetScanlineAt({%H-}X, {%H-}Y: integer): PBGRAPixel; virtual; - function GetTextureGL: IUnknown; virtual; - public - {** Offset to apply when the image is scanned } - ScanOffset: TPoint; - - function ScanAtInteger(X,Y: integer): TBGRAPixel; virtual; - function ScanAtIntegerExpanded(X, Y: integer): TExpandedPixel; virtual; - procedure ScanMoveTo(X,Y: Integer); virtual; - function ScanNextPixel: TBGRAPixel; virtual; - function ScanNextExpandedPixel: TExpandedPixel; virtual; - function ScanAt(X,Y: Single): TBGRAPixel; virtual; - function ScanAtExpanded(X, Y: Single): TExpandedPixel; virtual; - function IsScanPutPixelsDefined: boolean; virtual; - procedure ScanPutPixels({%H-}pdest: PBGRAPixel; {%H-}count: integer; {%H-}mode: TDrawMode); virtual; - procedure ScanSkipPixels(ACount: integer); virtual; - function GetImageBounds: TRect; overload; virtual; - function GetImageBounds(Channel: TChannel; ANothingValue: Byte = 0): TRect; overload; - function GetImageBounds(Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; - function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; virtual; - function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; virtual; - function GetScanCustomColorspace: TColorspaceAny; virtual; - procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer); virtual; - procedure ScanNextMaskChunk(var {%H-}ACount: integer; out {%H-}AMask: PByteMask; out {%H-}AStride: integer); virtual; - function ScanAtIntegerMask(X,Y: integer): TByteMask; virtual; - function ScanAtMask({%H-}X,{%H-}Y: Single): TByteMask; virtual; - - protected - //interface - function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; - - public - procedure PutImage(X, Y: integer; ASource: TCustomUniversalBitmap; AMode: TDrawMode; AOpacity: byte = 255); virtual; - - public - //filters - function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; - function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; - function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; - function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TCustomUniversalBitmap; overload; virtual; - function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TCustomUniversalBitmap; overload; virtual; - function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TCustomUniversalBitmap; overload; virtual; - function FilterCustomBlur(mask: TCustomUniversalBitmap): TCustomUniversalBitmap; overload; virtual; - function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TCustomUniversalBitmap; overload; virtual; - - end; - - { TCustomUniversalDrawer } - - TCustomUniversalDrawer = class - - {==== Load and save files ====} - - //there are UTF8 functions that are different from standard function as those - //depend on TFPCustomImage that does not clearly handle UTF8 - - {** Load image from a file. ''filename'' is an ANSI string } - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string); overload; virtual; abstract; - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; abstract; - {** Load image from a file with the specified image reader. ''filename'' is an ANSI string } - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader); overload; virtual; abstract; - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; abstract; - {** Load image from a file. ''filename'' is an UTF8 string } - class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AOptions: TBGRALoadingOptions = []); overload; virtual; abstract; - {** Load image from a file with the specified image reader. ''filename'' is an UTF8 string } - class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions = []); overload; virtual; abstract; - {** Load image from a stream. Format is detected automatically } - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream);overload; virtual; abstract; - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AOptions: TBGRALoadingOptions);overload; virtual; abstract; - {** Load image from a stream. The specified image reader is used } - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader);overload; virtual; abstract; - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; abstract; - {** Load image from an embedded Lazarus resource. Format is detected automatically } - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string); overload; virtual; abstract; - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AOptions: TBGRALoadingOptions); overload; virtual; abstract; - {** Load image from an embedded Lazarus resource. The specified image reader is used } - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader); overload; virtual; abstract; - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; virtual; abstract; - - {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } - class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string); overload; virtual; abstract; - {** Save image to a file with the specified image writer. ''filename'' is an ANSI string } - class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string; AHandler:TFPCustomImageWriter); overload; virtual; abstract; - {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } - class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string); overload; virtual; abstract; - {** Save image to a file with the specified image writer. ''filename'' is an UTF8 string } - class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler:TFPCustomImageWriter); overload; virtual; abstract; - - {** Save image to a stream in the specified image format } - class procedure SaveToStreamAs(ASource: TCustomUniversalBitmap; AStream: TStream; AFormat: TBGRAImageFormat); virtual; abstract; - {** Save image to a stream in PNG format } - class procedure SaveToStreamAsPng(ASource: TCustomUniversalBitmap; AStream: TStream); virtual; abstract; - - {==== Pixelwise drawing ====} - - {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm. - ''DrawLastPixel'' specifies if (x2,y2) must be drawn. } - class procedure DrawLine(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); virtual; abstract; - {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm - ''DrawLastPixel'' specifies if (x2,y2) must be drawn } - class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; - {** Draws an antialiased line with two brushes as dashes of length ''ADashLen''. - ''ADashPos'' specifies the start dash position and allows to retrieve the dash position at the end - of the line, in order to draw a polyline with consistent dashes } - class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; var DashPos: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; - - class procedure DrawPolyLine(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); virtual; abstract; - class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; - class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; abstract; - - class procedure DrawPolygon(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; abstract; - class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; - class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const APoints: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word = 65535); overload; virtual; abstract; - - {** Draw the border of a rectangle } - class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; - {** Draw a filled rectangle with a border } - class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; - - class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; - class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; virtual; abstract; - class procedure FillRoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); virtual; abstract; - - class procedure FillShape(ADest: TCustomUniversalBitmap; AShape: TBGRACustomFillInfo; AFillMode: TFillMode; ABrush: TUniversalBrush; AAlpha: Word = 65535); virtual; abstract; - class procedure FillPoly(ADest: TCustomUniversalBitmap; const APoints: array of TPointF; AFillMode: TFillMode; ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); virtual; abstract; - - {==== Using pen ====} - class function CreatePenStroker: TBGRACustomPenStroker; virtual; abstract; - class function CreateArrow: TBGRACustomArrow; virtual; abstract; - - class procedure RectangleAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, x2, y2: single; - const ABrush: TUniversalBrush; AWidth: single); virtual; abstract; - class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; - const APoints: array of TPointF; const ABrush: TUniversalBrush; AWidth: single); overload; virtual; abstract; - - class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; virtual; abstract; - class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; virtual; abstract; - class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; - const ABrush: TUniversalBrush; AWidth: single); overload; virtual; abstract; - class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; - const ABrush: TUniversalBrush; AWidth: single); overload; virtual; abstract; - - {==== Filling ====} - class procedure FillRectAntialias(ADest: TCustomUniversalBitmap; - x, y, x2, y2: single; const ABrush: TUniversalBrush; - APixelCenteredCoordinates: boolean = true); virtual; abstract; - class procedure FillRoundRectAntialias(ADest: TCustomUniversalBitmap; - x,y,x2,y2, rx,ry: single; const ABrush: TUniversalBrush; - AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); virtual; abstract; - class procedure FillShapeAntialias(ADest: TCustomUniversalBitmap; - AShape: TBGRACustomFillInfo; AFillMode: TFillMode; - ABrush: TUniversalBrush); virtual; abstract; - class procedure FillPolyAntialias(ADest: TCustomUniversalBitmap; - const APoints: array of TPointF; AFillMode: TFillMode; - ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); virtual; abstract; - class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; - x, y, rx, ry: single; const ABrush: TUniversalBrush); overload; virtual; abstract; - class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; - const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush); overload; virtual; abstract; - - //filters - class procedure FilterBlurRadial(ASource: TCustomUniversalBitmap; const ABounds: TRect; - radiusX, radiusY: single; blurType: TRadialBlurType; - ADest: TCustomUniversalBitmap); virtual; abstract; - class procedure FilterBlurMotion(ASource: TCustomUniversalBitmap; const ABounds: TRect; - distance: single; angle: single; oriented: boolean; - ADest: TCustomUniversalBitmap); virtual; abstract; - class procedure FilterCustomBlur(ASource: TCustomUniversalBitmap; const ABounds: TRect; - mask: TCustomUniversalBitmap; - ADest: TCustomUniversalBitmap); virtual; abstract; - - end; - TUniversalDrawerAny = class of TCustomUniversalDrawer; - -var - UniDrawerClass: TUniversalDrawerAny; - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -{ TUniversalBrush } - -function TUniversalBrush.GetDoesNothing: boolean; -begin - result := (Flags and UniversalBrushFlag_DoNothing) <> 0; -end; - -procedure TUniversalBrush.SetColorspace(AValue: TColorspaceAny); -begin - FColorspace:=AValue; - InternalInitContext:= nil; - InternalPutNextPixels := nil; - Flags := 0; -end; - -procedure TUniversalBrush.SetDoesNothing(AValue: boolean); -begin - if AValue then Flags := Flags or UniversalBrushFlag_DoNothing - else Flags := Flags and not UniversalBrushFlag_DoNothing; -end; - -procedure TUniversalBrush.MoveTo(AContext: PUniBrushContext; ADest: pointer; - AOfsX, AOfsY: integer); -begin - with AContext^ do - begin - AContext^.Dest:= ADest; - AContext^.Ofs.X := AOfsX; - AContext^.Ofs.Y := AOfsY; - end; - if Assigned(InternalInitContext) then - InternalInitContext(@FixedData, AContext); -end; - -procedure TUniversalBrush.PutNextPixels(AContext: PUniBrushContext; - AAlpha: Word; ACount: integer); -begin - InternalPutNextPixels(@FixedData, AContext, AAlpha, ACount); -end; - -{ TCustomUniversalBitmap } - -function TCustomUniversalBitmap.CheckEmpty: boolean; -var - alphaIdx, i: Integer; - p: PByte; -begin - alphaIdx := Colorspace.IndexOfAlphaChannel; - if (alphaIdx=-1) or (FDataByte=nil) then exit(false); - p := FDataByte; - for i := NbPixels-1 downto 0 do - begin - if Colorspace.GetColorTransparency(p) <> ctFullyTransparent then exit(true); - inc(p, FPixelSize); - end; - exit(false); -end; - -function TCustomUniversalBitmap.CheckIsZero: boolean; -var - i, dataSize: PtrInt; - p: PByte; -begin - p := DataByte; - if p = nil then exit(true); - dataSize := FNbPixels*IntPtr(FPixelSize); - for i := (dataSize shr 3) - 1 downto 0 do - begin - if PQWord(p)^ <> 0 then exit(false); - Inc(p,8); - end; - for i := (dataSize and 7) - 1 downto 0 do - begin - if PByte(p)^ <> 0 then exit(false); - inc(p); - end; - Result := True; -end; - -function TCustomUniversalBitmap.GetClipRect: TRect; -begin - result := FClipRect; -end; - -function TCustomUniversalBitmap.GetDataBytePtr: PByte; -begin - LoadFromBitmapIfNeeded; - result := FDataByte; -end; - -function TCustomUniversalBitmap.GetHasSemiTransparentPixels: boolean; -var - alphaIdx, i: Integer; - p: PByte; -begin - alphaIdx := Colorspace.IndexOfAlphaChannel; - if (alphaIdx=-1) or (FDataByte=nil) then exit(false); - p := FDataByte; - for i := NbPixels-1 downto 0 do - begin - if Colorspace.GetColorTransparency(p) = ctSemiTransparent then exit(true); - inc(p, FPixelSize); - end; - exit(false); -end; - -function TCustomUniversalBitmap.GetHasTransparentPixels: boolean; -var - alphaIdx, i: Integer; - p: PByte; -begin - alphaIdx := Colorspace.IndexOfAlphaChannel; - if (alphaIdx=-1) or (FDataByte=nil) then exit(false); - p := FDataByte; - for i := NbPixels-1 downto 0 do - begin - if Colorspace.GetColorTransparency(p) <> ctFullyOpaque then exit(true); - inc(p, FPixelSize); - end; - exit(false); -end; - -function TCustomUniversalBitmap.GetHeight: integer; -begin - result := FHeight; -end; - -function TCustomUniversalBitmap.GetLineOrder: TRawImageLineOrder; -begin - result := FLineOrder; -end; - -function TCustomUniversalBitmap.GetNbPixels: integer; -begin - result := FNbPixels; -end; - -function TCustomUniversalBitmap.GetRefCount: integer; -begin - result := FRefCount; -end; - -function TCustomUniversalBitmap.GetPixelAddress(x,y: integer): PByte; -begin - Result := FDataByte; - if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; - Inc(Result, FRowSize * y + IntPtr(FPixelSize)*x); -end; - -function TCustomUniversalBitmap.GetScanLineByte(y: integer): PByte; -begin - if (y < 0) or (y >= FHeight) then - raise ERangeError.Create('Scanline: out of bounds') - else - begin - LoadFromBitmapIfNeeded; - if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; - Result := FDataByte + FRowSize*y; - end; -end; - -function TCustomUniversalBitmap.GetWidth: integer; -begin - result := FWidth; -end; - -procedure TCustomUniversalBitmap.SetClipRect(const AValue: TRect); -begin - FClipRect := TRect.Intersect(AValue, Rect(0,0,Width,Height)); -end; - -procedure TCustomUniversalBitmap.RaiseInvalidBrushColorspace; -begin - raise exception.Create('Brush is not in '+Colorspace.GetName+' colorspace.'); -end; - -procedure TCustomUniversalBitmap.RaiseMissingUniDrawer; -begin - raise exception.Create('Universal drawer not found. Add UniversalDrawer to the uses clause.'); -end; - -function TCustomUniversalBitmap.CheckHorizLineBounds(var x:int32or64; y: int32or64; var x2: int32or64): boolean; -var - temp: int32or64; -begin - if (y < FClipRect.Top) or (y >= FClipRect.Bottom) then exit(false); - if (x2 < x) then - begin - temp := x; - x := x2; - x2 := temp; - end; - if (x >= FClipRect.Right) or (x2 < FClipRect.Left) then exit(false); - if x < FClipRect.Left then x := FClipRect.Left; - if x2 >= FClipRect.Right then x2 := FClipRect.Right - 1; - result := true; -end; - -function TCustomUniversalBitmap.CheckVertLineBounds(x: int32or64; var y,y2: int32or64): boolean; inline; -var - temp: int32or64; -begin - if (x < FClipRect.Left) or (x >= FClipRect.Right) then exit(false); - if (y2 < y) then - begin - temp := y; - y := y2; - y2 := temp; - end; - if (y >= FClipRect.Bottom) or (y2 < FClipRect.Top) then exit(false); - if y < FClipRect.Top then y := FClipRect.Top; - if y2 >= FClipRect.Bottom then y2 := FClipRect.Bottom - 1; - result := true; -end; - -class function TCustomUniversalBitmap.DefaultColorspace: TColorspaceAny; -begin - result := TBGRAPixelColorspace; -end; - -function TCustomUniversalBitmap.InternalDuplicate(ACopyProperties: boolean): TCustomUniversalBitmap; -begin - LoadFromBitmapIfNeeded; - result := InternalNew; - result.SetSize(FWidth,FHeight); - Move(FDataByte^, result.FDataByte^, FRowSize*FHeight); - result.InvalidateBitmap; - result.Caption := Caption; - if ACopyProperties then - CopyPropertiesTo(result); -end; - -function TCustomUniversalBitmap.InternalNew: TCustomUniversalBitmap; -begin - result := TCustomUniversalBitmap.Create(Colorspace, LineOrder); -end; - -procedure TCustomUniversalBitmap.ClearTransparentPixels; -var - alphaIdx, i: Integer; - p: PByte; -begin - alphaIdx := Colorspace.IndexOfAlphaChannel; - if (alphaIdx=-1) or (FDataByte=nil) then exit; - LoadFromBitmapIfNeeded; - p := FDataByte; - for i := NbPixels-1 downto 0 do - begin - if Colorspace.GetColorTransparency(p) = ctFullyTransparent then - AssignTransparentPixel(p^); - inc(p, FPixelSize); - end; - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.InternalCopyPixels(ASource, ADest: PByte; - ASourceStride, ADestStride: PtrInt; ACount: integer); -begin - while ACount>0 do - begin - move(ASource^, ADest^, FPixelSize); - inc(ASource, ASourceStride); - inc(ADest, ADestStride); - dec(ACount); - end; -end; - -procedure TCustomUniversalBitmap.InternalSwapPixels(ABuf1, ABuf2: PByte; - AStride1, AStride2: PtrInt; ACount: integer); -var temp: array[0..31] of byte; -begin - while ACount>0 do - begin - move(ABuf1^, {%H-}temp, FPixelSize); - move(ABuf2^, ABuf1^, FPixelSize); - move(temp, ABuf2^, FPixelSize); - inc(ABuf1, AStride1); - inc(ABuf2, AStride2); - dec(ACount); - end; -end; - -procedure TCustomUniversalBitmap.InternalSetPixels(ASource, ADest: PByte; - ADestStride: PtrInt; ACount: integer); -begin - while ACount>0 do - begin - move(ASource^, ADest^, FPixelSize); - inc(ADest, ADestStride); - dec(ACount); - end; -end; - -procedure TCustomUniversalBitmap.AssignTransparentPixel(out ADest); -begin - FillByte({%H-}ADest, FPixelSize, 0); -end; - -function TCustomUniversalBitmap.GetArrow: TBGRACustomArrow; -var - p: TBGRACustomPenStroker; -begin - p := GetInternalPen; - if p.Arrow = nil then - begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - p.Arrow := UniDrawerClass.CreateArrow; - p.Arrow.LineCap := LineCap; - p.ArrowOwned := true; - end; - result := p.Arrow; -end; - -function TCustomUniversalBitmap.GetLinearAntialiasing: boolean; -begin - result := FAntialiasingDrawMode in[dmLinearBlend,dmXor]; -end; - -function TCustomUniversalBitmap.GetLineCap: TPenEndCap; -begin - result := GetInternalPen.LineCap; -end; - -function TCustomUniversalBitmap.GetInternalPen: TBGRACustomPenStroker; -begin - if FPenStroker = nil then - begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - FPenStroker := UniDrawerClass.CreatePenStroker; - end; - result := FPenStroker; -end; - -function TCustomUniversalBitmap.GetPenStroker: TBGRACustomPenStroker; -begin - result := GetInternalPen; - if result.Arrow = nil then GetArrow; -end; - -procedure TCustomUniversalBitmap.PathStrokeAliasedCallback( - const APoints: array of TPointF; AClosed: boolean; AData: Pointer); -var pts: array of TPoint; - i: Integer; -begin - with TPathCallbackData(AData^) do - begin - setlength(pts, length(APoints)); - if PixelCenteredCoords then - begin - for i := 0 to high(pts) do - pts[i]:= APoints[i].Round; - end else - begin - for i := 0 to high(pts) do - pts[i]:= APoints[i].Floor; - end; - if AClosed then - UniDrawerClass.DrawPolygon(self, pts, BrushAddress^, Alpha) - else - UniDrawerClass.DrawPolyLine(self, pts, BrushAddress^, true, Alpha); - end; -end; - -procedure TCustomUniversalBitmap.PathStrokeAntialiasCallback( - const APoints: array of TPointF; AClosed: boolean; AData: Pointer); -var pts: array of TPointF; -begin - with TPathCallbackData(AData^) do - begin - if AClosed then - pts := GetInternalPen.ComputePolygon(APoints, Width) - else - pts := GetInternalPen.ComputePolyline(APoints, Width); - FillPolyAntialias(pts, BrushAddress^, PixelCenteredCoords); - end; -end; - -procedure TCustomUniversalBitmap.SetAntialiasingDrawMode(AValue: TDrawMode); -begin - if FAntialiasingDrawMode=AValue then Exit; - FAntialiasingDrawMode:=AValue; -end; - -procedure TCustomUniversalBitmap.SetLinearAntialiasing(AValue: boolean); -begin - if AValue then AntialiasingDrawMode:= dmLinearBlend - else AntialiasingDrawMode:= dmDrawWithTransparency; -end; - -procedure TCustomUniversalBitmap.SetLineCap(AValue: TPenEndCap); -begin - if AValue <> GetInternalPen.LineCap then - begin - GetInternalPen.LineCap := AValue; - if Assigned(GetInternalPen.Arrow) then - GetInternalPen.Arrow.LineCap := AValue; - end; -end; - -procedure TCustomUniversalBitmap.FillPolyAntialias( - const APoints: array of TPointF; const ABrush: TUniversalBrush; - APixelCenteredCoordinates: boolean); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillPolyAntialias(self, APoints, FillMode, - ABrush, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillPolyAntialias( - const APoints: array of TPointF; ATexture: IBGRAScanner; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - FillPolyAntialias(APoints, b, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.ErasePolyAntialias( - const APoints: array of TPointF; AAlpha: Byte; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillPolyAntialias(APoints, b, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillEllipseAntialias(x, y, rx, ry: single; - const ABrush: TUniversalBrush); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillEllipseAntialias(self, x,y,rx,ry, ABrush); -end; - -procedure TCustomUniversalBitmap.FillEllipseAntialias(x, y, rx, ry: single; - ATexture: IBGRAScanner); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - FillEllipseAntialias(x, y, rx, ry, b); -end; - -procedure TCustomUniversalBitmap.EraseEllipseAntialias(x, y, rx, ry: single; - AAlpha: Byte); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillEllipseAntialias(x, y, rx, ry, b); -end; - -procedure TCustomUniversalBitmap.FillEllipseAntialias(const AOrigin, AXAxis, - AYAxis: TPointF; const ABrush: TUniversalBrush); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillEllipseAntialias(self, AOrigin, AXAxis, AYAxis, ABrush); -end; - -procedure TCustomUniversalBitmap.FillEllipseAntialias(const AOrigin, AXAxis, - AYAxis: TPointF; ATexture: IBGRAScanner); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - FillEllipseAntialias(AOrigin, AXAxis, AYAxis, b); -end; - -procedure TCustomUniversalBitmap.EraseEllipseAntialias(const AOrigin, AXAxis, - AYAxis: TPointF; AAlpha: Byte); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillEllipseAntialias(AOrigin, AXAxis, AYAxis, b); -end; - -procedure TCustomUniversalBitmap.FillRectAntialias(x, y, x2, y2: single; - const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillRectAntialias(self, x,y,x2,y2, ABrush,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillRectAntialias(x, y, x2, y2: single; - ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AntialiasingDrawMode); - FillRectAntialias(x,y,x2,y2, b, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.EraseRectAntialias(x, y, x2, y2: single; - AAlpha: Byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillRectAntialias(x,y,x2,y2, b, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillRectAntialias(const ARectF: TRectF; - const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); -begin - FillRectAntialias(ARectF.Left, ARectF.Top, ARectF.Right, ARectF.Bottom, - ABrush, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillRectAntialias(const ARectF: TRectF; - ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean); -begin - FillRectAntialias(ARectF.Left, ARectF.Top, ARectF.Right, ARectF.Bottom, - ATexture, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.EraseRectAntialias(const ARectF: TRectF; - AAlpha: Byte; APixelCenteredCoordinates: boolean); -begin - EraseRectAntialias(ARectF.Left, ARectF.Top, ARectF.Right, ARectF.Bottom, - AAlpha, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillRoundRectAntialias(x, y, x2, y2, rx, - ry: single; const ABrush: TUniversalBrush; AOptions: TRoundRectangleOptions; - APixelCenteredCoordinates: boolean); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillRoundRectAntialias(self, x,y,x2,y2, rx,ry, ABrush, AOptions, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillRoundRectAntialias(x, y, x2, y2, rx, - ry: single; ATexture: IBGRAScanner; AOptions: TRoundRectangleOptions; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AntialiasingDrawMode, 0, 0); - FillRoundRectAntialias(x,y,x2,y2, rx,ry, b, AOptions, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.EraseRoundRectAntialias(x, y, x2, y2, rx, - ry: single; AAlpha: Byte; AOptions: TRoundRectangleOptions; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillRoundRectAntialias(x,y,x2,y2, rx,ry, b, AOptions, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; - const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); -begin - FillPolyAntialias(APath.getPoints,ABrush,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; - ATexture: IBGRAScanner; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - FillPath(APath, b, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; - APixelCenteredCoordinates: boolean); -begin - FillPolyAntialias(APath.getPoints(AMatrix), ABrush,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillPath(APath: IBGRAPath; - const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - FillPath(APath,AMatrix, b, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.ErasePath(APath: IBGRAPath; AAlpha: Byte; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillPath(APath, b, APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.ErasePath(APath: IBGRAPath; - const AMatrix: TAffineMatrix; AAlpha: byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillPath(APath,AMatrix, b, APixelCenteredCoordinates); -end; - -function TCustomUniversalBitmap.ScanAtInteger(X, Y: integer): TBGRAPixel; -begin - if (FScanWidth <> 0) and (FScanHeight <> 0) then - FConvertToBGRA.Convert(GetPixelAddress(PositiveMod(X+ScanOffset.X, FScanWidth), - PositiveMod(Y+ScanOffset.Y, FScanHeight)), - @result, 1, FPixelSize, sizeof(TBGRAPixel), nil) - else - result := BGRAPixelTransparent; -end; - -function TCustomUniversalBitmap.ScanAtIntegerExpanded(X, Y: integer): TExpandedPixel; -begin - if (FScanWidth <> 0) and (FScanHeight <> 0) then - FConvertToExpanded.Convert(GetPixelAddress(PositiveMod(X+ScanOffset.X, FScanWidth), - PositiveMod(Y+ScanOffset.Y, FScanHeight)), - @result, 1, FPixelSize, sizeof(TExpandedPixel), nil) - else - result := ExpandedPixelTransparent; -end; - -procedure TCustomUniversalBitmap.ScanMoveTo(X, Y: Integer); -begin - if (FScanWidth = 0) or (FScanHeight = 0) then exit; - LoadFromBitmapIfNeeded; - FScanCurX := PositiveMod(X+ScanOffset.X, FScanWidth); - FScanCurY := PositiveMod(Y+ScanOffset.Y, FScanHeight); - FScanPtr := GetPixelAddress(FScanCurX,FScanCurY); -end; - -function TCustomUniversalBitmap.ScanNextPixel: TBGRAPixel; -begin - if (FScanWidth <> 0) and (FScanHeight <> 0) then - begin - FConvertToBGRA.Convert(FScanPtr, @result, 1, FPixelSize, sizeof(TBGRAPixel), nil); - inc(FScanCurX); - inc(FScanPtr, FPixelSize); - if FScanCurX = FScanWidth then //cycle - begin - FScanCurX := 0; - dec(FScanPtr, FRowSize); - end; - end - else - result := BGRAPixelTransparent; -end; - -function TCustomUniversalBitmap.ScanNextExpandedPixel: TExpandedPixel; -begin - if (FScanWidth <> 0) and (FScanHeight <> 0) then - begin - FConvertToExpanded.Convert(FScanPtr, @result, 1, FPixelSize, sizeof(TExpandedPixel), nil); - inc(FScanCurX); - inc(FScanPtr, FPixelSize); - if FScanCurX = FScanWidth then //cycle - begin - FScanCurX := 0; - dec(FScanPtr, FRowSize); - end; - end - else - result := BGRAPixelTransparent; -end; - -function TCustomUniversalBitmap.ScanAt(X, Y: Single): TBGRAPixel; -begin - result := ScanAtInteger(round(X),round(Y)); -end; - -function TCustomUniversalBitmap.ScanAtExpanded(X, Y: Single): TExpandedPixel; -begin - result := ScanAtIntegerExpanded(round(X),round(Y)); -end; - -function TCustomUniversalBitmap.IsScanPutPixelsDefined: boolean; -begin - result := False; -end; - -procedure TCustomUniversalBitmap.ScanPutPixels(pdest: PBGRAPixel; - count: integer; mode: TDrawMode); -begin - //do nothing -end; - -procedure TCustomUniversalBitmap.ScanSkipPixels(ACount: integer); -var - fit: Integer; -begin - if (FScanWidth <= 0) or (FScanHeight <= 0) then exit; - if ACount >= FScanWidth then ACount := PositiveMod(ACount, FScanWidth); - fit := FScanWidth-FScanCurX; - if ACount >= fit then - begin - dec(ACount, fit); - dec(FScanPtr, FScanCurX*PtrInt(FPixelSize)); - FScanCurX := 0; - end; - inc(FScanCurX, ACount); - inc(FScanPtr, ACount*PtrInt(FPixelSize)); -end; - -function TCustomUniversalBitmap.GetImageBounds: TRect; -begin - result := GetImageBounds(cAlpha); -end; - -function TCustomUniversalBitmap.GetImageBounds(Channel: TChannel; - ANothingValue: Byte): TRect; -begin - result := GetImageBoundsWithin(rect(0,0,Width,Height), Channel, ANothingValue); -end; - -function TCustomUniversalBitmap.GetImageBounds(Channels: TChannels; - ANothingValue: Byte): TRect; -begin - result := GetImageBoundsWithin(rect(0,0,Width,Height), Channels, ANothingValue); -end; - -function TCustomUniversalBitmap.ProvidesScanline(ARect: TRect): boolean; -begin - result := false; -end; - -function TCustomUniversalBitmap.GetScanlineAt(X, Y: integer): PBGRAPixel; -begin - result := nil; -end; - -function TCustomUniversalBitmap.GetTextureGL: IUnknown; -begin - result := nil; -end; - -function TCustomUniversalBitmap.GetImageBoundsWithin(const ARect: TRect; - Channel: TChannel; ANothingValue: Byte): TRect; -var - idxChannel: Integer; - actualRect: TRect; - maxx, maxy, minx, miny, yb, xb, xb2: LongInt; - p: PByte; - minValueF, nothingValueF: Single; -begin - case Channel of - cAlpha: idxChannel := Colorspace.IndexOfAlphaChannel; - cRed: idxChannel := Colorspace.IndexOfChannel('Red'); - cGreen: idxChannel := Colorspace.IndexOfChannel('Green'); - cBlue: idxChannel := Colorspace.IndexOfChannel('Blue'); - else raise exception.Create('Unexpected channel'); - end; - if (idxChannel = -1) and (Channel in [cRed,cGreen,cBlue]) then - idxChannel := Colorspace.IndexOfChannel('Gray'); - if idxChannel = -1 then raise exception.Create('Channel not found'); - minValueF := Colorspace.GetMinValue(idxChannel); - nothingValueF := (ANothingValue - minValueF)/(Colorspace.GetMaxValue(idxChannel)-minValueF); - actualRect := TRect.Intersect(ARect, rect(0,0,Width,Height)); - maxx := actualRect.Left-1; - maxy := actualRect.Top-1; - minx := actualRect.Right; - miny := actualRect.Bottom; - for yb := actualRect.Top to actualRect.Bottom-1 do - begin - p := GetPixelAddress(actualRect.Left,yb); - for xb := actualRect.Left to actualRect.Right - 1 do - begin - if Colorspace.GetChannel(p, idxChannel) <> nothingValueF then - begin - if xb < minx then - minx := xb; - if yb < miny then - miny := yb; - if xb > maxx then - maxx := xb; - if yb > maxy then - maxy := yb; - - inc(p, (actualRect.Right-1-xb)*FPixelSize); - for xb2 := actualRect.Right-1 downto xb+1 do - begin - if Colorspace.GetChannel(p, idxChannel) <> nothingValueF then - begin - if xb2 > maxx then - maxx := xb2; - break; - end; - dec(p, FPixelSize); - end; - break; - end; - Inc(p, FPixelSize); - end; - end; - if minx > maxx then - begin - Result.left := 0; - Result.top := 0; - Result.right := 0; - Result.bottom := 0; - end - else - begin - Result.left := minx; - Result.top := miny; - Result.right := maxx + 1; - Result.bottom := maxy + 1; - end; -end; - -function TCustomUniversalBitmap.GetImageBoundsWithin(const ARect: TRect; - Channels: TChannels; ANothingValue: Byte): TRect; -var - c: TChannel; - resultForChannel: TRect; -begin - result := EmptyRect; - for c := low(TChannel) to high(TChannel) do - begin - if c in Channels then - begin - resultForChannel := GetImageBoundsWithin(ARect, c, ANothingValue); - if result.IsEmpty then result := resultForChannel - else result.Union(resultForChannel); - end; - end; -end; - -function TCustomUniversalBitmap.GetScanCustomColorspace: TColorspaceAny; -begin - result := Colorspace; -end; - -procedure TCustomUniversalBitmap.ScanNextCustomChunk(var ACount: integer; out - APixels: Pointer); -var - quantity: Integer; -begin - if (FScanWidth = 0) or (FScanHeight = 0) then raise exception.Create('Zero size scanner'); - APixels := FScanPtr; - quantity := FScanWidth-FScanCurX; - if ACount <= quantity then - quantity := ACount - else ACount := quantity; - Inc(FScanPtr, quantity*PtrInt(FPixelSize)); - inc(FScanCurX, quantity); - if FScanCurX = FWidth then - begin - FScanCurX := 0; - Dec(FScanPtr, RowSize); - end; -end; - -procedure TCustomUniversalBitmap.ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); -begin - raise exception.Create('This bitmap does not provide a mask.'); -end; - -function TCustomUniversalBitmap.ScanAtIntegerMask(X,Y: integer): TByteMask; -begin - result := ScanAtMask(X,Y); -end; - -function TCustomUniversalBitmap.ScanAtMask(X,Y: Single): TByteMask; -begin - result.gray := 0; - raise exception.Create('This bitmap does not provide a mask.'); -end; - -{ Interface gateway } -function TCustomUniversalBitmap.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - if GetInterface(iid, obj) then - Result := S_OK - else - Result := longint(E_NOINTERFACE); -end; - -{ There is no automatic reference counting, but it is compulsory to define these functions } -function TCustomUniversalBitmap._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -function TCustomUniversalBitmap._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; -begin - result := 0; -end; - -procedure TCustomUniversalBitmap.PutImage(X, Y: integer; - ASource: TCustomUniversalBitmap; AMode: TDrawMode; AOpacity: byte); -var - oldOfs: TPoint; -begin - if (ASource = nil) or (AOpacity = 0) then exit; - oldOfs := ASource.ScanOffset; - ASource.ScanOffset := Point(-X,-Y); - FillRect(RectWithSize(X,Y,ASource.Width,ASource.Height), ASource, AMode, AOpacity + (AOpacity shl 8)); - ASource.ScanOffset := oldOfs; -end; - -function TCustomUniversalBitmap.FilterBlurRadial(radius: single; - blurType: TRadialBlurType): TCustomUniversalBitmap; -begin - Result := FilterBlurRadial(rect(0,0,Width,Height), radius,radius, blurType); -end; - -function TCustomUniversalBitmap.FilterBlurRadial(const ABounds: TRect; - radius: single; blurType: TRadialBlurType): TCustomUniversalBitmap; -begin - Result := FilterBlurRadial(ABounds, radius,radius, blurType); -end; - -function TCustomUniversalBitmap.FilterBlurRadial(radiusX, radiusY: single; - blurType: TRadialBlurType): TCustomUniversalBitmap; -begin - Result := FilterBlurRadial(rect(0,0,Width,Height), radiusX,radiusY, blurType); -end; - -function TCustomUniversalBitmap.FilterBlurRadial(const ABounds: TRect; radiusX, - radiusY: single; blurType: TRadialBlurType): TCustomUniversalBitmap; -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - result := NewBitmap; result.SetSize(Width,Height); fillbyte(result.DataByte^, result.Height*result.RowSize, 0); - UniDrawerClass.FilterBlurRadial(self, ABounds, radiusX,radiusY, blurType, result); -end; - -function TCustomUniversalBitmap.FilterBlurMotion(distance: single; - angle: single; oriented: boolean): TCustomUniversalBitmap; -begin - result := FilterBlurMotion(rect(0,0,Width,Height), distance, angle, oriented); -end; - -function TCustomUniversalBitmap.FilterBlurMotion(const ABounds: TRect; - distance: single; angle: single; oriented: boolean): TCustomUniversalBitmap; -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - result := NewBitmap; result.SetSize(Width,Height); fillbyte(result.DataByte^, result.Height*result.RowSize, 0); - UniDrawerClass.FilterBlurMotion(self, ABounds, distance, angle, oriented, result); -end; - -function TCustomUniversalBitmap.FilterCustomBlur(mask: TCustomUniversalBitmap): TCustomUniversalBitmap; -begin - result := FilterCustomBlur(rect(0,0,Width,Height), mask); -end; - -function TCustomUniversalBitmap.FilterCustomBlur(const ABounds: TRect; - mask: TCustomUniversalBitmap): TCustomUniversalBitmap; -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - result := NewBitmap; result.SetSize(Width,Height); fillbyte(result.DataByte^, result.Height*result.RowSize, 0); - UniDrawerClass.FilterCustomBlur(self, ABounds, mask, result); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; - const ABrush: TUniversalBrush; APenWidth: single); -begin - FillPolyAntialias(GetInternalPen.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth), ABrush); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; - ATexture: IBGRAScanner; APenWidth: single); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawLineAntialias(x1,y1,x2,y2, b,APenWidth); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; - const ABrush: TUniversalBrush; APenWidth: single; AClosedCap: boolean); -begin - FillPolyAntialias(GetInternalPen.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,AClosedCap), ABrush); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; - ATexture: IBGRAScanner; APenWidth: single; AClosedCap: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawLineAntialias(x1,y1,x2,y2, b,APenWidth, AClosedCap); -end; - -procedure TCustomUniversalBitmap.EraseLineAntialias(x1, y1, x2, y2: single; - AAlpha: Byte; APenWidth: single); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - DrawLineAntialias(x1,y1,x2,y2, b, APenWidth); -end; - -procedure TCustomUniversalBitmap.EraseLineAntialias(x1, y1, x2, y2: single; - AAlpha: Byte; APenWidth: single; AClosedCap: boolean); -var - b: TUniversalBrush; - c: TBGRAPixel; - p: TBGRACustomPenStroker; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - c := BGRA(0,0,0, AAlpha); - p := GetInternalPen; - FillPolyAntialias(p.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,c,AClosedCap), b); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialias( - const APoints: array of TPointF; const ABrush: TUniversalBrush; - APenWidth: single); -begin - FillPolyAntialias(GetInternalPen.ComputePolyline(APoints,APenWidth),ABrush); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialias( - const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawPolyLineAntialias(APoints, b, APenWidth); -end; - -procedure TCustomUniversalBitmap.ErasePolyLineAntialias( - const APoints: array of TPointF; AAlpha: byte; APenWidth: single); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - DrawPolyLineAntialias(APoints, b, APenWidth); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialias( - const APoints: array of TPointF; const ABrush: TUniversalBrush; - APenWidth: single; AClosedCap: boolean); -begin - FillPolyAntialias(GetInternalPen.ComputePolyline(APoints,APenWidth,AClosedCap),ABrush); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialias( - const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single; - AClosedCap: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawPolyLineAntialias(APoints, b, APenWidth, AClosedCap); -end; - -procedure TCustomUniversalBitmap.ErasePolyLineAntialias( - const APoints: array of TPointF; AAlpha: byte; APenWidth: single; - AClosedCap: boolean); -var - b: TUniversalBrush; - c: TBGRAPixel; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - c := BGRA(0,0,0, AAlpha); - FillPolyAntialias(GetInternalPen.ComputePolyline(APoints,APenWidth,c,AClosedCap), b); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialiasAutocycle( - const APoints: array of TPointF; const ABrush: TUniversalBrush; - APenWidth: single); -begin - FillPolyAntialias(GetInternalPen.ComputePolylineAutoCycle(APoints,APenWidth),ABrush); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialiasAutocycle( - const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawPolyLineAntialiasAutocycle(APoints, b, APenWidth); -end; - -procedure TCustomUniversalBitmap.ErasePolyLineAntialiasAutocycle( - const APoints: array of TPointF; AAlpha: byte; APenWidth: single); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - DrawPolyLineAntialiasAutocycle(APoints, b, APenWidth); -end; - -procedure TCustomUniversalBitmap.DrawPolygonAntialias( - const APoints: array of TPointF; const ABrush: TUniversalBrush; - APenWidth: single); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawPolygonAntialias(self, GetInternalPen, APoints, ABrush, APenWidth); -end; - -procedure TCustomUniversalBitmap.DrawPolygonAntialias( - const APoints: array of TPointF; ATexture: IBGRAScanner; APenWidth: single); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawPolygonAntialias(APoints, b, APenWidth); -end; - -procedure TCustomUniversalBitmap.ErasePolygonOutlineAntialias( - const APoints: array of TPointF; AAlpha: byte; APenWidth: single); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - DrawPolygonAntialias(APoints, b, APenWidth); -end; - -procedure TCustomUniversalBitmap.RectangleAntialias(x, y, x2, y2: single; - const ABrush: TUniversalBrush; AWidth: single); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.RectangleAntialias(self, GetInternalPen, x, y, x2, y2, ABrush, AWidth); -end; - -procedure TCustomUniversalBitmap.RectangleAntialias(x, y, x2, y2: single; - ATexture: IBGRAScanner; AWidth: single); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AntialiasingDrawMode); - RectangleAntialias(x,y,x2,y2, b, AWidth); -end; - -procedure TCustomUniversalBitmap.Ellipse(x, y, rx, ry: single; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.Ellipse(self, GetInternalPen, x,y,rx,ry, ABrush, AWidth, AAlpha); -end; - -procedure TCustomUniversalBitmap.Ellipse(x, y, rx, ry: single; - ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AMode); - Ellipse(x,y,rx,ry, b, AWidth, AAlpha); -end; - -procedure TCustomUniversalBitmap.Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.Ellipse(self, GetInternalPen, AOrigin, AXAxis, AYAxis, ABrush, AWidth, AAlpha); -end; - -procedure TCustomUniversalBitmap.Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; - ATexture: IBGRAScanner; AWidth: single; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AMode); - Ellipse(AOrigin, AXAxis, AYAxis, b,AWidth,AAlpha); -end; - -procedure TCustomUniversalBitmap.EllipseAntialias(x, y, rx, ry: single; - const ABrush: TUniversalBrush; AWidth: single); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.EllipseAntialias(self, GetInternalPen, x,y,rx,ry, ABrush, AWidth); -end; - -procedure TCustomUniversalBitmap.EllipseAntialias(x, y, rx, ry: single; - ATexture: IBGRAScanner; AWidth: single); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - EllipseAntialias(x,y,rx,ry, b, AWidth); -end; - -procedure TCustomUniversalBitmap.EllipseAntialias(const AOrigin, AXAxis, - AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.EllipseAntialias(self, GetInternalPen, AOrigin, AXAxis, AYAxis, ABrush, AWidth); -end; - -procedure TCustomUniversalBitmap.EllipseAntialias(const AOrigin, AXAxis, - AYAxis: TPointF; ATexture: IBGRAScanner; AWidth: single); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - EllipseAntialias(AOrigin, AXAxis, AYAxis, b,AWidth); -end; - -procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; - const ABrush: TUniversalBrush; AWidth: single; - APixelCenteredCoordinates: boolean); -var - data: TPathCallbackData; -begin - if ABrush.DoesNothing then exit; - if UniDrawerClass=nil then RaiseMissingUniDrawer; - data.BrushAddress := @ABrush; - data.Alpha:= 65535; - data.Width:= AWidth; - data.PixelCenteredCoords := APixelCenteredCoordinates; - APath.stroke(@PathStrokeAntialiasCallback, @data); -end; - -procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; - ATexture: IBGRAScanner; AWidth: single; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawPath(APath, b,AWidth,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; AWidth: single; - APixelCenteredCoordinates: boolean); -var - data: TPathCallbackData; -begin - if ABrush.DoesNothing then exit; - if UniDrawerClass=nil then RaiseMissingUniDrawer; - data.BrushAddress := @ABrush; - data.Alpha:= 65535; - data.Width:= AWidth; - data.PixelCenteredCoords := APixelCenteredCoordinates; - APath.stroke(@PathStrokeAntialiasCallback, AMatrix, @data); -end; - -procedure TCustomUniversalBitmap.DrawPath(APath: IBGRAPath; - const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - DrawPath(APath,AMatrix, b,AWidth,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillShapeAntialias( - AShape: TBGRACustomFillInfo; const ABrush: TUniversalBrush); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillShapeAntialias(self, AShape, FillMode, - ABrush); -end; - -procedure TCustomUniversalBitmap.FillShapeAntialias( - AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AntialiasingDrawMode); - FillShapeAntialias(AShape, b); -end; - -procedure TCustomUniversalBitmap.EraseShapeAntialias( - AShape: TBGRACustomFillInfo; AAlpha: Byte); -var - b: TUniversalBrush; -begin - EraseBrush(b, AAlpha + (AAlpha shl 8)); - FillShapeAntialias(AShape, b); -end; - -procedure TCustomUniversalBitmap.SetLineOrder(AValue: TRawImageLineOrder); -begin - FLineOrder:= AValue; -end; - -procedure TCustomUniversalBitmap.Init; -begin - FRefCount := 1; - if FColorspace = nil then FColorspace := DefaultColorspace; - FPixelSize := FColorspace.GetSize; - FConvertToFPColor:= FColorspace.GetBridgedConversion(TFPColorColorspace); - FConvertFromFPColor:= TFPColorColorspace.GetBridgedConversion(FColorspace); - FConvertToBGRA := FColorspace.GetBridgedConversion(TBGRAPixelColorspace); - FConvertFromBGRA := TBGRAPixelColorspace.GetBridgedConversion(FColorspace); - FConvertToExpanded := FColorspace.GetBridgedConversion(TExpandedPixelColorspace); - FConvertFromExpanded := TExpandedPixelColorspace.GetBridgedConversion(FColorspace); - FReferenceWhite := nil; - FWidth := 0; - FHeight := 0; - - FScanWidth := 0; - FScanHeight:= 0; - ScanOffset := Point(0,0); - FScanPtr := nil; - FScanCurX:= 0; - FScanCurY:= 0; - - FNbPixels := 0; - FRowSize := 0; - FDataByte := nil; - FLineOrder := riloTopToBottom; - FClipRect := EmptyRect; - FillMode := fmWinding; - FAntialiasingDrawMode:= dmDrawWithTransparency; - FPenStroker := nil; -end; - -procedure TCustomUniversalBitmap.InvalidateBitmap; -begin - //not linked to a bitmap -end; - -procedure TCustomUniversalBitmap.LoadFromBitmapIfNeeded; -begin - //not linked to a bitmap -end; - -class procedure TCustomUniversalBitmap.EraseBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - raise exception.Create('Erase brush not implemented'); -end; - -class procedure TCustomUniversalBitmap.AlphaBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - raise exception.Create('Alpha brush not implemented'); -end; - -procedure TCustomUniversalBitmap.SolidBrushBGRA(out ABrush: TUniversalBrush; - ARed, AGreen, ABlue, AAlpha: Byte; ADrawMode: TDrawMode); -var c: TBGRAPixel; - c2: array[0..31] of byte; -begin - c.red := ARed; c.green := AGreen; c.blue := ABlue; c.alpha := AAlpha; - FConvertFromBGRA.Convert(@c,@c2,1,sizeof(c),FPixelSize,FReferenceWhite); - SolidBrushIndirect(ABrush, @c2, ADrawMode); -end; - -procedure TCustomUniversalBitmap.SolidBrushBGRA(out ABrush: TUniversalBrush; - AColor: TBGRAPixel; ADrawMode: TDrawMode); -var - c2: array[0..31] of byte; -begin - FConvertFromBGRA.Convert(@AColor,@c2,1,sizeof(AColor),FPixelSize,FReferenceWhite); - SolidBrushIndirect(ABrush, @c2, ADrawMode); -end; - -procedure TCustomUniversalBitmap.SolidBrushExpanded(out - ABrush: TUniversalBrush; ARed, AGreen, ABlue, AAlpha: Word; - ADrawMode: TDrawMode); -var c: TExpandedPixel; - c2: array[0..31] of byte; -begin - c.red := ARed; c.green := AGreen; c.blue := ABlue; c.alpha := AAlpha; - FConvertFromExpanded.Convert(@c,@c2,1,sizeof(c),FPixelSize,FReferenceWhite); - SolidBrushIndirect(ABrush, @c2, ADrawMode); -end; - -procedure TCustomUniversalBitmap.SolidBrushExpanded(out - ABrush: TUniversalBrush; AColor: TExpandedPixel; ADrawMode: TDrawMode); -var - c2: array[0..31] of byte; -begin - FConvertFromExpanded.Convert(@AColor,@c2,1,sizeof(AColor),FPixelSize,FReferenceWhite); - SolidBrushIndirect(ABrush, @c2, ADrawMode); -end; - -procedure DefaultSolidBrushIndirectSkipPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -begin - inc(AContextData^.Dest, ACount*PtrInt(PDefaultSolidBrushIndirectFixedData(AFixedData)^.PixelSize)); -end; - -procedure DefaultSolidBrushIndirectSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PByte; -begin - if AAlpha < 32768 then - begin - inc(AContextData^.Dest, ACount*PtrInt(PDefaultSolidBrushIndirectFixedData(AFixedData)^.PixelSize)); - exit; - end; - pDest := AContextData^.Dest; - while ACount > 0 do - begin - with PDefaultSolidBrushIndirectFixedData(AFixedData)^ do - begin - move(Color, pDest^, PixelSize); - inc(pDest, PixelSize); - end; - dec(ACount); - end; - AContextData^.Dest := pDest; -end; - -procedure TCustomUniversalBitmap.SolidBrushIndirect(out ABrush: TUniversalBrush; - AColor: Pointer; ADrawMode: TDrawMode); -var - ct: TColorTransparency; -begin - if FPixelSize+4 > sizeof(ABrush.FixedData) then - raise exception.Create('Brush fixed data size too small'); - - ct := Colorspace.GetColorTransparency(AColor); - if (ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and - (ct = ctSemiTransparent) then - raise exception.Create('Semi-tranparent drawing not handled by default brush') - else if ADrawMode = dmXor then - raise exception.Create('Xor mode not handled by default brush'); - - ABrush.Colorspace := Colorspace; - PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.PixelSize:= FPixelSize; - - if (ADrawMode <> dmSet) and (ct <> ctFullyOpaque) then - begin - ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSkipPixels; - ABrush.DoesNothing:= true; - end - else - begin - move(AColor^, PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.Color, FPixelSize); - ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSetPixels - end; -end; - -class procedure TCustomUniversalBitmap.ScannerBrush(out - ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode; - AOffsetX: integer = 0; AOffsetY: integer = 0); -begin - raise exception.Create('Scanner brush not implemented'); -end; - -class procedure TCustomUniversalBitmap.MaskBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); -begin - raise exception.Create('Mask brush not implemented'); -end; - -procedure TCustomUniversalBitmap.ReallocData; -begin - ReAllocMem(FDataByte, FHeight * FRowSize); - if (FNbPixels > 0) and (FDataByte = nil) then - raise EOutOfMemory.Create('TUniversalBitmap: Not enough memory'); - InvalidateBitmap; - FScanPtr:= nil; -end; - -procedure TCustomUniversalBitmap.FreeData; -begin - Freemem(FDataByte); - FDataByte := nil; - FScanPtr:= nil; -end; - -function TCustomUniversalBitmap.CheckClippedRectBounds(var x, y, x2, y2: integer): boolean; -var - temp: integer; -begin - if (x > x2) then - begin - temp := x; - x := x2; - x2 := temp; - end; - if (y > y2) then - begin - temp := y; - y := y2; - y2 := temp; - end; - if (x >= FClipRect.Right) or (x2 <= FClipRect.Left) or (y >= FClipRect.Bottom) or (y2 <= FClipRect.Top) then - begin - result := false; - exit; - end; - if x < FClipRect.Left then - x := FClipRect.Left; - if x2 > FClipRect.Right then - x2 := FClipRect.Right; - if y < FClipRect.Top then - y := FClipRect.Top; - if y2 > FClipRect.Bottom then - y2 := FClipRect.Bottom; - if (x2 - x <= 0) or (y2 - y <= 0) then - begin - result := false; - exit; - end else - result := true; -end; - -function TCustomUniversalBitmap.PtInClipRect(x, y: int32or64): boolean; -begin - result := (x >= FClipRect.Left) and (y >= FClipRect.Top) and (x < FClipRect.Right) and (y < FClipRect.Bottom); -end; - -procedure TCustomUniversalBitmap.SetInternalColor(x, y: integer; const Value: TFPColor); -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - FConvertFromFPColor.Convert(@Value, GetPixelAddress(x,y), - 1, sizeof(TFPColor), FPixelSize, FReferenceWhite); - InvalidateBitmap; -end; - -function TCustomUniversalBitmap.GetInternalColor(x, y: integer): TFPColor; -begin - if not PtInClipRect(x,y) then exit(colTransparent); - LoadFromBitmapIfNeeded; - FConvertToFPColor.Convert(GetPixelAddress(x,y), @result, - 1, FPixelSize, sizeof(TFPColor), FReferenceWhite); -end; - -procedure TCustomUniversalBitmap.SetInternalPixel(x, y: integer; Value: integer); -begin - SetInternalColor(x,y, Palette.Color[Value]); -end; - -function TCustomUniversalBitmap.GetInternalPixel(x, y: integer): integer; -begin - result := Palette.IndexOf(GetInternalColor(x,y)); -end; - -constructor TCustomUniversalBitmap.Create; -begin - Init; - inherited Create(0, 0); -end; - -constructor TCustomUniversalBitmap.Create(AColorspace: TColorspaceAny; - ALineOrder: TRawImageLineOrder); -begin - FColorspace := AColorspace; - Init; - FLineOrder:= ALineOrder; - inherited Create(0,0); -end; - -constructor TCustomUniversalBitmap.Create(AWidth, AHeight: integer); -begin - Init; - inherited Create(AWidth, AHeight); - if FDataByte<>nil then FillByte(FDataByte^, FHeight*FRowSize, 0); -end; - -constructor TCustomUniversalBitmap.Create(AColorspace: TColorspaceAny; AWidth, - AHeight: integer; ALineOrder: TRawImageLineOrder); -begin - FColorspace := AColorspace; - Init; - FLineOrder:= ALineOrder; - inherited Create(AWidth, AHeight); - if FDataByte<>nil then FillByte(FDataByte^, FHeight*FRowSize, 0); -end; - -procedure TCustomUniversalBitmap.Assign(Source: TPersistent); -var pdest: PByte; - x,y: Int32or64; - col: TFPColor; -begin - if Source is TCustomUniversalBitmap then - begin - SetSize(TCustomUniversalBitmap(Source).Width, TCustomUniversalBitmap(Source).Height); - PutImage(0, 0, TCustomUniversalBitmap(Source), dmSet); - end else - if Source is TFPCustomImage then - begin - SetSize(TFPCustomImage(Source).Width, TFPCustomImage(Source).Height); - for y := 0 to TFPCustomImage(Source).Height-1 do - begin - pdest := GetPixelAddress(0,y); - for x := 0 to TFPCustomImage(Source).Width-1 do - begin - col := TFPCustomImage(Source).Colors[x,y]; - FConvertFromFPColor.Convert(@col, pdest, 1, sizeof(TFPColor), FPixelSize, nil); - inc(pdest); - end; - end; - end else - inherited Assign(Source); -end; - -function TCustomUniversalBitmap.NewBitmap: TCustomUniversalBitmap; -begin - result := InternalNew; -end; - -function TCustomUniversalBitmap.NewBitmap(AWidth, AHeight: integer): TCustomUniversalBitmap; -var - c: array[0..23] of byte; -begin - AssignTransparentPixel(c); - result := NewBitmap(AWidth, AHeight, @c); -end; - -function TCustomUniversalBitmap.NewBitmap(AWidth, AHeight: integer; - AColor: Pointer): TCustomUniversalBitmap; -var - b: TUniversalBrush; -begin - result := InternalNew; - result.SetSize(AWidth,AHeight); - SolidBrushIndirect(b, AColor, dmSet); - result.Fill(b); -end; - -function TCustomUniversalBitmap.NewReference: TCustomUniversalBitmap; -begin - if self <> nil then Inc(FRefCount); - Result := self; -end; - -procedure TCustomUniversalBitmap.FreeReference; -begin - if self = nil then - exit; - - if FRefCount > 0 then - begin - Dec(FRefCount); - if FRefCount = 0 then - begin - self.Destroy; - end; - end; -end; - -function TCustomUniversalBitmap.GetUnique: TCustomUniversalBitmap; -begin - if FRefCount > 1 then - begin - Dec(FRefCount); - Result := self.Duplicate; - end - else - Result := self; -end; - -function TCustomUniversalBitmap.Duplicate(ACopyProperties: boolean): TCustomUniversalBitmap; -begin - result := InternalDuplicate(ACopyProperties); -end; - -procedure TCustomUniversalBitmap.CopyPropertiesTo( - ABitmap: TCustomUniversalBitmap); -begin - ABitmap.FillMode := FillMode; - ABitmap.ClipRect := ClipRect; - ABitmap.ScanOffset := ScanOffset; -end; - -function TCustomUniversalBitmap.GetPart(const ARect: TRect): TCustomUniversalBitmap; -var - sx, sy: integer; - xSrc0, ySrc, remainX, xSrc, yDest, copyCount, copyByte: integer; - pSrc, pDest, pSrcLine: PByte; -begin - sx := ARect.Width; - sy := ARect.Height; - if (sx = 0) or (sy = 0) then exit(nil); - result := InternalNew; - result.SetSize(sx,sy); - if (FWidth = 0) or (FHeight = 0) then - begin - result.FillTransparent; - exit; - end; - LoadFromBitmapIfNeeded; - xSrc0 := PositiveMod(ARect.Left, FWidth); - ySrc := PositiveMod(ARect.Top, FHeight); - for yDest := 0 to sy-1 do - begin - xSrc := xSrc0; - pSrcLine := GetScanLineByte(ySrc); - pSrc := pSrcLine + xSrc*FPixelSize; - pDest := result.GetScanLineByte(yDest); - remainX := sx; - while remainX > 0 do - begin - if xSrc+remainX > FWidth then - begin - copyCount := FWidth-xSrc; - copyByte := copyCount*FPixelSize; - move(pSrc^, pDest^, copyByte); - inc(pDest, copyByte); - xSrc := 0; - pSrc := pSrcLine; - dec(remainX, copyCount); - end - else - begin - move(pSrc^, pDest^, remainX*FPixelSize); - break; - end; - end; - inc(ySrc); - if ySrc = FHeight then ySrc := 0; - end; - result.InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.SetSize(AWidth, AHeight: integer); -var - nbPixels64: Int64; -begin - if AWidth < 0 then AWidth := 0; - if AHeight < 0 then AHeight := 0; - if (AWidth = Width) and (AHeight = Height) then exit; - inherited SetSize(AWidth, AHeight); - FWidth := AWidth; - FHeight := AHeight; - FScanWidth := AWidth; - FScanHeight:= AHeight; - nbPixels64 := int64(AWidth) * int64(AHeight); - if nbPixels64 > maxLongint then - begin - // 2 gigapixels limit - raise EOutOfMemory.Create('Image too big'); - end; - FNbPixels := nbPixels64; - FRowSize := PtrInt(FWidth)*FPixelSize; - ReallocData; - NoClip; -end; - -destructor TCustomUniversalBitmap.Destroy; -begin - FreeData; - FreeAndNil(FPenStroker); - inherited Destroy; -end; - -procedure TCustomUniversalBitmap.Serialize(AStream: TStream); -var lWidth,lHeight,y: integer; -begin - lWidth := NtoLE(Width); - lHeight := NtoLE(Height); - AStream.Write(lWidth,sizeof(lWidth)); - AStream.Write(lHeight,sizeof(lHeight)); - for y := 0 to Height-1 do - AStream.Write(GetPixelAddress(0,y)^, RowSize); -end; - -procedure TCustomUniversalBitmap.Deserialize(AStream: TStream); -var lWidth,lHeight,y: integer; -begin - lWidth := 0; - lHeight := 0; - AStream.Read(lWidth,sizeof(lWidth)); - AStream.Read(lHeight,sizeof(lHeight)); - lWidth := LEtoN(lWidth); - lHeight := LEtoN(lHeight); - SetSize(lWidth,lHeight); - for y := 0 to Height-1 do - AStream.Read(GetPixelAddress(0,y)^, RowSize); - InvalidateBitmap; -end; - -class procedure TCustomUniversalBitmap.SerializeEmpty(AStream: TStream); -var zero: integer; -begin - zero := 0; - AStream.Write(zero,sizeof(zero)); - AStream.Write(zero,sizeof(zero)); -end; - -procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: string); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromFile(self, AFilename); -end; - -procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: string; - AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromFile(self, AFilename, AOptions); -end; - -procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: String; - AHandler: TFPCustomImageReader); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromFile(self, AFilename, AHandler); -end; - -procedure TCustomUniversalBitmap.LoadFromFile(const AFilename: String; - AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromFile(self, AFilename, AHandler, AOptions); -end; - -procedure TCustomUniversalBitmap.LoadFromFileUTF8(const AFilenameUTF8: string; - AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromFileUTF8(self, AFilenameUTF8, AOptions); -end; - -procedure TCustomUniversalBitmap.LoadFromFileUTF8(const AFilenameUTF8: string; - AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromFileUTF8(self, AFilenameUTF8, AHandler, AOptions); -end; - -procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromStream(self, AStream); -end; - -procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream; - AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromStream(self, AStream, AOptions); -end; - -procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream; - AHandler: TFPCustomImageReader); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromStream(self, AStream, AHandler); -end; - -procedure TCustomUniversalBitmap.LoadFromStream(AStream: TStream; - AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromStream(self, AStream, AHandler, AOptions); -end; - -procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromResource(self, AFilename); -end; - -procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string; - AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromResource(self, AFilename, AOptions); -end; - -procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string; - AHandler: TFPCustomImageReader); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromResource(self, AFilename, AHandler); -end; - -procedure TCustomUniversalBitmap.LoadFromResource(AFilename: string; - AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.LoadFromResource(self, AFilename, AHandler, AOptions); -end; - -procedure TCustomUniversalBitmap.SaveToFile(const AFilename: string); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.SaveToFile(self, AFilename); -end; - -procedure TCustomUniversalBitmap.SaveToFile(const AFilename: string; - AHandler: TFPCustomImageWriter); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.SaveToFile(self, AFilename, AHandler); -end; - -procedure TCustomUniversalBitmap.SaveToFileUTF8(const AFilenameUTF8: string); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.SaveToFileUTF8(self, AFilenameUTF8); -end; - -procedure TCustomUniversalBitmap.SaveToFileUTF8(const AFilenameUTF8: string; - AHandler: TFPCustomImageWriter); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.SaveToFile(self, AFilenameUTF8, AHandler); -end; - -procedure TCustomUniversalBitmap.SaveToStreamAs(AStream: TStream; - AFormat: TBGRAImageFormat); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.SaveToStreamAs(self, AStream, AFormat); -end; - -procedure TCustomUniversalBitmap.SaveToStreamAsPng(AStream: TStream); -begin - if UniDrawerClass = nil then RaiseMissingUniDrawer; - UniDrawerClass.SaveToStreamAsPng(self, AStream); -end; - -procedure TCustomUniversalBitmap.NoClip; -begin - FClipRect := rect(0,0,FWidth,FHeight); -end; - -function TCustomUniversalBitmap.IntersectClip(const ARect: TRect): TRect; -var - remain: TRect; -begin - result := ClipRect; - remain := TRect.Intersect(ARect, result); - ClipRect := remain; -end; - -procedure TCustomUniversalBitmap.Fill(const ABrush: TUniversalBrush; AAlpha: Word = 65535); -var - pDest: PByte; - delta: PtrInt; - yb: Integer; - ctx: TUniBrushContext; -begin - if ABrush.DoesNothing or (NbPixels = 0) then exit; - LoadFromBitmapIfNeeded; - if LineOrder = riloBottomToTop then - delta := -RowSize - else - delta := RowSize; - pDest := GetPixelAddress(0,0); - for yb := 0 to Height-1 do - begin - ABrush.MoveTo(@ctx, pDest,0,yb); - ABrush.PutNextPixels(@ctx, AAlpha,Width); - inc(pDest, delta); - end; - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.Fill(ATexture: IBGRAScanner; AMode: TDrawMode); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - Fill(b); -end; - -procedure TCustomUniversalBitmap.Fill(ATexture: IBGRAScanner; AMode: TDrawMode; - AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - Fill(b, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillTransparent; -var - b: TUniversalBrush; -begin - EraseBrush(b, 65535); - Fill(b); -end; - -procedure TCustomUniversalBitmap.AlphaFill(alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - Fill(b); -end; - -procedure TCustomUniversalBitmap.ApplyMask(mask: TCustomUniversalBitmap; AAlpha: Word); -begin - ApplyMask(mask, Rect(0,0,Width,Height), Point(0,0), AAlpha); -end; - -procedure TCustomUniversalBitmap.ApplyMask(mask: TCustomUniversalBitmap; ARect: TRect; AAlpha: Word); -begin - ApplyMask(mask, ARect, ARect.TopLeft, AAlpha); -end; - -{ Apply a mask to the bitmap. It means that alpha channel is - changed according to grayscale values of the mask. - - See : http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_5 } -procedure TCustomUniversalBitmap.ApplyMask(mask: TCustomUniversalBitmap; - ARect: TRect; AMaskRectTopLeft: TPoint; AAlpha: Word); -var - b: TUniversalBrush; -begin - MaskBrush(b, mask, AMaskRectTopLeft.X-ARect.Left, AMaskRectTopLeft.Y-ARect.Top); - FillRect(ARect, b, AAlpha); -end; - -procedure TCustomUniversalBitmap.ApplyGlobalOpacity(alpha: byte); -begin - ApplyGlobalOpacity(ClipRect, alpha); -end; - -procedure TCustomUniversalBitmap.FillMask(x, y: integer; - AMask: TCustomUniversalBitmap; const ABrush: TUniversalBrush); -var - yb, remain: integer; - pScan: PByte; - delta: PtrInt; - ctx: TUniBrushContext; - r: TRect; - chunkCount, maskStride: integer; - maskSrc: PByteMask; - curVal: byte; - brushCount: integer; -begin - if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; - r := RectWithSize(x,y,AMask.Width,AMask.Height); - - if not CheckClippedRectBounds(r.Left,r.Top,r.Right,r.Bottom) - or ABrush.DoesNothing then exit; - - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(r.Left, r.Top); - if LineOrder = riloBottomToTop then - delta := -RowSize - else delta := RowSize; - - for yb := r.Top to r.Bottom-1 do - begin - ABrush.MoveTo(@ctx, pScan, r.Left, yb); - AMask.ScanMoveTo(r.Left - x, yb - y); - remain := r.Width; - while remain > 0 do - begin - chunkCount := remain; - AMask.ScanNextMaskChunk(chunkCount, maskSrc, maskStride); - dec(remain, chunkCount); - while chunkCount > 0 do - begin - curVal := maskSrc^.gray; - inc(maskSrc, maskStride); - dec(chunkCount); - brushCount := 1; - while (chunkCount > 0) and (maskSrc^.gray = curVal) do - begin - inc(maskSrc, maskStride); - dec(chunkCount); - inc(brushCount); - end; - ABrush.PutNextPixels(@ctx, curVal + (curVal shl 8), brushCount); - end; - end; - inc(pScan, delta); - end; - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.FillMask(x, y: integer; - AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner); -begin - FillMask(x,y, AMask, ATexture, dmDrawWithTransparency); -end; - -procedure TCustomUniversalBitmap.FillMask(x, y: integer; - AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode); -begin - FillMask(x,y, AMask, ATexture, AMode, Point(0,0)); -end; - -procedure TCustomUniversalBitmap.FillMask(x, y: integer; - AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; AMode: TDrawMode; - AScanOffset: TPoint); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode, AScanOffset.X, AScanOffset.Y); - FillMask(x,y, AMask, b); -end; - -procedure TCustomUniversalBitmap.ApplyGlobalOpacity(ARect: TRect; alpha: byte); -begin - EraseRect(ARect, 255-alpha); -end; - -procedure TCustomUniversalBitmap.DrawCheckers(ARect: TRect; const ABrushEven, - ABrushOdd: TUniversalBrush; AGridWidth: integer; AGridHeight: integer); -var xcount,patY,yb,w,n,patX,patX1,patX1b: Int32or64; - pdest: PByte; - delta: PtrInt; - actualRect: TRect; - ctxEven,ctxOdd: TUniBrushContext; -begin - actualRect := TRect.Intersect(ARect, ClipRect); - if actualRect.IsEmpty then exit; - w := actualRect.Right-actualRect.Left; - delta := self.RowSize; - if self.LineOrder = riloBottomToTop then delta := -delta; - pdest := self.GetPixelAddress(actualRect.left, actualRect.Top); - patY := (actualRect.Top - ARect.Top) mod (AGridHeight shl 1); - patX1 := (actualRect.Left - ARect.Left) mod (AGridWidth shl 1); - patX1b := (patX1+AGridWidth) mod (AGridWidth shl 1); - for yb := actualRect.Top to actualRect.Bottom-1 do - begin - if patY < AGridHeight then - patX := patX1 - else patX := patX1b; - ABrushEven.MoveTo(@ctxEven, pdest, actualRect.Left,yb); - ABrushOdd.MoveTo(@ctxOdd, pdest, actualRect.Left,yb); - xcount := w; - if patX >= AGridWidth then - begin - n := (AGridWidth shl 1) - patX; - if n > xcount then n := xcount; - ABrushEven.PutNextPixels(@ctxEven, $ffff, n); - ABrushOdd.PutNextPixels(@ctxOdd, 0, n); - dec(xcount,n); - patX := 0; - end; - while xcount > 0 do - begin - n := AGridWidth - patX; - if n > xcount then n := xcount; - ABrushOdd.PutNextPixels(@ctxOdd, $ffff, n); - ABrushOdd.PutNextPixels(@ctxEven, 0, n); - dec(xcount, n); - patX := AGridWidth; - - if xcount > 0 then - begin - n := (AGridWidth shl 1) - patX; - if n > xcount then n := xcount; - ABrushEven.PutNextPixels(@ctxEven, $ffff, n); - ABrushOdd.PutNextPixels(@ctxOdd, 0, n); - dec(xcount, n); - patX := 0; - end; - end; - inc(pbyte(pdest), delta); - inc(patY); - if patY = AGridHeight shl 1 then patY := 0; - end; - self.InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.FillRect(ALeft, ATop, ARight, ABottom: integer; - const ABrush: TUniversalBrush; AAlpha: Word); -var - yb, sx: integer; - pScan: PByte; - delta: PtrInt; - ctx: TUniBrushContext; -begin - if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; - if not CheckClippedRectBounds({%H-}ALeft,{%H-}ATop,{%H-}ARight,{%H-}ABottom) or - (AAlpha = 0) or ABrush.DoesNothing then exit; - - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(ALeft, ATop); - if LineOrder = riloBottomToTop then - delta := -RowSize - else - delta := RowSize; - sx := ARight - ALeft; - - for yb := ATop to ABottom-1 do - begin - ABrush.MoveTo(@ctx, pScan,ALeft,yb); - ABrush.PutNextPixels(@ctx, AAlpha,sx); - inc(pScan, delta); - end; - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.FillRect(const ARect: TRect; - const ABrush: TUniversalBrush; AAlpha: Word); -begin - FillRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, ABrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillRect(ALeft, ATop, ARight, - ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - FillRect(ALeft, ATop, ARight, ABottom, b, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillRect(const ARect: TRect; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -begin - FillRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, ATexture, AMode, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillRect(ALeft, ATop, ARight, - ABottom: integer; ATexture: IBGRAScanner; AMode: TDrawMode; - AScanOffset: TPoint; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AMode,AScanOffset.X,AScanOffset.Y); - FillRect(ALeft,ATop,ARight,ABottom, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.FillRect(const ARect: TRect; - ATexture: IBGRAScanner; AMode: TDrawMode; AScanOffset: TPoint; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AMode,AScanOffset.X,AScanOffset.Y); - FillRect(ARect, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.EraseRect(ALeft, ATop, ARight, - ABottom: integer; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - FillRect(ALeft, ATop, ARight, ABottom, b); -end; - -procedure TCustomUniversalBitmap.EraseRect(const ARect: TRect; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - FillRect(ARect, b); -end; - -procedure TCustomUniversalBitmap.AlphaFillRect(ALeft, ATop, ARight, - ABottom: integer; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillRect(ALeft, ATop, ARight, ABottom, b); -end; - -procedure TCustomUniversalBitmap.AlphaFillRect(const ARect: TRect; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillRect(ARect, b); -end; - -procedure TCustomUniversalBitmap.SetPixelIndirect(x, y: int32or64; AColor: pointer); -var - pScan: PByte; -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(x,y); - move(AColor^, pScan^, FPixelSize); - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.GetPixelIndirect(x, y: int32or64; AColor: pointer); -var - pScan: Pointer; -begin - if (x < 0) or (x >= FWidth) or (y < 0) or (y >= FHeight) then //it is possible to read pixels outside of the cliprect - AssignTransparentPixel(AColor^) - else - begin - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(x,y); - move(pScan^, AColor^, FPixelSize); - end; -end; - -procedure TCustomUniversalBitmap.GetPixelCycleIndirect(x, y: int32or64; - AColor: pointer); -var - pScan: PByte; -begin - if (FWidth=0) or (FHeight=0) then AssignTransparentPixel(AColor^) - else - begin - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(PositiveMod(x, Width), PositiveMod(y, Height)); - move(pScan^, AColor^, FPixelSize); - end; -end; - -procedure TCustomUniversalBitmap.DrawPixel(x, y: Int32or64; - const ABrush: TUniversalBrush; AAlpha: Word); -var - pScan: Pointer; - ctx: TUniBrushContext; -begin - if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; - if not PtInClipRect(x,y) or (AAlpha = 0) then exit; - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(x,y); - ABrush.MoveTo(@ctx, pScan,x,y); - ABrush.PutNextPixels(@ctx, AAlpha,1); - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.DrawPixel(x, y: Int32or64; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - DrawPixel(x,y, b, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawPixelF(x, y: single; - const ABrush: TUniversalBrush; AAlpha: Word); -var - ix, iy: integer; - fracX, fracY: longword; - aFracX, aFracY: word; -begin - if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; - ix := floor(x); fracX := round((x-ix)*65536); - if fracX = 65536 then begin fracX := 0; inc(ix); end; - iy := floor(y); fracY := round((y-iy)*65536); - if fracY = 65536 then begin fracY := 0; inc(iy); end; - if (ix >= Width) or (iy >= Height) then exit; - if (ix < -integer(fracX <> 0)) or (iy < -integer(fracy <> 0)) then exit; - aFracX := (AAlpha*fracX+32768) shr 16; - DrawPixel(ix,iy, ABrush, ((not aFracX)*longword(65536-fracY)+32768) shr 16); - DrawPixel(ix+1,iy, ABrush, (aFracX*longword(65536-fracY)+32768) shr 16); - DrawPixel(ix,iy+1, ABrush, ((not aFracX)*fracY+32768) shr 16); - DrawPixel(ix+1,iy+1, ABrush, (aFracX*fracY+32768) shr 16); -end; - -procedure TCustomUniversalBitmap.DrawPixelF(x, y: single; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - DrawPixelF(x,y, b, AAlpha); -end; - -procedure TCustomUniversalBitmap.ErasePixel(x, y: int32or64; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha+(alpha shl 8)); - DrawPixel(x,y, b); -end; - -procedure TCustomUniversalBitmap.ErasePixelF(x, y: single; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha+(alpha shl 8)); - DrawPixelF(x,y, b); -end; - -procedure TCustomUniversalBitmap.AlphaPixel(x, y: int32or64; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha+(alpha shl 8)); - DrawPixel(x,y, b); -end; - -procedure TCustomUniversalBitmap.AlphaPixelF(x, y: single; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha+(alpha shl 8)); - DrawPixelF(x,y, b); -end; - -procedure TCustomUniversalBitmap.HorizLine(x, y, x2: int32or64; - const ABrush: TUniversalBrush; AAlpha: Word); -var - pScan: Pointer; - ctx: TUniBrushContext; -begin - if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; - if not CheckHorizLineBounds(x,y,x2) then exit; - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(x,y); - ABrush.MoveTo(@ctx, pScan,x,y); - ABrush.PutNextPixels(@ctx, AAlpha,x2-x+1); - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.HorizLine(x, y, x2: int32or64; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - HorizLine(x,y,x2, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.EraseHorizLine(x, y, x2: int32or64; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha+(alpha shl 8)); - HorizLine(x,y,x2, b); -end; - -procedure TCustomUniversalBitmap.AlphaHorizLine(x, y, x2: int32or64; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha+(alpha shl 8)); - HorizLine(x,y,x2, b); -end; - -procedure TCustomUniversalBitmap.VertLine(x, y, y2: int32or64; - const ABrush: TUniversalBrush; AAlpha: Word); -var - pScan: PByte; - delta: PtrInt; - yb: Int32or64; - ctx: TUniBrushContext; -begin - if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace; - if not CheckVertLineBounds(x,y,y2) or ABrush.DoesNothing then exit; - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(x,y); - if LineOrder = riloTopToBottom then delta := RowSize else delta := -rowSize; - for yb := y to y2 do - begin - ABrush.MoveTo(@ctx, pScan,x,y); - ABrush.PutNextPixels(@ctx, AAlpha,1); - inc(pScan, delta); - end; - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.VertLine(x, y, y2: int32or64; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - VertLine(x,y,y2, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.EraseVertLine(x, y, y2: int32or64; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha+(alpha shl 8)); - VertLine(x,y,y2, b); -end; - -procedure TCustomUniversalBitmap.AlphaVertLine(x, y, y2: int32or64; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha+(alpha shl 8)); - VertLine(x,y,y2, b); -end; - -procedure TCustomUniversalBitmap.DrawLine(x1, y1, x2, y2: integer; - const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word = 65535); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawLine(self, x1,y1,x2,y2, ABrush, ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawLine(x1, y1, x2, y2: integer; - ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - DrawLine(x1,y1,x2,y2, b,ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; - const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawLineAntialias(self, x1,y1,x2,y2, ABrush, ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; - ATexture: IBGRAScanner; AMode: TDrawMode; ADrawLastPixel: boolean; - AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - DrawLineAntialias(x1,y1,x2,y2, b,ADrawLastPixel,AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; - const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; - ADrawLastPixel: boolean; AAlpha: Word); -var - dashPos: integer; -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - dashPos := 0; - UniDrawerClass.DrawLineAntialias(self, x1,y1,x2,y2, ABrush1,ABrush2, ADashLen, dashPos, ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; - const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; - var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawLineAntialias(self, x1,y1,x2,y2, ABrush1,ABrush2, ADashLen, ADashPos, ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.EraseLine(x1, y1, x2, y2: integer; - alpha: byte; DrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha+(alpha shl 8)); - DrawLine(x1,y1,x2,y2,b,DrawLastPixel); -end; - -procedure TCustomUniversalBitmap.EraseLineAntialias(x1, y1, x2, y2: integer; - alpha: byte; DrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha+(alpha shl 8)); - DrawLineAntialias(x1,y1,x2,y2,b,DrawLastPixel); -end; - -procedure TCustomUniversalBitmap.AlphaLine(x1, y1, x2, y2: integer; - alpha: byte; DrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha+(alpha shl 8)); - DrawLine(x1,y1,x2,y2,b,DrawLastPixel); -end; - -procedure TCustomUniversalBitmap.AlphaLineAntialias(x1, y1, x2, y2: integer; - alpha: byte; DrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha+(alpha shl 8)); - DrawLineAntialias(x1,y1,x2,y2,b,DrawLastPixel); -end; - -procedure TCustomUniversalBitmap.DrawPolyLine(const points: array of TPoint; - const ABrush: TUniversalBrush; ADrawLastPixel: boolean; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawPolyLine(self, points, ABrush, ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialias( - const points: array of TPoint; const ABrush: TUniversalBrush; - ADrawLastPixel: boolean; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawPolyLineAntialias(self, points, ABrush, ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawPolyLineAntialias( - const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; - ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawPolyLineAntialias(self, points, ABrush1, ABrush2, ADashLen, ADrawLastPixel, AAlpha); -end; - -procedure TCustomUniversalBitmap.ErasePolyLine(const points: array of TPoint; - alpha: byte; ADrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - DrawPolyLine(points, b, ADrawLastPixel); -end; - -procedure TCustomUniversalBitmap.ErasePolyLineAntialias( - const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - DrawPolyLineAntialias(points, b, ADrawLastPixel); -end; - -procedure TCustomUniversalBitmap.AlphaPolyLine(const points: array of TPoint; - alpha: byte; ADrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - DrawPolyLine(points, b, ADrawLastPixel); -end; - -procedure TCustomUniversalBitmap.AlphaPolyLineAntialias( - const points: array of TPoint; alpha: byte; ADrawLastPixel: boolean); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - DrawPolyLineAntialias(points, b, ADrawLastPixel); -end; - -procedure TCustomUniversalBitmap.DrawPolygon(const points: array of TPoint; - const ABrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawPolygon(self, points, ABrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawPolygonAntialias( - const points: array of TPoint; - const ABrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawPolygonAntialias(self, points, ABrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.DrawPolygonAntialias( - const points: array of TPoint; const ABrush1, - ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.DrawPolygonAntialias(self, points, ABrush1,ABrush2, ADashLen, AAlpha); -end; - -procedure TCustomUniversalBitmap.ErasePolygonOutline(const points: array of TPoint; - alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - DrawPolygon(points, b); -end; - -procedure TCustomUniversalBitmap.ErasePolygonOutlineAntialias( - const points: array of TPoint; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - DrawPolygonAntialias(points, b); -end; - -procedure TCustomUniversalBitmap.AlphaPolygonOutline(const points: array of TPoint; - alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - DrawPolygon(points, b); -end; - -procedure TCustomUniversalBitmap.AlphaPolygonOutlineAntialias( - const points: array of TPoint; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - DrawPolygonAntialias(points, b); -end; - -procedure TCustomUniversalBitmap.DrawPathAliased(APath: IBGRAPath; - const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; AAlpha: Word); -var - data: TPathCallbackData; -begin - if ABrush.DoesNothing then exit; - if UniDrawerClass=nil then RaiseMissingUniDrawer; - data.BrushAddress := @ABrush; - data.Alpha:= AAlpha; - data.PixelCenteredCoords := APixelCenteredCoordinates; - APath.stroke(@PathStrokeAliasedCallback, @data); -end; - -procedure TCustomUniversalBitmap.DrawPathAliased(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; - APixelCenteredCoordinates: boolean; AAlpha: Word); -var - data: TPathCallbackData; -begin - if ABrush.DoesNothing then exit; - if UniDrawerClass=nil then RaiseMissingUniDrawer; - data.BrushAddress := @ABrush; - data.Alpha:= AAlpha; - data.PixelCenteredCoords := APixelCenteredCoordinates; - APath.stroke(@PathStrokeAliasedCallback, AMatrix, @data); -end; - -procedure TCustomUniversalBitmap.Rectangle(x, y, x2, y2: integer; - const ABrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.Rectangle(self, x,y,x2,y2, ABrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.Rectangle(x, y, x2, y2: integer; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - Rectangle(x,y,x2,y2, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.Rectangle(const ARect: TRect; - const ABrush: TUniversalBrush; AAlpha: Word); -begin - Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ABrush,AAlpha); -end; - -procedure TCustomUniversalBitmap.Rectangle(const ARect: TRect; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -begin - Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ATexture,AMode,AAlpha); -end; - -procedure TCustomUniversalBitmap.Rectangle(x, y, x2, y2: integer; const ABorderBrush, - AFillBrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.Rectangle(self, x,y,x2,y2, ABorderBrush,AFillBrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.Rectangle(const ARect: TRect; - const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); -begin - Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ABorderBrush,AFillBrush,AAlpha); -end; - -procedure TCustomUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.RoundRect(self, X1,Y1,X2,Y2,DX,DY, ABorderBrush,AFillBrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.RoundRect(self, X1,Y1,X2,Y2,DX,DY, ABorderBrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - RoundRect(X1,Y1,X2,Y2,DX,DY, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.RoundRect(self, X1,Y1,X2,Y2,DX,DY, AFillBrush, AFillBrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - FillRoundRect(X1,Y1,X2,Y2,DX,DY, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.EraseRoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - FillRoundRect(X1,Y1,X2,Y2,DX,DY,b); -end; - -procedure TCustomUniversalBitmap.AlphaFillRoundRect(X1, Y1, X2, Y2: integer; - DX, DY: integer; alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillRoundRect(X1,Y1,X2,Y2,DX,DY,b); -end; - -procedure TCustomUniversalBitmap.EllipseInRect(ARect: TRect; - const ABorderBrush: TUniversalBrush; AAlpha: Word); -begin - RoundRect(ARect.left,ARect.top,ARect.right,ARect.bottom, - abs(ARect.right-ARect.left),abs(ARect.bottom-ARect.top), - ABorderBrush,AAlpha); -end; - -procedure TCustomUniversalBitmap.EllipseInRect(ARect: TRect; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - EllipseInRect(ARect, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.EllipseInRect(ARect: TRect; const ABorderBrush, - AFillBrush: TUniversalBrush; AAlpha: Word); -begin - RoundRect(ARect.left,ARect.top,ARect.right,ARect.bottom, - abs(ARect.right-ARect.left),abs(ARect.bottom-ARect.top), - ABorderBrush,AFillBrush,AAlpha); -end; - -procedure TCustomUniversalBitmap.FillEllipseInRect(ARect: TRect; - const AFillBrush: TUniversalBrush; AAlpha: Word); -begin - FillRoundRect(ARect.left,ARect.top,ARect.right,ARect.bottom, - abs(ARect.right-ARect.left),abs(ARect.bottom-ARect.top), - AFillBrush,AAlpha); -end; - -procedure TCustomUniversalBitmap.FillEllipseInRect(ARect: TRect; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AMode); - FillEllipseInRect(ARect, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.EraseEllipseInRect(ARect: TRect; alpha: byte); -var - b: TUniversalBrush; -begin - EraseBrush(b, alpha + (alpha shl 8)); - FillEllipseInRect(ARect,b); -end; - -procedure TCustomUniversalBitmap.AlphaFillEllipseInRect(ARect: TRect; - alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillEllipseInRect(ARect,b); -end; - -procedure TCustomUniversalBitmap.FillShape(AShape: TBGRACustomFillInfo; - const ABrush: TUniversalBrush; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillShape(self, AShape, FillMode, ABrush, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillShape(AShape: TBGRACustomFillInfo; - ATexture: IBGRAScanner; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture,AMode); - FillShape(AShape, b,AAlpha); -end; - -procedure TCustomUniversalBitmap.EraseShape(AShape: TBGRACustomFillInfo; - alpha: byte); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - FillShape(AShape,b); -end; - -procedure TCustomUniversalBitmap.AlphaFillShape(AShape: TBGRACustomFillInfo; - alpha: byte); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillShape(AShape,b); -end; - -procedure TCustomUniversalBitmap.FillPoly(const APoints: array of TPointF; - const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; - AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - UniDrawerClass.FillPoly(self, APoints, FillMode, ABrush, APixelCenteredCoordinates, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillPoly(const APoints: array of TPointF; - ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean; - AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - FillPoly(APoints, b,APixelCenteredCoordinates,AAlpha); -end; - -procedure TCustomUniversalBitmap.ErasePoly(const APoints: array of TPointF; - alpha: byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - FillPoly(APoints,b,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.AlphaFillPoly(const APoints: array of TPointF; - alpha: byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillPoly(APoints,b,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; - const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; - AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - FillPoly(APath.getPoints, ABrush, APixelCenteredCoordinates, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const ABrush: TUniversalBrush; - APixelCenteredCoordinates: boolean; AAlpha: Word); -begin - if UniDrawerClass=nil then RaiseMissingUniDrawer; - FillPoly(APath.getPoints(AMatrix), ABrush, APixelCenteredCoordinates, AAlpha); -end; - -procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; - ATexture: IBGRAScanner; AMode: TDrawMode; APixelCenteredCoordinates: boolean; - AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - FillPathAliased(APath, b,APixelCenteredCoordinates,AAlpha); -end; - -procedure TCustomUniversalBitmap.FillPathAliased(APath: IBGRAPath; - const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AMode: TDrawMode; - APixelCenteredCoordinates: boolean; AAlpha: Word); -var - b: TUniversalBrush; -begin - ScannerBrush(b, ATexture, AMode); - FillPathAliased(APath,AMatrix, b,APixelCenteredCoordinates,AAlpha); -end; - -procedure TCustomUniversalBitmap.ErasePathAliased(APath: IBGRAPath; - alpha: byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - FillPathAliased(APath,b,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.ErasePathAliased(APath: IBGRAPath; - const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - if alpha = 0 then exit; - EraseBrush(b, alpha + (alpha shl 8)); - FillPathAliased(APath,AMatrix,b,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.AlphaFillPathAliased(APath: IBGRAPath; - alpha: byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillPathAliased(APath,b,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.AlphaFillPathAliased(APath: IBGRAPath; - const AMatrix: TAffineMatrix; alpha: byte; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - AlphaBrush(b, alpha + (alpha shl 8)); - FillPathAliased(APath,AMatrix,b,APixelCenteredCoordinates); -end; - -procedure TCustomUniversalBitmap.VerticalFlip; -begin - VerticalFlip(rect(0,0,Width,Height)); -end; - -procedure TCustomUniversalBitmap.VerticalFlip(ARect: TRect); -var - yb,h2: integer; - line: Pointer; - linesize, delta: PtrInt; - PStart,PEnd: Pointer; -begin - if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit; - ARect.Intersect(rect(0,0,Width,Height)); - if ARect.IsEmpty then exit; - LoadFromBitmapIfNeeded; - linesize := (ARect.Right-ARect.Left) * FPixelSize; - line := nil; - getmem(line, linesize); - PStart := GetPixelAddress(ARect.Left, ARect.Top); - PEnd := GetPixelAddress(ARect.Left,ARect.Bottom-1); - h2 := (ARect.Bottom-ARect.Top) div 2; - if LineOrder = riloTopToBottom then delta := +RowSize else delta := -RowSize; - for yb := h2-1 downto 0 do - begin - move(PStart^, line^, linesize); - move(PEnd^, PStart^, linesize); - move(line^, PEnd^, linesize); - Inc(PStart, delta); - Dec(PEnd, delta); - end; - freemem(line); - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.HorizontalFlip; -begin - HorizontalFlip(rect(0,0,Width,Height)); -end; - -procedure TCustomUniversalBitmap.HorizontalFlip(ARect: TRect); -var - yb, w: integer; - PStart: PByte; - PEnd: PByte; -begin - if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit; - ARect.Intersect(rect(0,0,Width,Height)); - if ARect.IsEmpty then exit; - w := ARect.Right-ARect.Left; - LoadFromBitmapIfNeeded; - for yb := ARect.Top to ARect.Bottom-1 do - begin - PStart := GetPixelAddress(ARect.Left,yb); - PEnd := PStart + (w-1)*FPixelSize; - InternalSwapPixels(PStart, PEnd, FPixelSize, -FPixelSize, w shr 1); - end; - InvalidateBitmap; -end; - -procedure TCustomUniversalBitmap.RotateUDInplace; -begin - RotateUDInplace(rect(0,0,Width,Height)); -end; - -procedure TCustomUniversalBitmap.RotateUDInplace(ARect: TRect); -var - yb,h,h2: integer; - line: PByte; - linesize, delta: IntPtr; - PStart: PByte; - PEnd: PByte; - w: integer; -begin - if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit; - ARect.Intersect(rect(0,0,Width,Height)); - if ARect.IsEmpty then exit; - LoadFromBitmapIfNeeded; - w := ARect.Right-ARect.Left; - linesize := w * FPixelSize; - line := nil; - getmem(line, linesize); - PStart := GetPixelAddress(ARect.Left, ARect.Top); - PEnd := GetPixelAddress(ARect.Right-1, ARect.Bottom-1); - h := ARect.Bottom-ARect.Top; - h2 := h div 2; - if LineOrder = riloTopToBottom then delta := +RowSize else delta := -RowSize; - for yb := h2-1 downto 0 do - begin - InternalSwapPixels(PStart, PEnd, FPixelSize, -FPixelSize, w); - Inc(PStart, delta); - Dec(PEnd, delta); - end; - if odd(h) then - InternalSwapPixels(PStart, PEnd, FPixelSize, -FPixelSize, w shr 1); - freemem(line); - InvalidateBitmap; -end; - -function TCustomUniversalBitmap.RotateCW: TCustomUniversalBitmap; -var - psrc, pdest: PByte; - yb: integer; - delta: PtrInt; -begin - LoadFromBitmapIfNeeded; - result := InternalNew; - result.SetSize(Height, Width); - if Result.LineOrder = riloTopToBottom then - delta := Result.RowSize - else - delta := -Result.RowSize; - for yb := 0 to Height - 1 do - begin - psrc := ScanLineByte[yb]; - pdest := Result.GetPixelAddress(Height-1-yb, 0); - InternalCopyPixels(psrc, pdest, FPixelSize, delta, Width); - end; -end; - -function TCustomUniversalBitmap.RotateCCW: TCustomUniversalBitmap; -var - psrc, pdest: PByte; - yb: integer; - delta: PtrInt; -begin - LoadFromBitmapIfNeeded; - result := InternalNew; - result.SetSize(Height, Width); - if Result.LineOrder = riloTopToBottom then - delta := Result.RowSize - else - delta := -Result.RowSize; - for yb := 0 to Height - 1 do - begin - psrc := ScanLineByte[yb]; - pdest := Result.GetPixelAddress(yb, Width - 1); - InternalCopyPixels(psrc, pdest, FPixelSize,-delta, Width); - end; -end; - -function TCustomUniversalBitmap.RotateUD: TCustomUniversalBitmap; -var - yb: Integer; - psrc, pdest: PByte; -begin - LoadFromBitmapIfNeeded; - result := InternalNew; - result.SetSize(Width, Height); - for yb := 0 to Height-1 do - begin - psrc := ScanLineByte[yb]; - pdest := result.GetPixelAddress(Width-1,Height-1-yb); - InternalCopyPixels(psrc, pdest, FPixelSize, -FPixelSize, Width); - end; -end; - -{$ENDIF} diff --git a/components/bgrabitmap/unibitmapgeneric.inc b/components/bgrabitmap/unibitmapgeneric.inc deleted file mode 100644 index 04fc32b..0000000 --- a/components/bgrabitmap/unibitmapgeneric.inc +++ /dev/null @@ -1,1141 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -{$IFDEF INCLUDE_INTERFACE} -{$UNDEF INCLUDE_INTERFACE} - -type - { TGenericUniversalBitmap } - - generic TGenericUniversalBitmap = class(TCustomUniversalBitmap) - private - type PPixel = ^TPixel; - function GetDataPtr: PPixel; inline; - function GetScanLine(y: integer): PPixel; inline; - protected - class function DefaultColorspace: TColorspaceAny; override; - procedure Init; override; //ensure colorspace - function GetScanlineFast(y: integer): PPixel; inline; //typed function - procedure InternalCopyPixels(ASource,ADest: PByte; ASourceStride,ADestStride: PtrInt; ACount: integer); override; - procedure InternalSwapPixels(ABuf1,ABuf2: PByte; AStride1,AStride2: PtrInt; ACount: integer); override; - procedure InternalSetPixels(ASource,ADest: PByte; ADestStride: PtrInt; ACount: integer); override; - public - //typed functions - - {** Creates an image of dimensions ''AWidth'' and ''AHeight'' and fills it with ''Color'' } - constructor Create(AWidth, AHeight: integer; const AColor: TPixel); virtual; - function NewBitmap(AWidth, AHeight: integer; const AColor: TPixel): TCustomUniversalBitmap; overload; virtual; - - function Equals(comp: TCustomUniversalBitmap): boolean; overload; - function Equals(const comp: TPixel): boolean; overload; - function GetDifferenceBounds(ABitmap: TCustomUniversalBitmap): TRect; - - procedure SolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure IdleBrush(out ABrush: TUniversalBrush); virtual; - class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; - function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TPixel; - AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TCustomUniversalBitmap; virtual; - - procedure SetPixel(x,y: int32or64; const AColor: TPixel); overload; virtual; - function GetPixel(x,y: int32or64): TPixel; inline; - function GetPixelCycle(x,y: int32or64): TPixel; inline; - {** Returns the address of the left-most pixel of any line. - The parameter y ranges from 0 to Height-1 } - property ScanLine[y: integer]: PPixel Read GetScanLine; - property Data: PPixel read GetDataPtr; - - procedure Fill(const AColor: TPixel); overload; virtual; - procedure Fill(const AColor: TPixel; AMode : TDrawMode; AAlpha : Word = 65535); overload; virtual; - procedure ReplaceColor(const ABefore, AAfter: TPixel); overload; virtual; - procedure ReplaceColor(ARect: TRect; const ABefore, AAfter: TPixel); overload; virtual; - procedure ReplaceTransparent(const AAfter: TBGRAPixel); overload; virtual; - procedure ReplaceTransparent(ARect: TRect; const AAfter: TPixel); overload; virtual; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const AColor: TPixel); overload; virtual; - procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const AColor: TPixel; ADrawMode: TDrawMode); overload; virtual; - procedure FillRect(ALeft, ATop, ARight, ABottom: integer; const AColor: TPixel; ADrawMode: TDrawMode = dmSet; AAlpha: Word = 65535); overload; virtual; - procedure FillRect(const ARect: TRect; const AColor: TPixel; ADrawMode: TDrawMode = dmSet; AAlpha: Word = 65535); overload; virtual; - procedure DrawCheckers(ARect: TRect; const AColorEven,AColorOdd: TPixel; AGridWidth: integer = 8; AGridHeight: integer = 8; ADrawMode: TDrawMode = dmSet); virtual; - procedure DrawPixel(x,y: Int32or64; const AColor: TPixel); overload; virtual; - procedure DrawPixel(x,y: Int32or64; const AColor: TPixel; ADrawMode: TDrawMode); overload; virtual; - procedure DrawPixel(x,y: Int32or64; const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); overload; virtual; - procedure DrawPixelF(x,y: single; const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - {** Replaces the content of the pixels at line ''y'' and - at columns ''x'' to ''x2'' included, using specified color } - procedure SetHorizLine(x, y, x2: int32or64; const AColor: TPixel); virtual; - procedure HorizLine(x, y, x2: int32or64; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - {** Replaces a vertical line at column ''x'' and at row ''y'' to ''y2'' } - procedure SetVertLine(x, y, y2: int32or64; const AColor: TPixel); virtual; - procedure VertLine(x, y, y2: int32or64; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure DrawLine(x1, y1, x2, y2: integer; const AColor: TPixel; ADrawLastPixel: boolean; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure DrawLineAntialias(x1, y1, x2, y2: integer; const AColor: TPixel; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - procedure DrawLineAntialias(x1, y1, x2, y2: integer; const AColor1, AColor2: TPixel; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - procedure DrawLineAntialias(x1, y1, x2, y2: integer; const AColor1, AColor2: TPixel; ADashLen: integer; var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; virtual; - procedure DrawPolyLine(const points: array of TPoint; const AColor: TPixel; ADrawLastPixel: boolean; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; - procedure DrawPolyLineAntialias(const points: array of TPoint; const AColor: TPixel; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; - procedure DrawPolyLineAntialias(const points: array of TPoint; const AColor1, AColor2: TPixel; ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word = 65535); overload; - procedure DrawPolygon(const points: array of TPoint; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; - procedure DrawPolygonAntialias(const points: array of TPoint; const AColor: TPixel; AAlpha: Word = 65535); overload; - procedure DrawPolygonAntialias(const points: array of TPoint; const AColor1, AColor2: TPixel; ADashLen: integer; AAlpha: Word = 65535); overload; - procedure DrawPathAliased(APath: IBGRAPath; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure DrawPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure Rectangle(x, y, x2, y2: integer; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure Rectangle(x, y, x2, y2: integer; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure Rectangle(const ARect: TRect; const AColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure Rectangle(const ARect: TRect; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure EllipseInRect(ARect: TRect; const ABorderColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure EllipseInRect(ARect: TRect; const ABorderColor, AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure FillEllipseInRect(ARect: TRect; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure FillShape(AShape: TBGRACustomFillInfo; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; AAlpha: Word = 65535); overload; virtual; - procedure FillPoly(const APoints: array of TPointF; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; virtual; - procedure FillPathAliased(APath: IBGRAPath; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - procedure FillPathAliased(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AFillColor: TPixel; AMode : TDrawMode = dmDrawWithTransparency; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); overload; - - //optimized - procedure SetPixelIndirect(x,y: int32or64; AColor: pointer); override; - procedure GetPixelIndirect(x,y: int32or64; AColor: pointer); override; - procedure GetPixelCycleIndirect(x,y: int32or64; AColor: pointer); override; - function GetPixelAddress(x, y: integer): PByte; override; - - {==== Drawing lines and paths (floating point coordinates) ====} - {* These functions use the current pen style/cap/join. The parameter ''APenWidth'' - specifies the width of the line and the base unit for dashes. - See [[BGRABitmap tutorial 13|coordinate system]]. - * The coordinates are pixel-centered by default, so that when filling a rectangle, - if the supplied values are integers, the border will be half transparent. - If you want the border to be completely filled, you can subtract/add - 0.5 to the coordinates to include the remaining thin border. - See [[BGRABitmap tutorial 13|coordinate system]]. } - - procedure DrawLineAntialias(x1, y1, x2, y2: single; const AColor: TPixel; APenWidth: single); overload; virtual; - procedure DrawLineAntialias(x1, y1, x2, y2: single; const AColor: TPixel; APenWidth: single; AClosedCap: boolean); overload; virtual; - - {** Draws a polyline using current pen style/cap/join } - procedure DrawPolyLineAntialias(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); overload; virtual; - {** Draws a polyline using current pen style/cap/join. - ''Closed'' specifies if the end of the line is roundly closed. If it is not closed, - a space is left so that the next line can fit } - procedure DrawPolyLineAntialias(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single; AClosedCap: boolean); overload; virtual; - {** Draws a polyline using current pen style/cap/join. - The last point considered as a join with the first point if it has - the same coordinate } - procedure DrawPolyLineAntialiasAutocycle(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); overload; virtual; - {** Draws a polygon using current pen style/cap/join. - The polygon is always closed. You don't need to set the last point - to be the same as the first point } - procedure DrawPolygonAntialias(const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); overload; virtual; - - procedure RectangleAntialias(x, y, x2, y2: single; const AColor: TPixel; AWidth: single); overload; virtual; - - {** Draws an ellipse without antialising. ''rx'' is the horizontal radius and - ''ry'' the vertical radius } - procedure Ellipse(x, y, rx, ry: single; const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - procedure Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word = 65535); overload; virtual; - {** Draws an ellipse with antialising. ''rx'' is the horizontal radius and - ''ry'' the vertical radius } - procedure EllipseAntialias(x, y, rx, ry: single; const AColor: TPixel; AWidth: single); overload; virtual; - procedure EllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const AColor: TPixel; AWidth: single); overload; virtual; - - procedure DrawPath(APath: IBGRAPath; const AColor: TPixel; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure DrawPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AColor: TPixel; AWidth: single; APixelCenteredCoordinates: boolean = true); overload; virtual; - - //-------------------------------- antialias fill --------------------------------------------- - procedure FillPolyAntialias(const APoints: array of TPointF; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillEllipseAntialias(x, y, rx, ry: single; const AColor: TPixel); overload; virtual; - procedure FillEllipseAntialias(const AOrigin, AXAxis, AYAxis: TPointF; const AColor: TPixel); overload; virtual; - procedure FillPath(APath: IBGRAPath; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillPath(APath: IBGRAPath; const AMatrix: TAffineMatrix; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillRectAntialias(x, y, x2, y2: single; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - procedure FillRectAntialias(const ARectF: TRectF; const AColor: TPixel; APixelCenteredCoordinates: boolean = true); overload; virtual; - - {** Fills a rounded rectangle with antialiasing. The corners have an - elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to - draw the corners. See [[BGRABitmap Geometry types|geometry types]] } - procedure FillRoundRectAntialias(x, y, x2, y2, rx, ry: single; const AColor: TPixel; AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); overload; virtual; - - end; - -{$ENDIF} - -{$IFDEF INCLUDE_IMPLEMENTATION} -{$UNDEF INCLUDE_IMPLEMENTATION} - -{ TGenericUniversalBitmap } - -function TGenericUniversalBitmap.GetDataPtr: PPixel; -begin - result := PPixel(GetDataBytePtr); -end; - -function TGenericUniversalBitmap.GetScanLine(y: integer): PPixel; -begin - result := PPixel(GetScanLineByte(y)); -end; - -class function TGenericUniversalBitmap.DefaultColorspace: TColorspaceAny; -begin - Result:= TColorspace; -end; - -procedure TGenericUniversalBitmap.Init; -begin - inherited Init; - if FColorspace <> DefaultColorspace then raise exception.Create('Unexpected colorspace'); -end; - -{ Get scanline without checking bounds nor updated from bitmap } -function TGenericUniversalBitmap.GetScanlineFast(y: integer): PPixel; -begin - if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; - result := PPixel(FDataByte+FRowSize*y); -end; - -procedure TGenericUniversalBitmap.InternalCopyPixels(ASource, ADest: PByte; - ASourceStride, ADestStride: PtrInt; ACount: integer); -begin - while ACount>0 do - begin - PPixel(ADest)^ := PPixel(ASource)^; - inc(ASource, ASourceStride); - inc(ADest, ADestStride); - dec(ACount); - end; -end; - -procedure TGenericUniversalBitmap.InternalSwapPixels(ABuf1, ABuf2: PByte; - AStride1, AStride2: PtrInt; ACount: integer); -var temp: TPixel; -begin - while ACount>0 do - begin - temp := PPixel(ABuf1)^; - PPixel(ABuf1)^ := PPixel(ABuf2)^; - PPixel(ABuf2)^ := temp; - inc(ABuf1, AStride1); - inc(ABuf2, AStride2); - dec(ACount); - end; -end; - -procedure TGenericUniversalBitmap.InternalSetPixels(ASource, ADest: PByte; - ADestStride: PtrInt; ACount: integer); -begin - while ACount>0 do - begin - PPixel(ADest)^ := PPixel(ASource)^; - inc(ADest, ADestStride); - dec(ACount); - end; -end; - -constructor TGenericUniversalBitmap.Create(AWidth, AHeight: integer; - const AColor: TPixel); -var - p: PByte; - i: Integer; -begin - inherited Create(0, 0); - SetSize(AWidth,AHeight); - p := DataByte; - for i := NbPixels-1 downto 0 do - begin - PPixel(p)^ := AColor; - inc(p, sizeof(TPixel)); - end; -end; - -function TGenericUniversalBitmap.NewBitmap(AWidth, AHeight: integer; - const AColor: TPixel): TCustomUniversalBitmap; -var - b: TUniversalBrush; -begin - result := InternalNew; - result.SetSize(AWidth,AHeight); - SolidBrush(b, AColor, dmSet); - result.Fill(b); -end; - -function TGenericUniversalBitmap.Equals(comp: TCustomUniversalBitmap): boolean; -var - p,pComp: PByte; - y, x: Integer; - delta, compDelta: PtrInt; -begin - if (comp.Colorspace<>Colorspace) or - (comp.Width <> Width) or (comp.Height <> Height) then exit(false); - p := GetPixelAddress(0,0); - if LineOrder = riloTopToBottom then delta := 0 else delta := -RowSize*2; - pComp := comp.GetPixelAddress(0,0); - if comp.LineOrder = riloTopToBottom then compDelta := 0 else compDelta := -comp.RowSize*2; - for y := 0 to Height-1 do - begin - for x := Width-1 downto 0 do - begin - if PPixel(p)^ <> PPixel(pComp)^ then exit(false); - inc(p, sizeof(TPixel)); - inc(pComp, sizeof(TPixel)); - end; - inc(p, delta); - inc(pComp, compDelta); - end; - result := true; -end; - -function TGenericUniversalBitmap.Equals(const comp: TPixel): boolean; -var - p: PByte; - i: Integer; -begin - p := DataByte; - for i := NbPixels-1 downto 0 do - begin - if PPixel(p)^ <> comp then exit(false); - inc(p, sizeof(TPixel)); - end; - result := true; -end; - -function TGenericUniversalBitmap.GetDifferenceBounds( - ABitmap: TCustomUniversalBitmap): TRect; -var - minx, miny, maxx, maxy: integer; - xb, yb: integer; - p, p2: PPixel; -begin - if (ABitmap.Width <> Width) or (ABitmap.Height <> Height) - or (ABitmap.Colorspace <> Colorspace) then - begin - result := rect(0,0,Width,Height); - if ABitmap.Width > result.Right then result.Right := ABitmap.Width; - if ABitmap.Height > result.bottom then result.bottom := ABitmap.Height; - exit; - end; - maxx := -1; - maxy := -1; - minx := self.Width; - miny := self.Height; - for yb := 0 to self.Height - 1 do - begin - p := self.ScanLine[yb]; - p2 := PPixel(ABitmap.ScanLineByte[yb]); - for xb := 0 to self.Width - 1 do - begin - if p^ <> p2^ then - begin - if xb < minx then - minx := xb; - if yb < miny then - miny := yb; - if xb > maxx then - maxx := xb; - if yb > maxy then - maxy := yb; - end; - Inc(p); - Inc(p2); - end; - end; - if minx > maxx then - begin - Result.left := 0; - Result.top := 0; - Result.right := 0; - Result.bottom := 0; - end - else - begin - Result.left := minx; - Result.top := miny; - Result.right := maxx + 1; - Result.bottom := maxy + 1; - end; -end; - -procedure TGenericUniversalBitmap.SolidBrushIndirect(out - ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode); -begin - SolidBrush(ABrush, PPixel(AColor)^, ADrawMode); -end; - -class procedure TGenericUniversalBitmap.IdleBrush(out ABrush: TUniversalBrush); -begin - ABrush.Colorspace := TColorspace; - ABrush.InternalInitContext:= nil; - PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.PixelSize:= sizeof(TPixel); - ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSkipPixels; - ABrush.DoesNothing:= true; -end; - -class procedure TGenericUniversalBitmap.SolidBrush(out ABrush: TUniversalBrush; - const AColor: TPixel; ADrawMode: TDrawMode); -var - ct: TColorTransparency; -begin - ct := TColorspace.GetColorTransparency(@AColor); - if (ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and - (ct = ctSemiTransparent) then - raise exception.Create('Semi-tranparent drawing not handled by default brush') - else if ADrawMode = dmXor then - raise exception.Create('Xor mode not handled by default brush'); - - ABrush.Colorspace := TColorspace; - ABrush.InternalInitContext:= nil; - PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.PixelSize:= sizeof(TPixel); - - if (ADrawMode <> dmSet) and (ct <> ctFullyOpaque) then - begin - ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSkipPixels; - ABrush.DoesNothing:= true; - end - else - begin - PPixel(@PDefaultSolidBrushIndirectFixedData(@ABrush.FixedData)^.Color)^ := AColor; - ABrush.InternalPutNextPixels:= @DefaultSolidBrushIndirectSetPixels - end; -end; - -function TGenericUniversalBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; - APatternColor, ABackgroundColor: TPixel; AWidth: integer; AHeight: integer; - APenWidth: single): TCustomUniversalBitmap; -var - b: TUniversalBrush; -begin - result := InternalNew; - result.SetSize(AWidth,AHeight); - if ABrushStyle=bsClear then - result.FillTransparent - else - begin - SolidBrush(b, ABackgroundColor, dmSet); - result.Fill(b); - SolidBrush(b, APatternColor,dmDrawWithTransparency); - if ABrushStyle in[bsDiagCross,bsBDiagonal] then - begin - result.DrawLineAntialias(-1,AHeight,AWidth,-1, b,APenWidth); - result.DrawLineAntialias(-1-APenWidth,0+APenWidth,0+APenWidth,-1-APenWidth, b,APenWidth); - result.DrawLineAntialias(AWidth-1-APenWidth,AHeight+APenWidth,AWidth+APenWidth,AHeight-1-APenWidth, b,APenWidth); - end; - if ABrushStyle in[bsDiagCross,bsFDiagonal] then - begin - result.DrawLineAntialias(-1,-1,AWidth,AHeight, b,APenWidth); - result.DrawLineAntialias(AWidth-1-APenWidth,-1-APenWidth,AWidth+APenWidth,0+APenWidth, b,APenWidth); - result.DrawLineAntialias(-1-APenWidth,AHeight-1-APenWidth,0+APenWidth,AHeight+APenWidth, b,APenWidth); - end; - if ABrushStyle in[bsHorizontal,bsCross] then - result.DrawLineAntialias(-1,AHeight div 2,AWidth,AHeight div 2, b,APenWidth); - if ABrushStyle in[bsVertical,bsCross] then - result.DrawLineAntialias(AWidth div 2,-1,AWidth div 2,AHeight, b,APenWidth); - end; -end; - -procedure TGenericUniversalBitmap.SetPixelIndirect(x, y: int32or64; - AColor: pointer); -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - (GetScanlineFast(y)+x)^ := PPixel(AColor)^; - InvalidateBitmap; -end; - -procedure TGenericUniversalBitmap.GetPixelIndirect(x, y: int32or64; - AColor: pointer); -begin - if (x < 0) or (x >= FWidth) or (y < 0) or (y >= FHeight) then //it is possible to read pixels outside of the cliprect - AssignTransparentPixel(AColor^) else - begin - LoadFromBitmapIfNeeded; - PPixel(AColor)^ := (GetScanlineFast(y)+x)^; - end; -end; - -procedure TGenericUniversalBitmap.GetPixelCycleIndirect(x, y: int32or64; - AColor: pointer); -begin - if (Width = 0) or (Height = 0) then AssignTransparentPixel(AColor^) else - begin - LoadFromBitmapIfNeeded; - PPixel(AColor)^ := (GetScanlineFast(PositiveMod(y, Height)) + PositiveMod(x, Width))^; - end; -end; - -procedure TGenericUniversalBitmap.SetPixel(x, y: int32or64; const AColor: TPixel); -begin - if not PtInClipRect(x,y) then exit; - LoadFromBitmapIfNeeded; - (GetScanlineFast(y)+x)^ := AColor; - InvalidateBitmap; -end; - -function TGenericUniversalBitmap.GetPixel(x, y: int32or64): TPixel; -begin - GetPixelIndirect(x,y, @result); -end; - -function TGenericUniversalBitmap.GetPixelCycle(x, y: int32or64): TPixel; -begin - GetPixelCycleIndirect(x,y, @result); -end; - -procedure TGenericUniversalBitmap.Fill(const AColor: TPixel); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, dmSet); - Fill(b); -end; - -procedure TGenericUniversalBitmap.Fill(const AColor: TPixel; AMode : TDrawMode; AAlpha : Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AMode); - Fill(b, AAlpha); -end; - -procedure TGenericUniversalBitmap.ReplaceColor(const ABefore, AAfter: TPixel); -var - p: PPixel; - n: integer; -begin - p := Data; - for n := NbPixels - 1 downto 0 do - begin - if p^ = ABefore then p^ := AAfter; - Inc(p); - end; - InvalidateBitmap; -end; - -procedure TGenericUniversalBitmap.ReplaceColor(ARect: TRect; - const ABefore,AAfter: TPixel); -var - p: PPixel; - n,w,yb: integer; -begin - if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit; - LoadFromBitmapIfNeeded; - w := ARect.Width-1; - for yb := ARect.Top to ARect.Bottom-1 do - begin - p := GetScanlineFast(yb)+ARect.Left; - for n := w downto 0 do - begin - if p^ = ABefore then p^ := AAfter; - Inc(p); - end; - end; - InvalidateBitmap; -end; - -procedure TGenericUniversalBitmap.ReplaceTransparent(const AAfter: TBGRAPixel); -var before: TPixel; -begin - AssignTransparentPixel(before); - ReplaceColor(before, AAfter); -end; - -procedure TGenericUniversalBitmap.ReplaceTransparent(ARect: TRect; - const AAfter: TPixel); -var before: TPixel; -begin - AssignTransparentPixel(before); - ReplaceColor(ARect, before, AAfter); -end; - -procedure TGenericUniversalBitmap.FillMask(x, y: integer; - AMask: TCustomUniversalBitmap; const AColor: TPixel); -begin - FillMask(x,y, AMask, AColor, dmDrawWithTransparency); -end; - -procedure TGenericUniversalBitmap.FillMask(x, y: integer; - AMask: TCustomUniversalBitmap; const AColor: TPixel; ADrawMode: TDrawMode); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, ADrawMode); - FillMask(x,y, AMask, b); -end; - -procedure TGenericUniversalBitmap.FillRect(ALeft, ATop, ARight, - ABottom: integer; const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, ADrawMode); - FillRect(ALeft,ATop,ARight,ABottom, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.FillRect(const ARect: TRect; - const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, ADrawMode); - FillRect(ARect, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawCheckers(ARect: TRect; const AColorEven, - AColorOdd: TPixel; AGridWidth: integer; AGridHeight: integer; ADrawMode: TDrawMode); -var - bEven, bOdd: TUniversalBrush; -begin - SolidBrush(bEven, AColorEven, ADrawMode); - SolidBrush(bOdd, AColorOdd, ADrawMode); - DrawCheckers(ARect, bEven, bOdd, AGridWidth, AGridHeight); -end; - -procedure TGenericUniversalBitmap.DrawPixel(x, y: Int32or64; - const AColor: TPixel); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, dmDrawWithTransparency); - DrawPixel(x,y, b); -end; - -procedure TGenericUniversalBitmap.DrawPixel(x, y: Int32or64; - const AColor: TPixel; ADrawMode: TDrawMode); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, ADrawMode); - DrawPixel(x,y, b); -end; - -procedure TGenericUniversalBitmap.DrawPixel(x, y: Int32or64; - const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, ADrawMode); - DrawPixel(x,y, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPixelF(x, y: single; - const AColor: TPixel; ADrawMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, ADrawMode); - DrawPixelF(x,y, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.SetHorizLine(x, y, x2: int32or64; - const AColor: TPixel); -var - pScan: PByte; -begin - if not CheckHorizLineBounds(x,y,x2) then exit; - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(x,y); - InternalSetPixels(@AColor, pScan, sizeof(TPixel), x2-x+1); - InvalidateBitmap; -end; - -procedure TGenericUniversalBitmap.HorizLine(x, y, x2: int32or64; - const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AMode); - HorizLine(x,y,x2, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.SetVertLine(x, y, y2: int32or64; - const AColor: TPixel); -var - pScan: PByte; - delta: PtrInt; - yb: Int32or64; -begin - if not CheckVertLineBounds(x,y,y2) then exit; - LoadFromBitmapIfNeeded; - pScan := GetPixelAddress(x,y); - if LineOrder = riloTopToBottom then delta := RowSize else delta := -rowSize; - for yb := y to y2 do - begin - PPixel(pScan)^ := AColor; - inc(pScan, delta); - end; - InvalidateBitmap; -end; - -procedure TGenericUniversalBitmap.VertLine(x, y, y2: int32or64; - const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AMode); - VertLine(x,y,y2, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawLine(x1, y1, x2, y2: integer; - const AColor: TPixel; ADrawLastPixel: boolean; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AMode); - DrawLine(x1,y1,x2,y2, b,ADrawLastPixel,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; - const AColor: TPixel; ADrawLastPixel: boolean; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AntialiasingDrawMode); - DrawLineAntialias(x1,y1,x2,y2, b,ADrawLastPixel,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; - const AColor1, AColor2: TPixel; ADashLen: integer; - ADrawLastPixel: boolean; AAlpha: Word); -var - b1, b2: TUniversalBrush; -begin - SolidBrush(b1, AColor1, AntialiasingDrawMode); - SolidBrush(b2, AColor2, AntialiasingDrawMode); - DrawLineAntialias(x1,y1,x2,y2, b1,b2, ADashLen, ADrawLastPixel, AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; - const AColor1, AColor2: TPixel; ADashLen: integer; - var ADashPos: integer; ADrawLastPixel: boolean; AAlpha: Word); -var - b1, b2: TUniversalBrush; -begin - SolidBrush(b1, AColor1, AntialiasingDrawMode); - SolidBrush(b2, AColor2, AntialiasingDrawMode); - DrawLineAntialias(x1,y1,x2,y2, b1,b2, ADashLen,ADashPos, ADrawLastPixel, AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPolyLine(const points: array of TPoint; - const AColor: TPixel; ADrawLastPixel: boolean; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AMode); - DrawPolyLine(points, b, ADrawLastPixel, AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPolyLineAntialias( - const points: array of TPoint; const AColor: TPixel; - ADrawLastPixel: boolean; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AntialiasingDrawMode); - DrawPolyLineAntialias(points, b,ADrawLastPixel,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPolyLineAntialias( - const points: array of TPoint; const AColor1, AColor2: TPixel; - ADashLen: integer; ADrawLastPixel: boolean; AAlpha: Word); -var - b1, b2: TUniversalBrush; -begin - SolidBrush(b1, AColor1, AntialiasingDrawMode); - SolidBrush(b2, AColor2, AntialiasingDrawMode); - DrawPolyLineAntialias(points, b1,b2,ADashLen, ADrawLastPixel,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPolygon(const points: array of TPoint; - const AColor: TPixel; AMode : TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AMode); - DrawPolygon(points, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPolygonAntialias( - const points: array of TPoint; const AColor: TPixel; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AntialiasingDrawMode); - DrawPolygonAntialias(points, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPolygonAntialias( - const points: array of TPoint; const AColor1, AColor2: TPixel; - ADashLen: integer; AAlpha: Word); -var - b1, b2: TUniversalBrush; -begin - SolidBrush(b1, AColor1, AntialiasingDrawMode); - SolidBrush(b2, AColor2, AntialiasingDrawMode); - DrawPolygonAntialias(points, b1,b2,ADashLen, AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPathAliased(APath: IBGRAPath; - const AColor: TPixel; AMode: TDrawMode; APixelCenteredCoordinates: boolean; - AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor,AMode); - DrawPathAliased(APath, b,APixelCenteredCoordinates,AAlpha); -end; - -procedure TGenericUniversalBitmap.DrawPathAliased(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const AColor: TPixel; AMode: TDrawMode; - APixelCenteredCoordinates: boolean; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor,AMode); - DrawPathAliased(APath,AMatrix, b,APixelCenteredCoordinates,AAlpha); -end; - -procedure TGenericUniversalBitmap.Rectangle(x, y, x2, y2: integer; - const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, AColor, AMode); - Rectangle(x,y,x2,y2, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.Rectangle(x, y, x2, y2: integer; - const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - bBorder,bFill: TUniversalBrush; -begin - SolidBrush(bBorder, ABorderColor, AMode); - SolidBrush(bFill, AFillColor, AMode); - Rectangle(x,y,x2,y2, bBorder,bFill,AAlpha); -end; - -procedure TGenericUniversalBitmap.Rectangle(const ARect: TRect; - const AColor: TPixel; AMode: TDrawMode; AAlpha: Word); -begin - Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, AColor,AMode,AAlpha); -end; - -procedure TGenericUniversalBitmap.Rectangle(const ARect: TRect; - const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); -begin - Rectangle(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom, ABorderColor,AFillColor,AMode,AAlpha); -end; - -procedure TGenericUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; const ABorderColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, ABorderColor,AMode); - RoundRect(X1,Y1,X2,Y2,DX,DY, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; - AAlpha: Word); -var - bBorder, bFill: TUniversalBrush; -begin - SolidBrush(bBorder, ABorderColor,AMode); - SolidBrush(bFill, AFillColor,AMode); - RoundRect(X1,Y1,X2,Y2,DX,DY, bBorder,bFill,AAlpha); -end; - -procedure TGenericUniversalBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX, - DY: integer; const AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - bFill: TUniversalBrush; -begin - SolidBrush(bFill, AFillColor,AMode); - FillRoundRect(X1,Y1,X2,Y2,DX,DY, bFill,AAlpha); -end; - -procedure TGenericUniversalBitmap.EllipseInRect(ARect: TRect; - const ABorderColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b, ABorderColor,AMode); - EllipseInRect(ARect, b,AAlpha); -end; - -procedure TGenericUniversalBitmap.EllipseInRect(ARect: TRect; - const ABorderColor, AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - bBorder, bFill: TUniversalBrush; -begin - SolidBrush(bBorder, ABorderColor,AMode); - SolidBrush(bFill, AFillColor,AMode); - EllipseInRect(ARect, bBorder,bFill,AAlpha); -end; - -procedure TGenericUniversalBitmap.FillEllipseInRect(ARect: TRect; - const AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - bFill: TUniversalBrush; -begin - SolidBrush(bFill, AFillColor,AMode); - FillEllipseInRect(ARect, bFill,AAlpha); -end; - -procedure TGenericUniversalBitmap.FillShape(AShape: TBGRACustomFillInfo; - const AFillColor: TPixel; AMode: TDrawMode; AAlpha: Word); -var - bFill: TUniversalBrush; -begin - SolidBrush(bFill, AFillColor,AMode); - FillShape(AShape, bFill,AAlpha); -end; - -procedure TGenericUniversalBitmap.FillPoly(const APoints: array of TPointF; - const AFillColor: TPixel; AMode: TDrawMode; - APixelCenteredCoordinates: boolean; AAlpha: Word); -var - bFill: TUniversalBrush; -begin - SolidBrush(bFill, AFillColor,AMode); - FillPoly(APoints,bFill,APixelCenteredCoordinates,AAlpha); -end; - -procedure TGenericUniversalBitmap.FillPathAliased(APath: IBGRAPath; - const AFillColor: TPixel; AMode: TDrawMode; - APixelCenteredCoordinates: boolean; AAlpha: Word); -var - bFill: TUniversalBrush; -begin - SolidBrush(bFill, AFillColor,AMode); - FillPathAliased(APath,bFill,APixelCenteredCoordinates,AAlpha); -end; - -procedure TGenericUniversalBitmap.FillPathAliased(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const AFillColor: TPixel; AMode: TDrawMode; - APixelCenteredCoordinates: boolean; AAlpha: Word); -var - bFill: TUniversalBrush; -begin - SolidBrush(bFill, AFillColor,AMode); - FillPathAliased(APath,AMatrix, bFill,APixelCenteredCoordinates,AAlpha); -end; - -function TGenericUniversalBitmap.GetPixelAddress(x, y: integer): PByte; -begin - if FLineOrder = riloBottomToTop then y := FHeight - 1 - y; - result := FDataByte + FRowSize * y + IntPtr(x)*sizeof(TPixel); -end; - -procedure TGenericUniversalBitmap.FillPolyAntialias( - const APoints: array of TPointF; const AColor: TPixel; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - FillPolyAntialias(APoints, b, APixelCenteredCoordinates); -end; - -procedure TGenericUniversalBitmap.FillEllipseAntialias(x, y, rx, ry: single; - const AColor: TPixel); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - FillEllipseAntialias(x,y,rx,ry, b); -end; - -procedure TGenericUniversalBitmap.FillEllipseAntialias(const AOrigin, AXAxis, - AYAxis: TPointF; const AColor: TPixel); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - {$PUSH}{$R-} - FillEllipseAntialias(AOrigin, AXAxis, AYAxis, b); - {$POP} -end; - -procedure TGenericUniversalBitmap.FillPath(APath: IBGRAPath; - const AColor: TPixel; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - FillPath(APath, b, APixelCenteredCoordinates); -end; - -procedure TGenericUniversalBitmap.FillPath(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const AColor: TPixel; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - FillPath(APath,AMatrix, b, APixelCenteredCoordinates); -end; - -procedure TGenericUniversalBitmap.FillRectAntialias(x, y, x2, y2: single; - const AColor: TPixel; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - FillRectAntialias(x,y,x2,y2,b,APixelCenteredCoordinates); -end; - -procedure TGenericUniversalBitmap.FillRectAntialias(const ARectF: TRectF; - const AColor: TPixel; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - FillRectAntialias(ARectF,b,APixelCenteredCoordinates); -end; - -procedure TGenericUniversalBitmap.FillRoundRectAntialias(x, y, x2, y2, rx, - ry: single; const AColor: TPixel; AOptions: TRoundRectangleOptions; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - FillRoundRectAntialias(x,y,x2,y2, rx,ry, b, AOptions, APixelCenteredCoordinates); -end; - -procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; - const AColor: TPixel; APenWidth: single); -var - b: TUniversalBrush; - c: TBGRAPixel; - p: TBGRACustomPenStroker; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - c := AColor; - p := GetInternalPen; - FillPolyAntialias(p.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,c), b); -end; - -procedure TGenericUniversalBitmap.DrawLineAntialias(x1, y1, x2, y2: single; - const AColor: TPixel; APenWidth: single; AClosedCap: boolean); -var - b: TUniversalBrush; - c: TBGRAPixel; - p: TBGRACustomPenStroker; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - c := AColor; - p := GetInternalPen; - FillPolyAntialias(p.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],APenWidth,c,AClosedCap), b); -end; - -procedure TGenericUniversalBitmap.DrawPolyLineAntialias( - const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); -var - b: TUniversalBrush; - c: TBGRAPixel; - p: TBGRACustomPenStroker; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - c := AColor; - p := GetInternalPen; - FillPolyAntialias(p.ComputePolyline(APoints,APenWidth,c),b); -end; - -procedure TGenericUniversalBitmap.DrawPolyLineAntialias( - const APoints: array of TPointF; const AColor: TPixel; APenWidth: single; - AClosedCap: boolean); -var - b: TUniversalBrush; - c: TBGRAPixel; - p: TBGRACustomPenStroker; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - c := AColor; - p := GetInternalPen; - FillPolyAntialias(p.ComputePolyline(APoints,APenWidth,c,AClosedCap),b); -end; - -procedure TGenericUniversalBitmap.DrawPolyLineAntialiasAutocycle( - const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - DrawPolyLineAntialiasAutocycle(APoints, b, APenWidth); -end; - -procedure TGenericUniversalBitmap.DrawPolygonAntialias( - const APoints: array of TPointF; const AColor: TPixel; APenWidth: single); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - DrawPolygonAntialias(APoints, b, APenWidth); -end; - -procedure TGenericUniversalBitmap.RectangleAntialias(x, y, x2, y2: single; - const AColor: TPixel; AWidth: single); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - RectangleAntialias(x,y,x2,y2, b, AWidth); -end; - -procedure TGenericUniversalBitmap.Ellipse(x, y, rx, ry: single; - const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AMode); - Ellipse(x,y,rx,ry, b, AWidth,AAlpha); -end; - -procedure TGenericUniversalBitmap.Ellipse(const AOrigin, AXAxis, AYAxis: TPointF; - const AColor: TPixel; AWidth: single; AMode: TDrawMode; AAlpha: Word); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AMode); - {$PUSH}{$R-} - Ellipse(AOrigin, AXAxis, AYAxis, b, AWidth,AAlpha); - {$POP} -end; - -procedure TGenericUniversalBitmap.EllipseAntialias(x, y, rx, ry: single; - const AColor: TPixel; AWidth: single); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - EllipseAntialias(x,y,rx,ry, b, AWidth); -end; - -procedure TGenericUniversalBitmap.EllipseAntialias(const AOrigin, AXAxis, - AYAxis: TPointF; const AColor: TPixel; AWidth: single); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - {$PUSH}{$R-} - EllipseAntialias(AOrigin, AXAxis, AYAxis, b, AWidth); - {$POP} -end; - -procedure TGenericUniversalBitmap.DrawPath(APath: IBGRAPath; - const AColor: TPixel; AWidth: single; APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - DrawPath(APath, b, AWidth, APixelCenteredCoordinates); -end; - -procedure TGenericUniversalBitmap.DrawPath(APath: IBGRAPath; - const AMatrix: TAffineMatrix; const AColor: TPixel; AWidth: single; - APixelCenteredCoordinates: boolean); -var - b: TUniversalBrush; -begin - SolidBrush(b,AColor,AntialiasingDrawMode); - DrawPath(APath,AMatrix, b, AWidth, APixelCenteredCoordinates); -end; - -{$ENDIF} diff --git a/components/bgrabitmap/universaldrawer.pas b/components/bgrabitmap/universaldrawer.pas deleted file mode 100644 index 9e6e702..0000000 --- a/components/bgrabitmap/universaldrawer.pas +++ /dev/null @@ -1,1177 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit UniversalDrawer; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, FPImage, BGRABitmapTypes, BGRAGraphics, BGRAPen, BGRAArrow; - -type - - { TUniversalDrawer } - - TUniversalDrawer = class(TCustomUniversalDrawer) - - class function GetMaxColorChannelDepth(ADest: TCustomUniversalBitmap): byte; - - {==== Load and save files ====} - - //there are UTF8 functions that are different from standard function as those - //depend on TFPCustomImage that does not clearly handle UTF8 - - {** Load image from a file. ''filename'' is an ANSI string } - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string); overload; override; - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename: string; AOptions: TBGRALoadingOptions); overload; override; - {** Load image from a file with the specified image reader. ''filename'' is an ANSI string } - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader); overload; override; - class procedure LoadFromFile(ADest: TCustomUniversalBitmap; const AFilename:String; AHandler:TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; override; - {** Load image from a file. ''filename'' is an UTF8 string } - class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AOptions: TBGRALoadingOptions = []); overload; override; - {** Load image from a file with the specified image reader. ''filename'' is an UTF8 string } - class procedure LoadFromFileUTF8(ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions = []); overload; override; - {** Load image from a stream. Format is detected automatically } - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream); overload; override; - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AOptions: TBGRALoadingOptions); overload; override; - {** Load image from a stream. The specified image reader is used } - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader); overload; override; - class procedure LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; override; - {** Load image from an embedded Lazarus resource. Format is detected automatically } - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string); overload; override; - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AOptions: TBGRALoadingOptions); overload; override; - {** Load image from an embedded Lazarus resource. The specified image reader is used } - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader); overload; override; - class procedure LoadFromResource(ADest: TCustomUniversalBitmap; AFilename: string; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; override; - - {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } - class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string); overload; override; - {** Save image to a file with the specified image writer. ''filename'' is an ANSI string } - class procedure SaveToFile(ASource: TCustomUniversalBitmap; const AFilename: string; AHandler:TFPCustomImageWriter); overload; override; - {** Save image to a file. The format is guessed from the file extension. ''filename'' is an ANSI string } - class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string); overload; override; - {** Save image to a file with the specified image writer. ''filename'' is an UTF8 string } - class procedure SaveToFileUTF8(ASource: TCustomUniversalBitmap; const AFilenameUTF8: string; AHandler:TFPCustomImageWriter); overload; override; - - {** Save image to a stream in the specified image format } - class procedure SaveToStreamAs(ASource: TCustomUniversalBitmap; AStream: TStream; AFormat: TBGRAImageFormat); override; - {** Save image to a stream in PNG format } - class procedure SaveToStreamAsPng(ASource: TCustomUniversalBitmap; AStream: TStream); override; - - {==== Pixelwise drawing ====} - - class function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; - class function CheckAntialiasRectBounds(var x, y, x2, y2: single; w: single): boolean; - - {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm. - ''DrawLastPixel'' specifies if (x2,y2) must be drawn. } - class procedure DrawLine(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); override; - {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm - ''c'' specifies the color. ''DrawLastPixel'' specifies if (x2,y2) must be drawn } - class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; override; - {** Draws an antialiased line with two colors ''c1'' and ''c2'' as dashes of length ''dashLen''. - ''DashPos'' can be used to specify the start dash position and to retrieve the dash position at the end - of the line, in order to draw a polyline with consistent dashes } - class procedure DrawLineAntialias(ADest: TCustomUniversalBitmap; x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; var DashPos: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); override; - - class procedure DrawPolyLine(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); override; - class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; override; - class procedure DrawPolyLineAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; DrawLastPixel: boolean; AAlpha: Word = 65535); overload; override; - - class procedure DrawPolygon(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); override; - class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; - class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word = 65535); overload; override; - - {** Draw the border of a rectangle } - class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; - {** Draw a filled rectangle with a border } - class procedure Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; - - class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; - class procedure RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const ABorderBrush: TUniversalBrush; AAlpha: Word = 65535); overload; override; - class procedure FillRoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word = 65535); override; - - class procedure FillShape(ADest: TCustomUniversalBitmap; AShape: TBGRACustomFillInfo; AFillMode: TFillMode; ABrush: TUniversalBrush; AAlpha: Word = 65535); override; - class procedure FillPoly(ADest: TCustomUniversalBitmap; const APoints: array of TPointF; AFillMode: TFillMode; ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean = true; AAlpha: Word = 65535); override; - - {==== Using pen ====} - class function CreatePenStroker: TBGRACustomPenStroker; override; - class function CreateArrow: TBGRACustomArrow; override; - - class procedure RectangleAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, x2, y2: single; - const ABrush: TUniversalBrush; AWidth: single); override; - class procedure DrawPolygonAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; - const APoints: array of TPointF; const ABrush: TUniversalBrush; AWidth: single); overload; override; - - class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; override; - class procedure Ellipse(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word=65535); overload; override; - class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, rx, ry: single; - const ABrush: TUniversalBrush; AWidth: single); overload; override; - class procedure EllipseAntialias(ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; - const ABrush: TUniversalBrush; AWidth: single); overload; override; - - {==== Filling ====} - class procedure FillRectAntialias(ADest: TCustomUniversalBitmap; - x, y, x2, y2: single; const ABrush: TUniversalBrush; - APixelCenteredCoordinates: boolean = true); override; - class procedure FillRoundRectAntialias(ADest: TCustomUniversalBitmap; - x,y,x2,y2, rx,ry: single; const ABrush: TUniversalBrush; - AOptions: TRoundRectangleOptions = []; APixelCenteredCoordinates: boolean = true); override; - class procedure FillShapeAntialias(ADest: TCustomUniversalBitmap; - AShape: TBGRACustomFillInfo; AFillMode: TFillMode; - ABrush: TUniversalBrush); override; - class procedure FillPolyAntialias(ADest: TCustomUniversalBitmap; - const APoints: array of TPointF; AFillMode: TFillMode; - ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); override; - class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; - x, y, rx, ry: single; const ABrush: TUniversalBrush); overload; override; - class procedure FillEllipseAntialias(ADest: TCustomUniversalBitmap; - const AOrigin, AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush); overload; override; - - //filters - class procedure FilterBlurRadial(ASource: TCustomUniversalBitmap; const ABounds: TRect; - radiusX, radiusY: single; blurType: TRadialBlurType; - ADest: TCustomUniversalBitmap); override; - class procedure FilterBlurMotion(ASource: TCustomUniversalBitmap; const ABounds: TRect; - distance: single; angle: single; oriented: boolean; - ADest: TCustomUniversalBitmap); override; - class procedure FilterCustomBlur(ASource: TCustomUniversalBitmap; const ABounds: TRect; - mask: TCustomUniversalBitmap; - ADest: TCustomUniversalBitmap); override; - - end; - -implementation - -uses BGRAPolygon, BGRAPolygonAliased, BGRAPath, BGRAFillInfo, BGRAUTF8, - BGRAReadBMP, BGRAReadJpeg, BGRAWritePNG, BGRAWriteTiff, - BGRAFilterBlur, Math, FPWritePNM; - -{ TUniversalDrawer } - -class function TUniversalDrawer.GetMaxColorChannelDepth(ADest: TCustomUniversalBitmap): byte; -var - idxAlpha, i: Integer; - bits: Byte; -begin - result := 0; - idxAlpha := ADest.Colorspace.IndexOfAlphaChannel; - for i := 0 to ADest.Colorspace.GetChannelCount-1 do - if i <> idxAlpha then - begin - bits := ADest.Colorspace.GetChannelBitDepth(i); - if bits > result then result := bits; - end; -end; - -class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; - const AFilename: string); -begin - LoadFromFileUTF8(ADest, SysToUtf8(AFilename)); -end; - -class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; - const AFilename: string; AOptions: TBGRALoadingOptions); -begin - LoadFromFileUTF8(ADest, SysToUtf8(AFilename), AOptions); -end; - -class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; - const AFilename: String; AHandler: TFPCustomImageReader); -begin - LoadFromFileUTF8(ADest, SysToUtf8(AFilename), AHandler); -end; - -class procedure TUniversalDrawer.LoadFromFile(ADest: TCustomUniversalBitmap; - const AFilename: String; AHandler: TFPCustomImageReader; - AOptions: TBGRALoadingOptions); -begin - LoadFromFileUTF8(ADest, SysToUtf8(AFilename), AHandler, AOptions); -end; - -class procedure TUniversalDrawer.LoadFromFileUTF8( - ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; - AOptions: TBGRALoadingOptions); -var - stream: TStream; - format: TBGRAImageFormat; - reader: TFPCustomImageReader; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite); - try - format := DetectFileFormat(Stream, ExtractFileExt(AFilenameUTF8)); - reader := CreateBGRAImageReader(format); - try - ADest.LoadFromStream(stream, reader, AOptions); - finally - reader.Free; - end; - finally - stream.Free; - end; -end; - -class procedure TUniversalDrawer.LoadFromFileUTF8( - ADest: TCustomUniversalBitmap; const AFilenameUTF8: string; - AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -var - stream: TStream; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite); - try - ADest.LoadFromStream(stream, AHandler, AOptions); - finally - stream.Free; - end; -end; - -class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; - AStream: TStream); -begin - ADest.LoadFromStream(AStream, [loKeepTransparentRGB]); -end; - -class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; - AStream: TStream; AOptions: TBGRALoadingOptions); -var - format: TBGRAImageFormat; - reader: TFPCustomImageReader; -begin - format := DetectFileFormat(AStream); - reader := CreateBGRAImageReader(format); - try - ADest.LoadFromStream(AStream, reader, AOptions); - finally - reader.Free; - end; -end; - -class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; - AStream: TStream; AHandler: TFPCustomImageReader); -begin - ADest.LoadFromStream(AStream, AHandler, [loKeepTransparentRGB]); -end; - -class procedure TUniversalDrawer.LoadFromStream(ADest: TCustomUniversalBitmap; AStream: TStream; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -var OldBmpOption: TBMPTransparencyOption; - OldJpegPerf: TJPEGReadPerformance; -begin - if (loBmpAutoOpaque in AOptions) and (AHandler is TBGRAReaderBMP) then - begin - OldBmpOption := TBGRAReaderBMP(AHandler).TransparencyOption; - TBGRAReaderBMP(AHandler).TransparencyOption := toAuto; - TFPCustomImage(ADest).LoadFromStream(AStream, AHandler); - TBGRAReaderBMP(AHandler).TransparencyOption := OldBmpOption; - end else - if (loJpegQuick in AOptions) and (AHandler is TBGRAReaderJpeg) then - begin - OldJpegPerf := TBGRAReaderJpeg(AHandler).Performance; - TBGRAReaderJpeg(AHandler).Performance := jpBestSpeed; - TFPCustomImage(ADest).LoadFromStream(AStream, AHandler); - TBGRAReaderJpeg(AHandler).Performance := OldJpegPerf; - end else - TFPCustomImage(ADest).LoadFromStream(AStream, AHandler); - if not (loKeepTransparentRGB in AOptions) then - ADest.ClearTransparentPixels; -end; - -class procedure TUniversalDrawer.LoadFromResource( - ADest: TCustomUniversalBitmap; AFilename: string); -begin - LoadFromResource(ADest, AFilename, [loKeepTransparentRGB]); -end; - -class procedure TUniversalDrawer.LoadFromResource( - ADest: TCustomUniversalBitmap; AFilename: string; - AOptions: TBGRALoadingOptions); -var - stream: TStream; - format: TBGRAImageFormat; - reader: TFPCustomImageReader; - ext: String; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - ext := Uppercase(ExtractFileExt(AFilename)); - if (ext = '.BMP') and BGRAResource.IsWinResource(AFilename) then - begin - reader := TBGRAReaderBMP.Create; - TBGRAReaderBMP(reader).Subformat := bsfHeaderless; - end else - begin - format := DetectFileFormat(stream, ext); - reader := CreateBGRAImageReader(format); - end; - try - ADest.LoadFromStream(stream, reader, AOptions); - finally - reader.Free; - end; - finally - stream.Free; - end; -end; - -class procedure TUniversalDrawer.LoadFromResource( - ADest: TCustomUniversalBitmap; AFilename: string; - AHandler: TFPCustomImageReader); -begin - LoadFromResource(ADest, AFilename, AHandler, [loKeepTransparentRGB]); -end; - -class procedure TUniversalDrawer.LoadFromResource( - ADest: TCustomUniversalBitmap; AFilename: string; - AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); -var - stream: TStream; -begin - stream := BGRAResource.GetResourceStream(AFilename); - try - ADest.LoadFromStream(stream, AHandler, AOptions); - finally - stream.Free; - end; -end; - -class procedure TUniversalDrawer.SaveToFile(ASource: TCustomUniversalBitmap; - const AFilename: string); -begin - SaveToFileUTF8(ASource, SysToUtf8(AFilename)); -end; - -class procedure TUniversalDrawer.SaveToFile(ASource: TCustomUniversalBitmap; - const AFilename: string; AHandler: TFPCustomImageWriter); -begin - SaveToFileUTF8(ASource, SysToUtf8(AFilename), AHandler); -end; - -class procedure TUniversalDrawer.SaveToFileUTF8( - ASource: TCustomUniversalBitmap; const AFilenameUTF8: string); -var - writer: TFPCustomImageWriter; - format: TBGRAImageFormat; - ext: String; -begin - format := SuggestImageFormat(AFilenameUTF8); - if (format = ifXPixMap) and (ASource.NbPixels > 32768) then //xpm is slow so avoid big images - raise exception.Create('Image is too big to be saved as XPM'); - writer := CreateBGRAImageWriter(Format, ASource.HasTransparentPixels); - if GetMaxColorChannelDepth(ASource) > 8 then - begin - if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).WordSized := true; - end; - if writer is TFPWriterPNM then - begin - ext := LowerCase(ExtractFileExt(AFilenameUTF8)); - if ext = '.pbm' then TFPWriterPNM(writer).ColorDepth:= pcdBlackWhite else - if ext = '.pgm' then TFPWriterPNM(writer).ColorDepth:= pcdGrayscale else - if ext = '.ppm' then TFPWriterPNM(writer).ColorDepth:= pcdRGB; - end; - try - SaveToFileUTF8(ASource, AFilenameUTF8, writer); - finally - writer.free; - end; -end; - -class procedure TUniversalDrawer.SaveToFileUTF8( - ASource: TCustomUniversalBitmap; const AFilenameUTF8: string; - AHandler: TFPCustomImageWriter); -var - stream: TFileStreamUTF8; -begin - stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate); - try - TFPCustomImage(ASource).SaveToStream(stream, AHandler); - finally - stream.Free; - end; -end; - -class procedure TUniversalDrawer.SaveToStreamAs( - ASource: TCustomUniversalBitmap; AStream: TStream; AFormat: TBGRAImageFormat); -var writer: TFPCustomImageWriter; -begin - writer := CreateBGRAImageWriter(AFormat, ASource.HasTransparentPixels); - if GetMaxColorChannelDepth(ASource) > 8 then - begin - if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).WordSized := true; - end; - try - TFPCustomImage(ASource).SaveToStream(AStream, writer) - finally - writer.Free; - end; -end; - -class procedure TUniversalDrawer.SaveToStreamAsPng( - ASource: TCustomUniversalBitmap; AStream: TStream); -begin - SaveToStreamAs(ASource, AStream, ifPNG); -end; - -class function TUniversalDrawer.CheckRectBounds( - var x, y, x2, y2: integer; minsize: integer): boolean; -var - temp: integer; -begin - //swap coordinates if needed - if (x > x2) then - begin - temp := x; - x := x2; - x2 := temp; - end; - if (y > y2) then - begin - temp := y; - y := y2; - y2 := temp; - end; - result := (x2 - x > minsize) and (y2 - y > minsize); -end; - -class function TUniversalDrawer.CheckAntialiasRectBounds(var x, y, x2, - y2: single; w: single): boolean; -var - temp: Single; -begin - if (x > x2) then - begin - temp := x; - x := x2; - x2 := temp; - end; - if (y > y2) then - begin - temp := y; - y := y2; - y2 := temp; - end; - - result := (x2 - x > w) and (y2 - y > w); -end; - -class procedure TUniversalDrawer.DrawLine(ADest: TCustomUniversalBitmap; x1, - y1, x2, y2: integer; const ABrush: TUniversalBrush; DrawLastPixel: boolean; - AAlpha: Word); -type - TDrawPixelProc = procedure(x,y: Int32or64; const ABrush: TUniversalBrush; AAlpha: Word = 65535) of object; -var - Y, X: integer; - DX, DY, SX, SY, E: integer; - drawPixelProc: TDrawPixelProc; - skip: Boolean; - r: TRect; - E64: Int64; -begin - r := ADest.ClipRect; - skip := false; - if ABrush.DoesNothing or (AAlpha= 0) then skip := true; - if (x1 < r.Left) and (x2 < r.Left) then skip := true; - if (x1 >= r.Right) and (x2 >= r.Right) then skip := true; - if (y1 < r.Top) and (y2 < r.Top) then skip := true; - if (y1 >= r.Bottom) and (y2 >= r.Bottom) then skip := true; - if skip then exit; - - if (Y1 = Y2) then - begin - if (X1 = X2) then - begin - if DrawLastPixel then ADest.DrawPixel(X1, Y1, ABrush, AAlpha); - end else - begin - if not DrawLastPixel then - begin - if X2 > X1 then dec(X2) else inc(X2); - end; - ADest.HorizLine(X1,Y1,X2, ABrush, AAlpha); - end; - Exit; - end else - if (X1 = X2) then - begin - if not DrawLastPixel then - begin - if Y2 > Y1 then dec(Y2) else inc(Y2); - end; - ADest.VertLine(X1,Y1,Y2, ABrush, AAlpha); - Exit; - end; - - DX := X2 - X1; - DY := Y2 - Y1; - - if DX < 0 then - begin - SX := -1; - DX := -DX; - end - else SX := 1; - - if DY < 0 then - begin - SY := -1; - DY := -DY; - end - else SY := 1; - - DX := DX shl 1; - DY := DY shl 1; - - drawPixelProc := @ADest.DrawPixel; - X := X1; - Y := Y1; - if DX > DY then - begin - E := DY - DX shr 1; - if (X < r.Left) and (SX > 0) then - begin - E64 := E+int64(DY)*(r.Left-X)+DX; - E := (E64 mod DX)-DX; - Inc(Y, (E64 div DX)*SY); - X := r.Left; - end; - if (X >= r.Right) and (SX < 0) then - begin - E64 := E+int64(DY)*(X-(r.Right-1))+DX; - E := (E64 mod DX)-DX; - Inc(Y, (E64 div DX)*SY); - X := r.Right-1; - end; - if (X2 < r.Left-1) and (SX < 0) then X2 := r.Left-1; - if (X2 > r.Right) and (SX > 0) then X2 := r.Right; - while X <> X2 do - begin - drawPixelProc(X, Y, ABrush, AAlpha); - if E >= 0 then - begin - Inc(Y, SY); - Dec(E, DX); - end; - Inc(X, SX); - Inc(E, DY); - end; - end - else - begin - E := DX - DY shr 1; - if (Y < r.Top) and (SY > 0) then - begin - E64 := E+int64(DX)*(r.Top-Y)+DY; - E := (E64 mod DY)-DY; - Inc(X, (E64 div DY)*SX); - Y := r.Top; - end; - if (Y >= r.Bottom) and (SY < 0) then - begin - E64 := E+int64(DX)*(Y-(r.Bottom-1))+DY; - E := (E64 mod DY)-DY; - Inc(X, (E64 div DY)*SX); - Y := r.Bottom-1; - end; - if (Y2 < r.Top-1) and (SY < 0) then Y2 := r.Top-1; - if (Y2 > r.Bottom) and (SY > 0) then Y2 := r.Bottom; - while Y <> Y2 do - begin - drawPixelProc(X, Y, ABrush, AAlpha); - if E >= 0 then - begin - Inc(X, SX); - Dec(E, DY); - end; - Inc(Y, SY); - Inc(E, DX); - end; - end; - - if DrawLastPixel then - drawPixelProc(X2, Y2, ABrush, AAlpha); -end; - -class procedure TUniversalDrawer.DrawLineAntialias(ADest: TCustomUniversalBitmap; - x1, y1, x2, y2: integer; const ABrush: TUniversalBrush; - DrawLastPixel: boolean; AAlpha: Word = 65535); -var - dashPos: integer; -begin - dashPos := 0; - DrawLineAntialias(ADest,x1,y1,x2,y2, ABrush,ABrush,$1000000,dashPos,DrawLastPixel,AAlpha); -end; - -class procedure TUniversalDrawer.DrawLineAntialias(ADest: TCustomUniversalBitmap; - x1, y1, x2, y2: integer; const ABrush1, ABrush2: TUniversalBrush; - ADashLen: integer; var DashPos: integer; DrawLastPixel: boolean; - AAlpha: Word = 65535); -var - curBrush: PUniversalBrush; - - procedure SkipDash(ACount: integer); - begin - if ACount = 0 then exit; - DashPos := PositiveMod(DashPos+ACount, ADashLen+ADashLen); - if DashPos < ADashLen then curBrush := @ABrush1 else curBrush := @ABrush2; - end; - -var - X, Y, DX, DY, SX, SY, E,count, skipAfter: integer; - curAlpha: Word; - skip: Boolean; - r: TRect; - E64: Int64; -begin - r := ADest.ClipRect; - skip := false; - if (ABrush1.DoesNothing and ABrush2.DoesNothing) or (AAlpha=0) then skip := true; - if (x1 < r.Left) and (x2 < r.Left) then skip := true; - if (x1 >= r.Right) and (x2 >= r.Right) then skip := true; - if (y1 < r.Top) and (y2 < r.Top) then skip := true; - if (y1 >= r.Bottom) and (y2 >= r.Bottom) then skip := true; - - if ADashLen<=0 then ADashLen := 1; - if skip then - begin - count := max(abs(x2-x1),abs(y2-y1)); - if DrawLastPixel then inc(count); - SkipDash(count); - exit; - end; - - DashPos := PositiveMod(DashPos,ADashLen+ADashLen); - if DashPos < ADashLen then curBrush := @ABrush1 else curBrush := @ABrush2; - - if (Y1 = Y2) and (X1 = X2) then - begin - if DrawLastPixel then - begin - ADest.DrawPixel(X1, Y1, curBrush^, AAlpha); - inc(DashPos); - if DashPos = ADashLen + ADashLen then DashPos := 0; - end; - Exit; - end; - - DX := X2 - X1; - DY := Y2 - Y1; - if DX < 0 then - begin - SX := -1; - DX := -DX; - end else SX := 1; - - if DY < 0 then - begin - SY := -1; - DY := -DY; - end else SY := 1; - - DX := DX shl 1; - DY := DY shl 1; - X := X1; - Y := Y1; - if DX > DY then - begin - E := 0; - if (X < r.Left) and (SX > 0) then - begin - E64 := E+int64(DY)*(r.Left-X); - E := E64 mod DX; - Inc(Y, (E64 div DX)*SY); - SkipDash(r.Left-X); - X := r.Left; - end; - if (X >= r.Right) and (SX < 0) then - begin - E64 := E+int64(DY)*(X-(r.Right-1)); - E := E64 mod DX; - Inc(Y, (E64 div DX)*SY); - SkipDash(X-(r.Right-1)); - X := r.Right-1; - end; - if (X2 < r.Left-1) and (SX < 0) then - begin - skipAfter := (r.Left-1)-X2; - X2 := r.Left-1; - end else - if (X2 > r.Right) and (SX > 0) then - begin - skipAfter := X2-r.Right; - X2 := r.Right; - end else - skipAfter := 0; - while X <> X2 do - begin - curAlpha := AAlpha * E div DX; - ADest.DrawPixel(X, Y, curBrush^, AAlpha - curAlpha); - ADest.DrawPixel(X, Y + SY, curBrush^, curAlpha); - Inc(E, DY); - if E >= DX then - begin - Inc(Y, SY); - Dec(E, DX); - end; - Inc(X, SX); - - Inc(DashPos); - if DashPos = ADashLen then - curBrush := @ABrush2 - else - if DashPos = ADashLen + ADashLen then - begin - curBrush := @ABrush1; - DashPos := 0; - end; - end; - end - else - begin - E := 0; - if (Y < r.Top) and (SY > 0) then - begin - E64 := E+int64(DX)*(r.Top-Y); - E := E64 mod DY; - Inc(X, (E64 div DY)*SX); - SkipDash(r.Top-Y); - Y := r.Top; - end; - if (Y >= r.Bottom) and (SY < 0) then - begin - E64 := E+int64(DX)*(Y-(r.Bottom-1)); - E := E64 mod DY; - Inc(X, (E64 div DY)*SX); - SkipDash(Y-(r.Bottom-1)); - Y := r.Bottom-1; - end; - if (Y2 < r.Top-1) and (SY < 0) then - begin - skipAfter := (r.Top-1)-Y2; - Y2 := r.Top-1; - end else - if (Y2 > r.Bottom) and (SY > 0) then - begin - skipAfter := Y2-r.Bottom; - Y2 := r.Bottom; - end else - skipAfter := 0; - while Y <> Y2 do - begin - curAlpha := AAlpha * E div DY; - ADest.DrawPixel(X, Y, curBrush^, AAlpha - curAlpha); - ADest.DrawPixel(X + SX, Y, curBrush^, curAlpha); - Inc(E, DX); - if E >= DY then - begin - Inc(X, SX); - Dec(E, DY); - end; - Inc(Y, SY); - - Inc(DashPos); - if DashPos = ADashLen then - curBrush := @ABrush2 - else - if DashPos = ADashLen + ADashLen then - begin - curBrush := @ABrush1; - DashPos := 0; - end; - end; - end; - if DrawLastPixel then - begin - ADest.DrawPixel(X2, Y2, curBrush^, AAlpha); - inc(DashPos); - if DashPos = ADashLen + ADashLen then DashPos := 0; - end; - SkipDash(skipAfter); -end; - -class procedure TUniversalDrawer.DrawPolyLine(ADest: TCustomUniversalBitmap; - const points: array of TPoint; const ABrush: TUniversalBrush; - DrawLastPixel: boolean; AAlpha: Word); -var i,start: integer; -begin - if ABrush.DoesNothing then exit; - start := 0; - for i := 0 to high(points) do - if IsEmptyPoint(points[i]) then start := i+1 else - begin - if (i = high(points)) or IsEmptyPoint(points[i+1]) then - begin - if (i = start) and DrawLastPixel then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha); - end else - DrawLine(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, - DrawLastPixel and ((i=high(points)-1) or IsEmptyPoint(points[i+2])), AAlpha); - end; -end; - -class procedure TUniversalDrawer.DrawPolyLineAntialias( - ADest: TCustomUniversalBitmap; const points: array of TPoint; - const ABrush: TUniversalBrush; DrawLastPixel: boolean; AAlpha: Word); -var i,start: integer; -begin - if ABrush.DoesNothing then exit; - start := 0; - for i := 0 to high(points) do - if IsEmptyPoint(points[i]) then start := i+1 else - begin - if (i = high(points)) or IsEmptyPoint(points[i+1]) then - begin - if (i = start) and DrawLastPixel then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha); - end else - DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, - DrawLastPixel and ((i=high(points)-1) or IsEmptyPoint(points[i+2])), AAlpha); - end; -end; - -class procedure TUniversalDrawer.DrawPolyLineAntialias( - ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, - ABrush2: TUniversalBrush; ADashLen: integer; DrawLastPixel: boolean; - AAlpha: Word); -var i,start, dashPos: integer; -begin - if ABrush1.DoesNothing and ABrush2.DoesNothing then exit; - start := 0; - dashPos := 0; - for i := 0 to high(points) do - if IsEmptyPoint(points[i]) then start := i+1 else - begin - if (i = high(points)) or IsEmptyPoint(points[i+1]) then - begin - if (i = start) and DrawLastPixel then - begin - if dashPos < ADashLen then - ADest.DrawPixel(points[i].x,points[i].y, ABrush1,AAlpha) - else - ADest.DrawPixel(points[i].x,points[i].y, ABrush2,AAlpha); - inc(dashPos); - if dashPos = ADashLen*2 then dashPos := 0; - end; - end else - DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, - ABrush1,ABrush2,ADashLen,dashPos, - DrawLastPixel and ((i=high(points)-1) or IsEmptyPoint(points[i+2])), AAlpha); - end; -end; - -class procedure TUniversalDrawer.DrawPolygon(ADest: TCustomUniversalBitmap; - const points: array of TPoint; const ABrush: TUniversalBrush; AAlpha: Word); -var i,start: integer; -begin - if ABrush.DoesNothing then exit; - start := 0; - for i := 0 to high(points) do - if IsEmptyPoint(points[i]) then start := i+1 else - begin - if (i = high(points)) or IsEmptyPoint(points[i+1]) then - begin - if i = start then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha) - else if (i > start) then - DrawLine(ADest, points[i].x,points[i].Y,points[start].x,points[start].y, ABrush, false, AAlpha); - end else - DrawLine(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, false, AAlpha); - end; -end; - -class procedure TUniversalDrawer.DrawPolygonAntialias( - ADest: TCustomUniversalBitmap; const points: array of TPoint; - const ABrush: TUniversalBrush; AAlpha: Word); -var i,start: integer; -begin - if ABrush.DoesNothing then exit; - start := 0; - for i := 0 to high(points) do - if IsEmptyPoint(points[i]) then start := i+1 else - begin - if (i = high(points)) or IsEmptyPoint(points[i+1]) then - begin - if i = start then ADest.DrawPixel(points[i].x,points[i].y, ABrush,AAlpha) - else if (i > start) then - DrawLineAntialias(ADest, points[i].x,points[i].Y,points[start].x,points[start].y, ABrush, false, AAlpha); - end else - DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, ABrush, false, AAlpha); - end; -end; - -class procedure TUniversalDrawer.DrawPolygonAntialias( - ADest: TCustomUniversalBitmap; const points: array of TPoint; const ABrush1, - ABrush2: TUniversalBrush; ADashLen: integer; AAlpha: Word); -var i,start, dashPos: integer; -begin - if ABrush1.DoesNothing and ABrush2.DoesNothing then exit; - start := 0; - dashPos := 0; - for i := 0 to high(points) do - if IsEmptyPoint(points[i]) then start := i+1 else - begin - if (i = high(points)) or IsEmptyPoint(points[i+1]) then - begin - if i = start then - begin - if dashPos < ADashLen then - ADest.DrawPixel(points[i].x,points[i].y, ABrush1,AAlpha) - else - ADest.DrawPixel(points[i].x,points[i].y, ABrush2,AAlpha); - inc(dashPos); - if dashPos = ADashLen*2 then dashPos := 0; - end - else if (i > start) then - DrawLineAntialias(ADest, points[i].x,points[i].Y,points[start].x,points[start].y, - ABrush1,ABrush2,ADashLen,dashPos, false, AAlpha); - end else - DrawLineAntialias(ADest, points[i].x,points[i].Y,points[i+1].x,points[i+1].y, - ABrush1,ABrush2,ADashLen,dashPos, false, AAlpha); - end; -end; - -class procedure TUniversalDrawer.Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; - const ABrush: TUniversalBrush; AAlpha: Word); -begin - if not CheckRectBounds({%H-}x,{%H-}y,{%H-}x2,{%H-}y2,1) or ABrush.DoesNothing then exit; - ADest.HorizLine(x, y, x2-1, ABrush, AAlpha); - if y2-y > 2 then - begin - ADest.VertLine(x, y+1, y2-2, ABrush, AAlpha); - ADest.VertLine(x2-1, y+1, y2-2, ABrush, AAlpha); - end; - ADest.HorizLine(x, y2-1, x2-1, ABrush, AAlpha); -end; - -class procedure TUniversalDrawer.Rectangle(ADest: TCustomUniversalBitmap; x, y, x2, y2: integer; - const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); -begin - if not CheckRectBounds({%H-}x,{%H-}y,{%H-}x2,{%H-}y2,1) then exit; - Rectangle(ADest, x, y, x2, y2, ABorderBrush, AAlpha); - ADest.FillRect(x+1, y+1, x2-1, y2-1, AFillBrush, AAlpha); -end; - -class procedure TUniversalDrawer.RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; - const ABorderBrush, AFillBrush: TUniversalBrush; AAlpha: Word); -begin - BGRAPolygonAliased.BGRARoundRectAliased(ADest, X1,Y1,X2,Y2,DX,DY,ABorderBrush,AFillBrush,AAlpha); -end; - -class procedure TUniversalDrawer.RoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, DY: integer; - const ABorderBrush: TUniversalBrush; AAlpha: Word); -begin - BGRAPolygonAliased.BGRARoundRectAliased(ADest, X1,Y1,X2,Y2,DX,DY,ABorderBrush,ABorderBrush,AAlpha,false,true); -end; - -class procedure TUniversalDrawer.FillRoundRect(ADest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer; DX, - DY: integer; const AFillBrush: TUniversalBrush; AAlpha: Word); -begin - BGRAPolygonAliased.BGRARoundRectAliased(ADest, X1,Y1,X2,Y2,DX,DY,AFillBrush,AFillBrush,AAlpha); -end; - -class procedure TUniversalDrawer.FillShape(ADest: TCustomUniversalBitmap; - AShape: TBGRACustomFillInfo; AFillMode: TFillMode; ABrush: TUniversalBrush; - AAlpha: Word); -begin - BGRAPolygon.FillShapeAliased(ADest, AShape, ABrush, AAlpha, AFillMode = fmWinding); -end; - -class procedure TUniversalDrawer.FillPoly(ADest: TCustomUniversalBitmap; - const APoints: array of TPointF; AFillMode: TFillMode; - ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean; AAlpha: Word); -begin - BGRAPolygon.FillPolyAliased(ADest, APoints, ABrush, AAlpha, AFillMode = fmWinding, APixelCenteredCoordinates); -end; - -class function TUniversalDrawer.CreatePenStroker: TBGRACustomPenStroker; -begin - result := TBGRAPenStroker.Create; -end; - -class function TUniversalDrawer.CreateArrow: TBGRACustomArrow; -begin - result := TBGRAArrow.Create; -end; - -class procedure TUniversalDrawer.RectangleAntialias( - ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; x, y, x2, y2: single; - const ABrush: TUniversalBrush; AWidth: single); -var - hw, bevel: Single; -begin - if (APen.Style = psClear) or (AWidth = 0) then exit; - - if not CheckAntialiasRectBounds(x,y,x2,y2, AWidth) then - begin - hw := AWidth/2; - if APen.JoinStyle = pjsBevel then - begin - bevel := (2 - sqrt(2)) * hw; - FillRoundRectAntialias(ADest, x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, ABrush, - [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]); - end else - if APen.JoinStyle = pjsRound then - FillRoundRectAntialias(ADest, x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, ABrush) - else - FillRectAntialias(ADest, x - hw, y - hw, x2 + hw, y2 + hw, ABrush); - end else - if (APen.JoinStyle = pjsMiter) and (APen.Style = psSolid) and (APen.MiterLimit > 1.4142) then - begin - hw := AWidth/2; - FillPolyAntialias(ADest, [PointF(x-hw,y-hw),PointF(x2+hw,y-hw),PointF(x2+hw,y2+hw),PointF(x-hw,y2+hw),EmptyPointF, - PointF(x+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y+hw),PointF(x+hw,y+hw)], - fmWinding, ABrush, true); - end else - DrawPolygonAntialias(ADest, APen, [Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)], ABrush, AWidth); -end; - -class procedure TUniversalDrawer.DrawPolygonAntialias( - ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; - const APoints: array of TPointF; const ABrush: TUniversalBrush; AWidth: single); -begin - FillPolyAntialias(ADest, APen.ComputePolygon(APoints, AWidth), ADest.FillMode, ABrush, true); -end; - -class procedure TUniversalDrawer.Ellipse(ADest: TCustomUniversalBitmap; - APen: TBGRACustomPenStroker; x, y,rx, ry: single; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); -begin - if (APen.Style = psClear) or (AWidth = 0) then exit; - if (APen.Style = psSolid) then - BGRAPolygon.BorderEllipse(ADest, x, y, rx, ry, AWidth, ABrush, AAlpha) - else - begin - if ABrush.DoesNothing then exit; - FillPoly(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(x,y,rx,ry),AWidth), - ADest.FillMode, ABrush, true, AAlpha); - end; -end; - -class procedure TUniversalDrawer.Ellipse(ADest: TCustomUniversalBitmap; - APen: TBGRACustomPenStroker; const AOrigin, AXAxis, AYAxis: TPointF; - const ABrush: TUniversalBrush; AWidth: single; AAlpha: Word); -begin - if (APen.Style = psClear) or (AWidth = 0) or ABrush.DoesNothing then exit; - FillPoly(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(AOrigin, AXAxis, AYAxis), AWidth), - ADest.FillMode, ABrush, true, AAlpha); -end; - -class procedure TUniversalDrawer.EllipseAntialias( - ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; - x, y, rx, ry: single; const ABrush: TUniversalBrush; AWidth: single); -begin - if (APen.Style = psClear) or (AWidth = 0) then exit; - if (APen.Style = psSolid) then - BGRAPolygon.BorderEllipseAntialias(ADest, x, y, rx, ry, AWidth, ABrush) - else - begin - if ABrush.DoesNothing then exit; - FillPolyAntialias(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(x,y,rx,ry),AWidth), - ADest.FillMode, ABrush, true); - end; -end; - -class procedure TUniversalDrawer.EllipseAntialias( - ADest: TCustomUniversalBitmap; APen: TBGRACustomPenStroker; const AOrigin, - AXAxis, AYAxis: TPointF; const ABrush: TUniversalBrush; AWidth: single); -begin - if (APen.Style = psClear) or (AWidth = 0) or ABrush.DoesNothing then exit; - FillPolyAntialias(ADest, APen.ComputePolygon(BGRAPath.ComputeEllipse(AOrigin, AXAxis, AYAxis), AWidth), - ADest.FillMode, ABrush, true); -end; - -class procedure TUniversalDrawer.FillRectAntialias( - ADest: TCustomUniversalBitmap; x, y, x2, y2: single; - const ABrush: TUniversalBrush; APixelCenteredCoordinates: boolean); -var - fi: TFillRectangleInfo; -begin - if ABrush.DoesNothing then exit; - fi := TFillRectangleInfo.Create(x,y,x2,y2,APixelCenteredCoordinates); - FillShapeAntialias(ADest, fi, fmAlternate, ABrush); - fi.Free; -end; - -class procedure TUniversalDrawer.FillRoundRectAntialias( - ADest: TCustomUniversalBitmap; x, y, x2, y2, rx, ry: single; - const ABrush: TUniversalBrush; AOptions: TRoundRectangleOptions; - APixelCenteredCoordinates: boolean); -var - fi: TFillRoundRectangleInfo; -begin - if ABrush.DoesNothing or (x = x2) or (y = y2) then exit; - fi := TFillRoundRectangleInfo.Create(x,y,x2,y2, rx,ry, AOptions, APixelCenteredCoordinates); - FillShapeAntialias(ADest, fi, fmAlternate, ABrush); - fi.Free; -end; - -class procedure TUniversalDrawer.FillShapeAntialias( - ADest: TCustomUniversalBitmap; AShape: TBGRACustomFillInfo; - AFillMode: TFillMode; ABrush: TUniversalBrush); -begin - BGRAPolygon.FillShapeAntialias(ADest, AShape, ABrush, AFillMode = fmWinding); -end; - -class procedure TUniversalDrawer.FillPolyAntialias( - ADest: TCustomUniversalBitmap; const APoints: array of TPointF; - AFillMode: TFillMode; ABrush: TUniversalBrush; - APixelCenteredCoordinates: boolean); -begin - BGRAPolygon.FillPolyAntialias(ADest, APoints, ABrush, - AFillMode = fmWinding, APixelCenteredCoordinates); -end; - -class procedure TUniversalDrawer.FillEllipseAntialias( - ADest: TCustomUniversalBitmap; x, y, rx, ry: single; - const ABrush: TUniversalBrush); -begin - BGRAPolygon.FillEllipseAntialias(ADest, x, y, rx, ry, ABrush); -end; - -class procedure TUniversalDrawer.FillEllipseAntialias( - ADest: TCustomUniversalBitmap; const AOrigin, AXAxis, AYAxis: TPointF; - const ABrush: TUniversalBrush); -var - pts: array of TPointF; -begin - if (AOrigin.y = AXAxis.y) and (AOrigin.x = AYAxis.x) then - FillEllipseAntialias(ADest, AOrigin.x,AOrigin.y, - abs(AXAxis.x-AOrigin.x),abs(AYAxis.y-AOrigin.y), ABrush) - else - if (AOrigin.x = AXAxis.x) and (AOrigin.y = AYAxis.y) then - FillEllipseAntialias(ADest, AOrigin.x,AOrigin.y, - abs(AYAxis.x-AOrigin.x),abs(AXAxis.y-AOrigin.y), ABrush) - else - begin - if ABrush.DoesNothing then exit; - pts := BGRAPath.ComputeEllipse(AOrigin,AXAxis,AYAxis); - FillPolyAntialias(ADest, pts, fmAlternate, ABrush, true); - end; -end; - -class procedure TUniversalDrawer.FilterBlurRadial( - ASource: TCustomUniversalBitmap; const ABounds: TRect; radiusX, - radiusY: single; blurType: TRadialBlurType; ADest: TCustomUniversalBitmap); -begin - BGRAFilterBlur.FilterBlurRadial(ASource, ABounds, - radiusX,radiusY, blurType, ADest, nil); -end; - -class procedure TUniversalDrawer.FilterBlurMotion( - ASource: TCustomUniversalBitmap; const ABounds: TRect; - distance: single; angle: single; oriented: boolean; - ADest: TCustomUniversalBitmap); -begin - BGRAFilterBlur.FilterBlurMotion(ASource, ABounds, - distance, angle, oriented, ADest, nil); -end; - -class procedure TUniversalDrawer.FilterCustomBlur( - ASource: TCustomUniversalBitmap; const ABounds: TRect; - mask: TCustomUniversalBitmap; ADest: TCustomUniversalBitmap); -begin - BGRAFilterBlur.FilterBlurCustom(ASource, ABounds, - mask, ADest, nil); -end; - -initialization - - UniDrawerClass := TUniversalDrawer; - -end. diff --git a/components/bgrabitmap/unzipperext.pas b/components/bgrabitmap/unzipperext.pas deleted file mode 100644 index 1b1e67d..0000000 --- a/components/bgrabitmap/unzipperext.pas +++ /dev/null @@ -1,129 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit UnzipperExt; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, zipper; - -type - - { TUnzipperStreamUtf8 } - - TUnzipperStreamUtf8 = class(TUnZipper) - private - FCustomOutputStream: TStream; - FCustomInputStream: TStream; - procedure SetInputStream(AValue: TStream); - protected - Procedure CustomOpenInput(Sender: TObject; var AStream: TStream); - procedure CustomCloseInput(Sender: TObject; var AStream: TStream); - procedure CustomCreateOutput(Sender : TObject; var AStream : TStream; {%H-}AItem : TFullZipFileEntry); - procedure CustomCloseOutput(Sender : TObject; var AStream : TStream; {%H-}AItem : TFullZipFileEntry); - public - function UnzipFileToStream(AFilename: string; AStream: TStream; ACaseSensitive: boolean= true): boolean; - function UnzipFileToString(AFilename:string): string; - constructor Create; - property InputStream: TStream read FCustomInputStream write SetInputStream; - end; - -implementation - -uses BGRAUTF8; - -{ TUnzipperStreamUtf8 } - -procedure TUnzipperStreamUtf8.SetInputStream(AValue: TStream); -begin - if FCustomInputStream=AValue then Exit; - FCustomInputStream:=AValue; -end; - -procedure TUnzipperStreamUtf8.CustomOpenInput(Sender: TObject; var AStream: TStream); -begin - if Assigned(FCustomInputStream) then - AStream := FCustomInputStream - else - AStream := TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); -end; - -procedure TUnzipperStreamUtf8.CustomCloseInput(Sender: TObject; var AStream: TStream); -begin - if AStream = FCustomInputStream then - AStream := nil - else - FreeAndNil(AStream); -end; - -procedure TUnzipperStreamUtf8.CustomCreateOutput(Sender: TObject; - var AStream: TStream; AItem: TFullZipFileEntry); -begin - AStream := FCustomOutputStream; -end; - -procedure TUnzipperStreamUtf8.CustomCloseOutput(Sender: TObject; - var AStream: TStream; AItem: TFullZipFileEntry); -begin - AStream := nil; -end; - -function TUnzipperStreamUtf8.UnzipFileToStream(AFilename: string; AStream: TStream; - ACaseSensitive: boolean): boolean; -var - i: integer; - entryName: string; -begin - OpenInput; - AFilename := StringReplace(AFilename,'/','\',[rfReplaceAll]); - Try - ReadZipDirectory; - for i := 0 to Entries.count-1 do - begin - entryName := Entries.FullEntries[i].ArchiveFileName; - entryName:= StringReplace(entryName,'/','\',[rfReplaceAll]); - if (entryName = AFilename) or - (not ACaseSensitive and (CompareText(entryName,AFilename)=0)) then - begin - OnCreateStream := @CustomCreateOutput; - OnDoneStream := @CustomCloseOutput; - FCustomOutputStream := AStream; - UnZipOneFile(Entries.FullEntries[i]); - OnCreateStream := nil; - OnDoneStream := nil; - FCustomOutputStream := nil; - result := true; - exit; - end; - end; - Finally - CloseInput; - end; - result := false; -end; - -function TUnzipperStreamUtf8.UnzipFileToString(AFilename: string): string; -var mem: TMemoryStream; -begin - mem := TMemoryStream.Create; - try - UnzipFileToStream(AFilename,mem); - setlength(result,mem.Size); - mem.Position:= 0; - mem.Read(result[1], length(result)); - finally - mem.Free; - end; -end; - -constructor TUnzipperStreamUtf8.Create; -begin - inherited Create; - OnOpenInputStream := @CustomOpenInput; - OnCloseInputStream:= @CustomCloseInput; -end; - - -end. - diff --git a/components/bgrabitmap/uunittest.pas b/components/bgrabitmap/uunittest.pas deleted file mode 100644 index df2c3a8..0000000 --- a/components/bgrabitmap/uunittest.pas +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit UUnitTest; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes; - -implementation - -procedure Test(AExpression: boolean; ADescription: string); -begin - if not AExpression then - raise EAssertionFailed.Create('Assertion failed: '+ADescription); -end; - -var error: boolean; - -initialization - - Test(StrToBGRA('red ')=CSSRed,'ignore spaces'); - Test(StrToBGRA('red@')=BGRAPixelTransparent,'error fallback to transparent'); - Test(StrToBGRA('red@',CSSYellow)=CSSYellow,'error fallback to transparent'); - Test(StrToBGRA('rgb(255,0,0)')=CSSRed,'rgb format'); - Test(StrToBGRA('rgb(255,0,0,0.502)')=BGRA(255,0,0,128),'rgba format'); - Test(StrToBGRA('rgb(255,0,?)')=BGRAPixelTransparent,'missing as an error'); - Test(StrToBGRA('rgb(255,0,?)',CSSYellow)=CSSYellow,'missing as an error'); - Test(PartialStrToBGRA('rgb(255,?,?,?)',BGRA(128,128,128,128),error)=BGRA(255,128,128,128),'missing values replacement'); - Test(not error, 'missing is not an error'); - Test(PartialStrToBGRA('rgb(255,?,?)',BGRA(128,128,128,128),error)=BGRA(255,128,128,255),'implicit rgb alpha'); - Test(not error, 'missing is not an error'); - Test(PartialStrToBGRA('rgb(255,abc,0)',BGRA(128,128,128,128),error)=BGRA(255,0,0,255),'error replaced by 0 for rgb'); - Test(error, 'non numeric error'); - Test(PartialStrToBGRA('#ff????',BGRA(128,128,128,128),error)=BGRA(255,128,128,255),'missing values replacement'); - Test(not error, 'missing is not an error'); - Test(PartialStrToBGRA('#f??',BGRA(128,128,128,128),error)=BGRA(255,128,128,255),'missing values replacement'); - Test(not error, 'missing is not an error'); - Test(PartialStrToBGRA('#12??3456',BGRA(128,128,128,128),error)=BGRA($12,128,$34,$56),'html color with missing values'); - Test(not error, 'missing is not an error'); - Test(BGRAToStr(VGARed)='FF0000FF','Default color format'); - Test(BGRAToStr(BGRA(255,0,0), VGAColors)='Red','VGA color names'); - Test(BGRAToStr(BGRA(255,255,0), CSSColors)='Yellow','CSS color names'); - Test(BGRAToStr(BGRA(250,128,114), CSSColors)='Salmon','CSS color names'); -end. - diff --git a/components/bgrabitmap/vertex3d.inc b/components/bgrabitmap/vertex3d.inc deleted file mode 100644 index bff9fdf..0000000 --- a/components/bgrabitmap/vertex3d.inc +++ /dev/null @@ -1,457 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -type - { TBGRAObject3D } - - TBGRAObject3D = class(TInterfacedObject,IBGRAObject3D) - private - FColor: TBGRAPixel; - FLight: Single; - FTexture: IBGRAScanner; - FMainPart: IBGRAPart3D; - FFaces: array of IBGRAFace3D; - FFaceCount: integer; - FLightingNormal : TLightingNormal3D; - FParentLighting: boolean; - FMaterial: IBGRAMaterial3D; - FScene: TBGRAScene3D; - FFaceColorsInvalidated, - FMaterialInvalidated: boolean; - procedure AddFace(AFace: IBGRAFace3D); overload; - public - constructor Create(AScene: TBGRAScene3D); - destructor Destroy; override; - procedure Clear; - procedure InvalidateColor; - procedure InvalidateMaterial; - function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D; overload; - function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D; overload; - function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; - procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D); - function GetColor: TBGRAPixel; - function GetLight: Single; - function GetTexture: IBGRAScanner; - function GetMainPart: IBGRAPart3D; - function GetLightingNormal: TLightingNormal3D; - function GetParentLighting: boolean; - function GetFace(AIndex: integer): IBGRAFace3D; - function GetFaceCount: integer; - function GetTotalVertexCount: integer; - function GetTotalNormalCount: integer; - function GetMaterial: IBGRAMaterial3D; - procedure SetLightingNormal(const AValue: TLightingNormal3D); - procedure SetParentLighting(const AValue: boolean); - procedure SetColor(const AValue: TBGRAPixel); - procedure SetLight(const AValue: Single); - procedure SetTexture(const AValue: IBGRAScanner); - procedure SetMaterial(const AValue: IBGRAMaterial3D); - procedure RemoveUnusedVertices; - procedure SeparatePart(APart: IBGRAPart3D); - function GetScene: TObject; - function GetRefCount: integer; - procedure SetBiface(AValue : boolean); - procedure ForEachVertex(ACallback: TVertex3DCallback); - procedure ForEachFace(ACallback: TFace3DCallback); - procedure Update; - end; - - { TBGRAVertex3D } - - TBGRAVertex3D = class(TInterfacedObject,IBGRAVertex3D) - private - FColor: TBGRAPixel; - FParentColor: boolean; - FLight: Single; - FTexCoord: TPointF; - FCoordPool: TBGRACoordPool3D; - FCoordPoolIndex: integer; - FCustomFlags: LongWord; - FObject3D: TBGRAObject3D; - function GetCoordData: PBGRACoordData3D; - procedure Init(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); - public - constructor Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); overload; - constructor Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); overload; - destructor Destroy; override; - function GetColor: TBGRAPixel; - function GetLight: Single; - function GetViewNormal: TPoint3D; - function GetViewNormal_128: TPoint3D_128; - function GetCustomNormal: TPoint3D; - function GetCustomNormal_128: TPoint3D_128; - function GetSceneCoord: TPoint3D; - function GetSceneCoord_128: TPoint3D_128; - function GetTexCoord: TPointF; - function GetViewCoord: TPoint3D; - function GetViewCoord_128: TPoint3D_128; - function GetUsage: integer; - function GetCustomFlags: LongWord; - procedure SetColor(const AValue: TBGRAPixel); - procedure SetLight(const AValue: Single); - procedure SetViewNormal(const AValue: TPoint3D); - procedure SetViewNormal_128(const AValue: TPoint3D_128); - procedure SetCustomNormal(AValue: TPoint3D); - procedure SetCustomNormal_128(AValue: TPoint3D_128); - procedure NormalizeViewNormal; - procedure AddViewNormal(const AValue: TPoint3D_128); - procedure SetCustomFlags(AValue: LongWord); - procedure SetSceneCoord(const AValue: TPoint3D); - procedure SetSceneCoord_128(const AValue: TPoint3D_128); - procedure SetTexCoord(const AValue: TPointF); - procedure SetViewCoord(const AValue: TPoint3D); - procedure SetViewCoord_128(const AValue: TPoint3D_128); - function GetViewCoordZ: single; - function GetParentColor: Boolean; - procedure SetParentColor(const AValue: Boolean); - function GetProjectedCoord: TPointF; - procedure SetProjectedCoord(const AValue: TPointF); - procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D); - property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord; - property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128; - property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord; - property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128; - property ViewCoordZ: single read GetViewCoordZ; - property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord; - property TexCoord: TPointF read GetTexCoord write SetTexCoord; - property Color: TBGRAPixel read GetColor write SetColor; - property ParentColor: Boolean read GetParentColor write SetParentColor; - property Light: Single read GetLight write SetLight; - property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; - property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; - property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; - property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; - property Usage: integer read GetUsage; - property CoordData: PBGRACoordData3D read GetCoordData; - function GetAsObject: TObject; - end; - - { TBGRANormal3D } - - TBGRANormal3D = class(TInterfacedObject,IBGRANormal3D) - private - FPool: TBGRANormalPool3D; - FPoolIndex: integer; - function GetCustomNormal: TPoint3D; - function GetCustomNormal_128: TPoint3D_128; - function GetUsage: integer; - function GetViewNormal: TPoint3D; - function GetViewNormal_128: TPoint3D_128; - procedure SetCustomNormal(AValue: TPoint3D); - procedure SetCustomNormal_128(AValue: TPoint3D_128); - procedure SetViewNormal(AValue: TPoint3D); - procedure SetViewNormal_128(AValue: TPoint3D_128); - public - constructor Create(ANormalPool: TBGRANormalPool3D; ACustomNormal: TPoint3D); overload; - constructor Create(ANormalPool: TBGRANormalPool3D; ACustomNormal: TPoint3D_128); overload; - destructor Destroy; override; - property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal; - property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128; - property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal; - property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128; - property Usage: integer read GetUsage; - end; - -{ TBGRANormal3D } - -function TBGRANormal3D.GetCustomNormal: TPoint3D; -begin - result := Point3D((FPool.NormalData[FPoolIndex])^.customNormal); -end; - -function TBGRANormal3D.GetCustomNormal_128: TPoint3D_128; -begin - result := (FPool.NormalData[FPoolIndex])^.customNormal; -end; - -function TBGRANormal3D.GetUsage: integer; -begin - result := frefcount; -end; - -function TBGRANormal3D.GetViewNormal: TPoint3D; -begin - result := Point3D((FPool.NormalData[FPoolIndex])^.viewNormal); -end; - -function TBGRANormal3D.GetViewNormal_128: TPoint3D_128; -begin - result := (FPool.NormalData[FPoolIndex])^.viewNormal; -end; - -procedure TBGRANormal3D.SetCustomNormal(AValue: TPoint3D); -begin - (FPool.NormalData[FPoolIndex])^.customNormal := Point3D_128(AValue); -end; - -procedure TBGRANormal3D.SetCustomNormal_128(AValue: TPoint3D_128); -begin - (FPool.NormalData[FPoolIndex])^.customNormal := AValue; -end; - -procedure TBGRANormal3D.SetViewNormal(AValue: TPoint3D); -begin - (FPool.NormalData[FPoolIndex])^.viewNormal := Point3D_128(AValue); -end; - -procedure TBGRANormal3D.SetViewNormal_128(AValue: TPoint3D_128); -begin - (FPool.NormalData[FPoolIndex])^.viewNormal := AValue; -end; - -constructor TBGRANormal3D.Create(ANormalPool: TBGRANormalPool3D; - ACustomNormal: TPoint3D); -begin - FPool := ANormalPool; - FPoolIndex:= FPool.Add; - CustomNormal := ACustomNormal; -end; - -constructor TBGRANormal3D.Create(ANormalPool: TBGRANormalPool3D; - ACustomNormal: TPoint3D_128); -begin - FPool := ANormalPool; - FPoolIndex:= FPool.Add; - CustomNormal_128 := ACustomNormal; -end; - -destructor TBGRANormal3D.Destroy; -begin - FPool.Remove(FPoolIndex); - inherited Destroy; -end; - -{ TBGRAVertex3D } - -procedure TBGRAVertex3D.Init(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); -begin - FObject3D := AObject3D; - FCoordPool := ACoordPool; - FCoordPoolIndex := FCoordPool.Add; - FColor := BGRAWhite; - FParentColor := True; - FLight := 1; - SceneCoord_128 := ASceneCoord; -end; - -procedure TBGRAVertex3D.SetCustomNormal(AValue: TPoint3D); -begin - with FCoordPool.CoordData[FCoordPoolIndex]^ do - begin - customNormal := Point3D_128(AValue); - customNormalUsed := not CompareMem(@customNormal,@Point3D_128_Zero,sizeof(Point3D_128_Zero)); - end; -end; - -procedure TBGRAVertex3D.SetCustomNormal_128(AValue: TPoint3D_128); -begin - with FCoordPool.CoordData[FCoordPoolIndex]^ do - begin - customNormal := AValue; - customNormalUsed := not CompareMem(@customNormal,@Point3D_128_Zero,sizeof(Point3D_128_Zero)); - end; -end; - -function TBGRAVertex3D.GetCoordData: PBGRACoordData3D; -begin - result := FCoordPool.CoordData[FCoordPoolIndex]; -end; - -function TBGRAVertex3D.GetCustomNormal: TPoint3D; -begin - result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.customNormal); -end; - -function TBGRAVertex3D.GetCustomNormal_128: TPoint3D_128; -begin - result := FCoordPool.CoordData[FCoordPoolIndex]^.customNormal; -end; - -constructor TBGRAVertex3D.Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); -begin - Init(AObject3D, ACoordPool, Point3D_128(ASceneCoord)); -end; - -constructor TBGRAVertex3D.Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); -begin - Init(AObject3D, ACoordPool, ASceneCoord); -end; - -destructor TBGRAVertex3D.Destroy; -begin - FCoordPool.Remove(FCoordPoolIndex); - inherited Destroy; -end; - -function TBGRAVertex3D.GetColor: TBGRAPixel; -begin - result := FColor; -end; - -function TBGRAVertex3D.GetLight: Single; -begin - result := FLight; -end; - -function TBGRAVertex3D.GetViewNormal: TPoint3D; -begin - result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal); -end; - -function TBGRAVertex3D.GetViewNormal_128: TPoint3D_128; -begin - result := FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal; -end; - -function TBGRAVertex3D.GetSceneCoord: TPoint3D; -begin - result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord); -end; - -function TBGRAVertex3D.GetSceneCoord_128: TPoint3D_128; -begin - result := FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord; -end; - -function TBGRAVertex3D.GetTexCoord: TPointF; -begin - result := FTexCoord; -end; - -function TBGRAVertex3D.GetViewCoord: TPoint3D; -begin - result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord); -end; - -function TBGRAVertex3D.GetViewCoord_128: TPoint3D_128; -begin - result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord; -end; - -function TBGRAVertex3D.GetUsage: integer; -begin - result := frefcount; -end; - -function TBGRAVertex3D.GetCustomFlags: LongWord; -begin - result := FCustomFlags; -end; - -procedure TBGRAVertex3D.SetColor(const AValue: TBGRAPixel); -begin - FColor := AValue; - FParentColor := false; - FObject3D.InvalidateColor; -end; - -procedure TBGRAVertex3D.SetLight(const AValue: Single); -begin - FLight := AValue; -end; - -procedure TBGRAVertex3D.SetViewNormal(const AValue: TPoint3D); -begin - FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := Point3D_128(AValue); -end; - -procedure TBGRAVertex3D.SetViewNormal_128(const AValue: TPoint3D_128); -begin - FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := AValue; -end; - -procedure TBGRAVertex3D.SetSceneCoord(const AValue: TPoint3D); -begin - FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := Point3D_128(AValue); -end; - -procedure TBGRAVertex3D.SetSceneCoord_128(const AValue: TPoint3D_128); -begin - FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := AValue; -end; - -procedure TBGRAVertex3D.SetTexCoord(const AValue: TPointF); -begin - FTexCoord := AValue; -end; - -procedure TBGRAVertex3D.SetViewCoord(const AValue: TPoint3D); -begin - FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := Point3D_128(AValue); -end; - -procedure TBGRAVertex3D.SetViewCoord_128(const AValue: TPoint3D_128); -begin - FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := AValue; -end; - -function TBGRAVertex3D.GetViewCoordZ: single; -begin - result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord.Z; -end; - -function TBGRAVertex3D.GetParentColor: Boolean; -begin - result := FParentColor; -end; - -procedure TBGRAVertex3D.SetParentColor(const AValue: Boolean); -begin - FParentColor := AValue; - FObject3D.InvalidateColor; -end; - -function TBGRAVertex3D.GetProjectedCoord: TPointF; -begin - result := FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord; -end; - -procedure TBGRAVertex3D.SetProjectedCoord(const AValue: TPointF); -begin - FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord := AValue; -end; - -procedure TBGRAVertex3D.ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection : TProjection3D); -var P: PBGRACoordData3D; -begin - P := FCoordPool.CoordData[FCoordPoolIndex]; - with p^ do - begin - viewCoord := AMatrix*sceneCoord; - if customNormalUsed then - viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal) - else - ClearPoint3D_128(viewNormal); - if viewCoord.z > 0 then - begin - InvZ := 1/viewCoord.z; - projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x, - viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y); - end else - projectedCoord := PointF(0,0); - end; -end; - -function TBGRAVertex3D.GetAsObject: TObject; -begin - result := self; -end; - -procedure TBGRAVertex3D.NormalizeViewNormal; -begin - Normalize3D_128(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal); -end; - -procedure TBGRAVertex3D.AddViewNormal(const AValue: TPoint3D_128); -begin - with FCoordPool.CoordData[FCoordPoolIndex]^ do - if not customNormalUsed then - Add3D_Aligned(viewNormal, AValue); -end; - -procedure TBGRAVertex3D.SetCustomFlags(AValue: LongWord); -begin - FCustomFlags:= AValue; -end; - diff --git a/components/bgrabitmap/wordxyzabitmap.pas b/components/bgrabitmap/wordxyzabitmap.pas deleted file mode 100644 index 74aae80..0000000 --- a/components/bgrabitmap/wordxyzabitmap.pas +++ /dev/null @@ -1,777 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit WordXYZABitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; - -type - - { TWordXYZABitmap } - - TWordXYZABitmap = class(specialize TGenericUniversalBitmap) - protected - function InternalNew: TCustomUniversalBitmap; override; - procedure AssignTransparentPixel(out ADest); override; - public - class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TWordXYZA; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - procedure ReplaceImaginary(const AAfter: TWordXYZA); - end; - -const - WordXYZATransparent : TWordXYZA = (X:0; Y:0; Z:0; alpha:0); - -operator = (const c1, c2: TWordXYZA): boolean; inline; - -implementation - -uses XYZABitmap; - -operator = (const c1, c2: TWordXYZA): boolean; -begin - if (c1.alpha = 0) and (c2.alpha = 0) then - Result := True - else - Result := (c1.alpha = c2.alpha) and (c1.X = c2.X) and - (c1.Y = c2.Y) and (c1.Z = c2.Z); -end; - -procedure WordXYZASolidBrushSkipPixels({%H-}AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -begin - inc(PWordXYZA(AContextData^.Dest), ACount); -end; - -procedure WordXYZAChunkSetPixels( - ASource: PWordXYZA; ADest: PWordXYZA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; - finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + ((ASource^.alpha*alphaOver+32768) shr 16); - if finalAlpha <= 0 then ADest^ := WordXYZATransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.alpha:= finalAlpha; - ADest^.X := (ADest^.X*residualAlpha + - ASource^.X*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.Y := (ADest^.Y*residualAlpha + - ASource^.Y*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.Z := (ADest^.Z*residualAlpha + - ASource^.Z*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure WordXYZASolidBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PWordXYZA; -begin - pDest := PWordXYZA(AContextData^.Dest); - WordXYZAChunkSetPixels( PWordXYZA(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -procedure WordXYZAChunkDrawPixels( - ASource: PWordXYZA; ADest: PWordXYZA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver, srcAlphaOver, finalAlpha, finalAlphaDiv2, residualAlpha: UInt32or64; -begin - if AAlpha=0 then exit; - if AAlpha >= 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - srcAlphaOver := (ASource^.alpha*alphaOver+32768) shr 16; - if srcAlphaOver >= 65535 then - ADest^ := ASource^ - else - begin - if srcAlphaOver >= 32768 then inc(srcAlphaOver); - residualAlpha := (ADest^.alpha*UInt32or64(65536-srcAlphaOver)+32768) shr 16; - finalAlpha := residualAlpha + srcAlphaOver; - if finalAlpha <= 0 then ADest^ := WordXYZATransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - ADest^.alpha:= finalAlpha; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.X := (ADest^.X*residualAlpha + - ASource^.X*srcAlphaOver + finalAlphaDiv2) div finalAlpha; - ADest^.Y := (ADest^.Y*residualAlpha + - ASource^.Y*srcAlphaOver + finalAlphaDiv2) div finalAlpha; - ADest^.Z := (ADest^.Z*residualAlpha + - ASource^.Z*srcAlphaOver + finalAlphaDiv2) div finalAlpha; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; -end; - -procedure WordXYZASolidBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PWordXYZA; -begin - pDest := PWordXYZA(AContextData^.Dest); - WordXYZAChunkDrawPixels( PWordXYZA(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -procedure WordXYZAChunkXorPixels( - ASource: PWordXYZA; ADest: PWordXYZA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; - finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; - xored: TWordXYZA; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - PQWord(ADest)^ := PQWord(ADest)^ xor PQWord(ASource)^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - PQWord(@xored)^ := PQWord(ADest)^ xor PQWord(ASource)^; - residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + ((xored.alpha*alphaOver+32768) shr 16); - if finalAlpha <= 0 then ADest^ := WordXYZATransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.alpha:= finalAlpha; - ADest^.X := (ADest^.X*residualAlpha + - xored.X*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.Y := (ADest^.Y*residualAlpha + - xored.Y*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.Z := (ADest^.Z*residualAlpha + - xored.Z*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure WordXYZASolidBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PWordXYZA; -begin - pDest := PWordXYZA(AContextData^.Dest); - WordXYZAChunkXorPixels( PWordXYZA(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -type - PWordXYZAScannerBrushFixedData = ^TWordXYZAScannerBrushFixedData; - TWordXYZAScannerBrushFixedData = record - Scanner: Pointer; //avoid ref count by using pointer type - OffsetX, OffsetY: integer; - Conversion: TBridgedConversion; - end; - -procedure WordXYZAScannerBrushInitContext(AFixedData: Pointer; - AContextData: PUniBrushContext); -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, - AContextData^.Ofs.Y + OffsetY); -end; - -procedure WordXYZAScannerConvertBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PWordXYZA; - qty, pixSize: Integer; - buf: packed array[0..7] of TWordXYZA; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); - WordXYZAChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAScannerChunkBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PWordXYZA; - qty: Integer; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - WordXYZAChunkSetPixels(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAChunkSetPixelsExceptTransparent( - ASource: PWordXYZA; ADest: PWordXYZA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -var - alphaOver: UInt32or64; - finalAlpha, residualAlpha, finalAlphaDiv2: UInt32or64; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - if ASource^.alpha = 65535 then ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha; - while ACount > 0 do - begin - if ASource^.alpha = 65535 then - begin - residualAlpha := (ADest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + AAlpha; - if finalAlpha <= 0 then ADest^ := WordXYZATransparent else - begin - if finalAlpha > 65535 then finalAlpha := 65535; - finalAlphaDiv2 := finalAlpha shr 1; - ADest^.alpha:= finalAlpha; - ADest^.X := (ADest^.X*residualAlpha + - ASource^.X*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.Y := (ADest^.Y*residualAlpha + - ASource^.Y*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - ADest^.Z := (ADest^.Z*residualAlpha + - ASource^.Z*UInt32or64(finalAlpha-residualAlpha) + finalAlphaDiv2) div finalAlpha; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure WordXYZAScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PWordXYZA; - qty: Integer; - psrc: Pointer; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - WordXYZAChunkSetPixelsExceptTransparent(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PWordXYZA; - qty, pixSize: Integer; - buf: packed array[0..7] of TWordXYZA; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); - WordXYZAChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAScannerChunkBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - qty: Integer; - pDest: PWordXYZA; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - WordXYZAChunkDrawPixels(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAScannerConvertBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PWordXYZA; - qty, pixSize: Integer; - buf: packed array[0..7] of TWordXYZA; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); - WordXYZAChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAScannerChunkBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - qty: Integer; - pDest: PWordXYZA; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - WordXYZAChunkXorPixels(PWordXYZA(psrc), pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAScannerConvertBrushXorPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PWordXYZA; - qty, pixSize: Integer; - buf: packed array[0..7] of TWordXYZA; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TWordXYZA), nil); - WordXYZAChunkXorPixels(@buf, pDest, AAlpha, qty, sizeof(TWordXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure WordXYZAMaskBrushApply(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PWordXYZA; - qty, maskStride: Integer; - pMask: PByteMask; - factor: UInt32or64; -begin - with PWordXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - if AAlpha = 65535 then - begin - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - if pMask^.gray >= 128 then - pDest^.alpha := (pDest^.alpha*(pMask^.gray+1)) shr 8 - else pDest^.alpha := pDest^.alpha*pMask^.gray shr 8; - if pDest^.alpha = 0 then pDest^ := WordXYZATransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end else - begin - factor := AAlpha + (AAlpha shr 8) + (AAlpha shr 14); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.alpha := (pDest^.alpha*((factor*pMask^.gray+128) shr 8)) shr 16; - if pDest^.alpha = 0 then pDest^ := WordXYZATransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - end; - PWordXYZA(AContextData^.Dest) := pDest; - end; -end; - -procedure WordXYZAAlphaBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PWordXYZA; - alphaOver, residualAlpha, finalAlpha: UInt32or64; -begin - if AAlpha=0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - if AAlpha=65535 then - begin - finalAlpha := PWord(AFixedData)^; - while ACount > 0 do - begin - pDest^.alpha := finalAlpha; - inc(pDest); - dec(ACount); - end; - end else - begin - if AAlpha >= 32768 then alphaOver := AAlpha+1 - else alphaOver := AAlpha; - while ACount > 0 do - begin - residualAlpha := (pDest^.alpha*UInt32or64(65536-alphaOver)+32768) shr 16; - finalAlpha := residualAlpha + (PWord(AFixedData)^*alphaOver+32768) shr 16; - if finalAlpha > 65535 then finalAlpha := 65535; - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - end; - PWordXYZA(AContextData^.Dest) := pDest; -end; - -procedure WordXYZAAlphaBrushErasePixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PWordXYZA; - alphaMul, finalAlpha: UInt32or64; -begin - if AAlpha=0 then - begin - inc(PWordXYZA(AContextData^.Dest), ACount); - exit; - end; - pDest := PWordXYZA(AContextData^.Dest); - if AAlpha<>65535 then - alphaMul := 65535-((PWord(AFixedData)^*AAlpha+32767) div 65535) - else - alphaMul := 65535-PWord(AFixedData)^; - if alphaMul >= 32768 then inc(alphaMul); - while ACount > 0 do - begin - finalAlpha := (pDest^.alpha*alphaMul+32768) shr 16; - if finalAlpha <= 0 then pDest^ := WordXYZATransparent else - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - PWordXYZA(AContextData^.Dest) := pDest; -end; - -{ TWordXYZABitmap } - -function TWordXYZABitmap.InternalNew: TCustomUniversalBitmap; -begin - Result:= TWordXYZABitmap.Create; -end; - -procedure TWordXYZABitmap.AssignTransparentPixel(out ADest); -begin - TWordXYZA(ADest) := WordXYZATransparent; -end; - -class procedure TWordXYZABitmap.SolidBrush(out ABrush: TUniversalBrush; - const AColor: TWordXYZA; ADrawMode: TDrawMode); -begin - ABrush.Colorspace:= TWordXYZAColorspace; - PWordXYZA(@ABrush.FixedData)^ := AColor; - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSetPixels; - - dmSetExceptTransparent: - if AColor.alpha < 65535 then - ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSkipPixels - else - begin - ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSetPixels; - ABrush.DoesNothing := true; - end; - - dmDrawWithTransparency,dmLinearBlend: - if AColor.alpha<=0 then - begin - ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end - else if AColor.alpha>=1 then - ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSetPixels - else - ABrush.InternalPutNextPixels:= @WordXYZASolidBrushDrawPixels; - - dmXor: if PQWord(@AColor)^ = 0 then - begin - ABrush.InternalPutNextPixels:= @WordXYZASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end else - ABrush.InternalPutNextPixels:= @WordXYZASolidBrushXorPixels; - end; -end; - -class procedure TWordXYZABitmap.ScannerBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; ADrawMode: TDrawMode; - AOffsetX: integer; AOffsetY: integer); -var - sourceSpace: TColorspaceAny; -begin - ABrush.Colorspace:= TWordXYZAColorspace; - with PWordXYZAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @WordXYZAScannerBrushInitContext; - sourceSpace := AScanner.GetScanCustomColorspace; - if sourceSpace = TWordXYZAColorspace then - begin - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushDrawPixels; - dmXor: ABrush.InternalPutNextPixels:= @WordXYZAScannerChunkBrushXorPixels; - end; - end else - begin - with PWordXYZAScannerBrushFixedData(@ABrush.FixedData)^ do - Conversion := sourceSpace.GetBridgedConversion(TWordXYZAColorspace); - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushDrawPixels; - dmXor: ABrush.InternalPutNextPixels:= @WordXYZAScannerConvertBrushXorPixels; - end; - end; -end; - -class procedure TWordXYZABitmap.MaskBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); -begin - ABrush.Colorspace:= TWordXYZAColorspace; - with PWordXYZAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @WordXYZAScannerBrushInitContext; - ABrush.InternalPutNextPixels:= @WordXYZAMaskBrushApply; -end; - -class procedure TWordXYZABitmap.EraseBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, WordXYZATransparent, dmDrawWithTransparency); - exit; - end; - ABrush.Colorspace:= TWordXYZAColorspace; - PWord(@ABrush.FixedData)^ := AAlpha; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @WordXYZAAlphaBrushErasePixels; -end; - -class procedure TWordXYZABitmap.AlphaBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, WordXYZATransparent, dmSet); - exit; - end; - ABrush.Colorspace:= TWordXYZAColorspace; - PWord(@ABrush.FixedData)^ := AAlpha; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @WordXYZAAlphaBrushSetPixels; -end; - -procedure TWordXYZABitmap.ReplaceImaginary(const AAfter: TWordXYZA); -var - p: PWordXYZA; - n: integer; -begin - p := Data; - for n := NbPixels - 1 downto 0 do - begin - if (p^.alpha>0) and not IsRealColor(p^) then p^ := AAfter; - Inc(p); - end; - InvalidateBitmap; -end; - -end. - diff --git a/components/bgrabitmap/xyzabitmap.pas b/components/bgrabitmap/xyzabitmap.pas deleted file mode 100644 index 8dc2a4f..0000000 --- a/components/bgrabitmap/xyzabitmap.pas +++ /dev/null @@ -1,673 +0,0 @@ -// SPDX-License-Identifier: LGPL-3.0-linking-exception -unit XYZABitmap; - -{$mode objfpc}{$H+} - -interface - -uses - BGRAClasses, SysUtils, BGRABitmapTypes, UniversalDrawer; - -type - - { TXYZABitmap } - - TXYZABitmap = class(specialize TGenericUniversalBitmap) - protected - function InternalNew: TCustomUniversalBitmap; override; - procedure AssignTransparentPixel(out ADest); override; - public - class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TXYZA; ADrawMode: TDrawMode = dmDrawWithTransparency); override; - class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; - AOffsetX: integer = 0; AOffsetY: integer = 0); override; - class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override; - procedure ReplaceImaginary(const AAfter: TXYZA); - end; - -const - XYZATransparent : TXYZA = (X:0; Y:0; Z:0; alpha:0); - -operator = (const c1, c2: TXYZA): boolean; inline; -function IsRealColor(xyza: TXYZA): boolean; - -implementation - -uses BGRAFillInfo; - -operator = (const c1, c2: TXYZA): boolean; -begin - if (c1.alpha = 0) and (c2.alpha = 0) then - Result := True - else - Result := (c1.alpha = c2.alpha) and (c1.X = c2.X) and - (c1.Y = c2.Y) and (c1.Z = c2.Z); -end; - -var - xyHorseshoePolygon: TFillShapeInfo; - -procedure MakeXYHorseshoePolygon; -var - pts: array of TPointF; - i: Integer; - n: Single; -begin - setlength(pts, length(SpectralLocus)); - for i := 0 to high(pts) do - begin - n := SpectralLocus[i].X+SpectralLocus[i].Y+SpectralLocus[i].Z; - pts[i].x := SpectralLocus[i].X/n; - pts[i].y := SpectralLocus[i].Y/n; - end; - xyHorseshoePolygon := TFillPolyInfo.Create(pts, false); - pts := nil; -end; - -function IsRealColor(xyza: TXYZA): boolean; -const dim = 0.015; -var - n: Single; -begin - xyza.ChromaticAdapt(GetReferenceWhiteIndirect^, ReferenceWhite2E); - if (xyza.Y < 0) or (xyza.Y > 1) or (xyza.X < 0) or (xyza.Z < 0) then exit(false); - if (xyza.Y = 0) then exit((xyza.X=0) and (xyza.Z=0)); - if xyHorseshoePolygon = nil then MakeXYHorseshoePolygon; - n := xyza.X + xyza.Y + xyza.Z; - result := xyHorseshoePolygon.IsPointInside(xyza.X/n*(1-dim)+1/3*dim, xyza.Y/n*(1-dim)+1/3*dim, false); -end; - -procedure XYZASolidBrushSkipPixels({%H-}AFixedData: Pointer; - AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer); -begin - inc(PXYZA(AContextData^.Dest), ACount); -end; - -procedure XYZAChunkSetPixels( - ASource: PXYZA; ADest: PXYZA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -const oneOver65535 = 1/65535; -var - alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - residualAlpha := ADest^.alpha*(1-alphaOver); - finalAlpha := residualAlpha + ASource^.alpha*alphaOver; - if finalAlpha <= 0 then ADest^ := XYZATransparent else - begin - if finalAlpha > 1 then finalAlpha := 1; - ADest^.alpha:= finalAlpha; - finalAlphaInv := 1/finalAlpha; - ADest^.X := (ADest^.X*residualAlpha + - ASource^.X*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.Y := (ADest^.Y*residualAlpha + - ASource^.Y*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.Z := (ADest^.Z*residualAlpha + - ASource^.Z*(finalAlpha-residualAlpha) ) * finalAlphaInv; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure XYZASolidBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PXYZA; -begin - pDest := PXYZA(AContextData^.Dest); - XYZAChunkSetPixels( PXYZA(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -procedure XYZAChunkDrawPixels( - ASource: PXYZA; ADest: PXYZA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -const oneOver65535 = 1/65535; -var - alphaOver, srcAlphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; -begin - if AAlpha=0 then exit; - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - srcAlphaOver := ASource^.alpha*alphaOver; - if srcAlphaOver >= 1 then - ADest^ := ASource^ - else - begin - residualAlpha := ADest^.alpha*(1-srcAlphaOver); - finalAlpha := residualAlpha + srcAlphaOver; - if finalAlpha <= 0 then ADest^ := XYZATransparent else - begin - if finalAlpha > 1 then finalAlpha := 1; - ADest^.alpha:= finalAlpha; - finalAlphaInv := 1/finalAlpha; - ADest^.X := (ADest^.X*residualAlpha + - ASource^.X*srcAlphaOver ) * finalAlphaInv; - ADest^.Y := (ADest^.Y*residualAlpha + - ASource^.Y*srcAlphaOver ) * finalAlphaInv; - ADest^.Z := (ADest^.Z*residualAlpha + - ASource^.Z*srcAlphaOver ) * finalAlphaInv; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; -end; - -procedure XYZASolidBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PXYZA; -begin - pDest := PXYZA(AContextData^.Dest); - XYZAChunkDrawPixels( PXYZA(AFixedData), pDest, AAlpha, ACount, 0); - inc(pDest, ACount); - AContextData^.Dest := pDest; -end; - -type - PXYZAScannerBrushFixedData = ^TXYZAScannerBrushFixedData; - TXYZAScannerBrushFixedData = record - Scanner: Pointer; //avoid ref count by using pointer type - OffsetX, OffsetY: integer; - Conversion: TBridgedConversion; - end; - -procedure XYZAScannerBrushInitContext(AFixedData: Pointer; - AContextData: PUniBrushContext); -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX, - AContextData^.Ofs.Y + OffsetY); -end; - -procedure XYZAScannerConvertBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PXYZA; - qty, pixSize: Integer; - buf: packed array[0..7] of TXYZA; -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TXYZA), nil); - XYZAChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure XYZAScannerChunkBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PXYZA; - qty: Integer; -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - XYZAChunkSetPixels(PXYZA(psrc), pDest, AAlpha, qty, sizeof(TXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure XYZAChunkSetPixelsExceptTransparent( - ASource: PXYZA; ADest: PXYZA; - AAlpha: Word; ACount: integer; ASourceStride: integer); inline; -const oneOver65535 = 1/65535; -var - alphaOver, finalAlpha, finalAlphaInv, residualAlpha: single; -begin - if AAlpha=0 then exit; - if AAlpha=65535 then - begin - while ACount > 0 do - begin - if ASource^.alpha >= 1 then - ADest^ := ASource^; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end else - begin - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - if ASource^.alpha >= 1 then - begin - residualAlpha := ADest^.alpha*(1-alphaOver); - finalAlpha := residualAlpha + alphaOver; - if finalAlpha <= 0 then ADest^ := XYZATransparent else - begin - ADest^.alpha:= finalAlpha; - finalAlphaInv := 1/finalAlpha; - ADest^.X := (ADest^.X*residualAlpha + - ASource^.X*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.Y := (ADest^.Y*residualAlpha + - ASource^.Y*(finalAlpha-residualAlpha) ) * finalAlphaInv; - ADest^.Z := (ADest^.Z*residualAlpha + - ASource^.Z*(finalAlpha-residualAlpha) ) * finalAlphaInv; - end; - end; - inc(ADest); - dec(ACount); - inc(PByte(ASource), ASourceStride); - end; - end; -end; - -procedure XYZAScannerChunkBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PXYZA; - qty: Integer; - psrc: Pointer; -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - XYZAChunkSetPixelsExceptTransparent(PXYZA(psrc), pDest, AAlpha, qty, sizeof(TXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure XYZAScannerConvertBrushSetPixelsExceptTransparent(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PXYZA; - qty, pixSize: Integer; - buf: packed array[0..7] of TXYZA; -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TXYZA), nil); - XYZAChunkSetPixelsExceptTransparent(@buf, pDest, AAlpha, qty, sizeof(TXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure XYZAScannerChunkBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - qty: Integer; - pDest: PXYZA; -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - XYZAChunkDrawPixels(PXYZA(psrc), pDest, AAlpha, qty, sizeof(TXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure XYZAScannerConvertBrushDrawPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - psrc: Pointer; - pDest: PXYZA; - qty, pixSize: Integer; - buf: packed array[0..7] of TXYZA; -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize; - while ACount > 0 do - begin - if ACount > length(buf) then qty := length(buf) else qty := ACount; - IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc); - Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TXYZA), nil); - XYZAChunkDrawPixels(@buf, pDest, AAlpha, qty, sizeof(TXYZA) ); - inc(pDest, qty); - dec(ACount, qty); - end; - AContextData^.Dest := pDest; - end; -end; - -procedure XYZAMaskBrushApply(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -var - pDest: PXYZA; - qty, maskStride: Integer; - pMask: PByteMask; - factor: single; -begin - with PXYZAScannerBrushFixedData(AFixedData)^ do - begin - if AAlpha = 0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - IBGRAScanner(Scanner).ScanSkipPixels(ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - factor := AAlpha/(65535*255); - while ACount > 0 do - begin - qty := ACount; - IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride); - dec(ACount,qty); - while qty > 0 do - begin - pDest^.alpha := pDest^.alpha*pMask^.gray*factor; - if pDest^.alpha = 0 then pDest^ := XYZATransparent; - inc(pDest); - inc(pMask, maskStride); - dec(qty); - end; - end; - PXYZA(AContextData^.Dest) := pDest; - end; -end; - -procedure XYZAAlphaBrushSetPixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -const oneOver65535 = 1/65535; -var - pDest: PXYZA; - alphaOver, residualAlpha, finalAlpha: single; -begin - if AAlpha=0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - if AAlpha=65535 then - begin - finalAlpha := PSingle(AFixedData)^; - while ACount > 0 do - begin - pDest^.alpha := finalAlpha; - inc(pDest); - dec(ACount); - end; - end else - begin - alphaOver := AAlpha*single(oneOver65535); - while ACount > 0 do - begin - residualAlpha := pDest^.alpha*(1-alphaOver); - finalAlpha := residualAlpha + PSingle(AFixedData)^*alphaOver; - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - end; - PXYZA(AContextData^.Dest) := pDest; -end; - -procedure XYZAAlphaBrushErasePixels(AFixedData: Pointer; - AContextData: PUniBrushContext; AAlpha: Word; ACount: integer); -const oneOver65535 = 1/65535; -var - pDest: PXYZA; - alphaMul, finalAlpha: single; -begin - if AAlpha=0 then - begin - inc(PXYZA(AContextData^.Dest), ACount); - exit; - end; - pDest := PXYZA(AContextData^.Dest); - if AAlpha<>65535 then - alphaMul := 1-PSingle(AFixedData)^*AAlpha*single(oneOver65535) - else - alphaMul := 1-PSingle(AFixedData)^; - while ACount > 0 do - begin - finalAlpha := pDest^.alpha*alphaMul; - if finalAlpha <= 0 then pDest^ := XYZATransparent else - pDest^.alpha:= finalAlpha; - inc(pDest); - dec(ACount); - end; - PXYZA(AContextData^.Dest) := pDest; -end; - -{ TXYZABitmap } - -function TXYZABitmap.InternalNew: TCustomUniversalBitmap; -begin - Result:= TXYZABitmap.Create; -end; - -procedure TXYZABitmap.AssignTransparentPixel(out ADest); -begin - TXYZA(ADest) := XYZATransparent; -end; - -class procedure TXYZABitmap.SolidBrush(out ABrush: TUniversalBrush; - const AColor: TXYZA; ADrawMode: TDrawMode); -begin - ABrush.Colorspace:= TXYZAColorspace; - PXYZA(@ABrush.FixedData)^ := AColor; - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @XYZASolidBrushSetPixels; - - dmSetExceptTransparent: - if AColor.alpha < 1 then - ABrush.InternalPutNextPixels:= @XYZASolidBrushSkipPixels - else - begin - ABrush.InternalPutNextPixels:= @XYZASolidBrushSetPixels; - ABrush.DoesNothing := true; - end; - - dmDrawWithTransparency,dmLinearBlend: - if AColor.alpha<=0 then - begin - ABrush.InternalPutNextPixels:= @XYZASolidBrushSkipPixels; - ABrush.DoesNothing := true; - end - else if AColor.alpha>=1 then - ABrush.InternalPutNextPixels:= @XYZASolidBrushSetPixels - else - ABrush.InternalPutNextPixels:= @XYZASolidBrushDrawPixels; - - dmXor: raise exception.Create('Xor mode not available with floating point values'); - end; -end; - -class procedure TXYZABitmap.ScannerBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; ADrawMode: TDrawMode; - AOffsetX: integer; AOffsetY: integer); -var - sourceSpace: TColorspaceAny; -begin - ABrush.Colorspace:= TXYZAColorspace; - with PXYZAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @XYZAScannerBrushInitContext; - sourceSpace := AScanner.GetScanCustomColorspace; - if sourceSpace = TXYZAColorspace then - begin - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @XYZAScannerChunkBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @XYZAScannerChunkBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @XYZAScannerChunkBrushDrawPixels; - dmXor: raise exception.Create('Xor mode not available with floating point values'); - end; - end else - begin - with PXYZAScannerBrushFixedData(@ABrush.FixedData)^ do - Conversion := sourceSpace.GetBridgedConversion(TXYZAColorspace); - case ADrawMode of - dmSet: ABrush.InternalPutNextPixels:= @XYZAScannerConvertBrushSetPixels; - dmSetExceptTransparent: ABrush.InternalPutNextPixels:= @XYZAScannerConvertBrushSetPixelsExceptTransparent; - dmDrawWithTransparency,dmLinearBlend: - ABrush.InternalPutNextPixels:= @XYZAScannerConvertBrushDrawPixels; - dmXor: raise exception.Create('Xor mode not available with floating point values'); - end; - end; -end; - -class procedure TXYZABitmap.MaskBrush(out ABrush: TUniversalBrush; - AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer); -begin - ABrush.Colorspace:= TXYZAColorspace; - with PXYZAScannerBrushFixedData(@ABrush.FixedData)^ do - begin - Scanner := Pointer(AScanner); - OffsetX := AOffsetX; - OffsetY := AOffsetY; - end; - ABrush.InternalInitContext:= @XYZAScannerBrushInitContext; - ABrush.InternalPutNextPixels:= @XYZAMaskBrushApply; -end; - -class procedure TXYZABitmap.EraseBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, XYZATransparent, dmDrawWithTransparency); - exit; - end; - ABrush.Colorspace:= TXYZAColorspace; - PSingle(@ABrush.FixedData)^ := AAlpha/65535; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @XYZAAlphaBrushErasePixels; -end; - -class procedure TXYZABitmap.AlphaBrush(out ABrush: TUniversalBrush; - AAlpha: Word); -begin - if AAlpha = 0 then - begin - SolidBrush(ABrush, XYZATransparent, dmSet); - exit; - end; - ABrush.Colorspace:= TXYZAColorspace; - PSingle(@ABrush.FixedData)^ := AAlpha/65535; - ABrush.InternalInitContext:= nil; - ABrush.InternalPutNextPixels:= @XYZAAlphaBrushSetPixels; -end; - -procedure TXYZABitmap.ReplaceImaginary(const AAfter: TXYZA); -var - p: PXYZA; - n: integer; -begin - p := Data; - for n := NbPixels - 1 downto 0 do - begin - if (p^.alpha>0) and not IsRealColor(p^) then p^ := AAfter; - Inc(p); - end; - InvalidateBitmap; -end; - -finalization - - xyHorseshoePolygon.Free; - -end. - diff --git a/components/dexif b/components/dexif deleted file mode 160000 index 2c069a1..0000000 --- a/components/dexif +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 2c069a1b39db7e835852ad899c2200e604e0c41f diff --git a/components/vampireimaging/Demos/Data/Icon.png b/components/vampireimaging/Demos/Data/Icon.png deleted file mode 100644 index c7d2898..0000000 Binary files a/components/vampireimaging/Demos/Data/Icon.png and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Imaging.ico b/components/vampireimaging/Demos/Data/Imaging.ico deleted file mode 100644 index c886676..0000000 Binary files a/components/vampireimaging/Demos/Data/Imaging.ico and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Irbis.xpm b/components/vampireimaging/Demos/Data/Irbis.xpm deleted file mode 100644 index 54dbacd..0000000 --- a/components/vampireimaging/Demos/Data/Irbis.xpm +++ /dev/null @@ -1,331 +0,0 @@ -/* XPM */ -static char *Pixmap[] = { -"64 71 256 3", -"000 c #18180B", -"001 c #1C1E11", -"002 c #1C2313", -"003 c #262817", -"004 c #2B321C", -"005 c #32341D", -"006 c #2D3623", -"007 c #353A25", -"008 c #3B452C", -"009 c #3C4633", -"010 c #3F5036", -"011 c #444729", -"012 c #454D32", -"013 c #4A512B", -"014 c #495538", -"015 c #52522D", -"016 c #525434", -"017 c #55563A", -"018 c #545935", -"019 c #535C3B", -"020 c #585A32", -"021 c #595D3B", -"022 c #4E603C", -"023 c #5B623A", -"024 c #654B2B", -"025 c #605937", -"026 c #735E36", -"027 c #646639", -"028 c #746239", -"029 c #72733E", -"030 c #495842", -"031 c #545C42", -"032 c #4F6348", -"033 c #596548", -"034 c #5C6A52", -"035 c #636543", -"036 c #61664D", -"037 c #636B44", -"038 c #636B4C", -"039 c #6B6C44", -"040 c #6B6B4A", -"041 c #636C53", -"042 c #6B714A", -"043 c #697458", -"044 c #766E41", -"045 c #767749", -"046 c #727552", -"047 c #71765C", -"048 c #737954", -"049 c #747B5C", -"050 c #7B7C54", -"051 c #7B7E5B", -"052 c #6C7862", -"053 c #737D64", -"054 c #7C815A", -"055 c #7A8468", -"056 c #7D8873", -"057 c #886D3E", -"058 c #8A7F4A", -"059 c #817B52", -"060 c #957746", -"061 c #84804B", -"062 c #828253", -"063 c #83845B", -"064 c #868A5C", -"065 c #8A8551", -"066 c #888658", -"067 c #8B8C56", -"068 c #8B8A5B", -"069 c #928E5A", -"070 c #96925C", -"071 c #828563", -"072 c #80856B", -"073 c #858964", -"074 c #848A6B", -"075 c #888665", -"076 c #8A8C63", -"077 c #8A8D6B", -"078 c #858C74", -"079 c #8C9169", -"080 c #879071", -"081 c #85917A", -"082 c #8B9273", -"083 c #8C937B", -"084 c #8D987F", -"085 c #908E60", -"086 c #908F73", -"087 c #969569", -"088 c #939573", -"089 c #91957B", -"090 c #959973", -"091 c #959A7B", -"092 c #9C9773", -"093 c #9B9B73", -"094 c #9B9C7B", -"095 c #9EA16F", -"096 c #9DA17A", -"097 c #A29C65", -"098 c #A29D6B", -"099 c #A99B6F", -"100 c #A19C74", -"101 c #A19E7C", -"102 c #A99B73", -"103 c #A6A26C", -"104 c #A3A273", -"105 c #A3A37B", -"106 c #A4A87E", -"107 c #AAA572", -"108 c #A9A47A", -"109 c #AAA974", -"110 c #ABAA7B", -"111 c #B0A86E", -"112 c #B2AB76", -"113 c #B8B27A", -"114 c #C4BA7C", -"115 c #8C9682", -"116 c #959B83", -"117 c #95A085", -"118 c #96A08A", -"119 c #9CA183", -"120 c #9CA28A", -"121 c #9DA887", -"122 c #9EA88A", -"123 c #9CA592", -"124 c #A2A583", -"125 c #A2A58B", -"126 c #A5A983", -"127 c #A5A98A", -"128 c #A9A583", -"129 c #ABAB83", -"130 c #AAAC8B", -"131 c #A6AC94", -"132 c #AEB186", -"133 c #ADB18C", -"134 c #ACB197", -"135 c #B0A781", -"136 c #B1AD82", -"137 c #B1AE8A", -"138 c #B2AF90", -"139 c #B3B183", -"140 c #B3B38B", -"141 c #B6B88D", -"142 c #BAB582", -"143 c #B9B68B", -"144 c #BDBA85", -"145 c #BCBA8C", -"146 c #B3B493", -"147 c #B2B59A", -"148 c #B5B992", -"149 c #B5B99B", -"150 c #BAB592", -"151 c #B9B59B", -"152 c #BBBA93", -"153 c #BBBC9B", -"154 c #ADB4A0", -"155 c #B7BBA4", -"156 c #BDBFB2", -"157 c #BCC095", -"158 c #BEC19C", -"159 c #BDC1A7", -"160 c #BDC4B3", -"161 c #C4BD87", -"162 c #C2BE95", -"163 c #C1BEA3", -"164 c #CAC389", -"165 c #C6C498", -"166 c #D6C98A", -"167 c #D5CC96", -"168 c #DBD18C", -"169 c #DAD298", -"170 c #C3C4A3", -"171 c #C3C4AB", -"172 c #C6C9A2", -"173 c #C5C9AB", -"174 c #C9C5A3", -"175 c #C8C5AB", -"176 c #CCCAA4", -"177 c #CBCBAB", -"178 c #C2C5B1", -"179 c #C4C8B2", -"180 c #C2C9B8", -"181 c #C8C6B3", -"182 c #CACCB3", -"183 c #CACDBA", -"184 c #CDD0A9", -"185 c #CDD0B4", -"186 c #CDD1BA", -"187 c #D2CDA4", -"188 c #D0CDB3", -"189 c #D3D1A3", -"190 c #D4D1AC", -"191 c #DBD5A3", -"192 c #DAD5AB", -"193 c #DDD8A2", -"194 c #DCD9AC", -"195 c #D2D2B4", -"196 c #D2D4BB", -"197 c #D6D8B4", -"198 c #D5D8BC", -"199 c #DAD5B4", -"200 c #D9D5BB", -"201 c #DCDAB4", -"202 c #DCDABB", -"203 c #E0CE91", -"204 c #E4D58E", -"205 c #E3D699", -"206 c #E5DBA5", -"207 c #E2DDB4", -"208 c #EBE09F", -"209 c #EBE1AB", -"210 c #E9E4B6", -"211 c #F3E6AB", -"212 c #F5EBB7", -"213 c #F9F1BC", -"214 c #C9CFC1", -"215 c #CFD2C1", -"216 c #D2D5C1", -"217 c #D5D9C3", -"218 c #D7D8CC", -"219 c #D8D6C2", -"220 c #DBDCC4", -"221 c #DBDDCB", -"222 c #DDE0C8", -"223 c #DFE2D2", -"224 c #E4DCC3", -"225 c #E4E3C3", -"226 c #E4E3CC", -"227 c #E9E5C2", -"228 c #EBE5CA", -"229 c #EAE9C3", -"230 c #EDEBCB", -"231 c #E2E4D4", -"232 c #E5E8D9", -"233 c #E8E7D2", -"234 c #EDECD3", -"235 c #E9EBDC", -"236 c #EFF0CF", -"237 c #EDF1DD", -"238 c #F2EBC3", -"239 c #F0EED6", -"240 c #F8F2C5", -"241 c #F3F2D2", -"242 c #F5F4DA", -"243 c #F7F8D3", -"244 c #F8F6D5", -"245 c #F8F7D8", -"246 c #FBF9D3", -"247 c #FBFADC", -"248 c #ECEDE1", -"249 c #EEF0E2", -"250 c #F8F6E2", -"251 c #FDFDE3", -"252 c #FEFEE8", -"253 c none", -"254 c black", -"255 c black", -"253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253101253253253253253253253253253253253253", -"253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253035088152174091253253253253253253253253253253", -"253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253088071018126197234127040253253253253253253253253253", -"253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253173153077050129202242182124253253253253253253253253253", -"253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253147220220153076063137202250237149253253253253253253253253253", -"253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253101124185196149082071073132227242182074253253253253253253253253253", -"253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253253152177173170127082049076095190228241195122253253253253253253253253253", -"253253253253253253253253253253253253253253253253253253253253253253253253253099102102102101100092092094101174150137086086130182184158148094054040076103199229241229091253253253253253253253253253", -"253253253253022022073088253253253253253253253253253253253253253253253253093071101083078120115089078131134181131052034014030149177158157096043023097145207229244228129253253253253253253253253253", -"253253253253038033074147159149100069058253253253253253253253253253253081056034118043053131056052083154154159116055055122091170184145141093037090161187207229241230130253253253253253253253253253", -"253253253253049089155226237235215124076061045253253253253055081123154056052081154080123078030030032009034115049047119159170184174143136079043100189194210230241236158253253253253253253253253253", -"253253253055051121182222220222179179155131073042055074116032030115160160131123134083154154155155123030010056033003006048127132050106093079046157190201207230236242177253253253253253253253253253", -"253253253055048124153184173173159158159131041030052034055081154123081131123080043014115055052115155056052123056047072096133140087087076079136157158190201230234241195158148177253253253253253253", -"253253253073051071106158158157149149134055033081043052160134123032030052116078034041154081034032118154118159155074009037124093079064045104096105141190202225230241242242242182253253253253253253", -"253253253094054050073148140127133154056008008081043056034052034055115115047053030034118081081120154131031081147038082047088090095054062064076076132184197227230245247230170253253253253253253253", -"253253253163063073046079094091130121036030053055131056034053055041118154052056034056131154134154155134118082127036055130090054129110090093076090106165201229230241245165058253253253253253253253", -"253253165177130101071053088082133119080083081084120056118081034032115123055041056052030056081030030053131154149086031119133129133141132105090104143167194201210229236143065253253253253253253253", -"253253177188163125042022046073077071084119055053034030084053056120083083052043123155154180183118123154155091120134121077119126124132140096090105139142109145194229236172135253253253253253253253", -"253253174182173146088033037080046074043047043078043056154154154043034055053031041160183215155115116183155179131134147091086071077096126106141140095076110189207230236172128253253253253253253253", -"253253158196159127082042054091049055022033033032030115155154043055053041055056115154159156053009030033078186185196183146091148132126124090106157172145164189225227210176152253253253253253253253", -"253253182186171096055080091083043049053117131043052134155131154083041031034053123134083008056116131041008121220226196186170124133094106079096172176132165190197194210210230225253253253253253253", -"253231221216149116082091084049038081154084052032032034083134047034055081043043131155047043131171179185122051119198220198233184093146148096073129172172184202230229229229243241197253253253253253", -"253253196178134119083055049022049160056010043154081008056154134115072116118053155155030159173170190170226146048126196173155220185184174158093096157184185198229225194191229241225170253253253253", -"253253253253127120116056037043154118055159179159155134155159159155120116089134178091072186190190152055195185146124163163041120222198195170148096096157184185202197192194229240197162165253253253", -"253253253253077125134055033131118055183198155171179196043130178091047036047072125012131190202190086051124195185184177127038031131185202197158105079143189189176190189191207229201174162253253253", -"253253253253080131116041074180160155186124146177181170012121155043037038119033086011153195190194051040079202190187158043031074043134185190184132136110164191192189194207207227190148152253253253", -"253253253091131123072049084155178218127082133170158146011116047071082051055054041017170165165189046016086199187162087037124216133043131082172129105095164167193193194209206210210202162145253253", -"253253253083134123053056115131147186074048126145105140088133043073091048014094035041140165162165100015087176190152079105177226220090153082130157157162165169169193209209206209238243227145145253", -"253253253091155116081041056124147182073042088136136136050071091079105040033021046101141145145142098023063141165176150172174195202130124158163133148187165191191206209209209205211243246194135135", -"253253253120155083115052043082148134046023096139109096016043019047091048046051021104142113113113097027050105148158141132105152148133130153197148140157176189193193209211210206211240251242172100", -"253253253134155055081081032077127130049027073096087085087019051126094054051077076059097103103098097068063064093124106092079042071104016031173158148064076167193193193209209209193212246252230093", -"253253253131118047053118053082088091082035079085068062045011096124090054051054039050045069103110165063011004007053042013004051132174162157158172158121050161193169167169209209169193240251236095", -"253253253147120053043055078080119122082037011042029027029042064096088094079088068045044085143190174007042011012063067007009174076148153202049096157176189189167167168205206211209209238251251184", -"253253253147134055052041043071047048021004005013039020023027085079126094130126100066050070192227133002045050054085029003127132040073119177117033093165172141087114168168204209212213213247252241", -"253253090155155053049033041038001039011000006003071051062050062076119126130138129100085104207202077003003035042015004089090088085037054054147034036140157076045164167203205209212213212245251245", -"253253088153155115034078077149009015029018011005031091045059063088124086124133153165137135190207085016006010017047136105073108141090133091146091010071132031062161164166203209209209212238251247", -"253253100178156083043043014093122007011013011000005077042042094127127074091149163158174150165207106129125186200175141126140165165172192176158157049019132085054068061070164205209169193213247251", -"253253094181131041030038046054093125053030009007008050050055091146134094127163175157126146172192139200202182216155147137174192192187187152153158152145161167113045013070164167194167169212243247", -"253253094171125041032034074091130090091127154123072072074071083127155119127170174177151094157150096174197182186159163141143162162187162126130225172145189205167113070113205191191193209212246243", -"253253088147120049032052055090101116134147160155115071071072116120125088127147170175172137152140079040158153151163148158152143165162176201202190088162210212209206206206210209167161169206236240", -"253253050134125047030033131091125091124131154131056040074078083120120127134146147155163149158157105035140174129126105139143143145145187192153087085207213213209208208211213240210169166194240229", -"253253063128131047014034049088119088091124084071043031078074089120119147131155147119158153158158110071101190190150139139145162165174093162145194206212213213206168204211212213213212212212240210", -"253253059130147051038047041051073073074077049043043037055078116116125131134125134147126130141140132105105187201176143165187164152094090209212211203206212206107097166208213213213213213240238194", -"253253059146151033019078043047023046048054033089049043072089118120131138131127146147133096126140129105129152190176187176143098165143169169212211206211212166045044114208212213213213213213238165", -"253253045138155049040119082072046023042037072091053041051089123123147147134131130147146105104129152135141141176176176145162145192206209212212203113205208113103111169212213212213213213210194161", -"253253253138171124077094138124086042035019072083055040049089120134134149130127130147130088106140150143162093174187187190174207191212213213213209206208167166166205211212213213213213213194167164", -"253253253135175163124124151101092077046021053072043051071083089134127127130149138146130094137087035174162162162165187165104207241213213212212211193167114203211212212211211212211211209167164169", -"253253253150195175128076092087071063075043049055072041051116116127126126106129146147133130140092139176192187165165174187192240246240240212212191111062075111206212213212211211211208167114164206", -"253253253187224200138045029059045042077086043074083051072118119124105090096129132146150096087130143187199206191165210227206238246240238212203135075053076167211238240213212211208114103113168193", -"253253253253224228188101025020045061076088047071089074082120120096088080073090096121133086039048165187192227206113207227207209230238212206169187143144167211209209212238208205114069070111164205", -"253253253253210228224138086050050075085119089082120083051082055049073038049080055056082063018079145165191167165165187241238238241240210212211206208205209212210209169205203164103070097097113166", -"253253253253253227228188137130124077075079094147147049041043009014043043052033020025008002036162110104104048101172227242227227225207238210209211210212209207191161166168166113070069103111164169", -"253253253253253253224224171138063023014042084082049038082006005028028042027057057003000000089194099100176192227238210225200227212193166114114205206209191164109112114168114114113161161164169193", -"253253253253253253187224183163125080072055155056043030091055002003026060060060011001007053202210193192191207207189165207227238207167068045111203169167108067070114166166166166203169169167169206", -"253253253253253253165224196170146094076091131147118072091170091010004026028060008043178234241238167164145110048140207192207210193113097113167167167107067085142164114166168205168205205193209189", -"253253253253253253150195220188153130124130125116082077130173217183120012025025040219239242230165069085012077140187145187229209167069070112164169164161144110087069114166203204168206206193169169", -"253253253253253253163219233196153130127138094119053018063124183220200177127007116158174190093050049075071143133106077162191189107070136164164167176162104042015044114169205205208206208169161103", -"253253253253253253151196234219158146133146127088082042042033071130159153159074055096133150153172133157096152048011071145145112145189161162165108106087045027029107166191169205194169193164107045", -"253253253253253253183248237200158131147147134096075055072082127124159149096059024039073134149170101126046018004008100145107136167142162105093051050045027069097114167168167189167164164113085064", -"253253253253253253186248235186148124147149149096066042022037072133134096004000000001009012043117096079071013007021139109112165164158090016018007023027069161169169193167113095087097103103095064", -"253253253253253130182235231183146124146147133093063050042013048076054004002006004010034033014014012014014011006050129139144162164110016012011045067114161169169193164142104067067067070109103095", -"253253253253253151218235231216179149126130133126079064044037014019012031047078043033091127105124146133091071049106108112142161165097068085097142114164203206169164142098070069085062061087097142", -"253253253253151178221231231218182149133127126128105079076075083089131088082083083042134130079147146153177149148139110113144144142142103113114166169203168205169165098045065069085061085104103144", -"253253253253138217223223223217182152105095093090079088086091119120116131072072119082155127082159233226228225190143142161162142136107069113164205206209209205205139069065065070069087109109107112", -"253253054073147221232232223216172140104105108129126101088087088131154156091134131082134117155185239250241234202139162139113092066040027112166166204205205205205166113111097097107109104085085113", -"253253116155217235248232222195157110126149158151128100101092128159183183151163182170181220239234234242234224199174162162136066015015065114166203205205208203203168166161113113112113105054063142", -"253253156218235248235221196158109105134178163146129130128124130159181181163188190200199224228239242228224152162158143128063039011044111167203166203203205168203203166164161111112095063045068114", -"253253214248248232221196155146154179183178163149147138130130130147151151186188190174174201224228236202152136101105076045042017011112161191205203205205205203164166114161113142107087042068107164", -"253253179231235220183160156160214214178171163153155146138128128126108130171188188174176176199199202184145101079046039059062059087161166191205203206203167165113145112112107104103110104095109139", -"253253159220198173149155159160214178171159170171163149146137129129105128153151181170158170174174174165137063039021066135162161162113164166166203205164098087066085103112079066103113132104095105", -"253253134185158096091079084131149171179183182175171153146158150140135126137146159163170174165174165145068011016045108165162167167161164166166166164142066045039045108113087085104109104095079048" -}; diff --git a/components/vampireimaging/Demos/Data/LogoAlpha.png b/components/vampireimaging/Demos/Data/LogoAlpha.png deleted file mode 100644 index 25e78ef..0000000 Binary files a/components/vampireimaging/Demos/Data/LogoAlpha.png and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.bmp b/components/vampireimaging/Demos/Data/Tigers.bmp deleted file mode 100644 index bbbcc6f..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.bmp and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.dds b/components/vampireimaging/Demos/Data/Tigers.dds deleted file mode 100644 index 7774bb0..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.dds and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.gif b/components/vampireimaging/Demos/Data/Tigers.gif deleted file mode 100644 index ff4376b..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.gif and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.hdr b/components/vampireimaging/Demos/Data/Tigers.hdr deleted file mode 100644 index 0b3998a..0000000 --- a/components/vampireimaging/Demos/Data/Tigers.hdr +++ /dev/null @@ -1,344 +0,0 @@ -#?RADIANCE -#Made with Vampyre Imaging Library -FORMAT=32-bit_rle_rgbe - --Y 294 +X 400 -X­¯®¯²µ·¹»À¼¾¾¾¿ÁÁ¾»¸¶´´µµ¶·¸¹ºº»ºº¼ÀÂÄÈÊÎÑÏÎÏÑÑÓÕÖÖÖ×ØÙÛÝÛÚØÚÚÚÛÛâãåååæçèééææåääååæææìêê‡é ëëëììëëëììëêè„ç†å‚ã…âåãååæåæçççææèèéééêêêŠîìíŠîƒíïŠðñðð…î‚í‰îíìì…í -îîìëìíïïîî…ðïïð„ñð„îï„ðï„îëéêëê…ëì‡îììëëììíîîïîîìêêé„èçˆæçéë…êëëêçæ„ãåãáãäâß…Û„ÚÜÞàâãâáá…à0ÞÜÜÚÙ×××ØÜÞßàßßßÞÜØ×Ö×ÛÛÛÙÔÖ×ÖÖÕÕÔÓÒÑÑÒÑÐÏÏÌÈÄÃÄ ÁÃÂÃÆÇÇÇÉÈÉ„ÌKÎÎÌÉÅÃÁÂÃÃÅÆÇÈÉÉÊÉÉËËÌÏÒÕÙÛÚÙÙØØÙÛÜÞÞààâßàãããäåååææçèççèèêêëíìëëëìììíííììëë…ì îîîïïîîîïïïíì„êèèèééèç†æèçèèé…èìíïïðïðˆñ…ðî„ïððïïï…ñïŠðîîð†ñ†ð‡ïˆñòññïð‰ñð„ïð„ñ…ð…ñðï„ñ„òˆñ†ïð„ñ ïîììëêêéééèç†æçéëêêêììííìèæäääåæèèêêéê„ë…ì=êéççæçèèççåääâàßÞÜÛÛÚÜßáâããââááßÞÝÞßââãåââàààßÞÝÜÛÚÙØ×ÖÖÔÒÒÔÓ ÁÃÂÃÆÈÊÊÍÍÍ„Ð:ÒÒÏÍÉÆÅÅÇÆÃÃÆÆÇÇÉÆÇÊËÌÏÒÕÕØÖÕÖÖÖØÚÛ××ÙÙÛÙÛÜÝÜáááââàâæëêëìí„î ííìííîîïðïïîî…êìììîîìììîîíìêéééèçææèèæåå…äæåæçèëëìììîïðñ…òó…ï…ô…ò -ôóòòòííëëëì…í…ð -ïïðððíííëï„ôó„òð‡î…ð îïëèèêêçääããç„ëê„èì‰ðîîïðï†ð„ï -îíìëêçæçèè„ç*åäââààáááàßáãââãããäæçççåãâãããââäççéêéæèèèç„æ‡åæååç„éåááàßÝÜÚØØØÙÝà…á ßáààßàâäåãâââàààßÞÝÜÛÙØ×ÕÕÖÕÒÑÒÑÿ€ÿ€ÿ€“€B­¯®¯²µ¶¹»¿¼¾¾¾¿¿¿¾»¸¶´´µµµ·¸¸º¹»¹¸»ÀÀÃÆÉÎÐÏÎÎÑÑÑÕÖÖÖ×ØÙÛÝÛÚØÛÛÜÜÜã„å -æçèééæææää„æèêêêéé…êˆëììëêè„çˆå…ã„åçåçççèææèèéééêêêŠîìí‹î‚í”ï…ðñðð…î‚í‰îíìííîîíîîîìëìîïïîî…ðîîð„ñð„îï„ðï„îëéˆëì‡îí„ì ííîîïîîììëêê…èç†æèéëˆê çäâááãåãáâãâá„ßÝ„Û=ÝÞàâãâááàààááÞÜÜÚÙ×××ØÜÞààßßßÞÜØ×Ö×ÚÛÛÙÔÖ×ÖÖÕÕÔÓÒÑÒÓÒÑÑÏÍÉÄÃÄ ÁÃÂÃÆÇÇÇÉÈÉ„Ì/ÍÍÌÉÅÃÁÂÃÂÄÆÇÇÉÈÊÈÇËÉËÍÑÓØÚÙÙÙØØØÚÜÞÞààâßàãããåå„æèé„èêëëíììëëìíííïìììëë…íˆîïïïíìëëêêèèèééèèè…æ èèèéêèèèéêìí…ïˆñ…ðî„ï…ð…ñ”ï…ðîîð†ñ†ð†ï‰ñòññïð‰ñð„ïð„ñ…ð…ñðïñòññ„ò‰ñ„ïð…ñ ïîííìëêêêééç†æèéëêêê…ì çäãããåææèéê†éê„ë=êéççæçèèççåääâààÞÜÛÛÚÜßâääãââááßÞÝÞÞââãåââàààßÞÝÜÛÚÙÙØØÖÕÔÔÔÓ ÁÃÂÃÆÇÈÊÍÍ͆Ð8ÏÍÈÆÅÅÇÅÃÃÅÆÇÆÉÆÆÉÉËÍÑÓÔ×ÖÕÕÖÖ×ÙÚ××ÙÙÛÙÛÜÝÜááãããáâèëëëìí…î ííîïïïðïïïîîìîîíìêêêéèçææèèçææ…åæææèèëììííîîðð†ò…ð…ô…ò…ôíííëë”ì…ð -ïïðððíííëï„ôó„òðîîîïïîï†ðïëèèêêè„çé„ëê„èì‰ðïîðïíìëëé„è„çåäããâ†áâãââãããäæçççåãâââãâáãççèêèæèèèç‰æååæååç„éæãâàßÞÜÚØØØÙÝà…á ßáààßàáãåãâââàààßÞÝÜÛÚØØ×ÖÖÖÔÒÒÑÿ€ÿ€ÿ€“€C­¯®¯²´¶¸»¿¼¾¾¾¿¿¿¾»·µ³´µ´µ¶·¸¹¹º¹¸»¾ÀÁÅÈÎÐÏÎÎÐÐÑÔÖÖÖ×ØÙÛÝÛÚØÛÛÜÜÜâä„åæçèé…åæææçè…ê…ëìëëëêëëëìììêéçèççåæ„ç èèæææççèèééê…ï…îìí…î…ïƒî…ðï…ðñðð…î‚íŠî‚í…î -ïïîìíîðïîî…ð‚î†ï„îï„ðï„îëéˆëì„î"ïïîííììííîîîïîîìììëêêêéèèèçææçççèéˆêéçäâáááãâáâââá„àß„Ý/ÞßáâäãááàààááßÞÜÚÙ×××ÙÜßààßßßÞÜØ×Ö×ÚÙÛØÔÖ×ÖÖÕÕÔ„Ó -ÔÓÒÑÐÍÌÇÄÄÁÃÂÃÆ…ÇÉ„Ì<ÍÍËÇÅÂÀÁÂÂÄÅÆÇÈÈÉÈÇÊÈÉÌÏÒØÚÙØÙ××ØÚÜÞÞààâßàãããåæææçæçèçççèéêê…ìíííîï„ìë‡ï†î ïïïîìëìêêèèè…éˆèéêèééêêìííîîïïïðñ…ò…ðî„ï -ððñññóòñññ…ðï…ðîîð†ñ‹ð‡ñòòóóòñðð‰ñð„ïð„ñ…ð…ñððñòòñ„ò…ñòòññðïïð†ñïïïííììëëêêéçææçççèé„ê„ìëç„äåæççéééè…é…ê<éçççèèèççåääãáàÞÜÛÛÛÜàâääãââááßÞÝÞÞàâãåãâàààßÞÝÝÝÜÛÙÙØ×ÖÕÖÕÔ ÁÃÂÃÆÇÈÊËÍ͆ÐÏËÈÆÄÄÅÅÃÃÄÆÆÆÇÆÆÈÈÉÌÏÒÔ×Ö„Õ×ØÚ××ÙÙÛÙÛÜÝÜáâãããáâæêêêëìíî…íîîïðð…ï…íîí†ì îîîìêêêéèçææ…è†çæçèéììíííîîïïððñòòò…ð…ô…òóôõõõííí–ì…ð -ïïðððíííëï„ô…óñîïïððïðððññðððìèèêêéèèççé„ìê„èì‰ðïîð7ïííëëéèèèéèçççåååãâââããâáãäããäääååçççåãâââãáááââãäææçèç‹æåæææç„éæããáßÞÜÚØØØÛÞà…á ßáààßàáâããâââàààßÞÝÝÝÛÙØØ×Ø×ÕÔÔÒÿ€ÿ€ÿ€“€C­¯®¯²³´¸»¾¼¾¾¾¿¾¾½»¶µ³´µ´´µ·¸¸¸º¸¸»¿ÀÁÅÈÌÎÎÍÎÏÏÐÓÔÖÖ×ØÙÛÝÛÚØÚÚÛÛÛáâ…ãåååâ…ä„æééêêê…ëíìëêêëëëììíëéééçç…åæ‡ç -åååçççèèéé…æèèééé…í…îìí…îðððïïïîî…ðŠï…î…ðñðð…î‚íŠîíîîïïîïïïîìîïðïîî…ðƒî„í…îï„ðï„îìêììì…ëí‡ïî„í„îïîîíîíìì…êéèææ†èé†ê éæãáßßáâáàáâ†áà†ß*áãåãááààáââßÞÝÚÙ×××ÙÜßááßßßÞÜØ×Ö×ÙØÙØÔÖ×ÖÖ‡Õ -ÖÔÓÓÐÎÍÈÄÄ ÁÃÂÃÆÆÆÇÇÆɆÌ1ËÇÄÂÀÀÂÁÃÄÆÇÇÇÉÇÇÉÉÉÌÏÒ×ÙÙ×ØÖÖ×ÚÛÞÞààâßàãããääåååä‡æèèéêêëëëìììíëëììì…îðïïííîîîïïðîíììêêèèèééé‡ê -éééêëèêêêë…ì…ï…ñ…ðî„ï -ððñòòóóóññ…ðŠï…î…ðîîð†ñ‹ðñññòòñò†ó‚ð“ñ…ð‡ñòó‡ò†óò‹ñ„ï ííìììëëéèææ†èéêêìììëëçããââäææçèé†è‡é†è&ççææåãáàÞÜÛÛÛÝàãääãââááßÞÝÞÝßàãåãâàààß„Þ ÝÜÛÙÙØ×ØØÕÔ ÁÃÂÃÆÇÇÉËÌ͆ÐÎËÇÆÄÄÅÅÂÃÃÅÆÆÇÆÅÈÉÉÌÏÒÔÕÕÔ„Õ ØÙ××ÙÙÛÙÛÜÝÜ…áßàå„éê…ë ìííîîîïîîïïï…ìîîí…ì îîîìëêêéèçææŽèêìíí‡îððòòò…î…ô…òóôõööŠíŠì…ë…ð -ïïðððíííëï‰ôñîˆðñññððìèè…êèèé„ëé„èì‰ðïïñññŠðïíííëêèèéêèççç„å‡ãääããäääåååæçåãââáâáàÞÞÞßàâææçæç„é$æäãáßÞÜÚØØØÛßáãâáááßáààßààáâãâââàààß„ÞÜÚÙ…ØÖÔÓÿ€ÿ€ÿ€“€­¯®¯²³´¸¹½¼¾¾¾¿¾¾½¹¶´±³´´´µ¶†¸8»¿ÀÃÆÉÌÎÎÍÎÏÏÐÓÔÖÖ×ØÙÛÝÛÚØØØÙÙÚßàáââáâãääááââããäääåééêëì…êíìëêéëëëììíëéééçç…åˆçæååççèèéééæææååèèèéé…ì…îìí„î ïðñòððïïî…ðŠï…î…ðñðð…î‚íŒî†ï ðîíîïñïîî…ðïïî„í…îï„ðï„îìëììì…ëí„ïððïîîííí„îïîîíîî„ìëêêéèçç†èé†êèåãàßßàááàáááâ„ãâ„á/àßáãåãááààáââáÞÝÚÙ××ØÚÜßááßßßÞÜØ×Ö×ØØÙØÔÖ×ÖÖÕÔÔ„Õ -ÖÕÔÓÑÏÎÉÆÄ ÁÃÂÃÆÅÆÇÆÆÉ†Ì ÊÆÄ¿ÀÂÁÃÄņÇ8ÉÉÊÍÑÓ×ÙÙ×ØÖÖ×ÙÛÞÞààâßàãããâãããäâäåääãääåæççèéêêêëëìëëììí…îñïïííîîîïïñïíììêêèèèééêëë†ê ééêëêêêëë…ìî‰ï…ðî„ï -ðñòóôôóóòñ…ðŠï…î…ðîîð†ñŠðñññòóòòóóôôôóóñð‡ñƒð‰ñ…ð‡ñòóó†ò…óôó‹ñïððïî„íììêèçç†èéêêìììëêæãâââãäæççŒè‚é†è&ççæææäâàÞÜÛÛÛÞàãääãââááßÞÝÞÜßàãåãâàààß…Þ -ÜÛÛÙØØÙÙÖÔ ÁÃÂÃÆÇÇÉÊË͆РÍÊÇÅÂÄÅÄÂÃÃÅ„Æ ÅÈÉÊÍÑÓÔÕÕÓ„ÕØÙ××ÙÙÛÙÛÜÝÜßßààáÝÞãççæçè„éê„ëìííîîïðð…ìîîíìëìììîîîíëêêéèçææèèèéê…éèèèéêíí‡îíðððòò…î…ô…òóõöö÷ïîˆíŠì…ë…ð -ïïðððíííëï‰ôòˆðòòòñðñìèèêêêëëêêê„ëé„èì‰ðïðñññ‹ðîííìêèèêêèçççåææåäãäåäãã…ä…åæçåãââááààÞÞÝÞàâ“æç„é$æääâàÞÜÚØØÙÜßáãâáááßáààßàßàâãâââàààß„Þ ÜÛÚÙØØÙÙ×ÔÓÿ€ÿ€ÿ€“€ ¬­®¯¯²³¶¸½¼„¾(½¾½¹µ´´³³³µµ¶··¶¸º»»½¿ÁÄÇÌÍÍËËÍÎÏÒÔÖ×ÙÙÙ…Þ…Ø…ÛÜÜÜÞßÝÞ„àáââ†ã ççèéêêëëêêéêë‡íèééççèççééæææååééé‡êìêêëŽì íîîîïððîï„ð ñððîïïîîîððˆï…íì„í†î‚í…î†ðïîï„ð ñññòôôòòñ†ðñññï„íïˆð ïîîïïïîîïïðð„ï ððññòòòññ†ðï‰î!ïïîíëêêéèççèèçççèèèééèèåâßÝÜÞáââä‰åäâ‰áààâäãáÞÜÚÙ×ØÙÛÝààáààßÝÜ„Ú -Ø×ØÙÚÙØØÖÕ†Ö -×ÖÖÕÕÑÑÎÈÅ7ÀÁÂÃÃÄÄÄÆÆÉËÌÌËËÌÊÆÂÂÁÀÀÀÄÄÅÆÆÅÇÉËËÌÎÑÔÖÖ××ÖÔÔÔÖÙÚÝÞààà…á‡ãâââãããåæäåççæççèé†êééêëëíîîîíííïðñ…í ìììëêëêêì„íììëëëêê…ìíìììí…î†íîîïïððñññðññòòôõôôñóòñññððˆï…ñïðñðððñó„ô óñóôóóôõõ„ôòòñ†ð‰ñˆð ïîîïïïðñóóôô„ó òðññòóôóóññ„ðˆñ%ðïîíìëêêêéèççèèçççééêëëêéçäáààâäææçéé†èéêëëé„çƒè„çæäâàÞÜÛÛÝÞáãäâààßÝ…Þßáãäääãâ‡à ßÞÝÜÛÚØØÙ×Ô5ÀÁÂÃÃÅÅÇÈËÍÎÏÏÎÎÏÎÊÆÅÅÄÄÄÂÃÃÄÅÃÅÇÉÉÇÉÌÏÐÓÓÓÒÑÑÓÔ×ØÛÝÞŒßÜÜß…ä -æèâäåæåééê‡ëìííîï…ìëìíîî…íçççæåêééêëëëêêêçèêîî…ïðïïðð…ò†ð„òôôõõõôõõööïïïîˆíˆì…ë…î†ð îîïòôôôõô„òñðñòññòôôóóôôòòð†íîîíì„ëì„íïðððïíëëìììíííîî†í îîîíëëêêë„íê‡ç&æåæææäãåçååääååääâáááââááÞÛÛÛÚÝàáàâääã„âã„äå‰æåæåâàÞÜÚØÚÙÙÜÞÞÞÝÜÛÚÛ…Ü ÞßàáàßÞÝÜ†Ý -ÜÛÚÚØ×ÖÕÒÑÿ€ÿ€ÿ€“€ª«¬¬®²³¶¸¾»¼¾¾½¼¼»¸µ´…³´µµ··¸¼¾¾¿ÁÂÄÅ…Ë -ÌÎÏÒÔÖØÚÛۅ߅؈٠ÛÝÜÞÞßßßààáá…ßååçéêêëë„êëìì…íêêêéèéééêëèèçççææçææ…êìêêëìîîîïðîï„ð ñððîïïîîîððˆï…íì„í†î‚í…î†ðïî…ð ñññòôóòòñ†ðñññï„íî…ïðððîîîïïïîîïïðð„ï ððññòòòññ†ðïŠîïîííìêê„è†æ„è çäáÞÜÚÝàááã‰åäâ‡áààßßáââßÜÜÚÙ×ØÚÜÞààáààÞÝÜ„Ú‚Ù„ÛÚÙØ׆ØׄÖÓÑÎÈž¾ÀÁÁÄÄÄÆÆÉÊËËÊÉÊÈÆ„ÀÃÃÄÄÆÆÇËÍÎÎÏÑÒÔÔÖÖÕÔÓÔÕÙÛÝßá‡â…ã‚â†à âäãååæææçççè†æèéëìíîîîíííîïï‰íëíììîîïïíííïîííí…ìíìììíîîîïððññðññòòôõôôñóòñññððˆï…ñïðñðððñó„ôóñóôôóôõõôôôóòòñ†ðˆñð…ïðððîîîïïïðñóóôô„ó òðññòóôóóññ„ðˆñ -ðïîíìëëëêê„èæææçèèéééêèåäáßÞàäääæˆèéêëëê„èƒç„æåãààÞÜÛÛÝàáãäâààÞ݆Þà„âáàßÞ†ß -ÞÝÜÜÛÙØÙ×Ô¾¾ÀÁÁÅÅÇÈÌÍÍÎÎÍÍÍÌÈÆÅ„ÄÀÂÃÃÃÄÆÊÌÌÉËÌÎÐÑÒÒÒÑÑÓÔ×ÙÛÝßßß…á…ßÛÛß…âäåáãäääè„é…çêëíîïˆì‚î…íéééèæëêê‡ìèêì‡ïðïïðñ„ò ôôõõôõõööïïïîˆíˆì…ë…î†ð îîïòôôôõô„òñðñòòñòôôóóôóòòð†íîîíì…ë„ìíðððîíëëìììíííîî†í îîîíëëêêë„íêˆèççææåäæççåäääãããáßß„á àÝÛÚÙÙÛÞßàá‡âã„äå‡æ„äãáßÞÜÚØÚÚÚÜÞÞÞÜÜÛÚÛ„ÜÝÞ†ß‰Ý ÛÛÚÙØÖÕÒÑÿ€ÿ€ÿ€“€¨©«¬®²³µ¸½»»¼¼¼»»¹¸¶µ…´µ¶¶·¹¼¿ÁÃÁÂÂÄÄÉÊËËËÌÌÏÓÕ×ØÛÜÜ…ß…Ù ÚÚÚÙÙÚÚÚÜÜÜÝßãåæéêêëë…ê‚ë…ì ëìëêéëêêë„ì‚ë…ç…ëìêêëì…ê…ìë„ì†îïïðððñððîïïîîîððˆï…íì„í…îíììí„î†ðïïðñððð„ñóòòññ†ðñññï„íî†ïðïîîîïïïîîïïðð„ï ððññòòòññ‡ð‡ï$îîïïïîíìëêêèèççææååææèççæãàÝÚÙÚÝÞàâäˆåäâ‡áààßßáâáßÜÜÚÙ×ØÚÜÞßàßßßÞÝÜ„ÚÙÚÛÜÛ„Ú‚Ù„Ú Ù××ÖÖÖÓÒÏÉÆ5¼½¿ÁÁÄÃÄÅÅÈÉÉÊÉÈÈÇÆÃÃÂÀÀÁÃÄÅÅÆÈËÏÑÒÑÑÒÒÓÓÔÕÕÔÓÓÕÙÛÞßáŒã ââáààáàáâããäæ åæèêìíîîî„íîï…ìïïïííîíí‡ïðððïï…ìíìììí…ì…íìííîîïïðððñòóôôôõôôñóòñññððˆï…ñïð‰ñ ïïðñðððñó„ô‚ó…ô õõôôóòòññ†ðˆñð†ïðïîîîïïïðñóóôô„ó òðññòóôóóññŒðïïîííììëëêêèèçç„æèèééèèåâàÝÜÞàáãåç‡èéêëëê„èƒç„æäãàßÞÜÛÛÝàáâãâàßß‡Þ ààáàààßßÞ†ßÞÞÝÜÛ„ÙÕ ¼½¿ÁÁÄÄÇÈÊË„ÍËÌÊÈÇÆÅÄÄÄÂÃÃÄÄÇÊÌÏÐÌÌÌÎÎÐÐÒ„ÑÔØÚÜÝà‡á…àÜÛßâáãâãäæáãäää‹èêëîï‰ìí…ìéêééè„é ëëêêééêìíññ†ðïïðð…ï‡ðññòòóóôôðððòòïïïîˆíˆì…ë…î…ð -ïîîîñôôôõô„òñðòóòòòôôóóóòòñï†íîîíì…ë„ìíïðïîìëëìììíííîî†í îîîíëëêêë„íë‡ê#ééèæææåæèçæååäãããàßßßáààßÜÙÙØ×ÙÛÝÞà‡âã„äå†æå„äãàßÝÜÚØÚÚÚÜÝÞÜÚÚØØÚ„ÜÝÞßßßÞÞ‹ÝÛÛÙØØÖÓÑÿ€ÿ€ÿ€“€ ¦§©«¬¯°²µ»¹†»¹¹¹¸„µ¸¸¹º»¾¿Ã„ÄÃÂÂÈÈÊËËÌÌÏÓÖ×ÙÜÞÞ…á…ÜÝÛÛÚÙÛÛÛÝßÝßàààáàààß…Þååçéêêëë‡ê…ì ëëëêéëêêììîîŽìêêë‹ìêë„ì…îïïðððñððîïïîîîððˆï…íì„í…îíììí„î‡ðïñññðð„ñòòñññ†ðñññï„í†îïïïííîïïïîîïïðð„ï ððññòòòññ‡ðˆïî…ïîìëêêé„èæææèèçæäâßÜØ×ØÚÛÞàãˆåäâáá…âááààáââßÜÜÚÙ×ØÙÛÝÝÝÞßßÝÝÛ„ÚÛŽÜ ÚØ××Ö×ÔÒÏÉǺ»½¾ÀÁÀÁÂÃÆÇÉÉÈÇÇÆÆÆÅ„Ã -ÇÇÈÉÊÍÏÒÔÔ…ÒÑÒÔÔÔÒÓÕÚÜÞàãåå…ä…æåäâáàâââäæäææççèçççæ…ä æèéëìíîîî†í…ìïïïîìîííŠï‚î†íƒì‹íììíííîïïððñòóôôôõôôñóòñññððˆï…ñïð‰ñ‚ï…ðñó„ôóóôõõôôõõôóòòñññ†ðˆñï…îïïïííîïïïðñóóôô„ó òðññòóôóóññ…ðˆïî†íìëêêé„èçèèééèèæãáÞÜÛÛÝßáãæ‡èéêëëê…éèèççææåãààÞÜÛÛÝßàààáààˆÞƒàß ÞÞÝÜÚÙÙÙÖº»½¾ÀÁÂÄÅÈÊËÍÍÌËËÊÊÊÈ„ÇÅÆÆÇÉËÌÐÒÒÎÎÍÍÍÎÐЄÑÔØÚÜßàŒãÞÝàãâåååæçãäåææ„é†çêëíîïì„éçæååçèççæææëìîòò†ð‚ïŒðï„ðòòòóôííí…ïîˆíˆì…ë…î…ð„îñôôôõô„òñðóôôòòôôóòòòññï†íîîíì‰ëíïïïíìëëìììíííîî†í îîîíëëêêë„íˆìëëè„æèéèççæåäääáßßááàßÞÛØ××ÖÖ×ÚÜßá†âã„äæ„èç„æåäãáßÞÜÚØÚÙÙÛÛÛÚØØÖÖÙ„ÜÝÞßߎÝÜÛÛØØÖÓÒÿ€ÿ€ÿ€“€  ¢¥§©­®°´¸¸ºˆ»º„¸¼¼½¾¾ÀÂÅÆÆÅÄÃÂÁÆÈÉÉÉÊÌÏÔÖ×ÙÜßà…á†Þ‚Ý…ÛÝÞßà†â‚à…áççèéêêëë…ê‚é…ì êêêéèêééêëí„ì…ñ†ìêêë‹ì‚ê…ì„îïïðððñððîïïîîîððˆï…íì„í…îíëëì„îˆð„ñð„ñòññˆðñññï„í‡îïîííîïïïîîïïðð„ï ððññòòòññ‡ðˆïî…ï îíìëëêêêé…èéçåäáßÚØÖ×ØÚÝßãã‡åäâáá„âãããââãäãáÞÜÚÙ×ØÙÙÚÛÚÜßÝÝÝÛ„ÚÛÜÜÜ…Ú†Ü ÚÙØ×Ö×ÔÓÐÊÇ7´¶¹»¼¿¿¿ÀÁÆÇÈÇÇÈÇÇÈÉÇÆÅÅÆËËÌÍÍÐÑÔÕÕÔÔÒÒÑÐÒÓÔÔÑÓÕÚÝÞàãææ…ä…èçæã…â äåæçèéééèèçç…è ééêëëíîîî„í‡ìíîîíìíìíîïïïîíííììëë†íìììí…î…íììíííîîïïïñòóôôôõôôñóòñññððˆï…ñïðˆñðïîï„ðñó„ôóôõõõôôõõôóòññˆðˆñï†îïîííîïïïðñóóôô„ó òðññòóôóóññ…ðˆïî„íîîíìëëêêêéèèééêëéææãàÝÛÙÚÛÞàãæç†èéêëëê…éêéééèçæäâàÞÜÛÛÜÝÞßÝßàß߇Þßàß…Þ†ß ààßÞÝÜÚÙÚÙÖ ´¶¹»¼ÀÁÂÄÆÉ„ËÌËËÌÌËÉÈÈÉÉÊÊËÌÎÐÒÓÓÐÏÍÍËÍÏ„Ð ÑÔÙÛÝßâäå…ã…äàßáããäääæçäææççëêêéé…êìííîïˆìëê…ìéééèçåääåæææåååêìîññ†ðïïðð…ò…ðïïððð…òƒí…ïîˆíˆì…ë…î…ð -îíìîñôôôõô„òñòóôôóòôôóòòññðï†íîîíì‰ëíîïîíìëëìììíííîî†í îîîíëëêêë„íˆì$ëëèæææèèééèçççæååãáááâàßÞÚØÖÖÕÕÖØÛÝá†âã„äæ‡èççææåâàÞÜÚØÚÙØÙÙØ×ÖÕÕÔØ„ÜÝÝßÝ…Ü†Ý ÞÞÝÜÛÛØØØÕÓÿ€ÿ€ÿ€“€Ÿ¡£¥§¨«®³·ºº»½„»)¼¿ÁÀ¿ÀÃÄÆÈÈÉÊÌÎÐÏÎËÈÅÂÂÂÄÅÉËÏÓÕÝààáãããäåå…áããâà„Þ ßàáâäääááââã…ä#ééêéèììëììîîííìííìììçèéèçèèéééêêëëì…î…ì íêéëîììîí„ìëëìëêêêìììíîííîîîŒðïïïððñññììíííîíììíîî†í îïîïïðïîïïïðï‡ñðññ„ð ñññðïïððð„ñ*ïïîííîîíîîîïïïððíêëìíðññðñññòôóòóôòðñññðððˆï&îîîííîíîîíìëëêêêéêêèèççæâÞÚ×ÖÖ×ØÚÞãããå„æ„çääââáã„åæçåãßÛÚ„×ÙÚÛÛÛÝÝÜÝÛÚÚÛÛÛÚÚÛÜÚŠØ -×××ÖÕÓÑÐÎÉ!±³µ¸¹¹º¼¿À¿ÂÃÃÅÉÉÈÉÉÈÊÉÇÉÌÏÐÒÒÓÔׄÙÕÒÐÒÒÒÓÔÔÖÙÝÞáäääæææçèè…ç æææãââáâãäçé…ëììí…ë$êëìëêííîïïîîííìííìììëììëëëììíííîîïïí„ì…íïëëíïíîïïîîíííìííìììíîîïï…ñŠô ððïïïððñññïð„ñðïïŠñòñóóôóñò„óô†õôóñ„ðñññðïï„ð-ïïïîïïîíîîíîîîïïïððñòôõöõññðñññóõõôõõôòñññðððˆï îîîííîîïïïíìë„êëëêêéèçäàÜÛÙÙÛÛÝâææçèéêéêëë„êééèè„éêêèçâßÝÚÙÛÛÜÞßßÞÞßÝ…ÞßÞÝÞÞŒß -ÞÞÞÝÝÝÛÚØÕ!¯²´¶¸½½¿ÂÅÆÉÊÊÌÍÍÌÍÍÍÏÎÌÎÌÏÐÒÒÓÔׄÙÕÒÐÍÍÍÎÐÐÒÖÙÛßááâåååˆæäääâààßàááæèéêêèèééê…í&îîïîíððìëëîîííìííìììæçççæããäääååææçéëí„ð ñññòïîñòð…ò†ðïïïð„òëëííí…î…ï -ííìììíííîî…ëð„îððîîîëëë…í îïðððññðó†ôòðîíìííîîîíëììííì„ë(éçèéîîíîîîíììííììííïïîííîîííìëêììëêìîíííˆì„ë ééëèççæåæ„çäããááààßÛ×ÖÖÔÔÖÖ×Ýáááâäåäçêêé…èæç†èçåáÛ×ÕÔÖÖ×ÙÙÙ×ÖÖÕÖׄÙÛÜÜÝÜÛÛÙØØÕÓÿ€ÿ€ÿ€“€(œŸ¡¢¤¦¨«°³µ¸¸º¼»¼¼¾ÃÄÃÃÅÄÈÉËËËÍÎÐÑÑÐÏÍË„ÈÉÍÏÒÖ×Ýààáãããäåå…äååäâàßßßàááâäääåææçç…æ éêêêéììëììîî…í%ìììèééèèçèèèéèéééêææçææìììîîíëêìîìíîî‰ì ëêìììíîííˆî‡ð„ïððññìííîîîíìííîî†í îïîïïððïïïððð‡ñððñðïðððññðïïððð„ñïïî…íîîîïïïððíêëìíðññðñññòôòòòóò„ñƒðˆïîîîííîíîîíìëëë…êéèèèçãßÜØ×××ØÚÝââäåçè†çääââáã„åæååãßÛØ×Õ××ØØÚÚÚ…ÝÛÜÜÝ…ÜÚ…Ù…Ø -×××ÖÕÓÑÐÎÉ<¯±³µ¶¶¸¹¼½ÀÃÅÆÇÊÉÉÊËËÌÌÌÍÏÑÓÔÔÖ×ÙÚÛÛÚÙ×ÕÑÑÑÒÔÔÖÙÜÞáäääæææçèè…êèèçåäâââääçéëëëì„í…ì ëììëëííîïïîî…íìììëììì„ë…ìííïî„í îîïïïììíïíïïï„î ííîííììíîîïïŠñ…ô‚ð„ïððññï…ñðïðŠñòñóóô„óôóôôõõôõõõóòñðïðððññðïï„ðïïïîïïî„í"îîîïïïððòóôõõôññðñññóõôôôõôóñññðððˆï,îîîííîîïïïíìëëêêêëëëêééèåáÞÜÚÙÛÛÝáåæçéëëêëëë„êééèè†éèçâÞÜÚÙÙÚÛÜÝÝÝÞßÞ…ß‚à„߆à…ß -ÞÞÞÝÝÝÛÚØÕ¯±³µ¶º»½¿ÂÅÈÊËÌ„Í)ÎÐÒÑÐÓÏÑÓÔÔÖ×ÙÚÛÛÚÙ×ÕÎÎÎÐÐÒÓ×ÛÝßááâåååæææ…èæææã…áãæèé…ê‚ì†î ïïïîððìëëîî…íìììæçççæâãããäãäääåèêìïïñ…òðïñòð‡òððòðððïð„ò‚ëˆí…ï‚í„ì -íííîëëëìíð„îððîîîëëë…íî„ðòñòóôôóôôôñïîìììííîîìëììííì„ë éçèéíííîîîíìì†íïïîííîîîíìêêëìëëìîíííˆì„ë ééëèççæåæ„çåããâáááàÝØ××ÕÔÖÖ×Üààâäææåçêêé…èæç†è æåáÚ×ÕÔÔÕÖ×××…ÖØÙÙÙÛ…ÝÞ„ßÞ‡ÝÜÛÛÙØØÕÓÿ€ÿ€ÿ€“€!š›žŸ¢¢¦©­°´¶¸º½½½¾ÀÄÇÆÇÈÉÊÌÎÏÏÏÒ…ÔÒÐÎÎÍÎÎÑÒÕØÙÝààáãããäåå…âççåãâáßàáâáâäääèééêê…æ êêëêéììëììïîî„íƒì„éèççèèéççèèéææçææëìíîîíìììîìí…îííìí‡ìíîííîîî…í…ï‚ð…ïðððí„îïíííîîî†íîïîïïððï…ð ñññððñðïðñïïï„ðïîïððð„ñïïíììíííîîîïïïðððïïïðñññðñ…òññòòòñññ‡ð„ïîîîííîíîîíììëë†êéèèèåâÞÛØ×××ØÜàâäç„è„çääââáã„åæåäâÞÚØÖÕÕÕÖØØØÙÜÝÝÝÞÝÝÝÞÞÞÝÝÜÛ†ÚÙÙØØ×××ÖÕÓÑÐÎÉ<­®°²³´´·ºº¿ÃÆÇÉÊÊËÌÍÍÏÏÏÐÓÕ×ØØÚÚÜÝÝÞßÝÜÚ×ÖÕÖ×Ö×ÚÝßáäääæææçèè…éêêéçåäããåæçéëëëíîîïï…í ëìììëííîïïïîî„í…ìíììêëëììêëëììïî„íîïïðïííîïîïðïïðïïïîïîîíííîîïïŠñ…ó‚ð…ïƒð…ñòñòñóóôôó…ô‚õ…ôóòñïïï„ðïîï„ð,ïïïîïïíìíííîîîïïïððñòòóôóññðñòòóôôóóôôôòòñññ…ð„ï(îîîííîîïïïííëëêêëììëëêêêçãáßÜÚÛÛÜßãåçêëì„ë„êééèè†éèåáÝÛÙØÙÙÙÛÜÜÛÞßÞßààááâââáààà†áààßßÞÞÞÝÝÝÛÚØÖ<¯¯²³´·¸º½ÀÃÈÊËÎÍÍÎÏÑÒÔÔÔÖÓÕ×ØØÚÚÜÝÝÞßÝÜÚÔÓÓÔÔÔÖÙÜÝßááâåååæææ‡èçåãâááãäæèéêêìììíí…ò îïðïîððìëëïîî„í'ìììççèççââããäâãããäèêìïïðñòòôòñññòñòóóòó‡òññð„òëëííí…ë‡í†ìííëììííðïîîïððîîîëëë…íîîíîïïñòôôóòòóòñïí„ì -íííìëììííì„ë éæçéíííîîîíìì†í îïîííîîîíëêé…ëììëëˆì„ë*ééëèççæåçèèççåãããââááßÛÚÙ×ÕÖÖ×ÚÞàâåæçæèêêé…èæç†èæäßÚÖÔÓÔÔÕÖ××ÕÕÖÖÖÙÛÜÜÝÞàßÞÞÞ‡ßÞ„ÝÜÛÛÙØØÕÓÿ€ÿ€ÿ€“€<ššžž ¢¥§¬­³µ·»¾¾¿ÁÂÇÉÉÉËÌÍÐÒÒÓÕÕÕÖÖ×ÖÕÔÕÔÓÓÓÕ×ØÛÜÝààáãããäåå…áççæäâáááâãáâäääêëëìì…è#êììëêììëììïïîîîííìììéêêééèéééêçèèèé…æ éëìíîìîîíììŒîí„ìíîííîîî…í…ïððïïïîïïððíîîïïïîí„î†íîïîïï…ðòòñññðïðððïïðïîïïïððïîïððð„ñïî„ì -ííîîîïïïðð…ñòññðñòòóòñðñòôòññ‰ð ïïïîîîííîíîîí„ì‚ë…êéêêçäáÝÙ„×ÚÞáäåçè†çääââáã†åãâÞÙ×ÕÓÔÕ××ØØØÜÝÝßßÞßßà…ßÜ‡Û ÙØØ×××ÖÕÓÑÐÎÉ­­®±±²³µ¸¹¾ÃÆÇ„Ì(ÎÐÏÑÑÒÔÖØÚÜÜÝÞßàààâààÞÛÛÙÙÙØÙÜÞßáäääæææç‡èêêéçæäääææçéëëëîîî‡ïìííììííî„ïîîîíí„ìƒí„ì*ííëëëììíííììëìîïïîïïïîîðððïðððïïðïïïîíîîïïŠñ…óððïïïîïïððñññòóóñòñóó…ô…õôóôôôòñðïîïïïððïîï„ðïïïîîïíììííîîîïïïðð…ñòññðñòòôôôñóôõôóóòñññ…ðïïïîîîííîîïïïííììëë„ì„ëéæãàÝÚÛÛÛÝáäçéëëêëëë„êééèè…éèæåáÜÙØÖØÙÚÛÜÜÛÝÞÞàáâââäãŒâ àßßÞÞÞÝÝÝÛÚØÖ9¯°²³³¶·¹»¾ÁÇÉËÏÏÐÐÒÓÔÖ×ØÙÖØÚÜÜÝÞßàààâààÞÚÙØØØ×ØÙÝÝßááâåååˆæèèèæäãããäåæèéêêìììîî…ó*ïðððïððìëëïïîîîííìììçééèçãäääåâãããäçéêîîîð‰ò -óôôòôôôòòô„òð„òëëííí…ë‡í ìììëìììíë„í ðïîïðððîîîëëë…íîí„ìðôôôòðòòòðïíëëëììííëëììííì„ëèæçéìííîîîíììííí†îííîïïîëêèêëìëë„êë„íƒì„ëééëèççæåçééççå„ãâããàÝÝÛØÕÖÖÖØÜàâäææåçêêé…èæç…èæåäßÙÔÓÑÒÔÕÖ××ÕÕÖÖØÚÝÞÞÞß„á…ßàßßÞ„ÝÜÛÛÙØØÕÓÿ€ÿ€ÿ€“€<š›ž ¢¤§¬¬±´·»¾¾ÀÂÄÊÍÍÍÏÏÐÓÔÔÖÖ××ØÙØ×ÕÔ××ÕÕÖ××ÙÜÜÝààáãããäåå…äççåãâââáãäáâäääêêëëë…èêììëêììëììïïïîîííìììéêêêéêêëëìè„é…ì çéëìííîîîìí„îðïˆîìììíîííîððïïïîîïïïîîïïïð†î†íîïîïï„ðòòòñññðïïððïïðïîî…ïîïððð„ñïî„ì -ííîîîïïïðð…ñòññðñòóôòðððñôóññ‰ð ïïïîîîííîíîîí„ìëëëìë…êéæâßÛ„×ÙÝàâå„æ„çääââáã†åãáÜÙ×ÔÒÓÖ×ÙÚÚÙÛÝÝß„àáàßààáÞ„ÛÜÛÛÙØØ×××ÖÕÓÑÐÎÉ<­­®°°²³µ¸¹¾ÃÆÉÌÌÌÎÏÑÒÕÕÕØÙÚÝÞÞààááâããâàÞÜÜÚÚÛÙÛÝßàáäääæææçèè…ëêêéçææååæççéëëëííîîï…íìííììííî…ïîîííìììííîíìííîïïëììííë„ê éëìíïïïðïîï„ð‚ñ†ðïïíîîïïñððïïïîîïïïññòóóóñòñóó„ô†õ óóóôóòñðïîî…ïîï„ðïïïîîïíììííîîîïïïðð…ñòññðñòóôôòñòóõõôóòñññ…ð/ïïïîîîííîîïïïííììëëìííììëëìêçåâÞÛÚÛÛÜáäæèéêéêëë„êééèè…éèæåàÜÙ×Ö×ØÛÜÝÝÜÝÞÞàâãäääãâäääã„âãââàßßÞÞÞÝÝÝÛÚØ×*´´µ¶·¶·¸»¾ÀÅÊÍÏÐÐÑÓÕØÛÛÛÝÙÚÝÞÞààááâããâàÞÛÚ…Ø ÛÝßßááâåååæææ…éèèçåääããäææèéêê„ìí…ö9ïðððïððìëëïïïîîííìììçééèçååææçããäääçéëîîíîðñòòóóòòòóôôôõõ…ôóòòð„ò‚ëíìììëëììì…íñðï„ðîîîëëë…íîí„ìðôôôñððòñðïìëëë„ìëêììííì„ëèæçéìííîîîíììíí‡îííîïïîëéèêëììêéèççê„íƒì„ëééëèççæåçééèçæåä…ãâßÞÞÙÖÕÖÖ×ÜÞáâäåäçêêé…èæç…èæåâßÙÔÒÑÒÓÖ×××ÕÔÖÖØÜÞÞÞßàááâââ†á‚ß„ÝÜÛÛÙØØÕÔÿ€ÿ€ÿ€“€*šœŸŸ¢£§©­®°´·¼¾ÁÅÉÌËÍÎÍÏÓÔÕÕÕÖ××ÖÖÓÖ××ÙÚØ…× ØÛÜÜÜÞßàââã…å4æçççåäãàààáâââãääèéêëêìììíîëëëêêëëëìììíîííîíëêêèéêëëŠì -ëêéèççéêëë…ìëíîííîîîïïîïïððîìëìî†ï„î -ðïïîîðïîîïŠðïïîííîî‰íîïððïïïñòññðððïïîîï…ð„ïˆðïïïîíí„ï‡ðŠñ…ò†óñðï‡ð†ïîîííîîí†ìë‡êèèæâÞÛÙ××ØÛßáãæççè„çæçåååæç„å æãàÝÙ×ÖÖÖ×Ù„ÛÞßßßáâãäãääãããáÞÞÝÝÛÛÙ„Ø ×ÖÖÔÓÓÐÎÌ)­®°±³¶·¸º¸¼ÁÅÇÌÏÏÐÑÒÕØÙØÙÜÞßàààáâààâàßÞÝÜ„Ú2ÙÚÛÞàààâãäåææèèèéééêëêéèæçççèéééêêêììîîííîîïïîîîíí†ï„ñîíëêêììíŒï îííìëëìíî‡ï‡ñ óóñóóóôñïïïñ…óòòñññôóóòñðïîîïŠðóòŒñðññóôôóóóõöõõôôóóòñññ…ð„ïˆðïïïîíí„ï‡ðŠñó„ôó„ñ‚ó‡ñ‚ð†ï îîíîïïïíí‹ìGëêéèæáßÜÚÛÛßãäæéêëìëëêêéêèèééêééèçæãàÝÙ×ÖÖÖ×ÙÛÛÛÜßààáââãäãääãããäååääââà„ß ÞÝÜÝÞÜÚØÕ!·µ´´³´·º¾ÃÅÅÇÊÌÑÒÔ×ØÕØÙØÙÜÞßàààáâ‡àßÞØÕÕØØÙÜÞßßàááãääæææ„è éèèæåææåæ†è -êêìììôõõöö…ìéééëëêëìëëîíëêêççèééëëë‡êììë„êììí…îíîðîîˆðñòðîíîï‰ðïî…í„ëŠí -ðððïîððîîî†ëìíîîíííïòôôòòð‰í†ì‡í ììëëééëíïïððï…í‰îí…ë„ê -ëêêéêèçêëí‡ì ëëéèççæåç„éæ‡ãááâàÝÚ××ØÙÝáãåèè„êéèèèçæ…èæäâßÝÙÖÔÒÒÒÔÖ×ØØÖ×ØØØÛÞ„à áàààâãããâàßß…ÝÛÚÚÚØ×ÕÔÿ€ÿ€ÿ€“€žž ¡¢£§¨¬­°´·¼½ÁÄÉÌÌÎÏÎÐÒÓÕÕÕ„×ÖÒÕÕÖØÙØ×Ö×ÕÕ×ÙÚÜÜÞßàââã…å æçççåååáàáâââ„äèéêêê…ì…êëëëìììíîííîíëêêèééêë…ì…í ìëëêéçéêê‡ëíîííîîîïïîïïðððïîïð…ïðïïïîïïîîîïîíîîŠð‚ï†îˆí‚î…ï ñòññðððïïîîï…ð„ïˆð ïïïîîîïðïððð”ñò…óñðï‡ð†ïîîííîîí†ìë‡êèèæãàÝÚØ××ÙÜßâåå†çæçåååæç„å2äãàÝÙ×ÖÖÖ×ÛÝÝÝÜÝßÞßàâãäãääãããáÞÞÝÝÛÛÙØØØ××ÖÖÔÓÓÐÎ̯°±²µ¶··¹·»ÁÅÇÌÎÎÏÑÒÕÙÙÙÚÜÝßàà„âàáàÞÝÜÛ„Ù%ØØÚÝÞßàáãäåææèèèéééêêêéèèèççéééêêëëìì†í‚î…í†ï„ñ îíëêêëìíî†ï…ñïïîíìëìí‡îï‡ñ óóñóóóôóòñóô…óôóóòñóóñññïîíîîŠð‚óñóóóòóõöõõôôóóòñññ…ð„ïˆð ïïïîîîïðïðððñò„óò„ñ‚ó‡ñ‚ð†ï îîíîïïïííŒì,êêéçãáÞÛÛÛÝàãæèéêëëëêêéêèèééêééèçäãàÝÙ×ÖÖÖ×Û„Ý#ÞààááâãäãääãããäååääââàßßßÞÞÜÜÝÝÜÚØÕ¹·¶¶µ´·º»ÁÄÅÇÊÌÐÒÓÖØÕÙÙÙÚÜÝßàà„âƒà„ÞÜØÔÔ××ØÛÜÝßßááãääæææ‡è…æç„è éêêêìììóóóõõ…ìéééëëêëìëëîíëêêæçèééŠëîíììêêêˆìíîðîîˆðñòñðððò…ðò„ð…íìëéêëŠíˆð‚î†ëì†íïòôôòòð‰í†ì‡í ììëëêëëîïðððïŽîì‰ê -ëêêéêèçêëí‡ì ëëéèççæåç„éæ‡ãááââÞÜÙÙØØÛßàäçèèêêêéèèèçæ…èæäáßÝÙÖÔÒÒÒÔ×ÙÙÙ×ÖØ×ØÛÞ„à áàààâãããâàßß…ÝÛÚÚÙØ×ÕÔÿ€ÿ€ÿ€“€žŸŸ¢¡¢¢¥§ª«°³µº½ÁÅÉÌÌÎÐÐÒÔÕÖ…×ÖÕÐÓÔÕÕØÖÕÔÕÓÓÔ×ÙÚÜÝßàââã…å æçææåååâââã†ä(èéééèêêêëëéééêêëëëìììíîííîíëêêçèéêêììíîî…ïîííìëéêêˆëíîííîîîïïîïïððññóóó…ñòññ„ðïïîðîîîïŠð‡ïˆî‚í…î ïðòññðððïïîîï‘ð„ïîîïððð’ñ„ð…ñòñðï‡ð†ïîîííîîí‹ìëëêéèçåãáÞÚÙ×ØÚÝáäå†çæçåååæç„å2äâàÛÙ×ÖÖÖØÛÝÝÝÛÜÝÝßàâãäãääãããâáááàÝÛÙØØ××ÖÖÕÔÓÑÏÍÊ)±²²³µ¶¶¶·µºÀÃÆËÎÎÐÑÓÕÙÚÚÜÞßáááâââàßßÝÜÚÙÙ„Ø-××ØÚÜÞßáãäåææèèèéééêéééèèéééêëêêëëëììíììëëëìì„íî†ï„ñîíëêêëëìíîïïðññ†òñðïïí‰îï‡ñ óóñóóóôõõöö÷…ôõôôôóôóòòñðîîîïŠð†óòŒñòññòôõõõôôóóòñññ‘ð„ïîîïððð‘ñ…òñ„ðòó‡ñ‚ð†ï îîíîïïïíí„ì‡í?ìëêêèæäáÞÜÛÜÝàäçèêëëëêêéêèèééêééèçäâàÛÙ×ÖÖÖØÛÝÝÝÜÞßßááâãäãääããã…äââàßßÞÞÝÜÛÜÜÛÙ×Õ#»¸··µ´¶¹ºÀÃÃÆÈËÐÒÔ×ØÕÙÚÚÜÞßáááâââàß„ÝÜÝÛÖÒÓÔÔÖÙÚÜÝßááãääæææ‡è…çèéèèé„ê&ëêêïïïððëëëììéééëëêëìëëîíëêêææçééëëëìì…íïïîííë‰ìíîðîîˆðñòôóõõõ…óôóóòñîî„íëêëëŠí‰ðï…ìëëì…íïòôôòòðŠí„ìˆí ìììëëëìîððññïŽîì‰ê -ëêêéêèçêëí‡ì ëëéèççæåç„éç…åäããáããáßÜÚÚÙÚÜÞâåçèêêêéèèèçæ…èæäáÞÜØÖÔÒÒÒÕ×ÙÚÚ„ÖØÛÞ„àáàààâããâáàßßÝÝÝÜÛÛÚÙØØÖÔÓÿ€ÿ€ÿ€“€žŸŸ  ¡¢¤¤¨¨¬¯²¶º¾ÄÈÌÊÍÏÏÒÔÕ…ÖÕÔÒÍÐÐÑÓÕÔÒÒÒÐÐÒÕÖÙÚÝßáââã…åæç…å äããäåäääåæééé…çèèççéê„ëìììíîííîíëêêççèéêìíîî†ïñðïïîŠíëíîííîîîïïîïïððñôöõô…õôóóóòòòñññòñððñŠðïïððñðïï‡î…íîîîðñññðððïïîîï‘ð†ïðñðñññ†ò‰ñð„îð„ñòñðï‡ð†ïîîííîîíìëêêèçæåáÞÜÚØØÛÞâäæ…çæçåååæç„åãáßÛØ×ÖÖÖ×ÚÜÜÜÛÜÝÝßßâãäãää‡ãâÞÛÙØØ×ÖÖÕÔÓÑÐÎÍÊ)±²²²´µµµ¶³·½¿ÂÇËÌÎÑÒÔ×ÙÙÜÝßàááààßÝÜÜÚÙØ×ׄÖÓÓÕØÙÝÞàãäåææèèèéééê…éêêêëìëëëìíìììëêêêëììëëìíî†ï„ñîíëêêêëìííïðñò†óôôòòñŠðï‡ñ óóñóóóôõ÷ˆø÷÷÷öõö„õòñððñŠð óóôôôóóóò‰ñð„ñ ôõõõôôóóòñññ‘ð†ïðñðñññ†òñ„ðòó‡ñ‚ð†ï îîíîïïïíí„ìí„îƒí„ë(êéåáàÝÛÛÞâåçéëëëêêéêèèééêééèçãáßÛØ×ÖÖÖ×Ú„Ü ÝÞÞàáâãäãää‡ã âáâàßßÞÝÜ„ÛÚÙ×Ô=¼¸·¶´³µ·¹½ÀÀÂÄÇÍÏÓÕØÔ×ÙÙÜÝßàááààßÝÜÚÚÙÙÚÚÙÔÐÑÒÒÓÖØÛÜÞáâãääæææŒèêêé‡ê#éèéééêêéêëììéééëëêëìëëîíëêêåæççéëëì‡íóòðð†ï…îíîðîîˆðñòóõ÷öö…÷öõõôôðð„ïŽíðñòòóñ„ð„íì„ë ìììíîñôôòòð–í„ì ëìíïðñññð„ïŠîë„èé„ê -ëêêéêèçêëí‡ì ëëéèççæåç„éç†åäããäæåäßÞÞÛÚÚÜàäæèêêêéèèèçæ…èæäàÞÛ×ÕÔÒÒÒÔ×ØØØÖÕÖÖØÚÞ„àáàààâãããâàßßÝÝÜÛÛÚÙØØØÖÓÓÿ€ÿ€ÿ€“€:žŸŸŸž¡¡££¨¦©­°´·»ÀÅÉÈÍÍÎÑÑÒÔÕÔÕÕÔÑÏÌÎÐÏÑÕÓÑÑÒÏÐÐÓÕØÙÜßáââã…åæç„åçäääåæääåææéééçåæ†çèê„ëìììíîííîíëêêççèéêìíîïð…îòñð†ï†îëíîííîîîïïîïïððñôööõ…øõôôôóôôóóóôòñòòŠð ïððññððïï†îíííìíííîðñññðððïïîîï‘ðïïðïïïð„ñ‡ò‰ñð„îð„ñòñðï‡ð†ïîîííîîíìëêêéèèèâàÞÛÙÙÛÞáäå…ç%æçåååæçåååäãàßÚØ×ÖÖÖ×ÙÚÛÛÚÜÝÝßßâãäãää‡ãâÞÛÙØØ×ÖÖÕÔÒÑÐÎÍÊ„±²„µ²´º½ÀÅÇÉËÎÏÒ×ØÙÛÛ܆Þ>ÛÙÚÙØÖÖÖÕÕÕÖÑÓÓ×ØÛÝàãäåææèèèéééêèéééêëêêìíëëìííìììêééêêëëêëìíî†ï„ñîíë„êëìíïññóô…ñõôô…óò†ñï‡ñ óóñóóóôô÷‰ø÷÷÷ö÷÷öööôòñòòŠð óóôõõôóóó‰ñïðñññôõõõôôóóòñññ‘ðïïðïïïð„ñ‡òŽñð„ïòó‡ñ‚ð†ï îîíîïïïíí„ìí…ï=ííìëëëìëæäáßÜÝÞáåçéëëëêêéêèèééêééèæãàßÚØ×ÖÖÖ×ÙÚÛÛÛÝÞÞàáâãäãää‡ãâáâàßßÞÝÜÛÛÚÛÚÙ×Ô¼¸¶´²³µ··½¾¾ÁÂÄÉÍÏÓÔÒ×ØÙÛÛ܆ÞÛˆÙÓÏÐÐÑÒÕ×ÚÛÞáããääæææ„èç„èéèèŠêé„è êêèêêììéééëëêëìëëîíëêêååæçéëëìíï…íôóòŒðíîðîîˆðñòóõø÷ö…ø„ö ôóóñññðïîïïŠí -ðñòôôòñððð„íì‡ëíîñôôòòð–í†ìíïñññòñ„ïŠîë‰è -êêêéêèçêëí‡ì ëëéèççæåç„éç…æåäããåæçæààßÞÚÛÜßâæèêêêéèèèçæ…èæãàÝÛ×ÕÔÒÒÒÔÖ×ØØÕÕÖÖØÚÞ„àáàààâãããâàßßÝÝÜÛÚÚÙØØ×ÕÓÒÿ€ÿ€ÿ€“€)ŸŸŸ ¡¢£¦¨«¯«¬¯³µ¹¾ÃÆÇÊËÌÏÒÒÒÓÓÔÔÒÏÏÎÎÎÍÍÏ„ÎÌÌÍÏÑÔÖ×ÚÜàáãä„åæçååˆçèèèééêëëéèêéèççèèéëì„í†îïîíìëê„ëîîïñòòóóôõòòôôôòóôôó†òƒñ…ð ñïîíîîóôö÷øö„ø ÷ööõõ÷÷ööõ÷õô„óòñ†ðñòóôôðð…ïîîííììëíîïðñññ„ò‡ñ†ò‡ñ -ððïïïðññöõ„óò†ðñññóõóóòññðïïïîîîïïïñññð„î„ï„î„íîîíí„îíîìêçé„ëêéêêéäßÜÙÙÜßáåèé„çæççæ„å„äàÜØ×ÕÓÓÕ×ØÚÚÚÙÚÚÛÝßß…áââããâáààÞÝÜÛÚÙÖÖÔÔÓÓÑÐÎÌ„²µ´´´³²µ·º¿ÅÆÆÉËÌÑÔÕ×ÙÜÜÜ„Ý&ÜÚÙÙÙØ××ÖÖÔÕÖÓÓÔÖØÚÝÞàãääæçèèéééêééêêëˆêëëêëëéèêéèççèèéëì„í†îïîíìëê„ëïïñóôïðððñòòôôôòóôôó†òƒñ…ðñó„ñóôö÷øö‰ø÷÷ööõ÷õô„óòñ†ð ñòóôôôóóóòòò„ñ -ïïïîîïðñññ„ò‡ñ†ò‡ñððïïï…ð…ñ„ð‚ñ„óòñññðïïîíîðððñðîïïðð„ñðïïï„î„íîîíí„ìíïïïí…îíìëèåäãßÜÜÞßáåèêëë…êééèèèçççæãÞÛÙØÕÕ×ØØÚÚÚÙÚÚÛÝßß…áââããâá„àßßÞÞÝÜ„ÛÚÙ×Ô½¹¸¶µµ·»½ÂÅÀÀÂÅÈÊÍÐÒÑÔÕ×ÙÜÜÜ„ÝÜÚÙÙÙØ××Ù×Ö××ÑÑÒÔÖÜßàâåÞàáââæ„èääååæ…åíííîîêëëéèêéèççèèéëì„í†îïîíìë‡çéêëñññòóòòôôôòóôôó…ïîîîíí„ð ññðîððóôö÷øö‡ø -÷öôóóóò÷õô„óòñ†ðñòóôôòñ…ðïïïîîîíìëìííîîîïï„î„íîîïïï‡î íííìììííí†î…íëêêêëììêêêéèèèæçèèèé„èé…èêìì„ëê„é‚ë†éççé‡ìëêêéæäàÝÚÚÝßáåèêêêé†èå„âàÝÙÕÓÐÎÍÍÎÑÕ×××Ö×××ÚÛ܇ÞßßÞÞÝÜÜÛÙÙÙÛÛÚÙÙÖÔÔÑÐÐÿ€ÿ€ÿ€“€#ŸŸŸ¢¡£¤§©­®ª¬­°²µ»ÀÃÄÈÈÉÌÎÐÐÐÑÎÎÍÍÍ…ËÏ„ÎÌÌÍÐÑÒÖÖØÛàáâä„åæçååæ‡çèèèééêëëéèèèçæåææçéëìíííˆîíìì…ëìîïðñòóóôõòòôôôòôõôôˆò‡ñ ðïîîîóôö÷ø÷…ø -÷öööøøø÷÷÷…õôôò†ñôôõõöððïïïððïïîíììëíîïðñññŠòó„ôƒò†ñ -ðððïððñóöõ„óò…ñðñññóõóóòññðïïî„ìîïïðñð„îƒï…î„íîîíî…ïîîëçé„ë„ê éæâßÜÜÞßàäèé„çæçç‡å ããàÜØÖÕÒÒÓÔ×„Ø ÙÚÚÝßÞàááàáá„âáààÞÝÜÚÚØÖÖÔÔÓÓÑÐÎÍ#²²²³µ¶¶µµ´µ¶º¾ÂÃÃÆÈÊÎÑÒÔÖÙÚÚÚÛÙÙØ×ׇÖÔÕÖÓÓÔ×ØÙÜÝßâääåçèèéééêéééŠêëëêëëéèèèçæåææçéëìíííˆîíìì…ëïïñòóïðððñòòôôôòôõôôˆò‡ñ óòñññóôö÷ø÷Œøƒ÷…õôôò†ñôôõõöôôóóóôóóóòñïïïîîïðñññŠòó„ôƒò†ñ -ðððïðððñðð‹ñ„ó -òñññðïïîíî„ïîîîïïð„ñðïï…î„í‚î‡íïïïí…îííëéæææãàßßßàäèêëëêêéêê„éèèèæäãÝÛØÖÔÔÔÕ×„Ø ÙÚÚÝßÞàááàáá„â áààßàßÞÞÝÝÜ„ÛÚÙ×Ô#¼¹¸·µ¶¹¼¿ÂÅÀÀÂÃÄÇÊÍÏÎÑÒÔÖÙÚÚÚÛÙÙØ××…ÖÙ×Ö××ÑÑÒÔÖÛÞÞáãÞààââæ„èƒä‡åíííîîêëëéèèèçæåææçéëìíííˆîíìì…çæçéêêñññòóòòôôôòôõôôˆï‚î†ñ„ðóôö÷ø÷‰øõõõôó÷…õôôò†ñôôõõöòòðððòñððïîîîíìëìííîîîŠï„ð‚ï†î„íììííŒîìêêêëììêêêéèèè†æç‰èêìì„ëê„é‚ë†éèçéë†ìëìêéèæäàÞÝßßàäèêêêé†èæäãââßÜÙÕÓÏÎËËËÏÓÕÕÕÔÖ××ÚÛÛÜÞÞ݇ÞÜÜÛÛÙÙÙÚÛÚÙÙÖÔÔÑÐÐÿ€ÿ€ÿ€“€Ÿ¡¡¢¢¦§©«¯¯¬¬­®°´¹¾ÁÂÄÅÆÉÊËË…ÌËËÌÌÍÍÍÏ„ÎÍÍÎÐÒÒÖÖ×Ûßàáãäåååæçåååæ†ç èèèééêëëéèçææ„äåçéëëìí‡îƒí„ìëëìíîðñòóóôõòòôôôóôõŠôóóóòòññðïîïïôôõöö÷†ø÷öö†ø ÷ö÷÷÷öõõô…ó…ôññðððïïïîííììëíîïðñññ…ò‚ó„ôõõõôôóòò‡ñðððñòó÷ö„õó…ñðñññóõóóòññðïïíìëëëìî„ï…îï†î„íîîíî†ïîíêë„íìêëëëéåâ„Þàäèè„ç æææååæèçååãáßÙ×ÔÒÐÏÏÑÓÕÖ××ØØÙÜÝÞ„ß„àááààßÞÜÛÚÚØÖÖÔÔÓÓÑÐÎͲ³³´¶¸¸··¶¶¸»¾ÀÁÂÄÆÈÌÏÐÐÓÔÔÕÖ×Õ†Ö ×××ÖÖÔÕÖÔÔÕ×ÙÙÜÜÞâãäåæçèéééêèèéé‰ê -ëëêëëéèçææ„äåçéëëìí‡îƒí„ìëëîïðòóïðððñòòôôôóôõŠôóóóòòññôòñòóôôõöö÷ø ÷ö÷÷÷öõõô…ó…ôññðððòòòñññïïïîîïðñññ…ò‚ó„ôõõõôôóòò‡ñðððñññðñ…ò†ñ„óòñññðïïî…íìììííí‡ï†î„í‚î‡íƒî‡íîíêççåâ„Þ àäèêëëêêééé„èçååäãàÛØÖÔÒÐÑÒÓÕÖ××ØØÙÜÝÞ„ß„àááàà„ßÞÝÝÝÜ„ÛÚÙ×Ô½º¹·¶¹»¾ÀÅÅÂÁÂÁÃÅÈÌÍÌÏÐÐÓÔÔÕÖ×Õ†Ö×××Ù×Ö××ÒÒÓÕØÚÞÞßãÞÞàââæ„èããää†å íííîîêëëéèçææ„äåçéëëìí‡îíííìééèççææèêêñññòóòòôôôóôõŠôóóóòòññò„ðôôõöö÷‰ø÷ööõõø÷ö÷÷÷öõõô…ó…ôññðððñððïïîîîíìëìííîîî†ï ðððñòòñðïïï‡î†í‚î…ï…îìêêêëììêêêéèèèææååäääææ‡çéëëëêêëê„é‚ë†éèèéììì„íìììëéèåâ„Þàäèéêêé„èççåäãâáÞÚØÓÐÎËÉÈÈÌÐÑÓÓÕØØÙÜÛÚÛ…ÜÝÝÞÞÝÜÛÛÚÙÙ×ÚÛÚÙÙÖÔÔÑÐÐÿ€ÿ€ÿ€“€)¢£¤¥¦¨ª«­²²¯¯®­°´·»½½ÀÀÀÂÁÂÄÄÅÇÇÉÊÊËÌÍÍÎφÎÏÑÒÓÖÖÙÛßàáããåååæç…å…çèèèééêëëéèèçæååááâåæéêìí†î…íîíìëëììîïðòóóôõòòôôôóõö‡õöööõõõôóòññðïïð„ôõõ÷”ø÷÷ö†õ‚ô„óòòòïîîíííììëíîïðñññ…òôõö„õöõõôôôò…ñò…ñòõøö„õô„òñðñññóõóóòññðïïîìëêêëííîîî„íîîîííîîî„íîîíî„ïñóðîìí„ïíëìíëëèäàÞÞÝßãæè„ç…åæèæäãàÜÚÕÒÑÐÍËËÍÏÑÓÓÔ×ØØÛÜÜÝ„ÞßßßàáàßÞÝÛÚÚÙ×ÖÖÔÔÓÓÑÐÎÍF´µ¶¸ººº¹¹¸¸»½¿ÀÀÀÁÃÄÇÉÊÉÌËÍÎÏÐÐÒÓÓÔÕÕ××ÙÖÖÔÕÖÔÔÕØÙÚÜÝàââãäæçèéééêèèèééˆêëëêëëéèèçæååááâåæéêìí†î…íîíìëëíïðññïðððñòòôôôóõö‡õ öööõõõôóòñõ„ó„ôõõ÷”ø÷÷ö†õ -ôôóóðïïïîò…ñ -ïïïîîïðñññ…òôõö„õöõõôôôò…ñò†ñòðò…ó…òñ„óòñññðïïîíîîíìëëëìììî…ïîîííîîî„íîîíí„îíìîí†ì5íïîëèçäàÜÛÜÝßãæéëëêêééèèèçæåãáàÞÛØÔÓÑÎÍÍÍÏÑÓÓÔ×ØØÛÜÜÝ„ÞßßßàáàßÞÞßÞÝÜÝÝÜ„ÛÚÙ×Õ=¾¼»»º»¾ÀÃÈÈÅÄÂÁÂÄÅÈÉÇÉÊÉÌËÍÎÏÐÐÒÓÓÔÕÕ××ÙÙ×Ö××ÓÓÔÖØÛÞßáäÝÞßáâæ„èââãää…åíííîîêëëéèèçæååááâåæéêìí†î…íëééèçåæçéêñññòóòòôôôóõöõõ…øùùùøøõôóòñóñððñ„ôõõ÷ˆøööõõõ‡ø÷÷ö†õôôóóòñ…ð‚ï„î íìëìííîîî„ïðñòòññòóòñððïïˆîííîîŒïìêêêëììêêêéèèèææååããäåå‡æéëëééêëê„éëëéê„ëèèéììì‡í2ìêéæâÞÝÝÝßãæéêêéèèèçææäâáßÞÚÕÓÏÌÊÉÆÄÄÇÌÎÏÐÔÙÛÛÞÜØÚ…ÛÜÜÝÝÜÛÛÚÙÙ××ÚÛÚÙÙÖÔÔÑÐÐÿ€ÿ€ÿ€“€)£¤¦¨¨©«¬®³³±±°­®±´¶¹¹»»»½½¿ÀÂÂÃÃÅÈÈÉÉËËÍφÎÏÑÓÕ×ØÚÝÞßáââåååæçä„å…çèèèééêëëéèèèçæåáááäåèêëí†îíííîîïîìëëììíïðòóóôõòò„ôõöõõ…ö÷÷÷öööõôòòñðïðð†ôö÷÷÷ˆø‚÷Šø†÷ööõõö„õððïïîíììëíîïðñññ„òôôööõô†õôôò„ñƒò„ñóõø÷„õô„òñðñññóõóóòññðïïîììêêë…í„ìíîîíííîî„íîîíî„ïñóñïìî„ïíìíííëéåààÞÝßãæè„ç†åæåãâÝÚØÒÐÐÎÌÊÊËÍÐÒÓÔ××ØÚÛ܆ÝßßàààßÝÝÛÚÚØ×ÖÖÔÔÓÓÑÐÎÍFµ¶¹º½»º»º¹¹¼¿ÀÀ¿½¿¿¿ÃÅÅÅÇÇÉÊÌÌÍÎÐÑÒÓÔÕÖ×ÖÖÔÕÖÔÔÖØÙÚÞßàäââäææèéééêçèèééˆêëëêëëéèèèçæåáááäåèêëí†îíííîîïîìëëíïïññïðððñòò„ôõöõõ…ö÷÷÷öööõôòòõóóó‡ôö÷÷÷ˆø‚÷Šø†÷ööõõóòòññôóóóññïïïîîïðñññ„òôôööõô†õôôò„ñƒò„ñòòðó„ôó…òñ„óòñññðïïîíîïîììëëëììí„ïîîîíííîî„íîîíí„îíìíí†ì4íïïëêèæâÝÜÜÝßãæéëëêêééèèèæääáàÞÛÚÔÒÑÐÍËËËÍÐÒÓÔ××ØÚÛ܆ÝßßàààßÝÞßÞÝÜÝÝÜ„ÛÚÙ×Õ=À½½¾½½¾ÁÄÈÉÇÆÄÁÁÁÃÄÄÃÅÅÅÇÇÉÊÌÌÍÎÐÑÒÓÔÕÖ×Ù×Ö××ÓÓÔ×ØÝààâåÝÞßààæ„èâââää…åíííîîêëëéèèèçæåáááäåèêëí†îíííîîëëéèçåææéêñññòóòò„ôõöõõ…ùø„ù -öõôòòôñðñò†ôö÷÷÷…øõõõóóŠø†÷,ööõõôôôóóòñððïîîîíìëìííîîîïïïððóóñðññòòññððï…î -ïîîîíîîïïð‰ïìêêêëììêêêéèèèæçæåãããääååå„æèëêééêëê„éëëéê„ëèèéììì…í4îîíëêèãÞÝÝÝßãæéêêéèèèçææäáàÞÜØÓÑÌÉÉÈÅÃÃÅÊÌÏÏÔÙÚÛÞÛØÙ…ÚÛÛÝÝÜÛÚÚÙÙ××ÚÛÚÙÙÖÔÔÑÐÐÿ€ÿ€ÿ€“€ -©©««¬­­®¯°„¶µ¶¶¶··‡¹&»½¿¾ÁÂÃÆÆÈÊËËÌÌÍÎÎÎÏÏÑÒÕÖØÚÛÞàâââææçèè†æ‰èë„êèèæãâßÝÝàãæêììˆîíííïïïîíìììîîîðñó„ô‰õ…öƒ÷†öôôôõõôôôóôóóññöö÷øø÷øùø÷ø÷÷÷ö…÷ -õóòïðñðððï†ðñòôôôõõ‡öõôòóôõõõòññóóôóŽòó„õôóò…ñ&ïïîíííëìëëëííîïïïðññïïîïïííìëìíîïïïðñðŠïîíìëëéåáÞÞàáãç„è!æççæååçéåàÝÛØÕÏÌÊÉÆÅÇÉËËÎÐÓØÚÛÜÜ܇ÝÞ…ßàâßÝÚÚÚ„ØÔÓÒÏË*¸¹¹ºº»¼½¾¾¾¿¿¿½¿¿¿ÀÀÂÂÂÁÁÃÃÅÇÈÈËÌÍÐÑÒÔÖÖÓÓ„Ô ÖÖØÙÛÝßáâáäå„æçèè†æ‰èë„êèèæãâßÝÝàãæêììˆî„íîîììîíîðññòóõõõôô‰õ…öƒ÷†öôôôõõôôôóôõö÷÷ø÷÷õõõø÷÷ø÷ø÷÷÷ö…ô -ññòóòñðððï†ðñòôôôõõ‡öõôòóóôôòñððññòó„ôó‹òôôóòññ„ðïîíììë‡êììíîîîïïîíìííììëëìíîííîîï…î…í<îîíìëéèäÞÝÝÝÞâåçèèèæççæååãâáßÝÝÛØÒÏÎÌÊÉËËÌÎÏÒÒÕ×ØØÜÝßßÞÞÞßßà…ßààßÞÞÞÝÛÛÛÞÜÛÚØÕ+ÀÀÂÃÃÄÅÆÆÇÈÉÉÉÇÅÅÆÆÆÇÇÇÆÆÃÃÅÇÈÈËÌÍÐÑÒÔÖÖÑÑÒ„ÓÔ×ØÚÛÝßßßáãääææçèè…æãääåå…èë„êååãàÞÜÚÙÝßãçééë‡îíííêëëééåååèèèêëìììîð‰õ…öƒ÷†öôôôõõôôôóôôôöö÷÷÷ööòôóô÷Žø÷õôóóó…õ -óòòðññðððî„ì -ííîïðððññò†óòð†ïíëêêêëì„ëíŽï‚î„íìëëêééèç…æççææç…è„æ ååæèééêêêˆëê„é4êëêéçæäàÛÙÙÚÛßâåèèèæççæååâàÞÛÚ×ÓÏÊÇÅÃÁÀÂÃÃÅÇÉÐÙÚÛÝÙÕ‡Ö×Ú„ÛÜÜÛÚÙÛÛÚÚÚÙÖÔÔÑÏÿ€ÿ€ÿ€“€««¬¬¬°°±³³¶·¹·¶¶¶··¸…¹(¶¶¸º»¼ÀÀÀÄÅÈÉËËÌÌÌÎÎÎÏÏÑÒÕÖØÚÛÞàâââåææçè†æ‰è…êèèçåãÞÝÛÞáçëìíˆîíííïïïîíìììîîîðñó„ô‰õ…öƒ÷†öõô„õ…ô óðññóôõõöù÷”ø‡÷õõôððññ‡ðññòò„ô‰õóòóôõõõòññóóôóŽòó„õôóòññòñññïïíííëì„ëƒí„ïñð„ïîííììííîïííëëëéåáÞÞÞàãç„è æåääãâäæãÞÛÙ×ÓÎÊÊÈÅÅÇÉËËÍÐÒ×ÙÚÜ܇ÝÞ†ßàâßÝÜÚÚØØÙØÔÔÓÑÌ ¹¹º¼¼¾¿ÀÁÁ¿¿À„¿0ÀÀÀÂÂÁÀÀÁÁÂÄÅÆÉÊËÎÐÑÓÔÔÓÓÓÔÔÔÖÖØÙÛÝßáâáäåææåææçè†æ‰è…êèèçåãÞÝÛÞáçëìíˆî„íîîììííîïñññóõõõôô‰õ…öƒ÷†öõô„õ„ô õö÷÷õôôññô÷öö“ø‚÷…ôòóôôóññ‡ðññòò„ô‰õóòóóôôòñððññòó„ôó‹òôôóòññððñððïîíìì„ê ééêëììíîîîïï„í…ì…í‡îˆí1ëëéèäÞÝÝÝÞâåçèèèæåääãâàßßÝÛÛÙ×ÑÎÌÌÉÉËËÌÎÏÒÑÕØÙÚÜކ߂à†ßàßÞßÞÝÛÛÝÞÝÜÜÙÕ+ÂÂÃÄÄÇÇÉÊÊÉÊÊÊÉÅÅÆÆÇÇÇÆÅÅÁÁÂÄÅÆÉÊËÎÐÑÓÔÔÑÑÑ„ÓÔ×ØÚÛÝßßßáãääåææçè…æãääåå…è…êååäáàÛÙØÛÞãçééë‡îíííéëëééåååçèèêêìììîð‰õ…öƒ÷†öõô„õ†ô õöôôôóóðóóóöøõõõóó…ö -ôôôòñññððî…íîîï„ð‰ñ‡ïíëêêêëì„ëíŽï‚î…í ìëëêééçæç„æåååç…è…æåç†éê‡ëê„é3êééèçæäàÛÙÙÙÛßâåèèèæåääãâàÞÜÚØÕÑÎÈÅÄÃÀÀÂÃÄÅÇÉÊÏÑÒÓÕ‡Ö×ØÚ„ÛÜÜÛÚÙÛÜÚÚÛÙÖÖÕÒÐÿ€ÿ€ÿ€“€¬­®®¯°±²³³¸¹º¹¹¸„¹*»º¹¹·¶¶¶·¹»½¿ÀÂÄÅÇÉÉÌÌÌÍÍÎÏÏÑÒÕÖØÚÛÞàâââåå‰æ‰èéêêêëêêéçåàÞÜÝàçëíî†ïîîíííîïïííëëëíîîïðòóôôô‰õ…öƒ÷†öõõõööõõôôõôóïïñòòõôõ÷ö÷ø÷“ø…ù ø÷õóóòòòñ‡òóôôôó‰ôóóòóôõõõòññóóôóŽòó„õôóòññòóòññïïîíììëëêëëììîïïïðð…ïîí„ìíîˆï…î:íììëëëéåáÞÞÞßãææçèçæååãááâãàÛÚ×ÕÑÍÊÉÇÆÆÇÊËËÍÐÑÖÙÚÜÜÝÞÞÞÝÝÞ‡ßààßÞÜÜÚÙÙÙØÕÔÓÑÌ»¼½½¾¿ÀÁÂÂÀÁ„ÁÂÂÃÂÂ…À"ÁÃÅÇÉÉÌÎÐÑÓÓÒÓÓÔÔÔÖÖØÙÛÝßáâáäåææåå‰æ‰èéêêêëêêéçåàÞÜÝàçëíî†ïîîíííìííìêíííïððñòôõõôô‰õ…öƒ÷†öõõõööõõôôõõö÷÷õôòððòõôõ÷÷“ø…ö õõõöôòòòñ‡òóôôôó‰ôóóòóóôôòñððññòó„ôó‹ò%ôôóòññððñññïïííìëêêêéèéééëìíîîïïîîîííˆìííî…íˆì:ëëéèäÞÝÝÝÞáäæçèçæååãááÞÜÜÛÚÙØÕÐÎÌËÉÉËÌÍÎÏÑÑÕØÙÛÝÞàààßßààáàŠß -ÞÝÝÝÞÝÜÜÙÕ(ÄÅÅÆÆÇÉÉÊÊËËÍÌÌÇÈÈÈÉÈÇÇÅÅÀÀÀÁÃÅÇÉÉÌÎÐÑÓÓ„ÑÒÓÓÔ×ØÚÛÝßßßáãääååˆæãääåå…èéêêêëççæãâÝÚØÚÜãèéêì…ïîîíííéééèçåäåæèçéêëììîð‰õ…öƒ÷†ö -õõõööõõôôõ…ô -óòòòïòðñô÷Žø÷öõõõ…ø -÷öõõôòòòñð…î -ïïððïïððññ…ðˆïíëêêêëì„ëíŽï‚î„íîíëëêééèççææåæäãäæçç„èçèçææç‡éêëêŒé:èçæäàÛÙÙÙÚÞáäçèçæååãááÞÛÙ××ÓÏÌÈÅÃÃÁÁÃÄÄÅÇÈÈÊÎÎÐÓÖ×××ÖÖ×ØØÚ„ÛÜÜÛÛÙÛÜÛÛÛÚÖÖÕÒÐÿ€ÿ€ÿ€“€ °°°²²²³´´µº»¼„½„¾½¼º¹¸¸·¹¹º½¿ÀÂÂÃÅÇÈË„ÌÎÏÏÑÒÕÖØÚÛÞàâââäååææ…åæ‹èêëìëëëêèæãààâçìîî†ð‚î„íîîíìêêëìîîîðñòôôô‰õ…ö‰÷öõ„öõõõöôóïîòóóõõóõôõ÷öö÷÷÷—ø…ö‚õ‰ôóòóôôó†òññóôõõõòññóóôóŽòó„õ ôóòññòññð„ïíííëê„éëíïïïðñðððïïïîííìììíî‡ïî„íì…ë.éåáÞÞÝßãåææçæåääãàÞßáßÛÚ×ÔÑÎËÊÊÈÉËÌËËÍÎÐÕØÙÜÝÝŽßàßÞÝÜÛÚÚÚØÖÕÔÑÌ ¾¾ÀÀÀÁÂÃÃÄÂÃ…ÅÆÆÇÆÅÄ„Â&ÁÃÃÄÇÉÉÌÌÍÐÑÑÑÒÒÓÓÔÖÖØÙÛÝßáâáäåææäååææ…åæ‹èêëìëëëêèæãààâçìîî†ðîîíííìììëêììíîïïðñóôõôô‰õ…ö‰÷öõ„öõõõöööõõõôóñññóòóõöö÷÷÷”ø÷„øöööõõ‰ôóòóôôó†òññóóôôòñððññòó„ôó‹òôôóòññ„ðïîîîííìëêêéçèçèéëíííîïïîïîî„í…ì‡í…ì…ëéèäÞÝÜÛÝáäåæçæåääãàÞÜ„ÚÙØÕÑÎÎÍÌÌÎÏÎÎÏÐÐÓ×ØÚÝ߆àááà…ßÞßßààÞÝÝÞßÞÝÝÚÖ)ÇÇÈÉÉÊËËËÍÍÎÏÏÏÌÌÍÍÍÌÊÉÇÇÂÂÁÃÃÄÇÉÉÌÌÍÐÑÑЄÑÓÓÔ×ØÚÛÝßßßáãäääååææ…åãääåå‡èêëìèèèæåãßÝÝßäéëëì…ðîîíííéééèçããäæççèêêëìîð‰õ…ö‰÷öõ„öõõõöõ…ô óóóîïîðòöö÷÷÷ø‚÷ˆø÷÷öööõó‰ðïïïðð†ïƒî…ïíëêêêëì„ëíŽï‚î…íìëêêêééççæåääâáâåæææ†èçæè„éèŽéè„ç/æäàÛÙØØÙÝàäæçæåääãàÞÛÙØ××ÓÎÍÉÆÅÄÃÄÆÆÅÅÆÈÈÌÎÐÓÕÖˆØÚ‰Û ÝÝÜÛÜÛ×ÖÖÔÑÿ€ÿ€ÿ€“€°±²³³µµ···»¼¾¿¿¿…À)¿½¼º»º¹º»»½¿ÀÃÁÃÄÆÆÊÊÌÌÌÎÏÏÑÒÕÖØÚÛÞàâââääˆåæ‹èêë„ì êêêæããäçìîï†ð‚î‡íëêêêìîíîðññôôô‰õ…ö‰÷ööö÷öööõõöôóîîðññóóñõóô÷ööö„÷øøø÷–ø÷ö†õ ôôôóòòôôó…òñññóôõõõòññóóôóŽòó„õôóò„ñðïïîïï„í êéèèèêíïîïï„ñðïïïîíìëìííïïî‰íìê„ë éåáÞÞÝßâä„æ!åãâàÝÛÞáßÛÚØÔÒÏÍËÊÊËÍÍÌËÍÎÐÕØÙÜÝÞŽßàßÞÝÜÛÚÚÚØÖÕÔÑÌ&¿ÀÀÁÂÄÄÆÆÆÃÅÆÇÇÇÈÈÈÉÈÇÆÄÃÅÄÃÄÅÅÇÉÉÍËÍÏ„ÑÒÒÓÔÖÖØÙÛÝßáâáäåææääˆåæ‹èêë„ì êêêæããäçìîï†ðîîíííìììëêìììîïïðñóóõôô‰õ…ö‰÷ööö÷öööõõöööõõôóñðððòñòôööö„÷øøø÷–ø÷ö†õ ôôôóòòôôó…òñññóóôôòñððññòó„ôó‹òôôóòññðððïîîííîíìëêêèçæææèëíìíî…ï îîíîíìëëììííŠìëêëëëéèäÞÝÜÛÝàãåæææåãâàÝÛÛ…ÚØÕÒÐÏÎÌÎÐÐÎÎÎÐÏÒÖØÚÞààá„àááà„ßÞÝßßàà„ÞßÞÝÝÚÖ:ÇÉÉÊÊÍÍÎÏÏÎÏÑÒÒÎÏÏÏÑÍÍËÉÈÅÄÃÄÅÅÇÉÉÍËÍÏÑÑÐÐÑÑÑÓÓÔ×ØÚÛÝßßßáã„äˆåãääåå‡èêëìéééççæãßßáäéëëí…ðîîíííéééèæãããåçæèêêêìîð‰õ…ö‰÷ööö÷öööõõöõôôôòòñññìïîîñööö„÷øøø÷–ø÷ô†ñðððïïïðð…ï„î…ïíëêêêëì„ëíŽïîîíííìëëëéêëééèççåããáßáåæææ‰èëééçèŽéè„ç/æäàÛÙØØÙÝàãæææåãâàÝÛÙØØ××ÔÎÍÊÈÆÅÄÆÈÇÆÅÆÈÉÏÒÔ×Ø׈ØÚ…ÛÚÛÛÛÝÝÜÜÜÛ×ÖÖÔÑÿ€ÿ€ÿ€“€±±²³´…¶ ½¾¾¿ÀÁÁÁÀÀ¿¿¿„¾!½¼»½½¾¿¿ÂÄÅÇÈÈÉÌÐÑÍÎÏÑÓÔÖÖ×ÛÝßááá…æääåååæ‹èéêê…ì ëëêééííîîîñ„ðïïïîîîíìëëééêìííîðñòòôõõöõõ…ö’÷‡ö„õóòñò÷÷÷øùõõööö÷ööö÷÷–øƒ÷†ö„õôòôóòòñññðññô÷ùùøøø„÷ôñððñ…òó…ôõõõóõ„öôñð…ïííïïïîíëéêëëìíïïð…ñðîíìëì„íîïî‡íë†ê/çáÞÜÛÜàãåäääââàÞÜÜÛÚÛÛÛØÔÑÍÊÌÎÍÎÏÏÏÍÍÍÑØÚÞáÞÜÝÞ…ßà…ßÝÜÜÝÞÞÝÜÚÚÛÛÚ×ÕÏÂÂÂÃÆ…ÇÆÆÇÈÈÊÊÊÉÉÈÈÇÆÆÈÈÇÆÅÇÇÈÉÉÊÊÌÍÏ…ÑÔÔÖÙÙÚÜÜÞâáâäää…æääåååæ‹èéêê…ìëëêééííïññóòñññïïïîîîíì…ëíïïðñóôòôõõöõõ…ö’÷‡ö„õóòñòðððñóõõööö÷ööö÷÷–øƒ÷†ö„õôòôóòòñññðññôóòò‡ðòóòññó‰ô/óòòòñððïîîïïîîîíííììëéèçæçèèèêëìíîïðððïïïîíìëëê„ìíìëŒê6èåàÝÛÛÜàãåäääââàÞÜÜÛÚÛÛÛÜÜÚÕÓÑÐÏÏÐÑÐÎÎÎÏÐÓ×ÚÜÞßàááààáà‡ßààááàßÞÞßßÝÚÙÖÏÍËËÈ…Ë2ÌÍÎÎÏÑÑÐÐÐÍÍÍÌÌÈÈÇÆÅÇÇÈÉÉËÌÎÐÐÎÏÐÑÑÑÓÔ×ØØÚÚÜßßáâãã…æääåååãääååääåååèèéêê…é -èççææééççç…êïïïîîëééèçãâãåæåæçééïïñòóõõ…ö’÷‡ö„õóòñòêêêìíõõööö÷ööö÷ôõõ„öŒø÷õõõôôóóóòòóóòñòñð…ï îîíííîðñððïïî„íëéêêîí„ëí„ð„ï„îííìëëëê…éèççååäãããåäãäåæèêêéèêëééççç†éè‹ç8äáÞÙÖÖ×ØÜàåçççæâÝÛØØØ×ØØØÕÓÏÌÉÈÇÇÇÈÉÈÆÆÆÈÌÎÒÕÕÕÖ×Ø××ØÚÜÜ„ÛÚÙÚÛÜÜÛ…Ù×ÖÔÑÿ€ÿ€ÿ€“€³³´µµ…º2¿ÀÀÂÂÃÃÃÂÂÂÁÁÁÀ¿À¿½¼½½½¿¿¾¿ÀÃÃÆÈÉÎÏÌÎÏÑÒÓÖÖ×ÛÜßááá…åääåååæ‹èƒêˆìëëííîîî‡ðïïïîîíììéèéëììíîððòóô„õ†ö—÷ööõõõóòòò÷öö÷øõõööö÷ööö÷÷÷›ø‚÷…ö„ô òòñññððñóöùùù†øõòññ†òó…ô -õõõóõöööõò‡ïííïðïîîëéêëëìííïïð„ñðîîìììŽíì…ëéæáÝÛÚÛßâäãäâáßÝÜ„ÚÜÝÛØÕÒÎËÎÐÐÑÑÒÐÍÌËÐØÚÞáßÝÝÞ…ßà…ßÝÜÝÝÞÞÝÜÚÚÛÛÚ×ÕÏÂÂÃÄÆ…ÊÈÈÉËËÌ…ËÉÉÉÈÉÉÉÇÆÇÇÇÉÉÈÉÊÍÍ…ÑÓÔÖØÙÚÜÜÞâàâäää…åääåååæ‹èƒêˆìëëííï‡ñððïïïîîíììëêëííîïñññòóô„õ†ö—÷ööõõõóòòòðîîðñõõööö÷ööö÷÷÷›ø‚÷…ö„ôòòñññððñóóòòòðð„ñòôóóòó‰ôóòòòñðð‡î„íììëééèçç„èéììîî†ïîîììë‡ì‡ê…ëêèäÞÛÚÚÛßâäãäâáßÝÜ„ÚÜÝÛÜÞÚ×ÔÓÒÒÒÓÓÑÎÎÎÏÐÓ×ÚÜÞß…àáà†ßàààááàßÞÞßßÝÚÙÖÐÎÍÍɆÎ1ÏÑÑÑÓÓÓÑÑÐÎÎÎÍÉÉÉÇÆÇÇÇÉÉÈÉÊÍÍÍÎÏÐÐÑÓÔ×ØØÚÚÜßßáâãã…åääåååãääååääåååèèêêêˆéççëééçç…êððïïïëëéééâáâäååæèêêïïðññõõ†ö—÷ööõõõóòòòêêêëìõõööö÷ööö÷óó„õöö÷ø„öƒõ‡ó„ð ïïîîíííîï„ðïî„ìëéêêîí„ëí„ð„ïîîîííì„ë†éèççæåãááâââããååç„èêëêééè‡éŒçäáÞØÕÕ××ÛÞäççæäßÚØ„×"ØÙØÕÓÐÌÉÊÉÉÊËÊÉÆÆÅÇÌÎÒÕÖÖÖ×Ø××ØÚÜÜ„ÛÚÚÛÛÜÜÛ…Ù×ÖÔÑÿ€ÿ€ÿ€“€¶¶¶·¸…º¿ÀÀÁÂÃÃÃÁÁÃÃÃÂÂÀÁÀ¿†½»¼½ÀÀÂÄÆÊËËÌÎÏÑÓÔÔ×ÙÜÞßáá…ã‚ä„æ‰èéêêêë…ìíííììííîïîïðððñññ„ðïîíìêêêëììíîïïñòôôõôôõõöõõööö•÷…öô„ó òñóôôôõõööõõ…öƒ÷˜ø…÷ööõõôóóóòòòññòõ÷öõõ†ôóòò‡ó…ôõõõóò„ñðïïïîîïïííîîíìëê…ëìíîïðððññðïîíìíííììì‰íì…ë+éæáÝÛÚÛÝàâããáÞÝÜÚÙÙÙÚÜÝÝÜÚ×ÔÐÐÑÑÒÓÔÒÏÍÌÏÔÖÚ…ÝÞÞßßßàà„ßÞ„Ý ÞÝÜÚÚÛÛÚ×ÕÐÃÃÃÅÇ…ÉÈÈÉÊ„Ë ÊÊÌÌËËÊÊËÊɇÇÉÊÌÍÐÑÐÑÑÒÓÔ×ØÙÛÛÝààáãää…ç‚ä„æ‰èéêêêë…ì íííììííîð„ñòóññ„ðïîíìììëíííîïððñòôôõôôõõöõõööö•÷…öôóóóñððñòôôõõööõõ…öƒ÷˜ø…÷ööõõôóóóòòòññò„ôó…òóõôôóô„õ…ôóòòòññðððïîîííììíí„ìëêéé„èéêëìíî†ïîíìììê…ëêèäÞÛÚÚÛÝàâããáÞÝÜÚÙÙÙÚÜ„ÝÚ×ÔÓÒÒÔÕÕÔÑÏÎÏÒÕØÛÞÞßß„àáàà„ßà…á -àßÞÞßßÝÚÙÖÒÐÏÎ̆ÎÏÐÑÑÒÒÒÑÑÑÐÐÐÏÊËÊɇÇÈÊËÌÈÉÉÊËÐÑÒÕÖØÙÙÜßÞßá‡âááâââãääååääåååéêêêëŠéîíìéèé„ê#ññðððìëëêéãããäåçèéêêîïððñðññòóõõööö•÷…öôóóóîíííîôôõõööõõööòóóóôôôõõõ‘ø÷öõôô„óòñòñïïïîîîíîïððïîîì…ëêìëïî„ìî„ð„ïîíííìëëëêééèèè„çæåäâ…áâãäåæ„èêëë„é’çäáÞØÕÕ××ÚÝáããáÞÛØ…×ØÚÚ×ÕÒÎËËÊÊËÍÍËÈÆÆÇËÎÒÕ„Ö×Ö×ØÚŒÜÛ…Ù×ÖÔÑÿ€ÿ€ÿ€“€„»½…¾ÀÀÁ„Ã*ÁÁÃÃÃÂÂÂÃÂÁ¿½½¼¼¼¶·¹¼¼¾ÀÂÆÇÉËÍÏÏÒÔÔÖÙÜÝßàà…ßääåååæ‰èêêëëë…ìëìì„íîïïîîðñ„ò ñññðïîîííìíí„ïðññòˆôõõöö÷†ø÷÷öööõôôôõòòòóôôôõõöôôõöôõõ„öƒ÷šø÷öö÷öööõõõôôôõõôôô…ó…ôõŠôõõõóñðïïîïïïîíîïï„íìëêêëêêéêëëííîïïññðïï…í…ëì†í†ì,ëèâßÜÙÙÜÞáâáÞÜÛÚÙÙÚÙÚÜÞÞÞÝÚ×ÔÒÒÒÔÖØ×ÔÑÏÏÒÕØÛ…ÝÞßß߆àßßÞÞÝÝÝÜÚÚÛÛÚ×ÕÐÃÃÄÆÈ…ÉÈÉÊÊ„Ë*ÊÊÌÌËËËÌÍÌËÊÇÇÆÆÆÇÇÊËÌÐÑÑÑÐÑÑÓÕÖØÚÛÝàßáâää…ç†æ‰èêêëëë…ìëìì„íîïïññòóôòòòñññðïîîïîîî…ïðññòôôõõöööôõõöö÷†ø÷÷öööõôôôõòòòóôôôõõöôôõöôõõ„öƒ÷šø÷öö÷öööõõõôôôö÷öö†õööõõô…õ…ô4óòòòñððïïîíííìììííììíïîíìëêééèèéêëëìííïïðïïííììêéèééˆêë„ì.ëéæàÝÛÙÙÜÞáâáÞÜÛÚÙÙÚÙÚÜÞÞßßÜØÖÔÔÔÖØÚØÕÒÐÐÔÖÚÝÞ„ßàààá†àáâááàáàßÞÞßßÝÚÙÖÔÒÑÐÎ…ÐÏÐЅ҃фÐ#ÌÍÌËÊÇÇÆÆÆÅÆÈÊÊÂÃÃÅÆÏÐÑÔÕ×ØÙÜßÝßááá‡Ýßßßãääååääåååêêëëë…éè„é-ððîììèèêêëòòòññííìëëçæåææëëëììîîïððììíîîôõõöö÷†ø÷÷öööõôôôõòòòóôôôõõöôôõöðñòò„ó‚ôø ÷÷øøø÷ööö„õ -óóóôóóòòòñ„ðíìììê„éëëììñï„ìî„ð„ïîíìììëê„é&çååääåååäãáßßÞÝßááããäæçèèëìëêéééçæååææ‡çè„éæâßÙÖÖ××ØÛÝÞÝÛØ؆×ØÚÛÙÖÔÐÍÌËÌÍÏÑÐÍÊÈÈËÎÑÕ†Ö×ØÚ†ÜÝÝÜÜÛÜÛ…Ù×ÖÔÒÿ€ÿ€ÿ€“€½½½¿À…Ã2ÂÃÃÄÅÅÄÄÄÃÃÃÂÂÂÃÃÃÂÀ½½¼»»³´µ·¸½¾ÀÄÅÉÊÌÎÏÑÓÔÕØÛÜÞàà…ßääåååæ‰èêëë‡ìêëëìíííîïïîîðñòôòòòñññðïîï„î†ðñòóôó†ôõõö÷‡ø„÷õôôôö„ôóôôõõõôôõöôôõõõööö÷÷šø„÷øøø÷÷÷öõöööõôôõ…öôôôõõŠô+õõõóñïïîîïïïííîïïííîîíììëëêééêëëìíííïðññïïî„íëëêëëì†í…ìííêãàÝÙÙÛÝàáà݈ÚÜ„ßÜØ„Õ ØØÛÙÕÒÐÐÒÕØÛÞ„ÝÞßß߇àßßÞÝÝÝÜÚÚÛÛÚ×ÕÐÃÃÅÇȇË0ÌÌÎÎÌÌÌËÌÌËËËÍÎÍÌËÇÇÆÅÅÄÄÆÈÉÏÐÑÐÑÐÑÓÕÖØÙÚÜßÞàâää…ç†æ‰èêëë‡ìêëëìíìíîïïðñòóôôòòòñññðïîñïïïñ†ðñòóôõõõööôôõõö÷‡ø„÷õôôôö„ôóôôõõõôôõöôôõõõööö÷÷šø„÷øøø÷÷÷öõöö÷÷öö÷„ùøööö†õ…ô5óòòòñðïïîîíííìììííììîïïííìëêéééèéêëëìíïïðïïîíììêéèèèé‡êë…ì ëçâßÜÙÙÛÝàáà݈ÚÜßßßàÝÚÖÖÖ×ÙÛÝÛØÔÒÑÔÖÚ݆ßààá†àâââáàáàßÞÞßßÝÚÙ×ÕÓÒÒÏ…ÓÑÓÓ†ÔÓ…Ð#ÍÎÍÌËÇÇÆÅÅÂÃÅÆÇÂÂÃÄÅÎÐÑÓÓ×ØØÛÝÝßàáá‡Ýßßßãääååääåååêëëìì…éççèééòððíìèèêëëôòòòñîîììëéçççè†íîïïðìììîîôôõõö÷‡ø„÷õôôôö„ôóôôõõõôôõöððñññ…óŒøöö÷øøöö÷øööõõõôóó„õ„óñóðíìëëë„êìëîîñï„ìî„ð„ïîíììëëê„é&çååããäååããàÝÝÜÛÞááâãäåæèèëìëêéééçæåååæ‡çè„éçäáÛØ„×ÚÝÞÝÚˆ×ÙÛÛÚØÕÑ„Î ÑÓÔÓÎÌÉÉËÎÑÕ×…Ö×ØÚ†ÜÝÞÞÜÛÜÛ…Ù×ÖÔÒÿ€ÿ€ÿ€“€»¼¼¼½ÂÃÃÃÄÂÃÃÅÆÅÅÅ…ÄÃÃÂÂÁ„À$¾»¹¶µ´¶¸ºÀÂÅÇÇÉËÍÏÐÓÓÔÖÚÜÞàààááââæææ‡èçèéêëìëëêêêëëë„ìííëíìëíïðññðññòòóôòò‡ñ -ððïïïðñññò…ôòôôõõõ„ö÷„ø÷øøø„÷‚øŠ÷õôôôóôôô‡õ…ô„÷ø÷÷¦ø÷„øõ÷÷ôøöõôôõóõõö…õ ôôóòñññðïïí„ìîïïííí„ì"ëêéëìëêêìëíîðïðòññîìììëììêèéëíìëëì„í îîíìëæáÞÝÛÛ„Ý+ÛÚÚÚÙÚÛÜÜÞààßÝÚØÖÕÕ×ÚÝÞÞÚÖÑÐÍÐÕÛÝÝßÞÝÝßßßàà…áàßÝÜÝÜÛÚÛÚÜØØ×ÎÇÈÉÉÉ„ËÌËËÌ„Î͉ÌËËËÉÉÈÅ„ÃÅÇÍÎÎÎÐÎÏÑÔÖ×ÙÙÚÝÝßâã„ä…æ‡èçèéêëìëëêêêëëë„ìííïñðïñïðññðññòòóôòò‡ñ -ððïïïðñññò…ôòôôõõõ„ö÷„ø÷øøø„÷‚øŠ÷õôôôóôôô‡õ†ôõööö÷÷«ø÷÷øöøôóóò÷ööö÷ô„õ ôôóòñññðïïî„ïîííììí„î`ìëéèèèéêëêìíîíïðïððïíìêçåææçéêêèéêëìííîîîíìçâßÞÝÝÞÞÝÝÛÚÙØØØÚÛÜÞààßÝÚØÖÖÖØÜÞàßÜ×ÓÒÑÒÕÙÜßààßßàááàà„áããâáàààßÝÞÞàÜÛÙÕØÖÔÒÒÑÒÓÓÓÑÓÓÔÔÓÓÓ…Ò&ÐÐÌÌËËËÉÉÈÅÃÇÆÁÀÂÃÆÇÇÉÌÍÐÒÓÕØØØÛØÙÝÞÞÞ„àƒã„äåååäåæççìëëêêêëëë„ìíííîííîïðññðññòòóðïï‡î -ííìììíîîîï…ðòôôõõõ„ö÷„ø÷øøø„÷‚øŠ÷õôôôóôôô‡õ…ð ñòóóó÷÷øøøöö‘ø÷‰ö…õóñòòñóîññêïììîëñññïïð„ñ ððïîîíîíìëè‡æƒå„äâáà…ßàßâäæäæéëìëëééçå„ãDæççåæçèèééêëèåäßÚ×ÖÕÕÖØÚÜÝÞàáàáâÝØÛÜÝÜÚ×ÔÒÐÎÏÔÖ××ÔÏËÉÉÉÍÓÕÖØ×ÖÕ×ØÚÜÜ‡Þ ÜÚÛÚÙØØØÚ×ÖÔÑÿ€ÿ€ÿ€“€ ¼¼½¾¾ÃÃÃÄÄÃÃÄ…Å…ÄÃÃÂÂÁ„À$¾»¹´³²³´·¼¿ÂÄÇÉÊÍÎÐÒÓÔÖÚÜÝßßààââãæææ‰è éëëìëëêêêëëë„ìííëíìëíïðññðññ†ò‚ñ…ò -ñðððïñññòò…ôòôôô„õ öö÷÷øøø÷øøø÷‚õ†ô‡õ…ôõõ÷÷÷ö÷«øö÷ø÷ò÷øøøöø÷ôõ÷„öõôôò„ñ‚ï†îïïïíí„ì`êèèéìæåëíñðëîïíïññîìììëììêèèêíìëííïîííîîíìëçãßÝÜÛÛÜÝÜÚÚÙØØÚÛÜÝÞààÞÝÚØÖÕÕØÛÝÞßÝ×ÓÐÍÐÕÛÝÝßßÝÝßßààà†áßÞÝÛÚØØØÚÜØØ×ÐÈÈÉ…ËÌÌËËÌ„Î͉Ì)ËËËÉÉÈÅÃÂÀÁÁÃÉÌÌÌÍÎÏÑÔÔ×ÙÙÚÜÝßáââääåæçæææ‰è éëëìëëêêêëëë„ìííïñðïñïðññðññ†ò‚ñ…ò -ñðððïñññòò…ôòôôô„õ öö÷÷øøø÷øøø÷‚õ†ô‡õŠôö÷¬ø÷øøó÷†øõ÷÷„öõôôò„ñ‡ïîíííìí„ïîêéçæâãéëïíêìíìíïððïîìêçåæææè„êì„í îîîïíèäáÞ…Ý,ÜÚÚÙØØÚÛÜÝÞààÞÝÚØÖÖØÙÝßàáÞÙÔÒÑÒÕÙÜÞààßßáááàà„áãäâáàßÝÜÜÜÝàÜÛÛ×ÖÖÓÐÐÓÓÓÔÔÓÓÔÔÔÓÓÓ…Ò#ÐÐÌÌËËËÉÉÈÅÃÅÄ¿¼¾¿ÃÄÄÆÌÍÏÒÓÕØØØÚØÙÜ„Þààâããã„ä…å æççìëëêêêëëë„ìíííîííîïðññðññòòòïïïîî…ï -îííììîîîïï…ðòôôô„õ öö÷÷øøø÷øøø÷‚õ†ô‡õ…ð ïïñññö÷øøøööö•ø÷‰öôõõöõõðòöïëóøøõòòñìî…ó òððïîîîíììé…çƒæ†åâàßßÞÛÝâåèæáäåãçëìëëééçå„ãåççæç…é:ëëèæäàÜØÖÕÕÕ×ÙÚÜÞÜÜÜÝßÜÙÛÜÜÛÙ×ÔÒÐÎÑÔÖ×ØÖÐËÉÉÉÍÓÕÖØØÖÕ×ØÛÜÝ„ÞßßÞÜÛÚØ„×Ú×ÖÖÒÿ€ÿ€ÿ€“€„¾¿ÃÃÄÄÅÄĆŅÄÃÃÂÂÁ„À$¾»¹´±¯¯°µ»¾ÁÄÆÈÉÍÎÏÒÒÓÖÙÛÝßßßàâãäæææ‡èéêêëëìëëêêêëëë„ìííëíìëíî…ð‚ñ‡ò…óò…ñòòóó…ô†óôôôõööö÷÷÷øøø÷ø÷÷ööŠ÷öõõ…ô‡õ…ô õõõö÷õöö÷«ø ÷÷ö÷òðôõö÷ø÷ô…ö õôôóòòñðï…î…ïí„ìêçéèèêíìéíòóòðòóññî…ì íêèèéëìííîï„î ïîîíèäáÞÜ…ÚÙ„Ø:ÚÜÞÞßßÞÝÜÙ×ÖÖØÙÝßààÞÚÓÐÎÐÓÙÛÜÝßßÞßááàáâááàáàßÞÜÛÙØØÚÚÜÙÙØÑ ÉÉËÌÌËÌÌÌÍÌÌÍ„Î͉Ì)ËËËÉÉÈÅÃÀ¾¾¾¿ÈÊËËÍÍÎÑÓÔÖÙÙÙÜÝßáââãäåæçæææ‡èéêêëëìëëêêêëëë„ìííïñðïñî…ð‚ñ‡ò…óò…ñòòóó…ô†óôôôõööö÷÷÷øøø÷ø÷÷ööŠ÷öõõ…ô‡õ…ôò„ôõöö÷¯øõó÷õõöøø†öõôôóòòñð‡ïî„í„ïîíëèææçæâçìîíëíïïððïîìëè„æçéêêëìííîîîïïïîêæãàÞÜÛÜÜÚÙ„Ø:ÚÜÞÞßßÞÝÜÙ×Ö×ÙÛÞááâàÛÕÒÑÑÔØÛÞßàààáââàáâááàâãâáàÞÝÜÜÝÝßÜÜÜ× ÕÔÓÑÐÓÓÓÔÔÓ„ÔƒÓ…Ò-ÐÐÌÌËËËÉÉÈÅÃļ¹º¾ÁÃÄÆËÌÏÑÓÔØØØÚ×ÙÜÝÞÞÞàââããã„äåååæ„ç ìëëêêêëëë„ìíííîííîî…ðññòò„ïî…ï -îîîííîîïïï…ð†óôôôõööö÷÷÷øøø÷ø÷÷ööŠ÷öõõ…ô‡õ…ðïïïðñõöö÷øõõöö÷“ø†÷„ø÷÷øø÷÷öõîíñôîìñíîñöö†ó -òñðïïîîíìé…çèçææ…å=âàáßÝÞááÝáååäãåéëìëëééèæåãããäæççèéééêëëëéçæâÞÚ×ÕÔÓÔÔÖØØÙØØÚÜÜ„Û)ÚØÖÔÒÑÑÒÖØÙÙ×ÓÍÊÉÉÌÑÔÕÖØØÖ×ÚÜÝÝÞÞÝÝÞÞÞÜÚÙ„×ØÚ×××Óÿ€ÿ€ÿ€“€„¿ÀÄÄÄÅÅƇŅÄÃÃÂÂÁ„À$¾»¹´±­¬­³¸¼ÀÃÆÇÉÌÌÏÑÑÒÔØÚÜÞÞÞàâäåæææ‡è…ë ìëëêêêëëë„ìííëíìëíîïðïïððð„ñòóó†ôó…òóˆôòòññòòòóóôõõöö÷øøø÷øø÷ööŠ÷ööõõõôôô‡õ…ô öö÷÷÷ôôõöö÷ªø ÷ìÒÀÈÚóø÷õñô…÷ -ööõôóòòñðï„îïð„ï„î"êçêêçêëãÖÊÇÙïòòóññîìíííìíëèèèéêëìí„î ïïïîîëèãßÝÙ†ØÙÚÚÝ„à5ÞÝÛÚØ××ØØÛßááâáÜÕÑÎÐÓØÚÜÝßßßàáááââáààßÝÜÛÚÙØØØÚÚÜÚÚÚÒËÌÍÍÎÌÌ͉Î͉Ì)ËËËÉÉÈÅÃÀ½½»¼ÅÇÈÉÌÌÎÐÓÓÖØØÙÛÜÞàááâãåçèæææ‡è…ë ìëëêêêëëë„ìííïñðïñîïðïïððð„ñòóó†ôó…òóˆôòòññòòòóóôõõöö÷øøø÷øø÷ööŠ÷ööõõõôôô‡õ‡ô õõõôôõöö÷ªø ÷ëϽÅ×ïôöö÷ø…÷ -ööõôóòòñðð„ñðïîîíî†ïðìèçåÝÐÃÀÒèëëîïððïîíìé„æXçèééêëìíîîïïðñðíéåáßÛÚÙÙÙØØÙÚÛÞáàààÞÝÛÚØ××ÙÛÝáâãäãÞ×ÓÑÑÒ×ÚÝßàááâããáââáààááàßÝÝÛÛÜÝÝàÝÝÝØÔÔÒÐÏ…ÔÕ„ÔƒÓ…Ò-ÐÐÌÌËËËÉÉÈÅÃÄÁ»··º¿ÁÃÅËÌÎÑÑÔÖÖ×Ù×ÙÚÜÜÝÞàââããã„äƒå…ç ìëëêêêëëë„ìíííîííîîïðïïðððññîîïïï†ðïïïîïïï‡ðôòòññòòòóóôõõöö÷øøø÷øø÷ööŠ÷ööõõõôôô‡õ‡ð òòòôôõööôõõö÷Žø†÷Žø÷÷÷ôñÝ¿­¶Çâéîó÷ö…ô -óóñðïïîííêˆè‚æ„å^äääâÞÝÙÒŸ·ÊáãäéëìëëêéèæåäãããäåæçèéêëëììêèèäáÜØÖÓÒÐÏÐÓÔÕÕÖØÛÛÜÜÛÙØ×ÕÔÔÓÓÕØÚÚÛÚÕÎÊÉÈËÐÒÕÖØØ×ÙÚÜ„ÞÝÜÜÜÚÙØ×ÖÖ×ØØÚ×ØØÔÿ€ÿ€ÿ€“€ ¿¿¿ÁÁÄÄÅÅÅÆƆŅÄÃÃÂÂÁ„À$¾»¹´±­¬¬¯µ¹¾ÁÅÇÉÌÌÏÑÑÒÔØÚÜÞÞÞßâäåæææ‡èì„ë ìëëêêêëëë„ìííëíìëíí„ïƒð„ñòóô…õƒô„ò‰ôòññðññòòòôôõõõ÷øøø÷øø÷öõŠ÷öööõõôôô‡õ…ô ÷÷÷øùóôõöö÷÷©ø ðºŠÿ†ŠºÝõõìõ„ø ÷÷ööõôòòñðï„îðñðïïï„î%ëèìêèâÉž‡‡„¤Þòñòññîìíííîîëèèèéêëëìííî„ïKîîëèäáÞÙØ×ÕÖ××ÙÛÜÞáááàÞÛÛÙØ××ØÚÜàáâããÝÕÑÎÐÒØÙÜÝßßßàáâáâãáàßÞÜÚÚØ×ÕÕ××ÙÜÚÛÚÑ ÍÍÍÎÏÌÌÍÎÎÏÏ…Î͉Ì)ËËËÉÉÈÅÃÁ½½ººÂÄÆÇÉÌÎÏÓÓÕØØÙÛÛÞàáááâåçéæææ‡èì„ë ìëëêêêëëë„ìííïñðïñí„ïƒð„ñòóô…õƒô„ò‰ôòññðññòòòôôõõõ÷øøø÷øø÷öõŠ÷öööõõôôô‡õ†ô ööö÷óôõöö÷÷©ø ñ·~ëz±×òøö…ø -÷÷ööõôòòñð…ñðïïîîî„ï2ðñòïêà˜|›ÕêèìïððïîíìéççæææèèèéêêìîïïïñññíêæâßÛÙ„Ø>×ÚÝÝàäâáàÞÛÛÙØ××ÙÛÞáääåäßØÓÑÑÒÖÙÝßááââäãáâãáàßßàÞÝÜÚÙÙÚÛÜàÝÞÞØÓÓÒÒÎ…ÔÖÖÔÔÔÓÓÓ…Ò-ÐÐÌÌËËËÉÉÈÅÃÄÁ»··¸½¾ÀÃËÌÎÑÑÔÖÖ×ÙÖÙÚÜÜÜÞàâäããã„äåååé„ç ìëëêêêëëë„ìíííîííîí„ï -ðððññîîïïð…ñƒð„ïˆðôòññðññòòòôôõõõ÷øøø÷øø÷öõŠ÷öööõõôôô‡õ…ðñ…ó ôõööóôõõ÷Žø÷„ö÷„ø÷„ö÷…øöóøé¥i¿dižÈêóô÷„õ ôóóóñðïîîíê‰èæ†årçãàÒ±†mmp•ÎäáçëìëëêééçåäãâãäååæççéëëììêèèåáÞÚ×ÓÑÏÍÏÒÔÔÕÕ×ÛÛÞÜÛØ××ÔÓÔÓÓÕÙÛÛÝÜ×ÎÊÉÈÊÏÒÕÖØØØÙÛÜÞßßÞÝÛÛÚÙ××ÖÔÔÕÖ×Ú×ØÙÔÿ€÷€ÿ€š€¾½¿¾À„ÅÆÈÆÆÆ„Å -ÄÄÄÃÂÂÃÂÂÁ„À#¿¾½¹ºµ®®«´¶¹¼»ÁÄÈËÐÐÒÕÖØÙÚÜÝßßàãååæˆèƒê‡ëˆìíííððîð‡ïðððññòôôôõõööôõõõöõôôôó…òŠõññòõöôöøø÷öø÷öõööˆ÷ø÷÷÷öõõõ‰ôõõö†õ÷÷ùùøùù¦ø÷÷ÌóóùùƒŠŸÕôôôö÷„øQ÷÷÷õõõïîïîïóôõõôóòðîïîîéåçðÓ¦Œýÿ‚‚·áòñðíëîïíëëëìêçæçèçéêìíïñññðïëèçåßÛØ×ØØÙÜÜÝß„áàÞÝÜÛ„ÙÛßáäåããàÙÔÑÑÔØÚÜßááà„áààßßßÞÞÝÛÙÖÒÑÓÖ×ÛÖÖÕÏÒÒÐÏ…Î ÏÐÏÏÏÎÎÎÍ„ÌËËÌÌÌ„Ë$ÉÉÈÇÃÄ¿¹¸»ÂÆÈËÎÐÑÒÔÔÔÖØÙÛÜÝßàââãæèåæˆèƒê‡ëˆìííïñðîð‡ïðððññòôôôõõööôõõõöõôôôó…òŒñòõö÷‰ø‚öˆ÷ø÷÷÷öõõõ‰ôõõö…õòôôööøöö¨ø%Ïùóõëw~•Ìïôø÷÷øøø÷öõõôõõñïñïðñðïððïîî…ðWóðïÌœ~éó|}Œ³ÝìéìîïîíëêèçåæææçèçéêëëíïïððïëèçãÝÙÖÕ×ÖØÚÜÝßááâââàÞÜÙØ×××ÙÜÞâäããàÙÔÑÑÔØÚÞá†âáààßßßÞÞÝÛÙÚÚÚÛÞÝßÞßÞÙ„ÒÑ„ÓÔÕÔÔԄӃ҄Ђ̄Ë$ÉÉÈÇÃÄ¿¹¸µ½ÁÃÆÄÈÉËÌÓÓÑÏÑ××ØÚÛÞÞÞáâáã…äåååæ‰çééì„ïðððæêìîð‡ïðððíîïðððññòóðññòóñððïï…ò…ô óóôôôññòõöö‡ø÷öööˆ÷ø÷÷÷öõõõ‰ôõõö…ñôõö÷øøùù•ø÷ø÷öñÇÝÏÍÅch|´Þîóõøøöôô„òôñéæééêìëëíìëêç„ætééàß‘oÇÍfjq‚¬ÚçäæææèéèæåääãããäääåçæåæèèëìëèåâÝ×ÒÏÏÐÏÑÓÖÚÛÝÞÜÚÙ×ÖÔÓÑÐÐÐÓÖØÛßààÜ×ÐÎÍÐÔÕÕØÚÚØÙÚÜÞÝÜÜÛÛÛÚÚØ×ÓÐÐÒÔÖÙ×Ø×Ôÿ€õ€„«€‚ë€ÀÀÁÁÂ…ÆÈÆÆÆ„Å ÄÄÄÃÂÂÃÂÂ…À#¿½½ºº´®­ª®²´¸¸¾ÃÈËÐÐÑÔÕ×ØÙÚÜÞÞàâãåæ†èé„ê‡ëˆìíííððîð‡ï„ðñòóôôôõõõôõõõöööõõõ…òˆõóóðññôõóôööö÷øøöõöö÷÷÷‡ø÷÷÷öö‹õ‚ö…õö÷÷…ù¨ø ’áéëéõ…†”Éø÷„ø6õôöôõõòòô÷õòòóõõôóñóïìïðîíêòÕ”ñëñ÷óõñùóîññíîïïíìëìíëç„æèèêëî„ï1îëèçäßÚØÖÖ×ÙÜÝßàáááßßÝÝÜÛÙØØØÛßáäåãâßÙÔÑÑÔ×ÚÜßááà„áàßß…Ý ÚØÔÑÑÒÔ×ÜÖ×ÕÐÔÔÒÒÐ…ÏÐÏÏÏÎÎÎÍ„Ì-ËËËÌÌËËËÉÉÉÇÇÄÄ¿¸¶¸½ÁÄÇËÍÏÑÔÔÔÕ×ÙÛÜÜÞßááãåçåæ†èé„ê‡ëˆìííïñðîð‡ï„ðñòóôôôõõõôõõõöööõõõ‹ò -ññðððññôõö‰øöö÷÷÷‡ø÷÷÷öö‹õ‚ö…õóôô…ö¨ø –éïïéï}z†¾ò÷„ø5õôöôõõòóöøöôòñîîîìêììïñòñïëòЈÝßçóóõí÷ïœêêìíïïíìêèçæç…æ7èèêêìîîïïîëèçâÝÙÖÕÕÖØÚÜßàááâááÞÞÛÙØÖÖ×ÙÜÞâäãâßÙÔÑÑÔ×ÚÞá†âáàßß…ÝÚØÙÙÙÚÜÝ„àÚÔÔÓÓÓ…ÔÕÔÔÔ„ÓƒÒ„Ð*ÌÌËËËÉÉÉÇÇÄÄ¿¸¶³¸¼¿ÂÀÅÈËÌÓÓÏÏÐÖ××ÙÙÜÜÞáâáã„äååæ‹çééì„ïðððæêìîð‡ïðððíîîïðððñññðññòóóóñññ…ò‡ô -óññðññôõôö†ø÷ööö÷÷÷‡ø÷÷÷öö‹õ‚ö…ñôõö÷÷ùùù¥øHöøøŒËËÉÃÇfai£äðõøø÷ôøù÷øôïíîðïëêêééèçæçååçèçèãã¾}Ç»ÃÍÍÕßåá˜åææåçéééçåååä…ãAäååãæèèêìëèåâÛ×ÒÏÎÎÎÑÓØÛÝÞÞÜØØÖÖÔÓÑÏÏÐÓÖØÛßßÞÜ×ÐÏÍÐÔÕÕØÚÚØÙÚÜÞÝÛÛ„ÚÙ×ÕÒÏÎÐÓÕÚÙÙÙÕÿ€õ€…¨€‰æ€ÁÁÃÂÄÇÇÆÆÅÈÆÆÆ„ÅÄÄÃÃÂÁÂÁ„À%¿¿¾½¼»¹´®«¨ª­²µµ»ÁÇÌÐÐÑÔÕÖ××ÙÚÜÜÞâãåæ…èé„ê‚ëŽìíííððîð‡ï…ðñòóóôôôõôõõõö÷ööõõ…ó…õööõóóñññóôòôõõõøøøööö÷÷Šø÷÷÷öööˆõˆö÷÷÷øøùùù¦ø öôõáß×ÍÏ傉˜Ë‡ø=ö÷ôôöõôòïðòô÷÷ö÷öôñðïïïñ÷ߘõïååÝ×çåéõõÑîïíïïïîíìíîëèæææåæçéêì„î1íëèèäÞÙØÖÖ×ÚÞàáâãâáàßÝÝÜÛÙØØÙÛßàããââßÙÔÒÑÓ×ÙÜßááà„áàßÞÞ„Ý ÚØ×ÕÓÔ×ØÝØØÖÐÖÕÔÓÑ„ÏÎÐÏÏÏÎÎÎÍÌÌÌËÊÊ„Ë'ÊÉÉÉÈÇÆÅþ¹µ·¸¼ÂÄÇËÍÐÒÓÓÕ×ÙÙÚÛÜÝààáåçåæ…èé„ê‚ëŽìííïñðîð‡ï…ðñòóóôôôõôõõõö÷ööõõ…ó…ò óòñðïñññóôõ‰øö÷÷Šø÷÷÷öööˆõˆö ôôôõõööö÷¥ø€÷öýëçáÙÝéz}ŠÀóøøôöøø÷÷öôõôòðïñðíïðîïíìíîîîíìïÙŽÛáåéåáïéíùûÒìíëîííìëêéèççæææåæçèèëììíîíëèçâÜØÖÔÔÖÙÜßáâãâáàßÝÝÛÙØ×××ÚÝÞáâââßÙÔÒÑÓ×ÚÞá†âáàßÞÞ„Ý ÚØØØÖØÙÜáàááÚÖ„Õ„ÔÓÕÔÔÔ„Ó7ÒÒÑÐÏÏÐËËËÊÉÉÉÈÇÆÅþ¹µ±³·¼¿ÀÅÉÍÑÒÒÏÎÐÔÕÖ×ØÚÚÝàâáãäääååæ…çèˆéì„ïðððæêìîð‡ïðððííîïïïððññðññò„óòñ…ó…ôõôó…ñóôô„ö„ø÷ö÷÷Šø÷÷÷öööˆõƒö…óõööö÷ø÷§ø€ôîéÓÍùµ½a_j¤åòøöõ÷øùøøóðìéæäèéçéêèéèçåæåååçéÉ}ÅÅ¿ÉÉÉÝßßéëÊåçäèèééççææåäããâáâäãáäææèêêèåâÛÕÑÏÎÎÎÒÕÚÝßßÞÞÜÜÚÙÖÓÑÐÐÐÓÖ×ÛÝÞÞÜ×ÑÏÏÐÓ ÔÕØÚÚØÙÚÜÞÝÛÛ„ÚÙ×ÕÔÓÑÒÔ×ÜÙÚÚÕÿ€ô€‡¦€‹å€ÂÁÃÂÄÉÈÇÆÅÈÆÆÆ„ÅÄÄÃÂÁÁÁ„À0¿¿¿½¼¼º¶³°«£¡¦°´µ»ÀÇËÐÐÐÓÔÓÕÕ×ØÚÚÝáãåæèèèéêêêëëëìíííððîð‡ï -ðððïðññòòò„ôõõõöõõˆôˆ÷ööôóóôõóõ÷÷öøøø÷ö÷øƒ÷ˆö‚÷…ö…÷„ù¦øIãñÓϹ«¥«¿ë…»è÷øùøøøõïîïäÔÐÚàÝÕÓßçëðôôñóóòñÓ“åé׿¯ŸŸ¯¿Ûãáµæîîóïïîííïïíèæå„äæèê…ì0êèèäÜØØÖÖÙÞáãäääããááßÞÞÞÜÚÚÛÝßàââàáßÙÖÓÑÒÖÙÜßááà…áàààßßßÞÜÚÙØ××ØØÜÖ×ÕÏÖÖÔÓÒÑÑÏÏÎÐÏÏÏÎÎÎÍÌÌËËÉÉÊËÊ…É-ÇÆÆÄÀ½ºµ²°µ¿ÂÆËÍÐÑÓÓÔÖØ×ØÙÛÛÝÞáåçåæèèèéêêêëëëìííïñðîð‡ï -ðððïðññòòò„ôõõõöõõôóóôóóôõ÷‰ø÷øƒ÷ˆö‚÷…ö…ôöõöö¦øIçûáßÑÇÉÏ×ëuz«Øòøöøø÷ñêèéÞÏËÖÝ×ÍÉÔÝáåêììîîíëËŽÛßÛÍ¿µ·ÃÏë÷õºèîêìêíìììëéèçæå„ä5åæéêêëììêèçâÚÖÖÕÕ×ÜàâäääããááßÞÝÜÚÙÙÙÛÝÞàáàáßÙÖÓÑÒÖÙÞá†âááàààßßßÞÜÚÙØ××ØÚßßàßÙÖÖÕÕÕÖÕÔÔÓÕÔÔÔ„Ó ÒÒÐÐÎÎÏËÊ…É'ÇÆÆÄÀ½ºµ­«°º½ÄÉÌÐÓÑÑÏÎÎÒÓÔÖÖØÙÛßâáãäääæ†çè‰éì„ïðððæêìîð‡ïðððììíî„ï ðððññòóòòððð…ô…õ öööõõôóóôõõ÷ˆø÷øƒ÷ˆö‚÷…ó…öƒ÷¦ø@ößçÍ͹«§©¯³W\–ÊðøõööôìæãâÖÿÉÒÍÄÁÌÔØÝáääåæåäÂ|³½¹©¥¡«¿Íååß°àæäçæ„éèçæäãâá„àPßâããæééçåâÛÓÏÏÎÎÐÖÙÝàááàáááßÞÚÕÔÒÒÓÔÖ×ÙÜÝÞÛ×ÒÐÏÏÒÔÕØÚÚØÙÚÜÞÝÝÝÜÜÜÛÛØ×ØØ××ØØÚØÙØÔÿ€ô€‰£€Œå€ÁÁÂÂÄÉÉÇÆÅÈÆÆÆ„ÅÄÄÄÁ0ÀÀÀ¿¿¿½½¼»¸µ³±«Ÿœ¡®±¶»ÀÇÊÐÐÐÒÔÓÓÕ××ÙÚÝáãåæèèèêêê„ë‚ì†íˆìíííððîð‡ïðððïïðñòòòóôôôõõõöõôôóò…ô…÷…ù„õöô÷‡øö÷“ø‡ö÷ù÷ùù¥ø?÷ÊãÙű£Ÿ™§»å„õ›Üùøøú轟—“ƒÛã„…ƒõ÷…‰’£¸Õçðóî×™çÝÉ»Ÿ““—«—¿×ß©áëîó„ïCíïðíèæåäãâãåçêëëìììêèèäÛØØÖØÚàääææåäãããààßàÞÜÜÛÝßàââàáßÙÖÓÑÒÖÙÜßááà„áââáááàààÝÛÛÙØØÙÙÛÖÖÕÎÕÕÓÒÑÑÑÏÏÎÐÏÏÏÎÎÎÍÌÌË„ÉÊ…É*ÇÇÆÅ¿½¼¶­«°½ÀÇÌÍÐÑÓÓÔÖØÖÖØÙÛÜÝàåçåæèèèêêê„ë‚ì†íˆìííïñðîð‡ïðððïïðñòòòóôôôõõõöõôôóòŠô…ö„õöŠø÷“ø‡öˆ÷…ôöôöö÷¥ø€ÎëåÙËÅÇËÑÏÙzÕ…Éöøòîܱ“Ž}ÑÙ}{åáx|†—¬ÍâëîêÓ”áßÉɹ«¯·Á«Óí÷°äíêìéíííìëéèçæåäãâãäæçéêëììêèçâÙÖÖÕÖØÞâäææåäãããààÞÝÜÚÚÚÛÝÞàáàáßÙÖÓÑÒÖÙÞá†âáââáááàààÝÛÛÙØØÙÛßÞßÞ×…Õ ×ÖÔÔÓÕÔÔÔ„ÓÒÒЄÎÊ…É'ÇÇÆÅ¿½¼¶©¦«¹»ÅÉÌÐÒÑÑÏÎÎÑÑÓÔÖ××Ûßâáãäää‡çŠéì„ïðððæêìîð‡ïðððììíî„ï ðððññòóñððïï…ô…õ…÷„õ‚ö‰ø÷“ø‡öƒ÷…óöööõõ÷ö÷¦ø@ôÅ×ÓË·«§©±Ÿ\§uÅ÷øíäÒ¨Š……s»½pspÑÍnr{¢ÃÚãæáʈ·³££‘£³Å«ÏÛߦÜåäæå„éEèçæäãááßÞàßßáâãæééçåâÛÓÏÏÎÏÒ×ÛßââááâããààÛÖÕÓÓÓÕÖ×ÙÜÜÞÛ×ÒÐÏÏÒÔÕØÚÚØÙÚ܆ÞÝÜÜÚØÙÙØØÙØÙ×Ø×Òÿ€ô€Š€Œ€€€€Œ€å€…Å„ÉÈÆÆÆ„ÅÄ„Ã5ÂÂÂÀÀ¿¾½¼¼¾½¹±®®¯¬¡™Ÿ±·ÀÁÄÇÈÎÍÍÎÏÎÎÎÐÑØÚÝàáãçèèêêêëìì‡íëêêëë†ìííîî†ï‚î…ñðððññòñòôöôõõóò‹ôóôôöõö÷÷øööö÷÷÷ø‚ùˆ÷õö÷÷÷õõ…ö§ø€ö£ãÓ½§Ÿ›Ÿ«¿Ùïñ‰·Ñ¿§‘†‚ñÕÑÝÛÛãý‚ññÿ…‡‡‹™­¼Ä§ŠÝÍɱ™§›™™¥Ëá”äêïìêìííîïïíêèæäâááäçèéëêêêèæãáÜ×ÕÕ×ÜãåååææåäääããââáàßàààââáààÝØÖÔÑÓ× ÙÛÝßßàááããã„áâàààÝÛÚØ×ØÙÚØÕÒÍ…Ò1ÑÒÒÑÐÏÏÎÎÎÏÏÏÎÎÍÍÌÌÌËÉÉÈÇÆÆÈÇÃÀ½½¾»³«±ÃÉÉÊÎÑÓÖÕÕÖ„×ÙÙÜÝàääãçèèêêêëìì‡íëêêëë†ìííîî†ï‡îñññóóôóôö÷ôõõóò‹ôóôôöõö÷÷øööö÷÷÷øöõˆôòóôôôõõ…ö§øtö£éãÕÃÃÅÏÏËÉÑáÝz¨É¾§‚{é˽ÇÓÝÓÍiçóó}…’¦´»š}×Ë¿³«µÇ¿½»Ãßñ¡ðëèêéêêììêèéêéèæäãâãåæèèêìëéèåâÝØ×Õ×ÜãåçéêéèåääããáÞÞÝÜÝßß…à ÝØÖÔÑÓ×ÚÜßááã…äãâãäãàààÝÛÚØ×ØÙÚÛÛÚ×…Ö,×ØØÖÕÔÔÓÓÓÏÏÏÎÎÍÍÌÌÌËÉÉÈÇÆÆÅÁ¼¿»¼¼¹±©¯ÀÆÎÏÎÎ…Ï„Ð ÑÓÔÕ×ÛÜàääå„ç‡éêéè„ç -ìïïìììííëë†ì‚ë…ï…ê -ëëëíîôõõóò‹ôóôôöõö÷÷øööö÷÷÷ø‚÷†ö õõôõõõöõõ…ö§ø€õ áÓ½«©§±¯©§­µ«b•¾±‘znlÍ­Ÿ¥©¯·ÉfÁÅ×npos‚–¤¬qµ¥™‰—¯±µ·½×ã–âãåçåççééæããâáàÝÛÚÚÜÞßáâãããáßÝÚÕÏÎÐÓÙßáãäåäâãääããâààÞÞÜÛÛÜÜÜÝÜÙÕÒÐÏÐÔÕÔÖØØÙÛÛÜÜÜÚÚÚÛÝÜÜÜÚØ×ØÙÜÙ×ÖÖÔÑÿ€ô€ˆ€ˆ€Š€å€…Å„ÉÈÆÅÅÅÄÅÅ„ÃÂÂÂÀÀÀ¾¼¼»º»¹¶®¬­°³°­³½ÀÆÆÈÊË„ÎÏÏÎÎÐÑ×ØÛÞàâææèêêêëìì‡íìëëëìììíììíííîî†ï‚î…ñƒð…ñôôôõõóò…ô…ò óòòôõõõ÷÷ø÷¢øùùùø÷ùøˆ÷õööö÷öö§ø?è…å×½££¡©·ÅÝõý„‡ýÿ‰‡ÕÁÇÑ¿¯«§«Ååõ„…„„åï÷ùùã¹±³¥Ÿ½Å£½Ý|Öêðè…í-ïðîêèæåâááäæçéééèèçåãßÜØ×ØÚßåèçççæååææåååææää…â)àßßÜ×ÖÓÑÔ×ØÛÝßááâããääãããäãâââßÝÚØ××ØØÕÓÏÌ…ÒFÑÒÒÑÐÏÎÎÎÌÏÏÎÎÎÍÌÌÌËÊÉÈÆÆÅÄÅÃÀ½º¼¿ÁÀ¾ÄÎÑÎÏÒÔÔÖÖÖ×Ø×××ÙÙÛÜßâäâææèêêêëìì‡íìëëëìììíììíííîî†ï‡îƒñ…óööôõõóò…ô…ò óòòôõõõ÷÷ø÷¢øöööõôöõˆôõööö÷öö§ørè…ëåÓ¿½ÁÉËÇ¿¿Ñáãtyññy‚Ï»µ»³««¿Óãíõ}|{{×ãáÛÙű¹³«±×åï««Ñí‹âêêæëêêììëéêêêèæäââãäæçèéêêèæåáÝÙØØÚßåèéêêééçææååäãâááß„à)ßßßÜ×ÖÓÑÔ×ÙÝßáâãäääææåääæåâââßÝÚØ××ØØÙÙØÖ†Ö?ØØÖÕÔÓÓÓÒÏÏÎÎÎÍÌÌÌËÊÉÈÆÆÅĽ¹»¹º½À¾½ÂÍÏÓÔÒÐÑÏÏÏÐÑÐÐÐÑÒÓÓ×ÙÛßâãå„çŠéçççéìððììíííëë†ì‚ë…ï…ê -ëêëíîôõõóò…ô…ò óòòôõõõ÷÷ø÷¢øù÷÷÷ö÷÷öööõõõööõööö÷öö§øRç‚áÕ½§£§­­§›§¯³\jÓËfoo«‘—§¥Ÿ¥«³³ÁÛonji³¿Á¿½©ƒ‡±Å©¡©£Çá~ÕãæãèççééæääãáàßÛÚÚÜÝßà„áàßÜØÕÑÐÒ×Üâääååäääææååäääââß…ÜÛÛØÔÒÐÏÐÔÔÔÖØÚÚÛÜÜÝÝÝÜÜÝ„Þ ÛÚ×ØÙÚØÔÔÓÑÑÿ€ô€Ž€€€€€Œ„€“å€…Ä ÈÉÉÈÇÅÅÅÄÄÄ„Ã7ÂÂÁÀÀ¿¾¼»¹¹··µ±¬¬¬°´¹¼ÁÃÂÉÉÉËËÎÎÎÏÐÏÏÎÏÐÕ×ÙÜÞàåæçéêêëììˆí -ìëìììííìíí„î†ï‚î…ñƒð…ñóôóôôòñ…ó†ò ñòóôôõöö÷¥ø‡ùø÷÷÷øøööö÷÷ö÷÷ø÷÷£ø€àéëÛ³‰x—¥­±¹Ë邉’Šÿñµ¡¡…‰zv•µÍíÿûéýõûç·‘‹………‹Å­á~«ÙݼéôéðîîîïðòïëèçåãáàâåæèéèççåãáßÜÙÚÛÞãèêéçèçæçèèççèèçæåäãâáàßÞÜÙ×ÕÓÓÔ×ØÛÞàáããäääååääææäääáÞÛØ××ÖÖÓÐÎË…Ò„ÑBÏÎÎÍÌÌÏÎÎÍÍÌÌËËËÉÈÆÅÃÃÁÁ¿»»º»¿ÃÉËÐÓÓÑÑÔÔÔÖÖÖ×ÙØ××ØÙÙÚÝàáàåæçéêêëììˆí -ìëìììííìíí„î†ï‡îƒñ…óõöóôôòñ…ó†ò ñòóôôõöö÷£ø‚÷†öõõôôôõõööö÷÷ö÷÷ø÷÷£ø@àéñëÏ£•·Á¿·µ¿Óoqw{„|çá­—‰|nx™·ÁÅÃÕë÷xíãëÙÕ½“‰———¡µ¡éÍý¿ïõÈêíçî„í,ìëëëêèæåâââãäæçèéèçåãáÞÛÜÜÞãèêêëìëéèèèççæääã„á+ßßßÞÜÙ×ÕÓÓÔ×ÙÝàâäååæææççææçæäääáÞÛØ××ÖÖ×ÖÖÔ…ÕDÖÖÖÕÔÓÓÓÒÒÏÎÎÍÍÌÌËËËÉÈÆÅÃÃÁ½¸µ¹¹º¾ÁÇÊÏÒÐ××ÔÑÑÏÏÏÐÑÑÐÐÑÑÐÒÕ×ÙÝáãäæççç‹é èééìððìííîîëë†ì‚ë…ïˆêìîóôôòñ…ó†ò ñòóôôõöö÷¥øù„ø÷÷÷õööö÷ööö÷÷ö÷÷ø÷÷£øRßãçÛ·|…©£••¡UXejniýfhrn—›‘•£½ÏÑeõõ³™p^jjjn‹…Á¹õ‡¯ÙݺâêäëêêêéèææäáàßÜÚÙÚÝÝß„à3ÞÝÚØÕÓÔÖÚßåæææçæäæèèçççææääáÞÝÜÛÛÚØÖÓÑÐÏÑÓÓÔ×ÙÛÜÝÝÝ…Þß„à ÞÛØØØÙÖÒÒÐÏÏÿ€ó€Ž†€€Žƒ~„䀅ĄÈÆÅÄĆÃÂÁ„À2¾¼º¹·³¯¬«¨£­¶»¾ÁÅÇÇÇÉÊÊËÌÎÎÎÏÑÑÏÎÎÏÒÔ×ÙÛÞãäçèêêëìì‰íîìííîîíí…î†ï‚î…ñðððññðððòôòóóòñ…ò…ñ -ðððñòôôõöö«ø ùù÷÷øùùö÷÷øø†÷£ø>è…éשt½É›¡¡¯Ë㌔––ùÁ¥‰ýýñƒ¥Á¹­•—·ãëɱç‚ÿë·ƒhbnxx±|±ƒ£ÉÑ“éø„ó8òñòôñìéèæãàßáääæèææåãáàÞÜÜÞßâæêëêéééèéêéèèèéèçæååäáàÞÜÙÖ„Ô!ÕÖØÛßâãäååæææåäåææäääáßÜØÖÖÕÕÓÐÌÊ…ÑÐÑÑÐÎÍ„Ì<ÎÍÍÍÌËËËÊÉÈÆÄÃÁ½¹¶µ²²¼ÅÉÍÎÑÔÔÔÒÓÕÕÖ×××ØÙÙØ×××Ö×ÚÝßÞãäçèêêëìì‰íîìííîîíí…î†ï‡îñññóóòñòôõòóóòñ…ò…ñ -ðððñòôôõöö§ø÷øø÷ööôôõööö÷÷øø†÷£ø=ç…ïëÉ‘áᥫ¥«ÁÍjnu{|Ñ£‘~pɹ½~±ÍÉë«¿ÝÛ¿¯×oͱ‰x‰‰‘ʼn¹‹·ßíŸê…ñ8ððîííìëéèåâááâãäææçæåãáàÞÞßàâæêëììíìëêêéèèçæäãâãäâßÝÝÜÙÖ„Ô!ÕÖÙÝàãåæææçèèçææççäääáßÜØÖÖÕÕÖÖÔÓ‡ÕBÖÕÓÓÒÒÑÐÎÍÍÍÌËËËÊÉÈÆÄÃÁ½¹³®«±ºÃÈÌÍÐÓÓÓØØÕÒÓÐÐÐÑÒÒÑÐÐÐÎÎÒÕÖÛßáãåçççŠéêêééíññííîîîëë†ì‚ë…ïˆêììòóóòñ…ò…ñ -ðððñòôôõöö«ø ùùöö÷÷÷ö÷÷øø†÷£ø=å‚åÛ¯x¹½|“‘…‡•—NQ]fh«lP:x‰l“£Ÿ¡™•¥·¯‹t¡W£‡XHVZhpt±…©~¡ÅÑ’ã…îíìêèçåâáßÝÙØÙÛÜÞßßßÞÜÚÙ×ÕÕ×ÙÞâ„ç#èçæèêéèèççæåäâàßÜÚÚØÖÓÑÐÐÐÑÒÓÔØÛÝÝÞ…ßÞÞßáàààÞÛØØØÙÕÒÑÏÎÏÿ€ô€„‚~‡…€…ƒ~€‰„~„䀅ĄÈÆÄĆ…À2½¼¹¶µ¬¨¥¤¡¦´½¿ÀÄÈÈÉËËËÌÎÎÏÎÎÐÑÑÏÎÎÎÑÓÖÙÚÞâäçèêêëììˆíîîíííîîíîîïïîî†ï‚î…ñ -ðððññðððñô„òð…ò…ñ ðïðññóôõöö÷÷ªøù÷÷ùùù÷÷„ø„÷„ø÷Ÿø?òœëש|ÑÍ~—¡¡·Õ燇齭³Á»«“ñ‡Ó‹÷¯§Ïå¹Ù©õûËn`lzzµ|‡³Ë×êùø„õ%óôôòíêèæãàßáâäåçåääâáßÝÝÝßßâæêëêêêéèé„èéëééççæäáàÝÚØÖÔÓÔÕÖÖ×Ûßâääå„æäääååäããáßÜØÖÖÕÕÓÐÌÊ…Ñ„ÐÎ…Ì<ÍÍÍÌÌËËÊÉÉÇÆÃÁ¿·²¯®«µÃÍÏÏÏÑÒÓÔÓÓÖØÙØ××ÙÙÙØ×××ÕÖÙÜÝÞâäçèêêëììˆíîîíííîîíîîïïîî†ï‡î -ñññóóñññóõ„òð…ò…ñ ðïðññóôõöö÷÷©ø ÷öôôööö÷÷„ø„÷„ø÷ŸøRñœñëÉ™íÕƒ£¡³ÇÑhgki«·«‘tʼnÍvvíͱ±ÏׯљÍÅa—ƒ‘•—‘‹µxt‹Çá÷Œëóøóôôòñïîîíëéèåâàááãä„æäâáßÞÞàáâæêëìíííëê…èçæåäåäãßÝÝÚØÖÔÓÔÕÖÖØÝàãæææèèèç…æäããáßÜØÖÖÕÕÖÖÔÓ‰Õ@ÓÒÒÑÐÐÍÍÍÌÌËËÊÉÉÇÆÃÁ¿·²¬§¤´ÂËÌÍÏÑÒÓÔØØÖÕÕÑÐÐÑÒÓÑÐÐÐÌÎÐÔÕÚÞàãåçççŠéëëééíññíîîïïëë†ì‚ë…ïˆêëì„òð…ò…ñ ðïðññóôõöö÷÷ªøùöö…÷„ø„÷„ø÷Ÿø?î˜éٯɹtƒ›™LISS‡hhv…n^H|`ŸaeÙ¿¥™©¥tdb›—IfNZdpz…É™…‘~¯ÇÙ~âïõ„ï$îëèèåãáßÝÙØÙÚÜÝßÞÝÝÛÚØÖÖÖØÚÞãçççééèæ†èéèææäáßÜÚÙ×ÕÒÐÐЄÒÔØÛÝÞ…ßÞÝÝß„à ÞÛØØØÙÕÒÑÏÎÎÿ€ô€„‚~‡„€ˆ~€€‡~€‡„~„䀅ÂÈÈÆ„ÅÃÇÀ¾½½¼»¸¶¶«¥¦¬¯´¼ÁÁÂÉÊÌ„ÎÏÏÏЄÑÕÓÒÐÐÑÒÔ×ØÛßáâåçèêì†í -ìììîîíîîïï…î -ïïïîîðïîíì…ñ -ðððññòññòò…ôððñóòññðððñðððññòôõö÷÷÷øø÷§ø…ùøùùŒøùœøB÷øöÛ÷ϯ‹Åµl“¡±ÉÍÕù†óÑ·ÅÓß͙ٱ~·é…“ƒÝÓïýËÅåãùí·|ljpt­`X|ƒ¹ÙÝ‹ìóøø„ù÷ôòïîìéèäâãåçèèçåäãáàÞÞßâåéêêêë†ê"ëêèêëëéèçææãáÞÚ×ÔÓÓÓÕÖ×ØÛÝâäæçèèèç…æåääâÝØÕ„ÓÐÏÌËÏÏÏÐÑÐÐÏ„Î̇ËÉÉÈÇÇÆÅÂÀÀµ°±¶¹ÇÏÔÔÔÐÑÒ„ÕƒÖ„ÙÚÙ×ÕÔÔÕÕØÚÛßâäåèçèêì†í…ïíîîïï…îïïïññðïîíìïïðððñññóóòññòò†ôòñïïññðððñðððññòôõö÷÷÷øø÷§ø„öõö÷÷‹ø‚÷œøe÷øöÛÿßÇ£ùéµ½¿ÑÇ»½eeÁ§³ÓÕ¿¡r©¥«Çlyˆ~áÙÕÑŸ—¹»É¿¡•¡£™‰Å‘•¹™Ëéãîôøöõõóóóôòïîìëéæäãäåæææçæääâàßáãåçëìíî„í$ëêëêèèççæäããâàÝÝÚ×ÔÓÓÓÕÖ×ÙÜßãæçèêêéé„èçåääâßÜØÖÔÕ××ÖÖÓ…ÓÕÕÔ„ÓÑÐÏ…ËÉÉÈÇÇÆÅÂÀÀµ°±¶¹ÀÈÍÍÎÕÖØ„ÚØÕÕÑÒÒÓÔÔÒÐÏÏÌÍÏÒÓÙÞßàâäåç‡é -æææççéëëëì…îïïìèèììëééëëìííé„êïîîîï…÷ò†ñðððñðððññòôõö÷÷÷øø÷¢ø‚ö„õƒô„ó†õ -öööõõôóõö÷–øh÷÷øõøóØû×»‘͵x¡£©‘|‡JEz‹§§zZFh`b£Wctk½­¥›rr‰x‰“~pjhnzÝ¡tx~·×Ó…êïøõóóñðððïìëçâáÝÛÜÝßßßÞÜÜÚÙÙ××ØÛÝàããåè…é!êëêèèééèæåääáßÛ×ÔÑÏÏÐÒÓÔÓÔÖÛÝÞÞàà†ß„á ÞÚÖÖ×Ø×ÕÕÔÒÑÿ€ô€„‚~ˆ‚€ˆ~~„€„~„ä€ÁÁÂÂÂÈÆÆÆÅÆÅÃÂÁ‡À¿½½»¹¹¸¹¶µºÀÃÂÄÂÄÇËÌÍ΄χÑÕÔÓÒÐÏÐÐÔÕÛÞàâåçèêì†í -ìììîîíîîïï…î -ïïïîîðïïíí…ñ -ðððññòññòò…ôððñóòññ„ðîîïððòôôõö÷÷÷ø÷§ø‡ù‹øùø÷ùøcöø µŸ~f±Çéñ¿¿óŽŽ†õåÙ¿©Í©Á“·»©½ÿŠƒw÷ŠéÙã÷ûчxzzƒ½pl•¹ÍÑ¡ñõøøøùùúøöôòðïîìéèèèéèçæåäâáááßâäæéëêëë…êëëëêêëëêéççæãáÞÚ×ÕÔÓÕÖ×ØÙÛßàäåç…è„æåããàÜØÕÔÕÔÕÒÒÐÍÎÎÏÏÏÐÏÏÏÎÎÎÌËÉËËÊ…É ÇÇÅÃÃÂÃÀ¿ÄËÍ„ÒÖÑÒÔÕ„ÖØØÙÙÚÚÚÙØ×ÖÔÒÓÔ×ÙÞáäåèçèêì†í…ïíîîïï…îïïïññðïïííïïðððññòóóòññòò†ôòñïïññ„ðîîïððòôôõö÷÷÷ø÷§ø…ö‚÷‹ø÷öö÷øcõø£Ç½£‰á¹Ýåï㯫·aglÛç翉j•µ—·³—­ùŽƒïrg³¥±ÍÛÙ¡¥™Í¥©Ñ—ÉßÛ¦óöøøøööôõöôòðñïîëéçæçææçææääââáãææèëíïî„í8ìëëëêèçèçåääâàÝÝÚ×ÕÔÓÕÖ×ØÚÝàãæçèêêéééèèèçåããàÞÜØ×Ö×ØÙÙÚÕÒÒÓÓÓÕÔÔÔÓÓÓÑÐÎËËÊ…ÉÇÇÅÃÃÂÃÀ¿ÄËÍÍÎÍÎÑ×ØÙÚÛÛÛÙÖÖÒÒ„ÔÒÒÐÏÉËËÎÐØÜÞàâäåç‡é -æææççéëëëì…îïïìèèììëééëëìíí…êïîîîï…÷ò†ñ„ðîîïððòôôõö÷÷÷ø÷£ø‚ö„õôôôóó‹õ„óõõ÷“øX÷öõõ÷÷øòø¢Å»•v¹—³·Ãµz‰GFN±½¹“V8Xh‰z—‡f…Ñ{ym¿UIƒrl|…hlt|…Ñ…t‘|µËÉ›îðõ÷öõôóóóðîíêçåâáàßà„ßÞÛÛÚÚØÛÝßáääæè„é êëëëêèééèæææäáßÛ×ÔÑÐÐÒÒÔÕÔÔØÙÝÞà…áßßßááàßÜÚ×××Ù×ÖØØ×Óÿ€õ€„~ˆƒ€†ƒ~†€€€€€‹„~„䀿¿ÀÁ†ÆÅÃÃÁÀ¿¾„½4¼»»º¹»¼½ÁÃÄÆÇÆÈÈÈÊÍÎÏÏÐÐÑÑÑÒÒÒÓÓÓ×ÖÕÓÑÏÏÏÒÔØÜßáãçèêì†í -ìììîîíîîïï…îïïïîî…ï…ñ -ððññòòññòò…ôððñóòññðððïîîîïðñòôõööö÷÷÷«ø‚ùŒøùøøøù—øDùùøöø÷øÛщvd\±Ùùí¹¿„žŸ‰ï×»³½¯“‘¥ÁÇÁ£›¹Í×zˆ‰†åÍÑ×íᛕ§¡`p™n¯·éÇ÷ø÷…ø÷öõóòñðïíëëììëéèçåã„âåèéëíëëë„ê ëìììëêêêéèèèçãáÞÚ×ÖÔÕÖØÙÚÚÜßàãåç…èçæååáàßÛÙ×ÕÔÕÖ×Õ×ÕÒÌÌΈÏÎÌËÊÉÉÈ„Ç4ÆÅÅÄÃÅÆÇÌÍÏÑÑÓÔÔÔ×ÔÕÕÖ××ØØØÙÚÚÛÛÜÙÙØÖÕÒÒÒÕØÜàâåççèêì†í…ïíîîïï…îïïïññ‡ï ðððòòóóôòññòò†ôòñïïññðððïîîîïðñòôõööö÷÷÷ªøƒ÷‹ø÷÷ööö÷÷•øE÷÷÷øõø÷øÝ寋…»ßïñÏ¡±gvzyïáDZ¥•“§ÇÑͱ©ÁÛùŠ‰wmµ£µÛÕ§«½¯ƒ¡•±Õ…¿ÉñÌøøõ„ø ÷÷öõóòòòðîíëêêéçææäáàààáãæèéííïï„î8íìììëêêêéèæäãàÝÜÚ×ÖÔÕÖØÙÚÛÝàãäæèééèééèèæçåãâßÜÚØ××ØÚÜÝßÚÐÐÒÒÓ†ÔÓÑÐÏÉÉÈ„Ç3ÆÅÅÄÃÅÆÇÌÍÏÑÑÏÐÐÐÓÖ××ØÙÜÝÙ×ØÔÔÔÕÕÔÔÓÑÏÊÉÉÍÎ×ÚÝßâäåç‡é -æææççéëëëì…îïïìèèìì…ë ìííêêêëëïîîîï…ôò†ñðððïîîîïðñòôõööö÷÷÷£ø ÷÷öööõõôóôôõõ†öõõôô„óôõöö÷øköõôóóõñøòøÜ᧑zn¡µ¿~“T]_cɳ•ƒztvƒ•©«›~¡Á×uqXMƒjhdƒ…fr‘•x…\l•l«µáÀõ÷òøø÷õôôóòïîìêèæåäããâàààßÜÛÚÙÚÜßáâååæè„é8êìììëêêêéèçæåáßÛ×ÔÒÑÑÓÔÖ×ÕÕØÙÜßâãããâáàßßàßÞÝÙ×ÕÖ×ÚÙØÚÜÜØÿ€õ€Œ„€‘„€‹„~„ä€+½¾¿ÁÁÅÆÆÇÈÆÆÆÅÅÂÁÁ¿¾½½¼»º½½¿ÁÃÄÆÆÇÊÉÍÍÍÎÐÐЄÑÒ„ÓÔÔÔ×Ø×ÔÒÏÌÌÏÒÖÚÝáãçèêì†í -ìììîîíîîïï…î -ïïïîîïïïðð‡ñ„òññòò…ôððñóòññ„ð -ïîðñïñòóôõ„ö÷‹ø÷øø÷Íø9ö´zl`v—½ßåÙÁã ª˜íÓÏÃÃŵ££¹Ûѽ±¹Ñóx ª‡·½Ñ¿·­‰x\…Ň—±‰ø -÷öõõôóóòðï„ðîîïíêèçççêíîíïììì„ë ìíîíìêééèçèéèäáÜÙ×ÖÕÖØÚÛÜÛÝßàáåç†èæäàÛÚÚÖ××ÖÖÙÚÜÚÛÙÖ-ÊÌÌÎÏÎÎÏÏÐÏÏÎÍÍÍÌËÉÈÇÇÆÅÄÇÇÉÌÍÎÐÑÑÔÑÕÖÕÖ××ØØØ…ÙÜÜÜÝÝÚÛÛ×ÖÒÐÏÓÕÚÞáäççèêì†í…ïíîîïï…îïïïññïïïððïïðððóóôôôòññòò†ôòñïïññ„ð -ïîðñïñòóôõ„ö÷‹ø÷øø÷±ø÷”øC÷÷øøø÷øø½—³ÍÝͳ«ÛŽ–Šù÷çͽ·³»ÅÇÓÓÓÕÏÕù„Šœ{Ÿ……‰¯ËÁ»¯~…‘Ñ™Áñ—§µøø÷†ø÷öõõôôõóòððïïîìêèæãáàààãæéëî‡ï8îíîíììííìêèæäàÝÛÙ×ÖÕÖØÚÛÜÜÞàâäåçèèèéêéçææãââàÝÛÚÙÚÜàáâãßIÍÏÐÒÓÓÓÔÔÕÔÔÓÓÓÍÌËÉÈÇÇÆÅÄÇÇÉÌÍÎÐÑÑÔÎÒÓÓÔÕÕÕÖ×ÝÝÛØØÕÕÖÖÖÕÖÖÓÐÉÇÇÊÍÕÙÜßâäåç‡é -æææççéëëëì…îïïìèè…ìëëìííêêëëëïîîîï…ðò†ñ„ð -ïîðñïñòóôõ„ö÷‹ø÷øø÷–ø÷÷öö…õƒöˆ÷ö…õôôõõö÷øköõõôôö÷ôôø÷·‡tdx§¡‹»tzxã×·•‘©©µ­¡¡­Åéz}Œ‚[n\VPhxpzvV\XhX½ƒ“­õôôø÷ø÷öõôóòñðîìëéèéééçææçäáßÝÛÚÝáãåçæçè„é8ëíîíìëëëêéèèæãßÚÖÔÒÒÓÕ××Ø×ÖØÙÛàäååäãááßÝÞÜÛÛÙ×ÖØÚÞÝÞàààÜÿ€ö€‹ƒ€‘…€Š~}}~~~å€0¼¾¿ÁÁÅÅÆÈÈÆÈÈÉÉÈÆÄÃÂÀÀ¾½½ÀÀÁÃÅÊËÈÈÌÏÏÎÎÐÑÑÒÒÒÑÓÓ…ÔÕÕ×ØØÕÒÍÊÉÌÐÖÚÝàãçèêì†í -ìììîîíîîïï…î -ïïïîîïïððð‡ñòòôòññòò…ôððñóòññðððñððññïðñóôõõööö÷Šø÷÷÷ø÷±øùšø?ò÷Øtp‡»ÏÙ×Óˈ¹±Œ×ÅÇÅÉɵŸ±ÙÕÇÁÍã÷…¢ÆŘ¥ÉÑÕƒ±ÑÓý¹Pp|ÑÕ‹Çøóøøö„ø÷øø÷÷ööôóòóóóòñóôòîíêèéìðïïïíìì„ë8íîîííëêêéçéëèäáÜÙ×ÖÕ×ÙÚÜÝÝÝßàáäçèèèéèèæäßÙÙÙÖØÚÙÚÜÝÞÝÝÚØ ÉËÌÎÏÎÎÏÐÐÏÐЄÑÏÍÌÉÉÈÇÇÉÉËÎÐÓÔÒÑÕÖÖÕÔØØ؆ÙÚÛÜÜÝÝÝÚÜÜØÖÑÎÌÐÓØÝáãççèêì†í…ïíîîïï…îïïïññïïðððïïðððóóôôõòññòò†ôòñïïññðððñððññïðñóôõõööö÷Šø÷÷÷ø÷°øƒ÷–øB÷øøòøॉ¡ÇÅɽ­µ…¯¤ŽÿùãÏÃÁ»ÁÉÅÉÏÝåáß󋪾¹’™±¹½x«ÏËÁ“¥±¡á¹ýõ›Ìøôøøô„ø÷øø„÷öõôóñññðîîëèæãáâåéêíïïïð„ï.îîîííìíííëéçåàÝÛÙ×ÖÕ×ÙÚÜÝÝÞàâäåçèèèéêéçæäâââàÞ„Ýàâäääá2ÍÎÐÒÒÓÓÔÕÕÔÕÕÖÖÑÑÏÍÌÉÉÈÇÇÉÉËÎÐÓÔÒÑÕÕÕÓÓÖÖÖØØØÝßÜØÙ…ÖÕ××ÓÐÈÅÃÇËÓ×Üßâäåç‡é -æææççéëëëì…îïïìèèììíííëëìííêêëëìïîîîï…ðò†ñðððñððññïðñóôõõööö÷Šø÷÷÷ø÷˜ø÷öö„õ‚öŠø÷„öôóôõõõŽøI÷öõõ÷óøøï÷؃l`t“‘•™nŒùÙ±“‘™“™Ÿ›©©©±Å×í… ° sptxxLfz…|ZlPxxÉчÃöíöøóø÷…õôóñîîìëë…êëéæåàÝÝàäåæèçèè„é8ìîîííìììëêèéçãßÚÖÔÒÒÓ××ØÙ×ÖØÙÛßäååääááßÝÜÛÛÛÙØØÛÝááàââáÞÿ€ö€Š„€‘…€~~~†~}}}~~~倸¹»¾ÀÆÆÇÉÉÈÈÈÉÉÇÇÅÄÄÁÂÁÁÁÄÅÅÅÇÇÈÊÊËÌÌÓÓÔÔÔ†×ØØÙÚØØØ××ÏÅÂËÑÔØÜáåêêëŒìîïðïîîíí…ïîîððïîîŒñˆòððñóòïïðððòòòóõòóõõö†÷‰ø…ùÐø8µÍÛß×áÝÇ„¿¹ž‰…~áÁ³©§¯¿Ëß×ó„yù…|“Íй…᥽ՓÅáíñÉÕÙ±ÅÉÝñáù‹øù„úøøöõõóóóòðïîîîììîîïñòïîîíîï…î3ìëêéèéèçäàÜÙÖÕÕÖÚÝÞßàÞÝàãåçèèèçæåäâßÛÚÚÚÙÙÛÝßßàÞáàÙ ÆÆÈÌÎÎÏÐÑÑÐÐ…ÑÏÏÍÌËËËÌÏÏÑÒÔÔÔÖ××ÙÙÚÚÚÙÙÚÛÛ…ØÛÜÜÜÝÛÜÜÚÙÓÉÆÏÔ×ÛßäéêêëììŠïîïðïîîíí…ï îîððïîîïïððð‡ñˆòôòñðïïïðððïîïïñòóõõö…ô÷‰øõ„öÐø8Ååç×÷¥o¯¸§ŒˆëÅ­§«­·ÃÍÃû‚õ„‚•¾¿·„å©ÁáµÏ×Û¹ÉÙÁåõõíÝ÷‹ø!õôôóóñðñòòññððïííìëèèëëìîîìëêêëìí†î1íììëèçäàÜÙÖÕÕÖÚÝÞßáàßáäæçèèèçæåäâáßÞÝÝÜÝßáãäçåççß-ÈÊÌÏÑÓÔÕÖÖÕÕÕÖÖÑÑÏÏÍÌËËËÌÎÎÏÑÓÐÐÐÑÒÔÕÕÕÖØØØÙÙ…ÜÖ„×ÓÓÓÒÑËÀ½ÆÌÓÖÙßäçççééŠæ ëììëëëééë„ìëëíìì„ëìíí‡îˆïò„ñïïðððñðññóòóõõ†ö÷‰ø÷÷÷ùùŠø†öøø÷ööö†ø öõöööõõööøø÷†ø÷öö‡õö–ø?õ¡·¯•‡‰‡`ƒ†ŒyË…x‹—™™‘Ëwpã{wˆ´­žrµlt|Hbƒ™¡~x¡¡ÅÉÍÍÕîñô÷÷øø„öõóóóññð„ïîîííìêêëìêêìííððîîðïððï„î3ìììêêêèçäàÜÙÖÕÕÕØÚÚÜÛ×ÖÙÜàäååääãáàÞÝÙÙ×ØÙÛÞßàâåãåæÞÿ€÷€ˆ‡€‹€€‡€„~†~}}„~å€ ·¸º½¿ÅÅÆÇ„È ÉÉÊÉÈÇÇÉÇÆÅÅÆÆÇÈÊËÌÍÍÎÏÐÐÐÑÓÔÔÔÕ†×ØØÙÚ„Ø×ÓÈÃÇËÒÚàäåêêëŒìîïïîîîíí„ïîîîïïîîîŒñƒò…ôïðñòòïïðððòòòóõòóõõö†÷‰ø„ùÐø<÷ÔŠ‡ŽïÕË«³°ÛÀ—†Ÿ™é©•™›¯ÅÓÝéšš{}–ƒÇœÍÆÂïéÑý£¯ËïÿýÛ«åt‡Õöøø÷÷ˆøù„ú1ùø÷õõõôõöõôôôóòòóòðòòðïïîïðïîïïîíììëêëêçåáÞÙ×ÕÕ×Ý„àßßàãåçèèèæåäââßÜÛÛÛÝÞáâãââàááÙÄÅÇÊÍÍÎÎÏÐÐÐÑÑÑÔÓÒÑÑÓÑ…ÐÑÒÔÕÖ××ÙÙÚÚÚÛÙÚÛÛÛ…ÚÛÜÜÜÝÜÜÜÛÙ×ÌÆÊÎÕÝãçéêêëììŠïîïïîîîíí„ï îîîïïîîîïïððð‡ñƒò…ôóòñ„ï ðððïîïïñòóõõö…ô÷‰ø„ö÷Ðø7Õ‰zǵ±•­¢Ã·š“©›é¡…‰Ÿ¯½ÇÙ›£ˆ‚–ŽÝ—ÃÁ¶ÓÁ©Õ‹Ÿ¿ÕÙÅ—xõ…•ÑõŒøö„ôSòñòôóòòóôóòòñïîîïïíîîìììëìíîîïïîîîíìëëêçåáÞÙ×ÕÕ×Ýàààáßßáãåçèèèæåäââáàßßßàâåææçéæèèà ÈÈËÍÑÓÓÓÔ„Õ ÖÖÔÓÒÑÑÓÑ…Ð -ÑÒÔÒÓÓÔÕÖׅ؂نÚÖ„×ÓÓÔÓÑÎþÂÆÐ×ÞâäçççééŠæëëìëëëééëìììëëê‡ëì‡íîîïïï†ð„ñïïðððñðññóòóõõ†ö÷‰ø÷÷ùù‹ø†öøø÷ööö†øöõõ…ö÷‹ø÷ˆö–ø>ñ¿m]Y‡vzh…¡¦•‡•‰ÁrT\jz~xz™|Šsz”ƒ»…¤›ž·…l•^Zp‰•™r\Ål~Áíðòóõö÷…õô„óòðð„ïMîïðïîîðñððñðïððïïððñòðîïïîîììëêëêçåáÞÙ×ÕÕÕÙÝÝÝÜÚÚÛÝàãäåäãâàßÞÝÚÙÙÙÝàâääåçåçæÞÿ€ú€…‡€Š†€„€~~~‰~倵·¹»¾ÄÄÅÆÆÈÈÈÉÉ„ËÉËÉÈÈÈÊÊÊÌÍÏÏÐÑÑÓÓÓ„ÔÕÖÖ†×ØØÙÚÙÚÚØ××ÍÈÉÊÐÚáäåêêëŒì„î íîííïïïîîíí…î…ñ…ðññòòò…ôïïðòñïïðððòòòóõòóõõö†÷‰øƒùÒø=ÔšíÓÅ¡ÝÉÕ¸Œ‡ž‹Ë©Ÿ£¡¯¿Ùãñ®¬ï—‹¹ÃË¿‹³õñ«»¹ÏåõñÕ­ý—Áøùøöõö÷†øùùùúúùù÷‹õóóõóòóòñ„ð9ñðïððïîîíìììëéçâÞÚ×ÖÖ×ÝâââáßßßâäæèèæåäãâàÞÝÜÜÞÞáâããâãàááØÃÄÆÉÌÌÌÎÏÏÐÐÑÑчÔÒ…Ñ -ÒÔÖÖ×ØØÙÙمۂ܆ÛÜÜÜÝÜÝÝÛÛÚÑËÌÎÔÝäçèêêëìì…í…ï„î íîííïïïîîíí…î‚ïˆðññòòò…ôóñðîîïïðððïîïïñòóõõö…ô÷‰øƒöÒø8Ô„‚p±­±Ÿá¿¿®Ž’¦‡½“…ƒƒ›³ÁÛ§­‰ûš›³ÉÂǯt‘±±‘•|‘³ÅϽ›ýŸÉŽö÷„ø÷…øY÷öööôôóòóôôóòóôôóòññððñðïïîîíìììîîïððïîîíìììëéçâÞÚ×ÖÖ×ÝâââáßßßâäæèèæåäãâàààßàáâäæææçêçèèßÇÈÊÍÏÒÒÓÔÔÕÕÕÖÖ‡ÔÒÑÑÒÒÒÔÕÓÕÕÖ×ØØ؄كڅØÖ„×ÔÕÕÓÓÒÉÃÃÅÏ×ßââçççéé…å…æêëëëéëééëìëëëéé‡ëì‡íîîïïï‰ðïïïðððñðññóòóõõ†ö÷Šø‚ùŒø†öøø÷ööö†øöõõõö÷—øöö÷“ø>ôÀbYJrrvh­—œ«”†Šr\JPV^`df…”rë•¡žŸ”fltxntX\t™‡rÁ³ˆîîðñóóó…õ óóôôóòððð‰ï ñóññóòññðïð„ò8ñïððïîîíìììëéçâÞÚ×ÖÖÕÚÞÞÞÝÜÛÜÞáãääãâààÞÜÜÛÙÚÜÞâäååæèæçæÝÿ€ú€…‡€Š€€€€€„€~~‰~怵µ¸»½ÃÃÄÅÆÈÈÈÉɆËÊÉÉÊ„ÌÎÏÏÐÑÑÒÓÓÓÔÔÕÖÖÖ…Ø×ØØÙ„ÚØ×ÖÑÏÌÊÔÝãåæêêëŒìíîîîíîííïïîîíííìííîî…ñ…ð‚ñˆòîïðññïïðððòòòóõòóõõö†÷„ø…÷ù¢øù±ø>¿˜™ƒÛÑÇÙ–ÊŪõ•åµ±¯µ·½ÁÛñù°»‹ñ”‹©«˜µ»…É£ÙñÅϳŸ¯ÙãÇ·ÇÓ«òöõôóôöö„÷ø…ùúùø÷‡õHöõõööõõõôòòññðñòñïððïðððîîîìêçäßÚØÖ×ØßåäãâßßßáãææçæåãâàßÞÝÝÞßàáãäãââßáß×ÃÃÅÈËËÌÍÎÎÐÐÑÑÑ…ÔÕÔ„Ó ÒÒÓÔÖÖ×ØØ„ÙÚÛÛˆÜÛÜÜÜ„ÝÜÛÙÕÒÏÍØàæéêêêëìì…í…ïíîîîíîííïïîîíííìííîîïïˆð‚ñˆòññðîîïïðððïîïïñòóõõö…ô÷„ø…÷ö÷¡ø÷±ø>º‰}d©«³ËŒ¹º¦ù‘“Ñ‘…‡‹‰¥½Ç˜«Œý ÙÇ ¶«m¯¥á¯—vp‰¿Ï·­ËÝ­ðôõö÷ööö…÷„ö õóóóôôôóó„ôGóñòòñññðïîîîíîîïïððïîììëêììêçäßÚØÖ×ØßåäãâßßßáãææçæåãâàßàààáâãåæçæçéæçæÞÆÇÈÌÎÐÐÒÓÓÕÕÕÖÖ…ÔÕÔÓÓÓÕÔÔÔÖÓÔÕÖ×…ØÙÚÚÛÛ…×Ö„×ÕÕÕÔÓÑÌÊÇÅÓÛáãåçççéé…å…æ éëëêéëééëìëëê„éê„ëì‡íîîïïï…îƒð„ï ðððñðññóòóõõ†ö÷„ø…÷ùŽø†öøø÷ööö†øöõôõö˜øöö÷“øNö­hU?jvxo›ž™ï‡}›hXHFJNNTdxv’wᎳ©†™—]|VH‘‰nF<\•…‡§Ã¥éëíïòòóóóôôóóóôôôóñððñð…ïððò†ô@òñðñòòóôòïððïïïîíìíìêçäßÚØÖ××ÜááàáßßßááâãããâàÞÝÜÜÛÛÜÞàãäæåæçäæåÜÿ€ú€„„€€€‹€€€€€„€~~‹æ€µµ¸»½ÂÃÃÄÅÈÈÈÉÉɈËÍ„ÐÑÑÒÒ„ÔÕÕÖÕ„Ö…Ø×ØØÙ„ÚÙØØ××ÒÏÚáæèêêêëìíîíìîííïïîîííìììíîî…ñ…ïññòòò…ðîïïññïïðððòòòóõòóõõö†÷„ø…÷ù¢øù°ø?õ¬—ùçÙÓ׈”éï‰ñ—†Á±»¹ÃÅÇÉÝùûªÀ™ƒŸŠjÓµÓ›‰ÉÓ…­Ïýß›¡ý¿×ÙÇÓóòóòòôõö„÷ø…ùúúø÷÷õõöŠ÷(õôòòòñññóñïððïðñðïîîíêèäàÛØ××Øàæåãâàßßáã„æäãáàß„Þ àáäåååââÞßÞÖÂÂÅÇÊËÌÌÌÎÐÐÑÑÑ…Ô ÖÔÔÖ×ÓÑÑÓÓÕÕÖ†ØÙÛÜÜÝÝ…ÜÛÜÜÜÝÝÞÝÜÜÛÙÙÖÒÝäéìíêêëìì…í…ïìíîíìîííïïîîííìììíîîïïððð…ïññòòò…ðññïîîïïðððïîïïñòóõõö…ô÷„ø…÷ö÷¡ø÷°ø:ó¤…Å»¯­Ãz|¿ã‹÷“z©‘“‡“‹™¹µ…¥‘‰©£ˆùËÝŒr¹ÁtµÁÇ­rháµÇÅÇ…Õñðó„õö…÷„öõôóó‡ôõöõ…ôòðïï„î ðïïððïîîììêìíêèäàÛØ××Øàæåãâàßßáã„æäãáàßàááâäåçèéèçéåæåÜÅÅÈËÍÐÐÑÒÓÕÕÕÖÖ…Ô ÖÔÔÖ×ÖÕÕÖ×ÓÓÔ„Õ××ØÚÚÚÛÛ…×Ö„×ÕÖÕÔÓÓÑÑÍÉØàäçéçççéé…å…æ ééëééëééëìëë†é„ëìíí…ìîîïïï…í‚ð…ï ðððñðññóòóõõ†ö÷„ø…÷ùŽø†öøø÷ööö†øöõóõö˜øöõö“ø>öivltv‰]a•½tÕŠnrXRDBBHHPbfcu’‹sá±¹azx6P™™vF,‘z“›¡wÍëèëíïññ†ó$ôõôôóòñðññïïðññòóôõööõõôòññòòòóõòïðð„ï0íìííêèäàÛØ×××ÝââàáàßßááâãããáßÞÜÛÜÜÜÝÞáææèææçãåãÛÿ€ø€…€€€€€‹‡€ €€~„‚~„ç€-´µ¸»»¾¾¿ÁÂÈÈÉÉÉËËËÍÍÈÇÇÇÈÐÒÒÒÓÒÓÔÔÔÕÕ×××ØÙÙÚÚ…Ø×ØÙÚÚÜÝÜÛÚÝÛÚÚÚàäèèèêêêëëêêêë†ìëìííí…îïîïóóïïˆñ…îñññóóóò„ñ‚ð‡ñðïðòòóôôõõ÷÷÷øùùøøø„ùÖøCñ³ŠÑÕÍßóŒÏ¥ß…ï†ñ­¹³ÁÉÑÓÏÓÝïšÁ§  —‰z~£ý¡ßÓ¥ÓûùÏÁ©ñ»¿Ñ·ðñîïòòóõõö÷÷ö†÷öõö„÷öõöˆ÷„ö)õôôóóòòòñññððîîííìéæâÛ×Ö×ØÜâãâäãàààãèåäãã…á‚â…ãååâáÝàÞÕ ÁÂÅÇÉÌÌÌÎÐÑÒÔÔÔÕÖÖ×××ÖÖÖ×ÔÕÕÕÖÖÖ…ØÙÙÙÛÜÝÝÝ…ÜÛÜÝÞÞàààÞÝÝÛÚÚÚàäèèèêêêëëëìì‡íëìííí…îïîíììîî…ïƒð…ñƒð„ñ -ðððñððññïï„ðïðòòóôôõõõôôö÷ö÷ø÷„ö÷ÕøI맻µ­ÁË˧áŠýŠå——…‹‹‰±x¦›Ÿ¤¥›Œƒ‚•Õ‰ÍÁ™»ÙÅ¡¥Éõ½Ãíîññòòòññòóôóóôõöööõ‡ôóòóˆô„óòððïïï…îììëêëêêçåáÛ×Ö×ÚàæææäàÝÜÝÞáäããã…áââããåççèèèêæèçÝÅÅÈËÍÏÐÐÒÓÑÒÔÔÔÕÖÖ××ÖÔÐÎÏ„ÓÕÔ„Õ -××ØØØÚÚÛÛÜ…×Ö××ÙÙ×Ø×ÖÕÙØ×××Ýáååå…çãããä†åè„é…ëìëéêˆëìŠíƒî„í!îíííîëìíííììíîïïððññòññóó÷øøøù÷ùù‘ø†öøø÷†ö…øõ÷šøö÷÷öøM÷ëžafjp…™gŸ…˃õ‚½VXFNFHF@@JbUˆ‰“‘‹‚ws‡µ^›fƒ›nH0¥•¥§æééêïîðôôôöõôóðîñóòðïò„õƒô‡öõ„ôóòòññòôô…òððìççäáÞØ×ØÚÚÞäåäååãáâßßàààß„Þßââããã…âãàáàÙÿ€ø€…€€€Œ‹€‰~}~ç€%´µ¸¹»½½¾¿ÁÆÈÉÉÉËËÍÍÍÌËËËÌÐÒÒÒÓÒÓÔÔÔÕՆׂ؇ÙÚÛÜÝÝÝÜÛÞÞÞàáâåçèèêêêëëêêêë†ìëìííí…îïîïóóïïˆñ…ïñññóóóò„ñïïð†ñïïðñòòóôõõ÷÷÷øùùøøø„ùÖøAì˜Í¥Åááû ž›œ–‰“û³Ã¹ÅÓ××ÓÑÓÓŹ®¥——£­¸Ã‘Á–Œÿƒ‚·á‰åÇãÜýòððïðòóóôô„õöö÷öõõ†öõö‡÷…ø)÷öööõôóòòññððîîííìêçãÜ×ÖÖØÝáäããáßÝÝàåãâââ…áâããäãããäåâàÝÞÝÖ ÂÃÅÆÈÊÊÌÍÏÐÑÓÔÔÖÖÖ××ÖÕÔÕÖÔÕÕÕÖÖÖ…ØÙÙÙÚ„Û‡ÜÞßßàááàßÞÞÞàáâåçèèêêêëëëìì‡íëìííí…îïîíììîî…ïƒð…ñƒð„ñðððñïïðñ‡ïðñòòóôõõõôôö÷ö÷ø÷„ö÷ÕøD䌹­ÉÅÛŽ•œ¢žŒÛ“~…‡……ƒƒƒ|c¢¥¤ š•˜£ª¤—`sqe¿ac‘±¡á¹ÃÊîìñðïððïïððññò‡ô…óòòó‡ô…õ)ôóóòññðïïîîììëêëìëèåáÜ×ÖÖÙÞãååâÞÛÙÚÚÞááââ…áâããäåæççèèéæçæÞÅÇÈÊÌÍÍÏÐÓÐÑÓÔÔÖÖÖ××ÖÕÑÏÏ„ÓÕÔ„Õ‚×…ØÙÚÚ‡×ÙÙÙÚÚÚÙØÛÛÛÜÞßáäåå…çãããä†åè„é…ëìëéêˆëìŠíƒî…íììíí…ëìììîïîïðñòòññóó÷øøøù÷ùù‘ø†öøø÷‹öõ÷šø÷÷ø÷ŒøQ÷øøø÷ドPn•›»ˆ“›˜ƒ~¥LN<@@>:4028B‡Œ‰ˆš ›ƒ(t[ZNHJ^ —£»ãàåæêíðññòòóôñîíïññðïò‡ôˆö„÷ö…ô!õõôóóòòððìéçäâÞØ××ÙÙÝâåãäãáßßÜÜÞ݆Þàâããä‡âàáàÙÿ€÷€†‡€Œ‹€~€€€€€|}~瀵µ¸¹»¼¼½¾ÀÄÆÈÉÉÌ„Í…Î ÐÒÒÒÓÒÓÔÔÔÕՆׂ؇ÚÛÜÝÝÞÞÞÝááâäæäæçè„êëëêêêë†ìëìííí…îïîïóóïïˆñ…ðñññóóóòñññðïïððññ„ïîïññðòôõö÷÷÷øùùøøø„ùÖø<çã……­ùÏÿ··¤Ÿ—Œ”立·ÇÙÙ×ÕÑÑˉʾžû¥—ÅߌŠéÁ‰˜£¢ç¿Û¿ù`‹áÛüùøöññ„òñòóóôõö‡÷ø„ùø„÷8öõôóóòððîîîííêçãÜ×ÕÖ×ÝâãââàÜÚÙÜâàßßààáââãããääãââããáàÝÞÝÖ ÂÃÅÆÇÊÊÊÌÎÏÑÒÔÔÖ××ØØÖÔÔÖ×ÔÕÕÕÖÖօ؄لۆÝÞßàààáâáàááâäæäæçè„êëëëìì‡íëìííí…îïîíììîî…ï‹ð„ñ„ðïïðððïîîîïîïññðòôõöõôôö÷ö÷ø÷„ö÷ÕøGÚËppå»á¤¬¤¢žŽŠÍ~…zƒ‹‡……ƒr]¥©‘祙¿Ù‡w¡pdqol§‡•Á¡h|ÁÂäðñòðñòïïïîïððòòó„ôó†òó‡ôõ„öõ„ôò„ð3ïììëêëìëéåãÜ×ÕÖ×ÝâãâàÝØ×××ÛßÝßààáââãããääåææçççéåçåÝÅÇÈÊËÍÍÍÐÑÏÑÒÔÔÖ××ØØ×ÖÓÏЄÓÕԄՂ׆ØÙÚ†×ÙÙÚÛÛÜÝÜÛÞÞÞàâáâäå†çãããä†åè„é…ëìëéêˆëìŠíƒî…íìììíì†ëìíîíîðñóòññóó÷øøøù÷ùù‘ø†öøø÷ö…ø…öõ÷®øHõÖ·LDd·•Ãš¤›ž—„w—:D8@D@<8020>Š‘}Á¯Ë~n B[UU|^rnP`Hb›©Ñàâèëñòñññïðñïíìî„ïò‡ô‡ö†÷<ööõõõööõõôòòððíéèåâßØ××ÙÙÝâãâãâÞÜÜÙÙÛÚÛÜÜÞÞÞáããääâààââáâÞàÞÙÿ€ö€‡‡€Œ„€…€€~|€€€„}{}瀵¶¸¸¹»»¼¾¿ÃÅÈÉÉ…ÍÏ„ÎÐÒÒÒÓÒÓÔÔÔÕÕ×××ØØØÙÙ…ÚÛÛÜÝÞÝÞßßßãããåæææçé„êëëêêêë†ìëìííí…îïîïóóïïñ$óóóòñññïîîïðññïïîîîïðñïñóõö÷÷÷øùùøøø„ùÕøHôȳñÕáŸ×™•óåõû¥³¿ÍËÇÉÃÁÉзÁùÅÕ¹áÑÙ…`É’¥ž‰ÙÉ«Åp‘•Ç©Íòùúòñòóòñññòñòòó„õö†õö‡÷†ø„÷8öõõõôóððîîîïíêèäÝØÕÕ×ÞãåãâßÚØØÚßÞÝÝßàáââããääåãââããáßÝÞÝÖ ÃÄÅÆÇÉÉÉËÍÎÐÒÔÔ××ØØØÖÕÔÖ×ÔÕÕÕÖÖÖ…ØÙÙÙÛÛÜÜÜ…ÝÞßßáááââãâãããåæææçé„êëëëìì‡íëìííí…îïîíììîî…ï‹ð„ñ ðððïîîïððïîíìîîïðñïñóõöõôôö÷ö÷ø÷„ö÷Ôø@︕Ž‡Û‘¹‡ˆçãùýŠr|x|…‹‰‰‡~~k²¦±åÑíÁéѵl‰±tpm^™‘¡Á¯”·áîóñóòïï„î ïðññòóôôó†òó‡ô†õ„ô8óòñððïììëêëíìéæãÝØÕÕÖÚßáàÞÛ×ÕÔÔØÜÜÝßàáââããääååæææççèåæåÝÇÇÈÉÊÍÍÍÎÐÎÐÒÔÔ××ØØØ××ÓÏЄÓÕÔ„Õ -××ØØØÙÙÚÚÚ…ØÙÙÚÜÜßàáááßßàáãããäæ†çãããä†åè„é…ëìëéêˆëìŠíƒî„í!ìëëëììëëééëëëíîìíïñóòññóó÷øøøù÷ùù‘ø†öøø÷ö…ø…÷õ÷žøö÷ŒøJ÷øí³‡•|\§b™z|ÑËçéy[HDFLNHDB<26J•Œ‰…©•±µ•8\XQP68`v…PphzršÊÜäëñóññïïïðîëêì„ïò‡ôˆö„÷=öööõõö÷÷ööôòòððíéèæãàÙØ×ÙÙÜâãââàÜÚÚÖÖØØÚÛÜÞÞÞáãääåâààáâááÞßÞÙÿ€ö€~~„‚€„‚€‹€€€„~}~~~}~€€€}~~||~瀵·¸¸¹»»¼¾¿ÃÅÈÉÉ„ÍÎÓÒÐÒÒÐÒÒÒÓÒÓÔÔÔÕÕ×××ØÙÙ‡ÚÜÜÝÞÞÝßàààãããåæææçé„êëëêêêë†ìëìííí…îïîïóóïïñ$óóóòñññïîîïïñðïîíîîîðñïñòôö÷÷÷øùùøøø„ùÔøDùËëùñµ‹ÃÙ‰•õñõõ…熟™­»¿½»¿·±Á–ТéÕÙp`¹“ÉDÉŠ¡“P•‹Á`pÕ¨Ý÷ûóïòóóòñð„ñòóõõõö†õö÷†õ3óððîîîïîëèäÝØÕÕ×ÝâäãáÞÙ××ØÞÜÛÝÞßáâããääååãáâââàßÝÞÝÖ ÃÄÅÆÆÇÇÉËÌÍÏÒÔÔ××ØØÙÔÔÔÖÖÔÕÕÕÖÖÖ…ØÙÙÙÛÝÝ݆Þßßàáááâäääãããåæææçé„êëëëìì‡íëìííí…îïîíììîî…ï‹ð„ñ ðððïîîïïðîíììîîîðñïñòôöõôôö÷ö÷ø÷„ö÷ÓøNð¼ËÁÅ™‹ÃÅlt¹ÁÉé‰á|‰vƒ‡‹‰‰‡|‡w¶˜ÙÙñ…¹™ÕÅ…åvsgxÁ¡‹zÁ¡‘µ…•Íéóñóñðïïîíîîððññòôôó…ñòóô„ò,ñðïììëêëíìéæãÝØÕÕÕÙßáßÞÚ×ÔÓÓÖÚÛÝÞßáâããääåååä„æèåæåÞÇÈÈÈÊËËÍÎÐÍÏÒÔÔ××ØØÙØ×ÓÐÑ„ÓÕÔ„Õ -××ØØØÚÛÛÜ܇ÙÛÜÜß„á àààáâããäæ†çãããä†åè„é…ëìëéêˆëìŠíƒî„í!ìëëëììëéééëëëìîëíïðóòññóó÷øøøù÷ùù‘ø†öøø÷öŠøõ÷žø‚öŠøQöøøì¹Á™¡hbdDV‰…‘½vÍiXHPXTNJJB0FHFB<>8JZ,hd¡­¹ÕãxTRf>AL< `ƒB, L…p­ËƒFPT`f?Rf@£©TP¡¯½v›Éïùð„ïîîîíí…ëí†ïñôôõõõöö÷öööõööõõ…ô)ñññðïïîíìéééäÝÙÙ×ÙÝáâÝ×ÓÐÑÐÑÖÚÝáäåæææåääã‡äçèéâÿ€ô€~~„~€~}„~‹~~}}~~‰ €€}|~|{~å€Bµµ´´³º¼¾ÁÃÅÈÉËËÏÐÑÒÒÕÕÓÒÑÐÐÑÓÓÔÕÕÕÖ×××ØØÛÛÝÝÞàààââààáááâãããäãäåçèæ…èçæèé…êë„í -ìíííïíîïïî‰ñóñññ„óôˆõôóññ…ïî…ïííîïïññóõ÷÷ùùùØøD÷ѳ¦™Á™ùÉ͵ɕ«¡ñÛ©‡…|Õ¡¯»ÇÉÅÁ»±±±É‡ùõßÏ¥¡½ÝáÕ៬ˆÙᆛz`¥ËÍí§ñóööö…õôò†ñðïîîïïïñóõõõö÷÷ø„÷ öööõõôôõó„òññðïïìêçàØÔÒÖÛàáàÞØÔÒÑÒÔØÜáää„æåääãä„æäââáßÚÃÃÂÁÀÂÄÆÉËÏÑÓÔÔÖ×ØÙÙÙØ×ÕÔÔÔÕÖׄØÙÚ†ÛÝÝÞßßß„àáááâãããäãäåçèèéééêéèèé†ëêêêëìêìëëííîïïî…ðïïïðñððð„ñƒò…óòòñððîîíííìííîîíìììíîïðñòóôöööØøLõÉ¢–‹³•õÑݱ­hvp×Ë™z|©dr~‰‹‰…~rpDHp~íçÓÃt~—¡¡«yŠo‰ù†ŽÑÁÕãï“Øðöòôôóóóòòðð…ïíìëëìììîðñòòóôôõ„ô óóòññðññðîîï„îíëéæåàØÔÒÔØÜÝÝÚÕÑÎÎÏÐÔÙÞâä„æåää†ãäåäãáÜÇÆÅÅÄÇÉÌÎÐÏÑÓÔÔØÙÚÚÚ×ÖÕ…ÓÕÕÕÖ×ׄØÙÚØØÙÚÛÛÛÜÜÜààáááâãããäàááääß…áàßáâ…ãæççèéçéèèééëìëë…ìëëëíîííí„î‰ïîîííëê†éëëê„é -êëíîïøúùùùŒøöóóžøƒõ‹ö÷˜øI÷øøøðÀš‚nxáÁzj.DLµ­~dLHh8@>@FHFB<BDHFB>4,:J\l`nnb|¨šzùÁ™¿áÓw¬ßâõôôõõõôôóóóñð…ïíììííïððòòóõôôõõõôôòññî„ëî†ð"îëéæáÝ×ÓØÝÝÝÛÙÕÔÒÑÒÕØÜâææèèæççæåäç„éèèåæåÜÿ€ô€~€ˆ€€~‚~Š~~€€€~€€€}|~䀱°­¬¯±´º¿ÂÈÉÌÍÍÎÎÐÐÑÒÔÔ×ÖԄՄ׆ØÙÙÚÜÜßàáââáââããâááààâãäææè…éèêëééëëìííëëííˆïðñð†ñ‚ó†ô„õö…õö÷õôóñïïîïîðñññðïïîëëìîðòõö÷ù×øDöøந™Š‡…„ñ©ã­³©£Ÿ£¯©™™™¯¿ÇÇÇÅÿ¹±³¡……Ÿ¿Å¿¹ŸŸ¯«¥Õ£ ¹ ¹Å°¶¥Á tÍu‡ Êüó„õ%öö÷÷öõõôóòòñññðîííîïïïîïðñòóôõôôóòñðð„ï†ð"ïîíííìëèæãáàÝÚØÕÓÒÒÕÙÚÞäååæææçèçæå‡æââßÖ ¾½º¹¼¾ÂÇÎÒÐÒÔÖÖØÙÙÚÛÜÛÚØØÖÖ×××ÙÚˆÛ&ÝÝÝßàßàáââáââããâááààâãäæææçèèçèæèéèèèé…êëìíííîîíîîîïîïï„ð‚ñ‡òó‹ôòñðííìíìîïïïîííìèêéëíïðóôöÙøOÝ™«Í‘ù¡ÏzzxvpxfVjp|•••‘‹‡trdPNj|vt~‡½³¦§™Õݪµ¯ù¡©á‚‹˜¹ìëòñòòóóôôòòñðï…îíëêêëìììëìííîïñññðïïîí†î„í‚ì…ëèæäáÞÝÚ×ÖÕÓÒÒÓÕ×Úáäç…èçæåå…äåâããÜÂÁ¾½ÀÄÇËÎÐÕØÙÚÚØÙÙÚÛ„ÜÛÙÙÚÚÚ„ØÙ…Ú,ÛÛÛÝßßàáââáââããâááààÞàáããßàááàáßáâáäåæçççææè„éëëé‡ë…í‡îïïïðð…ïññïïîìê„é…ë éêèåæéíòõöøúùŽø‚öžø‰ö÷¡øk͆tnmzµãz—JFD@86DF640DRVTRNNPNHJ>((>NLFJ8426FFFPRD24F‹ÃŽš–\¡›«»`…Çn~ˆ¡àèðóóôôôõ„ô óñññòññïïíìì‡í îïðñññïïîíë„éì…ï#ðîéççæåäãããàÜØØÕÕÔÔÖÙÛÜâäæèèèééèèæè„êèéçèçÝÿ€ô€€~£„€ }€€€}~æ€"²²®­°´¸½ÀÁÉËÌÎÎÏÐÐÒÒÒÔÒÖÖÖ×××Ø×ØØ؆ÙÚÚÛÜÞàáá…ã ääâááààâãäææçèéèèèçéêèéëëìííëëííˆïð„ñ„óôˆõö‹÷õõòðïïïðòóóòóñòðíìéêîðóöùÙøEñʲ­™ëbx•Ó…µÍ¡¹··µ»µ£¯½ÃÅÅÇÁ»·¯©­¥¥³ÃÑÓǵ­›»›²¸²¾´zhœ³ªÇ,dÛˆ›œ¯ðû÷ó†õ‚ô…õôóóòðð…ï†î…ðïî†íî„ï$îîííììíëëëéçåàÜÚØ×××ÚÝÞßãæçéêëêêéèèæ†åßßÜÖÀ¿¼»¾ÀÄÊÍÎÑÓÕÖÖÙÚÚÜÜÜÚÙ†ØÙ„ÛÜ…ÝÞÞÞàáàáá…ãääâááààâãäææåæç„æçèæèèé…êëìíííîîíîîîïððð„ñƒò…óôôôõõ…ôööôóòñ…îð„ñ ððîëêççêíðòö÷×øG÷踖”õ‡©¨}±wµÍƒ…~znhb`z‘““•‰ƒznllhp…‰‰‡rŸ•®»·°µ©ž³³ç…¹õŠ˜š¬êíïðð…ñ ððññððññððïí…ì‡ë„íììëêë‰ìë…êéèèçæäáÝÙØØ×××ØÚÚÛßããåççéêéèèç†æäææÞÃÿ¾ÁÍÎÒÓÒÖØÚÛÛÙÚÚ„ÜÛÛÚÛ„ÜØÙÚÚÚ…ÛÜÜÝÞßàáá…ãääâááààÞàáããÞßàßßàßàáßäåæçççææè„éëëé„ëìíííîîî‰ïðñòò…ñòóñïïíëëêëëíîîíîìíëèçæèïòõ÷ùø‚ö£ø„ö÷ø]÷õõá«zvË^v©p‰•^VB:2442BFRV\\TTTLB@<8@FBJRVL:*f~›¤ ¡¢np—œ©åh©ÝvˆŒ™Øèîñòóôôôóòòóóòòôóññðïîîî…í ìììíîïïîïîíìê„éë„í$îðíéçéëêêéçæãßÚÙØ×××ÙÛÜÝâäåæèééêéèèé„êéêçèæÝÿ€ó€ €€€~~ †€ ~€€€~~怵´±°³¶»¿ÁÁÉËÍÎÎÏÐÑÒÒÐÒÒÕÕ×׆؇ÙÚÚÛÝÞàáâ„ã!äääâááààâãäææççèèçèçèêèéëëìííëëííˆïðñññò„óˆõöŒ÷öõòðïïïðòóôóõóõòïìééìðòöùÙøNÚ¸¹±›Í™••‰ë¨¿™£ÁÑÓ½·¹©·¿Á¿Åù³­¥£§£Ÿ©³¿ÛßÑǹ†Å¸»½Á¯rr¢³§ÓH\ÛŸ˜¢æûøóóõõôóóóòô…õóôóñðñðððîííìëìî…ïîˆí…îííì„ëêéééæãÞÜÚØØÙÛÞÞßãæçéêëëëêèèæ„åäåÞßÝÖ!ÂÁ¾½ÀÂÆÊÎÎÑÓÕÖÖÙÚÛÜÜÚÙÙÖÖØØÙÙÙÛÛÛ‡ÝÞÞÞááàáâ„ãäääâááààâãäææå†æçèæèèé…êëìíííîîíîîîïðð…ñ‚ò‰ô‚ö…ôöööôòñ…îññòñóñòðíêææéìïòö÷×ødôʘ–ŠÏÑç…Û˯“…‹‹p^`b‘‘“‡ƒzlhjlvƒ‰™¡Ÿ¡‘dw¾±´¸ª©—™¥²°ñ¥½õ‡˜˜¢áíïððññðððïïðòññòòððïîíîíììëêêéèéê…ìëêêë„ìë…ê#éêêêéèççæææãàÛÚÚØØÙÙÚÛÜßâãåççéëêèèç…æçäèçÞÅÅÂÁÃÏÔÕÓÓ×ØÛÛÛÙÚÛÜÜÚÚÚÙÙ…ÜÙÚÚ‡ÛÜÜÝßßàáâ„ãäääâááààÞàáããÞ†ß àáßäåæçççææè„éëëé„ëƒí„îˆïðññóó…ñóóóðïí…ëíîîîïîïíéçåèïòõ÷ùø‚ö£ø„ö÷øLôøñÂ’ƒ{·§~ع—r\NN8.2888@BDXfh`F Zª ¢ª¥šhxžœ¥ó½í{ŒŠÏèïññóóò„ñ óôóôôóñòñ†ïíëëêêêìíîíîííìëê„éë„ì$îîìéæèééèèèçäáÝÛÚØØÙÛÜÝÝâäåæèéêëêèèé„êéêçèçÝÿ€ó€~€€€¡‡€ €€€~~æ€#¸¶¶¶·¸»½¿ÁÈÉÌÎÎÒÑÔÕÒÕÓÒÒÒÕ×ØÚÚØØÙÙÙ‡ÚÜÝÞààáâãääãããâââááãäääæˆèéê…ëíëë„íîïï†ñ -óñòõóóõõõô„õö÷ø„÷ø…ù÷÷óñïïïññòóôõõõóñîëèêïòö÷ØøJ趮ª¦¡t«¡‰í©÷ÁÏË¿±«­©¹¿ÃÅÁ»···¯Ÿ—›Ÿ¥±¿ÛçÛÝí培·¼º¨Õd˨±£uX`ɘ“¢áýüøóñõö„ó…ôõõõó…ñ -ðîîîíííîîî„ï‚î„íëì‡íëëëê„éèæäâà„ß ÞÞßáãåèéëëë„ê éæåååèçãâßÚÇÆ„ÄÇÊÍÏÐÑÔÖ×ÜÛÝÞÜÛ„Ù -×ØÚÛÛÚÚÛÝÝ…ÞÝÞßàáààáâãääãããâââááãäää‰æçèèèé…êë„ìííïï„ðñððòññ…òôôóô„öôôõ…öôôñïíííïðññòòóòñðìéæéíðôö÷ÖøJ÷Ùœ˜–—~·­¿¨„Ó¢¡ù©›‹n`bn“••‘‹…~pdflv~…‰›¥¡£µ»•µ²´µ¨Ù‡ý°±ª…¥­ãŽ›•ŸÕêìîðññ‹ð -ññïîíîîîìë‡êë„ìêêëìŠêéèèèçææååäãàßÜ†Û ÜÞßâäæèèé„ê éèææèéçæçæàÁÂÅÉÊÏÏÏÐÓÕ×ÚÛÜÜÛÝÞÜÝÜ„Ú ÜÝßßááÞÛÛ…ÜÛÜÝßßààáâãääãããâââááààááâˆß àáååæææçææè†éëëìííìîìíïîîïïïî„ïð„ó‚ö†÷öõîìêééèéêêëïïïîíéæãæéíñóôöÒøNöø÷øØ”‡‚k—|¿¨{»“ŽÅlXZL4266LV^bb\XVTH88@HFBHT^flz‡~¡¥­­ŸÅlᥨz•­Ù„ŽŠ–Ñçíñññóò„ñ†òóóñ†ïíììëëìììííîííììëéççæé„ìëëëêêëìëëêêéçæäà…ÜÝÝßâãæèé†ê ëëêêëêçååäßÿ€ó€~€€€€ †€ƒ„€~~怄»¼»¼¿ÁÂÊÌÏÐÑÒÒÔÕÓÕÓÒÒÒÖØÙ†ÚÛ…Ü -ÚÚÜÜÜßààââ„ã äãããââäääææ…èéèèé…ë ìíëëíííîïïï†ñóñòõóóõõõôõöõõö÷ø„÷ø…ù÷÷õòðððñóôõõõöõôôðëçêïðö÷×øK뤕 –ë“hÏ™ƒáœ­¢ÿÕÓ³«£™Ÿ¹ÁÃÿ¹µ¯­¡—™¥¯µ¹ÃÝååÿ“¦©›¦ª’•Ñ¯•±°¥‚`­‘›“¡Äûüûôóöõ„ó…òóõõóòñòòòðïïîîííîîî„ï‚î„í†ë‚ì„ë -êéééèçææää„ã âààâäåçéëëë„ê éæåååççäãßÙÊÉÈÈÊÈÊÍÐÒÒÔ×ÙÙÜÜÝßÝÛ„ÙØÙ„ÛÜÜÞÞ…ß -ÞÞßààßààââ„ã äãããââäää‡æçææèèèé†ê ëìììíííïï„ðñððòññ„ò…ô„öôôõ…öôôóðîîîðñòóóóôôòòîéåéíîôõ÷Öøî™|ˆŠ‰í©™á¡†Û™¥“Ù±µ—~jbz„.—‘…~pddlv~ƒ¡«Éy–£œ§¦’—ÝϪ·±¯•Ù±É–ž•·èêëïñð†ï„î ïññðïîîïîìììë…êë„ìêêëìêêêé…èéèèçççææåäããâá…à ÞÝÝÞááãæèèé„ê éèææèèççèæßËÊÌÎÏÎÏÑÐÐ×ÙÜÞÞÜÜÝßÝÝÜ„ÚÜÞßßâãßÜ†Ý -ÜÜÝßßßààââ„ã äãããââáááââ…ßàßßáâåææçççææè„éêêëëìííìîìíïîî…ïñðïð„ó‚ö†÷öõïí„ëìíîîïðïïîëæâåêëðòôöÕøFè’rxwwË‘|ãŸ{ÁŽœ†³ztN888BXVZ\\\^VNB68DLJDLV\pf…—“Ÿ ‹‰½µ™© š†Å±¿‹‘‹•²äë„ïð„ñ…ð ñóóññïðñðïîíí…ì ííîííììëéççæè„é„ê éêìëëêéèççæä„á àÞÞàâãåèé†ê ëëêêëêçææäÝÿ€ò€ -~€€€€€‡€~…€~~怼¼¼¾¾¾¿ÁÂÄËÍÏÑÓÓÒÔÕÔÕÓÒÒÒÖØÙ„ÚÛŒÜßßàááâãã…äããä„æ…èéééêëëëìíííëëíí…ï†ñóñòõóó…õ÷÷õö÷ø„÷ø…ù÷÷÷ôñññóôõõõ÷÷÷õõòíèéíïô÷ÒøPùøøøï«ëù™‘Šß‰…뒃ņ®§ûËÅ¥­¥—¥»ÁÁ¿¹··­‘™§¹½¿ÅÙá󋦫³×“á“u‚—®š„\…•—¤µôúûôôùõ…ò„ñòóõô…òñïïï†î„ï‚î„íŒëêéééç„æå„ä„ãååæéêëê…è -æåååççåãßØÊÊÊËÌÌÍÐÒÓÔÖØÙÛÝÜßàÝÛ„ÙØÙÛ…ÝŽßàááâãã…äããä‰æèèçè‰ê ëìíííîîïï„ð -ñððòññòòòó…ô„öôôõ…ö -ôôôòðððñòò†ô -òñëæçêíòô÷ÑøP÷øøøô¬×σ…é±ý›Ï†Ÿ”ß·½•‹vl‡©©§¥Ÿ—…ƒvlnv|ƒ‡‘™¹q~›‘¹ÅçŸù™ƒ“—­¤™åµ— ™ ¨âçëïïîî„ï…îïðñð…ïîìììë„êë„ìêêëìêêêé„çƒè„çææåä„ãâ„á -àßßàááãåçç‡è ææèèçèèæ߃φÐÎÙÚÝßàÝÜßàÝÝÜÚÚÚÛÜÞààääáŒÝßßàááâãã…äããáââãã…ßááàáãææ„çææèéééê„ë -ìííìîìíïîî…ïññïð„ó‚ö†÷öõñîíííîîïïïñññïïíèãäçêïñôöÏøQ÷ðøóõìŸÁ³spuÏ©ý˜‚·~žÉ|H@@>Td\b``bdVL>68FRXRJLNZ|Z©‚ÛµŸ­Ýóó~•”‚—ñŸ~‘š™¢×åééêêí„ñ†ðñòò…ñƒï„íììííîííììëéççæè‡é èèêìëëêêééèçå†ãâãäãäæèé…è êëêêëéæèçãÝÿ€ì€ €€€€€€ €€~~…€€€~æ€#¾¾¿¿ÂÂÂÄÄÆÊÍÏÑÑÓÓÕÖÔÕÓÒÒÒ×ØÚÚÚÜÝÝÜÞ‰ÜÚÝßßàááâäååæåååä…æ…èëééëëì…íëëííïïïˆñóñòõóó„õ„÷ö÷ø„÷ø…ù÷÷ùö…õ„÷ù„÷óëåâîó÷ÕøMèͽõÿ„…×­“ŒzjÙÕr¥µÅÁÇÍÃÅÿ·¹³§›‹•§·¿¿ÃÕçéá·ûéj‘›«“•­™Ñ…’q~V~›¬£·éýþ÷ö÷ö„ñ‡òôõ…óòðððïï„î„ï‚î„í‰ëééêê…é‚çˆæ ååæåæçééé…è -æåååææåäÞÙÉÉËÍÏÏÒÓÔÕÓÖ×ÙÙÝÝßàÞÛ„Ù -ØÚÜÝÝÝßßàá†àßßßÞÝßßàááâäååæåååäŠæèèèé„ê -ììêêêëìíîî„ï„ðñððòññòòòôôöõôô„öôôõ…öôô÷õôòòñòôôôö÷öõôôñêãáìñô÷ÔøJç{·Ÿáùˆ‡é˧‰›íÍ~­½³Ÿ‘ƒ…©³¯«£™‘‹‹‡‹‘›™™“•¥¯»©ùÿµ¿Ëœ™·©¡›ˆ»‘Å‹ ­ «×ééíˆî†ï ðñðïððïïí„ìëêêë„ìêêëìêêêé…è ççææççææåååäˆã -âááãââäææç†è ææèçæééåßÚׄÓÐÐÏÎØÚÜßßÝÝßàÞÝÜÚÚÚÜÞßààäæâ‡ßÞÝÝÝÜÝßßàááâäååæåååäââããã…ßâááâãçççééçææèéê†ë -ìííìîìíïîî„ïñóòñð„ó‚ö†÷öõóñïïïóôõööóóóòññíæßÞèîñôÐøQõóõøáp—ƒ¹Ñt{ÙDZŠ“‚tå݃¥¡zLFRhzzz~~xxlZPB@T`f\PLP^r‡Ý륫¹–”±Á±‚•­‰µ}“¤˜¥Óçéèêêì„ïð†ñòó†ñïïïíííììííîííììëéççæè„êéééèèêìëëêêêéèçæ‰äãäæ‡è êëêêëéæèçãÞÿ€ì€„ €€€€€~~¥ €€}}€€€æ€)¾¿ÀÀÁÇÈÉËÌÍÍÍÎÎÑÓÔÕÕÚÙØØØÚÛÝÞÞßßÞÞÝßÞÞÞÝÞ„Üßßàááàáãåæèèèçæéé†èçæéé…ë‚í„ëìíïïïð‡ñóóô‰õŽ÷„ùø÷öõ…øù„ø ù÷ðæàèõ÷÷ÒøRöޛû¹ñ…y鵓Ùo­µx¡§±³Ë¿›ËáÓ÷«¯¹¿·—‰©¯»ÅÑÉÑÛëÅ£tw£©±‡žxxHÁÕo±©Ï¥©¼êøúø÷öóóññˆòóóõó†òñðïïðˆïîîìëíì‰ë êêëêéèçææåååæ„çæçéè„é‰èæåããäâÜ%ÊËÌÍÏÐÑÒÓÔ××ØÙÙÛÝÞßÞÜÛÙÙÙÜÝßààáààááââ„áàßßàßßàááàáãåæèèèçæèèæææêééˆèêëëêêééêëíîîîïïï„ð‚ñ„òó“ô„ö -õôóñõõõöö÷„ø ÷õîåÝåòôôÒøQõÞš½©ŸÛ…†„ÿÓµý ƒõù…§Áɧ›™—‘‰‰—Ÿ¡•‡ƒ‡zƒ¥§§•‘‡—¥·¥¡ŒËÕÛ‘¢ƒ¥pÑß›‹ñÝï‹š«£®Ûêìîðîññð‰ïððñð†ïîˆì -íìììëêéèêé‡è…çæåääãâáááããääããã„åææçˆèæçææçåà%ØÕÔÓÒÕÕ×ØÚ××ØÙÙÛÝÞßÞßÞÝÜÜßáãããèçãßßáà…ßÝÝÞßßàááàáãåæëëèäãääããâáááàßáá„â -ãääãæææçèé†ëìíííîîî‰ï‚ñ…õ‡ö÷÷÷øööôôùø÷óóóôõõöóòëáÚæóõöÐøT÷õô܉»pnlßÁ³ù™vÍ푳ûh\`fphr‰•pVPX`|hRPZJP\xproµ»¿ˆŸ™ÑדƒëÏᜒÑàçîòíëêëîŠñóò†ñïïîîïîííëéëîðîìêêëˆêééèèéèæææäääãääåææåäå„æèèêëìììêèèèææååæãÞÿ€ë€„ƒ€„€€~~ €€€€€~}|€€æ€ -ÅÅÆÇÇÈÉÊËÌ…ÍÏÏÒÓÔÚÚÙÙÚÛÞßààáààß„Þ„ÜÚÛÜÝÞßàáãäåçèèééèçééé…èçæéé…ë‚í„ëííïïïð‡ñóóô‰õŽ÷ùùùøùùøø…ù…øùøöðìíõ÷ÑøT÷øËí»·µµõŒ†|ïÍ¥³oµD`›ÃÇŹÓá¿íƒÃÑ××ÏãçɱýáßËÓÑÇ¿Ù‘ó£Ãqq‡˜„É@Hxz‰lfnw|„›¨Âíúúùøöóóññˆòóóõô…óòòñððð‰ïî‰íìëëëêëëêééççæååå…æ åæçèééêëéˆèææääåâÜ -ÌÍÏÏÐÑÑÓÓÔ…×5ÙÚÜÝÞÜÛÛÛÜÝßáááãááãâáááàààßÞÞßÝÞßàáãäåçèèééèçèèçææêééˆèêëë„ê ëìíîîîïïï„ð‚ñ„òó“ô öööø÷öõõööö÷÷…ø ÷÷ôîéêòôõÐøS÷øÊë¹µ«Ÿßˆ‰„ÿåÃ×Ù™·áçÑŸ›¹µå`rpprx~thLpñ×Å›—‘‘­|Ù¥Ó‚‚˜¥í±…ƒ›‡„‡‰‡ ¤¶ßììðððññð‰ïððñ†ðïîí‡ìí„ìêêé†êééèè…çæåääãáááâãããâáããåææçççˆèæçççèæà -ÛØ×ÖÕÕ×ØØÚ…×ÙÚÜÝÞßßÞÞßáãäååéèåáà…ßÞÝÜÝÝÝÞßàáãäåçèììéå„ä ããáááàßáá„â -ãääãçææçéé†ëìíííîîî‰ï‚ñ…õ‡ö÷÷÷øøø÷÷ùø÷óóõõõööóôñëæëóõöËø÷„øTóõÇ㥓‡~¿trlá×ÃÓzÁ`‘¹ááÇl…©N^T^dbZLD2XåÁ—bffXNj_«|¹‡xu‹›ˆá‘…}‘{z~‚‚„ŽžËÞçîòîëêëîŠñóò†ñð„ï -îííëéëîðîì‰ë êêêéèééèçæææ‹äåçèèèéêëìììêèèèæçæææäÞÿ€é€†ƒ€„€~~ˆ~Š‚~ˆ€†€~|}~ì€ -ÈÉÊÊÌÉÉËÌ̇ÍÎÑÓ„Ú(ÜÝßáááãáááàßßÞÞÞÜÜÚÛÜÝÝßáâååçêëêêêéèëëéé„èçæéé…ëííëííìí„ïð‡ñóóô‰õŽ÷ùùùøøˆù‰øõóö÷ÏøVùøøÖ‚ÃË«¯¹‚‘ƒ÷éßÇÉqÅ`H|³ÁŽՃ…í‘‘Ëåïïë¯Éé‘¡ƒëÓÛÅËÇÓŸÏ£y„„‘†¥\¹™ÝŽ}lhqu~}¥Ìïùûùøöôóññˆòóóõô†óòññððŠïííîˆí†ëéééççææ†å äåæèéééëéˆèææåååâÜ -ÍÎÏÐÒÒÒÓÔÔ‡×*ÙÛÝÛÛÛÝÞßáãããäããääâââááàßÞÞßÝÝßáâååçêëêêêé…èæêééˆèêëë„ê ëííîîîïïï„ð‚ñ„òó“ôöööø÷†ö‚÷ˆøõòïóôõÎøU÷øøÔ¿É«©§v‰…ý÷ñãçã•¡ÛÛÉŸ¡l{õx\hljnl.(P§ƒÍ¥›§£¹’”ϱ†Ž“Á‘å­ë™……†ˆ‰’ Àáìíðñðòñð‰ïððñ‡ðïîî†ìí…ì‹ê…èçææåäããâˆáãäæææççˆèæçèèèæàÝÚم؂ڇ×ÙÛÝßßßàââåæççëêçãáááàßßßÝÜ„Ýßáâååçêëíîêæäååääãáááàßáá„â -ãääãçççèéé†ëìíííîîî‰ï‚ñ…õ‡ö÷÷÷øø„ùø÷óóõöö÷øõöõòïñôõ÷ÍøWöðôöÎ|¹µ‡…‡fvoÕÙååç{Ïx¡™Ó×¹rRiÑPPVVRTPP—t«vxnndzv¯¡‡ƒ‘‰³Ý­é”…zx}…ƒŠ¦ÌÚèîóîëêëîŠñóò‡ñ„ïîííëéëîðîíìëìì‡ë êêééêéèçææå‡äãâãäåçèèéêëìììêèèèæçææçäßÿ€é€…ƒ€…€~}†€€~}‡~}}€‡€€…€~~ì€ÉÉÊÌÌËËËÌÌÍÍÌËËËÊÌÎÒÚÚÛÜÞßáâ…ã'ââááàßßÞÝÜÝÝÞßáãäæèêììêëëêéëëêééèèèçæéé…ëííëíííî„ïð‡ñóóô‰õŽ÷‹ùŒø÷ö÷ùÏøUóÌ„ÃÓ¯§Ÿ³†”†~óïsßÛݽ©§½ÃůÁ‚šÓñ“Íá陑ÁHh{†ÝÅÅ»Ë×Û¦ŽÝz†ƒƒã©£yŽ‘o¥¿swww‚›Òòùûúøøôóññˆò‚ó‡õóóòñððŠïîí†î„í…ëêéééçææååäääããäåæèèèé‰èææåååãÜÎÎÐÑÒÓÓÓÔÔ××ÖÖÕÕÔÖÙÜÛÛÜÞààâä…åæåäääããâáààáÞßáãäæèêììêëëêé…èêééˆèêëëêëêêìííîîîïïï„ð‚ñ„òó“ô‹öŠø÷öôòôöÏøTóË‚ÁÏ­­££w‹…‚ýÿ~÷ó÷Õ¿ÁÙÍÁ¡›kÙµÁ^jdn:Pxƒ“Ï£§¯Álj çƒŠ†‰ÿÍ¿‡ž—ž…Ïç…‡†‚„”Ääëîðñðòñð‰ï‚ð†ñðððîîí…ìí…ìëŠêé…èçæååäãã„á ààßàáãääåæçˆèæèèèéæàHÝÚÚÙØØØÙÚÚ××ÖÖÕÕÔÖÙÜßßàâäãåçèèììèäãâââááàßÞÞßÞßáãäæèêììîïëçæåååääáááàßáá„â -ãääãçççééé†ëìíííîîî‰ï‚ñ…õ‡ö÷÷÷øø†ùõõöö÷…øôóöôõÌøY÷÷õöñÅz¹É™‡zƒhyolßñùëãÇ¿ÁÏDZzfTƒÓ±±TVLN&`‰v~‚³~vz…‹nƒÝ}‚|ë»·„›–—y¹Ï}„‡„„ˆ±ÑÜéðôïëêëîŠñ†óòññðïïïîííëéëîðïíí‰ì‚ë„êéèèçææ„ä†âäåææççéëìììêèèèæçççèåßÿ€è€†„€€‹€€~}…~|}€€‡€€€„€ƒ…€‚è€ËÍÍÍÏË„ÌÍÍËËËÊÈÊÍÒÚÚÛÞààáãããå„ã%âââááßßÞÞßßàâååèèêìíëììêêëëëééèèèçæéé…ëííëíííî„ïð‡ñóóô‰õŽ÷‹ù‹ø÷øö÷ùÏøUÉÛÏÝݽ“•©„›‹†ƒ~yáßßÏáßí†Ùɇ™–½PѯÇËÁ¡8luË­£½ÇÓÙ¥œƒ†‚÷Ï¿ß‚ˆ‹{™‡µãstv{‘Òöûüúøøôóññˆò‚óˆõóòñððŠïŠîƒí…ë éééçææååä…ãäæææçççˆèææåååãÜËÍÎÐÐÓ„Ô××ÖÔÔÔÒÔØÜÛÛÝàááãåæææå†æääãâááâßàâååèèêìíëììêêé„èêééˆèêëëêìêêìííîîîïïï„ð‚ñ„òó“ô‹öŠø÷ö÷óôöÏøTÈÙÍÙÙ»››tˆ††‡ƒ÷ñóãóïùƒ„Ó«lŽœã©±hX`80p—“ ˜É³³ÃÏŒ¢ž”ˆˆýïçý–”‰Á³Õÿƒ‚‚}ˆÃçíîðòðòñð‰ï‚ðˆñðïîí…ìí…ìëêêë‰ê„è -çææåäããááá„ßàáâããääæˆèæèèééæàÞÚÙØØØ„Ú××ÖÔÔÔÒÔØÜßßáãååçèééíìéå„ä"ããááßßáßàâååèèêìíïïìççæååääáááàßáá„â -ãääãéççééé†ëìíííîîî‰ï‚ñ…õ‡ö†÷ø„ùõõöö†øõó÷ôõËøZöøøöõÁË¿Ñѧttxf}sqw†ùëãÕóñõ{¥tW„žå¹¡T:@p¡¡Š‰~±xnƒƒ‰•s”–…wí×Õ󕓃«™½ñ…ˆ…†¶×àéðôïëêëîŠñˆóññïïïîííëéëîðïííììí‡ì‚ë„êéèçææ„ä‡âäääææèëìììêèèèæççèèåßÿ€æ€ˆ‡€‡€€€€€}~~|}€€€‡‡€„„€„瀄ÉÊŠËÎÍÍÐÔÙÚÝàáããäåå†ã%âââáÞÝÞáááãäæçêëëìììëêêêëêéêëèééêëééê…ë„íî…ïð„ñ„ó"õõõóõõõ÷õööõöôòô÷õôøùøö÷øö÷÷øøø÷÷÷ØøZùù÷÷êÝçݵ†÷ÿ„ýÓ—™œ˜Šy|íÍÏÃÍßé‘šŽ…—ŸŒ±Ù‘Ù¹±zˆ‘ƒÃ©¿Ç¿Çû››–‰„yÕ½Ó‚‘’uvV`›Ùpnpu‹Êðöõööö…õ ôóòòòððñññó‡õôóòòðïîî†ïðïí†î#íìëêëëêéééçèéééèæååäãããâãäåæççæèèêé…çæççåÞÑÑÒÒÓ…Ö…Õ -ÔÓÔ×ÚÛÜßáã‡æ"åääæææåäåäâáááãäæçéëíìêêëìêêéèèèéæ‰èé„êƒì„íîîïððð„ñ"òòòñòóôôóõôóôóñóòñô÷öòðñôõöö÷ø÷÷ö÷×øX÷ööö÷åÑßÙ´‚ÙÕmÙ³™§{’‡ˆ‹ƒ÷õïåéù÷‘˜Œ‚Š’œ’¡ù©RNlµÏ–š™‹Ñ³ÉŹÃû› Ÿ–ŽˆçÓ錔•„£|©õ‚„~ˆÄêñó…ôóññðïïïîîîïðððññòòòññðïïîíìêë‰ì…ë#êééççèèçææåääååæäãáááàààßßááããåæèèê…éêêêëéâÖ×ØØØ…Ö…ÕAÖÕÖÙÜÞßãäæéééêêéééççäääããäâàáááãäæçïçåìóôëåéêååäåæßáááâáááââæææçç…éæçèèèííí„î'ïïïîïïðñðññððïîïðîðôôðïñòòóòôõöõõõøöõ÷÷ˆøö…÷Àøöõ„øjùõóÞÌÒË¡sËÉ^­‰lxpg~vsxzý÷óåçïï|‘•p|Š›”—¡p66H™Ë•›”³‰—‘‹™Ñ‡“–‘Œ‰á»Ñ‰—˜…£…ƒµ÷}y~‡’­Ñåêíïðîìîñóòñññðíëëííïó…ô óòññðïíìì„íîððëéë„í ìëêéèééèèèç„æçæäääâáââàáâäååçéëì„íììëèèêèàÿ€æ€€…†€‡‰€}~~~„€‡‡€ƒ„€…ç€ÉÉʇËÍÍÍÎÎÒÐÐÒÔÛÝàãåä†åääãääãããàÞáãäåççééê„ìêêéééêéééëèééêëê†ëìíííî…ïð„ñóóôóóˆõø÷øøøùúùö÷ùúöõöóôôôõ÷„øõ÷÷÷Ðø÷„ø\öîÔ¬õÁåçáÿ‘”•…Ó±«³¡ …kÕÑÁÁ¥¥Ïï~ƒùÓÑ•œ›vf¹•çˆ~Š‹‚å÷…Û¯½ƒœœ˜ŒݷÆ‘ˆpjH‘±“Ë×ÛÛy•Çïø÷øøø÷÷„ö -õôôóòñòòóó„õ ö÷öööõôòñ‡ðïðïíí…î#ïîíëêçææçççèéééèçæççèçåãââãäåääæçèè…éççéçàÒÒÒÓÓ†Ö×ØÙÙÙ××ÙÛÝßáåæ„çè„çæçç„æåäãäåççééêìíìêéêêéé…èæ‡è†êëììíííîîîïïððññòññ…òóôôóòóö÷òóòòóôòòôõòôôöø„÷öÔø|öø÷øøñèΦכÉÕÅÉgfe[“‘™›}ŒŽ‰‚óëïáÅÃçÿ„‡ý×ׂ‘–‚­p…ƒëš—•†ëûƒÛµÁƒœœ˜’÷ÉÙ‘›˜Š¡©ÕÝ¡å÷ÿý‘¿çöõ÷÷ööõõóóòñððïïðñññðññòòóôóóóñðïî†í…ìë„ê%ëìêêèçæäåååääååæääããääãâßßßààáâäæçèéê†ëìêã…؆ÖJ×ØÙÙÚÙÙÛÜàâåèêçèéééèèçççææåääåäâãäåççééðéåìòòêäçéåäääåßáááâáââããææççèéééêê…èƒí„îˆïñðñóõòóòðóôòðññïñðñôõõôóóôøø÷Ðøpùø÷õõïçÉŸ×ÁÍÃÍg`YKtrtxm|{tóýùåÅ¿ß÷‚‰ûïn‚‰|ƒ…Ll‰õ™‘’…uÃÏj­ŸtŽŽŠƒëÃÁ…˜–…—¡áí«çïóñˆ˜¦Ìèíðòóñîïòôôôòòñïìííîïó„ô -õõôôóòðïîî…ïñðëéë„ì ííìëêéæåå†æèææä„å ãâàáââãåèéêëì„îìéêêèâÿ€à€†„€„…€ˆ€€…€~~~…€€‡€ƒ„€~~~…ä€ÉËËËÌ…ËÍÍÎÐÐ…Ö -ÛÝàãäåååççˆåããáàãææèèéêëêëëêê…è ééèééèééê†ëì„í†ï„ñòóóõõóóˆõù÷÷÷öúùùöõöó÷ùùøööóíõ÷÷øøôÕøZúíЭšá¡¿ç×ÇÁáý„…é¹³»Ç˜£žïµ¿Ã¿Å­£Çvx|xõ钜š‚k›X¡s†„ƒ„éÅ«³»­™¯éžœ˜Ž…wÝ|‘‹|ePX¹¥ÏÓÛß|œÊïùù„øùø„÷…õ„ó„õö…÷õõó†òñññð†ï.îîíëëèåäääåææççèçææçèééæäââãããââäåææåççèèççèçßÒÓÓÓÔ…Ö×ØÙÚÚÜÜÜÝÝÝßâäæéééêêéé†èææççæææèèéêëéëíêèç†èæèèæ†è†ê5ììíííîîîïïððñññòòññòòòôôóòòóðððîòööõôîìð÷÷öôøöñôôö÷ø÷ÕørôÞŦ‘Õ•ÉááÕÏÇed±“‘‘‹ŒùãßáíçËÁ߃…~ѽŽ…ÇѱvŽ–˜˜ÿ˱³¹·±Áó’žœœ›˜‡ï‰œ•“Š‘¡™áµëõÿû„”¿æõ÷øøø÷÷öõôôôòòññòñññðññòòó…ôòñð†ïíîîîí…ìëêêèçæå„ä‚ã„äããääååãá…ßáâäåæçèèèêêêëìêã„ØÚ…Ö×ØÙÚÚ„Þßáâæçé‡è.çææçææååææåææèèéêëïçäêñðèãæèääãääßáááâââãããççç„éêëëèèèéêíîîïïîîˆïîêëëêóöõñïéèëðððíðîèïñóôõïôóôöÑønïÒ·›‹ÉÃËÕÍɳRNjrtq{ãËãõùéͽ×}ƒ†¿›ËŠ‰Š„³‰±™”ŒˆÛ©““©Ý‰ˆŠŠˆ}é{‘ƒ‘¥õ¿ííó¥Ææîòôõòðñõööõôôóñïîîîïó„ôõõöööôôˆñòñíéë…íìëêéçå†ä„æ‚ä„æåâáàâââãæçéêêëììíëéêêèáÿ€Þ€‰‚€…ƒ€‰„€ƒ…€}~…€‰‡€…€}~~…ä€ËËËÌÌ…ËÍÍÏÐÑÖÖÙÚÚßàáãäæçççèççæååæ„åââå„éêêêéééèçççæææéèèééèééê„ëì†íïïïðð…ñóóôõõóó‡õôøøùù÷øïìéäêêéÞÎÍÓÞëõø÷÷÷øöùùÑø\òá¾£†ý÷…“ŒÓ¥Éó÷ýå¹­½½Œž™á¥»ÉÇÓ¿«»Ýrw}~‚Œ““Švk¹dÇn}ƒ~wdz©£©©Ãã‚’“”“ˆŠŽŠo‘4<Á±ÓÍÙÛ…£Èíúù†ø ùùø÷÷÷ööõõõôó…õöö÷÷øø÷ö†ôóóôóò…ðïîíìëèäâááâääååæåååæçèèçåä„ãááâäåäãäååçåæçåßÓÓÓÔÔ†Ö×ÙÚÛÝÝààáàáãåæéêêëëêê…éèèèééè„éêêêèéëèååççææèææçèæ„è?éêêêëêêìììííîîîïïïððññòòòññòòòôôóòòðïôõððëìððîëæÒÁÂÊÖçóöööõõô÷÷Ñø\ñÙªŠ…ÿùyѽÅÉÍÅų›““uŠ‡áËÓÝñóßÇÓõƒ„‹‰Š’’‘Š…õù‡å~–’ˆáÇ·­ÁÍá󃕙›™“”›™”“Ë‘xéÁíïûù‡š»áô÷†ø÷öõôôôóóôóòòðññòòòóóôôõõóò‡ðïðððî„í.ìëêéèèèæääâààáâââáââäääãááàßßßàáâäåååæçèéééêèâØØÙÚÚ†Ö ×ÙÚÛÞßáâãäåçèéäååææååäääèèççæççç„é\êêêîæâèîïçáäæäãããäßáááââããääççèéééêëëëèèéêêîîïïïîîïïïðïïïîêêîîéïéèêèäâàν½ÅÑàìóòóòòìðððóö÷÷÷Èøs÷øøôÜ¢zszïó~zk±©»¯£‘zlnvvgyxÁ«Ëç÷õßÃÉñƒˆŠ~|‡ŠŠ†‚‚ÝŃ󅈇„zÅ­Ÿ›©µË邈Œ‘Ž‘†Á‰…ùËïçí댟¢Ãåîñôõôòóö÷÷ööõôòïïïîïó†ôõöö÷õô†òóõóðíí„ïîíìêéèæäãâââãããäãããäæææåä…âãåæçèéééêëêçèéçáÿ€Ý€€€€Œƒ€Š‹€~…€ˆ€~~~…ä€ËËËÌ̆ËÍÎÐÑÖØÚÝÝãããååçç„èçççåççåååãâæêëè„êƒè„æåæäéèçèéèééêëëëì†í„ï‡ñ-óóõõõóóõõõ÷õõôóùõðãÖ· •“Ž©©§£—¦»ÊÓÝåëøúúùùÎø]õÍ—žý‹–›á›¥Áû‚‚óɯ½§ñ—˜ß£ÅÑÏÙǧ«ÅÏÝßåy‚†yvhbh^¹ÅÕrytpuƒƒ}q×Ù鄇ëw…‡ƒ|vhX\d³ÍÃÑÕ‰¬Äêù÷‡øƒù…÷õõõô‡õö÷øùøöŠõó…ò.ñðïîîêæãáàáââãããäãäåææççæåäääãáàâãäããååçæåååãÝÓÓÔÔÔ†Ö -×ÙÚÛÝßáäää„æ‚ê„ëêêêéêêéééêééêëè„êçèéæäåæææäçæåæèæ„è êêêëëêêììííîî„ï0ðððññòòôññòòòôôóòñòìèÛζ œ£¡ž™˜•Ž•“Š™³ÇÑÛäèïôôõ÷ÎøgóÌ‘w}ÿˆ’Š³—µ¯½ZZ«ƒ“щ†×¿ËÙõùçÅÃßïûýûƒ‚†‰…©‹Ýñû‡‡„…‡÷ë늒•…õ‚’Š‹…zÃéçõñ‹¡¶Ýõö÷øø÷øø÷ööö†ôòòñññòòñññóôõöõóò†ñòòòñð„ï íììêêêéæääá„ß -àáßááâãäãã„áßßàâãääåæçèéèèéæáØØÙÚÚ†Ö×ÙÚÛÞáãååçééêêåå„æåååäˆèêëè„êíäáæíîæàääããâãäßáááâãããääççéééê„ë7èèéêêîîïïïîîïïïñïïîîëæâÔȲ–š—’Ž‘…”¬ÄÍØàåéíîîðõõöööÇøs÷øöÏ‹kptó‚Œ{k—‹©—B@xfhvd³vu¯»ßõûçÁ»Ùóÿùëx‚„ƒ„xr‹ƒãñávƒƒx|‰‰‰zçåñ……Š‡ó}„†‰Š‡}ƒ©…ÍëßçᎥš¾æíñóõóóô÷ùø÷öööóñïïïðó„ô óôôõ÷÷÷ôô…óô÷öòîï„ñ ðïîììêèåâááàà†âäääæåäã…âäåçççèêêìêææèåßÿ€Ü€…€…‚€†‚€Žˆ€…‰€ƒ…€‡€~†ä€ÇÊÊÌÎ…ËÌÍÎÑÔÖÙÜáãååæçæååççç…è…çˆêéèéèæäãââãåæèèé‡ëêêêë†ìïïð„ñ@óôóôõõôñú÷ðò÷øðçÛÔ¾ªŸ‚ÕÅgm‡“¡ª¦ªžûÉß‚•›´·ÀÇÁ¯ÅÚáæèðõøø÷øø÷ö÷…øö÷¯øö„ødõöôÞ”Ž•”‹‹”¡¥©É‚„…óÃ¥¥±ß™”幯ÑvsÓ«¯¿ÇÉÇÑåïzvqrrµµ•“»Ó×ßootsãu×ËËÕ÷…å±…x›¿ÏsßÛ£nµ×ÏÅóÉèøúùøøù…øùùù÷øø÷÷÷øúøõóóôôô‰õö÷ö…õôôóóôöóïíìêçåãäãáàáààáã„äããââááàßÞÞàáâãäåäãåßáÞ×Ù×ÕÔÓÓÓÔÖÖÔÖ×ÙÜààããåæèêêéééêêê…ëêéèéèæäãââãåæææèèè…éëìì„íNîïïíîîððïïñòñôõõôñðôõóóððëÞÔµ’„vÛ냊‡ˆŽ‘“‰÷åç’ŸŸª¶·«£ÃÛáäêðó÷ø÷øø÷ø÷øøø÷„ø÷‰ø÷¨øaóòñØŠ~{yƒŠŒ†|jRŸSQR›…~~¯ˆŒáÇË烄ñÇÁÙëõ÷õóñ†„ˆ„Ùùѳß÷ùÿ‚‡ƒ÷ƒýëÛÛû‹‹÷½‰ƒ§Ñë‚ÿýÍ¡«Õííõ»ãòòõ„÷ øøø÷öööôõõôôô†óƒô†õ -ôòòòôòñòòñ„ðïïîîííìêçåãâàÝÝÝßàáã„äããââááàßÞÞàáäççèççèæèéà…ÛÚØÙÖÖÚÚÜßâàâäçèêëèåäääååå…æ…è…êçççåäæåãàßÞÞßáãããäåå…âZãããäåçååãáêëëííççéêèññòðîëñðìíìèâÓÉ·—ˆyrÑãxz~zyŠ|wßÍ݃“•›¤°²ª¥ÂÙßâæêíõøòôõòóóøø÷õøøø÷ö‰ø‚÷ø÷øö÷†ørôóðÖ…toij‚Žˆym\Ev…@=;thfZZ‡x{»¥±Ý|{ß·µÍÝëí÷ù÷ƒ„‚}vÁÝѽåíåñƒ~z÷‡ýëÝÙñ…Žý±xr•½ÓzûýÏ¡­Ûïçç剡¥Ëåòóõôòñó÷ø÷ùùøöö÷ööö„ôóóôôô†õ„ô‚õ„ôòòòñññðïîíìêçåããáßÞßßàáã„äããäååääáÞÞàáãåæçæåçäæåÝŠ€ƒä€€€€†‚€„‚€Š…€~~…„€€…‚€‡€Šä€ÆÇÉËÌÊ„Ë ÌÍÎÑÔÖÙÜáãä†åæŒç…èéêêèèææäâáááâäæèéê‡ëêêë…ìKííïïðññïññó÷ïîðîêãÚÖÒÈ´£™••›™•‹í¹›™«`‰•¨¯·¥õ·£Ç…Ÿ¦ª¦¡§¥ŠáÏÑßy£¿ÊÏÐÐØâóøú†øù„ø÷ö¦øgõøøø÷Ø¢‰Œˆùÿ‹Ž…ƒ…Ž—¤£û¯“¯ç÷ùé¿©£µó¡™é»³ß~Õ“½»«¥»ÅÕÙ˽™j`‰r¯ÃËÓ×ÝÝÍý¹µÁãtÕ«™‰tjtz‰£³©§©ÉçßgÓ‡¼Ùò÷ûú…ùø…ù÷øùùùøùùøöõôôô‡ó õöõö÷÷ö÷÷„ö0õõööôðîííìêçåäâááàßàáãääãâáààßßÞÞÜÜÝÞàáâãããäÞàÞÕ×ÕÔÓÑÒÓÓÕÖÔÖ×ÙÜààããäåæèéèééé‡ê…ë…èéêêèèææäâáááâäææçèé†ê‚ì„íMîïïïîïïðñíðïñõóòóòîßÖÓŸ¤•Ž‰‹†{áßÓßõ…†‰ˆ‹Œ}Ë¿ÑÑ჌‰–™›˜ƒíéë÷„“¢´»Å½¾Ïâóøô…ø÷ö°ødðΔ{{vÝãttr{„sga­““—Ÿ—›‘|zp|»ëÏÓù‡‹ç§±ÙßÕÍÉÍÕé÷ïã¿‘Á¡Í™Õççåç÷ÿñéã×ÍÑ÷†ûÑ·¥‘›¥±ÅÙÑÑÑíÿÿûŽ²Ìëññôö…÷…öôõöööõõõôõõôôô‰óòóôôóôôóóóòññð„î ííìêçãáßÝÝÞßàáãääãâáààßßÞÞÜÜÝÞáä„æèåçèÞÛÛÛÚÚÚØØÕÖÚÚÜßâàâäççéêçäãäää‡å…ê…è åçæåäããáß„Þàâããååæ‡ãXäååçååãâëëìííçééëîîìíìéã×ÐÊ¿ªŽywoloÏ»½×ñ~yqtwvh¡›±Éß}~tpy}……zÛÙåó|‚¦²´±´ÇÜïø÷øø÷÷øöõˆø÷õ¢ø€÷÷÷òèÇ“utn½¹cglvxo_QIptntljdXZHPz|¿¥·åƒ„Ù›£ÉÍÇÁÅÑ×éóéÓ§~¹¥É‹Ã×íùñëëëíã×ËÍé|ùÏ¥xt~‰›½ÑÏÓÍÝóéoߣ¾âíñóóóòðò÷ùøùùøö÷øø÷÷÷ööõõôôô‡ó„ôöõôõõ†ô òððïîííìêçäâá„ßàáãääãâáâããâáßÜÜÝÞáâäåååæäåäÜ퀅ˆ€…‰€„Ê€‚‰€‚€„‚€ƒ~€‘€ä€ÆÇÈÉÌÉÉÊËËÌÍÎÑÔ×ÛÜáâããååã„åæŠç‰è æåäãâáááâäæééˆëê„ìíìí„îJïðñññðïñõêÛ½©„zyzuˆ†¢ª¥¥¦’Ñ›nt¡í‰‘¡¥ª‡­…—‰§ë›­±¥¦©£Ç¥¡¯Åy…‘Ÿ¥¥­«•Š¶ðûûøùˆøò†øöøn÷øøøùñéÓŸ†‘ùïùùéãõ‹›ª¦‰Á•£Ïåëݹ­§½ÿ¥šùÑÍó‚‚Å|‰Ÿ‹rrt¥‰p¡§“~t`•…¥…©¹·±£©Ãϵ——©ËÇ›`b©«§¡­§¯µÏuskqÆæñôûúù÷÷÷‡ù÷ø†ùø÷õôôôòò…ñóõõõ‰÷öõööôðïíîïíêççåãâàßááãäãâàßÞ„ÝÜÛÚÛÛÝßâãããäÞàÝÕÖÔÓÒÑÒÒÓÔÔÔÖ×ÙÜáâãâääæèèçèèééé…ê…ë‰èæåäãâáááâäæèèè‡êìííîïî„ïLðññòóïðîíïöìÞÀ«’…ƒƒ|„†‹†s¡•“‹—½ù„}vrsWt‹¿ÅÍïxy‚ƒv³³ËÝñ†ˆ‡Š†…„‚…·ìðíåê­øo÷øøøöÞϺŠpsvsËÅÉÏÉÝïrhc`Y•‰‰“…rvj|ÁŒŒï×ßÿ…†Ñ‘¡»¯Ÿ¡—ÝÁÁÅ·©™…ÙÉñ©ËÓÇ¿»ËéõÕ·³ÅëñÍ‹¯ËÕÕ¿³ÇÓÍÕÛóƒ…‡…‘º×ðððôõööö÷†öôõ†öôõõôôôòò…ñòòñò‰ôóòñðîîïíîïíêæãáàßÞßááãäãâàßÞ„ÝÜÛÚÛÛßã„æçåççÞÚÚÚÙÙÙØØÔÔÚÚÜßâáãäåççéæ„âƒä…å…ê…èåååäãááß…Þàâääåææ†ãWåååæèæåäâèèéêêëíëêëïãÔ·¢“}x‚Ž‰„~|icd`‡r…§ÕítbYWX>Hb¡¿ÃßpkZ]gia‘•³Ùõupsrrrysu¬ëôìÞäõõŒø÷õøy÷øøõëÓî|fhkf§›­»¿ÁÅ[PGC=pf`fb\THNBN“vx¿¯¿ëǃ“«›‹‘Õ¹‹½Ã«“‘…åÉÉ•¿ßÝɯ·ãùÙ·±»ÙÛʼnr—³··Ÿ—»ÅÇÕÓázwst„®Ïíïðòóóñîòõùøùùøö÷ùù„÷ööõôôôòò…ñ óôóôõõõöö„õ0ôôóññïïíîïíêçåäâàßßááãäãâàßàáàààÞÛÚÛÛÞáääåäæãåäÛ퀇†€†‡€…Ê€‡…€Œ‚€„‚€ˆ‚~‡ƒ~žè€ÄÆÇÈÊÉÉÉÊËÌÍÎÑÔØÛÛááâ„ãŠå…æˆèçæåää…ãåçéêëë†í…ì_ííîîîííîïðôðñíæÒ¬’Œ…‚ñáomuˆ¢­²°­—Ó³›å^­ñ‚‘™Žõ¯ƒ|•«ÙŒ ª¢¤£–·‘……‘ÕŠœ¬³«¹¯†ÓǤ¥¨¯°´ÃÐÛêëïñðîìîðŸøköðæ×ǹ³ªœ““’„ó÷õãßùŒ˜ŸžÓŸ¡ÃÑÛÕ³«£Áý˜‰ý÷‡†ý¹|zµ­x™­\‰‰£—‹|`•Zr‹Ÿ¯³Ÿ©T‰jh``t›Ÿ•z‰±Õvzrű»¹·ÅÕçqls”Îìóòûùø„÷†ù÷øùøø÷øúøõôôôóññ…ð=òóóóôõõööõöööõõööôðïïïîíëëêêæãáááãåäãáßÝÜÛÛÛÚÚÙØØÚÚÜÞàáâãÝßÜÖÕÔÒÑÐÑÒÒÔÔÔÖ×ÙÜ„â ãääæçæèèèŒéˆèçæåää…ãåçèèéêê…ëeíííïïîïïððññóôôòïïëäÈ¢ˆ‚…õùƒ„†ˆ„~yspcxntѱn»ëi]YWjv•µÑëz|wwwm\‘•§µÁ熅†„‡xiÃÍŠ”’™¦¯¿ËàæäããÛàäçìôžøkñèÙÀ«•‡~wsqhleÅÃÇÍÝákb_[Uvz……xjpfz·ƒwïñƒ‚û½“ñí¥Ç³éɧÿ¹«‹é™¯ÁÍÍ·å½…‡~ƒ—»¿¹¡§Ï÷‰Ž‰÷ååÝ×çõÿƒ‡…”ÂàôñðóõŠöôõöõõ„ôóôôôóññ‡ðïðññòóóòòóóòññð…ï'îíëéçæãààááãåäãáßÝÜÛÛÛÚÚÙØØÚÜàâäååæäæçÞ…ØÙØØÔÔÚÚÜßââãååæççåâáââã‡äŠèåååäãááà„ßàâääåæçç…äeåååææèææäãççééêïììèàÞƒ{}„sÍá}‰sk`VPFHH`Õ݇¯ÃL:76R8Lt£»ÓmjhbaXGfr•¯ÍÝpjiielkYŸµ‡–Šœª¾ÍÕßÞßÞÜáäëñôœøx÷öîæ×¹Ÿ‰zpheaWYQ£±½³³·SG>77dXTZ\ND<Á퇭2+,H$\¡Å‘¯§¡·ÇaVIn\Ùƒ™Ÿ­MHDNYT‘‰›É{wnf³ÇÝévƒ{}u|„œ³ÓÞæêíøõ÷òôôö„ø(óèãôøõ÷ö÷óîÜ˨‹…ƒ}vqe[e_^[SL›­µ¥Ÿ«OC:0,P„RLD<02,>t[delq{yÙ§‘ƒµv¹ÑÇ«~x·ççÓ½³¿ßåÝÛãñß“Ñ™©Ý~¥«½ÍÝy†‹Ž‘…ƒƒ|ù÷õõz‡¦Íßëìïð„ò óõ÷÷øø÷÷öööõõ„ô óôóòñððïîîî„ïðñòóô„ó0òòññðïïïîíìììëêèåäååææåâàÞÜÝßßÝÝÛØ××ØØÙÛÝßáåãäâÜÙ€ˆ€…‡€~~~€€€~~~†€€€~„†€„„€„·€†…€Œ‡€„~–}}}~~‡Š€„æ€ÆÇÈÉÊÉÉËÌÌÉÊÎÑÔ„ØÚ†á†ã äååããåååæ‰è†æçéëëë„í…ï€øðíëéëðôòðïùøïÍ„Á«Õñƒ‡šªžó«‘µ¡v厑›¡•ùÝ™©tb—éš™Žý­åÅÕ“»ãõ¹Óù–£åƒ­Dt׊——– ŽÍ™‹³ó’™˜ÕÕãå‹«¹ÃÅÇ¿°——®µ¯¨·ÒÍȽÅÆÍØÞÞͳŽë™¾¿»¶»»¼p¯ž –£­±¥“‘–Ž‰ýßÓÇÃÕõ„‰ŠŒû£‰±ÍßÛ»©±¹ÝŠŠˆíÉ«›p‘¿Ç÷££ÍusoÏÃËÕÏÕqx~˱‘ Hxn——¡»×yŠ’–‘‰…~vmÕÏÃj–Èïõìíõö÷÷ö÷õö„õ òððïîððïîïï„ðñòòóóó„ò.óôñïïïîîíìííëëéèççææåãàÞÛÚÙØ×Ö××ÖÖ××ØØÛÝÞáááÝÙ)ÔÒÒÒÐÑÒÓÔÔÖØÛÞàããâãäââãããäæææçææçèèææèèèæŽèäåçè„ê€ëìíîîîíòìëîïíñõòðîöøá¾ÍËÝëqv{{yyl›“—ùåÏpfa]Y™v\™­Á~·³SSS‰Z¥Áñ­Á³¡›¿×i`«vÕ僓¯Y[XYWR¡¡«¿ãwrmÙÝÝítˆ‰ŠˆŽ””˜”˜—ªÃÂÀ¼¶¿ÈÌÍÖŪ†Ý‘s¶¸º´®¥¥ –”}|„‡~vjcknokh]¯¯·½·³¯RNMKzb`ptlhdfdl‘Xfvy|éɱ«™­Ýåß×ÅÇñˆ†ƒóåëóïõ…Œ‡ßéùá™­‹«»ÇÍßù‡’—›ž™”‰ûõóƒ¦Ëãëõôò‘ôòóòòòñòôóòñðììë†ìíïïðð…ïîîìíïïîîíìëêèçæåää„ãàÞÛÙ××ÕÕÖ×ÖÖ××ØØÛÝÞáäææá%ÝÝÝÜÜÙÙÚÛÛÚÛÞâäããâãäååæççÜÝÝÝßååæææäå„æ„è…ä…ß -áâãåææççèé…åê„ã€äêìîíæíôÚµ}ÑÏåïqljikiVnx•õñ›»aNE>6TD6l±Ù™‹3((P8¡¹ƒŸ“›©±TMzT¹é“•—E=9=BA|~™¯Ïi^V§¹ÉÝrwqtsqt~ˆ™‘š——”£Ãƾ´²¶¿ËÏÑÀ¥~ÏŒ²³±­²§¥šŒ†wynzyogZV^a`\R@…¯›‹‰:2.'HNNFJ@6.,(8`EWhnw|çÁ§‹|ËÓÏű³ß}ytãáñýóí}ƒÕÕéá¹­‡£«·Ïãë|ˆ“‰ˆˆƒyïçãyœÀÞåéëïðññóöõõˆö‚õ…ô óòòñðððïíííî„ïð‰ñ.ðïîîïïîîíìììêéèéééççåãàÞÛÞàßÝÝÚ×ÖÖ××ØØÛÝàåãâàÝÖ€„‡€~~…€~~~€€€~~~‡ €€~~†€…ƒ€„€™€‡„€Œ†€Žƒ€†„€~}|}~‡‹€ƒæ€ÆÈÉÊÌÊÊËÌÍÏÑÓÖØÚÙÙÛÛßàà…á âââãããäããåååæ‰è…ç -èèéëëíííîî…ï€ñóññîñððñðèʹ ÷Á™ƒ£×Š“Ÿ§©§šñ«…tx‡Ëñ‰’Œù矹l`z×”Œ†¿åµ©·éó™µë’£…£©d.dÇù‰„Ån~¹ûŽœ÷õñßÙ…œ¯´À¶£‡™ª¯¤’Ÿ«¦§¯¬¯³¹¦™–ÿßû¥¦£Ÿ ›™tž™Š…„™§¨‰ý…ŠŠûßÍ¿µÅ郅„Š÷›å¡¿×Ù½«±µÁÕ튑ŠÏ±§Ÿ‘¯ÇÅÿ·»Ùtéyyïïwuw}ƒ„…y‘h@p•|‹‹ŸÁÝ”—™•‰ƒ{pËÅË}½ãôõïîõö÷÷ööõõöˆ÷ö„õ ôôòñðïîððïîïï„îïððñ†ò.óôñïïððïîíîïíìëêééèèæãáßÞÛÙØ×ÖÖÖÕÕÖÖÖ×ØÚÝßßßÜØÕÔÔÒÑÒÒÔÕÕ×ÙÜßàáààââáááâãääåå…æçææèèèæŽè€ææçéêëëìììíîîîíìïðññððññðâÀ«Ï¹­§¹Ýptwwuth¡ƒÁ±½»ÏcZS“…\‰…µ‘¥RVRJf•Ù£±±“™§»_\ZxµÁt…§§VZUQO“‡™ŸÁÙnfÓÉÇÙßy‚‚z~‚…ˆ‘š’ˆs‘›••— ¤€¡‘Š‰ïÑ훚–ŽŠ–ž”vv~zsliÓmokeY©©¯«£¥§PMKJXjrnfbdfhr‡©kxxvͽ½Á·³ËåãáÝÕÙ÷„ÿ‚‚ýý‚„Š„©ÉÑ™ÙÍ™±¹Åáý‰‘”—›™—“‘‹ƒóëïÆáëîòòòôôôóóññóó‡ôòòòññððòóòñðïììëì…ëìííîîî„ï.îîìíïððïîííìêéèçåååääãáßÞÛÙØÖÕÕÖÕÕÖÖÖ×ØÚÝßãåäàÞÞÞÝÝÚÚÛÛÛÜÞáäæãââã…å æÝÝÞÞÞäääåæäå„æ„è…å†â€ãäææçèèééæèèçææééêèëêééçÛ¸ ·±­­Áåiebbc[Jb\`¡µÕ¯E:0PL.H‰­Áx|2)(- $d™|“‹||‡DB9P•É…‹x88<79rl©³SPŸ¥·ÉËgjkfkov“ŽŠ…wg˜‡Š“š™~—‹„‚ãÃÓ‘““ŽŠŠ–ƒwqkpkbXS«Z]\P:nƒ™‘~~91,&@JjNefÁ¯«¯¯§¯ÉÝÙ×ÓÑÑå÷yvwvw}ƒ†ŠŒ‹ˆ‡Áƒ±…‘¹Å“•¯Çã}‚†ˆŠ‹Šˆ‰…zÙц¦Õäèìïîïðññòóòòóô†õ‚ô„ó…ñðïïï„í„ìƒí‰ïîîïððï„î"íìêëììëëèäãáààßÜÛÙØÕÕÕÖÕÕÕ×ØÜáßÝÛÙÔ€†ˆ€…~€€~}}~~„€~~‡€€€~~~„ -€€€~~„€……€‚„€‚€‚‹€‚…€ƒ„€‡€€~‹ƒ€€~~}}~…‹€‚ç€)ÉËÍÍÏÌÌÍÎÎÓÔÖØÙÝÜÜÝÞÝÞÞÞßÞßßßààáááâããåååæ„è…é…è„ë€ìïïïððïññðïððïöëÙ¾ …󊎆ñ­vfv匠œ˜„¹ñ¡t…ÝŸÛùýññן‘‰\±Å…û‡Žý™±™ù««…µ¹ë‚‰ƒß…‘`h±×çë†ã§å…•zÍ‚š——ñ~‘Ë„˜®¥é×뙘ûÉå‹Ÿ«©íÝŒ£°³Ÿ{Œñéñž¥¤¢’ƒóëõ÷ñáკ‘ùóý‰–“‡åÇ·¡«Õ÷ýñù«µù¥ÅÍ»¯±µ·½Íû‚ëDZ«©£§¹ÇÉÉÇÇÅÇÙï÷ù÷|„ˆ‰ŠŒ……Í‘Å¥t`­ƒƒv§í‡‘’Ž‰…~u×Ý©Íéðñðñóõö÷÷ö„õö‰õö„õ ôóòñðððïîïï„îïïïððð„ñóôñ„ï'îíìîïîíëëëêééèåäãááÞÜÚØ×ÖÕÖ×ÖÕÕ×ØÙÛÜÚ×ÓÙ××ÖÔÔÕÖ×ØÙÛÝßàßÝÝßàßßßààâââã…äåææèèèæ„è…é…èééêêêíí„î€ïïîîòðíðâÓ·™éuuqf­©“™¥±Ïlkikdba‰¥¡¥±¡Õ¡Ÿ›“ƒ\\‰`ÉVµTR™`¡á‰|P¹™¯UUT‡T¥ÅŸ›¥«QQv¥½é“­Z^e\©——­Ùqsdfc½Åý{lÏÉÁ~‹‚o³Ï‰Ž†{ééãz~wyu{|ñéÙÓɵµelkgÅÇËheXTŸ••››——‘Cb…µjj^^bbfjn·mjǹ·¹ÁÃÇÕååçÝ×ÕÙéùýÿÿ„‡‹ŒŒ‘Žë¯ýÙ¥‘饥¡‘¿ûŒ’––”“ŽŠ…ýù±Ïåêîðñòòôôôóòññ‰òññòòñññððïîííììëì†ë„ìí†î,ìíïïïîíìììêéèèççæææåäãááÞÜÚØ×ÖÕÖ×ÖÕÕ×ØÙÛàààÛáááààÛÛÜÞÞßßãäæâááâãâãããäà…áâãããäå„æ„è…æ…èæææççéêê‡ë€îíêïá׸–uÏjh_Mv‘£¹Ã±ZVQTEA?H$P­ÁrxhZRL:$DÉ…±x4X&/>$p­td7hhnfjpjZTD2DhB@84:8:<@R‹Z\³§¥£©§·ÓáãåÝÙ×Ûëõïññx{ˆŠ‡‰á«õÉ‘t½™¥™·ë‚‰ŒŒˆ†ƒƒyáá§Çáèëìíïïðññòôóó‰ô‚ó„ôóòññ„ï‹í‰ï,îîïïïîíìííìëêëììëëéåäãááÞÜÚØ×ÖÕÖ×ÖÕÕ×ØÛßÞÜÙ×Ï€„€‡‡€†~ˆ~}~~€€€~~~~€€€~~… €€~~~„€……€€€„€‚†€ƒ‡€‡„€ƒ„€Š€~~‹‚€”‰€‚…~†Š€‚ç€ËÍÎÏÐÏÏÐÑÑÔÕÖÚ„ÜÝÝÜÜÜÞÞÝÝÞÞÞßßßááãäåææç„è…ê„ë„ì€ííîîðòóîõôõïîíîÊ‘íÝÝ÷ƒŠ’’†á‹TNfz¿õõ‹ŠŠÝ™­hpÁùËõõëÛÅÑÑ­ý÷‚‰‚«Ý½õ‰­pÅÍñÿ‚ýí¡½z±ÓÛ×õíÏ—å•Ý‰—ÝåÁn£Óÿ¤¢‘ë˵çÝ÷ãùŒë­Ù’¨´y«ÛÅå‹™£®¦‹ñéëíëéáÕ銖šƒˆ’‰ïÓ½¡¥Éçñëñ÷³µµ•µÁ·±±³¹½Ããÿ÷ãé™›¡§·ÅÇÉÇÉÅ»»ÉÛïõóõ~…‡…ãÓ»©Ÿ—‘—››™t•Óx†Œ‹‰Š…‚~xv‡Éãëíïðòõõö„÷„ö‰õ öööõõôóòðïðð‰ïîï‡ð.òóñðïïîííìíîíëëëêêêééèçååäáßÝÚÚØØØ××ÖÖ×ØÙÚÚÙÕÒÚÙØ„×"ØÙÙØÙÚÜÞÞÝÞßßÞÞÞßßáááââãããääååçèèç„è…ê„é†ê€ííîîîðòîòëïììˆ×ÏÕåqpoi[—ƒv~‘¥µµV£Vaab™X…‘±Ýr›™›KI||¡©¡‹©µUONj‰±Ttµ¡«§T©…N•Í“Ÿ¡•—‰f¹Å©TX^Z‘Ý틱¿Ïaa[¯­Ãǯ©·½Óml`­¥Ûƒ‡…{jwÉÕÛwxsvjiÓÍÇ»µ·«£µcdb^Z\ac]U›—“……‘•‘‘‡bt‘fd\Zbdfjnnµ»¹­™£±¿ÏÝÝÝÙ×ÕËËÕã÷ÿýÿƒ‰Šˆ‡ûë×Ç»¹³­µ»»µ‹­í„’‘‹‰†††“Ëâçéîïñòñó„ôóòóò‰ñòóóñññïîíìíììëìë„ìëëìì†í.îîííîîîííìëêêèçèççæåææåäããáßÝÚÚØØØ××ÖÖ×ØÙÚÝßÞÙåãâàßÜÜÞÞßÞßàãäáááâãâââããßß…à áâãäåæççç‰è„êë…é€êêëëëêíêîæëèéÁˆÝÏÍËd`^TFj|‡•¥Ç¡A~?FDDZ @p™‘™^plZR)'8@ùñh`R(*4p|:T…|xf0dZ8t¹~rd`\hPHL­©Ét.87@Dd—™ƒ|‰™­ÃÕ„Ù8×ÍÍÙéûÿýû‰‹Œ†ïáÍÁ³¯§¡¥§­¹“§Ûv‚ˆ‡ƒ}}zyxˆÃÛãçëìíðñòóôôöõ„ô„óôôóó…ô óóòðïððïîîî†íîîï…ðñ„ð)ïîííìììëêéëìììëêéèæåäáßÝÚÚØØØ×ÖÔÔÕÖØÚÚÙ×ÕË€„…€ˆ€„€‚…~…€€~}}~€€€~~~~~~€~~‰~~~„€~~„ƒ€‰€€€…€ƒ†€‰Š€Œ‚~£…€ó€ÌÎÏÐÑÑÑÓÓÔÑÓÔØ…Ú ÜÚÜÜÜÝÜÜÝ„Þßààääæ‡è…êëëëìî…í€ìïðññíîûû÷÷í»ÿáÛËÕÿŒ’š˜…á‹FFbrÅñíËãÿ‰ó±Åpåñ…½ïù킃íõ……•¥÷óûˆ³íÅÍѹéÓ÷ÿƒõï¯Õ½»×ÛÙíé͗핛ߕÕå¡Í¡Çé‘”†ß±‹Ÿ§§µë†“˜™ó¥§ýŸ«·£wùÃÕÿ‘œ¨¥‹óéõ÷ññåÙåù‰””…ÿý‚‰…õáÅ¥­Çáííñí»Ý¥¯½·¯±³³·ÃÕëïß·“ýív‡¥ÃÏÏË¿«—‰‘±ÉÉÕãxzéÏ»¯§¥¥§««³½ÇɵÁÛu…Ž‹††„ƒƒ¢Òâèëîðñôõõ…÷öõóòñðïïðˆïîîïï‡ð ññððïîíììííí…ëê„éçæåáàÞÝÛÚÙØ×ÖÖÕ××ÙÚÚØÔÐÛˆÙÛÙÙÚÚÜÛˆÝßàà…áâ„äæ‡è…êèèèé†ê€ìîîïïòçíêìöæ´ëÍÁÇÓßooi^T“xtƒ¥£¡›£¿a^›X|¥­Íåp…KE…•dd¡…£¯¥NLj…‘|TxhÙŸ¡N£ƒNÕ•Ÿ¥Ÿ›“‡f¥¹ÅŸQT]X~¹Ýý£±¹ZYT£“­­§µ½ceb_­™§áƒwkwÅÃËásnngf¿½Á¹³±­£§»a_[S£¯[]T—•“…ƒ•‡‰|^xhd`^bbddhjt›±­•éí…›µÓÝ××Ó¿«¡™½Õ×áñ‚÷å×ÍÅÃÁÅÇÉÏÛååÏßý„ŠŽ‹ˆ‡ˆ‰«Õàæêíîðñññ…ôó„òƒñ‡òññðîîŒìëêˆìíîîíìîîíììëêêè…çææååäããáàÞÝÛÚÙØ×ÖÖÕ××ÙÚÝÞÜ×çäâàÝÝÝ†ß áãßàààáàáááâ‡ßáááääæ‡è‡êéêì…ëé„ë€íåïíìóå²ëÍ¿ÁÉÇ_[VKDz‡›‘Ãrptv“F?^*H…µ­TfrbX('8BVjjZPL©½p•¹ÉÍ¿Ÿ‰ý—µ¿ÇÑÛßÕÉ¿·³³µ¹ÁÇÑÕÛõÿùwv~„‚~}}~‚˜¾Ó×ßåèéìïðñôõööö„õ‹ôóóóôô…òñð…ïîîîïïð‰ò)ïíììëëëêééêììëëëêéèçåâáßÞÜÛÛÙØÕÓÒÓÔÖ××ØÖÓÈ€‡…€~~~ˆ €€€~~~~‰~~~€€~~}|~ˆ‚~‰~~~„€~~~„‚€‡…€„…€„„€‹…€€‚~‘ƒ~Š~—ô€ÎÐÑÓ…ÔÓÒÓÑÕÕ„ØÚÙ„Ú‡ÜÞßßããåæçŠè„ë€íìíîïðôôòðïõôûÖ…½£­ÉÓ¹±Ã‚”œ›÷©p4n“áýË‹¯óˆ…ÓÁP¡™…›§ËåÑÏÕ×­íÑÅ¥åãýûé¹É±Ñ‘l±Ûïõûëá›ÍÑ›½ËÏÙéëÅõÉÇÿ•†µÉ‘Á¥ÏÝí„ŠùÇ`µl™Á‹’šžÝh¥í¢¯¢‘áÃÛùˆ”ýéãý„‚ûéßåýŒ‘ˆñíóññÛÅÁÏßëóñëÇ¥‰«»±©««©«·»½ÇÅ·¥™‹ýÝÍÙ‡“vÑÕÙhfv—Ÿ§±·µ¯©Ÿ™—Ÿ«¯³»ÇÓÛÝqs{„Š‡‡‰†……‰«ÓÛãçèìíïððòôõŠ÷ö‰õóòò„ñðððï‘ðïïîììëê„ëéê„éèççææåãâààÞÝÝÛÚÙØ×××ÙÚÚØÔÐÝÜ‡Û -ÙÚÙÙ××ÙÚÚÚ„ÛÝÝßß…àáââããåæçŠè€çççèêéêêìììîñòóóêçÃr¹¡¡·¿ÅÅËklc[[Ÿh‘…‘¿»µ™‹©¹^ZMht…Í~z‡¡©‹…‡•|™¥Í~‡•‡ƒ~\2l‘áÍ———›™‡\¡ÝŸ¡•“™‹•~‘Hù‰±¯TSR=L…©Õ©¹··TP•vƒý‰™³\\Z€[Z—ƒ…©ÓmihaT«³ÉÏf``±©«³XUR§£¡­µ\UQNŸ¥—‘•——•‘…xlT8p\^^\\\^Z^dbj|…|xvvéÙÉᣋõùýƒ“«³½ÅÍÓÑÏËÁ½»¿ÇËÑÙçñõ÷…‡‰Œ‹‹ŠŠ³Ö×ÜáæéëîíìîðòŠôó‡òññð†îí‘ìí‡ìëêêèèçæçææååäää„ãâààÞÝÝÛÚÙØ×××ÙÚÝÞÜ×éæäâˆßÝÝÝÜÞÞÞßÞßßààÝÝÞ…ßááããåæçŠè„é€ëêëìíïëëíîíôííÉx³›·¿¹·µWSMCE~T…±©Ã—p`j…ŸK@18DhÙ|R^brvTDTJ@x©^L>HF. `¡ pÅjnfZVRP6|Õ«nbh\PDh`Ùnp.3.%2`É•‘…n48pZrñ~CECCDdv£WQVUN¡·³TLCnltMG@nlnvv6333fjddhfddjhVLB:(HB4,04220284@VXPLJN¡¥©½|——‹õùý~~©±µ»ÅÉÇÿµ±­µ½ÃÇÏÕá÷ÿ~z{„ƒƒ‚~}~…©ÍÑÖÝãæèëìïðòôˆö‚õˆôóóóôôó†òŠïð‡òñðîììë„ê!éèêëëëêéééççåãâààÞÝÝÛÚ×ÔÔÓÔÖ××ØÖÓÆ€ˆ…€~~~ˆ€€€~~~‹ƒ~ˆ~|||~ˆ‚~ˆ~~}„€~~~„ €€~…€……€„ƒ€„ƒ€…„€~’„~„ƒ~˜õ€ÏÒÒÓÖÖÕÔÔÓÐÑÑÕÕÖ×ׄØÙÙÚÛ†ÜÝÞßâãäåæŠè€êééëëëíîðð÷÷òïìñø܈ѣ©³Áŧ¥½–œš•ÍÁÑ L—¿÷Šç­Çßý‡ýË­x™›©¯»Ó¿¡µÉ·é©Á­ãßíÝǧÙ0¡™t¹ÛóïñéÑÁÑŸÃËËÓééÃå¡—Ñ‚Œ‡ý©¥|›Íåí…‹í«©¥å«ß…‹‘J—™Õxf›ã‰– Ÿ™ÿÇÇ釓‹ñÓçùÿ‚ïÕÕ郒‡Û×ïõñåÍÅÍÙãçá߻ᑃ©¹±¥§§¥§±··¿Ã½³§‘‡ñÅ…½7ÉÍÑÝ“£¡§­¯¥›•“—Ÿ«¯µ½ÉÙÛÛrt{ƒ‰ˆ‡‰††‡ºÕÙäåæêëîîîðóõö÷÷„ùø‡÷ö„õó…òññððð…ñòñ‰ð ïïïíëëêéêëëê†éç„æåããâáàßÝÜÛÚØ×××ÙÚÚØÔÐÞÝÜÜ…ÛÙÙØØÖ×ØØÙÙÚÚÚÛÛÛÞßßààßàáâââãäåæŠè€çææèèèêëííìîñôõðîÉs¯±µ»ÃÅÃÅÏihd[Z‡|é|¡¥ÙÓb­³¹Á[›l`ÙÁ‡…•¡£~dx“txÁƒ‰|xrV(h@ᙉ“•—•™•‰\Ñ¥§™‘—‹“z…<É©UPRR~Jp¥›»¿¹TQ‰\¹Åí‹£UWY€XX‹©Ñfcc^V©«½Ãd__\©›«µ±UTŸ•¡±ZWSN™Ÿ›•‘“™™“‹…~thTl`X\\ZZZXVX^^dpvxvv|~vÕ½ÅÝåáåíñõý‘£­»ÁÇÍÏÉÁ»¹½ÁÇÍÓÛéõõõ‚…‡ˆ‹Œ‹‹Œ–½×ÔÜßåèêììë íïñóôôõöööõ‡ôóòòññðîîîïîîîíìí‡îíŒìëëêéèèç„æåååä‡ãâáàßÝÜÛÚØ×××ÙÚÝÞÜ× ëèåãááàßßßÞ„ÝÛÜÜÝÝÝÞÞÞßÝÝÝÞßÝßßàáâãäåæè€éêêëíîïìíîîîèéÇr«¥«±»½·³±RMH@BdDᥡ“Ó§?t‰£A`40¡Í~ZhnvrT:XZJXl™bL<><"P@Prdd`VTLJ2tÉ£‰fVZ\N@\P©lr1*1,H.Hpƒ‘‰p45^:•½åpr8>2¡`€`r\``V\VR2L›hXXVLBh|…rd/,/-J2L¹Éhztp76R8dÅl\ZVb9;==@~‹•§IA>5Vv‡p2\PTdf43\\d^^^bdXVRB866*~Ÿ«¥CZH8H‘lZddffL0™fL(8‘XBD@, &Á‘•dTZfdhbZ`HTn^^\TDXp‘tb.+€0.D"0xpnb\\23+P8•rjhd-/V2‘Ñhbv`bj42\€©ÍhHFA955x~“D874fdnn`\TPTZVNLPT\ZTTR<:J@"0xJHHLZTHRXR:(Ñ•hZ^^U6:1ZDL2­rxXH(Hh™ZTFB<(0NHXT@JP‰P ¡¹¹€F8>>@84>:6:DJJDDFH20x`jZZXbd\X*`h‹rhhZ0V:¥t~ppfjj\RZ¡É©x‹>=p0XTfj\dtl0.3VDFLJD@DLNPLLLPTVPH8424FBHF@>6,$,t\l^XZ^/ZX(H`~pfr€^XF`•rtb\nnX%ZÁ|7rn.PHZfPRhn.+8T>>HB>>>BHNRN@BJTL>44 xLH \PDFdB@¡t`J:B@>:8:22tN><66026.,*(&"$$$&<\bdlvxzr…HÁÁÁ¡™|…•±ÅŹ|±¡x(©©‰Áéåxzñóóïñû‚‹‡‰÷³‡‡¥Çí˜ÀÑÎËÌÍÐÔàéñö÷‡ø ùù÷øùùúøø÷÷ö„õŽôóòòîíìé…è‰æå„ä âââáàßÝÝÝÜÛÚ…ÙÜÜÚÚØÕ»€€€„€~‰€~}}~€€€~~„~}}~…~|~~~~}~~}{~‹~ˆƒ~†€~ˆ‚~ˆ €~~~€€‰‚€›‚~˜~}z„{}‰~…}~„‚€†„€‡ä€ÓÓÑÐÐÍÎÍÌËËÌÍÎΆÑÒÒÓÔÚÚÜÝÝßßááãããåååæçæçéêìí„î€ïðððñÝ’ˆÁŸ•Ó”ž¨šßùr½ÿ‘ž¡¥¢œŸ¤“…¡ t·áÿˆÿÏ“åÁŸáÙã•éÍŸÏÑÅÉá¹Í¯™µ­§Ñ¯É‰á‘`±—«»···³³«›…åù‘£«³½·³“ù­Óåõùÿ‚ïÕ—Ù¿ÏãáñËáùé¿ÍÑÇÓíûýý€ïÙ¹‘Ãÿ÷킃µ¡·¿©½á÷ýûóãͽ¿ÑÕŹ¹ÁÉí£¥§Ÿ‘‰“¥Á‘‹µÍý½·µ³µ·¯¯«©·ÙáÙÝÙɵ¥¥‘``ÁÑ¡¹ÅÕÑb¡< @`000‰±ÉÛÕů¥©ÁÕßz|}͉‰‹•·ý¶ÐÒÑÕÒ ¼Æñùöøùùù„ø†ù„÷õõõóóò -ñððïïîìëëêˆéèçççææååääãââáàßÝÛÚÙØ„×ØÖÒÑÍÊÛÛÙÙÙÖÖÖÔÓÔÔÖÖ…ØÙØÙÙÙÛÜÝÝßßàáâãäåææ…è€éëëíïïïððñòòïõ݈x]ƒ‹­õ{yoŸåƒßù|wqmieb[PH@ñ‘µ£©¡RL¥Ñ—¡›‘F8Áéƒf<‰©l\\•tr^@\l¡©|vlpppll^^X©µjrrrvpdH™n…‹‰‘•—N““h±‡£›tt™µ€‡~xx‰™ŸŸŸ“xtéɧ¥§©SLrt‹‰~…››™—›“…~|xtnpt|tjhfd^RFHRRXXPRhdXb`\\ZTRPLHLLPN^…›Ÿ£¥¡£¡—µ±`ÁÑ¥±ÅáýƒýÁÁ¡00PÁëýûëÙÇÅÑã탄†ÛŸ™•‘‘™»ý¶ÒÒÐÔϹÁéöñøööö„ø†öôóóóò„ðïî„ìêéèççææ†åäääããâ„á àßßÝÜÝÝÛÚÙÙ…ÛØÙØØÔààßÝÝÚÛÚÚØÙÚÚۆ݀ÙÚÛÜÜßàáââäååççèéêëëëìëìîïðòòòóôõööùôÑt`Gl~›ÝbVROl¡lÉÑc\XQKGC;2*‘`vl\5PDD™hn`Z(¹‘^XJ@6 …V6`JDBhB8¡VF:@@@<<844|­@@846@HH„>c:2&(28D@..4HD:,284.,*&"""$"0Rbdnvz||tpáÁÁÁát…•¹ÑjÍxxñÁá±Ñ¹¹Íçéß͹»ÍßŠç›……‡«ÿ·ÉÉÇÍÊ·¼äõñøùùù„øùù÷øùùúøøø÷ööõõõŽô óòòîíìêêéèèè‰æå„ä âââáàßÝÝÝÛÚÙ…ØÛÛÚÙØÔ½€„„€~‰€}|}~€~~…~}~…~}~~~}~~}{~‹‚~ˆ~‡€~‡~}~Š~~}~„‚€¥‚~™~|{{{z|†~ ~~}|{{|||~‹ƒ€‰â€€ÑÑÐÎÎÍÎÎÍÌÍÎÏÐÒÔÓÒÒÔÒÔÔÕÖÜÜÝÞßàááããäååæççèæçêêìíîîìììííù鶉‘Ý›Áz£««‹³…•Ûˆ¢¥¡ ›‰‹ñ±‘¡ ‰¿ñ†ûѕ啇×Íã£Á…Ù›ÉÏÇÍýéÙ¹±í«ÉŸ•ÉÑPÍ™€­·µ···µ·‘½¥Ñ“›¡§«¡§£©·Õéõ÷ÿÿåÉ‘á¿ËÓ×ã·¹ù•ËÓßÝãóùý÷¡Ù½ýóëÿ‡·Ÿ½Ë¹ÃÛéùõïåÕ¿¿ÑÕÇ¿¿ÁÅÁ¯£Ÿ£¥›‰‹‰‹—Ÿ£Õ…µÍÇÁ¿»·³µµ­¯©©©ÃÛÙßÛ˹¥•|=¡pP0¡½ÑápjX8 0‘XP¹‡«·¯£Ÿ£­ÅÙãó‚Û«—‰‡“¥ñ«ËÎÊ—Ë×¹ôøøøùù„ø†ù„÷öõõôóò -ñððïïîíìëêˆéèçççææååääãââáàßÝÛÙØ…×ØÖÑÑÍÊÙÙØ×ׄÖ*ÔÕÖØÙÚÚÚÙÙÚÙÚÛÛÜÝÞßààâããääææçèèèêèéëëíïïïó„ô€îã¬pm•v—ׂ{xuazn™éx‚vqlb[UP‡hÑÑñµ£©PP™…N¥›“ZDhñ|zƒhD‘¥lj@rr\|Zl0‘¹xplnppnndNdh¥prljlh\X`zƒ‘“•™‘n­‰¡•‘ƒ|``Ñt‹|…ƒ™ŸRŸDh€éÑ¡Ÿ¥§§Kpp‰‹‰‡‘•—™•…~ƒ|zvtttvrhb`^ZPDHRPTZTVpdX``^^\XRPLFJLNNPn•Ÿ¥¥£¥¡Ÿ‡­¡p0¡¹ÅÕù‹ƒ…¡¡±ÉÉ‘Áñ‘±ÅËÃÃÅÇÑßåù†ˆï½©™‡‹•™©õ®ÎÏ̘ËÏ°ñõ÷õöö„ø†ö -ôóôóóñðððïî„ìêêéèçææ†åäääããâ„á àßßÝÜÝÝÛÙØÙ…ÛØØØ×Ô2ßÞÝÜÜÚÛÛÚÚÚÛÜÞÞàÞÞÞßÛÜÜÝÞáââãäåææççéêëëììíëìïïðòòò…õ€óÛbexj‡±ee[SFRN~ËabYSNF?4*B,¡ññ•pb+2LD@•pVph\$$\¡ZRFB80‰ZFhDD>h@40¡|F@<>@B@@:((P¡<DF@><<:4($*4B>02@L>6,0862.,&…" $>^dpx||xh•„7Á¡p™¥Írtlh¡Á‘©É‘Áñ—­½»µ¯³ÁÑÕë„ë¹£•…‰‹‰«÷¦ÃÅÃ’ÃÇ«îô÷ö÷…øùù÷øùùú„ø÷ööõõŽô óòòîíìëêéèèè‰æå„ä âââáàßÝÝÝÛÙ†ØÛÛÙÙ×Ô¼€„…€„‰€~|||~€€~~…ƒ~…~}~~~~~||~Šƒ~”~‡~}‰€~}~…€¥‚~š~}{|||}„~ ~|||}}}|}Œ‚€Š…€‚Ú€‚ψ΀ÐÐÒÓÔÕÔÔÓÔÕÖÖÖ×ÝÝÞßßáââããääåçççèçèêêëìîîñíïñôòÁ“ˆË™~‡û’§«§ï—‡Åñ’›˜…íïÅ…`phÑÃïƒýד¥¹ÉÁÉá½Ù…Å›½ÃÍ̓µ±¹«“­»—…‘ù¹¡ñ£·½¹½¿¿¹ÃÁ©GÁ݇›¥á…§·ÅË×ßåç÷éÕ¯ùá±ÑÓÑÛÕŸ•ÉÑáÛíõû‚©¡|Ù»íïëõ‚±—¿ÃÇÃÉÓéëïëÝÉÉÓ×Ï„Ëiɽ¯­««£“…™é¹‹»ËÇÃý¹µ·»µµ±­¥©ÉÛÙ×ǹ£“‡v¥¡``‘±Éù|xx¹D0`­zz~||—©©©­¯­³¿ÇÓᎌŒ‡íã“Ý©¯¤±|ßà÷õ÷ùùù‡øùø…÷õõõôóòò†ñ„òñññïïîîíííëêêééèèèççç†æåååäãâááßÝÛÙØØ…×ÖÓÒÏËØ××„Ö -×××ØÙÚÛÜÜÜ„Û€ÜÝÝÞßßàááãäääååæçèééêéêëëìíïðôòóóðå®zh‰x‹¯û|tsp§`r³ÙsrmhaUM™‘tP±ÑᩧRP£L\©¹—™—t\\Ñvz|ƒl&@‘tjPXttPl­l@ñÅpjjjnpphZ\`­pfb\P‘Pjv[~|z~‹‘‰‹~Á©­|tND`x‰|‰‰“—™QUQb•ñŸ¥§¥Kfd‰‰‹‡‡¡›—ƒxzxxxvxvvrnfb`bZNLLJNTTT|dRb``b`ZTRL„JMLJVƒŸ¡Ÿ¥¡¡›…½¹p`¡ÁÅñ…•ù‘Ù—›•“›Ÿ«µÁËÑÓÕ×Û厎‘”÷Í­—¥›ç«¯¦»‡ÕÙóñôôõö÷÷÷„õöõôóôôóòññððïî‰ïîîïîííììëëêéèèèç…æåååääãâ„á àßÞÝÝÝÛÙ؆ÙØ×ÖÕÓÞÝÝÜÜÛÛÜÜÜÝÞßáâááàààÝÞÞßàââãåå„çèèéëìì„í€ïïðñóóôôöõõæ¡c\…f~¡ÉV\XVx:`p,0Á|<>B>4(x½@:<<6T4F>@FHHTX`VXRxphxfVHR<@<>„Di@>:>B@0&&,:4.0HH:2(0<840,($$""" *Ldjtz|vpj¥¡áÁ±‘ÅhpzÙlxÉ…vrrv™·Å½µ¹¿ÃÁÅt‡Œ‘™”ÿÉ£¥›Ý£¦ž¯…vÃÔóõöôõöö„÷ö÷ùùúùùúùùø÷öõõ‡ôõõôôñðïîîìëëêéèçççææçç…æååäääããâááàßÞÝÛÙØÙ„ÚÛÚÙÙ×Ö»€…„€…‡€~||}~€€~}~„ƒ~†‚~‡„~||~‰~}}~…~‚~‡‚~ˆ€€€~~~…€¥‚~›~}|{||}~~~~}~~‘†€‡ƒ€„Ù€„ÎÍ„ÎÐÑÓÓÓÕÕÕÓÓÓÖÖ×ØØÝÝßßàá†ã€åççèèèééêììîîõðõ÷ûÕœŽÉ~p«Ž¤§¥¢ß•‰Óû‹“’˜÷ëÛå¹ñHÉ…Çõ„ûùÛ‰‘©©·ÇÝÉõ¥™¯½ÑÅññ§µ¥§±µ—Áññ½h§½Ã¿Á¿Á¹¿ñxÙ‰¡ýµÝ¡½×ÕÓÑÏÓÕÁ³ùÑÙµÝÛ×,ßÓ‘ùá“ÃÏáÝïó÷ÿ‚¹õ»×éëíû§‹½ÁË¿½Å×çïíÛÏÓ×ÙׄÓfÑǹ¯­­©©•ƒí…“á“ÁÉÅÃÅ¿»µ¹Á½»·¯©¡³ÙÓÑŹ©—ƒÍá``@P¡ù‡ƒÅl‰|“™Ÿ££©µ¯¯¯µ±§«­³¿Ï—¡©¥—õ—ž¥pt£Ïú÷ø„úù„÷øùø„÷ö„õóóòñ„ð ñóóòñññïïïî„í ëêêéèèæææ†å‚æ„åäãââàÝÛÚÙØØ×××ÕÕÕÔÐÍ‡Ö -ØØÙÙÛÛÜÝÝÝ„ÜÝބ߀àááãäääæäæçèèêêêëëìíîððôñöðï½}lŸv…•Ùxuqqj|¹ÍhgbaV™““•jHÑ™ƒ³©R£¥“B<`‘™‘•ƒP¡p~|h@h~h\bztB ¹¥d@‘djbbfjjh`PhÁbtbV``±|||xz|…‰a|zv±™©‘«Ÿ‹ztNp±t‡…‹“•‘•ŸSPr¡µñ›Ÿ¡£¥¡d\‹‹……¡“‡~rtxzvtvvvttjdbfbXPFF•LRTFpPdbff`\VRNNLHDFNLl——„¥@—éù‘``±‘剕ù¥±‹™Ÿ¥Ÿ——Ÿ¥³»ÁÅÉÍÑÕÑÑï…‰‘¦¯­Ÿû±™¹ù• ·‰£Èñóõóôôôõ„ôõöõô„óòòñðððîï„ðïððïîîïîîíìììë„êéèèæææ†åäã…áßßßÞÝÛÚÙÙÙØØØ×××ÖÓÒ„ÝÜÛÛÝÝÝßàááâââáááÞÞàááââäåå„ç€éçéêììíííîîïðòóôòõùöõÃmPvdf‰ÇiVWVYr<`‘IGCG=dbTP4¡h‘l|l6^ZN,`…xbPLD@•ZXFB0@hV2$DD:0™`$0X:4:D@86<<.@±lH:4X8DlH@>DDFJLLNNpd|f0rjb@N:H©Z\HNPB\fZ%):@|á…vhdh^BBn`\dfjtbPDD>:>@>@„Fq@:6:62,*($" " 6^fnx~~xtrÁá¡áÁÁ‘|ÉfdrÅt‰x‰…ƒxrlfrÅÅ·¯³·½··Û‡“¢¯³§™ù­•µñ™­ƒr‹Âòøõñòóóõööõöøùù…úûûøöõõôô„ó ôõõõòïëëë„éè„çæå„æ‡å„ä ãââáàßÝÛÚÙÛ„ÜÚÚÚÙÖ׺€……€……€…~|}}€„~}~„ƒ~…~}~‡}}~~|}Šƒ}„„~‹ƒ~‡‚}‰€€~~~§~„~›~}|{|||~~~~~”ˆ€…‚€„Ù€…ÌÎÎÏÑÑÓÓÔÕÖÕÕÕÖÖ×ØÙÚÚÝÞßàáá…ã€åæççèèééêêìíîïòòôû𷚊ƒt‡Ý–©¥¤Ñ›Ññ†‰Ž“†ßÛÍÛ³¥ÑñƒËñ‚ý÷釕¹é«ÇÙÓ›™™…§¹Í»ÉÉ雵³±³·“±ÉÙ©±‘‹§¹»½¿¹¿»£±‘‡‘‡¥¹ÉÝ¿×ÕÑÍÉÉ»“Åñ¥Ñ§ÍÝ€ãåÇõÁÁ‰»Õáçïñõ÷ûù¿±™ý­ÉÝåß÷‡¹Á˽¹µ¿ßçåÕÍÑÕ×ÕÓÓÕ×ÕË»±­­­¯Ÿ“ý僗‡í—·¿ÅÇÅý»»½»·³­«£¥ÇÑÏÇ»­Ÿ—•‡µp @™µ‰x«§­·»¿Å¿µµ¯«›•Ÿ§³É'ç‹–Ÿ¤®³¶¢Ë£¹Ýƒ§r‰“Æøòøùùúúøööö÷øùø÷÷÷ö…õóóòñ„ðñòòòñð„ïî„íëêëêèçæˆå‚æ„åäãââàÝÜÛÚØ×ÖÕÕÖÖÖÔÒÍ…Õ€ÖØØÙÙÛÛÜÝÞÝÝÝÞÞÞßàááßàááâãäääæäæèèèêêêëëìíïðñóôôïÝ‹lcƒ‰‹«ó~vwtp™t‰½Ëdb__R‹“‹h`±©±»­U§§™8(H¹‹••XPth|zZ$Háthfn|r< ™‰X`¡ff^\`f`€b`J(ÑhjbNl±ÑÕƒ||xxz~~j™Á•Å›“‡rj‘ñp‡‰‘“‘™™t­±á“•›Ÿ£^X—‘~x™—‰|vpprtrrttvttnfbff\RD…‘JRVLRfdffb^ZVRPNJFDJHVƒ“•¥¥§§¥—ÑÁÑHH¡µ•—‘ƒ“¯©Ÿ›••¥·Á¹³¯µ½¿ÃÉÛñ„Žš¡§²¸»§Õ­¿á‡¹—‘¿ñîôóóôôóóòóôõöõôôóóòò…ðîï„ðïîïï„îííìììëêêêëêèçæˆåäã…áßßßÞÝÜÛÚØØØ××ØØØ×ÕÓ†ÛÝÝÞßàáââ†ãààá„ãäåå„çtéèêëììííîîïððòóõñ÷øóÞ‡ZFThl“ájXYZYlHd‘•B>?A8X`VN44¡x¡h‰v7dZV -8©pjPV88`PTJ@*0¹P2.NF:*‰P h:.4<:4,8<*ph`D8(,8pJB@„F€H><\x|…Z`^\HtÍzlbbbZ<@jfZZ\Zf\LB@>:>@>@FHHFB<6*.640,6:H`ÁlLF<& @`•FHHJJJHH: @`…¡T€RPP80>BDFFFB<48BF:,"H`00,$H:<866862.($" " :Zdpvzƒ‡—…p‘‘™|jddx~~||p\ZXZTn§¿«z~‘™¥*£¥ÉÛwŒ¦¶¶·¾Ç°ç©¯ÝÉ…‡‰¿ïëïïðððòóóôõ÷øùúúù÷÷„öõõôô…óôôóòîë†éè†çƒæˆå„äãââáàßÝÝÛÚÛÜÜÛÚÙØØ×ÕÔ¹€†…€…„€†~~}~~€„~}}…ƒ~„~}}‡}}~~{}‰~{{~„~}~~‰~||~~†~}~~‹‚~ˆ~ž‚~„~~}|}}}~œ‰€ˆÙ€ÈÈÉÊËËÌÎÏÑÑÑÒÓÓÔÕÖÖØØØÙÚÛßßàááá„ã€äåçèèééêêêììîïðóòó䦜Õ~Z‡ßŠšŸœ›Œ£¥Ïã÷ýŠ†ù·¯·Ã¥­…á‘¥¯éýñÿùÅɹݵÉѽձÁ±Ë·½™‰ƒ±Áû¿¡©¡ùù§µ±¹¹½¹§0`µ•©±™Á™›Ÿ½ÏËÉÅÁ»™Ñ0±Á§»€ÃÏÁ™Ù™•Í­Ýéïõñïïñí»µ­›“©ÅÑÑߋ韻¹Ã·›“ÉÛãÓÉÍÍÍÏÑÑÕ××Í»«¥¥©«Ÿ•é…›¡‡å£­ÃÇÃÁ¿½¹·³¯­±·©¡©½¿Ã»±§¡›“nP há¡É¥³ÃÅÇ¿µ­©«¯§Ÿ¿Ó±xpzƒ•1©×íç烠±¹ÄÆÒÅÍÝã‡ÃÝõôó÷øøø÷õõôõõôõöööõõõóôõóóòñ„ð ññòñðïïïî†í ìëìëêéèçççæ„å‚æ„åäãââàÞÝÜÚÙØØ×××ØØÖÔ΀ÑÑÒÒÓÓÕ×ØÙÙÙÚÛÜÜÝÞßàßßàáâàááãããäääææèéêêëëìììíîðñòõôñÒ‡qp—›ß{||xthzx«ÅÃÁ»]Y¥‹‹‡ddhá\¡§±³§­d4,`¡‡‡‹thd±vvT 8‰dnhvxn*0™dx±l`€^XTVXVB4`nl`Phtdvvzzx|~~zj±‘áÅ|‰‡…~pT…‘½Ñ…—“•‘‘n‘¥r|››“V~“tjl~~xrljjjljhlnnrl`Z^bZPFFL\bPtLhplb`^ZXVVTPNJFHFXt~‘¡¥£=£«­›­‘ñ¹ñ™Ÿ›Ÿ¡©§¥£Ÿ™‘rŸÍÅ»§‹ƒ•§¯¹çõí냠²ºÆÇÓÆ”å÷ù‘ÁÕíòñðð„ñ‚ð„ñòóòññ†ðîï„ðïîîîììíí…ì ëêëëìëêéèçççæ„åäã…á„ßÞÝÜ„ÚÙØÚÛÛÙØÕ××ÙÚÚÙÚÛÝÞÞÞßááâããäåàáâãããååæ…ç€ééëíííîîïïïðòóõöõøóÑ~]]rbf~Éne][[STPz‡tl77jPZ`R68X™Lxzƒr``^4,hhHTL<@…RNF* (xD<2VF: ™4 p>",02**.&ÁlFN<.0BPFBDB>>>@@>BDD@:06>B:,"&`44086DB<20.,*& " *DRbpxƒ‡‰•“zpX™Ñ`dnvrxvpbVZZPDxÃÓ½›vnx‘$—ŸÁÏÉÓ¡®³¾¿Ë¾Ýïù›·Ñèëìîïïðòóòòôóó…ô óòñôöõõôô…óòôóòí‡é èççèéèççèçççæ…å„äãââáàßÞÝÜÚÜÝÝÜÜÙÖÖÕÒѹ€…†€‡‚€†~~}~~‡~~}~„ƒ~„~}}‡}}~}|}‰~|{~„‚~‹|||~‡„~‹‚~ˆ~Ÿ~„~ž~}}}~~ž‰€†Ù€ÆÈÈÉÊÊËÍÎÏÏÐÑÒÓÓÓÕ„Ö€×ØØßßàáááââããååçèèééêêììíîïðôìô¶’ƒ©Á•“ƒ“‘”‘ÿ‹…›ÃÛ÷û†‰ç‰£¹¥¡áéÑ•Ùñëõóáù™ñí¯¹¿±éÕ¹‹­Ï·™Ñƒ±Á¿Á»Ñ¡™±ù£¯·«·±³¯‰Ñ@¡µ—Ÿ§©™—©¯¯¹¿€¿Çñ©Á` Áù«µ»¿¯ùѱɩßåçñëéçé秉­™¿ËÑ׋ݕ³¿ËÁ™‡½×ÝÓÉËÉËÏÏÏÑÕÕͽ§›Ÿ­«Ÿ‘ýݧ§Ý…Ÿ±¿ÇÁÁ½½»·³³¯¯­§ŸŸ§­±³­©¥Ÿ™…h©Ù‰“—§½ÓÕÓÏÅ«£Ÿ•6ýÝ©Õ±£“rÉÅÅt‘©×ùûݽшµÁÌÑÏж݃¯¦ïññóö÷øøöôôóóòòóôôõõõ†óòñ„ð„ñïïïîíí…ì„ëêééèèèçæææåååääãäåããâáàÝÝÜÚÚÙ…ØÖÕÏ€ÏÐÑÑÒÓÔÕ××ØÙÙÚÛÛÜÝÞßßßàááààáãããäääåæçéêêêëììíîïðñòóëñŸosd~Õñ›|z}|vsÏv§¿»Á¹Z[›Zt‡`P¡¹L¹©­£§›…\8‘­zvfll­t|zN0Ñdpnxrd@`©l<¡Áh\€^ZRPRH@`Á•l`XPHNhtrvttz|vvx`P±Ý|…‡‡‡tbÉÑÑÉ…—‘“‘‰‰‰f`‘xvx‰““‹Zv‘xjftrxvrjjfhfffhllnj^XZ^\TJ‰xHdfXhFflh`^\ZXXXTTPJDBDJ\j~›¡£B£¥§¥É剙Ÿ¡ŸŸ¡¡£›…vl\…t‰ËÁ½­…ÝÕÙ›·ÝóóÝÉߌ·ÂÊÎÏÖÁ¦ë¯¡éêíîïðððññð…ï ðððñðððïðïïîï„ð ïîîîììíìì…ë*êêëëëêééèèèçæææåääãââááàßßßÞÝÞÞÜÜÜÛÛÛÜÜÙØÖ€ÖÖØÙÚØÙÚÜÜÝÝßßàááâääßààââãäåæææçççèéêìííîîïððòòóõöõñõ™`WJjŵ…me`]WY§RVvƒrrn27\2R`L,xx@pbxh^`\L4,‘•f<>8XB4PÑD @&O&(2&&& `>B8408TRJJFPHJNX8‘¡©RJDDD62…™¥•ZbZ\XRNPRL4Pb`RVTTF4hR`LPJ>>JJJF@<:„BB>:008@8,"DL0:2$$.HH8..,**&"  (8Rflxƒ‡‹‘t©±bb\blrtpljdLB@:H@rÇÑË«xŹ¹hƒŸ½Ëë¡Ã‚ª³¿ÇÈϼ¢ë•±Ÿææçêíîïïñóò…ñ òòòóòññòóóóò‡óòðîëéé…èççæçè„ç èéêçæææååää„ãâááàßÝÝÝÛÛÛÚÚÙ××ÕÓѹ€~~†€ˆ‚€†~}}~}‡~~}~„ƒ~„~}|†~|}~~|}‰||{~~|}}~‡„~‹‚~ˆ~ž‚~„~Ÿ‚~‚~†ƒ~‰‰€ƒÚ€ ÆÈÈÈÉÌÌÍÎÎÏÐÑ„Ó ÔÖÖÕÕÖ××ÞÞß…á€ããååæèéééêìììîîïðïñìšë‰©‘£…‹Œ†ï‹‘Éáùû…ƒÏÍñ›»³±ÙéÁ‡ÇéëíïÛñ¡ñ‡¯·»§íáÁ‡«Ï¥ù¡³Á±Å±ñP‘¡•™…£·¹¯¯­­©ý¡Á±Á‘Ÿ¡§±£±µ¹¿Åÿ¥é¡@•™§€­¹½¿·ùݹݳßãßëçåçéß…¥‡•½ÇÓÕѹÅÍ»“µÑÕÓÇÉÇÉÑÏËÍÏÏÍÁ£“Ÿ¯§ñÑý­­™Ùƒ£­ÁÉÁÁ¿½½¹µ·±­«£ŸŸ§¯³±­©¥Ÿ›‘“‰“›—“™£»ÓÝÝßÑ£‰ù幑‡Ç¯›‘pÕÝÁ!Ñ“Ï…Ž…ç͕ÀÐÓÛ×ÐÈ‚•ûßîòïöööøøöóó…òóóôõóó†òñ„ð -ñòòðïïïîíí…ëêêëëêé„èçæææååääãâãåäããâàÝÞÜÛÚÚÙØÙÙØÖÔÏ€ÏÐÑÑÒÔÔÖÖÖØÙÙÛÛÛÜÜÞÞàààââààáâââããääæèèêëêëìííîïðññïðå‚jo¹hÍõ¯‚{yxunÓ‰£¿»¿µWVƒxÅ…jX™‰@™‰£§§£›…`D™fxpZll­lzzH(0hjrptnZH±tHppfZZXPPH>@Ááj\VPPTjt„vVxxr¥8…~ƒƒ‡‡‰|háéÕщ™—•‹‰‹nX‰plp‡‡X‘n‘‹xj`hptptllhdbffjjllh`ZZXXTNhhd^hFfnd`\\„ZLTVRLHBBJVh|‹—¡Ÿ£¥¡¡•“™™Ÿ£ŸŸ¡•hX¡`Tp¿·µ­éáÝ鉣Ï|‚{˹ӘÀÊËÙÙÔ˃™óØçëèðîï„ð‡ïððñðð‡ï„ðïîîîíííì‰êëëêé„èçæææååääãââááßßßÝÝààÞÝÝ…ÜÚØÕÖÖ×ØÙÚÚÚÛÛÝÝÞààááâääàààââãã„å„ç€êëëíîîîïððòòóõõñùéz\SZÉ••k`\\VZµjdt…rrn12D<•^H.p`<`Xn`b`ZH84‘Xf82*@XHJJ8THDR>,PñTPF,$ 0(" Á‘lB<848N á‰t\LHJ€DDF<™­­™^`ZXRPNPRL6 T^XP\VPD6`NfNPH8<:::<<>@@<:008<2("<0PÙT4`pH4,(*"0Áé‘>22028NTPJHJ<<40p™|T€NJJLLXH­½µ¥jd\XNNPPRR>0`©‘BVVJF0D^JF@6tBHJF@<:::<<>@>84.28:0$88P<2,(PBL:..,,*(&"" $2Nbhnv|ƒ‡‰…vph^frrjhbTLF$(1NJJNTXH¥©•™j`XTJNPRRT:4h¥|tRRFDX(l\F<60x@HHF@<:::„.8‰>.6B>(0`©TTdp4*(*$ "$ €‰¥™2$*((,:HH@<:::>@><82.,066." &\6<.240L:8,.,,*,,(*&"">.,<<(0±B40B:@‘‘tl|8.$&*$$&"¡‰‰t,€&$$""0>@>>8$PÁ`щFTJPPNJ>6<`h`RNJHLPNJ>& 8‘T\LBB6@d^D626JBFDFB@<<>B@@<822,024," &X6<04&0<:<.220.,.**(&$ "6JTZ\fjjnÕ¹­¹±©­µ4Z^VB::<( 8X `Ù~µ›ÙÇ•vƒ“csrld³~‡w¥ÅÏØ×ØÞääèåçèééì„ï‚î„ï‚ð‡ïò†óðëèççæˆåææååæçèéêéèèèææääãáââààßßßÝßßÝ„ÛÙØ×ÖÔÓ³€†~~…€Œ -~~~}}}~‡~}~…ƒ~„~}}…~||}~~~‰}{}~~Œ~|{||~~Š~}~‚~†}~ž~…‚~œˆ~ˆ ~~~}||~~~ˆ…€ƒá€ ÉÉËËËÌÍÍ͆ÎÍÍÍÎÏÒÓ„ÕØÚÞßßáâãåèéêìì…î€ñðïôö¢‘…x‹…µ‘ûù†ŠõÇ«‡“ÓÝëíëïáƒÑ‰ÁÓ‹Ñ¡ÕÃßáåçã×ÙùűÃÏÛÑñ±É‘±±³åÉ…‰©¿»«™Ñ ™Åé…§»·±«¹£ÍÁ`\½ñ©‘ƒ‰—•£¡Ñ Phµµ×ÍÇ··¯£™…­á±³Í€ÓÓáãëéáݳ—ý鑧¹ÁÏõùá©·Ë˧•§ÅÉû½»¿ÇÇÃÃÁ¿µ«§£¡£“‹§—Åí¯»£Ù­ù±Ã¿¿¿¹³±±¯¯­©¡Ÿ™£§—•›‰‰ÑÅÉÕÙÕr‰¯¿ÃÏÏϣݡ‘É¡ÁÕ‘vpp±‹‹Õµƒ©Õ‹—™œ›•ѧýÈÝáéêäçêëëëìíïïïððñðïðñðð„ñðððñññððïïðñðîíí„ëìîìêèéêêéèéëëêé„èææåäã„á ßßßÞÝÝßÝ܆ÚØ×ÓÒÒÓÓÓÔ†Ö×…Ø€ÙÙÜÝÞÞÞàßáàááâäææêëëíîïïðððòôôðéšv¥Ÿlµ§÷ëvsrl×ÏÉ¡£»½µ¥™‰‹BH™‰“zD PxÕŸ™—•‹ƒ•‰•‹™‰‹…|\tbxnllX|prlbfD0`¥¡Z^^^\\^VD\0ÁɽZJPRPPP€`lrr@p¡p¹lrx‡“ƒpr\Ld±~‡‡‰‡‹‘‰‡pfhÅ¥r‡‰…x¡‰™z~xn`fjppxtnhfffbbb^\\XTRLTRHH…•`h\Ph\•d^bbb\TRRPPNJDDFLR^jzƒ‹‘‰vÍÍÝåå金‹&ƒfpP`¡ÁÑÝ•|‰‰¹‹‘ñÕ“¹Ï|Šˆ‹‰ŠÍ­÷”¸ÕÙØàãå„èêëí„ìîíìíîìí„î,íìíîîïððïïïîíìêêêéèèèçèèèéêêéèèçççæçèèèææåäã„áßßßÞÝÝßßßÞÞÞÝÝÝÛÙÖ…Ø„Ú€ÛÛÛÜÝÝØØØÙÙÜÝÞÞÞàáããåååçéêíîïðòòòóôôêïóöö˜tj‡¯r@…‰¹Á^Z]\±«±—fNPRpbjZ(\™j\V`j\J(T``@BD804@±ht@<2,((&.(00ÁP€x\(&" ,8><<4‘±±…@DPFRNPF@:8T‘lXPFDFJPNJF.,DxZbNB@d@lZH:6:LDFBFHB<<@@<<:822.0.0.&$&Hd:40,@8p<.464.,,,**(& $.8HPX\fjpph­©±­/¥©VRXP@68D0 (@@`Õ›‰h™‹“Ù½~£³kvuvoj•|ѪÎ×ÖÝàâ„å -çèéëíïïïîíï ñóóòòóòðëççææ‡åæççæåæéé†èææåäã„áßßßÞÝÝßÞÝÜÜÜÚ××ÖÔÓ³€†~„€‚~„}}~~‡~}~…ƒ~„~}~…~||}~~‰~|{~~~‹~}|||}~‹~}~‚~…~}~ž‚~„ƒ~œ†~‰~~~}||~~}~~~†€ƒà€ ÊËËËÌÌÍÍ͆ÎÍÍÍÎÏÐÒÓÓÓÕ×ØÞÞàáãäåèéêìì…î€ñòìôðŽ‘…ézƒ…Ù¯ïûƒ‹†å˱›“«×ÝéïñçÕÁѱv«Å‰É‰‘‡½Ù×Ó××ËÑ‘é³ÁÍÏÇé¹Ù—±µ±ÕÁù‡§¹µ£ù¡`™Ý£·Ã»·­¯ùé`‰å…“¡™•™Ÿ…‹™™…`8ÉݯËËÇÁ½±¯›ÙñÁ©¿CÉËÝáççãáí›ý©…Ÿ±¿Ññ…ñ¯ÅÕÉ£‘Ÿ½ÉÁ»¹¹¹½»··¹¹³©£ŸŸ•‘«™½å—³¿³…Å饿¿¿»µ­…«L§¡™Ÿ§«“‘•“‡ƒñ|‹«¹½¿Ë˧ƒÁ™é‰‘á“p™@átÍ¡Õ÷Š’ž¥¥¤Ï‚“¤Îåèëäæèéééêìíîî…ï‹ð ñññðïïîïðïîíí„ëìîìêèéêêéèéëëêé„èææåäãáááàßßÞÞÝÝÞÝ܆ÚØ×ÓÓÓÓÔÔÔ‡Öׄ؀ÙÙÚÜÝÝÝÞÞßßàáãäæçêëìíîïïðððñõñðæƒttý—“vñËñësrm½µ·»«µÁ½³§ŸTX‘DH‰~——‹‰r|D­‹‡…~dhxpjXPñlpjb\p0`x±\``\ZZXZVh@`É`\TTTLFJ€Tfj`L‘hXpÁÁhpr|…nhXl@¡‘tx~‡‰…ztp½dh|~ƒz™L©zrh\`hrntnld`\ZXXXZ\\VRNHPRJJ|‘djd^Jl‰\bbb^XRPPNNNJJLT\`fnz…‹‘‘‰……‰~ùƒ‰““‰vn,tlRt`¡på•vÑ¡á±å­áý‹ŒŠ‹‡‹pÃ}‡“ÂÖÔÞâåæççèéê„ëììëììíì†íAììíîïðïïîîíìëêêêéèèèçèèèéêêéèèçççæçèèèææåäãáááàßßÞÞÝÝÞßßÞÞÞÝÝÝÛÙÖØØØÙ…Ú„Û€ÜÝØØØÙÙÚÜÝÝÝÞàáããåæèéëíîððòòòóôôïòðóë|hfõŸjD©£¯¿ZY[¡—Ÿ¥™ŸhTRT$XV\V( XXbbRT^VDt^RBBB<2,*0$08``Pp,$"K $*64*$`‰¡É‰:BHBNNJ<>8H4pNDBDDHNPLH:BBh0¡ZJDB60hP<6:N<@2PP,044.(&„(D&$*,8JNRRNRZZbhtƒƒƒ…ƒrb\•JPF4,446H(,@x·‡ÁÁ`t|³×rxxyumja`ml«‡ÖÜÖÞà„âãåæéììíííìîïíî„ïîíîïïñòòñññðîëççææååæççæ„çæåæéé†è -ææåäãááààßˆÝ ÜÜÜÚ××ÖÔÓ³€~~ˆ€Ž -~}~~}|~ˆƒ~…ƒ~„~}}…}|{}~‰~|z{~‡„~~}|}}}~‹~}}~ƒ~…‚~ž‚~…‚~£~ˆ~~~}}}||z|~‹€Þ€'ËÌÌÌÍÌÍÍÍÎÌÍÍÎÎÍÍÍÎÏÐÑÓÓÓÕØÙÞßâãåæçéêìì†î€óóíôÑ•áá|¥ÇïëóûÙ¥›¯Ëããëïï×í±á‘¹ÃÕ¡‰é«ÇŽŸ§¿·í­‘»ÅÇÇ»ñÑõ›«µ¡­¹‰…£±±‘©‰Õ“©±³©£¹‘ÑÁáå‘—™›Ÿ‘ÅÑ™µÅ½¡HéÙ—¥±³ËÁÅÇ·±Å©™±í©¹€¿½ÃÉÓÛÛáÉ·•Í©ù™±¿Ó‡ý·Ã˵Åñ§¹½µ³³³±­«©«¯­¥¡ŸŸ§£›·©Õ音ÁÇ­ýÑ…±¹»¹³§¡¡££§­¡“™¯ÇÕÑ»§­·ÃÍÍÉËÓÓãùѹÅÙí‹¥¯©ŸƒÑ©…ù•¿£™```PÉåçïÿ‘¡¢ ¤¤±á»éåãäåååæçéêëìííîíî‹ï ððïïîîíîîîííí„ëíïí…êéèéëëêé„è -ææåäãáààßÞ‡Ý܆ÚØ×ÓÔÔÔÕÖÔ„ÖÕ„Ö€ØØØÙÙÙÛÜÝÝßßàààäåæèéëìíîïïïðððñôòñÈijµý£“‹£ËÓÙÙÕ½‘µ¿ÅÏËõ¥pp‹tl8PÁ—…^btl|Th‹ƒx‘‘lppZ4H…jnlfRH0X`^b\Z\`^N8`ÁÁ™RRZ\XT€‘4DTTL`щ‘áµfbjpp~‹‰p^pp‘Åtppnfjv~~tvzdx`½x|ƒ|Z`µ‡ztfR¥¹jjnfd`ZRNJHJPVXTRPLRTNP‘­nxpnf¡|JZ\^\VRTTVVTTXZj‡‘••…‡“¡©««©©¡¡‘ñÕµ¥¥2©XdtzrXdHÁ™Ï¹Å¡¡Á…‘Ëéïóû…‡…}~†}£Ù¶ßÞáãäääååçèéé…êëŒì îïîîíìëêëêêêé„èé…êéèèçççæçèèèææåäãáààßÞ†Ý ÞßÞÞÞÝÝÝÛÙÖÙˆÚÛÚÚÚÛÛØØØÙÙÙÛÜÝÝßàâãäçèêëíîïð„ò€óôôø÷ðîÅ_R|Õ‘~Rh“ŸŸ¡›z‹§³±µ§£hRR<0XHRH4(X\XH4>N@(LVFH@DTldLJD,h@02D.‘0tB:8*(0:*,`Á¡…:.(,22@ $,,0‘x™ñB46>@BF@,6,@h€‰J<@@48BJJJ>@68L¡\PHD:<…fR@40t`::@<862,(&$&,,,*,,02,,0XtDB@:4\L$*02.((**,,((02Fdnrl\RX`dhjhjjf^P‘‰hT`l<>86:*<,Xƒ½©µÑ¡`0d~±Ë×çãoopmgimfÉ´ÛÚÞßàààáâäåèêë„ì„í„îíííîïðòòññððîëççææååæççæ„çæåæéé†è -ææåäãáààßÞˆÝ ÜÜÜÚ××ÖÔÓ³€~~– ~}|~~}}~ˆ‚~†ƒ~„~}~…}|{}~‰}{z{~†~}…~}|}}}~Š~}}}~ƒ~…‚~…‚~—‚~…‚~¡†~† ~~~}~|{{|~†ˆ€‚Ý€†ÌÍÎÍÍËÌÌÌ„ÍÎÏÏÑÒÒÓÙÛÜààããåçèêêëíí…î%óïìç«Ù‹ÍÙƒ›·ÏÛõëïíÏ£“Ÿ£·ÑíéíëóÇ¡áÁå«Ï„Ñ€¹ËÍŸ…—³¥íÅ·¿Á»¡Ùµé•¯·¡‘ɵ§¯·‰ñ¡±Ñ•›Ÿ¥§¥¡¯ÙÁ`ñý›Ÿ¥›‘±Á ±•¡™± ÙÙý£±·µ¿½½»±¡ùÑhxÑ£·ÃÁÁÃÇËËÓŹ•ÝÁÍ“¯­½ýɉ«¯µ—­Ùá¡·µ±¯±¯¯«©§§«l«§¥£§­¡Ÿ½±áá›·Áó—éñ£µ¹»µ¥››Ÿ¡¡…­ËçíåÛÝáëïíëëïÛ¡Ñ¥‘…•©Í‡Ÿ­«—…ñÕ±Õ¥»‘0`¹É•½Ùßá郒š›Ÿ¢ª¢ñå|·ßäåãäääåçèéêë„íŠî†ïííîîííìì„ëíïíêê„éèéëëëêêééèçæääãááàßÞ†ÝÜÛÚ…ÛÙØÓÔÔÔÕÕÔ„Ö ÔÔÕÕÕ××ØÙÙÜÝÞßßààáâãåæçèêëìíîïïï„ð€óò㟭\á›™¡»ÇÏÑÕÑ»•—¹ÇÏßÑÉÁ¡•z4@±å‹ƒnPXÁ…‹jTbr\xpx‰‡‰…p•‰­jrjP(@‘jnhfJP``¡^\^Z\^`X|0Á`Ñ©RRVXZl±¡@HPH0Áé¥Éfdhnjv~zp\™ñ™¡­rpp€nllpvvtrpXhp©jvx|¥|`|vlTd©¡fhhfb\VNLHHHNTVRPRRX\TR­nzrlhX|xXZZ\ZVVVZ^`^``n…™­¯§¥§«¯±·»³¯¥|µ‘‰‰¥hzƒ|hT‘xl`ůϥÉ`ÁÉÑ›Åáçåãu‡…|…‹ëù‡¶Úààßàááãäåæçèé„êëëê†ë ìììíííìëë…ê„éèèé„ê‚é„èçççèççææääãááàßÞÝÜÜÛÛÜÝ…ÞÝÝÛÙÖ‡ÚÛÚÛÙ„Ú€××ØÙÙÛÜÝßßßááãäæçêíïîïðñòòòóôôùøôä “BX­~lƒ•Ÿ¡—xƒ©·¹Á±©•bL@P@•FB6p\VRZ8*\dpDB@*d<.0:" á`P`864..26&40ÁÑD8828:<:6,40P@XlF:BB:<>BDJB>4hPXVZ\\^^blpjhÑlz—­³«­¯±³¹»¹±¯™±l±Éé|µrztfXR•…tƒ»·…`ÁÙ¥ËÝããávƒ‡wn‹”‹‡÷šÏÞÜÞáÞßàâãäæçé‡êé…êë…ì‡ê éèèêêéèéêëëê‡èçççææååääãââáàÞÝÜ„Û ÜÞÞßßÞÝÝÛÙÖ‡ÚÛ‡Ú×ØÙÙÚÜÝÞààßßááãåæëññïïð„ò€óôôú÷óÈÕ|@L•~x‰™§££§z£·¿ËÁ³ŸdP8@@VF60X^TNJ2T@L20TXRFDL4X\x:8<,X8.200¡`‘l.866600$`ÁÁLH:<2X`@X@$0 `ÁÉ…F.8:<>:@:442(p@`€XD2PlhDLF@X\:F00&$h\482:82.,($"" "(,.04,@LBPB24:&0&$"$260.08><:|JTfzvnhbfbff^X\R\4P‘``|LNF<0*HDPD\f•Ÿtp¹~¯¹ËÑÍfmhhTMq„ë”ËßÞàâàââääæèèêëì„ëìîïððï„ð,îííììîðíéææååææççåãáááåæèèéêêéééèçææääãââáàÞ†ÝÛ„ÙÛÝÝÛÙ×±€~~–}|}„~}~…~~~†ƒ~„}}~…|{{|~ˆ~{zz}… ~}{|}~~}|{|}~Œ}|}}~ƒ~„‚~…~}~—‚~‡~~~~}}}~~~†…~~{|~‡Š€Ü€†ÍÎÎÎÍ̆ÎÐÐÑÓÔÕÖ×ÝÞßàáäåçèêêìììîí„î€ñîó›ƒù±±—±Óéíéíéå׿¡›§Ñãûýï߱ṭ½ÙÏÅÑÍ«½Ç³ýù›«“틧·Åūݥ哯µ™ùùñ£­µ¿…±`áPÝŸŸŸ§§©§¡ÑÁÁ`¡¡£§™±‘`@•Á…‰`¡`•õ“›³½¹³¹»·³³…™Ñ`x¡Ÿ»#ËÉÃÁÁ¿¿·­§•Ý½•¯£™ù‡§£­—­ñù¥·­©©§§„©o«­«§¥¥§¯£¥Ãµùõ™»¿»«¥ƒá‹£±¹±¥¡Ÿ¡««¡‹‰•­Ñåëó÷ù…„ýûí³¹ùÑÙᅥ呛›•‰ùÑÕÝÉÕý‰¡¡±‰—£Í×ÕÝ£ó©®¢{«}¾Þáãåàßâåæçééë‡ìíííîííîïîîïîîííîí‡ëíïíêêé„èé…ëêééèæääãââáàÞÝÝ„Þ ÜÛÛÛÜÜÝÜÚØÓŠÖÕÖÖÖ×ÙÙÙÚÛÝÞßàááâãääçèéêììííî„ï€ððñîò`¹lX­¡±¿ËÏÏÕÓÑ˳¥«ÁéóqÝ׫‹^@±±•‘t@PÅ‘‰l©rrJ|d‰‹‘x‘l…¹hnhJH`µrrlhB0`‰¹```^`\XTPÁÁ`‰^XTVTh`¡dHP`¡xÉlhjddllpprvPXቡ€ntrptrrpphb`P>…­fpxdPhppdLL‘©fhbb\TNHHJLNPRRNLNR\^TR­­dpfbdZ@`HTX\\``dltzrpllp‡¥±¯±¯±Z\]µ¯§~‰Ñ¹Ùá…™Årrh`XT‘|…µý‘©ÁÉ­×ãÝáç|ƒƒ‡½rr“–‡Ý‘ÁÙÜÝàÛÜÞâãäåæè‰é -êêêéëìëëìë…êééèèèêêéèéêëëê‡èçççæåäåääãââáàÞÝÜ…Û -ÜÝÝÞÝÝÜÚØÖ†Ú ÛÛÛÚÚÛÛÛÜÙÙÙÚÛÝÞßàáßàááãæçìñòïðñ…ò€óôøòòb‰L<‰…‰•¥£¡¥¥…•±×ßeµ¡pR2@lfJH8`RL><222,llFJH8H.>D,,($ph680860,*(&$$  &,.04,DLFNJD@FHTnrljhj454`Z\DDphx¡dpNF<80*@80600¡`ht.4640*(ÁÁ±x@82,$Á`@0,Á¡¡l2,$@<<:8668*040txLFD8$,>D.2.8P:68262.,*„(o$"  &.002.$H2B6(*4.4 ,*(0@HXbb^^PHHFL^ddff43310\J6hX‘™©|LD@>B@.@Ldpx•©n›±½»ÅÏkrpiTPfyˆÉ¯~¢ÌáÛÞÝÛÞáãäåæèé…êì†î ïððîììëëìîìç„åææççåãáááåæèèéêêéèèæææåääãââáàÞŠÝßÝÛÛÚØ×°€~~}}~€€€~}}…~}…~~~†~}~…‚~†|{{}~ˆ}zz|~… }z{}~~}{|{~~Œ~}|||~Ž‚~‹‚~™~‡~–…€ ~~}}}~~~‡‰~ˆ…€}€€Ü€ŠÎÐÐÑÑÑÒÒÓÕÕ×ØÙÛÛàà„áâäåçèéêê„ì€íîëö͹¡±É…ÉÛåãßÛÝ×ÓÅ¥•›çùƒ‰†½½É¡±ÃÙÏ…ñ™›·¿±é݃Ÿ“݇«£³µ³åñÁ郫·³…‰¥‰¥­µÁñ`X噡«­¯¯ƒáÁÁ‡¡±±£ý`‘™Ñ‘`0pá‘¡­·ÉÉ»¯¹·¹¯¡¥¹‘ች,£¹ÅÅ»¹··µ³­«›‹Ñͧ±§©Ÿ¡«±¥µ¡Í¡…£·¯¥§¥§««¯³·³­„§i³³­Í¿‡í¯ÁµŸ›ùý‘©±³ÃÑÛßÕÅ»£—¡¹ÇÝëù‚ƒ…Š‡‚õˉÁ•á±±•É‰Ÿ«­§¥©¡‹ñ……õùõõŸ£·ËÑÕßç…œ¢ó—¡“Ñ©¥r‡µÛÞßÜÞßàâãæçééˆëìíìëíîííîííëìíëëéê„ëíïíêêé„èé„ëêééçææääãââáàÞÝÝ„Þ ÝÜÝÝÝÜÛÚØ×Ó†ÖØØØÖ…Ù -ÜÜÝÞÞÞßàââ†äiææèéêëëìííîîïïñî·…`d™ùÉÇÇÅÅÍÓÏÑÇ¥Ÿ­ñùxsk‹h`¡¡››‰HP`‹“‰v||\vZHP……‰~x|XX©\tvxH4TlvrllH0@™½^ZbdddbD0ÁÁá\„X€|0``d¥X0`0½bddlljjnllpldd™árpllljhhffddXHxÅ|t~f`djltlVll\dhd`XTPLLPTZVTRPNPVZZRPV™P^ZZXPLx…NVXl…Ÿ©¡“‹…ƒ‡‹›¡§SUTTVVS¡…\­‘áÁ8ɉ©lxxtpprlb±RN¡¹½Ù…©©½ÕÛßãç|ˆƒzÙ‡—ÛÇÑ…µÛÞßÚÚÜÝßàããææˆèéééèêêé„êèéé†è êêéèéêëëê‡èççæåäãäääãââáàÞÝÜ„Û ÚØÚÚÚÛÛÚØ×Ö†Û#ÝÝÝÛÝÝßßßÜÜÝÞÞàááãäááâãããäéîðíîïïðð„ò€óíµrF@xÑÙrŸ—‘“™Ÿ¡§r¡íùn]M`8L^VPL&H\^TH<00H2,`\P:>,0‰FJ>D$>6(220á0hx0442.,,0ÁÁñB>4.",0¡0TL0Á‘X‰>82>DB>>DBB8. XpH`H<€><::8662*,..TpLF@B,*>N.42D\<48262.,,**,,&" "(0202.$@,<6&&02DH0.*<\lzxrp^TRVX^^`244221-ZN:|t¡‰¡t…RTPJFFHB>x<>‘‰\™­¿½½ÅÏlsl_ŸJ 0ƒ½™¡vŒµÛÞßÛÛÝÞàâäåçèé„êì†î/ïðîíìëëêìîìçäåååææççåãáááåæèèéêêéèçææäåääãââáàÞ†Ý ÞÞßßßÝÛÚØ××°€~}}}€€€~}|~…}~„~~~†~}}}…‚~†|{|}~ˆ|zz|… ~|{|~~~|{|}~~}}|}~Ž‚~‹‚~™~‡‚~“‡€ -~~}}}~~‰~„~‰„€|}„Ü€…ÎÏÏÐÐÐÑÑÒÒÓÔÕÕÖÖÛÝÞßÞáá„àáâãåæçè„é€êêëéð­Ýµ¥¹‘x‰ÇÕÕÙÕÓÙÓÓű›©éõû‡ÿ…©Ñå·ÝßÇé…É£µÁ›ÉÉ£Ù‹­Ÿ¯­¡ÍñÑɯ·¯é‰µ¥³±»•™‘ñ™Ÿ¡¯µ³«íá0`Ÿ©­±§ñ‘¡¡½áÁ¥§§½ÇÅ»³µ»¿­“ÙÁ‘¡½£·ÅÅ»¹¹¹·¯§«¥‹±Ÿ·½µ„·€©»¡Å™‰©µ³©©©§««±·»·±­©©­µ¯«¹¯‹é…¥·µ¡Ÿ•ƒƒ“¥½ÑáããßÛËÁ¯«¹ÑÝñÿ‚‚ƒ†ŠŒŒƒï½…¡éx¹É‹©·³­££§Ÿ‘‘…ñù‰‘¥«±½ÙãÛ熛›„á·©ñ±•Ó~›ÐÝßÝßßààãçééêëìíìììëëìììëìíííìììëììëëêê„ëììëˆê„ëêééçççååäããâáàßÞ݈ÜÛÚÚÙØÒ€ÖÖÖ×××ØØÙØÚÚÛÛÜÜÞÞÞßÞßáááãããââããäæçèééêëííîïïð똟r\p‘…ÉËÉÉÇÍÑÑÕÉ¥›³ñùõrÇ^`±ÑõŸ«™…@•‘flxZvRLZ‰…‹~jhPXpVxxx‰0hlppljN0@¡É`X``bff|`0`‘`\XXTd@p•¡D00p¡jbbdhp…l€nfVL¡±xrpnpljjjhhd`V6D©…zzpfflprlVlp\dff`ZTPLNRZ^ZXVRPTX\\VTV™LXXTTPNDBL`v‹¥©©£™“‹‰“—™QSTTSSUT¡…f‘á‘ÁÁ©©p…~xplnplbR™¥^nƒ§­8¿ÓÛãåëz„|oÉŸ‰ñ±—­ÃýŠœÑÝÞÛÛÜÞÝÞâãäåæçèçæçèèèéèèéêêéééèèèé†è éééèèéêêé‡èççææäãäääâáááàßÞÜ„ÛÚÚÛÛ„ÚÙØÕ€ÛÛÛÜÜÜÝÝÞÝÝÝÞÞÞÝßßßàßàâââäääãããäçëìëìíîïïðñòòô딃N@¹pv§£™———Ÿ£©Ÿnv£ï÷á\‹<0 •`dVP<pVZV: (*H0 :^PJ>2$ 8PBN>B8(>6.:4"¡02(.,.€.*`pD>82(0Á dh$00@TB640JJD@B>>@6$0h@8lLBDF:::888.28$,dXNFD44<>DD@6dt@DZ‡•§»ÅÅÅËilbO‰f `™~|•ã‰ŸÔÝÛÚÞÞÝÝàæçæåæçééêëííîîíììíìì„ê'ëìëèæçççèèæäãââäæèèééêêêéèèçæååääãâáßß݇܄ÝÛÚÚÙØÖ°€~}}~‘€}||~„ƒ~„~~~†~}}}„ƒ~†}{|}~‡~{|{}… ~|{|~~~|||~Ž~„}~Ž‚~‹‚~™~›ˆ€ -~}}||}~Œ‚~‹„€}|~„Û€…΂ЅÑÓÓÔ×××ØØÜÞßßÞááß„Þ€ßáãååæèèææçèéèä›õ߭ṉ|µÁÅÑËÍÕÑÑ÷›±åóûÉñ@h¿ã߽ݡñ£±¹ƒÅÁ¥…݉«¥ŸÉ…áÁõ¯³«ÙÅ“¥·¯µ±¡áÑý“Ÿ¡³»³£íÁ0ᥩ©­§Õ¡Á­ÉÑñ¡ùù©«­¹Á½»»€±»¿¥í……±‰½¥»ÃÁ½»¹¹·³©«£ñ¹™¯Ë·ÃÇ¿±«½—µ•­³µ««©§«­³¹½»µ±««±±­§£‰áå‹©«¥›‘‰‘©ËãéåáÝßÇ·«¯ÉÝã÷„‚„‡‹ŽŠÿã«ù¡p00Ñ‘¥±±­©¥¥££ññƒ‹—§­©­Ùáß냅íßãñ½£•…Ã|ŠÎ߆à âèêêìíîïííí‡ëìíìëééê‹ëêééèççææåäãâââàÞÜÚÚÚÛÛÝÛ…ÚØÒÖÖ×ØØ…ÙÛÛÝÝ„Þ€ßßàáâââãâáàßààáãäæèèêêìíîïïð䊱‡X±·ÇÇËÇÉÏÕ×É¥›½ñùýl‘‰±¡±‘¡§—||hÅ‘ƒNp|\tFP\‰…v^l0hX©xxv…8…prpnfV@``©Ñb\`Z^df…`0Ñ^^ZXNP`Á¡‘€X0`ÙÕjb\dfrtnlnff^|L`d‰`tttrnljjhjb`THH‰…vjthjntpjN`x\fdf`\VPLNV\`^ZXRRX\^\\ZV••VVNLPNJP^x™£¥­©§¥•‡‡“™™ONQSTSPR£ŸƒÕp©Ñ¡¡x¹x~ƒ)|ztllpxpV¥Zb~¡«½ÓÕáéëvvkɽ»­¥n—¥¯ç†ŒÏßßÞ…Ý ßâãåæçèæåæçç…èéêé‡è…ç†èêéˆè ççææäääãã…á àßÝÜÚÚÚÛÛÝÛ…ÚØÕÛÛÜ„ÝßßßÛÛÝÝÞàààááßßááàæåå„ã€åççêëëííîïðñòõä‚Z@h™tnŸ¥Ÿ—¡¥­¡nv­ïõÝSX @ 0^^`ZJ44RRP$,,D,8@ZD@8&,@ L><0DB<:B6*``‘¡4 ((,.,$`±©<:42&`Á LdH0@¡l>402RF:<@€86<0(,D@hLDFF<:::8>4:848PXLD>::<<8<*4`>84642,(($$*.,**&&,2400,(@P22""(08BLN\lxvjdld^`dfb\X-021221-LL@P‰`fbd^\VRNPTX\\ZXVTX^`^^\X™‘¥XLHNT\hv¡¥¥¯«§£‘‰‡ƒ‹£¥SVTTSTRQP™—…l©á‘‘‘‰Å|xx|rnt|t­™¥XZt™££ÅÛÝïçtǧ¹ÁiÍÍ¿¹±·å…ŒÑáßààßÝÜÚÝßáäååçääåæççèèçèèéˆè…ç†èêéˆèççææäääããáááâáàßÞÜ…ÛÝÛ…ÚØÕÝÝÝÞÞßßßààÝÝÞßßàáááãß„áçåäã„â€äæèéëëííîïððòÛx‘n00™l¡ŸŸ¡›Ÿ«¯µ«‡•ÇõÉ( 0hd^^XD&6\TR>0,80FD(:XF6,"88(|H8<8(`L@:B:0Á`J2 &$(**00±áx22*$ÁÁ@HP 0@…::204F:0268€4848LH`HB>@@><::>.6, @@LFD@>@B@:6,p@82622,**&$&**,.,*.0,*(&$@D\* &4DT\bnxxthbh`XZ\^d\X-10./..*FD>>@0 0 H‘\J@FJF<88:8D60048@>><:::.,0@P`lnffflvzpf`dZL™¡Tfnd)…-Q+)JD@B$@¡`Pp\TNHHH:(*6BL8HP`TFln¡tÉÅÃÅbblb•M›—ŸL…Ÿá†ˆÇÛãíìêäàÞÜÜÙÚÞáåèêêéêëëêèééê‡é‡èéèæææèé‡êééèèèæææääãâàßÞÞÜÜÝÛÛÜÜÛÝÛ…ÚØÖ°€~}}~~‘~||}~‹~~~~~‡~}}„ƒ~†}zz~‰|{|~… }{z}~~}}~}}~~}}~Œ~||~‹‚~™ƒ~’‚~„ˆ€„~{{||~„~~… €~€€Û€„Ó€ÕÓÓÕÕÕÖÖ×ØØÛÛÝÝÝàáâââááÞÚÚØØÙÚÜÞßâãåâääåæäÕ‹÷ù³•Ù‰¥v‘·ÅÉÑÍË¿¡Ÿ½ÍÛ·¥‘0hµÏÉÑËÅ¿¿½áÑ©Ù‹—åñ«­—ƒ™•±¹‹©Ÿå‘Ñ—¥µ¯¹£¡ÁÁ—‘¡«³¯¥…¡€0¡½‰ýýõÉÁùÅÙ¡½—›‘³»»¹Ãdzɩ¡¡©`…ÁË¿»¹¹»»»±¿¥½á‘‘§·ÉÏï­³‹©¡•«­±©©«­³³±«¯µ·µµµ·±­§£Ý½áŸÃÏÕϽ¡—‡ƒ›¿ÑÏÍɥ͑¡‰Óƒ‡‘Š„‚H÷åÁ³Å`ÁÙ—™·»Ã»ŸùÕù“£‘ùñù‡¥µ§áµÅíñ÷ƒ±•É‚ƒÕÝù÷ÛÑÛñÏìéìééæääåãßáåèëêìêçç„éê‰ë‡éëëééê‹ë êééèççææå„ä ãâàÝÝÜÝÜÛÝÛ…ÚØÒÛÜÜÜÝÜÜÝÝÝààáããââ…ä€ææåãâßÝÛÙÙÛÝÞßáäæèéêëììíØ{µ£T±t•‡¡§½ÍÍÓ×ÛϱµÙ×ÛƒPH‘á‹™Ÿ¡™“‹‰‹…PThddhppnƒrNLbjh882>X(`PDDB:.ÁÁ0<0,&"$*.0‘±¡6,@<,¡ÁÁ`,hN@6*(*,,88::@1410/.,*LHPB`d`*Fhj¡¥Ÿ½Ác¹P0@…[Y‘™¥—™·Ùá½ÛæòðîéåáÜÙÓÔÚàäèêêééêêéèè‰é èèæææèèééèèè‰êééèèèæææääãâàààÞÜÝÝÝÜÝÜÛÝÛ…ÚØÖ°€~}~~~}||~‹„~~~‡~}~„ƒ~†}zz~‰|||~~~~}{z}~~~}}~~}}~||~‹‚~™ƒ~‘„~‚‰€„~}{{|~‡ ~~~~~~„ ~~€}~€€ˆÙ€€ÕÕÕ××ÕÕÖÖ×××ØÙÙÝÝÝÞÞààááàáàÞÛÚØØØÙÚÝßáãåââããäà»ñáåÙ‘µ‰±Õ‹¥ÁÏÑǹ›¡ÉÍ»é¡Ñ@@µ§µÉÍÕËÅ·¹±ƒÍÅ­Õ‡‘ù‹­­‘ýŸÁ±éƒ›¥£í‘Ñ«¹¯³™ÁÁ¡Ÿ™—«³·€³«ƒ‘0ñɇÙÁéåÁÁ…Ý‘“«±Ã›—™‘ýñ§Á½ÁÃÇ©…™©‰ÃÇ¿³·¹»»½©½©Á‰p‰Ÿ¥½ÍÏù©±‹™‰‘¡§­©£¥©­­©£¡«³µ··¹±­«Ÿ™‘…ƒ™»ËÍÍ˳•…íÙí£ÅÉËͯÍÙÑÉ™™ã‚‹ŽMŒƒûóÛ·«Ý©áÁ™©¹µ½¿·ñÁÕåíùƒƒ«»¯‰Õ›Íáõó•p`±Ë͹ñÝùÇÅÁÓÎðîëìëêèèçäßÞâçêêìéççç„éêêêë„ê‡éêêêéêêëëìììëëë„êééèçççæå„äãâáÞÞÝÝÜÜÝÛÛÛÚÚÚØÑÝÝÝÞÞÞßßààááâã„ä„å€ææåãáßÝÛÚÙÙÚÜàâãæèèèêêëç½Ù«¡Ÿ^pht¥Éå“«Ç×Ý×Ë«µÕÑ»p(¡Ñ¹¡—™—“ƒ‰r:@`h‰\\‰Vr~fXfjd0bjlfD…nlnplZ(ÁÁlphfdXX`hR0@ñÁXt`Áh™Tn‰rnhhTLNn…ƒ…ƒnH@XXP¹Txrvpjjllntl\hHÁllrrtnjptp`DP|dfb`^ZVTTTVPNV^\^^^bf^X^dbj‡¡­¯­­£‰ùåé‹¡§¡…™¡Éщv«XY…VN§¥™‡…©xÁlz|||tl\‘©½ÁÁb^^t‰‹Ý‰½×Û˃Á¡ÁÓÕñ½ÓÉÑÁÇÄååäååäãâàÝÙÙÛßáââããääåæææ†çæçææåååæææççææçèèèééèèè„ç‚æ„äãâááââàßßÞÞÝÝÜÜÝÛÛÛÚÚÚØÕà‡áâãááâãä„æ€çäãääãæåãáßßÞÝÞÝßáãææêêëììæ´»xhn:4@T‰¥±p…¯¿ËÇ¿ŸËɳl@ÁnTV^HFD>D@@LX6.0,@@*@2B4(0‰>:0>P4dPDDD8,ÁÁ8@2.0,.24"0á©.D4L<Ád2L€\>2($(,PL@<0$0<>JR^v‹‹~`^Ñ͹^hhdfd|‘¹¹\Pr450.//-ZVL@F`@`Á\ZRNHL8NF8H8Ldd`020JbbRp¡¯»¯T P…§§t©¡©«±´ÝéðñïéåâßÚÓÑ×Þâæéèç‰è éèèçèèççææç‡èé‡ê‚é„èææççæåäãããáààÞÞÝÝÜÜÝÛÛÛÚÚÚØÖ¯€…†~Œ~}|||~‹„~~„~~}}„ƒ~†}zz~‰|||~„~}{z~~‰‚~‡~|}~~}}~}|~‹‚~¤ƒ~†~}}}~‡€…~}{z}‰†~‡~†}|~~~†Ù€×××Ø؄׀Ø××ÙÚÚÞÞÞßßàßßßÞáßÞÜÚÙØØØÙÝßáâäáááââá™Ó×ÓÕÉ‹…©‰pµ|¡ÍÅ¿±¡ÃÇù©‘¡x‘»·ËÍÕ˹™—‹Í½½­Ñ—‡•­¯ù¡£Ñ±Ñý›£§ù™ÕŸ©¹¯«‘Ñ¡‘›Ÿ³»½µ±ƒ¡Á™Å¥&Ýå¹Á‰õ£«½Ã¥Ÿ™‰Ñ•‘»½Å¿½ƒ™Áщ¹¹“ÃÅ¿­„¹€»­½¯Í±‰‹£©±ÁÅ»³£«‡‘ƒ“Ÿ¥­§£§¯±³¯§¥«³¹»»±¯¯£—¥¥­¹ÃËÍϱõÕµ­½µÅÉÑ¿…¥ñ‘ñå»é„‰‰ŠˆÿëãÃ¥‰©±ñ‘›­½Á³³ÁÉÇ¥éÅ©½é‰“—©½·¥“õ…§Ûñ¹­h‰³±HP…åÁ¿ÉÑÃóñïîíììëêçãáãæéêëéæçççè„é êëéééêééè…é"ëêéêëëëìííëëëéééëééèçèçææåäääããáàß…ÝÛÛÛÚÙÙ×Ñ ÞÞÞßßáâââãââã…ä€ææçæææåãáßÝÜÛÚÙÛÜáâäæçèèèééã˜Á±§Ÿ“\`¹±ÁұßÙÝÍ¥±ÉÉ8@¡Á…‰§›“““…nrZX.:L@`LBBF6*0``8B60:888:(0Áp©&($`PÁ`¥6LR+@22**.<4LJRLL2`@X\PPFT@B:8:HJRXFXHH@H*46DRZXPfx££j™‰¡80R‡“—•¤ÞêñòíèããáÝÖ Ó×Üàåèæäåææç…èéèèæçè…æèèéèèèéééêëëêêéèèèéèèææèéççç…åâàß…ÝÛÛÛÚÙÙ×ׯ€†~}}}~~‹}}||~‹…~‡~~}}~~~~†|{{~‰|z}~„~}{z~~‰‚~‡}{|~~}}~}|~‹‚~¢…~‡~}}}~…€†~}|}~Š…~ˆ~…~}}}}†Ù€€××ØØÙØØÙÙÙØØÙÚÚÞÞÞßßàßßßÞáßÞÜÛÚÚÙÙÚÝÞàââßßàááØï­ËËÏש±pph©p¿¿³‘‰©±µ‰á‰Á­µ·¹ÏËÑ¿éí¹•©Á¹å•¡—¡µ¥ƒõ“ŸÍ±Ñ›£¥ƒ½éŸ©¯¯©ÁÁ¡…™£±½¿€µ«ƒ¡¡±Åéù™ñ…ñ`Á…‡¥­·½Å©£‘é¥ùµ·ÁÁ­¥Ñ቉¹Ù£¿Å¿«½»¹»½¯¿³Ý‰¡•£¥³ÅË»©±«‘…™£¡¥£¡¡©­¯³¯­«©©­ÁÙßѯ¡«§£§¿ÏÙٵ齡©ƒ±½ÃÏÑÁ¥Ý™ÑŸÍñÿUÿùáɹ›ƒÅÁ¡©ƒ¯ÁÓѽ±½É͵‡Ýµ½ñ—Ÿ§¹½·¥ýÝí±Ï¿—ÁµÉDZ@•ãËŸ¿Ë¤öíñîíìëëêèåããåçèèçææçççèéééêë…éèçè‡é êëëëìííëëëéééëééèçççææåääããâáàßÞ„ÝÜÛÛÚÚÚ×Ñ€ÞÞßßàâãããäâãääåäääææçæææåãâáßÞÜÛÜÝÝàáãåæææçççÖ盫§¥¥~`±¡©¹‰Õ‰Ùß×±™©¿½Å`Á¡¹¥¥›¡•“ƒ\™¡¥XLhp•`d`nj^F|Vbdd8™bnjhF`hjprjV0``hnllnfb€hjV0¡½‰`¥RpÁxvjt|~zhT|Lhd‡‰‹‰vXPáhXH‰Ùv…xxtrtvtpn•X±xtzxztxxtrbBD\ZhnbZXVRRV\^\Z`bbhz›©™‡‘™¥±³µ³­£¡‹µ™™¡¥v¥¡££‰É…¡É‰§U§`¡¡Ÿ™xn­ÙÉ©pd‡ƒvrv|‡ƒnµ™±ZZ^^lz…ƒñéõ¥«§é¹ÇÍñ¡X±É›©±“åãêèççæååãáàÞÞàáàáââããääåææççææåææäääååå„æçççèéêêèèèæææçææ„ä ãâáââááàààßÞ„ÝÜÛÛÚÚÚ×Ôàààááâãããäâãääå…ç€æäääãäãáàßáßÛÛÙÛÜÞàáèèéééÓÙƒ‰||zR$P‘‘l±ÓÛÙ·‘£—|8@H|~vfRXRPD$@D4D\\62*<>,06>&$8XD>.:,@`HBDF6(0`Á4>66><::<(0`¥P(0p4@`ÁPR:DF€>6<6.D :LLTN@ @\LH`NF:<08:<@DB208 LTJ8BDFB46.68X4@DBF6(00áh<86BB><:H0`™¥DHh>04Á`X™@<>+FJBD:D 0BJLRL*0‘‘hXPhXD<:4:668@D22P0xZH82($.6,P80 @xh•`TPLHB64>HB:8lh42264>JPNFxJh\t›•ÁËÁÁ±›xFX‹ÀãèçëëéêçæàÜÜÞàååäâããääåæçèééèèæçææå…æçèèèéééêëëêêéèèèéèèææˆçæåãáàßßÞ…ÝÛÚÛØÕ®€‡~…}ƒ~‡ƒ~Šˆ~† ~~~~}}…~‡||{}ˆ~|{}~~}~~z{}~ˆƒ~†}||}~}}~~}}~Šƒ~’ƒ€Ž…~ˆƒ~‰~~}||}~~‚~Š‚~ˆ ~}~~Ø€ØØÙÙÙ„×€ØÙÚÚÜÜÞÞÞßßàßßßÞààßÞÞÞÜÝÝÞÜÝÝÞÞÛÛÝÝÝÑÅ‹³»ËÓŸ±Ñ¡©jpÝv•‹Õá‹•©¿ÇÃÅÃ鹕¥ñõɉ՗¯µ±õ¹µÍ‹‘­±……›£Ÿ—™Ÿ£©©­­•‰‘`ñ‡‘¯¹¹­¡…Ñ¡ùÉ™é€Ù‘Å`XÕ›¥§£›¡½‹™£§µ‹áñxÙñù­…«½¿½·»±«¯±³½¹éÉñ¡›­¹ÙÓÁ»³ýɽ§§—“••‹‹—©ÅÝíóû‡‹ˆ‡ˆÿßѵ¥¡Ÿ‡ñ£ÉßÛ¿É­½ñ™±½ËÝãݵñ¹µ‘Óïùù÷ëÉ—íÙ¥±‰Láʼn©·ËÝÍ·³¯­›‹…‰™§§£§³¹½³§•—§·»»Ï‚†¹v³ã·õ¡ÍËóñìîíêèèæãâââäääãããääååçéëëë…éçææççç„éêëëëìííëëëéééëééèçç„æåã†áßßßÞ„ÝÛÚÛØÒ€ßßàààáâââããääææäääææçæææåääâáááàààâààááâââää俧x…¯«±µ¥h¡©©¹á¹­…õÇŸÉõ›¡£«›™›“nP@h¹¹t,H©fnlndX``bXD8lfnjbZV\dllrp\ 0¡ávrtpnj€jhX@‘éÅx±­ZT|`‰á~xz‰‰h|`lv‰‹‡\pÑ‘¹™™™‰‡‰‹‹‡|txzxnvh¹‰Åƒ“Ÿ—•—‡Ñ‘lz|nntpdbfp£³ÉßwyvttÓ³§¡¥¯µ›ñ‹£§¥j¥­½ñ•¥©µ±«³ŸÕ­±|¡¡¡ŸD—…t͵x`¹¥r‡‹•™—~lbdhlpljjptljr|ƒƒ‡‰ƒ‹Ÿ§µÏ~…¿“½ÏÃÁ|§»åìïïíêèèæãâ…áßßà„á&ãæçççææåååãããäääååææçççèéêêèèèæææçææää†ãä„ãááßßßÞ„ÝÛÚÛØÕááâââáâââããääææ…çæäääãÞÞÞÜÜßßÛØØÚÛÜÜ݅倶—jv£‡‰…`\4@H`p™‰|‰íµ—Ñí…|~vfb^`F 8…P$$…@>04.< 4H6 .4>8<:8( 0Á­Dp<44``@•PBDVhDJ@L,LJJPTJ(@pÁ±`R\LB€@F>628:D048@`±lRTj~xnppf¡ldTPLDLPJ<8BRn…•Ÿ©_fckn­ƒ£«§Ÿ~­l|vhL8x¡©Ñ…‰|~thRp•™Thb^^XRF8dT4p…ZXTNNRN@42868@JPPH@8:BNTPLHDP^Zv›¯kt¯|››~^H\™ØçåéëîëëèáÞÞÞàäåã„âãäåçéééèèæææåää…æçèèéééêëëêêéèèèéèèææŠçäááßßßÞ„ÝÛÚÛØÔ®€ˆ‚~†} ~~~~Š‰~…„~~}~}|{}‰||}~~}~~{{}~ˆƒ~†}|„}~}}~Šƒ~…€ˆ~†„~ˆƒ~‰~~~}}}~¢‚€†~Ø€…Ù€ØØØÙÚÚÛÛÜÜÞÞÞßßàßßßÞááàßÞÞÞÝÞÞÝÝÝÞÞÝÝÞÞÞËɇ饿ËÍ¿›å¡é±™Á¹l©©Åtýx“©±Ã»¿¿»Ÿ¡‘­ùƒù™‰íŸ­±¯Á±¹Ñ…››±™ùƒ™£Ÿ›©§§­¯«µ¥¹Á¡ñ‰‘¡±³­¥›±ñ€‘½™™ƒ—¡ù ‰Ù‹¡»ÅÛãÍ¥‘Ÿ§»Å¹¥ÙáÁ‰ñ©»»»¿Á¹­©¯©­³©‡ù·ÙãûŽ—‡ñçïû…‹ýéÙÏËÇÏ킇‰‰ŒŠ‹‰…ýÿé×±¡ŸŸ‰Ñ‰ÁÛÙÝÃÝÝ奵ËÙãß¿‡½¹•ÓãùÿýóßÙDѽ“åდ—¡­¹Çǽ½³¥“ƒ‡¥¯±©¡§±µ·½ÍËÁÁÁÍÛá…”‰¿ŸÅËŸ¥É¤ðóïíííìèçäâáâãää„ãäååçéêêëêêêéèèççç„èéêêëëììííìëëéééêééèè…çæääãããâáàßààÞÞÝÞÜÜÛÙÓ‡à áâââãääåääå†æåååã„âáâ†á€ââãââ¹™lñ«¹¿·©±|ѹ±ÑÉÉÍ՟Õ푥©Ÿ•“•f48pÁ\,L±jpllNdTh‘`^H8XÉdlhb^^``jjpn`8`á|rtrljhhR0±•Í‰hVZX`ÁÉñ…“­·É푇ƒ›•jT‘áld€Ñ“ƒ›‰ƒxx~zvƒ‰pÕ­ÍÕé}‚vnnß×ÛãuwrÓËÍÍÉÅÅÑoy}}|{xutåt×ñ•—§³•Í|¡«¥¥‘pÕáõ‘¡¥¯­§«™l­©x¡Ÿ§¥PŸ¥©¥§›|ÉÅr‡•“‰zhbddjr~ƒ…vrvƒ‹¡§¡ŸŸ³ÃÓ‹‡×¿ÙÍ­l…¥•âíïïïëéèçäâ„à -áàßßàáááãæ…çææääããäååæææççèééêëëéèèæææçææå†äåååääãâáàßààÞÞÝÞÜÜÛÙÖ„á âááââããäååæ…çå„ä ßßÞÞÝÞÝÜÚÚÛ„Ü€ááãå䱇`á•™“ƒ|`pD.,0…@B<<$4@0hF>26<:<:86* |±`HBBDD@0< 0@*`>8:@:88>BPB4 XD68<86684‘Á½dtnl|³ËÁ¿É鉈Ž‚rlßáuwvnm[‰‘v^±€jfhrv‹¥XW^cÉ]dv}…ƒ†ƒ‚‚wnméÝÙu|pfßç|yzvprtmihgËáÕ—vn…¥‡¥Zzxb^dXRÑé‡xvxvndFpx^v\^\`3nprxxrfdnrnd\ZNHBJD@@TXDbdVH2.6BBLlz|vt‘§d|‚zµµÓ¥^``fl§½àïöäìòêçåâààá„âááâââåçèèéêêêç„æä„ãäåäååçææçæçèèææèèˆæèééèçåãâááàààßÝÝÚÙØ×Ó®€~~ˆ„~ }}~~~~‹…~~~……~~}}~Œ}||}‰}}~~~‹‡€‚†€…~ˆ„€Ž€ƒ…€ƒ€Š~ˆ‚~‰‚~†€•‚~’„€Š×€‡Ö×ÙÚ„ÛƒÝˆÞ -âááààßßßÞÞ…Ý€ÞßßßÞ³¯½Ñ½ÏÑÓ¿«ƒåɱ‰pdnnƒz¡·ÅËÁ½µ­ý…ñÙõ¡¹—¡©­›Ý¹ÍÉí‹™¡Õ™Áé“›Ÿ¡¥­³§é‘¡¡§ÇÁ±¥¡›Ý͇“ÉŠŠ‹wo×ßu‡‘ ª±ª“÷Ûr…£²¶¸¹±¤–Œ“€¡¦ž‘’“™š™›¢¨¯¸¶ª‰‡†ˆ‘”Š……†„ˆ•¡£–„õÙr‚‰˜š˜‘‡÷‚…ûóçÝÏ»³±·«‰‘ÁãëñóÛ¡ùÑ¡³¿ÓÙÛÙ£ÁÁ™ÕÝíõƒ„„†„ûïÛÍŽ¯§§¥­¹½ÉÏÁ§íÑퟱ±«£¡«¯µËéçéáÝó„‘™˜ó¥Ï…é“•­ÁÙ¸ùùôïðîêéçäââ„ãâáááâãåçééêëëëêééèç…èééèèéêêëìëééèèèŠéçæåååääãâáááàßßßÝÝÜÙÔ -ÝÝÝÜÜÝÝÞàá„â…ä‡å äääããââáá…à€áââàà¦v¥í©Åɽ³©›•‡íÙÁ¥‘­«…t±µ¯—‘‰~™,Xh­¹:@…nnppXLLTp©dX2<™µfb`d`^^dfhh\X0¡xhpvld^\^Z©ÑµÛ†‹„„†„‚óñ…•—›œ’‚y÷ñƒŒ”’——˜–‹Œ‰Ž€’„yzƒˆŽ˜œ ¥¢š‡Š‹‰Œ…xtx|vu~ˆ…wlÙã~ŒŠƒztutpåyztnÕÑÍÍÁ¡£©µ«ƒ‡©»³³·«å凟ŸŸ£¡››x•™z©£§§RSUUTV¯­«§¡—‘‹………‡‡v½©½z‹‡~trvƒ—·ËÍ¿6ÁÛx‰’“÷¹ß‰ó™“•·«ïíññîìêéçäàßßßàßßÞÞÞßàâäåæçèèèçæååäå„æ çèææçèèèêèèç…æˆåææåååääãâáááàßßßÝÝÜÙÖ ßßßÞÞßßàáãã…åæççç…äààß„ÞÝÜÜ…Û€ÜÞáäã¤`¥µ››™›…vrpjű¡xÕ‘Ÿ|rnx~ƒ‰rdXXXL DphdH:@D4@,<@*Pt@88@:88<>B8,0`0626:0*&&6p¡‹©á‚‚urortãå„–—’Ž“†tróï}z~vvysqvƒ€‡‚~tv~ƒ†…„‡‹Ž•””~„‰‰„~sostlfktrgbÛñ‡’Œ{nhd``ÉhifeÏÙÏ›z‡™¥«—jjƒnjtrZ½Ív‡xnrpjhN`pXvd^^236546lljntvhZVJFDBNNPJXLlZdZH2,8>@Nn~"§^s„†ß¡ÇzÅnnltv‡Ùëøèëñêéçäááâââá„àáâãææçèéêêéçæææä„ãääãããåååçååæåååçèˆæçèççæåäãâáááàßßÝÚÙØ×Ó®€~~~Š†~Ž ~~}~~~~~……~~}}~Œ}|{}‰~~‡€‚‰€‚¯€‚‰€„€“‚~‰‚~…†€‘ƒ~„€€‡×€ˆÖØÙ„ÛÝÜÝÝ݆ޅáààßßß…Þ€ßàáàà”£Ù|™É•¿ÇË¿¹³©£‡~½|­`V‰©á™§ÅÉÏù­£ñ…Ù•ÙåùÁ飩¯Å±ÍÝý‰¯©±É‰•—•‘•›§¥‘ùÑá¡ñ¹­©­µÁÕÑÅÁÅn|‡—£›Œ}ÝÛj…™¨¸¹°‘éÕËn†¥¶º¾¾À»˜Œ˜€­º±—Ž‰†Ž“™š¡®´½¾µ”ƒ{Šˆ‡ˆ–™ž¥®®›Œ÷Ï厙––˜š”‚×ÝŒŒ‰óÏËÝåßÕ͹‰‹µÙçïóù祩͛»½ÉÕÙÙ»íчÇÝã‰‰ŽŒ‰…ýïå×Å«¡™¡¯·¿ÉÁ©á¹Ñ™­³µ©›••§Ííéåç1ëãý”––×—ñ†ŒÓ•›¡·ÃòüöóôîìëéæäåãâáááßÞßàâäæçèéëííë„é‡è çååçèêëëéèçè‹éèç„æåäããââáàßßÝÝÜÙÔ -ÝÝÜÜÜÝÝÝßà„âäã„ä…å‡äã‡â€ããäâáŠp±±¹ý«Å»·­¯¯¯­—‘‘á©Å“±‘៳»¯¡™t0Xl½¡hd¹vpprJ0DT…¹`\@6‘‘d`^f`\\djlpf©Á™Ùz~xzƒ›µÉÕç÷‚“˜˜•‘Šéçz—•˜—“~ãáñ‚Š‹‘—–‘†…‹˜€›™˜„„…‰’’’—ž ž’…~‚†wv|‰†ƒ†„umÛÑñ’–†smilkÕávuplûËÑÉÅ··«‡‡£·µ·½»­‰±Ý—©Ÿ——‰`‘¡£¥QRTVVWWV«§¥¥“‡zx|ƒzÁµ¹xƒ~vllp~¿ÏÑÏ5Õ×õ“™å£õˆŽÛ››““›}äîëôôíìëéæâáàßÞÞÝÜÚÛÜßáããäæèéêçææåå…æçæåääæççêéçæææèçæˆåæç„æåäããââáàßßÝÝÜÙÖ‡Þßàâã‡åæç…ãààßß߄އ݀ßâåä‹^­µÑ‡Ÿ§“““ƒƒÕ™Á~¡™Õ…~ƒ~tfVPPT0P‰d ,…F8:B$ @. HdB8:H622:>FH@H ¡HLNVV\ht§½×튋‡„zrmÓÛ„—•Š‡‰…uáñû|vkloqusmx‹€•…‡ŽˆŠŠ‰ˆ‡“””Žƒx{‚‰{oelw}tkggn^]ÍÓ÷“Žr\VRSV³¿bacb»³——½¿­£•tn~ƒrrxvvf™½ƒnjlddZhX>bhbb24533456ffrrbLB86<>DHPLl`XJZVP:,02<@$<,*0\@8244D`‡Ÿ¥«6±­É{ˆˆµ‹çvu»‘“vƒp‰£èûðìîîìêæääãàßÞÝÜÛÛÜßáääåæéëëêéèèæå…ãâàÞÞÜÚÜÝÝÝßßßáåèˆæåäãããåæåääãâáààÞÚÙØ×Ó®€„~~~~}}~‰~}}~~~~†„~…}}~Œ„~†ƒ€„ˆ€ƒ‡€„‰€•€‚Ž€‚‡€„ƒ€‘€~~‰‚~„Š€ƒ~‘€€€€€‡Ö€‡Ö×ØÙ„ÛÜÜÜÝÝÝßßßÞÞààááâáààßà„â€ááãæåჃ©•p…|«·¯±­§§™‹…rÁŵdpÁÍ™«ÅÁÇÉ»§“ÁÉ¡Ù­Õù‹™««¯ƒµ©½áù—¯‘‰±…“‘é囵¿©«Ã×ßßëíñùëw„ŒŽé¿·¯Çx©º¶ª†©|xÝœªµ·¨ÿ·™›Ó¦¶¶¹¿»©ï߀Š¤µ¬˜‚}ƒƒ‰•š¥§¯ºÁ½‡çÙý††ùû ª®«“‡é××åý‘–•ýÉÅ჉ŒË¿ÉÇÅÅ»‡§ËÙßçù¿¹±í¡µ¹ÁËÕÛ»ñÁÓ刉†‡‰‹‡†‡óéÕÅ©©«§£§—͵£§§¥—‰•¯ÇÝáKÓÑÏß÷|Û‡ÑÓóש™¡™¯³»žõ÷óîñðîíêéèåáààßÞÝÝÞáãåæçéêììëëéèèççèèèééçäâßáäåãåççæçç„éèççç„èç„æ ååäãáàààÞÝÝÚÔ -ÞÞÝÝÝÞÞßàá„âãããäää…ã„äåäääãã‡å€æåä{~v͵µÍ•­«­±³±±©›™‘ùíõ¥™™É«³§¥Ÿrx``™•¥‘ZtxvntH04H‘ÅbVZLX`fbdd^¹Õ‹—§³Éáéãçóùûññ}„ˆ‡ïÙÝ×ñ“˜•…}k¥›“Ù‰‡ˆŠƒÝÇÅÇé„x„ˆ‹ƒkËï‹’€††‡††‰‹Ž‘‘’ŒŠ†|tnÓÕëtqqßç}ƒ|yqrvÝÑÙåó}wrséÝÙÛpnhb¹Åǵ­Ÿ•ƒ…±¯µ³«Z›½Áñ‘‹‘‘“|V…f™OPQQSVXWVXV«­©¡‰xxtplvtűµprjptpnjr‹©ÇÕÑÑÓ5ãû…ý¥éÓ÷ïí§•‘™ŒâïòïñîíëéæäâÞÜÜÜÛÚÚÛÝàáâãåçééèçæåääå„æåäââàààâääååæçæååæååæåææçèèç„æ ååäãáàààÞÝÝÚÖ ââáààâââãääåå‡æä„ã€ààááâáààßàâãããâáäéåßwnt͉r•‘•›Ÿ—‰ñÙÝ•x™©xrzrldRH>48pthL6LBH<`l`t¥«ÁÏÕß×åíóûû‚„†qɽÓÝóƒƒ~ywjU‡‰›á‚ncikÀ¿ÍÇÕl^TY[bdW±×}ytvtt{}{xwxy~}zvi`jÛÙÇZSZÃÉmojcfVV_¿³µ»½`]Z[¹«©¯]\TM‰©³›ƒrnnt~…z|n\3h™ÁpbV\Z\dV6@8TXX/0-,.253355jf\T<6:846JJtT\DD@@L:$0((>4"@\DdDRdt•ÁÉÏËÏãx{u{y}ý……‚uѱ¹¿¿ÏknlnaQxtƒÓi\ZZ£€›™‹¥^TRJKQR=½óxmztt|ƒ~wvupjkpsj_jßÏÇ·§©Ÿ‹©`c\\OK¥··¯­¹feddaŸ…‰­^TN|~—™‰xjjtx…‹…~p\0`¹ldVVZ\V^J.:JPT`.-**/2026hdjbZD8D>6.l…‰p1X8>:<::26FVf¡¯±·¿Å»¯“鑱ƒ«‘znnz£´äôïóïïîëêèåáßÝ…Û+ÝáâäåæèêêééçåäâàáââáßÞÙÓÕÔÍÍØÖ×ÚÛÝãåæèèçæåæ…è„æ ååãàÞÞÜÜÛÚÚ×Ô®€‚…~‹„~}~Š~}}}~~~†…~…}}~~‹‡€„€††€„…€…ˆ€ƒ”€‰†€†…€„ƒ€€~~~‰€‹…~•}~~‰Õ€„ÖÕÖÖ×ØØ…Û…Ý‚á‡ß€ááàááãããåäãæÝçæçŽ~Í‘ñ¡t͇•™Ÿ›“‹…~pf\X|`Ù·½½ÏÉÅÏÅ¡åù‰¡¡ÕƒŸ©¡¯­©‰•é—™£¡Ýñ¡©åå¡Åíù„†õ½•‘ᚤ§¤œ‘åÓv•Šß¥‘ƒ‘³û•§«’¯Ñ½µ‡–¤¨Ébp³€ù“¤ ¢¢ãŸÑš¡µŸïÙñ튕‘÷‚ž°­—é¿ÃíõñéÕÏÓñŽœ¡’ïËÓÓÉᔥ«ª¢ŒÓ§Õ„‡ûßÅ­Ÿ›£›‡‰£ÃÏÕãóõ»ÙÍݳÁ¿ÉÓÝáÕ¿¿ÅÏåý…ƒ„…‰‰ˆ……‚ÿýéÕ»­³±›Åé¡ù…‡‰ñ9탗¡¥µ··³ËÕ«nn|d¹x…“©Ÿ›¡¡©–íñóòòòðîíëéåâßÝÜÜÝÞßâãäæéé„ê èåããäåççèèæâÞÞÚØÛáåçèæçæåèééèæåæ…èæççææååäãâààßÝÞÚÔßßßÞÝßßàààáááââ…ä ââáááâããã…ä€æåæçææêáéâ₇…她±‘푧©¯«£Ÿ™™…¹ý¹Á·»³¯£“~½‰HX`l±^jttvprJ(((…ZRTZÑÙ­íñŸ»ÕûŠƒÝûÉ÷ŠŠ‹‰‰…uçõˆ‡ƒÝ·¯µÓçõxqna‘ùù¹{~„|h¡‘—Çëqqnl€kb—•§Ñ„Šˆyéçãó‚…‡‰~ápvyxvÇ»×çÝÓͽµ»Ïqtmke¯§¿Ë¿Ëy~}|r­xŸgfÁ»·“››“‘¯«±±­±•ÍÑÙ~‹‘“““‡z|‰“™KMOQVZZZ[Zµ¹«¥•‹‡r‰‘|Ínrrh­™Xprv>ƒ•©µ¿»Óݹ‹›™ñ¹É·±±¥›—‘ŒçïôðïîíëêèæáßÜÙØØÙÚÜßßáãåæçççèæãááâä…åãáßÐÇÈÑÖ×ÙÚÜßâäåæææåæ…èæççææååäãâààßÝÞÚׄäãääå…æ‚è‰åä„á€âãáâãäæçèççéãîàÚvdH‘plÅ~“›•“‘…zx¹pÑ™‘zƒnjZDH 00Ph:6\8P2>>:BTl‰Ÿ¯«Ãͧz‰›•ñÑÙ»«•zdbbjvÕçïðñðîíìéèäáÝÛÚÚÛÛÝááâåæ„èæåâàßÞà„âßÚÖÔÄ´¶¿ËÑÔÖØàãåçèçæåæ…èæççææåãàßÞÝÝÛÚÚ×Õ®€~~}}~~ƒ~‰~„}‚~ˆ„~„~|}~~~„‚€…‡€‚„€‡„€~~…€††€„„€„…€…€‹…€††€€€“ƒ~Š€‰~}~~„‚~‘~}}~ˆÕ€ØØ××Öׄ؅ۅ܀ßßßÞÞßÞÞÞÝÞÞßáâããåååæáâîÝÝ鹉‰¡p\•Ílpvvrnjhbb¡ƒ·»ÅÑËÇÏÕÅá‘™Áµõ¡«­­«£‡­‰‘å‘™™‘£½×»­Íãù…‹ƒÁ›—㎟­µ´®¦åµÁk”ŠÕ§›¡å‹©˜Õv™á€‹£Ž¿ñ^xµã‡—Ÿœ–Ë™|±ˆœ˜ç»Ã»ã‡’–‚Í厠¨”ݧ©ÑëûûñóÛ犙—’÷Á·½µ¹ù˜¢¢Ÿš…óÕïïéãÛ™¡—‡—»ËÑ×ççÉ‹ùù—³ÃÇÍ×áãß×ËÍÙëû‚ýÿƒ„„ƒ‚ƒƒ†…éÍ»±·Á¹få‘ÑõŸ—™å±É‰‹‘•—Ÿ±±Ÿ—Ó秙~Û¹|©v¡Ÿ¯±£—£­×ãôôðòòñðîíëèãàÝÚÚÝÞàããåæçééèèèæäââäæèéèçæâÞßÌÃÊÙââãââáàãæèçæåæ…èæçèèçææäãâááßßÞÛÔáàààßàààáâáááââ…ãáááàà„â€áâââäæåæçççëêëçÉ»áÙ¹P‰¡¹õƒ…‰•™“éÉŸ¹»¿½±¯£r•‘`p`pÁbdpztnjP404…ZRXVb›ÃÛÓÕåïó‚…|l»·Ãë„…ˆ††tÍÑ킇…z͵ÃËÕåtmkb›|‘±ã{‚wdù‰—Å€Ûormhi^—›¯½ovsnÑÉÁÍ烃sÇ×wxwwíÅÕÙÓ×ÓŽÅjmifd±—¥µ«£Étsljk\~x§Ç½¹³—~£©‘‰‘§§©«©«™pÕá‹‘‘‡…ƒƒ“J™¡QTWXXXZ_`©›—‡“•±8™½rx…|±]pnx‡‹•©³¯§ã÷»½ëÍ“Ù“¿»Á½©‘“™½ÚïóîîîíìëêèäàÝÙ××ÙÚÝßàáãäååäææäãááâäæçæåææåáÀ­¯¿ÌÐÑÒÕØÝàâäåæåæ…èæçèèçææäãâááßßÞÛØææååäå‡æ‚è‡å€äããáàààßààáâäêëìììéêîæÆÅÉ™X(\l¥Élt‰‰‹‘…‰å¥ƒ¡“‰‹‰tp^@40 @(H|B@BD>L0$(4*P2&.z·ÓËËÛãñxurh§£±ß}vpijfkÁÃßx~wk±—±¿¿Ã^UOGvf|¥ÏbZ`YQ|á~‘«³UWNGHCn¯Éf[a[¥±É¿Ñpro`›­gm]W±©©»¯¡£¡©¥©VRQGG‘‹‘•…x_`VROBZb£xrnn~ƒƒvv~xvjjdJ¹hlZR„P€LLJNZdf2d`.13347:@Cl\TPR\^XH™ZJF@H0……ÑX…z‰‰vr‡‹…x~Ÿ×Ù«„†óËåÿóãåÕÕëóË•‰•—ÎêéïììëëéèèäàÞÜÙÙÜÞàâã„äãâ„áâãåçêêêéêèèæÐÂÀÆÎÑÒÒÒÕØÛÞáãååç…èæçèçççææäããâàßßÛÙæççäää„å<ãããááàßÞÞÞßáãèêìííëññÕ¯j©x‘‘x`xxxX‰xɭჇ‰‘™õz¡£™ƒ‡xpVT(@0„@€JF<<<>*>6.(8(L`™…±ÉtutÍËÍ×ÝáãrllÁ—£¯\XURXX¡“õv›YSU…­d¡]OHC|fn¡‘YJ€YS•…•‘™¥SPGFJPd~Í×e]V£·éÙaY£Ÿ½gaYW¡“™«½³RIO‘‘¡½^RRQxxxvpp…IDA>xn`p‹‰‹LHj|v|xr|xvtxj\H<¹td\RLJLLHFNNNRTTVVVXZ`fl<µñÝ͵µ»ÍÇËÏåíסƒ•·“pÁÍy|{~åÏßÛã±Å¡Õ…Ÿ¥£ŽéùñîïîíììëëèåäáÞÞáãåç„é èäääåæçéêêì„íìëééêèçææçåãàÞÝÜßâæêéé…èæçè…æ ääããßßÞÚדâ€ãáááààÝÝÜÚÙÚÚÛÝàãåèéêììîÔÇ£‰µÁ¡Á±©Á‘‘™‘á™|í—³…›¿½½¹­¥“lpp¡Ñ½lnrrhd^\T©‹³ÅÍÑáãáů³¿ÑÙéõ}q³‹éõ¡­Ímntpm»‘ÑÕ‰ËËÇ™Áݵãha`¯‹…ñ€½·lif«•¡³Ñmljeƒ^Å¡ÛïzqÁ¡‘»ãÝ×ÉÅÏátpmof¹½ÕÕÓkg͹¡›­Ñmni‹›Ÿ£µ[[[\±‹n‰¯ÇÓ—™“‹“¡­­§¥£™t¥h¡¡™—™—‹‡‹‘•——•••™›£©¯³]abb¹«£*›ÕÅ¡‘­l‹‹—£ÃÑÛ‡©×³±áÛ†ŽŒõÝåëñÅù½Õ…¥«¡ƒÙ„ìëêéèèçäáàÞÛÛÞàáãåææåäââàÞßàâåéê„ìêéèåâáàßáäãàÞÜÛÛÝàâãåç…èæçè…æ ääããßßÞÚÖæããä„å€äããááßÞÝÞÝÞáãæèëííõöóл‹j|ppphpXpPPXP@‘±•ñ‘­•x‰«¥¡•~rlfH8ABzpj`p|l``@VTFJRr|^Px£•¡íÙyzy{ãÕÝßéÁñ­¹t‹|×ëêëííëêêêéæäâàÝÝàâãåççéêèáÞÜÙÙÛÝáåçèéééçåäæçäàÝÜÝÜÙ××Ø×ÚÝáåæ†èæçèæææäâáààßÜÛÚ×Õ¬€~†}|…}|}~~Ž~~}}}~‰ƒ~€€~~„…€~~…~~€€€~|~€€€‡„€ ~€€€‹…€…‚€†ƒ€‰„€™~™„€„…~Ž~~„€†ƒ~„Հ؀ÛÛÜÝÝááßßßÝÜÛÙØ××ØÚÜãåçéêïçäç…óÅÁ­©¡x©pH(08pXp¥‹rjr—¯Å÷©¡•áéé©¡¡‘¡¥•›¡›™…õ…£¯§¥·ÏÕÕ±…‹±¿Ï놊û»…Ùjpr·û‡‹Š‡í«Í±±‡Ã¹·ÑÁ™Õ†ˆƒ€½Á¡0¡ý½éã±~lt¹óŠ–Å…Õ«Ù÷‰Œ†å³‘·õ‚ƒó͵Áõ’™—Œ÷ïéñõùóåÇ­™ÏûƒÛ¿Ÿ›§¥›§Åíÿˆ‹ó¯‘Çñídz³­¯©¡§Ïíï÷÷ñëÛŸ¡Á¿ÍÓÛãççóóíéïññíéåçëïóõ÷ùƒŒ’3”’‘…Ý‹ÍÕ͹õ³ÉÇÇÑíûïË·³¯pp…¡³x{yÁ³ÇÓÏ• õÅíÝÔôôðëíí„ëêèæåãááãåæèêêêéèäääæçêííí„ïîíëëëêéèççææåäãáááâæêéé…èæçè…æ ääããßßÞÚבâ€ãääââáááßÞÜÛÚØØÙÛÞäæéëëëìïä‚cÅ«x¹±¹µ‘áÉ¡‰‘™ñ‘¹Ý©³£›«¹µ±¯§Ÿ•ÝáÙ¹¹prxvvnfZTD¡f§ÃÇÃÍÉÉÁ¯›™¥µÏ×Ñá{sÛt僓•¯Õmomc³ÍÁÁ½­•ÍÝ¥Ûhd`‰€ppÑé›Åb§“‰‰‹µÕhifdí»áí|voÇ«•ÇëqmɹÃÕãtpniÉÓáÛÓͽÁ·£‹‰ÁÓea¡‡£¡›§·µXVVŸt…³Ç¹£‘““——“•§»»³«­­¥t¡¥¡¡—“‘•—™™•“••™£¥©©Zbekm2khÃ|µ©­¹Õ‰‘›¥ÅÑÕÅ»ÅÏ‘©¥¹Ç‰Œ…ÑÃÍãݵ‘™ñÇñãŒÍèìðêêéè„çäãâßÞÞßâãåççæåäââàßàãæéë„íìëéèçäãâãåææåäãàÞßàâãåç…èæçè…æ ääããßßÞÚÖæäˆå€äââàÞÞÜÜÝßâèêìîï÷ùõÞxN…T|||…h™X@HP±¹ù饵¡‘™§Ÿzpnl¥©¹©¡…RJJJHHD8,\L•³µ«±­«Ÿf™§³¯«ÅÃga§~fÍnt‡»ZWPP—v•¡©|§f…±D@@^D`‘¹©f‡C€lZTdhh‹§OIF`Jõ»ÏÉabZ¡…¯Å\Z©­­µ½_aXQ›§ÁÉ»§‹~‘“‰±©JK‡vnrƒ“‘~v~x<98jPDV…™‰p`fhrx~ƒ“‡~tnl\@Lxjdfjlj`ZTLLPRPNNPPTZ^`dd7@CJMLK‰Hlt|St…XZNNZ|“‰ƒ“t©¹Áµ|zÁ³ÁÕÕ­‰å¹ßÏ‚ÆäéìéìëêéééèæäãâßßâãäçèèêêèáÞÜÚÛÞáåèéêêééèæåêíéå„ã -âáßÜÛÛÝáåæ†èæçèæææäâáààßÜÛÚ×Õ®€ƒ…~†}|}}~~„}~Š~’€€~…„€~~~„~~€€€~||}~€ˆ €€€~€€€…‚€…„€Ž‚€‹ƒ€˜‚~˜‡€‚…~~~~€€€…~|}~Ö€Ø ÛÛÝÝÝáááßßÞÞÜ…Ú€Ýàãåèêêôéåç•„÷ᯋííù~zÙ¹…ÁÑt‰nx|Ÿ³Ã½¯£—é鱡h¹™«­Ÿ‘‹…ñõݹ»­™½Éǽ|“¡·½½Ç傉†Ë‘ùrr¹÷õ÷÷³¹­‰¥“±©åÑ“Éïë»õ…¡0p‡Ÿ±××½•ýÙé«Û†ÃƒÑ¿ïƒ„íӽ׃‰ˆõÁ•­í˜çÅÓíïõõÛÁ¯›“¯ïÿïÝ­™£¡¡«Áç÷…ŒÇ›é•ë‚ÝË˽±«Ÿ¥Ëõû…ýûï½½±ËÑÙãåéõùïéñóñíåãçéñóõûû„‘–››š’÷“­¹Áí™±»¿½ÃãõKïçáÇ¿‡t‘ѹwÑ—­Á‹¥ƒ‘`PÁ¡É…Ïôñîôêíëëéééêéçæäããäæçéëëêéèääåèéíððïððïïïíìëëêéçç„è -ççæäâäçêéé…èæçè…æ ääããßßÞÚÓ‘â€äääâââááààÞÝÜÛÛÜßáåèéììëîîæ‰hÇÅ«‘éíý…ƒéÅÙé‘©Á‡«³©£«¹³­©¥§£™ùù¹Ñ½xtzxvfT‘…xr©ÃÅ«­ÉÁ¹©“‘•¥·ÉËÉÛwrj¿ƒzýƒ“¹ãÝál^³­±£—ÝÝ•ÉÇ·‘Ål€¡p…pr•¡›‘|ñõù¡³Á^a›víÅáuoiËýã{vqɯ­ÅÝtromÇ»Ë×ÍÉÁ¹³«“ƒ±Ñc¿­‰‹•›•—­±YSRT‘vɵ\¥‘•“‘‹¡¿Ã_[µµ³—…t“£¡Ÿ¡£¡›™›™™›™“‘“•™Ÿ¡£©©ZchloZqs݇¹½¹Ñƒ—£§ÃÑÑËÓÍÓ£µµé͇í©ÅÙ‘µ‘á¡‘Ý£É~Ìïéæôêêèçæææçæäâáßßáâäæçççåäââááâæéëíîîîííëêèèçåå…æ -ååäâáââãåç…èæçè…æ ääããßßÞÚ×æŠåããâà„߀âåèëíïïøúóà~QŸŸ‡p¡±ÅjnÉ¥p™©½á©¿­——§™‰|rtvÍñÑÉx¡THTTVPFpXD\›¥­“¥Ÿ“xr­µ¥•Á½a]V•hnén|Ÿ½­©OI—rh\l‘v|Zt£…v^|<¡ÑZFPZTRF©­¹|‰‹€>CnTÑ™µÉc^U¥££Õmgfµ©›«·]e\[¥Ÿ©Å¹«™‡•›…v§¥H“‘‡pp‹zz…‡E=9:\Dp\Ftfhhhtx“™CXdb~rdd\\pvr…™‘C>=?~j8Djƒn`bhh`VNNVVTNLRRVX\^``6CIJK1MQ›Ph‘™dthbfjp‰—Ÿ­»Åǵ¡¡Çëó•É‘Á©ñ‘¡Í•¥‹Øââåëçêé„è3ççåäãââãåæçééêéæàÝÜÝßãæéììëëêêéçææäãâââãâáàâãáàáãææ…èçæççæææäâáààßÜÛÛ×Ô®€ ~}~~~……~”‚€„~… €€~~}~~~~…~~}}~ˆ~ˆƒ~‰‚€…„€œ€€~~„€~˜‡€~~~• }||}~}||}~×€ -ÝÙÙØ×ØØØÚÚ…Ø…ÚâŠá€ãäåæèèéêêïêå顃íÛ¿±¹©Ÿ“•‘…|||™«Ÿ«Ñ„Œ‰ýëÙÉ¿•x±t­Ñ™Ÿñɉ•õ¹É©•‘“¥›‹~‹·ÍÑů£×û‹‘ñ§…tép«åûû…ƒï³õ¹é¹©›‡í‰£Ç›Ñµ‘ÑÁ‰¥¯ÓßË·—ñ‰¿€×ÙßÕ±•Ý©Å¡íûó³Ýóûã±™³Ýý™˜Žý×ÍÓÝ×ͳÉÙÍ·§»ÕïñÛ·›“›©­¯Áãíùýïә际ÓÓÙÛ¿£¥£•©Ûñ‡†ýñ³ñ•»ÉÏÛßáëóõùùûùñéééåáãëñ÷ÿ‡Œ’—Šñ¥Ùåé…£­³±§¯2ÅÑÓÕåñßÙÓÓÛãÛ¥ ` 0Á00L`‹ÛÅñîîìëëëêééêééçæææååæçéé„ë èææéíðòóööõ„óòðïì†é†è ççæææçèèè„æ„å ææääããáßÝØÑßàá‡â„ãâääåååäã†â€ãããäææèêêêìììóðãg½ÇÃŹ©¡¡Ÿ››™™¡«³¯¯ÏzpýÅÇ¿§“­¹±ÉÍx|éÁlhxÙ¯¿³—•“•‘‹‰›³¿ÁŵËéñrqË…õƒ±Ýíçmg¿™Ý•ùñ±‹‡vá…£¡ƒ½­Ù±…t“••———ƒ€ñ©©±³±¡ƒÝ©Í§ÉÁ½¥—¯ÝßÓµ‘³ÇÏjpoѹ©»Åµ£¥³¹§‹‘©»½¿³™…‡‹‘¡³±««¥•té©h•“‘•‘‹‘‹™ÁËba]X¯±‰Áƒ£©Ÿ¥¥¡™™›™““™››¡©¯µ_egkpp×±ÍÝ‹Ÿ›5¡¥¥±¹ÃÏéùñõõóõ÷ùá`0Á``x‘…£ÛÀëèéëëéèçææçæåäãããááããåæ„ç åääããçêìíîî„ìëéˆè†æ ååæææçèèè„æ„å ææääãâßßßÜ؈æ‚è„ãâääåååçç†å„çéêëñññóóùüõß…O•„Ÿd…zt‘ƒv~‰“£¯±¯£¡¯fgc¥¯¹¯‰p™é¹áÝh``\¥HT`ÁŸ¯›…zv~jtzx…¿µ§™«ÉË\\£pltál™··ŸPP™t•X±Á™z^T™j‹lL\xñá|^nT…J€¡hƒ‡ƒ|xnfrÑ¡…¯•~t“±­±™zz“SYY¥‹‡—§Ÿ~Ÿ‹rr™‡ƒzrxx|pdj|thd^T<>~|Vln…jTbjd`\RTZ\ZTTZXXX^d^brDIJKMP›^l‘±j|lf%lnr~‰—§ÁÙÓÏÉÓáñõåÁ‘Á‘‘™…ŸÏ¸âàäæçèê…è‚æ†äåæç„éäßÝÝßâåæêíìëëêëéççæ„äãáßßßáããââäææçèèè„æ„å äâáààßÜÛÚ×Ó®€–ƒ€‡~}~~~„†~”‚€„~… €€~~}}~~„~~~}}~ˆ~‰ƒ~ƒ€¡‚}„€~™†€~~~” ~|{}|z||}~×€ØØ×ÔÕ…ØŠÚâáßàá„ã€äääåæçèèéêêëéæÚ‹ýåÝÉÅÁ±™Ÿ“‘‡~|~…•·Óé÷ž ¤£–ùỉv©x|©|­¯™~pɹ©Ñ‘­©™“¡¥Ÿ—‘‰‹¡ÁÍÕ·‡~Åñ†Žç¯vÕÉ‹Çëé㧅Օу—‰ƒ“£¹‡©ÉpÙõ£»ÓÙÏÁ«ù€|±ÑËÓ½›‡‡~½©å»ÕÅpƒÅóë«“·ÙñŠ…÷éɯ©­«—Ñõùíͱ»ËÓɳ›•£¯·¿ÕáëõéÓ‘É©ù»ÅÑ×磵Ñï‚ûïÏ“…©ÅÇÍÑ×ßéïõ÷ùù÷ëåãÛÏÉ×åíóù„‡ŠŠÉƒéõ‰¡­¯­¡¥¯µµ¿ã÷÷zvtéçß½0Á„`- pt¤èìîíëêëëêééêéèçæææååæçééëëêéèèéëîðóõôôó„ñïîíë†é†è‚ç„æççæææˆå äããâàßÝ×Ð -ßààââààááâ‡ä€åååäâááâäääææåæçèéêêêììíòïÖ}Ë¿ÅÃÅû­§§››Ÿ¡Ÿ­·¿Í×Ûãz…„}tÑÇ»™“Í‘½Ùƒ§¥‹……õÑÑù£¿»­Ÿ¥¡•‡‡‘«¹½Á¯‹—Ñëon¿“‡õñ“ÇßÙkg³‰vÁ‘Ù™|‡|x‹¡Ÿv¥•ñ¹Ùí›—„“€í…©µµ³£“‹‹ƒÅµõ³»­‡½Õe§‹µÇÅceeÍ¿«¡Ÿ“…™¿É½¥—¡¯±«•…~‰‘™«­©§¥tÁÉÙ‰‰‹‘ƒ—“‘§·»^][¯³£vl£Ÿ•—£¡Ÿ›››™Ÿ£¡—•¥¯±·afhnop¯pÑõŸŸ&¡§©«­³µÃéÿý‚‚‚ÿÿûõ‘Á```péÝ‘¡¥åæèéêêéé…ç æåãããââããåæçççæææçççéíîïïïííììëéˆè†æ åååæææççæææˆå äããáßßßÜØäååææå„æ‡äåååç„å€ççèééèéëëìñññóóõùõÓt­£©­±£“xzz|…•Ÿ©¹ÃÃÅÉÉjnmpjc½¿³ƒx¹‘Áí›f^d͵Åí·µ£‘‡xfnx~±¥›ƒ`t©½VU|tvÝÉ~§«—LQ›znth¡l`XTh~f@D`É™x±±p\PN€NRP\~ƒ|ldbxzµ…±“™‹h`l‹N…\b…‰@DH—|rtrjh‘£™…zp~|xzxpldfd^\jh^XZ^F`™`\TTNPdtrfvƒ|;@HX @±©f^PHPXT™\ƒ™—…pnrƒ‰|lxƒd`hr‰HAtn~zvh`bvzv`^df^‘KLJIxztfjll^TZ`ZXdh`Z\jhR‘V\ZVTPT^ntjbhjfjvpjjRldhTRX^XTTZ\^^ZX\X:PHLTZhxKJMMP™nµfz……|……¥ÍÛávwx{zƒ½±¡Ááá±Õ‰±’ÖäÞßâåæåå…ã!áàßâåääåææçééèèæãâãåçéêìíìëëééèæå…äåæåååäããââãååææååå‡ä âáàßÞÞÜÛÚ×Ó¬€•ˆ€šƒ~‡‚~ˆ‚~ˆ…~ˆ†}~‡~•‚€‘„€•~•‚~™…€~~Ž†€}…{}~Ù€ÓÑÑÑΆÖ×Ø‡Ú -áßÞÞßßáâãä…å€ããäååâæäš÷ázˆ„‚ŠŒ’‘ýã»—‘‹‘Å퇚§ª¥žçÍ‹jj~Á…‹ˆ‚ë¿pt¡³³«·Í×É«‹rnjlv§³³‹¹Å¡ÇÝÛÁƒ¥‘t¡™Ë×áåÃåÑá‡åÑ•¡­¹»Ç›•Á©‰é½‡—¡£©­±¡‹¡Ûñíï倿£‘™¥¡›‘ézÇÿ“™›ƒõõ‚íɱ»¹£‰‰“›¯û…’•ˆÝ˽¥—•‘‘…‰•™©¿Ùãååç˧¡§¹ÏÕɽ±§¡‘‹£ÇÕÕÛÙ×Á¡Ñ±ƒ¡Ÿ­»ÏÙÛçññóõõ÷óåÓ·«³»ÅÓëû„‰ˆÏݯ«§««£±.ßï…’”‡~|ÁÁÁ00`Tv½•Òäèìììêèêëêééêéèçæççææççéé‡ëìíïñññððîîììëéèè‰éèèèççåä„åäˆã ääãâáàÝÙ×ÓÏ ÞÞàáãÞÞÞßßàââ„ä åååâáààááâä„æ€èèèëëíííóïçš÷󅎈†Žœ¦•‚ÿç×ÏÓÁù½Ñptvwywk·­“…¡Ý‰ˆ…yÙ±‹“ŸÍáÕÃÁÍÓɵ¥“•—±··³—Õñ«Ëǽ½»“á¹±Á›ÉÏÅ¿£ÍÕùr¥¥x•›£§«Ÿƒ±¡©ñ­xƒ“•“‹‹©ÃÁ€ÃÁ½«™¡©µµ¥—‡ñ«Ãc`bbŽ]¿™‡‹‰‰~~x¡×gig^«©§ƒ~zrz‹“‘Ÿ­­§£§¯¥‰‰‘‡~‡—‘‰™¥£¡£¥¥™x‘x^‰—Ÿ£ŸŸŸ¡££¥£›‹|‹“›©¿ÑjppnqŇ鳱©«¯±!¯¯Áåñ–”’„ÙÁÁ@P`‰™Ï—Ôåæèèèéèéê…è ææäääããääåæçç„èêêìí…ðîîììëé†è çæåååæææåååä„åäˆã ääãâáâáâáÞØâââãã…äàââ„ä…å€ããåååçééêêëëëñññóóîóïœï󅆄ˆ–ˆvÝÙ×Ç»Áç‘™W[_dc^WQ§“‹‘¹u|l±h~¡×Éõ·ÅÅÁµ­™‘“›—£§“v­ÕŸ—™•pµ¡‘¥ƒ›…‹v|…‘Z•\pptrrjN(X‰ ‰…XZ€`TNVXT`ŸŸ¡•‘…|‘››‡‰|É`fn|@?<>xl4fRPhnnbjprhIIEI‡…r\`bh\VZbb`lplfhpxr`XX\VRNNVlzpbllfdjb\TF\\NbRT\d^VVZZ\^XZ^^VLJDJ\t‹™MNPNR‘+X\~‘‹‹“¯Ó×p}~ƒ‚†‚ÑÁÁ±¡Á…½ÊÜßáßâäåäã…á ßßÝâæääæææçéééêçãããåçéêëíìëëééçæ†ä æèæææåããââãä„åäˆã âààÞÞÞÜÛÚ×Ó¬€‚‰€Šˆ€‡„€™‚~‡„~†~~~~~ˆ~„}~™~„„€€Œ„€«‚~š…€~ˆ€ ~zz||{~Ú€ÑÔÓÏËÒÔÑÒÓÐÓÕ؄ـÚÛààßÞßßáâääãàáäãßáâàããã·t}–’Œ™­³¨…χ‰™¿å…‘œ¤¤—ˆíÑÃ푵ƒÁ††é¥zlt«¿ËÙå÷„ûÏŸ~tn•¥µ·£‰‹•«×͹x…x©©ñÁÍÛçÉùáýñ̓™§µ½Í­É¡­Ñ€ý™•‘™¡¥™Áíû„‹ŒûÙ­—•¡¯£‡xõ‹¡Ý‡”šˆƒ‰ë³£©©‘…‰‹“Ï‹–•ˆã͹•—•……‘“‘£·ÏÝßÛáåßϽÃÕß͵µµ±Ÿ§ÉÙáã×½¡•ñ¹é—›§·É×Ûåíñõóïóñëßųµµ·Á×ñýƒ/ŠŠˆó¥å~¡±µ³·»¹£¡»çï…——”‰ˆ‘ÉÑP0H~å™Åäéìêëìêêêë„êééçæç‡èêëëëêêëëíðñññðïîîíìëêŒè ççæååääåå„äãâ„á âââááßÝÙØÔÏ€ÝÞÞàâÞàÞàââãââãââãääââàßáâãåæçèäçéèëíîëîðìÓ‹†ˆ•¥£šœ®¿»¤çÉÁÅÁÁ¯¯Ãlpuy{qeµ¯«ù½õ£Ý…„}sÑ›ƒ‹›ÍÝÙÏËÛtíÛË·¯§¡§¹»»µ©™ŸµÇÅ»¿·…©•ÙÉñ»ÇÁÁ£1ÕÕùx½©xŸ©¯«¥£‡•¡½Õr~‰™›™•©ÅÑÃkopͱ¡¥¯»§“…õx¯„_€ba\]¹ƒvxxzx|~­mkjf`³­¡…~zvvƒ‘——™Ÿ««§«§±¹µ«‘t|“…•£¥©§‰|r­lv~›¥¥ŸŸŸ¡¥©¥“…~~ƒ‘¥½ÑÓmrrtߧõ£·»¹½ÁÁµ¯Áçï‚”˜—•“‘•Ïñ¡`P‰‘÷ šÃâèéæèééèéêé„èçæ‡åäåççèéçèèêìîïðððïîîíìëê„èççæåäääåææååäääåå„ä‡ã -ääãââáááÞØá„â€àâàáâàááâãåååæçåæäãäãäæçèæåçëëìïðîððñÛ‡Š–¥¥š®Àº¡…åÑ»³ÇÅ£‰•MU[`aRI…•õÁåx¡inlc¯…t|“ÅÉÅ»»Íj×ÍÍÁµ·µ¯·­§¡—›«©›—›Zpl™¡Íƒƒ…np¥`¥~‰bzrprrp^PHdh‰R`b^^Zbjlv‘£¡UX[¥‰—›Ÿ•‹|É\bt<9;57635lLPdnlfjjlpLIIHKvZ\Z\Z^dllhrtlhnnvƒƒvd^TRFDNdtlXbnnjj^J>>lPxZT\dlfZZ\Z\^„\;VNHHLbt…™™LNPV©z¥\•™™››™™³×Ûu††‡ˆ‡‹˜Õù¡‘¡‰‘ó•¸Øßáßàâããäåä„ãâáàâ„äåæçèéèçåããåçéêëìììëëééçæåå„äåçæææåääããäääåå„äãˆâààßÝÝÜÙÕ¸€‰‡€~~~„€‹€–~~}}~…~~~~~ˆ…~ƒ€Š~ˆ€‹…€«ƒ~š„€~ˆ€}{||}Û€€ÌÒÔÐǶ”–¡¼ÑÑÕÙØØØÚÛàáàÞßÞßàâãÞãàÜÝÓ¼´®§§¡šsѯ±isk}•—x©t|‘·Ùù‡Œ˜œ¡”…í×Ï±í¹‰¡‡Åñ†‰ß£å½¥±~Áí‚–œ•ù½—…“§ÁÇÕÙÓÕÑѱýá…ñý»Ë×ßÅ€ý‰ƒ¹¡‹££©·ÃÁ™É̓¯Ë˯•›Ÿ£·×íû‡‘——’㥉•ƒ•Åéí‚‹”—“‰ûõ¯Ù½Ùñõ…‹•­ù–ŸŸœ‹ãÍÁ«­«Ÿ™•—™›Ÿ©±ÇÕÓ놓——ŠóááÉ¥£§¥—…Ÿ½ÕáÝÅ­©¯¥ýñ“™Ÿ«ÁÏÛáç:ñõïååëçå×ÏË¿³©Ãé÷ŠŒ‡é­¡±ÉÏ×ïùéÝå„¥ÀƸš’•í¯—•¹‰¥»ÙêëîŠëêééèçç„èççèéêêéèèêëíððñðïîîíìëêéèèçæææ…çæååŒäâˆáàßÝÙÙÕÏ€ÞÝÜÛÙĬ¥ª¶ÕçââáààáâãáãáßàââãåçäêéäèáÊ»´²«¥‹}õßáz{ƒ‘¥¡˳¯µÁÙñûzywttmd»­±£åÉÁÕÕámh©ƒéÝáå•Ïçorwz~õáËÃÃÁÇÏÇÇÇÍÑɽ½Á¹½¿¡Ù¹lñýµ½¹·›€tått•…£­¯«£Ÿx•¡r››‹z‘¡¥£¡¹ÍÍÅiptpk¹›™›—•§³©Y\]^]_]©£ƒ‰t‰±Ñpv—Ájggcc³­¥‘‡|vz‹—™——›¡£§År~ƒr»›“ƒjlz‡|¡§­¡‹|…•…¥¡r~‰•¡¡Ÿ¡ŸC™™¡©«§£›‘‡ƒ‹™³ÓÓjrvwvᵑ¥µÍÝåóûõåá‚£¿Å¹œ““•—õ·Ÿ›É£µÔååêèèêêèéêêé„èæå…æåääæçççææèéëîîððïîîíìëêéèèçæææå„äƒå–äâáààÞÙ€àáâßÚÇ®¦ª¶ÔçäæçæææèèåæäãäàáâãåäîëëíåÎÆÀ¸¸±«‘„ÿãç…ˆŸµ©ƒÉ³·µ»ÛíéjfYZ\UL‡•‘ͱ¡¥d‰¡ON‡fÍÍɱp­¹W]fjjÉÇûÿ½»Á·µÅÓÍDZ¡›•r™0¹á‘…ƒzb€FXZxpvrlntlX\`H\hlld\\bpv••NW\YT—‰‹“—›>;65410Z`NDDx¡ÉfdhxGGJLM‘‘|f`RJXjpldfhd`^dXejl^‘fTH8@L\XHVpvp^RDJZ\|pTV^lph^Z\GZ\^``^ZTPNPV`dx——LORY\µ‘r‰—¯½ÁË×áÕÓz‡œµ»¯”Œ””駑»‰¡±ËÜÝáàâããâäæææååää‡âäææèèæãâãåæèëëììëëêééççæååäãããä…æ‚åŒäã„â ãããâááßßÞÛ×­€ƒ‡€ˆ‡€„ ~}}~€€„~ƒ…€•~~~}~†~~~ˆ‚~…€‹‡€ƒ…~……€“…€”‚~š…€‹€…Ý€ÅÉÓÁŽ³tlj‘„¼ÈÏ…Ø€ÚßáàÞàßßáâäãßÞÖÇ”lÉns~“‰mÙkÍÓty}‡{³ƒzx«Õ퇒’“ƒé˹µ|©‰hÉ…½ßñû¥½‰‘Ù¿‰›š¦š…¿—…—©×áçåã×½…—Ùý‰Ž‡û©‹«ÉÍÙÓÙõ¡™‡­³¹Áǽ•é‡­åý€ûǕ탛§¥³ÉÝéç÷‰˜œƒ¿~Ñl‡Ï‹›“Œ•˜—翯嵥©½Ñý«Õˆ™¡¥Ÿ‹åÑÏÇÃŹ«©±³µ¹¹±ÁËÕ‡•–‹ŽŽûßÛ—•‘ƒÝ£¿Í˹­Áɻ鉙›§½ÏÙãëñóéáåëééáÝÛϹ¥µÙóƒ…'‹ŽŒ†å©¥³ã‡‘š¡­²µ¿ÇÙîöíʱ¤™–žœ˜”•¡®ËáèìîŠëêééè‰çéééçææèêëïïñðííììëëêèèç…æ„çæåäääŠãâˆáàßÝÙÙÕÐ ÞÙÛșӕ“•½›×á…à€âãàâáàáãâäæçåáåäÕ wßy~£š}ù|ñõ‚ƒšœ‡Ã­­³ÃÛõÿ…ƒ}thf`±³©¯ƒÙ‘‰í¹Ã»³p|¥±ÅÁéÁtouuuztË·½ÁÃËÕ×ÑËÑÕÕ¿¹»½ÓswnÏ“‰¯¿¹¹«™tÝ‘•…¥«©¥Ÿ£…Ñt“«€¿»—rõ‡¡©ŸŸ¹Á»±¯cgkom©~‰ý‘·lp_Z^cd`VŸƒv­||…¹Õr…§_ecfef·³­Ÿ™‡‡“Ÿ—“•“™«w†…~}{uÁŸ‡jlpzt݃›©¯™‡~•©™d©n‡™£§©§¡Ÿ£§«©§•“‰‹‘Ÿ¿Ùn1pvwv|é­©·åŒ–›¢±µ´½ÆØêðë˱§›˜Ÿ™™ž¥­ÄÜãæêèèêêèéêêé„èæ‡åääååæåäåæèêííïïííììëëêèèç„æå„äååäääŠãŠäâáààÞÙÞÛàÍ×™“•½›Õàá…æ€èäåäãåááâäæìèìéߪ‚ó„Š“§ÿ÷ûˆ‰š¤§Í©­µ»ËåëvogYSRO‘›•¡|Éhd­\|vvHH•¥‰©WMWX\[W£™§±¯§¥Ç½µÁÍÓÇ­©µ·]_[±^n¡©“xfT\V©hptƒrnlnpb™Tl|‘€v^µVbnrrx|…|HLQTUpxу¯daL?@<99-RDHpLLd‰±Ábj‹?CCJLI‰…|lfZNXflld`bXRVn]mqnkld“lT>>DLJxNlxpZJF\nnJpN^bfjpddb`^^^``\XRPRRTTf…ŸPQ4T[^dÅ™—¥Ó‡ˆ“©¯­¶¿ÑãçãÅ® “”ŽŽ’›¥½ÔÚÞáàâããâäæææååää‡âä„æ åâááãåæêêëì„é èççååäãããâä…æåäää’ãâááßßÞÛ×…€…›€†€€†€ˆ‡€…}}~~††~‡€’ƒ€Œƒ~ˆ~‡~Š…€~‰€ƒ‡~ƒ†€’‡€ˆ~‹~š†€…ô€€Âåߋ\‰l™˜ÂËØ×Ö×ØÚÞáßÞàáââãââÖ·“}ÛËÓÙÛr{j»ÉÏávxxŠ„ã½tr±Û󇎉ƒ†…á¿©—‘p‰•á…³Ûëñýáht‰¡zÙ‰‘ž›¤™ù¡‡z~ƒ±ãéííéÓ³…Ÿßÿ˜œ™å¥¯ÇáåÝÉ€«£«¡‰…£ÍÝãÛѱ•‰©Íû…í·‹Ùz“¥§ÅãíáÙãû„…ƒ…×åµµ™÷—šœ’’“‘ýÍ·Ÿ‘½‰ù‰¥Áý§ÍõŠ—šš”ÿÝÕÙßåëáÍÃÍáëãÑ¿ÁÏù—˜‰‹‡ýÍ•‡‰áå«»»µ¯½Á¯‰Ýý‘•¯ÉÓãí;óïáÛáëééëíëÝ什åÿŠ‹ù¿§ÁŠ§»ÌÔÙßåêêñö÷÷óèÛÊ°Ÿ£¤ ¡°ÆÛãæëîì‰ëêééèçç„æ„çèçåäåæèëíîïïììëëêêêèèçæææåæ„çæääŒãâˆáàßÝÙÙÕЀÚÓ­í£|ÑÕÅõɶàáÞàßàââàâáàâäååææáÙ¿¢õçíóõ‡~åñó÷~‚‚š’ýÓ±­¯½Ùóû‚xojhf¹¥«›‰­ñ‰¥õ|›½µ¯¥‘…±ÁÁ…ÉrmpmmpÍ¡—£«µÃÏÕÍÉËÑ˳µÇÉÍqyys¹¥»ÁÃñ›€“—Ÿ™‰‰§·¹³©¡Ÿ—™«¹`±pñƒ™¡¥µµ«£Ÿµ`]Zk³~ýõõÃpni^`db§‰ƒvn™t᥵Õz‘¯]_\_\½¯«­«©©¡™©³­•‘™Ï‡‡‚~„~|sÅ¡pjntvÝõ‰™£“‡‡‘™‹h©Íz~ƒ‘£«±¯C§ŸŸ¥§§§Ÿ›•‘‘“‘¡Ëßpvxx|óéÌ«½ÉÑÙàäèéîòðòñæÛ˯Ÿ¥¥¡§²ÁÓÞáæêéèêêèéêêé„èæ†å…äåäããåæéììíîììëëêêêèèçæææåˆäŒãŠäâáààÞÙ€ÙÕ²÷©ƒÝÝÉõ˶àãæåäåæèäåäãåãããääãÛæ‘ýíõûýŠ“‚éõí÷ƒƒ–™ùׯ­«©»Ñ×mdYOQW£›|©áPl¡Ptƒzz`(X‰Z‹PGMKOM‰nn“ŸŸ››µ£Ÿ§µ­£Ÿ³Áµ]```ƒ…¥§Ÿ©‰p€hr|pr“•…zrnnrpz‹GƒfT½RZdfjpnnplz>:7M“nÙÅų]QO@=<8dDFJR…X¡`©^hƒ>;9@Avvvrjjd\`lr|xf`VLV•rvqnuqoa—pF>BNR™bpjVJLZb`HhZ^`fnnjhJd^ZZ\^\ZXVRLJLRd‘§SX]_cÏ­“­Ÿ±ºÆÔÞàåæëíêíïçצ“•˜–™¦¶ËÕØÝááâããâäæææååääâââ„áä„æäàßàáãæèéêêééèèççæåääãââáä„æåää”ãâááßßÞÛ×€€€„~˜€…ƒ€„†€‰†€…~|}~~…~}„~‚†€“„€š€~‹„€~~~‡€…~~}„~ƒ…€“ˆ€‡‚~Š‚~š…€„õ€«—ÅhZ™h`d^e±Ì„Ö€ØÙÞßßßáßââßÛÒ¡Û­¹Å¿ÃÉqɵ£¹Ãnyùïvy‚|qÉ|px•·Íé‚÷áëᯕ“zÁ‘™Ñ¹åñ£ÉÝÛ¥Áplͭ󉘟Ÿ —뉅ƒ‘³ÅßéíëãÁ“j›ÝûŽ—œ›é£­Í÷ñé˵³Ã¹¯¯¿é„†õ݉»ãû€ïÅ“ùÑz‹Ÿ«×÷óÝÑÏïÿñÙÙÃñ™¡tˇ•–‰‹ŒŠã©—õÑ…±Ñ‰­½ƒ¿é†…‹‰ë×ÕçñûÿõåÝëý…„é×Óá’ŸžŠíçõˆ‹‹ï¡‘‘ýí…¡·µ«©¥­©ÙÑñ‰¡·ÅÙçëéßÙÛççéí÷ñãÓ»­©Áå)ý‰Ž”‚Õ³ç°ÉØìóíîõ÷÷ùøùùôñòñàËÄ¿¼¼ÈÕâæéìîí‰ëêééèç…æ„çæåäããæèëííïîìëëêêêéèèæææåäæ„çæäãâ„à„áàßÝÙÙÕÏjºŸÕƒÙŹµ½‡†ÓãÜßßßàâßáááããææâß΢íÏåãÝáçõãÑçýýƒ…ŽŠ‚糯µÅÕáïyi»ÅÍ¿¥›™Ý±ÉÑÅñÍvµ±©xáÉ¥Áå±Ómljihm»‡‘­ÁÍË„Å€³™ÅËÍrxus­£ÁËÛÍ»™¥¹¹³³ÃÉfa±¥™¡­·»³“xíõ‡“™›©¯§—™µÅ³›©“Ź퉯hpph`^][“pnͱ|±é¡ÕÁl‰ŸVYWUVQ­«­³µµ³¯©©±»ZP™Ÿ—«{‹|Ýåí{wrˉxtz~íízƒU“‡~z‰v­©Ñrr™«­«£ŸŸ¡££¥›—““—•‰§Çátuw||Ý»í²ÌÛæìíïôöö÷÷öðîîïðÞɽ»¾ÇÍÙáäæèéèêêèéêêé„èæååˆäããâááäæèëìííìëëêêêéèèæææåˆäŽã‰äâáààÞÙ€½¤ß‰õÝÍÉÑ“‡ÔéèäääæçãåååæáääáÞÈšáÃ××Ó×Ý{ùçÓëóqvéçuƒ‚xqÕ±«±«³¯ÃaSŸ£•‹‰vÅ™¹‘|…^ƒ~H@`t¥…™JHHIJIvTd•££ŸŸ‘ƒ|‰‘zdt¥¿¯Z[YZƒƒ¡¡¥ÃŸt€r~™™™¯¥MEztfrŸ‹vZL¡ÁTTZbfjb^b`rx`F`n¡‘¹dSOEF=962X:B™™©©x™FZb884153`hlpnnf`dnt=5`bVh_}‚rÉÕßqg^¡`JNXZ¡¥\fhRHDDLVHhh™XX\fhhdI^\ZXXZ\XXTNJFHJPn“©Y[_cf¹—É¡¿ÐÚäéíïóóóôðïñïîíÙÁº¶µ·ÀÈÓØÛÞàââããâäæææååääââ…áãæææäâÞÞÞáâåèééêé…ç æääãââááã„æåäãâ„á âããâááßßÞÛ×€€…~•€‡€…€€…€ˆ‚€ˆ~~}}~~~„~|}~~~†€“„€‚€‹‚~~~~ˆ€~~~}}~~~†€Œ‚€„„€€€€†‚~Šƒ~š…€ƒõ€€~³|bPN`\h‰z‘ËÔÖÖ×ØÙÙÜßÝààçàâÑ¢íÉÇÁÏÙÑ»±¿¹­¿ÕÛ„ßÍßßëÙ­vr‰¥½ÛóýùëÉ·—ƒ‡ÑÅnÙéÝ¿ÙÃép@H…‡×…š ¤ž•Ùƒ~—ÃÕÝçëãÙ·á©Íëÿ™˜å›£ÅíýùÓ€»··µ§©¹ï‰‹ûÛŸ‘Éßûç­…íÝz‹Ÿ±ÝõëË¿½ë…ýÙÁ¥µ\‰›íŠŠ†ù‚ƒ††ç£ý­Ñ¡±¹åŸÑïÿñ‚„ûÝÛáñ‚……ýéáçû‚„÷åá¡éÛ盓“‹‘£µ«›—™«¹£É¡Ù‘—­¿É×#áãÝÙÝåéëëëéãÙɳ§¥½í‡Ž’‰ëÓ…Ðãîòõôõö„÷ùøöôññîëéçâßâèêèëëìíˆìëêêéèèç„æ3çèééèçæääæçéìíîìëêéêêéèçæåååäääåæææåääããâáàßÞàààááà„ß àáààßßÞÚÚÕЀ‡»‡n±©½¹Ñ½ºéÝßßààââääâáâçààÏœõåéåééÝÕßïïáëýÿ…}éïõùÿë¿™Ÿ·ÅÕãéáǵ·¥›‘õíõå~|½j«±™¹Á‘ÉËgikffgj¯…‰—­ÇËý···Ÿáù»Á¹Ïqur¥¡ÁÉÕË¿€›¥±³©­¿Íjd±›•¥·½»£xnõý‡‹‹“©¯Ÿ‰…©c»›ƒl|ñ£ÁefhÅ\Y[[£nÉ•¹‰Ñ±ÉÉÍz•£©§VWV©³±³»_]Y©«¯±·VP££»…‘•ˆåÝéutyr§ƒ~|~~x~‹‰ƒvnv…ƒ­‘¹jhr§©¥HŸ›Ÿ£Ÿ¡¡Ÿ›™•—‹­Ýsru}}å׉Òâèëîñóôôõôóóõóñîîíêçäàßááãåèèéêéêêéêêëêéèççæ„åäääãääããáààâäèê„ëêéêêéèçææååääã‡ä ããâáââãâááâââ…ã -äãããâáááßÙ€ˆÇ™ƒÙ½ÁÁáÉÀîâääåæçãåæååáèÞÝË—ÙÁÓÝ××Í»¿ëñííõÝspÏÏáÛáÍ£§¥±£¥«³©—ƒzr~“xÉÉj¹ÁT@hPƒƒnX@@l­j™LHHGLEEdRn‰™«Ÿ~vnnp`•¹•¡£WXTzv—¥É©~€rz•‡—·«NEvjjv…——‡hB<™½XXTZ``VLPRh>lNDJPL™tD=:t6566l@l™¹É‰•‰JZdj^146p`pvr::5^^jt=4`d\te|ˆyÍÑçpeaYx^TTXZ^dfbP@<bDPVr…|z`@4\‰j`L\nthflljlj^Z<@…v||<6hhj8tlPáÑÉÅ­¡™tv\@0|t|rJ0±Õ•x``P),-3ZF‘©¹¡“|x>>95Zx…‹—‘‰FC=tr—½f—n€njƒ\D`‰‡|9b<4:PjpvbR8(D\hVb•KIKŸPCpljdpjxr640nn>:7^FBN``(HLljzÛÃÉÕÕÏÅÅegX•ƒ`bfbXNLPRRZVVP(LNLFl>^T!LHLRRRTTPLJJHPPTPJj‘X\_a`c’æôñóöö…÷õóóòñïïîìëèæææäãããääç„é ëìììëîñîêèåâ„áâââáßÜÚÚÜßáåêëêææååææäßÜÞààß„Þßààß„Þ -ÝÜÜÝàãããâá„ß àááßßÞÜÛÛÙÕ…‡~‘€†€†~…€€‡~†~„}|}~…„€~~~…„€~~„ƒ€…€‹€‹‚~…€€€€€„‚~„€€€€…~~}~~…€†€€€ˆƒ€~}~~—ü€€|zlZPR…`HXdj«ÊÔØØÚÚÛÙÝÜã㿉‚ÿÇ‘«Íï…ŠŠsÇoy˜¡Ÿ“ëÇÁ½»§‘|ƒÛíƒûë¡¡h¹éíéŹÉÍѽ›¡«·™±0hÕ³å󇎎ýÛ•¹­¥‹½ÙÛóƒ’‹ñ‹¹­×íéñ÷õß¹§¿÷ƒõ݀Ͽ±»™ý…«ëˆ„Ý›‘‘³áûý럙•Ñ™¹Ñïýýñ郂ïÓ·xp~«Á󅌋†‚÷Ñ™“‘ƒÙ©¥Õ“µ¿ÛëßÕ™¡ùŧÁÃÅßùÿÿóÑ©Ÿ¡µËáádzåßÕÕÛÝÓËÇÛ‡˜“‘‡Ó«¥™‘‰…õƒ‘“ÁÁùõ…ƒõýŸ½!ËÕÓËÍÑÕÙßãããéëçá˹±Ëˆ‰•—”Ñöùùøø…ùøøø÷öõõôññðððïŒí îïîíííìëëéèèçæèëìêéæãááãäæèëêèææ„å äâáâãâââáßßß„â áàààÝÛÛÝÞÝÜÛ…Ü ÝÞÞÞÜÞÝÙÙÕÑ€™“‹‰“­µÅ©±ŸÊâãáââãäææàãß·‚xë³—›½ßýƒ‹“ˆÿŠ”•Ÿž–‡wáçåÝѳ™£±ËÍb¹±ƒ…‰ÍíÝÙÉɳ­£jj›£Ÿ~©Á¹í§³³WTSOK§™h©¹Õ‘±»»¹[]]Z•^­¡¹±««­©­©§»íl¿¥€›‘›‡`ч¥¿^Stttv³¡™“pt`­…™¡·»µ±³`Z§‰‰«·µ`a_[YR§›xtz…~ݽ½Íz…‡‘‰ld±±¡±¥“•¥£—‹vlhv‰“‹•ÝçßÝßß××Ùávyttm¡ƒxrnjhbµ`lt‘p±ÑljÅÉz‹!‘“•—››—‘‹“•—™•‹­qy|†Šˆ“Ííîòôõˆöõôóôòðïîïïíìëëëììì†ëìëêêêéèçççæååääåãâßÝÚÚÝàäæççæææ„åä„ãâââáßßß„âá„àáãáßßÞÝÞ„à áâááàááââßÚ€©­©¥ÅÁÅÅÕ±Ñççææèèéåçãçå¼~mÃ~r™ÉÕËbp{ñŠœ¡œ{pdÅÍ×ÕÇ•l‰“Ÿ—>nhL4x¹É©™‘j~nZJ:F|ƒrRX‘¡Ñ‰|n2*())ffJ‰™¹•‹zz@B?;R<‘™…ƒƒ~x~•Åh‹^€djƒ\2dpt64H0:@Nj\TR>,DHlNjndfnvjlrfN™jxrh74133-\^\F@JVTPtP`@NFHFFDX0@‰µX64@BHHFBDFB@F>LRpPpN\•HH|¡N…tJT NLTPJLNLPPLJJLPTTZX^…T]ksv‚®èñóõ†öôñóðïïïîìëéèèçåæææååé„íî…ðóðìêèååäääããáàÜÙ××ÙÜÞãèéçää„ãáÜÚÛ„ÞÝÚØØÛÝÞ…Ü ÛÛÜßãááàÞ„ÝÞ„ßÝÚÙÚ×Õ†„~‘€‡€€€‡€ˆ~†~„ƒ}†€€€„~†€€€~Œ€ˆ~€Š„~Œ~„†€‰ƒ~‡~}||}~œ…€†„~ -~~}~~~~—û€€tppl…••d6ƒªÌÓÔÚÛÝÝÞßÛགྷ÷óÓ­ŸµËá÷ƒÇ…‰½}Œ•‘“ÃÍ`~¥·¿Å|¿Ï¯Ñ©‰™±Ñ퇟¹Ùó×¥ÕÅ—­·ññXÙ·ÃÝïÿƒ‚ýùµ±Ñh…½•¿ÑÛ×僊Šû™¡‰µ¹¹»ÅÇË•áÃññ×€¿½­ßíÍ¥Ãñ÷óݯ‘‹¥Åñóï¹õ‹åé§ÑÛßÝÙÙßý„וù¯ã÷‰„ˆ‰‹ŠÿáÁ¡•““‘‘‡á݃‘›­­“ùÁ``@hÁý¥Åɹ¡—‰ýõõùéáÕ­Á½µ£‰éíÑp¿ž¥¥žûÅŸ“ƒÑɽÉå‹™‰¹Ñµñƒíé‘­ ÅÑÑÇÁÇÍÓÓÑÏÏÑÙÝ×ÑÉËÅÍž˜™Áñö÷øˆ÷öõõôõóñ…ïŒî ïïïîîîííí„ì2ëêêêçæäáÞßãáàäåääãâáââãááàáâââáÞ×Õ×ÛßàààßààÝÛÛÜÜÛÚ„Ù ÚÜÜÝÞÝÜÝÜØØÔЀáÉÉáùñÑÝÙt·Èæéåâãæåæèâã¼|éçéÉåññoi³‹Ÿß‰Œ‡wpl­íƒ£Çû¯™Ýµ­±…¡•¥µÁÕ퇣±«¥©±Í£§©Ññ‰±£«µ½]V¡¡‰p©ñ›©¥©©©VWV«v¥‹§™™££“tÅx¹Ù¹—€…‹—¡¡Ÿ·¯«—zjjz—“•±V¥±ƒ£¡ŸŸ¡¥¥¹aŸnÝ—±§VZ\]ZWW¥Ÿ™‹ƒ‰‹‰Í±bflrpbµ¡x‘Áá¹ÕÝv…‡xplhÍÉÉɹÁͳÕÑůáéñ‡¿xƒ„Ç™xvh¡•¥Ñzzn…‘•ÑlŹp|…‰‹“••“‘““—£­«¡«×‰Œ–¿êìð…ô õõõôôóòòòñï„îíì!ëëêêêééêééèçççåãàÜÙØÛÝßâäâããâáââã„á(àááßÝ×ÕØÛßàààßààáâãáßÞÜÛÜÝÝÞßàááàààßßàÞÙ€ÕÑÝõùííùù…ÃÍèêêèéëêìîäá¼Õ×v|“—¯É_\—lƒÛ‡…wk[UU‡µh‰¥x‘‡½j…pnN`tP`p‰¡bvxpltVpv||…`p|zz‡z6.V\H0`h‰ñ‰|lnjj885\Fxt‡dbdppZH|V™¹T€N`trn^Ndj^f\><@PdXPTBL:px\p\ZZdndv?b4‰fvh221000/\XVJ@DLNRJ\L2:,6<4`p00`hxh8BBB>@FF‰|tTPX»Ç³™xÁÑÙx­fefe`—hHHH…PP|X`RTP¥Th@L;LJPLHJLLNPJJLJNRV``Xf“^owvƒ³æîðóóóôôôõóññïïîïíìëêééèçææçèéë„ìGîðññðïðîìëêééèèææåáÞÛØÕÕØÙÜáææåãâáââãáÞÝÞßààßÞÕÐÒØÜÝÝÜÛÜÜÜÛÜÞàßÝÜÛÙÙÚÛÝ„ßÞÜÛÛÙÖ‰~‚Ž€Š‚€„‡€~‡~…‡~‡ ~~~|}~… -€€~}~~~†€€€~‰~š~~~‰€~‡€Š‚~† ~~}|{{}~~ˆ‡~†~~~…€……~ -~}~~~~˜ú€€‰phl`4•³Á¿¿µ¡—|l»`fc]Snh…T@DL^XN8H`‰x\T<JHFJH‡JLNPRV`fdjr¥s~z‰Àäëîñññ†ðï„îíëééêêêéçåçëíí„ìîðòòðîˆìêêêèâÞÛÖÒÓÖØÛßääãáàßß…á„â ÞÙĹ¼ÉÔÛÜÛÛ…ÜÝÝÜÚÚ×ÕÔÖØÛÝßßßÞÝÝÝÚ׈~‚€”…€~~~…‚~„†~‡‚~„~}~‡€}|}~ˆ€€~~ˆ‚~’~†~~‘‡€~„~|||~~‡Š~‹…€~~~‡‡~˜ù€€0Rlh\-,//+'&JNZ`XL>LdnbJ:($:T8HPl`@6!LHDFHDFDHHJLLPPPR^lltj…p‚|ŽÅâëîðñ‡ïîííëëë†éçæååê†íîðòòðî†ì+ííëëìêäáÝÖÒÒÔÖÚÞáãáàÞÝÝßààááããââÝÖ¼®³ÀÑÚÛÚÚ…ÜÝÝÜÚÚ×ÔÔÔ×ÙÜÝÞÝÞÝÝÝÚÖ‰~Œ€—€€}}~…~}„ƒ~‰ƒ~„~}~‹~}~~Œ~Š‚~Œ€~‘‡€‘„~}~~~…~Š~€€€‡…€~~„‡~˜ù€€<<`|``TT…ŸÊËÒ××ÞÞÚßÜÁýçóí½í|½õñéïóá­‹xƒ³Ûõƒ…ûÓùᑉ^Ÿ½Ñx‰§Õ»¹‘µ…£³»ËÃÕùÁ|¹·¿ñ‰Å•­§›£«·¹µå­©Á¡Á»Ÿ£½ÙïõùéÁ•‡¯Áɧ©ßóŠùÅŸ‘±ùý€Ë³›­»á÷û„ƒß¥›—«¯ÃË»•ýÙá§Í×ѽ¥›¡­§“…Ñëý…„ˆˆ†…‚óíïñÿóáåõíëçÓÑÅÉÅÅɹ¹ý•ƒ¡·­Ýééíééáá…å¥Éßãyáååz‹Ëé‹››–’ˆß›õ§»«Åõ£ŸŸ‹É™•½Í¹í §·µ¯­±µ»ÁÅÉÍÏÑÏÑÕÝóñóáÓŠ¨§µçôôõ÷„õô„òñðïîî†íììíìíîî„íîïððˆïEðïîííìêèåáÝÞâßÜÝÞßßßÞÝÝÞßßàáäååäàÞÑÌÏ×ÜÝßÞßààÞÜÛÛÜÚÙØ×ÕÓÔÖ×ØÚÛÜÜÛ××Ó΀•ÍñÙµ­µÅÇèæéêçèèäêæ¾óÓ×ÉÕ‘¿×ÏÙÙÛÓ»±µ·¿ËÝÛmkgãÁ™©ñ™‘‰b©¡¡•­‹‘Å‹‹™£­³¥™‰¡ƒµ«©É`©…‹‘‰‡~xb©±¹Ù£·»—tx‹¡µµµŸƒ~‹¥¡¡ÓÙlµ…“¹É¯€xj•¥«¹[[pdn‰‹‰rZN‘‘±ƒ©©§•…z||~||‹¯¯­VVUSOLL•™¥­­¥—±±§¥—v•p…¹±™Ñ|lnzƒ‡~hÁɵ­­±¥¡`tÉóû‚‰çÝý‹¿ÑqvvtwrÇ•Õƒ‘ƒ¹zƒ‰v™pl™©™½;x…ƒ…‡‰‘““•™¥··¹±­z›ªÚèêïóôôôóòñññðïîííììëëëìëêêëêêêì„íŽì>ëëíìëéåßÙØÙÚÜÝÞßßßÞÝÝÞßßàáâáááÝØÊÆÉÑÙÝßÞßààáâãáßÞÜÛÚØ×ØÙÛÜÞßßà„ÞØ€¥­ÙõÝÉÍÑÕÍçäåæâææãèå¶Ó©¯¥~µr‘›«­¯«©—“—§™¡‘ECGƒjH‰ÁjrbZBXPtVdD4T‘h`dhnpjT@hxl‹tph xr\XLB>B<60TxÅ—¥“pRJRp~xnXXd…lRLd§³Fzb`l•~!NF`b`lrh0/J(0@RZVJ@0"@PpXrffXLDB„LzTnf^,--,)&%JR`l`ZNXjldbP.4,Hp‰‰phbXJHJNF0XdllXT\lBX(‰×Ýv~×~ÁÕtz£©VZZ\][l™b^LHTD@>\80LT>@B4,@™•é“¡‘“z`d~~xnLLl—…^RTzÁfE>jr|‹“H€`B`jdlr:2-L20H^bVD>:0,$4$,Zhplb`dTH‘Ppd.,.,*)'&P.5:10.2464dR4,$Lttx™jh\XVF>D8\PBDHLLNPRRZh<~‡©y|—Ïàêí„ï îííëëëêéèˆçåääåé†ìîðòòðî„í.îïïïíííêäáÞÚÕÕÕÖØÙÞáßÝÜÛÛÝÝßàáââäãàßÒÉÇÎÔÚÜÜÞÝ„ÜÝÝÜÚÚÖÒÐÑÒÕÙÛÜÝÞÝÝÝÚ׈€…~Ž…€~}}}~~}}~~~~‡}|}~„~~~~…~}}~~•ƒ€…€‡ƒ€ƒ~Š~ˆ€Š€~}†~‰…~~~~…~}~~„‡€…‚~…†~“€„ø€€“‘‹‡‘…d¹ÉÎÕÔ×ÙÙØßÇ‘÷ˆÿÙŸ•¡¹ÝÿíÛ×ÙÓ³—™Ï‹›Ÿ—ˆñ¹Ýù¹±¡ñ…‰‰¹½ÍÉù¡¥ƒ‹³ÍÑ٩ѹѡ§±ŸýáÙùáÑ“¡ŸùÙñу‘™Ÿ½Íåõƒ‡…ýׇ³ÛÛÏ­Ãû„™Œïǭш€Õ§™¯¿Ûõˆˆƒß¹™“¡·µ«ÁÓÏÉáч«ÑÕÝåãñå·‹íÙù†ˆŽ‹ˆ‰Š‡……‡‰“†ÿß«Ñññ…ÕŸ»¯…‰Ÿ›•‘‡ñåÁÑ™µ“¥…Ÿív£¹é­vƒ—ßõˆ•š¡£ ž…­³»­ÙÑ¥¡££™ýÙÙѽé—Ÿ¡¥£­·¿ÇËÏÓÙÝßßñïç럩Êðôñó„õó„ñïïíííìììëëìëëëìëë„ìííî„ïîîîïïïððïîíìëéçåãßßâßÝ„Ü2ÛÚÚÚÛÝÞßáäææçåâÝÛÚÙÛßàáâãáàßÜÜÚÙØ××ÕÒÒÓÕ×ÙÚÚÛÛ××ÓÏ€ÃÅÅÅù·„ÛéäëæçèéåæÍ•áooϳ‘½ÑÝÝÙÙÛ×ÏÑÇÁ݇Œ…voi½›¹ÉÉÙÁù|j…¡Á™¥x­‘¡««§th©ÝŸ›•Á±±ÕÁp©prtp©lÙùÑ|~ƒ—µ»»»WXS«zbt¯Á«•ÁïthO‰•«Ãcc€—x|›¥«­WTQrjv‹‘‡ƒ“ƒd©±p‰•§¯³·­‹lÕ‡³µYXVROMNNPRWZWWUUU[]«Ÿ|‘‰¡dt•Å¡—…‰•zdjnͽ‘•vrVjzd•ûƒµ¡áé±ÕÝqvx{}…p‡‡—‘¥‰h…‰‹‰~Í©©©¡<É~ƒz|xvz‰•“—››«_a½½Ñ•›¸ÞçëïòóóòñðïïïîíììëêêééêêéèéêééêëëìíîííëììëêçåáÜÛÜÝÝ„ÜÛÚÚÚÛÝÞß…á -ààÝÛÚÙÛÞßà„áââáßÞÝÜÛØÖÖ×ØÚÜÝÞß„ÞÙ€ÇÉËË˽¿ŠáìãçãääããæËÁWVŸ…p›©¯¿ÃÃÅ»Á¹­¯Û‚|m\UFx^p‰™±©É\BHHpdZNBTP…hX^j|ƒ\P¡¥znX@XLX•‰D8D:>66D(XѽlppjE@5lFBb¡•fNXÃ`E4ntrGF€bFTfhln;4.P:4FZbVBHPNJ6`hB:d\HL:LB2@N:jÑp—xÉádn»½]]^cfio\`TVP\tVPBL\RtX\X@4`HFBDB:>DHLLNJPTTXb;@…v| Ïßçëîïïïîíëëêéèççåæèéçæçæ„åçé„êëìíîîíì„ëGìíììêêêèåâÞÙÕÕÖØÙÙÛÜÜÛÚÚÚÛÝÞßáââããââÛÕÔÕØÚÜÜÞÝÛÝÞÝÞÝÝÛÛ×ÒÏÏÐÔØÚÜÜÞÝÝÝÚ؇€€€‘†€ ~}}}~~~}~„ƒ~‡}}~„†~}~„~~}}~ˆƒ€‹ƒ€„‚€‡ƒ€‚~‹~“€~}}„~Š„~‰€~}}~…ˆ€„‚~††~’€€ø€€£Ÿ—“——„ÇÌÔÕÖÖØÕÚÚ˜ãï„ýÇ—¹ËáíÕÅÁÇǵ¯¿ëˆˆ„ñÁñ­µõñå©xé©ÁÍË“¡™ƒ‘³ÅÅɧÝÙ™·Ã½­•Ñ¹±¡±‘¯©™ùÉу•ù±±™ÇëõƒŠ‰ñ›‹¿íóËŸïó˜•ÿç˃€Ñ±ŸµÉÛí…ƒ÷Õµ•‹‹¥­³ÓÛ×ϱùý¡¿Ë¹¹ÉÑÝÍõí›ãƒŠŠ‹ˆ‡‡ˆ‰…†‡‡Œ‹ŠŒ™”„¿ù¥™±¡•ÏÕÃù£Ÿ…ý…ƒ¹Õ·•›‘Ùá©`‘Ñ‹ÁÅÑýƒŒ•œ£¨¨ªŸç³¥—áÁõ•£¥§›…ñíÍ-ÁÕƒŸ¡Ÿ—›§µÁ¿ÍÑÙÝÙÙåõùñãᚬÝðòïðóôôóòññðïïîíííŽëììíîî…íîîïïðïïîíìëêéæãáßÞààÞÝÛ‡ÚÛÜßàä„ç$äáßÞÜÞàáââããáàÞÜÙØ×ÖØ×ÔÓÔÕÖØÚÚÛÛ××ÓÏ€ÍËÇÅÅ¿Ï£èêåæçèéêãØ•ßçrmÁ›“«ËÕÝßÙ×ÛÛÑÙãã÷}ypfddÁ§á­™‰µéá½™õ¥›“…^`‡™££¡™x­Í•¡™‹~zrÁ¡áɵp|vd•É‹™‹õ½¹ŸÇËÃ\ZT§d`xµÇ¹•v™Û×dW••±Áf]€‘~‡¥·±·VP•ƒpjnpzx‰Ÿ‘…rÍé‡|…—£¥ŸƒÑÝ‘±XXXTQMNOMPRUX\\[ZY[`\Up‘hppt•v¡§™nÝ‘…`dhÍjfj‡ƒ`llhxáõ»ÉéÇÍÕów{ƒˆˆ‹‹Žƒ¯‰‘Å…±z…‰‹‹~f¹½µ9½Ín~|xnlv‰•—›ŸŸŸ¥±ÁÅÅÑ“ŸÉàéíïñòòññïïîîíììëëéèèéêéèèéêèè„êŠìííîîíìììëêéæãßÜÜÝßÞÝÛ‡ÚÛÜßà‡áßÞÜÝÞßà„áâááàßÞÝÝÚØÖØØÙÛÝÞßÞÞÞÝØ€ÍÍÍÏѿשêèääåæçæéá˜Ù»[V™xr|›±ÏÍÁ»»¿¿¿ÃËçrfUFD>r\lTXµ¡tH@¡hLB<8@hZT\``fX‰±ttdRJH@Rx@08\@J<2H\‰lp^©…¥‘«•A6-^0:Z—•pTBr±¡B6vvj‡G>fTHRfnjl9.N@62>DNJJ^^LD>|¡VTB8FDR¹Í•P±ñ~«©·Ý…iSllpf|RNPh`‰@:FRVL:hphdh>LHB628<.6FHRL2PtZj0+' "$$')-.444322681"P\TP\JZZV:TL`N8" 04>@PL8DB@x•¹©P©Ùx©­½á×nopjihd`KdJNB`x<:FRVTH<|pH\JFF82:HTTPR…V"`v“Ÿo…ÂÖàåèìîííìëëèææåäãããæéçæååä…åæåæçéè„çèéééëëëêééèæååâÜØÕÕØÚÚÚ؆×ØÚÜÞàá„âáßÞÞ„ÜÞÞÝÚÞ„ßÝÝÝÙÖÔÒÒÓÖØÚÛÜÜÛÜØׇ‹€„€~–ˆ~‚}†‚~‘}{|~~‹‚~…€€~…~~€€€~Š~~–€‚…~…~~~}}†‰€„‚~ˆ…~•ø€€³­Ÿ—“~]ÁÇÓÔÕÖÖÑÕ¥Ãåõçµ…©™ÑÙÓ㛩û›¥»×ë÷ýõéïã¯õåõÝÕéùíõ¡±ÃÇËÁ›¥§¯§…¡Í¡±¿É½»‰Õ•¡¡Á韻ÉÍË¿³»µ­ƒrr«ÍÙÕõÿ„Ûýå©Íãå¿‘É£Õˆ˜ŒÉ™³ïñ€Ï³©¹Ñ鄉‡ñ»“¡‘ýµññáÑÍ»‡õ™·««¿ÏÑѳõÑñÃ÷ˆŒŠƒ‚‚ƒŠ†…†…†‰ŠŠˆ” •Ù«¡•‰›¿ÏÑÇ¥åÕ‰³¯—¥Ãµ¹ËÝÁ•§¥›ù¥ËÉ™áí‘¥ÅåéûŠ”Ÿ§¥££šé¡•‰ý‡‘“¡§©Ÿùù嵩õ›™‘…ý›µ¹»ÁÍ×áåáéíëã­êððïð…ñïïîîíìëëëéééêëêééêëééëêêêë‡ìííîîïîîììíìëêèãàÞÞàáßßÝ܇ÛÜßàã…äããââ†áàßÜÚÚÚÙØ×ØÙ×ÕÓÒÓÖØÙÛÚÖÖÒ΀×ÏÉÃÁ½»æéååæççéÕ~ÅßÑ­z\Ñ£ÑÓÑÏÓ×Û×ǽÍÓÏÍÉÅÁ½¹³—ééýÙÁÑÝlåñ•——ƒl¹t‰™—z‘±‰‡‰p¥t¡ùÝ|‰‘…—µ³§—‰‹³ÃÅŹ­U—­¹©­¥‡d±‘·\`U“©¹¥€‰¡±¹c_Y—rZ`dÁv‹¯¯‹xfÍz‹xv‡““™‡Á­å™©VVSQONOQPQSUV^aba`Y\`]vhrrbbl|…‰‹^™­v“‡tƒ¡…v|“…hrnj½¥×Õ±éõ•«Ééí÷…‹Œ‰‚~w±rÁhtzƒ…‹…pÅÍÉ•lµt|tjdÑ|‘“›£¥©»ÍÕÙ‹¢Ûäëíï„ðïîíìììêêéèçææç‹èé‡êëëëììííìëêêéçæãàÞÜÜßàßßÝÜÛ„ÜÛÛÜßà…âƒã…â„ãâãââáàßÞÞÜÚØ×ÕÖÙÜÝÞÝÝÝÜØ€ÙÕÑÍÑÑÑŠçäâãäåæäÜ‹™¹¥~\F©ƒ­µ»»³µ»Á»£«­±•…xrnhbF|¡‘‰…L•‘VR@>@:8LHJXN:8ttl`NBD@lT0`p•PLR\ZVd|zl\^b~©§j`Z0R0X\tn^H@f…:4;jVn|h€TLVdnt?<1F*.:lJXljVFB46HN..P`PhR,.HDDFTB0DB>dt£¡PpÙÕz‰«ÓÏÑlmmke\XStLNDpBB@HJNTL@l|9xL8lBJB4*TpÅxt±pvh¹™­z‡‰—¡§¯±½ÑÝ߈§ßãëíîïïîîîìììëëéèèèæååçèèèæçèççèçèèé†êéèé…êéèèæåäáßÝÜÜàáâàßÝÞ„ßÞÝÞàâ‹ã…äãääãââàßßÞÝÛÙÖÔÕØÛÝÝÜÜÜÛØ€ÝÓÇÅÍÑ×ëËäââäååÔ•µ—­™jH|³¯±·±¯µ½Á¯Ÿ©­¯‡tpjbR@‰±b\¥•LPXPHB<@N\4HJD6p8Xd\ZJ64>BB2TRPT^B*BDF6RzxT@‰xvv›ÏÍÉejnme\VTƒ`bR>DFFJFLTTD4d :h4,X>B6@8@PVZ\^\^fr“£©nŒÌØãåèê„ëééçääâââááäææåääãääããäääåˆæåæææçççæåæåããàÝÚØÙÜÞÞÝÛÚØ„ÖÙÝÞàâ…ãâ„àßààÞÞÜÚÝ…ßÝÝÝÜÚØÕÒÔ×ÙÛÜÚÚÛØÔˆ‰€‡~—~~~~‰~}~„~}|~†~|{{|~•€ˆ~~€€€Œ€€€~~‰‚~ˆ~~~€€€…Ž€~“~}~‡ˆ€~„~~~~ø€€±¡‘‹…ƒ|oµÓÓÒÏب¹·ÉÑ÷÷Ç…ÙÉËÙÓ«™¡µÍ§“¡ÅßííïãÑ͹“éåýùáý«³»Á½½³¡±Ñ¥£Å§½±`¡ÙµÇŹ‹¹ÁÁñ¹“§¹ÁÁÓÝÕ…•‘¹¥•¥Ëéëßéýó¹ý¿ÝóíËýуł†ýÇ—¥ÉÛ€×ÁŸ›³Íé…‰ŒƒñÃÙµ£ËÕÉ¿»µ³‘õù›»ÍÕÙɧÝÙ•Å„‚‚„ˆ‡‡ˆˆ‰‹‘“Ž‘ŠéÑÁÉÓßÕ÷±¥¡ŸŸ‘©Å±Ÿ½ÉÛãùÏ™§­§‰“™Õƒ¯«¥½åíûŠ”œ Ÿ¢¡ƒÇµ¯›‘‘•™Ÿ§©©£‰$‘ñ­á‘“‹íñ“Ÿ£©½Óåïëíïù냷íðïîïðïïïî„íìëêééèçééèéèèééèèèéèéêêê„ëêé„êëêééêëêèæâßÜÝàáââßÞÝÜÜÝÝÞßàââãã…â"ãããââáááßÞÛÛÚÚÚÙÙØÙÚØÖÓÐÐÔ×ØØ×ÕÖÓ΀׿¯««­±Ã–Ûåßæç㶵›³ÏÇÁ“lá¯ÕÉËï½Õ×ϱ¯½ÑÓɽ·³©›|åéíÙµÉvƒ‰“‘‰ƒv¹µƒbX¡™µ‰……^‰pñµx…—£©­›‰‘‘~±É¥µÁýµ­©™‡å‰¥«¯«ÁÁx¯VU¡~™£¡€‰v|—£TVXR“dhdv‘zxxth­©\p‰•‘““~©±ƒŸVXTQNMOQPRSTVVY`b`XY\X|…“™…tpjrvvdx™‡t“‡‰¡dprrdt“›á­…³··Åååë{‚„…vuxe£¡•ztrv|…ƒjhDpt­dh±vpj¹©hzƒ‹•Ÿ­±µ½Íßヰáäêìíîíííìëìëëêéèèçæååæçççæççææççæçèééèèèé„è„é„ç æäâßÝÛÛÞàââßÞ„ßàßßàââãã…âãããäå„äãããââáààßÞÝÛÚÖÓÓ×ÚÛÝÜÜÝÜØ€ã˹»ÁÏÑÙ™Ûéæéæ寯—Ÿ§•bJµŸÁ¯¯«¥¯ÃÇŧ“•¡©“zpnpTJ@‰©©­•‘PLNJB>BJJDXHB.@`Hx`VTB@$ `‘xTVR^btt`T\ZTh‘‹—‘vb`hdVxRjjf^L`|Lv3%bbH\jj€bLB@JT^2,+)J4(,PjPB:64,0T\68LTPPPHLPPRb640+(((*%&(*,/3;>;2351@BRddbXDBD>J`^tltŸ™“©ÑÑÑjjomdVRWHrpfLDFHLLRVVL86>BT \D>0@@:LZ\VXbjlt¥±g˜ÐÚâçè„êèææåãâáàààáäæåãããâˆã†å,æåäåååææåäãääãâßÜÙ×ØÛÝÞÞÛÛÚØØØÙÛÝßàáâãâââáßß…àßßÞÞßà„ßÞÝÝÜÚØÕÒÒÖÙÚÚØØÙ×Ôˆˆ€ˆ~—†~‰ ~}~~|{}~†}|{|~Œ‚~Š~†~~€€„€~~‰‚~ˆ~~–€¡‚~ˆ‰€‘„~~~ø€€‘‘‡‡||voÈÑÔÇ×ë§Íãíóí·•³ÇÓçÓ…~¡±¯Õ©½…ÁÝãßÉ»»¯™ñÝõñÕ‰£¯ÃÅǽ™½‘Áù‰·ÓÙñá᧯Á»±•á±±É··ÇÍÇÃÍϱùáéíál‡›Áåíéáã³áÍ•Åçûùå›Õ‹Ëûùçϯ¥¹Í+ÓÅ¥ÇÛ냆‰Š‡í±‹±³­±­¥«—‰‡•ŸµËÕ×Í‘Íý¹Éáÿ‡ˆˆ„…€†ˆ‰Š‹‰†ŠŽ‰‰ˆ‰‚ñÏ»½ÍÝóÙ¯§«±Åϯ¥·µ¥±½ãñýçÇ»µŸ‹‹£½É×Ó»±ÇéùŠ•ž£Ž…ŽŸóÛ·“…‡‰‡™¥©­›•—§«“±Å‡“£µ³¡™§·ÅÕåñïñ……¼ï÷ñííîïïîíìííìëêééèççéèçèèçèè„ç èèèéééêêê‡éèçæææåãáßÜÛÛÞÞàáÞÝÞÝÞàáââãäããã„á ââãäãââááßÝÜ„ÛÙÙØÙÚÙ×ÕÑÏÐÕØ×ÖÖÖÕÏ€¿±£¥©­³½ÇžÞÛéâÚß™·ÉÓɽ™‡£ÁÍËѳ‡›ÇÏ·ÝÅÝ‹µÃ¹«™‘‘…éåÝÅ¡p‰‘‡‹l‰pÉ~……`0pÁ¹z‰‘ƒlÙÁὧ››™—¥¥ííÝ­Á™ƒ³½¹·§™h±á‘©«¯­•jµv¯«©›‘…›Ÿ¡€‰tŸ£¡MPRNJ…Ph`z~jjprtfTZfv‡••““lÍ›—¡­VTPMLNPPRSTUSRZ][XVWO‰…™Ÿ£‘rrx~•rl‰‡vƒ›¡±¥™|jbrzŸÃÏ×ÕÏÇÑåï~„†‡}ochxnÏÇŸthhjhr‹‰th.l|…l|`©jp~~vrzƒ‘¥­»½Éqy}±ßçèëììííìëêëëêêèèçææ„å ææåçææååæææç†è‡çæåååääáÞÝÛÙÙÜÞàáÞÝßááãäãâãäããã„áââãäåæå„äã„âààßßÞÝÚØÕÑÓØÛÞÞÞßÝـѵ§«½ÓÕÕÛ¦ééíáßã“©«¯—h`‹¯»·»Ÿz‘¿Á¡­…•d“~nfdPTR™¡™•tFTDFBDB<<4LlFFF$0p©‘XVFH\|`rpf\T>tP|fLZ^>Zlr€dJLN^^\)&$%$H.8@ND66::60(2DDNRPLTDTTdbbXJ>BTN^~§É÷¯¿×ßrsrqiQ@D]W‘pL<>@>FPXVR@88@F6(TDDDNNJV\XZdttx‡TcfžÓßâè…éæäããâáàßßßàäæäâããâãã…â ããäääåååä„ã(äããâáááàÞÛÙ×ÖÖØÚÜÞÛÚÛÜÝÞßßßàààâãáááßÞÞàá…àáâáà„ßÞÝÝÜÛØÖÓÐÑÖÙÚ××ØÖÔ‰†€”ƒ~Š…~ˆ„~~||}~‡}||~‰„~}~‰‚~‡~‘…€~“‚~„•€ªŠ€“ƒ~ú€€ƒ‹‹ƒ‡tprjI¢ÙÊÔÂË»Ùíïëׯ›µÇÙçëÅí|§µ›±­ÁÅ¡ÓÛϵ«³­ýíõͽ—¹«ÅÅÉ£áñƒ££³³ñљљ«¹§µ»§ƒÙÁÁ×ïõç×Ç¿õåéí¡‰‘µ×çéåÓÙ¥Ïí‚÷£­õÍéëåÙÁ¡·Ï€Ó½›¯ÓáŠ‰‰ï©ù³§—™‹•‹‡…•­ÇÓÑÃíÕ‹ÉÑéý„…Š‡………‡ˆ‰ŠŠˆ„…ˆ……„„ûíɯ«½Éÿç­ŸŸ»ÍÓ¿­±±©§¯Ùëñß×Ï·“…“‘¯ÕÛÙÕ½¹×÷„Ž›¢¡Œëßë•–‘…¯ùñùõéý¥«­£—•©¹·……éÕ¥Á³›“›«·ËéïíÃòøô†íìëëìëëêééèççéèçèèçèèææççç‰è†çæåäääãáÞÜÙØÙÜÞßàÞÝÞÞàâãää„æäâáááââãääâââáßÝÝ…ÛÙØÚÛÚØ×ÓÎÌÑ××ÖÖÖÔ΀¯§›«¯½Áy¼åáïç¡ÁÏÉÇ·Ÿ›¿ÅÏÓÍ¡õ™ÉË›¹½ÑÅ—¹±›ƒ…‹…éÝɵ¥~•™™‡‰fH@Áh~vplp±p±|‡ƒ‡…dáÑ©«½Ã¹­¥Ÿ™‡íùÍ¡t½ƒ‰›­µ·«“Tx훩«YZ™fx¹¥¯§›—•¡€›n‡§­§KKMLG…`tÁ‰xRV``\ZRZdl~““ƒ¡•j¡™¡«UTRPOOOQRSSTROTWXVVUŸ‘‰‘—›Ÿ™rt…“thz~x~~¡©¯«µ§‰\^v~¥ÓßÙ×ÑÏáñz…‰„n³©³x}~s•Á±¹µ©Åt‹‰|n"lz‰hhÁ¡l‰vlpr…“£·»½Ét}µßåçêêëìì†êéèèçææ„å -ææåææåäååå‰æ‡åäããâáÞÝÚØ×ØÚÝßàÞÝßáãåçæä„æ äâáááââãäåææå„ä…âàßßÞÞÛÙ×ÑÐÔÙÝÞÞßÜØd¯£—“§ÍÍßÝŠÈòãêé—«³«›‘t|§µ½Ã½“ݹ±vd•zjZ`\b`­±‰tdHT:@>D( X>J..:(‘¡¡dNJ<<@H6‘‰|hx‹‰ztl^^L…•¹­p^„V€Xf`24‰dtl2-Z>H‰rNX^DZnxhDZ\nbZ&%$# @6D*0pHLZN@DJRXj|vx‡Uhj¤×áäççèééçåãáâááàßßßàäæäâããââãáá„â‡ã‡âáààßÞÞÛÙ×ÕÓÔ×ÚÛÜÛÚÛÜÞàââáãããâà†Þàáá„àâãâáßàßßßÝÝÝÜÙØÕÏÎÓØÙ××ØÖÓ‰†€~„„~‰…~‡~|}…}|}~ˆ}}~Š†~‰ ~~€€~~…€~~‘‚~…”€ª†€ƒ„€†~‹~}~Žú€€p•‡ƒrlfjCwºÉ̦½«ÃãíåÍ­§¿ÍßëÙ§v‡¥¯‡½±¹É£Ëɽ§¡¥£—ýí饱£Ã¹ÅÇ©É¡‘¹•§µ©É¡•õ•§¹±­­õ…ñ¹ý·ÅÛûƒéÇ©…éùíÕ•­Ÿ©ÁÙåãá³Í¹É·Ûù‡ƒëƒÑ¥¹ëíå×Á™³Ï€Í±—­Ñßéÿ„††Ý‡É››‰‡ƒéõùƒ…‘·ÑÙ×µáÑÁ×é÷ÿƒŒŠ‰ˆ‡ˆˆˆ‰‰‰‡†‡‚‚ƒ‚ûóϳ«µ¿ñã­¡©½ÃÇÁ¹¹µ©¡¡Íå鿳Á³ýí£ËÛßß×ÁÁ჌‘š£™‚çáÍ÷ ¦“½ýåááÙéý§©£›%¡±¿Ç·ù‰Åƒµ¿¥““£Ùëçåý„‰Éðóòëëìííìëê„ëééèèççéèçèèçèç…æ ççèèèçæåå„ä1ååäãâââáßÝÚ×Ö×ÚÜÝßÞÝÝÝÞàâäæçèèçåãáááââãääããââàÞÝÜ„ÛÚÙÚÜÛÙØÖÐÌÏÓÔÔÖÖÓ΀›ŸŸ‰‡§§¯¿r”Êß楑“»ÓËÉ¿¯­ÅËÕÙÁ£Ç½~¹¹Å½‘·§~‡…~áÙµ‘©™—‰phPp©xzvdXPÁ‰Ù~…‡||¹dñÁý££ÅÑd_¯ŸzéýÉxxÅ‘‘—£¯±«|x‘Ñ¥­­XV‘Jph‘±©››‘—¡G—tj‡©«£›JKKJtNT¡nLHN™…•NVZh‰›™•p…‘f——£§­XUTSRQRRRSSRRUVUTUS¡™™‘••——rt„‡S~v|ƒzzŸ±µ—§©¡n½×ßßÛÕÙë|‚„ˆxc³·­Ý’ɵ­±©¹Í…vv~‰‰½\X…Z|‡vlhln…³½ÁËéz‚¾ááèé…êéèéêéèç„æ„å ææåæåäääååå„æåääˆãá„à)ÞÜÙÕÔÕØÛÝßÞÝßàáãåææçèèçæãââáââãäåçæææååäã„âáàßßÞÝÛÙÓÏÒ×ÙÜÞßÜ×€‹~‰»¿ÉÙ‚ŸÕßÛž‹…Ÿ±¯¥‘•©¯¿É·…p“­›Td¡‘n‡rZPZ\`\¡xPTJJ8@D< @h>2$$ á½\JLHDPRPJ…hPHL<>BF<@H2& páTRNRD6(``±rf`|‹>?rj`½dn…,p‰zl`b`d<@XRz:3*B h‡pTfpTP`n.`:4DZXRBDH@8,DD>0*PH0<&D@6`dZX@0D4`R\`d40/,+†*k+154dX.-XVRPNH@RR@HVNNRRVTRPZT>:Btdhz|‹«em±ÛÝäåå„æãáßááàßÞßßàäæäâããâââàà„á„âá߉Þ.ÜÛÛÚÙ×ÕÒÐÏÐÕ×ÙÛÚÚÜÜÝÞÞáãäääãßÜÚÚÜÞÞàááââáàâäãâ„áßßÞÝÝÝÚÚÕÐÐÑÐÒÖ×ÔÒ„~„†€~’ƒ~Š~~~}~…~}{}~„}|}~~†~{{|… €€~~~}~ˆ ~}€€€~}}–~}~„„~~~†‚~†€€€•~~~Ž†€…€€€†~‚~†‚~…ù€€©x£ù‘PNdxRjy‹¡ƒŸ‡©½··¡­ËÑÓÅ|z•­³‹ÙÕ³¿µ£¡›™“ƒñõÕ鹯ÁÕÏ¡éÑÁt‰©³½‡á|¹Ý‹—•ŸÕ‰¡Á±™¹ËÃñ„ƒåÑ闷§±ñ…©ë÷ùï㹽Ʌ£Õó††Í¥Ñ¡ÁƒƒãÁ±“•«€·±‹§Ñßï÷åãáãçù…±ñ““‡…‡‘…í‰ÃÙÙå×ýჽßíõý‚Š‘‘‹ˆ‡‡†‡…‚ûù‚„ƒƒíǵ¿ÇÓÕÁÁÉ»³¹ÃËÓÕË¥ýµ±Å…Í““Ã˵­©™µ×õ‡›•íÛù“¬†Ó·Å¡¹ÙÍÍñ›«±³'¹ÃÏÛãÛ×Á‰Ù项«™‡ÝåÇííñûÿ÷½çéëéêëëêëéééè„çè†éêêéèèçææçççèèèççæäãáá…à3ßßÞÝÜÚ××ÔÔÕØÛÜÞÞßààááâäååæçæäãáááâããääãããäâàßßÝÞÝÝÝ„Ü ÛÚÙÖÓÑÏÏÐÔÖÕЀñ“¯íl…©Éz‰‘¡¯}|…¿Í±­©¯½Ï××Å¡¯½­rÁí‘­¹«‹||~xnÍѥѹ—“‘‰dp…NHh•ÍÙzƒrZxH`ÁÁ•Ÿ«³Ã^a­z鱋…é—¹·µ±¯ƒ|©…£½½]\W‘@±¡§[U§£“zv1~np«£—‹‹|…\¡áf`RT\\XXT™\—¥Ÿ‹™Z•¡§­ZYZYXXRQ„RoUVT¥©VVSR¡‘‹‹‹“•……“‘“—‘hp½“‘l¹njj«·¥£«©³Ïåí||zbbÅÇ—ñ‹šp³­¹‘µ¡½‹‹‡‹‹“¥“Xx‰r‘…pjµ½§ÅÍÝéýý¿æåèçèéééèè†çææååäääåææåääãâââããäääãâáààà…ßEÞÝÝÛÛÚØÖÔÐÏÒÔØÜÞÝÝàââãääåæçççæäãâââããäåæçççæåääâããââáààßÞÝÝÚÖÕÒÓÖÙÜÛ×€Åx—Ùp‰~«Õ„’š¢¦sdn¥…“¡©µ¹±§‘‰~‹xF™í~xxfD88,*2,*($86\bX\R@<*VTZZ\1/0//,+„*|+010\Z0/-+XRND>HNHP^FJRTRVVT<,lfhX8l:4>:>BBtx|\Px^RH<0‘\J@<&P™J>:p8(p`Á¥tdlpr~pZ™±n‡lVRXv|rjff6$ptzprn4\6 `™‹h.VX^LDH€:,:LbTJ#FB2"((X‰JF66B26*&(hNZVRN,0…árfJ8::>>xpxxL@‘dTN@@p¹hPND4 á…J@xtH((¡`¡‘±ƒjjhnn>L©XNLZfz~tjdhd\X¡•vjnbXH20dzd,PPVH6F+8,28VZXFFD4&( 0l|\>848*,**6@\ddXP4FHD4hH‰VH6@NZ\T^\\n…¡¯¯ŸLtx›…‡‡gmhß‚“XH`•p`hHNJJDHRRJHTXH(HBZP>hhN‰¡™»gÈÛàßáâããßÝÛڄ܆݆ßÞÝÝÜÛÛÛÜ„ÝÛÙÖÖÕˆÓÒÑÐÍËÊÆÃÄÇÎÔ×Ù܇ÞÜÛÚÜÝÝÜÜÞàãåçåãäääããã‡áà„ß ÝÜÚØÕÑÍÍÐÑÐ~~}}~•‚~†‚~‰…~}~„~}{}~…}|}~~~~}}|}}}~ˆ~}~‹~}}~‡~|~€“…~‚~„‘€‚„€’~~~~~“~…€€€€‡~Ž~„‚~…ù€€ÝѹXxFƒ•¥»¿µ¿»·¹¯¥§µ£Ÿ•«Á£Ý½±rÁÇÓÃù±‘…»¯™‘Ÿ•“õõíٕ鉽ÅÉ©¡‘@Á“±±¯§“ù™ñé™™‘‘h™­ÇÙ××ÑÙׯٹ™|Ù‰‰•ÉÙåïñå½±‘™É•½ÙÛÏ¿“éÑá×ùñÛíµù•€¡©ËãçùõÓ³¿ÙÅåÑõ•›Ÿ¥›‘ƒí™ïÿùé¡áñ±Ïéÿ…ŠŒˆ………†ˆˆ‡†…††„‚ÿŒˆíáÛ×ÑÍͯ‰¯ÑÕÅÅÉ—åáíù‰¡µµ«µÅǽ±­©£³ßïóçÁÁÅýÁ†Œí†Ûɉ¥ÍÍÑÙù™±.ÁÉÕåïçßÝÙÉ¥‹›¹­ñù‰Éÿù‚ŒºÙàãääæççåäãããäææçççèé„ê‚ì„êèèçç…èæãáßÛÚÙÙÙØÙÚÚÚÙÙ×ÔÕÒÎÎÒÕØÜßáâáá…à ááâãâââãããääâ„áƒà„áààßßÞÞÞÝÜÛÚØÖÓÏÍÏÐÍ€Ýéõ©z¿ÑÓÙÙÏÕﯹ·­¥§¥¹Å£Ñµ¹‰¹¹¿«Å©½‡›vttxpÑÍŵtÑŸ›zTháÁ•‡‡|hh@¡ÝzvÕ™p¡á‘¹‰±½Á¹­©­±¡¹É…Áx£½¹»·µ±“‰¡éݯµ§•j(‘í³±T§Ÿ•t©v€zznhz‹‘“ƒfl…­™p±db^^JFF¯U­¯Ÿn…™z™§§RQSRSSTTUTRPMQSSSVW³Z\YSN—““•••—fp‡Ÿ…“p­­½Åt‡‹~vp…‘“›™§­¹ÑÍÉÇrÑÉŽ³¯w{víŠÝÑ|¡¡™¥Át~<‡‰‹‘—›Ÿ¥›“xfr‰‰|åÕj­éí¼ØÞáããäååäãâáââãããäâáâãäääååäääãááàà…áßÜÚÚÚØ…×ØÙØØ×ÕÓÑÌÉÉÌÒÖÚÝßááá„àáâãäå„ä‚ãäãâââááàÞÝÛÙ×ÒÑÒÓÒ€ÝÑÉxÉÇËÃÅÁ¿Ç¯“‹££‹r‡—±µ|‘|‘z••™………ÍldfR@DBD@LRPZZ)*+*()*,--*)&)***.2l9;:2,R…P\RD8HXj^@>T@P\|\dTFHJTRNZ\d|‡‰™¥©X•›‹…‰bhcÓ‚Ë‘8Lxxh\dBPRJHLPHFPVN:0@ZT@dd:v¯±`n¤ÌÛÝÞÜÝÞÞÜÚ„ÙÚÚÛÛÛÜÝ݈ßÞÝÜ„Û ÝÝÛÚ×ÖÕÓÑ…ÐÑÒÑÏÎÍËÉÃÀÀÄÌÒ×ÙÜÞÞÞ„ÝÛÚÙÚÜÛÛÛÞàãåçåã„â‚á„ã„áààßßÞÝÜÙØÓÎÌÍÎÏ„~}•ƒ~…ƒ~‰…~}…~}{}† }|}~~~}||}}Š~}}~~Š~}}~‡}|~€„~Ž†~‡~€„‚~„“€…€‘„~”}~„€€€€ˆ~’‚~„ú€€¥ÕÉ¡z™Ÿ·É˽³¹»·©©¯·Ÿ‘‡©µtѽÁŹý­…r¡§¡™£•‘ƒùíÍ…‰™»Å¿“™`ñ›·µ­ù¹Á©‰‘Ñ‘@ `p›Ãçû†óÕËÁ•¡Åñ…ƒ¡Ëåçíïß©ÙXhµñ«ÇÍ¿³…áá›×ù‰×»Å•Å€§µ³Ÿ™±ÅÏíïɧ·íÕñÙµù™¡™ýéÕ¡÷‚ñã«ýùÁãýˆ‹ˆûûû†‡…‰‡…„ûÿýˆŠƒëÕß×ÏËŧõñ‡±­¯¿¥ƒíùý¥Áǵ«¿ÅÅÁù¡­í‚óó‰p³Ñ§í…áÁ}ÝÑ…±ÍåÝáõ•"­½ÇÝïïãß×ѹ—™³±™ñýõ§ý‡…šÊ×àÝâääååä„âäååææçèè„ê‚ì„êéèçæç„è æâáÜÙØÖÖ×ÖׄÙØÕÔÔÏËÊÏÕØÛÞàááàà†ßà„á$âããääâáàßßßààááâááàààßßßÞÝÜÜÙ××ÑÍÍÍË€‰Õå͹·×ÕÛÏÑÉù­³¹»¯Ÿ››™¹½‡¡Åz¡Á»¿³éÑÙ…‘“zxprrÑlÅ©d|‘™lPpÑù‰‘‹‰t¥8@¡x~zÅ™pÁ¡…“»ËÓlÁ­«£t`‰áÁÕ|‹«¹¹¿»µ­~¹‘ÑÍñŸ­¡™•\ ៫«QŸ—‘j|l€tv|pjnr~…‹‰d‰•±™µbb^VH‘©“¯QS¥™x¥h“££PPQNN¥SRQOMQSRQ£±[_Á`XS™•“““‘|Á½`x‰~v‘d¹ÅÉv‹“|ft…‘¡©«¡¯ÙkÉÕÉ™ÁÓ—tÓuÑË…áÕ‘`¡©©¥½n…‹‘•››£™›‘rp‰éÙ¹‘焆Ì×ÞÛáâ„ãáàààßßß…áãäääååäääãâáàßà„á ßÛÚØØ×ÕÕÖÕÖ×ØØØ×ÔÑÑÊÆÅÊÒÖÚÜßàáàà„ßá„âãääãã…äãââ„äå…äãââáàßßÝÛÙÕÑÑÐÑ€¥­­·ÕÍÍÍÃÇÁ³¡£§‘pt~ƒ£p|™Vv‘—¡¡ÙfVdZJJBBxX 8b`RRD4H@XVJJJL ‰@:6t`áÁPXXl™™LhlvV8¹••F^‰‰~…bh`Á©©`n^LB4©VHt1J@FXXBTd`Z¯bc|´ÊÛØÛ…Ú„Ø ×××ØØÙÛÜ݈ßÞÝÝÜ„ÛÜÛÚÖÕÒÑÐ…Î'ÐÑÐÎÎÌÉƾ»º¾ÊÒ×ØÛÝÞÝÜÛÛÛÚØ×ÙÚÚÚÛÝàãåçåâ†á…ã†á ßÞÝÝÛØÖÐÌÌÊÍ„~•‚~†ƒ~‰~„~…~}|}…~}|}~}||}}~„€…~}}~~Š}}}~~†}}€„~Ž†~… ~~~€€~~„…€ƒ‰€€€€€€ˆ‚~ˆƒ~€}~…€€‰~‘~~~û€€ýzz¡­¯ÁÁ½»¯µ¹­©¯³¯‘Ù¹«Ñ…xŸ»Ã¿Á¥ñµ©t™¡£™™‹ƒƒõÅ…™™»Ç»ñÙhHᓱ·³©Ñ¡Á“`PP@xŸ½ã‚‡†ã˱í™htñ‡‡¯ÍãïííÛ—¹¡`¡Ñ“»·µ¥ñ™•·Ù÷õɯ¯ñƒ€«½Á»·»ÅÁÏѽ§·•ƒ‡‡ƒ‰‘Ÿ¥£éÑÍ«íÿ‚ëÕ±ƒ·åÿ†…‰ƒ÷óóù‚…„„††„‚ûåóÿƒ†‰…õÛÙÑÅ¿½©õÑÅÕ…—™£™…õñõƒ½Í½›¡±ÁÉÍ͹£åýõ¯`xÁï­«÷×˽ÙÅé…½ñùùÙá™·ÁÙçéÝÛÙÓ㙯±¡‰ñ“󋆨ÑÙàÛáâ…ãâáàáâãäåæçèéêêêìì„ëèèææç„èåãáÝÙׄÖׄÙØÖÔÓÎÉÆËÓ×ÚÜÞßàßß„Þßßààáâ„ã!ääãâáààßßßáââáááàààßßÞÝÜÛÚØ×ÒÎÌÊɀვ­ÓÝÛßÏÉÉ¿»µµ¹¿µ¥£éé³»õ›¯¹µ·¡ýéñ…‘™•ƒztrrlnÑ¥`“—‘±™‰ùƒ‘‰…rhP`¹x|x‘pÑñÙ¥Ÿ¯Çhid³©™½‰‘ívz‡«·½Ã»¹­lp±‘¡¹‡©¡›‹¥8­«§¥•‹ÁlbCtv…xljrttxvrhZXbd`^Z^d\N|…™“«£R™|^V^‡›POPN››¡ŸPPONMOQQŸ•±Åbba\V¥„•v™É©‘¡lvtƒ|jÉÍÑt…••…fn~™¡©©™£ÏÛÕs¯±¹Áë¥p—ÝÛã…¹½©h™©©­™©t‰‰—¥ŸŸ…lx……tl½|߇…¨Ï×ÜÙàáââáààÞÝÝÝÞÞßßßàáâãääååäåääâáàßà„á.ÞÜÚÙØÖÔÕÔÔÖ×ØØ×ÖÔÒÐÉÄÁÇÑ×ÛÜÝßßßÞÞÝÞÞßßààáââããã„ä ãââáâãäåå…äãâââáßÞÝÛÜØÓÑÏЀånf|©ÉÓÑÙͽÁµ­¡‘£©™xt­±“™Ñp`r~‡‡z©µÍ^X\VHF@@:DL|D@hfXV`888pRRFB4 @¡L:2H@±Á`HTft‡FFHnhn‘P…½NR^ƒ‰‘‰‰L(‘¹‰xPnZH8HpjLpbH<:X$>€PP:2,.462220006:840,,.((RRB|‰‘Zd\RN>>>DP`nrj£¥a•x«Å4p¹¹Ï~¡‰`@@|‰\PPX0>B8BLLHNTTJ44PTF64hP¯jf‰¶ÉÚÙÜØÙÙÙØ×ÖÕÔÕÕÕÖ×ÙÛÜÜÞ…ßàßßÜÜ…ÛQÜÛÚ×ÕÓÑÏÎÎÍÎÎÐÑÐÏÏÍÊƾ¸µ·ÆÐÕ×ØÙÚÙÙÙØÙØ×××ØÙÚÚÝàâãääãâááàáßàààáááàààßßÞÝÜÛÚÙ×ÒÐÎÎΕ~~~~‡ƒ~‹„~„~„}…~||}~„|}~€€€~}}~~‹}|}~~…~}~‡‚~™~~~€‰„€„ˆ€„…€ˆ„~†ƒ~’€}}~„€~~}‡~’~û€€¬É‰Ÿ­¿ÃÁÉÁµ¯±¹±«¯·­™rɱ‰£ñÅŸ»ÑÍÓ¯õÉÁÙõ›¥¡•‹‡……Ýù…ù·Ó¯¡¡¡±ñ‰¯ÃÇ¥Éá¡……í©Á0……½‘³Ûý‚‚ݹݡp¡ÉÁý…£¿ÑíÿíëÑÉá™™µÑ—¥³«ñ©µÉá÷á½³¯õ¥ý€³ÃÉÑÑÉǽ·³³¹»«¡Ÿ™£›¥­·“Í©¥­ëÿÿíϳ•……©éûû‚ûóñ÷‚ƒƒƒ‚„„ýñÓéÿ‚ˆŠŠ‰åÑ¿µ£¥¡å¹¡¥á‹‡ƒõñññ‹«Á½›‘Ÿ³ÇÑɹ—¥ù…„„±p±åû¹‰‘Ý·Íß—ùµ‘ñ™‰á¡Ñ™³ËËÓÛ×ÓÓÍ¿««­£‰íểŒ«ÓÛÝÚ…ßàâàßßÞÞÞàáâãååçéê…ìëèèææ…èæäâÞÛØÖÖÕÕ×ØØØ××ÖÔÔÏÉÆÊÒÕÙÚÚ݈ÞßßàáâãäããäääãâááßÞßà…áàààßßÞÞÝÜÚÚ×ÓÐÎÉÈ€¥½‘»Ûåçáã×É¿Áû½¿¿±Ÿ‘É廽ùá­¹½··•ÝÕéíý‘•‘ƒ|zzxpjn½¡xù™¡~t¡ÁÑù™“th¡‰jjÁ‘Á0™™©á™¯ÅÍeb«™½‘Ñé½é…±¹ÓÓÁ¿¥VH™µ¡hµ­«©Ÿ…ƒ‡Ñ…Ñ€‡‰‹zplxplhhnnhhlrnf`dllVhT`¯«¥“zbZ`r—•MŸM›Ÿ¥MNNNMMNQ¡±Ígii`]\©—“‹¹•…|µrttlhÑÙÝá|‰‡jfr…•£©‘Ÿåyxz·ÁÑåõ¹É‡Á¿éÝ~`¹…x¹Xf^¡x™r…™™Ÿ¥¡›Ÿ­£~px|xpÍͳ«Î×Ø×ÝÞÝ…ÜÚ„Ù ÚÜÜÜÞÞàãã…åäááßß…áßÝÛÚÙÖÔÔÔÓÕÖ×ÖÖÖÔÑÐÊÄÁÆÑØÛÜÜ‹ÝßßááãããäääãâááàââˆäãââááàßÞÝÝÛØÖÑЀ«³x«ß×ÙÕÛÏ¿±«§—›©©™vdµ›Í¥ƒ‡‰n•½µ¥XVLDBDD>NTDD0µnhR$X‰TZPN&`‘tF2D Á¡xXZn‰B@bVh@ ‘Ù‰\r—Ÿ‹r(`ÑtHhV\H28|ddV<86\$l€NJ@:64>2.*068<<840*&*2.$P\lf`RF:**.>ZX(L&LHJN&'''&&()NH@nCEE=:4T^RNFJFPDD@\>@DJH‘•©\NHL>44B>HPTXZNF>FFFB8l‡hs´ÉØÙÙÕÕ„ÔÓÒ„Ñ5ÒÔÕ×ÙÙÛÝÞßßßàßßÜÛÚÛÛÜÛÜÛÚ×ÖÕÓÏÎÎÍÍÎÏÐÏÏÎÍËÉÀº³µÅÎÓÔÔÕŠÖØØÚÛÝàààáâãâááßàÞÝÜÝßàà…Þ ÜÜÛÙÙ××ÕÖÕÒÑ€”~~~~†…~‹~}~~~„}…}{|~~}z|}~~~„ €€~}||}~~Š}|}~~~„~}~‡ƒ~˜ƒ~€€„ˆ€…†€‡…~…„~ -€€€}~}‡ -~~}}~~~‘~~û€€Ï¡Á©±ÉÍÅÍů«½Íµ©±·©ÍÕ¹‡¥•—»ÃÑÑ͇¹½Å埧Ÿ•“•““‰‹ù™ÙÉ­É£ñ¹é©—³¿Ã¡©Á‰ÅùýÑ‘Á@Ù…z‰¡Áßõùé¿—¹¡‘‘ɉÁÓÍçûíçËùщѭ¡ý¯¿»…ƒ×ßý㹩§ñ½‹€·ÁÉÏÍÇÇǹ¥§µ¹¯©§£±³¯±·¿£Ñ¡½µéýïͯ“……£éõõõ÷ù÷÷÷ƒƒƒ‚‚ƒƒÿñÛí‚…Œ‘Šƒå럓ƒÍ±­½ù‹…ƒýùù僛µ»›Ÿ³ÃËÏ»‘³Œ†¡‰¯~õ‘¯Ï…™ý‰íÁÙá“…¥&‰µƒ»ÏÉÉËÏÑÉÇ»«§££‹Ùz½…ªÓÜÛÙÝÜÜÛÛÝßßÝÝ„Ü ßßßâäæèêê„ìëèèææ…è æåãßÜÚ×ÖÕÔÔ…Ö ÔÒÒÏÉÆÊÒÕÙØØÛ„ÝÞ„ÝÞßàââäããäääãâááßÞß„àááàààßßÞÞÞÝÛÚ×ÔÔÒÌɀ͚½»áíéãá×Á»Í׿½ÁÁ­“õÅå¹Ã—¹»»·­h¡Åéù“‹ƒ~|z~rlrÕ\©É™Ÿz¡Áù‘ƒ—‘vXÁ‰ÉÍÉ¡pÁ@ቯÁÇű—x™Á±¹‰±ƒ¹½³Ã×ÇÁ§±HXÙ‰p駡‡P`r³§§•vppÁ•r€—“‹|pl||n\ZhlljnrvtljltfpLt•¯«T•‰t`Z`p›•—Ÿ›™£NNNMMLNQ¡•µgjmoddc·—xvd™™ÉvtrhfÑáéáv~…‰ndp~›§§‹«„…‚|§±¿‚û—•¥«‡§‘Õdf¹™thj‘3`‰f•Ÿ›››Ÿ­¯‘ttz~‡ƒÝÇ‹ªÎ×Ø×ÜÚÚÚÙÚÙÙØØØ××ØÙØØÛÝßáãä„åäááßß…áßÞÜÛÚØÖÔÓÓÓÔÕÔÔÔÒÑÏÊÄÁÅÑ؈ÛÜ„ÛÜÝßàáãããäääãâááàââãäã„äããââáááàßÞÝÝÛÙÓÒ€Ò–©¯åÙÛÑÓ˹¯¹¹›««“j¥™¹™£zr‡‡‡D\tµµRVTHDDHHFRVH\0nlL0‘ldZZNL.Áx©x`8 Á±ùz`hdv‡…~bL> `@p‘\p\‹‰x…¡‹pP8ép@D‰`R>.4`‹ldR402\<@€TJD>68B:0 &28>@4.20*(,4&Tfld1TD4**.:\VJLJLHJN'''&&%')PHFrHFIKBB>ffPPFH@XHHPpB@BHL•¡¥¥TLHN@46@Pfvdvbb_]z|­uÙpDxƒ\‰|‘HFhH™H4B@",6RRNNRX\Z\LB@DFHHxJ‘oŽ´ËÕÔÖÒÒÑÑÑ„ÐÏÎÎÏÐÒÔÖ×ÛÝÝßßßàßßÜÛÚÛÛÜ„Û -ÙÖÕÓÒÎÎÍÌÌ…Î ËÉǺµ·ÅÎÓÓÓÔŠÕÖØÙÚÝàààáâãâááßàÞÜÛÜÞàß…Þ ÜÜÜÛÙÙ×ÖÙÙÔÓ‚€’ƒ~Š„~Œ ~~}~}}}~~…}z}„~}z|}‹}{{|}~~‰~}}}„~„~ˆ‚~™~~~€ˆ€„‡€‡…~…„~Ž„€~€~… ~~}}~~~~‘~ú€€ÑÖ«»Ý×ÑÑÇ­³ÏÝ»£­³¥‡ÑÙµ‰¯·»ÏÕ×É«Ý©¥Åñ‹¥©£››•‘“‰¹¡™§»¡™‰¡Í›±ÁÇŸ¡Á™Õõñ­áÁ@Ù™£¥»ËßïóÕ¥ÁpÁ¡•ÓåùçãßÏ—‘x¥µ¡ƒ¹ÏÁ‰á§ßáóÙ«™á½‰€¹½ÇËûÃÓÅ­¥©­©¥§§·½»¹»½±ýÍùÁç÷ÿí¿§‘…¡áíëéñùùûƒ„ƒ‚‚ƒ‚ÿõåï…‘Œ„÷Û»™•‰ýáŹ½á‹‘‡ƒùõùéý“§³õ‘¯ËÝÛ¹™Í”Œùé|ã{Ùµ…çå››•…‡‘±…‰‹é"Ñ•…«ÃÿÃÃÁ¿»­­¥­·¹›õ…×£ÎÛÚØÜÚÚÚÙÚ…Û ÚÚÚÛÜÞáäèèèê„ìëèèææ…èæååáßÝÚ×ÕÔÓÓÔÔÓÔÓÑÒÎÊÇÊÑÔØØØÚ„ÜÝÝÝÜÛÛÝßáâãããäääãâááßÞ„ßàààßààßßÞßßÞÜÛÙÖÖÕÑÌ€ÙЊ·ëýõçå׿ÃßçÅ·½½§Ý±Ý»Ï»³»½¿­ƒ•…¡Ùý‡‘‘‰ƒƒ~~tltnd`™—›|…•¡‘•“…hÁ‘Ñͽx‘Á@Ù•›™©µ¿Á½©~•p±á¡ÉxxxÅÍ£•ÅÅ¿±vÁµhX,@ÁÙ…vnx‡ƒzT@@ `™XTN•—hX‹‡xB0hpTLNlZ<,\f…n^P4,*H<@€VBH@66HH>*&*462& .2,(&40,,xpj``R:.(*,<lL8>\" ,8FZZRV^ZZP@DBL^j^…T¯‹´ËÔÑÓÐÐÏÏΉÍÏÒÕ×ÛÜÜÞßßàßßÜÛÚÛÛÜ„Û ÙÙ×ÖÕÑÎÍËÊÊ…Ë ÉÈý·¹ÅÎÑÑÑ…ÓÔÕÕÓÓÓÕÖØÚÝàààáâãâááààÞÜÚÜˆÞ ÜÝÝÜÛÙÙ×ÛÜÚÕƒ€‘ƒ~‰…~~}~…~…}z}„~|z|}Š~||{|}~~Š~}„~…~ˆ‚~™ƒ~“‰€„†€††~†…~„~ˆ -€€€~€~Š -~}~~~}~‘~ù€€Ìå¶Ãh~zåáÛ·½Ï×·›£«Ÿ…ÍÑÍÁËÕÛßÏõÕ¡½ý™©«§££¡Ÿ™™““‹Ñ¹á‰§™Ù™™Ñ‘§»ÁÑÁ¡ÝƒÝñ‘0¡™¡¿½ÏÓÝåç¹Ý‘`@±p±ù¡íÏíÇÏÛÕÓ·¥¡t•±¥•ÁãÅ™ÁßáßÅ—‹éµñ€¯·¿»­¥»ÇÇ¿¯¡¥¡¥©³Åǽ»··‘剿åõõÙ±Ÿ‘…ù“Ïáéãë÷û‚…„„ƒÿƒ‚÷ç‘Ž÷ãÓ±‰‰ýáÝÑÅÅé“••‹ƒõíñåí©‰í‰¯áý㱡㘊‹ãÑ·}µ¥·ññÁ³¡ƒ‹‘ÉéñÅù“"õ™ù¥á™±··Ã³­µ¯³¯¹ÃË»©±“Ä×ØÔÚØÖÖÖ؅ل×ØÚÞâåçèéëìììëèèææ…èçæåäâáÝÙÖÔÑÑÒÒÑÒÑÑÒÎÌÇÊÐÓ×ØØÚ„ÛÜÝÜÚÙÙÛÞàâãããäääãâááß…ÞßààßßàßßÞßàßÝÜÚ×Ö×ÖÏ€ÙޫɆùñáËÏááÁ­³µ¡Å¥íÏãÍ¿·»·z©pxÉý•‘‰‰…|xntptház‰Å‘‰•pƒz±Á™Ùn¡x00᛫§±µ³µµ—¡P¡á±‰ÙéÙ»Ó¡tµÁ»¹`…x•‹«§z`h•©«§‘pff•Ñ€™™rXZtƒrd^VR\bhpj`\jz`•jŸ©£ld`Z±n‹‘“•¡MNOONL—KNSR¡¡·gkqri¿¿»§xtÑ­©¥©Átz|~nfÉÑÙáípv|`™Z~«É»›ÛŒ}~ÑÕɌٽ»Û»§£zbd\l‘`©¹Ýt|!½\‰`•t‘‘—›™•ƒ‰•­»µ¡‰±‘¼ÑÓÓ×ÖÕÕÔ‡ÓÒÑÓÒÓØÛÞàáâäåååäááßß…áàßÞßàßÜØÔÑÏÏÑÑÐÑÐÐÍÇÅÂÅÎÔØÙÙÚ„ÙÚÛÚÙØØÚÝÞáâããäääãâáááâá„âäãâããââáããâáßáàÝÞÜ×€ØÙ£¿ƒzãßÑÁÁËß‹Ÿ‰b…ůÁ›‰…vP\D44‘µZTJNJLPPFZ\N60‰XVJdP`llNHJL:Áx¹6H @¡||p‰‡ƒ|vHH`@±h¡¹p|‹›b6|‡~b0(Td\X^vh:4>fphXJ422P8`€LBF6$*@DF@6*,*$,42*&.4$8@nh\XB*((*P4LLB@FLL&'(('&H$'*)LRtGGLOK‰…ƒ\8(±th44 T @,@BRRR^\RJ@FJTfrpbT…{«ÈÎËÏÎÍ͇ËÊÉÉÊËÎÒÖÙÛÛÝßßàßßÜÛÚÛÛÜ„Û ÚÙÙÙØÕÑÍËÈÈÉÊ…É ÅÀº¼ÄËÐÑÑ…ÓÔÕÓÒÑÑÓÖ×ÚÝàààáâãâááààÜÚØÚ„ÞÝÞÞÞÜÝÞÞÜÙÚÙÛÞÞØ€€€€€€ƒ~ˆ†~~}}…~… |z}~~}||{~‰ -~}{{|}}}~~‰~}„~Žƒ~™~Š~ˆ†€„€ƒ…€†‡~†…~„~ˆ -€€€~€€~Š ~}}~~~~}~~’ù€€ÌØÄÓr‡ïݽÅÑͳ—›‘|¹¹|¹ÇßÛÛÙ¯õÕÍ•µ…­±µ¯­§™›—•åñáÙõ­‘͇‘‹¹ÁÁщ“í±ÁP™å³ÑÓÕ×ÝÛã£á¡@Áñ™™Ñ¥ñÉñÍ™Íá×Õ½©™Éù¡½¥ÅçãÃË××Ñǧ……©Õ€£±·©™£·ÃÇ·§Ÿ‘•¥«¹¹»»³·“Ùƒ»áóíÇ­Ÿ“ƒùÃÙßçãóý„……„ƒ‚ÿýƒƒýëëÿ‡‘•ïÛÏÙÙÉÉÍÝÕÍå…›©¥“‡ƒýíáå—‰“¿û†Ù¥£Ù–ƒÑ—åã„¡ÑßûïÍ»åùƒ‹ƒÁñÑ3¡‰å½¹Ù‰›¯µ±«³±µ·½½ÏÝÝÃÍ‘¼ÓÖÔÖÕÔÓÓÔÖ×ØØÖÕÔÔÔÕ×Úßäåæé„ëêçæåæç…è çæåãâßÜØÔÑÑÑÒ„Ñ-ÐÍÌÉÌÏÑÖ×ØÚÛÜÜÛÛÛÚÙÙÙÛÝßâââãääããááàßßÞÜÛÜÞßàà…ß ààßÞÝÜÛ××ÖЀß׸ч™†ÿóÝÕ×͹§«©›‹½¡‡ßëÍ¿µ·‘¥…lpɉ‘™…~xvppn¡¹¹txÝ©‘…™hrph©ÁÉ~x¹`¡±í©½¹µ±³§«x‘Áñ©Áé©ÝµÓ§x³Å¹³™t‰áÙh¥™­©‹“£¥££‡rnz\p¥€‰“~fTVd~‰|l\PR^b`jd^^t~^…b›£¡•nhd`X©h‰‘‘•£ŸNMONML—™OTT¥Ÿ³Ónrsm¿¿»Í½¥¡¡©Ít‡‡xhbÅÉÝåprxl^`ƒÁkµ‘›×t»‹ùù’’»ÕÑßï¡z­½`j^|Xñ¹v'x\ltlƒ‘••‘…‡•¡¯¹Áǹ͎´ÍÑÓÕÒÒÒÑÑÑÒÓÒÑ…ÏÐÔÙÝÞßâääåäãààÞßà…áààááàÝÚ×ÒÐÏÏÐÐÐÏÎÍÉÆÂÅÌÒ×ØÚÚÙ…ÚÙØ×ØÙÛÞàââãääããááààáááâáá…ãâãããäâ„áÞÞÞØ€àұώ†|éÛÉÅų›•‘~fxxr½Ã—trTL0@04b^\NRRVRNBTZN:DH‰|H>tXLLXBB80@`Á±n@X`p`¡xƒ~‡|xnn>(P@Áx±•‘ƒ—h:v‡xzh@ x™TplpfLJ^pf\N>20880T€PL@0$$2@HNP()((&%HH'++PVnLRVQ‰‡ZdhXTLPThBLPLNLJ™¡¡PNJ>6.JWpx³|eŸrÙå…ƒ›‘§¯‹plXhx::.TX™\:@@2P80H:JX`\PHBJT\fnv…ƒ|«ÅËÈÉÊÊ„ÉÊËÊÈÇÇÆÇÈËÏÔ×ÚÛÝßßàÞÞÛÚÙÚÛ…Ü ÛÚÚÛÙ×ÓÐËÉÈ„É?ÈÈÈÄÁ¼¾ÃÈÎÐÑÔÓÔÔÓÓÓÒÑÐÑÓÔ×ÙÜÞßààááàßßÞÞÜÛÚÛÜÝÞÞÝÞÞÞÝÝÜÜÚÚÚÜÜàßÚ€€€„€Œ‚~ˆ†~Ž~}}~…~„ ~{z}~}{|}~‰ -}{|{|}}}~~‰~}}}~~‚~™~Š~ˆ†€€€€„„€„‰~‡„~ˆ€„ -€€~€€~† ~~~~}~„„~‘ù€OÇÏÂÏ’³¨šŠyË»»¯¡‘‡|p͹‰¹Áçã×Á‹éá¹…‘á—¡±³½»±‘“—››—á™ñ±‡‹ý¹|Ù½ýñ©‰ñÁÁé‹—å‘¡‰±…›Ã„Ù€Ó½ÑÁ`0‘‘¡`x~»×çÛÑãùÕ•éá¹ÙÝ«Ãã÷áßÛ˽¯‹ñƒ‘¥¹•¥±«§§©­µ¹±§§£«©³¯§§¯¯«…ɉÉãõëÁ½±§“‹£ÇÙßïáïù‚„„ƒ‚ÿõý„…„ñß÷ˆ’š‹åÕÅÍéé镽ÝùÝÕŸ±­¡•`—•ñÁÉÙí…Ÿ±Ñõ½—“‘³•™©|}õóùݹ³™ÕÕ僗‰¹ÙéÙ‰Ÿ­±¡‹…ýý™§«­­­¯»ÁÉÝííéÿ–²ÌÒÑÐÐÐÏÎÏÑÓÓÒÑÑÐÐÑÒÔØÝàâæè„ê èæäååæèéé„èæäâàßÝÚÓ…ÑÐÐÏÍÌÊÍÌÏÕÕØÚÛÝÝÜÛÚ„Ù ÚÜßááâãããââá„àÞÛÙÚÝÝßàßÞßßàààßÞÞÝÞ×ÙÖÏ€âֹǚȳž‚ßÁ¹³±¡™•‘…ÝÍ—ÓÝÿµd‘‘`|í•“—‹‹‡vjnnprn™l¹‘pvÙ¥ù™ÕÉ…`áÁÁéƒ|¹`Á™½‰—±Á»µ¯¡‡…¡‘Á‘±“»ËÍÁ¹ÅÙ³n`±áѹXÅ¡­£§©¥›•™tÉnxl|€nvpllnv~…zlbXbjhbdbfnxtHhd¡¡‘jnhj^Vx•™“™Ÿ¡¡OMNMLK—™¡UVUŸ©Íptwo¿»³ÙñÙщ¡½½Õz…‰‹‰vnj½ÁÉÑÕptz~™cÍ£‹“»—•¹Š’•ñßãÅ£›|¡µÁddX¹ÙÁv3ttzpd`ÁÍ~‰‰‡ƒ‡“Ÿ­»ÅÑßÿ“ªÇÏÑÏÎÍÍÌÌÌÎÎÍÌÌËËÌÌÍÑÖÙÛßá„ã áßÝÞÞßáââ…á -âàßÝÛ×ÒÎÎÏ„Î!ÍËÇÃÅÉÑ×ØÙÙÚÛÛÚÙÙØØ×ØÙÚÝßàâãããââá„àááâáàáâã„â ãããâââáâÞààÙ€ÙÉ­¿¡¾¬–ƒuÉ­¥™ƒvnfX••±¯‹|lZ4PP< 4¡h^XLPTRD>:HVPDT@‰XB8t\4HHxt4 ÁÁÑrDX@hpVVr‡ƒrjfV@`00@0p|‘‡vph<>H hD‘lf\ZVbhXHH6X2D@$<€BJ@866868>@@<..0*(**28@2h\TL.,>,$:FH@J‰…HRRLRNNXFp…‰DFJLRz¡‡l|v|t±½x‚xvp¹§zT^RXdld02\P(`62@NJJ-8`BD:(DDH8LJ< xB><0dJp0(ÁÁp\> ™¡xJFLbt`HP@0Á@``0t­¡‘xlnzƒp`|h0`h<`pb\\\ZVPLb`0LT,<0:@DD@:8:6688>@<62*&*686,HLRH8\>HB:0"$.&0>t VBD0(`©R80@@ÁZD ÑÑJDHN`hR6D@ÁÁÁ`ÁÁPdl«£‹nbh8?`d`@PX\hn\\`pf^^blPXX±tXXQDLF@:660,26:<<40, "*42,"&,TRF<,$0Z2LRPPJHJHFJLFFHHHL)-.-`^…Z[Z``|`8PdttX\RT`\JH„JpN•¥•™L^fd\f‰—~rƒÅçÝÁ¹­••zŸnÅű\d\Xd<@@0(8,<2LF@HPJPdDB:>@FJTf|Ÿ]et… »ÁÀ»¼¼½¾¾¾¼ºº¹¸º¿ÃÇÉÌÎÐÓ×ÛÛÜÜÛÙÖÖ×ÚÝßßßÞÝÝÜ„ÚÙ×ÖÒÏÌÌÍÎÏÎÍÊÃÀÂÇÑÓÕ×ÕÕÓÑÒ…ÓÒÑÑÒÕØÚÛÛÚÛÛÜÜÝÜÜÛÛÚ„ÙÚÛÛÜÜÙ×ØØØÙØØÚÛÕ€€†€„~“~}}~~|}}~}}|z{~}|}~ˆ ~|{zz{zz}ˆ -€€~~}}~~~‹~}…~£‚~„€ƒ…€†~~Š„~‚~„€~~„~„~}~~‡‚~‹û€€â°½£ÁŶÆÒÓ秛•¯Ÿ“~­¡õÙÉÉñ§·ÃÉÏÏÉý·¹±‰ñõù…ÉÑÁé‘•™Á¹ñ‡‡¡ÑÁp`½‡ý•¡©õ•Ÿ§¡£­ÝÁ¡00ÁÁÁ¡«Áíï÷ù÷‚ó÷Óíʼn…‘¹‡‘•ÁÍããáÝË¥±á«›‡…€•¡µ³¯¥™©£ñá‘——ÕÝ•£Ÿ…µõ³áã×ÁÁÑɧÍñ¹áû‚ñëééëïõõó÷÷…ˆ„ýçÛ†——†ŒÉÉ¥¡Ù™¡Ÿ™“‘•‹‰ýŸ±«§±™‰ý››—éå“™‡dz||„™X…‹pµƒ‚‰éµ™ÝÑé———‹Éù‰O…™…³«³¹­Ÿ§¯³³§¡¥£©¹ë—™ž®Â»½ÃÃÅÂÅÅÄÂÃÄÄÉÍÑÓÓÕ×ÙÝáååæèåââáâäèèéèèæåääãââàààßÞÝ„Ü*ßâÛÑÎÑ×ÝßßßÜÛÙÛÚÛÜÝÜÛÚÙØØØÚÝÝÝßÞÝÝßÞÝÜØÖÙÜ†Ú„Ü ÝÞÝÞÝÙÙÕÑ€Õ­ÏÃåäÚäÞÉÕ£¯³£Ÿ›‘…£ÅÇ¡Å¥™•½—£©¥Ÿ™—‘‹……tZV©ÁÅjd0PÕ…‰tp¹©é|z‰±Ñ¡±våH`ññ…‘›‰‡Õ‘`00ÁÁÁ±¯¯ÇÙÓÇ·ZÑÛ·µ•±‘©~‘“­¯³³©›‡r`™½ƒbV€dv|ztldjjzr…¡fflfűpld\b‰Í—•›zx—z™µŸ«PK›““•“™——™›RVX»¯¡gs{zs¹µ±±±í¥Ÿ™“‰…ƒõ“•‹~évƒ‘‘‘‰íí¥½¯…‡~Œ«á‘˃}™ñ…j©±½lnrn‘X8JXxf‘‘‘…ljt~ƒƒ~…‘›£Çw}…£¼À¿ÄÇÆÆÅÆÆÅÃÁ¿¿ÄÉÌÎÎÐÑÓÕÚÞÞßáÞÛÛÚÛÝááåææäããâáààÞ„ÝÜ…Ú<ØÓÉÆÉÑÙØØÛÚÙØÙÙÙÚÛÚÚÙ×ÖÖ×ÚÝÝÝßÞÝÝßÞÝßßààßÞÝÝÝÞÞßßßààâàááâáÞÚ€Ù¥©§ÕÚÎÖÒÄÇz‹“‡zpfZ\v¡¥|…hXXV\ZTPPD>6.>4&(HP\86@ LHB$ PlµF6Pdh ÁáHHRTZdddÁÁ‘ÁÁÁ`‰ƒr…~|hB~nfp8h©T8tnxldVjhhtrX`©…XB>:60:4DP`6l@ •PLH0x‰­B4`p`b8 ©ÙTRPRRZJ4`Á `ÁÁl•‡‰|›ƒn|lx@P¡ X¹tnbXffdlf8±JP:FJ€FB@@<62(&*(>D>4D@62&&H pdVL>28@:$DFZV(&JPPJDFLJJLN*,2lbnT^cb^]~­•tPnlllnjr`P|NZ\ZXPTRVZd``Z‰f•r~†ˆ„`‘zÉ‘×|±jPB862D$ @>BDHLH„D:JLFBL^d~S^jr†Ÿ²¹º¶·¿½¼»º¸·¶·½ÅÇÆÆÇÉÌÑÕÙÙÛÛÚ×ÖÖÖ×ÛÝÞßßÝÝÜÛÛ„Ù‚Ø‡× -ÖÐÆÃÂÆÐÓÔ׆ÓÔÕÔÔÑÏÎÎÐÖ××ØÚÚÙÙÚÚÚ„Ù ØØ×××ØÙÙÙ×Ö„Ø×ÙÜÛ×€€€…€…~Ž~~~~~}}~~|}~~}{||{~~|}~‡ -~{z{|{zz{~‹~~}}}~~~Š‚}‚~„‚~„ƒ~‰~~€€‹€€€†€„~Š~Ž‚~… €€€}~~€„ƒ~…~~}}~’û€€ÁäÅÇ«¤ÀÄËÔ瑃zx~z¯»£õáÝÙõ¡¯µ½ÁËÇÿ½Å¿›íùùÅáù…•Ÿ¥ñÑÕùý…™Á±¡`µ‡õ©™¡ñ§¹¹©“ÝÉÁx¡ÁÁ`h£×çÓßçÛÕõ÷ÇÝ­¡±Á‘©™É‡­½ÙãçáËõ±…©¡•“*™¥©§¡›•“Ù‘•­•ñ…Ÿ‹õÉ…·ÙÙË·¹Éɱáá§íõó÷„é€çãéëéíóƒ‡ÿëÝÝ‹•’ŽÝéÅñ‰£±¥›Ÿ¡¯‰ÕÉõ£¯±¥¡¡¡¥£‘‰‰ÕÉxvl‘鄇}¥pƒµÁp—󳋷§ýÝõ‹‹©­“á™Åááåõ­³µ»½½»­››³·Çåÿ–£¥£¯º¾º¾ÂÁÿ¿ÀÄÉÑ×ÖÕÕÖ×ÙÛàäåæèçåãââäæèèèççæååä†âàá„â)ãäßÕÒÒ×ÝßßàÝÛÛÛÜÜÞÞÝÛÙÖÖÔÔ×ÙÙÚÜÜÛÛÝÝÝÚØÖׅ؆ڄÜÛÖØÓЀá䯧µÅçäÜÏÏ…›¡±¯¥‘‰¥Óϡ͹µ±Í™Ÿ›••‘‰|jF>H¹Åf½‰H¡‰¡ÑÝññvxÁÑ­zÕTxé핧«™ƒl͹Á‘‘ÁÁÁ`‘©ÅÉÑÕ×É·Íᯩ‰™ÑÉñ™Ñ‹Ÿ§µ½¹«‘|~“‹vl€nrrxtnhbj`t$`t‡xjÑftdN‰‰pjjj…‘~…xn­¯££™—•—™‘—™—›ŸTX³±§§oy~{~ÍÕÁÑp|•§§¡Ÿ¡¡¯‹ÙÍñ…•Ÿ™‘‘•…ƒÕÍ‘Åýˆ†·¥™ÁÍ•µ¡÷É‹ƒÕÅÉhlpp^PHpt…±­©fz|ƒ‡‹‰…v•“£ÁÛŠ• ±¼¿ÂÇÆÄÅÿ¿ÄÌÑÑÐÐÑÑÓÕÙÝÞàáàÞÜÛÛÝßáäææåääãâá…àßà„á)ßÝØÏËËÑÙØØÛÛÚÙÙÚÚÜÝÛÚ×ÕÔÓÓ×ÙÙÚÜÜÛÛÝÝÝÞÞÞÝ…ÜÝÝÝÞÝÞßßßàßàßÞØ€ß絩«ºÙÖÎÉÁd^x…rd\\ƒ±©t‰tpl‰\\VNNLD>80<0 H\4d< @RRNN4 ­¥x4`P‘`‰^p(8¡Í`f`ZHFx@`Á@ÁÁÁ‰™•~¡vƒ—‡r‰LXÁhpp¡d`Zbfbd\L@`PH6<>V:<8<:40,.$ $NVB6L*6.4,:^TL>6>F<,,<`TLNHTTLBDJJJLN*-bd^pW]``a“•¡¹ZZpzvrrx|‰`‰tL\fb„^n`f`Z^••fvv•åƒ‡{£t¯¹¡ƒÑ³lF6D@P:<<><<`4,PNLLLPVPDJ^^l‹£`gyŽ£°³²¸½»»¹¸¸¶¶»ÄÉÉÈÈÈÉÌÏÔ×ÙÚÛÛÙÖÖÖ×ÚÛÞßßÞÝÝÝÛÚ…ÙØÙ„Ú ÙØÓÊÆÃÆÐÓÔ×Õ…Ó ÕÖÕÓÐÎÎÌÎÓ×Öׄ؄ÙØŠ×ÙׄÖ×ÖÙÛÚÖ€€€…€…~~~~~}}„~|}~~~}{||{~~~}}~† ~}{z}}{zz{}‹‚~…}‚~ˆ~}~ƒ~„~„ƒ~Š‚~‚€„…€~~~‹ƒ~~~~~€€€~~~~†ƒ~†ˆ~ù€€ÅÙÑß»¾ÂÌÊÑé~|zzrnvõ—­«•ÝÑÑÍ姭±¹Åÿ½»½±“ùáùùÍÑ郑››ÁÉÙíõõñá‘‘@Á‡õ©™Ù§Ç͹—ùÝ©``éé‘``™ŸßçÑÓßÓ¹ÝñÁÝ¥‘¹É©¡±Éé«»×ááÝ˃‘Ñ‘©¡•‘€•—›¡Ÿ•‹‘Ÿ‹Íµ¡›«™•ù¡Ÿ‹Ñ±¥™¿ÓÓÇ·¹ÍϽùå¥åëãëåååßÝÕÝÝßãïÿ„ùãÕÝŠ“’‹«¡©›¥±­¥ŸŸ§­ÕµÍÙ©­¯³µ¿ÍÅ‘‰áñ™‰‘`‡‡‡Ù«¿Ç«•`‰™‘‹¹­…Ùñ…¥««™*ý…ùåÝÙõ›©³»ÁÁÁù»ÃÁÏÝ㎘¥¶¿»ºÀÂÃÂÀÁÄÉÒÙ†×ÙÛÞâåæçèæäããâä†ç æåäãâââàààá„â ãäßÕÑÑ×ÝßßàÝ„ÜÞÞàßÝÚ×ÖÔÓÖØØÙÛ†ÚØÖÔÕքׂ؄٠ÚÛÚÛÚÖÖÓÏ€áÜ¿»«±çåÞȵn剑©­¡õ«Ë¹‡Å¹¹µÉ•››™™‘‰‰jFD™­Åf½•P¹ƒ‘…hp¹ÝééÙ¡¡Á‘¹xÕH‘áÙ“·Á«‡ÝÍ™ñù¡``ÁÑ«ÑËÍÇ×É©ÁÝ­­™¹áÁ±¹éù¡£·½»«•TXÉ‘‹vj€jlntph^^lXhLtxpÕln`Dptxv‘‰‰|jl•…ll©©Ÿ™—•“‘“™™›Ÿ¥©Y±«¡«s{‚}~¡™­r‘™§¥«£££©±Ý™½ÑÙ‹¡›§·³…xáõŸÍ±‘‹ˆíÅ×Ó±§¡©£§‘‹‡n½ÅdjrphprOlÙf¹½­¡±jt~‰‘‹™™©¹Ãmz‰”¢°½ÄÉÇÄÅÃÂÃÂÄÍÔÓÑÒÑÑÓÓÕ×ÛÞßàáßÝÜÜÛÞàãæææåäããááààßßÞÞ„àßßÛÑÌËÑÙØØÜÛÛÚÚÛÜÝÝÝÛØÖÔÓÓÖØØÙÛ†Ú -ÛÛÜÛÙÚÚÚÛÛ„Ü -ÝÞßÞÞÞßÞÜØ€ÜßÅ·“¦ØÕÐÁ©Vfvƒt`XÁ«Zttl…Z^VNLF@:40<,D@\4dD HTRNP( ‰µ•hXá0`0‰Xx H‰©fxtdJ|H``hh Á±¡•ƒ“|z‡…r‘L`Ñx@h‰¹jbjjfbX. ™TJ844€8:486.&,2"4VZB8T.6,( B\HB<8DXH6 :ZPFJLVVLB@FHHLPP-``^vY]\a`hX‰btt~rzxx~…‘HlpxXpnjdhp~…bT`©Á……™`~ƒ}Ù«½¿¡™…||dD>*x:ddTP`BFNRTRTXPR^`n|…LXiy‹›ª´»»º»¹¸¹¹¼ÅËÊÉÉÈÉÊÌÏÒÖÙÚÛÛÚØÖÖÖØÛÞßßßÞÝÝÜÛÚÙÙØØ×؆ÙÕËÆÃÆÐÓÔØÕÔÓÓÔÕÖÖÖÕÑÎÍÌÍÓÕÕˆ×Ö‡ÕÖÖ×××ÖÕ„ÖÕØÙØÕ€€€…€~‡~„…~Ž~~~~~}}„~|}„~ |{|||~~~}}~… ~~}{{}}|{{{}‹‚~‡}~ˆ‚}ƒ~„~„ƒ~Š‚~‘€„…€~~‹…~Œ -~~~}€€€†‚~†‚~ˆ~…~ù€€ÚÏÎýჹ¾Ì³Ó‘åÉÁdrrá饣…ñÑÍÑÉÝ•£­­­½½»··¥“ƒñÑé…‹‰ñÙñŸ‘¹éí‡ñ¡‘p¡ÙÝ™‘™å™½ÅÁŸõ¡±`Á‰‘¡P¥xŸÙéÛ¹Ïß½Éë»Å…X`™µ¥x¡~§½ÛÝÙÕÅñÑ™‹«¥•€“™•™“ƒí§‰½½™£…ù…•£¡ÑµÁ§½ÍÍùÁÑÕÕ‘µßÛ×ÙßßÛÕÏËÑÓÕÛï÷ÿóáÕá••‚…•¥¡¹«³­«©§¥§£ÙÁÁÍ‹«¯¿ÏÛëù룅—«Ç½•ÍÇ‹‰zÕÏÅÓñxp¥‘‹“¹¯‡ÑåýŸ›­­AŸŸ««—“‘£µ¿ÁÅËÑÝååãããÙáí‚š©¸·µ¾ÄÃÁÂÅÎÖÙÚÙÙÙ×××ÚÛÝáäåæèçåäãâãæçæ„ç -æåäâãããâáâ„ã,âáÞÔÎÐ×ÝßßàÞÝÜÝÞÞàààßÜÙ×ÖÔÖØØÚÚØØØÙØ×ÕÒÐÒÔÕՅ׃؄ÚÙÖÖÑ΀ÜÛÛ÷±¦ååÞ²³zÙÕÝ“£›ýázµ»ÑŽŹё››•“‡‰‡……~bL¥µjnjµpÙ…‘—x`Páõ‡…Õ@`‘¡ñÕr½ ‘éå…­·µ‘Ý•±ÁÁ…‘¡`0ų×ÕÉ¡½Ó­µÝ«©lÉ|¥h‘щ£§·»³©•‘P‰xtj€fjnpjZZtVTPx…‹jÅnnj`@|‘‡‡‰|nr™“VDx£¥Ÿ—•‘‹‡‘™››¡©¥±³«£µ{ƒ‡~w~©£¿³»·±±­«­«©ñÍÑÙ©§¯µÃÓáו|«ËÏ«ñσééßáýƒ—飫•‡l±µ±hvz~‹H‘ƒ|rhn~‹•™¥­¯±»½ÁÏÙw‚‹˜°ÃÇÆÆÅÃÄÆÌÑÔÕÔÔÓÓÒÓÔÕÖÚÝÞßáàÞÝÜÛÜßâäåææåäãâ„á‚à…á4àßÜÒÍÌÑÙØØÜÝÛÚÛÜÝÞßÞÝÚ×ÕÔÓÖØØÚÚØØØÙØ×ØØÙØØØÙÙÚÚÛÛÜÛÜ„ÝÜÞÝÛ×€ÖÖÐÕƒšÖÔЫ©b•‘­p~rµ©hŸdpxtxp…X^ZRH>:62.4 DH24."0.:" 4XV4T.24,8,,HN4224FfPF FVHBDNVTH>>DFHLTLV`^f…``\aYFX…|“|zt…‡…‰‹‰h`|xb„|w‰™¥§r\pt“±·•É·~ƒw×Ñ»Çåwƒ±x‡bLV:D@L:HF@DFHLNTRJH@:DR\XRPRZblt|~|V^fv—±¹»º»¹º¼ÂÈËÍÌÌËÊÊÊÍÏÑÕØÙÛÜÜÙ×ÖÖ×ÛÜÝÞßßÞÝÝÛÚÚÛÚÙÙÚ„Û4ÙØÕËÆÃÆÐÓÔØÖÔÓÔÕÖ×Ø×ÖÔÐÎÎÎÓÕÕ××ÕÕÕÖÕÓÓÒÑÒÒÓÔÔÕÖÖÖ×ÕÔ„ÕÔ×ÙØÔ€€€…€ -~~~~~„†~ ~~~~}}„}|}~~…|~~}|}~… ~~|{z~~|{|~Œ~~}„~‚}ˆ~|}‹ ~~~~~…ƒ~¢…€~~‹~}~~~‘~€€€…€~†ƒ~Ÿ÷€€ÑÖʳá}«ÄÏž¿¡ñ½¡ll±É—­¡‹åÙÑááá…•Ÿ¥©§©­§¯—…õսы“‰í¡……›¥ÝÁx™¥‰¡‘±`Ýõé¡‘•n™£¯‹Ý‘¡ÁP¡ñ±0p~•©ÙáÕ¹½ãÑÕÕíÁxhÁÝñÁ¡‘§½¹ÏÉÕÍ­Á‰‰³«›•€“™±‡Ñá©¡•—‰å‹™—Ÿ—ƒáÉí©ÃÙÓǹÃ×åÍ—‰·ÙçííÛçãɳÑãéõý‚û÷ëåáÍ‘Ÿ¦šÑ٥ŹÙÓÁ­»·¯¡¥•É¥ÑÅé•«·ÅÕë÷÷å‘õ—µÃ»«¿çŠéÃÅËÕíá“…™™§…ÑÅå…™©§¯¯'³··±©§¡›—«¹ÃÅÍÓÙãéçééí÷‚ˆ’›¨¶ÄÃÁÅÆÆÉÑÕ†ÖØÖÖØÚÜâãåèèçæåäääååæèééèçåäâã†âã„äàÙÒÒ×ÛáâßÝÝÞÞß„à)ÝÚØ×ÕÖÖÕ×ØØØ×ÖÕÕÓÓÒÓÒÒÓÓÔÓÓÔÔÔÕÖ×ØØÚÙÖÖÓÏ€ÛåÖ­«œîßá¿Í±½á‘ÕÑÓµvÍŽÉÅÁ|‰‘••‰‹…tP…‘‘¡r~t±pp‹‰Ñ‘¡©‘•|¡±áÕݹ`0¡…||…‡¹0Á‘‰Áp@Ù—¥±Ù×Í¥§ÓËÇÁ­•Á¹­É­ñáÁ§·Ãǵ§›`XvŸ—p€lnhnh™­~~J44l•‡¡PbffbF|¡x‡‹‡|t|¡•^P™ŸŸ›—‹•™™Q§¯³¯¯·„†‚¿å½á³ÍÃÁ³¹¹µ©µ§Ù±õåí“£¯¿ÍÓÓßÛ“ù§ÇßáËÏïóÓ×ßéÿõ«¥»«“‰p­¡Álrxƒ‰‹'‘“““‰ƒzxƒ‘“›¡§µ¿ÁÁÁÅÉgnw‚Œ¡¼ÄÃÄÃÃÇÎÓ†ÕÖÕÔÕÖ×ÜßàááàßÞÝÝÝÞáäæèèçæäãááá„à‚á„âÞÖÑÏÑÖÚ„ÛÜÝÞßßßÝÜÚØ×ÕÖÖÕ×ØØØ×ÖÕÖׇÖØ×Ö„Ø -ÙÙÛÜÝÜÞßÜ×€ÐÝÍ£“ŽÖÙד¯|™h\­…‹É±Í¥TD\\‘`fb\XF<4,82&TD,P@@:T@ZPHd`p^h\D ÁPpH¡™T`@pPJLTRJp0`Á \H0‘щ£¡tn£¡‹xb@hx­©\‰`prvp|nh\40PP^VF>€>@0>:8@F2PTZ8<46.0$04L>D6<:4BVVF BPND>FLN<2@LTX^'Tbhf~vbddg—™l‡•‰‡‘‡‘‘h…‘dv‰—§µz啇“¯»¯³Ë{ƒÝ½ÇÑßùõ­©§jXH480d@:NJ@:FB<8:FNPX\RXdjjvƒfdhap¡•\‡—•••“•‘‡‰n\njn~‡‘‘›§©~~“©½³³Ñw|ÛÃÁÓÝ×Á“‰‹zbPH>< X<<@DLN'PTTVVTRNJLPX\\\`dflntxBBFNVZm—¶½ÄÇÉËÐчÏÎÍÍÍÏÔÖÙÜÜÛÛÚÙ××ÙÜÝßàáàßÞ„Ü ÛÙÛÚÚÚÛÛÛÚ×ÏÉÅÆÎÕÖØÕÕÖÖ×ØØØÖ××ÖÔ„ÒÓÔÔÔÒÒÒÑÑÏÏÐÐІÑÒÒÒÓÔÖ„×ØÔÒ„€…€ƒ‡~…‰~††~~}~~}{~~||}}}~~~|{~… ~~{{{}~}{}} }|}~~~}|}ˆ~|}‰ ~~~~~}}~~†ƒ~¢„€~~¤‚€ƒ~ù€€ÌËËÂñѬÁƃ¹µ‘Á©Hl‰›‘“¥—ƒõå¡Ù¹ÁÑÁåí‘™±¹©±¹—ÕéÁ•—•áÉÁÑ~•—‘‘H…±hÍùÉÁÁ͇·¹¯‹ù½¡ÁѵµÁÁ@|Á¹ÁÑÝÍ«½çãåá0TÍéÁÁp…³µ»·½·«Éá韯©™‘€“•¥……™ƒ™‰½ù陵ѓ‘ƒýñÍù±ËÕÑÇ·ÁÑÓ½™±ÓáååÛÁ±µÇåëïóùõåãÛÛÕõ››¥óõ塵åñåÓÅÅ·Ÿ•¡§§­³ÃÇÍÑÕÛéïῧ³Ûѽ·¯—µ}„ëÕÍÓ½¥§‹rƒ—™—‘ᥭᕫ©¯±'··¹±©§¥¥­µµ¹ÇËÏÕ×ßéñõ÷û…Œ•œ¡©ºÓØÖÙÝÝÝÞ‡Ý"ÛÙÚÚÜâæçèêèèèæåäåååçéééèèçæçæåååää…â ßØÒÓ×Ûáãá„àáââààÞÛÙØ×ÖÖÕÖÖ×ÖÕÔÔÓÑ†Ð†Ò ÓÓÔÕ××ØØÕÖÑ΀ØÝÙÀÃõçÛÙ„µµ•Í™é±á‘©Ç­…xáɉ©‘‘‘hÑzí‘‘Xd``p~p‰ÁÁ—ƒÁ™‘ቃѱ‰É‘ÅáPÁí§•ƒtí•`ÁÑÁÁÑÁ Á“ÕÉÍÛÕ¹•¯ãßÓ±`¡±™Õ¹ÁÁ¡‘³¯Á½¹³£¡±Ù‘›™ƒr€nnl`XX^r`\ ‰‰©PZXJL‘…x¥z‡‡…|tz‡‘…bV|“™—““vbt‰“™¡§§§­µ·µÕˆ†ŒÙåí…ŸµÓÛ×ÍÉËÅ­­µ±­¿ÃÅÇÇÇËËÏÙÕí¹ÛÓÃÁ÷ǂ‡„õçáéÕ½»‡™¡ƒ‡ƒÍ‘‘µnxƒ‹'‘“•••“‘‘•™¡¥±»¿ÅÉÍfgjqw}Š£ÉÓÓØÛÛÛ܇ÛÚØ×Ö×ÞáááãáááßÞÝÞáãåçèçææåäåä„ãâ„á&àÞÖÑÏÑÖÚÜÝÝÝÞßßààßÝÝÛÙØ×ÖÖÕÖÖ×ÖÕÔÔÕÕÔÓ„ÔˆÖ -ØÙÚÛÛÜÝÞÛ×€Ñ×Ò¸¯áÓÕÎx¥›p|DÉ¡ù‘‘™³ŸnFJ‰…L@@0((Ll>` (($4HFD:4`…tV>P @Z`Z8P‰`‘X‘¡D Á¥^b`R>td`Áѱ‰@Á¡|µŸ›¥©‰^¹£‘r`™hÁÁ`x~j~zxrdP`ÁjZ\LB€FF42 ,*P\T0,*0,""@4(H8B82<6><28<:6DVZZTTZ`\fv~Rgfb…Évtt…—££§©©‰‡‡„•:—™™—•—•—©»·£…|zŸursåßÕ½—Õëá×µv``^Vx@H.>422HTPB<:42Fff^VTXf`j|‡…\ea~™Í‹›ƒ“UT³«¥™‹ƒƒ‘™•“™•“•~|~­§³Á›‡©vsuãÛɱ¥»w}wr·tnnrn±pT08BHH LNPPNJHLRVXZ^„`^djr;9?FILRTY^½ÎÓÕÕÕ‡ÖÕÓÑÏÍÏÖÚÝßßßÝÝÝÚØÙÙÙÜßááá…âáàááàß„ÝÚÔÎÉÇÏÖØÛÙÚÚÛÜÜÛØÖÙÚØ×ÖÔ҆РÏÏÎÌËËÌÌ͆ΠÏÏÏÐÑÒÔÕÖÖÖÔÑ…€€€€††~„Š~}}|{{|}„~~}~„„~~|}~~|}~~}|{~…‡~}{}~~‹ -~|}|~~{|}ˆ~|}ˆ~}~‡~‚†~¢€€€~~…‚€žƒ€†„€†ƒ~šû€€ÂÉÅÉ•½ ·Í©‹x•t©•ÁhlÉÍÙåíåÕÍ™éñ•©áp@PáÙ‘‰‘¡õ…ÉÙ—¯Á¡ñÅééÁp…é`híÁÁÁ•~“¥¹³áéÙµxPÁ`™‰…É­·Ïå‹í˽ÉÝ‘ÉxtP`@ÏÉßßÓñåÁ©µ±›…€‰õÉ…¹ÅÑ¥ÁåÅÍíñƒ‡á¹ÙíÙ‡©»ÓÑÁ³­­­¡©Ëíõñùé…¥ååñïõ‚鯽Óã—Œ„f‰©¡ÕÙÍ‚É­™“›¥­¯±½ËÓÙÙÑÇ¿¯Ÿ±éûã©‹»xtsǽ¹ÃÁÑŽëË«‘‰~‡‰ýýõ‘¡¡¡J¥©­«¥¥§§©«­µÁÉÏÓÓÕÝãñû‚ƒŠ“œ¡ª«³×éæßàÞæááàßßßÝÜÚÙÙÛàåçéêèçèæãáàáââæéëëìííê†èçäããâàÝ×ÓÔÚßàáá…ãâáàààßÜØ×ÕÓÑÐÎÌÌÊÉÉÉÈÊ…ÏÐÏÎÍÏÐÐÑÓÓÓÔ×ÓÓÐÏ€ØÔ×Ñy“­ÜÍ·—«¯§‘ÝŽ½õåÁÁÍű¡¡éÉd‘á±±¡hX`PXá‰f`hÙ¥©§t©¡éýlHÁ¹…ñá……áXÁá­§¥¥—xíùíͱÁÁÙ©¡åÁËçítpÏÏÇÑå`Pñí¡¡—ÕÑÍÇÃý§ýñx¡‰p€tzñ±p©½©¡¥…t•©ÕÑlD(x|©dtxƒ…xjbt‹…|z‰£Ÿ™••ZHj©³·«¥S±§­ÅÓÕ…‹­µ£Ñ×ÕÙqroÛÏûµ¿ËËÏÙÝÙ×ËÇÉÁ³¡ÁëñrsÛ»­Û‡†…íåÛ×ÑÙ”ÿßµ—™¡õáÅlvv‡‹I“—•‘‘““•——››¡£§­³¿Édehjlrv‚’ÂØßÝãÝääãââààßÝÛÙØÙÞãæèèæææäâßßàááåèéêêëë…êéêèæääâàÝ×ÓÔ×Ýßàá…ãâáàààßÜØØØÖÕÓÔÔÔÓÑÓÒÑÐ…ÒÓÒÑÑÒÓÔÕÖ×Ö×ÙÛÛÚ×€ÔÔÐʡȾ£l‘§™‡Zxt|…‰br½…‰hXPL‰h, `p$8F0 NH>::$$>l\XNP0rjhƒ‰¡[SaRt‹§•¡UWP¯‡‡‘•‘“—Ÿ—““‹zjbƒ±»Z[­ÁwssÍÉ»·¯µmß¿™||tvh­‰dH@zDDDHLLNNPRRVZ^^^XZ^dlr8:¥§«©§§§©«­±·ÃËÑÓÕ×Ûßí÷ýƒ…‹’˜¦­­ÈâéáãßãááàßßßÝÜÛÚÙÛàåçéëèèéèæã„âåéëëìíìê†èçåãäãáÞØÓÕÚßàáã„äããááààßÜÙØÖÔÑÐÍËÊÉÈÇÈÈÊÏÏ…ÎÍÍÏÐÐÒÓÔÔÕ×ÓÓÐ΀ÙÑÕÔ„’Ôº¡Éý¡«‘åÙÍÕõ‹ñáí|rÍɹÁÑÁld‘Ñ¡l¥™hLÍ…pJ©Ý•rõ‹p<Áé­áµýÝhÁÁ±…¥¥Ÿ‰ƒÍáÁ᩹ÍÍÙéëéwãÏÏÓáP“ŸÑá¡ÑÑË͵±åù‰Á‡§¡Ù€ƒzÅ©|­±¡™‰¡pl¹hfd`HLTPRbrz|‡|ndt‰‰ƒ…‹Ÿ›——Htp³½½³­X³§³Óß㇉åÕ©¹­Ù×ÝÛããÛÇ¿¹µµ¿ÉËÍÕÙÙ×ÍÉÇÁ³£›½éïézïͽჳé٣ŽÉóÓ¹±ŸŸ‘õxpnpv‡‡H‹••“““—™›™Ÿ¡¥§§«¯³½ÅÉegilqu|ƒ‰®ÑÜÞåÞääãââáàßÝÜÚØÚÞãåæèææçæäâàáááäçèèêë†êéêèæåäãáÞØÓÕ×Ýßàã„ä ããááààßÜÙÙÙ×Õ„ÓÑÐÑÑÑÐÒˆÑ ÒÓÔÕ×ØØØÙÜÛÚ×€ÕÒÏ͈•†Ã¯“顧h¥¡©¥jj©PDhhl…lp@ PP((xD<&t¡hbZ*(D¡RP P™|Thh‘h0Á¡pRR^d^JBJb‘@`Á`±‘‰©©©±¯·a±—¡«tÁtn@P«§›—ƒl±±vptV…€VPP8\hP<$ 088P$ , H( .4:<88<0<86:>JD>:8(Bxd^TZ5vnt•¯`_¡tl‘•­Ÿ£¯­¡£•‰‰‘——“™¡¡™—‘ƒth‰¹ÁÃeÁ‘Ásq™±­‡£¥Ë¯pƒŸ™ƒ|xl­L@>BBHD|FBFHNNNPRTTZ^bddb^bdlpt9;@HMRWYaŠ´ÊÑÛÕØÙÙ×××ÖÕÓÒÑÐÑÖÚÜÞáÞÝßÝÜÙØ×ØØÛßááâãâßÝàááãáàÞÝÞßÞÚÔËÇÏÖØÝßàáàààßÞÞÝÜÛØ×ÓÐÎÌËÌÌÌÊÉÊÊÉÊÍÍ‡Ì ÍÎÏÐÒÒÒÓÔÕÔÔÒ…€€€€~~„…~~~~…~}}~~}||}~~~}~~~~„~~~~|}~~}~~~}z{~‰ ~|{z{|}}~…€… {|~~{{}†~~~}|„~~}†~ }}~~~}~~—~†€†€€~~~ €„€€~~Ž~žù€€ÈÌÆË¡©—¢ ©©‘b~…nµ­¥­Ívx|‡‹‘…ñõ‹|Ù‹¯ŸÉ¹Ù¥…éé½á‡íÅz¡³™¥…~›‘\ͽ©ÅzùÁ¡µ…±»µ©¡‘™µÁÁÁ``0`©ÉÏËãñ†Ñ¯íP½•‘ÑÁ`p¥ÇÉåé¿…‰‰¡Á•¹½ýÙ€§¡Å‰ÕíáéÅ¡•§¥Ñµ›·µ¥«¿Ñçïç×ɵ±±·ÁÉÝåéñÓéѳ÷ùûý„‰ÿÃÅõ‰’——¹™‘µ±ÛÓ·ÏñÝÉ­—‹›¥¯¯¯¹¿ÉÍÍÁ¹³§›‘Ïëý‚óÕ»ÙéËt`ÁlŸ™™±Õ»¿—‰‘‹íé••›Ÿ/¡¥©§§§©«­¯³¹ÅÉÏÑÏÑÕÙåóùý„ˆ‘™¢®­·ÛïåãáåãááßßßÞÝ„Ûáåçéë…éçåãââåéé„ëê†è,çæåäãâÞØÔÓ×ÜßâãåææäããâáààßÜÚØ×ÔÒÐÌÉÈÆÄÄÆÈËÍÎ‡Í ÏÐÑÒÔÕÕÖ×ÔÒÐÍ€×ÒÕÖŠ“çϳ£‰µ‰£‘…ÙÑÉÑõ‰‡‡‡|ÑÕzÙzrb¥™½n~hx±ítbµÅ‡™™nX`™z,±‰ÍÑÍé…|±ÁÁÁ‡™«©£™~‡ÁÁÁ``@ÁÉÝããïézzÕµ‘õ¡å§§ñÁ©­ÍÑÉË£h©á¡‹¯³éÅ€—P½µ‘‰lp¡phlZB@H\NZ\`hrvx‰‡xjv‰™—™™…xhÁÅÁ¹[\»©»ßu{}…©©™¹·ãÝÕ×éáÑ»·±³µ¿ÉËÍÓÕÕÕÑËÇ¿³©¡µÙïó|ùéßïý噡Áùÿ¿íÑýÉͧŸ•õálpnvƒƒ)‡‰‘“““•—™›Ÿ¡¥«­¯¯¯±¹ÃÇËgknrvwƒ…˜ÄÞßäâäää„âàÞÝÛÙÚßãåæèçèèèçåãâáàãæèèˆê*ééèçæåãâÞØÕÖÙÞàâãåææäããâáààßÜÚÚÚØÕÓÒÒÑÏÍÎχÑÐÑÑÑÒÔÕÖØÙÙÙÚÜÚÚÖ€ÕÔÐÏŽ“Ñ쉵£‰nÁ¹±¹Ål`TNRRD``Xpd•PH>*0(XJB$(h‰@6…‰Z^T. (PZX0\…LBXÁÁ…XPffbXXNdpÁÁÁá‘`¡¹³©¹»dc£xÑppÅv‰Á™§§£—n4htxv…•p€ph4$ttL$(pT8( <00&$$"&28@DDBB0<@@DBD@<:6P|nbZ17~p£Va^dv\`•¯›¥»µ¥—‹…‡‹•™——£§©£—‘…xrƒ«ÃËiÍ»³ÏáËp`Á©v¥¡™­xͳ·~r±@B@BHF8JHJLRTTVXZ\`fhnjdfbdjrrr:AHOTSYZq£ÉÏÚØÛÚÙØ×××ÕÔÓÒÑÑÖÚÜÞá…ßÜÚÙØØÛÞß„á1ßÝàááãáàßßßàÞÛÕÌÇÎÕØÞàáââáààÞÞÝÜÛÙ×ÕÒÎÍËËËÉÈÆÇÉÉË…ÌÊËÌÌÎÏÏÑÒÔÔÔÕÖÔÔÑ…€€€~~„…~‡~~~„~~~}}~~~~„~~~|…~}z{~‰ ~zzz{{|{~…€€~||~}z{}† ~~~||~~ˆ~}|~„~}~—‚~…‚€„„€~~~ €†~{z}„~}~†‚~žø€€ÈÐÉÌ ›~œ©­©rtű±©¹h‡|åýáÕÙ‹—›­Ë¿«¥­©³µ›‘á™Ù…‹áŃ¥¯•©‘~‹•Ù`¡ÍÁµÁvƒ¹á±Ñ‹™¹»±£Ÿ›‘…Á``Á``Pá×Ù×ãåù†éÙ¹É@Px›™ÁÁ`¥ÁÇÓׯùñxpá—³¹•‘€»«¹‘ùíé½Ù±±å©·ÁÑùñ¿çÛÍÃÇÓåïïáÏ¿·µÁÇÉÕßéëËýéÇõý‚„ˆŠùÁËŒ•”©¥Í³×Õ§¹ÛÉ­©•§±¯¯µ»Áÿµ­©£›Ÿ³Ýñññçpxz¥`@@`Hn—pPɵ½¡‰á¡¡Ù•‘•™J¡¥¥§©©«¯±µ»ÇÉËÏÍÍÑÕÝéóù‚‡—ª³³ÎîêãâæããáááßßÝÜÜÝÝáåçéëêëêéëéçäââäçèéëëëé‡è?æææåãàÚÔÓÕÚßáãäååäääââáàßÞÛÚ×ÕÒÐÌÇÃÂÂÁÃÆËÍÎÍÍÌËÌÍÍÏÑÒÔÖ×Ö××ÔÒÎÍ€ÔÒ×ØŒ•ÃÁµ³‰™é“éÕÕÑ݃‘íõÑÁÅŸŸ¥•…‹——‹‡tL‰™åtb­Å•f\l™t8ñÍÝÝñƒ…¡ÑÑÍ—©££Ÿ‹pÁ``Á``ýéïíïéù…ëÙÉéÁñ¯¯‘ÁÁ™­ÇÏÉÇ™ÁÉÁÑᓱ³‹€µ£•`ÅlÉp‰¡ñ¹plH8h…hzz|vtv‹“…vx‡‘‘•™›™™|‰›ÃËda_]Á«Åtu|~~‘©©Õ¹ããÃÃÝÓ÷µ³³·ÁËÉËÏÏÓÓÏÇÿ¹³±³Ååõóùý‚µ‰ááÁ‘¹—ÉýËÏ­™‘õ±¡Åppv~ƒJ‡‹‘““••™›¡£©­¯­¯³³·»ÃÉglptyv‰°ÙßãäçääãâââàßÝÜÛÛßãåæèèèéèèçåâáàâåçèéêéé„ê+éééèççåãàÚÖÖÙÝââãäååäääââáàßÞÛÜÛÙÕÓÒÏÌÊÊËÍÏ„ÑÐÏÎÏÐÑÒÕÖØÙÙÙÚÛÜÚÙÕ€ÔÖÒб½¶±™Ý‡~ݽ½­½fl\XL‰H…`PpvpRJ>>HRZB, (\•D2x‰bbP*4NRT0¡‰•JFl±Á™TVljf`^bfTÁÁÁ`ÙÇ¿µ½¹Ëm½µx©`¡x‡|PÁÁh›¡¥©`hÙ±|r…b^€‡v88™BP4 0á•<,`XL66:::8:BHNJD6>BDFDB@<888Hd~r4249r‰WXaefnth“©Ÿ‹™½µ£™‘“›Ÿ™™¡¥¥¡›™•‰‡‰¿ÑÍÓÓjnrŸX``d|£zh(ѵ»›ƒz½tXpFDDHL/NPNPRTTXZ\^bflrpjhhjjnpp:AINVRU[cŽ½ÎÚÛÝÚÚÙØØ×ÖÕ„Ó,ÖÚÜÞáàáàßáßÜÚØØÚÜÞßáááßÝàááãááßßááàÜ×ÍÇÎÕØÞà…á,àßÞÝÜÜÚØÖÒÐÍËÊÉÅÃÃÄÆÉËÌÌÌÊÊÉÊÊÌÎÏÑÒÔÔÔÕÖÖÔÒÑ…€ -€€~~~…~…~„~~}~~~~„~~}|}„~~||~‰ ~z{{z{{|~†€~}}||}zz}†}}}||‡~~~~~~}||~~}}~—~~„€ƒ…€~~~£€€€}{{{~}}~…„~ø€UÌÑÇͨŸ…Ž±›‘x­­™µ½lr‹“‹™¡±µÉÑ‘¡×ɳ¥§±»½©‘©ÉÅõå¹½~Ÿ­ÕÁõ|õ¡‰Íµ¥Átá©áá‘›³·±›•‰Ù±Ñ…Ápµå݄߀éÅ©`P@P›ÁÁP›»Ç¿Á£á`@™«»Á¯­»³­õùéÍ¡¹¹•±£¥Á•Ý¥×ïíçÑÇÃÕßçÝÏË»»ÁÅË×ãçåË…×Žå·Ñˆ”„Ç…áý‡³ÇË­™»¯£¡‘—£©±­¯µµµ±«¡¡Ÿ¡£££«·ÑëëGrw‚ƒ~PÁÁ`Á‘Tx µ§µ£‡Épá“—™•™›Ÿ£©­±³·¹»¿ÃÏÍËÍÉÉÑ×Ùßçíõƒ‹–ž«´µ¶Ûëäáåäã„áß„ÝÞáåæéëëëêéëêçäââãåèéëëëé‰è=çæäáÚÕÒÔÙÞáâãäãäåäãâáààÞÝÛØÕÒÐÌÅÀ¿À¿ÁÆËÍÍÍËÊÊËÌÍÐÒÓÕ×××ØØÔÒÎÍUÓÑÖܘ£Á§·«•ÁééÁÅÝé…“•…¹­­|¹‰å™¡Ÿ—•—‰…v8hÙÕÙ…½™“^…•ý‹±¹ÍÙÙù…í¥áùz‡‘›¡©¡•‡ÝÁá…Á€‰ÅùñõíñíïÉ¡±ñÉ¥¯±±ÁÁ±£ÁÍÍÉ£Ù±±«Á¿­«¹±¡láíá•P@‰zv`H`X•p…‡‹›“ƒ|z›•‡~‡‹™¡—RZ¯Ãijje`ǵÛ|‚xÇåñ‹»Ûå»—³µ³­¯³¹»ÃËÇÇËÍÑÑÉÃÁ¿ÁpÁÁ½¿Ëã÷ÿƒ…‰……‘ÁÁÁáÙ‘‘ñÁɯ‹Ù¡…Ñzzƒ…‰“•—™Ÿ££¥©«±µ·µµ·µ··»ÁÉinrsx~†”ÁàåãçæääâââáßÞÝÛÜßãäæéèêèçéèæãáàâäæèèéèé„ê…é5çæäáÚ××ÙÜâââãäãäåäãâáààÞÝÝÜÙÕÓÑÍÉÇÇÈËÏÑÑÑÐÏÎÍÎÐÑÓÖ×ØÙ„ÛÜÚØÕUÔÔÑÔš•³§¿±•x­­©¥±±`b^VVd0<\P(`\©lddXF<@P\F6p™>BDBFFF>6D,2vt=:::;~v™a]ca¡l¹©j‘››x£««—““›¡£Ÿ™¡¥§¥Ÿ›uŸ™Ÿ«ÃÙÛlorvt`ÁÁ¡ÁÁh™@HÉ­·Ÿz±pPXRNRNVVVX\^`dfhjlptxzxrnplljljj>FKQUUX]l¢ÊÙÚÞÜÚÙØØØÖÕÔÔÓÔÖÚÜÞáááàßáàÝÚØØÙÛÝßáááßÝàááã„á5ââáÞ×ÎÈÍÔØÞÞàààáááàÞÝÜÜÛÙ×ÔÐÍËÉÆÂÀÁÁÃÉËÌÌËÊÉÈÉÊÌÎÐÒÓÔ…ÖÔÑÐ…€€€‰~…~}„~}~~‹~}}…~„~~~~}{}„~~~}}‰~}|…z~‰ }{||}|zz|†…}‡‡~ -}}~~}~~œ…€ƒ„€~~£„€ |zz{z|~}}}~„…~ž÷€€ÏÉËÑ©¯ƒ‹pp™µ™Ù±Ñhƒ•™‹±±áÁÑ©ÙxÕ­ÉŹ©©½½·§­¹‰ùÕ¡|™§ùÝÙåéÅ©Á©¡¥nÑ™¹‘ù—¡¥©¥›‘©|™ ÁÁ` ÍÃãÝãáÍÑÇ‹‘Á@H…“¥‰`ÁÁÁ›»Ç³¿£™(h‘͹ÇÉ»­€»µ™dÍÙÁ½ÉÁÁ‹©¿õ‰Áé«ËÙãïëåÉ«½ÇÏÏǽ¿ÁÅËÕÛÝÛ×¹ñ‘ß…û‹š—ŽÏ³ãŠ‹’Õ‰õµÃ¯™§©¡¡§¥Ÿ¡³³«­©£ŸŸ¡££§¡¡¯ÁÙßv‡ˆ“ÁÁ`Á```Pxl—³§‡x•É…“››™¡+£¡¥§¥­µ»¿ÅÉËÏÇÅÉÉÇÑÏÑÛáãéû‹’—™œ¬¶·Åêàéâäããá…âáàßãåæˆé çæäáàáâåèèèé‰è4çææâÚÕÓÕÚßááâãáááàÞÝÝßßÞÛÙ×ÕÓÐÎÇÅÁ¾¾ÁÇÉÊÊÉÈÆÈÉÌÍÎÐÔׄØ×ÓÔÎÍlÓÒÕب§«¤«•™ÁåÍù™Ñý—•‰v‘™É¡¥xDÁ¡é™™™‘“…l<(h­Ý‰l¡‹‘‰½­­ÑÝ|8ÁÑõíå…ù½…Éý“—›§§¡©…ÙáÁÁ‘ùÕûéíçãëÕ‘Á±Åµ¿¡„Á€±ËϿɥɉñå¿Ïõ¥µ­¡‘ýùÍ©‘…Xn…¡8Ñhz‡‘›Ÿ¡xƒ—‘‰‡‹“›¥§¥¡~™pµkÛlqni½³å…ŠÅ镯Ëß·ŸŸ§©««­³¹¿¿ÁÁÅËÍÉý¿ÁÃÃÇÁÁÏá÷ÿƒ†‹ˆ“¡ÁÁÁÁ™\ƒ¹ãÉ—¹¥Ávƒ…~‡‹‰—›¡¥¥§«­±³¹¿¿¹¹½¹µ¹¹¿ÃÍkppv~ˆŠŽ§ßàíåæäääâááààßÝÝáãäæèèæææèææåæãââäçéééëêê‡é=çææâÚÖÖ×ÜàââäääãââàßÞàáàÝÛÚÙ×ÓÑÊÉÄÀÃÊÏÑÒÓÒÑÏÑÏÏÑÑÔ×ÚÜÜÜÛÙÛÛÙÕ€ÙØÕÖ©³©•œ™|p•¥|©•ÍÉVHNVNP@PXL (0xb^\RFFZZN<844LTZVhXd‰‘PÁ‰©‰•`4D‘•ÁX^bf^Zjxh‰` ÁÁ` Á©Ç»Éɵ»»~ÁÁ•‘v`ÁÁÁ™¡¥›“r‰¡±`‘“¡•‡x€‡~`T±•T`‰pH&0ND0<&0:BRRT@*6FLNFD>@BDHHJFBF\RƒH|;BCA|~±f]d™^\¡br‹£³v¥¯‹‘™©§›Ÿ£¥©«§¡Ÿ£¥§§§Ÿ¥µÇáãpsw{ÁÁáÁ```h‘x¥Ã¯‰Xd‰\bdbZ`,^ZX`bhlnnptvzx~…~rpjjhjbfrFLPRUWWa†È×âÙÜÚÚÙÙ„Ø×ÕÕÙÚÜÞßßÞÞÞßÞÝÜÜÙ×ØÚÜßßßâ„áà„ß4àââÞ×ÍÇÍÔØÜÚÛÜÛÚÚÙ×ÖÖØØ×ÕÓÒÐÎËÈÂÁ¼¹ºÀÅÇÈÊËÉÉÉÇÇÉÉÌÏÒ„ÓÑÔ×ÕÓ…€€€…~}~~~…~}}„~}~~Š~}}…~ƒ†~ }z}~~~~~~}~~‡ -~~}}|zz{|~‰ |z|}~{zzz†}}}|~‡†~ -}}~~}}~™~€„€ -€€€~¤„€ |zz{z{{{}~…„~ ö€€ÊÂÅͯ·~ƒ½“‘¹•µv‡““‹Ù•Õõõí¥|©‰µ·¯§©¿Á¹­Ñ‘Á™‰áxr—£‰éáñé©‘x©ÁÕåµ|…Ñ¡‡­­¯§›½Ñp±¡@ÁÁ`0v×éåããËÉ»¹ÁÁ`™›£…`ÁÁX§¹Å»½“h P¡‰¿ÃÍ»³hµŸá‰©Å½µ™­á‰£ÉÑÕµÏÝçííëëÓ½»ÅÍËù»¿ÇËÓÛßÝÛ·ñçýý‘Ÿ Ï±÷‘‰·í~—¥¯©—™Ÿ—¡©«¥›“‘›¥ŸŸŸ¡£££¥££©½Ùpyƒ‰‰µ±„ÁJ`Á@p±rŸÁ¹©v…ñ™¡››™—•Ÿ££¥¯¹ÅËÍÍÏÓÏÇÉÇÅËÑÏÓ×ßãõ‡”—™¨´³¹ãâåãääããääããââààãåç„éççèççæäáßàáåçæ‹è æääáÚÕÓÕÙÞà„á%àßÞÜÜÛÜÝÜÚØ×ÕÓÐÎËȽ¸¼ÂÇÈÉÉÈÇÆÆÉÌÍÎÐÔׄØ×ÓÔÎÌ€ÕÓ×Ú³¯µ–™Õ§¡¡‘­µƒ—™~pµx…¹ÍÅ©™•µz“•—™™™‹xh(ÁÁ‰d¹‘‹•‹b±¹áÝp0¹åíùùÅ…á¹›Ÿ£“µÑùùÁÁÁ±ëÿñíéßãÉÁÁÁÕ³½½›ÁÁÁ‘ÃËËÇÇ•™±xÑ•ÇËǵ­h¯—ñÙÙåÍ•|‰¡Zdf`xŃ…‘¡¥§™…ƒ‹“‡|~‡“›¥©§¥~¥~ÁÕÛrxyx³¥ï†‚‰·ñ…‰—¥¹Ç±¡Ÿ£±»¿Á¿¿½¹¿ÅÇÅÃÁÁÃÃÃÅÃÃÉÝ÷†ˆŒŒÁÙ„Á`Á‘•Õ¿éÕ»ƒ•™é“‹‹‰‰“››Ÿ¥­±³µµ·¹ÁÅÃÁÁ¿»»·¹¿ÁÉjnps{„…‰œÓâçåææåäãââáààÞÞâãåèèèæååææååæãáâãæèèéêêê‡é+èææãÛ×Ö×ÛàáâãããâáàÞÝÝÞÞÝÜÚÚÙ×ÓÒÎÌÀ»ÁÊÏÑÑÒÐЄÏÑÑÔ×Ú„ÜÚÛÛÙÔ€ÙÕÕÕ²¹³ŽÇxl^hh`XLRLJl(4l|xhH,PDNRJDFTTF:@h@XHXbZ6X`H0`x¥‘©±hD©¡jfhfh\Nx`P©0ÁÁ`0rÃÍÅÉɱ³­¡¡ÁÁµ——r`ÁÁh©¡¡¡‘fXñ™j›Ÿ—‡|hjh‰XXdh\&.8pB84>JVXZJ86BJJD<<>BDFHLHF:PV‰‰‡DKQT|v¿jdd‰©\\dht‡•‰x~t‰›©¥Ÿ™™™¡£££¡¡¥¥§§¥Ÿ§¯Ãársuy}¯©„Á=`Á…Áz§Ë¹ŸfXXbf`\`^Z```fnv|~||~…‡‰|pnjfffhvEKNORUX]w»ÓÛÙÜÛ„Ú ÙØØ×ÕÕÙÚÜßßßÞ„Ý ÜÜÜØÖ×ÙÜÞÞß…áà…ß -ÞÞÚÓËÇÍÓ×Û„Ú.ÙØ×ÖÕÕÖÖÕÔÒÑÐÎËÉÆø²¸ÀÅÆÈÊÉÉÈÉÇÇÈÉÌÏÒÓÔÓÓÒÔ×ÕÒ…€€€†ƒ~†Š~Š~}{}~~}~„…~|{}‡~}~‡ -~|}}}|zz{|‰~{z{~„{zz}†}|}}ˆ‚}‡~~}~š~„„€€€€~¥…€}„z{z|~~†ƒ~ ö€€Æ¼Àȶ¿Á…vͽ¹±§§•ÉÅù…õíéÉÁáõ…‘Õ•ñ›£¥§¯Á¿¹·…Á@X‰™Xh—£ññƒááÁ`x¹ƒõ­‘…tÅ—§»¹µ¡‘‰Á‘l`@ÁÁ@•víã×åÑÇ£áÁ`0t£§§‰`ÁÁ©§¹¹³½``•­Ã¹Á³«X“É‘x‘¹µ¥±Ùíý‘™íÍŸÉÙáíõéïñßÑÉËËŽ³·¿ÅËÓÛááݹñ¡ñ†˜¡¢ ïÓ‹‘–„¥n|…›——£©«ŸŸŸ›—­¹·¥ƒƒ‘›››Ÿ££„¥m£¥¡±×qy†…pÁ ```ÁH¥r—Á˵·“±¹•©§¥…‰•™§µ½ÇÑÕÕÕÛÝÓÉÇÅ¿ÇËÅÉÏ×넉’•¡¯¯¬Òèâæååäääååääãâáäåçéééçååæçæåãàßßßáååæ…è†æääáÛÖÓÔÙÝßßáàßÞÝÜÚ…Ø×ÖÕÔÒÐÍËŵ¯¸ÂÇÇÈÇ„ÆÈËÍÎÒÖ×ØÚÚÚØÔÔÎÌ€ØÕÚÜó՛åÑǹ­£x•©ý‘…ͽ½½­ÅÍnrÉ¡¡Ý~‰—Ÿ¥¡“‰VHÁ±‘¡¡…‹›‹j½ÅtÍ¡Á±õ…õ¡…••í§¯§¥¡‰zÁ±‰ÁÁ¡Ñ«ÿïáëçá³ñÁ`“ÇÇÁŸáÁÁñÇÏǿñ±¡­»É¿Åµ¯X•Í‘ÁÁÕÁ‰¥©XZt‹‹‡‡—§§«¯¥™‘‘“‰~v|‡“›¥««§‰µ‰Ómpy|‚‚Í»‚ƒ„Š±ƒ‘£¥¡¡¯¹¯£¥¥¡§¿ÍÏÇÁ½»½ÁÃÃÃÇÇÄÅrÃÅÁÑõƒ†…Š‰ŒƒÁ‘Á¡Áhɉ·ãíËÁ›½½™›™…‰‘Ÿ££«±»½Á¿¿ÁÉÓÍÇÉÉ¿¿¿¹·»ÁÇimosz‚‚ŒÁãâçççææåãããââàßããæèèçæããäæäåäâààáäæçèéêééé…èçææãÝ×Ö×ÚßàáââààßÝ…ÛÙØÙÙØÕÓÐÏɸ±¾ËÏÏÑÐÏ„ÎÏÐÑÖÙÚÜÝÝÝÛÜÛÙÔ€ÙÕÕÕ¿»Í’Ï£—ƒnfFXt­JNHldpHHl‰TNt<@p>FFDLPND>Á`H\l\:X`FlXÁ`p½Zd©T4XlÅzvthPDHÁpdP8ÁÁ@x“lÕÇÃ͹±—‘ÁÁ£Ÿ“v@ÁÁÁ­¥›“—ZP¡ñ…“™‹ƒ€j|8hxLL\hXD(20@b@40@PX\`VJBHHF>468>@FHNLH4DTEHMPX[™•mjfg^bnlfhrz›‡ƒztj¡§¥—•›£¥¥¥§©§©©©¥¡©§·ßstrwy~nÁ@```Á‘½r›ÅÉ«¥||t\`bhbV\'bjjltz…‰‘—ŸŸxtphbfnxFJLOPUXYf£ÏÔÛ„ÜÛ„ÚÙØ×ÚÚÝßßßÝÛÚÜÝÜÜÚ×ÖÖÖÙÜÜÞà„á†ÞÝÝÚÕÌÇÌÒÖÚØÚÙØ×ÖÕ…Ó&ÑÐÐÐÎÍËÇÆÁ°©µÁÅÅÆÇÈÇÇÇÆÇÈÉÍÐÒÓÕÕÕÓÖ×ÕÒ…€€€‡~~~‡~‚„~Š}z|}}}~„ ~~~}z{}~†~‡ ~z|~~}zz|}€‡|z{|…{zz}†|||~‡~}}ˆ~~~›~†€‚„€§†€ z|{{{z}~‡‚~¡ö€€Ä»ÁÄ¿ÓÁxnÑÁµ­«¯­íÉ탉‰íåñõåÙÉé…éµ¥Ù‹•¡©·½Á½¿¡ÑÁ`@hpf£«Ÿƒ‡ÁÑÁ™v™õ¡¡‘‰l¡±¹µ³›‰éÁ¡©‰0``P‘µëç×ÉåãÉ~Á```‹¡¯µ‘`ÁÁt··µ½á` Páµ¹«³§€Áѱl©½©©Éý…™¹¹©­ÅÛåéëãçíééßÕÑÅ»±¹ÃÉËÕßããßÅõó„‘ £ –ù뉋”|©‹‹‘ŸŸ§¯©£¡££±ÁŽ§“z‹™Ÿ£§©§§¥£¡£›£Ërz‡†ˆÑ‰```p¡©“©ËÕϽµ|ƒ©µ««—½ÉL‡•›©­·ÃÇÑÕÛßåçÝÍÅ»»½»»¿ÉÑáý‡‘”ž«®«¿èçêæææåæççæååãâåææèèçåâáäææåãàÝÝÝàãäæçèèˆæ3äãàÝÖÓÔØÜÞßßÞÝÛÚÙ×ÖÖÕÔÓÔÓÒÒÐÎÌÊŶ°ºÃÇÆÅÅÄÃÄÅÇËÍÎÒÖØ„ÚÙÔÔÎÌ€ØÕÛÙÍÃÑŒãÍ»©—ƒ¥¡é‘~¹­ÁÑŽ±ÕpÕ­¥Ñz…™£¥§Ÿ—v‰`áÁÙƒtjlv¥¡`ÁÉ‘—í¡¥©½¹¿·³¥…nÙÁÑñéÑ¡¡ÍÉÿûáÑëõãÁ``±­ÇÑϧáÁÁ­ÃÓÇÃÃá¡¡‘ùÃÁ³·«‘€É鱑ÙÕ±•±Z`dz||‰•Ÿ«­³³­¥¥—‰~x‰“©­­©›Å‰Ùqzƒƒ…~Ûß„„ƒ·Ÿ£­«¥¥©­­©©«­ÁÓÛÕËŹ³µ½ÁÃÅÉÉÉÇÇÅÃÁûÃ넇…‹Šã©Á¡ÑáÍ«Éçïåͽ£ƒŸ¥£«™ÍáL“£©µ·½ÃÅÉÍÑ×ÝßÕÍÍÏÇÁ¹·¹»¿ÅÓmqtx}‡«àáèèçççæååäääâáãäåææåãààâääåäáßßßâåæçééé‡èçæäãÞØÖÖÚÝßááàÞÝÜÛÙØØ×Ö…Õ!ÓÑÐÍȹ³ÀËÏÎÎÎÌÌÌÍÍÏÐÒÖÙÛÝÝÝÞÜÝÛÙÔ€ØÔÖÒÉÅÉsËŸ‰pb\H`h•NRH\TdTT\l•HLD`6@DFPNPJF*`@0XhVhZ<04@@@`Á™tjl•\hx…n‘‘‡pP:hÁp¡hP``p·ßÑÁ¹ÍɳrÁÁ±‘©Ÿ|@ÁÁ¥§“™©`PÑÑ—•‡ƒhi|X`h¡…LPL`,*0FJFT:6:HXZ`b\XTRND<26:>lPdxp<$@d<>DNRZXVHD0 ```|^PH>>@``ÁxpjF`‘j“™‘…hP\ H` ``Á¡|×ÑѹÃÓÓ¡ÁÁ™¥±¥pÁ¡pƒ³¡¥vZ™`@‰“‰‰~ll€PP™p…\,40N>68JD@<@8PFhdh,8‰JD@FXVTNH:0@ÁÁ`lfbdT@F8`ÁÁÁ‡vpXX‰¡l—‘‡‹~r¥D8@ÁÁáñ¿Õ×ÃÇËÛË•XÁÁÁѷé«d`Á駥Ÿ‘¹hh`@tŸ—‰‡|¹…€xpH(8xRFLHRRH:>>,0ÁÁÁPzrhZDB@ÁÁ`‰‡ƒlxxx¥||xpx|xl‘P`Á¡Á¡ÛßÏÑÓÍËX`¡™Í§½©±j0¡™­—^xt±8¡…“tpb¥fxHXTXH @‘lH~fRTJFFHHPX`dhjjdTLNRJFBFDNTZ\Z6D•±·caZ·§¯¯¯§›pnnntx|‡•§«­¯£™tp³Ñ›¶®µ¹Æ¿©§¡››—‘“—™¥»Ûƒ„‡e†„~Ù½¹±¯«±»¿ÃÅÉÉÅÙß·™£‘xh‡µÃÍÑÓ×ÛÝÕÏ«Ñ…l™ƒ©µ««§™•‘JLI‹EUaÇØÝâãßÞããáßßÞÝÜÚÙØÕÓÑÏÐÓÕØØØ×ÕÓÐÎÐÕÚÛÜÝÝÝÛ…Ú6ØØÙÕÐÇÉÍÑØÖØÖÓÑÎÌÉÈÇÃÀ½¿¾¾ÀÀÀ¾»¹·¹¹¹º»½¼¾ÀÀÃÄÆÉÌÐÒÔÖÖÖ„ÕÔÓ…€Œ~|~„~„~~~|{|}~ˆ~}|zzz|~†}zz}„…~‰~|{z{{}‰~{{}~…|{~„~~}}}‡ ~}}}~~}}~~~¥ƒ€œ‰€Žˆ€£„~‰€€€ï€€ÄÀ¾À´Ã…|ƒ‰‘“••‘“—Ù¹éùÑ•…Áƒ™‰‘əᡱÁ›£«±­³›ÝñáÁ@p‹£·¿¥‘‘ÁÁ|•“‰¹ùd¹‡…~~‡‰ƒ½pÁ`0x~ËçíñåãÍ¥@@‘Á£±Ã¿n0 ™›¥‰±•‰p`|›¥Ÿ¥“‹Õ€‰`‘­­áÙÑùÉ•Å¥£¹¿ËÑÙßéçñõûýõñëçåáåëïóïóû÷ñ¯Ïáã„‹ûÝÑÙÕÕÏÇÅ»³±±ÅËÍÛçáãß×Á›Ýµd™z©°ºÈËÐÊÌœ¯›“‹‡xvx|‡™›§Õx‡ŽŠÛ™‹¡Ÿ­Ç×åéñóù•¦ŠÃµL³›|¥ÑnããëáßÙ¯ƒ©xÍ—ÃËÇÑÑÙåíù‚‚÷ïõ‘¡ºîïêæêðîììëéèèæäãáÞÛÙØØÙÛßààßáÞÛÚÚÚÞããáâ‡ã4âáááÞÚÓÐÒÖÝÝÞÝÛÙÖÒÌÉÈÆÃÀÀ¾½¾¿¿À¿¾½½¾¾¹¸¶·º½½ÀÆÌÏÒÔÕׄÙÚÖÔÑÍ€ÔÔ×ÖÄË‘¡©©›‰‹z`|ùzÕ­tµx…|lj…H¡¡á¡©|™™•r…p``Á‰§«©ƒ‰ÁÁÁ­·³ÑÉ‘µå›¡§¡¡©©¡ŸÝ‘Á`0±—ï÷õõïááÇÕáÉõÍáÝÙ…±­¿ÁµÅ‰©É“©«¡Ÿ“Ý€©‰ñÉ­É‘¹Ýµ‡µ‘f“››ŸŸ£©©­­««­«¥¡›§¯¹»·…Ñå烃íßÝÓÏÏËÃ÷±¯­¯»ÁÑÛãáÝÕ¿ŸíÙ»‹´¶½ÉÌÐÊ̢Ż»µ­¡™—•›§·¹Ãñ‡“˜–œšù·©ÅÑ×Õ×Ûåíïñõû–§ŒÓÏ*ͱ“ŸË÷ý÷ùõóñǙٛ͡ÇÍËÕ×ÛÛÝáorãÙÝ}Š£Ûéëíì„ê!éèææäâáßÜÚ××ÖØÚÞßàââàÝÚÙØÜáãããäåå…ä<ââãàÜÖÒÓØÝÞàÞÝÚØÕÒÑÐÌÈÆÆÅÅÆÇÈÅÃÁÀÀÂÂÂÁÀÀÃÅÆÉÌÏÒÖØÙÛÜÝÝÞÞÞÜÛ×€ÒÑÏʼÅ|lz‹›|ZLJ<``@(H>@DFDBF248``Á @flh^F@HÁÁpvƒx‘™d…­tx~xzƒ||±P`Á¡Ñ•×ßÓ×ÙÑÁ›™@‘¹Ñ«·±©Z `™›‹…b…hXXhz‡xvpn©€P8‰‰h8x™hZ‡^:NNJHLNTZZ^^```RLNRPJFHHTZbd`8D™«¯be¹«§­£…ƒvpnnt|ƒ‘©­­«•v¥f¡}©­µÀÃÆÀ–«Ÿ›•…~|……¡©·á|ˆŒ‰‰‚Ï—£§©©¯³¹ÃÅÉÍ׌ ‚µ«H­™|~ŸÉiÓÏÕÕÝá¿•¹txµ‡­­©­­©™—KM—“Vb‚ÂÕÝâãßÞââáßÞÝÜÚÙÖÔÑÏÎÎÎÑÕÖÖ×ØÖÓÑÐÐÔ„ÙÚÛÛ„Ú!ÙØØÙÕÐÇÈËÏØÖ×ÖÕÒÏÌÈÇÆ¿½¼»»¼½¾¼º¹„¸·¸¹¹¼¾¿ÂÄÇÊÍÎÐÒÔÕÕ…ÔÒ…€Œ~}~~…~…~}{{{}~ˆ~}{{z|~†~zz|„~}~~~‰~|{z{|}‰~{|}~…||~„~~~}}‡ ~}}}~~}}~~~¥‚€˜~~Š€†€ƒ€ˆ€ˆ„~Š€€î€€Ä¿¾Áž³vz~‡‹“ùÉÉ…ù•¡¡…Õƒ“‘É‘‘¡Á‰±•©¯­±¹§Ù™¡Á`PÁ±»¹‘ÁÁ±zƒ›|ùxÝ|ƒ‡‘‘ƒzƒ||á``0L‡Ããïõëã¿›µ@©µ«£ÇµÁx\¥f™…Ñ­‰P™­£¥‘‘Á€`t͡饇…ý£¡íý¥µÇÉÓÛçíçï÷÷÷ñíéçåéïóùýïóùõí½™Ññù‰íÏÍ×ÏÉÁ»¿¿½½¿ÇÉÉÅÉÉÉË¿¥‹Í­Á¹•»ÄÎÓÓÕÏÑ¥§n^TZµ©­±±¥½nrz“·ËÓË­~µ¹‰£©­·ÇÓáãé톶Ôß|OÓÇÁÏlqrssuÝÓ¥T\¥‘ÍÍÍÉÉÑÙßåéõù÷ñéñŒ›¶ïîèåéîîëëéèçåäâàÝÚØÖÖÖØÛÞàßßàßÝÛÙØÚßàßáâãã…â ßàáßÚÒÎÎÔÚÝÞÝÜÚØÓÍÉÈÆÄÁ¾¼¼½½»¾À¿„¾¹·´µ¸º¼ÀÆÍÐÔÔÔÕ…×ÓÒÎÊ€ÕÓ×Ö®µ‹£Ÿ¡™‹ƒ|b‰™áƒ|Õx©‰t½tnhf¡`pá¡Å“›››••x™@`Á‘Ý­«£z…ÁÁñ‹³Í‰‰•ý•›Ÿ£•¥¡—ñ¡`@…±éó÷ùõÝÓ¿ý¡ñõÙ×ÛÇñщՋ§­‘Ý­ÁÁ™§³§Ÿ‘•É€±Á©í¥ÉxxíŸåÝ‹“££¡£©§§¥¥£©§¥¡Ÿ£¡¡££§­µµµ•‹Óõû†ˆëÝçÑÉÇ¿»»½¹¹»»ÅÉÑ×ÝÝßÑ·‘åÑí×£ÅÉÏÒÓÕÏѨ½‘‡‰‡õåééíåý‘‘›µ×éééÑ£ùù§ÇÑÕÓÓáéééóŠ¹ÔĦ‰OéÝÕ…‡ƒ„ûóÇÉ…‰Å™ÕÛÛßßáããßßÛßáåã几ÚéêìëêéèèèæåäâàÞÛÙÖÔÔÕÖÙÝÝßàâáÞÚØ×ØÜàââääå„ä ãââãàÜÔÏÐÖÛÞàßÝÜÙÖÒÑÐÎÌÉÆÅÄÆÅÄÄÃ…ÂÁÀ½¾ÁÃÄÈÌÐÔ×Ø×ÙÚÚÚÛÛÜÚÙ×€ÓÐÏÊ¥¿|hxv™~\LFBDDx$ @|\LtH($8tXD(,8@`PpP`bRJNJF0ÁÁ`DbZ\X$`ÁÁtz…©©`p|zzpƒ¡‘ÁÍvƒ…ɉ@ÁÁÙ¹¿ÁÇÏϽ¯‘©pxx‡·»¹­‹rzÍ‘­“‹r^h|……“zjlt€`H©™plVjlvl^•Tth`dZVRRZXVXXZXVTPPRPRVXVbnX0`relhhÁ··•‹|xnz~…••‰“›\lLP8¡ÃžÂÊÎÒÏÍɬ۹p©±p‰‘‰Áá™™™±¹l‰…¡Á—¡¯½ÅDZ¯Ëǹ‡ËÐÎÈÀM±¤’|xxzwçãÇ™õñÍßÛÙ×ÏËǽ¯­§§££¥¡ŸR`hk²ÒÙàâàÞßÞÜÛÚÙ×ÔÑÐÐÎÌÌÌÍÏÒÔÖÖÕ×ÕÓÐÎÍÎÒÕÖ؆Ù9ÚÙÙÚ×ÓÊÆÆÉÑÕÕÖÖÖÔÒÎÌËÊÌÌÇÅ¿¼¼¼»¼ºº¹·¶µµ¶·¸º¼ÃÆËÎÎÎÐÏÎËÎÎ̈́΄€~~|}~†~„~|{{||}~‡~|zz{~„~{zz~Ž ~~~}|{|}‰~|}~ˆƒ~…}~‡~{}„~†~~~„€•~~}}~~Š€~~~}}|„}‚|…}†~‹Ž€„‚~“»½¼‹¥‘~íÉj~…‰‰…ƒ…ý‰áá¡á……ýѹ雑ÙáÁ0 @áÑ›©¥·Å¯ý©ÁÁ`™åƒ©³¡ÁÁÁh|~•ƒt‡‘‰µ¯vípx…±p`0‰Ÿµ·ÕçÝ÷™0(h•Á½ÉÓÕ¿«ƒx‰—›§™±­‹—»Ë«|z…€ ‘vzéù¥™™‹Ý‰·ÁÁÍÏÙãïåéåéëííëççéåßãëñõ÷óÓµÑᄈÿåÑÍ÷¯¯­½ÃÅÃÇï¡•¥xpxp­Ý“á§ÉÐÓÜÛÜÝ×ϲt\hH 0  08PhPlx•j©¯µ¿×çÝÕÕÍÙ¨ÝÛØÐÐOÌÌƳ§Ÿ˜{ë·~|©ÍéßÙÝÙÕ˽¥™£¿Õáñùƒ‡Š’›©ÚóîççéççåäâáààÞÜÚÙ×ÕÔÕÕØÙÛßàßßÜÛÚÖ×ÚÚÚÜßßà„á àÞÝÞÜÖÎÏÐÑÙÚÜ„Ý,ÙÔÑÑÏÏÐÎÍÈÃÂÀ¿ÁÁ¿¾¾»¶´²³¶·»ÁÈÑÓÓÔÓÍÇÅÉÌËÉÈÆÄ€ÐÍǕï‹ýñ‡‹ƒzvrÅXP¡±é~vÉ¥¡‘…É|htÁÁPáÁ‰•“—“x™HÁÁ¹ù¯¯ÁÁÁ…‘›Çɱ‹›§«£§ÍÇýŸ«“Á¡PáÁÙÙíóáÓÉ­¹á‘©¹éãßáÝÏÅ“™µ«¹¹±™Ñ¹›¥ÉÓµƒƒ•€É…‡ùí“Ÿ“—“…å…©³µµ«£¥©«¥¡£¥§§¥¡Ÿ¡—¥«·Åçí눆ýç×ÓÇ·­¥£«·»ÁÃų©¥§Ÿ¹‘‰‘…ÅùŸéªËÐÏÙÙÜÝ×и¹Á¡Ù©áѱ±±ÑÑᙹɉ¥­ÁÑ‹ËÕãçåçãáÛÛë¬×ÓÕÔÑMÌÊÀ²§¡’‚õÓ©Ãé÷éëùïëåÓÁ¹¹ÉÙÛÛápqt~…‘ÅâèééèçæäâáàßÞÜÚÙØØØÙÙØÙÛÝßßßâàßÛÖÓÖÙÛÞáˆâ;àâßÝ×ÏÍÓÚÛÝßßÞÞÜÚÙÙØØÙÖÕÑÌÊÇÅÅÿ½¼¼¼¾ÀÃÉÎÔÖÖØÙÖÏÎÑÖ×ÕÓÑЀÔÌ¿‘Á¯‰Ñ©TvrfVF84d `p±XBd@@Ll•L*40`ÁpP‘á™PJPJH4(ÁÁ`HµNZbÁÁÁƒƒ§£‹p|‰‡‹³«pÕp~‹z™P¡Ù³½µ½Ëǵ±—‘p‰‘¡É½»µ¯§£|t‰•¥™th……§Z^d€ ‰dT…fvjnj\‘`…zjn`XVVZXTVVXXVTRTPJPV\`n|n,L™¹ijϹ¯±~vppnz‰‹•‡|…ƒxD8<@h•rÏ¢ÇÌÑÖÑÏÌÇ¿¨p™p`¡±‘¡‘Á±Ñp‘‘`…™¥¡n§©¹ÇÏÓ·±Íí–ÌÎÎÇÇ8ø¥–‘Ž‡vß»“‘ÁçåÓÕáÙÕ˽§—•§¥£§TSUbhcžÎØÞáßÛÝÛÚØ×ÖÕÔÒÐÐ΄ÍÏÑÓÖÖÕ×ÕÔÒÌËÍÏÒÔÖ××„Ø ÙØØØÖÒËÅÅÈÑÓÕ„ÖÔÑ…Î%ËËÇÂÀ½¼¼¼º¹·µ´´µ¶·º¼ÃÇËÎÎÎÐÌÅÃÈÊÊÉÉÉË„€~~ˆ~~|{}~†~ ~{z{|||{~†~}zz{}~~zzz~~„~}{|}‰~|}~‰‚~…}~‡~|}~~†~~~~€€”‡~‚‹€~~}}}ˆ|ƒ}…~Œ€–ñ€€µ¹±x¥‹vÕÉr…‰‹‹…ýý‘Ñ`háùáɱ‡­¡±á@Á¡Ñ‘‰£±½½£ÉÁ`ÁÕ·¹ÁÁpzƒ‡‰Õµƒ›¡­¥ÅÁ…érv…‰zx``‘Ÿ±¹ÓßÓ¿½l0 X›Å¿ÉÏÙ͹lp~Ÿ±¥Ñ‰™ÁɯÝé¡€xz|‹§¥Ÿ™…ÝÉ“³»·ÓÕßçïçëéëëëíëéçãÝ×ÝåéûûóíÉ|Û|†÷ßÉ¿¯¥¡¥§·¿½¹·­›—“…á…™Ù‡•«ÝœÃ××ÙÚÛÝÚѺÁ‘tXX`d\‘P0 @8™|­©­±z­±»ÉÝëáÝÕÇç¼ÛÞ×ÑÎMÎÐÓÒÍÊÈÀ¶®”yãåãí÷ãÑÑÏÅ©‰‘³Í×ßïý‡‹’•£ÏóìæåçæåäââàààÞÝÜÛÙ××ØØÙÛÝßàßßÜÛÚÖÕÙØ×ÚÝ†ß ÞÜÜÜÚÕÎÏÐÐ×ÚÛ„Ý,ÚÖÓÓÐÏÑÏÏÌÉÆÃÃÄÃÁÀ¾¼¶µ²³¶¸¼ÃÊÑÓÓÓÑÈÀ½¿ÃÄÂÃÀÊȺ‚Á¯‰åÙ‰‘“…zvÙÉd@¡¡…ñåf¹­¡|njfh0@¡‘᡹‰…••‘|•ÁÁÁõ‘©µ©ÁÁÁ‹™¹Å­éý£·³½ÅÝÕ•ù›©…¡¡ùÁ×Ùëë×Ïͱ™ñÁ‘½éçåáããÙ‡…¡¥»»»¥á›§ÍϹéùµ€±¡‰‡‡…£—ƒÙÑ—·»»¿µ¯­«­§¥£¥¥§¥£¡Ÿ™•™¡£ÃÉÇÃÙ냃õãÏŹ«£¡¡«·¹¹»±¡ŸŸ“©ù‘™©ñ—§·ç ÅØÕ×ÙÛÝÚѾÙÕ±‘•™‘ñ±Ñ‘¡Ñ™ùµÙåáåí›Ï×çïëçååÛÙÿÁÖÖÕÔÐNÎÏÎÌËÈɹ²›ïõõùÿýóñïçÉ­©©ÃÓÙÝßáqs…´ÝåççæåäãáàÞÝÝÝÜÚÚÚÛÜÛÚÛÝÞßßßâàßÛÖÒÔÖÙÛßà†á àààÞÝ×ÏÍÑÙÛÝ„Þ,ÝÜÜÛÙØÙØØÕÑÏËÉÇÆÄÃÂÀ¾½¼¼¾ÀÄËÐÔÖÖÖÙÔÌÈËÏÐÏÎÎЀÎÆ´~½­ƒ¹™XxrdTF6PL `@`©|.DLDP@,*0 `0áÁ¡Z@PF><2DÁÁ0¹RXj<`ÁÁÑ‹‰›¡¹Á‡››§©Ã½~Ñrz‹…n\`ÁÙ­¹µ½Ã½¯·™pÁ­ÏÅÅ··½»td|™¯¡›`±…‡¡£…™±€h|dRHJjxtnZ…t“‰~znd`\\XXVVVXXVTRLHLTZlvƒN…d½gkË·£›xlddfp|ƒ‡‹‡z|~vx‘TP\^h…Ç•½ÒÑÓÐÎÌÉÀ°Á¥lhx…ᙡ`¡hɉ©½Á¹¹~©«½Ï×Õ¹µË¿¹¤ÇÐÍÉÆMÅÆƾ¸·º´®§uÛçåãããÝ×Õ˯•©§¥¥©VVde]ŠÇÕÜßÝÚÛÚØØÖÕÕÔÓÒÑÑÐÐÐÏÑÓÔÖÖÕ×ÕÔÒÌÉËÍÎÒÕ†Ö„× ÖÒËÅÄÈÐÓÕ„ÖÕÓÒÑÏÎÎÍÍËÇÅÁ¿¿¾¼»¸¶µµ¶¶¸º½ÄÈÌ„Î -ÈÀ½¿ÃÃÂÅÇÉ„€~~‡~~~|{|~~~~~~}~~||{{|{{}‡~z{z|~~{zz}…‚~ˆ~…~{{}‰~||~‰‚~…‚~…~~~}~‰‚~ž~€€“~}„~„‹€‡~‚}„|‚}†~Œ’€”ð€€µ¾§Ñ‘Z­ÁÝ‘‘ƒùý™¡ÁÁ@™ÑñíÍÙááÍ…µ™‰ñP¡ñõ—«·µ§åÁ`Á‘µ‡›µÝ¡Á`@•ttxÉ…f™µÉÃÉÏ¥‹~|‡•Åpd™¯Á×Õ˹»•‘ @‘¿¿ÃÏÙͽÉÑX­f£¹·‹‘‘©ÅǷ͹™€Á¥‹“§™‡Õ½Å‡³³³¹×áéïëíïëííëëíëéÝÝÛßçó„÷ñ½¡ÃÝñýëÕµŸ™‘“§·»±©£“‰‹Å…镽ƒ‹“•§Åí¶ÎÚÚÛÝÝÞ±Õpd©¥¥¥­¥™™¥±½fhd½¥µƒ¥­½ÑßëëÛÁ¿ØÙç×ÓÑ8ÏÐÒÔÔÓÒÍÌÌÎË¿®¦ŠtÓËÁ»©‘‰“¹ËÇÅÏåûŠ•‘ ¿îêäãåååäââààááàßßÝ„ÛÜÝÞààßßÜÛÚØÖÖÔÕ×ÜÝÞ„ß=ÞÜÛÜÚÕÎÎÏÏÖØÚÝÝÛÚÙ×ÕÖÓÑÒÒÏÍÌËÇÇÇÅÄÂÁ¾¸¶µµ¸º¾ÅËÑÔÒÓÍÅ¿¹·º¼¼ÀÃÃgÆȭݧ…åÕé—Ÿ›“‹…xÕÑp@ÁÁááÁ½Éµ¹Á±¥lb@8Xñ¡ááù‡•…±``ÁÁÝ¡«¹ÙÁÁÉ—­·«åɇµÉÙãß㵕™£­£ŸÑ±á¡½ÕãíáÏÇË©ÑÁ±x³„ã€çåßÍéù—½Ã·•™¡·ÑÍ¿ÝÉ­ùÁ‹‘‰ÝÅÉ·¹¿ËÅÿ·³³«©§§¥¥§£¡¥£¡§¯±elÑ˱©×ñýõé×½©§Ÿ™Ÿ¥¯·µ­©™‘•‘å‰ñɉ—£¥µÓù‘¸ÎØÙÛÝÝ۳둅ÕÙÝÝÝåÝÍÍÑÝéù‡‡ƒýáñ¡ÇÓë÷ïååáÍÙ›ÞÔßÔÖÒÏ΄ÍHÌÌÎÎÍȾ²­¢ƒùïåß˵«­ÉÕ××Õ×áw††ŸÓäææääããààÞÝßßÞÞÝÝßáßÜÞßààßßâàÞÛ×ÒÑÓÖÙÝ߆à<ßÞßÝÜ×ÏËÐØÛÜÞÞÝÜÜÝÞÞÛÙÛÚØÕÔÓÐÍËÉÇÆÅÂÀ¿¾¾ÀÃÇÍÑÕØÖÖØ×ÐÉÇÈÈÈËÍЀÌȨۧѩ¥jxfTJ6<8 0ÁÁ¡x`DLTX@P2&$(` @ÁµHJD840X`¡ÁP¡`\ph@ÁÁÁÙ‰“—½j™±ÁÅÅÉ~~ƒ‹‰¥pÑ…¥·¿¿¹µ©µ“‘`Ñ«ËÉŽ¹Ãá±lõ•©¥‘lv‹•¥¡‹…x€±hRPRbp^‰txd›——…vlfb^ZXXVXXVTTTRV\h;D—|±ÇÏÏ¿«‹tbZX^dtƒ|~vrzz½d™l‰fhbb~¥Ñ}©ÁÏÐÎÍÌÌ¥Óvj±©¹½ÉÑɽ¹ÁÅÉÑljhÉ­¹Ÿ§Á×ÙÓ»±»»tºÁØÎËÈOÆÅÅ¿¹»½¼ÁÄÁ»¯¥¢‘vãÕËűŸ™—©³§Ÿ›«ZjdXs½ÔÛÝÛÙÚÚØØÖÕÖÖÕÕÕÔÔÕÔÒÔÕÕ×ÖÕ×ÕÔÒÎÊÈÉÍÏÓÕÕ„Ö=×ÖÖÖÕÑËÅÃÆÏÓÔÖÖÕÔÔÓÓÓÑÏÐÐÎÌÊÉÆÃÂÀ¿½»¸¶¶··¹¼ÀÇÊÌÎÎÎÌɼ¹º»¼ÁÇÊ €€€~~~‡~~~|zz{}„~}{|~~}}}|||{|~†~{{z|~~{z{|~„‚~Ž~||~‰}||~ˆ~}~~‹~~~}~‡ƒ~š‚€š~~}~~‡Š€ƒ~~~~‹™€ï€€²ºœ¿…­¥¹Ý¥“•¡£›‘…¥ÑÁÁ`Á‘åÙ­‰‘Ùåíá‘ṡÁ¡¡ppŸ±»½§¡¡``Á‰™™¥xÑÁ``Pj‡¥‰b™­·ÇÏÑ»§—‘‘•nx¡­r­ÛÙÕ»¯»«` d‡¹¯ÏåÉõ­©¡™©“ÁµŸ™«¹»©T©€¡Á‰••“½­›¥¥±¯Íåëéãëëïíááçéïñóñíïùû‚ˆç¹»Ç×åïé¿¥£¡—™ŸŸ£§¡¡“ƒ‘‰µXÙxÁå~‰‘›­¿Õá­ÖÝÞÞßá¾o‡‹ƒ~xvtrtrjfbbbddb©p­£±ÃÕáåáÓ·­µÙÛÚØÔÒ/ÑÑÑÒÑÑÏÎÎÎÐÐÎÇËɼœ×·¯»­›¥¯»½½½»Å鈑–”¸ïíáëèàãâà†ßÞ†ÝÞßáß„Ü ÛØ×ÕÔÑÒÔ×ÚÚÚÜ†Ú ØÔÑÍËÎÒÕØÙÙ…Ú)Ù××ÕÔÓÐÎÍËÊÆÄÃýº¶³´¸º¿ÃÈÍÎÎÎÊÈÇÁ»¸¹¼ÀÃÀÍÊ¡¿éÝåí«©—…ƒ|vfp`ÁÁ`Á•ÅÁ±™¡`éñá­D`x¡á¡0Á‰‡`áÁ™¥©¹ñÁ``Áµ­³íщ¿Óßççå˱­§¥§«…‘¡Á‹ÏïãáÑËŧ‰¡¥±ëãáÛçõËÉñùÑå¯×˳©­¿ÏÑ¿é‘ù€áÝ‘“‘‘‰ÙÁÙ‹µ»½ÉÉÇÉÿ¿¹«©©§§§©§­¥§§¯·½gpmÁ»Ïéóûïé駡——›¥«¥¥“‹‰Ù¥ù‰Ñõ‰“§½ÕëùŒ¸ÜÝÜÝÜß¹¯Ÿ›•““‰‰‰‹‹‡ƒƒ…íÉ­ñÉÙçõ÷éáçÛÕ¼ÕØÖÑÐÑ1ÐÐÐÑÐÏÍÍÎÐÑÑÏÊÌ˽žïéßëÝÅÅÉÍÑÓÕÙÑÝ}„ˆ‘˜Æãèäæåääâáá…à„ßÞßà‡âLàÝÚÕÑÓ×ÙÝàÞÞßÝÝÝÞÝÝÜÚÙÔÎÐÖÚÝÞÞÞÝÝÞÞÜÚÙÙØØÙ×ÕÔÒÏÏÌËÈÅÂÂÃÀÀÃÈÌÑÕÖÖÖÕÔÒÍÇÄÅÇËÏÒ€Áɦ¿r齡­«…dRJL* ÁÁÁ\t@`0Ph`PHP`0‘b:HNJ:&``@Áxzhf<ÁÁáp•“±•hŸ³¿ÉËͳ›““^X¡¥h±×ËË·¯¯™`` •É¿Å½µÇ±±ÁÙÉÝŸÁ¯‹|‘™‡|P©€™µjZRTVRp`‰h£¥«¡ƒtt|lXPRVVRNPPNPNTZh>HJ~ƒŸ»¿ÁÍ×ztZTV^`nxxxn`lp©l©\µfrpr|‘±¿q ÉÏÔÖÖÙ¸t™›‹…ƒƒzz~ztpjhffh½½¥É©¹ÇÙÝË»¹©¡ ¼ÅÍÏÍÈ1ÇÇÈÈÇÇÅÄÄÅÈÇŽ¿Áµ–áÏÇÕÇ££µ½±©§¡‘£`e`cx®ËÕÞßÜÜÛÙØ×„Ö ÔÑÕÖÖ×ÕÕ×ØÖ„Õ=ÔÒÏÌÉÉËÍÑÔÔÖÖÕÕÕÖÕÕÓÏÍÈÃÅÊÎÑÒÒÔÕÕÖÖÔÒÑÐÎÎÎÍËÉÉľ¾ÀÀ»¸¶µ¶º½ÁÄÉ„Ë ÊÈÇÁ»··»¾ÂÈ€€€„~‰~|zz{z„~}{|}„~}}}|{||‡~{{{z~„|z{{}„‚~}}~‰}{|~ˆ~}}~~Š~~}}~†ƒ~›ƒ€˜~~}~~~ˆŠ€’„~Š™€ï€±µÁ‰±µÅÝ«¥™Ÿ£Ÿ™“ý¡ñ„Á€±ÝéÕ¹Á‘Á݃ƒ¹Á‰±Á¡‘`•—¥¹¿³•áP`x‡›£tÁÁ``µ‰‹^r£¯»ÉÓÕ¿¯©£™›z•¹j£××Í»«»¡x v±³Ç׎§©`™—û©§¡­¹½«•‰`pµ‘•—Ýt‰¡Ÿ¡³Ñçíçßëë€ïëßßåçïñ÷÷óóûùÿ‡…ç½½ËËÑÝѵ£ŸŸ¡¥¥›‹ƒÑÕ½…Lùµù‡‘§·Ç×á{«ÖÙÞààáÐŒ¡—‡~~|~~tlh\±±¹¹hXLp±ÍÙÝíáÕµÅÂÙÜÛÙÖÓÓÓÔÔÓÒÑÐÐÐÑÐÏÍÏËÊ·|¿µ­§­±·¿¿»·¹Ãë‹”—’±êìáëèàããáàà„ߊàÞ„ÜÛÙ×ÕÔÐÎÑÕØÙÚÛÙ…Ú ØÔÑÍÊÎÑÔØØØ…Ú)ÙØ××ÖÔÑÐÎÍÌÊÉÇÅÅ¿»¸³¶º½ÀÄÈÌÍÎÌÊÈǾº¹º¾ÂÃËÇ™ËÙÕáí¯½Ÿ‹‰…zÅp„Á€±µ½½‘0@Áé|lhHH¡á`0Á­‡••“~±pÁ¡©™µ¿ñÁ``‘ýµ¯±ƒÕ—ÉÕãéééѹ·±©¥§•¥¡Ñ…ÅíáÛÓÇʼnáÁŸãçÝ×ãñ½¹ñ¹Õ³ÛѽµµÃÏÓýÙÉáù•™—•“…õ¯µ³±·ÍÇÉÅ¿»¹«„§~¥§§­©««³»¿ÍrqͧÃáåçÝÓ¹§£™¡¡Ÿ‘‹ƒåѽñ­ñ…‘«»Ïáé¯ØÙÜÞßà՚ǻ«£››™—“‹ƒýùõíÑ¥‘­¥ÓíïñïáçÙåÆÖØ×ÒÒÑÑÑÒÒÑÑÏÏÐÒÒÒÐÏÑÍ˹†åÛÙÓÙÕÕ„Ó×Ñᇉ“Ááèãææääã‡â„ãƒá‡â àÞÛÕÑÑÓÖÚÞÝÝ߆Ý9ÛÚÙÔÍÏÔÙÝÝÞÞÝÝÞÞÝÛÚÙÙÚÙÙ×ÖÔÓÓÑÎÊÇÄÃÄÂÂÅÈÌÑÕÕÖÔÕÔÒÎÉÆÄÆÊÏÒÂÇœÇ|å½±¹™½‹dVPR24 „Á€h|‘`PPPh644P``0á‰LJTR< 0``pprpDÁÁ‘Á•‘d™x©µÁËÏѹ£¡™“‘‘bp¡^§ÓËù¥«`@@…ÁÁ¿·±Ã£¡Á|µÑ£Ã³•‰‰“›‹dx‰Án^VVZ\¥f•©­§›Ÿ•‡zxxlX€PPVVPLPPRRRX^l~LO‰n—¹½¹·©vpZZ`hhlbdh`•™‘pT©…½djjlpx‘­·i™ÆÌÓ×ØÙÉŽ­§›“‹‹‰‰…|vh½½½¹t|‰…µÑÕÙÑ»¹§³¬¿ÆËÏÎÉÉÉÊÉÉÈÇÆÇÈÈÈÆÃÃÂð×ÍÉŽµ¿Á»­£¡—¥chaar©ÊÕÞßÜÜÜÚÙØ„×ÖÕØÙÙÚ„×Ö„Õ ÔÒÐÌÉÇÈÊÎÒÓÕÖ†Õ9ÓÏÍÈÂÅÉÍÑÒÒÔÕÕÕÖÔÓÒÑÑÑÏÎÍÌÍÈÂÂÄý¹¸¶¸»¾ÂÅÈÊËËËÊÈǾ¹·¹½ÁÈ€€€„~ˆ~~|„z}~~~}||}~~}}|{{|{~†}||{{}„|z{{}~„~ƒ~‰}{}~ˆ~}~~~Š~}}}~†~ž‚€•…~}~~‰Š€‰~Šš€Žï€€·®|Ç‘ÅÉÑÙ£³£Ÿ§£“é‰á¡Á`ÁÅõí©™‘©Åƒå©¡Á`áÁ`™£«¿½­‘¹P Px¥Ÿ¥`ÁÁ`8­‹^•ƒ§©µË×ÙŹ½µ«¡¡~zÝr•ÏÓÅ¿¯Á™‰@|d¯¹ÃÑ»±“™¡dµŸÉÅ»¹«±¹½­xH€`\“‘“‘|™§©“~‰½ÕéóíáëéíçÛÛãçïñù÷óõû÷ÿŠ‹÷Á±¹µµÁ¯¥Ÿ››—™™—‹íz~á©Ñ\¥ñ‰‘—¡±½ÇÙéñû£ÐÙÞßàÞÞ©»•…ƒƒ‡…vrh||‘|d`\‘ÑÛßïã×ÁwÑÙÜÛÚ×Ô/ÔÔÖ×ÖÕÔÔÓÓÒÑÐÐÎËÐÊŸßµ½³§¯¯¯­«©±Ã錗™“¯ãêáêçáäãâ†áâ†ãáàßÞ„Ü ÛÙÙ×ÒÎÊÌÒÖ×ÚÚÙÚÚÚÙÚ×ÓÏËÉËÏÒ××ØØØ„Ú(ÙØ××ÕÓÑÑÏÏÎÌÊÉÈÁ¾¹´¸½¾ÁÄÈÊÌÌÌÊÉÈľº¹¾ÂÃ'ÎÅå›ÍÕÝá£Ñ­‘‘ƒz­d±¡Á`Á‘•Å¹x80‰Ír‘ 0Á„`€±‘›™•‘ƒ©¡Á‘᱋½¹ÕÁÁ¹õ±³³…Ý©ÍÏÛëííÕÃÁ¹¯¥£©ý‹¹çÝÓÕÍÉ•™±±½‹ãëÛÑáí³¹é‘¹ñ»ßÛÍÇ¿ÇÏÓé±±ù—››™•‡¹Á¹£‘‘ŸÕÍËÉý¹©§¥£££§©­«««³»¿ÍuzÝ•S§ÃÉÉ󩣟¡››“ù…í½¥…ù‰Ñ|ƒ‰™§³ÁÑåéõŸÎÛàáâßä³Ý½µ«¡ŸŸŸ™“•‹é͹¹½±•‘ùůëïíóãçÛ„ÒÕØÖÔ„Ó/ÔÕÔÓÓÑÓÔÔÓÑÑÐÍÑ̤óÑÝÝÓÕÏÇÅÉËÓÓ烊Œ»ßèâæææäääã„âã‡ä‡âLáÞÜÖÑÏÏÑ×ÛÜÝÞÜÝÞÝÜÝÛÙØÒÌÎÓØÛÜÝÜÜÝÝÞÝÜÜÛÙÛÛÚÙØØÖÖÓÑÎÊÆÅÅÄÅÆÊÍÐÓÔÔÔÕÕÔÑÏÊÆÆÊÏÒ€ÈÅáÝÁµ½™Ï—fZTN84 P`Á¡Á@…¹l`@`6.`0Á``¡‘`NXXB&0p ÁPf…v`@ÁÁÁ¡¹‘““d‰­¯»ÍÕÕ¿­­¥›“‘p^Z©^›ËÇ»»©­‡X@¥tÁË÷³Ã™¡¹…±é«É½¥›“—›‹\Xx€©nxh\Z^jrŸ¯«·¡‘ƒ§›~lTNNRRNLPPRTTX^p~PX\|¡©£™‡vnhb`dhhf­`b­|lX‘Hd¥`bhjrx›¹ÁÏŽ¿ÍÕØÙØרÁ«£™‘‹ƒƒxµ…|l‰‰¹‘‘Ñ××Õ»»«l¼¿ÆÊÍÌË1ËËÌÌËËËÉÊÊÉÈÈÅÂÃÈÄ¢óÍÛÕ»³Á½«£¡Ÿ™­dkcbp£ÈÕÞßÝÝÜÛÛÙ„Ø ××ÚÜÜÝÚÙ××Ö…ÕKÒÑÍÈÅÃÆËÏÒÕÖÔÕÖÕÔÕÓÏÍÆÂÃÈÌÐÐÒÓÓÕÕÖÕÔÓÓÑÒÑÐÏÎÏËÆÆÈÆ¿¼¹¸»¾ÀÂÆÈÉËËËÊÉÈĽ¹¸¼ÁÈ€€€„~ˆ~~|{z{z|„~ -}|}~~}|z„{}†}|||{|~|zz{}~„~‘~‰}|}~ˆ~}~~~Š~}}}¦‚€‘~„~}~~~‹‰€Œ‰~}~ˆ›€Žï€€¸™iÅ…åÝáÙ§©›¥Ÿ“ÅÙÑ¡ÁÁ•ù•­±á•éñùÙáÁ`¡`±«³»¹­›¡‘@@0Pj£™ÁÁ`X‰r™—`•ƒ¡«³Ç××Çÿ»³©¥››zxÃÏÅ÷¿±±PL\·»Åѳ¥½™¡­zŸÇÇÁ¿³µ»»©h`€pV‡‘•“‘“£¥rt‹¿ÛåíëáëéëçÛÛãçïóù÷óõûûŠŒ‚ÅŸ¡¥¯«››—›™›™“zÙÕµ•‘l‰µý‘›¥³½ÅÑÛåë놭ÌÛÜÞÜß¾ñ£“…ƒƒ……~zl|t•ÁÑjÙÍ•tzÍáãíçÛÑ”ÔÖØØØ×ÔÕÖ†Ø)ÖÔÒÐÐÎÏÏÌÌĤy»§££¡›Ÿ¡§»åŠšœ—±àçâéçáääããã‰âãâáàßÝ„ÜLÛÛÚ×ÒÌÈÉÏÔÖØÚÙÚÚÙØØ×ÓÏËÇËÎÒÖ××ØØØÙÚÙØØ××ÕÓÓÑÑÐÎÌÊÉÊÄÁ¼·¹½¿ÁÃÅÉÊÌÌÊÉÈÈÇÆ¿¿ÂÂ'̶…í™ÑÑáÝË·—“…x‘±ááÁ`Á‰ålr\0™éá©``Á„`€É—Ÿ—“›•¡±Áá‘Ñ…¿¹ùÁÁ`‘Õ™µ¿½…Ý©ÇÑÙçíë×ÍÇû±­³§—‹‘¯ÛÙÑÛÕÉÉñÁ…ƒçëáÕÙá­Ùáù噽ÝÝÕÍÅËÑÑ¿±¡Áùƒ•Ÿ›•‘¡Å¿±…¡ÙÓÅÅÁ»¹©¥£¡¡£§©¯©««³»Çjv~v«Y«µ¹¯¡Ÿ›¡ŸŸ—ƒéåÁ¡¥¡…‘µåƒ‡‘›©µ½É×áç热ÏßßáÞâÀû¿³«¡ŸŸ™›Ÿá¹¥Ááõýñ½¥áñíïëëåšÓÒÓÒÒÓÓÓÔÖ×†Ö ÔÒÑÐÑÑÎÎÄ¥ÙÍÏÍû»½ÅÍÑ僌Ž”‘·Ýçâ„æƒå‹äãâàá„âLáàÞÖÑÎÍÎÓÙÚÛÝÜÝÝÜÜÜÚÙØÑËÌÑ×ÚÛÛÜÜÜÝÝÝÜÛÚÙÚÛÛÚÚØÖÖÓÑÏÍÊÇÇÆÆÇÊËÎÑÓÔÔÔÕÔÔÓÑÎËÌÏрʴ…ëÁ¥¥­~ÅŸhZTH<8HÁ`ÁÁ`|Í>2,0@Hxhd`Á``©jNXXN>$Pp0p`^‹ƒPÁÁ¡±x•Ÿf‹§±¹ÉÓÓÁ·±­¥›—~rf^l‘ÁûÁ«©v`©xrÍÑÉ¿¯¹—Á±Ùá•­Ç¿«¡™›Ÿ™‡hh¡€¹hxjb`dr…©¯§­‘‹‹­§‹ƒƒlTLLPPNLPPRTTX^xET^Xtr‰pjf`jhppl^©©•tthLTpµddltx…“§¹ÁÅsŸÁÓÖØ×׸믡™“‹‹‹z±t‘µÉjùñ¡pvÉÛ×Ñý·„¿ÀÃÇÉÌËËËÎÎ…Í"ÌÉÈÇÄÃÆÆÅÂ¥~Ï¿·¯·±¡››¯emeeqŸÆÖÜß…ÝÛ„Ú -ØÖÚÛÛÝÚÙ×Ö†Õ&ÔÓÍÈÄÂÂÈÍÐÓÕÔÕÕÔÓÔÒÏÍÅ¿ÂÆËÏÏÐÒÓÓÕÕÕÔÓÒ„Ñ!ÐÐÏÌÆÆÈÇÿ¼º»ÀÀÂÄÅÇÉÊËÉÉÈÈÇÅÀ½¾ÁÇ€€€„~ˆ~}|{z{z{~~~||„~}{z„{}†~…| }zz{}~…~›}|}~ˆ~}}~‹~}}}¥„€Š~Œ‰€Œ†~„~ˆ€Œï€&²}·Ã‡õ…~‡­›•ýñÑ`hÑ¡áx¹‡™›•á±¹á‰­¡„Á€`¥©µÃ¹«“Ýp0@@Xt—0Á`l—©¥Ÿxr™£§¥¿ÑÑÅÅ»½»·³±·¥‰z‹³ËÇÇ¿¿“¡É`Xd«¿ÃÑ¥…t©`nƒ—¹»¹µ³¹½µŸ¥xX©¡…‘—™•™§³µ¿±©»Ûsÿóóñåíéëå××áåïóýû÷ùÿ‡‡„…ÿYÛ¡Ÿ••—•£~Å­¡‘ɹp``Õ«­«µ·»ÅÓÑÏÉÃå£ÒÜßÞÝڮɓ‘‰‡‡‡‹ƒzxnÅÅx‡‡‘«Ïßåëïßë±ÌÑÒÒÓÔÔÔÖׄÚ&ÛØÓÑÏÎÎÌÏÐÌÍ˾ՙ›—•——™Ÿ±Ý‡š—­Ùåáéæâä„å„ä…ãâààßß݇Ü'×ÑÌÊÉÌÒÕ×ÙØÚÚØØØ×ÓÏÊÅÈÍÑÕÕÖ××ØØÙØ××ÖÕÓÒ„ÑÏÎÌÊÌÈľ¸»½¾¿ÀÄÇÉËËÊÉÉÊÌÍÌÉÅÃÂ&ÃÿÿnÑ~…¯½Ÿ‘ƒÉ‰¡‰‘0`ÁÑÕ…‡nX‘±½ÕdtP„Á€½™¡›Ÿ—å‰ÑñÁÁ•»±™Á`•©½ÏËÅŸ™¿ÉÍÍßçåÕÏÏÏÍÉÇÇí—¯ÉÕÕßßÇ“­éÉɉÛïãÛÍË©…鱋¡³ÑÑËÃÇÏÓ͵áÑùÍ•¡§£ÃÙÙßÅ»ÏñõÕÉÅ¿¹©£¡ŸŸ¡¥©¯­±±·¿osvxïZϧ¥¥¥£Ÿ™›©£…ÑÁ±¡áÑ…‘‘Ù™¥§§·µ¿ÁÃÍááßÙÑñ©×àââÞ֮ᷭ¥££ŸŸŸ›‘ññ‡““›™Ÿ£¿ßçííõíù²ÇËÍÍÎÑÒÒÔÖØ…Ù#ÖÒÐÐÏÎÐÑÎÊÇÀ©ýËŽ··»¿ÇËß•Ž±Úçáäç‰æå„äãâáààá„âáàßØÐÎÎÎÒ×ÙÙÜÜÝÝÜÛÜÙØØÑÊËÐÖÚÚ„Û+ÜÜÜÚÙÙØÙÛÚÚÚÙØØÕÓÒÐÌÊÊÈÆÆÇÉÌÐÒÓÔÔÕÕÖØÙØÔÑÏÑ&ÄœûùP…PTd©§nXPF` @00`@‰¡>,:4Ht….$ …Á€`P\dZFXP`@‘pr‹‡(ÁÁ…­«§xŸ«­­ÁÍͽ¹··µ±¯Ÿ•~v|‘±½½Å­¥vx‘Á¹|ÇÙÍÅ¥§•vÁ‘‰Ÿ£¹³£—›Ÿ¡•|•™á±zrjlnr™³»Å³·ËßpÍŸ‹‰lTLJNNLJPPVVX\bHPUZ³§€xl`rlb\^l|z^‘x©™`XH‘vƒ|z‰…“—©¹µ·³³Õ™ËØÙÙÔЧѣ•““‘‘‰‡x½½p||‰›“‹§ÉÑ×ÏÍÁ˶½ÀÁÂÇÊÊËÍÏÐÐÐÑÏËÈÆÅÃÀÆÉÆý´™Ù§¯³¯§™›™­enffn™ÃÖÜÝÞÞßßßÝ„Ü -Ù×ÚÜÜÜ××ÖÖˆÕ%ÏÈÄÂÂÅËÎÑÔÓÕÕÓÓÓÑÎÌÅ¿ÀÅÊÎÎÏÑÓÓÓÔÔÒÑÐÏ…ÐÑÍÇÇÉËÇþ¼¾¿ÀÁÂÃÆÈ…ÉÊÌÌÊÇÃÂÇ‚€„~‰~}|}}||{{}~~|}~~~|„z{~†~}|||}}{z{~¢~}}}‰‚}Œ~}~}~Ž€”„€„~‚}„~ˆ€Œ‚~ž€‹ï€&§s`f…ñz~~ƒ™“™™í±¡¥‰0`n‡ùá‘Á‹ñ±„Á€`ͧ±¥§—Ý™P@‡—“pÁÁ`£¥­¡—››™§³·±³¹±·¹­»½·¡‘£·ÁÁÁù½•¡Pd³µ·­tndLr|¡£§¥«µµ¡tñlpv•›•©ÉÑ×ßÛpsˆ…ÿƒýõëãÛ×ÙÛßåïõóõùõ…ŒßË€»›““‘••‘‰ƒ‘£~™‘…|lx••Í•¯«©©©§±³±«¯©©««·Û»ØßÚÜÙÑx“‡ƒƒƒ‡‡‡……‡‡‡‰•›Ÿ§¹ÍÙÛÝßéá…¹ÈÈÇÉÉÌÍÐÓ×ÙÚÛÛØ×ÔÏÏÌËÍÍÍÇÅĽ¡‰‰“•—¡©Ë‚–š£©ÆãäÞãà„ã…äãáâããá„ß…Þ!ÝÜÛÖÒÍÊÈÌÐÔÕØÚÚÙÚÚÚØÔÎÈÃÆÊÐÔÖ×ÕÔÔ†Ó†Ñ -ÐÏÏÎÎÊÇÃÁÀ„¿ÀÂÅÈ„Ê ÍÍÍÎÎÍÊÈÇ&¸“‰‡«í…‹‹³¥‹‰~¡X`‰™hP‘±¡‰‹ƒfxhx½bµh…Á€õ¥¥­Ÿ¡õ±Áñ‰¹­¿«±ÁÁŽ¿ÇÓɵ·¿ÅÅÃÕáÝÑÕÑÑÛß×Ó×ϯ›µËÕÕÕÝÓ§ñÅñ‰‡»çáÛɳ§‘¥‰“Ÿ­ÁÃÇÅÅÑÓ»§ù…©‰­©³­·Ùçñùý………†…ãgǽ»­£›™›Ÿ¥­µ­±·¹irxwßÙË4«Ÿ¡››•‡™¯Áµ™±¥¥­­¥é£»¹»½¿ÁÃÉËËÏËÅ»µ¿åÀÝäââÛÓƒµ±«§†¥L¡¡¡¥«¯·ÃÏãëíïó鈹ÅÃÅÆÉÍÎÑÖÙÛÛÜÝÚÚÙÕÓÑÎÏÑÑÏÌÉÈÆ«ÇÁ½¹±¹·ÉÇÕŽ‘‘³Øââæãççææç„æå„äãââáàá„ã'ââáÛØÒÌÌÏÔØÙÛÝÝÜÝÞÝÜÚ×ÏÆÈÍÓ×ÙÙÛÜÜÛÛÜÜÛÛ†Ú -ÙØØÖÖÕÓÏÌÊ„ÉËÍÑÔ„Ö ÙÙÙÚÚÙÕÑÑ&ÅžŽ…£xDNXXz‰tN8FT `±TH @D844(xp™<`(„Á€`¥lNZT`R‰@@PTx‡—‹ÁÁ¡™­­µ§—¡¥¥£«·»¹¹·µ»½·«¯§‹x—«³³µ¹±…­…‘\v±åÑǹ—‡…p‡““§§££ŸŸ…j¹d`t`pbxz‹«¹ÁÉÙpuy~n³O…xlbRHDHJNX^^^ZV5JRZ±­€·‡l\TTZ^ZVhtRlx…dX\\X•v‘‘‘“—¡©©µ³­¥›§Í´ÒØÔÓÑËw¡—““‹‡ƒƒƒ‡—¡©³½ËÕ×Õѽp§·´¹¿ÁÄÅÈËÏÑÒÒÓÐÏÍÉÇÆÂÁÆÉź»¹ ©››¡Ÿ•™‘Ÿerjfg–Ç×ÝÝÚßßÝÝÞ„Ý ÜÛÛÜÜÚ××ÖÖÓ„Ð'ÓÕÕÐÌÈÄÃÇÌÎÐÓÕÕÔÕÖÕÓÐËü¾ÄËÏÑÑÒÓÓÑÑÒÒÑцÐÏÎÎÌËÉÆÃÃÃÂÁÁÂÄÄÅȄʆÍËÊÌ„€~Š ~}{}~~}|||~„}}~~~}„z{~†~}{|~~|zz{~¢~~}~‰‚~}~~~‹…€€„€Š~’ˆ€œ €Šï€€žtfg‹~ƒƒ~~‘‹™—Á‰á‰ÅÑÉÙ@`¹~›Ù™áÑ‹­ÁÁÁ­•¥««£“­`@|b‘›0`@b›ŸŸ£›‘‘“—•‘™©­­±·µ¹·±¿Ãù±¯»ÁÃÅ»³›|Å‘fxµ¯™|xzp`vr‰›¡¡§§™‰r€lpn•—™­ÍÙÙÛorx…ƒƒ…‚÷ïçßÛÙÝßåïó÷ù÷ý‰’ŒóÁ©Ÿ—‘‘‘‘…éÝ‹—Õ•…p|Ázƒ‰Ÿ³¹µµ³±¯µ±«©¥¡¥£­½’¼ÚØàÜÙˆ‹…ƒ…‡‰‰‰‹‘—£§­½ËÙÛÛáéÃÅÄÄÅÆÈ0ËÐÕÙÚÛÛÙÖÑÍËÊÊËÌÊÅÄÄÀ½¬·‡ƒ‘›—§Ëƒ—™ ©ÇââÝáàââáâˆãááà„ßÝ„Þ!ÝÜÛ×ÒÎËÉÌÐÓÕØÙØØÚÚÙØÔÎÉÄÆÊÏÔÖ×ÕÔÔ„Ó‚Ò†ÑÐÏÏÎÎÊÇÃÁÀ¿¾½¿ÀÁÃÇÈÉÉÊË…ÍÊÈÇ€®“‹†¯ƒ‰‹™­©“|‰(`©ÍÅ©©Pñ凃¡P±Ñlj‘`ÁÁÁáÕ­«±¯½‘áɃ¹ÅÑ‘¡™…ÇÇÉËù¹½¿½»ÅÓÕÍÓÍ×ÝÝÝßáÝË¿ÃÑ××ÛÙÑ·›ýÉɉ§ÏáÓµ£©“ƒ™•§»»¿½¿Çǵ¥‰‰e•­…¯©±±½áñùÿ‚ˆ‹‰…†sifÃÁ±§™Ÿ¥­³¯µ·Ámvx㿳¯£››™—‡ñá“£õ½©•¡¹é‡•«ÁÅÃÅÅÇÉÉËËËÉÁ½µ­³Ç—ÁÞàåÝÛ’±¯©¥¥§§©©©„¥H§«¯µ»ÁËÕãëïñóù—½ÀÀÃÄÇÈÊÎÒ×ÛÛÝÝÚÙ×ÑÐÏÍÍÏÍÍËÉÇƵ߻·³¯··ÅÃÓ’´Öàáäâåæäåæ…å -ääããâââáàá„ã!ââàÜØÓÎÌÏÔ×ØÛÜÜÜÝÝÝÛÚ×ÏÇÈÍÒ×ÙÙÛÜÜ…ÛƒÚ…ÙØØÖÖÕÓÏÌÊÉÈÇÉÊÌÐÒÔÕÕÖ×…ÙÕÑÑ€¸œ…¥HNTZ\v‹zTBD8`¹‰\< P `8>>T x‘:6< ÁÁÁ`‘|^hh`Vl ``•d•¡~0p‘p§µ³±¥™›¡Ÿ¥µµ³·³¹½½»·¹·©Ÿ§³¹»½¹±™zÁ™™zËÓŧ‰‹…t‹‡‘¡¡£››“‘‹…lhhDh|^vlx•·ÅÉÏpu{|{n[QF~rdVLFHJNX\bb^b::$` (hNNT‰PDFB\0ÁÁÁpr||…l\PÁPÁ«©l™X•í‘—··µ§›¥¥£ŸŸ§­¯©§©»¿ÁÇÁÁ¿½½¿¿ÃÅŽ³«›|lj~•¿Ç¿Ÿ‡‘‘•‡‰‹—§££Ÿ¡…‰‰z™€™Áx…“¡ÅÓ×Ùtvwywk·RƒvjZPHJLRX\`VNlIKY¥~zzl`^XN|‰x|P±|¥^flƒ•›Ÿ££¡Ÿ§§©«­“…•­Ó„³ÓÒÒÓƒ¡Ÿ—““‘“““‘‘“——™¡§«·ÇÓ×ÙÙÏm‘¬­®²·¸»¼1ÀÅËÐÒÒÑÎÌÆÀ¿ÀÀ¾ÁÁÀ¾¼¾½¶å«›““•‘‹‰½ggisŸÀÐØÙ×ÙÚÙÛ܆ÛÚÙØØ××ÖÖ‡Õ$ÔÑÍËÈÆÇÊÌÎÑÓÓÒÓÓÓÒÏËž¾ÃÉÎÐÑÒÒÑÐÐÐÏÏŠÎÌËÉÆÃÃÃÂÁÀÀÁÁÃÆÈÊÉÉËÌÍÌÌÍÌÌ̃€~|{}~~{|}~~~„~}zzz}†~z{|~„}~~~¿…~‰†€€ƒ€Šˆ~}~~˜‡€›¡€‹î€€Šzk³‰‹…~xvvrtxzÙ©áXʼn•³ÁÁ`‘µ‰ƒ•“•­·­µÕáÁ` p‰Ÿ§—ÝÁÁ X•‹T‰TVXfvƒ‡~z||~|||ƒ‘©·½»Á½¿ÇÇ¿»¿Á¿¹«£™znflx™£™zƒzpd`¡¡¥¡Ÿ“…zzÍ©€•‰±ƒ“››·ÁÅÉnrv|ƒ{ù‚ûñóëåááããçïóùåÕ——–ï‹“—™Ÿ‰ÝÁ¹ÁÍÉ©xPp™r…‘±»¿¿¹¿½¹³±«¥‘tÙvÉáñ›ÖÙ×Ó‚—‡|z|ƒ‹““•—Ÿ«¯³ÁÓÛ×Õßå…¬¿½¼¾½¼¼À0ÃÉÏÖØØ×ÔÑÊÆÄÆÉÊÇÅÀ¿ÁÀº­Ãƒv~‰““•«Ï󈚦ÎÛ×ÖÚÛÚÝÝ߇áà‡ßÝ„Þ ÜÚÛØÕÒÐÌËÍÐÒÖ†×ÕÓÏËÆÆÉÍÒÕ×ÕÓÒ„Ñ‹ÏÎÎÊÇÃÁÀ¾½¼¼¼¾ÁÅÈÉÈÈÊËËÌÍÍËÈÈ€š‹zÓ«¡›››™•™››~©há¡ù“‹¥nÁÁÑÁ‘‹Ÿ­·­±É¡Á`µ·Ã¿Ý‘ÁÁ‘ÑÕÉÉჇ‘¡¯¿Á»·¯¯±¯­¯¹½¹µ³ÉÛååéåáÝÝßÝßáßÛÍÅ»Ÿ……‘§ÁÃõ¥©¥“‡ƒ©½½ÅÁù³«Ÿ‘áÅ€ÉÙ饱³»½Ýëõý…Ž‹‰ƒëoÓÇõ«¥¡££§­³±Ÿ‘`yzƒß—•™›—™åŽÁÙÝʼn±Í‘›«½ÉÍÍÇÏÑÑÍÑÏËÅ·£ù£Óëû ÝÞØÕ‹¹±©£¡››¡«­­©«­³·¿ËÑÓÙãï÷õ÷¿½À¿ÂÃÅÇ0ËÑØÚÙÛØ×ÔÐËÉËÌËËÈÈÅÃÆö鵧£§¯³½ÇÙéz„šÁÏÖÚÝÝÞààâ…ä ãââáàáââáàá„â%áààÝÚ×ÓÐÎÑÓÖÙÛÙÙÛÛÚÙÙØÒÊÈËÐÖÙÙÛÛÛÚÚÙÙ‹ØÖÖÕÓÏÌÊÈÇÆÆÆÉÍÑÓÕÔÔÖ××ØÙÙÖÒÒ€ž’‚Ï•jdfhhvxxnXHP@H¥T@\<0Á` td^nhfdjbt|`Á |—£¡~¡hÁÁPb±±¥d™¡r­··«£¥¥§¥£¥¥¡›•™­»ÃÅÉÅÃÃÃÅÁÅÇÃÁ³«¡…ll¿Ã¿¯™“™‘‡zvŸ³­«§¥‘‡‰…ƒÍ­€©­Á|~£ÃÍÕÝxzwsrj·R~tjZRLNNRX\^PF;RQ\¥ptlnnhlP|lt|•…l\8™npr~‘¡¡›£¥£Ÿ­­­©Ÿ‰vÍh‹»Õå”ÏÏÎͧ—…ƒ‰‘““‘“•™£­³µ¿Ë×ÛÙÙÍr˜¬®®³¶·º¼0ÀÅÌÐÐÐÎÌÉÄ¿¾¿¿¾¿À¾½¼¿½³á±›‹‘‘£µ_cm|©¾ËÕÕÕÖØØÚ…Û ÚÚÙØØ×××ÖÖÖ„×$ÕÔÔÑÎÍËÇÆÉÊÍÐÓÑÑÓÓÒÐÏÍÆ¿¾ÂÈÍÐÑÒÑÐÐÐÏŒÎÌËÉÆÃÃÃÂÁ¾¾¾ÀÁÅÈÉÈÈÊËËËÌÍÍÌ΃€~}{}~„|z{|~‰~{z{|~„~}zz|…‚~Á…~‰†€€„€‰ˆ~}|~”~…†€›¡€‹î€€~rÃ……vprrhp|ƒ‹‡‘±h`£·±í‰`P™Í……•¡¹ÅÇ˻ɡÁ`Hx¥¥‰á``h~•~•µ©X™lpxFHLR\bffdbjv|z‹“«¹±·»»½Á¹·½½µ³«££•|ƒ“¡¥¡|‰tµ¥d££§£›‘‰|rxÙ¹•|™n…‰‘•‡~|¡ipv~|ÿ„ûíïéå„ã€çïóùñ冚œù£›©›—›—…Ùͽ¥©¡t`p©lƒ£·½¹µµ½Á½·§¡“nhhÉÝ£Ñáó½ÜÕÖ›“‰~vpnpz…“—™¡Ÿ¡­³µÃÓÛÙÓÝ厶À½¾¾¾»¼¿ÂÇÍÓÖ×ÕÒÎÊÇÆÆÈËÇÄÀÀ¿¼·ª¹|lr~™Ÿ»ßù†ˆ—°×ÛÕÔÖÙÚÛÛÞà„áà‰ß…Þ'ÜÚÚØÕÔÑÍËÍÏÒÔ×ÖÖ××ÖÕÒÏÌÇÈÈËÑÕ×ÕÒÑÑÑÐÏÏφÎÏÏÏÎÎÊÇÃÁÀ¾¼¼º»»½ÁÄÆÇÈÊËËÌÍËËÉÈVŽ|Õµ¥£™››•“¥Ÿ|rtáÉ‹©§³©Å±‘Áá«¿ËÇɳ±Á¡Ù­ÑÓé¡``©§×ÙÁõýù…ñÑÕí…‰‘“™—••›§©¥¡³ÍßÝá…Ý€ÛááÙÙÑÉÉ»£§½ÅÉŽ¯­«—ù釫½¿ÅÃû±£—‘ùÙÕÕÙ“«¯³·¿·¯³Ë…Œˆˆ†ïp×Ë¿³«¥£££§­³±­¡ez~‰é§©±Ÿ›•‘‹áÕ½¥µµ¡áÙ‰£¥©±ÃËÅÃÃÍÕÓÑÉÇ»«—‹…éí©Ûëý…ÄáÖ×¥T·«¡™“‘™¥­¯­¯³·½ÅÏ×ÙßéóùùõÀ¿ÁÂÃÄÅÇËÐÖÙØØ×ÔÑÏÌËËÌÌËÇÇÆþ²Ý¯—­¹ÇÙçïx}¨ÍÏÓ×ÚÜÝß߆â áááàááââáàà„â áààÝÚØÕÐÎÐÓÖØ„ÙÚÙÙØØÓËÉÊÏÕØÙÛÛÚÚÙÙØ؇×ØØØÖÖÕÓÏÌÊÈÆÆÄÅÆÉÌÐÒÒÔÖ×××Ù×ÖÔÒU‘†å³hfffhtv~|lDD0@fl`nr™XP`½nblv……‰‘Á`xŸ½¯~™Á‘‹¹·ŸÁѹpåÁµé~~z‡‘‘“‘“‰|‡—¯¿»…ÀÅÃÉÉÃÁ¹±±£‰…—³ÃÉÉ»¥›Ÿ‰ÝÍx£µ³¯©¥…|ƒáÁ±©½n~‰—¡§Ÿ—™¹ruonl»T~pfZRNNNRX\^\XBV]g«hn‡tplfL|…|hxd@8`±nz|…™Ÿ™——£§¥¡©§Ÿ‘ƒpl½½‘ÅÕçx¶ÒÌÏV›£™…xv‹“•“—™¥­¹¿ÁÇÏÙÛÙ×Í{£®¯¯´¸¹º¼¿ÄÊÍÍÎÍÉÆÃÀ¿¿¿¾¿¿½¾º»¼°Ý¯•…ƒ——¡³¹\]m¶¾ÉÒÑÓÕÖÖØ…ÚÙ…Ø××ÖÖ×„Ø ÖÔÔÑÎÎÌÈÆÈÊÍφÑÐÎÍÇÀ¿ÁÆÍÐÑÒÐÐЄΈÍÎÎÌËÉÆÃÃÃÂÀ¾¾¾¼½ÁÄÆÇÈÊËËËÌËÍÍ΂€~|}…~}||}~‰~|z{}„}|{{}„~~~„~®‚~Œ…~Š…€€„€‰‡~}|}•‚~„†€›¡€‹î€€jͳ—‰‡…||v~r™£|ƒåñ™j™±µ©t‘™d…•rµ·Ÿ¹Ç«™P`px‰µ@`Á`f›•‘jV\­^‰`‰<@@Xt™ZZXVJ`dxrz‰™§©««¯·¹¹µµ±··¯§¥§ŸŸ™›¯¥£Ÿ™›r­Zb‡—Ÿ¥™rfzÝÅ€±©™½v…—t‘hp…«vu~y‚„óïßÛáåÝåëõõ‚†‚‚“›…ã÷ß——‘‰|Ñͱ™…x±h\l~‡•›­¿Ãµ©µ»¹¹¹¯v©XhµÍÕ¯ÑçíóŠÃÐÓ®…vnhdl~‹‘••—›¡§­µµ½ÅÑÛÝÑÑå¤ÃÆÀÅÄ¿¿ÄÆÉÍÐÐÏÏÍ…Ê-ÈÇÃÁ¿¼¹·¶§»t\™±Ÿ±Çãëû‡–¹ÌÍÐÔÕ×ØÚÚÜÞßáááâãááá†ß&ÞÝÛÚÛÜÚØ××ÕÏËÊÊËÐÔÓÔÕÔÔÓÐÎÊÂÁÃÊÑÓÔÔÓÑІÎ$ÐÒÒÒÓÓÒÒÐÐÍÈÆÄÀ¾¼º¹¸¹º½ÁÅÅÇÊÊËÍÍÎÌËÊ€ˆóɧ››—“‘‘‘—‘¿Ç“|¹ÁÙ³¹Ç¿¹‘™‰±ÁÍÍÝÕßÝÉÕ¡`ѧ½ÏíÁ`Á©‹¿ÓÍ¥ƒ…ý‡ÍÑ陡¹Ùõ‹‰‡•‘›‘›Ÿ¯ËÛÕÕÓÓÕÕ×Ù×ß×ÑÉÇÉÃÅÇÇÇÑÉÇÁ½­õƒ‘µ½ÑÏËÅ­™‰éÑ€½µÁ韥©™å­¥ÑÓˆ…ŠƒzqlÉ¿­¥§¥¡¥§§UZXh‚‹yÙñ룣¡™‰áá½¥©ù±…™Ÿ¯µ·ÉÍ¿³·ÅÍËÓɯŸý­µÝÝñ¿Ýñ÷ÿ“ÌÓֹퟗ‘‡‰«±µµ·»¿ÇÍÕÕÝçñûûñëñ¢¿ÉÅÆÇÇÇÆÉËÎÒÕÖÔÓÒ„Ð`ÎÍÌÉÊÉÉÆÅ¿®Û§‰á陹Óçñíõ|ºÑÐÓÖØÚÜÝÝßááãäâãäãâäáàààáââàßÞÞßÝÛÛÚÙÓÎÎÐÔØÜÛÚÙØØÖÖÖÒËÊÉÌÔ×ØÚÛÙÙ××ÖÖÖ׈ÖÔÓÕÔÒÏÊÈÆÄÃÂÄÆÉÍÑÑÓÖÖ×ÙÙØÖÔÓ€†í¿“…tpnjjbpn¡­T@THr‡•£­ƒ|Á±p…‰d¥±¡³µ­¥p᧳¹ÁÁ…Å͹dhÅj¥©Ét|x•±¹jlhf`trƒx‰™±»½½¿ÃÅËËÍËÑÕŹµ¯›¥«ÃÇŽ¹µ±¡~Ùz‡—£¿³­µvnppɱ¡•¥½tx~“t•|‘½·ujlf]QI|jRHJHH„LZ000@Zgo`­ÉÃvn`XDp|xhdXx0@^pv…‹•§©›‘Ÿ§­«±¥•‡Ù½µµ¡ÅÛáç†ÀÈΰ­—‰zrx‰‘•™›¡§­³»½ÁËÕßÝÕÇÅ«´µ„¼ -º¼¿ÂÆÉÊÈÇÆ„Ä.ÂÀ½¾À¾¾¸³´¬å§‰ÍÉ•¥­»¯³^rž¸½ÃÊÍÐÓÕÕÖØØÚÛÚÛÜÚÚۈ؄Ö%ÕÓÓÒÐÊÆÅÇÉÏÓÑÑÐÎÎÎÌËÇÁÀÂÇÎÒÒÒÐÎÍËÌÌËË„Í„ÎÍÌËÉÈÆÆÃÁÀ¾¼»º¹»ÀÂÅÇÊÊËÍÍÑÑÑЀ~}}‡~|}„~‡ ~|{|~|{z}‡~~}}†~©~†~…„~‡€‹ˆ€ˆ†~}}~’†~……€›¡€~~‡í€€dű™……~|z|zxt©‹õ…df‡•­­¯¯•Í\X‰Pxt£­µ·¯XPp~‘```pnƒ‹‡dX`XZT<@Dd‰VZZVxx\hrpz‡““¡¥Ÿ•‰‰—©«§£Ÿ›¥›ŸŸ±³³¯©£ƒnrx‡‡—§­—vrÑÙÁ±€¥¡™µÍÝrtP`hX¡³tvy„‡ëçÙÙÝááçëõõ‚‰„†• ¢œ•™í™“…ƒÝÑ­¡…xx•r~~ƒ•­»½±¥§µ»³­‘n¥`P@ÑÙ‘ÅÝåéïñ—¹É®¡phdhtƒ““—£©¯µµ»ÃÍÙ×ÍÍé¬ÅÅÁÅÅÄ¿ÁÄ7ÅÇÊÍÍÎÎÍÊÊËËÊÉÇÃÁ¿»´°®¡µl…É“³Åáíÿ…¢ÄÌÍÐÔÕÖ×ØØÙÛÞÞßÞßà„Þ5ÝÞßßßÝÜÛÚÛÜÚÙ××ÔÐËÊÉÉÎÐÐÒÔÒÔÒÏÌÉÂÀÃÉÏÒÔÓÑÐÏÎÎÍÍÍÎÍÌÍÍ„ÎÍÌËÇÆÄÀ½¼º¸¶·¸º¿ÂÃÇÊÊËÍÍÎÍËÊëǧ——“„€‘‘­Í«‰á|‘³»ËÉÏ˯ù¡‰‰é±Ù—ÕáçÙÓ­…±‰¯Å¿µÁ¡±›³Ç¿™‡‰ƒÍñ‰™¡¥É퉋‡éÙÙ‡‹““‘·ÇÉËË¿µ¥«»ÏÑÓÑÏÍËËÁÁÍËÕÕ×Ñ˽£‘™£­»Ó×Ó·‘ƒýéÕÁ¹±±Íéý‰åá€ÉÙáÓ„†ƒ|sl÷§£¡¡Ÿ£§¥§X^`l„“˜•’™÷©¥¡•ñݹ­©¹…™™›¯··ÅÇ»­¯ÃÍÍůí­Ñ¡ñÙ™Óçïó÷ÿž¼Ì¹Ç«™•¥­±µµ¹½ÅËÏÕÕÛåí÷÷ïçó©ÀÇÇÆÈÉÇÈÉÊÌÏÒÒÒÓÑÐÐÑaÑÏÎÌÉÊÉÆÀ¾¹ªÕŸõŽù«Õåíñ÷{œÅÑÐÒÖØØÚÜÛÝÞßàáàááàßààßààáááàßÞßßÞÜÛÚØÓÎÎÏÒÖÙÙØ×Ö×ÖÕÔÑÊÈÉÌÒÕ×ÙÙÙ×ÖÖÖÕÕÖ„Õ Ö××ÖÕÔÕÓÒÏÊÇÆÄÂÀÁÄÆÊÎÐÓÖÖ×ÙÙØ×ÖÓ€{㹓~rnjhjdhj¯pRHJJHFN1:I_„•Ÿ££”ˉtr\R™|t|t`…zdj‰“Ÿ¥£›“¡£©£‰nX‰`‰±‘±ÉÏÙåçáÕª©»•ƒzz‡•——•™Ÿ£©±µ·½½ÁÉÏÕÓËÃÓ ¶¶»„¼9»¼½¾ÀÁÁÃÄÄÃÄÅÅÅÁ½½¿½¸«¡Ÿ›É•Ý¥‰‘x§«µµ»c˜¸ºÄÈÍÐÏÏÑÏÐÒÒÔÔÔÕÕ…ÔÕÕÕÖÖÖ„Õ'ÔÓÓÑÎÌÇÄÄÆÉÌÌËÊÊÌÊÉÈž¼¼ÀÆÉËËÊÉÉÈÊÊÉÉËÊ„ËÌÌËËÊÈÆÅÆÄÁ¾»¹·¶·º¾ÃÄÇÉËÍÎÎÒÒÒÑ’‚~Œƒ~‡ ~~~~}z{|~‰‡~„~~}}~~‰…~•~†“~}}…€ŒŠ€††~’~„}~‰ƒ€›¡€‚„~†í€€«··©›‡|tpt|~vl“³«­›…p`\bhx•“‹‡rT©Phƒj­x|`P4 ` Xx`zjXZP`Z¥`THDH…^dhb@ P‘­^Íjhdb\X…H`\‘•“••…xZd‡››“‘^|ppTdµ¡xéíÝÁ½¥}¡©µµ­­¥|…™¡ÇíŠáÛÕÕ×Ûßçï÷ùõ‰–©»¸²®ª˜v˹¡zÝÍɱÉr‰›—xŸ£¹»¹µ±¯§§¡td@``|p£³­ÅÕßãáïí‚—•¯…vpt|…‰‹‹“—›¡§¯·»»½ÅÍÑÍÇÉÛ¨ÆÂÂÃÂÁ„½ ÀÁÃÅÇÈÈÈÉ„Ê)ÇÂÀ¼º²©†‡d•™¡³Åßíõ‘ÂÍÈÐÒÓÕÔÔÕÓÔÖ×ØØØÙډ؉×ÕÔÑÌÊÇÇÉÊÊËËÌÎÍËÉž½¿ÄÉÍÏ͆˂ʅËÍÌËÊÊÉÈÇÅÄÀ¾º¶³²²´·¼ÀÃÆÉËÍ„ÎÍÊ€ßÙ‡…‡‡‰‰‰¯ÙÓÍÁ«™‹•£·ÍÑÉûµ¡ƒý›±µ§õÕ½½¹½±‘Ñ¡Ù“›…‹…‰ƒå‰‰‰Íƒ…‹…ÉááñÙýýƒ•›“‹Ñ•Ùµ·ÇÇÇ¿¹­—“µÇÇ¿·½³ƒ½±½µ±áËííåÑ͹­€±¹µÉɽ½ÉÅÙáÙÉÉÍ¥õýyvl¹«£Ÿ›Ÿ¥«­¯³eny‹¥ºº¸µ² ÝÍ©éÙÕÕ퇛­±‘™¹½ËÏÍÉÅÃÁÇÁ›­ÉÙÙ­…­¹Éßåïóñûó—›Ï­Ÿ›¥­±³µ½¿ÅËÑÕÙÛÝßåíñíçãå¥ÁÅÈÅÆÆÆÅÆ=ÆÇÉÊËÌÌÌÍÎÐÐÐÎÌÉÉÆÀ¸°©–³•ùÝÕÑ™×åëó÷ÁÔÐÑÓÕÕÖØØÖØÙØÙÛÙÚÛÚÙÛÚÙÚ‰ÛÚÙÙØØÔÐÌÍÏÑÒÒÑÏÏ„ÑÍÆÆÆÉÎÒÓ‡Ô'ÒÓÔÕ×××ÙØ×ÖÖÕÔÒÑÐËÈÄÀ½¼¼¾ÁÆËÎÒÕ×ÙÚÚÙÙ×Ô€¿»§ztjb`bdf^Vz¯³³£ƒ|~‹•Ÿ±½½¯¥¥¥“xý|‘§«™Ý½™‰tT@` h©‰ŸƒfjdlfÁ…tpltµvlrl0@ p¥Å\¹`hltlf•X`lÅ·ÅÇÅÁµ§©“x‰«ÇÇ¿·½³|¥…•—ׯz±¥¡™…x€|…d…‰‰¡|‰±Å•|ÅÅ\WJlXJBB@DFJFHN4AUkŽ¨±±´ª•pµ¡X‰¥bv‰‡hp‘“¥©§£Ÿ£Ÿ¥t…pxxtd—©¯ËÍÙßÛßÑq‰µ—‰…‡—™——Ÿ£§­³¹½ÁÁÅÉÏÕÏÉÅÉ™µ·º»»»¹¹¹=º¼½¿¿¿ÁÁÂÂÄÄÄÀ½½¿»¸¬¡œ‘³‹á±™v§­·¹¿r©»½ÇÊÏÒÐÎÏÎÎÐÐÑÓÑÒÓÒÑÓÒÑÒ‰ÓÒÑÑÏÎÌÇÄÃÅÇÈÈÈÆÇÉÉÈÈļ¼º¼ÃÆdžÈ(ÉÈÉÉÊËËËÍÌËÊÊÉÈÅÅÆÄÁ½º·µ¶·ºÀÄÄÆÉËÍÎÎÒÓÓÑ¢~…ˆ~|{|}~~ˆ‡~„ ~|{||~~~†…~“…~„–~€€€ŒŒ€„…~’~}}}~‹ƒ€›¡€‚„~†í€€£­±¥Ÿ‹~tpr…‹zƒ§Ÿ¥~¥™‘||l|Pdrjx`h‰•bfLdldlpH(((`` ((PXXxTT^\¹lPHLdbh¹ 0` H¥©Åhd\\VVHLT‘›­£¡›‹z©xt©`V|…tlxxdX§ŸlÝÙͽ±•…€‰‘‰‰d‰x™‰|¡­«zX©çù‡áÝ×ÛÝÝÝçñûýù‹”œ©³²°«ª§££›‰¡ñÝÕ½n|—‡r‰­¯µ··µ³­©¡ƒ…XH`|‰™¡¡™™£©§³Ëû‚Œƒ­vvx|ƒ‰‹—›Ÿ£©±½¿¿ÁÉÏÑÍÇÍÏ›ÂÃÀÁÁÀ»º¹<º¼¾ÂÄÅÆÅÆÇÉÊÊÉÇÂÀ¼»¸­žvh\­µÁ‡³Çãí÷¡ËÊËÐÒÔÔÔÕÕÓÓÕ×ØØØ×ÖÕÔÔÖÕ„ÖÕÕÕÖ„ÕÔÔÔÑÍÊÅÂÃÅÅÈÊÊÌÍÊÇľ»½ÂÈËÍË„É ËÊÉÉÊÈÅÆÆ„ÇÆÅÆÆÅľ¹µ³±¯±µº¾ÁÆÉËÍÏÏÏÎÍÊ€ÓÍ»«¥Ÿ‘‡ƒ…‹•‘‘ÅÓËÓ©éÙÕÕÙÙé…—¥›Ñ±½Ýý‰…Õ­¹±©±­¥‰…‰¡Á‰¡Ñ•Á‡‡……ý½¡•‘Õ‰…‹ý͉ᡉõñù‹‘•‰Õ•‰™Í¿ÏÃý³­›å½ÍÙý‹ÑÍÕ½­­©½ÁÓÁ‰õåååÁ¥•€•±±…ɱÉÑ©ËÍ¿—Õ×ùísl¹¯¥¥¡¥«¯±·fq~¦´µ¸µ´³¯°©Œ§ýéáá‘¡©¡‹£ÇÉÏÑÑÏÍÅÃÁ§ÉùÙÙµ§µ¹½Å¿¹¿½ÉÛû|‡‡Í©¡Ÿ£¥­±³·ÁÅÉÍÑ×ÝßßãéïñíçåÙ˜½ÄÅÃÄÅÃÄÅ -ÆÇÊËÉËËÊËÌ„Î$ÌÉÇÆÀ¹´©¥™õññŸÕçï÷ûžËÑÒÑÓÔÔÕØÙÖÖØØ„ÙØ†×…ØƒÙ„Ø ××ÕÐÌËËÌÍÎÎÍÍ„Ð6ÍÅÄÄÇÍÑÒÒÑÑÒÒÓÓÒÒÓÕÖ××ØÙÙ××ÖÕÒÑÐÌÈÃÀ¼º¹»¿ÄÈÌÑÕ×ÙÚÛÙÙ×Ô€±­—ƒxxlb^`lrd\bŸ¹·³v½ÝÙÍÕÝrxƒ‡±©½åÝ~|Á‘©™…|x\@@8`` (X±‘‰ffhhÙ©|tx½|lpÍ0 `0X½©Z^^h``‰LD`½ÇáËÉ¿­©Ÿå±¹¹ý‹ÑÍݽ•|x¥¹Í±p©•™©p€txdt\‰xÉ•z¡­§zZ­Á³TJlZNHFBBDHHHZ:Lby’¦­¶µ®¨ ›’y±‘™\j|…vbzŸ§§©¥££¡Ÿ…¹x|ƒ“›¥­§¡¥¥¯¹Õmzx³“‰‰‹•——™£§«¯µ»ÃÅÅÉÍÓÕÏËËÁµºº¹¹¹¸·¸<¸»½¾¾¿¿¾¿ÀÂÂÂÀ½½½»¸¯¥œŠŸx½¹±|¥¯¹»Á…´¸ÀÈÊÐÒÑÏÐÎÎÎÐÑÑÑÐÏÎÎÎÏΆÏ)ÐÑÐÏÏÏÎÎÎÌÈÄÂÁÁÃÄÅÄÄÈÈÆÆ»¹·¸¿ÁÄÅÅÅÆÆÈÉÈÈ…É ÊÊËÊÈÈÇÅÅÆÅÁ¼¹¶´³´¸½ÂÃÆÉËÍÏÏÓÓÓÑ”‡~„…~‚Š~ -}{{|}}}~~~„‡~ ~~}|{|„~†…~ˆ…~‚‰~„Œ~}}}~…~„‚€Œ€„~’~}}}~Œƒ€›¡€~~~†í€2«Ÿ••™“zåx~‹‡~ƒ©Ÿ›p™xtXXd|•…8(H|±XpP|ph¹8,H0„ €@`@b^``µ‘xp±bbÁ½¡‰xÁ @l¡Z±hjhXV¥©‰H|ÇŠá­§‰pr…`ldlh`XPX\`l|xd•‘l½ÍÕ͉X‰‰‰x8 0­¿k×ÝÇtÕÅïíñíÝëáåáßáéïýÿÿ‰‘¨¥¬°°¯©ª¬­«©ó—ÕéÉ|Nx~åt£¯µ±µ©µ¥¥©…‰‘‘``x•“—‘~px›«Óï}Ńrtn~~ƒ‡—£§«µ»¿¿ÅÑÕËÿ½Ã‹ÈÅÅÀÁ¿¾¾º½¾À„Ä)ÆÇÊÊÌÉÅÂÀ»»·±ŸqƒndZ^d~­ÉÝé}¦ÈÄÉÉËÎÎÐÒÒÓÓÔ„ÕÔÓÓÒÑÒ…ÓÒÓÓÔÓ„Ò)ÑÏÍÉÃÀÀÀÂÃÆÈÊÊÊÈÆÁ½º¼ÁÇÉÈÅÂÂÌÏÊÉÈÉÊÉÈÈÉÉÊ„ÉÈÆÅÄÀ½¹µ°®®°´·½ÁÇËÌÍÎÎÎÍËÊ€ÅÁ¹¯©—…õƒ™§¡•—§ÏÓË‘ÅÅÍÝÉ­©µÍÕá¹™ÁåùÅ‘á‰Á½¡ù‘…Ù©‘‘ÑÁ¡ÁáÍ‘‡‰õ͹±Åñ…ƒýùÝűÁáµéù‰‡íùñ¡Ýí’ï±·±­¡ÝµÁ½Á½µ­©¡¡©±½Å‰¿¹ƒééíݱ…Ù€ÙÙá™Ñ¡`ýïƒýýÝ…ýÑëçëßϹ«¥¡¡§«­¯µhvˆ˜ª°´³²µ¶¸¶µ®ý¡éùù—‘©—ùƒ»ÅÍÕ×Ë×ÇÉÍ¥ÁùÑ¡‰³¹½³¡‘—¥«»Ýù†‰…Ó£¥™¥§­¯¹ÁÇÍÑÕÙÝßáåíëëéççߎÁ¾ÂÀÂÀÁÃÃÅÆÇ…É#ËÌÎÐÑÎËÉÇƽ·ª‚«¡•‡‡…ŸÓééñ‚ªÎÍÑÑÓÖ×…Ö ×ØØ×ÖÖÕÕÔÓÔ…ÕÖÖ×Ø×„Ö ×ØÕÑÌÉÉÉÊÌÌÌÍ„Î ÊÅÃÅÊÏÒÑÐÍËÓÓ„ÑÒÓÔÔÕÕÖ„ÕÔÒÑÐËÇÿ»¹¹»½ÂÇÍÓ×ØÙÚÚÙØÖÓ€»­™…zzthÉlllhdl­·¹‰™­ÍÝɱ©¡­­¹Ù¹éåí©`Ñt©‘t±PDh@(@‘¡0Áh©zjlhʼn•ÁlhÍÉ­•pÁ `©`½lpnfd±¡‰dµë˜ó·¹«Ÿ—Í¥±©±­¡™•‘•‰…‘±¹|§£h¹Áŵ‰X‰€‰‰©p‘p±åÙq×ÝÇn©›­£Ÿx^NJD@DJNRT\BYq‡›¦«ª®§ª¬¯¯ áƒ±Åµtn‡tÍn¡«³©«¡«“‡™Á¹x`x““™‰xz‹•¥Ã×khj±……ƒ‹“›£¥­±µ½ÁÅÇËÓÓÏÉÅ»¯z²²µ´¶¶¹º¸¹»„¼$¾¾¿¿ÂÄÅ¿½¼¹´­¬£{¥—‰rphz­¿½Åk—ÀÂÇÈÊ˄͇ÎÍÍÍËËÌ„ÍÎÐÑÒÒЄÍ!ÎÎËÇ¿¿¿ÀÂÃÃÄÅÅÄÿ»¹º¾ÄÆÅ¿¿ÇÇÆÇÆ…ÈÉÉÊ„ÉÇÅÅÆÄÀ¼¸´²²´·»ÁÃÇËÌÍÎÎÒÒÒЈ~‹‹~‚}…~}|„~}~~}}}…|{{}~„†~‚„~}z||~~~…~}}~~€†~„†~…}„|~€„~‘€~~~„~Œ~}}}~ƒ€›¡€‹î€5¥›‘“•‰zí|•››‘•Ízµ…x||pt|HDPl|­p0HPTX©††‚‚ÿÿ÷…¡Ã½³Ÿ‘‡…~xvrx||‡‹¯ËÝëõñëçáåyƒƒ…‡ˆˆŠŒŽ‘’’’“”’”—˜†•#”‘Œ‹ˆ‡Œ•—˜™ ­ºÇÏÐÐÒÕ×ÖÕÕÔÓÒÒÒÐÐÐÓÕ„Ö„ÕYÓÐÎËÊÇÄÃÄÆÉËÍÏÐÑÒÒÓÔÓÒÑÐÐÐÑÒÑÐÏÍÌÉÈÅÄÄÃÁÁÀ¾¼»¹¸··¸¸¸¶·¸º½¾ÁÂÃÃÆÆÆÇÉÊÊÉÈÇÇÇÆÆÆÅÅÇÈÉÊÍÏÐÐÑÒ„ÓÒÐ΄ËÊÆÁÁÅÊÏË»³³³»ÈÎÓ„Ô$ÒÏÎÎÎÐÒÒÑÐÏÏÎÌÌÊÈËÍÏÍÊÈÆÁ½»º¹»¼ÀÅÉÌ΄ÍЄ–€€€~~}}‰~‡€—€Ž€„˜€¡ÿ€ë€€fhnzŸ¥±ÁËÍimqsvz|}‚ƒƒƒ‚…ʼn·sx|‚‡Š†yuimv}ã«á¥……`rnd­‰p\‡“¥­±µ»·¹½ÁafgijjkkkllmllkkllkÓÓÓjkkkmnlkliihfeÍÇËikprtutsrqpoonnnoruv9roijhfeÃx…Ÿ­³·½Ã¹Õï÷ýÿƒõíñ‘¨­«««ª¦ ›„xrtx|‚„„„…‡ˆ‰‰‰ŠŠŠ…‰…Š‚‹„Œ<”˜ž ª¶ÂÎÒÒÒÓ×ÙÚÜÜÚØ×ÖÖØØ×××ØÙÙØØÖÓÓÒÒÓÓÑÏÍËÊÊÊÎÐÒÓÖÖÖ××ØÙÙØ„×%ÙÚÚÙØ×ÕÒÐÎÊÉÈÄÃÃÂÀ¿¾½¼¼¼»¹¹¹º¼½¾ÁÂÃÆÇ„È4ÉÈÆÆÅÅÄÃÄÃÃÂÃÄÆÈËÍÎÎÎÐÑÑÒÒÑÏÎÍÌÌËÉÆÁÀÃÆû·º¼»¿ÌÓÕÕÓÐ…ÎÍÎÎÍÌËÊÉÉÈÈÈÇÈÈÈÅÁ¿¼¸´³°°±²´¹½À„ÁÂÄIŸ£±ÇÛÛÝÝãñ÷ù†‰Ž‘•—™›š™šš›˜ã¥Õ‰•žœœ™“‰…“÷³õÁ­±…•‘‹ýÍÁÁÑ×áåéíóõùÿƒ„†‡‡iˆ‡‡‡†…ƒ‚ÿÿÿ‚‚‚…‡…„…†……‚ÿûý„†…ˆ‰Š‰ˆ‡†…„†……†‡†‰‰…‚ƒ„~õë¹ÕÏÏËÉÍÇÝï÷÷ýóéí«µµ¸®­©¤ •‰„†‰Š”–—™™˜˜™™™…˜…™˜˜™šš› ¡¤¥¨³¾ËÕØÙØÙÝÞà„áàßÞÞÞˆÜ)ÛÜÛÛÛÙØÖÕÒÑÐÏÐÒÕ×ÙÚÚÛÛÝÞÞÞÝÝÜÜÝÞßßÞÝÛÚØÖÓ…ÒÏÎÌËÊÉÈÇÇÇÅÄÅÆÇÉÉÍÍÎÎІхÏ.ÎÎÎÍÌÍÎÑÒÕ×ØØÙÚÛÛÚÚÙØÖÕÔÔÔÓÐËÊÍÐÎÆÃÅÈÉÉÑÕÖ×ØÙÙ„Ú%ÙÙØØÖÕÕÔÓÒÑÒÒÑÑÑÒÐÎËÇÄÂÀÀÀÁÃÈÌÏÑÐÐÑÒÒK‡“§¿Ù××Ùãñ÷ù†‰“–—£¦£“ŒÍ›Û‰’šœœž›•Ž‹yˆ’Œë›É•x|f…r¹xtp±ÉÕÝáåéíïóù}‚„………‡bˆ‡‡‡†…ƒ‚ÿÿÿ‚‚‚…‡„ƒ‡‡†„ƒû÷ù‚„…ˆ‰Š‰ˆ‡†…„‚‚ƒ}„ˆ……††„ƒ‚屢Á·¯£Ÿ¡‰¡³½½ásÙÏÓz™¥ª«ª¦¡š–‡{w{‚†‰‹ŒŽ‘„“”””’“––…—”“‘ŽŽ–™œž©´ÁÌ„ÏÒÒÔ„Õ ÔÓÒÒÒÐÐÐÓ„Ô]ÒÒÑÐÐÎÍÊÉÇÅÄÃÄÇÉËÍÏÏÏÐÑÒÓÒÒÑÐÐÑÒÓÓÓÑÐÎÌÊÈÇÆÅÄÄÃÂÀ¿½¼»º»º¸¸¸¹»½¾ÁÂÃÃÆÆÆÇÉÊÊÉÉÉÈÈÇÇÇÆÅÇÈÉËÏÐÑÑÒ…ÔÓÑÎËËÊÉÈÅÁ¿ÂÇǽ·¸¹¶½ÈÍ…Ò#ÐÎÎÎÍÐÑÐÏÏÎÍÌÌÊÉÇÊÌÎÍËÉÆ¿½ºº»»¾ÃÇÊ„ËÍÏŒ€ƒŽ€‚„~„ƒ~Œ“€ƒŽ€ƒ›€€ÿ€ö€$¡±clq~|~‚‡‹Œ‹Ž’’•——˜—”˜ˆ¡‹k‡Š‹’“…‘ ŽŽ——›ƒÛ˱­•‹‰‹tx‰‹¥­±µ»»¿ÃËffhj‡k_mllkkqqonnÙÙmprsvwz|xzxtrtnr}‹‘•“Œ‡}wutuw}~zvonmÙÕÇ¥™£»¹ÍÙã󎧻ÃÆÂÄ¿»»¾À¼¿ÃËÌÊÉǸ­ŸŽ„‰‰‹Ž„Š‹Œ‰…Œ0‘’“–œ¨³½ÉÑÑÐÑÓÓÓÕÕÖÖÖ××ÖÕÕÖ××ÖÖ×××ÕÕÒÏÏÎÎÏÐÏÌ…Ê ÎÑÒÓÕÕÕÖ××ØØØ„×%ØÙÚÚØ×ÖÒÑÎÊÉÈÄÃÅÃÁ¿¿¿¾¼¼»¹¹¹»¼½¾ÁÂÃÆÇ„ÈÉÈ„ÆÅÅÆÅ„Ã)ÅÇÊÍÎÎÎÏÐÐÑÑÏÎÍÌÌËËÈÃÀ¼¼¾¹¶¿À½½½ÇÐÒÔÑÎÎÍÎ…ÍËËËÊÈÈdžÆÄÁ¿½¸µ³„° -´¸»¾À¿¿ÁÂÂ$Ýï„•žœ™™ž¢£¤¦¦¦©«­­¨©©©«¨ª™½¥¢©¥¨¤„£#¨©©ª¡£™ýïÛͱ§Ÿ¥“¹½ÕÝáåéïñ÷ýƒ…††……ˆ‡‡„†X„ƒƒÿÿ‚…‡ˆ‹ŒŽ’“‘ŽŒˆƒ†‘”›¡¥£ žœ˜‘Ž‹ˆ‡ˆŠŽŽŽŠ†„ƒÿûñÏ¿Å×Ùãëõû˜®½ÅÆÇÉÄÀÁÂÅÄÉÏÏÑÐÎÌź«šŒŽ‘“„™š››œœœ„œ…›š™œžŸ ¤«ºÆÑÙÙØÙÜÛÛÝÞÞÞßààÞÞÝÝÜ…ÛÙÙÙØØØ××ÖÖÔÑÐÏÏÏÐÓÖ×ØÚÚÚÛÛÜ„Ý ÜÜÝÝÞàßÞÜÚØÖÔ…ÒÑÏÍÌÌÌÊÇÇÇÆÅÆÇÇÉÉÍÍÎÎІÑÏÐÑÑÏÏÐÏÎÌÍÎÏÑÕ×ØØÙÙÚÙÙÙ×ÖÕ„Ô%ÓÏËÇÇÈÃÁËÌËÊÉÏÓÖØÙÙÙÚÚÙÙÙØ×ÖÕÔÔÒÒÑÑÑÒ„ÑÐÏÌÇÄÂÀ¾ÀÀÂÇÊÌÎÏÏÐÒÒ$×ç‚‘–š™—™ž¢£¤¦¦¤§©«¬ª¯²°¬¡£”»« ¦¤¨¨„§!ž£§¤š™„ãÕÁɵ‰‹z¯»ËÓ×Ûáëïóù~~ƒ‡…ˆ‡‡„†X„ƒƒÿÿ‚…‡ˆ‹ˆˆŠŽŒ‰†…~ƒ‘š ¤¢Ÿœš–Œ„‚‚„†‰‡…„ƒÿû屡©Ç½ÉËÓÙ‚—©°²»½¸µµ°¶¹½ÃÆÆÄ¿½³ªžŽ„‡ˆ‰Œ„ ‘““””””——š…™ –“‘“–š£°¼Ç„ÎaÒÑÑÒÒÒÓÓÔÔÓÒÑÑÐÐÏÏÑÓÑÐÐÎÎÍÍÍÌÊÈÅÄÃÃÃÄÈÊËÍÎÎÎÏÐÐÒÒÒÑÐÐÑÒÒÔÓÒÐÏÌÊÈÇÆÅÄÄÅÃÁ¿¿¾¼»»º¸¸¸¹¼½¾ÁÂÃÃÆÆÆÇÉÊʈÉ'ÇÆÇÇÉËÎÐÑÑÒÓÔÓÒÒÐÏÍËÊÉÉÇÃÀ¼¼¿½·¿¿»¸¼ÅËÑ„Ò)ÐÎÍÍÍÎÐÏÏÎÎÌÌÊÉÈÆÉËÍÍËÊÇ¿½º¹ºº½ÂÅÇÉÊÊËÍÏ‚š€‚’€••€‚©€Œÿ€ÿ€€€‚‡Š‹‹‹ŽŽ““”•••––—˜˜žžœœ™˜˜v›™x’™š™˜–•˜“‘—™ššœ–™—š”–•“‡||~|{||zxutpppnmnnllkmmmllutsqppqu‡’”—™šš•’…‰™žœ £££¡¢¢œ˜’ŒŒ‘”–•“”–˜˜˜’ŒŽ–ž ¨«°³·¼ÁÂÁ¼¼»º¸¾ÀÃÄ„ÃÄÄÅÅÁºµ³¨ œ–•”““ŽŽŽˆB””—›¤³¿ÈÎÑÓÓÒÑÑÐÎÎÓÕÓÓÕÖÖÕÔÓÕÖÕÔÔÕÕÔÓÒÐÏÏÎÎÏÏÍÊÉÉÊÊÊÎÑÒÓÔÔÔÕÖ××ØØ…×$ØÙÙØ×ÕÒÑÏÌËÈÅÅÇÅÂÁÀ¿¾¼¼»¹¹º»¼½¾ÁÂÃÆÇ„ÈÉÈÆÇÈ…ÆÄ„Ã'ÆÊÌÍÌÍÎÎÐÑÑÏÎÍÌËËÊÆÀ»µ³²³»ÄÅÁ»½ÆÌÏÐÏÍËÌ…Í -ÌËÊÉÉÈÈÆÆÅ„ÆÅÁ¿½¸µ²°®¯¯²·º¼¾¿¿À€œ£¥¦ªª¨¦¦ªª«¬¬¬°±²³³±°®®¯ª©¨„©»’§ª«®­¬ª©«¬ªªª©­°­°¬©¡žœ››–•••—–”•ŽŠˆ‡‹‹‹‰ˆ‰‰ˆ‡†‰ˆˆ‡‡‰ˆ‡†……†Š•›¡¤¦©¬ª¬«§¤™‘•¥«­±´³³²²²®¬§¡œ››œŸ :Ÿ £¤¤¤¢™šœ¢¬´¸º¼ÂÄÆÅÄÇÇÇÅÄÅÈÌÌÍÎÎÏÏÐÏÏËý³¨ œ ŸžžžžŸ ‰ŸœŸ£¦¯¼ÄÌÓÙÛÛÚÛÜÜÚÚÝÝÜÜÝÞÞÝÜÛÛÛ„Ù ØØ×Õ×Ø××ÖÕÔÒЄÎÐÓÖ×ØÙÙÙÚÛÜÜÝÝÝ„Ü -ÝÞÞÝÛÚØÖÔÔ„ÓÒÑÎÍÌÌÊÇÇÇÆÆÆÇÇÉÉÍÍÎÎІÑÏÐÑÑÑÐÐÐÎÍÍÍÎÐÔÖ×Ö×…ÙØÖÕÔÔÓÒÓÑÌÆÄ¿¾ÆÐÑÏÌÊÐÔ×ÙÙÙÚÚ„Ù$ØÖÖÔÔÓÒÑÑÐÐÒÑÑÑÒÐÏÌÇÄÁ¾½½¾ÂÆÉÌÍÎÎÏÑÒ€Ÿ¥©«­¤¥£¤§ª«¬¬¬®¯±±±«²´±¨¢§©‡³½‘¦ª¬®­¬ª©ž¥¥£œ¦¨«§ª¨®¨¤œŸœ–‘Ž’‘Ž‹‰ˆ‰‰‰ˆ†‰‰ˆ‡†‰ˆˆ‡‡‰ˆ‡†……†Š•›¢¤¡ŸŸŸ  ›˜˜”¥ª«¯²²±°±°­ª¢œ—––•™ššš„ž6Œˆ’šž¦ª«®³¶¹¸¸¶µµ´³¸»ÀÁÀÁ¿½º»»½º·²°¥š™™˜—––”••––“”–™™…ž&•••˜š¢°¹ÀÉÏÒÑÐÐÑÐÎÎÑÑÐÐÑÒÒÑÐÐÐÏÎÍÍÏÏÏÎ…ÍÌÊÈÇÄ„ÂÄÈÊË„ÍÎÏÐÐÒÒÑ„Ð.ÑÒÒÑÐÎÌÊÈÈÈÆÅÆÇÅÂÁ¿¾¼»»º¸¸¹¹¼½¾ÁÂÃÃÆÆÆÇÉÊÊÉÊÊÊ„É ÇÆÇÇÇÉÍÏÏÏÐÑ„ÒÑÏÍÊÉÉÈÇþ¸·µ¶½Äÿº¼ÅÊÐÑÒÒÒЄÍ$ÎÏÏÎÍÌÌÊÊÉÇÆÉËÍÍËÊÇ¿¼¹¸¸¹¼ÁÄÅÈÉÉÊÌÏ€‚ÿ€ÿ€ó€ŒŒŒ„“ ’––—˜˜š›œœœ…ž ˜—šžÇ~¹˜žžŸ„ž œšœž¢¤„§‚¨Š¦[ŸŸ¡¢¥œ˜‘ˆ…„}xvyxywt|ˆ‘”˜š™˜™Ÿžœ˜•š ¢£¤¥¥¤§¨©¨¥©¥¢¢¢£ª­­­§§¨¨¨®®¯±±´¶¹»½»¼½ÀÀ¹¼½¾ÂÀÂÃÅÇÈ„Ç…ÆÈÇÅÃÁ¸´¯¬©¤¥£¢¤…œ—”–› ©±¶ÁÉÒÓÔÔÒÑÓÓÓÒ„Ñ…ÒÔÕÕÔÓÓ†Ô ÒÒÒÑÎÎÎÍÍÏÍÊÊ„ÈÉÌ„Î/ÐÒÔÕ×ÖÔÔÕÕ×××Ø×ÖÕÓÒÐÌÊÉÉÈÇÇÅÃÂÁ¿¿½¿½¼¼¼½¿¿ÂÅÈÇȈÉÇ…ÆOÅÅÃÃÄÅÇÉÍÌÍÍÎÎÐÑÐÏÍÎÌÉÈÊÉ¿¸²³´¶ÄÇƽ½ÆÌÔÔÌÊÍÎÍËËËÉÉÈÈÈÇÇÆÄÃÅÆÅÁÀÁÀ¿½¸³°­­®¯²´¹¼„¾‚Á‚«‡¬«®¯¯±±³³´´´³³²²²°«§¥Ï¥ã¦´²²²³„²±¯®±±¯±±±³´µ¶µµ¶¶¶†¹?ººº¹³±®©§ Ÿžš˜—•‘‹ŽŽŒ‰”œ¤¨¬®®®¯±¯±®ª™¦±²²³µµ³¶¶¸·µ³¯­­­®´¶·„¶¸¸¹ºº¼¼¼¿ÁÄÆÅÆÇÉÊÊÇÆÆÇÈÊÌÎÏÑЈÏ$ÌËÉÆÅÄ¿º¸µ´°¬ª§§¨¨¨©£ ¡¦¬¯¶¼ÆÎ×ØÙÙÙÚ„ÛŒÚÙØØ„ÙØØÖÖÖ„×>ÕÔÓÒÐÏÍÌÏÑÓÖ××ÖÖ×ØÙÚÛÚÙÙÚÚÛÜÛÝÝÛÚØ×ÕÓÒÒÑÑÒÒÑÏÏÍÌÊÉÊÉÇÇÈÉÊÊÊËÌÍÑ/ÏÏÎÍÏÑÒÕÙØ××ÙÙÛÜÜÚÙØÔÑÑÒÓÐÍļ·¿ÍÓ×ÓÍÉÎÕ×ØÙÚ×××Ö„ÔÒ…ÑÏÎÎÐÏÑÒÒÐÏÌǾº»½¾ÀÄÈÌÌÍÍÍÏШ¨¨©©„§¥©©«¬¬­®…°„®"¨¥£Å…Åž´³²²³²²««ª¨¨­­¬­­­°®¬®´´µµµ…³dµ··¶µ°®­«ª¥¤–‘‘Ž‹†„‹Š‹‰†”œ¤¨¨¬§¢¢§¦¦¤ —“¢¯±­¯°°¯µµ·µ²¬¨¦¦¦§­¯°¯°±±³³²°¯¯®²µ·¹¼´µ·¹º»º¹»¼¼¿ÀÂÃÅÄÃÃÃ…¾'ÃÃÁ¾¼¸´¯¬©§¥¢ Ÿžœ›™——”–› £ª°ºÂËÍÍÍÎÐÑÑÑ…ÐÏ„ÎÏηÍ=ÎÎÎÍÎÎÍÍÍËÉÇÆÄÃÁÁÂÅÇÉËËÊÊËÌÍÎÐÏÍÍÎÎÐÐÐÒÑÏÎÍËÉÇÇÆÅÅÅÇÅÃÂÀ¾¼»¼¼„» ½¿ÀÂÃÄÆÈÈÈɅʇÉ2ÇÇÆÅÇÉÍÎÐÐÒÒÑÑÐÏÍÍËÇÆÈȾ¶²¯µÂÇÈÅ¿»ÂÉÏÒÑÑÐÐÐÏÎÎÍÍÌ„ÊÉÈÇÆÅÉÊËÎÍÊž»¿¿¼µ´¸»¿ÃÄÅÅÄÇÊ€ƒÿ€ÿ€ò€ŽŽŽ•••–—˜™™š›œžžž¢„¡Ÿ¢¤¬™s~™ŸŸ¢£¤£¢…£ -¢¡   ¢£¦©ª…¨…§/¦§§§¦ªª§££¦¦¦¤£Ÿž›˜—•”“Œ‡‡‰“–™žŸ¢  ™™–¢©ªªª„«+ª¬«¨ª§¦¦§ª®°°°ª«¬­®²³³´µµ¶¹º»»¼½¿¿º¼¾¿ÃÀÂÃņDžÆÊÊÉÈÇ„ÂÁ¼¾½»¾‡½ ÀÅÈÎÑÑÔØÓÔÕÕÔ„ÓхЄÑÓÔÔÔ†ÓHÔÔÒÒÒÐÎÎÎÌÍÎËÊÊÉÈÈÉÉËÎÎÎÍÏÑÒÓÔÓÒÒÓÓÕÕÕ×ÖÔÓÑÐÎÌÊÉÈÈÇÅÃÂÂÁÀ¿¾¿¾¼¼½¿¿ÀÂÆÉÉȈÉdžÆ4ÅÄÃÄÅÇÉÌÌÍÍÎÎÏÐÐÏÍÎÍÊÉÉȾ¹±¬±¼ÊÊÄ¿»½ÆÌÓÓÌÊÍÍÌËÊÉÉÉÈÇ„ÆÄÃÅÅÄÁ¿ÀÀ¿½¸³¯­¬­­±´¸»¼¾¾¾¿Áƒ­„®¯°°±±²³´µ¶·¸··„¶¸·¶¶¡‡’¯·¶¶···¶¸„·¶µ´´´¶·¸º¹···¸¸…»/º»»»º¼»¹··¹¹¸·¶³²¯¬«©¨§ ›š¡§ªª­°°²²±±­ª¢ ®¹»¸¹„º-¹»º·´±°°±´¸ºº¹¹º»¼¼¼½¿¿À¿ÁÂÄÅÆÇÈÉÊËÈÆÇÈÈÊÌÎÏЄυÐ#ÍÍÍÌÊÎÎÍÎÍÍÉÆÄÁÃÃÄÄÄÃÄÇËÏÐÒÓÖÚØÙÚÙÚ„Ûڄ؉هØׄÖ××ÖÕÓÓÑÏÎÎÍÏÑÓ„Ö!ÕÖÖ×ØÙØ××ØØÚÚÚÛÛÙØ×ÕÓÒÒÒÑÐÑÑÐÎÍÍÌ„Ê ÈÈÉÊËÌËÌÌÎÑÒÒÑ3ÏÏÎÏÑÒÕØØ××ÙÙÚÜÜÛÙØÕÒÑÒÒÏÌÁ´µÄÒÖÕÐÍÉÎÕÖÖÙÙ××ÖÕÔÔÓÓÒ„ÑÐÏÎÏÏÏÐÒÒÏÎÌǽº¹»½ÀÃÇÊËÍÍÍÏÑ©©©««¨©ªªª¬¬­®¯°±²²±…³±®¬­˜w†§µ·¶···¶„°±³²°°±³³±°±µµµ¶¶…´`·¸¸··º¹·´³º¸µ°®¬«¨¥¤¦¥¤—š¡§ª¨¬©¦¨©¨¨¤ ›šª·¹³´µµµ¸·º¹¶®ª©©«­±´´³µµ¶·¸µ´³³³´¶·¹º¶¸¹º»¼»»¼¼¼¿ÀÂÃÄ„Ã…ÁÅÅÅÃ…ÂÁÀ¾»º¹»¹¸¶´¶¶¹¾ÁÆÈÉÌÐÌÍÎÎÏ„Ñω΄͂̅͂΅ÍDÌËÈÇÅÃÂÂÂÃÅÇÉÊÊÊÉÊÊËÌÍÍËÌÌÍÎÎÎÐÏÍÍËÉÈÇÇÆÅÄÅÅÃÂÂÀ¾½¼¼¼»»¼¼¾ÀÀÃÃÅÆÈÈÈɅʇÉSÈÇÆÅÇÉÌÎÐÐÒÒÑÐÐÏÍÍËÈÇÈȾ´«¬ºÈÊȾ»ÂÉÎÑÑÐÐÏÏÏÎÍÌÌËÊÉÊÊÉÈÇÆÄÈÉÊÍÍÉž»¾¿º³³·º¿ÁÃÄÅÄÆÊÿ€ÿ€ÿ€“€…šœœžžŸŸŸ ¡¢£¤¤¥¤„©ª««®­³²­®¬ª¬¬­¬¬«¬¬®¯¯®­¬­®®±³†´…²b³´´´³µ³®¨¥¤§«¬­¨§¨§§©¨¨¡š––•˜šŸ¡  ¡¥¥¦¤ šª®¯¯°±±±²°²°¬¬ªª¬­°±²²²®¯°°±µµ¶·¸µ¶¸¸¸º»»¼½º½¿ÀÃÀÂÃÅÇÆÇLJÈ(ÊËÌËÊÇÅÄÂÂÀÂÂÂÄÇÈÉÊÊÎÑÓÔÔÔ×ÖÖØÒÔÕÕÓÓÒÒÑЉÎЉÒÓÓÒÐÑÐÎÎÎÌËËÊÉÉ…ÊËÍÌÌÌÍΆÏÐÐÐÑÑÓÒÐÐÏÎÍËÉÉÈÇÅÃÂÀÀÁÁÀ¿À„¿ ÀÁÁÄÈËÉÉÉÊʅɇÈTÇÆÄÅÆÇÉËÌÍÍÎÎÏÏÐÏÎÎÎÌÉÉÆÄ»¤¤·ÆËÊľ»¾ÆËÒÑÊÈËÌÊÊÉÈÈÇÇÆÄÅÅÄÃÃÅÄÃÁ¾¿¿¾½¹³¯¬««¬¯²¶¹»¾¾½¿Â´µµ¶¶µµ·„¸¹º»¼½½¾…½$¿ÀÁÁ¾Ã¾Á¿À¿ÀÁÀ¿¿ÀÁÂÃÃÁÁÀÁÂÂÃÃÃÂÂÃÄĆÅÇÇÆ„ÅÆÅÃÃÁ¾¼…º¼»º³¬§¦¦©«®±±±„² °­¢§¶¾À¾¿„À+¿Á¿»¶´´¶·º»½¼¼½¾¿ÀÀ¿ÀÂÃÄÅÅÆÆÇÈÉÊËËËÉÇÇÈÈÊÌ΄ÏІÑ(ÐÑÒÑÐÓÑÐÎÍÑÎËÊÈÈÊÊËÌÒÕÖ×ØÒÕÔÔÖÙÚÛÛÚÛÛÛÚØׇØÖÕÔÕ„Ö#ÔÒÑÏÎÎÏÐÑÒÔÕÕÕÔÔÓÓÔÔÕÔÔÔÕÕÖÖÖØ×ÕÕÔÓ…Ñ ÏÏÏÍÌÌÍÍÌÌÌ„ËÌÍÍÍÎÎÏÑ„Ò‰Ñ ÒÒÑÐÏÐÒÒÕ„×)ÙÙÚÛÜÛÚØÖÔÒÑÏÐͲ¨ºÎÔÖÕÏÌÊÎÔÔÕ××ÕÕÕÔÓÒÒÑÑЄÏÎÎÎÏÎÏÑÑÎÍÌÈý¹¹º»¾ÁÅÈÊÍÌÌÏѲ³³´´¯°²²³³³´¶¶··¹¹¸„º$»·´´°µ¸¶ºº½¼¼½¼¼¸¹º»¼À¿½½½¾¾¼º»½½¾¿¿…¾W¿ÀÀ¿¿À¾½¼»½»ºµ³°°°¯¯µ´³¬¥¥¤¤§ª­°«§©«ª«©¥œ ²¼½¹º»»»¾¾¿½¹¯®­¯±³µ¶¶µ¸¸º»»¸·¶¶¶·¸¹¹¹º¼¼½½¼»„¼¿À„ÃĆÅÆÈÈÈÇÇÅÄÂÂÃÂÁÀ¿ÂÁÀÀ¾¿ÂÄÅÅÊÌÌÌÎÍ„ÏÑÐÐÏ΄Í̈ˆÌÍÎÍ…ÌDËÊÇÅÃÂÂÃÄÅÇÈÉÉÉÈÈÇÇÈÈÉÈÈÈÉÉÊÊÊÌËÉÉÈÇÆÆÅÅÅÃÃÃÂÀÀÀ¿¿¾¾¾½½¾¾ÀÁÃÄÆÆÇÈÈÈɉÊ)ËËÊÉÈÇÆÇÉËÍÐÐÒÒÑÏÐÏÎÍÌÊÈÈÅÄ¿¥ ²ÄÉÊÈÁ¼¼ÂÈÍ…Ï(ÎÎÌËËÊÊÉÈÉÉÈÇÇÅÃÇÉÊÌÍÈÆÀ¼½¿º²°µ¸½ÀÂÄÄÄÆÊÿ€ÿ€ÿ€“€¤„¥ ¢¢¤¥¥¤¥¦¦§©„ª¬®¯¯¯®®³±¯´³²°¯†²³´¶¶·¶¶··¹¹º¼¾¾¾¿¿¿…¾/½¾¾¾½½½¹µ´´²¶´³´´´µ¶´³´±­¥¢¢¤§ª¬ª¨¨ª¨¨¥¢™ ®¯¯±±†³±­®­­®¯„²#´°°°±±µ¶¶·¸··¸¸¸ººº»»¹¼½¾ÂÀÂÃÅÇÆÆÈÈˆÉ ÊÉÉÇÇÆÅÅÂÅÇÆ„Ê ÌÍÐÒÒÐÏÔÔÒÒÒЄÒÑÐφÎÍ„ÌÎÐÑ‰Ò ÑÐÐÏÎÎÌËË„ÊË̇ËÊË„Í΄Ï(ÐÏÏÒÑÏÏÏÍÍËÉÈÇÆÄÂÂÀÂÂÂÁÀÀÁÀÀÁÂÂÂÆÊÍËÉÊËÊ…ÉˆÈ -ÇÆÇÇÇÈÊËÍÍ„Î%ÐÐÎÏÎÍÊÉÇÆ´“ž»ÈÉÇľº¾ÆÊÑÐÉÇËÊÉÈÈÈÇÆÅĆÃÄÃÿ½¿¾¾½¹µ°¬«««­°´¸º½¾¼¾Á2»»»½½»»½¾¾½¾¾¿ÀÁÂÄÄÂÁÁÂÃÄÂÁÇÇÄÀÁÂÃÄÅÆÆÆÅÆÇÈÊÊÌÊÊËÌ„ÍÌÍÍÎÏÏ…ÑaÐÑÑÑÐÏÏÏÎÍÍÌÊÇÅÆÆÇÈÈÇÅÆÃÀ¸µ³¶¹¹º¹¶¶´²²¯¬¡«»¿ÀÀÀÁÁÁÃÁÿ¼¹·¶¸¹¼¼½½½¾¿ÀÀÀ¿ÁÃÃÄÇÇÈÈÈÊÊÊÌÌÊÇÆÆÇÈÊÌÎÏÎωÑÒÒÒÑÒÒÒÑÑÓÑÏÏÌÌÍÐÑÒÖ××ÖÔÙÙØ×ØÙ„ÚÙÙ؆×Ö…Õ‚Ö‡×ÖÖÕÔÔÕÖÖÔÔÒÐÐÏÏÑÑÒÔÕÕÔÔÔ†Ò.ÓÓÓÔÔÕÔÔ×ÕÔÔÓÒÒÑÑÑÏÏÎÏÍÌÍÎÏÍÌÌÍÌÌÍÍÏÏÏÐÐÑÑÓÔÒÒ‰Ñ6ÒÒÒÑÑÒÒÒÔÖ×××ÙÙÚÚÜÜÚÙ×ÖÓÑÏΟ¼ÑÑÓÕÏÊÊÎÒÓÔÖÖÔÔÔÒÒÑÑÑÏψÎÍÏÐÐÎÍÌÈľ¹¹ºº¼ÀÄÇÉÌÌÌÍÑ»»»½½··¸¹¹¸¹¹¹»¼½¾¾½½¿¿¿À¾¿Àº¹„¼½¾¿¿¿¾¿ÁÁÂÂÈÇÇÇÈÉÉÅÄÄÅÅÅÆÆ…ÊdÆÇÇÆÆÄÄÃÃÁÆÄ»¸¹¹¹º»½»¼¹¶°®­°³¸¹´¯¯­««©¥›¤·½½»»¼¼¼ÀÀÀ¾º²°¯±³µµ¶¶·¹ºº»»¸¸¶¶¶¹¹»»»½½½¾¾»º¹»¼¼¿ÀÂÃÂÃÅÅÅ…ÈÇ„È!ÇÇÆÅÅÆÅÅÄÄÅÄÄÃÄÆÇÇÆÆÍÍÌËÌÍÎÎÎÏÎÎΆÍ˅ɂʇËÌÍÌÌÌ„Ë ÉÇÄÄÃÃÅÅdžȉÇÈÈÉÈÈËÉÈÈÇÇÆÅÅÅÃÃÂÂÂÀÂÂÁˆ¿ ÂÂÄÆÈÈÈÉÉÈɉÊ6ËÌËÊÉÈÇÇÈÊÍÐÐÒÒÐÎÐÐÎÎÍÌÉÈÅö’—µÆÇÇÈÁ»¼ÂÇËÏÏÎÎÍÍÌËÊÊÉÉȆÇÅÃÇÈÊÌÌÈÆÀ½À¿º²°´·»¾ÁÃÄÃÅÊÿ€ÿ€ÿ€“€¦§§‡¨-§¨©ªª¬¬­®­¯¯°²²±³°±°»»¸¶¶´µµµ´µ¶¶¸¸¹¹¹¼½¼¼½¿À…Á…Ã1ÁÂÂÂÁ¼½¿ÀÁÀ¿½¸¶»»¼½½½¹¹¹¸±®®±µ¹»»º»¹¶²«¦§´³±³³´´„³°¬¯®­®¯³³µµ·±²³´´¶·¸¹¹´µ·¸¹¸„¹ ·º¼½ÀÀÂÃÅÇÅÆȈÉ%ÊÊÉÈÆÆÅÄÄÂÆÈÈËÇÈÊËÌËËÌÌÍÉÈÆÈËÍÎÏÏÎÏÎ͆̅ËÍÏÐЈÒÐÐÐÎÎÎÌÊËÌËÊËÍÍÍ„ËÊÊÊÌ„Í·Ï%ÐÑÏÏÏÎÍËÈÈÇÆÄÃÂÂÂÃÂÂÁÂÂÂÁÂÂÃÄÇËÍËÉÊˈɄÈÉÉÉÈ„ÇÈÊËÍÍ„Î$ÏÐÎÏÏÎËÈȽ¥•¬ÂÅÇÈüº½ÆÊÏÐÉÇÉÊÉÈÇÆÆÅŇÃÄÃÿ½„¾º¶²­¬¬ª¬°³¶¹½¼¼¾Á¾¾¾¿¿…ÁÀÁÁÃÃÅ„Æ!ÂÄÄÅÆÄÆÄÉÈÅÈÇÈÈÈÉÉÉÈÊÊÊÌÌÍÍÍÐÑÐÐЄσхÓdÑÒÒÒÑÑÐÍÌËÊËËËÌËËÍÍÎÌÈÈÈÇÀ¾½ÀÄÃÅÅÄÅÁ¾»´®¥°ÁÂÂÁÂÃÃÂÂÁÁ¿»¹¸¶¸¹½½¾¿ÁÀÁÂÂÃÀÂÄÄÅÇÈÊÊËÊËÌÌÌÈÆÄÅÅÈÊÌÎÏÎÏÑÑÑ…Ò'ÕÖÖÕÔÒÒÑÑÐÓÑÐÐÏÐÓÔÖ×ÕÕÖ×××ÖÔÖÚÙÚÛÚÙØ×ÕÕŒÔÕÖ†×ÖÖÔÓÔÔÖÖÔÓÒÑÑÐÑÒÒÓÔÕÕÔÓˆÒ‚Ó…ÔÖÕÔÔÓÓÒÒÑÐÏÎÏÏÎÍÏÏÏ‡Í ÏÏÐÐÑÑÑÒÓÔÔÒ„Ñ…Ò9ÓÔÓÑÑÒÒÒÔÖÖ××ÙÙÙÚÛÜÚÙØÖÓÑÎűž®ÃÍÐÔÔÍÊÉÏÒÒÓÕÕÔÔÓÒÑÑÑÏÏÎÍÍÍ…ÎÍÏÐÏÎÍÍÉÅ¿»ººº»¾ÂÅÈÌÌÌÍо¾¾¿¿…¼»¼¼¾¾¿„Á(¿ÀÁÂÃÉÊÅÆÅÅÅÂÀ¾ÁÂÂÂÁÃÃÄÅÅÉÉÊÌÍÍÍÉÆÇÇÇÈÉÉ…Í…É_ÅÅÅÄÄÆÄþ¼¾¾¿ÀÀÃÀÀÀ¿»¹¸»¾ÃŽ¿»·´­¨Ÿ©¼ÁÀ¼½¾¾½ÀÀÀ¾¹³°¯±³···¹º»¼½½¾º¹¸¸¸¹º¼½¾¿¿ÀÀÀ¹¸¹¹¹¼¿ÀÂÃÂÃÅÅÅ…ÊÉÊÊÉÈÆÆÅÄÄÆÆÇÇÇÈÈÈÇÅÉÉÊËËÈÈÆÇˈ͈ÊɆÈÉʆËÌÍÌ†Ë ÉÇÅÅÄÅÆÇÇ„È‹Ç…ÈÊÉÈÈÇÇÇÆÅÄÃÂÃÄÂÁÀ¿¿À¿¿ÀÁÃÄÆÇÉÈÈ„É„ÊË…Ì0ÍÌÊÊÈÇÇÈÊÍÐÐÒÒÐÎÏÐÎÎÎÌÉÆÅ»¥”¦¼ÃÆÈÆ¿»¼ÃÇËÎÎÍÍÌÌÌʄɇÇÅÃÇÈÊËÌÈÆÁ¾ÀÀ»²¯³¶º½ÀÃÃÃÅÉÿ€ÿ€ÿ€“€§©©©§¬¬¬««¬¬®°°°±„²³´µ¶¶„·…¸ -¶··¸¸ºº»»»‡½¿ÃÅ…ÁÃÂÂÃÄÂÂ…ÁÀ¿¾¿„¾ÂÃÃÂÁÃÿ¾¹·µ·¹»ÀÀÀÁ¾¼¹±«¢±º»¾…¸¹·¶³°¯­­¯²µµ¶··‡¹ºº»º»¼½¾¿¾½¼¼¼»¹»»¼¾ÀÂÂÄÄÆÈ„É/ÊÊÈÈÈÉÉÂÄÅÄÃÈÉÉÎÏÎÏÏÐÐÎÏÎÌËÈÈÈÊËÌÍÌËËÊÉÈÈÊÊËËËÍ„ÏÎÌÍÎÏÍ̈ΠÏÐÐÏÏÌÊËÌÌÍ΅ωÍ+ÏÐÐÐÑÑÐÐÒÑÐÐÒÐÍÊÉÈÇÅÃÂÁÀÁÂÂÃÃÃÂÂÄÅÄÄÅÇÈÈÉÊɈÈÇÆÇ…È ÇÆÆÈÉÉÊËÌËÍ„ÎÍÌËÊÆ»©£µ¿½¿ÄÄÀ»··¾†ÄÆ„ÈÅ„ÁÀ¿¿Á…À¿¾¾¾º¶¯«©¨©¬®²µ¹¼¾½¾À¾ÀÀÀ¾ÀÁÁÀ¾ÂÂÄÅÆÄÅÆÆÆÇÇÈÉÉÊÌÌÌË…ÌÊËË„ÌÍÍÍÏÏÏÐÐÒÐÏÏÏÐÐÑÑÑÒÒÑ„Ò ÑÐÏÐÐÑÐÏЄÏÌÌÍÌÌÍÌÌÉÈÅÃÁÃÅÇÌÌÊËÆÄÁº³­½ÆÇɆÄÿ»¹··º»¿¿ÀÁÁ‡ÃNÄÄÅÄÅÆÇÈÉÈÇÆÆÇÆÆÆÇÇÉÌÎÏÍÍÎÐÑÑÑÒÒÒÓÔÔÕÕÔÕÖÖÕÓÑÒÑÒÓÔÔÕÖ××ÖÕÔÖÔÔÖÕØÙØ×ÖÖÕÔÔÔÓÓÔÔÓ„Ò -ÓÕÖÖ×ÖÕÖ×ׇÖÕÓÓÑÐÑÑÑÒÓÔÔÔÓÓ‰ÒÓÕ†Ö.×ÖÕÖ×ÖÔÒÒÑÐÏÏÎÍÌÍÎÏÏÏÎÏÏÐÑÐÐÑÓÓÔÕÖÕÔÓÒÒÒÑÒÒÑÑÑ„Ò ÑÒÒÒÓÕÔÔÕÖÖØ„ÚÙØ×ÖÒǵ«»ÃÄÊÐÑÌÉÇÇÏÔ†ÕÔÒÑÑ…ÒÑ„ÏÐ…ÏÍÍÍÉÆÀ»º¹¸º½ÁÄÈËÌÌÍоÀÀÀ¾¾¿¿¾½¶¶¸ºº½¾¿¿¿ÃÃÅÆÆÄÅÅÅÄ…ÅÃÄÄ„Å!ÆÆÆÈÈÈÊÊÆÆÆÈÉÇÈÉÉÉÍÍÌÍÎÍÍËËËÈÈÃÁÀ…ÂÄÆÇÅÄÇÆÅÂÁ¹·µ·¹ºÀÀÄÄÀ½»³­¢±º»¾…¸¹·¶³°²±±³µ¸¹¹ºº†¼½½¾¾½¾¿…ÁÀ¾¼»¹»»¼¾ÀÂÂÃÃÃÇÈLJÈÉÉÆ…ÈÇÈÉÊÇÈÈÉÊËËÊÉÈÃÇÈÊÏÌÍÌËËÊÉÈÈŒÉÊÊËÊÉÊËË‡Ê ÉÇÇÆÄÅÅÅÆÇÈÈÈŒÇɆÊ:ËÊÉÊËÊÉÇÆÅÄÃÃÂÁÀÁÂÂÃÃÃÂÂÄÅÄÄÅÇÈÈÉÊÉÈÊÌÌËÊËËÊÉÊËÌÌËÊÈÆÆÈÉË΄τÎÍÌËÊÆ»©¡²ºº¿ÄÄÀ½¹ºÁ‡ÇÈÌÌÎË„ÇÉÊÊʈÊÈÈÈľ¹¹·³²µ¸½ÁÆÇÇÈÍÿ€ÿ€ÿ€“€§©©©§«¬¬«««¬®¯°²†³´¶¶··¹¹¸‡¹ººº»ˆ½¾½¾¿ÃÆŠÁ„Á¿¾¾¾½…¾ÂÃÃÃÂÃÃÃÁÀ¼¹·¹»½ÀÂÂÃÂÀ¼µ¯©¶½¾¿†¼¹¹¶²²±²³µ¸¹º»¼…º†¼‚½„¿½¼¼»¹¹º»¼¿ÀÂÂÄÄÆÈÉÈÈÉÉÉÇÇ„È'ÊÊÊÉÊËÌÐÐÏÏÏÐÐÎÎÌÌÊÈÈÇÈÉÊËËÊÉÈÇÇÇÈÉÉÊÊÌ„ÍÌË̄΃υÎÏÐÐÏÏÌÊÌÌÍÎÏÐÐÏΉÍÎÏÐÒ҄ЂфÒÎËÉÉÇÆÅÊÂ&ÄÅÅÆÇÈÉÉÊÊÊÈÈÉÉÉÈÉÉÈÈÈÉÉÉÈÈÇÆÆÈÉÉÉÊËËÍ„ÎÏÊÈÌ¿ª ª»¿½½Âÿ½¹ºÁÇŠÈ ÅÂÁÁÁÀ¿¾¿¿À…Á¿¿¾»¶±«ª¨©­®²µ¹¼¾¾¿À¾ÀÀÀ¾ÀÁÁÀ¾ÁÂÄÄÅƆÇÈÉÉËÌÍÍ̉ÍÎÍÏÏÏÐÏÏÐÐÑÒÑÐχÑÏÏÐÑÒÑÑÐÏÏÍÏÎÍ…ÏÌÍÍÌÌÎÎÎËÊÇÄÃÅÇÉÌÎÌÍÊÇľ¹µÃÉÉ̆ÇÄľ¼º¼½¿ÂÃÄÅƅĆƂDŽÉÇÆÆÇÆÆÆÇÈËÌÎÏÍÍÎІт҄ÔÖÖÖÕÖ‡Ô„ÖÕÔÒÕÒÒÔÔÖ××ÖÕÔ„ÒÑ„Ò„ÑÒÔՄփ؄×ÖÖÖÕÓÓÑÐÑÑÒÓÔÕÖÔÓ‰ÒÓÓÕ××…Ö"×××Ø×ÕÔÒÑÐÐÑÏÏÍÍÍÎÏÏÎÏÏÐÑÑÒÒÔÕÕÖÖÖ„Ô -ÓÒÓÔÒÑÑÓÔÓ…ÒÓÕÓÔÔÖÖØ„ÚÛÖÔØ̶¬³ÁÃÃÉÎÏÌÈÄÅÍÒ‡Ô ÒÑÑÒÒÑÑÑÐÏÍ·ÏÎÏÍÊÆÁ¼º¹¹»½ÁÄÈËÌÌÏоÀÀÀ¾ÀÁÁÀ¾µ¶¸¹º¿„ÁÃÃÅÆÆÄ‹ÅÇÇÈÇÈÈÉÊÈÈÊÊÊÆÇÇȆɅËÍ„ËÆÅÂÀ¿…ÂÅÇÇÆÅÇÇÇÄü¹·¹»¼ÀÂÅÇÃÁ½·²©¶½¾¿†¼ ¹¹¶²¶´µ·¸»½‹¾ƒÀ„ÁÂÁÁÀÀ»¹¹º»¼¿ÀÂÂÃÃÃÇÈÆÆÈÈÈÇÇ„È ÊÊÊÉÊÉËËÌÈÈÈ„ÊÉÈÇÃÅÇÈÍÊËËÊÉÈÇÇÇ…È…ÉÈÈÉ„ÊÌÍÌ„ËÊÊÊÉÇÇÆÄÅÅÆÇÈÉÊÈŒÇÉËË…Ê ËËËÌËÉÈÆÅÄÄÅÊÂ&ÄÅÅÆÇÈÉÉÊÊÊÈÊÍÍÌÌÌÍËÊÊÌÍÌÌÌÈÆÆÈÉÊÍÎÏÏÏ„ÎÏÊÈÌ¿ª ©¸ºº½Âÿ½¹ºÁ‡ÇÈÌÌÎÏÐÏÏÏÌÊÈÉÊÊ…ËÉÊÉÅÿº¹¸´³µ¸½ÁÆÇÇÊÍÿ€ÿ€ÿ€“€§¨¨¨§§¨¨§¦ª«¬­®°„± -²³³³µ¶·¹º¹‰º¼„½¾¼½½½¾½¾¿ÃÆÁÁÀÀÀ¿¾¾¾À‡½ƒ¼„¾¿…ÃÂÃÂÀ¿¼¹¶¸¹»¿ÁÁÃÂÀ½·³±¸¾‡¿¾¼¼¹µ³²³¶¸»¼½½¾…½¿„¾½½½¿¿À¿¿¾½»ºº¼¼¾¿ÀÂÂÄÄÆÈÉÈÈÉÉÉ…È(ÎÐÐÐÏËÌÌÐÒÑÑÑÐÐÌÍÌËÉÇÇÇÈÉÊÊÊÉÈÇÅÅÅÇÈÉÊÊÌ„Í ÌËÌÍÎÎÏÐÑÐÐÐÏÏÎÏÐÐÏÏÍÌÍÍÍÎÏÐÐÏÍ̈ÍÎÏÐÒÒÑÑÐÑÒÓÔÔÔÓÏÌËÉÇÆÅÄÃÂÂÁ†ÂÄÅÆÇÈÉÊËÊËÊÉÊËÊ„ÉÈÈÈÉÉÈÈÈÇÆÅÆÇÇÇÉËËÌ…ÍÌËÁ®£§µ¾À¼¼ÀÁ¿»¹ºÂÈ…É…ÈÅ„ÂÁ¿¾¾¿ˆÀ¿»·±­¬©ª¬°²¶¹½¾¾¿Á¾¿¿¿¾¾¿¿¾½¾¿ÀÁÂÃÅÅÆÅÅÇÇÈÉỂÍÏÏÏÐÏÏÐÐÑÏÏÏÐÑÒÑÐÏ„ÐÏÏÎÍÍÎÎ…ÍÌÌÍÍÍÎÏÏÐÐÍÍÎÍ„ÌÊÉÇÄÃÃÅÇËÍÌÌËÇÅ¿»¼ÄÉʈÊÈÇÄÁ½¼½ÀÂÅÆÇÇÈ…ÇÉ„ÈÇÇÇÉÉÊÉÉÈÇÇÆÆÇÈÊËÌÍÏÍÍÎІÑÓ„Ô ÑÓÓÓÒÖÔÔÔ†ÖÕÕÕÓÑÔÒÒÓÔÖÖÖÕÓÒÒ…ÑÒÓÒ„ÑÒÔÔÕÖ×؆ÙØ×ÖÖÕÓÓÒÑÑÒÒÓÔÖÕÔÒÑчÒÓÔÖ×ׄÖ$×ØÙÙÙØÖÔÓÑÐÐÑÐÏÏÎÍÍÎÏÎÏÏÐÑÑÒÓÕÖÖÖ×ÖÕ†ÔÓÒÑÒÓÓÒÒÑÒÒÑÒÓÒÑÔÕÕ×…ÙØ×͹®³½ÄÃÄÇÌÍËÇÃÄÍÒ…ÓÔÔÒ„Ñ„ÏÎÍ͆ÏÐÏÏÎËǾ¼ºº»¾ÂÅÈÌÍÍÏѾ¿¿¿¾¿ÀÀ¿¾·¸¹»»½¾¿¿¾ÂÃÄÄÆÄÅÆÇņÇÈÈÈÊÈÈÉÊÊÈÈÉÊÊÆÆÆÇÉÈÈÇÇÇÉÉÈÉÉ…ÈÃÿ¿¾Á„ÂÆÇÇÇÆÅÆÅļ¹¶¸¹¹¿ÁÄÆÄÁ¾¹´±¸¾‡¿¾¼¼¹µ·¶·¹¼¾¿ÁÁÁ…À…Â…ÁÄÃÁÁÁ»ºº¼¼¾¿ÀÂÂÃÃÃÇÈÆÆÇ‡È -ÉÊËËÊËËËÌÍ…ÊÉÉÉÈÅÁÅÇÈÍÊÊÊÉÈÇ„ÅÆÇ頃 ÈÈÈÉÊËÌÍ΄ÍÌËÊÊÉÇÇÆÅÆÆÇÈÈÊÉÈÆÅƈÇÈÊËË„ÊËÌÍÍÍÌÊÈÈÅÄÄÅÄÃÂÂÁ†Â&ÄÅÆÇÈÉÊËÊËÊÉËÎÎÍÍÍÌËÊËÌÌÌËÊÈÆÅÆÇÉËÍÏÏÎ…ÍÌËÁ®£§´»»º¼ÀÁ¿»¹¹ÁÈÈ„ÇÈÈÌÌÎÑÔÓÓÓÏÉÈÉŠÊÅÄÀ¼º¸··¹½ÀÃÇÈÈÊÍÿ€ÿ€ÿ€“€…¥ £¤¤¢¡¦§©ª«¬„®°°²²²´¶·‰¹„º »»¼½º»»¼½»½¾Áÿ¿¾¾¾¼¼»¼¼¹ºº»»»¼»„½¾¿À…ÄÀ¿¼¹¶¶¸º¿¿À¾»¸µµ¹¼¿½…¿À½½º¶µµ¶¸º½¿ÀÀÀ…ÂÃÆÀ'ÁÀÀ¿¿¼¼¼¾¿¿ÀÂÂÂÄÄÆÈÉÉÉÊÊÊÉÉÊÊÊÐÑÒÑÐËÌÌцÒÎÎÌÌÊÈÈÇÈÉÊËËÊÈÆÅÅÅÆÈÉÊÌ΄ÏÎÌÎÎÏÐÑÒÓÒÒÒÑÏÏÏÐÐÏÏÍÌÍÍ΄ÏÍËÊËÌÍΆÏцÒÓÖÖÖÕÔÐÎÌÉÇÆÅÃÂÂÁÀÁ… ÄÅÅÇÈÊÊÊËËË…É ÈÈÈÇÆÆÈÈÇÆÆÅ„ÃÅÅÈʆËÉÊÇ°¤«¶½½Á½»¾¿½»¹»ÃÉ…ÊÉ„ÈÅ„ÂÁÁ¿À‰ÁÀ¾¹²­¬«ª­°³·¹½¾¾ÁÁ»½½½»½¾¾½»º»½½¾À„ÁÄÄÅÆÆÈÊÌ‹ÍÎÍÍÍÎÏÍÍÍÎÏÐÏÎÎÎÏÏÍ„Ì -ÊÌÌÈÉÉÊÊËÌ…Í!ÏÐÑÍÎÎÎÍËËËÊÉÇÄÂÂÃÅÊÌÊÌËÆÃÀ½ÁÄÈÊÉ…ÊÌÉÉÅÿ¾ÀÂÄÇÉÊÊË…ÌÍÌÌÌË…Ê)ÌÊÊÉÉÇÇÇÉÌÌÌÍÍÏÍÍÎÐÑÑÑÒÒÒÕÕÖÖÖÓÕÖÕÔ×ÔÔÕÖØ„×ÖÖÕÔÒÕÒÒÔÔÖ××ÖÔÒ†ÑÒÔÓ„Ò$ÓÕÖ×ØÙÙÚÛÛÛÚÙØØÖÖÕÓÓÒÑÒÒÓÔÔÔÓÒÑÐÑÑÒÓ†ÔÖØØׄØÚÛÛÚÙ×ÖÔÑÐÐÑÏÏÍÍÌ„ÍÏÏÐÑÑÒÓÖÖÖ×××ÕÔÔÔÓÒÒÒˆÑЄÏÐÏÒÔÔÖ„×ÕÖÓ½°·ÁÅÃÃÆÇÉËÉÅÁÂÌÑ…ÒÓÔÒ„ÑÏÑÐÏÐÌÈþ½»º½¾ÂÆÈÌÍÍÏÑ»½½½»½¾¾½»·¸¹¹¼¹„»ÀÀÂÃÊÅÇÇÈÅÇÇÇÈÅÇÇÇÈÄÄÄÆÇÆÆÅÄÄ…ÅÃÄÄÅÅÂÿ¿¿ÀÀÂÂÃ…ÇÄÄÄÃÁ¼¹¶¶¸·¿¿ÄÅÄÀ½¹¶µ¹¼¿½…¿À½½º¶¸·º¼¾ÁÁÃÄÄ…ÅÇÆÅÅÄ…ÃÄÄÃÁÁ¼¼¼¾¿¿ÀÂÂÂÃÃÃdžÈÉÉÊÊÊËÌÍÌÌËËËÌÍÌ„ËÊÊÉÈÇÃÅÇÈÍÊËËÊÈÆ„ÅÆÈÈÊʆÉ!ÊËÌÍÍÎÐÏÏÎÎÍÌÊÊÉÇÇÆÅÇÇÇÈÈÈÇÆÅÄÅÅLJÈÊÌÌËÌÌÌÍÏÏÏÎÍËÊÈÅÄÄÅÃÂÂÁÀÁ…ÂÄÅÅÇÈÊÊÊËËËÉËÍÍ„Ì ÊÉÉÊÊÊÉÉÇ„ÃÇÉËÎÎÍ„ËÉÊÇ°¤«¶»º¼»»¾¿½º·¸ÁÈÈ„ÇÈÈÌÌÎЄÓÏËÊʆËÌËËÊÇŽ»¹¹»¼ÁÃÅÇÈÈËÍÿ€ÿ€ÿ€“€¢¢¤¢¢ ¡¡ Ÿ£¥¦§¨«¬®®¬­¯¯¯±²´¶··…¸¶··…¸¹º¸¸…º9»¿Â¾½¼»º»º¹º»¹¹º»»¼¼½¾¾½½¾ÀÀÃÃÄÃÃÁÃÃÁÁ¾º¸¸¹»¿ÁÂÃÄÀ½¹¶¹¹¾Á‡À½½»¶¸·¹¼¾ÂÂÃÄĆÅ(ÄÃÃÃÄÄÃÃÃÂÁÀÀ¿½½¿ÀÁÀÀÂÂÂÄÄÆÈÉÊËËÌÌËËÌÌÍÏ„Ñ#ÍÏÏÔÕÔÓÒÒÒÎÏÎÌËÈÈÈÊËÌÍÌËÉÇÅÅÅÇÉÊÌÍÏ„Ð$ÏÎÏÏÐÑÒÓÔÓÓÓÒÑÏÏÐÐÏÏÍÍÍÎÏÎÏÎÍËÊÊÊÌÍÏ„ÑÐÐÑÒÒ„ÔÖ×××ÖÔÑÎÌÉÇÄÃÂÁ„À… ÄÅÅÆÇÈÊÊËËËÊÉ„ÈÇÆÅÄÅÆÅÄÄÃÃÂÂÁÁÃÄÇÉËÊ„ÈÇŹª±»½¿½¿¼¹¼½¼»º»Å†ËÊ„È -ÅÂÁÁÁÂÁÁÁ†ÃÁÁÁ¾¹³¯­««­°´·º¾¿¾ÁÁºº»ºº¹ºº¹¸¸¹ºº¼À…ÁÂÃÄÄÆÈʈÌ2ÊËËÌÌËËËÌÌËËÌÌÌÎÍÌÌÌÍÌËÊÉÊÉÈÉÊÈÈÉÊÊËÌÍÎÎÍÍÏÑÑÍÎÏÎÍ„ÌËÊÆÃÃÅÆËÍÍÎÌÇÅÁ¿ÅÆɈÌÉÉÆÃÂÂÃÆÈÌÍÍÎÎ…Ð)ÏÏÎÍÍÎÎÍÍÍÌÌÊÊÉÉÉÊÌÍÌÌÍÍÎÍÍÎÐÑÓÓÔÔÔ××ØØÙÙ„ÛÙØØ×ØÙØØ„×ÖÕÔÖÔÔÖÕØÙØ×ÔÒ…ÑÒÔÖÕ„ÔÕÖ×ØÙÙÚÛÜÛÜÜÛÙØÖÖÕÓÓÒÒÒ…ÓÒÐÏÏÐÑÒÔ„ÖÕÖ×ØØ„ÙÚÜÜÜÛÙØÖÕÒÐÏÏÎÍ„Ì(ÍÍÍÏÏÐÑÑÒÒÔÖÖ×××ÖÔÒÒÒÑÑÑÏÏÏÐÏÏÏÎÎÎÍÍÍÎÏчÔÓÑŵ¼ÆÉÇÃÂÄÆÈÉÈÄÀÁËÑ…ÒÓÔÒÑÑÒÒ…ÑÐÑÑÒ„ÓÒÑÑÐÌÉÄÀ¾¼º½¿ÂÆÈÍÎÍÏѺº»ºº¾¿¿¾½´µ·¸¹¸º»»º¾¿¿ÀÁ¿ÁÄĆÅJÃÄÄÅÅÃÄÄÅÅÄÄÅÅÅÃÃÃÄÅÄÃÃÁÁÅÄÃÄÅÃÃÄÅÅÃÃÀ¿¿ÀÀÂÃÃÇÇÈÇÇÄÆÆÅľº¸¸¹¹¿ÁÆÇÅÁ¾»¸¹¹¾Á‡À ½½»¶»»¼ÀÂÅÆƇÈ5ÉÈÇÇÇÈÇÆÆÆÅÄÄý½¿ÀÁÀÀÂÂÂÃÃÃÇÈÉÉÉÊÊËËÌÌÍÎÏÐÐÏÍÍÍÏÏÍÌÌ„ËÊÉÈÃÇÈÊÏÌÍÌËÉÇÅÅÅÆÈÈÊËÌ…ËÊËÍÍÍÎ…ÐÏÍÌÊÊÉŠÇÆÄÃÃÄÅÇÉ„ÊÉÊËÌÌ„ÍÏÐÐÐÏÍÌÊÉÆÄÂÃÂÁ„À…Â&ÄÅÅÆÇÈÊÊËËËÊËÌÌËÊÊÉÉÈÉÉÉÈÈÇÅÂÂÁÁÄÈÊÍÎË„ÈÇŹª±»½½ººº¹¼½¼º¶¸ÁÈÈ„ÇÈÈÌÌÎÎÏ„ÍËËË̆ÎËËËÇƽ¼º¹»½ÁÃÅÈÉÉËÍÿ€ÿ€ÿ€“€:Ÿ¡ŸžŸ˜˜˜šž¡¤¦¨©ªª©©ª««±³µ··¹·µµµ¶¶¶µµµ´³´µµ¶··¶¸¸ºº»¼¼¼‡»º»»¼¼‡¾¿À„Á.¿¿ÂÂÂÃÃÁ¾»¹¹»¿ÁÁÀÃÁÀ½¼º¼¾ÀÂÀÂÃÃÂÀÀ¿½¼º»½ÀÂÃÄÆƆÇÆÆÅÄÄÇÇÇÅÄÃÁÀÀÀ¿ÀÁÀÀÄÂAÃÅÇÈÈÈÉËÌÍÍÎÎÏÐÐÐÑÑÑÍÐÒÑÔÓÒÒÑÑÒÒÑÎÌËÊÊËÍÎÎÍÌÊÈÇÅÅÇÈÊÌÍÑÔÕÔÒÏÎÏÑÑÒ„ÓÔÓ„ÑÒÐÏÏÌÉÉÉÊÍÏÍÌÌÊÇÊÌÍÎÎÏÏÐЄÑÓÕÖÖ×ÖÖØØÕÐÍËÈÆÄÃÂÁÁ„ÀÁÀÀÁÂÃÃÄÅÇÉÉÉËËËÊÉÈÇÇÆÆÅÅÄÄ„Ã#ÂÂÀÀÂÃÃÇÉÉÈÇÄÅÊȹ­´¼¾½¾¾½»µº»º¹¶¹ÄȇɃȆDžÈÆÆÄÃÁÁÁ¿½¹´°­«¬¬­²¶¸º»»¾¿¶¸·´µµ·„¶1¹¹º½¿ÁÂÂÂÁÁÂÄÄÅÇÉËËÍËÉÉÉÊÊÊÉÉÉÈÇÈÉÉÊËËÊÊËÌÍÍÌÌÌËË…ÊÉÊʄ͈̃Ï/ÐÐÎÎÏÏÏÍÉÇÄÅÅÉÌÌÊËÉÈÆÄÄÆÈÊÌËÌÍÍÌËËÉÇÆÄÅÇÊÌÎÏÐÑÑ…ÒÑÐÐÏ΄ÐÎÎÌÊÊÊÉËÌËÊÏÏÏÍÍÏÑÒÔÔÔÕ××ÙÙÚÚÛ„Ü$ÝÝÞÜÚÙÙÛÛÚÙÙÚÚÙÖÕ×ÖÖ×ÙÚÚÙØÖÔÒÑÑÒÔÖØÙ„Ø(ÖÕ×ØÙÙÛÛÛÜÜÜÛÚÙÙÙ×ÕÓÓÒÑÑÒÒÓÓÒÑÑÏÎÑÓÔÕÖØ؆ÙÚÚÛÛÛÜÝßÞÜÙÙ×ÔÒÑÏÎÍÍ„ÌÍÌÊËÌÍÍÏÏÑÓÓÔÔÖÔÕÕÓ„ÒÑÑÐÏÎÍ„Ì!ËËÌÌÎÐÓÔÓ××ÕÒ˵ÀÍÏÍÊÆÆÅÆÆÄÂÁÁÅÏÔ…Õ‚Ô‰Ò…ÑÓÕ×ÖÕÔÓÑÏËÅÀ¾¼»»¼ÀÅÈËÌÌÏÐ%¶¸·´µº½¼¹¹¶··µ¸º¼½½½¼¼½¿¿¾ÀÃÄÄÆÄÃÂÂÃÄÂÁÀÁÂÂÃÄÄÃÄÄÅÆÇŠÅÄ„Å ÄÄÄÅÅÂÂÆÉËËËÇ…Â ÃÃÁ¾»¹¹¾Á„ÄÃÁ¿¾¾¿ÁÄÅÄÅÇÆÅÄÄÂÁ¾¾¾ÁÃÅÇÈÉÉÊ…ÇÉÉÈÈÈÊÊÊÈÈÇÄÃÃÄÄÄÂAÃÅÇÈÈÈÉËÌÍÍÎÎÏÐÐÐÑÑÑÏÎÎÎÍÐÏÎÍÍÎÎÍÊÉÉÈÈÊÊÎÎÍÌÊÈÇÅÅÇÈÊÌÍÎÎÏÎÎËËÍÍÎφÐÎÍÍÍËÉÇÇÆÅÅÆÇÈÇÇÅÅÄÂÅÇÈÉÊÌ…Í„ÎÏÏÏÐÒÓÒÐÍËÉÇÄÃÃÂÁÁ„ÀCÁÂÄÄÅÇÇÈÉÊÌÌÍÎÏÎÌÉÈÇÇÆÆÅÅÄÆÇÇÆÆÅÅÄÄÅÆÇÊÌÍÊÊÉÈÈ·«´¿ÁÀ¾¼¼º¹ºº¸¶´·ÁÇÈ„ÉËÍÌÌÌÉ„ÇÊ…ÎÏÐÐÏÎÍÍÊÈÇÿ½º¹¹º¿ÄÆÉËËÌÎÿ€ÿ€ÿ€“€Ÿ›œœ›˜‡…Œ“¢¢¦§©ª©§©©ªª¯²´„¶´³„´‚³…² -´´¶¶¶¸¸¹ººŠ¼»¼¼½„¾„¿À…Á¿¿ÃÃÃÅÅÁ¿¼¹¹»½ÁÂÂÁÀ¾¼º»¼¾ÁÂÁ„ÃÂÀÀ½¼º¼½ÁÃÅÆÆÈÈ…Ç…ÈÉËÉÉÈÄÄÀHÁÂÂÂÃÃÂÂÂÃÅÆÈÈÉÊËÍÍÍÎÐÐÑÑÑÒÒÒÎÑÓÒÕÒÒÒÑÑÒÒÑÏÎÍËËÍÍÐÐÐÎÌÉÇÆÇÈÉËÍÍÑÕÕÔÔÐÏÏÑ„ÒÓÓÔÔÓ„ÒÑÏÏÍËËÊÊÌÏÍÌÍËÊÌÎÎÐÑчÒÔÖÖ××ÕÔÕÕÒÏÍÊÈÅÃÂÁÀÀÀ†¿ÀÀÂÁÂÃÆÆÈÉÊËËÊÈÇÆÆÅÅÅ„Ã'ÁÀÀÃÂÁÁÂÃÃÇÉÉÉÇÃÇÇÀ²²ÃÄÀ¾¿½½»µ¸¸¶·µ¹ÆÉȇÉÈÆÆÃÃÀÁÀ¾½¹´¯­«¨¨©­²¶¹º»½À¶´²³³²¯«¤£©³¸»»¿ÀÁÂÁÀÁÁÂÄÄÆÈ„ÊÈÇ„È ÇÇÆÅÅÆÆÈÈ…ÊÌÍÍŠÌÊ…ÌÍÍÎÏЇÏ/ÐÐÏÏÏÑÑÍÊÇÅÄÅÇËÌÌÌÊÈÆÄÅÆÈÌÌÌÍÎÍÍÌËÊÇÆÄÆÇËÍÏÐÑÑÑ…ÒÑÑÒÒÒÔÔÔÓÒÏÌËËËÊ„Ì†Ï ÑÒÓÔÕÖ×ÙÙÙÚ„ÜÝÞÞÞßÜÛÛ„ÚÙÙÚÚÙØÖÙ××ÙÙÜÜÜÚ×ÕÓÒÒÓÕ×…Ù(Ø×ÖØØÙÚÚÚÛÛÛÜÜÜÚÚÙØÖÔÓÔÔÓÒÒÓÓÒÑÒÒÒÔÖ×ØÙÙˆÚ‚Û„Ü ÞÞÛÙÙÖÔÑÏÏÍ‡Ì ÊÉÊËÌÌÌÍÐÑÒ„ÔÕÔÒÒÒÑÑÑÏÏÎÍÌËË…ÌÎÎÑÓÔÔ×Ö×Ïù¹ÎÔÑÏËÆÆÅÆÄÀ½¿ÀÄÒÕÔ„ÕÔÔÔÒÒÓ„ÔÓ…ÒÓÕÖÕÔÓÒÑÏËÅÀ¾»¹¹º¾ÃÆÊÌÌÍÑ.¶´²³³³²«¤£©¯¶µ¶¹»¼½¼»¼¼½¾½¿ÁÂÂÄÂÁÁÁÂÂÁÁÁ¿¾¾¿¿Á„ƒÄÅ+ÆÇÄÅÅÅÆÂÆÈËÎËËÇÂÂÃÃÃÅÅÁ¿¼¹¹¾ÁÄÅÅÄÃÁ¿¾¾ÀÁÄÅÄ„ÇÅÄÄÁ¾¾¿ÁÄÇÉÉÉÊÊ…Ç ÊÊÌÌÌÍÎÍÌÌÈÆ…Ä ÅÅÅÃÃÂÂÂÃÅÆÈÈÉÊËÍÍÍÎÐÐÑÑÑÒÒÒÏÏÐÏ„ÎÍÍÎÎÍÌ„ÊËÌÐÐÐÎÌÉÇÆÇÈÉËÍÍÏÐÐÎÎÌÍÍÍÎÎÎÏ…Ð -ÎÎÍÌÊÈÇÈÈÈ…Ç -ÅÆÆÇÈÊËÌÍ͇΃τÐÒÒÏÍÊÉÇÃÃÂÁÀÀÀ„¿BÀÁÃÄÅÄÅÆÉÉËÍÎÎÎÌÈÇÆÆÅÅÅÃÃÅÇÄÄÄÆÅÄÄÅÇÇÊÌÍËÊÈÉÅ»¯°ÃÇÿ¼¼º¹¸¶´´³·ÅÈÇ„ÉËÍÍÌÌÊ„ÈÌ„ÐÏÏÐÏÏÍÍËÊÈÇý¼¹¸¸¸»ÀÅÈÉÊÌÏÿ€ÿ€ÿ€“€ œ›œœ˜‘†|z‡’Ÿ¤¥¦§¨©©¦§©ªª¯²³´´µ´†³²²³²²²³³´¶µ´·¸¸ºº¼¼½¾¾…¿…¾¿¿¿ÀÀˆÁ/¿¿ÃÃÅÅÅÂÀ½¹¸º¼¿ÂÂÀ¾¼º¸¼¼¿ÁÃÃÃÄÄÃÃÃÀ½¼º¼¿ÂÄÇÇÈÉÉ…ÈÊÊËÌÌËËËÊÉÅÃÂÁÁ„ÃÄÃÃÃÂÃÄÅÆÇÉÊËÍÍÍÎÐÐÑÑÑÒÒÒÎÑÓÒÕ…Ñ6ÒÒÑÏÏÍÍÍÎÏÑÑÐÏÌÊÈÇÈÉËÌÎÏÓ××ÖÔÑÏÐÑÒÒÒÓÓÕÕÖÕÕÒÓÒÑÏÏÎÍÍÌˇÍÏÑÑÒˆÓ,ÒÓÔÔÕÕÓÑÒÑÐÍËÉÇÄÂÁ¿¾¿¾¾¾¼¼¼½½¿¿¿¾ÀÃÅÇÈÉÊÊÉÈÇ…ÅÄÄÄÃÀÀÀ†ÃÅÇÉÊËÇÇŽ¶´ÀÊÆÂÀÀ¾½ºµ¶¶¶·´ºÈÉÈ„ÊËʉɅÈÆÄÃÁÀÀÀ½»º´¯¬ª¨§¨¬°´¸ºº½À ²²³³¯¨¦¡›™¤±¹½½¾ÀÁÁÁ¿ÀÁÂÂÄÅÇÈÈÉÈ†Ç†Æ ÇÇÈÊÉÈÊÊËÌÍ„ÌÍ…Î…ÍÎÎÏÏÏ…Ð2ÏÏÏÐÐÏÏÑÑÑÍÌÈÅÃÄÆÉÌÌÌËÉÇÅÆÆÉÌÍÍÎÏÏÎÌÌËÇÆÄÆÉÍÏÑÑÒÓÓ…Ô ÓÔÕÕÖÔÖÕÔÔÏÍ„ÌÍÎÎÎÐ…Ï ÑÑÒÒÕÖ×ÙÙÙÚ„Ü ÝÞÞÞßÝÛÛÚ…Ù4ÚÚÙØØÙÙÙÚÛÜÜÜÛØÖÔÒÓÕ×ØÚÛÚÙÙÙØ×ØÙÙÚÚÚÛÜÝÝÞÞÝÛÙØÖÔÔÕÕÕ…ÔÓÔÖ×ÙˆÛ)ÜÛÛÛÚÚÚÛÜÜÛÜÛÚØ×ÕÒÐÎÍËÊËÊÉÉÈÈÇÇÇÉÉÉÈËÍÏÑÒ…Ô1ÒÑÑÒÑÑÑÐÏÌÊÊËÍÎÌÌÎÎÏÑÔÔÖØÙÔź½ÈÖ×ÓÑÌÆÅÄÆÿ½¾¿ÅÔÕÔ„ÖÕÔÔÓÓÓ„ÕÓ…ÒÓÔÕÔÓÓÒÐÍËÅÀ½º¹¸¹¼ÁÄÈËËÍÑ!²²³³¯©§ ™—¤®¸¸¸¹»¼¼¼º»¼½½½¾ÀÁÁÂÁÀ„Á À¿¿À¿¿¿ÀÁ„ÂÃÄÄ„ÅÇÈÈ…É…È<ÉÉÊÊÊÈÉËÍÎËËÇÂÂÃÃÅÅÅÂÀ½¹¸½¿ÂÄÅÄÃÁ¿¾¾ÀÂÄÇÆÇÈÈÇÆÆÄÁ¾¾¿ÂÆÈÊÊËÌÌ…È3ÍÎÏÏÏÎÏÏÎÍÉÆÅÄÄÅÆÇÇÇÄÃÃÃÂÃÄÅÆÇÉÊËÍÍÍÎÐÐÑÑÑÒÒÒÐÐÐÏÎÎ„Í ÎÎÎÌÌÌÊËÍÍÑÑÐÏÌÊÈÇÈÉËÌÎÏÐÑÑÑÏÍÍÍ„ÎÏÐÑÒÒÒÑÏÍÌÊÈÈÉÉɇÈÉÊÌÎÎÏÏφЅÏЄÏÍËÊÈÅÂÂÁ¿¾¿¾¾¾¼¼¾ÁÁ„ ÃÆÉÊÌÍÎÎÊÈÇ…Å+ÄÄÅÆÄÃÄÆÇÆÆÇÇÉÊÍÎÍËÌÈ»±²¿ÊÉÅÃÀ¼»¹¸¶µ´´±¸ÆÈÈ„ÊÌÎÍÌÌÊ„É̄ЄÏÍÍÌËÉÇÇý»¹¸¶¸»¿ÃÇÉÉÌÏÿ€ÿ€ÿ€“€+›››–‹~†ŠŒ“š¡¢¡¥¦¨©¨§©©ªª°²³³³´³³³´³³³²²´³³„´ ¶¶¶··¸¹¹¼¼¾¾†¿Á¿¿¿¾¿„Á7ÂÂÂÁÂÁÁÁ¿¿ÃÃÃÅž¹¶·¹¼À¾¼»¸·¼½¿ÃÃÃÅÆÅÅÃÃÁ½¼»½ÀÄÆÈÉÉËË…É ËËËÍÍËËËÊÈÇÄ„ÃÄ„ÅÄ„ÃOÄÅÅÅÈÈÊËÍÍÍÎÏÐÐÐÑÑÑÍÐÒÑÔÏÐÑÑÑÒÒÒÑÏÍÍÍÎÎÑÑÑÏÍËÈÈÈÊÍÎÐÑÔ×××ÕÒÑÑÒÓÓÓÔÕÖ××Ø×ÔÓÔÒÐÏψÎÏÏÐÑÒÒÓÔÔÓÓÓÔÓÒ„Ñ(ÒÒÑÐÎÍÍÌÊÈÆÃÁ¿¾¼½¼¼¼º¹¹º¼¼½½½¿ÃÅÇÈÉÉÉÊÉÈ…ÇÆÆÅÃÀÀÂÄ„ÃÅÅÈÊËÌÉƽ³·ÀÍÊÆÅÁÁ¾¼¹³µ´³´´¼ÉÉɄʃˈɅÈÆÄÁÁ¿À¾½»º´¯¬¨§¦¦©¬±¶¸º½¿+²²²®¢–ž¥«¯±¹»»º¾¿ÁÁÁÀÁÁÂÄÄÅÇÇÇÈÇÇÇÈÇÇÇÆÆÈÇÇ„ÈÊÊÊÉÉÊ„Ì‚Í‰Ï ÎÍÏÏÏÐÑÒÒÑЄÏ/ÐÐÏÏÏÑÑÏÍÊÅÃÂÃÆÊÌÍÌÊÇÆÆÇÉÌÍÎÏÐÏÏÎÍËÇÆÅÇËÎÑÒÓÔÔÔ…ÕÖÖÖ××ÔÖÔÔÒÑÏÍÌÍ΄ÏÑÐ„Ï ÐÑÑÑÔÔÖ×ÙÙÙÚÛ†ÜÞÜÚÙÙØ„Ù3ÚÛÚÙØÙÙÙÚÚÜÜÜÛÙ×ÔÔÔÖÙÚÜÜÜÛÛÙÙØÙÙÚÛÛÛÜÞßààáàÜÙÙ×ÖÔÖׄÖ×Ö×ØÙÜÜÞÞÝÜÜÛÛÜÜÛÚ„Ù(ÚÚÛÜÚÙÙØÖÔÒÏÍÌÉÈÉÈÇÇÆÆÄÄÆÆÇÇÇÉÌÏÐÒÓÔÔÕÕÓ‡ÒÐÍÊÊÌ…ÎÏÏÒÔÔ×ÚÚ̼ºÉÖÖ××ÒÍÆÄÃÄÀ¼¼»¿ÈÔÕÕ„ÖÕ…Ô„ÕÓ…Ò ÓÔÔÓÒÒÑÏÍËÅÀ¼„¹¼ÁÃÇÉËÍÐ.²²²®¢–ž£¨«±µºµ´¹¹¼¼¼»¼¼½¾¾¾ÀÁÁÂÁÁÁÂÁÁÀ¿¿ÂÁÁÁÂÁ†ÂÄÄÄÅÅÈȆÊ.ËÊÊÉÈÌÎÎÎÏËÍÎÑÓËËÇÂÂÃÃÃÅž¹¶»½ÀÃÅÄÃÁ¿½¿ÁÂÆÇÇ„ÉÇÇÄÁ¾¾ÁÄÈÉÌÌÍÎÎ…ÉÏÏÏÐÐÎÏÎÎÌÊÈÇÆÇÇÈÉÉÉÅÄ„ÃÄÅÅÅÈÈÊËÍÍÍÎÏÐÐÐÑÑÑÎÍÎΆÍ!ÎÏÎÎÍÌÊÊÍÍÑÑÑÏÍËÈÈÈÊÍÎÐÑÒÓÓÑÐÍÍÍ΄ÐÒÓÔÔÕÔÑÍÍËÊÈÊË„ÊËÊËÌÍÍÏŠÐ-ÎÎÍÍÍÎÎÎÍÍÌËÊÈÆÄÂÀ¿¾¼½¼¼¼º¹»¾¾ÀÁÁÁÂÆÉÊÌÌÍÍËÉÈ…ÇÆÆÇÇÄÄÅÈ„ÇÉÉËÎÎÎÍÌ¿²²¿ËÊÈÉÅÁ¼º¹¶µ²²°±»ÇÈÉ„ÊÌÎÎÍÍË„ÉÌ…ÐÏÏÍÍËËÊÉÇÇý»¸¶µµ¹½ÁÅÇÉÌÎÿ€ÿ€ÿ€“€œ˜šš’ˆ’˜™ššœ ¢¤¥¦§¨§©©ª««²³³´³„´µ´´³³³´³³³´µ¶··¶¶··¹¹¼¾¾¿À…¿ÁÁÁ¿¿…Á7ÄÄÂÂÂÁÁÁ¿¿ÂÂÂÃÿº¶µ¶¹¾À¼º¹·´¼½ÀÃÃÄÅÆÆÆÅÃÁ½¼»¾ÁÅÈÉÉËËË…ÊÍÍËËËÌÌÌËÊÈÄÃÃÃÄ„Æ‚Å…ÃBÄÄÅÇÈÈÊËËÌÍÍÎÎÎÏÏÐÌÎÐÏÒÏÏÑÑÒÒÒÓÑÑÍÌÌÍÎÐÐÐÎÍÌÊÈÉÌÍÏÑÒÕØØ×ÖÓÑÑÒÓÔÕÖׄÙ1ØÔÓÔÒÐÐÏÎÎÏÏÎÎÎÏÐÏÍÎÏÏÑÔÓÓÒÒÓÒÑÏÎÍÍÍÎÍÌÊÈÉÊÊÈÅÃÀ¿„¼»º¹¸¸¹º»¼¼¼¿ÃÅÇÈÉÉÉÊËÉÈÈÉ„È(ÇÄÁÀÃÅÅÃÃÅÅÆÈÊËÍÈÀ²´ÃÈÎËÇÆþºº´²­ª­´ÁÇɈËÊÉÉŠÈÆÄÁÀ¾À¾½ºº´­«¨¥£¢¦©¯µ·¹»¾´°²±© ª³¹º·»º»½½¿ÀÁÀÁÁÂÄÄÅÇÇÈÇ„ÈÉÈÈÇÇÇÈÇÇÇÈÉÊËËÊÈÉÊËÌÌÌÍΆÏÑÐ…ÏÑÑÑÒÒÒ…ÏÐÐÎ΄Ï%ÎËÅÁ¿ÀÃÈÊÎÍËÉÇÆÇÊÌÎÏÏÑÑÐÏÎÌÇÆÅÈÌÐÒÓÔÔ‡Ö××ÖÖÕÖÖÖÕÔÑÏÎÍÍÏÐÑÑÐÑÑ…Ï8ÐÑÑÒÓÔÖ××ØÙÙÚÚÚÛÛÜÜÚÙØ××ØÙÙÚÚÛÛÚÙÙØØÙÚÜÜÜÚÙØÖÔÕ×ÙÛÝÞÜÛÛÛ„ÙÚÛÜÝÞàáááâáÝÚÙׄÖ)×ØØÙÚÚÛÛÝÞßáàÞÜÛÛÚÛÛÚÙØØÙÙÙÚÛÜÚÙÚØÖÓÑÎÌÊÈ„ÇDÆÄÃÃÃÄÅÆÆÆÉÍÏÑÑÓÔÓÕ×ÕÔÔÕÔÔÔÓÒÏËËÎÏÏÎÎÏÏÑÒÔÔØÙÓÁ»ÇÑÖ×Ø×ÔÎÆÃÄžµ³´¿ÌÓÕ…×Ö‰ÔÓ„ÑÒÓÔÔÒÒÒÑÏÍËž»¹··¶¹½ÁÆÈÊÌÐ;´°²±©¨¯³µ·¹¹¶¸¸¹»¼»¼¼½¿¿¿ÀÁÁÁÂÁÁÂÃÂÂÁÁÀÁÁÀÁÁÂÃÄÄÃÂÂÃÄÄÅÇÈɆÊËËËÊÊÎÎÎÏÏÎÏÐÓÓËËÇ…ÂÃÿº¶¸º½ÁÄÄÃÁ¿½ÀÁÃÆÇÈ„ÉÈÇÄÁ¾¾ÁÄÈËÌÍÎÏυʂЇÏÎÊÈÇÇÇÈ„É‚Å…ÃÄÄÅÇÈÈÊËËÌÍÍÎÎÎÏÏЄÍ5ËËÍÍÍÎÎÏÐÎÍÊÊÊËÍÐÐÐÎÍÌÊÈÉÌÍÏÑÒÒÓÓÓÑÎÍÎÎÐÐÑÒÔÕÖÕÖÕÑÎÍË„Ê ËÌÌÌÍÍÍÎÏÏÐÑÑ„ÐÎÏÐÎÍÌ„Ë ÍÍÍÌÊÊÉÈÆÂÁ¿¿„¼»º¹¸º½¾¾¿ÀÀÂÆÉÊÊÌÍÌÌËÉÈÈÉ„È)ÉÈÅÄÇÈÉÇÇÉÉÉËÎÎÏÌÅ´²¾ÇÌËËÉƼ¹¹¸²¬¨©±¿ÅÈÊ„ËÍÎÎÎÍÊ„ÈË„ÎÏÏÏÍËÊËÊÉÅÇý¹·µ³³¶º¾ÄÆÈËÍÿ€ÿ€ÿ€“€%››œž ¡¡¢£¤¥¥¥¦¨©©ªª««¬²³´´¶´³³³´¶¶´ ¶¶·¸¸»»¼½„¾ -¿¿¿ÁÁÀ¿ÁÁÁ„ÂÄ„Á¿¿ÂÂÃÅÅÁ¿¾¸³±±´·¹¾¿¿»¹½½ÀÄÆÇ„ÉÈÈÆÀ¾¿ÂÆÉÊÌÌÍÍÍÌÍ͇ÎÏÎÌËËÆÅÄÄÅÇÈÉÉÊÈÈÈÇÆ…Ä -ÆÇÈÉÉÉËÍÍÍ…Î/ÍÌËÌÍÌÍÍÎÎÎÏÎÍËÍËËËÌÍÎÎÎÍËËËÌÍÎÐÑÒÔÖÖÕÓÒÒÑÒÓÔÕׄÙJÚØÕÑÎÌÊÈÈÉËÍÎÏÏÐÑÒÒÒÓÓÒÔÖÕÔÓÒÏÎÌÌÌËÍÍÍÌËÌÍÌÊÈÈÆÃÂÀ¾¼»¼º¹¸¸¸¹ºº»½½¿ÃÅÆÇÉÈÉË…Ê„É.ÈÇÆÆÅÆÆÆÅÄÄÆÈËËËǹ®»ËÌÌÇÆÆÇľºµµ¢š›«»ÈÉÆÉÍÌËËË…ÊËÉÉÈ…ÇÈÈÆÃÁ¿¿¾½»¹²«¦£¢  £¦«³¶·¹¼²²³´µ´¶·¸¹ºº»»»¾¿…ÁÂÃÄÆÇÈÈÊÈÇÇÇÈÊÊÈÉÊËÊËËÌ„ÍÎÏÏÏÐÏÏÑÑÑÒÒÑÒÒÒÑÑ„Ï2ÍÏÏÑÑÒÐÎÉÄÀÀÂÆÈÈÉÉÅÃÇÇÊÎÑÏÑÒÒÒÓÒÐËÈÉÌÐÓÕÖÖ××Ø×××Ø؆ÙØÖÕÔÑÏÏÏÐÑÒÓÔÔÓÔÓÓÒ„Ñ ÐÒÒÔÕÕÕ×ÙÙÙ…Ú!ÙØ×ØÙØÙÙÚÚÚÛÚÙ×Ù×××ØÙÚÚÚÙ×××ØÙÚÜÝ…ÞWÜÛÛÚÛÛÜÝßáããââáÝÛÚØÖÔÔÕ×ÙÚÚÛÜÜÞÞÞßßÞÝÝÜÚÚÛÛÙØØ××ÙÙÙØ×ØÙ×ÖÔÓÒÏÍÌÊÇÇÆÄÃÂÂÂÃÄÄÅÇÇÊÍÏÑÒÕÔÕ×…Ö2ÕÕÔÔÒÑÑÐÏÐÑÐÏÏÏÐÓÕÕÕÖÍÃÌÔÔ×ÙØÖÒÐÊÆÅdz¦£²ÄÐÕ×Ö×ÖÖÖÕ‡ÔÓ҅тЄÑÐÏÎÌÌÆÀº¸¶´´·º¾ÄÇÈÊÎ"´´¶¶·´¶·¸¹ºº»»»¹º¼¼¼ÁÁÂÃÄ¿ÁÁÂÂÂÁÁÁ“ÂMÄÄÅÅÆÇÈÈÈÉÉÊÊËËÊÊËËËÍÍÌÍÎÍËÏÎËÆÆÂÂÃÅÅÄÂÁ»¶¸¸º½ÀÁ¿½ÀÁÃÈÉÅÇÈÈÈËËÉÄÁÂÅÉÌÎÏÏÐÐÐ…Ô†ÒÑÏÏÎÉ„È -ÊËÌÍÎÈÈÈÇÆ…ÄÆÇÈÉÉÉˈÍ̆ÊÌ…Í ËÊËÊÉÉÊÌÍÍÍË„Ê`ÌÎÐÑÒÔÕÕÓÒÐÏÎÏÏÓÓÕÕÔÔÕÖÕÑÎÍÊÈÇÇÈÉÊÍÍÍÎÏÐÐÐÒÒÐÐÑÐÏÎÎÍÌÊÊËËÍÍÍÌËÌÍÌÊÈÈÆÃÂÀ¾¼»½¾½»»»½¾½¾ÀÁÃÆÉÇÇÉÈÉË„ÊÉÈÉËÍËʇÉ$ÈÈÉËÏÏÏÎÁ³½ÉËËËÊÉÇľº¸º¦šš§·ÅÇÈËÐÏÏχÎÍÌÌ̇ÍÌËÍÎÎÌËËÆÀº¸´±±³·»ÂÆÆÈÌÿ€ÿ€ÿ€“€ žž  ¡¡£¤£„¥¦§©ªª««­®®²³´´¶´³³³´¶´´´³‹´¶··¸¹º»»¼¼¼¾¾¾¿ÁÁÀ¿†ÁƒÂ„Á„¿0ÀÁÁÁ¿¾¹´±±³·¹»¼»¹·¼½ÀÃÅÆÇÈÉÉËËÈÃÀÁÄÈËÍÎÎÎÏÐÎÐÐÐÑ…Ð#ÑÎÍËËÆÆÈÈÉÉËËÌÍÊËÊÊÉÉÉÈÈÈÆÇÈÈÉÉËÍÍÍ…Î|ÍÌËÌÍÌÍÍÎÎÎÏÎÍËËÊÉÊÊÍÎÎÍÌËËËÌÎÐÑÓÔÕÖÖÖÕÓÔÔÔÕÖ×ÙÛÚÚÙÙ×ÔÏËÊÈÈÈÉÊÍÍÏÑÑÒÓÓÒÓÒÑÑÒÑÑÏÎÍÌÊÊËËÍÍÍÌËÍÍÌÊÉÈÆÄÁ¿¾¼»¼¼º¸¸¹¹º¹º¼¼¾ÁÃÅÇÈÈɆʄɃȅÆ!ÄÃÃÃÇÊËÌǽ»ÄÍÌËÇÆÇÈľ»¶°™‘–±ÃÊÊÇÉŒËɆÈÉÈÈÂÁÀÀÀ¾»¹³«¦£¡ŸŸ¢£ª±´µ·»(³µ¶¶··¹¹º»º»»»½¾ÀÁÂÂÃÃÄÅÅÆÇÈÈÊÈÇÇÇÈÊÈÈÈÇŠÈ ÇÈÉÊÊÈÉÊË…Ì͇τÑÒÒÑÑ…Ï2ÐÐÑÒÒÒÐÎÊÅÀÀÂÆÈËÌËÈÆÆÇÊÎÏÒÒÔÕÕÔÔÓÍËÌÎÒÕ×ØÙÙÙÚÙÚÚÚÛ…Ú#ÛÙ×ÖÔÑÑÑÒÔÔÔÖÖ×Ö×ÖÖÕÕÕÔÔÔÒÒÔÔÕÕ×ÙÙÙ…Ú'ÙØ×ØÙØÙÙÚÚÚÛÚÙ××ÖÕÖÖÙÚÚÙØ×××ØÚÜÝßàßÞÞÞÝ„ÜÞÞàáãäãââàÜÙ×ÖÔÒÓÕÖÙÙÛÜÝÞß„Þ3ÝÛÚÙÙØØÙØÖÖ××ÙÙÙØ×ÙÙØÖÕÔÒÐÍÌÉÇÇÆÆÄÂÂÃÃÄÃÄÆÆÈÌÎÐÒÔÔÕ†ÖÕÕÔÔÓ†Ñ"ÐÏÎÎÎÑÔÔÖÖÑÏÕ×Ô×ÙØÖÔÐÊÇŪž¶ËÓÖÙ׊ÖÔÔÓ†ÒÑÑÑÒÓÒÑÑÏÌÌÆÀº·µ³³¶¹¼ÂÄÆÈÌ"¶···¹·¹¹º»º»»»½¹»¼½½ÃÃÄÅÅ¿ÁÁÂÂÂÁÁÁ…ÂÁŠÂÁÂÂÃÄÃÄ…ÅÇÇÈÊËËÊʆË;ÍÍÌËÎÎËÆÆÂÂÃÅÅÄÂÁ¼¸¸¸º½ÀÂÿ½ÀÁÃÇÉÆÇÈÉÉÎÎËÆÄÄÈÌÏÐÑÒÒÓÔÕ××Ø؆ÔÒÐÏÎÉÉÊËÍÍÎÏÏÐÊËÊÊÉÉÉÈÈÈÆÇÈÈÉÉˈÍ̆ÊÌ…ÍËÊÊ„ÈËÍÍÌÊÊÉÊÊÍÐÑÓÔ„ÕÓ„ÐQÒÕÕ××ÕÔÕÕÔÑÌÊÈÇÅÆÈÈÊÌÎÏÐÐÒÑÐÑÐÐÎÎÎÍÍÌÌÊÈÈÊËÍÍÍÌËÍÍÌÊÉÈÆÄÁ¿¾¼»½¾½»»¼½¾½¾¾ÀÁÄÇÆÇÈÈÉ…ÊÉÈÉËÍËÊÊ…É!ÈÇÇÇËÎÎÑÎÆÁÇÌËËËÊÊÈľ»¸µ‘“­ÀÉÊËÍŠÏÎÎÌÌ΄ÐÏÎÎÍÍÎÏÏÍËËÆÀº·³°±³µºÁÃÄÆÊÿ€ÿ€ÿ€“€ œžž ¡¢¤¥¦¦„¥¤¦©©©­®®°°²³³´¶´³³³´´´³´´µ··¸¹¹…»?¼½¿¿À¿¿¿ÀÀÁÁÁÂÂÁÁÀÁÁÁÀ¿¿ÀÁÁÁ¿¾¹µ²±²·º»¼¼¹·¼½¿ÃÅÅÆÇÈÇÊÊÈ¿ÀÃÇÉÌÍ…ÎÏÏÐÑ…Ð#ÑÏÍËÊÇÈÉÊÌÌÍÎÏÏÍÏÎÍÌÌËÊÉÈÇÇÈÈÈÉËÍÍÍ…Î(ÍÌËÌÍÌÍÍÎÎÎÏÎÍËÊÈÈÈÉÌÍÍÍËËÊËÍÏÑÓÔÕÕÖÖÖÕÕ„Ö.×ÙÚÛÛÚÙÙÖÒÍÊÈÇÆÇÈÊËÍÏÑÒÓÔÓÒÒÑÐÏÎÎÍÌËËÉÈÉÊËÍÍÍÌ„ÍËËÉÈÅÂÀ¾„¼º„¹º¹¹º»½ÀÃÄÇÈÇÈÊŠÉ„È'ÇÆÆÃÃÂÃÄÈÊÌÇÀÃÇÊÉÊÊÉÉÈÄ¿¼·«•šºÈÊÉÇÈËË̆ÍÌËˈÉÆÄÂÁÁÁÀ¿½º´­¨£¡Ÿž¡£¨°³´µº ·¸¹¹º¹º»¼½¼„½¾ÁÃ„Ä ÆÇÇÆÇÈÈÉÈÇÇÇ„ÈÇÉÉÇÈÈÊÊÊËËÌÌÎÏÏÏÎÏÏÏÐÐÑÑÒÑÐ…Ï‚Ñ„Ò,ÐÏËÆÁÀÁÆÉÌÍÍÊÇÆÇÉÍÏÓÕÖÖÖÕÕÓÍËËÎÒÕ×ØØØÙÙØÙÙÚÛ…Ú ÜÙØÕÔÑÒÓÕÖÖׄÙÚÚÙØ××ÖÕÔÒÒÔÔÔÕ×ÙÙÙ…Ú'ÙØ×ØÙØÙÙÚÚÚÛÚÙ×ÖÔÔÔÕØÙÙØ××Ö×ÙÛÜßàáßÞßßÝ„Þ/ßàáãäåäâáßÛ×ÖÓÒÒÓÔÖ×ÙÛÜÞßßßÞÞÝÛÙÙÙ×ÖÖ×ÕÔÕÖ×ÙÙÙØ„Ù ××ÕÓÑÎÌÊÇÇÇÆÄ„ÃÄÃÃÄÅÇËÌÏÒÔÒÔÖ‡Õ.ÔÔÓÒÒÒÑÑÑÐÎÌÌÌÏÒÔ××Ô×ØØØÙÙØÖÔÐËÇǾ¥œ¢ÀÐÓÔØÖÕÖÖ†×ÖÖÔÔÓÓ„ÔÓÓÓÔÔÓÒÑÐÎÌÈ»·µ³²µ¸»ÀÃÄÆË ·¸¹¹º¹º»¼½¼…½¿ÁÂÂÄÄÆÇÇÃÃÄÅÆÂÁÁÁÂÅÅćÅÀ¿ÀÁÂÂÂÃÃ…ÅHÆÆÉÊÊÊÉÊÊÊËËËÌÍËËÎÎËÇÇÃÃÄÅÅÄÂÁ½¸¸¸¹½ÁÃÄÃÀ¾ÀÁÂÆÉÆÈÉÉÉÌÌÉÄÁÂÅÈËÍÐÑÑÒÒÕÖÖØØ…Ô ÕÓÐÏÎÊËÌÎÏÏÐÒÒÓÍÏÎÍÌÌËÊÉÈÇÇÈÈÈÉˈÍ̆ÊÌ…ÍËÊÈÇÇÇÈÊËËËÊÉÈÊËÎÑÓÔ…Õ4ÓÓÒÒÒÓ××ØØÖÕÕÕÓÏËÈÆÅÄÆÇÈÊËÎÏÐÒÒÑÐÐÐÎÍËËÊÉÉÉÈÇÈÉËÍÍÍÌ„ÍËËÉÈÅÂÀ¾¼¼¾¾¾½½¼½¾»¼¾¾ÀÄÆÆÇÈÇÈÊ„ÉÈÈÉËÍÌÌÌËÊÊÉÉÇÆÅÆÈÌÎÓÑÌ„ËÌÌËÊÈÄ¿¼º°˜˜¸ÈÊËÌÍÏÏφÐÑÒÑÐÐÒ„ÔÒÏÎÎÍÏÑÐÎÌÌÈ»·µ³²µ¸º¾ÁÃÅÉÿ€ÿ€ÿ€“€'š››œ££¥¦§§¦¦¦¥¢£¦¨¨®®¯±±²³³´µ´³³³´´³³³‹²³³´µ¶¸¹¹„» ¼¼¾¾¿¿¿¾¾¾¿¿¿…Á¿¿ÁÁÁ…À#Á¿¾º·³°±·»»½¼¹·¼¼¾ÃÃÂÄÅÆÆÈÈÆÁ½¾ÁÃÈÉ„ËÍËÍÎÏІÑÎËÊÈÈÈÉËÍÎÎÐÑÑÐÑÐÏÎÍÌÊɆÈÉËÍÍÍ…Î&ÍÌËÌÍÌÍÍÎÎÎÏÎÍËÊÈÈÈÉËÌÍËÊÊÊËÍÏÑÒÔÕÖÖ×׆Ö*ØÙÛÛÚÙØ×ÕÑÌÈÇÆÆÇÈÈËÍÏÑÑÒÓÒÑÑÐÎÍÍÌËÊÊÉÈÈÉËËˆÍ ÌËËÈÆÃÂÀ¾½½¼»„¹ º·¸º¼½ÀÃÄÆÇÇÈÉ(ÈÈÈÆÆÃÂÀÀÂÇÉÌÉÃÄÇÈÆÉÍÎÌÉÅ¿¼¶¢ŸÃÊÉÉÆÇËˈÍËËʆÉÈÆÄÂÁÁÂÂÀ¾¼·²©£¢ Ÿ¢£§¯²³µ¹·¹ºº»ºº¼†¾½ÁÂÅÇÈÄÅÇÇÇÆÇÇÈÉÈÇÇÇÈÈÇÇÇ‹ÆÅÆÇÇÈÇÈÈ„Ê -ÌÌÌÍÏÏÎÍÍÍ„ÏÑÑІφÒ,ÐÏËÇÂÀÀÆÊÍÏÎÌÊÆÆÈÌÎÓÔÖ××ÔÔÒÌÉÉÌÏÓÕÔÕÖÖ×Ö×ØÙÚ†ÛÙÖÓÒÑÒÔÕ×ØÙÚÛÛÜÜÜÛÚÙØÖÕ†ÔÕ×ÙÙÙ…Ú'ÙØ×ØÙØÙÙÚÚÚÛÚÙ×ÖÔÔÔÕ×ØÙ×ÖÖÖ×ÙÛÜÞàáàÞààß„Þ ßàâããäãáàÞÚÖÔ„ÒÔÔ×ÙÛÜÝÞßÝÜÜÜÚÙÙØ×ÖÖÕÔÔÕ×׈٠Ø××ÔÒÏÍÌÉÉÈÆÅ„Ã ÄÂÂÄÆÇÊÍÏÒÒÒÔˆÕ…Ô+ÒÒÒÑÐÌÌÊËÌÐÔÖÙÖ×Ö×ÙÚÙÖÖÕÑËÇųž›§ÉÒÒÓÕÔÔÕ××Ø…×ÖÖÔÔÓ„ÒÓÕ×ÕÕÔÓÓÑÏÏËŽ¸¶´³µ·ºÀÃÄÆÊ·¹ºº»ºº¼†¾½½ÀÂÃÄÄÅÇÇÇÆÇÇÈÉÂÁÁÁÂÈÇÇdžƅ¿¾¿ÀÁÂÂÃÆŠÇÈÊÊÉÈÈÈÊÊÊ…ËÌÌËÇÇ…ÅĽ¹º··½ÁÄÄÄÂÀ¾ÀÂÆÇÆÇ…ÈÆÁ½¾ÁÃÈÉÎÏÏÏÐÒÓÕÖ׆ÔÒÏÍÌÊËÍÏÐÑÒÔÔÔÐÑÐÏÎÍÌÊɆÈÉˈÍ̆ÊÌ…ÍËÊÈÇÇÇÈÉÊÊÊÈÈÈÊËÎÑÒÔ†ÕÔ„Ó×ØØ×ÕÔÕÕÒÎÉÇÅÄÄÅÇÇÊÊÎÏÐÐÒÑÏÏÍÍ„ÊÈÈÈÇÇÈÊˈÍÌËËÈÆÃÂÀ¾½¾À¾½½¼½½»»½¾ÁÄÇÆÆÇÇÈ…ÉÈÈÉË„Í(ÌÌËÉÉÆÅÄÄÅÊÍÓÖÒÏÎÌËÍÍËËÉÅ¿¼¸¦ÁÌËÌÌÌÎχÐÓÖÖÔÔÖ„ØÔÐÐÏÏÐÑÑÐÌÎËŽ¸¶´³µ·¹¾ÀÂÄÈÿ€ÿ€ÿ€“€&šš›œœ¢£¥¦¦¨§§¦¦¢¤§©©­®®¯°²³³´µ´³³³´³³³Œ²³³³´´¹¹º»¼¼¼½¾¾¾¿¿…¾‚¿…Á7¿¿ÁÁÁÀÀ¿¿¿Á¿¿¼·³°±·»»¼¼¸¶¼¼¾ÂÃÀÁÂÃÂÈÈÆÁ¾½ÁÄÇÉËËËÌÌËÍÎÐÐ…Ñ#ÐÍÊÈÆÈÈÈÊËÎÎÐÑÑÐÑÑÏÎÏÍÌÊÊÈÈÇÇÇÉËÍÍÍ…ÎVÍÌËÌÍÌÍÍÎÎÎÏÎÍËËÊÉÉÊÊËËËÊÉÊËÎÏÐÒÔÔÕÖ×××ÖÖÕÖÖ×ÙÙÚÙØØ×ÕÐËÈÈÇÇÈÈÈÊÌÎÏÐÑÒÑÑÐÎÍÊÉÈÇÇÉÊÉÉÊËË…Í ÎÎÍÍÍËÉÇÅÄ¿¿¾¼»ºº¹¹º¶·º¼¾ÁÃÃÆÇƇȄÉ.ÊËÉÉÉÈÆÄÃÀÀ¿ÀÄÉËÈÅÄÉÊÇÈÎÎÍÉÆÀ¼´›Š“¥ÉËËËÇÇËËÍÎÍ„ÌÍÌˈÉÈÅÄÂÀÀÂÂÀ¾½¹³¬¦£¢¢¢¤©°³´µ¹··¹„º!¼¾¾À¾¾¾½ÀÁÅÇÇÄÄÆÇÇÆÇÇÈÉÈÇÇÇÈÇÇÇÆÆŠÅ ÄÅÆÇÇÈÈÉÊ…ÌÍÍÎÏ…ÍÎÏÏÑÑЄÏ+ÐÑÔÔÓÓÓÒÐÐÌÇÂÀÀÆÊÏÐÐÌËÆÆÈÌÎÒÔÕÕÕÔÔÒÍÊÉÌÐÓÕÔ…Ö×ÙÚÚ…Û#Ú×ÔÒÐÑÒÒÔÕØÙÚÛÛÜÜÜÛÚÛÙØÖÖÔÔÒÒÒÕ×ÙÙÙ…Ú'ÙØ×ØÙØÙÙÚÚÚÛÚÙ××ÖÕÕÖÖ×××ÖÕÖ×ÙÛÜÞßàßÞààà„ÞßàáââãâáàÝØÕÔÓ„ÒÔÖØÚÛÜÜÞÝÜÜÚÙÙÚÙÙØ×ÖÕÕÖ××…Ù ÚÚÙÙÙ×ÕÒÑÐÍËËÉÆÅÄÄÃÃÄÁÁÄÆÈËÎÏÒÒÒ‡Ô‚Õ†Ô ÓÒÑÏÌËÊÉËÏÔÕ„ØÙÚÚØ×ÖÕÑËÇ­›Ÿ®ÏÔÓÕ×ÓÔÕ×ØׇÖÔÔÒ„ÑÔ„×ÕÓÓÑÏÐÎÇÀº·µ³µ¶ºÀÄÄÆÊ··¹„º!¼¾¾À¾¾¾½ÀÁÅÇÇÄÄÆÇÇÆÇÇÈÉÂÁÁÁÂÇÇÇÆƅŇ¾¿ÁÁÃÃÄ„ÅÇÇÈÈÉÊÉ„ÈÉÊ…ËÌÌËÈÉ…Å$ľºº··½ÁÄÅÄÂÀ¾¿ÁÅÇÅÆÈÈÈÇÇÄ¿¼¼¿ÂÆÈ΄ÏÒÓÕ×Ø…Ô ÓÐÎËÉÊËÌÎÏÑÒÔÔÔÐÑÑÏÎÏÍÌÊÊÈÈÇÇÇÉˈÍ̆ÊÌ…ÍËÊÉ…ÈÊÊÉÈÈÈÊÌÎÐÒÔÔÔ„ÕÔÒÒÒÓ××ØÖÕÓÕÔÑÌÈÇÆ„ÅÇÈÊÌÍÎÏÐÐÏÎÍËËÊÊʆÈÊË…Í ÎÎÍÍÍËÉÇÅÄ¿¿ÀÀ¾¾¾¼½½ºº¼¿ÁÄÇÅÆÇƈÈÉËÍÎÎÍÍÌËÉÈÆÄÃÂÄÈÍÓÖÕÐÐ΄ÍËÉÆÀ¼¶ŸŽ“¤ÈÌÌÎÎÌÎÏÐÑЄÏÓÖÖÔÔÕ„×ÔÐÐÐÏÐÒÑÐÎÎÎÇÀº¹¸·¸º»¾ÂÃÅÉÿ€ÿ€ÿ€“€ \ No newline at end of file diff --git a/components/vampireimaging/Demos/Data/Tigers.jng b/components/vampireimaging/Demos/Data/Tigers.jng deleted file mode 100644 index 2269df5..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.jng and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.jp2 b/components/vampireimaging/Demos/Data/Tigers.jp2 deleted file mode 100644 index c840f36..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.jp2 and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.jpg b/components/vampireimaging/Demos/Data/Tigers.jpg deleted file mode 100644 index 5f89150..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.jpg and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.mng b/components/vampireimaging/Demos/Data/Tigers.mng deleted file mode 100644 index c70eac4..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.mng and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.pam b/components/vampireimaging/Demos/Data/Tigers.pam deleted file mode 100644 index 126b6bb..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.pam and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.pbm b/components/vampireimaging/Demos/Data/Tigers.pbm deleted file mode 100644 index bebca0f..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.pbm and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.pcx b/components/vampireimaging/Demos/Data/Tigers.pcx deleted file mode 100644 index 305be05..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.pcx and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.pfm b/components/vampireimaging/Demos/Data/Tigers.pfm deleted file mode 100644 index 8fb44a6..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.pfm and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.pgm b/components/vampireimaging/Demos/Data/Tigers.pgm deleted file mode 100644 index 54d6c73..0000000 --- a/components/vampireimaging/Demos/Data/Tigers.pgm +++ /dev/null @@ -1,68 +0,0 @@ -P5 -257 -189 -255 -ÏÏÒ×ÙÛÛÝÞàáÝÖÑÑÓÔ×ÚÚÚÙÝßåìñððïòõ÷ùüúüýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþÿÿÿÿÿÿÿýü÷ôõõúþÿÿýüøùúþýüûúùø÷óòðîìêçèÎÎÒ×ÖÙÛßßßàÜÕÑÏÑÓÖØÙØØÛÝâêððïïðô÷ùûúüýýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþüùõóöüÿÿÿþûøùùüýýüûúøööôñðîìêèÏÎÓÕ×ØÚÞßßßÚÕÏÏÐÒÖØØØØÚÝâêðîïîîóøùüùüþýýýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüøõõ÷ýÿÿþÿûù÷ùùýüüúùøöø÷ôòïîîèÍÎÑÓÕ×ÚÝßÝÞÛÑÐÎÏÒÔÖÖØÚÝàæëíîëìîñöùûýýýýýýýýþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüøõ÷ùüÿÿüüùùùøüþýýûùúùùø÷õòïðêÊÌÏÒÓ×ÙÛÝÜÚ×ÒÐÏÎÑÔÔ×Ýââãåèëëêéíò÷üþþþþýýýýüûûûûþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿü÷üÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷õöúþÿýúúùùùùûüûûúøúúúùøõôðîéÄÇÌÎÎÒ×ÙÚÙØ×ØÕÓÕ×ÙÛÝãçèæäåçëêçíõøþþÿÿÿþþþþþüýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿøôôúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷ööùûúüüùùùùúúúúùùúúúûûøööòñë»ÀÄÇÉÏÑÖÖÙÚÙÚÙÚÚßâäåéîïìæããæèéïõûþÿÿÿÿÿÿÿÿÿÿþüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûõñòöýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿý÷ôõöùùùúùùùùùùûùøúùúúúúø÷öôòì·»¿ÀÃÉÎÔÖÙÚÛÝàâáåéëíðôõôñëçèêíò÷üÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþ÷ôòöúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûõñòõ÷øùùùúúúüûúúûûûûúúøø÷÷õñ춶¹¼¿ÄÉÒØÞÞßãæèéìòóõ÷ùúûù÷óñññõúüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþöôô÷þÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúòîðòöõ÷ùùüÿýÿþþüüüýýûúøø÷÷ôñ쵸º½ÀÃÇÑÙßàåæëîðóö÷úûüûýúø÷óõôøüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûõôöüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿøðíîó÷ö÷ùüÿÿÿÿÿÿÿþþþþûúøø÷ööñí·¹½¿ÂÄÆÑØßáæéîðòõøúûüûúùø÷öóóòóùúýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüõõøþÿÿÿÿÿÿÿÿÿÿÿÿÿÿýôïïñôø÷ùüûýÿÿÿÿÿÿÿÿþüûøù÷÷÷÷ñì»»¼¿ÀÁÂÍÔÜáæêîñô÷úüúúùöôóòòðïíïôøüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷õùÿÿÿÿÿÿÿÿÿÿÿÿÿÿúõïïïõúùøúúýÿÿÿÿÿÿÿÿÿüûúø÷ôõôï꼺¼¾¿¿ÀÇÎ×Ûâçëïóöøøùùôòñïïíìíéìïõúþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúöøþÿÿÿÿÿÿÿÿÿÿÿÿÿûôðïïò÷÷öùúüÿÿÿÿÿÿÿÿýýûøøöôôòð黼¾¿¿ÀÂÄÊÒÖÜàæëïóóôóóðíîîîíìíéêîô÷ùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýùùüÿÿÿÿÿÿÿÿÿÿÿÿÿúòíìïðóóòôøûýÿþýÿÿÿþýýúøøöôóóïë¼¾ÀÃÄÄÅÅÊÍÑÖÜàäçèëìëìììíïííëëêìðòöúþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûúûÿÿÿÿÿÿÿÿÿÿÿÿüõïéæçêîïñòõøùûûüýþÿüûüùø÷öôôòïë¿ÃÆÆÇÈÉÊÍÍÍÑÓØÙÚÜàáâæèêìíïíììëíðô÷ûþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿú÷úÿÿÿÿÿÿÿÿÿÿÿûöïèåáàâèìîñô÷ùûúùûüüüúúù÷÷öôôóïìÅÅÈÊÊÌÍÐÏÍÎÏÏÓÑÒÓÕÚÙßâåæìëêëíìîñõúüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûøùþÿÿÿÿÿÿÿÿýúøñéãàÛÞáãéìñóöùûùúúûûûûýûùøø÷öõñêÉÉËÎÏÑÑÑÒÑÑÒÓÔÓÐÏÏÑ×ÚÝáäèééêêëíðôøûüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûùúþÿÿÿÿÿÿÿüùöóîçáÝÛßããçêñô÷úûúúüûúûûýûûù÷øøõõìÎÏÐÐÒÕÕÖØ×ØØÚØÖÓÓÒÔÕÙÜßâååçèéííðôøûþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷÷üÿÿÿÿÿÿûøöõòíèäààããäæçïôùüûûûüýûúúúûüûøùùõõíÐÑÔ×ØØÖØÚÜÝÜÛÚÚØÙØ×ØÙÛÝßãåççéëîñó÷øüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿü÷÷ûÿÿÿÿýû÷ö÷öõòêçäååçåäçîôøúüüûýüûúûùúûüúùúøóíÒÓÖÚÛÚÛÛÞààÞÞßßÜÝÝÙØÙÙØÚßâäæçéìðòõøûþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûöõøÿÿÿüøõõôøùùôíêéêìéåãèîõúúúúüýüûüûúûýüüùúûôîÖÖÙÚÛÛÛÛÝÞßÞÞàßßààÝÙÙØÕØÜàââäçêíñó÷üýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿý÷óöûÿýø÷óóô÷úû÷ñíêíñòêåèïöúúúúüüüüüýþýûüüùùùóîØÚÛßßàßàãâââáàßàáßÞÜÚÖÕÓÕÚàâääèìïóôøýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúõõùûøöôôõöùûüùñîîó÷úòéèëôùûúúüýüüüþÿýûûúøúùôîÛÛÞààááàáãâáâááààßÞÝÛÖÓÏÎÔÜÞáâçëîðó÷ûþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþù÷øø÷ôñòõùùüûõñîðöüý÷ìçèñøúûüüþýþþýÿþûøö÷ùùõïÝßàáâáâáâââááááààßßÛÚ×ÑËÈÌ×ÛÞâæêíñòöúýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùêõÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþñóÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûöõóñðòõùüûùøóñðôûþÿüïèçîöúüüýÿþÿýüþüú÷ö÷ùú÷òáááâáâåäâââáááßàßßÞÝÜØÓÏÈÈÑ×Ýáåèëïñôùüþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿï›}Ž¾öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúÉ—ˆÑûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿý÷ðððñöùýÿýú÷òðòöûÿÿÿóéçíõûýýþÿÿýüûüùöóòöøøùñæäâäââäåäâãááàßààßÞÝÛÙØÔÈÃÉÒ×ÝäçììïóöùýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿowuzŸñÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿú£rt|z{žûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüôîîïõúüþýüú÷òïðôûÿÿÿôêèïöüÿþÿÿüúúúúøòððô÷úùòêéææåãäääááâáÞÜÞßÞÜÛÙÙØÒÉÀ¿ÈÑ×ßæëëðñóöùûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿö}piemw˜éÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷›lojfpwwÖÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüðîíðúýÿÿýüú÷óñð÷úÿþÿôëéíôûþýþÿüûûûùöññïð÷ûûôéçæèçäåäââââáßÝÝÝÜÛÚÙØÕÎʾ³¼ÏØáåëêîîðñöùþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿë{l_[_hoÈÿÿùÖ½¹š“§£–¤²ÆÞûÿþ¦ih[PT[lsÀÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúñíïõÿÿÿÿÿÿýúøôõ÷úþþýôîéíôúþÿÿÿýÿýþýû÷õòñöù÷ñçææçèçåäáâãââáàßÝÚÙ××ÕÏÉÌɾÉÝàäèììíîííó÷ýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÌqk\\`_aioš©‘‚w]Y^[`ls{~€‰—n`ZRcaUYj§ÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿûòîóýÿÿÿÿÿÿÿÿýûûüýüüûòîêîõùýÿÿÿÿÿÿÿþýû÷òñòôóíæåçåçåââááâáààÞÞÜØÕÒÑÍÅÅÌÖÜæççêëîìïðîíïóùûþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ´skHDU[U]ov|…z_B<6@RW\q}tsodGBDIS81Cc‡õÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿúööûÿÿÿÿÿÿÿÿÿÿÿÿÿüúûõðííïôûþÿÿÿÿÿÿÿÿÿýøóïïîíêååååæäâááàâáßÞÜÜÙÕÑÈ¿¹¸ÎßáæéééìíïíððïìîïõùþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÈuk?1BNP_it{lLGC5/KplUUlYNpfF:?C: Bcwâÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿÿþúùûÿÿÿÿÿÿÿÿÿÿÿÿÿÿýú÷ðíííîóûÿÿÿÿÿÿÿÿÿÿýúñðîîëéâãäååããáßßàÞÞÝÚÙØÓÐǽÅÏâèèæëííîîððòòïíìëðöýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿôbG1H\ec^jiWbbN.'JguˆwniOZfaFFG<%"Iiráÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýú÷ðííîïôùÿÿÿÿÿÿÿÿÿÿþøñîíïìéàâãäääãâßÝÜÙÙÙØÖÔÖ×ÚÞäçééëêíîïððòóôòñïëèêñúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÆXD9XvvS]|~wiSD9I`\Mh‡~gRYqWNR6")C_öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýùöïîîðó÷úþÿÿÿÿÿÿÿÿÿúõñðòô÷òÜßãââååäâãßÝÚÙ×ÖØÛàååçéëìîïðñðòòõõöôõñëåæîøýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ5AWlbS‡¤ƒue][\djfcj‚¢¯e:=Sc^E$8E»ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùôðìñó÷øúÿÿÿÿÿÿÿÿýýùöôóùýþú×ÚàäãæææçèåâàÞÝÞàãæêêëîïíññòóòòòôö÷ööôíÞÝëóüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÀVhf^OiĪ‹‚eSTY_fz€|„ÁÞš7&6Sig@ 7:Øÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûôïîñ÷úûúþÿÿÿÿÿÿÿûùø÷úýÿÿÿûÕ×Þââåååççêçççäååæéëëîðòóóóõôôôôõööö÷öóáÚäóÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿñŽ~eUJ¨Û¨™R>CQ^i¤‘†}ÓÜ{*5HPmsQ7=YòÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýöïîóüýýûýÿÿÿÿÿÿýûùúýÿÿÿÿÿúÓÕÜàáâäåçéëëëëèèéçêìíðññòôôõöööõõö÷ö÷öõìääöÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèŽmVUuÊÀ£kFBEGWf®–‚ Z™É†I*LK?SjTX‡üÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷ñîõÿÿþûüÿÿÿÿÿýüûüþÿÿÿÿÿÿúÐÔÚÞààäæèèìììíêëëëíîïïðñóôö÷÷ööööö÷ùú÷÷õñòýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÞ~[UfxXŒ‹NGHJINZ’¥š¬‹mŠ€]HGlIAfbÂÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùññ÷ÿÿÿýüýÿÿÿÿýýÿÿÿÿÿÿÿÿÿøÐÕØÜÞâäçêëíìîìëëíïïîîðñóóóõö÷÷ööö÷ûûýúûúúüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÌYRbr£”}KEGHFEEx¸µ¦œ¬¾_.{nkj(IpëÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúððöÿÿÿûöøýÿÿþýÿÿÿÿÿÿÿÿÿÿøÓÕ×ÛÛÞâäèëîîïíìîìíïíïïñóóôõõ÷ù÷÷ùùûüýÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿš,Fhi¯ž•–CAFIGE>wÂwABFV&qƒE9? eÓÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúñïòýÿýöññ÷úûüþÿÿÿÿÿÿÿÿÿÿøÔÕÖØÙÝàãèëíïïîìíììîïîïñóóòõöøùùúúûüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿü¶I(BO6<4:R‡G>HGGC<’©352@4(p‚!O R“áÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüðìñüýûóëëòöúûÿÿÿÿÿÿÿÿÿÿÿùÓÔÓÕØÛàäèëíïððíêììïîïïñóòôô÷øùúûûüýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿø·d+4OD?S"23Y@3fOS:Bax1&8BIIFB>([ŽR1!@L9>FH,H»f:Ëš(u„Æÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúùù÷ñîèêî÷ÿÿÿÿÿÿÿÿÿÿÿÿÿ÷ÌÇÈÌÕáæéîíðòõõõòïñòôõööö÷÷ùùüüÿÿÿÿÿÿþüþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÄ—•=649EMMJFB=71=@BCA?S•ÉŠ-½¿(%~–½ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûòðîíîó÷ÿÿÿÿÿÿÿÿÿÿÿÿÿùÏÌËÐÙâäêíïòóõóñððòóô÷ø÷ø÷ùùúüüÿÿÿÿÿÿýýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿﮣ0~yA?FC:5;JKLID>98;CJMM7O¼ÌÍ•7¸ÂF*†ž®øÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿøôòòóöùþÿÿÿÿÿÿÿÿÿÿÿÿù×ÕÔÕÛáäéìðó÷öóñððó÷öõ÷÷ùúùùúýüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¹ žf$‡…¡¥^NI75CLKJHC;49>CPUV]•Í˾XhÆÁS%€¡¢æÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþùø÷øøúþÿÿÿÿÿÿÿÿÿÿÿÿúÜÚÜÝßãèìòóöøöôññòöù÷ùùûúûûùúûüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÄyZ*”„µ{ZL<7KQPLHA:5;AENWm™©‹”C:Ÿ¿Ál&t¨¡ÉÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýüûüÿÿÿÿÿÿÿÿÿÿÿÿÿúÛÜàáäçéíñõ÷ùøôññòöøúúüüûûúúúûúýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿàacŠ…[G¢ƒGX[YMCBSYTOJC>EQMILZRfŠXk«} - ™~\y¤­ÃþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúâãæççêìïîïñôöøööùýþÿÿÿÿýüüûùúùûþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿãqSOm…w]|QXsYPa45CCGD-RdPMHpwWŠ‚Ÿ£, Bš„…ˆ’«Ðÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûååçéêëíííëëîõö÷ûýÿÿÿÿÿÿÿÿÿüúüúüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿáx[TKtz~mAYjSLŠM7C>2fMSYz«v{’mN…¤’mƒˆƒ—Ýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýÿÿÿÿÿÿÿÿÿÿÿÿÿüææèëìëëìëëèìô÷ûþÿÿÿÿÿÿÿÿÿÿþüýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÿÈsiiLFr˜Š‰€yx{‹ˆo£A 8)Jœ¢_N[^…­¢‡viŠ¤‹QJ}‚€‡ÜÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýÿÿÿÿÿÿÿÿÿÿÿÿûçèêìììíìïïîïõúþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÛ‡q†louaHFu›Ž~wr_pƒ~rŽ¤4'b££q~eZ˜©¤œ‰`y :)1D^pqz|^@?Hh€‰…`Sv‹~‡¿ÄÄÄÄÉãýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþîλ«˜||uoddjonicK:DF>78\‰€‡S@-PhE)Sn`HDYcmk.1(%0Ze]S7,X_^P&)IYAJahP)*DV^^YC6B`qpfaf~„ƒ‚‚˜—Ši‰Œ¨¢†oz••Œ‘”‚ow‚wjnriZUOLVWVK(3@;77:Ejn[^[]oolizƒ„…ƒ‡‹’—ˆ@ )LQ`‚•›Ÿ–{o“íÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþúöòðïíïîîò÷üþúðïîíìîðôùûùûüûýüþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿñº‘ztwlTADTkpnmjA#$&:RUUL+ Qa\Y1$78%H]^T,,FQVXT8'2Rdn`BBauvm_uxb`|hYŽœ‘{pu…ˆ~{sjh]Zqtjfom^PHDPSQM'(:877:=XqbXW]copnkkxƒ„†‰‘“•ˆ^D32LL=d™˜•‹~…ÛÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüøòñïïñïðôøüôóññññòôñõøøúúùùúüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÚ‡]brwteJ66IYTThjJ##06IVTV=F]ZW5%%#QXYS-0KSQQM4(2S]gX25N`idSPVQ^krdJdvbl{|wica^[Sali]_h^OI@LPMJ( 87779:D\[G=BQgomfWQ[pt{†‚re`]`aei[l†”“Š‰ˆ±öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû÷öóñïîðô÷øïõôóòôóôòñóôöö÷÷øúüüýýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÕ‰\]_bptla=%-O^LMehP#&>:GXONH**BPRP3# 5VSVQ/2OPOPK,!>Z_cE&/O\^[J=@Ncjk`BEs~dXgppeZa_\WV_e^WZXQMINNKC* 575657;GK@954BZ]K>::OZbjgb[Y[ahpx}‡Ž‹Šäøýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþûù÷óòððó÷øïööööõôòððñòóôõö÷úúüûüþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ½aOYa^anqkT!3gkTPcgP!FDMU?>M*%CJHB-ERRQO/3TPLOJ"F^^]<Ib_^B)2G[bgZ;CgnohXYgjiXU`^\NTaaYPSQOPLJG?&2532235:@@>>7.14387=LT[_b^WW\ahqy{‚‰ŒŠ¯ñôüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüú÷óñïôøøðùù÷÷ôõññðððñòôöööøøûûüþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿü§dbgcOQcnmmU--DpmYP]hNAGJO60F"CHF;& "KMPRK'&XXRQI$#MZZ]IB\__:#2FNZcZ:=cnli[Q]lk_QZ]ZQQX\OIQQOD=@@9) 2532122763525@EIL57MORTR+,QSTU<)IOHOTP2)Ib`\J@D@TYWLBIGCGMH>?FF90279+7841///00=LPNG1  - -()2332B^bowuy‚…ˆ†ƒ‚Š–²Òåïñ÷÷øÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýüüúù÷÷÷÷÷÷óñí÷õõðîëêëííîïñññôôöøúüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿç‡dE`‰ƒ^3>vzwvsS A]\Y/&NZF=GF,2'@:(%A=<;84108?@C/>NPTVN+.QUSM$&LFCRXS/<_^]I;D=@<553**-01%496520../1HTUTQJ# - -*/:@-  Imqe^bp~‹vH?;De«éïÑ™áÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýüúúú÷òôõôôñðêñïîíîîíðó÷öõõôöøúûýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ³qK;e……z@>p~|rcVN! DZZW:.PP'9BH23<.?5' 2<<=>=)%972*0?CDLQPJ28TMF3>HIOSY^<8VXZM7IHHNURJBBCABA=856.++-1'399731/./-8RUSPLD #8AF)"<:5COV\cfjtˆ{`KCQ²Ïv3‰ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþýûúùöòòòóòñïëíííîðñòö÷÷ö÷ö÷úûûýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÒzR:L€†‚t=FkmmdRNG R\[[8MQ4/CG,/<7B1 398<;:,806DDBEEA-#;VME.8HLPPUZD&:PTWM1KKCGSOE@BD@BBB<885-'(-+%5::94110--.GOPQOM: - -/EE36PPOLMS[[[_aey‹ ´»¯La™f9eûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþýüù÷õòòñððîêééêëîòôôö÷øúúúüþüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿú•k@>_ˆ…„j$4IOQQQSB&7FMTH,HJ>;IHB=?@@AAA<676-&(0.%4<;98321..+9IOROOP9 -&IJPTROLJFYaREKSYe{‡¤¿Ðà¶dcn>füÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþüûùùöòññóóðìåæéêìïññóõ÷ùúúûýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÃyb69q†„€\7Vacd[=E@/\\ZI/FA##@ACD8 0CEE8++1IPPOMP> 8=GPC)BI?7?EB=;===?@<146.'&42!2>:76431/.+-8DMPPQR+5BKPRTPID8-[fV=4;Kazro˜ÏßñÖš|<Žÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþüüûú÷÷õôõõóìåçæêìîïñòôõöùùúüüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùŽrL*<{~y_>QacaM#? 7510-23/2:>?@A< =CDG<554KRNLMO>35CLA'?:123.% 76"0<9754430-**3?JMNMMGFKKNPSTN5*!H_UA74= -$531/* !///19@BAA& 'HFEJ>3,5PPKLMP?",*@J>2FA25@B><:<==<7232+$#66!(88764410-+*.:DKLKIHIHJKMRSQ3 KNLKB: (.454/* )--..3>@@( -6HJED:1 *LMIKMM;(/0BF=,CB46@B><;=?<:6111+))77#/7664421-+*(1>EGEA><==:ELMP? 6M311DF?-CA67???<:<;96510.,)%49--;975210/**+1;ACDB81446CKKID# +F%UE7OmŽ’‘gPœèúùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüûúúûúùùøøõïêêêëííîìîðîîðóõö÷úüþÿÿÿÿÿÿÿÿÿÿÿÿ€3'#?E>3D?46>?=9642353/,-/+#4<8%'89620///-159<>?CFHEHD>BFA:>22K "Cnˆ‘”•~m„òøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþýüùùúùúùù÷÷öïêëíììîìëíîïïðñõö÷úýÿÿÿÿÿÿÿÿÿÿÿÿøn+:HG_mniKPZcf^YH 8H( -*OL:8= 1JHC+&8@'*:<& -46547- 112/ %68>:=EFB<"#=EA"5E>,+8<984/.-12/./1/'8?>/$1751010117FNLCHQUXXTI5**,5?<(;g(Qs|€ŠŠ…Z³ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýüûøúøùúùùøøöðëëìììíììììîðòô÷úûþÿÿÿÿÿÿÿÿÿÿÿÿÿÎQ%3KWejlfLRalldX; -BH$:KE/87!:HG=&'9=".9;!42334"$104 - 179;>A@')=?==@@@6"#5A8%7>6!7:750.,-0100141*8@<5#+444115515F[\XZ^`_]K' ,>A6*$&]F 2Tlrq~Žˆ†—~Ïÿüüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýûú÷÷÷ùúúùø÷ïíìíìîîíìíðïòôöùüýþÿÿÿÿÿÿÿÿÿÿÿÿÿk&+TcjjkiXNbxvoY/ (OKDG9+=2&BHK/(9=!6<=53544 022+ - 06999<=?">@@?=;82(&4?0)9;3#8852.--010-/252,5<75$#24548>=74:R\]]`caW2#2;71+"##6?!N\nnvˆ’gAžši¨ùúûùýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûøø÷÷÷ùùù÷öïîîîîîïîññóóö÷÷úýþÿÿÿÿÿÿÿÿÿÿÿÿÿ×9!Zhfegh\J]€{uHGTD$JH-*=&-EEC&>@!;<> 45771525& '58=:;;>8&>>;;9983*);>32:<7)9941/-/31/./343,/852'#/29ANLF>=:;=-(>><;:985!?A<9;=9 *7952/.3741/1543+)43/*&/?NWZUMEHNSW[]^^\H+ ;DA;;;6.*2;O\ipt€ŒtRLV}±úûöùúüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþüúøöøõ÷ööõôïðïñóòôõ÷øùùúûýÿþÿýûúûþÿÿÿÿÿÿÿÿW#J`ecglaOe€|6 8VT8%BI/+:5G:-?> #><<* -$7327/ "75-# -5739>=<98#(BA>=;;746>>===3,88620/365325542,'/-+-1=PXZVSICHQV\[][ZUG' -??B@:;=.)-6LRepuzg_iTPSQw§üÿüûùùþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿþûøöö÷÷öôööîôóöõöö÷ùûüýþþÿÿÿÿüú÷öûýÿÿÿÿÿÿÿŽ\' ?X`gimaVjx[ CSRGCN< /69A-/$%>;"%=;=+ )83161 &60' %)4107??><9+DB>==;9-3>>?>BC:.7E:+-3H;Rxyq5Iswyme~§ÿÿÿþûúúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿýù÷ø÷÷ööõöí÷÷÷÷øùúüýþþþþÿÿÿÿü÷óòöûÿÿÿÿÿÿózWJ*:H]jm_Tlc &MOPLGG)--&?8*7( &;9!<<>)*95373 -*-&$ ".;>5.-(6FDE5 .C?;;===)3=>?><0.7642131/56655310.DVZYJA9?QUQ2-[caa_\WJ<:@CB:(%34007H=6^vk&ZeBjga„ýÿÿÿÿÿúôúþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿýûøøøøööôôíøøùüýýüýþþÿÿÿÿÿÿÿüú÷ööúþÿÿÿÿÿÏYUW>#>kpZOgD HOONF51,13<-(7) $::"$;<@%(::893 + ( &7?D@4))GHH"5EB=>?>>15>>@?<1)86311252245:D@=ERZ\XQ7+*/KRRG)"E\]\\YOA.*FF?>DC1&%/25@F:7Q_JMW ?gYdìÿÿÿÿÿÿúùüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþýüûúø÷÷÷ôóìúúüýýýýýþþþÿÿÿÿÿÿÿüúùúúýÿÿþÿÿ¬=OUP&#C^LG_58MTNPK*)$39;1&8$ ':8**8;?$ (<<<<4 +%.&>=?@:#-DFA CEFA>=>@57<<>=<."561/,/269>Qlx_NQUROTS;##*JTWYR0)>UZVK:,$BKOG=AE:.(-34;B@78IRMgh@c>B½ÿÿÿÿÿÿÿþþÿýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýûúøøøöõíúúüûúþýþþÿþþÿÿÿÿÿþþýüüûüýýþþÿŸ5EY]I#/8BZ;9=DEHDHSa…„Pb]79|ÿÿÿÿÿÿÿþþþýýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýúûûúù÷õïùùøùúüüýýþÿÿÿÿÿÿÿÿþþþüüüüüþþÿ%5]d]I4)$ $NOONUfvš’zrr‚z_XIBXY[bimmoq‡Œ—Š|{v‡•…sxƒ„Š‰ƒ„}rrnYELN6H[ZS:7CNTWV=%DWÕÿÿÿÿÿÿýüýýüüþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýùûù÷ï÷õöö÷úüþþþþþÿþþþÿÿÿÿþýüýýüþÿÿt"(Eb`YSPH=2#8D0@VZRJE0."6=;!"02 !653247;+ =<77=@?B2(7?>;4:Qhkkp’œ]lšvMKDrúÿÿÿÿÿÿÿüú÷ööúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüûø÷ïùø÷÷ùùûüþþÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùd7/!3RTWVRKH;7CVXUMB%$,9>>:%23.127@Vb]gŠ‰Š~Œ“€b\t–sC?z““~WJ^‚ˆnY}œ›Š‡ˆ‹”“‡qlxtkdwˆ…{qjgo„„‚w_dtm^\TOD@HX[]]=+=HGKPF.>MTZX[b`a][VD?<451,46797:GYfejrg;1NWTMJFµÿÿÿÿÿÿÿûùø÷öúýÿÿÿÿÿÿÿÿÿÿÿÿÿüúûüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüúøðùùøùûûüýýþþþþÿýþÿþÿÿÿÿÿÿÿÿþÿød8./IPQKFDA>%4^]\WN>"3;==8"21'2COi‚‘vY^‡–—”‚p€’ŒfQZm~€o?9gˆ‰iBA[yzwtWF\Š{kp~‹qwˆ†d_tnfZ`uzv`Sa\t‰ƒXCli]LFMIDHTX[[=09HIJNMEDKQUV[aabcbVKEF'2;:0%2:@FOYYoP;L#OWQI@sÿÿÿÿÿÿÿÿúôóõøýþÿÿÿÿÿÿþÿÿÿÿÿþêÓäñôöüÿÿÿÿÿÿÿÿÿÿÿÿÿÿþýúøñüûûûûüýýýþýþþýýýþýûüýÿÿÿÿÿÿÿÆ9(#+/@@@BG2B\_]XL6(59=:7 #/4Devor|†‡oZazŠ’‘„ed{‹u\]hwxnKDd„ˆm<OeaT;LRF@PTVYI7=HKKMLHFKQUXY[^\fhQGCP8 :C;"0>ABTVSY@‚`L^ebHD\îÿÿÿÿÿÿÿüõñ÷úÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿâ½ÒêêíòùÿÿÿÿÿÿÿÿÿÿÿÿÿÿþüûòüüüüüüüûüýþýþýüüüúöøøüÿÿÿÿÿÿŠ+&6:DJ8M^[YUG*069883!*BkŠ…jdjw…mQVeq|‚ƒnTKlvdLWsrkVAQ~pKFJWszg*%a€}m_p{vaSr|iTanxsZdvvmJENIVmmiO:Sfa6ERI=KVTWO;:JNLLMHJNSUVUVXYdgRBAOD/GH?AI<<:4.$7[\\c^OEP_dp€lF6=CctrhI*(HV86bma08XaJ=;Ggpe9?g~|oU^{vcZi}{pgqnh`WCTniWEGOKR_aaU‹|SYn*7n}×ÿÿÿÿÿÿÿÿÿüûýÿÿÿÿÿÿýþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿüùïüýüüýþýþüýþþþÿÿþþüüûüþÿÿÿÿÿÿ¿fd[MEHF@9=?ERPR`[QVUF$)8?<4$*Z^DFSK?K[aboywT=;BlxskO#(H;5NY:$4COM>6HX]\E68Ypg_f}y\I^wy\\mgYVJHcgcPCIIL[_\Z@"A[PKDGG`kgda?&OUTVWTSTRMMQTX[bnvz{G*/CLNPXfkso^Qkv! " -1L¦ÿÿÿÿÿÿÿÿÿÿÿýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþûùñúûûûüýýýýýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ°b`_]OKIIKLRZdh~Œ„ul]G,"2FH?9)*K^PKJFACVa^Hd{vVC;:ZsqlL1!EW[N,Mrj\H83Kjjc<5.#:CGQK%9KIIF9Gb_OFGGCJNHipfOQNE=:EGKVXVP39DJKEGFBNXZ\Y;(CFFPRTVYWVRDERW`lrun@6EQQPRSYv‚Ž‹‡#6cÐÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûúïöøúýýþýüýýýþþÿüýÿÿÿÿÿÿÿÿÿÿÿÕƒˆ¤¿½”n\[XQew‚ˆ~eZ@5L…„eBA`nbiugULEJWYQ>O_`]:#+`d_75<+=NRSQ+$/=CIIFJakonXKNYRA8@XkmlffS@C><'(;ox~~qRNS[ijjm]Udu„}UQabWFFB3LZYSL?KchI6?OOZ^V^jnpG:7P|vhmgRF5!$.9Pgmni[WUUMLTVMHJl‰‡†vT95:4,CM\eca^BIcnYSem`MV[U`nhTHM]fR99>FP\SHSfUP3'Bcuogg\>2"+/BZ___ZX]baZW_bVQW‹œr|€tJ:=;8AJB=BA*18>RXWTSTVUSOOGC]tyƒcrÚÿÿÿÿÿÿÿÿÿÿúèáÛãõÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþüûñU=<1%&#HäýùüýüþÿÿõÃ…krvvv{up†”vZ\cV?Melmh^E3<9 $65CRPOQSTTPORQEDhx€†s’ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþûýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþüþþÿþþÿþýÿýýôFBB8$% Lñýûýýþþÿæ—rQUq‰“ŒŠ“©£|ca[G@Pimh[5.64/B[R;5ML /[\Y\\Z<,0Oc`bf^12]^_]TOds_QMD7IbeC4>W[S28G[lggeVL<.O^hf_\WA?=''5BJONC6G`XXcaXG?KTOR}ptqr}‚oT?B<9667:641BKLMPROMMQRNBNu€ˆ„šúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿü÷ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿýüýýûüûüýýþþýýýüòA=?=/+%˜þýýþþÿÿØ‹uTDVw‡Žh[™…xjdkbQFQ`]@'733KZX;3NK;Zab[ZN*'4Q[]age<7[XVXTDVx`JLM>=\bO;8IVS9 $=WXVX`_C:P[afgb[O:@@ekfWJJe„ˆ[?96.$/='/8/8GKKLNMMKNPRNI^“äÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùõ÷ýÿÿÿÿÿÿÿÿþÿÿþú÷ûýýüûüûýûù÷ûúúýüûüûúó'%+.-.FåüýþþþÿÚvkZEUmvr]CPw‡}vm:&N^X9/SR0$)-9OYZM*4VCOU[a_Y2 5PQPW_a<%HIKSD-6e^DFSYR[\P93COR?-/JVQSQW^>:X\bc_^XOGCCJD0289,(/EOG9410-%#Nh]KB;Gv’|Q<(%.:?;"3/3BGGIKMKJKMPVXSm‘– ëÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûóöúÿÿÿÿýÿÿýýýþüîâíùýúûüýýüøõõõùúüýûùùò"$$$6«üüýþÿÿázeWBRhrqfSNWglom]*:VS/BS/$6?LXZA%)N[49QNHGMG2+C>AJ[`X:1LBIa[@2TeB?IV_`^F26BLL5)/Y_RI??B;FZ\]aZUPPUOFV[H601*. .3MT?23/+)$5s…‹_DA]}‹}qU*3B/;C/!+)WL$(?69>B7!6XdJBS]aK=PQHZxtXGXjL9FP]b\?3BGGD4*"'JWPFH?6J]]^[XUTZa]X^^ZC$)*?@;>>7-(*2*6*KƒyL(2>[q}€‚rBBI!3CC0 &&2CAAADFKLLNS`dYo£¹ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýõôö÷øûúøøûüÿÿÿýðãèõûýüüýþúøõñîðò÷úúùùñ]^^Wkíüýýþÿï‰ou]GWktmlie_}”ˆvjL'&;5%MP;6ITX:7PH5.7$-;8$(?;@]cb_]=:c[He~oSN^lT=KW^^W?6@FCKL:,6HJT^^E1I``_ZXWY]cc``fbF :TBAB251(0H267U„EBOmx€ˆŒ’bCJ'*BEE6**+uO$_m|•˜™‚NB1':BDC60-(8@96CJLNRRT`ei›ßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüöùûù÷õóôô÷úýþýþÿÿýúüþÿÿþýùùø÷ïîïóøùùøðh_ZV`àýüüþÜY^nS.5ejecgd[dige`]F7<116;FLJ?.FG=.JIG5 -5DJMHSXKBG^b_^V.B[[-OggIM]MBIYfgQ500J_VH?25=?JNI.1Q__XVWYZ\`gjffqS;@974:?CG>24#!8=3-=HHPTW_km˜êÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúøûþüøøøø÷øûÿÿÿÿÿÿÿÿþÿÿþþþüúúøôðíñ÷ø÷÷ðfTQQQŸüûýöwMfiG2RgeW]i\O`jd_XM=6;01?IKJE/9G$ 1HHC/BHPXKCE+5YcaZYI8O\[;,H_\GGSS@=JY_`P- JOC@>3+4DMNH+7M]aYUXY[]^ajgcgUCJTQB:9<4@HCNJU=9<4?E(CVXpw‚ƒ…oNG;9=CGC666 78-/?CLW]`lqœ÷ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûöøþýúúûûüüÿÿÿÿÿÿÿÿÿÿÿþýýþûùùùöîêïöøö÷ñXLKQR_Çýý¹ObleKMaic@Qd?+8ZaRGHA53*9JIJ; 6D; 3CEGC$'TURQTB62(HZ`ZH&9R]^D(F]UKHQR?@TVXYWA#9>69:3/8ALN<(DPZ_ZVXX[^]Ybc_]QEFPXH:ALC8C>CS]VL:3:QlpfgvŽ’}cw€lI3229DG=5AB 4AB8=IU\am{Ÿùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûöóöúüùúüÿÿÿÿÿÿýþþÿÿÿÿÿÿþþüüúúú÷ñêèòøøøñHKBKNWÞü€DckbS^goV:UW0*/PXD@D>6,%DMK@ 4A8 'AFDB/$NYlh[J98-3HPZ]98Z`_;2_VOEMO9AWVSVT;18)*&(-1CRL+&DRX]_][[[\\[^\][TLGJSJ?>84&#INGEE/ 2=B?-$UTdi]D:P5+^]]Q#Hdgb. --dZP?@D7BVTOMQ8+6.**,-+HVS2$?RX_aca][[[^^Y[\ZQHGOJBHHJKMA">G082L\RXZo~†Žwc^5}’Y9$,(1DGEFJQM35J<2+Uiry¦ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþüýýüûúøöðìéîõúùûþÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿþþþþûûûùöíéëñ÷ï9=Egyˆ}PP[ONVeiO8DYH+;XQ?9;933&)NN3 *IG5 27:/PR[eX82OL6C^aaD Pbc`*5e\T@8=6BXSOKF4.<75=9,(?SQ9%FHNRTTK2=G91?pyŠÙþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýüýÿÿýùøóñòòòóñïìåÝâíõûþýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþýüûøòìçêëI54Rghda[VYYQGD\8*F[_P13ELB;855-:SO(8FMRSOgme/m5Sts}.!-*+KB4>LRQGk{v8ƒ*2i{_.+2'&@NQSQSQ<=?7-U‹®íõ÷üùùúù÷ööùùüüÿÿÿÿÿÿþüÿýÿýùöïíìíïñïîëåÖÖìöùùùøøùúúûüÿÿÿÿÿÿýüýÿÿþÿÿþþþüùø÷òéåävavqm`_k[\ZC18]OW``A%0;CGA>><88#OE!>NN""5% 3DJ[fcM" #FbXieV#5UC!@\ZG8-)IKE=DC37:8:?<9>48\\P@2/DTRUUUXVVUVXRUksuleN@<3'$(9953578BC19ITRM„Žk(my&LQN<40!;69OQNPVG<=EC7j¯ìóôöôóôòñññòó÷ûÿÿÿÿÿÿýüÿÿþüûøôïíêëíëëèâ××ëôóö÷ö÷÷÷öùúýÿÿÿÿÿýýþÿþÿÿþÿþÿýýùø÷ðéý¾mˆufhpXUU?+;md]`F'&lITb_,#<\E3OYVA3)%GK>1@KC6214;=79=(BYWF71->MNSWVWXVTVYUXkvxiaP:3*('2<>:2368;?*2WhM^”‹N@“d2oZJ7382<5.EKLNIADT^LHŽàïðïîîíîïíëêëòøýÿÿÿÿÿüýþýÿüüûû÷ïçæéçèæáØØçñóôõôô÷óðôùýÿÿÿÿÿþýþþýÿÿþþÿÿÿþúûø÷ïüÌ}´™ƒrf_RMH<(Gre`L)"%CJGGE=;<9'(:2#!22% 0= -K^`[YG $KjSYaN)EYRRUPK9:78D929CF<0/4687><"?VT>62-=MNRWXWVVSV]ZTky~iaA$!&(+1?EB62037:5A959;748>2EXQ?AA2HQPRTVVTTSU^]Pe„hI" 153ADG@=.-18ALbfDBD+;†”KVtNJ3)05* LOKHCB4+,79;= ;& 8. - ;CCMP; - -Ttfamg8,NUWYVMD#2$2BB<<==89;<65::0'JUL@KC,HTSQPRSSTTW_]Pfƒs3 $,C98EBGHD:139GLSeO=>Rd_THSxG?8',76-?EKH10@?@DMZm„“°ØÛÙÛÜÝÝÙØÔÖàåëñøþÿÿýùúüÿÿÿÿÿýýþùîèçéêêãÚâòô÷÷ôñôóòóòôøûüúúüüüýüúùúûýýûýýþþþôærXÜùùœJQSOEAD\S0&(ATSPLGD@0-16-%D@-A$ 9. -$CFEFD V`of`lc2$0HNW\XO5.@/3@?:77;,-67-285-,MRGAN8(JYVROOQRQSY__Sj‚‚F%&5KKCAB*,8;+&AFJ>5@BABHNc‚¢ÊÓÕØØÙÙÖÓÑÙäæéìôüüýûø÷üÿÿÿÿÿÿýûúùöóôõóêÜäôô÷õóóõõõòïïó÷øùùúûûùúúùùúúüúýüüüüòü·M½úýŸ?GQPF?BcS2,.EONOMHE='(05+.HD5?" 8/#HQH=+ - Yejkamd. 6IT]]R$=F:7=?;550#?:055*$.LN@=M8!H^WRPQOQRSY`\Soƒ‡v714ERLKLH37FMGCCFE?1/E8>‘z B>$^wAB006:6'+13=BCFF@@IRo…™¯ÉÒÖÙ×ÖÒÐÕãêççìòúüþüøøûýÿÿÿÿÿüüýûûüüüûïáãóôøôóóöø÷òîëîõõø÷øøùúø÷÷öøøùùúûûúúòúÝX—ùùŠ27DNE8C^C--.CLKIHFE:((.4-1HC6= 9) H`W;#Zlbi_^b-ER^_S$@E967;7/7+*G9482 5KH>@O?!EXQQPMKOPUY^VRu‡‹]";NSRPOT:#/6NOOVeN;8COA—‡fjeB(NGE4.2;:><951+1;EJJKKOU_j”¬Í×ØØÓÔÙçîêëëîð÷üýýûøøûÿÿÿÿÿÿþýûúýþýýôåãòôøöôöùûúôîìíðóöóôõôóóñòóô÷÷÷÷ùùøøðøñrˆ÷év=,0C=1OV2-//&+D,581#!9HG?CQF+HTRPLFGOQWX^WU…I%Qb[XWRV6(39OW`myW=J_mQl—{kp„mAPHC3(/;?EGIJGC;:EJMR[_`afoº×ØØ×Þëïïíííîðõüýÿüûøüÿÿÿÿÿÿÿÿüýÿÿÿýöçäòõù÷öøúûúöðîíïòóððððîïîðñòòôôõøø÷÷ïòö…röÖeO-" $-\T;51#);B7(" .B2:F5 !GD85G=:,$X`jcIcl`(4QW^[SDM?796.< -/7%14/&"9IG@DOC.EQRM@?KQTXW[ZZ‡–j6:Xlf^_SQNHPS[`goqUN\`hc}ŽugrkR@IDB7"*9@DGKJIGDDFLOSZadfjoy†¡Ôåêíòõóóòòòïðøþÿÿýüùûÿÿÿÿÿÿÿÿýÿÿÿÿþùèçðøù÷øúüûúöòïîîðñïíííìíííîíîïðñõö÷÷îíö›díÄZTF(#JNB<2( .A+FK5.B-9BWRC+ 4 RdgrX]y\&2Pb\XS KL?8;&560++0"%#OSW\VX]eŽŒK7M\pqigYRW_efeggj_Xmt^DLƒ‡}ygZwumHBB/!2?DHJJHFJIHLQSW\djmpv€Àóôûøùûúúù÷òðøÿÿÿÿþúüþÿÿÿÿÿÿÿÿÿÿÿÿÿùìèòùúûüüýûúùôòïííïíìëêèéëììëìíîðòõõöíëô¬SÙµPSQE-#()4< !"9 5QSI2&*' 5]iwteoI - -> WjeUI(GMA8<4,'&(+2(&'=DH;8CA:KUSJ4;WXX\SU^q“l.=efsvoeWS[aghiec]MWvynHR„‹wgm•”uHFI>+3>CEHHFEHIJMQRVZbjlpuŠ åùùùýýüûúøòðúÿÿÿÿÿýûüÿÿÿÿÿÿÿÿÿÿÿÿÿüñêóûüþÿÿÿýúû÷ñïíììëêèçæçèéêééììîðòõõíìð¶G¾§1>OK8/0:=59920**?1(@OA!1B'/7 /JRM>B8 $cnv}ogQ E= -\jkO//CS;<8%,&#34'+,:DI@9ACBLTSH";c`[_T\o‚‘FCojpvfYTT]`ejjdaWIQvz~cc…h3@^fyNRRJJ>97;ACFHHGHKLPRTUX^hims|‰ŽÅúüýÿÿýüûùôòùÿÿÿÿÿÿýýýÿÿÿÿÿÿÿÿÿÿÿÿÿôìñúüÿÿÿÿÿýýùóòïëéèæääåèçèèççëìïðñóóîêñ¾E¡«%'DA402>B?>=14HFIC9 4ISPGF,ruu„F'$[)_eg@DY>O51.%/;$7?>>BLL@AHILQS@ HkfdgVf~ˆ|."Ir`hlZTRV^`befd^XPRi}~z{ƒ, 2^8OeLF1,69>AEHHHIMMRUWXY\cfnu„¥ðÿÿÿÿþþüùöôùÿÿÿÿÿÿÿýþÿÿÿÿÿÿÿÿÿÿÿÿÿõîðùÿÿÿÿÿÿÿüû÷õñêèãÞßáæççååæèëíññòôóìèòÊL†¥%!20-3?BEHILNPSVY[XZ[^ajszƒ–ÊÿÿÿÿÿÿýúøöûÿÿÿÿÿÿÿÿüÿÿÿÿÿÿÿÿÿÿÿÿÿøïðùþÿÿÿÿÿÿýûøøòìçÝØÙÞæçæäáäæìðòõõöòëìï×[x”?:@0#3DF@+'-#1JMIJKF$ -&7J7+4. -.7;((CJOP<[vrpZR[_cb=&bdYZ26-/=$:DLTVNAGMEBEKQVU=/`pv‚kO~y<FKQWXB3ix…{_…Žq@IMKSTNMP^e^VRWZ[]]]^\[b|†Š”b -"IhpaC0GMK:>KPT[_bbiicc^^Z[`kt{†Œ•äÿÿÿÿÿÿÿÿüþÿÿÿÿÿÿÿÿýúüÿÿÿÿÿÿÿÿÿÿÿúîî÷üþýûùöôôòðððëçàÃÉàäããáâãåìñöø÷õóìëíï†_qdOGG*@B1172+4-#4?HPQSH *PE;> -?M2%*D^]ZK'  -;ywj{mMkd.gdRVYTE#,#$95AKGFIPX\ZZVKCDLPTYYM9k€’up„ƒbOSTRQTSVakibVRZ\_``_^ZXVj…ŽŽ“LHkuwqcKETVP:BRWZaekrspgceNNZalu{€ˆŠ¿ÿÿÿÿÿÿÿÿÿÿÿÿÿüùýÿÿü÷ùþÿÿÿÿÿÿÿÿÿÿüðíóûûøõóðïìèéééçäÚËÐàâáÞÞàâåíô÷÷ù÷óëêìò•DXWDAF&2B56?>3/%";DJOPP) MSJE CU:(-@YX\VB!J{tqyZXncHjU+,[QL8(??NLGGGMWZ]]XQKLPVW[YMCm|†poƒsWQUWWV\`fkli_]Šž•«Œ]\\[SQRqŒ“šŽŠ„xtsqcbd[RUWZT\fovwvrl_@,Ladksv{|†¤ôÿÿÿÿÿÿÿÿÿÿÿÿ÷óùþÿü÷õøþÿÿÿÿÿÿÿÿÿüñìñùüùóðíëçåáâäãàÕÑ×ÝÜÛÚÛßáåïö÷ùúùôìèçë„]A(&3OONQM;@ytrY"[mc -OdD&GUOF=.3MMDILNSY[]\YTONPTW]`AIs‚zompdXRSVZcopl`LKZŽÄÉÛéÈfZYUOKO\r˜œ¤¥€jliktvyxxkX^Q>Xty|zyoT/!@chimptum€—ãÿÿÿÿÿÿÿÿÿÿûùóðøüÿþúôòúÿÿÿÿÿÿÿþÿûòëðøúúõïéæâÜÚÙÛÝÚÒÐÕÕÔÔÕØÝáçðõøøùøöïèíàj>IOIB@? <7 (=:2 >HKKI1IUN53UR ":HLHIMI E}~|oa' -*_oVFXH/ DSMHB297Q7;MORWXZZZXVTTTVX_aCMuˆpifa^\XUZaippjO51\½ÔáëèÕhKKF@@CMSbƒ•™‚JE^cekwx{¬ÃƒeSRq~~~l9(Lhijnopssm}”ßÿÿÿÿÿÿÿÿÿüõïîðöûüþúôðõþþÿÿÿÿÿþþüòçë÷üú÷ñèäàÚ×Ô×ÖÖÓÑÔÒÏÍÑÕÜãêðñôöö÷óíåê¼V>BFCA?=$0B-&993 $?LKKG=TV$ -8Tc45EBJL;EM7  Kw~}kU) ,bpX.12HSH*GUVHD7%0@FG3EORRVXWWXWUSUVV[_X5DIL?4LXXTVWVVVWVTTQS[cX#,xŽme]TRX[`bWSR7""7sÕêðöõì›- !$+Idlpqnk~äôîâÍ°Ÿ™Š{S:Py|xtmc^enqtv€ŠÍÿÿÿÿÿÿýúùôòïððôùûûþøïìòùüþÿþþþüûóæåòøúú÷ñîíïìæÝØ×ÖÔÑÎËËÍÑÝèïïðéæíîéåÝÉkM85DFA;7( -82+6/ - #DGJH#)MZ4QY?:TZblJ=JP6 LktneU >tnou] /U]G/I[e=44B?LNC2:V]`\ZZWVVWWSQNS\igB:q†zgYPLOW[XPKI'$7HRpÀðñôøöÅC#"#/647Uhsvtnf“ññìçèæàÝÓÇ ††€{wugQLZjmquƒ‹·ÿÿÿÿÿýûúú÷õõ÷ó÷øüúýùòëíòùüýüüûüúòåäñ÷ùùøöõñðïîçàÜÚÖÕÐËÊÍÓàéîîíßØààÞáÝ·T61=RIC>9* -"3, ,5 CEHG$ MZ& MU?/Thpp]KMPHHntibO -_\LP_e9$9DDG>,6T\_cd`^ZWVUVVVVZcpjZcy~tYMIHNUSLCD5!6FKTc{µïööÿÈYC><;;:9:=?=4/Ohvxtkc¾øñìèåçæåäèêáÑÅ–vngZVaggfqˆŽ§õÿÿÿÿþüûüúùùûùúýûûýúôëéîöùûúúùùøòçâîöùùö÷÷õñðîìèãßÜÚÓÐÍÐÖàëîîëä×ÔÖÝãߧP11?aNED=' ,-%>+  8MKC H^)JUB4]grug[TPO0,>kqfcJ:iojvJ!3biZWag1@IHD:EUTOYdfb_YVUUVYZ[`etqRamlbPLHKLFB?2+1@DLWeoæùûÿëxUPIHGDB933/"+^xxwksàôïêéèëéçæéêèèèÖˆdfeffdddt›ëÿÿÿÿÿþüýýþÿÿýþþüüýúöîçéðöùø÷÷øöòèáêö÷ø÷ùø÷ôóòðïêéåßØÓÑÑØáéëìêçßÔÔÜäÛ‘Z337ZVFD<$9%853PJJ"  D](O]C8^epwkb\UTOB@_lggE.jpilI"Cemd^cg.@KJEE\XC 1OQTgw}„‹†ticZRPRX]\_o~w[TLHGH:3Foy®÷ôLID@GORRUW^eirzzv¡ÓÑÔÔÕÚæïñðéãÞààßÙ×ÕÎyHDLWbqz…¬çíñöøúÿÿÿÿüýýýýüüýüúù÷ðéãæíòôóóñðéÝÞêñôòððîíîíííïîìêåàÛÙÕÕÚáåèëííîêè€bIEDCB@PZA&JZca@ :fnoM W`D`T;:9! ".:=;3F@$'i‰„|m_UTSSWZbdœ‘ˆrJJB7-&#/EKTZbXU`e]J25Xvz}´íªMD@?IRTTZ_chku{st·ÜØÚÙØÜãêêêåååãßÜÛ×ÐÅu@.5VlvzÃééîòö÷úýþÿÿûüûüüýûùùúöôíåãèñññïïìçÛÜæîñðîíììîìëìîîììçâÚ×ÓÐÒÙáãêìïïíércLEA?@=DcWA6FP_hl\H:&1UhhK#)D7&MVF:<9%$49<^kF661,++.110$4{‚mYRQRUXYcpˆ¬»½žbKC:1*)4MHEX^aZY``C!#Pnx~¼­RC@HPRUW]cehkrwprÁÝÛÚÙÙÚÝáâääåæäâÜÚÐÀ³k:*(LotyÛæéîïòñóõ÷÷ùöøøùúúùùø÷õóîçâåììëéìèãÙØâêîëìêêëêìëìíëêêæâÛÖÏÌÎÔÞäèìïðïëf]PJ@=@B@Sf`L848=ISR:28A@2+))# +0;=;/ !7?>" -$89=A?6!6][[UK43EL@@3%&&Kd?750)&(,"&@MB,P~znXSRPUZ\dw¹ÊÅÁ®—yB317EREI^ddb_`R%:V^`bflxŒ‰RGIMRSX]afiknuuol¯Û××ÕÔÖØÝÝßßâäãâÚ×ÐÀ¥X>50Knu|²ççëìïñíïóóóóïññòóòòôóòñðïèáàãäãäçåàÖÕßçéæçèéçèëìîíìêèäãÛÔÍÈÉÑÜâèíðñðê]WOLB;CMJH[qA(-+&%0/16#&!  ";>:/)0;:8/ .9=A>=Ppu‚ÊåæéîîîïðïðîïììîîîìíííìíîíçÝÙÚÞàâââÝÔÔßåßÙáçæåæééêêêêèäãÜÔÊÅÆÍ×âêíññïêVTMF>6<;7567 -L81$?‡€‚ƒ~yuodZUSUZ^h‡¯·ºº¼ÀÁ¾¾ YFF">bfcdeW(*UUMFYu‡‡ˆŠh@BFJOX`dgnqvwrpr„ÄÒÐÐÕÕØÙÙÚÛÜàáÝÙÓÎÇŸZMJPdwxÔäèìðïððñððîîíìêèçæäåæçêëèåÝÐÑÖÛÝßßÛÓÐÝÞÏÈÛãââãåçééêéêæãÞÕËÃÅÊØâëîððîêPRNB8:CIcžkkÖbJ7=95/*;M+ #&*.*$#!7EJIA<87888.AC?* Ç©^N5"!#%),9E<+$%*,O€‡…tiaYWTW]_h‰³·¹º»¿¿»¸¼²f:6[cdabW Qb^^gqz„„~€‡…[BBHNW`bgpvxwppws…²ËÔ×××Ø×ÙØÛÝßÚ×ÎÉÇ¢WQT]kx~ØâåëîïîïñððïêêèåãàÞÙÙÜßàãããÜÍËÒØÞáàßÖÑÙÙÎÏÕàââãâãççèëíêæß×ÌÅÂÇÙãêïñïíèOPNA5:CI“Û¸V™Ô»™|{wwidiR4 "(-5:==>CPWJ?<;>?@#"6@.^Ľ‰LA1 #&(*3B=+$%%&%$')K‚„‰Šƒqa]XVWZ]do”¯±³¶¸º»¹¹¹¼Ÿoeaccac5 .Wklmtxwx{{vw~‰xMBGPY]cipw{vklswxŠŸ¾ÔØÔÓÔÕØØÚÛÙÓÉÅŧWRV]lƒ¯ØÝãçëíïïïîîêéäãâßÞÛ××××ÛÞààÜÐËÒÙßãâàÙÐÖÖÒÙÖàáãääåæèëìíëçà×ÌÅÃÇÖãëïðïîéOOLFACCa¾ÒÔ†YºÍÊÊÁ¸¹¾¨|I2 !-5:=@=8@RNC>>>AA. $.5'1– ˜hH: #%%&(,8>8)#')&&+-G}z{‡ˆ|g[XUUX\aiœ¦«­®²´··¹º¹¹´™ocb\>!?gmkio~~yvu|„ŠˆyVAFS[^flquythgnot„Ž“¤ÁÎÏÏÏÐÑÑÓÒÎÇĵ~ZXbq“ÂÕÚÞãæçêäÞáãâßÛÛÜÚÛÛÙØÖ×ØÚÞàÜÔÍÒÚÞáââÛÑÖÇÃÞ×ÝãååæçèéìíìíêàØÌÇÄÇÔâìïðïíéLOOIHIL›ÍÌÏÂ\xÍÇÆÉËËÎÆi6)  ,0 ,7=CC78OMF?=<<:63./0.d†}[>.$'))%&'(,6>5'')&*00N{vbe„rb\TQSV_gnŽ˜šš¡¦©¤¤§­¯¯´²¯ž}b33Vhmqon}ˆ„zjr…ŽŽz^IOX[`gkmmtqg`ehfˆ·À±œ®ÄÉËÈÊÊÌÍÈÿ¹²®‹gi|“²ÆÉÔ×ÝàáÝÓÍÔÙÚÙÚÚÜÞÛÝÜÙØÙØØÚßÝÖÐÐØÞãåäßÖ×ÃÆãÔ×äèèèêéëëíììëåÜÐÈÆÆÏàêïîîìéMONKJG_¹ÁÄÇÌžR ËÄÅÊÉͯI( ";4%  -@HKOLKHA=:2);D=42/!@†ƒtL6.,.,)&%&(-7?5**(.22X}x]BpiaZSPPQ\fqŽ‹‰ŠŠ††ˆ’—œ¢žžŽj,)Ykqsrvƒ€|€xho„Œ‘”xZ\]]^cfijmrcW\bj»åå缡¶¿ÅÂÂÅÆÈ¿¸³®ªªª¡¦±·¾ÃÉÏÕ×ÙÓÎÐÓ×ØÙÛÝÞààßÝÜÛÚ××ÙÝÝÚÔÓØàææåâÛÚÆÐèÜÛæêééêììëëìíìçÝÎÈÆÆÍÛèìííêèNNJHGF¾º¾¿ÃÄt_ÁÇÇÇÉψ> ,4562% - FYSNLJC>;0)Ymj\RF;(+oˆ…oK840.-(%#"&/9B;-.=>@dzmHWdcXSQNOTaq†‡ˆ‡€}}€Š‘‘†qm`FMdnpqou|vt{{pp}Š”•”|b`\^acdjs{}”¹ÃÈáæçèر·¾Çǽ¹µ­ª§¦¦¤£©«ª­¯±´¸¿ÈÑÕÖÔÓÔÕÙÚÛÝàááââáàßÛØ×ÙÚàÜ×ÖØâëíêäßÛÍÙéæãåçéçêêëêìíîëéáÏÇÅÆËØæìììéèNJCA?T¨¹·¶¸½Ä²NŽÑËÌÍÀ\:+,-5893.( C_WSPIC?>;Olnmig_\XPE?:MguƒvT?53573$",2CPKGADKr‚zrg[_]VTRMKNYz‰‹Šˆ…†‡‡‡‡ˆŒ‘’‘Šwijmnnnrsqsuuvywpv€Š‘—˜•‘v_ZZ[Y`Œº×îùöôïêîîëêàÙÙàáÙ¿“ŠŽ‰Žš¢¨«­®±²¸½ÇÐ××ØÝÜÞßáááâáââääââàÛÙÙÜàáÞÙÚäììëæßÚËÙêçåææêçêêëëëìíìéâÓÉÈÆÊ×æêììèçGEA>@¹¶¶¹º¾ÆшS¼ÓÏÒ¦C79;2)(.587634BIW_YTOD@@BJirqonljgefda^[\_mwohTEUf^ZH6:FJQTWWNEKs{vspf\YTRPNLL^…‹ŒŒ‰Š‹‹ŒŽ’’“””„|ropuuspppotxxyˆ‹’˜––•ŽvdYRn¼ôýÿúõðîìíðòðíììëìíïçdz«¡œ «³µµ¶¸¸·¼ÂÆÎÙÝÞàäããåäåäåäãåääâââàÝÜÞáããÝÙàéìêåÝβÓìçççèèêéëêëíììíêä×ÌÈÇÉ×åêêêçæDC@:j¶¼¼¼¿ÃÇÍÐÇU{×ÐÓ•A;!EF(+,058'/GF$ *)+8>DMScz€…‰Ž“–›—•”‘“’‹ˆ†‡ˆ‰Š‰Š‹‰‰†…€~„‚‚~}yvqjfefb_VYf^`iie\VROMOS]yƒ††‡†‡‰ˆŠ‹‹Ž“•–——–—™—‹{ytoifjyƒ„‰ŠŠ”™šŸ ¬ÈãùööõöûùöïêéìòööõóóòòðîîìåâÝ×ÑÎÊÈÄÄÄÄÅÊÍÏÕÚàâäåæåæäãâáßÝÞãååäæèçåâäçéäÝÛáëëìÏ­×ìíííììííîííëëìêëëèÝÒÌËÎÕâçêéèæA?b±ÆÆÄÅÆÉÍÎÒṈ̃SV‚tOD<@JLA" +7?OZv†‹ŠŒŽŽ’‹‹Š‰…‚„‡‡‡†…†‡ƒ€~|„„…‚‡„ƒ‚}}‚}zz\MZbeb^XTRNQUax}~~‚‚ƒ„†ˆˆ‰Œ‘”•——™˜™—š™“‹ƒ{tifqŠ’¢²¾ÉÕÛÞäî÷ú÷ö÷ø÷öøõñìææìñ÷ö÷÷÷öôôòòñíèâÞÙÙÖÑÎÎËÌÎÏÒÓÙÚßáåãæåäââáßßÝàáäçèêíîìêêêëéäßãëðèÃÆéïñððîððððïîíêééééåÜÓÍÌÍÒàåççèèCBz©£¢¡ ¦®±°­£—rFm~x`LKJHT`?#.1/AYs}~‚…†‰‹Š‰‡‡‡‡…ƒ€€ƒ„„ƒ‚€}xy}~€‚€ƒ‚~€€€]G]gd_]WRNMPUcrxvvv}ƒ„†ŠŒŽ‘”––˜˜™˜šššš™–’Œ‰–¢¯ÃÚëùÿÿýýùùøôöúùúúùøõòîçäæëðö÷öúù÷õõööôðíéåâáÝÙ×ÕÓÔÖÕÓÔØÜßàäååæäââßàßßàãåêìîððñïìììëæÜáëí×ËÕæïðññóñðñïííìééèçåâÝÔÏÌÌÒÛãèæäçGMbmiovx€‰”—˜˜™oU…–™“y~ŽyC*(9@8*-O_jmptx~‚„ƒƒ„…†„‚}~€‚‚~}y~‚…ˆˆ†„‚‚†ƒ~}|zaI[b^]cpxz|q~£³²­ªž…„‡Œ‘’–™›š›š›››œœœ›œœ ¨±»Ïåóööøûüúø÷÷õõ÷÷öõõôòðìéåãèíðóôõøø÷öö÷ùøöðìéæåäáÞÛØØÖÕÔÖØÛßâãååååããáàáàßãçìíðñôóñïìêëåÞßäÙÑØÙåððððñðïïîëëèæææææâßÕÑÍÎÎØáäâã憖ž¤ ¢¨«¬¯³¶·µ¶µ³ªZZ¤²µ´²±±¯²®¤˜’…{xqty}€‚„ƒ‚€€‚ƒ‚ƒ…‚†™œ¡£¤ž–Œš§±·²°¬¤œ•“—›™•––“‡{†•ž§·Í×ÛÛÔÕÜâåçåäÜͶ¨Ÿ žžŸ   ŸŸŸŸŸžŸ¤«¹ÉÙìôóóòóöööøøóöóóòñðîííììçâããèîñòòòõ÷÷÷õ÷ùøõóíëèæçäáßÛØØ×Õ×ØÚàáâåäææãåääãâááåêííïððîìêééåÚÖÐÒáßÚâìñïïïïïíìééåääåååäà×ÑËËÍÔÜààãå±²²³³´µ¸¹º»½¼¼º»¹º•S¾»½»»¼¹¹»»½ÀÄÆÆÅÃÂÃÃÁ¾¼º¶²®¬ª¤¢ž™•–”Ž“ ®³¸¹¼¼¸ª¤»ÁÀÂÃÄÇþ···¿ÂÂÃÆÈÈÊÏÒÖÙÛÛÛÜØÚØÛáãäãâãæçãÛÓÐÍÉƼ¹¹¹ºµµ¾ÅË×åîòóõõóñðñóòòóòððððïîíîííëèåãáäèííìîñóôñòóôöõñïìéçåææãàÜÙÛ×ØÙÚÜßáåææææåäääããàáåëíìîñôñîëæçäÚËÄßéäÛâîïïîíìêéèæååâãäãåãÞÖÍÈÉËÒÚÝßàã·¸¹¸º¼½½¾ÁÂÅÅÅÅÇÇÉʾ¾ÈÈÊÉÇÇÉËÉÇÇÈËËËÌÌÌÍÌÎÐÑÐÐÎËÍÍÊÅÃÁÁÀ¹¬¨«°´¸¸¼º¸¬±ÉÊÊËÌÊÍÈ¿ÀÄÉÊÈÉÍÍÎÑÑÐÓÖ×ÙÛÛÙÙÚÝßáããäãääåææææååãÞÜÜßáäéïïðòòóóóôòïíííïîïïïïïïïðîìíìíéæããâåèêëêéëíìëíîîñïîëèæåãââÞàÞÜÜÚÛÜÞááäåççææææäæåãáäæêìíîïóòïëåæåÚ¹ËëìáÙàìîìíìéèçåâäãâááâãâÞÖÌÅÅÉÏ×ÛßÞäÇÆÇÈÈÊÉÈÊÌÏÑÏÍÑÒÐÔÓÖÔÒÕÕÖÔÕ×ÚÚÛÝÝÞÞßááâããâââààßÜÚÙÕÔÕ××ÔÔÌ¿ÆÈÉÅÅÁ¼¬ºÏÍÏÑÑÏÐËÅÃÄÊËÍÍÍÎÏÏÒÔÕ×ÙÙÛÝÚ××ØÝàãããåååææéèæåââããáãæèìíìïííîñôïðííëììêéêëíîîîïîíìëìêèæãåæèêêéçççèèéêêéììêéææäâáàßàáßààßàáãææçéçææææçæèæäåèéìíîñðòðíêæ㽤ØæêàÙáéëëêéçääãâàáâáááâáßØÎÇÆÆÌÓÛÞÜãÊËÌÍÏÍÌÏÑÓÓÖÔÓÖ×ØÚÚÚÛÜÙÙÛÛÝÝÝßáãâããâããåçææäåãããááßÞÞßßàÞÜÙÒÏÔÚÞÝÙÑdzÉ×ÕÐÒÒÒÐÊÅÃÆÌÎÐÐÑÒÒÒÔÖÕØÙÚÙÙØÖÖ×ÛÞááäåçççéêêæçææåææèëíìëëêèëíîííìêéèéêèçèëìîíìíììììëêèåææéêêéççèçèçêììíííìëìèåãââßßáàáàáãâäåéèêèæææçæçèçåæåéêìííðñðîìèαÅÙäåÜ×àééêêçææääâáááááâáààÙÐÈÅÄÈÑØÝÞâÌÌÊÌÍËÌÎÑÑÔÕÖÕ×ÚÛßÝÝÞÝÝÞàßßáâàââãââäããäâââãâáßàßáááàáßßâßÛÕÒÔÛàßÞ×ÍÂÓÜÛØØØ×ÕÎÉÈÌÑÕÕÖÖÕÖÖØ×ÖÙÚÛØ××Ö×ÖÜßáàâæåææçèéçêêêêêëëíìììèèæéìíëêçäæåçèæçæèêììíïíîíëíêèåæçéìëèèçççèçëíîìíïîîïëèåäãâààááàáãåèêëììêéèéèåæéèæåäçèéêíððñíî×µÅ×ÖàáØÔßèèèééçæåääâààáââááßÙÑÈÄÆÊÒÙÝÞâÆÈÇÇÉÆÅÇËÌÏÏÏÒÔÖ×ÛÝÝßÞÝÞàßßàáÞààáàáâàÞÝÛÝÜÚÛÛÜÝÝßàááááßßÝÜÕÏÒØßßßØÏÎ×ÜÚÛÜÛÚØÓÎÎÒÙÛÜÜÞÝÝßßÝÛÜÛÞÝÚØ×ÚÜÝàáàâææççèëìêìëìëëîïîíëëèèæèëìëçåããäèêçèèêëíîñòòñïììëèççèëëéåäçèêêêëïïïïïóóñîêäâäâàßààáãåæçëëîëêééççååååääãâãæêìíííìܼÇÕÕÖÜÝÕÒÝçççæèçåääããááââáäãâÝÔËÇÇËÓÚßàäÂÃÀÂÅÃÂÂÅÉÍÎÎÍÏÑÔÙÜÛÜÚÚÚÚÛÙÚÚÚÜÛÜÝÞÞÝÛÙÚØÙÙÚÚÜßÞÞàãáâáßààßÚÓÓÙßÞßÙÓÔØÝÝÞßßÜÚÔÓÕÚßáãäååæãâàââáßÞÜÚÛÞààßááäèèêììîïñôôòïðòòðïîîëêêëîïíêåâåèëìíííìîðòõôõòîíìëéåçèéçåâäçêîíîîïðòóóõöôîìæâáàÞßààßâáäåéêììêçåæäãäãâáàßÝßäèééèéÛÁÏÞÙÔÔ×ØÒÐÞèéèééçæåãäåääæéèçåäßÕÍÉÈÊÓÚàßâÀ¼¼¼¶©«»ÄÇËÍÌËÍÏÑÕØÚØÕ××ÖÕÔÓÔ×ÙØÙÛÝÝÝÝÜÝÝÛÚÛÞÞààààâââââáâãÝ×ÔÖÝßßÛ×Ö×ÜßàáàßÜÖÔ×ÞâäæçèçææåçééæáßÜÜÞßàâááâæèéìíïòóôõööõòòòððñðëììíòòðíèäæëîðññïîðññóõõôññîëéèæçèççæèìîïñòòññôôõõöôïìæäáÝÞÜÞÝÛÝÞßàäçéêêéååäãâàÞßßÞÝáãèéêêßÆÎçâÚØÔÓÏÎÑåèëëêéèçèèèèççæèêèåäßÖÍÈÅÅÏÖÛÞá¹»´££¢¨¼ÅÇÊÌËËÌÍÒÕÖ×ÕÔÖÖÕÖÔÔÖ×ÙØØÚÜÜÝßááááààßàãâåãâãâáâãäâßØÒÒÙßßÛØÖÙßàâãááÜÖÖÚáåçééêêêêìíêëéåáßàááâãáãâååéëîíðóòôõõôóððððññïïîïóöóîêçêîòóóòïïñòòôö÷ùöñïìëìêêìëìîóôõóóóôôñññòóòñíêãßÝÚÚØØ×ÖØÙØÜàæèêéèåæåääáÛÝáááâæêìïçÊÐêìåÝÖÓÑÌÊÒçéëíëëéèêééèçççèéåæâß×ËÆÄÄÊÒÚÝ⺺³§µÁÂÂÅÆÈËËÌÎÐÓÖÖ×××Ø×ÖÖ×Õ×ØÚÚ×ÙÚÝÝáááááãâàããåäæäââááàáãáÛÒÎÒÚÞÜ××ÚßâãäããÝ××ÜäèêìììëìííííìêæâàâääåãââáâäæéëëìïðññòðîííïññòñîîîñôðíëéíïôõöôòððòõöúüûùòðîììîîïðòóöøöõóòóïîîîïðîíìçâàÚ×ÙÖÔÓÔÕ×ØÛâåèéêëéèêêèäÞáâãããçëíëÒÐèîìèßÕÕʽ¿ØèêííëêééêêéçäåæçæããâÝØÊÄÁÁÅÏ×Ûỽ¿ÀÂÃÄÄÅÇÊÎÎÎÑÒÔÖØØÖ×ØØ×Õ×××××××ØÙÚÚÝÞÞßàââáâããäååâââááãäâÝÔÎÑÕÛÜ×ÖÚáäæèèéåÜÝäêíïîðîïðññïðíëåãäçèëêéèçææååèêêíïïñïñîíîíïññðíîëëíðñîëííòõö÷÷ôóôóöùýýüùòîêèêíïñõ÷ö÷õôôñïïííìîîììîëèãßÜØÕÕÓÑÓÔÕØÛâäèêëëëëêêéæåäääâáåêìåÖæìììéáÙÔ¸¢½äëììëììêìêéççæçåååäãàÞØËÁ½»ÁÊÔÖÝÁÁÃÃÄÇÈÈÇÈËÐÐÓÔÕÔ×Ù×ÕÕ××ÖÖÕÖÕÔÔÔÖÖØ××ÙÛÛÝßàáááââãäãââáâãääâà×ÎÎÖÞßÚ×ØÞãèìëêæÞÞãêìîîïïòòóñóòïéåçìíîïðòðîíìéççéêìïðððïìîììïñòñíêééëïííëíðõúù÷÷ö÷ø÷úýþüü÷îêååèëîôõøöõòïîíëëêêíïîìîîìêæáÜØ×ÖÔÔÒÒÒÔ×ÝãèçêëêêêêêççååãàßàæìëéììïíêâÚÒªžÎéèëìëíìííìêêêêèèçèæääàÛÎÁ½¼ÀÇÑÓÚÀÀÂÃÆÉËÌÉÉÌÒÔÒÔÖÕÖ×ØÖÖ×ÖÖÔÔÓÓÓÓÓÓÔÕ×ÙÛÜÝÜßßáßÞßáâäâááâäååäãáÙÎÍ×àáÝÖØÝâæèéèäÜÚáçëììëíðôóóóñêæåçêïïòôôòððíêèèèéíïðññïíìîíðððñíëêêêíëêììðôøø÷ùø÷öøúüýûúôëèæææêîñôõöóðíîìëêêëìïïîðïíìéãáÝÚØÕÔÓÒÐÕØßãææééèêêééêéèçãßÜÝãêíììîîíëäÜÈž§ßêééêíîìíìíìêéèçéêëéçäâáÔÆÀ½ÀÈÐÔÙ \ No newline at end of file diff --git a/components/vampireimaging/Demos/Data/Tigers.png b/components/vampireimaging/Demos/Data/Tigers.png deleted file mode 100644 index 30a9128..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.png and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.ppm b/components/vampireimaging/Demos/Data/Tigers.ppm deleted file mode 100644 index e013247..0000000 --- a/components/vampireimaging/Demos/Data/Tigers.ppm +++ /dev/null @@ -1,253 +0,0 @@ -P6 -257 -189 -65535 -ÏÏÜÜÜÜÐÐÜÜÜÜÑÑßßßßÕÕââããØØããääÝÝääççÝÝääççÞÞççééßßèèêêààééëëááêêììÝÝææééØØááããÔÔÝÝààÔÔÝÝààÕÕÞÞááÕÕààßßØØââááÚÚääããÚÚääããÚÚääããÚÚääããÞÞççææááèèèèææììììëëòòòòïïööôôîîõõóóïïõõóóððôôóóòòööõõôôùù÷÷õõúúööööüüøøùùþþúúùùüüùùûûþþúúúúÿÿûûúúÿÿýýûûÿÿÿÿüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüþþýýûûýýüüøøúúùùõõøø÷÷õõøøööõõøøööúúüüûûýýÿÿþþþþÿÿÿÿþþÿÿÿÿüüÿÿýýúúýýýýööûûüüööûûüüøøüüýýüüÿÿÿÿùùÿÿÿÿööÿÿÿÿøøþþþþööüüüüõõüüüüôôûûûûóóúúúúññ÷÷øøòòööõõññõõôôïïóóòòííòòóóééððððååïïîîääððîîÎÎÜÜÜÜÏÏÜÜÜÜÑÑßßßßÕÕââãã××ââããÛÛããææÝÝääèèßßèèêêßßèèêêßßèèêêààééëëÜÜååèè××ááããÓÓÝÝßßÓÓÜÜÞÞÔÔÝÝààÔÔßßÞÞØØââááÙÙããââÚÚääããÙÙããââÙÙããââÜÜååääßßææææããêêêêééððïïïïõõóóîîõõóóîîôôòòïïôôóóññõõôôóóøø÷÷ôôúúööööüü÷÷øøýýùùùùüüùùûûþþûûúúÿÿûûúúÿÿýýûûÿÿÿÿüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþûûýýüüùùûûúúõõøø÷÷ôô÷÷õõööùù÷÷ûûýýüüþþÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿþþúúýýþþööûûüüööûûüü÷÷ûûüüúúþþÿÿùùÿÿÿÿööÿÿÿÿøøþþþþööýýýýõõüüüüôôûûûûóóúúúúòòúúúúóóøø÷÷òòööôôññõõôôîîóóóóììòòóóææññððååððîîÏÏÜÜÜÜÏÏÜÜÜÜÒÒßßßßÔÔááââ××ââããÛÛââååÜÜääççÞÞèèêêßßèèêêßßèèêêßßèèêêÛÛååççÖÖààââÒÒÛÛÞÞÒÒÛÛÞÞÓÓÜÜßßÔÔÞÞÝÝÖÖááßßÙÙââááÙÙããââÙÙããââÙÙããââÜÜääääßßææææããêêêêééððïïîîõõóóííôôòòííôôòòííóóòòïïóóòòòò÷÷õõõõûûööööüüøøùùþþúúùùüüùùúúþþúúúúÿÿûûùùÿÿüüúúÿÿþþúúÿÿÿÿûûÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþÿÿýýýýÿÿüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüþþýýøøúúùùõõøø÷÷õõøøöö÷÷úúùùüüþþýýÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿþþúúýýýýööûûüüõõúúûû÷÷ûûüüøøüüýýùùÿÿÿÿ÷÷ÿÿÿÿ÷÷þþþþööýýýýõõüüüüôôûûûûóóúúúúôôûûûûõõúúùùóóøøööòòööõõïïôôôôííôôõõééôôóóååððïïÍÍÛÛÛÛÏÏÜÜÜÜÑÑÞÞÞÞÒÒßßààÕÕààââÙÙááããÜÜããææÝÝççééßßèèêêÝÝççééÞÞççêêÛÛååççÔÔÝÝààÓÓÜÜÞÞÒÒÛÛÝÝÒÒÛÛÝÝÓÓÞÞÝÝÕÕààÞÞ××ááàà××ááààÙÙããââÛÛååääÝÝççääààééççääîîëëééòòïïììóóññììóóññêêññïïììññððîîóóòòññööôôõõúúøø÷÷üüúúùùýýüüûûþþüüüüþþüüüüþþýýúúÿÿýýùùÿÿýýùùÿÿýýúúÿÿýýúúÿÿûûûûÿÿþþûûÿÿÿÿûûÿÿÿÿüüÿÿÿÿþþÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüþþúúûûýýúúþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûýýüüøøúúùùõõøø÷÷÷÷ùùøøùùûûøøüüþþüüÿÿÿÿþþþþÿÿýýýýýýüüüüýýûûùùûûúúùùûûûûùùûûúú÷÷ûûúúøøþþüüúúÿÿþþùùÿÿþþùùÿÿýý÷÷ýýüüõõüüûûööýýûûõõüüûûõõüüûûööûûúúõõúúùùôôùù÷÷òòööõõïïôôóóííõõóóææññîîÊÊØØØØÌÌÚÚÚÚÏÏÜÜÜÜÒÒßßßßÔÔßßààÚÚááääÛÛããææÜÜååèèÝÝææééÜÜååèèÛÛääççÙÙââääÔÔÞÞààÓÓÜÜßßÒÒÛÛÝÝÒÒÛÛÝÝÓÓÝÝÜÜÕÕààÞÞÖÖààßßØØââááÜÜççææááëëêêááëëééââììèèääîîëëææððììêêññîîëëòòïïêêññîîêêïïííííòòññòòööõõõõúúùùúúþþýýûûÿÿþþüüÿÿþþýýÿÿþþýýÿÿÿÿûûÿÿþþùùÿÿýýùùÿÿýýùùÿÿüüùùÿÿûûùùýýüüùùýýÿÿùùýýþþùùýýþþûûÿÿÿÿûûÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûûûýýùùøøúúööûûýýúúþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþúúýýûûøøúúùùõõøø÷÷ööùù÷÷úúüüùùýýÿÿüüþþÿÿýýýýþþûûüüüüúúûûûûøøúúûûùùùùûûúúùùûûúúøøûûúúùùýýüüúúþþýýúúýýüüùùýýüüøøüüûû÷÷ûûúúøøüüúúøøüüúúøøüüûû÷÷üüûûõõûûúúôôùùøøôôøøööññõõôôííôôòòææññîîÅÅÓÓÓÓÈÈÖÖÖÖÌÌÚÚÙÙÏÏÜÜÜÜÑÑÛÛÝÝÖÖÝÝààÙÙááããÚÚääææÚÚääææÚÚããååÚÚããååÙÙââääÙÙââääÖÖààââÕÕÞÞááÖÖààââØØââááÙÙääââÛÛååääÝÝççææââììëëååïïîîååððííääîîëëââííêêääííêêèèîîììêêññîîêêððííêêîîííííòòññóóøø÷÷ööûûúúûûÿÿþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿûûÿÿýýúúþþýýùùþþÿÿúúÿÿÿÿúúÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþÿÿúúùùûûööõõøøôôööøøõõúúüüùùýýÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿûûýýüüøøúúúúööùù÷÷ööùù÷÷ùùûû÷÷ûûýýúúúúüüùùüüýýøøüüýý÷÷úúûûôôùùûûøøùùûûûûùùûûúúùùûûúúúúüüûûûûüüûûúúüüûûùùûûúúùùûûúúúúüüûûúúüüûûúúûûûûúúüüûûùùýýüüööûûúúõõúúùùõõùùøøòòööõõïïööôôèèòòðð¾¾ÌÌËËÂÂÐÐÏÏÆÆÓÓÒÒÉÉÖÖ××ËË××ÙÙÑÑÛÛÝÝÖÖÜÜààÙÙààããÙÙààääÛÛããææÛÛääççÚÚããååÛÛääççÜÜããææÜÜããææÜÜããææààèèèèââêêééääëëëëååííííèèððððëëôôóóììôôóóêêòòññææîîííããëëêêããììééååîîëëççððììêêïïííîîôôòòóóùùøøùùýýüüýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüÿÿÿÿûûþþþþüüÿÿþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüýýøøööøøôôóóõõòòôôööóó÷÷ùùõõüüþþûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüþþýýøøúúøøõõ÷÷õõööùùöö÷÷ùùõõùùûûøøùùûûøøúúûûõõûûüüõõúúûûôôùùûû÷÷ùùûûùùùùûûùùùùûûùùùùûûúúúúüüûûùùûûúúøøûûúúùùüüûûøøûûúúùùüüûûùùüüûûùùüüûûøøüüûûööûûúúööúúúúôôúúøøòòøøööðð÷÷ôôééòòðð»»ÉÉÉɾ¾ÌÌËËÂÂÏÏÏÏÃÃÐÐÒÒÆÆÒÒÔÔÌÌ××ÙÙÑÑÚÚÝÝÖÖßßââÙÙááååÛÛããççÛÛääççÜÜååèèÞÞææééââèèëëããééììããééììææììììééïïïïëëññòòììóóóóîîõõõõññøøøøòòùùùùññøøøøïïõõõõêêññððççîîëëççïïììééððîîííòòððññööôôõõûûùùûûýýýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþþþÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿúúøøúúööõõ÷÷ôôôôööóóööùùôôúúüüùùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûýýûûööøøôôóóõõòòôôööóóõõøøôô÷÷úúööøøúúööùùûûõõúúûûõõúúûûõõúúüüøøúúüüùùúúüüùùûûýýûûúúüüüüúúüüûûùùüüûûøøýýüüøøýýüüùùýýüüùùýýüüøøüüûû÷÷üüûûööûûúúööûûúúõõúúùùôôúúùùòòùùööððööôôêêòòññººÇÇÉÉ»»ÈÈË˽½ÊÊÌÌÀÀÌÌÏÏÃÃÏÏÑÑÈÈÓÓÕÕÌÌ××ÙÙÓÓßßááØØããææÝÝèèêêÞÞççééßßééëëââëëííççììððééîîòòééïïòòëëòòòòïïööõõññøøøøòòùùùùôôûûûûõõüüüüööýýýý÷÷ýýýýõõüüüüóóúúùùòò÷÷õõððõõóóññõõôôòòõõóóööøø÷÷ùùüüûûûûýýüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýþþûû÷÷ùùööôô÷÷óóôôøøóó÷÷úúööýýÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúüüúúôôööóóññóóððòòôôññóóööóóööùùõõööùùõõøøúúôôúúûûõõûûûûööüüþþúúýýÿÿüüýýÿÿûûþþÿÿþþýýÿÿÿÿýýÿÿþþûûþþýýúúþþýýúúþþýýúúþþýýúúþþýýùùýýüüøøüüûûööûûúúööûûúúööúúùùôôúúùùòòùùööððööôôêêòòññººÇÇË˼¼ÉÉÌ̾¾ÊÊÎÎÀÀÍÍÏÏÃÃÏÏÑÑÈÈÒÒÖÖËËÕÕÚÚÒÒÞÞàà××ääååÝÝééêêààééëëääììîîææííððëëññóóííóóõõïïõõ÷÷ññ÷÷øøóóúúúúôôûûûûõõýýýý÷÷þþþþøøþþþþ÷÷þþþþøøÿÿÿÿööüüýý÷÷ûûûû÷÷ùùùùôô÷÷õõõõøøõõõõ÷÷ööøøúúùùûûýýüüüüþþýýýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþûûýýùùööùùõõôô÷÷ôôööùùööûûýýûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþøøúúøøóóôôññññòòððòòóóññõõööóóøøúúööøøùùööùùúúôôúúûûööüüýý÷÷þþÿÿûûÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÿÿÿÿüüÿÿÿÿûûÿÿþþûûÿÿþþùùýýüüøøüüûû÷÷ûûúúööûûúúõõúúùùôôúúùùòòúú÷÷ïïööóóëëóóòò¼¼ÈÈÏϾ¾ÊÊÎÎÀÀÍÍÎÎÂÂÐÐÎÎÅÅÒÒÒÒÉÉÒÒ××ËËÔÔÛÛÑÑÝÝàà××ããããÝÝééééààêêììççííððëëïïòòííôôôôïïõõõõððööööòòùùùùôôûûûûõõüüüü÷÷þþþþøøþþþþ÷÷ýýýýôôýýüüôôüüûûööûûüüøøùùüü÷÷øøúúôôööôôôôööóóôôõõôôôô÷÷ööùùûûúúúúüüûûüüþþýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿýýûûýýúúööøøööõõøøööøøûûúúýýÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýûû÷÷÷÷õõóóóóññóóóóññôôôôòò÷÷÷÷ôôúúúú÷÷ùùùù÷÷úúûûõõüüýý÷÷üüýýøøþþþþûûÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿüüÿÿÿÿúúþþýýùùýýüü÷÷ûûúú÷÷üüûûõõúúùùõõúúùùôôúúøøóóúú÷÷ïïööôôëëòòññ¿¿ËËÒÒÀÀÌÌÐÐÀÀÍÍÎÎÁÁÏÏÎÎÃÃÐÐÐÐÆÆÐÐÓÓÈÈÑÑ××ÏÏÚÚÝÝÕÕààááÛÛææææààêêììççííññëëððóóììóóóóððööööòòøøøøôôûûûûööýýýý÷÷þþþþ÷÷ýýýý÷÷ýýýýõõüüüüññúúùùññùùùùòòöö÷÷ôôööøøôôõõ÷÷òòôôòòññóóððððòòññññóóòòôô÷÷ööøøúúùùûûýýüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþúúüüúú÷÷ùùøøõõøø÷÷ùùûûúúþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüüüúú÷÷÷÷õõóóóóññóóóóññóóóóññ÷÷÷÷õõûûûûùùûûûûùùùùúúôôûûüüööûûüüööþþþþûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿúúþþýýùùýýüüøøüüûûööûûúúõõúúùùóóøø÷÷óóùùööññøøõõîîõõóóêêññððÀÀÌÌÒÒ¿¿ËËÏÏÀÀÍÍÍÍÁÁÏÏÎÎÂÂÏÏÐÐÅÅÎÎÓÓÆÆÎÎÕÕÊÊÕÕÙÙÐÐÛÛÜÜÖÖââââÛÛååççããêêííèèííððêêññññííôôôôññ÷÷÷÷óóúúúúôôûûûûôôûûûûõõüüüüõõüüüüòòøøøøîî÷÷ööîîööööïïôôõõððóóôôññòòôôîîññððïïòòïïììïïîîîîññððññôôóóõõøøøøúúüüüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþúúüüûûööùùøøøøúúùùýýÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüüüùùöö÷÷ôôóóôôññòòóóððóóóóññööööôôùùùùööùùùùööøøùùôôúúûûõõûûüü÷÷ýýýýúúÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿþþþþýýúúþþüüùùýýûûøøûûúúööûûúúôôùùøøóóøøööòòøøõõðð÷÷ôôîîõõòòêêððïïÀÀÌÌÒÒÀÀÌÌÐÐÁÁÎÎÏÏÁÁÏÏÏÏÄÄÏÏÑÑÈÈÎÎ××ËËÏÏÚÚÊÊÑÑÙÙÍÍØØÚÚÒÒßßßß××ááããÞÞååèèããèèêêææííííêêññññííôôôôðð÷÷÷÷ññ÷÷÷÷òòøøøøññøøøøðð÷÷÷÷îîõõõõììóóóóììóóóóììóóóóììóóóóííòòóóììññòòííòòòòêêïïííëëððïïîîóóòòòò÷÷øøõõúúûûøøüüýýþþÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüþþýýùùûûúúúúûûûûýýýýýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûúúüüõõôôööððññòòììïïññëëòòóóííôôôôòò÷÷ööôôööööôôööõõôô÷÷÷÷ôôúúúú÷÷üüüüúúýýýýûûÿÿÿÿýýþþþþüüþþþþüüÿÿÿÿýýÿÿÿÿþþÿÿÿÿýýþþþþüüýýýýûûüüþþûûûûüüùùùùûûøøööûûùùôôùùøøóóøøööòòøøôôññ÷÷òòîîôôððììññííÀÀÌÌÓÓÂÂÎÎÒÒÂÂÐÐÑÑÅÅÒÒÒÒÈÈÒÒÕÕËËÒÒÚÚÍÍÑÑÜÜËËÓÓÚÚÍÍØØÚÚÏÏÛÛÛÛÓÓÝÝßßÚÚààããßßääççââééééååììììççîîîîèèïïïïêêññññììòòòòëëññññëëòòòòëëòòòòëëòòòòììóóóóííôôôôííóóôôííòòóóììññóóììññòòëëððïïííòòññððôôóóòòöö÷÷ôôùùúú÷÷üüýýüüÿÿýýÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüüüûûûûûûüüüüüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüýýøø÷÷øøòòòòóóííîîïïêêëëììææììííèèïïïïììòòòòððóóóóññóóôôóóõõõõõõøøøøøøúúúúùùûûûûùùüüüüúúüüüüúúýýýýûûþþþþüüþþþþüüÿÿÿÿýýýýýýûûüüüüúúûûýýúúùùûûøøøøúúööõõúúøøôôùùøøóóøøööòòøøôôññ÷÷òòïïôôððììññîîÂÂÏÏÕÕÅÅÒÒÕÕÈÈÕÕÖÖÉÉÕÕÖÖÊÊÕÕØØÎÎÔÔÝÝÑÑÕÕààÐÐ××ßßÏÏÚÚÝÝÎÎÛÛÛÛÐÐÚÚÜÜÕÕÜÜßßÙÙÞÞááÛÛââââÜÜããããÝÝääääÞÞååååááèèèèããééééääêêêêææííííèèïïïïééððððëëòòòòììóóóóîîôôôôííòòóóììññòòííòòòòììññððííòòññññõõôôóó÷÷øøõõúúûûùùýýþþüüÿÿýýþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýûûüüûûùùúúûûûûûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüüüøø÷÷ùùóóòòóóííííîîééëëììççççèèââççèèââééééççííííëëððññííóóòòôôôôôô÷÷÷÷ööúúùùùùøøúúûûøøüüüüúúûûûûùùûûûûùùüüüüùùýýýýúúýýýýûûýýýýûûûûûûùùúúüüùùùùûû÷÷÷÷ùùõõööúúùùõõùùøøóóøøööòòøøôôòò÷÷óóïïôôððììòòîîÈÈÓÓÙÙÉÉÓÓÙÙËËÖÖÛÛÍÍ××ÜÜÎÎØØÝÝÏÏÙÙßßÒÒÙÙààÕÕÛÛââÔÔÚÚááÓÓÙÙßßÓÓÙÙÞÞÔÔÚÚßßÕÕÛÛßßØØÝÝáá××ÜÜàà××ÝÝàà××ÞÞßßÙÙààààÜÜããããÝÝããããááèèèèããêêêêååììììççîîîîëëòòòòëëññððëëððîîììññïïííòòññììññððîîóóòòññõõôôôôùùøø÷÷üüûûúúþþýýüüÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþüüûûûûùùûûûûùùÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüúúúúùùøøüüûûùùÿÿþþüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýüüüüúúùùúúööóóööððííïïééèèêêääååèèââââääßßääææááççèèããééêêååííîîééòòððððööôôõõøøõõ÷÷ùùùùööúúûûõõûûüü÷÷úúûûõõûûüüööûûüü÷÷üüüüøøüüüüúúüüüüúúüüüüúúþþýýûûüüüüùùùùûûøøøøúúùù÷÷úúùùööùùøøõõúúööóóùùôôññööòòëëññííÌÌÖÖÜÜÍÍ××ÝÝÎÎØØÞÞÐÐÚÚààÑÑÛÛááÒÒÝÝããÔÔÜÜââ××ÜÜããØØÝÝää××ÜÜãã××ÜÜáá××ÝÝááØØÞÞââÙÙÞÞââØØÝÝááÖÖÛÛßßÔÔÛÛÜÜÔÔÛÛÛÛ××ÝÝÝÝÚÚááááÝÝããããßßææææââééééååììììééïïïïêêïïïïëëïïííëëððîîëëððïïììññððîîòòññññõõôôôôøø÷÷ööûûúúùùýýüüûûþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüüüùùùùùùööüüüüúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüúúûûúúøøüüûûùùÿÿþþüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüûûýýúúøøøøøøõõõõööòòññóóííëëííççççééããããææààââääßßååççááééêêääééêêääììííèèððïïééööõõîîøø÷÷ññúúúúóóûûüüööüüýý÷÷ûûüüööûûüüööüüýýøøüüýýùùüüüüúúüüüüúúüüüüúúþþýýûûüüüüúúûûýýúúùùûûúú÷÷ùùùùøøúúúúööûû÷÷óóùùôôóóùùôôììòòîîÏÏÚÚßßÑÑÛÛááÒÒÜÜââÒÒÜÜââÓÓÞÞããÕÕààåå××ßßååÚÚààççÜÜââééÛÛááççÛÛááææÜÜââççÝÝããèèÜÜââååÚÚààããØØÝÝáá××ÞÞÞÞÖÖÝÝÝÝØØßßßßÙÙààààÜÜããããßßææææááèèèèããêêêêææííííççííììééííììêêîîííëëïïîîììòòññîîòòññððôôóóôôøø÷÷ööûûúúùùýýüüüüÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþüüþþþþüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüúúúúùù÷÷úúùù÷÷þþýýûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûüüüüüüùùøøûûøøööøøøøõõõõööòòððòòììëëîîèèééëëååææèèââææèèââèèêêååééêêääêêëëååëëììççîîííèèôôóóîîøø÷÷òòûûûûööüüýýøøüüýýøøüüýýøøüüýýøøýýþþùùýýþþùùüüüüúúüüüüúúüüüüúúüüûûùùüüüüúúûûýýúúûûýýûûøøúúúúùùûûúú÷÷ûûøøóóúúõõóóùùôôííóóïïÑÑÜÜääÒÒÝÝããÔÔààããÖÖââää××ããææ××ããææÙÙááååÝÝââèèÞÞããééßßååêêààååêêààååêêßßääééÞÞããççÝÝããççÜÜââååÜÜããããÛÛââââÚÚááááÛÛââââÜÜããããÞÞååååààææææââççèèååêêëëææììììééííììëëííììííïïîîììññððîîóóòòññõõôôóó÷÷ööõõúúùù÷÷ûûúúûûþþýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýùùúúùùõõùùùùööüüüüúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþýýüüüüúúùùùù÷÷ùùøøööúúùùööùùøøööööùùôôññ÷÷ððììññëëêêííèèêêëëææêêëëååëëììççììííççêêëëååêêëëååïïììééõõññîîûûööôôúúúúõõûûüüööüüýýøøýýþþøøüüýý÷÷ýýþþúúýýýýûûüüüüúúüüüüúúüüüüúúúúûûøøûûüüúúûûýýúúûûýýûûúúüüùùùùûûùùúúüüùù÷÷úú÷÷ôô÷÷óóîîóóïïÔÔÞÞèèÔÔÞÞææÖÖááääÚÚääççÚÚååèèÚÚååèèÜÜääèèààääêêááææëëââèèììââèèììááççëëááççëëááççêêááççêêààååééßßææææßßææææÜÜããããÛÛââââÜÜããããÜÜããããÛÛââââÝÝääääááèèèèââêêééååììééèèííêêëëííëëêêïïííììññððððôôóóòòööõõóóøø÷÷ööûûúúúúýýüüýýÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýüü÷÷ùùøøôôøøøøõõúúúúøøÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿýýýýþþúúúúøøøøøøõõ÷÷÷÷ôô÷÷÷÷ôôúúúú÷÷úúúúøøùùûûööôôøøññïïóóííííððêêííïïééîîððêêððññëëîîïïêêêêëëææééêêããïïííééôôññííúú÷÷óóûûûûööûûüüööûûüü÷÷ûûüüööüüýý÷÷ýýþþúúýýýýûûüüüüúúýýýýûûüüüüúúúúüüùùûûýýúúüüþþûûüüþþûûûûýýúúùùûûøøúúûûùùúúüüøøõõ÷÷ôôïïóóððÙÙààêêÙÙààééÛÛââççÝÝääééÝÝååééÞÞååêêÞÞääééßßääééààææêêááççëëááççëëááææëëààææêêââèèëëââèèëëááççêêááèèééââééééßßææææÜÜããããÛÛããããÛÛââââØØááááØØããááÜÜççææÞÞééææààëëââããëëääææììææêêííììëëððïïîîóóòòññõõôôòò÷÷õõõõúúùùúúýýüüüüþþýýþþÿÿÿÿÿÿÿÿÿÿþþÿÿýýþþÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýùùùùùùôôööööôôøøøøööüüüüûûÿÿÿÿýýþþþþüüúúúú÷÷ùùùùõõööööóóööööôô÷÷÷÷ôôùùùù÷÷üüûûúúüüüüøøùùúúôôôôõõððððòòììîîððêêññòòììôôõõïïôôööððïïððëëëëììææííîîèèòòóóîî÷÷ùùóóûûüüööûûüüööûûüüööûûüüööüüýý÷÷üüýýùùýýýýüüýýýýûûýýýýûûýýþþûûýýÿÿüüüüþþûûûûýýúúüüþþûûûûýýúúùùûûøøùùûûøøùùûû÷÷õõ÷÷ôôïïóóððÛÛááììÜÜããëëÝÝääêêááççëëââççëëââèèììââççììââèèììääêêîîääêêîîääêêííããééììããééììââèèëëââèèëëââèèëëââééééááèèèèààççççßßååååÝÝääääÚÚáááá××ààààÔÔßßßßÖÖááßßÙÙååááÞÞêêââââëëääååììææççëëêêêêîîííííòòððððôôóóòò÷÷õõóóøø÷÷øøûûùùüüþþûûþþÿÿþþþþÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüüü÷÷÷÷øøôôøøøøôôúúûû÷÷üüüüúúúúúúúúøøøøùù÷÷÷÷ùù÷÷ööùùøø÷÷úúùùøø÷÷ûûûûøøýýüüûûýýýýûûúúûû÷÷õõõõòòòòóóîîòòóóííõõ÷÷ññùùúúõõûûüü÷÷ôôõõððîîïïêêììîîééïïððêê÷÷÷÷ññûûûûõõûûüü÷÷ûûüüööûûüüõõüüýý÷÷ýýþþúúýýýýûûýýýýûûýýýýûûþþþþüüþþÿÿýýüüÿÿüüûûýýúúûûýýúúúúüüùùùùûûøøúúüüøøùùûûøøõõ÷÷ôôïïóóððÜÜääííÜÜååììÝÝççëëááèèììããèèììããééííããééííââèèììããééîîååëëîîääêêííããééììããééììããééììããééììââèèëëááèèèèááèèççààççççààææææÞÞååååÚÚááááÖÖÞÞààÒÒÛÛÝÝÑÑÛÛØØÕÕààÛÛÛÛææààààèèããããééååååêêééééííììììññððîîóóòòññõõôôòò÷÷õõ÷÷úú÷÷ûûýýùùýýÿÿüüþþÿÿýýÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿúúúúûûõõùùúúôôùùúúôôúúúú÷÷ùùùùøø÷÷÷÷ùùõõôôøøõõõõøøøø÷÷úúúúúúúúûûûûùùýýýýûûüüüüúúøøøøööôôôôóóòòòòððóóôôïï÷÷ùùóóüüýý÷÷ýýþþùùùùúúôôððññììëëííèèììîîèèõõôôïïúúúúõõûûüü÷÷üüýýøøüüýýööüüþþøøþþÿÿûûýýýýûûþþþþüüþþþþüüþþþþüüÿÿÿÿþþýýÿÿüüûûýýúúùùûûøø÷÷ùùöö÷÷úúööúúûûøøøøûû÷÷ööøøôôððôôññÞÞææììßßèèëëààééëëââééììããééííããééííääêêîîããééííääêêîîääêêííääêêííããééììããééììããééììããééììââèèëëááèèèèááèèèèààççççßßååååÞÞääääÚÚááááÕÕÝÝÞÞÎÎØØÚÚÌÌ××ÔÔÏÏÚÚÕÕ××ããÜÜÝÝååààââççããååééééééììììëëððîîííòòññññõõôôòòööõõõõùùõõúúüüøøüüþþûûýýÿÿüüþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüûûùùððïïêêùùøøööÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüööõõññ÷÷ööóóÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüýý÷÷øøùùóóööøøòòõõ÷÷ððõõõõòòôôôôôôõõõõóóøøøøõõûûûûùùýýýýûûýýüüûûûûûûùùúúúúøøööööôôôôôôòòôôôôòòöö÷÷ññûûüüööýýÿÿùùÿÿÿÿûûýýþþùùóóôôîîììîîééììííèèóóòòííùùùùóóûûüüööüüýýøøüüýý÷÷ýýÿÿùùÿÿÿÿûûþþþþüüÿÿÿÿýýþþþþüüýýýýûûýýÿÿüüûûýýúúúúüüøøøøúúööööùùõõ÷÷úúööùùûû÷÷ùùüüøøøøúúööòòööóóààêêììààêêììààêêêêããêêììããééííääêêîîææììððååëëïïääêêííääêêííääêêííããééììããééììããééììââèèëëââèèëëááèèèèááèèèèààççççààææææßßååååÛÛââââ××ÞÞßßÓÓÛÛÜÜÌÌÕÕÔÔÌÌÖÖÒÒÓÓÞÞØØÚÚââÞÞÞÞææââããêêççççììêêêêïïííííññððððôôòòòòõõòòõõøøôôùùûû÷÷üüýýûûüüÿÿûûþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿòòóóðð±±®®¡¡——’’ƒƒ¨¨¡¡‘‘ÑÑËË¿¿úúøøõõÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüúúÙÙÔÔÊÊ°°ªªžž¡¡©©¤¤››ÞÞÛÛ××üüüüûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþúúøøùùóóôôôôïïôôôôîîôôôôððõõõõòòøøùùôôûûûûööþþþþúúþþÿÿûûýýþþûûûûûûøøùùùùõõööõõòòôôóóññõõõõññøøùùóóüüýý÷÷ÿÿÿÿûûÿÿÿÿýýÿÿÿÿüüõõööññííîîêêììííééòòññííøøøøóóûûýý÷÷ýýþþùùýýþþùùþþÿÿúúÿÿÿÿûûÿÿÿÿýýþþþþüüýýýýûûüüüüúúüüýýúúúúûûøø÷÷ùùõõôô÷÷óóóóööòòõõùùôôøøûûööùùûûøø÷÷ûû÷÷ññööóóááïïïïááííîîááëëííääëëííääêêííääêêííææëëïïææììïïååëëîîääêêííääêêííããééììããééììââèèëëááççêêââèèëëááèèèèààèèççààççççààææææÞÞååååÜÜããããÛÛââââØØßßßßÏÏÕÕÖÖÉÉÑÑÐÐÍÍ××ÔÔÓÓÞÞÛÛ××ââÞÞÛÛèèááããììççèèîîêêîîññððïïññîîòòôôîîõõ÷÷óóööùùõõùùûûøøüüþþûûüüÿÿûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ®®±±ªª„„††zzŽŽ€€‹‹}}––~~¹¹°°œœööôôííÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüûû÷÷ºº³³««ŽŽ‡‡||ŽŽŠŠ}}““’’„„’’‘‘‡‡’’‘‘ŠŠ²²±±­­üüüüûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýúúøø÷÷óóôôòòîîóóòòííôôóóîîøø÷÷òòüüûûùùýýýýüüþþþþüüýýþþúúüüýýøøûûüüööúúùùôôööõõññôôóóîîôôóóïïùù÷÷óóýýüü÷÷ÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿþþ÷÷÷÷õõïïïïììîîîîëëóóóóññøøùùôôüüýý÷÷ÿÿÿÿûûþþÿÿùùþþÿÿùùþþÿÿûûýýýýûûüüüüúúûûûûùùûûûûùùûûûûùùúúúú÷÷ööööôôññõõððððõõîîóóøøòòööúúõõùùüüùùööüüøøðð÷÷ôôããòòòòääññññääîîððççííððææììïïääëëííææììïïææëëïïååëëîîääééííääééííääêêííããééììááççêêààååééááææêêááèèèèààççææßßååååÞÞååååÜÜããããÛÛããããÛÛââââÖÖÝÝÝÝÏÏÖÖÖÖÇÇÏÏÎÎÅÅÏÏËËÌÌÖÖÓÓÒÒÝÝÙÙ××ããààààééççèèííííííððïïîîððííòòôôîîóóõõññôôööóóööùùõõùùûûøøúúüüùùþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿøøøøøø‘‘””ƒƒ‡‡||‚‚xxvv~~rr††ww““xx³³ªª””ññîîååÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúùùõõ²²­­  ˆˆww……††zz‚‚xxxx~~vv„„‡‡„„‹‹ŽŽŠŠ‹‹ŽŽˆˆÞÞààÜÜÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýùùööôôððóóòòííòòññììõõôôïïüüûûööÿÿþþüüÿÿÿÿÿÿÿÿÿÿþþþþþþüüýýýýüüûûûûúúúúùùöö÷÷ööññõõôôððõõôôïïúúùùôôüüûûööÿÿÿÿûûþþÿÿüüÿÿÿÿüü÷÷÷÷õõððððííîîîîììññññïï÷÷÷÷óóüüýý÷÷þþÿÿúúýýÿÿùùþþÿÿùùþþÿÿûûþþýýüüüüüüúúüüüüúúüüüüúúûûûûùùùùùù÷÷õõõõóóôôõõóóòòóóññóóôôóóøøúúööúúýýúúøøþþúúññøøõõããññññääïïññääííððèèîîòòèèííððååëëîîææëëïïææëëïïääêêííääêêííääêêììããêêììããééëëááççééààææééààææééßßææææßßååååÞÞääääÜÜääääÜÜããããÜÜããââØØààßßÓÓÚÚÚÚÏÏ××××ÅÅÎÎÍ͹¹ÅÅÁÁÂÂÍÍÊÊÑÑÜÜÚÚÙÙããããááééééççììììííððîîììððììððóóííððóóïïññôôññòòõõòòööùùôôùùûû÷÷ýýÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿïïððîî’’‹‹„„ooyyqqggvvkkiizznnzzppŠŠ††ppŸŸ••ƒƒÚÚÒÒËËÿÿÿÿþþÿÿÿÿÿÿûûûûùùááÞÞÙÙÏÏÊÊÄÄÉÉÇÇÁÁ°°¬¬¥¥ªª§§œœ»»¸¸®®¼¼³³®®±±¨¨¢¢ºº´´¬¬ÇÇÀÀººÖÖÑÑÊÊèèååààüüüüùùÿÿÿÿÿÿÿÿþþüü»»··®®‚‚rr€€qqnnttgg``ii``bbmmjjkktttt}}„„‚‚ƒƒ‹‹……ÊÊÏÏÈÈÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüü÷÷ôôôôîîòòòòììóóóóîîùùøøôôÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýþþüüûûúúûûúúööøø÷÷óóùù÷÷ôôúúùùõõüüûû÷÷ÿÿþþûûþþþþüüþþþþüü÷÷÷÷õõòòòòïïîîîîììññññïï÷÷÷÷óóûûüüööþþÿÿúúþþÿÿúúþþÿÿúúþþÿÿûûþþþþüüÿÿÿÿüüþþþþüüþþþþûûýýýýûûüüüüúúùùùùöö÷÷÷÷ööõõõõõõõõõõõõ÷÷øø÷÷øøûû÷÷õõûûööïïööòòååîîññååîîññååîîññèèííññééîîòòèèííññææììïïååëëîîããééííääêêììääëëëëããêêêêããêêêêââééééááèèèèààççççßßææææÝÝääääÜÜããããÚÚááááÛÛââààÚÚààÜÜÓÓÜÜÙÙÌÌ××ÖÖÏÏÙÙØØÌÌ××ÕÕÂÂÎÎÍÍËË××ÖÖÜÜççææââèèëëååëëëëééïïííììòòííììòòííííóóîîííóóîîííóóîîííóóïïóó÷÷òòøøúúôôýýþþùùÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ××××ÕÕ††ˆˆ„„||ƒƒ||kkuummhhwwmmjj{{qqllyynnyyyyll„„pp……rrµµ¬¬  ¾¾ºº´´§§¥¥––››——ŠŠŒŒwwttiiwwooeexxuuiittrriizzuuqqƒƒuuŠŠ‹‹||””‡‡——““‡‡šš••ˆˆ¢¢žž’’´´®®¢¢²²©©ŸŸŒŒ„„zzvvwwiirrqqcceekk\\rr||qqnn{{ssaannllggqqoo||‚‚~~³³ºº´´ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿûûþþÿÿùùÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüýý÷÷õõööððòòóóîîööööóóþþþþüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþýýüüýýýýüüüüþþýýûûþþýýûûþþýýûûýýýýûûüüüüúúõõõõóóòòòòððïïïïììòòòòðð÷÷øøóóúúûûõõýýþþùùÿÿÿÿûûÿÿÿÿûûÿÿÿÿüüÿÿÿÿüüÿÿÿÿûûÿÿÿÿúúÿÿÿÿüüþþþþüüþþþþüüüüüüúúùùùùööõõõõôôôôôô÷÷ööõõõõöö÷÷ôôóó÷÷óóííóóïïääííððääííððååîîññææììððèèííññççììððääêêííääêêííããééííããééëëããêêêêââééééââééééááèèèèààççççààççççßßååååÛÛââââÙÙàààà××ÞÞÞÞÕÕÜÜÛÛÒÒÙÙÔÔÊÊÓÓÐÐÊÊÔÔÓÓÏÏÙÙØØ××ááààÜÜççææããîîììååïïïïèèííññééððððêêññîîííóóîîììòòííîîôôïïïïõõññîîôôïïííóóïïððôôïïôô÷÷ññùùûûõõüüýýùùÿÿþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÃÃÃÃÁÁ‡‡ŠŠ††||„„}}VV``WWSS\\TTddnnffmmssjjmmmm``xxtteeŽŽ„„pp™™‰‰ww„„££˜˜‹‹––ŽŽzzvvhh[[XXEEYYOOGGPPGGIIUUVVXXWWnnbb__ssaaoottiiˆˆˆˆ––’’……ŠŠ{{ŒŒ‰‰yyŽŽ„„vv‡‡xxkkgg[[MMUUXXHHUU\\LLYYbbQQddll^^HHNNFF??EECCTTZZWWtt{{uu””žž””õõøøõõÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûýýÿÿùùÿÿÿÿûûÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿüüûûüüöö÷÷ùùòò÷÷ùùóóüüüüúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþýýûûüüüüúúüüüüùùøøøøööóóóóññññññîîññññîîóóóóññöö÷÷óóûûüüööþþÿÿúúÿÿÿÿüüÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþüüúúúúøøööööõõóóóóõõóóóóòòòòòòððîîóóîîêêððììääííððääííððããííïïææììððççììððææëëïïääêêííããééììããééììââééëëããêêêêââééééááèèèèààççççßßææææßßååååÜÜããããÙÙààààÖÖÝÝÝÝÏÏÖÖÖÖÇÇÎÎÍÍÂÂÉÉÅÅÀÀÈÈÆÆÐÐÛÛÚÚÞÞèèççááêêééææííííééððððééððððééïïòòëëòòòòììóóððîîôôïïííóóîîïïõõððððõõññîîôôïïììòòííïïóóííññóóííõõøøòòùùûûööþþþþüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÔÔÔÔÒÒŠŠŒŒ‰‰zz„„{{MMUUMMAADD==UUXXSSccff^^ggggZZyyvvffŠŠ~~ii››††qq¡¡}}‘‘€€qqkk``SSbb]]NN^^XXAARRGG88GG??55aabbVVŠŠ‡‡ww‚‚ƒƒxxffnniiiimmddˆˆƒƒttuupp\\ggeeOO‘‘……rryyhhiiYYGGJJQQ>>GGYYFFQQ[[PPJJOOLL....11------UUXXRRtt||ss††††ççêêææÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüþþøøþþþþùùÿÿÿÿûûÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿüüþþÿÿúúûûüüööúúûûôôüüýýøøÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýûûüüûûúúùùùù÷÷ôôôôòòññññîîññññîîññññîîòòòòññõõööòòûûüüööÿÿÿÿûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþüüûûûûùùõõõõôôóóóóõõòòòòòòññòòïïííññííêêððììââëëííââëëííããììîîææììïïææììïïååëëîîääêêííããééììááççêêááççééááèèèèààççççààççççßßææææÝÝääääÜÜããããÛÛââââ××ÞÞÞÞÕÕÜÜÜÜÍÍÔÔÔÔÆÆÌÌÌÌÌÌÒÒÒÒÒÒÜÜÙÙÞÞëëææããððëëååïïííééììññëëððóóííòòõõííòòõõîîóóôôîîóóòòððõõññððõõññññööòòóóööòòññóóððïïòòîîîîññììïïññëëóóõõïï÷÷ùùôôüüþþûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿöööööö••——––rrzzvvUU__YY==GG>>TTaaYYllvvmm{{~~pp{{zzff‚‚rr]]––{{ff||bbxxll\\wwzzkk}}yyffqqccIIII>>//9977**bbaaUUˆˆ{{mm——‰‰{{¢¢‘‘ŒŒŽŽ‚‚‡‡……ttŒŒ~~jjqqbbRR~~nn]]ŠŠzzaa„„vvcc[[]]PPMMaaLLQQaaQQNNRRRR//66::))33**YYaaWW||‚‚||††ŠŠƒƒççèèååÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÿÿÿÿüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüÿÿÿÿûûþþÿÿùùüüýýøøüüýýøøÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿýýûûûûùùùùööôôôôòòññññîîññññîîòòòòððóóóóòòöö÷÷òòúúûûõõÿÿÿÿûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýùùúú÷÷óóõõóóññòòôôññòòóóððóóòòííòòññêêððîîààééëëááêêììââëëííååëëîîææëëîîååëëîîååëëîîääêêííááççêêààååèèßßååååÝÝããããÜÜããããÜÜããããÛÛââââÚÚááááØØßßßßÙÙààààÚÚááááÝÝääääààççççååëëììççîîííççððììççððííêêòòððììððòòííòòôôîîóóõõïïôô÷÷ððôôõõððôôóóññööòòòò÷÷óóòòøøóóóóööóóóóõõòòññóóððîîððëëììîîééîîððëëóóõõïïúúüüùùþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÑÑÒÒÑÑeeqqooOO]]YYBBPPIIbbssbb††{{’’‹‹xxpphhYY~~rree¨¨‹‹xx££||ŽŽ€€||ppnnjjYYbbXXIIPPNNFF^^__XXvvxxmmqqttbbcceeUU~~€€tt™™ŽŽ˜˜žž’’||{{ffvveeSS}}nnRRŽŽ‡‡eennooWW]]hhSSddjj``IIJJHH++33++00==//RRZZQQrrwwqq””˜˜‘‘øøùù÷÷ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿûûÿÿþþúúÿÿþþúúÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿüüúúûûøøøøööóóóóññòòòòïïòòòòððôôôôòòööööôôøøùùôôûûüüööþþÿÿúúÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿýýúúüüùùööùùõõóóõõóóòòóóõõóóõõõõôôøøööôôúúøøññ÷÷õõÝÝææééßßèèêêááëëììããêêííääêêííææììïïææììïïååëëîîääêêîîääëëììááèèèèààææææÝÝããããÜÜããããÚÚááááÚÚááááÛÛââââÞÞääääááèèèèååììììççííííççîîîîééïïîîììññððììññððîîóóòòïïôôóóððôôóóññõõõõððõõùùòòöö÷÷òòööõõóóùùôôóóùùôôóóúúôôôôøøôôööøøõõóóõõòòîîññììééììææëëííççððóóîî÷÷úúööüüþþûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ——‘‘@@LLCCMMZZOOggpp]]……„„oo‚‚vvffqqhh]]¢¢››ŒŒÁÁ³³¢¢™™™™’’€€ŽŽ‚‚yy~~iiyyttddssrreejjvvkkxx||rrƒƒuuvv€€mmrr||oo€€||’’™™““²²µµ¬¬ÇǾ¾­­ƒƒ{{ffUULL==YYQQ>>oojjOO||{{[[uuvv]]\\[[JJ''##++77**FFNNEEWW\\VVÈÈÉÉÆÆÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýÿÿþþúúÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüúúúú÷÷÷÷ôôôôôôòòññññïïôôôôòòööööôôùùùù÷÷úúúúööûûüüööþþÿÿúúÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýûûÿÿüüúúÿÿûû÷÷üüøøõõùùôôõõ÷÷õõõõööøøùùûûûûûûþþüüûûÿÿþþ÷÷üüûûÙÙââääÛÛääææààééëëääëëîîååëëîîèèííññççììððççììððèèííññèèîîððææííííããêêêêââééééááççççßßææææààççççààééèèââëëêêååîîííççññîîèèññîîééòòïïëëôôòòììõõòòëëôôòòïïööôôòòõõõõòò÷÷õõóó÷÷ööôôõõùùôôõõøøôôööøøôôøøôôööùùõõ÷÷úúööööùùôôööùùôôõõøøóóððòòííääææááããææààîîððëëõõ÷÷ôôûûýýúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÌÌÎÎÈÈggooaa{{oo€€~~ffss``rrbbZZŠŠ~~ttÕÕÐеµ¹¹½½©©šš¡¡££‘‘ššzz}}nnmmjjZZiikk\\nnqqddxxwwhhƒƒ||kk’’€€‘‘˜˜ŒŒ““‘‘˜˜šš••ÑÑÍÍÆÆïïãã×ׯ¯®®ŸŸKKKKBB7777++JJKK77nnjjJJ……€€cc„„}}ggYYUUCC$$$$**00++EEMMEEMMPPIIááààÞÞÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüüü÷÷÷÷÷÷óóóóòòòòòòòòõõõõóóùùùù÷÷üüûûúúüüüüøøûûüüööþþÿÿùùÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýúúýýúúùùûûøø÷÷úúöö÷÷ùù÷÷úúüüûûüüþþþþýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿùùýýüü××ààââÙÙââääÞÞèèêêããêêììääêêííææììïïççììððççììððèèííññèèîîññééððððèèîîîîèèîîîîççîîîîååììììååììììææííííççííííééððððêêòòððëëòòððííôôòòïïõõóóðð÷÷õõññøøõõññ÷÷õõóó÷÷ööóóøøööôôøø÷÷õõ÷÷÷÷õõ÷÷øøõõ÷÷÷÷õõøøôôööùùõõ÷÷ùùõõ÷÷ùùôô÷÷úúôôööùùóóõõ÷÷ññççééããààããÝÝééëëææõõ÷÷óóþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿôôõõï便££  ’’yy‡‡yy``ssjjUUcc``QQÀÀ¹¹¢¢ííááÎΫ«±±­­²²¼¼¯¯¬¬­­  lliiXXYYSS??^^XXJJooggXX||ttXX††dd¶¶¸¸££žž¨¨˜˜ššœœ™™žž¤¤žž‘‘””ˆˆããÜÜÈÈééääÌÌ™™„„AA:://NNGG::ff\\IIttccQQ‘‘jj““ˆˆppnnffVVLLKKBBMMSSJJnnppiiõõõõôôÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýýýøøøøøøóóóóóóòòòòòòööööôôýýýýûûþþþþüüþþþþûûüüýýùùþþþþûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþþþüüûûýýúúúúûûøøúúüüùùüüþþüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùùüüüüÕÕÞÞáá××ààââÜÜææèèááèèëëããééììääêêííææëëïïççììððèèííññééïïòòêêññññêêññññêêññññêêññññèèîîïïééïïððëëïïððêêîîððììððòòííòòòòîîóóòòððôôóóññõõôôòòõõõõòòööõõóóøøööóóøø÷÷ôôùùøøôôùùøøööùùõõööùùõõööùùõõõõøøôôööùùõõ÷÷ùùõõ÷÷ùùôôøøúúôô÷÷ùùóóööøøòòîîññëëèèëëååèèëëåå÷÷ùùööÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿîîîîé鬬¡¡‡‡––€€bb{{iiRRrrkkUU‹‹vvÞÞÔÔ½½ÔÔÍÍÀÀ  ¢¢  ´´¶¶©©‡‡nnddZZDDccUU;;ffXX@@kkZZCC||kkJJŠŠzzYYÉɼ¼¥¥ªª««““™™©©µµªªfftthhªª¯¯ÙÙÔÔ¿¿¨¨˜˜ŒŒgg]]JJBB::((ffaaTTqq]]NNbbPP::uuhhWWˆˆ€€jjoojjYYnnppccšš••ýýýýüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùùùùùùôôôôôôòòòòòòøøøøööÿÿÿÿþþÿÿÿÿÿÿÿÿþþþþüüüüüüýýýýýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþüüýýýýûûûûýýúúûûýýúúüüÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿøøüüúúÓÓÜÜßßÖÖßßááÛÛääççßßççêêààèèêêââééììååììîîèèííïïèèïïððééïïññëëòòòòëëòòòòëëòòòòêêóóòòèèññïïêêòòïïîîññññîîððññïïññòòððòòòòññóóòòòòôôóóòòôôóóóóõõôôôôööõõôô÷÷ööõõùùøø÷÷úúùù÷÷úúøøööùùõõööùùõõööùùõõõõùùõõööùùõõøøúúööùùûûööúúüüööøøúúôô÷÷ùùôô÷÷øøôôôôõõññõõööòòýýþþüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèèååããžž““{{}}ppQQvvjjSS††{{gg••zzuunn``••——ŒŒžž¢¢››¢¢ŸŸ——llccLLhhZZBBllZZ??qq\\>>qq[[>>ww``AAƒƒmmLL¹¹¢¢ŠŠ¾¾¶¶¥¥««®®ŸŸ´´ÀÀ±±••££šš~~††¡¡ŸŸ””¡¡’’††zzss]]aa^^HH^^^^KKllkk\\HH))&&WWWWDD}}kk||yynnÐÐÏÏÊÊÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúúúùùôôôôôôôôôôõõøøùùøøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýþþýýüüýýÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþþþüüýýþþüüþþÿÿýýþþÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ÷÷úúùùÓÓÜÜßß××ààââÚÚââååÜÜææééÝÝççééààêêììääììííèèîîííééððððêêññññììóóóóëëòòòòììôôôôëëòòòòêêòòîîêêòòììïïòòððññóóññññóóññññóóòòññóóòòòòôôóóóóõõôôôôööõõôôööõõôôööõõõõøøööööùù÷÷÷÷ùùøø÷÷úúöö÷÷ùùõõ÷÷ùùõõööùùõõøøúúööúúüüùùûûýýøøüüþþúúúúüü÷÷ûûüüøøûûûûùùûûûûùùýýýýûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÝÝÖÖÓÓvvooZZpphhMMxxee’’††yy««££™™££¥¥±±¶¶³³¦¦¨¨££™™’’ƒƒmm``DDkkXX==nnXX<>88$$ ``__PP„„yyóóïïííÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûûûøøôôôôóóóóóóõõ÷÷ùùùùþþÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿýýûûþþúú÷÷ûûüüùùúúÿÿýýûûÿÿÿÿüüÿÿÿÿýýþþþþüüþþþþüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ÷÷ûûøøÕÕÞÞáá××ààââÙÙââääÛÛååççÜÜååèèÞÞèèêêââêêêêææììììééïïïïêêññññììóóóóííôôôôííôôôôííòòóóììòòððííóóîîîîññððððòòññññóóòòððòòññññóóòòòòôôóóóóõõôôôôööõõôôööõõôô÷÷ööõõøøööõõøø÷÷÷÷úúøøùùûû÷÷øøúúööøøúúööøøûû÷÷ùùûûøøûûýýúúûûýýûûüüÿÿýýýýÿÿýýþþÿÿýýÿÿÿÿüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ³³««§§DD<>eeRR::ooXX??ssZZ??ppXX::mmVV44iiNN..¤¤ˆˆqqÜÜÍÍ»»””~~WWWWIIWWXXOO]]\\WWqqkkgg==44++ œœƒƒppµµ{{jjVVFFXXKK<<]]RRGG$$##……zzhhååÛÛÉÉÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûûûùùôôôôôôòòòòõõ÷÷õõ÷÷þþýýþþÿÿÿÿÿÿÿÿýýÿÿúú÷÷ûûõõóó÷÷÷÷ôôõõüüøøööüüûûùùüüüüúúýýýýûûþþþþüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿþþýýÿÿþþ÷÷ûûùùÕÕßßáá××ààââ××ááããÚÚââääÛÛããææÞÞææééááèèééååëëëëèèïïïïêêññññììòòóóîîôôôôïïôôõõððòòóóîîññððîîòòïïîîññððïïññððññóóòòññóóòòññóóòòòòôôóóóóõõôôôôööõõôôööõõôôööõõööøø÷÷øøùùøøùùúúùùùùûûøøùùûûøøúúüüùùúúüüúúüüýýûûüüþþüüýýþþýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüü÷÷Ðм¼ii\\VV;;9900WWXXJJiiffRRSSHH88YYOOFFLLFF;;TTNNDDkkgg``££ššgg[[II__PP::mmZZCCmmZZAAllYY??hhUU99aaMM//··¢¢‰‰Ãù¹§§FFFF55FFKK::BBGG;;QQWWMMIIHH::66::((––ƒƒkk³³ss55//iiee__**))%% ooiiUU³³¥¥ŠŠïïçç××ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüýýøøóóôôññððññïïööôôõõþþüüýýÿÿýýÿÿýýûûýý÷÷õõøøññïïòòòòïïññ÷÷ôôóóùùøøööüüûûúúüüüüúúÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿøøûûúúÕÕßßááÕÕßßááÕÕßßááÙÙßßââÜÜááååßßääééââèèêêååììììèèïïïïêêññññííòòóóïïóóõõððôôõõòòôôóóððòòññííððïïîîññððïïññððññóóòòññóóòòññóóòòòòôôóóóóõõôôôôööõõôôööõõõõ÷÷õõøø÷÷ôôùùùùööúúúúøøùùûûøøúúüüùùûûýýúúüüüüüüýýýýýýýýýýýýÿÿþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûùùööÒÒÃ󳋋vvhhGG9933@@JJ@@aaggWWbbYYCC``QQ@@rrhh^^1100%%GGDD55KKEE88yynnbbbbRRAA^^MM44ll[[<>……‡‡zz§§¡¡••øøððããÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýÿÿòòññööîîîîòòôôòòôôüüùùúúÿÿþþÿÿûûùùúúòòððññîîëëííîîììííððííïï÷÷õõööþþýýýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùùúúüüÕÕßßááÓÓÜÜßßÒÒÛÛÝÝÖÖÜÜààÚÚááääààææééääëëììççííîîêêññññììòòòòïïôôõõððõõööññõõööóóõõõõññôôóóððòòññîîññððïïññññññóóóóòòôôóóôôööôôôôööõõõõøøööõõøøööööùù÷÷÷÷ùùøøøøùùööúúûûùùüüüüúúýýüüúúþþýýûûÿÿþþüüþþýýýýþþþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿööóóîîÇǸ¸±±¯¯¦¦””SSSSGGEEGGEE{{~~wwhhggQQtthhLL]]KK55ccUUEE€€wwll––ŒŒˆˆHHCC==::66**YYII77eeTT;;mm\\==pp\\@@llXX==hhSS99ddNN<>ddNN??SS??11==++ccRRBBtt^^NN]]JJ66ZZRR33cc\\55ii\\@@FF<>..\\LL;;__QQ99__OO44\\EE00ZZCC00ZZKK00iiXX??qq``HHqq``GGoo^^EEllYYDDffSS@@bbMM<>]]II77[[HH44]]MM88ggVV==ss[[BBuu__JJnn``HHWWII))ooddLLÍÍÊʼ¼××ØØÊÊÞÞ××ÎΨ¨©©œœ??OOAAÇÇÇǾ¾ÍÍÐÐÇÇOO__]],,??==˜˜””³³°°¦¦ÀÀ¿¿³³ûûúúôôÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüùùûû÷÷öö÷÷ôôõõõõõõõõõõ÷÷ööööúúøøùùüüúúûûÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ÷÷üüûûØØââßß××ààááÖÖßßããØØààççÜÜääééààêêììååììïïêêïïóóììòòõõïïõõ÷÷ññøøøøóóúúúúóóùùùùòò÷÷øøññõõööññõõööóóôôööõõööùùøøùùûûööøøûû÷÷øøûûøøùùùùøøúúùùùùûûúúúúüüûûùùûûúúùùûûúúúúüüûûüüþþýýýýýýýýþþþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÒÒÄÄ¿¿¿¿¯¯¡¡ºº®®  {{~~rr**66..––œœŸŸ™™““¹¹²²ªª´´¸¸««zztt^^ttbbIImm\\BB^^FF//[[CC00eeUU;;oo__GGoo__KKmm]]JJii[[GGggUUDD``KK;;WWDD11ZZJJ88__QQ<>;;££©©©©——šš’’¥¥¤¤ÌÌÃÿ¿››ŽŽ‚‚xxppZZiibbEE^^NN44WWHH55ii``GGqqffJJppeeLLll``IIjj\\JJbbTTBBYYKK77UUEE11__LL<>wwaaFFjjPP’’€€pp··ªª  ½½ºº´´œœ  œœ¦¦¨¨££WWYYTTKKOOJJ§§´´©©ÍÍÍÍÃÃËËÐÐÁÁvv††((9999„„ŒŒ††¸¸ºº²²´´³³­­ÙÙÓÓÐÐÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿþþüüýýýýûûüüþþüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùùüüûûÜÜääííÝÝååëëßßééëëááêêììããììììääïïëëèèððððííòòööððõõúúòòùùûûóóúúúúõõüüüüôôûûûûòò÷÷øøññõõööññõõööôôõõøøøøùùûûùùúúüüúúûûÿÿúúûûÿÿûûýýüüûûýýüüûûýýüüûûýýüüúúüüûûúúüüûûúúüüûûúúüüûûûûûûûûýýýýýýþþþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿççççãã||wwllƒƒxxnn££žž››››’’llttooXX^^aa­­µµ³³ŽŽ››‘‘ZZ]]ZZttmmpprrrrppllrr__iiddCChhUU<>rrOOFFqqPPJJssVVLLvvOO>>TT77**++!!kkiiee„„zzggvvccMMss__MMkk\\AA““„„ll••‹‹zzkkoocc––¡¡››šš““¨¨´´ªª±±··³³88@@>> UUXXXX¥¥°°ªªŠŠžž˜˜ŽŽžžšš––ŸŸœœ¡¡¨¨¡¡½½¼¼¬¬ááÙÙÈÈÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûýýüüèèëëõõééëëóóêêííòòêêïïóóêêððóóëëññôôììóóôôììóóóóììóóóóêêññññêêññññííôôôôóóùùùùøøùùûûùùùùûûûûüüÿÿüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿþþûûýýüüúúüüûûûûýýüüûûûûûûýýýýýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèèèèå厎ŽŽ‹‹rrrrnnjjkk``ccbbTT’’ˆˆ~~¨¨¤¤——––˜˜‰‰‘‘––‰‰’’””ŒŒ••““||††~~PPXXXXggrrqq{{‚‚mmjj``nn__KK©©œœŽŽ``eebb__DD??xxMMBBrrHH;;22 - -??FFBBšš¤¤˜˜……||rrppaaTTqqhhVVxxooXX––zzÁÁ»»®®‹‹‡‡ŒŒ’’¡¡¤¤žž¢¢§§  zz‡‡€€\\ggcc’’œœ››±±¶¶µµœœ©©¡¡ww‡‡~~››––••ŸŸžž““šššš­­ªª¡¡ììääÕÕÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüýýüüééììóóééììòòêêîîòòëëññóóëëòòóóëëññóóëëññòòëëòòòòêêññññêêññññééïïððììòòòòóóøøùùøøùùûûûûüüþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÿÿÿÿüüþþýýýýýýýýþþþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýýýÿÿÿÿýýÔÔÔÔÌ̉‰ƒƒ††~~xx„„ttaaddUUYY^^MMˆˆ{{²²ªª  ŸŸ‘‘šš  ˜˜‘‘——™™‡‡‘‘‘‘‡‡––••‘‘      žž””‹‹……uu««¢¢šš±±µµ¶¶KKYYZZ11..''aaEE88RR22&&TTccee¢¢²²°°ªª··¬¬uuwwmmffeeVVttrr__yyuubb››ŠŠ½½¾¾³³°°µµ²²ŸŸ££¢¢œœœœ››‡‡ˆˆww‚‚yy˜˜¡¡žž´´··¸¸˜˜¢¢¡¡[[kkhhXXbb__‹‹••““ŽŽšš˜˜——™™››ŸŸééããØØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþÿÿýýþþÿÿýýþþÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûüüüüèèîîññééîîòòêêððóóëëòòóóëëòòññêêòòññëëóóòòëëòòòòííôôôôïïôôõõïïóóôôïïôôõõôôøøùùúúûûýýýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýääââàࣣšššš‘‘…………  šš––ŒŒ€€~~˜˜¡¡„„||ŠŠrrddhh\\OO__\\NN““ŠŠ~~ºº««¡¡¢¢¢¢˜˜‰‰––‘‘„„””}}‹‹nnyyyy€€‰‰††••šš——¡¡££¤¤““””‡‡‰‰||¥¥££˜˜»»´´°°  ¤¤¢¢>>JJDD22++##BB33//yyyyyy©©¸¸¶¶««··±±¡¡¥¥››††‰‰{{””••ƒƒ}}}}llqqrree««««  ¹¹ºº°°µµ··®®ªª±±©©––  ››rryyvvŠŠ‘‘ˆˆ­­´´±±™™¦¦¥¥>>SSQQ++<<==KKRRWWŠŠ‹‹ŠŠ——’’‰‰––““¢¢¡¡§§ååààÑÑÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿþþüüýýÿÿüüþþÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýýýééïïòòêêððóóëëññôôëëòòòòëëòòòòëëòòòòììóóóóííôôôôððööööòòøøøøôôùùúúööúúûû÷÷ûûüüûûüüþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùù÷÷ööõõôôóóúúùùùùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýûûûûââØØÒÒÃý½µµ¬¬ªª¤¤ˆˆ††ƒƒ‚‚ttuu……~~wwmmxxrryy{{xxuu’’}}kk{{kkXXff\\OOhhYYOO™™ŠŠ€€ººªª  ’’ˆˆqqzz||ˆˆŽŽpp{{{{vv||——––——ŸŸ¡¡ŽŽ““„„‰‰}}¤¤¤¤››²²®®§§¤¤©©¤¤‡‡››˜˜77HH@@VV\\^^››££©©¤¤±±ªª¢¢°°¤¤‡‡ŽŽ‚‚mmppeennmmcchhooddppzzqq˜˜››——³³³³­­´´¶¶¨¨°°··««¤¤¯¯§§šš¢¢žž­­µµ¬¬¬¬³³°°££žž**CC??!!""TTZZ^^„„ŽŽ††““ŽŽ‹‹””‘‘­­©©®®ææßßÎÎÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþÿÿýýþþÿÿýýþþÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýýýêêññôôëëòòõõììññõõëëòòóóêêññòòëëòòòòëëòòòòííóóôôððöö÷÷óóùùúúøøýýýýüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüûûüüïïììììææääàà××ÔÔÑѾ¾»»ººµµ½½¹¹ººÄľ¾½½ÁÁººÂ¾¾··ÀÀ³³°°½½²²¬¬¿¿³³­­Â¾¾¹¹ÎÎÍÍËËÜÜÛÛÚÚççèèææííëëëëôôððññûû÷÷÷÷ööññòòúúøøùùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿõõõõõõ»»³³°°¤¤’’……œœ‘‘‰‰ššœœ››¦¦¨¨¦¦µµ©©  ¤¤ŒŒ€€eecc\\mmmmeeŠŠttddss__~~ggUUeeWWLLbbTTII„„wwkk³³©©žžŠŠˆˆ{{llttkk‚‚ˆˆˆˆ‰‰••””||‡‡……oowwssˆˆ††‰‰––––››™™ššŸŸ››      œœ££ŸŸ””¤¤œœ‘‘¢¢ššWWkkbbUUbbcc‘‘ŽŽœœ““””  šš››————‘‘ŽŽ””’’ŽŽšš——……’’ŽŽˆˆ‹‹‹‹››œœšš§§¬¬¦¦¤¤¨¨¥¥ŠŠŒŒ‰‰‡‡ˆˆ››¡¡™™žž¥¥¡¡šš¦¦¤¤qq‚‚00@@AAYYbbee‚‚‹‹‰‰††‘‘ŽŽºº¶¶¶¶ääÛÛÈÈÿÿÿÿùùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþüüýýþþüüýýÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿýýüüþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûýýýýééôôööêêòòõõëëððõõêêïïôôêêððóóëëòòòòëëññóóììòòõõððööúúõõûûýýøøýýþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþüüÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþûûûûûûùùõõ÷÷ëëääææÚÚØØÕÕÉÉÉÉÀÀ¼¼¶¶¯¯ªªžž••žž——ŒŒ††rr€€zzrr‰‰……šš””››œœ••©©¢¢““¼¼ªªŸŸÄÄ®®  ¬¬šš‹‹zz~~ssmmzzvv‰‰ŒŒŽŽ­­¨¨¡¡¸¸ªªœœ¾¾´´¦¦Ãþ¾²²ºº°°««¨¨¦¦¤¤°°¶¶²²¼¼ÀÀ¾¾ÉÉÍÍÈÈÝÝÝÝ××óóïïëëööõõññõõóóððûûúúùùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýýýÙÙÕÕÕÕÍÍÈÈÆÆ©©¡¡œœ••‹‹££““††žž‘‘‹‹  ŸŸžž¦¦žž––­­ŒŒ~~¡¡zzkkgg]]RRee``TTƒƒhhXX‹‹hhWWzz^^OOaaQQGG]]MM>>ƒƒrrbb··®®££‘‘‚‚nnxxllŠŠ’’ŽŽšš¢¢‡‡‚‚iippkk||……€€{{‹‹††vv††„„ƒƒˆˆ‹‹ŽŽ’’““ŽŽ˜˜˜˜ŠŠ˜˜””ttww<>UUCC775588::66@@EErruumm’’||dd™™nnOOjjLLkkLL44IIDD44UU[[RRllxxnnŠŠ……{{™™‚‚||  ŒŒƒƒ¨¨ŒŒ||ŒŒnn]]ZZTTEEJJWWRRPPaaee~~€€{{¥¥‘‘±±ŽŽww¸¸––~~»»ƒƒ††ssffhhkkaa‹‹‰‰®®žž¯¯››““››““ŠŠœœœœ™™³³¯¯­­ÖÖËËÃÃááÌÌÆÆååËËÅÅããÌÌÀÀÝÝÍÍÈÈÚÚÓÓÔÔííééêêÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþôôññííÞÞØØÔÔÓÓÆÆÃÃÊÊ··°°Â¤¤šš²²ŒŒƒƒªª‹‹€€¦¦ŒŒ¡¡††yy››€€ppŠŠwwmm††wwttƒƒ€€qq‹‹……uušš~~mmvv\\››ppSSxxYYHH[[KK@@iiUUEEssUUBBkkLL66\\FF22^^GG11‡‡nnYY­­™™ŠŠ¢¢““……œœ••‹‹¢¢››——˜˜””’’iijjggPPWWRR77BB::[[jjaatt‚‚{{QQ^^ZZ..<<99``lljjzz‡‡„„hhzzuuQQbbaaMM]]bbffrruupp}}ww{{‡‡‚‚yy„„„„88CC>>&&//11<>33KKOO]]aa__qqaaššssZZžžtt^^œœppaassffYYZZff^^ppuuoožž……§§‰‰yy„„€€mmvvŠŠ……‚‚©©––ÁÁ¡¡ÉÉ  ÌÌ¥¥‘‘¾¾¥¥——ªª¥¥¤¤¶¶³³³³ÏϽ½¾¾ÏÏÁÁ¿¿ÊÊÄÄ¿¿ààÙÙÙÙààÛÛÚÚÝÝ××ÒÒááÜÜ××ææááÝÝëëããââááÜÜÚÚËËÆÆÃé©££ŸŸÅÅÀÀ¼¼ÞÞÛÛØØÖÖÔÔÑÑÔÔÎÎÏÏÔÔÉÉÊÊÏÏÇÇÃû»´´ªªŸŸ••¡¡––‘‘³³ŸŸ••»»••ŠŠ¦¦‚‚ww››‚‚xxŸŸˆˆ~~œœ‡‡{{™™||hh‰‰oo^^||qqlluussee{{qqcc‹‹ppaaŽŽiiRRffKK}}UU??QQ@@99``KK;;qqOO==llII22\\EE--^^EE,,ttYYGGuuiižžŒŒ‚‚¡¡––œœ——••€€iimmjjXXaa\\RR\\WWww{{ŠŠ„„uu{{hhttmm„„‰‰““ŸŸ˜˜ŠŠ––~~‰‰‡‡„„’’‡‡’’““ŒŒ˜˜””™™¥¥ŸŸ¦¦  uu}}yy""--++ %%//00UU^^\\ccppjjggwwuuxx††‡‡‘‘››––¨¨¬¬¥¥­­±±««²²¶¶°°©©°°©©  ©©¤¤——¢¢ŸŸˆˆ••‘‘€€ŠŠ~~ŠŠ¼¼Åž¾üüúú÷÷ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüûûøøøøùùõõôôúúôôóóùùóóòò÷÷ôôôôôôóóóóóóóóóóóóóóóóóóôôôôôôùùùùùùüüüüþþÿÿÿÿÿÿÿÿÿÿÿÿúúýýüüééóóùùêêòòøøëëðð÷÷êêïïôôêêððôôëëññööïïôôøøóóøøûû÷÷üüÿÿúúýýÿÿûûýýþþúúüüþþûûþþÿÿýýþþÿÿýýþþÿÿþþÿÿÿÿýýÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþííííêêÒÒÎÎÉɱ±§§žžŸŸŽŽ‚‚zznnee\\ddddSSddhhxxzz{{¡¡ŠŠ€€²²µµªªŠŠrr‹‹qqVV]]RR;;6699--))7788::CCHHrrppffŽŽxxbbllPP„„bbGG``FF..11**""))77??>>~~jjYY““nnMM““mmLL‚‚^^@@BB4444<>HHDD==GG@@YYee\\YYeeddJJSSWWuu||xx  ¥¥žž©©­­§§©©­­§§§§ªª¡¡¡¡¦¦žž››¡¡ššŒŒ——ŽŽ””••ââääßßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýýýúúúúúúõõõõõõôôôôôôóóóóóóóóóóóóôôôôôôóóóóóóôôôôôôööööøøùùúúûûùùþþúúóóøøõõííøøÿÿïïööüüññõõúúññõõùùññõõùùòòööúúòò÷÷ûûòòõõúúööøøüüùùúúýýùùúúüüúúûûýýúúûûýýúúûûýýúúûûýýûûüüþþûûýýüüûûýýüüüüþþýýüüþþýýýýÿÿþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿääááàࢢšššš{{rrrrzzyyww‡‡~~‰‰||¢¢ƒƒtt––sseenn\\UU>>LLUU<>KKJJccee__……ttddŸŸww``––rr__uuff\\cchh__mmmmbbiihh^^}}ssff’’}}ll¢¢€€ll••tt\\ff__\\||{{²²ŠŠÀÀœœŠŠ¥¥…………{{xxxx„„‚‚}}ŸŸŽŽ……­­ŠŠww¬¬„„rr||dd……wwdd‡‡uuff……ppggnneexxffWW‡‡ssddšš||iižžwwbbŒŒll\\‹‹pp__””yyhhnn^^||``PPjj\\HH``SS@@ss]]MM~~__JJ}}\\@@{{WW::HH3344..[[GG44ccCC00__DD88``FF44aaGG55ddII77rrSSDD……nn__~~oo``cc\\MMSSRREEUUYYOOaaiiaayy€€||††……€€„„„„ww~~~~hhoooocchhiioorrvvƒƒ‡‡‹‹‡‡ŠŠŽŽ’’““˜˜œœ””˜˜™™‚‚ŠŠˆˆtt~~{{nnyyuullwwssooyyuuppzzvvss~~xxww‚‚jjssvvzz……””’’¦¦¨¨  ¤¤¨¨ŸŸ¡¡¤¤››œœ  ˜˜››ŸŸ————ŸŸ——¼¼Ãû»ùùùùôôÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüüüùùùùùùøøøøøøööööööôôôôôôóóóóòòòòòòððôôôôòò÷÷÷÷õõùùùù÷÷ööûû÷÷ïïõõòòïïúúÿÿññøøýýóó÷÷ûûòòööúúóó÷÷ûûóó÷÷ûûòòøøûûòòööúúòòõõùùõõööúúõõ÷÷ùù÷÷øøúúøøùùûûøøùùûûøøùùûûùùúúüüúúüüûûûûýýüüûûýýüüüüþþýýüüþþýýýýÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿââÝÝßß  œœxxqqqq{{qqrrwwvvttwwzzuu‘‘……yy¢¢„„tt££yyhh••oobb]]OOJJ""88>>00CCCC^^gghh††pp__oo``MMggccVVŽŽwwjj™™wwccƒƒ]]GG==//##--8888VVSSOOUUNNAAjjZZMMkkXX{{``FF||^^CCppZZ::EE9922<<;;::ccTTFF~~``@@……``DD„„]]==^^@@&&??--** - -CCIICC||iiYY‚‚ccLLƒƒffII€€aaIISS<<11EEFFGGggffggttccVVwwbbNN~~__JJww\\AAJJ9933..0011NNTTLLmmVV––llOO˜˜ppRRyyOO>>==44//::CCBBffff__~~qq^^‰‰ooSSjjUUuuZZOOHHTTMMKKYYTT``ee\\‰‰uuffššxxgg¢¢xxff’’ooYY[[VVPPWW[[[[””‡‡uu¯¯ŽŽ||´´ˆˆ€€’’ssqqvvnniiƒƒ}}vv˜˜‚‚vv¡¡~~nn’’ww^^€€mmVV‰‰sscc‹‹pphhˆˆmmaa‚‚hhUU~~iiWW‰‰rr^^––uu[[““kkQQˆˆeeOO……kkVV††iiUU``PPtt__NNjj]]IItt__OO}}^^II~~YY??xxNN77QQ33##66,,""XXDD44aaCC..\\BB33]]CC00]]CC11``EE33ggHH77ppWWFFpp]]LL``RR@@TTLL<>bbNN??rr``GGJJ77..774400ggUUIIzzXX==yyUU;;ppQQ11UU88$$ __ZZLLzzccOO€€aaII€€aaDD{{``CCMM>>--EEFFDDkkkkhhssccRRss^^GG}}^^IIvv[[@@>>--'' !!""^^\\NNŠŠppTT””llOOllMMmmGG5511((""**--++``__UU‚‚xxccˆˆrrVVllUUnnPP@@99::44??EEDDff[[PPŠŠllVV““pp[[ttaa‹‹iiWWQQPPFFOO\\UU……||qq››~~mm¥¥}}cc  ttffii__ttooddŠŠzzpp˜˜zzkk™™xxaa‚‚jjOO{{hhWW‰‰rrhhŠŠnn]]ŠŠllSSxx``IIxxggQQŠŠssVV––ooSS‹‹ggSSttccNNddMM``MMzz``MMrrddPPtt^^NNxxXXCCwwTT<>,,[[@@--__BB..ddII66jjPP@@ggQQ>>``PP>>YYRRAAPPKKBBAA??::@@EE>>BBIIFFAAGGHHFFMMMMGGMMMMNNSSRR]]ccbbfflljjiittnnmmyysspp||uujjxxrrddqqmmddqqmmiiuuqqppzzwwvv}}€€ŠŠ„„ˆˆ’’‰‰““––šš˜˜˜˜  ˜˜¡¡¡¡¡¡¥¥ŸŸ¢¢¦¦žž  ££šš  ˜˜½½ÀÀººôôôôïïúúõõòòÿÿýýûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýýýûûûûûûùùùùùùööööõõôôôôòòôôóóòò÷÷ööôôùùúúöö÷÷ûû÷÷ïïõõòòõõüüÿÿööüüÿÿôôúúýýôôúúýýóóøøûûòòøøûûððööùùððõõùùððôôùùððôôøøññôô÷÷òòõõøøóóööùùôôøøúúõõùùúúõõùùúúööùùúúøøúúûûùùúúûûûûüüþþûûüüþþüüýýýýýýÿÿþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüûû¿¿··¯¯ƒƒzzpp‚‚vvttzz~~xxzzyyvviieeii``iiiixxzznn••oo  {{gg££{{ff||ggVV@@??6633AABBQQ]]YY……yyšš~~ii„„jj\\ggffddttuupp‘‘zzdd}}]]EE77''##&&''VVWWPPee\\MMii__QQjjeeQQ[[DD55PP>>::ffZZKK??,,##,,&&%%ggUUEEwwWW==uuTT99ddJJ++FF11  1111))kk``KKuu__KK}}aaMM}}bbMMss\\II@@55&&8866//rrmmgg~~llWWzzddJJ€€aaIIssYY@@==11++..3322kkbbQQŠŠjjNNggMMllNNttYY;;55))&&&&%%%%YYWWII€€qqWWppXX’’mmVVbbII554411**IIDDFFooVVGG||^^DDˆˆkkOO––qqZZŠŠjjVVQQNNDDJJTTNN€€zzjj}}iiœœ{{``ww^^ŒŒjjZZppeeYY~~qqggšš{{jjzzaaŒŒppTTsseeQQ}}nnaaˆˆnn[[ŒŒiiPPyyccGGtteeJJ……jjQQŽŽjjRR||__HHjj]]II{{aaMM€€``JJ{{``OOjjUUEEbbMM>>kkNN88ooMM44hhEE33KK44%%66++((UU??44bb@@//\\??--\\>>,,ZZ<<++[[==--]]>>--``DD22ddKK99jjRR==ggSS<>//CC==^^ggcc˜˜……yy¥¥ƒƒqq{{eeQQPP[[QQhhllgg‹‹ttaa‚‚``HHOO::**""FFHHAA]]VVAA__OO==``XXHH\\DD99FF6622^^VVHHDD22''..$$$$ccSSAAvvYYAAppRR<<\\EE//==// - - MMII@@rr\\FFww[[FFiiRR??SSFF55TTKK>>==33++AA8811vvffXX††llQQˆˆkkMM……eeKKkkQQ::))((--))ppddSS……eeKKŠŠeeMMhhPP}}ccCCGG6622AA====eeaaSSzzffNN††ggPP‹‹eeOOffMM::<<8833NNGGGGssZZKKxx^^II€€ggMMnnVV‡‡ggRRNNII@@DDJJFFzzssbb  zziiœœvvaa˜˜qqXXˆˆhhVVmmaaUUuukkaa““zzll˜˜xx``qqVV}}hhSSuueeUUƒƒkkXX‰‰hhPPhhLL||hhMM‚‚eeNNƒƒaaIIvv[[BBeeUUCCnnZZIIxx\\GGvv[[II^^HH99UU@@33ddII66jjII44eeCC66KK44$$:://,,WWBB77ddBB22__@@//__??--^^==--^^==//\\;;,,ZZ<<++^^BB11mmRR??nnXX>>kkXXBBccUUEETTHH==2200**))00++,,11--!!!!))----;;??88@@DD==LLPPJJTTYYSSaaiiaajjvvmmggsskkggsslliivvoooozzuuxxƒƒ~~ˆˆ……ƒƒ‹‹‰‰ŠŠ‘‘ŽŽ——””““šš˜˜––™™˜˜  œœ››¢¢ŸŸžž¡¡¢¢  ££¡¡°°²²®®ÜÜØØÕÕïïééççôôîîííøøõõóóþþþþüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýýýüüüüúúûûûûûûúúúúüüùùùùúú÷÷÷÷÷÷öö÷÷óóööööóóöö÷÷ôôôôùùôôïïôôññööüüÿÿööüüÿÿõõûûþþôôúúýýòòøøûûîîóó÷÷îîôôøøîîôôøøííóóööîîóó÷÷ññôôùùòòööúúóó÷÷úúóóøøùùòòøøùùóóøøùùôôööøøõõööùùööøøúúøøùùýýøøùùüüûûüüüüûûýýüüüüþþýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþûûûûÎÎÁÁ¾¾œœ‹‹tteebbyyzz——‹‹€€vvnnRRNNLL<>RR::++OO>>447722""ZZNNAAooSS99vvUU@@TT99**77))KKBB77OODD::VVJJ>>tt]]IIccEE……ggJJ~~__FF^^DD--&&556611mm__NN€€ccLL‡‡ggPPŠŠffVV††hhMMPP==44HHBB??llddYY||eeQQ……eeNNŠŠddMMmmTT@@??5555VVPPKKtt``OOtt^^PPwwccOO„„iiQQ€€ccMMJJFF<>++&&PPKK??FF55''((``SSAAccMM88++??44..44-- &&((''\\MM??jjOO77hhMM88__DD44WW@@22WWEE55QQBB00SSEE77ddQQ??mmVV==ssZZ>>{{[[??\\BB((..%%LLKKCCpp__OO||__HHbbLL……bbPP‚‚aaLLKK88,,AA==66oogg[[zzffSS‚‚ddOO‡‡ddLLccKK==@@8899gg\\UUvvaaTTmmZZNNvvaaQQddLL``HHKKBB==22;;;;]]``SSŒŒssaarr[[‰‰mmRRvvZZDD\\TTGG__YYJJ]]SSHH}}ffUU‹‹hhOOŠŠeeOOyy\\FFhhSS<>ppQQ::ssWW??ww]]DDttXXCCeeOO>>[[SS@@llYYEEooVVBB^^HH66QQ==44VV@@55__CC99eeFF;;II88((00))$$]]FF<>GG@@QQZZUUmmwwqqoo||uu{{ˆˆ‚‚ƒƒŠŠ‚‚ŽŽ‰‰‰‰‘‘––““““™™˜˜’’œœ””ŸŸ  ’’žžŸŸšš‘‘™™››šš  ŸŸ¨¨ªª©©ÁÁÁÁÁÁÜÜÛÛÜÜííëëééôôóóòòööôôôôûûùùõõûûùùõõüüùù÷÷ÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿþþýýþþýýüüýýüüûûûûûûúúúúùùùùùùùùùùùùøøùùûûøøùùúú÷÷ùùùùùùùùùùõõööööññööõõííóóññôôúúýýóóùùüüòòøøûûïïõõùùîîóó÷÷ëëññôôêêððóóëëññóóììòòõõííòòõõîîóóõõïïóó÷÷ññõõùùññõõõõññõõ÷÷óóøøùùõõ÷÷ùù÷÷ùùûûùùúúüüúúûûýýüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿììííç窪˜˜††””rrhhbbXXXXnnzzuu££……¯¯““wwŠŠoo]]IIFF??JJVVTTŽŽŒŒ„„ªª’’ƒƒ­­‡‡ww¨¨……mm§§……kk®®~~jjƒƒbbTT22..""##00''NNXXOOpp[[ŽŽkkSSˆˆiiJJTT;;11::4433hheeTT……kkRRqqUU<<&&VVQQBBppWWDDooWW;;UU66$$ LLCC;;FF33%%((""aaRR@@eeHH77!!>>66//99&&2266//ccSSBBffLL77ddLL99aaJJ66__GG55WWCC00PPAA//MM??55XXHH77ddPP;;iiPP99ooQQ55UU<<$$55**WWRRCCtt__OO~~__IIƒƒddLLˆˆeeMM||]]KKJJ::--BB??33ooffWW{{hhTTccQQ}}\\GGBB//%%;;5522qq^^SSppVVJJhhTTCC{{ccRR‡‡ggNN„„bbGGNN>>99##++..KKSSLL‡‡qq\\‰‰ooXX‰‰nnRRuuYYAAYYMMAAbbXXGGYYNN??rr__MMˆˆhhNN‰‰ddQQbbIIllUU;;ggTT<>33VV??66]]??11AA11##--''##\\CC88ggCC00aa@@11]]<<,,[[::**[[99))[[88&&[[::''YY::&&ccDD00zz__KKyyeeNNzzffSSsseeVVddaaSS4477** - -  - -2222..;;;;22CC??77EEHHAADDOOGG22@@77!!++))'',,))&&++**66>>@@eellnn„„‰‰––‘‘ŽŽšš••˜˜••‹‹••””ŠŠ””””ŽŽ˜˜——™™ŸŸ’’ššžžŒŒ‘‘••eehhddffhhbbˆˆˆˆƒƒ®®­­§§ÞÞÝÝÝÝóóññóóôôóóííôôññììøøôôññÿÿüüûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýþþýýûûüüüüúúûûúúúúúúùùùùùùøøøøøøõõøø÷÷ööùù÷÷ööùù÷÷÷÷ùùúúóóõõøøððõõööêêòòòòññ÷÷úúððööùùïïôôøøííòòööììòòõõëëññôôëëññôôììòòõõííóó÷÷ððõõùùññõõùùññõõùùòòööùùññõõööòòööøøóóøøùùùùúúüüúúûûýýûûüüÿÿýýþþÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿøøøøõõ³³¬¬  ——}}ooggSSKK^^dd]]‹‹²²˜˜µµ””xxjjWWLLKK??yyƒƒzz¢¢ššŠŠ®®““~~¬¬ŠŠuu§§‚‚kkŸŸzzaa››ooSSWW??--MMRRGGkkQQ‹‹hhNNƒƒddCC^^EE99@@::66YYXXGG~~iiUUyy__GG;;%%))$$$$SSPPBBqqVVEEqqZZ>>WW77&&((SSEE??ZZ@@33;;..!!ddOO>>ccEE66@@991155"" - - - - AA>>44ccRR==ddKK77ddMM99ccLL88bbII66ZZAA00CC33&&EE;;44YYLL88^^MM::bbLL99ccLL66YY>>00OO==..ccUU@@uuZZGG€€^^KK……ccNN‰‰ffNN||ccNNTTHH99KKFF99ppffUUwwaaJJ{{\\LLllLL@@00$$MMDD99qqZZHHqqSS@@ssYYCCddQQ‡‡ggOO‰‰jjMMQQ;;--$$!!!!AAGGCC‚‚kkYY††jjWW‰‰llTT~~\\FF^^LLBBkkZZMMeeUUGGooZZJJ‚‚eeQQ……ddRRddKKuu[[BBiiTT<>66YY>>//CC//##..&&!!YYBB33hhEE..ccBB22aa@@00]]<<,,\\;;**ZZ77%%YY88&&XX::&&ZZ<<((rrWWCC{{ggOO||hhUUvvhhYYkkggYY__bbUU0033--  - - - - $$%%##::<<55CCBB::JJPPHHJJXXOO00BB::  [[``__~~††||ŠŠ„„qq{{llxxrrttzzvv……‡‡„„’’••””œœ¡¡¡¡††ŽŽYY``]]PPUUOONNPPLLYYZZTTzz{{zz»»¼¼½½îîïïèèóóóóííÛÛÛÛ××®®¬¬©©êêççææÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿýýþþýýûûüüüüûûûûûûûûûûùùùùùùõõõõõõôô÷÷õõõõøøööõõøøööõõ÷÷øøòòôôööïïôôõõêêññññððõõùùîîôôøøííóó÷÷ììòòõõííóóööííóóööííóóööïïôôøøòò÷÷ûûôôúúýýôôùùüüóóøøûûóóøøûûôôøøúúôôùùúúööûûüüúúüüþþûûüüÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÌÌÁÁ¶¶˜˜ƒƒxxrr[[WWOOPPMMssss¥¥˜˜··’’««ˆˆttddPPAAXXQQFF‹‹††zz¦¦{{««‹‹tt££kk˜˜qq]]††ffLL||]]<<<<-- YYZZMM„„llPP‹‹iiNN……hhGGaaII77--%%""AA@@66ttddTTzzbbJJJJ22""++##!!QQLLBBjjRR@@rrZZ>>^^<<++,,PPCC==ggJJ99SS::++ddOO;;]]CC22##>>55..//##KKCC55ccLL88ddJJ88eeLL88ggNN::hhJJ88NN44$$ ::3300WWLL88[[FF66VVAA44HH88**TT>>44ddOO::llTT<>..HH33&&55''""YYAA00hhEE--ffEE44eeCC44__>>..\\;;++\\88''ZZ88&&YY88%%VV77$$aaFF22yyeeMM{{ggTTuuggXXiiffYY``ddUUVV[[OO--00-- - - - -1133,,MMLLDDRRXXNNRR__UU00==88 ((3322GGSSMMGGQQJJAAKKCCWWZZNNhhff\\jjnnmmlluuttpp}}sswwww‚‚||ŠŠŠŠ¡¡¢¢šš¢¢¥¥¢¢™™žžŸŸŒŒ‘‘••uuxxyy__cc__VVYYXXffiihhÁÁÃý½ÚÚÚÚÔÔŠŠ‰‰EEGGDD  ——ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýþþþþûûýýýýûûüüûûûûûûøøøøøøõõõõõõõõööööôôööööôôööööôôöö÷÷óóôôööïïóóôôëëññòòììòò÷÷ììòò÷÷ììòòööííóóööîîôôøøïïõõùùññööúúóóùùüüôôúúýýôôúúýýôôúúýýóóúúýýóóùùüüõõúúûûøøüüýýùùýýþþûûüüÿÿýýþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿççØØÙÙ¥¥ŠŠzzvveeQQOOOOCCVVff``““——²²••~~²²{{¡¡„„ss]]OO??__[[NNŽŽll˜˜ffœœ||dd——ss^^€€aaMMww__HHssWW>>;;**))''&&jjiiZZ……ooYY‹‹llSS‡‡llOO^^FF.. ..****mmaaUU{{ccHHZZCC22**II@@;;eeUUCCqqXX==VV66$$!!CC@@99ccLL44]]EE22ggTT<>-- 66--%%,, QQDD22ddFF44ddEE77ffII44eeHH33iiFF7744 DD==::XXJJ::TT==--44((&&%%OOII77llUU;;rrRR<>ppVV>>hhRR??HH<<007711**WWNN@@zziiSSyy]]JJvvRR<>ppPP==ooPP<>@@00##&&&&"",,((%%^^__RR……ss__ŒŒppUU‹‹ppRRggJJ44&& WWKKBBxxbbIInnUUCC99(( ;;44..^^RRAAooWW??OO.. - -665500``JJ44eeJJ88kkVV??WW;;++**##"" WWGG33__CC--__??11bbBB//ddDD00[[==// OOEE;;^^II::MM99((%%##9988,,VVPP==kkSS==qqSS??nnSS??mmTT??kkVV<<8811  3344..ZZVVDDmm\\DDvvVVAAmmJJ44CC00##%%**##JJHH??nn[[HH||__II€€``HH€€``II``II‚‚ccGGnnRR<<8877''OOJJCCeeYYLLss__II}}ggLLrrYYAAJJ:://hh[[LLoo]]FFffMM??]]MM<>((\\;;%%YY88""ZZ77%%TT55""aaGG22qq[[HHssbbQQnnggWWffffYYddgg[[cchh``DDPPFF337700````NNeeaaNNkkffWWnnjj\\kkii[[jjffQQiibbHHll^^IIiiZZDDttoo``rryyyyaajjeeTT]]TTZZccZZccllddiisshhuu~~rrŒŒ““‡‡šš™™¶¶¶¶»»ËËÌÌÐÐÙÙÛÛØØææèèääÄÄÆÆÂÂxx{{wwuu{{xx††……MMUUTT~~}}xxþþýýüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýþþþþüüýýûûûûûûúúúúúúøøøøøøôôõõøøôôõõøøóóôô÷÷ôôööõõôô÷÷õõóóôôóóííññððææììññççììññêêïïôôêêððóóììòòõõîîôô÷÷ïïõõùùððõõùùññ÷÷úúòòùùüüôôúúýýõõûûþþööüüþþ÷÷üüýýùùýýþþúúþþÿÿüüþþÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÚÚÍÍÊÊ¢¢ŠŠzzŠŠsseeKKIIBBDDPPGGŒŒ‡‡§§˜˜ˆˆ¨¨––¨¨‘‘}}‚‚oo``PPKK;;kknnZZww]]ŠŠwwWW’’uuVV‰‰llSS__NN<>++;; SSGG88^^EE88WW;;--CC00&&[[HH??``OO@@ggPP==jjPP??llTT@@kkUUBB[[HH66 EEBB99bbWWEEhhXX>>llVV<<^^GG..II::,,;;==66CCDD<>XXHH66bbPP<>qqPP==iiJJ99iiHH66kkII77llJJ88llHH77ooKK::ooMM;;eeJJ44XX??..YYBB55]]CC66TT99))GG33%%DD33**XXBB22SS@@((??++TT??55ddNN<>00!!VVPPDDiiTT;;AA--##&&3355))tthhRR‚‚iiNNƒƒiiOOyy[[CC::$$(( UUJJCCiiSS;;__EE--DD--""==33..TTKK;;ppWWBBEE)) 00,,,,ffPP@@ffMM==kkMM88??)) **(())(())&& \\EE88``AA))[[==++ZZ;;**YY55%%-- PPCC55XXAA33VV;;..\\>>33__II@@ddOOAAffOO==iiOOAAllPP::aaMM<>mmZZ??``NN::NNHH::EEJJAAIIGG==pp^^KK||ccKK{{^^FFzz\\DDzz\\DD}}^^EEaaOO77--((KKEE>>QQGG>>ggVVDDuu^^EEjjQQ::BB44++ZZOOAAoo[[DDllOO??SSBB33[[II88ooOO@@ooOO==jjMM99ggHH55iiFF55kkGG66jjII77llKK99mmLL99ddHH33UU@@--XX??22\\??11SS;;((DD00 <<**!!\\EE44ZZDD--??++RR>>33ddKK;;hhEE//ddCC..bb@@,,aa@@,,__??((^^>>&&[[;;##XX77&&RR33!!RR44ZZ@@''ccPP??hh^^NNggddRRffeeXXaaee[[^^ee^^[[]]YY^^]]QQccbbMM``ccIIcceeQQooddRRzzeeRR{{ggMMvvaaHHXXEE//HH88''<<++++cc^^XXttvvwwddmmqqPPYYVVIIKKHHEEIIBBNNRRJJffjjff““‡‡¢¢šš‡‡vvyyddkkppbb°°±±¦¦ëëççààóóììêê÷÷øøööññóóòò´´¶¶··††††‰‰ëëééèèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüýýýýûûüüüüüüüüüüýýýýøøúú÷÷øøúúööööùùõõ÷÷úúööööùùõõôôööòòïïòòïïççììññèèííòòééîîóóëëññôôëëññôôííóóööííóó÷÷ïïôôøøññööúúòò÷÷ûûòò÷÷ûûóóùùüüóóùùüüôôûûûûööýýýý÷÷ýýýýúúüüþþüüýýÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¾¾ÀÀ¼¼}}qqnn{{ooVVHH66445533ddnnaa——““€€ŸŸzz››‰‰ww„„xx‚‚‚‚}}SSXXQQddffTT‡‡xx]]ttXXŠŠllNNiiOO3300''MMHH<>44RR<<++SS<<,,VV??//\\II<>mmPP<>>><>00PP88%%CC// ??..$$[[DD33__CC//AA++EE44**]]FF88ffEE//ddCC..ccAA--aa@@,,``??++]]<<''[[::%%WW66%%SS44""QQ55VV::""__II99ccWWIIffaaNNffbbTT``bbWW]]``XXaa^^TT``__OO____JJ]]bbOO__bbSSiibbPPxxeeMMzzggDDwwee>>UUCC&&::++88,,""%%..,,%%__aa]]__ggffXXffaa\\bb]]PPZZQQKKRROOQQWWZZqqoonn¡¡••……¡¡••iiddQQxxwwgg½½¶¶¯¯ôôëëééõõóóóóöööö÷÷úúøøþþúúùùýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýþþýýûûüüýýûûüüûûûûûûûûýýüüùùûûøøøøúú÷÷øøúúööùùûû÷÷øøúú÷÷õõ÷÷óóððóóððèèííòòèèííòòêêððôôëëññôôììòòõõííóóööííóóööííóó÷÷ððõõúúððööúúððõõùùòò÷÷ûûòòùùûûóóúúúúõõüüüüööýýýýúúûûýýüüýýÿÿýýþþÿÿüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿååããããeeii``aaggbb€€uuooOOBB..<<<<66{{‚‚ss˜˜’’{{ŸŸxxŸŸŠŠyy‰‰xxvvvvSSYYOOoonn]]‰‰ww]]……jjOOƒƒbbEE__FF**++''KKHH::ssZZNNQQ;;11 HHGG<<}}kkXX€€ggRR€€eePP{{]]II66"",,%%dd[[JJss^^AArrYY==II33##.. RRDD66ggSS<>00ZZBB..\\BB**UUDD**ZZ::$$VV11&& 88;;88MM<>;;11qq^^LLww^^EEvvYYAAyy[[CC{{]]EE||\\AAbbKK//AA77$$HH??66JJ@@77ddSSBBooWW??eeKK9900""GG;;22hhUU>>kkRR33UUEE00VVGG77iiOO==llPP==ffNN99eeJJ66ffHH55iiJJ77mmLL99iiHH66ggFF33__BB..TT??--WW>>11XX<<..OO77$$II55%%FF66,,\\EE44ddCC11FF--!!33$$SS==11ccCC//ddBB--bbAA--aa@@--``??--^^==++\\;;))WW66%%TT55##PP44OO11WW>>//^^OOBBaaYYFFbb]]LL\\[[OOVVXXNNRRTTKKLLRREEJJTTEEMMSSHHLLPPFF__ZZIIrr__JJttaa@@vvdd<>WW??++&&<<::11aaOO44ggJJ44XXAA,,  ,,))&&HH<<33PPAA33\\CC..``CC**\\CC**__>>++KK//##??AA11QQ>>++UU88''LL::##NN99##TT==,,\\HH66``OO99II99(( - -  446600ZZLL;;rrTT??rr]]CCjjZZDDccQQ==ZZII55MM::00++$$ ::33--llXXFFtt[[@@vvYY??zz]]BB||__EEyy[[@@ffMM00SSCC//LLAA88LLAA99ccWWHHmmWW==ggNN::11&&JJ==44hhTT??llPP44[[EE44ZZGG::hhMM;;iiOO<>,,WW;;--SS::,,PP99''MM55%%??33((WWCC44ddFF22TT88))11""NN::00ggGG22eeEE22ccDD11``@@--]]==--\\;;++[[;;**XX88((SS44##RR44 PP66##WW??//[[MM>>\\VVEE__XXIIZZ[[NNVVXXNNMMLLGGAADD==CCII@@EEII==GGKK??[[YYEEmm^^GGpp^^<>ppWW==GG55&&::++""[[JJ<>,,++LLCC11TT@@((VV==%%UU==''QQ77$$EE11!!LL::((UUDD....%%  ##EE>>55\\JJ66jjNN::ooYY@@oo^^DDeePP99__EE55??,,##$$@@8800eeQQ>>kkRR::ppSS;;uuVV==zz\\CCxxYYAAooSS::bbPP<>//``@@00[[@@..VV<<**SS77**RR88++TT;;))QQ66'';;00%%TTDD44ffJJ55bbEE33AA00%%FF44))ccEE11eeFF33aaCC//\\==**YY;;**XX;;**XX::**WW99''TT88''UU>>--YYEE55__II::^^NN>>XXQQAAXXSSFFZZYYKK^^]]PPdd]]TT__ZZPPcc^^TT\\YYMMRRTTFFYYXXAAdd[[EEeeRR<>kkTT<>33UU>>**WW@@--RR==//..&&$$11!!::%%""774422UUFF99^^GG22eeKK66kkQQ::nn\\??kkRR66TT;;++$$IIAA66ccNN;;ggMM88ffHH33iiJJ44rrTT==vvSS@@ppPP;;aaMM66;;--"":://,,[[OODDllUU>>kkQQ==99//&&RREE<>..@@00$$YY>>**ccDD00``AA..[[<<))WW<<**WW==++WW<<++ZZ==))WW>>--WWGG99hhYYMMvv``SSpp__MMbbWWCChh[[IIqqeeNNvvjjRRwwmmTT{{llUUyyhhQQee^^CCIIII88==<<--BB::++II;;11ZZDD55ddQQ66]]OO55EE66%%44''&&PPPPHHxx€€yy11::99 $$%%hhiiaaˆˆŠŠ’’ŒŒ˜˜••ŽŽ©©œœŽŽ²²¡¡±±šš‹‹··ŽŽ¦¦——††ttqqggÄÄÂÂÀÀÿÿûûùùÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþýýýýýýüüüüüüúúúúúúûûûûûûúúúúúúúúúúúúúúüüûûùùûûúúùùûûúúøøúú÷÷øøúúööööùùõõññôôòòëëññôôëëññôôëëññôôììòòõõììòòõõììòòõõëëññôôëëññôôëëññôôììòòôôììóóóóîîõõõõïïööööððùùùùòòûûûûôôýýüüùùýýüüüüÿÿþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÜÜ××ÙÙssee\\@@11&&GGGG<<__bbWWuummYYƒƒ{{gg‰‰mmŠŠoo„„||mmeebbVVccjjccnn{{tt„„zz‹‹‚‚ww‡‡yyhh……iiNNeeJJ22 __WW>>ttWW99JJ-- UUNN??rr]]EEllVVAANN>>,,ZZII88]]FF66>>++XXLL>>kk[[CCnnZZ==``OO::>>44))==66--YYJJ77ggLL99CC++ II??11^^JJ11ddJJ33@@++ ''%%XXCC11WWAA00ZZ@@//ZZAA//]]AA-->>-- - -::2200WW>>88WW==00XXBB3333)) 11##)) ''++**LLBB44ZZGG33ccGG55ddII55ggMM88hhRR66ffPP44EE33$$??::..bbNN::jjMM::ggLL77ggLL77kkOO;;kkOO==iiNN;;\\DD33AA,,&&8800++TTGG;;ffRR??[[II66AA22((XXHH99ccPP77]]DD..00""66--""[[GG22bbGG33__FF55^^BB22ZZ;;--XX88**VV66%%WW77%%YY;;&&YY==((WW;;((XX;;++XX>>..\\AA//[[<<,,CC99%%WWII77iiPP>>ggKK44[[CC22BB--""MM77%%__AA**``@@**]]@@00UU>>,,SS??++YYEE11YYEE11NNBB00RRGG::ffXXKKnn]]„„nnYYkkRR€€mmPP††ppRR‰‰ssRR††ssOO††ppNNnn^^BB<<66##,,**,,,,$$00..&&BB<<22\\QQ@@bbSS>>WWFF22JJ88''AA00""55''<<44))qquuhhUU^^WW  DDGG@@iillcc€€„„ww††‰‰ƒƒŠŠ‡‡’’……®®  ¬¬ššƒƒ¯¯——ºº§§˜˜””——ŠŠ––““ÚÚÙÙÕÕÿÿÿÿÿÿÿÿüüüüÿÿýýýýÿÿýýýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþüüüüüüûûûûûûûûùùúúúúùùúúûûùùúúúúûûùùúúüüùùùùüüùùúúûûùùùùúúøøøøùù÷÷ññóóóóììòòõõììòòõõììòòõõëëññôôííóóööííóóööììòòõõììòòõõííóóööîîôôööîîõõõõðð÷÷÷÷ññøøøøóóúúúúõõüüüü÷÷þþþþüüþþýýýýÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿŠŠ€€@@33,,,,!!>><<55jjll^^yyeeŠŠllˆˆ€€ooˆˆ€€oo……ppqqnn``bbff\\qq{{vvŒŒ‰‰””ŠŠ€€‘‘„„pp„„kkTTRR<<)) ::99--ooddHHww[[>>BB''**##aaYYGGooYYBB``II55GG99'']]OO==VV@@00DD22$$aaVVGGkk\\CCpp]]@@NN??,,//&&>>8811ZZJJ66ffLL66@@**%% UUHH55bbMM33ggKK22<<&& - - **,,##ZZDD11XXBB22\\CC22\\AA..\\AA))(( KK@@88XX??55ZZ??00LL88))  11))44)) GGAA66WWGG11``HH55ddFF55bbHH66eeKK77eeMM55eeOO6699** 6600%%bbNN;;llNN;;iiNN::ggNN::ffLL88ddJJ88__FF22XX??//II22,,::55,,SSEE88bbOO==OO>>--II66(([[II77^^LL//[[AA,,11 <<00''^^GG44``FF11\\CC11ZZ>>//WW88**VV66((WW77''YY;;&&ZZ<<%%WW;;$$UU88$$XX::))YY??--^^AA00]]<<,,GG<<$$UUEE33ggJJ;;bbEE..\\CC11DD--##CC..ZZ>>))``@@++\\BB22WWCC11ZZHH55aaOO<<__OO>>RRJJ88PPFF88YYLL<>//&&==//''LLII>>RRUUKK..00++ccee__ppttkkƒƒ††zz„„††~~‹‹ƒƒ¨¨ššµµ¢¢zzcceeSS>>¿¿­­££®®­­§§qq„„{{²²»»µµýýùùûûþþûûüüýýûûüüüüúúûûÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüüüüüúúúúúúûûùùúúûûùùúúûûùùúúùùùùøøùùûûùùúúûûùùúúûûúúúúùùúúøøøøøøññóóóóííóóööííóóööííóóõõííóóööííóó÷÷îîôô÷÷ííóóööððõõùùððõõùùññ÷÷ùùññøøøøóóúúúúóóúúúúõõúúûûøøüüýýúúþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿææÞÞÝÝZZJJCC++!!--11..qqrrdd††}}ii‡‡{{hh„„{{kkƒƒ~~ll‚‚oouuttdd^^aaTToovvss””••””™™……™™‰‰ttllZZII++``\\GGyyhhJJllTT==** 9922''ii__KKnnYYEEOO::**FF88&&^^OO>>GG11!!MM;;,,ddYYJJhhXXAAiiTT;;66&&>>44..bbPP<>$$WWCC99[[>>00]]BB..44##>>55""%%  - -;;7700VVFF33^^HH22hhKK::eeGG77bbJJ88ddII99ddMM77\\HH11..##::55))ccOO;;iiLL88ffJJ66ddJJ55bbGG33aaGG33__FF..YYAA--LL66--??99..ZZMM;;bbOO<>++\\==''WW;;$$VV88%%WW::))]]@@//``@@//aa==..JJ;;&&QQ==,,ddDD55``AA++WW??--HH11''AA--TT;;++\\==**__HH55ggRRCCtt``QQqq__OOhhXXLLZZRRAAXXPP==__QQ>>qq``IIjjOO‡‡mmQQ‰‰mmSSŽŽooSSppRRŒŒooPPuu[[CCGG;;//3322**''((!!((**%%<<9933QQGG==\\KK<<^^JJ99]]KK::XXFF55FF88))BB55++HH6600EE::44JJEE::LLLL>>YY\\TTkkmmgg}}€€ww‚‚††zzˆˆ‰‰€€››••‹‹´´££••­­œœŠŠgg\\EEwwqqkk““——‹‹jjzzjjšš§§ŸŸããââããþþþþþþûûúúúúùù÷÷øøüüúúûûÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþÿÿüüüüüüûûúúûûûûùùúúûûùùúúûûùùúúùù÷÷úúùùøøúúûûùùüüùùùùúúùùùùùùööööööññóóóóííóóööííóóööííôô÷÷îîôôøøððõõùùððõõùùððööùùññ÷÷ùùòòøøúúóóùùûûôôúúûûõõûûüü÷÷üüüüûûüüýýüüþþþþýýÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþþþÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¾¾°°¬¬kkUUHH33%% ..00..qqrrff}}mmzzgg~~zzgg€€~~llqqwwvvddaa``OOsswwss””––––™™““‰‰yycc::..## 4488''qqiiPP~~hhKK]]GG44$$KKDD66mmaaJJggTT@@>>..DD66##]]MM;;BB,, SSCC55bbYYDDffYY>>ZZHH//++88,,&&ffRR??ffRR::::**22%%[[NN88aaLL33eeKK55FF00  - -2200))XXEE11YYBB,,__DD..ccHH00PP::  ..''""``FF::^^@@22\\>>++** !!DD88-- ,,--""VVII88[[DD00aaGG77iiLL>>ggKK99bbJJ77ddJJ88ffLL88PP;;&&(( ##!!>>88..ccOO>>iiLL::eeKK77ddII55ccHH44aaHH55]]GG00]]CC22BB))##++&&[[RR@@hhQQ??ccKK77bbGG11ccKK88bbNN55bbGG3399**""DD99//^^GG44aaFF22[[CC00ZZ??..YY::++XX88((^^>>++bbCC..__@@**[[>>))XX;;''[[==++__BB11^^@@00\\>>..II99&&HH77((^^@@33^^>>))UU;;((MM66++FF11))RR;;00ffOO99xx``MMjjYY€€llYYzzhhVVpp``QQeeYYKKii[[JJvv``MMccKK‡‡ggOO‰‰kkRRŒŒmmRRllRR’’mmQQ‹‹mmLLnnZZAABB<<11,,++##00--&&XXNNBBggWWCCeeRR==^^LL88^^KK77\\LL99UUGG88MM;;00GG88..NNBB55UUOO==ffffZZppttll||‚‚zz‡‡‡‡~~ˆˆ‹‹€€••ˆˆ°°‹‹••ˆˆppooggPP **++&&__eeXX``qq^^‰‰••¿¿ÀÀÃÃûûûûüüüüüüúúúúøøúúüüúúûûýýûûúúþþýýýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýþþýýüüüüûûúúúúúúúúùùøøùùúúùùùùùù÷÷ùùùùøøúúúúøøúúøøøøøøøøøøøø÷÷÷÷ööññóóóóîîôôøøîîôôøøððõõùùññööúúññööúúññ÷÷ûûòòùùúúóóúúùùóóûûúúõõüüüü÷÷ûûýýøøüüýýúúýýþþüüþþýýýýÿÿÿÿýýÿÿþþÿÿÿÿÿÿýýþþÿÿûûüüÿÿûûüüþþûûüüÿÿýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¬¬¡¡šš‚‚ggWW33$$1144..__aaXXuuxxll{{||kk||{{hhoo‚‚……vvxxyyiieeggYYvv~~~~————––‘‘XXGG00JJMM::wwkkQQ~~ffLL\\HH22@@22##__VVCCkk]]FFQQ>>--88**GG::''\\JJ88==''UUEE88dd\\AAZZLL33MM;;%%22##77++$$ccQQ>>ccOO7788**9922%%[[QQ;;``MM88ddKK99MM77&& - - - -::22++XXGG00XXAA'']]>>((aaEE..QQ==%%  99//''^^FF33[[BB..SS88##""$$9911&& - -RRGG55^^EE44]]??--bbFF88ggMM::ffMM22ddLL44bbGG33aaFF55@@..((//((!!??77**hhSS??jjQQ::ggMM99ffLL77ddJJ55ddHH66``DD11ZZBB11--PPII99ffNN<><<66(( ..++""]]RRDDaaQQ;;ffTT;;eeRR;;__KK55^^LL55]]PP77LL>>((EE77$$KK==..TTFF55ffaaSScckk^^rrvv‡‡ˆˆ‹‹€€——ŽŽ€€‰‰{{gg‚‚uuXX}}``vviiUUnnffUUoojjUUbbjjUUˆˆ··¸¸»»ýýýýüüÿÿÿÿüüþþüüÿÿþþüüýýûûúúøøýýúúûûÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþÿÿÿÿüüÿÿþþüüýýüüúúúúúúùùøøùùøøøøøøøøùùùùùùùùùùùùøøøøøø÷÷÷÷÷÷øøøøøøøøøøøøððòòóóòò÷÷ûûòò÷÷ûûóóùùüüòòøøûûóóùùüüóóùùüüôôúúüüõõüüüüööýýýýøøþþþþúúþþÿÿúúÿÿÿÿûûÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüýýÿÿúúûûýýøøùùûû÷÷ùùûûûûüüþþýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþ¬¬  ——ˆˆnn[[CC55$$..00))SSVVNNmmppffvvxxii}}~~oo€€uu‚‚……{{uuzzooggoohhwwƒƒ……‹‹}}ppaa,,""]]YYAAvvhhKKyyeeIImmYY<>))88**LL@@00WWFF33::##[[II88``UU<>00!! >>22**aaOO88``LL66;;--##::33))YYQQ>>^^LL88ffLL99OO88'' BB77))ZZII11WWBB((ZZ<<%%__CC,,TTAA((  ==66,,WWFF00RR>>''GG33 - - ----##<<22$$&&##BB77((WWCC00XX<<,,YY;;--^^DD55ffOO66ffPP11ffNN33ffKK77__GG88..##%%-- FF::..mmUU@@jjQQ99ggMM88ffKK77eeKK66eeJJ66eeFF11OO::%% OOEE66aaOO<>((``AA--^^@@00^^@@//``BB11^^CC..ZZAA**XXAA))KK;;))9900##JJ==,,\\HH66ffTTEEhh\\OOccZZMM__YYLL``\\OOssffYY{{jjUUyyjjOOssddMM[[OO@@GGCC99OOKK>>qqeePP‰‰qqSSnnMM‘‘nnOO’’nnNNŽŽllLL‹‹jjJJeeBBqq^^>>KK@@--  - - DD>>88]]PPDDeeSS==jjTT>>__JJ77MM==((VVII11ddZZ>>XXMM66EE;;''HH==**SSCC11gg\\OOLLRRCC__kkaaƒƒ’’‚‚††zzNNHH88gg]]HH™™……pp˜˜‹‹rr——ŽŽuugg‚‚||ff‘‘””··¸¸¶¶ÿÿÿÿøøÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿþþüüýýþþúúûûÿÿúúúúþþûûøøÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿþþÿÿÿÿýýþþýýûûûûúúúúùùùùùùúúúúúúùùùùùùùùùùùùøøøøøøøøøøøøøøøøøøøøøøøøððòòóóôôúúüüôôúúüüõõúúýýôôúúüüôôûûýýööüüþþööýýþþ÷÷þþþþùùÿÿÿÿûûÿÿÿÿüüÿÿÿÿüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüýýÿÿøøùùûûõõööùùôôööùù÷÷øøúúúúüüýýýýÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿööööõõ˜˜ŽŽƒƒ€€jjUUoo\\HH33((**%%99<<66JJOOFF]]__RRssuuiiyy€€……~~rrxxppffllcc~~„„||yyvv==))&& 1177//kkccJJssccGGvvccEEss__??llZZ;;llYY>>LL33""66 77**##JJ<>44,,]]LL44^^II44::))""::--''^^MM>>bbKK;;eeMM::JJ55$$ FF::((ZZJJ22ZZDD--]]>>**``DD//VVBB** AA::11JJ<<**@@22""@@// - - 88//,,NN;;..XXNN??ddNN::[[EE,,SS;;''QQ99**II44((ZZFF22kkWW<>hhNN>>aaLL;;XX<<..00$$ HH==55]]GG22^^DD//\\BB11ZZ??//[[==..]]>>--ZZ==))WW;;&&^^AA..``BB33aaCC44``BB33]]CC33YY??11VV??00PP@@66GG??::aaXXQQvvjj__zznnaawwnnbbddaaQQVVXXIILLNNHHYYTTHHrreeOOwwiiPPuueeOOMMBB;;##!! &&((%%DD>>44‚‚nnWW’’ssVV••ooQQ––ooOO‘‘ooOOŠŠmmLL„„hhHHpp]]>>\\OO::""VVMMEEaaRRBBhhUU??iiRR??aaHH99FF55$$==33 MMEE11OOGG44KKAA--LL@@,,YYGG44kk[[LLTTRRAAHHKK>>zzttjj’’‹‹‹‹tt7777%%wwoohh}}||kkVVYYFFŒŒ~~nn‚‚~~hhttyynnœœ™™’’þþþþøøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþúúøøûûööññþþûû÷÷ÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿþþÿÿÿÿþþÿÿýýýýüüüüüüúúúúúúúúúúúúúúúúúúùùùùùùøøøøøøøøøøøø÷÷÷÷÷÷÷÷÷÷÷÷ððòòóóööûûüü÷÷ûûüüøøüüýýøøþþþþøøÿÿÿÿùùÿÿÿÿøøþþþþøøÿÿÿÿúúÿÿÿÿüüÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿüüýýÿÿùùûûüüøøùùýýööøøúúööøøøøúúüüùùýýÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÙÙÙÙ××ttnnddxxjjYY||jjYYaaPP??))##!!0044--OOUUNN||ƒƒ€€‰‰ˆˆiissqq``gg__{{vvZZZZRR ,,--%%bb^^QQmmeeMMrrccHHwwaaEEllXX<>//))__KK==aaKK::eeQQ<>))--""AA77//YYII44ZZDD11[[AA33WW>>..YY==++\\??,,]]BB//YY??,,YY>>,,\\AA00]]BB33ccGG::jjUUCCeePPDDYYOOHHaaZZTTiihh``ooqqjjvvrrhhzzll]]tteeVVQQJJ77>>==3388::==BBAA;;hhaaMMrrffSSxxeeSShhZZOO@@9922$$%%!!0000--ccYYJJ††nnUUnnRRkkOOŠŠllQQllPPuuaaJJ__TT??CC@@--""%%AA::44ggYYGGnnXX>>ffOO66ddOO::nnSSAAjjTTCCMMCC009955$$8855""KK??((TT@@//YYCC33ggOO??ggYYEEUUNN==JJLL>>iihhVVƒƒrrffaaaaKK!!..%%``eeZZggpp__``QQHH~~ffqqpp^^„„yymmôôððééÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþûûööþþúúööÿÿüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿýýýýýýüüüüüüûûûûûûúúúúúúùùùùùùùùùùùùùùùùùùööööööööööõõïïññóó÷÷üüýýøøüüýýùùýýþþùùÿÿÿÿùùÿÿÿÿúúÿÿÿÿùùÿÿÿÿùùÿÿÿÿúúÿÿÿÿüüÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿýýûûýýûûúúüüüüùùûûûûúúüüùùúúüüùùüüþþûûþþÿÿüüþþÿÿþþýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÀÀ¼¼··WWPPIIlldd[[uujj]]rreeTT;;55%%!!%% ++5511PPZZYYkkwwxxZZddffVV__ZZllyyllGGKK==%%))!!IIMM@@iiccTTrriiVVnnccHHssddHHqq]]FFII77##33$$??::%%//**// >>11**TTBB22__HH11__KK55WW??--;;''EE22##[[GG55CC// ??66--\\LL66]]HH11JJ66++JJ77,,]]HH99__KK::ddOO::@@//  ==77''\\MM66aaMM88ffJJ88ddJJ88UUCC..@@;;33))!!<<33))NN==00 7777))__PP::bbNN77eePP99``SS99\\LL77??//""$$GG<<--ddXX@@hhXXBBddRR99%% - - &&!!""%%++((bbVVBBllXX;;jjXX77ggSS55ddNN44ccMM55ddOO::hhOO55YYEE,, !!SSII>>\\OO77``MM88ffNN;;aaOO::__NN99OO==**## <<..$$VVFF44WWFF33SS??00SS==++QQ99$$UU;;''YY??--__DD22aaHH55aaOO==uuddTT‘‘rr››‹‹||‚‚ssbbhhdd]]hhggggffmmgg``kkaaggffYYyyggWW{{ffQQ\\MM338811''221166;;;;::dd``TTrrjjZZxxmmYY||mm]]rrhhSSFFBB4499::::VVRRHH{{hhSS††kkSS„„ffNNuu\\EEZZKK44DD==**,,(( 7722..ccVVFFoo^^EEyy``BBqqXX::ddNN33jjQQ88kkVV??XXNN66GG@@//??77**MM<<,,WWBB//ZZBB00ddII88iiSSBB__SS@@KKLL66OOLL77ii]]MMlliiRRbbcc\\‚‚}}rr€€ss""^^RRKKzzaaVVRR==bbVVDDÓÓÊÊ··ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþûûÿÿþþýýÿÿÿÿÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýýýýýýýýýüüüüüüûûûûûûúúúúúúúúúúúúúúúúúúøøøøøøøø÷÷øøððòòóóøøüüýýøøüüýýùùýýþþøøþþþþ÷÷ýýþþùùÿÿÿÿùùÿÿÿÿûûÿÿÿÿüüÿÿÿÿýýÿÿÿÿýýÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿþþÿÿþþþþÿÿýýüüÿÿûûüüþþüüüüþþûûüüþþúúûûýýùùûûýýúúüüþþúúüüÿÿüüüüÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿ»»¯¯¨¨NNGGBB\\[[WWttoodd{{rr``dd^^LL9922%%$$ "" $$<>..## AA66--__KK99eeLL44\\GG11;;++22$$CC66&&YYFF33==(( AA:://\\KK66ZZEE//VV??33YYAA33]]GG77__JJ;;eePP<>;;**YYNN66``MM88eeLL99``II66TTCC..<<9922##AA55--QQ<<--$$&&,,##TTQQ??YYNN::aaXXJJff``JJgg\\HHII>>1166//''QQJJ<<__XXCCddXXCC[[JJ33!!!!""FFCC33bbWWCCiiWW<>kk``SS}}kkWWwweeIIUUII55>><<88EEGGBB\\\\VVnnii]]xxoo\\€€mmZZ{{llPPRRKK55::9944TTMM@@}}ggOO††iiNN††ffLL~~aaHHllZZAA\\TT??KKDD44**%%//++ OOHH??__XXFFeeZZDDqq__DDttaaDDggTT;;``GG11YYEE11RRGG11TTJJ::WWLLCC__NNBB``PP88]]JJ33ccNN99hhUUAAhhYYBBgg]]CCaaYYBBgg]]IIqqiiQQzzxxllšššššš^^ii``xxzziittvv]]NNKK==YYKK77œœ‘‘ssÿÿÿÿùùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿþþüüÿÿþþýýÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþüüüüüüüüüüüüüüüüüüûûûûûûúúúúúúùùùùùùøøøøøøññóóóóøøüüýý÷÷üüýýööûûüü÷÷ûûüü÷÷üüýýúúþþÿÿúúþþÿÿúúÿÿÿÿûûÿÿÿÿüüÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýÿÿüüýýÿÿüüýýÿÿüüüüþþûûûûýýúúûûýýúúûûýýúúûûýýúúýýÿÿüüýýÿÿÿÿÿÿÿÿÿÿ±±¡¡œœ;;22//DDJJFFrruuhh}}{{hh||rrcchh]]QQLLFF88<<;;..3344**,,--%%++..''114433GGRRYYWWkkhhPPQQOOQQVVKKaaggUUmmjj[[ppaaRRmm^^IImm^^LLYYGG66'' --!!JJAA33DD//%%JJ==11__LL99ccMM==MM66''33 66''GG<<%%WW@@..====66++ZZHH77ZZDD33YYCC44[[BB33[[CC44``II;;eeLL<>kkTT==^^KK88LLBB,,KKBB//__QQHHhhZZKKaaTT;;\\MM..eeRR66jjZZ<>77!!!!""JJIIGGjjllZZuunnZZvvggVVmm^^IIccTTAAJJ;;,,""%%@@9911DD// JJ>>44[[OO;;``NN55^^JJ55<<$$//AA11""LLAA++VV@@..UU77&&  ,,''PPBB44UUBB44QQAA33II::''JJ<<))XXJJ88``SSHH]]ZZQQKKKKEE>>==<>44BB33%%kkXXEE{{ffOO„„ggNNjjQQmmPPnnSS’’ppWWooVVŒŒmmSSƒƒjjUUvvggLLiiaaBB\\RR44__NN44ddQQ66ggOO88ggSS@@IIDD447799''SSJJ44bbPPBBddOO>>]]MM33RREE--XXLL66vveeRRˆˆ}}kk††rr……ssˆˆ‡‡xx¨¨¦¦››««°°¨¨mmuunn„„ƒƒ~~®®­­  ŠŠ``ee^^dd``XXeeWWPP““††qqýýûûôôÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüýýýýûûüüûûùùúúúú÷÷ùùúú÷÷ùùýýûûüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüÿÿÿÿûûÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýþþüüüüûûúúúúøøùùùù÷÷òòóóññõõûûþþõõûûþþôôúúýýõõúúýýööüüÿÿ÷÷üüÿÿùùýýÿÿúúþþÿÿúúÿÿÿÿûûÿÿÿÿýýÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûúúøø€€zzttNNKKGG==BB==''22&&==II<>ZZTTFFkkoo\\~~wwqqqqttxxmm‚‚€€ŒŒ——‘‘ŸŸ››ŸŸžž––ŸŸ™™˜˜••™™••ššŸŸ¡¡¡¡¬¬¥¥œœ––––††ss{{uuiiuuyyzzˆˆžž§§••½½¤¤––ÀÀ››œœ„„ttQQ[[OOKKWWWW••ŽŽŽŽ¹¹££¿¿¡¡„„¨¨jjoollNNddddnnxxpp¦¦••´´tt¸¸––uu¿¿šš}}žž~~lloopphh””¾¾««™™Â¨¨˜˜¥¥““––žž––šš¡¡  ˜˜§§££––°°¦¦••®®¢¢’’¶¶žž’’ÆÆœœ““¸¸””ƒƒ••„„‚‚„„‚‚ƒƒ””ŽŽ””‰‰uuˆˆqq~~{{kk””‹‹~~°°——ˆˆ´´’’‚‚¨¨‹‹tt––……ss……€€xx~~~~rr††††uu¢¢˜˜……««••ƒƒ§§““‚‚’’zzttwwddƒƒzzoo™™††zz––~~nnzzuu\\ssttiinnjjeemmddVV__YYKKTTVVNN__^^VVvvmm__||pp]]„„ppSS‰‰ooOOUUQQBB::>>88TTRRHHkk[[JJkk[[EEqq^^HHyyaaJJmmWWEEOO;;**bbPP::rr``EE‚‚eeJJhhNN‹‹ggJJŽŽkkLL’’qqSSppQQrrUUˆˆnnSS„„nnRR{{jjMMddXX::``QQ77__MM55TTEE..RRGG77GGDD66==??))OOFF00WWEE77XXGG77XXKK55SSJJ00WWMM99dd\\HHvvoo]]}}~~qqzz}}rr‚‚vv……ŠŠss€€~~DDRRRRBBEEBB]]ffaaaarrkkggllccddddVVee__QQeeZZPPÉɼ¼ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüýýüüúúûûûûùùúúûûøøúúúúøøùùýýûûüüÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûüüýýööüüüüööÿÿüüóóÿÿýý÷÷ÿÿþþùùÿÿÿÿüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýýýûûýýýýûûûûûûùùúúúúøøòòôôóóööüüÿÿööûûÿÿõõûûþþööüüÿÿ÷÷ýýÿÿøøýýÿÿúúþþÿÿúúþþÿÿúúÿÿÿÿûûÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿþþÿÿÿÿýýþþÿÿýýþþÿÿýýÿÿÿÿýýÿÿþþþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿûûùùøø€€zzxxKKNNAA>>AA--))""""%% >>DD==[[aaXXbbiiaacciidd]]cc__VV^^[[RR\\\\JJYYVVDDVVRR**6655AAII@@ttuuhhvvtt^^yyrr^^vvmmVVrraaMM]]QQ::00'' 77//%%PPDD55__KK::``OO88bbNN==\\II..88%%##??,,VV??--WW==--HH44&&$$CCFF>>UUZZQQbbff]]ƒƒ~~˜˜——””¤¤¦¦’’‹‹ŠŠhhqqnnffyyvvœœœœ™™µµ§§žž¼¼¦¦––ºº££””¨¨““††‡‡‡‡‰‰šš””¦¦¦¦žž¨¨ŸŸ””||}}ss^^jjgg]]uurrwwˆˆ||  ƒƒ´´ŒŒ}}  }}jjXXTTIIEEPPLL}}}}{{ªªšš……´´™™}}••zzllVVXXUUHHZZXXkkttjj™™zz©©ŠŠss©©††kk¥¥„„iiiiXXWW^^[[mmttww¬¬œœ¼¼ŸŸ‚‚€€ƒƒ~~††‡‡††””••ŽŽ§§¡¡””©©ŽŽ‡‡ww™™ŠŠ||¶¶••‹‹°°••~~‚‚yyttssxxuuŒŒŠŠ}}ƒƒqq……{{jjyyppee~~uujjššˆˆuu¨¨‰‰uu¦¦……mm‹‹rrbbttggcc||xxnnwwrrcc——ˆˆyy··››ŒŒ¶¶——ˆˆ¬¬““€€~~llYYggTTKK’’~~uu||mm~~rrXXhhaaRR^^[[VVddddZZ]]``UUWW[[UU__^^VVssjj]]yyll[[ooUU„„mmPPYYPP??CCCC::PPMMDDjj[[MMnn\\FFqq]]EExx__FFzz^^IInnUUAAkkVV??rr\\FFaaOOˆˆccOO‡‡eeMMŒŒjjMM‘‘qqSSrrTTŽŽssWWttYYŒŒtt\\||iiOOkk__CCggXXAAiiYYBB@@66!!##KKCC99WWNN==UUNN77IIAA--@@22""NNCC11UUMM77ZZTT99``[[FFjjddZZooppkkmmqqll‚‚††bbhhbbHHRRNNZZdddd,,3333##--11ZZhhlljjppllffiiWWaa``II[[TTCCˆˆxxÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýûûüüùùöö÷÷øøõõööúú÷÷ùùûûùùúúÿÿýýþþÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüýýÿÿøøóóîîææèèÚÚÍÍôôèèÚÚýýòòììþþôôòòÿÿ÷÷õõÿÿüüüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþüüþþþþüüüüüüúúûûúúøøóóõõóóùùþþÿÿøøýýÿÿøøýýÿÿøøýýÿÿøøýýÿÿùùþþÿÿúúþþÿÿúúþþÿÿúúÿÿÿÿûûÿÿÿÿûûÿÿÿÿûûÿÿÿÿûûÿÿÿÿýýþþÿÿüüýýÿÿüüýýÿÿüüÿÿýýüüþþýýûûýýüüûûýýüüüüþþýýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÚÚÐÐÑÑTTJJMM33;;11,,..$$""--55//55>>77;;CC@@NNWWUULLXXWWJJWWXXKKZZZZOO``\\<>//UUCC99ggWWCC‚‚zzrrŽŽ‹‹ŠŠ||ˆˆ††}}‹‹‰‰““ŽŽŸŸšš¨¨™™ŠŠ””wwqqqqhhnn||uu‘‘ŒŒ­­››‘‘¼¼  ŒŒ¿¿žžˆˆ´´‘‘„„„„zzvvpp}}zz‹‹““ŽŽ¨¨žž••––ˆˆ}}rrtthheexxqqtt‚‚zz˜˜‹‹zz¨¨‡‡pp¡¡||ffmm^^SSSS\\UUss}}ww  ™™……²²˜˜€€™™}}qqSSPPKKGGSSPPeekkddƒƒ}}mm¢¢‹‹ww¨¨……nnššhhmm]]NNPP]]WWmmyyzz——ŒŒ££ŠŠ{{——„„qqss{{qquu||zzŠŠŒŒ„„¢¢™™ŽŽ••‰‰}}rrppaaŠŠ‡‡yy««’’‡‡°°““zz„„{{ssjjookk~~€€uu……rr––ˆˆuu‘‘€€ssuumm‚‚xxžž††ss  ‚‚iittddjj^^YYffeeZZggeeUUsshhWWœœ……tt§§„„rr¥¥kk””vvaaccNNDDllddXX……yyhhˆˆtt[[zzggVVYYMMGGbbccTTggiiZZ\\[[UUVVVVMMooffXXwwiiXXzziiVV€€llVVll\\JJQQII>>WWQQIIjj[[PPqq^^GGss\\BByy^^CCzz[[BBvvXX@@qqVVAAvvZZHHƒƒ``NN††ccNN††iiOO‰‰iiOO‰‰llQQŠŠooSS‰‰mmSS‘‘ww``““zzeewwddMMgg[[BBeeUUBBssddPPTTKK8822**$$ZZLLAAaaXX??XXNN559900IIBB))XXRR;;ZZVV@@\\XXFFmmkk]]iinnggddkkff‘‘˜˜’’jjrrnnSSWWQQ••˜˜““ooyyzzZZddhhllwwzzss~~yyww{{oo^^__JJ]]YYEE{{qqccõõòòïïÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüýýùù÷÷øø÷÷ôôõõûûøøúúýýûûüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿüüÿÿÿÿûûÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿììèèååØØÈÈ»»ëëØØÉÉøøììååøøííëëøøððííøøôôõõüüúúûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüþþþþüüýýýýûûüüüüùùôôööôôùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùýýÿÿùùþþÿÿúúþþÿÿûûÿÿÿÿúúÿÿÿÿûûÿÿÿÿýýþþÿÿüüýýÿÿüüýýÿÿüüýýþþúúüüýýøøùùúúøøúúûûùùúúûûûûýýþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿªª››ššDD9988!!++&& --8844@@LLKKBBPPSSLL\\[[WWccaaIIMMLLeecc``wwuujjwwrrbbwwnn\\wwjjXXiiZZHHFF88&&((!!++##MM??44UUGG;;\\HH88__GG55\\HH33UUCC**;;--00!!>>;;))VVXXJJƒƒ‚‚ww¨¨””¤¤——••……qq}}€€xxƒƒ††ŠŠšš££””‡‡’’xxgghhccaaqqkkww~~uuŽŽ††zz¡¡ŽŽ{{ªª““zz´´}}““€€uukkjjhhYYdd``††ƒƒvvœœ‡‡xx……xxkkZZffZZffqqee““‡‡xxœœƒƒmmœœzzeevvkkXXLLYYMM__jjaaŸŸ““¨¨||™™ttddaaXXVV]]YY\\aa\\rrnnccšš……tt¦¦ŠŠqq’’yy``CC::**--7700rryyvv››””‰‰  }}ŽŽ‚‚ooppxxnn€€ˆˆŠŠ““ŠŠ——ŠŠ~~ƒƒvviiiikk]]ŠŠ‰‰}}§§‚‚ªª‹‹wwˆˆ~~rreellggzzxxqqŽŽƒƒvv››ŒŒtt˜˜††rrxxoodd‚‚zzrršš‰‰}}žžˆˆrr’’€€mmgg^^WWZZ\\RRbbeeUUaa__NNttkkYY™™}}jj¡¡{{gg””{{aaqqccPPSSMMEErrhh^^ŒŒyydd‰‰tt``VVGG99bbZZJJnnhhYYcc^^UURRRRLLggaaVVwwjjYYxxhhVV~~iiWWuubbOOXXNN==TTMMBBhh]]SSssbbKKss^^CCww]]>>xx]]??xxWW>>zzXXBB||^^FFbbGG„„eeJJƒƒggJJ‚‚ffKKƒƒggLL„„iiNN„„llQQŽŽvv\\‘‘zz``yyddLLeeTT<>rrccNN__YYDD##&& - -KK??11ii[[EEjj[[??__SS33]]WW88bb__CCXXPPAATTPPBBzz||pphhssccddmmccžž¥¥‡‡’’ˆˆ††……””˜˜––ˆˆŽŽŽŽ‡‡„„~~…………‰‰““jjqqiiLLNNBB\\XXMMyyppjjôôððððÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþûûùùúúøøõõööýýûûüüÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿþþûûÿÿýýúúÿÿþþúúÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúøøööììääÝÝððççÝÝùùððëëúúòòîîùùññîîööóóññøø÷÷õõþþüüûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýýýýýûûûûúúøøóóõõóóùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿúúþþÿÿúúÿÿÿÿüüÿÿÿÿýýþþÿÿýýþþÿÿüüýýÿÿúúûûýýøøùùûûöö÷÷úúöö÷÷úúöö÷÷ùùùùúúýýýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ··©©¥¥nn\\QQ;;::00  $$"" - -  ..99==QQaa``QQeeccIISSNNkkllffzzuullwwrreeoojjXXlleeRRXXPPAA44++''""@@9911YYJJ<>FF??00WWMMIIwwhhNNwwddIIzzbbJJ||bbII}}]]DD}}ZZBB{{]]BB~~``CC€€ccFF~~``DD||aaEE~~ccGG€€eeJJƒƒkkPP‡‡ppUUuuZZ’’zz``ŽŽww__llVVwwhhRRSSNN99@@::..7700''CC??//ggWWCCpp[[AAssaaAA~~qqQQ‰‰aajjffOOTTWWCCqq{{iiJJXXQQDDKKMM‡‡ŠŠ™™¥¥˜˜ŸŸ¨¨œœ••††‰‰††““yy~~>>FFEEGGGGBBaacc[[bbee[[‘‘‹‹††ÿÿüüüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿüüúúûûúúøøùùþþüüýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿýýúúÿÿýýùùÿÿþþûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþÿÿýýûûÿÿýýüüÿÿþþûûþþûû÷÷ûûùùööùùøøõõüüûûøøÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýýýýýûûûûûûøøôôôôóóùùÿÿÿÿøøýýÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿùùþþÿÿúúþþÿÿûûÿÿÿÿüüÿÿÿÿýýÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüýýÿÿûûüüþþúúûûýý÷÷øøúúõõööùùôôööøøùùúúüüþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÌÌÄĽ½yyiizzppbbRRPPCC@@@@44@@BB8899<<55++22**%%""%%0088<>aaPP>>]]OO>>XXLL==VVCC88PP::,,CC// SSII??oosskkjjvvppkkuull{{zzoo||ttjjggffVVVV\\VV``ggiippxxooxx||qq‰‰††~~ŸŸ””„„€€rraaZZQQIIJJFFJJTTMMQQ\\VV€€yyqq——ˆˆyy––††qq’’zzlljj]]TT;;;;33669944^^^^YYttll]]QQLL::FFKK@@zzyyii””eeˆˆtt\\KK@@11  PPKK??yymmTTˆˆttZZmm^^GGTTSSCCIIRREEZZ__QQˆˆ||kkœœ‚‚kk‘‘ww``SSKK@@OOUUVV{{{{šš““……žž€€ƒƒttookkaaqqvvoo••……™™ŠŠ}}ƒƒwwqqllrrll}}uu¢¢ŽŽ§§ŠŠ~~˜˜‚‚qq……}}mmŠŠ‡‡}}ŽŽ‚‚||ŒŒ{{ll‚‚uu^^qqmmcc[[XXWWmmjjggƒƒss‘‘{{hhii``eeXXOOaa]]RRggee__aabb[[rrggXXˆˆrr^^qq^^••ooZZffRRYYNN::ZZUUDDŠŠzzjj††ssaall^^LLii]]NNhh^^QQcc^^UUjj``[[……sshh‹‹vvbb‰‰ooZZ††ooXX€€mmQQEE<<++>>66--vviiRRxxffRR}}ggTTggRRddLL€€aaEE}}aaBB€€ccFFbbEE||__CC{{__DD~~ccGG‚‚ffKK……iiMM††kkOOŽŽssWWœœee¤¤ˆˆoo££‰‰rr˜˜††pp^^ZZEE==::--@@<<33GGDD66ddXXEEpp^^GGqqccEE€€ssWWƒƒjj„„jjuuvvddrr{{jj==JJCC''--11OOTTTT——¢¢››‹‹““eekkggmmqqll††‚‚66==;; JJJJGG„„……€€’’““‹‹ââààÜÜÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýþþýýûûüüÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿýýúúÿÿþþûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþýýûûþþýýûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýýýýýûûûûûûøøóóóóòòúúýýÿÿúúþþÿÿùùþþÿÿùùþþÿÿúúÿÿÿÿúúÿÿÿÿùùÿÿÿÿùùÿÿÿÿøøþþÿÿùùþþÿÿûûÿÿÿÿüüÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýþþÿÿüüýýÿÿüüýýþþüüüüýýýýýýþþþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÕÕËËÃË‹zzhh‚‚zzkkppttffddccXX\\[[QQ\\__SSZZ\\XXUUVVOOJJNNDDNNSSNNOOUUXXUU\\bbaajjll[[iihheejjaazzxxjj{{ppiinngg\\mmnnbbjjnnbbWW^^RR//4422 ((**66;;<>JJII??hhddXX{{mmVVWWMM::7733,, %%%%%%))OOEE>>``WW==uubbCCssaaBBZZSS<>::))3355??FFJJ^^[[ZZdd]]RRUUTTEEIIOODD99;;6699<<99__bb__rrvvrrbbggbbaabbZZcc``VV``[[LLXXVVOOVVYYRRmmmmjj}}wwooyyttccZZ``QQvv~~qq™™ˆˆxxvvkk__VVYYNNKKQQLLJJPPIIppqqggŠŠuu““††nn‘‘ppkk``YYIICC88////&&**--))TTQQHHYYSSEEQQNNBBeebbUUii``JJBB??++0022++####""!!!!RROOEEllbbLLvv__CCuu__BBhhZZBBPPMM<<__^^PPyyoo``{{oo\\ooggRR[[[[LLUUVVQQ????<>EE??33pp\\KKuu]]GGrr^^CCbbUUAAaa\\PP[[[[NNkkggVV„„wwbbww]]uu^^ŒŒqq__||jjTTPPHH88__WWPPuujjRRuuaaKKwwbbMM}}ggMMffHHƒƒeeHH……eeLL……eeLLaaHH}}ddJJ{{ffJJtt``FFxxbbIIƒƒmmPPˆˆqqXXxxcc——iiŸŸ‡‡ll››‹‹rrttkkYYHHBB55MMLLCC^^__TThhddUUjjeeRRffhhVVkkjjYYrroo^^xxxxjj’’……””˜˜ŽŽ‘‘™™‹‹™™’’šš””‰‰‡‡  - - --..EERRPPyy~~yyððïïëëÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿþþüüýýüüúúûûüüùùððõõòòõõûûþþôôüüÿÿóóþþÿÿööýýÿÿ÷÷üüÿÿ÷÷üüÿÿøøþþÿÿúúÿÿÿÿúúÿÿÿÿûûÿÿÿÿúúÿÿÿÿúúÿÿÿÿüüÿÿÿÿþþÿÿÿÿüüþþÿÿýýþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûûûûû¤¤¢¢ŸŸ||yy„„~~€€~~{{~~wwwwƒƒrrppssddrrqqbbppuummffuutt^^uuss__vvuurr}}tt’’~~¡¡„„®®––‰‰¶¶šš‹‹»»  °°––‡‡‰‰yyttddeeddPP[[YYOOYYTTddllffyy~~~~ŒŒ~~zznnUU[[LLLL[[TT]]mmllggyyvvggttrrkkuuttjjppnnbbffddZZ[[XXMMQQIIPPSSQQWW\\XXllooggvvrrffggddTT<>eeWWFFrr\\FFss\\DDhhXXDDcc]]NNZZ]]QQWWXXIIllddPP~~llRRmmVVƒƒooXX}}mmSSZZNN==AA7711bbWWKKffYYFFiiZZDDuuddKKzzeeHHeeHHƒƒggLL††iiNN……hhMM€€hhKKzzeeKKiiVV@@hhWW@@vveeHH{{jjQQ††ss__’’€€kk——††mmšš‰‰qqŽŽƒƒmmXXVVFFIIKK>>[[[[PPiihh\\hhhh[[eehhYYffkk[[eekk[[nnrriiŒŒ……˜˜˜˜ŽŽ££¥¥––ŸŸ¤¤––˜˜¢¢˜˜••žž™™..3322  ??KKIIww||uuÙÙÛÛÖÖÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýþþÿÿüüûûýýúúøøýýùùïïõõòòòòúúýýóóüüþþòòþþÿÿ÷÷ÿÿÿÿùùÿÿÿÿúúÿÿÿÿøøÿÿÿÿ÷÷ÿÿþþùùÿÿÿÿúúÿÿÿÿúúÿÿÿÿúúÿÿÿÿûûÿÿÿÿþþÿÿÿÿüüýýÿÿüüýýÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÜÜÞÞáá••˜˜™™““ŸŸ  ¬¬¸¸¹¹¬¬±±²²©©±±¯¯ÁÁÐÐÌÌÈÈÌÌÈÈ©©¨¨¡¡}}††††ccwwvv__vvttaarrssggii__††zzffœœŠŠuu­­’’€€´´——„„¨¨wwxxee{{ooggTTVVVV??JJKKXXeeYY——œœ‰‰ªª££˜˜¡¡——‚‚zznnVVYYPPKKZZWWkkzzyy||‡‡yyyytt„„~~zzŠŠ……{{}}``oorrTTeehhNN^^eeTTbbeeffppllppqqiiffhh__NNUUQQZZiiccjjzzkk{{vvggxxsseeIIPPBB++44--&&!!;;==88yyxxddzzaatt__QQKK88IIJJ88UUOOEEDD;;66TTRRHHccffUUjjjjUUqqhhTTtteeRRDD;;++**''3333##FFAA55YYQQEE\\XXHHaa__GGdd``HHaa\\JJ^^aaOO{{xxhh~~qq””ƒƒtt’’‚‚ssvvmmbb``aa[[``ffaallqqhhffii``SSXXUUKKLLEEXXVVGGzzmmVVšš{{^^¤¤{{]]››}}\\yyXXyyXXwwggJJaaQQ@@ddUUNNYYRRJJTTPPIIVVPPJJssjjVV™™‡‡nn  ……jj˜˜||iippccrriiYY^^VVEEXXPPEEWWMMDDSSOOBBWW[[JJ\\^^MM____NNookkVV||kkRR}}iiSS~~llVV}}oo[[nnccOOhhZZHHss\\FFrrYY@@ffPP;;ggYYIIffaaTTXXVVGGhhaaNNyyhhRR||iiRRzzffNNiiZZ??VVJJ6699,,%%KK==77^^TTCCee[[GGttffPPyyffKK}}ffIIffKK‚‚ffLL„„iiNN……jjMMeeLLrrYYDDddSS==ffVV>>ll__KKzzoo\\kk••††nn››ŠŠpp››ŽŽwwrrqq__GGKK;;ZZZZMMnnppddllnnccllnnbbnnqqccccjj]]kkppiiˆˆ‰‰ƒƒ––””ŒŒ®®¬¬ŸŸªª­­  ¢¢ªª¡¡§§®®ªªwwzz{{ --7777……‹‹ˆˆÖÖÖÖÏÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýÿÿüüûûþþûû÷÷ýýúúîîõõòòïïúúüüøøýýÿÿïïùùúúÒÒÝÝÞÞ°°»»¼¼²²ÀÀ¿¿ÑÑááààòòÿÿÿÿõõþþÿÿùùþþÿÿ÷÷üüÿÿùùÿÿÿÿûûÿÿÿÿþþÿÿÿÿýýþþÿÿüüýýÿÿüüÿÿýýþþÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùùüüýýØØÞÞááÉÉÑÑÔÔÇÇÎÎÑÑÊÊÐÐÔÔ±±¹¹½½‘‘ššžž€€’’}}‘‘››ŸŸ  ¥¥´´¿¿ËË··½½ÄÄ||††††XXllnnVVllmmkk{{{{……‹‹““‡‡ŸŸ‘‘§§ŽŽyyªª{{™™ƒƒpp‚‚rrbbzzppffaa^^XX&&''%%--66//ZZddNNˆˆ‡‡ll››ˆˆqqŠŠttddXXQQJJAAHHFF::EE??VV^^RR……††ww˜˜‰‰ww¤¤ŽŽ­­——ŠŠ——””……ttƒƒ||``uuss\\ttttbbvvssss{{ww||yytt||xx€€oouuxx\\rrjjvvttii€€yyjjggaaPPKKDD88++''====99uurrdd~~uu__}}ooXXYYPP<>OOJJ@@5522**UUTTLLffjjWWiikkRRqqhhTTmm``PPEE;;11HHAA22jj^^KKvveeRReeXXMMRRPPEEZZ]]HHddggRRccccWWnnoo]]ƒƒ}}ffŽŽ||iiœœ††ss§§}}  ††vvzznncc\\]]XX]]``\\XX__^^WW\\[[sshhcc‚‚kk^^qq]]ššwwZZyyXX™™yyTTqqMM}}eeLLPPBB11<<--%%GG;;::MMGGEERRLLFF^^WWMM‰‰ww__¥¥……ii¨¨‚‚mmœœ~~nnƒƒrrffssjj]]ff\\MMbbTTDD[[NN>>ZZVVJJ__``PP__^^MMbb``MMjjbbMMuueeKKyykkRR„„oo¦¦™™‡‡¦¦˜˜‰‰““‚‚tt}}eeQQrrYY@@]]HH33__NN<>KKLL77EEHH--;;??((::<<..==@@††ŸŸììÿÿÿÿøøüüÿÿööüüÿÿ÷÷üüÿÿùùþþÿÿüüþþÿÿýýþþÿÿýýÿÿÿÿþþÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿååããàà››ŸŸ˜˜tt{{ww……~~ˆˆ„„{{„„€€~~ŒŒˆˆzzŒŒŒŒppƒƒ}}ŽŽŒŒ——˜˜˜˜‘‘••••œœ˜˜˜˜¡¡••‹‹””‰‰``oonnQQggggaarrkkyyƒƒss~~••ˆˆww‡‡wwee€€wwddqqjjbb``cc^^WW[[UUCCIIDD3399441133,,KKMM::JJCC44llccTTƒƒttbbFF;;// $$11((77AA99oonn]]˜˜‡‡oo¦¦††kk¨¨ƒƒkk©©††nn„„ttXXSSTTBBTTYYYY\\eeffppuujj€€||ff……xx]]……vv\\~~tt^^WWXXGGOOddWW{{zzqq““tt§§’’}}¬¬‘‘||~~kk\\ffll``~~}}mmŽŽzz„„ssiillaaRRppmm``rrrrffkkmmddzzwwoo““pp““zzddzzhhTT^^__PP__eeZZ||rrhhŽŽxxffyyeeOOTTMM;;IIOOEEPPUUBB__]]FFqqeeLL††nnQQ}}eeJJmmZZDDyyffOOŽŽyy[[}}iiFFvvccKKOODD;;..;;11SSZZLL‡‡wwhhŸŸ‡‡jj™™‚‚dd’’xx\\””wwXXŠŠmmSSccOO99MMCC55441100 !!$$))--((::??55BBAA55ccUUAA††kkRRppUU‘‘ooQQnnTTƒƒmmOO{{mmRRqqWWŠŠuuYYssUU……mmOO}}kkSS††ss\\rr]]‡‡eeOOwwccKK}}jjOO¬¬žžŠŠ··­­¤¤œœ••ŽŽ‰‰‰‰ƒƒ••‘‘ŸŸ““ˆˆ””ˆˆxxgg__NNUUMM<>KKQQMM]]ffee||~~kk‚‚ww\\„„ppWW……ppUU||kkOOEEBB44EENNHH||tthh††ppee––nn™™€€jjpp``LL[[ddRRzz||ll““~~‰‰qqkkqqbbRRllhh\\jjggXXffffZZvvuuoo““……oo••zz__ppVVEEVVPPCCccaaSS~~wwbb‰‰qq]]ttZZCCMMDD//GGKK::VVZZKKZZSSAAvvffMM‹‹uuWW}}hhLLnn\\IIyy``NN‹‹ooWW}}ffNNhhNN>>99''!!<>??CC77UUYYNNvvqq__uuggKK^^MM33QQGG88ggddXXkkaaNN//**::DDBBwwqqcc……nnSSˆˆiiJJjjHH””hhKKŠŠiiQQ``MM==??==55==DD??eeggaayygg„„tt[[ss^^––vv__ooTTPPAA33EEEEBBrrgg‡‡ooaaŠŠqqbb‰‰nn]]xxhhUUeeffVV||{{nn••††‚‚‡‡rrbbvvddOOjjbbWWddXXHHSSII88^^``TT€€xx__““vvZZrrRR==PPGG..YYRR<>]]RR==UURRCC7788..339900GGII<<``VVHHqq\\JJ~~__II{{^^JJhhUUBBTTFF66ee[[NN~~vvhh{{llZZ‚‚jjTT‘‘ssZZ““ppXX‡‡hhQQmmYY??ddQQ99tt[[GGddII€€^^AAxxffKKšš––‹‹’’““††‡‡}}ŠŠŠŠ††„„ˆˆ„„††ŠŠ€€››‘‘„„¨¨““††““vvwwgg]]^^QQGG``UUGGYYOO@@VVKK==RRHH>>SSGG??VVGG@@YYKK@@--''++%%RRHH==PPEE99JJBB22``UUCCqq^^DDtt]]AAss``EEvvccFFyyddGGyyaaEEzz]]CCzz\\@@aaCC~~ccFFvv``FFddUU>>mmccMM““ŠŠssžž••~~§§œœ„„ŸŸ™™ƒƒ­­­­¤¤üüûûüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüûûüüøø÷÷þþûûùùÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿûûÿÿÿÿþþÿÿÿÿþþÿÿÿÿüüÿÿÿÿüüþþþþüüÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿÿÿüüÿÿþþüüýýýýûûûûÿÿûûûûÿÿýýüüüüÿÿüüýýÿÿûûüüþþûûýýüüüüþþýýüüþþýýýýÿÿþþýýÿÿþþüüþþýýüüþþüüûûþþúúøøþþùùññ÷÷ôôLLYYWWFFTT[[??YY]]AAVVTT77DDEE**AADD))88@@®®³³úúÿÿÿÿøøÿÿÿÿúúÿÿÿÿûûÿÿÿÿýýÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿââààâ⤤ŸŸ››‘‘ŠŠ€€rriiZZZZ[[PPffppdd‡‡¡¡œœŠŠ§§££’’vvuuffvvoo˜˜¤¤¦¦¬¬°°²²³³««žž¦¦˜˜ƒƒŸŸŠŠ||xxoo~~vvzz……}}uu||hh``jj\\RR__XXccii\\~~vv^^‚‚qqTTaaSS>>..++4488--KKLL@@HHGG::GGGG<>::@@,,AA>>,,]]LL==ggTT<>TTKK66RRHH>>HH==99;;22))HH??33XXOODD??4411""DDAA66QQKK>>II@@33WWJJ;;mmYYCCuu]]CCqq^^EEpp__AAttaaDDuu__CCww^^EEuu]]AAxx__BB||aaCCzzddGGppccHHjj]]EEss[[››””zz««¢¢‹‹¬¬££““ªª§§œœëëêêèèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýúúøøûûööôôýýøø÷÷ÿÿýýüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüþþÿÿúúÿÿÿÿýýÿÿÿÿüüþþþþüüüüüüúúùùùù÷÷ûûüüùùþþþþüüþþþþüüýýýýûûüüüüúúüüýýúúúúýýúúúúÿÿüüüüüüÿÿúúûûýýøøùùûûúúüüûûúúüüûûúúüüûûüüþþýýûûýýüüûûýýýýûûýýûûúúýýùùøøýýùùññ÷÷óó((;;<<%%99<<))AABB,,CCDD55@@GG--CCJJFFaaddÜÜïïðð÷÷ÿÿÿÿøøÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿááããßߎŽ‹‹ŠŠˆˆzzttpp\\\\[[QQkkllee††nnŒŒŽŽvv••……yyƒƒppggYYYYNN\\iiaa‡‡ŠŠ¡¡››‘‘››ˆˆuu––llRRNN>>--99//ZZhh]]uuvvccrroo``PPMMHH??CC;;ffkkZZrrggQQLLAA003344**55<<**==@@//OONN>>ddffTTssqqWWƒƒmmWWss``NN>>::--EEII<>GG>>,,LLJJ>>€€||mm……qq\\llUUAAdd[[KKwwggVVllUUssffKK‚‚ooRR‡‡ooOOxxbbIIZZJJ55NNEE44ddVVDD}}__GG€€bbGGbbPP66MM;;--KK>>44jj^^RR{{iiQQwwddGGxxffMMtteeMM~~kkRR‡‡qqXX__PP77UUNN<<}}kkUU‹‹llPPssQQ‘‘ttRRooNNmmNN……iiLLrrccGGdd]]@@]]XX;;\\YY==bbaaGG^^YY@@KKAA**NNDD,,[[II..]]II66FF;;++;;88--??CC44eeYY@@wwaaDDii[[==UULL55PPFF88JJCC77HHBB33DD==00<<44""7733aaffSSyy€€zzppuuoo``ccYYZZXXRRLLPPKKYY^^YY““ŠŠ³³žž‰‰¹¹¡¡ˆˆ¡¡ŽŽxxssffRRYYOO????77--::22,,GG??,,PPOO>>ZZSSHHVVNN<<..''66//..LLDD==FF@@00MMDD//ggTT>>qqXX@@ooYY@@mm[[@@qq^^AAuu__BBrr]]BBqq]]@@ss^^BBvv__DDvvccFFxxllNNxxnnOOsshhLLŠŠ„„ll««¤¤““³³¨¨™™µµ²²¢¢ððððììÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýüü÷÷ùùõõòòüü÷÷ôôýýûûøøþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýýýýýÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþþþþþýýÿÿýýýýÿÿþþÿÿþþüüýýóóòòóóêêééääòòññììûûûûøøýýýýûûüüüüúúýýüüúúýýýýûûûûÿÿûûúúÿÿüüûûýýüüøøúúúúõõøø÷÷ööøøõõõõøøôôùùûûøøúúüüûûûûýýüüüüþþýýûûýýüüøøûûúúööûûúúðð÷÷õõ--005577 8899!!6688&&55;;55NNTT§§ÁÁÂÂõõÿÿÿÿõõÿÿÿÿùùÿÿÿÿûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿèèèèåå““††ƒƒzzssyyjjggWWWWHHaall\\ƒƒooˆˆssŽŽ‡‡qqŠŠyymmoohh__WWii\\\\ssee{{ll‹‹‚‚ee‘‘„„hh““€€jj„„pp[[BB;;,, DDRRJJmmnn__vvggTTKK>>55UUXXKKuuhhNNMM@@++3344))GGLL>>UUUUEEeebbNNqqooVVwwqqUUccSS@@>>33**;;::33cceeZZvvqq^^MMGG66## SSKK@@nnffOOllddHHmm[[AAooYY>>ww^^BBjjYYBBHHEE55!!''88>>99WWZZTTVVSSEEbbTT>>nn]]GG€€ooWWŠŠrrVV„„iiMMWWLL>>CCEE@@ii``OObbVV>>dd^^HH~~wwddooTT__SS??GGFF88hhllYYŠŠxxeennPP@@__QQCChh]]MM||iiSS††ssVV‰‰ttPP‰‰ppLLllXX99RRCC..QQHH77bbUUBBtt^^DDww]]@@XXEE,,HH66%%KK>>33xxmm``‚‚tt[[ttffJJii^^DD\\SS::__RR;;ccUU??WWOO99bb[[GG€€nnTTŠŠmmMMŒŒnnMM‘‘qqPPŒŒjjJJ‡‡eeFF~~aaDDxxccHHzziiLLttccDDhhZZ==xxllPP~~ooUUll[[AASSII--NN??))PP@@11BB:://EE??7733--&&++&&GG==99MMEE99llaaJJzzhhNN__RR88KKEE//NNDD66II??22EE<<**AA88,,<<11%%((HHJJ>>ƒƒ‹‹ƒƒ––œœ••¡¡™™wwvvppWW[[TTTTWWQQyysskk¡¡~~³³ššƒƒ¤¤zz‘‘……rrqqkk[[==;;..NNEE::aaVVAAFFAA33XXNNAA``XX==FF@@++--%%77//&&CC==,,@@99$$]]NN99kkUU??iiVV==hhWW>>jjXX==nnZZ>>oo[[??pp\\@@rr^^CCuu__DDtt``DDyyiiLL„„ttUU€€ppUUuujjVV¡¡™™ˆˆ¼¼´´  Äľ¾­­øøööòòÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýüüøøøøôôððûûõõòòûûùù÷÷ýýýýüüýýýýÿÿýýýýþþýýýýýýûûûûûûüüüüüüýýýýýýþþþþþþþþþþþþÿÿÿÿÿÿÿÿÿÿÿÿýýûûýýïïêêééààÛÛÐÐëëææÛÛùùøøóóüüüüúúûûûûùùýýýýûûýýýýûûûûÿÿûûúúÿÿûûúúüüûûøøúúùùööùù÷÷ôôööóóóóõõòòööøøôôøøúúùùùùüüûûúúüüûûûûýýüüøøûûúúööûûúúîîõõôô11DDGG??TTVVHH``aa>>OOSS))==BB˜˜±±µµ÷÷ÿÿÿÿóóÿÿÿÿøøÿÿÿÿûûÿÿÿÿüüÿÿÿÿþþÿÿÿÿîîññïœœ’’‡‡llŠŠ||kk^^RRKKPPXXSSuuiiŒŒ‚‚mm‹‹‚‚wwŠŠ……yy‡‡{{sskkpphhXXllddiiwwqqŠŠ‹‹yyœœŽŽuu™™‡‡ll‘‘}}ccooaaKK88..&&11>>99UU[[LLbbWWEE4411$$KKJJ88xxjjKKSSEE**//..!!MMNNFF^^[[KKmmhhRRyyqq[[hh[[IIPPUULLoonnZZjjbbJJ::22 >>88--]]RRHHSSII77RRNN55]]RR88ggTT99XXHH..55..,,--))HHKKKKrrmmii~~{{iigg__QQbbUUDDzzffSS‡‡oo^^‹‹rrYYtt[[DDXXPPJJeehhbbttffQQll\\BBqqrr[[““~~žž……kk„„hhVVff[[NNoooo]]‘‘}}jjww]]LLZZKK??cc[[MMssccOO‰‰ooYYttVVˆˆnnLLccPP44TTDD//__VVDDgg[[HHkkZZ>>kkUU66WWDD,,II77%%::..AA66%%mm]]FF||jjSSrrccOOhhZZEEmm[[HH``QQBBOOJJ::gg``JJ‚‚qqUUŒŒooNNnnNNŽŽkkLLŒŒggGGˆˆddDD„„ccEE‡‡kkQQqqUUŽŽmmNN††hhLLŠŠooTT‰‰ppVVƒƒmmQQbbWW9922))..""7744,,::::22>>;;11ZZSSHH[[TTIISSPPAAZZRR==``PP;;UUJJ55DD@@**??77&&CC88))LLCC//DD99--UUGG99DD99''aabbSS’’››ŠŠˆˆ``cc^^::9922BBGG==QQUUMMttrrhh‘‘††ss¦¦ŽŽyyªª©©““ƒƒ““‡‡yyZZXXKKccUUGGmm\\FF99..##QQCC;;bbWW??__WW@@IIAA4444--<<66%%;;66""NNDD//ggTT@@ccTT==aaSS<>11%%##779944VVSSKKTTOOHHWWUUHHvvsshh„„xxffttcc‘‘ooYYŒŒmmSSccMM::UULLEE}}zzqqooVVkk\\DD||||ll››““‚‚  ~~ccˆˆ``PPoobbUUyyvvbb’’~~hh||ffOO[[OO==ffaaLLwwllRR‰‰ooXXmmVV‡‡ffKKggOO77TTHH22]]TTCChhYYGGddUU<>ssiiRR[[WWAAVVWWAA``VVCCRRBB44PPGG44JJCC--@@77((LLAA--kk\\AARRCC22UUGG66VVHH88ookk[[””››ŽŽUU\\QQ ,,--++UUXXMMccgg[[‡‡ƒƒzz˜˜‹‹¥¥’’€€®®˜˜„„³³œœ‹‹µµ¢¢““„„vvggddVVAAgg__DD>>66((EE8855``VV>>bbZZ??bbYYGGSSII77CC::**BB::**@@==))VVQQ::]]SS<<^^PP;;\\MM66bbQQ88kkXX@@pp\\AAss__BBwwaaCC{{ddGGyyddGG„„mmPPŽŽyy__„„uubb††}}kkµµ®®˜˜ÝÝÑÑ¿¿ÿÿÿÿúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþúúûûùùôôüüúúôôüüûûøøùùùùøøúúúúøøùùùùøøøøøøøø÷÷÷÷÷÷øøøøøøúúúúúúüüüüüüþþþþþþÿÿþþÿÿÿÿÿÿÿÿÿÿþþÿÿýýýýýýúúúú÷÷÷÷øøõõúúùù÷÷ýýüüúúþþýýûûÿÿÿÿüüÿÿþþûûýýþþüüûûþþýýùùüüûû÷÷ûûúúõõúúøøôô÷÷òòññóóííññóóîîôôööôô÷÷ùùøøùùûûúúúúüüûûùùüüûûõõûûùùððöööönn}}}}iiyy||ddvvzz``pprr€€––ššèèûûüüõõÿÿÿÿøøÿÿÿÿúúÿÿÿÿøøÿÿÿÿÿÿÿÿÿÿ¿¿»»ÂÂ}}||yyŒŒyy––€€ppmm[[PPRRRRGGqqvveeƒƒ„„{{‡‡††wwwwuuƒƒww||yyssvvyy‡‡~~ŽŽ……””‡‡vv’’}}cczz^^ŒŒzz[[ooggHHHHHH557799**9988..MMJJ>>HHCC55DDFF99mmffIIrr]]::ffQQ8822))EEBB44aa``DDkkeeHHqqffJJ[[OO??MMHHAAdd``TTrrccNNllYYBBffYYDDbbZZHH@@<<.. &&++QQII66iiUU@@eePP;;QQ??//YYTTFFgghhWWcc``JJHHJJ::77<<;;oorrmm„„~~iiŒŒxx]]ppPP‡‡kkKKPP@@**UUMM??}}ttdd……qqWWRREE..KKII<<„„zzhhžž||__––ooZZkk__QQssrr[[||ddvv__GG__SS>>kkffNN}}ssWW‰‰ssYY‹‹llQQxx[[<<^^II//VVHH33PPFF55XXII77oo__FF€€mmSSyy``EEggPP88NNFF66__ZZFFqq``BBddPP11jjYY99wweeFFwwffIIVVMM33KKII00ooffKKqqSS’’ppJJkkAA‰‰gg@@ŠŠffBBggEE‹‹hhFFkkKK’’ttSS••yyVV““wwSS’’ssQQœœuuWW¢¢{{\\wwYY77FF55;;22##77,,""@@77**mm[[DD€€llNN^^MM77II??,,__XXGGVVKK;;NNDD**SSJJ**UUJJ33^^MM88uu``CC__NN88WWHH66UUDD55YYRRCCˆˆ~~aaggXX334444vvwwnn‚‚„„xx““’’ŠŠœœ––ŠŠªª¢¢³³§§»»¨¨¼¼©©©©””||rrbbLL[[WW>>HHCC11BB66--WWNN66__VV;;ccYYCCaaWWCCRRGG44KKAA22BB??11;;88((UUJJ99__SS??YYKK55WWGG00ddVV>>oo^^EEqq__DDttaaEEyyeeHHxxeeGG}}ggII‡‡ttYY……zzdd„„kk´´®®˜˜îîååÕÕÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýùùúúùùôôûûûûööüüüüùùûûûûùùùùùùöö÷÷÷÷õõöööööö÷÷÷÷öö÷÷÷÷ööùùùùùùûûûûûûýýýýýýÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿþþÿÿÿÿýýýýýýûûüüüüúúýýýýûûÿÿþþüüÿÿÿÿûûÿÿÿÿûûýýÿÿýýûûþþýýøøüüûû÷÷üüûûööûûùù÷÷úúõõòòôôððññóóïïòòôôóóôô÷÷ööøøúúùùúúûûúúøøûûúúõõûûùùîîõõôôuu‚‚jjxx{{ddttyy^^oovvaa{{‚‚ÕÕììììööÿÿÿÿööÿÿÿÿøøÿÿÿÿûûÿÿÿÿááääååxxllssuuvvnnŒŒ„„oozzeeUUJJ==55DDJJDD||||ppƒƒwwzz}}wwiirrrr‚‚wwzz||xxiiuummtt~~rr……~~ppŠŠ{{bbŒŒyyZZ……ttWWƒƒppRRcc[[<>aa\\BBmm``??qq\\<>……ff>>‡‡ggCChhDDŒŒiiDDŒŒllIIŽŽqqOO““yyWW––{{YY••wwVVœœttVV§§~~``ƒƒccCC``JJ00aaSS@@YYKK99^^MM66kkSS77ooWW>>``II99DD66((JJDD77jj^^PP__RR77hh]]88ooaaBBllQQ>>ww]]EE]]LL00[[JJ66[[HH66LLCC00rruuaaffjjWW222200[[\\SSooppdd‡‡‰‰„„  œœŠŠ¯¯§§‘‘··¥¥ŽŽ²²œœ‚‚´´šš}}‰‰vv^^[[QQ??RRJJ88PPFF44WWMM99\\SS==``WW>>ee\\EE[[QQ==MMDD11LLGG559922$$99,,TTLL88[[OO;;QQDD..GG??$$ZZPP77ii\\FFjj\\EEttccJJ||ggJJjjKK‚‚ssVV‰‰€€jj‡‡„„qq°°««˜˜õõïïââÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþüüûûúúûûúú÷÷ýýüüúúþþþþüüýýýýûûúúúúøøùùúúööùùúúôôúúúúõõùùùùõõúúúúúúüüüüüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýþþÿÿýýþþÿÿýýÿÿÿÿüüýýÿÿúúûûÿÿüüúúÿÿþþúúþþýýøøüüûû÷÷üüûûøøúúøøõõ÷÷ööòòôôòòïïòòððóóõõôô÷÷úúøøùùúúúú÷÷úúùùôôúúùùîîõõóórr„„bbmmpp]]jjppZZiiuuUUkkuuœœ¶¶¹¹ööÿÿÿÿ÷÷þþÿÿ÷÷ÿÿÿÿòòúúøø‹‹‹‹jjaa^^€€}}nn||hhllZZIIEEFF<>oo]]==hhWW@@II??//&&((QQLL66qqWW>>BB//JJBB77jj[[HHooZZ??iiUU9911)) - - - -DDAA44ccUUDDkkZZDDqqeeOO||llXXll``IIXXYYDD^^[[GG>><<--BBJJ??kkrrddxxgg……vv[[€€nnNN‡‡iiQQqqZZHHPPMM88kkddNNƒƒooTT……mmPP\\MM77??>>00ee^^LLppOOŒŒllJJkkZZHHaa]]GGuuggQQzzeeNNccSS==ZZPP99mm^^DD„„jjOO‘‘ooPP’’ppLL€€__BBTT99''::++mm]]LLxxaaHHllSS99ffPP44ddOO11QQCC--FF99))SSDD//ggWW>>uu__FFvv``EEkk[[CCDD;;((RRJJ55uu__IIŒŒmmTT““ppSSŠŠiiJJ††eeEEˆˆggHHŒŒhhFFjjFFŽŽmmJJnnNN’’qqSSšš{{__——ww[[••rrSS™™vvWW„„eeFFmmSS;;pp]]JJzzffPPwwddIIiiSS99__II66\\JJ<<\\NN@@SSDD88bbRREEkk\\DDddVV55ssaaDDwwYYBBeeKKbbNN55\\II55__LL::PPEE66WWUUCCZZ\\EE77::--XXYYTTjjnnddmmqqff‡‡‡‡€€‘‘ŒŒ……ŸŸ––ˆˆ®®  ²²  ¬¬””{{²²””yy••kkllccQQdd[[IIYYNN;;VVLL::[[PP>>``XXAAee\\EEbbXXBBTTHH44SSHH44SSHH5599++44**SSJJ77VVII44GG>>##MM??**__RR@@bbWWGGnn``HHkkNN„„ppTT……uuYY‚‚ll‹‹‡‡uu±±¯¯üüùùííÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýýýüüúúúúøøööûûúúøøÿÿþþýýþþþþüüüüüüúúüüüüùùûûüü÷÷ûûýý÷÷ûûýýùùýýýýüüÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþýýÿÿýýüüÿÿüüúúÿÿýýúúÿÿýýúúýýýýøøüüûû÷÷ûûúúøøûûúúööùùøøññóóòòííïïîîññóóòòööùùøø÷÷úúøøõõúú÷÷ôôúú÷÷ïïööòòaaqquu\\ddddZZccggZZjjvvVVmmww\\||„„¿¿××ÜÜúúÿÿÿÿùùÿÿÿÿÊÊÆÆÉÉkkccbb€€xxooŒŒ€€rrˆˆyygghh``OO``ddZZuuyyss‚‚€€yy‚‚wwppXXUUQQ^^jjhhss}}vvTTTTII99>>11JJMMAAvvqqcc‚‚uuaaxxffQQjj[[IIii\\EE[[UUCCKKJJ==KKFF::BB::00TTKK::gg__??nn\\==rr\\>>]]LL44..%%33.. PPII44ffWW==eeJJ33 MMDD==ccUUDDeeXX;;kkZZ;;ggVV==7733&&9999//qqiiZZxxiiTTwweeMMtteeQQvvhhQQ``WW??IIKK99JJDD<<))&&##55;;11``^^PPzzppTT……ttOOnnPPrrXXEEBB44%%JJNN;;qqhhTT‡‡ooUU‹‹ooOOllUU@@>>88--dd[[LL‡‡ooRRggGGqq]]FFdd^^DDooffTTwwddPPbbPP??^^RRAAxxhhNNƒƒggKKŠŠffEEhhCCeeDDnnOO::<>ss__DDwwaaEE^^NN99@@88))ddXXFFvvccFF……kkPPooTTŽŽiiOO‰‰eeHHŠŠggFF‹‹ggGGjjIImmLLllLL‹‹hhJJ’’rrXX’’ssXXooPPmmNN€€aaCCmmWW??hhYYDDuuccII……iiOOppYYAA\\KK77ccSSBBrr^^NNkkTTEE]]HH99ffVV>>aaQQ55ggUU==}}eeGGˆˆnnOO||jjRRoo``LL^^KK77QQDD99UUMM>>jjiiOO‚‚„„tt††‡‡xxwwyywwŒŒ‡‡››••ŽŽ­­ŸŸ””µµ¢¢””££}}‹‹vvZZ¡¡ˆˆpp¥¥‘‘‹‹‚‚oogg^^NNOODD55OODD44NNCC33TTKK99aaYYEEgg[[FF]]OO::UUFF00bbTT99ccUU;;55--11--QQFF::aaTT??hhSSBBYYJJ::\\PPBBii\\FFxxiiPPƒƒppZZ††uuZZŽŽ‚‚kk˜˜¸¸±±¢¢þþúúòòÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýýýüüúúùùøøöö÷÷õõóóùùøøõõûûûûùùýýýýûûûûûûùùûûüüúúüüþþûûþþÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿþþþþþþþþþþþþþþþþýýÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþÿÿÿÿüüÿÿÿÿûûÿÿþþúúýýýýúúþþýýøøüüûûøøüüûûúúüüûûøøúúùùóóõõôôííïïîîììîîííóóööõõööûû÷÷õõûûööõõûûööïïööòòQQaa\\__cc]]WWWWVVTTddjjPPiiqqRRtt}}~~™™¢¢ÜÜèèîîôôÿÿÿÿ““bbWWRR~~zzoo‹‹€€tt€€xxlljjjj``ssuukk~~ttŠŠ……uukkhhOONNJJbbooiijjoobbEEBB//;;<<22BBAA::llffXXxxnnZZggWWCC__SSBBbbXXHHZZRRDDOOII>>EE==117755%%aaXX>>nncc<>ggQQ::&& - -MMGG55ccSS22__HH''--::7766\\UUGGffYYAAggWW>>eeTT;;KK??..3355//iiddSSyyooXXŽŽ€€ii‘‘{{bb‚‚nnXXjj__IIPPMM==MMNN>>FF<<88//((''DDGG>>ee]]IIttddEEnnIIƒƒqqRR[[II<<""MMMM::}}nnYYppUUppPPccJJ55OOBB<<††ssXX€€hhJJuuaaKK``ZZBBllaaSSuubbPP[[II::bbTTDD{{llOO‚‚hhGG……ccBB‰‰ddCC‰‰bb==ggII--22((KKCC33ZZII77KK55%%II88&&DD22GG55""KK;;((OOBB..eeVV@@yyeeJJuu^^CCKK99&&@@44((ffWWHH{{ddII„„jjOO‹‹nnRR‘‘nnOOllKKjjGGjjHHŽŽjjIIkkJJllKKjjLLŽŽnnSS‹‹mmRR‹‹mmNNŠŠllMM‚‚eeGGpp__CCee\\AAkk__@@ddJJss[[CC\\MM88ggXXCCnnZZDDmmVVAAeeOO<>11\\SSAAeeYYBB``TT77ZZMM//ffTT55qq]]==aaSS4411))22''MM@@//llWWFF]]OO::TTGG33VVHH88__UUBB}}ppXX……ww[[……kk——‘‘ÀÀºº­­ÿÿþþùùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿýýÿÿþþüüÿÿþþüüþþýýûûúúùù÷÷õõôôññòòññïïõõôôòòúúúú÷÷üüüüúúûûûûùùûûüüúúüüþþûûþþÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüþþÿÿûûþþÿÿüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿûûÿÿÿÿûûÿÿþþûûÿÿþþúúþþýýùùýýüüúúüüûûùùûûúúööøø÷÷ññóóòòêêììëëîîððïïòò÷÷óóôôúúõõõõûûööïïõõññCCQQHHggkkaaFF@@==..9977GG^^^^^^{{€€™™  ¦¦¶¶¼¼ÉÉÖÖÐІ†||ttSSMMDDqqxxjjyyuuffppmmddggmmggxx{{qq‚‚ƒƒwwuu^^]][[NNSSPPffppccffffSSHH@@11GGHHFFaa__SSuurrZZhhaaFF]]PP55\\SS;;YYRR??RRKK99NNFF66>>55))3344!!ff__@@uu``>>ooWW==::** ((++""__[[>>jjXX11SS== ##%%""DDGG::UUQQ@@__WW@@aaQQ??MM;;//3344//rrkkVVssjjPP‡‡yy``””{{``……ooXXbbWWJJNNOOIIggggYYQQFF66## <<==33€€rraa‡‡ppVV……ppSSxxeeKK:://$$!!!!aa__LLŠŠxx``––vv[[’’ssPPOO==$$ CC==88‘‘vvZZ„„llOOooddQQYYSS@@^^SSFFjjVVEEXXHH11``WW::zzjjKKffDD}}__>>zz]]==‚‚aa88ddEE''++""@@==--UUGG77OO<<--GG77((HH88&&LL::''KK;;%%II;;''ll\\GG||iiNN~~eeKKUU@@++??11 bbQQ<<}}ddJJƒƒiiMM‹‹qqQQ’’qqPP••rrPP””ppNN‘‘llKKjjJJjjIIjjJJnnPPŽŽnnSS‡‡jjNNˆˆllMM‹‹mmNN‰‰jjKKyyccGGii[[BBkk[[<>XXEE++$$((##GGFF<>BBFF??hhffVVjjbbOOHHLL::ZZYYEEƒƒqq\\‹‹ttXX‡‡ttUUggVV>>%%!!++//((iiggRR„„wwYYttWW‹‹rrOOJJ77!!JJJJ==””vvYY‹‹mmMMyyhhKKddPP@@WWJJ::^^PP66TTII00]]VV??}}kkMM„„bbBB^^@@ww\\;;qqVV//^^??&&55))DD@@00[[NN<>yyggKK{{bbII]]HH44@@22 __NN88ggLL††jjLL‹‹nnKK‘‘rrPP––uuSS™™ssSS••llNNiiKK‹‹hhHH‰‰ggHHŠŠjjKKŠŠmmMM‡‡llLL‡‡nnOOŒŒooPPnnQQ‡‡iiPPtt]]GGssZZ??ww``@@wwaaEEuu``KKoo\\AAddWW>>mm__JJvvaaGGzzbbDDqq]]CC>>33EE<<))ZZQQDD8811((DD??00XXKK22VVGG66hh__IIuuiiOOhh``KKZZ[[HHWW``KKppwwff€€ss‹‹€€ww‰‰yymmsseeVV„„yydd€€||bbffeePP——ŽŽ€€©©œœ––‘‘qqttkk++--CC>>//DD<<22@@77++[[SS>>jj^^DDllZZ>>rr[[@@zz__EE~~eeFF~~jjEEvveeEEUU@@--BB66 eeWW@@eeVVBBLLEE55FF@@..ssggNN‚‚kk††tt••““‚‚ÄÄÄÄ··ÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüÿÿýýúúÿÿÿÿûûÿÿÿÿüüÿÿÿÿýýÿÿÿÿüüÿÿþþûûÿÿüüùùþþüüøøûûúúõõùùøøóóúúøøóóùùøøóóùùøøóóùùøøóóøø÷÷ññööõõïïóóòòììïïêêççììççååïïêêççõõóóññúúùùööûûúúøøþþýýûûÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿÿÿýýÿÿÿÿüüÿÿÿÿûûÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿþþýýÿÿþþûûýýüüúúüüûûùùûûúúøøúúùùõõøø÷÷ññóóòòîîððííïïòòîîóóööòòððóóññFFKKJJ??JJCC%%55<<]]uuvvpp‚‚||yy„„{{yy„„~~uuzzssoojj]]ooppffiinneekkffUUffee``cciihhwwyyvvkkii[[AA??33>>EEBBjjkkcc}}wwhhjj``QQ>>55,,??DDDDkkccSSggaaKKXXPP::ZZLL77VVNN77NNII44KKDD22HHAA2211,,CCAA11rrhhPPttddGGNN==++ - -OOKKAAhh^^IIggXXCCXXHH33NNKK88WWOO99GGDD33$$ 005500YY[[QQvvqq``xxnnXXxxiiOO‚‚ss[[mm``NN44..####<<::,,ZZUU>>aaffPPzzvv__‚‚ttZZ‡‡rrUU……ssXXQQFF5566==77ddbbOO}}qqVV}}iiLLuuddCC::)) ^^\\CC‘‘ssVVŒŒkkIIggEEiiPP;;OOAA//[[QQ::XXKK11TTHH,,oo\\>>}}``DD__BB~~``>>mmWW33UU::""88,,CC;;//<<33$$QQCC11YYFF//\\FF))WW;;%%JJ22%%LL@@22xxffPP‰‰ooSS……kkPPiiTT>>??00""ZZII77||hhKK‡‡kkMMjjIIllKKmmLLmmLLŽŽmmMMmmMMjjJJŠŠffFFŠŠggGGŒŒllKKŠŠmmLL‰‰nnOO‹‹ppUUŽŽssZZ““ppXX‡‡ffLL||__EEww__DDvv``EEuuaaGGjjYY@@TTHH55ddWWFFzzggQQss\\??rr[[@@[[LL77@@77$$II??33NNFF<<]]TTGGeeUU==\\KK;;bbTTBBqq``FFmmaaHHee__HHddeeTTkkoo__€€}}jjŽŽ€€rrqqff[[..++""^^]]PP}}{{ggqqmm]]’’ˆˆzz““……™™™™‘‘””9999,,6600$$CC;;44??55++KKBB00^^QQ<>ŽŽ††pp““yyŸŸ  ŠŠââââÖÖÿÿþþüüÿÿÿÿýýÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿüüÿÿÿÿúúÿÿÿÿûûÿÿÿÿûûÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüÿÿþþûûÿÿýýúúÿÿþþûûÿÿÿÿüüÿÿÿÿûûÿÿýýúúþþúúööüüùùôô÷÷ööòòööõõññööõõññööõõññ÷÷õõññ÷÷ööññööõõïïôôóóîîòòññëëîîëëææèèääààëëèèããóóññîîùù÷÷õõýýüüùùÿÿþþüüþþþþüüþþþþüüþþþþüüÿÿÿÿüüÿÿÿÿúúÿÿÿÿúúÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿüüÿÿþþüüþþýýûûýýüüúúüüûûøøúúùùôôööõõïïññïïëëííêêííïïììííððíígg]]ZZGGKK??BBIICCYYllkkmm‚‚€€xx{{||yyttyywwqqrrppppmmddmmqqffmmqqiimmggUU\\^^PPUU\\SSoottiiHHNNFF<<<<44^^]]NNssssaaxxvvggiiggXXBBFF99;;JJEE[[[[GGffbbLL__VVAA[[MM;;TTKK77NNHH44OOHH88EE>>..++&&QQOO??rrhhPPqqccGGCC66**WWPP>>mm^^DDffXX@@JJ<<)) WWQQ::ZZSS663322&&  RRRRCC‚‚||hhkk““€€ii~~ooVVwwmmXXSSII;;,,11..MMII==QQOO<>))EE77**GG<<11>>66((NN@@..XXCC++VV??''LL44??00QQLL88‚‚nnWWŒŒllPPƒƒhhKKmmYY??KK;;,,RRBB22rraaDD……iiKKiiIIiiIIˆˆffDDƒƒeeBB„„hhEE‰‰jjII‹‹hhII‹‹ffFFŒŒggGGŒŒjjHH††ggEE††kkMMuu\\yybb““xx\\ŽŽnnMM}}ddGGww``GGuu__DDrr``BBggYY>>KKBB00GG<<..TTHH88``SS>>eeTT>>ffZZGGLLBB00JJAA44OOHH>>bbXXLLrr``HHbbOO>>ZZHH77kkXX==ppbbDDttggMMooii[[eeggVV„„~~ffoo{{qq##))$$==DD<<„„„„vvMMGG::rrhh[[‘‘ŠŠ||……‹‹ƒƒ‘‘””BB@@44((""55..((FF<<44DD::((FF;;**[[NN<>tt]]==€€bbDD}}ffBBzzffFFwwccFFbbVV::ZZKK77ggXXFF[[VV99LLFF--KKAA//‰‰‚‚nnŸŸ††´´µµžžððððããüüúúøøýýüüúúÿÿÿÿûûÿÿÿÿûûÿÿÿÿûûÿÿþþùùþþýý÷÷þþýý÷÷ÿÿüü÷÷ÿÿýý÷÷ÿÿþþøøÿÿþþúúÿÿÿÿüüÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüÿÿýýúúÿÿþþûûÿÿþþûûÿÿÿÿûûÿÿýýúúþþùùõõùùööòòôôóóïïòòòòììóóòòííòòññììôôóóïïööõõððõõõõïïóóòòììññïïêêììééááääààÙÙççääÛÛññïïëëøø÷÷ôôûûûûøøýýýýûûþþþþûûýýýýúúûûûûùùüüüüùùüüýýøøýýþþøøþþÿÿùùþþÿÿúúÿÿÿÿúúÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿþþþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿþþüüÿÿýýúúüüûûúúüüúú÷÷úúøøôôööôôííððííêêììééééììêꨨ¡¡¤¤TTUULLhhvvssyyˆˆ……{{‡‡ƒƒ||……‚‚uu||yyppvvqqppttkkmmqqddnnttjjppsskkbbggWWHHOOAAAALLCCggsshhGGJJBBSSZZLLvvssbb{{rr``vvmm]]UURRCCCCJJ>>GGMMBBZZXXDDee``FF^^XX>>VVOO99UUOO99RRKK88RRJJAAJJCC//))## IIII;;ppffTTmm[[GG--((""PPNN;;nnaaGGoo[[==;;//""!!UUMM;;MMEE(( ##((11 QQWW@@uuqqXXŽŽee––€€gg„„qqWWff]]GG**(( 003311NNLL==VVUUFFmmiiXXwwbbŽŽ€€mmˆˆyyffyyjjVV//""**((++>>77**]]ZZEEjjggHHccVV55++ AABB88~~ppWW††mmQQtt``CChhYY88KKDD))55//``RR>>nnYY<>IIBB((44// 44..!!PPHH44WWOO::UULL==NNFF99KKFF88KKHH<>TTEE22``PP44qq__CCvvffQQmmggVV``^^JJˆˆ‚‚kk˜˜yy‘‘||%%,,##JJMMGGœœ˜˜ŽŽ::==..GGFF66ss‰‰““yyuummJJ>>3333++GG::77TTBB//AA55''==44!!``RR66ssaa<>**iiVV??ddJJ€€bbAAƒƒeeCC„„eeDDƒƒeeDDˆˆggFFˆˆffFF‡‡ffFF‡‡ddDDˆˆffFFˆˆhhHHccBB}}hhLL~~ff™™††jjžž‡‡ll––}}dd‹‹yy]]oobbMM__SS@@XXOO==NNEE77??66))7722$$>>88))TTLL88UUMM77PPGG99NNEE;;NNII<>OOLL??ccUU??ffVV@@OOAA..ZZJJ22nn[[CCxxggTTnnggXXffddRRŸŸ™™‚‚©©¢¢ˆˆ……‚‚mm33::..€€……~~‘‘„„3377''ggbbPPnnffVVccee[[WWPPEESSEE99JJAA//  88--,,YYNN::PPHH4411++11))WWLL88rrccEEuuffIIrrbbFFttddKKuullLLii[[AA__MM88^^PP::ddZZBB[[YYAAJJMM88}}‚‚nn¿¿ÁÁ­­ôôððääøøõõóóøø÷÷ôôúúøøòòøø÷÷ññøøööññùùööððùùõõïïøøôôïïøøôôïï÷÷ôôîîùùõõïïùùõõññüüøøôôÿÿûû÷÷ÿÿÿÿûûÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþûûÿÿýýúúÿÿÿÿûûÿÿÿÿûûÿÿþþûûÿÿýýúúÿÿüüøøüüúúõõøø÷÷òòôôóóîîòòññììððïïêêññððëëòòññììññððëëññððëëïïîîêêëëèèããããààÙÙããàà××ððððééöö÷÷òòõõ÷÷ññøøùùóóúúùùóóúúùùôôúúùùôôúúùùôôúúùùôôùùøøóóûûúúõõýýüü÷÷ÿÿþþúúÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþýýþþýýýýÿÿþþþþÿÿûûýýÿÿûûþþÿÿýýÿÿÿÿþþýýÿÿüüþþÿÿýýýýÿÿüüýýÿÿüüüüÿÿûûüüþþûûúúûûøø÷÷ûûööôôúúööññõõööééïïïïùùÿÿýýÑÑÊÊÅÅ{{…………““  šš——ŽŽˆˆ††yy~~zzyy€€zz„„ˆˆ~~llppcchhnnddjjmmeeRRUUFF@@;;11KKQQJJww‡‡zz||||kk~~rr``~~uu]]ddZZFFDD55''11))5577++QQRRDDcc]]FFee\\@@bbXX@@aaWWAA__UU??[[PP??XXLLEEXXMM::99**## WWRRDDaaWWBB==;;))2222''8811++VVJJ;;ii[[AAnn``CC00--998800QQHH22)) - - VVUUMMuuoo^^vvll\\||pp__‚‚rr^^ooQQGG<<&&   &&))##..**%%WWRRAAŠŠ‚‚mmjj]]EEttjjSSxxbb~~uu__HH<<-- 2222++11++""TTQQAA}}qqZZmmVV>>UUCC22qqbbQQllUU~~iiJJddTT99QQDD..EE66((;;33""cc]]??mm__??ggNN55YY==))ffPP88rr^^@@iiTT99\\EE..WW@@,,VV==((ZZBB##ccJJ..iiLL44ccDD,,ccHH//bbNN11DD66 __UUEEllUU††hhMMrrVV;;[[GG++QQ@@))II<<((``PP77yy^^CC{{__==eeBB……ggFF‡‡eeEE‰‰ffFFŠŠhhHH‡‡eeEE††ccCCˆˆeeEE‰‰jjII‚‚ffEE€€llOO~~ffœœˆˆmm¡¡ŠŠqq‘‘{{ffvv``jjffKKTTNN77MMEE77CC99))??88&&==77))IICC44XXPP<>NNMM@@ZZMM??``RR==GG88''SSBB,,}}jjUUŒŒ||llkkccWWxxvvgg®®§§••¨¨ŸŸhhddVVRRWWQQ¢¢©©¢¢rr}}nnCCFF66„„qq||nnXXgg__MMTTHH;;RRCC55UUII7755++%%HHEE22YYPP55PPGG..++!!++!!JJ>>**ddYYBBkk__EEmm``JJkkccJJii^^@@ddSS::ffXX@@rrjjOOyyuuYYffccKK____MM¤¤££””ëëççÞÞööòòððôôôôîîôôóóîîóóòòììóóòòììôôññëëôôññëëõõòòììôôññëëòòïïééòòïïééôôïïëëùùôôññýýùùööÿÿýýúúÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿýýúúÿÿýýúúÿÿþþûûÿÿþþûûÿÿÿÿüüÿÿýýúúÿÿüüùùþþüüøøýýüüøøúúùùôôôôóóîîîîííèèííììèèïïîîêêííììèèîîííééííììèèëëççååääààÜÜããààÙÙííííççôôõõððõõ÷÷òò÷÷÷÷òòùù÷÷óóøø÷÷òòùù÷÷óóúúùùôôøøööòòõõôôððøø÷÷òòüüûûööÿÿýýùùÿÿÿÿþþÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþþþþþýýþþþþýýÿÿýýýýÿÿûûüüÿÿúúýýÿÿüüþþÿÿýýýýÿÿüüýýÿÿüüýýÿÿüüýýÿÿüüþþÿÿýýýýÿÿüüûûüüùùùùýýúúööûûøøõõúúûûïïôôõõõõÿÿÿÿÜÜ××ÑÑ““——»»ÆÆÃꪭ­§§””™™‘‘€€ŒŒƒƒzz~~wwxxvvnnffjj``^^ee\\ZZaaUUMMRRDD:::://ZZ^^WW€€‹‹||„„{{ee‚‚uuYYmmaaHHFF88%%<>^^HH11VV@@**]]II11ggUU99kkXX==``LL88SS==--RR==''YYDD))]]EE**``FF//__DD00eeOO88aaNN))??--]]RR??}}iiQQ‚‚ddHHiiMM11\\EE//SSAA))KK<<**^^PP99tt__==yy__;;||eeCC„„hhGGŠŠggIIŠŠggHH‰‰ffFFˆˆeeEE„„ccBB……ffEEŒŒmmLL‰‰jjKK}}ggLLŽŽeežž‹‹vv¦¦~~}}jj~~wwaaWWXXDD5544''44//""<<44''BB66((CC;;..FFEE55ZZSS>>ffYYAA__VV>>SSGG;;OOBB::GGBB::FFGG::OOJJ<>00QQGG11QQBB0011((&&,,** NNHH11^^SS::[[II55KK::--??22$$II??--[[SS==gg]]IIgg\\DDffYY<>**WWJJ::]]OO??AA55((""7711$$TTMM55>>88((##$$))''NNFF55>>77%% - -  - -DDAA99RRII44 FFFF66ZZWW>>ff``HHyypp\\xxnnQQtthhOO@@33'' - -  - - HHLLBBˆˆˆˆuu‡‡€€bbyyZZŒŒ€€cc‰‰~~__SSFF1100))!!!!22//''eeccPPyymmOOhhJJ€€mmLLyyhhJJll^^??ff[[BB??66%%IIDD//TTOO5566--PPCC//bbQQ::aaNN77aaOO77``NN66ccPP44eeSS77]]II66]]BB44aaHH44ddJJ22aaEE++YYCC**XXII22aaPP88UUAA ;;((ffXXBBjjNN~~aaBBkkNN//mmPP;;iiQQ88TT??//kk[[DDyycc@@~~aa==}}ddCCeeEE……ffGG‡‡ffFF……ddDD……ccCC‚‚ccBB……ffEEŽŽooNNnnOOyybbGGˆˆzz__¤¤‘‘||ªª••ƒƒ‹‹}}kkee^^MM..22**!!##%%))**''22..##LLBB22NNGG77EEGG66[[UUAAeeXXBBdd\\AA``TT@@]]OOAADD@@33??@@44FFDD55RRJJ99^^UU>>oo__CC……vv]]ƒƒ||kk\\ZZNNUUXXPPSS\\TT55@@77JJQQJJ––œœ••žž««¢¢[[dd^^oommbb‘‘ŠŠuuhheeMMee__IINNEE55>>99,,KKAA..YYEE00GG88++..//ZZOO55ffSS88hhWW@@bbTT??UUHH55KKAA..ZZPP==ccWW??aaSS77bbUU;;ii[[BBxxggOO„„ttZZ‰‰~~dd™™••¬¬©©˜˜ÐÐÌÌÀÀëëêêÜÜééééÞÞééççââééèèââèèççááèèææááééççââèèææààèèååààèèääÞÞççääÝÝêêççââððëëèèööòòîîûû÷÷óóÿÿüüùùÿÿÿÿüüÿÿÿÿýýÿÿÿÿýýÿÿýýúúÿÿûû÷÷ÿÿüüùùÿÿþþûûÿÿÿÿýýÿÿÿÿýýÿÿÿÿýýÿÿÿÿûûÿÿÿÿûûÿÿþþùùþþýýùùýýüü÷÷÷÷ööññììëëææëëêêææííììèèííììèèííììèèëëêêææççääààååààÜÜèèççßßòòòòëëööõõññøø÷÷ôôùùøøóóùùøøóóøøööòòøøööòò÷÷õõññõõôôððööõõññùù÷÷óóüüûûööýýýýúúÿÿÿÿýýÿÿÿÿþþþþþþüüþþþþûûþþþþûûýýýýûûýýþþûûúúþþúúùùþþúúúúüüùùûûýýúúýýÿÿüüüüþþûûýýÿÿüüýýÿÿüüýýÿÿûûýýÿÿúúüüþþùùýýÿÿúúûûþþûûùùþþýýððøøöö¾¾Â··””’’{{ââóóïïððÿÿýýííññîœœ˜˜``ccWWccnn]]ffll[[]]__PPUUWWFFSSVVBBQQYYKKccqqffvvuujjdd[[LLDD<<&&66..CC::++ZZRR==iibbGGlleeGGjj``CCgg\\==ffVV99ggTT;;VVEE--II99%%HH;;&&UUII11YYJJ;;++%%TTOO>>YYQQ::''!!11--##WWOO??<<55"" - -  - -MMLL??FF@@,, ++00++UUPP==``YY==]]XX??kkbbPPnnggFFUUPP77   **** mmkk\\‘‘‰‰ssŠŠzzZZ††vvSS‘‘^^‰‰}}[[TTLL55..**""))-- >>>>33eeffRRuukkMMiiNN€€mmPP{{jjJJqqaaIIhhVVII-- 5522''GGGG00::11 RR@@11ffTT==ddTT;;^^NN66^^MM44aaNN22aaOO33\\HH55__GG77ccKK66bbLL22YYFF))VVFF++YYLL44[[KK11TT>>$$FF33&&oo]]DD‚‚ffFFzz]]99iiPP++uu\\CCiiUU88LL::%%nn[[FFffDD‚‚cc@@aaBB~~``AAccCCddCCddBBddBB‚‚ddBB††ggFFppNNnnOOyybbHH‰‰{{aa§§••¥¥““~~””ˆˆxxKKFF;;##%%....))7744--@@==//__XXCCPPMM88IIMM==^^[[II__VVAAcc]]AAgg]]??ddXXAAQQNN::BBDD77IIFF88UUMM<>qqjjLLsshhHHsseeEEpp``@@jj[[88ggWW55eeQQ66SS>>((KK<<((LLBB++SSHH11II==-- - -9933((^^ZZDD\\TT<<&&  @@??66[[UUBB8833  PPMMBBGG??** ..4411^^XXDDbb\\??``ZZCCccZZKK^^YY??%%$$ - -  - - ""mmmm^^~~vv__ŽŽ„„iiŒŒzz]]ŠŠssUUaa„„zzVVNNDD22((&&""2255##CCCC77____SSiieeMM{{llNNooTT~~llRRvvaaSSVVEE==%%EE@@55[[UU<>44TTBB::ccRR==ccQQ::]]LL44YYGG//XXGG**^^MM11LL::((JJ<<..WWGG44XXHH00FF??""NNCC((ZZII11XXDD--LL==''FF<<,,rr``II~~ccBBqqXX44iiQQ11uuaa??WWII&&CC77""oo\\EE……kkIIˆˆffEEbbCC}}__CC}}``AA~~aa@@€€bbBB€€bbBBddDD‰‰iiGGŽŽooOOŠŠqqSS{{ffLL~~jj¦¦””¤¤””€€žž••ƒƒ``\\RR5566((6677&&IIJJ44ccbbMMeeaaNN\\YYGGWWWWGGZZXXHHTTPP==\\XX@@jjbbFFff[[BB__WW@@QQOO??PPMM<<[[VVDDbb]]LLaa\\KKQQPP@@TTXXKKddooddQQ\\SSTTXXWW˜˜™™››ŽŽ““ŽŽ))11((119933VV]]ZZSS[[VVžž””xx||uuPPNNDD__PP??AA::''FF==''VVII77ZZMM77FF::**%%&&??44!!ccTT>>gg[[??kk^^EE__PP::UUFF11aaRR99eeUU::ccTT99``VV;;aa__@@iiddJJ„„xxee££••‚‚¬¬ŸŸºº³³¨¨ÙÙÕÕÎÎÝÝÝÝÛÛÜÜààÛÛààáá××ààááÛÛááââÜÜááââÛÛÞÞààÙÙßßÜÜÖÖßßÛÛÕÕååááÛÛííééääïïëëææññííèèôôððììúúõõòòÿÿüüùùÿÿýýúúÿÿþþûûÿÿüüøøýýùùõõýýøøôôÿÿüüùùÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÿÿÿÿûûÿÿÿÿúúÿÿþþúúýýüüøøýýüü÷÷üüûûööùùøøóóøøööññøø÷÷òòùùøøóóùùööòòóóîîêêèèããààîîêêããùùööððûûööóóûûùùõõùùøøóó÷÷ööññ÷÷ööòòùùøøóóùùøøóóùùøøóó÷÷õõññôôóóïïôôóóîîööööóóùùùù÷÷úúúúøøûûûûùùûûûûùùûûûûùùüüüüúúüüüüúúøøüüùùøøýýùùúúüüùùùùûû÷÷ùùûû÷÷úúüüùùúúüüùùûûýýúúúúüü÷÷üüþþøøûûýýøøüüþþùùûûþþùùùùþþûûññ÷÷õõööÿÿÿÿÎÎÃÃÃÃddcc``»»ÏÏÉÉííÿÿüüøøÿÿøø¸¸¯¯««WWTTIIYY^^QQaajj____jj[[UU``NNSSUUDDSSZZKKpp}}ppjjjj\\KKDD66DD<>XXTT==6622 NNKK??HH??,, --33--dd^^KKllggKKdd^^FFXXPPAAAA<<++    ppppeeƒƒ{{dd……eeˆˆff‚‚vv[[jjƒƒzz]]HH>>55&&"" ""&&..00%%JJKKDD````NNrrjjLL€€ssQQ‚‚rrRRxxddOO??11####!!XXRR??cc[[99WWLL88WWHH77^^NN77bbPP88__MM66VVEE..VVFF,,QQ@@''++ - -::00##__RRAAYYLL77GGBB&&RRGG..XXEE..KK77##;;11EE??++rr^^KKyy__DDiiPP66ffLL77ss__>>YYJJ&&<<,,mmZZCCˆˆppMM††hhFFccCC~~``GG~~aaCC{{__>>~~bbCC~~bbCC€€ddDD‰‰jjHHqqPP„„ooRRxxffMM””‚‚qq¦¦––ƒƒ§§™™……’’‹‹vvNNKKAAFFBB==JJGG;;]][[JJjjiiUUccccQQbbaaRReeccUU__^^OOGGGG66MMLL88aa\\EEiibbLLff\\GG^^WWDD^^XXEEbb\\II__[[JJVVUUFFDDDD66AACC88RR]]SSBBOOEEOOTTPP¤¤¦¦¤¤ŒŒ’’ŒŒ((11((RRYYQQQQSSPP,,5533ssvvnn‹‹ŽŽ……YYVVIIeeUU99IIBB%%IIAA((SSGG66YYLL55[[FF44HH22++//%%--&&GG::))LLCC00PPCC11^^OO==eeTT??ggVV>>jjYY??jjXXCCaaSS>>\\UU==gg^^HHrrggRR‘‘ƒƒpp¨¨——ƒƒ··ªª––Ãÿ¿²²ÔÔÖÖÐÐÚÚÝÝÖÖÜÜááÖÖßßââÜÜßßààÚÚÞÞßßØØÜÜÝÝ××ÜÜÚÚÔÔââÞÞØØììééããòòîîééððììççððììççóóððêêùùôôññþþúú÷÷ÿÿüüùùÿÿþþûûÿÿüüùùýýùùõõýýùùõõÿÿûûøøÿÿþþûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿýýÿÿÿÿûûÿÿýýùùþþýýùùþþýýùùýýüüøøýýüüøøþþýýøøþþýýùùþþýýùùÿÿûûøø÷÷òòîîììççääííééããùùõõïïûûööóóûûùùööøø÷÷òòøøööòòøøööòòúúøøôôûûúúõõúúùùôôööõõññóóòòííññððëëòòòòðð÷÷÷÷ôôøøøøööúúúú÷÷ùùùù÷÷úúúú÷÷úúúúøøúúúúøøøøüüøøööûû÷÷÷÷ùùõõ÷÷ùùõõööùùõõ÷÷úúööøøúú÷÷ùùûûøøùùûûööúúüü÷÷ûûýýøøûûýý÷÷ùùüü÷÷÷÷ýýúúðð÷÷õõòòþþýýééääååxxlleeœœ¯¯¥¥ëëÿÿüüóóýýõõ¦¦œœ™™KKEE::JJLL@@RR]]SSUUiiZZPP^^MMLLMM??XXZZPPnnxxll[[YYHHDD??11CC??11CC??11[[YYDDhhccIIiiaaDDmm]]??mm[[;;jjYY55jjYY55``JJ//JJ33EE66""HH??''PPFF22HH==,,""EEDD44````GG__XXBB""JJJJ??TTRR77..)) - - OOMM@@BB88**))00&&cc]]NN||ww\\rrnnPPUUPP<<5533%%++,,  ""!!oorreeˆˆ‚‚jj}}yyccƒƒ€€hhzzvv]]}}tt^^xx\\EE==55##$$##&&##((** !!&&**!!ZZ\\MMpphhQQ€€ssVV‚‚ttSSxxffMM>>//""ZZTTBBcc[[::WWLL22VVGG33XXII33[[MM33WWII//OO>>((ZZHH22JJ99""//BB::++ee[[IIUULL44NNGG,,XXJJ11WW@@**==++11))QQGG22rr]]DDrrYY::ggMM44hhOO??vvbbHHeePP00@@++kkWW@@€€llHHzzdd??||ccEE{{aaHHxx^^BBtt]]<>11<>yyaaCCyy\\EEooWW<>6699**CCHH77MMNN==ggffVVqqnn]]}}ww``ŒŒ‚‚kk——ŽŽzzqqnnaaRRQQJJ``aaXXuuxxjj}}††zzaaiiaaƒƒyy©©¬¬  ’’‹‹}}„„~~€€ˆˆ——››––||……MMZZTT``jj^^aa]]JJddWWBBMMEE//??88KK@@,,[[NN::__SS::eeZZ>>ff\\@@gg^^CCjj^^FFcc\\FF__WWAAWWMM88[[KK88iiXXDDmm\\GGqqaaFFxxffJJ‚‚ooRR„„ssWWƒƒuuZZ‚‚ww]]……{{cc……llŸŸ““xx±±¡¡††ÏÏÈȲ²ÚÚââØØÞÞââÙÙááááÚÚßßààÙÙææææßßññïïééõõóóííõõóóííóóññëëóóññëëóóññëëôôññìì÷÷óóîîûû÷÷óóÿÿüüøøÿÿýýúúÿÿÿÿûûÿÿüüùùÿÿûûøøýýùùõõÿÿüüøøÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿûûÿÿÿÿúúÿÿÿÿúúÿÿýýùùÿÿþþúúÿÿÿÿúúÿÿÿÿûûÿÿÿÿûûÿÿþþúúùùøøôôííííèèííêêããùùõõïïüü÷÷ôôüüúúööùùùùóóúúùùôôûûúúõõüüûû÷÷ýýüüøøüüûûööùùøøôôôôôôððòòòòîîòòòòïïóóóóññõõõõóóööööôôôôôôòòôôôôòòóóôôòòòòôôññððóóïïððóóððññóóððòòôôññóóõõòòóóööòòóóööóóôô÷÷óóôô÷÷òòööøøóóøøúúõõøøúúõõööúúõõôôûû÷÷îîôôòòîîøøññññúúöö¥¥˜˜’’ƒƒ‹‹ƒƒââÿÿùùÚÚááÛÛ}}{{tthhee]]@@@@00++22##%%00//--6688????==mmuurrffllggWWOO99LLII33GGCC447722((++'' //**AA99**VVOO;;\\WW;;PPKK**>>77<>llNN77eeOO55ss]]>>}}bbEEƒƒeeJJˆˆhhKK„„iiJJ‚‚ooSS~~nnWWyyooYY¤¤šš¹¹¦¦‹‹ppJJKK??KKOO??oooo]]ˆˆ‚‚ll€€}}iiuuvvffuuwwgghhkk^^ccjj]]aaffWW[[__OObbiiUUjjkkXXttrraazzwwff‚‚~~gg„„kk‡‡ttkkllaaccee^^qqttggssyyggww‚‚uuss||rr‘‘””ˆˆ¢¢££™™‰‰……zz€€yyƒƒŠŠƒƒ||ƒƒddjjiiMMWWVVYYaaWW^^YYJJ]]VV@@PPKK446600@@::))XXKK55bbSS::eeXX@@hh\\CCll__FFkk__FFee^^FFcc\\DD``YYAAccWW@@hhZZDDpp__JJssbbKKxxggNN~~nnQQ……vvVVˆˆyyZZŠŠzz__}}bb——‚‚dd  ‹‹nn¬¬——xx°°••ââÝÝÎÎííëëââððïïééóóññìì÷÷õõððùù÷÷òò÷÷ööññ÷÷ööððööõõðð÷÷ööððööõõïïõõóóííööóóííüüùùóóÿÿþþøøÿÿÿÿûûÿÿÿÿüüÿÿýýúúÿÿýýúúÿÿúú÷÷ÿÿüüøøÿÿÿÿûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüÿÿÿÿüüÿÿþþúúÿÿÿÿúúÿÿÿÿúúÿÿÿÿûûÿÿÿÿûûÿÿþþúúûûúúõõïïîîêêïïììåå÷÷óóîîýýùùööüüúúööúúùùôôûûúúõõýýüü÷÷þþýýùùýýüüøøüüûûööùùùùööõõõõóóóóóóòòòòòòññòòòòððôôôôòòôôôôòòóóóóññòòòòïïññòòïïïïòòîîîîññííïïòòîîïïòòîîððòòîîññóóïïððòòîîññóóððòòóóññòòôôññóóõõòòõõøøôô÷÷ùùõõööúúööôôûûõõîîôôññèèôôññîîûûøø¶¶¬¬§§xx||vvÝÝ÷÷ððÊÊÒÒÌÌrrppiijjllbbXX^^LL88::,, $$!!%%""0044,,TTdd[[]]gg``__VVDDTTPP@@IIEE8800,,%%""**%%--%%22**;;99''!!##**!!22""++ CC@@,,__VV>>II::&&,,)) ZZ]]RRddbbNNOOII//++&&@@@@55YYYYGGEE>>00 - -%%..((''))##&&))""QQMMAA**$$ QQZZFFttmmTTuueePP__XX??BB<<++ DDIIAA,,00!! cckk^^vv}}nnzz€€ooŒŒˆˆwwvvnnZZxxttdd’’{{yyss[[ ..8822LLDD22 eehh\\||yy``xxss__qqpp[[jjkkSS11--!! ddaaPPhhccKK[[TT@@UUKK<<[[MM99@@55""))WWEE//XXFF&&99))**DDBB66@@==((JJ::&&TT<<--;;&&>>--CC00??..aaMM55ttZZ99ttZZ::ggPP44ggOO77qqYY??eeQQ22UUBB**llYY??{{ccCC||bb;;uu\\::aaKK44ccNN::||``IIddJJƒƒiiII……nnNN||iiLLyymmTTzzss\\„„{{ee®®  ˆˆ««ŸŸ……ccbbTTKKLLHHffddTTtttt^^ŒŒ††nn††qqpp||€€ppkkqqccccll]]jjoo^^sswwddww~~hh}}~~ii~~}}hh~~jj„„}}iiˆˆ€€jjvvwweemmppcc„„……ttŽŽ‹‹zzxxtthhWW[[TT]]dd__––šš››’’””ŠŠˆˆww€€sskkssiiˆˆˆˆ‰‰ŒŒ††€€……xxcc^^PPZZWWGGYYXXGGBBBB114400!!PPBB--aaRR99eeXX@@hh\\BBkk^^EEjj^^FFdd^^CCcc\\AAff__EEii]]FFii[[EEpp__JJuuddMMwwffMM{{kkNN‚‚qqTT‹‹xx[[~~^^””€€aaššdd  ˆˆjj©©‘‘ss´´€€ÛÛÊʵµûûõõëëøø÷÷òòýýüüööûûúúôôüüûûõõýýüüööüüûûõõýýüüööüüûûõõúúùùóó÷÷õõïïööóóííýýúúôôÿÿÿÿûûÿÿÿÿýýÿÿÿÿýýÿÿÿÿüüÿÿþþûûÿÿûûøøÿÿüüùùÿÿþþúúÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿþþÿÿÿÿüüÿÿÿÿüüÿÿÿÿúúÿÿÿÿûûüüúúööòòññììððííææøøôôîîþþúúööþþûûùùýýüüøøþþýýùùÿÿýýùùÿÿþþúúýýüüøøüüûûööûûûûøø÷÷÷÷ôôõõõõóóóóóóññòòññïïòòññïïóóóóññòòññïïññððîîïïððííííððììììîîëëììïïëëííððììîîññííïïññííîîññííîîññííððòòîîññóóïïòòôôññôôööóóööøøõõõõùùõõóóúúõõííóóððååóóññììùù÷÷Ãúº¸¸mmiiffÌÌèèàཽÇÇÀÀjjee]]ddkk````kk\\YY[[KK<> - - - -BBLL88kkiiMMtthhOOff^^DDJJFF//8866''<<==332299--((--++DDKK>>mmvvggzzƒƒrr{{““ˆˆvv||jj……††qqbb``LL  88BB88VVRR??kkoodd……ll‡‡yyjjqqkk[[__aaOO::::**__]]NNhhccNN[[UUCCTTKK==WWOO;;--''22++TTCC22LL;;$$@@66CC33""==99**@@==''QQCC**LL33""&&66))BB22DD55aaMM22ooUU44ssYY88bbKK//^^GG00jjUU99eeSS44]]KK00rr^^CC€€ggFF€€dd>>uu[[88VVDD--``LL;;ƒƒggQQ„„iiLLƒƒjjHH„„ooPPtthhOOppllUUwwvv__‡‡pp³³¥¥‹‹„„ƒƒhh<>ddYY>>gg\\AAgg]]BBcc\\@@aa[[??dd]]AAhh^^FFkk^^FFqqaaKKuuddMMwwffLLzzjjLL€€nnPP‰‰vvXX~~[[””€€__˜˜‚‚gg‡‡mm¨¨vvµµšš||ÆÆ­­““ôôééÛÛýýúúôôûûûûõõüüûûõõþþýýøøþþýý÷÷ýýýý÷÷ýýüüööýýüüööúúúúóó÷÷õõððööóóîîýýûûõõÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿýýÿÿýýùùÿÿüüøøþþýýùùÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüÿÿÿÿüüþþýýúúõõõõññññïïèèøøõõïïþþûû÷÷ÿÿüüúúÿÿþþûûÿÿÿÿûûÿÿÿÿüüÿÿÿÿüüÿÿþþúúüüüüøøüüüüúúùùùù÷÷õõõõóóóóóóññññòòîîððññííððññîîïïññííîîïïììììîîëëêêííêêééììééëëííêêììîîëëííïïììííððììììïïëëììïïëëîîññííîîññììððòòïïóóôôòòôôööóóõõùùôôóóùùôôííóóððççóóòòììööóóÌÌÃÃÃÃiiXX\\®®ÔÔÊÊ®®¼¼´´MMBB::JJTTQQYYhhhh]]bbXXEEOO@@;;CC99==EE;;HHRRCCKKUUJJIIII::PPMM==QQLL::KKCC//IIBB11==<<22++))00((**%%++$$DD::%%)) 44++!!TTUU<>DD33 \\WWOOnniiWWTTOO??UUPP@@PPLL55))$$::44++DD==((;;66//--%%;;11""PPEE((TTEE&&55$$"" DD44%%LL99##JJ;;^^JJ--qqSS77wwXX::kkOO55aaGG22ccTT44bbXX77ddUU66uu^^>>€€ffBBcc<>TTRR;;HHDD,,KKGG88]]^^UU[[\\MMjj^^GGffUU;;VVLL00VVQQ44__UUAAffXX::99..))##JJLL::TTKK66GG>>33MMQQCCggeeMM]]NN33,,!!FFGG55cc__KK**@@CC88BBHH99GGPP>>SSTT==''##GGHH;;````GGppiiRRllffOOcc]]HHaa[[LLAA<<44  ((--((……‹‹~~††ŽŽ{{‰‰zz˜˜••……››ššˆˆ\\]]RR558800..5511mmuuee77<>zzcc>>€€ee==jjPP11==**kk[[GG^^ŽŽzzTTvvRR’’xx^^wwllVV‚‚}}hhŸŸ‘‘}}¬¬šš‡‡››}}AA@@331122((^^__TT††‹‹uuqqzzee~~€€pp„„wwmmrrffbbmm``^^ll]]eeooaaooxxiippyyggrr||hhxxmm{{ooxx||llppwwggjjqqaabbiiYYccjjZZ||rr””““††••””††ŠŠ’’‚‚ŠŠ““……••šš::@@99 <>..RRII77WWLL99ZZRR<<^^VV??aaZZ@@dd]]AAdd]]DDee^^EEff__FFiibbIIllccKKssffOOvvjjTTwwllSSxxmmQQzzooRRqqTT‡‡wwXXŒŒ{{ZZ““‚‚``œœˆˆjj§§uu¯¯””yy»»ŸŸ~~Éɲ²””ûûòòááÿÿÿÿ÷÷ÿÿÿÿüüÿÿÿÿüüÿÿÿÿúúþþÿÿùùýýÿÿøøüüþþ÷÷úúûûôôùùùùóóùù÷÷ññüüûûõõÿÿÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿþþùùÿÿþþøøÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿýýøøøøööññòòëëóóôôííúúûûõõþþÿÿüüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüýýýýûûüüüüúúùùùùööööøøóóóóõõïïîîððêêêêîîééååëëççááççããááèèããããêêååééííééììííëëëëííêêêêììééééëëèèêêììééììîîëëîîððììððòòïïóóõõòòóóõõòòôôööóóôôøøôôññ÷÷òòììòòïïëëîîððïï÷÷õõÖÖÕÕÓÓeebb``‹‹  °°¸¸»»224466++00,,<>44^^bbPPtthhQQssaaGGgg]]<>..DDGG<>GG77HHRRAAMMPP993333**))++**RRPPDDaa]]GGlleePPkkiiQQbbaaOOVVTTJJ..//)) MMSSLL––ˆˆˆˆ}}ˆˆ||‹‹€€,,++%% - -AAKKBBrrzzii++00%%oorrhhyy||ooyy||kkYYXX@@hhii]]wwvvbbkkjjYYttssbbOOMM;;++''PPMM==IIDD//55((1100((aaTTCC[[DD))$$)) MM==..vvYY<<]]==||ccDDnnXX;;llQQ99wwZZ??||ccEEqqXX==jjUU99kk[[==oo]]>>ssbb@@{{ff@@ff>>ggOO66HH88**xxjjUU’’‚‚aa——ƒƒ]]šš\\ŽŽzz^^qqppXXŠŠŠŠtt¥¥™™‚‚¥¥šš‡‡xxuuiiHHHH>>KKJJ>>eehh[[€€ˆˆqqkkpp^^ffee\\ooqqnnggllffaakkaaaannddiiqqggppxxkkppxxiirrzzjjtt||nnrr||mmllwwhhiiuuhhiiuuhhiiuuhhiirrffnnuujjƒƒ‰‰””‰‰ššŒŒ››¡¡’’šš››‘‘$$''## ##,,((YYdd\\uu~~ww__bb]]@@CC;;**//$$5577))UUMM>>[[QQ@@ZZSS@@^^VVDDaa[[EEdd]]GGgg__IIjjbbLLllddNNmmffOOqqhhRRwwkkVVwwooYYxxqqYYvvooUUzzppUU||ppTTssVV……vvUUŽŽ[[™™‡‡hh¢¢ŒŒqq­­““xx½½ŸŸ}}ÀÀ¤¤‚‚ããÓÓ¼¼ÿÿÿÿøøÿÿÿÿüüÿÿÿÿýýÿÿÿÿûûÿÿÿÿúúÿÿÿÿúúýýþþøøûûüüõõúúúúôôúúùùóóýýüüööÿÿÿÿûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúþþýýøøÿÿÿÿúúÿÿÿÿýýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúúúøøññóóëëòòõõììùùûûööþþÿÿüüÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿüüýýýýûûüüüüúúúúúúøøøøúúôôôôööððîîññëëééííèèááææââÝÝââÞÞÝÝããßßááççããééííééëëííêêêêííééèèëëèèççééææééëëèèëëííêêïïññîîòòôôññôôööòòõõøøôôööøøôôõõùùôôññ÷÷óóììññïïëëññôôëëõõôôÝÝááààssqqttƒƒ‘‘ŽŽœœ««¥¥OOVVPPJJQQGGPPWWHH@@EE552222,,DDHHBBRR]]EEZZ^^AA\\UUBBBB;;..$$##;;66''GG>>--<<00""++--BBEE//jj^^HHnnaaGGff__??hh``AAnn__FFkkYY@@BB// - -((--##::55$$++%%FFMM;;aa``LLTTHH66DD;;**JJGG66GG??22  77CC55DDMM==LLQQCC88;;$$))))669966YYZZKKee``KKiieeNNiiggMMQQQQ??""##""((!!!! - - llttgg——……ŠŠŽŽ€€††ŠŠ}}€€ŠŠyynnrrii##..++__ll__kkuucc$$ %%!!qqyynnxx{{mmww{{jjRRTTBB3388,,xxzzjj}}{{jjrroo^^ssqq__FFFF88&&CCLL::AA@@,,00,,&&11++%%MM>>**ccNN77AA00##[[LL44ooTT55yy]];;€€eeFFhhJJuuaaBBffSS44mmZZ;;ss__BBllWW==ggSS88kkXX;;pp]]==wwdd@@||iiDD||iiCCaaNN44KK??00tt__‘‘……dd‰‰dd­­’’ppeehhffSS——””©©££ŠŠ‘‘yyRRRRDDQQRRDDXXYYJJ``ddUUppyygglloo__^^__TTeeeeaabbeeZZddii\\kkqqkkkkttllffttffhhssggmmttiillyylljjxxkkgguuhhhhttiijjvvkkllwwmmkkvvjjkkvvllyy„„||ŠŠ••ŒŒ““œœ  ££––¢¢££šš558855 44;;88[[ff``zz‰‰llttkk>>BB88..11%%LLJJ==``ZZKK^^WWGG^^WWGG^^WWGGaa\\HHdd__IIffccNNooiiTTsskkWWwwnnYYwwnnYYzzqq[[yyvv^^yyvvaawwtt[[zzttVVzzqqSS}}rrSS€€ttQQ‡‡yyVV••‚‚ee  ˆˆoo¥¥tt²²œœzz¾¾ŸŸ{{Ðл»  þþûûññÿÿÿÿûûÿÿÿÿûûÿÿÿÿûûÿÿÿÿúúÿÿÿÿúúÿÿÿÿùùÿÿþþøøþþýý÷÷üüûûõõþþþþøøÿÿÿÿûûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿüüþþÿÿùùýýþþ÷÷ÿÿÿÿúúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûûû÷÷òòóóëëòòóóììùùúúõõýýÿÿúúÿÿÿÿûûÿÿÿÿüüÿÿÿÿûûþþÿÿúúüüýý÷÷úúûûõõûûüüööüüýýøøøøúúôôõõøøòòôôööññððòòììëëííèèååèèââÚÚÜÜ××ØØÜÜÖÖááççààççííææééîîééèèííééååëëççææëëççééëëååëëííèèííððêêóóõõððööùùóóööùùóóööùùóóôôøøòòññ÷÷ôôììññððååóóóóåå÷÷ôôååððíí……ƒƒ„„ŒŒ––’’””¡¡™™||‚‚vvttxxeekkllUUff``HHHH==..GGDD88WW\\BBWWYY??KKCC00HH@@..DD@@''DD??,,MMGG;;VVMM@@??>>++99::%%UUNN66``XX<>JJ::ccddRRZZMM99JJ@@++QQLL777722## AAHH<<\\\\LLIIGG882211""..22((EEOOFFhhmm]]ookkYYmmggSSbbYYCC7733$$$$**"" ))  - -&&//''‚‚‰‰~~‘‘˜˜ˆˆ††ˆˆ~~ˆˆŒŒ€€„„||LLPPGG IITTMMss€€qqnnxxgg ''((//++uu€€ssuuzzjjxx{{kkBBCC55 VVZZNNyy{{kkttuueeoooo__YYYYII))))%%>>FF66<<<<))6600%%CC88,,KK<<''XXCC//OO;;**RRGG55rr]]>>yy[[66dd@@kkLLƒƒnnOO€€llLLuuaaAArr__AApp\\@@ffRR66ddPP33kkXX88pp]]<>--JJGG77CC>>,,5544IIII..YYUU77dd^^>>mmffEEooggGGsshhIIii\\>>&&   - -  55>>,,mmffNNiiXX>>[[NN55YYRR88##  - - RRVVMMeeccQQDDGG332266,,55>>44OO]]NNmmwwhhppwwddpprr^^ffaaLL::77((""  GGRRLLŠŠ‘‘‰‰‰‰‚‚yy’’††~~††uu((,,## [[gg]]xx……uuss}}ll 88BB==ttttuu}}jjggjjXX(((( ""jjnnbbnnqq``iill]]ZZ\\MM--// ####..44--99@@332222!!<<33##ZZJJ66TTGG00eeRR88rr]]BBjjZZ>>kkYY88rr[[88uuccCC||mmMM€€ppNNƒƒnnOO‚‚mmNN{{iiJJrr^^BBhhTT88jjWW77rr__==vvcc??{{hhDDmmGGmmFFoobb>>TTLL::‰‰€€pp¢¢““{{´´  ……µµ££ˆˆ’’ŠŠtt‡‡‡‡xx››šš‹‹››™™††yyzzmmccgg[[eellYYhhll\\iiii[[kkhh[[jjkk^^hhjj\\kknn]]vvzzff~~„„rr{{‚‚vvqq{{rr__ppff\\llbbjjttlllluummooxxqqppyyqqnnyyoommxxnnmmxxnniitthhggrrhheeppggwwƒƒzz••‘‘¡¡££——££££––§§¨¨››``ddZZ %%%%..##WW``SS{{„„wwƒƒ€€ˆˆ€€……‰‰xxxx{{nnaabbTT\\[[LLppjjWWppmmYYeeggYYLLPPCCUUXXIIffjjXXllpp]]nnss``vvzzff||}}kk„„ƒƒtt‰‰‰‰zzŠŠŠŠ{{‰‰‡‡||}}~~xxss}}nnvv~~llddffVVeeffUUttqq^^}}ww``‹‹hh˜˜ˆˆmmŸŸŽŽpp¥¥““vv´´——~~¶¶™™ÖÖËË®®ÿÿÿÿööÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüÿÿÿÿúúÿÿÿÿûûÿÿÿÿûûÿÿÿÿýýÿÿÿÿûûþþýýøøüüûûõõÿÿþþùùÿÿÿÿüüÿÿÿÿüüüüýý÷÷ùùúúóóúúûûôôþþþþøøÿÿÿÿûûÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿûûÿÿÿÿùùüüýýõõóóôôëëññòòëëöö÷÷ññûûüü÷÷üüýý÷÷úúûûõõ÷÷øøóóõõööññóóôôïïòòóóííððññììííîîééîîïïêêííïïééììïïééëëííççééëëååááããÞÞÕÕ××ÑÑØØÜÜÖÖããééââääêêããããééââááççââááççââââèèããççééããêêììççïïòòììõõøøòòøøúúôôùùúúôôúúûûõõööúúôôòòøøõõëëññððææññððååôôððííøøó󪪨¨¤¤XXZZQQkkqqjjkkoogg^^ZZIIaaTTAAeeZZAAAA22 @@FF66ZZXXDDRRGG--RRII//YYSS==YYRR==MMEE22GG@@33<<44##!! ..22 QQQQ;;__ZZ<>22##  - -''++QQKK22bbYY88ffaa>>jjcc>>llcc>>WWII//   IIKK99qqooYYrrjjNNff^^BB<<99%%OOTTKKnnvvbbRRYYEE5599....9900??II>>\\hhYY[[iiVV[[hhUUbbkkZZ^^eeWWKKQQEE  NNXXWW——ŽŽ„„ŠŠ‹‹ƒƒˆˆŠŠƒƒjjssee!!,,2200hhuullzzˆˆxxss}}kk"" ]]ii``tt~~llYYZZLL4466--####VV__WWjjmmccggffXX]]\\OOQQRRGG)),,##((..##,,**%% DD@@11KKEE44llbbNNnnaaLLddWWAAkk]]??rr__>>ttaaAAxxggFFmmNNƒƒnnQQˆˆooSS‡‡ooSSƒƒllKK~~ggFFxxbbDDvvaa@@zzbb??eeAA‚‚jjGG‡‡qqMM‡‡ttOObbTT44bb``II‰‰‹‹ww››——¡¡––‚‚––||‡‡††uu††ƒƒuu‰‰‡‡vv~~||iiqqppXXlljjSSmmkkTTrrmmVVwwqqZZ€€zzddˆˆ……pp‰‰‡‡uu††ƒƒttzzwwiibbddWWXXddYYffuull››¥¥ŸŸÍÍÑÑÍÍÓÓÕÕÐÐââääÞÞííïïééÒÒÕÕÎÎuuuuhhssiiggsshhccoodd\\hh^^ZZdd^^__hhaalluummƒƒ‹‹ƒƒ¥¥œœ§§­­££­­°°¥¥´´··©©²²¸¸§§ŽŽ˜˜‹‹ww„„yyuu‡‡vvoo††ssww††vv‡‡ŒŒ}}‹‹ŽŽ‚‚‘‘€€‘‘ŽŽ……‚‚‚‚zzkkqqccnnwwiibbjj``LLVVKKeerrbbƒƒ~~ŠŠ‘‘„„““„„‘‘‡‡‹‹‘‘ŠŠ‚‚‡‡‚‚ffllff;;CC;;**00((SSVVLL||zzoo€€rrppˆˆ„„llŽŽ‡‡jj••‰‰ll––‰‰mm‚‚ee££““ttºº§§‰‰ððèèØØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿüüÿÿÿÿúúýýýý÷÷üüúúõõ÷÷ööññõõôôïïûûúúôôþþýýøøÿÿÿÿùùýýÿÿøøûûüüõõ÷÷÷÷ðð÷÷õõððüüûûööÿÿÿÿûûÿÿÿÿýýÿÿÿÿýýÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿûûÿÿÿÿùùÿÿÿÿùùüüýý÷÷õõööííïïððééòòôôîîúúúúööûûüü÷÷ûûüüöö÷÷øøòòòòóóííììïïééééîîççèèééääââääÞÞááããÝÝÞÞããÝÝßßååÞÞááççààààããÝÝÛÛÝÝØØÙÙÛÛÕÕÜÜßßØØÜÜààÙÙÙÙßßÙÙØØßßÚÚÚÚààÛÛÜÜââÝÝááææââççééããëëîîèèòòôôïïööøøóóøøûûôôùùûûõõúúüüõõøøûûôôóóúúôôîîôôññååððîîääõõïïÝÝêêãã‚‚OOTTKKUUbbRR[[hhbb]]aaUUZZXX@@XXVV::[[SS<<88--"",,**##PPSSAAQQKK2222--!!!! <<99((WWQQCCWWLL==QQCC00&& - - - -&&%%UUSS<>QQBB((%% - - '']]aaNNppmmQQmmeeFFMMII22 - - CCHH??bbpp]]__mmYY00..'',,22++JJQQGGXX``RR[[ddYYVV``UUWWbbVVYYggZZWWaaWW%%(("" - -QQ]][[ŒŒ••ŒŒ’’””ˆˆ‘‘’’‰‰……††oo{{ll--::.. 44==77iizzmm~~‰‰zzffoo]] RR``SShhss]]]]__NN@@CC66....%%$$TT]]SShhkk^^ddddTT^^^^PPWWXXMM!!##@@GG99..--22,,QQMM@@NNJJ;;jjggUUOOJJ::XXNN<>FF==>>HH>>VVaaSSddll]]ZZ``PP<<<<00!!%%XX__VViimm__mmnn]]__``QQXX[[NN %%++##HHMM>>6655""HHCC44ZZUUHH__[[MM__]]MMGGGG88aaYYGGppeeGGssggHHwwffGG€€hhHH€€kkJJjjJJƒƒiiJJƒƒjjKKiiIIggFF}}eeFF€€ggHH‚‚hhHH‚‚hhHH††mmMMˆˆrrQQllPPYYOO55aa``MMššœœˆˆ¡¡¢¢‹‹œœœœ‰‰„„‡‡yy€€rr}}zzhhwwss``ssooYYvvqqYYvvrr]]wwuu__{{yyddyyzzggttxxddxx€€nn{{ƒƒqqhhpp^^FFKK<<..22##88==//„„ŠŠ€€ÛÛàà××îîîîééòòððììôôôôëëôôóóééææææÛÛrryyoo..>>33--@@44((44..%%//++''1100"",,**&&%%$$..00,,7777;;FFCC??JJEE@@JJEE99EE@@44??88HHSSGGkkxxjjrr€€ttzzxx~~‚‚tt……‰‰zz††ˆˆ}}““„„ÝÝÛÛ××ýýúú÷÷ååèèßßµµ¸¸±±™™šš””––˜˜••‘‘››‘‘šš——ŽŽuu‰‰€€@@QQPP""--11HHNNKK}}€€xxŠŠŽŽ‡‡‚‚ˆˆ€€††}}ˆˆ}}……ŠŠ{{††ˆˆttˆˆ……mmŽŽ††ooŽŽˆˆooŠŠmm““{{°°††ëëããÍÍÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿýýÿÿÿÿúúýýüüööùùøøòòõõôôïïòòóóììññóóëëóóóóííööööððúúûûôôüüüüööýýýý÷÷üüþþ÷÷÷÷ùùòòôôôôîîööóóîîûûùùòòýýþþööÿÿÿÿøøÿÿÿÿùùÿÿÿÿúúÿÿÿÿúúÿÿÿÿúúýýÿÿùùýýÿÿúúþþÿÿúúôôøøððëëëëååììììææöö÷÷òòûûüüööüüýý÷÷úúûûõõöö÷÷òòïïòòììééïïèèææììååççííææããèèââÜÜââÛÛÙÙßßØØÚÚààÙÙÜÜààÙÙÝÝààÚÚÜÜÞÞÙÙÛÛÞÞ××ØØÜÜÕÕÓÓÙÙÓÓÑÑØØÓÓÕÕÚÚÖÖØØÞÞÙÙààææááêêììççññóóííòòôôïïññôôîîôô÷÷ññóóõõððññööïïññøøððððööññêêòòïïÜÜëëííßßççããšš˜˜\\ffggRRUUPPIIPP@@PPWWKKVVXXPPVVUUFFRROO99UUNN88>>33%% - -RRQQDDUUQQ<>))883300//&&HHDD<>VVZZEEVVVV==eebbPPeeeeVVZZYYJJEEEE55NNOOAAmmnnbbssuuaa||vv\\~~qqVVmmOO‚‚mmMM€€jjKKhhII€€hhIIiiKKiiJJ}}ffGGyyddEEwwaaBB{{eeGG……ooPPŽŽ}}]]‰‰||ee\\WWDDLLPPAA……ŠŠzzœœŒŒ’’‘‘‚‚}}oonnqq]]eeiiPPbbccKKhhffOOrrnnXXssrr^^oopp__ffhhZZ__ccVV[[``VV668800&&((2244&&HHLL<<[[``JJffkkVV……ˆˆ||ÌÌÎÎÇÇõõôôððööôôòòøø÷÷ððùùúúîîùùùùììÐÐÒÒÉÉPP\\RR**55--%%00(())44..**4422##--++ ##--((88DD;;AAMMCC??JJBBBBNNCCddoocctt‚‚rr~~€€ŠŠˆˆŒŒŠŠ……††yyxxuu¢¢ªª÷÷ôôèèøøôôððïïññêêììííççïïííèèîîëëããêêççÚÚææååÚÚÜÜÝÝÔÔÒÒÔÔÌ̱±´´¬¬™™œœ””––œœ––““——ŠŠ““ŠŠ„„‘‘ˆˆƒƒŽŽ……vvxx^^jjaaZZee\\mmrrff€€‚‚rr…………pp††qq——‰‰uu¢¢––‚‚¨¨žžÔÔÄÄ¢¢ÿÿÿÿõõÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿûûÿÿÿÿûûÿÿþþøøýýüüööüüûûõõüüûûõõúúùùóóùù÷÷òòööøøññööúúòòõõ÷÷ððøøùùòòúúûûôôýýýý÷÷üüüüööüüÿÿ÷÷úúüüôôõõõõïïòòïïééôôññëëôôööïïúúûûôôüüýýööýýþþ÷÷ýýþþ÷÷üüýý÷÷ûûýý÷÷ûûýý÷÷úúüüööññ÷÷ïïëëììååëëêêääôôõõïïùùúúôôúúûûõõúúûûõõùùúúôôööùùóóóóùùòòññööïïïïõõîîïïõõîîîîôôííééîîèèããééââââååßßááââÝÝÞÞààÚÚÜÜßßØØ××ÛÛÔÔÒÒØØÒÒÑÑ××ÓÓÔÔÙÙÕÕØØÞÞÙÙããèèääííïïêêññóóííòòóóííììôôììààééááÚÚããÛÛááééààááééááááèèââââêêççÚÚççææÃÃÇÇÆÆhhkkii??KKJJ==EE>>PPRRDDddjjaa^^__UU]]YYEEXXSS==TTMM..CC:: - -0011##MMEE//AA>>(( - -BB>>))NNGG----""  - - $$''##XXYYDDaa[[>>jj\\<>JJBB88DD==\\ii]]tt‚‚tt‚‚ƒƒŠŠˆˆŠŠƒƒttqq}}ooÈÈÏÏ··ýýúúìì÷÷ôôððññððììííííççììëëææïïììææððììããííëëââììëëããííîîççððïïèèèèèèßßÚÚÜÜÔÔÐÐÒÒÈȦ¦««¤¤‚‚‡‡yyˆˆss‚‚yyffttkkeepphhsszzrrzz€€ssxx€€mm||~~hhŽŽ‡‡rr¥¥››‡‡§§¢¢‚‚Çǵµ••ÿÿööééÿÿÿÿüüÿÿÿÿþþÿÿÿÿûûÿÿÿÿûûþþþþùùýýýý÷÷üüüüööýýýý÷÷üüüüööûûûûôôúúüüõõûûýýööúúûûôôûûüüõõýýþþøøüüýý÷÷ûûýýööüüÿÿ÷÷úúüüõõõõ÷÷ððññððêêððîîééññóóìì÷÷ùùòòúúûûôôûûüüööûûüüööûûüüõõúúûûööùùûûõõøøúúôôññ÷÷ïïëëííææééééããññòòìì÷÷ùùóóùùûûôôúúûûõõøøùùóó÷÷úúôôööúúôôôôùùòòòòööððòòõõïïïïôôííììòòëëééïïèèææëëååääèèááááååÞÞßßããÜÜÚÚÞÞ××ÕÕÜÜÕÕÒÒÚÚÔÔÕÕÛÛ××ÛÛááÜÜääééååííññëëððóóííïïóóììêêòòêêããííååÙÙããÛÛ××àà××ÙÙááØØßßççßßããììææÙÙêêåå±±ºº¼¼ffhhee??DDDD??EE>>RRUULLrryyxxccee]]bbZZEE``XXDDZZQQ66AA77  DD==66FF??//  - -4466$$UUTT77HH;;**   - - - - MMLL;;kkbbEEnn__FFbbWW22%%""   YY``NNnnxxZZ55<<)) UUccVVbbooddMM[[OO==KK??iiwwlltt‚‚vv€€‹‹††……zz€€xxoosskkiilleeddgg````ggXX@@DD77==>>66KKUUGGzz„„zz††ˆˆxxwwss||qqbb``ZZ CCRRIIqq„„ww}}ˆˆ}}€€‚‚uu}}‘‘~~XXbbZZ%%++''((2200>>IIGGrr{{uuyyvvllrrccjjpp``rrzzhhxxkk??FF44 ))!!PPWWKK__aaMM^^__FF]]ZZGGMMOO@@SS]]PPffmmggeellmm``ggeejjssff~~||hh‡‡{{aa„„ww\\ƒƒssWWkkIIiiFF||iiHH}}hhFF€€iiEE……llGG‡‡llHH……nnIIˆˆssOO‹‹xxYY——ˆˆll’’‡‡mmppggRRvvzzkk~~‡‡yy‚‚„„vvzzzzkkgghhVVccccMM````GGccbbLLddddPP\\]]LLXXXXIISSUUGGDDFF99>>==33''//%%++++##FFCC::WWVVII\\ZZMMddccQQooooWW||}}ff……‡‡vv££¥¥••ììííßßûûûûóóýýüüøøÿÿÿÿüüîîññëë„„‘‘ˆˆaanngg__iiccXXbb]]VVaa[[WW__ZZRR\\VVMMZZSSCCQQGG==JJ>>>>II>>::CC99((44--**))33??66llxxmm‡‡‡‡ŠŠˆˆ€€||„„ss{{ççèè××ûû÷÷êêööòòîîòòïïííððîîééïïîîééññððëëïïîîééîîííèèííììææîîïïééîîïïééííîîèèííîîååííîîççààßßÚÚ——žž››pp~~{{qq~~pp€€xxuu€€vvwwzzvv}}rrss~~mmuu~~ii‹‹uu©©  ŠŠ¨¨¥¥„„¼¼¬¬’’üüííÝÝÿÿÿÿúúÿÿÿÿÿÿÿÿÿÿýýÿÿÿÿüüÿÿÿÿûûþþÿÿùùýýþþøøýýþþøøýýþþ÷÷þþÿÿøøÿÿÿÿúúÿÿÿÿûûýýþþùùýýÿÿøøýýÿÿùùûûþþööûûþþööûûÿÿööúúýýõõööùùññòòòòììííííççëëïïççññõõííööúúòòøøûûõõøøúúôô÷÷úúôôøøúúôôøøúúôô÷÷ùùóóòòööïïêêïïççèèééââîîïïèèõõùùññööûûòò÷÷ûûóóøøúúôôùùûûõõùùûûõõ÷÷ùùóóõõøøòòôôööññòò÷÷ððïïõõîîîîôôííëëññëëééððææææííääããççââÝÝââÛÛ××ßß××ÓÓÞÞÕÕØØÝÝÙÙÝÝããÞÞããééääêêððééëëòòêêììòòëëééññééççïïççááèèááØØàà××ØØààÖÖßßææÝÝããííææÖÖææää––©©©©iissppGGEEBBGGFF==LLLLDDjjrrqqiinnddaa\\FF``YYBBYYOO7733,, - - 553311TTMM==BB33 ""!!LLMM44QQGG22""   - -IIGG::ppffHHll__HHffaa??2222   TT]]MMllww``"" //<<66[[ii]]iiwwllNN\\PPBBPPDDjjxxmmrrtt‰‰ˆˆŽŽ††}}ƒƒ{{xxzzrrssttmmkkmmffggmm__bbggSSTTXXFFNNXXKKnnyyoo„„||yy€€vvxxss\\[[SS55CC>>ss……{{~~ŠŠ‚‚||vvrrˆˆxxWWbb[[&&++''))3311OO[[YYtt~~ww††{{xx}}mmqqxxhhuu}}kkxx€€kk>>BB22**%%OOXXOO__bbQQ^^bbJJ]]\\LLYY\\RRjjvvmmiiqqooTTYY``LLRRUUiirrffƒƒoo††yybb……ww__ƒƒssWWjjHHggDDyyffFF||ggEEjjFF……llGG‡‡mmII……nnJJˆˆssPPŒŒ{{]]™™ssžž••}}ssjjVVccddVVjjppccllnn^^ccddRRaabbMM``ccMMaaccOObbccRR[[]]NNKKNNAAFFHH>>88;;223377--))//##1133''KKGG>>YYTTII__[[NNiiffUUrroo\\{{xxdd……ƒƒqqŒŒ‹‹}}’’……¿¿¾¾´´ôôööííýýÿÿùùüüþþùùüüþþøø®®±±¬¬ccoohh__jjddYYdd^^XXcc]]YYaa\\VV``[[PP]]VV;;HH??,,66,,88@@77DDJJAAEEMMGG@@GGGG**22**OOXXNN‰‰‡‡‹‹ˆˆŽŽ€€……uu§§¬¬óóòòääõõññççôôððééóóññëëññððêêòòññëëôôóóííôôóóííôôóóííôôòòííòòòòëëîîïïèèììííççììííååëëììååííííèèØØØØ××——œœ››pp}}zzkk{{ssmmzzssiissqqhhrrhhjjxxhhpp{{hhŒŒyy­­££­­©©‰‰¼¼««‘‘øøææÕÕÿÿÿÿûûÿÿÿÿþþÿÿÿÿýýÿÿÿÿýýÿÿÿÿýýÿÿÿÿûûÿÿÿÿúúÿÿÿÿúúÿÿÿÿúúÿÿÿÿúúÿÿÿÿûûÿÿÿÿýýÿÿÿÿüüÿÿÿÿùùüüýý÷÷ûûþþööûûþþööûûþþööúúýýõõùùûûôôôôôôîîëëëëääææééááëëîîææóóööïïööøøòò÷÷úúôô÷÷úúôô÷÷úúôôööùùóóööøøòòññõõîîééîîææååææßßëëííææóó÷÷îîôôùùððõõùùññööùùóó÷÷ùùóóùùúúôô÷÷ùùóóõõøøòòõõ÷÷ññòòøøññòòøøññññööððîîôôîîëëòòèèééïïææèèëëççââççááÚÚããÚÚ××ââÙÙÛÛááÜÜÞÞããßßããèèããççììææêêððééêêððééêêññééééññééççïïççääììããÞÞææÝÝßßççÝÝããììååÆÆÓÓÖÖƒƒžžžžiizzwwKKGG::QQMM::SSSSAAVV__XXhhoodd__]]FF^^YY>>NNCC..   - -%%PPTT::__UU55>>//"" 8888..QQII6655))YYZZGGnnffGGmmddLLggeeHHEEGG// ##XXddVVddpp``XXdd[[llzzoopp}}rr]]kk__YYgg[[kkyymmllzznnww„„xx€€‰‰zzxxvv}}uuuu}}ttuu~~ttqqzzoossyyhhccggXXTT\\RRjjssii}}xx{{‚‚xx||……uu__aaVV3377--!!11>>;;oo€€{{}}‹‹……yy‚‚xxddxxjj\\hhaa((//++++5533ZZffcckkuummuu~~ssqqxxiiqqxxhhwwmmqqzzffDDMM??&&!!%%,,))GGOOFF__ffTTbbhhPP__bbQQkkppaaww„„uuzz……zzss{{uuyy}}––––””……€€ll‰‰yycc„„ttXX€€kkJJ||eeCCxxddDD{{ffDD€€jjFF††nnJJˆˆnnLL‡‡ppLLyyUUššŠŠmm™™ww••||ww||oo\\ddVV``ddMMccddMM``bbMM]]__HH]]``KKffiiXXYY]]LL>>BB6677;;330055,,&&))!!**//%%++44&&VVVVHHjjll^^ffjjZZkkoo^^ppuuddrrwwhhvvzznn}}ƒƒww||ƒƒvvuuzzoozz~~ttÇÇÊÊÁÁÿÿÿÿûûýýÿÿûûÿÿÿÿùùááààÜÜwwzz]]iibb\\ff``YYdd^^[[dd^^ZZdd]]VVcc[[OO[[RRHHOOFFTTZZQQ[[__WW^^cc__``dddd``ee__nnttkk††‹‹ƒƒ‹‹ŽŽ‡‡ŒŒŽŽ‚‚‡‡ŒŒ||ÄÄÅÅ··ììèèÝÝêêççÞÞëëèèááïïííææððïïééòòòòëëõõõõïïøø÷÷ññ÷÷ööññøø÷÷ññòòóóììììîîççêêììååêêëëããììííççêêììççêêééããááââÙÙªªµµªªjjzznnccssllccpplleepphheesseekkxxff††‡‡uu««££ŽŽ±±««ŒŒºº©©ŽŽòòááÑÑÿÿÿÿûûÿÿÿÿýýÿÿÿÿþþÿÿÿÿþþÿÿÿÿþþÿÿÿÿýýÿÿÿÿüüÿÿÿÿýýÿÿÿÿüüÿÿÿÿúúÿÿÿÿüüÿÿÿÿüüþþÿÿùùýýþþøøüüýýööüüþþööûûÿÿõõüüÿÿööûûþþööûûýýööõõõõïïëëììææææééááééììääññôôííôôööññ÷÷úúôôøøúúôô÷÷ùùóóööùùóóõõøøòòððõõííèèííååââääÝÝééëëääññôôííôô÷÷ððôôøøññõõùùóóõõøøòòõõùùòòõõøøòòóóööññòòõõïïòò÷÷ññññööððññööððððõõïïííôôëëëëòòééêêïïêêææììååßßççßßÛÛääÝÝÜÜââÝÝÝÝããßßààææááääëëããééïïèèêêððééééññééééññééììôôììííõõííëëóóêêååííääããììæ涶ÃÃËË‹‹¥¥©©qqƒƒNNQQ==TTVV??UUYYEESS[[KK^^ii\\\\__HH``YY<>$$]][[::aaVV99,,""((%%!!PPJJ99LLCC-- WW^^KKjjllNNkkkkPPddbbKK::<<++??LL@@ffuuhh]]hh\\ - -((33//ffssjjllzzssll{{ppeesshhbbqqffddsshhbbqqffhhxxllrr€€uuqq}}ttss}}ttvvwwvv……yyvv„„ww||††xxxxrrnnssggsszzoozzww{{‚‚xxxx‚‚wwggqqeeOOZZNN77??55??KKDDWWhheett……pp{{vvZZff^^TTdd[[HHUUPPFFSSNNTTaa[[``kkccggsshhhhsshhjjttffnnyyffddnn__NNTTLL////))**00((==GG;;``iiUUaakkTTffmm\\yypp‡‡€€‹‹––††––££——ŸŸ¢¢››œœœœ••‡‡uu}}ddˆˆwwZZ€€nnPPyyeeDDxxbb??zzddBB€€kkHH‡‡ppOO‡‡ooPP‡‡rrNN••‚‚[[££’’qq””ŒŒvvqqsshhffmmdd__ddTT\\``GG]]__DD]]__FFOOPP>>PPRRBBbbffQQBBII550066,,--44..11<>OOSSCC[[``PPqqvvffsswwggppwwggooxxggqqyyiippyyllnnzznnllzzppiittllhhmmeeffii__ˆˆŒŒ„„ÞÞááÙÙüüÿÿøøüüÿÿööøøùùóóŽŽ––YYff__ZZgg``XXff__[[ff^^]]gg^^\\hh^^]]gg^^^^ff]]^^ff]]aaii``fflleejjqqiissyyqqzz††‹‹ƒƒ‡‡‡‡ŠŠ„„••——‡‡ÑÑÑÑÄÄááÞÞÕÕßßÞÞÕÕááââÜÜããääÞÞççèèááîîððééöö÷÷ððùùúúóóùùúúóóõõööïïððóóëëééííååèèììääèèééààêêììääääêêääââççßßããççÞÞÛÛààÙÙƒƒ‡‡WWll``^^mmccccmmeeffqqddhhuuaa‚‚oo©©¤¤‘‘±±¨¨¸¸ªªêêààÑÑÿÿÿÿúúüüþþûûþþÿÿúúÿÿÿÿýýÿÿÿÿüüÿÿÿÿýýÿÿÿÿüüÿÿÿÿýýÿÿÿÿüüÿÿÿÿüüÿÿÿÿüüÿÿÿÿúúýýþþøøýýþþøøüüýýööûûþþôôüüÿÿôôüüÿÿóóûûÿÿõõúúþþööõõùùññííððééææèèããççêêääïïññììóóõõððööùùóóööùùóóøøúúôôøøúúôô÷÷ùùóóññööïïææëëããááââÛÛççèèââððòòííóóõõððôô÷÷ññóóúúòòòòøøññññ÷÷ððòòøøññññ÷÷ððññööïïññööïïððõõïïññööððïïôôííîîôôííííóóììêêññééååííååááèèââÞÞääááÝÝääààÝÝääààßßååááââêêââææîîææêêòòêêééññééëëóóëëììôôììííõõííííõõììééððêêææííêê««¶¶»»‘‘¡¡¥¥mm{{xxWW]]JJXX__JJTT^^KKRR\\NNVVccWWVV__MMXXWW??@@77%% $$OOQQ==``ZZ;;==55!! BBCC00^^\\FFTTSSBBNNOO==[[ZZBBcc``BBOOMM5566BB55ffrr``kkqqaa^^^^PP$$%% YYjj^^mmuuPP``UU --$$++==88GG[[WWZZoohhddvvtteexxrr^^qqii^^ooii]]nnhh[[llff^^ppjjhhxxoohhwwlljjttjjvvwwyy‡‡{{{{‰‰}}||ˆˆ||}}††{{||„„{{yy„„zz{{……||{{††}}tt€€vvllyyoo``llbbLLUUKKHHTTMMPPaa^^hhyywwiittrrTTaa[[TTcc]]WWdd__OO\\WWOO\\WWaakkffggrrjjhhssiiggssggbbpp^^]]jj]]RRZZTT;;>>::22::44;;GG>>\\ggWWbbnn[[ffppdduuvv……““‡‡ŠŠ˜˜ŸŸ••””¤¤——££––––™™ˆˆ””‰‰vv€€ff‰‰yy\\ƒƒqqSS||ggGG{{eeCC||ffDD€€kkHHˆˆqqPPƒƒkkKK}}ggGGœœˆˆgg¬¬››xx’’‹‹ttZZ\\RRZZ^^RR``bbRR]]^^JJ]]__GGQQRR<>>>DD33""'' ##**%%DDOOBBWW]]MMaaeeUUqqvvffww||llvvzzjjww}}mmuu}}llqq||mmpp{{oommzzooiivvnn\\gg^^VV[[RRbbdd[[xx{{tt  ££œœêêïïææþþÿÿøøõõööðð‹‹””\\iibb[[hhaaXXee^^YYdd\\[[gg]]^^ii``__ii````hh__ccjjaaeennddiittggoozznntt~~ss€€……}}‡‡††‡‡‘‘ˆˆŠŠƒƒ¢¢¥¥••××××ÊÊÙÙÙÙÏÏÚÚÛÛÒÒÚÚÝÝÖÖÜÜààÙÙááääÜÜëëïïççôô÷÷ïïøøùùóó÷÷øøññóóôôííëëîîææââææÞÞääèèààççèèßßääççààààååßßÞÞââÜÜààääÝÝÛÛààÜÜ››˜˜TThhbbZZhh``aallbbbbnn``eerr__}}€€mm  ™™††««¤¤ŠŠ··­­––ììââÔÔùùøøòòøøûû÷÷üüýý÷÷üüþþùùýýÿÿúúÿÿÿÿüüÿÿÿÿûûÿÿÿÿüüÿÿÿÿüüÿÿÿÿûûþþÿÿúúüüýýøøýýþþøøýýþþøøüüýýööüüþþööüüÿÿ÷÷üüÿÿ÷÷ûûþþööúúýýõõööúúòòïïòòëëêêììææééêêååììïïééññóóííõõøøòòõõ÷÷òòõõøøòòööùùóóôô÷÷ññññööïïééîîååââããÜÜææèèááïïññììôôõõððôô÷÷ññòòùùññññ÷÷ððòò÷÷ññññööïïððõõîîïïõõîîîîôôííîîôôííïïõõîîïïõõîîííôôííììòòëëêêññééååííååááèèââßßååááÜÜããßßÛÛââÝÝÜÜããÞÞááééááææîîææêêòòêêééððééêêòòêêììôôììììôôëëììôôììêêññëëèèîîëë››¦¦©©€€‡‡ŒŒ``jjffXXccPPUU``LLQQ__LLPP]]NNMM\\QQUUddWWXX]]IIOOHH33!!&&QQ^^MMiikkNNmmiiTT;;55.. - - - -AAEE<>LLAACCTTLL55GGEE11EEBB;;RRPP??VVSSBBYYSSII[[XXNN``]]LL^^[[LL__\\SSee__XXhh]]ZZddYYhhrrhhww„„yyxx‡‡||xx……||yy„„||||‡‡~~yy……~~zz‡‡xx……}}tt€€xxllyyqqiivvmmZZddZZVVbb[[__ppmmhhxxxxkkvvvvaammjj\\jjeeRR^^ZZ==JJFFHHTTPPeeppllkkvvqqllwwoogguukk``oo__UUccWWSS\\VVIINNJJ99CC>>66DD>>LLXXMM]]kk\\bbooffffttll``qqhh]]ooggyy‹‹‚‚““¥¥––––ŸŸŽŽ––››‰‰””ŒŒxxŽŽgg‡‡xxZZ‚‚ooQQ}}iiHH}}ggDD}}ggEEkkHH††ooMM††mmMM€€iiLL¢¢ss±±ŸŸ††——xxaaddOOffiiYY``bbRR``__NNXXYYCCGGII44??@@22;;<<11;;??//%%++44;;55YYeeWWaaggWWkkoo``vv{{kkssxxhhrrvvggxx}}nnwwnnqq||oollyynn__nneeOO__WWJJUUMMDDHH@@ZZ]]SSƒƒ‡‡ˆˆ»»¿¿¶¶ööúúññöö÷÷ññœœ¥¥YYff__UUbb[[PP]]VVMMYYQQTT__VV]]hh__aakkbbccjjaaffnneehhqqhhllxxppsswwww‚‚zzƒƒ‹‹‚‚ˆˆ““‰‰††““ˆˆˆˆŽŽ‚‚±±´´¤¤ÝÝÝÝÐÐÚÚÜÜÑÑÛÛÞÞÓÓÚÚßß××ÚÚààÙÙßßääÜÜççííååððôôííôôõõîîòòôôííííïïèèèèëëããããççßßääèèààææèèßßääççßßÞÞããÝÝÝÝááÜÜÜÜààÛÛÕÕÙÙ×׆†‘‘‘‘NNaaaaNN\\VV[[ee[[ffqqccoo}}ii††‰‰uu——||  šš‚‚½½¨¨óóììÞÞòòññêêóóõõññ÷÷ùùòòùùûûõõúúüüööþþÿÿúúÿÿÿÿúúÿÿÿÿúúþþÿÿúúýýþþùùýýþþùùýýþþùùýýþþøøýýþþøøüüýýööüüþþøøüüÿÿùùüüþþùùúúýýööùùüüôô÷÷úúòòòòõõîîííïïêêèèêêååêêììççððòòììóóööððôô÷÷ññôôööññõõ÷÷òòôôõõððððõõîîêêïïççããååÞÞääææààííððêêóóõõððôôøøòòññ÷÷ððññõõïïððõõîîîîôôííííóóììîîôôííííóóììííóóììííóóììïïôôííîîóóííííòòëëêêññééååîîååááééââÞÞååááÛÛããÞÞÙÙààÛÛÙÙààÛÛÜÜääÜÜââêêââææííååèèïïèèêêòòêêëëóóëëììôôëëììôôììêêññëëééïïì솆™™——ss{{xx[[aaZZVV^^PPUU\\MMTT[[MMRRYYJJOOYYII]]jj__hhtteeWWWW??::55##''..&&SSccXXhhuucctt||qqrrzzuuQQWWUU((,,,,""((%%((11(($$-- HHQQDDqqssxxˆˆyy~~‰‰}}[[ff]] - -  ``rrpphh{{ss&&..%% OO]][[ff{{zzYYooffBBTTGGCCRRHHCCQQHH''22..))%%33,,!!44..11DD==@@RRHHDDVVKK@@SSHH77KK@@DDUUJJOO\\RRPP\\SSXXaaXXeeqqggll}}rroo}}ttpp||ttllvvooggrrnnmmzzvvss}}pp||ll{{vvkkzzrrkkyyllhhvvmmjjzzxxpp~~{{rr~~zzoo||xxllwwrrXXbb^^GGTTQQSSbb\\aaqqhhjjyynn}}tteeqqjjUU\\PPLLUUJJKKPPHHEEHH@@;;>>7766<<55??EE==MMUUGGWW^^QQMMXXKK((88++''$$,,::55vvƒƒvv——¡¡––››‡‡™™‘‘{{‚‚hh„„ttTT{{iiFF{{hhBB||ffCC}}ffDD‚‚hhEE††kkHHssPPŽŽvvTT¢¢””ww¶¶­­••««¥¥’’ŸŸ‡‡‰‰||^^bbQQ\\bbKKTTYY??HHLL66??@@223388++--44&&&&,,<>00@@BB44BBDD55AAFF7799EE55''77++%%%%??KK??‡‡””‚‚••šš††œœ””~~‚‚hh}}mmMMwwffBBwwdd>>zzee@@~~hhDDƒƒjjDD……kkCCvvMM˜˜ƒƒ]]¦¦œœ½½ªªÌÌÊʼ¼ÊÊËËÄÄ®®²²ªªvvzznn]]ccQQVVZZFFLLOO==BBDD5599>>0055<>RRPP11??9911;;22[[eeWW||‰‰uu‡‡ŒŒww’’zz¨¨¤¤‘‘ââääÒÒêêííââîîïïèèòòòòííòòóóîîóóööððóóõõððõõööññ÷÷øøóóùùúúôôùùúúôôúúûûõõøøùùóóùùúúôôùùúúôôùùûûõõûûüüööúúüüööùùûûõõùùûûõõùùûûõõøøúúôôööøøóóôô÷÷ññññóóîîëëííççççééããççììååììòòëëììòòëëîîððëëííïïêêïïññëëëëïïééååëëääÝÝããÜÜÞÞââÛÛççééããííððêêïïóóììììòòêêììòòêêëëññééëëññêêëëññêêëëññêêëëòòêêëëòòêêëëòòëëììóóììëëòòëëêêññêêêêññééææîîææããëëääÞÞååááÚÚááÜÜÕÕÛÛ××ÒÒÙÙÔÔÓÓÛÛÔÔØØààÙÙààççááääììääèèððèèëëóóëëííõõííîîööïïííôôññêêññïïppuuqqvvkkgghhYY\\bbTTPPWWJJLLTTEERRVVJJUUYYKKPPXXDDbbnnZZqq€€uull{{rrWWffUUAAOOFF<>AASSFFEEVVKKEESSJJ88DD??&&11.. ..**%%33..@@NNHHJJVVMMHHUULL&&33** - -((66,,CCPPCCGGPPBBIIUUFFGG[[KKDDYYJJ<>~~hhAA……mmCC‡‡ooFFŽŽwwQQžžŠŠll¬¬££ÊÊÈÈ»»ÔÔÖÖÎÎÍÍÒÒÑÑÉÉÐÐÌ̸¸ÀÀ··¤¤­­žž‚‚WWYYKKEEGG88AAFF77FFMM??WW]]OOddll^^TT]]NNYYbbSSooxxjjuu}}nnvv~~oorr{{llooxxkkoozzmm``ll__((8800 ))GGQQEEhhnnddnnwwoomm{{sstt{{sswwvv}}……{{ŽŽ‚‚££  ——››  ——^^llddRRaaYYSSbbZZXXgg__^^lldd^^mmccddsshhhhwwllll{{pprr€€vvxxƒƒzzyy……||||‡‡~~‚‚ŽŽƒƒƒƒŽŽ„„}}‰‰„„||¿¿¹¹ããääÜÜÞÞááÚÚßßááÙÙÛÛààØØÙÙààØØÙÙááØØÜÜããÛÛààææÞÞââææÞÞääèèààääççßßææêêââèèëëããèèëëããææêêààààääÜÜÛÛââÛÛØØÛÛÕÕËËÏÏÅů¯¹¹²²bbrrqqCCVVQQ==LLBB;;EE;;[[ddWW{{ˆˆttˆˆŽŽyy’’““~~Äı±ëëîîÝÝêêííääïïððëëññññïïòòóóïïóóõõïïððòòííòòôôîîõõööððõõööññõõööññõõööððóóôôîîôôõõïïôôõõïïõõööððõõööññôôööññôôööññõõ÷÷òòôôööññôôööññóóõõððóóôôïïññóóííììîîèèææééããããèèááååëëääææììååèèêêääééëëååëëííèèèèììææããééââÛÛááÚÚÛÛààØØääççÝÝêêííääììððççééîîææééîîææééïïççêêïïééééîîèèééïïèèèèòòééééóóêêêêôôëëêêôôëëééóóêêççòòééççððççååííääããëëääÞÞååààØØßßÚÚÒÒÙÙÔÔÏÏÕÕÑÑÏÏÖÖÒÒÕÕÜÜØØÞÞååààããêêããèèððèèììôôììîîööîîïïööððîîõõòòêêððîîllwwrreeqqeebbhhXX``ddVVUUYYMMLLPPGGTTZZNN^^eeRR[[bbOOZZ__RRiittkkxx‹‹‚‚NNYYRR33;;4411BBBB..@@@@''99::((885588FF>>66EE<< !!//6644GGII??MMHH%%!!''5500,,::22((22))-- &&   ''33--CCSSJJGGVVLLEEQQHH88DD;;00==4488EE==FFSSJJFFQQHHDDOOFF::EE<>;;**;;77))::77++<<99%%6633""2200''5533,,771100::5511??==MM\\XXddrrkkIISSIIDDKK@@CCHH??228811##**## &&&&$$//..€€‘‘††ŽŽœœŒŒ––ŒŒcckkbbddllZZŽŽŽŽyy‘‘ŒŒttŒŒ††ii‚‚ttQQ~~kkFF||ffAAzzdd>>}}ggAA……llFF‰‰ooJJyyXX££““}}ºº²²¥¥ÃÃÇǽ½ÊÊÎÎÇÇÉÉÍÍÉÉÈÈÏÏÈÈËËÓÓÌÌÐÐØØÑÑÍÍÑÑÈÈœœŸŸ””]]``UUDDKK??NNXXKKZZccVVQQXXMMFFKKBBeemmcctt~~rrssoossoopp}}mmpp||ll``ll__11==55%%""##HHPPHHggrrffaaooccUUddZZMM[[RR]]ff\\nnttll~~ƒƒ{{””——‰‰œœŸŸ——››‹‹ccmmccNN__UUQQaaYYWWee\\YYhh^^__nncceettiikkzznnnn}}rrsswwzz……||{{‡‡~~‹‹‚‚…………€€ŒŒ||‰‰yy……uu±±±±¥¥ææââÙÙÝÝÝÝÔÔÛÛÜÜÔÔÙÙÛÛÕÕÙÙÞÞ××ÙÙßß××ÛÛââÙÙßßääÜÜááääÜÜââååÝÝââååÝÝääççßßççëëããééììääååèèààààääÜÜÚÚââÙÙØØÜÜÓÓÒÒÕÕÍͧ§°°¬¬__nnkkLL__[[FFVVOOGGTTKK__jj]]}}‹‹{{ˆˆ}}˜˜™™‰‰ÔÔÖÖÉÉèèííääèèííççëëððééîîóóííððóóííññóóííññóóííòòôôîîóóôôîîóóôôïïòòóóííòòóóííððññëëïïññëëññòòììññòòììññòòììïïññííïïòòîîððòòïïððòòííïïòòëëððòòììððóóììííóóììééîîççááææßßÝÝããÜÜÞÞääÝÝááççààååèèââççééããèèééääååêêããààææßßÙÙßßØØÙÙßß××ââèèßßèèííååããèèààÝÝääÛÛååêêââêêîîææèèííææççììææèèííççèèððèèèèððèèèèññééééòòééèèññééééòòêêèèððççååííääããëëääßßææááØØßßÚÚÐÐ××ÒÒÌÌÓÓÏÏÍÍÔÔÏÏÓÓÚÚÕÕÛÛââÞÞããëëããééññééììôôììïï÷÷ïïîîööïïííôôññêêððîîffppgg__nnaa__ffWW[[^^OOQQTTGGPPRRII[[\\RRddhhWWddnn``__iiaa\\ff\\››¨¨ŸŸˆˆˆˆHHLLGG@@SSRR==SSRR;;JJKK66CCAA33>>8866;;7744<<@@**<>LLDD±±Ãÿ¿¿¿ÉÉÇÇ„„‹‹ŠŠZZkkffRRee``//@@==##4411 11--..**00,,##3300((5533++771100;;6655BB@@IIVVQQWWff^^DDOOGG>>GG@@//55//##"" !!!!##"" LLWWRR  ––ŒŒ™™ŽŽšš‘‘““šš‘‘––„„““€€‘‘ŠŠyy‹‹……oo‡‡yyXXnnHH~~hhCC||ff??~~hhBB……llGGˆˆppKK‹‹||\\¢¢œœ……¾¾ÁÁ²²ÁÁÈȾ¾ÄÄÊÊÃÃÄÄÊÊÃÃÅÅÌÌÄÄÈÈÐÐÈÈÉÉÐÐËËÉÉÍÍÇÇÉÉÍÍÅÅ°°³³¬¬llrrjjUU^^UUUU]]TT++22))NNTTLLrr{{rrssttpp}}pppp~~qqqqrreeppii00::88$$''%%##55<<44ffnneeaaoobbTTggZZNN``UUccttjj„„„„——••™™––ššžž••››¡¡¡¡¥¥˜˜yy€€xxHHYYNNJJZZRRQQ__VVUUdd[[ZZii``ccrrhhllzzppoo~~tttt‚‚xx||‡‡~~€€‹‹‚‚„„††‡‡‡‡€€ŒŒ||ŠŠ~~ŒŒ}}™™››ŽŽÓÓÐÐÃÃÝÝÜÜÐÐÛÛÛÛÑÑÙÙÛÛÓÓÛÛßßØØÚÚààØØÜÜââÚÚÝÝããÛÛààããÛÛààããÛÛááääÜÜââååÝÝååééááååééááããææÞÞÞÞããÛÛØØßßÖÖÖÖÚÚÐÐÑÑÔÔÌ̪ª³³¯¯eessppUUggccTTdd^^\\jjaarr~~ttƒƒ‘‘„„ŠŠ‘‘„„££¥¥——ÛÛßßÔÔææììææééïïééììòòëëïïõõîîññôôîîòòôôîîóóõõïïóóõõððóóôôîîòòôôîîññòòììòòóóííññòòììððññëëîîïïêêííîîééììííèèëëììééèèëëèèêêììééëëííèèëëîîèèííïïêêííññëëééïïééèèííççààææßßÖÖÜÜÕÕ××ÝÝÖÖÛÛààÙÙááääÞÞääææááååççááããèèââßßååÞÞÙÙÞÞØØÖÖÜÜÔÔààææÞÞââèèààÕÕÛÛÓÓÏÏÖÖÎÎßßääÜÜççëëããääêêããääêêããååëëääææííææççïïççèèððèèééññééééññééééññééééññééççîîææääììååààççããÙÙààÛÛÑÑØØÔÔËËÒÒÎÎÌÌÓÓÏÏÑÑ××ÓÓÜÜââÞÞããëëääêêòòêêììôôììîîööííîîõõïïííôôññêêððîî__jjZZ^^ll[[__ggYYWWYYJJLLLL==PPPPDDXXYYNNWWbbQQff€€ss¶¶°°||„„zzƒƒyyÊÊÒÒÄÄŸŸ¬¬¤¤kk}}}}TTccccAAMMPPIITTSSGGPPIIDDIIEE;;BBFF//==;;@@TTKK[[ffZZ;;==11  - -##&&''!!,,!!++44**3388++66==55::CC7711>>,,--55''**66))""44((AANNEERR^^UUVVccYYRRddXXHHZZNNDDUUJJBBPPFF??NNDD@@OOEEAAPPEEDDOOFF!!77CCAALLYYNNPP\\OOJJWWLL33??55"" ##%% ——¤¤ŸŸÅÅ××Ïϲ²½½··iixxppVVhhcc::KKGG""33//))&&(($$,,((""22//''5533++772211<<7733AA>>BBPPKKPP__WWEESSKK44??99--5500&&--&& '' ((!!))--""4455))<<<<44==>>77__hh__‹‹™™˜˜ŽŽ™™——žž––——œœ‹‹šš””ƒƒ’’ŠŠwwˆˆgg††vvUU€€mmHH€€iiEE}}ggAAjjEEˆˆooJJŠŠqqNNŒŒ||^^¡¡ŸŸŠŠ¼¼Åŵµ¾¾ÈȽ½ÁÁÊÊÁÁÂÂËËÃÃÃÃËËÃÃÇÇÎÎÆÆÈÈÎÎÉÉÅÅËËÅÅÁÁÈÈÁÁÆÆÌÌÅż¼Ãü¼wwwwHHPPIIDDLLDDjjttjjqq}}ssoo~~ssmm||qqnn||rrddrrhh))** ""))11,,bbjj``ss||oommxxjjkkxxmmuuxx~~ŠŠ‚‚‰‰’’‰‰••››““––››••––‘‘˜˜‹‹——žž••””œœ””eevvkkKK[[SSMMZZTTSSaa\\YYggbbccqqkkkkzzrrnn}}uussxx~~‰‰„„††‡‡‘‘ˆˆ‡‡††~~ŠŠ€€||ŠŠ‘‘„„††‹‹~~››››‹‹ÁÁ±±ÖÖ××ÊÊÜÜßßÔÔÝÝââØØÜÜââÚÚÜÜââÚÚÝÝââÚÚÝÝááÙÙßßââÚÚßßââÚÚââääÜÜããææÞÞããççßßááääÜÜÝÝááÙÙÔÔÛÛÓÓÒÒÖÖÌÌÐÐÔÔÌÌ­­¶¶²²ccqqnnZZllhh^^nnggiiwwooww……||‚‚““‡‡——‹‹¯¯±±¥¥ààââÚÚææêêççèèííèèëëññêêííôôììððôôííòòóóííòòóóîîòòõõïïññõõîîððõõîîïïôôííïïððêêîîïïêêííîîééëëëëææééêêääççèèââååææââßßââÞÞààââßßããååààååççááææèèããççêêääååëëääååëëääßßååÞÞÔÔÚÚÓÓÒÒØØÑÑØØÞÞ××ààââÜÜääææááææééããääééââââèèááÜÜááÛÛ××ÜÜÕÕÞÞããÛÛÞÞããÜÜÔÔÚÚÒÒÕÕÜÜÓÓÛÛààØØääèèààääêêããääêêããååëëääããêêââääììääççîîççèèïïèèèèððèèêêòòêêëëóóêêééññèèææîîèèââèèääÛÛââÝÝÒÒÙÙÕÕÌÌÓÓÎÎÊÊÑÑÌÌÎÎÕÕÐÐÜÜããÞÞääììääééññééííõõííîîööîîîîõõïïììóóññééïïíí^^hhUU]]jjZZ``ffYYWWXXFFIIJJ99OOOOBBVVZZMMSSddSS­­¢¢ÎÎééããÂÂÈÈÂÂnnllff¤¤¯¯££ÎÎââÙÙ½½ÌÌË˦¦®®²²‰‰””••ˆˆ““’’††ŒŒ„„xx‚‚ƒƒtt||{{ww‚‚bbkkaaGGHH99 ((""00%%##00$$**33%%11<<0055BB44??LL??GGQQEEJJVVFFFFUUFFHHVVKKOO[[RR\\jjbb__qqjjSSdd[[GGWWMMDDUUJJDDTTKKFFWWOOFFYYPPHHYYOO''55))''3300??MM@@LLYYKK77CC99%%nnwwrrÃÃÔÔÊÊÁÁÎÎÆÆ””¡¡››UUffddHHZZXX55GGBB**$$$$"",,--""11..))5500,,8844//;;8800>>;;::JJCCJJ[[RRGGUUOO33??88++66..**77..--77..2288003366++2255))4488--::;;22]]cc[[ŠŠ˜˜ŽŽšš‘‘’’œœ““——¡¡””››¡¡œœ™™……††nnxxYY€€rrMM~~llFF~~iiDDjjFF€€nnHH‡‡qqJJ’’uuSS––‚‚hh©©©©””¸¸Â´´¹¹Ãù¹ººÆƼ¼»»ÇÇÀÀ¿¿ÉÉÂÂÂÂËËÄÄÃÃËËÆÆÂÂÉÉÄÄÂÂÉÉÄÄÂÂÉÉÄÄÄÄËËÇǬ¬³³®®€€‡‡‚‚uu}}wwqqzzsspp}}rroo}}qqkk}}ppkk~~rr@@KKBB - -77CC;;ffqqhhzz„„zz}}……yy~~††yy……ˆˆ……‡‡……ˆˆ‘‘‡‡‹‹““ŠŠ‹‹’’‰‰‡‡ˆˆ‡‡††ŽŽ––——  ——„„’’ˆˆXXgg__MMZZVVSS__\\\\iiggeessnnjjxxqqoo}}wwuu‚‚||}}ŠŠƒƒ……ˆˆˆˆ““ŠŠ††ŽŽ……yy……{{xx††}}ŒŒ……‰‰‚‚ŸŸ  ±±²²££ÊÊÍÍÀÀÛÛßßÕÕÚÚããÚÚ××àà××ÚÚÞÞ××ÚÚßß××ÛÛààØØÝÝââÚÚÞÞââÚÚààããÛÛààääÜÜßßããÛÛÙÙßßÖÖÐÐ××ÎÎÌÌÔÔÊÊÌÌÔÔË˱±»»µµccqqllZZllgg__ppjjhhxxqqww‡‡‡‡™™’’››‘‘¿¿ÀÀ¸¸ÞÞââÛÛààææààååëëååééîîèèííððêêïïòòììððôôííððôôííððôôîîîîôôïïîîôôîîëëññììëëïïëëèèììèèææêêååççééääååææââääææááààääààÜÜááÝÝÜÜááÜÜÜÜááÛÛÝÝááÛÛààääÞÞââççààââééááããééââààææßßÖÖÜÜÕÕÒÒØØÑÑ××ÝÝÖÖááããÝÝååççááèèêêääååêêããããééââÝÝããÜÜÖÖÜÜÕÕÚÚááÙÙÚÚááØØÕÕÞÞÔÔÛÛääÙÙÛÛááÙÙääèèââååêêääååëëääççììååääììääååííååççîîççèèððèèêêòòêêëëóóëëëëóóëëêêòòêêèèïïééââééååÛÛââÝÝÒÒØØÔÔÌÌÓÓÏÏÊÊÑÑÎÎÎÎÕÕÑÑÚÚááÞÞääëëææêêòòììííõõïïîîõõððîîõõððííôôððééððííaaggUU]]hh]]]]eeYYZZ^^KKTTXXFFWWZZKKTT[[KKjj}}pp¸¸ÑÑÊÊÍÍààÜÜÛÛÞÞÜÜšš——iiqqkk¸¸ÌÌÊÊÊÊÜÜ××ÉÉÙÙÒÒÌÌØØÕÕÄÄÐÐÏϾ¾ÉÉÉɾ¾ÊÊÉÉÂÂÎÎÌ̲²»»ºº““••[[``[[EEEE==  - -""00((((""!!!!'' ))22((55AA66@@LLCCDDQQFFIIVVIILLYYKKHHVVJJCCOOEEJJXXSSZZmmkkXXiiccLL\\TTEEWWMMEEVVOOEEVVRRIIZZTTKKZZRR66CC88$$11++**771177DD99==KK>>//::00$$>>FF??®®¤¤§§¶¶°°ŸŸ®®ªªqq‚‚OOaa__AASSMM 22++''''0011''5511++7700,,7755--9988--<<::00BB<<<>55;;@@88VV``XXˆˆ––ŒŒ‰‰’’ŠŠ‹‹““‹‹““ŸŸ››ŸŸ˜˜’’€€ŠŠzzddooRR{{mmHHzziiEE}}hhFF€€kkIIqqMM‡‡vvOO””{{YY  ’’zz¬¬±±ŸŸ°°»»°°´´¾¾¶¶´´ÀÀ¹¹³³ÁÁ¼¼··ÄÄ¿¿¹¹ÆÆÁÁ¼¼ÉÉÃý½ÈÈÃÃÀÀÊÊÅÅÁÁËËÆÆÁÁÊÊÅÅÁÁÊÊÅż¼ÆÆÁÁ¥¥®®ªª~~ˆˆƒƒqq}}uunn}}qqffwwjjDDWWKK&&22++""..))JJWWPPttxxzz††xx„„{{zzxxˆˆ~~••ŒŒ™™ŽŽ––ŒŒŠŠ‘‘ŠŠ††ŽŽ††††ŽŽ††‹‹””ŠŠ““››’’™™¡¡˜˜——ŸŸ––‡‡‘‘‰‰ccpphhMMYYVVSS^^]]^^mmkkeeuuqqiixxttqq€€||xx††‚‚}}‹‹††‚‚ˆˆ‡‡’’ˆˆ„„„„uuxxttzz}}‡‡„„ˆˆ{{‰‰‹‹{{ššššŒŒ¢¢££––¥¥¨¨²²··®®ÇÇÑÑÇÇÑÑÛÛÒÒ××ÚÚÓÓÕÕÛÛÓÓÕÕÛÛÓÓÕÕÜÜÔÔ××ÝÝÕÕ××ÝÝÕÕØØÞÞÖÖØØÝÝÕÕÓÓÛÛÒÒËËÖÖÌÌÈÈÔÔÊÊÆÆÒÒÈȼ¼ÇÇÀÀŠŠ––‘‘ddttnnccssnnll||wwzz‹‹„„ˆˆ˜˜¢¢©©  ÍÍÏÏÉÉÚÚààÙÙÜÜääÜÜßßèèßßääëëããêêííççêêîîèèêêððééææììååááççááããééååææëëççääêêææââèèääààååááßßååááââååââááããááââääááßßääààÝÝããßßÜÜââÝÝÛÛááÛÛÛÛââÚÚÝÝããÜÜÞÞääÝÝââççààããééââààææßßÙÙßßØØÔÔÙÙÒÒØØÞÞ××ááääÞÞääææááççééããååêêããääêêããßßääÞÞÖÖÝÝÕÕÙÙáá××ÍÍÕÕÌÌÉÉÒÒÈÈÞÞééÝÝÛÛââÚÚââææááååëëääççììææèèííææççîîççèèïïèèèèïïèèééññééëëóóëëëëóóëëëëóóêêëëóóêêééññêêããééååÜÜããÞÞÒÒÙÙÔÔÎÎÔÔÐÐËËÒÒÐÐÎÎÕÕÓÓØØßßÝÝããêêææëëòòííííôôððîîõõòòîîõõññëëóóííééððììbbddVV\\hh__\\hh]]XXbbQQWWaaOOXXbbMMYYeeOOžž²²©©ÆÆÜÜÝÝÊÊÛÛ××ÑÑÜÜÙÙÊÊÑÑÍÍmmuuoo„„‘‘ŽŽÌÌÜÜÕÕÆÆ××ÍÍÉÉÕÕÒÒÌÌ××ÖÖÍÍØØ××ÍÍÙÙØØÏÏÛÛÚÚÊÊÔÔÔÔ}}€€KKJJAA;;;;00 - - 66@@7799EE;;""  - - $$,,%%44AA99@@NNEEGGUUJJNN\\NNOO\\PPCCNNDD??OOIISSjjiiTTggddNN``[[GGXXRREEVVQQCCTTSSBBTTPPCCRRMM@@MMFF<>KKFF00992222::2233<<11..99..22>>5599FF<<99EE;;XXgg\\††••‹‹ˆˆŽŽ‡‡ss{{sssspp––››ŠŠŽŽˆˆvv††vv``ppRRwwhhHHvveeEE{{ffFF€€hhJJ„„ssRR‰‰||WW““ƒƒ__¨¨¢¢ŒŒ¦¦­­¤¤¤¤°°¦¦¤¤°°¬¬¨¨¶¶µµªª»»ºº­­¾¾»»¨¨ººµµ¨¨ºº¶¶®®»»¹¹´´ÀÀ¾¾¶¶Â¿¿¶¶ÂÂÀÀººÆÆÄĸ¸ÄĶ¶ÁÁ¿¿¨¨³³±±‡‡––kk}}rr<>MMHH33CCCC11@@==55CC9944@@99//==88**8866**88::((9988))==::00BB@@;;NNIIFFWWQQ??LLDD33>>5522==22--<<3322CC==::IIBB99IIBB__ssii……——ŒŒ††‘‘ˆˆllvvnnQQZZPP……‰‰yy‚‚mm€€xx``zzppSSvvggIIvvddGGuuddFFxxddIIqqRRˆˆ{{TT””‡‡dd¢¢¢¢‘‘››¥¥££˜˜¥¥¡¡••¢¢¡¡““¡¡¡¡’’¢¢££¢¢ŸŸŸŸ››ŸŸœœ’’  žž——¤¤¢¢œœ©©§§  ­­¬¬¥¥±±°°ªª¶¶µµ§§²²³³§§³³³³——¥¥££uu„„€€44@@99 --==55eessiixx……||~~ŠŠ„„ŒŒˆˆ‚‚ŠŠ††ˆˆŽŽŠŠ’’šš””ŽŽ˜˜’’‹‹””ŽŽ——‘‘‰‰ŒŒzz||€€‡‡‚‚““››’’››££ššžž§§¤¤©©¡¡  ¥¥œœ‹‹‰‰jjrrooffvvrrddxxsseexxssggxxvvkk}}zzpp~~uu„„€€vvƒƒ}}||‡‡‹‹‚‚pp||rrddqqhhkkvvppss{{oouuÉÉÊÊÀÀêêììääêêììååëëîîççÄÄÌÌÃí­µµ¬¬ÃÃÆÆ¿¿ÊÊÎÎÇÇÎÎÓÓËËÌÌÑÑÉÉÈÈÒÒÇÇÉÉÕÕÉÉÉÉÕÕÉÉÊÊ××ËËÂÂÐÐÅźºËË¿¿¶¶ÆÆ»»´´Â··°°¾¾µµ±±¾¾··±±¾¾··©©¶¶±±¦¦³³¯¯¬¬»»¶¶¶¶ÄÄ¿¿ÁÁÈÈÃÃÆÆÍÍÅÅÈÈÒÒÉÉÍÍ××ÏÏÒÒÜÜÔÔ××ááØØÚÚââÚÚÜÜããÛÛÙÙÞÞØØÕÕÚÚÓÓ××ÜÜÖÖØØÞÞÙÙÛÛááÜÜÜÜââÝÝÜÜããÝÝÞÞääÞÞààææààààèèââââééããááééããááèèááààççááßßååââßßääààßßääßßÜÜââÜÜÜÜââÜÜÝÝããÞÞààææààááææààÞÞääÝÝÙÙßßØØØØÞÞ××ÞÞááÛÛææèèââëëííççééííççèèììééååêêççÞÞååÞÞÝÝååÜÜÍÍÕÕÌÌÔÔÝÝÓÓççððååààææßßààååßßééííççêêððééêêððééêêððêêêêññëëëëòòëëëëòòëëêêññêêêêòòëëëëóóììììôôííëëòòììèèîîêêààççååÒÒÛÛØØÍÍÖÖÓÓËËÔÔÑÑËËÔÔÑÑÒÒÙÙ××ÞÞååááèèïïêêëëòòííììóóïïììóóîîêêññììèèïïëëccff]]bbee]]__aa\\\\__SSZZ__KKQQaaNN„„››““¼¼ÐÐÍÍ»»ÌÌÈÈ¿¿ÏÏÎÎÀÀÐÐÐÐÃÃÓÓÔÔÄÄÓÓÒÒ††ŒŒ‚‚ttwwiiÁÁÓÓÇÇÈÈÕÕÖÖÊÊÖÖÖÖÉÉÖÖÓÓÈÈØØÕÕÑÑÜÜÜÜššžž––SSTT??))++ - - --AAAA99KKDD;;LL??@@MM::@@GG::2277//  ((""MM__YYccssrr]]mmllWWhhddUUffbbRRcc__JJ]]YYEEWWQQEESSJJ77FF;;,,==66aattrrtt‡‡††rr„„hhvvuu\\llhhPP__YYIIRRNN339966(($$(())""44??>>ssŠŠ……‹‹¢¢œœ‹‹žž››‰‰››––zz‰‰TTdd[[??OOLL>>IIGG::FF??66BB::22BB<<++==99&&8877##5544""5533''996633FF????RRIIHH\\QQCCTTII55BB9933CC>>BBUUSSHHVVUUHHYYVViixxˆˆ››’’ƒƒ””‰‰zz††~~ZZ__ZZllpp``}}||gg~~yybbxxnnTTxxggKKuueeHHppccEEppddJJuuiiII„„wwQQ‡‡gg——’’ŸŸ¡¡‘‘ŸŸŸŸžžžž‹‹˜˜˜˜ˆˆ––••‰‰––••ŠŠ——••‹‹™™——ŠŠ——••ŒŒšš˜˜““¡¡ŸŸ™™§§¦¦šš§§¨¨œœ§§¨¨§§©©‘‘žžŠŠ‹‹{{††ˆˆmmyyvvSS^^YY]]ff^^rr~~vv||ˆˆ}}ŠŠ€€ŠŠ„„€€ˆˆ„„……ˆˆˆˆ””ŽŽ‚‚ˆˆƒƒ‡‡ŒŒ’’ŽŽ‹‹’’ˆˆƒƒˆˆƒƒŽŽ••™™¡¡˜˜žž§§££ªª¡¡¦¦ªª§§¨¨ŸŸ‘‘’’nn||wwff{{ssccwwrreeyywwgg}}yyjj}}{{pp~~||xx„„€€‚‚ŒŒ……ŠŠ““ŠŠŒŒ••‹‹¡¡ªª  ÂÂÊÊÀÀËËÑÑÈÈÑÑÔÔÍÍææééââééííååëëîîææëëïïèèÝÝââÚÚ½½Ãû»ÂÂÇÇ¿¿ÊÊÍÍÅÅÑÑÔÔÌÌÑÑÔÔÌÌÆÆÍÍÃÃÁÁÊÊÀÀººÇÇ»»³³Â´´®®¿¿³³ªª½½³³¨¨¼¼³³¨¨¼¼´´¦¦ºº²²§§¹¹°°¯¯¾¾³³±±¿¿¸¸±±¾¾ºº³³ÀÀ¹¹¶¶Â¼¼¼¼Ãÿ¿¾¾Æƾ¾ÂÂÉÉÂÂÇÇÎÎÇÇÎÎÖÖÎÎÕÕÝÝÕÕØØááÙÙÚÚááÚÚÙÙßßØØØØÞÞ××ÙÙßßÙÙÚÚààÜÜÝÝããÞÞÞÞããÞÞÝÝååÝÝßßççßßááééááââêêââââêêââââëëââããëëããââêêããââééææááççääßßååààÜÜââÝÝÜÜââÝÝÝÝããßßßßääààââèèããààææßßÜÜââÛÛÛÛááÚÚààââÜÜèèêêääîîññëëííòòëëëëððððççëëîîââèèããÝÝååÛÛÒÒÚÚÑÑÜÜääÚÚëëððççèèííææååëëååèèííèèééîîèèêêððééééîîêêêêððëëëëññììêêññììêêññììëëòòííììóóïïííôôððëëòòííééððììááêêêêÐÐÜÜÛÛÉÉÖÖÔÔÈÈÕÕÐÐÉÉÕÕÑÑÐÐØØÕÕÜÜããßßççîîêêëëòòííëëòòííëëòòííééððëëééïïììbbeeYY]]aaTTVVZZLLSSXXEEQQWWBB__nn]]§§¾¾¸¸··ÌÌË˹¹ÉÉÉɸ¸ÈÈÈȺºÊÊÊʾ¾ÎÎÏÏÃÃÔÔÓÓ»»ÄĽ½ccffXX——¦¦——ÏÏßßØØÊÊÙÙÔÔÊÊÚÚ××ÎÎÛÛØØÇÇÏÏÍÍrrssjjNNQQ<<##**''$$11--,,????44AA<<55BB77??LL::CCPP@@GGPPGGAAHH@@::BB9933;;22((11))''!!NN\\XXhhzzxx^^rrpp\\mmiiYYjjffQQcc__II]]UUGGXXOOGGVVKKBBSSHHUUiiaaqq‡‡„„ttˆˆ‡‡vv‡‡††vvƒƒ„„ttllyyxxiiuuuueerrpp\\jjhhUU]]\\PPUUPPEERRKKPPggaamm‚‚zz‡‡››˜˜‹‹œœ——ŠŠ__nnnnKKWWWW??KKEE<>OOWWBB‰‰™™ŒŒ··ÌÌÉɵµÉÉÈȸ¸ÉÉÉÉ»»ÊÊÊʼ¼ÌÌËËÀÀÏÏÏÏÅÅÕÕÕÕÏÏÞÞØØ››žž““ccmm\\»»ÏÏÁÁÍÍââÛÛËËÝÝÛÛÑÑßßÚÚ³³¹¹µµYYYYOOHHLL<<''##""@@QQLL??TTOO66GGHH33==9911::0099DD44@@LL==DDOODDAAMMAA@@LLAA::II>><>$$//**66??5577AA66;;DD66@@LL==CCPPCCFFUUJJNN]]TTRRccWWWWiiaa[[nnmmggyyxxjj}}{{eewwvvggwwwwiiyyyykk||{{ww‰‰††ŽŽ††˜˜––££  ””ªª§§¤¤¡¡££¢¢‘‘££££‘‘££££¡¡¡¡ŒŒŸŸ‹‹œœŽŽ  ŸŸ’’¤¤££’’¤¤££‘‘££¢¢‘‘¢¢ŸŸ¡¡žžŒŒ¡¡‹‹ŸŸ˜˜‰‰––††™™’’„„““’’€€ŒŒ{{‡‡‰‰{{ˆˆŠŠ……““““„„’’’’yyˆˆˆˆmmjj||||ggzzzzccyyrrbbxxqqaawwppccrrooccppnneeqqpp``ooll^^oollSSddaaUUiieeqq‡‡‚‚uu‡‡zz‰‰‚‚††ƒƒˆˆ||~~mmyytt^^ttooWWqqjjQQnnddLLnnddMMnnccLLmmeeLLoohhLLˆˆ‡‡mm••ŸŸŽŽ””¡¡žž””¢¢¤¤’’££¢¢’’¡¡¡¡““¡¡¡¡””££££––££££––¤¤¤¤˜˜¦¦¦¦˜˜¤¤££šš¥¥¤¤œœ¨¨§§œœ¨¨¨¨žžªª««  ««¬¬¡¡¬¬­­¡¡ªª­­££¬¬¯¯££¬¬®®¢¢­­°°››¦¦¨¨ŒŒ——™™„„ŽŽ…………‚‚‹‹ŒŒ††}}‰‰ww††}}tt‚‚{{{{††€€††‰‰ŽŽ––ŽŽ‘‘šš‘‘••žž––™™¢¢™™¦¦œœŸŸ©©ŸŸ¢¢¬¬¢¢¤¤¯¯¥¥¢¢­­££££ªª¢¢¡¡¦¦žž““™™ˆˆŽŽƒƒ‚‚‰‰€€§§®®¥¥ããèèààüüþþøøøøúúôôúúüü÷÷ûûýýùùúúûûööööùùóóòòõõîîððôôëëïïòòêêïïóóëëòòõõííôôøøððóó÷÷ïïððõõííííóóëëííóóëëòòôôììññôôììïïóóëëððóóëëððóóëëîîññêêêêîîææããééááÚÚããÚÚÕÕßßÕÕÐÐÛÛÐÐÌÌÚÚÏÏÊÊÖÖÌÌÉÉÑÑÉÉÇÇÎÎÆÆÆÆÎÎÆÆÄÄÐÐÊÊÄÄÏÏÉÉÆÆÑÑËËÊÊÒÒÊÊÎÎÖÖÎÎÑÑÙÙÑÑÕÕÝÝÕÕÜÜääÜÜááééááââééââææëëääææììååççííççççììèèééîîêêééííêêééííééææììèèââëëææââêêããââêêááããëëããääììççååììèèääëëççääêêææææëëççææëëççããééååââèèããââèèããääêêååééííêêèèííééääêêååààââÝÝããååßßééëëååèèññééééññêêèèììëëÞÞããááÀÀÈȾ¾¿¿ÇǼ¼ååëëååëëððééééïïççêêïïèèééïïèèêêððééëëññêêëëòòííëëòòííêêññììëëòòííëëòòííëëòòííììóóîîììóóîîëëòòííëëóóîîääïïëëÛÛååââÑÑÛÛØØÌÌ××ÓÓÌÌ××ÓÓÑÑÛÛØØÚÚááßßååëëééééððííêêòòïïëëòòïïééððííççîîííUUXXGGSSWW@@PPTT>>llsshh··ÉÉÀÀÄÄ××ÒÒÁÁÑÑÏÏÂÂÓÓÏÏÂÂÔÔÐÐÅÅÕÕÒÒÉÉÖÖÔÔËËØØÖÖÏÏÞÞÚÚÎÎßßØØÚÚääâ⣣§§  TTaaUU££¹¹®®ÇÇÛÛÖÖ¹¹ËËÉÉ……””RR[[WWKKUURR,,997744DDAAMMaaZZLL``\\''6677 ++""00??44--==//22@@33@@PPDDEEWWMMLL]]WWVVhh^^YYnnhhjj}}}}‚‚””““ˆˆšš™™ŒŒžžŽŽ¢¢  ““¦¦¤¤——ªª©©šš®®¬¬žž²²°°šš¯¯­­˜˜¬¬¬¬——¬¬««””©©©©——ªª©©——©©©©••¨¨¨¨’’¤¤££¡¡  ŸŸ  žž¡¡  ¢¢¡¡¢¢¡¡‘‘¡¡¡¡‘‘££¢¢¤¤¢¢¢¢ŸŸ¡¡žžŒŒŸŸ››ŒŒ‰‰™™šš††——˜˜ŠŠššššŒŒœœœœ‹‹››››ŠŠ››››……˜˜˜˜„„––––““““||‘‘vvŒŒ‡‡pp††‚‚oo€€oopp€€€€ll}}{{hhyyvv__ppmmccttqqnn}}eeyyqqii{{ssvv‚‚xx}}‚‚ss}}}}iivvtt]]qqnnVVooiiOOjjffLLggddJJjjffLLnnjjPPyyssYY‘‘||››‘‘žž™™ŸŸ››  ––““žž˜˜““žž˜˜••  šš’’  ŸŸ““¡¡¡¡••¢¢¢¢——¢¢¢¢™™¤¤££šš¦¦¥¥››§§¦¦žž©©¨¨  ««©©¡¡¬¬««¢¢¬¬««££­­««¢¢¬¬ªª¢¢¬¬­­¤¤®®°°¡¡¬¬­­——¢¢¢¢ŽŽ™™˜˜‡‡““’’††’’ŽŽ‡‡||ˆˆ€€tt„„{{nnxxss„„||……’’ŠŠœœ’’””””¡¡——––¢¢˜˜––¢¢——››¦¦œœ££ªª¡¡§§®®¥¥©©¯¯¦¦®®³³¬¬®®´´¬¬¸¸¿¿³³ÐÐÖÖËËççëëääøøüüôôööúúóóööùùóóööùùóó÷÷ùùóóúúýýööùùûûôôööùùòòññôôììììððèèëëïïççîîññééòòööîîõõùùññôôùùññóóùùññòòøøððòò÷÷ïïóóööîîóóööîîòòôôììððóóëëððóóëëîîññééêêììååææêêââßßææÝÝÛÛââÚÚÖÖÝÝÔÔÑÑÜÜÒÒÍÍØØÎÎÎÎÖÖÎÎËËÓÓËËÊÊÓÓËËÊÊÒÒËËÊÊÓÓÌÌËËÔÔÌÌÐÐØØÐÐÒÒÚÚÒÒÔÔÜÜÔÔÙÙááÙÙÜÜääÜÜááééááããêêããææììååææììååèèííççççììèèèèííééææëëççççëëèèääêêææááêêääààèèààßßççßßààèèààããëëååææííééææììèèççììèèèèííééééïïêêééîîêêææììèèååêêææççììèèééîîêêêêððììççììèèááææààààååÞÞååééããééññììëëòòîîííòòîîØØÛÛ×׺º¾¾¶¶ÝÝááØØîîòòîîííóóîîííóóííííóóííììòòëëììòòëëííóóììììóóîîííôôððììóóîîììóóîîëëòòííëëòòííëëòòííêêññììêêññììêêòòííååððììÝÝççääÔÔÞÞÛÛÏÏÙÙÖÖÎÎÙÙÕÕÑÑÛÛ××ÙÙààÞÞääêêèèççîîììééððííééððííééïïììççîîííSSXXMMMMWWGGoo||qq³³ÄÄÀÀÀÀ××ÓÓÂÂ××ÕÕÄÄÔÔÒÒÄÄÕÕÒÒÅÅÖÖÓÓÈÈØØÕÕÍÍÛÛÙÙÎÎÜÜÛÛÑÑßßÛÛÐÐßß××ÎÎÙÙÚÚ»»ÂÂÀÀddllcc``rraa““¥¥ŸŸˆˆœœœœyyŽŽŠŠZZiieeNN\\TTDDUUJJGGZZOOOOeeYYRRffbbKKZZ[[!!--((!!..&&%%33((##11''00AA88;;OOGGEEXXUUUUjjcc__vvqq{{ŸŸžž’’¤¤££££¢¢¥¥££’’§§¥¥¦¦££§§¦¦““««©©““©©¨¨““¨¨©©‘‘¥¥§§¥¥§§££¤¤‘‘££££££££¢¢¡¡ŒŒžžœœˆˆšš™™‰‰››šš‹‹œœ  žžŽŽ  ŸŸŸŸŸŸŸŸŸŸ‰‰žžžžŒŒŸŸžžŸŸžžŠŠœœ››ˆˆšššš……————……––––‡‡™™˜˜‹‹œœ‹‹œœŒŒžž‰‰››››ŸŸŸŸ‹‹‡‡››††œœššƒƒ™™——„„——––……————ˆˆšššš‰‰››™™……––’’ƒƒ””ƒƒ““ggvvssSShh____uukkoo||ppww~~llyyzzddvvvv__rrppXXnnkkQQoohhNNkkddKKooggOOppllSS||yyaaŠŠ••’’ŠŠ••™™‰‰——˜˜‰‰››““‹‹››˜˜‹‹œœ˜˜ŒŒššžž‘‘ŸŸŸŸ’’    ••¡¡  ˜˜££¢¢šš¦¦¥¥››§§¥¥žžªª¦¦ŸŸ««§§¡¡­­©©££­­ªª££®®ªª££­­ªª¦¦®®­­¥¥¬¬¬¬¦¦®®­­¤¤¯¯®®©©¨¨––¢¢¡¡ŽŽ››——ˆˆ””……uuƒƒzztt€€zz€€ŠŠ„„™™¡¡››¥¥  §§  ¯¯¶¶¯¯¿¿Â»»ÊÊÍÍÅÅÓÓÖÖÎÎÛÛßß××ààååÝÝââççßßççììååïïôôììôôûûîîøøýýòò÷÷úúòò÷÷úúóó÷÷úúóóøøûûõõ÷÷úúôô÷÷ùùóóøøûûòòõõùùïïòòööììîîòòêêêêííååêêííååîîññééòòööîî÷÷ûûóóööúúòòõõûûóóõõûûóóõõûûóóõõùùññôôøøððôôøøððóó÷÷ïïóóööîîòòõõííññòòëëííîîççææêêââââææßßÞÞããÛÛÛÛääÚÚØØááØØÕÕÝÝÕÕÓÓÛÛÓÓÓÓÚÚÒÒÒÒØØÐÐÒÒÙÙÑÑÕÕÛÛÓÓÔÔÜÜÔÔÖÖÞÞÖÖ××ßß××ÛÛããÛÛÝÝååÝÝááééááããêêââææììååææëëääèèííççççììèèææììèèååêêææååêêååââééääßßééããààèèááààççààááééááââêêääææììééèèîîêêééïïêêëëññììììóóííííóóïïììòòííëëððììëëððììëëññììììòòííëëððëëååììååààèèààååëëääééòòïïííõõòòééïïèèÎÎÑÑËËÐÐÓÓËËììïïææððóóïïññööòòððõõññððõõññîîôôííïïõõîîððõõîîïïööññîîõõññîîõõððííôôïïììóóîîêêññììééððëëééððëëééððëëèèððììããîîêêÜÜææããÔÔßßÛÛÐÐÚÚ××ÏÏÙÙÕÕÐÐÚÚ××××ÞÞÜÜááééææææììêêççîîììèèîîììèèïïììççððííRR[[NNKK[[TT}}••““¦¦¾¾¿¿££ºº»»££¸¸ºº¦¦··¸¸¥¥µµµµ««»»»»±±ÂÂÁÁ³³ÅÅÃò²ÄÄÃî®ÁÁ¾¾££ºº¶¶™™¯¯°°¦¦¢¢xxŽŽ……VV__PPyy‡‡ƒƒ††˜˜™™{{““ff{{zzWWff``VVee[[UUccYYPPccYYVVppllhh{{}}MMUUSS""""**""))55--44CC@@44GG??44EE??GG[[WW\\uunnvvŽŽŠŠ‚‚————ƒƒ˜˜——……™™˜˜‡‡™™˜˜‰‰››šš‹‹žžŠŠ  žžŒŒ££  ¤¤¡¡¢¢¢¢ŽŽ¡¡¡¡    ŽŽ    ŽŽ        ŒŒžžžžŠŠœœ››ˆˆšš™™‡‡™™˜˜……˜˜——ˆˆšš™™ŠŠœœ››ŠŠšš‹‹ŠŠ››ŸŸ‹‹››žž‰‰™™››ˆˆ™™››‡‡••——……‘‘““……’’””‡‡––——‡‡——˜˜ˆˆ™™™™ŠŠšš››ŠŠšš››‰‰™™ššŠŠ››››ˆˆ››ššˆˆ››šš……˜˜——‡‡˜˜——‡‡˜˜˜˜ˆˆ™™››‰‰˜˜™™ŠŠ˜˜˜˜‰‰˜˜——ŠŠ˜˜˜˜iiwwttNNbbXXccyyqqrrwwvv~~mmvvwwbbvvuu]]qqmmWWmmhhQQkkddPPjjbbOOmmffRRrrkkWW}}zzii……ŠŠ€€††„„ŽŽ„„ŽŽŒŒ„„‰‰††––‰‰˜˜••ŒŒ››ššššŸŸœœ‘‘¢¢ŸŸ––££¡¡™™¥¥¤¤››¨¨§§ŸŸªª¨¨¡¡««ªª¡¡¬¬««¢¢­­ªª££®®ªª££®®­­¤¤­­¯¯¥¥¯¯®®¥¥¯¯®®¥¥¯¯­­££¯¯®®££¯¯¬¬  ¬¬§§œœ©©¢¢™™££žž˜˜ŸŸ››££žž¥¥««¤¤¯¯µµ¯¯¼¼ÁÁººÏÏÐÐËËááããÞÞîîððêêúúûûôôÿÿÿÿúúÿÿÿÿúúüüÿÿùùùùÿÿ÷÷÷÷ýýõõøøüüôô÷÷ûûóóôôøøððööúúòòúúüüööùùûûõõùùüüöö÷÷ýýööööüüõõööûûôôõõùùññòòööííïïóóêêêêîîææèèëëããêêííææííññééòòõõííõõùùññööúúòò÷÷úúòòùùüüôôùùüüôôööúúòòõõùùññõõùùññööúúòòööúúòòôôøøððòòõõííïïòòêêëëïïççèèììääääêêââââêêááÞÞèèßßÜÜääÜÜÚÚââÚÚØØààØØ××ßßÖÖ××ßßÕÕÙÙááØØØØàà××××ßßÕÕØØàà××ÛÛããÚÚÞÞææÞÞááééááââééââææììååççììååççììææèèííééççììèèääêêææããêêååââèèããââééääááèèããááèèããââééääääëëççææììèèêêððììëëòòííííôôïïîîõõððïïõõññððööññïïôôððììòòííììòòëëììòòëëëëññêêèèííææááååßßååééããëëññììëëóóííÚÚââÚÚÑÑØØÎÎÜÜàà××ëëííææóóóóððõõôôóóóóõõòòññööòòððøøððîîööîîîîööîîððööññîîõõññììóóïïììóóîîêêòòììééððëëééððêêèèïïèèèèîîëëææííëëààëëççÝÝççääÕÕààÜÜÑÑÛÛØØÏÏÙÙÕÕÐÐÚÚ××ÓÓÞÞÚÚÛÛååââââììééååïïììääîîëëããííêêååïïììMMaaYYQQhhddbb}}pp‰‰‡‡oo……ƒƒww‰‰‰‰€€‚‚’’’’ŠŠ™™šš‘‘¡¡¡¡••¨¨¦¦™™¬¬««››®®­­®®²²®®¶¶žž¯¯²²¡¡³³®®~~ˆˆddnnmmŽŽžž˜˜®®««œœ°°®®œœªªªª——¤¤¤¤™™ššƒƒ’’‚‚™™””••¦¦¦¦ŠŠ‘‘WWYYPP77<<2222;;00CCPPEELLYYTTAAOOFF11??//33CC66UUjjddff{{yyqq„„‚‚tt‡‡……ww‹‹‰‰xx}}““‘‘˜˜••……™™——ˆˆœœšš‰‰››‰‰œœœœŠŠœœœœŠŠ‹‹žžžžŒŒŸŸŸŸ‹‹ŠŠ››››ŠŠššššˆˆ˜˜˜˜††––––‡‡————ˆˆ˜˜˜˜ˆˆ˜˜˜˜‹‹››ššŠŠ››ššŠŠšš™™ˆˆ››œœ‡‡ššœœ……˜˜ššƒƒ––••““‘‘……——––‹‹››šš’’    ’’    žžžžŽŽœœœœŒŒšššš‹‹šš——ŠŠ™™——‹‹šš˜˜ŒŒšš••žž››ŽŽ››››††––——……––˜˜ƒƒ••——““””jj}}uuPPddWWccvvmmoo{{rroowwjjssvveexx||ee‡‡ˆˆrryy’’ƒƒ””’’‰‰ŠŠˆˆ––””‡‡´´µµ§§¾¾Äĺº¼¼Ãþ¾¼¼¾¾»»¹¹»»¶¶®®²²««šš§§‘‘••‘‘œœ——••žž››šš££  §§¤¤ŸŸ©©¦¦¡¡¬¬©©¤¤¯¯««¥¥°°¬¬¥¥¯¯¬¬¦¦°°­­¦¦°°¬¬¦¦°°««§§°°®®§§°°°°§§±±°°§§±±°°§§±±±±§§°°®®§§°°¬¬¨¨²²ªª§§±±ªª««´´®®µµººµµ½½Â¼¼ÅÅËËÄÄÕÕÛÛÔÔççììææóó÷÷ññööùùóóõõùùòòøøûûóóúúýýõõûûþþööùùýýõõööüüôôõõûûóóööúúòòõõùùññõõùùññööúúóóøøúúõõ÷÷ùùóóõõùùóóóóùùòòòòøøññòò÷÷ððòòõõííîîòòêêëëïïççééììääééëëããëëîîççîîòòêêòòõõííóó÷÷ïïôôøøððõõùùññ÷÷ûûóóøøûûóóööúúòòõõùùññõõùùññ÷÷úúòòùùüüôô÷÷ûûóóööùùññòòõõííïïòòêêëëïïèèèèííææååííääããííããããêêããààèèààÝÝååÝÝÛÛããÚÚÛÛããÚÚÚÚââÙÙØØáá××ØØàà××ÙÙááØØÛÛããÛÛÝÝååÝÝááééááããêêââååëëääççììååççììææççììèèççììèèååëëççääëëççããêêææããééååââééääââééääááèèããääëëççèèîîêêëëòòííììóóïïîîõõññððööòòññøøóóòòøøóóññööòòîîôôïïììòòëëëëññééëëññêêææííææààççààááèèààææììççÜÜääÝÝÕÕÝÝÕÕÚÚããØØÜÜääÚÚééììææóóôôððóóôôòòððõõññîîõõññîîööîîííööííííõõííííõõððííôôïïëëòòííêêññììèèïïêêèèîîêêççííèèççîîççççííêêææííëëááëëèèÞÞèèååÖÖááÝÝÓÓÝÝÚÚÐÐÚÚ××ÑÑÛÛØØÑÑÛÛØØØØããßßààêêççââììééááëëèèââììééääîîëë‹‹ŸŸŸŸ™™­­®®ŸŸµµ··¤¤ºº¸¸¤¤··µµ§§··¶¶­­¼¼¼¼®®¿¿¿¿°°ÀÀÀÀ±±ÂÂÁÁ³³ÆÆÅŶ¶ÉÉÈȸ¸ÉÉÇǺºÇÇÇÇ»»ÇÇÌ̺ºÆÆÅŹ¹ÅÅÁÁ²²½½½½kkrruuhhssuu§§¹¹¸¸´´ÅÅÄĺºÇÇÈȹ¹ÆÆÈÈ··ÄÄÆÆ··ÄÄÁÁ´´Äľ¾²²ÃÃÁÁººÄľ¾··ÀÀ»»­­¹¹³³  ®®¨¨››©©¥¥’’œœŸŸ‹‹’’““‰‰€€ŠŠ‡‡~~ŠŠ““††——””‡‡˜˜••ˆˆ™™——‰‰˜˜˜˜‰‰˜˜˜˜‰‰˜˜˜˜‰‰››šš‹‹œœ‹‹œœœœ‰‰››››ˆˆšššš‡‡™™™™‰‰››››ŠŠœœœœˆˆ››››‹‹œœœœŒŒšššš‹‹™™™™‹‹™™™™žžžž™™§§§§¡¡¯¯¯¯¤¤²²¯¯¨¨¶¶°°ªª¸¸²²««¹¹³³¦¦´´®®  ¬¬©©——¢¢¡¡¤¤¯¯®®°°»»ºº¸¸Ãü¼ÈÈÇǸ¸ÄÄÃ÷·ÂÂÁÁ³³¿¿¾¾­­¸¸··¦¦±±®®  ««§§ŸŸªª¦¦££­­¤¤¨¨°°ªª¦¦®®««  ªª¨¨  ¬¬©©¡¡¬¬©©©©§§’’ŸŸ——‰‰““ˆˆ––——¢¢««¡¡««³³©©´´ºº¯¯ÂÂÈȼ¼ÕÕÙÙÍÍààááÖÖßßääÙÙÞÞååÚÚÙÙßßÕÕÛÛààÕÕááææÝÝääêêââççííååééîîææèèííââååììßßßßææÙÙÓÓÚÚÏÏÀÀÇÇ¿¿¹¹ºº··²²²²°°°°°°®®®®³³¯¯««³³®®ªª²²­­©©²²­­©©´´®®ªª´´¯¯ªªµµ®®©©µµ¬¬©©´´¯¯©©´´±±©©´´³³©©´´³³©©´´³³««²²®®¬¬³³­­±±··¯¯¶¶¾¾µµÃÃÉÉÁÁÓÓÕÕÎÎßßããÜÜììòòëëóóøøññññøøððððøøððïï÷÷ïïññøøððôôúúòòôôúúòòôôúúòòööüüôôõõûûóóòòøøððôôùùññôô÷÷ïïóó÷÷îîóóööððóóõõððòòôôîîððóóííííóóììííóóììííòòëëîîòòêêêêîîææççêêââèèëëããèèëëããëëïïççððóóëëòòõõííóóööîîóóööîîôô÷÷ïïõõùùññööúúòòööúúòòööúúòòõõùùññööúúòòøøüüôôøøûûóóõõùùññôô÷÷ïïððóóëëííññééééïïççææîîååååïïååååììååââêêââààèèßßÞÞææÜÜÛÛããÚÚÛÛããÚÚÚÚââÙÙÙÙááØØÚÚââÙÙÛÛããÛÛÜÜååÝÝááééááããêêââååëëääççììååççììææèèííééèèííééååëëççææììèèååììèèååììèèääëëççããêêååââééääââééääææííééêêññììììóóïïììóóïïîîõõññïïõõññððõõññîîôôððììòòííëëññêêêêððééêêððééääííååÛÛååÜÜ××ââØØÕÕÝÝ××××ÞÞØØããêêââßßééÞÞÛÛååÚÚääêêããííòòííððõõññîîõõññììõõððííõõííííõõííííõõííììôôîîëëòòííééððëëééïïëëççííééååììèèååììææååííææææììééååííëëããííêêßßééææØØââßßÓÓÝÝÚÚÏÏÙÙÖÖÎÎÙÙÕÕÐÐÚÚ××ÖÖààÝÝÜÜææããßßééææààééææââëëèèããííëë°°ÅÅÄı±ÅÅÄı±ÆÆÅÅ´´ÆÆÃõµÆÆÃõµÇÇÃ÷·ÈÈÅŹ¹ÊÊÇǺºËËÉÉ»»ÌÌÉɼ¼ÍÍÊʽ½ÏÏÌ̾¾ÎÎËËÀÀÍÍÊÊ¿¿ËËÊÊ¿¿ÌÌÉɼ¼ËËÇÇÀÀËËÉÉ¥¥©©§§bblldd——§§  ¿¿ÏÏÏϾ¾ÌÌÍÍ¿¿ÍÍÍÍ¿¿ÌÌÍÍ¿¿ÌÌÊÊ¿¿ÍÍÈȼ¼ËËÆƽ½ËËÆƾ¾ÌÌÊʾ¾ÍÍËË¿¿ÎÎÌÌÃÃÐÐÏÏÇÇÓÓÑÑËËÕÕÑÑÌÌÔÔÔÔÊÊÓÓÔÔÇÇÒÒÑÑÅÅÒÒÏÏÅÅÓÓÏÏÅÅÓÓÏÏÄÄÑÑÎÎÂÂÎÎÍÍÁÁÍÍÌ̾¾ËËÉÉ»»ÈÈÇǹ¹ÄÄÄÄ··ÀÀÀÀ¶¶¾¾ÁÁ²²½½½½¬¬¹¹¶¶¨¨··³³¥¥´´°°  ¯¯««žž¬¬ªªŸŸ­­««žž««©©˜˜¦¦¤¤œœªªªª§§µµµµ³³ÁÁÁÁ¹¹ÆÆÅż¼ÊÊÅŽ½ËËÃÃÁÁÍÍÅÅÁÁÍÍÅŽ½Êʵµ½½¸¸±±··µµÂÂËËÊÊÆÆÐÐÎÎÅÅÏÏÌÌÇÇÑÑÎÎÇÇÒÒÏÏÉÉÓÓÒÒËËÕÕÔÔÈÈÒÒÑÑÇÇÎÎÊÊÁÁÈÈÄÄ¿¿ÇÇÂÂÁÁÈÈÂÂÈÈÎÎÉÉÊÊÑÑÌÌÉÉÑÑÍÍÉÉÒÒÎÎËËÔÔÑÑÍÍÕÕÒÒÏÏÕÕÐÐÒÒØØÐÐÕÕÛÛÓÓ××ÝÝÖÖÛÛááÚÚÞÞããÜÜÝÝååÚÚÞÞååÛÛààååÛÛÜÜææÛÛÛÛããÙÙÝÝääÛÛÝÝããÚÚßßååÝÝããééááååëëââææììääääëëââääëëááååììààççîîããèèîîääèèêêääââããÞÞÜÜÝÝØØ××ÜÜÖÖÒÒÚÚÓÓÏÏÖÖÏÏÊÊÔÔÌÌÈÈÑÑÉÉÅÅÌÌÅÅÄÄÉÉÃÃÂÂÉÉÂÂÂÂÊÊÁÁÂÂËËÁÁ¾¾ÆÆ¿¿¿¿ÆÆ¿¿ÆÆÍÍÇÇÏÏÓÓÌÌÔÔØØÐÐÞÞááÚÚééììääððôôììóóööîîóó÷÷ððóóùùóóóóùùòòòòøøññððööïïïïõõîîññööïïòò÷÷ïïññ÷÷ïïññ÷÷ïïóó÷÷ïïóóööîîòòõõííòòõõííòòõõííòòõõííòòôôííòòóóîîððòòììïïóóììííóóììííóóììëëññêêëëïïèèééììååççêêââååééááççëëããééïïççììóóêêííóóëëííòòêêîîóóëëòòõõííôô÷÷ïïôôøøððòòööîîóóööîîôô÷÷ïïôôøøððööùùññõõùùññóóööîîññôôììîîññééëëððèèééîîççççííääççîîææææîîææããëëããááééááÞÞææÜÜÜÜääÛÛÝÝååÜÜÚÚââÚÚÛÛããÚÚÜÜääÛÛÝÝääÜÜààææßßããèèááååééããççííææèèííççèèííççèèííééèèííééççììèèååììèèååììèèååììèèääììèèääëëççââééääããêêääææííææêêòòêêììóóííëëòòííííôôññïïööññññùùññïï÷÷ððììôôììëëññêêèèííææééîîèèããííääØØææÜÜÏÏÙÙÐÐÎÎÒÒÍÍââèèááèèññééââííããÜÜææÜÜääêêââððóóííïïôôññëëõõððììôôïïììóóííëëòòííêêññììééððëëééïïëëççííééççííééææííééããêêææääëëååååììååããììèèââííêêááëëêêÞÞèèää××ááÜÜÐÐÚÚÙÙÍÍÖÖØØÌÌ××ÓÓÏÏÙÙÓÓÔÔßßÙÙÚÚååààÝÝèèââßßééããßßééääââììèè··ÊÊÈÈ··ËËÉÉ··ËËÉɹ¹ËËÈÈ»»ÌÌÉɽ½ÎÎÊʽ½ÎÎË˾¾ÏÏÌÌ¿¿ÐÐÍÍÁÁÒÒÏÏÂÂÓÓÐÐÄÄÕÕÒÒÄÄÕÕÑÑÇÇÕÕÓÓÇÇÔÔÒÒÇÇÖÖÓÓÈÈ××ÑÑËËØØÏÏÏÏØØÎÎÄÄÏÏÅÅÂÂÏÏÉÉÈÈ××ÕÕÈÈ××ÖÖÊÊØØÖÖÊÊ××ÖÖÈÈÖÖÓÓÉÉÖÖÒÒÊÊØØÓÓËËÙÙÔÔÊÊØØÖÖÈÈÖÖÓÓÈÈÖÖÓÓÉÉ××ÔÔËËÙÙÔÔÎÎÙÙÓÓÏÏÙÙÕÕÏÏÙÙÖÖÐÐÙÙ××ÎÎÚÚÖÖÎÎÛÛÖÖÎÎÚÚÖÖÏÏÛÛ××ÐÐÝÝÙÙÑÑÞÞÚÚÐÐÝÝÙÙÒÒÝÝÛÛÎÎÜÜØØÈÈÛÛÖÖÈÈÜÜØØËËÛÛ××ÍÍØØÓÓÈÈÔÔÎÎÆÆÓÓÍÍÄÄÑÑËËÄÄÑÑÌÌÃÃÐÐÍ;¾ËËÇDz²¿¿¼¼¯¯»»ºº²²¾¾½½¶¶Ãû»ÆÆÅž¾ÊÊÆƾ¾ÉÉÃÃÂÂÌÌÇÇÂÂËËÆÆ¿¿ÉÉÄÄ··¾¾¹¹¼¼Â¾¾ÌÌ××ÕÕÍÍØØÖÖÎÎØØÔÔÏÏÙÙÕÕÏÏÙÙÖÖÎÎØØ××ÐÐÚÚÙÙÌÌÖÖÕÕÉÉÐÐËËÇÇÎÎÉÉÈÈÏÏÊÊÌÌÒÒÎÎÐÐ××ÒÒÑÑ××ÒÒÍÍÖÖÒÒÌÌ××ÔÔÏÏÚÚÖÖÑÑÚÚÖÖÓÓÚÚÔÔÕÕÝÝÕÕÕÕÝÝÔÔÕÕÝÝÕÕÖÖßß××ÙÙááÙÙÙÙââÙÙÛÛääÛÛÜÜååÜÜÛÛææÜÜÜÜääÛÛÞÞããÛÛßßääÜÜààææÞÞââèèààååêêââååëëããååëëããææììääææëëääææììääææììääééììææëëííèèëëííççççîîææææîîææååííååääííååããììããááççààââååààääååááææççááççééÞÞêêììààîîððääòòôôééôôóóííööôôîîööõõïïôôööîîóó÷÷ïïóó÷÷ïïòò÷÷ïïòòøøññòò÷÷ññððõõîîííóóììííóóììîîóóììïïôôììïïôôììïïôôììññôôììññôôììññôôììññôôììññôôììññôôììòòôôííññóóííïïññëëïïòòììììòòëëììóóììêêððééêêííååèèëëããççêêââççêêââèèììääèèïïççêêññééëëññééêêññééëëððééííññééïïòòêêîîòòêêííññééïïòòêêïïóóëëððóóëëòòõõííññôôììïïóóëëííññééëëîîææééííææççììååææëëããääëëããããëëããààèèààááééááààèèßßÞÞææÝÝÞÞææÝÝÝÝååÜÜÝÝååÜÜÞÞææÝÝààççßßããééââææééããèèëëääèèííççééîîèèééîîèèèèííééèèííééèèííééææííééææììèèææííééççííééääëëççããêêææääììååææîîææééññééëëóóììììóóîîííôôððîîõõððððøøïïððøøððííõõííììòòëëèèííççèèííççääííååØØååÛÛÃÃÉÉÂÂÕÕ××ÒÒëëññêêêêóóëëßßëëááÛÛääÛÛããééááïïññëëïïóóïïééóóííììóóîîëëòòííééððëëééïïëëèèîîêêççííééääëëççååììèèääëëççããêêææääêêääããêêããááëëççààììééááëëêêÞÞèèääØØââÜÜÏÏÙÙØØÊÊÓÓ××ÊÊÔÔÐÐÍÍ××ÐÐÒÒÜÜÖÖØØââÝÝÜÜææààÞÞééââÞÞèèââââììèèÆÆÖÖÖÖÆÆÖÖÖÖÇÇ××××ÆÆ××ÔÔÇÇØØÔÔÈÈÙÙÕÕÇÇÙÙÕÕÇÇØØÕÕÈÈÙÙÖÖÊÊÛÛØØÌÌÝÝÚÚÍÍßßÛÛÍÍÝÝÚÚÎÎÛÛÙÙÐÐÞÞÛÛÑÑßßÝÝÐÐÝÝÝÝÒÒààÝÝÑÑááÛÛ××ááÞÞ××ààÝÝÓÓßßÛÛÓÓááÜÜÔÔââÝÝÔÔââÞÞÓÓààÜÜÔÔââÝÝÕÕããßßØØååááØØææääØØææääÚÚèèææÚÚèèææÛÛèèääÝÝèèââßßééããààêêääààêêååááëëççááììèèààììèèààëëççààììææááììææßßêêääÝÝêêããÜÜééââÙÙèèáá××ææáá××ääßßÕÕââÚÚÔÔáá××ÕÕââÙÙ××ããÚÚ××ããÜÜÕÕááÛÛÕÕààÚÚÏÏÚÚÕÕÅÅÑÑÍÍÃÃÏÏÌÌÉÉÔÔÑÑÍÍÖÖÖÖÍÍÖÖÔÔÌÌÔÔÏÏÌÌÓÓÎÎÊÊÏÏËËÅÅËËÇǸ¸¾¾ººÃÃÊÊÆÆÑÑÜÜÛÛÏÏÚÚÙÙÑÑÛÛÙÙÓÓÝÝÚÚÓÓÝÝÚÚÒÒÜÜÜÜÒÒÜÜÜÜÏÏÙÙØØÌÌÓÓÏÏÊÊÑÑÌÌËËÒÒÎÎÐÐ××ÒÒÑÑØØÓÓÒÒÙÙÔÔÐÐÚÚÖÖÏÏÚÚ××ÑÑÛÛÙÙÒÒÛÛØØÔÔÛÛÖÖÖÖÞÞÕÕ××ààÖÖÕÕââÙÙ××ããÚÚØØääÛÛÙÙååÜÜÚÚææÝÝÛÛèèÞÞÙÙååÛÛÚÚââÙÙÛÛááÙÙÞÞââÚÚááææÞÞããééááååëëããååëëããææëëããèèííååèèííççèèííççèèííççèèîîççêêððééééïïèèççîîççææííææããëëããââììääããììääååëëääååééããççêêääééííååëëïïååîîòòèèîîóóééîîòòééïïôôììîîóóëëîîòòêêîîôôììïïööííññøøïïððõõîîððõõîîííóóììííóóììììòòëëììòòëëììòòëëëëññééêêððèèëëññééííññééïïòòêêððóóëëððóóëëððóóëëññôôëëññóóììððòòììîîññëëîîññëëììòòëëëëññêêééïïèèêêííååèèëëããééììääêêííååêêïïççêêññééêêññèèêêððèèééïïççêêîîççëëîîççëëîîççëëïïççëëððèèììððèèììððèèììððèèîîòòêêîîòòêêììððèèëëïïççêêííææééííååææììääååêêââããêêââááééááááééááááééááââêêááááééßßááééßßááééààààèèßßááééààââêêââååëëããêêììææêêííççèèîîèèêêððééééîîèèèèííééèèííééèèííééççííééèèîîêêççííééééïïëëççííééååììèèææííççççïïççééññééëëòòììììóóîîííôôððîîööññîîööîîððøøððîîööîîííóóììëëððêêèèííççååëëääÄÄÍÍÅų³··°°ßßááÛÛééîîççèèññééÞÞêêààÛÛääÛÛääêêááííïïééííññííèèòòììêêññììééððëëèèîîêêææììèèææììééääëëççããêêååââééääããêêååããêêååããééããããêêââààêêååààëëèèààêêééÞÞééääÙÙããÝÝÑÑÛÛÚÚÌÌÕÕØØÊÊÔÔÏÏÊÊÕÕÎÎÏÏÚÚÔÔÕÕßßÚÚÛÛååßßÜÜèèááÜÜççááââììççÉÉÙÙÙÙÊÊÚÚÚÚÊÊÚÚÚÚËËÛÛÙÙÍÍÜÜÚÚÌÌÛÛÙÙËËÛÛÖÖÍÍÝÝÖÖÏÏßßÙÙÐÐààÚÚÑÑààÜÜÓÓââÝÝÒÒááÝÝÒÒààÞÞÔÔââßßÕÕããáá××ääää××ååããÖÖååããÙÙååââÚÚææââÙÙççáá××ååààØØååááØØææááØØææááÚÚèèããÛÛèèããÛÛèèääÜÜêêååÝÝëëççßßììééßßììççààììææããììççââëëææââììææââììççääîîêêääïïììääîîëëääîîëëããííééããííééââììèèààììææââììääááêêââââêêããààééââÝÝééààÞÞèèááààééââààééââááêêääààèèããÞÞææááÛÛããÞÞÕÕÞÞ××ÓÓÜÜÕÕ××ààÚÚÝÝääßßààççââààææââÝÝããÞÞ××ÝÝØØÎÎÔÔÐо¾Äľ¾ÎÎÖÖÏÏÙÙââÜÜ××ààÚÚÕÕÝÝ××ÕÕÞÞØØÕÕÞÞØØÕÕÞÞÙÙÓÓÜÜ××ÏÏ××ÒÒÌÌÓÓÏÏËËÒÒÍÍÍÍÔÔÏÏÒÒÙÙÔÔÓÓÚÚÕÕÕÕÜÜ××ÕÕÜÜØØÕÕÝÝÙÙÖÖÞÞÚÚÖÖÞÞÚÚÖÖÝÝØØØØààÙÙÙÙááÚÚ××ááÚÚÚÚããÜÜÛÛääÞÞÛÛååßßÛÛääßßÚÚääÞÞÙÙããÚÚÙÙááÙÙÙÙááÙÙÜÜââÚÚÞÞååÝÝááèèààããêêââããééââææëëääççííææééîîèèééîîééééîîèèèèððèèèèññèèééññééååïïççääïïççääïïççääîîææææííææééííççêêííèèêêïïççììññééííóóêêììóóëëëëòòëëëëòòêêèèòòççççððççééòòééììôôììììôôììììôôììëëóóëëëëòòëëêêññêêééððèèééïïèèêêððééëëððééëëïïèèëëîîèèììïïééììññééííòòêêïïôôììîîóóëëííòòêêîîóóëëîîòòëëííòòëëííòòêêííòòêêííññêêììññééëëïïèèééììääêêííååêêííååëëïïççììððèèììññééëëððèèêêîîççêêííææëëîîççëëîîççëëîîççëëîîççììððèèîîòòêêîîòòêêîîòòêêîîòòêêïïóóëëîîòòêêííññééîîññééêêïïççççììääååëëããääêêââââëëããááééááááééááââêêââááééááââêêââááééááââêêááããëëããããëëããååììååèèííççééððééééððééêêññééèèïïééèèîîêêèèííééèèííééèèîîêêææííééççîîêêèèïïêêèèîîêêççííééææííççææííååèèððèèêêññëëëëòòîîììóóîîììóóîîîîööîîïï÷÷ïïîîööîîííôôííëëòòëëèèïïèèÔÔÚÚÓÓ¼¼Â»»ÐÐÒÒÌÌßßããÝÝääììääååííååÜÜææÝÝØØããÙÙááêêááèèððèèççððééææòòééççññééèèïïééççîîééææííêêääííççããììææââëëääááêêææááêêææááêêææááêêææááêêååááëëççßßêêççßßééççßßééååÙÙääààÒÒÝÝÛÛËËÖÖÖÖÈÈÓÓÑÑÉÉÓÓÎÎÍÍ××ÑÑÔÔÞÞØØÙÙããßßÜÜççããÝÝèèããááëëççÊÊÚÚÚÚÊÊÚÚÚÚÉÉÙÙÙÙËËÚÚÚÚÌÌÛÛÛÛËËÙÙÚÚËËÚÚÖÖÎÎÜÜÕÕÐÐÞÞ××ÑÑßßÙÙÓÓááÜÜÔÔááÜÜÔÔââÝÝÔÔââààÕÕããááØØååããÙÙææááÛÛééããÚÚèèããÚÚèèããÛÛééääÚÚèèããÚÚèèããÛÛééääÜÜêêååÜÜêêååÝÝêêååÞÞêêææßßëëççÝÝêêååßßëëææßßëëççààííååààëëääããëëææããììççââììççââììææââììèèááëëèèááëëèèááëëèèââììééááëëèèààêêççßßééääÞÞêêááÞÞêêßßßßêêááßßëëááààëëââááééããããééååââèèääââèèääããêêååââèèääÞÞååààÙÙááÙÙÖÖÞÞÕÕØØààØØÝÝååÛÛááééááááèèããááççââÜÜááÝÝÔÔÚÚÕÕÉÉÑÑÊÊÖÖßßÖÖÞÞææÝÝÝÝååÝÝÛÛããÛÛÜÜããÛÛÛÛããÛÛÚÚââÙÙÙÙààØØÓÓÛÛÓÓÐÐÖÖÒÒÏÏÖÖÑÑÒÒÙÙÔÔÖÖÝÝÙÙÙÙààÛÛÙÙààÜÜÚÚááÜÜÚÚááÜÜÙÙààÛÛÚÚááÜÜÚÚááÝÝÛÛââÞÞÛÛááÝÝÛÛááÝÝÜÜããßßÝÝääààÞÞääááÜÜããßßÛÛââÝÝÚÚââÚÚÙÙááÙÙÙÙââÚÚÚÚââÚÚÝÝææÞÞààèèààââêêââããééââääêêããèèííççççììååèèííææèèííççççîîççççïïççèèððèèèèïïççêêððééêêññééêêññééêêññêêììððêêîîññêêííññééîîòòêêîîòòêêííòòêêììòòêêééïïççèèððääææîîååèèððééêêòòëëëëóóëëêêòòêêééññééççïïççååííååççîîææèèííççééîîèèêêïïééëëííèèììííèèëëííèèêêïïèèëëññééììòòêêììòòêêííóóëëïïôôììííóóëëîîôôììììóóëëììòòêêïïòòêêììððèèëëïïççééììääêêííååëëîîææììððèèîîòòêêííññééëëîîççëëîîççëëîîççëëîîççëëîîççëëîîççëëîîççííññééïïòòêêððóóëëîîòòêêîîòòêêððôôììððóóëëññóóëëññôôììììññééééïïççèèííååååììääããëëããããëëããááééááááééááââêêââââêêââááééááââêêââääììääååííååççïïççééññééêêòòêêêêòòêêêêòòêêééññêêééððëëèèïïêêééïïëëèèïïêêææììèèççííééééððëëééïïëëèèííêêææííææååííååççïïççèèïïééééððëëêêññííëëóóííîîööîîîîööîîîîööîîììôôììììôôììÚÚââÚÚ¾¾Æƾ¾ÍÍÓÓÌÌÞÞááÛÛÚÚááÚÚááééááââêêââÛÛããÛÛ××ààØØààééááççððççççððççççððææèèññççèèððèèççîîééççííëëääííììããììììââììììááëëééßßééææßßééææààêêççààëëèèááëëèèááêêççààêêççßßééææÚÚääááÓÓÞÞÝÝËË××ÕÕÈÈÓÓÓÓÊÊÔÔÑÑÍÍØØÒÒÔÔÞÞÙÙÙÙääààÝÝççääÞÞèèääááëëééÆÆÖÖÖÖÈÈ××××ÇÇÖÖÖÖÆÆ××ØØÇÇØØÙÙÅÅÖÖ××ÆÆÕÕÓÓÊÊÖÖÓÓËËÙÙÖÖÍÍÚÚ××ÏÏÝÝØØÐÐÝÝØØÐÐÝÝÙÙÑÑßßÜÜÓÓááÞÞÔÔââààÕÕããßßÙÙææââÚÚèèããÚÚèèããÛÛééääÛÛééääÚÚèèããÛÛééääÜÜêêååÜÜêêååÝÝééääÝÝêêååÞÞêêææÜÜééääÝÝêêååÞÞêêææÝÝëëããÞÞêêããââêêääââëëååßßêêããÞÞèèââÝÝççââÜÜææããÜÜççããÜÜææããÚÚääááÛÛååââÛÛååââÜÜççááÜÜèèßßÜÜèèÞÞÝÝééßßßßêêááààëëââââêêããããêêååããêêååááèèããááèèããààææââÞÞååààÙÙááÙÙÔÔÜÜÔÔÖÖÞÞÖÖÛÛããÚÚààèèààááèèããââèèããÜÜââÝÝÕÕÛÛÖÖÓÓÚÚÓÓÙÙââÙÙÞÞææÝÝÝÝååÝÝÝÝååÝÝÞÞææÝÝÞÞææÞÞÝÝååÝÝÛÛããÛÛ××ßß××ÓÓÚÚÕÕÓÓÚÚÕÕ××ÞÞÙÙÜÜããÞÞÞÞååààßßææááßßææââààççããààççââààççããááèèääááççããààççââßßååááÞÞååááÞÞååááààççââßßææááÝÝääààÜÜããÜÜÚÚââÚÚÜÜääÜÜÞÞææÞÞßßççßßááééááããêêââããééââääêêããèèííççèèííææééîîèèééîîèèèèððèèêêòòêêêêòòêêììððêêïïññììïïññëëììòòëëëëòòëëííññëëññóóììññôôëëððóóëëïïòòêêììòòêêëëòòêêééïïççççððääççîîååèèððééêêòòêêëëóóëëêêòòêêççïïççååííååããììããååììääççììååééïïèèëëððêêëëîîèèììîîééììîîééëëððééììòòêêííóóëëïïôôììññööîîññ÷÷ïïññ÷÷ïïññööîîîîôôììííòòêêîîòòêêííññééëëïïççëëîîææëëîîççììïïèèííññééííññééììïïççééììääééììääëëîîççììïïèèììððèèííððééììððèèîîññééññôôììññôôììññôôììññôôììññôôììóó÷÷ïïôô÷÷ïïòòõõííîîóóëëëëððééççììääääëëããääììääããëëããááééááààèèààááééááááééááââêêââããëëããääííääææîîææççïïççêêòòêêêêòòêêëëôôëëêêòòêêééññêêééððììééððëëèèîîêêççîîêêææììèèææììèèççííééææììèèååììèèääììååããëëããããëëããääëëååææííééêêññììëëòòììììóóëëëëóóëëëëóóëëëëóóëëÞÞææÞÞÄÄÌÌÄÄÍÍÕÕÍÍÚÚààÙÙÝÝßßÚÚÛÛááÚÚÝÝææÝÝÞÞççßßÚÚààÙÙØØÝÝÖÖááææààééîîèèééîîççééîîççééîîççèèððèèèèîîêêççííëëããììîîââììïïááëëííââììêêààêêççààêêççááëëèèááëëèèááêêèèââììééââììééááëëèèÜÜççããÕÕààßßÍÍÙÙ××ÉÉÕÕÔÔÊÊÕÕÓÓÎÎÙÙ××ÕÕßßÝÝÛÛååââÞÞééääààêêææááììééÂÂÒÒÒÒÃÃÓÓÓÓÂÂÑÑÑÑÁÁÒÒÕÕÃÃÔÔØØÁÁÓÓ××ÀÀÒÒÒÒÃÃÒÒÑÑÅÅÔÔÒÒÉÉØØÔÔËËÛÛ××ÍÍÜÜØØÌÌÜÜØØÌÌÛÛÙÙÎÎÜÜÚÚÏÏßßÛÛÒÒááÜÜ××ääààÙÙççââÙÙççââÙÙççââØØææááØØååááØØååááØØååááØØææááØØääààØØååààØØååááÙÙååááÚÚççââÙÙææááÚÚççááÛÛèèââÝÝèèããÝÝèèââÜÜèèââÛÛååááÚÚääààÚÚääááÚÚããááÚÚääááÚÚããààÚÚääááÛÛååââÜÜççááÝÝééááÞÞééááÝÝééààßßêêááááììääááêêååããëëææââêêääááééããââééããááééããááèèââÜÜääÜÜ××ßß××××ßß××ÛÛããÛÛààèèááááèèããââèèããÝÝããÞÞÙÙÞÞÚÚØØßßÙÙÛÛââÜÜßßççààààççááààèèááááèèááááèèââÞÞææßßÜÜääÝÝØØààÙÙØØÞÞÚÚÙÙààÛÛÝÝääßßááèèããââêêååääëëççååììççææííççææííççææííèèääëëççããêêææââééääääêêææääêêææããêêååááèèããààççââßßååááÝÝääßßÝÝååÞÞààççááááééââááééááááééááââêêââããêêããååììååééïïèèééïïèèêêññééëëòòëëëëóóëëììôôììííõõííïï÷÷ïïññùùññòòùùññïïøøïïííõõííððõõîîóóööïïòò÷÷îîññõõííððôôììïïôôììîîôôììëëññééééòòççééññèèêêòòêêììôôììííõõííììôôììééññééææííææããëëããååííååééïïèèëëòòëëììóóëëïïòòììððòòììïïòòììííòòëëîîôôììððõõííññ÷÷ïïóóùùññòòøøððóóùùññññ÷÷ïïïïôôììîîóóëëïïòòêêííññééëëïïççééííææêêîîææêêïïççììððèèëëîîææééììääççêêââèèëëããëëîîççììððèèïïóóëëîîóóëëïïôôëëïïóóëëññôôììññõõííóóööîîôô÷÷ïïôô÷÷ïïõõùùññööúúòòôôøøððïïôôììëëòòééççííååããëëââââêêââááééááààèèààààèèààááééááááééááááééââââêêããããêêããääììååææííççééððêêééññêêêêòòëëëëòòììêêññëëèèîîééççííèèççííèèååììççääëëååääììææääëëææããêêååââééååááééââààèèááààççááááèèââååììèèééïïëëééððêêççññèèææððèèêêððééÞÞååÞÞÉÉÐÐÉÉÓÓÜÜÓÓÞÞèèßßÜÜããÜÜÛÛßßÙÙØØààØØÚÚââÚÚÜÜããÜÜØØÞÞ××××ÜÜÔÔââççààêêïïèèêêððèèééïïççêêððèèèèððééèèîîêêççííëëääííèèããììèèääííèèääííêêääììêêääììêêååîîëëææððììååððììääïïëëããîîêêââííééÞÞééååÖÖááààÏÏÚÚÙÙËË××ÖÖËËÖÖÔÔÎÎØØ××ÕÕßßÞÞÚÚååããÞÞééææÞÞééææààëëééÀÀÐÐÐо¾ÍÍÍͽ½ÍÍÌ̽½ÍÍÏÏ··ÈÈÊʪª¾¾¿¿««ÀÀÀÀ¹¹ÍÍÌÌÃÃÕÕÒÒÆÆ××ÓÓÉÉÚÚ××ËËÜÜÙÙÊÊÛÛØØÉÉÚÚ××ÊÊÜÜÙÙÌÌÝÝÚÚÑÑßßÚÚÔÔââÞÞ××ääààØØååáá××ääààÔÔââÞÞÕÕããÞÞÖÖããßßÔÔââÞÞÔÔââÝÝÓÓááÜÜÒÒààÛÛÓÓááÜÜÕÕããßß××ääááÖÖääààØØääààÚÚææââÚÚèèããÜÜèèääÜÜççããÜÜççããÜÜææããÝÝççããÜÜççããÜÜææââÛÛååââÛÛææããÝÝèèããÝÝèèââßßééääßßééääßßêêââààêêääááëëééááëëééááëëççààëëââááëëââââêêââããëëããããëëããßßççßßÚÚââÚÚØØààØØÚÚááÜÜßßææââááèèããááèèããßßååááÛÛââÝÝÚÚààÛÛÛÛââÝÝßßææââááèèããââééääââééääââééääááèèããÞÞååááÚÚááÝÝÙÙààÛÛÛÛââÞÞááççããääëëææååììèèææííééèèïïèèççïïççççïïççççîîèèççííééææííééççîîêêééððëëééððëëççîîééããêêææááèèããßßææááßßææââááççããááèèããââééããããëëããââêêââââêêââããëëããææîîææèèððèèééññééëëóóëëììôôììííõõííïï÷÷ïïððøøððññùùññññúúòòòòúúòòññûûòòððúúððññ÷÷ïïòò÷÷ïïññ÷÷ïïððõõííððõõííññööîîððõõííììòòêêëëóóêêêêóóééììôôëëîî÷÷îîïï÷÷ïïîîööîîëëóóëëèèïïèèååììååææîîææêêòòêêììôôììîîööîîóóõõððóóõõððññóóííîîóóëëïïõõííññööîîññööîîòòøøððóóùùññóóùùññòòøøððððööîîññööîîððóóëëííññééììððèèééïïççèèîîææééîîççëëïïèèëëîîææëëîîææèèííååêêïïççííòòëëîîóóëëïïõõííððööîîññ÷÷ïïññ÷÷ïïññööîîññööîîôôøøððôôøøððõõùùññôôùùññõõúúòòóóøøððîîõõììëëóóêêææîîååääììããââêêââßßççßßààèèààÞÞææÞÞßßççßßßßççßßÞÞååààßßææââààççââááèèããââééååååììèèççîîêêééððììêêññììééññëëèèððèèååííååååííååääììääääììããããëëããââééääááççããááèèããááèèããààççââààççââââééääååëëççèèïïêêééððëëææòòééççòòêêääççááÏÏÓÓÍÍÔÔÛÛÔÔääïïææààëëââÝÝååÝÝÜÜââÛÛ××ààØØ××ßß××ÖÖÛÛÕÕÕÕÚÚÓÓÕÕÝÝÔÔååííããèèððèèééòòêêééòòêêééññêêééððëëèèïïêêèèîîêêèèïïççççïïççèèïïççèèïïêêèèîîììèèîîììèèííììççïïììååòòííããññììââîîêêààííèèÝÝêêåå××ââááÏÏÛÛÚÚËËÖÖÕÕÉÉÔÔÓÓÉÉÔÔÓÓÑÑÜÜÛÛ××ââááÛÛææååÜÜèèççààëëêê»»ËËË˼¼ÌÌÌ̶¶ÆÆÆƨ¨¸¸¸¸¨¨¹¹¸¸¤¤¹¹··§§½½¼¼¹¹ÎÎÍÍÄÄÕÕÓÓÆÆ××ÓÓÈÈÙÙÖÖÊÊÛÛØØÉÉÚÚ××ÉÉÚÚÖÖÊÊÛÛØØËËÜÜÙÙÑÑßßÚÚÓÓááÜÜÔÔââÝÝÕÕããßßÔÔââÝÝÓÓááÝÝÔÔââÝÝÔÔââÝÝÓÓááÜÜÔÔââÝÝÓÓááÜÜÓÓááÜÜÔÔââÝÝÕÕããÞÞ××ääààÖÖääààØØääààÙÙååááÚÚççââÛÛççããÝÝççããÞÞèèääààêêççààêêççààêêççààêêççßßééææßßééææßßééææààééççááëëééááëëééããííèèââììééââëëëëââëëêêááëëææààëëââááëëââããëëããääììääããëëããááééááÛÛããÛÛ××ÞÞ××××ÞÞÙÙÜÜããÞÞááèèããßßééããÜÜææààÙÙããÝÝÙÙááÛÛÜÜããÞÞááççããââééääããêêææääëëççããêêææââééääßßææááÚÚááÝÝÚÚááÜÜÝÝääßßããêêååççííééèèîîêêééïïëëééððêêèèññèèèèññèèêêññêêêêññììëëòòííììóóîîêêññììëëòòììééððëëææììèèââééääááèèããââééääââêêååããêêææããëëååääììããââêêââããëëããããëëããååííååååííååééññééêêòòêêììôôììììôôììîîööîîððøøððððøøððññùùññòòùùññððúúññððùùïïòò÷÷ïïññõõííððõõííððõõííððõõííññööîîññööïïïïôôììííõõììììôôëëííõõììððøøððòòúúòòððøøððììôôììééññééççïïççééññééììôôììïï÷÷ïïññøøññôô÷÷ññôôööññòòôôîîïïôôííððööîîòò÷÷ïïññ÷÷ïïòòøøððôôúúòòõõûûóóööüüôôôôúúòòññööîîññôôììîîññééííññééììòòêêëëññééëëññééììòòêêììññêêììòòêêííôôììïïøøîîññùùððòòùùððóóøøððòòøøððòòøøððóóùùññòòøøððððööîîññööîîññööîîòò÷÷ïïððøøîîïï÷÷îîîîööííììôôëëééññèèääììããááééááßßççßßÜÜääÜÜÝÝååÝÝÛÛããÛÛÛÛããÚÚÚÚââÚÚÚÚááÜÜÛÛââÞÞÝÝããßßÜÜããßßßßææááââééååççííééééïïëëééððììééððêêèèððèèææííææææîîææååííååååííååääììääââêêääÞÞååààààææââããêêååããêêääââééääããêêææææííééééððëëëëòòììëëööííääïïææÓÓÖÖÐÐØØÜÜÖÖëëññêêééóóêêããîîååßßççßßÛÛààÚÚÖÖßß××ÔÔÝÝÕÕÓÓÙÙÒÒÑÑ××ÏÏÖÖßßÕÕççïïææééññèèêêòòêêëëóóêêêêòòêêêêññììééððëëééïïëëééññééééññééééññééééïïëëèèîîììèèîîììèèîîììææððììääññììááîîééââîîééààììèèÜÜééää××ââááÎÎÙÙØØÉÉÔÔÓÓÇÇÓÓÒÒÇÇÓÓÑÑÌÌØØ××ÓÓßßÞÞÙÙääããÛÛççååààëëêê¼¼ÌÌÌÌ»»ËËËË··ÆÆÇÇ««»»ºº¶¶ÈÈÆƾ¾ÒÒÏϾ¾ÓÓÒÒÀÀÓÓÒÒÄÄÕÕÓÓÆÆÖÖÓÓÇÇØØÔÔÉÉÚÚ××ÉÉÚÚ××ÊÊÛÛØØËËÜÜÚÚÍÍÞÞÛÛÒÒààÛÛÔÔââÝÝÔÔââÝÝÕÕããÞÞÕÕããÞÞÕÕããßßÖÖääààÕÕããßßÔÔââÝÝÔÔââÝÝÕÕããÞÞÔÔââÝÝÕÕããßßÖÖããßßØØååááØØååáá××ããààØØääààÙÙææááÛÛççããÝÝççããààêêææààêêççààêêææààêêççááëëèèââììééááëëèèààêêççââììêêââììêêããííììããííëëääîîììããììííááëëêêááëëççààëëããààêêááââééááââêêââããëëããââêêââÝÝææÝÝÕÕÞÞÖÖÒÒÚÚÕÕÖÖÞÞÙÙÝÝääßßÝÝèèââÛÛææààØØããÜÜÙÙââÝÝÝÝääààááèèããããêêååååëëççææììèèååëëççääëëççààççããÚÚááÝÝÚÚááÜÜßßææááææììèèèèïïêêêêññììëëòòííëëòòììêêòòëëêêòòëëëëóóííììóóïïììóóîîììóóîîììóóîîëëóóííêêññììççííééããêêææââééããããêêææååììèèååììèèååííææääììääääëëääããëëããââêêââããëëããääììääææîîææèèððèèêêòòêêêêòòêêëëóóëëííõõííîîööîîîîööîîïï÷÷ïïîîøøîîííööììîîôôëëîîóóëëííóóëëïïõõííððööííððööîîññ÷÷ïïððööííííôôììììôôëëììôôëëïï÷÷îîññùùððîîööîîììôôììêêòòêêééññééëëóóêêííõõííññùùññóóúúòòööùùóóõõøøòòóóööññññõõîîððõõííññ÷÷ïïóóùùññôôúúòò÷÷ýýôôùùþþööùùþþööööüüôôòò÷÷ïïññõõììîîóóêêííòòééììòòêêííôôëëííôôëëîîõõììîîööííððøøîîïïùùïïððûûññòòüüòòòòûûòòôôùùññòò÷÷ïïòò÷÷ïïòòøøððïïõõììîîôôììííôôììííôôììííõõììììööííêêõõëëêêôôëëêêóóêêççïïææããëëââááééààÜÜääÝÝÚÚââÚÚÛÛããÛÛÚÚááÚÚØØààÙÙÖÖÞÞ××ØØßßÚÚÙÙààÛÛÚÚââÜÜÛÛââÞÞÞÞååààããêêååææííèèèèïïêêééððêêêêññëëêêòòêêèèððèèèèððèèééññééééññééèèïïééååììççááççããââééääääëëççääëëææääëëææääëëççççîîêêêêññììììóóííççóóêêÒÒßßÕÕ××ÜÜÕÕëëïïééííôôììèèóóêêååððèèààèèààÛÛààÙÙ××ááÙÙÏÏØØÐÐÆÆÌÌÅÅÈÈÎÎÆÆÜÜããÚÚèèïïææééòòééììóóììëëóóììêêòòëëêêññììééððëëééððëëééññêêééññééééððééççîîêêææììêêççííëëèèííëëææîîëëããîîêêààììééááììééßßëëèèÛÛèèää××ããââÌÌØØ××ÈÈÓÓÒÒÃÃÑÑÏÏÃÃÑÑÎÎÇÇÕÕÓÓÏÏÜÜÚÚÖÖââááÚÚååääßßêêéé½½ÌÌÎξ¾ÎÎÏÏÀÀÐÐÑÑÁÁÑÑÑÑÂÂÒÒÑÑÃÃÓÓÓÓÄÄÔÔÔÔÄÄÔÔÔÔÆÆÕÕÖÖÇÇ××ÕÕÈÈÙÙÖÖËËÜÜÙÙËËÜÜÚÚÌÌÜÜÜÜÎÎÞÞÞÞÏÏßßßßÓÓááÝÝÔÔââÝÝÖÖääààÖÖääààÔÔââÝÝÕÕããÞÞÖÖããààÖÖääààÕÕããßßÔÔââÞÞÕÕããààÕÕããßßÕÕããßßÕÕããßßÕÕããßßÕÕããßßÖÖããÞÞ××ããßßØØääààÚÚååááÛÛååââÜÜççããÝÝèèääÞÞèèääÞÞééååààêêççááëëèèááëëèèààêêççááëëèèââììééââììééââììêêããííêêããííêêááëëêêááëëééááëëææààêêããááêêááããììããããííääááììããÝÝèèßßÕÕàà××ÑÑÛÛÕÕÒÒÝÝ××××ááÛÛÝÝååààÞÞææááÚÚââÝÝÙÙááÜÜÝÝääßßââééääååììææèèííææééïïèèééïïééééððëëææííèèßßææââßßææââååëëççêêññííììóóïïííôôïïííôôððîîõõòòîîôôóóîîõõóóîîõõòòïïööòòïïööòòïïõõññïïööòòììóóîîêêññììååììèèääëëççååììèèççîîééééïïëëëëññííêêññëëééññééèèððèèççïïççææîîææææîîææååííååååííååèèïïèèééññééééññééëëóóëëííõõííííõõííîîööííííõõììîîööííììôôëëëëóóêêììôôëëììôôëëííõõììîîööííïï÷÷îîîîööííëëôôëëììôôëëêêòòééêêòòééììôôëëîîööííîîööííììôôëëêêòòééëëóóêêììôôëëïï÷÷ïïòòúúòòóóûûóóõõûûôôõõûûôôòòøøññòòøøððòòøøïïóóøøððôôúúóó÷÷üüõõúúÿÿ÷÷ùùÿÿõõúúÿÿ÷÷ööüüôôññ÷÷ïïììôôëëééññèèççïïææééññèèëëóóêêííõõììïï÷÷îîòòúúððóóûûòòóóûûòòóóûûòòòòúúññòòùùððóóøøððññööîîïïõõììííõõììëëóóêêëëóóêêëëóóëëììôôììììôôììëëóóëëëëóóëëììôôììêêòòêêççïïççääììääááééááÞÞææÞÞÛÛããÛÛÙÙááÚÚÙÙààÛÛ××ÞÞÙÙ××ÝÝÙÙØØÞÞÚÚÙÙààÛÛÙÙààÛÛÛÛââÞÞÞÞååààããêêååååììææèèððèèééññééêêòòêêêêòòêêêêòòêêêêòòêêééññèèééññêêééððëëççííééææííééååììèèååììèèååììèèããêêææããêêååççííééêêññììëëòòííããîîèèÔÔããÙÙååîîååííòòëëêêóóëëççôôëëççððèèââêêââÛÛããÛÛÕÕàà××¾¾ÊÊÁÁ®®¶¶®®ÈÈÌÌÅÅææììääêêòòééééóóëëëëòòííëëòòííëëòòííëëòòííêêññììëëòòííëëññííééððëëèèîîêêèèîîëëççííììççîîììççììëëççììëëääííêêááììééááììëëßßêêééÜÜèèççÖÖääääËËÙÙÙÙÄÄÑÑÑÑÀÀÎÎÌÌ¿¿ÍÍÊÊÃÃÑÑÏÏÌÌØØ××ÔÔààÞÞ××ââááÜÜççææ¿¿ÑÑÑÑÀÀÒÒÒÒÁÁÓÓÓÓÂÂÓÓÓÓÅÅÔÔÔÔÇÇ××××ÈÈ××××ÇÇ××××ÇÇÖÖ××ÆÆ××××ÈÈÚÚÙÙËËÞÞÜÜÌÌßßÝÝÐÐààààÑÑááááÒÒââââÓÓááßßÔÔããááÖÖääââÕÕããßßÔÔââÝÝÔÔââÝÝÕÕããààÕÕããááÔÔââààÔÔââààÓÓááßßÔÔââààÔÔââßßÓÓááÜÜÓÓááÜÜÓÓááÜÜÔÔââÜÜÕÕââÝÝ××ããßßØØââßßØØââßßÚÚääááÚÚååââÛÛææââÜÜççããÞÞèèääààêêççààêêççààêêççààêêççááëëèèááëëèèââììééããííêêââììééááëëééááëëééááëëææááììääááííããââííääââííääááììããßßêêáá××ããÚÚÑÑÛÛÕÕÑÑÜÜÖÖ××ââÜÜÜÜèèââÜÜééââÙÙååßßÙÙââÜÜÜÜââÞÞááççããääììææææððççééóóêêééòòêêééññêêææîîççßßççààßßççààääììååêêññêêëëóóîîííôôïïííôôððííôôññîîôôóóððööôôññ÷÷ôôññ÷÷óóððööòòññ÷÷óóðð÷÷òòííôôïïééððëëææììèèèèîîêêëëòòííììóóîîííôôïïïïõõòòîîööïïïï÷÷ïïîîööîîììôôììëëóóëëêêòòêêèèððèèççïïççèèïïèèèèððèèééññééëëóóëëííõõííîîööííîîööííîîööííííõõììëëóóêêììôôëëëëóóêêëëóóêêííõõììîîööííïï÷÷îîîîööííììôôëëééññèèèèððççèèððççêêòòééííõõììììôôëëëëóóêêêêòòééëëóóêêîîööííòòúúòòõõýýõõõõýýõõõõûûôôõõûûôôôôúúóóõõûûóóõõûûóóõõûûóóøøýý÷÷úúÿÿùùûûÿÿøøúúÿÿööùùþþööõõúúòòîîôôììééññèèææííääååííääèèððççêêòòééííõõììññùùððòòúúññôôüüóóòòúúññòòúúññððøøïïííõõììííôôììììóóêêëëòòééêêòòééééññèèééññèèëëóóëëííõõííììôôììëëóóëëììôôììììôôììëëóóëëééññééææîîææââêêââÞÞææÞÞÛÛããÛÛÚÚââÛÛÚÚááÜÜØØßßÚÚØØßßÚÚØØÞÞÚÚØØÞÞÚÚ××ÞÞÙÙØØààÚÚÛÛââÞÞààææââããëëääèèïïèèççïïççééññééééòòééééññééééññééééññèèééññêêééððëëèèïïêêèèîîêêççííééææííééääëëççââééääááèèããââééääççííééëëòòîîççòòïïããòòêêêêóóëëêêóóëëëëõõììëëôôëëééññééããëëããÜÜääÜÜÓÓßßÖÖ³³¾¾µµ««²²««ÕÕÚÚÔÔëëððëëèèððêêèèòòììëëòòííëëòòííììóóîîììóóîîììóóîîììóóîîëëòòððêêññïïééððîîééððððééððññééïïððèèïïîîææïïììääððììââïïëëââííììááììëëÞÞêêééØØææææÎÎÜÜÜÜÄÄÑÑÑÑÀÀÎÎÎÎÀÀÍÍÌÌÂÂÐÐÐÐÉÉÖÖÕÕÑÑÝÝÛÛÔÔààÞÞÙÙååää¼¼ÑÑÑѾ¾ÒÒÒÒ¿¿ÓÓÓÓÃÃÔÔÔÔÅÅÕÕÕÕÈÈØØØØÊÊÚÚÚÚÊÊÚÚÚÚÈÈØØØØÆÆØØØØÇÇÛÛÛÛËËààßßÍÍââááÐÐßßßßÑÑááááÒÒââââÓÓááááÔÔââââÖÖããääÖÖääààÔÔââÝÝÔÔââÝÝÕÕããááÔÔââââÔÔââââÓÓááááÒÒààààÒÒààááÒÒààßßÒÒààÛÛÒÒààÛÛÒÒààÛÛÓÓààÛÛÓÓààÛÛÕÕââÝÝØØããßßÚÚääááÛÛååââÜÜççããÜÜççããÜÜççããÞÞééååßßééååààêêççßßééååÞÞèèääßßééååààêêççááëëèèââììééááëëèèààêêèèààêêèèááëëææââííææááîîääááîîääááííääááììããßßëëââÙÙääÜÜÑÑÛÛÖÖÐÐÚÚÔÔØØââÝÝÜÜêêããÝÝëëääÚÚééááÙÙââÜÜÛÛââÝÝààææââââëëääââïïææääññèèååññèèèèððççååììããÞÞææÝÝÜÜääÛÛââêêááççïïææêêññëëëëòòííëëòòííëëòòïïììóóññïïõõôôññøøôôññøøóóññøøóóññøøóóïïööòòëëññííççííééççííééèèîîêêêêññììííôôððîîõõññññ÷÷óóññùùòòññùùññððøøððîîööîîîîööîîëëóóëëééññééèèððèèèèïïèèèèïïèèééððééëëóóëëííõõííîîööííîîööííîîööííííõõììììôôëëëëóóêêììôôëëììôôëëîîööííîîööííîîööííïï÷÷ííììôôëëêêòòééééññèèééññèèééññèèëëóóêêêêòòééééññèèêêòòééëëóóêêîîööîîññùùññôôüüôôôôüüôôõõûûôôööüüõõööüüõõõõûûóóôôúúòòööüüôô÷÷ýý÷÷ùùÿÿøøúúÿÿööùùþþôô÷÷ýýõõóóøøññëëòòêêèèððççææîîååççîîååççîîååééññèèììôôëëïï÷÷ííññùùïïòòúúññòòúúññððøøïïîîõõììëëôôëëêêõõëëèèóóééééóóééééññèèééññèèêêòòééëëóóëëííõõííííõõííììôôììííõõííííõõííììôôììëëóóëëèèððèèääëëääââêêââßßççßßÝÝååÞÞÛÛââÝÝÙÙààÛÛØØßßÚÚØØßßÚÚ××ÞÞÙÙÕÕÜÜØØÙÙààÛÛÜÜããßßááèèããããëëääææîîææææîîææèèððèèèèððèèèèððèèééññèèééññééééððééééððëëêêññììééððëëèèïïêêççîîééääëëææááèèââßßååááßßææááääëëææêêññîîééóóóóææóóîîêêóóííééõõììëëõõììííóóììêêòòêêääììääÞÞææÞÞËËÖÖÍͨ¨´´««³³ºº²²ããççââëëññììééððììççððëëêêññììììóóîîííôôððëëòòííììóóîîëëòòííììóóòòëëòòóóééññððééïïòòééîîòòééííòòèèïïððææòòííääóóííââññííããïïîîââííììààëëêêÝÝëëëëÓÓààààÇÇÕÕÕÕÂÂÐÐÑÑÀÀÍÍÏÏÃÃÐÐÒÒÊÊÖÖÖÖÑÑÝÝÛÛÔÔààÞÞÙÙääãã \ No newline at end of file diff --git a/components/vampireimaging/Demos/Data/Tigers.psd b/components/vampireimaging/Demos/Data/Tigers.psd deleted file mode 100644 index 71aa028..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.psd and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.tga b/components/vampireimaging/Demos/Data/Tigers.tga deleted file mode 100644 index 8b4aef4..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.tga and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Tigers.tif b/components/vampireimaging/Demos/Data/Tigers.tif deleted file mode 100644 index 9be7dd2..0000000 Binary files a/components/vampireimaging/Demos/Data/Tigers.tif and /dev/null differ diff --git a/components/vampireimaging/Demos/Data/Vezyr.png b/components/vampireimaging/Demos/Data/Vezyr.png deleted file mode 100644 index ee09ac5..0000000 Binary files a/components/vampireimaging/Demos/Data/Vezyr.png and /dev/null differ diff --git a/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.dof b/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.dof deleted file mode 100644 index a4d1a69..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.dof +++ /dev/null @@ -1,117 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=0 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=..\..\Bin -UnitOutputDir=..\..\Bin\Dcu\Win32 -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common;..\..\..\Extras\Extensions\LibTiff -Conditionals=FULL_FEATURE_SET -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -Launcher= -UseLauncher=0 -DebugCWD= -[HistoryLists\hlConditionals] -Count=1 -Item0=FULL_FEATURE_SET -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common;..\..\..\Extras\Extensions\LibTiff -[HistoryLists\hlOutputDirectorry] -Count=1 -Item0=..\..\Bin diff --git a/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.dpr b/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.dpr deleted file mode 100644 index c597aa1..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.dpr +++ /dev/null @@ -1,17 +0,0 @@ -program Bench; - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$IFDEF MSWINDOWS} - {$APPTYPE CONSOLE} -{$ENDIF} - -uses - DemoUnit; -begin - RunDemo; -end. - - diff --git a/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.lpi b/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.lpi deleted file mode 100644 index 7fb1d55..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Benchmark/Bench.lpi +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - - - - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="2"> - <Unit0> - <Filename Value="Bench.dpr"/> - <IsPartOfProject Value="True"/> - </Unit0> - <Unit1> - <Filename Value="DemoUnit.pas"/> - <IsPartOfProject Value="True"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\Bench"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;$(ProjOutDir)"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <SyntaxMode Value="Delphi"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-dFULL_FEATURE_SET"/> - </Other> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> diff --git a/components/vampireimaging/Demos/ObjectPascal/Benchmark/DemoUnit.pas b/components/vampireimaging/Demos/ObjectPascal/Benchmark/DemoUnit.pas deleted file mode 100644 index 922dafa..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Benchmark/DemoUnit.pas +++ /dev/null @@ -1,455 +0,0 @@ -{ - Vampyre Imaging Library Demo - Benchmark (core low level API) - - Simple program which measures time taken by the main Imaging functions - (loading, manipulation, saving) in microsecond resolution. - You can use it to compare the speeds of executables created by the supported - compilers (you can find results for my machine somewhere in Demos directory). -} -unit DemoUnit; - -{$I ImagingOptions.inc} - -{ Define this to write results to log file or undef it to - display them on screen.} -{$DEFINE LOG_TO_FILE} -{ Define this to write images created in saving test on disk. - They are saved only to memory when testing.} -{$DEFINE SAVE_IMAGES_TO_FILES} - -interface - -procedure RunDemo; - -implementation - -uses - SysUtils, - Classes, - ImagingTypes, - Imaging, - ImagingUtility, - DemoUtils; - -type - TManipulation = (maResize3k, maResize1k, maFlip, maMirror, maSwapChannels, - maConvARGB64, maConvARGBF, maConvARGB16, maConvRGB24, maConvARGB32, - maCompressDXT, maDecompressDXT, maReduceColors, maClone, maMipMaps, - maCopyRect, maMapImage, maFill, maSplit, maMakePal, maReplace, - maRotate180, maRotate90, maStretchRect); - - TFileFormatInfo = record - Name: string; - Ext: string; - Masks: string; - CanSave: Boolean; - IsMulti: Boolean; - end; - -const - SDataDir = 'Data'; - SImageName = 'Tigers'; - SSaveImage = '_BenchOut'; - SLogFileName = 'ResultsPas.log'; - -var - Time: Int64; - Img: TImageData; -{$IFDEF LOG_TO_FILE} - Output: TextFile; -{$ENDIF} - -procedure WriteTimeDiff(const Msg: string; const OldTime: Int64); -var - Diff: Double; - S: string; -begin - Diff := (GetTimeMicroseconds - OldTime) * 1.0; - S := Format('%-58s %16.0n us', [Msg, Diff], GetFormatSettingsForFloats); - WriteLn(Output, S); -end; - -function GetImageName(const Ext: string): string; -begin - Result := GetDataDir + PathDelim + SImageName + '.' + Ext; -end; - -procedure LoadImage(const Name: string); -var - Mem: TMemoryStream; -begin - if FileExists(Name) then - begin - Mem := TMemoryStream.Create; - try - WriteLn(Output, 'Loading image: ' + ExtractFileName(Name)); - Mem.LoadFromFile(Name); - Time := GetTimeMicroseconds; - // We are loading from memory stream so there is no file system - // overhead measured. - Imaging.LoadImageFromStream(Mem, Img); - WriteTimeDiff('Image loaded in:', Time); - finally - Mem.Free; - end; - end; -end; - -procedure SaveImage(const Ext: string); -var - Mem: TMemoryStream; -begin - Mem := TMemoryStream.Create; - WriteLn(Output, 'Saving image to format: ' + Ext); - try - Time := GetTimeMicroseconds; - // We are saving to memory stream so there is no file system - // overhead measured. But if image is in data format which is not - // supported by this file format the measured time will include conversion - // time. - Imaging.SaveImageToStream(Ext, Mem, Img); - WriteTimeDiff('Image saved in:', Time); - {$IFDEF SAVE_IMAGES_TO_FILES} - Mem.SaveToFile(GetAppDir + PathDelim + sSaveImage + '.' + Ext); - {$ENDIF} - finally - Mem.Free; - end; -end; - -var - ImgClone: TImageData; - Subs: TDynImageDataArray; - FillColor: TColor32Rec = (Color: $FFFF0000); - NewColor: TColor32Rec = (Color: $FF00CCFF); - I, XCount, YCount: LongInt; - Pal: PPalette32; - Formats: array of TFileFormatInfo; - -procedure ManipulateImage(Man: TManipulation); -begin - // According to the enum value image manipulation functions are - // called and measured. - case Man of - maResize3k: - begin - WriteLn(Output, 'Resizing image to 3000x3000 (bilinear) ... '); - Time := GetTimeMicroseconds; - Imaging.ResizeImage(Img, 3000, 3000, rfBilinear); - WriteTimeDiff('Image resized in: ', Time); - end; - maResize1k: - begin - WriteLn(Output, 'Resizing image to 1000x1000 (bicubic) ... '); - Time := GetTimeMicroseconds; - Imaging.ResizeImage(Img, 1000, 1000, rfBicubic); - WriteTimeDiff('Image resized in: ', Time); - end; - maFlip: - begin - WriteLn(Output, 'Flipping image ... '); - Time := GetTimeMicroseconds; - Imaging.FlipImage(Img); - WriteTimeDiff('Image flipped in: ', Time); - end; - maMirror: - begin - WriteLn(Output, 'Mirroring image ... '); - Time := GetTimeMicroseconds; - Imaging.MirrorImage(Img); - WriteTimeDiff('Image mirrored in:', Time); - end; - maSwapChannels: - begin - WriteLn(Output, 'Swapping channels of image ... '); - Time := GetTimeMicroseconds; - Imaging.SwapChannels(Img, ChannelRed, ChannelGreen); - WriteTimeDiff('Channels swapped in: ', Time); - end; - maConvARGB64: - begin - WriteLn(Output, 'Converting image to A16R16G16B16 64bit format ... '); - Time := GetTimeMicroseconds; - Imaging.ConvertImage(Img, ifA16R16G16B16); - WriteTimeDiff('Image converted in: ', Time); - end; - maConvARGBF: - begin - WriteLn(Output, 'Converting image to A32B32G32R32F 128bit floating ' + - 'point format... '); - Time := GetTimeMicroseconds; - Imaging.ConvertImage(Img, ifA32B32G32R32F); - WriteTimeDiff('Image converted in: ', Time); - end; - maConvARGB16: - begin - WriteLn(Output, 'Converting image to A4R4G4B4 16bit format... '); - Time := GetTimeMicroseconds; - Imaging.ConvertImage(Img, ifA4R4G4B4); - WriteTimeDiff('Image converted in: ', Time); - end; - maConvRGB24: - begin - WriteLn(Output, 'Converting image to R8G8B8 24bit format... '); - Time := GetTimeMicroseconds; - Imaging.ConvertImage(Img, ifR8G8B8); - WriteTimeDiff('Image converted in: ', Time); - end; - maConvARGB32: - begin - WriteLn(Output, 'Converting image to A8R8G8B8 32bit format... '); - Time := GetTimeMicroseconds; - Imaging.ConvertImage(Img, ifA8R8G8B8); - WriteTimeDiff('Image converted in: ', Time); - end; - maCompressDXT: - begin - WriteLn(Output, 'Compressing image to DXT1 format... '); - Time := GetTimeMicroseconds; - Imaging.ConvertImage(Img, ifDXT1); - WriteTimeDiff('Image compressed in: ', Time); - end; - maDecompressDXT: - begin - WriteLn(Output, 'Decompressing image from DXT1 format... '); - Time := GetTimeMicroseconds; - Imaging.ConvertImage(Img, ifA8R8G8B8); - WriteTimeDiff('Image decompressed in: ', Time); - end; - maReduceColors: - begin - WriteLn(Output, 'Reducing colors count to 1024... '); - Time := GetTimeMicroseconds; - Imaging.ReduceColors(Img, 1024); - WriteTimeDiff('Colors reduced in: ', Time); - end; - maMipMaps: - begin - WriteLn(Output, 'Creating mipmaps ... '); - SetLength(Subs, 0); - Time := GetTimeMicroseconds; - Imaging.GenerateMipMaps(Img, 0, Subs); - WriteTimeDiff('Mipmaps created in: ', Time); - Imaging.FreeImagesInArray(Subs); - end; - maClone: - begin - WriteLn(Output, 'Cloning image ... '); - Imaging.InitImage(ImgClone); - Time := GetTimeMicroseconds; - Imaging.CloneImage(Img, ImgClone); - WriteTimeDiff('Image cloned in: ', Time); - end; - maCopyRect: - begin - WriteLn(Output, 'Copying rectangle ... '); - Time := GetTimeMicroseconds; - Imaging.CopyRect(ImgClone, 0, 1500, 1500, 1500, Img, 0, 0); - WriteTimeDiff('Rectangle copied in: ', Time); - end; - maStretchRect: - begin - WriteLn(Output, 'Stretching rectangle (bicubic) ... '); - Time := GetTimeMicroseconds; - Imaging.StretchRect(ImgClone, 0, 1500, 1500, 1500, Img, 500, 500, 2000, 2000, rfBicubic); - WriteTimeDiff('Rectangle stretched in: ', Time); - Imaging.FreeImage(ImgClone); - end; - maMapImage: - begin - WriteLn(Output, 'Mapping image to existing palette ... '); - Time := GetTimeMicroseconds; - Imaging.MapImageToPalette(Img, Pal, 256); - WriteTimeDiff('Image mapped in: ', Time); - Imaging.FreePalette(Pal); - end; - maFill: - begin - WriteLn(Output, 'Filling rectangle ... '); - Time := GetTimeMicroseconds; - Imaging.FillRect(Img, 1500, 0, 1500, 1500, @FillColor); - WriteTimeDiff('Rectangle filled in: ', Time); - end; - maReplace: - begin - WriteLn(Output, 'Replacing colors in rectangle ... '); - Time := GetTimeMicroseconds; - Imaging.ReplaceColor(Img, 0, 0, Img.Width, Img.Height, @FillColor, @NewColor); - WriteTimeDiff('Colors replaced in: ', Time); - end; - maSplit: - begin - WriteLn(Output, 'Splitting image ... '); - SetLength(Subs, 0); - Time := GetTimeMicroseconds; - Imaging.SplitImage(Img, Subs, 300, 300, XCount, YCount, True, @FillColor); - WriteTimeDiff('Image split in: ', Time); - Imaging.FreeImagesInArray(Subs); - end; - maMakePal: - begin - WriteLn(Output, 'Making palette for images ... '); - Imaging.NewPalette(256, Pal); - SetLength(Subs, 1); - Subs[0] := Img; - Time := GetTimeMicroseconds; - Imaging.MakePaletteForImages(Subs, Pal, 256, False); - WriteTimeDiff('Palette made in: ', Time); - Img := Subs[0]; - end; - maRotate180: - begin - WriteLn(Output, 'Rotating image 180 degrees CCW ... '); - Time := GetTimeMicroseconds; - Imaging.RotateImage(Img, 180); - WriteTimeDiff('Image rotated in: ', Time); - end; - maRotate90: - begin - WriteLn(Output, 'Rotating image 90 degrees CCW ... '); - Time := GetTimeMicroseconds; - Imaging.RotateImage(Img, 90); - WriteTimeDiff('Image rotated in: ', Time); - end; - end; -end; - -procedure RunDemo; -begin - WriteLn('Vampyre Imaging Library Benchmark Demo version ', Imaging.GetVersionStr); - WriteLn; - -{$IFDEF LOG_TO_FILE} - // If logging to file is defined new output file is created - // and all messages are written into it. - try - AssignFile(Output, GetAppDir + PathDelim + SLogFileName); - Rewrite(Output); - except - on E: Exception do - begin - WriteLn('Exception raised during opening log file for writing: ' + - GetAppDir + PathDelim + SLogFileName); - WriteLn(E.Message); - Halt(1); - end; - end; - WriteLn('Benchmarking ...'); -{$ELSE} - // Otherwise standard System.Output file is used. -{$ENDIF} - - if not DirectoryExists(GetDataDir) then - begin - // If required testing data is not found program halts. - WriteLn('Error!' + sLineBreak + '"Data" directory with ' + - 'required "Tigers.*" images not found.'); - WriteLn; - WriteLn('Press RETURN key to exit'); - ReadLn; - Halt(1); - end; - - // Call this before any manipulation with TImageData record. - Imaging.InitImage(Img); - try - try - I := 0; - SetLength(Formats, 1); - // Enumerate all supported file formats and store their properties - // to dyn array. After each iteration dyn array's size is increased by one - // so next call to EnumFileFormats will have free space for results. - // After enumerating last array item should be deleted because its empty. - while Imaging.EnumFileFormats(I, Formats[I].Name, Formats[I].Ext, - Formats[I].Masks, Formats[I].CanSave, Formats[I].IsMulti) do - begin - SetLength(Formats, I + 1); - end; - SetLength(Formats, I); - - // Test image loading functions for all supported image file formats - // note that image loaded in one LoadImage is automaticaly - // freed in then next LoadImage call so no leaks (should) occurr. - WriteLn(Output, '------------- Loading Images -------------'); - for I := Low(Formats) to High(Formats) do - LoadImage(GetImageName(Formats[I].Ext)); - - // Test image manipulation functions like conversions, resizing and other. - WriteLn(Output, sLineBreak + '----------- Image Manipulation -----------'); - ManipulateImage(maResize3k); - ManipulateImage(maConvARGB64); - ManipulateImage(maFlip); - ManipulateImage(maMirror); - ManipulateImage(maSwapChannels); - ManipulateImage(maConvARGBF); - ManipulateImage(maConvARGB16); - ManipulateImage(maConvARGB32); - ManipulateImage(maClone); - ManipulateImage(maCopyRect); - ManipulateImage(maFill); - ManipulateImage(maStretchRect); - ManipulateImage(maReplace); - ManipulateImage(maMipMaps); - ManipulateImage(maSplit); - ManipulateImage(maResize1k); - ManipulateImage(maRotate180); - ManipulateImage(maRotate90); - ManipulateImage(maReduceColors); - ManipulateImage(maMakePal); - ManipulateImage(maMapImage); - ManipulateImage(maCompressDXT); - ManipulateImage(maDecompressDXT); - ManipulateImage(maConvRGB24); - - // Test image saving functions. Image is now in R8G8B8 format. Note that - // some supported file formats cannot save images in R8G8B8 so their - // time includes conversions. - WriteLn(Output, sLineBreak + '------------- Saving Images --------------'); - for I := Low(Formats) to High(Formats) do - begin - if Formats[I].CanSave then - SaveImage(Formats[I].Ext); - end; - - except - on E: Exception do - begin - WriteLn('Exception Raised!'); - WriteLn(E.Message); - end; - end; - finally - // Image must be freed in the end. - Imaging.FreeImage(Img); - {$IFDEF LOG_TO_FILE} - CloseFile(Output); - WriteLn('Results written to "' + SLogFileName + '" file.'); - {$ENDIF} - end; - - WriteLn; - WriteLn('Press RETURN key to exit'); - ReadLn; -end; - -{ - File Notes: - - -- 0.77.1 --------------------------------------------------- - - Refactored the demo (moved stuff to unit from dpr) and - added Lazarus project files. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Now uses file format enumeration so it tries to load/save images in - all supported formats. Plus some minor aesthetic changes. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added thousand separators to output times - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - added filtered image resizing and rectangle stretching - - added MNG and JNG file saving and loading and exception catcher -} - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/DXTypes.pas b/components/vampireimaging/Demos/ObjectPascal/Common/DXTypes.pas deleted file mode 100644 index 8c45456..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/DXTypes.pas +++ /dev/null @@ -1,177 +0,0 @@ -{******************************************************************************} -{* *} -{* Copyright (C) Microsoft Corporation. All Rights Reserved. *} -{* *} -{* Files: dxsdkver.h, extracts from various DirectX SDK include files *} -{* Content: DirectX 9.0 headers common types *} -{* *} -{* DirectX 9.0 Delphi / FreePascal adaptation by Alexey Barkovoy *} -{* E-Mail: directx@clootie.ru *} -{* *} -{* Latest version can be downloaded from: *} -{* http://www.clootie.ru *} -{* http://sourceforge.net/projects/delphi-dx9sdk *} -{* *} -{*----------------------------------------------------------------------------*} -{* $Id: DXTypes.pas,v 1.23 2007/04/14 20:57:43 clootie Exp $ } -{******************************************************************************} -{ } -{ The contents of this file are used with permission, subject to the Mozilla } -{ Public License Version 1.1 (the "License"); you may not use this file except } -{ in compliance with the License. You may obtain a copy of the License at } -{ http://www.mozilla.org/MPL/MPL-1.1.html } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, } -{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for } -{ the specific language governing rights and limitations under the License. } -{ } -{ Alternatively, the contents of this file may be used under the terms of the } -{ GNU Lesser General Public License (the "LGPL License"), in which case the } -{ provisions of the LGPL License are applicable instead of those above. } -{ If you wish to allow use of your version of this file only under the terms } -{ of the LGPL License and not to allow others to use your version of this file } -{ under the MPL, indicate your decision by deleting the provisions above and } -{ replace them with the notice and other provisions required by the LGPL } -{ License. If you do not delete the provisions above, a recipient may use } -{ your version of this file under either the MPL or the LGPL License. } -{ } -{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html } -{ } -{******************************************************************************} - -{ I DirectX.inc} -{$WEAKPACKAGEUNIT} -{$MINENUMSIZE 4} - -unit DXTypes; - -interface - -(*$HPPEMIT '#include "dxsdkver.h"' *) - - -uses Windows; - -(*==========================================================================; - * - * File: dxsdkver.h - * Content: DirectX SDK Version Include File - * - ****************************************************************************) -const - _DXSDK_PRODUCT_MAJOR = 9; - {$EXTERNALSYM _DXSDK_PRODUCT_MAJOR} - _DXSDK_PRODUCT_MINOR = 18; - {$EXTERNALSYM _DXSDK_PRODUCT_MINOR} - _DXSDK_BUILD_MAJOR = 944; - {$EXTERNALSYM _DXSDK_BUILD_MAJOR} - _DXSDK_BUILD_MINOR = 0000; - {$EXTERNALSYM _DXSDK_BUILD_MINOR} - - - -(**************************************************************************** - * Other files - ****************************************************************************) -type - // TD3DValue is the fundamental Direct3D fractional data type - D3DVALUE = Single; - {$EXTERNALSYM D3DVALUE} - TD3DValue = D3DVALUE; - {$NODEFINE TD3DValue} - PD3DValue = ^TD3DValue; - {$NODEFINE PD3DValue} - - D3DCOLOR = type DWord; - {$EXTERNALSYM D3DCOLOR} - TD3DColor = D3DCOLOR; - {$NODEFINE TD3DColor} - PD3DColor = ^TD3DColor; - {$NODEFINE PD3DColor} - - _D3DVECTOR = packed record - x: Single; - y: Single; - z: Single; - end {_D3DVECTOR}; - {$EXTERNALSYM _D3DVECTOR} - D3DVECTOR = _D3DVECTOR; - {$EXTERNALSYM D3DVECTOR} - TD3DVector = _D3DVECTOR; - {$NODEFINE TD3DVector} - PD3DVector = ^TD3DVector; - {$NODEFINE PD3DVector} - - REFERENCE_TIME = LONGLONG; - {$EXTERNALSYM REFERENCE_TIME} - TReferenceTime = REFERENCE_TIME; - {$NODEFINE TReferenceTime} - PReferenceTime = ^TReferenceTime; - {$NODEFINE PReferenceTime} - - -// ================================================================== -// Here comes generic Windows types for Win32 / Win64 compatibility -// - - UInt64 = Int64; // for a while - - // - // The INT_PTR is guaranteed to be the same size as a pointer. Its - // size with change with pointer size (32/64). It should be used - // anywhere that a pointer is cast to an integer type. UINT_PTR is - // the unsigned variation. - // - {$EXTERNALSYM INT_PTR} - {$EXTERNALSYM UINT_PTR} - {$EXTERNALSYM LONG_PTR} - {$EXTERNALSYM ULONG_PTR} - {$EXTERNALSYM DWORD_PTR} - - - - - - - - INT_PTR = Longint; - UINT_PTR = LongWord; - LONG_PTR = Longint; - ULONG_PTR = LongWord; - DWORD_PTR = LongWord; - - PINT_PTR = ^INT_PTR; - PUINT_PTR = ^UINT_PTR; - PLONG_PTR = ^LONG_PTR; - PULONG_PTR = ^ULONG_PTR; - - - - - - PtrInt = Longint; - PtrUInt = Longword; - - PPtrInt = ^PtrInt; - PPtrUInt = ^PtrUInt; - - // - // SIZE_T used for counts or ranges which need to span the range of - // of a pointer. SSIZE_T is the signed variation. - // - {$EXTERNALSYM SIZE_T} - {$EXTERNALSYM SSIZE_T} - SIZE_T = ULONG_PTR; - SSIZE_T = LONG_PTR; - PSIZE_T = ^SIZE_T; - PSSIZE_T = ^SSIZE_T; - - SizeInt = SSIZE_T; - SizeUInt = SIZE_T; - PSizeInt = PSSIZE_T; - PSizeUInt = PSIZE_T; - -implementation - -end. - diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/DemoUtils.pas b/components/vampireimaging/Demos/ObjectPascal/Common/DemoUtils.pas deleted file mode 100644 index d35f4a5..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/DemoUtils.pas +++ /dev/null @@ -1,96 +0,0 @@ -unit DemoUtils; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, - Classes, - ImagingTypes, - Imaging, - ImagingUtility; - -const - SDataDir = 'Data'; - SSourceDir = 'Source'; - -{ } -function ExpandFileTo(const FileName, BasePath: string): string; -{ } -function SwapPathDelims(const FileName: string; const NewDelim: string = PathDelim): string; -{ } -function GetDataDir: string; -{ } -function GetRootDir: string; -{ Returns next valid image format.} -function NextFormat(Format: TImageFormat): TImageFormat; - -implementation - -function ExpandFileTo(const FileName, BasePath: string): string; -var - OldPath: string; -begin - GetDir(0, OldPath); - try - if SysUtils.DirectoryExists(BasePath) then - begin - ChDir(BasePath); - Result:= ExpandFileName(FileName); - end - else - Result:=FileName; - finally - ChDir(OldPath); - end; -end; - -function SwapPathDelims(const FileName, NewDelim: string): string; -begin - Result := FileName; - Result := StringReplace(Result, '\', NewDelim, [rfReplaceAll]); - Result := StringReplace(Result, '/', NewDelim, [rfReplaceAll]); -end; - -function GetDataDir: string; -var - Iter: Integer; -begin - Iter := 0; - Result := GetAppDir; - while not DirectoryExists(Result + PathDelim + SDataDir) and (Iter < 7) do - begin - Result := ExtractFileDir(Result); - Inc(Iter); - end; - Result := Result + PathDelim + SDataDir; -end; - -function GetRootDir: string; -var - Iter: Integer; -begin - Iter := 0; - Result := GetAppDir; - while not DirectoryExists(Result + PathDelim + SSourceDir) and (Iter < 7) do - begin - Result := ExtractFileDir(Result); - Inc(Iter); - end; -end; - -function NextFormat(Format: TImageFormat): TImageFormat; -var - Info: TImageFormatInfo; -begin - repeat - if Format < High(TImageFormat) then - Format := Succ(Format) - else - Format := ifIndex8; - until GetImageFormatInfo(Format, Info); - Result := Format; -end; - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/Direct3D9.pas b/components/vampireimaging/Demos/ObjectPascal/Common/Direct3D9.pas deleted file mode 100644 index 48ec129..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/Direct3D9.pas +++ /dev/null @@ -1,5614 +0,0 @@ -{******************************************************************************} -{* *} -{* Copyright (C) Microsoft Corporation. All Rights Reserved. *} -{* *} -{* Files: d3d9types.h d3d9caps.h d3d9.h *} -{* Content: Direct3D9 include files *} -{* *} -{* DirectX 9.0 Delphi / FreePascal adaptation by Alexey Barkovoy *} -{* E-Mail: directx@clootie.ru *} -{* *} -{* Latest version can be downloaded from: *} -{* http://clootie.ru *} -{* http://sourceforge.net/projects/delphi-dx9sdk *} -{* *} -{*----------------------------------------------------------------------------*} -{* $Id: Direct3D9.pas,v 1.13 2006/10/22 22:00:33 clootie Exp $ } -{******************************************************************************} -{ } -{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI) } -{ } -{ The contents of this file are used with permission, subject to the Mozilla } -{ Public License Version 1.1 (the "License"); you may not use this file except } -{ in compliance with the License. You may obtain a copy of the License at } -{ http://www.mozilla.org/MPL/MPL-1.1.html } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, } -{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for } -{ the specific language governing rights and limitations under the License. } -{ } -{ Alternatively, the contents of this file may be used under the terms of the } -{ GNU Lesser General Public License (the "LGPL License"), in which case the } -{ provisions of the LGPL License are applicable instead of those above. } -{ If you wish to allow use of your version of this file only under the terms } -{ of the LGPL License and not to allow others to use your version of this file } -{ under the MPL, indicate your decision by deleting the provisions above and } -{ replace them with the notice and other provisions required by the LGPL } -{ License. If you do not delete the provisions above, a recipient may use } -{ your version of this file under either the MPL or the LGPL License. } -{ } -{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html } -{ } -{******************************************************************************} - -{$I DirectX.inc} - -unit Direct3D9; - -interface - -// Global level dynamic loading support -{$IFDEF DYNAMIC_LINK_ALL} - {$DEFINE DIRECT3D9_DYNAMIC_LINK} -{$ENDIF} -{$IFDEF DYNAMIC_LINK_EXPLICIT_ALL} - {$DEFINE DIRECT3D9_DYNAMIC_LINK_EXPLICIT} -{$ENDIF} - -// Remove "dots" below to force some kind of dynamic linking -{.$DEFINE DIRECT3D9_DYNAMIC_LINK} -{.$DEFINE DIRECT3D9_DYNAMIC_LINK_EXPLICIT} - -(*$HPPEMIT '#include "d3d9.h"' *) -(*$HPPEMIT '#include "d3d9types.h"' *) -(*$HPPEMIT '#include "d3d9caps.h"' *) - -uses Windows, DXTypes; - -///// Helper constants (for use in SetRenderState) ///// -const - iTrue = DWORD(True); - iFalse = DWORD(False); - - - - -(*==========================================================================; - * - * Copyright (C) Microsoft Corporation. All Rights Reserved. - * - * File: d3d9types.h - * Content: Direct3D capabilities include file - * - ***************************************************************************) - -type - // D3DCOLOR is equivalent to D3DFMT_A8R8G8B8 - D3DCOLOR = DXTypes.D3DCOLOR; - {$EXTERNALSYM D3DCOLOR} - TD3DColor = DXTypes.TD3DColor; - -// maps unsigned 8 bits/channel to D3DCOLOR -// #define D3DCOLOR_ARGB(a,r,g,b) \ -// ((D3DCOLOR)((((a)&0xff)<<24)|(((r)&0xff)<<16)|(((g)&0xff)<<8)|((b)&0xff))) -function D3DCOLOR_ARGB(a,r,g,b: DWord): TD3DColor;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DCOLOR_ARGB} -// #define D3DCOLOR_RGBA(r,g,b,a) D3DCOLOR_ARGB(a,r,g,b) -function D3DCOLOR_RGBA(r,g,b,a: DWord): TD3DColor;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DCOLOR_RGBA} -// #define D3DCOLOR_XRGB(r,g,b) D3DCOLOR_ARGB(0xff,r,g,b) -function D3DCOLOR_XRGB(r,g,b: DWord): TD3DColor;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DCOLOR_XRGB} - -// #define D3DCOLOR_XYUV(y,u,v) D3DCOLOR_ARGB(0xff,y,u,v) -function D3DCOLOR_XYUV(y,u,v: DWord): TD3DColor;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DCOLOR_XYUV} -// #define D3DCOLOR_AYUV(a,y,u,v) D3DCOLOR_ARGB(a,y,u,v) -function D3DCOLOR_AYUV(a,y,u,v: DWord): TD3DColor;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DCOLOR_AYUV} - -// maps floating point channels (0.f to 1.f range) to D3DCOLOR -// #define D3DCOLOR_COLORVALUE(r,g,b,a) \ -// D3DCOLOR_RGBA((DWORD)((r)*255.f),(DWORD)((g)*255.f),(DWORD)((b)*255.f),(DWORD)((a)*255.f)) -function D3DCOLOR_COLORVALUE(r,g,b,a: Single): TD3DColor;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DCOLOR_COLORVALUE} - -type - _D3DVECTOR = DXTypes._D3DVECTOR; - {$EXTERNALSYM _D3DVECTOR} - D3DVECTOR = DXTypes.D3DVECTOR; - {$EXTERNALSYM D3DVECTOR} - TD3DVector = DXTypes.TD3DVector; - PD3DVector = DXTypes.PD3DVector; - - PD3DColorValue = ^TD3DColorValue; - _D3DCOLORVALUE = packed record - r: Single; - g: Single; - b: Single; - a: Single; - end {_D3DCOLORVALUE}; - {$EXTERNALSYM _D3DCOLORVALUE} - D3DCOLORVALUE = _D3DCOLORVALUE; - {$EXTERNALSYM D3DCOLORVALUE} - TD3DColorValue = _D3DCOLORVALUE; - - PD3DRect = ^TD3DRect; - _D3DRECT = packed record - x1: LongInt; - y1: LongInt; - x2: LongInt; - y2: LongInt; - end {_D3DRECT}; - {$EXTERNALSYM _D3DRECT} - D3DRECT = _D3DRECT; - {$EXTERNALSYM D3DRECT} - TD3DRect = _D3DRECT; - - PD3DMatrix = ^TD3DMatrix; - _D3DMATRIX = packed record - case integer of - 0 : (_11, _12, _13, _14: Single; - _21, _22, _23, _24: Single; - _31, _32, _33, _34: Single; - _41, _42, _43, _44: Single); - 1 : (m : array [0..3, 0..3] of Single); - end {_D3DMATRIX}; - {$EXTERNALSYM _D3DMATRIX} - D3DMATRIX = _D3DMATRIX; - {$EXTERNALSYM D3DMATRIX} - TD3DMatrix = _D3DMATRIX; - - PD3DViewport9 = ^TD3DViewport9; - _D3DVIEWPORT9 = packed record - X: DWord; - Y: DWord; { Viewport Top left } - Width: DWord; - Height: DWord; { Viewport Dimensions } - MinZ: Single; { Min/max of clip Volume } - MaxZ: Single; - end {_D3DVIEWPORT9}; - {$EXTERNALSYM _D3DVIEWPORT9} - D3DVIEWPORT9 = _D3DVIEWPORT9; - {$EXTERNALSYM D3DVIEWPORT9} - TD3DViewport9 = _D3DVIEWPORT9; - -(* - * Values for clip fields. - *) - -const - // Max number of user clipping planes, supported in D3D. - D3DMAXUSERCLIPPLANES = 32; - {$EXTERNALSYM D3DMAXUSERCLIPPLANES} - - // These bits could be ORed together to use with D3DRS_CLIPPLANEENABLE - // - D3DCLIPPLANE0 = (1 shl 0); - {$EXTERNALSYM D3DCLIPPLANE0} - D3DCLIPPLANE1 = (1 shl 1); - {$EXTERNALSYM D3DCLIPPLANE1} - D3DCLIPPLANE2 = (1 shl 2); - {$EXTERNALSYM D3DCLIPPLANE2} - D3DCLIPPLANE3 = (1 shl 3); - {$EXTERNALSYM D3DCLIPPLANE3} - D3DCLIPPLANE4 = (1 shl 4); - {$EXTERNALSYM D3DCLIPPLANE4} - D3DCLIPPLANE5 = (1 shl 5); - {$EXTERNALSYM D3DCLIPPLANE5} - - // The following bits are used in the ClipUnion and ClipIntersection - // members of the D3DCLIPSTATUS9 - // - D3DCS_LEFT = $00000001; - {$EXTERNALSYM D3DCS_LEFT} - D3DCS_RIGHT = $00000002; - {$EXTERNALSYM D3DCS_RIGHT} - D3DCS_TOP = $00000004; - {$EXTERNALSYM D3DCS_TOP} - D3DCS_BOTTOM = $00000008; - {$EXTERNALSYM D3DCS_BOTTOM} - D3DCS_FRONT = $00000010; - {$EXTERNALSYM D3DCS_FRONT} - D3DCS_BACK = $00000020; - {$EXTERNALSYM D3DCS_BACK} - D3DCS_PLANE0 = $00000040; - {$EXTERNALSYM D3DCS_PLANE0} - D3DCS_PLANE1 = $00000080; - {$EXTERNALSYM D3DCS_PLANE1} - D3DCS_PLANE2 = $00000100; - {$EXTERNALSYM D3DCS_PLANE2} - D3DCS_PLANE3 = $00000200; - {$EXTERNALSYM D3DCS_PLANE3} - D3DCS_PLANE4 = $00000400; - {$EXTERNALSYM D3DCS_PLANE4} - D3DCS_PLANE5 = $00000800; - {$EXTERNALSYM D3DCS_PLANE5} - - D3DCS_ALL = D3DCS_LEFT or - D3DCS_RIGHT or - D3DCS_TOP or - D3DCS_BOTTOM or - D3DCS_FRONT or - D3DCS_BACK or - D3DCS_PLANE0 or - D3DCS_PLANE1 or - D3DCS_PLANE2 or - D3DCS_PLANE3 or - D3DCS_PLANE4 or - D3DCS_PLANE5; - {$EXTERNALSYM D3DCS_ALL} - -type - PD3DClipStatus9 = ^TD3DClipStatus9; - _D3DCLIPSTATUS9 = packed record - ClipUnion: DWord; - ClipIntersection: DWord; - end {_D3DCLIPSTATUS9}; - {$EXTERNALSYM _D3DCLIPSTATUS9} - D3DCLIPSTATUS9 = _D3DCLIPSTATUS9; - {$EXTERNALSYM D3DCLIPSTATUS9} - TD3DClipStatus9 = _D3DCLIPSTATUS9; - - PD3DMaterial9 = ^TD3DMaterial9; - _D3DMATERIAL9 = packed record - Diffuse: TD3DColorValue; { Diffuse color RGBA } - Ambient: TD3DColorValue; { Ambient color RGB } - Specular: TD3DColorValue; { Specular 'shininess' } - Emissive: TD3DColorValue; { Emissive color RGB } - Power: Single; { Sharpness if specular highlight } - end {_D3DMATERIAL9}; - {$EXTERNALSYM _D3DMATERIAL9} - D3DMATERIAL9 = _D3DMATERIAL9; - {$EXTERNALSYM D3DMATERIAL9} - TD3DMaterial9 = _D3DMATERIAL9; - - _D3DLIGHTTYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DLIGHT_INVALID_0, {= 0} - D3DLIGHT_POINT, {= 1} - D3DLIGHT_SPOT, {= 2} - D3DLIGHT_DIRECTIONAL{= 3} - {$ELSE} - D3DLIGHT_POINT = 1, - D3DLIGHT_SPOT = 2, - D3DLIGHT_DIRECTIONAL = 3 - {$ENDIF} - ); - {$EXTERNALSYM _D3DLIGHTTYPE} - D3DLIGHTTYPE = _D3DLIGHTTYPE; - {$EXTERNALSYM D3DLIGHTTYPE} - TD3DLightType = _D3DLIGHTTYPE; - - PD3DLight9 = ^TD3DLight9; - _D3DLIGHT9 = packed record - _Type: TD3DLightType; { Type of light source } - Diffuse: TD3DColorValue; { Diffuse color of light } - Specular: TD3DColorValue; { Specular color of light } - Ambient: TD3DColorValue; { Ambient color of light } - Position: TD3DVector; { Position in world space } - Direction: TD3DVector; { Direction in world space } - Range: Single; { Cutoff range } - Falloff: Single; { Falloff } - Attenuation0: Single; { Constant attenuation } - Attenuation1: Single; { Linear attenuation } - Attenuation2: Single; { Quadratic attenuation } - Theta: Single; { Inner angle of spotlight cone } - Phi: Single; { Outer angle of spotlight cone } - end {_D3DLIGHT9}; - {$EXTERNALSYM _D3DLIGHT9} - D3DLIGHT9 = _D3DLIGHT9; - {$EXTERNALSYM D3DLIGHT9} - TD3DLight9 = _D3DLIGHT9; - -(* - * Options for clearing - *) -const - D3DCLEAR_TARGET = $00000001; { Clear target surface } - {$EXTERNALSYM D3DCLEAR_TARGET} - D3DCLEAR_ZBUFFER = $00000002; { Clear target z buffer } - {$EXTERNALSYM D3DCLEAR_ZBUFFER} - D3DCLEAR_STENCIL = $00000004; { Clear stencil planes } - {$EXTERNALSYM D3DCLEAR_STENCIL} - -(* - * The following defines the rendering states - *) -type - _D3DSHADEMODE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DSHADEMODE} - D3DSHADEMODE = _D3DSHADEMODE; - {$EXTERNALSYM D3DSHADEMODE} - TD3DShadeMode = _D3DSHADEMODE; - -const - D3DSHADE_FLAT = 1; - {$EXTERNALSYM D3DSHADE_FLAT} - D3DSHADE_GOURAUD = 2; - {$EXTERNALSYM D3DSHADE_GOURAUD} - D3DSHADE_PHONG = 3; - {$EXTERNALSYM D3DSHADE_PHONG} - -type - _D3DFILLMODE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DFILLMODE} - D3DFILLMODE = _D3DFILLMODE; - {$EXTERNALSYM D3DFILLMODE} - TD3DFillMode = _D3DFILLMODE; - -const - D3DFILL_POINT = 1; - {$EXTERNALSYM D3DFILL_POINT} - D3DFILL_WIREFRAME = 2; - {$EXTERNALSYM D3DFILL_WIREFRAME} - D3DFILL_SOLID = 3; - {$EXTERNALSYM D3DFILL_SOLID} - -type - _D3DBLEND = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DBLEND} - D3DBLEND = _D3DBLEND; - {$EXTERNALSYM D3DBLEND} - TD3DBlend = _D3DBLEND; - -const - D3DBLEND_ZERO = 1; - {$EXTERNALSYM D3DBLEND_ZERO} - D3DBLEND_ONE = 2; - {$EXTERNALSYM D3DBLEND_ONE} - D3DBLEND_SRCCOLOR = 3; - {$EXTERNALSYM D3DBLEND_SRCCOLOR} - D3DBLEND_INVSRCCOLOR = 4; - {$EXTERNALSYM D3DBLEND_INVSRCCOLOR} - D3DBLEND_SRCALPHA = 5; - {$EXTERNALSYM D3DBLEND_SRCALPHA} - D3DBLEND_INVSRCALPHA = 6; - {$EXTERNALSYM D3DBLEND_INVSRCALPHA} - D3DBLEND_DESTALPHA = 7; - {$EXTERNALSYM D3DBLEND_DESTALPHA} - D3DBLEND_INVDESTALPHA = 8; - {$EXTERNALSYM D3DBLEND_INVDESTALPHA} - D3DBLEND_DESTCOLOR = 9; - {$EXTERNALSYM D3DBLEND_DESTCOLOR} - D3DBLEND_INVDESTCOLOR = 10; - {$EXTERNALSYM D3DBLEND_INVDESTCOLOR} - D3DBLEND_SRCALPHASAT = 11; - {$EXTERNALSYM D3DBLEND_SRCALPHASAT} - D3DBLEND_BOTHSRCALPHA = 12; - {$EXTERNALSYM D3DBLEND_BOTHSRCALPHA} - D3DBLEND_BOTHINVSRCALPHA = 13; - {$EXTERNALSYM D3DBLEND_BOTHINVSRCALPHA} - D3DBLEND_BLENDFACTOR = 14; (* Only supported if D3DPBLENDCAPS_BLENDFACTOR is on *) - {$EXTERNALSYM D3DBLEND_BLENDFACTOR} - D3DBLEND_INVBLENDFACTOR = 15; (* Only supported if D3DPBLENDCAPS_BLENDFACTOR is on *) - {$EXTERNALSYM D3DBLEND_INVBLENDFACTOR} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DBLEND_SRCCOLOR2 = 16; - {$EXTERNALSYM D3DBLEND_SRCCOLOR2} - D3DBLEND_INVSRCCOLOR2 = 17; - {$EXTERNALSYM D3DBLEND_INVSRCCOLOR2} -{$ENDIF} - -type - _D3DBLENDOP = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DBLENDOP} - D3DBLENDOP = _D3DBLENDOP; - {$EXTERNALSYM D3DBLENDOP} - TD3DBlendOp = _D3DBLENDOP; - -const - D3DBLENDOP_ADD = 1; - {$EXTERNALSYM D3DBLENDOP_ADD} - D3DBLENDOP_SUBTRACT = 2; - {$EXTERNALSYM D3DBLENDOP_SUBTRACT} - D3DBLENDOP_REVSUBTRACT = 3; - {$EXTERNALSYM D3DBLENDOP_REVSUBTRACT} - D3DBLENDOP_MIN = 4; - {$EXTERNALSYM D3DBLENDOP_MIN} - D3DBLENDOP_MAX = 5; - {$EXTERNALSYM D3DBLENDOP_MAX} - -type - _D3DTEXTUREADDRESS = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DTEXTUREADDRESS} - D3DTEXTUREADDRESS = _D3DTEXTUREADDRESS; - {$EXTERNALSYM D3DTEXTUREADDRESS} - TD3DTextureAddress = _D3DTEXTUREADDRESS; - -const - D3DTADDRESS_WRAP = 1; - {$EXTERNALSYM D3DTADDRESS_WRAP} - D3DTADDRESS_MIRROR = 2; - {$EXTERNALSYM D3DTADDRESS_MIRROR} - D3DTADDRESS_CLAMP = 3; - {$EXTERNALSYM D3DTADDRESS_CLAMP} - D3DTADDRESS_BORDER = 4; - {$EXTERNALSYM D3DTADDRESS_BORDER} - D3DTADDRESS_MIRRORONCE = 5; - {$EXTERNALSYM D3DTADDRESS_MIRRORONCE} - -type - _D3DCULL = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DCULL} - D3DCULL = _D3DCULL; - {$EXTERNALSYM D3DCULL} - TD3DCull = _D3DCULL; - -const - D3DCULL_NONE = 1; - {$EXTERNALSYM D3DCULL_NONE} - D3DCULL_CW = 2; - {$EXTERNALSYM D3DCULL_CW} - D3DCULL_CCW = 3; - {$EXTERNALSYM D3DCULL_CCW} - -type - _D3DCMPFUNC = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DCMPFUNC} - D3DCMPFUNC = _D3DCMPFUNC; - {$EXTERNALSYM D3DCMPFUNC} - TD3DCmpFunc = _D3DCMPFUNC; - -const - D3DCMP_NEVER = 1; - {$EXTERNALSYM D3DCMP_NEVER} - D3DCMP_LESS = 2; - {$EXTERNALSYM D3DCMP_LESS} - D3DCMP_EQUAL = 3; - {$EXTERNALSYM D3DCMP_EQUAL} - D3DCMP_LESSEQUAL = 4; - {$EXTERNALSYM D3DCMP_LESSEQUAL} - D3DCMP_GREATER = 5; - {$EXTERNALSYM D3DCMP_GREATER} - D3DCMP_NOTEQUAL = 6; - {$EXTERNALSYM D3DCMP_NOTEQUAL} - D3DCMP_GREATEREQUAL = 7; - {$EXTERNALSYM D3DCMP_GREATEREQUAL} - D3DCMP_ALWAYS = 8; - {$EXTERNALSYM D3DCMP_ALWAYS} - -type - _D3DSTENCILOP = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DSTENCILOP} - D3DSTENCILOP = _D3DSTENCILOP; - {$EXTERNALSYM D3DSTENCILOP} - TD3DStencilOp = _D3DSTENCILOP; - -const - D3DSTENCILOP_KEEP = 1; - {$EXTERNALSYM D3DSTENCILOP_KEEP} - D3DSTENCILOP_ZERO = 2; - {$EXTERNALSYM D3DSTENCILOP_ZERO} - D3DSTENCILOP_REPLACE = 3; - {$EXTERNALSYM D3DSTENCILOP_REPLACE} - D3DSTENCILOP_INCRSAT = 4; - {$EXTERNALSYM D3DSTENCILOP_INCRSAT} - D3DSTENCILOP_DECRSAT = 5; - {$EXTERNALSYM D3DSTENCILOP_DECRSAT} - D3DSTENCILOP_INVERT = 6; - {$EXTERNALSYM D3DSTENCILOP_INVERT} - D3DSTENCILOP_INCR = 7; - {$EXTERNALSYM D3DSTENCILOP_INCR} - D3DSTENCILOP_DECR = 8; - {$EXTERNALSYM D3DSTENCILOP_DECR} - -type - _D3DFOGMODE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DFOGMODE} - D3DFOGMODE = _D3DFOGMODE; - {$EXTERNALSYM D3DFOGMODE} - TD3DFogMode = _D3DFOGMODE; - -const - D3DFOG_NONE = 0; - {$EXTERNALSYM D3DFOG_NONE} - D3DFOG_EXP = 1; - {$EXTERNALSYM D3DFOG_EXP} - D3DFOG_EXP2 = 2; - {$EXTERNALSYM D3DFOG_EXP2} - D3DFOG_LINEAR = 3; - {$EXTERNALSYM D3DFOG_LINEAR} - -type - _D3DZBUFFERTYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DZBUFFERTYPE} - D3DZBUFFERTYPE = _D3DZBUFFERTYPE; - {$EXTERNALSYM D3DZBUFFERTYPE} - TD3DZBufferType = _D3DZBUFFERTYPE; - -const - D3DZB_FALSE = 0; - {$EXTERNALSYM D3DZB_FALSE} - D3DZB_TRUE = 1; - {$EXTERNALSYM D3DZB_TRUE} - D3DZB_USEW = 2; - {$EXTERNALSYM D3DZB_USEW} - -type - // Primitives supported by draw-primitive API - _D3DPRIMITIVETYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DPT_INVALID_0 {= 0}, - D3DPT_POINTLIST {= 1}, - D3DPT_LINELIST {= 2}, - D3DPT_LINESTRIP {= 3}, - D3DPT_TRIANGLELIST {= 4}, - D3DPT_TRIANGLESTRIP{= 5}, - D3DPT_TRIANGLEFAN {= 6} - {$ELSE} - D3DPT_POINTLIST = 1, - D3DPT_LINELIST = 2, - D3DPT_LINESTRIP = 3, - D3DPT_TRIANGLELIST = 4, - D3DPT_TRIANGLESTRIP = 5, - D3DPT_TRIANGLEFAN = 6 - {$ENDIF} - ); - {$EXTERNALSYM _D3DPRIMITIVETYPE} - D3DPRIMITIVETYPE = _D3DPRIMITIVETYPE; - {$EXTERNALSYM D3DPRIMITIVETYPE} - TD3DPrimitiveType = _D3DPRIMITIVETYPE; - -{$IFNDEF SUPPORTS_EXPL_ENUMS} -const - D3DTS_VIEW = 2; - {$EXTERNALSYM D3DTS_VIEW} - D3DTS_PROJECTION = 3; - {$EXTERNALSYM D3DTS_PROJECTION} - D3DTS_TEXTURE0 = 16; - {$EXTERNALSYM D3DTS_TEXTURE0} - D3DTS_TEXTURE1 = 17; - {$EXTERNALSYM D3DTS_TEXTURE1} - D3DTS_TEXTURE2 = 18; - {$EXTERNALSYM D3DTS_TEXTURE2} - D3DTS_TEXTURE3 = 19; - {$EXTERNALSYM D3DTS_TEXTURE3} - D3DTS_TEXTURE4 = 20; - {$EXTERNALSYM D3DTS_TEXTURE4} - D3DTS_TEXTURE5 = 21; - {$EXTERNALSYM D3DTS_TEXTURE5} - D3DTS_TEXTURE6 = 22; - {$EXTERNALSYM D3DTS_TEXTURE6} - D3DTS_TEXTURE7 = 23; - {$EXTERNALSYM D3DTS_TEXTURE7} - D3DTS_FORCE_DWORD = $7fffffff; (* force 32-bit size enum *) - {$EXTERNALSYM D3DTS_FORCE_DWORD} - -type - _D3DTRANSFORMSTATETYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; -{$ELSE} -type - _D3DTRANSFORMSTATETYPE = ( - D3DTS_VIEW = 2, - D3DTS_PROJECTION = 3, - D3DTS_TEXTURE0 = 16, - D3DTS_TEXTURE1 = 17, - D3DTS_TEXTURE2 = 18, - D3DTS_TEXTURE3 = 19, - D3DTS_TEXTURE4 = 20, - D3DTS_TEXTURE5 = 21, - D3DTS_TEXTURE6 = 22, - D3DTS_TEXTURE7 = 23 - ); -{$ENDIF} - {$EXTERNALSYM _D3DTRANSFORMSTATETYPE} - D3DTRANSFORMSTATETYPE = _D3DTRANSFORMSTATETYPE; - {$EXTERNALSYM D3DTRANSFORMSTATETYPE} - TD3DTransformStateType = _D3DTRANSFORMSTATETYPE; - -// #define D3DTS_WORLDMATRIX(index) (D3DTRANSFORMSTATETYPE)(index + 256) -function D3DTS_WORLDMATRIX(index: Byte): TD3DTransformStateType;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DTS_WORLDMATRIX} - -const - D3DTS_WORLD = TD3DTransformStateType(0 + 256); // #define D3DTS_WORLD D3DTS_WORLDMATRIX(0) - {$EXTERNALSYM D3DTS_WORLD} - D3DTS_WORLD1 = TD3DTransformStateType(1 + 256); // #define D3DTS_WORLD1 D3DTS_WORLDMATRIX(1) - {$EXTERNALSYM D3DTS_WORLD1} - D3DTS_WORLD2 = TD3DTransformStateType(2 + 256); // #define D3DTS_WORLD2 D3DTS_WORLDMATRIX(2) - {$EXTERNALSYM D3DTS_WORLD2} - D3DTS_WORLD3 = TD3DTransformStateType(3 + 256); // #define D3DTS_WORLD3 D3DTS_WORLDMATRIX(3) - {$EXTERNALSYM D3DTS_WORLD3} - -{$IFNDEF SUPPORTS_EXPL_ENUMS} -type - _D3DRENDERSTATETYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DRENDERSTATETYPE} - D3DRENDERSTATETYPE = _D3DRENDERSTATETYPE; - {$EXTERNALSYM D3DRENDERSTATETYPE} - TD3DRenderStateType = _D3DRENDERSTATETYPE; - -const - D3DRS_ZENABLE = TD3DRenderStateType(7); { D3DZBUFFERTYPE (or TRUE/FALSE for legacy) } - {$EXTERNALSYM D3DRS_ZENABLE} - D3DRS_FILLMODE = TD3DRenderStateType(8); { D3DFILLMODE } - {$EXTERNALSYM D3DRS_FILLMODE} - D3DRS_SHADEMODE = TD3DRenderStateType(9); { D3DSHADEMODE } - {$EXTERNALSYM D3DRS_SHADEMODE} - D3DRS_ZWRITEENABLE = TD3DRenderStateType(14); { TRUE to enable z writes } - {$EXTERNALSYM D3DRS_ZWRITEENABLE} - D3DRS_ALPHATESTENABLE = TD3DRenderStateType(15); { TRUE to enable alpha tests } - {$EXTERNALSYM D3DRS_ALPHATESTENABLE} - D3DRS_LASTPIXEL = TD3DRenderStateType(16); { TRUE for last-pixel on lines } - {$EXTERNALSYM D3DRS_LASTPIXEL} - D3DRS_SRCBLEND = TD3DRenderStateType(19); { D3DBLEND } - {$EXTERNALSYM D3DRS_SRCBLEND} - D3DRS_DESTBLEND = TD3DRenderStateType(20); { D3DBLEND } - {$EXTERNALSYM D3DRS_DESTBLEND} - D3DRS_CULLMODE = TD3DRenderStateType(22); { D3DCULL } - {$EXTERNALSYM D3DRS_CULLMODE} - D3DRS_ZFUNC = TD3DRenderStateType(23); { D3DCMPFUNC } - {$EXTERNALSYM D3DRS_ZFUNC} - D3DRS_ALPHAREF = TD3DRenderStateType(24); { D3DFIXED } - {$EXTERNALSYM D3DRS_ALPHAREF} - D3DRS_ALPHAFUNC = TD3DRenderStateType(25); { D3DCMPFUNC } - {$EXTERNALSYM D3DRS_ALPHAFUNC} - D3DRS_DITHERENABLE = TD3DRenderStateType(26); { TRUE to enable dithering } - {$EXTERNALSYM D3DRS_DITHERENABLE} - D3DRS_ALPHABLENDENABLE = TD3DRenderStateType(27); { TRUE to enable alpha blending } - {$EXTERNALSYM D3DRS_ALPHABLENDENABLE} - D3DRS_FOGENABLE = TD3DRenderStateType(28); { TRUE to enable fog blending } - {$EXTERNALSYM D3DRS_FOGENABLE} - D3DRS_SPECULARENABLE = TD3DRenderStateType(29); { TRUE to enable specular } - {$EXTERNALSYM D3DRS_SPECULARENABLE} - D3DRS_FOGCOLOR = TD3DRenderStateType(34); { D3DCOLOR } - {$EXTERNALSYM D3DRS_FOGCOLOR} - D3DRS_FOGTABLEMODE = TD3DRenderStateType(35); { D3DFOGMODE } - {$EXTERNALSYM D3DRS_FOGTABLEMODE} - D3DRS_FOGSTART = TD3DRenderStateType(36); { Fog start (for both vertex and pixel fog) } - {$EXTERNALSYM D3DRS_FOGSTART} - D3DRS_FOGEND = TD3DRenderStateType(37); { Fog end } - {$EXTERNALSYM D3DRS_FOGEND} - D3DRS_FOGDENSITY = TD3DRenderStateType(38); { Fog density } - {$EXTERNALSYM D3DRS_FOGDENSITY} - D3DRS_RANGEFOGENABLE = TD3DRenderStateType(48); { Enables range-based fog } - {$EXTERNALSYM D3DRS_RANGEFOGENABLE} - D3DRS_STENCILENABLE = TD3DRenderStateType(52); { BOOL enable/disable stenciling } - {$EXTERNALSYM D3DRS_STENCILENABLE} - D3DRS_STENCILFAIL = TD3DRenderStateType(53); { D3DSTENCILOP to do if stencil test fails } - {$EXTERNALSYM D3DRS_STENCILFAIL} - D3DRS_STENCILZFAIL = TD3DRenderStateType(54); { D3DSTENCILOP to do if stencil test passes and Z test fails } - {$EXTERNALSYM D3DRS_STENCILZFAIL} - D3DRS_STENCILPASS = TD3DRenderStateType(55); { D3DSTENCILOP to do if both stencil and Z tests pass } - {$EXTERNALSYM D3DRS_STENCILPASS} - D3DRS_STENCILFUNC = TD3DRenderStateType(56); { D3DCMPFUNC fn. Stencil Test passes if ((ref & mask) stencilfn (stencil & mask)) is true } - {$EXTERNALSYM D3DRS_STENCILFUNC} - D3DRS_STENCILREF = TD3DRenderStateType(57); { Reference value used in stencil test } - {$EXTERNALSYM D3DRS_STENCILREF} - D3DRS_STENCILMASK = TD3DRenderStateType(58); { Mask value used in stencil test } - {$EXTERNALSYM D3DRS_STENCILMASK} - D3DRS_STENCILWRITEMASK = TD3DRenderStateType(59); { Write mask applied to values written to stencil buffer } - {$EXTERNALSYM D3DRS_STENCILWRITEMASK} - D3DRS_TEXTUREFACTOR = TD3DRenderStateType(60); { D3DCOLOR used for multi-texture blend } - {$EXTERNALSYM D3DRS_TEXTUREFACTOR} - D3DRS_WRAP0 = TD3DRenderStateType(128); { wrap for 1st texture coord. set } - {$EXTERNALSYM D3DRS_WRAP0} - D3DRS_WRAP1 = TD3DRenderStateType(129); { wrap for 2nd texture coord. set } - {$EXTERNALSYM D3DRS_WRAP1} - D3DRS_WRAP2 = TD3DRenderStateType(130); { wrap for 3rd texture coord. set } - {$EXTERNALSYM D3DRS_WRAP2} - D3DRS_WRAP3 = TD3DRenderStateType(131); { wrap for 4th texture coord. set } - {$EXTERNALSYM D3DRS_WRAP3} - D3DRS_WRAP4 = TD3DRenderStateType(132); { wrap for 5th texture coord. set } - {$EXTERNALSYM D3DRS_WRAP4} - D3DRS_WRAP5 = TD3DRenderStateType(133); { wrap for 6th texture coord. set } - {$EXTERNALSYM D3DRS_WRAP5} - D3DRS_WRAP6 = TD3DRenderStateType(134); { wrap for 7th texture coord. set } - {$EXTERNALSYM D3DRS_WRAP6} - D3DRS_WRAP7 = TD3DRenderStateType(135); { wrap for 8th texture coord. set } - {$EXTERNALSYM D3DRS_WRAP7} - D3DRS_CLIPPING = TD3DRenderStateType(136); - {$EXTERNALSYM D3DRS_CLIPPING} - D3DRS_LIGHTING = TD3DRenderStateType(137); - {$EXTERNALSYM D3DRS_LIGHTING} - D3DRS_AMBIENT = TD3DRenderStateType(139); - {$EXTERNALSYM D3DRS_AMBIENT} - D3DRS_FOGVERTEXMODE = TD3DRenderStateType(140); - {$EXTERNALSYM D3DRS_FOGVERTEXMODE} - D3DRS_COLORVERTEX = TD3DRenderStateType(141); - {$EXTERNALSYM D3DRS_COLORVERTEX} - D3DRS_LOCALVIEWER = TD3DRenderStateType(142); - {$EXTERNALSYM D3DRS_LOCALVIEWER} - D3DRS_NORMALIZENORMALS = TD3DRenderStateType(143); - {$EXTERNALSYM D3DRS_NORMALIZENORMALS} - D3DRS_DIFFUSEMATERIALSOURCE = TD3DRenderStateType(145); - {$EXTERNALSYM D3DRS_DIFFUSEMATERIALSOURCE} - D3DRS_SPECULARMATERIALSOURCE = TD3DRenderStateType(146); - {$EXTERNALSYM D3DRS_SPECULARMATERIALSOURCE} - D3DRS_AMBIENTMATERIALSOURCE = TD3DRenderStateType(147); - {$EXTERNALSYM D3DRS_AMBIENTMATERIALSOURCE} - D3DRS_EMISSIVEMATERIALSOURCE = TD3DRenderStateType(148); - {$EXTERNALSYM D3DRS_EMISSIVEMATERIALSOURCE} - D3DRS_VERTEXBLEND = TD3DRenderStateType(151); - {$EXTERNALSYM D3DRS_VERTEXBLEND} - D3DRS_CLIPPLANEENABLE = TD3DRenderStateType(152); - {$EXTERNALSYM D3DRS_CLIPPLANEENABLE} - D3DRS_POINTSIZE = TD3DRenderStateType(154); { float point size } - {$EXTERNALSYM D3DRS_POINTSIZE} - D3DRS_POINTSIZE_MIN = TD3DRenderStateType(155); { float point size min threshold } - {$EXTERNALSYM D3DRS_POINTSIZE_MIN} - D3DRS_POINTSPRITEENABLE = TD3DRenderStateType(156); { BOOL point texture coord control } - {$EXTERNALSYM D3DRS_POINTSPRITEENABLE} - D3DRS_POINTSCALEENABLE = TD3DRenderStateType(157); { BOOL point size scale enable } - {$EXTERNALSYM D3DRS_POINTSCALEENABLE} - D3DRS_POINTSCALE_A = TD3DRenderStateType(158); { float point attenuation A value } - {$EXTERNALSYM D3DRS_POINTSCALE_A} - D3DRS_POINTSCALE_B = TD3DRenderStateType(159); { float point attenuation B value } - {$EXTERNALSYM D3DRS_POINTSCALE_B} - D3DRS_POINTSCALE_C = TD3DRenderStateType(160); { float point attenuation C value } - {$EXTERNALSYM D3DRS_POINTSCALE_C} - D3DRS_MULTISAMPLEANTIALIAS = TD3DRenderStateType(161); // BOOL - set to do FSAA with multisample buffer - {$EXTERNALSYM D3DRS_MULTISAMPLEANTIALIAS} - D3DRS_MULTISAMPLEMASK = TD3DRenderStateType(162); // DWORD - per-sample enable/disable - {$EXTERNALSYM D3DRS_MULTISAMPLEMASK} - D3DRS_PATCHEDGESTYLE = TD3DRenderStateType(163); // Sets whether patch edges will use float style tessellation - {$EXTERNALSYM D3DRS_PATCHEDGESTYLE} - D3DRS_DEBUGMONITORTOKEN = TD3DRenderStateType(165); // DEBUG ONLY - token to debug monitor - {$EXTERNALSYM D3DRS_DEBUGMONITORTOKEN} - D3DRS_POINTSIZE_MAX = TD3DRenderStateType(166); { float point size max threshold } - {$EXTERNALSYM D3DRS_POINTSIZE_MAX} - D3DRS_INDEXEDVERTEXBLENDENABLE = TD3DRenderStateType(167); - {$EXTERNALSYM D3DRS_INDEXEDVERTEXBLENDENABLE} - D3DRS_COLORWRITEENABLE = TD3DRenderStateType(168); // per-channel write enable - {$EXTERNALSYM D3DRS_COLORWRITEENABLE} - D3DRS_TWEENFACTOR = TD3DRenderStateType(170); // float tween factor - {$EXTERNALSYM D3DRS_TWEENFACTOR} - D3DRS_BLENDOP = TD3DRenderStateType(171); // D3DBLENDOP setting - {$EXTERNALSYM D3DRS_BLENDOP} - D3DRS_POSITIONDEGREE = TD3DRenderStateType(172); // NPatch position interpolation degree. D3DDEGREE_LINEAR or D3DDEGREE_CUBIC (default) - {$EXTERNALSYM D3DRS_POSITIONDEGREE} - D3DRS_NORMALDEGREE = TD3DRenderStateType(173); // NPatch normal interpolation degree. D3DDEGREE_LINEAR (default) or D3DDEGREE_QUADRATIC - {$EXTERNALSYM D3DRS_NORMALDEGREE} - D3DRS_SCISSORTESTENABLE = TD3DRenderStateType(174); - {$EXTERNALSYM D3DRS_SCISSORTESTENABLE} - D3DRS_SLOPESCALEDEPTHBIAS = TD3DRenderStateType(175); - {$EXTERNALSYM D3DRS_SLOPESCALEDEPTHBIAS} - D3DRS_ANTIALIASEDLINEENABLE = TD3DRenderStateType(176); - {$EXTERNALSYM D3DRS_ANTIALIASEDLINEENABLE} - D3DRS_MINTESSELLATIONLEVEL = TD3DRenderStateType(178); - {$EXTERNALSYM D3DRS_MINTESSELLATIONLEVEL} - D3DRS_MAXTESSELLATIONLEVEL = TD3DRenderStateType(179); - {$EXTERNALSYM D3DRS_MAXTESSELLATIONLEVEL} - D3DRS_ADAPTIVETESS_X = TD3DRenderStateType(180); - {$EXTERNALSYM D3DRS_ADAPTIVETESS_X} - D3DRS_ADAPTIVETESS_Y = TD3DRenderStateType(181); - {$EXTERNALSYM D3DRS_ADAPTIVETESS_Y} - D3DRS_ADAPTIVETESS_Z = TD3DRenderStateType(182); - {$EXTERNALSYM D3DRS_ADAPTIVETESS_Z} - D3DRS_ADAPTIVETESS_W = TD3DRenderStateType(183); - {$EXTERNALSYM D3DRS_ADAPTIVETESS_W} - D3DRS_ENABLEADAPTIVETESSELLATION = TD3DRenderStateType(184); - {$EXTERNALSYM D3DRS_ENABLEADAPTIVETESSELLATION} - D3DRS_TWOSIDEDSTENCILMODE = TD3DRenderStateType(185); (* BOOL enable/disable 2 sided stenciling *) - {$EXTERNALSYM D3DRS_TWOSIDEDSTENCILMODE} - D3DRS_CCW_STENCILFAIL = TD3DRenderStateType(186); (* D3DSTENCILOP to do if ccw stencil test fails *) - {$EXTERNALSYM D3DRS_CCW_STENCILFAIL} - D3DRS_CCW_STENCILZFAIL = TD3DRenderStateType(187); (* D3DSTENCILOP to do if ccw stencil test passes and Z test fails *) - {$EXTERNALSYM D3DRS_CCW_STENCILZFAIL} - D3DRS_CCW_STENCILPASS = TD3DRenderStateType(188); (* D3DSTENCILOP to do if both ccw stencil and Z tests pass *) - {$EXTERNALSYM D3DRS_CCW_STENCILPASS} - D3DRS_CCW_STENCILFUNC = TD3DRenderStateType(189); (* D3DCMPFUNC fn. ccw Stencil Test passes if ((ref & mask) stencilfn (stencil & mask)) is true *) - {$EXTERNALSYM D3DRS_CCW_STENCILFUNC} - D3DRS_COLORWRITEENABLE1 = TD3DRenderStateType(190); (* Additional ColorWriteEnables for the devices that support D3DPMISCCAPS_INDEPENDENTWRITEMASKS *) - {$EXTERNALSYM D3DRS_COLORWRITEENABLE1} - D3DRS_COLORWRITEENABLE2 = TD3DRenderStateType(191); (* Additional ColorWriteEnables for the devices that support D3DPMISCCAPS_INDEPENDENTWRITEMASKS *) - {$EXTERNALSYM D3DRS_COLORWRITEENABLE2} - D3DRS_COLORWRITEENABLE3 = TD3DRenderStateType(192); (* Additional ColorWriteEnables for the devices that support D3DPMISCCAPS_INDEPENDENTWRITEMASKS *) - {$EXTERNALSYM D3DRS_COLORWRITEENABLE3} - D3DRS_BLENDFACTOR = TD3DRenderStateType(193); (* D3DCOLOR used for a constant blend factor during alpha blending for devices that support D3DPBLENDCAPS_BLENDFACTOR *) - {$EXTERNALSYM D3DRS_BLENDFACTOR} - D3DRS_SRGBWRITEENABLE = TD3DRenderStateType(194); (* Enable rendertarget writes to be DE-linearized to SRGB (for formats that expose D3DUSAGE_QUERY_SRGBWRITE) *) - {$EXTERNALSYM D3DRS_SRGBWRITEENABLE} - D3DRS_DEPTHBIAS = TD3DRenderStateType(195); - {$EXTERNALSYM D3DRS_DEPTHBIAS} - D3DRS_WRAP8 = TD3DRenderStateType(198); (* Additional wrap states for vs_3_0+ attributes with D3DDECLUSAGE_TEXCOORD *) - {$EXTERNALSYM D3DRS_WRAP8} - D3DRS_WRAP9 = TD3DRenderStateType(199); - {$EXTERNALSYM D3DRS_WRAP9} - D3DRS_WRAP10 = TD3DRenderStateType(200); - {$EXTERNALSYM D3DRS_WRAP10} - D3DRS_WRAP11 = TD3DRenderStateType(201); - {$EXTERNALSYM D3DRS_WRAP11} - D3DRS_WRAP12 = TD3DRenderStateType(202); - {$EXTERNALSYM D3DRS_WRAP12} - D3DRS_WRAP13 = TD3DRenderStateType(203); - {$EXTERNALSYM D3DRS_WRAP13} - D3DRS_WRAP14 = TD3DRenderStateType(204); - {$EXTERNALSYM D3DRS_WRAP14} - D3DRS_WRAP15 = TD3DRenderStateType(205); - {$EXTERNALSYM D3DRS_WRAP15} - D3DRS_SEPARATEALPHABLENDENABLE = TD3DRenderStateType(206); (* TRUE to enable a separate blending function for the alpha channel *) - {$EXTERNALSYM D3DRS_SEPARATEALPHABLENDENABLE} - D3DRS_SRCBLENDALPHA = TD3DRenderStateType(207); (* SRC blend factor for the alpha channel when D3DRS_SEPARATEDESTALPHAENABLE is TRUE *) - {$EXTERNALSYM D3DRS_SRCBLENDALPHA} - D3DRS_DESTBLENDALPHA = TD3DRenderStateType(208); (* DST blend factor for the alpha channel when D3DRS_SEPARATEDESTALPHAENABLE is TRUE *) - {$EXTERNALSYM D3DRS_DESTBLENDALPHA} - D3DRS_BLENDOPALPHA = TD3DRenderStateType(209); (* Blending operation for the alpha channel when D3DRS_SEPARATEDESTALPHAENABLE is TRUE *) - {$EXTERNALSYM D3DRS_BLENDOPALPHA} - - - D3DRS_FORCE_DWORD = TD3DRenderStateType($7fffffff); { force 32-bit size enum } - {$EXTERNALSYM D3DRS_FORCE_DWORD} -{$ELSE} -type - _D3DRENDERSTATETYPE = ( - D3DRS_ZENABLE = 7, (* D3DZBUFFERTYPE (or TRUE/FALSE for legacy) *) - D3DRS_FILLMODE = 8, (* D3DFILLMODE *) - D3DRS_SHADEMODE = 9, (* D3DSHADEMODE *) - D3DRS_ZWRITEENABLE = 14, (* TRUE to enable z writes *) - D3DRS_ALPHATESTENABLE = 15, (* TRUE to enable alpha tests *) - D3DRS_LASTPIXEL = 16, (* TRUE for last-pixel on lines *) - D3DRS_SRCBLEND = 19, (* D3DBLEND *) - D3DRS_DESTBLEND = 20, (* D3DBLEND *) - D3DRS_CULLMODE = 22, (* D3DCULL *) - D3DRS_ZFUNC = 23, (* D3DCMPFUNC *) - D3DRS_ALPHAREF = 24, (* D3DFIXED *) - D3DRS_ALPHAFUNC = 25, (* D3DCMPFUNC *) - D3DRS_DITHERENABLE = 26, (* TRUE to enable dithering *) - D3DRS_ALPHABLENDENABLE = 27, (* TRUE to enable alpha blending *) - D3DRS_FOGENABLE = 28, (* TRUE to enable fog blending *) - D3DRS_SPECULARENABLE = 29, (* TRUE to enable specular *) - D3DRS_FOGCOLOR = 34, (* D3DCOLOR *) - D3DRS_FOGTABLEMODE = 35, (* D3DFOGMODE *) - D3DRS_FOGSTART = 36, (* Fog start (for both vertex and pixel fog) *) - D3DRS_FOGEND = 37, (* Fog end *) - D3DRS_FOGDENSITY = 38, (* Fog density *) - D3DRS_RANGEFOGENABLE = 48, (* Enables range-based fog *) - D3DRS_STENCILENABLE = 52, (* BOOL enable/disable stenciling *) - D3DRS_STENCILFAIL = 53, (* D3DSTENCILOP to do if stencil test fails *) - D3DRS_STENCILZFAIL = 54, (* D3DSTENCILOP to do if stencil test passes and Z test fails *) - D3DRS_STENCILPASS = 55, (* D3DSTENCILOP to do if both stencil and Z tests pass *) - D3DRS_STENCILFUNC = 56, (* D3DCMPFUNC fn. Stencil Test passes if ((ref & mask) stencilfn (stencil & mask)) is true *) - D3DRS_STENCILREF = 57, (* Reference value used in stencil test *) - D3DRS_STENCILMASK = 58, (* Mask value used in stencil test *) - D3DRS_STENCILWRITEMASK = 59, (* Write mask applied to values written to stencil buffer *) - D3DRS_TEXTUREFACTOR = 60, (* D3DCOLOR used for multi-texture blend *) - D3DRS_WRAP0 = 128, (* wrap for 1st texture coord. set *) - D3DRS_WRAP1 = 129, (* wrap for 2nd texture coord. set *) - D3DRS_WRAP2 = 130, (* wrap for 3rd texture coord. set *) - D3DRS_WRAP3 = 131, (* wrap for 4th texture coord. set *) - D3DRS_WRAP4 = 132, (* wrap for 5th texture coord. set *) - D3DRS_WRAP5 = 133, (* wrap for 6th texture coord. set *) - D3DRS_WRAP6 = 134, (* wrap for 7th texture coord. set *) - D3DRS_WRAP7 = 135, (* wrap for 8th texture coord. set *) - D3DRS_CLIPPING = 136, - D3DRS_LIGHTING = 137, - D3DRS_AMBIENT = 139, - D3DRS_FOGVERTEXMODE = 140, - D3DRS_COLORVERTEX = 141, - D3DRS_LOCALVIEWER = 142, - D3DRS_NORMALIZENORMALS = 143, - D3DRS_DIFFUSEMATERIALSOURCE = 145, - D3DRS_SPECULARMATERIALSOURCE = 146, - D3DRS_AMBIENTMATERIALSOURCE = 147, - D3DRS_EMISSIVEMATERIALSOURCE = 148, - D3DRS_VERTEXBLEND = 151, - D3DRS_CLIPPLANEENABLE = 152, - D3DRS_POINTSIZE = 154, (* float point size *) - D3DRS_POINTSIZE_MIN = 155, (* float point size min threshold *) - D3DRS_POINTSPRITEENABLE = 156, (* BOOL point texture coord control *) - D3DRS_POINTSCALEENABLE = 157, (* BOOL point size scale enable *) - D3DRS_POINTSCALE_A = 158, (* float point attenuation A value *) - D3DRS_POINTSCALE_B = 159, (* float point attenuation B value *) - D3DRS_POINTSCALE_C = 160, (* float point attenuation C value *) - D3DRS_MULTISAMPLEANTIALIAS = 161, // BOOL - set to do FSAA with multisample buffer - D3DRS_MULTISAMPLEMASK = 162, // DWORD - per-sample enable/disable - D3DRS_PATCHEDGESTYLE = 163, // Sets whether patch edges will use float style tessellation - D3DRS_DEBUGMONITORTOKEN = 165, // DEBUG ONLY - token to debug monitor - D3DRS_POINTSIZE_MAX = 166, (* float point size max threshold *) - D3DRS_INDEXEDVERTEXBLENDENABLE = 167, - D3DRS_COLORWRITEENABLE = 168, // per-channel write enable - D3DRS_TWEENFACTOR = 170, // float tween factor - D3DRS_BLENDOP = 171, // D3DBLENDOP setting - D3DRS_POSITIONDEGREE = 172, // NPatch position interpolation degree. D3DDEGREE_LINEAR or D3DDEGREE_CUBIC (default) - D3DRS_NORMALDEGREE = 173, // NPatch normal interpolation degree. D3DDEGREE_LINEAR (default) or D3DDEGREE_QUADRATIC - D3DRS_SCISSORTESTENABLE = 174, - D3DRS_SLOPESCALEDEPTHBIAS = 175, - D3DRS_ANTIALIASEDLINEENABLE = 176, - - D3DRS_MINTESSELLATIONLEVEL = 178, - D3DRS_MAXTESSELLATIONLEVEL = 179, - D3DRS_ADAPTIVETESS_X = 180, - D3DRS_ADAPTIVETESS_Y = 181, - D3DRS_ADAPTIVETESS_Z = 182, - D3DRS_ADAPTIVETESS_W = 183, - D3DRS_ENABLEADAPTIVETESSELLATION = 184, - D3DRS_TWOSIDEDSTENCILMODE = 185, (* BOOL enable/disable 2 sided stenciling *) - D3DRS_CCW_STENCILFAIL = 186, (* D3DSTENCILOP to do if ccw stencil test fails *) - D3DRS_CCW_STENCILZFAIL = 187, (* D3DSTENCILOP to do if ccw stencil test passes and Z test fails *) - D3DRS_CCW_STENCILPASS = 188, (* D3DSTENCILOP to do if both ccw stencil and Z tests pass *) - D3DRS_CCW_STENCILFUNC = 189, (* D3DCMPFUNC fn. ccw Stencil Test passes if ((ref & mask) stencilfn (stencil & mask)) is true *) - D3DRS_COLORWRITEENABLE1 = 190, (* Additional ColorWriteEnables for the devices that support D3DPMISCCAPS_INDEPENDENTWRITEMASKS *) - D3DRS_COLORWRITEENABLE2 = 191, (* Additional ColorWriteEnables for the devices that support D3DPMISCCAPS_INDEPENDENTWRITEMASKS *) - D3DRS_COLORWRITEENABLE3 = 192, (* Additional ColorWriteEnables for the devices that support D3DPMISCCAPS_INDEPENDENTWRITEMASKS *) - D3DRS_BLENDFACTOR = 193, (* D3DCOLOR used for a constant blend factor during alpha blending for devices that support D3DPBLENDCAPS_BLENDFACTOR *) - D3DRS_SRGBWRITEENABLE = 194, (* Enable rendertarget writes to be DE-linearized to SRGB (for formats that expose D3DUSAGE_QUERY_SRGBWRITE) *) - D3DRS_DEPTHBIAS = 195, - D3DRS_WRAP8 = 198, (* Additional wrap states for vs_3_0+ attributes with D3DDECLUSAGE_TEXCOORD *) - D3DRS_WRAP9 = 199, - D3DRS_WRAP10 = 200, - D3DRS_WRAP11 = 201, - D3DRS_WRAP12 = 202, - D3DRS_WRAP13 = 203, - D3DRS_WRAP14 = 204, - D3DRS_WRAP15 = 205, - D3DRS_SEPARATEALPHABLENDENABLE = 206, (* TRUE to enable a separate blending function for the alpha channel *) - D3DRS_SRCBLENDALPHA = 207, (* SRC blend factor for the alpha channel when D3DRS_SEPARATEDESTALPHAENABLE is TRUE *) - D3DRS_DESTBLENDALPHA = 208, (* DST blend factor for the alpha channel when D3DRS_SEPARATEDESTALPHAENABLE is TRUE *) - D3DRS_BLENDOPALPHA = 209 (* Blending operation for the alpha channel when D3DRS_SEPARATEDESTALPHAENABLE is TRUE *) - ); - {$EXTERNALSYM _D3DRENDERSTATETYPE} - D3DRENDERSTATETYPE = _D3DRENDERSTATETYPE; - {$EXTERNALSYM D3DRENDERSTATETYPE} - TD3DRenderStateType = _D3DRENDERSTATETYPE; -{$ENDIF} - -const - // Maximum number of simultaneous render targets D3D supports - D3D_MAX_SIMULTANEOUS_RENDERTARGETS = 4; - {$EXTERNALSYM D3D_MAX_SIMULTANEOUS_RENDERTARGETS} - -type - // Values for material source - _D3DMATERIALCOLORSOURCE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DMATERIALCOLORSOURCE} - D3DMATERIALCOLORSOURCE = _D3DMATERIALCOLORSOURCE; - {$EXTERNALSYM D3DMATERIALCOLORSOURCE} - TD3DMaterialSource = _D3DMATERIALCOLORSOURCE; - -const - D3DMCS_MATERIAL = TD3DMaterialSource(0); // Color from material is used - {$EXTERNALSYM D3DMCS_MATERIAL} - D3DMCS_COLOR1 = TD3DMaterialSource(1); // Diffuse vertex color is used - {$EXTERNALSYM D3DMCS_COLOR1} - D3DMCS_COLOR2 = TD3DMaterialSource(2); // Specular vertex color is used - {$EXTERNALSYM D3DMCS_COLOR2} - D3DMCS_FORCE_DWORD = TD3DMaterialSource($7fffffff); // force 32-bit size enum - {$EXTERNALSYM D3DMCS_FORCE_DWORD} - - // Bias to apply to the texture coordinate set to apply a wrap to. - D3DRENDERSTATE_WRAPBIAS = DWORD(128); - {$EXTERNALSYM D3DRENDERSTATE_WRAPBIAS} - - { Flags to construct the WRAP render states } - D3DWRAP_U = $00000001; - {$EXTERNALSYM D3DWRAP_U} - D3DWRAP_V = $00000002; - {$EXTERNALSYM D3DWRAP_V} - D3DWRAP_W = $00000004; - {$EXTERNALSYM D3DWRAP_W} - - { Flags to construct the WRAP render states for 1D thru 4D texture coordinates } - D3DWRAPCOORD_0 = $00000001; // same as D3DWRAP_U - {$EXTERNALSYM D3DWRAPCOORD_0} - D3DWRAPCOORD_1 = $00000002; // same as D3DWRAP_V - {$EXTERNALSYM D3DWRAPCOORD_1} - D3DWRAPCOORD_2 = $00000004; // same as D3DWRAP_W - {$EXTERNALSYM D3DWRAPCOORD_2} - D3DWRAPCOORD_3 = $00000008; - {$EXTERNALSYM D3DWRAPCOORD_3} - - { Flags to construct D3DRS_COLORWRITEENABLE } - D3DCOLORWRITEENABLE_RED = (1 shl 0); - {$EXTERNALSYM D3DCOLORWRITEENABLE_RED} - D3DCOLORWRITEENABLE_GREEN = (1 shl 1); - {$EXTERNALSYM D3DCOLORWRITEENABLE_GREEN} - D3DCOLORWRITEENABLE_BLUE = (1 shl 2); - {$EXTERNALSYM D3DCOLORWRITEENABLE_BLUE} - D3DCOLORWRITEENABLE_ALPHA = (1 shl 3); - {$EXTERNALSYM D3DCOLORWRITEENABLE_ALPHA} - -(* - * State enumerants for per-stage processing of fixed function pixel processing - * Two of these affect fixed function vertex processing as well: TEXTURETRANSFORMFLAGS and TEXCOORDINDEX. - *) -{$IFNDEF SUPPORTS_EXPL_ENUMS} -type - _D3DTEXTURESTAGESTATETYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DTEXTURESTAGESTATETYPE} - D3DTEXTURESTAGESTATETYPE = _D3DTEXTURESTAGESTATETYPE; - {$EXTERNALSYM D3DTEXTURESTAGESTATETYPE} - TD3DTextureStageStateType = _D3DTEXTURESTAGESTATETYPE; - -const - D3DTSS_COLOROP = TD3DTextureStageStateType( 1); { D3DTEXTUREOP - per-stage blending controls for color channels } - {$EXTERNALSYM D3DTSS_COLOROP} - D3DTSS_COLORARG1 = TD3DTextureStageStateType( 2); { D3DTA_* (texture arg) } - {$EXTERNALSYM D3DTSS_COLORARG1} - D3DTSS_COLORARG2 = TD3DTextureStageStateType( 3); { D3DTA_* (texture arg) } - {$EXTERNALSYM D3DTSS_COLORARG2} - D3DTSS_ALPHAOP = TD3DTextureStageStateType( 4); { D3DTEXTUREOP - per-stage blending controls for alpha channel } - {$EXTERNALSYM D3DTSS_ALPHAOP} - D3DTSS_ALPHAARG1 = TD3DTextureStageStateType( 5); { D3DTA_* (texture arg) } - {$EXTERNALSYM D3DTSS_ALPHAARG1} - D3DTSS_ALPHAARG2 = TD3DTextureStageStateType( 6); { D3DTA_* (texture arg) } - {$EXTERNALSYM D3DTSS_ALPHAARG2} - D3DTSS_BUMPENVMAT00 = TD3DTextureStageStateType( 7); { float (bump mapping matrix) } - {$EXTERNALSYM D3DTSS_BUMPENVMAT00} - D3DTSS_BUMPENVMAT01 = TD3DTextureStageStateType( 8); { float (bump mapping matrix) } - {$EXTERNALSYM D3DTSS_BUMPENVMAT01} - D3DTSS_BUMPENVMAT10 = TD3DTextureStageStateType( 9); { float (bump mapping matrix) } - {$EXTERNALSYM D3DTSS_BUMPENVMAT10} - D3DTSS_BUMPENVMAT11 = TD3DTextureStageStateType(10); { float (bump mapping matrix) } - {$EXTERNALSYM D3DTSS_BUMPENVMAT11} - D3DTSS_TEXCOORDINDEX = TD3DTextureStageStateType(11); { identifies which set of texture coordinates index this texture } - {$EXTERNALSYM D3DTSS_TEXCOORDINDEX} - D3DTSS_BUMPENVLSCALE = TD3DTextureStageStateType(22); { float scale for bump map luminance } - {$EXTERNALSYM D3DTSS_BUMPENVLSCALE} - D3DTSS_BUMPENVLOFFSET = TD3DTextureStageStateType(23); { float offset for bump map luminance } - {$EXTERNALSYM D3DTSS_BUMPENVLOFFSET} - D3DTSS_TEXTURETRANSFORMFLAGS = TD3DTextureStageStateType(24); { D3DTEXTURETRANSFORMFLAGS controls texture transform } - {$EXTERNALSYM D3DTSS_TEXTURETRANSFORMFLAGS} - D3DTSS_COLORARG0 = TD3DTextureStageStateType(26); { D3DTA_* third arg for triadic ops } - {$EXTERNALSYM D3DTSS_COLORARG0} - D3DTSS_ALPHAARG0 = TD3DTextureStageStateType(27); { D3DTA_* third arg for triadic ops } - {$EXTERNALSYM D3DTSS_ALPHAARG0} - D3DTSS_RESULTARG = TD3DTextureStageStateType(28); { D3DTA_* arg for result (CURRENT or TEMP) } - {$EXTERNALSYM D3DTSS_RESULTARG} - D3DTSS_CONSTANT = TD3DTextureStageStateType(32); { Per-stage constant D3DTA_CONSTANT } - {$EXTERNALSYM D3DTSS_CONSTANT} - - D3DTSS_FORCE_DWORD = TD3DTextureStageStateType($7fffffff); { force 32-bit size enum } - {$EXTERNALSYM D3DTSS_FORCE_DWORD} -{$ELSE} -type - _D3DTEXTURESTAGESTATETYPE = ( - D3DTSS_COLOROP = 1, { D3DTEXTUREOP - per-stage blending controls for color channels } - D3DTSS_COLORARG1 = 2, { D3DTA_* (texture arg) } - D3DTSS_COLORARG2 = 3, { D3DTA_* (texture arg) } - D3DTSS_ALPHAOP = 4, { D3DTEXTUREOP - per-stage blending controls for alpha channel } - D3DTSS_ALPHAARG1 = 5, { D3DTA_* (texture arg) } - D3DTSS_ALPHAARG2 = 6, { D3DTA_* (texture arg) } - D3DTSS_BUMPENVMAT00 = 7, { float (bump mapping matrix) } - D3DTSS_BUMPENVMAT01 = 8, { float (bump mapping matrix) } - D3DTSS_BUMPENVMAT10 = 9, { float (bump mapping matrix) } - D3DTSS_BUMPENVMAT11 = 10, { float (bump mapping matrix) } - D3DTSS_TEXCOORDINDEX = 11, { identifies which set of texture coordinates index this texture } - D3DTSS_BUMPENVLSCALE = 22, { float scale for bump map luminance } - D3DTSS_BUMPENVLOFFSET = 23, { float offset for bump map luminance } - D3DTSS_TEXTURETRANSFORMFLAGS = 24, { D3DTEXTURETRANSFORMFLAGS controls texture transform } - D3DTSS_COLORARG0 = 26, { D3DTA_* third arg for triadic ops } - D3DTSS_ALPHAARG0 = 27, { D3DTA_* third arg for triadic ops } - D3DTSS_RESULTARG = 28, { D3DTA_* arg for result (CURRENT or TEMP) } - D3DTSS_CONSTANT = 32 { Per-stage constant D3DTA_CONSTANT } - ); - {$EXTERNALSYM _D3DTEXTURESTAGESTATETYPE} - D3DTEXTURESTAGESTATETYPE = _D3DTEXTURESTAGESTATETYPE; - {$EXTERNALSYM D3DTEXTURESTAGESTATETYPE} - TD3DTextureStageStateType = _D3DTEXTURESTAGESTATETYPE; -{$ENDIF} - -type -(* - * State enumerants for per-sampler texture processing. - *) - _D3DSAMPLERSTATETYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DSAMP_invalid_0 {= 0}, - D3DSAMP_ADDRESSU {= 1}, { D3DTEXTUREADDRESS for U coordinate } - D3DSAMP_ADDRESSV {= 2}, { D3DTEXTUREADDRESS for V coordinate } - D3DSAMP_ADDRESSW {= 3}, { D3DTEXTUREADDRESS for W coordinate } - D3DSAMP_BORDERCOLOR {= 4}, { D3DCOLOR } - D3DSAMP_MAGFILTER {= 5}, { D3DTEXTUREFILTER filter to use for magnification } - D3DSAMP_MINFILTER {= 6}, { D3DTEXTUREFILTER filter to use for minification } - D3DSAMP_MIPFILTER {= 7}, { D3DTEXTUREFILTER filter to use between mipmaps during minification } - D3DSAMP_MIPMAPLODBIAS {= 8}, { float Mipmap LOD bias } - D3DSAMP_MAXMIPLEVEL {= 9}, { DWORD 0..(n-1) LOD index of largest map to use (0 == largest) } - D3DSAMP_MAXANISOTROPY {= 10}, { DWORD maximum anisotropy } - D3DSAMP_SRGBTEXTURE {= 11}, { Default = 0 (which means Gamma 1.0, - no correction required.) else correct for - Gamma = 2.2 } - D3DSAMP_ELEMENTINDEX {= 12}, { When multi-element texture is assigned to sampler, this - indicates which element index to use. Default = 0. } - D3DSAMP_DMAPOFFSET {= 13} { Offset in vertices in the pre-sampled displacement map. - Only valid for D3DDMAPSAMPLER sampler } - {$ELSE} - D3DSAMP_ADDRESSU = 1, { D3DTEXTUREADDRESS for U coordinate } - D3DSAMP_ADDRESSV = 2, { D3DTEXTUREADDRESS for V coordinate } - D3DSAMP_ADDRESSW = 3, { D3DTEXTUREADDRESS for W coordinate } - D3DSAMP_BORDERCOLOR = 4, { D3DCOLOR } - D3DSAMP_MAGFILTER = 5, { D3DTEXTUREFILTER filter to use for magnification } - D3DSAMP_MINFILTER = 6, { D3DTEXTUREFILTER filter to use for minification } - D3DSAMP_MIPFILTER = 7, { D3DTEXTUREFILTER filter to use between mipmaps during minification } - D3DSAMP_MIPMAPLODBIAS = 8, { float Mipmap LOD bias } - D3DSAMP_MAXMIPLEVEL = 9, { DWORD 0..(n-1) LOD index of largest map to use (0 == largest) } - D3DSAMP_MAXANISOTROPY = 10, { DWORD maximum anisotropy } - D3DSAMP_SRGBTEXTURE = 11, { Default = 0 (which means Gamma 1.0, - no correction required.) else correct for - Gamma = 2.2 } - D3DSAMP_ELEMENTINDEX = 12, { When multi-element texture is assigned to sampler, this - indicates which element index to use. Default = 0. } - D3DSAMP_DMAPOFFSET = 13 { Offset in vertices in the pre-sampled displacement map. - Only valid for D3DDMAPSAMPLER sampler } - {$ENDIF} - ); - {$EXTERNALSYM _D3DSAMPLERSTATETYPE} - D3DSAMPLERSTATETYPE = _D3DSAMPLERSTATETYPE; - {$EXTERNALSYM D3DSAMPLERSTATETYPE} - TD3DSamplerStateType = _D3DSAMPLERSTATETYPE; - -const - { Special sampler which is used in the tesselator } - D3DDMAPSAMPLER = 256; - {$EXTERNALSYM D3DDMAPSAMPLER} - - // Samplers used in vertex shaders - D3DVERTEXTEXTURESAMPLER0 = (D3DDMAPSAMPLER+1); - {$EXTERNALSYM D3DVERTEXTEXTURESAMPLER0} - D3DVERTEXTEXTURESAMPLER1 = (D3DDMAPSAMPLER+2); - {$EXTERNALSYM D3DVERTEXTEXTURESAMPLER1} - D3DVERTEXTEXTURESAMPLER2 = (D3DDMAPSAMPLER+3); - {$EXTERNALSYM D3DVERTEXTEXTURESAMPLER2} - D3DVERTEXTEXTURESAMPLER3 = (D3DDMAPSAMPLER+4); - {$EXTERNALSYM D3DVERTEXTEXTURESAMPLER3} - - // Values, used with D3DTSS_TEXCOORDINDEX, to specify that the vertex data(position - // and normal in the camera space) should be taken as texture coordinates - // Low 16 bits are used to specify texture coordinate index, to take the WRAP mode from - // - D3DTSS_TCI_PASSTHRU = $00000000; - {$EXTERNALSYM D3DTSS_TCI_PASSTHRU} - D3DTSS_TCI_CAMERASPACENORMAL = $00010000; - {$EXTERNALSYM D3DTSS_TCI_CAMERASPACENORMAL} - D3DTSS_TCI_CAMERASPACEPOSITION = $00020000; - {$EXTERNALSYM D3DTSS_TCI_CAMERASPACEPOSITION} - D3DTSS_TCI_CAMERASPACEREFLECTIONVECTOR = $00030000; - {$EXTERNALSYM D3DTSS_TCI_CAMERASPACEREFLECTIONVECTOR} - D3DTSS_TCI_SPHEREMAP = $00040000; - {$EXTERNALSYM D3DTSS_TCI_SPHEREMAP} - -(* - * Enumerations for COLOROP and ALPHAOP texture blending operations set in - * texture processing stage controls in D3DTSS. - *) -type - _D3DTEXTUREOP = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DTEXTUREOP} - D3DTEXTUREOP = _D3DTEXTUREOP; - {$EXTERNALSYM D3DTEXTUREOP} - TD3DTextureOp = _D3DTEXTUREOP; - -const - // Control - D3DTOP_DISABLE = 1; // disables stage - {$EXTERNALSYM D3DTOP_DISABLE} - D3DTOP_SELECTARG1 = 2; // the default - {$EXTERNALSYM D3DTOP_SELECTARG1} - D3DTOP_SELECTARG2 = 3; - {$EXTERNALSYM D3DTOP_SELECTARG2} - - // Modulate - D3DTOP_MODULATE = 4; // multiply args together - {$EXTERNALSYM D3DTOP_MODULATE} - D3DTOP_MODULATE2X = 5; // multiply and 1 bit - {$EXTERNALSYM D3DTOP_MODULATE2X} - D3DTOP_MODULATE4X = 6; // multiply and 2 bits - {$EXTERNALSYM D3DTOP_MODULATE4X} - - // Add - D3DTOP_ADD = 7; // add arguments together - {$EXTERNALSYM D3DTOP_ADD} - D3DTOP_ADDSIGNED = 8; // add with -0.5 bias - {$EXTERNALSYM D3DTOP_ADDSIGNED} - D3DTOP_ADDSIGNED2X = 9; // as above but left 1 bit - {$EXTERNALSYM D3DTOP_ADDSIGNED2X} - D3DTOP_SUBTRACT = 10; // Arg1 - Arg2, with no saturation - {$EXTERNALSYM D3DTOP_SUBTRACT} - D3DTOP_ADDSMOOTH = 11; // add 2 args, subtract product - // Arg1 + Arg2 - Arg1*Arg2 - // = Arg1 + (1-Arg1)*Arg2 - {$EXTERNALSYM D3DTOP_ADDSMOOTH} - - // Linear alpha blend: Arg1*(Alpha) + Arg2*(1-Alpha) - D3DTOP_BLENDDIFFUSEALPHA = 12; // iterated alpha - {$EXTERNALSYM D3DTOP_BLENDDIFFUSEALPHA} - D3DTOP_BLENDTEXTUREALPHA = 13; // texture alpha - {$EXTERNALSYM D3DTOP_BLENDTEXTUREALPHA} - D3DTOP_BLENDFACTORALPHA = 14; // alpha from D3DRS_TEXTUREFACTOR - {$EXTERNALSYM D3DTOP_BLENDFACTORALPHA} - - // Linear alpha blend with pre-multiplied arg1 input: Arg1 + Arg2*(1-Alpha) - D3DTOP_BLENDTEXTUREALPHAPM = 15; // texture alpha - {$EXTERNALSYM D3DTOP_BLENDTEXTUREALPHAPM} - D3DTOP_BLENDCURRENTALPHA = 16; // by alpha of current color - {$EXTERNALSYM D3DTOP_BLENDCURRENTALPHA} - - // Specular mapping - D3DTOP_PREMODULATE = 17; // modulate with next texture before use - {$EXTERNALSYM D3DTOP_PREMODULATE} - D3DTOP_MODULATEALPHA_ADDCOLOR = 18; // Arg1.RGB + Arg1.A*Arg2.RGB - // COLOROP only - {$EXTERNALSYM D3DTOP_MODULATEALPHA_ADDCOLOR} - D3DTOP_MODULATECOLOR_ADDALPHA = 19; // Arg1.RGB*Arg2.RGB + Arg1.A - // COLOROP only - {$EXTERNALSYM D3DTOP_MODULATECOLOR_ADDALPHA} - D3DTOP_MODULATEINVALPHA_ADDCOLOR = 20; // (1-Arg1.A)*Arg2.RGB + Arg1.RGB - // COLOROP only - {$EXTERNALSYM D3DTOP_MODULATEINVALPHA_ADDCOLOR} - D3DTOP_MODULATEINVCOLOR_ADDALPHA = 21; // (1-Arg1.RGB)*Arg2.RGB + Arg1.A - // COLOROP only - {$EXTERNALSYM D3DTOP_MODULATEINVCOLOR_ADDALPHA} - - // Bump mapping - D3DTOP_BUMPENVMAP = 22; // per pixel env map perturbation - {$EXTERNALSYM D3DTOP_BUMPENVMAP} - D3DTOP_BUMPENVMAPLUMINANCE = 23; // with luminance channel - {$EXTERNALSYM D3DTOP_BUMPENVMAPLUMINANCE} - - // This can do either diffuse or specular bump mapping with correct input. - // Performs the function (Arg1.R*Arg2.R + Arg1.G*Arg2.G + Arg1.B*Arg2.B) - // where each component has been scaled and offset to make it signed. - // The result is replicated into all four (including alpha) channels. - // This is a valid COLOROP only. - D3DTOP_DOTPRODUCT3 = 24; - {$EXTERNALSYM D3DTOP_DOTPRODUCT3} - - // Triadic ops - D3DTOP_MULTIPLYADD = 25; // Arg0 + Arg1*Arg2 - {$EXTERNALSYM D3DTOP_MULTIPLYADD} - D3DTOP_LERP = 26; // (Arg0)*Arg1 + (1-Arg0)*Arg2 - {$EXTERNALSYM D3DTOP_LERP} - -(* - * Values for COLORARG0,1,2, ALPHAARG0,1,2, and RESULTARG texture blending - * operations set in texture processing stage controls in D3DRENDERSTATE. - *) -const - D3DTA_SELECTMASK = $0000000f; // mask for arg selector - {$EXTERNALSYM D3DTA_SELECTMASK} - D3DTA_DIFFUSE = $00000000; // select diffuse color (read only) - {$EXTERNALSYM D3DTA_DIFFUSE} - D3DTA_CURRENT = $00000001; // select stage destination register (read/write) - {$EXTERNALSYM D3DTA_CURRENT} - D3DTA_TEXTURE = $00000002; // select texture color (read only) - {$EXTERNALSYM D3DTA_TEXTURE} - D3DTA_TFACTOR = $00000003; // select D3DRS_TEXTUREFACTOR (read only) - {$EXTERNALSYM D3DTA_TFACTOR} - D3DTA_SPECULAR = $00000004; // select specular color (read only) - {$EXTERNALSYM D3DTA_SPECULAR} - D3DTA_TEMP = $00000005; // select temporary register color (read/write) - {$EXTERNALSYM D3DTA_TEMP} - D3DTA_CONSTANT = $00000006; // select texture stage constant - {$EXTERNALSYM D3DTA_CONSTANT} - D3DTA_COMPLEMENT = $00000010; // take 1.0 - x (read modifier) - {$EXTERNALSYM D3DTA_COMPLEMENT} - D3DTA_ALPHAREPLICATE = $00000020; // replicate alpha to color components (read modifier) - {$EXTERNALSYM D3DTA_ALPHAREPLICATE} - -type - // - // Values for D3DSAMP_***FILTER texture stage states - // - _D3DTEXTUREFILTERTYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DTEXTUREFILTERTYPE} - D3DTEXTUREFILTERTYPE = _D3DTEXTUREFILTERTYPE; - {$EXTERNALSYM D3DTEXTUREFILTERTYPE} - TD3DTextureFilterType = _D3DTEXTUREFILTERTYPE; - -const - D3DTEXF_NONE = 0; // filtering disabled (valid for mip filter only) - {$EXTERNALSYM D3DTEXF_NONE} - D3DTEXF_POINT = 1; // nearest - {$EXTERNALSYM D3DTEXF_POINT} - D3DTEXF_LINEAR = 2; // linear interpolation - {$EXTERNALSYM D3DTEXF_LINEAR} - D3DTEXF_ANISOTROPIC = 3; // anisotropic - {$EXTERNALSYM D3DTEXF_ANISOTROPIC} - D3DTEXF_PYRAMIDALQUAD = 6; // 4-sample tent - {$EXTERNALSYM D3DTEXF_PYRAMIDALQUAD} - D3DTEXF_GAUSSIANQUAD = 7; // 4-sample gaussian - {$EXTERNALSYM D3DTEXF_GAUSSIANQUAD} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DTEXF_CONVOLUTIONMONO = 8; // Convolution filter for monochrome textures - {$EXTERNALSYM D3DTEXF_CONVOLUTIONMONO} -{$ENDIF} - -const - { Bits for Flags in ProcessVertices call } - D3DPV_DONOTCOPYDATA = (1 shl 0); - {$EXTERNALSYM D3DPV_DONOTCOPYDATA} - -//------------------------------------------------------------------- - - // Flexible vertex format bits - // - D3DFVF_RESERVED0 = $001; - {$EXTERNALSYM D3DFVF_RESERVED0} - D3DFVF_POSITION_MASK = $400E; - {$EXTERNALSYM D3DFVF_POSITION_MASK} - D3DFVF_XYZ = $002; - {$EXTERNALSYM D3DFVF_XYZ} - D3DFVF_XYZRHW = $004; - {$EXTERNALSYM D3DFVF_XYZRHW} - D3DFVF_XYZB1 = $006; - {$EXTERNALSYM D3DFVF_XYZB1} - D3DFVF_XYZB2 = $008; - {$EXTERNALSYM D3DFVF_XYZB2} - D3DFVF_XYZB3 = $00a; - {$EXTERNALSYM D3DFVF_XYZB3} - D3DFVF_XYZB4 = $00c; - {$EXTERNALSYM D3DFVF_XYZB4} - D3DFVF_XYZB5 = $00e; - {$EXTERNALSYM D3DFVF_XYZB5} - D3DFVF_XYZW = $4002; - {$EXTERNALSYM D3DFVF_XYZW} - - D3DFVF_NORMAL = $010; - {$EXTERNALSYM D3DFVF_NORMAL} - D3DFVF_PSIZE = $020; - {$EXTERNALSYM D3DFVF_PSIZE} - D3DFVF_DIFFUSE = $040; - {$EXTERNALSYM D3DFVF_DIFFUSE} - D3DFVF_SPECULAR = $080; - {$EXTERNALSYM D3DFVF_SPECULAR} - - D3DFVF_TEXCOUNT_MASK = $f00; - {$EXTERNALSYM D3DFVF_TEXCOUNT_MASK} - D3DFVF_TEXCOUNT_SHIFT = 8; - {$EXTERNALSYM D3DFVF_TEXCOUNT_SHIFT} - D3DFVF_TEX0 = $000; - {$EXTERNALSYM D3DFVF_TEX0} - D3DFVF_TEX1 = $100; - {$EXTERNALSYM D3DFVF_TEX1} - D3DFVF_TEX2 = $200; - {$EXTERNALSYM D3DFVF_TEX2} - D3DFVF_TEX3 = $300; - {$EXTERNALSYM D3DFVF_TEX3} - D3DFVF_TEX4 = $400; - {$EXTERNALSYM D3DFVF_TEX4} - D3DFVF_TEX5 = $500; - {$EXTERNALSYM D3DFVF_TEX5} - D3DFVF_TEX6 = $600; - {$EXTERNALSYM D3DFVF_TEX6} - D3DFVF_TEX7 = $700; - {$EXTERNALSYM D3DFVF_TEX7} - D3DFVF_TEX8 = $800; - {$EXTERNALSYM D3DFVF_TEX8} - - D3DFVF_LASTBETA_UBYTE4 = $1000; - {$EXTERNALSYM D3DFVF_LASTBETA_UBYTE4} - D3DFVF_LASTBETA_D3DCOLOR = $8000; - {$EXTERNALSYM D3DFVF_LASTBETA_D3DCOLOR} - - D3DFVF_RESERVED2 = $6000; // 2 reserved bits - {$EXTERNALSYM D3DFVF_RESERVED2} - -//--------------------------------------------------------------------- -// Vertex Shaders -// - -// Vertex shader declaration - -// Forces TD3DDeclUsage, TD3DDeclMethod, TD3DDeclType be 1 byte enums -{$MINENUMSIZE 1} - -type - // Vertex element semantics - // - _D3DDECLUSAGE = ( - D3DDECLUSAGE_POSITION, // = 0 - D3DDECLUSAGE_BLENDWEIGHT, // 1 - D3DDECLUSAGE_BLENDINDICES, // 2 - D3DDECLUSAGE_NORMAL, // 3 - D3DDECLUSAGE_PSIZE, // 4 - D3DDECLUSAGE_TEXCOORD, // 5 - D3DDECLUSAGE_TANGENT, // 6 - D3DDECLUSAGE_BINORMAL, // 7 - D3DDECLUSAGE_TESSFACTOR, // 8 - D3DDECLUSAGE_POSITIONT, // 9 - D3DDECLUSAGE_COLOR, // 10 - D3DDECLUSAGE_FOG, // 11 - D3DDECLUSAGE_DEPTH, // 12 - D3DDECLUSAGE_SAMPLE // 13 - ); - {$EXTERNALSYM _D3DDECLUSAGE} - D3DDECLUSAGE = _D3DDECLUSAGE; - {$EXTERNALSYM D3DDECLUSAGE} - TD3DDeclUsage = _D3DDECLUSAGE; - -const - MAXD3DDECLUSAGE = DWORD(D3DDECLUSAGE_SAMPLE); - {$EXTERNALSYM MAXD3DDECLUSAGE} - MAXD3DDECLUSAGEINDEX = 15; - {$EXTERNALSYM MAXD3DDECLUSAGEINDEX} - MAXD3DDECLLENGTH = 64; // does not include "end" marker vertex element - {$EXTERNALSYM MAXD3DDECLLENGTH} - -type - _D3DDECLMETHOD = ( - D3DDECLMETHOD_DEFAULT, // = 0, - D3DDECLMETHOD_PARTIALU, - D3DDECLMETHOD_PARTIALV, - D3DDECLMETHOD_CROSSUV, // Normal - D3DDECLMETHOD_UV, - D3DDECLMETHOD_LOOKUP, // Lookup a displacement map - D3DDECLMETHOD_LOOKUPPRESAMPLED // Lookup a pre-sampled displacement map - ); - {$EXTERNALSYM _D3DDECLMETHOD} - D3DDECLMETHOD = _D3DDECLMETHOD; - {$EXTERNALSYM D3DDECLMETHOD} - TD3DDeclMethod = _D3DDECLMETHOD; - -const - MAXD3DDECLMETHOD = DWORD(D3DDECLMETHOD_LOOKUPPRESAMPLED); - {$EXTERNALSYM MAXD3DDECLMETHOD} - -type - // Declarations for _Type fields - // - _D3DDECLTYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DDECLTYPE_FLOAT1 {= 0}, // 1D float expanded to (value, 0., 0., 1.) - D3DDECLTYPE_FLOAT2 {= 1}, // 2D float expanded to (value, value, 0., 1.) - D3DDECLTYPE_FLOAT3 {= 2}, // 3D float expanded to (value, value, value, 1.) - D3DDECLTYPE_FLOAT4 {= 3}, // 4D float - D3DDECLTYPE_D3DCOLOR {= 4}, // 4D packed unsigned bytes mapped to 0. to 1. range - // Input is in D3DCOLOR format (ARGB) expanded to (R, G, B, A) - D3DDECLTYPE_UBYTE4 {= 5}, // 4D unsigned byte - D3DDECLTYPE_SHORT2 {= 6}, // 2D signed short expanded to (value, value, 0., 1.) - D3DDECLTYPE_SHORT4 {= 7}, // 4D signed short - - // The following types are valid only with vertex shaders >= 2.0 - - - D3DDECLTYPE_UBYTE4N {= 8}, // Each of 4 bytes is normalized by dividing to 255.0 - D3DDECLTYPE_SHORT2N {= 9}, // 2D signed short normalized (v[0]/32767.0,v[1]/32767.0,0,1) - D3DDECLTYPE_SHORT4N {= 10}, // 4D signed short normalized (v[0]/32767.0,v[1]/32767.0,v[2]/32767.0,v[3]/32767.0) - D3DDECLTYPE_USHORT2N {= 11}, // 2D unsigned short normalized (v[0]/65535.0,v[1]/65535.0,0,1) - D3DDECLTYPE_USHORT4N {= 12}, // 4D unsigned short normalized (v[0]/65535.0,v[1]/65535.0,v[2]/65535.0,v[3]/65535.0) - D3DDECLTYPE_UDEC3 {= 13}, // 3D unsigned 10 10 10 format expanded to (value, value, value, 1) - D3DDECLTYPE_DEC3N {= 14}, // 3D signed 10 10 10 format normalized and expanded to (v[0]/511.0, v[1]/511.0, v[2]/511.0, 1) - D3DDECLTYPE_FLOAT16_2{= 15}, // Two 16-bit floating point values, expanded to (value, value, 0, 1) - D3DDECLTYPE_FLOAT16_4{= 16}, // Four 16-bit floating point values - D3DDECLTYPE_UNUSED {= 17} // When the type field in a decl is unused. - {$ELSE} - D3DDECLTYPE_FLOAT1 = 0, // 1D float expanded to (value, 0., 0., 1.) - D3DDECLTYPE_FLOAT2 = 1, // 2D float expanded to (value, value, 0., 1.) - D3DDECLTYPE_FLOAT3 = 2, // 3D float expanded to (value, value, value, 1.) - D3DDECLTYPE_FLOAT4 = 3, // 4D float - D3DDECLTYPE_D3DCOLOR = 4, // 4D packed unsigned bytes mapped to 0. to 1. range - // Input is in D3DCOLOR format (ARGB) expanded to (R, G, B, A) - D3DDECLTYPE_UBYTE4 = 5, // 4D unsigned byte - D3DDECLTYPE_SHORT2 = 6, // 2D signed short expanded to (value, value, 0., 1.) - D3DDECLTYPE_SHORT4 = 7, // 4D signed short - - // The following types are valid only with vertex shaders >= 2.0 - - - D3DDECLTYPE_UBYTE4N = 8, // Each of 4 bytes is normalized by dividing to 255.0 - D3DDECLTYPE_SHORT2N = 9, // 2D signed short normalized (v[0]/32767.0,v[1]/32767.0,0,1) - D3DDECLTYPE_SHORT4N = 10, // 4D signed short normalized (v[0]/32767.0,v[1]/32767.0,v[2]/32767.0,v[3]/32767.0) - D3DDECLTYPE_USHORT2N = 11, // 2D unsigned short normalized (v[0]/65535.0,v[1]/65535.0,0,1) - D3DDECLTYPE_USHORT4N = 12, // 4D unsigned short normalized (v[0]/65535.0,v[1]/65535.0,v[2]/65535.0,v[3]/65535.0) - D3DDECLTYPE_UDEC3 = 13, // 3D unsigned 10 10 10 format expanded to (value, value, value, 1) - D3DDECLTYPE_DEC3N = 14, // 3D signed 10 10 10 format normalized and expanded to (v[0]/511.0, v[1]/511.0, v[2]/511.0, 1) - D3DDECLTYPE_FLOAT16_2 = 15, // Two 16-bit floating point values, expanded to (value, value, 0, 1) - D3DDECLTYPE_FLOAT16_4 = 16, // Four 16-bit floating point values - D3DDECLTYPE_UNUSED = 17 // When the type field in a decl is unused. - {$ENDIF} - ); - {$EXTERNALSYM _D3DDECLTYPE} - D3DDECLTYPE = _D3DDECLTYPE; - {$EXTERNALSYM D3DDECLTYPE} - TD3DDeclType = _D3DDECLTYPE; - -// Restores enums to be 4 byte in size -{$MINENUMSIZE 4} - -const - MAXD3DDECLTYPE = DWORD(D3DDECLTYPE_UNUSED); - {$EXTERNALSYM MAXD3DDECLTYPE} - -type - PD3DVertexElement9 = ^TD3DVertexElement9; - _D3DVERTEXELEMENT9 = packed record - Stream: Word; // Stream index - Offset: Word; // Offset in the stream in bytes - _Type: TD3DDeclType{Byte}; // Data type - Method: TD3DDeclMethod{Byte}; // Processing method - Usage: TD3DDeclUsage{Byte}; // Semantics - UsageIndex: Byte; // Semantic index - end; - {$EXTERNALSYM _D3DVERTEXELEMENT9} - D3DVERTEXELEMENT9 = _D3DVERTEXELEMENT9; - {$EXTERNALSYM D3DVERTEXELEMENT9} - TD3DVertexElement9 = _D3DVERTEXELEMENT9; - -// This is used to initialize the last vertex element in a vertex declaration -// array -// -const - D3DDECL_END: TD3DVertexElement9 = (Stream : $FF; - Offset : 0; - _Type : D3DDECLTYPE_UNUSED; - Method : TD3DDeclMethod(0); - Usage : TD3DDeclUsage(0); - UsageIndex : 0); - {$EXTERNALSYM D3DDECL_END} - -// Maximum supported number of texture coordinate sets -const - D3DDP_MAXTEXCOORD = 8; - {$EXTERNALSYM D3DDP_MAXTEXCOORD} - -//--------------------------------------------------------------------- -// Values for IDirect3DDevice9::SetStreamSourceFreq's Setting parameter -//--------------------------------------------------------------------- - D3DSTREAMSOURCE_INDEXEDDATA = LongWord(1 shl 30); - {$EXTERNALSYM D3DSTREAMSOURCE_INDEXEDDATA} - D3DSTREAMSOURCE_INSTANCEDATA = LongWord(2 shl 30); - {$EXTERNALSYM D3DSTREAMSOURCE_INSTANCEDATA} - - -//--------------------------------------------------------------------- -// -// The internal format of Pixel Shader (PS) & Vertex Shader (VS) -// Instruction Tokens is defined in the Direct3D Device Driver Kit -// -//--------------------------------------------------------------------- - - // - // Instruction Token Bit Definitions - // - D3DSI_OPCODE_MASK = $0000FFFF; - {$EXTERNALSYM D3DSI_OPCODE_MASK} - - D3DSI_INSTLENGTH_MASK = $0F000000; - {$EXTERNALSYM D3DSI_INSTLENGTH_MASK} - D3DSI_INSTLENGTH_SHIFT = 24; - {$EXTERNALSYM D3DSI_INSTLENGTH_SHIFT} - -type - _D3DSHADER_INSTRUCTION_OPCODE_TYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DSHADER_INSTRUCTION_OPCODE_TYPE} - D3DSHADER_INSTRUCTION_OPCODE_TYPE = _D3DSHADER_INSTRUCTION_OPCODE_TYPE; - {$EXTERNALSYM D3DSHADER_INSTRUCTION_OPCODE_TYPE} - TD3DShaderInstructionOpcodeType = _D3DSHADER_INSTRUCTION_OPCODE_TYPE; - -const - D3DSIO_NOP = 0; - {$EXTERNALSYM D3DSIO_NOP} - D3DSIO_MOV = 1; - {$EXTERNALSYM D3DSIO_MOV} - D3DSIO_ADD = 2; - {$EXTERNALSYM D3DSIO_ADD} - D3DSIO_SUB = 3; - {$EXTERNALSYM D3DSIO_SUB} - D3DSIO_MAD = 4; - {$EXTERNALSYM D3DSIO_MAD} - D3DSIO_MUL = 5; - {$EXTERNALSYM D3DSIO_MUL} - D3DSIO_RCP = 6; - {$EXTERNALSYM D3DSIO_RCP} - D3DSIO_RSQ = 7; - {$EXTERNALSYM D3DSIO_RSQ} - D3DSIO_DP3 = 8; - {$EXTERNALSYM D3DSIO_DP3} - D3DSIO_DP4 = 9; - {$EXTERNALSYM D3DSIO_DP4} - D3DSIO_MIN = 10; - {$EXTERNALSYM D3DSIO_MIN} - D3DSIO_MAX = 11; - {$EXTERNALSYM D3DSIO_MAX} - D3DSIO_SLT = 12; - {$EXTERNALSYM D3DSIO_SLT} - D3DSIO_SGE = 13; - {$EXTERNALSYM D3DSIO_SGE} - D3DSIO_EXP = 14; - {$EXTERNALSYM D3DSIO_EXP} - D3DSIO_LOG = 15; - {$EXTERNALSYM D3DSIO_LOG} - D3DSIO_LIT = 16; - {$EXTERNALSYM D3DSIO_LIT} - D3DSIO_DST = 17; - {$EXTERNALSYM D3DSIO_DST} - D3DSIO_LRP = 18; - {$EXTERNALSYM D3DSIO_LRP} - D3DSIO_FRC = 19; - {$EXTERNALSYM D3DSIO_FRC} - D3DSIO_M4x4 = 20; - {$EXTERNALSYM D3DSIO_M4x4} - D3DSIO_M4x3 = 21; - {$EXTERNALSYM D3DSIO_M4x3} - D3DSIO_M3x4 = 22; - {$EXTERNALSYM D3DSIO_M3x4} - D3DSIO_M3x3 = 23; - {$EXTERNALSYM D3DSIO_M3x3} - D3DSIO_M3x2 = 24; - {$EXTERNALSYM D3DSIO_M3x2} - D3DSIO_CALL = 25; - {$EXTERNALSYM D3DSIO_CALL} - D3DSIO_CALLNZ = 26; - {$EXTERNALSYM D3DSIO_CALLNZ} - D3DSIO_LOOP = 27; - {$EXTERNALSYM D3DSIO_LOOP} - D3DSIO_RET = 28; - {$EXTERNALSYM D3DSIO_RET} - D3DSIO_ENDLOOP = 29; - {$EXTERNALSYM D3DSIO_ENDLOOP} - D3DSIO_LABEL = 30; - {$EXTERNALSYM D3DSIO_LABEL} - D3DSIO_DCL = 31; - {$EXTERNALSYM D3DSIO_DCL} - D3DSIO_POW = 32; - {$EXTERNALSYM D3DSIO_POW} - D3DSIO_CRS = 33; - {$EXTERNALSYM D3DSIO_CRS} - D3DSIO_SGN = 34; - {$EXTERNALSYM D3DSIO_SGN} - D3DSIO_ABS = 35; - {$EXTERNALSYM D3DSIO_ABS} - D3DSIO_NRM = 36; - {$EXTERNALSYM D3DSIO_NRM} - D3DSIO_SINCOS = 37; - {$EXTERNALSYM D3DSIO_SINCOS} - D3DSIO_REP = 38; - {$EXTERNALSYM D3DSIO_REP} - D3DSIO_ENDREP = 39; - {$EXTERNALSYM D3DSIO_ENDREP} - D3DSIO_IF = 40; - {$EXTERNALSYM D3DSIO_IF} - D3DSIO_IFC = 41; - {$EXTERNALSYM D3DSIO_IFC} - D3DSIO_ELSE = 42; - {$EXTERNALSYM D3DSIO_ELSE} - D3DSIO_ENDIF = 43; - {$EXTERNALSYM D3DSIO_ENDIF} - D3DSIO_BREAK = 44; - {$EXTERNALSYM D3DSIO_BREAK} - D3DSIO_BREAKC = 45; - {$EXTERNALSYM D3DSIO_BREAKC} - D3DSIO_MOVA = 46; - {$EXTERNALSYM D3DSIO_MOVA} - D3DSIO_DEFB = 47; - {$EXTERNALSYM D3DSIO_DEFB} - D3DSIO_DEFI = 48; - {$EXTERNALSYM D3DSIO_DEFI} - - D3DSIO_TEXCOORD = 64; - {$EXTERNALSYM D3DSIO_TEXCOORD} - D3DSIO_TEXKILL = 65; - {$EXTERNALSYM D3DSIO_TEXKILL} - D3DSIO_TEX = 66; - {$EXTERNALSYM D3DSIO_TEX} - D3DSIO_TEXBEM = 67; - {$EXTERNALSYM D3DSIO_TEXBEM} - D3DSIO_TEXBEML = 68; - {$EXTERNALSYM D3DSIO_TEXBEML} - D3DSIO_TEXREG2AR = 69; - {$EXTERNALSYM D3DSIO_TEXREG2AR} - D3DSIO_TEXREG2GB = 70; - {$EXTERNALSYM D3DSIO_TEXREG2GB} - D3DSIO_TEXM3x2PAD = 71; - {$EXTERNALSYM D3DSIO_TEXM3x2PAD} - D3DSIO_TEXM3x2TEX = 72; - {$EXTERNALSYM D3DSIO_TEXM3x2TEX} - D3DSIO_TEXM3x3PAD = 73; - {$EXTERNALSYM D3DSIO_TEXM3x3PAD} - D3DSIO_TEXM3x3TEX = 74; - {$EXTERNALSYM D3DSIO_TEXM3x3TEX} - D3DSIO_RESERVED0 = 75; - {$EXTERNALSYM D3DSIO_RESERVED0} - D3DSIO_TEXM3x3SPEC = 76; - {$EXTERNALSYM D3DSIO_TEXM3x3SPEC} - D3DSIO_TEXM3x3VSPEC = 77; - {$EXTERNALSYM D3DSIO_TEXM3x3VSPEC} - D3DSIO_EXPP = 78; - {$EXTERNALSYM D3DSIO_EXPP} - D3DSIO_LOGP = 79; - {$EXTERNALSYM D3DSIO_LOGP} - D3DSIO_CND = 80; - {$EXTERNALSYM D3DSIO_CND} - D3DSIO_DEF = 81; - {$EXTERNALSYM D3DSIO_DEF} - D3DSIO_TEXREG2RGB = 82; - {$EXTERNALSYM D3DSIO_TEXREG2RGB} - D3DSIO_TEXDP3TEX = 83; - {$EXTERNALSYM D3DSIO_TEXDP3TEX} - D3DSIO_TEXM3x2DEPTH = 84; - {$EXTERNALSYM D3DSIO_TEXM3x2DEPTH} - D3DSIO_TEXDP3 = 85; - {$EXTERNALSYM D3DSIO_TEXDP3} - D3DSIO_TEXM3x3 = 86; - {$EXTERNALSYM D3DSIO_TEXM3x3} - D3DSIO_TEXDEPTH = 87; - {$EXTERNALSYM D3DSIO_TEXDEPTH} - D3DSIO_CMP = 88; - {$EXTERNALSYM D3DSIO_CMP} - D3DSIO_BEM = 89; - {$EXTERNALSYM D3DSIO_BEM} - - D3DSIO_DP2ADD = 90; - {$EXTERNALSYM D3DSIO_DP2ADD} - D3DSIO_DSX = 91; - {$EXTERNALSYM D3DSIO_DSX} - D3DSIO_DSY = 92; - {$EXTERNALSYM D3DSIO_DSY} - D3DSIO_TEXLDD = 93; - {$EXTERNALSYM D3DSIO_TEXLDD} - D3DSIO_SETP = 94; - {$EXTERNALSYM D3DSIO_SETP} - D3DSIO_TEXLDL = 95; - {$EXTERNALSYM D3DSIO_TEXLDL} - D3DSIO_BREAKP = 96; - {$EXTERNALSYM D3DSIO_BREAKP} - - - D3DSIO_PHASE = $FFFD; - {$EXTERNALSYM D3DSIO_PHASE} - D3DSIO_COMMENT = $FFFE; - {$EXTERNALSYM D3DSIO_COMMENT} - D3DSIO_END = $FFFF; - {$EXTERNALSYM D3DSIO_END} - - //--------------------------------------------------------------------- - // Use these constants with D3DSIO_SINCOS macro as SRC2, SRC3 - // - //#define D3DSINCOSCONST1 -1.5500992e-006f, -2.1701389e-005f, 0.0026041667f, 0.00026041668f - //#define D3DSINCOSCONST2 -0.020833334f, -0.12500000f, 1.0f, 0.50000000f - - //--------------------------------------------------------------------- - // Co-Issue Instruction Modifier - if set then this instruction is to be - // issued in parallel with the previous instruction(s) for which this bit - // is not set. - // - D3DSI_COISSUE = $40000000; - {$EXTERNALSYM D3DSI_COISSUE} - - //--------------------------------------------------------------------- - // Opcode specific controls - - D3DSP_OPCODESPECIFICCONTROL_MASK = $00ff0000; - {$EXTERNALSYM D3DSP_OPCODESPECIFICCONTROL_MASK} - D3DSP_OPCODESPECIFICCONTROL_SHIFT = 16; - {$EXTERNALSYM D3DSP_OPCODESPECIFICCONTROL_SHIFT} - - // ps_2_0 texld controls - D3DSI_TEXLD_PROJECT = ($01 shl D3DSP_OPCODESPECIFICCONTROL_SHIFT); - {$EXTERNALSYM D3DSI_TEXLD_PROJECT} - D3DSI_TEXLD_BIAS = ($02 shl D3DSP_OPCODESPECIFICCONTROL_SHIFT); - {$EXTERNALSYM D3DSI_TEXLD_BIAS} - -type - // Comparison for dynamic conditional instruction opcodes (i.e. if, breakc) - {$MINENUMSIZE 1} // Forces TD3DShaderComparison be 1 byte enum - _D3DSHADER_COMPARISON = ( - // < = > - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DSPC_RESERVED0{= 0}, // 0 0 0 - D3DSPC_GT {= 1}, // 0 0 1 - D3DSPC_EQ {= 2}, // 0 1 0 - D3DSPC_GE {= 3}, // 0 1 1 - D3DSPC_LT {= 4}, // 1 0 0 - D3DSPC_NE {= 5}, // 1 0 1 - D3DSPC_LE {= 6}, // 1 1 0 - D3DSPC_RESERVED1{= 7} // 1 1 1 - {$ELSE} - D3DSPC_RESERVED0= 0, // 0 0 0 - D3DSPC_GT = 1, // 0 0 1 - D3DSPC_EQ = 2, // 0 1 0 - D3DSPC_GE = 3, // 0 1 1 - D3DSPC_LT = 4, // 1 0 0 - D3DSPC_NE = 5, // 1 0 1 - D3DSPC_LE = 6, // 1 1 0 - D3DSPC_RESERVED1= 7 // 1 1 1 - {$ENDIF} - ); - {$EXTERNALSYM _D3DSHADER_COMPARISON} - D3DSHADER_COMPARISON = _D3DSHADER_COMPARISON; - {$EXTERNALSYM D3DSHADER_COMPARISON} - TD3DShaderComparison = _D3DSHADER_COMPARISON; - {$MINENUMSIZE 4} // Restores enums to be 4 byte in size - -const - // Comparison is part of instruction opcode token: - D3DSHADER_COMPARISON_SHIFT = D3DSP_OPCODESPECIFICCONTROL_SHIFT; - {$EXTERNALSYM D3DSHADER_COMPARISON_SHIFT} - D3DSHADER_COMPARISON_MASK = ($7 shl D3DSHADER_COMPARISON_SHIFT); - {$EXTERNALSYM D3DSHADER_COMPARISON_MASK} - - //--------------------------------------------------------------------- - // Predication flags on instruction token - D3DSHADER_INSTRUCTION_PREDICATED = ($1 shl 28); - {$EXTERNALSYM D3DSHADER_INSTRUCTION_PREDICATED} - - //--------------------------------------------------------------------- - // DCL Info Token Controls - - // For dcl info tokens requiring a semantic (usage + index) - D3DSP_DCL_USAGE_SHIFT = 0; - {$EXTERNALSYM D3DSP_DCL_USAGE_SHIFT} - D3DSP_DCL_USAGE_MASK = $0000000f; - {$EXTERNALSYM D3DSP_DCL_USAGE_MASK} - - D3DSP_DCL_USAGEINDEX_SHIFT = 16; - {$EXTERNALSYM D3DSP_DCL_USAGEINDEX_SHIFT} - D3DSP_DCL_USAGEINDEX_MASK = $000f0000; - {$EXTERNALSYM D3DSP_DCL_USAGEINDEX_MASK} - - // DCL pixel shader sampler info token. - D3DSP_TEXTURETYPE_SHIFT = 27; - {$EXTERNALSYM D3DSP_TEXTURETYPE_SHIFT} - D3DSP_TEXTURETYPE_MASK = $78000000; - {$EXTERNALSYM D3DSP_TEXTURETYPE_MASK} - -{$IFNDEF SUPPORTS_EXPL_ENUMS_except_BCB6} -type - _D3DSAMPLER_TEXTURE_TYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DSAMPLER_TEXTURE_TYPE} - D3DSAMPLER_TEXTURE_TYPE = _D3DSAMPLER_TEXTURE_TYPE; - {$EXTERNALSYM D3DSAMPLER_TEXTURE_TYPE} - TD3DSamplerTextureType = _D3DSAMPLER_TEXTURE_TYPE; - -const - D3DSTT_UNKNOWN = 0 shl D3DSP_TEXTURETYPE_SHIFT; // uninitialized value - {$EXTERNALSYM D3DSTT_UNKNOWN} - D3DSTT_2D = 2 shl D3DSP_TEXTURETYPE_SHIFT; // dcl_2d s# (for declaring a 2-D texture) - {$EXTERNALSYM D3DSTT_2D} - D3DSTT_CUBE = 3 shl D3DSP_TEXTURETYPE_SHIFT; // dcl_cube s# (for declaring a cube texture) - {$EXTERNALSYM D3DSTT_CUBE} - D3DSTT_VOLUME = 4 shl D3DSP_TEXTURETYPE_SHIFT; // dcl_volume s# (for declaring a volume texture) - {$EXTERNALSYM D3DSTT_VOLUME} - D3DSTT_FORCE_DWORD = $7fffffff; // force 32-bit size enum - {$EXTERNALSYM D3DSTT_FORCE_DWORD} -{$ELSE} -type - _D3DSAMPLER_TEXTURE_TYPE = ( - D3DSTT_UNKNOWN = 0 shl D3DSP_TEXTURETYPE_SHIFT, // uninitialized value - D3DSTT_2D = 2 shl D3DSP_TEXTURETYPE_SHIFT, // dcl_2d s# (for declaring a 2-D texture) - D3DSTT_CUBE = 3 shl D3DSP_TEXTURETYPE_SHIFT, // dcl_cube s# (for declaring a cube texture) - D3DSTT_VOLUME = 4 shl D3DSP_TEXTURETYPE_SHIFT, // dcl_volume s# (for declaring a volume texture) - D3DSTT_FORCE_DWORD = $7fffffff // force 32-bit size enum - ); - {$EXTERNALSYM _D3DSAMPLER_TEXTURE_TYPE} - D3DSAMPLER_TEXTURE_TYPE = _D3DSAMPLER_TEXTURE_TYPE; - {$EXTERNALSYM D3DSAMPLER_TEXTURE_TYPE} - TD3DSamplerTextureType = _D3DSAMPLER_TEXTURE_TYPE; -{$ENDIF} - -const - //--------------------------------------------------------------------- - // Parameter Token Bit Definitions - // - D3DSP_REGNUM_MASK = $000007FF; - {$EXTERNALSYM D3DSP_REGNUM_MASK} - - // destination parameter write mask - D3DSP_WRITEMASK_0 = $00010000; // Component 0 (X;Red) - {$EXTERNALSYM D3DSP_WRITEMASK_0} - D3DSP_WRITEMASK_1 = $00020000; // Component 1 (Y;Green) - {$EXTERNALSYM D3DSP_WRITEMASK_1} - D3DSP_WRITEMASK_2 = $00040000; // Component 2 (Z;Blue) - {$EXTERNALSYM D3DSP_WRITEMASK_2} - D3DSP_WRITEMASK_3 = $00080000; // Component 3 (W;Alpha) - {$EXTERNALSYM D3DSP_WRITEMASK_3} - D3DSP_WRITEMASK_ALL = $000F0000; // All Components - {$EXTERNALSYM D3DSP_WRITEMASK_ALL} - - // destination parameter modifiers - D3DSP_DSTMOD_SHIFT = 20; - {$EXTERNALSYM D3DSP_DSTMOD_SHIFT} - D3DSP_DSTMOD_MASK = $00F00000; - {$EXTERNALSYM D3DSP_DSTMOD_MASK} - - // Bit masks for destination parameter modifiers - D3DSPDM_NONE = (0 shl D3DSP_DSTMOD_SHIFT); // nop - {$EXTERNALSYM D3DSPDM_NONE} - D3DSPDM_SATURATE = (1 shl D3DSP_DSTMOD_SHIFT); // clamp to 0. to 1. range - {$EXTERNALSYM D3DSPDM_SATURATE} - D3DSPDM_PARTIALPRECISION = (2 shl D3DSP_DSTMOD_SHIFT); // Partial precision hint - {$EXTERNALSYM D3DSPDM_PARTIALPRECISION} - D3DSPDM_MSAMPCENTROID = (4 shl D3DSP_DSTMOD_SHIFT); // Relevant to multisampling only: - {$EXTERNALSYM D3DSPDM_MSAMPCENTROID} - // When the pixel center is not covered, sample - // attribute or compute gradients/LOD - // using multisample "centroid" location. - // "Centroid" is some location within the covered - // region of the pixel. - - // destination parameter - D3DSP_DSTSHIFT_SHIFT = 24; - {$EXTERNALSYM D3DSP_DSTSHIFT_SHIFT} - D3DSP_DSTSHIFT_MASK = $0F000000; - {$EXTERNALSYM D3DSP_DSTSHIFT_MASK} - - // destination/source parameter register type - D3DSP_REGTYPE_SHIFT = 28; - {$EXTERNALSYM D3DSP_REGTYPE_SHIFT} - D3DSP_REGTYPE_SHIFT2 = 8; - {$EXTERNALSYM D3DSP_REGTYPE_SHIFT2} - D3DSP_REGTYPE_MASK = $70000000; - {$EXTERNALSYM D3DSP_REGTYPE_MASK} - D3DSP_REGTYPE_MASK2 = $00001800; - {$EXTERNALSYM D3DSP_REGTYPE_MASK2} - - -{$IFNDEF SUPPORTS_EXPL_ENUMS} -const - D3DSPR_TEMP = 0; // Temporary Register File - {$EXTERNALSYM D3DSPR_TEMP} - D3DSPR_INPUT = 1; // Input Register File - {$EXTERNALSYM D3DSPR_INPUT} - D3DSPR_CONST = 2; // Constant Register File - {$EXTERNALSYM D3DSPR_CONST} - D3DSPR_ADDR = 3; // Address Register (VS) - {$EXTERNALSYM D3DSPR_ADDR} - D3DSPR_TEXTURE = 3; // Texture Register File (PS) - {$EXTERNALSYM D3DSPR_TEXTURE} - D3DSPR_RASTOUT = 4; // Rasterizer Register File - {$EXTERNALSYM D3DSPR_RASTOUT} - D3DSPR_ATTROUT = 5; // Attribute Output Register File - {$EXTERNALSYM D3DSPR_ATTROUT} - D3DSPR_TEXCRDOUT = 6; // Texture Coordinate Output Register File - {$EXTERNALSYM D3DSPR_TEXCRDOUT} - D3DSPR_OUTPUT = 6; // Output register file for VS3.0+ - {$EXTERNALSYM D3DSPR_OUTPUT} - D3DSPR_CONSTINT = 7; // Constant Integer Vector Register File - {$EXTERNALSYM D3DSPR_CONSTINT} - D3DSPR_COLOROUT = 8; // Color Output Register File - {$EXTERNALSYM D3DSPR_COLOROUT} - D3DSPR_DEPTHOUT = 9; // Depth Output Register File - {$EXTERNALSYM D3DSPR_DEPTHOUT} - D3DSPR_SAMPLER = 10; // Sampler State Register File - {$EXTERNALSYM D3DSPR_SAMPLER} - D3DSPR_CONST2 = 11; // Constant Register File 2048 - 4095 - {$EXTERNALSYM D3DSPR_CONST2} - D3DSPR_CONST3 = 12; // Constant Register File 4096 - 6143 - {$EXTERNALSYM D3DSPR_CONST3} - D3DSPR_CONST4 = 13; // Constant Register File 6144 - 8191 - {$EXTERNALSYM D3DSPR_CONST4} - D3DSPR_CONSTBOOL = 14; // Constant Boolean register file - {$EXTERNALSYM D3DSPR_CONSTBOOL} - D3DSPR_LOOP = 15; // Loop counter register file - {$EXTERNALSYM D3DSPR_LOOP} - D3DSPR_TEMPFLOAT16 = 16; // 16-bit float temp register file - {$EXTERNALSYM D3DSPR_TEMPFLOAT16} - D3DSPR_MISCTYPE = 17; // Miscellaneous (single) registers. - {$EXTERNALSYM D3DSPR_MISCTYPE} - D3DSPR_LABEL = 18; // Label - {$EXTERNALSYM D3DSPR_LABEL} - D3DSPR_PREDICATE = 19; // Predicate register - {$EXTERNALSYM D3DSPR_PREDICATE} - -type - _D3DSHADER_PARAM_REGISTER_TYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; -{$ELSE} -type - _D3DSHADER_PARAM_REGISTER_TYPE = ( - D3DSPR_TEMP = 0, // Temporary Register File - D3DSPR_INPUT = 1, // Input Register File - D3DSPR_CONST = 2, // Constant Register File - D3DSPR_ADDR = 3, // Address Register (VS) - D3DSPR_TEXTURE = 3, // Texture Register File (PS) - D3DSPR_RASTOUT = 4, // Rasterizer Register File - D3DSPR_ATTROUT = 5, // Attribute Output Register File - D3DSPR_TEXCRDOUT = 6, // Texture Coordinate Output Register File - D3DSPR_OUTPUT = 6, // Output register file for VS3.0+ - D3DSPR_CONSTINT = 7, // Constant Integer Vector Register File - D3DSPR_COLOROUT = 8, // Color Output Register File - D3DSPR_DEPTHOUT = 9, // Depth Output Register File - D3DSPR_SAMPLER = 10, // Sampler State Register File - D3DSPR_CONST2 = 11, // Constant Register File 2048 - 4095 - D3DSPR_CONST3 = 12, // Constant Register File 4096 - 6143 - D3DSPR_CONST4 = 13, // Constant Register File 6144 - 8191 - D3DSPR_CONSTBOOL = 14, // Constant Boolean register file - D3DSPR_LOOP = 15, // Loop counter register file - D3DSPR_TEMPFLOAT16 = 16, // 16-bit float temp register file - D3DSPR_MISCTYPE = 17, // Miscellaneous (single) registers. - D3DSPR_LABEL = 18, // Label - D3DSPR_PREDICATE = 19 // Predicate register - ); -{$ENDIF} - {$EXTERNALSYM _D3DSHADER_PARAM_REGISTER_TYPE} - D3DSHADER_PARAM_REGISTER_TYPE = _D3DSHADER_PARAM_REGISTER_TYPE; - {$EXTERNALSYM D3DSHADER_PARAM_REGISTER_TYPE} - TD3DShaderParamRegisterType = _D3DSHADER_PARAM_REGISTER_TYPE; - - // The miscellaneous register file (D3DSPR_MISCTYPES) - // contains register types for which there is only ever one - // register (i.e. the register # is not needed). - // Rather than use up additional register types for such - // registers, they are defined - // as particular offsets into the misc. register file: - {$MINENUMSIZE 1} // Forces TD3DShaderMiscTypeOffsets be 1 byte enum - _D3DSHADER_MISCTYPE_OFFSETS = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DSMO_POSITION {= 0}, // Input position x,y,z,rhw (PS) - D3DSMO_FACE {= 1} // Floating point primitive area (PS) - {$ELSE} - D3DSMO_POSITION = 0, // Input position x,y,z,rhw (PS) - D3DSMO_FACE = 1 // Floating point primitive area (PS) - {$ENDIF} - ); - {$EXTERNALSYM _D3DSHADER_MISCTYPE_OFFSETS} - D3DSHADER_MISCTYPE_OFFSETS = _D3DSHADER_MISCTYPE_OFFSETS; - {$EXTERNALSYM D3DSHADER_MISCTYPE_OFFSETS} - TD3DShaderMiscTypeOffsets = _D3DSHADER_MISCTYPE_OFFSETS; - {$MINENUMSIZE 4} // Restores enums to be 4 byte in size - - // Register offsets in the Rasterizer Register File - // - _D3DVS_RASTOUT_OFFSETS = ( - D3DSRO_POSITION, // = 0, - D3DSRO_FOG, - D3DSRO_POINT_SIZE - ); - {$EXTERNALSYM _D3DVS_RASTOUT_OFFSETS} - D3DVS_RASTOUT_OFFSETS = _D3DVS_RASTOUT_OFFSETS; - {$EXTERNALSYM D3DVS_RASTOUT_OFFSETS} - TD3DVSRastoutOffsets = _D3DVS_RASTOUT_OFFSETS; - -// Source operand addressing modes - -const - D3DVS_ADDRESSMODE_SHIFT = 13; - {$EXTERNALSYM D3DVS_ADDRESSMODE_SHIFT} - D3DVS_ADDRESSMODE_MASK = 1 shl D3DVS_ADDRESSMODE_SHIFT; - {$EXTERNALSYM D3DVS_ADDRESSMODE_MASK} - -type - _D3DVS_ADDRESSMODE_TYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DVS_ADDRESSMODE_TYPE} - D3DVS_ADDRESSMODE_TYPE = _D3DVS_ADDRESSMODE_TYPE; - {$EXTERNALSYM D3DVS_ADDRESSMODE_TYPE} - TD3DVSAddressModeType = _D3DVS_ADDRESSMODE_TYPE; - -const - D3DVS_ADDRMODE_ABSOLUTE = 0 shl D3DVS_ADDRESSMODE_SHIFT; - {$EXTERNALSYM D3DVS_ADDRMODE_ABSOLUTE} - D3DVS_ADDRMODE_RELATIVE = 1 shl D3DVS_ADDRESSMODE_SHIFT; - {$EXTERNALSYM D3DVS_ADDRMODE_RELATIVE} - D3DVS_ADDRMODE_FORCE_DWORD = $7fffffff; // force 32-bit size enum - {$EXTERNALSYM D3DVS_ADDRMODE_FORCE_DWORD} - -const - D3DSHADER_ADDRESSMODE_SHIFT = 13; - {$EXTERNALSYM D3DSHADER_ADDRESSMODE_SHIFT} - D3DSHADER_ADDRESSMODE_MASK = (1 shl D3DSHADER_ADDRESSMODE_SHIFT); - {$EXTERNALSYM D3DSHADER_ADDRESSMODE_MASK} - -type - _D3DSHADER_ADDRESSMODE_TYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DSHADER_ADDRESSMODE_TYPE} - D3DSHADER_ADDRESSMODE_TYPE = _D3DSHADER_ADDRESSMODE_TYPE; - {$EXTERNALSYM D3DSHADER_ADDRESSMODE_TYPE} - TD3DShaderAddressModeType = _D3DSHADER_ADDRESSMODE_TYPE; - -const - D3DSHADER_ADDRMODE_ABSOLUTE = (0 shl D3DSHADER_ADDRESSMODE_SHIFT); - {$EXTERNALSYM D3DSHADER_ADDRMODE_ABSOLUTE} - D3DSHADER_ADDRMODE_RELATIVE = (1 shl D3DSHADER_ADDRESSMODE_SHIFT); - {$EXTERNALSYM D3DSHADER_ADDRMODE_RELATIVE} - D3DSHADER_ADDRMODE_FORCE_DWORD = $7fffffff; // force 32-bit size enum - {$EXTERNALSYM D3DSHADER_ADDRMODE_FORCE_DWORD} - - // Source operand swizzle definitions - // - D3DVS_SWIZZLE_SHIFT = 16; - {$EXTERNALSYM D3DVS_SWIZZLE_SHIFT} - D3DVS_SWIZZLE_MASK = $00FF0000; - {$EXTERNALSYM D3DVS_SWIZZLE_MASK} - - // The following bits define where to take component X from: - - D3DVS_X_X = 0 shl D3DVS_SWIZZLE_SHIFT; - {$EXTERNALSYM D3DVS_X_X} - D3DVS_X_Y = 1 shl D3DVS_SWIZZLE_SHIFT; - {$EXTERNALSYM D3DVS_X_Y} - D3DVS_X_Z = 2 shl D3DVS_SWIZZLE_SHIFT; - {$EXTERNALSYM D3DVS_X_Z} - D3DVS_X_W = 3 shl D3DVS_SWIZZLE_SHIFT; - {$EXTERNALSYM D3DVS_X_W} - - // The following bits define where to take component Y from: - - D3DVS_Y_X = 0 shl (D3DVS_SWIZZLE_SHIFT + 2); - {$EXTERNALSYM D3DVS_Y_X} - D3DVS_Y_Y = 1 shl (D3DVS_SWIZZLE_SHIFT + 2); - {$EXTERNALSYM D3DVS_Y_Y} - D3DVS_Y_Z = 2 shl (D3DVS_SWIZZLE_SHIFT + 2); - {$EXTERNALSYM D3DVS_Y_Z} - D3DVS_Y_W = 3 shl (D3DVS_SWIZZLE_SHIFT + 2); - {$EXTERNALSYM D3DVS_Y_W} - - // The following bits define where to take component Z from: - - D3DVS_Z_X = 0 shl (D3DVS_SWIZZLE_SHIFT + 4); - {$EXTERNALSYM D3DVS_Z_X} - D3DVS_Z_Y = 1 shl (D3DVS_SWIZZLE_SHIFT + 4); - {$EXTERNALSYM D3DVS_Z_Y} - D3DVS_Z_Z = 2 shl (D3DVS_SWIZZLE_SHIFT + 4); - {$EXTERNALSYM D3DVS_Z_Z} - D3DVS_Z_W = 3 shl (D3DVS_SWIZZLE_SHIFT + 4); - {$EXTERNALSYM D3DVS_Z_W} - - // The following bits define where to take component W from: - - D3DVS_W_X = 0 shl (D3DVS_SWIZZLE_SHIFT + 6); - {$EXTERNALSYM D3DVS_W_X} - D3DVS_W_Y = 1 shl (D3DVS_SWIZZLE_SHIFT + 6); - {$EXTERNALSYM D3DVS_W_Y} - D3DVS_W_Z = 2 shl (D3DVS_SWIZZLE_SHIFT + 6); - {$EXTERNALSYM D3DVS_W_Z} - D3DVS_W_W = 3 shl (D3DVS_SWIZZLE_SHIFT + 6); - {$EXTERNALSYM D3DVS_W_W} - - // Value when there is no swizzle (X is taken from X, Y is taken from Y, - // Z is taken from Z, W is taken from W - // - D3DVS_NOSWIZZLE = D3DVS_X_X or D3DVS_Y_Y or D3DVS_Z_Z or D3DVS_W_W; - {$EXTERNALSYM D3DVS_NOSWIZZLE} - - // source parameter swizzle - D3DSP_SWIZZLE_SHIFT = 16; - {$EXTERNALSYM D3DSP_SWIZZLE_SHIFT} - D3DSP_SWIZZLE_MASK = $00FF0000; - {$EXTERNALSYM D3DSP_SWIZZLE_MASK} - - D3DSP_NOSWIZZLE = - (0 shl (D3DSP_SWIZZLE_SHIFT + 0)) or - (1 shl (D3DSP_SWIZZLE_SHIFT + 2)) or - (2 shl (D3DSP_SWIZZLE_SHIFT + 4)) or - (3 shl (D3DSP_SWIZZLE_SHIFT + 6)); - {$EXTERNALSYM D3DSP_NOSWIZZLE} - - // pixel-shader swizzle ops - D3DSP_REPLICATERED = - (0 shl (D3DSP_SWIZZLE_SHIFT + 0)) or - (0 shl (D3DSP_SWIZZLE_SHIFT + 2)) or - (0 shl (D3DSP_SWIZZLE_SHIFT + 4)) or - (0 shl (D3DSP_SWIZZLE_SHIFT + 6)); - {$EXTERNALSYM D3DSP_REPLICATERED} - - D3DSP_REPLICATEGREEN = - (1 shl (D3DSP_SWIZZLE_SHIFT + 0)) or - (1 shl (D3DSP_SWIZZLE_SHIFT + 2)) or - (1 shl (D3DSP_SWIZZLE_SHIFT + 4)) or - (1 shl (D3DSP_SWIZZLE_SHIFT + 6)); - {$EXTERNALSYM D3DSP_REPLICATEGREEN} - - D3DSP_REPLICATEBLUE = - (2 shl (D3DSP_SWIZZLE_SHIFT + 0)) or - (2 shl (D3DSP_SWIZZLE_SHIFT + 2)) or - (2 shl (D3DSP_SWIZZLE_SHIFT + 4)) or - (2 shl (D3DSP_SWIZZLE_SHIFT + 6)); - {$EXTERNALSYM D3DSP_REPLICATEBLUE} - - D3DSP_REPLICATEALPHA = - (3 shl (D3DSP_SWIZZLE_SHIFT + 0)) or - (3 shl (D3DSP_SWIZZLE_SHIFT + 2)) or - (3 shl (D3DSP_SWIZZLE_SHIFT + 4)) or - (3 shl (D3DSP_SWIZZLE_SHIFT + 6)); - {$EXTERNALSYM D3DSP_REPLICATEALPHA} - - // source parameter modifiers - D3DSP_SRCMOD_SHIFT = 24; - {$EXTERNALSYM D3DSP_SRCMOD_SHIFT} - D3DSP_SRCMOD_MASK = $0F000000; - {$EXTERNALSYM D3DSP_SRCMOD_MASK} - -type - _D3DSHADER_PARAM_SRCMOD_TYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DSHADER_PARAM_SRCMOD_TYPE} - D3DSHADER_PARAM_SRCMOD_TYPE = _D3DSHADER_PARAM_SRCMOD_TYPE; - {$EXTERNALSYM D3DSHADER_PARAM_SRCMOD_TYPE} - TD3DShaderParamSRCModType = _D3DSHADER_PARAM_SRCMOD_TYPE; - -const - D3DSPSM_NONE = 0 shl D3DSP_SRCMOD_SHIFT; // nop - {$EXTERNALSYM D3DSPSM_NONE} - D3DSPSM_NEG = 1 shl D3DSP_SRCMOD_SHIFT; // negate - {$EXTERNALSYM D3DSPSM_NEG} - D3DSPSM_BIAS = 2 shl D3DSP_SRCMOD_SHIFT; // bias - {$EXTERNALSYM D3DSPSM_BIAS} - D3DSPSM_BIASNEG = 3 shl D3DSP_SRCMOD_SHIFT; // bias and negate - {$EXTERNALSYM D3DSPSM_BIASNEG} - D3DSPSM_SIGN = 4 shl D3DSP_SRCMOD_SHIFT; // sign - {$EXTERNALSYM D3DSPSM_SIGN} - D3DSPSM_SIGNNEG = 5 shl D3DSP_SRCMOD_SHIFT; // sign and negate - {$EXTERNALSYM D3DSPSM_SIGNNEG} - D3DSPSM_COMP = 6 shl D3DSP_SRCMOD_SHIFT; // complement - {$EXTERNALSYM D3DSPSM_COMP} - D3DSPSM_X2 = 7 shl D3DSP_SRCMOD_SHIFT; // *2 - {$EXTERNALSYM D3DSPSM_X2} - D3DSPSM_X2NEG = 8 shl D3DSP_SRCMOD_SHIFT; // *2 and negate - {$EXTERNALSYM D3DSPSM_X2NEG} - D3DSPSM_DZ = 9 shl D3DSP_SRCMOD_SHIFT; // divide through by z component - {$EXTERNALSYM D3DSPSM_DZ} - D3DSPSM_DW = 10 shl D3DSP_SRCMOD_SHIFT; // divide through by w component - {$EXTERNALSYM D3DSPSM_DW} - D3DSPSM_ABS = 11 shl D3DSP_SRCMOD_SHIFT; // abs() - {$EXTERNALSYM D3DSPSM_ABS} - D3DSPSM_ABSNEG = 12 shl D3DSP_SRCMOD_SHIFT; // -abs() - {$EXTERNALSYM D3DSPSM_ABSNEG} - D3DSPSM_NOT = 13 shl D3DSP_SRCMOD_SHIFT; // for predicate register: "!p0" - {$EXTERNALSYM D3DSPSM_NOT} - D3DSPSM_FORCE_DWORD = $7fffffff; // force 32-bit size enum - {$EXTERNALSYM D3DSPSM_FORCE_DWORD} - -// pixel shader version token -//#define D3DPS_VERSION(_Major,_Minor) (0xFFFF0000|((_Major)<<8)|(_Minor)) -function D3DPS_VERSION(_Major, _Minor: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DPS_VERSION} - -// vertex shader version token -//#define D3DVS_VERSION(_Major,_Minor) (0xFFFE0000|((_Major)<<8)|(_Minor)) -function D3DVS_VERSION(_Major, _Minor: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DVS_VERSION} - -// extract major/minor from version cap -//#define D3DSHADER_VERSION_MAJOR(_Version) (((_Version)>>8)&0xFF) -function D3DSHADER_VERSION_MAJOR(_Version: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DSHADER_VERSION_MAJOR} -//#define D3DSHADER_VERSION_MINOR(_Version) (((_Version)>>0)&0xFF) -function D3DSHADER_VERSION_MINOR(_Version: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DSHADER_VERSION_MINOR} - -const - // destination/source parameter register type - D3DSI_COMMENTSIZE_SHIFT = 16; - {$EXTERNALSYM D3DSI_COMMENTSIZE_SHIFT} - D3DSI_COMMENTSIZE_MASK = $7FFF0000; - {$EXTERNALSYM D3DSI_COMMENTSIZE_MASK} - -//#define D3DSHADER_COMMENT(_DWordSize) \ -// ((((_DWordSize)<<D3DSI_COMMENTSIZE_SHIFT)&D3DSI_COMMENTSIZE_MASK)|D3DSIO_COMMENT) -function D3DSHADER_COMMENT(_DWordSize: DWord) : DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DSHADER_COMMENT} - -const - // pixel/vertex shader end token - D3DPS_END = $0000FFFF; - {$EXTERNALSYM D3DPS_END} - D3DVS_END = $0000FFFF; - {$EXTERNALSYM D3DVS_END} - - -//--------------------------------------------------------------------- - -type - // High order surfaces - // - _D3DBASISTYPE = ( - D3DBASIS_BEZIER {= 0}, - D3DBASIS_BSPLINE {= 1}, - D3DBASIS_CATMULL_ROM {= 2} { In D3D8 this used to be D3DBASIS_INTERPOLATE } - ); - {$EXTERNALSYM _D3DBASISTYPE} - D3DBASISTYPE = _D3DBASISTYPE; - {$EXTERNALSYM D3DBASISTYPE} - TD3DBasisType = _D3DBASISTYPE; - - _D3DDEGREETYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DDEGREE_invalid_0 {= 0}, - D3DDEGREE_LINEAR {= 1}, - D3DDEGREE_QUADRATIC {= 2}, - D3DDEGREE_CUBIC {= 3}, - D3DDEGREE_invalid_4 {= 4}, - D3DDEGREE_QUINTIC {= 5} - {$ELSE} - D3DDEGREE_LINEAR = 1, - D3DDEGREE_QUADRATIC = 2, - D3DDEGREE_CUBIC = 3, - D3DDEGREE_QUINTIC = 5 - {$ENDIF} - ); - {$EXTERNALSYM _D3DDEGREETYPE} - D3DDEGREETYPE = _D3DDEGREETYPE; - {$EXTERNALSYM D3DDEGREETYPE} - TD3DDegreeType = _D3DDEGREETYPE; - - _D3DPATCHEDGESTYLE = ( - D3DPATCHEDGE_DISCRETE {= 0}, - D3DPATCHEDGE_CONTINUOUS {= 1} - ); - {$EXTERNALSYM _D3DPATCHEDGESTYLE} - D3DPATCHEDGESTYLE = _D3DPATCHEDGESTYLE; - {$EXTERNALSYM D3DPATCHEDGESTYLE} - TD3DPatchEdgeStyle = _D3DPATCHEDGESTYLE; - - _D3DSTATEBLOCKTYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DSBT_INVALID_0, - D3DSBT_ALL {= 1}, // capture all state - D3DSBT_PIXELSTATE {= 2}, // capture pixel state - D3DSBT_VERTEXSTATE {= 3} // capture vertex state - {$ELSE} - D3DSBT_ALL = 1, // capture all state - D3DSBT_PIXELSTATE = 2, // capture pixel state - D3DSBT_VERTEXSTATE = 3 // capture vertex state - {$ENDIF} - ); - {$EXTERNALSYM _D3DSTATEBLOCKTYPE} - D3DSTATEBLOCKTYPE = _D3DSTATEBLOCKTYPE; - {$EXTERNALSYM D3DSTATEBLOCKTYPE} - TD3DStateBlockType = _D3DSTATEBLOCKTYPE; - -type - // The D3DVERTEXBLENDFLAGS type is used with D3DRS_VERTEXBLEND state. - // - _D3DVERTEXBLENDFLAGS = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DVERTEXBLENDFLAGS} - D3DVERTEXBLENDFLAGS = _D3DVERTEXBLENDFLAGS; - {$EXTERNALSYM D3DVERTEXBLENDFLAGS} - TD3DVertexBlendFlags = _D3DVERTEXBLENDFLAGS; - -const - D3DVBF_DISABLE = 0; // Disable vertex blending - {$EXTERNALSYM D3DVBF_DISABLE} - D3DVBF_1WEIGHTS = 1; // 2 matrix blending - {$EXTERNALSYM D3DVBF_1WEIGHTS} - D3DVBF_2WEIGHTS = 2; // 3 matrix blending - {$EXTERNALSYM D3DVBF_2WEIGHTS} - D3DVBF_3WEIGHTS = 3; // 4 matrix blending - {$EXTERNALSYM D3DVBF_3WEIGHTS} - D3DVBF_TWEENING = 255; // blending using D3DRS_TWEENFACTOR - {$EXTERNALSYM D3DVBF_TWEENING} - D3DVBF_0WEIGHTS = 256; // one matrix is used with weight 1.0 - {$EXTERNALSYM D3DVBF_0WEIGHTS} - D3DVBF_FORCE_DWORD = $7fffffff; // force 32-bit size enum - {$EXTERNALSYM D3DVBF_FORCE_DWORD} - -type - _D3DTEXTURETRANSFORMFLAGS = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; - {$EXTERNALSYM _D3DTEXTURETRANSFORMFLAGS} - D3DTEXTURETRANSFORMFLAGS = _D3DTEXTURETRANSFORMFLAGS; - {$EXTERNALSYM D3DTEXTURETRANSFORMFLAGS} - TD3DTextureTransformFlags = _D3DTEXTURETRANSFORMFLAGS; - -const - D3DTTFF_DISABLE = 0; // texture coordinates are passed directly - {$EXTERNALSYM D3DTTFF_DISABLE} - D3DTTFF_COUNT1 = 1; // rasterizer should expect 1-D texture coords - {$EXTERNALSYM D3DTTFF_COUNT1} - D3DTTFF_COUNT2 = 2; // rasterizer should expect 2-D texture coords - {$EXTERNALSYM D3DTTFF_COUNT2} - D3DTTFF_COUNT3 = 3; // rasterizer should expect 3-D texture coords - {$EXTERNALSYM D3DTTFF_COUNT3} - D3DTTFF_COUNT4 = 4; // rasterizer should expect 4-D texture coords - {$EXTERNALSYM D3DTTFF_COUNT4} - D3DTTFF_PROJECTED = 256; // texcoords to be divided by COUNTth element - {$EXTERNALSYM D3DTTFF_PROJECTED} - D3DTTFF_FORCE_DWORD = $7fffffff; - {$EXTERNALSYM D3DTTFF_FORCE_DWORD} - -const - // Macros to set texture coordinate format bits in the FVF id - - D3DFVF_TEXTUREFORMAT2 = 0; // Two floating point values - {$EXTERNALSYM D3DFVF_TEXTUREFORMAT2} - D3DFVF_TEXTUREFORMAT1 = 3; // One floating point value - {$EXTERNALSYM D3DFVF_TEXTUREFORMAT1} - D3DFVF_TEXTUREFORMAT3 = 1; // Three floating point values - {$EXTERNALSYM D3DFVF_TEXTUREFORMAT3} - D3DFVF_TEXTUREFORMAT4 = 2; // Four floating point values - {$EXTERNALSYM D3DFVF_TEXTUREFORMAT4} - -//#define D3DFVF_TEXCOORDSIZE3(CoordIndex) (D3DFVF_TEXTUREFORMAT3 << (CoordIndex*2 + 16)) -function D3DFVF_TEXCOORDSIZE3(CoordIndex: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DFVF_TEXCOORDSIZE3} -//#define D3DFVF_TEXCOORDSIZE2(CoordIndex) (D3DFVF_TEXTUREFORMAT2) -function D3DFVF_TEXCOORDSIZE2(CoordIndex: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DFVF_TEXCOORDSIZE2} -//#define D3DFVF_TEXCOORDSIZE4(CoordIndex) (D3DFVF_TEXTUREFORMAT4 << (CoordIndex*2 + 16)) -function D3DFVF_TEXCOORDSIZE4(CoordIndex: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DFVF_TEXCOORDSIZE4} -//#define D3DFVF_TEXCOORDSIZE1(CoordIndex) (D3DFVF_TEXTUREFORMAT1 << (CoordIndex*2 + 16)) -function D3DFVF_TEXCOORDSIZE1(CoordIndex: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM D3DFVF_TEXCOORDSIZE1} - - -//--------------------------------------------------------------------- - -type - { Direct3D9 Device types } - _D3DDEVTYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DDEVTYPE_INVALID_0, - D3DDEVTYPE_HAL {= 1}, - D3DDEVTYPE_REF {= 2}, - D3DDEVTYPE_SW {= 3}, - - D3DDEVTYPE_NULLREF {= 4} - {$ELSE} - D3DDEVTYPE_HAL = 1, - D3DDEVTYPE_REF = 2, - D3DDEVTYPE_SW = 3, - - D3DDEVTYPE_NULLREF = 4 - {$ENDIF} - ); - {$EXTERNALSYM _D3DDEVTYPE} - D3DDEVTYPE = _D3DDEVTYPE; - {$EXTERNALSYM D3DDEVTYPE} - TD3DDevType = _D3DDEVTYPE; - - { Multi-Sample buffer types } - _D3DMULTISAMPLE_TYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DMULTISAMPLE_NONE {= 0}, - D3DMULTISAMPLE_NONMASKABLE {= 1}, - D3DMULTISAMPLE_2_SAMPLES {= 2}, - D3DMULTISAMPLE_3_SAMPLES {= 3}, - D3DMULTISAMPLE_4_SAMPLES {= 4}, - D3DMULTISAMPLE_5_SAMPLES {= 5}, - D3DMULTISAMPLE_6_SAMPLES {= 6}, - D3DMULTISAMPLE_7_SAMPLES {= 7}, - D3DMULTISAMPLE_8_SAMPLES {= 8}, - D3DMULTISAMPLE_9_SAMPLES {= 9}, - D3DMULTISAMPLE_10_SAMPLES {= 10}, - D3DMULTISAMPLE_11_SAMPLES {= 11}, - D3DMULTISAMPLE_12_SAMPLES {= 12}, - D3DMULTISAMPLE_13_SAMPLES {= 13}, - D3DMULTISAMPLE_14_SAMPLES {= 14}, - D3DMULTISAMPLE_15_SAMPLES {= 15}, - D3DMULTISAMPLE_16_SAMPLES {= 16} - {$ELSE} - D3DMULTISAMPLE_NONE = 0, - D3DMULTISAMPLE_NONMASKABLE = 1, - D3DMULTISAMPLE_2_SAMPLES = 2, - D3DMULTISAMPLE_3_SAMPLES = 3, - D3DMULTISAMPLE_4_SAMPLES = 4, - D3DMULTISAMPLE_5_SAMPLES = 5, - D3DMULTISAMPLE_6_SAMPLES = 6, - D3DMULTISAMPLE_7_SAMPLES = 7, - D3DMULTISAMPLE_8_SAMPLES = 8, - D3DMULTISAMPLE_9_SAMPLES = 9, - D3DMULTISAMPLE_10_SAMPLES = 10, - D3DMULTISAMPLE_11_SAMPLES = 11, - D3DMULTISAMPLE_12_SAMPLES = 12, - D3DMULTISAMPLE_13_SAMPLES = 13, - D3DMULTISAMPLE_14_SAMPLES = 14, - D3DMULTISAMPLE_15_SAMPLES = 15, - D3DMULTISAMPLE_16_SAMPLES = 16 - {$ENDIF} - ); - {$EXTERNALSYM _D3DMULTISAMPLE_TYPE} - D3DMULTISAMPLE_TYPE = _D3DMULTISAMPLE_TYPE; - {$EXTERNALSYM D3DMULTISAMPLE_TYPE} - TD3DMultiSampleType = _D3DMULTISAMPLE_TYPE; - -(* Formats - * Most of these names have the following convention: - * A = Alpha - * R = Red - * G = Green - * B = Blue - * X = Unused Bits - * P = Palette - * L = Luminance - * U = dU coordinate for BumpMap - * V = dV coordinate for BumpMap - * S = Stencil - * D = Depth (e.g. Z or W buffer) - * C = Computed from other channels (typically on certain read operations) - * - * Further, the order of the pieces are from MSB first; hence - * D3DFMT_A8L8 indicates that the high byte of this two byte - * format is alpha. - * - * D3DFMT_D16_LOCKABLE indicates: - * - An integer 16-bit value. - * - An app-lockable surface. - * - * D3DFMT_D32F_LOCKABLE indicates: - * - An IEEE 754 floating-point value. - * - An app-lockable surface. - * - * All Depth/Stencil formats except D3DFMT_D16_LOCKABLE and D3DFMT_D32F_LOCKABLE indicate: - * - no particular bit ordering per pixel, and - * - are not app lockable, and - * - the driver is allowed to consume more than the indicated - * number of bits per Depth channel (but not Stencil channel). - *) -// #define MAKEFOURCC(ch0, ch1, ch2, ch3) \ -// ((DWORD)(BYTE)(ch0) | ((DWORD)(BYTE)(ch1) << 8) | \ -// ((DWORD)(BYTE)(ch2) << 16) | ((DWORD)(BYTE)(ch3) << 24 )) -function MAKEFOURCC(ch0, ch1, ch2, ch3: AnsiChar): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM MAKEFOURCC} - - -{$IFNDEF SUPPORTS_EXPL_ENUMS_except_BCB6} -const - D3DFMT_UNKNOWN = 0; - {$EXTERNALSYM D3DFMT_UNKNOWN} - - D3DFMT_R8G8B8 = 20; - {$EXTERNALSYM D3DFMT_R8G8B8} - D3DFMT_A8R8G8B8 = 21; - {$EXTERNALSYM D3DFMT_A8R8G8B8} - D3DFMT_X8R8G8B8 = 22; - {$EXTERNALSYM D3DFMT_X8R8G8B8} - D3DFMT_R5G6B5 = 23; - {$EXTERNALSYM D3DFMT_R5G6B5} - D3DFMT_X1R5G5B5 = 24; - {$EXTERNALSYM D3DFMT_X1R5G5B5} - D3DFMT_A1R5G5B5 = 25; - {$EXTERNALSYM D3DFMT_A1R5G5B5} - D3DFMT_A4R4G4B4 = 26; - {$EXTERNALSYM D3DFMT_A4R4G4B4} - D3DFMT_R3G3B2 = 27; - {$EXTERNALSYM D3DFMT_R3G3B2} - D3DFMT_A8 = 28; - {$EXTERNALSYM D3DFMT_A8} - D3DFMT_A8R3G3B2 = 29; - {$EXTERNALSYM D3DFMT_A8R3G3B2} - D3DFMT_X4R4G4B4 = 30; - {$EXTERNALSYM D3DFMT_X4R4G4B4} - D3DFMT_A2B10G10R10 = 31; - {$EXTERNALSYM D3DFMT_A2B10G10R10} - D3DFMT_A8B8G8R8 = 32; - {$EXTERNALSYM D3DFMT_A8B8G8R8} - D3DFMT_X8B8G8R8 = 33; - {$EXTERNALSYM D3DFMT_X8B8G8R8} - D3DFMT_G16R16 = 34; - {$EXTERNALSYM D3DFMT_G16R16} - D3DFMT_A2R10G10B10 = 35; - {$EXTERNALSYM D3DFMT_A2R10G10B10} - D3DFMT_A16B16G16R16 = 36; - {$EXTERNALSYM D3DFMT_A16B16G16R16} - - D3DFMT_A8P8 = 40; - {$EXTERNALSYM D3DFMT_A8P8} - D3DFMT_P8 = 41; - {$EXTERNALSYM D3DFMT_P8} - - D3DFMT_L8 = 50; - {$EXTERNALSYM D3DFMT_L8} - D3DFMT_A8L8 = 51; - {$EXTERNALSYM D3DFMT_A8L8} - D3DFMT_A4L4 = 52; - {$EXTERNALSYM D3DFMT_A4L4} - - D3DFMT_V8U8 = 60; - {$EXTERNALSYM D3DFMT_V8U8} - D3DFMT_L6V5U5 = 61; - {$EXTERNALSYM D3DFMT_L6V5U5} - D3DFMT_X8L8V8U8 = 62; - {$EXTERNALSYM D3DFMT_X8L8V8U8} - D3DFMT_Q8W8V8U8 = 63; - {$EXTERNALSYM D3DFMT_Q8W8V8U8} - D3DFMT_V16U16 = 64; - {$EXTERNALSYM D3DFMT_V16U16} - D3DFMT_A2W10V10U10 = 67; - {$EXTERNALSYM D3DFMT_A2W10V10U10} - - // D3DFMT_UYVY = MAKEFOURCC('U', 'Y', 'V', 'Y'); - D3DFMT_UYVY = Byte('U') or (Byte('Y') shl 8) or (Byte('V') shl 16) or (Byte('Y') shl 24); - {$EXTERNALSYM D3DFMT_UYVY} - // D3DFMT_R8G8_B8G8 = MAKEFOURCC('R', 'G', 'B', 'G'), - D3DFMT_R8G8_B8G8 = Byte('R') or (Byte('G') shl 8) or (Byte('B') shl 16) or (Byte('G') shl 24); - {$EXTERNALSYM D3DFMT_R8G8_B8G8} - // D3DFMT_YUY2 = MAKEFOURCC('Y', 'U', 'Y', '2'), - D3DFMT_YUY2 = Byte('Y') or (Byte('U') shl 8) or (Byte('Y') shl 16) or (Byte('2') shl 24); - {$EXTERNALSYM D3DFMT_YUY2} - // D3DFMT_G8R8_G8B8 = MAKEFOURCC('G', 'R', 'G', 'B'), - D3DFMT_G8R8_G8B8 = Byte('G') or (Byte('R') shl 8) or (Byte('G') shl 16) or (Byte('B') shl 24); - {$EXTERNALSYM D3DFMT_G8R8_G8B8} - // D3DFMT_DXT1 = MAKEFOURCC('D', 'X', 'T', '1'), - D3DFMT_DXT1 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('1') shl 24); - {$EXTERNALSYM D3DFMT_DXT1} - // D3DFMT_DXT2 = MAKEFOURCC('D', 'X', 'T', '2'), - D3DFMT_DXT2 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('2') shl 24); - {$EXTERNALSYM D3DFMT_DXT2} - // D3DFMT_DXT3 = MAKEFOURCC('D', 'X', 'T', '3'), - D3DFMT_DXT3 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('3') shl 24); - {$EXTERNALSYM D3DFMT_DXT3} - // D3DFMT_DXT4 = MAKEFOURCC('D', 'X', 'T', '4'), - D3DFMT_DXT4 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('4') shl 24); - {$EXTERNALSYM D3DFMT_DXT4} - // D3DFMT_DXT5 = MAKEFOURCC('D', 'X', 'T', '5'), - D3DFMT_DXT5 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('5') shl 24); - {$EXTERNALSYM D3DFMT_DXT5} - - D3DFMT_D16_LOCKABLE = 70; - {$EXTERNALSYM D3DFMT_D16_LOCKABLE} - D3DFMT_D32 = 71; - {$EXTERNALSYM D3DFMT_D32} - D3DFMT_D15S1 = 73; - {$EXTERNALSYM D3DFMT_D15S1} - D3DFMT_D24S8 = 75; - {$EXTERNALSYM D3DFMT_D24S8} - D3DFMT_D24X8 = 77; - {$EXTERNALSYM D3DFMT_D24X8} - D3DFMT_D24X4S4 = 79; - {$EXTERNALSYM D3DFMT_D24X4S4} - D3DFMT_D16 = 80; - {$EXTERNALSYM D3DFMT_D16} - - - D3DFMT_D32F_LOCKABLE = 82; - {$EXTERNALSYM D3DFMT_D32F_LOCKABLE} - D3DFMT_D24FS8 = 83; - {$EXTERNALSYM D3DFMT_D24FS8} - -{$IFDEF DIRECT3D_VERSION_9_VISTA} - (* Z-Stencil formats valid for CPU access *) - D3DFMT_D32_LOCKABLE = 84; - {$EXTERNALSYM D3DFMT_D32_LOCKABLE} - D3DFMT_S8_LOCKABLE = 85; - {$EXTERNALSYM D3DFMT_S8_LOCKABLE} - - -{$ENDIF} - - D3DFMT_L16 = 81; - {$EXTERNALSYM D3DFMT_L16} - - - D3DFMT_VERTEXDATA =100; - {$EXTERNALSYM D3DFMT_VERTEXDATA} - D3DFMT_INDEX16 =101; - {$EXTERNALSYM D3DFMT_INDEX16} - D3DFMT_INDEX32 =102; - {$EXTERNALSYM D3DFMT_INDEX32} - - D3DFMT_Q16W16V16U16 =110; - {$EXTERNALSYM D3DFMT_Q16W16V16U16} - - // D3DFMT_MULTI2_ARGB8 = MAKEFOURCC('M','E','T','1'), - D3DFMT_MULTI2_ARGB8 = Byte('M') or (Byte('E') shl 8) or (Byte('T') shl 16) or (Byte('1') shl 24); - {$EXTERNALSYM D3DFMT_MULTI2_ARGB8} - - // Floating point surface formats - - // s10e5 formats (16-bits per channel) - D3DFMT_R16F = 111; - {$EXTERNALSYM D3DFMT_R16F} - D3DFMT_G16R16F = 112; - {$EXTERNALSYM D3DFMT_G16R16F} - D3DFMT_A16B16G16R16F = 113; - {$EXTERNALSYM D3DFMT_A16B16G16R16F} - - // IEEE s23e8 formats (32-bits per channel) - D3DFMT_R32F = 114; - {$EXTERNALSYM D3DFMT_R32F} - D3DFMT_G32R32F = 115; - {$EXTERNALSYM D3DFMT_G32R32F} - D3DFMT_A32B32G32R32F = 116; - {$EXTERNALSYM D3DFMT_A32B32G32R32F} - - D3DFMT_CxV8U8 = 117; - {$EXTERNALSYM D3DFMT_CxV8U8} - -{$IFDEF DIRECT3D_VERSION_9_VISTA} - // Monochrome 1 bit per pixel format - D3DFMT_A1 = 118; - {$EXTERNALSYM D3DFMT_A1} - - - // Binary format indicating that the data has no inherent type - D3DFMT_BINARYBUFFER = 199; - {$EXTERNALSYM D3DFMT_BINARYBUFFER} - -{$ENDIF} - - // ATI - 3Dc/ATI2N texture format - // D3DFMT_ATI2 = MAKEFOURCC('A', 'T', 'I', '2'), - D3DFMT_ATI2 = Byte('A') or (Byte('T') shl 8) or (Byte('I') shl 16) or (Byte('2') shl 24); - //{$EXTERNALSYM D3DFMT_ATI2} //Clootie: - this is not defined in original SDK headers - - D3DFMT_FORCE_DWORD = $7fffffff; - {$EXTERNALSYM D3DFMT_FORCE_DWORD} - -type - _D3DFORMAT = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; -{$ELSE} -type - _D3DFORMAT = ( - D3DFMT_UNKNOWN = 0, - - D3DFMT_R8G8B8 = 20, - D3DFMT_A8R8G8B8 = 21, - D3DFMT_X8R8G8B8 = 22, - D3DFMT_R5G6B5 = 23, - D3DFMT_X1R5G5B5 = 24, - D3DFMT_A1R5G5B5 = 25, - D3DFMT_A4R4G4B4 = 26, - D3DFMT_R3G3B2 = 27, - D3DFMT_A8 = 28, - D3DFMT_A8R3G3B2 = 29, - D3DFMT_X4R4G4B4 = 30, - D3DFMT_A2B10G10R10 = 31, - D3DFMT_A8B8G8R8 = 32, - D3DFMT_X8B8G8R8 = 33, - D3DFMT_G16R16 = 34, - D3DFMT_A2R10G10B10 = 35, - D3DFMT_A16B16G16R16 = 36, - - D3DFMT_A8P8 = 40, - D3DFMT_P8 = 41, - - D3DFMT_L8 = 50, - D3DFMT_A8L8 = 51, - D3DFMT_A4L4 = 52, - - D3DFMT_V8U8 = 60, - D3DFMT_L6V5U5 = 61, - D3DFMT_X8L8V8U8 = 62, - D3DFMT_Q8W8V8U8 = 63, - D3DFMT_V16U16 = 64, - D3DFMT_A2W10V10U10 = 67, - D3DFMT_A8X8V8U8 = 68, - D3DFMT_L8X8V8U8 = 69, - - // D3DFMT_UYVY = MAKEFOURCC('U', 'Y', 'V', 'Y'), - D3DFMT_UYVY = Byte('U') or (Byte('Y') shl 8) or (Byte('V') shl 16) or (Byte('Y') shl 24), - // D3DFMT_RGBG = MAKEFOURCC('R', 'G', 'B', 'G'), - D3DFMT_RGBG = Byte('R') or (Byte('G') shl 8) or (Byte('B') shl 16) or (Byte('G') shl 24), - // D3DFMT_YUY2 = MAKEFOURCC('Y', 'U', 'Y', '2'), - D3DFMT_YUY2 = Byte('Y') or (Byte('U') shl 8) or (Byte('Y') shl 16) or (Byte('2') shl 24), - // D3DFMT_GRGB = MAKEFOURCC('G', 'R', 'G', 'B'), - D3DFMT_GRGB = Byte('G') or (Byte('R') shl 8) or (Byte('G') shl 16) or (Byte('B') shl 24), - // D3DFMT_DXT1 = MAKEFOURCC('D', 'X', 'T', '1'), - D3DFMT_DXT1 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('1') shl 24), - // D3DFMT_DXT2 = MAKEFOURCC('D', 'X', 'T', '2'), - D3DFMT_DXT2 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('2') shl 24), - // D3DFMT_DXT3 = MAKEFOURCC('D', 'X', 'T', '3'), - D3DFMT_DXT3 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('3') shl 24), - // D3DFMT_DXT4 = MAKEFOURCC('D', 'X', 'T', '4'), - D3DFMT_DXT4 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('4') shl 24), - // D3DFMT_DXT5 = MAKEFOURCC('D', 'X', 'T', '5'), - D3DFMT_DXT5 = Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or (Byte('5') shl 24), - - D3DFMT_D16_LOCKABLE = 70, - D3DFMT_D32 = 71, - D3DFMT_D15S1 = 73, - D3DFMT_D24S8 = 75, - D3DFMT_D24X8 = 77, - D3DFMT_D24X4S4 = 79, - D3DFMT_D16 = 80, - - D3DFMT_D32F_LOCKABLE = 82, - D3DFMT_D24FS8 = 83, - -{$IFDEF DIRECT3D_VERSION_9_VISTA} - (* Z-Stencil formats valid for CPU access *) - D3DFMT_D32_LOCKABLE = 84, - D3DFMT_S8_LOCKABLE = 85, - - -{$ENDIF} - - D3DFMT_L16 = 81, - - D3DFMT_VERTEXDATA =100, - D3DFMT_INDEX16 =101, - D3DFMT_INDEX32 =102, - - D3DFMT_Q16W16V16U16 =110, - - // D3DFMT_MULTI2_ARGB8 = MAKEFOURCC('M','E','T','1'), - D3DFMT_MULTI2_ARGB8 = Byte('M') or (Byte('E') shl 8) or (Byte('T') shl 16) or (Byte('1') shl 24), - - // Floating point surface formats - - // s10e5 formats (16-bits per channel) - D3DFMT_R16F = 111, - D3DFMT_G16R16F = 112, - D3DFMT_A16B16G16R16F = 113, - - // IEEE s23e8 formats (32-bits per channel) - D3DFMT_R32F = 114, - D3DFMT_G32R32F = 115, - D3DFMT_A32B32G32R32F = 116, - - D3DFMT_CxV8U8 = 117, - -{$IFDEF DIRECT3D_VERSION_9_VISTA} - // Monochrome 1 bit per pixel format - D3DFMT_A1 = 118, - - - // Binary format indicating that the data has no inherent type - D3DFMT_BINARYBUFFER = 199, - -{$ENDIF} - - D3DFMT_FORCE_DWORD = $7fffffff - ); -{$ENDIF} - {$EXTERNALSYM _D3DFORMAT} - D3DFORMAT = _D3DFORMAT; - {$EXTERNALSYM D3DFORMAT} - PD3DFormat = ^TD3DFormat; - TD3DFormat = _D3DFORMAT; - - { Display Modes } - PD3DDisplayMode = ^TD3DDisplayMode; - _D3DDISPLAYMODE = packed record - Width: LongWord; - Height: LongWord; - RefreshRate: LongWord; - Format: TD3DFormat; - end {_D3DDISPLAYMODE}; - {$EXTERNALSYM _D3DDISPLAYMODE} - D3DDISPLAYMODE = _D3DDISPLAYMODE; - {$EXTERNALSYM D3DDISPLAYMODE} - TD3DDisplayMode = _D3DDISPLAYMODE; - - { Creation Parameters } - PD3DDeviceCreationParameters = ^TD3DDeviceCreationParameters; - _D3DDEVICE_CREATION_PARAMETERS = packed record - AdapterOrdinal: LongWord; - DeviceType: TD3DDevType; - hFocusWindow: HWND; - BehaviorFlags: LongInt; - end {_D3DDEVICE_CREATION_PARAMETERS}; - {$EXTERNALSYM _D3DDEVICE_CREATION_PARAMETERS} - D3DDEVICE_CREATION_PARAMETERS = _D3DDEVICE_CREATION_PARAMETERS; - {$EXTERNALSYM D3DDEVICE_CREATION_PARAMETERS} - TD3DDeviceCreationParameters = _D3DDEVICE_CREATION_PARAMETERS; - - - { SwapEffects } - _D3DSWAPEFFECT = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DSWAPEFFECT_INVALID_0 {= 0}, - D3DSWAPEFFECT_DISCARD {= 1}, - D3DSWAPEFFECT_FLIP {= 2}, - D3DSWAPEFFECT_COPY {= 3} - {$ELSE} - D3DSWAPEFFECT_DISCARD = 1, - D3DSWAPEFFECT_FLIP = 2, - D3DSWAPEFFECT_COPY = 3 - {$ENDIF} - ); - {$EXTERNALSYM _D3DSWAPEFFECT} - D3DSWAPEFFECT = _D3DSWAPEFFECT; - {$EXTERNALSYM D3DSWAPEFFECT} - TD3DSwapEffect = _D3DSWAPEFFECT; - - { Pool types } - _D3DPOOL = ( - D3DPOOL_DEFAULT {= 0}, - D3DPOOL_MANAGED {= 1}, - D3DPOOL_SYSTEMMEM {= 2}, - D3DPOOL_SCRATCH {= 3} - ); - {$EXTERNALSYM _D3DPOOL} - D3DPOOL = _D3DPOOL; - {$EXTERNALSYM D3DPOOL} - TD3DPool = _D3DPOOL; - - -const - { RefreshRate pre-defines } - D3DPRESENT_RATE_DEFAULT = $00000000; - {$EXTERNALSYM D3DPRESENT_RATE_DEFAULT} - -type - { Resize Optional Parameters } - PD3DPresentParameters = ^TD3DPresentParameters; - _D3DPRESENT_PARAMETERS_ = packed record - BackBufferWidth: LongWord; - BackBufferHeight: LongWord; - BackBufferFormat: TD3DFormat; - BackBufferCount: LongWord; - - MultiSampleType: TD3DMultiSampleType; - MultiSampleQuality: DWORD; - - SwapEffect: TD3DSwapEffect; - hDeviceWindow: HWND; - Windowed: Bool; - EnableAutoDepthStencil: Bool; - AutoDepthStencilFormat: TD3DFormat; - Flags: LongInt; - - { FullScreen_RefreshRateInHz must be zero for Windowed mode } - FullScreen_RefreshRateInHz: LongWord; - PresentationInterval: LongWord; - end {_D3DPRESENT_PARAMETERS_}; - {$EXTERNALSYM _D3DPRESENT_PARAMETERS_} - D3DPRESENT_PARAMETERS = _D3DPRESENT_PARAMETERS_; - {$EXTERNALSYM D3DPRESENT_PARAMETERS} - TD3DPresentParameters = _D3DPRESENT_PARAMETERS_; - - // Values for D3DPRESENT_PARAMETERS.Flags - -const - D3DPRESENTFLAG_LOCKABLE_BACKBUFFER = $00000001; - {$EXTERNALSYM D3DPRESENTFLAG_LOCKABLE_BACKBUFFER} - D3DPRESENTFLAG_DISCARD_DEPTHSTENCIL = $00000002; - {$EXTERNALSYM D3DPRESENTFLAG_DISCARD_DEPTHSTENCIL} - D3DPRESENTFLAG_DEVICECLIP = $00000004; - {$EXTERNALSYM D3DPRESENTFLAG_DEVICECLIP} - D3DPRESENTFLAG_VIDEO = $00000010; - {$EXTERNALSYM D3DPRESENTFLAG_VIDEO} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DPRESENTFLAG_NOAUTOROTATE = $00000020; - {$EXTERNALSYM D3DPRESENTFLAG_NOAUTOROTATE} - D3DPRESENTFLAG_UNPRUNEDMODE = $00000040; - {$EXTERNALSYM D3DPRESENTFLAG_UNPRUNEDMODE} - -{$ENDIF} - - { Gamma Ramp: Same as DX7 } - -type - PD3DGammaRamp = ^TD3DGammaRamp; - _D3DGAMMARAMP = packed record - red : array [0..255] of Word; - green : array [0..255] of Word; - blue : array [0..255] of Word; - end; - {$EXTERNALSYM _D3DGAMMARAMP} - D3DGAMMARAMP = _D3DGAMMARAMP; - {$EXTERNALSYM D3DGAMMARAMP} - TD3DGammaRamp = _D3DGAMMARAMP; - - { Back buffer types } - _D3DBACKBUFFER_TYPE = ( - D3DBACKBUFFER_TYPE_MONO {= 0}, - D3DBACKBUFFER_TYPE_LEFT {= 1}, - D3DBACKBUFFER_TYPE_RIGHT {= 2} - ); - {$EXTERNALSYM _D3DBACKBUFFER_TYPE} - D3DBACKBUFFER_TYPE = _D3DBACKBUFFER_TYPE; - {$EXTERNALSYM D3DBACKBUFFER_TYPE} - TD3DBackbufferType = _D3DBACKBUFFER_TYPE; - - - { Types } - _D3DRESOURCETYPE = ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DRTYPE_INVALID_0 {= 0}, - D3DRTYPE_SURFACE {= 1}, - D3DRTYPE_VOLUME {= 2}, - D3DRTYPE_TEXTURE {= 3}, - D3DRTYPE_VOLUMETEXTURE {= 4}, - D3DRTYPE_CUBETEXTURE {= 5}, - D3DRTYPE_VERTEXBUFFER {= 6}, - D3DRTYPE_INDEXBUFFER {= 7} //if this changes, change _D3DDEVINFO_RESOURCEMANAGER definition - {$ELSE} - D3DRTYPE_SURFACE = 1, - D3DRTYPE_VOLUME = 2, - D3DRTYPE_TEXTURE = 3, - D3DRTYPE_VOLUMETEXTURE = 4, - D3DRTYPE_CUBETEXTURE = 5, - D3DRTYPE_VERTEXBUFFER = 6, - D3DRTYPE_INDEXBUFFER = 7 //if this changes, change _D3DDEVINFO_RESOURCEMANAGER definition - {$ENDIF} - ); - {$EXTERNALSYM _D3DRESOURCETYPE} - D3DRESOURCETYPE = _D3DRESOURCETYPE; - {$EXTERNALSYM D3DRESOURCETYPE} - TD3DResourceType = _D3DRESOURCETYPE; - -const - { Usages } - D3DUSAGE_RENDERTARGET = $00000001; - {$EXTERNALSYM D3DUSAGE_RENDERTARGET} - D3DUSAGE_DEPTHSTENCIL = $00000002; - {$EXTERNALSYM D3DUSAGE_DEPTHSTENCIL} - D3DUSAGE_DYNAMIC = $00000200; - {$EXTERNALSYM D3DUSAGE_DYNAMIC} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DUSAGE_NONSECURE = $00800000; - {$EXTERNALSYM D3DUSAGE_NONSECURE} -{$ENDIF} - - // When passed to CheckDeviceFormat, D3DUSAGE_AUTOGENMIPMAP may return - // D3DOK_NOAUTOGEN if the device doesn't support autogeneration for that format. - // D3DOK_NOAUTOGEN is a success code, not a failure code... the SUCCEEDED and FAILED macros - // will return true and false respectively for this code. - D3DUSAGE_AUTOGENMIPMAP = $00000400; - {$EXTERNALSYM D3DUSAGE_AUTOGENMIPMAP} - D3DUSAGE_DMAP = $00004000; - {$EXTERNALSYM D3DUSAGE_DMAP} - - // The following usages are valid only for querying CheckDeviceFormat - D3DUSAGE_QUERY_LEGACYBUMPMAP = $00008000; - {$EXTERNALSYM D3DUSAGE_QUERY_LEGACYBUMPMAP} - D3DUSAGE_QUERY_SRGBREAD = $00010000; - {$EXTERNALSYM D3DUSAGE_QUERY_SRGBREAD} - D3DUSAGE_QUERY_FILTER = $00020000; - {$EXTERNALSYM D3DUSAGE_QUERY_FILTER} - D3DUSAGE_QUERY_SRGBWRITE = $00040000; - {$EXTERNALSYM D3DUSAGE_QUERY_SRGBWRITE} - D3DUSAGE_QUERY_POSTPIXELSHADER_BLENDING = $00080000; - {$EXTERNALSYM D3DUSAGE_QUERY_POSTPIXELSHADER_BLENDING} - D3DUSAGE_QUERY_VERTEXTEXTURE = $00100000; - {$EXTERNALSYM D3DUSAGE_QUERY_VERTEXTEXTURE} - D3DUSAGE_QUERY_WRAPANDMIP = $00200000; - {$EXTERNALSYM D3DUSAGE_QUERY_WRAPANDMIP} - - - { Usages for Vertex/Index buffers } - D3DUSAGE_WRITEONLY = $00000008; - {$EXTERNALSYM D3DUSAGE_WRITEONLY} - D3DUSAGE_SOFTWAREPROCESSING = $00000010; - {$EXTERNALSYM D3DUSAGE_SOFTWAREPROCESSING} - D3DUSAGE_DONOTCLIP = $00000020; - {$EXTERNALSYM D3DUSAGE_DONOTCLIP} - D3DUSAGE_POINTS = $00000040; - {$EXTERNALSYM D3DUSAGE_POINTS} - D3DUSAGE_RTPATCHES = $00000080; - {$EXTERNALSYM D3DUSAGE_RTPATCHES} - D3DUSAGE_NPATCHES = $00000100; - {$EXTERNALSYM D3DUSAGE_NPATCHES} - - - - - - - - -type - { CubeMap Face identifiers } - _D3DCUBEMAP_FACES = ( - D3DCUBEMAP_FACE_POSITIVE_X {= 0}, - D3DCUBEMAP_FACE_NEGATIVE_X {= 1}, - D3DCUBEMAP_FACE_POSITIVE_Y {= 2}, - D3DCUBEMAP_FACE_NEGATIVE_Y {= 3}, - D3DCUBEMAP_FACE_POSITIVE_Z {= 4}, - D3DCUBEMAP_FACE_NEGATIVE_Z {= 5} - ); - {$EXTERNALSYM _D3DCUBEMAP_FACES} - D3DCUBEMAP_FACES = _D3DCUBEMAP_FACES; - {$EXTERNALSYM D3DCUBEMAP_FACES} - TD3DCubemapFaces = _D3DCUBEMAP_FACES; - - -const - { Lock flags } - D3DLOCK_READONLY = $00000010; - {$EXTERNALSYM D3DLOCK_READONLY} - D3DLOCK_DISCARD = $00002000; - {$EXTERNALSYM D3DLOCK_DISCARD} - D3DLOCK_NOOVERWRITE = $00001000; - {$EXTERNALSYM D3DLOCK_NOOVERWRITE} - D3DLOCK_NOSYSLOCK = $00000800; - {$EXTERNALSYM D3DLOCK_NOSYSLOCK} - D3DLOCK_DONOTWAIT = $00004000; - {$EXTERNALSYM D3DLOCK_DONOTWAIT} - - D3DLOCK_NO_DIRTY_UPDATE = $00008000; - {$EXTERNALSYM D3DLOCK_NO_DIRTY_UPDATE} - - - - - - -type - { Vertex Buffer Description } - PD3DVertexBufferDesc = ^TD3DVertexBufferDesc; - _D3DVERTEXBUFFER_DESC = packed record - Format : TD3DFormat; - _Type : TD3DResourceType; - Usage : DWord; - Pool : TD3DPool; - Size : LongWord; - - FVF : DWord; - end; - {$EXTERNALSYM _D3DVERTEXBUFFER_DESC} - D3DVERTEXBUFFER_DESC = _D3DVERTEXBUFFER_DESC; - {$EXTERNALSYM D3DVERTEXBUFFER_DESC} - TD3DVertexBufferDesc = _D3DVERTEXBUFFER_DESC; - - { Index Buffer Description } - PD3DIndexBufferDesc = ^TD3DIndexBufferDesc; - _D3DINDEXBUFFER_DESC = packed record - Format : TD3DFormat; - _Type : TD3DResourceType; - Usage : DWord; - Pool : TD3DPool; - Size : LongWord; - end {_D3DINDEXBUFFER_DESC}; - {$EXTERNALSYM _D3DINDEXBUFFER_DESC} - D3DINDEXBUFFER_DESC = _D3DINDEXBUFFER_DESC; - {$EXTERNALSYM D3DINDEXBUFFER_DESC} - TD3DIndexBufferDesc = _D3DINDEXBUFFER_DESC; - - - { Surface Description } - PD3DSurfaceDesc = ^TD3DSurfaceDesc; - _D3DSURFACE_DESC = packed record - Format : TD3DFormat; - _Type : TD3DResourceType; - Usage : DWord; - Pool : TD3DPool; - - MultiSampleType: TD3DMultiSampleType; - MultiSampleQuality: DWORD; - Width : LongWord; - Height : LongWord; - end {_D3DSURFACE_DESC}; - {$EXTERNALSYM _D3DSURFACE_DESC} - D3DSURFACE_DESC = _D3DSURFACE_DESC; - {$EXTERNALSYM D3DSURFACE_DESC} - TD3DSurfaceDesc = _D3DSURFACE_DESC; - - PD3DVolumeDesc = ^TD3DVolumeDesc; - _D3DVOLUME_DESC = packed record - Format : TD3DFormat; - _Type : TD3DResourceType; - Usage : DWord; - Pool : TD3DPool; - - Width : LongWord; - Height : LongWord; - Depth : LongWord; - end {_D3DVOLUME_DESC}; - {$EXTERNALSYM _D3DVOLUME_DESC} - D3DVOLUME_DESC = _D3DVOLUME_DESC; - {$EXTERNALSYM D3DVOLUME_DESC} - TD3DVolumeDesc = _D3DVOLUME_DESC; - - { Structure for LockRect } - PD3DLockedRect = ^TD3DLockedRect; - _D3DLOCKED_RECT = packed record - Pitch: Integer; - pBits: Pointer; // void* - end {_D3DLOCKED_RECT}; - {$EXTERNALSYM _D3DLOCKED_RECT} - D3DLOCKED_RECT = _D3DLOCKED_RECT; - {$EXTERNALSYM D3DLOCKED_RECT} - TD3DLockedRect = _D3DLOCKED_RECT; - - { Structures for LockBox } - PD3DBox = ^TD3DBox; - _D3DBOX = packed record - Left : LongWord; - Top : LongWord; - Right : LongWord; - Bottom : LongWord; - Front : LongWord; - Back : LongWord; - end {_D3DBOX}; - {$EXTERNALSYM _D3DBOX} - D3DBOX = _D3DBOX; - {$EXTERNALSYM D3DBOX} - TD3DBox = _D3DBOX; - - PD3DLockedBox = ^TD3DLockedBox; - _D3DLOCKED_BOX = packed record - RowPitch : Integer; - SlicePitch : Integer; - pBits : Pointer; // void* - end {_D3DLOCKED_BOX}; - {$EXTERNALSYM _D3DLOCKED_BOX} - D3DLOCKED_BOX = _D3DLOCKED_BOX; - {$EXTERNALSYM D3DLOCKED_BOX} - TD3DLockedBox = _D3DLOCKED_BOX; - - { Structures for LockRange } - PD3DRange = ^TD3DRange; - _D3DRANGE = packed record - Offset : LongWord; - Size : LongWord; - end {_D3DRANGE}; - {$EXTERNALSYM _D3DRANGE} - D3DRANGE = _D3DRANGE; - {$EXTERNALSYM D3DRANGE} - TD3DRange = _D3DRANGE; - - { Structures for high order primitives } - PD3DRectPatchInfo = ^TD3DRectPatchInfo; - _D3DRECTPATCH_INFO = packed record - StartVertexOffsetWidth : LongWord; - StartVertexOffsetHeight : LongWord; - Width : LongWord; - Height : LongWord; - Stride : LongWord; - Basis : TD3DBasisType; - Degree : TD3DDegreeType; - end; - {$EXTERNALSYM _D3DRECTPATCH_INFO} - D3DRECTPATCH_INFO = _D3DRECTPATCH_INFO; - {$EXTERNALSYM D3DRECTPATCH_INFO} - TD3DRectPatchInfo = _D3DRECTPATCH_INFO; - - PD3DTriPatchInfo = ^TD3DTriPatchInfo; - _D3DTRIPATCH_INFO = packed record - StartVertexOffset : LongWord; - NumVertices : LongWord; - Basis : TD3DBasisType; - Degree : TD3DDegreeType; - end; - {$EXTERNALSYM _D3DTRIPATCH_INFO} - D3DTRIPATCH_INFO = _D3DTRIPATCH_INFO; - {$EXTERNALSYM D3DTRIPATCH_INFO} - TD3DTriPatchInfo = _D3DTRIPATCH_INFO; - -const - { Adapter Identifier } - MAX_DEVICE_IDENTIFIER_STRING = 512; - {$EXTERNALSYM MAX_DEVICE_IDENTIFIER_STRING} -type - PD3DAdapterIdentifier9 = ^TD3DAdapterIdentifier9; - _D3DADAPTER_IDENTIFIER9 = packed record - Driver : array [0..MAX_DEVICE_IDENTIFIER_STRING-1] of AnsiChar; - Description : array [0..MAX_DEVICE_IDENTIFIER_STRING-1] of AnsiChar; - DeviceName : array [0..31] of AnsiChar; { Device name for GDI (ex. \\.\DISPLAY1) } - -{$IFDEF WIN32} - DriverVersion : Int64; { Defined for 32 bit components } -{$ELSE} - DriverVersionLowPart : DWord; { Defined for 16 bit driver components } - DriverVersionHighPart : DWord; -{$ENDIF} - - VendorId : DWord; - DeviceId : DWord; - SubSysId : DWord; - Revision : DWord; - - DeviceIdentifier : TGUID; - - WHQLLevel : DWord; - - end; - {$EXTERNALSYM _D3DADAPTER_IDENTIFIER9} - D3DADAPTER_IDENTIFIER9 = _D3DADAPTER_IDENTIFIER9; - {$EXTERNALSYM D3DADAPTER_IDENTIFIER9} - TD3DAdapterIdentifier9 = _D3DADAPTER_IDENTIFIER9; - - - { Raster Status structure returned by GetRasterStatus } - PD3DRasterStatus = ^TD3DRasterStatus; - _D3DRASTER_STATUS = packed record - InVBlank : Bool; - ScanLine : LongWord; - end; - {$EXTERNALSYM _D3DRASTER_STATUS} - D3DRASTER_STATUS = _D3DRASTER_STATUS; - {$EXTERNALSYM D3DRASTER_STATUS} - TD3DRasterStatus = _D3DRASTER_STATUS; - - - -{ Debug monitor tokens (DEBUG only) - - Note that if D3DRS_DEBUGMONITORTOKEN is set, the call is treated as - passing a token to the debug monitor. For example, if, after passing - D3DDMT_ENABLE/DISABLE to D3DRS_DEBUGMONITORTOKEN other token values - are passed in, the enabled/disabled state of the debug - monitor will still persist. - - The debug monitor defaults to enabled. - - Calling GetRenderState on D3DRS_DEBUGMONITORTOKEN is not of any use. -} - _D3DDEBUGMONITORTOKENS = DWord; - {$EXTERNALSYM _D3DDEBUGMONITORTOKENS} - D3DDEBUGMONITORTOKENS = _D3DDEBUGMONITORTOKENS; - {$EXTERNALSYM D3DDEBUGMONITORTOKENS} - TD3DDebugMonitorTokens = _D3DDEBUGMONITORTOKENS; - -const - D3DDMT_ENABLE = 0; // enable debug monitor - {$EXTERNALSYM D3DDMT_ENABLE} - D3DDMT_DISABLE = 1; // disable debug monitor - {$EXTERNALSYM D3DDMT_DISABLE} - -{$IFNDEF SUPPORTS_EXPL_ENUMS} -const - // Async feedback - D3DQUERYTYPE_VCACHE = 4; { D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_VCACHE} - D3DQUERYTYPE_RESOURCEMANAGER = 5; { D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_RESOURCEMANAGER} - D3DQUERYTYPE_VERTEXSTATS = 6; { D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_VERTEXSTATS} - D3DQUERYTYPE_EVENT = 8; { D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_EVENT} - D3DQUERYTYPE_OCCLUSION = 9; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_OCCLUSION} - D3DQUERYTYPE_TIMESTAMP = 10; { D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_TIMESTAMP} - D3DQUERYTYPE_TIMESTAMPDISJOINT = 11; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_TIMESTAMPDISJOINT} - D3DQUERYTYPE_TIMESTAMPFREQ = 12; { D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_TIMESTAMPFREQ} - D3DQUERYTYPE_PIPELINETIMINGS = 13; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_PIPELINETIMINGS} - D3DQUERYTYPE_INTERFACETIMINGS = 14; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_INTERFACETIMINGS} - D3DQUERYTYPE_VERTEXTIMINGS = 15; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_VERTEXTIMINGS} - D3DQUERYTYPE_PIXELTIMINGS = 16; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_PIXELTIMINGS} - D3DQUERYTYPE_BANDWIDTHTIMINGS = 17; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_BANDWIDTHTIMINGS} - D3DQUERYTYPE_CACHEUTILIZATION = 18; { D3DISSUE_BEGIN, D3DISSUE_END } - {$EXTERNALSYM D3DQUERYTYPE_CACHEUTILIZATION} -type - _D3DQUERYTYPE = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord; -{$ELSE} -type - // Async feedback - {$MINENUMSIZE 1} // Forces TD3DQueryType be 1 byte enum - _D3DQUERYTYPE = ( - D3DQUERYTYPE_VCACHE = 4, { D3DISSUE_END } - D3DQUERYTYPE_RESOURCEMANAGER = 5, { D3DISSUE_END } - D3DQUERYTYPE_VERTEXSTATS = 6, { D3DISSUE_END } - D3DQUERYTYPE_EVENT = 8, { D3DISSUE_END } - D3DQUERYTYPE_OCCLUSION = 9, { D3DISSUE_BEGIN, D3DISSUE_END } - D3DQUERYTYPE_TIMESTAMP = 10, { D3DISSUE_END } - D3DQUERYTYPE_TIMESTAMPDISJOINT = 11, { D3DISSUE_BEGIN, D3DISSUE_END } - D3DQUERYTYPE_TIMESTAMPFREQ = 12, { D3DISSUE_END } - D3DQUERYTYPE_PIPELINETIMINGS = 13, { D3DISSUE_BEGIN, D3DISSUE_END } - D3DQUERYTYPE_INTERFACETIMINGS = 14, { D3DISSUE_BEGIN, D3DISSUE_END } - D3DQUERYTYPE_VERTEXTIMINGS = 15, { D3DISSUE_BEGIN, D3DISSUE_END } - D3DQUERYTYPE_PIXELTIMINGS = 16, { D3DISSUE_BEGIN, D3DISSUE_END } - D3DQUERYTYPE_BANDWIDTHTIMINGS = 17, { D3DISSUE_BEGIN, D3DISSUE_END } - D3DQUERYTYPE_CACHEUTILIZATION = 18 { D3DISSUE_BEGIN, D3DISSUE_END } - ); - {$MINENUMSIZE 4} // Restores enums to be 4 byte in size -{$ENDIF} - {$EXTERNALSYM _D3DQUERYTYPE} - D3DQUERYTYPE = _D3DQUERYTYPE; - {$EXTERNALSYM D3DQUERYTYPE} - TD3DQueryType = _D3DQUERYTYPE; - -const - // Flags field for Issue - D3DISSUE_END = (1 shl 0); // Tells the runtime to issue the end of a query, changing it's state to "non-signaled". - {$EXTERNALSYM D3DISSUE_END} - D3DISSUE_BEGIN = (1 shl 1); // Tells the runtime to issue the beginng of a query. - {$EXTERNALSYM D3DISSUE_BEGIN} - - - // Flags field for GetData - D3DGETDATA_FLUSH = (1 shl 0); // Tells the runtime to flush if the query is outstanding. - {$EXTERNALSYM D3DGETDATA_FLUSH} - -type - PD3DResourceStats = ^TD3DResourceStats; - _D3DRESOURCESTATS = packed record - // Data collected since last Present() - bThrashing : BOOL; (* indicates if thrashing *) - ApproxBytesDownloaded : DWORD; (* Approximate number of bytes downloaded by resource manager *) - NumEvicts : DWORD; (* number of objects evicted *) - NumVidCreates : DWORD; (* number of objects created in video memory *) - LastPri : DWORD; (* priority of last object evicted *) - NumUsed : DWORD; (* number of objects set to the device *) - NumUsedInVidMem : DWORD; (* number of objects set to the device, which are already in video memory *) - // Persistent data - WorkingSet : DWORD; (* number of objects in video memory *) - WorkingSetBytes : DWORD; (* number of bytes in video memory *) - TotalManaged : DWORD; (* total number of managed objects *) - TotalBytes : DWORD; (* total number of bytes of managed objects *) - end; - {$EXTERNALSYM _D3DRESOURCESTATS} - D3DRESOURCESTATS = _D3DRESOURCESTATS; - {$EXTERNALSYM D3DRESOURCESTATS} - TD3DResourceStats = _D3DRESOURCESTATS; - -const - D3DRTYPECOUNT = (DWORD(D3DRTYPE_INDEXBUFFER) + 1); - {$EXTERNALSYM D3DRTYPECOUNT} - -type - PD3DDevInfoResourceManager = ^TD3DDevInfoResourceManager; - _D3DDEVINFO_RESOURCEMANAGER = packed record -//#ifndef WOW64_ENUM_WORKAROUND - stats: array [0..D3DRTYPECOUNT-1] of TD3DResourceStats; -//#else -// stats: array[0..7] of TD3DResourceStats; -//#endif - end; - {$EXTERNALSYM _D3DDEVINFO_RESOURCEMANAGER} - D3DDEVINFO_RESOURCEMANAGER = _D3DDEVINFO_RESOURCEMANAGER; - {$EXTERNALSYM D3DDEVINFO_RESOURCEMANAGER} - TD3DDevInfoResourceManager = _D3DDEVINFO_RESOURCEMANAGER; - - PD3DDevInfoD3DVertexStats = ^TD3DDevInfoD3DVertexStats; - _D3DDEVINFO_D3DVERTEXSTATS = packed record - NumRenderedTriangles : DWORD; (* total number of triangles that are not clipped in this frame *) - NumExtraClippingTriangles : DWORD; (* Number of new triangles generated by clipping *) - end; - {$EXTERNALSYM _D3DDEVINFO_D3DVERTEXSTATS} - D3DDEVINFO_D3DVERTEXSTATS = _D3DDEVINFO_D3DVERTEXSTATS; - {$EXTERNALSYM D3DDEVINFO_D3DVERTEXSTATS} - TD3DDevInfoD3DVertexStats = _D3DDEVINFO_D3DVERTEXSTATS; - - PD3DDevInfoVCache = ^TD3DDevInfoVCache; - _D3DDEVINFO_VCACHE = packed record - Pattern : DWORD; (* bit pattern, return value must be FOUR_CC('C', 'A', 'C', 'H') *) - OptMethod : DWORD; (* optimization method 0 means longest strips, 1 means vertex cache based *) - CacheSize : DWORD; (* cache size to optimize for (only required if type is 1) *) - MagicNumber : DWORD; (* used to determine when to restart strips (only required if type is 1)*) - end; - {$EXTERNALSYM _D3DDEVINFO_VCACHE} - D3DDEVINFO_VCACHE = _D3DDEVINFO_VCACHE; - {$EXTERNALSYM D3DDEVINFO_VCACHE} - TD3DDevInfoVCache = _D3DDEVINFO_VCACHE; - - - PD3DDevInfoD3D9PipelineTimings = ^TD3DDevInfoD3D9PipelineTimings; - _D3DDEVINFO_D3D9PIPELINETIMINGS = packed record - VertexProcessingTimePercent: Single; - PixelProcessingTimePercent: Single; - OtherGPUProcessingTimePercent: Single; - GPUIdleTimePercent: Single; - end; - {$EXTERNALSYM _D3DDEVINFO_D3D9PIPELINETIMINGS} - D3DDEVINFO_D3D9PIPELINETIMINGS = _D3DDEVINFO_D3D9PIPELINETIMINGS; - {$EXTERNALSYM D3DDEVINFO_D3D9PIPELINETIMINGS} - TD3DDevInfoD3D9PipelineTimings = _D3DDEVINFO_D3D9PIPELINETIMINGS; - - PD3DDevInfoD3D9InterfaceTimings = ^TD3DDevInfoD3D9InterfaceTimings; - _D3DDEVINFO_D3D9INTERFACETIMINGS = packed record - WaitingForGPUToUseApplicationResourceTimePercent: Single; - WaitingForGPUToAcceptMoreCommandsTimePercent: Single; - WaitingForGPUToStayWithinLatencyTimePercent: Single; - WaitingForGPUExclusiveResourceTimePercent: Single; - WaitingForGPUOtherTimePercent: Single; - end; - {$EXTERNALSYM _D3DDEVINFO_D3D9INTERFACETIMINGS} - D3DDEVINFO_D3D9INTERFACETIMINGS = _D3DDEVINFO_D3D9INTERFACETIMINGS; - {$EXTERNALSYM D3DDEVINFO_D3D9INTERFACETIMINGS} - TD3DDevInfoD3D9InterfaceTimings = _D3DDEVINFO_D3D9INTERFACETIMINGS; - - PD3DDevInfoD3D9StageTimings = ^TD3DDevInfoD3D9StageTimings; - _D3DDEVINFO_D3D9STAGETIMINGS = packed record - MemoryProcessingPercent: Single; - ComputationProcessingPercent: Single; - end; - {$EXTERNALSYM _D3DDEVINFO_D3D9STAGETIMINGS} - D3DDEVINFO_D3D9STAGETIMINGS = _D3DDEVINFO_D3D9STAGETIMINGS; - {$EXTERNALSYM D3DDEVINFO_D3D9STAGETIMINGS} - TD3DDevInfoD3D9StageTimings = _D3DDEVINFO_D3D9STAGETIMINGS; - - PD3DDevInfoD3D9BandwidthTimings = ^TD3DDevInfoD3D9BandwidthTimings; - _D3DDEVINFO_D3D9BANDWIDTHTIMINGS = packed record - MaxBandwidthUtilized: Single; - FrontEndUploadMemoryUtilizedPercent: Single; - VertexRateUtilizedPercent: Single; - TriangleSetupRateUtilizedPercent: Single; - FillRateUtilizedPercent: Single; - end; - {$EXTERNALSYM _D3DDEVINFO_D3D9BANDWIDTHTIMINGS} - D3DDEVINFO_D3D9BANDWIDTHTIMINGS = _D3DDEVINFO_D3D9BANDWIDTHTIMINGS; - {$EXTERNALSYM D3DDEVINFO_D3D9BANDWIDTHTIMINGS} - TD3DDevInfoD3D9BandwidthTimings = _D3DDEVINFO_D3D9BANDWIDTHTIMINGS; - - PD3DDevInfoD3D9CacheUtilization = ^TD3DDevInfoD3D9CacheUtilization; - _D3DDEVINFO_D3D9CACHEUTILIZATION = packed record - TextureCacheHitRate: Single; // Percentage of cache hits - PostTransformVertexCacheHitRate: Single; - end; - {$EXTERNALSYM _D3DDEVINFO_D3D9CACHEUTILIZATION} - D3DDEVINFO_D3D9CACHEUTILIZATION = _D3DDEVINFO_D3D9CACHEUTILIZATION; - {$EXTERNALSYM D3DDEVINFO_D3D9CACHEUTILIZATION} - TD3DDevInfoD3D9CacheUtilization = _D3DDEVINFO_D3D9CACHEUTILIZATION; - -{$IFDEF DIRECT3D_VERSION_9_VISTA} - - PD3DComposeRectsOp = ^TD3DComposeRectsOp; - _D3DCOMPOSERECTSOP = - ( - D3DCOMPOSERECTS_INVALID_0, - D3DCOMPOSERECTS_COPY {= 1}, - D3DCOMPOSERECTS_OR {= 2}, - D3DCOMPOSERECTS_AND {= 3}, - D3DCOMPOSERECTS_NEG {= 4} - ); - {$EXTERNALSYM _D3DCOMPOSERECTSOP} - D3DCOMPOSERECTSOP = _D3DCOMPOSERECTSOP; - {$EXTERNALSYM D3DCOMPOSERECTSOP} - TD3DComposeRectsOp = _D3DCOMPOSERECTSOP; - - PD3DComposeRectDesc = ^TD3DComposeRectDesc; - _D3DCOMPOSERECTDESC = record - X, Y: Word; // Top-left coordinates of a rect in the source surface - Width, Height: Word; // Dimensions of the rect - end; - {$EXTERNALSYM _D3DCOMPOSERECTDESC} - D3DCOMPOSERECTDESC = _D3DCOMPOSERECTDESC; - {$EXTERNALSYM D3DCOMPOSERECTDESC} - TD3DComposeRectDesc = _D3DCOMPOSERECTDESC; - - PD3DComposeRectDestination = ^TD3DComposeRectDestination; - _D3DCOMPOSERECTDESTINATION = record - SrcRectIndex: Word; // Index of D3DCOMPOSERECTDESC - Reserved: Word; // For alignment - X, Y: Smallint; // Top-left coordinates of the rect in the destination surface - end; - {$EXTERNALSYM _D3DCOMPOSERECTDESTINATION} - D3DCOMPOSERECTDESTINATION = _D3DCOMPOSERECTDESTINATION; - {$EXTERNALSYM D3DCOMPOSERECTDESTINATION} - TD3DComposeRectDestination = _D3DCOMPOSERECTDESTINATION; - -const - D3DCOMPOSERECTS_MAXNUMRECTS = $FFFF; - {$EXTERNALSYM D3DCOMPOSERECTS_MAXNUMRECTS} - D3DCONVOLUTIONMONO_MAXWIDTH = 7; - {$EXTERNALSYM D3DCONVOLUTIONMONO_MAXWIDTH} - D3DCONVOLUTIONMONO_MAXHEIGHT = D3DCONVOLUTIONMONO_MAXWIDTH; - {$EXTERNALSYM D3DCONVOLUTIONMONO_MAXHEIGHT} - D3DFMT_A1_SURFACE_MAXWIDTH = 8192; - {$EXTERNALSYM D3DFMT_A1_SURFACE_MAXWIDTH} - D3DFMT_A1_SURFACE_MAXHEIGHT = 2048; - {$EXTERNALSYM D3DFMT_A1_SURFACE_MAXHEIGHT} - - -type - PD3DPresentStats = ^TD3DPresentStats; - _D3DPRESENTSTATS = record - PresentCount: LongWord; - PresentRefreshCount: LongWord; - SyncRefreshCount: LongWord; - SyncQPCTime: LARGE_INTEGER; - SyncGPUTime: LARGE_INTEGER; - end; - {$EXTERNALSYM _D3DPRESENTSTATS} - D3DPRESENTSTATS = _D3DPRESENTSTATS; - {$EXTERNALSYM D3DPRESENTSTATS} - TD3DPresentStats = _D3DPRESENTSTATS; - - PD3DScanlineOrdering = ^TD3DScanlineOrdering; - D3DSCANLINEORDERING = ( - D3DSCANLINEORDERING_INVALID_0, - D3DSCANLINEORDERING_PROGRESSIVE {= 1}, - D3DSCANLINEORDERING_INTERLACED {= 2} - ); - {$EXTERNALSYM D3DSCANLINEORDERING} - TD3DScanlineOrdering = D3DSCANLINEORDERING; - - - PD3DDisplayModeEx = ^TD3DDisplayModeEx; - D3DDISPLAYMODEEX = record - Size: LongWord; - Width: LongWord; - Height: LongWord; - RefreshRate: LongWord; - Format: TD3DFormat; - ScanLineOrdering: TD3DScanlineOrdering; - end; - {$EXTERNALSYM D3DDISPLAYMODEEX} - TD3DDisplayModeEx = D3DDISPLAYMODEEX; - - PD3DDisplayModeFilter = ^TD3DDisplayModeFilter; - D3DDISPLAYMODEFILTER = record - Size: LongWord; - Format: TD3DFormat; - ScanLineOrdering: TD3DScanlineOrdering; - end; - {$EXTERNALSYM D3DDISPLAYMODEFILTER} - TD3DDisplayModeFilter = D3DDISPLAYMODEFILTER; - - - PD3DDisplayRotation = ^TD3DDisplayRotation; - D3DDISPLAYROTATION = - ( - {$IFNDEF SUPPORTS_EXPL_ENUMS} - D3DDISPLAYROTATION_INVALID_0, - D3DDISPLAYROTATION_IDENTITY {= 1}, // No rotation. - D3DDISPLAYROTATION_90 {= 2}, // Rotated 90 degrees. - D3DDISPLAYROTATION_180 {= 3}, // Rotated 180 degrees. - D3DDISPLAYROTATION_270 {= 4} // Rotated 270 degrees. - {$ELSE} - D3DDISPLAYROTATION_IDENTITY = 1, // No rotation. - D3DDISPLAYROTATION_90 = 2, // Rotated 90 degrees. - D3DDISPLAYROTATION_180 = 3, // Rotated 180 degrees. - D3DDISPLAYROTATION_270 = 4 // Rotated 270 degrees. - {$ENDIF} - ); - {$EXTERNALSYM D3DDISPLAYROTATION} - TD3DDisplayRotation = D3DDISPLAYROTATION; - -{$ENDIF} - - - - -(*==========================================================================; - * - * Copyright (C) Microsoft Corporation. All Rights Reserved. - * - * File: d3d9caps.h - * Content: Direct3D capabilities include file - * - ***************************************************************************) - -type - PD3DVShaderCaps2_0 = ^TD3DVShaderCaps2_0; - _D3DVSHADERCAPS2_0 = packed record - Caps: DWORD; - DynamicFlowControlDepth: Integer; - NumTemps: Integer; - StaticFlowControlDepth: Integer; - end; - {$EXTERNALSYM _D3DVSHADERCAPS2_0} - D3DVSHADERCAPS2_0 = _D3DVSHADERCAPS2_0; - {$EXTERNALSYM D3DVSHADERCAPS2_0} - TD3DVShaderCaps2_0 = _D3DVSHADERCAPS2_0; - -const - D3DVS20CAPS_PREDICATION = (1 shl 0); - {$EXTERNALSYM D3DVS20CAPS_PREDICATION} - - D3DVS20_MAX_DYNAMICFLOWCONTROLDEPTH = 24; - {$EXTERNALSYM D3DVS20_MAX_DYNAMICFLOWCONTROLDEPTH} - D3DVS20_MIN_DYNAMICFLOWCONTROLDEPTH = 0; - {$EXTERNALSYM D3DVS20_MIN_DYNAMICFLOWCONTROLDEPTH} - D3DVS20_MAX_NUMTEMPS = 32; - {$EXTERNALSYM D3DVS20_MAX_NUMTEMPS} - D3DVS20_MIN_NUMTEMPS = 12; - {$EXTERNALSYM D3DVS20_MIN_NUMTEMPS} - D3DVS20_MAX_STATICFLOWCONTROLDEPTH = 4; - {$EXTERNALSYM D3DVS20_MAX_STATICFLOWCONTROLDEPTH} - D3DVS20_MIN_STATICFLOWCONTROLDEPTH = 1; - {$EXTERNALSYM D3DVS20_MIN_STATICFLOWCONTROLDEPTH} - -type - PD3DPShaderCaps2_0 = ^TD3DPShaderCaps2_0; - _D3DPSHADERCAPS2_0 = packed record - Caps: DWORD; - DynamicFlowControlDepth: Integer; - NumTemps: Integer; - StaticFlowControlDepth: Integer; - NumInstructionSlots: Integer; - end; - {$EXTERNALSYM _D3DPSHADERCAPS2_0} - D3DPSHADERCAPS2_0 = _D3DPSHADERCAPS2_0; - {$EXTERNALSYM D3DPSHADERCAPS2_0} - TD3DPShaderCaps2_0 = _D3DPSHADERCAPS2_0; - -const - D3DPS20CAPS_ARBITRARYSWIZZLE = (1 shl 0); - {$EXTERNALSYM D3DPS20CAPS_ARBITRARYSWIZZLE} - D3DPS20CAPS_GRADIENTINSTRUCTIONS = (1 shl 1); - {$EXTERNALSYM D3DPS20CAPS_GRADIENTINSTRUCTIONS} - D3DPS20CAPS_PREDICATION = (1 shl 2); - {$EXTERNALSYM D3DPS20CAPS_PREDICATION} - D3DPS20CAPS_NODEPENDENTREADLIMIT = (1 shl 3); - {$EXTERNALSYM D3DPS20CAPS_NODEPENDENTREADLIMIT} - D3DPS20CAPS_NOTEXINSTRUCTIONLIMIT = (1 shl 4); - {$EXTERNALSYM D3DPS20CAPS_NOTEXINSTRUCTIONLIMIT} - - D3DPS20_MAX_DYNAMICFLOWCONTROLDEPTH = 24; - {$EXTERNALSYM D3DPS20_MAX_DYNAMICFLOWCONTROLDEPTH} - D3DPS20_MIN_DYNAMICFLOWCONTROLDEPTH = 0; - {$EXTERNALSYM D3DPS20_MIN_DYNAMICFLOWCONTROLDEPTH} - D3DPS20_MAX_NUMTEMPS = 32; - {$EXTERNALSYM D3DPS20_MAX_NUMTEMPS} - D3DPS20_MIN_NUMTEMPS = 12; - {$EXTERNALSYM D3DPS20_MIN_NUMTEMPS} - D3DPS20_MAX_STATICFLOWCONTROLDEPTH = 4; - {$EXTERNALSYM D3DPS20_MAX_STATICFLOWCONTROLDEPTH} - D3DPS20_MIN_STATICFLOWCONTROLDEPTH = 0; - {$EXTERNALSYM D3DPS20_MIN_STATICFLOWCONTROLDEPTH} - D3DPS20_MAX_NUMINSTRUCTIONSLOTS = 512; - {$EXTERNALSYM D3DPS20_MAX_NUMINSTRUCTIONSLOTS} - D3DPS20_MIN_NUMINSTRUCTIONSLOTS = 96; - {$EXTERNALSYM D3DPS20_MIN_NUMINSTRUCTIONSLOTS} - - D3DMIN30SHADERINSTRUCTIONS = 512; - {$EXTERNALSYM D3DMIN30SHADERINSTRUCTIONS} - D3DMAX30SHADERINSTRUCTIONS = 32768; - {$EXTERNALSYM D3DMAX30SHADERINSTRUCTIONS} - -type - PD3DCaps9 = ^TD3DCaps9; - _D3DCAPS9 = record - (* Device Info *) - DeviceType: TD3DDevType; - AdapterOrdinal: DWord; - - (* Caps from DX7 Draw *) - Caps: DWord; - Caps2: DWord; - Caps3: DWord; - PresentationIntervals: DWord; - - (* Cursor Caps *) - CursorCaps: DWORD; - - (* 3D Device Caps *) - DevCaps: DWord; - PrimitiveMiscCaps: DWord; - RasterCaps: DWord; - ZCmpCaps: DWord; - SrcBlendCaps: DWord; - DestBlendCaps: DWord; - AlphaCmpCaps: DWord; - ShadeCaps: DWord; - TextureCaps: DWord; - TextureFilterCaps: DWord; // D3DPTFILTERCAPS for IDirect3DTexture9's - CubeTextureFilterCaps: DWord; // D3DPTFILTERCAPS for IDirect3DCubeTexture9's - VolumeTextureFilterCaps: DWord; // D3DPTFILTERCAPS for IDirect3DVolumeTexture9's - TextureAddressCaps: DWord; // D3DPTADDRESSCAPS for IDirect3DTexture9's - VolumeTextureAddressCaps: DWord; // D3DPTADDRESSCAPS for IDirect3DVolumeTexture9's - - LineCaps: DWord; // D3DLINECAPS - - MaxTextureWidth, MaxTextureHeight: DWord; - MaxVolumeExtent: DWord; - - MaxTextureRepeat: DWord; - MaxTextureAspectRatio: DWord; - MaxAnisotropy: DWord; - MaxVertexW: Single; - - GuardBandLeft: Single; - GuardBandTop: Single; - GuardBandRight: Single; - GuardBandBottom: Single; - - ExtentsAdjust: Single; - StencilCaps: DWord; - - FVFCaps: DWord; - TextureOpCaps: DWord; - MaxTextureBlendStages: DWord; - MaxSimultaneousTextures: DWord; - - VertexProcessingCaps: DWord; - MaxActiveLights: DWord; - MaxUserClipPlanes: DWord; - MaxVertexBlendMatrices: DWord; - MaxVertexBlendMatrixIndex: DWord; - - MaxPointSize: Single; - - MaxPrimitiveCount: DWord; // max number of primitives per DrawPrimitive call - MaxVertexIndex: DWord; - MaxStreams: DWord; - MaxStreamStride: DWord; // max stride for SetStreamSource - - VertexShaderVersion: DWord; - MaxVertexShaderConst: DWord; // number of vertex shader constant registers - - PixelShaderVersion: DWord; - PixelShader1xMaxValue: Single; // max value storable in registers of ps.1.x shaders - - // Here are the DX9 specific ones - DevCaps2: DWORD; - - MaxNpatchTessellationLevel: Single; - Reserved5: DWORD; - - MasterAdapterOrdinal: LongWord; // ordinal of master adaptor for adapter group - AdapterOrdinalInGroup: LongWord; // ordinal inside the adapter group - NumberOfAdaptersInGroup: LongWord; // number of adapters in this adapter group (only if master) - DeclTypes: DWORD; // Data types, supported in vertex declarations - NumSimultaneousRTs: DWORD; // Will be at least 1 - StretchRectFilterCaps: DWORD; // Filter caps supported by StretchRect - VS20Caps: TD3DVShaderCaps2_0; - PS20Caps: TD3DPShaderCaps2_0; - VertexTextureFilterCaps: DWORD; // D3DPTFILTERCAPS for IDirect3DTexture9's for texture, used in vertex shaders - MaxVShaderInstructionsExecuted: DWORD; // maximum number of vertex shader instructions that can be executed - MaxPShaderInstructionsExecuted: DWORD; // maximum number of pixel shader instructions that can be executed - MaxVertexShader30InstructionSlots: DWORD; - MaxPixelShader30InstructionSlots: DWORD; - end {D3DCAPS9}; - {$EXTERNALSYM _D3DCAPS9} - D3DCAPS9 = _D3DCAPS9; - {$EXTERNALSYM D3DCAPS9} - TD3DCaps9 = _D3DCAPS9; - - // - // BIT DEFINES FOR D3DCAPS9 DWORD MEMBERS - // - -const - // - // Caps - // - D3DCAPS_READ_SCANLINE = $00020000; - {$EXTERNALSYM D3DCAPS_READ_SCANLINE} - - // - // Caps2 - // - D3DCAPS2_FULLSCREENGAMMA = $00020000; - {$EXTERNALSYM D3DCAPS2_FULLSCREENGAMMA} - D3DCAPS2_CANCALIBRATEGAMMA = $00100000; - {$EXTERNALSYM D3DCAPS2_CANCALIBRATEGAMMA} - D3DCAPS2_RESERVED = $02000000; - {$EXTERNALSYM D3DCAPS2_RESERVED} - D3DCAPS2_CANMANAGERESOURCE = $10000000; - {$EXTERNALSYM D3DCAPS2_CANMANAGERESOURCE} - D3DCAPS2_DYNAMICTEXTURES = $20000000; - {$EXTERNALSYM D3DCAPS2_DYNAMICTEXTURES} - D3DCAPS2_CANAUTOGENMIPMAP = $40000000; - {$EXTERNALSYM D3DCAPS2_CANAUTOGENMIPMAP} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DCAPS2_CANSHARERESOURCE = $80000000; - {$EXTERNALSYM D3DCAPS2_CANSHARERESOURCE} -{$ENDIF} - - // - // Caps3 - // - D3DCAPS3_RESERVED = $8000001F; - {$EXTERNALSYM D3DCAPS3_RESERVED} - - // Indicates that the device can respect the ALPHABLENDENABLE render state - // when fullscreen while using the FLIP or DISCARD swap effect. - // COPY and COPYVSYNC swap effects work whether or not this flag is set. - D3DCAPS3_ALPHA_FULLSCREEN_FLIP_OR_DISCARD = $00000020; - {$EXTERNALSYM D3DCAPS3_ALPHA_FULLSCREEN_FLIP_OR_DISCARD} - - // Indicates that the device can perform a gamma correction from - // a windowed back buffer containing linear content to the sRGB desktop. - D3DCAPS3_LINEAR_TO_SRGB_PRESENTATION = $00000080; - {$EXTERNALSYM D3DCAPS3_LINEAR_TO_SRGB_PRESENTATION} - - D3DCAPS3_COPY_TO_VIDMEM = $00000100; { Device can acclerate copies from sysmem to local vidmem } - {$EXTERNALSYM D3DCAPS3_COPY_TO_VIDMEM} - D3DCAPS3_COPY_TO_SYSTEMMEM = $00000200; { Device can acclerate copies from local vidmem to sysmem } - {$EXTERNALSYM D3DCAPS3_COPY_TO_SYSTEMMEM} - - - // - // PresentationIntervals - // - D3DPRESENT_INTERVAL_DEFAULT = $00000000; - {$EXTERNALSYM D3DPRESENT_INTERVAL_DEFAULT} - D3DPRESENT_INTERVAL_ONE = $00000001; - {$EXTERNALSYM D3DPRESENT_INTERVAL_ONE} - D3DPRESENT_INTERVAL_TWO = $00000002; - {$EXTERNALSYM D3DPRESENT_INTERVAL_TWO} - D3DPRESENT_INTERVAL_THREE = $00000004; - {$EXTERNALSYM D3DPRESENT_INTERVAL_THREE} - D3DPRESENT_INTERVAL_FOUR = $00000008; - {$EXTERNALSYM D3DPRESENT_INTERVAL_FOUR} - D3DPRESENT_INTERVAL_IMMEDIATE = $80000000; - {$EXTERNALSYM D3DPRESENT_INTERVAL_IMMEDIATE} - - // - // CursorCaps - // - // Driver supports HW color cursor in at least hi-res modes(height >=400) - D3DCURSORCAPS_COLOR = $00000001; - {$EXTERNALSYM D3DCURSORCAPS_COLOR} - // Driver supports HW cursor also in low-res modes(height < 400) - D3DCURSORCAPS_LOWRES = $00000002; - {$EXTERNALSYM D3DCURSORCAPS_LOWRES} - - // - // DevCaps - // - D3DDEVCAPS_EXECUTESYSTEMMEMORY = $00000010; { Device can use execute buffers from system memory } - {$EXTERNALSYM D3DDEVCAPS_EXECUTESYSTEMMEMORY} - D3DDEVCAPS_EXECUTEVIDEOMEMORY = $00000020; { Device can use execute buffers from video memory } - {$EXTERNALSYM D3DDEVCAPS_EXECUTEVIDEOMEMORY} - D3DDEVCAPS_TLVERTEXSYSTEMMEMORY = $00000040; { Device can use TL buffers from system memory } - {$EXTERNALSYM D3DDEVCAPS_TLVERTEXSYSTEMMEMORY} - D3DDEVCAPS_TLVERTEXVIDEOMEMORY = $00000080; { Device can use TL buffers from video memory } - {$EXTERNALSYM D3DDEVCAPS_TLVERTEXVIDEOMEMORY} - D3DDEVCAPS_TEXTURESYSTEMMEMORY = $00000100; { Device can texture from system memory } - {$EXTERNALSYM D3DDEVCAPS_TEXTURESYSTEMMEMORY} - D3DDEVCAPS_TEXTUREVIDEOMEMORY = $00000200; { Device can texture from device memory } - {$EXTERNALSYM D3DDEVCAPS_TEXTUREVIDEOMEMORY} - D3DDEVCAPS_DRAWPRIMTLVERTEX = $00000400; { Device can draw TLVERTEX primitives } - {$EXTERNALSYM D3DDEVCAPS_DRAWPRIMTLVERTEX} - D3DDEVCAPS_CANRENDERAFTERFLIP = $00000800; { Device can render without waiting for flip to complete } - {$EXTERNALSYM D3DDEVCAPS_CANRENDERAFTERFLIP} - D3DDEVCAPS_TEXTURENONLOCALVIDMEM = $00001000; { Device can texture from nonlocal video memory } - {$EXTERNALSYM D3DDEVCAPS_TEXTURENONLOCALVIDMEM} - D3DDEVCAPS_DRAWPRIMITIVES2 = $00002000; { Device can support DrawPrimitives2 } - {$EXTERNALSYM D3DDEVCAPS_DRAWPRIMITIVES2} - D3DDEVCAPS_SEPARATETEXTUREMEMORIES = $00004000; { Device is texturing from separate memory pools } - {$EXTERNALSYM D3DDEVCAPS_SEPARATETEXTUREMEMORIES} - D3DDEVCAPS_DRAWPRIMITIVES2EX = $00008000; { Device can support Extended DrawPrimitives2 i.e. DX7 compliant driver } - {$EXTERNALSYM D3DDEVCAPS_DRAWPRIMITIVES2EX} - D3DDEVCAPS_HWTRANSFORMANDLIGHT = $00010000; { Device can support transformation and lighting in hardware and DRAWPRIMITIVES2EX must be also } - {$EXTERNALSYM D3DDEVCAPS_HWTRANSFORMANDLIGHT} - D3DDEVCAPS_CANBLTSYSTONONLOCAL = $00020000; { Device supports a Tex Blt from system memory to non-local vidmem } - {$EXTERNALSYM D3DDEVCAPS_CANBLTSYSTONONLOCAL} - D3DDEVCAPS_HWRASTERIZATION = $00080000; { Device has HW acceleration for rasterization } - {$EXTERNALSYM D3DDEVCAPS_HWRASTERIZATION} - D3DDEVCAPS_PUREDEVICE = $00100000; { Device supports D3DCREATE_PUREDEVICE } - {$EXTERNALSYM D3DDEVCAPS_PUREDEVICE} - D3DDEVCAPS_QUINTICRTPATCHES = $00200000; { Device supports quintic Beziers and BSplines } - {$EXTERNALSYM D3DDEVCAPS_QUINTICRTPATCHES} - D3DDEVCAPS_RTPATCHES = $00400000; { Device supports Rect and Tri patches } - {$EXTERNALSYM D3DDEVCAPS_RTPATCHES} - D3DDEVCAPS_RTPATCHHANDLEZERO = $00800000; { Indicates that RT Patches may be drawn efficiently using handle 0 } - {$EXTERNALSYM D3DDEVCAPS_RTPATCHHANDLEZERO} - D3DDEVCAPS_NPATCHES = $01000000; { Device supports N-Patches } - {$EXTERNALSYM D3DDEVCAPS_NPATCHES} - - // - // PrimitiveMiscCaps - // - D3DPMISCCAPS_MASKZ = $00000002; - {$EXTERNALSYM D3DPMISCCAPS_MASKZ} - D3DPMISCCAPS_CULLNONE = $00000010; - {$EXTERNALSYM D3DPMISCCAPS_CULLNONE} - D3DPMISCCAPS_CULLCW = $00000020; - {$EXTERNALSYM D3DPMISCCAPS_CULLCW} - D3DPMISCCAPS_CULLCCW = $00000040; - {$EXTERNALSYM D3DPMISCCAPS_CULLCCW} - D3DPMISCCAPS_COLORWRITEENABLE = $00000080; - {$EXTERNALSYM D3DPMISCCAPS_COLORWRITEENABLE} - D3DPMISCCAPS_CLIPPLANESCALEDPOINTS = $00000100; { Device correctly clips scaled points to clip planes } - {$EXTERNALSYM D3DPMISCCAPS_CLIPPLANESCALEDPOINTS} - D3DPMISCCAPS_CLIPTLVERTS = $00000200; { device will clip post-transformed vertex primitives } - {$EXTERNALSYM D3DPMISCCAPS_CLIPTLVERTS} - D3DPMISCCAPS_TSSARGTEMP = $00000400; { device supports D3DTA_TEMP for temporary register } - {$EXTERNALSYM D3DPMISCCAPS_TSSARGTEMP} - D3DPMISCCAPS_BLENDOP = $00000800; { device supports D3DRS_BLENDOP } - {$EXTERNALSYM D3DPMISCCAPS_BLENDOP} - D3DPMISCCAPS_NULLREFERENCE = $00001000; { Reference Device that doesnt render } - {$EXTERNALSYM D3DPMISCCAPS_NULLREFERENCE} - D3DPMISCCAPS_INDEPENDENTWRITEMASKS = $00004000; { Device supports independent write masks for MET or MRT } - {$EXTERNALSYM D3DPMISCCAPS_INDEPENDENTWRITEMASKS} - D3DPMISCCAPS_PERSTAGECONSTANT = $00008000; { Device supports per-stage constants } - {$EXTERNALSYM D3DPMISCCAPS_PERSTAGECONSTANT} - D3DPMISCCAPS_FOGANDSPECULARALPHA = $00010000; { Device supports separate fog and specular alpha (many devices - use the specular alpha channel to store fog factor) } - {$EXTERNALSYM D3DPMISCCAPS_FOGANDSPECULARALPHA} - D3DPMISCCAPS_SEPARATEALPHABLEND = $00020000; { Device supports separate blend settings for the alpha channel } - {$EXTERNALSYM D3DPMISCCAPS_SEPARATEALPHABLEND} - D3DPMISCCAPS_MRTINDEPENDENTBITDEPTHS = $00040000; { Device supports different bit depths for MRT } - {$EXTERNALSYM D3DPMISCCAPS_MRTINDEPENDENTBITDEPTHS} - D3DPMISCCAPS_MRTPOSTPIXELSHADERBLENDING = $00080000; { Device supports post-pixel shader operations for MRT } - {$EXTERNALSYM D3DPMISCCAPS_MRTPOSTPIXELSHADERBLENDING} - D3DPMISCCAPS_FOGVERTEXCLAMPED = $00100000; { Device clamps fog blend factor per vertex } - {$EXTERNALSYM D3DPMISCCAPS_FOGVERTEXCLAMPED} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DPMISCCAPS_POSTBLENDSRGBCONVERT = $00200000; { Indicates device can perform conversion to sRGB after blending. } - {$EXTERNALSYM D3DPMISCCAPS_POSTBLENDSRGBCONVERT} -{$ENDIF} - - // - // LineCaps - // - D3DLINECAPS_TEXTURE = $00000001; - {$EXTERNALSYM D3DLINECAPS_TEXTURE} - D3DLINECAPS_ZTEST = $00000002; - {$EXTERNALSYM D3DLINECAPS_ZTEST} - D3DLINECAPS_BLEND = $00000004; - {$EXTERNALSYM D3DLINECAPS_BLEND} - D3DLINECAPS_ALPHACMP = $00000008; - {$EXTERNALSYM D3DLINECAPS_ALPHACMP} - D3DLINECAPS_FOG = $00000010; - {$EXTERNALSYM D3DLINECAPS_FOG} - D3DLINECAPS_ANTIALIAS = $00000020; - {$EXTERNALSYM D3DLINECAPS_ANTIALIAS} - - // - // RasterCaps - // - D3DPRASTERCAPS_DITHER = $00000001; - {$EXTERNALSYM D3DPRASTERCAPS_DITHER} - D3DPRASTERCAPS_ZTEST = $00000010; - {$EXTERNALSYM D3DPRASTERCAPS_ZTEST} - D3DPRASTERCAPS_FOGVERTEX = $00000080; - {$EXTERNALSYM D3DPRASTERCAPS_FOGVERTEX} - D3DPRASTERCAPS_FOGTABLE = $00000100; - {$EXTERNALSYM D3DPRASTERCAPS_FOGTABLE} - D3DPRASTERCAPS_MIPMAPLODBIAS = $00002000; - {$EXTERNALSYM D3DPRASTERCAPS_MIPMAPLODBIAS} - D3DPRASTERCAPS_ZBUFFERLESSHSR = $00008000; - {$EXTERNALSYM D3DPRASTERCAPS_ZBUFFERLESSHSR} - D3DPRASTERCAPS_FOGRANGE = $00010000; - {$EXTERNALSYM D3DPRASTERCAPS_FOGRANGE} - D3DPRASTERCAPS_ANISOTROPY = $00020000; - {$EXTERNALSYM D3DPRASTERCAPS_ANISOTROPY} - D3DPRASTERCAPS_WBUFFER = $00040000; - {$EXTERNALSYM D3DPRASTERCAPS_WBUFFER} - D3DPRASTERCAPS_WFOG = $00100000; - {$EXTERNALSYM D3DPRASTERCAPS_WFOG} - D3DPRASTERCAPS_ZFOG = $00200000; - {$EXTERNALSYM D3DPRASTERCAPS_ZFOG} - D3DPRASTERCAPS_COLORPERSPECTIVE = $00400000; { Device iterates colors perspective correct } - {$EXTERNALSYM D3DPRASTERCAPS_COLORPERSPECTIVE} - D3DPRASTERCAPS_SCISSORTEST = $01000000; - {$EXTERNALSYM D3DPRASTERCAPS_SCISSORTEST} - D3DPRASTERCAPS_SLOPESCALEDEPTHBIAS = $02000000; - {$EXTERNALSYM D3DPRASTERCAPS_SLOPESCALEDEPTHBIAS} - D3DPRASTERCAPS_DEPTHBIAS = $04000000; - {$EXTERNALSYM D3DPRASTERCAPS_DEPTHBIAS} - D3DPRASTERCAPS_MULTISAMPLE_TOGGLE = $08000000; - {$EXTERNALSYM D3DPRASTERCAPS_MULTISAMPLE_TOGGLE} - - // - // ZCmpCaps, AlphaCmpCaps - // - D3DPCMPCAPS_NEVER = $00000001; - {$EXTERNALSYM D3DPCMPCAPS_NEVER} - D3DPCMPCAPS_LESS = $00000002; - {$EXTERNALSYM D3DPCMPCAPS_LESS} - D3DPCMPCAPS_EQUAL = $00000004; - {$EXTERNALSYM D3DPCMPCAPS_EQUAL} - D3DPCMPCAPS_LESSEQUAL = $00000008; - {$EXTERNALSYM D3DPCMPCAPS_LESSEQUAL} - D3DPCMPCAPS_GREATER = $00000010; - {$EXTERNALSYM D3DPCMPCAPS_GREATER} - D3DPCMPCAPS_NOTEQUAL = $00000020; - {$EXTERNALSYM D3DPCMPCAPS_NOTEQUAL} - D3DPCMPCAPS_GREATEREQUAL = $00000040; - {$EXTERNALSYM D3DPCMPCAPS_GREATEREQUAL} - D3DPCMPCAPS_ALWAYS = $00000080; - {$EXTERNALSYM D3DPCMPCAPS_ALWAYS} - - // - // SourceBlendCaps, DestBlendCaps - // - D3DPBLENDCAPS_ZERO = $00000001; - {$EXTERNALSYM D3DPBLENDCAPS_ZERO} - D3DPBLENDCAPS_ONE = $00000002; - {$EXTERNALSYM D3DPBLENDCAPS_ONE} - D3DPBLENDCAPS_SRCCOLOR = $00000004; - {$EXTERNALSYM D3DPBLENDCAPS_SRCCOLOR} - D3DPBLENDCAPS_INVSRCCOLOR = $00000008; - {$EXTERNALSYM D3DPBLENDCAPS_INVSRCCOLOR} - D3DPBLENDCAPS_SRCALPHA = $00000010; - {$EXTERNALSYM D3DPBLENDCAPS_SRCALPHA} - D3DPBLENDCAPS_INVSRCALPHA = $00000020; - {$EXTERNALSYM D3DPBLENDCAPS_INVSRCALPHA} - D3DPBLENDCAPS_DESTALPHA = $00000040; - {$EXTERNALSYM D3DPBLENDCAPS_DESTALPHA} - D3DPBLENDCAPS_INVDESTALPHA = $00000080; - {$EXTERNALSYM D3DPBLENDCAPS_INVDESTALPHA} - D3DPBLENDCAPS_DESTCOLOR = $00000100; - {$EXTERNALSYM D3DPBLENDCAPS_DESTCOLOR} - D3DPBLENDCAPS_INVDESTCOLOR = $00000200; - {$EXTERNALSYM D3DPBLENDCAPS_INVDESTCOLOR} - D3DPBLENDCAPS_SRCALPHASAT = $00000400; - {$EXTERNALSYM D3DPBLENDCAPS_SRCALPHASAT} - D3DPBLENDCAPS_BOTHSRCALPHA = $00000800; - {$EXTERNALSYM D3DPBLENDCAPS_BOTHSRCALPHA} - D3DPBLENDCAPS_BOTHINVSRCALPHA = $00001000; - {$EXTERNALSYM D3DPBLENDCAPS_BOTHINVSRCALPHA} - D3DPBLENDCAPS_BLENDFACTOR = $00002000; { Supports both D3DBLEND_BLENDFACTOR and D3DBLEND_INVBLENDFACTOR } - {$EXTERNALSYM D3DPBLENDCAPS_BLENDFACTOR} - - // - // ShadeCaps - // - D3DPSHADECAPS_COLORGOURAUDRGB = $00000008; - {$EXTERNALSYM D3DPSHADECAPS_COLORGOURAUDRGB} - D3DPSHADECAPS_SPECULARGOURAUDRGB = $00000200; - {$EXTERNALSYM D3DPSHADECAPS_SPECULARGOURAUDRGB} - D3DPSHADECAPS_ALPHAGOURAUDBLEND = $00004000; - {$EXTERNALSYM D3DPSHADECAPS_ALPHAGOURAUDBLEND} - D3DPSHADECAPS_FOGGOURAUD = $00080000; - {$EXTERNALSYM D3DPSHADECAPS_FOGGOURAUD} - - // - // TextureCaps - // - D3DPTEXTURECAPS_PERSPECTIVE = $00000001; { Perspective-correct texturing is supported } - {$EXTERNALSYM D3DPTEXTURECAPS_PERSPECTIVE} - D3DPTEXTURECAPS_POW2 = $00000002; { Power-of-2 texture dimensions are required - applies to non-Cube/Volume textures only. } - {$EXTERNALSYM D3DPTEXTURECAPS_POW2} - D3DPTEXTURECAPS_ALPHA = $00000004; { Alpha in texture pixels is supported } - {$EXTERNALSYM D3DPTEXTURECAPS_ALPHA} - D3DPTEXTURECAPS_SQUAREONLY = $00000020; { Only square textures are supported } - {$EXTERNALSYM D3DPTEXTURECAPS_SQUAREONLY} - D3DPTEXTURECAPS_TEXREPEATNOTSCALEDBYSIZE = $00000040; { Texture indices are not scaled by the texture size prior to interpolation } - {$EXTERNALSYM D3DPTEXTURECAPS_TEXREPEATNOTSCALEDBYSIZE} - D3DPTEXTURECAPS_ALPHAPALETTE = $00000080; { Device can draw alpha from texture palettes } - {$EXTERNALSYM D3DPTEXTURECAPS_ALPHAPALETTE} - // Device can use non-POW2 textures if: - // 1) D3DTEXTURE_ADDRESS is set to CLAMP for this texture's stage - // 2) D3DRS_WRAP(N) is zero for this texture's coordinates - // 3) mip mapping is not enabled (use magnification filter only) - D3DPTEXTURECAPS_NONPOW2CONDITIONAL = $00000100; - {$EXTERNALSYM D3DPTEXTURECAPS_NONPOW2CONDITIONAL} - D3DPTEXTURECAPS_PROJECTED = $00000400; { Device can do D3DTTFF_PROJECTED } - {$EXTERNALSYM D3DPTEXTURECAPS_PROJECTED} - D3DPTEXTURECAPS_CUBEMAP = $00000800; { Device can do cubemap textures } - {$EXTERNALSYM D3DPTEXTURECAPS_CUBEMAP} - D3DPTEXTURECAPS_VOLUMEMAP = $00002000; { Device can do volume textures } - {$EXTERNALSYM D3DPTEXTURECAPS_VOLUMEMAP} - D3DPTEXTURECAPS_MIPMAP = $00004000; { Device can do mipmapped textures } - {$EXTERNALSYM D3DPTEXTURECAPS_MIPMAP} - D3DPTEXTURECAPS_MIPVOLUMEMAP = $00008000; { Device can do mipmapped volume textures } - {$EXTERNALSYM D3DPTEXTURECAPS_MIPVOLUMEMAP} - D3DPTEXTURECAPS_MIPCUBEMAP = $00010000; { Device can do mipmapped cube maps } - {$EXTERNALSYM D3DPTEXTURECAPS_MIPCUBEMAP} - D3DPTEXTURECAPS_CUBEMAP_POW2 = $00020000; { Device requires that cubemaps be power-of-2 dimension } - {$EXTERNALSYM D3DPTEXTURECAPS_CUBEMAP_POW2} - D3DPTEXTURECAPS_VOLUMEMAP_POW2 = $00040000; { Device requires that volume maps be power-of-2 dimension } - {$EXTERNALSYM D3DPTEXTURECAPS_VOLUMEMAP_POW2} - D3DPTEXTURECAPS_NOPROJECTEDBUMPENV = $00200000; { Device does not support projected bump env lookup operation - in programmable and fixed function pixel shaders } - {$EXTERNALSYM D3DPTEXTURECAPS_NOPROJECTEDBUMPENV} - - // - // TextureFilterCaps, StretchRectFilterCaps - // - D3DPTFILTERCAPS_MINFPOINT = $00000100; { Min Filter } - {$EXTERNALSYM D3DPTFILTERCAPS_MINFPOINT} - D3DPTFILTERCAPS_MINFLINEAR = $00000200; - {$EXTERNALSYM D3DPTFILTERCAPS_MINFLINEAR} - D3DPTFILTERCAPS_MINFANISOTROPIC = $00000400; - {$EXTERNALSYM D3DPTFILTERCAPS_MINFANISOTROPIC} - D3DPTFILTERCAPS_MINFPYRAMIDALQUAD = $00000800; - {$EXTERNALSYM D3DPTFILTERCAPS_MINFPYRAMIDALQUAD} - D3DPTFILTERCAPS_MINFGAUSSIANQUAD = $00001000; - {$EXTERNALSYM D3DPTFILTERCAPS_MINFGAUSSIANQUAD} - D3DPTFILTERCAPS_MIPFPOINT = $00010000; { Mip Filter } - {$EXTERNALSYM D3DPTFILTERCAPS_MIPFPOINT} - D3DPTFILTERCAPS_MIPFLINEAR = $00020000; - {$EXTERNALSYM D3DPTFILTERCAPS_MIPFLINEAR} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DPTFILTERCAPS_CONVOLUTIONMONO = $00040000; { Min and Mag for the convolution mono filter } - {$EXTERNALSYM D3DPTFILTERCAPS_CONVOLUTIONMONO} -{$ENDIF} - D3DPTFILTERCAPS_MAGFPOINT = $01000000; { Mag Filter } - {$EXTERNALSYM D3DPTFILTERCAPS_MAGFPOINT} - D3DPTFILTERCAPS_MAGFLINEAR = $02000000; - {$EXTERNALSYM D3DPTFILTERCAPS_MAGFLINEAR} - D3DPTFILTERCAPS_MAGFANISOTROPIC = $04000000; - {$EXTERNALSYM D3DPTFILTERCAPS_MAGFANISOTROPIC} - D3DPTFILTERCAPS_MAGFPYRAMIDALQUAD = $08000000; - {$EXTERNALSYM D3DPTFILTERCAPS_MAGFPYRAMIDALQUAD} - D3DPTFILTERCAPS_MAGFGAUSSIANQUAD = $10000000; - {$EXTERNALSYM D3DPTFILTERCAPS_MAGFGAUSSIANQUAD} - - // - // TextureAddressCaps - // - D3DPTADDRESSCAPS_WRAP = $00000001; - {$EXTERNALSYM D3DPTADDRESSCAPS_WRAP} - D3DPTADDRESSCAPS_MIRROR = $00000002; - {$EXTERNALSYM D3DPTADDRESSCAPS_MIRROR} - D3DPTADDRESSCAPS_CLAMP = $00000004; - {$EXTERNALSYM D3DPTADDRESSCAPS_CLAMP} - D3DPTADDRESSCAPS_BORDER = $00000008; - {$EXTERNALSYM D3DPTADDRESSCAPS_BORDER} - D3DPTADDRESSCAPS_INDEPENDENTUV = $00000010; - {$EXTERNALSYM D3DPTADDRESSCAPS_INDEPENDENTUV} - D3DPTADDRESSCAPS_MIRRORONCE = $00000020; - {$EXTERNALSYM D3DPTADDRESSCAPS_MIRRORONCE} - - // - // StencilCaps - // - D3DSTENCILCAPS_KEEP = $00000001; - {$EXTERNALSYM D3DSTENCILCAPS_KEEP} - D3DSTENCILCAPS_ZERO = $00000002; - {$EXTERNALSYM D3DSTENCILCAPS_ZERO} - D3DSTENCILCAPS_REPLACE = $00000004; - {$EXTERNALSYM D3DSTENCILCAPS_REPLACE} - D3DSTENCILCAPS_INCRSAT = $00000008; - {$EXTERNALSYM D3DSTENCILCAPS_INCRSAT} - D3DSTENCILCAPS_DECRSAT = $00000010; - {$EXTERNALSYM D3DSTENCILCAPS_DECRSAT} - D3DSTENCILCAPS_INVERT = $00000020; - {$EXTERNALSYM D3DSTENCILCAPS_INVERT} - D3DSTENCILCAPS_INCR = $00000040; - {$EXTERNALSYM D3DSTENCILCAPS_INCR} - D3DSTENCILCAPS_DECR = $00000080; - {$EXTERNALSYM D3DSTENCILCAPS_DECR} - D3DSTENCILCAPS_TWOSIDED = $00000100; - {$EXTERNALSYM D3DSTENCILCAPS_TWOSIDED} - - // - // TextureOpCaps - // - D3DTEXOPCAPS_DISABLE = $00000001; - {$EXTERNALSYM D3DTEXOPCAPS_DISABLE} - D3DTEXOPCAPS_SELECTARG1 = $00000002; - {$EXTERNALSYM D3DTEXOPCAPS_SELECTARG1} - D3DTEXOPCAPS_SELECTARG2 = $00000004; - {$EXTERNALSYM D3DTEXOPCAPS_SELECTARG2} - D3DTEXOPCAPS_MODULATE = $00000008; - {$EXTERNALSYM D3DTEXOPCAPS_MODULATE} - D3DTEXOPCAPS_MODULATE2X = $00000010; - {$EXTERNALSYM D3DTEXOPCAPS_MODULATE2X} - D3DTEXOPCAPS_MODULATE4X = $00000020; - {$EXTERNALSYM D3DTEXOPCAPS_MODULATE4X} - D3DTEXOPCAPS_ADD = $00000040; - {$EXTERNALSYM D3DTEXOPCAPS_ADD} - D3DTEXOPCAPS_ADDSIGNED = $00000080; - {$EXTERNALSYM D3DTEXOPCAPS_ADDSIGNED} - D3DTEXOPCAPS_ADDSIGNED2X = $00000100; - {$EXTERNALSYM D3DTEXOPCAPS_ADDSIGNED2X} - D3DTEXOPCAPS_SUBTRACT = $00000200; - {$EXTERNALSYM D3DTEXOPCAPS_SUBTRACT} - D3DTEXOPCAPS_ADDSMOOTH = $00000400; - {$EXTERNALSYM D3DTEXOPCAPS_ADDSMOOTH} - D3DTEXOPCAPS_BLENDDIFFUSEALPHA = $00000800; - {$EXTERNALSYM D3DTEXOPCAPS_BLENDDIFFUSEALPHA} - D3DTEXOPCAPS_BLENDTEXTUREALPHA = $00001000; - {$EXTERNALSYM D3DTEXOPCAPS_BLENDTEXTUREALPHA} - D3DTEXOPCAPS_BLENDFACTORALPHA = $00002000; - {$EXTERNALSYM D3DTEXOPCAPS_BLENDFACTORALPHA} - D3DTEXOPCAPS_BLENDTEXTUREALPHAPM = $00004000; - {$EXTERNALSYM D3DTEXOPCAPS_BLENDTEXTUREALPHAPM} - D3DTEXOPCAPS_BLENDCURRENTALPHA = $00008000; - {$EXTERNALSYM D3DTEXOPCAPS_BLENDCURRENTALPHA} - D3DTEXOPCAPS_PREMODULATE = $00010000; - {$EXTERNALSYM D3DTEXOPCAPS_PREMODULATE} - D3DTEXOPCAPS_MODULATEALPHA_ADDCOLOR = $00020000; - {$EXTERNALSYM D3DTEXOPCAPS_MODULATEALPHA_ADDCOLOR} - D3DTEXOPCAPS_MODULATECOLOR_ADDALPHA = $00040000; - {$EXTERNALSYM D3DTEXOPCAPS_MODULATECOLOR_ADDALPHA} - D3DTEXOPCAPS_MODULATEINVALPHA_ADDCOLOR = $00080000; - {$EXTERNALSYM D3DTEXOPCAPS_MODULATEINVALPHA_ADDCOLOR} - D3DTEXOPCAPS_MODULATEINVCOLOR_ADDALPHA = $00100000; - {$EXTERNALSYM D3DTEXOPCAPS_MODULATEINVCOLOR_ADDALPHA} - D3DTEXOPCAPS_BUMPENVMAP = $00200000; - {$EXTERNALSYM D3DTEXOPCAPS_BUMPENVMAP} - D3DTEXOPCAPS_BUMPENVMAPLUMINANCE = $00400000; - {$EXTERNALSYM D3DTEXOPCAPS_BUMPENVMAPLUMINANCE} - D3DTEXOPCAPS_DOTPRODUCT3 = $00800000; - {$EXTERNALSYM D3DTEXOPCAPS_DOTPRODUCT3} - D3DTEXOPCAPS_MULTIPLYADD = $01000000; - {$EXTERNALSYM D3DTEXOPCAPS_MULTIPLYADD} - D3DTEXOPCAPS_LERP = $02000000; - {$EXTERNALSYM D3DTEXOPCAPS_LERP} - - // - // FVFCaps - // - D3DFVFCAPS_TEXCOORDCOUNTMASK = $0000ffff; { mask for texture coordinate count field } - {$EXTERNALSYM D3DFVFCAPS_TEXCOORDCOUNTMASK} - D3DFVFCAPS_DONOTSTRIPELEMENTS = $00080000; { Device prefers that vertex elements not be stripped } - {$EXTERNALSYM D3DFVFCAPS_DONOTSTRIPELEMENTS} - D3DFVFCAPS_PSIZE = $00100000; { Device can receive point size } - {$EXTERNALSYM D3DFVFCAPS_PSIZE} - - // - // VertexProcessingCaps - // - D3DVTXPCAPS_TEXGEN = $00000001; { device can do texgen } - {$EXTERNALSYM D3DVTXPCAPS_TEXGEN} - D3DVTXPCAPS_MATERIALSOURCE7 = $00000002; { device can do DX7-level colormaterialsource ops } - {$EXTERNALSYM D3DVTXPCAPS_MATERIALSOURCE7} - D3DVTXPCAPS_DIRECTIONALLIGHTS = $00000008; { device can do directional lights } - {$EXTERNALSYM D3DVTXPCAPS_DIRECTIONALLIGHTS} - D3DVTXPCAPS_POSITIONALLIGHTS = $00000010; { device can do positional lights (includes point and spot) } - {$EXTERNALSYM D3DVTXPCAPS_POSITIONALLIGHTS} - D3DVTXPCAPS_LOCALVIEWER = $00000020; { device can do local viewer } - {$EXTERNALSYM D3DVTXPCAPS_LOCALVIEWER} - D3DVTXPCAPS_TWEENING = $00000040; { device can do vertex tweening } - {$EXTERNALSYM D3DVTXPCAPS_TWEENING} - D3DVTXPCAPS_TEXGEN_SPHEREMAP = $00000100; { device supports D3DTSS_TCI_SPHEREMAP } - {$EXTERNALSYM D3DVTXPCAPS_TEXGEN_SPHEREMAP} - D3DVTXPCAPS_NO_TEXGEN_NONLOCALVIEWER = $00000200; { device does not support TexGen in non-local - viewer mode } - {$EXTERNALSYM D3DVTXPCAPS_NO_TEXGEN_NONLOCALVIEWER} - - // - // DevCaps2 - // - D3DDEVCAPS2_STREAMOFFSET = $00000001; { Device supports offsets in streams. Must be set by DX9 drivers } - {$EXTERNALSYM D3DDEVCAPS2_STREAMOFFSET} - D3DDEVCAPS2_DMAPNPATCH = $00000002; { Device supports displacement maps for N-Patches} - {$EXTERNALSYM D3DDEVCAPS2_DMAPNPATCH} - D3DDEVCAPS2_ADAPTIVETESSRTPATCH = $00000004; { Device supports adaptive tesselation of RT-patches} - {$EXTERNALSYM D3DDEVCAPS2_ADAPTIVETESSRTPATCH} - D3DDEVCAPS2_ADAPTIVETESSNPATCH = $00000008; { Device supports adaptive tesselation of N-patches} - {$EXTERNALSYM D3DDEVCAPS2_ADAPTIVETESSNPATCH} - D3DDEVCAPS2_CAN_STRETCHRECT_FROM_TEXTURES = $00000010; { Device supports StretchRect calls with a texture as the source} - {$EXTERNALSYM D3DDEVCAPS2_CAN_STRETCHRECT_FROM_TEXTURES} - D3DDEVCAPS2_PRESAMPLEDDMAPNPATCH = $00000020; { Device supports presampled displacement maps for N-Patches } - {$EXTERNALSYM D3DDEVCAPS2_PRESAMPLEDDMAPNPATCH} - D3DDEVCAPS2_VERTEXELEMENTSCANSHARESTREAMOFFSET = $00000040; { Vertex elements in a vertex declaration can share the same stream offset } - {$EXTERNALSYM D3DDEVCAPS2_VERTEXELEMENTSCANSHARESTREAMOFFSET} - - // - // DeclTypes - // - D3DDTCAPS_UBYTE4 = $00000001; - {$EXTERNALSYM D3DDTCAPS_UBYTE4} - D3DDTCAPS_UBYTE4N = $00000002; - {$EXTERNALSYM D3DDTCAPS_UBYTE4N} - D3DDTCAPS_SHORT2N = $00000004; - {$EXTERNALSYM D3DDTCAPS_SHORT2N} - D3DDTCAPS_SHORT4N = $00000008; - {$EXTERNALSYM D3DDTCAPS_SHORT4N} - D3DDTCAPS_USHORT2N = $00000010; - {$EXTERNALSYM D3DDTCAPS_USHORT2N} - D3DDTCAPS_USHORT4N = $00000020; - {$EXTERNALSYM D3DDTCAPS_USHORT4N} - D3DDTCAPS_UDEC3 = $00000040; - {$EXTERNALSYM D3DDTCAPS_UDEC3} - D3DDTCAPS_DEC3N = $00000080; - {$EXTERNALSYM D3DDTCAPS_DEC3N} - D3DDTCAPS_FLOAT16_2 = $00000100; - {$EXTERNALSYM D3DDTCAPS_FLOAT16_2} - D3DDTCAPS_FLOAT16_4 = $00000200; - {$EXTERNALSYM D3DDTCAPS_FLOAT16_4} - - - - -(*==========================================================================; - * - * Copyright (C) Microsoft Corporation. All Rights Reserved. - * - * File: d3d9.h - * Content: Direct3D include file - * - ****************************************************************************) - -(* This identifier is passed to Direct3DCreate9 in order to ensure that an - * application was built against the correct header files. This number is - * incremented whenever a header (or other) change would require applications - * to be rebuilt. If the version doesn't match, Direct3DCreate9 will fail. - * (The number itself has no meaning.)*) - -const - D3D_SDK_VERSION = (32 or $80000000); - D3D9b_SDK_VERSION = (31 or $80000000); - {$EXTERNALSYM D3D_SDK_VERSION} - {$EXTERNALSYM D3D9b_SDK_VERSION} - -type - HMONITOR = THandle; - {$EXTERNALSYM HMONITOR} - -(* - * Direct3D interfaces - *) - - // forward interfaces declaration - IDirect3D9 = interface; - IDirect3DDevice9 = interface; -{$IFDEF DIRECT3D_VERSION_9_VISTA} - IDirect3DDevice9Ex = interface; -{$ENDIF} - IDirect3DStateBlock9 = interface; - IDirect3DVertexDeclaration9 = interface; - IDirect3DVertexShader9 = interface; - IDirect3DPixelShader9 = interface; - IDirect3DResource9 = interface; - IDirect3DBaseTexture9 = interface; - IDirect3DTexture9 = interface; - IDirect3DVolumeTexture9 = interface; - IDirect3DCubeTexture9 = interface; - IDirect3DVertexBuffer9 = interface; - IDirect3DIndexBuffer9 = interface; - IDirect3DSurface9 = interface; - IDirect3DVolume9 = interface; - IDirect3DSwapChain9 = interface; - IDirect3DQuery9 = interface; - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3D9);'} - {$EXTERNALSYM IDirect3D9} - IDirect3D9 = interface(IUnknown) - ['{81BDCBCA-64D4-426d-AE8D-AD0147F4275C}'] - (*** IDirect3D9 methods ***) - function RegisterSoftwareDevice(pInitializeFunction: Pointer): HResult; stdcall; - function GetAdapterCount: LongWord; stdcall; - function GetAdapterIdentifier(Adapter: LongWord; Flags: DWord; out pIdentifier: TD3DAdapterIdentifier9): HResult; stdcall; - function GetAdapterModeCount(Adapter: LongWord; Format: TD3DFormat): LongWord; stdcall; - function EnumAdapterModes(Adapter: LongWord; Format: TD3DFormat; Mode: LongWord; out pMode: TD3DDisplayMode): HResult; stdcall; - function GetAdapterDisplayMode(Adapter: LongWord; out pMode: TD3DDisplayMode): HResult; stdcall; - function CheckDeviceType(Adapter: LongWord; CheckType: TD3DDevType; AdapterFormat, BackBufferFormat: TD3DFormat; Windowed: BOOL): HResult; stdcall; - function CheckDeviceFormat(Adapter: LongWord; DeviceType: TD3DDevType; AdapterFormat: TD3DFormat; Usage: DWord; RType: TD3DResourceType; CheckFormat: TD3DFormat): HResult; stdcall; - function CheckDeviceMultiSampleType(Adapter: LongWord; DeviceType: TD3DDevType; SurfaceFormat: TD3DFormat; Windowed: BOOL; MultiSampleType: TD3DMultiSampleType; pQualityLevels: PDWORD): HResult; stdcall; - function CheckDepthStencilMatch(Adapter: LongWord; DeviceType: TD3DDevType; AdapterFormat, RenderTargetFormat, DepthStencilFormat: TD3DFormat): HResult; stdcall; - function CheckDeviceFormatConversion(Adapter: LongWord; DeviceType: TD3DDevType; SourceFormat, TargetFormat: TD3DFormat): HResult; stdcall; - function GetDeviceCaps(Adapter: LongWord; DeviceType: TD3DDevType; out pCaps: TD3DCaps9): HResult; stdcall; - function GetAdapterMonitor(Adapter: LongWord): HMONITOR; stdcall; - function CreateDevice(Adapter: LongWord; DeviceType: TD3DDevType; hFocusWindow: HWND; BehaviorFlags: DWord; pPresentationParameters: PD3DPresentParameters; out ppReturnedDeviceInterface: IDirect3DDevice9): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3D9Helper} - IDirect3D9Helper = class - (*** helper information ***) - szVersionString: PWideChar; - end; -{$IFDEF DIRECT3D_VERSION_9_VISTA} - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3D9Ex);'} - {$EXTERNALSYM IDirect3D9Ex} - IDirect3D9Ex = interface(IDirect3D9) - ['{02177241-69FC-400C-8FF1-93A44DF6861D}'] - (*** IDirect3D9Ex methods ***) - function GetAdapterModeCountEx(Adapter: LongWord; const pFilter: PD3DDisplayModeFilter): LongWord; stdcall; - function EnumAdapterModesEx(Adapter: LongWord; const pFilter: PD3DDisplayModeFilter; Mode: LongWord; pMode: PD3DDisplayModeEx): HResult; stdcall; - function GetAdapterDisplayModeEx(Adapter: LongWord; pMode: PD3DDisplayModeEx; pRotation: PD3DDisplayRotation): HResult; stdcall; - function CreateDeviceEx(Adapter: LongWord; DeviceType: TD3DDevType; hFocusWindow: HWND; BehaviorFlags: DWORD; pPresentationParameters: PD3DPresentParameters; pFullscreenDisplayMode: PD3DDisplayModeEx; out ppReturnedDeviceInterface: IDirect3DDevice9Ex): HResult; stdcall; - function GetAdapterLUID(Adapter: LongWord; pLUID: PLargeInteger{*LUID}): HResult; stdcall; - end; -{$ENDIF} - - - -{ SwapChain } - - - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DDevice9);'} - {$EXTERNALSYM IDirect3DDevice9} - IDirect3DDevice9 = interface(IUnknown) - ['{D0223B96-BF7A-43fd-92BD-A43B0D82B9EB}'] - (*** IDirect3DDevice9 methods ***) - function TestCooperativeLevel: HResult; stdcall; - function GetAvailableTextureMem: LongWord; stdcall; - function EvictManagedResources: HResult; stdcall; - function GetDirect3D(out ppD3D9: IDirect3D9): HResult; stdcall; - function GetDeviceCaps(out pCaps: TD3DCaps9): HResult; stdcall; - function GetDisplayMode(iSwapChain: LongWord; out pMode: TD3DDisplayMode): HResult; stdcall; - function GetCreationParameters(out pParameters: TD3DDeviceCreationParameters): HResult; stdcall; - function SetCursorProperties(XHotSpot, YHotSpot: LongWord; pCursorBitmap: IDirect3DSurface9): HResult; stdcall; - procedure SetCursorPosition(XScreenSpace, YScreenSpace: LongWord; Flags: DWord); stdcall; - function ShowCursor(bShow: BOOL): BOOL; stdcall; - function CreateAdditionalSwapChain(const pPresentationParameters: TD3DPresentParameters; out pSwapChain: IDirect3DSwapChain9): HResult; stdcall; - function GetSwapChain(iSwapChain: LongWord; out pSwapChain: IDirect3DSwapChain9): HResult; stdcall; - function GetNumberOfSwapChains: LongWord; stdcall; - function Reset(const pPresentationParameters: TD3DPresentParameters): HResult; stdcall; - function Present(pSourceRect, pDestRect: PRect; hDestWindowOverride: HWND; pDirtyRegion: PRgnData): HResult; stdcall; - function GetBackBuffer(iSwapChain: LongWord; iBackBuffer: LongWord; _Type: TD3DBackBufferType; out ppBackBuffer: IDirect3DSurface9): HResult; stdcall; - function GetRasterStatus(iSwapChain: LongWord; out pRasterStatus: TD3DRasterStatus): HResult; stdcall; - function SetDialogBoxMode(bEnableDialogs: BOOL): HResult; stdcall; - procedure SetGammaRamp(iSwapChain: LongWord; Flags: DWord; const pRamp: TD3DGammaRamp); stdcall; - procedure GetGammaRamp(iSwapChain: LongWord; out pRamp: TD3DGammaRamp); stdcall; - function CreateTexture(Width, Height, Levels: LongWord; Usage: DWord; Format: TD3DFormat; Pool: TD3DPool; out ppTexture: IDirect3DTexture9; pSharedHandle: PHandle): HResult; stdcall; - function CreateVolumeTexture(Width, Height, Depth, Levels: LongWord; Usage: DWord; Format: TD3DFormat; Pool: TD3DPool; out ppVolumeTexture: IDirect3DVolumeTexture9; pSharedHandle: PHandle): HResult; stdcall; - function CreateCubeTexture(EdgeLength, Levels: LongWord; Usage: DWord; Format: TD3DFormat; Pool: TD3DPool; out ppCubeTexture: IDirect3DCubeTexture9; pSharedHandle: PHandle): HResult; stdcall; - function CreateVertexBuffer(Length: LongWord; Usage, FVF: DWord; Pool: TD3DPool; out ppVertexBuffer: IDirect3DVertexBuffer9; pSharedHandle: PHandle): HResult; stdcall; - function CreateIndexBuffer(Length: LongWord; Usage: DWord; Format: TD3DFormat; Pool: TD3DPool; out ppIndexBuffer: IDirect3DIndexBuffer9; pSharedHandle: PHandle): HResult; stdcall; - function CreateRenderTarget(Width, Height: LongWord; Format: TD3DFormat; MultiSample: TD3DMultiSampleType; MultisampleQuality: DWORD; Lockable: BOOL; out ppSurface: IDirect3DSurface9; pSharedHandle: PHandle): HResult; stdcall; - function CreateDepthStencilSurface(Width, Height: LongWord; Format: TD3DFormat; MultiSample: TD3DMultiSampleType; MultisampleQuality: DWORD; Discard: BOOL; out ppSurface: IDirect3DSurface9; pSharedHandle: PHandle): HResult; stdcall; - function UpdateSurface(pSourceSurface: IDirect3DSurface9; pSourceRect: PRect; pDestinationSurface: IDirect3DSurface9; pDestPoint: PPoint): HResult; stdcall; - function UpdateTexture(pSourceTexture, pDestinationTexture: IDirect3DBaseTexture9): HResult; stdcall; - function GetRenderTargetData(pRenderTarget, pDestSurface: IDirect3DSurface9): HResult; stdcall; - function GetFrontBufferData(iSwapChain: LongWord; pDestSurface: IDirect3DSurface9): HResult; stdcall; - function StretchRect(pSourceSurface: IDirect3DSurface9; pSourceRect: PRect; pDestSurface: IDirect3DSurface9; pDestRect: PRect; Filter: TD3DTextureFilterType): HResult; stdcall; - function ColorFill(pSurface: IDirect3DSurface9; pRect: PRect; color: TD3DColor): HResult; stdcall; - function CreateOffscreenPlainSurface(Width, Height: LongWord; Format: TD3DFormat; Pool: TD3DPool; out ppSurface: IDirect3DSurface9; pSharedHandle: PHandle): HResult; stdcall; - function SetRenderTarget(RenderTargetIndex: DWORD; pRenderTarget: IDirect3DSurface9): HResult; stdcall; - function GetRenderTarget(RenderTargetIndex: DWORD; out ppRenderTarget: IDirect3DSurface9): HResult; stdcall; - function SetDepthStencilSurface(pNewZStencil: IDirect3DSurface9): HResult; stdcall; - function GetDepthStencilSurface(out ppZStencilSurface: IDirect3DSurface9): HResult; stdcall; - function BeginScene: HResult; stdcall; - function EndScene: HResult; stdcall; - function Clear(Count: DWord; pRects: PD3DRect; Flags: DWord; Color: TD3DColor; Z: Single; Stencil: DWord): HResult; stdcall; - function SetTransform(State: TD3DTransformStateType; const pMatrix: TD3DMatrix): HResult; stdcall; - function GetTransform(State: TD3DTransformStateType; out pMatrix: TD3DMatrix): HResult; stdcall; - function MultiplyTransform(State: TD3DTransformStateType; const pMatrix: TD3DMatrix): HResult; stdcall; - function SetViewport(const pViewport: TD3DViewport9): HResult; stdcall; - function GetViewport(out pViewport: TD3DViewport9): HResult; stdcall; - function SetMaterial(const pMaterial: TD3DMaterial9): HResult; stdcall; - function GetMaterial(out pMaterial: TD3DMaterial9): HResult; stdcall; - function SetLight(Index: DWord; const pLight: TD3DLight9): HResult; stdcall; - function GetLight(Index: DWord; out pLight: TD3DLight9): HResult; stdcall; - function LightEnable(Index: DWord; Enable: BOOL): HResult; stdcall; - function GetLightEnable(Index: DWord; out pEnable: BOOL): HResult; stdcall; - function SetClipPlane(Index: DWord; pPlane: PSingle): HResult; stdcall; - function GetClipPlane(Index: DWord; pPlane: PSingle): HResult; stdcall; - function SetRenderState(State: TD3DRenderStateType; Value: DWord): HResult; stdcall; - function GetRenderState(State: TD3DRenderStateType; out pValue: DWord): HResult; stdcall; - function CreateStateBlock(_Type: TD3DStateBlockType; out ppSB: IDirect3DStateBlock9): HResult; stdcall; - function BeginStateBlock: HResult; stdcall; - function EndStateBlock(out ppSB: IDirect3DStateBlock9): HResult; stdcall; - function SetClipStatus(const pClipStatus: TD3DClipStatus9): HResult; stdcall; - function GetClipStatus(out pClipStatus: TD3DClipStatus9): HResult; stdcall; - function GetTexture(Stage: DWord; out ppTexture: IDirect3DBaseTexture9): HResult; stdcall; - function SetTexture(Stage: DWord; pTexture: IDirect3DBaseTexture9): HResult; stdcall; - function GetTextureStageState(Stage: DWord; _Type: TD3DTextureStageStateType; out pValue: DWord): HResult; stdcall; - function SetTextureStageState(Stage: DWord; _Type: TD3DTextureStageStateType; Value: DWord): HResult; stdcall; - function GetSamplerState(Sampler: DWORD; _Type: TD3DSamplerStateType; out pValue: DWORD): HResult; stdcall; - function SetSamplerState(Sampler: DWORD; _Type: TD3DSamplerStateType; Value: DWORD): HResult; stdcall; - function ValidateDevice(out pNumPasses: DWord): HResult; stdcall; - function SetPaletteEntries(PaletteNumber: LongWord; pEntries: pPaletteEntry): HResult; stdcall; - function GetPaletteEntries(PaletteNumber: LongWord; pEntries: pPaletteEntry): HResult; stdcall; - function SetCurrentTexturePalette(PaletteNumber: LongWord): HResult; stdcall; - function GetCurrentTexturePalette(out PaletteNumber: LongWord): HResult; stdcall; - function SetScissorRect(pRect: PRect): HResult; stdcall; - function GetScissorRect(out pRect: TRect): HResult; stdcall; - function SetSoftwareVertexProcessing(bSoftware: BOOL): HResult; stdcall; - function GetSoftwareVertexProcessing: BOOL; stdcall; - function SetNPatchMode(nSegments: Single): HResult; stdcall; - function GetNPatchMode: Single; stdcall; - function DrawPrimitive(PrimitiveType: TD3DPrimitiveType; StartVertex, PrimitiveCount: LongWord): HResult; stdcall; - function DrawIndexedPrimitive(_Type: TD3DPrimitiveType; BaseVertexIndex: Integer; MinVertexIndex, NumVertices, startIndex, primCount: LongWord): HResult; stdcall; - function DrawPrimitiveUP(PrimitiveType: TD3DPrimitiveType; PrimitiveCount: LongWord; const pVertexStreamZeroData; VertexStreamZeroStride: LongWord): HResult; stdcall; - function DrawIndexedPrimitiveUP(PrimitiveType: TD3DPrimitiveType; MinVertexIndex, NumVertice, PrimitiveCount: LongWord; const pIndexData; IndexDataFormat: TD3DFormat; const pVertexStreamZeroData; VertexStreamZeroStride: LongWord): HResult; stdcall; - function ProcessVertices(SrcStartIndex, DestIndex, VertexCount: LongWord; pDestBuffer: IDirect3DVertexBuffer9; pVertexDecl: IDirect3DVertexDeclaration9; Flags: DWord): HResult; stdcall; - function CreateVertexDeclaration(pVertexElements: PD3DVertexElement9; out ppDecl: IDirect3DVertexDeclaration9): HResult; stdcall; - function SetVertexDeclaration(pDecl: IDirect3DVertexDeclaration9): HResult; stdcall; - function GetVertexDeclaration(out ppDecl: IDirect3DVertexDeclaration9): HResult; stdcall; - function SetFVF(FVF: DWORD): HResult; stdcall; - function GetFVF(out FVF: DWORD): HResult; stdcall; - function CreateVertexShader(pFunction: PDWord; out ppShader: IDirect3DVertexShader9): HResult; stdcall; - function SetVertexShader(pShader: IDirect3DVertexShader9): HResult; stdcall; - function GetVertexShader(out ppShader: IDirect3DVertexShader9): HResult; stdcall; - function SetVertexShaderConstantF(StartRegister: LongWord; pConstantData: PSingle; Vector4fCount: LongWord): HResult; stdcall; - function GetVertexShaderConstantF(StartRegister: LongWord; pConstantData: PSingle; Vector4fCount: LongWord): HResult; stdcall; - function SetVertexShaderConstantI(StartRegister: LongWord; pConstantData: PInteger; Vector4iCount: LongWord): HResult; stdcall; - function GetVertexShaderConstantI(StartRegister: LongWord; pConstantData: PInteger; Vector4iCount: LongWord): HResult; stdcall; - function SetVertexShaderConstantB(StartRegister: LongWord; pConstantData: PBOOL; BoolCount: LongWord): HResult; stdcall; - function GetVertexShaderConstantB(StartRegister: LongWord; pConstantData: PBOOL; BoolCount: LongWord): HResult; stdcall; - function SetStreamSource(StreamNumber: LongWord; pStreamData: IDirect3DVertexBuffer9; OffsetInBytes, Stride: LongWord): HResult; stdcall; - function GetStreamSource(StreamNumber: LongWord; out ppStreamData: IDirect3DVertexBuffer9; out pOffsetInBytes, pStride: LongWord): HResult; stdcall; - function SetStreamSourceFreq(StreamNumber: LongWord; Setting: LongWord): HResult; stdcall; - function GetStreamSourceFreq(StreamNumber: LongWord; out Setting: LongWord): HResult; stdcall; - function SetIndices(pIndexData: IDirect3DIndexBuffer9): HResult; stdcall; - function GetIndices(out ppIndexData: IDirect3DIndexBuffer9): HResult; stdcall; - function CreatePixelShader(pFunction: PDWord; out ppShader: IDirect3DPixelShader9): HResult; stdcall; - function SetPixelShader(pShader: IDirect3DPixelShader9): HResult; stdcall; - function GetPixelShader(out ppShader: IDirect3DPixelShader9): HResult; stdcall; - function SetPixelShaderConstantF(StartRegister: LongWord; pConstantData: PSingle; Vector4fCount: LongWord): HResult; stdcall; - function GetPixelShaderConstantF(StartRegister: LongWord; pConstantData: PSingle; Vector4fCount: LongWord): HResult; stdcall; - function SetPixelShaderConstantI(StartRegister: LongWord; pConstantData: PInteger; Vector4iCount: LongWord): HResult; stdcall; - function GetPixelShaderConstantI(StartRegister: LongWord; pConstantData: PInteger; Vector4iCount: LongWord): HResult; stdcall; - function SetPixelShaderConstantB(StartRegister: LongWord; pConstantData: PBOOL; BoolCount: LongWord): HResult; stdcall; - function GetPixelShaderConstantB(StartRegister: LongWord; pConstantData: PBOOL; BoolCount: LongWord): HResult; stdcall; - function DrawRectPatch(Handle: LongWord; pNumSegs: PSingle; pTriPatchInfo: PD3DRectPatchInfo): HResult; stdcall; - function DrawTriPatch(Handle: LongWord; pNumSegs: PSingle; pTriPatchInfo: PD3DTriPatchInfo): HResult; stdcall; - function DeletePatch(Handle: LongWord): HResult; stdcall; - function CreateQuery(_Type: TD3DQueryType; out ppQuery: IDirect3DQuery9): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DDevice9Helper} - IDirect3DDevice9Helper = class - (*** helper information ***) - CreationParameters: TD3DDeviceCreationParameters; - PresentParameters: TD3DPresentParameters; - DisplayMode: TD3DDisplayMode; - Caps: TD3DCaps9; - - AvailableTextureMem: LongWord; - SwapChains: LongWord; - Textures: LongWord; - VertexBuffers: LongWord; - IndexBuffers: LongWord; - VertexShaders: LongWord; - PixelShaders: LongWord; - - Viewport: TD3DViewport9; - ProjectionMatrix: TD3DMatrix; - ViewMatrix: TD3DMatrix; - WorldMatrix: TD3DMatrix; - TextureMatrices: array[0..7] of TD3DMatrix; - - FVF: DWORD; - VertexSize: LongWord; - VertexShaderVersion: DWORD; - PixelShaderVersion: DWORD; - SoftwareVertexProcessing: BOOL; - - Material: TD3DMaterial9; - Lights: array[0..15] of TD3DLight9; - LightsEnabled: array[0..15] of BOOL; - - GammaRamp: TD3DGammaRamp; - ScissorRect: TRect; - DialogBoxMode: BOOL; - end; -{$IFDEF DIRECT3D_VERSION_9_VISTA} - - - PIDirect3DResource9 = ^IDirect3DResource9; - {$EXTERNALSYM PIDirect3DResource9} - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DDevice9Ex);'} - {$EXTERNALSYM IDirect3DDevice9Ex} - IDirect3DDevice9Ex = interface(IDirect3DDevice9) - ['{B18B10CE-2649-405a-870F-95F777D4313A}'] - (*** IDirect3DDevice9Ex methods ***) - function SetConvolutionMonoKernel(Width, Height: LongWord; rows, columns: PSingle): HResult; stdcall; - function ComposeRects(pSrc, pDst: IDirect3DSurface9; pSrcRectDescs: IDirect3DVertexBuffer9; NumRects: LongWord; pDstRectDescs: IDirect3DVertexBuffer9; Operation: TD3DComposeRectsOp; Xoffset, Yoffset: Integer): HResult; stdcall; - function PresentEx(const pSourceRect, pDestRect: PRect; hDestWindowOverride: HWND; const pDirtyRegion: PRgnData; dwFlags: DWORD): HResult; stdcall; - function GetGPUThreadPriority(out pPriority: Integer): HResult; stdcall; - function SetGPUThreadPriority(Priority: Integer): HResult; stdcall; - function WaitForVBlank(iSwapChain: LongWord): HResult; stdcall; - function CheckResourceResidency(pResourceArray: PIDirect3DResource9; NumResources: LongWord): HResult; stdcall; - function SetMaximumFrameLatency(MaxLatency: LongWord): HResult; stdcall; - function GetMaximumFrameLatency(out pMaxLatency: LongWord): HResult; stdcall; - function CheckDeviceState(hDestinationWindow: HWND): HResult; stdcall; - function CreateRenderTargetEx(Width, Height: LongWord; Format: TD3DFormat; MultiSample: TD3DMultiSampleType; MultisampleQuality: DWORD; Lockable: BOOL; out ppSurface: IDirect3DSurface9; pSharedHandle: PHandle; Usage: DWORD): HResult; stdcall; - function CreateOffscreenPlainSurfaceEx(Width, Height: LongWord; Format: TD3DFormat; Pool: TD3DPool; out ppSurface: IDirect3DSurface9; pSharedHandle: PHandle; Usage: DWORD): HResult; stdcall; - function CreateDepthStencilSurfaceEx(Width, Height: LongWord; Format: TD3DFormat; MultiSample: TD3DMultiSampleType; MultisampleQuality: DWORD; Discard: BOOL; out ppSurface: IDirect3DSurface9; pSharedHandle: PHandle; Usage: DWORD): HResult; stdcall; - function ResetEx(const pPresentationParameters: TD3DPresentParameters; const pFullscreenDisplayMode: TD3DDisplayModeEx): HResult; stdcall; - function GetDisplayModeEx(iSwapChain: LongWord; pMode: PD3DDisplayModeEx; pRotation: PD3DDisplayRotation): HResult; stdcall; - end; -{$ENDIF} - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DStateBlock9);'} - {$EXTERNALSYM IDirect3DStateBlock9} - IDirect3DStateBlock9 = interface(IUnknown) - ['{B07C4FE5-310D-4ba8-A23C-4F0F206F218B}'] - (*** IDirect3DStateBlock9 methods ***) - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function Capture: HResult; stdcall; - function Apply: HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DStateBlock9Helper} - IDirect3DStateBlock9Helper = class - (*** helper information ***) - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DSwapChain9);'} - {$EXTERNALSYM IDirect3DSwapChain9} - IDirect3DSwapChain9 = interface(IUnknown) - ['{794950F2-ADFC-458a-905E-10A10B0B503B}'] - (*** IDirect3DSwapChain9 methods ***) - function Present(pSourceRect, pDestRect: PRect; hDestWindowOverride: HWND; pDirtyRegion: PRgnData; dwFlags: DWORD): HResult; stdcall; - function GetFrontBufferData(pDestSurface: IDirect3DSurface9): HResult; stdcall; - function GetBackBuffer(iBackBuffer: LongWord; _Type: TD3DBackBufferType; out ppBackBuffer: IDirect3DSurface9): HResult; stdcall; - function GetRasterStatus(out pRasterStatus: TD3DRasterStatus): HResult; stdcall; - function GetDisplayMode(out pMode: TD3DDisplayMode): HResult; stdcall; - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function GetPresentParameters(out pPresentationParameters: TD3DPresentParameters): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DSwapChain9Helper} - IDirect3DSwapChain9Helper = class - (*** helper information ***) - PresentParameters: TD3DPresentParameters; - DisplayMode: TD3DDisplayMode; - CreationCallStack: PWideChar; - end; -{$IFDEF DIRECT3D_VERSION_9_VISTA} - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DSwapChain9Ex);'} - {$EXTERNALSYM IDirect3DSwapChain9Ex} - IDirect3DSwapChain9Ex = interface(IDirect3DSwapChain9) - ['{91886CAF-1C3D-4d2e-A0AB-3E4C7D8D3303}'] - (*** IDirect3DSwapChain9Ex methods ***) - function GetLastPresentCount(out pLastPresentCount: LongWord): HResult; stdcall; - function GetPresentStats(out pPresentationStatistics: TD3DPresentStats): HResult; stdcall; - function GetDisplayModeEx(pMode: PD3DDisplayModeEx; pRotation: PD3DDisplayRotation): HResult; stdcall; - end; -{$ENDIF} - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DResource9);'} - {$EXTERNALSYM IDirect3DResource9} - IDirect3DResource9 = interface(IUnknown) - ['{05EEC05D-8F7D-4362-B999-D1BAF357C704}'] - (*** IDirect3DResource9 methods ***) - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function SetPrivateData(const refguid: TGUID; const pData: Pointer; SizeOfData, Flags: DWord): HResult; stdcall; - function GetPrivateData(const refguid: TGUID; pData: Pointer; out pSizeOfData: DWord): HResult; stdcall; - function FreePrivateData(const refguid: TGUID): HResult; stdcall; - function SetPriority(PriorityNew: DWord): DWord; stdcall; - function GetPriority: DWord; stdcall; - procedure PreLoad; stdcall; - function GetType: TD3DResourceType; stdcall; - end; - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DVertexDeclaration9);'} - {$EXTERNALSYM IDirect3DVertexDeclaration9} - IDirect3DVertexDeclaration9 = interface(IUnknown) - ['{DD13C59C-36FA-4098-A8FB-C7ED39DC8546}'] - (*** IDirect3DVertexDeclaration9 methods ***) - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function GetDeclaration(pElement: PD3DVertexElement9; out pNumElements: LongWord): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DVertexDeclaration9Helper} - IDirect3DVertexDeclaration9Helper = class - (*** helper information ***) - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DVertexShader9);'} - {$EXTERNALSYM IDirect3DVertexShader9} - IDirect3DVertexShader9 = interface(IUnknown) - ['{EFC5557E-6265-4613-8A94-43857889EB36}'] - (*** IDirect3DVertexShader9 methods ***) - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function GetFunction(pData: Pointer; out pSizeOfData: LongWord): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DVertexShader9Helper} - IDirect3DVertexShader9Helper = class - (*** helper information ***) - Version: DWORD; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DPixelShader9);'} - {$EXTERNALSYM IDirect3DPixelShader9} - IDirect3DPixelShader9 = interface(IUnknown) - ['{6D3BDBDC-5B02-4415-B852-CE5E8BCCB289}'] - (*** IDirect3DPixelShader9 methods ***) - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function GetFunction(pData: Pointer; out pSizeOfData: LongWord): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DPixelShader9Helper} - IDirect3DPixelShader9Helper = class - (*** helper information ***) - Version: DWORD; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DBaseTexture9);'} - {$EXTERNALSYM IDirect3DBaseTexture9} - IDirect3DBaseTexture9 = interface(IDirect3DResource9) - ['{580CA87E-1D3C-4d54-991D-B7D3E3C298CE}'] - (*** IDirect3DBaseTexture9 methods ***) - function SetLOD(LODNew: DWord): DWord; stdcall; - function GetLOD: DWord; stdcall; - function GetLevelCount: DWord; stdcall; - function SetAutoGenFilterType(FilterType: TD3DTextureFilterType): HResult; stdcall; - function GetAutoGenFilterType: TD3DTextureFilterType; stdcall; - procedure GenerateMipSubLevels; stdcall; - end; - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DTexture9);'} - {$EXTERNALSYM IDirect3DTexture9} - IDirect3DTexture9 = interface(IDirect3DBaseTexture9) - ['{85C31227-3DE5-4f00-9B3A-F11AC38C18B5}'] - (*** IDirect3DTexture9 methods ***) - function GetLevelDesc(Level: LongWord; out pDesc: TD3DSurfaceDesc): HResult; stdcall; - function GetSurfaceLevel(Level: LongWord; out ppSurfaceLevel: IDirect3DSurface9): HResult; stdcall; - function LockRect(Level: LongWord; out pLockedRect: TD3DLockedRect; pRect: PRect; Flags: DWord): HResult; stdcall; - function UnlockRect(Level: LongWord): HResult; stdcall; - function AddDirtyRect(pDirtyRect: PRect): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DTexture9Helper} - IDirect3DTexture9Helper = class - (*** helper information ***) - Name: PWideChar; - Width: LongWord; - Height: LongWord; - Levels: LongWord; - Usage: DWORD; - Format: TD3DFormat; - Pool: TD3DPool; - Priority: DWORD; - LOD: DWORD; - FilterType: TD3DTextureFilterType; - LockCount: LongWord; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DVolumeTexture9);'} - {$EXTERNALSYM IDirect3DVolumeTexture9} - IDirect3DVolumeTexture9 = interface(IDirect3DBaseTexture9) - ['{2518526C-E789-4111-A7B9-47EF328D13E6}'] - (*** IDirect3DVolumeTexture9 methods ***) - function GetLevelDesc(Level: LongWord; out pDesc: TD3DVolumeDesc): HResult; stdcall; - function GetVolumeLevel(Level: LongWord; out ppVolumeLevel: IDirect3DVolume9): HResult; stdcall; - function LockBox(Level: LongWord; out pLockedVolume: TD3DLockedBox; pBox: PD3DBox; Flags: DWord): HResult; stdcall; - function UnlockBox(Level: LongWord): HResult; stdcall; - function AddDirtyBox(pDirtyBox: PD3DBox): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DVolumeTexture9Helper} - IDirect3DVolumeTexture9Helper = class - (*** helper information ***) - Name: PWideChar; - Width: LongWord; - Height: LongWord; - Depth: LongWord; - Levels: LongWord; - Usage: DWORD; - Format: TD3DFormat; - Pool: TD3DPool; - Priority: DWORD; - LOD: DWORD; - FilterType: TD3DTextureFilterType; - LockCount: LongWord; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DCubeTexture9);'} - {$EXTERNALSYM IDirect3DCubeTexture9} - IDirect3DCubeTexture9 = interface(IDirect3DBaseTexture9) - ['{FFF32F81-D953-473a-9223-93D652ABA93F}'] - (*** IDirect3DCubeTexture9 methods ***) - function GetLevelDesc(Level: LongWord; out pDesc: TD3DSurfaceDesc): HResult; stdcall; - function GetCubeMapSurface(FaceType: TD3DCubeMapFaces; Level: LongWord; out ppCubeMapSurface: IDirect3DSurface9): HResult; stdcall; - function LockRect(FaceType: TD3DCubeMapFaces; Level: LongWord; out pLockedRect: TD3DLockedRect; pRect: PRect; Flags: DWord): HResult; stdcall; - function UnlockRect(FaceType: TD3DCubeMapFaces; Level: LongWord): HResult; stdcall; - function AddDirtyRect(FaceType: TD3DCubeMapFaces; pDirtyRect: PRect): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DCubeTexture9Helper} - IDirect3DCubeTexture9Helper = class - (*** helper information ***) - Name: PWideChar; - Width: LongWord; - Height: LongWord; - Depth: LongWord; - Levels: LongWord; - Usage: DWORD; - Format: TD3DFormat; - Pool: TD3DPool; - Priority: DWORD; - LOD: DWORD; - FilterType: TD3DTextureFilterType; - LockCount: LongWord; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DVertexBuffer9);'} - {$EXTERNALSYM IDirect3DVertexBuffer9} - IDirect3DVertexBuffer9 = interface(IDirect3DResource9) - ['{B64BB1B5-FD70-4df6-BF91-19D0A12455E3}'] - (*** IDirect3DVertexBuffer9 methods ***) - function Lock(OffsetToLock, SizeToLock: LongWord; out ppbData: Pointer; Flags: DWord): HResult; stdcall; - function Unlock: HResult; stdcall; - function GetDesc(out pDesc: TD3DVertexBufferDesc): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DVertexBuffer9Helper} - IDirect3DVertexBuffer9Helper = class - (*** helper information ***) - Name: PWideChar; - Length: LongWord; - Usage: DWORD; - FVF: DWORD; - Pool: TD3DPool; - Priority: DWORD; - LockCount: LongWord; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DIndexBuffer9);'} - {$EXTERNALSYM IDirect3DIndexBuffer9} - IDirect3DIndexBuffer9 = interface(IDirect3DResource9) - ['{7C9DD65E-D3F7-4529-ACEE-785830ACDE35}'] - (*** IDirect3DIndexBuffer9 methods ***) - function Lock(OffsetToLock, SizeToLock: DWord; out ppbData: Pointer; Flags: DWord): HResult; stdcall; - function Unlock: HResult; stdcall; - function GetDesc(out pDesc: TD3DIndexBufferDesc): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DIndexBuffer9Helper} - IDirect3DIndexBuffer9Helper = class - (*** helper information ***) - Name: PWideChar; - Length: LongWord; - Usage: DWORD; - Format: TD3DFormat; - Pool: TD3DPool; - Priority: DWORD; - LockCount: LongWord; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DSurface9);'} - {$EXTERNALSYM IDirect3DSurface9} - IDirect3DSurface9 = interface(IDirect3DResource9) - ['{0CFBAF3A-9FF6-429a-99B3-A2796AF8B89B}'] - (*** IDirect3DSurface9 methods ***) - function GetContainer(const riid: TGUID; out ppContainer{: Pointer}): HResult; stdcall; - function GetDesc(out pDesc: TD3DSurfaceDesc): HResult; stdcall; - function LockRect(out pLockedRect: TD3DLockedRect; pRect: PRect; Flags: DWord): HResult; stdcall; - function UnlockRect: HResult; stdcall; - function GetDC(out phdc: HDC): HResult; stdcall; - function ReleaseDC(hdc: HDC): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DSurface9Helper} - IDirect3DSurface9Helper = class - (*** helper information ***) - Name: PWideChar; - Width: LongWord; - Height: LongWord; - Usage: DWORD; - Format: TD3DFormat; - Pool: TD3DPool; - MultiSampleType: TD3DMultiSampleType; - MultiSampleQuality: DWORD; - Priority: DWORD; - LockCount: LongWord; - DCCount: LongWord; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DVolume9);'} - {$EXTERNALSYM IDirect3DVolume9} - IDirect3DVolume9 = interface (IUnknown) - ['{24F416E6-1F67-4aa7-B88E-D33F6F3128A1}'] - (*** IDirect3DVolume9 methods ***) - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function SetPrivateData(const refguid: TGUID; const pData; SizeOfData, Flags: DWord): HResult; stdcall; - function GetPrivateData(const refguid: TGUID; pData: Pointer; out pSizeOfData: DWord): HResult; stdcall; - function FreePrivateData(const refguid: TGUID): HResult; stdcall; - function GetContainer(const riid: TGUID; var ppContainer: Pointer): HResult; stdcall; - function GetDesc(out pDesc: TD3DVolumeDesc): HResult; stdcall; - function LockBox(out pLockedVolume: TD3DLockedBox; pBox: PD3DBox; Flags: DWord): HResult; stdcall; - function UnlockBox: HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DVolume9Helper} - IDirect3DVolume9Helper = class - (*** helper information ***) - Name: PWideChar; - Width: LongWord; - Height: LongWord; - Depth: LongWord; - Usage: DWORD; - Format: TD3DFormat; - Pool: TD3DPool; - LockCount: LongWord; - CreationCallStack: PWideChar; - end; - - - - {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDirect3DQuery9);'} - {$EXTERNALSYM IDirect3DQuery9} - IDirect3DQuery9 = interface(IUnknown) - ['{d9771460-a695-4f26-bbd3-27b840b541cc}'] - (*** IDirect3DQuery9 methods ***) - function GetDevice(out ppDevice: IDirect3DDevice9): HResult; stdcall; - function GetType: TD3DQueryType; stdcall; - function GetDataSize: DWORD; stdcall; - function Issue(dwIssueFlags: DWORD): HResult; stdcall; - function GetData(pData: Pointer; dwSize: DWORD; dwGetDataFlags: DWORD): HResult; stdcall; - end; - - {$EXTERNALSYM IDirect3DQuery9Helper} - IDirect3DQuery9Helper = class - (*** helper information ***) - _Type: TD3DQueryType; - DataSize: DWORD; - CreationCallStack: PWideChar; - end; - - - - -(* - * Interface IID's - *) -type - IID_IDirect3D9 = IDirect3D9; - {$EXTERNALSYM IID_IDirect3D9} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - IID_IDirect3D9Ex = IDirect3D9Ex; - {$EXTERNALSYM IID_IDirect3D9Ex} -{$ENDIF} - IID_IDirect3DDevice9 = IDirect3DDevice9; - {$EXTERNALSYM IID_IDirect3DDevice9} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - IID_IDirect3DDevice9Ex = IDirect3DDevice9Ex; - {$EXTERNALSYM IID_IDirect3DDevice9Ex} -{$ENDIF} - IID_IDirect3DResource9 = IDirect3DResource9; - {$EXTERNALSYM IID_IDirect3DResource9} - IID_IDirect3DBaseTexture9 = IDirect3DBaseTexture9; - {$EXTERNALSYM IID_IDirect3DBaseTexture9} - IID_IDirect3DTexture9 = IDirect3DTexture9; - {$EXTERNALSYM IID_IDirect3DTexture9} - IID_IDirect3DCubeTexture9 = IDirect3DCubeTexture9; - {$EXTERNALSYM IID_IDirect3DCubeTexture9} - IID_IDirect3DVolumeTexture9 = IDirect3DVolumeTexture9; - {$EXTERNALSYM IID_IDirect3DVolumeTexture9} - IID_IDirect3DVertexBuffer9 = IDirect3DVertexBuffer9; - {$EXTERNALSYM IID_IDirect3DVertexBuffer9} - IID_IDirect3DIndexBuffer9 = IDirect3DIndexBuffer9; - {$EXTERNALSYM IID_IDirect3DIndexBuffer9} - IID_IDirect3DSurface9 = IDirect3DSurface9; - {$EXTERNALSYM IID_IDirect3DSurface9} - IID_IDirect3DVolume9 = IDirect3DVolume9; - {$EXTERNALSYM IID_IDirect3DVolume9} - IID_IDirect3DSwapChain9 = IDirect3DSwapChain9; - {$EXTERNALSYM IID_IDirect3DSwapChain9} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - IID_IDirect3DSwapChain9Ex = IDirect3DSwapChain9Ex; - {$EXTERNALSYM IID_IDirect3DSwapChain9Ex} -{$ENDIF} - IID_IDirect3DVertexDeclaration9 = IDirect3DVertexDeclaration9; - {$EXTERNALSYM IID_IDirect3DVertexDeclaration9} - IID_IDirect3DVertexShader9 = IDirect3DVertexShader9; - {$EXTERNALSYM IID_IDirect3DVertexShader9} - IID_IDirect3DPixelShader9 = IDirect3DPixelShader9; - {$EXTERNALSYM IID_IDirect3DPixelShader9} - IID_IDirect3DStateBlock9 = IDirect3DStateBlock9; - {$EXTERNALSYM IID_IDirect3DStateBlock9} - IID_IDirect3DQuery9 = IDirect3DQuery9; - {$EXTERNALSYM IID_IDirect3DQuery9} -const - IID_HelperName : TGUID = '{E4A36723-FDFE-4b22-B146-3C04C07F4CC8}'; - {$EXTERNALSYM IID_HelperName} - - - -const -{**************************************************************************** - * Flags for SetPrivateData method on all D3D9 interfaces - * - * The passed pointer is an IUnknown ptr. The SizeOfData argument to SetPrivateData - * must be set to sizeof(IUnknown*). Direct3D will call AddRef through this - * pointer and Release when the private data is destroyed. The data will be - * destroyed when another SetPrivateData with the same GUID is set, when - * FreePrivateData is called, or when the D3D9 object is freed. - ****************************************************************************} - D3DSPD_IUNKNOWN = $00000001; - {$EXTERNALSYM D3DSPD_IUNKNOWN} - -(**************************************************************************** - * - * Flags for IDirect3D9::CreateDevice's BehaviorFlags - * - ****************************************************************************) - - D3DCREATE_FPU_PRESERVE = $00000002; - {$EXTERNALSYM D3DCREATE_FPU_PRESERVE} - D3DCREATE_MULTITHREADED = $00000004; - {$EXTERNALSYM D3DCREATE_MULTITHREADED} - - D3DCREATE_PUREDEVICE = $00000010; - {$EXTERNALSYM D3DCREATE_PUREDEVICE} - D3DCREATE_SOFTWARE_VERTEXPROCESSING = $00000020; - {$EXTERNALSYM D3DCREATE_SOFTWARE_VERTEXPROCESSING} - D3DCREATE_HARDWARE_VERTEXPROCESSING = $00000040; - {$EXTERNALSYM D3DCREATE_HARDWARE_VERTEXPROCESSING} - D3DCREATE_MIXED_VERTEXPROCESSING = $00000080; - {$EXTERNALSYM D3DCREATE_MIXED_VERTEXPROCESSING} - - D3DCREATE_DISABLE_DRIVER_MANAGEMENT = $00000100; - {$EXTERNALSYM D3DCREATE_DISABLE_DRIVER_MANAGEMENT} - D3DCREATE_ADAPTERGROUP_DEVICE = $00000200; - {$EXTERNALSYM D3DCREATE_ADAPTERGROUP_DEVICE} - D3DCREATE_DISABLE_DRIVER_MANAGEMENT_EX = $00000400; - {$EXTERNALSYM D3DCREATE_DISABLE_DRIVER_MANAGEMENT_EX} - - // This flag causes the D3D runtime not to alter the focus - // window in any way. Use with caution- the burden of supporting - // focus management events (alt-tab, etc.) falls on the - // application, and appropriate responses (switching display - // mode, etc.) should be coded. - D3DCREATE_NOWINDOWCHANGES = $00000800; - {$EXTERNALSYM D3DCREATE_NOWINDOWCHANGES} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - // Disable multithreading for software vertex processing - D3DCREATE_DISABLE_PSGP_THREADING = $00002000; - {$EXTERNALSYM D3DCREATE_DISABLE_PSGP_THREADING} - // This flag enables present statistics on device. - D3DCREATE_ENABLE_PRESENTSTATS = $00004000; - {$EXTERNALSYM D3DCREATE_ENABLE_PRESENTSTATS} - // This flag disables printscreen support in the runtime for this device - D3DCREATE_DISABLE_PRINTSCREEN = $00008000; - {$EXTERNALSYM D3DCREATE_DISABLE_PRINTSCREEN} - - D3DCREATE_SCREENSAVER = $10000000; - {$EXTERNALSYM D3DCREATE_SCREENSAVER} -{$ENDIF} - - -(**************************************************************************** - * - * Parameter for IDirect3D9::CreateDevice's Adapter argument - * - ****************************************************************************) - - D3DADAPTER_DEFAULT = 0; - {$EXTERNALSYM D3DADAPTER_DEFAULT} - -(**************************************************************************** - * - * Flags for IDirect3D9::EnumAdapters - * - ****************************************************************************) - -{$IFDEF DIRECT3D_VERSION_9_VISTA} -(* - * The D3DENUM_WHQL_LEVEL value has been retired for this and future versions. - * See the DirectX SDK for sample code on discovering driver signatures. - *) - -(* NO_DRIVERVERSION will not fill out the DriverVersion field, nor will the - DriverVersion be incorporated into the DeviceIdentifier GUID. WINNT only *) - D3DENUM_NO_DRIVERVERSION = $00000004; - {$EXTERNALSYM D3DENUM_NO_DRIVERVERSION} -{$ELSE} - D3DENUM_WHQL_LEVEL = $00000002; - {$EXTERNALSYM D3DENUM_WHQL_LEVEL} -{$ENDIF} - -(**************************************************************************** - * - * Maximum number of back-buffers supported in DX9 - * - ****************************************************************************) - - D3DPRESENT_BACK_BUFFERS_MAX = 3; - {$EXTERNALSYM D3DPRESENT_BACK_BUFFERS_MAX} - -{$IFDEF DIRECT3D_VERSION_9_VISTA} -(**************************************************************************** - * - * Maximum number of back-buffers supported when apps use CreateDeviceEx - * - ****************************************************************************) - - D3DPRESENT_BACK_BUFFERS_MAX_EX = 30; - {$EXTERNALSYM D3DPRESENT_BACK_BUFFERS_MAX_EX} - -{$ENDIF} -(**************************************************************************** - * - * Flags for IDirect3DDevice9::SetGammaRamp - * - ****************************************************************************) - - D3DSGR_NO_CALIBRATION = $00000000; - {$EXTERNALSYM D3DSGR_NO_CALIBRATION} - D3DSGR_CALIBRATE = $00000001; - {$EXTERNALSYM D3DSGR_CALIBRATE} - -(**************************************************************************** - * - * Flags for IDirect3DDevice9::SetCursorPosition - * - ****************************************************************************) - - D3DCURSOR_IMMEDIATE_UPDATE = $00000001; - {$EXTERNALSYM D3DCURSOR_IMMEDIATE_UPDATE} - -(**************************************************************************** - * - * Flags for IDirect3DSwapChain9::Present - * - ****************************************************************************) - - D3DPRESENT_DONOTWAIT = $00000001; - {$EXTERNALSYM D3DPRESENT_DONOTWAIT} - D3DPRESENT_LINEAR_CONTENT = $00000002; - {$EXTERNALSYM D3DPRESENT_LINEAR_CONTENT} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - D3DPRESENT_DONOTFLIP = $00000004; - {$EXTERNALSYM D3DPRESENT_DONOTFLIP} - D3DPRESENT_FLIPRESTART = $00000008; - {$EXTERNALSYM D3DPRESENT_FLIPRESTART} -{$ENDIF} - -(**************************************************************************** - * - * Flags for DrawPrimitive/DrawIndexedPrimitive - * Also valid for Begin/BeginIndexed - * Also valid for VertexBuffer::CreateVertexBuffer - ****************************************************************************) - - -(* - * DirectDraw error codes - *) - _FACD3D = $876; - {$EXTERNALSYM _FACD3D} - -//#define MAKE_D3DHRESULT( code ) MAKE_HRESULT( 1, _FACD3D, code ) -function MAKE_D3DHRESULT(Code: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM MAKE_D3DHRESULT} -//#define MAKE_D3DSTATUS( code ) MAKE_HRESULT( 0, _FACD3D, code ) -function MAKE_D3DSTATUS(Code: DWord): DWord;{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} -{$EXTERNALSYM MAKE_D3DSTATUS} - -const - MAKE_D3DHRESULT_R = (1 shl 31) or (_FACD3D shl 16); - MAKE_D3DSTATUS_R = (0 shl 31) or (_FACD3D shl 16); - -(* - * Direct3D Errors - *) - D3D_OK = S_OK; - {$EXTERNALSYM D3D_OK} - - D3DERR_WRONGTEXTUREFORMAT = HResult(MAKE_D3DHRESULT_R or 2072); - {$EXTERNALSYM D3DERR_WRONGTEXTUREFORMAT} - D3DERR_UNSUPPORTEDCOLOROPERATION = HResult(MAKE_D3DHRESULT_R or 2073); - {$EXTERNALSYM D3DERR_UNSUPPORTEDCOLOROPERATION} - D3DERR_UNSUPPORTEDCOLORARG = HResult(MAKE_D3DHRESULT_R or 2074); - {$EXTERNALSYM D3DERR_UNSUPPORTEDCOLORARG} - D3DERR_UNSUPPORTEDALPHAOPERATION = HResult(MAKE_D3DHRESULT_R or 2075); - {$EXTERNALSYM D3DERR_UNSUPPORTEDALPHAOPERATION} - D3DERR_UNSUPPORTEDALPHAARG = HResult(MAKE_D3DHRESULT_R or 2076); - {$EXTERNALSYM D3DERR_UNSUPPORTEDALPHAARG} - D3DERR_TOOMANYOPERATIONS = HResult(MAKE_D3DHRESULT_R or 2077); - {$EXTERNALSYM D3DERR_TOOMANYOPERATIONS} - D3DERR_CONFLICTINGTEXTUREFILTER = HResult(MAKE_D3DHRESULT_R or 2078); - {$EXTERNALSYM D3DERR_CONFLICTINGTEXTUREFILTER} - D3DERR_UNSUPPORTEDFACTORVALUE = HResult(MAKE_D3DHRESULT_R or 2079); - {$EXTERNALSYM D3DERR_UNSUPPORTEDFACTORVALUE} - D3DERR_CONFLICTINGRENDERSTATE = HResult(MAKE_D3DHRESULT_R or 2081); - {$EXTERNALSYM D3DERR_CONFLICTINGRENDERSTATE} - D3DERR_UNSUPPORTEDTEXTUREFILTER = HResult(MAKE_D3DHRESULT_R or 2082); - {$EXTERNALSYM D3DERR_UNSUPPORTEDTEXTUREFILTER} - D3DERR_CONFLICTINGTEXTUREPALETTE = HResult(MAKE_D3DHRESULT_R or 2086); - {$EXTERNALSYM D3DERR_CONFLICTINGTEXTUREPALETTE} - D3DERR_DRIVERINTERNALERROR = HResult(MAKE_D3DHRESULT_R or 2087); - {$EXTERNALSYM D3DERR_DRIVERINTERNALERROR} - - D3DERR_NOTFOUND = HResult(MAKE_D3DHRESULT_R or 2150); - {$EXTERNALSYM D3DERR_NOTFOUND} - D3DERR_MOREDATA = HResult(MAKE_D3DHRESULT_R or 2151); - {$EXTERNALSYM D3DERR_MOREDATA} - D3DERR_DEVICELOST = HResult(MAKE_D3DHRESULT_R or 2152); - {$EXTERNALSYM D3DERR_DEVICELOST} - D3DERR_DEVICENOTRESET = HResult(MAKE_D3DHRESULT_R or 2153); - {$EXTERNALSYM D3DERR_DEVICENOTRESET} - D3DERR_NOTAVAILABLE = HResult(MAKE_D3DHRESULT_R or 2154); - {$EXTERNALSYM D3DERR_NOTAVAILABLE} - D3DERR_OUTOFVIDEOMEMORY = HResult(MAKE_D3DHRESULT_R or 380); - {$EXTERNALSYM D3DERR_OUTOFVIDEOMEMORY} - D3DERR_INVALIDDEVICE = HResult(MAKE_D3DHRESULT_R or 2155); - {$EXTERNALSYM D3DERR_INVALIDDEVICE} - D3DERR_INVALIDCALL = HResult(MAKE_D3DHRESULT_R or 2156); - {$EXTERNALSYM D3DERR_INVALIDCALL} - D3DERR_DRIVERINVALIDCALL = HResult(MAKE_D3DHRESULT_R or 2157); - {$EXTERNALSYM D3DERR_DRIVERINVALIDCALL} - D3DERR_WASSTILLDRAWING = HResult(MAKE_D3DHRESULT_R or 540); - {$EXTERNALSYM D3DERR_WASSTILLDRAWING} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - - - D3DERR_DEVICEREMOVED = HResult(MAKE_D3DHRESULT_R or 2160); - {$EXTERNALSYM D3DERR_DEVICEREMOVED} -{$ENDIF} - D3DOK_NOAUTOGEN = HResult(MAKE_D3DSTATUS_R or 2159); - {$EXTERNALSYM D3DOK_NOAUTOGEN} -{$IFDEF DIRECT3D_VERSION_9_VISTA} - S_NOT_RESIDENT = HResult(MAKE_D3DSTATUS_R or 2165); - {$EXTERNALSYM S_NOT_RESIDENT} - S_RESIDENT_IN_SHARED_MEMORY = HResult(MAKE_D3DSTATUS_R or 2166); - {$EXTERNALSYM S_RESIDENT_IN_SHARED_MEMORY} - S_PRESENT_MODE_CHANGED = HResult(MAKE_D3DSTATUS_R or 2167); - {$EXTERNALSYM S_PRESENT_MODE_CHANGED} - S_PRESENT_OCCLUDED = HResult(MAKE_D3DSTATUS_R or 2168); - {$EXTERNALSYM S_PRESENT_OCCLUDED} - D3DERR_DEVICEHUNG = HResult(MAKE_D3DHRESULT_R or 2164); - {$EXTERNALSYM D3DERR_DEVICEHUNG} -{$ENDIF} - - - -(* - * DLL Function for creating a Direct3D9 object. This object supports - * enumeration and allows the creation of Direct3DDevice9 objects. - * Pass the value of the constant D3D_SDK_VERSION to this function, so - * that the run-time can validate that your application was compiled - * against the right headers. - *) - - -function Direct3D9Loaded: Boolean; -function LoadDirect3D9: Boolean; -function UnLoadDirect3D9: Boolean; - -const - Direct3D9dll = 'd3d9.dll'; - -// Due to the way Object Pascal handles functions resulting in 'native' interface -// pointer we should declare result not as interface but as usial pointer - -{$IFDEF DIRECT3D9_DYNAMIC_LINK} -type - TDirect3DCreate9 = function (SDKVersion: LongWord): Pointer; stdcall; - {$IFDEF DIRECT3D_VERSION_9_VISTA} - TDirect3DCreate9Ex = function (SDKVersion: LongWord; out d3d9ex: IDirect3D9Ex): HRESULT; stdcall; - {$ENDIF} - -var - _Direct3DCreate9: TDirect3DCreate9 = nil; - {$IFDEF DIRECT3D_VERSION_9_VISTA} - Direct3DCreate9Ex: TDirect3DCreate9Ex = nil; - {$ENDIF} - -{$ELSE} -function _Direct3DCreate9(SDKVersion: LongWord): Pointer; stdcall; -{$ENDIF} - -function Direct3DCreate9(SDKVersion: LongWord): IDirect3D9; stdcall; -{$EXTERNALSYM Direct3DCreate9} -{$IFNDEF DIRECT3D9_DYNAMIC_LINK} -{$IFDEF DIRECT3D_VERSION_9_VISTA} -function Direct3DCreate9Ex(SDKVersion: LongWord; out d3d9ex: IDirect3D9Ex): HRESULT; stdcall; -{$EXTERNALSYM Direct3DCreate9Ex} -{$ENDIF} -{$ENDIF} - -(* - * Stubs for graphics profiling. - *) - -function D3DPERF_BeginEvent(col: TD3DColor; wszName: PWideChar): Integer; stdcall; external Direct3D9dll; -{$EXTERNALSYM D3DPERF_BeginEvent} -function D3DPERF_EndEvent: Integer; stdcall; external Direct3D9dll; -{$EXTERNALSYM D3DPERF_EndEvent} -procedure D3DPERF_SetMarker(col: TD3DColor; wszName: PWideChar); stdcall; external Direct3D9dll; -{$EXTERNALSYM D3DPERF_SetMarker} -procedure D3DPERF_SetRegion(col: TD3DColor; wszName: PWideChar); stdcall; external Direct3D9dll; -{$EXTERNALSYM D3DPERF_SetRegion} -function D3DPERF_QueryRepeatFrame: BOOL; stdcall; external Direct3D9dll; -{$EXTERNALSYM D3DPERF_QueryRepeatFrame} - -procedure D3DPERF_SetOptions(dwOptions: DWORD); stdcall; external Direct3D9dll; -{$EXTERNALSYM D3DPERF_SetOptions} -function D3DPERF_GetStatus: DWORD; stdcall; external Direct3D9dll; -{$EXTERNALSYM D3DPERF_GetStatus} - - -//******************************************************************** -// Introduced types for compatibility with non-Borland compliant translation -// by Ampaze (Tim Baumgarten) from http://www.crazyentertainment.net -type - PD3DAdapter_Identifier9 = PD3DAdapterIdentifier9; - PD3DDevice_Creation_Parameters = PD3DDeviceCreationParameters; - PD3DDevInfo_D3DVertexStats = PD3DDevInfoD3DVertexStats; - PD3DDevInfo_ResourceManager = PD3DDevInfoResourceManager; - PD3DDevInfo_VCache = PD3DDevInfoVCache; - PD3DIndexBuffer_Desc = PD3DIndexBufferDesc; - PD3DLocked_Box = PD3DLockedBox; - PD3DLocked_Rect = PD3DLockedRect; - PD3DPresent_Parameters = PD3DPresentParameters; - PD3DRaster_Status = PD3DRasterStatus; - PD3DRectPatch_Info = PD3DRectPatchInfo; - PD3DSurface_Desc = PD3DSurfaceDesc; - PD3DTriPatch_Info = PD3DTriPatchInfo; - PD3DVertexBuffer_Desc = PD3DVertexBufferDesc; - PD3DVolume_Desc = PD3DVolumeDesc; - - TD3DAdapter_Identifier9 = TD3DAdapterIdentifier9; - TD3DBackBuffer_Type = TD3DBackBufferType; - TD3DCubeMap_Faces = TD3DCubeMapFaces; - TD3DDevice_Creation_Parameters = TD3DDeviceCreationParameters; - TD3DDevInfo_D3DVertexStats = TD3DDevInfoD3DVertexStats; - TD3DDevInfo_ResourceManager = TD3DDevInfoResourceManager; - TD3DDevInfo_VCache = TD3DDevInfoVCache; - TD3DIndexBuffer_Desc = TD3DIndexBufferDesc; - TD3DLocked_Box = TD3DLockedBox; - TD3DLocked_Rect = TD3DLockedRect; - TD3DMultiSample_Type = TD3DMultiSampleType; - TD3DPresent_Parameters = TD3DPresentParameters; - TD3DRaster_Status = TD3DRasterStatus; - TD3DRectPatch_Info = TD3DRectPatchInfo; - TD3DSampler_Texture_Type = TD3DSamplerTextureType; - TD3DShader_AddressMode_Type = TD3DShaderAddressModeType; - TD3DShader_Comparison = TD3DShaderComparison; - TD3DShader_Instruction_Opcode_Type = TD3DShaderInstructionOpcodeType; - TD3DShader_MiscType_Offsets = TD3DShaderMiscTypeOffsets; - TD3DShader_Param_Register_Type = TD3DShaderParamRegisterType; - TD3DShader_Param_SRCMod_Type = TD3DShaderParamSRCModType; - TD3DSurface_Desc = TD3DSurfaceDesc; - TD3DTriPatch_Info = TD3DTriPatchInfo; - TD3DVertexBuffer_Desc = TD3DVertexBufferDesc; - TD3DVolume_Desc = TD3DVolumeDesc; - TD3DVS_AddressMode_Type = TD3DVSAddressModeType; - TD3DVS_RastOut_Offsets = TD3DVSRastOutOffsets; - - -implementation - -(*==========================================================================; - * File: d3d9types.h - * Content: Direct3D capabilities include file - ***************************************************************************) - -// #define D3DCOLOR_ARGB(a,r,g,b) \ -// ((D3DCOLOR)((((a)&0xff)<<24)|(((r)&0xff)<<16)|(((g)&0xff)<<8)|((b)&0xff))) -function D3DCOLOR_ARGB(a,r,g,b: DWord): TD3DColor; -begin - Result := (a shl 24) or (r shl 16) or (g shl 8) or b; -end; - -// #define D3DCOLOR_RGBA(r,g,b,a) D3DCOLOR_ARGB(a,r,g,b) -function D3DCOLOR_RGBA(r,g,b,a: DWord): TD3DColor; -begin - Result := (a shl 24) or (r shl 16) or (g shl 8) or b; -end; - -// #define D3DCOLOR_XRGB(r,g,b) D3DCOLOR_ARGB(0xff,r,g,b) -function D3DCOLOR_XRGB(r,g,b: DWord): TD3DColor; -begin - Result := DWORD($FF shl 24) or (r shl 16) or (g shl 8) or b; -end; - -// #define D3DCOLOR_XYUV(y,u,v) D3DCOLOR_ARGB(0xff,y,u,v) -function D3DCOLOR_XYUV(y,u,v: DWord): TD3DColor; -begin - Result := DWORD($FF shl 24) or (y shl 16) or (u shl 8) or v; -end; - -// #define D3DCOLOR_AYUV(a,y,u,v) D3DCOLOR_ARGB(a,y,u,v) -function D3DCOLOR_AYUV(a,y,u,v: DWord): TD3DColor; -begin - Result := (a shl 24) or (y shl 16) or (u shl 8) or v; -end; - -// #define D3DCOLOR_COLORVALUE(r,g,b,a) \ -// D3DCOLOR_RGBA((DWORD)((r)*255.f),(DWORD)((g)*255.f),(DWORD)((b)*255.f),(DWORD)((a)*255.f)) -function D3DCOLOR_COLORVALUE(r,g,b,a: Single): TD3DColor; -begin - Result := (round(a * 255) shl 24) or - (round(r * 255) shl 16) or - (round(g * 255) shl 8) or - (round(b * 255)); -end; - -// #define D3DTS_WORLDMATRIX(index) (D3DTRANSFORMSTATETYPE)(index + 256) -function D3DTS_WORLDMATRIX(index: Byte): TD3DTransformStateType; -begin - Result:= TD3DTransformStateType(index + 256); -end; - -//#define D3DPS_VERSION(_Major,_Minor) (0xFFFF0000|((_Major)<<8)|(_Minor)) -function D3DPS_VERSION(_Major, _Minor : Cardinal) : Cardinal; -begin - Result:= $FFFF0000 or (_Major shl 8 ) or _Minor; -end; - -//#define D3DVS_VERSION(_Major,_Minor) (0xFFFE0000|((_Major)<<8)|(_Minor)) -function D3DVS_VERSION(_Major, _Minor : Cardinal) : Cardinal; -begin - Result:= $FFFE0000 or (_Major shl 8 ) or _Minor; -end; - -//#define D3DSHADER_VERSION_MAJOR(_Version) (((_Version)>>8)&0xFF) -function D3DSHADER_VERSION_MAJOR(_Version : Cardinal) : Cardinal; -begin - Result:= (_Version shr 8 ) and $FF; -end; - -//#define D3DSHADER_VERSION_MINOR(_Version) (((_Version)>>0)&0xFF) -function D3DSHADER_VERSION_MINOR(_Version : Cardinal) : Cardinal; -begin - Result:= (_Version shr 0) and $FF; -end; - -//#define D3DSHADER_COMMENT(_DWordSize) \ -// ((((_DWordSize)<<D3DSI_COMMENTSIZE_SHIFT)&D3DSI_COMMENTSIZE_MASK)|D3DSIO_COMMENT) -function D3DSHADER_COMMENT(_DWordSize: DWord) : DWord; -begin - Result:= ((_DWordSize shl D3DSI_COMMENTSIZE_SHIFT) and D3DSI_COMMENTSIZE_MASK) or D3DSIO_COMMENT; -end; - -//#define D3DFVF_TEXCOORDSIZE3(CoordIndex) (D3DFVF_TEXTUREFORMAT3 << (CoordIndex*2 + 16)) -function D3DFVF_TEXCOORDSIZE3(CoordIndex: DWord): DWord; -begin - Result:= D3DFVF_TEXTUREFORMAT3 shl (CoordIndex * 2 + 16) -end; - -//#define D3DFVF_TEXCOORDSIZE2(CoordIndex) (D3DFVF_TEXTUREFORMAT2) -function D3DFVF_TEXCOORDSIZE2(CoordIndex: DWord): DWord; -begin - Result:= D3DFVF_TEXTUREFORMAT2; -end; - -//#define D3DFVF_TEXCOORDSIZE4(CoordIndex) (D3DFVF_TEXTUREFORMAT4 << (CoordIndex*2 + 16)) -function D3DFVF_TEXCOORDSIZE4(CoordIndex: DWord): DWord; -begin - Result:= D3DFVF_TEXTUREFORMAT4 shl (CoordIndex * 2 + 16) -end; - -//#define D3DFVF_TEXCOORDSIZE1(CoordIndex) (D3DFVF_TEXTUREFORMAT1 << (CoordIndex*2 + 16)) -function D3DFVF_TEXCOORDSIZE1(CoordIndex: DWord): DWord; -begin - Result:= D3DFVF_TEXTUREFORMAT1 shl (CoordIndex * 2 + 16) -end; - -// #define MAKEFOURCC(ch0, ch1, ch2, ch3) \ -// ((DWORD)(BYTE)(ch0) | ((DWORD)(BYTE)(ch1) << 8) | \ -// ((DWORD)(BYTE)(ch2) << 16) | ((DWORD)(BYTE)(ch3) << 24 )) -function MAKEFOURCC(ch0, ch1, ch2, ch3: AnsiChar): DWord; -begin - Result:= Byte(ch0) or (Byte(ch1) shl 8) or (Byte(ch2) shl 16) or (Byte(ch3) shl 24 ); -end; - -(*==========================================================================; - * File: d3d9.h - * Content: Direct3D include file - ****************************************************************************) - -//#define MAKE_D3DHRESULT( code ) MAKE_HRESULT( 1, _FACD3D, code ) -function MAKE_D3DHRESULT(Code: DWord): DWord; -begin - Result:= DWord((1 shl 31) or (_FACD3D shl 16)) or Code; -end; - -//#define MAKE_D3DSTATUS( code ) MAKE_HRESULT( 0, _FACD3D, code ) -function MAKE_D3DSTATUS(Code: DWord): DWord; -begin - Result:= DWord((0 shl 31) or (_FACD3D shl 16)) or Code; -end; - -{$IFDEF DIRECT3D9_DYNAMIC_LINK} -var - Direct3D9Lib: THandle = 0; - -function Direct3D9Loaded: Boolean; -begin - Result:= Direct3D9Lib <> 0; -end; - -function UnLoadDirect3D9: Boolean; -begin - Result:= True; - if Direct3D9Loaded then - begin - Result:= FreeLibrary(Direct3D9Lib); - _Direct3DCreate9:= nil; - Direct3D9Lib:= 0; - end; -end; - -function LoadDirect3D9: Boolean; -const - ProcName = 'Direct3DCreate9'; - ProcNameEx = 'Direct3DCreate9Ex'; -begin - Result:= Direct3D9Loaded; - if (not Result) then - begin - Direct3D9Lib:= LoadLibrary(Direct3D9dll); - if Direct3D9Loaded then - begin - _Direct3DCreate9:= GetProcAddress(Direct3D9Lib, ProcName); - Result:= Assigned(_Direct3DCreate9); - if not Result then UnLoadDirect3D9; - {$IFDEF DIRECT3D_VERSION_9_VISTA} - - Direct3DCreate9Ex:= GetProcAddress(Direct3D9Lib, ProcNameEx); - {$ENDIF} - end; - end; -end; -{$ELSE} -function Direct3D9Loaded: Boolean; -begin // Stub function for static linking - Result:= True; -end; - -function UnLoadDirect3D9: Boolean; -begin // Stub function for static linking - Result:= True; // should emulate "normal" behaviour -end; - -function LoadDirect3D9: Boolean; -begin // Stub function for static linking - Result:= True; -end; - -function _Direct3DCreate9(SDKVersion: LongWord): Pointer; external Direct3D9dll name 'Direct3DCreate9'; -{$IFDEF DIRECT3D_VERSION_9_VISTA} -function Direct3DCreate9Ex(SDKVersion: LongWord; out d3d9ex: IDirect3D9Ex): HRESULT; stdcall; external Direct3D9dll; -{$ENDIF} -{$ENDIF} - -function Direct3DCreate9(SDKVersion: LongWord): IDirect3D9; stdcall; -begin -{$IFDEF DIRECT3D9_DYNAMIC_LINK} -{$IFDEF DIRECT3D9_DYNAMIC_LINK_EXPLICIT} - LoadDirect3D9; - -{$ENDIF} -{$ENDIF} - Result:= IDirect3D9(_Direct3DCreate9(SDKVersion)); - if Assigned(Result) then Result._Release; // Delphi autoincrement reference count -end; - -{$IFDEF DIRECT3D9_DYNAMIC_LINK} -initialization -{$IFNDEF DIRECT3D9_DYNAMIC_LINK_EXPLICIT} - LoadDirect3D9; -{$ENDIF} -finalization - UnLoadDirect3D9; -{$ENDIF} -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/DirectX.inc b/components/vampireimaging/Demos/ObjectPascal/Common/DirectX.inc deleted file mode 100644 index 9e20bbd..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/DirectX.inc +++ /dev/null @@ -1,133 +0,0 @@ -{******************************************************************************} -{ } -{ The contents of this file are subject to the Mozilla Public License Version } -{ 1.1 (the "License"); you may not use this file except in compliance with the } -{ License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, } -{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for } -{ the specific language governing rights and limitations under the License. } -{ } -{ The Original Code is DirectX.inc. } -{ } -{******************************************************************************} -{$IFNDEF __TMT__} -{$IFNDEF FPC} - - // *** Borland compilers support *** - {$INCLUDE Jedi.inc} - - {$DEFINE BORLAND} - {$DEFINE TYPE_IDENTITY} - {$DEFINE SUPPORTS_EXCEPTIONS} - {$IFDEF COMPILER6_UP} - {$DEFINE SUPPORTS_EXPL_ENUMS} // Enumerated types with explicitly assigned ordinality - {$IFNDEF BCB6_UP} - // C++Builder6 hack: Delphi 6-7 compilers have bugged .HPP generation for - // enums in some cases (and D6 compiler is included with BCB6) - {$DEFINE SUPPORTS_EXPL_ENUMS_except_BCB6} - {$ENDIF} - {$ENDIF} - - // Additional settings - {$BOOLEVAL OFF} - {$MINENUMSIZE 4} - {$ALIGN ON} - - {$IFDEF COMPILER7_UP} - {$WARN UNSAFE_CODE OFF} - {$WARN UNSAFE_TYPE OFF} - {$WARN UNSAFE_CAST OFF} - {$ENDIF} - - {$IFDEF COMPILER9_UP} - {$IFDEF DEBUG} - {$INLINE OFF} - {$ELSE} - {$INLINE ON} - {$ENDIF} - {$ENDIF} -{$ELSE} - - // *** FreePascal compiler support *** - {$INCLUDE Jedi.inc} - - {$APPTYPE GUI} - - // Additional settings - {$H+} // Long Strings - {$BOOLEVAL OFF} - {$MINENUMSIZE 4} - {$ALIGN ON} - {$PACKRECORDS 8} - {$INLINE ON} - - {$UNDEF TYPE_IDENTITY} - {$DEFINE SUPPORTS_EXCEPTIONS} - {$DEFINE SUPPORTS_INLINE} - {$DEFINE COMPILER5_UP} // Specially for DirectDraw.pas - -{$ENDIF} -{$ELSE} - // *** TMT Pascal compiler support *** - {.$I TMT.inc} - - // TMT compiler support - {$IFNDEF __TMT__} - TMT pascal compiler required here - {$ENDIF} - - // ADD IFOPT for TMT - - {$DEFINE TMT} - - {$IFDEF __WIN32__} - {$DEFINE WIN32} - {$ENDIF} - - {$IFDEF __VER5__} - {$DEFINE TMT5} - {$DEFINE TMT5_UP} - {$DEFINE TMT4_UP} - {$DEFINE TMT3_UP} - {$ENDIF} - - {$IFDEF __VER4__} - {$DEFINE TMT4} - {$DEFINE TMT4_UP} - {$DEFINE TMT3_UP} - {$ENDIF} - - {$IFDEF __VER3__} - {$DEFINE TMT3} - {$DEFINE TMT3_UP} - {$ENDIF} - - {$IFDEF TMT4_UP} - {$DEFINE SUPPORTS_INTERFACE} - {$ENDIF} - - // Additional settings - {$A+} // Word alignment data - {$OA+} // Objects and structures align - {$Z4} // Set minimum size of enumerated type to 4 -{$ENDIF} - - -// By default use most recent DirectX sub-version - -{$IFNDEF DX81} - {$IFNDEF DX80} - {$DEFINE DX81} - {$ENDIF} -{$ENDIF} - - -{$IFNDEF DX92} - {$IFNDEF DX91} - {$IFNDEF DX90} - {$DEFINE DX92} - {$ENDIF} - {$ENDIF} -{$ENDIF} - diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/MainIcon.res b/components/vampireimaging/Demos/ObjectPascal/Common/MainIcon.res deleted file mode 100644 index e4dabb7..0000000 Binary files a/components/vampireimaging/Demos/ObjectPascal/Common/MainIcon.res and /dev/null differ diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/dglOpenGL.pas b/components/vampireimaging/Demos/ObjectPascal/Common/dglOpenGL.pas deleted file mode 100644 index 1720c10..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/dglOpenGL.pas +++ /dev/null @@ -1,20003 +0,0 @@ -{ ============================================================================ - - OpenGL 4.3 - Headertranslation - Version 4.3 - Date : 08.08.2012 - - Supported environments and targets : - - (Win32) Delphi 4 and up - - (Win32, Win64) Delphi XE2 - - (Win32, Win64, Linux, MacOSX) FreePascal (1.9.3 and up) - -============================================================================== - - Containts the translations of glext.h, gl_1_1.h, glu.h and weglext.h. - It also contains some helperfunctions that were inspired by those - found in Mike Lischke's OpenGL12.pas. - - Copyright (C) DGL-OpenGL2-Portteam - All Rights Reserved - - Obtained through: - Delphi OpenGL Community(DGL) - www.delphigl.com - - Converted and maintained by DGL's GL2.0-Team : - - Sascha Willems - http://www.saschawillems.de - - Steffen Xonna (Lossy eX) - http://www.dev-center.de - Additional input : - - Andrey Gruzdev (Mac OS X patch for XE2 / FPC) - - Lars Middendorf - - Martin Waldegger (Mars) - - Benjamin Rosseaux (BeRo) - http://www.0ok.de - Additional thanks: - sigsegv (libdl.so) - - -============================================================================== - You may retrieve the latest version of this file at the Delphi OpenGL - Community home page, located at http://www.delphigl.com/ - - The contents of this file are used with permission, subject to - the Mozilla Public License Version 1.1 (the "License"); you may - not use this file except in compliance with the License. You may - obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an - "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or - implied. See the License for the specific language governing - rights and limitations under the License. - -============================================================================== - History : - Version 1.0 Initial Release - Version 1.1 Added PPointer in Tpyessection for compatiblity with Delphi - versions lower than 7 (SW) - Added a function named RaiseLastOSError including a comment - on how to make it run under Delphi versions lower than 7 (SW) - Added some data types according to the GL-Syntax (SW) - Version 1.2 Fixed some problems with getting the addresses of some - Extensions (e.g. glTexImage3D) where the EXT/ARB did work - but not the core-functions (SW) - Version 1.3 A second call to ReadimplementationProperties won't - revert to the default libs anymore (MW) - Libraries now will be released if necessary (MW) - Version 1.3a Small fixes for glSlang-functions (SW) - Version 1.3b Fixed a small bug with GL_ARB_shader_objects, that lead - lead to that extension not loaded correctly (SW) - Version 1.3c more GL 1.5 compliance by FOG_COORD_xx and - ARB less VBO and occlusion query routines (MW) - Version 1.3d Fixed linebreaks (should now be corrected under D5) (SW) - Version 1.4 Changed header to correspond to the OpenGL-Shading - Language specification 1.10 : - - Added new GL_SAMPLER_*-Constants - - Added Constant GL_SHADING_LANGUAGE_VERSION_ARB - - Added Constant GL_FRAGMENT_SHADER_DERIVATIVE_HINT_ARB - - Added Constant GL_MAX_FRAGMENT_UNIFORM_COMPONENTS_ARB (SW) - Version 1.4a Fixed a missing stdcall for glBindAttribLocationARB (SW) - Version 1.4b Fixed declaration for glUniform*(f/i)vARB (added count) (MW) - glCompileShaderARB changed from function to procedure (MW) - Version 1.5 Added support for FreePascal (BR) - Added type TGLVectorf3/TGLVector3f (SW) - Version 1.6 Added Extension GL_EXT_framebuffer_object (SX) - Version 1.7 Added Extension GL_ARB_fragment_program_shadow (SX) - Added Extension GL_ARB_draw_buffers (SX) - Added Extension GL_ARB_texture_rectangle (SX) - Added Extension GL_ARB_color_buffer_float (SX) - Added Extension GL_ARB_half_float_pixel (SX) - Added Extension GL_ARB_texture_float (SX) - Added Extension GL_ARB_pixel_buffer_object (SX) - Added Extension GL_EXT_depth_bounds_test (SX) - Added Extension GL_EXT_texture_mirror_clamp (SX) - Added Extension GL_EXT_blend_equation_separate (SX) - Added Extension GL_EXT_pixel_buffer_object (SX) - Added Extension GL_EXT_texture_compression_dxt1 (SX) - Added Extension GL_NV_fragment_program_option (SX) - Added Extension GL_NV_fragment_program2 (SX) - Added Extension GL_NV_vertex_program2_option (SX) - Added Extension GL_NV_vertex_program3 (SX) - Version 1.8 Added explicit delegate type definitions (LM) - Added .Net 1.1 Support (LM) - Added .Net overloaded functions (LM) - Added delayed extension loading and stubs (LM) - Added automatic InitOpenGL call in CreateRenderingContext(LM) - Added extra Read_* function (LM) - Version 2.0 fixed some Problem with version string and damn drivers. - String 1.15 identified as OpenGL 1.5 not as OpenGL 1.1 (SX) - Removed unexisting extension GL_ARB_texture_mirror_repeat(SX) - Added Extension WGL_ARB_pixel_format_float (SX) - Added Extension GL_EXT_stencil_clear_tag (SX) - Added Extension GL_EXT_texture_rectangle (SX) - Added Extension GL_EXT_texture_edge_clamp (SX) - Some 1.5 Core Consts added (now completed) (SX) - gluProject need pointer for not .net (SX) - gluUnProject need pointer for not .net (SX) - wglUseFontOutlines* need pointer for not .net (SX) - wglSwapMultipleBuffers need pointer for not .net (SX) - Bug with wglGetExtensionsStringEXT removed - different type for .net (SX) - Added OpenGL 2.0 Core (SX) - Version 2.0.1 fixed some problems with glGetActiveAttrib in 2.0 Core (SX) - fixes some problems with gluProject (SX) - fixes some problems with gluUnProject (SX) - fixes some problems with gluTessVertex (SX) - fixes some problems with gluLoadSamplingMatrices (SX) - Version 2.1 Removed .NET Support (SX) - Better support for Linux (SX) - Better Codeformation (SX) - Added some more Vector/Matrix types (SX) - Added OpenGL 2.1 Core (SX) - Added Extension GL_EXT_packed_depth_stencil (SX) - Added Extension GL_EXT_texture_sRGB (SX) - Added Extension GL_EXT_framebuffer_blit (SX) - Added Extension GL_EXT_framebuffer_multisample (SX) - Added Extension GL_EXT_timer_query (SX) - Added Extension GL_EXT_gpu_program_parameters (SX) - Added Extension GL_EXT_bindable_uniform (SX) - Added Extension GL_EXT_draw_buffers2 (SX) - Added Extension GL_EXT_draw_instanced (SX) - Added Extension GL_EXT_framebuffer_sRGB (SX) - Added Extension GL_EXT_geometry_shader4 (SX) - Added Extension GL_EXT_gpu_shader4 (SX) - Added Extension GL_EXT_packed_float (SX) - Added Extension GL_EXT_texture_array (SX) - Added Extension GL_EXT_texture_buffer_object (SX) - Added Extension GL_EXT_texture_compression_latc (SX) - Added Extension GL_EXT_texture_compression_rgtc (SX) - Added Extension GL_EXT_texture_integer (SX) - Added Extension GL_EXT_texture_shared_exponent (SX) - Added Extension GL_NV_depth_buffer_float (SX) - Added Extension GL_NV_fragment_program4 (SX) - Added Extension GL_NV_framebuffer_multisample_coverage (SX) - Added Extension GL_NV_geometry_program4 (SX) - Added Extension GL_NV_gpu_program4 (SX) - Added Extension GL_NV_parameter_buffer_object (SX) - Added Extension GL_NV_transform_feedback (SX) - Added Extension GL_NV_vertex_program4 (SX) - Version 3.0 fixed some const of GL_EXT_texture_shared_exponent (SX) - possible better support for mac (SX) - Added OpenGL 3.0 Core (SX) - Added Extension GL_ARB_depth_buffer_float (SX) - Added Extension GL_ARB_draw_instanced (SX) - Added Extension GL_ARB_framebuffer_object (SX) - Added Extension GL_ARB_framebuffer_sRGB (SX) - Added Extension GL_ARB_geometry_shader4 (SX) - Added Extension GL_ARB_half_float_vertex (SX) - Added Extension GL_ARB_instanced_arrays (SX) - Added Extension GL_ARB_map_buffer_range (SX) - Added Extension GL_ARB_texture_buffer_object (SX) - Added Extension GL_ARB_texture_compression_rgtc (SX) - Added Extension GL_ARB_texture_rg (SX) - Added Extension GL_ARB_vertex_array_object (SX) - Added Extension GL_NV_conditional_render (SX) - Added Extension GL_NV_present_video (SX) - Added Extension GL_EXT_transform_feedback (SX) - Added Extension GL_EXT_direct_state_access (SX) - Added Extension GL_EXT_vertex_array_bgra (SX) - Added Extension GL_EXT_texture_swizzle (SX) - Added Extension GL_NV_explicit_multisample (SX) - Added Extension GL_NV_transform_feedback2 (SX) - Added Extension WGL_ARB_create_context (SX) - Added Extension WGL_NV_present_video (SX) - Added Extension WGL_NV_video_out (SX) - Added Extension WGL_NV_swap_group (SX) - Added Extension WGL_NV_gpu_affinity (SX) - Added define DGL_TINY_HEADER to suppress automatic - function loading (SX) - glProcedure renamed to dglGetProcAddress and now it's - visible from outside the unit to custom load functions (SX) - dglCheckExtension added to check if an extension exists (SX) - Read_GL_ARB_buffer_object renamed to - Read_GL_ARB_vertex_buffer_object (SX) - Version 3.0.1 fixed an problem with fpc (SX) - Version 3.0.2 fixed an problem with WGL_ARB_create_context (SX) - Version 3.2 Functions from GL_VERSION_3_0 where updated (SX) - Functions from GL_ARB_map_buffer_range where updated (SX) - Functions from GL_NV_present_video where added (SX) - Added consts of GL_ARB_instanced_arrays (SX) - Defines to identify Delphi was changed (prevent for - feature maintenance) (SX) - Added Extension GL_ATI_meminfo (SX) - Added Extension GL_AMD_performance_monitor (SX) - Added Extension GL_AMD_texture_texture4 (SX) - Added Extension GL_AMD_vertex_shader_tesselator (SX) - Added Extension GL_EXT_provoking_vertex (SX) - Added Extension WGL_AMD_gpu_association (SX) - Added OpenGL 3.1 Core (SX) - All deprecated stuff can be disabled if you undef the - define DGL_DEPRECATED (SX) - Added Extension GL_ARB_uniform_buffer_object (SX) - Added Extension GL_ARB_compatibility (SX) - Added Extension GL_ARB_copy_buffer (SX) - Added Extension GL_ARB_shader_texture_lod (SX) - Remove function from GL_NV_present_video (SX) - Added Extension WGL_3DL_stereo_control (SX) - Added Extension GL_EXT_texture_snorm (SX) - Added Extension GL_AMD_draw_buffers_blend (SX) - Added Extension GL_APPLE_texture_range (SX) - Added Extension GL_APPLE_float_pixels (SX) - Added Extension GL_APPLE_vertex_program_evaluators (SX) - Added Extension GL_APPLE_aux_depth_stencil (SX) - Added Extension GL_APPLE_object_purgeable (SX) - Added Extension GL_APPLE_row_bytes (SX) - Added OpenGL 3.2 Core (SX) - Added Extension GL_ARB_depth_clamp (SX) - Added Extension GL_ARB_draw_elements_base_vertex (SX) - Added Extension GL_ARB_fragment_coord_conventions (SX) - Added Extension GL_ARB_provoking_vertex (SX) - Added Extension GL_ARB_seamless_cube_map (SX) - Added Extension GL_ARB_sync (SX) - Added Extension GL_ARB_texture_multisample (SX) - Added Extension GL_ARB_vertex_array_bgra (SX) - Added Extension GL_ARB_draw_buffers_blend (SX) - Added Extension GL_ARB_sample_shading (SX) - Added Extension GL_ARB_texture_cube_map_array (SX) - Added Extension GL_ARB_texture_gather (SX) - Added Extension GL_ARB_texture_query_lod (SX) - Added Extension WGL_ARB_create_context_profile (SX) - Added GLX Core up to Version 1.4 (SX) - Added Extension GLX_ARB_multisample (SX) - Added Extension GLX_ARB_fbconfig_float (SX) - Added Extension GLX_ARB_get_proc_address (SX) - Added Extension GLX_ARB_create_context (SX) - Added Extension GLX_ARB_create_context_profile (SX) - Added Extension GLX_EXT_visual_info (SX) - Added Extension GLX_EXT_visual_rating (SX) - Added Extension GLX_EXT_import_context (SX) - Added Extension GLX_EXT_fbconfig_packed_float (SX) - Added Extension GLX_EXT_framebuffer_sRGB (SX) - Added Extension GLX_EXT_texture_from_pixmap (SX) - Version 3.2.1 Fixed some problems with Delphi < 6 (SX) - Version 3.2.2 Added Extension GL_APPLE_rgb_422 (SX) - Added Extension GL_EXT_separate_shader_objects (SX) - Added Extension GL_NV_video_capture (SX) - Added Extension GL_NV_copy_image (SX) - Added Extension GL_NV_parameter_buffer_object2 (SX) - Added Extension GL_NV_shader_buffer_load (SX) - Added Extension GL_NV_vertex_buffer_unified_memory (SX) - Added Extension GL_NV_texture_barrier (SX) - Variable GL_EXT_texture_snorm will be filled (SX) - Variable GL_APPLE_row_bytes will be filled (SX) - Added Extension WGL_NV_video_capture (SX) - Added Extension WGL_NV_copy_image (SX) - WGL_NV_video_out now named WGL_NV_video_output (SX) - Added Extension GLX_EXT_swap_control (SX) - Version 3.2.3 Fixed an Problem with glGetAttribLocation (SX) - Added const GL_UNIFORM_BUFFER_EXT (SX) - Functions of GL_NV_texture_barrier now will be loaded (SX) - Version 4.0 Changes on Extension GL_ARB_texture_gather (SX) - Changes on Extension GL_NV_shader_buffer_load (SX) - Added OpenGL 3.3 Core (SX) - Added OpenGL 4.0 Core (SX) - Added Extension GL_AMD_shader_stencil_export (SX) - Added Extension GL_AMD_seamless_cubemap_per_texture (SX) - Added Extension GL_ARB_shading_language_include (SX) - Added Extension GL_ARB_texture_compression_bptc (SX) - Added Extension GL_ARB_blend_func_extended (SX) - Added Extension GL_ARB_explicit_attrib_location (SX) - Added Extension GL_ARB_occlusion_query2 (SX) - Added Extension GL_ARB_sampler_objects (SX) - Added Extension GL_ARB_shader_bit_encoding (SX) - Added Extension GL_ARB_texture_rgb10_a2ui (SX) - Added Extension GL_ARB_texture_swizzle (SX) - Added Extension GL_ARB_timer_query (SX) - Added Extension GL_ARB_vertex_type_2_10_10_10_rev (SX) - Added Extension GL_ARB_draw_indirect (SX) - Added Extension GL_ARB_gpu_shader5 (SX) - Added Extension GL_ARB_gpu_shader_fp64 (SX) - Added Extension GL_ARB_shader_subroutine (SX) - Added Extension GL_ARB_tessellation_shader (SX) - Added Extension GL_ARB_texture_buffer_object_rgb32 (SX) - Added Extension GL_ARB_transform_feedback2 (SX) - Added Extension GL_ARB_transform_feedback3 (SX) - Version 4.1 Possible fix some strange linux behavior (SX) - All function uses GL instead of TGL types (SX) - GL_AMD_vertex_shader_tesselator will be read now (SX) - GL_AMD_draw_buffers_blend will be read now (SX) - Changes on glStencilFuncSeparate (GL_2_0) (SX) - Changes on GL_VERSION_3_2 (SX) - Changes on GL_VERSION_3_3 (SX) - Changes on GL_VERSION_4_0 (SX) - Changes on GL_ARB_sample_shading (SX) - Changes on GL_ARB_texture_cube_map_array (SX) - Changes on GL_ARB_gpu_shader5 (SX) - Changes on GL_ARB_transform_feedback3 (SX) - Changes on GL_ARB_sampler_objects (SX) - Changes on GL_ARB_gpu_shader_fp64 (SX) - Changes on GL_APPLE_element_array (SX) - Changes on GL_APPLE_vertex_array_range (SX) - Changes on GL_NV_transform_feedback (SX) - Changes on GL_NV_vertex_buffer_unified_memory (SX) - Changes on GL_EXT_multi_draw_arrays (SX) - Changes on GL_EXT_direct_state_access (SX) - Changes on GL_AMD_performance_monitor (SX) - Changes on GL_AMD_seamless_cubemap_per_texture (SX) - Changes on GL_EXT_geometry_shader4 (SX) - Added OpenGL 4.1 Core (SX) - Added Extension GL_ARB_ES2_compatibility (SX) - Added Extension GL_ARB_get_program_binary (SX) - Added Extension GL_ARB_separate_shader_objects (SX) - Added Extension GL_ARB_shader_precision (SX) - Added Extension GL_ARB_vertex_attrib_64bit (SX) - Added Extension GL_ARB_viewport_array (SX) - Added Extension GL_ARB_cl_event (SX) - Added Extension GL_ARB_debug_output (SX) - Added Extension GL_ARB_robustness (SX) - Added Extension GL_ARB_shader_stencil_export (SX) - Added Extension GL_AMD_conservative_depth (SX) - Added Extension GL_EXT_shader_image_load_store (SX) - Added Extension GL_EXT_vertex_attrib_64bit (SX) - Added Extension GL_NV_gpu_program5 (SX) - Added Extension GL_NV_gpu_shader5 (SX) - Added Extension GL_NV_shader_buffer_store (SX) - Added Extension GL_NV_tessellation_program5 (SX) - Added Extension GL_NV_vertex_attrib_integer_64bit (SX) - Added Extension GL_NV_multisample_coverage (SX) - Added Extension GL_AMD_name_gen_delete (SX) - Added Extension GL_AMD_debug_output (SX) - Added Extension GL_NV_vdpau_interop (SX) - Added Extension GL_AMD_transform_feedback3_lines_triangles (SX) - Added Extension GL_AMD_depth_clamp_separate (SX) - Added Extension GL_EXT_texture_sRGB_decode (SX) - Added Extension WGL_ARB_framebuffer_sRGB (SX) - Added Extension WGL_ARB_create_context_robustness (SX) - Added Extension WGL_EXT_create_context_es2_profile (SX) - Added Extension WGL_NV_multisample_coverage (SX) - Added Extension GLX_ARB_vertex_buffer_object (SX) - Added Extension GLX_ARB_framebuffer_sRGB (SX) - Added Extension GLX_ARB_create_context_robustness (SX) - Added Extension GLX_EXT_create_context_es2_profile (SX) - Version 4.1a Fix for dglGetProcAddress with FPC and linux (def param) (SW) - Version 4.2 Added OpenGL 4.2 Core (SW) - Added Extension GL_ARB_base_instance (SW) - Added Extension GL_ARB_shading_language_420pack (SW) - Added Extension GL_ARB_transform_feedback_instanced (SW) - Added Extension GL_ARB_compressed_texture_pixel_storage (SW) - Added Extension GL_ARB_conservative_depth (SW) - Added Extension GL_ARB_internalformat_query (SW) - Added Extension GL_ARB_map_buffer_alignment (SW) - Added Extension GL_ARB_shader_atomic_counters (SW) - Added Extension GL_ARB_shader_image_load_store (SW) - Added Extension GL_ARB_shading_language_packing (SW) - Added Extension GL_ARB_texture_storage (SW) - Added Extension WGL_NV_DX_interop (SW) - Added Define for WGL_EXT_create_context_es2_profile (SW) - Version 4.2a Added Mac OS X patch by Andrey Gruzdev (SW) - Version 4.3 Added OpenGL 4.3 Core (SW) - Added GL_ARB_arrays_of_arrays (SW) - Added GL_ARB_fragment_layer_viewport (SW) - Added GL_ARB_shader_image_size (SW) - Added GL_ARB_ES3_compatibility (SW) - Added GL_ARB_clear_buffer_object (SW) - Added GL_ARB_compute_shader (SW) - Added GL_ARB_copy_image (SW) - Added GL_KHR_debug (SW) - Added GL_ARB_explicit_uniform_location, (SW) - Added GL_ARB_framebuffer_no_attachments (SW) - Added GL_ARB_internalformat_query2 (SW) - Added GL_ARB_invalidate_subdata (SW) - Added GL_ARB_multi_draw_indirect (SW) - Added GL_ARB_program_interface_query (SW) - Added GL_ARB_robust_buffer_access_behavior (SW) - Added GL_ARB_shader_storage_buffer_object (SW) - Added GL_ARB_stencil_texturing (SW) - Added GL_ARB_texture_buffer_range (SW) - Added GL_ARB_texture_query_levels (SW) - Added GL_ARB_texture_storage_multisample (SW) - Added GL_ARB_texture_view (SW) - Added GL_ARB_vertex_attrib_binding (SW) - Added new vendor-specific extensions (SW) - Added GL_NV_path_rendering (SW) - Added GL_AMD_pinned_memory (SW) - Added GL_AMD_stencil_operation_extended (SW) - Added GL_AMD_vertex_shader_viewport_index (SW) - Added GL_AMD_vertex_shader_layer (SW) - Added GL_NV_bindless_texture (SW) - Added GL_NV_shader_atomic_float (SW) - Added GL_AMD_query_buffer_object (SW) - Added CreateRenderingContextVersion (SW) - - -============================================================================== - Header based on glext.h rev 83 (2012-08-06) - Header based on wglext.h rev 24 (2012/01/04) - Header based on glxext.h rev 33 (2012/02/29) (only Core/ARB/EXT) - - This is an important notice for maintaining. Dont remove it. And make sure - to keep it up to date -============================================================================== } - -{$define DGL_DEPRECATED} -{ - This define defines if the header should use deprecated ARB stuff or not. - per Default the Header use deprecated Stuff. -} - - -{.$define DGL_TINY_HEADER} -{ - If you enable the define DGL_TINY_HEADER no function automatically will be loaded if you - call ActivateRenderingContext. This may some bit faster and the smart linker can delete - all non used functions. This will reduce the filesize of your binary file. But in this - case you have to load the functions by yourself. There are two ways to do this. - - 1. You can load whole extension by calling the func Read_Extensionname. But if you do - this it's possible to load functions you dont use. So you have the same "problem" - like before. But it's only an bit smaler. - > Read_GL_ARB_multitexture; - - 2. You are able to load only the functions you exactly need. In this case you are able - to use the variables of the dglOpenGL.pas. So you only need to load the functions - and you can use the header like before. - To do this you have to created and activated an opengl context and than you can load - the needed functions. - > ActivateRenderingContext(fDC, fRC); - > glActiveTextureARB := dglGetProcAddress('glActiveTextureARB'); - > glMultiTexCoord2fARB := dglGetProcAddress('glMultiTexCoord2fARB'); - - So only the function "glActiveTextureARB" and "glMultiTexCoord2fARB" will be loaded. - - - Please notice that the extension variables won't be loaded if this define is active. But - you can call dglCheckExtension to check if any extension exists. You can assign them to - the variables of the dglOpenGL.pas so all code they use this will find them. - - > GL_ARB_shading_language_100 := dglCheckExtension('GL_ARB_shading_language_100'); -} - - -unit dglOpenGL; - -interface - -// defines to configure freepascal -{$IFDEF FPC} - {$MODE Delphi} - - {$IFNDEF WINDOWS} - {$LINKLIB c} - {$ENDIF} -{$ENDIF} - -// known delphi versions -{$IFNDEF FPC} // if freepascal isnt defined - {$IFDEF VER140} // Delphi 6 - {$DEFINE DELPHI6_AND_DOWN} - {$ENDIF} - - {$IFDEF VER130} // Delphi 5 - {$DEFINE DELPHI6_AND_DOWN} - {$ENDIF} - - {$IFDEF VER120} // Delphi 4 - {$DEFINE DELPHI6_AND_DOWN} - {$ENDIF} - - {$IFDEF VER110} // C++ Builder 3 - {$DEFINE DELPHI6_AND_DOWN} - {$ENDIF} - - {$IFDEF VER100} // Delphi 3 - {$DEFINE DELPHI6_AND_DOWN} - {$ENDIF} -{$ENDIF} - -// Options for Delphi < 5 -{$IFDEF DELPHI6_AND_DOWN} - {$A+} -{$ELSE} - {$A4} -{$ENDIF} - -// generell options -{$H+,O+,X+} - -// detecting Windows -{$IFDEF Win32} // Delphi and fpc of 32 Bit Windows - {$DEFINE DGL_WIN} -{$ENDIF} - -{$IFDEF Win64} // Delphi and fpc of 32 Bit Windows - {$DEFINE DGL_WIN} -{$ENDIF} - -// detecting Linux -{$IFDEF linux} // Linux - {$DEFINE DGL_LINUX} -{$ENDIF} - -{$IFDEF DARWIN} // Mac OS X and FPC - {$DEFINE DGL_MAC} -{$ENDIF} - -{$IFDEF DELPHI} // Mac OS X add Delphi -{$IFDEF MACOS} - {$DEFINE DGL_MAC} -{$ENDIF} -{$ENDIF} - - -// detecting 64 Bit CPU -{$IFDEF CPU64} // fpc on 64 bit cpus - {$DEFINE DGL_64BIT} // dgl define for 64 bit -{$ENDIF} - - - -uses - {$IFDEF FPC}{$IFDEF DARWIN}dynlibs,{$ENDIF}{$ENDIF} // LoadLibrary functions - SysUtils - {$IFDEF DGL_WIN}, Windows{$ENDIF} - {$IFDEF DGL_LINUX}, X, XLib, XUtil{$ENDIF} - ; - -type - // Needed for Delphi 6 and less (defined in system.pas for Delphi 7) - PPointer = ^Pointer; - PCardinal = ^Cardinal; - - GLenum = Cardinal; - GLboolean = BYTEBOOL; - GLbitfield = Cardinal; - GLbyte = Shortint; - GLshort = SmallInt; - GLint = Integer; - GLsizei = Integer; - GLubyte = Byte; - GLushort = Word; - GLuint = Cardinal; - GLfloat = Single; - GLclampf = Single; - GLdouble = Double; - GLclampd = Double; - GLvoid = Pointer; - GLint64 = Int64; - GLuint64 = {$IFDEF DELPHI6_AND_DOWN} Int64 {$ELSE} UInt64 {$ENDIF}; - - TGLenum = GLenum; - TGLboolean = GLboolean; - TGLbitfield = GLbitfield; - TGLbyte = GLbyte; - TGLshort = GLshort; - TGLint = GLint; - TGLsizei = GLsizei; - TGLubyte = GLubyte; - TGLushort = GLushort; - TGLuint = GLuint; - TGLfloat = GLfloat; - TGLclampf = GLclampf; - TGLdouble = GLdouble; - TGLclampd = GLclampd; - TGLvoid = GLvoid; - TGLint64 = GLint64; - TGLuint64 = GLuint64; - - PGLboolean = ^GLboolean; - PGLbyte = ^GLbyte; - PGLshort = ^GLshort; - PGLint = ^GLint; - PGLsizei = ^GLsizei; - PGLubyte = ^GLubyte; - PGLushort = ^GLushort; - PGLuint = ^GLuint; - PGLclampf = ^GLclampf; - PGLfloat = ^GLfloat; - PGLdouble = ^GLdouble; - PGLclampd = ^GLclampd; - PGLenum = ^GLenum; - PGLvoid = Pointer; - PPGLvoid = ^PGLvoid; - PGLint64 = ^GLint64; - PGLuint64 = ^GLuint64; - - // GL_NV_half_float - GLhalfNV = WORD; - TGLhalfNV = GLhalfNV; - PGLhalfNV = ^GLhalfNV; - - // GL_ARB_shader_objects - PGLHandleARB = ^GLHandleARB; - GLHandleARB = Integer; - GLcharARB = AnsiChar; - PGLcharARB = PAnsiChar; - PPGLcharARB = ^PGLcharARB; - - // GL_VERSION_1_5 - GLintptr = GLint; - GLsizeiptr = GLsizei; - - // GL_ARB_vertex_buffer_object - GLintptrARB = GLint; - GLsizeiptrARB = GLsizei; - - // GL_VERSION_2_0 - GLHandle = Integer; - PGLchar = PAnsiChar; - PPGLchar = ^PGLChar; - - // GL_EXT_timer_query - GLint64EXT = Int64; - TGLint64EXT = GLint64EXT; - PGLint64EXT = ^GLint64EXT; - - GLuint64EXT = GLuint64; - TGLuint64EXT = GLuint64EXT; - PGLuint64EXT = ^GLuint64EXT; - - // WGL_ARB_pbuffer - HPBUFFERARB = THandle; - - // WGL_EXT_pbuffer - HPBUFFEREXT = THandle; - - // WGL_NV_present_video - PHVIDEOOUTPUTDEVICENV = ^HVIDEOOUTPUTDEVICENV; - HVIDEOOUTPUTDEVICENV = THandle; - - // WGL_NV_video_output - PHPVIDEODEV = ^HPVIDEODEV; - HPVIDEODEV = THandle; - - // WGL_NV_gpu_affinity - PHPGPUNV = ^HPGPUNV; - PHGPUNV = ^HGPUNV; - - // WGL_NV_video_capture - HVIDEOINPUTDEVICENV = THandle; - PHVIDEOINPUTDEVICENV = ^HVIDEOINPUTDEVICENV; - - HPGPUNV = THandle; - HGPUNV = THandle; - - // GL_ARB_sync - GLsync = Pointer; - - // GL_ARB_cl_event - { These incomplete types let us declare types compatible with OpenCL's cl_context and cl_event } - _cl_context = record end; - _cl_event = record end; - p_cl_context = ^_cl_context; - p_cl_event = ^_cl_event; - - // GL_ARB_debug_output - TglDebugProcARB = procedure (source: GLenum; type_: GLenum; id: GLuint; severity: GLenum; length: GLsizei; const message_: PGLchar; userParam: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_debug_output - TglDebugProcAMD = procedure (id: GLuint; category: GLenum; severity: GLenum; length: GLsizei; const message_: PGLchar; userParam: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // (4.3) GL_KHR_debug - TglDebugProc = procedure(source : GLEnum; type_ : GLEnum; id : GLUInt; severity : GLUInt; length : GLsizei; const message_ : PGLCHar; userParam : PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_vdpau_interop - GLvdpauSurfaceNV = GLintptr; - PGLvdpauSurfaceNV = ^GLvdpauSurfaceNV; - - - // GLX - {$IFDEF DGL_LINUX} - GLXContext = Pointer; - GLXContextID = TXID; - GLXDrawable = TXID; - GLXFBConfig = Pointer; - GLXPbuffer = TXID; - GLXPixmap = TXID; - GLXWindow = TXID; - - Window = TXID; - Colormap = TXID; - Pixmap = TXID; - Font = TXID; - {$ENDIF} - - // Datatypes corresponding to GL's types TGL(name)(type)(count) - TGLVectorub2 = array[0..1] of GLubyte; - TGLVectori2 = array[0..1] of GLint; - TGLVectorf2 = array[0..1] of GLfloat; - TGLVectord2 = array[0..1] of GLdouble; - TGLVectorp2 = array[0..1] of Pointer; - - TGLVectorub3 = array[0..2] of GLubyte; - TGLVectori3 = array[0..2] of GLint; - TGLVectorf3 = array[0..2] of GLfloat; - TGLVectord3 = array[0..2] of GLdouble; - TGLVectorp3 = array[0..2] of Pointer; - - TGLVectorub4 = array[0..3] of GLubyte; - TGLVectori4 = array[0..3] of GLint; - TGLVectorf4 = array[0..3] of GLfloat; - TGLVectord4 = array[0..3] of GLdouble; - TGLVectorp4 = array[0..3] of Pointer; - - TGLArrayf4 = TGLVectorf4; - TGLArrayf3 = TGLVectorf3; - TGLArrayd3 = TGLVectord3; - TGLArrayi4 = TGLVectori4; - TGLArrayp4 = TGLVectorp4; - - TGlMatrixub3 = array[0..2, 0..2] of GLubyte; - TGlMatrixi3 = array[0..2, 0..2] of GLint; - TGLMatrixf3 = array[0..2, 0..2] of GLfloat; - TGLMatrixd3 = array[0..2, 0..2] of GLdouble; - - TGlMatrixub4 = array[0..3, 0..3] of GLubyte; - TGlMatrixi4 = array[0..3, 0..3] of GLint; - TGLMatrixf4 = array[0..3, 0..3] of GLfloat; - TGLMatrixd4 = array[0..3, 0..3] of GLdouble; - - TGLVector3f = TGLVectorf3; - - // Datatypes corresponding to OpenGL12.pas for easy porting - TVector3d = TGLVectord3; - - TVector4i = TGLVectori4; - TVector4f = TGLVectorf4; - TVector4p = TGLVectorp4; - - TMatrix4f = TGLMatrixf4; - TMatrix4d = TGLMatrixd4; - - PGLMatrixd4 = ^TGLMatrixd4; - PVector4i = ^TVector4i; - - - -{$IFDEF FPC} - TRect = packed record - Left, Top, Right, Bottom: Longint; - end; -{$ENDIF} - - - PGPU_DEVICE = ^GPU_DEVICE; - GPU_DEVICE = record - cb: DWORD; - DeviceName: array [0..31] of AnsiChar; - DeviceString: array [0..127] of AnsiChar; - Flags: DWORD; - rcVirtualScreen: TRect; - end; - - -type -{$IFDEF FPC} - {$IFDEF DGL_WIN} - PWGLSwap = ^TWGLSwap; - {$EXTERNALSYM _WGLSWAP} - _WGLSWAP = packed record - hdc: HDC; - uiFlags: UINT; - end; - - TWGLSwap = _WGLSWAP; - {$EXTERNALSYM WGLSWAP} - WGLSWAP = _WGLSWAP; - - {$ENDIF} -{$ENDIF} - - // GLU types - TGLUNurbs = record - end; - TGLUQuadric = record - end; - TGLUTesselator = record - end; - PGLUNurbs = ^TGLUNurbs; - PGLUQuadric = ^TGLUQuadric; - PGLUTesselator = ^TGLUTesselator; - // backwards compatibility - TGLUNurbsObj = TGLUNurbs; - TGLUQuadricObj = TGLUQuadric; - TGLUTesselatorObj = TGLUTesselator; - TGLUTriangulatorObj = TGLUTesselator; - PGLUNurbsObj = PGLUNurbs; - PGLUQuadricObj = PGLUQuadric; - PGLUTesselatorObj = PGLUTesselator; - PGLUTriangulatorObj = PGLUTesselator; - - // GLUQuadricCallback - TGLUQuadricErrorProc = procedure(errorCode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - // GLUTessCallback - TGLUTessBeginProc = procedure(AType: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessEdgeFlagProc = procedure(Flag: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessVertexProc = procedure(VertexData: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessEndProc = procedure; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessErrorProc = procedure(ErrNo: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessCombineProc = procedure(Coords: TGLArrayd3; VertexData: TGLArrayp4; Weight: TGLArrayf4; OutData: PPointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessBeginDataProc = procedure(AType: GLenum; UserData: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessEdgeFlagDataProc = procedure(Flag: GLboolean; UserData: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessVertexDataProc = procedure(VertexData: Pointer; UserData: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessEndDataProc = procedure(UserData: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessErrorDataProc = procedure(ErrNo: GLenum; UserData: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TGLUTessCombineDataProc = procedure(Coords: TGLArrayd3; VertexData: TGLArrayp4; Weight: TGLArrayf4; OutData: PPointer; UserData: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - // GLUNurbsCallback - TGLUNurbsErrorProc = procedure(ErrorCode: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - -var - GL_VERSION_1_0, - GL_VERSION_1_1, - GL_VERSION_1_2, - GL_VERSION_1_3, - GL_VERSION_1_4, - GL_VERSION_1_5, - GL_VERSION_2_0, - GL_VERSION_2_1, - GL_VERSION_3_0, - GL_VERSION_3_1, - GL_VERSION_3_2, - GL_VERSION_3_3, - GL_VERSION_4_0, - GL_VERSION_4_1, - GL_VERSION_4_2, - GL_VERSION_4_3, - GLU_VERSION_1_1, - GLU_VERSION_1_2, - GLU_VERSION_1_3, - GL_3DFX_multisample, - GL_3DFX_tbuffer, - GL_3DFX_texture_compression_FXT1, - GL_APPLE_client_storage, - GL_APPLE_element_array, - GL_APPLE_fence, - GL_APPLE_specular_vector, - GL_APPLE_transform_hint, - GL_APPLE_vertex_array_object, - GL_APPLE_vertex_array_range, - GL_APPLE_ycbcr_422, - GL_APPLE_texture_range, - GL_APPLE_float_pixels, - GL_APPLE_vertex_program_evaluators, - GL_APPLE_aux_depth_stencil, - GL_APPLE_object_purgeable, - GL_APPLE_row_bytes, - GL_APPLE_rgb_422, - GL_ARB_depth_texture, - GL_ARB_fragment_program, - GL_ARB_imaging, - GL_ARB_matrix_palette, - GL_ARB_multisample, - GL_ARB_multitexture, - GL_ARB_point_parameters, - GL_ARB_shadow, - GL_ARB_shadow_ambient, - GL_ARB_texture_border_clamp, - GL_ARB_texture_compression, - GL_ARB_texture_cube_map, - GL_ARB_texture_env_add, - GL_ARB_texture_env_combine, - GL_ARB_texture_env_crossbar, - GL_ARB_texture_env_dot3, - GL_ARB_texture_mirrored_repeat, - GL_ARB_transpose_matrix, - GL_ARB_vertex_blend, - GL_ARB_vertex_buffer_object, - GL_ARB_vertex_program, - GL_ARB_window_pos, - GL_ARB_shader_objects, - GL_ARB_vertex_shader, - GL_ARB_fragment_shader, - GL_ARB_shading_language_100, - GL_ARB_occlusion_query, - GL_ARB_texture_non_power_of_two, - GL_ARB_point_sprite, - GL_ARB_fragment_program_shadow, - GL_ARB_draw_buffers, - GL_ARB_texture_rectangle, - GL_ARB_color_buffer_float, - GL_ARB_half_float_pixel, - GL_ARB_texture_float, - GL_ARB_pixel_buffer_object, - GL_ARB_depth_buffer_float, - GL_ARB_draw_instanced, - GL_ARB_framebuffer_object, - GL_ARB_framebuffer_sRGB, - GL_ARB_geometry_shader4, - GL_ARB_half_float_vertex, - GL_ARB_instanced_arrays, - GL_ARB_map_buffer_range, - GL_ARB_texture_buffer_object, - GL_ARB_texture_compression_rgtc, - GL_ARB_texture_rg, - GL_ARB_vertex_array_object, - GL_ARB_uniform_buffer_object, - GL_ARB_compatibility, - GL_ARB_copy_buffer, - GL_ARB_shader_texture_lod, - GL_ARB_depth_clamp, - GL_ARB_draw_elements_base_vertex, - GL_ARB_fragment_coord_conventions, - GL_ARB_provoking_vertex, - GL_ARB_seamless_cube_map, - GL_ARB_sync, - GL_ARB_texture_multisample, - GL_ARB_vertex_array_bgra, - GL_ARB_draw_buffers_blend, - GL_ARB_sample_shading, - GL_ARB_texture_cube_map_array, - GL_ARB_texture_gather, - GL_ARB_texture_query_lod, - GL_ARB_shading_language_include, - GL_ARB_texture_compression_bptc, - GL_ARB_blend_func_extended, - GL_ARB_explicit_attrib_location, - GL_ARB_occlusion_query2, - GL_ARB_sampler_objects, - GL_ARB_shader_bit_encoding, - GL_ARB_texture_rgb10_a2ui, - GL_ARB_texture_swizzle, - GL_ARB_timer_query, - GL_ARB_vertex_type_2_10_10_10_rev, - GL_ARB_draw_indirect, - GL_ARB_gpu_shader5, - GL_ARB_gpu_shader_fp64, - GL_ARB_shader_subroutine, - GL_ARB_tessellation_shader, - GL_ARB_texture_buffer_object_rgb32, - GL_ARB_transform_feedback2, - GL_ARB_transform_feedback3, - GL_ARB_ES2_compatibility, - GL_ARB_get_program_binary, - GL_ARB_separate_shader_objects, - GL_ARB_shader_precision, - GL_ARB_vertex_attrib_64bit, - GL_ARB_viewport_array, - // GL 4.2 - GL_ARB_base_instance, - GL_ARB_shading_language_420pack, - GL_ARB_transform_feedback_instanced, - GL_ARB_compressed_texture_pixel_storage, - GL_ARB_conservative_depth, - GL_ARB_internalformat_query, - GL_ARB_map_buffer_alignment, - GL_ARB_shader_atomic_counters, - GL_ARB_shader_image_load_store, - GL_ARB_shading_language_packing, - GL_ARB_texture_storage, - // GL 4.3 - GL_ARB_arrays_of_arrays, - GL_ARB_fragment_layer_viewport, - GL_ARB_shader_image_size, - GL_ARB_ES3_compatibility, - GL_ARB_clear_buffer_object, - GL_ARB_compute_shader, - GL_ARB_copy_image, - GL_KHR_debug, - GL_ARB_explicit_uniform_location, - GL_ARB_framebuffer_no_attachments, - GL_ARB_internalformat_query2, - GL_ARB_invalidate_subdata, - GL_ARB_multi_draw_indirect, - GL_ARB_program_interface_query, - GL_ARB_robust_buffer_access_behavior, - GL_ARB_shader_storage_buffer_object, - GL_ARB_stencil_texturing, - GL_ARB_texture_buffer_range, - GL_ARB_texture_query_levels, - GL_ARB_texture_storage_multisample, - GL_ARB_texture_view, - GL_ARB_vertex_attrib_binding, - // GL 4.3 vendor specific - GL_NV_path_rendering, - GL_AMD_pinned_memory, - GL_AMD_stencil_operation_extended, - GL_AMD_vertex_shader_viewport_index, - GL_AMD_vertex_shader_layer, - GL_NV_bindless_texture, - GL_NV_shader_atomic_float, - GL_AMD_query_buffer_object, - // - GL_ARB_cl_event, - GL_ARB_debug_output, - GL_ARB_robustness, - GL_ARB_shader_stencil_export, - GL_ATI_draw_buffers, - GL_ATI_element_array, - GL_ATI_envmap_bumpmap, - GL_ATI_fragment_shader, - GL_ATI_map_object_buffer, - GL_ATI_pn_triangles, - GL_ATI_separate_stencil, - GL_ATI_text_fragment_shader, - GL_ATI_texture_env_combine3, - GL_ATI_texture_float, - GL_ATI_texture_mirror_once, - GL_ATI_vertex_array_object, - GL_ATI_vertex_attrib_array_object, - GL_ATI_vertex_streams, - GL_ATI_meminfo, - GL_AMD_performance_monitor, - GL_AMD_texture_texture4, - GL_AMD_vertex_shader_tesselator, - GL_AMD_draw_buffers_blend, - GL_AMD_shader_stencil_export, - GL_AMD_seamless_cubemap_per_texture, - GL_AMD_conservative_depth, - GL_AMD_name_gen_delete, - GL_AMD_debug_output, - GL_AMD_transform_feedback3_lines_triangles, - GL_AMD_depth_clamp_separate, - GL_EXT_422_pixels, - GL_EXT_abgr, - GL_EXT_bgra, - GL_EXT_blend_color, - GL_EXT_blend_func_separate, - GL_EXT_blend_logic_op, - GL_EXT_blend_minmax, - GL_EXT_blend_subtract, - GL_EXT_clip_volume_hint, - GL_EXT_cmyka, - GL_EXT_color_matrix, - GL_EXT_color_subtable, - GL_EXT_compiled_vertex_array, - GL_EXT_convolution, - GL_EXT_coordinate_frame, - GL_EXT_copy_texture, - GL_EXT_cull_vertex, - GL_EXT_draw_range_elements, - GL_EXT_fog_coord, - GL_EXT_framebuffer_object, - GL_EXT_histogram, - GL_EXT_index_array_formats, - GL_EXT_index_func, - GL_EXT_index_material, - GL_EXT_index_texture, - GL_EXT_light_texture, - GL_EXT_misc_attribute, - GL_EXT_multi_draw_arrays, - GL_EXT_multisample, - GL_EXT_packed_pixels, - GL_EXT_paletted_texture, - GL_EXT_pixel_transform, - GL_EXT_pixel_transform_color_table, - GL_EXT_point_parameters, - GL_EXT_polygon_offset, - GL_EXT_rescale_normal, - GL_EXT_secondary_color, - GL_EXT_separate_specular_color, - GL_EXT_shadow_funcs, - GL_EXT_shared_texture_palette, - GL_EXT_stencil_two_side, - GL_EXT_stencil_wrap, - GL_EXT_subtexture, - GL_EXT_texture, - GL_EXT_texture3D, - GL_EXT_texture_compression_s3tc, - GL_EXT_texture_cube_map, - GL_EXT_texture_edge_clamp, - GL_EXT_texture_env_add, - GL_EXT_texture_env_combine, - GL_EXT_texture_env_dot3, - GL_EXT_texture_filter_anisotropic, - GL_EXT_texture_lod_bias, - GL_EXT_texture_object, - GL_EXT_texture_perturb_normal, - GL_EXT_texture_rectangle, - GL_EXT_vertex_array, - GL_EXT_vertex_shader, - GL_EXT_vertex_weighting, - GL_EXT_depth_bounds_test, - GL_EXT_texture_mirror_clamp, - GL_EXT_blend_equation_separate, - GL_EXT_pixel_buffer_object, - GL_EXT_texture_compression_dxt1, - GL_EXT_stencil_clear_tag, - GL_EXT_packed_depth_stencil, - GL_EXT_texture_sRGB, - GL_EXT_framebuffer_blit, - GL_EXT_framebuffer_multisample, - GL_EXT_timer_query, - GL_EXT_gpu_program_parameters, - GL_EXT_bindable_uniform, - GL_EXT_draw_buffers2, - GL_EXT_draw_instanced, - GL_EXT_framebuffer_sRGB, - GL_EXT_geometry_shader4, - GL_EXT_gpu_shader4, - GL_EXT_packed_float, - GL_EXT_texture_array, - GL_EXT_texture_buffer_object, - GL_EXT_texture_compression_latc, - GL_EXT_texture_compression_rgtc, - GL_EXT_texture_integer, - GL_EXT_texture_shared_exponent, - GL_EXT_transform_feedback, - GL_EXT_direct_state_access, - GL_EXT_vertex_array_bgra, - GL_EXT_texture_swizzle, - GL_EXT_provoking_vertex, - GL_EXT_texture_snorm, - GL_EXT_separate_shader_objects, - GL_EXT_shader_image_load_store, - GL_EXT_vertex_attrib_64bit, - GL_EXT_texture_sRGB_decode, - GL_FfdMaskSGIX, - GL_HP_convolution_border_modes, - GL_HP_image_transform, - GL_HP_occlusion_test, - GL_HP_texture_lighting, - GL_IBM_cull_vertex, - GL_IBM_multimode_draw_arrays, - GL_IBM_rasterpos_clip, - GL_IBM_texture_mirrored_repeat, - GL_IBM_vertex_array_lists, - GL_INGR_blend_func_separate, - GL_INGR_color_clamp, - GL_INGR_interlace_read, - GL_INGR_palette_buffer, - GL_INTEL_parallel_arrays, - GL_INTEL_texture_scissor, - GL_MESA_resize_buffers, - GL_MESA_window_pos, - GL_NV_blend_square, - GL_NV_copy_depth_to_color, - GL_NV_depth_clamp, - GL_NV_evaluators, - GL_NV_fence, - GL_NV_float_buffer, - GL_NV_fog_distance, - GL_NV_fragment_program, - GL_NV_half_float, - GL_NV_light_max_exponent, - GL_NV_multisample_filter_hint, - GL_NV_occlusion_query, - GL_NV_packed_depth_stencil, - GL_NV_pixel_data_range, - GL_NV_point_sprite, - GL_NV_primitive_restart, - GL_NV_register_combiners, - GL_NV_register_combiners2, - GL_NV_texgen_emboss, - GL_NV_texgen_reflection, - GL_NV_texture_compression_vtc, - GL_NV_texture_env_combine4, - GL_NV_texture_expand_normal, - GL_NV_texture_rectangle, - GL_NV_texture_shader, - GL_NV_texture_shader2, - GL_NV_texture_shader3, - GL_NV_vertex_array_range, - GL_NV_vertex_array_range2, - GL_NV_vertex_program, - GL_NV_vertex_program1_1, - GL_NV_vertex_program2, - GL_NV_fragment_program_option, - GL_NV_fragment_program2, - GL_NV_vertex_program2_option, - GL_NV_vertex_program3, - GL_NV_depth_buffer_float, - GL_NV_fragment_program4, - GL_NV_framebuffer_multisample_coverage, - GL_NV_geometry_program4, - GL_NV_gpu_program4, - GL_NV_parameter_buffer_object, - GL_NV_transform_feedback, - GL_NV_vertex_program4, - GL_NV_conditional_render, - GL_NV_present_video, - GL_NV_explicit_multisample, - GL_NV_transform_feedback2, - GL_NV_video_capture, - GL_NV_copy_image, - GL_NV_parameter_buffer_object2, - GL_NV_shader_buffer_load, - GL_NV_vertex_buffer_unified_memory, - GL_NV_gpu_program5, - GL_NV_gpu_shader5, - GL_NV_shader_buffer_store, - GL_NV_tessellation_program5, - GL_NV_vertex_attrib_integer_64bit, - GL_NV_multisample_coverage, - GL_NV_vdpau_interop, - GL_NV_texture_barrier, - GL_OML_interlace, - GL_OML_resample, - GL_OML_subsample, - GL_PGI_misc_hints, - GL_PGI_vertex_hints, - GL_REND_screen_coordinates, - GL_S3_s3tc, - GL_SGIS_detail_texture, - GL_SGIS_fog_function, - GL_SGIS_generate_mipmap, - GL_SGIS_multisample, - GL_SGIS_pixel_texture, - GL_SGIS_point_line_texgen, - GL_SGIS_point_parameters, - GL_SGIS_sharpen_texture, - GL_SGIS_texture4D, - GL_SGIS_texture_border_clamp, - GL_SGIS_texture_color_mask, - GL_SGIS_texture_edge_clamp, - GL_SGIS_texture_filter4, - GL_SGIS_texture_lod, - GL_SGIS_texture_select, - GL_SGIX_async, - GL_SGIX_async_histogram, - GL_SGIX_async_pixel, - GL_SGIX_blend_alpha_minmax, - GL_SGIX_calligraphic_fragment, - GL_SGIX_clipmap, - GL_SGIX_convolution_accuracy, - GL_SGIX_depth_pass_instrument, - GL_SGIX_depth_texture, - GL_SGIX_flush_raster, - GL_SGIX_fog_offset, - GL_SGIX_fog_scale, - GL_SGIX_fragment_lighting, - GL_SGIX_framezoom, - GL_SGIX_igloo_interface, - GL_SGIX_impact_pixel_texture, - GL_SGIX_instruments, - GL_SGIX_interlace, - GL_SGIX_ir_instrument1, - GL_SGIX_list_priority, - GL_SGIX_pixel_texture, - GL_SGIX_pixel_tiles, - GL_SGIX_polynomial_ffd, - GL_SGIX_reference_plane, - GL_SGIX_resample, - GL_SGIX_scalebias_hint, - GL_SGIX_shadow, - GL_SGIX_shadow_ambient, - GL_SGIX_sprite, - GL_SGIX_subsample, - GL_SGIX_tag_sample_buffer, - GL_SGIX_texture_add_env, - GL_SGIX_texture_coordinate_clamp, - GL_SGIX_texture_lod_bias, - GL_SGIX_texture_multi_buffer, - GL_SGIX_texture_scale_bias, - GL_SGIX_texture_select, - GL_SGIX_vertex_preclip, - GL_SGIX_ycrcb, - GL_SGIX_ycrcb_subsample, - GL_SGIX_ycrcba, - GL_SGI_color_matrix, - GL_SGI_color_table, - GL_SGI_depth_pass_instrument, - GL_SGI_texture_color_table, - GL_SUNX_constant_data, - GL_SUN_convolution_border_modes, - GL_SUN_global_alpha, - GL_SUN_mesh_array, - GL_SUN_slice_accum, - GL_SUN_triangle_list, - GL_SUN_vertex, - - GL_WIN_phong_shading, - GL_WIN_specular_fog, - WGL_3DFX_multisample, - WGL_ARB_buffer_region, - WGL_ARB_extensions_string, - WGL_ARB_make_current_read, - WGL_ARB_multisample, - WGL_ARB_pbuffer, - WGL_ARB_pixel_format, - WGL_ARB_pixel_format_float, - WGL_ARB_render_texture, - WGL_ARB_create_context, - WGL_ARB_create_context_profile, - WGL_ARB_framebuffer_sRGB, - WGL_ARB_create_context_robustness, - WGL_ATI_pixel_format_float, - WGL_AMD_gpu_association, - WGL_EXT_depth_float, - WGL_EXT_display_color_table, - WGL_EXT_extensions_string, - WGL_EXT_make_current_read, - WGL_EXT_multisample, - WGL_EXT_pbuffer, - WGL_EXT_pixel_format, - WGL_EXT_swap_control, - WGL_EXT_create_context_es2_profile, - WGL_I3D_digital_video_control, - WGL_I3D_gamma, - WGL_I3D_genlock, - WGL_I3D_image_buffer, - WGL_I3D_swap_frame_lock, - WGL_I3D_swap_frame_usage, - WGL_NV_float_buffer, - WGL_NV_render_depth_texture, - WGL_NV_render_texture_rectangle, - WGL_NV_vertex_array_range, - WGL_NV_present_video, - WGL_NV_video_output, - WGL_NV_swap_group, - WGL_NV_gpu_affinity, - WGL_NV_video_capture, - WGL_NV_copy_image, - WGL_NV_multisample_coverage, - WGL_NV_DX_interop, - WGL_OML_sync_control, - WGL_3DL_stereo_control, - WIN_draw_range_elements, - WIN_swap_hint, - -// GLX_VERSION_1_0, - GLX_VERSION_1_3, - GLX_VERSION_1_4, - GLX_ARB_multisample, - GLX_ARB_fbconfig_float, - GLX_ARB_get_proc_address, - GLX_ARB_create_context, - GLX_ARB_create_context_profile, - GLX_ARB_vertex_buffer_object, - GLX_ARB_framebuffer_sRGB, - GLX_ARB_create_context_robustness, - GLX_EXT_visual_info, - GLX_EXT_visual_rating, - GLX_EXT_import_context, - GLX_EXT_fbconfig_packed_float, - GLX_EXT_framebuffer_sRGB, - GLX_EXT_texture_from_pixmap, - GLX_EXT_swap_control, - GLX_EXT_create_context_es2_profile : Boolean; - -const - // GL_VERSION_1_1 - { AttribMask } - GL_DEPTH_BUFFER_BIT = $00000100; - GL_STENCIL_BUFFER_BIT = $00000400; - GL_COLOR_BUFFER_BIT = $00004000; - { Boolean } - GL_TRUE = 1; - GL_FALSE = 0; - { BeginMode } - GL_POINTS = $0000; - GL_LINES = $0001; - GL_LINE_LOOP = $0002; - GL_LINE_STRIP = $0003; - GL_TRIANGLES = $0004; - GL_TRIANGLE_STRIP = $0005; - GL_TRIANGLE_FAN = $0006; - { AlphaFunction } - GL_NEVER = $0200; - GL_LESS = $0201; - GL_EQUAL = $0202; - GL_LEQUAL = $0203; - GL_GREATER = $0204; - GL_NOTEQUAL = $0205; - GL_GEQUAL = $0206; - GL_ALWAYS = $0207; - { BlendingFactorDest } - GL_ZERO = 0; - GL_ONE = 1; - GL_SRC_COLOR = $0300; - GL_ONE_MINUS_SRC_COLOR = $0301; - GL_SRC_ALPHA = $0302; - GL_ONE_MINUS_SRC_ALPHA = $0303; - GL_DST_ALPHA = $0304; - GL_ONE_MINUS_DST_ALPHA = $0305; - { BlendingFactorSrc } - GL_DST_COLOR = $0306; - GL_ONE_MINUS_DST_COLOR = $0307; - GL_SRC_ALPHA_SATURATE = $0308; - { DrawBufferMode } - GL_NONE = 0; - GL_FRONT_LEFT = $0400; - GL_FRONT_RIGHT = $0401; - GL_BACK_LEFT = $0402; - GL_BACK_RIGHT = $0403; - GL_FRONT = $0404; - GL_BACK = $0405; - GL_LEFT = $0406; - GL_RIGHT = $0407; - GL_FRONT_AND_BACK = $0408; - { ErrorCode } - GL_NO_ERROR = 0; - GL_INVALID_ENUM = $0500; - GL_INVALID_VALUE = $0501; - GL_INVALID_OPERATION = $0502; - GL_OUT_OF_MEMORY = $0505; - { FrontFaceDirection } - GL_CW = $0900; - GL_CCW = $0901; - { GetPName } - GL_POINT_SIZE = $0B11; - GL_POINT_SIZE_RANGE = $0B12; - GL_POINT_SIZE_GRANULARITY = $0B13; - GL_LINE_SMOOTH = $0B20; - GL_LINE_WIDTH = $0B21; - GL_LINE_WIDTH_RANGE = $0B22; - GL_LINE_WIDTH_GRANULARITY = $0B23; - GL_POLYGON_SMOOTH = $0B41; - GL_CULL_FACE = $0B44; - GL_CULL_FACE_MODE = $0B45; - GL_FRONT_FACE = $0B46; - GL_DEPTH_RANGE = $0B70; - GL_DEPTH_TEST = $0B71; - GL_DEPTH_WRITEMASK = $0B72; - GL_DEPTH_CLEAR_VALUE = $0B73; - GL_DEPTH_FUNC = $0B74; - GL_STENCIL_TEST = $0B90; - GL_STENCIL_CLEAR_VALUE = $0B91; - GL_STENCIL_FUNC = $0B92; - GL_STENCIL_VALUE_MASK = $0B93; - GL_STENCIL_FAIL = $0B94; - GL_STENCIL_PASS_DEPTH_FAIL = $0B95; - GL_STENCIL_PASS_DEPTH_PASS = $0B96; - GL_STENCIL_REF = $0B97; - GL_STENCIL_WRITEMASK = $0B98; - GL_VIEWPORT = $0BA2; - GL_DITHER = $0BD0; - GL_BLEND_DST = $0BE0; - GL_BLEND_SRC = $0BE1; - GL_BLEND = $0BE2; - GL_LOGIC_OP_MODE = $0BF0; - GL_COLOR_LOGIC_OP = $0BF2; - GL_DRAW_BUFFER = $0C01; - GL_READ_BUFFER = $0C02; - GL_SCISSOR_BOX = $0C10; - GL_SCISSOR_TEST = $0C11; - GL_COLOR_CLEAR_VALUE = $0C22; - GL_COLOR_WRITEMASK = $0C23; - GL_DOUBLEBUFFER = $0C32; - GL_STEREO = $0C33; - GL_LINE_SMOOTH_HINT = $0C52; - GL_POLYGON_SMOOTH_HINT = $0C53; - GL_UNPACK_SWAP_BYTES = $0CF0; - GL_UNPACK_LSB_FIRST = $0CF1; - GL_UNPACK_ROW_LENGTH = $0CF2; - GL_UNPACK_SKIP_ROWS = $0CF3; - GL_UNPACK_SKIP_PIXELS = $0CF4; - GL_UNPACK_ALIGNMENT = $0CF5; - GL_PACK_SWAP_BYTES = $0D00; - GL_PACK_LSB_FIRST = $0D01; - GL_PACK_ROW_LENGTH = $0D02; - GL_PACK_SKIP_ROWS = $0D03; - GL_PACK_SKIP_PIXELS = $0D04; - GL_PACK_ALIGNMENT = $0D05; - GL_MAX_TEXTURE_SIZE = $0D33; - GL_MAX_VIEWPORT_DIMS = $0D3A; - GL_SUBPIXEL_BITS = $0D50; - GL_TEXTURE_1D = $0DE0; - GL_TEXTURE_2D = $0DE1; - GL_POLYGON_OFFSET_UNITS = $2A00; - GL_POLYGON_OFFSET_POINT = $2A01; - GL_POLYGON_OFFSET_LINE = $2A02; - GL_POLYGON_OFFSET_FILL = $8037; - GL_POLYGON_OFFSET_FACTOR = $8038; - GL_TEXTURE_BINDING_1D = $8068; - GL_TEXTURE_BINDING_2D = $8069; - { GetTextureParameter } - GL_TEXTURE_WIDTH = $1000; - GL_TEXTURE_HEIGHT = $1001; - GL_TEXTURE_INTERNAL_FORMAT = $1003; - GL_TEXTURE_BORDER_COLOR = $1004; - GL_TEXTURE_BORDER = $1005; - GL_TEXTURE_RED_SIZE = $805C; - GL_TEXTURE_GREEN_SIZE = $805D; - GL_TEXTURE_BLUE_SIZE = $805E; - GL_TEXTURE_ALPHA_SIZE = $805F; - { HintMode } - GL_DONT_CARE = $1100; - GL_FASTEST = $1101; - GL_NICEST = $1102; - { DataType } - GL_BYTE = $1400; - GL_UNSIGNED_BYTE = $1401; - GL_SHORT = $1402; - GL_UNSIGNED_SHORT = $1403; - GL_INT = $1404; - GL_UNSIGNED_INT = $1405; - GL_FLOAT = $1406; - GL_DOUBLE = $140A; - { LogicOp } - GL_CLEAR = $1500; - GL_AND = $1501; - GL_AND_REVERSE = $1502; - GL_COPY = $1503; - GL_AND_INVERTED = $1504; - GL_NOOP = $1505; - GL_XOR = $1506; - GL_OR = $1507; - GL_NOR = $1508; - GL_EQUIV = $1509; - GL_INVERT = $150A; - GL_OR_REVERSE = $150B; - GL_COPY_INVERTED = $150C; - GL_OR_INVERTED = $150D; - GL_NAND = $150E; - GL_SET = $150F; - { MatrixMode (for gl3.h, FBO attachment type) } - GL_TEXTURE = $1702; - { PixelCopyType } - GL_COLOR = $1800; - GL_DEPTH = $1801; - GL_STENCIL = $1802; - { PixelFormat } - GL_STENCIL_INDEX = $1901; - GL_DEPTH_COMPONENT = $1902; - GL_RED = $1903; - GL_GREEN = $1904; - GL_BLUE = $1905; - GL_ALPHA = $1906; - GL_RGB = $1907; - GL_RGBA = $1908; - { PolygonMode } - GL_POINT = $1B00; - GL_LINE = $1B01; - GL_FILL = $1B02; - { StencilOp } - GL_KEEP = $1E00; - GL_REPLACE = $1E01; - GL_INCR = $1E02; - GL_DECR = $1E03; - { StringName } - GL_VENDOR = $1F00; - GL_RENDERER = $1F01; - GL_VERSION = $1F02; - GL_EXTENSIONS = $1F03; - { TextureMagFilter } - GL_NEAREST = $2600; - GL_LINEAR = $2601; - { TextureMinFilter } - GL_NEAREST_MIPMAP_NEAREST = $2700; - GL_LINEAR_MIPMAP_NEAREST = $2701; - GL_NEAREST_MIPMAP_LINEAR = $2702; - GL_LINEAR_MIPMAP_LINEAR = $2703; - { TextureParameterName } - GL_TEXTURE_MAG_FILTER = $2800; - GL_TEXTURE_MIN_FILTER = $2801; - GL_TEXTURE_WRAP_S = $2802; - GL_TEXTURE_WRAP_T = $2803; - { TextureTarget } - GL_PROXY_TEXTURE_1D = $8063; - GL_PROXY_TEXTURE_2D = $8064; - { TextureWrapMode } - GL_REPEAT = $2901; - { PixelInternalFormat } - GL_R3_G3_B2 = $2A10; - GL_RGB4 = $804F; - GL_RGB5 = $8050; - GL_RGB8 = $8051; - GL_RGB10 = $8052; - GL_RGB12 = $8053; - GL_RGB16 = $8054; - GL_RGBA2 = $8055; - GL_RGBA4 = $8056; - GL_RGB5_A1 = $8057; - GL_RGBA8 = $8058; - GL_RGB10_A2 = $8059; - GL_RGBA12 = $805A; - GL_RGBA16 = $805B; -{$ifdef DGL_DEPRECATED} - GL_ACCUM = $0100; - GL_LOAD = $0101; - GL_RETURN = $0102; - GL_MULT = $0103; - GL_ADD = $0104; - GL_CURRENT_BIT = $00000001; - GL_POINT_BIT = $00000002; - GL_LINE_BIT = $00000004; - GL_POLYGON_BIT = $00000008; - GL_POLYGON_STIPPLE_BIT = $00000010; - GL_PIXEL_MODE_BIT = $00000020; - GL_LIGHTING_BIT = $00000040; - GL_FOG_BIT = $00000080; - GL_ACCUM_BUFFER_BIT = $00000200; - GL_VIEWPORT_BIT = $00000800; - GL_TRANSFORM_BIT = $00001000; - GL_ENABLE_BIT = $00002000; - GL_HINT_BIT = $00008000; - GL_EVAL_BIT = $00010000; - GL_LIST_BIT = $00020000; - GL_TEXTURE_BIT = $00040000; - GL_SCISSOR_BIT = $00080000; - GL_ALL_ATTRIB_BITS = $000FFFFF; - GL_QUADS = $0007; - GL_QUAD_STRIP = $0008; - GL_POLYGON = $0009; - GL_CLIP_PLANE0 = $3000; - GL_CLIP_PLANE1 = $3001; - GL_CLIP_PLANE2 = $3002; - GL_CLIP_PLANE3 = $3003; - GL_CLIP_PLANE4 = $3004; - GL_CLIP_PLANE5 = $3005; - GL_2_BYTES = $1407; - GL_3_BYTES = $1408; - GL_4_BYTES = $1409; - GL_AUX0 = $0409; - GL_AUX1 = $040A; - GL_AUX2 = $040B; - GL_AUX3 = $040C; - GL_STACK_OVERFLOW = $0503; - GL_STACK_UNDERFLOW = $0504; - GL_2D = $0600; - GL_3D = $0601; - GL_3D_COLOR = $0602; - GL_3D_COLOR_TEXTURE = $0603; - GL_4D_COLOR_TEXTURE = $0604; - GL_PASS_THROUGH_TOKEN = $0700; - GL_POINT_TOKEN = $0701; - GL_LINE_TOKEN = $0702; - GL_POLYGON_TOKEN = $0703; - GL_BITMAP_TOKEN = $0704; - GL_DRAW_PIXEL_TOKEN = $0705; - GL_COPY_PIXEL_TOKEN = $0706; - GL_LINE_RESET_TOKEN = $0707; - GL_EXP = $0800; - GL_EXP2 = $0801; - GL_COEFF = $0A00; - GL_ORDER = $0A01; - GL_DOMAIN = $0A02; - GL_CURRENT_COLOR = $0B00; - GL_CURRENT_INDEX = $0B01; - GL_CURRENT_NORMAL = $0B02; - GL_CURRENT_TEXTURE_COORDS = $0B03; - GL_CURRENT_RASTER_COLOR = $0B04; - GL_CURRENT_RASTER_INDEX = $0B05; - GL_CURRENT_RASTER_TEXTURE_COORDS = $0B06; - GL_CURRENT_RASTER_POSITION = $0B07; - GL_CURRENT_RASTER_POSITION_VALID = $0B08; - GL_CURRENT_RASTER_DISTANCE = $0B09; - GL_POINT_SMOOTH = $0B10; - GL_LINE_STIPPLE = $0B24; - GL_LINE_STIPPLE_PATTERN = $0B25; - GL_LINE_STIPPLE_REPEAT = $0B26; - GL_LIST_MODE = $0B30; - GL_MAX_LIST_NESTING = $0B31; - GL_LIST_BASE = $0B32; - GL_LIST_INDEX = $0B33; - GL_POLYGON_MODE = $0B40; - GL_POLYGON_STIPPLE = $0B42; - GL_EDGE_FLAG = $0B43; - GL_LIGHTING = $0B50; - GL_LIGHT_MODEL_LOCAL_VIEWER = $0B51; - GL_LIGHT_MODEL_TWO_SIDE = $0B52; - GL_LIGHT_MODEL_AMBIENT = $0B53; - GL_SHADE_MODEL = $0B54; - GL_COLOR_MATERIAL_FACE = $0B55; - GL_COLOR_MATERIAL_PARAMETER = $0B56; - GL_COLOR_MATERIAL = $0B57; - GL_FOG = $0B60; - GL_FOG_INDEX = $0B61; - GL_FOG_DENSITY = $0B62; - GL_FOG_START = $0B63; - GL_FOG_END = $0B64; - GL_FOG_MODE = $0B65; - GL_FOG_COLOR = $0B66; - GL_ACCUM_CLEAR_VALUE = $0B80; - GL_MATRIX_MODE = $0BA0; - GL_NORMALIZE = $0BA1; - GL_MODELVIEW_STACK_DEPTH = $0BA3; - GL_PROJECTION_STACK_DEPTH = $0BA4; - GL_TEXTURE_STACK_DEPTH = $0BA5; - GL_MODELVIEW_MATRIX = $0BA6; - GL_PROJECTION_MATRIX = $0BA7; - GL_TEXTURE_MATRIX = $0BA8; - GL_ATTRIB_STACK_DEPTH = $0BB0; - GL_CLIENT_ATTRIB_STACK_DEPTH = $0BB1; - GL_ALPHA_TEST = $0BC0; - GL_ALPHA_TEST_FUNC = $0BC1; - GL_ALPHA_TEST_REF = $0BC2; - GL_INDEX_LOGIC_OP = $0BF1; - GL_AUX_BUFFERS = $0C00; - GL_INDEX_CLEAR_VALUE = $0C20; - GL_INDEX_WRITEMASK = $0C21; - GL_INDEX_MODE = $0C30; - GL_RGBA_MODE = $0C31; - GL_RENDER_MODE = $0C40; - GL_PERSPECTIVE_CORRECTION_HINT = $0C50; - GL_POINT_SMOOTH_HINT = $0C51; - GL_FOG_HINT = $0C54; - GL_TEXTURE_GEN_S = $0C60; - GL_TEXTURE_GEN_T = $0C61; - GL_TEXTURE_GEN_R = $0C62; - GL_TEXTURE_GEN_Q = $0C63; - GL_PIXEL_MAP_I_TO_I = $0C70; - GL_PIXEL_MAP_S_TO_S = $0C71; - GL_PIXEL_MAP_I_TO_R = $0C72; - GL_PIXEL_MAP_I_TO_G = $0C73; - GL_PIXEL_MAP_I_TO_B = $0C74; - GL_PIXEL_MAP_I_TO_A = $0C75; - GL_PIXEL_MAP_R_TO_R = $0C76; - GL_PIXEL_MAP_G_TO_G = $0C77; - GL_PIXEL_MAP_B_TO_B = $0C78; - GL_PIXEL_MAP_A_TO_A = $0C79; - GL_PIXEL_MAP_I_TO_I_SIZE = $0CB0; - GL_PIXEL_MAP_S_TO_S_SIZE = $0CB1; - GL_PIXEL_MAP_I_TO_R_SIZE = $0CB2; - GL_PIXEL_MAP_I_TO_G_SIZE = $0CB3; - GL_PIXEL_MAP_I_TO_B_SIZE = $0CB4; - GL_PIXEL_MAP_I_TO_A_SIZE = $0CB5; - GL_PIXEL_MAP_R_TO_R_SIZE = $0CB6; - GL_PIXEL_MAP_G_TO_G_SIZE = $0CB7; - GL_PIXEL_MAP_B_TO_B_SIZE = $0CB8; - GL_PIXEL_MAP_A_TO_A_SIZE = $0CB9; - GL_MAP_COLOR = $0D10; - GL_MAP_STENCIL = $0D11; - GL_INDEX_SHIFT = $0D12; - GL_INDEX_OFFSET = $0D13; - GL_RED_SCALE = $0D14; - GL_RED_BIAS = $0D15; - GL_ZOOM_X = $0D16; - GL_ZOOM_Y = $0D17; - GL_GREEN_SCALE = $0D18; - GL_GREEN_BIAS = $0D19; - GL_BLUE_SCALE = $0D1A; - GL_BLUE_BIAS = $0D1B; - GL_ALPHA_SCALE = $0D1C; - GL_ALPHA_BIAS = $0D1D; - GL_DEPTH_SCALE = $0D1E; - GL_DEPTH_BIAS = $0D1F; - GL_MAX_EVAL_ORDER = $0D30; - GL_MAX_LIGHTS = $0D31; - GL_MAX_CLIP_PLANES = $0D32; - GL_MAX_PIXEL_MAP_TABLE = $0D34; - GL_MAX_ATTRIB_STACK_DEPTH = $0D35; - GL_MAX_MODELVIEW_STACK_DEPTH = $0D36; - GL_MAX_NAME_STACK_DEPTH = $0D37; - GL_MAX_PROJECTION_STACK_DEPTH = $0D38; - GL_MAX_TEXTURE_STACK_DEPTH = $0D39; - GL_MAX_CLIENT_ATTRIB_STACK_DEPTH = $0D3B; - GL_INDEX_BITS = $0D51; - GL_RED_BITS = $0D52; - GL_GREEN_BITS = $0D53; - GL_BLUE_BITS = $0D54; - GL_ALPHA_BITS = $0D55; - GL_DEPTH_BITS = $0D56; - GL_STENCIL_BITS = $0D57; - GL_ACCUM_RED_BITS = $0D58; - GL_ACCUM_GREEN_BITS = $0D59; - GL_ACCUM_BLUE_BITS = $0D5A; - GL_ACCUM_ALPHA_BITS = $0D5B; - GL_NAME_STACK_DEPTH = $0D70; - GL_AUTO_NORMAL = $0D80; - GL_MAP1_COLOR_4 = $0D90; - GL_MAP1_INDEX = $0D91; - GL_MAP1_NORMAL = $0D92; - GL_MAP1_TEXTURE_COORD_1 = $0D93; - GL_MAP1_TEXTURE_COORD_2 = $0D94; - GL_MAP1_TEXTURE_COORD_3 = $0D95; - GL_MAP1_TEXTURE_COORD_4 = $0D96; - GL_MAP1_VERTEX_3 = $0D97; - GL_MAP1_VERTEX_4 = $0D98; - GL_MAP2_COLOR_4 = $0DB0; - GL_MAP2_INDEX = $0DB1; - GL_MAP2_NORMAL = $0DB2; - GL_MAP2_TEXTURE_COORD_1 = $0DB3; - GL_MAP2_TEXTURE_COORD_2 = $0DB4; - GL_MAP2_TEXTURE_COORD_3 = $0DB5; - GL_MAP2_TEXTURE_COORD_4 = $0DB6; - GL_MAP2_VERTEX_3 = $0DB7; - GL_MAP2_VERTEX_4 = $0DB8; - GL_MAP1_GRID_DOMAIN = $0DD0; - GL_MAP1_GRID_SEGMENTS = $0DD1; - GL_MAP2_GRID_DOMAIN = $0DD2; - GL_MAP2_GRID_SEGMENTS = $0DD3; - GL_FEEDBACK_BUFFER_POINTER = $0DF0; - GL_FEEDBACK_BUFFER_SIZE = $0DF1; - GL_FEEDBACK_BUFFER_TYPE = $0DF2; - GL_SELECTION_BUFFER_POINTER = $0DF3; - GL_SELECTION_BUFFER_SIZE = $0DF4; - GL_LIGHT0 = $4000; - GL_LIGHT1 = $4001; - GL_LIGHT2 = $4002; - GL_LIGHT3 = $4003; - GL_LIGHT4 = $4004; - GL_LIGHT5 = $4005; - GL_LIGHT6 = $4006; - GL_LIGHT7 = $4007; - GL_AMBIENT = $1200; - GL_DIFFUSE = $1201; - GL_SPECULAR = $1202; - GL_POSITION = $1203; - GL_SPOT_DIRECTION = $1204; - GL_SPOT_EXPONENT = $1205; - GL_SPOT_CUTOFF = $1206; - GL_CONSTANT_ATTENUATION = $1207; - GL_LINEAR_ATTENUATION = $1208; - GL_QUADRATIC_ATTENUATION = $1209; - GL_COMPILE = $1300; - GL_COMPILE_AND_EXECUTE = $1301; - GL_EMISSION = $1600; - GL_SHININESS = $1601; - GL_AMBIENT_AND_DIFFUSE = $1602; - GL_COLOR_INDEXES = $1603; - GL_MODELVIEW = $1700; - GL_PROJECTION = $1701; - GL_COLOR_INDEX = $1900; - GL_LUMINANCE = $1909; - GL_LUMINANCE_ALPHA = $190A; - GL_BITMAP = $1A00; - GL_RENDER = $1C00; - GL_FEEDBACK = $1C01; - GL_SELECT = $1C02; - GL_FLAT = $1D00; - GL_SMOOTH = $1D01; - GL_S = $2000; - GL_T = $2001; - GL_R = $2002; - GL_Q = $2003; - GL_MODULATE = $2100; - GL_DECAL = $2101; - GL_TEXTURE_ENV_MODE = $2200; - GL_TEXTURE_ENV_COLOR = $2201; - GL_TEXTURE_ENV = $2300; - GL_EYE_LINEAR = $2400; - GL_OBJECT_LINEAR = $2401; - GL_SPHERE_MAP = $2402; - GL_TEXTURE_GEN_MODE = $2500; - GL_OBJECT_PLANE = $2501; - GL_EYE_PLANE = $2502; - GL_CLAMP = $2900; - GL_CLIENT_PIXEL_STORE_BIT = $00000001; - GL_CLIENT_VERTEX_ARRAY_BIT = $00000002; - GL_CLIENT_ALL_ATTRIB_BITS = $FFFFFFFF; - GL_ALPHA4 = $803B; - GL_ALPHA8 = $803C; - GL_ALPHA12 = $803D; - GL_ALPHA16 = $803E; - GL_LUMINANCE4 = $803F; - GL_LUMINANCE8 = $8040; - GL_LUMINANCE12 = $8041; - GL_LUMINANCE16 = $8042; - GL_LUMINANCE4_ALPHA4 = $8043; - GL_LUMINANCE6_ALPHA2 = $8044; - GL_LUMINANCE8_ALPHA8 = $8045; - GL_LUMINANCE12_ALPHA4 = $8046; - GL_LUMINANCE12_ALPHA12 = $8047; - GL_LUMINANCE16_ALPHA16 = $8048; - GL_INTENSITY = $8049; - GL_INTENSITY4 = $804A; - GL_INTENSITY8 = $804B; - GL_INTENSITY12 = $804C; - GL_INTENSITY16 = $804D; - GL_TEXTURE_LUMINANCE_SIZE = $8060; - GL_TEXTURE_INTENSITY_SIZE = $8061; - GL_TEXTURE_PRIORITY = $8066; - GL_TEXTURE_RESIDENT = $8067; - GL_VERTEX_ARRAY = $8074; - GL_NORMAL_ARRAY = $8075; - GL_COLOR_ARRAY = $8076; - GL_INDEX_ARRAY = $8077; - GL_TEXTURE_COORD_ARRAY = $8078; - GL_EDGE_FLAG_ARRAY = $8079; - GL_VERTEX_ARRAY_SIZE = $807A; - GL_VERTEX_ARRAY_TYPE = $807B; - GL_VERTEX_ARRAY_STRIDE = $807C; - GL_NORMAL_ARRAY_TYPE = $807E; - GL_NORMAL_ARRAY_STRIDE = $807F; - GL_COLOR_ARRAY_SIZE = $8081; - GL_COLOR_ARRAY_TYPE = $8082; - GL_COLOR_ARRAY_STRIDE = $8083; - GL_INDEX_ARRAY_TYPE = $8085; - GL_INDEX_ARRAY_STRIDE = $8086; - GL_TEXTURE_COORD_ARRAY_SIZE = $8088; - GL_TEXTURE_COORD_ARRAY_TYPE = $8089; - GL_TEXTURE_COORD_ARRAY_STRIDE = $808A; - GL_EDGE_FLAG_ARRAY_STRIDE = $808C; - GL_VERTEX_ARRAY_POINTER = $808E; - GL_NORMAL_ARRAY_POINTER = $808F; - GL_COLOR_ARRAY_POINTER = $8090; - GL_INDEX_ARRAY_POINTER = $8091; - GL_TEXTURE_COORD_ARRAY_POINTER = $8092; - GL_EDGE_FLAG_ARRAY_POINTER = $8093; - GL_V2F = $2A20; - GL_V3F = $2A21; - GL_C4UB_V2F = $2A22; - GL_C4UB_V3F = $2A23; - GL_C3F_V3F = $2A24; - GL_N3F_V3F = $2A25; - GL_C4F_N3F_V3F = $2A26; - GL_T2F_V3F = $2A27; - GL_T4F_V4F = $2A28; - GL_T2F_C4UB_V3F = $2A29; - GL_T2F_C3F_V3F = $2A2A; - GL_T2F_N3F_V3F = $2A2B; - GL_T2F_C4F_N3F_V3F = $2A2C; - GL_T4F_C4F_N3F_V4F = $2A2D; - GL_COLOR_TABLE_FORMAT_EXT = $80D8; - GL_COLOR_TABLE_WIDTH_EXT = $80D9; - GL_COLOR_TABLE_RED_SIZE_EXT = $80DA; - GL_COLOR_TABLE_GREEN_SIZE_EXT = $80DB; - GL_COLOR_TABLE_BLUE_SIZE_EXT = $80DC; - GL_COLOR_TABLE_ALPHA_SIZE_EXT = $80DD; - GL_COLOR_TABLE_LUMINANCE_SIZE_EXT = $80DE; - GL_COLOR_TABLE_INTENSITY_SIZE_EXT = $80DF; - GL_LOGIC_OP = GL_INDEX_LOGIC_OP; - GL_TEXTURE_COMPONENTS = GL_TEXTURE_INTERNAL_FORMAT; -{$endif} - - // GL_VERSION_1_2 - GL_UNSIGNED_BYTE_3_3_2 = $8032; - GL_UNSIGNED_SHORT_4_4_4_4 = $8033; - GL_UNSIGNED_SHORT_5_5_5_1 = $8034; - GL_UNSIGNED_INT_8_8_8_8 = $8035; - GL_UNSIGNED_INT_10_10_10_2 = $8036; - GL_TEXTURE_BINDING_3D = $806A; - GL_PACK_SKIP_IMAGES = $806B; - GL_PACK_IMAGE_HEIGHT = $806C; - GL_UNPACK_SKIP_IMAGES = $806D; - GL_UNPACK_IMAGE_HEIGHT = $806E; - GL_TEXTURE_3D = $806F; - GL_PROXY_TEXTURE_3D = $8070; - GL_TEXTURE_DEPTH = $8071; - GL_TEXTURE_WRAP_R = $8072; - GL_MAX_3D_TEXTURE_SIZE = $8073; - GL_UNSIGNED_BYTE_2_3_3_REV = $8362; - GL_UNSIGNED_SHORT_5_6_5 = $8363; - GL_UNSIGNED_SHORT_5_6_5_REV = $8364; - GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365; - GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366; - GL_UNSIGNED_INT_8_8_8_8_REV = $8367; - GL_UNSIGNED_INT_2_10_10_10_REV = $8368; - GL_BGR = $80E0; - GL_BGRA = $80E1; - GL_MAX_ELEMENTS_VERTICES = $80E8; - GL_MAX_ELEMENTS_INDICES = $80E9; - GL_CLAMP_TO_EDGE = $812F; - GL_TEXTURE_MIN_LOD = $813A; - GL_TEXTURE_MAX_LOD = $813B; - GL_TEXTURE_BASE_LEVEL = $813C; - GL_TEXTURE_MAX_LEVEL = $813D; - GL_SMOOTH_POINT_SIZE_RANGE = $0B12; - GL_SMOOTH_POINT_SIZE_GRANULARITY = $0B13; - GL_SMOOTH_LINE_WIDTH_RANGE = $0B22; - GL_SMOOTH_LINE_WIDTH_GRANULARITY = $0B23; - GL_ALIASED_LINE_WIDTH_RANGE = $846E; -{$ifdef DGL_DEPRECATED} - GL_RESCALE_NORMAL = $803A; - GL_LIGHT_MODEL_COLOR_CONTROL = $81F8; - GL_SINGLE_COLOR = $81F9; - GL_SEPARATE_SPECULAR_COLOR = $81FA; - GL_ALIASED_POINT_SIZE_RANGE = $846D; -{$endif} - - // GL_VERSION_1_3 - GL_TEXTURE0 = $84C0; - GL_TEXTURE1 = $84C1; - GL_TEXTURE2 = $84C2; - GL_TEXTURE3 = $84C3; - GL_TEXTURE4 = $84C4; - GL_TEXTURE5 = $84C5; - GL_TEXTURE6 = $84C6; - GL_TEXTURE7 = $84C7; - GL_TEXTURE8 = $84C8; - GL_TEXTURE9 = $84C9; - GL_TEXTURE10 = $84CA; - GL_TEXTURE11 = $84CB; - GL_TEXTURE12 = $84CC; - GL_TEXTURE13 = $84CD; - GL_TEXTURE14 = $84CE; - GL_TEXTURE15 = $84CF; - GL_TEXTURE16 = $84D0; - GL_TEXTURE17 = $84D1; - GL_TEXTURE18 = $84D2; - GL_TEXTURE19 = $84D3; - GL_TEXTURE20 = $84D4; - GL_TEXTURE21 = $84D5; - GL_TEXTURE22 = $84D6; - GL_TEXTURE23 = $84D7; - GL_TEXTURE24 = $84D8; - GL_TEXTURE25 = $84D9; - GL_TEXTURE26 = $84DA; - GL_TEXTURE27 = $84DB; - GL_TEXTURE28 = $84DC; - GL_TEXTURE29 = $84DD; - GL_TEXTURE30 = $84DE; - GL_TEXTURE31 = $84DF; - GL_ACTIVE_TEXTURE = $84E0; - GL_MULTISAMPLE = $809D; - GL_SAMPLE_ALPHA_TO_COVERAGE = $809E; - GL_SAMPLE_ALPHA_TO_ONE = $809F; - GL_SAMPLE_COVERAGE = $80A0; - GL_SAMPLE_BUFFERS = $80A8; - GL_SAMPLES = $80A9; - GL_SAMPLE_COVERAGE_VALUE = $80AA; - GL_SAMPLE_COVERAGE_INVERT = $80AB; - GL_TEXTURE_CUBE_MAP = $8513; - GL_TEXTURE_BINDING_CUBE_MAP = $8514; - GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515; - GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516; - GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518; - GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A; - GL_PROXY_TEXTURE_CUBE_MAP = $851B; - GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C; - GL_COMPRESSED_RGB = $84ED; - GL_COMPRESSED_RGBA = $84EE; - GL_TEXTURE_COMPRESSION_HINT = $84EF; - GL_TEXTURE_COMPRESSED_IMAGE_SIZE = $86A0; - GL_TEXTURE_COMPRESSED = $86A1; - GL_NUM_COMPRESSED_TEXTURE_FORMATS = $86A2; - GL_COMPRESSED_TEXTURE_FORMATS = $86A3; - GL_CLAMP_TO_BORDER = $812D; -{$ifdef DGL_DEPRECATED} - GL_CLIENT_ACTIVE_TEXTURE = $84E1; - GL_MAX_TEXTURE_UNITS = $84E2; - GL_TRANSPOSE_MODELVIEW_MATRIX = $84E3; - GL_TRANSPOSE_PROJECTION_MATRIX = $84E4; - GL_TRANSPOSE_TEXTURE_MATRIX = $84E5; - GL_TRANSPOSE_COLOR_MATRIX = $84E6; - GL_MULTISAMPLE_BIT = $20000000; - GL_NORMAL_MAP = $8511; - GL_REFLECTION_MAP = $8512; - GL_COMPRESSED_ALPHA = $84E9; - GL_COMPRESSED_LUMINANCE = $84EA; - GL_COMPRESSED_LUMINANCE_ALPHA = $84EB; - GL_COMPRESSED_INTENSITY = $84EC; - GL_COMBINE = $8570; - GL_COMBINE_RGB = $8571; - GL_COMBINE_ALPHA = $8572; - GL_SOURCE0_RGB = $8580; - GL_SOURCE1_RGB = $8581; - GL_SOURCE2_RGB = $8582; - GL_SOURCE0_ALPHA = $8588; - GL_SOURCE1_ALPHA = $8589; - GL_SOURCE2_ALPHA = $858A; - GL_OPERAND0_RGB = $8590; - GL_OPERAND1_RGB = $8591; - GL_OPERAND2_RGB = $8592; - GL_OPERAND0_ALPHA = $8598; - GL_OPERAND1_ALPHA = $8599; - GL_OPERAND2_ALPHA = $859A; - GL_RGB_SCALE = $8573; - GL_ADD_SIGNED = $8574; - GL_INTERPOLATE = $8575; - GL_SUBTRACT = $84E7; - GL_CONSTANT = $8576; - GL_PRIMARY_COLOR = $8577; - GL_PREVIOUS = $8578; - GL_DOT3_RGB = $86AE; - GL_DOT3_RGBA = $86AF; -{$endif} - - // GL_VERSION_1_4 - GL_BLEND_DST_RGB = $80C8; - GL_BLEND_SRC_RGB = $80C9; - GL_BLEND_DST_ALPHA = $80CA; - GL_BLEND_SRC_ALPHA = $80CB; - GL_POINT_FADE_THRESHOLD_SIZE = $8128; - GL_DEPTH_COMPONENT16 = $81A5; - GL_DEPTH_COMPONENT24 = $81A6; - GL_DEPTH_COMPONENT32 = $81A7; - GL_MIRRORED_REPEAT = $8370; - GL_MAX_TEXTURE_LOD_BIAS = $84FD; - GL_TEXTURE_LOD_BIAS = $8501; - GL_INCR_WRAP = $8507; - GL_DECR_WRAP = $8508; - GL_TEXTURE_DEPTH_SIZE = $884A; - GL_TEXTURE_COMPARE_MODE = $884C; - GL_TEXTURE_COMPARE_FUNC = $884D; -{$ifdef DGL_DEPRECATED} - GL_POINT_SIZE_MIN = $8126; - GL_POINT_SIZE_MAX = $8127; - GL_POINT_DISTANCE_ATTENUATION = $8129; - GL_GENERATE_MIPMAP = $8191; - GL_GENERATE_MIPMAP_HINT = $8192; - GL_FOG_COORDINATE_SOURCE = $8450; - GL_FOG_COORDINATE = $8451; - GL_FRAGMENT_DEPTH = $8452; - GL_CURRENT_FOG_COORDINATE = $8453; - GL_FOG_COORDINATE_ARRAY_TYPE = $8454; - GL_FOG_COORDINATE_ARRAY_STRIDE = $8455; - GL_FOG_COORDINATE_ARRAY_POINTER = $8456; - GL_FOG_COORDINATE_ARRAY = $8457; - GL_COLOR_SUM = $8458; - GL_CURRENT_SECONDARY_COLOR = $8459; - GL_SECONDARY_COLOR_ARRAY_SIZE = $845A; - GL_SECONDARY_COLOR_ARRAY_TYPE = $845B; - GL_SECONDARY_COLOR_ARRAY_STRIDE = $845C; - GL_SECONDARY_COLOR_ARRAY_POINTER = $845D; - GL_SECONDARY_COLOR_ARRAY = $845E; - GL_TEXTURE_FILTER_CONTROL = $8500; - GL_DEPTH_TEXTURE_MODE = $884B; - GL_COMPARE_R_TO_TEXTURE = $884E; -{$endif} - - // GL_VERSION_1_5 - GL_BUFFER_SIZE = $8764; - GL_BUFFER_USAGE = $8765; - GL_QUERY_COUNTER_BITS = $8864; - GL_CURRENT_QUERY = $8865; - GL_QUERY_RESULT = $8866; - GL_QUERY_RESULT_AVAILABLE = $8867; - GL_ARRAY_BUFFER = $8892; - GL_ELEMENT_ARRAY_BUFFER = $8893; - GL_ARRAY_BUFFER_BINDING = $8894; - GL_ELEMENT_ARRAY_BUFFER_BINDING = $8895; - GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING = $889F; - GL_READ_ONLY = $88B8; - GL_WRITE_ONLY = $88B9; - GL_READ_WRITE = $88BA; - GL_BUFFER_ACCESS = $88BB; - GL_BUFFER_MAPPED = $88BC; - GL_BUFFER_MAP_POINTER = $88BD; - GL_STREAM_DRAW = $88E0; - GL_STREAM_READ = $88E1; - GL_STREAM_COPY = $88E2; - GL_STATIC_DRAW = $88E4; - GL_STATIC_READ = $88E5; - GL_STATIC_COPY = $88E6; - GL_DYNAMIC_DRAW = $88E8; - GL_DYNAMIC_READ = $88E9; - GL_DYNAMIC_COPY = $88EA; - GL_SAMPLES_PASSED = $8914; -{$ifdef DGL_DEPRECATED} - GL_VERTEX_ARRAY_BUFFER_BINDING = $8896; - GL_NORMAL_ARRAY_BUFFER_BINDING = $8897; - GL_COLOR_ARRAY_BUFFER_BINDING = $8898; - GL_INDEX_ARRAY_BUFFER_BINDING = $8899; - GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING = $889A; - GL_EDGE_FLAG_ARRAY_BUFFER_BINDING = $889B; - GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING = $889C; - GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING = $889D; - GL_WEIGHT_ARRAY_BUFFER_BINDING = $889E; - GL_FOG_COORD_SRC = $8450; - GL_FOG_COORD = $8451; - GL_CURRENT_FOG_COORD = $8453; - GL_FOG_COORD_ARRAY_TYPE = $8454; - GL_FOG_COORD_ARRAY_STRIDE = $8455; - GL_FOG_COORD_ARRAY_POINTER = $8456; - GL_FOG_COORD_ARRAY = $8457; - GL_FOG_COORD_ARRAY_BUFFER_BINDING = $889D; - GL_SRC0_RGB = $8580; - GL_SRC1_RGB = $8581; - GL_SRC2_RGB = $8582; - GL_SRC0_ALPHA = $8588; - GL_SRC1_ALPHA = $8589; - GL_SRC2_ALPHA = $858A; -{$endif} - - // GL_VERSION_2_0 - GL_BLEND_EQUATION_RGB = $8009; - GL_VERTEX_ATTRIB_ARRAY_ENABLED = $8622; - GL_VERTEX_ATTRIB_ARRAY_SIZE = $8623; - GL_VERTEX_ATTRIB_ARRAY_STRIDE = $8624; - GL_VERTEX_ATTRIB_ARRAY_TYPE = $8625; - GL_CURRENT_VERTEX_ATTRIB = $8626; - GL_VERTEX_PROGRAM_POINT_SIZE = $8642; - GL_VERTEX_ATTRIB_ARRAY_POINTER = $8645; - GL_STENCIL_BACK_FUNC = $8800; - GL_STENCIL_BACK_FAIL = $8801; - GL_STENCIL_BACK_PASS_DEPTH_FAIL = $8802; - GL_STENCIL_BACK_PASS_DEPTH_PASS = $8803; - GL_MAX_DRAW_BUFFERS = $8824; - GL_DRAW_BUFFER0 = $8825; - GL_DRAW_BUFFER1 = $8826; - GL_DRAW_BUFFER2 = $8827; - GL_DRAW_BUFFER3 = $8828; - GL_DRAW_BUFFER4 = $8829; - GL_DRAW_BUFFER5 = $882A; - GL_DRAW_BUFFER6 = $882B; - GL_DRAW_BUFFER7 = $882C; - GL_DRAW_BUFFER8 = $882D; - GL_DRAW_BUFFER9 = $882E; - GL_DRAW_BUFFER10 = $882F; - GL_DRAW_BUFFER11 = $8830; - GL_DRAW_BUFFER12 = $8831; - GL_DRAW_BUFFER13 = $8832; - GL_DRAW_BUFFER14 = $8833; - GL_DRAW_BUFFER15 = $8834; - GL_BLEND_EQUATION_ALPHA = $883D; - GL_MAX_VERTEX_ATTRIBS = $8869; - GL_VERTEX_ATTRIB_ARRAY_NORMALIZED = $886A; - GL_MAX_TEXTURE_IMAGE_UNITS = $8872; - GL_FRAGMENT_SHADER = $8B30; - GL_VERTEX_SHADER = $8B31; - GL_MAX_FRAGMENT_UNIFORM_COMPONENTS = $8B49; - GL_MAX_VERTEX_UNIFORM_COMPONENTS = $8B4A; - GL_MAX_VARYING_FLOATS = $8B4B; - GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C; - GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS = $8B4D; - GL_SHADER_TYPE = $8B4F; - GL_FLOAT_VEC2 = $8B50; - GL_FLOAT_VEC3 = $8B51; - GL_FLOAT_VEC4 = $8B52; - GL_INT_VEC2 = $8B53; - GL_INT_VEC3 = $8B54; - GL_INT_VEC4 = $8B55; - GL_BOOL = $8B56; - GL_BOOL_VEC2 = $8B57; - GL_BOOL_VEC3 = $8B58; - GL_BOOL_VEC4 = $8B59; - GL_FLOAT_MAT2 = $8B5A; - GL_FLOAT_MAT3 = $8B5B; - GL_FLOAT_MAT4 = $8B5C; - GL_SAMPLER_1D = $8B5D; - GL_SAMPLER_2D = $8B5E; - GL_SAMPLER_3D = $8B5F; - GL_SAMPLER_CUBE = $8B60; - GL_SAMPLER_1D_SHADOW = $8B61; - GL_SAMPLER_2D_SHADOW = $8B62; - GL_DELETE_STATUS = $8B80; - GL_COMPILE_STATUS = $8B81; - GL_LINK_STATUS = $8B82; - GL_VALIDATE_STATUS = $8B83; - GL_INFO_LOG_LENGTH = $8B84; - GL_ATTACHED_SHADERS = $8B85; - GL_ACTIVE_UNIFORMS = $8B86; - GL_ACTIVE_UNIFORM_MAX_LENGTH = $8B87; - GL_SHADER_SOURCE_LENGTH = $8B88; - GL_ACTIVE_ATTRIBUTES = $8B89; - GL_ACTIVE_ATTRIBUTE_MAX_LENGTH = $8B8A; - GL_FRAGMENT_SHADER_DERIVATIVE_HINT = $8B8B; - GL_SHADING_LANGUAGE_VERSION = $8B8C; - GL_CURRENT_PROGRAM = $8B8D; - GL_POINT_SPRITE_COORD_ORIGIN = $8CA0; - GL_LOWER_LEFT = $8CA1; - GL_UPPER_LEFT = $8CA2; - GL_STENCIL_BACK_REF = $8CA3; - GL_STENCIL_BACK_VALUE_MASK = $8CA4; - GL_STENCIL_BACK_WRITEMASK = $8CA5; -{$ifdef DGL_DEPRECATED} - GL_VERTEX_PROGRAM_TWO_SIDE = $8643; - GL_POINT_SPRITE = $8861; - GL_COORD_REPLACE = $8862; - GL_MAX_TEXTURE_COORDS = $8871; -{$endif} - - // GL_VERSION_2_1 - GL_PIXEL_PACK_BUFFER = $88EB; - GL_PIXEL_UNPACK_BUFFER = $88EC; - GL_PIXEL_PACK_BUFFER_BINDING = $88ED; - GL_PIXEL_UNPACK_BUFFER_BINDING = $88EF; - GL_FLOAT_MAT2x3 = $8B65; - GL_FLOAT_MAT2x4 = $8B66; - GL_FLOAT_MAT3x2 = $8B67; - GL_FLOAT_MAT3x4 = $8B68; - GL_FLOAT_MAT4x2 = $8B69; - GL_FLOAT_MAT4x3 = $8B6A; - GL_SRGB = $8C40; - GL_SRGB8 = $8C41; - GL_SRGB_ALPHA = $8C42; - GL_SRGB8_ALPHA8 = $8C43; - GL_COMPRESSED_SRGB = $8C48; - GL_COMPRESSED_SRGB_ALPHA = $8C49; -{$ifdef DGL_DEPRECATED} - GL_CURRENT_RASTER_SECONDARY_COLOR = $845F; - GL_SLUMINANCE_ALPHA = $8C44; - GL_SLUMINANCE8_ALPHA8 = $8C45; - GL_SLUMINANCE = $8C46; - GL_SLUMINANCE8 = $8C47; - GL_COMPRESSED_SLUMINANCE = $8C4A; - GL_COMPRESSED_SLUMINANCE_ALPHA = $8C4B; -{$endif} - - // GL_VERSION_3_0 - GL_COMPARE_REF_TO_TEXTURE = $884E; - GL_CLIP_DISTANCE0 = $3000; - GL_CLIP_DISTANCE1 = $3001; - GL_CLIP_DISTANCE2 = $3002; - GL_CLIP_DISTANCE3 = $3003; - GL_CLIP_DISTANCE4 = $3004; - GL_CLIP_DISTANCE5 = $3005; - GL_CLIP_DISTANCE6 = $3006; - GL_CLIP_DISTANCE7 = $3007; - GL_MAX_CLIP_DISTANCES = $0D32; - GL_MAJOR_VERSION = $821B; - GL_MINOR_VERSION = $821C; - GL_NUM_EXTENSIONS = $821D; - GL_CONTEXT_FLAGS = $821E; - GL_DEPTH_BUFFER = $8223; - GL_STENCIL_BUFFER = $8224; - GL_COMPRESSED_RED = $8225; - GL_COMPRESSED_RG = $8226; - GL_CONTEXT_FLAG_FORWARD_COMPATIBLE_BIT = $0001; - GL_RGBA32F = $8814; - GL_RGB32F = $8815; - GL_RGBA16F = $881A; - GL_RGB16F = $881B; - GL_VERTEX_ATTRIB_ARRAY_INTEGER = $88FD; - GL_MAX_ARRAY_TEXTURE_LAYERS = $88FF; - GL_MIN_PROGRAM_TEXEL_OFFSET = $8904; - GL_MAX_PROGRAM_TEXEL_OFFSET = $8905; - GL_CLAMP_READ_COLOR = $891C; - GL_FIXED_ONLY = $891D; - GL_MAX_VARYING_COMPONENTS = $8B4B; - GL_TEXTURE_1D_ARRAY = $8C18; - GL_PROXY_TEXTURE_1D_ARRAY = $8C19; - GL_TEXTURE_2D_ARRAY = $8C1A; - GL_PROXY_TEXTURE_2D_ARRAY = $8C1B; - GL_TEXTURE_BINDING_1D_ARRAY = $8C1C; - GL_TEXTURE_BINDING_2D_ARRAY = $8C1D; - GL_R11F_G11F_B10F = $8C3A; - GL_UNSIGNED_INT_10F_11F_11F_REV = $8C3B; - GL_RGB9_E5 = $8C3D; - GL_UNSIGNED_INT_5_9_9_9_REV = $8C3E; - GL_TEXTURE_SHARED_SIZE = $8C3F; - GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH = $8C76; - GL_TRANSFORM_FEEDBACK_BUFFER_MODE = $8C7F; - GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS = $8C80; - GL_TRANSFORM_FEEDBACK_VARYINGS = $8C83; - GL_TRANSFORM_FEEDBACK_BUFFER_START = $8C84; - GL_TRANSFORM_FEEDBACK_BUFFER_SIZE = $8C85; - GL_PRIMITIVES_GENERATED = $8C87; - GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN = $8C88; - GL_RASTERIZER_DISCARD = $8C89; - GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS = $8C8A; - GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS = $8C8B; - GL_INTERLEAVED_ATTRIBS = $8C8C; - GL_SEPARATE_ATTRIBS = $8C8D; - GL_TRANSFORM_FEEDBACK_BUFFER = $8C8E; - GL_TRANSFORM_FEEDBACK_BUFFER_BINDING = $8C8F; - GL_RGBA32UI = $8D70; - GL_RGB32UI = $8D71; - GL_RGBA16UI = $8D76; - GL_RGB16UI = $8D77; - GL_RGBA8UI = $8D7C; - GL_RGB8UI = $8D7D; - GL_RGBA32I = $8D82; - GL_RGB32I = $8D83; - GL_RGBA16I = $8D88; - GL_RGB16I = $8D89; - GL_RGBA8I = $8D8E; - GL_RGB8I = $8D8F; - GL_RED_INTEGER = $8D94; - GL_GREEN_INTEGER = $8D95; - GL_BLUE_INTEGER = $8D96; - GL_RGB_INTEGER = $8D98; - GL_RGBA_INTEGER = $8D99; - GL_BGR_INTEGER = $8D9A; - GL_BGRA_INTEGER = $8D9B; - GL_SAMPLER_1D_ARRAY = $8DC0; - GL_SAMPLER_2D_ARRAY = $8DC1; - GL_SAMPLER_1D_ARRAY_SHADOW = $8DC3; - GL_SAMPLER_2D_ARRAY_SHADOW = $8DC4; - GL_SAMPLER_CUBE_SHADOW = $8DC5; - GL_UNSIGNED_INT_VEC2 = $8DC6; - GL_UNSIGNED_INT_VEC3 = $8DC7; - GL_UNSIGNED_INT_VEC4 = $8DC8; - GL_INT_SAMPLER_1D = $8DC9; - GL_INT_SAMPLER_2D = $8DCA; - GL_INT_SAMPLER_3D = $8DCB; - GL_INT_SAMPLER_CUBE = $8DCC; - GL_INT_SAMPLER_1D_ARRAY = $8DCE; - GL_INT_SAMPLER_2D_ARRAY = $8DCF; - GL_UNSIGNED_INT_SAMPLER_1D = $8DD1; - GL_UNSIGNED_INT_SAMPLER_2D = $8DD2; - GL_UNSIGNED_INT_SAMPLER_3D = $8DD3; - GL_UNSIGNED_INT_SAMPLER_CUBE = $8DD4; - GL_UNSIGNED_INT_SAMPLER_1D_ARRAY = $8DD6; - GL_UNSIGNED_INT_SAMPLER_2D_ARRAY = $8DD7; - GL_QUERY_WAIT = $8E13; - GL_QUERY_NO_WAIT = $8E14; - GL_QUERY_BY_REGION_WAIT = $8E15; - GL_QUERY_BY_REGION_NO_WAIT = $8E16; - GL_BUFFER_ACCESS_FLAGS = $911F; - GL_BUFFER_MAP_LENGTH = $9120; - GL_BUFFER_MAP_OFFSET = $9121; - { Reuse tokens from ARB_depth_buffer_float } - { reuse GL_DEPTH_COMPONENT32F } - { reuse GL_DEPTH32F_STENCIL8 } - { reuse GL_FLOAT_32_UNSIGNED_INT_24_8_REV } - { Reuse tokens from ARB_framebuffer_object } - { reuse GL_INVALID_FRAMEBUFFER_OPERATION } - { reuse GL_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING } - { reuse GL_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE } - { reuse GL_FRAMEBUFFER_DEFAULT } - { reuse GL_FRAMEBUFFER_UNDEFINED } - { reuse GL_DEPTH_STENCIL_ATTACHMENT } - { reuse GL_INDEX } - { reuse GL_MAX_RENDERBUFFER_SIZE } - { reuse GL_DEPTH_STENCIL } - { reuse GL_UNSIGNED_INT_24_8 } - { reuse GL_DEPTH24_STENCIL8 } - { reuse GL_TEXTURE_STENCIL_SIZE } - { reuse GL_TEXTURE_RED_TYPE } - { reuse GL_TEXTURE_GREEN_TYPE } - { reuse GL_TEXTURE_BLUE_TYPE } - { reuse GL_TEXTURE_ALPHA_TYPE } - { reuse GL_TEXTURE_DEPTH_TYPE } - { reuse GL_UNSIGNED_NORMALIZED } - { reuse GL_FRAMEBUFFER_BINDING } - { reuse GL_DRAW_FRAMEBUFFER_BINDING } - { reuse GL_RENDERBUFFER_BINDING } - { reuse GL_READ_FRAMEBUFFER } - { reuse GL_DRAW_FRAMEBUFFER } - { reuse GL_READ_FRAMEBUFFER_BINDING } - { reuse GL_RENDERBUFFER_SAMPLES } - { reuse GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME } - { reuse GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL } - { reuse GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE } - { reuse GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER } - { reuse GL_FRAMEBUFFER_COMPLETE } - { reuse GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT } - { reuse GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT } - { reuse GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER } - { reuse GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER } - { reuse GL_FRAMEBUFFER_UNSUPPORTED } - { reuse GL_MAX_COLOR_ATTACHMENTS } - { reuse GL_COLOR_ATTACHMENT0 } - { reuse GL_COLOR_ATTACHMENT1 } - { reuse GL_COLOR_ATTACHMENT2 } - { reuse GL_COLOR_ATTACHMENT3 } - { reuse GL_COLOR_ATTACHMENT4 } - { reuse GL_COLOR_ATTACHMENT5 } - { reuse GL_COLOR_ATTACHMENT6 } - { reuse GL_COLOR_ATTACHMENT7 } - { reuse GL_COLOR_ATTACHMENT8 } - { reuse GL_COLOR_ATTACHMENT9 } - { reuse GL_COLOR_ATTACHMENT10 } - { reuse GL_COLOR_ATTACHMENT11 } - { reuse GL_COLOR_ATTACHMENT12 } - { reuse GL_COLOR_ATTACHMENT13 } - { reuse GL_COLOR_ATTACHMENT14 } - { reuse GL_COLOR_ATTACHMENT15 } - { reuse GL_DEPTH_ATTACHMENT } - { reuse GL_STENCIL_ATTACHMENT } - { reuse GL_FRAMEBUFFER } - { reuse GL_RENDERBUFFER } - { reuse GL_RENDERBUFFER_WIDTH } - { reuse GL_RENDERBUFFER_HEIGHT } - { reuse GL_RENDERBUFFER_INTERNAL_FORMAT } - { reuse GL_STENCIL_INDEX1 } - { reuse GL_STENCIL_INDEX4 } - { reuse GL_STENCIL_INDEX8 } - { reuse GL_STENCIL_INDEX16 } - { reuse GL_RENDERBUFFER_RED_SIZE } - { reuse GL_RENDERBUFFER_GREEN_SIZE } - { reuse GL_RENDERBUFFER_BLUE_SIZE } - { reuse GL_RENDERBUFFER_ALPHA_SIZE } - { reuse GL_RENDERBUFFER_DEPTH_SIZE } - { reuse GL_RENDERBUFFER_STENCIL_SIZE } - { reuse GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE } - { reuse GL_MAX_SAMPLES } - { Reuse tokens from ARB_framebuffer_sRGB } - { reuse GL_FRAMEBUFFER_SRGB } - { Reuse tokens from ARB_half_float_vertex } - { reuse GL_HALF_FLOAT } - { Reuse tokens from ARB_map_buffer_range } - { reuse GL_MAP_READ_BIT } - { reuse GL_MAP_WRITE_BIT } - { reuse GL_MAP_INVALIDATE_RANGE_BIT } - { reuse GL_MAP_INVALIDATE_BUFFER_BIT } - { reuse GL_MAP_FLUSH_EXPLICIT_BIT } - { reuse GL_MAP_UNSYNCHRONIZED_BIT } - { Reuse tokens from ARB_texture_compression_rgtc } - { reuse GL_COMPRESSED_RED_RGTC1 } - { reuse GL_COMPRESSED_SIGNED_RED_RGTC1 } - { reuse GL_COMPRESSED_RG_RGTC2 } - { reuse GL_COMPRESSED_SIGNED_RG_RGTC2 } - { Reuse tokens from ARB_texture_rg } - { reuse GL_RG } - { reuse GL_RG_INTEGER } - { reuse GL_R8 } - { reuse GL_R16 } - { reuse GL_RG8 } - { reuse GL_RG16 } - { reuse GL_R16F } - { reuse GL_R32F } - { reuse GL_RG16F } - { reuse GL_RG32F } - { reuse GL_R8I } - { reuse GL_R8UI } - { reuse GL_R16I } - { reuse GL_R16UI } - { reuse GL_R32I } - { reuse GL_R32UI } - { reuse GL_RG8I } - { reuse GL_RG8UI } - { reuse GL_RG16I } - { reuse GL_RG16UI } - { reuse GL_RG32I } - { reuse GL_RG32UI } - { Reuse tokens from ARB_vertex_array_object } - { reuse GL_VERTEX_ARRAY_BINDING } -{$ifdef DGL_DEPRECATED} - GL_CLAMP_VERTEX_COLOR = $891A; - GL_CLAMP_FRAGMENT_COLOR = $891B; - GL_ALPHA_INTEGER = $8D97; - { Reuse tokens from ARB_framebuffer_object } - { reuse GL_TEXTURE_LUMINANCE_TYPE } - { reuse GL_TEXTURE_INTENSITY_TYPE } -{$endif} - - // GL_VERSION_3_1 - GL_SAMPLER_2D_RECT = $8B63; - GL_SAMPLER_2D_RECT_SHADOW = $8B64; - GL_SAMPLER_BUFFER = $8DC2; - GL_INT_SAMPLER_2D_RECT = $8DCD; - GL_INT_SAMPLER_BUFFER = $8DD0; - GL_UNSIGNED_INT_SAMPLER_2D_RECT = $8DD5; - GL_UNSIGNED_INT_SAMPLER_BUFFER = $8DD8; - GL_TEXTURE_BUFFER = $8C2A; - GL_MAX_TEXTURE_BUFFER_SIZE = $8C2B; - GL_TEXTURE_BINDING_BUFFER = $8C2C; - GL_TEXTURE_BUFFER_DATA_STORE_BINDING = $8C2D; - GL_TEXTURE_BUFFER_FORMAT = $8C2E; - GL_TEXTURE_RECTANGLE = $84F5; - GL_TEXTURE_BINDING_RECTANGLE = $84F6; - GL_PROXY_TEXTURE_RECTANGLE = $84F7; - GL_MAX_RECTANGLE_TEXTURE_SIZE = $84F8; - GL_RED_SNORM = $8F90; - GL_RG_SNORM = $8F91; - GL_RGB_SNORM = $8F92; - GL_RGBA_SNORM = $8F93; - GL_R8_SNORM = $8F94; - GL_RG8_SNORM = $8F95; - GL_RGB8_SNORM = $8F96; - GL_RGBA8_SNORM = $8F97; - GL_R16_SNORM = $8F98; - GL_RG16_SNORM = $8F99; - GL_RGB16_SNORM = $8F9A; - GL_RGBA16_SNORM = $8F9B; - GL_SIGNED_NORMALIZED = $8F9C; - GL_PRIMITIVE_RESTART = $8F9D; - GL_PRIMITIVE_RESTART_INDEX = $8F9E; - { Reuse tokens from ARB_copy_buffer } - { reuse GL_COPY_READ_BUFFER } - { reuse GL_COPY_WRITE_BUFFER } - { Reuse tokens from ARB_draw_instanced (none) } - { Reuse tokens from ARB_uniform_buffer_object } - { reuse GL_UNIFORM_BUFFER } - { reuse GL_UNIFORM_BUFFER_BINDING } - { reuse GL_UNIFORM_BUFFER_START } - { reuse GL_UNIFORM_BUFFER_SIZE } - { reuse GL_MAX_VERTEX_UNIFORM_BLOCKS } - { reuse GL_MAX_FRAGMENT_UNIFORM_BLOCKS } - { reuse GL_MAX_COMBINED_UNIFORM_BLOCKS } - { reuse GL_MAX_UNIFORM_BUFFER_BINDINGS } - { reuse GL_MAX_UNIFORM_BLOCK_SIZE } - { reuse GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS } - { reuse GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS } - { reuse GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT } - { reuse GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH } - { reuse GL_ACTIVE_UNIFORM_BLOCKS } - { reuse GL_UNIFORM_TYPE } - { reuse GL_UNIFORM_SIZE } - { reuse GL_UNIFORM_NAME_LENGTH } - { reuse GL_UNIFORM_BLOCK_INDEX } - { reuse GL_UNIFORM_OFFSET } - { reuse GL_UNIFORM_ARRAY_STRIDE } - { reuse GL_UNIFORM_MATRIX_STRIDE } - { reuse GL_UNIFORM_IS_ROW_MAJOR } - { reuse GL_UNIFORM_BLOCK_BINDING } - { reuse GL_UNIFORM_BLOCK_DATA_SIZE } - { reuse GL_UNIFORM_BLOCK_NAME_LENGTH } - { reuse GL_UNIFORM_BLOCK_ACTIVE_UNIFORMS } - { reuse GL_UNIFORM_BLOCK_ACTIVE_UNIFORM_INDICES } - { reuse GL_UNIFORM_BLOCK_REFERENCED_BY_VERTEX_SHADER } - { reuse GL_UNIFORM_BLOCK_REFERENCED_BY_FRAGMENT_SHADER } - { reuse GL_INVALID_INDEX } - - // GL_VERSION_3_2 - GL_CONTEXT_CORE_PROFILE_BIT = $00000001; - GL_CONTEXT_COMPATIBILITY_PROFILE_BIT = $00000002; - GL_LINES_ADJACENCY = $000A; - GL_LINE_STRIP_ADJACENCY = $000B; - GL_TRIANGLES_ADJACENCY = $000C; - GL_TRIANGLE_STRIP_ADJACENCY = $000D; - GL_PROGRAM_POINT_SIZE = $8642; - GL_MAX_GEOMETRY_TEXTURE_IMAGE_UNITS = $8C29; - GL_FRAMEBUFFER_ATTACHMENT_LAYERED = $8DA7; - GL_FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS = $8DA8; - GL_GEOMETRY_SHADER = $8DD9; - GL_GEOMETRY_VERTICES_OUT = $8916; - GL_GEOMETRY_INPUT_TYPE = $8917; - GL_GEOMETRY_OUTPUT_TYPE = $8918; - GL_MAX_GEOMETRY_UNIFORM_COMPONENTS = $8DDF; - GL_MAX_GEOMETRY_OUTPUT_VERTICES = $8DE0; - GL_MAX_GEOMETRY_TOTAL_OUTPUT_COMPONENTS = $8DE1; - GL_MAX_VERTEX_OUTPUT_COMPONENTS = $9122; - GL_MAX_GEOMETRY_INPUT_COMPONENTS = $9123; - GL_MAX_GEOMETRY_OUTPUT_COMPONENTS = $9124; - GL_MAX_FRAGMENT_INPUT_COMPONENTS = $9125; - GL_CONTEXT_PROFILE_MASK = $9126; - { reuse GL_MAX_VARYING_COMPONENTS } - { reuse GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER } - { Reuse tokens from ARB_depth_clamp } - { reuse GL_DEPTH_CLAMP } - { Reuse tokens from ARB_draw_elements_base_vertex (none) } - { Reuse tokens from ARB_fragment_coord_conventions (none) } - { Reuse tokens from ARB_provoking_vertex } - { reuse GL_QUADS_FOLLOW_PROVOKING_VERTEX_CONVENTION } - { reuse GL_FIRST_VERTEX_CONVENTION } - { reuse GL_LAST_VERTEX_CONVENTION } - { reuse GL_PROVOKING_VERTEX } - { Reuse tokens from ARB_seamless_cube_map } - { reuse GL_TEXTURE_CUBE_MAP_SEAMLESS } - { Reuse tokens from ARB_sync } - { reuse GL_MAX_SERVER_WAIT_TIMEOUT } - { reuse GL_OBJECT_TYPE } - { reuse GL_SYNC_CONDITION } - { reuse GL_SYNC_STATUS } - { reuse GL_SYNC_FLAGS } - { reuse GL_SYNC_FENCE } - { reuse GL_SYNC_GPU_COMMANDS_COMPLETE } - { reuse GL_UNSIGNALED } - { reuse GL_SIGNALED } - { reuse GL_ALREADY_SIGNALED } - { reuse GL_TIMEOUT_EXPIRED } - { reuse GL_CONDITION_SATISFIED } - { reuse GL_WAIT_FAILED } - { reuse GL_TIMEOUT_IGNORED } - { reuse GL_SYNC_FLUSH_COMMANDS_BIT } - { reuse GL_TIMEOUT_IGNORED } - { Reuse tokens from ARB_texture_multisample } - { reuse GL_SAMPLE_POSITION } - { reuse GL_SAMPLE_MASK } - { reuse GL_SAMPLE_MASK_VALUE } - { reuse GL_MAX_SAMPLE_MASK_WORDS } - { reuse GL_TEXTURE_2D_MULTISAMPLE } - { reuse GL_PROXY_TEXTURE_2D_MULTISAMPLE } - { reuse GL_TEXTURE_2D_MULTISAMPLE_ARRAY } - { reuse GL_PROXY_TEXTURE_2D_MULTISAMPLE_ARRAY } - { reuse GL_TEXTURE_BINDING_2D_MULTISAMPLE } - { reuse GL_TEXTURE_BINDING_2D_MULTISAMPLE_ARRAY } - { reuse GL_TEXTURE_SAMPLES } - { reuse GL_TEXTURE_FIXED_SAMPLE_LOCATIONS } - { reuse GL_SAMPLER_2D_MULTISAMPLE } - { reuse GL_INT_SAMPLER_2D_MULTISAMPLE } - { reuse GL_UNSIGNED_INT_SAMPLER_2D_MULTISAMPLE } - { reuse GL_SAMPLER_2D_MULTISAMPLE_ARRAY } - { reuse GL_INT_SAMPLER_2D_MULTISAMPLE_ARRAY } - { reuse GL_UNSIGNED_INT_SAMPLER_2D_MULTISAMPLE_ARRAY } - { reuse GL_MAX_COLOR_TEXTURE_SAMPLES } - { reuse GL_MAX_DEPTH_TEXTURE_SAMPLES } - { reuse GL_MAX_INTEGER_SAMPLES } - { Don't need to reuse tokens from ARB_vertex_array_bgra since they're already in 1.2 core } - - // GL_VERSION_3_3 - GL_VERTEX_ATTRIB_ARRAY_DIVISOR = $88FE; - { Reuse tokens from ARB_blend_func_extended } - { reuse GL_SRC1_COLOR } - { reuse GL_ONE_MINUS_SRC1_COLOR } - { reuse GL_ONE_MINUS_SRC1_ALPHA } - { reuse GL_MAX_DUAL_SOURCE_DRAW_BUFFERS } - { Reuse tokens from ARB_explicit_attrib_location (none) } - { Reuse tokens from ARB_occlusion_query2 } - { reuse GL_ANY_SAMPLES_PASSED } - { Reuse tokens from ARB_sampler_objects } - { reuse GL_SAMPLER_BINDING } - { Reuse tokens from ARB_shader_bit_encoding (none) } - { Reuse tokens from ARB_texture_rgb10_a2ui } - { reuse GL_RGB10_A2UI } - { Reuse tokens from ARB_texture_swizzle } - { reuse GL_TEXTURE_SWIZZLE_R } - { reuse GL_TEXTURE_SWIZZLE_G } - { reuse GL_TEXTURE_SWIZZLE_B } - { reuse GL_TEXTURE_SWIZZLE_A } - { reuse GL_TEXTURE_SWIZZLE_RGBA } - { Reuse tokens from ARB_timer_query } - { reuse GL_TIME_ELAPSED } - { reuse GL_TIMESTAMP } - { Reuse tokens from ARB_vertex_type_2_10_10_10_rev } - { reuse GL_INT_2_10_10_10_REV } - - // GL_VERSION_4_0 - GL_SAMPLE_SHADING = $8C36; - GL_MIN_SAMPLE_SHADING_VALUE = $8C37; - GL_MIN_PROGRAM_TEXTURE_GATHER_OFFSET = $8E5E; - GL_MAX_PROGRAM_TEXTURE_GATHER_OFFSET = $8E5F; - GL_TEXTURE_CUBE_MAP_ARRAY = $9009; - GL_TEXTURE_BINDING_CUBE_MAP_ARRAY = $900A; - GL_PROXY_TEXTURE_CUBE_MAP_ARRAY = $900B; - GL_SAMPLER_CUBE_MAP_ARRAY = $900C; - GL_SAMPLER_CUBE_MAP_ARRAY_SHADOW = $900D; - GL_INT_SAMPLER_CUBE_MAP_ARRAY = $900E; - GL_UNSIGNED_INT_SAMPLER_CUBE_MAP_ARRAY = $900F; - { Reuse tokens from ARB_texture_query_lod (none) } - { Reuse tokens from ARB_draw_buffers_blend (none) } - { Reuse tokens from ARB_draw_indirect } - { reuse GL_DRAW_INDIRECT_BUFFER } - { reuse GL_DRAW_INDIRECT_BUFFER_BINDING } - { Reuse tokens from ARB_gpu_shader5 } - { reuse GL_GEOMETRY_SHADER_INVOCATIONS } - { reuse GL_MAX_GEOMETRY_SHADER_INVOCATIONS } - { reuse GL_MIN_FRAGMENT_INTERPOLATION_OFFSET } - { reuse GL_MAX_FRAGMENT_INTERPOLATION_OFFSET } - { reuse GL_FRAGMENT_INTERPOLATION_OFFSET_BITS } - { reuse GL_MAX_VERTEX_STREAMS } - { Reuse tokens from ARB_gpu_shader_fp64 } - { reuse GL_DOUBLE_VEC2 } - { reuse GL_DOUBLE_VEC3 } - { reuse GL_DOUBLE_VEC4 } - { reuse GL_DOUBLE_MAT2 } - { reuse GL_DOUBLE_MAT3 } - { reuse GL_DOUBLE_MAT4 } - { reuse GL_DOUBLE_MAT2x3 } - { reuse GL_DOUBLE_MAT2x4 } - { reuse GL_DOUBLE_MAT3x2 } - { reuse GL_DOUBLE_MAT3x4 } - { reuse GL_DOUBLE_MAT4x2 } - { reuse GL_DOUBLE_MAT4x3 } - { Reuse tokens from ARB_shader_subroutine } - { reuse GL_ACTIVE_SUBROUTINES } - { reuse GL_ACTIVE_SUBROUTINE_UNIFORMS } - { reuse GL_ACTIVE_SUBROUTINE_UNIFORM_LOCATIONS } - { reuse GL_ACTIVE_SUBROUTINE_MAX_LENGTH } - { reuse GL_ACTIVE_SUBROUTINE_UNIFORM_MAX_LENGTH } - { reuse GL_MAX_SUBROUTINES } - { reuse GL_MAX_SUBROUTINE_UNIFORM_LOCATIONS } - { reuse GL_NUM_COMPATIBLE_SUBROUTINES } - { reuse GL_COMPATIBLE_SUBROUTINES } - { Reuse tokens from ARB_tessellation_shader } - { reuse GL_PATCHES } - { reuse GL_PATCH_VERTICES } - { reuse GL_PATCH_DEFAULT_INNER_LEVEL } - { reuse GL_PATCH_DEFAULT_OUTER_LEVEL } - { reuse GL_TESS_CONTROL_OUTPUT_VERTICES } - { reuse GL_TESS_GEN_MODE } - { reuse GL_TESS_GEN_SPACING } - { reuse GL_TESS_GEN_VERTEX_ORDER } - { reuse GL_TESS_GEN_POINT_MODE } - { reuse GL_ISOLINES } - { reuse GL_FRACTIONAL_ODD } - { reuse GL_FRACTIONAL_EVEN } - { reuse GL_MAX_PATCH_VERTICES } - { reuse GL_MAX_TESS_GEN_LEVEL } - { reuse GL_MAX_TESS_CONTROL_UNIFORM_COMPONENTS } - { reuse GL_MAX_TESS_EVALUATION_UNIFORM_COMPONENTS } - { reuse GL_MAX_TESS_CONTROL_TEXTURE_IMAGE_UNITS } - { reuse GL_MAX_TESS_EVALUATION_TEXTURE_IMAGE_UNITS } - { reuse GL_MAX_TESS_CONTROL_OUTPUT_COMPONENTS } - { reuse GL_MAX_TESS_PATCH_COMPONENTS } - { reuse GL_MAX_TESS_CONTROL_TOTAL_OUTPUT_COMPONENTS } - { reuse GL_MAX_TESS_EVALUATION_OUTPUT_COMPONENTS } - { reuse GL_MAX_TESS_CONTROL_UNIFORM_BLOCKS } - { reuse GL_MAX_TESS_EVALUATION_UNIFORM_BLOCKS } - { reuse GL_MAX_TESS_CONTROL_INPUT_COMPONENTS } - { reuse GL_MAX_TESS_EVALUATION_INPUT_COMPONENTS } - { reuse GL_MAX_COMBINED_TESS_CONTROL_UNIFORM_COMPONENTS } - { reuse GL_MAX_COMBINED_TESS_EVALUATION_UNIFORM_COMPONENTS } - { reuse GL_UNIFORM_BLOCK_REFERENCED_BY_TESS_CONTROL_SHADER } - { reuse GL_UNIFORM_BLOCK_REFERENCED_BY_TESS_EVALUATION_SHADER } - { reuse GL_TESS_EVALUATION_SHADER } - { reuse GL_TESS_CONTROL_SHADER } - { Reuse tokens from ARB_texture_buffer_object_rgb32 (none) } - { Reuse tokens from ARB_transform_feedback2 } - { reuse GL_TRANSFORM_FEEDBACK } - { reuse GL_TRANSFORM_FEEDBACK_BUFFER_PAUSED } - { reuse GL_TRANSFORM_FEEDBACK_BUFFER_ACTIVE } - { reuse GL_TRANSFORM_FEEDBACK_BINDING } - { Reuse tokens from ARB_transform_feedback3 } - { reuse GL_MAX_TRANSFORM_FEEDBACK_BUFFERS } - { reuse GL_MAX_VERTEX_STREAMS } - - // GL_VERSION_4_1 - { Reuse tokens from ARB_ES2_compatibility } - { reuse GL_FIXED } - { reuse GL_IMPLEMENTATION_COLOR_READ_TYPE } - { reuse GL_IMPLEMENTATION_COLOR_READ_FORMAT } - { reuse GL_LOW_FLOAT } - { reuse GL_MEDIUM_FLOAT } - { reuse GL_HIGH_FLOAT } - { reuse GL_LOW_INT } - { reuse GL_MEDIUM_INT } - { reuse GL_HIGH_INT } - { reuse GL_SHADER_COMPILER } - { reuse GL_NUM_SHADER_BINARY_FORMATS } - { reuse GL_MAX_VERTEX_UNIFORM_VECTORS } - { reuse GL_MAX_VARYING_VECTORS } - { reuse GL_MAX_FRAGMENT_UNIFORM_VECTORS } - { reuse GL_RGB565 } - { Reuse tokens from ARB_get_program_binary } - { reuse GL_PROGRAM_BINARY_RETRIEVABLE_HINT } - { reuse GL_PROGRAM_BINARY_LENGTH } - { reuse GL_NUM_PROGRAM_BINARY_FORMATS } - { reuse GL_PROGRAM_BINARY_FORMATS } - { Reuse tokens from ARB_separate_shader_objects } - { reuse GL_VERTEX_SHADER_BIT } - { reuse GL_FRAGMENT_SHADER_BIT } - { reuse GL_GEOMETRY_SHADER_BIT } - { reuse GL_TESS_CONTROL_SHADER_BIT } - { reuse GL_TESS_EVALUATION_SHADER_BIT } - { reuse GL_ALL_SHADER_BITS } - { reuse GL_PROGRAM_SEPARABLE } - { reuse GL_ACTIVE_PROGRAM } - { reuse GL_PROGRAM_PIPELINE_BINDING } - { Reuse tokens from ARB_shader_precision (none) } - { Reuse tokens from ARB_vertex_attrib_64bit - all are in GL 3.0 and 4.0 already } - { Reuse tokens from ARB_viewport_array - some are in GL 1.1 and ARB_provoking_vertex already } - { reuse GL_MAX_VIEWPORTS } - { reuse GL_VIEWPORT_SUBPIXEL_BITS } - { reuse GL_VIEWPORT_BOUNDS_RANGE } - { reuse GL_LAYER_PROVOKING_VERTEX } - { reuse GL_VIEWPORT_INDEX_PROVOKING_VERTEX } - { reuse GL_UNDEFINED_VERTEX } - - // GL_VERSION_4_2 - { Reuse tokens from ARB_base_instance (none) } - { Reuse tokens from ARB_shading_language_420pack (none) } - { Reuse tokens from ARB_transform_feedback_instanced (none) } - { Reuse tokens from ARB_compressed_texture_pixel_storage } - { reuse GL_UNPACK_COMPRESSED_BLOCK_WIDTH } - { reuse GL_UNPACK_COMPRESSED_BLOCK_HEIGHT } - { reuse GL_UNPACK_COMPRESSED_BLOCK_DEPTH } - { reuse GL_UNPACK_COMPRESSED_BLOCK_SIZE } - { reuse GL_PACK_COMPRESSED_BLOCK_WIDTH } - { reuse GL_PACK_COMPRESSED_BLOCK_HEIGHT } - { reuse GL_PACK_COMPRESSED_BLOCK_DEPTH } - { reuse GL_PACK_COMPRESSED_BLOCK_SIZE } - { Reuse tokens from ARB_conservative_depth (none) } - { Reuse tokens from ARB_internalformat_query } - { reuse GL_NUM_SAMPLE_COUNTS } - { Reuse tokens from ARB_map_buffer_alignment } - { reuse GL_MIN_MAP_BUFFER_ALIGNMENT } - { Reuse tokens from ARB_shader_atomic_counters } - { reuse GL_ATOMIC_COUNTER_BUFFER } - { reuse GL_ATOMIC_COUNTER_BUFFER_BINDING } - { reuse GL_ATOMIC_COUNTER_BUFFER_START } - { reuse GL_ATOMIC_COUNTER_BUFFER_SIZE } - { reuse GL_ATOMIC_COUNTER_BUFFER_DATA_SIZE } - { reuse GL_ATOMIC_COUNTER_BUFFER_ACTIVE_ATOMIC_COUNTERS } - { reuse GL_ATOMIC_COUNTER_BUFFER_ACTIVE_ATOMIC_COUNTER_INDICES } - { reuse GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_VERTEX_SHADER } - { reuse GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_TESS_CONTROL_SHADER } - { reuse GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_TESS_EVALUATION_SHADER } - { reuse GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_GEOMETRY_SHADER } - { reuse GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_FRAGMENT_SHADER } - { reuse GL_MAX_VERTEX_ATOMIC_COUNTER_BUFFERS } - { reuse GL_MAX_TESS_CONTROL_ATOMIC_COUNTER_BUFFERS } - { reuse GL_MAX_TESS_EVALUATION_ATOMIC_COUNTER_BUFFERS } - { reuse GL_MAX_GEOMETRY_ATOMIC_COUNTER_BUFFERS } - { reuse GL_MAX_FRAGMENT_ATOMIC_COUNTER_BUFFERS } - { reuse GL_MAX_COMBINED_ATOMIC_COUNTER_BUFFERS } - { reuse GL_MAX_VERTEX_ATOMIC_COUNTERS } - { reuse GL_MAX_TESS_CONTROL_ATOMIC_COUNTERS } - { reuse GL_MAX_TESS_EVALUATION_ATOMIC_COUNTERS } - { reuse GL_MAX_GEOMETRY_ATOMIC_COUNTERS } - { reuse GL_MAX_FRAGMENT_ATOMIC_COUNTERS } - { reuse GL_MAX_COMBINED_ATOMIC_COUNTERS } - { reuse GL_MAX_ATOMIC_COUNTER_BUFFER_SIZE } - { reuse GL_MAX_ATOMIC_COUNTER_BUFFER_BINDINGS } - { reuse GL_ACTIVE_ATOMIC_COUNTER_BUFFERS } - { reuse GL_UNIFORM_ATOMIC_COUNTER_BUFFER_INDEX } - { reuse GL_UNSIGNED_INT_ATOMIC_COUNTER } - { Reuse tokens from ARB_shader_image_load_store } - { reuse GL_VERTEX_ATTRIB_ARRAY_BARRIER_BIT } - { reuse GL_ELEMENT_ARRAY_BARRIER_BIT } - { reuse GL_UNIFORM_BARRIER_BIT } - { reuse GL_TEXTURE_FETCH_BARRIER_BIT } - { reuse GL_SHADER_IMAGE_ACCESS_BARRIER_BIT } - { reuse GL_COMMAND_BARRIER_BIT } - { reuse GL_PIXEL_BUFFER_BARRIER_BIT } - { reuse GL_TEXTURE_UPDATE_BARRIER_BIT } - { reuse GL_BUFFER_UPDATE_BARRIER_BIT } - { reuse GL_FRAMEBUFFER_BARRIER_BIT } - { reuse GL_TRANSFORM_FEEDBACK_BARRIER_BIT } - { reuse GL_ATOMIC_COUNTER_BARRIER_BIT } - { reuse GL_ALL_BARRIER_BITS } - { reuse GL_MAX_IMAGE_UNITS } - { reuse GL_MAX_COMBINED_IMAGE_UNITS_AND_FRAGMENT_OUTPUTS } - { reuse GL_IMAGE_BINDING_NAME } - { reuse GL_IMAGE_BINDING_LEVEL } - { reuse GL_IMAGE_BINDING_LAYERED } - { reuse GL_IMAGE_BINDING_LAYER } - { reuse GL_IMAGE_BINDING_ACCESS } - { reuse GL_IMAGE_1D } - { reuse GL_IMAGE_2D } - { reuse GL_IMAGE_3D } - { reuse GL_IMAGE_2D_RECT } - { reuse GL_IMAGE_CUBE } - { reuse GL_IMAGE_BUFFER } - { reuse GL_IMAGE_1D_ARRAY } - { reuse GL_IMAGE_2D_ARRAY } - { reuse GL_IMAGE_CUBE_MAP_ARRAY } - { reuse GL_IMAGE_2D_MULTISAMPLE } - { reuse GL_IMAGE_2D_MULTISAMPLE_ARRAY } - { reuse GL_INT_IMAGE_1D } - { reuse GL_INT_IMAGE_2D } - { reuse GL_INT_IMAGE_3D } - { reuse GL_INT_IMAGE_2D_RECT } - { reuse GL_INT_IMAGE_CUBE } - { reuse GL_INT_IMAGE_BUFFER } - { reuse GL_INT_IMAGE_1D_ARRAY } - { reuse GL_INT_IMAGE_2D_ARRAY } - { reuse GL_INT_IMAGE_CUBE_MAP_ARRAY } - { reuse GL_INT_IMAGE_2D_MULTISAMPLE } - { reuse GL_INT_IMAGE_2D_MULTISAMPLE_ARRAY } - { reuse GL_UNSIGNED_INT_IMAGE_1D } - { reuse GL_UNSIGNED_INT_IMAGE_2D } - { reuse GL_UNSIGNED_INT_IMAGE_3D } - { reuse GL_UNSIGNED_INT_IMAGE_2D_RECT } - { reuse GL_UNSIGNED_INT_IMAGE_CUBE } - { reuse GL_UNSIGNED_INT_IMAGE_BUFFER } - { reuse GL_UNSIGNED_INT_IMAGE_1D_ARRAY } - { reuse GL_UNSIGNED_INT_IMAGE_2D_ARRAY } - { reuse GL_UNSIGNED_INT_IMAGE_CUBE_MAP_ARRAY } - { reuse GL_UNSIGNED_INT_IMAGE_2D_MULTISAMPLE } - { reuse GL_UNSIGNED_INT_IMAGE_2D_MULTISAMPLE_ARRAY } - { reuse GL_MAX_IMAGE_SAMPLES } - { reuse GL_IMAGE_BINDING_FORMAT } - { reuse GL_IMAGE_FORMAT_COMPATIBILITY_TYPE } - { reuse GL_IMAGE_FORMAT_COMPATIBILITY_BY_SIZE } - { reuse GL_IMAGE_FORMAT_COMPATIBILITY_BY_CLASS } - { reuse GL_MAX_VERTEX_IMAGE_UNIFORMS } - { reuse GL_MAX_TESS_CONTROL_IMAGE_UNIFORMS } - { reuse GL_MAX_TESS_EVALUATION_IMAGE_UNIFORMS } - { reuse GL_MAX_GEOMETRY_IMAGE_UNIFORMS } - { reuse GL_MAX_FRAGMENT_IMAGE_UNIFORMS } - { reuse GL_MAX_COMBINED_IMAGE_UNIFORMS } - { Reuse tokens from ARB_shading_language_packing (none) } - { Reuse tokens from ARB_texture_storage } - { reuse GL_TEXTURE_IMMUTABLE_FORMAT } - - // GL_VERSION_4_3 - GL_NUM_SHADING_LANGUAGE_VERSIONS = $82E9; - GL_VERTEX_ATTRIB_ARRAY_LONG = $874E; - { Reuse tokens from ARB_arrays_of_arrays (none, GLSL only) } - { Reuse tokens from ARB_fragment_layer_viewport (none, GLSL only) } - { Reuse tokens from ARB_shader_image_size (none, GLSL only) } - { Reuse tokens from ARB_ES3_compatibility } - { reuse GL_COMPRESSED_RGB8_ETC2 } - { reuse GL_COMPRESSED_SRGB8_ETC2 } - { reuse GL_COMPRESSED_RGB8_PUNCHTHROUGH_ALPHA1_ETC2 } - { reuse GL_COMPRESSED_SRGB8_PUNCHTHROUGH_ALPHA1_ETC2 } - { reuse GL_COMPRESSED_RGBA8_ETC2_EAC } - { reuse GL_COMPRESSED_SRGB8_ALPHA8_ETC2_EAC } - { reuse GL_COMPRESSED_R11_EAC } - { reuse GL_COMPRESSED_SIGNED_R11_EAC } - { reuse GL_COMPRESSED_RG11_EAC } - { reuse GL_COMPRESSED_SIGNED_RG11_EAC } - { reuse GL_PRIMITIVE_RESTART_FIXED_INDEX } - { reuse GL_ANY_SAMPLES_PASSED_CONSERVATIVE } - { reuse GL_MAX_ELEMENT_INDEX } - { Reuse tokens from ARB_clear_buffer_object (none) } - { Reuse tokens from ARB_compute_shader } - { reuse GL_COMPUTE_SHADER } - { reuse GL_MAX_COMPUTE_UNIFORM_BLOCKS } - { reuse GL_MAX_COMPUTE_TEXTURE_IMAGE_UNITS } - { reuse GL_MAX_COMPUTE_IMAGE_UNIFORMS } - { reuse GL_MAX_COMPUTE_SHARED_MEMORY_SIZE } - { reuse GL_MAX_COMPUTE_UNIFORM_COMPONENTS } - { reuse GL_MAX_COMPUTE_ATOMIC_COUNTER_BUFFERS } - { reuse GL_MAX_COMPUTE_ATOMIC_COUNTERS } - { reuse GL_MAX_COMBINED_COMPUTE_UNIFORM_COMPONENTS } - { reuse GL_MAX_COMPUTE_LOCAL_INVOCATIONS } - { reuse GL_MAX_COMPUTE_WORK_GROUP_COUNT } - { reuse GL_MAX_COMPUTE_WORK_GROUP_SIZE } - { reuse GL_COMPUTE_LOCAL_WORK_SIZE } - { reuse GL_UNIFORM_BLOCK_REFERENCED_BY_COMPUTE_SHADER } - { reuse GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_COMPUTE_SHADER } - { reuse GL_DISPATCH_INDIRECT_BUFFER } - { reuse GL_DISPATCH_INDIRECT_BUFFER_BINDING } - { Reuse tokens from ARB_copy_image (none) } - { Reuse tokens from KHR_debug } - { reuse GL_DEBUG_OUTPUT_SYNCHRONOUS } - { reuse GL_DEBUG_NEXT_LOGGED_MESSAGE_LENGTH } - { reuse GL_DEBUG_CALLBACK_FUNCTION } - { reuse GL_DEBUG_CALLBACK_USER_PARAM } - { reuse GL_DEBUG_SOURCE_API } - { reuse GL_DEBUG_SOURCE_WINDOW_SYSTEM } - { reuse GL_DEBUG_SOURCE_SHADER_COMPILER } - { reuse GL_DEBUG_SOURCE_THIRD_PARTY } - { reuse GL_DEBUG_SOURCE_APPLICATION } - { reuse GL_DEBUG_SOURCE_OTHER } - { reuse GL_DEBUG_TYPE_ERROR } - { reuse GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR } - { reuse GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR } - { reuse GL_DEBUG_TYPE_PORTABILITY } - { reuse GL_DEBUG_TYPE_PERFORMANCE } - { reuse GL_DEBUG_TYPE_OTHER } - { reuse GL_MAX_DEBUG_MESSAGE_LENGTH } - { reuse GL_MAX_DEBUG_LOGGED_MESSAGES } - { reuse GL_DEBUG_LOGGED_MESSAGES } - { reuse GL_DEBUG_SEVERITY_HIGH } - { reuse GL_DEBUG_SEVERITY_MEDIUM } - { reuse GL_DEBUG_SEVERITY_LOW } - { reuse GL_DEBUG_TYPE_MARKER } - { reuse GL_DEBUG_TYPE_PUSH_GROUP } - { reuse GL_DEBUG_TYPE_POP_GROUP } - { reuse GL_DEBUG_SEVERITY_NOTIFICATION } - { reuse GL_MAX_DEBUG_GROUP_STACK_DEPTH } - { reuse GL_DEBUG_GROUP_STACK_DEPTH } - { reuse GL_BUFFER } - { reuse GL_SHADER } - { reuse GL_PROGRAM } - { reuse GL_QUERY } - { reuse GL_PROGRAM_PIPELINE } - { reuse GL_SAMPLER } - { reuse GL_DISPLAY_LIST } - { reuse GL_MAX_LABEL_LENGTH } - { reuse GL_DEBUG_OUTPUT } - { reuse GL_CONTEXT_FLAG_DEBUG_BIT } - { reuse GL_STACK_UNDERFLOW } - { reuse GL_STACK_OVERFLOW } - { Reuse tokens from ARB_explicit_uniform_location } - { reuse GL_MAX_UNIFORM_LOCATIONS } - { Reuse tokens from ARB_framebuffer_no_attachments } - { reuse GL_FRAMEBUFFER_DEFAULT_WIDTH } - { reuse GL_FRAMEBUFFER_DEFAULT_HEIGHT } - { reuse GL_FRAMEBUFFER_DEFAULT_LAYERS } - { reuse GL_FRAMEBUFFER_DEFAULT_SAMPLES } - { reuse GL_FRAMEBUFFER_DEFAULT_FIXED_SAMPLE_LOCATIONS } - { reuse GL_MAX_FRAMEBUFFER_WIDTH } - { reuse GL_MAX_FRAMEBUFFER_HEIGHT } - { reuse GL_MAX_FRAMEBUFFER_LAYERS } - { reuse GL_MAX_FRAMEBUFFER_SAMPLES } - { Reuse tokens from ARB_internalformat_query2 } - { reuse GL_INTERNALFORMAT_SUPPORTED } - { reuse GL_INTERNALFORMAT_PREFERRED } - { reuse GL_INTERNALFORMAT_RED_SIZE } - { reuse GL_INTERNALFORMAT_GREEN_SIZE } - { reuse GL_INTERNALFORMAT_BLUE_SIZE } - { reuse GL_INTERNALFORMAT_ALPHA_SIZE } - { reuse GL_INTERNALFORMAT_DEPTH_SIZE } - { reuse GL_INTERNALFORMAT_STENCIL_SIZE } - { reuse GL_INTERNALFORMAT_SHARED_SIZE } - { reuse GL_INTERNALFORMAT_RED_TYPE } - { reuse GL_INTERNALFORMAT_GREEN_TYPE } - { reuse GL_INTERNALFORMAT_BLUE_TYPE } - { reuse GL_INTERNALFORMAT_ALPHA_TYPE } - { reuse GL_INTERNALFORMAT_DEPTH_TYPE } - { reuse GL_INTERNALFORMAT_STENCIL_TYPE } - { reuse GL_MAX_WIDTH } - { reuse GL_MAX_HEIGHT } - { reuse GL_MAX_DEPTH } - { reuse GL_MAX_LAYERS } - { reuse GL_MAX_COMBINED_DIMENSIONS } - { reuse GL_COLOR_COMPONENTS } - { reuse GL_DEPTH_COMPONENTS } - { reuse GL_STENCIL_COMPONENTS } - { reuse GL_COLOR_RENDERABLE } - { reuse GL_DEPTH_RENDERABLE } - { reuse GL_STENCIL_RENDERABLE } - { reuse GL_FRAMEBUFFER_RENDERABLE } - { reuse GL_FRAMEBUFFER_RENDERABLE_LAYERED } - { reuse GL_FRAMEBUFFER_BLEND } - { reuse GL_READ_PIXELS } - { reuse GL_READ_PIXELS_FORMAT } - { reuse GL_READ_PIXELS_TYPE } - { reuse GL_TEXTURE_IMAGE_FORMAT } - { reuse GL_TEXTURE_IMAGE_TYPE } - { reuse GL_GET_TEXTURE_IMAGE_FORMAT } - { reuse GL_GET_TEXTURE_IMAGE_TYPE } - { reuse GL_MIPMAP } - { reuse GL_MANUAL_GENERATE_MIPMAP } - { reuse GL_AUTO_GENERATE_MIPMAP } - { reuse GL_COLOR_ENCODING } - { reuse GL_SRGB_READ } - { reuse GL_SRGB_WRITE } - { reuse GL_FILTER } - { reuse GL_VERTEX_TEXTURE } - { reuse GL_TESS_CONTROL_TEXTURE } - { reuse GL_TESS_EVALUATION_TEXTURE } - { reuse GL_GEOMETRY_TEXTURE } - { reuse GL_FRAGMENT_TEXTURE } - { reuse GL_COMPUTE_TEXTURE } - { reuse GL_TEXTURE_SHADOW } - { reuse GL_TEXTURE_GATHER } - { reuse GL_TEXTURE_GATHER_SHADOW } - { reuse GL_SHADER_IMAGE_LOAD } - { reuse GL_SHADER_IMAGE_STORE } - { reuse GL_SHADER_IMAGE_ATOMIC } - { reuse GL_IMAGE_TEXEL_SIZE } - { reuse GL_IMAGE_COMPATIBILITY_CLASS } - { reuse GL_IMAGE_PIXEL_FORMAT } - { reuse GL_IMAGE_PIXEL_TYPE } - { reuse GL_SIMULTANEOUS_TEXTURE_AND_DEPTH_TEST } - { reuse GL_SIMULTANEOUS_TEXTURE_AND_STENCIL_TEST } - { reuse GL_SIMULTANEOUS_TEXTURE_AND_DEPTH_WRITE } - { reuse GL_SIMULTANEOUS_TEXTURE_AND_STENCIL_WRITE } - { reuse GL_TEXTURE_COMPRESSED_BLOCK_WIDTH } - { reuse GL_TEXTURE_COMPRESSED_BLOCK_HEIGHT } - { reuse GL_TEXTURE_COMPRESSED_BLOCK_SIZE } - { reuse GL_CLEAR_BUFFER } - { reuse GL_TEXTURE_VIEW } - { reuse GL_VIEW_COMPATIBILITY_CLASS } - { reuse GL_FULL_SUPPORT } - { reuse GL_CAVEAT_SUPPORT } - { reuse GL_IMAGE_CLASS_4_X_32 } - { reuse GL_IMAGE_CLASS_2_X_32 } - { reuse GL_IMAGE_CLASS_1_X_32 } - { reuse GL_IMAGE_CLASS_4_X_16 } - { reuse GL_IMAGE_CLASS_2_X_16 } - { reuse GL_IMAGE_CLASS_1_X_16 } - { reuse GL_IMAGE_CLASS_4_X_8 } - { reuse GL_IMAGE_CLASS_2_X_8 } - { reuse GL_IMAGE_CLASS_1_X_8 } - { reuse GL_IMAGE_CLASS_11_11_10 } - { reuse GL_IMAGE_CLASS_10_10_10_2 } - { reuse GL_VIEW_CLASS_128_BITS } - { reuse GL_VIEW_CLASS_96_BITS } - { reuse GL_VIEW_CLASS_64_BITS } - { reuse GL_VIEW_CLASS_48_BITS } - { reuse GL_VIEW_CLASS_32_BITS } - { reuse GL_VIEW_CLASS_24_BITS } - { reuse GL_VIEW_CLASS_16_BITS } - { reuse GL_VIEW_CLASS_8_BITS } - { reuse GL_VIEW_CLASS_S3TC_DXT1_RGB } - { reuse GL_VIEW_CLASS_S3TC_DXT1_RGBA } - { reuse GL_VIEW_CLASS_S3TC_DXT3_RGBA } - { reuse GL_VIEW_CLASS_S3TC_DXT5_RGBA } - { reuse GL_VIEW_CLASS_RGTC1_RED } - { reuse GL_VIEW_CLASS_RGTC2_RG } - { reuse GL_VIEW_CLASS_BPTC_UNORM } - { reuse GL_VIEW_CLASS_BPTC_FLOAT } - { Reuse tokens from ARB_invalidate_subdata (none) } - { Reuse tokens from ARB_multi_draw_indirect (none) } - { Reuse tokens from ARB_program_interface_query } - { reuse GL_UNIFORM } - { reuse GL_UNIFORM_BLOCK } - { reuse GL_PROGRAM_INPUT } - { reuse GL_PROGRAM_OUTPUT } - { reuse GL_BUFFER_VARIABLE } - { reuse GL_SHADER_STORAGE_BLOCK } - { reuse GL_VERTEX_SUBROUTINE } - { reuse GL_TESS_CONTROL_SUBROUTINE } - { reuse GL_TESS_EVALUATION_SUBROUTINE } - { reuse GL_GEOMETRY_SUBROUTINE } - { reuse GL_FRAGMENT_SUBROUTINE } - { reuse GL_COMPUTE_SUBROUTINE } - { reuse GL_VERTEX_SUBROUTINE_UNIFORM } - { reuse GL_TESS_CONTROL_SUBROUTINE_UNIFORM } - { reuse GL_TESS_EVALUATION_SUBROUTINE_UNIFORM } - { reuse GL_GEOMETRY_SUBROUTINE_UNIFORM } - { reuse GL_FRAGMENT_SUBROUTINE_UNIFORM } - { reuse GL_COMPUTE_SUBROUTINE_UNIFORM } - { reuse GL_TRANSFORM_FEEDBACK_VARYING } - { reuse GL_ACTIVE_RESOURCES } - { reuse GL_MAX_NAME_LENGTH } - { reuse GL_MAX_NUM_ACTIVE_VARIABLES } - { reuse GL_MAX_NUM_COMPATIBLE_SUBROUTINES } - { reuse GL_NAME_LENGTH } - { reuse GL_TYPE } - { reuse GL_ARRAY_SIZE } - { reuse GL_OFFSET } - { reuse GL_BLOCK_INDEX } - { reuse GL_ARRAY_STRIDE } - { reuse GL_MATRIX_STRIDE } - { reuse GL_IS_ROW_MAJOR } - { reuse GL_ATOMIC_COUNTER_BUFFER_INDEX } - { reuse GL_BUFFER_BINDING } - { reuse GL_BUFFER_DATA_SIZE } - { reuse GL_NUM_ACTIVE_VARIABLES } - { reuse GL_ACTIVE_VARIABLES } - { reuse GL_REFERENCED_BY_VERTEX_SHADER } - { reuse GL_REFERENCED_BY_TESS_CONTROL_SHADER } - { reuse GL_REFERENCED_BY_TESS_EVALUATION_SHADER } - { reuse GL_REFERENCED_BY_GEOMETRY_SHADER } - { reuse GL_REFERENCED_BY_FRAGMENT_SHADER } - { reuse GL_REFERENCED_BY_COMPUTE_SHADER } - { reuse GL_TOP_LEVEL_ARRAY_SIZE } - { reuse GL_TOP_LEVEL_ARRAY_STRIDE } - { reuse GL_LOCATION } - { reuse GL_LOCATION_INDEX } - { reuse GL_IS_PER_PATCH } - { Reuse tokens from ARB_robust_buffer_access_behavior (none) } - { Reuse tokens from ARB_shader_storage_buffer_object } - { reuse GL_SHADER_STORAGE_BUFFER } - { reuse GL_SHADER_STORAGE_BUFFER_BINDING } - { reuse GL_SHADER_STORAGE_BUFFER_START } - { reuse GL_SHADER_STORAGE_BUFFER_SIZE } - { reuse GL_MAX_VERTEX_SHADER_STORAGE_BLOCKS } - { reuse GL_MAX_GEOMETRY_SHADER_STORAGE_BLOCKS } - { reuse GL_MAX_TESS_CONTROL_SHADER_STORAGE_BLOCKS } - { reuse GL_MAX_TESS_EVALUATION_SHADER_STORAGE_BLOCKS } - { reuse GL_MAX_FRAGMENT_SHADER_STORAGE_BLOCKS } - { reuse GL_MAX_COMPUTE_SHADER_STORAGE_BLOCKS } - { reuse GL_MAX_COMBINED_SHADER_STORAGE_BLOCKS } - { reuse GL_MAX_SHADER_STORAGE_BUFFER_BINDINGS } - { reuse GL_MAX_SHADER_STORAGE_BLOCK_SIZE } - { reuse GL_SHADER_STORAGE_BUFFER_OFFSET_ALIGNMENT } - { reuse GL_SHADER_STORAGE_BARRIER_BIT } - { reuse GL_MAX_COMBINED_SHADER_OUTPUT_RESOURCES } - { Reuse tokens from ARB_stencil_texturing } - { reuse GL_DEPTH_STENCIL_TEXTURE_MODE } - { Reuse tokens from ARB_texture_buffer_range } - { reuse GL_TEXTURE_BUFFER_OFFSET } - { reuse GL_TEXTURE_BUFFER_SIZE } - { reuse GL_TEXTURE_BUFFER_OFFSET_ALIGNMENT } - { Reuse tokens from ARB_texture_query_levels (none) } - { Reuse tokens from ARB_texture_storage_multisample (none) } - { Reuse tokens from ARB_texture_view } - { reuse GL_TEXTURE_VIEW_MIN_LEVEL } - { reuse GL_TEXTURE_VIEW_NUM_LEVELS } - { reuse GL_TEXTURE_VIEW_MIN_LAYER } - { reuse GL_TEXTURE_VIEW_NUM_LAYERS } - { reuse GL_TEXTURE_IMMUTABLE_LEVELS } - { Reuse tokens from ARB_vertex_attrib_binding } - { reuse GL_VERTEX_ATTRIB_BINDING } - { reuse GL_VERTEX_ATTRIB_RELATIVE_OFFSET } - { reuse GL_VERTEX_BINDING_DIVISOR } - { reuse GL_VERTEX_BINDING_OFFSET } - { reuse GL_VERTEX_BINDING_STRIDE } - { reuse GL_MAX_VERTEX_ATTRIB_RELATIVE_OFFSET } - { reuse GL_MAX_VERTEX_ATTRIB_BINDINGS } - - - // GL_3DFX_multisample - GL_MULTISAMPLE_3DFX = $86B2; - GL_SAMPLE_BUFFERS_3DFX = $86B3; - GL_SAMPLES_3DFX = $86B4; - GL_MULTISAMPLE_BIT_3DFX = $20000000; - - // GL_3DFX_texture_compression_FXT1 - GL_COMPRESSED_RGB_FXT1_3DFX = $86B0; - GL_COMPRESSED_RGBA_FXT1_3DFX = $86B1; - - // GL_APPLE_client_storage - GL_UNPACK_CLIENT_STORAGE_APPLE = $85B2; - - // GL_APPLE_element_array - GL_ELEMENT_ARRAY_APPLE = $8A0C; - GL_ELEMENT_ARRAY_TYPE_APPLE = $8A0D; - GL_ELEMENT_ARRAY_POINTER_APPLE = $8A0E; - - // GL_APPLE_fence - GL_DRAW_PIXELS_APPLE = $8A0A; - GL_FENCE_APPLE = $8A0B; - - // GL_APPLE_specular_vector - GL_LIGHT_MODEL_SPECULAR_VECTOR_APPLE = $85B0; - - // GL_APPLE_transform_hint - GL_TRANSFORM_HINT_APPLE = $85B1; - - // GL_APPLE_vertex_array_object - GL_VERTEX_ARRAY_BINDING_APPLE = $85B5; - - // GL_APPLE_vertex_array_range - GL_VERTEX_ARRAY_RANGE_APPLE = $851D; - GL_VERTEX_ARRAY_RANGE_LENGTH_APPLE = $851E; - GL_VERTEX_ARRAY_STORAGE_HINT_APPLE = $851F; - GL_VERTEX_ARRAY_RANGE_POINTER_APPLE = $8521; - GL_STORAGE_CLIENT_APPLE = $85B4; - GL_STORAGE_CACHED_APPLE = $85BE; - GL_STORAGE_SHARED_APPLE = $85BF; - - // GL_APPLE_ycbcr_422 - GL_YCBCR_422_APPLE = $85B9; - GL_UNSIGNED_SHORT_8_8_APPLE = $85BA; - GL_UNSIGNED_SHORT_8_8_REV_APPLE = $85BB; - - // GL_APPLE_texture_range - GL_TEXTURE_RANGE_LENGTH_APPLE = $85B7; - GL_TEXTURE_RANGE_POINTER_APPLE = $85B8; - GL_TEXTURE_STORAGE_HINT_APPLE = $85BC; - GL_STORAGE_PRIVATE_APPLE = $85BD; - { reuse GL_STORAGE_CACHED_APPLE } - { reuse GL_STORAGE_SHARED_APPLE } - - // GL_APPLE_float_pixels - GL_HALF_APPLE = $140B; - GL_RGBA_FLOAT32_APPLE = $8814; - GL_RGB_FLOAT32_APPLE = $8815; - GL_ALPHA_FLOAT32_APPLE = $8816; - GL_INTENSITY_FLOAT32_APPLE = $8817; - GL_LUMINANCE_FLOAT32_APPLE = $8818; - GL_LUMINANCE_ALPHA_FLOAT32_APPLE = $8819; - GL_RGBA_FLOAT16_APPLE = $881A; - GL_RGB_FLOAT16_APPLE = $881B; - GL_ALPHA_FLOAT16_APPLE = $881C; - GL_INTENSITY_FLOAT16_APPLE = $881D; - GL_LUMINANCE_FLOAT16_APPLE = $881E; - GL_LUMINANCE_ALPHA_FLOAT16_APPLE = $881F; - GL_COLOR_FLOAT_APPLE = $8A0F; - - // GL_APPLE_vertex_program_evaluators - GL_VERTEX_ATTRIB_MAP1_APPLE = $8A00; - GL_VERTEX_ATTRIB_MAP2_APPLE = $8A01; - GL_VERTEX_ATTRIB_MAP1_SIZE_APPLE = $8A02; - GL_VERTEX_ATTRIB_MAP1_COEFF_APPLE = $8A03; - GL_VERTEX_ATTRIB_MAP1_ORDER_APPLE = $8A04; - GL_VERTEX_ATTRIB_MAP1_DOMAIN_APPLE = $8A05; - GL_VERTEX_ATTRIB_MAP2_SIZE_APPLE = $8A06; - GL_VERTEX_ATTRIB_MAP2_COEFF_APPLE = $8A07; - GL_VERTEX_ATTRIB_MAP2_ORDER_APPLE = $8A08; - GL_VERTEX_ATTRIB_MAP2_DOMAIN_APPLE = $8A09; - - // GL_APPLE_aux_depth_stencil - GL_AUX_DEPTH_STENCIL_APPLE = $8A14; - - // GL_APPLE_object_purgeable - GL_BUFFER_OBJECT_APPLE = $85B3; - GL_RELEASED_APPLE = $8A19; - GL_VOLATILE_APPLE = $8A1A; - GL_RETAINED_APPLE = $8A1B; - GL_UNDEFINED_APPLE = $8A1C; - GL_PURGEABLE_APPLE = $8A1D; - - // GL_APPLE_row_bytes - GL_PACK_ROW_BYTES_APPLE = $8A15; - GL_UNPACK_ROW_BYTES_APPLE = $8A16; - - // GL_APPLE_rgb_422 - { reuse GL_UNSIGNED_SHORT_8_8_APPLE } - { reuse GL_UNSIGNED_SHORT_8_8_REV_APPLE } - - // GL_ARB_depth_texture - GL_DEPTH_COMPONENT16_ARB = $81A5; - GL_DEPTH_COMPONENT24_ARB = $81A6; - GL_DEPTH_COMPONENT32_ARB = $81A7; - GL_TEXTURE_DEPTH_SIZE_ARB = $884A; - GL_DEPTH_TEXTURE_MODE_ARB = $884B; - - // GL_ARB_fragment_program - GL_FRAGMENT_PROGRAM_ARB = $8804; - GL_PROGRAM_ALU_INSTRUCTIONS_ARB = $8805; - GL_PROGRAM_TEX_INSTRUCTIONS_ARB = $8806; - GL_PROGRAM_TEX_INDIRECTIONS_ARB = $8807; - GL_PROGRAM_NATIVE_ALU_INSTRUCTIONS_ARB = $8808; - GL_PROGRAM_NATIVE_TEX_INSTRUCTIONS_ARB = $8809; - GL_PROGRAM_NATIVE_TEX_INDIRECTIONS_ARB = $880A; - GL_MAX_PROGRAM_ALU_INSTRUCTIONS_ARB = $880B; - GL_MAX_PROGRAM_TEX_INSTRUCTIONS_ARB = $880C; - GL_MAX_PROGRAM_TEX_INDIRECTIONS_ARB = $880D; - GL_MAX_PROGRAM_NATIVE_ALU_INSTRUCTIONS_ARB = $880E; - GL_MAX_PROGRAM_NATIVE_TEX_INSTRUCTIONS_ARB = $880F; - GL_MAX_PROGRAM_NATIVE_TEX_INDIRECTIONS_ARB = $8810; - GL_MAX_TEXTURE_COORDS_ARB = $8871; - GL_MAX_TEXTURE_IMAGE_UNITS_ARB = $8872; - - // GL_ARB_imaging - GL_CONSTANT_COLOR_ARB = $8001; - GL_ONE_MINUS_CONSTANT_COLOR = $8002; - GL_CONSTANT_ALPHA = $8003; - GL_ONE_MINUS_CONSTANT_ALPHA = $8004; - GL_BLEND_COLOR = $8005; - GL_FUNC_ADD = $8006; - GL_MIN = $8007; - GL_MAX = $8008; - GL_BLEND_EQUATION = $8009; - GL_FUNC_SUBTRACT = $800A; - GL_FUNC_REVERSE_SUBTRACT = $800B; -{$ifdef DGL_DEPRECATED} - GL_CONVOLUTION_1D = $8010; - GL_CONVOLUTION_2D = $8011; - GL_SEPARABLE_2D = $8012; - GL_CONVOLUTION_BORDER_MODE = $8013; - GL_CONVOLUTION_FILTER_SCALE = $8014; - GL_CONVOLUTION_FILTER_BIAS = $8015; - GL_REDUCE = $8016; - GL_CONVOLUTION_FORMAT = $8017; - GL_CONVOLUTION_WIDTH = $8018; - GL_CONVOLUTION_HEIGHT = $8019; - GL_MAX_CONVOLUTION_WIDTH = $801A; - GL_MAX_CONVOLUTION_HEIGHT = $801B; - GL_POST_CONVOLUTION_RED_SCALE = $801C; - GL_POST_CONVOLUTION_GREEN_SCALE = $801D; - GL_POST_CONVOLUTION_BLUE_SCALE = $801E; - GL_POST_CONVOLUTION_ALPHA_SCALE = $801F; - GL_POST_CONVOLUTION_RED_BIAS = $8020; - GL_POST_CONVOLUTION_GREEN_BIAS = $8021; - GL_POST_CONVOLUTION_BLUE_BIAS = $8022; - GL_POST_CONVOLUTION_ALPHA_BIAS = $8023; - GL_HISTOGRAM = $8024; - GL_PROXY_HISTOGRAM = $8025; - GL_HISTOGRAM_WIDTH = $8026; - GL_HISTOGRAM_FORMAT = $8027; - GL_HISTOGRAM_RED_SIZE = $8028; - GL_HISTOGRAM_GREEN_SIZE = $8029; - GL_HISTOGRAM_BLUE_SIZE = $802A; - GL_HISTOGRAM_ALPHA_SIZE = $802B; - GL_HISTOGRAM_LUMINANCE_SIZE = $802C; - GL_HISTOGRAM_SINK = $802D; - GL_MINMAX = $802E; - GL_MINMAX_FORMAT = $802F; - GL_MINMAX_SINK = $8030; - GL_TABLE_TOO_LARGE = $8031; - GL_COLOR_MATRIX = $80B1; - GL_COLOR_MATRIX_STACK_DEPTH = $80B2; - GL_MAX_COLOR_MATRIX_STACK_DEPTH = $80B3; - GL_POST_COLOR_MATRIX_RED_SCALE = $80B4; - GL_POST_COLOR_MATRIX_GREEN_SCALE = $80B5; - GL_POST_COLOR_MATRIX_BLUE_SCALE = $80B6; - GL_POST_COLOR_MATRIX_ALPHA_SCALE = $80B7; - GL_POST_COLOR_MATRIX_RED_BIAS = $80B8; - GL_POST_COLOR_MATRIX_GREEN_BIAS = $80B9; - GL_POST_COLOR_MATRIX_BLUE_BIAS = $80BA; - GL_POST_COLOR_MATRIX_ALPHA_BIAS = $80BB; - GL_COLOR_TABLE = $80D0; - GL_POST_CONVOLUTION_COLOR_TABLE = $80D1; - GL_POST_COLOR_MATRIX_COLOR_TABLE = $80D2; - GL_PROXY_COLOR_TABLE = $80D3; - GL_PROXY_POST_CONVOLUTION_COLOR_TABLE = $80D4; - GL_PROXY_POST_COLOR_MATRIX_COLOR_TABLE = $80D5; - GL_COLOR_TABLE_SCALE = $80D6; - GL_COLOR_TABLE_BIAS = $80D7; - GL_COLOR_TABLE_FORMAT = $80D8; - GL_COLOR_TABLE_WIDTH = $80D9; - GL_COLOR_TABLE_RED_SIZE = $80DA; - GL_COLOR_TABLE_GREEN_SIZE = $80DB; - GL_COLOR_TABLE_BLUE_SIZE = $80DC; - GL_COLOR_TABLE_ALPHA_SIZE = $80DD; - GL_COLOR_TABLE_LUMINANCE_SIZE = $80DE; - GL_COLOR_TABLE_INTENSITY_SIZE = $80DF; - GL_CONSTANT_BORDER = $8151; - GL_REPLICATE_BORDER = $8153; - GL_CONVOLUTION_BORDER_COLOR = $8154; -{$endif} - - // GL_ARB_matrix_palette - GL_MATRIX_PALETTE_ARB = $8840; - GL_MAX_MATRIX_PALETTE_STACK_DEPTH_ARB = $8841; - GL_MAX_PALETTE_MATRICES_ARB = $8842; - GL_CURRENT_PALETTE_MATRIX_ARB = $8843; - GL_MATRIX_INDEX_ARRAY_ARB = $8844; - GL_CURRENT_MATRIX_INDEX_ARB = $8845; - GL_MATRIX_INDEX_ARRAY_SIZE_ARB = $8846; - GL_MATRIX_INDEX_ARRAY_TYPE_ARB = $8847; - GL_MATRIX_INDEX_ARRAY_STRIDE_ARB = $8848; - GL_MATRIX_INDEX_ARRAY_POINTER_ARB = $8849; - - // GL_ARB_multisample - GL_MULTISAMPLE_ARB = $809D; - GL_SAMPLE_ALPHA_TO_COVERAGE_ARB = $809E; - GL_SAMPLE_ALPHA_TO_ONE_ARB = $809F; - GL_SAMPLE_COVERAGE_ARB = $80A0; - GL_SAMPLE_BUFFERS_ARB = $80A8; - GL_SAMPLES_ARB = $80A9; - GL_SAMPLE_COVERAGE_VALUE_ARB = $80AA; - GL_SAMPLE_COVERAGE_INVERT_ARB = $80AB; - GL_MULTISAMPLE_BIT_ARB = $20000000; - - // GL_ARB_multitexture - GL_TEXTURE0_ARB = $84C0; - GL_TEXTURE1_ARB = $84C1; - GL_TEXTURE2_ARB = $84C2; - GL_TEXTURE3_ARB = $84C3; - GL_TEXTURE4_ARB = $84C4; - GL_TEXTURE5_ARB = $84C5; - GL_TEXTURE6_ARB = $84C6; - GL_TEXTURE7_ARB = $84C7; - GL_TEXTURE8_ARB = $84C8; - GL_TEXTURE9_ARB = $84C9; - GL_TEXTURE10_ARB = $84CA; - GL_TEXTURE11_ARB = $84CB; - GL_TEXTURE12_ARB = $84CC; - GL_TEXTURE13_ARB = $84CD; - GL_TEXTURE14_ARB = $84CE; - GL_TEXTURE15_ARB = $84CF; - GL_TEXTURE16_ARB = $84D0; - GL_TEXTURE17_ARB = $84D1; - GL_TEXTURE18_ARB = $84D2; - GL_TEXTURE19_ARB = $84D3; - GL_TEXTURE20_ARB = $84D4; - GL_TEXTURE21_ARB = $84D5; - GL_TEXTURE22_ARB = $84D6; - GL_TEXTURE23_ARB = $84D7; - GL_TEXTURE24_ARB = $84D8; - GL_TEXTURE25_ARB = $84D9; - GL_TEXTURE26_ARB = $84DA; - GL_TEXTURE27_ARB = $84DB; - GL_TEXTURE28_ARB = $84DC; - GL_TEXTURE29_ARB = $84DD; - GL_TEXTURE30_ARB = $84DE; - GL_TEXTURE31_ARB = $84DF; - GL_ACTIVE_TEXTURE_ARB = $84E0; - GL_CLIENT_ACTIVE_TEXTURE_ARB = $84E1; - GL_MAX_TEXTURE_UNITS_ARB = $84E2; - - // GL_ARB_point_parameters - GL_POINT_SIZE_MIN_ARB = $8126; - GL_POINT_SIZE_MAX_ARB = $8127; - GL_POINT_FADE_THRESHOLD_SIZE_ARB = $8128; - GL_POINT_DISTANCE_ATTENUATION_ARB = $8129; - - // GL_ARB_shadow - GL_TEXTURE_COMPARE_MODE_ARB = $884C; - GL_TEXTURE_COMPARE_FUNC_ARB = $884D; - GL_COMPARE_R_TO_TEXTURE_ARB = $884E; - - // GL_ARB_shadow_ambient - GL_TEXTURE_COMPARE_FAIL_VALUE_ARB = $80BF; - - // GL_ARB_texture_border_clamp - GL_CLAMP_TO_BORDER_ARB = $812D; - - // GL_ARB_texture_compression - GL_COMPRESSED_ALPHA_ARB = $84E9; - GL_COMPRESSED_LUMINANCE_ARB = $84EA; - GL_COMPRESSED_LUMINANCE_ALPHA_ARB = $84EB; - GL_COMPRESSED_INTENSITY_ARB = $84EC; - GL_COMPRESSED_RGB_ARB = $84ED; - GL_COMPRESSED_RGBA_ARB = $84EE; - GL_TEXTURE_COMPRESSION_HINT_ARB = $84EF; - GL_TEXTURE_COMPRESSED_IMAGE_SIZE_ARB = $86A0; - GL_TEXTURE_COMPRESSED_ARB = $86A1; - GL_NUM_COMPRESSED_TEXTURE_FORMATS_ARB = $86A2; - GL_COMPRESSED_TEXTURE_FORMATS_ARB = $86A3; - - // GL_ARB_texture_cube_map - GL_NORMAL_MAP_ARB = $8511; - GL_REFLECTION_MAP_ARB = $8512; - GL_TEXTURE_CUBE_MAP_ARB = $8513; - GL_TEXTURE_BINDING_CUBE_MAP_ARB = $8514; - GL_TEXTURE_CUBE_MAP_POSITIVE_X_ARB = $8515; - GL_TEXTURE_CUBE_MAP_NEGATIVE_X_ARB = $8516; - GL_TEXTURE_CUBE_MAP_POSITIVE_Y_ARB = $8517; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Y_ARB = $8518; - GL_TEXTURE_CUBE_MAP_POSITIVE_Z_ARB = $8519; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Z_ARB = $851A; - GL_PROXY_TEXTURE_CUBE_MAP_ARB = $851B; - GL_MAX_CUBE_MAP_TEXTURE_SIZE_ARB = $851C; - - // GL_ARB_texture_env_combine - GL_COMBINE_ARB = $8570; - GL_COMBINE_RGB_ARB = $8571; - GL_COMBINE_ALPHA_ARB = $8572; - GL_SOURCE0_RGB_ARB = $8580; - GL_SOURCE1_RGB_ARB = $8581; - GL_SOURCE2_RGB_ARB = $8582; - GL_SOURCE0_ALPHA_ARB = $8588; - GL_SOURCE1_ALPHA_ARB = $8589; - GL_SOURCE2_ALPHA_ARB = $858A; - GL_OPERAND0_RGB_ARB = $8590; - GL_OPERAND1_RGB_ARB = $8591; - GL_OPERAND2_RGB_ARB = $8592; - GL_OPERAND0_ALPHA_ARB = $8598; - GL_OPERAND1_ALPHA_ARB = $8599; - GL_OPERAND2_ALPHA_ARB = $859A; - GL_RGB_SCALE_ARB = $8573; - GL_ADD_SIGNED_ARB = $8574; - GL_INTERPOLATE_ARB = $8575; - GL_SUBTRACT_ARB = $84E7; - GL_CONSTANT_ARB = $8576; - GL_PRIMARY_COLOR_ARB = $8577; - GL_PREVIOUS_ARB = $8578; - - // GL_ARB_texture_env_dot3 - GL_DOT3_RGB_ARB = $86AE; - GL_DOT3_RGBA_ARB = $86AF; - - // GL_ARB_texture_mirrored_repeat - GL_MIRRORED_REPEAT_ARB = $8370; - - // GL_ARB_transpose_matrix - GL_TRANSPOSE_MODELVIEW_MATRIX_ARB = $84E3; - GL_TRANSPOSE_PROJECTION_MATRIX_ARB = $84E4; - GL_TRANSPOSE_TEXTURE_MATRIX_ARB = $84E5; - GL_TRANSPOSE_COLOR_MATRIX_ARB = $84E6; - - // GL_ARB_vertex_blend - GL_MAX_VERTEX_UNITS_ARB = $86A4; - GL_ACTIVE_VERTEX_UNITS_ARB = $86A5; - GL_WEIGHT_SUM_UNITY_ARB = $86A6; - GL_VERTEX_BLEND_ARB = $86A7; - GL_CURRENT_WEIGHT_ARB = $86A8; - GL_WEIGHT_ARRAY_TYPE_ARB = $86A9; - GL_WEIGHT_ARRAY_STRIDE_ARB = $86AA; - GL_WEIGHT_ARRAY_SIZE_ARB = $86AB; - GL_WEIGHT_ARRAY_POINTER_ARB = $86AC; - GL_WEIGHT_ARRAY_ARB = $86AD; - GL_MODELVIEW0_ARB = $1700; - GL_MODELVIEW1_ARB = $850A; - GL_MODELVIEW2_ARB = $8722; - GL_MODELVIEW3_ARB = $8723; - GL_MODELVIEW4_ARB = $8724; - GL_MODELVIEW5_ARB = $8725; - GL_MODELVIEW6_ARB = $8726; - GL_MODELVIEW7_ARB = $8727; - GL_MODELVIEW8_ARB = $8728; - GL_MODELVIEW9_ARB = $8729; - GL_MODELVIEW10_ARB = $872A; - GL_MODELVIEW11_ARB = $872B; - GL_MODELVIEW12_ARB = $872C; - GL_MODELVIEW13_ARB = $872D; - GL_MODELVIEW14_ARB = $872E; - GL_MODELVIEW15_ARB = $872F; - GL_MODELVIEW16_ARB = $8730; - GL_MODELVIEW17_ARB = $8731; - GL_MODELVIEW18_ARB = $8732; - GL_MODELVIEW19_ARB = $8733; - GL_MODELVIEW20_ARB = $8734; - GL_MODELVIEW21_ARB = $8735; - GL_MODELVIEW22_ARB = $8736; - GL_MODELVIEW23_ARB = $8737; - GL_MODELVIEW24_ARB = $8738; - GL_MODELVIEW25_ARB = $8739; - GL_MODELVIEW26_ARB = $873A; - GL_MODELVIEW27_ARB = $873B; - GL_MODELVIEW28_ARB = $873C; - GL_MODELVIEW29_ARB = $873D; - GL_MODELVIEW30_ARB = $873E; - GL_MODELVIEW31_ARB = $873F; - - // GL_ARB_vertex_buffer_object - GL_BUFFER_SIZE_ARB = $8764; - GL_BUFFER_USAGE_ARB = $8765; - GL_ARRAY_BUFFER_ARB = $8892; - GL_ELEMENT_ARRAY_BUFFER_ARB = $8893; - GL_ARRAY_BUFFER_BINDING_ARB = $8894; - GL_ELEMENT_ARRAY_BUFFER_BINDING_ARB = $8895; - GL_VERTEX_ARRAY_BUFFER_BINDING_ARB = $8896; - GL_NORMAL_ARRAY_BUFFER_BINDING_ARB = $8897; - GL_COLOR_ARRAY_BUFFER_BINDING_ARB = $8898; - GL_INDEX_ARRAY_BUFFER_BINDING_ARB = $8899; - GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING_ARB = $889A; - GL_EDGE_FLAG_ARRAY_BUFFER_BINDING_ARB = $889B; - GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING_ARB = $889C; - GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING_ARB = $889D; - GL_WEIGHT_ARRAY_BUFFER_BINDING_ARB = $889E; - GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ARB = $889F; - GL_READ_ONLY_ARB = $88B8; - GL_WRITE_ONLY_ARB = $88B9; - GL_READ_WRITE_ARB = $88BA; - GL_BUFFER_ACCESS_ARB = $88BB; - GL_BUFFER_MAPPED_ARB = $88BC; - GL_BUFFER_MAP_POINTER_ARB = $88BD; - GL_STREAM_DRAW_ARB = $88E0; - GL_STREAM_READ_ARB = $88E1; - GL_STREAM_COPY_ARB = $88E2; - GL_STATIC_DRAW_ARB = $88E4; - GL_STATIC_READ_ARB = $88E5; - GL_STATIC_COPY_ARB = $88E6; - GL_DYNAMIC_DRAW_ARB = $88E8; - GL_DYNAMIC_READ_ARB = $88E9; - GL_DYNAMIC_COPY_ARB = $88EA; - - // GL_ARB_vertex_program - GL_COLOR_SUM_ARB = $8458; - GL_VERTEX_PROGRAM_ARB = $8620; - GL_VERTEX_ATTRIB_ARRAY_ENABLED_ARB = $8622; - GL_VERTEX_ATTRIB_ARRAY_SIZE_ARB = $8623; - GL_VERTEX_ATTRIB_ARRAY_STRIDE_ARB = $8624; - GL_VERTEX_ATTRIB_ARRAY_TYPE_ARB = $8625; - GL_CURRENT_VERTEX_ATTRIB_ARB = $8626; - GL_PROGRAM_LENGTH_ARB = $8627; - GL_PROGRAM_STRING_ARB = $8628; - GL_MAX_PROGRAM_MATRIX_STACK_DEPTH_ARB = $862E; - GL_MAX_PROGRAM_MATRICES_ARB = $862F; - GL_CURRENT_MATRIX_STACK_DEPTH_ARB = $8640; - GL_CURRENT_MATRIX_ARB = $8641; - GL_VERTEX_PROGRAM_POINT_SIZE_ARB = $8642; - GL_VERTEX_PROGRAM_TWO_SIDE_ARB = $8643; - GL_VERTEX_ATTRIB_ARRAY_POINTER_ARB = $8645; - GL_PROGRAM_ERROR_POSITION_ARB = $864B; - GL_PROGRAM_BINDING_ARB = $8677; - GL_MAX_VERTEX_ATTRIBS_ARB = $8869; - GL_VERTEX_ATTRIB_ARRAY_NORMALIZED_ARB = $886A; - GL_PROGRAM_ERROR_STRING_ARB = $8874; - GL_PROGRAM_FORMAT_ASCII_ARB = $8875; - GL_PROGRAM_FORMAT_ARB = $8876; - GL_PROGRAM_INSTRUCTIONS_ARB = $88A0; - GL_MAX_PROGRAM_INSTRUCTIONS_ARB = $88A1; - GL_PROGRAM_NATIVE_INSTRUCTIONS_ARB = $88A2; - GL_MAX_PROGRAM_NATIVE_INSTRUCTIONS_ARB = $88A3; - GL_PROGRAM_TEMPORARIES_ARB = $88A4; - GL_MAX_PROGRAM_TEMPORARIES_ARB = $88A5; - GL_PROGRAM_NATIVE_TEMPORARIES_ARB = $88A6; - GL_MAX_PROGRAM_NATIVE_TEMPORARIES_ARB = $88A7; - GL_PROGRAM_PARAMETERS_ARB = $88A8; - GL_MAX_PROGRAM_PARAMETERS_ARB = $88A9; - GL_PROGRAM_NATIVE_PARAMETERS_ARB = $88AA; - GL_MAX_PROGRAM_NATIVE_PARAMETERS_ARB = $88AB; - GL_PROGRAM_ATTRIBS_ARB = $88AC; - GL_MAX_PROGRAM_ATTRIBS_ARB = $88AD; - GL_PROGRAM_NATIVE_ATTRIBS_ARB = $88AE; - GL_MAX_PROGRAM_NATIVE_ATTRIBS_ARB = $88AF; - GL_PROGRAM_ADDRESS_REGISTERS_ARB = $88B0; - GL_MAX_PROGRAM_ADDRESS_REGISTERS_ARB = $88B1; - GL_PROGRAM_NATIVE_ADDRESS_REGISTERS_ARB = $88B2; - GL_MAX_PROGRAM_NATIVE_ADDRESS_REGISTERS_ARB = $88B3; - GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB = $88B4; - GL_MAX_PROGRAM_ENV_PARAMETERS_ARB = $88B5; - GL_PROGRAM_UNDER_NATIVE_LIMITS_ARB = $88B6; - GL_TRANSPOSE_CURRENT_MATRIX_ARB = $88B7; - GL_MATRIX0_ARB = $88C0; - GL_MATRIX1_ARB = $88C1; - GL_MATRIX2_ARB = $88C2; - GL_MATRIX3_ARB = $88C3; - GL_MATRIX4_ARB = $88C4; - GL_MATRIX5_ARB = $88C5; - GL_MATRIX6_ARB = $88C6; - GL_MATRIX7_ARB = $88C7; - GL_MATRIX8_ARB = $88C8; - GL_MATRIX9_ARB = $88C9; - GL_MATRIX10_ARB = $88CA; - GL_MATRIX11_ARB = $88CB; - GL_MATRIX12_ARB = $88CC; - GL_MATRIX13_ARB = $88CD; - GL_MATRIX14_ARB = $88CE; - GL_MATRIX15_ARB = $88CF; - GL_MATRIX16_ARB = $88D0; - GL_MATRIX17_ARB = $88D1; - GL_MATRIX18_ARB = $88D2; - GL_MATRIX19_ARB = $88D3; - GL_MATRIX20_ARB = $88D4; - GL_MATRIX21_ARB = $88D5; - GL_MATRIX22_ARB = $88D6; - GL_MATRIX23_ARB = $88D7; - GL_MATRIX24_ARB = $88D8; - GL_MATRIX25_ARB = $88D9; - GL_MATRIX26_ARB = $88DA; - GL_MATRIX27_ARB = $88DB; - GL_MATRIX28_ARB = $88DC; - GL_MATRIX29_ARB = $88DD; - GL_MATRIX30_ARB = $88DE; - GL_MATRIX31_ARB = $88DF; - - // GL_ARB_draw_buffers - GL_MAX_DRAW_BUFFERS_ARB = $8824; - GL_DRAW_BUFFER0_ARB = $8825; - GL_DRAW_BUFFER1_ARB = $8826; - GL_DRAW_BUFFER2_ARB = $8827; - GL_DRAW_BUFFER3_ARB = $8828; - GL_DRAW_BUFFER4_ARB = $8829; - GL_DRAW_BUFFER5_ARB = $882A; - GL_DRAW_BUFFER6_ARB = $882B; - GL_DRAW_BUFFER7_ARB = $882C; - GL_DRAW_BUFFER8_ARB = $882D; - GL_DRAW_BUFFER9_ARB = $882E; - GL_DRAW_BUFFER10_ARB = $882F; - GL_DRAW_BUFFER11_ARB = $8830; - GL_DRAW_BUFFER12_ARB = $8831; - GL_DRAW_BUFFER13_ARB = $8832; - GL_DRAW_BUFFER14_ARB = $8833; - GL_DRAW_BUFFER15_ARB = $8834; - - // GL_ARB_texture_rectangle - GL_TEXTURE_RECTANGLE_ARB = $84F5; - GL_TEXTURE_BINDING_RECTANGLE_ARB = $84F6; - GL_PROXY_TEXTURE_RECTANGLE_ARB = $84F7; - GL_MAX_RECTANGLE_TEXTURE_SIZE_ARB = $84F8; - - // GL_ARB_color_buffer_float - GL_RGBA_FLOAT_MODE_ARB = $8820; - GL_CLAMP_VERTEX_COLOR_ARB = $891A; - GL_CLAMP_FRAGMENT_COLOR_ARB = $891B; - GL_CLAMP_READ_COLOR_ARB = $891C; - GL_FIXED_ONLY_ARB = $891D; - WGL_TYPE_RGBA_FLOAT_ARB = $21A0; - GLX_RGBA_FLOAT_TYPE = $20B9; - GLX_RGBA_FLOAT_BIT = $00000004; - - // GL_ARB_half_float_pixel - GL_HALF_FLOAT_ARB = $140B; - - // GL_ARB_texture_float - GL_TEXTURE_RED_TYPE_ARB = $8C10; - GL_TEXTURE_GREEN_TYPE_ARB = $8C11; - GL_TEXTURE_BLUE_TYPE_ARB = $8C12; - GL_TEXTURE_ALPHA_TYPE_ARB = $8C13; - GL_TEXTURE_LUMINANCE_TYPE_ARB = $8C14; - GL_TEXTURE_INTENSITY_TYPE_ARB = $8C15; - GL_TEXTURE_DEPTH_TYPE_ARB = $8C16; - GL_UNSIGNED_NORMALIZED_ARB = $8C17; - GL_RGBA32F_ARB = $8814; - GL_RGB32F_ARB = $8815; - GL_ALPHA32F_ARB = $8816; - GL_INTENSITY32F_ARB = $8817; - GL_LUMINANCE32F_ARB = $8818; - GL_LUMINANCE_ALPHA32F_ARB = $8819; - GL_RGBA16F_ARB = $881A; - GL_RGB16F_ARB = $881B; - GL_ALPHA16F_ARB = $881C; - GL_INTENSITY16F_ARB = $881D; - GL_LUMINANCE16F_ARB = $881E; - GL_LUMINANCE_ALPHA16F_ARB = $881F; - - // GL_ARB_pixel_buffer_object - GL_PIXEL_PACK_BUFFER_ARB = $88EB; - GL_PIXEL_UNPACK_BUFFER_ARB = $88EC; - GL_PIXEL_PACK_BUFFER_BINDING_ARB = $88ED; - GL_PIXEL_UNPACK_BUFFER_BINDING_ARB = $88EF; - - // GL_ARB_depth_buffer_float - GL_DEPTH_COMPONENT32F = $8CAC; - GL_DEPTH32F_STENCIL8 = $8CAD; - GL_FLOAT_32_UNSIGNED_INT_24_8_REV = $8DAD; - - // GL_ARB_framebuffer_object - GL_INVALID_FRAMEBUFFER_OPERATION = $0506; - GL_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING = $8210; - GL_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE = $8211; - GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE = $8212; - GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE = $8213; - GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE = $8214; - GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE = $8215; - GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE = $8216; - GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE = $8217; - GL_FRAMEBUFFER_DEFAULT = $8218; - GL_FRAMEBUFFER_UNDEFINED = $8219; - GL_DEPTH_STENCIL_ATTACHMENT = $821A; - GL_MAX_RENDERBUFFER_SIZE = $84E8; - GL_DEPTH_STENCIL = $84F9; - GL_UNSIGNED_INT_24_8 = $84FA; - GL_DEPTH24_STENCIL8 = $88F0; - GL_TEXTURE_STENCIL_SIZE = $88F1; - GL_TEXTURE_RED_TYPE = $8C10; - GL_TEXTURE_GREEN_TYPE = $8C11; - GL_TEXTURE_BLUE_TYPE = $8C12; - GL_TEXTURE_ALPHA_TYPE = $8C13; - GL_TEXTURE_DEPTH_TYPE = $8C16; - GL_UNSIGNED_NORMALIZED = $8C17; - GL_FRAMEBUFFER_BINDING = $8CA6; - GL_DRAW_FRAMEBUFFER_BINDING = GL_FRAMEBUFFER_BINDING; - GL_RENDERBUFFER_BINDING = $8CA7; - GL_READ_FRAMEBUFFER = $8CA8; - GL_DRAW_FRAMEBUFFER = $8CA9; - GL_READ_FRAMEBUFFER_BINDING = $8CAA; - GL_RENDERBUFFER_SAMPLES = $8CAB; - GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE = $8CD0; - GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME = $8CD1; - GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL = $8CD2; - GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE = $8CD3; - GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER = $8CD4; - GL_FRAMEBUFFER_COMPLETE = $8CD5; - GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT = $8CD6; - GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT = $8CD7; - GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER = $8CDB; - GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER = $8CDC; - GL_FRAMEBUFFER_UNSUPPORTED = $8CDD; - GL_MAX_COLOR_ATTACHMENTS = $8CDF; - GL_COLOR_ATTACHMENT0 = $8CE0; - GL_COLOR_ATTACHMENT1 = $8CE1; - GL_COLOR_ATTACHMENT2 = $8CE2; - GL_COLOR_ATTACHMENT3 = $8CE3; - GL_COLOR_ATTACHMENT4 = $8CE4; - GL_COLOR_ATTACHMENT5 = $8CE5; - GL_COLOR_ATTACHMENT6 = $8CE6; - GL_COLOR_ATTACHMENT7 = $8CE7; - GL_COLOR_ATTACHMENT8 = $8CE8; - GL_COLOR_ATTACHMENT9 = $8CE9; - GL_COLOR_ATTACHMENT10 = $8CEA; - GL_COLOR_ATTACHMENT11 = $8CEB; - GL_COLOR_ATTACHMENT12 = $8CEC; - GL_COLOR_ATTACHMENT13 = $8CED; - GL_COLOR_ATTACHMENT14 = $8CEE; - GL_COLOR_ATTACHMENT15 = $8CEF; - GL_DEPTH_ATTACHMENT = $8D00; - GL_STENCIL_ATTACHMENT = $8D20; - GL_FRAMEBUFFER = $8D40; - GL_RENDERBUFFER = $8D41; - GL_RENDERBUFFER_WIDTH = $8D42; - GL_RENDERBUFFER_HEIGHT = $8D43; - GL_RENDERBUFFER_INTERNAL_FORMAT = $8D44; - GL_STENCIL_INDEX1 = $8D46; - GL_STENCIL_INDEX4 = $8D47; - GL_STENCIL_INDEX8 = $8D48; - GL_STENCIL_INDEX16 = $8D49; - GL_RENDERBUFFER_RED_SIZE = $8D50; - GL_RENDERBUFFER_GREEN_SIZE = $8D51; - GL_RENDERBUFFER_BLUE_SIZE = $8D52; - GL_RENDERBUFFER_ALPHA_SIZE = $8D53; - GL_RENDERBUFFER_DEPTH_SIZE = $8D54; - GL_RENDERBUFFER_STENCIL_SIZE = $8D55; - GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE = $8D56; - GL_MAX_SAMPLES = $8D57; -{$ifdef DGL_DEPRECATED} - GL_INDEX = $8222; - GL_TEXTURE_LUMINANCE_TYPE = $8C14; - GL_TEXTURE_INTENSITY_TYPE = $8C15; -{$endif} - - // GL_ARB_framebuffer_sRGB - GL_FRAMEBUFFER_SRGB = $8DB9; - - // GL_ARB_geometry_shader4 - GL_LINES_ADJACENCY_ARB = $000A; - GL_LINE_STRIP_ADJACENCY_ARB = $000B; - GL_TRIANGLES_ADJACENCY_ARB = $000C; - GL_TRIANGLE_STRIP_ADJACENCY_ARB = $000D; - GL_PROGRAM_POINT_SIZE_ARB = $8642; - GL_MAX_GEOMETRY_TEXTURE_IMAGE_UNITS_ARB = $8C29; - GL_FRAMEBUFFER_ATTACHMENT_LAYERED_ARB = $8DA7; - GL_FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS_ARB = $8DA8; - GL_FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_ARB = $8DA9; - GL_GEOMETRY_SHADER_ARB = $8DD9; - GL_GEOMETRY_VERTICES_OUT_ARB = $8DDA; - GL_GEOMETRY_INPUT_TYPE_ARB = $8DDB; - GL_GEOMETRY_OUTPUT_TYPE_ARB = $8DDC; - GL_MAX_GEOMETRY_VARYING_COMPONENTS_ARB = $8DDD; - GL_MAX_VERTEX_VARYING_COMPONENTS_ARB = $8DDE; - GL_MAX_GEOMETRY_UNIFORM_COMPONENTS_ARB = $8DDF; - GL_MAX_GEOMETRY_OUTPUT_VERTICES_ARB = $8DE0; - GL_MAX_GEOMETRY_TOTAL_OUTPUT_COMPONENTS_ARB = $8DE1; - { reuse GL_MAX_VARYING_COMPONENTS } - { reuse GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER } - - // GL_ARB_half_float_vertex - GL_HALF_FLOAT = $140B; - - // GL_ARB_instanced_arrays - GL_VERTEX_ATTRIB_ARRAY_DIVISOR_ARB = $88FE; - - // GL_ARB_map_buffer_range - GL_MAP_READ_BIT = $0001; - GL_MAP_WRITE_BIT = $0002; - GL_MAP_INVALIDATE_RANGE_BIT = $0004; - GL_MAP_INVALIDATE_BUFFER_BIT = $0008; - GL_MAP_FLUSH_EXPLICIT_BIT = $0010; - GL_MAP_UNSYNCHRONIZED_BIT = $0020; - - // GL_ARB_texture_buffer_object - GL_TEXTURE_BUFFER_ARB = $8C2A; - GL_MAX_TEXTURE_BUFFER_SIZE_ARB = $8C2B; - GL_TEXTURE_BINDING_BUFFER_ARB = $8C2C; - GL_TEXTURE_BUFFER_DATA_STORE_BINDING_ARB = $8C2D; - GL_TEXTURE_BUFFER_FORMAT_ARB = $8C2E; - - // GL_ARB_texture_compression_rgtc - GL_COMPRESSED_RED_RGTC1 = $8DBB; - GL_COMPRESSED_SIGNED_RED_RGTC1 = $8DBC; - GL_COMPRESSED_RG_RGTC2 = $8DBD; - GL_COMPRESSED_SIGNED_RG_RGTC2 = $8DBE; - - // GL_ARB_texture_rg - GL_RG = $8227; - GL_RG_INTEGER = $8228; - GL_R8 = $8229; - GL_R16 = $822A; - GL_RG8 = $822B; - GL_RG16 = $822C; - GL_R16F = $822D; - GL_R32F = $822E; - GL_RG16F = $822F; - GL_RG32F = $8230; - GL_R8I = $8231; - GL_R8UI = $8232; - GL_R16I = $8233; - GL_R16UI = $8234; - GL_R32I = $8235; - GL_R32UI = $8236; - GL_RG8I = $8237; - GL_RG8UI = $8238; - GL_RG16I = $8239; - GL_RG16UI = $823A; - GL_RG32I = $823B; - GL_RG32UI = $823C; - - // GL_ARB_vertex_array_object - GL_VERTEX_ARRAY_BINDING = $85B5; - - // GL_ARB_uniform_buffer_object - GL_UNIFORM_BUFFER = $8A11; - GL_UNIFORM_BUFFER_BINDING = $8A28; - GL_UNIFORM_BUFFER_START = $8A29; - GL_UNIFORM_BUFFER_SIZE = $8A2A; - GL_MAX_VERTEX_UNIFORM_BLOCKS = $8A2B; - GL_MAX_GEOMETRY_UNIFORM_BLOCKS = $8A2C; - GL_MAX_FRAGMENT_UNIFORM_BLOCKS = $8A2D; - GL_MAX_COMBINED_UNIFORM_BLOCKS = $8A2E; - GL_MAX_UNIFORM_BUFFER_BINDINGS = $8A2F; - GL_MAX_UNIFORM_BLOCK_SIZE = $8A30; - GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS = $8A31; - GL_MAX_COMBINED_GEOMETRY_UNIFORM_COMPONENTS = $8A32; - GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS = $8A33; - GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT = $8A34; - GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH = $8A35; - GL_ACTIVE_UNIFORM_BLOCKS = $8A36; - GL_UNIFORM_TYPE = $8A37; - GL_UNIFORM_SIZE = $8A38; - GL_UNIFORM_NAME_LENGTH = $8A39; - GL_UNIFORM_BLOCK_INDEX = $8A3A; - GL_UNIFORM_OFFSET = $8A3B; - GL_UNIFORM_ARRAY_STRIDE = $8A3C; - GL_UNIFORM_MATRIX_STRIDE = $8A3D; - GL_UNIFORM_IS_ROW_MAJOR = $8A3E; - GL_UNIFORM_BLOCK_BINDING = $8A3F; - GL_UNIFORM_BLOCK_DATA_SIZE = $8A40; - GL_UNIFORM_BLOCK_NAME_LENGTH = $8A41; - GL_UNIFORM_BLOCK_ACTIVE_UNIFORMS = $8A42; - GL_UNIFORM_BLOCK_ACTIVE_UNIFORM_INDICES = $8A43; - GL_UNIFORM_BLOCK_REFERENCED_BY_VERTEX_SHADER = $8A44; - GL_UNIFORM_BLOCK_REFERENCED_BY_GEOMETRY_SHADER = $8A45; - GL_UNIFORM_BLOCK_REFERENCED_BY_FRAGMENT_SHADER = $8A46; - GL_INVALID_INDEX = $FFFFFFFF; - - // GL_ARB_compatibility - { ARB_compatibility just defines tokens from core 3.0 } - - // GL_ARB_copy_buffer - GL_COPY_READ_BUFFER_BINDING = $8F36; - GL_COPY_READ_BUFFER = GL_COPY_READ_BUFFER_BINDING; - GL_COPY_WRITE_BUFFER_BINDING = $8F37; - GL_COPY_WRITE_BUFFER = GL_COPY_WRITE_BUFFER_BINDING; - - // GL_ARB_depth_clamp - GL_DEPTH_CLAMP = $864F; - - // GL_ARB_provoking_vertex - GL_QUADS_FOLLOW_PROVOKING_VERTEX_CONVENTION = $8E4C; - GL_FIRST_VERTEX_CONVENTION = $8E4D; - GL_LAST_VERTEX_CONVENTION = $8E4E; - GL_PROVOKING_VERTEX = $8E4F; - - // GL_ARB_seamless_cube_map - GL_TEXTURE_CUBE_MAP_SEAMLESS = $884F; - - // GL_ARB_sync - GL_MAX_SERVER_WAIT_TIMEOUT = $9111; - GL_OBJECT_TYPE = $9112; - GL_SYNC_CONDITION = $9113; - GL_SYNC_STATUS = $9114; - GL_SYNC_FLAGS = $9115; - GL_SYNC_FENCE = $9116; - GL_SYNC_GPU_COMMANDS_COMPLETE = $9117; - GL_UNSIGNALED = $9118; - GL_SIGNALED = $9119; - GL_ALREADY_SIGNALED = $911A; - GL_TIMEOUT_EXPIRED = $911B; - GL_CONDITION_SATISFIED = $911C; - GL_WAIT_FAILED = $911D; - GL_SYNC_FLUSH_COMMANDS_BIT = $00000001; - GL_TIMEOUT_IGNORED = $FFFFFFFFFFFFFFFF; - - // GL_ARB_texture_multisample - GL_SAMPLE_POSITION = $8E50; - GL_SAMPLE_MASK = $8E51; - GL_SAMPLE_MASK_VALUE = $8E52; - GL_MAX_SAMPLE_MASK_WORDS = $8E59; - GL_TEXTURE_2D_MULTISAMPLE = $9100; - GL_PROXY_TEXTURE_2D_MULTISAMPLE = $9101; - GL_TEXTURE_2D_MULTISAMPLE_ARRAY = $9102; - GL_PROXY_TEXTURE_2D_MULTISAMPLE_ARRAY = $9103; - GL_TEXTURE_BINDING_2D_MULTISAMPLE = $9104; - GL_TEXTURE_BINDING_2D_MULTISAMPLE_ARRAY = $9105; - GL_TEXTURE_SAMPLES = $9106; - GL_TEXTURE_FIXED_SAMPLE_LOCATIONS = $9107; - GL_SAMPLER_2D_MULTISAMPLE = $9108; - GL_INT_SAMPLER_2D_MULTISAMPLE = $9109; - GL_UNSIGNED_INT_SAMPLER_2D_MULTISAMPLE = $910A; - GL_SAMPLER_2D_MULTISAMPLE_ARRAY = $910B; - GL_INT_SAMPLER_2D_MULTISAMPLE_ARRAY = $910C; - GL_UNSIGNED_INT_SAMPLER_2D_MULTISAMPLE_ARRAY = $910D; - GL_MAX_COLOR_TEXTURE_SAMPLES = $910E; - GL_MAX_DEPTH_TEXTURE_SAMPLES = $910F; - GL_MAX_INTEGER_SAMPLES = $9110; - - // GL_ARB_vertex_array_bgra - { reuse GL_BGRA } - - // GL_ARB_sample_shading - GL_SAMPLE_SHADING_ARB = $8C36; - GL_MIN_SAMPLE_SHADING_VALUE_ARB = $8C37; - - // GL_ARB_texture_cube_map_array - GL_TEXTURE_CUBE_MAP_ARRAY_ARB = $9009; - GL_TEXTURE_BINDING_CUBE_MAP_ARRAY_ARB = $900A; - GL_PROXY_TEXTURE_CUBE_MAP_ARRAY_ARB = $900B; - GL_SAMPLER_CUBE_MAP_ARRAY_ARB = $900C; - GL_SAMPLER_CUBE_MAP_ARRAY_SHADOW_ARB = $900D; - GL_INT_SAMPLER_CUBE_MAP_ARRAY_ARB = $900E; - GL_UNSIGNED_INT_SAMPLER_CUBE_MAP_ARRAY_ARB = $900F; - - // GL_ARB_texture_gather - GL_MIN_PROGRAM_TEXTURE_GATHER_OFFSET_ARB = $8E5E; - GL_MAX_PROGRAM_TEXTURE_GATHER_OFFSET_ARB = $8E5F; - - // GL_ARB_shading_language_include - GL_SHADER_INCLUDE_ARB = $8DAE; - GL_NAMED_STRING_LENGTH_ARB = $8DE9; - GL_NAMED_STRING_TYPE_ARB = $8DEA; - - // GL_ARB_texture_compression_bptc - GL_COMPRESSED_RGBA_BPTC_UNORM_ARB = $8E8C; - GL_COMPRESSED_SRGB_ALPHA_BPTC_UNORM_ARB = $8E8D; - GL_COMPRESSED_RGB_BPTC_SIGNED_FLOAT_ARB = $8E8E; - GL_COMPRESSED_RGB_BPTC_UNSIGNED_FLOAT_ARB = $8E8F; - - // GL_ARB_blend_func_extended - GL_SRC1_COLOR = $88F9; - { reuse GL_SRC1_ALPHA } - GL_ONE_MINUS_SRC1_COLOR = $88FA; - GL_ONE_MINUS_SRC1_ALPHA = $88FB; - GL_MAX_DUAL_SOURCE_DRAW_BUFFERS = $88FC; - - // GL_ARB_occlusion_query2 - GL_ANY_SAMPLES_PASSED = $8C2F; - - // GL_ARB_sampler_objects - GL_SAMPLER_BINDING = $8919; - - // GL_ARB_texture_rgb10_a2ui - GL_RGB10_A2UI = $906F; - - // GL_ARB_texture_swizzle - GL_TEXTURE_SWIZZLE_R = $8E42; - GL_TEXTURE_SWIZZLE_G = $8E43; - GL_TEXTURE_SWIZZLE_B = $8E44; - GL_TEXTURE_SWIZZLE_A = $8E45; - GL_TEXTURE_SWIZZLE_RGBA = $8E46; - - // GL_ARB_timer_query - GL_TIME_ELAPSED = $88BF; - GL_TIMESTAMP = $8E28; - - // GL_ARB_vertex_type_2_10_10_10_rev - { reuse GL_UNSIGNED_INT_2_10_10_10_REV } - GL_INT_2_10_10_10_REV = $8D9F; - - // GL_ARB_draw_indirect - GL_DRAW_INDIRECT_BUFFER = $8F3F; - GL_DRAW_INDIRECT_BUFFER_BINDING = $8F43; - - // GL_ARB_gpu_shader5 - GL_GEOMETRY_SHADER_INVOCATIONS = $887F; - GL_MAX_GEOMETRY_SHADER_INVOCATIONS = $8E5A; - GL_MIN_FRAGMENT_INTERPOLATION_OFFSET = $8E5B; - GL_MAX_FRAGMENT_INTERPOLATION_OFFSET = $8E5C; - GL_FRAGMENT_INTERPOLATION_OFFSET_BITS = $8E5D; - { reuse GL_MAX_VERTEX_STREAMS } - - // GL_ARB_gpu_shader_fp64 - { reuse GL_DOUBLE } - GL_DOUBLE_VEC2 = $8FFC; - GL_DOUBLE_VEC3 = $8FFD; - GL_DOUBLE_VEC4 = $8FFE; - GL_DOUBLE_MAT2 = $8F46; - GL_DOUBLE_MAT3 = $8F47; - GL_DOUBLE_MAT4 = $8F48; - GL_DOUBLE_MAT2x3 = $8F49; - GL_DOUBLE_MAT2x4 = $8F4A; - GL_DOUBLE_MAT3x2 = $8F4B; - GL_DOUBLE_MAT3x4 = $8F4C; - GL_DOUBLE_MAT4x2 = $8F4D; - GL_DOUBLE_MAT4x3 = $8F4E; - - // GL_ARB_shader_subroutine - GL_ACTIVE_SUBROUTINES = $8DE5; - GL_ACTIVE_SUBROUTINE_UNIFORMS = $8DE6; - GL_ACTIVE_SUBROUTINE_UNIFORM_LOCATIONS = $8E47; - GL_ACTIVE_SUBROUTINE_MAX_LENGTH = $8E48; - GL_ACTIVE_SUBROUTINE_UNIFORM_MAX_LENGTH = $8E49; - GL_MAX_SUBROUTINES = $8DE7; - GL_MAX_SUBROUTINE_UNIFORM_LOCATIONS = $8DE8; - GL_NUM_COMPATIBLE_SUBROUTINES = $8E4A; - GL_COMPATIBLE_SUBROUTINES = $8E4B; - { reuse GL_UNIFORM_SIZE } - { reuse GL_UNIFORM_NAME_LENGTH } - - // GL_ARB_tessellation_shader - GL_PATCHES = $000E; - GL_PATCH_VERTICES = $8E72; - GL_PATCH_DEFAULT_INNER_LEVEL = $8E73; - GL_PATCH_DEFAULT_OUTER_LEVEL = $8E74; - GL_TESS_CONTROL_OUTPUT_VERTICES = $8E75; - GL_TESS_GEN_MODE = $8E76; - GL_TESS_GEN_SPACING = $8E77; - GL_TESS_GEN_VERTEX_ORDER = $8E78; - GL_TESS_GEN_POINT_MODE = $8E79; - { reuse GL_TRIANGLES } - { reuse GL_QUADS } - GL_ISOLINES = $8E7A; - { reuse GL_EQUAL } - GL_FRACTIONAL_ODD = $8E7B; - GL_FRACTIONAL_EVEN = $8E7C; - { reuse GL_CCW } - { reuse GL_CW } - GL_MAX_PATCH_VERTICES = $8E7D; - GL_MAX_TESS_GEN_LEVEL = $8E7E; - GL_MAX_TESS_CONTROL_UNIFORM_COMPONENTS = $8E7F; - GL_MAX_TESS_EVALUATION_UNIFORM_COMPONENTS = $8E80; - GL_MAX_TESS_CONTROL_TEXTURE_IMAGE_UNITS = $8E81; - GL_MAX_TESS_EVALUATION_TEXTURE_IMAGE_UNITS = $8E82; - GL_MAX_TESS_CONTROL_OUTPUT_COMPONENTS = $8E83; - GL_MAX_TESS_PATCH_COMPONENTS = $8E84; - GL_MAX_TESS_CONTROL_TOTAL_OUTPUT_COMPONENTS = $8E85; - GL_MAX_TESS_EVALUATION_OUTPUT_COMPONENTS = $8E86; - GL_MAX_TESS_CONTROL_UNIFORM_BLOCKS = $8E89; - GL_MAX_TESS_EVALUATION_UNIFORM_BLOCKS = $8E8A; - GL_MAX_TESS_CONTROL_INPUT_COMPONENTS = $886C; - GL_MAX_TESS_EVALUATION_INPUT_COMPONENTS = $886D; - GL_MAX_COMBINED_TESS_CONTROL_UNIFORM_COMPONENTS = $8E1E; - GL_MAX_COMBINED_TESS_EVALUATION_UNIFORM_COMPONENTS = $8E1F; - GL_UNIFORM_BLOCK_REFERENCED_BY_TESS_CONTROL_SHADER = $84F0; - GL_UNIFORM_BLOCK_REFERENCED_BY_TESS_EVALUATION_SHADER = $84F1; - GL_TESS_EVALUATION_SHADER = $8E87; - GL_TESS_CONTROL_SHADER = $8E88; - - // GL_ARB_texture_buffer_object_rgb32 - { reuse GL_RGB32F } - { reuse GL_RGB32UI } - { reuse GL_RGB32I } - - // GL_ARB_transform_feedback2 - GL_TRANSFORM_FEEDBACK = $8E22; - GL_TRANSFORM_FEEDBACK_PAUSED = $8E23; - GL_TRANSFORM_FEEDBACK_BUFFER_PAUSED = GL_TRANSFORM_FEEDBACK_PAUSED; - GL_TRANSFORM_FEEDBACK_ACTIVE = $8E24; - GL_TRANSFORM_FEEDBACK_BUFFER_ACTIVE = GL_TRANSFORM_FEEDBACK_ACTIVE; - GL_TRANSFORM_FEEDBACK_BINDING = $8E25; - - // GL_ARB_transform_feedback3 - GL_MAX_TRANSFORM_FEEDBACK_BUFFERS = $8E70; - GL_MAX_VERTEX_STREAMS = $8E71; - - // GL_ARB_ES2_compatibility - GL_FIXED = $140C; - GL_IMPLEMENTATION_COLOR_READ_TYPE = $8B9A; - GL_IMPLEMENTATION_COLOR_READ_FORMAT = $8B9B; - GL_LOW_FLOAT = $8DF0; - GL_MEDIUM_FLOAT = $8DF1; - GL_HIGH_FLOAT = $8DF2; - GL_LOW_INT = $8DF3; - GL_MEDIUM_INT = $8DF4; - GL_HIGH_INT = $8DF5; - GL_SHADER_COMPILER = $8DFA; - GL_NUM_SHADER_BINARY_FORMATS = $8DF9; - GL_MAX_VERTEX_UNIFORM_VECTORS = $8DFB; - GL_MAX_VARYING_VECTORS = $8DFC; - GL_MAX_FRAGMENT_UNIFORM_VECTORS = $8DFD; - GL_RGB565 = $8D62; - - // GL_ARB_get_program_binary - GL_PROGRAM_BINARY_RETRIEVABLE_HINT = $8257; - GL_PROGRAM_BINARY_LENGTH = $8741; - GL_NUM_PROGRAM_BINARY_FORMATS = $87FE; - GL_PROGRAM_BINARY_FORMATS = $87FF; - - // GL_ARB_separate_shader_objects - GL_VERTEX_SHADER_BIT = $00000001; - GL_FRAGMENT_SHADER_BIT = $00000002; - GL_GEOMETRY_SHADER_BIT = $00000004; - GL_TESS_CONTROL_SHADER_BIT = $00000008; - GL_TESS_EVALUATION_SHADER_BIT = $00000010; - GL_ALL_SHADER_BITS = $FFFFFFFF; - GL_PROGRAM_SEPARABLE = $8258; - GL_ACTIVE_PROGRAM = $8259; - GL_PROGRAM_PIPELINE_BINDING = $825A; - - // GL_ARB_vertex_attrib_64bit - { reuse GL_RGB32I } - { reuse GL_DOUBLE_VEC2 } - { reuse GL_DOUBLE_VEC3 } - { reuse GL_DOUBLE_VEC4 } - { reuse GL_DOUBLE_MAT2 } - { reuse GL_DOUBLE_MAT3 } - { reuse GL_DOUBLE_MAT4 } - { reuse GL_DOUBLE_MAT2x3 } - { reuse GL_DOUBLE_MAT2x4 } - { reuse GL_DOUBLE_MAT3x2 } - { reuse GL_DOUBLE_MAT3x4 } - { reuse GL_DOUBLE_MAT4x2 } - { reuse GL_DOUBLE_MAT4x3 } - - // GL_ARB_viewport_array - { reuse GL_SCISSOR_BOX } - { reuse GL_VIEWPORT } - { reuse GL_DEPTH_RANGE } - { reuse GL_SCISSOR_TEST } - GL_MAX_VIEWPORTS = $825B; - GL_VIEWPORT_SUBPIXEL_BITS = $825C; - GL_VIEWPORT_BOUNDS_RANGE = $825D; - GL_LAYER_PROVOKING_VERTEX = $825E; - GL_VIEWPORT_INDEX_PROVOKING_VERTEX = $825F; - GL_UNDEFINED_VERTEX = $8260; - { reuse GL_FIRST_VERTEX_CONVENTION } - { reuse GL_LAST_VERTEX_CONVENTION } - { reuse GL_PROVOKING_VERTEX } - - // GL_ARB_cl_event - GL_SYNC_CL_EVENT_ARB = $8240; - GL_SYNC_CL_EVENT_COMPLETE_ARB = $8241; - - // GL_ARB_debug_output - GL_DEBUG_OUTPUT_SYNCHRONOUS_ARB = $8242; - GL_DEBUG_NEXT_LOGGED_MESSAGE_LENGTH_ARB = $8243; - GL_DEBUG_CALLBACK_FUNCTION_ARB = $8244; - GL_DEBUG_CALLBACK_USER_PARAM_ARB = $8245; - GL_DEBUG_SOURCE_API_ARB = $8246; - GL_DEBUG_SOURCE_WINDOW_SYSTEM_ARB = $8247; - GL_DEBUG_SOURCE_SHADER_COMPILER_ARB = $8248; - GL_DEBUG_SOURCE_THIRD_PARTY_ARB = $8249; - GL_DEBUG_SOURCE_APPLICATION_ARB = $824A; - GL_DEBUG_SOURCE_OTHER_ARB = $824B; - GL_DEBUG_TYPE_ERROR_ARB = $824C; - GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR_ARB = $824D; - GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR_ARB = $824E; - GL_DEBUG_TYPE_PORTABILITY_ARB = $824F; - GL_DEBUG_TYPE_PERFORMANCE_ARB = $8250; - GL_DEBUG_TYPE_OTHER_ARB = $8251; - GL_MAX_DEBUG_MESSAGE_LENGTH_ARB = $9143; - GL_MAX_DEBUG_LOGGED_MESSAGES_ARB = $9144; - GL_DEBUG_LOGGED_MESSAGES_ARB = $9145; - GL_DEBUG_SEVERITY_HIGH_ARB = $9146; - GL_DEBUG_SEVERITY_MEDIUM_ARB = $9147; - GL_DEBUG_SEVERITY_LOW_ARB = $9148; - - // GL_ARB_robustness - { reuse GL_NO_ERROR } - GL_CONTEXT_FLAG_ROBUST_ACCESS_BIT_ARB = $00000004; - GL_LOSE_CONTEXT_ON_RESET_ARB = $8252; - GL_GUILTY_CONTEXT_RESET_ARB = $8253; - GL_INNOCENT_CONTEXT_RESET_ARB = $8254; - GL_UNKNOWN_CONTEXT_RESET_ARB = $8255; - GL_RESET_NOTIFICATION_STRATEGY_ARB = $8256; - GL_NO_RESET_NOTIFICATION_ARB = $8261; - - // GL_ARB_compressed_texture_pixel_storage - GL_UNPACK_COMPRESSED_BLOCK_WIDTH = $09127; - GL_UNPACK_COMPRESSED_BLOCK_HEIGHT = $09128; - GL_UNPACK_COMPRESSED_BLOCK_DEPTH = $09129; - GL_UNPACK_COMPRESSED_BLOCK_SIZE = $0912A; - GL_PACK_COMPRESSED_BLOCK_WIDTH = $0912B; - GL_PACK_COMPRESSED_BLOCK_HEIGHT = $0912C; - GL_PACK_COMPRESSED_BLOCK_DEPTH = $0912D; - GL_PACK_COMPRESSED_BLOCK_SIZE = $0912E; - - // GL_ARB_internalformat_query - GL_NUM_SAMPLE_COUNTS = $09380; - - // GL_ARB_map_buffer_alignment - GL_MIN_MAP_BUFFER_ALIGNMENT = $090BC; - - // GL_ARB_shader_atomic_counters - GL_ATOMIC_COUNTER_BUFFER = $92C0; - GL_ATOMIC_COUNTER_BUFFER_BINDING = $92C1; - GL_ATOMIC_COUNTER_BUFFER_START = $92C2; - GL_ATOMIC_COUNTER_BUFFER_SIZE = $92C3; - GL_ATOMIC_COUNTER_BUFFER_DATA_SIZE = $92C4; - GL_ATOMIC_COUNTER_BUFFER_ACTIVE_ATOMIC_COUNTERS = $92C5; - GL_ATOMIC_COUNTER_BUFFER_ACTIVE_ATOMIC_COUNTER_INDICES = $92C6; - GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_VERTEX_SHADER = $92C7; - GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_TESS_CONTROL_SHADER = $92C8; - GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_TESS_EVALUATION_SHADER = $92C9; - GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_GEOMETRY_SHADER = $92CA; - GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_FRAGMENT_SHADER = $92CB; - GL_MAX_VERTEX_ATOMIC_COUNTER_BUFFERS = $92CC; - GL_MAX_TESS_CONTROL_ATOMIC_COUNTER_BUFFERS = $92CD; - GL_MAX_TESS_EVALUATION_ATOMIC_COUNTER_BUFFERS = $92CE; - GL_MAX_GEOMETRY_ATOMIC_COUNTER_BUFFERS = $92CF; - GL_MAX_FRAGMENT_ATOMIC_COUNTER_BUFFERS = $92D0; - GL_MAX_COMBINED_ATOMIC_COUNTER_BUFFERS = $92D1; - GL_MAX_VERTEX_ATOMIC_COUNTERS = $92D2; - GL_MAX_TESS_CONTROL_ATOMIC_COUNTERS = $92D3; - GL_MAX_TESS_EVALUATION_ATOMIC_COUNTERS = $92D4; - GL_MAX_GEOMETRY_ATOMIC_COUNTERS = $92D5; - GL_MAX_FRAGMENT_ATOMIC_COUNTERS = $92D6; - GL_MAX_COMBINED_ATOMIC_COUNTERS = $92D7; - GL_MAX_ATOMIC_COUNTER_BUFFER_SIZE = $92D8; - GL_MAX_ATOMIC_COUNTER_BUFFER_BINDINGS = $92DC; - GL_ACTIVE_ATOMIC_COUNTER_BUFFERS = $92D9; - GL_UNIFORM_ATOMIC_COUNTER_BUFFER_INDEX = $92DA; - GL_UNSIGNED_INT_ATOMIC_COUNTER = $92DB; - - // GL_ARB_shader_image_load_store - GL_VERTEX_ATTRIB_ARRAY_BARRIER_BIT = $00000001; - GL_ELEMENT_ARRAY_BARRIER_BIT = $00000002; - GL_UNIFORM_BARRIER_BIT = $00000004; - GL_TEXTURE_FETCH_BARRIER_BIT = $00000008; - GL_SHADER_IMAGE_ACCESS_BARRIER_BIT = $00000020; - GL_COMMAND_BARRIER_BIT = $00000040; - GL_PIXEL_BUFFER_BARRIER_BIT = $00000080; - GL_TEXTURE_UPDATE_BARRIER_BIT = $00000100; - GL_BUFFER_UPDATE_BARRIER_BIT = $00000200; - GL_FRAMEBUFFER_BARRIER_BIT = $00000400; - GL_TRANSFORM_FEEDBACK_BARRIER_BIT = $00000800; - GL_ATOMIC_COUNTER_BARRIER_BIT = $00001000; - GL_ALL_BARRIER_BITS = $FFFFFFFF; - GL_MAX_IMAGE_UNITS = $8F38; - GL_MAX_COMBINED_IMAGE_UNITS_AND_FRAGMENT_OUTPUTS = $8F39; - GL_IMAGE_BINDING_NAME = $8F3A; - GL_IMAGE_BINDING_LEVEL = $8F3B; - GL_IMAGE_BINDING_LAYERED = $8F3C; - GL_IMAGE_BINDING_LAYER = $8F3D; - GL_IMAGE_BINDING_ACCESS = $8F3E; - GL_IMAGE_1D = $904C; - GL_IMAGE_2D = $904D; - GL_IMAGE_3D = $904E; - GL_IMAGE_2D_RECT = $904F; - GL_IMAGE_CUBE = $9050; - GL_IMAGE_BUFFER = $9051; - GL_IMAGE_1D_ARRAY = $9052; - GL_IMAGE_2D_ARRAY = $9053; - GL_IMAGE_CUBE_MAP_ARRAY = $9054; - GL_IMAGE_2D_MULTISAMPLE = $9055; - GL_IMAGE_2D_MULTISAMPLE_ARRAY = $9056; - GL_INT_IMAGE_1D = $9057; - GL_INT_IMAGE_2D = $9058; - GL_INT_IMAGE_3D = $9059; - GL_INT_IMAGE_2D_RECT = $905A; - GL_INT_IMAGE_CUBE = $905B; - GL_INT_IMAGE_BUFFER = $905C; - GL_INT_IMAGE_1D_ARRAY = $905D; - GL_INT_IMAGE_2D_ARRAY = $905E; - GL_INT_IMAGE_CUBE_MAP_ARRAY = $905F; - GL_INT_IMAGE_2D_MULTISAMPLE = $9060; - GL_INT_IMAGE_2D_MULTISAMPLE_ARRAY = $9061; - GL_UNSIGNED_INT_IMAGE_1D = $9062; - GL_UNSIGNED_INT_IMAGE_2D = $9063; - GL_UNSIGNED_INT_IMAGE_3D = $9064; - GL_UNSIGNED_INT_IMAGE_2D_RECT = $9065; - GL_UNSIGNED_INT_IMAGE_CUBE = $9066; - GL_UNSIGNED_INT_IMAGE_BUFFER = $9067; - GL_UNSIGNED_INT_IMAGE_1D_ARRAY = $9068; - GL_UNSIGNED_INT_IMAGE_2D_ARRAY = $9069; - GL_UNSIGNED_INT_IMAGE_CUBE_MAP_ARRAY = $906A; - GL_UNSIGNED_INT_IMAGE_2D_MULTISAMPLE = $906B; - GL_UNSIGNED_INT_IMAGE_2D_MULTISAMPLE_ARRAY = $906C; - GL_MAX_IMAGE_SAMPLES = $906D; - GL_IMAGE_BINDING_FORMAT = $906E; - GL_IMAGE_FORMAT_COMPATIBILITY_TYPE = $90C7; - GL_IMAGE_FORMAT_COMPATIBILITY_BY_SIZE = $90C8; - GL_IMAGE_FORMAT_COMPATIBILITY_BY_CLASS = $90C9; - GL_MAX_VERTEX_IMAGE_UNIFORMS = $90CA; - GL_MAX_TESS_CONTROL_IMAGE_UNIFORMS = $90CB; - GL_MAX_TESS_EVALUATION_IMAGE_UNIFORMS = $90CC; - GL_MAX_GEOMETRY_IMAGE_UNIFORMS = $90CD; - GL_MAX_FRAGMENT_IMAGE_UNIFORMS = $90CE; - GL_MAX_COMBINED_IMAGE_UNIFORMS = $90CF; - - // GL_ARB_texture_storage - GL_TEXTURE_IMMUTABLE_FORMAT = $912F; - - // (4.3) GL_KHR_texture_compression_astc_ldr - GL_COMPRESSED_RGBA_ASTC_4x4_KHR = $93B0; - GL_COMPRESSED_RGBA_ASTC_5x4_KHR = $93B1; - GL_COMPRESSED_RGBA_ASTC_5x5_KHR = $93B2; - GL_COMPRESSED_RGBA_ASTC_6x5_KHR = $93B3; - GL_COMPRESSED_RGBA_ASTC_6x6_KHR = $93B4; - GL_COMPRESSED_RGBA_ASTC_8x5_KHR = $93B5; - GL_COMPRESSED_RGBA_ASTC_8x6_KHR = $93B6; - GL_COMPRESSED_RGBA_ASTC_8x8_KHR = $93B7; - GL_COMPRESSED_RGBA_ASTC_105_KHR = $93B8; - GL_COMPRESSED_RGBA_ASTC_106_KHR = $93B9; - GL_COMPRESSED_RGBA_ASTC_108_KHR = $93BA; - GL_COMPRESSED_RGBA_ASTC_110_KHR = $93BB; - GL_COMPRESSED_RGBA_ASTC_12x10_KHR = $93BC; - GL_COMPRESSED_RGBA_ASTC_12x12_KHR = $93BD; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_4x4_KHR = $93D0; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_5x4_KHR = $93D1; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_5x5_KHR = $93D2; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_6x5_KHR = $93D3; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_6x6_KHR = $93D4; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_8x5_KHR = $93D5; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_8x6_KHR = $93D6; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_8x8_KHR = $93D7; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_10x5_KHR = $93D8; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_10x6_KHR = $93D9; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_10x8_KHR = $93DA; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_10x10_KHR = $93DB; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_12x10_KHR = $93DC; - GL_COMPRESSED_SRGB8_ALPHA8_ASTC_12x12_KHR = $93DD; - - // (4.3) GL_KHR_debug - GL_DEBUG_OUTPUT_SYNCHRONOUS = $8242; - GL_DEBUG_NEXT_LOGGED_MESSAGE_LENGTH = $8243; - GL_DEBUG_CALLBACK_FUNCTION = $8244; - GL_DEBUG_CALLBACK_USER_PARAM = $8245; - GL_DEBUG_SOURCE_API = $8246; - GL_DEBUG_SOURCE_WINDOW_SYSTEM = $8247; - GL_DEBUG_SOURCE_SHADER_COMPILER = $8248; - GL_DEBUG_SOURCE_THIRD_PARTY = $8249; - GL_DEBUG_SOURCE_APPLICATION = $824A; - GL_DEBUG_SOURCE_OTHER = $824B; - GL_DEBUG_TYPE_ERROR = $824C; - GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR = $824D; - GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR = $824E; - GL_DEBUG_TYPE_PORTABILITY = $824F; - GL_DEBUG_TYPE_PERFORMANCE = $8250; - GL_DEBUG_TYPE_OTHER = $8251; - GL_DEBUG_TYPE_MARKER = $8268; - GL_DEBUG_TYPE_PUSH_GROUP = $8269; - GL_DEBUG_TYPE_POP_GROUP = $826A; - GL_DEBUG_SEVERITY_NOTIFICATION = $826B; - GL_MAX_DEBUG_GROUP_STACK_DEPTH = $826C; - GL_DEBUG_GROUP_STACK_DEPTH = $826D; - GL_BUFFER = $82E0; - GL_SHADER = $82E1; - GL_PROGRAM = $82E2; - GL_QUERY = $82E3; - GL_PROGRAM_PIPELINE = $82E4; - GL_SAMPLER = $82E6; - GL_DISPLAY_LIST = $82E7; - GL_MAX_LABEL_LENGTH = $82E8; - GL_MAX_DEBUG_MESSAGE_LENGTH = $9143; - GL_MAX_DEBUG_LOGGED_MESSAGES = $9144; - GL_DEBUG_LOGGED_MESSAGES = $9145; - GL_DEBUG_SEVERITY_HIGH = $9146; - GL_DEBUG_SEVERITY_MEDIUM = $9147; - GL_DEBUG_SEVERITY_LOW = $9148; - GL_DEBUG_OUTPUT = $92E0; - GL_CONTEXT_FLAG_DEBUG_BIT = $00000002; - { reuse GL_STACK_UNDERFLOW } - { reuse GL_STACK_OVERFLOW } - - // (4.3) GL_ARB_compute_shader - GL_COMPUTE_SHADER = $91B9; - GL_MAX_COMPUTE_UNIFORM_BLOCKS = $91BB; - GL_MAX_COMPUTE_TEXTURE_IMAGE_UNITS = $91BC; - GL_MAX_COMPUTE_IMAGE_UNIFORMS = $91BD; - GL_MAX_COMPUTE_SHARED_MEMORY_SIZE = $8262; - GL_MAX_COMPUTE_UNIFORM_COMPONENTS = $8263; - GL_MAX_COMPUTE_ATOMIC_COUNTER_BUFFERS = $8264; - GL_MAX_COMPUTE_ATOMIC_COUNTERS = $8265; - GL_MAX_COMBINED_COMPUTE_UNIFORM_COMPONENTS = $8266; - GL_MAX_COMPUTE_LOCAL_INVOCATIONS = $90EB; - GL_MAX_COMPUTE_WORK_GROUP_COUNT = $91BE; - GL_MAX_COMPUTE_WORK_GROUP_SIZE = $91BF; - GL_COMPUTE_LOCAL_WORK_SIZE = $8267; - GL_UNIFORM_BLOCK_REFERENCED_BY_COMPUTE_SHADER = $90EC; - GL_ATOMIC_COUNTER_BUFFER_REFERENCED_BY_COMPUTE_SHADER = $90ED; - GL_DISPATCH_INDIRECT_BUFFER = $90EE; - GL_DISPATCH_INDIRECT_BUFFER_BINDING = $90EF; - GL_COMPUTE_SHADER_BIT = $00000020; - - // (4.3) GL_ARB_ES3_compatibility - GL_COMPRESSED_RGB8_ETC2 = $9274; - GL_COMPRESSED_SRGB8_ETC2 = $9275; - GL_COMPRESSED_RGB8_PUNCHTHROUGH_ALPHA1_ETC2 = $9276; - GL_COMPRESSED_SRGB8_PUNCHTHROUGH_ALPHA1_ETC2 = $9277; - GL_COMPRESSED_RGBA8_ETC2_EAC = $9278; - GL_COMPRESSED_SRGB8_ALPHA8_ETC2_EAC = $9279; - GL_COMPRESSED_R11_EAC = $9270; - GL_COMPRESSED_SIGNED_R11_EAC = $9271; - GL_COMPRESSED_RG11_EAC = $9272; - GL_COMPRESSED_SIGNED_RG11_EAC = $9273; - GL_PRIMITIVE_RESTART_FIXED_INDEX = $8D69; - GL_ANY_SAMPLES_PASSED_CONSERVATIVE = $8D6A; - GL_MAX_ELEMENT_INDEX = $8D6B; - - // (4.3) GL_ARB_explicit_uniform_location - GL_MAX_UNIFORM_LOCATIONS = $826E; - - // (4.3) GL_ARB_fragment_layer_viewport - - // (4.3) GL_ARB_framebuffer_no_attachments - GL_FRAMEBUFFER_DEFAULT_WIDTH = $9310; - GL_FRAMEBUFFER_DEFAULT_HEIGHT = $9311; - GL_FRAMEBUFFER_DEFAULT_LAYERS = $9312; - GL_FRAMEBUFFER_DEFAULT_SAMPLES = $9313; - GL_FRAMEBUFFER_DEFAULT_FIXED_SAMPLE_LOCATIONS = $9314; - GL_MAX_FRAMEBUFFER_WIDTH = $9315; - GL_MAX_FRAMEBUFFER_HEIGHT = $9316; - GL_MAX_FRAMEBUFFER_LAYERS = $9317; - GL_MAX_FRAMEBUFFER_SAMPLES = $9318; - - // (4.3) GL_ARB_internalformat_query2 - { reuse GL_IMAGE_FORMAT_COMPATIBILITY_TYPE } - { reuse GL_NUM_SAMPLE_COUNTS } - { reuse GL_RENDERBUFFER } - { reuse GL_SAMPLES } - { reuse GL_TEXTURE_1D } - { reuse GL_TEXTURE_1D_ARRAY } - { reuse GL_TEXTURE_2D } - { reuse GL_TEXTURE_2D_ARRAY } - { reuse GL_TEXTURE_3D } - { reuse GL_TEXTURE_CUBE_MAP } - { reuse GL_TEXTURE_CUBE_MAP_ARRAY } - { reuse GL_TEXTURE_RECTANGLE } - { reuse GL_TEXTURE_BUFFER } - { reuse GL_TEXTURE_2D_MULTISAMPLE } - { reuse GL_TEXTURE_2D_MULTISAMPLE_ARRAY } - { reuse GL_TEXTURE_COMPRESSED } - GL_INTERNALFORMAT_SUPPORTED = $826F; - GL_INTERNALFORMAT_PREFERRED = $8270; - GL_INTERNALFORMAT_RED_SIZE = $8271; - GL_INTERNALFORMAT_GREEN_SIZE = $8272; - GL_INTERNALFORMAT_BLUE_SIZE = $8273; - GL_INTERNALFORMAT_ALPHA_SIZE = $8274; - GL_INTERNALFORMAT_DEPTH_SIZE = $8275; - GL_INTERNALFORMAT_STENCIL_SIZE = $8276; - GL_INTERNALFORMAT_SHARED_SIZE = $8277; - GL_INTERNALFORMAT_RED_TYPE = $8278; - GL_INTERNALFORMAT_GREEN_TYPE = $8279; - GL_INTERNALFORMAT_BLUE_TYPE = $827A; - GL_INTERNALFORMAT_ALPHA_TYPE = $827B; - GL_INTERNALFORMAT_DEPTH_TYPE = $827C; - GL_INTERNALFORMAT_STENCIL_TYPE = $827D; - GL_MAX_WIDTH = $827E; - GL_MAX_HEIGHT = $827F; - GL_MAX_DEPTH = $8280; - GL_MAX_LAYERS = $8281; - GL_MAX_COMBINED_DIMENSIONS = $8282; - GL_COLOR_COMPONENTS = $8283; - GL_DEPTH_COMPONENTS = $8284; - GL_STENCIL_COMPONENTS = $8285; - GL_COLOR_RENDERABLE = $8286; - GL_DEPTH_RENDERABLE = $8287; - GL_STENCIL_RENDERABLE = $8288; - GL_FRAMEBUFFER_RENDERABLE = $8289; - GL_FRAMEBUFFER_RENDERABLE_LAYERED = $828A; - GL_FRAMEBUFFER_BLEND = $828B; - GL_READ_PIXELS = $828C; - GL_READ_PIXELS_FORMAT = $828D; - GL_READ_PIXELS_TYPE = $828E; - GL_TEXTURE_IMAGE_FORMAT = $828F; - GL_TEXTURE_IMAGE_TYPE = $8290; - GL_GET_TEXTURE_IMAGE_FORMAT = $8291; - GL_GET_TEXTURE_IMAGE_TYPE = $8292; - GL_MIPMAP = $8293; - GL_MANUAL_GENERATE_MIPMAP = $8294; - GL_AUTO_GENERATE_MIPMAP = $8295; - GL_COLOR_ENCODING = $8296; - GL_SRGB_READ = $8297; - GL_SRGB_WRITE = $8298; - GL_SRGB_DECODE_ARB = $8299; - GL_FILTER = $829A; - GL_VERTEX_TEXTURE = $829B; - GL_TESS_CONTROL_TEXTURE = $829C; - GL_TESS_EVALUATION_TEXTURE = $829D; - GL_GEOMETRY_TEXTURE = $829E; - GL_FRAGMENT_TEXTURE = $829F; - GL_COMPUTE_TEXTURE = $82A0; - GL_TEXTURE_SHADOW = $82A1; - GL_TEXTURE_GATHER = $82A2; - GL_TEXTURE_GATHER_SHADOW = $82A3; - GL_SHADER_IMAGE_LOAD = $82A4; - GL_SHADER_IMAGE_STORE = $82A5; - GL_SHADER_IMAGE_ATOMIC = $82A6; - GL_IMAGE_TEXEL_SIZE = $82A7; - GL_IMAGE_COMPATIBILITY_CLASS = $82A8; - GL_IMAGE_PIXEL_FORMAT = $82A9; - GL_IMAGE_PIXEL_TYPE = $82AA; - GL_SIMULTANEOUS_TEXTURE_AND_DEPTH_TEST = $82AC; - GL_SIMULTANEOUS_TEXTURE_AND_STENCIL_TEST = $82AD; - GL_SIMULTANEOUS_TEXTURE_AND_DEPTH_WRITE = $82AE; - GL_SIMULTANEOUS_TEXTURE_AND_STENCIL_WRITE = $82AF; - GL_TEXTURE_COMPRESSED_BLOCK_WIDTH = $82B1; - GL_TEXTURE_COMPRESSED_BLOCK_HEIGHT = $82B2; - GL_TEXTURE_COMPRESSED_BLOCK_SIZE = $82B3; - GL_CLEAR_BUFFER = $82B4; - GL_TEXTURE_VIEW = $82B5; - GL_VIEW_COMPATIBILITY_CLASS = $82B6; - GL_FULL_SUPPORT = $82B7; - GL_CAVEAT_SUPPORT = $82B8; - GL_IMAGE_CLASS_4_X_32 = $82B9; - GL_IMAGE_CLASS_2_X_32 = $82BA; - GL_IMAGE_CLASS_1_X_32 = $82BB; - GL_IMAGE_CLASS_4_X_16 = $82BC; - GL_IMAGE_CLASS_2_X_16 = $82BD; - GL_IMAGE_CLASS_1_X_16 = $82BE; - GL_IMAGE_CLASS_4_X_8 = $82BF; - GL_IMAGE_CLASS_2_X_8 = $82C0; - GL_IMAGE_CLASS_1_X_8 = $82C1; - GL_IMAGE_CLASS_11_11_10 = $82C2; - GL_IMAGE_CLASS_10_10_10_2 = $82C3; - GL_VIEW_CLASS_128_BITS = $82C4; - GL_VIEW_CLASS_96_BITS = $82C5; - GL_VIEW_CLASS_64_BITS = $82C6; - GL_VIEW_CLASS_48_BITS = $82C7; - GL_VIEW_CLASS_32_BITS = $82C8; - GL_VIEW_CLASS_24_BITS = $82C9; - GL_VIEW_CLASS_16_BITS = $82CA; - GL_VIEW_CLASS_8_BITS = $82CB; - GL_VIEW_CLASS_S3TC_DXT1_RGB = $82CC; - GL_VIEW_CLASS_S3TC_DXT1_RGBA = $82CD; - GL_VIEW_CLASS_S3TC_DXT3_RGBA = $82CE; - GL_VIEW_CLASS_S3TC_DXT5_RGBA = $82CF; - GL_VIEW_CLASS_RGTC1_RED = $82D0; - GL_VIEW_CLASS_RGTC2_RG = $82D1; - GL_VIEW_CLASS_BPTC_UNORM = $82D2; - GL_VIEW_CLASS_BPTC_FLOAT = $82D3; - - // (4.3) GL_ARB_invalidate_subdata - - // (4.3) GL_ARB_multi_draw_indirect - - // (4.3) GL_ARB_program_interface_query - GL_UNIFORM = $92E1; - GL_UNIFORM_BLOCK = $92E2; - GL_PROGRAM_INPUT = $92E3; - GL_PROGRAM_OUTPUT = $92E4; - GL_BUFFER_VARIABLE = $92E5; - GL_SHADER_STORAGE_BLOCK = $92E6; - { reuse GL_ATOMIC_COUNTER_BUFFER } - GL_VERTEX_SUBROUTINE = $92E8; - GL_TESS_CONTROL_SUBROUTINE = $92E9; - GL_TESS_EVALUATION_SUBROUTINE = $92EA; - GL_GEOMETRY_SUBROUTINE = $92EB; - GL_FRAGMENT_SUBROUTINE = $92EC; - GL_COMPUTE_SUBROUTINE = $92ED; - GL_VERTEX_SUBROUTINE_UNIFORM = $92EE; - GL_TESS_CONTROL_SUBROUTINE_UNIFORM = $92EF; - GL_TESS_EVALUATION_SUBROUTINE_UNIFORM = $92F0; - GL_GEOMETRY_SUBROUTINE_UNIFORM = $92F1; - GL_FRAGMENT_SUBROUTINE_UNIFORM = $92F2; - GL_COMPUTE_SUBROUTINE_UNIFORM = $92F3; - GL_TRANSFORM_FEEDBACK_VARYING = $92F4; - GL_ACTIVE_RESOURCES = $92F5; - GL_MAX_NAME_LENGTH = $92F6; - GL_MAX_NUM_ACTIVE_VARIABLES = $92F7; - GL_MAX_NUM_COMPATIBLE_SUBROUTINES = $92F8; - GL_NAME_LENGTH = $92F9; - GL_TYPE = $92FA; - GL_ARRAY_SIZE = $92FB; - GL_OFFSET = $92FC; - GL_BLOCK_INDEX = $92FD; - GL_ARRAY_STRIDE = $92FE; - GL_MATRIX_STRIDE = $92FF; - GL_IS_ROW_MAJOR = $9300; - GL_ATOMIC_COUNTER_BUFFER_INDEX = $9301; - GL_BUFFER_BINDING = $9302; - GL_BUFFER_DATA_SIZE = $9303; - GL_NUM_ACTIVE_VARIABLES = $9304; - GL_ACTIVE_VARIABLES = $9305; - GL_REFERENCED_BY_VERTEX_SHADER = $9306; - GL_REFERENCED_BY_TESS_CONTROL_SHADER = $9307; - GL_REFERENCED_BY_TESS_EVALUATION_SHADER = $9308; - GL_REFERENCED_BY_GEOMETRY_SHADER = $9309; - GL_REFERENCED_BY_FRAGMENT_SHADER = $930A; - GL_REFERENCED_BY_COMPUTE_SHADER = $930B; - GL_TOP_LEVEL_ARRAY_SIZE = $930C; - GL_TOP_LEVEL_ARRAY_STRIDE = $930D; - GL_LOCATION = $930E; - GL_LOCATION_INDEX = $930F; - GL_IS_PER_PATCH = $92E7; - { reuse GL_NUM_COMPATIBLE_SUBROUTINES } - { reuse GL_COMPATIBLE_SUBROUTINES } - - // (4.3) GL_ARB_robust_buffer_access_behavior - - // (4.3) GL_ARB_shader_image_size - - // (4.3) GL_ARB_shader_storage_buffer_object - GL_SHADER_STORAGE_BUFFER = $90D2; - GL_SHADER_STORAGE_BUFFER_BINDING = $90D3; - GL_SHADER_STORAGE_BUFFER_START = $90D4; - GL_SHADER_STORAGE_BUFFER_SIZE = $90D5; - GL_MAX_VERTEX_SHADER_STORAGE_BLOCKS = $90D6; - GL_MAX_GEOMETRY_SHADER_STORAGE_BLOCKS = $90D7; - GL_MAX_TESS_CONTROL_SHADER_STORAGE_BLOCKS = $90D8; - GL_MAX_TESS_EVALUATION_SHADER_STORAGE_BLOCKS = $90D9; - GL_MAX_FRAGMENT_SHADER_STORAGE_BLOCKS = $90DA; - GL_MAX_COMPUTE_SHADER_STORAGE_BLOCKS = $90DB; - GL_MAX_COMBINED_SHADER_STORAGE_BLOCKS = $90DC; - GL_MAX_SHADER_STORAGE_BUFFER_BINDINGS = $90DD; - GL_MAX_SHADER_STORAGE_BLOCK_SIZE = $90DE; - GL_SHADER_STORAGE_BUFFER_OFFSET_ALIGNMENT = $90DF; - GL_SHADER_STORAGE_BARRIER_BIT = $2000; - GL_MAX_COMBINED_SHADER_OUTPUT_RESOURCES = GL_MAX_COMBINED_IMAGE_UNITS_AND_FRAGMENT_OUTPUTS; - { reuse GL_MAX_COMBINED_IMAGE_UNITS_AND_FRAGMENT_OUTPUTS } - - // (4.3) GL_ARB_stencil_texturing - GL_DEPTH_STENCIL_TEXTURE_MODE = $90EA; - - // (4.3) GL_ARB_texture_buffer_range - GL_TEXTURE_BUFFER_OFFSET = $919D; - GL_TEXTURE_BUFFER_SIZE = $919E; - GL_TEXTURE_BUFFER_OFFSET_ALIGNMENT = $919F; - - // (4.3) GL_ARB_texture_query_levels - - // (4.3) GL_ARB_texture_storage_multisample - - // (4.3) GL_ARB_texture_view - GL_TEXTURE_VIEW_MIN_LEVEL = $82DB; - GL_TEXTURE_VIEW_NUM_LEVELS = $82DC; - GL_TEXTURE_VIEW_MIN_LAYER = $82DD; - GL_TEXTURE_VIEW_NUM_LAYERS = $82DE; - GL_TEXTURE_IMMUTABLE_LEVELS = $82DF; - - // (4.3) GL_ARB_vertex_attrib_binding - GL_VERTEX_ATTRIB_BINDING = $82D4; - GL_VERTEX_ATTRIB_RELATIVE_OFFSET = $82D5; - GL_VERTEX_BINDING_DIVISOR = $82D6; - GL_VERTEX_BINDING_OFFSET = $82D7; - GL_VERTEX_BINDING_STRIDE = $82D8; - GL_MAX_VERTEX_ATTRIB_RELATIVE_OFFSET = $82D9; - GL_MAX_VERTEX_ATTRIB_BINDINGS = $82DA; - - // (4.3) GL_ARB_robustness_isolation - - // GL_ATI_draw_buffers - GL_MAX_DRAW_BUFFERS_ATI = $8824; - GL_DRAW_BUFFER0_ATI = $8825; - GL_DRAW_BUFFER1_ATI = $8826; - GL_DRAW_BUFFER2_ATI = $8827; - GL_DRAW_BUFFER3_ATI = $8828; - GL_DRAW_BUFFER4_ATI = $8829; - GL_DRAW_BUFFER5_ATI = $882A; - GL_DRAW_BUFFER6_ATI = $882B; - GL_DRAW_BUFFER7_ATI = $882C; - GL_DRAW_BUFFER8_ATI = $882D; - GL_DRAW_BUFFER9_ATI = $882E; - GL_DRAW_BUFFER10_ATI = $882F; - GL_DRAW_BUFFER11_ATI = $8830; - GL_DRAW_BUFFER12_ATI = $8831; - GL_DRAW_BUFFER13_ATI = $8832; - GL_DRAW_BUFFER14_ATI = $8833; - GL_DRAW_BUFFER15_ATI = $8834; - - // GL_ATI_element_array - GL_ELEMENT_ARRAY_ATI = $8768; - GL_ELEMENT_ARRAY_TYPE_ATI = $8769; - GL_ELEMENT_ARRAY_POINTER_ATI = $876A; - - // GL_ATI_envmap_bumpmap - GL_BUMP_ROT_MATRIX_ATI = $8775; - GL_BUMP_ROT_MATRIX_SIZE_ATI = $8776; - GL_BUMP_NUM_TEX_UNITS_ATI = $8777; - GL_BUMP_TEX_UNITS_ATI = $8778; - GL_DUDV_ATI = $8779; - GL_DU8DV8_ATI = $877A; - GL_BUMP_ENVMAP_ATI = $877B; - GL_BUMP_TARGET_ATI = $877C; - - // GL_ATI_fragment_shader - GL_FRAGMENT_SHADER_ATI = $8920; - GL_REG_0_ATI = $8921; - GL_REG_1_ATI = $8922; - GL_REG_2_ATI = $8923; - GL_REG_3_ATI = $8924; - GL_REG_4_ATI = $8925; - GL_REG_5_ATI = $8926; - GL_REG_6_ATI = $8927; - GL_REG_7_ATI = $8928; - GL_REG_8_ATI = $8929; - GL_REG_9_ATI = $892A; - GL_REG_10_ATI = $892B; - GL_REG_11_ATI = $892C; - GL_REG_12_ATI = $892D; - GL_REG_13_ATI = $892E; - GL_REG_14_ATI = $892F; - GL_REG_15_ATI = $8930; - GL_REG_16_ATI = $8931; - GL_REG_17_ATI = $8932; - GL_REG_18_ATI = $8933; - GL_REG_19_ATI = $8934; - GL_REG_20_ATI = $8935; - GL_REG_21_ATI = $8936; - GL_REG_22_ATI = $8937; - GL_REG_23_ATI = $8938; - GL_REG_24_ATI = $8939; - GL_REG_25_ATI = $893A; - GL_REG_26_ATI = $893B; - GL_REG_27_ATI = $893C; - GL_REG_28_ATI = $893D; - GL_REG_29_ATI = $893E; - GL_REG_30_ATI = $893F; - GL_REG_31_ATI = $8940; - GL_CON_0_ATI = $8941; - GL_CON_1_ATI = $8942; - GL_CON_2_ATI = $8943; - GL_CON_3_ATI = $8944; - GL_CON_4_ATI = $8945; - GL_CON_5_ATI = $8946; - GL_CON_6_ATI = $8947; - GL_CON_7_ATI = $8948; - GL_CON_8_ATI = $8949; - GL_CON_9_ATI = $894A; - GL_CON_10_ATI = $894B; - GL_CON_11_ATI = $894C; - GL_CON_12_ATI = $894D; - GL_CON_13_ATI = $894E; - GL_CON_14_ATI = $894F; - GL_CON_15_ATI = $8950; - GL_CON_16_ATI = $8951; - GL_CON_17_ATI = $8952; - GL_CON_18_ATI = $8953; - GL_CON_19_ATI = $8954; - GL_CON_20_ATI = $8955; - GL_CON_21_ATI = $8956; - GL_CON_22_ATI = $8957; - GL_CON_23_ATI = $8958; - GL_CON_24_ATI = $8959; - GL_CON_25_ATI = $895A; - GL_CON_26_ATI = $895B; - GL_CON_27_ATI = $895C; - GL_CON_28_ATI = $895D; - GL_CON_29_ATI = $895E; - GL_CON_30_ATI = $895F; - GL_CON_31_ATI = $8960; - GL_MOV_ATI = $8961; - GL_ADD_ATI = $8963; - GL_MUL_ATI = $8964; - GL_SUB_ATI = $8965; - GL_DOT3_ATI = $8966; - GL_DOT4_ATI = $8967; - GL_MAD_ATI = $8968; - GL_LERP_ATI = $8969; - GL_CND_ATI = $896A; - GL_CND0_ATI = $896B; - GL_DOT2_ADD_ATI = $896C; - GL_SECONDARY_INTERPOLATOR_ATI = $896D; - GL_NUM_FRAGMENT_REGISTERS_ATI = $896E; - GL_NUM_FRAGMENT_CONSTANTS_ATI = $896F; - GL_NUM_PASSES_ATI = $8970; - GL_NUM_INSTRUCTIONS_PER_PASS_ATI = $8971; - GL_NUM_INSTRUCTIONS_TOTAL_ATI = $8972; - GL_NUM_INPUT_INTERPOLATOR_COMPONENTS_ATI = $8973; - GL_NUM_LOOPBACK_COMPONENTS_ATI = $8974; - GL_COLOR_ALPHA_PAIRING_ATI = $8975; - GL_SWIZZLE_STR_ATI = $8976; - GL_SWIZZLE_STQ_ATI = $8977; - GL_SWIZZLE_STR_DR_ATI = $8978; - GL_SWIZZLE_STQ_DQ_ATI = $8979; - GL_SWIZZLE_STRQ_ATI = $897A; - GL_SWIZZLE_STRQ_DQ_ATI = $897B; - GL_RED_BIT_ATI = $00000001; - GL_GREEN_BIT_ATI = $00000002; - GL_BLUE_BIT_ATI = $00000004; - GL_2X_BIT_ATI = $00000001; - GL_4X_BIT_ATI = $00000002; - GL_8X_BIT_ATI = $00000004; - GL_HALF_BIT_ATI = $00000008; - GL_QUARTER_BIT_ATI = $00000010; - GL_EIGHTH_BIT_ATI = $00000020; - GL_SATURATE_BIT_ATI = $00000040; - GL_COMP_BIT_ATI = $00000002; - GL_NEGATE_BIT_ATI = $00000004; - GL_BIAS_BIT_ATI = $00000008; - - // GL_ATI_pn_triangles - GL_PN_TRIANGLES_ATI = $87F0; - GL_MAX_PN_TRIANGLES_TESSELATION_LEVEL_ATI = $87F1; - GL_PN_TRIANGLES_POINT_MODE_ATI = $87F2; - GL_PN_TRIANGLES_NORMAL_MODE_ATI = $87F3; - GL_PN_TRIANGLES_TESSELATION_LEVEL_ATI = $87F4; - GL_PN_TRIANGLES_POINT_MODE_LINEAR_ATI = $87F5; - GL_PN_TRIANGLES_POINT_MODE_CUBIC_ATI = $87F6; - GL_PN_TRIANGLES_NORMAL_MODE_LINEAR_ATI = $87F7; - GL_PN_TRIANGLES_NORMAL_MODE_QUADRATIC_ATI = $87F8; - - // GL_ATI_separate_stencil - GL_STENCIL_BACK_FUNC_ATI = $8800; - GL_STENCIL_BACK_FAIL_ATI = $8801; - GL_STENCIL_BACK_PASS_DEPTH_FAIL_ATI = $8802; - GL_STENCIL_BACK_PASS_DEPTH_PASS_ATI = $8803; - - // GL_ATI_text_fragment_shader - GL_TEXT_FRAGMENT_SHADER_ATI = $8200; - - // GL_ATI_texture_env_combine3 - GL_MODULATE_ADD_ATI = $8744; - GL_MODULATE_SIGNED_ADD_ATI = $8745; - GL_MODULATE_SUBTRACT_ATI = $8746; - - // GL_ATI_texture_float - GL_RGBA_FLOAT32_ATI = $8814; - GL_RGB_FLOAT32_ATI = $8815; - GL_ALPHA_FLOAT32_ATI = $8816; - GL_INTENSITY_FLOAT32_ATI = $8817; - GL_LUMINANCE_FLOAT32_ATI = $8818; - GL_LUMINANCE_ALPHA_FLOAT32_ATI = $8819; - GL_RGBA_FLOAT16_ATI = $881A; - GL_RGB_FLOAT16_ATI = $881B; - GL_ALPHA_FLOAT16_ATI = $881C; - GL_INTENSITY_FLOAT16_ATI = $881D; - GL_LUMINANCE_FLOAT16_ATI = $881E; - GL_LUMINANCE_ALPHA_FLOAT16_ATI = $881F; - - // GL_ATI_texture_mirror_once - GL_MIRROR_CLAMP_ATI = $8742; - GL_MIRROR_CLAMP_TO_EDGE_ATI = $8743; - - // GL_ATI_vertex_array_object - GL_STATIC_ATI = $8760; - GL_DYNAMIC_ATI = $8761; - GL_PRESERVE_ATI = $8762; - GL_DISCARD_ATI = $8763; - GL_OBJECT_BUFFER_SIZE_ATI = $8764; - GL_OBJECT_BUFFER_USAGE_ATI = $8765; - GL_ARRAY_OBJECT_BUFFER_ATI = $8766; - GL_ARRAY_OBJECT_OFFSET_ATI = $8767; - - // GL_ATI_vertex_streams - GL_MAX_VERTEX_STREAMS_ATI = $876B; - GL_VERTEX_STREAM0_ATI = $876C; - GL_VERTEX_STREAM1_ATI = $876D; - GL_VERTEX_STREAM2_ATI = $876E; - GL_VERTEX_STREAM3_ATI = $876F; - GL_VERTEX_STREAM4_ATI = $8770; - GL_VERTEX_STREAM5_ATI = $8771; - GL_VERTEX_STREAM6_ATI = $8772; - GL_VERTEX_STREAM7_ATI = $8773; - GL_VERTEX_SOURCE_ATI = $8774; - - // GL_ATI_meminfo - GL_VBO_FREE_MEMORY_ATI = $87FB; - GL_TEXTURE_FREE_MEMORY_ATI = $87FC; - GL_RENDERBUFFER_FREE_MEMORY_ATI = $87FD; - - // GL_AMD_performance_monitor - GL_COUNTER_TYPE_AMD = $8BC0; - GL_COUNTER_RANGE_AMD = $8BC1; - GL_UNSIGNED_INT64_AMD = $8BC2; - GL_PERCENTAGE_AMD = $8BC3; - GL_PERFMON_RESULT_AVAILABLE_AMD = $8BC4; - GL_PERFMON_RESULT_SIZE_AMD = $8BC5; - GL_PERFMON_RESULT_AMD = $8BC6; - - // GL_AMD_vertex_shader_tesselator - GL_SAMPLER_BUFFER_AMD = $9001; - GL_INT_SAMPLER_BUFFER_AMD = $9002; - GL_UNSIGNED_INT_SAMPLER_BUFFER_AMD = $9003; - GL_TESSELLATION_MODE_AMD = $9004; - GL_TESSELLATION_FACTOR_AMD = $9005; - GL_DISCRETE_AMD = $9006; - GL_CONTINUOUS_AMD = $9007; - - // GL_AMD_seamless_cubemap_per_texture - { reuse GL_TEXTURE_CUBE_MAP_SEAMLESS } - - // GL_AMD_name_gen_delete - GL_DATA_BUFFER_AMD = $9151; - GL_PERFORMANCE_MONITOR_AMD = $9152; - GL_QUERY_OBJECT_AMD = $9153; - GL_VERTEX_ARRAY_OBJECT_AMD = $9154; - GL_SAMPLER_OBJECT_AMD = $9155; - - // GL_AMD_debug_output - GL_MAX_DEBUG_LOGGED_MESSAGES_AMD = $9144; - GL_DEBUG_LOGGED_MESSAGES_AMD = $9145; - GL_DEBUG_SEVERITY_HIGH_AMD = $9146; - GL_DEBUG_SEVERITY_MEDIUM_AMD = $9147; - GL_DEBUG_SEVERITY_LOW_AMD = $9148; - GL_DEBUG_CATEGORY_API_ERROR_AMD = $9149; - GL_DEBUG_CATEGORY_WINDOW_SYSTEM_AMD = $914A; - GL_DEBUG_CATEGORY_DEPRECATION_AMD = $914B; - GL_DEBUG_CATEGORY_UNDEFINED_BEHAVIOR_AMD = $914C; - GL_DEBUG_CATEGORY_PERFORMANCE_AMD = $914D; - GL_DEBUG_CATEGORY_SHADER_COMPILER_AMD = $914E; - GL_DEBUG_CATEGORY_APPLICATION_AMD = $914F; - GL_DEBUG_CATEGORY_OTHER_AMD = $9150; - - // GL_AMD_depth_clamp_separate - GL_DEPTH_CLAMP_NEAR_AMD = $901E; - GL_DEPTH_CLAMP_FAR_AMD = $901F; - - // GL_EXT_422_pixels - GL_422_EXT = $80CC; - GL_422_REV_EXT = $80CD; - GL_422_AVERAGE_EXT = $80CE; - GL_422_REV_AVERAGE_EXT = $80CF; - - // GL_EXT_abgr - GL_ABGR_EXT = $8000; - - // GL_EXT_bgra - GL_BGR_EXT = $80E0; - GL_BGRA_EXT = $80E1; - - // GL_EXT_blend_color - GL_CONSTANT_COLOR_EXT = $8001; - GL_ONE_MINUS_CONSTANT_COLOR_EXT = $8002; - GL_CONSTANT_ALPHA_EXT = $8003; - GL_ONE_MINUS_CONSTANT_ALPHA_EXT = $8004; - GL_BLEND_COLOR_EXT = $8005; - - // GL_EXT_blend_func_separate - GL_BLEND_DST_RGB_EXT = $80C8; - GL_BLEND_SRC_RGB_EXT = $80C9; - GL_BLEND_DST_ALPHA_EXT = $80CA; - GL_BLEND_SRC_ALPHA_EXT = $80CB; - - // GL_EXT_blend_minmax - GL_FUNC_ADD_EXT = $8006; - GL_MIN_EXT = $8007; - GL_MAX_EXT = $8008; - GL_BLEND_EQUATION_EXT = $8009; - - // GL_EXT_blend_subtract - GL_FUNC_SUBTRACT_EXT = $800A; - GL_FUNC_REVERSE_SUBTRACT_EXT = $800B; - - // GL_EXT_clip_volume_hint - GL_CLIP_VOLUME_CLIPPING_HINT_EXT = $80F0; - - // GL_EXT_cmyka - GL_CMYK_EXT = $800C; - GL_CMYKA_EXT = $800D; - GL_PACK_CMYK_HINT_EXT = $800E; - GL_UNPACK_CMYK_HINT_EXT = $800F; - - // GL_EXT_compiled_vertex_array - GL_ARRAY_ELEMENT_LOCK_FIRST_EXT = $81A8; - GL_ARRAY_ELEMENT_LOCK_COUNT_EXT = $81A9; - - // GL_EXT_convolution - GL_CONVOLUTION_1D_EXT = $8010; - GL_CONVOLUTION_2D_EXT = $8011; - GL_SEPARABLE_2D_EXT = $8012; - GL_CONVOLUTION_BORDER_MODE_EXT = $8013; - GL_CONVOLUTION_FILTER_SCALE_EXT = $8014; - GL_CONVOLUTION_FILTER_BIAS_EXT = $8015; - GL_REDUCE_EXT = $8016; - GL_CONVOLUTION_FORMAT_EXT = $8017; - GL_CONVOLUTION_WIDTH_EXT = $8018; - GL_CONVOLUTION_HEIGHT_EXT = $8019; - GL_MAX_CONVOLUTION_WIDTH_EXT = $801A; - GL_MAX_CONVOLUTION_HEIGHT_EXT = $801B; - GL_POST_CONVOLUTION_RED_SCALE_EXT = $801C; - GL_POST_CONVOLUTION_GREEN_SCALE_EXT = $801D; - GL_POST_CONVOLUTION_BLUE_SCALE_EXT = $801E; - GL_POST_CONVOLUTION_ALPHA_SCALE_EXT = $801F; - GL_POST_CONVOLUTION_RED_BIAS_EXT = $8020; - GL_POST_CONVOLUTION_GREEN_BIAS_EXT = $8021; - GL_POST_CONVOLUTION_BLUE_BIAS_EXT = $8022; - GL_POST_CONVOLUTION_ALPHA_BIAS_EXT = $8023; - - // GL_EXT_coordinate_frame - GL_TANGENT_ARRAY_EXT = $8439; - GL_BINORMAL_ARRAY_EXT = $843A; - GL_CURRENT_TANGENT_EXT = $843B; - GL_CURRENT_BINORMAL_EXT = $843C; - GL_TANGENT_ARRAY_TYPE_EXT = $843E; - GL_TANGENT_ARRAY_STRIDE_EXT = $843F; - GL_BINORMAL_ARRAY_TYPE_EXT = $8440; - GL_BINORMAL_ARRAY_STRIDE_EXT = $8441; - GL_TANGENT_ARRAY_POINTER_EXT = $8442; - GL_BINORMAL_ARRAY_POINTER_EXT = $8443; - GL_MAP1_TANGENT_EXT = $8444; - GL_MAP2_TANGENT_EXT = $8445; - GL_MAP1_BINORMAL_EXT = $8446; - GL_MAP2_BINORMAL_EXT = $8447; - - // GL_EXT_cull_vertex - GL_CULL_VERTEX_EXT = $81AA; - GL_CULL_VERTEX_EYE_POSITION_EXT = $81AB; - GL_CULL_VERTEX_OBJECT_POSITION_EXT = $81AC; - - // GL_EXT_draw_range_elements - GL_MAX_ELEMENTS_VERTICES_EXT = $80E8; - GL_MAX_ELEMENTS_INDICES_EXT = $80E9; - - // GL_EXT_fog_coord - GL_FOG_COORDINATE_SOURCE_EXT = $8450; - GL_FOG_COORDINATE_EXT = $8451; - GL_FRAGMENT_DEPTH_EXT = $8452; - GL_CURRENT_FOG_COORDINATE_EXT = $8453; - GL_FOG_COORDINATE_ARRAY_TYPE_EXT = $8454; - GL_FOG_COORDINATE_ARRAY_STRIDE_EXT = $8455; - GL_FOG_COORDINATE_ARRAY_POINTER_EXT = $8456; - GL_FOG_COORDINATE_ARRAY_EXT = $8457; - - // GL_EXT_framebuffer_object - GL_FRAMEBUFFER_EXT = $8D40; - GL_RENDERBUFFER_EXT = $8D41; - GL_STENCIL_INDEX_EXT = $8D45; - GL_STENCIL_INDEX1_EXT = $8D46; - GL_STENCIL_INDEX4_EXT = $8D47; - GL_STENCIL_INDEX8_EXT = $8D48; - GL_STENCIL_INDEX16_EXT = $8D49; - GL_RENDERBUFFER_WIDTH_EXT = $8D42; - GL_RENDERBUFFER_HEIGHT_EXT = $8D43; - GL_RENDERBUFFER_INTERNAL_FORMAT_EXT = $8D44; - GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT = $8CD0; - GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT = $8CD1; - GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT = $8CD2; - GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT = $8CD3; - GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT = $8CD4; - GL_COLOR_ATTACHMENT0_EXT = $8CE0; - GL_COLOR_ATTACHMENT1_EXT = $8CE1; - GL_COLOR_ATTACHMENT2_EXT = $8CE2; - GL_COLOR_ATTACHMENT3_EXT = $8CE3; - GL_COLOR_ATTACHMENT4_EXT = $8CE4; - GL_COLOR_ATTACHMENT5_EXT = $8CE5; - GL_COLOR_ATTACHMENT6_EXT = $8CE6; - GL_COLOR_ATTACHMENT7_EXT = $8CE7; - GL_COLOR_ATTACHMENT8_EXT = $8CE8; - GL_COLOR_ATTACHMENT9_EXT = $8CE9; - GL_COLOR_ATTACHMENT10_EXT = $8CEA; - GL_COLOR_ATTACHMENT11_EXT = $8CEB; - GL_COLOR_ATTACHMENT12_EXT = $8CEC; - GL_COLOR_ATTACHMENT13_EXT = $8CED; - GL_COLOR_ATTACHMENT14_EXT = $8CEE; - GL_COLOR_ATTACHMENT15_EXT = $8CEF; - GL_DEPTH_ATTACHMENT_EXT = $8D00; - GL_STENCIL_ATTACHMENT_EXT = $8D20; - GL_FRAMEBUFFER_COMPLETE_EXT = $8CD5; - GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT = $8CD6; - GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT = $8CD7; - GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT = $8CD8; - GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT = $8CD9; - GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT = $8CDA; - GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT = $8CDB; - GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT = $8CDC; - GL_FRAMEBUFFER_UNSUPPORTED_EXT = $8CDD; - GL_FRAMEBUFFER_STATUS_ERROR_EXT = $8CDE; - GL_FRAMEBUFFER_BINDING_EXT = $8CA6; - GL_RENDERBUFFER_BINDING_EXT = $8CA7; - GL_MAX_COLOR_ATTACHMENTS_EXT = $8CDF; - GL_MAX_RENDERBUFFER_SIZE_EXT = $84E8; - GL_INVALID_FRAMEBUFFER_OPERATION_EXT = $0506; - - // GL_EXT_histogram - GL_HISTOGRAM_EXT = $8024; - GL_PROXY_HISTOGRAM_EXT = $8025; - GL_HISTOGRAM_WIDTH_EXT = $8026; - GL_HISTOGRAM_FORMAT_EXT = $8027; - GL_HISTOGRAM_RED_SIZE_EXT = $8028; - GL_HISTOGRAM_GREEN_SIZE_EXT = $8029; - GL_HISTOGRAM_BLUE_SIZE_EXT = $802A; - GL_HISTOGRAM_ALPHA_SIZE_EXT = $802B; - GL_HISTOGRAM_LUMINANCE_SIZE_EXT = $802C; - GL_HISTOGRAM_SINK_EXT = $802D; - GL_MINMAX_EXT = $802E; - GL_MINMAX_FORMAT_EXT = $802F; - GL_MINMAX_SINK_EXT = $8030; - GL_TABLE_TOO_LARGE_EXT = $8031; - - // GL_EXT_index_array_formats - GL_IUI_V2F_EXT = $81AD; - GL_IUI_V3F_EXT = $81AE; - GL_IUI_N3F_V2F_EXT = $81AF; - GL_IUI_N3F_V3F_EXT = $81B0; - GL_T2F_IUI_V2F_EXT = $81B1; - GL_T2F_IUI_V3F_EXT = $81B2; - GL_T2F_IUI_N3F_V2F_EXT = $81B3; - GL_T2F_IUI_N3F_V3F_EXT = $81B4; - - // GL_EXT_index_func - GL_INDEX_TEST_EXT = $81B5; - GL_INDEX_TEST_FUNC_EXT = $81B6; - GL_INDEX_TEST_REF_EXT = $81B7; - - // GL_EXT_index_material - GL_INDEX_MATERIAL_EXT = $81B8; - GL_INDEX_MATERIAL_PARAMETER_EXT = $81B9; - GL_INDEX_MATERIAL_FACE_EXT = $81BA; - - // GL_EXT_light_texture - GL_FRAGMENT_MATERIAL_EXT = $8349; - GL_FRAGMENT_NORMAL_EXT = $834A; - GL_FRAGMENT_COLOR_EXT = $834C; - GL_ATTENUATION_EXT = $834D; - GL_SHADOW_ATTENUATION_EXT = $834E; - GL_TEXTURE_APPLICATION_MODE_EXT = $834F; - GL_TEXTURE_LIGHT_EXT = $8350; - GL_TEXTURE_MATERIAL_FACE_EXT = $8351; - GL_TEXTURE_MATERIAL_PARAMETER_EXT = $8352; - - // GL_EXT_multisample - GL_MULTISAMPLE_EXT = $809D; - GL_SAMPLE_ALPHA_TO_MASK_EXT = $809E; - GL_SAMPLE_ALPHA_TO_ONE_EXT = $809F; - GL_SAMPLE_MASK_EXT = $80A0; - GL_1PASS_EXT = $80A1; - GL_2PASS_0_EXT = $80A2; - GL_2PASS_1_EXT = $80A3; - GL_4PASS_0_EXT = $80A4; - GL_4PASS_1_EXT = $80A5; - GL_4PASS_2_EXT = $80A6; - GL_4PASS_3_EXT = $80A7; - GL_SAMPLE_BUFFERS_EXT = $80A8; - GL_SAMPLES_EXT = $80A9; - GL_SAMPLE_MASK_VALUE_EXT = $80AA; - GL_SAMPLE_MASK_INVERT_EXT = $80AB; - GL_SAMPLE_PATTERN_EXT = $80AC; - GL_MULTISAMPLE_BIT_EXT = $20000000; - - // GL_EXT_packed_pixels - GL_UNSIGNED_BYTE_3_3_2_EXT = $8032; - GL_UNSIGNED_SHORT_4_4_4_4_EXT = $8033; - GL_UNSIGNED_SHORT_5_5_5_1_EXT = $8034; - GL_UNSIGNED_INT_8_8_8_8_EXT = $8035; - GL_UNSIGNED_INT_10_10_10_2_EXT = $8036; - - // GL_EXT_paletted_texture - GL_COLOR_INDEX1_EXT = $80E2; - GL_COLOR_INDEX2_EXT = $80E3; - GL_COLOR_INDEX4_EXT = $80E4; - GL_COLOR_INDEX8_EXT = $80E5; - GL_COLOR_INDEX12_EXT = $80E6; - GL_COLOR_INDEX16_EXT = $80E7; - GL_TEXTURE_INDEX_SIZE_EXT = $80ED; - - // GL_EXT_pixel_transform - GL_PIXEL_TRANSFORM_2D_EXT = $8330; - GL_PIXEL_MAG_FILTER_EXT = $8331; - GL_PIXEL_MIN_FILTER_EXT = $8332; - GL_PIXEL_CUBIC_WEIGHT_EXT = $8333; - GL_CUBIC_EXT = $8334; - GL_AVERAGE_EXT = $8335; - GL_PIXEL_TRANSFORM_2D_STACK_DEPTH_EXT = $8336; - GL_MAX_PIXEL_TRANSFORM_2D_STACK_DEPTH_EXT = $8337; - GL_PIXEL_TRANSFORM_2D_MATRIX_EXT = $8338; - - // GL_EXT_point_parameters - GL_POINT_SIZE_MIN_EXT = $8126; - GL_POINT_SIZE_MAX_EXT = $8127; - GL_POINT_FADE_THRESHOLD_SIZE_EXT = $8128; - GL_DISTANCE_ATTENUATION_EXT = $8129; - - // GL_EXT_polygon_offset - GL_POLYGON_OFFSET_EXT = $8037; - GL_POLYGON_OFFSET_FACTOR_EXT = $8038; - GL_POLYGON_OFFSET_BIAS_EXT = $8039; - - // GL_EXT_rescale_normal - GL_RESCALE_NORMAL_EXT = $803A; - - // GL_EXT_secondary_color - GL_COLOR_SUM_EXT = $8458; - GL_CURRENT_SECONDARY_COLOR_EXT = $8459; - GL_SECONDARY_COLOR_ARRAY_SIZE_EXT = $845A; - GL_SECONDARY_COLOR_ARRAY_TYPE_EXT = $845B; - GL_SECONDARY_COLOR_ARRAY_STRIDE_EXT = $845C; - GL_SECONDARY_COLOR_ARRAY_POINTER_EXT = $845D; - GL_SECONDARY_COLOR_ARRAY_EXT = $845E; - - // GL_EXT_separate_specular_color - GL_LIGHT_MODEL_COLOR_CONTROL_EXT = $81F8; - GL_SINGLE_COLOR_EXT = $81F9; - GL_SEPARATE_SPECULAR_COLOR_EXT = $81FA; - - // GL_EXT_shared_texture_palette - GL_SHARED_TEXTURE_PALETTE_EXT = $81FB; - - // GL_EXT_stencil_two_side - GL_STENCIL_TEST_TWO_SIDE_EXT = $8910; - GL_ACTIVE_STENCIL_FACE_EXT = $8911; - - // GL_EXT_stencil_wrap - GL_INCR_WRAP_EXT = $8507; - GL_DECR_WRAP_EXT = $8508; - - // GL_EXT_texture - GL_ALPHA4_EXT = $803B; - GL_ALPHA8_EXT = $803C; - GL_ALPHA12_EXT = $803D; - GL_ALPHA16_EXT = $803E; - GL_LUMINANCE4_EXT = $803F; - GL_LUMINANCE8_EXT = $8040; - GL_LUMINANCE12_EXT = $8041; - GL_LUMINANCE16_EXT = $8042; - GL_LUMINANCE4_ALPHA4_EXT = $8043; - GL_LUMINANCE6_ALPHA2_EXT = $8044; - GL_LUMINANCE8_ALPHA8_EXT = $8045; - GL_LUMINANCE12_ALPHA4_EXT = $8046; - GL_LUMINANCE12_ALPHA12_EXT = $8047; - GL_LUMINANCE16_ALPHA16_EXT = $8048; - GL_INTENSITY_EXT = $8049; - GL_INTENSITY4_EXT = $804A; - GL_INTENSITY8_EXT = $804B; - GL_INTENSITY12_EXT = $804C; - GL_INTENSITY16_EXT = $804D; - GL_RGB2_EXT = $804E; - GL_RGB4_EXT = $804F; - GL_RGB5_EXT = $8050; - GL_RGB8_EXT = $8051; - GL_RGB10_EXT = $8052; - GL_RGB12_EXT = $8053; - GL_RGB16_EXT = $8054; - GL_RGBA2_EXT = $8055; - GL_RGBA4_EXT = $8056; - GL_RGB5_A1_EXT = $8057; - GL_RGBA8_EXT = $8058; - GL_RGB10_A2_EXT = $8059; - GL_RGBA12_EXT = $805A; - GL_RGBA16_EXT = $805B; - GL_TEXTURE_RED_SIZE_EXT = $805C; - GL_TEXTURE_GREEN_SIZE_EXT = $805D; - GL_TEXTURE_BLUE_SIZE_EXT = $805E; - GL_TEXTURE_ALPHA_SIZE_EXT = $805F; - GL_TEXTURE_LUMINANCE_SIZE_EXT = $8060; - GL_TEXTURE_INTENSITY_SIZE_EXT = $8061; - GL_REPLACE_EXT = $8062; - GL_PROXY_TEXTURE_1D_EXT = $8063; - GL_PROXY_TEXTURE_2D_EXT = $8064; - GL_TEXTURE_TOO_LARGE_EXT = $8065; - - // GL_EXT_texture3D - GL_PACK_SKIP_IMAGES_EXT = $806B; - GL_PACK_IMAGE_HEIGHT_EXT = $806C; - GL_UNPACK_SKIP_IMAGES_EXT = $806D; - GL_UNPACK_IMAGE_HEIGHT_EXT = $806E; - GL_TEXTURE_3D_EXT = $806F; - GL_PROXY_TEXTURE_3D_EXT = $8070; - GL_TEXTURE_DEPTH_EXT = $8071; - GL_TEXTURE_WRAP_R_EXT = $8072; - GL_MAX_3D_TEXTURE_SIZE_EXT = $8073; - - // GL_EXT_texture_compression_s3tc - GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0; - GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1; - GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2; - GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3; - - // GL_EXT_texture_cube_map - GL_NORMAL_MAP_EXT = $8511; - GL_REFLECTION_MAP_EXT = $8512; - GL_TEXTURE_CUBE_MAP_EXT = $8513; - GL_TEXTURE_BINDING_CUBE_MAP_EXT = $8514; - GL_TEXTURE_CUBE_MAP_POSITIVE_X_EXT = $8515; - GL_TEXTURE_CUBE_MAP_NEGATIVE_X_EXT = $8516; - GL_TEXTURE_CUBE_MAP_POSITIVE_Y_EXT = $8517; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Y_EXT = $8518; - GL_TEXTURE_CUBE_MAP_POSITIVE_Z_EXT = $8519; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Z_EXT = $851A; - GL_PROXY_TEXTURE_CUBE_MAP_EXT = $851B; - GL_MAX_CUBE_MAP_TEXTURE_SIZE_EXT = $851C; - - // GL_EXT_texture_edge_clamp - GL_CLAMP_TO_EDGE_EXT = $812F; - - // GL_EXT_texture_env_combine - GL_COMBINE_EXT = $8570; - GL_COMBINE_RGB_EXT = $8571; - GL_COMBINE_ALPHA_EXT = $8572; - GL_RGB_SCALE_EXT = $8573; - GL_ADD_SIGNED_EXT = $8574; - GL_INTERPOLATE_EXT = $8575; - GL_CONSTANT_EXT = $8576; - GL_PRIMARY_COLOR_EXT = $8577; - GL_PREVIOUS_EXT = $8578; - GL_SOURCE0_RGB_EXT = $8580; - GL_SOURCE1_RGB_EXT = $8581; - GL_SOURCE2_RGB_EXT = $8582; - GL_SOURCE0_ALPHA_EXT = $8588; - GL_SOURCE1_ALPHA_EXT = $8589; - GL_SOURCE2_ALPHA_EXT = $858A; - GL_OPERAND0_RGB_EXT = $8590; - GL_OPERAND1_RGB_EXT = $8591; - GL_OPERAND2_RGB_EXT = $8592; - GL_OPERAND0_ALPHA_EXT = $8598; - GL_OPERAND1_ALPHA_EXT = $8599; - GL_OPERAND2_ALPHA_EXT = $859A; - - // GL_EXT_texture_env_dot3 - GL_DOT3_RGB_EXT = $8740; - GL_DOT3_RGBA_EXT = $8741; - - // GL_EXT_texture_filter_anisotropic - GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; - GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; - - // GL_EXT_texture_lod_bias - GL_MAX_TEXTURE_LOD_BIAS_EXT = $84FD; - GL_TEXTURE_FILTER_CONTROL_EXT = $8500; - GL_TEXTURE_LOD_BIAS_EXT = $8501; - - // GL_EXT_texture_object - GL_TEXTURE_PRIORITY_EXT = $8066; - GL_TEXTURE_RESIDENT_EXT = $8067; - GL_TEXTURE_1D_BINDING_EXT = $8068; - GL_TEXTURE_2D_BINDING_EXT = $8069; - GL_TEXTURE_3D_BINDING_EXT = $806A; - - // GL_EXT_texture_perturb_normal - GL_PERTURB_EXT = $85AE; - GL_TEXTURE_NORMAL_EXT = $85AF; - - // GL_EXT_texture_rectangle - GL_TEXTURE_RECTANGLE_EXT = $84F5; - GL_TEXTURE_BINDING_RECTANGLE_EXT = $84F6; - GL_PROXY_TEXTURE_RECTANGLE_EXT = $84F7; - GL_MAX_RECTANGLE_TEXTURE_SIZE_EXT = $84F8; - - // GL_EXT_vertex_array - GL_VERTEX_ARRAY_EXT = $8074; - GL_NORMAL_ARRAY_EXT = $8075; - GL_COLOR_ARRAY_EXT = $8076; - GL_INDEX_ARRAY_EXT = $8077; - GL_TEXTURE_COORD_ARRAY_EXT = $8078; - GL_EDGE_FLAG_ARRAY_EXT = $8079; - GL_VERTEX_ARRAY_SIZE_EXT = $807A; - GL_VERTEX_ARRAY_TYPE_EXT = $807B; - GL_VERTEX_ARRAY_STRIDE_EXT = $807C; - GL_VERTEX_ARRAY_COUNT_EXT = $807D; - GL_NORMAL_ARRAY_TYPE_EXT = $807E; - GL_NORMAL_ARRAY_STRIDE_EXT = $807F; - GL_NORMAL_ARRAY_COUNT_EXT = $8080; - GL_COLOR_ARRAY_SIZE_EXT = $8081; - GL_COLOR_ARRAY_TYPE_EXT = $8082; - GL_COLOR_ARRAY_STRIDE_EXT = $8083; - GL_COLOR_ARRAY_COUNT_EXT = $8084; - GL_INDEX_ARRAY_TYPE_EXT = $8085; - GL_INDEX_ARRAY_STRIDE_EXT = $8086; - GL_INDEX_ARRAY_COUNT_EXT = $8087; - GL_TEXTURE_COORD_ARRAY_SIZE_EXT = $8088; - GL_TEXTURE_COORD_ARRAY_TYPE_EXT = $8089; - GL_TEXTURE_COORD_ARRAY_STRIDE_EXT = $808A; - GL_TEXTURE_COORD_ARRAY_COUNT_EXT = $808B; - GL_EDGE_FLAG_ARRAY_STRIDE_EXT = $808C; - GL_EDGE_FLAG_ARRAY_COUNT_EXT = $808D; - GL_VERTEX_ARRAY_POINTER_EXT = $808E; - GL_NORMAL_ARRAY_POINTER_EXT = $808F; - GL_COLOR_ARRAY_POINTER_EXT = $8090; - GL_INDEX_ARRAY_POINTER_EXT = $8091; - GL_TEXTURE_COORD_ARRAY_POINTER_EXT = $8092; - GL_EDGE_FLAG_ARRAY_POINTER_EXT = $8093; - - // GL_EXT_vertex_shader - GL_VERTEX_SHADER_EXT = $8780; - GL_VERTEX_SHADER_BINDING_EXT = $8781; - GL_OP_INDEX_EXT = $8782; - GL_OP_NEGATE_EXT = $8783; - GL_OP_DOT3_EXT = $8784; - GL_OP_DOT4_EXT = $8785; - GL_OP_MUL_EXT = $8786; - GL_OP_ADD_EXT = $8787; - GL_OP_MADD_EXT = $8788; - GL_OP_FRAC_EXT = $8789; - GL_OP_MAX_EXT = $878A; - GL_OP_MIN_EXT = $878B; - GL_OP_SET_GE_EXT = $878C; - GL_OP_SET_LT_EXT = $878D; - GL_OP_CLAMP_EXT = $878E; - GL_OP_FLOOR_EXT = $878F; - GL_OP_ROUND_EXT = $8790; - GL_OP_EXP_BASE_2_EXT = $8791; - GL_OP_LOG_BASE_2_EXT = $8792; - GL_OP_POWER_EXT = $8793; - GL_OP_RECIP_EXT = $8794; - GL_OP_RECIP_SQRT_EXT = $8795; - GL_OP_SUB_EXT = $8796; - GL_OP_CROSS_PRODUCT_EXT = $8797; - GL_OP_MULTIPLY_MATRIX_EXT = $8798; - GL_OP_MOV_EXT = $8799; - GL_OUTPUT_VERTEX_EXT = $879A; - GL_OUTPUT_COLOR0_EXT = $879B; - GL_OUTPUT_COLOR1_EXT = $879C; - GL_OUTPUT_TEXTURE_COORD0_EXT = $879D; - GL_OUTPUT_TEXTURE_COORD1_EXT = $879E; - GL_OUTPUT_TEXTURE_COORD2_EXT = $879F; - GL_OUTPUT_TEXTURE_COORD3_EXT = $87A0; - GL_OUTPUT_TEXTURE_COORD4_EXT = $87A1; - GL_OUTPUT_TEXTURE_COORD5_EXT = $87A2; - GL_OUTPUT_TEXTURE_COORD6_EXT = $87A3; - GL_OUTPUT_TEXTURE_COORD7_EXT = $87A4; - GL_OUTPUT_TEXTURE_COORD8_EXT = $87A5; - GL_OUTPUT_TEXTURE_COORD9_EXT = $87A6; - GL_OUTPUT_TEXTURE_COORD10_EXT = $87A7; - GL_OUTPUT_TEXTURE_COORD11_EXT = $87A8; - GL_OUTPUT_TEXTURE_COORD12_EXT = $87A9; - GL_OUTPUT_TEXTURE_COORD13_EXT = $87AA; - GL_OUTPUT_TEXTURE_COORD14_EXT = $87AB; - GL_OUTPUT_TEXTURE_COORD15_EXT = $87AC; - GL_OUTPUT_TEXTURE_COORD16_EXT = $87AD; - GL_OUTPUT_TEXTURE_COORD17_EXT = $87AE; - GL_OUTPUT_TEXTURE_COORD18_EXT = $87AF; - GL_OUTPUT_TEXTURE_COORD19_EXT = $87B0; - GL_OUTPUT_TEXTURE_COORD20_EXT = $87B1; - GL_OUTPUT_TEXTURE_COORD21_EXT = $87B2; - GL_OUTPUT_TEXTURE_COORD22_EXT = $87B3; - GL_OUTPUT_TEXTURE_COORD23_EXT = $87B4; - GL_OUTPUT_TEXTURE_COORD24_EXT = $87B5; - GL_OUTPUT_TEXTURE_COORD25_EXT = $87B6; - GL_OUTPUT_TEXTURE_COORD26_EXT = $87B7; - GL_OUTPUT_TEXTURE_COORD27_EXT = $87B8; - GL_OUTPUT_TEXTURE_COORD28_EXT = $87B9; - GL_OUTPUT_TEXTURE_COORD29_EXT = $87BA; - GL_OUTPUT_TEXTURE_COORD30_EXT = $87BB; - GL_OUTPUT_TEXTURE_COORD31_EXT = $87BC; - GL_OUTPUT_FOG_EXT = $87BD; - GL_SCALAR_EXT = $87BE; - GL_VECTOR_EXT = $87BF; - GL_MATRIX_EXT = $87C0; - GL_VARIANT_EXT = $87C1; - GL_INVARIANT_EXT = $87C2; - GL_LOCAL_CONSTANT_EXT = $87C3; - GL_LOCAL_EXT = $87C4; - GL_MAX_VERTEX_SHADER_INSTRUCTIONS_EXT = $87C5; - GL_MAX_VERTEX_SHADER_VARIANTS_EXT = $87C6; - GL_MAX_VERTEX_SHADER_INVARIANTS_EXT = $87C7; - GL_MAX_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87C8; - GL_MAX_VERTEX_SHADER_LOCALS_EXT = $87C9; - GL_MAX_OPTIMIZED_VERTEX_SHADER_INSTRUCTIONS_EXT = $87CA; - GL_MAX_OPTIMIZED_VERTEX_SHADER_VARIANTS_EXT = $87CB; - GL_MAX_OPTIMIZED_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87CC; - GL_MAX_OPTIMIZED_VERTEX_SHADER_INVARIANTS_EXT = $87CD; - GL_MAX_OPTIMIZED_VERTEX_SHADER_LOCALS_EXT = $87CE; - GL_VERTEX_SHADER_INSTRUCTIONS_EXT = $87CF; - GL_VERTEX_SHADER_VARIANTS_EXT = $87D0; - GL_VERTEX_SHADER_INVARIANTS_EXT = $87D1; - GL_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87D2; - GL_VERTEX_SHADER_LOCALS_EXT = $87D3; - GL_VERTEX_SHADER_OPTIMIZED_EXT = $87D4; - GL_X_EXT = $87D5; - GL_Y_EXT = $87D6; - GL_Z_EXT = $87D7; - GL_W_EXT = $87D8; - GL_NEGATIVE_X_EXT = $87D9; - GL_NEGATIVE_Y_EXT = $87DA; - GL_NEGATIVE_Z_EXT = $87DB; - GL_NEGATIVE_W_EXT = $87DC; - GL_ZERO_EXT = $87DD; - GL_ONE_EXT = $87DE; - GL_NEGATIVE_ONE_EXT = $87DF; - GL_NORMALIZED_RANGE_EXT = $87E0; - GL_FULL_RANGE_EXT = $87E1; - GL_CURRENT_VERTEX_EXT = $87E2; - GL_MVP_MATRIX_EXT = $87E3; - GL_VARIANT_VALUE_EXT = $87E4; - GL_VARIANT_DATATYPE_EXT = $87E5; - GL_VARIANT_ARRAY_STRIDE_EXT = $87E6; - GL_VARIANT_ARRAY_TYPE_EXT = $87E7; - GL_VARIANT_ARRAY_EXT = $87E8; - GL_VARIANT_ARRAY_POINTER_EXT = $87E9; - GL_INVARIANT_VALUE_EXT = $87EA; - GL_INVARIANT_DATATYPE_EXT = $87EB; - GL_LOCAL_CONSTANT_VALUE_EXT = $87EC; - GL_LOCAL_CONSTANT_DATATYPE_EXT = $87ED; - - // GL_EXT_vertex_weighting - GL_MODELVIEW0_STACK_DEPTH_EXT = $0BA3; - GL_MODELVIEW1_STACK_DEPTH_EXT = $8502; - GL_MODELVIEW0_MATRIX_EXT = $0BA6; - GL_MODELVIEW1_MATRIX_EXT = $8506; - GL_VERTEX_WEIGHTING_EXT = $8509; - GL_MODELVIEW0_EXT = $1700; - GL_MODELVIEW1_EXT = $850A; - GL_CURRENT_VERTEX_WEIGHT_EXT = $850B; - GL_VERTEX_WEIGHT_ARRAY_EXT = $850C; - GL_VERTEX_WEIGHT_ARRAY_SIZE_EXT = $850D; - GL_VERTEX_WEIGHT_ARRAY_TYPE_EXT = $850E; - GL_VERTEX_WEIGHT_ARRAY_STRIDE_EXT = $850F; - GL_VERTEX_WEIGHT_ARRAY_POINTER_EXT = $8510; - - // GL_EXT_depth_bounds_test - GL_DEPTH_BOUNDS_TEST_EXT = $8890; - GL_DEPTH_BOUNDS_EXT = $8891; - - // GL_EXT_texture_mirror_clamp - GL_MIRROR_CLAMP_EXT = $8742; - GL_MIRROR_CLAMP_TO_EDGE_EXT = $8743; - GL_MIRROR_CLAMP_TO_BORDER_EXT = $8912; - - // GL_EXT_blend_equation_separate - GL_BLEND_EQUATION_RGB_EXT = $8009; - GL_BLEND_EQUATION_ALPHA_EXT = $883D; - - // GL_EXT_pixel_buffer_object - GL_PIXEL_PACK_BUFFER_EXT = $88EB; - GL_PIXEL_UNPACK_BUFFER_EXT = $88EC; - GL_PIXEL_PACK_BUFFER_BINDING_EXT = $88ED; - GL_PIXEL_UNPACK_BUFFER_BINDING_EXT = $88EF; - - // GL_EXT_stencil_clear_tag - GL_STENCIL_TAG_BITS_EXT = $88F2; - GL_STENCIL_CLEAR_TAG_VALUE_EXT = $88F3; - - // GL_EXT_packed_depth_stencil - GL_DEPTH_STENCIL_EXT = $84F9; - GL_UNSIGNED_INT_24_8_EXT = $84FA; - GL_DEPTH24_STENCIL8_EXT = $88F0; - GL_TEXTURE_STENCIL_SIZE_EXT = $88F1; - - // GL_EXT_texture_sRGB - GL_SRGB_EXT = $8C40; - GL_SRGB8_EXT = $8C41; - GL_SRGB_ALPHA_EXT = $8C42; - GL_SRGB8_ALPHA8_EXT = $8C43; - GL_SLUMINANCE_ALPHA_EXT = $8C44; - GL_SLUMINANCE8_ALPHA8_EXT = $8C45; - GL_SLUMINANCE_EXT = $8C46; - GL_SLUMINANCE8_EXT = $8C47; - GL_COMPRESSED_SRGB_EXT = $8C48; - GL_COMPRESSED_SRGB_ALPHA_EXT = $8C49; - GL_COMPRESSED_SLUMINANCE_EXT = $8C4A; - GL_COMPRESSED_SLUMINANCE_ALPHA_EXT = $8C4B; - GL_COMPRESSED_SRGB_S3TC_DXT1_EXT = $8C4C; - GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT = $8C4D; - GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT = $8C4E; - GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT = $8C4F; - - // GL_EXT_framebuffer_blit - GL_READ_FRAMEBUFFER_EXT = $8CA8; - GL_DRAW_FRAMEBUFFER_EXT = $8CA9; - GL_READ_FRAMEBUFFER_BINDING_EXT = GL_FRAMEBUFFER_BINDING_EXT; - GL_DRAW_FRAMEBUFFER_BINDING_EXT = $8CAA; - - // GL_EXT_framebuffer_multisample - GL_RENDERBUFFER_SAMPLES_EXT = $8CAB; - GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT = $8D56; - GL_MAX_SAMPLES_EXT = $8D57; - - // GL_EXT_timer_query - GL_TIME_ELAPSED_EXT = $88BF; - - // GL_EXT_bindable_uniform - GL_MAX_VERTEX_BINDABLE_UNIFORMS_EXT = $8DE2; - GL_MAX_FRAGMENT_BINDABLE_UNIFORMS_EXT = $8DE3; - GL_MAX_GEOMETRY_BINDABLE_UNIFORMS_EXT = $8DE4; - GL_MAX_BINDABLE_UNIFORM_SIZE_EXT = $8DED; - GL_UNIFORM_BUFFER_EXT = $8DEE; - GL_UNIFORM_BUFFER_BINDING_EXT = $8DEF; - - // GL_EXT_framebuffer_sRGB - GLX_FRAMEBUFFER_SRGB_CAPABLE_EXT = $20B2; - WGL_FRAMEBUFFER_SRGB_CAPABLE_EXT = $20A9; - GL_FRAMEBUFFER_SRGB_EXT = $8DB9; - GL_FRAMEBUFFER_SRGB_CAPABLE_EXT = $8DBA; - - // GL_EXT_geometry_shader4 - GL_GEOMETRY_SHADER_EXT = $8DD9; - GL_GEOMETRY_VERTICES_OUT_EXT = $8DDA; - GL_GEOMETRY_INPUT_TYPE_EXT = $8DDB; - GL_GEOMETRY_OUTPUT_TYPE_EXT = $8DDC; - GL_MAX_GEOMETRY_TEXTURE_IMAGE_UNITS_EXT = $8C29; - GL_MAX_GEOMETRY_VARYING_COMPONENTS_EXT = $8DDD; - GL_MAX_VERTEX_VARYING_COMPONENTS_EXT = $8DDE; - GL_MAX_VARYING_COMPONENTS_EXT = $8B4B; - GL_MAX_GEOMETRY_UNIFORM_COMPONENTS_EXT = $8DDF; - GL_MAX_GEOMETRY_OUTPUT_VERTICES_EXT = $8DE0; - GL_MAX_GEOMETRY_TOTAL_OUTPUT_COMPONENTS_EXT = $8DE1; - GL_LINES_ADJACENCY_EXT = $A; - GL_LINE_STRIP_ADJACENCY_EXT = $B; - GL_TRIANGLES_ADJACENCY_EXT = $C; - GL_TRIANGLE_STRIP_ADJACENCY_EXT = $D; - GL_FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS_EXT = $8DA8; - GL_FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_EXT = $8DA9; - GL_FRAMEBUFFER_ATTACHMENT_LAYERED_EXT = $8DA7; - GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER_EXT = $8CD4; - GL_PROGRAM_POINT_SIZE_EXT = $8642; - - // GL_EXT_gpu_shader4 - GL_VERTEX_ATTRIB_ARRAY_INTEGER_EXT = $88FD; - GL_SAMPLER_1D_ARRAY_EXT = $8DC0; - GL_SAMPLER_2D_ARRAY_EXT = $8DC1; - GL_SAMPLER_BUFFER_EXT = $8DC2; - GL_SAMPLER_1D_ARRAY_SHADOW_EXT = $8DC3; - GL_SAMPLER_2D_ARRAY_SHADOW_EXT = $8DC4; - GL_SAMPLER_CUBE_SHADOW_EXT = $8DC5; - GL_UNSIGNED_INT_VEC2_EXT = $8DC6; - GL_UNSIGNED_INT_VEC3_EXT = $8DC7; - GL_UNSIGNED_INT_VEC4_EXT = $8DC8; - GL_INT_SAMPLER_1D_EXT = $8DC9; - GL_INT_SAMPLER_2D_EXT = $8DCA; - GL_INT_SAMPLER_3D_EXT = $8DCB; - GL_INT_SAMPLER_CUBE_EXT = $8DCC; - GL_INT_SAMPLER_2D_RECT_EXT = $8DCD; - GL_INT_SAMPLER_1D_ARRAY_EXT = $8DCE; - GL_INT_SAMPLER_2D_ARRAY_EXT = $8DCF; - GL_INT_SAMPLER_BUFFER_EXT = $8DD0; - GL_UNSIGNED_INT_SAMPLER_1D_EXT = $8DD1; - GL_UNSIGNED_INT_SAMPLER_2D_EXT = $8DD2; - GL_UNSIGNED_INT_SAMPLER_3D_EXT = $8DD3; - GL_UNSIGNED_INT_SAMPLER_CUBE_EXT = $8DD4; - GL_UNSIGNED_INT_SAMPLER_2D_RECT_EXT = $8DD5; - GL_UNSIGNED_INT_SAMPLER_1D_ARRAY_EXT = $8DD6; - GL_UNSIGNED_INT_SAMPLER_2D_ARRAY_EXT = $8DD7; - GL_UNSIGNED_INT_SAMPLER_BUFFER_EXT = $8DD8; - GL_MIN_PROGRAM_TEXEL_OFFSET_EXT = $8904; - GL_MAX_PROGRAM_TEXEL_OFFSET_EXT = $8905; - - // GL_EXT_packed_float - GL_R11F_G11F_B10F_EXT = $8C3A; - GL_UNSIGNED_INT_10F_11F_11F_REV_EXT = $8C3B; - RGBA_SIGNED_COMPONENTS_EXT = $8C3C; - WGL_TYPE_RGBA_UNSIGNED_FLOAT_EXT = $20A8; - GLX_RGBA_UNSIGNED_FLOAT_TYPE_EXT = $20B1; - GLX_RGBA_UNSIGNED_FLOAT_BIT_EXT = $00000008; - - // GL_EXT_texture_array - GL_TEXTURE_1D_ARRAY_EXT = $8C18; - GL_TEXTURE_2D_ARRAY_EXT = $8C1A; - GL_PROXY_TEXTURE_2D_ARRAY_EXT = $8C1B; - GL_PROXY_TEXTURE_1D_ARRAY_EXT = $8C19; - GL_TEXTURE_BINDING_1D_ARRAY_EXT = $8C1C; - GL_TEXTURE_BINDING_2D_ARRAY_EXT = $8C1D; - GL_MAX_ARRAY_TEXTURE_LAYERS_EXT = $88FF; - GL_COMPARE_REF_DEPTH_TO_TEXTURE_EXT = $884E; - - // GL_EXT_texture_buffer_object - GL_TEXTURE_BUFFER_EXT = $8C2A; - GL_MAX_TEXTURE_BUFFER_SIZE_EXT = $8C2B; - GL_TEXTURE_BINDING_BUFFER_EXT = $8C2C; - GL_TEXTURE_BUFFER_DATA_STORE_BINDING_EXT = $8C2D; - GL_TEXTURE_BUFFER_FORMAT_EXT = $8C2E; - - // GL_EXT_texture_compression_latc - GL_COMPRESSED_LUMINANCE_LATC1_EXT = $8C70; - GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT = $8C71; - GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT = $8C72; - GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT = $8C73; - - // GL_EXT_texture_compression_rgtc - GL_COMPRESSED_RED_RGTC1_EXT = $8DBB; - GL_COMPRESSED_SIGNED_RED_RGTC1_EXT = $8DBC; - GL_COMPRESSED_RED_GREEN_RGTC2_EXT = $8DBD; - GL_COMPRESSED_SIGNED_RED_GREEN_RGTC2_EXT = $8DBE; - - // GL_EXT_texture_integer - GL_RGBA_INTEGER_MODE_EXT = $8D9E; - GL_RGBA32UI_EXT = $8D70; - GL_RGB32UI_EXT = $8D71; - GL_ALPHA32UI_EXT = $8D72; - GL_INTENSITY32UI_EXT = $8D73; - GL_LUMINANCE32UI_EXT = $8D74; - GL_LUMINANCE_ALPHA32UI_EXT = $8D75; - GL_RGBA16UI_EXT = $8D76; - GL_RGB16UI_EXT = $8D77; - GL_ALPHA16UI_EXT = $8D78; - GL_INTENSITY16UI_EXT = $8D79; - GL_LUMINANCE16UI_EXT = $8D7A; - GL_LUMINANCE_ALPHA16UI_EXT = $8D7B; - GL_RGBA8UI_EXT = $8D7C; - GL_RGB8UI_EXT = $8D7D; - GL_ALPHA8UI_EXT = $8D7E; - GL_INTENSITY8UI_EXT = $8D7F; - GL_LUMINANCE8UI_EXT = $8D80; - GL_LUMINANCE_ALPHA8UI_EXT = $8D81; - GL_RGBA32I_EXT = $8D82; - GL_RGB32I_EXT = $8D83; - GL_ALPHA32I_EXT = $8D84; - GL_INTENSITY32I_EXT = $8D85; - GL_LUMINANCE32I_EXT = $8D86; - GL_LUMINANCE_ALPHA32I_EXT = $8D87; - GL_RGBA16I_EXT = $8D88; - GL_RGB16I_EXT = $8D89; - GL_ALPHA16I_EXT = $8D8A; - GL_INTENSITY16I_EXT = $8D8B; - GL_LUMINANCE16I_EXT = $8D8C; - GL_LUMINANCE_ALPHA16I_EXT = $8D8D; - GL_RGBA8I_EXT = $8D8E; - GL_RGB8I_EXT = $8D8F; - GL_ALPHA8I_EXT = $8D90; - GL_INTENSITY8I_EXT = $8D91; - GL_LUMINANCE8I_EXT = $8D92; - GL_LUMINANCE_ALPHA8I_EXT = $8D93; - GL_RED_INTEGER_EXT = $8D94; - GL_GREEN_INTEGER_EXT = $8D95; - GL_BLUE_INTEGER_EXT = $8D96; - GL_ALPHA_INTEGER_EXT = $8D97; - GL_RGB_INTEGER_EXT = $8D98; - GL_RGBA_INTEGER_EXT = $8D99; - GL_BGR_INTEGER_EXT = $8D9A; - GL_BGRA_INTEGER_EXT = $8D9B; - GL_LUMINANCE_INTEGER_EXT = $8D9C; - GL_LUMINANCE_ALPHA_INTEGER_EXT = $8D9D; - - // GL_EXT_texture_shared_exponent - GL_RGB9_E5_EXT = $8C3D; - GL_UNSIGNED_INT_5_9_9_9_REV_EXT = $8C3E; - GL_TEXTURE_SHARED_SIZE_EXT = $8C3F; - - // GL_EXT_transform_feedback - GL_TRANSFORM_FEEDBACK_BUFFER_EXT = $8C8E; - GL_TRANSFORM_FEEDBACK_BUFFER_START_EXT = $8C84; - GL_TRANSFORM_FEEDBACK_BUFFER_SIZE_EXT = $8C85; - GL_TRANSFORM_FEEDBACK_BUFFER_BINDING_EXT = $8C8F; - GL_INTERLEAVED_ATTRIBS_EXT = $8C8C; - GL_SEPARATE_ATTRIBS_EXT = $8C8D; - GL_PRIMITIVES_GENERATED_EXT = $8C87; - GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN_EXT = $8C88; - GL_RASTERIZER_DISCARD_EXT = $8C89; - GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS_EXT = $8C8A; - GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS_EXT = $8C8B; - GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS_EXT = $8C80; - GL_TRANSFORM_FEEDBACK_VARYINGS_EXT = $8C83; - GL_TRANSFORM_FEEDBACK_BUFFER_MODE_EXT = $8C7F; - GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH_EXT = $8C76; - - // GL_EXT_direct_state_access - GL_PROGRAM_MATRIX_EXT = $8E2D; - GL_TRANSPOSE_PROGRAM_MATRIX_EXT = $8E2E; - GL_PROGRAM_MATRIX_STACK_DEPTH_EXT = $8E2F; - - // GL_EXT_texture_swizzle - GL_TEXTURE_SWIZZLE_R_EXT = $8E42; - GL_TEXTURE_SWIZZLE_G_EXT = $8E43; - GL_TEXTURE_SWIZZLE_B_EXT = $8E44; - GL_TEXTURE_SWIZZLE_A_EXT = $8E45; - GL_TEXTURE_SWIZZLE_RGBA_EXT = $8E46; - - // GL_EXT_provoking_vertex - GL_QUADS_FOLLOW_PROVOKING_VERTEX_CONVENTION_EXT = $8E4C; - GL_FIRST_VERTEX_CONVENTION_EXT = $8E4D; - GL_LAST_VERTEX_CONVENTION_EXT = $8E4E; - GL_PROVOKING_VERTEX_EXT = $8E4F; - - // GL_EXT_texture_snorm - GL_ALPHA_SNORM = $9010; - GL_LUMINANCE_SNORM = $9011; - GL_LUMINANCE_ALPHA_SNORM = $9012; - GL_INTENSITY_SNORM = $9013; - GL_ALPHA8_SNORM = $9014; - GL_LUMINANCE8_SNORM = $9015; - GL_LUMINANCE8_ALPHA8_SNORM = $9016; - GL_INTENSITY8_SNORM = $9017; - GL_ALPHA16_SNORM = $9018; - GL_LUMINANCE16_SNORM = $9019; - GL_LUMINANCE16_ALPHA16_SNORM = $901A; - GL_INTENSITY16_SNORM = $901B; - { reuse GL_RED_SNORM } - { reuse GL_RG_SNORM } - { reuse GL_RGB_SNORM } - { reuse GL_RGBA_SNORM } - { reuse GL_R8_SNORM } - { reuse GL_RG8_SNORM } - { reuse GL_RGB8_SNORM } - { reuse GL_RGBA8_SNORM } - { reuse GL_R16_SNORM } - { reuse GL_RG16_SNORM } - { reuse GL_RGB16_SNORM } - { reuse GL_RGBA16_SNORM } - { reuse GL_SIGNED_NORMALIZED } - - // GL_EXT_separate_shader_objects - GL_ACTIVE_PROGRAM_EXT = $8B8D; - - // GL_EXT_shader_image_load_store - GL_MAX_IMAGE_UNITS_EXT = $8F38; - GL_MAX_COMBINED_IMAGE_UNITS_AND_FRAGMENT_OUTPUTS_EXT = $8F39; - GL_IMAGE_BINDING_NAME_EXT = $8F3A; - GL_IMAGE_BINDING_LEVEL_EXT = $8F3B; - GL_IMAGE_BINDING_LAYERED_EXT = $8F3C; - GL_IMAGE_BINDING_LAYER_EXT = $8F3D; - GL_IMAGE_BINDING_ACCESS_EXT = $8F3E; - GL_IMAGE_1D_EXT = $904C; - GL_IMAGE_2D_EXT = $904D; - GL_IMAGE_3D_EXT = $904E; - GL_IMAGE_2D_RECT_EXT = $904F; - GL_IMAGE_CUBE_EXT = $9050; - GL_IMAGE_BUFFER_EXT = $9051; - GL_IMAGE_1D_ARRAY_EXT = $9052; - GL_IMAGE_2D_ARRAY_EXT = $9053; - GL_IMAGE_CUBE_MAP_ARRAY_EXT = $9054; - GL_IMAGE_2D_MULTISAMPLE_EXT = $9055; - GL_IMAGE_2D_MULTISAMPLE_ARRAY_EXT = $9056; - GL_INT_IMAGE_1D_EXT = $9057; - GL_INT_IMAGE_2D_EXT = $9058; - GL_INT_IMAGE_3D_EXT = $9059; - GL_INT_IMAGE_2D_RECT_EXT = $905A; - GL_INT_IMAGE_CUBE_EXT = $905B; - GL_INT_IMAGE_BUFFER_EXT = $905C; - GL_INT_IMAGE_1D_ARRAY_EXT = $905D; - GL_INT_IMAGE_2D_ARRAY_EXT = $905E; - GL_INT_IMAGE_CUBE_MAP_ARRAY_EXT = $905F; - GL_INT_IMAGE_2D_MULTISAMPLE_EXT = $9060; - GL_INT_IMAGE_2D_MULTISAMPLE_ARRAY_EXT = $9061; - GL_UNSIGNED_INT_IMAGE_1D_EXT = $9062; - GL_UNSIGNED_INT_IMAGE_2D_EXT = $9063; - GL_UNSIGNED_INT_IMAGE_3D_EXT = $9064; - GL_UNSIGNED_INT_IMAGE_2D_RECT_EXT = $9065; - GL_UNSIGNED_INT_IMAGE_CUBE_EXT = $9066; - GL_UNSIGNED_INT_IMAGE_BUFFER_EXT = $9067; - GL_UNSIGNED_INT_IMAGE_1D_ARRAY_EXT = $9068; - GL_UNSIGNED_INT_IMAGE_2D_ARRAY_EXT = $9069; - GL_UNSIGNED_INT_IMAGE_CUBE_MAP_ARRAY_EXT = $906A; - GL_UNSIGNED_INT_IMAGE_2D_MULTISAMPLE_EXT = $906B; - GL_UNSIGNED_INT_IMAGE_2D_MULTISAMPLE_ARRAY_EXT = $906C; - GL_MAX_IMAGE_SAMPLES_EXT = $906D; - GL_IMAGE_BINDING_FORMAT_EXT = $906E; - GL_VERTEX_ATTRIB_ARRAY_BARRIER_BIT_EXT = $00000001; - GL_ELEMENT_ARRAY_BARRIER_BIT_EXT = $00000002; - GL_UNIFORM_BARRIER_BIT_EXT = $00000004; - GL_TEXTURE_FETCH_BARRIER_BIT_EXT = $00000008; - GL_SHADER_IMAGE_ACCESS_BARRIER_BIT_EXT = $00000020; - GL_COMMAND_BARRIER_BIT_EXT = $00000040; - GL_PIXEL_BUFFER_BARRIER_BIT_EXT = $00000080; - GL_TEXTURE_UPDATE_BARRIER_BIT_EXT = $00000100; - GL_BUFFER_UPDATE_BARRIER_BIT_EXT = $00000200; - GL_FRAMEBUFFER_BARRIER_BIT_EXT = $00000400; - GL_TRANSFORM_FEEDBACK_BARRIER_BIT_EXT = $00000800; - GL_ATOMIC_COUNTER_BARRIER_BIT_EXT = $00001000; - GL_ALL_BARRIER_BITS_EXT = $FFFFFFFF; - - // GL_EXT_vertex_attrib_64bit - { reuse GL_DOUBLE } - GL_DOUBLE_VEC2_EXT = $8FFC; - GL_DOUBLE_VEC3_EXT = $8FFD; - GL_DOUBLE_VEC4_EXT = $8FFE; - GL_DOUBLE_MAT2_EXT = $8F46; - GL_DOUBLE_MAT3_EXT = $8F47; - GL_DOUBLE_MAT4_EXT = $8F48; - GL_DOUBLE_MAT2x3_EXT = $8F49; - GL_DOUBLE_MAT2x4_EXT = $8F4A; - GL_DOUBLE_MAT3x2_EXT = $8F4B; - GL_DOUBLE_MAT3x4_EXT = $8F4C; - GL_DOUBLE_MAT4x2_EXT = $8F4D; - GL_DOUBLE_MAT4x3_EXT = $8F4E; - - // GL_EXT_texture_sRGB_decode - GL_TEXTURE_SRGB_DECODE_EXT = $8A48; - GL_DECODE_EXT = $8A49; - GL_SKIP_DECODE_EXT = $8A4A; - - // GL_NV_texture_multisample - GL_TEXTURE_COVERAGE_SAMPLES_NV = $9045; - GL_TEXTURE_COLOR_SAMPLES_NV = $9046; - - // GL_AMD_blend_minmax_factor - GL_FACTOR_MIN_AMD = $901C; - GL_FACTOR_MAX_AMD = $901D; - - // GL_AMD_sample_positions - GL_SUBSAMPLE_DISTANCE_AMD = $883F; - - // GL_EXT_x11_sync_object - GL_SYNC_X11_FENCE_EXT = $90E1; - - // GL_EXT_framebuffer_multisample_blit_scaled - GL_SCALED_RESOLVE_FASTEST_EXT = $90BA; - GL_SCALED_RESOLVE_NICEST_EXT = $90BB; - - // (4.3) GL_NV_path_rendering - GL_PATH_FORMAT_SVG_NV = $9070; - GL_PATH_FORMAT_PS_NV = $9071; - GL_STANDARD_FONT_NAME_NV = $9072; - GL_SYSTEM_FONT_NAME_NV = $9073; - GL_FILE_NAME_NV = $9074; - GL_PATH_STROKE_WIDTH_NV = $9075; - GL_PATH_END_CAPS_NV = $9076; - GL_PATH_INITIAL_END_CAP_NV = $9077; - GL_PATH_TERMINAL_END_CAP_NV = $9078; - GL_PATH_JOIN_STYLE_NV = $9079; - GL_PATH_MITER_LIMIT_NV = $907A; - GL_PATH_DASH_CAPS_NV = $907B; - GL_PATH_INITIAL_DASH_CAP_NV = $907C; - GL_PATH_TERMINAL_DASH_CAP_NV = $907D; - GL_PATH_DASH_OFFSET_NV = $907E; - GL_PATH_CLIENT_LENGTH_NV = $907F; - GL_PATH_FILL_MODE_NV = $9080; - GL_PATH_FILL_MASK_NV = $9081; - GL_PATH_FILL_COVER_MODE_NV = $9082; - GL_PATH_STROKE_COVER_MODE_NV = $9083; - GL_PATH_STROKE_MASK_NV = $9084; - GL_PATH_SAMPLE_QUALITY_NV = $9085; - GL_PATH_STROKE_BOUND_NV = $9086; - GL_PATH_STROKE_OVERSAMPLE_COUNT_NV= $9087; - GL_COUNT_UP_NV = $9088; - GL_COUNT_DOWN_NV = $9089; - GL_PATH_OBJECT_BOUNDING_BOX_NV = $908A; - GL_CONVEX_HULL_NV = $908B; - GL_MULTI_HULLS_NV = $908C; - GL_BOUNDING_BOX_NV = $908D; - GL_TRANSLATE_X_NV = $908E; - GL_TRANSLATE_Y_NV = $908F; - GL_TRANSLATE_2D_NV = $9090; - GL_TRANSLATE_3D_NV = $9091; - GL_AFFINE_2D_NV = $9092; - GL_PROJECTIVE_2D_NV = $9093; - GL_AFFINE_3D_NV = $9094; - GL_PROJECTIVE_3D_NV = $9095; - GL_TRANSPOSE_AFFINE_2D_NV = $9096; - GL_TRANSPOSE_PROJECTIVE_2D_NV = $9097; - GL_TRANSPOSE_AFFINE_3D_NV = $9098; - GL_TRANSPOSE_PROJECTIVE_3D_NV = $9099; - GL_UTF8_NV = $909A; - GL_UTF16_NV = $909B; - GL_BOUNDING_BOX_OF_BOUNDING_BOXES_NV= $909C; - GL_PATH_COMMAND_COUNT_NV = $909D; - GL_PATH_COORD_COUNT_NV = $909E; - GL_PATH_DASH_ARRAY_COUNT_NV = $909F; - GL_PATH_COMPUTED_LENGTH_NV = $90A0; - GL_PATH_FILL_BOUNDING_BOX_NV = $90A1; - GL_PATH_STROKE_BOUNDING_BOX_NV = $90A2; - GL_SQUARE_NV = $90A3; - GL_ROUND_NV = $90A4; - GL_TRIANGULAR_NV = $90A5; - GL_BEVEL_NV = $90A6; - GL_MITER_REVERT_NV = $90A7; - GL_MITER_TRUNCATE_NV = $90A8; - GL_SKIP_MISSING_GLYPH_NV = $90A9; - GL_USE_MISSING_GLYPH_NV = $90AA; - GL_PATH_ERROR_POSITION_NV = $90AB; - GL_PATH_FOG_GEN_MODE_NV = $90AC; - GL_ACCUM_ADJACENT_PAIRS_NV = $90AD; - GL_ADJACENT_PAIRS_NV = $90AE; - GL_FIRST_TO_REST_NV = $90AF; - GL_PATH_GEN_MODE_NV = $90B0; - GL_PATH_GEN_COEFF_NV = $90B1; - GL_PATH_GEN_COLOR_FORMAT_NV = $90B2; - GL_PATH_GEN_COMPONENTS_NV = $90B3; - GL_PATH_STENCIL_FUNC_NV = $90B7; - GL_PATH_STENCIL_REF_NV = $90B8; - GL_PATH_STENCIL_VALUE_MASK_NV = $90B9; - GL_PATH_STENCIL_DEPTH_OFFSET_FACTOR_NV= $90BD; - GL_PATH_STENCIL_DEPTH_OFFSET_UNITS_NV= $90BE; - GL_PATH_COVER_DEPTH_FUNC_NV = $90BF; - GL_PATH_DASH_OFFSET_RESET_NV = $90B4; - GL_MOVE_TO_RESETS_NV = $90B5; - GL_MOVE_TO_CONTINUES_NV = $90B6; - GL_CLOSE_PATH_NV = $00; - GL_MOVE_TO_NV = $02; - GL_RELATIVE_MOVE_TO_NV = $03; - GL_LINE_TO_NV = $04; - GL_RELATIVE_LINE_TO_NV = $05; - GL_HORIZONTAL_LINE_TO_NV = $06; - GL_RELATIVE_HORIZONTAL_LINE_TO_NV= $07; - GL_VERTICAL_LINE_TO_NV = $08; - GL_RELATIVE_VERTICAL_LINE_TO_NV = $09; - GL_QUADRATIC_CURVE_TO_NV = $0A; - GL_RELATIVE_QUADRATIC_CURVE_TO_NV= $0B; - GL_CUBIC_CURVE_TO_NV = $0C; - GL_RELATIVE_CUBIC_CURVE_TO_NV = $0D; - GL_SMOOTH_QUADRATIC_CURVE_TO_NV = $0E; - GL_RELATIVE_SMOOTH_QUADRATIC_CURVE_TO_NV= $0F; - GL_SMOOTH_CUBIC_CURVE_TO_NV = $10; - GL_RELATIVE_SMOOTH_CUBIC_CURVE_TO_NV= $11; - GL_SMALL_CCW_ARC_TO_NV = $12; - GL_RELATIVE_SMALL_CCW_ARC_TO_NV = $13; - GL_SMALL_CW_ARC_TO_NV = $14; - GL_RELATIVE_SMALL_CW_ARC_TO_NV = $15; - GL_LARGE_CCW_ARC_TO_NV = $16; - GL_RELATIVE_LARGE_CCW_ARC_TO_NV = $17; - GL_LARGE_CW_ARC_TO_NV = $18; - GL_RELATIVE_LARGE_CW_ARC_TO_NV = $19; - GL_RESTART_PATH_NV = $F0; - GL_DUP_FIRST_CUBIC_CURVE_TO_NV = $F2; - GL_DUP_LAST_CUBIC_CURVE_TO_NV = $F4; - GL_RECT_NV = $F6; - GL_CIRCULAR_CCW_ARC_TO_NV = $F8; - GL_CIRCULAR_CW_ARC_TO_NV = $FA; - GL_CIRCULAR_TANGENT_ARC_TO_NV = $FC; - GL_ARC_TO_NV = $FE; - GL_RELATIVE_ARC_TO_NV = $FF; - GL_BOLD_BIT_NV = $01; - GL_ITALIC_BIT_NV = $02; - GL_GLYPH_WIDTH_BIT_NV = $01; - GL_GLYPH_HEIGHT_BIT_NV = $02; - GL_GLYPH_HORIZONTAL_BEARING_X_BIT_NV= $04; - GL_GLYPH_HORIZONTAL_BEARING_Y_BIT_NV= $08; - GL_GLYPH_HORIZONTAL_BEARING_ADVANCE_BIT_NV= $10; - GL_GLYPH_VERTICAL_BEARING_X_BIT_NV= $20; - GL_GLYPH_VERTICAL_BEARING_Y_BIT_NV= $40; - GL_GLYPH_VERTICAL_BEARING_ADVANCE_BIT_NV= $80; - GL_GLYPH_HAS_KERNING_NV = $100; - GL_FONT_X_MIN_BOUNDS_NV = $00010000; - GL_FONT_Y_MIN_BOUNDS_NV = $00020000; - GL_FONT_X_MAX_BOUNDS_NV = $00040000; - GL_FONT_Y_MAX_BOUNDS_NV = $00080000; - GL_FONT_UNITS_PER_EM_NV = $00100000; - GL_FONT_ASCENDER_NV = $00200000; - GL_FONT_DESCENDER_NV = $00400000; - GL_FONT_HEIGHT_NV = $00800000; - GL_FONT_MAX_ADVANCE_WIDTH_NV = $01000000; - GL_FONT_MAX_ADVANCE_HEIGHT_NV = $02000000; - GL_FONT_UNDERLINE_POSITION_NV = $04000000; - GL_FONT_UNDERLINE_THICKNESS_NV = $08000000; - GL_FONT_HAS_KERNING_NV = $10000000; - - // (4.3) GL_AMD_pinned_memory - GL_EXTERNAL_VIRTUAL_MEMORY_BUFFER_AMD= $9160; - - // (4.3) GL_AMD_stencil_operation_extended - GL_SET_AMD = $874A; - GL_REPLACE_VALUE_AMD = $874B; - GL_STENCIL_OP_VALUE_AMD = $874C; - GL_STENCIL_BACK_OP_VALUE_AMD = $874D; - - // (4.3) GL_AMD_vertex_shader_viewport_index - - // (4.3) GL_AMD_vertex_shader_layer - - // (4.3) GL_NV_bindless_texture - - // (4.3) GL_NV_shader_atomic_float - - // (4.3) GL_AMD_query_buffer_object - GL_QUERY_BUFFER_AMD = $9192; - GL_QUERY_BUFFER_BINDING_AMD = $9193; - GL_QUERY_RESULT_NO_WAIT_AMD = $9194; - - // GL_FfdMaskSGIX - GL_TEXTURE_DEFORMATION_BIT_SGIX = $00000001; - GL_GEOMETRY_DEFORMATION_BIT_SGIX = $00000002; - - // GL_HP_convolution_border_modes - GL_IGNORE_BORDER_HP = $8150; - GL_CONSTANT_BORDER_HP = $8151; - GL_REPLICATE_BORDER_HP = $8153; - GL_CONVOLUTION_BORDER_COLOR_HP = $8154; - - // GL_HP_image_transform - GL_IMAGE_SCALE_X_HP = $8155; - GL_IMAGE_SCALE_Y_HP = $8156; - GL_IMAGE_TRANSLATE_X_HP = $8157; - GL_IMAGE_TRANSLATE_Y_HP = $8158; - GL_IMAGE_ROTATE_ANGLE_HP = $8159; - GL_IMAGE_ROTATE_ORIGIN_X_HP = $815A; - GL_IMAGE_ROTATE_ORIGIN_Y_HP = $815B; - GL_IMAGE_MAG_FILTER_HP = $815C; - GL_IMAGE_MIN_FILTER_HP = $815D; - GL_IMAGE_CUBIC_WEIGHT_HP = $815E; - GL_CUBIC_HP = $815F; - GL_AVERAGE_HP = $8160; - GL_IMAGE_TRANSFORM_2D_HP = $8161; - GL_POST_IMAGE_TRANSFORM_COLOR_TABLE_HP = $8162; - GL_PROXY_POST_IMAGE_TRANSFORM_COLOR_TABLE_HP = $8163; - - // GL_HP_occlusion_test - GL_OCCLUSION_TEST_HP = $8165; - GL_OCCLUSION_TEST_RESULT_HP = $8166; - - // GL_HP_texture_lighting - GL_TEXTURE_LIGHTING_MODE_HP = $8167; - GL_TEXTURE_POST_SPECULAR_HP = $8168; - GL_TEXTURE_PRE_SPECULAR_HP = $8169; - - // GL_IBM_cull_vertex - GL_CULL_VERTEX_IBM = 103050; - - // GL_IBM_rasterpos_clip - GL_RASTER_POSITION_UNCLIPPED_IBM = $19262; - - // GL_IBM_texture_mirrored_repeat - GL_MIRRORED_REPEAT_IBM = $8370; - - // GL_IBM_vertex_array_lists - GL_VERTEX_ARRAY_LIST_IBM = 103070; - GL_NORMAL_ARRAY_LIST_IBM = 103071; - GL_COLOR_ARRAY_LIST_IBM = 103072; - GL_INDEX_ARRAY_LIST_IBM = 103073; - GL_TEXTURE_COORD_ARRAY_LIST_IBM = 103074; - GL_EDGE_FLAG_ARRAY_LIST_IBM = 103075; - GL_FOG_COORDINATE_ARRAY_LIST_IBM = 103076; - GL_SECONDARY_COLOR_ARRAY_LIST_IBM = 103077; - GL_VERTEX_ARRAY_LIST_STRIDE_IBM = 103080; - GL_NORMAL_ARRAY_LIST_STRIDE_IBM = 103081; - GL_COLOR_ARRAY_LIST_STRIDE_IBM = 103082; - GL_INDEX_ARRAY_LIST_STRIDE_IBM = 103083; - GL_TEXTURE_COORD_ARRAY_LIST_STRIDE_IBM = 103084; - GL_EDGE_FLAG_ARRAY_LIST_STRIDE_IBM = 103085; - GL_FOG_COORDINATE_ARRAY_LIST_STRIDE_IBM = 103086; - GL_SECONDARY_COLOR_ARRAY_LIST_STRIDE_IBM = 103087; - - // GL_INGR_color_clamp - GL_RED_MIN_CLAMP_INGR = $8560; - GL_GREEN_MIN_CLAMP_INGR = $8561; - GL_BLUE_MIN_CLAMP_INGR = $8562; - GL_ALPHA_MIN_CLAMP_INGR = $8563; - GL_RED_MAX_CLAMP_INGR = $8564; - GL_GREEN_MAX_CLAMP_INGR = $8565; - GL_BLUE_MAX_CLAMP_INGR = $8566; - GL_ALPHA_MAX_CLAMP_INGR = $8567; - - // GL_INGR_interlace_read - GL_INTERLACE_READ_INGR = $8568; - - // GL_INTEL_parallel_arrays - GL_PARALLEL_ARRAYS_INTEL = $83F4; - GL_VERTEX_ARRAY_PARALLEL_POINTERS_INTEL = $83F5; - GL_NORMAL_ARRAY_PARALLEL_POINTERS_INTEL = $83F6; - GL_COLOR_ARRAY_PARALLEL_POINTERS_INTEL = $83F7; - GL_TEXTURE_COORD_ARRAY_PARALLEL_POINTERS_INTEL = $83F8; - - // GL_NV_copy_depth_to_color - GL_DEPTH_STENCIL_TO_RGBA_NV = $886E; - GL_DEPTH_STENCIL_TO_BGRA_NV = $886F; - - // GL_NV_depth_clamp - GL_DEPTH_CLAMP_NV = $864F; - - // GL_NV_evaluators - GL_EVAL_2D_NV = $86C0; - GL_EVAL_TRIANGULAR_2D_NV = $86C1; - GL_MAP_TESSELLATION_NV = $86C2; - GL_MAP_ATTRIB_U_ORDER_NV = $86C3; - GL_MAP_ATTRIB_V_ORDER_NV = $86C4; - GL_EVAL_FRACTIONAL_TESSELLATION_NV = $86C5; - GL_EVAL_VERTEX_ATTRIB0_NV = $86C6; - GL_EVAL_VERTEX_ATTRIB1_NV = $86C7; - GL_EVAL_VERTEX_ATTRIB2_NV = $86C8; - GL_EVAL_VERTEX_ATTRIB3_NV = $86C9; - GL_EVAL_VERTEX_ATTRIB4_NV = $86CA; - GL_EVAL_VERTEX_ATTRIB5_NV = $86CB; - GL_EVAL_VERTEX_ATTRIB6_NV = $86CC; - GL_EVAL_VERTEX_ATTRIB7_NV = $86CD; - GL_EVAL_VERTEX_ATTRIB8_NV = $86CE; - GL_EVAL_VERTEX_ATTRIB9_NV = $86CF; - GL_EVAL_VERTEX_ATTRIB10_NV = $86D0; - GL_EVAL_VERTEX_ATTRIB11_NV = $86D1; - GL_EVAL_VERTEX_ATTRIB12_NV = $86D2; - GL_EVAL_VERTEX_ATTRIB13_NV = $86D3; - GL_EVAL_VERTEX_ATTRIB14_NV = $86D4; - GL_EVAL_VERTEX_ATTRIB15_NV = $86D5; - GL_MAX_MAP_TESSELLATION_NV = $86D6; - GL_MAX_RATIONAL_EVAL_ORDER_NV = $86D7; - - // GL_NV_fence - GL_ALL_COMPLETED_NV = $84F2; - GL_FENCE_STATUS_NV = $84F3; - GL_FENCE_CONDITION_NV = $84F4; - - // GL_NV_float_buffer - GL_FLOAT_R_NV = $8880; - GL_FLOAT_RG_NV = $8881; - GL_FLOAT_RGB_NV = $8882; - GL_FLOAT_RGBA_NV = $8883; - GL_FLOAT_R16_NV = $8884; - GL_FLOAT_R32_NV = $8885; - GL_FLOAT_RG16_NV = $8886; - GL_FLOAT_RG32_NV = $8887; - GL_FLOAT_RGB16_NV = $8888; - GL_FLOAT_RGB32_NV = $8889; - GL_FLOAT_RGBA16_NV = $888A; - GL_FLOAT_RGBA32_NV = $888B; - GL_TEXTURE_FLOAT_COMPONENTS_NV = $888C; - GL_FLOAT_CLEAR_COLOR_VALUE_NV = $888D; - GL_FLOAT_RGBA_MODE_NV = $888E; - - // GL_NV_fog_distance - GL_FOG_DISTANCE_MODE_NV = $855A; - GL_EYE_RADIAL_NV = $855B; - GL_EYE_PLANE_ABSOLUTE_NV = $855C; - - // GL_NV_fragment_program - GL_MAX_FRAGMENT_PROGRAM_LOCAL_PARAMETERS_NV = $8868; - GL_FRAGMENT_PROGRAM_NV = $8870; - GL_MAX_TEXTURE_COORDS_NV = $8871; - GL_MAX_TEXTURE_IMAGE_UNITS_NV = $8872; - GL_FRAGMENT_PROGRAM_BINDING_NV = $8873; - GL_PROGRAM_ERROR_STRING_NV = $8874; - - // GL_NV_half_float - GL_HALF_FLOAT_NV = $140B; - - // GL_NV_light_max_exponent - GL_MAX_SHININESS_NV = $8504; - GL_MAX_SPOT_EXPONENT_NV = $8505; - - // GL_NV_multisample_filter_hint - GL_MULTISAMPLE_FILTER_HINT_NV = $8534; - - // GL_NV_occlusion_query - GL_PIXEL_COUNTER_BITS_NV = $8864; - GL_CURRENT_OCCLUSION_QUERY_ID_NV = $8865; - GL_PIXEL_COUNT_NV = $8866; - GL_PIXEL_COUNT_AVAILABLE_NV = $8867; - - // GL_NV_packed_depth_stencil - GL_DEPTH_STENCIL_NV = $84F9; - GL_UNSIGNED_INT_24_8_NV = $84FA; - - // GL_NV_pixel_data_range - GL_WRITE_PIXEL_DATA_RANGE_NV = $8878; - GL_READ_PIXEL_DATA_RANGE_NV = $8879; - GL_WRITE_PIXEL_DATA_RANGE_LENGTH_NV = $887A; - GL_READ_PIXEL_DATA_RANGE_LENGTH_NV = $887B; - GL_WRITE_PIXEL_DATA_RANGE_POINTER_NV = $887C; - GL_READ_PIXEL_DATA_RANGE_POINTER_NV = $887D; - - // GL_NV_point_sprite - GL_POINT_SPRITE_NV = $8861; - GL_COORD_REPLACE_NV = $8862; - GL_POINT_SPRITE_R_MODE_NV = $8863; - - // GL_NV_primitive_restart - GL_PRIMITIVE_RESTART_NV = $8558; - GL_PRIMITIVE_RESTART_INDEX_NV = $8559; - - // GL_NV_register_combiners - GL_REGISTER_COMBINERS_NV = $8522; - GL_VARIABLE_A_NV = $8523; - GL_VARIABLE_B_NV = $8524; - GL_VARIABLE_C_NV = $8525; - GL_VARIABLE_D_NV = $8526; - GL_VARIABLE_E_NV = $8527; - GL_VARIABLE_F_NV = $8528; - GL_VARIABLE_G_NV = $8529; - GL_CONSTANT_COLOR0_NV = $852A; - GL_CONSTANT_COLOR1_NV = $852B; - GL_PRIMARY_COLOR_NV = $852C; - GL_SECONDARY_COLOR_NV = $852D; - GL_SPARE0_NV = $852E; - GL_SPARE1_NV = $852F; - GL_DISCARD_NV = $8530; - GL_E_TIMES_F_NV = $8531; - GL_SPARE0_PLUS_SECONDARY_COLOR_NV = $8532; - GL_UNSIGNED_IDENTITY_NV = $8536; - GL_UNSIGNED_INVERT_NV = $8537; - GL_EXPAND_NORMAL_NV = $8538; - GL_EXPAND_NEGATE_NV = $8539; - GL_HALF_BIAS_NORMAL_NV = $853A; - GL_HALF_BIAS_NEGATE_NV = $853B; - GL_SIGNED_IDENTITY_NV = $853C; - GL_SIGNED_NEGATE_NV = $853D; - GL_SCALE_BY_TWO_NV = $853E; - GL_SCALE_BY_FOUR_NV = $853F; - GL_SCALE_BY_ONE_HALF_NV = $8540; - GL_BIAS_BY_NEGATIVE_ONE_HALF_NV = $8541; - GL_COMBINER_INPUT_NV = $8542; - GL_COMBINER_MAPPING_NV = $8543; - GL_COMBINER_COMPONENT_USAGE_NV = $8544; - GL_COMBINER_AB_DOT_PRODUCT_NV = $8545; - GL_COMBINER_CD_DOT_PRODUCT_NV = $8546; - GL_COMBINER_MUX_SUM_NV = $8547; - GL_COMBINER_SCALE_NV = $8548; - GL_COMBINER_BIAS_NV = $8549; - GL_COMBINER_AB_OUTPUT_NV = $854A; - GL_COMBINER_CD_OUTPUT_NV = $854B; - GL_COMBINER_SUM_OUTPUT_NV = $854C; - GL_MAX_GENERAL_COMBINERS_NV = $854D; - GL_NUM_GENERAL_COMBINERS_NV = $854E; - GL_COLOR_SUM_CLAMP_NV = $854F; - GL_COMBINER0_NV = $8550; - GL_COMBINER1_NV = $8551; - GL_COMBINER2_NV = $8552; - GL_COMBINER3_NV = $8553; - GL_COMBINER4_NV = $8554; - GL_COMBINER5_NV = $8555; - GL_COMBINER6_NV = $8556; - GL_COMBINER7_NV = $8557; - - // GL_NV_register_combiners2 - GL_PER_STAGE_CONSTANTS_NV = $8535; - - // GL_NV_texgen_emboss - GL_EMBOSS_LIGHT_NV = $855D; - GL_EMBOSS_CONSTANT_NV = $855E; - GL_EMBOSS_MAP_NV = $855F; - - // GL_NV_texgen_reflection - GL_NORMAL_MAP_NV = $8511; - GL_REFLECTION_MAP_NV = $8512; - - // GL_NV_texture_env_combine4 - GL_COMBINE4_NV = $8503; - GL_SOURCE3_RGB_NV = $8583; - GL_SOURCE3_ALPHA_NV = $858B; - GL_OPERAND3_RGB_NV = $8593; - GL_OPERAND3_ALPHA_NV = $859B; - - // GL_NV_texture_expand_normal - GL_TEXTURE_UNSIGNED_REMAP_MODE_NV = $888F; - - // GL_NV_texture_rectangle - GL_TEXTURE_RECTANGLE_NV = $84F5; - GL_TEXTURE_BINDING_RECTANGLE_NV = $84F6; - GL_PROXY_TEXTURE_RECTANGLE_NV = $84F7; - GL_MAX_RECTANGLE_TEXTURE_SIZE_NV = $84F8; - - // GL_NV_texture_shader - GL_OFFSET_TEXTURE_RECTANGLE_NV = $864C; - GL_OFFSET_TEXTURE_RECTANGLE_SCALE_NV = $864D; - GL_DOT_PRODUCT_TEXTURE_RECTANGLE_NV = $864E; - GL_RGBA_UNSIGNED_DOT_PRODUCT_MAPPING_NV = $86D9; - GL_UNSIGNED_INT_S8_S8_8_8_NV = $86DA; - GL_UNSIGNED_INT_8_8_S8_S8_REV_NV = $86DB; - GL_DSDT_MAG_INTENSITY_NV = $86DC; - GL_SHADER_CONSISTENT_NV = $86DD; - GL_TEXTURE_SHADER_NV = $86DE; - GL_SHADER_OPERATION_NV = $86DF; - GL_CULL_MODES_NV = $86E0; - GL_OFFSET_TEXTURE_MATRIX_NV = $86E1; - GL_OFFSET_TEXTURE_SCALE_NV = $86E2; - GL_OFFSET_TEXTURE_BIAS_NV = $86E3; - GL_OFFSET_TEXTURE_2D_MATRIX_NV = GL_OFFSET_TEXTURE_MATRIX_NV; - GL_OFFSET_TEXTURE_2D_SCALE_NV = GL_OFFSET_TEXTURE_SCALE_NV; - GL_OFFSET_TEXTURE_2D_BIAS_NV = GL_OFFSET_TEXTURE_BIAS_NV; - GL_PREVIOUS_TEXTURE_INPUT_NV = $86E4; - GL_CONST_EYE_NV = $86E5; - GL_PASS_THROUGH_NV = $86E6; - GL_CULL_FRAGMENT_NV = $86E7; - GL_OFFSET_TEXTURE_2D_NV = $86E8; - GL_DEPENDENT_AR_TEXTURE_2D_NV = $86E9; - GL_DEPENDENT_GB_TEXTURE_2D_NV = $86EA; - GL_DOT_PRODUCT_NV = $86EC; - GL_DOT_PRODUCT_DEPTH_REPLACE_NV = $86ED; - GL_DOT_PRODUCT_TEXTURE_2D_NV = $86EE; - GL_DOT_PRODUCT_TEXTURE_CUBE_MAP_NV = $86F0; - GL_DOT_PRODUCT_DIFFUSE_CUBE_MAP_NV = $86F1; - GL_DOT_PRODUCT_REFLECT_CUBE_MAP_NV = $86F2; - GL_DOT_PRODUCT_CONST_EYE_REFLECT_CUBE_MAP_NV = $86F3; - GL_HILO_NV = $86F4; - GL_DSDT_NV = $86F5; - GL_DSDT_MAG_NV = $86F6; - GL_DSDT_MAG_VIB_NV = $86F7; - GL_HILO16_NV = $86F8; - GL_SIGNED_HILO_NV = $86F9; - GL_SIGNED_HILO16_NV = $86FA; - GL_SIGNED_RGBA_NV = $86FB; - GL_SIGNED_RGBA8_NV = $86FC; - GL_SIGNED_RGB_NV = $86FE; - GL_SIGNED_RGB8_NV = $86FF; - GL_SIGNED_LUMINANCE_NV = $8701; - GL_SIGNED_LUMINANCE8_NV = $8702; - GL_SIGNED_LUMINANCE_ALPHA_NV = $8703; - GL_SIGNED_LUMINANCE8_ALPHA8_NV = $8704; - GL_SIGNED_ALPHA_NV = $8705; - GL_SIGNED_ALPHA8_NV = $8706; - GL_SIGNED_INTENSITY_NV = $8707; - GL_SIGNED_INTENSITY8_NV = $8708; - GL_DSDT8_NV = $8709; - GL_DSDT8_MAG8_NV = $870A; - GL_DSDT8_MAG8_INTENSITY8_NV = $870B; - GL_SIGNED_RGB_UNSIGNED_ALPHA_NV = $870C; - GL_SIGNED_RGB8_UNSIGNED_ALPHA8_NV = $870D; - GL_HI_SCALE_NV = $870E; - GL_LO_SCALE_NV = $870F; - GL_DS_SCALE_NV = $8710; - GL_DT_SCALE_NV = $8711; - GL_MAGNITUDE_SCALE_NV = $8712; - GL_VIBRANCE_SCALE_NV = $8713; - GL_HI_BIAS_NV = $8714; - GL_LO_BIAS_NV = $8715; - GL_DS_BIAS_NV = $8716; - GL_DT_BIAS_NV = $8717; - GL_MAGNITUDE_BIAS_NV = $8718; - GL_VIBRANCE_BIAS_NV = $8719; - GL_TEXTURE_BORDER_VALUES_NV = $871A; - GL_TEXTURE_HI_SIZE_NV = $871B; - GL_TEXTURE_LO_SIZE_NV = $871C; - GL_TEXTURE_DS_SIZE_NV = $871D; - GL_TEXTURE_DT_SIZE_NV = $871E; - GL_TEXTURE_MAG_SIZE_NV = $871F; - - // GL_NV_texture_shader2 - GL_DOT_PRODUCT_TEXTURE_3D_NV = $86EF; - - // GL_NV_texture_shader3 - GL_OFFSET_PROJECTIVE_TEXTURE_2D_NV = $8850; - GL_OFFSET_PROJECTIVE_TEXTURE_2D_SCALE_NV = $8851; - GL_OFFSET_PROJECTIVE_TEXTURE_RECTANGLE_NV = $8852; - GL_OFFSET_PROJECTIVE_TEXTURE_RECTANGLE_SCALE_NV = $8853; - GL_OFFSET_HILO_TEXTURE_2D_NV = $8854; - GL_OFFSET_HILO_TEXTURE_RECTANGLE_NV = $8855; - GL_OFFSET_HILO_PROJECTIVE_TEXTURE_2D_NV = $8856; - GL_OFFSET_HILO_PROJECTIVE_TEXTURE_RECTANGLE_NV = $8857; - GL_DEPENDENT_HILO_TEXTURE_2D_NV = $8858; - GL_DEPENDENT_RGB_TEXTURE_3D_NV = $8859; - GL_DEPENDENT_RGB_TEXTURE_CUBE_MAP_NV = $885A; - GL_DOT_PRODUCT_PASS_THROUGH_NV = $885B; - GL_DOT_PRODUCT_TEXTURE_1D_NV = $885C; - GL_DOT_PRODUCT_AFFINE_DEPTH_REPLACE_NV = $885D; - GL_HILO8_NV = $885E; - GL_SIGNED_HILO8_NV = $885F; - GL_FORCE_BLUE_TO_ONE_NV = $8860; - - // GL_NV_vertex_array_range - GL_VERTEX_ARRAY_RANGE_NV = $851D; - GL_VERTEX_ARRAY_RANGE_LENGTH_NV = $851E; - GL_VERTEX_ARRAY_RANGE_VALID_NV = $851F; - GL_MAX_VERTEX_ARRAY_RANGE_ELEMENT_NV = $8520; - GL_VERTEX_ARRAY_RANGE_POINTER_NV = $8521; - - // GL_NV_vertex_array_range2 - GL_VERTEX_ARRAY_RANGE_WITHOUT_FLUSH_NV = $8533; - - // GL_NV_vertex_program - GL_VERTEX_PROGRAM_NV = $8620; - GL_VERTEX_STATE_PROGRAM_NV = $8621; - GL_ATTRIB_ARRAY_SIZE_NV = $8623; - GL_ATTRIB_ARRAY_STRIDE_NV = $8624; - GL_ATTRIB_ARRAY_TYPE_NV = $8625; - GL_CURRENT_ATTRIB_NV = $8626; - GL_PROGRAM_LENGTH_NV = $8627; - GL_PROGRAM_STRING_NV = $8628; - GL_MODELVIEW_PROJECTION_NV = $8629; - GL_IDENTITY_NV = $862A; - GL_INVERSE_NV = $862B; - GL_TRANSPOSE_NV = $862C; - GL_INVERSE_TRANSPOSE_NV = $862D; - GL_MAX_TRACK_MATRIX_STACK_DEPTH_NV = $862E; - GL_MAX_TRACK_MATRICES_NV = $862F; - GL_MATRIX0_NV = $8630; - GL_MATRIX1_NV = $8631; - GL_MATRIX2_NV = $8632; - GL_MATRIX3_NV = $8633; - GL_MATRIX4_NV = $8634; - GL_MATRIX5_NV = $8635; - GL_MATRIX6_NV = $8636; - GL_MATRIX7_NV = $8637; - GL_CURRENT_MATRIX_STACK_DEPTH_NV = $8640; - GL_CURRENT_MATRIX_NV = $8641; - GL_VERTEX_PROGRAM_POINT_SIZE_NV = $8642; - GL_VERTEX_PROGRAM_TWO_SIDE_NV = $8643; - GL_PROGRAM_PARAMETER_NV = $8644; - GL_ATTRIB_ARRAY_POINTER_NV = $8645; - GL_PROGRAM_TARGET_NV = $8646; - GL_PROGRAM_RESIDENT_NV = $8647; - GL_TRACK_MATRIX_NV = $8648; - GL_TRACK_MATRIX_TRANSFORM_NV = $8649; - GL_VERTEX_PROGRAM_BINDING_NV = $864A; - GL_PROGRAM_ERROR_POSITION_NV = $864B; - GL_VERTEX_ATTRIB_ARRAY0_NV = $8650; - GL_VERTEX_ATTRIB_ARRAY1_NV = $8651; - GL_VERTEX_ATTRIB_ARRAY2_NV = $8652; - GL_VERTEX_ATTRIB_ARRAY3_NV = $8653; - GL_VERTEX_ATTRIB_ARRAY4_NV = $8654; - GL_VERTEX_ATTRIB_ARRAY5_NV = $8655; - GL_VERTEX_ATTRIB_ARRAY6_NV = $8656; - GL_VERTEX_ATTRIB_ARRAY7_NV = $8657; - GL_VERTEX_ATTRIB_ARRAY8_NV = $8658; - GL_VERTEX_ATTRIB_ARRAY9_NV = $8659; - GL_VERTEX_ATTRIB_ARRAY10_NV = $865A; - GL_VERTEX_ATTRIB_ARRAY11_NV = $865B; - GL_VERTEX_ATTRIB_ARRAY12_NV = $865C; - GL_VERTEX_ATTRIB_ARRAY13_NV = $865D; - GL_VERTEX_ATTRIB_ARRAY14_NV = $865E; - GL_VERTEX_ATTRIB_ARRAY15_NV = $865F; - GL_MAP1_VERTEX_ATTRIB0_4_NV = $8660; - GL_MAP1_VERTEX_ATTRIB1_4_NV = $8661; - GL_MAP1_VERTEX_ATTRIB2_4_NV = $8662; - GL_MAP1_VERTEX_ATTRIB3_4_NV = $8663; - GL_MAP1_VERTEX_ATTRIB4_4_NV = $8664; - GL_MAP1_VERTEX_ATTRIB5_4_NV = $8665; - GL_MAP1_VERTEX_ATTRIB6_4_NV = $8666; - GL_MAP1_VERTEX_ATTRIB7_4_NV = $8667; - GL_MAP1_VERTEX_ATTRIB8_4_NV = $8668; - GL_MAP1_VERTEX_ATTRIB9_4_NV = $8669; - GL_MAP1_VERTEX_ATTRIB10_4_NV = $866A; - GL_MAP1_VERTEX_ATTRIB11_4_NV = $866B; - GL_MAP1_VERTEX_ATTRIB12_4_NV = $866C; - GL_MAP1_VERTEX_ATTRIB13_4_NV = $866D; - GL_MAP1_VERTEX_ATTRIB14_4_NV = $866E; - GL_MAP1_VERTEX_ATTRIB15_4_NV = $866F; - GL_MAP2_VERTEX_ATTRIB0_4_NV = $8670; - GL_MAP2_VERTEX_ATTRIB1_4_NV = $8671; - GL_MAP2_VERTEX_ATTRIB2_4_NV = $8672; - GL_MAP2_VERTEX_ATTRIB3_4_NV = $8673; - GL_MAP2_VERTEX_ATTRIB4_4_NV = $8674; - GL_MAP2_VERTEX_ATTRIB5_4_NV = $8675; - GL_MAP2_VERTEX_ATTRIB6_4_NV = $8676; - GL_MAP2_VERTEX_ATTRIB7_4_NV = $8677; - GL_MAP2_VERTEX_ATTRIB8_4_NV = $8678; - GL_MAP2_VERTEX_ATTRIB9_4_NV = $8679; - GL_MAP2_VERTEX_ATTRIB10_4_NV = $867A; - GL_MAP2_VERTEX_ATTRIB11_4_NV = $867B; - GL_MAP2_VERTEX_ATTRIB12_4_NV = $867C; - GL_MAP2_VERTEX_ATTRIB13_4_NV = $867D; - GL_MAP2_VERTEX_ATTRIB14_4_NV = $867E; - GL_MAP2_VERTEX_ATTRIB15_4_NV = $867F; - - // GL_NV_fragment_program2 and GL_NV_vertex_program2_option - GL_MAX_PROGRAM_EXEC_INSTRUCTIONS_NV = $88F4; - GL_MAX_PROGRAM_CALL_DEPTH_NV = $88F5; - - // GL_NV_fragment_program2 - GL_MAX_PROGRAM_IF_DEPTH_NV = $88F6; - GL_MAX_PROGRAM_LOOP_DEPTH_NV = $88F7; - GL_MAX_PROGRAM_LOOP_COUNT_NV = $88F8; - - // GL_NV_vertex_program3 - MAX_VERTEX_TEXTURE_IMAGE_UNITS_ARB = $8B4C; - - // GL_NV_depth_buffer_float - GL_FLOAT_32_UNSIGNED_INT_24_8_REV_NV = $8DAD; - GL_DEPTH_BUFFER_FLOAT_MODE_NV = $8DAF; - - // GL_NV_framebuffer_multisample_coverage - GL_RENDERBUFFER_COVERAGE_SAMPLES_NV = $8CAB; - GL_RENDERBUFFER_COLOR_SAMPLES_NV = $8E10; - - // GL_NV_geometry_program4 - GL_GEOMETRY_PROGRAM_NV = $8C26; - GL_MAX_PROGRAM_OUTPUT_VERTICES_NV = $8C27; - GL_MAX_PROGRAM_TOTAL_OUTPUT_COMPONENTS_NV = $8C28; - - // GL_NV_gpu_program4 - GL_PROGRAM_ATTRIB_COMPONENTS_NV = $8906; - GL_PROGRAM_RESULT_COMPONENTS_NV = $8907; - GL_MAX_PROGRAM_ATTRIB_COMPONENTS_NV = $8908; - GL_MAX_PROGRAM_RESULT_COMPONENTS_NV = $8909; - GL_MAX_PROGRAM_GENERIC_ATTRIBS_NV = $8DA5; - GL_MAX_PROGRAM_GENERIC_RESULTS_NV = $8DA6; - - // GL_NV_parameter_buffer_object - GL_MAX_PROGRAM_PARAMETER_BUFFER_BINDINGS_NV = $8DA0; - GL_MAX_PROGRAM_PARAMETER_BUFFER_SIZE_NV = $8DA1; - GL_VERTEX_PROGRAM_PARAMETER_BUFFER_NV = $8DA2; - GL_GEOMETRY_PROGRAM_PARAMETER_BUFFER_NV = $8DA3; - GL_FRAGMENT_PROGRAM_PARAMETER_BUFFER_NV = $8DA4; - - // GL_NV_transform_feedback - GL_TRANSFORM_FEEDBACK_BUFFER_NV = $8C8E; - GL_TRANSFORM_FEEDBACK_BUFFER_START_NV = $8C84; - GL_TRANSFORM_FEEDBACK_BUFFER_SIZE_NV = $8C85; - GL_TRANSFORM_FEEDBACK_RECORD_NV = $8C86; - GL_TRANSFORM_FEEDBACK_BUFFER_BINDING_NV = $8C8F; - GL_INTERLEAVED_ATTRIBS_NV = $8C8C; - GL_SEPARATE_ATTRIBS_NV = $8C8D; - GL_PRIMITIVES_GENERATED_NV = $8C87; - GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN_NV = $8C88; - GL_RASTERIZER_DISCARD_NV = $8C89; - GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS_NV = $8C8A; - GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS_NV = $8C8B; - GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS_NV = $8C80; - GL_TRANSFORM_FEEDBACK_ATTRIBS_NV = $8C7E; - GL_ACTIVE_VARYINGS_NV = $8C81; - GL_ACTIVE_VARYING_MAX_LENGTH_NV = $8C82; - GL_TRANSFORM_FEEDBACK_VARYINGS_NV = $8C83; - GL_TRANSFORM_FEEDBACK_BUFFER_MODE_NV = $8C7F; - GL_BACK_PRIMARY_COLOR_NV = $8C77; - GL_BACK_SECONDARY_COLOR_NV = $8C78; - GL_TEXTURE_COORD_NV = $8C79; - GL_CLIP_DISTANCE_NV = $8C7A; - GL_VERTEX_ID_NV = $8C7B; - GL_PRIMITIVE_ID_NV = $8C7C; - GL_GENERIC_ATTRIB_NV = $8C7D; - GL_LAYER_NV = $8DAA; - GL_NEXT_BUFFER_NV = -2; - GL_SKIP_COMPONENTS4_NV = -3; - GL_SKIP_COMPONENTS3_NV = -4; - GL_SKIP_COMPONENTS2_NV = -5; - GL_SKIP_COMPONENTS1_NV = -6; - - // GL_NV_conditional_render - GL_QUERY_WAIT_NV = $8E13; - GL_QUERY_NO_WAIT_NV = $8E14; - GL_QUERY_BY_REGION_WAIT_NV = $8E15; - GL_QUERY_BY_REGION_NO_WAIT_NV = $8E16; - - // GL_NV_present_video - GL_FRAME_NV = $8E26; - GL_FIELDS_NV = $8E27; - GL_CURRENT_TIME_NV = $8E28; - GL_NUM_FILL_STREAMS_NV = $8E29; - GL_PRESENT_TIME_NV = $8E2A; - GL_PRESENT_DURATION_NV = $8E2B; - - // GL_NV_explicit_multisample - GL_SAMPLE_POSITION_NV = $8E50; - GL_SAMPLE_MASK_NV = $8E51; - GL_SAMPLE_MASK_VALUE_NV = $8E52; - GL_TEXTURE_BINDING_RENDERBUFFER_NV = $8E53; - GL_TEXTURE_RENDERBUFFER_DATA_STORE_BINDING_NV = $8E54; - GL_TEXTURE_RENDERBUFFER_NV = $8E55; - GL_SAMPLER_RENDERBUFFER_NV = $8E56; - GL_INT_SAMPLER_RENDERBUFFER_NV = $8E57; - GL_UNSIGNED_INT_SAMPLER_RENDERBUFFER_NV = $8E58; - GL_MAX_SAMPLE_MASK_WORDS_NV = $8E59; - - // GL_NV_transform_feedback2 - GL_TRANSFORM_FEEDBACK_NV = $8E22; - GL_TRANSFORM_FEEDBACK_BUFFER_PAUSED_NV = $8E23; - GL_TRANSFORM_FEEDBACK_BUFFER_ACTIVE_NV = $8E24; - GL_TRANSFORM_FEEDBACK_BINDING_NV = $8E25; - - // GL_NV_video_capture - GL_VIDEO_BUFFER_NV = $9020; - GL_VIDEO_BUFFER_BINDING_NV = $9021; - GL_FIELD_UPPER_NV = $9022; - GL_FIELD_LOWER_NV = $9023; - GL_NUM_VIDEO_CAPTURE_STREAMS_NV = $9024; - GL_NEXT_VIDEO_CAPTURE_BUFFER_STATUS_NV = $9025; - GL_VIDEO_CAPTURE_TO_422_SUPPORTED_NV = $9026; - GL_LAST_VIDEO_CAPTURE_STATUS_NV = $9027; - GL_VIDEO_BUFFER_PITCH_NV = $9028; - GL_VIDEO_COLOR_CONVERSION_MATRIX_NV = $9029; - GL_VIDEO_COLOR_CONVERSION_MAX_NV = $902A; - GL_VIDEO_COLOR_CONVERSION_MIN_NV = $902B; - GL_VIDEO_COLOR_CONVERSION_OFFSET_NV = $902C; - GL_VIDEO_BUFFER_INTERNAL_FORMAT_NV = $902D; - GL_PARTIAL_SUCCESS_NV = $902E; - GL_SUCCESS_NV = $902F; - GL_FAILURE_NV = $9030; - GL_YCBYCR8_422_NV = $9031; - GL_YCBAYCR8A_4224_NV = $9032; - GL_Z6Y10Z6CB10Z6Y10Z6CR10_422_NV = $9033; - GL_Z6Y10Z6CB10Z6A10Z6Y10Z6CR10Z6A10_4224_NV = $9034; - GL_Z4Y12Z4CB12Z4Y12Z4CR12_422_NV = $9035; - GL_Z4Y12Z4CB12Z4A12Z4Y12Z4CR12Z4A12_4224_NV = $9036; - GL_Z4Y12Z4CB12Z4CR12_444_NV = $9037; - GL_VIDEO_CAPTURE_FRAME_WIDTH_NV = $9038; - GL_VIDEO_CAPTURE_FRAME_HEIGHT_NV = $9039; - GL_VIDEO_CAPTURE_FIELD_UPPER_HEIGHT_NV = $903A; - GL_VIDEO_CAPTURE_FIELD_LOWER_HEIGHT_NV = $903B; - GL_VIDEO_CAPTURE_SURFACE_ORIGIN_NV = $903C; - - // GL_NV_shader_buffer_load - GL_BUFFER_GPU_ADDRESS_NV = $8F1D; - GL_GPU_ADDRESS_NV = $8F34; - GL_MAX_SHADER_BUFFER_ADDRESS_NV = $8F35; - - // GL_NV_vertex_buffer_unified_memory - GL_VERTEX_ATTRIB_ARRAY_UNIFIED_NV = $8F1E; - GL_ELEMENT_ARRAY_UNIFIED_NV = $8F1F; - GL_VERTEX_ATTRIB_ARRAY_ADDRESS_NV = $8F20; - GL_VERTEX_ARRAY_ADDRESS_NV = $8F21; - GL_NORMAL_ARRAY_ADDRESS_NV = $8F22; - GL_COLOR_ARRAY_ADDRESS_NV = $8F23; - GL_INDEX_ARRAY_ADDRESS_NV = $8F24; - GL_TEXTURE_COORD_ARRAY_ADDRESS_NV = $8F25; - GL_EDGE_FLAG_ARRAY_ADDRESS_NV = $8F26; - GL_SECONDARY_COLOR_ARRAY_ADDRESS_NV = $8F27; - GL_FOG_COORD_ARRAY_ADDRESS_NV = $8F28; - GL_ELEMENT_ARRAY_ADDRESS_NV = $8F29; - GL_VERTEX_ATTRIB_ARRAY_LENGTH_NV = $8F2A; - GL_VERTEX_ARRAY_LENGTH_NV = $8F2B; - GL_NORMAL_ARRAY_LENGTH_NV = $8F2C; - GL_COLOR_ARRAY_LENGTH_NV = $8F2D; - GL_INDEX_ARRAY_LENGTH_NV = $8F2E; - GL_TEXTURE_COORD_ARRAY_LENGTH_NV = $8F2F; - GL_EDGE_FLAG_ARRAY_LENGTH_NV = $8F30; - GL_SECONDARY_COLOR_ARRAY_LENGTH_NV = $8F31; - GL_FOG_COORD_ARRAY_LENGTH_NV = $8F32; - GL_ELEMENT_ARRAY_LENGTH_NV = $8F33; - GL_DRAW_INDIRECT_UNIFIED_NV = $8F40; - GL_DRAW_INDIRECT_ADDRESS_NV = $8F41; - GL_DRAW_INDIRECT_LENGTH_NV = $8F42; - - // GL_NV_gpu_program5 - GL_MAX_GEOMETRY_PROGRAM_INVOCATIONS_NV = $8E5A; - GL_MIN_FRAGMENT_INTERPOLATION_OFFSET_NV = $8E5B; - GL_MAX_FRAGMENT_INTERPOLATION_OFFSET_NV = $8E5C; - GL_FRAGMENT_PROGRAM_INTERPOLATION_OFFSET_BITS_NV = $8E5D; - GL_MIN_PROGRAM_TEXTURE_GATHER_OFFSET_NV = $8E5E; - GL_MAX_PROGRAM_TEXTURE_GATHER_OFFSET_NV = $8E5F; - GL_MAX_PROGRAM_SUBROUTINE_PARAMETERS_NV = $8F44; - GL_MAX_PROGRAM_SUBROUTINE_NUM_NV = $8F45; - - // GL_NV_gpu_shader5 - GL_INT64_NV = $140E; - GL_UNSIGNED_INT64_NV = $140F; - GL_INT8_NV = $8FE0; - GL_INT8_VEC2_NV = $8FE1; - GL_INT8_VEC3_NV = $8FE2; - GL_INT8_VEC4_NV = $8FE3; - GL_INT16_NV = $8FE4; - GL_INT16_VEC2_NV = $8FE5; - GL_INT16_VEC3_NV = $8FE6; - GL_INT16_VEC4_NV = $8FE7; - GL_INT64_VEC2_NV = $8FE9; - GL_INT64_VEC3_NV = $8FEA; - GL_INT64_VEC4_NV = $8FEB; - GL_UNSIGNED_INT8_NV = $8FEC; - GL_UNSIGNED_INT8_VEC2_NV = $8FED; - GL_UNSIGNED_INT8_VEC3_NV = $8FEE; - GL_UNSIGNED_INT8_VEC4_NV = $8FEF; - GL_UNSIGNED_INT16_NV = $8FF0; - GL_UNSIGNED_INT16_VEC2_NV = $8FF1; - GL_UNSIGNED_INT16_VEC3_NV = $8FF2; - GL_UNSIGNED_INT16_VEC4_NV = $8FF3; - GL_UNSIGNED_INT64_VEC2_NV = $8FF5; - GL_UNSIGNED_INT64_VEC3_NV = $8FF6; - GL_UNSIGNED_INT64_VEC4_NV = $8FF7; - GL_FLOAT16_NV = $8FF8; - GL_FLOAT16_VEC2_NV = $8FF9; - GL_FLOAT16_VEC3_NV = $8FFA; - GL_FLOAT16_VEC4_NV = $8FFB; - { reuse GL_PATCHES } - - // GL_NV_shader_buffer_store - GL_SHADER_GLOBAL_ACCESS_BARRIER_BIT_NV = $00000010; - { reuse GL_READ_WRITE } - { reuse GL_WRITE_ONLY } - - // GL_NV_tessellation_program5 - GL_MAX_PROGRAM_PATCH_ATTRIBS_NV = $86D8; - GL_TESS_CONTROL_PROGRAM_NV = $891E; - GL_TESS_EVALUATION_PROGRAM_NV = $891F; - GL_TESS_CONTROL_PROGRAM_PARAMETER_BUFFER_NV = $8C74; - GL_TESS_EVALUATION_PROGRAM_PARAMETER_BUFFER_NV = $8C75; - - // GL_NV_vertex_attrib_integer_64bit - { reuse GL_INT64_NV } - { reuse GL_UNSIGNED_INT64_NV } - - // GL_NV_multisample_coverage - GL_COVERAGE_SAMPLES_NV = $80A9; - GL_COLOR_SAMPLES_NV = $8E20; - - // GL_NV_vdpau_interop - GL_SURFACE_STATE_NV = $86EB; - GL_SURFACE_REGISTERED_NV = $86FD; - GL_SURFACE_MAPPED_NV = $8700; - GL_WRITE_DISCARD_NV = $88BE; - - // GL_OML_interlace - GL_INTERLACE_OML = $8980; - GL_INTERLACE_READ_OML = $8981; - - // GL_OML_resample - GL_PACK_RESAMPLE_OML = $8984; - GL_UNPACK_RESAMPLE_OML = $8985; - GL_RESAMPLE_REPLICATE_OML = $8986; - GL_RESAMPLE_ZERO_FILL_OML = $8987; - GL_RESAMPLE_AVERAGE_OML = $8988; - GL_RESAMPLE_DECIMATE_OML = $8989; - - // GL_OML_subsample - GL_FORMAT_SUBSAMPLE_24_24_OML = $8982; - GL_FORMAT_SUBSAMPLE_244_244_OML = $8983; - - // GL_PGI_misc_hints - GL_PREFER_DOUBLEBUFFER_HINT_PGI = $1A1F8; - GL_CONSERVE_MEMORY_HINT_PGI = $1A1FD; - GL_RECLAIM_MEMORY_HINT_PGI = $1A1FE; - GL_NATIVE_GRAPHICS_HANDLE_PGI = $1A202; - GL_NATIVE_GRAPHICS_BEGIN_HINT_PGI = $1A203; - GL_NATIVE_GRAPHICS_END_HINT_PGI = $1A204; - GL_ALWAYS_FAST_HINT_PGI = $1A20C; - GL_ALWAYS_SOFT_HINT_PGI = $1A20D; - GL_ALLOW_DRAW_OBJ_HINT_PGI = $1A20E; - GL_ALLOW_DRAW_WIN_HINT_PGI = $1A20F; - GL_ALLOW_DRAW_FRG_HINT_PGI = $1A210; - GL_ALLOW_DRAW_MEM_HINT_PGI = $1A211; - GL_STRICT_DEPTHFUNC_HINT_PGI = $1A216; - GL_STRICT_LIGHTING_HINT_PGI = $1A217; - GL_STRICT_SCISSOR_HINT_PGI = $1A218; - GL_FULL_STIPPLE_HINT_PGI = $1A219; - GL_CLIP_NEAR_HINT_PGI = $1A220; - GL_CLIP_FAR_HINT_PGI = $1A221; - GL_WIDE_LINE_HINT_PGI = $1A222; - GL_BACK_NORMALS_HINT_PGI = $1A223; - - // GL_PGI_vertex_hints - GL_VERTEX_DATA_HINT_PGI = $1A22A; - GL_VERTEX_CONSISTENT_HINT_PGI = $1A22B; - GL_MATERIAL_SIDE_HINT_PGI = $1A22C; - GL_MAX_VERTEX_HINT_PGI = $1A22D; - GL_COLOR3_BIT_PGI = $00010000; - GL_COLOR4_BIT_PGI = $00020000; - GL_EDGEFLAG_BIT_PGI = $00040000; - GL_INDEX_BIT_PGI = $00080000; - GL_MAT_AMBIENT_BIT_PGI = $00100000; - GL_MAT_AMBIENT_AND_DIFFUSE_BIT_PGI = $00200000; - GL_MAT_DIFFUSE_BIT_PGI = $00400000; - GL_MAT_EMISSION_BIT_PGI = $00800000; - GL_MAT_COLOR_INDEXES_BIT_PGI = $01000000; - GL_MAT_SHININESS_BIT_PGI = $02000000; - GL_MAT_SPECULAR_BIT_PGI = $04000000; - GL_NORMAL_BIT_PGI = $08000000; - GL_TEXCOORD1_BIT_PGI = $10000000; - GL_TEXCOORD2_BIT_PGI = $20000000; - GL_TEXCOORD3_BIT_PGI = $40000000; - GL_TEXCOORD4_BIT_PGI = $80000000; - GL_VERTEX23_BIT_PGI = $00000004; - GL_VERTEX4_BIT_PGI = $00000008; - - // GL_REND_screen_coordinates - GL_SCREEN_COORDINATES_REND = $8490; - GL_INVERTED_SCREEN_W_REND = $8491; - - // GL_S3_s3tc - GL_RGB_S3TC = $83A0; - GL_RGB4_S3TC = $83A1; - GL_RGBA_S3TC = $83A2; - GL_RGBA4_S3TC = $83A3; - - // GL_SGIS_detail_texture - GL_DETAIL_TEXTURE_2D_SGIS = $8095; - GL_DETAIL_TEXTURE_2D_BINDING_SGIS = $8096; - GL_LINEAR_DETAIL_SGIS = $8097; - GL_LINEAR_DETAIL_ALPHA_SGIS = $8098; - GL_LINEAR_DETAIL_COLOR_SGIS = $8099; - GL_DETAIL_TEXTURE_LEVEL_SGIS = $809A; - GL_DETAIL_TEXTURE_MODE_SGIS = $809B; - GL_DETAIL_TEXTURE_FUNC_POINTS_SGIS = $809C; - - // GL_SGIS_fog_function - GL_FOG_FUNC_SGIS = $812A; - GL_FOG_FUNC_POINTS_SGIS = $812B; - GL_MAX_FOG_FUNC_POINTS_SGIS = $812C; - - // GL_SGIS_generate_mipmap - GL_GENERATE_MIPMAP_SGIS = $8191; - GL_GENERATE_MIPMAP_HINT_SGIS = $8192; - - // GL_SGIS_multisample - GL_MULTISAMPLE_SGIS = $809D; - GL_SAMPLE_ALPHA_TO_MASK_SGIS = $809E; - GL_SAMPLE_ALPHA_TO_ONE_SGIS = $809F; - GL_SAMPLE_MASK_SGIS = $80A0; - GL_1PASS_SGIS = $80A1; - GL_2PASS_0_SGIS = $80A2; - GL_2PASS_1_SGIS = $80A3; - GL_4PASS_0_SGIS = $80A4; - GL_4PASS_1_SGIS = $80A5; - GL_4PASS_2_SGIS = $80A6; - GL_4PASS_3_SGIS = $80A7; - GL_SAMPLE_BUFFERS_SGIS = $80A8; - GL_SAMPLES_SGIS = $80A9; - GL_SAMPLE_MASK_VALUE_SGIS = $80AA; - GL_SAMPLE_MASK_INVERT_SGIS = $80AB; - GL_SAMPLE_PATTERN_SGIS = $80AC; - - // GL_SGIS_pixel_texture - GL_PIXEL_TEXTURE_SGIS = $8353; - GL_PIXEL_FRAGMENT_RGB_SOURCE_SGIS = $8354; - GL_PIXEL_FRAGMENT_ALPHA_SOURCE_SGIS = $8355; - GL_PIXEL_GROUP_COLOR_SGIS = $8356; - - // GL_SGIS_point_line_texgen - GL_EYE_DISTANCE_TO_POINT_SGIS = $81F0; - GL_OBJECT_DISTANCE_TO_POINT_SGIS = $81F1; - GL_EYE_DISTANCE_TO_LINE_SGIS = $81F2; - GL_OBJECT_DISTANCE_TO_LINE_SGIS = $81F3; - GL_EYE_POINT_SGIS = $81F4; - GL_OBJECT_POINT_SGIS = $81F5; - GL_EYE_LINE_SGIS = $81F6; - GL_OBJECT_LINE_SGIS = $81F7; - - // GL_SGIS_point_parameters - GL_POINT_SIZE_MIN_SGIS = $8126; - GL_POINT_SIZE_MAX_SGIS = $8127; - GL_POINT_FADE_THRESHOLD_SIZE_SGIS = $8128; - GL_DISTANCE_ATTENUATION_SGIS = $8129; - - // GL_SGIS_sharpen_texture - GL_LINEAR_SHARPEN_SGIS = $80AD; - GL_LINEAR_SHARPEN_ALPHA_SGIS = $80AE; - GL_LINEAR_SHARPEN_COLOR_SGIS = $80AF; - GL_SHARPEN_TEXTURE_FUNC_POINTS_SGIS = $80B0; - - // GL_SGIS_texture4D - GL_PACK_SKIP_VOLUMES_SGIS = $8130; - GL_PACK_IMAGE_DEPTH_SGIS = $8131; - GL_UNPACK_SKIP_VOLUMES_SGIS = $8132; - GL_UNPACK_IMAGE_DEPTH_SGIS = $8133; - GL_TEXTURE_4D_SGIS = $8134; - GL_PROXY_TEXTURE_4D_SGIS = $8135; - GL_TEXTURE_4DSIZE_SGIS = $8136; - GL_TEXTURE_WRAP_Q_SGIS = $8137; - GL_MAX_4D_TEXTURE_SIZE_SGIS = $8138; - GL_TEXTURE_4D_BINDING_SGIS = $814F; - - // GL_SGIS_texture_color_mask - GL_TEXTURE_COLOR_WRITEMASK_SGIS = $81EF; - - // GL_SGIS_texture_edge_clamp - GL_CLAMP_TO_EDGE_SGIS = $812F; - - // GL_SGIS_texture_filter4 - GL_FILTER4_SGIS = $8146; - GL_TEXTURE_FILTER4_SIZE_SGIS = $8147; - - // GL_SGIS_texture_lod - GL_TEXTURE_MIN_LOD_SGIS = $813A; - GL_TEXTURE_MAX_LOD_SGIS = $813B; - GL_TEXTURE_BASE_LEVEL_SGIS = $813C; - GL_TEXTURE_MAX_LEVEL_SGIS = $813D; - - // GL_SGIS_texture_select - GL_DUAL_ALPHA4_SGIS = $8110; - GL_DUAL_ALPHA8_SGIS = $8111; - GL_DUAL_ALPHA12_SGIS = $8112; - GL_DUAL_ALPHA16_SGIS = $8113; - GL_DUAL_LUMINANCE4_SGIS = $8114; - GL_DUAL_LUMINANCE8_SGIS = $8115; - GL_DUAL_LUMINANCE12_SGIS = $8116; - GL_DUAL_LUMINANCE16_SGIS = $8117; - GL_DUAL_INTENSITY4_SGIS = $8118; - GL_DUAL_INTENSITY8_SGIS = $8119; - GL_DUAL_INTENSITY12_SGIS = $811A; - GL_DUAL_INTENSITY16_SGIS = $811B; - GL_DUAL_LUMINANCE_ALPHA4_SGIS = $811C; - GL_DUAL_LUMINANCE_ALPHA8_SGIS = $811D; - GL_QUAD_ALPHA4_SGIS = $811E; - GL_QUAD_ALPHA8_SGIS = $811F; - GL_QUAD_LUMINANCE4_SGIS = $8120; - GL_QUAD_LUMINANCE8_SGIS = $8121; - GL_QUAD_INTENSITY4_SGIS = $8122; - GL_QUAD_INTENSITY8_SGIS = $8123; - GL_DUAL_TEXTURE_SELECT_SGIS = $8124; - GL_QUAD_TEXTURE_SELECT_SGIS = $8125; - - // GL_SGIX_async - GL_ASYNC_MARKER_SGIX = $8329; - - // GL_SGIX_async_histogram - GL_ASYNC_HISTOGRAM_SGIX = $832C; - GL_MAX_ASYNC_HISTOGRAM_SGIX = $832D; - - // GL_SGIX_async_pixel - GL_ASYNC_TEX_IMAGE_SGIX = $835C; - GL_ASYNC_DRAW_PIXELS_SGIX = $835D; - GL_ASYNC_READ_PIXELS_SGIX = $835E; - GL_MAX_ASYNC_TEX_IMAGE_SGIX = $835F; - GL_MAX_ASYNC_DRAW_PIXELS_SGIX = $8360; - GL_MAX_ASYNC_READ_PIXELS_SGIX = $8361; - - // GL_SGIX_blend_alpha_minmax - GL_ALPHA_MIN_SGIX = $8320; - GL_ALPHA_MAX_SGIX = $8321; - - // GL_SGIX_calligraphic_fragment - GL_CALLIGRAPHIC_FRAGMENT_SGIX = $8183; - - // GL_SGIX_clipmap - GL_LINEAR_CLIPMAP_LINEAR_SGIX = $8170; - GL_TEXTURE_CLIPMAP_CENTER_SGIX = $8171; - GL_TEXTURE_CLIPMAP_FRAME_SGIX = $8172; - GL_TEXTURE_CLIPMAP_OFFSET_SGIX = $8173; - GL_TEXTURE_CLIPMAP_VIRTUAL_DEPTH_SGIX = $8174; - GL_TEXTURE_CLIPMAP_LOD_OFFSET_SGIX = $8175; - GL_TEXTURE_CLIPMAP_DEPTH_SGIX = $8176; - GL_MAX_CLIPMAP_DEPTH_SGIX = $8177; - GL_MAX_CLIPMAP_VIRTUAL_DEPTH_SGIX = $8178; - GL_NEAREST_CLIPMAP_NEAREST_SGIX = $844D; - GL_NEAREST_CLIPMAP_LINEAR_SGIX = $844E; - GL_LINEAR_CLIPMAP_NEAREST_SGIX = $844F; - - // GL_SGIX_convolution_accuracy - GL_CONVOLUTION_HINT_SGIX = $8316; - - // GL_SGIX_depth_texture - GL_DEPTH_COMPONENT16_SGIX = $81A5; - GL_DEPTH_COMPONENT24_SGIX = $81A6; - GL_DEPTH_COMPONENT32_SGIX = $81A7; - - // GL_SGIX_fog_offset - GL_FOG_OFFSET_SGIX = $8198; - GL_FOG_OFFSET_VALUE_SGIX = $8199; - - // GL_SGIX_fog_scale - GL_FOG_SCALE_SGIX = $81FC; - GL_FOG_SCALE_VALUE_SGIX = $81FD; - - // GL_SGIX_fragment_lighting - GL_FRAGMENT_LIGHTING_SGIX = $8400; - GL_FRAGMENT_COLOR_MATERIAL_SGIX = $8401; - GL_FRAGMENT_COLOR_MATERIAL_FACE_SGIX = $8402; - GL_FRAGMENT_COLOR_MATERIAL_PARAMETER_SGIX = $8403; - GL_MAX_FRAGMENT_LIGHTS_SGIX = $8404; - GL_MAX_ACTIVE_LIGHTS_SGIX = $8405; - GL_CURRENT_RASTER_NORMAL_SGIX = $8406; - GL_LIGHT_ENV_MODE_SGIX = $8407; - GL_FRAGMENT_LIGHT_MODEL_LOCAL_VIEWER_SGIX = $8408; - GL_FRAGMENT_LIGHT_MODEL_TWO_SIDE_SGIX = $8409; - GL_FRAGMENT_LIGHT_MODEL_AMBIENT_SGIX = $840A; - GL_FRAGMENT_LIGHT_MODEL_NORMAL_INTERPOLATION_SGIX = $840B; - GL_FRAGMENT_LIGHT0_SGIX = $840C; - GL_FRAGMENT_LIGHT1_SGIX = $840D; - GL_FRAGMENT_LIGHT2_SGIX = $840E; - GL_FRAGMENT_LIGHT3_SGIX = $840F; - GL_FRAGMENT_LIGHT4_SGIX = $8410; - GL_FRAGMENT_LIGHT5_SGIX = $8411; - GL_FRAGMENT_LIGHT6_SGIX = $8412; - GL_FRAGMENT_LIGHT7_SGIX = $8413; - - // GL_SGIX_framezoom - GL_FRAMEZOOM_SGIX = $818B; - GL_FRAMEZOOM_FACTOR_SGIX = $818C; - GL_MAX_FRAMEZOOM_FACTOR_SGIX = $818D; - - // GL_SGIX_impact_pixel_texture - GL_PIXEL_TEX_GEN_Q_CEILING_SGIX = $8184; - GL_PIXEL_TEX_GEN_Q_ROUND_SGIX = $8185; - GL_PIXEL_TEX_GEN_Q_FLOOR_SGIX = $8186; - GL_PIXEL_TEX_GEN_ALPHA_REPLACE_SGIX = $8187; - GL_PIXEL_TEX_GEN_ALPHA_NO_REPLACE_SGIX = $8188; - GL_PIXEL_TEX_GEN_ALPHA_LS_SGIX = $8189; - GL_PIXEL_TEX_GEN_ALPHA_MS_SGIX = $818A; - - // GL_SGIX_instruments - GL_INSTRUMENT_BUFFER_POINTER_SGIX = $8180; - GL_INSTRUMENT_MEASUREMENTS_SGIX = $8181; - - // GL_SGIX_interlace - GL_INTERLACE_SGIX = $8094; - - // GL_SGIX_ir_instrument1 - GL_IR_INSTRUMENT1_SGIX = $817F; - - // GL_SGIX_list_priority - GL_LIST_PRIORITY_SGIX = $8182; - - // GL_SGIX_pixel_texture - GL_PIXEL_TEX_GEN_SGIX = $8139; - GL_PIXEL_TEX_GEN_MODE_SGIX = $832B; - - // GL_SGIX_pixel_tiles - GL_PIXEL_TILE_BEST_ALIGNMENT_SGIX = $813E; - GL_PIXEL_TILE_CACHE_INCREMENT_SGIX = $813F; - GL_PIXEL_TILE_WIDTH_SGIX = $8140; - GL_PIXEL_TILE_HEIGHT_SGIX = $8141; - GL_PIXEL_TILE_GRID_WIDTH_SGIX = $8142; - GL_PIXEL_TILE_GRID_HEIGHT_SGIX = $8143; - GL_PIXEL_TILE_GRID_DEPTH_SGIX = $8144; - GL_PIXEL_TILE_CACHE_SIZE_SGIX = $8145; - - // GL_SGIX_polynomial_ffd - GL_GEOMETRY_DEFORMATION_SGIX = $8194; - GL_TEXTURE_DEFORMATION_SGIX = $8195; - GL_DEFORMATIONS_MASK_SGIX = $8196; - GL_MAX_DEFORMATION_ORDER_SGIX = $8197; - - // GL_SGIX_reference_plane - GL_REFERENCE_PLANE_SGIX = $817D; - GL_REFERENCE_PLANE_EQUATION_SGIX = $817E; - - // GL_SGIX_resample - GL_PACK_RESAMPLE_SGIX = $842C; - GL_UNPACK_RESAMPLE_SGIX = $842D; - GL_RESAMPLE_REPLICATE_SGIX = $842E; - GL_RESAMPLE_ZERO_FILL_SGIX = $842F; - GL_RESAMPLE_DECIMATE_SGIX = $8430; - - // GL_SGIX_scalebias_hint - GL_SCALEBIAS_HINT_SGIX = $8322; - - // GL_SGIX_shadow - GL_TEXTURE_COMPARE_SGIX = $819A; - GL_TEXTURE_COMPARE_OPERATOR_SGIX = $819B; - GL_TEXTURE_LEQUAL_R_SGIX = $819C; - GL_TEXTURE_GEQUAL_R_SGIX = $819D; - - // GL_SGIX_shadow_ambient - GL_SHADOW_AMBIENT_SGIX = $80BF; - - // GL_SGIX_sprite - GL_SPRITE_SGIX = $8148; - GL_SPRITE_MODE_SGIX = $8149; - GL_SPRITE_AXIS_SGIX = $814A; - GL_SPRITE_TRANSLATION_SGIX = $814B; - GL_SPRITE_AXIAL_SGIX = $814C; - GL_SPRITE_OBJECT_ALIGNED_SGIX = $814D; - GL_SPRITE_EYE_ALIGNED_SGIX = $814E; - - // GL_SGIX_subsample - GL_PACK_SUBSAMPLE_RATE_SGIX = $85A0; - GL_UNPACK_SUBSAMPLE_RATE_SGIX = $85A1; - GL_PIXEL_SUBSAMPLE_4444_SGIX = $85A2; - GL_PIXEL_SUBSAMPLE_2424_SGIX = $85A3; - GL_PIXEL_SUBSAMPLE_4242_SGIX = $85A4; - - // GL_SGIX_texture_add_env - GL_TEXTURE_ENV_BIAS_SGIX = $80BE; - - // GL_SGIX_texture_coordinate_clamp - GL_TEXTURE_MAX_CLAMP_S_SGIX = $8369; - GL_TEXTURE_MAX_CLAMP_T_SGIX = $836A; - GL_TEXTURE_MAX_CLAMP_R_SGIX = $836B; - - // GL_SGIX_texture_lod_bias - GL_TEXTURE_LOD_BIAS_S_SGIX = $818E; - GL_TEXTURE_LOD_BIAS_T_SGIX = $818F; - GL_TEXTURE_LOD_BIAS_R_SGIX = $8190; - - // GL_SGIX_texture_multi_buffer - GL_TEXTURE_MULTI_BUFFER_HINT_SGIX = $812E; - - // GL_SGIX_texture_scale_bias - GL_POST_TEXTURE_FILTER_BIAS_SGIX = $8179; - GL_POST_TEXTURE_FILTER_SCALE_SGIX = $817A; - GL_POST_TEXTURE_FILTER_BIAS_RANGE_SGIX = $817B; - GL_POST_TEXTURE_FILTER_SCALE_RANGE_SGIX = $817C; - - // GL_SGIX_vertex_preclip - GL_VERTEX_PRECLIP_SGIX = $83EE; - GL_VERTEX_PRECLIP_HINT_SGIX = $83EF; - - // GL_SGIX_ycrcb - GL_YCRCB_422_SGIX = $81BB; - GL_YCRCB_444_SGIX = $81BC; - - // GL_SGIX_ycrcba - GL_YCRCB_SGIX = $8318; - GL_YCRCBA_SGIX = $8319; - - // GL_SGI_color_matrix - GL_COLOR_MATRIX_SGI = $80B1; - GL_COLOR_MATRIX_STACK_DEPTH_SGI = $80B2; - GL_MAX_COLOR_MATRIX_STACK_DEPTH_SGI = $80B3; - GL_POST_COLOR_MATRIX_RED_SCALE_SGI = $80B4; - GL_POST_COLOR_MATRIX_GREEN_SCALE_SGI = $80B5; - GL_POST_COLOR_MATRIX_BLUE_SCALE_SGI = $80B6; - GL_POST_COLOR_MATRIX_ALPHA_SCALE_SGI = $80B7; - GL_POST_COLOR_MATRIX_RED_BIAS_SGI = $80B8; - GL_POST_COLOR_MATRIX_GREEN_BIAS_SGI = $80B9; - GL_POST_COLOR_MATRIX_BLUE_BIAS_SGI = $80BA; - GL_POST_COLOR_MATRIX_ALPHA_BIAS_SGI = $80BB; - - // GL_SGI_color_table - GL_COLOR_TABLE_SGI = $80D0; - GL_POST_CONVOLUTION_COLOR_TABLE_SGI = $80D1; - GL_POST_COLOR_MATRIX_COLOR_TABLE_SGI = $80D2; - GL_PROXY_COLOR_TABLE_SGI = $80D3; - GL_PROXY_POST_CONVOLUTION_COLOR_TABLE_SGI = $80D4; - GL_PROXY_POST_COLOR_MATRIX_COLOR_TABLE_SGI = $80D5; - GL_COLOR_TABLE_SCALE_SGI = $80D6; - GL_COLOR_TABLE_BIAS_SGI = $80D7; - GL_COLOR_TABLE_FORMAT_SGI = $80D8; - GL_COLOR_TABLE_WIDTH_SGI = $80D9; - GL_COLOR_TABLE_RED_SIZE_SGI = $80DA; - GL_COLOR_TABLE_GREEN_SIZE_SGI = $80DB; - GL_COLOR_TABLE_BLUE_SIZE_SGI = $80DC; - GL_COLOR_TABLE_ALPHA_SIZE_SGI = $80DD; - GL_COLOR_TABLE_LUMINANCE_SIZE_SGI = $80DE; - GL_COLOR_TABLE_INTENSITY_SIZE_SGI = $80DF; - - // GL_SGI_depth_pass_instrument - GL_DEPTH_PASS_INSTRUMENT_SGIX = $8310; - GL_DEPTH_PASS_INSTRUMENT_COUNTERS_SGIX = $8311; - GL_DEPTH_PASS_INSTRUMENT_MAX_SGIX = $8312; - - // GL_SGI_texture_color_table - GL_TEXTURE_COLOR_TABLE_SGI = $80BC; - GL_PROXY_TEXTURE_COLOR_TABLE_SGI = $80BD; - - // GL_SUNX_constant_data - GL_UNPACK_CONSTANT_DATA_SUNX = $81D5; - GL_TEXTURE_CONSTANT_DATA_SUNX = $81D6; - - // GL_SUN_convolution_border_modes - GL_WRAP_BORDER_SUN = $81D4; - - // GL_SUN_global_alpha - GL_GLOBAL_ALPHA_SUN = $81D9; - GL_GLOBAL_ALPHA_FACTOR_SUN = $81DA; - - // GL_SUN_mesh_array - GL_QUAD_MESH_SUN = $8614; - GL_TRIANGLE_MESH_SUN = $8615; - - // GL_SUN_slice_accum - GL_SLICE_ACCUM_SUN = $85CC; - - // GL_SUN_triangle_list - GL_RESTART_SUN = $0001; - GL_REPLACE_MIDDLE_SUN = $0002; - GL_REPLACE_OLDEST_SUN = $0003; - GL_TRIANGLE_LIST_SUN = $81D7; - GL_REPLACEMENT_CODE_SUN = $81D8; - GL_REPLACEMENT_CODE_ARRAY_SUN = $85C0; - GL_REPLACEMENT_CODE_ARRAY_TYPE_SUN = $85C1; - GL_REPLACEMENT_CODE_ARRAY_STRIDE_SUN = $85C2; - GL_REPLACEMENT_CODE_ARRAY_POINTER_SUN = $85C3; - GL_R1UI_V3F_SUN = $85C4; - GL_R1UI_C4UB_V3F_SUN = $85C5; - GL_R1UI_C3F_V3F_SUN = $85C6; - GL_R1UI_N3F_V3F_SUN = $85C7; - GL_R1UI_C4F_N3F_V3F_SUN = $85C8; - GL_R1UI_T2F_V3F_SUN = $85C9; - GL_R1UI_T2F_N3F_V3F_SUN = $85CA; - GL_R1UI_T2F_C4F_N3F_V3F_SUN = $85CB; - - // GL_WIN_phong_shading - GL_PHONG_WIN = $80EA; - GL_PHONG_HINT_WIN = $80EB; - - // GL_WIN_specular_fog - GL_FOG_SPECULAR_TEXTURE_WIN = $80EC; - - // GL_ARB_vertex_shader - GL_VERTEX_SHADER_ARB = $8B31; - GL_MAX_VERTEX_UNIFORM_COMPONENTS_ARB = $8B4A; - GL_MAX_VARYING_FLOATS_ARB = $8B4B; - GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS_ARB = $8B4C; - GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS_ARB = $8B4D; - GL_OBJECT_ACTIVE_ATTRIBUTES_ARB = $8B89; - GL_OBJECT_ACTIVE_ATTRIBUTE_MAX_LENGTH_ARB = $8B8A; - - // GL_ARB_fragment_shader - GL_FRAGMENT_SHADER_ARB = $8B30; - GL_MAX_FRAGMENT_UNIFORM_COMPONENTS_ARB = $8B49; // 1.4 - GL_FRAGMENT_SHADER_DERIVATIVE_HINT_ARB = $8B8B; // 1.4 - - // GL_ARB_occlusion_query - GL_SAMPLES_PASSED_ARB = $8914; - GL_QUERY_COUNTER_BITS_ARB = $8864; - GL_CURRENT_QUERY_ARB = $8865; - GL_QUERY_RESULT_ARB = $8866; - GL_QUERY_RESULT_AVAILABLE_ARB = $8867; - - // GL_ARB_point_sprite - GL_POINT_SPRITE_ARB = $8861; - GL_COORD_REPLACE_ARB = $8862; - - // GL_ARB_shading_language_100 - GL_SHADING_LANGUAGE_VERSION_ARB = $8B8C; // 1.4 - - // GL_ARB_shader_objects - GL_PROGRAM_OBJECT_ARB = $8B40; - - GL_OBJECT_TYPE_ARB = $8B4E; - GL_OBJECT_SUBTYPE_ARB = $8B4F; - GL_OBJECT_DELETE_STATUS_ARB = $8B80; - GL_OBJECT_COMPILE_STATUS_ARB = $8B81; - GL_OBJECT_LINK_STATUS_ARB = $8B82; - GL_OBJECT_VALIDATE_STATUS_ARB = $8B83; - GL_OBJECT_INFO_LOG_LENGTH_ARB = $8B84; - GL_OBJECT_ATTACHED_OBJECTS_ARB = $8B85; - GL_OBJECT_ACTIVE_UNIFORMS_ARB = $8B86; - GL_OBJECT_ACTIVE_UNIFORM_MAX_LENGTH_ARB = $8B87; - GL_OBJECT_SHADER_SOURCE_LENGTH_ARB = $8B88; - - GL_SHADER_OBJECT_ARB = $8B48; - - GL_FLOAT_VEC2_ARB = $8B50; - GL_FLOAT_VEC3_ARB = $8B51; - GL_FLOAT_VEC4_ARB = $8B52; - GL_INT_VEC2_ARB = $8B53; - GL_INT_VEC3_ARB = $8B54; - GL_INT_VEC4_ARB = $8B55; - GL_BOOL_ARB = $8B56; - GL_BOOL_VEC2_ARB = $8B57; - GL_BOOL_VEC3_ARB = $8B58; - GL_BOOL_VEC4_ARB = $8B59; - GL_FLOAT_MAT2_ARB = $8B5A; - GL_FLOAT_MAT3_ARB = $8B5B; - GL_FLOAT_MAT4_ARB = $8B5C; - GL_SAMPLER_1D_ARB = $8B5D; - GL_SAMPLER_2D_ARB = $8B5E; - GL_SAMPLER_3D_ARB = $8B5F; - GL_SAMPLER_CUBE_ARB = $8B60; - GL_SAMPLER_1D_SHADOW_ARB = $8B61; - GL_SAMPLER_2D_SHADOW_ARB = $8B62; - GL_SAMPLER_2D_RECT_ARB = $8B63; - GL_SAMPLER_2D_RECT_SHADOW_ARB = $8B64; - - // WGL_3DFX_multisample - WGL_SAMPLE_BUFFERS_3DFX = $2060; - WGL_SAMPLES_3DFX = $2061; - - // WGL_ARB_buffer_region - WGL_FRONT_COLOR_BUFFER_BIT_ARB = $00000001; - WGL_BACK_COLOR_BUFFER_BIT_ARB = $00000002; - WGL_DEPTH_BUFFER_BIT_ARB = $00000004; - WGL_STENCIL_BUFFER_BIT_ARB = $00000008; - - // WGL_ARB_make_current_read - ERROR_INVALID_PIXEL_TYPE_ARB = $2043; - ERROR_INCOMPATIBLE_DEVICE_CONTEXTS_ARB = $2054; - - // WGL_ARB_multisample - WGL_SAMPLE_BUFFERS_ARB = $2041; - WGL_SAMPLES_ARB = $2042; - - // WGL_ARB_pbuffer - WGL_DRAW_TO_PBUFFER_ARB = $202D; - WGL_MAX_PBUFFER_PIXELS_ARB = $202E; - WGL_MAX_PBUFFER_WIDTH_ARB = $202F; - WGL_MAX_PBUFFER_HEIGHT_ARB = $2030; - WGL_PBUFFER_LARGEST_ARB = $2033; - WGL_PBUFFER_WIDTH_ARB = $2034; - WGL_PBUFFER_HEIGHT_ARB = $2035; - WGL_PBUFFER_LOST_ARB = $2036; - - // WGL_ARB_pixel_format - WGL_NUMBER_PIXEL_FORMATS_ARB = $2000; - WGL_DRAW_TO_WINDOW_ARB = $2001; - WGL_DRAW_TO_BITMAP_ARB = $2002; - WGL_ACCELERATION_ARB = $2003; - WGL_NEED_PALETTE_ARB = $2004; - WGL_NEED_SYSTEM_PALETTE_ARB = $2005; - WGL_SWAP_LAYER_BUFFERS_ARB = $2006; - WGL_SWAP_METHOD_ARB = $2007; - WGL_NUMBER_OVERLAYS_ARB = $2008; - WGL_NUMBER_UNDERLAYS_ARB = $2009; - WGL_TRANSPARENT_ARB = $200A; - WGL_TRANSPARENT_RED_VALUE_ARB = $2037; - WGL_TRANSPARENT_GREEN_VALUE_ARB = $2038; - WGL_TRANSPARENT_BLUE_VALUE_ARB = $2039; - WGL_TRANSPARENT_ALPHA_VALUE_ARB = $203A; - WGL_TRANSPARENT_INDEX_VALUE_ARB = $203B; - WGL_SHARE_DEPTH_ARB = $200C; - WGL_SHARE_STENCIL_ARB = $200D; - WGL_SHARE_ACCUM_ARB = $200E; - WGL_SUPPORT_GDI_ARB = $200F; - WGL_SUPPORT_OPENGL_ARB = $2010; - WGL_DOUBLE_BUFFER_ARB = $2011; - WGL_STEREO_ARB = $2012; - WGL_PIXEL_TYPE_ARB = $2013; - WGL_COLOR_BITS_ARB = $2014; - WGL_RED_BITS_ARB = $2015; - WGL_RED_SHIFT_ARB = $2016; - WGL_GREEN_BITS_ARB = $2017; - WGL_GREEN_SHIFT_ARB = $2018; - WGL_BLUE_BITS_ARB = $2019; - WGL_BLUE_SHIFT_ARB = $201A; - WGL_ALPHA_BITS_ARB = $201B; - WGL_ALPHA_SHIFT_ARB = $201C; - WGL_ACCUM_BITS_ARB = $201D; - WGL_ACCUM_RED_BITS_ARB = $201E; - WGL_ACCUM_GREEN_BITS_ARB = $201F; - WGL_ACCUM_BLUE_BITS_ARB = $2020; - WGL_ACCUM_ALPHA_BITS_ARB = $2021; - WGL_DEPTH_BITS_ARB = $2022; - WGL_STENCIL_BITS_ARB = $2023; - WGL_AUX_BUFFERS_ARB = $2024; - WGL_NO_ACCELERATION_ARB = $2025; - WGL_GENERIC_ACCELERATION_ARB = $2026; - WGL_FULL_ACCELERATION_ARB = $2027; - WGL_SWAP_EXCHANGE_ARB = $2028; - WGL_SWAP_COPY_ARB = $2029; - WGL_SWAP_UNDEFINED_ARB = $202A; - WGL_TYPE_RGBA_ARB = $202B; - WGL_TYPE_COLORINDEX_ARB = $202C; - - // WGL_ARB_pixel_format_float - WGL_RGBA_FLOAT_MODE_ARB = $8820; - WGL_CLAMP_VERTEX_COLOR_ARB = $891A; - WGL_CLAMP_FRAGMENT_COLOR_ARB = $891B; - WGL_CLAMP_READ_COLOR_ARB = $891C; - WGL_FIXED_ONLY_ARB = $891D; - - // WGL_ARB_render_texture - WGL_BIND_TO_TEXTURE_RGB_ARB = $2070; - WGL_BIND_TO_TEXTURE_RGBA_ARB = $2071; - WGL_TEXTURE_FORMAT_ARB = $2072; - WGL_TEXTURE_TARGET_ARB = $2073; - WGL_MIPMAP_TEXTURE_ARB = $2074; - WGL_TEXTURE_RGB_ARB = $2075; - WGL_TEXTURE_RGBA_ARB = $2076; - WGL_NO_TEXTURE_ARB = $2077; - WGL_TEXTURE_CUBE_MAP_ARB = $2078; - WGL_TEXTURE_1D_ARB = $2079; - WGL_TEXTURE_2D_ARB = $207A; - WGL_MIPMAP_LEVEL_ARB = $207B; - WGL_CUBE_MAP_FACE_ARB = $207C; - WGL_TEXTURE_CUBE_MAP_POSITIVE_X_ARB = $207D; - WGL_TEXTURE_CUBE_MAP_NEGATIVE_X_ARB = $207E; - WGL_TEXTURE_CUBE_MAP_POSITIVE_Y_ARB = $207F; - WGL_TEXTURE_CUBE_MAP_NEGATIVE_Y_ARB = $2080; - WGL_TEXTURE_CUBE_MAP_POSITIVE_Z_ARB = $2081; - WGL_TEXTURE_CUBE_MAP_NEGATIVE_Z_ARB = $2082; - WGL_FRONT_LEFT_ARB = $2083; - WGL_FRONT_RIGHT_ARB = $2084; - WGL_BACK_LEFT_ARB = $2085; - WGL_BACK_RIGHT_ARB = $2086; - WGL_AUX0_ARB = $2087; - WGL_AUX1_ARB = $2088; - WGL_AUX2_ARB = $2089; - WGL_AUX3_ARB = $208A; - WGL_AUX4_ARB = $208B; - WGL_AUX5_ARB = $208C; - WGL_AUX6_ARB = $208D; - WGL_AUX7_ARB = $208E; - WGL_AUX8_ARB = $208F; - WGL_AUX9_ARB = $2090; - - // WGL_ARB_create_context - WGL_CONTEXT_DEBUG_BIT_ARB = $00000001; - WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB = $00000002; - WGL_CONTEXT_MAJOR_VERSION_ARB = $2091; - WGL_CONTEXT_MINOR_VERSION_ARB = $2092; - WGL_CONTEXT_LAYER_PLANE_ARB = $2093; - WGL_CONTEXT_FLAGS_ARB = $2094; - ERROR_INVALID_VERSION_ARB = $2095; - - // WGL_ARB_create_context_profile - WGL_CONTEXT_PROFILE_MASK_ARB = $9126; - WGL_CONTEXT_CORE_PROFILE_BIT_ARB = $00000001; - WGL_CONTEXT_COMPATIBILITY_PROFILE_BIT_ARB = $00000002; - ERROR_INVALID_PROFILE_ARB = $2096; - - // WGL_ARB_framebuffer_sRGB - WGL_FRAMEBUFFER_SRGB_CAPABLE_ARB = $20A9; - - // WGL_ARB_create_context_robustness - WGL_CONTEXT_ROBUST_ACCESS_BIT_ARB = $00000004; - WGL_LOSE_CONTEXT_ON_RESET_ARB = $8252; - WGL_CONTEXT_RESET_NOTIFICATION_STRATEGY_ARB = $8256; - WGL_NO_RESET_NOTIFICATION_ARB = $8261; - - // WGL_ATI_pixel_format_float - WGL_TYPE_RGBA_FLOAT_ATI = $21A0; - GL_TYPE_RGBA_FLOAT_ATI = $8820; - GL_COLOR_CLEAR_UNCLAMPED_VALUE_ATI = $8835; - - // WGL_AMD_gpu_association - WGL_GPU_VENDOR_AMD = $1F00; - WGL_GPU_RENDERER_STRING_AMD = $1F01; - WGL_GPU_OPENGL_VERSION_STRING_AMD = $1F02; - WGL_GPU_FASTEST_TARGET_GPUS_AMD = $21A2; - WGL_GPU_RAM_AMD = $21A3; - WGL_GPU_CLOCK_AMD = $21A4; - WGL_GPU_NUM_PIPES_AMD = $21A5; - WGL_GPU_NUM_SIMD_AMD = $21A6; - WGL_GPU_NUM_RB_AMD = $21A7; - WGL_GPU_NUM_SPI_AMD = $21A8; - - // WGL_EXT_depth_float - WGL_DEPTH_FLOAT_EXT = $2040; - - // WGL_EXT_make_current_read - ERROR_INVALID_PIXEL_TYPE_EXT = $2043; - - // WGL_EXT_multisample - WGL_SAMPLE_BUFFERS_EXT = $2041; - WGL_SAMPLES_EXT = $2042; - - // WGL_EXT_pbuffer - WGL_DRAW_TO_PBUFFER_EXT = $202D; - WGL_MAX_PBUFFER_PIXELS_EXT = $202E; - WGL_MAX_PBUFFER_WIDTH_EXT = $202F; - WGL_MAX_PBUFFER_HEIGHT_EXT = $2030; - WGL_OPTIMAL_PBUFFER_WIDTH_EXT = $2031; - WGL_OPTIMAL_PBUFFER_HEIGHT_EXT = $2032; - WGL_PBUFFER_LARGEST_EXT = $2033; - WGL_PBUFFER_WIDTH_EXT = $2034; - WGL_PBUFFER_HEIGHT_EXT = $2035; - - // WGL_EXT_pixel_format - WGL_NUMBER_PIXEL_FORMATS_EXT = $2000; - WGL_DRAW_TO_WINDOW_EXT = $2001; - WGL_DRAW_TO_BITMAP_EXT = $2002; - WGL_ACCELERATION_EXT = $2003; - WGL_NEED_PALETTE_EXT = $2004; - WGL_NEED_SYSTEM_PALETTE_EXT = $2005; - WGL_SWAP_LAYER_BUFFERS_EXT = $2006; - WGL_SWAP_METHOD_EXT = $2007; - WGL_NUMBER_OVERLAYS_EXT = $2008; - WGL_NUMBER_UNDERLAYS_EXT = $2009; - WGL_TRANSPARENT_EXT = $200A; - WGL_TRANSPARENT_VALUE_EXT = $200B; - WGL_SHARE_DEPTH_EXT = $200C; - WGL_SHARE_STENCIL_EXT = $200D; - WGL_SHARE_ACCUM_EXT = $200E; - WGL_SUPPORT_GDI_EXT = $200F; - WGL_SUPPORT_OPENGL_EXT = $2010; - WGL_DOUBLE_BUFFER_EXT = $2011; - WGL_STEREO_EXT = $2012; - WGL_PIXEL_TYPE_EXT = $2013; - WGL_COLOR_BITS_EXT = $2014; - WGL_RED_BITS_EXT = $2015; - WGL_RED_SHIFT_EXT = $2016; - WGL_GREEN_BITS_EXT = $2017; - WGL_GREEN_SHIFT_EXT = $2018; - WGL_BLUE_BITS_EXT = $2019; - WGL_BLUE_SHIFT_EXT = $201A; - WGL_ALPHA_BITS_EXT = $201B; - WGL_ALPHA_SHIFT_EXT = $201C; - WGL_ACCUM_BITS_EXT = $201D; - WGL_ACCUM_RED_BITS_EXT = $201E; - WGL_ACCUM_GREEN_BITS_EXT = $201F; - WGL_ACCUM_BLUE_BITS_EXT = $2020; - WGL_ACCUM_ALPHA_BITS_EXT = $2021; - WGL_DEPTH_BITS_EXT = $2022; - WGL_STENCIL_BITS_EXT = $2023; - WGL_AUX_BUFFERS_EXT = $2024; - WGL_NO_ACCELERATION_EXT = $2025; - WGL_GENERIC_ACCELERATION_EXT = $2026; - WGL_FULL_ACCELERATION_EXT = $2027; - WGL_SWAP_EXCHANGE_EXT = $2028; - WGL_SWAP_COPY_EXT = $2029; - WGL_SWAP_UNDEFINED_EXT = $202A; - WGL_TYPE_RGBA_EXT = $202B; - WGL_TYPE_COLORINDEX_EXT = $202C; - - // WGL_I3D_digital_video_control - WGL_DIGITAL_VIDEO_CURSOR_ALPHA_FRAMEBUFFER_I3D = $2050; - WGL_DIGITAL_VIDEO_CURSOR_ALPHA_VALUE_I3D = $2051; - WGL_DIGITAL_VIDEO_CURSOR_INCLUDED_I3D = $2052; - WGL_DIGITAL_VIDEO_GAMMA_CORRECTED_I3D = $2053; - - // WGL_I3D_gamma - WGL_GAMMA_TABLE_SIZE_I3D = $204E; - WGL_GAMMA_EXCLUDE_DESKTOP_I3D = $204F; - - // WGL_I3D_genlock - WGL_GENLOCK_SOURCE_MULTIVIEW_I3D = $2044; - WGL_GENLOCK_SOURCE_EXTENAL_SYNC_I3D = $2045; - WGL_GENLOCK_SOURCE_EXTENAL_FIELD_I3D = $2046; - WGL_GENLOCK_SOURCE_EXTENAL_TTL_I3D = $2047; - WGL_GENLOCK_SOURCE_DIGITAL_SYNC_I3D = $2048; - WGL_GENLOCK_SOURCE_DIGITAL_FIELD_I3D = $2049; - WGL_GENLOCK_SOURCE_EDGE_FALLING_I3D = $204A; - WGL_GENLOCK_SOURCE_EDGE_RISING_I3D = $204B; - WGL_GENLOCK_SOURCE_EDGE_BOTH_I3D = $204C; - - // WGL_I3D_image_buffer - WGL_IMAGE_BUFFER_MIN_ACCESS_I3D = $00000001; - WGL_IMAGE_BUFFER_LOCK_I3D = $00000002; - - // WGL_NV_float_buffer - WGL_FLOAT_COMPONENTS_NV = $20B0; - WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_R_NV = $20B1; - WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RG_NV = $20B2; - WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGB_NV = $20B3; - WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGBA_NV = $20B4; - WGL_TEXTURE_FLOAT_R_NV = $20B5; - WGL_TEXTURE_FLOAT_RG_NV = $20B6; - WGL_TEXTURE_FLOAT_RGB_NV = $20B7; - WGL_TEXTURE_FLOAT_RGBA_NV = $20B8; - - // WGL_NV_render_depth_texture - WGL_BIND_TO_TEXTURE_DEPTH_NV = $20A3; - WGL_BIND_TO_TEXTURE_RECTANGLE_DEPTH_NV = $20A4; - WGL_DEPTH_TEXTURE_FORMAT_NV = $20A5; - WGL_TEXTURE_DEPTH_COMPONENT_NV = $20A6; - WGL_DEPTH_COMPONENT_NV = $20A7; - - // WGL_NV_render_texture_rectangle - WGL_BIND_TO_TEXTURE_RECTANGLE_RGB_NV = $20A0; - WGL_BIND_TO_TEXTURE_RECTANGLE_RGBA_NV = $20A1; - WGL_TEXTURE_RECTANGLE_NV = $20A2; - - // WGL_NV_present_video - WGL_NUM_VIDEO_SLOTS_NV = $20F0; - - // WGL_NV_video_output - WGL_BIND_TO_VIDEO_RGB_NV = $20C0; - WGL_BIND_TO_VIDEO_RGBA_NV = $20C1; - WGL_BIND_TO_VIDEO_RGB_AND_DEPTH_NV = $20C2; - WGL_VIDEO_OUT_COLOR_NV = $20C3; - WGL_VIDEO_OUT_ALPHA_NV = $20C4; - WGL_VIDEO_OUT_DEPTH_NV = $20C5; - WGL_VIDEO_OUT_COLOR_AND_ALPHA_NV = $20C6; - WGL_VIDEO_OUT_COLOR_AND_DEPTH_NV = $20C7; - WGL_VIDEO_OUT_FRAME = $20C8; - WGL_VIDEO_OUT_FIELD_1 = $20C9; - WGL_VIDEO_OUT_FIELD_2 = $20CA; - WGL_VIDEO_OUT_STACKED_FIELDS_1_2 = $20CB; - WGL_VIDEO_OUT_STACKED_FIELDS_2_1 = $20CC; - - // WGL_NV_gpu_affinity - WGL_ERROR_INCOMPATIBLE_AFFINITY_MASKS_NV = $20D0; - WGL_ERROR_MISSING_AFFINITY_MASK_NV = $20D1; - - // WGL_NV_video_capture - WGL_UNIQUE_ID_NV = $20CE; - WGL_NUM_VIDEO_CAPTURE_SLOTS_NV = $20CF; - - // WGL_NV_multisample_coverage - WGL_COVERAGE_SAMPLES_NV = $2042; - WGL_COLOR_SAMPLES_NV = $20B9; - - // WGL_EXT_create_context_es2_profile - WGL_CONTEXT_ES2_PROFILE_BIT_EXT = $00000004; - - // WGL_NV_DX_interop - WGL_ACCESS_READ_ONLY_NV = $00000000; - WGL_ACCESS_READ_WRITE_NV = $00000001; - WGL_ACCESS_WRITE_DISCARD_NV = $00000002; - - // WIN_draw_range_elements - GL_MAX_ELEMENTS_VERTICES_WIN = $80E8; - GL_MAX_ELEMENTS_INDICES_WIN = $80E9; - - // GLX 1.1 and later: - GLX_VENDOR = 1; - GLX_VERSION = 2; - GLX_EXTENSIONS = 3; - - GLX_USE_GL = 1; - GLX_BUFFER_SIZE = 2; - GLX_LEVEL = 3; - GLX_RGBA = 4; - GLX_DOUBLEBUFFER = 5; - GLX_STEREO = 6; - GLX_AUX_BUFFERS = 7; - GLX_RED_SIZE = 8; - GLX_GREEN_SIZE = 9; - GLX_BLUE_SIZE = 10; - GLX_ALPHA_SIZE = 11; - GLX_DEPTH_SIZE = 12; - GLX_STENCIL_SIZE = 13; - GLX_ACCUM_RED_SIZE = 14; - GLX_ACCUM_GREEN_SIZE = 15; - GLX_ACCUM_BLUE_SIZE = 16; - GLX_ACCUM_ALPHA_SIZE = 17; - - // GLX_VERSION_1_3 - GLX_WINDOW_BIT = $00000001; - GLX_PIXMAP_BIT = $00000002; - GLX_PBUFFER_BIT = $00000004; - GLX_RGBA_BIT = $00000001; - GLX_COLOR_INDEX_BIT = $00000002; - GLX_PBUFFER_CLOBBER_MASK = $08000000; - GLX_FRONT_LEFT_BUFFER_BIT = $00000001; - GLX_FRONT_RIGHT_BUFFER_BIT = $00000002; - GLX_BACK_LEFT_BUFFER_BIT = $00000004; - GLX_BACK_RIGHT_BUFFER_BIT = $00000008; - GLX_AUX_BUFFERS_BIT = $00000010; - GLX_DEPTH_BUFFER_BIT = $00000020; - GLX_STENCIL_BUFFER_BIT = $00000040; - GLX_ACCUM_BUFFER_BIT = $00000080; - GLX_CONFIG_CAVEAT = $20; - GLX_X_VISUAL_TYPE = $22; - GLX_TRANSPARENT_TYPE = $23; - GLX_TRANSPARENT_INDEX_VALUE = $24; - GLX_TRANSPARENT_RED_VALUE = $25; - GLX_TRANSPARENT_GREEN_VALUE = $26; - GLX_TRANSPARENT_BLUE_VALUE = $27; - GLX_TRANSPARENT_ALPHA_VALUE = $28; - GLX_DONT_CARE = $FFFFFFFF; - GLX_NONE = $8000; - GLX_SLOW_CONFIG = $8001; - GLX_TRUE_COLOR = $8002; - GLX_DIRECT_COLOR = $8003; - GLX_PSEUDO_COLOR = $8004; - GLX_STATIC_COLOR = $8005; - GLX_GRAY_SCALE = $8006; - GLX_STATIC_GRAY = $8007; - GLX_TRANSPARENT_RGB = $8008; - GLX_TRANSPARENT_INDEX = $8009; - GLX_VISUAL_ID = $800B; - GLX_SCREEN = $800C; - GLX_NON_CONFORMANT_CONFIG = $800D; - GLX_DRAWABLE_TYPE = $8010; - GLX_RENDER_TYPE = $8011; - GLX_X_RENDERABLE = $8012; - GLX_FBCONFIG_ID = $8013; - GLX_RGBA_TYPE = $8014; - GLX_COLOR_INDEX_TYPE = $8015; - GLX_MAX_PBUFFER_WIDTH = $8016; - GLX_MAX_PBUFFER_HEIGHT = $8017; - GLX_MAX_PBUFFER_PIXELS = $8018; - GLX_PRESERVED_CONTENTS = $801B; - GLX_LARGEST_PBUFFER = $801C; - GLX_WIDTH = $801D; - GLX_HEIGHT = $801E; - GLX_EVENT_MASK = $801F; - GLX_DAMAGED = $8020; - GLX_SAVED = $8021; - GLX_WINDOW = $8022; - GLX_PBUFFER = $8023; - GLX_PBUFFER_HEIGHT = $8040; - GLX_PBUFFER_WIDTH = $8041; - - // GLX_VERSION_1_4 - GLX_SAMPLE_BUFFERS = 100000; - GLX_SAMPLES = 100001; - - // GLX_ARB_multisample - GLX_SAMPLE_BUFFERS_ARB = 100000; - GLX_SAMPLES_ARB = 100001; - - // GLX_ARB_fbconfig_float - GLX_RGBA_FLOAT_TYPE_ARB = $20B9; - GLX_RGBA_FLOAT_BIT_ARB = $00000004; - - // GLX_ARB_create_context - GLX_CONTEXT_DEBUG_BIT_ARB = $00000001; - GLX_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB = $00000002; - GLX_CONTEXT_MAJOR_VERSION_ARB = $2091; - GLX_CONTEXT_MINOR_VERSION_ARB = $2092; - GLX_CONTEXT_FLAGS_ARB = $2094; - - // GLX_ARB_create_context_profile - GLX_CONTEXT_CORE_PROFILE_BIT_ARB = $00000001; - GLX_CONTEXT_COMPATIBILITY_PROFILE_BIT_ARB = $00000002; - GLX_CONTEXT_PROFILE_MASK_ARB = $9126; - - // GLX_ARB_vertex_buffer_object - GLX_CONTEXT_ALLOW_BUFFER_BYTE_ORDER_MISMATCH_ARB = $2095; - - // GLX_ARB_framebuffer_sRGB - GLX_FRAMEBUFFER_SRGB_CAPABLE_ARB = $20B2; - - // GLX_ARB_create_context_robustness - GLX_CONTEXT_ROBUST_ACCESS_BIT_ARB = $00000004; - GLX_LOSE_CONTEXT_ON_RESET_ARB = $8252; - GLX_CONTEXT_RESET_NOTIFICATION_STRATEGY_ARB = $8256; - GLX_NO_RESET_NOTIFICATION_ARB = $8261; - - // GLX_EXT_visual_info - GLX_X_VISUAL_TYPE_EXT = $22; - GLX_TRANSPARENT_TYPE_EXT = $23; - GLX_TRANSPARENT_INDEX_VALUE_EXT = $24; - GLX_TRANSPARENT_RED_VALUE_EXT = $25; - GLX_TRANSPARENT_GREEN_VALUE_EXT = $26; - GLX_TRANSPARENT_BLUE_VALUE_EXT = $27; - GLX_TRANSPARENT_ALPHA_VALUE_EXT = $28; - GLX_NONE_EXT = $8000; - GLX_TRUE_COLOR_EXT = $8002; - GLX_DIRECT_COLOR_EXT = $8003; - GLX_PSEUDO_COLOR_EXT = $8004; - GLX_STATIC_COLOR_EXT = $8005; - GLX_GRAY_SCALE_EXT = $8006; - GLX_STATIC_GRAY_EXT = $8007; - GLX_TRANSPARENT_RGB_EXT = $8008; - GLX_TRANSPARENT_INDEX_EXT = $8009; - - // GLX_EXT_visual_rating - GLX_VISUAL_CAVEAT_EXT = $20; - GLX_SLOW_VISUAL_EXT = $8001; - GLX_NON_CONFORMANT_VISUAL_EXT = $800D; - (* reuse GLX_NONE_EXT *) - - // GLX_EXT_import_context - GLX_SHARE_CONTEXT_EXT = $800A; - GLX_VISUAL_ID_EXT = $800B; - GLX_SCREEN_EXT = $800C; - - // GLX_EXT_fbconfig_packed_float -// GLX_RGBA_UNSIGNED_FLOAT_TYPE_EXT = $20B1; -// GLX_RGBA_UNSIGNED_FLOAT_BIT_EXT = $00000008; - - // GLX_EXT_framebuffer_sRGB -// GLX_FRAMEBUFFER_SRGB_CAPABLE_EXT = $20B2; - - // GLX_EXT_texture_from_pixmap - GLX_TEXTURE_1D_BIT_EXT = $00000001; - GLX_TEXTURE_2D_BIT_EXT = $00000002; - GLX_TEXTURE_RECTANGLE_BIT_EXT = $00000004; - GLX_BIND_TO_TEXTURE_RGB_EXT = $20D0; - GLX_BIND_TO_TEXTURE_RGBA_EXT = $20D1; - GLX_BIND_TO_MIPMAP_TEXTURE_EXT = $20D2; - GLX_BIND_TO_TEXTURE_TARGETS_EXT = $20D3; - GLX_Y_INVERTED_EXT = $20D4; - GLX_TEXTURE_FORMAT_EXT = $20D5; - GLX_TEXTURE_TARGET_EXT = $20D6; - GLX_MIPMAP_TEXTURE_EXT = $20D7; - GLX_TEXTURE_FORMAT_NONE_EXT = $20D8; - GLX_TEXTURE_FORMAT_RGB_EXT = $20D9; - GLX_TEXTURE_FORMAT_RGBA_EXT = $20DA; - GLX_TEXTURE_1D_EXT = $20DB; - GLX_TEXTURE_2D_EXT = $20DC; - GLX_TEXTURE_RECTANGLE_EXT = $20DD; - GLX_FRONT_LEFT_EXT = $20DE; - GLX_FRONT_RIGHT_EXT = $20DF; - GLX_BACK_LEFT_EXT = $20E0; - GLX_BACK_RIGHT_EXT = $20E1; - GLX_FRONT_EXT = GLX_FRONT_LEFT_EXT; - GLX_BACK_EXT = GLX_BACK_LEFT_EXT; - GLX_AUX0_EXT = $20E2; - GLX_AUX1_EXT = $20E3; - GLX_AUX2_EXT = $20E4; - GLX_AUX3_EXT = $20E5; - GLX_AUX4_EXT = $20E6; - GLX_AUX5_EXT = $20E7; - GLX_AUX6_EXT = $20E8; - GLX_AUX7_EXT = $20E9; - GLX_AUX8_EXT = $20EA; - GLX_AUX9_EXT = $20EB; - - // GLX_EXT_swap_control - GLX_SWAP_INTERVAL_EXT = $20F1; - GLX_MAX_SWAP_INTERVAL_EXT = $20F2; - - // GLX_EXT_create_context_es2_profile - GLX_CONTEXT_ES2_PROFILE_BIT_EXT = $00000004; - - // GL_EXT_Late_Swaps - GLX_LATE_SWAPS_TEAR_EXT = $20F3; - - // GLU - GLU_INVALID_ENUM = 100900; - GLU_INVALID_VALUE = 100901; - GLU_OUT_OF_MEMORY = 100902; - GLU_INCOMPATIBLE_GL_VERSION = 100903; - GLU_VERSION = 100800; - GLU_EXTENSIONS = 100801; - GLU_TRUE = GL_TRUE; - GLU_FALSE = GL_FALSE; - GLU_SMOOTH = 100000; - GLU_FLAT = 100001; - GLU_NONE = 100002; - GLU_POINT = 100010; - GLU_LINE = 100011; - GLU_FILL = 100012; - GLU_SILHOUETTE = 100013; - GLU_OUTSIDE = 100020; - GLU_INSIDE = 100021; - GLU_TESS_MAX_COORD = 1.0E150; - GLU_TESS_WINDING_RULE = 100140; - GLU_TESS_BOUNDARY_ONLY = 100141; - GLU_TESS_TOLERANCE = 100142; - GLU_TESS_WINDING_ODD = 100130; - GLU_TESS_WINDING_NONZERO = 100131; - GLU_TESS_WINDING_POSITIVE = 100132; - GLU_TESS_WINDING_NEGATIVE = 100133; - GLU_TESS_WINDING_ABS_GEQ_TWO = 100134; - GLU_TESS_BEGIN = 100100; // TGLUTessBeginProc - GLU_TESS_VERTEX = 100101; // TGLUTessVertexProc - GLU_TESS_END = 100102; // TGLUTessEndProc - GLU_TESS_ERROR = 100103; // TGLUTessErrorProc - GLU_TESS_EDGE_FLAG = 100104; // TGLUTessEdgeFlagProc - GLU_TESS_COMBINE = 100105; // TGLUTessCombineProc - GLU_TESS_BEGIN_DATA = 100106; // TGLUTessBeginDataProc - GLU_TESS_VERTEX_DATA = 100107; // TGLUTessVertexDataProc - GLU_TESS_END_DATA = 100108; // TGLUTessEndDataProc - GLU_TESS_ERROR_DATA = 100109; // TGLUTessErrorDataProc - GLU_TESS_EDGE_FLAG_DATA = 100110; // TGLUTessEdgeFlagDataProc - GLU_TESS_COMBINE_DATA = 100111; // TGLUTessCombineDataProc - GLU_TESS_ERROR1 = 100151; - GLU_TESS_ERROR2 = 100152; - GLU_TESS_ERROR3 = 100153; - GLU_TESS_ERROR4 = 100154; - GLU_TESS_ERROR5 = 100155; - GLU_TESS_ERROR6 = 100156; - GLU_TESS_ERROR7 = 100157; - GLU_TESS_ERROR8 = 100158; - GLU_TESS_MISSING_BEGIN_POLYGON = GLU_TESS_ERROR1; - GLU_TESS_MISSING_BEGIN_CONTOUR = GLU_TESS_ERROR2; - GLU_TESS_MISSING_END_POLYGON = GLU_TESS_ERROR3; - GLU_TESS_MISSING_END_CONTOUR = GLU_TESS_ERROR4; - GLU_TESS_COORD_TOO_LARGE = GLU_TESS_ERROR5; - GLU_TESS_NEED_COMBINE_CALLBACK = GLU_TESS_ERROR6; - GLU_AUTO_LOAD_MATRIX = 100200; - GLU_CULLING = 100201; - GLU_SAMPLING_TOLERANCE = 100203; - GLU_DISPLAY_MODE = 100204; - GLU_PARAMETRIC_TOLERANCE = 100202; - GLU_SAMPLING_METHOD = 100205; - GLU_U_STEP = 100206; - GLU_V_STEP = 100207; - GLU_PATH_LENGTH = 100215; - GLU_PARAMETRIC_ERROR = 100216; - GLU_DOMAIN_DISTANCE = 100217; - GLU_MAP1_TRIM_2 = 100210; - GLU_MAP1_TRIM_3 = 100211; - GLU_OUTLINE_POLYGON = 100240; - GLU_OUTLINE_PATCH = 100241; - GLU_NURBS_ERROR1 = 100251; - GLU_NURBS_ERROR2 = 100252; - GLU_NURBS_ERROR3 = 100253; - GLU_NURBS_ERROR4 = 100254; - GLU_NURBS_ERROR5 = 100255; - GLU_NURBS_ERROR6 = 100256; - GLU_NURBS_ERROR7 = 100257; - GLU_NURBS_ERROR8 = 100258; - GLU_NURBS_ERROR9 = 100259; - GLU_NURBS_ERROR10 = 100260; - GLU_NURBS_ERROR11 = 100261; - GLU_NURBS_ERROR12 = 100262; - GLU_NURBS_ERROR13 = 100263; - GLU_NURBS_ERROR14 = 100264; - GLU_NURBS_ERROR15 = 100265; - GLU_NURBS_ERROR16 = 100266; - GLU_NURBS_ERROR17 = 100267; - GLU_NURBS_ERROR18 = 100268; - GLU_NURBS_ERROR19 = 100269; - GLU_NURBS_ERROR20 = 100270; - GLU_NURBS_ERROR21 = 100271; - GLU_NURBS_ERROR22 = 100272; - GLU_NURBS_ERROR23 = 100273; - GLU_NURBS_ERROR24 = 100274; - GLU_NURBS_ERROR25 = 100275; - GLU_NURBS_ERROR26 = 100276; - GLU_NURBS_ERROR27 = 100277; - GLU_NURBS_ERROR28 = 100278; - GLU_NURBS_ERROR29 = 100279; - GLU_NURBS_ERROR30 = 100280; - GLU_NURBS_ERROR31 = 100281; - GLU_NURBS_ERROR32 = 100282; - GLU_NURBS_ERROR33 = 100283; - GLU_NURBS_ERROR34 = 100284; - GLU_NURBS_ERROR35 = 100285; - GLU_NURBS_ERROR36 = 100286; - GLU_NURBS_ERROR37 = 100287; - GLU_CW = 100120; - GLU_CCW = 100121; - GLU_INTERIOR = 100122; - GLU_EXTERIOR = 100123; - GLU_UNKNOWN = 100124; - GLU_BEGIN = GLU_TESS_BEGIN; - GLU_VERTEX = GLU_TESS_VERTEX; - GLU_END = GLU_TESS_END; - GLU_ERROR = GLU_TESS_ERROR; - GLU_EDGE_FLAG = GLU_TESS_EDGE_FLAG; - -type - // GL_VERSION_1_0 - TglCullFace = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFrontFace = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglHint = procedure(target: GLenum; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLineWidth = procedure(width: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointSize = procedure(size: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPolygonMode = procedure(face: GLenum; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglScissor = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameterf = procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawBuffer = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClear = procedure(mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearColor = procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearStencil = procedure(s: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearDepth = procedure(depth: GLclampd); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilMask = procedure(mask: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorMask = procedure(red: GLboolean; green: GLboolean; blue: GLboolean; alpha: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDepthMask = procedure(flag: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisable = procedure(cap: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnable = procedure(cap: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFinish = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFlush = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendFunc = procedure(sfactor: GLenum; dfactor: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLogicOp = procedure(opcode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilFunc = procedure(func: GLenum; ref: GLint; mask: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilOp = procedure(fail: GLenum; zfail: GLenum; zpass: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDepthFunc = procedure(func: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelStoref = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReadBuffer = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBooleanv = procedure(pname: GLenum; params: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetDoublev = procedure(pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetError = function(): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFloatv = procedure(pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsEnabled = function(cap: GLenum): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDepthRange = procedure(zNear: GLclampd; zFar: GLclampd); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglViewport = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_1_1 - TglDrawArrays = procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElements = procedure(mode: GLenum; count: GLsizei; _type: GLenum; const indices: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPointerv = procedure(pname: GLenum; params: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPolygonOffset = procedure(factor: GLfloat; units: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexImage1D = procedure(target: GLenum; level: GLint; internalFormat: GLenum; x: GLint; y: GLint; width: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexImage2D = procedure(target: GLenum; level: GLint; internalFormat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexSubImage1D = procedure(target: GLenum; level: GLint; xoffset: GLint; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexSubImage2D = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexSubImage1D = procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexSubImage2D = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - -{$ifdef DGL_DEPRECATED} - TglAccum = procedure(op: GLenum; value: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglAlphaFunc = procedure(func: GLenum; ref: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglArrayElement = procedure(i: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBegin = procedure(mode: GLenum); {$IFNDEF CLR}{$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}{$ENDIF} - TglBitmap = procedure(width: GLsizei; height: GLsizei; xorig: GLfloat; yorig: GLfloat; xmove: GLfloat; ymove: GLfloat; const bitmap: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCallList = procedure(list: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCallLists = procedure(n: GLsizei; _type: GLenum; const lists: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearAccum = procedure(red: GLfloat; green: GLfloat; blue: GLfloat; alpha: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearIndex = procedure(c: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClipPlane = procedure(plane: GLenum; const equation: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3b = procedure(red: GLbyte; green: GLbyte; blue: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3bv = procedure(const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3d = procedure(red: GLdouble; green: GLdouble; blue: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3f = procedure(red: GLfloat; green: GLfloat; blue: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3i = procedure(red: GLint; green: GLint; blue: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3s = procedure(red: GLshort; green: GLshort; blue: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3ub = procedure(red: GLubyte; green: GLubyte; blue: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3ubv = procedure(const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3ui = procedure(red: GLuint; green: GLuint; blue: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3uiv = procedure(const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3us = procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3usv = procedure(const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4b = procedure(red: GLbyte; green: GLbyte; blue: GLbyte; alpha: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4bv = procedure(const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4d = procedure(red: GLdouble; green: GLdouble; blue: GLdouble; alpha: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4f = procedure(red: GLfloat; green: GLfloat; blue: GLfloat; alpha: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4i = procedure(red: GLint; green: GLint; blue: GLint; alpha: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4s = procedure(red: GLshort; green: GLshort; blue: GLshort; alpha: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4ub = procedure(red: GLubyte; green: GLubyte; blue: GLubyte; alpha: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4ubv = procedure(const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4ui = procedure(red: GLuint; green: GLuint; blue: GLuint; alpha: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4uiv = procedure(const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4us = procedure(red: GLushort; green: GLushort; blue: GLushort; alpha: GLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4usv = procedure(const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorMaterial = procedure(face: GLenum; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorPointer = procedure(size: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; _type: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteLists = procedure(list: GLuint; range: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisableClientState = procedure(_array: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawPixels = procedure(width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEdgeFlag = procedure(flag: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEdgeFlagPointer = procedure(stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEdgeFlagv = procedure(const flag: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnableClientState = procedure(_array: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnd = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndList = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord1d = procedure(u: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord1dv = procedure(const u: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord1f = procedure(u: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord1fv = procedure(const u: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord2d = procedure(u: GLdouble; v: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord2dv = procedure(const u: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord2f = procedure(u: GLfloat; v: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalCoord2fv = procedure(const u: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalMesh1 = procedure(mode: GLenum; i1: GLint; i2: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalMesh2 = procedure(mode: GLenum; i1: GLint; i2: GLint; j1: GLint; j2: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalPoint1 = procedure(i: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalPoint2 = procedure(i: GLint; j: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFeedbackBuffer = procedure(size: GLsizei; _type: GLenum; buffer: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogf = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogfv = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogi = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogiv = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFrustum = procedure(left: GLdouble; right: GLdouble; bottom: GLdouble; top: GLdouble; zNear: GLdouble; zFar: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenLists = function(range: GLsizei): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetClipPlane = procedure(plane: GLenum; equation: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetLightfv = procedure(light: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetLightiv = procedure(light: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapdv = procedure(target: GLenum; query: GLenum; v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapfv = procedure(target: GLenum; query: GLenum; v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapiv = procedure(target: GLenum; query: GLenum; v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMaterialfv = procedure(face: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMaterialiv = procedure(face: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPixelMapfv = procedure(map: GLenum; values: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPixelMapuiv = procedure(map: GLenum; values: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPixelMapusv = procedure(map: GLenum; values: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPolygonStipple = procedure(mask: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexEnvfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexEnviv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexGendv = procedure(coord: GLenum; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexGenfv = procedure(coord: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexGeniv = procedure(coord: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexMask = procedure(mask: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexPointer = procedure(_type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexd = procedure(c: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexdv = procedure(const c: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexf = procedure(c: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexfv = procedure(const c: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexi = procedure(c: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexiv = procedure(const c: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexs = procedure(c: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexsv = procedure(const c: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexub = procedure(c: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexubv = procedure(const c: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInitNames = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInterleavedArrays = procedure(format: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsList = function(list: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsTexture = function(texture: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightModelf = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightModelfv = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightModeli = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightModeliv = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightf = procedure(light: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightfv = procedure(light: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLighti = procedure(light: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightiv = procedure(light: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLineStipple = procedure(factor: GLint; pattern: GLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglListBase = procedure(base: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadIdentity = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadMatrixd = procedure(const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadMatrixf = procedure(const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadName = procedure(name: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMap1d = procedure(target: GLenum; u1: GLdouble; u2: GLdouble; stride: GLint; order: GLint; const points: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMap1f = procedure(target: GLenum; u1: GLfloat; u2: GLfloat; stride: GLint; order: GLint; const points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMap2d = procedure(target: GLenum; u1: GLdouble; u2: GLdouble; ustride: GLint; uorder: GLint; v1: GLdouble; v2: GLdouble; vstride: GLint; vorder: GLint; const points: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMap2f = procedure(target: GLenum; u1: GLfloat; u2: GLfloat; ustride: GLint; uorder: GLint; v1: GLfloat; v2: GLfloat; vstride: GLint; vorder: GLint; const points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapGrid1d = procedure(un: GLint; u1: GLdouble; u2: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapGrid1f = procedure(un: GLint; u1: GLfloat; u2: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapGrid2d = procedure(un: GLint; u1: GLdouble; u2: GLdouble; vn: GLint; v1: GLdouble; v2: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapGrid2f = procedure(un: GLint; u1: GLfloat; u2: GLfloat; vn: GLint; v1: GLfloat; v2: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMaterialf = procedure(face: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMaterialfv = procedure(face: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMateriali = procedure(face: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMaterialiv = procedure(face: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixMode = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultMatrixd = procedure(const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultMatrixf = procedure(const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNewList = procedure(list: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3b = procedure(nx: GLbyte; ny: GLbyte; nz: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3bv = procedure(const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3d = procedure(nx: GLdouble; ny: GLdouble; nz: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3f = procedure(nx: GLfloat; ny: GLfloat; nz: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3i = procedure(nx: GLint; ny: GLint; nz: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3s = procedure(nx: GLshort; ny: GLshort; nz: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalPointer = procedure(_type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglOrtho = procedure(left: GLdouble; right: GLdouble; bottom: GLdouble; top: GLdouble; zNear: GLdouble; zFar: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPassThrough = procedure(token: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelMapfv = procedure(map: GLenum; mapsize: GLsizei; const values: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelMapuiv = procedure(map: GLenum; mapsize: GLsizei; const values: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelMapusv = procedure(map: GLenum; mapsize: GLsizei; const values: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTransferf = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTransferi = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelZoom = procedure(xfactor: GLfloat; yfactor: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPolygonStipple = procedure(const mask: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPopAttrib = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPopClientAttrib = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPopMatrix = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPopName = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPrioritizeTextures = procedure(n: GLsizei; const textures: PGLuint; const priorities: PGLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPushAttrib = procedure(mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPushClientAttrib = procedure(mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPushMatrix = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPushName = procedure(name: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2d = procedure(x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2f = procedure(x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2i = procedure(x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2s = procedure(x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos2sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3d = procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3f = procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3i = procedure(x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3s = procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos3sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4d = procedure(x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4f = procedure(x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4i = procedure(x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4s = procedure(x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRasterPos4sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRectd = procedure(x1: GLdouble; y1: GLdouble; x2: GLdouble; y2: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRectdv = procedure(const v1: PGLdouble; const v2: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRectf = procedure(x1: GLfloat; y1: GLfloat; x2: GLfloat; y2: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRectfv = procedure(const v1: PGLfloat; const v2: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRecti = procedure(x1: GLint; y1: GLint; x2: GLint; y2: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRectiv = procedure(const v1: PGLint; const v2: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRects = procedure(x1: GLshort; y1: GLshort; x2: GLshort; y2: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRectsv = procedure(const v1: PGLshort; const v2: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRenderMode = function(mode: GLenum): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRotated = procedure(angle: GLdouble; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRotatef = procedure(angle: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglScaled = procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglScalef = procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSelectBuffer = procedure(size: GLsizei; buffer: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglShadeModel = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1d = procedure(s: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1f = procedure(s: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1i = procedure(s: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1s = procedure(s: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2d = procedure(s: GLdouble; t: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2f = procedure(s: GLfloat; t: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2i = procedure(s: GLint; t: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2s = procedure(s: GLshort; t: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3d = procedure(s: GLdouble; t: GLdouble; r: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3f = procedure(s: GLfloat; t: GLfloat; r: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3i = procedure(s: GLint; t: GLint; r: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3s = procedure(s: GLshort; t: GLshort; r: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4d = procedure(s: GLdouble; t: GLdouble; r: GLdouble; q: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4f = procedure(s: GLfloat; t: GLfloat; r: GLfloat; q: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4i = procedure(s: GLint; t: GLint; r: GLint; q: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4s = procedure(s: GLshort; t: GLshort; r: GLshort; q: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordPointer = procedure(size: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexEnvf = procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexEnvfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexEnvi = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexEnviv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexGend = procedure(coord: GLenum; pname: GLenum; param: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexGendv = procedure(coord: GLenum; pname: GLenum; const params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexGenf = procedure(coord: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexGenfv = procedure(coord: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexGeniv = procedure(coord: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - - TglTranslated = procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTranslatef = procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2d = procedure(x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2f = procedure(x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2i = procedure(x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2s = procedure(x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3d = procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3f = procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3i = procedure(x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3s = procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4d = procedure(x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4f = procedure(x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4i = procedure(x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4s = procedure(x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexPointer = procedure(size: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -{$endif} - - // GL_VERSION_1_2 - TglBlendColor = procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendEquation = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawRangeElements = procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei; _type: GLenum; const indices: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexImage3D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexSubImage3D = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexSubImage3D = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -{$ifdef DGL_DEPRECATED} - TglColorTable = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const table: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorTableParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorTableParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyColorTable = procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTable = procedure(target: GLenum; format: GLenum; _type: GLenum; table: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorSubTable = procedure(target: GLenum; start: GLsizei; count: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyColorSubTable = procedure(target: GLenum; start: GLsizei; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionFilter1D = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionFilter2D = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameterf = procedure(target: GLenum; pname: GLenum; params: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameteri = procedure(target: GLenum; pname: GLenum; params: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyConvolutionFilter1D = procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyConvolutionFilter2D = procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetConvolutionFilter = procedure(target: GLenum; format: GLenum; _type: GLenum; image: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetConvolutionParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetConvolutionParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSeparableFilter = procedure(target: GLenum; format: GLenum; _type: GLenum; row: PGLvoid; column: PGLvoid; span: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSeparableFilter2D = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const row: PGLvoid; const column: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetHistogram = procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetHistogramParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetHistogramParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMinmax = procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMinmaxParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMinmaxParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglHistogram = procedure(target: GLenum; width: GLsizei; internalformat: GLenum; sink: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMinmax = procedure(target: GLenum; internalformat: GLenum; sink: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglResetHistogram = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglResetMinmax = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -{$endif} - - // GL_VERSION_1_3 - TglActiveTexture = procedure(texture: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSampleCoverage = procedure(value: GLclampf; invert: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexImage3D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexSubImage3D = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexSubImage2D = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexSubImage1D = procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -{$ifdef DGL_DEPRECATED} - TglClientActiveTexture = procedure(texture: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1d = procedure(target: GLenum; s: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1dv = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1f = procedure(target: GLenum; s: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1fv = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1i = procedure(target: GLenum; s: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1iv = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1s = procedure(target: GLenum; s: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1sv = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2d = procedure(target: GLenum; s: GLdouble; t: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2dv = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2f = procedure(target: GLenum; s: GLfloat; t: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2fv = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2i = procedure(target: GLenum; s: GLint; t: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2iv = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2s = procedure(target: GLenum; s: GLshort; t: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2sv = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3d = procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3dv = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3f = procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3fv = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3i = procedure(target: GLenum; s: GLint; t: GLint; r: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3iv = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3s = procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3sv = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4d = procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble; q: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4dv = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4f = procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat; q: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4fv = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4i = procedure(target: GLenum; s: GLint; t: GLint; r: GLint; q: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4iv = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4s = procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort; q: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4sv = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadTransposeMatrixf = procedure(const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadTransposeMatrixd = procedure(const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultTransposeMatrixf = procedure(const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultTransposeMatrixd = procedure(const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -{$endif} - - // GL_VERSION_1_4 - TglBlendFuncSeparate = procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiDrawArrays = procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiDrawElements = procedure(mode: GLenum; const count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameterf = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameterfv = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameteri = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameteriv = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -{$ifdef DGL_DEPRECATED} - TglFogCoordf = procedure(coord: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordfv = procedure(const coord: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordd = procedure(coord: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoorddv = procedure(const coord: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordPointer = procedure(_type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3b = procedure(red: GLbyte; green: GLbyte; blue: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3bv = procedure(const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3d = procedure(red: GLdouble; green: GLdouble; blue: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3f = procedure(red: GLfloat; green: GLfloat; blue: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3i = procedure(red: GLint; green: GLint; blue: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3s = procedure(red: GLshort; green: GLshort; blue: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3ub = procedure(red: GLubyte; green: GLubyte; blue: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3ubv = procedure(const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3ui = procedure(red: GLuint; green: GLuint; blue: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3uiv = procedure(const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3us = procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3usv = procedure(const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColorPointer = procedure(size: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2d = procedure(x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2f = procedure(x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2i = procedure(x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2s = procedure(x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3d = procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3dv = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3f = procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3fv = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3i = procedure(x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3iv = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3s = procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3sv = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -{$endif} - - // GL_VERSION_1_5 - TglGenQueries = procedure(n: GLsizei; ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteQueries = procedure(n: GLsizei; const ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsQuery = function(id: GLuint): boolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginQuery = procedure(target: GLenum; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndQuery = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryiv = procedure(target, pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryObjectiv = procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryObjectuiv = procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBuffer = procedure(target: GLenum; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteBuffers = procedure(n: GLsizei; const buffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenBuffers = procedure(n: GLsizei; buffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsBuffer = function(buffer: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBufferData = procedure(target: GLenum; size: GLsizeiptr; const data: PGLvoid; usage: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBufferSubData = procedure(target: GLenum; offset: GLintptr; size: GLsizeiptr; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferSubData = procedure(target: GLenum; offset: GLintptr; size: GLsizeiptr; data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapBuffer = function(target: GLenum; access: GLenum): PGLvoid; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUnmapBuffer = function(target: GLenum): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferPointerv = procedure(target: GLenum; pname: GLenum; params: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_2_0 - TglBlendEquationSeparate = procedure(modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawBuffers = procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilOpSeparate = procedure(face: GLenum; sfail: GLenum; dpfail: GLenum; dppass: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilFuncSeparate = procedure(face: GLenum; func: GLenum; ref: GLint; mask: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilMaskSeparate = procedure(face: GLenum; mask: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglAttachShader = procedure(programObj, shaderObj: GLhandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindAttribLocation = procedure(programObj: GLhandle; index: GLuint; name: PGLChar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompileShader = procedure(shaderObj: GLhandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCreateProgram = function: GLhandle; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCreateShader = function(shaderType: GLenum): GLhandle; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteProgram = procedure(programObj: GLhandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteShader = procedure(shaderObj: GLhandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDetachShader = procedure(programObj, shaderObj: GLhandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisableVertexAttribArray = procedure(index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnableVertexAttribArray = procedure(index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveAttrib = procedure(programObj: GLhandle; index: GLuint; maxlength: GLsizei; var length: GLint; var size: GLint; var _type: GLenum; name: PGLChar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveUniform = procedure(programObj: GLhandle; index: GLuint; maxLength: GLsizei; var length: GLsizei; var size: GLint; var _type: GLenum; name: PGLChar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetAttachedShaders = procedure(programObj: GLhandle; MaxCount: GLsizei; var Count: GLint; shaders: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetAttribLocation = function(programObj: GLhandle; char: PGLChar): glint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramiv = procedure(programObj: GLhandle; pname: GLenum; params: PGLInt); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramInfoLog = procedure(programObj: GLHandle; maxLength: glsizei; var length: GLint; infoLog: PGLChar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetShaderiv = procedure(shaderObj: GLhandle; pname: GLenum; params: PGLInt); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetShaderInfoLog = procedure(shaderObj: GLHandle; maxLength: glsizei; var length: glint; infoLog: PGLChar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetShaderSource = procedure(shaderObj: GLhandle; maxlength: GLsizei; var length: GLsizei; source: PGLChar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformLocation = function(programObj: GLhandle; const char: PGLChar): glint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformfv = procedure(programObj: GLhandle; location: GLint; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformiv = procedure(programObj: GLhandle; location: GLint; params: PGLInt); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribfv = procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribiv = procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribPointerv = procedure(index: GLuint; pname: GLenum; _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsProgram = function(programObj: GLhandle) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsShader = function(shaderObj: GLhandle) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLinkProgram = procedure(programObj: GLHandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglShaderSource = procedure(shaderObj: GLHandle; count: glsizei; const _string: PPGLChar; lengths: pglint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUseProgram = procedure(programObj: GLhandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1f = procedure(location: GLint; v0: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2f = procedure(location: GLint; v0, v1: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3f = procedure(location: GLint; v0, v1, v2: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4f = procedure(location: GLint; v0, v1, v2, v3: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1i = procedure(location: GLint; v0: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2i = procedure(location: GLint; v0, v1: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3i = procedure(location: GLint; v0, v1, v2: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4i = procedure(location: GLint; v0, v1, v2, v3: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1fv = procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2fv = procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3fv = procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4fv = procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1iv = procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2iv = procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3iv = procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4iv = procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix2fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix3fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix4fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglValidateProgram = procedure(programObj: GLhandle); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1d = procedure(index: GLuint; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1f = procedure(index: GLuint; x: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1fv = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1s = procedure(index: GLuint; x: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1sv = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2d = procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2f = procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2fv = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2s = procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2sv = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3d = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3f = procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3fv = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3s = procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3sv = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4Nbv = procedure(index: GLuint; const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4Niv = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4Nsv = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4Nub = procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4Nubv = procedure(index: GLuint; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4Nuiv = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4Nusv = procedure(index: GLuint; const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4bv = procedure(index: GLuint; const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4d = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4f = procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4fv = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4iv = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4s = procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4sv = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4ubv = procedure(index: GLuint; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4uiv = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4usv = procedure(index: GLuint; const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribPointer = procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_2_1 - TglUniformMatrix2x3fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix3x2fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix2x4fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix4x2fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix3x4fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix4x3fv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_3_0 - { OpenGL 3.0 also reuses entry points from these extensions: } - { ARB_framebuffer_object } - { ARB_map_buffer_range } - { ARB_vertex_array_object } - TglColorMaski = procedure(index_: GLuint; r: GLboolean; g: GLboolean; b: GLboolean; a: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBooleani_v = procedure(target: GLenum; index_: GLuint; data: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetIntegeri_v = procedure(target: GLenum; index_: GLuint; data: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnablei = procedure(target: GLenum; index_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisablei = procedure(target: GLenum; index_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsEnabledi = function(target: GLenum; index_: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginTransformFeedback = procedure(primitiveMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndTransformFeedback = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferRange = procedure(target: GLenum; index_: GLuint; buffer: GLuint; offset: GLintptr; size: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferBase = procedure(target: GLenum; index_: GLuint; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTransformFeedbackVaryings = procedure(program_: GLuint; count: GLsizei; const varyings: PPGLchar; bufferMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTransformFeedbackVarying = procedure(program_: GLuint; index_: GLuint; bufSize: GLsizei; length: PGLsizei; size: PGLsizei; type_: PGLsizei; name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClampColor = procedure(targe: GLenum; clamp: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginConditionalRender = procedure(id: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndConditionalRender = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribIPointer = procedure(index_: GLuint; size: GLint; type_: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribIiv = procedure(index_: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribIuiv = procedure(index_: GLuint; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI1i = procedure(index_: GLuint; x: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2i = procedure(index_: GLuint; x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3i = procedure(index_: GLuint; x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4i = procedure(index_: GLuint; x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI1ui = procedure(index_: GLuint; x: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2ui = procedure(index_: GLuint; x: GLuint; y: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3ui = procedure(index_: GLuint; x: GLuint; y: GLuint; z: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4ui = procedure(index_: GLuint; x: GLuint; y: GLuint; z: GLuint; w: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI1iv = procedure(index_: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2iv = procedure(index_: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3iv = procedure(index_: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4iv = procedure(index_: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI1uiv = procedure(index_: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2uiv = procedure(index_: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3uiv = procedure(index_: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4uiv = procedure(index_: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4bv = procedure(index_: GLuint; const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4sv = procedure(index_: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4ubv = procedure(index_: GLuint; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4usv = procedure(index_: GLuint; const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformuiv = procedure(program_: GLuint; location: GLint; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindFragDataLocation = procedure(program_: GLuint; color: GLuint; const name: PGLChar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFragDataLocation = function(program_: GLuint; const name: PGLChar): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1ui = procedure(location: GLint; v0: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2ui = procedure(location: GLint; v0: GLuint; v1: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3ui = procedure(location: GLint; v0: GLuint; v1: GLuint; v2: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4ui = procedure(location: GLint; v0: GLuint; v1: GLuint; v2: GLuint; v3: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1uiv = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2uiv = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3uiv = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4uiv = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameterIiv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameterIuiv = procedure(target: GLenum; pname: GLenum; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexParameterIiv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexParameterIuiv = procedure(target: GLenum; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearBufferiv = procedure(buffer: GLenum; drawbuffer: GLint; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearBufferuiv = procedure(buffer: GLenum; drawbuffer: GLint; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearBufferfv = procedure(buffer: GLenum; drawbuffer: GLint; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearBufferfi = procedure(buffer: GLenum; drawbuffer: GLint; depth: GLfloat; stencil: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetStringi = function(name: GLenum; index: GLuint): PGLubyte; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_3_1 - { OpenGL 3.1 also reuses entry points from these extensions: } - { ARB_copy_buffer } - { ARB_uniform_buffer_object } - TglDrawArraysInstanced = procedure(mode: GLenum; first: GLint; count: GLsizei; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementsInstanced = procedure(mode: GLenum; count: GLsizei; type_: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexBuffer = procedure(target: GLenum; internalformat: GLenum; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPrimitiveRestartIndex = procedure(index_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_3_2 - { OpenGL 3.2 also reuses entry points from these extensions: } - { ARB_draw_elements_base_vertex } - { ARB_provoking_vertex } - { ARB_sync } - { ARB_texture_multisample } - TglGetInteger64i_v = procedure(target: GLenum; index_: GLuint; data: PGLint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferParameteri64v = procedure(target: GLenum; pname: GLenum; params: PGLint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTexture = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -// TglFramebufferTextureFace = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint; face: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_3_3 - { OpenGL 3.3 also reuses entry points from these extensions: } - { ARB_blend_func_extended } - { ARB_sampler_objects } - { ARB_explicit_attrib_location, but it has none } - { ARB_occlusion_query2 (no entry points) } - { ARB_shader_bit_encoding (no entry points) } - { ARB_texture_rgb10_a2ui (no entry points) } - { ARB_texture_swizzle (no entry points) } - { ARB_timer_query } - { ARB_vertex_type_2_10_10_10_rev } - TglVertexAttribDivisor = procedure(index: GLuint; divisor: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_4_0 - { OpenGL 4.0 also reuses entry points from these extensions: } - { ARB_texture_query_lod (no entry points) } - { ARB_draw_indirect } - { ARB_gpu_shader5 (no entry points) } - { ARB_gpu_shader_fp64 } - { ARB_shader_subroutine } - { ARB_tessellation_shader } - { ARB_texture_buffer_object_rgb32 (no entry points) } - { ARB_texture_cube_map_array (no entry points) } - { ARB_texture_gather (no entry points) } - { ARB_transform_feedback2 } - { ARB_transform_feedback3 } - TglMinSampleShading = procedure(value: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendEquationi = procedure(buf: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendEquationSeparatei = procedure(buf: GLuint; modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendFunci = procedure(buf: GLuint; src: GLenum; dst: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendFuncSeparatei = procedure(buf: GLuint; srcRGB: GLenum; dstRGB: GLenum; srcAlpha: GLenum; dstAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_VERSION_4_1 - { OpenGL 4.1 also reuses entry points from these extensions: } - { ARB_ES2_compatibility } - { ARB_get_program_binary } - { ARB_separate_shader_objects } - { ARB_shader_precision (no entry points) } - { ARB_vertex_attrib_64bit } - { ARB_viewport_array } - - // GL_3DFX_tbuffer - TglTbufferMask3DFX = procedure(mask: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_APPLE_element_array - TglElementPointerAPPLE = procedure(_type: GLenum; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementArrayAPPLE = procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawRangeElementArrayAPPLE = procedure(mode: GLenum; start: GLuint; _end: GLuint; first: GLint; count: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiDrawElementArrayAPPLE = procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiDrawRangeElementArrayAPPLE = procedure(mode: GLenum; start: GLuint; _end: GLuint; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_APPLE_fence - TglGenFencesAPPLE = procedure(n: GLsizei; fences: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteFencesAPPLE = procedure(n: GLsizei; const fences: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSetFenceAPPLE = procedure(fence: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsFenceAPPLE = function(fence: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTestFenceAPPLE = function(fence: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFinishFenceAPPLE = procedure(fence: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTestObjectAPPLE = function(_object: GLenum; name: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFinishObjectAPPLE = procedure(_object: GLenum; name: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_APPLE_vertex_array_object - TglBindVertexArrayAPPLE = procedure(_array: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteVertexArraysAPPLE = procedure(n: GLsizei; const arrays: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenVertexArraysAPPLE = procedure(n: GLsizei; const arrays: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsVertexArrayAPPLE = function(_array: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_APPLE_vertex_array_range - TglVertexArrayRangeAPPLE = procedure(length: GLsizei; _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFlushVertexArrayRangeAPPLE = procedure(length: GLsizei; _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayParameteriAPPLE = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_APPLE_texture_range - TglTextureRangeAPPLE = procedure(target: GLenum; length: GLsizei; const Pointer_: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexParameterPointervAPPLE = procedure(target: GLenum; pname: GLenum; params: PPGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_APPLE_vertex_program_evaluators - TglEnableVertexAttribAPPLE = procedure(index_: GLuint; pname: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisableVertexAttribAPPLE = procedure(index_: GLuint; pname: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsVertexAttribEnabledAPPLE = function(index_: GLuint; pname: GLenum): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapVertexAttrib1dAPPLE = procedure(index_: GLuint; size: GLuint; u1: GLdouble; u2: GLdouble; stride: GLint; order: GLint; const points: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapVertexAttrib1fAPPLE = procedure(index_: GLuint; size: GLuint; u1: GLfloat; u2: GLfloat; stride: GLint; order: GLint; const points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapVertexAttrib2dAPPLE = procedure(index_: GLuint; size: GLuint; u1: GLdouble; u2: GLdouble; ustride: GLint; uorder: GLint; v1: GLdouble; v2: GLdouble; vstride: GLint; vorder: GLint; const points: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapVertexAttrib2fAPPLE = procedure(index_: GLuint; size: GLuint; u1: GLfloat; u2: GLfloat; ustride: GLint; order: GLint; v1: GLfloat; v2: GLfloat; vstride: GLint; vorder: GLint; const points: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_APPLE_object_purgeable - TglObjectPurgeableAPPLE = function(objectType: GLenum; name: GLuint; option: GLenum): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglObjectUnpurgeableAPPLE = function(objectType: GLenum; name: GLuint; option: GLenum): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetObjectParameterivAPPLE = procedure(objectType: GLenum; name: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_matrix_palette - TglCurrentPaletteMatrixARB = procedure(index: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixIndexubvARB = procedure(size: GLint; const indices: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixIndexusvARB = procedure(size: GLint; const indices: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixIndexuivARB = procedure(size: GLint; const indices: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixIndexPointerARB = procedure(size: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_multisample - TglSampleCoverageARB = procedure(value: GLclampf; invert: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_multitexture - TglActiveTextureARB = procedure(texture: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClientActiveTextureARB = procedure(texture: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1dARB = procedure(target: GLenum; s: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1dvARB = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1fARB = procedure(target: GLenum; s: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1fvARB = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1iARB = procedure(target: GLenum; s: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1ivARB = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1sARB = procedure(target: GLenum; s: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1svARB = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2dARB = procedure(target: GLenum; s: GLdouble; t: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2dvARB = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2fARB = procedure(target: GLenum; s: GLfloat; t: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2fvARB = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2iARB = procedure(target: GLenum; s: GLint; t: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2ivARB = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2sARB = procedure(target: GLenum; s: GLshort; t: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2svARB = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3dARB = procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3dvARB = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3fARB = procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3fvARB = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3iARB = procedure(target: GLenum; s: GLint; t: GLint; r: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3ivARB = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3sARB = procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3svARB = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4dARB = procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble; q: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4dvARB = procedure(target: GLenum; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4fARB = procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat; q: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4fvARB = procedure(target: GLenum; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4iARB = procedure(target: GLenum; s: GLint; t: GLint; r: GLint; q: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4ivARB = procedure(target: GLenum; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4sARB = procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort; q: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4svARB = procedure(target: GLenum; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_point_parameters - TglPointParameterfARB = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameterfvARB = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_texture_compression - TglCompressedTexImage3DARB = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexImage2DARB = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexImage1DARB = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexSubImage3DARB = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexSubImage2DARB = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTexSubImage1DARB = procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCompressedTexImageARB = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_transpose_matrix - TglLoadTransposeMatrixfARB = procedure(const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadTransposeMatrixdARB = procedure(const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultTransposeMatrixfARB = procedure(const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultTransposeMatrixdARB = procedure(const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_blend - TglWeightbvARB = procedure(size: GLint; const weights: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightsvARB = procedure(size: GLint; const weights: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightivARB = procedure(size: GLint; const weights: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightfvARB = procedure(size: GLint; const weights: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightdvARB = procedure(size: GLint; const weights: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightubvARB = procedure(size: GLint; const weights: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightusvARB = procedure(size: GLint; const weights: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightuivARB = procedure(size: GLint; const weights: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightPointerARB = procedure(size: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexBlendARB = procedure(count: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_buffer_object - TglBindBufferARB = procedure(target: GLenum; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteBuffersARB = procedure(n: GLsizei; const buffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenBuffersARB = procedure(n: GLsizei; buffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsBufferARB = function(buffer: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBufferDataARB = procedure(target: GLenum; size: GLsizeiptrARB; const data: PGLvoid; usage: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBufferSubDataARB = procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferSubDataARB = procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapBufferARB = function(target: GLenum; access: GLenum): PGLvoid; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUnmapBufferARB = function(target: GLenum): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferParameterivARB = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferPointervARB = procedure(target: GLenum; pname: GLenum; params: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_program - TglVertexAttrib1dARB = procedure(index: GLuint; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1dvARB = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1fARB = procedure(index: GLuint; x: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1fvARB = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1sARB = procedure(index: GLuint; x: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1svARB = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2dARB = procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2dvARB = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2fARB = procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2fvARB = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2sARB = procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2svARB = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3dARB = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3dvARB = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3fARB = procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3fvARB = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3sARB = procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3svARB = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4NbvARB = procedure(index: GLuint; const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4NivARB = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4NsvARB = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4NubARB = procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4NubvARB = procedure(index: GLuint; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4NuivARB = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4NusvARB = procedure(index: GLuint; const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4bvARB = procedure(index: GLuint; const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4dARB = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4dvARB = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4fARB = procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4fvARB = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4ivARB = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4sARB = procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4svARB = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4ubvARB = procedure(index: GLuint; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4uivARB = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4usvARB = procedure(index: GLuint; const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribPointerARB = procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnableVertexAttribArrayARB = procedure(index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisableVertexAttribArrayARB = procedure(index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramStringARB = procedure(target: GLenum; format: GLenum; len: GLsizei; const _string: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindProgramARB = procedure(target: GLenum; _program: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteProgramsARB = procedure(n: GLsizei; const programs: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenProgramsARB = procedure(n: GLsizei; programs: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameter4dARB = procedure(target: GLenum; index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameter4dvARB = procedure(target: GLenum; index: GLuint; const params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameter4fARB = procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameter4fvARB = procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameter4dARB = procedure(target: GLenum; index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameter4dvARB = procedure(target: GLenum; index: GLuint; const params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameter4fARB = procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameter4fvARB = procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramEnvParameterdvARB = procedure(target: GLenum; index: GLuint; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramEnvParameterfvARB = procedure(target: GLenum; index: GLuint; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramLocalParameterdvARB = procedure(target: GLenum; index: GLuint; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramLocalParameterfvARB = procedure(target: GLenum; index: GLuint; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramivARB = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramStringARB = procedure(target: GLenum; pname: GLenum; _string: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribdvARB = procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribfvARB = procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribivARB = procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribPointervARB = procedure(index: GLuint; pname: GLenum; _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsProgramARB = function(_program: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_window_pos - TglWindowPos2dARB = procedure(x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2dvARB = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2fARB = procedure(x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2fvARB = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2iARB = procedure(x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2ivARB = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2sARB = procedure(x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2svARB = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3dARB = procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3dvARB = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3fARB = procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3fvARB = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3iARB = procedure(x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3ivARB = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3sARB = procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3svARB = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_draw_buffers - TglDrawBuffersARB = procedure(n: GLsizei; bufs: PGLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_color_buffer_float - TglClampColorARB = procedure(target: GLenum; clamp: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_shader - TglGetActiveAttribARB = procedure(programobj: GLhandleARB; index: GLuint; maxLength: GLsizei; var length: GLsizei; var size: GLint; var _type: GLenum; name: PGLcharARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetAttribLocationARB = function(programObj: GLhandleARB; const char: PGLcharARB): glint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindAttribLocationARB = procedure(programObj: GLhandleARB; index: GLuint; const name: PGLcharARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_shader_objects - TglDeleteObjectARB = procedure(Obj: GLHandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetHandleARB = function(pname: GlEnum): GLHandleARB; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDetachObjectARB = procedure(container, attached: GLHandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCreateShaderObjectARB = function(shaderType: glenum): GLHandleARB; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglShaderSourceARB = procedure(shaderObj: GLHandleARB; count: glsizei; const _string: PPGLCharARB; lengths: pglint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompileShaderARB = procedure(shaderObj: GLHandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCreateProgramObjectARB = function: GLHandleARB; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglAttachObjectARB = procedure(programObj, shaderObj: GLhandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLinkProgramARB = procedure(programObj: GLHandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUseProgramObjectARB = procedure(programObj: GLHandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglValidateProgramARB = procedure(programObj: GLhandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1fARB = procedure(location: glint; v0: glfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2fARB = procedure(location: glint; v0, v1: glfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3fARB = procedure(location: glint; v0, v1, v2: glfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4fARB = procedure(location: glint; v0, v1, v2, v3: glfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1iARB = procedure(location: glint; v0: glint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2iARB = procedure(location: glint; v0, v1: glint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3iARB = procedure(location: glint; v0, v1, v2: glint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4iARB = procedure(location: glint; v0, v1, v2, v3: glint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1fvARB = procedure(location: glint; count: GLsizei; value: pglfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2fvARB = procedure(location: glint; count: GLsizei; value: pglfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3fvARB = procedure(location: glint; count: GLsizei; value: pglfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4fvARB = procedure(location: glint; count: GLsizei; value: pglfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1ivARB = procedure(location: glint; count: GLsizei; value: pglint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2ivARB = procedure(location: glint; count: GLsizei; value: pglint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3ivARB = procedure(location: glint; count: GLsizei; value: pglint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4ivARB = procedure(location: glint; count: GLsizei; value: pglint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix2fvARB = procedure(location: glint; count: glsizei; transpose: glboolean; value: pglfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix3fvARB = procedure(location: glint; count: glsizei; transpose: glboolean; value: pglfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix4fvARB = procedure(location: glint; count: glsizei; transpose: glboolean; value: pglfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetObjectParameterfvARB = procedure(Obj: GLHandleARB; pname: GLEnum; params: PGLFloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetObjectParameterivARB = procedure(Obj: GLHandleARB; pname: GLEnum; params: PGLInt); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetInfoLogARB = procedure(shaderObj: GLHandleARB; maxLength: glsizei; var length: glint; infoLog: PGLcharARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetAttachedObjectsARB = procedure(programobj: GLhandleARB; maxCount: GLsizei; var count: GLsizei; objects: PGLhandleARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformLocationARB = function(programObj: GLhandleARB; const char: PGLcharARB): glint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveUniformARB = procedure(programobj: GLhandleARB; index: GLuint; maxLength: GLsizei; var length: GLsizei; var size: GLint; var _type: GLenum; name: PGLcharARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformfvARB = procedure(programObj: GLhandleARB; location: GLint; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformivARB = procedure(programObj: GLhandleARB; location: GLint; params: PGLInt); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetShaderSourceARB = procedure(shader: GLhandleARB; maxLength: GLsizei; var length: GLsizei; source: PGLcharARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_Occlusion_Query - TglGenQueriesARB = procedure(n: GLsizei; ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteQueriesARB = procedure(n: GLsizei; const ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsQueryARB = function(id: GLuint): boolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginQueryARB = procedure(target: GLenum; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndQueryARB = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryivARB = procedure(target, pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryObjectivARB = procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryObjectuivARB = procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_draw_instanced - TglDrawArraysInstancedARB = procedure(mode: GLenum; first: GLint; count: GLsizei; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementsInstancedARB = procedure(mode: GLenum; count: GLsizei; type_: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_framebuffer_object - TglIsRenderbuffer = function(renderbuffer: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindRenderbuffer = procedure(target: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteRenderbuffers = procedure(n: GLsizei; const renderbuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenRenderbuffers = procedure(n: GLsizei; renderbuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRenderbufferStorage = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetRenderbufferParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsFramebuffer = function(framebuffer: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindFramebuffer = procedure(target: GLenum; framebuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteFramebuffers = procedure(n: GLsizei; const framebuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenFramebuffers = procedure(n: GLsizei; framebuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCheckFramebufferStatus = function(target: GLenum): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTexture1D = procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTexture2D = procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTexture3D = procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint; zoffset: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferRenderbuffer = procedure(target: GLenum; attachment: GLenum; renderbuffertarget: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFramebufferAttachmentParameteriv = procedure(target: GLenum; attachment: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenerateMipmap = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlitFramebuffer = procedure(srcX0: GLint; srcY0: GLint; srcX1: GLint; srcY1: GLint; dstX0: GLint; dstY0: GLint; dstX1: GLint; dstY1: GLint; mask: GLbitfield; filter: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRenderbufferStorageMultisample = procedure(target: GLenum; samples: GLsizei; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTextureLayer = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint; layer: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_geometry_shader4 - TglProgramParameteriARB = procedure(program_: GLuint; pname: GLenum; value: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTextureARB = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTextureLayerARB = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint; layer: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTextureFaceARB = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint; face: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_instanced_arrays - TglVertexAttribDivisorARB = procedure(index_: GLuint; divisor: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_map_buffer_range - TglMapBufferRange = function(target: GLenum; offset: GLintptr; length: GLsizeiptr; access: GLbitfield): PGLvoid; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFlushMappedBufferRange = procedure(target: GLenum; offset: GLintptr; length: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_texture_buffer_object - TglTexBufferARB = procedure(target: GLenum; internalformat: GLenum; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_array_object - TglBindVertexArray = procedure(array_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteVertexArrays = procedure(n: GLsizei; const arrays: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenVertexArrays = procedure(n: GLsizei; arrays: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsVertexArray = function(array_: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_uniform_buffer_object - TglGetUniformIndices = procedure(program_: GLuint; uniformCount: GLsizei; const uniformNames: PPGLchar; uniformIndices: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveUniformsiv = procedure(program_: GLuint; uniformCount: GLsizei; const uniformIndices: PGLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveUniformName = procedure(program_: GLuint; uniformIndex: GLuint; bufSize: GLsizei; length: PGLsizei; uniformName: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformBlockIndex = function(program_: GLuint; const uniformBlockName: PGLchar): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveUniformBlockiv = procedure(program_: GLuint; uniformBlockIndex: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveUniformBlockName = procedure(program_: GLuint; uniformBlockIndex: GLuint; bufSize: GLsizei; length: PGLsizei; uniformBlockName: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformBlockBinding = procedure(program_: GLuint; uniformBlockIndex: GLuint; uniformBlockBinding: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_copy_buffer - TglCopyBufferSubData = procedure(readTarget: GLenum; writeTarget: GLenum; readOffset: GLintptr; writeOffset: GLintptr; size: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_draw_elements_base_vertex - TglDrawElementsBaseVertex = procedure(mode: GLenum; count: GLsizei; type_: GLenum; const indices: PGLvoid; basevertex: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawRangeElementsBaseVertex = procedure(mode: GLenum; start: GLuint; end_: GLuint; count: GLsizei; type_: GLenum; const indices: PGLvoid; basevertex: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementsInstancedBaseVertex = procedure(mode: GLenum; count: GLsizei; type_: GLenum; const indices: PGLvoid; primcount: GLsizei; basevertex: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiDrawElementsBaseVertex = procedure(mode: GLenum; const count: PGLsizei; type_: GLenum; const indices: PPGLvoid; primcount: GLsizei; const basevertex: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_provoking_vertex - TglProvokingVertex = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_sync - TglFenceSync = function(condition: GLenum; flags: GLbitfield): GLsync; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsSync = function(sync: GLsync): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteSync = procedure(sync: GLsync); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClientWaitSync = function(sync: GLsync; flags: GLbitfield; timeout: GLuint64): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWaitSync = procedure(sync: GLsync; flags: GLbitfield; timeout: GLuint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetInteger64v = procedure(pname: GLenum; params: PGLint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSynciv = procedure(sync: GLsync; pname: GLenum; butSize: GLsizei; length: PGLsizei; values: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_texture_multisample - TglTexImage2DMultisample = procedure(target: GLenum; samples: GLsizei; internalformat: GLint; width: GLsizei; height: GLsizei; fixedsamplelocations: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexImage3DMultisample = procedure(target: GLenum; samples: GLsizei; internalformat: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; fixedsamplelocations: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultisamplefv = procedure(pname: GLenum; index_: GLuint; val: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSampleMaski = procedure(index_: GLuint; mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_draw_buffers_blend - TglBlendEquationiARB = procedure(buf: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendEquationSeparateiARB = procedure(buf: GLuint; modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendFunciARB = procedure(buf: GLuint; src: GLenum; dst: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendFuncSeparateiARB = procedure(buf: GLuint; srcRGB: GLenum; dstRGB: GLenum; srcAlpha: GLenum; dstAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_sample_shading - TglMinSampleShadingARB = procedure(value: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_shading_language_include - TglNamedStringARB = procedure(type_: GLenum; namelen: GLint; const name: PGLchar; stringlen: GLint; const string_: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteNamedStringARB = procedure(namelen: GLint; const name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompileShaderIncludeARB = procedure (shader: GLuint; count: GLsizei; const path: PPGLchar; const length: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsNamedStringARB = function(namelen: GLint; const name: PGLchar): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedStringARB = procedure(namelen: GLint; const name: PGLchar; bufSize: GLsizei; stringlen: GLint; string_: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedStringivARB = procedure(namelen: GLint; const name: PGLchar; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_blend_func_extended - TglBindFragDataLocationIndexed = procedure(program_: GLuint; colorNumber: GLuint; index: GLuint; const name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFragDataIndex = function(program_: GLuint; const name: PGLchar): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_sampler_objects - TglGenSamplers = procedure(count: GLsizei; samplers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteSamplers = procedure(count: GLsizei; const samplers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsSampler = function(sampler: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindSampler = procedure(unit_: GLuint; sampler: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplerParameteri = procedure(sampler: GLuint; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplerParameteriv = procedure(sampler: GLuint; pname: GLenum; const param: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplerParameterf = procedure(sampler: GLuint; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplerParameterfv = procedure(sampler: GLuint; pname: GLenum; const param: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplerParameterIiv = procedure(sampler: GLuint; pname: GLenum; const param: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplerParameterIuiv = procedure(sampler: GLuint; pname: GLenum; const param: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSamplerParameteriv = procedure(sampler: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSamplerParameterIiv = procedure(sampler: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSamplerParameterfv = procedure(sampler: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSamplerParameterIuiv = procedure(sampler: GLuint; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_timer_query - TglQueryCounter = procedure(id: GLuint; target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryObjecti64v = procedure(id: GLuint; pname: GLenum; params: PGLint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryObjectui64v = procedure(id: GLuint; pname: GLenum; params: PGLuint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_type_2_10_10_10_rev - TglVertexP2ui = procedure(type_: GLenum; value: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexP2uiv = procedure(type_: GLenum; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexP3ui = procedure(type_: GLenum; value: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexP3uiv = procedure(type_: GLenum; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexP4ui = procedure(type_: GLenum; value: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexP4uiv = procedure(type_: GLenum; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP1ui = procedure(type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP1uiv = procedure(type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP2ui = procedure(type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP2uiv = procedure(type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP3ui = procedure(type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP3uiv = procedure(type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP4ui = procedure(type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordP4uiv = procedure(type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP1ui = procedure(texture: GLenum; type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP1uiv = procedure(texture: GLenum; type_: GLenum; const coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP2ui = procedure(texture: GLenum; type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP2uiv = procedure(texture: GLenum; type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP3ui = procedure(texture: GLenum; type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP3uiv = procedure(texture: GLenum; type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP4ui = procedure(texture: GLenum; type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordP4uiv = procedure(texture: GLenum; type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalP3ui = procedure(type_: GLenum; coords: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalP3uiv = procedure(type_: GLenum; const coords: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorP3ui = procedure(type_: GLenum; color: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorP3uiv = procedure(type_: GLenum; const color: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorP4ui = procedure(type_: GLenum; color: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorP4uiv = procedure(type_: GLenum; const color: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColorP3ui = procedure(type_: GLenum; color: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColorP3uiv = procedure(type_: GLenum; const color: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP1ui = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; value: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP1uiv = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP2ui = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; value: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP2uiv = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP3ui = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; value: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP3uiv = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP4ui = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; value: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribP4uiv = procedure(index: GLuint; type_: GLenum; normalized: GLboolean; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_draw_indirect - TglDrawArraysIndirect = procedure(mode: GLenum; const indirect: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementsIndirect = procedure(mode: GLenum; type_: GLenum; const indirect: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_gpu_shader_fp64 - TglUniform1d = procedure(location: GLint; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2d = procedure(location: GLint; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3d = procedure(location: GLint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4d = procedure(location: GLint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1dv = procedure(location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2dv = procedure(location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3dv = procedure(location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4dv = procedure(location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix2dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix3dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix4dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix2x3dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix2x4dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix3x2dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix3x4dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix4x2dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformMatrix4x3dv = procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformdv = procedure(program_: GLuint; location: GLint; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_shader_subroutine - TglGetSubroutineUniformLocation = function(program_: GLuint; shadertype: GLenum; const name: PGLchar): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSubroutineIndex = function(program_: GLuint; shadertype: GLenum; const name: PGLchar): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveSubroutineUniformiv = procedure(program_: GLuint; shadertype: GLenum; index: GLuint; pname: GLenum; values: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveSubroutineUniformName = procedure(program_: GLuint; shadertype: GLenum; index: GLuint; bufsize: GLsizei; length: PGLsizei; name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveSubroutineName = procedure(program_: GLuint; shadertype: GLenum; index: GLuint; bufsize: GLsizei; length: PGLsizei; name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformSubroutinesuiv = procedure(shadertype: GLenum; count: GLsizei; const indices: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformSubroutineuiv = procedure(shadertype: GLenum; location: GLint; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramStageiv = procedure(program_: GLuint; shadertype: GLenum; pname: GLenum; values: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_tessellation_shader - TglPatchParameteri = procedure(pname: GLenum; value: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPatchParameterfv = procedure(pname: GLenum; const values: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_transform_feedback2 - TglBindTransformFeedback = procedure(target: GLenum; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteTransformFeedbacks = procedure(n: GLsizei; const ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenTransformFeedbacks = procedure(n: GLsizei; ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsTransformFeedback = function(id: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPauseTransformFeedback = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglResumeTransformFeedback = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawTransformFeedback = procedure(mode: GLenum; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_transform_feedback3 - TglDrawTransformFeedbackStream = procedure(mode: GLenum; id: GLuint; stream: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginQueryIndexed = procedure(target: GLenum; index: GLuint; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndQueryIndexed = procedure(target: GLenum; index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryIndexediv = procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_ES2_compatibility - TglReleaseShaderCompiler = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglShaderBinary = procedure(count: GLsizei; const shaders: PGLuint; binaryformat: GLenum; const binary: PGLvoid; length: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetShaderPrecisionFormat = procedure(shadertype: GLenum; precisiontype: GLenum; range: PGLint; precision: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDepthRangef = procedure(n: GLclampf; f: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearDepthf = procedure(d: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_get_program_binary - TglGetProgramBinary = procedure(program_: GLuint; bufSize: GLsizei; length: PGLsizei; binaryFormat: PGLenum; binary: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramBinary = procedure(program_: GLuint; binaryFormat: GLenum; const binary: PGLvoid; length: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramParameteri = procedure(program_: GLuint; pname: GLenum; value: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_separate_shader_objects - TglUseProgramStages = procedure(pipeline: GLuint; stages: GLbitfield; program_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglActiveShaderProgram = procedure(pipeline: GLuint; program_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCreateShaderProgramv = function(type_: GLenum; count: GLsizei; const strings: PPGLchar): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindProgramPipeline = procedure(pipeline: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteProgramPipelines = procedure(n: GLsizei; const pipelines: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenProgramPipelines = procedure(n: GLsizei; pipelines: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsProgramPipeline = function(pipeline: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramPipelineiv = procedure(pipeline: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1i = procedure(program_: GLuint; location: GLint; v0: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1iv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1f = procedure(program_: GLuint; location: GLint; v0: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1fv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1d = procedure(program_: GLuint; location: GLint; v0: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1dv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1ui = procedure(program_: GLuint; location: GLint; v0: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1uiv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2i = procedure(program_: GLuint; location: GLint; v0: GLint; v1: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2iv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2f = procedure(program_: GLuint; location: GLint; v0: GLfloat; v1: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2fv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2d = procedure(program_: GLuint; location: GLint; v0: GLdouble; v1: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2dv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2ui = procedure(program_: GLuint; location: GLint; v0: GLuint; v1: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2uiv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3i = procedure(program_: GLuint; location: GLint; v0: GLint; v1: GLint; v2: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3iv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3f = procedure(program_: GLuint; location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3fv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3d = procedure(program_: GLuint; location: GLint; v0: GLdouble; v1: GLdouble; v2: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3dv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3ui = procedure(program_: GLuint; location: GLint; v0: GLuint; v1: GLuint; v2: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3uiv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4i = procedure(program_: GLuint; location: GLint; v0: GLint; v1: GLint; v2: GLint; v3: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4iv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4f = procedure(program_: GLuint; location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat; v3: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4fv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4d = procedure(program_: GLuint; location: GLint; v0: GLdouble; v1: GLdouble; v2: GLdouble; v3: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4dv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4ui = procedure(program_: GLuint; location: GLint; v0: GLuint; v1: GLuint; v2: GLuint; v3: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4uiv = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x3fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x2fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x4fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x2fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x4fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x3fv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x3dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x2dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x4dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x2dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x4dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x3dv = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglValidateProgramPipeline = procedure(pipeline: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramPipelineInfoLog = procedure(pipeline: GLuint; bufSize: GLsizei; length: PGLsizei; infoLog: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_attrib_64bit - TglVertexAttribL1d = procedure(index: GLuint; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2d = procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3d = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4d = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL1dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4dv = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribLPointer = procedure(index: GLuint; size: GLint; type_: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribLdv = procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_viewport_array - TglViewportArrayv = procedure(first: GLuint; count: GLsizei; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglViewportIndexedf = procedure(index: GLuint; x: GLfloat; y: GLfloat; w: GLfloat; h: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglViewportIndexedfv = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglScissorArrayv = procedure(first: GLuint; count: GLsizei; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglScissorIndexed = procedure(index: GLuint; left: GLint; bottom: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglScissorIndexedv = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDepthRangeArrayv = procedure(first: GLuint; count: GLsizei; const v: PGLclampd); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDepthRangeIndexed = procedure(index: GLuint; n: GLclampd; f: GLclampd); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFloati_v = procedure(target: GLenum; index: GLuint; data: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetDoublei_v = procedure(target: GLenum; index: GLuint; data: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL 4.2 - - // GL_ARB_base_instance - TglDrawArraysInstancedBaseInstance = procedure(mode : GLenum; first : GLint; count :GLsizei; primcount : GLsizei; baseinstance : GLUint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementsInstancedBaseInstance = procedure(mode : GLEnum; count : GLsizei; _type : GLenum; const indices : PGLVoid; primcount : GLsizei; baseinstance : GLUInt); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementsInstancedBaseVertexBaseInstance = procedure(mode : GLEnum; count : GLsizei; _type : GLenum; const indices : PGLVoid; primcount :GLsizei; basevertex : GLint; baseinstance : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_transform_feedback_instanced - TglDrawTransformFeedbackInstanced = procedure(mode : GLenum; id : GLuint; primcount : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawTransformFeedbackStreamInstanced = procedure(mode : GLenum; id : GLUInt; stream : GLUint; primcount : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_internalformat_query - TglGetInternalformativ = procedure(target : GLenum; internalformat : GLenum; pname : GLenum; bufSize : GLsizei; params : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_shader_atomic_counters - TglGetActiveAtomicCounterBufferiv = procedure(_program : GLuint; bufferIndex : GLuint; pname : GLenum; params : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - /// GL_ARB_shader_image_load_store - TglBindImageTexture = procedure(_unit : GLuint; texture : GLuint; level :GLint; layered : GLboolean; layer : GLint; access : GLenum; format : GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMemoryBarrier = procedure(barriers : GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_texture_storage - TglTexStorage1D = procedure(target : GLenum; levels :GLsizei; internalformat : GLenum; width : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexStorage2D = procedure(target : GLenum; levels :GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexStorage3D = procedure(target : GLenum; levels :GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei; depth : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureStorage1DEXT = procedure(texture : GLuint; target : GLenum; levels :GLsizei; internalformat : GLenum; width : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureStorage2DEXT = procedure(texture : GLuint; target : GLenum; levels :GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureStorage3DEXT = procedure(texture : GLuint; target : GLenum; levels :GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei; depth : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - - // GL 4.3 - - // GL_KHR_debug - TglDebugMessageControl = procedure(source : GLenum; type_ : GLenum; severity : TGLenum; count : GLsizei; const ids : PGLUInt; enabled : GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDebugMessageInsert = procedure(source : GLenum; type_ : GLenum; id : GLuint; sverity : GLenum; length : GLsizei; const buf : PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDebugMessageCallback = procedure(callback : TGLDEBUGPROC; const userParam : Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetDebugMessageLog = function(count : GLuint; bufsize : GLsizei; sources : PGLenum; types : PGLenum; ids : PGLuint; sverities : PGLenum; lengths : PGLSizei; messagelog : PGLchar) : GLUInt; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPushDebugGroup = procedure(source : GLenum; id : GLuint; length : GLsizei; const message_ : PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPopDebugGroup = procedure; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglObjectLabel = procedure(identifier : GLenum; name : GLuint; length : GLsizei; const label_ : PGLCHar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetObjectLabel = procedure(identifier : GLenum; name : GLuint; bufsize : GLsizei; length : PGLsizei; label_ : PGLCHar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglObjectPtrLabel = procedure(const ptr : Pointer; length : GLsizei; const label_ : PGLCHar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetObjectPtrLabel = procedure(const ptr : Pointer; bufSize : GLsizei; length : PGLsizei; label_ : PGLCHar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - - // GL_ARB_clear_buffer_object - TglClearBufferData = procedure(target : GLenum; internalformat : GLenum; format : GLEnum; type_ : GLEnum; const data : Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearBufferSubData = procedure(target : GLenum; internalformat : GLenum; offset : GLintptr; size : GLsizeiptr; format : GLenum; type_ : GLenum; const data : Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearNamedBufferDataEXT = procedure(buffer : GLuint; internalformat : GLenum; format : GLEnum; type_ : GLEnum; const data : Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearNamedBufferSubDataEXT = procedure(buffer : GLuint; internalformat : GLenum; format : GLenum; type_ : GLenum; offset : GLsizeiptr; size : GLsizeiptr; const data : Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_compute_shader 1 - TglDispatchCompute = procedure(num_groups_x : GLuint; num_groups_y : GLuint; num_groups_z : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDispatchComputeIndirect = procedure(indirect : GLintptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_copy_image - TglCopyImageSubData = procedure(srcName : GLUInt; srcTarget : GLenum; srcLevel : GLint; srcX : GLint; srcY : GLint; srcZ : GLint; dstName : GLUInt; dstTarget : GLEnum; dstLevel : GLInt; dstX : GLInt; dstY : GLint; dstZ : GLint; srcWidth : GLsizei; srcHeight : GLsizei; srcDepth : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_debug_group - // ARB_debug_group reuses entry points from KHR_debug - - // GL_ARB_debug_label - // ARB_debug_label reuses entry points from KHR_debug - - // GL_ARB_debug_output2 - - // GL_ARB_ES3_compatibility - - // GL_ARB_explicit_uniform_location - - // GL_ARB_fragment_layer_viewport - - // GL_ARB_framebuffer_no_attachments - TglFramebufferParameteri = procedure(target : GLenum; pname : GLenum; param : GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFramebufferParameteriv = procedure(target : GLenum; pname : GLenum; params : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferParameteriEXT = procedure(framebuffer : GLUInt; pname : GLenum; param : GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedFramebufferParameterivEXT = procedure(framebuffer : GLUInt; pname : GLenum; param : GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_internalformat_query2 - TglGetInternalformati64v = procedure(target : GLenum; internalformat : GLenum; pname : GLenum; bufSize : GLsizei; params : PGLint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_invalidate_subdata - TglInvalidateTexSubImage = procedure(texture : GLuint; level : GLint; xoffset : GLint; yoffset : GLint; zoffset : GLint; width : GLsizei; height : GLsizei; depth : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInvalidateTexImage = procedure(texture : GLuint; level : GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInvalidateBufferSubData = procedure(buffer : GLuint; offset : GLintptr; length : GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInvalidateBufferData = procedure(buffer : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInvalidateFramebuffer = procedure(target : GLenum; numAttachments : GLsizei; const attachments : PGLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInvalidateSubFramebuffer = procedure(target : GLenum; numAttachments : GLsizei; const attachments : PGLenum; x : GLint; y : GLint; width : GLsizei; height : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_multi_draw_indirect - TglMultiDrawArraysIndirect = procedure(mode : GLenum; const indirect : Pointer; drawcount : GLsizei; stride : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiDrawElementsIndirect = procedure(mode : GLenum; type_ : GLenum; const indirect : Pointer; drawcount : GLsizei; stride : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_program_interface_query - TglGetProgramInterfaceiv = procedure(program_ : GLUInt;programInterface : GLenum; pname : GLenum; params : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramResourceIndex = function(program_ : GLUInt;programInterface : GLenum; const name : PGLchar) : GLUInt; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramResourceName = procedure(program_ : GLUInt;programInterface : GLenum; index : GLuint; bufSize : GLsizei; length : PGLsizei; name : PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramResourceiv = procedure(program_ : GLUInt;programInterface : GLenum; index : GLuint; propCount : GLsizei; const props : PGLenum; bufSize : GLsizei; length : PGLsizei; params : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramResourceLocation = function(program_ : GLUInt;programInterface : GLenum; const name : PGLchar) : GLInt; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramResourceLocationIndex = function(program_ : GLUInt;programInterface : GLenum; const name : PGLchar) : GLInt; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_robust_buffer_access_behavior - - // GL_ARB_shader_image_size - - // GL_ARB_shader_storage_buffer_object - TglShaderStorageBlockBinding = procedure(program_ : GLuint; storageBlockIndex : GLuint; storageBlockBinding : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_stencil_texturing - - // GL_ARB_texture_buffer_range - TglTexBufferRange = procedure(target : GLenum; internalformat : GLenum; buffer : GLuint; offset :GLintptr; size : GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureBufferRangeEXT = procedure(texture : GLuint; target : GLenum; internalformat : GLenum; buffer : GLuint; offset : GLintptr; size : GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_texture_query_levels - - // GL_ARB_texture_storage_multisample - TglTexStorage2DMultisample = procedure(target : GLenum; samples : GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei; fixedsamplelocations : GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexStorage3DMultisample = procedure(target : GLenum; samples : GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei; depth : GLsizei; fixedsamplelocations : GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureStorage2DMultisampleEXT = procedure(texture : GLuint; target : GLenum; samples : GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei; fixedsamplelocations : GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureStorage3DMultisampleEXT = procedure(texture : GLuint; target : GLenum; samples : GLsizei; internalformat : GLenum; width : GLsizei; height : GLsizei; depth : GLsizei; fixedsamplelocations : GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_texture_view - TglTextureView = procedure(texture : GLuint; target : GLenum; origtexture : GLuint; internalformat : GLenum; minlevel : GLuint; numlevels : GLuint; minlayer : GLuint; numlayers : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_vertex_attrib_binding - TglBindVertexBuffer = procedure(bindingindex : GLuint; buffer : GLuint; offset : GLintptr; stride : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribFormat = procedure(attribindex : GLuint; size : GLInt; type_ : GLEnum; normalized : GLboolean; relativeoffset : GLUint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribIFormat = procedure(attribindex : GLuint; size : GLInt; type_ : GLEnum; relativeoffset : GLUint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribLFormat = procedure(attribindex : GLuint; size : GLInt; type_ : GLEnum; relativeoffset : GLUint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribBinding = procedure(attribindex : GLuint; bindingindex : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexBindingDivisor = procedure(bindingindex : GLuint; divisor : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayBindVertexBufferEXT = procedure(vaobj : GLuint; bindingindex : GLuint; buffer : GLuint; offset : GLintptr; stride : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayVertexAttribFormatEXT = procedure(vaobj : GLuint; attribindex : GLuint; size : GLInt; type_ : GLEnum; normalized : GLboolean; relativeoffset : GLUint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayVertexAttribIFormatEXT = procedure(vaobj : GLuint; attribindex : GLuint; size : GLInt; type_ : GLEnum; relativeoffset : GLUint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayVertexAttribLFormatEXT = procedure(vaobj : GLuint; attribindex : GLuint; size : GLInt; type_ : GLEnum; relativeoffset : GLUint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayVertexAttribBindingEXT = procedure(vaobj : GLuint; attribindex : GLuint; bindingindex : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayVertexBindingDivisorEXT = procedure(vaobj : GLuint; bindingindex : GLuint; divisor : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_robustness_isolation - - // - - // GL_ARB_cl_event - TglCreateSyncFromCLeventARB = function(context: p_cl_context; event: p_cl_event; flags: GLbitfield): GLsync; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_debug_output - TglDebugMessageControlARB = procedure(source: GLenum; type_: GLenum; severity: GLenum; count: GLsizei; const ids: PGLuint; enabled: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDebugMessageInsertARB = procedure(source: GLenum; type_: GLenum; id: GLuint; severity: GLenum; length: GLsizei; const buf: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDebugMessageCallbackARB = procedure(callback: TglDebugProcARB; const userParam: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetDebugMessageLogARB = function(count: GLuint; bufsize: GLsizei; sources: PGLenum; types: PGLenum; ids: PGLuint; severities: PGLenum; lengths: PGLsizei; messageLog: PGLchar): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ARB_robustness - TglGetGraphicsResetStatusARB = function(): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnMapdvARB = procedure(target: GLenum; query: GLenum; bufSize: GLsizei; v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnMapfvARB = procedure(target: GLenum; query: GLenum; bufSize: GLsizei; v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnMapivARB = procedure(target: GLenum; query: GLenum; bufSize: GLsizei; v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnPixelMapfvARB = procedure(map: GLenum; bufSize: GLsizei; values: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnPixelMapuivARB = procedure(map: GLenum; bufSize: GLsizei; values: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnPixelMapusvARB = procedure(map: GLenum; bufSize: GLsizei; values: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnPolygonStippleARB = procedure(bufSize: GLsizei; pattern: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnColorTableARB = procedure(target: GLenum; format: GLenum; type_: GLenum; bufSize: GLsizei; table: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnConvolutionFilterARB = procedure(target: GLenum; format: GLenum; type_: GLenum; bufSize: GLsizei; image: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnSeparableFilterARB = procedure(target: GLenum; format: GLenum; type_: GLenum; rowBufSize: GLsizei; row: PGLvoid; columnBufSize: GLsizei; column: PGLvoid; span: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnHistogramARB = procedure(target: GLenum; reset: GLboolean; format: GLenum; type_: GLenum; bufSize: GLsizei; values: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnMinmaxARB = procedure(target: GLenum; reset: GLboolean; format: GLenum; type_: GLenum; bufSize: GLsizei; values: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnTexImageARB = procedure(target: GLenum; level: GLint; format: GLenum; type_: GLenum; bufSize: GLsizei; img: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReadnPixelsARB = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; type_: GLenum; bufSize: GLsizei; data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnCompressedTexImageARB = procedure(target: GLenum; lod: GLint; bufSize: GLsizei; img: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnUniformfvARB = procedure(program_: GLuint; location: GLint; bufSize: GLsizei; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnUniformivARB = procedure(program_: GLuint; location: GLint; bufSize: GLsizei; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnUniformuivARB = procedure(program_: GLuint; location: GLint; bufSize: GLsizei; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetnUniformdvARB = procedure(program_: GLuint; location: GLint; bufSize: GLsizei; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_draw_buffers - TglDrawBuffersATI = procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_element_array - TglElementPointerATI = procedure(_type: GLenum; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementArrayATI = procedure(mode: GLenum; count: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawRangeElementArrayATI = procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_envmap_bumpmap - TglTexBumpParameterivATI = procedure(pname: GLenum; const param: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexBumpParameterfvATI = procedure(pname: GLenum; const param: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexBumpParameterivATI = procedure(pname: GLenum; param: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexBumpParameterfvATI = procedure(pname: GLenum; param: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_fragment_shader - TglGenFragmentShadersATI = function(range: GLuint): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindFragmentShaderATI = procedure(id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteFragmentShaderATI = procedure(id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginFragmentShaderATI = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndFragmentShaderATI = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPassTexCoordATI = procedure(dst: GLuint; coord: GLuint; swizzle: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSampleMapATI = procedure(dst: GLuint; interp: GLuint; swizzle: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorFragmentOp1ATI = procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorFragmentOp2ATI = procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorFragmentOp3ATI = procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint; arg3: GLuint; arg3Rep: GLuint; arg3Mod: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglAlphaFragmentOp1ATI = procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglAlphaFragmentOp2ATI = procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglAlphaFragmentOp3ATI = procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint; arg3: GLuint; arg3Rep: GLuint; arg3Mod: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSetFragmentShaderConstantATI = procedure(dst: GLuint; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_map_object_buffer - TglMapObjectBufferATI = function(buffer: GLuint): PGLvoid; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUnmapObjectBufferATI = procedure(buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_pn_triangles - TglPNTrianglesiATI = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPNTrianglesfATI = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_separate_stencil - TglStencilOpSeparateATI = procedure(face: GLenum; sfail: GLenum; dpfail: GLenum; dppass: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilFuncSeparateATI = procedure(frontfunc: GLenum; backfunc: GLenum; ref: GLint; mask: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_vertex_array_object - TglNewObjectBufferATI = function(size: GLsizei; const _pointer: PGLvoid; usage: GLenum): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsObjectBufferATI = function(buffer: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUpdateObjectBufferATI = procedure(buffer: GLuint; offset: GLuint; size: GLsizei; const _pointer: PGLvoid; preserve: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetObjectBufferfvATI = procedure(buffer: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetObjectBufferivATI = procedure(buffer: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFreeObjectBufferATI = procedure(buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglArrayObjectATI = procedure(_array: GLenum; size: GLint; _type: GLenum; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetArrayObjectfvATI = procedure(_array: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetArrayObjectivATI = procedure(_array: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantArrayObjectATI = procedure(id: GLuint; _type: GLenum; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVariantArrayObjectfvATI = procedure(id: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVariantArrayObjectivATI = procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_vertex_attrib_array_object - TglVertexAttribArrayObjectATI = procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribArrayObjectfvATI = procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribArrayObjectivATI = procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_ATI_vertex_streams - TglVertexStream1sATI = procedure(stream: GLenum; x: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream1svATI = procedure(stream: GLenum; const coords: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream1iATI = procedure(stream: GLenum; x: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream1ivATI = procedure(stream: GLenum; const coords: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream1fATI = procedure(stream: GLenum; x: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream1fvATI = procedure(stream: GLenum; const coords: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream1dATI = procedure(stream: GLenum; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream1dvATI = procedure(stream: GLenum; const coords: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2sATI = procedure(stream: GLenum; x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2svATI = procedure(stream: GLenum; const coords: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2iATI = procedure(stream: GLenum; x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2ivATI = procedure(stream: GLenum; const coords: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2fATI = procedure(stream: GLenum; x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2fvATI = procedure(stream: GLenum; const coords: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2dATI = procedure(stream: GLenum; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream2dvATI = procedure(stream: GLenum; const coords: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3sATI = procedure(stream: GLenum; x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3svATI = procedure(stream: GLenum; const coords: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3iATI = procedure(stream: GLenum; x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3ivATI = procedure(stream: GLenum; const coords: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3fATI = procedure(stream: GLenum; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3fvATI = procedure(stream: GLenum; const coords: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3dATI = procedure(stream: GLenum; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream3dvATI = procedure(stream: GLenum; const coords: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4sATI = procedure(stream: GLenum; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4svATI = procedure(stream: GLenum; const coords: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4iATI = procedure(stream: GLenum; x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4ivATI = procedure(stream: GLenum; const coords: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4fATI = procedure(stream: GLenum; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4fvATI = procedure(stream: GLenum; const coords: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4dATI = procedure(stream: GLenum; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexStream4dvATI = procedure(stream: GLenum; const coords: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3bATI = procedure(stream: GLenum; nx: GLbyte; ny: GLbyte; nz: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3bvATI = procedure(stream: GLenum; const coords: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3sATI = procedure(stream: GLenum; nx: GLshort; ny: GLshort; nz: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3svATI = procedure(stream: GLenum; const coords: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3iATI = procedure(stream: GLenum; nx: GLint; ny: GLint; nz: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3ivATI = procedure(stream: GLenum; const coords: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3fATI = procedure(stream: GLenum; nx: GLfloat; ny: GLfloat; nz: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3fvATI = procedure(stream: GLenum; const coords: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3dATI = procedure(stream: GLenum; nx: GLdouble; ny: GLdouble; nz: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalStream3dvATI = procedure(stream: GLenum; const coords: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClientActiveVertexStreamATI = procedure(stream: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexBlendEnviATI = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexBlendEnvfATI = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_performance_monitor - TglGetPerfMonitorGroupsAMD = procedure(numGroups: PGLint; groupsSize: GLsizei; groups: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPerfMonitorCountersAMD = procedure(group: GLuint; numCounters: PGLint; maxActiveCouters: PGLint; counterSize: GLsizei; counters: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPerfMonitorGroupStringAMD = procedure(group: GLuint; bufSize: GLsizei; length: PGLsizei; groupString: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPerfMonitorCounterStringAMD = procedure(group: GLuint; counter: GLuint; bufSize: GLsizei; length: PGLsizei; counterString: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPerfMonitorCounterInfoAMD = procedure(group: GLuint; counter: GLuint; pname: GLenum; data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenPerfMonitorsAMD = procedure(n: GLsizei; monitors: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeletePerfMonitorsAMD = procedure(n: GLsizei; monitors: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSelectPerfMonitorCountersAMD = procedure(monitor: GLuint; enable: GLboolean; group: GLuint; numCounters: GLint; counterList: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginPerfMonitorAMD = procedure(monitor: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndPerfMonitorAMD = procedure(monitor: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPerfMonitorCounterDataAMD = procedure(monitor: GLuint; pname: GLenum; dataSize: GLsizei; data: PGLuint; bytesWritten: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_vertex_shader_tesselator - TglTessellationFactorAMD = procedure(factor: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTessellationModeAMD = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_draw_buffers_blend - TglBlendFuncIndexedAMD = procedure(buf: GLuint; src: GLenum; dst: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendFuncSeparateIndexedAMD = procedure(buf: GLuint; srcRGB: GLenum; dstRGB: GLenum; srcAlpha: GLenum; dstAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendEquationIndexedAMD = procedure(buf: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBlendEquationSeparateIndexedAMD = procedure(buf: GLuint; modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_name_gen_delete - TglGenNamesAMD = procedure(identifier: GLenum; num: GLuint; names: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteNamesAMD = procedure(identifier: GLenum; num: GLuint; const names: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsNameAMD = function(identifier: GLenum; name: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_debug_output - TglDebugMessageEnableAMD = procedure(category: GLenum; severity: GLenum; count: GLsizei; const ids: PGLuint; enabled: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDebugMessageInsertAMD = procedure(category: GLenum; severity: GLenum; id: GLuint; length: GLsizei; const buf: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDebugMessageCallbackAMD = procedure(callback: TGLDebugProcAMD; userParam: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetDebugMessageLogAMD = function(count: GLuint; bufsize: GLsizei; categories: PGLenum; severities: PGLuint; ids: PGLuint; lengths: PGLsizei; message: PGLchar): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_blend_color - TglBlendColorEXT = procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_blend_func_separate - TglBlendFuncSeparateEXT = procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_blend_minmax - TglBlendEquationEXT = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_color_subtable - TglColorSubTableEXT = procedure(target: GLenum; start: GLsizei; count: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyColorSubTableEXT = procedure(target: GLenum; start: GLsizei; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_compiled_vertex_array - TglLockArraysEXT = procedure(first: GLint; count: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUnlockArraysEXT = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_convolution - TglConvolutionFilter1DEXT = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionFilter2DEXT = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameterfEXT = procedure(target: GLenum; pname: GLenum; params: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameterfvEXT = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameteriEXT = procedure(target: GLenum; pname: GLenum; params: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglConvolutionParameterivEXT = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyConvolutionFilter1DEXT = procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyConvolutionFilter2DEXT = procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetConvolutionFilterEXT = procedure(target: GLenum; format: GLenum; _type: GLenum; image: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetConvolutionParameterfvEXT = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetConvolutionParameterivEXT = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSeparableFilterEXT = procedure(target: GLenum; format: GLenum; _type: GLenum; row: PGLvoid; column: PGLvoid; span: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSeparableFilter2DEXT = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const row: PGLvoid; const column: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_coordinate_frame - TglTangent3bEXT = procedure(tx: GLbyte; ty: GLbyte; tz: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3bvEXT = procedure(const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3dEXT = procedure(tx: GLdouble; ty: GLdouble; tz: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3dvEXT = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3fEXT = procedure(tx: GLfloat; ty: GLfloat; tz: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3fvEXT = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3iEXT = procedure(tx: GLint; ty: GLint; tz: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3ivEXT = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3sEXT = procedure(tx: GLshort; ty: GLshort; tz: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangent3svEXT = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3bEXT = procedure(bx: GLbyte; by: GLbyte; bz: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3bvEXT = procedure(const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3dEXT = procedure(bx: GLdouble; by: GLdouble; bz: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3dvEXT = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3fEXT = procedure(bx: GLfloat; by: GLfloat; bz: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3fvEXT = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3iEXT = procedure(bx: GLint; by: GLint; bz: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3ivEXT = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3sEXT = procedure(bx: GLshort; by: GLshort; bz: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormal3svEXT = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTangentPointerEXT = procedure(_type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBinormalPointerEXT = procedure(_type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_copy_texture - TglCopyTexImage1DEXT = procedure(target: GLenum; level: GLint; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexImage2DEXT = procedure(target: GLenum; level: GLint; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexSubImage1DEXT = procedure(target: GLenum; level: GLint; xoffset: GLint; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexSubImage2DEXT = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTexSubImage3DEXT = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_cull_vertex - TglCullParameterdvEXT = procedure(pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCullParameterfvEXT = procedure(pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_draw_range_elements - TglDrawRangeElementsEXT = procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei; _type: GLenum; const indices: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_fog_coord - TglFogCoordfEXT = procedure(coord: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordfvEXT = procedure(const coord: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoorddEXT = procedure(coord: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoorddvEXT = procedure(const coord: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordPointerEXT = procedure(_type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_framebuffer_object - TglIsRenderbufferEXT = function(renderbuffer: GLuint): Boolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindRenderbufferEXT = procedure(target: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteRenderbuffersEXT = procedure(n: GLsizei; const renderbuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenRenderbuffersEXT = procedure(n: GLsizei; renderbuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRenderbufferStorageEXT = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetRenderbufferParameterivEXT = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsFramebufferEXT = function(framebuffer: GLuint): Boolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindFramebufferEXT = procedure(target: GLenum; framebuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteFramebuffersEXT = procedure(n: GLsizei; const framebuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenFramebuffersEXT = procedure(n: GLsizei; framebuffers: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCheckFramebufferStatusEXT = function(target: GLenum): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTexture1DEXT = procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTexture2DEXT = procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTexture3DEXT = procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint; zoffset: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferRenderbufferEXT = procedure(target: GLenum; attachment: GLenum; renderbuffertarget: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFramebufferAttachmentParameterivEXT = procedure(target: GLenum; attachment: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenerateMipmapEXT = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_histogram - TglGetHistogramEXT = procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetHistogramParameterfvEXT = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetHistogramParameterivEXT = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMinmaxEXT = procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMinmaxParameterfvEXT = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMinmaxParameterivEXT = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglHistogramEXT = procedure(target: GLenum; width: GLsizei; internalformat: GLenum; sink: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMinmaxEXT = procedure(target: GLenum; internalformat: GLenum; sink: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglResetHistogramEXT = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglResetMinmaxEXT = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_index_func - TglIndexFuncEXT = procedure(func: GLenum; ref: GLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_index_material - TglIndexMaterialEXT = procedure(face: GLenum; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_light_texture - TglApplyTextureEXT = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureLightEXT = procedure(pname: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureMaterialEXT = procedure(face: GLenum; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_multi_draw_arrays - TglMultiDrawArraysEXT = procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiDrawElementsEXT = procedure(mode: GLenum; const count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_multisample - TglSampleMaskEXT = procedure(value: GLclampf; invert: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplePatternEXT = procedure(pattern: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_paletted_texture - TglColorTableEXT = procedure(target: GLenum; internalFormat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const table: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableEXT = procedure(target: GLenum; format: GLenum; _type: GLenum; data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableParameterivEXT = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableParameterfvEXT = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_pixel_transform - TglPixelTransformParameteriEXT = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTransformParameterfEXT = procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTransformParameterivEXT = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTransformParameterfvEXT = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_point_parameters - TglPointParameterfEXT = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameterfvEXT = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_polygon_offset - TglPolygonOffsetEXT = procedure(factor: GLfloat; bias: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_secondary_color - TglSecondaryColor3bEXT = procedure(red: GLbyte; green: GLbyte; blue: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3bvEXT = procedure(const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3dEXT = procedure(red: GLdouble; green: GLdouble; blue: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3dvEXT = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3fEXT = procedure(red: GLfloat; green: GLfloat; blue: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3fvEXT = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3iEXT = procedure(red: GLint; green: GLint; blue: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3ivEXT = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3sEXT = procedure(red: GLshort; green: GLshort; blue: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3svEXT = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3ubEXT = procedure(red: GLubyte; green: GLubyte; blue: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3ubvEXT = procedure(const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3uiEXT = procedure(red: GLuint; green: GLuint; blue: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3uivEXT = procedure(const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3usEXT = procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3usvEXT = procedure(const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColorPointerEXT = procedure(size: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_stencil_two_side - TglActiveStencilFaceEXT = procedure(face: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_subtexture - TglTexSubImage1DEXT = procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexSubImage2DEXT = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_texture3D - TglTexImage3DEXT = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexSubImage3DEXT = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_texture_object - TglAreTexturesResidentEXT = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindTextureEXT = procedure(target: GLenum; texture: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteTexturesEXT = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenTexturesEXT = procedure(n: GLsizei; textures: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsTextureEXT = function(texture: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPrioritizeTexturesEXT = procedure(n: GLsizei; const textures: PGLuint; const priorities: PGLclampf); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_texture_perturb_normal - TglTextureNormalEXT = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_vertex_array - TglArrayElementEXT = procedure(i: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorPointerEXT = procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawArraysEXT = procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEdgeFlagPointerEXT = procedure(stride: GLsizei; count: GLsizei; const _pointer: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPointervEXT = procedure(pname: GLenum; params: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexPointerEXT = procedure(_type: GLenum; stride: GLsizei; count: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalPointerEXT = procedure(_type: GLenum; stride: GLsizei; count: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordPointerEXT = procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexPointerEXT = procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_vertex_shader - TglBeginVertexShaderEXT = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndVertexShaderEXT = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindVertexShaderEXT = procedure(id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenVertexShadersEXT = function(range: GLuint): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteVertexShaderEXT = procedure(id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglShaderOp1EXT = procedure(op: GLenum; res: GLuint; arg1: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglShaderOp2EXT = procedure(op: GLenum; res: GLuint; arg1: GLuint; arg2: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglShaderOp3EXT = procedure(op: GLenum; res: GLuint; arg1: GLuint; arg2: GLuint; arg3: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSwizzleEXT = procedure(res: GLuint; _in: GLuint; outX: GLenum; outY: GLenum; outZ: GLenum; outW: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWriteMaskEXT = procedure(res: GLuint; _in: GLuint; outX: GLenum; outY: GLenum; outZ: GLenum; outW: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInsertComponentEXT = procedure(res: GLuint; src: GLuint; num: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglExtractComponentEXT = procedure(res: GLuint; src: GLuint; num: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenSymbolsEXT = function(datatype: GLenum; storagetype: GLenum; range: GLenum; components: GLuint): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSetInvariantEXT = procedure(id: GLuint; _type: GLenum; const addr: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSetLocalConstantEXT = procedure(id: GLuint; _type: GLenum; const addr: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantbvEXT = procedure(id: GLuint; const addr: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantsvEXT = procedure(id: GLuint; const addr: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantivEXT = procedure(id: GLuint; const addr: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantfvEXT = procedure(id: GLuint; const addr: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantdvEXT = procedure(id: GLuint; const addr: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantubvEXT = procedure(id: GLuint; const addr: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantusvEXT = procedure(id: GLuint; const addr: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantuivEXT = procedure(id: GLuint; const addr: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVariantPointerEXT = procedure(id: GLuint; _type: GLenum; stride: GLuint; const addr: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnableVariantClientStateEXT = procedure(id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisableVariantClientStateEXT = procedure(id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindLightParameterEXT = function(light: GLenum; value: GLenum): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindMaterialParameterEXT = function(face: GLenum; value: GLenum): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindTexGenParameterEXT = function(_unit: GLenum; coord: GLenum; value: GLenum): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindTextureUnitParameterEXT = function(_unit: GLenum; value: GLenum): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindParameterEXT = function(value: GLenum): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsVariantEnabledEXT = function(id: GLuint; cap: GLenum): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVariantBooleanvEXT = procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVariantIntegervEXT = procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVariantFloatvEXT = procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVariantPointervEXT = procedure(id: GLuint; value: GLenum; data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetInvariantBooleanvEXT = procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetInvariantIntegervEXT = procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetInvariantFloatvEXT = procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetLocalConstantBooleanvEXT = procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetLocalConstantIntegervEXT = procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetLocalConstantFloatvEXT = procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_vertex_weighting - TglVertexWeightfEXT = procedure(weight: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexWeightfvEXT = procedure(const weight: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexWeightPointerEXT = procedure(size: GLsizei; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_stencil_clear_tag - TglStencilClearTagEXT = procedure(stencilTagBits: GLsizei; stencilClearTag: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_framebuffer_blit - TglBlitFramebufferEXT = procedure(srcX0: GLint; srcY0: GLint; srcX1: GLint; srcY1: GLint; dstX0: GLint; dstY0: GLint; dstX1: GLint; dstY1: GLint; mask: GLbitfield; filter: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_framebuffer_multisample - TglRenderbufferStorageMultisampleEXT = procedure(target: GLenum; samples: GLsizei; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_timer_query - TglGetQueryObjecti64vEXT = procedure(id: GLuint; pname: GLenum; params: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetQueryObjectui64vEXT = procedure(id: GLuint; pname: GLenum; params: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_gpu_program_parameters - TglProgramEnvParameters4fvEXT = procedure(target: GLenum; index: GLuint; count: GLsizei; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameters4fvEXT = procedure(target: GLenum; index: GLuint; count: GLsizei; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_bindable_uniform - TglUniformBufferEXT = procedure(_program: GLuint; location: GLint; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformBufferSizeEXT = function(_program: GLuint; location: GLint): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformOffsetEXT = function(_program: GLuint; location: GLint): GLintptr; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_draw_buffers2 - TglColorMaskIndexedEXT = procedure(buf: GLuint; r: GLboolean; g: GLboolean; b: GLboolean; a: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBooleanIndexedvEXT = procedure(value: GLenum; index: GLuint; data: PGLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetIntegerIndexedvEXT = procedure(value: GLenum; index: GLuint; data: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnableIndexedEXT = procedure(target: GLenum; index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisableIndexedEXT = procedure(target: GLenum; index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsEnabledIndexedEXT = function(target: GLenum; index: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_draw_instanced - TglDrawArraysInstancedEXT = procedure(mode: GLenum; first: GLint; count: GLsizei; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawElementsInstancedEXT = procedure(mode: GLenum; count: GLsizei; _type: GLenum; const indices: Pointer; primcount: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_geometry_shader4 - TglProgramParameteriEXT = procedure (_program: GLuint; pname: GLenum; value: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTextureEXT = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -// TglFramebufferTextureLayerEXT = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint; layer: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferTextureFaceEXT = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint; face: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_gpu_shader4 - TglVertexAttribI1iEXT = procedure(index: GLuint; x: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2iEXT = procedure(index: GLuint; x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3iEXT = procedure(index: GLuint; x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4iEXT = procedure(index: GLuint; x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI1uiEXT = procedure(index: GLuint; x: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2uiEXT = procedure(index: GLuint; x: GLuint; y: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3uiEXT = procedure(index: GLuint; x: GLuint; y: GLuint; z: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4uiEXT = procedure(index: GLuint; x: GLuint; y: GLuint; z: GLuint; w: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI1ivEXT = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2ivEXT = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3ivEXT = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4ivEXT = procedure(index: GLuint; const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI1uivEXT = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI2uivEXT = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI3uivEXT = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4uivEXT = procedure(index: GLuint; const v: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4bvEXT = procedure(index: GLuint; const v: PGLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4svEXT = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4ubvEXT = procedure(index: GLuint; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribI4usvEXT = procedure(index: GLuint; const v: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribIPointerEXT = procedure(index: GLuint; size: GLint; _type: GLenum; stride: GLsizei; const _pointer: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribIivEXT = procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribIuivEXT = procedure(index: GLuint; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1uiEXT = procedure(location: GLint; v0: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2uiEXT = procedure(location: GLint; v0: GLuint; v1: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3uiEXT = procedure(location: GLint; v0: GLuint; v1: GLuint; v2: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4uiEXT = procedure(location: GLint; v0: GLuint; v1: GLuint; v2: GLuint; v3: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1uivEXT = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2uivEXT = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3uivEXT = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4uivEXT = procedure(location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformuivEXT = procedure(_program: GLuint; location: GLint; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindFragDataLocationEXT = procedure(_program: GLuint; colorNumber: GLuint; const name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFragDataLocationEXT = function(_program: GLuint; const name: PGLchar): GLint; - - // GL_EXT_texture_array - TglFramebufferTextureLayerEXT = procedure(target: GLenum; attachment: GLenum; texture: GLuint; level: GLint; layer: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_texture_buffer_object - TglTexBufferEXT = procedure(target: GLenum; internalformat: GLenum; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_texture_integer - TglClearColorIiEXT = procedure(r: GLint; g: GLint; b: GLint; a: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearColorIuiEXT = procedure(r: GLuint; g: GLuint; b: GLuint; a: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameterIivEXT = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexParameterIuivEXT = procedure(target: GLenum; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexParameterIivEXT = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTexParameterIiuvEXT = procedure(target: GLenum; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_HP_image_transform - TglImageTransformParameteriHP = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglImageTransformParameterfHP = procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglImageTransformParameterivHP = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglImageTransformParameterfvHP = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetImageTransformParameterivHP = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetImageTransformParameterfvHP = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_depth_bounds_test - TglDepthBoundsEXT = procedure(zmin: GLclampd; zmax: GLclampd); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_blend_equation_separate - TglBlendEquationSeparateEXT = procedure(modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_transform_feedback - TglBeginTransformFeedbackEXT = procedure(primitiveMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndTransformFeedbackEXT = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferRangeEXT = procedure(target: GLenum; index_: GLuint; buffer: GLuint; offset: GLintptr; size: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferOffsetEXT = procedure(target: GLenum; index_: GLuint; buffer: GLuint; offset: GLintptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferBaseEXT = procedure(target: GLenum; index_: GLuint; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTransformFeedbackVaryingsEXT = procedure(program_: GLuint; count: GLsizei; const locations: PGLint; bufferMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTransformFeedbackVaryingEXT = procedure(program_: GLuint; index_: GLuint; location: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_direct_state_access - TglClientAttribDefaultEXT = procedure(mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPushClientAttribDefaultEXT = procedure(mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixLoadfEXT = procedure(mode: GLenum; const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixLoaddEXT = procedure(mode: GLenum; const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixMultfEXT = procedure(mode: GLenum; const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixMultdEXT = procedure(mode: GLenum; const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixLoadIdentityEXT = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixRotatefEXT = procedure(mode: GLenum; angle: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixRotatedEXT = procedure(mode: GLenum; angle: GLdouble; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixScalefEXT = procedure(mode: GLenum; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixScaledEXT = procedure(mode: GLenum; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixTranslatefEXT = procedure(mode: GLenum; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixTranslatedEXT = procedure(mode: GLenum; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixFrustumEXT = procedure(mode: GLenum; left: GLdouble; right: GLdouble; bottom: GLdouble; top: GLdouble; zNear: GLdouble; zFar: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixOrthoEXT = procedure(mode: GLenum; left: GLdouble; right: GLdouble; bottom: GLdouble; top: GLdouble; zNear: GLdouble; zFar: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixPopEXT = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixPushEXT = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixLoadTransposefEXT = procedure(mode: GLenum; const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixLoadTransposedEXT = procedure(mode: GLenum; const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixMultTransposefEXT = procedure(mode: GLenum; const m: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMatrixMultTransposedEXT = procedure(mode: GLenum; const m: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureParameterfEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureParameterfvEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureParameteriEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureParameterivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureImage1DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureImage2DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureSubImage1DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureSubImage2DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTextureImage1DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTextureImage2DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTextureSubImage1DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTextureSubImage2DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureImageEXT = procedure(texture: GLuint; target: GLenum; level: GLint; format: GLenum; type_: GLenum; pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureParameterfvEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureParameterivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureLevelParameterfvEXT = procedure(texture: GLuint; target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureLevelParameterivEXT = procedure(texture: GLuint; target: GLenum; level: GLint; pname: GLenum; params: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureImage3DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureSubImage3DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyTextureSubImage3DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexParameterfEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexParameterfvEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexParameteriEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexParameterivEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexImage1DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexImage2DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexSubImage1DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexSubImage2DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyMultiTexImage1DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyMultiTexImage2DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei; border: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyMultiTexSubImage1DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyMultiTexSubImage2DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexImageEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; format: GLenum; type_: GLenum; pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexParameterfvEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexParameterivEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexLevelParameterfvEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexLevelParameterivEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexImage3DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; type_: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexSubImage3DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; type_: GLenum; const pixels:PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyMultiTexSubImage3DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindMultiTextureEXT = procedure(texunit: GLenum; target: GLenum; texture: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEnableClientStateIndexedEXT = procedure(array_: GLenum; index_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDisableClientStateIndexedEXT = procedure(array_: GLenum; index_: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoordPointerEXT = procedure(texunit: GLenum; size: GLint; type_: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexEnvfEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexEnvfvEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexEnviEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexEnvivEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexGendEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; param: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexGendvEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; const params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexGenfEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexGenfvEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexGeniEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexGenivEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexEnvfvEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexEnvivEXT = procedure(texunit: GLenum; target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexGendvEXT = procedure(texunit: GLenum; coord: GLenum; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexGenfvEXT = procedure(texunit: GLenum; coord: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexGenivEXT = procedure(texunit: GLenum; coord: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFloatIndexedvEXT = procedure(target: GLenum; index_: GLuint; data: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetDoubleIndexedvEXT = procedure(target: GLenum; index_: GLuint; data: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPointerIndexedvEXT = procedure(target: GLenum; index_: GLuint; data: PPGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTextureImage3DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTextureImage2DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTextureImage1DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTextureSubImage3DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTextureSubImage2DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedTextureSubImage1DEXT = procedure(texture: GLuint; target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCompressedTextureImageEXT = procedure(texture: GLuint; target: GLenum; lod: GLint; img: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedMultiTexImage3DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedMultiTexImage2DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedMultiTexImage1DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedMultiTexSubImage3DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedMultiTexSubImage2DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCompressedMultiTexSubImage1DEXT = procedure(texunit: GLenum; target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const bits: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCompressedMultiTexImageEXT = procedure(texunit: GLenum; target: GLenum; lod: GLint; img: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramStringEXT = procedure(program_: GLuint; target: GLenum; format: GLenum; len: GLsizei; const string_: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameter4dEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameter4dvEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; const params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameter4fEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameter4fvEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedProgramLocalParameterdvEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedProgramLocalParameterfvEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedProgramivEXT = procedure(program_: GLuint; target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedProgramStringEXT = procedure(program_: GLuint; target: GLenum; pname: GLenum; string_: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameters4fvEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; count: GLsizei; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameterI4iEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameterI4ivEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParametersI4ivEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; count: GLsizei; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameterI4uiEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; x: GLuint; y: GLuint; z: GLuint; w: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParameterI4uivEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedProgramLocalParametersI4uivEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; count: GLsizei; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedProgramLocalParameterIivEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedProgramLocalParameterIuivEXT = procedure(program_: GLuint; target: GLenum; index_: GLuint; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureParameterIivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureParameterIuivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureParameterIivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureParameterIuivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexParameterIivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexParameterIuivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexParameterIivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMultiTexParameterIuivEXT = procedure(texture: GLuint; target: GLenum; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1fEXT = procedure(program_: GLuint; location: GLint; v0: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2fEXT = procedure(program_: GLuint; location: GLint; v0: GLfloat; v1: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3fEXT = procedure(program_: GLuint; location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4fEXT = procedure(program_: GLuint; location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat; v3: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1iEXT = procedure(program_: GLuint; location: GLint; v0: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2iEXT = procedure(program_: GLuint; location: GLint; v0: GLint; v1: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3iEXT = procedure(program_: GLuint; location: GLint; v0: GLint; v1: GLint; v2: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4iEXT = procedure(program_: GLuint; location: GLint; v0: GLint; v1: GLint; v2: GLint; v3: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1ivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2ivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3ivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4ivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x3fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x2fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x4fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x2fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x4fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x3fvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1uiEXT = procedure(program_: GLuint; location: GLint; v0: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2uiEXT = procedure(program_: GLuint; location: GLint; v0: GLuint; v1: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3uiEXT = procedure(program_: GLuint; location: GLint; v0: GLuint; v1: GLuint; v2: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4uiEXT = procedure(program_: GLuint; location: GLint; v0: GLuint; v1: GLuint; v2: GLuint; v3: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1uivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2uivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3uivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4uivEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedBufferDataEXT = procedure(buffer: GLuint; size: GLsizei; const data: PGLvoid; usage: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedBufferSubDataEXT = procedure(buffer: GLuint; offset: GLintptr; size: GLsizeiptr; const data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapNamedBufferEXT = function(buffer: GLuint; access: GLenum): PGLvoid; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUnmapNamedBufferEXT = function(buffer: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapNamedBufferRangeEXT = function(buffer: GLuint; offset: GLintptr; length: GLsizeiptr; access: GLbitfield): PGLvoid; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFlushMappedNamedBufferRangeEXT = procedure(buffer: GLuint; offset: GLintptr; length: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedCopyBufferSubDataEXT = procedure(readBuffer: GLuint; writeBuffer: GLuint; readOffset: GLintptr; writeOffset: GLintptr; size: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedBufferParameterivEXT = procedure(buffer: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedBufferPointervEXT = procedure(buffer: GLuint; pname: GLenum; params: PPGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedBufferSubDataEXT = procedure(buffer: GLuint; offset: GLintptr; size: GLsizeiptr; data: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureBufferEXT = procedure(texture: GLuint; target: GLenum; internalformat: GLenum; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexBufferEXT = procedure(texunit: GLenum; target: GLenum; interformat: GLenum; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedRenderbufferStorageEXT = procedure(renderbuffer: GLuint; interformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedRenderbufferParameterivEXT = procedure(renderbuffer: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCheckNamedFramebufferStatusEXT = function(framebuffer: GLuint; target: GLenum): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferTexture1DEXT = procedure(framebuffer: GLuint; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferTexture2DEXT = procedure(framebuffer: GLuint; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferTexture3DEXT = procedure(framebuffer: GLuint; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint; zoffset: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferRenderbufferEXT = procedure(framebuffer: GLuint; attachment: GLenum; renderbuffertarget: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedFramebufferAttachmentParameterivEXT = procedure(framebuffer: GLuint; attachment: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenerateTextureMipmapEXT = procedure(texture: GLuint; target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenerateMultiTexMipmapEXT = procedure(texunit: GLenum; target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferDrawBufferEXT = procedure(framebuffer: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferDrawBuffersEXT = procedure(framebuffer: GLuint; n: GLsizei; const bufs: PGLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFramebufferReadBufferEXT = procedure(framebuffer: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFramebufferParameterivEXT = procedure(framebuffer: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedRenderbufferStorageMultisampleEXT = procedure(renderbuffer: GLuint; samples: GLsizei; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedRenderbufferStorageMultisampleCoverageEXT = procedure(renderbuffer: GLuint; coverageSamples: GLsizei; colorSamples: GLsizei; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferTextureEXT = procedure(framebuffer: GLuint; attachment: GLenum; texture: GLuint; level: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferTextureLayerEXT = procedure(framebuffer: GLuint; attachment: GLenum; texture: GLuint; level: GLint; layer: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNamedFramebufferTextureFaceEXT = procedure(framebuffer: GLuint; attachment: GLenum; texture: GLuint; level: GLint; face: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTextureRenderbufferEXT = procedure(texture: GLuint; target: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexRenderbufferEXT = procedure(texunit: GLenum; target: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1dEXT = procedure(program_: GLuint; location: GLint; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2dEXT = procedure(program_: GLuint; location: GLint; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3dEXT = procedure(program_: GLuint; location: GLint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4dEXT = procedure(program_: GLuint; location: GLint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x3dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix2x4dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x2dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix3x4dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x2dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformMatrix4x3dvEXT = procedure(program_: GLuint; location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_separate_shader_objects - TglUseShaderProgramEXT = procedure(_type: GLenum; _program: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglActiveProgramEXT = procedure(_program: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCreateShaderProgramEXT = function(_type: GLenum; const _string: PGLchar): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_shader_image_load_store - TglBindImageTextureEXT = procedure(index: GLuint; texture: GLuint; level: GLint; layered: GLboolean; layer: GLint; access: GLenum; format: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMemoryBarrierEXT = procedure(barriers: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_EXT_vertex_attrib_64bit - TglVertexAttribL1dEXT = procedure(index: GLuint; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2dEXT = procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3dEXT = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4dEXT = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL1dvEXT = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2dvEXT = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3dvEXT = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4dvEXT = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribLPointerEXT = procedure(index: GLuint; size: GLint; type_: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribLdvEXT = procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayVertexAttribLOffsetEXT = procedure(vaobj: GLuint; buffer: GLuint; index: GLuint; size: GLint; type_: GLenum; stride: GLsizei; offset: GLintptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_IBM_multimode_draw_arrays - TglMultiModeDrawArraysIBM = procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei; modestride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiModeDrawElementsIBM = procedure(const mode: PGLenum; const count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei; modestride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_IBM_vertex_array_lists - TglColorPointerListIBM = procedure(size: GLint; _type: GLenum; stride: GLint; const _pointer: PGLvoid; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColorPointerListIBM = procedure(size: GLint; _type: GLenum; stride: GLint; const _pointer: PGLvoid; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEdgeFlagPointerListIBM = procedure(stride: GLint; const _pointer: PGLboolean; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordPointerListIBM = procedure(_type: GLenum; stride: GLint; const _pointer: PGLvoid; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexPointerListIBM = procedure(_type: GLenum; stride: GLint; const _pointer: PGLvoid; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalPointerListIBM = procedure(_type: GLenum; stride: GLint; const _pointer: PGLvoid; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordPointerListIBM = procedure(size: GLint; _type: GLenum; stride: GLint; const _pointer: PGLvoid; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexPointerListIBM = procedure(size: GLint; _type: GLenum; stride: GLint; const _pointer: PGLvoid; ptrstride: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_INGR_blend_func_separate - TglBlendFuncSeparateINGR = procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_INTEL_parallel_arrays - TglVertexPointervINTEL = procedure(size: GLint; _type: GLenum; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalPointervINTEL = procedure(_type: GLenum; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorPointervINTEL = procedure(size: GLint; _type: GLenum; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordPointervINTEL = procedure(size: GLint; _type: GLenum; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_MESA_resize_buffers - TglResizeBuffersMESA = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_MESA_window_pos - TglWindowPos2dMESA = procedure(x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2dvMESA = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2fMESA = procedure(x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2fvMESA = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2iMESA = procedure(x: GLint; y: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2ivMESA = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2sMESA = procedure(x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos2svMESA = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3dMESA = procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3dvMESA = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3fMESA = procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3fvMESA = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3iMESA = procedure(x: GLint; y: GLint; z: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3ivMESA = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3sMESA = procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos3svMESA = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4dMESA = procedure(x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4dvMESA = procedure(const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4fMESA = procedure(x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4fvMESA = procedure(const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4iMESA = procedure(x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4ivMESA = procedure(const v: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4sMESA = procedure(x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWindowPos4svMESA = procedure(const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_evaluators - TglMapControlPointsNV = procedure(target: GLenum; index: GLuint; _type: GLenum; ustride: GLsizei; vstride: GLsizei; uorder: GLint; vorder: GLint; _packed: GLboolean; const points: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapParameterivNV = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMapParameterfvNV = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapControlPointsNV = procedure(target: GLenum; index: GLuint; _type: GLenum; ustride: GLsizei; vstride: GLsizei; _packed: GLboolean; points: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapParameterivNV = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapParameterfvNV = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapAttribParameterivNV = procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetMapAttribParameterfvNV = procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEvalMapsNV = procedure(target: GLenum; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_fence - TglDeleteFencesNV = procedure(n: GLsizei; const fences: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenFencesNV = procedure(n: GLsizei; fences: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsFenceNV = function(fence: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTestFenceNV = function(fence: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFenceivNV = procedure(fence: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFinishFenceNV = procedure(fence: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSetFenceNV = procedure(fence: GLuint; condition: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_fragment_program - TglProgramNamedParameter4fNV = procedure(id: GLuint; len: GLsizei; const name: PGLubyte; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramNamedParameter4dNV = procedure(id: GLuint; len: GLsizei; const name: PGLubyte; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramNamedParameter4fvNV = procedure(id: GLuint; len: GLsizei; const name: PGLubyte; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramNamedParameter4dvNV = procedure(id: GLuint; len: GLsizei; const name: PGLubyte; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramNamedParameterfvNV = procedure(id: GLuint; len: GLsizei; const name: PGLubyte; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramNamedParameterdvNV = procedure(id: GLuint; len: GLsizei; const name: PGLubyte; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_half_float - TglVertex2hNV = procedure(x: GLhalfNV; y: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex2hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3hNV = procedure(x: GLhalfNV; y: GLhalfNV; z: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex3hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4hNV = procedure(x: GLhalfNV; y: GLhalfNV; z: GLhalfNV; w: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertex4hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3hNV = procedure(nx: GLhalfNV; ny: GLhalfNV; nz: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3hNV = procedure(red: GLhalfNV; green: GLhalfNV; blue: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4hNV = procedure(red: GLhalfNV; green: GLhalfNV; blue: GLhalfNV; alpha: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1hNV = procedure(s: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord1hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2hNV = procedure(s: GLhalfNV; t: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3hNV = procedure(s: GLhalfNV; t: GLhalfNV; r: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord3hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4hNV = procedure(s: GLhalfNV; t: GLhalfNV; r: GLhalfNV; q: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1hNV = procedure(target: GLenum; s: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord1hvNV = procedure(target: GLenum; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2hNV = procedure(target: GLenum; s: GLhalfNV; t: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord2hvNV = procedure(target: GLenum; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3hNV = procedure(target: GLenum; s: GLhalfNV; t: GLhalfNV; r: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord3hvNV = procedure(target: GLenum; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4hNV = procedure(target: GLenum; s: GLhalfNV; t: GLhalfNV; r: GLhalfNV; q: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMultiTexCoord4hvNV = procedure(target: GLenum; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordhNV = procedure(fog: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordhvNV = procedure(const fog: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3hNV = procedure(red: GLhalfNV; green: GLhalfNV; blue: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColor3hvNV = procedure(const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexWeighthNV = procedure(weight: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexWeighthvNV = procedure(const weight: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1hNV = procedure(index: GLuint; x: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1hvNV = procedure(index: GLuint; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2hNV = procedure(index: GLuint; x: GLhalfNV; y: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2hvNV = procedure(index: GLuint; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3hNV = procedure(index: GLuint; x: GLhalfNV; y: GLhalfNV; z: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3hvNV = procedure(index: GLuint; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4hNV = procedure(index: GLuint; x: GLhalfNV; y: GLhalfNV; z: GLhalfNV; w: GLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4hvNV = procedure(index: GLuint; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs1hvNV = procedure(index: GLuint; n: GLsizei; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs2hvNV = procedure(index: GLuint; n: GLsizei; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs3hvNV = procedure(index: GLuint; n: GLsizei; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs4hvNV = procedure(index: GLuint; n: GLsizei; const v: PGLhalfNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_occlusion_query - TglGenOcclusionQueriesNV = procedure(n: GLsizei; ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteOcclusionQueriesNV = procedure(n: GLsizei; const ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsOcclusionQueryNV = function(id: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBeginOcclusionQueryNV = procedure(id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndOcclusionQueryNV = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetOcclusionQueryivNV = procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetOcclusionQueryuivNV = procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_pixel_data_range - TglPixelDataRangeNV = procedure(target: GLenum; length: GLsizei; _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFlushPixelDataRangeNV = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_point_sprite - TglPointParameteriNV = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameterivNV = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_primitive_restart - TglPrimitiveRestartNV = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPrimitiveRestartIndexNV = procedure(index: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_register_combiners - TglCombinerParameterfvNV = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCombinerParameterfNV = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCombinerParameterivNV = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCombinerParameteriNV = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCombinerInputNV = procedure(stage: GLenum; portion: GLenum; variable: GLenum; input: GLenum; mapping: GLenum; componentUsage: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCombinerOutputNV = procedure(stage: GLenum; portion: GLenum; abOutput: GLenum; cdOutput: GLenum; sumOutput: GLenum; scale: GLenum; bias: GLenum; abDotProduct: GLboolean; cdDotProduct: GLboolean; muxSum: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFinalCombinerInputNV = procedure(variable: GLenum; input: GLenum; mapping: GLenum; componentUsage: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCombinerInputParameterfvNV = procedure(stage: GLenum; portion: GLenum; variable: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCombinerInputParameterivNV = procedure(stage: GLenum; portion: GLenum; variable: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCombinerOutputParameterfvNV = procedure(stage: GLenum; portion: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCombinerOutputParameterivNV = procedure(stage: GLenum; portion: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFinalCombinerInputParameterfvNV = procedure(variable: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFinalCombinerInputParameterivNV = procedure(variable: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_register_combiners2 - TglCombinerStageParameterfvNV = procedure(stage: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetCombinerStageParameterfvNV = procedure(stage: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_vertex_array_range - TglFlushVertexArrayRangeNV = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexArrayRangeNV = procedure(length: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_vertex_program - TglAreProgramsResidentNV = function(n: GLsizei; const programs: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindProgramNV = procedure(target: GLenum; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteProgramsNV = procedure(n: GLsizei; const programs: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglExecuteProgramNV = procedure(target: GLenum; id: GLuint; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenProgramsNV = procedure(n: GLsizei; programs: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramParameterdvNV = procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramParameterfvNV = procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramivNV = procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramStringNV = procedure(id: GLuint; pname: GLenum; _program: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTrackMatrixivNV = procedure(target: GLenum; address: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribdvNV = procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribfvNV = procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribivNV = procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribPointervNV = procedure(index: GLuint; pname: GLenum; _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsProgramNV = function(id: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadProgramNV = procedure(target: GLenum; id: GLuint; len: GLsizei; const _program: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramParameter4dNV = procedure(target: GLenum; index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramParameter4dvNV = procedure(target: GLenum; index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramParameter4fNV = procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramParameter4fvNV = procedure(target: GLenum; index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramParameters4dvNV = procedure(target: GLenum; index: GLuint; count: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramParameters4fvNV = procedure(target: GLenum; index: GLuint; count: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglRequestResidentProgramsNV = procedure(n: GLsizei; const programs: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTrackMatrixNV = procedure(target: GLenum; address: GLuint; matrix: GLenum; transform: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribPointerNV = procedure(index: GLuint; fsize: GLint; _type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1dNV = procedure(index: GLuint; x: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1dvNV = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1fNV = procedure(index: GLuint; x: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1fvNV = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1sNV = procedure(index: GLuint; x: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib1svNV = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2dNV = procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2dvNV = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2fNV = procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2fvNV = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2sNV = procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib2svNV = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3dNV = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3dvNV = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3fNV = procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3fvNV = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3sNV = procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib3svNV = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4dNV = procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4dvNV = procedure(index: GLuint; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4fNV = procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4fvNV = procedure(index: GLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4sNV = procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4svNV = procedure(index: GLuint; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4ubNV = procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttrib4ubvNV = procedure(index: GLuint; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs1dvNV = procedure(index: GLuint; count: GLsizei; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs1fvNV = procedure(index: GLuint; count: GLsizei; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs1svNV = procedure(index: GLuint; count: GLsizei; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs2dvNV = procedure(index: GLuint; count: GLsizei; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs2fvNV = procedure(index: GLuint; count: GLsizei; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs2svNV = procedure(index: GLuint; count: GLsizei; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs3dvNV = procedure(index: GLuint; count: GLsizei; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs3fvNV = procedure(index: GLuint; count: GLsizei; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs3svNV = procedure(index: GLuint; count: GLsizei; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs4dvNV = procedure(index: GLuint; count: GLsizei; const v: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs4fvNV = procedure(index: GLuint; count: GLsizei; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs4svNV = procedure(index: GLuint; count: GLsizei; const v: PGLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribs4ubvNV = procedure(index: GLuint; count: GLsizei; const v: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_depth_buffer_float - TglDepthRangedNV = procedure(n: GLdouble; f: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglClearDepthdNV = procedure(d: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDepthBoundsdNV = procedure(zmin: GLdouble; zmax: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_framebuffer_multisample_coverage - TglRenderbufferStorageMultsampleCoverageNV = procedure(target: GLenum; coverageSamples: GLsizei; colorSamples: GLsizei; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_geometry_program4 - TglProgramVertexLimitNV = procedure(target: GLenum; limit: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_gpu_program4 - TglProgramLocalParameterI4iNV = procedure(target: GLenum; index: GLuint; x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameterI4ivNV = procedure(target: GLenum; index: GLuint; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParametersI4ivNV = procedure(target: GLenum; index: GLuint; count: GLsizei; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameterI4uiNV = procedure(target: GLenum; index: GLuint; x: GLuint; y: GLuint; z: GLuint; w: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParameterI4uivNV = procedure(target: GLenum; index: GLuint; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramLocalParametersI4uivNV = procedure(target: GLenum; index: GLuint; count: GLsizei; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameterI4iNV = procedure(target: GLenum; index: GLuint; x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameterI4ivNV = procedure(target: GLenum; index: GLuint; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParametersI4ivNV = procedure(target: GLenum; index: GLuint; count: GLsizei; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameterI4uiNV = procedure(target: GLenum; index: GLuint; x: GLuint; y: GLuint; z: GLuint; w: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParameterI4uivNV = procedure(target: GLenum; index: GLuint; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramEnvParametersI4uivNV = procedure(target: GLenum; index: GLuint; count: GLsizei; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramLocalParameterIivNV = procedure(target: GLenum; index: GLuint; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramLocalParameterIuivNV = procedure(target: GLenum; index: GLuint; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramEnvParameterIivNV = procedure(target: GLenum; index: GLuint; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramEnvParameterIuivNV = procedure(target: GLenum; index: GLuint; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_parameter_buffer_object - TglProgramBufferParametersfvNV = procedure(target: GLenum; buffer: GLuint; index: GLuint; count: GLsizei; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramBufferParametersIivNV = procedure(target: GLenum; buffer: GLuint; index: GLuint; count: GLsizei; const params: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramBufferParametersIuivNV = procedure(target: GLenum; buffer: GLuint; index: GLuint; count: GLuint; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_transform_feedback - TglBeginTransformFeedbackNV = procedure(primitiveMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndTransformFeedbackNV = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTransformFeedbackAttribsNV = procedure(count: GLsizei; const attribs: GLint; bufferMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferRangeNV = procedure(target: GLenum; index: GLuint; buffer: GLuint; offset: GLintptr; size: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferOffsetNV = procedure(target: GLenum; index: GLuint; buffer: GLuint; offset: GLintptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindBufferBaseNV = procedure(target: GLenum; index: GLuint; buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTransformFeedbackVaryingsNV = procedure(program_: GLuint; count: GLsizei; const locations: PGLint; bufferMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglActiveVaryingNV = procedure(program_: GLuint; const name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVaryingLocationNV = function(program_: GLuint; const name: PGLchar): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetActiveVaryingNV = procedure(program_: GLuint; index: GLuint; bufSize: GLsizei; length: PGLsizei; size: PGLsizei; _type: PGLenum; name: PGLchar); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTransformFeedbackVaryingNV = procedure(program_: GLuint; index: GLuint; location: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTransformFeedbackStreamAttribsNV = procedure(count: GLsizei; const attribs: PGLint; nbuffers: GLsizei; const bufstreams: PGLint; bufferMode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_conditional_render - TglBeginConditionalRenderNV = procedure(id: GLuint; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndConditionalRenderNV = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_present_video - TglPresentFrameKeyedNV = procedure(video_slot: GLuint; minPresentTime: GLuint64EXT; beginPresentTimeId: GLuint; presentDuratioId: GLuint; type_: GLenum; target0: GLenum; fill0: GLuint; key0: GLuint; target1: GLenum; fill1: GLuint; key1: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPresentFrameDualFillNV = procedure(video_slot: GLuint; minPresentTime: GLuint64EXT; beginPresentTimeId: GLuint; presentDurationId: GLuint; type_: GLenum; target0: GLenum; fill0: GLuint; target1: GLenum; fill1: GLuint; target2: GLenum; fill2: GLuint; target3: GLenum; fill3: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideoivNV = procedure(video_slot: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideouivNV = procedure(video_slot: GLuint; pname: GLenum; params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideoi64vNV = procedure(video_slot: GLuint; pname: GLenum; params: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideoui64vNV = procedure(video_slot: GLuint; pname: GLenum; params: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} -// TglVideoParameterivNV = procedure(video_slot: GLuint; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_explicit_multisample - TglGetMultisamplefvNV = procedure (pname: GLenum; index: GLuint; val: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSampleMaskIndexedNV = procedure (index: GLuint; mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexRenderbufferNV = procedure (target: GLenum; renderbuffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_transform_feedback2 - TglBindTransformFeedbackNV = procedure(target: GLenum; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteTransformFeedbacksNV = procedure(n: GLsizei; ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenTransformFeedbacksNV = procedure(n: GLsizei; ids: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsTransformFeedbackNV = function (id: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPauseTransformFeedbackNV = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglResumeTransformFeedbackNV = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDrawTransformFeedbackNV = procedure(mode: GLenum; id: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_video_capture - TglBeginVideoCaptureNV = procedure(video_capture_slot: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindVideoCaptureStreamBufferNV = procedure(video_capture_slot: GLuint; stream: GLuint; frame_region: GLenum; offset: GLintptrARB); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglBindVideoCaptureStreamTextureNV = procedure(video_capture_slot: GLuint; stream: GLuint; frame_region: GLenum; target: GLenum; texture: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEndVideoCaptureNV = procedure(video_capture_slot: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideoCaptureivNV = procedure(video_capture_slot: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideoCaptureStreamivNV = procedure(video_capture_slot: GLuint; stream: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideoCaptureStreamfvNV = procedure(video_capture_slot: GLuint; stream: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVideoCaptureStreamdvNV = procedure(video_capture_slot: GLuint; stream: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVideoCaptureNV = function(video_capture_slot: GLuint; sequence_num: PGLuint; capture_time: PGLuint64EXT): GLenum; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVideoCaptureStreamParameterivNV = procedure(video_capture_slot: GLuint; stream: GLuint; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVideoCaptureStreamParameterfvNV = procedure(video_capture_slot: GLuint; stream: GLuint; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVideoCaptureStreamParameterdvNV = procedure(video_capture_slot: GLuint; stream: GLuint; pname: GLenum; const params: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_copy_image - TglCopyImageSubDataNV = procedure(srcName: GLuint; srcTarget: GLenum; srcLevel: GLint; srcX: GLint; srcY: GLint; srcZ: GLint; dstName: GLuint; dstTarget: GLenum; dstLevel: GLint; dstX: GLint; dstY: GLint; dstZ: GLint; width: GLsizei; height: GLsizei; depth: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_shader_buffer_load - TglMakeBufferResidentNV = procedure(target: GLenum; access: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMakeBufferNonResidentNV = procedure(target: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsBufferResidentNV = function(target: GLenum): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMakeNamedBufferResidentNV = procedure(buffer: GLuint; access: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMakeNamedBufferNonResidentNV = procedure(buffer: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsNamedBufferResidentNV = function(buffer: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetBufferParameterui64vNV = procedure(target: GLenum; pname: GLenum; params: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetNamedBufferParameterui64vNV = procedure(buffer: GLuint; pname: GLenum; params: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetIntegerui64vNV = procedure(value: GLenum; result: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformui64NV = procedure(location: GLint; value: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformui64vNV = procedure(location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformui64vNV = procedure(_program: GLuint; location: GLint; params: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformui64NV = procedure(_program: GLuint; location: GLint; value: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformui64vNV = procedure(_program: GLuint; location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_vertex_buffer_unified_memory - TglBufferAddressRangeNV = procedure(pname: GLenum; index: GLuint; adress: GLuint64EXT; length: GLsizeiptr); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexFormatNV = procedure(size: GLint; _type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormalFormatNV = procedure(_type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorFormatNV = procedure(size: GLint; _type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIndexFormatNV = procedure(_type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoordFormatNV = procedure(size: GLint; _type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglEdgeFlagFormatNV = procedure(stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSecondaryColorFormatNV = procedure(size: GLint; _type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFogCoordFormatNV = procedure(_type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribFormatNV = procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribIFormatNV = procedure(index: GLuint; size: GLint; _type: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetIntegerui64i_vNV = procedure(value: GLenum; index: GLuint; Result: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_gpu_program5 - TglProgramSubroutineParametersuivNV = procedure(target: GLenum; count: GLsizei; const params: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetProgramSubroutineParameteruivNV = procedure(target: GLenum; index: GLuint; param: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_gpu_shader5 - TglUniform1i64NV = procedure(location: GLint; x: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2i64NV = procedure(location: GLint; x: GLint64EXT; y: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3i64NV = procedure(location: GLint; x: GLint64EXT; y: GLint64EXT; z: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4i64NV = procedure(location: GLint; x: GLint64EXT; y: GLint64EXT; z: GLint64EXT; w: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1i64vNV = procedure(location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2i64vNV = procedure(location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3i64vNV = procedure(location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4i64vNV = procedure(location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1ui64NV = procedure(location: GLint; x: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2ui64NV = procedure(location: GLint; x: GLuint64EXT; y: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3ui64NV = procedure(location: GLint; x: GLuint64EXT; y: GLuint64EXT; z: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4ui64NV = procedure(location: GLint; x: GLuint64EXT; y: GLuint64EXT; z: GLuint64EXT; w: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform1ui64vNV = procedure(location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform2ui64vNV = procedure(location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform3ui64vNV = procedure(location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniform4ui64vNV = procedure(location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetUniformi64vNV = procedure(program_: GLuint; location: GLint; params: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1i64NV = procedure(program_: GLuint; location: GLint; x: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2i64NV = procedure(program_: GLuint; location: GLint; x: GLint64EXT; y: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3i64NV = procedure(program_: GLuint; location: GLint; x: GLint64EXT; y: GLint64EXT; z: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4i64NV = procedure(program_: GLuint; location: GLint; x: GLint64EXT; y: GLint64EXT; z: GLint64EXT; w: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1i64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2i64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3i64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4i64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1ui64NV = procedure(program_: GLuint; location: GLint; x: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2ui64NV = procedure(program_: GLuint; location: GLint; x: GLuint64EXT; y: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3ui64NV = procedure(program_: GLuint; location: GLint; x: GLuint64EXT; y: GLuint64EXT; z: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4ui64NV = procedure(program_: GLuint; location: GLint; x: GLuint64EXT; y: GLuint64EXT; z: GLuint64EXT; w: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform1ui64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform2ui64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform3ui64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniform4ui64vNV = procedure(program_: GLuint; location: GLint; count: GLsizei; const value: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_vertex_attrib_integer_64bit - TglVertexAttribL1i64NV = procedure(index: GLuint; x: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2i64NV = procedure(index: GLuint; x: GLint64EXT; y: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3i64NV = procedure(index: GLuint; x: GLint64EXT; y: GLint64EXT; z: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4i64NV = procedure(index: GLuint; x: GLint64EXT; y: GLint64EXT; z: GLint64EXT; w: GLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL1i64vNV = procedure(index: GLuint; const v: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2i64vNV = procedure(index: GLuint; const v: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3i64vNV = procedure(index: GLuint; const v: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4i64vNV = procedure(index: GLuint; const v: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL1ui64NV = procedure(index: GLuint; x: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2ui64NV = procedure(index: GLuint; x: GLuint64EXT; y: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3ui64NV = procedure(index: GLuint; x: GLuint64EXT; y: GLuint64EXT; z: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4ui64NV = procedure(index: GLuint; x: GLuint64EXT; y: GLuint64EXT; z: GLuint64EXT; w: GLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL1ui64vNV = procedure(index: GLuint; const v: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL2ui64vNV = procedure(index: GLuint; const v: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL3ui64vNV = procedure(index: GLuint; const v: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribL4ui64vNV = procedure(index: GLuint; const v: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribLi64vNV = procedure(index: GLuint; pname: GLenum; params: PGLint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetVertexAttribLui64vNV = procedure(index: GLuint; pname: GLenum; params: PGLuint64EXT); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVertexAttribLFormatNV = procedure(index: GLuint; size: GLint; type_: GLenum; stride: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_vdpau_interop - TglVDPAUInitNV = procedure(const vdpDevice: PGLvoid; const getProcAddress: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAUFiniNV = procedure; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAURegisterVideoSurfaceNV = function(vdpSurface: PGLvoid; target: GLenum; numTextureNames: GLsizei; const textureNames: PGLuint): GLvdpauSurfaceNV; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAURegisterOutputSurfaceNV = function(vdpSurface: PGLvoid; target: GLenum; numTextureNames: GLsizei; const textureNames: PGLuint): GLvdpauSurfaceNV; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAUIsSurfaceNV = procedure(surface: GLvdpauSurfaceNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAUUnregisterSurfaceNV = procedure(surface: GLvdpauSurfaceNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAUGetSurfaceivNV = procedure(surface: GLvdpauSurfaceNV; pname: GLenum; bufSize: GLsizei; length: PGLsizei; values: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAUSurfaceAccessNV = procedure(surface: GLvdpauSurfaceNV; access: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAUMapSurfacesNV = procedure(numSurfaces: GLsizei; const surfaces: PGLvdpauSurfaceNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglVDPAUUnmapSurfacesNV = procedure(numSurface: GLsizei; const surfaces: PGLvdpauSurfaceNV); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_texture_barrier - TglTextureBarrierNV = procedure; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // (4.3) - // GL_NV_path_rendering - TglGenPathsNV = function(range : GLsizei) : GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeletePathsNV = procedure(path : GLUInt; range : GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsPathNV = function(path : GLUInt) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathCommandsNV = procedure(path : GLUInt; numCommands : GLsizei; const commands : PGLubyte; numCoords : GLsizei; coordType : GLenum; const coords : PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathCoordsNV = procedure(path : GLUInt; numCoords : GLSizei; coordType : GLenum; const coords : PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathSubCommandsNV = procedure(path : GLUInt; commandStart : GLsizei; commandsToDelete : GLsizei; numCommands : GLsizei; const commands : PGLubyte; numCoords : GLSizei; coordType : GLenum; const coords : PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathSubCoordsNV = procedure(path : GLUInt; coordStart : GLsizei; numCoords : GLSizei; coordType : GLenum; const coords : PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathStringNV = procedure(path : GLUInt; format : GLenum; length : GLsizei; const pathString : PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathGlyphsNV = procedure(firstPathName : GLuint; fontTarget : GLenum; const fontName : PGLvoid; fontStyle : GLbitfield; numGlyphs : GLsizei; type_ : GLenum; const charcodes : PGLvoid; handleMissingGlyphs : GLenum; pathParameterTemplate : GLUInt; emScale : GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathGlyphRangeNV = procedure(firstPathName : GLuint; fontTarget : GLenum; const fontName : PGLvoid; fontStyle : GLbitfield; firstGlyph : GLuint; numGlyphs : GLsizei; handleMissingGlyphs : GLenum; pathParameterTemplate : GLUInt; emScale : GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglWeightPathsNV = procedure(resultPath : GLUInt; numPaths : GLSizei; const paths : PGLuint; const weights : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyPathNV = procedure(resultPath : GLUInt; srcPath : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInterpolatePathsNV = procedure(resultPath : GLUInt; pathA : GLUInt; pathB : GLUInt; weight : GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTransformPathNV = procedure(resultPath : GLUInt; srcPath : GLuint; transformType : GLenum; const transformValues : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathParameterivNV = procedure(path : GLUInt; pname : GLEnum; const value : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathParameteriNV = procedure(path : GLUInt; pname : GLEnum; value : GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathParameterfvNV = procedure(path : GLUInt; pname : GLEnum; const value : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathParameterfNV = procedure(path : GLUInt; pname : GLEnum; value : GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathDashArrayNV = procedure(path : GLUInt; dashCount : GLsizei; const dashArray : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathStencilFuncNV = procedure(func : GLenum; ref : GLint; mask : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathStencilDepthOffsetNV = procedure(factor : GLfloat; units : GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilFillPathNV = procedure(path : GLUInt; fillMode : GLenum; mask : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilStrokePathNV = procedure(path : GLUInt; reference : GLint; mask : GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilFillPathInstancedNV = procedure(numPaths : GLSizei; pathNameType : GLenum; const paths : PGLvoid; pathBase : GLUInt; fillMode : GLenum; mask : GLuint; transformType : GLenum; const transformValues : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStencilStrokePathInstancedNV = procedure(numPaths : GLSizei; pathNameType : GLenum; const paths : PGLvoid; pathBase : GLUInt; reference : GLint; mask : GLuint; transformType : GLenum; const transformValues : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathCoverDepthFuncNV = procedure(func : GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathColorGenNV = procedure(color : GLenum; genMode : GLenum; colorFormat : GLenum; const coeffs : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathTexGenNV = procedure(texCoordSet : GLenum; genMode : GLenum; components : GLint; const coeffs : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPathFogGenNV = procedure(genMode : GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCoverFillPathNV = procedure(path : GLUInt; coverMode : GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCoverStrokePathNV = procedure(path : GLUInt; coverMode : GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCoverFillPathInstancedNV = procedure(numPaths : GLSizei; pathNameType : GLenum; const paths : PGLvoid; pathBase : GLUInt; coverMode : GLenum; transformType : GLenum; const transformValues : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCoverStrokePathInstancedNV = procedure(numPaths : GLSizei; pathNameType : GLenum; const paths : PGLvoid; pathBase : GLUInt; coverMode : GLenum; transformType : GLenum; const transformValues : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathParameterivNV = procedure(path : GLUInt; pname : GLEnum; value : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathParameterfvNV = procedure(path : GLUInt; pname : GLEnum; value : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathCommandsNV = procedure(path : GLUInt; commands : PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathCoordsNV = procedure(path : GLUInt; coords : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathDashArrayNV = procedure(path : GLUInt; dashArray : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathMetricsNV = procedure(metricQueryMask : GLbitfield; numPaths : GLSizei; pathNameType : GLenum; const paths : PGLvoid; pathBase : GLUInt; stride : GLsizei; metrics : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathMetricRangeNV = procedure(metricQueryMask : GLbitfield; firstPathName : GLuint; numPaths : GLSizei; stride : GLsizei; metrics : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathSpacingNV = procedure(pathListMode : GLenum; numPaths : GLSizei; pathNameType : GLenum; const paths : PGLvoid; pathBase : GLUInt; advanceScale : GLfloat; kerningScale : GLfloat; transformType : GLenum; returnedSpacing : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathColorGenivNV = procedure(color : GLenum; pname : GLEnum; value : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathColorGenfvNV = procedure(color : GLenum; pname : GLEnum; value : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathTexGenivNV = procedure(texCoordSet : GLenum; pname : GLEnum; value : PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathTexGenfvNV = procedure(texCoordSet : GLenum; pname : GLEnum; value : PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsPointInFillPathNV = function(path : GLUInt; mask : GLuint; x : GLfloat; y : GLfloat) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsPointInStrokePathNV = function (path : GLUInt; x : GLfloat; y : GLfloat) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPathLengthNV = function(path : GLUInt; startSegment : GLsizei; numSegments : GLsizei) : GLfloat; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointAlongPathNV = function(path : GLUInt; startSegment : GLsizei; numSegments : GLsizei; distance : GLfloat; x : PGLfloat; y : PGLfloat; tangentX : PGLfloat; tangentY : PGLfloat) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_pinned_memory - - // GL_AMD_stencil_operation_extended - TglStencilOpValueAMD = procedure(face : GLEnum; value : GLUInt); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_AMD_vertex_shader_viewport_index - - // GL_AMD_vertex_shader_layer - - // GL_NV_bindless_texture - TglGetTextureHandleNV = function(texture : GLuint ) : GLuint64; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetTextureSamplerHandleNV = function(texture : GLuint; sampler : GLuint) : GLuint64; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMakeTextureHandleResidentNV = procedure(handle : GLUint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMakeTextureHandleNonResidentNV = procedure(handle : GLUint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetImageHandleNV = function(texture : GLuint; level : GLint; layered : GLboolean; layer : GLint; format : GLenum) : GLUInt64; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMakeImageHandleResidentNV = procedure(handle : GLUint64; access : GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglMakeImageHandleNonResidentNV = procedure(handle : GLUint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformHandleui64NV = procedure(location : GLint; value : GLuint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglUniformHandleui64vNV = procedure(location : GLint; cowunt : GLsizei; const value : PGLuint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformHandleui64NV = procedure(program_ : GLuint; location : GLint; value : GLuint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglProgramUniformHandleui64vNV = procedure(program_ : GLuint; location : GLint; count : GLsizei; const values : PGLuint64); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsTextureHandleResidentNV = function(handle : GLUint64) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsImageHandleResidentNV = function(handle : GLUint64) : GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_NV_shader_atomic_float - - // GL_AMD_query_buffer_object - - // - - // GL_PGI_misc_hints - TglHintPGI = procedure(target: GLenum; mode: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_detail_texture - TglDetailTexFuncSGIS = procedure(target: GLenum; n: GLsizei; const points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetDetailTexFuncSGIS = procedure(target: GLenum; points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_fog_function - TglFogFuncSGIS = procedure(n: GLsizei; const points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFogFuncSGIS = procedure(points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_multisample - TglSampleMaskSGIS = procedure(value: GLclampf; invert: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSamplePatternSGIS = procedure(pattern: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_pixel_texture - TglPixelTexGenParameteriSGIS = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTexGenParameterivSGIS = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTexGenParameterfSGIS = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPixelTexGenParameterfvSGIS = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPixelTexGenParameterivSGIS = procedure(pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetPixelTexGenParameterfvSGIS = procedure(pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_point_parameters - TglPointParameterfSGIS = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPointParameterfvSGIS = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_sharpen_texture - TglSharpenTexFuncSGIS = procedure(target: GLenum; n: GLsizei; const points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetSharpenTexFuncSGIS = procedure(target: GLenum; points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_texture4D - TglTexImage4DSGIS = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; size4d: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexSubImage4DSGIS = procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; woffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; size4d: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_texture_color_mask - TglTextureColorMaskSGIS = procedure(red: GLboolean; green: GLboolean; blue: GLboolean; alpha: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIS_texture_filter4 - TglGetTexFilterFuncSGIS = procedure(target: GLenum; filter: GLenum; weights: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexFilterFuncSGIS = procedure(target: GLenum; filter: GLenum; n: GLsizei; const weights: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_async - TglAsyncMarkerSGIX = procedure(marker: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFinishAsyncSGIX = function(markerp: PGLuint): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPollAsyncSGIX = function(markerp: PGLuint): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGenAsyncMarkersSGIX = function(range: GLsizei): GLuint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeleteAsyncMarkersSGIX = procedure(marker: GLuint; range: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglIsAsyncMarkerSGIX = function(marker: GLuint): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_flush_raster - TglFlushRasterSGIX = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_fragment_lighting - TglFragmentColorMaterialSGIX = procedure(face: GLenum; mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightfSGIX = procedure(light: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightfvSGIX = procedure(light: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightiSGIX = procedure(light: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightivSGIX = procedure(light: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightModelfSGIX = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightModelfvSGIX = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightModeliSGIX = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentLightModelivSGIX = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentMaterialfSGIX = procedure(face: GLenum; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentMaterialfvSGIX = procedure(face: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentMaterialiSGIX = procedure(face: GLenum; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglFragmentMaterialivSGIX = procedure(face: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFragmentLightfvSGIX = procedure(light: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFragmentLightivSGIX = procedure(light: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFragmentMaterialfvSGIX = procedure(face: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetFragmentMaterialivSGIX = procedure(face: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLightEnviSGIX = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_framezoom - TglFrameZoomSGIX = procedure(factor: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_igloo_interface - TglIglooInterfaceSGIX = procedure(pname: GLenum; const params: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_instruments - TglGetInstrumentsSGIX = function(): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglInstrumentsBufferSGIX = procedure(size: GLsizei; buffer: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglPollInstrumentsSGIX = function(marker_p: PGLint): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReadInstrumentsSGIX = procedure(marker: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStartInstrumentsSGIX = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglStopInstrumentsSGIX = procedure(marker: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_list_priority - TglGetListParameterfvSGIX = procedure(list: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetListParameterivSGIX = procedure(list: GLuint; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglListParameterfSGIX = procedure(list: GLuint; pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglListParameterfvSGIX = procedure(list: GLuint; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglListParameteriSGIX = procedure(list: GLuint; pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglListParameterivSGIX = procedure(list: GLuint; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_pixel_texture - TglPixelTexGenSGIX = procedure(mode: GLenum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_polynomial_ffd - TglDeformationMap3dSGIX = procedure(target: GLenum; u1: GLdouble; u2: GLdouble; ustride: GLint; uorder: GLint; v1: GLdouble; v2: GLdouble; vstride: GLint; vorder: GLint; w1: GLdouble; w2: GLdouble; wstride: GLint; worder: GLint; const points: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeformationMap3fSGIX = procedure(target: GLenum; u1: GLfloat; u2: GLfloat; ustride: GLint; uorder: GLint; v1: GLfloat; v2: GLfloat; vstride: GLint; vorder: GLint; w1: GLfloat; w2: GLfloat; wstride: GLint; worder: GLint; const points: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglDeformSGIX = procedure(mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglLoadIdentityDeformationMapSGIX = procedure(mask: GLbitfield); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_reference_plane - TglReferencePlaneSGIX = procedure(const equation: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_sprite - TglSpriteParameterfSGIX = procedure(pname: GLenum; param: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSpriteParameterfvSGIX = procedure(pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSpriteParameteriSGIX = procedure(pname: GLenum; param: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglSpriteParameterivSGIX = procedure(pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGIX_tag_sample_buffer - TglTagSampleBufferSGIX = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SGI_color_table - TglColorTableSGI = procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const table: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorTableParameterfvSGI = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColorTableParameterivSGI = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglCopyColorTableSGI = procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableSGI = procedure(target: GLenum; format: GLenum; _type: GLenum; table: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableParameterfvSGI = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGetColorTableParameterivSGI = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SUNX_constant_data - TglFinishTextureSUNX = procedure(); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SUN_global_alpha - TglGlobalAlphaFactorbSUN = procedure(factor: GLbyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGlobalAlphaFactorsSUN = procedure(factor: GLshort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGlobalAlphaFactoriSUN = procedure(factor: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGlobalAlphaFactorfSUN = procedure(factor: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGlobalAlphaFactordSUN = procedure(factor: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGlobalAlphaFactorubSUN = procedure(factor: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGlobalAlphaFactorusSUN = procedure(factor: GLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglGlobalAlphaFactoruiSUN = procedure(factor: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SUN_mesh_array - TglDrawMeshArraysSUN = procedure(mode: GLenum; first: GLint; count: GLsizei; width: GLsizei); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SUN_triangle_list - TglReplacementCodeuiSUN = procedure(code: GLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeusSUN = procedure(code: GLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeubSUN = procedure(code: GLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuivSUN = procedure(const code: PGLuint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeusvSUN = procedure(const code: PGLushort); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeubvSUN = procedure(const code: PGLubyte); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodePointerSUN = procedure(_type: GLenum; stride: GLsizei; const _pointer: PGLvoid); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // GL_SUN_vertex - TglColor4ubVertex2fSUN = procedure(r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4ubVertex2fvSUN = procedure(const c: PGLubyte; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4ubVertex3fSUN = procedure(r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4ubVertex3fvSUN = procedure(const c: PGLubyte; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3fVertex3fSUN = procedure(r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor3fVertex3fvSUN = procedure(const c: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3fVertex3fSUN = procedure(nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglNormal3fVertex3fvSUN = procedure(const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4fNormal3fVertex3fSUN = procedure(r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglColor4fNormal3fVertex3fvSUN = procedure(const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fVertex3fSUN = procedure(s: GLfloat; t: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fVertex3fvSUN = procedure(const tc: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4fVertex4fSUN = procedure(s: GLfloat; t: GLfloat; p: GLfloat; q: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4fVertex4fvSUN = procedure(const tc: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fColor4ubVertex3fSUN = procedure(s: GLfloat; t: GLfloat; r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fColor4ubVertex3fvSUN = procedure(const tc: PGLfloat; const c: PGLubyte; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fColor3fVertex3fSUN = procedure(s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fColor3fVertex3fvSUN = procedure(const tc: PGLfloat; const c: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fNormal3fVertex3fSUN = procedure(s: GLfloat; t: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fNormal3fVertex3fvSUN = procedure(const tc: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fColor4fNormal3fVertex3fSUN = procedure(s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord2fColor4fNormal3fVertex3fvSUN = procedure(const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4fColor4fNormal3fVertex4fSUN = procedure(s: GLfloat; t: GLfloat; p: GLfloat; q: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglTexCoord4fColor4fNormal3fVertex4fvSUN = procedure(const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiVertex3fSUN = procedure(rc: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiVertex3fvSUN = procedure(const rc: PGLuint; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiColor4ubVertex3fSUN = procedure(rc: GLuint; r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiColor4ubVertex3fvSUN = procedure(const rc: PGLuint; const c: PGLubyte; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiColor3fVertex3fSUN = procedure(rc: GLuint; r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiColor3fVertex3fvSUN = procedure(const rc: PGLuint; const c: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiNormal3fVertex3fSUN = procedure(rc: GLuint; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiNormal3fVertex3fvSUN = procedure(const rc: PGLuint; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiColor4fNormal3fVertex3fSUN = procedure(rc: GLuint; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiColor4fNormal3fVertex3fvSUN = procedure(const rc: PGLuint; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiTexCoord2fVertex3fSUN = procedure(rc: GLuint; s: GLfloat; t: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiTexCoord2fVertex3fvSUN = procedure(const rc: PGLuint; const tc: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiTexCoord2fNormal3fVertex3fSUN = procedure(rc: GLuint; s: GLfloat; t: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN = procedure(const rc: PGLuint; const tc: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN = procedure(rc: GLuint; s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TglReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN = procedure(const rc: PGLuint; const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - - // window support functions -{$IFDEF DGL_WIN} - TwglGetProcAddress = function(ProcName: PAnsiChar): Pointer; stdcall; - TwglCopyContext = function(p1: HGLRC; p2: HGLRC; p3: Cardinal): BOOL; stdcall; - TwglCreateContext = function(DC: HDC): HGLRC; stdcall; - TwglCreateLayerContext = function(p1: HDC; p2: Integer): HGLRC; stdcall; - TwglDeleteContext = function(p1: HGLRC): BOOL; stdcall; - TwglDescribeLayerPlane = function(p1: HDC; p2, p3: Integer; p4: Cardinal; p5: PLayerPlaneDescriptor): BOOL; stdcall; - TwglGetCurrentContext = function: HGLRC; stdcall; - TwglGetCurrentDC = function: HDC; stdcall; - TwglGetLayerPaletteEntries = function(p1: HDC; p2, p3, p4: Integer; var pcr): Integer; stdcall; - TwglMakeCurrent = function(DC: HDC; p2: HGLRC): BOOL; stdcall; - TwglRealizeLayerPalette = function(p1: HDC; p2: Integer; p3: BOOL): BOOL; stdcall; - TwglSetLayerPaletteEntries = function(p1: HDC; p2, p3, p4: Integer; var pcr): Integer; stdcall; - TwglShareLists = function(p1, p2: HGLRC): BOOL; stdcall; - TwglSwapLayerBuffers = function(p1: HDC; p2: Cardinal): BOOL; stdcall; - TwglSwapMultipleBuffers = function(p1: UINT; const p2: PWGLSWAP): DWORD; stdcall; - TwglUseFontBitmapsA = function(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; - TwglUseFontBitmapsW = function(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; - TwglUseFontBitmaps = function(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; - - TwglUseFontOutlinesA = function(p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; - TwglUseFontOutlinesW = function(p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; - TwglUseFontOutlines = function(p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; - - - // WGL_ARB_buffer_region - TwglCreateBufferRegionARB = function(hDC: HDC; iLayerPlane: GLint; uType: GLuint): THandle; stdcall; - TwglDeleteBufferRegionARB = procedure(hRegion: THandle); stdcall; - TwglSaveBufferRegionARB = function(hRegion: THandle; x: GLint; y: GLint; width: GLint; height: GLint): Boolean; stdcall; - TwglRestoreBufferRegionARB = function(hRegion: THandle; x: GLint; y: GLint; width: GLint; height: GLint; xSrc: GLint; ySrc: GLint): Boolean; stdcall; - - // WGL_ARB_extensions_string - TwglGetExtensionsStringARB = function(hdc: HDC): PAnsiChar; stdcall; - - // WGL_ARB_make_current_read - TwglMakeContextCurrentARB = function(hDrawDC: HDC; hReadDC: HDC; hglrc: HGLRC): Boolean; stdcall; - TwglGetCurrentReadDCARB = function(): HDC; stdcall; - - // WGL_ARB_pbuffer - TwglCreatePbufferARB = function(hDC: HDC; iPixelFormat: GLint; iWidth: GLint; iHeight: GLint; const piAttribList: PGLint): HPBUFFERARB; stdcall; - TwglGetPbufferDCARB = function(hPbuffer: HPBUFFERARB): HDC; stdcall; - TwglReleasePbufferDCARB = function(hPbuffer: HPBUFFERARB; hDC: HDC): GLint; stdcall; - TwglDestroyPbufferARB = function(hPbuffer: HPBUFFERARB): Boolean; stdcall; - TwglQueryPbufferARB = function(hPbuffer: HPBUFFERARB; iAttribute: GLint; piValue: PGLint): Boolean; stdcall; - - // WGL_ARB_pixel_format - TwglGetPixelFormatAttribivARB = function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; const piAttributes: PGLint; piValues: PGLint): Boolean; stdcall; - TwglGetPixelFormatAttribfvARB = function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; const piAttributes: PGLint; pfValues: PGLfloat): Boolean; stdcall; - TwglChoosePixelFormatARB = function(hdc: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLfloat; nMaxFormats: GLuint; piFormats: PGLint; nNumFormats: PGLuint): BOOL; stdcall; - - // WGL_ARB_color_buffer_float - TwglClampColorARB = procedure(target: GLenum; clamp: GLenum); stdcall; - - // WGL_ARB_render_texture - TwglBindTexImageARB = function(hPbuffer: HPBUFFERARB; iBuffer: GLint): Boolean; stdcall; - TwglReleaseTexImageARB = function(hPbuffer: HPBUFFERARB; iBuffer: GLint): Boolean; stdcall; - TwglSetPbufferAttribARB = function(hPbuffer: HPBUFFERARB; const piAttribList: PGLint): Boolean; stdcall; - - // WGL_ARB_create_context - TwglCreateContextAttribsARB = function(hDC: HDC; hShareContext: HGLRC; const attribList: PGLint): HGLRC; stdcall; - - // WGL_AMD_gpu_association - TwglGetGPUIDsAMD = function(maxCount: Cardinal; ids: PCardinal): Cardinal; stdcall; - TwglGetGPUInfoAMD = function(id: Cardinal; property_: Integer; dataType: GLenum; size: Cardinal; data: Pointer): Integer; stdcall; - TwglGetContextGPUIDAMD = function(hglrc: HGLRC): Cardinal; stdcall; - TwglCreateAssociatedContextAMD = function(id: Cardinal): HGLRC; stdcall; - TwglCreateAssociatedContextAttribsAMD = function(id: Cardinal; hShareContext: HGLRC; const attribList: PInteger): HGLRC; stdcall; - TwglDeleteAssociatedContextAMD = function(hglrc: HGLRC): Boolean; stdcall; - TwglMakeAssociatedContextCurrentAMD = function(hglrc: HGLRC): Boolean; stdcall; - TwglGetCurrentAssociatedContextAMD = function(): HGLRC; stdcall; - TwglBlitContextFramebufferAMD = procedure(dstCtx: HGLRC; srcX0: GLint; srcY0: GLint; srcX1: GLint; srcY1: GLint; dstX0: GLint; dstY0: GLint; dstX1: GLint; dstY1: GLint; mask: GLbitfield; filter: GLenum); stdcall; - - // WGL_EXT_display_color_table - TwglCreateDisplayColorTableEXT = function(id: GLushort): GLboolean; stdcall; - TwglLoadDisplayColorTableEXT = function(const table: PGLushort; length: GLuint): GLboolean; stdcall; - TwglBindDisplayColorTableEXT = function(id: GLushort): GLboolean; stdcall; - TwglDestroyDisplayColorTableEXT = procedure(id: GLushort); stdcall; - - // WGL_EXT_extensions_string - TwglGetExtensionsStringEXT = function(): PAnsiChar; stdcall; - - // WGL_EXT_make_current_read - TwglMakeContextCurrentEXT = function(hDrawDC: HDC; hReadDC: HDC; hglrc: HGLRC): Boolean; stdcall; - TwglGetCurrentReadDCEXT = function(): HDC; stdcall; - - // WGL_EXT_pbuffer - TwglCreatePbufferEXT = function(hDC: HDC; iPixelFormat: GLint; iWidth: GLint; iHeight: GLint; const piAttribList: PGLint): HPBUFFEREXT; stdcall; - TwglGetPbufferDCEXT = function(hPbuffer: HPBUFFEREXT): HDC; stdcall; - TwglReleasePbufferDCEXT = function(hPbuffer: HPBUFFEREXT; hDC: HDC): GLint; stdcall; - TwglDestroyPbufferEXT = function(hPbuffer: HPBUFFEREXT): Boolean; stdcall; - TwglQueryPbufferEXT = function(hPbuffer: HPBUFFEREXT; iAttribute: GLint; piValue: PGLint): Boolean; stdcall; - - // WGL_EXT_pixel_format - TwglGetPixelFormatAttribivEXT = function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; piAttributes: PGLint; piValues: PGLint): Boolean; stdcall; - TwglGetPixelFormatAttribfvEXT = function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; piAttributes: PGLint; pfValues: PGLfloat): Boolean; stdcall; - TwglChoosePixelFormatEXT = function(hdc: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLfloat; nMaxFormats: GLuint; piFormats: PGLint; nNumFormats: PGLuint): Boolean; stdcall; - - // WGL_EXT_swap_control - TwglSwapIntervalEXT = function(interval: GLint): Boolean; stdcall; - TwglGetSwapIntervalEXT = function(): GLint; stdcall; - - // WGL_I3D_digital_video_control - TwglGetDigitalVideoParametersI3D = function(hDC: HDC; iAttribute: GLint; piValue: PGLint): Boolean; stdcall; - TwglSetDigitalVideoParametersI3D = function(hDC: HDC; iAttribute: GLint; const piValue: PGLint): Boolean; stdcall; - - // WGL_I3D_gamma - TwglGetGammaTableParametersI3D = function(hDC: HDC; iAttribute: GLint; piValue: PGLint): Boolean; stdcall; - TwglSetGammaTableParametersI3D = function(hDC: HDC; iAttribute: GLint; const piValue: PGLint): Boolean; stdcall; - TwglGetGammaTableI3D = function(hDC: HDC; iEntries: GLint; puRed: PGLushort; puGreen: PGLushort; puBlue: PGLushort): Boolean; stdcall; - TwglSetGammaTableI3D = function(hDC: HDC; iEntries: GLint; const puRed: PGLushort; const puGreen: PGLushort; const puBlue: PGLushort): Boolean; stdcall; - - // WGL_I3D_genlock - TwglEnableGenlockI3D = function(hDC: HDC): Boolean; stdcall; - TwglDisableGenlockI3D = function(hDC: HDC): Boolean; stdcall; - TwglIsEnabledGenlockI3D = function(hDC: HDC; pFlag: Boolean): Boolean; stdcall; - TwglGenlockSourceI3D = function(hDC: HDC; uSource: GLuint): Boolean; stdcall; - TwglGetGenlockSourceI3D = function(hDC: HDC; uSource: PGLuint): Boolean; stdcall; - TwglGenlockSourceEdgeI3D = function(hDC: HDC; uEdge: GLuint): Boolean; stdcall; - TwglGetGenlockSourceEdgeI3D = function(hDC: HDC; uEdge: PGLuint): Boolean; stdcall; - TwglGenlockSampleRateI3D = function(hDC: HDC; uRate: GLuint): Boolean; stdcall; - TwglGetGenlockSampleRateI3D = function(hDC: HDC; uRate: PGLuint): Boolean; stdcall; - TwglGenlockSourceDelayI3D = function(hDC: HDC; uDelay: GLuint): Boolean; stdcall; - TwglGetGenlockSourceDelayI3D = function(hDC: HDC; uDelay: PGLuint): Boolean; stdcall; - TwglQueryGenlockMaxSourceDelayI3D = function(hDC: HDC; uMaxLineDelay: PGLuint; uMaxPixelDelay: PGLuint): Boolean; stdcall; - - // WGL_I3D_image_buffer - TwglCreateImageBufferI3D = function(hDC: HDC; dwSize: GLuint; uFlags: GLuint): GLvoid; stdcall; - TwglDestroyImageBufferI3D = function(hDC: HDC; pAddress: GLvoid): Boolean; stdcall; - TwglAssociateImageBufferEventsI3D = function(hDC: HDC; const pEvent: THandle; const pAddress: PGLvoid; const pSize: PGLuint; count: GLuint): Boolean; stdcall; - TwglReleaseImageBufferEventsI3D = function(hDC: HDC; const pAddress: PGLvoid; count: GLuint): Boolean; stdcall; - - // WGL_I3D_swap_frame_lock - TwglEnableFrameLockI3D = function(): Boolean; stdcall; - TwglDisableFrameLockI3D = function(): Boolean; stdcall; - TwglIsEnabledFrameLockI3D = function(pFlag: Boolean): Boolean; stdcall; - TwglQueryFrameLockMasterI3D = function(pFlag: Boolean): Boolean; stdcall; - - // WGL_I3D_swap_frame_usage - TwglGetFrameUsageI3D = function(pUsage: PGLfloat): Boolean; stdcall; - TwglBeginFrameTrackingI3D = function(): Boolean; stdcall; - TwglEndFrameTrackingI3D = function(): Boolean; stdcall; - TwglQueryFrameTrackingI3D = function(pFrameCount: PGLuint; pMissedFrames: PGLuint; pLastMissedUsage: PGLfloat): Boolean; stdcall; - - // WGL_NV_vertex_array_range - TwglAllocateMemoryNV = procedure(size: GLsizei; readfreq: GLfloat; writefreq: GLfloat; priority: GLfloat); stdcall; - TwglFreeMemoryNV = procedure(_pointer: Pointer); stdcall; - - // WGL_NV_present_video - TwglEnumerateVideoDevicesNV = function(hdc: HDC; phDeviceList: PHVIDEOOUTPUTDEVICENV): Integer; stdcall; - TwglBindVideoDeviceNV = function(hd: HDC; uVideoSlot: Cardinal; hVideoDevice: HVIDEOOUTPUTDEVICENV; piAttribList: PInteger): Boolean; stdcall; - TwglQueryCurrentContextNV = function(iAttribute: Integer; piValue: PInteger): Boolean; stdcall; - - // WGL_NV_video_output - TwglGetVideoDeviceNV = function(hDC: HDC; numDevices: Integer; hVideoDevice: PHPVIDEODEV): Boolean; stdcall; - TwglReleaseVideoDeviceNV = function(hVideoDevice: HPVIDEODEV): Boolean; stdcall; - TwglBindVideoImageNV = function(hVideoDevice: HPVIDEODEV; hPbuffer: HPBUFFERARB; iVideoBuffer: Integer): Boolean; stdcall; - TwglReleaseVideoImageNV = function(hPbuffer: HPBUFFERARB; iVideoBuffer: Integer): Boolean; stdcall; - TwglSendPbufferToVideoNV = function(hPbuffer: HPBUFFERARB; iBufferType: Integer; pulCounterPbuffer: PCardinal; bBlock: Boolean): Boolean; stdcall; - TwglGetVideoInfoNV = function(hpVideoDevice: HPVIDEODEV; pulCounterOutputPbuffer: PCardinal; pulCounterOutputVideo: PCardinal): Boolean; stdcall; - - // WGL_NV_swap_group - TwglJoinSwapGroupNV = function(hDC: HDC; group: GLuint): Boolean; stdcall; - TwglBindSwapBarrierNV = function(group: GLuint; barrier: GLuint): Boolean; stdcall; - TwglQuerySwapGroupNV = function(hDC: HDC; group: PGLuint; barrier: PGLuint): Boolean; stdcall; - TwglQueryMaxSwapGroupsNV = function(hDC: HDC; mxGroups: PGLuint; maxBarriers: PGLuint): Boolean; stdcall; - TwglQueryFrameCountNV = function(hDC: HDC; count: PGLuint): Boolean; stdcall; - TwglResetFrameCountNV = function(hDC: HDC): Boolean; stdcall; - - // WGL_NV_gpu_affinity - TwglEnumGpusNV = function(iGpuIndex: Cardinal; phGpu: PHGPUNV): Boolean; stdcall; - TwglEnumGpuDevicesNV = function(hGpu: HGPUNV; iDeviceIndex: Cardinal; lpGpuDevice: PGPU_DEVICE): Boolean; stdcall; - TwglCreateAffinityDCNV = function(const phGpuList: PHGPUNV): HDC; stdcall; - TwglEnumGpusFromAffinityDCNV = function(hAffinityDC: HDC; iGpuIndex: Cardinal; hGpu: PHGPUNV): Boolean; stdcall; - TwglDeleteDCNV = function(hDC: HDC): Boolean; stdcall; - - // WGL_NV_video_capture - TwglBindVideoCaptureDeviceNV = function(uVideoSlot: Cardinal; hDevice: HVIDEOINPUTDEVICENV): Boolean; stdcall; - TwglEnumerateVideoCaptureDevicesNV = function(hDc: HDC; phDeviceList: PHVIDEOINPUTDEVICENV): Cardinal; stdcall; - TwglLockVideoCaptureDeviceNV = function(hDc: HDC; hDevice: HVIDEOINPUTDEVICENV): Boolean; stdcall; - TwglQueryVideoCaptureDeviceNV = function(hDc: HDC; hDevice: HVIDEOINPUTDEVICENV; iAttribute: Integer; piValue: PInteger): Boolean; stdcall; - TwglReleaseVideoCaptureDeviceNV = function(hDc: HDC; hDevice: HVIDEOINPUTDEVICENV): Boolean; stdcall; - - // WGL_NV_copy_image - TwglCopyImageSubDataNV = function(hSrcRc: HGLRC; srcName: GLuint; srcTarget: GLenum; srcLevel: GLint; srcX: GLint; srcY: GLint; srcZ: GLint; hDstRC: HGLRC; dstName: GLuint; dstTarget: GLenum; dstLevel: GLint; dstX: GLint; dstY: GLint; dstZ: GLint; width: GLsizei; height: GLsizei; depth: GLsizei): Boolean; stdcall; - - // WGL_NV_DX_interop - TwglDXSetResourceShareHandleNV = function(dxObject : PGLVoid; hareHandle : Cardinal) : Boolean; stdcall; - TwglDXOpenDeviceNV = function(dxDevice : PGLVoid) : Cardinal; stdcall; - TwglDXCloseDeviceNV = function(hDevice : Cardinal) : Boolean; stdcall; - TwglDXRegisterObjectNV = function(hDevice : Cardinal; dxObject : PGLVoid; name : GLUInt; _type : TGLEnum; access : TGLenum) : Cardinal; stdcall; - TwglDXUnregisterObjectNV = function(hDevice : Cardinal; hObject : Cardinal) : Boolean; stdcall; - TwglDXObjectAccessNV = function(hObject : Cardinal; access : GLenum) : Boolean; stdcall; - TwglDXLockObjectsNV = function(hDevice : Cardinal; count : GLint; hObjects : PCardinal) : Boolean; stdcall; - TwglDXUnlockObjectsNV = function (hDevice : Cardinal; count : GLint; hObjects : PCardinal) : Boolean; stdcall; - - // WGL_OML_sync_control - TwglGetSyncValuesOML = function(hdc: HDC; ust: PGLint64; msc: PGLint64; sbc: PGLint64): Boolean; stdcall; - TwglGetMscRateOML = function(hdc: HDC; numerator: PGLint; denominator: PGLint): Boolean; stdcall; - TwglSwapBuffersMscOML = function(hdc: HDC; target_msc: GLint64; divisor: GLint64; remainder: GLint64): GLint64; stdcall; - TwglSwapLayerBuffersMscOML = function(hdc: HDC; fuPlanes: GLint; target_msc: GLint64; divisor: GLint64; remainder: GLint64): GLint64; stdcall; - TwglWaitForMscOML = function(hdc: HDC; target_msc: GLint64; divisor: GLint64; remainder: GLint64; ust: PGLint64; msc: PGLint64; sbc: PGLint64): Boolean; stdcall; - TwglWaitForSbcOML = function(hdc: HDC; target_sbc: GLint64; ust: PGLint64; msc: PGLint64; sbc: PGLint64): Boolean; stdcall; - - // WGL_3DL_stereo_control - TwglSetStereoEmitterState3DL = function(hDC: HDC; uState: UINT): Boolean; stdcall; - - // WIN_draw_range_elements - TglDrawRangeElementsWIN = procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei; _type: GLenum; const indices: PGLvoid); stdcall; - - // WIN_swap_hint - TglAddSwapHintRectWIN = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei); stdcall; -{$ENDIF} - -{$IFDEF DGL_LINUX} - TglXChooseVisual = function(dpy: PDisplay; screen: GLint; attribList: PGLint): PXVisualInfo; cdecl; - TglXCopyContext = procedure(dpy: PDisplay; src: GLXContext; dst: GLXContext; mask: GLuint); cdecl; - TglXCreateContext = function(dpy: PDisplay; vis: PXVisualInfo; shareList: GLXContext; direct: GLboolean): GLXContext; cdecl; - TglXCreateGLXPixmap = function(dpy: PDisplay; vis: PXVisualInfo; pixmap: Pixmap): GLXPixmap cdecl; - TglXDestroyContext = procedure(dpy: PDisplay; ctx: GLXContext); cdecl; - TglXDestroyGLXPixmap = procedure(dpy : PDisplay; pix: GLXPixmap); cdecl; - TglXGetConfig = function(dpy : PDisplay; vis: PXVisualInfo; attrib: GLint; value: PGLint): GLint; cdecl; - TglXGetCurrentContext = function: GLXContext cdecl; - TglXGetCurrentDrawable = function: GLXDrawable cdecl; - TglXIsDirect = function(dpy: PDisplay; ctx: GLXContext): glboolean; cdecl; - TglXMakeCurrent = function(dpy: PDisplay; drawable: GLXDrawable; ctx: GLXContext): GLboolean cdecl; - TglXQueryExtension = function(dpy: PDisplay; errorBase: PGLint; eventBase: PGLint): GLboolean; cdecl; - TglXQueryVersion = function(dpy: PDisplay; major: PGLint; minor: PGLint): GLboolean cdecl; - TglXSwapBuffers = procedure(dpy: PDisplay; drawable: GLXDrawable); cdecl; - TglXUseXFont = procedure(font: Font; first: GLint; count: GLint; listBase: GLint); cdecl; - TglXWaitGL = procedure; cdecl; - TglXWaitX = procedure; cdecl; - - TglXGetClientString = function(dpy: PDisplay; name: GLint): PGLchar; cdecl; - TglXQueryServerString = function(dpy: PDisplay; screen: GLint; name: GLint): PGLchar; cdecl; - TglXQueryExtensionsString = function(dpy: PDisplay; screen: GLint): PGLchar; cdecl; - - // GLX_VERSION_1_3 - TglXGetFBConfigs = function(dpy: PDisplay; screen: GLint; nelements: PGLint): GLXFBConfig; cdecl; - TglXChooseFBConfig = function(dpy: PDisplay; screen: GLint; attrib_list: PGLint; nelements: PGLint): GLXFBConfig; cdecl; - TglXGetFBConfigAttrib = function(dpy: PDisplay; config: GLXFBConfig; attribute: GLint; value: PGLint): glint; cdecl; - TglXGetVisualFromFBConfig = function(dpy: PDisplay; config: GLXFBConfig) : PXVisualInfo; - TglXCreateWindow = function(dpy: PDisplay; config: GLXFBConfig; win: Window; attrib_list: PGLint): GLXWindow; cdecl; - TglXDestroyWindow = procedure(dpy: PDisplay; win: GLXWindow); cdecl; - TglXCreatePixmap = function(dpy: PDisplay; config: GLXFBConfig; pixmap: Pixmap; attrib_list: PGLint): GLXPixmap; cdecl; - - TglXDestroyPixmap = procedure(dpy: PDisplay; pixmap: GLXPixmap); cdecl; - TglXCreatePbuffer = function(dpy: PDisplay; config: GLXFBConfig; attrib_list: PGLint): GLXPbuffer; cdecl; - TglXDestroyPbuffer = procedure(dpy: PDisplay; pbuf: GLXPbuffer); cdecl; - TglXQueryDrawable = procedure(dpy: PDisplay; draw: GLXDrawable; attribute: GLint; value: PGLuint); cdecl; - TglXCreateNewContext = function(dpy: PDisplay; config: GLXFBConfig; render_type: GLint; share_list: GLXContext; direct: GLboolean): GLXContext cdecl; - TglXMakeContextCurrent = function(display: PDisplay; draw: GLXDrawable; read_: GLXDrawable; ctx: GLXContext): GLboolean; cdecl; - TglXGetCurrentReadDrawable = function: GLXDrawable; cdecl; - TglXGetCurreentDisplay = function: PDisplay; - - TglXQueryContext = function(dpy: PDisplay; ctx: GLXContext; attribute: GLint; value: PGLint): GLint; cdecl; - TglXSelectEvent = procedure(dpy: PDisplay; draw: GLXDrawable; event_mask: GLuint); cdecl; - TglXGetSelectedEvent = procedure(dpy: PDisplay; draw: GLXDrawable; event_mask: PGLuint); cdecl; - - // GLX_VERSION_1_4 - TglXGetProcAddress = function(const name: PAnsiChar): pointer; cdecl; - - // GLX_ARB_get_proc_address - TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl; - - // GLX_ARB_create_context - TglXCreateContextAttribsARB = function(dpy: PDisplay; config: GLXFBConfig; share_context: GLXContext; direct: GLboolean; const attrib_list: PGLint): GLXContext; cdecl; - - // GLX_EXT_import_context - TglXGetCurrentDisplayEXT = function: PDisplay; cdecl; - TglXQueryContextInfoEXT = function(dpy: PDisplay; context: GLXContext; attribute: GLint; value: PGLint): GLint; cdecl; - TglXGetContextIDEXT = function(const context: GLXContext): GLXContextID; cdecl; - TglXImportContextEXT = function(dpy: PDisplay; contextID: GLXContextID): GLXContext; cdecl; - TglXFreeContextEXT = procedure(dpy: PDisplay; context: GLXContext); cdecl; - - // GLX_EXT_texture_from_pixmap - TglXBindTexImageEXT = procedure(dpy: PDisplay; drawable: GLXDrawable; buffer: GLint; const attrib_list: PGLint); cdecl; - TglXReleaseTexImageEXT = procedure(dpy: PDisplay; drawable: GLXDrawable; buffer: GLint); cdecl; -{$ENDIF} - - // GL utility functions and procedures - TgluErrorString = function(errCode: GLEnum): PAnsiChar; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluGetString = function(name: GLEnum): PAnsiChar; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluOrtho2D = procedure(left, right, bottom, top: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluPerspective = procedure(fovy, aspect, zNear, zFar: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluPickMatrix = procedure(x, y, width, height: GLdouble; const viewport: TVector4i); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluLookAt = procedure(eyex, eyey, eyez, centerx, centery, centerz, upx, upy, upz: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluProject = function(objx, objy, objz: GLdouble; const modelMatrix: TGLMatrixd4; const projMatrix: TGLMatrixd4; const viewport: TVector4i; winx, winy, winz: PGLdouble): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluUnProject = function(winx, winy, winz: GLdouble; const modelMatrix: TGLMatrixd4; const projMatrix: TGLMatrixd4; const viewport: TVector4i; objx, objy, objz: PGLdouble): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluScaleImage = function(format: GLEnum; widthin, heightin: GLint; typein: GLEnum; datain: Pointer; widthout, heightout: GLint; typeout: GLEnum; const dataout: Pointer): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNewQuadric = function: PGLUquadric; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluDeleteQuadric = procedure(state: PGLUquadric); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluQuadricNormals = procedure(quadObject: PGLUquadric; normals: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluQuadricTexture = procedure(quadObject: PGLUquadric; textureCoords: GLboolean); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluQuadricOrientation = procedure(quadObject: PGLUquadric; orientation: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluQuadricDrawStyle = procedure(quadObject: PGLUquadric; drawStyle: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluCylinder = procedure(quadObject: PGLUquadric; baseRadius, topRadius, height: GLdouble; slices, stacks: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluDisk = procedure(quadObject: PGLUquadric; innerRadius, outerRadius: GLdouble; slices, loops: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluPartialDisk = procedure(quadObject: PGLUquadric; innerRadius, outerRadius: GLdouble; slices, loops: GLint; startAngle, sweepAngle: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluSphere = procedure(quadObject: PGLUquadric; radius: GLdouble; slices, stacks: GLint); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluQuadricCallback = procedure(quadObject: PGLUquadric; which: GLEnum; fn: TGLUQuadricErrorProc); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNewTess = function: PGLUtesselator; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluDeleteTess = procedure(tess: PGLUtesselator); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessBeginPolygon = procedure(tess: PGLUtesselator; polygon_data: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessBeginContour = procedure(tess: PGLUtesselator); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessVertex = procedure(tess: PGLUtesselator; const coords: TGLArrayd3; data: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessEndContour = procedure(tess: PGLUtesselator); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessEndPolygon = procedure(tess: PGLUtesselator); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessProperty = procedure(tess: PGLUtesselator; which: GLEnum; value: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessNormal = procedure(tess: PGLUtesselator; x, y, z: GLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluTessCallback = procedure(tess: PGLUtesselator; which: GLEnum; fn: Pointer); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluGetTessProperty = procedure(tess: PGLUtesselator; which: GLEnum; value: PGLdouble); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNewNurbsRenderer = function: PGLUnurbs; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluDeleteNurbsRenderer = procedure(nobj: PGLUnurbs); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluBeginSurface = procedure(nobj: PGLUnurbs); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluBeginCurve = procedure(nobj: PGLUnurbs); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluEndCurve = procedure(nobj: PGLUnurbs); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluEndSurface = procedure(nobj: PGLUnurbs); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluBeginTrim = procedure(nobj: PGLUnurbs); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluEndTrim = procedure(nobj: PGLUnurbs); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluPwlCurve = procedure(nobj: PGLUnurbs; count: GLint; points: PGLfloat; stride: GLint; atype: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNurbsCurve = procedure(nobj: PGLUnurbs; nknots: GLint; knot: PGLfloat; stride: GLint; ctlarray: PGLfloat; order: GLint; atype: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNurbsSurface = procedure(nobj: PGLUnurbs; sknot_count: GLint; sknot: PGLfloat; tknot_count: GLint; tknot: PGLfloat; s_stride, t_stride: GLint; ctlarray: PGLfloat; sorder, torder: GLint; atype: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluLoadSamplingMatrices = procedure(nobj: PGLUnurbs; const modelMatrix, projMatrix: TGLMatrixf4; const viewport: TVector4i); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNurbsProperty = procedure(nobj: PGLUnurbs; aproperty: GLEnum; value: GLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluGetNurbsProperty = procedure(nobj: PGLUnurbs; aproperty: GLEnum; value: PGLfloat); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNurbsCallback = procedure(nobj: PGLUnurbs; which: GLEnum; fn: TGLUNurbsErrorProc); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluBeginPolygon = procedure(tess: PGLUtesselator); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluNextContour = procedure(tess: PGLUtesselator; atype: GLEnum); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - TgluEndPolygon = procedure(tess: PGLUtesselator); {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - -var - // GL_VERSION_1_0 - glCullFace: TglCullFace; - glFrontFace: TglFrontFace; - glHint: TglHint; - glLineWidth: TglLineWidth; - glPointSize: TglPointSize; - glPolygonMode: TglPolygonMode; - glScissor: TglScissor; - glTexParameterf: TglTexParameterf; - glTexParameterfv: TglTexParameterfv; - glTexParameteri: TglTexParameteri; - glTexParameteriv: TglTexParameteriv; - glTexImage1D: TglTexImage1D; - glTexImage2D: TglTexImage2D; - glDrawBuffer: TglDrawBuffer; - glClear: TglClear; - glClearColor: TglClearColor; - glClearStencil: TglClearStencil; - glClearDepth: TglClearDepth; - glStencilMask: TglStencilMask; - glColorMask: TglColorMask; - glDepthMask: TglDepthMask; - glDisable: TglDisable; - glEnable: TglEnable; - glFinish: TglFinish; - glFlush: TglFlush; - glBlendFunc: TglBlendFunc; - glLogicOp: TglLogicOp; - glStencilFunc: TglStencilFunc; - glStencilOp: TglStencilOp; - glDepthFunc: TglDepthFunc; - glPixelStoref: TglPixelStoref; - glPixelStorei: TglPixelStorei; - glReadBuffer: TglReadBuffer; - glReadPixels: TglReadPixels; - glGetBooleanv: TglGetBooleanv; - glGetDoublev: TglGetDoublev; - glGetError: TglGetError; - glGetFloatv: TglGetFloatv; - glGetIntegerv: TglGetIntegerv; - glGetString: TglGetString; - glGetTexImage: TglGetTexImage; - glGetTexParameteriv: TglGetTexParameteriv; - glGetTexParameterfv: TglGetTexParameterfv; - glGetTexLevelParameterfv: TglGetTexLevelParameterfv; - glGetTexLevelParameteriv: TglGetTexLevelParameteriv; - glIsEnabled: TglIsEnabled; - glDepthRange: TglDepthRange; - glViewport: TglViewport; - - // GL_VERSION_1_1 - glDrawArrays: TglDrawArrays; - glDrawElements: TglDrawElements; - glGetPointerv: TglGetPointerv; - glPolygonOffset: TglPolygonOffset; - glCopyTexImage1D: TglCopyTexImage1D; - glCopyTexImage2D: TglCopyTexImage2D; - glCopyTexSubImage1D: TglCopyTexSubImage1D; - glCopyTexSubImage2D: TglCopyTexSubImage2D; - glTexSubImage1D: TglTexSubImage1D; - glTexSubImage2D: TglTexSubImage2D; - glBindTexture: TglBindTexture; - glDeleteTextures: TglDeleteTextures; - glGenTextures: TglGenTextures; -{$ifdef DGL_DEPRECATED} - glAccum: TglAccum; - glAlphaFunc: TglAlphaFunc; - glAreTexturesResident: TglAreTexturesResident; - glArrayElement: TglArrayElement; - glBegin: TglBegin; - glBitmap: TglBitmap; - glCallList: TglCallList; - glCallLists: TglCallLists; - glClearAccum: TglClearAccum; - glClearIndex: TglClearIndex; - glClipPlane: TglClipPlane; - glColor3b: TglColor3b; - glColor3bv: TglColor3bv; - glColor3d: TglColor3d; - glColor3dv: TglColor3dv; - glColor3f: TglColor3f; - glColor3fv: TglColor3fv; - glColor3i: TglColor3i; - glColor3iv: TglColor3iv; - glColor3s: TglColor3s; - glColor3sv: TglColor3sv; - glColor3ub: TglColor3ub; - glColor3ubv: TglColor3ubv; - glColor3ui: TglColor3ui; - glColor3uiv: TglColor3uiv; - glColor3us: TglColor3us; - glColor3usv: TglColor3usv; - glColor4b: TglColor4b; - glColor4bv: TglColor4bv; - glColor4d: TglColor4d; - glColor4dv: TglColor4dv; - glColor4f: TglColor4f; - glColor4fv: TglColor4fv; - glColor4i: TglColor4i; - glColor4iv: TglColor4iv; - glColor4s: TglColor4s; - glColor4sv: TglColor4sv; - glColor4ub: TglColor4ub; - glColor4ubv: TglColor4ubv; - glColor4ui: TglColor4ui; - glColor4uiv: TglColor4uiv; - glColor4us: TglColor4us; - glColor4usv: TglColor4usv; - glColorMaterial: TglColorMaterial; - glColorPointer: TglColorPointer; - glCopyPixels: TglCopyPixels; - glDeleteLists: TglDeleteLists; - glDisableClientState: TglDisableClientState; - glDrawPixels: TglDrawPixels; - glEdgeFlag: TglEdgeFlag; - glEdgeFlagPointer: TglEdgeFlagPointer; - glEdgeFlagv: TglEdgeFlagv; - glEnableClientState: TglEnableClientState; - glEnd: TglEnd; - glEndList: TglEndList; - glEvalCoord1d: TglEvalCoord1d; - glEvalCoord1dv: TglEvalCoord1dv; - glEvalCoord1f: TglEvalCoord1f; - glEvalCoord1fv: TglEvalCoord1fv; - glEvalCoord2d: TglEvalCoord2d; - glEvalCoord2dv: TglEvalCoord2dv; - glEvalCoord2f: TglEvalCoord2f; - glEvalCoord2fv: TglEvalCoord2fv; - glEvalMesh1: TglEvalMesh1; - glEvalMesh2: TglEvalMesh2; - glEvalPoint1: TglEvalPoint1; - glEvalPoint2: TglEvalPoint2; - glFeedbackBuffer: TglFeedbackBuffer; - glFogf: TglFogf; - glFogfv: TglFogfv; - glFogi: TglFogi; - glFogiv: TglFogiv; - glFrustum: TglFrustum; - glGenLists: TglGenLists; - glGetClipPlane: TglGetClipPlane; - glGetLightfv: TglGetLightfv; - glGetLightiv: TglGetLightiv; - glGetMapdv: TglGetMapdv; - glGetMapfv: TglGetMapfv; - glGetMapiv: TglGetMapiv; - glGetMaterialfv: TglGetMaterialfv; - glGetMaterialiv: TglGetMaterialiv; - glGetPixelMapfv: TglGetPixelMapfv; - glGetPixelMapuiv: TglGetPixelMapuiv; - glGetPixelMapusv: TglGetPixelMapusv; - glGetPolygonStipple: TglGetPolygonStipple; - glGetTexEnvfv: TglGetTexEnvfv; - glGetTexEnviv: TglGetTexEnviv; - glGetTexGendv: TglGetTexGendv; - glGetTexGenfv: TglGetTexGenfv; - glGetTexGeniv: TglGetTexGeniv; - glIndexMask: TglIndexMask; - glIndexPointer: TglIndexPointer; - glIndexd: TglIndexd; - glIndexdv: TglIndexdv; - glIndexf: TglIndexf; - glIndexfv: TglIndexfv; - glIndexi: TglIndexi; - glIndexiv: TglIndexiv; - glIndexs: TglIndexs; - glIndexsv: TglIndexsv; - glIndexub: TglIndexub; - glIndexubv: TglIndexubv; - glInitNames: TglInitNames; - glInterleavedArrays: TglInterleavedArrays; - glIsList: TglIsList; - glIsTexture: TglIsTexture; - glLightModelf: TglLightModelf; - glLightModelfv: TglLightModelfv; - glLightModeli: TglLightModeli; - glLightModeliv: TglLightModeliv; - glLightf: TglLightf; - glLightfv: TglLightfv; - glLighti: TglLighti; - glLightiv: TglLightiv; - glLineStipple: TglLineStipple; - glListBase: TglListBase; - glLoadIdentity: TglLoadIdentity; - glLoadMatrixd: TglLoadMatrixd; - glLoadMatrixf: TglLoadMatrixf; - glLoadName: TglLoadName; - glMap1d: TglMap1d; - glMap1f: TglMap1f; - glMap2d: TglMap2d; - glMap2f: TglMap2f; - glMapGrid1d: TglMapGrid1d; - glMapGrid1f: TglMapGrid1f; - glMapGrid2d: TglMapGrid2d; - glMapGrid2f: TglMapGrid2f; - glMaterialf: TglMaterialf; - glMaterialfv: TglMaterialfv; - glMateriali: TglMateriali; - glMaterialiv: TglMaterialiv; - glMatrixMode: TglMatrixMode; - glMultMatrixd: TglMultMatrixd; - glMultMatrixf: TglMultMatrixf; - glNewList: TglNewList; - glNormal3b: TglNormal3b; - glNormal3bv: TglNormal3bv; - glNormal3d: TglNormal3d; - glNormal3dv: TglNormal3dv; - glNormal3f: TglNormal3f; - glNormal3fv: TglNormal3fv; - glNormal3i: TglNormal3i; - glNormal3iv: TglNormal3iv; - glNormal3s: TglNormal3s; - glNormal3sv: TglNormal3sv; - glNormalPointer: TglNormalPointer; - glOrtho: TglOrtho; - glPassThrough: TglPassThrough; - glPixelMapfv: TglPixelMapfv; - glPixelMapuiv: TglPixelMapuiv; - glPixelMapusv: TglPixelMapusv; - glPixelTransferf: TglPixelTransferf; - glPixelTransferi: TglPixelTransferi; - glPixelZoom: TglPixelZoom; - glPolygonStipple: TglPolygonStipple; - glPopAttrib: TglPopAttrib; - glPopClientAttrib: TglPopClientAttrib; - glPopMatrix: TglPopMatrix; - glPopName: TglPopName; - glPrioritizeTextures: TglPrioritizeTextures; - glPushAttrib: TglPushAttrib; - glPushClientAttrib: TglPushClientAttrib; - glPushMatrix: TglPushMatrix; - glPushName: TglPushName; - glRasterPos2d: TglRasterPos2d; - glRasterPos2dv: TglRasterPos2dv; - glRasterPos2f: TglRasterPos2f; - glRasterPos2fv: TglRasterPos2fv; - glRasterPos2i: TglRasterPos2i; - glRasterPos2iv: TglRasterPos2iv; - glRasterPos2s: TglRasterPos2s; - glRasterPos2sv: TglRasterPos2sv; - glRasterPos3d: TglRasterPos3d; - glRasterPos3dv: TglRasterPos3dv; - glRasterPos3f: TglRasterPos3f; - glRasterPos3fv: TglRasterPos3fv; - glRasterPos3i: TglRasterPos3i; - glRasterPos3iv: TglRasterPos3iv; - glRasterPos3s: TglRasterPos3s; - glRasterPos3sv: TglRasterPos3sv; - glRasterPos4d: TglRasterPos4d; - glRasterPos4dv: TglRasterPos4dv; - glRasterPos4f: TglRasterPos4f; - glRasterPos4fv: TglRasterPos4fv; - glRasterPos4i: TglRasterPos4i; - glRasterPos4iv: TglRasterPos4iv; - glRasterPos4s: TglRasterPos4s; - glRasterPos4sv: TglRasterPos4sv; - glRectd: TglRectd; - glRectdv: TglRectdv; - glRectf: TglRectf; - glRectfv: TglRectfv; - glRecti: TglRecti; - glRectiv: TglRectiv; - glRects: TglRects; - glRectsv: TglRectsv; - glRenderMode: TglRenderMode; - glRotated: TglRotated; - glRotatef: TglRotatef; - glScaled: TglScaled; - glScalef: TglScalef; - glSelectBuffer: TglSelectBuffer; - glShadeModel: TglShadeModel; - glTexCoord1d: TglTexCoord1d; - glTexCoord1dv: TglTexCoord1dv; - glTexCoord1f: TglTexCoord1f; - glTexCoord1fv: TglTexCoord1fv; - glTexCoord1i: TglTexCoord1i; - glTexCoord1iv: TglTexCoord1iv; - glTexCoord1s: TglTexCoord1s; - glTexCoord1sv: TglTexCoord1sv; - glTexCoord2d: TglTexCoord2d; - glTexCoord2dv: TglTexCoord2dv; - glTexCoord2f: TglTexCoord2f; - glTexCoord2fv: TglTexCoord2fv; - glTexCoord2i: TglTexCoord2i; - glTexCoord2iv: TglTexCoord2iv; - glTexCoord2s: TglTexCoord2s; - glTexCoord2sv: TglTexCoord2sv; - glTexCoord3d: TglTexCoord3d; - glTexCoord3dv: TglTexCoord3dv; - glTexCoord3f: TglTexCoord3f; - glTexCoord3fv: TglTexCoord3fv; - glTexCoord3i: TglTexCoord3i; - glTexCoord3iv: TglTexCoord3iv; - glTexCoord3s: TglTexCoord3s; - glTexCoord3sv: TglTexCoord3sv; - glTexCoord4d: TglTexCoord4d; - glTexCoord4dv: TglTexCoord4dv; - glTexCoord4f: TglTexCoord4f; - glTexCoord4fv: TglTexCoord4fv; - glTexCoord4i: TglTexCoord4i; - glTexCoord4iv: TglTexCoord4iv; - glTexCoord4s: TglTexCoord4s; - glTexCoord4sv: TglTexCoord4sv; - glTexCoordPointer: TglTexCoordPointer; - glTexEnvf: TglTexEnvf; - glTexEnvfv: TglTexEnvfv; - glTexEnvi: TglTexEnvi; - glTexEnviv: TglTexEnviv; - glTexGend: TglTexGend; - glTexGendv: TglTexGendv; - glTexGenf: TglTexGenf; - glTexGenfv: TglTexGenfv; - glTexGeni: TglTexGeni; - glTexGeniv: TglTexGeniv; - glTranslated: TglTranslated; - glTranslatef: TglTranslatef; - glVertex2d: TglVertex2d; - glVertex2dv: TglVertex2dv; - glVertex2f: TglVertex2f; - glVertex2fv: TglVertex2fv; - glVertex2i: TglVertex2i; - glVertex2iv: TglVertex2iv; - glVertex2s: TglVertex2s; - glVertex2sv: TglVertex2sv; - glVertex3d: TglVertex3d; - glVertex3dv: TglVertex3dv; - glVertex3f: TglVertex3f; - glVertex3fv: TglVertex3fv; - glVertex3i: TglVertex3i; - glVertex3iv: TglVertex3iv; - glVertex3s: TglVertex3s; - glVertex3sv: TglVertex3sv; - glVertex4d: TglVertex4d; - glVertex4dv: TglVertex4dv; - glVertex4f: TglVertex4f; - glVertex4fv: TglVertex4fv; - glVertex4i: TglVertex4i; - glVertex4iv: TglVertex4iv; - glVertex4s: TglVertex4s; - glVertex4sv: TglVertex4sv; - glVertexPointer: TglVertexPointer; -{$endif} - - // GL_VERSION_1_2 - glBlendColor: TglBlendColor; - glBlendEquation: TglBlendEquation; - glDrawRangeElements: TglDrawRangeElements; - glTexImage3D: TglTexImage3D; - glTexSubImage3D: TglTexSubImage3D; - glCopyTexSubImage3D: TglCopyTexSubImage3D; -{$ifdef DGL_DEPRECATED} - glColorTable: TglColorTable; - glColorTableParameterfv: TglColorTableParameterfv; - glColorTableParameteriv: TglColorTableParameteriv; - glCopyColorTable: TglCopyColorTable; - glGetColorTable: TglGetColorTable; - glGetColorTableParameterfv: TglGetColorTableParameterfv; - glGetColorTableParameteriv: TglGetColorTableParameteriv; - glColorSubTable: TglColorSubTable; - glCopyColorSubTable: TglCopyColorSubTable; - glConvolutionFilter1D: TglConvolutionFilter1D; - glConvolutionFilter2D: TglConvolutionFilter2D; - glConvolutionParameterf: TglConvolutionParameterf; - glConvolutionParameterfv: TglConvolutionParameterfv; - glConvolutionParameteri: TglConvolutionParameteri; - glConvolutionParameteriv: TglConvolutionParameteriv; - glCopyConvolutionFilter1D: TglCopyConvolutionFilter1D; - glCopyConvolutionFilter2D: TglCopyConvolutionFilter2D; - glGetConvolutionFilter: TglGetConvolutionFilter; - glGetConvolutionParameterfv: TglGetConvolutionParameterfv; - glGetConvolutionParameteriv: TglGetConvolutionParameteriv; - glGetSeparableFilter: TglGetSeparableFilter; - glSeparableFilter2D: TglSeparableFilter2D; - glGetHistogram: TglGetHistogram; - glGetHistogramParameterfv: TglGetHistogramParameterfv; - glGetHistogramParameteriv: TglGetHistogramParameteriv; - glGetMinmax: TglGetMinmax; - glGetMinmaxParameterfv: TglGetMinmaxParameterfv; - glGetMinmaxParameteriv: TglGetMinmaxParameteriv; - glHistogram: TglHistogram; - glMinmax: TglMinmax; - glResetHistogram: TglResetHistogram; - glResetMinmax: TglResetMinmax; -{$endif} - - // GL_VERSION_1_3 - glActiveTexture: TglActiveTexture; - glSampleCoverage: TglSampleCoverage; - glCompressedTexImage3D: TglCompressedTexImage3D; - glCompressedTexImage2D: TglCompressedTexImage2D; - glCompressedTexImage1D: TglCompressedTexImage1D; - glCompressedTexSubImage3D: TglCompressedTexSubImage3D; - glCompressedTexSubImage2D: TglCompressedTexSubImage2D; - glCompressedTexSubImage1D: TglCompressedTexSubImage1D; - glGetCompressedTexImage: TglGetCompressedTexImage; -{$ifdef DGL_DEPRECATED} - glClientActiveTexture: TglClientActiveTexture; - glMultiTexCoord1d: TglMultiTexCoord1d; - glMultiTexCoord1dv: TglMultiTexCoord1dv; - glMultiTexCoord1f: TglMultiTexCoord1f; - glMultiTexCoord1fv: TglMultiTexCoord1fv; - glMultiTexCoord1i: TglMultiTexCoord1i; - glMultiTexCoord1iv: TglMultiTexCoord1iv; - glMultiTexCoord1s: TglMultiTexCoord1s; - glMultiTexCoord1sv: TglMultiTexCoord1sv; - glMultiTexCoord2d: TglMultiTexCoord2d; - glMultiTexCoord2dv: TglMultiTexCoord2dv; - glMultiTexCoord2f: TglMultiTexCoord2f; - glMultiTexCoord2fv: TglMultiTexCoord2fv; - glMultiTexCoord2i: TglMultiTexCoord2i; - glMultiTexCoord2iv: TglMultiTexCoord2iv; - glMultiTexCoord2s: TglMultiTexCoord2s; - glMultiTexCoord2sv: TglMultiTexCoord2sv; - glMultiTexCoord3d: TglMultiTexCoord3d; - glMultiTexCoord3dv: TglMultiTexCoord3dv; - glMultiTexCoord3f: TglMultiTexCoord3f; - glMultiTexCoord3fv: TglMultiTexCoord3fv; - glMultiTexCoord3i: TglMultiTexCoord3i; - glMultiTexCoord3iv: TglMultiTexCoord3iv; - glMultiTexCoord3s: TglMultiTexCoord3s; - glMultiTexCoord3sv: TglMultiTexCoord3sv; - glMultiTexCoord4d: TglMultiTexCoord4d; - glMultiTexCoord4dv: TglMultiTexCoord4dv; - glMultiTexCoord4f: TglMultiTexCoord4f; - glMultiTexCoord4fv: TglMultiTexCoord4fv; - glMultiTexCoord4i: TglMultiTexCoord4i; - glMultiTexCoord4iv: TglMultiTexCoord4iv; - glMultiTexCoord4s: TglMultiTexCoord4s; - glMultiTexCoord4sv: TglMultiTexCoord4sv; - glLoadTransposeMatrixf: TglLoadTransposeMatrixf; - glLoadTransposeMatrixd: TglLoadTransposeMatrixd; - glMultTransposeMatrixf: TglMultTransposeMatrixf; - glMultTransposeMatrixd: TglMultTransposeMatrixd; -{$endif} - - // GL_VERSION_1_4 - glBlendFuncSeparate: TglBlendFuncSeparate; - glMultiDrawArrays: TglMultiDrawArrays; - glMultiDrawElements: TglMultiDrawElements; - glPointParameterf: TglPointParameterf; - glPointParameterfv: TglPointParameterfv; - glPointParameteri: TglPointParameteri; - glPointParameteriv: TglPointParameteriv; -{$ifdef DGL_DEPRECATED} - glFogCoordf: TglFogCoordf; - glFogCoordfv: TglFogCoordfv; - glFogCoordd: TglFogCoordd; - glFogCoorddv: TglFogCoorddv; - glFogCoordPointer: TglFogCoordPointer; - glSecondaryColor3b: TglSecondaryColor3b; - glSecondaryColor3bv: TglSecondaryColor3bv; - glSecondaryColor3d: TglSecondaryColor3d; - glSecondaryColor3dv: TglSecondaryColor3dv; - glSecondaryColor3f: TglSecondaryColor3f; - glSecondaryColor3fv: TglSecondaryColor3fv; - glSecondaryColor3i: TglSecondaryColor3i; - glSecondaryColor3iv: TglSecondaryColor3iv; - glSecondaryColor3s: TglSecondaryColor3s; - glSecondaryColor3sv: TglSecondaryColor3sv; - glSecondaryColor3ub: TglSecondaryColor3ub; - glSecondaryColor3ubv: TglSecondaryColor3ubv; - glSecondaryColor3ui: TglSecondaryColor3ui; - glSecondaryColor3uiv: TglSecondaryColor3uiv; - glSecondaryColor3us: TglSecondaryColor3us; - glSecondaryColor3usv: TglSecondaryColor3usv; - glSecondaryColorPointer: TglSecondaryColorPointer; - glWindowPos2d: TglWindowPos2d; - glWindowPos2dv: TglWindowPos2dv; - glWindowPos2f: TglWindowPos2f; - glWindowPos2fv: TglWindowPos2fv; - glWindowPos2i: TglWindowPos2i; - glWindowPos2iv: TglWindowPos2iv; - glWindowPos2s: TglWindowPos2s; - glWindowPos2sv: TglWindowPos2sv; - glWindowPos3d: TglWindowPos3d; - glWindowPos3dv: TglWindowPos3dv; - glWindowPos3f: TglWindowPos3f; - glWindowPos3fv: TglWindowPos3fv; - glWindowPos3i: TglWindowPos3i; - glWindowPos3iv: TglWindowPos3iv; - glWindowPos3s: TglWindowPos3s; - glWindowPos3sv: TglWindowPos3sv; -{$endif} - - // GL_VERSION_1_5 - glGenQueries: TglGenQueries; - glDeleteQueries: TglDeleteQueries; - glIsQuery: TglIsQuery; - glBeginQuery: TglBeginQuery; - glEndQuery: TglEndQuery; - glGetQueryiv: TglGetQueryiv; - glGetQueryObjectiv: TglGetQueryObjectiv; - glGetQueryObjectuiv: TglGetQueryObjectuiv; - glBindBuffer: TglBindBuffer; - glDeleteBuffers: TglDeleteBuffers; - glGenBuffers: TglGenBuffers; - glIsBuffer: TglIsBuffer; - glBufferData: TglBufferData; - glBufferSubData: TglBufferSubData; - glGetBufferSubData: TglGetBufferSubData; - glMapBuffer: TglMapBuffer; - glUnmapBuffer: TglUnmapBuffer; - glGetBufferParameteriv: TglGetBufferParameteriv; - glGetBufferPointerv: TglGetBufferPointerv; - - // GL_VERSION_2_0 - glBlendEquationSeparate: TglBlendEquationSeparate; - glDrawBuffers: TglDrawBuffers; - glStencilOpSeparate: TglStencilOpSeparate; - glStencilFuncSeparate: TglStencilFuncSeparate; - glStencilMaskSeparate: TglStencilMaskSeparate; - glAttachShader: TglAttachShader; - glBindAttribLocation: TglBindAttribLocation; - glCompileShader: TglCompileShader; - glCreateProgram: TglCreateProgram; - glCreateShader: TglCreateShader; - glDeleteProgram: TglDeleteProgram; - glDeleteShader: TglDeleteShader; - glDetachShader: TglDetachShader; - glDisableVertexAttribArray: TglDisableVertexAttribArray; - glEnableVertexAttribArray: TglEnableVertexAttribArray; - glGetActiveAttrib: TglGetActiveAttrib; - glGetActiveUniform: TglGetActiveUniform; - glGetAttachedShaders: TglGetAttachedShaders; - glGetAttribLocation: TglGetAttribLocation; - glGetProgramiv: TglGetProgramiv; - glGetProgramInfoLog: TglGetProgramInfoLog; - glGetShaderiv: TglGetShaderiv; - glGetShaderInfoLog: TglGetShaderInfoLog; - glGetShaderSource: TglGetShaderSource; - glGetUniformLocation: TglGetUniformLocation; - glGetUniformfv: TglGetUniformfv; - glGetUniformiv: TglGetUniformiv; - glGetVertexAttribfv: TglGetVertexAttribfv; - glGetVertexAttribiv: TglGetVertexAttribiv; - glGetVertexAttribPointerv: TglGetVertexAttribPointerv; - glIsProgram: TglIsProgram; - glIsShader: TglIsShader; - glLinkProgram: TglLinkProgram; - glShaderSource: TglShaderSource; - glUseProgram: TglUseProgram; - glUniform1f: TglUniform1f; - glUniform2f: TglUniform2f; - glUniform3f: TglUniform3f; - glUniform4f: TglUniform4f; - glUniform1i: TglUniform1i; - glUniform2i: TglUniform2i; - glUniform3i: TglUniform3i; - glUniform4i: TglUniform4i; - glUniform1fv: TglUniform1fv; - glUniform2fv: TglUniform2fv; - glUniform3fv: TglUniform3fv; - glUniform4fv: TglUniform4fv; - glUniform1iv: TglUniform1iv; - glUniform2iv: TglUniform2iv; - glUniform3iv: TglUniform3iv; - glUniform4iv: TglUniform4iv; - glUniformMatrix2fv: TglUniformMatrix2fv; - glUniformMatrix3fv: TglUniformMatrix3fv; - glUniformMatrix4fv: TglUniformMatrix4fv; - glValidateProgram: TglValidateProgram; - glVertexAttrib1d: TglVertexAttrib1d; - glVertexAttrib1dv: TglVertexAttrib1dv; - glVertexAttrib1f: TglVertexAttrib1f; - glVertexAttrib1fv: TglVertexAttrib1fv; - glVertexAttrib1s: TglVertexAttrib1s; - glVertexAttrib1sv: TglVertexAttrib1sv; - glVertexAttrib2d: TglVertexAttrib2d; - glVertexAttrib2dv: TglVertexAttrib2dv; - glVertexAttrib2f: TglVertexAttrib2f; - glVertexAttrib2fv: TglVertexAttrib2fv; - glVertexAttrib2s: TglVertexAttrib2s; - glVertexAttrib2sv: TglVertexAttrib2sv; - glVertexAttrib3d: TglVertexAttrib3d; - glVertexAttrib3dv: TglVertexAttrib3dv; - glVertexAttrib3f: TglVertexAttrib3f; - glVertexAttrib3fv: TglVertexAttrib3fv; - glVertexAttrib3s: TglVertexAttrib3s; - glVertexAttrib3sv: TglVertexAttrib3sv; - glVertexAttrib4Nbv: TglVertexAttrib4Nbv; - glVertexAttrib4Niv: TglVertexAttrib4Niv; - glVertexAttrib4Nsv: TglVertexAttrib4Nsv; - glVertexAttrib4Nub: TglVertexAttrib4Nub; - glVertexAttrib4Nubv: TglVertexAttrib4Nubv; - glVertexAttrib4Nuiv: TglVertexAttrib4Nuiv; - glVertexAttrib4Nusv: TglVertexAttrib4Nusv; - glVertexAttrib4bv: TglVertexAttrib4bv; - glVertexAttrib4d: TglVertexAttrib4d; - glVertexAttrib4dv: TglVertexAttrib4dv; - glVertexAttrib4f: TglVertexAttrib4f; - glVertexAttrib4fv: TglVertexAttrib4fv; - glVertexAttrib4iv: TglVertexAttrib4iv; - glVertexAttrib4s: TglVertexAttrib4s; - glVertexAttrib4sv: TglVertexAttrib4sv; - glVertexAttrib4ubv: TglVertexAttrib4ubv; - glVertexAttrib4uiv: TglVertexAttrib4uiv; - glVertexAttrib4usv: TglVertexAttrib4usv; - glVertexAttribPointer: TglVertexAttribPointer; - - // GL_VERSION_2_1 - glUniformMatrix2x3fv: TglUniformMatrix2x3fv; - glUniformMatrix3x2fv: TglUniformMatrix3x2fv; - glUniformMatrix2x4fv: TglUniformMatrix2x4fv; - glUniformMatrix4x2fv: TglUniformMatrix4x2fv; - glUniformMatrix3x4fv: TglUniformMatrix3x4fv; - glUniformMatrix4x3fv: TglUniformMatrix4x3fv; - - // GL_VERSION_3_0 - glColorMaski: TglColorMaski; - glGetBooleani_v: TglGetBooleani_v; - glGetIntegeri_v: TglGetIntegeri_v; - glEnablei: TglEnablei; - glDisablei: TglDisablei; - glIsEnabledi: TglIsEnabledi; - glBeginTransformFeedback: TglBeginTransformFeedback; - glEndTransformFeedback: TglEndTransformFeedback; - glBindBufferRange: TglBindBufferRange; - glBindBufferBase: TglBindBufferBase; - glTransformFeedbackVaryings: TglTransformFeedbackVaryings; - glGetTransformFeedbackVarying: TglGetTransformFeedbackVarying; - glClampColor: TglClampColor; - glBeginConditionalRender: TglBeginConditionalRender; - glEndConditionalRender: TglEndConditionalRender; - glVertexAttribI1i: TglVertexAttribI1i; - glVertexAttribI2i: TglVertexAttribI2i; - glVertexAttribI3i: TglVertexAttribI3i; - glVertexAttribI4i: TglVertexAttribI4i; - glVertexAttribI1ui: TglVertexAttribI1ui; - glVertexAttribI2ui: TglVertexAttribI2ui; - glVertexAttribI3ui: TglVertexAttribI3ui; - glVertexAttribI4ui: TglVertexAttribI4ui; - glVertexAttribI1iv: TglVertexAttribI1iv; - glVertexAttribI2iv: TglVertexAttribI2iv; - glVertexAttribI3iv: TglVertexAttribI3iv; - glVertexAttribI4iv: TglVertexAttribI4iv; - glVertexAttribI1uiv: TglVertexAttribI1uiv; - glVertexAttribI2uiv: TglVertexAttribI2uiv; - glVertexAttribI3uiv: TglVertexAttribI3uiv; - glVertexAttribI4uiv: TglVertexAttribI4uiv; - glVertexAttribI4bv: TglVertexAttribI4bv; - glVertexAttribI4sv: TglVertexAttribI4sv; - glVertexAttribI4ubv: TglVertexAttribI4ubv; - glVertexAttribI4usv: TglVertexAttribI4usv; - glVertexAttribIPointer: TglVertexAttribIPointer; - glGetVertexAttribIiv: TglGetVertexAttribIiv; - glGetVertexAttribIuiv: TglGetVertexAttribIuiv; - glGetUniformuiv: TglGetUniformuiv; - glBindFragDataLocation: TglBindFragDataLocation; - glGetFragDataLocation: TglGetFragDataLocation; - glUniform1ui: TglUniform1ui; - glUniform2ui: TglUniform2ui; - glUniform3ui: TglUniform3ui; - glUniform4ui: TglUniform4ui; - glUniform1uiv: TglUniform1uiv; - glUniform2uiv: TglUniform2uiv; - glUniform3uiv: TglUniform3uiv; - glUniform4uiv: TglUniform4uiv; - glTexParameterIiv: TglTexParameterIiv; - glTexParameterIuiv: TglTexParameterIuiv; - glGetTexParameterIiv: TglGetTexParameterIiv; - glGetTexParameterIuiv: TglGetTexParameterIuiv; - glClearBufferiv: TglClearBufferiv; - glClearBufferuiv: TglClearBufferuiv; - glClearBufferfv: TglClearBufferfv; - glClearBufferfi: TglClearBufferfi; - glGetStringi: TglGetStringi; - - // GL_VERSION_3_1 - glDrawArraysInstanced: TglDrawArraysInstanced; - glDrawElementsInstanced: TglDrawElementsInstanced; - glTexBuffer: TglTexBuffer; - glPrimitiveRestartIndex: TglPrimitiveRestartIndex; - - // GL_VERSION_3_2 - { OpenGL 3.2 also reuses entry points from these extensions: } - { ARB_draw_elements_base_vertex } - { ARB_provoking_vertex } - { ARB_sync } - { ARB_texture_multisample } - glGetInteger64i_v: TglGetInteger64i_v; - glGetBufferParameteri64v: TglGetBufferParameteri64v; - glFramebufferTexture: TglFramebufferTexture; -// glFramebufferTextureFace: TglFramebufferTextureFace; - - // GL_VERSION_3_3 - glVertexAttribDivisor: TglVertexAttribDivisor; - - // GL_VERSION_4_0 - { OpenGL 4.0 also reuses entry points from these extensions: } - { ARB_texture_query_lod (no entry points) } - { ARB_draw_indirect } - { ARB_gpu_shader5 (no entry points) } - { ARB_gpu_shader_fp64 } - { ARB_shader_subroutine } - { ARB_tessellation_shader } - { ARB_texture_buffer_object_rgb32 (no entry points) } - { ARB_texture_cube_map_array (no entry points) } - { ARB_texture_gather (no entry points) } - { ARB_transform_feedback2 } - { ARB_transform_feedback3 } - glMinSampleShading: TglMinSampleShading; - glBlendEquationi: TglBlendEquationi; - glBlendEquationSeparatei: TglBlendEquationSeparatei; - glBlendFunci: TglBlendFunci; - glBlendFuncSeparatei: TglBlendFuncSeparatei; - - // GL_3DFX_tbuffer - glTbufferMask3DFX: TglTbufferMask3DFX; - - // GL_APPLE_element_array - glElementPointerAPPLE: TglElementPointerAPPLE; - glDrawElementArrayAPPLE: TglDrawElementArrayAPPLE; - glDrawRangeElementArrayAPPLE: TglDrawRangeElementArrayAPPLE; - glMultiDrawElementArrayAPPLE: TglMultiDrawElementArrayAPPLE; - glMultiDrawRangeElementArrayAPPLE: TglMultiDrawRangeElementArrayAPPLE; - - // GL_APPLE_fence - glGenFencesAPPLE: TglGenFencesAPPLE; - glDeleteFencesAPPLE: TglDeleteFencesAPPLE; - glSetFenceAPPLE: TglSetFenceAPPLE; - glIsFenceAPPLE: TglIsFenceAPPLE; - glTestFenceAPPLE: TglTestFenceAPPLE; - glFinishFenceAPPLE: TglFinishFenceAPPLE; - glTestObjectAPPLE: TglTestObjectAPPLE; - glFinishObjectAPPLE: TglFinishObjectAPPLE; - - // GL_APPLE_vertex_array_object - glBindVertexArrayAPPLE: TglBindVertexArrayAPPLE; - glDeleteVertexArraysAPPLE: TglDeleteVertexArraysAPPLE; - glGenVertexArraysAPPLE: TglGenVertexArraysAPPLE; - glIsVertexArrayAPPLE: TglIsVertexArrayAPPLE; - - // GL_APPLE_vertex_array_range - glVertexArrayRangeAPPLE: TglVertexArrayRangeAPPLE; - glFlushVertexArrayRangeAPPLE: TglFlushVertexArrayRangeAPPLE; - glVertexArrayParameteriAPPLE: TglVertexArrayParameteriAPPLE; - - // GL_APPLE_texture_range - glTextureRangeAPPLE: TglTextureRangeAPPLE; - glGetTexParameterPointervAPPLE: TglGetTexParameterPointervAPPLE; - - // GL_APPLE_vertex_program_evaluators - glEnableVertexAttribAPPLE: TglEnableVertexAttribAPPLE; - glDisableVertexAttribAPPLE: TglDisableVertexAttribAPPLE; - glIsVertexAttribEnabledAPPLE: TglIsVertexAttribEnabledAPPLE; - glMapVertexAttrib1dAPPLE: TglMapVertexAttrib1dAPPLE; - glMapVertexAttrib1fAPPLE: TglMapVertexAttrib1fAPPLE; - glMapVertexAttrib2dAPPLE: TglMapVertexAttrib2dAPPLE; - glMapVertexAttrib2fAPPLE: TglMapVertexAttrib2fAPPLE; - - // GL_APPLE_object_purgeable - glObjectPurgeableAPPLE: TglObjectPurgeableAPPLE; - glObjectUnpurgeableAPPLE: TglObjectUnpurgeableAPPLE; - glGetObjectParameterivAPPLE: TglGetObjectParameterivAPPLE; - - // GL_ARB_matrix_palette - glCurrentPaletteMatrixARB: TglCurrentPaletteMatrixARB; - glMatrixIndexubvARB: TglMatrixIndexubvARB; - glMatrixIndexusvARB: TglMatrixIndexusvARB; - glMatrixIndexuivARB: TglMatrixIndexuivARB; - glMatrixIndexPointerARB: TglMatrixIndexPointerARB; - - // GL_ARB_multisample - glSampleCoverageARB: TglSampleCoverageARB; - - // GL_ARB_multitexture - glActiveTextureARB: TglActiveTextureARB; - glClientActiveTextureARB: TglClientActiveTextureARB; - glMultiTexCoord1dARB: TglMultiTexCoord1dARB; - glMultiTexCoord1dvARB: TglMultiTexCoord1dvARB; - glMultiTexCoord1fARB: TglMultiTexCoord1fARB; - glMultiTexCoord1fvARB: TglMultiTexCoord1fvARB; - glMultiTexCoord1iARB: TglMultiTexCoord1iARB; - glMultiTexCoord1ivARB: TglMultiTexCoord1ivARB; - glMultiTexCoord1sARB: TglMultiTexCoord1sARB; - glMultiTexCoord1svARB: TglMultiTexCoord1svARB; - glMultiTexCoord2dARB: TglMultiTexCoord2dARB; - glMultiTexCoord2dvARB: TglMultiTexCoord2dvARB; - glMultiTexCoord2fARB: TglMultiTexCoord2fARB; - glMultiTexCoord2fvARB: TglMultiTexCoord2fvARB; - glMultiTexCoord2iARB: TglMultiTexCoord2iARB; - glMultiTexCoord2ivARB: TglMultiTexCoord2ivARB; - glMultiTexCoord2sARB: TglMultiTexCoord2sARB; - glMultiTexCoord2svARB: TglMultiTexCoord2svARB; - glMultiTexCoord3dARB: TglMultiTexCoord3dARB; - glMultiTexCoord3dvARB: TglMultiTexCoord3dvARB; - glMultiTexCoord3fARB: TglMultiTexCoord3fARB; - glMultiTexCoord3fvARB: TglMultiTexCoord3fvARB; - glMultiTexCoord3iARB: TglMultiTexCoord3iARB; - glMultiTexCoord3ivARB: TglMultiTexCoord3ivARB; - glMultiTexCoord3sARB: TglMultiTexCoord3sARB; - glMultiTexCoord3svARB: TglMultiTexCoord3svARB; - glMultiTexCoord4dARB: TglMultiTexCoord4dARB; - glMultiTexCoord4dvARB: TglMultiTexCoord4dvARB; - glMultiTexCoord4fARB: TglMultiTexCoord4fARB; - glMultiTexCoord4fvARB: TglMultiTexCoord4fvARB; - glMultiTexCoord4iARB: TglMultiTexCoord4iARB; - glMultiTexCoord4ivARB: TglMultiTexCoord4ivARB; - glMultiTexCoord4sARB: TglMultiTexCoord4sARB; - glMultiTexCoord4svARB: TglMultiTexCoord4svARB; - - // GL_ARB_point_parameters - glPointParameterfARB: TglPointParameterfARB; - glPointParameterfvARB: TglPointParameterfvARB; - - // GL_ARB_texture_compression - glCompressedTexImage3DARB: TglCompressedTexImage3DARB; - glCompressedTexImage2DARB: TglCompressedTexImage2DARB; - glCompressedTexImage1DARB: TglCompressedTexImage1DARB; - glCompressedTexSubImage3DARB: TglCompressedTexSubImage3DARB; - glCompressedTexSubImage2DARB: TglCompressedTexSubImage2DARB; - glCompressedTexSubImage1DARB: TglCompressedTexSubImage1DARB; - glGetCompressedTexImageARB: TglGetCompressedTexImageARB; - - // GL_ARB_transpose_matrix - glLoadTransposeMatrixfARB: TglLoadTransposeMatrixfARB; - glLoadTransposeMatrixdARB: TglLoadTransposeMatrixdARB; - glMultTransposeMatrixfARB: TglMultTransposeMatrixfARB; - glMultTransposeMatrixdARB: TglMultTransposeMatrixdARB; - - // GL_ARB_vertex_blend - glWeightbvARB: TglWeightbvARB; - glWeightsvARB: TglWeightsvARB; - glWeightivARB: TglWeightivARB; - glWeightfvARB: TglWeightfvARB; - glWeightdvARB: TglWeightdvARB; - glWeightubvARB: TglWeightubvARB; - glWeightusvARB: TglWeightusvARB; - glWeightuivARB: TglWeightuivARB; - glWeightPointerARB: TglWeightPointerARB; - glVertexBlendARB: TglVertexBlendARB; - - // GL_ARB_vertex_buffer_object - glBindBufferARB: TglBindBufferARB; - glDeleteBuffersARB: TglDeleteBuffersARB; - glGenBuffersARB: TglGenBuffersARB; - glIsBufferARB: TglIsBufferARB; - glBufferDataARB: TglBufferDataARB; - glBufferSubDataARB: TglBufferSubData; - glGetBufferSubDataARB: TglGetBufferSubDataARB; - glMapBufferARB: TglMapBufferARB; - glUnmapBufferARB: TglUnmapBufferARB; - glGetBufferParameterivARB: TglGetBufferParameterivARB; - glGetBufferPointervARB: TglGetBufferPointervARB; - - // GL_ARB_vertex_program - glVertexAttrib1dARB: TglVertexAttrib1dARB; - glVertexAttrib1dvARB: TglVertexAttrib1dvARB; - glVertexAttrib1fARB: TglVertexAttrib1fARB; - glVertexAttrib1fvARB: TglVertexAttrib1fvARB; - glVertexAttrib1sARB: TglVertexAttrib1sARB; - glVertexAttrib1svARB: TglVertexAttrib1svARB; - glVertexAttrib2dARB: TglVertexAttrib2dARB; - glVertexAttrib2dvARB: TglVertexAttrib2dvARB; - glVertexAttrib2fARB: TglVertexAttrib2fARB; - glVertexAttrib2fvARB: TglVertexAttrib2fvARB; - glVertexAttrib2sARB: TglVertexAttrib2sARB; - glVertexAttrib2svARB: TglVertexAttrib2svARB; - glVertexAttrib3dARB: TglVertexAttrib3dARB; - glVertexAttrib3dvARB: TglVertexAttrib3dvARB; - glVertexAttrib3fARB: TglVertexAttrib3fARB; - glVertexAttrib3fvARB: TglVertexAttrib3fvARB; - glVertexAttrib3sARB: TglVertexAttrib3sARB; - glVertexAttrib3svARB: TglVertexAttrib3svARB; - glVertexAttrib4NbvARB: TglVertexAttrib4NbvARB; - glVertexAttrib4NivARB: TglVertexAttrib4NivARB; - glVertexAttrib4NsvARB: TglVertexAttrib4NsvARB; - glVertexAttrib4NubARB: TglVertexAttrib4NubARB; - glVertexAttrib4NubvARB: TglVertexAttrib4NubvARB; - glVertexAttrib4NuivARB: TglVertexAttrib4NuivARB; - glVertexAttrib4NusvARB: TglVertexAttrib4NusvARB; - glVertexAttrib4bvARB: TglVertexAttrib4bvARB; - glVertexAttrib4dARB: TglVertexAttrib4dARB; - glVertexAttrib4dvARB: TglVertexAttrib4dvARB; - glVertexAttrib4fARB: TglVertexAttrib4fARB; - glVertexAttrib4fvARB: TglVertexAttrib4fvARB; - glVertexAttrib4ivARB: TglVertexAttrib4ivARB; - glVertexAttrib4sARB: TglVertexAttrib4sARB; - glVertexAttrib4svARB: TglVertexAttrib4svARB; - glVertexAttrib4ubvARB: TglVertexAttrib4ubvARB; - glVertexAttrib4uivARB: TglVertexAttrib4uivARB; - glVertexAttrib4usvARB: TglVertexAttrib4usvARB; - glVertexAttribPointerARB: TglVertexAttribPointerARB; - glEnableVertexAttribArrayARB: TglEnableVertexAttribArrayARB; - glDisableVertexAttribArrayARB: TglDisableVertexAttribArrayARB; - glProgramStringARB: TglProgramStringARB; - glBindProgramARB: TglBindProgramARB; - glDeleteProgramsARB: TglDeleteProgramsARB; - glGenProgramsARB: TglGenProgramsARB; - - glProgramEnvParameter4dARB: TglProgramEnvParameter4dARB; - glProgramEnvParameter4dvARB: TglProgramEnvParameter4dvARB; - glProgramEnvParameter4fARB: TglProgramEnvParameter4fARB; - glProgramEnvParameter4fvARB: TglProgramEnvParameter4fvARB; - glProgramLocalParameter4dARB: TglProgramLocalParameter4dARB; - glProgramLocalParameter4dvARB: TglProgramLocalParameter4dvARB; - glProgramLocalParameter4fARB: TglProgramLocalParameter4fARB; - glProgramLocalParameter4fvARB: TglProgramLocalParameter4fvARB; - glGetProgramEnvParameterdvARB: TglGetProgramEnvParameterdvARB; - glGetProgramEnvParameterfvARB: TglGetProgramEnvParameterfvARB; - glGetProgramLocalParameterdvARB: TglGetProgramLocalParameterdvARB; - glGetProgramLocalParameterfvARB: TglGetProgramLocalParameterfvARB; - glGetProgramivARB: TglGetProgramivARB; - glGetProgramStringARB: TglGetProgramStringARB; - glGetVertexAttribdvARB: TglGetVertexAttribdvARB; - glGetVertexAttribfvARB: TglGetVertexAttribfvARB; - glGetVertexAttribivARB: TglGetVertexAttribivARB; - glGetVertexAttribPointervARB: TglGetVertexAttribPointervARB; - glIsProgramARB: TglIsProgramARB; - - // GL_ARB_window_pos - glWindowPos2dARB: TglWindowPos2dARB; - glWindowPos2dvARB: TglWindowPos2dvARB; - glWindowPos2fARB: TglWindowPos2fARB; - glWindowPos2fvARB: TglWindowPos2fvARB; - glWindowPos2iARB: TglWindowPos2iARB; - glWindowPos2ivARB: TglWindowPos2ivARB; - glWindowPos2sARB: TglWindowPos2sARB; - glWindowPos2svARB: TglWindowPos2svARB; - glWindowPos3dARB: TglWindowPos3dARB; - glWindowPos3dvARB: TglWindowPos3dvARB; - glWindowPos3fARB: TglWindowPos3fARB; - glWindowPos3fvARB: TglWindowPos3fvARB; - glWindowPos3iARB: TglWindowPos3iARB; - glWindowPos3ivARB: TglWindowPos3ivARB; - glWindowPos3sARB: TglWindowPos3sARB; - glWindowPos3svARB: TglWindowPos3svARB; - - // GL_ARB_draw_buffers - glDrawBuffersARB: TglDrawBuffersARB; - - // GL_ARB_color_buffer_float - glClampColorARB: TglClampColorARB; - - // GL_ARB_vertex_shader - glGetActiveAttribARB: TglGetActiveAttribARB; - glGetAttribLocationARB: TglGetAttribLocationARB; - glBindAttribLocationARB: TglBindAttribLocationARB; - - // GL_ARB_shader_objects - glDeleteObjectARB: TglDeleteObjectARB; - glGetHandleARB: TglGetHandleARB; - glDetachObjectARB: TglDetachObjectARB; - glCreateShaderObjectARB: TglCreateShaderObjectARB; - glShaderSourceARB: TglShaderSourceARB; - glCompileShaderARB: TglCompileShaderARB; - glCreateProgramObjectARB: TglCreateProgramObjectARB; - glAttachObjectARB: TglAttachObjectARB; - glLinkProgramARB: TglLinkProgramARB; - glUseProgramObjectARB: TglUseProgramObjectARB; - glValidateProgramARB: TglValidateProgramARB; - glUniform1fARB: TglUniform1fARB; - glUniform2fARB: TglUniform2fARB; - glUniform3fARB: TglUniform3fARB; - glUniform4fARB: TglUniform4fARB; - glUniform1iARB: TglUniform1iARB; - glUniform2iARB: TglUniform2iARB; - glUniform3iARB: TglUniform3iARB; - glUniform4iARB: TglUniform4iARB; - glUniform1fvARB: TglUniform1fvARB; - glUniform2fvARB: TglUniform2fvARB; - glUniform3fvARB: TglUniform3fvARB; - glUniform4fvARB: TglUniform4fvARB; - glUniform1ivARB: TglUniform1ivARB; - glUniform2ivARB: TglUniform2ivARB; - glUniform3ivARB: TglUniform3ivARB; - glUniform4ivARB: TglUniform4ivARB; - glUniformMatrix2fvARB: TglUniformMatrix2fvARB; - glUniformMatrix3fvARB: TglUniformMatrix3fvARB; - glUniformMatrix4fvARB: TglUniformMatrix4fvARB; - glGetObjectParameterfvARB: TglGetObjectParameterfvARB; - glGetObjectParameterivARB: TglGetObjectParameterivARB; - glGetInfoLogARB: TglGetInfoLogARB; - glGetAttachedObjectsARB: TglGetAttachedObjectsARB; - glGetUniformLocationARB: TglGetUniformLocationARB; - glGetActiveUniformARB: TglGetActiveUniformARB; - glGetUniformfvARB: TglGetUniformfvARB; - glGetUniformivARB: TglGetUniformivARB; - glGetShaderSourceARB: TglGetShaderSourceARB; - - // GL_ARB_Occlusion_Query - glGenQueriesARB: TglGenQueriesARB; - glDeleteQueriesARB: TglDeleteQueriesARB; - glIsQueryARB: TglIsQueryARB; - glBeginQueryARB: TglBeginQueryARB; - glEndQueryARB: TglEndQueryARB; - glGetQueryivARB: TglGetQueryivARB; - glGetQueryObjectivARB: TglGetQueryObjectivARB; - glGetQueryObjectuivARB: TglGetQueryObjectuivARB; - - // GL_ARB_draw_instanced - glDrawArraysInstancedARB: TglDrawArraysInstancedARB; - glDrawElementsInstancedARB: TglDrawElementsInstancedARB; - - // GL_ARB_framebuffer_object - glIsRenderbuffer: TglIsRenderbuffer; - glBindRenderbuffer: TglBindRenderbuffer; - glDeleteRenderbuffers: TglDeleteRenderbuffers; - glGenRenderbuffers: TglGenRenderbuffers; - glRenderbufferStorage: TglRenderbufferStorage; - glGetRenderbufferParameteriv: TglGetRenderbufferParameteriv; - glIsFramebuffer: TglIsFramebuffer; - glBindFramebuffer: TglBindFramebuffer; - glDeleteFramebuffers: TglDeleteFramebuffers; - glGenFramebuffers: TglGenFramebuffers; - glCheckFramebufferStatus: TglCheckFramebufferStatus; - glFramebufferTexture1D: TglFramebufferTexture1D; - glFramebufferTexture2D: TglFramebufferTexture2D; - glFramebufferTexture3D: TglFramebufferTexture3D; - glFramebufferRenderbuffer: TglFramebufferRenderbuffer; - glGetFramebufferAttachmentParameteriv: TglGetFramebufferAttachmentParameteriv; - glGenerateMipmap: TglGenerateMipmap; - glBlitFramebuffer: TglBlitFramebuffer; - glRenderbufferStorageMultisample: TglRenderbufferStorageMultisample; - glFramebufferTextureLayer: TglFramebufferTextureLayer; - - // GL_ARB_geometry_shader4 - glProgramParameteriARB: TglProgramParameteriARB; - glFramebufferTextureARB: TglFramebufferTextureARB; - glFramebufferTextureLayerARB: TglFramebufferTextureLayerARB; - glFramebufferTextureFaceARB: TglFramebufferTextureFaceARB; - - // GL_ARB_instanced_arrays - glVertexAttribDivisorARB: TglVertexAttribDivisorARB; - - // GL_ARB_map_buffer_range - glMapBufferRange: TglMapBufferRange; - glFlushMappedBufferRange: TglFlushMappedBufferRange; - - // GL_ARB_texture_buffer_object - glTexBufferARB: TglTexBufferARB; - - // GL_ARB_vertex_array_object - glBindVertexArray: TglBindVertexArray; - glDeleteVertexArrays: TglDeleteVertexArrays; - glGenVertexArrays: TglGenVertexArrays; - glIsVertexArray: TglIsVertexArray; - - // GL_ARB_uniform_buffer_object - glGetUniformIndices: TglGetUniformIndices; - glGetActiveUniformsiv: TglGetActiveUniformsiv; - glGetActiveUniformName: TglGetActiveUniformName; - glGetUniformBlockIndex: TglGetUniformBlockIndex; - glGetActiveUniformBlockiv: TglGetActiveUniformBlockiv; - glGetActiveUniformBlockName: TglGetActiveUniformBlockName; - glUniformBlockBinding: TglUniformBlockBinding; - - // GL_ARB_copy_buffer - glCopyBufferSubData: TglCopyBufferSubData; - - // GL_ARB_draw_elements_base_vertex - glDrawElementsBaseVertex: TglDrawElementsBaseVertex; - glDrawRangeElementsBaseVertex: TglDrawRangeElementsBaseVertex; - glDrawElementsInstancedBaseVertex: TglDrawElementsInstancedBaseVertex; - glMultiDrawElementsBaseVertex: TglMultiDrawElementsBaseVertex; - - // GL_ARB_provoking_vertex - glProvokingVertex: TglProvokingVertex; - - // GL_ARB_sync - glFenceSync: TglFenceSync; - glIsSync: TglIsSync; - glDeleteSync: TglDeleteSync; - glClientWaitSync: TglClientWaitSync; - glWaitSync: TglWaitSync; - glGetInteger64v: TglGetInteger64v; - glGetSynciv: TglGetSynciv; - - // GL_ARB_texture_multisample - glTexImage2DMultisample: TglTexImage2DMultisample; - glTexImage3DMultisample: TglTexImage3DMultisample; - glGetMultisamplefv: TglGetMultisamplefv; - glSampleMaski: TglSampleMaski; - - // GL_ARB_draw_buffers_blend - glBlendEquationiARB: TglBlendEquationiARB; - glBlendEquationSeparateiARB: TglBlendEquationSeparateiARB; - glBlendFunciARB: TglBlendFunciARB; - glBlendFuncSeparateiARB: TglBlendFuncSeparateiARB; - - // GL_ARB_sample_shading - glMinSampleShadingARB: TglMinSampleShadingARB; - - // GL_ARB_shading_language_include - glNamedStringARB: TglNamedStringARB; - glDeleteNamedStringARB: TglDeleteNamedStringARB; - glCompileShaderIncludeARB: TglCompileShaderIncludeARB; - glIsNamedStringARB: TglIsNamedStringARB; - glGetNamedStringARB: TglGetNamedStringARB; - glGetNamedStringivARB: TglGetNamedStringivARB; - - // GL_ARB_blend_func_extended - glBindFragDataLocationIndexed: TglBindFragDataLocationIndexed; - glGetFragDataIndex: TglGetFragDataIndex; - - // GL_ARB_sampler_objects - glGenSamplers: TglGenSamplers; - glDeleteSamplers: TglDeleteSamplers; - glIsSampler: TglIsSampler; - glBindSampler: TglBindSampler; - glSamplerParameteri: TglSamplerParameteri; - glSamplerParameteriv: TglSamplerParameteriv; - glSamplerParameterf: TglSamplerParameterf; - glSamplerParameterfv: TglSamplerParameterfv; - glSamplerParameterIiv: TglSamplerParameterIiv; - glSamplerParameterIuiv: TglSamplerParameterIuiv; - glGetSamplerParameteriv: TglGetSamplerParameteriv; - glGetSamplerParameterIiv: TglGetSamplerParameterIiv; - glGetSamplerParameterfv: TglGetSamplerParameterfv; - glGetSamplerParameterIuiv: TglGetSamplerParameterIuiv; - - // GL_ARB_timer_query - glQueryCounter: TglQueryCounter; - glGetQueryObjecti64v: TglGetQueryObjecti64v; - glGetQueryObjectui64v: TglGetQueryObjectui64v; - - // GL_ARB_vertex_type_2_10_10_10_rev - glVertexP2ui: TglVertexP2ui; - glVertexP2uiv: TglVertexP2uiv; - glVertexP3ui: TglVertexP3ui; - glVertexP3uiv: TglVertexP3uiv; - glVertexP4ui: TglVertexP4ui; - glVertexP4uiv: TglVertexP4uiv; - glTexCoordP1ui: TglTexCoordP1ui; - glTexCoordP1uiv: TglTexCoordP1uiv; - glTexCoordP2ui: TglTexCoordP2ui; - glTexCoordP2uiv: TglTexCoordP2uiv; - glTexCoordP3ui: TglTexCoordP3ui; - glTexCoordP3uiv: TglTexCoordP3uiv; - glTexCoordP4ui: TglTexCoordP4ui; - glTexCoordP4uiv: TglTexCoordP4uiv; - glMultiTexCoordP1ui: TglMultiTexCoordP1ui; - glMultiTexCoordP1uiv: TglMultiTexCoordP1uiv; - glMultiTexCoordP2ui: TglMultiTexCoordP2ui; - glMultiTexCoordP2uiv: TglMultiTexCoordP2uiv; - glMultiTexCoordP3ui: TglMultiTexCoordP3ui; - glMultiTexCoordP3uiv: TglMultiTexCoordP3uiv; - glMultiTexCoordP4ui: TglMultiTexCoordP4ui; - glMultiTexCoordP4uiv: TglMultiTexCoordP4uiv; - glNormalP3ui: TglNormalP3ui; - glNormalP3uiv: TglNormalP3uiv; - glColorP3ui: TglColorP3ui; - glColorP3uiv: TglColorP3uiv; - glColorP4ui: TglColorP4ui; - glColorP4uiv: TglColorP4uiv; - glSecondaryColorP3ui: TglSecondaryColorP3ui; - glSecondaryColorP3uiv: TglSecondaryColorP3uiv; - glVertexAttribP1ui: TglVertexAttribP1ui; - glVertexAttribP1uiv: TglVertexAttribP1uiv; - glVertexAttribP2ui: TglVertexAttribP2ui; - glVertexAttribP2uiv: TglVertexAttribP2uiv; - glVertexAttribP3ui: TglVertexAttribP3ui; - glVertexAttribP3uiv: TglVertexAttribP3uiv; - glVertexAttribP4ui: TglVertexAttribP4ui; - glVertexAttribP4uiv: TglVertexAttribP4uiv; - - // GL_ARB_draw_indirect - glDrawArraysIndirect: TglDrawArraysIndirect; - glDrawElementsIndirect: TglDrawElementsIndirect; - - // GL_ARB_gpu_shader_fp64 - glUniform1d: TglUniform1d; - glUniform2d: TglUniform2d; - glUniform3d: TglUniform3d; - glUniform4d: TglUniform4d; - glUniform1dv: TglUniform1dv; - glUniform2dv: TglUniform2dv; - glUniform3dv: TglUniform3dv; - glUniform4dv: TglUniform4dv; - glUniformMatrix2dv: TglUniformMatrix2dv; - glUniformMatrix3dv: TglUniformMatrix3dv; - glUniformMatrix4dv: TglUniformMatrix4dv; - glUniformMatrix2x3dv: TglUniformMatrix2x3dv; - glUniformMatrix2x4dv: TglUniformMatrix2x4dv; - glUniformMatrix3x2dv: TglUniformMatrix3x2dv; - glUniformMatrix3x4dv: TglUniformMatrix3x4dv; - glUniformMatrix4x2dv: TglUniformMatrix4x2dv; - glUniformMatrix4x3dv: TglUniformMatrix4x3dv; - glGetUniformdv: TglGetUniformdv; - - // GL_ARB_shader_subroutine - glGetSubroutineUniformLocation: TglGetSubroutineUniformLocation; - glGetSubroutineIndex: TglGetSubroutineIndex; - glGetActiveSubroutineUniformiv: TglGetActiveSubroutineUniformiv; - glGetActiveSubroutineUniformName: TglGetActiveSubroutineUniformName; - glGetActiveSubroutineName: TglGetActiveSubroutineName; - glUniformSubroutinesuiv: TglUniformSubroutinesuiv; - glGetUniformSubroutineuiv: TglGetUniformSubroutineuiv; - glGetProgramStageiv: TglGetProgramStageiv; - - // GL_ARB_tessellation_shader - glPatchParameteri: TglPatchParameteri; - glPatchParameterfv: TglPatchParameterfv; - - // GL_ARB_transform_feedback2 - glBindTransformFeedback: TglBindTransformFeedback; - glDeleteTransformFeedbacks: TglDeleteTransformFeedbacks; - glGenTransformFeedbacks: TglGenTransformFeedbacks; - glIsTransformFeedback: TglIsTransformFeedback; - glPauseTransformFeedback: TglPauseTransformFeedback; - glResumeTransformFeedback: TglResumeTransformFeedback; - glDrawTransformFeedback: TglDrawTransformFeedback; - - // GL_ARB_transform_feedback3 - glDrawTransformFeedbackStream: TglDrawTransformFeedbackStream; - glBeginQueryIndexed: TglBeginQueryIndexed; - glEndQueryIndexed: TglEndQueryIndexed; - glGetQueryIndexediv: TglGetQueryIndexediv; - - // GL_ARB_ES2_compatibility - glReleaseShaderCompiler: TglReleaseShaderCompiler; - glShaderBinary: TglShaderBinary; - glGetShaderPrecisionFormat: TglGetShaderPrecisionFormat; - glDepthRangef: TglDepthRangef; - glClearDepthf: TglClearDepthf; - - // GL_ARB_get_program_binary - glGetProgramBinary: TglGetProgramBinary; - glProgramBinary: TglProgramBinary; - glProgramParameteri: TglProgramParameteri; - - // GL_ARB_separate_shader_objects - glUseProgramStages: TglUseProgramStages; - glActiveShaderProgram: TglActiveShaderProgram; - glCreateShaderProgramv: TglCreateShaderProgramv; - glBindProgramPipeline: TglBindProgramPipeline; - glDeleteProgramPipelines: TglDeleteProgramPipelines; - glGenProgramPipelines: TglGenProgramPipelines; - glIsProgramPipeline: TglIsProgramPipeline; - glGetProgramPipelineiv: TglGetProgramPipelineiv; - glProgramUniform1i: TglProgramUniform1i; - glProgramUniform1iv: TglProgramUniform1iv; - glProgramUniform1f: TglProgramUniform1f; - glProgramUniform1fv: TglProgramUniform1fv; - glProgramUniform1d: TglProgramUniform1d; - glProgramUniform1dv: TglProgramUniform1dv; - glProgramUniform1ui: TglProgramUniform1ui; - glProgramUniform1uiv: TglProgramUniform1uiv; - glProgramUniform2i: TglProgramUniform2i; - glProgramUniform2iv: TglProgramUniform2iv; - glProgramUniform2f: TglProgramUniform2f; - glProgramUniform2fv: TglProgramUniform2fv; - glProgramUniform2d: TglProgramUniform2d; - glProgramUniform2dv: TglProgramUniform2dv; - glProgramUniform2ui: TglProgramUniform2ui; - glProgramUniform2uiv: TglProgramUniform2uiv; - glProgramUniform3i: TglProgramUniform3i; - glProgramUniform3iv: TglProgramUniform3iv; - glProgramUniform3f: TglProgramUniform3f; - glProgramUniform3fv: TglProgramUniform3fv; - glProgramUniform3d: TglProgramUniform3d; - glProgramUniform3dv: TglProgramUniform3dv; - glProgramUniform3ui: TglProgramUniform3ui; - glProgramUniform3uiv: TglProgramUniform3uiv; - glProgramUniform4i: TglProgramUniform4i; - glProgramUniform4iv: TglProgramUniform4iv; - glProgramUniform4f: TglProgramUniform4f; - glProgramUniform4fv: TglProgramUniform4fv; - glProgramUniform4d: TglProgramUniform4d; - glProgramUniform4dv: TglProgramUniform4dv; - glProgramUniform4ui: TglProgramUniform4ui; - glProgramUniform4uiv: TglProgramUniform4uiv; - glProgramUniformMatrix2fv: TglProgramUniformMatrix2fv; - glProgramUniformMatrix3fv: TglProgramUniformMatrix3fv; - glProgramUniformMatrix4fv: TglProgramUniformMatrix4fv; - glProgramUniformMatrix2dv: TglProgramUniformMatrix2dv; - glProgramUniformMatrix3dv: TglProgramUniformMatrix3dv; - glProgramUniformMatrix4dv: TglProgramUniformMatrix4dv; - glProgramUniformMatrix2x3fv: TglProgramUniformMatrix2x3fv; - glProgramUniformMatrix3x2fv: TglProgramUniformMatrix3x2fv; - glProgramUniformMatrix2x4fv: TglProgramUniformMatrix2x4fv; - glProgramUniformMatrix4x2fv: TglProgramUniformMatrix4x2fv; - glProgramUniformMatrix3x4fv: TglProgramUniformMatrix3x4fv; - glProgramUniformMatrix4x3fv: TglProgramUniformMatrix4x3fv; - glProgramUniformMatrix2x3dv: TglProgramUniformMatrix2x3dv; - glProgramUniformMatrix3x2dv: TglProgramUniformMatrix3x2dv; - glProgramUniformMatrix2x4dv: TglProgramUniformMatrix2x4dv; - glProgramUniformMatrix4x2dv: TglProgramUniformMatrix4x2dv; - glProgramUniformMatrix3x4dv: TglProgramUniformMatrix3x4dv; - glProgramUniformMatrix4x3dv: TglProgramUniformMatrix4x3dv; - glValidateProgramPipeline: TglValidateProgramPipeline; - glGetProgramPipelineInfoLog: TglGetProgramPipelineInfoLog; - - // GL_ARB_vertex_attrib_64bit - glVertexAttribL1d: TglVertexAttribL1d; - glVertexAttribL2d: TglVertexAttribL2d; - glVertexAttribL3d: TglVertexAttribL3d; - glVertexAttribL4d: TglVertexAttribL4d; - glVertexAttribL1dv: TglVertexAttribL1dv; - glVertexAttribL2dv: TglVertexAttribL2dv; - glVertexAttribL3dv: TglVertexAttribL3dv; - glVertexAttribL4dv: TglVertexAttribL4dv; - glVertexAttribLPointer: TglVertexAttribLPointer; - glGetVertexAttribLdv: TglGetVertexAttribLdv; - - // GL_ARB_viewport_array - glViewportArrayv: TglViewportArrayv; - glViewportIndexedf: TglViewportIndexedf; - glViewportIndexedfv: TglViewportIndexedfv; - glScissorArrayv: TglScissorArrayv; - glScissorIndexed: TglScissorIndexed; - glScissorIndexedv: TglScissorIndexedv; - glDepthRangeArrayv: TglDepthRangeArrayv; - glDepthRangeIndexed: TglDepthRangeIndexed; - glGetFloati_v: TglGetFloati_v; - glGetDoublei_v: TglGetDoublei_v; - - // GL 4.2 - - // GL_ARB_base_instance - glDrawArraysInstancedBaseInstance : TglDrawArraysInstancedBaseInstance; - glDrawElementsInstancedBaseInstance : TglDrawElementsInstancedBaseInstance; - glDrawElementsInstancedBaseVertexBaseInstance : TglDrawElementsInstancedBaseVertexBaseInstance; - - // GL_ARB_transform_feedback_instanced - glDrawTransformFeedbackInstanced : TglDrawTransformFeedbackInstanced; - glDrawTransformFeedbackStreamInstanced : TglDrawTransformFeedbackStreamInstanced; - - // GL_ARB_internalformat_query - glGetInternalformativ : TglGetInternalformativ; - - // GL_ARB_shader_atomic_counters - glGetActiveAtomicCounterBufferiv : TglGetActiveAtomicCounterBufferiv; - - /// GL_ARB_shader_image_load_store - glBindImageTexture : TglBindImageTexture; - glMemoryBarrier : TglMemoryBarrier; - - // GL_ARB_texture_storage - glTexStorage1D : TglTexStorage1D; - glTexStorage2D : TglTexStorage2D; - glTexStorage3D : TglTexStorage3D; - glTextureStorage1DEXT : TglTextureStorage1DEXT; - glTextureStorage2DEXT : TglTextureStorage2DEXT; - glTextureStorage3DEXT : TglTextureStorage3DEXT; - - - // GL 4.3 - - // GL_KHR_debug - glDebugMessageControl : TglDebugMessageControl; - glDebugMessageInsert : TglDebugMessageInsert; - glDebugMessageCallback : TglDebugMessageCallback; - glGetDebugMessageLog : TglGetDebugMessageLog; - glPushDebugGroup : TglPushDebugGroup; - glPopDebugGroup : TglPopDebugGroup; - glObjectLabel : TglObjectLabel; - glGetObjectLabel : TglGetObjectLabel; - glObjectPtrLabel : TglObjectPtrLabel; - glGetObjectPtrLabel : TglGetObjectPtrLabel; - - // GL_ARB_clear_buffer_object - glClearBufferData : TglClearBufferData; - glClearBufferSubData : TglClearBufferSubData; - glClearNamedBufferDataEXT : TglClearNamedBufferDataEXT; - glClearNamedBufferSubDataEXT : TglClearNamedBufferSubDataEXT; - - // GL_ARB_compute_shader - glDispatchCompute : TglDispatchCompute; - glDispatchComputeIndirect : TglDispatchComputeIndirect; - - // GL_ARB_copy_image - glCopyImageSubData : TglCopyImageSubData; - - // GL_ARB_framebuffer_no_attachments - glFramebufferParameteri : TglFramebufferParameteri; - glGetFramebufferParameteriv : TglGetFramebufferParameteriv; - glNamedFramebufferParameteriEXT : TglNamedFramebufferParameteriEXT; - glGetNamedFramebufferParameterivEXT : TglGetNamedFramebufferParameterivEXT; - - // GL_ARB_internalformat_query2 - glGetInternalformati64v : TglGetInternalformati64v; - - // GL_ARB_invalidate_subdata - glInvalidateTexSubImage : TglInvalidateTexSubImage; - glInvalidateTexImage : TglInvalidateTexImage; - glInvalidateBufferSubData : TglInvalidateBufferSubData; - glInvalidateBufferData : TglInvalidateBufferData; - glInvalidateFramebuffer : TglInvalidateFramebuffer; - glInvalidateSubFramebuffer : TglInvalidateSubFramebuffer; - - // GL_ARB_multi_draw_indirect - glMultiDrawArraysIndirect : TglMultiDrawArraysIndirect; - glMultiDrawElementsIndirect : TglMultiDrawElementsIndirect; - - // GL_ARB_program_interface_query - glGetProgramInterfaceiv : TglGetProgramInterfaceiv; - glGetProgramResourceIndex : TglGetProgramResourceIndex; - glGetProgramResourceName : TglGetProgramResourceName; - glGetProgramResourceiv : TglGetProgramResourceiv; - glGetProgramResourceLocation : TglGetProgramResourceLocation; - glGetProgramResourceLocationIndex : TglGetProgramResourceLocationIndex; - - // GL_ARB_shader_storage_buffer_object - glShaderStorageBlockBinding : TglShaderStorageBlockBinding; - - // GL_ARB_texture_buffer_range - glTexBufferRange : TglTexBufferRange; - glTextureBufferRangeEXT : TglTextureBufferRangeEXT; - - // GL_ARB_texture_storage_multisample - glTexStorage2DMultisample : TglTexStorage2DMultisample; - glTexStorage3DMultisample : TglTexStorage3DMultisample; - glTextureStorage2DMultisampleEXT : TglTextureStorage2DMultisampleEXT; - glTextureStorage3DMultisampleEXT : TglTextureStorage3DMultisampleEXT; - - // GL_ARB_texture_view - glTextureView : TglTextureView; - - // GL_ARB_vertex_attrib_binding - glBindVertexBuffer : TglBindVertexBuffer; - glVertexAttribFormat : TglVertexAttribFormat; - glVertexAttribIFormat : TglVertexAttribIFormat; - glVertexAttribLFormat : TglVertexAttribLFormat; - glVertexAttribBinding : TglVertexAttribBinding; - glVertexBindingDivisor : TglVertexBindingDivisor; - glVertexArrayBindVertexBufferEXT : TglVertexArrayBindVertexBufferEXT; - glVertexArrayVertexAttribFormatEXT : TglVertexArrayVertexAttribFormatEXT; - glVertexArrayVertexAttribIFormatEXT : TglVertexArrayVertexAttribIFormatEXT; - glVertexArrayVertexAttribLFormatEXT : TglVertexArrayVertexAttribLFormatEXT; - glVertexArrayVertexAttribBindingEXT : TglVertexArrayVertexAttribBindingEXT; - glVertexArrayVertexBindingDivisorEXT : TglVertexArrayVertexBindingDivisorEXT; - - // - - // GL_ARB_cl_event - glCreateSyncFromCLeventARB: TglCreateSyncFromCLeventARB; - - // GL_ARB_debug_output - glDebugMessageControlARB: TglDebugMessageControlARB; - glDebugMessageInsertARB: TglDebugMessageInsertARB; - glDebugMessageCallbackARB: TglDebugMessageCallbackARB; - glGetDebugMessageLogARB: TglGetDebugMessageLogARB; - - // GL_ARB_robustness - glGetGraphicsResetStatusARB: TglGetGraphicsResetStatusARB; - glGetnMapdvARB: TglGetnMapdvARB; - glGetnMapfvARB: TglGetnMapfvARB; - glGetnMapivARB: TglGetnMapivARB; - glGetnPixelMapfvARB: TglGetnPixelMapfvARB; - glGetnPixelMapuivARB: TglGetnPixelMapuivARB; - glGetnPixelMapusvARB: TglGetnPixelMapusvARB; - glGetnPolygonStippleARB: TglGetnPolygonStippleARB; - glGetnColorTableARB: TglGetnColorTableARB; - glGetnConvolutionFilterARB: TglGetnConvolutionFilterARB; - glGetnSeparableFilterARB: TglGetnSeparableFilterARB; - glGetnHistogramARB: TglGetnHistogramARB; - glGetnMinmaxARB: TglGetnMinmaxARB; - glGetnTexImageARB: TglGetnTexImageARB; - glReadnPixelsARB: TglReadnPixelsARB; - glGetnCompressedTexImageARB: TglGetnCompressedTexImageARB; - glGetnUniformfvARB: TglGetnUniformfvARB; - glGetnUniformivARB: TglGetnUniformivARB; - glGetnUniformuivARB: TglGetnUniformuivARB; - glGetnUniformdvARB: TglGetnUniformdvARB; - - // GL_ATI_draw_buffers - glDrawBuffersATI: TglDrawBuffersATI; - - // GL_ATI_element_array - glElementPointerATI: TglElementPointerATI; - glDrawElementArrayATI: TglDrawElementArrayATI; - glDrawRangeElementArrayATI: TglDrawRangeElementArrayATI; - - // GL_ATI_envmap_bumpmap - glTexBumpParameterivATI: TglTexBumpParameterivATI; - glTexBumpParameterfvATI: TglTexBumpParameterfvATI; - glGetTexBumpParameterivATI: TglGetTexBumpParameterivATI; - glGetTexBumpParameterfvATI: TglGetTexBumpParameterfvATI; - - // GL_ATI_fragment_shader - glGenFragmentShadersATI: TglGenFragmentShadersATI; - glBindFragmentShaderATI: TglBindFragmentShaderATI; - glDeleteFragmentShaderATI: TglDeleteFragmentShaderATI; - glBeginFragmentShaderATI: TglBeginFragmentShaderATI; - glEndFragmentShaderATI: TglEndFragmentShaderATI; - glPassTexCoordATI: TglPassTexCoordATI; - glSampleMapATI: TglSampleMapATI; - glColorFragmentOp1ATI: TglColorFragmentOp1ATI; - glColorFragmentOp2ATI: TglColorFragmentOp2ATI; - glColorFragmentOp3ATI: TglColorFragmentOp3ATI; - glAlphaFragmentOp1ATI: TglAlphaFragmentOp1ATI; - glAlphaFragmentOp2ATI: TglAlphaFragmentOp2ATI; - glAlphaFragmentOp3ATI: TglAlphaFragmentOp3ATI; - glSetFragmentShaderConstantATI: TglSetFragmentShaderConstantATI; - - // GL_ATI_map_object_buffer - glMapObjectBufferATI: TglMapObjectBufferATI; - glUnmapObjectBufferATI: TglUnmapObjectBufferATI; - - // GL_ATI_pn_triangles - glPNTrianglesiATI: TglPNTrianglesiATI; - glPNTrianglesfATI: TglPNTrianglesfATI; - - // GL_ATI_separate_stencil - glStencilOpSeparateATI: TglStencilOpSeparateATI; - glStencilFuncSeparateATI: TglStencilFuncSeparateATI; - - // GL_ATI_vertex_array_object - glNewObjectBufferATI: TglNewObjectBufferATI; - glIsObjectBufferATI: TglIsObjectBufferATI; - glUpdateObjectBufferATI: TglUpdateObjectBufferATI; - glGetObjectBufferfvATI: TglGetObjectBufferfvATI; - glGetObjectBufferivATI: TglGetObjectBufferivATI; - glFreeObjectBufferATI: TglFreeObjectBufferATI; - glArrayObjectATI: TglArrayObjectATI; - glGetArrayObjectfvATI: TglGetArrayObjectfvATI; - glGetArrayObjectivATI: TglGetArrayObjectivATI; - glVariantArrayObjectATI: TglVariantArrayObjectATI; - glGetVariantArrayObjectfvATI: TglGetVariantArrayObjectfvATI; - glGetVariantArrayObjectivATI: TglGetVariantArrayObjectivATI; - glVertexAttribArrayObjectATI: TglVertexAttribArrayObjectATI; - glGetVertexAttribArrayObjectfvATI: TglGetVertexAttribArrayObjectfvATI; - glGetVertexAttribArrayObjectivATI: TglGetVertexAttribArrayObjectivATI; - - // GL_ATI_vertex_streams - glVertexStream1sATI: TglVertexStream1sATI; - glVertexStream1svATI: TglVertexStream1svATI; - glVertexStream1iATI: TglVertexStream1iATI; - glVertexStream1ivATI: TglVertexStream1ivATI; - glVertexStream1fATI: TglVertexStream1fATI; - glVertexStream1fvATI: TglVertexStream1fvATI; - glVertexStream1dATI: TglVertexStream1dATI; - glVertexStream1dvATI: TglVertexStream1dvATI; - glVertexStream2sATI: TglVertexStream2sATI; - glVertexStream2svATI: TglVertexStream2svATI; - glVertexStream2iATI: TglVertexStream2iATI; - glVertexStream2ivATI: TglVertexStream2ivATI; - glVertexStream2fATI: TglVertexStream2fATI; - glVertexStream2fvATI: TglVertexStream2fvATI; - glVertexStream2dATI: TglVertexStream2dATI; - glVertexStream2dvATI: TglVertexStream2dvATI; - glVertexStream3sATI: TglVertexStream3sATI; - glVertexStream3svATI: TglVertexStream3svATI; - glVertexStream3iATI: TglVertexStream3iATI; - glVertexStream3ivATI: TglVertexStream3ivATI; - glVertexStream3fATI: TglVertexStream3fATI; - glVertexStream3fvATI: TglVertexStream3fvATI; - glVertexStream3dATI: TglVertexStream3dATI; - glVertexStream3dvATI: TglVertexStream3dvATI; - glVertexStream4sATI: TglVertexStream4sATI; - glVertexStream4svATI: TglVertexStream4svATI; - glVertexStream4iATI: TglVertexStream4iATI; - glVertexStream4ivATI: TglVertexStream4ivATI; - glVertexStream4fATI: TglVertexStream4fATI; - glVertexStream4fvATI: TglVertexStream4fvATI; - glVertexStream4dATI: TglVertexStream4dATI; - glVertexStream4dvATI: TglVertexStream4dvATI; - glNormalStream3bATI: TglNormalStream3bATI; - glNormalStream3bvATI: TglNormalStream3bvATI; - glNormalStream3sATI: TglNormalStream3sATI; - glNormalStream3svATI: TglNormalStream3svATI; - glNormalStream3iATI: TglNormalStream3iATI; - glNormalStream3ivATI: TglNormalStream3ivATI; - glNormalStream3fATI: TglNormalStream3fATI; - glNormalStream3fvATI: TglNormalStream3fvATI; - glNormalStream3dATI: TglNormalStream3dATI; - glNormalStream3dvATI: TglNormalStream3dvATI; - glClientActiveVertexStreamATI: TglClientActiveVertexStreamATI; - glVertexBlendEnviATI: TglVertexBlendEnviATI; - glVertexBlendEnvfATI: TglVertexBlendEnvfATI; - - // GL_AMD_performance_monitor - glGetPerfMonitorGroupsAMD: TglGetPerfMonitorGroupsAMD; - glGetPerfMonitorCountersAMD: TglGetPerfMonitorCountersAMD; - glGetPerfMonitorGroupStringAMD: TglGetPerfMonitorGroupStringAMD; - glGetPerfMonitorCounterStringAMD: TglGetPerfMonitorCounterStringAMD; - glGetPerfMonitorCounterInfoAMD: TglGetPerfMonitorCounterInfoAMD; - glGenPerfMonitorsAMD: TglGenPerfMonitorsAMD; - glDeletePerfMonitorsAMD: TglDeletePerfMonitorsAMD; - glSelectPerfMonitorCountersAMD: TglSelectPerfMonitorCountersAMD; - glBeginPerfMonitorAMD: TglBeginPerfMonitorAMD; - glEndPerfMonitorAMD: TglEndPerfMonitorAMD; - glGetPerfMonitorCounterDataAMD: TglGetPerfMonitorCounterDataAMD; - - // GL_AMD_vertex_shader_tesselator - glTessellationFactorAMD: TglTessellationFactorAMD; - glTessellationModeAMD: TglTessellationModeAMD; - - // GL_AMD_draw_buffers_blend - glBlendFuncIndexedAMD: TglBlendFuncIndexedAMD; - glBlendFuncSeparateIndexedAMD: TglBlendFuncSeparateIndexedAMD; - glBlendEquationIndexedAMD: TglBlendEquationIndexedAMD; - glBlendEquationSeparateIndexedAMD: TglBlendEquationSeparateIndexedAMD; - - // GL_AMD_name_gen_delete - glGenNamesAMD: TglGenNamesAMD; - glDeleteNamesAMD: TglDeleteNamesAMD; - glIsNameAMD: TglIsNameAMD; - - // GL_AMD_debug_output - glDebugMessageEnableAMD: TglDebugMessageEnableAMD; - glDebugMessageInsertAMD: TglDebugMessageInsertAMD; - glDebugMessageCallbackAMD: TglDebugMessageCallbackAMD; - glGetDebugMessageLogAMD: TglGetDebugMessageLogAMD; - - // GL_EXT_blend_color - glBlendColorEXT: TglBlendColorEXT; - - // GL_EXT_blend_func_separate - glBlendFuncSeparateEXT: TglBlendFuncSeparateEXT; - - // GL_EXT_blend_minmax - glBlendEquationEXT: TglBlendEquationEXT; - - // GL_EXT_color_subtable - glColorSubTableEXT: TglColorSubTableEXT; - glCopyColorSubTableEXT: TglCopyColorSubTableEXT; - - // GL_EXT_compiled_vertex_array - glLockArraysEXT: TglLockArraysEXT; - glUnlockArraysEXT: TglUnlockArraysEXT; - - // GL_EXT_convolution - glConvolutionFilter1DEXT: TglConvolutionFilter1DEXT; - glConvolutionFilter2DEXT: TglConvolutionFilter2DEXT; - glConvolutionParameterfEXT: TglConvolutionParameterfEXT; - glConvolutionParameterfvEXT: TglConvolutionParameterfvEXT; - glConvolutionParameteriEXT: TglConvolutionParameteriEXT; - glConvolutionParameterivEXT: TglConvolutionParameterivEXT; - glCopyConvolutionFilter1DEXT: TglCopyConvolutionFilter1DEXT; - glCopyConvolutionFilter2DEXT: TglCopyConvolutionFilter2DEXT; - glGetConvolutionFilterEXT: TglGetConvolutionFilterEXT; - glGetConvolutionParameterfvEXT: TglGetConvolutionParameterfvEXT; - glGetConvolutionParameterivEXT: TglGetConvolutionParameterivEXT; - glGetSeparableFilterEXT: TglGetSeparableFilterEXT; - glSeparableFilter2DEXT: TglSeparableFilter2DEXT; - - // GL_EXT_coordinate_frame - glTangent3bEXT: TglTangent3bEXT; - glTangent3bvEXT: TglTangent3bvEXT; - glTangent3dEXT: TglTangent3dEXT; - glTangent3dvEXT: TglTangent3dvEXT; - glTangent3fEXT: TglTangent3fEXT; - glTangent3fvEXT: TglTangent3fvEXT; - glTangent3iEXT: TglTangent3iEXT; - glTangent3ivEXT: TglTangent3ivEXT; - glTangent3sEXT: TglTangent3sEXT; - glTangent3svEXT: TglTangent3svEXT; - glBinormal3bEXT: TglBinormal3bEXT; - glBinormal3bvEXT: TglBinormal3bvEXT; - glBinormal3dEXT: TglBinormal3dEXT; - glBinormal3dvEXT: TglBinormal3dvEXT; - glBinormal3fEXT: TglBinormal3fEXT; - glBinormal3fvEXT: TglBinormal3fvEXT; - glBinormal3iEXT: TglBinormal3iEXT; - glBinormal3ivEXT: TglBinormal3ivEXT; - glBinormal3sEXT: TglBinormal3sEXT; - glBinormal3svEXT: TglBinormal3svEXT; - glTangentPointerEXT: TglTangentPointerEXT; - glBinormalPointerEXT: TglBinormalPointerEXT; - - // GL_EXT_copy_texture - glCopyTexImage1DEXT: TglCopyTexImage1DEXT; - glCopyTexImage2DEXT: TglCopyTexImage2DEXT; - glCopyTexSubImage1DEXT: TglCopyTexSubImage1DEXT; - glCopyTexSubImage2DEXT: TglCopyTexSubImage2DEXT; - glCopyTexSubImage3DEXT: TglCopyTexSubImage3DEXT; - - // GL_EXT_cull_vertex - glCullParameterdvEXT: TglCullParameterdvEXT; - glCullParameterfvEXT: TglCullParameterfvEXT; - - // GL_EXT_draw_range_elements - glDrawRangeElementsEXT: TglDrawRangeElementsEXT; - - // GL_EXT_fog_coord - glFogCoordfEXT: TglFogCoordfEXT; - glFogCoordfvEXT: TglFogCoordfvEXT; - glFogCoorddEXT: TglFogCoorddEXT; - glFogCoorddvEXT: TglFogCoorddvEXT; - glFogCoordPointerEXT: TglFogCoordPointerEXT; - - // GL_EXT_framebuffer_object - glIsRenderbufferEXT: TglIsRenderbufferEXT; - glBindRenderbufferEXT: TglBindRenderbufferEXT; - glDeleteRenderbuffersEXT: TglDeleteRenderbuffersEXT; - glGenRenderbuffersEXT: TglGenRenderbuffersEXT; - glRenderbufferStorageEXT: TglRenderbufferStorageEXT; - glGetRenderbufferParameterivEXT: TglGetRenderbufferParameterivEXT; - glIsFramebufferEXT: TglIsFramebufferEXT; - glBindFramebufferEXT: TglBindFramebufferEXT; - glDeleteFramebuffersEXT: TglDeleteFramebuffersEXT; - glGenFramebuffersEXT: TglGenFramebuffersEXT; - glCheckFramebufferStatusEXT: TglCheckFramebufferStatusEXT; - glFramebufferTexture1DEXT: TglFramebufferTexture1DEXT; - glFramebufferTexture2DEXT: TglFramebufferTexture2DEXT; - glFramebufferTexture3DEXT: TglFramebufferTexture3DEXT; - glFramebufferRenderbufferEXT: TglFramebufferRenderbufferEXT; - glGetFramebufferAttachmentParameterivEXT: TglGetFramebufferAttachmentParameterivEXT; - glGenerateMipmapEXT: TglGenerateMipmapEXT; - - // GL_EXT_histogram - glGetHistogramEXT: TglGetHistogramEXT; - glGetHistogramParameterfvEXT: TglGetHistogramParameterfvEXT; - glGetHistogramParameterivEXT: TglGetHistogramParameterivEXT; - glGetMinmaxEXT: TglGetMinmaxEXT; - glGetMinmaxParameterfvEXT: TglGetMinmaxParameterfvEXT; - glGetMinmaxParameterivEXT: TglGetMinmaxParameterivEXT; - glHistogramEXT: TglHistogramEXT; - glMinmaxEXT: TglMinmaxEXT; - glResetHistogramEXT: TglResetHistogramEXT; - glResetMinmaxEXT: TglResetMinmaxEXT; - - // GL_EXT_index_func - glIndexFuncEXT: TglIndexFuncEXT; - - // GL_EXT_index_material - glIndexMaterialEXT: TglIndexMaterialEXT; - - // GL_EXT_light_texture - glApplyTextureEXT: TglApplyTextureEXT; - glTextureLightEXT: TglTextureLightEXT; - glTextureMaterialEXT: TglTextureMaterialEXT; - - // GL_EXT_multi_draw_arrays - glMultiDrawArraysEXT: TglMultiDrawArraysEXT; - glMultiDrawElementsEXT: TglMultiDrawElementsEXT; - - // GL_EXT_multisample - glSampleMaskEXT: TglSampleMaskEXT; - glSamplePatternEXT: TglSamplePatternEXT; - - // GL_EXT_paletted_texture - glColorTableEXT: TglColorTableEXT; - glGetColorTableEXT: TglGetColorTableEXT; - glGetColorTableParameterivEXT: TglGetColorTableParameterivEXT; - glGetColorTableParameterfvEXT: TglGetColorTableParameterfvEXT; - - // GL_EXT_pixel_transform - glPixelTransformParameteriEXT: TglPixelTransformParameteriEXT; - glPixelTransformParameterfEXT: TglPixelTransformParameterfEXT; - glPixelTransformParameterivEXT: TglPixelTransformParameterivEXT; - glPixelTransformParameterfvEXT: TglPixelTransformParameterfvEXT; - - // GL_EXT_point_parameters - glPointParameterfEXT: TglPointParameterfEXT; - glPointParameterfvEXT: TglPointParameterfvEXT; - - // GL_EXT_polygon_offset - glPolygonOffsetEXT: TglPolygonOffsetEXT; - - // GL_EXT_secondary_color - glSecondaryColor3bEXT: TglSecondaryColor3bEXT; - glSecondaryColor3bvEXT: TglSecondaryColor3bvEXT; - glSecondaryColor3dEXT: TglSecondaryColor3dEXT; - glSecondaryColor3dvEXT: TglSecondaryColor3dvEXT; - glSecondaryColor3fEXT: TglSecondaryColor3fEXT; - glSecondaryColor3fvEXT: TglSecondaryColor3fvEXT; - glSecondaryColor3iEXT: TglSecondaryColor3iEXT; - glSecondaryColor3ivEXT: TglSecondaryColor3ivEXT; - glSecondaryColor3sEXT: TglSecondaryColor3sEXT; - glSecondaryColor3svEXT: TglSecondaryColor3svEXT; - glSecondaryColor3ubEXT: TglSecondaryColor3ubEXT; - glSecondaryColor3ubvEXT: TglSecondaryColor3ubvEXT; - glSecondaryColor3uiEXT: TglSecondaryColor3uiEXT; - glSecondaryColor3uivEXT: TglSecondaryColor3uivEXT; - glSecondaryColor3usEXT: TglSecondaryColor3usEXT; - glSecondaryColor3usvEXT: TglSecondaryColor3usvEXT; - glSecondaryColorPointerEXT: TglSecondaryColorPointerEXT; - - // GL_EXT_stencil_two_side - glActiveStencilFaceEXT: TglActiveStencilFaceEXT; - - // GL_EXT_subtexture - glTexSubImage1DEXT: TglTexSubImage1DEXT; - glTexSubImage2DEXT: TglTexSubImage2DEXT; - - // GL_EXT_texture3D - glTexImage3DEXT: TglTexImage3DEXT; - glTexSubImage3DEXT: TglTexSubImage3DEXT; - - // GL_EXT_texture_object - glAreTexturesResidentEXT: TglAreTexturesResidentEXT; - glBindTextureEXT: TglBindTextureEXT; - glDeleteTexturesEXT: TglDeleteTexturesEXT; - glGenTexturesEXT: TglGenTexturesEXT; - glIsTextureEXT: TglIsTextureEXT; - glPrioritizeTexturesEXT: TglPrioritizeTexturesEXT; - - // GL_EXT_texture_perturb_normal - glTextureNormalEXT: TglTextureNormalEXT; - - // GL_EXT_vertex_array - glArrayElementEXT: TglArrayElementEXT; - glColorPointerEXT: TglColorPointerEXT; - glDrawArraysEXT: TglDrawArraysEXT; - glEdgeFlagPointerEXT: TglEdgeFlagPointerEXT; - glGetPointervEXT: TglGetPointervEXT; - glIndexPointerEXT: TglIndexPointerEXT; - glNormalPointerEXT: TglNormalPointerEXT; - glTexCoordPointerEXT: TglTexCoordPointerEXT; - glVertexPointerEXT: TglVertexPointerEXT; - - // GL_EXT_vertex_shader - glBeginVertexShaderEXT: TglBeginVertexShaderEXT; - glEndVertexShaderEXT: TglEndVertexShaderEXT; - glBindVertexShaderEXT: TglBindVertexShaderEXT; - glGenVertexShadersEXT: TglGenVertexShadersEXT; - glDeleteVertexShaderEXT: TglDeleteVertexShaderEXT; - glShaderOp1EXT: TglShaderOp1EXT; - glShaderOp2EXT: TglShaderOp2EXT; - glShaderOp3EXT: TglShaderOp3EXT; - glSwizzleEXT: TglSwizzleEXT; - glWriteMaskEXT: TglWriteMaskEXT; - glInsertComponentEXT: TglInsertComponentEXT; - glExtractComponentEXT: TglExtractComponentEXT; - glGenSymbolsEXT: TglGenSymbolsEXT; - glSetInvariantEXT: TglSetInvariantEXT; - glSetLocalConstantEXT: TglSetLocalConstantEXT; - glVariantbvEXT: TglVariantbvEXT; - glVariantsvEXT: TglVariantsvEXT; - glVariantivEXT: TglVariantivEXT; - glVariantfvEXT: TglVariantfvEXT; - glVariantdvEXT: TglVariantdvEXT; - glVariantubvEXT: TglVariantubvEXT; - glVariantusvEXT: TglVariantusvEXT; - glVariantuivEXT: TglVariantuivEXT; - glVariantPointerEXT: TglVariantPointerEXT; - glEnableVariantClientStateEXT: TglEnableVariantClientStateEXT; - glDisableVariantClientStateEXT: TglDisableVariantClientStateEXT; - glBindLightParameterEXT: TglBindLightParameterEXT; - glBindMaterialParameterEXT: TglBindMaterialParameterEXT; - glBindTexGenParameterEXT: TglBindTexGenParameterEXT; - glBindTextureUnitParameterEXT: TglBindTextureUnitParameterEXT; - glBindParameterEXT: TglBindParameterEXT; - glIsVariantEnabledEXT: TglIsVariantEnabledEXT; - glGetVariantBooleanvEXT: TglGetVariantBooleanvEXT; - glGetVariantIntegervEXT: TglGetVariantIntegervEXT; - glGetVariantFloatvEXT: TglGetVariantFloatvEXT; - glGetVariantPointervEXT: TglGetVariantPointervEXT; - glGetInvariantBooleanvEXT: TglGetInvariantBooleanvEXT; - glGetInvariantIntegervEXT: TglGetInvariantIntegervEXT; - glGetInvariantFloatvEXT: TglGetInvariantFloatvEXT; - glGetLocalConstantBooleanvEXT: TglGetLocalConstantBooleanvEXT; - glGetLocalConstantIntegervEXT: TglGetLocalConstantIntegervEXT; - glGetLocalConstantFloatvEXT: TglGetLocalConstantFloatvEXT; - - // GL_EXT_vertex_weighting - glVertexWeightfEXT: TglVertexWeightfEXT; - glVertexWeightfvEXT: TglVertexWeightfvEXT; - glVertexWeightPointerEXT: TglVertexWeightPointerEXT; - - // GL_EXT_stencil_clear_tag - glStencilClearTagEXT: TglStencilClearTagEXT; - - // GL_EXT_framebuffer_blit - glBlitFramebufferEXT: TglBlitFramebufferEXT; - - // GL_EXT_framebuffer_multisample - glRenderbufferStorageMultisampleEXT: TglRenderbufferStorageMultisampleEXT; - - // GL_EXT_timer_query - glGetQueryObjecti64vEXT: TglGetQueryObjecti64vEXT; - glGetQueryObjectui64vEXT: TglGetQueryObjectui64vEXT; - - // GL_EXT_gpu_program_parameters - glProgramEnvParameters4fvEXT: TglProgramEnvParameters4fvEXT; - glProgramLocalParameters4fvEXT: TglProgramLocalParameters4fvEXT; - - // GL_EXT_bindable_uniform - glUniformBufferEXT: TglUniformBufferEXT; - glGetUniformBufferSizeEXT: TglGetUniformBufferSizeEXT; - glGetUniformOffsetEXT: TglGetUniformOffsetEXT; - - // GL_EXT_draw_buffers2 - glColorMaskIndexedEXT: TglColorMaskIndexedEXT; - glGetBooleanIndexedvEXT: TglGetBooleanIndexedvEXT; - glGetIntegerIndexedvEXT: TglGetIntegerIndexedvEXT; - glEnableIndexedEXT: TglEnableIndexedEXT; - glDisableIndexedEXT: TglDisableIndexedEXT; - glIsEnabledIndexedEXT: TglIsEnabledIndexedEXT; - - // GL_EXT_draw_instanced - glDrawArraysInstancedEXT: TglDrawArraysInstancedEXT; - glDrawElementsInstancedEXT: TglDrawElementsInstancedEXT; - - // GL_EXT_geometry_shader4 - glProgramParameteriEXT: TglProgramParameteriEXT; - glFramebufferTextureEXT: TglFramebufferTextureEXT; -// glFramebufferTextureLayerEXT: TglFramebufferTextureLayerEXT; - glFramebufferTextureFaceEXT: TglFramebufferTextureFaceEXT; - - // GL_EXT_gpu_shader4 - glVertexAttribI1iEXT: TglVertexAttribI1iEXT; - glVertexAttribI2iEXT: TglVertexAttribI2iEXT; - glVertexAttribI3iEXT: TglVertexAttribI3iEXT; - glVertexAttribI4iEXT: TglVertexAttribI4iEXT; - glVertexAttribI1uiEXT: TglVertexAttribI1uiEXT; - glVertexAttribI2uiEXT: TglVertexAttribI2uiEXT; - glVertexAttribI3uiEXT: TglVertexAttribI3uiEXT; - glVertexAttribI4uiEXT: TglVertexAttribI4uiEXT; - glVertexAttribI1ivEXT: TglVertexAttribI1ivEXT; - glVertexAttribI2ivEXT: TglVertexAttribI2ivEXT; - glVertexAttribI3ivEXT: TglVertexAttribI3ivEXT; - glVertexAttribI4ivEXT: TglVertexAttribI4ivEXT; - glVertexAttribI1uivEXT: TglVertexAttribI1uivEXT; - glVertexAttribI2uivEXT: TglVertexAttribI2uivEXT; - glVertexAttribI3uivEXT: TglVertexAttribI3uivEXT; - glVertexAttribI4uivEXT: TglVertexAttribI4uivEXT; - glVertexAttribI4bvEXT: TglVertexAttribI4bvEXT; - glVertexAttribI4svEXT: TglVertexAttribI4svEXT; - glVertexAttribI4ubvEXT: TglVertexAttribI4ubvEXT; - glVertexAttribI4usvEXT: TglVertexAttribI4usvEXT; - glVertexAttribIPointerEXT: TglVertexAttribIPointerEXT; - glGetVertexAttribIivEXT: TglGetVertexAttribIivEXT; - glGetVertexAttribIuivEXT: TglGetVertexAttribIuivEXT; - glUniform1uiEXT: TglUniform1uiEXT; - glUniform2uiEXT: TglUniform2uiEXT; - glUniform3uiEXT: TglUniform3uiEXT; - glUniform4uiEXT: TglUniform4uiEXT; - glUniform1uivEXT: TglUniform1uivEXT; - glUniform2uivEXT: TglUniform2uivEXT; - glUniform3uivEXT: TglUniform3uivEXT; - glUniform4uivEXT: TglUniform4uivEXT; - glGetUniformuivEXT: TglGetUniformuivEXT; - glBindFragDataLocationEXT: TglBindFragDataLocationEXT; - glGetFragDataLocationEXT: TglGetFragDataLocationEXT; - - // GL_EXT_texture_array - glFramebufferTextureLayerEXT: TglFramebufferTextureLayerEXT; - - // GL_EXT_texture_buffer_object - glTexBufferEXT: TglTexBufferEXT; - - // GL_EXT_texture_integer - glClearColorIiEXT: TglClearColorIiEXT; - glClearColorIuiEXT: TglClearColorIuiEXT; - glTexParameterIivEXT: TglTexParameterIivEXT; - glTexParameterIuivEXT: TglTexParameterIuivEXT; - glGetTexParameterIivEXT: TglGetTexParameterIivEXT; - glGetTexParameterIiuvEXT: TglGetTexParameterIiuvEXT; - - // GL_EXT_transform_feedback - glBeginTransformFeedbackEXT: TglBeginTransformFeedbackEXT; - glEndTransformFeedbackEXT: TglEndTransformFeedbackEXT; - glBindBufferRangeEXT: TglBindBufferRangeEXT; - glBindBufferOffsetEXT: TglBindBufferOffsetEXT; - glBindBufferBaseEXT: TglBindBufferBaseEXT; - glTransformFeedbackVaryingsEXT: TglTransformFeedbackVaryingsEXT; - glGetTransformFeedbackVaryingEXT: TglGetTransformFeedbackVaryingEXT; - - // GL_EXT_direct_state_access - glClientAttribDefaultEXT: TglClientAttribDefaultEXT; - glPushClientAttribDefaultEXT: TglPushClientAttribDefaultEXT; - glMatrixLoadfEXT: TglMatrixLoadfEXT; - glMatrixLoaddEXT: TglMatrixLoaddEXT; - glMatrixMultfEXT: TglMatrixMultfEXT; - glMatrixMultdEXT: TglMatrixMultdEXT; - glMatrixLoadIdentityEXT: TglMatrixLoadIdentityEXT; - glMatrixRotatefEXT: TglMatrixRotatefEXT; - glMatrixRotatedEXT: TglMatrixRotatedEXT; - glMatrixScalefEXT: TglMatrixScalefEXT; - glMatrixScaledEXT: TglMatrixScaledEXT; - glMatrixTranslatefEXT: TglMatrixTranslatefEXT; - glMatrixTranslatedEXT: TglMatrixTranslatedEXT; - glMatrixFrustumEXT: TglMatrixFrustumEXT; - glMatrixOrthoEXT: TglMatrixOrthoEXT; - glMatrixPopEXT: TglMatrixPopEXT; - glMatrixPushEXT: TglMatrixPushEXT; - glMatrixLoadTransposefEXT: TglMatrixLoadTransposefEXT; - glMatrixLoadTransposedEXT: TglMatrixLoadTransposedEXT; - glMatrixMultTransposefEXT: TglMatrixMultTransposefEXT; - glMatrixMultTransposedEXT: TglMatrixMultTransposedEXT; - glTextureParameterfEXT: TglTextureParameterfEXT; - glTextureParameterfvEXT: TglTextureParameterfvEXT; - glTextureParameteriEXT: TglTextureParameteriEXT; - glTextureParameterivEXT: TglTextureParameterivEXT; - glTextureImage1DEXT: TglTextureImage1DEXT; - glTextureImage2DEXT: TglTextureImage2DEXT; - glTextureSubImage1DEXT: TglTextureSubImage1DEXT; - glTextureSubImage2DEXT: TglTextureSubImage2DEXT; - glCopyTextureImage1DEXT: TglCopyTextureImage1DEXT; - glCopyTextureImage2DEXT: TglCopyTextureImage2DEXT; - glCopyTextureSubImage1DEXT: TglCopyTextureSubImage1DEXT; - glCopyTextureSubImage2DEXT: TglCopyTextureSubImage2DEXT; - glGetTextureImageEXT: TglGetTextureImageEXT; - glGetTextureParameterfvEXT: TglGetTextureParameterfvEXT; - glGetTextureParameterivEXT: TglGetTextureParameterivEXT; - glGetTextureLevelParameterfvEXT: TglGetTextureLevelParameterfvEXT; - glGetTextureLevelParameterivEXT: TglGetTextureLevelParameterivEXT; - glTextureImage3DEXT: TglTextureImage3DEXT; - glTextureSubImage3DEXT: TglTextureSubImage3DEXT; - glCopyTextureSubImage3DEXT: TglCopyTextureSubImage3DEXT; - glMultiTexParameterfEXT: TglMultiTexParameterfEXT; - glMultiTexParameterfvEXT: TglMultiTexParameterfvEXT; - glMultiTexParameteriEXT: TglMultiTexParameteriEXT; - glMultiTexParameterivEXT: TglMultiTexParameterivEXT; - glMultiTexImage1DEXT: TglMultiTexImage1DEXT; - glMultiTexImage2DEXT: TglMultiTexImage2DEXT; - glMultiTexSubImage1DEXT: TglMultiTexSubImage1DEXT; - glMultiTexSubImage2DEXT: TglMultiTexSubImage2DEXT; - glCopyMultiTexImage1DEXT: TglCopyMultiTexImage1DEXT; - glCopyMultiTexImage2DEXT: TglCopyMultiTexImage2DEXT; - glCopyMultiTexSubImage1DEXT: TglCopyMultiTexSubImage1DEXT; - glCopyMultiTexSubImage2DEXT: TglCopyMultiTexSubImage2DEXT; - glGetMultiTexImageEXT: TglGetMultiTexImageEXT; - glGetMultiTexParameterfvEXT: TglGetMultiTexParameterfvEXT; - glGetMultiTexParameterivEXT: TglGetMultiTexParameterivEXT; - glGetMultiTexLevelParameterfvEXT: TglGetMultiTexLevelParameterfvEXT; - glGetMultiTexLevelParameterivEXT: TglGetMultiTexLevelParameterivEXT; - glMultiTexImage3DEXT: TglMultiTexImage3DEXT; - glMultiTexSubImage3DEXT: TglMultiTexSubImage3DEXT; - glCopyMultiTexSubImage3DEXT: TglCopyMultiTexSubImage3DEXT; - glBindMultiTextureEXT: TglBindMultiTextureEXT; - glEnableClientStateIndexedEXT: TglEnableClientStateIndexedEXT; - glDisableClientStateIndexedEXT: TglDisableClientStateIndexedEXT; - glMultiTexCoordPointerEXT: TglMultiTexCoordPointerEXT; - glMultiTexEnvfEXT: TglMultiTexEnvfEXT; - glMultiTexEnvfvEXT: TglMultiTexEnvfvEXT; - glMultiTexEnviEXT: TglMultiTexEnviEXT; - glMultiTexEnvivEXT: TglMultiTexEnvivEXT; - glMultiTexGendEXT: TglMultiTexGendEXT; - glMultiTexGendvEXT: TglMultiTexGendvEXT; - glMultiTexGenfEXT: TglMultiTexGenfEXT; - glMultiTexGenfvEXT: TglMultiTexGenfvEXT; - glMultiTexGeniEXT: TglMultiTexGeniEXT; - glMultiTexGenivEXT: TglMultiTexGenivEXT; - glGetMultiTexEnvfvEXT: TglGetMultiTexEnvfvEXT; - glGetMultiTexEnvivEXT: TglGetMultiTexEnvivEXT; - glGetMultiTexGendvEXT: TglGetMultiTexGendvEXT; - glGetMultiTexGenfvEXT: TglGetMultiTexGenfvEXT; - glGetMultiTexGenivEXT: TglGetMultiTexGenivEXT; - glGetFloatIndexedvEXT: TglGetFloatIndexedvEXT; - glGetDoubleIndexedvEXT: TglGetDoubleIndexedvEXT; - glGetPointerIndexedvEXT: TglGetPointerIndexedvEXT; - glCompressedTextureImage3DEXT: TglCompressedTextureImage3DEXT; - glCompressedTextureImage2DEXT: TglCompressedTextureImage2DEXT; - glCompressedTextureImage1DEXT: TglCompressedTextureImage1DEXT; - glCompressedTextureSubImage3DEXT: TglCompressedTextureSubImage3DEXT; - glCompressedTextureSubImage2DEXT: TglCompressedTextureSubImage2DEXT; - glCompressedTextureSubImage1DEXT: TglCompressedTextureSubImage1DEXT; - glGetCompressedTextureImageEXT: TglGetCompressedTextureImageEXT; - glCompressedMultiTexImage3DEXT: TglCompressedMultiTexImage3DEXT; - glCompressedMultiTexImage2DEXT: TglCompressedMultiTexImage2DEXT; - glCompressedMultiTexImage1DEXT: TglCompressedMultiTexImage1DEXT; - glCompressedMultiTexSubImage3DEXT: TglCompressedMultiTexSubImage3DEXT; - glCompressedMultiTexSubImage2DEXT: TglCompressedMultiTexSubImage2DEXT; - glCompressedMultiTexSubImage1DEXT: TglCompressedMultiTexSubImage1DEXT; - glGetCompressedMultiTexImageEXT: TglGetCompressedMultiTexImageEXT; - glNamedProgramStringEXT: TglNamedProgramStringEXT; - glNamedProgramLocalParameter4dEXT: TglNamedProgramLocalParameter4dEXT; - glNamedProgramLocalParameter4dvEXT: TglNamedProgramLocalParameter4dvEXT; - glNamedProgramLocalParameter4fEXT: TglNamedProgramLocalParameter4fEXT; - glNamedProgramLocalParameter4fvEXT: TglNamedProgramLocalParameter4fvEXT; - glGetNamedProgramLocalParameterdvEXT: TglGetNamedProgramLocalParameterdvEXT; - glGetNamedProgramLocalParameterfvEXT: TglGetNamedProgramLocalParameterfvEXT; - glGetNamedProgramivEXT: TglGetNamedProgramivEXT; - glGetNamedProgramStringEXT: TglGetNamedProgramStringEXT; - glNamedProgramLocalParameters4fvEXT: TglNamedProgramLocalParameters4fvEXT; - glNamedProgramLocalParameterI4iEXT: TglNamedProgramLocalParameterI4iEXT; - glNamedProgramLocalParameterI4ivEXT: TglNamedProgramLocalParameterI4ivEXT; - glNamedProgramLocalParametersI4ivEXT: TglNamedProgramLocalParametersI4ivEXT; - glNamedProgramLocalParameterI4uiEXT: TglNamedProgramLocalParameterI4uiEXT; - glNamedProgramLocalParameterI4uivEXT: TglNamedProgramLocalParameterI4uivEXT; - glNamedProgramLocalParametersI4uivEXT: TglNamedProgramLocalParametersI4uivEXT; - glGetNamedProgramLocalParameterIivEXT: TglGetNamedProgramLocalParameterIivEXT; - glGetNamedProgramLocalParameterIuivEXT: TglGetNamedProgramLocalParameterIuivEXT; - glTextureParameterIivEXT: TglTextureParameterIivEXT; - glTextureParameterIuivEXT: TglTextureParameterIuivEXT; - glGetTextureParameterIivEXT: TglGetTextureParameterIivEXT; - glGetTextureParameterIuivEXT: TglGetTextureParameterIuivEXT; - glMultiTexParameterIivEXT: TglMultiTexParameterIivEXT; - glMultiTexParameterIuivEXT: TglMultiTexParameterIuivEXT; - glGetMultiTexParameterIivEXT: TglGetMultiTexParameterIivEXT; - glGetMultiTexParameterIuivEXT: TglGetMultiTexParameterIuivEXT; - glProgramUniform1fEXT: TglProgramUniform1fEXT; - glProgramUniform2fEXT: TglProgramUniform2fEXT; - glProgramUniform3fEXT: TglProgramUniform3fEXT; - glProgramUniform4fEXT: TglProgramUniform4fEXT; - glProgramUniform1iEXT: TglProgramUniform1iEXT; - glProgramUniform2iEXT: TglProgramUniform2iEXT; - glProgramUniform3iEXT: TglProgramUniform3iEXT; - glProgramUniform4iEXT: TglProgramUniform4iEXT; - glProgramUniform1fvEXT: TglProgramUniform1fvEXT; - glProgramUniform2fvEXT: TglProgramUniform2fvEXT; - glProgramUniform3fvEXT: TglProgramUniform3fvEXT; - glProgramUniform4fvEXT: TglProgramUniform4fvEXT; - glProgramUniform1ivEXT: TglProgramUniform1ivEXT; - glProgramUniform2ivEXT: TglProgramUniform2ivEXT; - glProgramUniform3ivEXT: TglProgramUniform3ivEXT; - glProgramUniform4ivEXT: TglProgramUniform4ivEXT; - glProgramUniformMatrix2fvEXT: TglProgramUniformMatrix2fvEXT; - glProgramUniformMatrix3fvEXT: TglProgramUniformMatrix3fvEXT; - glProgramUniformMatrix4fvEXT: TglProgramUniformMatrix4fvEXT; - glProgramUniformMatrix2x3fvEXT: TglProgramUniformMatrix2x3fvEXT; - glProgramUniformMatrix3x2fvEXT: TglProgramUniformMatrix3x2fvEXT; - glProgramUniformMatrix2x4fvEXT: TglProgramUniformMatrix2x4fvEXT; - glProgramUniformMatrix4x2fvEXT: TglProgramUniformMatrix4x2fvEXT; - glProgramUniformMatrix3x4fvEXT: TglProgramUniformMatrix3x4fvEXT; - glProgramUniformMatrix4x3fvEXT: TglProgramUniformMatrix4x3fvEXT; - glProgramUniform1uiEXT: TglProgramUniform1uiEXT; - glProgramUniform2uiEXT: TglProgramUniform2uiEXT; - glProgramUniform3uiEXT: TglProgramUniform3uiEXT; - glProgramUniform4uiEXT: TglProgramUniform4uiEXT; - glProgramUniform1uivEXT: TglProgramUniform1uivEXT; - glProgramUniform2uivEXT: TglProgramUniform2uivEXT; - glProgramUniform3uivEXT: TglProgramUniform3uivEXT; - glProgramUniform4uivEXT: TglProgramUniform4uivEXT; - glNamedBufferDataEXT: TglNamedBufferDataEXT; - glNamedBufferSubDataEXT: TglNamedBufferSubDataEXT; - glMapNamedBufferEXT: TglMapNamedBufferEXT; - glUnmapNamedBufferEXT: TglUnmapNamedBufferEXT; - glMapNamedBufferRangeEXT: TglMapNamedBufferRangeEXT; - glFlushMappedNamedBufferRangeEXT: TglFlushMappedNamedBufferRangeEXT; - glNamedCopyBufferSubDataEXT: TglNamedCopyBufferSubDataEXT; - glGetNamedBufferParameterivEXT: TglGetNamedBufferParameterivEXT; - glGetNamedBufferPointervEXT: TglGetNamedBufferPointervEXT; - glGetNamedBufferSubDataEXT: TglGetNamedBufferSubDataEXT; - glTextureBufferEXT: TglTextureBufferEXT; - glMultiTexBufferEXT: TglMultiTexBufferEXT; - glNamedRenderbufferStorageEXT: TglNamedRenderbufferStorageEXT; - glGetNamedRenderbufferParameterivEXT: TglGetNamedRenderbufferParameterivEXT; - glCheckNamedFramebufferStatusEXT: TglCheckNamedFramebufferStatusEXT; - glNamedFramebufferTexture1DEXT: TglNamedFramebufferTexture1DEXT; - glNamedFramebufferTexture2DEXT: TglNamedFramebufferTexture2DEXT; - glNamedFramebufferTexture3DEXT: TglNamedFramebufferTexture3DEXT; - glNamedFramebufferRenderbufferEXT: TglNamedFramebufferRenderbufferEXT; - glGetNamedFramebufferAttachmentParameterivEXT: TglGetNamedFramebufferAttachmentParameterivEXT; - glGenerateTextureMipmapEXT: TglGenerateTextureMipmapEXT; - glGenerateMultiTexMipmapEXT: TglGenerateMultiTexMipmapEXT; - glFramebufferDrawBufferEXT: TglFramebufferDrawBufferEXT; - glFramebufferDrawBuffersEXT: TglFramebufferDrawBuffersEXT; - glFramebufferReadBufferEXT: TglFramebufferReadBufferEXT; - glGetFramebufferParameterivEXT: TglGetFramebufferParameterivEXT; - glNamedRenderbufferStorageMultisampleEXT: TglNamedRenderbufferStorageMultisampleEXT; - glNamedRenderbufferStorageMultisampleCoverageEXT: TglNamedRenderbufferStorageMultisampleCoverageEXT; - glNamedFramebufferTextureEXT: TglNamedFramebufferTextureEXT; - glNamedFramebufferTextureLayerEXT: TglNamedFramebufferTextureLayerEXT; - glNamedFramebufferTextureFaceEXT: TglNamedFramebufferTextureFaceEXT; - glTextureRenderbufferEXT: TglTextureRenderbufferEXT; - glMultiTexRenderbufferEXT: TglMultiTexRenderbufferEXT; - glProgramUniform1dEXT: TglProgramUniform1dEXT; - glProgramUniform2dEXT: TglProgramUniform2dEXT; - glProgramUniform3dEXT: TglProgramUniform3dEXT; - glProgramUniform4dEXT: TglProgramUniform4dEXT; - glProgramUniform1dvEXT: TglProgramUniform1dvEXT; - glProgramUniform2dvEXT: TglProgramUniform2dvEXT; - glProgramUniform3dvEXT: TglProgramUniform3dvEXT; - glProgramUniform4dvEXT: TglProgramUniform4dvEXT; - glProgramUniformMatrix2dvEXT: TglProgramUniformMatrix2dvEXT; - glProgramUniformMatrix3dvEXT: TglProgramUniformMatrix3dvEXT; - glProgramUniformMatrix4dvEXT: TglProgramUniformMatrix4dvEXT; - glProgramUniformMatrix2x3dvEXT: TglProgramUniformMatrix2x3dvEXT; - glProgramUniformMatrix2x4dvEXT: TglProgramUniformMatrix2x4dvEXT; - glProgramUniformMatrix3x2dvEXT: TglProgramUniformMatrix3x2dvEXT; - glProgramUniformMatrix3x4dvEXT: TglProgramUniformMatrix3x4dvEXT; - glProgramUniformMatrix4x2dvEXT: TglProgramUniformMatrix4x2dvEXT; - glProgramUniformMatrix4x3dvEXT: TglProgramUniformMatrix4x3dvEXT; - - // GL_EXT_separate_shader_objects - glUseShaderProgramEXT: TglUseShaderProgramEXT; - glActiveProgramEXT: TglActiveProgramEXT; - glCreateShaderProgramEXT: TglCreateShaderProgramEXT; - - // GL_EXT_shader_image_load_store - glBindImageTextureEXT: TglBindImageTextureEXT; - glMemoryBarrierEXT: TglMemoryBarrierEXT; - - // GL_EXT_vertex_attrib_64bit - glVertexAttribL1dEXT: TglVertexAttribL1dEXT; - glVertexAttribL2dEXT: TglVertexAttribL2dEXT; - glVertexAttribL3dEXT: TglVertexAttribL3dEXT; - glVertexAttribL4dEXT: TglVertexAttribL4dEXT; - glVertexAttribL1dvEXT: TglVertexAttribL1dvEXT; - glVertexAttribL2dvEXT: TglVertexAttribL2dvEXT; - glVertexAttribL3dvEXT: TglVertexAttribL3dvEXT; - glVertexAttribL4dvEXT: TglVertexAttribL4dvEXT; - glVertexAttribLPointerEXT: TglVertexAttribLPointerEXT; - glGetVertexAttribLdvEXT: TglGetVertexAttribLdvEXT; - glVertexArrayVertexAttribLOffsetEXT: TglVertexArrayVertexAttribLOffsetEXT; - - // GL_HP_image_transform - glImageTransformParameteriHP: TglImageTransformParameteriHP; - glImageTransformParameterfHP: TglImageTransformParameterfHP; - glImageTransformParameterivHP: TglImageTransformParameterivHP; - glImageTransformParameterfvHP: TglImageTransformParameterfvHP; - glGetImageTransformParameterivHP: TglGetImageTransformParameterivHP; - glGetImageTransformParameterfvHP: TglGetImageTransformParameterfvHP; - - // GL_EXT_depth_bounds_test - glDepthBoundsEXT: TglDepthBoundsEXT; - - // GL_EXT_blend_equation_separate - glBlendEquationSeparateEXT: TglBlendEquationSeparateEXT; - - // GL_IBM_multimode_draw_arrays - glMultiModeDrawArraysIBM: TglMultiModeDrawArraysIBM; - glMultiModeDrawElementsIBM: TglMultiModeDrawElementsIBM; - - // GL_IBM_vertex_array_lists - glColorPointerListIBM: TglColorPointerListIBM; - glSecondaryColorPointerListIBM: TglSecondaryColorPointerListIBM; - glEdgeFlagPointerListIBM: TglEdgeFlagPointerListIBM; - glFogCoordPointerListIBM: TglFogCoordPointerListIBM; - glIndexPointerListIBM: TglIndexPointerListIBM; - glNormalPointerListIBM: TglNormalPointerListIBM; - glTexCoordPointerListIBM: TglTexCoordPointerListIBM; - glVertexPointerListIBM: TglVertexPointerListIBM; - - // GL_INGR_blend_func_separate - glBlendFuncSeparateINGR: TglBlendFuncSeparateINGR; - - // GL_INTEL_parallel_arrays - glVertexPointervINTEL: TglVertexPointervINTEL; - glNormalPointervINTEL: TglNormalPointervINTEL; - glColorPointervINTEL: TglColorPointervINTEL; - glTexCoordPointervINTEL: TglTexCoordPointervINTEL; - - // GL_MESA_resize_buffers - glResizeBuffersMESA: TglResizeBuffersMESA; - - // GL_MESA_window_pos - glWindowPos2dMESA: TglWindowPos2dMESA; - glWindowPos2dvMESA: TglWindowPos2dvMESA; - glWindowPos2fMESA: TglWindowPos2fMESA; - glWindowPos2fvMESA: TglWindowPos2fvMESA; - glWindowPos2iMESA: TglWindowPos2iMESA; - glWindowPos2ivMESA: TglWindowPos2ivMESA; - glWindowPos2sMESA: TglWindowPos2sMESA; - glWindowPos2svMESA: TglWindowPos2svMESA; - glWindowPos3dMESA: TglWindowPos3dMESA; - glWindowPos3dvMESA: TglWindowPos3dvMESA; - glWindowPos3fMESA: TglWindowPos3fMESA; - glWindowPos3fvMESA: TglWindowPos3fvMESA; - glWindowPos3iMESA: TglWindowPos3iMESA; - glWindowPos3ivMESA: TglWindowPos3ivMESA; - glWindowPos3sMESA: TglWindowPos3sMESA; - glWindowPos3svMESA: TglWindowPos3svMESA; - glWindowPos4dMESA: TglWindowPos4dMESA; - glWindowPos4dvMESA: TglWindowPos4dvMESA; - glWindowPos4fMESA: TglWindowPos4fMESA; - glWindowPos4fvMESA: TglWindowPos4fvMESA; - glWindowPos4iMESA: TglWindowPos4iMESA; - glWindowPos4ivMESA: TglWindowPos4ivMESA; - glWindowPos4sMESA: TglWindowPos4sMESA; - glWindowPos4svMESA: TglWindowPos4svMESA; - - // GL_NV_evaluators - glMapControlPointsNV: TglMapControlPointsNV; - glMapParameterivNV: TglMapParameterivNV; - glMapParameterfvNV: TglMapParameterfvNV; - glGetMapControlPointsNV: TglGetMapControlPointsNV; - glGetMapParameterivNV: TglGetMapParameterivNV; - glGetMapParameterfvNV: TglGetMapParameterfvNV; - glGetMapAttribParameterivNV: TglGetMapAttribParameterivNV; - glGetMapAttribParameterfvNV: TglGetMapAttribParameterfvNV; - glEvalMapsNV: TglEvalMapsNV; - - // GL_NV_fence - glDeleteFencesNV: TglDeleteFencesNV; - glGenFencesNV: TglGenFencesNV; - glIsFenceNV: TglIsFenceNV; - glTestFenceNV: TglTestFenceNV; - glGetFenceivNV: TglGetFenceivNV; - glFinishFenceNV: TglFinishFenceNV; - glSetFenceNV: TglSetFenceNV; - - // GL_NV_fragment_program - glProgramNamedParameter4fNV: TglProgramNamedParameter4fNV; - glProgramNamedParameter4dNV: TglProgramNamedParameter4dNV; - glProgramNamedParameter4fvNV: TglProgramNamedParameter4fvNV; - glProgramNamedParameter4dvNV: TglProgramNamedParameter4dvNV; - glGetProgramNamedParameterfvNV: TglGetProgramNamedParameterfvNV; - glGetProgramNamedParameterdvNV: TglGetProgramNamedParameterdvNV; - - // GL_NV_half_float - glVertex2hNV: TglVertex2hNV; - glVertex2hvNV: TglVertex2hvNV; - glVertex3hNV: TglVertex3hNV; - glVertex3hvNV: TglVertex3hvNV; - glVertex4hNV: TglVertex4hNV; - glVertex4hvNV: TglVertex4hvNV; - glNormal3hNV: TglNormal3hNV; - glNormal3hvNV: TglNormal3hvNV; - glColor3hNV: TglColor3hNV; - glColor3hvNV: TglColor3hvNV; - glColor4hNV: TglColor4hNV; - glColor4hvNV: TglColor4hvNV; - glTexCoord1hNV: TglTexCoord1hNV; - glTexCoord1hvNV: TglTexCoord1hvNV; - glTexCoord2hNV: TglTexCoord2hNV; - glTexCoord2hvNV: TglTexCoord2hvNV; - glTexCoord3hNV: TglTexCoord3hNV; - glTexCoord3hvNV: TglTexCoord3hvNV; - glTexCoord4hNV: TglTexCoord4hNV; - glTexCoord4hvNV: TglTexCoord4hvNV; - glMultiTexCoord1hNV: TglMultiTexCoord1hNV; - glMultiTexCoord1hvNV: TglMultiTexCoord1hvNV; - glMultiTexCoord2hNV: TglMultiTexCoord2hNV; - glMultiTexCoord2hvNV: TglMultiTexCoord2hvNV; - glMultiTexCoord3hNV: TglMultiTexCoord3hNV; - glMultiTexCoord3hvNV: TglMultiTexCoord3hvNV; - glMultiTexCoord4hNV: TglMultiTexCoord4hNV; - glMultiTexCoord4hvNV: TglMultiTexCoord4hvNV; - glFogCoordhNV: TglFogCoordhNV; - glFogCoordhvNV: TglFogCoordhvNV; - glSecondaryColor3hNV: TglSecondaryColor3hNV; - glSecondaryColor3hvNV: TglSecondaryColor3hvNV; - glVertexWeighthNV: TglVertexWeighthNV; - glVertexWeighthvNV: TglVertexWeighthvNV; - glVertexAttrib1hNV: TglVertexAttrib1hNV; - glVertexAttrib1hvNV: TglVertexAttrib1hvNV; - glVertexAttrib2hNV: TglVertexAttrib2hNV; - glVertexAttrib2hvNV: TglVertexAttrib2hvNV; - glVertexAttrib3hNV: TglVertexAttrib3hNV; - glVertexAttrib3hvNV: TglVertexAttrib3hvNV; - glVertexAttrib4hNV: TglVertexAttrib4hNV; - glVertexAttrib4hvNV: TglVertexAttrib4hvNV; - glVertexAttribs1hvNV: TglVertexAttribs1hvNV; - glVertexAttribs2hvNV: TglVertexAttribs2hvNV; - glVertexAttribs3hvNV: TglVertexAttribs3hvNV; - glVertexAttribs4hvNV: TglVertexAttribs4hvNV; - - // GL_NV_occlusion_query - glGenOcclusionQueriesNV: TglGenOcclusionQueriesNV; - glDeleteOcclusionQueriesNV: TglDeleteOcclusionQueriesNV; - glIsOcclusionQueryNV: TglIsOcclusionQueryNV; - glBeginOcclusionQueryNV: TglBeginOcclusionQueryNV; - glEndOcclusionQueryNV: TglEndOcclusionQueryNV; - glGetOcclusionQueryivNV: TglGetOcclusionQueryivNV; - glGetOcclusionQueryuivNV: TglGetOcclusionQueryuivNV; - - // GL_NV_pixel_data_range - glPixelDataRangeNV: TglPixelDataRangeNV; - glFlushPixelDataRangeNV: TglFlushPixelDataRangeNV; - - // GL_NV_point_sprite - glPointParameteriNV: TglPointParameteriNV; - glPointParameterivNV: TglPointParameterivNV; - - // GL_NV_primitive_restart - glPrimitiveRestartNV: TglPrimitiveRestartNV; - glPrimitiveRestartIndexNV: TglPrimitiveRestartIndexNV; - - // GL_NV_register_combiners - glCombinerParameterfvNV: TglCombinerParameterfvNV; - glCombinerParameterfNV: TglCombinerParameterfNV; - glCombinerParameterivNV: TglCombinerParameterivNV; - glCombinerParameteriNV: TglCombinerParameteriNV; - glCombinerInputNV: TglCombinerInputNV; - glCombinerOutputNV: TglCombinerOutputNV; - glFinalCombinerInputNV: TglFinalCombinerInputNV; - glGetCombinerInputParameterfvNV: TglGetCombinerInputParameterfvNV; - glGetCombinerInputParameterivNV: TglGetCombinerInputParameterivNV; - glGetCombinerOutputParameterfvNV: TglGetCombinerOutputParameterfvNV; - glGetCombinerOutputParameterivNV: TglGetCombinerOutputParameterivNV; - glGetFinalCombinerInputParameterfvNV: TglGetFinalCombinerInputParameterfvNV; - glGetFinalCombinerInputParameterivNV: TglGetFinalCombinerInputParameterivNV; - - // GL_NV_register_combiners2 - glCombinerStageParameterfvNV: TglCombinerStageParameterfvNV; - glGetCombinerStageParameterfvNV: TglGetCombinerStageParameterfvNV; - - // GL_NV_vertex_array_range - glFlushVertexArrayRangeNV: TglFlushVertexArrayRangeNV; - glVertexArrayRangeNV: TglVertexArrayRangeNV; - - // GL_NV_vertex_program - glAreProgramsResidentNV: TglAreProgramsResidentNV; - glBindProgramNV: TglBindProgramNV; - glDeleteProgramsNV: TglDeleteProgramsNV; - glExecuteProgramNV: TglExecuteProgramNV; - glGenProgramsNV: TglGenProgramsNV; - glGetProgramParameterdvNV: TglGetProgramParameterdvNV; - glGetProgramParameterfvNV: TglGetProgramParameterfvNV; - glGetProgramivNV: TglGetProgramivNV; - glGetProgramStringNV: TglGetProgramStringNV; - glGetTrackMatrixivNV: TglGetTrackMatrixivNV; - glGetVertexAttribdvNV: TglGetVertexAttribdvNV; - glGetVertexAttribfvNV: TglGetVertexAttribfvNV; - glGetVertexAttribivNV: TglGetVertexAttribivNV; - glGetVertexAttribPointervNV: TglGetVertexAttribPointervNV; - glIsProgramNV: TglIsProgramNV; - glLoadProgramNV: TglLoadProgramNV; - glProgramParameter4dNV: TglProgramParameter4dNV; - glProgramParameter4dvNV: TglProgramParameter4dvNV; - glProgramParameter4fNV: TglProgramParameter4fNV; - glProgramParameter4fvNV: TglProgramParameter4fvNV; - glProgramParameters4dvNV: TglProgramParameters4dvNV; - glProgramParameters4fvNV: TglProgramParameters4fvNV; - glRequestResidentProgramsNV: TglRequestResidentProgramsNV; - glTrackMatrixNV: TglTrackMatrixNV; - glVertexAttribPointerNV: TglVertexAttribPointerNV; - glVertexAttrib1dNV: TglVertexAttrib1dNV; - glVertexAttrib1dvNV: TglVertexAttrib1dvNV; - glVertexAttrib1fNV: TglVertexAttrib1fNV; - glVertexAttrib1fvNV: TglVertexAttrib1fvNV; - glVertexAttrib1sNV: TglVertexAttrib1sNV; - glVertexAttrib1svNV: TglVertexAttrib1svNV; - glVertexAttrib2dNV: TglVertexAttrib2dNV; - glVertexAttrib2dvNV: TglVertexAttrib2dvNV; - glVertexAttrib2fNV: TglVertexAttrib2fNV; - glVertexAttrib2fvNV: TglVertexAttrib2fvNV; - glVertexAttrib2sNV: TglVertexAttrib2sNV; - glVertexAttrib2svNV: TglVertexAttrib2svNV; - glVertexAttrib3dNV: TglVertexAttrib3dNV; - glVertexAttrib3dvNV: TglVertexAttrib3dvNV; - glVertexAttrib3fNV: TglVertexAttrib3fNV; - glVertexAttrib3fvNV: TglVertexAttrib3fvNV; - glVertexAttrib3sNV: TglVertexAttrib3sNV; - glVertexAttrib3svNV: TglVertexAttrib3svNV; - glVertexAttrib4dNV: TglVertexAttrib4dNV; - glVertexAttrib4dvNV: TglVertexAttrib4dvNV; - glVertexAttrib4fNV: TglVertexAttrib4fNV; - glVertexAttrib4fvNV: TglVertexAttrib4fvNV; - glVertexAttrib4sNV: TglVertexAttrib4sNV; - glVertexAttrib4svNV: TglVertexAttrib4svNV; - glVertexAttrib4ubNV: TglVertexAttrib4ubNV; - glVertexAttrib4ubvNV: TglVertexAttrib4ubvNV; - glVertexAttribs1dvNV: TglVertexAttribs1dvNV; - glVertexAttribs1fvNV: TglVertexAttribs1fvNV; - glVertexAttribs1svNV: TglVertexAttribs1svNV; - glVertexAttribs2dvNV: TglVertexAttribs2dvNV; - glVertexAttribs2fvNV: TglVertexAttribs2fvNV; - glVertexAttribs2svNV: TglVertexAttribs2svNV; - glVertexAttribs3dvNV: TglVertexAttribs3dvNV; - glVertexAttribs3fvNV: TglVertexAttribs3fvNV; - glVertexAttribs3svNV: TglVertexAttribs3svNV; - glVertexAttribs4dvNV: TglVertexAttribs4dvNV; - glVertexAttribs4fvNV: TglVertexAttribs4fvNV; - glVertexAttribs4svNV: TglVertexAttribs4svNV; - glVertexAttribs4ubvNV: TglVertexAttribs4ubvNV; - - // GL_NV_depth_buffer_float - glDepthRangedNV: TglDepthRangedNV; - glClearDepthdNV: TglClearDepthdNV; - glDepthBoundsdNV: TglDepthBoundsdNV; - - // GL_NV_framebuffer_multisample_coverage - glRenderbufferStorageMultsampleCoverageNV: TglRenderbufferStorageMultsampleCoverageNV; - - // GL_NV_geometry_program4 - glProgramVertexLimitNV: TglProgramVertexLimitNV; - - // GL_NV_gpu_program4 - glProgramLocalParameterI4iNV: TglProgramLocalParameterI4iNV; - glProgramLocalParameterI4ivNV: TglProgramLocalParameterI4ivNV; - glProgramLocalParametersI4ivNV: TglProgramLocalParametersI4ivNV; - glProgramLocalParameterI4uiNV: TglProgramLocalParameterI4uiNV; - glProgramLocalParameterI4uivNV: TglProgramLocalParameterI4uivNV; - glProgramLocalParametersI4uivNV: TglProgramLocalParametersI4uivNV; - glProgramEnvParameterI4iNV: TglProgramEnvParameterI4iNV; - glProgramEnvParameterI4ivNV: TglProgramEnvParameterI4ivNV; - glProgramEnvParametersI4ivNV: TglProgramEnvParametersI4ivNV; - glProgramEnvParameterI4uiNV: TglProgramEnvParameterI4uiNV; - glProgramEnvParameterI4uivNV: TglProgramEnvParameterI4uivNV; - glProgramEnvParametersI4uivNV: TglProgramEnvParametersI4uivNV; - glGetProgramLocalParameterIivNV: TglGetProgramLocalParameterIivNV; - glGetProgramLocalParameterIuivNV: TglGetProgramLocalParameterIuivNV; - glGetProgramEnvParameterIivNV: TglGetProgramEnvParameterIivNV; - glGetProgramEnvParameterIuivNV: TglGetProgramEnvParameterIuivNV; - - // GL_NV_parameter_buffer_object - glProgramBufferParametersfvNV: TglProgramBufferParametersfvNV; - glProgramBufferParametersIivNV: TglProgramBufferParametersIivNV; - glProgramBufferParametersIuivNV: TglProgramBufferParametersIuivNV; - - // GL_NV_transform_feedback - glBeginTransformFeedbackNV: TglBeginTransformFeedbackNV; - glEndTransformFeedbackNV: TglEndTransformFeedbackNV; - glTransformFeedbackAttribsNV: TglTransformFeedbackAttribsNV; - glBindBufferRangeNV: TglBindBufferRangeNV; - glBindBufferOffsetNV: TglBindBufferOffsetNV; - glBindBufferBaseNV: TglBindBufferBaseNV; - glTransformFeedbackVaryingsNV: TglTransformFeedbackVaryingsNV; - glActiveVaryingNV: TglActiveVaryingNV; - glGetVaryingLocationNV: TglGetVaryingLocationNV; - glGetActiveVaryingNV: TglGetActiveVaryingNV; - glGetTransformFeedbackVaryingNV: TglGetTransformFeedbackVaryingNV; - glTransformFeedbackStreamAttribsNV: TglTransformFeedbackStreamAttribsNV; - - // GL_NV_conditional_render - glBeginConditionalRenderNV: TglBeginConditionalRenderNV; - glEndConditionalRenderNV: TglEndConditionalRenderNV; - - // GL_NV_present_video - glPresentFrameKeyedNV: TglPresentFrameKeyedNV; - glPresentFrameDualFillNV: TglPresentFrameDualFillNV; - glGetVideoivNV: TglGetVideoivNV; - glGetVideouivNV: TglGetVideouivNV; - glGetVideoi64vNV: TglGetVideoi64vNV; - glGetVideoui64vNV: TglGetVideoui64vNV; -// glVideoParameterivNV: TglVideoParameterivNV; - - // GL_NV_explicit_multisample - glGetMultisamplefvNV: TglGetMultisamplefvNV; - glSampleMaskIndexedNV: TglSampleMaskIndexedNV; - glTexRenderbufferNV: TglTexRenderbufferNV; - - // GL_NV_transform_feedback2 - glBindTransformFeedbackNV: TglBindTransformFeedbackNV; - glDeleteTransformFeedbacksNV: TglDeleteTransformFeedbacksNV; - glGenTransformFeedbacksNV: TglGenTransformFeedbacksNV; - glIsTransformFeedbackNV: TglIsTransformFeedbackNV; - glPauseTransformFeedbackNV: TglPauseTransformFeedbackNV; - glResumeTransformFeedbackNV: TglResumeTransformFeedbackNV; - glDrawTransformFeedbackNV: TglDrawTransformFeedbackNV; - - // GL_NV_video_capture - glBeginVideoCaptureNV: TglBeginVideoCaptureNV; - glBindVideoCaptureStreamBufferNV: TglBindVideoCaptureStreamBufferNV; - glBindVideoCaptureStreamTextureNV: TglBindVideoCaptureStreamTextureNV; - glEndVideoCaptureNV: TglEndVideoCaptureNV; - glGetVideoCaptureivNV: TglGetVideoCaptureivNV; - glGetVideoCaptureStreamivNV: TglGetVideoCaptureStreamivNV; - glGetVideoCaptureStreamfvNV: TglGetVideoCaptureStreamfvNV; - glGetVideoCaptureStreamdvNV: TglGetVideoCaptureStreamdvNV; - glVideoCaptureNV: TglVideoCaptureNV; - glVideoCaptureStreamParameterivNV: TglVideoCaptureStreamParameterivNV; - glVideoCaptureStreamParameterfvNV: TglVideoCaptureStreamParameterfvNV; - glVideoCaptureStreamParameterdvNV: TglVideoCaptureStreamParameterdvNV; - - // GL_NV_copy_image - glCopyImageSubDataNV: TglCopyImageSubDataNV; - - // GL_NV_shader_buffer_load - glMakeBufferResidentNV: TglMakeBufferResidentNV; - glMakeBufferNonResidentNV: TglMakeBufferNonResidentNV; - glIsBufferResidentNV: TglIsBufferResidentNV; - glMakeNamedBufferResidentNV: TglMakeNamedBufferResidentNV; - glMakeNamedBufferNonResidentNV: TglMakeNamedBufferNonResidentNV; - glIsNamedBufferResidentNV: TglIsNamedBufferResidentNV; - glGetBufferParameterui64vNV: TglGetBufferParameterui64vNV; - glGetNamedBufferParameterui64vNV: TglGetNamedBufferParameterui64vNV; - glGetIntegerui64vNV: TglGetIntegerui64vNV; - glUniformui64NV: TglUniformui64NV; - glUniformui64vNV: TglUniformui64vNV; - glGetUniformui64vNV: TglGetUniformui64vNV; - glProgramUniformui64NV: TglProgramUniformui64NV; - glProgramUniformui64vNV: TglProgramUniformui64vNV; - - // GL_NV_vertex_buffer_unified_memory - glBufferAddressRangeNV: TglBufferAddressRangeNV; - glVertexFormatNV: TglVertexFormatNV; - glNormalFormatNV: TglNormalFormatNV; - glColorFormatNV: TglColorFormatNV; - glIndexFormatNV: TglIndexFormatNV; - glTexCoordFormatNV: TglTexCoordFormatNV; - glEdgeFlagFormatNV: TglEdgeFlagFormatNV; - glSecondaryColorFormatNV: TglSecondaryColorFormatNV; - glFogCoordFormatNV: TglFogCoordFormatNV; - glVertexAttribFormatNV: TglVertexAttribFormatNV; - glVertexAttribIFormatNV: TglVertexAttribIFormatNV; - glGetIntegerui64i_vNV: TglGetIntegerui64i_vNV; - - // GL_NV_gpu_program5 - glProgramSubroutineParametersuivNV: TglProgramSubroutineParametersuivNV; - glGetProgramSubroutineParameteruivNV: TglGetProgramSubroutineParameteruivNV; - - // GL_NV_gpu_shader5 - glUniform1i64NV: TglUniform1i64NV; - glUniform2i64NV: TglUniform2i64NV; - glUniform3i64NV: TglUniform3i64NV; - glUniform4i64NV: TglUniform4i64NV; - glUniform1i64vNV: TglUniform1i64vNV; - glUniform2i64vNV: TglUniform2i64vNV; - glUniform3i64vNV: TglUniform3i64vNV; - glUniform4i64vNV: TglUniform4i64vNV; - glUniform1ui64NV: TglUniform1ui64NV; - glUniform2ui64NV: TglUniform2ui64NV; - glUniform3ui64NV: TglUniform3ui64NV; - glUniform4ui64NV: TglUniform4ui64NV; - glUniform1ui64vNV: TglUniform1ui64vNV; - glUniform2ui64vNV: TglUniform2ui64vNV; - glUniform3ui64vNV: TglUniform3ui64vNV; - glUniform4ui64vNV: TglUniform4ui64vNV; - glGetUniformi64vNV: TglGetUniformi64vNV; - glProgramUniform1i64NV: TglProgramUniform1i64NV; - glProgramUniform2i64NV: TglProgramUniform2i64NV; - glProgramUniform3i64NV: TglProgramUniform3i64NV; - glProgramUniform4i64NV: TglProgramUniform4i64NV; - glProgramUniform1i64vNV: TglProgramUniform1i64vNV; - glProgramUniform2i64vNV: TglProgramUniform2i64vNV; - glProgramUniform3i64vNV: TglProgramUniform3i64vNV; - glProgramUniform4i64vNV: TglProgramUniform4i64vNV; - glProgramUniform1ui64NV: TglProgramUniform1ui64NV; - glProgramUniform2ui64NV: TglProgramUniform2ui64NV; - glProgramUniform3ui64NV: TglProgramUniform3ui64NV; - glProgramUniform4ui64NV: TglProgramUniform4ui64NV; - glProgramUniform1ui64vNV: TglProgramUniform1ui64vNV; - glProgramUniform2ui64vNV: TglProgramUniform2ui64vNV; - glProgramUniform3ui64vNV: TglProgramUniform3ui64vNV; - glProgramUniform4ui64vNV: TglProgramUniform4ui64vNV; - - // GL_NV_vertex_attrib_integer_64bit - glVertexAttribL1i64NV: TglVertexAttribL1i64NV; - glVertexAttribL2i64NV: TglVertexAttribL2i64NV; - glVertexAttribL3i64NV: TglVertexAttribL3i64NV; - glVertexAttribL4i64NV: TglVertexAttribL4i64NV; - glVertexAttribL1i64vNV: TglVertexAttribL1i64vNV; - glVertexAttribL2i64vNV: TglVertexAttribL2i64vNV; - glVertexAttribL3i64vNV: TglVertexAttribL3i64vNV; - glVertexAttribL4i64vNV: TglVertexAttribL4i64vNV; - glVertexAttribL1ui64NV: TglVertexAttribL1ui64NV; - glVertexAttribL2ui64NV: TglVertexAttribL2ui64NV; - glVertexAttribL3ui64NV: TglVertexAttribL3ui64NV; - glVertexAttribL4ui64NV: TglVertexAttribL4ui64NV; - glVertexAttribL1ui64vNV: TglVertexAttribL1ui64vNV; - glVertexAttribL2ui64vNV: TglVertexAttribL2ui64vNV; - glVertexAttribL3ui64vNV: TglVertexAttribL3ui64vNV; - glVertexAttribL4ui64vNV: TglVertexAttribL4ui64vNV; - glGetVertexAttribLi64vNV: TglGetVertexAttribLi64vNV; - glGetVertexAttribLui64vNV: TglGetVertexAttribLui64vNV; - glVertexAttribLFormatNV: TglVertexAttribLFormatNV; - - // GL_NV_vdpau_interop - glVDPAUInitNV: TglVDPAUInitNV; - glVDPAUFiniNV: TglVDPAUFiniNV; - glVDPAURegisterVideoSurfaceNV: TglVDPAURegisterVideoSurfaceNV; - glVDPAURegisterOutputSurfaceNV: TglVDPAURegisterOutputSurfaceNV; - glVDPAUIsSurfaceNV: TglVDPAUIsSurfaceNV; - glVDPAUUnregisterSurfaceNV: TglVDPAUUnregisterSurfaceNV; - glVDPAUGetSurfaceivNV: TglVDPAUGetSurfaceivNV; - glVDPAUSurfaceAccessNV: TglVDPAUSurfaceAccessNV; - glVDPAUMapSurfacesNV: TglVDPAUMapSurfacesNV; - glVDPAUUnmapSurfacesNV: TglVDPAUUnmapSurfacesNV; - - // GL_NV_texture_barrier - glTextureBarrierNV: TglTextureBarrierNV; - - // (4.3) GL_NV_path_rendering - glGenPathsNV : TglGenPathsNV; - glDeletePathsNV : TglDeletePathsNV; - glIsPathNV : TglIsPathNV; - glPathCommandsNV : TglPathCommandsNV; - glPathCoordsNV : TglPathCoordsNV; - glPathSubCommandsNV : TglPathSubCommandsNV; - glPathSubCoordsNV : TglPathSubCoordsNV; - glPathStringNV : TglPathStringNV; - glPathGlyphsNV : TglPathGlyphsNV; - glPathGlyphRangeNV : TglPathGlyphRangeNV; - glWeightPathsNV : TglWeightPathsNV; - glCopyPathNV : TglCopyPathNV; - glInterpolatePathsNV : TglInterpolatePathsNV; - glTransformPathNV : TglTransformPathNV; - glPathParameterivNV : TglPathParameterivNV; - glPathParameteriNV : TglPathParameteriNV; - glPathParameterfvNV : TglPathParameterfvNV; - glPathParameterfNV : TglPathParameterfNV; - glPathDashArrayNV : TglPathDashArrayNV; - glPathStencilFuncNV : TglPathStencilFuncNV; - glPathStencilDepthOffsetNV : TglPathStencilDepthOffsetNV; - glStencilFillPathNV : TglStencilFillPathNV; - glStencilStrokePathNV : TglStencilStrokePathNV; - glStencilFillPathInstancedNV : TglStencilFillPathInstancedNV; - glStencilStrokePathInstancedNV : TglStencilStrokePathInstancedNV; - glPathCoverDepthFuncNV : TglPathCoverDepthFuncNV; - glPathColorGenNV : TglPathColorGenNV; - glPathTexGenNV : TglPathTexGenNV; - glPathFogGenNV : TglPathFogGenNV; - glCoverFillPathNV : TglCoverFillPathNV; - glCoverStrokePathNV : TglCoverStrokePathNV; - glCoverFillPathInstancedNV : TglCoverFillPathInstancedNV; - glCoverStrokePathInstancedNV : TglCoverStrokePathInstancedNV; - glGetPathParameterivNV : TglGetPathParameterivNV; - glGetPathParameterfvNV : TglGetPathParameterfvNV; - glGetPathCommandsNV : TglGetPathCommandsNV; - glGetPathCoordsNV : TglGetPathCoordsNV; - glGetPathDashArrayNV : TglGetPathDashArrayNV; - glGetPathMetricsNV : TglGetPathMetricsNV; - glGetPathMetricRangeNV : TglGetPathMetricRangeNV; - glGetPathSpacingNV : TglGetPathSpacingNV; - glGetPathColorGenivNV : TglGetPathColorGenivNV; - glGetPathColorGenfvNV : TglGetPathColorGenfvNV; - glGetPathTexGenivNV : TglGetPathTexGenivNV; - glGetPathTexGenfvNV : TglGetPathTexGenfvNV; - glIsPointInFillPathNV : TglIsPointInFillPathNV; - glIsPointInStrokePathNV : TglIsPointInStrokePathNV; - glGetPathLengthNV : TglGetPathLengthNV; - glPointAlongPathNV : TglPointAlongPathNV; - - // GL_AMD_pinned_memory - - // GL_AMD_stencil_operation_extended - glStencilOpValueAMD : TglStencilOpValueAMD; - - // GL_AMD_vertex_shader_viewport_index - - // GL_AMD_vertex_shader_layer - - // GL_NV_bindless_texture - glGetTextureHandleNV : TglGetTextureHandleNV; - glGetTextureSamplerHandleNV : TglGetTextureSamplerHandleNV; - glMakeTextureHandleResidentNV : TglMakeTextureHandleResidentNV; - glMakeTextureHandleNonResidentNV : TglMakeTextureHandleNonResidentNV; - glGetImageHandleNV : TglGetImageHandleNV; - glMakeImageHandleResidentNV : TglMakeImageHandleResidentNV; - glMakeImageHandleNonResidentNV : TglMakeImageHandleNonResidentNV; - glUniformHandleui64NV : TglUniformHandleui64NV; - glUniformHandleui64vNV : TglUniformHandleui64vNV; - glProgramUniformHandleui64NV : TglProgramUniformHandleui64NV; - glProgramUniformHandleui64vNV : TglProgramUniformHandleui64vNV; - glIsTextureHandleResidentNV : TglIsTextureHandleResidentNV; - glIsImageHandleResidentNV : TglIsImageHandleResidentNV; - - // - - // GL_PGI_misc_hints - glHintPGI: TglHintPGI; - - // GL_SGIS_detail_texture - glDetailTexFuncSGIS: TglDetailTexFuncSGIS; - glGetDetailTexFuncSGIS: TglGetDetailTexFuncSGIS; - - // GL_SGIS_fog_function - glFogFuncSGIS: TglFogFuncSGIS; - glGetFogFuncSGIS: TglGetFogFuncSGIS; - - // GL_SGIS_multisample - glSampleMaskSGIS: TglSampleMaskSGIS; - glSamplePatternSGIS: TglSamplePatternSGIS; - - // GL_SGIS_pixel_texture - glPixelTexGenParameteriSGIS: TglPixelTexGenParameteriSGIS; - glPixelTexGenParameterivSGIS: TglPixelTexGenParameterivSGIS; - glPixelTexGenParameterfSGIS: TglPixelTexGenParameterfSGIS; - glPixelTexGenParameterfvSGIS: TglPixelTexGenParameterfvSGIS; - glGetPixelTexGenParameterivSGIS: TglGetPixelTexGenParameterivSGIS; - glGetPixelTexGenParameterfvSGIS: TglGetPixelTexGenParameterfvSGIS; - - // GL_SGIS_point_parameters - glPointParameterfSGIS: TglPointParameterfSGIS; - glPointParameterfvSGIS: TglPointParameterfvSGIS; - - // GL_SGIS_sharpen_texture - glSharpenTexFuncSGIS: TglSharpenTexFuncSGIS; - glGetSharpenTexFuncSGIS: TglGetSharpenTexFuncSGIS; - - // GL_SGIS_texture4D - glTexImage4DSGIS: TglTexImage4DSGIS; - glTexSubImage4DSGIS: TglTexSubImage4DSGIS; - - // GL_SGIS_texture_color_mask - glTextureColorMaskSGIS: TglTextureColorMaskSGIS; - - // GL_SGIS_texture_filter4 - glGetTexFilterFuncSGIS: TglGetTexFilterFuncSGIS; - glTexFilterFuncSGIS: TglTexFilterFuncSGIS; - - // GL_SGIX_async - glAsyncMarkerSGIX: TglAsyncMarkerSGIX; - glFinishAsyncSGIX: TglFinishAsyncSGIX; - glPollAsyncSGIX: TglPollAsyncSGIX; - glGenAsyncMarkersSGIX: TglGenAsyncMarkersSGIX; - glDeleteAsyncMarkersSGIX: TglDeleteAsyncMarkersSGIX; - glIsAsyncMarkerSGIX: TglIsAsyncMarkerSGIX; - - // GL_SGIX_flush_raster - glFlushRasterSGIX: TglFlushRasterSGIX; - - // GL_SGIX_fragment_lighting - glFragmentColorMaterialSGIX: TglFragmentColorMaterialSGIX; - glFragmentLightfSGIX: TglFragmentLightfSGIX; - glFragmentLightfvSGIX: TglFragmentLightfvSGIX; - glFragmentLightiSGIX: TglFragmentLightiSGIX; - glFragmentLightivSGIX: TglFragmentLightivSGIX; - glFragmentLightModelfSGIX: TglFragmentLightModelfSGIX; - glFragmentLightModelfvSGIX: TglFragmentLightModelfvSGIX; - glFragmentLightModeliSGIX: TglFragmentLightModeliSGIX; - glFragmentLightModelivSGIX: TglFragmentLightModelivSGIX; - glFragmentMaterialfSGIX: TglFragmentMaterialfSGIX; - glFragmentMaterialfvSGIX: TglFragmentMaterialfvSGIX; - glFragmentMaterialiSGIX: TglFragmentMaterialiSGIX; - glFragmentMaterialivSGIX: TglFragmentMaterialivSGIX; - glGetFragmentLightfvSGIX: TglGetFragmentLightfvSGIX; - glGetFragmentLightivSGIX: TglGetFragmentLightivSGIX; - glGetFragmentMaterialfvSGIX: TglGetFragmentMaterialfvSGIX; - glGetFragmentMaterialivSGIX: TglGetFragmentMaterialivSGIX; - glLightEnviSGIX: TglLightEnviSGIX; - - // GL_SGIX_framezoom - glFrameZoomSGIX: TglFrameZoomSGIX; - - // GL_SGIX_igloo_interface - glIglooInterfaceSGIX: TglIglooInterfaceSGIX; - - // GL_SGIX_instruments - glGetInstrumentsSGIX: TglGetInstrumentsSGIX; - glInstrumentsBufferSGIX: TglInstrumentsBufferSGIX; - glPollInstrumentsSGIX: TglPollInstrumentsSGIX; - glReadInstrumentsSGIX: TglReadInstrumentsSGIX; - glStartInstrumentsSGIX: TglStartInstrumentsSGIX; - glStopInstrumentsSGIX: TglStopInstrumentsSGIX; - - // GL_SGIX_list_priority - glGetListParameterfvSGIX: TglGetListParameterfvSGIX; - glGetListParameterivSGIX: TglGetListParameterivSGIX; - glListParameterfSGIX: TglListParameterfSGIX; - glListParameterfvSGIX: TglListParameterfvSGIX; - glListParameteriSGIX: TglListParameteriSGIX; - glListParameterivSGIX: TglListParameterivSGIX; - - // GL_SGIX_pixel_texture - glPixelTexGenSGIX: TglPixelTexGenSGIX; - - // GL_SGIX_polynomial_ffd - glDeformationMap3dSGIX: TglDeformationMap3dSGIX; - glDeformationMap3fSGIX: TglDeformationMap3fSGIX; - glDeformSGIX: TglDeformSGIX; - glLoadIdentityDeformationMapSGIX: TglLoadIdentityDeformationMapSGIX; - - // GL_SGIX_reference_plane - glReferencePlaneSGIX: TglReferencePlaneSGIX; - - // GL_SGIX_sprite - glSpriteParameterfSGIX: TglSpriteParameterfSGIX; - glSpriteParameterfvSGIX: TglSpriteParameterfvSGIX; - glSpriteParameteriSGIX: TglSpriteParameteriSGIX; - glSpriteParameterivSGIX: TglSpriteParameterivSGIX; - - // GL_SGIX_tag_sample_buffer - glTagSampleBufferSGIX: TglTagSampleBufferSGIX; - - // GL_SGI_color_table - glColorTableSGI: TglColorTableSGI; - glColorTableParameterfvSGI: TglColorTableParameterfvSGI; - glColorTableParameterivSGI: TglColorTableParameterivSGI; - glCopyColorTableSGI: TglCopyColorTableSGI; - glGetColorTableSGI: TglGetColorTableSGI; - glGetColorTableParameterfvSGI: TglGetColorTableParameterfvSGI; - glGetColorTableParameterivSGI: TglGetColorTableParameterivSGI; - - // GL_SUNX_constant_data - glFinishTextureSUNX: TglFinishTextureSUNX; - - // GL_SUN_global_alpha - glGlobalAlphaFactorbSUN: TglGlobalAlphaFactorbSUN; - glGlobalAlphaFactorsSUN: TglGlobalAlphaFactorsSUN; - glGlobalAlphaFactoriSUN: TglGlobalAlphaFactoriSUN; - glGlobalAlphaFactorfSUN: TglGlobalAlphaFactorfSUN; - glGlobalAlphaFactordSUN: TglGlobalAlphaFactordSUN; - glGlobalAlphaFactorubSUN: TglGlobalAlphaFactorubSUN; - glGlobalAlphaFactorusSUN: TglGlobalAlphaFactorusSUN; - glGlobalAlphaFactoruiSUN: TglGlobalAlphaFactoruiSUN; - - // GL_SUN_mesh_array - glDrawMeshArraysSUN: TglDrawMeshArraysSUN; - - // GL_SUN_triangle_list - glReplacementCodeuiSUN: TglReplacementCodeuiSUN; - glReplacementCodeusSUN: TglReplacementCodeusSUN; - glReplacementCodeubSUN: TglReplacementCodeubSUN; - glReplacementCodeuivSUN: TglReplacementCodeuivSUN; - glReplacementCodeusvSUN: TglReplacementCodeusvSUN; - glReplacementCodeubvSUN: TglReplacementCodeubvSUN; - glReplacementCodePointerSUN: TglReplacementCodePointerSUN; - - // GL_SUN_vertex - glColor4ubVertex2fSUN: TglColor4ubVertex2fSUN; - glColor4ubVertex2fvSUN: TglColor4ubVertex2fvSUN; - glColor4ubVertex3fSUN: TglColor4ubVertex3fSUN; - glColor4ubVertex3fvSUN: TglColor4ubVertex3fvSUN; - glColor3fVertex3fSUN: TglColor3fVertex3fSUN; - glColor3fVertex3fvSUN: TglColor3fVertex3fvSUN; - glNormal3fVertex3fSUN: TglNormal3fVertex3fSUN; - glNormal3fVertex3fvSUN: TglNormal3fVertex3fvSUN; - glColor4fNormal3fVertex3fSUN: TglColor4fNormal3fVertex3fSUN; - glColor4fNormal3fVertex3fvSUN: TglColor4fNormal3fVertex3fvSUN; - glTexCoord2fVertex3fSUN: TglTexCoord2fVertex3fSUN; - glTexCoord2fVertex3fvSUN: TglTexCoord2fVertex3fvSUN; - glTexCoord4fVertex4fSUN: TglTexCoord4fVertex4fSUN; - glTexCoord4fVertex4fvSUN: TglTexCoord4fVertex4fvSUN; - glTexCoord2fColor4ubVertex3fSUN: TglTexCoord2fColor4ubVertex3fSUN; - glTexCoord2fColor4ubVertex3fvSUN: TglTexCoord2fColor4ubVertex3fvSUN; - glTexCoord2fColor3fVertex3fSUN: TglTexCoord2fColor3fVertex3fSUN; - glTexCoord2fColor3fVertex3fvSUN: TglTexCoord2fColor3fVertex3fvSUN; - glTexCoord2fNormal3fVertex3fSUN: TglTexCoord2fNormal3fVertex3fSUN; - glTexCoord2fNormal3fVertex3fvSUN: TglTexCoord2fNormal3fVertex3fvSUN; - glTexCoord2fColor4fNormal3fVertex3fSUN: TglTexCoord2fColor4fNormal3fVertex3fSUN; - glTexCoord2fColor4fNormal3fVertex3fvSUN: TglTexCoord2fColor4fNormal3fVertex3fvSUN; - glTexCoord4fColor4fNormal3fVertex4fSUN: TglTexCoord4fColor4fNormal3fVertex4fSUN; - glTexCoord4fColor4fNormal3fVertex4fvSUN: TglTexCoord4fColor4fNormal3fVertex4fvSUN; - glReplacementCodeuiVertex3fSUN: TglReplacementCodeuiVertex3fSUN; - glReplacementCodeuiVertex3fvSUN: TglReplacementCodeuiVertex3fvSUN; - glReplacementCodeuiColor4ubVertex3fSUN: TglReplacementCodeuiColor4ubVertex3fSUN; - glReplacementCodeuiColor4ubVertex3fvSUN: TglReplacementCodeuiColor4ubVertex3fvSUN; - glReplacementCodeuiColor3fVertex3fSUN: TglReplacementCodeuiColor3fVertex3fSUN; - glReplacementCodeuiColor3fVertex3fvSUN: TglReplacementCodeuiColor3fVertex3fvSUN; - glReplacementCodeuiNormal3fVertex3fSUN: TglReplacementCodeuiNormal3fVertex3fSUN; - glReplacementCodeuiNormal3fVertex3fvSUN: TglReplacementCodeuiNormal3fVertex3fvSUN; - glReplacementCodeuiColor4fNormal3fVertex3fSUN: TglReplacementCodeuiColor4fNormal3fVertex3fSUN; - glReplacementCodeuiColor4fNormal3fVertex3fvSUN: TglReplacementCodeuiColor4fNormal3fVertex3fvSUN; - glReplacementCodeuiTexCoord2fVertex3fSUN: TglReplacementCodeuiTexCoord2fVertex3fSUN; - glReplacementCodeuiTexCoord2fVertex3fvSUN: TglReplacementCodeuiTexCoord2fVertex3fvSUN; - glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN: TglReplacementCodeuiTexCoord2fNormal3fVertex3fSUN; - glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN: TglReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN; - glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN: TglReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN; - glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN: TglReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN; - -{$IFDEF DGL_WIN} - wglGetProcAddress: TwglGetProcAddress; - wglCopyContext: TwglCopyContext; - wglCreateContext: TwglCreateContext; - wglCreateLayerContext: TwglCreateLayerContext; - wglDeleteContext: TwglDeleteContext; - wglDescribeLayerPlane: TwglDescribeLayerPlane; - wglGetCurrentContext: TwglGetCurrentContext; - wglGetCurrentDC: TwglGetCurrentDC; - wglGetLayerPaletteEntries: TwglGetLayerPaletteEntries; - wglMakeCurrent: TwglMakeCurrent; - wglRealizeLayerPalette: TwglRealizeLayerPalette; - wglSetLayerPaletteEntries: TwglSetLayerPaletteEntries; - wglShareLists: TwglShareLists; - wglSwapLayerBuffers: TwglSwapLayerBuffers; - wglSwapMultipleBuffers: TwglSwapMultipleBuffers; - wglUseFontBitmapsA: TwglUseFontBitmapsA; - wglUseFontOutlinesA: TwglUseFontOutlinesA; - wglUseFontBitmapsW: TwglUseFontBitmapsW; - wglUseFontOutlinesW: TwglUseFontOutlinesW; - wglUseFontBitmaps: TwglUseFontBitmaps; - wglUseFontOutlines: TwglUseFontOutlines; - - // WGL_ARB_buffer_region - wglCreateBufferRegionARB: TwglCreateBufferRegionARB; - wglDeleteBufferRegionARB: TwglDeleteBufferRegionARB; - wglSaveBufferRegionARB: TwglSaveBufferRegionARB; - wglRestoreBufferRegionARB: TwglRestoreBufferRegionARB; - - // WGL_ARB_extensions_string - wglGetExtensionsStringARB: TwglGetExtensionsStringARB; - - // WGL_ARB_make_current_read - wglMakeContextCurrentARB: TwglMakeContextCurrentARB; - wglGetCurrentReadDCARB: TwglGetCurrentReadDCARB; - - // WGL_ARB_pbuffer - wglCreatePbufferARB: TwglCreatePbufferARB; - wglGetPbufferDCARB: TwglGetPbufferDCARB; - wglReleasePbufferDCARB: TwglReleasePbufferDCARB; - wglDestroyPbufferARB: TwglDestroyPbufferARB; - wglQueryPbufferARB: TwglQueryPbufferARB; - - // WGL_ARB_pixel_format - wglGetPixelFormatAttribivARB: TwglGetPixelFormatAttribivARB; - wglGetPixelFormatAttribfvARB: TwglGetPixelFormatAttribfvARB; - wglChoosePixelFormatARB: TwglChoosePixelFormatARB; - // WGL_ARB_color_buffer_float - wglClampColorARB: TwglClampColorARB; - - // WGL_ARB_render_texture - wglBindTexImageARB: TwglBindTexImageARB; - wglReleaseTexImageARB: TwglReleaseTexImageARB; - wglSetPbufferAttribARB: TwglSetPbufferAttribARB; - - // WGL_ARB_create_context - wglCreateContextAttribsARB: TwglCreateContextAttribsARB; - - // WGL_AMD_gpu_association - wglGetGPUIDsAMD: TwglGetGPUIDsAMD; - wglGetGPUInfoAMD: TwglGetGPUInfoAMD; - wglGetContextGPUIDAMD: TwglGetContextGPUIDAMD; - wglCreateAssociatedContextAMD: TwglCreateAssociatedContextAMD; - wglCreateAssociatedContextAttribsAMD: TwglCreateAssociatedContextAttribsAMD; - wglDeleteAssociatedContextAMD: TwglDeleteAssociatedContextAMD; - wglMakeAssociatedContextCurrentAMD: TwglMakeAssociatedContextCurrentAMD; - wglGetCurrentAssociatedContextAMD: TwglGetCurrentAssociatedContextAMD; - wglBlitContextFramebufferAMD: TwglBlitContextFramebufferAMD; - - // WGL_EXT_display_color_table - wglCreateDisplayColorTableEXT: TwglCreateDisplayColorTableEXT; - wglLoadDisplayColorTableEXT: TwglLoadDisplayColorTableEXT; - wglBindDisplayColorTableEXT: TwglBindDisplayColorTableEXT; - wglDestroyDisplayColorTableEXT: TwglDestroyDisplayColorTableEXT; - - // WGL_EXT_extensions_string - wglGetExtensionsStringEXT: TwglGetExtensionsStringEXT; - - // WGL_EXT_make_current_read - wglMakeContextCurrentEXT: TwglMakeContextCurrentEXT; - wglGetCurrentReadDCEXT: TwglGetCurrentReadDCEXT; - - // WGL_EXT_pbuffer - wglCreatePbufferEXT: TwglCreatePbufferEXT; - wglGetPbufferDCEXT: TwglGetPbufferDCEXT; - wglReleasePbufferDCEXT: TwglReleasePbufferDCEXT; - wglDestroyPbufferEXT: TwglDestroyPbufferEXT; - wglQueryPbufferEXT: TwglQueryPbufferEXT; - - // WGL_EXT_pixel_format - wglGetPixelFormatAttribivEXT: TwglGetPixelFormatAttribivEXT; - wglGetPixelFormatAttribfvEXT: TwglGetPixelFormatAttribfvEXT; - wglChoosePixelFormatEXT: TwglChoosePixelFormatEXT; - - // WGL_EXT_swap_control - wglSwapIntervalEXT: TwglSwapIntervalEXT; - wglGetSwapIntervalEXT: TwglGetSwapIntervalEXT; - - // WGL_I3D_digital_video_control - wglGetDigitalVideoParametersI3D: TwglGetDigitalVideoParametersI3D; - wglSetDigitalVideoParametersI3D: TwglSetDigitalVideoParametersI3D; - - // WGL_I3D_gamma - wglGetGammaTableParametersI3D: TwglGetGammaTableParametersI3D; - wglSetGammaTableParametersI3D: TwglSetGammaTableParametersI3D; - wglGetGammaTableI3D: TwglGetGammaTableI3D; - wglSetGammaTableI3D: TwglSetGammaTableI3D; - - // WGL_I3D_genlock - wglEnableGenlockI3D: TwglEnableGenlockI3D; - wglDisableGenlockI3D: TwglDisableGenlockI3D; - wglIsEnabledGenlockI3D: TwglIsEnabledGenlockI3D; - wglGenlockSourceI3D: TwglGenlockSourceI3D; - wglGetGenlockSourceI3D: TwglGetGenlockSourceI3D; - wglGenlockSourceEdgeI3D: TwglGenlockSourceEdgeI3D; - wglGetGenlockSourceEdgeI3D: TwglGetGenlockSourceEdgeI3D; - wglGenlockSampleRateI3D: TwglGenlockSampleRateI3D; - wglGetGenlockSampleRateI3D: TwglGetGenlockSampleRateI3D; - wglGenlockSourceDelayI3D: TwglGenlockSourceDelayI3D; - wglGetGenlockSourceDelayI3D: TwglGetGenlockSourceDelayI3D; - wglQueryGenlockMaxSourceDelayI3D: TwglQueryGenlockMaxSourceDelayI3D; - - // WGL_I3D_image_buffer - wglCreateImageBufferI3D: TwglCreateImageBufferI3D; - wglDestroyImageBufferI3D: TwglDestroyImageBufferI3D; - wglAssociateImageBufferEventsI3D: TwglAssociateImageBufferEventsI3D; - wglReleaseImageBufferEventsI3D: TwglReleaseImageBufferEventsI3D; - - // WGL_I3D_swap_frame_lock - wglEnableFrameLockI3D: TwglEnableFrameLockI3D; - wglDisableFrameLockI3D: TwglDisableFrameLockI3D; - wglIsEnabledFrameLockI3D: TwglIsEnabledFrameLockI3D; - wglQueryFrameLockMasterI3D: TwglQueryFrameLockMasterI3D; - - // WGL_I3D_swap_frame_usage - wglGetFrameUsageI3D: TwglGetFrameUsageI3D; - wglBeginFrameTrackingI3D: TwglBeginFrameTrackingI3D; - wglEndFrameTrackingI3D: TwglEndFrameTrackingI3D; - wglQueryFrameTrackingI3D: TwglQueryFrameTrackingI3D; - - // WGL_NV_vertex_array_range - wglAllocateMemoryNV: TwglAllocateMemoryNV; - wglFreeMemoryNV: TwglFreeMemoryNV; - - // WGL_NV_present_video - wglEnumerateVideoDevicesNV: TwglEnumerateVideoDevicesNV; - wglBindVideoDeviceNV: TwglBindVideoDeviceNV; - wglQueryCurrentContextNV: TwglQueryCurrentContextNV; - - // WGL_NV_video_output - wglGetVideoDeviceNV: TwglGetVideoDeviceNV; - wglReleaseVideoDeviceNV: TwglReleaseVideoDeviceNV; - wglBindVideoImageNV: TwglBindVideoImageNV; - wglReleaseVideoImageNV: TwglReleaseVideoImageNV; - wglSendPbufferToVideoNV: TwglSendPbufferToVideoNV; - wglGetVideoInfoNV: TwglGetVideoInfoNV; - - // WGL_NV_swap_group - wglJoinSwapGroupNV: TwglJoinSwapGroupNV; - wglBindSwapBarrierNV: TwglBindSwapBarrierNV; - wglQuerySwapGroupNV: TwglQuerySwapGroupNV; - wglQueryMaxSwapGroupsNV: TwglQueryMaxSwapGroupsNV; - wglQueryFrameCountNV: TwglQueryFrameCountNV; - wglResetFrameCountNV: TwglResetFrameCountNV; - - // WGL_NV_gpu_affinity - wglEnumGpusNV: TwglEnumGpusNV; - wglEnumGpuDevicesNV: TwglEnumGpuDevicesNV; - wglCreateAffinityDCNV: TwglCreateAffinityDCNV; - wglEnumGpusFromAffinityDCNV: TwglEnumGpusFromAffinityDCNV; - wglDeleteDCNV: TwglDeleteDCNV; - - // WGL_NV_video_capture - wglBindVideoCaptureDeviceNV: TwglBindVideoCaptureDeviceNV; - wglEnumerateVideoCaptureDevicesNV: TwglEnumerateVideoCaptureDevicesNV; - wglLockVideoCaptureDeviceNV: TwglLockVideoCaptureDeviceNV; - wglQueryVideoCaptureDeviceNV: TwglQueryVideoCaptureDeviceNV; - wglReleaseVideoCaptureDeviceNV: TwglReleaseVideoCaptureDeviceNV; - - // WGL_NV_copy_image - wglCopyImageSubDataNV: TwglCopyImageSubDataNV; - - // WGL_NV_DX_interop - wglDXSetResourceShareHandleNV : TwglDXSetResourceShareHandleNV; - wglDXOpenDeviceNV : TwglDXOpenDeviceNV; - wglDXCloseDeviceNV : TwglDXCloseDeviceNV; - wglDXRegisterObjectNV : TwglDXRegisterObjectNV; - wglDXUnregisterObjectNV : TwglDXUnregisterObjectNV; - wglDXObjectAccessNV : TwglDXObjectAccessNV; - wglDXLockObjectsNV : TwglDXLockObjectsNV; - wglDXUnlockObjectsNV : TwglDXUnlockObjectsNV; - - // WGL_OML_sync_control - wglGetSyncValuesOML: TwglGetSyncValuesOML; - wglGetMscRateOML: TwglGetMscRateOML; - wglSwapBuffersMscOML: TwglSwapBuffersMscOML; - wglSwapLayerBuffersMscOML: TwglSwapLayerBuffersMscOML; - wglWaitForMscOML: TwglWaitForMscOML; - wglWaitForSbcOML: TwglWaitForSbcOML; - - // WGL_3DL_stereo_control - wglSetStereoEmitterState3DL: TwglSetStereoEmitterState3DL; - - // WIN_draw_range_elements - glDrawRangeElementsWIN: TglDrawRangeElementsWIN; - - // WIN_swap_hint - glAddSwapHintRectWIN: TglAddSwapHintRectWIN; -{$ENDIF} - -{$IFDEF DGL_LINUX} - glXChooseVisual: TglXChooseVisual; - glXCopyContext: TglXCopyContext; - glXCreateContext: TglXCreateContext; - glXCreateGLXPixmap: TglXCreateGLXPixmap; - glXDestroyContext: TglXDestroyContext; - glXDestroyGLXPixmap: TglXDestroyGLXPixmap; - glXGetConfig: TglXGetConfig; - glXGetCurrentContext: TglXGetCurrentContext; - glXGetCurrentDrawable: TglXGetCurrentDrawable; - glXIsDirect: TglXIsDirect; - glXMakeCurrent: TglXMakeCurrent; - glXQueryExtension: TglXQueryExtension; - glXQueryVersion: TglXQueryVersion; - glXSwapBuffers: TglXSwapBuffers; - glXUseXFont: TglXUseXFont; - glXWaitGL: TglXWaitGL; - glXWaitX: TglXWaitX; - - glXGetClientString: TglXGetClientString; - glXQueryServerString: TglXQueryServerString; - glXQueryExtensionsString: TglXQueryExtensionsString; - - // GLX_VERSION_1_3 - glXGetFBConfigs: TglXGetFBConfigs; - glXChooseFBConfig: TglXChooseFBConfig; - glXGetFBConfigAttrib: TglXGetFBConfigAttrib; - glXGetVisualFromFBConfig: TglXGetVisualFromFBConfig; - glXCreateWindow: TglXCreateWindow; - glXDestroyWindow: TglXDestroyWindow; - glXCreatePixmap: TglXCreatePixmap; - - glXDestroyPixmap: TglXDestroyPixmap; - glXCreatePbuffer: TglXCreatePbuffer; - glXDestroyPbuffer: TglXDestroyPbuffer; - glXQueryDrawable: TglXQueryDrawable; - glXCreateNewContext: TglXCreateNewContext; - glXMakeContextCurrent: TglXMakeContextCurrent; - glXGetCurrentReadDrawable: TglXGetCurrentReadDrawable; - glXGetCurreentDisplay: TglXGetCurreentDisplay; - - glXQueryContext: TglXQueryContext; - glXSelectEvent: TglXSelectEvent; - glXGetSelectedEvent: TglXGetSelectedEvent; - - // GLX_VERSION_1_4 - glXGetProcAddress: TglXGetProcAddress; - - // GLX_ARB_get_proc_address - glXGetProcAddressARB: TglXGetProcAddressARB; - - // GLX_ARB_create_context - glXCreateContextAttribsARB: TglXCreateContextAttribsARB; - - // GLX_EXT_import_context - glXGetCurrentDisplayEXT: TglXGetCurrentDisplayEXT; - glXQueryContextInfoEXT: TglXQueryContextInfoEXT; - glXGetContextIDEXT: TglXGetContextIDEXT; - glXImportContextEXT: TglXImportContextEXT; - glXFreeContextEXT: TglXFreeContextEXT; - - // GLX_EXT_texture_from_pixmap - glXBindTexImageEXT: TglXBindTexImageEXT; - glXReleaseTexImageEXT: TglXReleaseTexImageEXT; -{$ENDIF} - - // GL utility functions and procedures - gluErrorString: TgluErrorString; - gluGetString: TgluGetString; - gluOrtho2D: TgluOrtho2D; - gluPerspective: TgluPerspective; - gluPickMatrix: TgluPickMatrix; - gluLookAt: TgluLookAt; - gluProject: TgluProject; - gluUnProject: TgluUnProject; - gluScaleImage: TgluScaleImage; - gluBuild1DMipmaps: TgluBuild1DMipmaps; - gluBuild2DMipmaps: TgluBuild2DMipmaps; - gluNewQuadric: TgluNewQuadric; - gluDeleteQuadric: TgluDeleteQuadric; - gluQuadricNormals: TgluQuadricNormals; - gluQuadricTexture: TgluQuadricTexture; - gluQuadricOrientation: TgluQuadricOrientation; - gluQuadricDrawStyle: TgluQuadricDrawStyle; - gluCylinder: TgluCylinder; - gluDisk: TgluDisk; - gluPartialDisk: TgluPartialDisk; - gluSphere: TgluSphere; - gluQuadricCallback: TgluQuadricCallback; - gluNewTess: TgluNewTess; - gluDeleteTess: TgluDeleteTess; - gluTessBeginPolygon: TgluTessBeginPolygon; - gluTessBeginContour: TgluTessBeginContour; - gluTessVertex: TgluTessVertex; - gluTessEndContour: TgluTessEndContour; - gluTessEndPolygon: TgluTessEndPolygon; - gluTessProperty: TgluTessProperty; - gluTessNormal: TgluTessNormal; - gluTessCallback: TgluTessCallback; - gluGetTessProperty: TgluGetTessProperty; - gluNewNurbsRenderer: TgluNewNurbsRenderer; - gluDeleteNurbsRenderer: TgluDeleteNurbsRenderer; - gluBeginSurface: TgluBeginSurface; - gluBeginCurve: TgluBeginCurve; - gluEndCurve: TgluEndCurve; - gluEndSurface: TgluEndSurface; - gluBeginTrim: TgluBeginTrim; - gluEndTrim: TgluEndTrim; - gluPwlCurve: TgluPwlCurve; - gluNurbsCurve: TgluNurbsCurve; - gluNurbsSurface: TgluNurbsSurface; - gluLoadSamplingMatrices: TgluLoadSamplingMatrices; - gluNurbsProperty: TgluNurbsProperty; - gluGetNurbsProperty: TgluGetNurbsProperty; - gluNurbsCallback: TgluNurbsCallback; - gluBeginPolygon: TgluBeginPolygon; - gluNextContour: TgluNextContour; - gluEndPolygon: TgluEndPolygon; - - -type - TRCOptions = set of (opDoubleBuffered, opGDI, opStereo); - -var - GL_LibHandle: Pointer = nil; - GLU_LibHandle: Pointer = nil; - - LastPixelFormat: Integer; - ExtensionsRead: Boolean; - ImplementationRead: Boolean; - - -const -{$IFDEF DGL_WIN} - OPENGL_LIBNAME = 'OpenGL32.dll'; - GLU_LIBNAME = 'GLU32.dll'; -{$ELSE} - {$IFDEF darwin} - OPENGL_LIBNAME = 'libGL.dylib'; - GLU_LIBNAME = 'libGLU.dylib'; - {$ELSE} - OPENGL_LIBNAME = 'libGL.so.1'; - GLU_LIBNAME = 'libGLU.so.1'; - {$ENDIF} -{$ENDIF} - -function InitOpenGL(LibName: String = OPENGL_LIBNAME; GLULibName: String = GLU_LIBNAME): Boolean; - -function dglGetProcAddress(ProcName: PAnsiChar; LibHandle: Pointer = nil {$IFDEF DGL_LINUX}; ForceDLSym: Boolean = False{$ENDIF}): Pointer; -function dglCheckExtension(Extension: AnsiString): Boolean; - -procedure ReadExtensions; -procedure ReadImplementationProperties; - -// ============================================================================= -// Helper-Functions -// ============================================================================= -{$IFDEF DGL_WIN} - function CreateRenderingContext(DC: HDC; Options: TRCOptions; ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers: Integer; Layer: Integer): HGLRC; - function CreateRenderingContextVersion(DC: HDC; Options: TRCOptions; MajorVersion, MinorVersion : Integer; ForwardCompatible : Boolean; ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers: Integer; Layer: Integer): HGLRC; - procedure DestroyRenderingContext(RC: HGLRC); - - procedure ActivateRenderingContext(DC: HDC; RC: HGLRC; loadext: boolean = true); - procedure DeactivateRenderingContext; -{$ENDIF} - - -procedure ReadOpenGLCore; -procedure Read_GL_3DFX_tbuffer; -procedure Read_GL_APPLE_element_array; -procedure Read_GL_APPLE_fence; -procedure Read_GL_APPLE_vertex_array_object; -procedure Read_GL_APPLE_vertex_array_range; -procedure Read_GL_APPLE_texture_range; -procedure Read_GL_APPLE_vertex_program_evaluators; -procedure Read_GL_APPLE_object_purgeable; -procedure Read_GL_ARB_matrix_palette; -procedure Read_GL_ARB_multitexture; -procedure Read_GL_ARB_point_parameters; -procedure Read_GL_ARB_texture_compression; -procedure Read_GL_ARB_transpose_matrix; -procedure Read_GL_ARB_vertex_blend; -procedure Read_GL_ARB_vertex_buffer_object; -procedure Read_GL_ARB_vertex_program; -procedure Read_GL_ARB_window_pos; -procedure Read_GL_ARB_color_buffer_float; -procedure Read_GL_ARB_Shader_Objects; -procedure Read_GL_ARB_occlusion_query; -procedure Read_GL_ARB_draw_instanced; -procedure Read_GL_ARB_framebuffer_object; -procedure Read_GL_ARB_geometry_shader4; -procedure Read_GL_ARB_instanced_arrays; -procedure Read_GL_ARB_map_buffer_range; -procedure Read_GL_ARB_texture_buffer_object; -procedure Read_GL_ARB_vertex_array_object; -procedure Read_GL_ARB_uniform_buffer_object; -procedure Read_GL_ARB_copy_buffer; -procedure Read_GL_ARB_draw_elements_base_vertex; -procedure Read_GL_ARB_provoking_vertex; -procedure Read_GL_ARB_sync; -procedure Read_GL_ARB_texture_multisample; -procedure Read_GL_ARB_draw_buffers_blend; -procedure Read_GL_ARB_sample_shading; -procedure Read_GL_ARB_shading_language_include; -procedure Read_GL_ARB_blend_func_extended; -procedure Read_GL_ARB_sampler_objects; -procedure Read_GL_ARB_timer_query; -procedure Read_GL_ARB_vertex_type_2_10_10_10_rev; -procedure Read_GL_ARB_draw_indirect; -procedure Read_GL_ARB_gpu_shader_fp64; -procedure Read_GL_ARB_shader_subroutine; -procedure Read_GL_ARB_tessellation_shader; -procedure Read_GL_ARB_transform_feedback2; -procedure Read_GL_ARB_transform_feedback3; -procedure Read_GL_ARB_ES2_compatibility; -procedure Read_GL_ARB_get_program_binary; -procedure Read_GL_ARB_separate_shader_objects; -procedure Read_GL_ARB_vertex_attrib_64bit; -procedure Read_GL_ARB_viewport_array; -// GL 4.2 -procedure Read_GL_ARB_base_instance; -procedure Read_GL_ARB_transform_feedback_instanced; -procedure Read_GL_ARB_internalformat_query; -procedure Read_GL_ARB_shader_atomic_counters; -procedure Read_GL_ARB_shader_image_load_store; -procedure Read_GL_ARB_texture_storage; -// GL 4.3 -procedure Read_GL_KHR_debug; -procedure Read_GL_ARB_clear_buffer_object; -procedure Read_GL_ARB_compute_shader; -procedure Read_GL_ARB_copy_image; -procedure Read_GL_ARB_framebuffer_no_attachments; -procedure Read_GL_ARB_internalformat_query2; -procedure Read_GL_ARB_invalidate_subdata; -procedure Read_GL_ARB_multi_draw_indirect; -procedure Read_GL_ARB_program_interface_query; -procedure Read_GL_ARB_shader_storage_buffer_object; -procedure Read_GL_ARB_texture_buffer_range; -procedure Read_GL_ARB_texture_storage_multisample; -procedure Read_GL_ARB_texture_view; -procedure Read_GL_ARB_vertex_attrib_binding; -// -procedure Read_GL_ARB_cl_event; -procedure Read_GL_ARB_debug_output; -procedure Read_GL_ARB_robustness; -procedure Read_GL_ATI_draw_buffers; -procedure Read_GL_ATI_element_array; -procedure Read_GL_ATI_envmap_bumpmap; -procedure Read_GL_ATI_fragment_shader; -procedure Read_GL_ATI_map_object_buffer; -procedure Read_GL_ATI_pn_triangles; -procedure Read_GL_ATI_separate_stencil; -procedure Read_GL_ATI_vertex_array_object; -procedure Read_GL_ATI_vertex_attrib_array_object; -procedure Read_GL_ATI_vertex_streams; -procedure Read_GL_AMD_performance_monitor; -procedure Read_GL_AMD_vertex_shader_tesselator; -procedure Read_GL_AMD_draw_buffers_blend; -procedure Read_GL_AMD_name_gen_delete; -procedure Read_GL_AMD_debug_output; -procedure Read_GL_EXT_blend_color; -procedure Read_GL_EXT_blend_func_separate; -procedure Read_GL_EXT_blend_minmax; -procedure Read_GL_EXT_color_subtable; -procedure Read_GL_EXT_compiled_vertex_array; -procedure Read_GL_EXT_convolution; -procedure Read_GL_EXT_coordinate_frame; -procedure Read_GL_EXT_copy_texture; -procedure Read_GL_EXT_cull_vertex; -procedure Read_GL_EXT_draw_range_elements; -procedure Read_GL_EXT_fog_coord; -procedure Read_GL_EXT_framebuffer_object; -procedure Read_GL_EXT_histogram; -procedure Read_GL_EXT_index_func; -procedure Read_GL_EXT_index_material; -procedure Read_GL_EXT_multi_draw_arrays; -procedure Read_GL_EXT_multisample; -procedure Read_GL_EXT_paletted_texture; -procedure Read_GL_EXT_pixel_transform; -procedure Read_GL_EXT_point_parameters; -procedure Read_GL_EXT_polygon_offset; -procedure Read_GL_EXT_secondary_color; -procedure Read_GL_EXT_stencil_two_side; -procedure Read_GL_EXT_subtexture; -procedure Read_GL_EXT_texture3D; -procedure Read_GL_EXT_texture_object; -procedure Read_GL_EXT_texture_perturb_normal; -procedure Read_GL_EXT_vertex_array; -procedure Read_GL_EXT_vertex_shader; -procedure Read_GL_EXT_vertex_weighting; -procedure Read_GL_EXT_depth_bounds_test; -procedure Read_GL_EXT_blend_equation_separate; -procedure Read_GL_EXT_stencil_clear_tag; -procedure Read_GL_EXT_framebuffer_blit; -procedure Read_GL_EXT_framebuffer_multisample; -procedure Read_GL_EXT_timer_query; -procedure Read_GL_EXT_gpu_program_parameters; -procedure Read_GL_EXT_bindable_uniform; -procedure Read_GL_EXT_draw_buffers2; -procedure Read_GL_EXT_draw_instanced; -procedure Read_GL_EXT_geometry_shader4; -procedure Read_GL_EXT_gpu_shader4; -procedure Read_GL_EXT_texture_array; -procedure Read_GL_EXT_texture_buffer_object; -procedure Read_GL_EXT_texture_integer; -procedure Read_GL_EXT_transform_feedback; -procedure Read_GL_EXT_direct_state_access; -procedure Read_GL_EXT_separate_shader_objects; -procedure Read_GL_EXT_shader_image_load_store; -procedure Read_GL_EXT_vertex_attrib_64bit; -procedure Read_GL_HP_image_transform; -procedure Read_GL_IBM_multimode_draw_arrays; -procedure Read_GL_IBM_vertex_array_lists; -procedure Read_GL_INGR_blend_func_separate; -procedure Read_GL_INTEL_parallel_arrays; -procedure Read_GL_MESA_resize_buffers; -procedure Read_GL_MESA_window_pos; -procedure Read_GL_NV_evaluators; -procedure Read_GL_NV_fence; -procedure Read_GL_NV_fragment_program; -procedure Read_GL_NV_half_float; -procedure Read_GL_NV_occlusion_query; -procedure Read_GL_NV_pixel_data_range; -procedure Read_GL_NV_point_sprite; -procedure Read_GL_NV_primitive_restart; -procedure Read_GL_NV_register_combiners; -procedure Read_GL_NV_register_combiners2; -procedure Read_GL_NV_vertex_array_range; -procedure Read_GL_NV_vertex_program; -procedure Read_GL_NV_depth_buffer_float; -procedure Read_GL_NV_framebuffer_multisample_coverage; -procedure Read_GL_NV_geometry_program4; -procedure Read_GL_NV_gpu_program4; -procedure Read_GL_NV_parameter_buffer_object; -procedure Read_GL_NV_transform_feedback; -procedure Read_GL_NV_conditional_render; -procedure Read_GL_NV_present_video; -procedure Read_GL_NV_explicit_multisample; -procedure Read_GL_NV_transform_feedback2; -procedure Read_GL_NV_video_capture; -procedure Read_GL_NV_copy_image; -procedure Read_GL_NV_shader_buffer_load; -procedure Read_GL_NV_vertex_buffer_unified_memory; -procedure Read_GL_NV_gpu_program5; -procedure Read_GL_NV_gpu_shader5; -procedure Read_GL_NV_vertex_attrib_integer_64bit; -procedure Read_GL_NV_vdpau_interop; -procedure Read_GL_NV_texture_barrier; -procedure Read_GL_PGI_misc_hints; -procedure Read_GL_SGIS_detail_texture; -procedure Read_GL_SGIS_fog_function; -procedure Read_GL_SGIS_multisample; -procedure Read_GL_SGIS_pixel_texture; -procedure Read_GL_SGIS_point_parameters; -procedure Read_GL_SGIS_sharpen_texture; -procedure Read_GL_SGIS_texture4D; -procedure Read_GL_SGIS_texture_color_mask; -procedure Read_GL_SGIS_texture_filter4; -procedure Read_GL_SGIX_async; -procedure Read_GL_SGIX_flush_raster; -procedure Read_GL_SGIX_fragment_lighting; -procedure Read_GL_SGIX_framezoom; -procedure Read_GL_SGIX_igloo_interface; -procedure Read_GL_SGIX_instruments; -procedure Read_GL_SGIX_list_priority; -procedure Read_GL_SGIX_pixel_texture; -procedure Read_GL_SGIX_polynomial_ffd; -procedure Read_GL_SGIX_reference_plane; -procedure Read_GL_SGIX_sprite; -procedure Read_GL_SGIX_tag_sample_buffer; -procedure Read_GL_SGI_color_table; -procedure Read_GL_SUNX_constant_data; -procedure Read_GL_SUN_global_alpha; -procedure Read_GL_SUN_mesh_array; -procedure Read_GL_SUN_triangle_list; -procedure Read_GL_SUN_vertex; - -{$IFDEF DGL_WIN} -procedure Read_WGL_ARB_buffer_region; -procedure Read_WGL_ARB_extensions_string; -procedure Read_WGL_ARB_make_current_read; -procedure Read_WGL_ARB_pbuffer; -procedure Read_WGL_ARB_pixel_format; -procedure Read_WGL_ARB_pixel_format_float; -procedure Read_WGL_ARB_render_texture; -procedure Read_WGL_ARB_create_context; -procedure Read_WGL_AMD_gpu_association; -procedure Read_WGL_EXT_display_color_table; -procedure Read_WGL_EXT_extensions_string; -procedure Read_WGL_EXT_make_current_read; -procedure Read_WGL_EXT_pbuffer; -procedure Read_WGL_EXT_pixel_format; -procedure Read_WGL_EXT_swap_control; -procedure Read_WGL_I3D_digital_video_control; -procedure Read_WGL_I3D_gamma; -procedure Read_WGL_I3D_genlock; -procedure Read_WGL_I3D_image_buffer; -procedure Read_WGL_I3D_swap_frame_lock; -procedure Read_WGL_I3D_swap_frame_usage; -procedure Read_WGL_NV_vertex_array_range; -procedure Read_WGL_NV_present_video; -procedure Read_WGL_NV_video_output; -procedure Read_WGL_NV_swap_group; -procedure Read_WGL_NV_gpu_affinity; -procedure Read_WGL_NV_video_capture; -procedure Read_WGL_NV_copy_image; -procedure Read_WGL_OML_sync_control; -procedure Read_WGL_3DL_stereo_control; - -procedure Read_WIN_draw_range_elements; -procedure Read_WIN_swap_hint; -{$ENDIF} - - -implementation - - -{$IFDEF DGL_LINUX} -const - RTLD_LAZY = $001; - RTLD_NOW = $002; - RTLD_BINDING_MASK = $003; - - // Seems to work on Debian / Fedora - LibraryLib = {$IFDEF Linux} 'libdl.so.2'{$ELSE} 'c'{$ENDIF}; - -function dlopen(Name: PAnsiChar; Flags: LongInt): Pointer; cdecl; external LibraryLib name 'dlopen'; -function dlclose(Lib: Pointer): LongInt; cdecl; external LibraryLib name 'dlclose'; - -function dlsym(Lib: Pointer; Name: PAnsiChar): Pointer; cdecl; external LibraryLib name 'dlsym'; -{$ENDIF} - -{$IFDEF DGL_MAC}{$IFDEF OPENGL_FRAMEWORK} // OpenGL framework used -const - RTLD_DEFAULT = Pointer(-2); -{$ENDIF}{$ENDIF} - -function dglLoadLibrary(Name: PChar): Pointer; -begin - {$IFDEF DGL_WIN} - Result := Pointer(LoadLibrary(Name)); - {$ENDIF} - - {$IFDEF DGL_LINUX} - Result := dlopen(Name, RTLD_LAZY); - {$ENDIF} - - {$IFDEF DGL_MAC} - {$IFDEF OPENGL_FRAMEWORK} - Result := RTLD_DEFAULT; - {$ELSE} - Result := Pointer(LoadLibrary(Name)); - {$ENDIF} - {$ENDIF} -end; - - -function dglFreeLibrary(LibHandle: Pointer): Boolean; -begin - if LibHandle = nil then - Result := False - else - {$IFDEF DGL_WIN} - Result := FreeLibrary(HMODULE(LibHandle)); - {$ENDIF} - - {$IFDEF DGL_LINUX} - Result := dlclose(LibHandle) = 0; - {$ENDIF} - - {$IFDEF DGL_MAC} - {$IFDEF OPENGL_FRAMEWORK} - Result := true; - {$ELSE} - Result := FreeLibrary(HMODULE(LibHandle)); - {$ENDIF} - {$ENDIF} -end; - - -function dglGetProcAddress(ProcName: PAnsiChar; LibHandle: Pointer = nil {$IFDEF DGL_LINUX}; ForceDLSym: Boolean = False{$ENDIF}): Pointer; -begin - if LibHandle = nil then - LibHandle := GL_LibHandle; - - Result := nil; - - {$IFDEF DGL_WIN} - Result := GetProcAddress(HMODULE(LibHandle), ProcName); - - if result <> nil then - exit; - - if Addr(wglGetProcAddress) <> nil then - Result := wglGetProcAddress(ProcName); - {$ENDIF} - - {$IFDEF DGL_LINUX} - if not ForceDLSym then begin - if Addr(glXGetProcAddress) <> nil then - Result := glXGetProcAddress(ProcName); - - if result <> nil then - exit; - - if Addr(glXGetProcAddressARB) <> nil then - Result := glXGetProcAddressARB(ProcName); - - if result <> nil then - exit; - end; - - Result := dlsym(LibHandle, ProcName); - {$ENDIF} - - {$IFDEF DGL_MAC} - Result := GetProcAddress(HMODULE(LibHandle), ProcName); - {$ENDIF} -end; - - -function Int_GetExtensionString: AnsiString; -begin - // generel extension string - if not Assigned(@glGetString) then - glGetString := dglGetProcAddress('glGetString'); - - if Assigned(@glGetString) then - Result := glGetString(GL_EXTENSIONS) - else - Result := ''; - - if (GL_LibHandle <> nil) then begin - {$IFDEF DGL_WIN} - // wglGetExtensionsStringEXT - if not Assigned(@wglGetExtensionsStringEXT) then - wglGetExtensionsStringEXT := dglGetProcAddress('wglGetExtensionsStringEXT'); - - if Assigned(@wglGetExtensionsStringEXT) then - Result := Result + #32 + wglGetExtensionsStringEXT; - - // wglGetExtensionsStringARB - if not Assigned(@wglGetExtensionsStringARB) then - wglGetExtensionsStringARB := dglGetProcAddress('wglGetExtensionsStringARB'); - - if Assigned(@wglGetExtensionsStringARB) then - Result := Result + #32 + wglGetExtensionsStringARB(wglGetCurrentDC); - {$ENDIF} - end; - - Result := #32 + Result + #32; -end; - - -function Int_CheckExtension(AllExtensions, CheckExtension: AnsiString): Boolean; -begin - Result := Pos(#32 + CheckExtension + #32, AllExtensions) > 0; -end; - - -function dglCheckExtension(Extension: AnsiString): Boolean; -var - Extensions: AnsiString; -begin - Extensions := Int_GetExtensionString; - Result := Int_CheckExtension(Extensions, Extension); -end; - - - -function InitOpenGL(LibName: String; GLULibName: String): Boolean; -begin - Result := False; - - // free opened libraries - if GL_LibHandle <> nil then - dglFreeLibrary(GL_LibHandle); - - if GLU_LibHandle <> nil then - dglFreeLibrary(GLU_LibHandle); - - // load library - GL_LibHandle := dglLoadLibrary(PChar(LibName)); - GLU_LibHandle := dglLoadLibrary(PChar(GLULibName)); - - // load GL functions - if (GL_LibHandle <> nil) then begin - {$IFDEF DGL_WIN} - wglCopyContext := dglGetProcAddress('wglCopyContext'); - wglCreateLayerContext := dglGetProcAddress('wglCreateLayerContext'); - wglCreateContext := dglGetProcAddress('wglCreateContext'); - wglDeleteContext := dglGetProcAddress('wglDeleteContext'); - wglDescribeLayerPlane := dglGetProcAddress('wglDescribeLayerPlane'); - wglGetCurrentContext := dglGetProcAddress('wglGetCurrentContext'); - wglGetCurrentDC := dglGetProcAddress('wglGetCurrentDC'); - wglGetLayerPaletteEntries := dglGetProcAddress('wglGetLayerPaletteEntries'); - wglGetProcAddress := dglGetProcAddress('wglGetProcAddress'); - wglMakeCurrent := dglGetProcAddress('wglMakeCurrent'); - wglRealizeLayerPalette := dglGetProcAddress('wglRealizeLayerPalette'); - wglSetLayerPaletteEntries := dglGetProcAddress('wglSetLayerPaletteEntries'); - wglShareLists := dglGetProcAddress('wglShareLists'); - wglSwapLayerBuffers := dglGetProcAddress('wglSwapLayerBuffers'); - wglSwapMultipleBuffers := dglGetProcAddress('wglSwapMultipleBuffers'); - wglUseFontBitmapsA := dglGetProcAddress('wglUseFontBitmapsA'); - wglUseFontOutlinesA := dglGetProcAddress('wglUseFontOutlinesA'); - wglUseFontBitmapsW := dglGetProcAddress('wglUseFontBitmapsW'); - wglUseFontOutlinesW := dglGetProcAddress('wglUseFontOutlinesW'); - wglUseFontBitmaps := dglGetProcAddress('wglUseFontBitmapsA'); - wglUseFontOutlines := dglGetProcAddress('wglUseFontOutlinesA'); - {$ENDIF} - - {$IFDEF DGL_LINUX} - // GLX_VERSION_1_4 (needs to be first) - glXGetProcAddress := dglGetProcAddress('glXGetProcAddress', nil, True); - - // GLX_ARB_get_proc_address (also needs to be first) - glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB', nil, True); - - glXChooseVisual := dglGetProcAddress('glXChooseVisual'); - glXCopyContext := dglGetProcAddress('glXCopyContext'); - glXCreateContext := dglGetProcAddress('glXCreateContext'); - glXCreateGLXPixmap := dglGetProcAddress('glXCreateGLXPixmap'); - glXDestroyContext := dglGetProcAddress('glXDestroyContext'); - glXDestroyGLXPixmap := dglGetProcAddress('glXDestroyGLXPixmap'); - glXGetConfig := dglGetProcAddress('glXGetConfig'); - glXGetCurrentContext := dglGetProcAddress('glXGetCurrentContext'); - glXGetCurrentDrawable := dglGetProcAddress('glXGetCurrentDrawable'); - glXIsDirect := dglGetProcAddress('glXIsDirect'); - glXMakeCurrent := dglGetProcAddress('glXMakeCurrent'); - glXQueryExtension := dglGetProcAddress('glXQueryExtension'); - glXQueryVersion := dglGetProcAddress('glXQueryVersion'); - glXSwapBuffers := dglGetProcAddress('glXSwapBuffers'); - glXUseXFont := dglGetProcAddress('glXUseXFont'); - glXWaitGL := dglGetProcAddress('glXWaitGL'); - glXWaitX := dglGetProcAddress('glXWaitX'); - - glXGetClientString := dglGetProcAddress('glXGetClientString'); - glXQueryServerString := dglGetProcAddress('glXQueryServerString'); - glXQueryExtensionsString := dglGetProcAddress('glXQueryExtensionsString'); - - // GLX_VERSION_1_3 - glXGetFBConfigs := dglGetProcAddress('glXGetFBConfigs'); - glXChooseFBConfig := dglGetProcAddress('glXChooseFBConfig'); - glXGetFBConfigAttrib := dglGetProcAddress('glXGetFBConfigAttrib'); - glXGetVisualFromFBConfig := dglGetProcAddress('glXGetVisualFromFBConfig'); - glXCreateWindow := dglGetProcAddress('glXCreateWindow'); - glXDestroyWindow := dglGetProcAddress('glXDestroyWindow'); - glXCreatePixmap := dglGetProcAddress('glXCreatePixmap'); - - glXDestroyPixmap := dglGetProcAddress('glXDestroyPixmap'); - glXCreatePbuffer := dglGetProcAddress('glXCreatePbuffer'); - glXDestroyPbuffer := dglGetProcAddress('glXDestroyPbuffer'); - glXQueryDrawable := dglGetProcAddress('glXQueryDrawable'); - glXCreateNewContext := dglGetProcAddress('glXCreateNewContext'); - glXMakeContextCurrent := dglGetProcAddress('glXMakeContextCurrent'); - glXGetCurrentReadDrawable := dglGetProcAddress('glXGetCurrentReadDrawable'); - glXGetCurreentDisplay := dglGetProcAddress('glXGetCurreentDisplay'); - - glXQueryContext := dglGetProcAddress('glXQueryContext'); - glXSelectEvent := dglGetProcAddress('glXSelectEvent'); - glXGetSelectedEvent := dglGetProcAddress('glXGetSelectedEvent'); - - // GLX_ARB_create_context - glXCreateContextAttribsARB := dglGetProcAddress('glXCreateContextAttribsARB'); - - // GLX_EXT_import_context - glXGetCurrentDisplayEXT := dglGetProcAddress('glXGetCurrentDisplayEXT'); - glXQueryContextInfoEXT := dglGetProcAddress('glXQueryContextInfoEXT'); - glXGetContextIDEXT := dglGetProcAddress('glXGetContextIDEXT'); - glXImportContextEXT := dglGetProcAddress('glXImportContextEXT'); - glXFreeContextEXT := dglGetProcAddress('glXFreeContextEXT'); - - // GLX_EXT_texture_from_pixmap - glXBindTexImageEXT := dglGetProcAddress('glXBindTexImageEXT'); - glXReleaseTexImageEXT := dglGetProcAddress('glXReleaseTexImageEXT'); - {$ENDIF} - - Result := True; - end; - - // load GLU functions - if GLU_LibHandle <> nil then begin - // GLU ======================================================================== - gluBeginCurve := dglGetProcAddress('gluBeginCurve', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluBeginPolygon := dglGetProcAddress('gluBeginPolygon', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluBeginSurface := dglGetProcAddress('gluBeginSurface', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluBeginTrim := dglGetProcAddress('gluBeginTrim', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluBuild1DMipmaps := dglGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluBuild2DMipmaps := dglGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluCylinder := dglGetProcAddress('gluCylinder', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluDeleteNurbsRenderer := dglGetProcAddress('gluDeleteNurbsRenderer', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluDeleteQuadric := dglGetProcAddress('gluDeleteQuadric', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluDeleteTess := dglGetProcAddress('gluDeleteTess', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluDisk := dglGetProcAddress('gluDisk', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluEndCurve := dglGetProcAddress('gluEndCurve', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluEndPolygon := dglGetProcAddress('gluEndPolygon', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluEndSurface := dglGetProcAddress('gluEndSurface', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluEndTrim := dglGetProcAddress('gluEndTrim', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluErrorString := dglGetProcAddress('gluErrorString', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluGetNurbsProperty := dglGetProcAddress('gluGetNurbsProperty', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluGetString := dglGetProcAddress('gluGetString', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluGetTessProperty := dglGetProcAddress('gluGetTessProperty', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluLoadSamplingMatrices := dglGetProcAddress('gluLoadSamplingMatrices', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluLookAt := dglGetProcAddress('gluLookAt', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNewNurbsRenderer := dglGetProcAddress('gluNewNurbsRenderer', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNewQuadric := dglGetProcAddress('gluNewQuadric', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNewTess := dglGetProcAddress('gluNewTess', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNextContour := dglGetProcAddress('gluNextContour', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNurbsCallback := dglGetProcAddress('gluNurbsCallback', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNurbsCurve := dglGetProcAddress('gluNurbsCurve', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNurbsProperty := dglGetProcAddress('gluNurbsProperty', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluNurbsSurface := dglGetProcAddress('gluNurbsSurface', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluOrtho2D := dglGetProcAddress('gluOrtho2D', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluPartialDisk := dglGetProcAddress('gluPartialDisk', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluPerspective := dglGetProcAddress('gluPerspective', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluPickMatrix := dglGetProcAddress('gluPickMatrix', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluProject := dglGetProcAddress('gluProject', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluPwlCurve := dglGetProcAddress('gluPwlCurve', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluQuadricCallback := dglGetProcAddress('gluQuadricCallback', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluQuadricDrawStyle := dglGetProcAddress('gluQuadricDrawStyle', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluQuadricNormals := dglGetProcAddress('gluQuadricNormals', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluQuadricOrientation := dglGetProcAddress('gluQuadricOrientation', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluQuadricTexture := dglGetProcAddress('gluQuadricTexture', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluScaleImage := dglGetProcAddress('gluScaleImage', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluSphere := dglGetProcAddress('gluSphere', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessBeginContour := dglGetProcAddress('gluTessBeginContour', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessBeginPolygon := dglGetProcAddress('gluTessBeginPolygon', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessCallback := dglGetProcAddress('gluTessCallback', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessEndContour := dglGetProcAddress('gluTessEndContour', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessEndPolygon := dglGetProcAddress('gluTessEndPolygon', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessNormal := dglGetProcAddress('gluTessNormal', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessProperty := dglGetProcAddress('gluTessProperty', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluTessVertex := dglGetProcAddress('gluTessVertex', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - gluUnProject := dglGetProcAddress('gluUnProject', GLU_LibHandle {$IFDEF DGL_LINUX}, True{$ENDIF}); - end; -end; - -procedure ReadOpenGLCore; -begin - // GL_VERSION_1_0 - glCullFace := dglGetProcAddress('glCullFace'); - glFrontFace := dglGetProcAddress('glFrontFace'); - glHint := dglGetProcAddress('glHint'); - glLineWidth := dglGetProcAddress('glLineWidth'); - glPointSize := dglGetProcAddress('glPointSize'); - glPolygonMode := dglGetProcAddress('glPolygonMode'); - glScissor := dglGetProcAddress('glScissor'); - glTexParameterf := dglGetProcAddress('glTexParameterf'); - glTexParameterfv := dglGetProcAddress('glTexParameterfv'); - glTexParameteri := dglGetProcAddress('glTexParameteri'); - glTexParameteriv := dglGetProcAddress('glTexParameteriv'); - glTexImage1D := dglGetProcAddress('glTexImage1D'); - glTexImage2D := dglGetProcAddress('glTexImage2D'); - glDrawBuffer := dglGetProcAddress('glDrawBuffer'); - glClear := dglGetProcAddress('glClear'); - glClearColor := dglGetProcAddress('glClearColor'); - glClearStencil := dglGetProcAddress('glClearStencil'); - glClearDepth := dglGetProcAddress('glClearDepth'); - glStencilMask := dglGetProcAddress('glStencilMask'); - glColorMask := dglGetProcAddress('glColorMask'); - glDepthMask := dglGetProcAddress('glDepthMask'); - glDisable := dglGetProcAddress('glDisable'); - glEnable := dglGetProcAddress('glEnable'); - glFinish := dglGetProcAddress('glFinish'); - glFlush := dglGetProcAddress('glFlush'); - glBlendFunc := dglGetProcAddress('glBlendFunc'); - glLogicOp := dglGetProcAddress('glLogicOp'); - glStencilFunc := dglGetProcAddress('glStencilFunc'); - glStencilOp := dglGetProcAddress('glStencilOp'); - glDepthFunc := dglGetProcAddress('glDepthFunc'); - glPixelStoref := dglGetProcAddress('glPixelStoref'); - glPixelStorei := dglGetProcAddress('glPixelStorei'); - glReadBuffer := dglGetProcAddress('glReadBuffer'); - glReadPixels := dglGetProcAddress('glReadPixels'); - glGetBooleanv := dglGetProcAddress('glGetBooleanv'); - glGetDoublev := dglGetProcAddress('glGetDoublev'); - glGetError := dglGetProcAddress('glGetError'); - glGetFloatv := dglGetProcAddress('glGetFloatv'); - glGetIntegerv := dglGetProcAddress('glGetIntegerv'); - glGetString := dglGetProcAddress('glGetString'); - glGetTexImage := dglGetProcAddress('glGetTexImage'); - glGetTexParameteriv := dglGetProcAddress('glGetTexParameteriv'); - glGetTexParameterfv := dglGetProcAddress('glGetTexParameterfv'); - glGetTexLevelParameterfv := dglGetProcAddress('glGetTexLevelParameterfv'); - glGetTexLevelParameteriv := dglGetProcAddress('glGetTexLevelParameteriv'); - glIsEnabled := dglGetProcAddress('glIsEnabled'); - glDepthRange := dglGetProcAddress('glDepthRange'); - glViewport := dglGetProcAddress('glViewport'); - - // GL_VERSION_1_1 - glDrawArrays := dglGetProcAddress('glDrawArrays'); - glDrawElements := dglGetProcAddress('glDrawElements'); - glGetPointerv := dglGetProcAddress('glGetPointerv'); - glPolygonOffset := dglGetProcAddress('glPolygonOffset'); - glCopyTexImage1D := dglGetProcAddress('glCopyTexImage1D'); - glCopyTexImage2D := dglGetProcAddress('glCopyTexImage2D'); - glCopyTexSubImage1D := dglGetProcAddress('glCopyTexSubImage1D'); - glCopyTexSubImage2D := dglGetProcAddress('glCopyTexSubImage2D'); - glTexSubImage1D := dglGetProcAddress('glTexSubImage1D'); - glTexSubImage2D := dglGetProcAddress('glTexSubImage2D'); - glBindTexture := dglGetProcAddress('glBindTexture'); - glDeleteTextures := dglGetProcAddress('glDeleteTextures'); - glGenTextures := dglGetProcAddress('glGenTextures'); - -{$ifdef DGL_DEPRECATED} - glAccum := dglGetProcAddress('glAccum'); - glAlphaFunc := dglGetProcAddress('glAlphaFunc'); - glAreTexturesResident := dglGetProcAddress('glAreTexturesResident'); - glArrayElement := dglGetProcAddress('glArrayElement'); - glBegin := dglGetProcAddress('glBegin'); - glBitmap := dglGetProcAddress('glBitmap'); - glCallList := dglGetProcAddress('glCallList'); - glCallLists := dglGetProcAddress('glCallLists'); - glClearAccum := dglGetProcAddress('glClearAccum'); - glClearIndex := dglGetProcAddress('glClearIndex'); - glClipPlane := dglGetProcAddress('glClipPlane'); - glColor3b := dglGetProcAddress('glColor3b'); - glColor3bv := dglGetProcAddress('glColor3bv'); - glColor3d := dglGetProcAddress('glColor3d'); - glColor3dv := dglGetProcAddress('glColor3dv'); - glColor3f := dglGetProcAddress('glColor3f'); - glColor3fv := dglGetProcAddress('glColor3fv'); - glColor3i := dglGetProcAddress('glColor3i'); - glColor3iv := dglGetProcAddress('glColor3iv'); - glColor3s := dglGetProcAddress('glColor3s'); - glColor3sv := dglGetProcAddress('glColor3sv'); - glColor3ub := dglGetProcAddress('glColor3ub'); - glColor3ubv := dglGetProcAddress('glColor3ubv'); - glColor3ui := dglGetProcAddress('glColor3ui'); - glColor3uiv := dglGetProcAddress('glColor3uiv'); - glColor3us := dglGetProcAddress('glColor3us'); - glColor3usv := dglGetProcAddress('glColor3usv'); - glColor4b := dglGetProcAddress('glColor4b'); - glColor4bv := dglGetProcAddress('glColor4bv'); - glColor4d := dglGetProcAddress('glColor4d'); - glColor4dv := dglGetProcAddress('glColor4dv'); - glColor4f := dglGetProcAddress('glColor4f'); - glColor4fv := dglGetProcAddress('glColor4fv'); - glColor4i := dglGetProcAddress('glColor4i'); - glColor4iv := dglGetProcAddress('glColor4iv'); - glColor4s := dglGetProcAddress('glColor4s'); - glColor4sv := dglGetProcAddress('glColor4sv'); - glColor4ub := dglGetProcAddress('glColor4ub'); - glColor4ubv := dglGetProcAddress('glColor4ubv'); - glColor4ui := dglGetProcAddress('glColor4ui'); - glColor4uiv := dglGetProcAddress('glColor4uiv'); - glColor4us := dglGetProcAddress('glColor4us'); - glColor4usv := dglGetProcAddress('glColor4usv'); - glColorMaterial := dglGetProcAddress('glColorMaterial'); - glColorPointer := dglGetProcAddress('glColorPointer'); - glCopyPixels := dglGetProcAddress('glCopyPixels'); - glDeleteLists := dglGetProcAddress('glDeleteLists'); - glDisableClientState := dglGetProcAddress('glDisableClientState'); - glDrawPixels := dglGetProcAddress('glDrawPixels'); - glEdgeFlag := dglGetProcAddress('glEdgeFlag'); - glEdgeFlagPointer := dglGetProcAddress('glEdgeFlagPointer'); - glEdgeFlagv := dglGetProcAddress('glEdgeFlagv'); - glEnableClientState := dglGetProcAddress('glEnableClientState'); - glEnd := dglGetProcAddress('glEnd'); - glEndList := dglGetProcAddress('glEndList'); - glEvalCoord1d := dglGetProcAddress('glEvalCoord1d'); - glEvalCoord1dv := dglGetProcAddress('glEvalCoord1dv'); - glEvalCoord1f := dglGetProcAddress('glEvalCoord1f'); - glEvalCoord1fv := dglGetProcAddress('glEvalCoord1fv'); - glEvalCoord2d := dglGetProcAddress('glEvalCoord2d'); - glEvalCoord2dv := dglGetProcAddress('glEvalCoord2dv'); - glEvalCoord2f := dglGetProcAddress('glEvalCoord2f'); - glEvalCoord2fv := dglGetProcAddress('glEvalCoord2fv'); - glEvalMesh1 := dglGetProcAddress('glEvalMesh1'); - glEvalMesh2 := dglGetProcAddress('glEvalMesh2'); - glEvalPoint1 := dglGetProcAddress('glEvalPoint1'); - glEvalPoint2 := dglGetProcAddress('glEvalPoint2'); - glFeedbackBuffer := dglGetProcAddress('glFeedbackBuffer'); - glFogf := dglGetProcAddress('glFogf'); - glFogfv := dglGetProcAddress('glFogfv'); - glFogi := dglGetProcAddress('glFogi'); - glFogiv := dglGetProcAddress('glFogiv'); - glFrustum := dglGetProcAddress('glFrustum'); - glGenLists := dglGetProcAddress('glGenLists'); - glGetClipPlane := dglGetProcAddress('glGetClipPlane'); - glGetLightfv := dglGetProcAddress('glGetLightfv'); - glGetLightiv := dglGetProcAddress('glGetLightiv'); - glGetMapdv := dglGetProcAddress('glGetMapdv'); - glGetMapfv := dglGetProcAddress('glGetMapfv'); - glGetMapiv := dglGetProcAddress('glGetMapiv'); - glGetMaterialfv := dglGetProcAddress('glGetMaterialfv'); - glGetMaterialiv := dglGetProcAddress('glGetMaterialiv'); - glGetPixelMapfv := dglGetProcAddress('glGetPixelMapfv'); - glGetPixelMapuiv := dglGetProcAddress('glGetPixelMapuiv'); - glGetPixelMapusv := dglGetProcAddress('glGetPixelMapusv'); - glGetPolygonStipple := dglGetProcAddress('glGetPolygonStipple'); - glGetTexEnvfv := dglGetProcAddress('glGetTexEnvfv'); - glGetTexEnviv := dglGetProcAddress('glGetTexEnviv'); - glGetTexGendv := dglGetProcAddress('glGetTexGendv'); - glGetTexGenfv := dglGetProcAddress('glGetTexGenfv'); - glGetTexGeniv := dglGetProcAddress('glGetTexGeniv'); - glIndexMask := dglGetProcAddress('glIndexMask'); - glIndexPointer := dglGetProcAddress('glIndexPointer'); - glIndexd := dglGetProcAddress('glIndexd'); - glIndexdv := dglGetProcAddress('glIndexdv'); - glIndexf := dglGetProcAddress('glIndexf'); - glIndexfv := dglGetProcAddress('glIndexfv'); - glIndexi := dglGetProcAddress('glIndexi'); - glIndexiv := dglGetProcAddress('glIndexiv'); - glIndexs := dglGetProcAddress('glIndexs'); - glIndexsv := dglGetProcAddress('glIndexsv'); - glIndexub := dglGetProcAddress('glIndexub'); - glIndexubv := dglGetProcAddress('glIndexubv'); - glInitNames := dglGetProcAddress('glInitNames'); - glInterleavedArrays := dglGetProcAddress('glInterleavedArrays'); - glIsList := dglGetProcAddress('glIsList'); - glIsTexture := dglGetProcAddress('glIsTexture'); - glLightModelf := dglGetProcAddress('glLightModelf'); - glLightModelfv := dglGetProcAddress('glLightModelfv'); - glLightModeli := dglGetProcAddress('glLightModeli'); - glLightModeliv := dglGetProcAddress('glLightModeliv'); - glLightf := dglGetProcAddress('glLightf'); - glLightfv := dglGetProcAddress('glLightfv'); - glLighti := dglGetProcAddress('glLighti'); - glLightiv := dglGetProcAddress('glLightiv'); - glLineStipple := dglGetProcAddress('glLineStipple'); - glListBase := dglGetProcAddress('glListBase'); - glLoadIdentity := dglGetProcAddress('glLoadIdentity'); - glLoadMatrixd := dglGetProcAddress('glLoadMatrixd'); - glLoadMatrixf := dglGetProcAddress('glLoadMatrixf'); - glLoadName := dglGetProcAddress('glLoadName'); - glMap1d := dglGetProcAddress('glMap1d'); - glMap1f := dglGetProcAddress('glMap1f'); - glMap2d := dglGetProcAddress('glMap2d'); - glMap2f := dglGetProcAddress('glMap2f'); - glMapGrid1d := dglGetProcAddress('glMapGrid1d'); - glMapGrid1f := dglGetProcAddress('glMapGrid1f'); - glMapGrid2d := dglGetProcAddress('glMapGrid2d'); - glMapGrid2f := dglGetProcAddress('glMapGrid2f'); - glMaterialf := dglGetProcAddress('glMaterialf'); - glMaterialfv := dglGetProcAddress('glMaterialfv'); - glMateriali := dglGetProcAddress('glMateriali'); - glMaterialiv := dglGetProcAddress('glMaterialiv'); - glMatrixMode := dglGetProcAddress('glMatrixMode'); - glMultMatrixd := dglGetProcAddress('glMultMatrixd'); - glMultMatrixf := dglGetProcAddress('glMultMatrixf'); - glNewList := dglGetProcAddress('glNewList'); - glNormal3b := dglGetProcAddress('glNormal3b'); - glNormal3bv := dglGetProcAddress('glNormal3bv'); - glNormal3d := dglGetProcAddress('glNormal3d'); - glNormal3dv := dglGetProcAddress('glNormal3dv'); - glNormal3f := dglGetProcAddress('glNormal3f'); - glNormal3fv := dglGetProcAddress('glNormal3fv'); - glNormal3i := dglGetProcAddress('glNormal3i'); - glNormal3iv := dglGetProcAddress('glNormal3iv'); - glNormal3s := dglGetProcAddress('glNormal3s'); - glNormal3sv := dglGetProcAddress('glNormal3sv'); - glNormalPointer := dglGetProcAddress('glNormalPointer'); - glOrtho := dglGetProcAddress('glOrtho'); - glPassThrough := dglGetProcAddress('glPassThrough'); - glPixelMapfv := dglGetProcAddress('glPixelMapfv'); - glPixelMapuiv := dglGetProcAddress('glPixelMapuiv'); - glPixelMapusv := dglGetProcAddress('glPixelMapusv'); - glPixelTransferf := dglGetProcAddress('glPixelTransferf'); - glPixelTransferi := dglGetProcAddress('glPixelTransferi'); - glPixelZoom := dglGetProcAddress('glPixelZoom'); - glPolygonStipple := dglGetProcAddress('glPolygonStipple'); - glPopAttrib := dglGetProcAddress('glPopAttrib'); - glPopClientAttrib := dglGetProcAddress('glPopClientAttrib'); - glPopMatrix := dglGetProcAddress('glPopMatrix'); - glPopName := dglGetProcAddress('glPopName'); - glPrioritizeTextures := dglGetProcAddress('glPrioritizeTextures'); - glPushAttrib := dglGetProcAddress('glPushAttrib'); - glPushClientAttrib := dglGetProcAddress('glPushClientAttrib'); - glPushMatrix := dglGetProcAddress('glPushMatrix'); - glPushName := dglGetProcAddress('glPushName'); - glRasterPos2d := dglGetProcAddress('glRasterPos2d'); - glRasterPos2dv := dglGetProcAddress('glRasterPos2dv'); - glRasterPos2f := dglGetProcAddress('glRasterPos2f'); - glRasterPos2fv := dglGetProcAddress('glRasterPos2fv'); - glRasterPos2i := dglGetProcAddress('glRasterPos2i'); - glRasterPos2iv := dglGetProcAddress('glRasterPos2iv'); - glRasterPos2s := dglGetProcAddress('glRasterPos2s'); - glRasterPos2sv := dglGetProcAddress('glRasterPos2sv'); - glRasterPos3d := dglGetProcAddress('glRasterPos3d'); - glRasterPos3dv := dglGetProcAddress('glRasterPos3dv'); - glRasterPos3f := dglGetProcAddress('glRasterPos3f'); - glRasterPos3fv := dglGetProcAddress('glRasterPos3fv'); - glRasterPos3i := dglGetProcAddress('glRasterPos3i'); - glRasterPos3iv := dglGetProcAddress('glRasterPos3iv'); - glRasterPos3s := dglGetProcAddress('glRasterPos3s'); - glRasterPos3sv := dglGetProcAddress('glRasterPos3sv'); - glRasterPos4d := dglGetProcAddress('glRasterPos4d'); - glRasterPos4dv := dglGetProcAddress('glRasterPos4dv'); - glRasterPos4f := dglGetProcAddress('glRasterPos4f'); - glRasterPos4fv := dglGetProcAddress('glRasterPos4fv'); - glRasterPos4i := dglGetProcAddress('glRasterPos4i'); - glRasterPos4iv := dglGetProcAddress('glRasterPos4iv'); - glRasterPos4s := dglGetProcAddress('glRasterPos4s'); - glRasterPos4sv := dglGetProcAddress('glRasterPos4sv'); - glRectd := dglGetProcAddress('glRectd'); - glRectdv := dglGetProcAddress('glRectdv'); - glRectf := dglGetProcAddress('glRectf'); - glRectfv := dglGetProcAddress('glRectfv'); - glRecti := dglGetProcAddress('glRecti'); - glRectiv := dglGetProcAddress('glRectiv'); - glRects := dglGetProcAddress('glRects'); - glRectsv := dglGetProcAddress('glRectsv'); - glRenderMode := dglGetProcAddress('glRenderMode'); - glRotated := dglGetProcAddress('glRotated'); - glRotatef := dglGetProcAddress('glRotatef'); - glScaled := dglGetProcAddress('glScaled'); - glScalef := dglGetProcAddress('glScalef'); - glSelectBuffer := dglGetProcAddress('glSelectBuffer'); - glShadeModel := dglGetProcAddress('glShadeModel'); - glTexCoord1d := dglGetProcAddress('glTexCoord1d'); - glTexCoord1dv := dglGetProcAddress('glTexCoord1dv'); - glTexCoord1f := dglGetProcAddress('glTexCoord1f'); - glTexCoord1fv := dglGetProcAddress('glTexCoord1fv'); - glTexCoord1i := dglGetProcAddress('glTexCoord1i'); - glTexCoord1iv := dglGetProcAddress('glTexCoord1iv'); - glTexCoord1s := dglGetProcAddress('glTexCoord1s'); - glTexCoord1sv := dglGetProcAddress('glTexCoord1sv'); - glTexCoord2d := dglGetProcAddress('glTexCoord2d'); - glTexCoord2dv := dglGetProcAddress('glTexCoord2dv'); - glTexCoord2f := dglGetProcAddress('glTexCoord2f'); - glTexCoord2fv := dglGetProcAddress('glTexCoord2fv'); - glTexCoord2i := dglGetProcAddress('glTexCoord2i'); - glTexCoord2iv := dglGetProcAddress('glTexCoord2iv'); - glTexCoord2s := dglGetProcAddress('glTexCoord2s'); - glTexCoord2sv := dglGetProcAddress('glTexCoord2sv'); - glTexCoord3d := dglGetProcAddress('glTexCoord3d'); - glTexCoord3dv := dglGetProcAddress('glTexCoord3dv'); - glTexCoord3f := dglGetProcAddress('glTexCoord3f'); - glTexCoord3fv := dglGetProcAddress('glTexCoord3fv'); - glTexCoord3i := dglGetProcAddress('glTexCoord3i'); - glTexCoord3iv := dglGetProcAddress('glTexCoord3iv'); - glTexCoord3s := dglGetProcAddress('glTexCoord3s'); - glTexCoord3sv := dglGetProcAddress('glTexCoord3sv'); - glTexCoord4d := dglGetProcAddress('glTexCoord4d'); - glTexCoord4dv := dglGetProcAddress('glTexCoord4dv'); - glTexCoord4f := dglGetProcAddress('glTexCoord4f'); - glTexCoord4fv := dglGetProcAddress('glTexCoord4fv'); - glTexCoord4i := dglGetProcAddress('glTexCoord4i'); - glTexCoord4iv := dglGetProcAddress('glTexCoord4iv'); - glTexCoord4s := dglGetProcAddress('glTexCoord4s'); - glTexCoord4sv := dglGetProcAddress('glTexCoord4sv'); - glTexCoordPointer := dglGetProcAddress('glTexCoordPointer'); - glTexEnvf := dglGetProcAddress('glTexEnvf'); - glTexEnvfv := dglGetProcAddress('glTexEnvfv'); - glTexEnvi := dglGetProcAddress('glTexEnvi'); - glTexEnviv := dglGetProcAddress('glTexEnviv'); - glTexGend := dglGetProcAddress('glTexGend'); - glTexGendv := dglGetProcAddress('glTexGendv'); - glTexGenf := dglGetProcAddress('glTexGenf'); - glTexGenfv := dglGetProcAddress('glTexGenfv'); - glTexGeni := dglGetProcAddress('glTexGeni'); - glTexGeniv := dglGetProcAddress('glTexGeniv'); - glTranslated := dglGetProcAddress('glTranslated'); - glTranslatef := dglGetProcAddress('glTranslatef'); - glVertex2d := dglGetProcAddress('glVertex2d'); - glVertex2dv := dglGetProcAddress('glVertex2dv'); - glVertex2f := dglGetProcAddress('glVertex2f'); - glVertex2fv := dglGetProcAddress('glVertex2fv'); - glVertex2i := dglGetProcAddress('glVertex2i'); - glVertex2iv := dglGetProcAddress('glVertex2iv'); - glVertex2s := dglGetProcAddress('glVertex2s'); - glVertex2sv := dglGetProcAddress('glVertex2sv'); - glVertex3d := dglGetProcAddress('glVertex3d'); - glVertex3dv := dglGetProcAddress('glVertex3dv'); - glVertex3f := dglGetProcAddress('glVertex3f'); - glVertex3fv := dglGetProcAddress('glVertex3fv'); - glVertex3i := dglGetProcAddress('glVertex3i'); - glVertex3iv := dglGetProcAddress('glVertex3iv'); - glVertex3s := dglGetProcAddress('glVertex3s'); - glVertex3sv := dglGetProcAddress('glVertex3sv'); - glVertex4d := dglGetProcAddress('glVertex4d'); - glVertex4dv := dglGetProcAddress('glVertex4dv'); - glVertex4f := dglGetProcAddress('glVertex4f'); - glVertex4fv := dglGetProcAddress('glVertex4fv'); - glVertex4i := dglGetProcAddress('glVertex4i'); - glVertex4iv := dglGetProcAddress('glVertex4iv'); - glVertex4s := dglGetProcAddress('glVertex4s'); - glVertex4sv := dglGetProcAddress('glVertex4sv'); - glVertexPointer := dglGetProcAddress('glVertexPointer'); -{$endif} - - // GL_VERSION_1_2 - glBlendColor := dglGetProcAddress('glBlendColor'); - glBlendEquation := dglGetProcAddress('glBlendEquation'); - glDrawRangeElements := dglGetProcAddress('glDrawRangeElements'); - glTexImage3D := dglGetProcAddress('glTexImage3D'); - glTexSubImage3D := dglGetProcAddress('glTexSubImage3D'); - glCopyTexSubImage3D := dglGetProcAddress('glCopyTexSubImage3D'); -{$ifdef DGL_DEPRECATED} - glColorTable := dglGetProcAddress('glColorTable'); - glColorTableParameterfv := dglGetProcAddress('glColorTableParameterfv'); - glColorTableParameteriv := dglGetProcAddress('glColorTableParameteriv'); - glCopyColorTable := dglGetProcAddress('glCopyColorTable'); - glGetColorTable := dglGetProcAddress('glGetColorTable'); - glGetColorTableParameterfv := dglGetProcAddress('glGetColorTableParameterfv'); - glGetColorTableParameteriv := dglGetProcAddress('glGetColorTableParameteriv'); - glColorSubTable := dglGetProcAddress('glColorSubTable'); - glCopyColorSubTable := dglGetProcAddress('glCopyColorSubTable'); - glConvolutionFilter1D := dglGetProcAddress('glConvolutionFilter1D'); - glConvolutionFilter2D := dglGetProcAddress('glConvolutionFilter2D'); - glConvolutionParameterf := dglGetProcAddress('glConvolutionParameterf'); - glConvolutionParameterfv := dglGetProcAddress('glConvolutionParameterfv'); - glConvolutionParameteri := dglGetProcAddress('glConvolutionParameteri'); - glConvolutionParameteriv := dglGetProcAddress('glConvolutionParameteriv'); - glCopyConvolutionFilter1D := dglGetProcAddress('glCopyConvolutionFilter1D'); - glCopyConvolutionFilter2D := dglGetProcAddress('glCopyConvolutionFilter2D'); - glGetConvolutionFilter := dglGetProcAddress('glGetConvolutionFilter'); - glGetConvolutionParameterfv := dglGetProcAddress('glGetConvolutionParameterfv'); - glGetConvolutionParameteriv := dglGetProcAddress('glGetConvolutionParameteriv'); - glGetSeparableFilter := dglGetProcAddress('glGetSeparableFilter'); - glSeparableFilter2D := dglGetProcAddress('glSeparableFilter2D'); - glGetHistogram := dglGetProcAddress('glGetHistogram'); - glGetHistogramParameterfv := dglGetProcAddress('glGetHistogramParameterfv'); - glGetHistogramParameteriv := dglGetProcAddress('glGetHistogramParameteriv'); - glGetMinmax := dglGetProcAddress('glGetMinmax'); - glGetMinmaxParameterfv := dglGetProcAddress('glGetMinmaxParameterfv'); - glGetMinmaxParameteriv := dglGetProcAddress('glGetMinmaxParameteriv'); - glHistogram := dglGetProcAddress('glHistogram'); - glMinmax := dglGetProcAddress('glMinmax'); - glResetHistogram := dglGetProcAddress('glResetHistogram'); - glResetMinmax := dglGetProcAddress('glResetMinmax'); -{$endif} - - // GL_VERSION_1_3 - glActiveTexture := dglGetProcAddress('glActiveTexture'); - glSampleCoverage := dglGetProcAddress('glSampleCoverage'); - glCompressedTexImage3D := dglGetProcAddress('glCompressedTexImage3D'); - glCompressedTexImage2D := dglGetProcAddress('glCompressedTexImage2D'); - glCompressedTexImage1D := dglGetProcAddress('glCompressedTexImage1D'); - glCompressedTexSubImage3D := dglGetProcAddress('glCompressedTexSubImage3D'); - glCompressedTexSubImage2D := dglGetProcAddress('glCompressedTexSubImage2D'); - glCompressedTexSubImage1D := dglGetProcAddress('glCompressedTexSubImage1D'); - glGetCompressedTexImage := dglGetProcAddress('glGetCompressedTexImage'); -{$ifdef DGL_DEPRECATED} - glClientActiveTexture := dglGetProcAddress('glClientActiveTexture'); - glMultiTexCoord1d := dglGetProcAddress('glMultiTexCoord1d'); - glMultiTexCoord1dv := dglGetProcAddress('glMultiTexCoord1dv'); - glMultiTexCoord1f := dglGetProcAddress('glMultiTexCoord1f'); - glMultiTexCoord1fv := dglGetProcAddress('glMultiTexCoord1fv'); - glMultiTexCoord1i := dglGetProcAddress('glMultiTexCoord1i'); - glMultiTexCoord1iv := dglGetProcAddress('glMultiTexCoord1iv'); - glMultiTexCoord1s := dglGetProcAddress('glMultiTexCoord1s'); - glMultiTexCoord1sv := dglGetProcAddress('glMultiTexCoord1sv'); - glMultiTexCoord2d := dglGetProcAddress('glMultiTexCoord2d'); - glMultiTexCoord2dv := dglGetProcAddress('glMultiTexCoord2dv'); - glMultiTexCoord2f := dglGetProcAddress('glMultiTexCoord2f'); - glMultiTexCoord2fv := dglGetProcAddress('glMultiTexCoord2fv'); - glMultiTexCoord2i := dglGetProcAddress('glMultiTexCoord2i'); - glMultiTexCoord2iv := dglGetProcAddress('glMultiTexCoord2iv'); - glMultiTexCoord2s := dglGetProcAddress('glMultiTexCoord2s'); - glMultiTexCoord2sv := dglGetProcAddress('glMultiTexCoord2sv'); - glMultiTexCoord3d := dglGetProcAddress('glMultiTexCoord3d'); - glMultiTexCoord3dv := dglGetProcAddress('glMultiTexCoord3dv'); - glMultiTexCoord3f := dglGetProcAddress('glMultiTexCoord3f'); - glMultiTexCoord3fv := dglGetProcAddress('glMultiTexCoord3fv'); - glMultiTexCoord3i := dglGetProcAddress('glMultiTexCoord3i'); - glMultiTexCoord3iv := dglGetProcAddress('glMultiTexCoord3iv'); - glMultiTexCoord3s := dglGetProcAddress('glMultiTexCoord3s'); - glMultiTexCoord3sv := dglGetProcAddress('glMultiTexCoord3sv'); - glMultiTexCoord4d := dglGetProcAddress('glMultiTexCoord4d'); - glMultiTexCoord4dv := dglGetProcAddress('glMultiTexCoord4dv'); - glMultiTexCoord4f := dglGetProcAddress('glMultiTexCoord4f'); - glMultiTexCoord4fv := dglGetProcAddress('glMultiTexCoord4fv'); - glMultiTexCoord4i := dglGetProcAddress('glMultiTexCoord4i'); - glMultiTexCoord4iv := dglGetProcAddress('glMultiTexCoord4iv'); - glMultiTexCoord4s := dglGetProcAddress('glMultiTexCoord4s'); - glMultiTexCoord4sv := dglGetProcAddress('glMultiTexCoord4sv'); - glLoadTransposeMatrixf := dglGetProcAddress('glLoadTransposeMatrixf'); - glLoadTransposeMatrixd := dglGetProcAddress('glLoadTransposeMatrixd'); - glMultTransposeMatrixf := dglGetProcAddress('glMultTransposeMatrixf'); - glMultTransposeMatrixd := dglGetProcAddress('glMultTransposeMatrixd'); -{$endif} - - // GL_VERSION_1_4 - glBlendFuncSeparate := dglGetProcAddress('glBlendFuncSeparate'); - glMultiDrawArrays := dglGetProcAddress('glMultiDrawArrays'); - glMultiDrawElements := dglGetProcAddress('glMultiDrawElements'); - glPointParameterf := dglGetProcAddress('glPointParameterf'); - glPointParameterfv := dglGetProcAddress('glPointParameterfv'); - glPointParameteri := dglGetProcAddress('glPointParameteri'); - glPointParameteriv := dglGetProcAddress('glPointParameteriv'); -{$ifdef DGL_DEPRECATED} - glFogCoordf := dglGetProcAddress('glFogCoordf'); - glFogCoordfv := dglGetProcAddress('glFogCoordfv'); - glFogCoordd := dglGetProcAddress('glFogCoordd'); - glFogCoorddv := dglGetProcAddress('glFogCoorddv'); - glFogCoordPointer := dglGetProcAddress('glFogCoordPointer'); - glSecondaryColor3b := dglGetProcAddress('glSecondaryColor3b'); - glSecondaryColor3bv := dglGetProcAddress('glSecondaryColor3bv'); - glSecondaryColor3d := dglGetProcAddress('glSecondaryColor3d'); - glSecondaryColor3dv := dglGetProcAddress('glSecondaryColor3dv'); - glSecondaryColor3f := dglGetProcAddress('glSecondaryColor3f'); - glSecondaryColor3fv := dglGetProcAddress('glSecondaryColor3fv'); - glSecondaryColor3i := dglGetProcAddress('glSecondaryColor3i'); - glSecondaryColor3iv := dglGetProcAddress('glSecondaryColor3iv'); - glSecondaryColor3s := dglGetProcAddress('glSecondaryColor3s'); - glSecondaryColor3sv := dglGetProcAddress('glSecondaryColor3sv'); - glSecondaryColor3ub := dglGetProcAddress('glSecondaryColor3ub'); - glSecondaryColor3ubv := dglGetProcAddress('glSecondaryColor3ubv'); - glSecondaryColor3ui := dglGetProcAddress('glSecondaryColor3ui'); - glSecondaryColor3uiv := dglGetProcAddress('glSecondaryColor3uiv'); - glSecondaryColor3us := dglGetProcAddress('glSecondaryColor3us'); - glSecondaryColor3usv := dglGetProcAddress('glSecondaryColor3usv'); - glSecondaryColorPointer := dglGetProcAddress('glSecondaryColorPointer'); - glWindowPos2d := dglGetProcAddress('glWindowPos2d'); - glWindowPos2dv := dglGetProcAddress('glWindowPos2dv'); - glWindowPos2f := dglGetProcAddress('glWindowPos2f'); - glWindowPos2fv := dglGetProcAddress('glWindowPos2fv'); - glWindowPos2i := dglGetProcAddress('glWindowPos2i'); - glWindowPos2iv := dglGetProcAddress('glWindowPos2iv'); - glWindowPos2s := dglGetProcAddress('glWindowPos2s'); - glWindowPos2sv := dglGetProcAddress('glWindowPos2sv'); - glWindowPos3d := dglGetProcAddress('glWindowPos3d'); - glWindowPos3dv := dglGetProcAddress('glWindowPos3dv'); - glWindowPos3f := dglGetProcAddress('glWindowPos3f'); - glWindowPos3fv := dglGetProcAddress('glWindowPos3fv'); - glWindowPos3i := dglGetProcAddress('glWindowPos3i'); - glWindowPos3iv := dglGetProcAddress('glWindowPos3iv'); - glWindowPos3s := dglGetProcAddress('glWindowPos3s'); - glWindowPos3sv := dglGetProcAddress('glWindowPos3sv'); -{$endif} - - // GL_VERSION_1_5 - glGenQueries := dglGetProcAddress('glGenQueries'); - glDeleteQueries := dglGetProcAddress('glDeleteQueries'); - glIsQuery := dglGetProcAddress('glIsQuery'); - glBeginQuery := dglGetProcAddress('glBeginQuery'); - glEndQuery := dglGetProcAddress('glEndQuery'); - glGetQueryiv := dglGetProcAddress('glGetQueryiv'); - glGetQueryObjectiv := dglGetProcAddress('glGetQueryObjectiv'); - glGetQueryObjectuiv := dglGetProcAddress('glGetQueryObjectuiv'); - glBindBuffer := dglGetProcAddress('glBindBuffer'); - glDeleteBuffers := dglGetProcAddress('glDeleteBuffers'); - glGenBuffers := dglGetProcAddress('glGenBuffers'); - glIsBuffer := dglGetProcAddress('glIsBuffer'); - glBufferData := dglGetProcAddress('glBufferData'); - glBufferSubData := dglGetProcAddress('glBufferSubData'); - glGetBufferSubData := dglGetProcAddress('glGetBufferSubData'); - glMapBuffer := dglGetProcAddress('glMapBuffer'); - glUnmapBuffer := dglGetProcAddress('glUnmapBuffer'); - glGetBufferParameteriv := dglGetProcAddress('glGetBufferParameteriv'); - glGetBufferPointerv := dglGetProcAddress('glGetBufferPointerv'); - - // GL_VERSION_2_0 - glBlendEquationSeparate := dglGetProcAddress('glBlendEquationSeparate'); - glDrawBuffers := dglGetProcAddress('glDrawBuffers'); - glStencilOpSeparate := dglGetProcAddress('glStencilOpSeparate'); - glStencilFuncSeparate := dglGetProcAddress('glStencilFuncSeparate'); - glStencilMaskSeparate := dglGetProcAddress('glStencilMaskSeparate'); - glAttachShader := dglGetProcAddress('glAttachShader'); - glBindAttribLocation := dglGetProcAddress('glBindAttribLocation'); - glCompileShader := dglGetProcAddress('glCompileShader'); - glCreateProgram := dglGetProcAddress('glCreateProgram'); - glCreateShader := dglGetProcAddress('glCreateShader'); - glDeleteProgram := dglGetProcAddress('glDeleteProgram'); - glDeleteShader := dglGetProcAddress('glDeleteShader'); - glDetachShader := dglGetProcAddress('glDetachShader'); - glDisableVertexAttribArray := dglGetProcAddress('glDisableVertexAttribArray'); - glEnableVertexAttribArray := dglGetProcAddress('glEnableVertexAttribArray'); - glGetActiveAttrib := dglGetProcAddress('glGetActiveAttrib'); - glGetActiveUniform := dglGetProcAddress('glGetActiveUniform'); - glGetAttachedShaders := dglGetProcAddress('glGetAttachedShaders'); - glGetAttribLocation := dglGetProcAddress('glGetAttribLocation'); - glGetProgramiv := dglGetProcAddress('glGetProgramiv'); - glGetProgramInfoLog := dglGetProcAddress('glGetProgramInfoLog'); - glGetShaderiv := dglGetProcAddress('glGetShaderiv'); - glGetShaderInfoLog := dglGetProcAddress('glGetShaderInfoLog'); - glGetShaderSource := dglGetProcAddress('glGetShaderSource'); - glGetUniformLocation := dglGetProcAddress('glGetUniformLocation'); - glGetUniformfv := dglGetProcAddress('glGetUniformfv'); - glGetUniformiv := dglGetProcAddress('glGetUniformiv'); - glGetVertexAttribfv := dglGetProcAddress('glGetVertexAttribfv'); - glGetVertexAttribiv := dglGetProcAddress('glGetVertexAttribiv'); - glGetVertexAttribPointerv := dglGetProcAddress('glGetVertexAttribPointerv'); - glIsProgram := dglGetProcAddress('glIsProgram'); - glIsShader := dglGetProcAddress('glIsShader'); - glLinkProgram := dglGetProcAddress('glLinkProgram'); - glShaderSource := dglGetProcAddress('glShaderSource'); - glUseProgram := dglGetProcAddress('glUseProgram'); - glUniform1f := dglGetProcAddress('glUniform1f'); - glUniform2f := dglGetProcAddress('glUniform2f'); - glUniform3f := dglGetProcAddress('glUniform3f'); - glUniform4f := dglGetProcAddress('glUniform4f'); - glUniform1i := dglGetProcAddress('glUniform1i'); - glUniform2i := dglGetProcAddress('glUniform2i'); - glUniform3i := dglGetProcAddress('glUniform3i'); - glUniform4i := dglGetProcAddress('glUniform4i'); - glUniform1fv := dglGetProcAddress('glUniform1fv'); - glUniform2fv := dglGetProcAddress('glUniform2fv'); - glUniform3fv := dglGetProcAddress('glUniform3fv'); - glUniform4fv := dglGetProcAddress('glUniform4fv'); - glUniform1iv := dglGetProcAddress('glUniform1iv'); - glUniform2iv := dglGetProcAddress('glUniform2iv'); - glUniform3iv := dglGetProcAddress('glUniform3iv'); - glUniform4iv := dglGetProcAddress('glUniform4iv'); - glUniformMatrix2fv := dglGetProcAddress('glUniformMatrix2fv'); - glUniformMatrix3fv := dglGetProcAddress('glUniformMatrix3fv'); - glUniformMatrix4fv := dglGetProcAddress('glUniformMatrix4fv'); - glValidateProgram := dglGetProcAddress('glValidateProgram'); - glVertexAttrib1d := dglGetProcAddress('glVertexAttrib1d'); - glVertexAttrib1dv := dglGetProcAddress('glVertexAttrib1dv'); - glVertexAttrib1f := dglGetProcAddress('glVertexAttrib1f'); - glVertexAttrib1fv := dglGetProcAddress('glVertexAttrib1fv'); - glVertexAttrib1s := dglGetProcAddress('glVertexAttrib1s'); - glVertexAttrib1sv := dglGetProcAddress('glVertexAttrib1sv'); - glVertexAttrib2d := dglGetProcAddress('glVertexAttrib2d'); - glVertexAttrib2dv := dglGetProcAddress('glVertexAttrib2dv'); - glVertexAttrib2f := dglGetProcAddress('glVertexAttrib2f'); - glVertexAttrib2fv := dglGetProcAddress('glVertexAttrib2fv'); - glVertexAttrib2s := dglGetProcAddress('glVertexAttrib2s'); - glVertexAttrib2sv := dglGetProcAddress('glVertexAttrib2sv'); - glVertexAttrib3d := dglGetProcAddress('glVertexAttrib3d'); - glVertexAttrib3dv := dglGetProcAddress('glVertexAttrib3dv'); - glVertexAttrib3f := dglGetProcAddress('glVertexAttrib3f'); - glVertexAttrib3fv := dglGetProcAddress('glVertexAttrib3fv'); - glVertexAttrib3s := dglGetProcAddress('glVertexAttrib3s'); - glVertexAttrib3sv := dglGetProcAddress('glVertexAttrib3sv'); - glVertexAttrib4Nbv := dglGetProcAddress('glVertexAttrib4Nbv'); - glVertexAttrib4Niv := dglGetProcAddress('glVertexAttrib4Niv'); - glVertexAttrib4Nsv := dglGetProcAddress('glVertexAttrib4Nsv'); - glVertexAttrib4Nub := dglGetProcAddress('glVertexAttrib4Nub'); - glVertexAttrib4Nubv := dglGetProcAddress('glVertexAttrib4Nubv'); - glVertexAttrib4Nuiv := dglGetProcAddress('glVertexAttrib4Nuiv'); - glVertexAttrib4Nusv := dglGetProcAddress('glVertexAttrib4Nusv'); - glVertexAttrib4bv := dglGetProcAddress('glVertexAttrib4bv'); - glVertexAttrib4d := dglGetProcAddress('glVertexAttrib4d'); - glVertexAttrib4dv := dglGetProcAddress('glVertexAttrib4dv'); - glVertexAttrib4f := dglGetProcAddress('glVertexAttrib4f'); - glVertexAttrib4fv := dglGetProcAddress('glVertexAttrib4fv'); - glVertexAttrib4iv := dglGetProcAddress('glVertexAttrib4iv'); - glVertexAttrib4s := dglGetProcAddress('glVertexAttrib4s'); - glVertexAttrib4sv := dglGetProcAddress('glVertexAttrib4sv'); - glVertexAttrib4ubv := dglGetProcAddress('glVertexAttrib4ubv'); - glVertexAttrib4uiv := dglGetProcAddress('glVertexAttrib4uiv'); - glVertexAttrib4usv := dglGetProcAddress('glVertexAttrib4usv'); - glVertexAttribPointer := dglGetProcAddress('glVertexAttribPointer'); - - // GL_VERSION_2_1 - glUniformMatrix2x3fv := dglGetProcAddress('glUniformMatrix2x3fv'); - glUniformMatrix3x2fv := dglGetProcAddress('glUniformMatrix3x2fv'); - glUniformMatrix2x4fv := dglGetProcAddress('glUniformMatrix2x4fv'); - glUniformMatrix4x2fv := dglGetProcAddress('glUniformMatrix4x2fv'); - glUniformMatrix3x4fv := dglGetProcAddress('glUniformMatrix3x4fv'); - glUniformMatrix4x3fv := dglGetProcAddress('glUniformMatrix4x3fv'); - - // GL_VERSION_3_0 - { OpenGL 3.0 also reuses entry points from these extensions: } - Read_GL_ARB_framebuffer_object; - Read_GL_ARB_map_buffer_range; - Read_GL_ARB_vertex_array_object; - - glColorMaski := dglGetProcAddress('glColorMaski'); - glGetBooleani_v := dglGetProcAddress('glGetBooleani_v'); - glGetIntegeri_v := dglGetProcAddress('glGetIntegeri_v'); - glEnablei := dglGetProcAddress('glEnablei'); - glDisablei := dglGetProcAddress('glDisablei'); - glIsEnabledi := dglGetProcAddress('glIsEnabledi'); - glBeginTransformFeedback := dglGetProcAddress('glBeginTransformFeedback'); - glEndTransformFeedback := dglGetProcAddress('glEndTransformFeedback'); - glBindBufferRange := dglGetProcAddress('glBindBufferRange'); - glBindBufferBase := dglGetProcAddress('glBindBufferBase'); - glTransformFeedbackVaryings := dglGetProcAddress('glTransformFeedbackVaryings'); - glGetTransformFeedbackVarying := dglGetProcAddress('glGetTransformFeedbackVarying'); - glClampColor := dglGetProcAddress('glClampColor'); - glBeginConditionalRender := dglGetProcAddress('glBeginConditionalRender'); - glEndConditionalRender := dglGetProcAddress('glEndConditionalRender'); - glVertexAttribI1i := dglGetProcAddress('glVertexAttribI1i'); - glVertexAttribI2i := dglGetProcAddress('glVertexAttribI2i'); - glVertexAttribI3i := dglGetProcAddress('glVertexAttribI3i'); - glVertexAttribI4i := dglGetProcAddress('glVertexAttribI4i'); - glVertexAttribI1ui := dglGetProcAddress('glVertexAttribI1ui'); - glVertexAttribI2ui := dglGetProcAddress('glVertexAttribI2ui'); - glVertexAttribI3ui := dglGetProcAddress('glVertexAttribI3ui'); - glVertexAttribI4ui := dglGetProcAddress('glVertexAttribI4ui'); - glVertexAttribI1iv := dglGetProcAddress('glVertexAttribI1iv'); - glVertexAttribI2iv := dglGetProcAddress('glVertexAttribI2iv'); - glVertexAttribI3iv := dglGetProcAddress('glVertexAttribI3iv'); - glVertexAttribI4iv := dglGetProcAddress('glVertexAttribI4iv'); - glVertexAttribI1uiv := dglGetProcAddress('glVertexAttribI1uiv'); - glVertexAttribI2uiv := dglGetProcAddress('glVertexAttribI2uiv'); - glVertexAttribI3uiv := dglGetProcAddress('glVertexAttribI3uiv'); - glVertexAttribI4uiv := dglGetProcAddress('glVertexAttribI4uiv'); - glVertexAttribI4bv := dglGetProcAddress('glVertexAttribI4bv'); - glVertexAttribI4sv := dglGetProcAddress('glVertexAttribI4sv'); - glVertexAttribI4ubv := dglGetProcAddress('glVertexAttribI4ubv'); - glVertexAttribI4usv := dglGetProcAddress('glVertexAttribI4usv'); - glVertexAttribIPointer := dglGetProcAddress('glVertexAttribIPointer'); - glGetVertexAttribIiv := dglGetProcAddress('glGetVertexAttribIiv'); - glGetVertexAttribIuiv := dglGetProcAddress('glGetVertexAttribIuiv'); - glGetUniformuiv := dglGetProcAddress('glGetUniformuiv'); - glBindFragDataLocation := dglGetProcAddress('glBindFragDataLocation'); - glGetFragDataLocation := dglGetProcAddress('glGetFragDataLocation'); - glUniform1ui := dglGetProcAddress('glUniform1ui'); - glUniform2ui := dglGetProcAddress('glUniform2ui'); - glUniform3ui := dglGetProcAddress('glUniform3ui'); - glUniform4ui := dglGetProcAddress('glUniform4ui'); - glUniform1uiv := dglGetProcAddress('glUniform1uiv'); - glUniform2uiv := dglGetProcAddress('glUniform2uiv'); - glUniform3uiv := dglGetProcAddress('glUniform3uiv'); - glUniform4uiv := dglGetProcAddress('glUniform4uiv'); - glTexParameterIiv := dglGetProcAddress('glTexParameterIiv'); - glTexParameterIuiv := dglGetProcAddress('glTexParameterIuiv'); - glGetTexParameterIiv := dglGetProcAddress('glGetTexParameterIiv'); - glGetTexParameterIuiv := dglGetProcAddress('glGetTexParameterIuiv'); - glClearBufferiv := dglGetProcAddress('glClearBufferiv'); - glClearBufferuiv := dglGetProcAddress('glClearBufferuiv'); - glClearBufferfv := dglGetProcAddress('glClearBufferfv'); - glClearBufferfi := dglGetProcAddress('glClearBufferfi'); - glGetStringi := dglGetProcAddress('glGetStringi'); - - // GL_VERSION_3_1 - { OpenGL 3.1 also reuses entry points from these extensions: } - Read_GL_ARB_copy_buffer; - Read_GL_ARB_uniform_buffer_object; - - glDrawArraysInstanced := dglGetProcAddress('glDrawArraysInstanced'); - glDrawElementsInstanced := dglGetProcAddress('glDrawElementsInstanced'); - glTexBuffer := dglGetProcAddress('glTexBuffer'); - glPrimitiveRestartIndex := dglGetProcAddress('glPrimitiveRestartIndex'); - - // GL_VERSION_3_2 - { OpenGL 3.2 also reuses entry points from these extensions: } - Read_GL_ARB_draw_elements_base_vertex; - Read_GL_ARB_provoking_vertex; - Read_GL_ARB_sync; - Read_GL_ARB_texture_multisample; - - glGetInteger64i_v := dglGetProcAddress('glGetInteger64i_v'); - glGetBufferParameteri64v := dglGetProcAddress('glGetBufferParameteri64v'); - glFramebufferTexture := dglGetProcAddress('glFramebufferTexture'); -// glFramebufferTextureFace := dglGetProcAddress('glFramebufferTextureFace'); - - // GL_VERSION_3_3 - { OpenGL 3.3 also reuses entry points from these extensions: } - Read_GL_ARB_blend_func_extended; - Read_GL_ARB_sampler_objects; - { ARB_explicit_attrib_location, but it has none } - { ARB_occlusion_query2 (no entry points) } - { ARB_shader_bit_encoding (no entry points) } - { ARB_texture_rgb10_a2ui (no entry points) } - { ARB_texture_swizzle (no entry points) } - Read_GL_ARB_timer_query; - Read_GL_ARB_vertex_type_2_10_10_10_rev; - - glVertexAttribDivisor := dglGetProcAddress('glVertexAttribDivisor'); - - // GL_VERSION_4_0 - { OpenGL 4.0 also reuses entry points from these extensions: } - { ARB_texture_query_lod (no entry points) } - Read_GL_ARB_draw_indirect; - { ARB_gpu_shader5 (no entry points) } - Read_GL_ARB_gpu_shader_fp64; - Read_GL_ARB_shader_subroutine; - Read_GL_ARB_tessellation_shader; - { ARB_texture_buffer_object_rgb32 (no entry points) } - { ARB_texture_cube_map_array (no entry points) } - { ARB_texture_gather (no entry points) } - Read_GL_ARB_transform_feedback2; - Read_GL_ARB_transform_feedback3; - - glMinSampleShading := dglGetProcAddress('glMinSampleShading'); - glBlendEquationi := dglGetProcAddress('glBlendEquationi'); - glBlendEquationSeparatei := dglGetProcAddress('glBlendEquationSeparatei'); - glBlendFunci := dglGetProcAddress('glBlendFunci'); - glBlendFuncSeparatei := dglGetProcAddress('glBlendFuncSeparatei'); - - // GL_VERSION_4_1 - { OpenGL 4.1 also reuses entry points from these extensions: } - Read_GL_ARB_ES2_compatibility; - Read_GL_ARB_get_program_binary; - Read_GL_ARB_separate_shader_objects; - { ARB_shader_precision (no entry points) } - Read_GL_ARB_vertex_attrib_64bit; - Read_GL_ARB_viewport_array; - - // GL_VERSION_4_2 - { OpenGL 4.2 reuses entry points from these extensions: } - Read_GL_ARB_base_instance; - //Read_GL_ARB_shading_language_420pack (no entry points) - Read_GL_ARB_transform_feedback_instanced; - //Read_GL_ARB_compressed_texture_pixel_storage (no entry points) - //Read_GL_ARB_conservative_depth; - Read_GL_ARB_internalformat_query; - //Read_GL_ARB_map_buffer_alignment; - Read_GL_ARB_shader_atomic_counters; - Read_GL_ARB_shader_image_load_store; - //Read_GL_ARB_shading_language_packing; - Read_GL_ARB_texture_storage; - - // GL_VERSION_4_3 - // OpenGL 4.3 reuses entry points from these extensions: - // Read_GL_ARB_arrays_of_arrays (none, GLSL only) (no entry points) - // Read_GL_ARB_fragment_layer_viewport (none, GLSL only) (no entry points) - // Read_GL_ARB_shader_image_size (none, GLSL only) (no entry points) - // Read_GL_ARB_ES3_compatibility (no entry points) - Read_GL_ARB_clear_buffer_object; - Read_GL_ARB_compute_shader; - Read_GL_ARB_copy_image; - Read_GL_KHR_debug; - // Read_GL_ARB_explicit_uniform_location (no entry points) - Read_GL_ARB_framebuffer_no_attachments; - Read_GL_ARB_internalformat_query2; - Read_GL_ARB_invalidate_subdata; - Read_GL_ARB_multi_draw_indirect; - Read_GL_ARB_program_interface_query; - // Read_GL_ARB_robust_buffer_access_behavior (none) (no entry points) - Read_GL_ARB_shader_storage_buffer_object; - // Read_GL_ARB_stencil_texturing (no entry points) - Read_GL_ARB_texture_buffer_range; - // Read_GL_ARB_texture_query_levels (none) (no entry points) - Read_GL_ARB_texture_storage_multisample; - Read_GL_ARB_texture_view; - Read_GL_ARB_vertex_attrib_binding; -end; - -procedure Read_GL_3DFX_tbuffer; -begin - glTbufferMask3DFX := dglGetProcAddress('glTbufferMask3DFX'); -end; - -procedure Read_GL_APPLE_element_array; -begin - glElementPointerAPPLE := dglGetProcAddress('glElementPointerAPPLE'); - glDrawElementArrayAPPLE := dglGetProcAddress('glDrawElementArrayAPPLE'); - glDrawRangeElementArrayAPPLE := dglGetProcAddress('glDrawRangeElementArrayAPPLE'); - glMultiDrawElementArrayAPPLE := dglGetProcAddress('glMultiDrawElementArrayAPPLE'); - glMultiDrawRangeElementArrayAPPLE := dglGetProcAddress('glMultiDrawRangeElementArrayAPPLE'); -end; - -procedure Read_GL_APPLE_fence; -begin - glGenFencesAPPLE := dglGetProcAddress('glGenFencesAPPLE'); - glDeleteFencesAPPLE := dglGetProcAddress('glDeleteFencesAPPLE'); - glSetFenceAPPLE := dglGetProcAddress('glSetFenceAPPLE'); - glIsFenceAPPLE := dglGetProcAddress('glIsFenceAPPLE'); - glTestFenceAPPLE := dglGetProcAddress('glTestFenceAPPLE'); - glFinishFenceAPPLE := dglGetProcAddress('glFinishFenceAPPLE'); - glTestObjectAPPLE := dglGetProcAddress('glTestObjectAPPLE'); - glFinishObjectAPPLE := dglGetProcAddress('glFinishObjectAPPLE'); -end; - -procedure Read_GL_APPLE_vertex_array_object; -begin - glBindVertexArrayAPPLE := dglGetProcAddress('glBindVertexArrayAPPLE'); - glDeleteVertexArraysAPPLE := dglGetProcAddress('glDeleteVertexArraysAPPLE'); - glGenVertexArraysAPPLE := dglGetProcAddress('glGenVertexArraysAPPLE'); - glIsVertexArrayAPPLE := dglGetProcAddress('glIsVertexArrayAPPLE'); -end; - -procedure Read_GL_APPLE_vertex_array_range; -begin - glVertexArrayRangeAPPLE := dglGetProcAddress('glVertexArrayRangeAPPLE'); - glFlushVertexArrayRangeAPPLE := dglGetProcAddress('glFlushVertexArrayRangeAPPLE'); - glVertexArrayParameteriAPPLE := dglGetProcAddress('glVertexArrayParameteriAPPLE'); -end; - -procedure Read_GL_APPLE_texture_range; -begin - glTextureRangeAPPLE := dglGetProcAddress('glTextureRangeAPPLE'); - glGetTexParameterPointervAPPLE := dglGetProcAddress('glGetTexParameterPointervAPPLE'); -end; - -procedure Read_GL_APPLE_vertex_program_evaluators; -begin - glEnableVertexAttribAPPLE := dglGetProcAddress('glEnableVertexAttribAPPLE'); - glDisableVertexAttribAPPLE := dglGetProcAddress('glDisableVertexAttribAPPLE'); - glIsVertexAttribEnabledAPPLE := dglGetProcAddress('glIsVertexAttribEnabledAPPLE'); - glMapVertexAttrib1dAPPLE := dglGetProcAddress('glMapVertexAttrib1dAPPLE'); - glMapVertexAttrib1fAPPLE := dglGetProcAddress('glMapVertexAttrib1fAPPLE'); - glMapVertexAttrib2dAPPLE := dglGetProcAddress('glMapVertexAttrib2dAPPLE'); - glMapVertexAttrib2fAPPLE := dglGetProcAddress('glMapVertexAttrib2fAPPLE'); -end; - -procedure Read_GL_APPLE_object_purgeable; -begin - glObjectPurgeableAPPLE := dglGetProcAddress('glObjectPurgeableAPPLE'); - glObjectUnpurgeableAPPLE := dglGetProcAddress('glObjectUnpurgeableAPPLE'); - glGetObjectParameterivAPPLE := dglGetProcAddress('glGetObjectParameterivAPPLE'); -end; - -procedure Read_GL_ARB_matrix_palette; -begin - glCurrentPaletteMatrixARB := dglGetProcAddress('glCurrentPaletteMatrixARB'); - glMatrixIndexubvARB := dglGetProcAddress('glMatrixIndexubvARB'); - glMatrixIndexusvARB := dglGetProcAddress('glMatrixIndexusvARB'); - glMatrixIndexuivARB := dglGetProcAddress('glMatrixIndexuivARB'); - glMatrixIndexPointerARB := dglGetProcAddress('glMatrixIndexPointerARB'); -end; - -procedure Read_GL_ARB_multisample; -begin - glSampleCoverageARB := dglGetProcAddress('glSampleCoverageARB'); -end; - -procedure Read_GL_ARB_multitexture; -begin - glActiveTextureARB := dglGetProcAddress('glActiveTextureARB'); - glClientActiveTextureARB := dglGetProcAddress('glClientActiveTextureARB'); - glMultiTexCoord1dARB := dglGetProcAddress('glMultiTexCoord1dARB'); - glMultiTexCoord1dvARB := dglGetProcAddress('glMultiTexCoord1dvARB'); - glMultiTexCoord1fARB := dglGetProcAddress('glMultiTexCoord1fARB'); - glMultiTexCoord1fvARB := dglGetProcAddress('glMultiTexCoord1fvARB'); - glMultiTexCoord1iARB := dglGetProcAddress('glMultiTexCoord1iARB'); - glMultiTexCoord1ivARB := dglGetProcAddress('glMultiTexCoord1ivARB'); - glMultiTexCoord1sARB := dglGetProcAddress('glMultiTexCoord1sARB'); - glMultiTexCoord1svARB := dglGetProcAddress('glMultiTexCoord1svARB'); - glMultiTexCoord2dARB := dglGetProcAddress('glMultiTexCoord2dARB'); - glMultiTexCoord2dvARB := dglGetProcAddress('glMultiTexCoord2dvARB'); - glMultiTexCoord2fARB := dglGetProcAddress('glMultiTexCoord2fARB'); - glMultiTexCoord2fvARB := dglGetProcAddress('glMultiTexCoord2fvARB'); - glMultiTexCoord2iARB := dglGetProcAddress('glMultiTexCoord2iARB'); - glMultiTexCoord2ivARB := dglGetProcAddress('glMultiTexCoord2ivARB'); - glMultiTexCoord2sARB := dglGetProcAddress('glMultiTexCoord2sARB'); - glMultiTexCoord2svARB := dglGetProcAddress('glMultiTexCoord2svARB'); - glMultiTexCoord3dARB := dglGetProcAddress('glMultiTexCoord3dARB'); - glMultiTexCoord3dvARB := dglGetProcAddress('glMultiTexCoord3dvARB'); - glMultiTexCoord3fARB := dglGetProcAddress('glMultiTexCoord3fARB'); - glMultiTexCoord3fvARB := dglGetProcAddress('glMultiTexCoord3fvARB'); - glMultiTexCoord3iARB := dglGetProcAddress('glMultiTexCoord3iARB'); - glMultiTexCoord3ivARB := dglGetProcAddress('glMultiTexCoord3ivARB'); - glMultiTexCoord3sARB := dglGetProcAddress('glMultiTexCoord3sARB'); - glMultiTexCoord3svARB := dglGetProcAddress('glMultiTexCoord3svARB'); - glMultiTexCoord4dARB := dglGetProcAddress('glMultiTexCoord4dARB'); - glMultiTexCoord4dvARB := dglGetProcAddress('glMultiTexCoord4dvARB'); - glMultiTexCoord4fARB := dglGetProcAddress('glMultiTexCoord4fARB'); - glMultiTexCoord4fvARB := dglGetProcAddress('glMultiTexCoord4fvARB'); - glMultiTexCoord4iARB := dglGetProcAddress('glMultiTexCoord4iARB'); - glMultiTexCoord4ivARB := dglGetProcAddress('glMultiTexCoord4ivARB'); - glMultiTexCoord4sARB := dglGetProcAddress('glMultiTexCoord4sARB'); - glMultiTexCoord4svARB := dglGetProcAddress('glMultiTexCoord4svARB'); -end; - -procedure Read_GL_ARB_point_parameters; -begin - glPointParameterfARB := dglGetProcAddress('glPointParameterfARB'); - glPointParameterfvARB := dglGetProcAddress('glPointParameterfvARB'); -end; - -procedure Read_GL_ARB_texture_compression; -begin - glCompressedTexImage3DARB := dglGetProcAddress('glCompressedTexImage3DARB'); - glCompressedTexImage2DARB := dglGetProcAddress('glCompressedTexImage2DARB'); - glCompressedTexImage1DARB := dglGetProcAddress('glCompressedTexImage1DARB'); - glCompressedTexSubImage3DARB := dglGetProcAddress('glCompressedTexSubImage3DARB'); - glCompressedTexSubImage2DARB := dglGetProcAddress('glCompressedTexSubImage2DARB'); - glCompressedTexSubImage1DARB := dglGetProcAddress('glCompressedTexSubImage1DARB'); - glGetCompressedTexImageARB := dglGetProcAddress('glGetCompressedTexImageARB'); -end; - -procedure Read_GL_ARB_transpose_matrix; -begin - glLoadTransposeMatrixfARB := dglGetProcAddress('glLoadTransposeMatrixfARB'); - glLoadTransposeMatrixdARB := dglGetProcAddress('glLoadTransposeMatrixdARB'); - glMultTransposeMatrixfARB := dglGetProcAddress('glMultTransposeMatrixfARB'); - glMultTransposeMatrixdARB := dglGetProcAddress('glMultTransposeMatrixdARB'); -end; - -procedure Read_GL_ARB_vertex_blend; -begin - glWeightbvARB := dglGetProcAddress('glWeightbvARB'); - glWeightsvARB := dglGetProcAddress('glWeightsvARB'); - glWeightivARB := dglGetProcAddress('glWeightivARB'); - glWeightfvARB := dglGetProcAddress('glWeightfvARB'); - glWeightdvARB := dglGetProcAddress('glWeightdvARB'); - glWeightubvARB := dglGetProcAddress('glWeightubvARB'); - glWeightusvARB := dglGetProcAddress('glWeightusvARB'); - glWeightuivARB := dglGetProcAddress('glWeightuivARB'); - glWeightPointerARB := dglGetProcAddress('glWeightPointerARB'); - glVertexBlendARB := dglGetProcAddress('glVertexBlendARB'); -end; - -procedure Read_GL_ARB_vertex_buffer_object; -begin - glBindBufferARB := dglGetProcAddress('glBindBufferARB'); - glDeleteBuffersARB := dglGetProcAddress('glDeleteBuffersARB'); - glGenBuffersARB := dglGetProcAddress('glGenBuffersARB'); - glIsBufferARB := dglGetProcAddress('glIsBufferARB'); - glBufferDataARB := dglGetProcAddress('glBufferDataARB'); - glBufferSubDataARB := dglGetProcAddress('glBufferSubDataARB'); - glGetBufferSubDataARB := dglGetProcAddress('glGetBufferSubDataARB'); - glMapBufferARB := dglGetProcAddress('glMapBufferARB'); - glUnmapBufferARB := dglGetProcAddress('glUnmapBufferARB'); - glGetBufferParameterivARB := dglGetProcAddress('glGetBufferParameterivARB'); - glGetBufferPointervARB := dglGetProcAddress('glGetBufferPointervARB'); -end; - -procedure Read_GL_ARB_vertex_program; -begin - glVertexAttrib1dARB := dglGetProcAddress('glVertexAttrib1dARB'); - glVertexAttrib1dvARB := dglGetProcAddress('glVertexAttrib1dvARB'); - glVertexAttrib1fARB := dglGetProcAddress('glVertexAttrib1fARB'); - glVertexAttrib1fvARB := dglGetProcAddress('glVertexAttrib1fvARB'); - glVertexAttrib1sARB := dglGetProcAddress('glVertexAttrib1sARB'); - glVertexAttrib1svARB := dglGetProcAddress('glVertexAttrib1svARB'); - glVertexAttrib2dARB := dglGetProcAddress('glVertexAttrib2dARB'); - glVertexAttrib2dvARB := dglGetProcAddress('glVertexAttrib2dvARB'); - glVertexAttrib2fARB := dglGetProcAddress('glVertexAttrib2fARB'); - glVertexAttrib2fvARB := dglGetProcAddress('glVertexAttrib2fvARB'); - glVertexAttrib2sARB := dglGetProcAddress('glVertexAttrib2sARB'); - glVertexAttrib2svARB := dglGetProcAddress('glVertexAttrib2svARB'); - glVertexAttrib3dARB := dglGetProcAddress('glVertexAttrib3dARB'); - glVertexAttrib3dvARB := dglGetProcAddress('glVertexAttrib3dvARB'); - glVertexAttrib3fARB := dglGetProcAddress('glVertexAttrib3fARB'); - glVertexAttrib3fvARB := dglGetProcAddress('glVertexAttrib3fvARB'); - glVertexAttrib3sARB := dglGetProcAddress('glVertexAttrib3sARB'); - glVertexAttrib3svARB := dglGetProcAddress('glVertexAttrib3svARB'); - glVertexAttrib4NbvARB := dglGetProcAddress('glVertexAttrib4NbvARB'); - glVertexAttrib4NivARB := dglGetProcAddress('glVertexAttrib4NivARB'); - glVertexAttrib4NsvARB := dglGetProcAddress('glVertexAttrib4NsvARB'); - glVertexAttrib4NubARB := dglGetProcAddress('glVertexAttrib4NubARB'); - glVertexAttrib4NubvARB := dglGetProcAddress('glVertexAttrib4NubvARB'); - glVertexAttrib4NuivARB := dglGetProcAddress('glVertexAttrib4NuivARB'); - glVertexAttrib4NusvARB := dglGetProcAddress('glVertexAttrib4NusvARB'); - glVertexAttrib4bvARB := dglGetProcAddress('glVertexAttrib4bvARB'); - glVertexAttrib4dARB := dglGetProcAddress('glVertexAttrib4dARB'); - glVertexAttrib4dvARB := dglGetProcAddress('glVertexAttrib4dvARB'); - glVertexAttrib4fARB := dglGetProcAddress('glVertexAttrib4fARB'); - glVertexAttrib4fvARB := dglGetProcAddress('glVertexAttrib4fvARB'); - glVertexAttrib4ivARB := dglGetProcAddress('glVertexAttrib4ivARB'); - glVertexAttrib4sARB := dglGetProcAddress('glVertexAttrib4sARB'); - glVertexAttrib4svARB := dglGetProcAddress('glVertexAttrib4svARB'); - glVertexAttrib4ubvARB := dglGetProcAddress('glVertexAttrib4ubvARB'); - glVertexAttrib4uivARB := dglGetProcAddress('glVertexAttrib4uivARB'); - glVertexAttrib4usvARB := dglGetProcAddress('glVertexAttrib4usvARB'); - glVertexAttribPointerARB := dglGetProcAddress('glVertexAttribPointerARB'); - glEnableVertexAttribArrayARB := dglGetProcAddress('glEnableVertexAttribArrayARB'); - glDisableVertexAttribArrayARB := dglGetProcAddress('glDisableVertexAttribArrayARB'); - glProgramStringARB := dglGetProcAddress('glProgramStringARB'); - glBindProgramARB := dglGetProcAddress('glBindProgramARB'); - glDeleteProgramsARB := dglGetProcAddress('glDeleteProgramsARB'); - glGenProgramsARB := dglGetProcAddress('glGenProgramsARB'); - glProgramEnvParameter4dARB := dglGetProcAddress('glProgramEnvParameter4dARB'); - glProgramEnvParameter4dvARB := dglGetProcAddress('glProgramEnvParameter4dvARB'); - glProgramEnvParameter4fARB := dglGetProcAddress('glProgramEnvParameter4fARB'); - glProgramEnvParameter4fvARB := dglGetProcAddress('glProgramEnvParameter4fvARB'); - glProgramLocalParameter4dARB := dglGetProcAddress('glProgramLocalParameter4dARB'); - glProgramLocalParameter4dvARB := dglGetProcAddress('glProgramLocalParameter4dvARB'); - glProgramLocalParameter4fARB := dglGetProcAddress('glProgramLocalParameter4fARB'); - glProgramLocalParameter4fvARB := dglGetProcAddress('glProgramLocalParameter4fvARB'); - glGetProgramEnvParameterdvARB := dglGetProcAddress('glGetProgramEnvParameterdvARB'); - glGetProgramEnvParameterfvARB := dglGetProcAddress('glGetProgramEnvParameterfvARB'); - glGetProgramLocalParameterdvARB := dglGetProcAddress('glGetProgramLocalParameterdvARB'); - glGetProgramLocalParameterfvARB := dglGetProcAddress('glGetProgramLocalParameterfvARB'); - glGetProgramivARB := dglGetProcAddress('glGetProgramivARB'); - glGetProgramStringARB := dglGetProcAddress('glGetProgramStringARB'); - glGetVertexAttribdvARB := dglGetProcAddress('glGetVertexAttribdvARB'); - glGetVertexAttribfvARB := dglGetProcAddress('glGetVertexAttribfvARB'); - glGetVertexAttribivARB := dglGetProcAddress('glGetVertexAttribivARB'); - glGetVertexAttribPointervARB := dglGetProcAddress('glGetVertexAttribPointervARB'); - glIsProgramARB := dglGetProcAddress('glIsProgramARB'); -end; - -procedure Read_GL_ARB_window_pos; -begin - glWindowPos2dARB := dglGetProcAddress('glWindowPos2dARB'); - glWindowPos2dvARB := dglGetProcAddress('glWindowPos2dvARB'); - glWindowPos2fARB := dglGetProcAddress('glWindowPos2fARB'); - glWindowPos2fvARB := dglGetProcAddress('glWindowPos2fvARB'); - glWindowPos2iARB := dglGetProcAddress('glWindowPos2iARB'); - glWindowPos2ivARB := dglGetProcAddress('glWindowPos2ivARB'); - glWindowPos2sARB := dglGetProcAddress('glWindowPos2sARB'); - glWindowPos2svARB := dglGetProcAddress('glWindowPos2svARB'); - glWindowPos3dARB := dglGetProcAddress('glWindowPos3dARB'); - glWindowPos3dvARB := dglGetProcAddress('glWindowPos3dvARB'); - glWindowPos3fARB := dglGetProcAddress('glWindowPos3fARB'); - glWindowPos3fvARB := dglGetProcAddress('glWindowPos3fvARB'); - glWindowPos3iARB := dglGetProcAddress('glWindowPos3iARB'); - glWindowPos3ivARB := dglGetProcAddress('glWindowPos3ivARB'); - glWindowPos3sARB := dglGetProcAddress('glWindowPos3sARB'); - glWindowPos3svARB := dglGetProcAddress('glWindowPos3svARB'); -end; - -procedure Read_GL_ARB_draw_buffers; -begin - glDrawBuffersARB := dglGetProcAddress('glDrawBuffersARB'); -end; - -procedure Read_GL_ARB_color_buffer_float; -begin - glClampColorARB := dglGetProcAddress('glClampColorARB'); -end; - -procedure Read_GL_ARB_Shader_Objects; -begin - // GL_ARB_Shader_Objects - glCreateShaderObjectARB := dglGetProcAddress('glCreateShaderObjectARB'); - glShaderSourceARB := dglGetProcAddress('glShaderSourceARB'); - glCompileShaderARB := dglGetProcAddress('glCompileShaderARB'); - glDeleteObjectARB := dglGetProcAddress('glDeleteObjectARB'); - glGetHandleARB := dglGetProcAddress('glGetHandleARB'); - glDetachObjectARB := dglGetProcAddress('glDetachObjectARB'); - glCreateProgramObjectARB := dglGetProcAddress('glCreateProgramObjectARB'); - glAttachObjectARB := dglGetProcAddress('glAttachObjectARB'); - glLinkProgramARB := dglGetProcAddress('glLinkProgramARB'); - glUseProgramObjectARB := dglGetProcAddress('glUseProgramObjectARB'); - glValidateProgramARB := dglGetProcAddress('glValidateProgramARB'); - glGetObjectParameterfvARB := dglGetProcAddress('glGetObjectParameterfvARB'); - glGetObjectParameterivARB := dglGetProcAddress('glGetObjectParameterivARB'); - glGetActiveUniformARB := dglGetProcAddress('glGetActiveUniformARB'); - glGetAttachedObjectsARB := dglGetProcAddress('glGetAttachedObjectsARB'); - glGetShaderSourceARB := dglGetProcAddress('glGetShaderSourceARB'); - glGetUniformfvARB := dglGetProcAddress('glGetUniformfvARB'); - glGetUniformivARB := dglGetProcAddress('glGetUniformivARB'); - glGetUniformLocationARB := dglGetProcAddress('glGetUniformLocationARB'); - glGetInfoLogARB := dglGetProcAddress('glGetInfoLogARB'); - glUniform1fARB := dglGetProcAddress('glUniform1fARB'); - glUniform2fARB := dglGetProcAddress('glUniform2fARB'); - glUniform3fARB := dglGetProcAddress('glUniform3fARB'); - glUniform4fARB := dglGetProcAddress('glUniform4fARB'); - glUniform1iARB := dglGetProcAddress('glUniform1iARB'); - glUniform2iARB := dglGetProcAddress('glUniform2iARB'); - glUniform3iARB := dglGetProcAddress('glUniform3iARB'); - glUniform4iARB := dglGetProcAddress('glUniform4iARB'); - glUniform1fvARB := dglGetProcAddress('glUniform1fvARB'); - glUniform2fvARB := dglGetProcAddress('glUniform2fvARB'); - glUniform3fvARB := dglGetProcAddress('glUniform3fvARB'); - glUniform4fvARB := dglGetProcAddress('glUniform4fvARB'); - glUniform1ivARB := dglGetProcAddress('glUniform1ivARB'); - glUniform2ivARB := dglGetProcAddress('glUniform2ivARB'); - glUniform3ivARB := dglGetProcAddress('glUniform3ivARB'); - glUniform4ivARB := dglGetProcAddress('glUniform4ivARB'); - glUniformMatrix2fvARB := dglGetProcAddress('glUniformMatrix2fvARB'); - glUniformMatrix3fvARB := dglGetProcAddress('glUniformMatrix3fvARB'); - glUniformMatrix4fvARB := dglGetProcAddress('glUniformMatrix4fvARB'); - - // GL_ARB_vertex_shader - glGetActiveAttribARB := dglGetProcAddress('glGetActiveAttribARB'); - glGetAttribLocationARB := dglGetProcAddress('glGetAttribLocationARB'); - glBindAttribLocationARB := dglGetProcAddress('glBindAttribLocationARB'); - glGetVertexAttribPointervARB := dglGetProcAddress('glGetVertexAttribPointervARB'); -end; - -procedure Read_GL_ARB_occlusion_query; -begin - glGenQueriesARB := dglGetProcAddress('glGenQueriesARB'); - glDeleteQueriesARB := dglGetProcAddress('glDeleteQueriesARB'); - glIsQueryARB := dglGetProcAddress('glIsQueryARB'); - glBeginQueryARB := dglGetProcAddress('glBeginQueryARB'); - glEndQueryARB := dglGetProcAddress('glEndQueryARB'); - glGetQueryivARB := dglGetProcAddress('glGetQueryivARB'); - glGetQueryObjectivARB := dglGetProcAddress('glGetQueryObjectivARB'); - glGetQueryObjectuivARB := dglGetProcAddress('glGetQueryObjectuivARB'); -end; - -procedure Read_GL_ARB_draw_instanced; -begin - glDrawArraysInstancedARB := dglGetProcAddress('glDrawArraysInstancedARB'); - glDrawElementsInstancedARB := dglGetProcAddress('glDrawElementsInstancedARB'); -end; - -procedure Read_GL_ARB_framebuffer_object; -begin - glIsRenderbuffer := dglGetProcAddress('glIsRenderbuffer'); - glBindRenderbuffer := dglGetProcAddress('glBindRenderbuffer'); - glDeleteRenderbuffers := dglGetProcAddress('glDeleteRenderbuffers'); - glGenRenderbuffers := dglGetProcAddress('glGenRenderbuffers'); - glRenderbufferStorage := dglGetProcAddress('glRenderbufferStorage'); - glGetRenderbufferParameteriv := dglGetProcAddress('glGetRenderbufferParameteriv'); - glIsFramebuffer := dglGetProcAddress('glIsFramebuffer'); - glBindFramebuffer := dglGetProcAddress('glBindFramebuffer'); - glDeleteFramebuffers := dglGetProcAddress('glDeleteFramebuffers'); - glGenFramebuffers := dglGetProcAddress('glGenFramebuffers'); - glCheckFramebufferStatus := dglGetProcAddress('glCheckFramebufferStatus'); - glFramebufferTexture1D := dglGetProcAddress('glFramebufferTexture1D'); - glFramebufferTexture2D := dglGetProcAddress('glFramebufferTexture2D'); - glFramebufferTexture3D := dglGetProcAddress('glFramebufferTexture3D'); - glFramebufferRenderbuffer := dglGetProcAddress('glFramebufferRenderbuffer'); - glGetFramebufferAttachmentParameteriv := dglGetProcAddress('glGetFramebufferAttachmentParameteriv'); - glGenerateMipmap := dglGetProcAddress('glGenerateMipmap'); - glBlitFramebuffer := dglGetProcAddress('glBlitFramebuffer'); - glRenderbufferStorageMultisample := dglGetProcAddress('glRenderbufferStorageMultisample'); - glFramebufferTextureLayer := dglGetProcAddress('glFramebufferTextureLayer'); -end; - -procedure Read_GL_ARB_geometry_shader4; -begin - glProgramParameteriARB := dglGetProcAddress('glProgramParameteriARB'); - glFramebufferTextureARB := dglGetProcAddress('glFramebufferTextureARB'); - glFramebufferTextureLayerARB := dglGetProcAddress('glFramebufferTextureLayerARB'); - glFramebufferTextureFaceARB := dglGetProcAddress('glFramebufferTextureFaceARB'); -end; - -procedure Read_GL_ARB_instanced_arrays; -begin - glVertexAttribDivisorARB := dglGetProcAddress('glVertexAttribDivisorARB'); -end; - -procedure Read_GL_ARB_map_buffer_range; -begin - glMapBufferRange := dglGetProcAddress('glMapBufferRange'); - glFlushMappedBufferRange := dglGetProcAddress('glFlushMappedBufferRange'); -end; - -procedure Read_GL_ARB_texture_buffer_object; -begin - glTexBufferARB := dglGetProcAddress('glTexBufferARB'); -end; - -procedure Read_GL_ARB_vertex_array_object; -begin - glBindVertexArray := dglGetProcAddress('glBindVertexArray'); - glDeleteVertexArrays := dglGetProcAddress('glDeleteVertexArrays'); - glGenVertexArrays := dglGetProcAddress('glGenVertexArrays'); - glIsVertexArray := dglGetProcAddress('glIsVertexArray'); -end; - -procedure Read_GL_ARB_uniform_buffer_object; -begin - glGetUniformIndices := dglGetProcAddress('glGetUniformIndices'); - glGetActiveUniformsiv := dglGetProcAddress('glGetActiveUniformsiv'); - glGetActiveUniformName := dglGetProcAddress('glGetActiveUniformName'); - glGetUniformBlockIndex := dglGetProcAddress('glGetUniformBlockIndex'); - glGetActiveUniformBlockiv := dglGetProcAddress('glGetActiveUniformBlockiv'); - glGetActiveUniformBlockName := dglGetProcAddress('glGetActiveUniformBlockName'); - glUniformBlockBinding := dglGetProcAddress('glUniformBlockBinding'); -end; - -procedure Read_GL_ARB_copy_buffer; -begin - glCopyBufferSubData := dglGetProcAddress('glCopyBufferSubData'); -end; - -procedure Read_GL_ARB_draw_elements_base_vertex; -begin - glDrawElementsBaseVertex := dglGetProcAddress('glDrawElementsBaseVertex'); - glDrawRangeElementsBaseVertex := dglGetProcAddress('glDrawRangeElementsBaseVertex'); - glDrawElementsInstancedBaseVertex := dglGetProcAddress('glDrawElementsInstancedBaseVertex'); - glMultiDrawElementsBaseVertex := dglGetProcAddress('glMultiDrawElementsBaseVertex'); -end; - -procedure Read_GL_ARB_provoking_vertex; -begin - glProvokingVertex := dglGetProcAddress('glProvokingVertex'); -end; - -procedure Read_GL_ARB_sync; -begin - glFenceSync := dglGetProcAddress('glFenceSync'); - glIsSync := dglGetProcAddress('glIsSync'); - glDeleteSync := dglGetProcAddress('glDeleteSync'); - glClientWaitSync := dglGetProcAddress('glClientWaitSync'); - glWaitSync := dglGetProcAddress('glWaitSync'); - glGetInteger64v := dglGetProcAddress('glGetInteger64v'); - glGetSynciv := dglGetProcAddress('glGetSynciv'); -end; - -procedure Read_GL_ARB_texture_multisample; -begin - glTexImage2DMultisample := dglGetProcAddress('glTexImage2DMultisample'); - glTexImage3DMultisample := dglGetProcAddress('glTexImage3DMultisample'); - glGetMultisamplefv := dglGetProcAddress('glGetMultisamplefv'); - glSampleMaski := dglGetProcAddress('glSampleMaski'); -end; - -procedure Read_GL_ARB_draw_buffers_blend; -begin - glBlendEquationiARB := dglGetProcAddress('glBlendEquationiARB'); - glBlendEquationSeparateiARB := dglGetProcAddress('glBlendEquationSeparateiARB'); - glBlendFunciARB := dglGetProcAddress('glBlendFunciARB'); - glBlendFuncSeparateiARB := dglGetProcAddress('glBlendFuncSeparateiARB'); -end; - -procedure Read_GL_ARB_sample_shading; -begin - glMinSampleShadingARB := dglGetProcAddress('glMinSampleShadingARB'); -end; - -procedure Read_GL_ARB_shading_language_include; -begin - glNamedStringARB := dglGetProcAddress('glNamedStringARB'); - glDeleteNamedStringARB := dglGetProcAddress('glDeleteNamedStringARB'); - glCompileShaderIncludeARB := dglGetProcAddress('glCompileShaderIncludeARB'); - glIsNamedStringARB := dglGetProcAddress('glIsNamedStringARB'); - glGetNamedStringARB := dglGetProcAddress('glGetNamedStringARB'); - glGetNamedStringivARB := dglGetProcAddress('glGetNamedStringivARB'); -end; - -procedure Read_GL_ARB_blend_func_extended; -begin - glBindFragDataLocationIndexed := dglGetProcAddress('glBindFragDataLocationIndexed'); - glGetFragDataIndex := dglGetProcAddress('glGetFragDataIndex'); -end; - -procedure Read_GL_ARB_sampler_objects; -begin - glGenSamplers := dglGetProcAddress('glGenSamplers'); - glDeleteSamplers := dglGetProcAddress('glDeleteSamplers'); - glIsSampler := dglGetProcAddress('glIsSampler'); - glBindSampler := dglGetProcAddress('glBindSampler'); - glSamplerParameteri := dglGetProcAddress('glSamplerParameteri'); - glSamplerParameteriv := dglGetProcAddress('glSamplerParameteriv'); - glSamplerParameterf := dglGetProcAddress('glSamplerParameterf'); - glSamplerParameterfv := dglGetProcAddress('glSamplerParameterfv'); - glSamplerParameterIiv := dglGetProcAddress('glSamplerParameterIiv'); - glSamplerParameterIuiv := dglGetProcAddress('glSamplerParameterIuiv'); - glGetSamplerParameteriv := dglGetProcAddress('glGetSamplerParameteriv'); - glGetSamplerParameterIiv := dglGetProcAddress('glGetSamplerParameterIiv'); - glGetSamplerParameterfv := dglGetProcAddress('glGetSamplerParameterfv'); - glGetSamplerParameterIuiv := dglGetProcAddress('glGetSamplerParameterIuiv'); -end; - -procedure Read_GL_ARB_timer_query; -begin - glQueryCounter := dglGetProcAddress('glQueryCounter'); - glGetQueryObjecti64v := dglGetProcAddress('glGetQueryObjecti64v'); - glGetQueryObjectui64v := dglGetProcAddress('glGetQueryObjectui64v'); -end; - -procedure Read_GL_ARB_vertex_type_2_10_10_10_rev; -begin - glVertexP2ui := dglGetProcAddress('glVertexP2ui'); - glVertexP2uiv := dglGetProcAddress('glVertexP2uiv'); - glVertexP3ui := dglGetProcAddress('glVertexP3ui'); - glVertexP3uiv := dglGetProcAddress('glVertexP3uiv'); - glVertexP4ui := dglGetProcAddress('glVertexP4ui'); - glVertexP4uiv := dglGetProcAddress('glVertexP4uiv'); - glTexCoordP1ui := dglGetProcAddress('glTexCoordP1ui'); - glTexCoordP1uiv := dglGetProcAddress('glTexCoordP1uiv'); - glTexCoordP2ui := dglGetProcAddress('glTexCoordP2ui'); - glTexCoordP2uiv := dglGetProcAddress('glTexCoordP2uiv'); - glTexCoordP3ui := dglGetProcAddress('glTexCoordP3ui'); - glTexCoordP3uiv := dglGetProcAddress('glTexCoordP3uiv'); - glTexCoordP4ui := dglGetProcAddress('glTexCoordP4ui'); - glTexCoordP4uiv := dglGetProcAddress('glTexCoordP4uiv'); - glMultiTexCoordP1ui := dglGetProcAddress('glMultiTexCoordP1ui'); - glMultiTexCoordP1uiv := dglGetProcAddress('glMultiTexCoordP1uiv'); - glMultiTexCoordP2ui := dglGetProcAddress('glMultiTexCoordP2ui'); - glMultiTexCoordP2uiv := dglGetProcAddress('glMultiTexCoordP2uiv'); - glMultiTexCoordP3ui := dglGetProcAddress('glMultiTexCoordP3ui'); - glMultiTexCoordP3uiv := dglGetProcAddress('glMultiTexCoordP3uiv'); - glMultiTexCoordP4ui := dglGetProcAddress('glMultiTexCoordP4ui'); - glMultiTexCoordP4uiv := dglGetProcAddress('glMultiTexCoordP4uiv'); - glNormalP3ui := dglGetProcAddress('glNormalP3ui'); - glNormalP3uiv := dglGetProcAddress('glNormalP3uiv'); - glColorP3ui := dglGetProcAddress('glColorP3ui'); - glColorP3uiv := dglGetProcAddress('glColorP3uiv'); - glColorP4ui := dglGetProcAddress('glColorP4ui'); - glColorP4uiv := dglGetProcAddress('glColorP4uiv'); - glSecondaryColorP3ui := dglGetProcAddress('glSecondaryColorP3ui'); - glSecondaryColorP3uiv := dglGetProcAddress('glSecondaryColorP3uiv'); - glVertexAttribP1ui := dglGetProcAddress('glVertexAttribP1ui'); - glVertexAttribP1uiv := dglGetProcAddress('glVertexAttribP1uiv'); - glVertexAttribP2ui := dglGetProcAddress('glVertexAttribP2ui'); - glVertexAttribP2uiv := dglGetProcAddress('glVertexAttribP2uiv'); - glVertexAttribP3ui := dglGetProcAddress('glVertexAttribP3ui'); - glVertexAttribP3uiv := dglGetProcAddress('glVertexAttribP3uiv'); - glVertexAttribP4ui := dglGetProcAddress('glVertexAttribP4ui'); - glVertexAttribP4uiv := dglGetProcAddress('glVertexAttribP4uiv'); -end; - -procedure Read_GL_ARB_draw_indirect; -begin - glDrawArraysIndirect := dglGetProcAddress('glDrawArraysIndirect'); - glDrawElementsIndirect := dglGetProcAddress('glDrawElementsIndirect'); -end; - -procedure Read_GL_ARB_gpu_shader_fp64; -begin - glUniform1d := dglGetProcAddress('glUniform1d'); - glUniform2d := dglGetProcAddress('glUniform2d'); - glUniform3d := dglGetProcAddress('glUniform3d'); - glUniform4d := dglGetProcAddress('glUniform4d'); - glUniform1dv := dglGetProcAddress('glUniform1dv'); - glUniform2dv := dglGetProcAddress('glUniform2dv'); - glUniform3dv := dglGetProcAddress('glUniform3dv'); - glUniform4dv := dglGetProcAddress('glUniform4dv'); - glUniformMatrix2dv := dglGetProcAddress('glUniformMatrix2dv'); - glUniformMatrix3dv := dglGetProcAddress('glUniformMatrix3dv'); - glUniformMatrix4dv := dglGetProcAddress('glUniformMatrix4dv'); - glUniformMatrix2x3dv := dglGetProcAddress('glUniformMatrix2x3dv'); - glUniformMatrix2x4dv := dglGetProcAddress('glUniformMatrix2x4dv'); - glUniformMatrix3x2dv := dglGetProcAddress('glUniformMatrix3x2dv'); - glUniformMatrix3x4dv := dglGetProcAddress('glUniformMatrix3x4dv'); - glUniformMatrix4x2dv := dglGetProcAddress('glUniformMatrix4x2dv'); - glUniformMatrix4x3dv := dglGetProcAddress('glUniformMatrix4x3dv'); - glGetUniformdv := dglGetProcAddress('glGetUniformdv'); -end; - -procedure Read_GL_ARB_shader_subroutine; -begin - glGetSubroutineUniformLocation := dglGetProcAddress('glGetSubroutineUniformLocation'); - glGetSubroutineIndex := dglGetProcAddress('glGetSubroutineIndex'); - glGetActiveSubroutineUniformiv := dglGetProcAddress('glGetActiveSubroutineUniformiv'); - glGetActiveSubroutineUniformName := dglGetProcAddress('glGetActiveSubroutineUniformName'); - glGetActiveSubroutineName := dglGetProcAddress('glGetActiveSubroutineName'); - glUniformSubroutinesuiv := dglGetProcAddress('glUniformSubroutinesuiv'); - glGetUniformSubroutineuiv := dglGetProcAddress('glGetUniformSubroutineuiv'); - glGetProgramStageiv := dglGetProcAddress('glGetProgramStageiv'); -end; - -procedure Read_GL_ARB_tessellation_shader; -begin - glPatchParameteri := dglGetProcAddress('glPatchParameteri'); - glPatchParameterfv := dglGetProcAddress('glPatchParameterfv'); -end; - -procedure Read_GL_ARB_transform_feedback2; -begin - glBindTransformFeedback := dglGetProcAddress('glBindTransformFeedback'); - glDeleteTransformFeedbacks := dglGetProcAddress('glDeleteTransformFeedbacks'); - glGenTransformFeedbacks := dglGetProcAddress('glGenTransformFeedbacks'); - glIsTransformFeedback := dglGetProcAddress('glIsTransformFeedback'); - glPauseTransformFeedback := dglGetProcAddress('glPauseTransformFeedback'); - glResumeTransformFeedback := dglGetProcAddress('glResumeTransformFeedback'); - glDrawTransformFeedback := dglGetProcAddress('glDrawTransformFeedback'); -end; - -procedure Read_GL_ARB_transform_feedback3; -begin - glDrawTransformFeedbackStream := dglGetProcAddress('glDrawTransformFeedbackStream'); - glBeginQueryIndexed := dglGetProcAddress('glBeginQueryIndexed'); - glEndQueryIndexed := dglGetProcAddress('glEndQueryIndexed'); - glGetQueryIndexediv := dglGetProcAddress('glGetQueryIndexediv'); -end; - -procedure Read_GL_ARB_ES2_compatibility; -begin - glReleaseShaderCompiler := dglGetProcAddress('glReleaseShaderCompiler'); - glShaderBinary := dglGetProcAddress('glShaderBinary'); - glGetShaderPrecisionFormat := dglGetProcAddress('glGetShaderPrecisionFormat'); - glDepthRangef := dglGetProcAddress('glDepthRangef'); - glClearDepthf := dglGetProcAddress('glClearDepthf'); -end; - -procedure Read_GL_ARB_get_program_binary; -begin - glGetProgramBinary := dglGetProcAddress('glGetProgramBinary'); - glProgramBinary := dglGetProcAddress('glProgramBinary'); - glProgramParameteri := dglGetProcAddress('glProgramParameteri'); -end; - -procedure Read_GL_ARB_separate_shader_objects; -begin - glUseProgramStages := dglGetProcAddress('glUseProgramStages'); - glActiveShaderProgram := dglGetProcAddress('glActiveShaderProgram'); - glCreateShaderProgramv := dglGetProcAddress('glCreateShaderProgramv'); - glBindProgramPipeline := dglGetProcAddress('glBindProgramPipeline'); - glDeleteProgramPipelines := dglGetProcAddress('glDeleteProgramPipelines'); - glGenProgramPipelines := dglGetProcAddress('glGenProgramPipelines'); - glIsProgramPipeline := dglGetProcAddress('glIsProgramPipeline'); - glGetProgramPipelineiv := dglGetProcAddress('glGetProgramPipelineiv'); - glProgramUniform1i := dglGetProcAddress('glProgramUniform1i'); - glProgramUniform1iv := dglGetProcAddress('glProgramUniform1iv'); - glProgramUniform1f := dglGetProcAddress('glProgramUniform1f'); - glProgramUniform1fv := dglGetProcAddress('glProgramUniform1fv'); - glProgramUniform1d := dglGetProcAddress('glProgramUniform1d'); - glProgramUniform1dv := dglGetProcAddress('glProgramUniform1dv'); - glProgramUniform1ui := dglGetProcAddress('glProgramUniform1ui'); - glProgramUniform1uiv := dglGetProcAddress('glProgramUniform1uiv'); - glProgramUniform2i := dglGetProcAddress('glProgramUniform2i'); - glProgramUniform2iv := dglGetProcAddress('glProgramUniform2iv'); - glProgramUniform2f := dglGetProcAddress('glProgramUniform2f'); - glProgramUniform2fv := dglGetProcAddress('glProgramUniform2fv'); - glProgramUniform2d := dglGetProcAddress('glProgramUniform2d'); - glProgramUniform2dv := dglGetProcAddress('glProgramUniform2dv'); - glProgramUniform2ui := dglGetProcAddress('glProgramUniform2ui'); - glProgramUniform2uiv := dglGetProcAddress('glProgramUniform2uiv'); - glProgramUniform3i := dglGetProcAddress('glProgramUniform3i'); - glProgramUniform3iv := dglGetProcAddress('glProgramUniform3iv'); - glProgramUniform3f := dglGetProcAddress('glProgramUniform3f'); - glProgramUniform3fv := dglGetProcAddress('glProgramUniform3fv'); - glProgramUniform3d := dglGetProcAddress('glProgramUniform3d'); - glProgramUniform3dv := dglGetProcAddress('glProgramUniform3dv'); - glProgramUniform3ui := dglGetProcAddress('glProgramUniform3ui'); - glProgramUniform3uiv := dglGetProcAddress('glProgramUniform3uiv'); - glProgramUniform4i := dglGetProcAddress('glProgramUniform4i'); - glProgramUniform4iv := dglGetProcAddress('glProgramUniform4iv'); - glProgramUniform4f := dglGetProcAddress('glProgramUniform4f'); - glProgramUniform4fv := dglGetProcAddress('glProgramUniform4fv'); - glProgramUniform4d := dglGetProcAddress('glProgramUniform4d'); - glProgramUniform4dv := dglGetProcAddress('glProgramUniform4dv'); - glProgramUniform4ui := dglGetProcAddress('glProgramUniform4ui'); - glProgramUniform4uiv := dglGetProcAddress('glProgramUniform4uiv'); - glProgramUniformMatrix2fv := dglGetProcAddress('glProgramUniformMatrix2fv'); - glProgramUniformMatrix3fv := dglGetProcAddress('glProgramUniformMatrix3fv'); - glProgramUniformMatrix4fv := dglGetProcAddress('glProgramUniformMatrix4fv'); - glProgramUniformMatrix2dv := dglGetProcAddress('glProgramUniformMatrix2dv'); - glProgramUniformMatrix3dv := dglGetProcAddress('glProgramUniformMatrix3dv'); - glProgramUniformMatrix4dv := dglGetProcAddress('glProgramUniformMatrix4dv'); - glProgramUniformMatrix2x3fv := dglGetProcAddress('glProgramUniformMatrix2x3fv'); - glProgramUniformMatrix3x2fv := dglGetProcAddress('glProgramUniformMatrix3x2fv'); - glProgramUniformMatrix2x4fv := dglGetProcAddress('glProgramUniformMatrix2x4fv'); - glProgramUniformMatrix4x2fv := dglGetProcAddress('glProgramUniformMatrix4x2fv'); - glProgramUniformMatrix3x4fv := dglGetProcAddress('glProgramUniformMatrix3x4fv'); - glProgramUniformMatrix4x3fv := dglGetProcAddress('glProgramUniformMatrix4x3fv'); - glProgramUniformMatrix2x3dv := dglGetProcAddress('glProgramUniformMatrix2x3dv'); - glProgramUniformMatrix3x2dv := dglGetProcAddress('glProgramUniformMatrix3x2dv'); - glProgramUniformMatrix2x4dv := dglGetProcAddress('glProgramUniformMatrix2x4dv'); - glProgramUniformMatrix4x2dv := dglGetProcAddress('glProgramUniformMatrix4x2dv'); - glProgramUniformMatrix3x4dv := dglGetProcAddress('glProgramUniformMatrix3x4dv'); - glProgramUniformMatrix4x3dv := dglGetProcAddress('glProgramUniformMatrix4x3dv'); - glValidateProgramPipeline := dglGetProcAddress('glValidateProgramPipeline'); - glGetProgramPipelineInfoLog := dglGetProcAddress('glGetProgramPipelineInfoLog'); -end; - -procedure Read_GL_ARB_vertex_attrib_64bit; -begin - glVertexAttribL1d := dglGetProcAddress('glVertexAttribL1d'); - glVertexAttribL2d := dglGetProcAddress('glVertexAttribL2d'); - glVertexAttribL3d := dglGetProcAddress('glVertexAttribL3d'); - glVertexAttribL4d := dglGetProcAddress('glVertexAttribL4d'); - glVertexAttribL1dv := dglGetProcAddress('glVertexAttribL1dv'); - glVertexAttribL2dv := dglGetProcAddress('glVertexAttribL2dv'); - glVertexAttribL3dv := dglGetProcAddress('glVertexAttribL3dv'); - glVertexAttribL4dv := dglGetProcAddress('glVertexAttribL4dv'); - glVertexAttribLPointer := dglGetProcAddress('glVertexAttribLPointer'); - glGetVertexAttribLdv := dglGetProcAddress('glGetVertexAttribLdv'); -end; - -procedure Read_GL_ARB_viewport_array; -begin - glViewportArrayv := dglGetProcAddress('glViewportArrayv'); - glViewportIndexedf := dglGetProcAddress('glViewportIndexedf'); - glViewportIndexedfv := dglGetProcAddress('glViewportIndexedfv'); - glScissorArrayv := dglGetProcAddress('glScissorArrayv'); - glScissorIndexed := dglGetProcAddress('glScissorIndexed'); - glScissorIndexedv := dglGetProcAddress('glScissorIndexedv'); - glDepthRangeArrayv := dglGetProcAddress('glDepthRangeArrayv'); - glDepthRangeIndexed := dglGetProcAddress('glDepthRangeIndexed'); - glGetFloati_v := dglGetProcAddress('glGetFloati_v'); - glGetDoublei_v := dglGetProcAddress('glGetDoublei_v'); -end; - -// GL 4.2 - -procedure Read_GL_ARB_base_instance; -begin -glDrawArraysInstancedBaseInstance := dglGetProcAddress('glDrawArraysInstancedBaseInstance'); -glDrawElementsInstancedBaseInstance := dglGetProcAddress('glDrawElementsInstancedBaseInstance'); -glDrawElementsInstancedBaseVertexBaseInstance := dglGetProcAddress('glDrawElementsInstancedBaseVertexBaseInstance'); -end; - -procedure Read_GL_ARB_transform_feedback_instanced; -begin -glDrawTransformFeedbackInstanced := dglGetProcAddress('glDrawTransformFeedbackInstanced'); -glDrawTransformFeedbackStreamInstanced := dglGetProcAddress('glDrawTransformFeedbackStreamInstanced'); -end; - -procedure Read_GL_ARB_internalformat_query; -begin -glGetInternalformativ := dglGetProcAddress('glGetInternalformativ'); -end; - -procedure Read_GL_ARB_shader_atomic_counters; -begin -glGetActiveAtomicCounterBufferiv := dglGetProcAddress('glGetActiveAtomicCounterBufferiv'); -end; - -procedure Read_GL_ARB_shader_image_load_store; -begin -glBindImageTexture := dglGetProcAddress('glBindImageTexture'); -glMemoryBarrier := dglGetProcAddress('glMemoryBarrier'); -end; - -procedure Read_GL_ARB_texture_storage; -begin -glTexStorage1D := dglGetProcAddress('glTexStorage1D'); -glTexStorage2D := dglGetProcAddress('glTexStorage2D'); -glTexStorage3D := dglGetProcAddress('glTexStorage3D'); -glTextureStorage1DEXT := dglGetProcAddress('glTextureStorage1DEXT'); -glTextureStorage2DEXT := dglGetProcAddress('glTextureStorage2DEXT'); -glTextureStorage3DEXT := dglGetProcAddress('glTextureStorage3DEXT'); -end; - - -// GL 4.3 -procedure Read_GL_KHR_debug; -begin - glDebugMessageControl := dglGetProcAddress('glDebugMessageControl'); - glDebugMessageInsert := dglGetProcAddress('glDebugMessageInsert'); - glDebugMessageCallback := dglGetProcAddress('glDebugMessageCallback'); - glGetDebugMessageLog := dglGetProcAddress('glGetDebugMessageLog'); - glPushDebugGroup := dglGetProcAddress('glPushDebugGroup'); - glPopDebugGroup := dglGetProcAddress('glPopDebugGroup'); - glObjectLabel := dglGetProcAddress('glObjectLabel'); - glGetObjectLabel := dglGetProcAddress('glGetObjectLabel'); - glObjectPtrLabel := dglGetProcAddress('glObjectPtrLabel'); - glGetObjectPtrLabel := dglGetProcAddress('glGetObjectPtrLabel'); -end; - -procedure Read_GL_ARB_clear_buffer_object; -begin - glClearBufferData := dglGetProcAddress('glClearBufferData'); - glClearBufferSubData := dglGetProcAddress('glClearBufferSubData'); - glClearNamedBufferDataEXT := dglGetProcAddress('glClearNamedBufferDataEXT'); - glClearNamedBufferSubDataEXT := dglGetProcAddress('glClearNamedBufferSubDataEXT'); -end; - -procedure Read_GL_ARB_compute_shader; -begin - glDispatchCompute := dglGetProcAddress('glDispatchCompute'); - glDispatchComputeIndirect := dglGetProcAddress('glDispatchComputeIndirect'); -end; - -procedure Read_GL_ARB_copy_image; -begin - glCopyImageSubData := dglGetProcAddress('glCopyImageSubData'); -end; - -procedure Read_GL_ARB_framebuffer_no_attachments; -begin - glFramebufferParameteri := dglGetProcAddress('glFramebufferParameteri'); - glGetFramebufferParameteriv := dglGetProcAddress('glGetFramebufferParameteriv'); - glNamedFramebufferParameteriEXT := dglGetProcAddress('glNamedFramebufferParameteriEXT'); - glGetNamedFramebufferParameterivEXT := dglGetProcAddress('glGetNamedFramebufferParameterivEXT'); -end; - -procedure Read_GL_ARB_internalformat_query2; -begin - glGetInternalformati64v := dglGetProcAddress('glGetInternalformati64v');; -end; - -procedure Read_GL_ARB_invalidate_subdata; -begin - glInvalidateTexSubImage := dglGetProcAddress('glInvalidateTexSubImage'); - glInvalidateTexImage := dglGetProcAddress('glInvalidateTexImage'); - glInvalidateBufferSubData := dglGetProcAddress('glInvalidateBufferSubData'); - glInvalidateBufferData := dglGetProcAddress('glInvalidateBufferData'); - glInvalidateFramebuffer := dglGetProcAddress('glInvalidateFramebuffer'); - glInvalidateSubFramebuffer := dglGetProcAddress('glInvalidateSubFramebuffer'); -end; - -procedure Read_GL_ARB_multi_draw_indirect; -begin - glMultiDrawArraysIndirect := dglGetProcAddress('glMultiDrawArraysIndirect'); - glMultiDrawElementsIndirect := dglGetProcAddress('glMultiDrawElementsIndirect'); -end; - -procedure Read_GL_ARB_program_interface_query; -begin - glGetProgramInterfaceiv := dglGetProcAddress('glGetProgramInterfaceiv'); - glGetProgramResourceIndex := dglGetProcAddress('glGetProgramResourceIndex'); - glGetProgramResourceName := dglGetProcAddress('glGetProgramResourceName'); - glGetProgramResourceiv := dglGetProcAddress('glGetProgramResourceiv'); - glGetProgramResourceLocation := dglGetProcAddress('glGetProgramResourceLocation'); - glGetProgramResourceLocationIndex := dglGetProcAddress('glGetProgramResourceLocationIndex'); -end; - -procedure Read_GL_ARB_shader_storage_buffer_object; -begin - glShaderStorageBlockBinding := dglGetProcAddress('glShaderStorageBlockBinding'); -end; - -procedure Read_GL_ARB_texture_buffer_range; -begin - glTexBufferRange := dglGetProcAddress('glTexBufferRange'); - glTextureBufferRangeEXT := dglGetProcAddress('glTextureBufferRangeEXT'); -end; - -procedure Read_GL_ARB_texture_storage_multisample; -begin - glTexStorage2DMultisample := dglGetProcAddress('glTexStorage2DMultisample'); - glTexStorage3DMultisample := dglGetProcAddress('glTexStorage3DMultisample'); - glTextureStorage2DMultisampleEXT := dglGetProcAddress('glTextureStorage2DMultisampleEXT'); - glTextureStorage3DMultisampleEXT := dglGetProcAddress('glTextureStorage3DMultisampleEXT'); -end; - -procedure Read_GL_ARB_texture_view; -begin - glTextureView := dglGetProcAddress('glTextureView'); -end; - -procedure Read_GL_ARB_vertex_attrib_binding; -begin - glBindVertexBuffer := dglGetProcAddress('glBindVertexBuffer'); - glVertexAttribFormat := dglGetProcAddress('glVertexAttribFormat'); - glVertexAttribIFormat := dglGetProcAddress('glVertexAttribIFormat'); - glVertexAttribLFormat := dglGetProcAddress('glVertexAttribLFormat'); - glVertexAttribBinding := dglGetProcAddress('glVertexAttribBinding'); - glVertexBindingDivisor := dglGetProcAddress('glVertexBindingDivisor'); - glVertexArrayBindVertexBufferEXT := dglGetProcAddress('glVertexArrayBindVertexBufferEXT'); - glVertexArrayVertexAttribFormatEXT := dglGetProcAddress('glVertexArrayVertexAttribFormatEXT'); - glVertexArrayVertexAttribIFormatEXT := dglGetProcAddress('glVertexArrayVertexAttribIFormatEXT'); - glVertexArrayVertexAttribLFormatEXT := dglGetProcAddress('glVertexArrayVertexAttribLFormatEXT'); - glVertexArrayVertexAttribBindingEXT := dglGetProcAddress('glVertexArrayVertexAttribBindingEXT'); - glVertexArrayVertexBindingDivisorEXT := dglGetProcAddress('glVertexArrayVertexBindingDivisorEXT'); -end; - -procedure Read_GL_NV_path_rendering; -begin - glGenPathsNV := dglGetProcAddress('glGenPathsNV'); - glDeletePathsNV := dglGetProcAddress('glDeletePathsNV'); - glIsPathNV := dglGetProcAddress('glIsPathNV'); - glPathCommandsNV := dglGetProcAddress('glPathCommandsNV'); - glPathCoordsNV := dglGetProcAddress('glPathCoordsNV'); - glPathSubCommandsNV := dglGetProcAddress('glPathSubCommandsNV'); - glPathSubCoordsNV := dglGetProcAddress('glPathSubCoordsNV'); - glPathStringNV := dglGetProcAddress('glPathStringNV'); - glPathGlyphsNV := dglGetProcAddress('glPathGlyphsNV'); - glPathGlyphRangeNV := dglGetProcAddress('glPathGlyphRangeNV'); - glWeightPathsNV := dglGetProcAddress('glWeightPathsNV'); - glCopyPathNV := dglGetProcAddress('glCopyPathNV'); - glInterpolatePathsNV := dglGetProcAddress('glInterpolatePathsNV'); - glTransformPathNV := dglGetProcAddress('glTransformPathNV'); - glPathParameterivNV := dglGetProcAddress('glPathParameterivNV'); - glPathParameteriNV := dglGetProcAddress('glPathParameteriNV'); - glPathParameterfvNV := dglGetProcAddress('glPathParameterfvNV'); - glPathParameterfNV := dglGetProcAddress('glPathParameterfNV'); - glPathDashArrayNV := dglGetProcAddress('glPathDashArrayNV'); - glPathStencilFuncNV := dglGetProcAddress('glPathStencilFuncNV'); - glPathStencilDepthOffsetNV := dglGetProcAddress('glPathStencilDepthOffsetNV'); - glStencilFillPathNV := dglGetProcAddress('glStencilFillPathNV'); - glStencilStrokePathNV := dglGetProcAddress('glStencilStrokePathNV'); - glStencilFillPathInstancedNV := dglGetProcAddress('glStencilFillPathInstancedNV'); - glStencilStrokePathInstancedNV := dglGetProcAddress('glStencilStrokePathInstancedNV'); - glPathCoverDepthFuncNV := dglGetProcAddress('glPathCoverDepthFuncNV'); - glPathColorGenNV := dglGetProcAddress('glPathColorGenNV'); - glPathTexGenNV := dglGetProcAddress('glPathTexGenNV'); - glPathFogGenNV := dglGetProcAddress('glPathFogGenNV'); - glCoverFillPathNV := dglGetProcAddress('glCoverFillPathNV'); - glCoverStrokePathNV := dglGetProcAddress('glCoverStrokePathNV'); - glCoverFillPathInstancedNV := dglGetProcAddress('glCoverFillPathInstancedNV'); - glCoverStrokePathInstancedNV := dglGetProcAddress('glCoverStrokePathInstancedNV'); - glGetPathParameterivNV := dglGetProcAddress('glGetPathParameterivNV'); - glGetPathParameterfvNV := dglGetProcAddress('glGetPathParameterfvNV'); - glGetPathCommandsNV := dglGetProcAddress('glGetPathCommandsNV'); - glGetPathCoordsNV := dglGetProcAddress('glGetPathCoordsNV'); - glGetPathDashArrayNV := dglGetProcAddress('glGetPathDashArrayNV'); - glGetPathMetricsNV := dglGetProcAddress('glGetPathMetricsNV'); - glGetPathMetricRangeNV := dglGetProcAddress('glGetPathMetricRangeNV'); - glGetPathSpacingNV := dglGetProcAddress('glGetPathSpacingNV'); - glGetPathColorGenivNV := dglGetProcAddress('glGetPathColorGenivNV'); - glGetPathColorGenfvNV := dglGetProcAddress('glGetPathColorGenfvNV'); - glGetPathTexGenivNV := dglGetProcAddress('glGetPathTexGenivNV'); - glGetPathTexGenfvNV := dglGetProcAddress('glGetPathTexGenfvNV'); - glIsPointInFillPathNV := dglGetProcAddress('glIsPointInFillPathNV'); - glIsPointInStrokePathNV := dglGetProcAddress('glIsPointInStrokePathNV'); - glGetPathLengthNV := dglGetProcAddress('glGetPathLengthNV'); - glPointAlongPathNV := dglGetProcAddress('glPointAlongPathNV'); -end; - -procedure Read_GL_AMD_stencil_operation_extended; -begin - glStencilOpValueAMD := dglGetProcAddress('glStencilOpValueAMD'); -end; - -procedure Read_GL_NV_bindless_texture; -begin - glGetTextureHandleNV := dglGetProcAddress('glGetTextureHandleNV'); - glGetTextureSamplerHandleNV := dglGetProcAddress('glGetTextureSamplerHandleNV'); - glMakeTextureHandleResidentNV := dglGetProcAddress('glMakeTextureHandleResidentNV'); - glMakeTextureHandleNonResidentNV := dglGetProcAddress('glMakeTextureHandleNonResidentNV'); - glGetImageHandleNV := dglGetProcAddress('glGetImageHandleNV'); - glMakeImageHandleResidentNV := dglGetProcAddress('glMakeImageHandleResidentNV'); - glMakeImageHandleNonResidentNV := dglGetProcAddress('glMakeImageHandleNonResidentNV'); - glUniformHandleui64NV := dglGetProcAddress('glUniformHandleui64NV'); - glUniformHandleui64vNV := dglGetProcAddress('glUniformHandleui64vNV'); - glProgramUniformHandleui64NV := dglGetProcAddress('glProgramUniformHandleui64NV'); - glProgramUniformHandleui64vNV := dglGetProcAddress('glProgramUniformHandleui64vNV'); - glIsTextureHandleResidentNV := dglGetProcAddress('glIsTextureHandleResidentNV'); - glIsImageHandleResidentNV := dglGetProcAddress('glIsImageHandleResidentNV'); -end; - -procedure Read_GL_ARB_cl_event; -begin - glCreateSyncFromCLeventARB := dglGetProcAddress('glCreateSyncFromCLeventARB'); -end; - -procedure Read_GL_ARB_debug_output; -begin - glDebugMessageControlARB := dglGetProcAddress('glDebugMessageControlARB'); - glDebugMessageInsertARB := dglGetProcAddress('glDebugMessageInsertARB'); - glDebugMessageCallbackARB := dglGetProcAddress('glDebugMessageCallbackARB'); - glGetDebugMessageLogARB := dglGetProcAddress('glGetDebugMessageLogARB'); -end; - -procedure Read_GL_ARB_robustness; -begin - glGetGraphicsResetStatusARB := dglGetProcAddress('glGetGraphicsResetStatusARB'); - glGetnMapdvARB := dglGetProcAddress('glGetnMapdvARB'); - glGetnMapfvARB := dglGetProcAddress('glGetnMapfvARB'); - glGetnMapivARB := dglGetProcAddress('glGetnMapivARB'); - glGetnPixelMapfvARB := dglGetProcAddress('glGetnPixelMapfvARB'); - glGetnPixelMapuivARB := dglGetProcAddress('glGetnPixelMapuivARB'); - glGetnPixelMapusvARB := dglGetProcAddress('glGetnPixelMapusvARB'); - glGetnPolygonStippleARB := dglGetProcAddress('glGetnPolygonStippleARB'); - glGetnColorTableARB := dglGetProcAddress('glGetnColorTableARB'); - glGetnConvolutionFilterARB := dglGetProcAddress('glGetnConvolutionFilterARB'); - glGetnSeparableFilterARB := dglGetProcAddress('glGetnSeparableFilterARB'); - glGetnHistogramARB := dglGetProcAddress('glGetnHistogramARB'); - glGetnMinmaxARB := dglGetProcAddress('glGetnMinmaxARB'); - glGetnTexImageARB := dglGetProcAddress('glGetnTexImageARB'); - glReadnPixelsARB := dglGetProcAddress('glReadnPixelsARB'); - glGetnCompressedTexImageARB := dglGetProcAddress('glGetnCompressedTexImageARB'); - glGetnUniformfvARB := dglGetProcAddress('glGetnUniformfvARB'); - glGetnUniformivARB := dglGetProcAddress('glGetnUniformivARB'); - glGetnUniformuivARB := dglGetProcAddress('glGetnUniformuivARB'); - glGetnUniformdvARB := dglGetProcAddress('glGetnUniformdvARB'); -end; - -procedure Read_GL_ATI_draw_buffers; -begin - glDrawBuffersATI := dglGetProcAddress('glDrawBuffersATI'); -end; - -procedure Read_GL_ATI_element_array; -begin - glElementPointerATI := dglGetProcAddress('glElementPointerATI'); - glDrawElementArrayATI := dglGetProcAddress('glDrawElementArrayATI'); - glDrawRangeElementArrayATI := dglGetProcAddress('glDrawRangeElementArrayATI'); -end; - -procedure Read_GL_ATI_envmap_bumpmap; -begin - glTexBumpParameterivATI := dglGetProcAddress('glTexBumpParameterivATI'); - glTexBumpParameterfvATI := dglGetProcAddress('glTexBumpParameterfvATI'); - glGetTexBumpParameterivATI := dglGetProcAddress('glGetTexBumpParameterivATI'); - glGetTexBumpParameterfvATI := dglGetProcAddress('glGetTexBumpParameterfvATI'); -end; - -procedure Read_GL_ATI_fragment_shader; -begin - glGenFragmentShadersATI := dglGetProcAddress('glGenFragmentShadersATI'); - glBindFragmentShaderATI := dglGetProcAddress('glBindFragmentShaderATI'); - glDeleteFragmentShaderATI := dglGetProcAddress('glDeleteFragmentShaderATI'); - glBeginFragmentShaderATI := dglGetProcAddress('glBeginFragmentShaderATI'); - glEndFragmentShaderATI := dglGetProcAddress('glEndFragmentShaderATI'); - glPassTexCoordATI := dglGetProcAddress('glPassTexCoordATI'); - glSampleMapATI := dglGetProcAddress('glSampleMapATI'); - glColorFragmentOp1ATI := dglGetProcAddress('glColorFragmentOp1ATI'); - glColorFragmentOp2ATI := dglGetProcAddress('glColorFragmentOp2ATI'); - glColorFragmentOp3ATI := dglGetProcAddress('glColorFragmentOp3ATI'); - glAlphaFragmentOp1ATI := dglGetProcAddress('glAlphaFragmentOp1ATI'); - glAlphaFragmentOp2ATI := dglGetProcAddress('glAlphaFragmentOp2ATI'); - glAlphaFragmentOp3ATI := dglGetProcAddress('glAlphaFragmentOp3ATI'); - glSetFragmentShaderConstantATI := dglGetProcAddress('glSetFragmentShaderConstantATI'); -end; - -procedure Read_GL_ATI_map_object_buffer; -begin - glMapObjectBufferATI := dglGetProcAddress('glMapObjectBufferATI'); - glUnmapObjectBufferATI := dglGetProcAddress('glUnmapObjectBufferATI'); -end; - -procedure Read_GL_ATI_pn_triangles; -begin - glPNTrianglesiATI := dglGetProcAddress('glPNTrianglesiATI'); - glPNTrianglesfATI := dglGetProcAddress('glPNTrianglesfATI'); -end; - -procedure Read_GL_ATI_separate_stencil; -begin - glStencilOpSeparateATI := dglGetProcAddress('glStencilOpSeparateATI'); - glStencilFuncSeparateATI := dglGetProcAddress('glStencilFuncSeparateATI'); -end; - -procedure Read_GL_ATI_vertex_array_object; -begin - glNewObjectBufferATI := dglGetProcAddress('glNewObjectBufferATI'); - glIsObjectBufferATI := dglGetProcAddress('glIsObjectBufferATI'); - glUpdateObjectBufferATI := dglGetProcAddress('glUpdateObjectBufferATI'); - glGetObjectBufferfvATI := dglGetProcAddress('glGetObjectBufferfvATI'); - glGetObjectBufferivATI := dglGetProcAddress('glGetObjectBufferivATI'); - glFreeObjectBufferATI := dglGetProcAddress('glFreeObjectBufferATI'); - glArrayObjectATI := dglGetProcAddress('glArrayObjectATI'); - glGetArrayObjectfvATI := dglGetProcAddress('glGetArrayObjectfvATI'); - glGetArrayObjectivATI := dglGetProcAddress('glGetArrayObjectivATI'); - glVariantArrayObjectATI := dglGetProcAddress('glVariantArrayObjectATI'); - glGetVariantArrayObjectfvATI := dglGetProcAddress('glGetVariantArrayObjectfvATI'); - glGetVariantArrayObjectivATI := dglGetProcAddress('glGetVariantArrayObjectivATI'); - -end; - -procedure Read_GL_ATI_vertex_attrib_array_object; -begin - glVertexAttribArrayObjectATI := dglGetProcAddress('glVertexAttribArrayObjectATI'); - glGetVertexAttribArrayObjectfvATI := dglGetProcAddress('glGetVertexAttribArrayObjectfvATI'); - glGetVertexAttribArrayObjectivATI := dglGetProcAddress('glGetVertexAttribArrayObjectivATI'); -end; - -procedure Read_GL_ATI_vertex_streams; -begin - glVertexStream1sATI := dglGetProcAddress('glVertexStream1sATI'); - glVertexStream1svATI := dglGetProcAddress('glVertexStream1svATI'); - glVertexStream1iATI := dglGetProcAddress('glVertexStream1iATI'); - glVertexStream1ivATI := dglGetProcAddress('glVertexStream1ivATI'); - glVertexStream1fATI := dglGetProcAddress('glVertexStream1fATI'); - glVertexStream1fvATI := dglGetProcAddress('glVertexStream1fvATI'); - glVertexStream1dATI := dglGetProcAddress('glVertexStream1dATI'); - glVertexStream1dvATI := dglGetProcAddress('glVertexStream1dvATI'); - glVertexStream2sATI := dglGetProcAddress('glVertexStream2sATI'); - glVertexStream2svATI := dglGetProcAddress('glVertexStream2svATI'); - glVertexStream2iATI := dglGetProcAddress('glVertexStream2iATI'); - glVertexStream2ivATI := dglGetProcAddress('glVertexStream2ivATI'); - glVertexStream2fATI := dglGetProcAddress('glVertexStream2fATI'); - glVertexStream2fvATI := dglGetProcAddress('glVertexStream2fvATI'); - glVertexStream2dATI := dglGetProcAddress('glVertexStream2dATI'); - glVertexStream2dvATI := dglGetProcAddress('glVertexStream2dvATI'); - glVertexStream3sATI := dglGetProcAddress('glVertexStream3sATI'); - glVertexStream3svATI := dglGetProcAddress('glVertexStream3svATI'); - glVertexStream3iATI := dglGetProcAddress('glVertexStream3iATI'); - glVertexStream3ivATI := dglGetProcAddress('glVertexStream3ivATI'); - glVertexStream3fATI := dglGetProcAddress('glVertexStream3fATI'); - glVertexStream3fvATI := dglGetProcAddress('glVertexStream3fvATI'); - glVertexStream3dATI := dglGetProcAddress('glVertexStream3dATI'); - glVertexStream3dvATI := dglGetProcAddress('glVertexStream3dvATI'); - glVertexStream4sATI := dglGetProcAddress('glVertexStream4sATI'); - glVertexStream4svATI := dglGetProcAddress('glVertexStream4svATI'); - glVertexStream4iATI := dglGetProcAddress('glVertexStream4iATI'); - glVertexStream4ivATI := dglGetProcAddress('glVertexStream4ivATI'); - glVertexStream4fATI := dglGetProcAddress('glVertexStream4fATI'); - glVertexStream4fvATI := dglGetProcAddress('glVertexStream4fvATI'); - glVertexStream4dATI := dglGetProcAddress('glVertexStream4dATI'); - glVertexStream4dvATI := dglGetProcAddress('glVertexStream4dvATI'); - glNormalStream3bATI := dglGetProcAddress('glNormalStream3bATI'); - glNormalStream3bvATI := dglGetProcAddress('glNormalStream3bvATI'); - glNormalStream3sATI := dglGetProcAddress('glNormalStream3sATI'); - glNormalStream3svATI := dglGetProcAddress('glNormalStream3svATI'); - glNormalStream3iATI := dglGetProcAddress('glNormalStream3iATI'); - glNormalStream3ivATI := dglGetProcAddress('glNormalStream3ivATI'); - glNormalStream3fATI := dglGetProcAddress('glNormalStream3fATI'); - glNormalStream3fvATI := dglGetProcAddress('glNormalStream3fvATI'); - glNormalStream3dATI := dglGetProcAddress('glNormalStream3dATI'); - glNormalStream3dvATI := dglGetProcAddress('glNormalStream3dvATI'); - glClientActiveVertexStreamATI := dglGetProcAddress('glClientActiveVertexStreamATI'); - glVertexBlendEnviATI := dglGetProcAddress('glVertexBlendEnviATI'); - glVertexBlendEnvfATI := dglGetProcAddress('glVertexBlendEnvfATI'); -end; - -procedure Read_GL_AMD_performance_monitor; -begin - glGetPerfMonitorGroupsAMD := dglGetProcAddress('glGetPerfMonitorGroupsAMD'); - glGetPerfMonitorCountersAMD := dglGetProcAddress('glGetPerfMonitorCountersAMD'); - glGetPerfMonitorGroupStringAMD := dglGetProcAddress('glGetPerfMonitorGroupStringAMD'); - glGetPerfMonitorCounterStringAMD := dglGetProcAddress('glGetPerfMonitorCounterStringAMD'); - glGetPerfMonitorCounterInfoAMD := dglGetProcAddress('glGetPerfMonitorCounterInfoAMD'); - glGenPerfMonitorsAMD := dglGetProcAddress('glGenPerfMonitorsAMD'); - glDeletePerfMonitorsAMD := dglGetProcAddress('glDeletePerfMonitorsAMD'); - glSelectPerfMonitorCountersAMD := dglGetProcAddress('glSelectPerfMonitorCountersAMD'); - glBeginPerfMonitorAMD := dglGetProcAddress('glBeginPerfMonitorAMD'); - glEndPerfMonitorAMD := dglGetProcAddress('glEndPerfMonitorAMD'); - glGetPerfMonitorCounterDataAMD := dglGetProcAddress('glGetPerfMonitorCounterDataAMD'); -end; - -procedure Read_GL_AMD_vertex_shader_tesselator; -begin - glTessellationFactorAMD := dglGetProcAddress('glTessellationFactorAMD'); - glTessellationModeAMD := dglGetProcAddress('glTessellationModeAMD'); -end; - -procedure Read_GL_AMD_draw_buffers_blend; -begin - glBlendFuncIndexedAMD := dglGetProcAddress('glBlendFuncIndexedAMD'); - glBlendFuncSeparateIndexedAMD := dglGetProcAddress('glBlendFuncSeparateIndexedAMD'); - glBlendEquationIndexedAMD := dglGetProcAddress('glBlendEquationIndexedAMD'); - glBlendEquationSeparateIndexedAMD := dglGetProcAddress('glBlendEquationSeparateIndexedAMD'); -end; - -procedure Read_GL_AMD_name_gen_delete; -begin - glGenNamesAMD := dglGetProcAddress('glGenNamesAMD'); - glDeleteNamesAMD := dglGetProcAddress('glDeleteNamesAMD'); - glIsNameAMD := dglGetProcAddress('glIsNameAMD'); -end; - -procedure Read_GL_AMD_debug_output; -begin - glDebugMessageEnableAMD := dglGetProcAddress('glDebugMessageEnableAMD'); - glDebugMessageInsertAMD := dglGetProcAddress('glDebugMessageInsertAMD'); - glDebugMessageCallbackAMD := dglGetProcAddress('glDebugMessageCallbackAMD'); - glGetDebugMessageLogAMD := dglGetProcAddress('glGetDebugMessageLogAMD'); -end; - -procedure Read_GL_EXT_blend_color; -begin - glBlendColorEXT := dglGetProcAddress('glBlendColorEXT'); -end; - -procedure Read_GL_EXT_blend_func_separate; -begin - glBlendFuncSeparateEXT := dglGetProcAddress('glBlendFuncSeparateEXT'); -end; - -procedure Read_GL_EXT_blend_minmax; -begin - glBlendEquationEXT := dglGetProcAddress('glBlendEquationEXT'); -end; - -procedure Read_GL_EXT_color_subtable; -begin - glColorSubTableEXT := dglGetProcAddress('glColorSubTableEXT'); - glCopyColorSubTableEXT := dglGetProcAddress('glCopyColorSubTableEXT'); -end; - -procedure Read_GL_EXT_compiled_vertex_array; -begin - glLockArraysEXT := dglGetProcAddress('glLockArraysEXT'); - glUnlockArraysEXT := dglGetProcAddress('glUnlockArraysEXT'); -end; - -procedure Read_GL_EXT_convolution; -begin - glConvolutionFilter1DEXT := dglGetProcAddress('glConvolutionFilter1DEXT'); - glConvolutionFilter2DEXT := dglGetProcAddress('glConvolutionFilter2DEXT'); - glConvolutionParameterfEXT := dglGetProcAddress('glConvolutionParameterfEXT'); - glConvolutionParameterfvEXT := dglGetProcAddress('glConvolutionParameterfvEXT'); - glConvolutionParameteriEXT := dglGetProcAddress('glConvolutionParameteriEXT'); - glConvolutionParameterivEXT := dglGetProcAddress('glConvolutionParameterivEXT'); - glCopyConvolutionFilter1DEXT := dglGetProcAddress('glCopyConvolutionFilter1DEXT'); - glCopyConvolutionFilter2DEXT := dglGetProcAddress('glCopyConvolutionFilter2DEXT'); - glGetConvolutionFilterEXT := dglGetProcAddress('glGetConvolutionFilterEXT'); - glGetConvolutionParameterfvEXT := dglGetProcAddress('glGetConvolutionParameterfvEXT'); - glGetConvolutionParameterivEXT := dglGetProcAddress('glGetConvolutionParameterivEXT'); - glGetSeparableFilterEXT := dglGetProcAddress('glGetSeparableFilterEXT'); - glSeparableFilter2DEXT := dglGetProcAddress('glSeparableFilter2DEXT'); -end; - -procedure Read_GL_EXT_coordinate_frame; -begin - glTangent3bEXT := dglGetProcAddress('glTangent3bEXT'); - glTangent3bvEXT := dglGetProcAddress('glTangent3bvEXT'); - glTangent3dEXT := dglGetProcAddress('glTangent3dEXT'); - glTangent3dvEXT := dglGetProcAddress('glTangent3dvEXT'); - glTangent3fEXT := dglGetProcAddress('glTangent3fEXT'); - glTangent3fvEXT := dglGetProcAddress('glTangent3fvEXT'); - glTangent3iEXT := dglGetProcAddress('glTangent3iEXT'); - glTangent3ivEXT := dglGetProcAddress('glTangent3ivEXT'); - glTangent3sEXT := dglGetProcAddress('glTangent3sEXT'); - glTangent3svEXT := dglGetProcAddress('glTangent3svEXT'); - glBinormal3bEXT := dglGetProcAddress('glBinormal3bEXT'); - glBinormal3bvEXT := dglGetProcAddress('glBinormal3bvEXT'); - glBinormal3dEXT := dglGetProcAddress('glBinormal3dEXT'); - glBinormal3dvEXT := dglGetProcAddress('glBinormal3dvEXT'); - glBinormal3fEXT := dglGetProcAddress('glBinormal3fEXT'); - glBinormal3fvEXT := dglGetProcAddress('glBinormal3fvEXT'); - glBinormal3iEXT := dglGetProcAddress('glBinormal3iEXT'); - glBinormal3ivEXT := dglGetProcAddress('glBinormal3ivEXT'); - glBinormal3sEXT := dglGetProcAddress('glBinormal3sEXT'); - glBinormal3svEXT := dglGetProcAddress('glBinormal3svEXT'); - glTangentPointerEXT := dglGetProcAddress('glTangentPointerEXT'); - glBinormalPointerEXT := dglGetProcAddress('glBinormalPointerEXT'); -end; - -procedure Read_GL_EXT_copy_texture; -begin - glCopyTexImage1DEXT := dglGetProcAddress('glCopyTexImage1DEXT'); - glCopyTexImage2DEXT := dglGetProcAddress('glCopyTexImage2DEXT'); - glCopyTexSubImage1DEXT := dglGetProcAddress('glCopyTexSubImage1DEXT'); - glCopyTexSubImage2DEXT := dglGetProcAddress('glCopyTexSubImage2DEXT'); - glCopyTexSubImage3DEXT := dglGetProcAddress('glCopyTexSubImage3DEXT'); -end; - -procedure Read_GL_EXT_cull_vertex; -begin - glCullParameterdvEXT := dglGetProcAddress('glCullParameterdvEXT'); - glCullParameterfvEXT := dglGetProcAddress('glCullParameterfvEXT'); -end; - -procedure Read_GL_EXT_draw_range_elements; -begin - glDrawRangeElementsEXT := dglGetProcAddress('glDrawRangeElementsEXT'); -end; - -procedure Read_GL_EXT_fog_coord; -begin - glFogCoordfEXT := dglGetProcAddress('glFogCoordfEXT'); - glFogCoordfvEXT := dglGetProcAddress('glFogCoordfvEXT'); - glFogCoorddEXT := dglGetProcAddress('glFogCoorddEXT'); - glFogCoorddvEXT := dglGetProcAddress('glFogCoorddvEXT'); - glFogCoordPointerEXT := dglGetProcAddress('glFogCoordPointerEXT'); -end; - -procedure Read_GL_EXT_framebuffer_object; -begin - glIsRenderbufferEXT := dglGetProcAddress('glIsRenderbufferEXT'); - glBindRenderbufferEXT := dglGetProcAddress('glBindRenderbufferEXT'); - glDeleteRenderbuffersEXT := dglGetProcAddress('glDeleteRenderbuffersEXT'); - glGenRenderbuffersEXT := dglGetProcAddress('glGenRenderbuffersEXT'); - glRenderbufferStorageEXT := dglGetProcAddress('glRenderbufferStorageEXT'); - glGetRenderbufferParameterivEXT := dglGetProcAddress('glGetRenderbufferParameterivEXT'); - glIsFramebufferEXT := dglGetProcAddress('glIsFramebufferEXT'); - glBindFramebufferEXT := dglGetProcAddress('glBindFramebufferEXT'); - glDeleteFramebuffersEXT := dglGetProcAddress('glDeleteFramebuffersEXT'); - glGenFramebuffersEXT := dglGetProcAddress('glGenFramebuffersEXT'); - glCheckFramebufferStatusEXT := dglGetProcAddress('glCheckFramebufferStatusEXT'); - glFramebufferTexture1DEXT := dglGetProcAddress('glFramebufferTexture1DEXT'); - glFramebufferTexture2DEXT := dglGetProcAddress('glFramebufferTexture2DEXT'); - glFramebufferTexture3DEXT := dglGetProcAddress('glFramebufferTexture3DEXT'); - glFramebufferRenderbufferEXT := dglGetProcAddress('glFramebufferRenderbufferEXT'); - glGetFramebufferAttachmentParameterivEXT := dglGetProcAddress('glGetFramebufferAttachmentParameterivEXT'); - glGenerateMipmapEXT := dglGetProcAddress('glGenerateMipmapEXT'); -end; - -procedure Read_GL_EXT_histogram; -begin - glGetHistogramEXT := dglGetProcAddress('glGetHistogramEXT'); - glGetHistogramParameterfvEXT := dglGetProcAddress('glGetHistogramParameterfvEXT'); - glGetHistogramParameterivEXT := dglGetProcAddress('glGetHistogramParameterivEXT'); - glGetMinmaxEXT := dglGetProcAddress('glGetMinmaxEXT'); - glGetMinmaxParameterfvEXT := dglGetProcAddress('glGetMinmaxParameterfvEXT'); - glGetMinmaxParameterivEXT := dglGetProcAddress('glGetMinmaxParameterivEXT'); - glHistogramEXT := dglGetProcAddress('glHistogramEXT'); - glMinmaxEXT := dglGetProcAddress('glMinmaxEXT'); - glResetHistogramEXT := dglGetProcAddress('glResetHistogramEXT'); - glResetMinmaxEXT := dglGetProcAddress('glResetMinmaxEXT'); -end; - -procedure Read_GL_EXT_index_func; -begin - glIndexFuncEXT := dglGetProcAddress('glIndexFuncEXT'); -end; - -procedure Read_GL_EXT_index_material; -begin - glIndexMaterialEXT := dglGetProcAddress('glIndexMaterialEXT'); -end; - -procedure Read_GL_EXT_light_texture; -begin - glApplyTextureEXT := dglGetProcAddress('glApplyTextureEXT'); - glTextureLightEXT := dglGetProcAddress('glTextureLightEXT'); - glTextureMaterialEXT := dglGetProcAddress('glTextureMaterialEXT'); -end; - -procedure Read_GL_EXT_multi_draw_arrays; -begin - glMultiDrawArraysEXT := dglGetProcAddress('glMultiDrawArraysEXT'); - glMultiDrawElementsEXT := dglGetProcAddress('glMultiDrawElementsEXT'); -end; - -procedure Read_GL_EXT_multisample; -begin - glSampleMaskEXT := dglGetProcAddress('glSampleMaskEXT'); - glSamplePatternEXT := dglGetProcAddress('glSamplePatternEXT'); -end; - -procedure Read_GL_EXT_paletted_texture; -begin - glColorTableEXT := dglGetProcAddress('glColorTableEXT'); - glGetColorTableEXT := dglGetProcAddress('glGetColorTableEXT'); - glGetColorTableParameterivEXT := dglGetProcAddress('glGetColorTableParameterivEXT'); - glGetColorTableParameterfvEXT := dglGetProcAddress('glGetColorTableParameterfvEXT'); -end; - -procedure Read_GL_EXT_pixel_transform; -begin - glPixelTransformParameteriEXT := dglGetProcAddress('glPixelTransformParameteriEXT'); - glPixelTransformParameterfEXT := dglGetProcAddress('glPixelTransformParameterfEXT'); - glPixelTransformParameterivEXT := dglGetProcAddress('glPixelTransformParameterivEXT'); - glPixelTransformParameterfvEXT := dglGetProcAddress('glPixelTransformParameterfvEXT'); -end; - -procedure Read_GL_EXT_point_parameters; -begin - glPointParameterfEXT := dglGetProcAddress('glPointParameterfEXT'); - glPointParameterfvEXT := dglGetProcAddress('glPointParameterfvEXT'); -end; - -procedure Read_GL_EXT_polygon_offset; -begin - glPolygonOffsetEXT := dglGetProcAddress('glPolygonOffsetEXT'); -end; - -procedure Read_GL_EXT_secondary_color; -begin - glSecondaryColor3bEXT := dglGetProcAddress('glSecondaryColor3bEXT'); - glSecondaryColor3bvEXT := dglGetProcAddress('glSecondaryColor3bvEXT'); - glSecondaryColor3dEXT := dglGetProcAddress('glSecondaryColor3dEXT'); - glSecondaryColor3dvEXT := dglGetProcAddress('glSecondaryColor3dvEXT'); - glSecondaryColor3fEXT := dglGetProcAddress('glSecondaryColor3fEXT'); - glSecondaryColor3fvEXT := dglGetProcAddress('glSecondaryColor3fvEXT'); - glSecondaryColor3iEXT := dglGetProcAddress('glSecondaryColor3iEXT'); - glSecondaryColor3ivEXT := dglGetProcAddress('glSecondaryColor3ivEXT'); - glSecondaryColor3sEXT := dglGetProcAddress('glSecondaryColor3sEXT'); - glSecondaryColor3svEXT := dglGetProcAddress('glSecondaryColor3svEXT'); - glSecondaryColor3ubEXT := dglGetProcAddress('glSecondaryColor3ubEXT'); - glSecondaryColor3ubvEXT := dglGetProcAddress('glSecondaryColor3ubvEXT'); - glSecondaryColor3uiEXT := dglGetProcAddress('glSecondaryColor3uiEXT'); - glSecondaryColor3uivEXT := dglGetProcAddress('glSecondaryColor3uivEXT'); - glSecondaryColor3usEXT := dglGetProcAddress('glSecondaryColor3usEXT'); - glSecondaryColor3usvEXT := dglGetProcAddress('glSecondaryColor3usvEXT'); - glSecondaryColorPointerEXT := dglGetProcAddress('glSecondaryColorPointerEXT'); -end; - -procedure Read_GL_EXT_stencil_two_side; -begin - glActiveStencilFaceEXT := dglGetProcAddress('glActiveStencilFaceEXT'); -end; - -procedure Read_GL_EXT_subtexture; -begin - glTexSubImage1DEXT := dglGetProcAddress('glTexSubImage1DEXT'); - glTexSubImage2DEXT := dglGetProcAddress('glTexSubImage2DEXT'); -end; - -procedure Read_GL_EXT_texture3D; -begin - glTexImage3DEXT := dglGetProcAddress('glTexImage3DEXT'); - glTexSubImage3DEXT := dglGetProcAddress('glTexSubImage3DEXT'); -end; - -procedure Read_GL_EXT_texture_object; -begin - glAreTexturesResidentEXT := dglGetProcAddress('glAreTexturesResidentEXT'); - glBindTextureEXT := dglGetProcAddress('glBindTextureEXT'); - glDeleteTexturesEXT := dglGetProcAddress('glDeleteTexturesEXT'); - glGenTexturesEXT := dglGetProcAddress('glGenTexturesEXT'); - glIsTextureEXT := dglGetProcAddress('glIsTextureEXT'); - glPrioritizeTexturesEXT := dglGetProcAddress('glPrioritizeTexturesEXT'); -end; - -procedure Read_GL_EXT_texture_perturb_normal; -begin - glTextureNormalEXT := dglGetProcAddress('glTextureNormalEXT'); -end; - -procedure Read_GL_EXT_vertex_array; -begin - glArrayElementEXT := dglGetProcAddress('glArrayElementEXT'); - glColorPointerEXT := dglGetProcAddress('glColorPointerEXT'); - glDrawArraysEXT := dglGetProcAddress('glDrawArraysEXT'); - glEdgeFlagPointerEXT := dglGetProcAddress('glEdgeFlagPointerEXT'); - glGetPointervEXT := dglGetProcAddress('glGetPointervEXT'); - glIndexPointerEXT := dglGetProcAddress('glIndexPointerEXT'); - glNormalPointerEXT := dglGetProcAddress('glNormalPointerEXT'); - glTexCoordPointerEXT := dglGetProcAddress('glTexCoordPointerEXT'); - glVertexPointerEXT := dglGetProcAddress('glVertexPointerEXT'); -end; - -procedure Read_GL_EXT_vertex_shader; -begin - glBeginVertexShaderEXT := dglGetProcAddress('glBeginVertexShaderEXT'); - glEndVertexShaderEXT := dglGetProcAddress('glEndVertexShaderEXT'); - glBindVertexShaderEXT := dglGetProcAddress('glBindVertexShaderEXT'); - glGenVertexShadersEXT := dglGetProcAddress('glGenVertexShadersEXT'); - glDeleteVertexShaderEXT := dglGetProcAddress('glDeleteVertexShaderEXT'); - glShaderOp1EXT := dglGetProcAddress('glShaderOp1EXT'); - glShaderOp2EXT := dglGetProcAddress('glShaderOp2EXT'); - glShaderOp3EXT := dglGetProcAddress('glShaderOp3EXT'); - glSwizzleEXT := dglGetProcAddress('glSwizzleEXT'); - glWriteMaskEXT := dglGetProcAddress('glWriteMaskEXT'); - glInsertComponentEXT := dglGetProcAddress('glInsertComponentEXT'); - glExtractComponentEXT := dglGetProcAddress('glExtractComponentEXT'); - glGenSymbolsEXT := dglGetProcAddress('glGenSymbolsEXT'); - glSetInvariantEXT := dglGetProcAddress('glSetInvariantEXT'); - glSetLocalConstantEXT := dglGetProcAddress('glSetLocalConstantEXT'); - glVariantbvEXT := dglGetProcAddress('glVariantbvEXT'); - glVariantsvEXT := dglGetProcAddress('glVariantsvEXT'); - glVariantivEXT := dglGetProcAddress('glVariantivEXT'); - glVariantfvEXT := dglGetProcAddress('glVariantfvEXT'); - glVariantdvEXT := dglGetProcAddress('glVariantdvEXT'); - glVariantubvEXT := dglGetProcAddress('glVariantubvEXT'); - glVariantusvEXT := dglGetProcAddress('glVariantusvEXT'); - glVariantuivEXT := dglGetProcAddress('glVariantuivEXT'); - glVariantPointerEXT := dglGetProcAddress('glVariantPointerEXT'); - glEnableVariantClientStateEXT := dglGetProcAddress('glEnableVariantClientStateEXT'); - glDisableVariantClientStateEXT := dglGetProcAddress('glDisableVariantClientStateEXT'); - glBindLightParameterEXT := dglGetProcAddress('glBindLightParameterEXT'); - glBindMaterialParameterEXT := dglGetProcAddress('glBindMaterialParameterEXT'); - glBindTexGenParameterEXT := dglGetProcAddress('glBindTexGenParameterEXT'); - glBindTextureUnitParameterEXT := dglGetProcAddress('glBindTextureUnitParameterEXT'); - glBindParameterEXT := dglGetProcAddress('glBindParameterEXT'); - glIsVariantEnabledEXT := dglGetProcAddress('glIsVariantEnabledEXT'); - glGetVariantBooleanvEXT := dglGetProcAddress('glGetVariantBooleanvEXT'); - glGetVariantIntegervEXT := dglGetProcAddress('glGetVariantIntegervEXT'); - glGetVariantFloatvEXT := dglGetProcAddress('glGetVariantFloatvEXT'); - glGetVariantPointervEXT := dglGetProcAddress('glGetVariantPointervEXT'); - glGetInvariantBooleanvEXT := dglGetProcAddress('glGetInvariantBooleanvEXT'); - glGetInvariantIntegervEXT := dglGetProcAddress('glGetInvariantIntegervEXT'); - glGetInvariantFloatvEXT := dglGetProcAddress('glGetInvariantFloatvEXT'); - glGetLocalConstantBooleanvEXT := dglGetProcAddress('glGetLocalConstantBooleanvEXT'); - glGetLocalConstantIntegervEXT := dglGetProcAddress('glGetLocalConstantIntegervEXT'); - glGetLocalConstantFloatvEXT := dglGetProcAddress('glGetLocalConstantFloatvEXT'); -end; - -procedure Read_GL_EXT_vertex_weighting; -begin - glVertexWeightfEXT := dglGetProcAddress('glVertexWeightfEXT'); - glVertexWeightfvEXT := dglGetProcAddress('glVertexWeightfvEXT'); - glVertexWeightPointerEXT := dglGetProcAddress('glVertexWeightPointerEXT'); -end; - -procedure Read_GL_EXT_depth_bounds_test; -begin - glImageTransformParameteriHP := dglGetProcAddress('glImageTransformParameteriHP'); - glDepthBoundsEXT := dglGetProcAddress('glDepthBoundsEXT'); -end; - -procedure Read_GL_EXT_blend_equation_separate; -begin - glBlendEquationSeparateEXT := dglGetProcAddress('glBlendEquationSeparateEXT'); -end; - -procedure Read_GL_EXT_stencil_clear_tag; -begin - glStencilClearTagEXT := dglGetProcAddress('glStencilClearTagEXT'); -end; - -procedure Read_GL_EXT_framebuffer_blit; -begin - glBlitFramebufferEXT := dglGetProcAddress('glBlitFramebufferEXT'); -end; - -procedure Read_GL_EXT_framebuffer_multisample; -begin - glRenderbufferStorageMultisampleEXT := dglGetProcAddress('glRenderbufferStorageMultisampleEXT'); -end; - -procedure Read_GL_EXT_timer_query; -begin - glGetQueryObjecti64vEXT := dglGetProcAddress('glGetQueryObjecti64vEXT'); - glGetQueryObjectui64vEXT := dglGetProcAddress('glGetQueryObjectui64vEXT'); -end; - -procedure Read_GL_EXT_gpu_program_parameters; -begin - glProgramEnvParameters4fvEXT := dglGetProcAddress('glProgramEnvParameters4fvEXT'); - glProgramLocalParameters4fvEXT := dglGetProcAddress('glProgramLocalParameters4fvEXT'); -end; - -procedure Read_GL_EXT_bindable_uniform; -begin - glUniformBufferEXT := dglGetProcAddress('glUniformBufferEXT'); - glGetUniformBufferSizeEXT := dglGetProcAddress('glGetUniformBufferSizeEXT'); - glGetUniformOffsetEXT := dglGetProcAddress('glGetUniformOffsetEXT'); -end; - -procedure Read_GL_EXT_draw_buffers2; -begin - glColorMaskIndexedEXT := dglGetProcAddress('glColorMaskIndexedEXT'); - glGetBooleanIndexedvEXT := dglGetProcAddress('glGetBooleanIndexedvEXT'); - glGetIntegerIndexedvEXT := dglGetProcAddress('glGetIntegerIndexedvEXT'); - glEnableIndexedEXT := dglGetProcAddress('glEnableIndexedEXT'); - glDisableIndexedEXT := dglGetProcAddress('glDisableIndexedEXT'); - glIsEnabledIndexedEXT := dglGetProcAddress('glIsEnabledIndexedEXT'); -end; - -procedure Read_GL_EXT_draw_instanced; -begin - glDrawArraysInstancedEXT := dglGetProcAddress('glDrawArraysInstancedEXT'); - glDrawElementsInstancedEXT := dglGetProcAddress('glDrawElementsInstancedEXT'); -end; - -procedure Read_GL_EXT_geometry_shader4; -begin - glProgramParameteriEXT := dglGetProcAddress('glProgramParameteriEXT'); - glFramebufferTextureEXT := dglGetProcAddress('glFramebufferTextureEXT'); -// glFramebufferTextureLayerEXT := dglGetProcAddress('glFramebufferTextureLayerEXT'); - glFramebufferTextureFaceEXT := dglGetProcAddress('glFramebufferTextureFaceEXT'); -end; - -procedure Read_GL_EXT_gpu_shader4; -begin - glVertexAttribI1iEXT := dglGetProcAddress('glVertexAttribI1iEXT'); - glVertexAttribI2iEXT := dglGetProcAddress('glVertexAttribI2iEXT'); - glVertexAttribI3iEXT := dglGetProcAddress('glVertexAttribI3iEXT'); - glVertexAttribI4iEXT := dglGetProcAddress('glVertexAttribI4iEXT'); - glVertexAttribI1uiEXT := dglGetProcAddress('glVertexAttribI1uiEXT'); - glVertexAttribI2uiEXT := dglGetProcAddress('glVertexAttribI2uiEXT'); - glVertexAttribI3uiEXT := dglGetProcAddress('glVertexAttribI3uiEXT'); - glVertexAttribI4uiEXT := dglGetProcAddress('glVertexAttribI4uiEXT'); - glVertexAttribI1ivEXT := dglGetProcAddress('glVertexAttribI1ivEXT'); - glVertexAttribI2ivEXT := dglGetProcAddress('glVertexAttribI2ivEXT'); - glVertexAttribI3ivEXT := dglGetProcAddress('glVertexAttribI3ivEXT'); - glVertexAttribI4ivEXT := dglGetProcAddress('glVertexAttribI4ivEXT'); - glVertexAttribI1uivEXT := dglGetProcAddress('glVertexAttribI1uivEXT'); - glVertexAttribI2uivEXT := dglGetProcAddress('glVertexAttribI2uivEXT'); - glVertexAttribI3uivEXT := dglGetProcAddress('glVertexAttribI3uivEXT'); - glVertexAttribI4uivEXT := dglGetProcAddress('glVertexAttribI4uivEXT'); - glVertexAttribI4bvEXT := dglGetProcAddress('glVertexAttribI4bvEXT'); - glVertexAttribI4svEXT := dglGetProcAddress('glVertexAttribI4svEXT'); - glVertexAttribI4ubvEXT := dglGetProcAddress('glVertexAttribI4ubvEXT'); - glVertexAttribI4usvEXT := dglGetProcAddress('glVertexAttribI4usvEXT'); - glVertexAttribIPointerEXT := dglGetProcAddress('glVertexAttribIPointerEXT'); - glGetVertexAttribIivEXT := dglGetProcAddress('glGetVertexAttribIivEXT'); - glGetVertexAttribIuivEXT := dglGetProcAddress('glGetVertexAttribIuivEXT'); - glUniform1uiEXT := dglGetProcAddress('glUniform1uiEXT'); - glUniform2uiEXT := dglGetProcAddress('glUniform2uiEXT'); - glUniform3uiEXT := dglGetProcAddress('glUniform3uiEXT'); - glUniform4uiEXT := dglGetProcAddress('glUniform4uiEXT'); - glUniform1uivEXT := dglGetProcAddress('glUniform1uivEXT'); - glUniform2uivEXT := dglGetProcAddress('glUniform2uivEXT'); - glUniform3uivEXT := dglGetProcAddress('glUniform3uivEXT'); - glUniform4uivEXT := dglGetProcAddress('glUniform4uivEXT'); - glGetUniformuivEXT := dglGetProcAddress('glGetUniformuivEXT'); - glBindFragDataLocationEXT := dglGetProcAddress('glBindFragDataLocationEXT'); - glGetFragDataLocationEXT := dglGetProcAddress('glGetFragDataLocationEXT'); -end; - -procedure Read_GL_EXT_texture_array; -begin - glFramebufferTextureLayerEXT := dglGetProcAddress('glFramebufferTextureLayerEXT'); -end; - -procedure Read_GL_EXT_texture_buffer_object; -begin - glTexBufferEXT := dglGetProcAddress('glTexBufferEXT'); -end; - -procedure Read_GL_EXT_texture_integer; -begin - glClearColorIiEXT := dglGetProcAddress('glClearColorIiEXT'); - glClearColorIuiEXT := dglGetProcAddress('glClearColorIuiEXT'); - glTexParameterIivEXT := dglGetProcAddress('glTexParameterIivEXT'); - glTexParameterIuivEXT := dglGetProcAddress('glTexParameterIuivEXT'); - glGetTexParameterIivEXT := dglGetProcAddress('glGetTexParameterIivEXT'); - glGetTexParameterIiuvEXT := dglGetProcAddress('glGetTexParameterIiuvEXT'); -end; - -procedure Read_GL_EXT_transform_feedback; -begin - glBeginTransformFeedbackEXT := dglGetProcAddress('lBeginTransformFeedbackEXT'); - glEndTransformFeedbackEXT := dglGetProcAddress('glEndTransformFeedbackEXT'); - glBindBufferRangeEXT := dglGetProcAddress('glBindBufferRangeEXT'); - glBindBufferOffsetEXT := dglGetProcAddress('glBindBufferOffsetEXT'); - glBindBufferBaseEXT := dglGetProcAddress('glBindBufferBaseEXT'); - glTransformFeedbackVaryingsEXT := dglGetProcAddress('glTransformFeedbackVaryingsEXT'); - glGetTransformFeedbackVaryingEXT := dglGetProcAddress('glGetTransformFeedbackVaryingEXT'); -end; - -procedure Read_GL_EXT_direct_state_access; -begin - glClientAttribDefaultEXT := dglGetProcAddress('glClientAttribDefaultEXT'); - glPushClientAttribDefaultEXT := dglGetProcAddress('glPushClientAttribDefaultEXT'); - glMatrixLoadfEXT := dglGetProcAddress('glMatrixLoadfEXT'); - glMatrixLoaddEXT := dglGetProcAddress('glMatrixLoaddEXT'); - glMatrixMultfEXT := dglGetProcAddress('glMatrixMultfEXT'); - glMatrixMultdEXT := dglGetProcAddress('glMatrixMultdEXT'); - glMatrixLoadIdentityEXT := dglGetProcAddress('glMatrixLoadIdentityEXT'); - glMatrixRotatefEXT := dglGetProcAddress('glMatrixRotatefEXT'); - glMatrixRotatedEXT := dglGetProcAddress('glMatrixRotatedEXT'); - glMatrixScalefEXT := dglGetProcAddress('glMatrixScalefEXT'); - glMatrixScaledEXT := dglGetProcAddress('glMatrixScaledEXT'); - glMatrixTranslatefEXT := dglGetProcAddress('glMatrixTranslatefEXT'); - glMatrixTranslatedEXT := dglGetProcAddress('glMatrixTranslatedEXT'); - glMatrixFrustumEXT := dglGetProcAddress('glMatrixFrustumEXT'); - glMatrixOrthoEXT := dglGetProcAddress('glMatrixOrthoEXT'); - glMatrixPopEXT := dglGetProcAddress('glMatrixPopEXT'); - glMatrixPushEXT := dglGetProcAddress('glMatrixPushEXT'); - glMatrixLoadTransposefEXT := dglGetProcAddress('glMatrixLoadTransposefEXT'); - glMatrixLoadTransposedEXT := dglGetProcAddress('glMatrixLoadTransposedEXT'); - glMatrixMultTransposefEXT := dglGetProcAddress('glMatrixMultTransposefEXT'); - glMatrixMultTransposedEXT := dglGetProcAddress('glMatrixMultTransposedEXT'); - glTextureParameterfEXT := dglGetProcAddress('glTextureParameterfEXT'); - glTextureParameterfvEXT := dglGetProcAddress('glTextureParameterfvEXT'); - glTextureParameteriEXT := dglGetProcAddress('glTextureParameteriEXT'); - glTextureParameterivEXT := dglGetProcAddress('glTextureParameterivEXT'); - glTextureImage1DEXT := dglGetProcAddress('glTextureImage1DEXT'); - glTextureImage2DEXT := dglGetProcAddress('glTextureImage2DEXT'); - glTextureSubImage1DEXT := dglGetProcAddress('glTextureSubImage1DEXT'); - glTextureSubImage2DEXT := dglGetProcAddress('glTextureSubImage2DEXT'); - glCopyTextureImage1DEXT := dglGetProcAddress('glCopyTextureImage1DEXT'); - glCopyTextureImage2DEXT := dglGetProcAddress('glCopyTextureImage2DEXT'); - glCopyTextureSubImage1DEXT := dglGetProcAddress('glCopyTextureSubImage1DEXT'); - glCopyTextureSubImage2DEXT := dglGetProcAddress('glCopyTextureSubImage2DEXT'); - glGetTextureImageEXT := dglGetProcAddress('glGetTextureImageEXT'); - glGetTextureParameterfvEXT := dglGetProcAddress('glGetTextureParameterfvEXT'); - glGetTextureParameterivEXT := dglGetProcAddress('glGetTextureParameterivEXT'); - glGetTextureLevelParameterfvEXT := dglGetProcAddress('glGetTextureLevelParameterfvEXT'); - glGetTextureLevelParameterivEXT := dglGetProcAddress('glGetTextureLevelParameterivEXT'); - glTextureImage3DEXT := dglGetProcAddress('glTextureImage3DEXT'); - glTextureSubImage3DEXT := dglGetProcAddress('glTextureSubImage3DEXT'); - glCopyTextureSubImage3DEXT := dglGetProcAddress('glCopyTextureSubImage3DEXT'); - glMultiTexParameterfEXT := dglGetProcAddress('glMultiTexParameterfEXT'); - glMultiTexParameterfvEXT := dglGetProcAddress('glMultiTexParameterfvEXT'); - glMultiTexParameteriEXT := dglGetProcAddress('glMultiTexParameteriEXT'); - glMultiTexParameterivEXT := dglGetProcAddress('glMultiTexParameterivEXT'); - glMultiTexImage1DEXT := dglGetProcAddress('glMultiTexImage1DEXT'); - glMultiTexImage2DEXT := dglGetProcAddress('glMultiTexImage2DEXT'); - glMultiTexSubImage1DEXT := dglGetProcAddress('glMultiTexSubImage1DEXT'); - glMultiTexSubImage2DEXT := dglGetProcAddress('glMultiTexSubImage2DEXT'); - glCopyMultiTexImage1DEXT := dglGetProcAddress('glCopyMultiTexImage1DEXT'); - glCopyMultiTexImage2DEXT := dglGetProcAddress('glCopyMultiTexImage2DEXT'); - glCopyMultiTexSubImage1DEXT := dglGetProcAddress('glCopyMultiTexSubImage1DEXT'); - glCopyMultiTexSubImage2DEXT := dglGetProcAddress('glCopyMultiTexSubImage2DEXT'); - glGetMultiTexImageEXT := dglGetProcAddress('glGetMultiTexImageEXT'); - glGetMultiTexParameterfvEXT := dglGetProcAddress('glGetMultiTexParameterfvEXT'); - glGetMultiTexParameterivEXT := dglGetProcAddress('glGetMultiTexParameterivEXT'); - glGetMultiTexLevelParameterfvEXT := dglGetProcAddress('glGetMultiTexLevelParameterfvEXT'); - glGetMultiTexLevelParameterivEXT := dglGetProcAddress('glGetMultiTexLevelParameterivEXT'); - glMultiTexImage3DEXT := dglGetProcAddress('glMultiTexImage3DEXT'); - glMultiTexSubImage3DEXT := dglGetProcAddress('glMultiTexSubImage3DEXT'); - glCopyMultiTexSubImage3DEXT := dglGetProcAddress('glCopyMultiTexSubImage3DEXT'); - glBindMultiTextureEXT := dglGetProcAddress('glBindMultiTextureEXT'); - glEnableClientStateIndexedEXT := dglGetProcAddress('glEnableClientStateIndexedEXT'); - glDisableClientStateIndexedEXT := dglGetProcAddress('glDisableClientStateIndexedEXT'); - glMultiTexCoordPointerEXT := dglGetProcAddress('glMultiTexCoordPointerEXT'); - glMultiTexEnvfEXT := dglGetProcAddress('glMultiTexEnvfEXT'); - glMultiTexEnvfvEXT := dglGetProcAddress('glMultiTexEnvfvEXT'); - glMultiTexEnviEXT := dglGetProcAddress('glMultiTexEnviEXT'); - glMultiTexEnvivEXT := dglGetProcAddress('glMultiTexEnvivEXT'); - glMultiTexGendEXT := dglGetProcAddress('glMultiTexGendEXT'); - glMultiTexGendvEXT := dglGetProcAddress('glMultiTexGendvEXT'); - glMultiTexGenfEXT := dglGetProcAddress('glMultiTexGenfEXT'); - glMultiTexGenfvEXT := dglGetProcAddress('glMultiTexGenfvEXT'); - glMultiTexGeniEXT := dglGetProcAddress('glMultiTexGeniEXT'); - glMultiTexGenivEXT := dglGetProcAddress('glMultiTexGenivEXT'); - glGetMultiTexEnvfvEXT := dglGetProcAddress('glGetMultiTexEnvfvEXT'); - glGetMultiTexEnvivEXT := dglGetProcAddress('glGetMultiTexEnvivEXT'); - glGetMultiTexGendvEXT := dglGetProcAddress('glGetMultiTexGendvEXT'); - glGetMultiTexGenfvEXT := dglGetProcAddress('glGetMultiTexGenfvEXT'); - glGetMultiTexGenivEXT := dglGetProcAddress('glGetMultiTexGenivEXT'); - glGetFloatIndexedvEXT := dglGetProcAddress('glGetFloatIndexedvEXT'); - glGetDoubleIndexedvEXT := dglGetProcAddress('glGetDoubleIndexedvEXT'); - glGetPointerIndexedvEXT := dglGetProcAddress('glGetPointerIndexedvEXT'); - glCompressedTextureImage3DEXT := dglGetProcAddress('glCompressedTextureImage3DEXT'); - glCompressedTextureImage2DEXT := dglGetProcAddress('glCompressedTextureImage2DEXT'); - glCompressedTextureImage1DEXT := dglGetProcAddress('glCompressedTextureImage1DEXT'); - glCompressedTextureSubImage3DEXT := dglGetProcAddress('glCompressedTextureSubImage3DEXT'); - glCompressedTextureSubImage2DEXT := dglGetProcAddress('glCompressedTextureSubImage2DEXT'); - glCompressedTextureSubImage1DEXT := dglGetProcAddress('glCompressedTextureSubImage1DEXT'); - glGetCompressedTextureImageEXT := dglGetProcAddress('glGetCompressedTextureImageEXT'); - glCompressedMultiTexImage3DEXT := dglGetProcAddress('glCompressedMultiTexImage3DEXT'); - glCompressedMultiTexImage2DEXT := dglGetProcAddress('glCompressedMultiTexImage2DEXT'); - glCompressedMultiTexImage1DEXT := dglGetProcAddress('glCompressedMultiTexImage1DEXT'); - glCompressedMultiTexSubImage3DEXT := dglGetProcAddress('glCompressedMultiTexSubImage3DEXT'); - glCompressedMultiTexSubImage2DEXT := dglGetProcAddress('glCompressedMultiTexSubImage2DEXT'); - glCompressedMultiTexSubImage1DEXT := dglGetProcAddress('glCompressedMultiTexSubImage1DEXT'); - glGetCompressedMultiTexImageEXT := dglGetProcAddress('glGetCompressedMultiTexImageEXT'); - glNamedProgramStringEXT := dglGetProcAddress('glNamedProgramStringEXT'); - glNamedProgramLocalParameter4dEXT := dglGetProcAddress('glNamedProgramLocalParameter4dEXT'); - glNamedProgramLocalParameter4dvEXT := dglGetProcAddress('glNamedProgramLocalParameter4dvEXT'); - glNamedProgramLocalParameter4fEXT := dglGetProcAddress('glNamedProgramLocalParameter4fEXT'); - glNamedProgramLocalParameter4fvEXT := dglGetProcAddress('glNamedProgramLocalParameter4fvEXT'); - glGetNamedProgramLocalParameterdvEXT := dglGetProcAddress('glGetNamedProgramLocalParameterdvEXT'); - glGetNamedProgramLocalParameterfvEXT := dglGetProcAddress('glGetNamedProgramLocalParameterfvEXT'); - glGetNamedProgramivEXT := dglGetProcAddress('glGetNamedProgramivEXT'); - glGetNamedProgramStringEXT := dglGetProcAddress('glGetNamedProgramStringEXT'); - glNamedProgramLocalParameters4fvEXT := dglGetProcAddress('glNamedProgramLocalParameters4fvEXT'); - glNamedProgramLocalParameterI4iEXT := dglGetProcAddress('glNamedProgramLocalParameterI4iEXT'); - glNamedProgramLocalParameterI4ivEXT := dglGetProcAddress('glNamedProgramLocalParameterI4ivEXT'); - glNamedProgramLocalParametersI4ivEXT := dglGetProcAddress('glNamedProgramLocalParametersI4ivEXT'); - glNamedProgramLocalParameterI4uiEXT := dglGetProcAddress('glNamedProgramLocalParameterI4uiEXT'); - glNamedProgramLocalParameterI4uivEXT := dglGetProcAddress('glNamedProgramLocalParameterI4uivEXT'); - glNamedProgramLocalParametersI4uivEXT := dglGetProcAddress('glNamedProgramLocalParametersI4uivEXT'); - glGetNamedProgramLocalParameterIivEXT := dglGetProcAddress('glGetNamedProgramLocalParameterIivEXT'); - glGetNamedProgramLocalParameterIuivEXT := dglGetProcAddress('glGetNamedProgramLocalParameterIuivEXT'); - glTextureParameterIivEXT := dglGetProcAddress('glTextureParameterIivEXT'); - glTextureParameterIuivEXT := dglGetProcAddress('glTextureParameterIuivEXT'); - glGetTextureParameterIivEXT := dglGetProcAddress('glGetTextureParameterIivEXT'); - glGetTextureParameterIuivEXT := dglGetProcAddress('glGetTextureParameterIuivEXT'); - glMultiTexParameterIivEXT := dglGetProcAddress('glMultiTexParameterIivEXT'); - glMultiTexParameterIuivEXT := dglGetProcAddress('glMultiTexParameterIuivEXT'); - glGetMultiTexParameterIivEXT := dglGetProcAddress('glGetMultiTexParameterIivEXT'); - glGetMultiTexParameterIuivEXT := dglGetProcAddress('glGetMultiTexParameterIuivEXT'); - glProgramUniform1fEXT := dglGetProcAddress('glProgramUniform1fEXT'); - glProgramUniform2fEXT := dglGetProcAddress('glProgramUniform2fEXT'); - glProgramUniform3fEXT := dglGetProcAddress('glProgramUniform3fEXT'); - glProgramUniform4fEXT := dglGetProcAddress('glProgramUniform4fEXT'); - glProgramUniform1iEXT := dglGetProcAddress('glProgramUniform1iEXT'); - glProgramUniform2iEXT := dglGetProcAddress('glProgramUniform2iEXT'); - glProgramUniform3iEXT := dglGetProcAddress('glProgramUniform3iEXT'); - glProgramUniform4iEXT := dglGetProcAddress('glProgramUniform4iEXT'); - glProgramUniform1fvEXT := dglGetProcAddress('glProgramUniform1fvEXT'); - glProgramUniform2fvEXT := dglGetProcAddress('glProgramUniform2fvEXT'); - glProgramUniform3fvEXT := dglGetProcAddress('glProgramUniform3fvEXT'); - glProgramUniform4fvEXT := dglGetProcAddress('glProgramUniform4fvEXT'); - glProgramUniform1ivEXT := dglGetProcAddress('glProgramUniform1ivEXT'); - glProgramUniform2ivEXT := dglGetProcAddress('glProgramUniform2ivEXT'); - glProgramUniform3ivEXT := dglGetProcAddress('glProgramUniform3ivEXT'); - glProgramUniform4ivEXT := dglGetProcAddress('glProgramUniform4ivEXT'); - glProgramUniformMatrix2fvEXT := dglGetProcAddress('glProgramUniformMatrix2fvEXT'); - glProgramUniformMatrix3fvEXT := dglGetProcAddress('glProgramUniformMatrix3fvEXT'); - glProgramUniformMatrix4fvEXT := dglGetProcAddress('glProgramUniformMatrix4fvEXT'); - glProgramUniformMatrix2x3fvEXT := dglGetProcAddress('glProgramUniformMatrix2x3fvEXT'); - glProgramUniformMatrix3x2fvEXT := dglGetProcAddress('glProgramUniformMatrix3x2fvEXT'); - glProgramUniformMatrix2x4fvEXT := dglGetProcAddress('glProgramUniformMatrix2x4fvEXT'); - glProgramUniformMatrix4x2fvEXT := dglGetProcAddress('glProgramUniformMatrix4x2fvEXT'); - glProgramUniformMatrix3x4fvEXT := dglGetProcAddress('glProgramUniformMatrix3x4fvEXT'); - glProgramUniformMatrix4x3fvEXT := dglGetProcAddress('glProgramUniformMatrix4x3fvEXT'); - glProgramUniform1uiEXT := dglGetProcAddress('glProgramUniform1uiEXT'); - glProgramUniform2uiEXT := dglGetProcAddress('glProgramUniform2uiEXT'); - glProgramUniform3uiEXT := dglGetProcAddress('glProgramUniform3uiEXT'); - glProgramUniform4uiEXT := dglGetProcAddress('glProgramUniform4uiEXT'); - glProgramUniform1uivEXT := dglGetProcAddress('glProgramUniform1uivEXT'); - glProgramUniform2uivEXT := dglGetProcAddress('glProgramUniform2uivEXT'); - glProgramUniform3uivEXT := dglGetProcAddress('glProgramUniform3uivEXT'); - glProgramUniform4uivEXT := dglGetProcAddress('glProgramUniform4uivEXT'); - glNamedBufferDataEXT := dglGetProcAddress('glNamedBufferDataEXT'); - glNamedBufferSubDataEXT := dglGetProcAddress('glNamedBufferSubDataEXT'); - glMapNamedBufferEXT := dglGetProcAddress('glMapNamedBufferEXT'); - glUnmapNamedBufferEXT := dglGetProcAddress('glUnmapNamedBufferEXT'); - glMapNamedBufferRangeEXT := dglGetProcAddress('glMapNamedBufferRangeEXT'); - glFlushMappedNamedBufferRangeEXT := dglGetProcAddress('glFlushMappedNamedBufferRangeEXT'); - glNamedCopyBufferSubDataEXT := dglGetProcAddress('glNamedCopyBufferSubDataEXT'); - glGetNamedBufferParameterivEXT := dglGetProcAddress('glGetNamedBufferParameterivEXT'); - glGetNamedBufferPointervEXT := dglGetProcAddress('glGetNamedBufferPointervEXT'); - glGetNamedBufferSubDataEXT := dglGetProcAddress('glGetNamedBufferSubDataEXT'); - glTextureBufferEXT := dglGetProcAddress('glTextureBufferEXT'); - glMultiTexBufferEXT := dglGetProcAddress('glMultiTexBufferEXT'); - glNamedRenderbufferStorageEXT := dglGetProcAddress('glNamedRenderbufferStorageEXT'); - glGetNamedRenderbufferParameterivEXT := dglGetProcAddress('glGetNamedRenderbufferParameterivEXT'); - glCheckNamedFramebufferStatusEXT := dglGetProcAddress('glCheckNamedFramebufferStatusEXT'); - glNamedFramebufferTexture1DEXT := dglGetProcAddress('glNamedFramebufferTexture1DEXT'); - glNamedFramebufferTexture2DEXT := dglGetProcAddress('glNamedFramebufferTexture2DEXT'); - glNamedFramebufferTexture3DEXT := dglGetProcAddress('glNamedFramebufferTexture3DEXT'); - glNamedFramebufferRenderbufferEXT := dglGetProcAddress('glNamedFramebufferRenderbufferEXT'); - glGetNamedFramebufferAttachmentParameterivEXT := dglGetProcAddress('glGetNamedFramebufferAttachmentParameterivEXT'); - glGenerateTextureMipmapEXT := dglGetProcAddress('glGenerateTextureMipmapEXT'); - glGenerateMultiTexMipmapEXT := dglGetProcAddress('glGenerateMultiTexMipmapEXT'); - glFramebufferDrawBufferEXT := dglGetProcAddress('glFramebufferDrawBufferEXT'); - glFramebufferDrawBuffersEXT := dglGetProcAddress('glFramebufferDrawBuffersEXT'); - glFramebufferReadBufferEXT := dglGetProcAddress('glFramebufferReadBufferEXT'); - glGetFramebufferParameterivEXT := dglGetProcAddress('glGetFramebufferParameterivEXT'); - glNamedRenderbufferStorageMultisampleEXT := dglGetProcAddress('glNamedRenderbufferStorageMultisampleEXT'); - glNamedRenderbufferStorageMultisampleCoverageEXT := dglGetProcAddress('glNamedRenderbufferStorageMultisampleCoverageEXT'); - glNamedFramebufferTextureEXT := dglGetProcAddress('glNamedFramebufferTextureEXT'); - glNamedFramebufferTextureLayerEXT := dglGetProcAddress('glNamedFramebufferTextureLayerEXT'); - glNamedFramebufferTextureFaceEXT := dglGetProcAddress('glNamedFramebufferTextureFaceEXT'); - glTextureRenderbufferEXT := dglGetProcAddress('glTextureRenderbufferEXT'); - glMultiTexRenderbufferEXT := dglGetProcAddress('glMultiTexRenderbufferEXT'); - glProgramUniform1dEXT := dglGetProcAddress('glProgramUniform1dEXT'); - glProgramUniform2dEXT := dglGetProcAddress('glProgramUniform2dEXT'); - glProgramUniform3dEXT := dglGetProcAddress('glProgramUniform3dEXT'); - glProgramUniform4dEXT := dglGetProcAddress('glProgramUniform4dEXT'); - glProgramUniform1dvEXT := dglGetProcAddress('glProgramUniform1dvEXT'); - glProgramUniform2dvEXT := dglGetProcAddress('glProgramUniform2dvEXT'); - glProgramUniform3dvEXT := dglGetProcAddress('glProgramUniform3dvEXT'); - glProgramUniform4dvEXT := dglGetProcAddress('glProgramUniform4dvEXT'); - glProgramUniformMatrix2dvEXT := dglGetProcAddress('glProgramUniformMatrix2dvEXT'); - glProgramUniformMatrix3dvEXT := dglGetProcAddress('glProgramUniformMatrix3dvEXT'); - glProgramUniformMatrix4dvEXT := dglGetProcAddress('glProgramUniformMatrix4dvEXT'); - glProgramUniformMatrix2x3dvEXT := dglGetProcAddress('glProgramUniformMatrix2x3dvEXT'); - glProgramUniformMatrix2x4dvEXT := dglGetProcAddress('glProgramUniformMatrix2x4dvEXT'); - glProgramUniformMatrix3x2dvEXT := dglGetProcAddress('glProgramUniformMatrix3x2dvEXT'); - glProgramUniformMatrix3x4dvEXT := dglGetProcAddress('glProgramUniformMatrix3x4dvEXT'); - glProgramUniformMatrix4x2dvEXT := dglGetProcAddress('glProgramUniformMatrix4x2dvEXT'); - glProgramUniformMatrix4x3dvEXT := dglGetProcAddress('glProgramUniformMatrix4x3dvEXT'); -end; - -procedure Read_GL_EXT_separate_shader_objects; -begin - glUseShaderProgramEXT := dglGetProcAddress('glUseShaderProgramEXT'); - glActiveProgramEXT := dglGetProcAddress('glActiveProgramEXT'); - glCreateShaderProgramEXT := dglGetProcAddress('glCreateShaderProgramEXT'); -end; - -procedure Read_GL_EXT_shader_image_load_store; -begin - glBindImageTextureEXT := dglGetProcAddress('glBindImageTextureEXT'); - glMemoryBarrierEXT := dglGetProcAddress('glMemoryBarrierEXT'); -end; - -procedure Read_GL_EXT_vertex_attrib_64bit; -begin - glVertexAttribL1dEXT := dglGetProcAddress('glVertexAttribL1dEXT'); - glVertexAttribL2dEXT := dglGetProcAddress('glVertexAttribL2dEXT'); - glVertexAttribL3dEXT := dglGetProcAddress('glVertexAttribL3dEXT'); - glVertexAttribL4dEXT := dglGetProcAddress('glVertexAttribL4dEXT'); - glVertexAttribL1dvEXT := dglGetProcAddress('glVertexAttribL1dvEXT'); - glVertexAttribL2dvEXT := dglGetProcAddress('glVertexAttribL2dvEXT'); - glVertexAttribL3dvEXT := dglGetProcAddress('glVertexAttribL3dvEXT'); - glVertexAttribL4dvEXT := dglGetProcAddress('glVertexAttribL4dvEXT'); - glVertexAttribLPointerEXT := dglGetProcAddress('glVertexAttribLPointerEXT'); - glGetVertexAttribLdvEXT := dglGetProcAddress('glGetVertexAttribLdvEXT'); - glVertexArrayVertexAttribLOffsetEXT := dglGetProcAddress('glVertexArrayVertexAttribLOffsetEXT'); -end; - -procedure Read_GL_HP_image_transform; -begin - glImageTransformParameteriHP := dglGetProcAddress('glImageTransformParameteriHP'); - glImageTransformParameterfHP := dglGetProcAddress('glImageTransformParameterfHP'); - glImageTransformParameterivHP := dglGetProcAddress('glImageTransformParameterivHP'); - glImageTransformParameterfvHP := dglGetProcAddress('glImageTransformParameterfvHP'); - glGetImageTransformParameterivHP := dglGetProcAddress('glGetImageTransformParameterivHP'); - glGetImageTransformParameterfvHP := dglGetProcAddress('glGetImageTransformParameterfvHP'); -end; - -procedure Read_GL_IBM_multimode_draw_arrays; -begin - glMultiModeDrawArraysIBM := dglGetProcAddress('glMultiModeDrawArraysIBM'); - glMultiModeDrawElementsIBM := dglGetProcAddress('glMultiModeDrawElementsIBM'); -end; - -procedure Read_GL_IBM_vertex_array_lists; -begin - glColorPointerListIBM := dglGetProcAddress('glColorPointerListIBM'); - glSecondaryColorPointerListIBM := dglGetProcAddress('glSecondaryColorPointerListIBM'); - glEdgeFlagPointerListIBM := dglGetProcAddress('glEdgeFlagPointerListIBM'); - glFogCoordPointerListIBM := dglGetProcAddress('glFogCoordPointerListIBM'); - glIndexPointerListIBM := dglGetProcAddress('glIndexPointerListIBM'); - glNormalPointerListIBM := dglGetProcAddress('glNormalPointerListIBM'); - glTexCoordPointerListIBM := dglGetProcAddress('glTexCoordPointerListIBM'); - glVertexPointerListIBM := dglGetProcAddress('glVertexPointerListIBM'); -end; - -procedure Read_GL_INGR_blend_func_separate; -begin - glBlendFuncSeparateINGR := dglGetProcAddress('glBlendFuncSeparateINGR'); -end; - -procedure Read_GL_INTEL_parallel_arrays; -begin - glVertexPointervINTEL := dglGetProcAddress('glVertexPointervINTEL'); - glNormalPointervINTEL := dglGetProcAddress('glNormalPointervINTEL'); - glColorPointervINTEL := dglGetProcAddress('glColorPointervINTEL'); - glTexCoordPointervINTEL := dglGetProcAddress('glTexCoordPointervINTEL'); -end; - -procedure Read_GL_MESA_resize_buffers; -begin - glResizeBuffersMESA := dglGetProcAddress('glResizeBuffersMESA'); -end; - -procedure Read_GL_MESA_window_pos; -begin - glWindowPos2dMESA := dglGetProcAddress('glWindowPos2dMESA'); - glWindowPos2dvMESA := dglGetProcAddress('glWindowPos2dvMESA'); - glWindowPos2fMESA := dglGetProcAddress('glWindowPos2fMESA'); - glWindowPos2fvMESA := dglGetProcAddress('glWindowPos2fvMESA'); - glWindowPos2iMESA := dglGetProcAddress('glWindowPos2iMESA'); - glWindowPos2ivMESA := dglGetProcAddress('glWindowPos2ivMESA'); - glWindowPos2sMESA := dglGetProcAddress('glWindowPos2sMESA'); - glWindowPos2svMESA := dglGetProcAddress('glWindowPos2svMESA'); - glWindowPos3dMESA := dglGetProcAddress('glWindowPos3dMESA'); - glWindowPos3dvMESA := dglGetProcAddress('glWindowPos3dvMESA'); - glWindowPos3fMESA := dglGetProcAddress('glWindowPos3fMESA'); - glWindowPos3fvMESA := dglGetProcAddress('glWindowPos3fvMESA'); - glWindowPos3iMESA := dglGetProcAddress('glWindowPos3iMESA'); - glWindowPos3ivMESA := dglGetProcAddress('glWindowPos3ivMESA'); - glWindowPos3sMESA := dglGetProcAddress('glWindowPos3sMESA'); - glWindowPos3svMESA := dglGetProcAddress('glWindowPos3svMESA'); - glWindowPos4dMESA := dglGetProcAddress('glWindowPos4dMESA'); - glWindowPos4dvMESA := dglGetProcAddress('glWindowPos4dvMESA'); - glWindowPos4fMESA := dglGetProcAddress('glWindowPos4fMESA'); - glWindowPos4fvMESA := dglGetProcAddress('glWindowPos4fvMESA'); - glWindowPos4iMESA := dglGetProcAddress('glWindowPos4iMESA'); - glWindowPos4ivMESA := dglGetProcAddress('glWindowPos4ivMESA'); - glWindowPos4sMESA := dglGetProcAddress('glWindowPos4sMESA'); - glWindowPos4svMESA := dglGetProcAddress('glWindowPos4svMESA'); -end; - -procedure Read_GL_NV_evaluators; -begin - glMapControlPointsNV := dglGetProcAddress('glMapControlPointsNV'); - glMapParameterivNV := dglGetProcAddress('glMapParameterivNV'); - glMapParameterfvNV := dglGetProcAddress('glMapParameterfvNV'); - glGetMapControlPointsNV := dglGetProcAddress('glGetMapControlPointsNV'); - glGetMapParameterivNV := dglGetProcAddress('glGetMapParameterivNV'); - glGetMapParameterfvNV := dglGetProcAddress('glGetMapParameterfvNV'); - glGetMapAttribParameterivNV := dglGetProcAddress('glGetMapAttribParameterivNV'); - glGetMapAttribParameterfvNV := dglGetProcAddress('glGetMapAttribParameterfvNV'); - glEvalMapsNV := dglGetProcAddress('glEvalMapsNV'); -end; - -procedure Read_GL_NV_fence; -begin - glDeleteFencesNV := dglGetProcAddress('glDeleteFencesNV'); - glGenFencesNV := dglGetProcAddress('glGenFencesNV'); - glIsFenceNV := dglGetProcAddress('glIsFenceNV'); - glTestFenceNV := dglGetProcAddress('glTestFenceNV'); - glGetFenceivNV := dglGetProcAddress('glGetFenceivNV'); - glFinishFenceNV := dglGetProcAddress('glFinishFenceNV'); - glSetFenceNV := dglGetProcAddress('glSetFenceNV'); -end; - -procedure Read_GL_NV_fragment_program; -begin - glProgramNamedParameter4fNV := dglGetProcAddress('glProgramNamedParameter4fNV'); - glProgramNamedParameter4dNV := dglGetProcAddress('glProgramNamedParameter4dNV'); - glProgramNamedParameter4fvNV := dglGetProcAddress('glProgramNamedParameter4fvNV'); - glProgramNamedParameter4dvNV := dglGetProcAddress('glProgramNamedParameter4dvNV'); - glGetProgramNamedParameterfvNV := dglGetProcAddress('glGetProgramNamedParameterfvNV'); - glGetProgramNamedParameterdvNV := dglGetProcAddress('glGetProgramNamedParameterdvNV'); -end; - -procedure Read_GL_NV_half_float; -begin - glVertex2hNV := dglGetProcAddress('glVertex2hNV'); - glVertex2hvNV := dglGetProcAddress('glVertex2hvNV'); - glVertex3hNV := dglGetProcAddress('glVertex3hNV'); - glVertex3hvNV := dglGetProcAddress('glVertex3hvNV'); - glVertex4hNV := dglGetProcAddress('glVertex4hNV'); - glVertex4hvNV := dglGetProcAddress('glVertex4hvNV'); - glNormal3hNV := dglGetProcAddress('glNormal3hNV'); - glNormal3hvNV := dglGetProcAddress('glNormal3hvNV'); - glColor3hNV := dglGetProcAddress('glColor3hNV'); - glColor3hvNV := dglGetProcAddress('glColor3hvNV'); - glColor4hNV := dglGetProcAddress('glColor4hNV'); - glColor4hvNV := dglGetProcAddress('glColor4hvNV'); - glTexCoord1hNV := dglGetProcAddress('glTexCoord1hNV'); - glTexCoord1hvNV := dglGetProcAddress('glTexCoord1hvNV'); - glTexCoord2hNV := dglGetProcAddress('glTexCoord2hNV'); - glTexCoord2hvNV := dglGetProcAddress('glTexCoord2hvNV'); - glTexCoord3hNV := dglGetProcAddress('glTexCoord3hNV'); - glTexCoord3hvNV := dglGetProcAddress('glTexCoord3hvNV'); - glTexCoord4hNV := dglGetProcAddress('glTexCoord4hNV'); - glTexCoord4hvNV := dglGetProcAddress('glTexCoord4hvNV'); - glMultiTexCoord1hNV := dglGetProcAddress('glMultiTexCoord1hNV'); - glMultiTexCoord1hvNV := dglGetProcAddress('glMultiTexCoord1hvNV'); - glMultiTexCoord2hNV := dglGetProcAddress('glMultiTexCoord2hNV'); - glMultiTexCoord2hvNV := dglGetProcAddress('glMultiTexCoord2hvNV'); - glMultiTexCoord3hNV := dglGetProcAddress('glMultiTexCoord3hNV'); - glMultiTexCoord3hvNV := dglGetProcAddress('glMultiTexCoord3hvNV'); - glMultiTexCoord4hNV := dglGetProcAddress('glMultiTexCoord4hNV'); - glMultiTexCoord4hvNV := dglGetProcAddress('glMultiTexCoord4hvNV'); - glFogCoordhNV := dglGetProcAddress('glFogCoordhNV'); - glFogCoordhvNV := dglGetProcAddress('glFogCoordhvNV'); - glSecondaryColor3hNV := dglGetProcAddress('glSecondaryColor3hNV'); - glSecondaryColor3hvNV := dglGetProcAddress('glSecondaryColor3hvNV'); - glVertexWeighthNV := dglGetProcAddress('glVertexWeighthNV'); - glVertexWeighthvNV := dglGetProcAddress('glVertexWeighthvNV'); - glVertexAttrib1hNV := dglGetProcAddress('glVertexAttrib1hNV'); - glVertexAttrib1hvNV := dglGetProcAddress('glVertexAttrib1hvNV'); - glVertexAttrib2hNV := dglGetProcAddress('glVertexAttrib2hNV'); - glVertexAttrib2hvNV := dglGetProcAddress('glVertexAttrib2hvNV'); - glVertexAttrib3hNV := dglGetProcAddress('glVertexAttrib3hNV'); - glVertexAttrib3hvNV := dglGetProcAddress('glVertexAttrib3hvNV'); - glVertexAttrib4hNV := dglGetProcAddress('glVertexAttrib4hNV'); - glVertexAttrib4hvNV := dglGetProcAddress('glVertexAttrib4hvNV'); - glVertexAttribs1hvNV := dglGetProcAddress('glVertexAttribs1hvNV'); - glVertexAttribs2hvNV := dglGetProcAddress('glVertexAttribs2hvNV'); - glVertexAttribs3hvNV := dglGetProcAddress('glVertexAttribs3hvNV'); - glVertexAttribs4hvNV := dglGetProcAddress('glVertexAttribs4hvNV'); -end; - -procedure Read_GL_NV_occlusion_query; -begin - glGenOcclusionQueriesNV := dglGetProcAddress('glGenOcclusionQueriesNV'); - glDeleteOcclusionQueriesNV := dglGetProcAddress('glDeleteOcclusionQueriesNV'); - glIsOcclusionQueryNV := dglGetProcAddress('glIsOcclusionQueryNV'); - glBeginOcclusionQueryNV := dglGetProcAddress('glBeginOcclusionQueryNV'); - glEndOcclusionQueryNV := dglGetProcAddress('glEndOcclusionQueryNV'); - glGetOcclusionQueryivNV := dglGetProcAddress('glGetOcclusionQueryivNV'); - glGetOcclusionQueryuivNV := dglGetProcAddress('glGetOcclusionQueryuivNV'); -end; - -procedure Read_GL_NV_pixel_data_range; -begin - glPixelDataRangeNV := dglGetProcAddress('glPixelDataRangeNV'); - glFlushPixelDataRangeNV := dglGetProcAddress('glFlushPixelDataRangeNV'); -end; - -procedure Read_GL_NV_point_sprite; -begin - glPointParameteriNV := dglGetProcAddress('glPointParameteriNV'); - glPointParameterivNV := dglGetProcAddress('glPointParameterivNV'); -end; - -procedure Read_GL_NV_primitive_restart; -begin - glPrimitiveRestartNV := dglGetProcAddress('glPrimitiveRestartNV'); - glPrimitiveRestartIndexNV := dglGetProcAddress('glPrimitiveRestartIndexNV'); -end; - -procedure Read_GL_NV_register_combiners; -begin - glCombinerParameterfvNV := dglGetProcAddress('glCombinerParameterfvNV'); - glCombinerParameterfNV := dglGetProcAddress('glCombinerParameterfNV'); - glCombinerParameterivNV := dglGetProcAddress('glCombinerParameterivNV'); - glCombinerParameteriNV := dglGetProcAddress('glCombinerParameteriNV'); - glCombinerInputNV := dglGetProcAddress('glCombinerInputNV'); - glCombinerOutputNV := dglGetProcAddress('glCombinerOutputNV'); - glFinalCombinerInputNV := dglGetProcAddress('glFinalCombinerInputNV'); - glGetCombinerInputParameterfvNV := dglGetProcAddress('glGetCombinerInputParameterfvNV'); - glGetCombinerInputParameterivNV := dglGetProcAddress('glGetCombinerInputParameterivNV'); - glGetCombinerOutputParameterfvNV := dglGetProcAddress('glGetCombinerOutputParameterfvNV'); - glGetCombinerOutputParameterivNV := dglGetProcAddress('glGetCombinerOutputParameterivNV'); - glGetFinalCombinerInputParameterfvNV := dglGetProcAddress('glGetFinalCombinerInputParameterfvNV'); - glGetFinalCombinerInputParameterivNV := dglGetProcAddress('glGetFinalCombinerInputParameterivNV'); -end; - -procedure Read_GL_NV_register_combiners2; -begin - glCombinerStageParameterfvNV := dglGetProcAddress('glCombinerStageParameterfvNV'); - glGetCombinerStageParameterfvNV := dglGetProcAddress('glGetCombinerStageParameterfvNV'); -end; - -procedure Read_GL_NV_vertex_array_range; -begin - glFlushVertexArrayRangeNV := dglGetProcAddress('glFlushVertexArrayRangeNV'); - glVertexArrayRangeNV := dglGetProcAddress('glVertexArrayRangeNV'); -end; - -procedure Read_GL_NV_vertex_program; -begin - glAreProgramsResidentNV := dglGetProcAddress('glAreProgramsResidentNV'); - glBindProgramNV := dglGetProcAddress('glBindProgramNV'); - glDeleteProgramsNV := dglGetProcAddress('glDeleteProgramsNV'); - glExecuteProgramNV := dglGetProcAddress('glExecuteProgramNV'); - glGenProgramsNV := dglGetProcAddress('glGenProgramsNV'); - glGetProgramParameterdvNV := dglGetProcAddress('glGetProgramParameterdvNV'); - glGetProgramParameterfvNV := dglGetProcAddress('glGetProgramParameterfvNV'); - glGetProgramivNV := dglGetProcAddress('glGetProgramivNV'); - glGetProgramStringNV := dglGetProcAddress('glGetProgramStringNV'); - glGetTrackMatrixivNV := dglGetProcAddress('glGetTrackMatrixivNV'); - glGetVertexAttribdvNV := dglGetProcAddress('glGetVertexAttribdvNV'); - glGetVertexAttribfvNV := dglGetProcAddress('glGetVertexAttribfvNV'); - glGetVertexAttribivNV := dglGetProcAddress('glGetVertexAttribivNV'); - glGetVertexAttribPointervNV := dglGetProcAddress('glGetVertexAttribPointervNV'); - glIsProgramNV := dglGetProcAddress('glIsProgramNV'); - glLoadProgramNV := dglGetProcAddress('glLoadProgramNV'); - glProgramParameter4dNV := dglGetProcAddress('glProgramParameter4dNV'); - glProgramParameter4dvNV := dglGetProcAddress('glProgramParameter4dvNV'); - glProgramParameter4fNV := dglGetProcAddress('glProgramParameter4fNV'); - glProgramParameter4fvNV := dglGetProcAddress('glProgramParameter4fvNV'); - glProgramParameters4dvNV := dglGetProcAddress('glProgramParameters4dvNV'); - glProgramParameters4fvNV := dglGetProcAddress('glProgramParameters4fvNV'); - glRequestResidentProgramsNV := dglGetProcAddress('glRequestResidentProgramsNV'); - glTrackMatrixNV := dglGetProcAddress('glTrackMatrixNV'); - glVertexAttribPointerNV := dglGetProcAddress('glVertexAttribPointerNV'); - glVertexAttrib1dNV := dglGetProcAddress('glVertexAttrib1dNV'); - glVertexAttrib1dvNV := dglGetProcAddress('glVertexAttrib1dvNV'); - glVertexAttrib1fNV := dglGetProcAddress('glVertexAttrib1fNV'); - glVertexAttrib1fvNV := dglGetProcAddress('glVertexAttrib1fvNV'); - glVertexAttrib1sNV := dglGetProcAddress('glVertexAttrib1sNV'); - glVertexAttrib1svNV := dglGetProcAddress('glVertexAttrib1svNV'); - glVertexAttrib2dNV := dglGetProcAddress('glVertexAttrib2dNV'); - glVertexAttrib2dvNV := dglGetProcAddress('glVertexAttrib2dvNV'); - glVertexAttrib2fNV := dglGetProcAddress('glVertexAttrib2fNV'); - glVertexAttrib2fvNV := dglGetProcAddress('glVertexAttrib2fvNV'); - glVertexAttrib2sNV := dglGetProcAddress('glVertexAttrib2sNV'); - glVertexAttrib2svNV := dglGetProcAddress('glVertexAttrib2svNV'); - glVertexAttrib3dNV := dglGetProcAddress('glVertexAttrib3dNV'); - glVertexAttrib3dvNV := dglGetProcAddress('glVertexAttrib3dvNV'); - glVertexAttrib3fNV := dglGetProcAddress('glVertexAttrib3fNV'); - glVertexAttrib3fvNV := dglGetProcAddress('glVertexAttrib3fvNV'); - glVertexAttrib3sNV := dglGetProcAddress('glVertexAttrib3sNV'); - glVertexAttrib3svNV := dglGetProcAddress('glVertexAttrib3svNV'); - glVertexAttrib4dNV := dglGetProcAddress('glVertexAttrib4dNV'); - glVertexAttrib4dvNV := dglGetProcAddress('glVertexAttrib4dvNV'); - glVertexAttrib4fNV := dglGetProcAddress('glVertexAttrib4fNV'); - glVertexAttrib4fvNV := dglGetProcAddress('glVertexAttrib4fvNV'); - glVertexAttrib4sNV := dglGetProcAddress('glVertexAttrib4sNV'); - glVertexAttrib4svNV := dglGetProcAddress('glVertexAttrib4svNV'); - glVertexAttrib4ubNV := dglGetProcAddress('glVertexAttrib4ubNV'); - glVertexAttrib4ubvNV := dglGetProcAddress('glVertexAttrib4ubvNV'); - glVertexAttribs1dvNV := dglGetProcAddress('glVertexAttribs1dvNV'); - glVertexAttribs1fvNV := dglGetProcAddress('glVertexAttribs1fvNV'); - glVertexAttribs1svNV := dglGetProcAddress('glVertexAttribs1svNV'); - glVertexAttribs2dvNV := dglGetProcAddress('glVertexAttribs2dvNV'); - glVertexAttribs2fvNV := dglGetProcAddress('glVertexAttribs2fvNV'); - glVertexAttribs2svNV := dglGetProcAddress('glVertexAttribs2svNV'); - glVertexAttribs3dvNV := dglGetProcAddress('glVertexAttribs3dvNV'); - glVertexAttribs3fvNV := dglGetProcAddress('glVertexAttribs3fvNV'); - glVertexAttribs3svNV := dglGetProcAddress('glVertexAttribs3svNV'); - glVertexAttribs4dvNV := dglGetProcAddress('glVertexAttribs4dvNV'); - glVertexAttribs4fvNV := dglGetProcAddress('glVertexAttribs4fvNV'); - glVertexAttribs4svNV := dglGetProcAddress('glVertexAttribs4svNV'); - glVertexAttribs4ubvNV := dglGetProcAddress('glVertexAttribs4ubvNV'); -end; - -procedure Read_GL_NV_depth_buffer_float; -begin - glDepthRangedNV := dglGetProcAddress('glDepthRangedNV'); - glClearDepthdNV := dglGetProcAddress('glClearDepthdNV'); - glDepthBoundsdNV := dglGetProcAddress('glDepthBoundsdNV'); -end; - -procedure Read_GL_NV_framebuffer_multisample_coverage; -begin - glRenderbufferStorageMultsampleCoverageNV := dglGetProcAddress('glRenderbufferStorageMultsampleCoverageNV'); -end; - -procedure Read_GL_NV_geometry_program4; -begin - glProgramVertexLimitNV := dglGetProcAddress('glProgramVertexLimitNV'); -end; - -procedure Read_GL_NV_gpu_program4; -begin - glProgramLocalParameterI4iNV := dglGetProcAddress('glProgramLocalParameterI4iNV'); - glProgramLocalParameterI4ivNV := dglGetProcAddress('glProgramLocalParameterI4ivNV'); - glProgramLocalParametersI4ivNV := dglGetProcAddress('glProgramLocalParametersI4ivNV'); - glProgramLocalParameterI4uiNV := dglGetProcAddress('glProgramLocalParameterI4uiNV'); - glProgramLocalParameterI4uivNV := dglGetProcAddress('glProgramLocalParameterI4uivNV'); - glProgramLocalParametersI4uivNV := dglGetProcAddress('glProgramLocalParametersI4uivNV'); - glProgramEnvParameterI4iNV := dglGetProcAddress('glProgramEnvParameterI4iNV'); - glProgramEnvParameterI4ivNV := dglGetProcAddress('glProgramEnvParameterI4ivNV'); - glProgramEnvParametersI4ivNV := dglGetProcAddress('glProgramEnvParametersI4ivNV'); - glProgramEnvParameterI4uiNV := dglGetProcAddress('glProgramEnvParameterI4uiNV'); - glProgramEnvParameterI4uivNV := dglGetProcAddress('glProgramEnvParameterI4uivNV'); - glProgramEnvParametersI4uivNV := dglGetProcAddress('glProgramEnvParametersI4uivNV'); - glGetProgramLocalParameterIivNV := dglGetProcAddress('glGetProgramLocalParameterIivNV'); - glGetProgramLocalParameterIuivNV := dglGetProcAddress('glGetProgramLocalParameterIuivNV'); - glGetProgramEnvParameterIivNV := dglGetProcAddress('glGetProgramEnvParameterIivNV'); - glGetProgramEnvParameterIuivNV := dglGetProcAddress('glGetProgramEnvParameterIuivNV'); -end; - -procedure Read_GL_NV_parameter_buffer_object; -begin - glProgramBufferParametersfvNV := dglGetProcAddress('glProgramBufferParametersfvNV'); - glProgramBufferParametersIivNV := dglGetProcAddress('glProgramBufferParametersIivNV'); - glProgramBufferParametersIuivNV := dglGetProcAddress('glProgramBufferParametersIuivNV'); -end; - -procedure Read_GL_NV_transform_feedback; -begin - glBeginTransformFeedbackNV := dglGetProcAddress('glBeginTransformFeedbackNV'); - glEndTransformFeedbackNV := dglGetProcAddress('glEndTransformFeedbackNV'); - glTransformFeedbackAttribsNV := dglGetProcAddress('glTransformFeedbackAttribsNV'); - glBindBufferRangeNV := dglGetProcAddress('glBindBufferRangeNV'); - glBindBufferOffsetNV := dglGetProcAddress('glBindBufferOffsetNV'); - glBindBufferBaseNV := dglGetProcAddress('glBindBufferBaseNV'); - glTransformFeedbackVaryingsNV := dglGetProcAddress('glTransformFeedbackVaryingsNV'); - glActiveVaryingNV := dglGetProcAddress('glActiveVaryingNV'); - glGetVaryingLocationNV := dglGetProcAddress('glGetVaryingLocationNV'); - glGetActiveVaryingNV := dglGetProcAddress('glGetActiveVaryingNV'); - glGetTransformFeedbackVaryingNV := dglGetProcAddress('glGetTransformFeedbackVaryingNV'); - glTransformFeedbackStreamAttribsNV := dglGetProcAddress('glTransformFeedbackStreamAttribsNV'); -end; - -procedure Read_GL_NV_conditional_render; -begin - glBeginConditionalRenderNV := dglGetProcAddress('glBeginConditionalRenderNV'); - glEndConditionalRenderNV := dglGetProcAddress('glEndConditionalRenderNV'); -end; - -procedure Read_GL_NV_present_video; -begin - glPresentFrameKeyedNV := dglGetProcAddress('glPresentFrameKeyedNV'); - glPresentFrameDualFillNV := dglGetProcAddress('glPresentFrameDualFillNV'); - glGetVideoivNV := dglGetProcAddress('glGetVideoivNV'); - glGetVideouivNV := dglGetProcAddress('glGetVideouivNV'); - glGetVideoi64vNV := dglGetProcAddress('glGetVideoi64vNV'); - glGetVideoui64vNV := dglGetProcAddress('glGetVideoui64vNV'); -// glVideoParameterivNV := dglGetProcAddress('glVideoParameterivNV'); -end; - -procedure Read_GL_NV_explicit_multisample; -begin - glGetMultisamplefvNV := dglGetProcAddress('glGetMultisamplefvNV'); - glSampleMaskIndexedNV := dglGetProcAddress('glSampleMaskIndexedNV'); - glTexRenderbufferNV := dglGetProcAddress('glTexRenderbufferNV'); -end; - -procedure Read_GL_NV_transform_feedback2; -begin - glBindTransformFeedbackNV := dglGetProcAddress('glBindTransformFeedbackNV'); - glDeleteTransformFeedbacksNV := dglGetProcAddress('glDeleteTransformFeedbacksNV'); - glGenTransformFeedbacksNV := dglGetProcAddress('glGenTransformFeedbacksNV'); - glIsTransformFeedbackNV := dglGetProcAddress('glIsTransformFeedbackNV'); - glPauseTransformFeedbackNV := dglGetProcAddress('glPauseTransformFeedbackNV'); - glResumeTransformFeedbackNV := dglGetProcAddress('glResumeTransformFeedbackNV'); - glDrawTransformFeedbackNV := dglGetProcAddress('glDrawTransformFeedbackNV'); -end; - -procedure Read_GL_NV_video_capture; -begin - glBeginVideoCaptureNV := dglGetProcAddress('glBeginVideoCaptureNV'); - glBindVideoCaptureStreamBufferNV := dglGetProcAddress('glBindVideoCaptureStreamBufferNV'); - glBindVideoCaptureStreamTextureNV := dglGetProcAddress('glBindVideoCaptureStreamTextureNV'); - glEndVideoCaptureNV := dglGetProcAddress('glEndVideoCaptureNV'); - glGetVideoCaptureivNV := dglGetProcAddress('glGetVideoCaptureivNV'); - glGetVideoCaptureStreamivNV := dglGetProcAddress('glGetVideoCaptureStreamivNV'); - glGetVideoCaptureStreamfvNV := dglGetProcAddress('glGetVideoCaptureStreamfvNV'); - glGetVideoCaptureStreamdvNV := dglGetProcAddress('glGetVideoCaptureStreamdvNV'); - glVideoCaptureNV := dglGetProcAddress('glVideoCaptureNV'); - glVideoCaptureStreamParameterivNV := dglGetProcAddress('glVideoCaptureStreamParameterivNV'); - glVideoCaptureStreamParameterfvNV := dglGetProcAddress('glVideoCaptureStreamParameterfvNV'); - glVideoCaptureStreamParameterdvNV := dglGetProcAddress('glVideoCaptureStreamParameterdvNV'); -end; - -procedure Read_GL_NV_copy_image; -begin - glCopyImageSubDataNV := dglGetProcAddress('glCopyImageSubDataNV'); -end; - -procedure Read_GL_NV_shader_buffer_load; -begin - glMakeBufferResidentNV := dglGetProcAddress('glMakeBufferResidentNV'); - glMakeBufferNonResidentNV := dglGetProcAddress('glMakeBufferNonResidentNV'); - glIsBufferResidentNV := dglGetProcAddress('glIsBufferResidentNV'); - glMakeNamedBufferResidentNV := dglGetProcAddress('glMakeNamedBufferResidentNV'); - glMakeNamedBufferNonResidentNV := dglGetProcAddress('glMakeNamedBufferNonResidentNV'); - glIsNamedBufferResidentNV := dglGetProcAddress('glIsNamedBufferResidentNV'); - glGetBufferParameterui64vNV := dglGetProcAddress('glGetBufferParameterui64vNV'); - glGetNamedBufferParameterui64vNV := dglGetProcAddress('glGetNamedBufferParameterui64vNV'); - glGetIntegerui64vNV := dglGetProcAddress('glGetIntegerui64vNV'); - glUniformui64NV := dglGetProcAddress('glUniformui64NV'); - glUniformui64vNV := dglGetProcAddress('glUniformui64vNV'); - glGetUniformui64vNV := dglGetProcAddress('glGetUniformui64vNV'); - glProgramUniformui64NV := dglGetProcAddress('glProgramUniformui64NV'); - glProgramUniformui64vNV := dglGetProcAddress('glProgramUniformui64vNV'); -end; - -procedure Read_GL_NV_vertex_buffer_unified_memory; -begin - glBufferAddressRangeNV := dglGetProcAddress('glBufferAddressRangeNV'); - glVertexFormatNV := dglGetProcAddress('glVertexFormatNV'); - glNormalFormatNV := dglGetProcAddress('glNormalFormatNV'); - glColorFormatNV := dglGetProcAddress('glColorFormatNV'); - glIndexFormatNV := dglGetProcAddress('glIndexFormatNV'); - glTexCoordFormatNV := dglGetProcAddress('glTexCoordFormatNV'); - glEdgeFlagFormatNV := dglGetProcAddress('glEdgeFlagFormatNV'); - glSecondaryColorFormatNV := dglGetProcAddress('glSecondaryColorFormatNV'); - glFogCoordFormatNV := dglGetProcAddress('glFogCoordFormatNV'); - glVertexAttribFormatNV := dglGetProcAddress('glVertexAttribFormatNV'); - glVertexAttribIFormatNV := dglGetProcAddress('glVertexAttribIFormatNV'); - glGetIntegerui64i_vNV := dglGetProcAddress('glGetIntegerui64i_vNV'); -end; - -procedure Read_GL_NV_gpu_program5; -begin - glProgramSubroutineParametersuivNV := dglGetProcAddress('glProgramSubroutineParametersuivNV'); - glGetProgramSubroutineParameteruivNV := dglGetProcAddress('glGetProgramSubroutineParameteruivNV'); -end; - -procedure Read_GL_NV_gpu_shader5; -begin - glUniform1i64NV := dglGetProcAddress('glUniform1i64NV'); - glUniform2i64NV := dglGetProcAddress('glUniform2i64NV'); - glUniform3i64NV := dglGetProcAddress('glUniform3i64NV'); - glUniform4i64NV := dglGetProcAddress('glUniform4i64NV'); - glUniform1i64vNV := dglGetProcAddress('glUniform1i64vNV'); - glUniform2i64vNV := dglGetProcAddress('glUniform2i64vNV'); - glUniform3i64vNV := dglGetProcAddress('glUniform3i64vNV'); - glUniform4i64vNV := dglGetProcAddress('glUniform4i64vNV'); - glUniform1ui64NV := dglGetProcAddress('glUniform1ui64NV'); - glUniform2ui64NV := dglGetProcAddress('glUniform2ui64NV'); - glUniform3ui64NV := dglGetProcAddress('glUniform3ui64NV'); - glUniform4ui64NV := dglGetProcAddress('glUniform4ui64NV'); - glUniform1ui64vNV := dglGetProcAddress('glUniform1ui64vNV'); - glUniform2ui64vNV := dglGetProcAddress('glUniform2ui64vNV'); - glUniform3ui64vNV := dglGetProcAddress('glUniform3ui64vNV'); - glUniform4ui64vNV := dglGetProcAddress('glUniform4ui64vNV'); - glGetUniformi64vNV := dglGetProcAddress('glGetUniformi64vNV'); - glProgramUniform1i64NV := dglGetProcAddress('glProgramUniform1i64NV'); - glProgramUniform2i64NV := dglGetProcAddress('glProgramUniform2i64NV'); - glProgramUniform3i64NV := dglGetProcAddress('glProgramUniform3i64NV'); - glProgramUniform4i64NV := dglGetProcAddress('glProgramUniform4i64NV'); - glProgramUniform1i64vNV := dglGetProcAddress('glProgramUniform1i64vNV'); - glProgramUniform2i64vNV := dglGetProcAddress('glProgramUniform2i64vNV'); - glProgramUniform3i64vNV := dglGetProcAddress('glProgramUniform3i64vNV'); - glProgramUniform4i64vNV := dglGetProcAddress('glProgramUniform4i64vNV'); - glProgramUniform1ui64NV := dglGetProcAddress('glProgramUniform1ui64NV'); - glProgramUniform2ui64NV := dglGetProcAddress('glProgramUniform2ui64NV'); - glProgramUniform3ui64NV := dglGetProcAddress('glProgramUniform3ui64NV'); - glProgramUniform4ui64NV := dglGetProcAddress('glProgramUniform4ui64NV'); - glProgramUniform1ui64vNV := dglGetProcAddress('glProgramUniform1ui64vNV'); - glProgramUniform2ui64vNV := dglGetProcAddress('glProgramUniform2ui64vNV'); - glProgramUniform3ui64vNV := dglGetProcAddress('glProgramUniform3ui64vNV'); - glProgramUniform4ui64vNV := dglGetProcAddress('glProgramUniform4ui64vNV'); -end; - -procedure Read_GL_NV_vertex_attrib_integer_64bit; -begin - glVertexAttribL1i64NV := dglGetProcAddress('glVertexAttribL1i64NV'); - glVertexAttribL2i64NV := dglGetProcAddress('glVertexAttribL2i64NV'); - glVertexAttribL3i64NV := dglGetProcAddress('glVertexAttribL3i64NV'); - glVertexAttribL4i64NV := dglGetProcAddress('glVertexAttribL4i64NV'); - glVertexAttribL1i64vNV := dglGetProcAddress('glVertexAttribL1i64vNV'); - glVertexAttribL2i64vNV := dglGetProcAddress('glVertexAttribL2i64vNV'); - glVertexAttribL3i64vNV := dglGetProcAddress('glVertexAttribL3i64vNV'); - glVertexAttribL4i64vNV := dglGetProcAddress('glVertexAttribL4i64vNV'); - glVertexAttribL1ui64NV := dglGetProcAddress('glVertexAttribL1ui64NV'); - glVertexAttribL2ui64NV := dglGetProcAddress('glVertexAttribL2ui64NV'); - glVertexAttribL3ui64NV := dglGetProcAddress('glVertexAttribL3ui64NV'); - glVertexAttribL4ui64NV := dglGetProcAddress('glVertexAttribL4ui64NV'); - glVertexAttribL1ui64vNV := dglGetProcAddress('glVertexAttribL1ui64vNV'); - glVertexAttribL2ui64vNV := dglGetProcAddress('glVertexAttribL2ui64vNV'); - glVertexAttribL3ui64vNV := dglGetProcAddress('glVertexAttribL3ui64vNV'); - glVertexAttribL4ui64vNV := dglGetProcAddress('glVertexAttribL4ui64vNV'); - glGetVertexAttribLi64vNV := dglGetProcAddress('glGetVertexAttribLi64vNV'); - glGetVertexAttribLui64vNV := dglGetProcAddress('glGetVertexAttribLui64vNV'); - glVertexAttribLFormatNV := dglGetProcAddress('glVertexAttribLFormatNV'); -end; - -procedure Read_GL_NV_vdpau_interop; -begin - glVDPAUInitNV := dglGetProcAddress('glVDPAUInitNV'); - glVDPAUFiniNV := dglGetProcAddress('glVDPAUFiniNV'); - glVDPAURegisterVideoSurfaceNV := dglGetProcAddress('glVDPAURegisterVideoSurfaceNV'); - glVDPAURegisterOutputSurfaceNV := dglGetProcAddress('glVDPAURegisterOutputSurfaceNV'); - glVDPAUIsSurfaceNV := dglGetProcAddress('glVDPAUIsSurfaceNV'); - glVDPAUUnregisterSurfaceNV := dglGetProcAddress('glVDPAUUnregisterSurfaceNV'); - glVDPAUGetSurfaceivNV := dglGetProcAddress('glVDPAUGetSurfaceivNV'); - glVDPAUSurfaceAccessNV := dglGetProcAddress('glVDPAUSurfaceAccessNV'); - glVDPAUMapSurfacesNV := dglGetProcAddress('glVDPAUMapSurfacesNV'); - glVDPAUUnmapSurfacesNV := dglGetProcAddress('glVDPAUUnmapSurfacesNV'); -end; - -procedure Read_GL_NV_texture_barrier; -begin - glTextureBarrierNV := dglGetProcAddress('glTextureBarrierNV'); -end; - -procedure Read_GL_PGI_misc_hints; -begin - glHintPGI := dglGetProcAddress('glHintPGI'); -end; - -procedure Read_GL_SGIS_detail_texture; -begin - glDetailTexFuncSGIS := dglGetProcAddress('glDetailTexFuncSGIS'); - glGetDetailTexFuncSGIS := dglGetProcAddress('glGetDetailTexFuncSGIS'); -end; - -procedure Read_GL_SGIS_fog_function; -begin - glFogFuncSGIS := dglGetProcAddress('glFogFuncSGIS'); - glGetFogFuncSGIS := dglGetProcAddress('glGetFogFuncSGIS'); -end; - -procedure Read_GL_SGIS_multisample; -begin - glSampleMaskSGIS := dglGetProcAddress('glSampleMaskSGIS'); - glSamplePatternSGIS := dglGetProcAddress('glSamplePatternSGIS'); -end; - -procedure Read_GL_SGIS_pixel_texture; -begin - glPixelTexGenParameteriSGIS := dglGetProcAddress('glPixelTexGenParameteriSGIS'); - glPixelTexGenParameterivSGIS := dglGetProcAddress('glPixelTexGenParameterivSGIS'); - glPixelTexGenParameterfSGIS := dglGetProcAddress('glPixelTexGenParameterfSGIS'); - glPixelTexGenParameterfvSGIS := dglGetProcAddress('glPixelTexGenParameterfvSGIS'); - glGetPixelTexGenParameterivSGIS := dglGetProcAddress('glGetPixelTexGenParameterivSGIS'); - glGetPixelTexGenParameterfvSGIS := dglGetProcAddress('glGetPixelTexGenParameterfvSGIS'); -end; - -procedure Read_GL_SGIS_point_parameters; -begin - glPointParameterfSGIS := dglGetProcAddress('glPointParameterfSGIS'); - glPointParameterfvSGIS := dglGetProcAddress('glPointParameterfvSGIS'); -end; - -procedure Read_GL_SGIS_sharpen_texture; -begin - glSharpenTexFuncSGIS := dglGetProcAddress('glSharpenTexFuncSGIS'); - glGetSharpenTexFuncSGIS := dglGetProcAddress('glGetSharpenTexFuncSGIS'); -end; - -procedure Read_GL_SGIS_texture4D; -begin - glTexImage4DSGIS := dglGetProcAddress('glTexImage4DSGIS'); - glTexSubImage4DSGIS := dglGetProcAddress('glTexSubImage4DSGIS'); -end; - -procedure Read_GL_SGIS_texture_color_mask; -begin - glTextureColorMaskSGIS := dglGetProcAddress('glTextureColorMaskSGIS'); -end; - -procedure Read_GL_SGIS_texture_filter4; -begin - glGetTexFilterFuncSGIS := dglGetProcAddress('glGetTexFilterFuncSGIS'); - glTexFilterFuncSGIS := dglGetProcAddress('glTexFilterFuncSGIS'); -end; - -procedure Read_GL_SGIX_async; -begin - glAsyncMarkerSGIX := dglGetProcAddress('glAsyncMarkerSGIX'); - glFinishAsyncSGIX := dglGetProcAddress('glFinishAsyncSGIX'); - glPollAsyncSGIX := dglGetProcAddress('glPollAsyncSGIX'); - glGenAsyncMarkersSGIX := dglGetProcAddress('glGenAsyncMarkersSGIX'); - glDeleteAsyncMarkersSGIX := dglGetProcAddress('glDeleteAsyncMarkersSGIX'); - glIsAsyncMarkerSGIX := dglGetProcAddress('glIsAsyncMarkerSGIX'); -end; - -procedure Read_GL_SGIX_flush_raster; -begin - glFlushRasterSGIX := dglGetProcAddress('glFlushRasterSGIX'); -end; - -procedure Read_GL_SGIX_fragment_lighting; -begin - glFragmentColorMaterialSGIX := dglGetProcAddress('glFragmentColorMaterialSGIX'); - glFragmentLightfSGIX := dglGetProcAddress('glFragmentLightfSGIX'); - glFragmentLightfvSGIX := dglGetProcAddress('glFragmentLightfvSGIX'); - glFragmentLightiSGIX := dglGetProcAddress('glFragmentLightiSGIX'); - glFragmentLightivSGIX := dglGetProcAddress('glFragmentLightivSGIX'); - glFragmentLightModelfSGIX := dglGetProcAddress('glFragmentLightModelfSGIX'); - glFragmentLightModelfvSGIX := dglGetProcAddress('glFragmentLightModelfvSGIX'); - glFragmentLightModeliSGIX := dglGetProcAddress('glFragmentLightModeliSGIX'); - glFragmentLightModelivSGIX := dglGetProcAddress('glFragmentLightModelivSGIX'); - glFragmentMaterialfSGIX := dglGetProcAddress('glFragmentMaterialfSGIX'); - glFragmentMaterialfvSGIX := dglGetProcAddress('glFragmentMaterialfvSGIX'); - glFragmentMaterialiSGIX := dglGetProcAddress('glFragmentMaterialiSGIX'); - glFragmentMaterialivSGIX := dglGetProcAddress('glFragmentMaterialivSGIX'); - glGetFragmentLightfvSGIX := dglGetProcAddress('glGetFragmentLightfvSGIX'); - glGetFragmentLightivSGIX := dglGetProcAddress('glGetFragmentLightivSGIX'); - glGetFragmentMaterialfvSGIX := dglGetProcAddress('glGetFragmentMaterialfvSGIX'); - glGetFragmentMaterialivSGIX := dglGetProcAddress('glGetFragmentMaterialivSGIX'); - glLightEnviSGIX := dglGetProcAddress('glLightEnviSGIX'); -end; - -procedure Read_GL_SGIX_framezoom; -begin - glFrameZoomSGIX := dglGetProcAddress('glFrameZoomSGIX'); -end; - -procedure Read_GL_SGIX_igloo_interface; -begin - glIglooInterfaceSGIX := dglGetProcAddress('glIglooInterfaceSGIX'); -end; - -procedure Read_GL_SGIX_instruments; -begin - glGetInstrumentsSGIX := dglGetProcAddress('glGetInstrumentsSGIX'); - glInstrumentsBufferSGIX := dglGetProcAddress('glInstrumentsBufferSGIX'); - glPollInstrumentsSGIX := dglGetProcAddress('glPollInstrumentsSGIX'); - glReadInstrumentsSGIX := dglGetProcAddress('glReadInstrumentsSGIX'); - glStartInstrumentsSGIX := dglGetProcAddress('glStartInstrumentsSGIX'); - glStopInstrumentsSGIX := dglGetProcAddress('glStopInstrumentsSGIX'); -end; - -procedure Read_GL_SGIX_list_priority; -begin - glGetListParameterfvSGIX := dglGetProcAddress('glGetListParameterfvSGIX'); - glGetListParameterivSGIX := dglGetProcAddress('glGetListParameterivSGIX'); - glListParameterfSGIX := dglGetProcAddress('glListParameterfSGIX'); - glListParameterfvSGIX := dglGetProcAddress('glListParameterfvSGIX'); - glListParameteriSGIX := dglGetProcAddress('glListParameteriSGIX'); - glListParameterivSGIX := dglGetProcAddress('glListParameterivSGIX'); -end; - -procedure Read_GL_SGIX_pixel_texture; -begin - glPixelTexGenSGIX := dglGetProcAddress('glPixelTexGenSGIX'); -end; - -procedure Read_GL_SGIX_polynomial_ffd; -begin - glDeformationMap3dSGIX := dglGetProcAddress('glDeformationMap3dSGIX'); - glDeformationMap3fSGIX := dglGetProcAddress('glDeformationMap3fSGIX'); - glDeformSGIX := dglGetProcAddress('glDeformSGIX'); - glLoadIdentityDeformationMapSGIX := dglGetProcAddress('glLoadIdentityDeformationMapSGIX'); -end; - -procedure Read_GL_SGIX_reference_plane; -begin - glReferencePlaneSGIX := dglGetProcAddress('glReferencePlaneSGIX'); -end; - -procedure Read_GL_SGIX_sprite; -begin - glSpriteParameterfSGIX := dglGetProcAddress('glSpriteParameterfSGIX'); - glSpriteParameterfvSGIX := dglGetProcAddress('glSpriteParameterfvSGIX'); - glSpriteParameteriSGIX := dglGetProcAddress('glSpriteParameteriSGIX'); - glSpriteParameterivSGIX := dglGetProcAddress('glSpriteParameterivSGIX'); -end; - -procedure Read_GL_SGIX_tag_sample_buffer; -begin - glTagSampleBufferSGIX := dglGetProcAddress('glTagSampleBufferSGIX'); -end; - -procedure Read_GL_SGI_color_table; -begin - glColorTableSGI := dglGetProcAddress('glColorTableSGI'); - glColorTableParameterfvSGI := dglGetProcAddress('glColorTableParameterfvSGI'); - glColorTableParameterivSGI := dglGetProcAddress('glColorTableParameterivSGI'); - glCopyColorTableSGI := dglGetProcAddress('glCopyColorTableSGI'); - glGetColorTableSGI := dglGetProcAddress('glGetColorTableSGI'); - glGetColorTableParameterfvSGI := dglGetProcAddress('glGetColorTableParameterfvSGI'); - glGetColorTableParameterivSGI := dglGetProcAddress('glGetColorTableParameterivSGI'); -end; - -procedure Read_GL_SUNX_constant_data; -begin - glFinishTextureSUNX := dglGetProcAddress('glFinishTextureSUNX'); -end; - -procedure Read_GL_SUN_global_alpha; -begin - glGlobalAlphaFactorbSUN := dglGetProcAddress('glGlobalAlphaFactorbSUN'); - glGlobalAlphaFactorsSUN := dglGetProcAddress('glGlobalAlphaFactorsSUN'); - glGlobalAlphaFactoriSUN := dglGetProcAddress('glGlobalAlphaFactoriSUN'); - glGlobalAlphaFactorfSUN := dglGetProcAddress('glGlobalAlphaFactorfSUN'); - glGlobalAlphaFactordSUN := dglGetProcAddress('glGlobalAlphaFactordSUN'); - glGlobalAlphaFactorubSUN := dglGetProcAddress('glGlobalAlphaFactorubSUN'); - glGlobalAlphaFactorusSUN := dglGetProcAddress('glGlobalAlphaFactorusSUN'); - glGlobalAlphaFactoruiSUN := dglGetProcAddress('glGlobalAlphaFactoruiSUN'); -end; - -procedure Read_GL_SUN_mesh_array; -begin - glDrawMeshArraysSUN := dglGetProcAddress('glDrawMeshArraysSUN'); -end; - -procedure Read_GL_SUN_triangle_list; -begin - glReplacementCodeuiSUN := dglGetProcAddress('glReplacementCodeuiSUN'); - glReplacementCodeusSUN := dglGetProcAddress('glReplacementCodeusSUN'); - glReplacementCodeubSUN := dglGetProcAddress('glReplacementCodeubSUN'); - glReplacementCodeuivSUN := dglGetProcAddress('glReplacementCodeuivSUN'); - glReplacementCodeusvSUN := dglGetProcAddress('glReplacementCodeusvSUN'); - glReplacementCodeubvSUN := dglGetProcAddress('glReplacementCodeubvSUN'); - glReplacementCodePointerSUN := dglGetProcAddress('glReplacementCodePointerSUN'); -end; - -procedure Read_GL_SUN_vertex; -begin - glColor4ubVertex2fSUN := dglGetProcAddress('glColor4ubVertex2fSUN'); - glColor4ubVertex2fvSUN := dglGetProcAddress('glColor4ubVertex2fvSUN'); - glColor4ubVertex3fSUN := dglGetProcAddress('glColor4ubVertex3fSUN'); - glColor4ubVertex3fvSUN := dglGetProcAddress('glColor4ubVertex3fvSUN'); - glColor3fVertex3fSUN := dglGetProcAddress('glColor3fVertex3fSUN'); - glColor3fVertex3fvSUN := dglGetProcAddress('glColor3fVertex3fvSUN'); - glNormal3fVertex3fSUN := dglGetProcAddress('glNormal3fVertex3fSUN'); - glNormal3fVertex3fvSUN := dglGetProcAddress('glNormal3fVertex3fvSUN'); - glColor4fNormal3fVertex3fSUN := dglGetProcAddress('glColor4fNormal3fVertex3fSUN'); - glColor4fNormal3fVertex3fvSUN := dglGetProcAddress('glColor4fNormal3fVertex3fvSUN'); - glTexCoord2fVertex3fSUN := dglGetProcAddress('glTexCoord2fVertex3fSUN'); - glTexCoord2fVertex3fvSUN := dglGetProcAddress('glTexCoord2fVertex3fvSUN'); - glTexCoord4fVertex4fSUN := dglGetProcAddress('glTexCoord4fVertex4fSUN'); - glTexCoord4fVertex4fvSUN := dglGetProcAddress('glTexCoord4fVertex4fvSUN'); - glTexCoord2fColor4ubVertex3fSUN := dglGetProcAddress('glTexCoord2fColor4ubVertex3fSUN'); - glTexCoord2fColor4ubVertex3fvSUN := dglGetProcAddress('glTexCoord2fColor4ubVertex3fvSUN'); - glTexCoord2fColor3fVertex3fSUN := dglGetProcAddress('glTexCoord2fColor3fVertex3fSUN'); - glTexCoord2fColor3fVertex3fvSUN := dglGetProcAddress('glTexCoord2fColor3fVertex3fvSUN'); - glTexCoord2fNormal3fVertex3fSUN := dglGetProcAddress('glTexCoord2fNormal3fVertex3fSUN'); - glTexCoord2fNormal3fVertex3fvSUN := dglGetProcAddress('glTexCoord2fNormal3fVertex3fvSUN'); - glTexCoord2fColor4fNormal3fVertex3fSUN := dglGetProcAddress('glTexCoord2fColor4fNormal3fVertex3fSUN'); - glTexCoord2fColor4fNormal3fVertex3fvSUN := dglGetProcAddress('glTexCoord2fColor4fNormal3fVertex3fvSUN'); - glTexCoord4fColor4fNormal3fVertex4fSUN := dglGetProcAddress('glTexCoord4fColor4fNormal3fVertex4fSUN'); - glTexCoord4fColor4fNormal3fVertex4fvSUN := dglGetProcAddress('glTexCoord4fColor4fNormal3fVertex4fvSUN'); - glReplacementCodeuiVertex3fSUN := dglGetProcAddress('glReplacementCodeuiVertex3fSUN'); - glReplacementCodeuiVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiVertex3fvSUN'); - glReplacementCodeuiColor4ubVertex3fSUN := dglGetProcAddress('glReplacementCodeuiColor4ubVertex3fSUN'); - glReplacementCodeuiColor4ubVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiColor4ubVertex3fvSUN'); - glReplacementCodeuiColor3fVertex3fSUN := dglGetProcAddress('glReplacementCodeuiColor3fVertex3fSUN'); - glReplacementCodeuiColor3fVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiColor3fVertex3fvSUN'); - glReplacementCodeuiNormal3fVertex3fSUN := dglGetProcAddress('glReplacementCodeuiNormal3fVertex3fSUN'); - glReplacementCodeuiNormal3fVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiNormal3fVertex3fvSUN'); - glReplacementCodeuiColor4fNormal3fVertex3fSUN := dglGetProcAddress('glReplacementCodeuiColor4fNormal3fVertex3fSUN'); - glReplacementCodeuiColor4fNormal3fVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiColor4fNormal3fVertex3fvSUN'); - glReplacementCodeuiTexCoord2fVertex3fSUN := dglGetProcAddress('glReplacementCodeuiTexCoord2fVertex3fSUN'); - glReplacementCodeuiTexCoord2fVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiTexCoord2fVertex3fvSUN'); - glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN := dglGetProcAddress('glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN'); - glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN'); - glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN := dglGetProcAddress('glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN'); - glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN := dglGetProcAddress('glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN'); -end; - -{$IFDEF DGL_WIN} -procedure Read_WGL_ARB_buffer_region; -begin - wglCreateBufferRegionARB := dglGetProcAddress('wglCreateBufferRegionARB'); - wglDeleteBufferRegionARB := dglGetProcAddress('wglDeleteBufferRegionARB'); - wglSaveBufferRegionARB := dglGetProcAddress('wglSaveBufferRegionARB'); - wglRestoreBufferRegionARB := dglGetProcAddress('wglRestoreBufferRegionARB'); -end; - -procedure Read_WGL_ARB_extensions_string; -begin - wglGetExtensionsStringARB := dglGetProcAddress('wglGetExtensionsStringARB'); -end; - -procedure Read_WGL_ARB_make_current_read; -begin - wglMakeContextCurrentARB := dglGetProcAddress('wglMakeContextCurrentARB'); - wglGetCurrentReadDCARB := dglGetProcAddress('wglGetCurrentReadDCARB'); -end; - -procedure Read_WGL_ARB_pbuffer; -begin - wglCreatePbufferARB := dglGetProcAddress('wglCreatePbufferARB'); - wglGetPbufferDCARB := dglGetProcAddress('wglGetPbufferDCARB'); - wglReleasePbufferDCARB := dglGetProcAddress('wglReleasePbufferDCARB'); - wglDestroyPbufferARB := dglGetProcAddress('wglDestroyPbufferARB'); - wglQueryPbufferARB := dglGetProcAddress('wglQueryPbufferARB'); -end; - -procedure Read_WGL_ARB_pixel_format; -begin - wglGetPixelFormatAttribivARB := dglGetProcAddress('wglGetPixelFormatAttribivARB'); - wglGetPixelFormatAttribfvARB := dglGetProcAddress('wglGetPixelFormatAttribfvARB'); - wglChoosePixelFormatARB := dglGetProcAddress('wglChoosePixelFormatARB'); -end; - -procedure Read_WGL_ARB_pixel_format_float; -begin - wglClampColorARB := dglGetProcAddress('wglClampColorARB'); -end; - -procedure Read_WGL_ARB_render_texture; -begin - wglBindTexImageARB := dglGetProcAddress('wglBindTexImageARB'); - wglReleaseTexImageARB := dglGetProcAddress('wglReleaseTexImageARB'); - wglSetPbufferAttribARB := dglGetProcAddress('wglSetPbufferAttribARB'); -end; - -procedure Read_WGL_ARB_create_context; -begin - wglCreateContextAttribsARB := dglGetProcAddress('wglCreateContextAttribsARB'); -end; - -procedure Read_WGL_AMD_gpu_association; -begin - wglGetGPUIDsAMD := dglGetProcAddress('wglGetGPUIDsAMD'); - wglGetGPUInfoAMD := dglGetProcAddress('wglGetGPUInfoAMD'); - wglGetContextGPUIDAMD := dglGetProcAddress('wglGetContextGPUIDAMD'); - wglCreateAssociatedContextAMD := dglGetProcAddress('wglCreateAssociatedContextAMD'); - wglCreateAssociatedContextAttribsAMD := dglGetProcAddress('wglCreateAssociatedContextAttribsAMD'); - wglDeleteAssociatedContextAMD := dglGetProcAddress('wglDeleteAssociatedContextAMD'); - wglMakeAssociatedContextCurrentAMD := dglGetProcAddress('wglMakeAssociatedContextCurrentAMD'); - wglGetCurrentAssociatedContextAMD := dglGetProcAddress('wglGetCurrentAssociatedContextAMD'); - wglBlitContextFramebufferAMD := dglGetProcAddress('wglBlitContextFramebufferAMD'); -end; - -procedure Read_WGL_EXT_display_color_table; -begin - wglCreateDisplayColorTableEXT := dglGetProcAddress('wglCreateDisplayColorTableEXT'); - wglLoadDisplayColorTableEXT := dglGetProcAddress('wglLoadDisplayColorTableEXT'); - wglBindDisplayColorTableEXT := dglGetProcAddress('wglBindDisplayColorTableEXT'); - wglDestroyDisplayColorTableEXT := dglGetProcAddress('wglDestroyDisplayColorTableEXT'); -end; - -procedure Read_WGL_EXT_extensions_string; -begin - wglGetExtensionsStringEXT := dglGetProcAddress('wglGetExtensionsStringEXT'); -end; - -procedure Read_WGL_EXT_make_current_read; -begin - wglMakeContextCurrentEXT := dglGetProcAddress('wglMakeContextCurrentEXT'); - wglGetCurrentReadDCEXT := dglGetProcAddress('wglGetCurrentReadDCEXT'); -end; - -procedure Read_WGL_EXT_pbuffer; -begin - wglCreatePbufferEXT := dglGetProcAddress('wglCreatePbufferEXT'); - wglGetPbufferDCEXT := dglGetProcAddress('wglGetPbufferDCEXT'); - wglReleasePbufferDCEXT := dglGetProcAddress('wglReleasePbufferDCEXT'); - wglDestroyPbufferEXT := dglGetProcAddress('wglDestroyPbufferEXT'); - wglQueryPbufferEXT := dglGetProcAddress('wglQueryPbufferEXT'); -end; - -procedure Read_WGL_EXT_pixel_format; -begin - wglGetPixelFormatAttribivEXT := dglGetProcAddress('wglGetPixelFormatAttribivEXT'); - wglGetPixelFormatAttribfvEXT := dglGetProcAddress('wglGetPixelFormatAttribfvEXT'); - wglChoosePixelFormatEXT := dglGetProcAddress('wglChoosePixelFormatEXT'); -end; - -procedure Read_WGL_EXT_swap_control; -begin - wglSwapIntervalEXT := dglGetProcAddress('wglSwapIntervalEXT'); - wglGetSwapIntervalEXT := dglGetProcAddress('wglGetSwapIntervalEXT'); -end; - -procedure Read_WGL_I3D_digital_video_control; -begin - wglGetDigitalVideoParametersI3D := dglGetProcAddress('wglGetDigitalVideoParametersI3D'); - wglSetDigitalVideoParametersI3D := dglGetProcAddress('wglSetDigitalVideoParametersI3D'); -end; - -procedure Read_WGL_I3D_gamma; -begin - wglGetGammaTableParametersI3D := dglGetProcAddress('wglGetGammaTableParametersI3D'); - wglSetGammaTableParametersI3D := dglGetProcAddress('wglSetGammaTableParametersI3D'); - wglGetGammaTableI3D := dglGetProcAddress('wglGetGammaTableI3D'); - wglSetGammaTableI3D := dglGetProcAddress('wglSetGammaTableI3D'); -end; - -procedure Read_WGL_I3D_genlock; -begin - wglEnableGenlockI3D := dglGetProcAddress('wglEnableGenlockI3D'); - wglDisableGenlockI3D := dglGetProcAddress('wglDisableGenlockI3D'); - wglIsEnabledGenlockI3D := dglGetProcAddress('wglIsEnabledGenlockI3D'); - wglGenlockSourceI3D := dglGetProcAddress('wglGenlockSourceI3D'); - wglGetGenlockSourceI3D := dglGetProcAddress('wglGetGenlockSourceI3D'); - wglGenlockSourceEdgeI3D := dglGetProcAddress('wglGenlockSourceEdgeI3D'); - wglGetGenlockSourceEdgeI3D := dglGetProcAddress('wglGetGenlockSourceEdgeI3D'); - wglGenlockSampleRateI3D := dglGetProcAddress('wglGenlockSampleRateI3D'); - wglGetGenlockSampleRateI3D := dglGetProcAddress('wglGetGenlockSampleRateI3D'); - wglGenlockSourceDelayI3D := dglGetProcAddress('wglGenlockSourceDelayI3D'); - wglGetGenlockSourceDelayI3D := dglGetProcAddress('wglGetGenlockSourceDelayI3D'); - wglQueryGenlockMaxSourceDelayI3D := dglGetProcAddress('wglQueryGenlockMaxSourceDelayI3D'); -end; - -procedure Read_WGL_I3D_image_buffer; -begin - wglCreateImageBufferI3D := dglGetProcAddress('wglCreateImageBufferI3D'); - wglDestroyImageBufferI3D := dglGetProcAddress('wglDestroyImageBufferI3D'); - wglAssociateImageBufferEventsI3D := dglGetProcAddress('wglAssociateImageBufferEventsI3D'); - wglReleaseImageBufferEventsI3D := dglGetProcAddress('wglReleaseImageBufferEventsI3D'); -end; - -procedure Read_WGL_I3D_swap_frame_lock; -begin - wglEnableFrameLockI3D := dglGetProcAddress('wglEnableFrameLockI3D'); - wglDisableFrameLockI3D := dglGetProcAddress('wglDisableFrameLockI3D'); - wglIsEnabledFrameLockI3D := dglGetProcAddress('wglIsEnabledFrameLockI3D'); - wglQueryFrameLockMasterI3D := dglGetProcAddress('wglQueryFrameLockMasterI3D'); -end; - -procedure Read_WGL_I3D_swap_frame_usage; -begin - wglGetFrameUsageI3D := dglGetProcAddress('wglGetFrameUsageI3D'); - wglBeginFrameTrackingI3D := dglGetProcAddress('wglBeginFrameTrackingI3D'); - wglEndFrameTrackingI3D := dglGetProcAddress('wglEndFrameTrackingI3D'); - wglQueryFrameTrackingI3D := dglGetProcAddress('wglQueryFrameTrackingI3D'); -end; - -procedure Read_WGL_NV_vertex_array_range; -begin - wglAllocateMemoryNV := dglGetProcAddress('wglAllocateMemoryNV'); - wglFreeMemoryNV := dglGetProcAddress('wglFreeMemoryNV'); -end; - -procedure Read_WGL_NV_present_video; -begin - wglEnumerateVideoDevicesNV := dglGetProcAddress('wglEnumerateVideoDevicesNV'); - wglBindVideoDeviceNV := dglGetProcAddress('wglBindVideoDeviceNV'); - wglQueryCurrentContextNV := dglGetProcAddress('wglQueryCurrentContextNV'); -end; - -procedure Read_WGL_NV_video_output; -begin - wglGetVideoDeviceNV := dglGetProcAddress('wglGetVideoDeviceNV'); - wglReleaseVideoDeviceNV := dglGetProcAddress('wglReleaseVideoDeviceNV'); - wglBindVideoImageNV := dglGetProcAddress('wglBindVideoImageNV'); - wglReleaseVideoImageNV := dglGetProcAddress('wglReleaseVideoImageNV'); - wglSendPbufferToVideoNV := dglGetProcAddress('wglSendPbufferToVideoNV'); - wglGetVideoInfoNV := dglGetProcAddress('wglGetVideoInfoNV'); -end; - -procedure Read_WGL_NV_swap_group; -begin - wglJoinSwapGroupNV := dglGetProcAddress('wglJoinSwapGroupNV'); - wglBindSwapBarrierNV := dglGetProcAddress('wglBindSwapBarrierNV'); - wglQuerySwapGroupNV := dglGetProcAddress('wglQuerySwapGroupNV'); - wglQueryMaxSwapGroupsNV := dglGetProcAddress('wglQueryMaxSwapGroupsNV'); - wglQueryFrameCountNV := dglGetProcAddress('wglQueryFrameCountNV'); - wglResetFrameCountNV := dglGetProcAddress('wglResetFrameCountNV'); -end; - -procedure Read_WGL_NV_gpu_affinity; -begin - wglEnumGpusNV := dglGetProcAddress('wglEnumGpusNV'); - wglEnumGpuDevicesNV := dglGetProcAddress('wglEnumGpuDevicesNV'); - wglCreateAffinityDCNV := dglGetProcAddress('wglCreateAffinityDCNV'); - wglEnumGpusFromAffinityDCNV := dglGetProcAddress('wglEnumGpusFromAffinityDCNV'); - wglDeleteDCNV := dglGetProcAddress('wglDeleteDCNV'); -end; - -procedure Read_WGL_NV_video_capture; -begin - wglBindVideoCaptureDeviceNV := dglGetProcAddress('wglBindVideoCaptureDeviceNV'); - wglEnumerateVideoCaptureDevicesNV := dglGetProcAddress('wglEnumerateVideoCaptureDevicesNV'); - wglLockVideoCaptureDeviceNV := dglGetProcAddress('wglLockVideoCaptureDeviceNV'); - wglQueryVideoCaptureDeviceNV := dglGetProcAddress('wglQueryVideoCaptureDeviceNV'); - wglReleaseVideoCaptureDeviceNV := dglGetProcAddress('wglReleaseVideoCaptureDeviceNV'); -end; - -procedure Read_WGL_NV_copy_image; -begin - wglCopyImageSubDataNV := dglGetProcAddress('wglCopyImageSubDataNV'); -end; - -procedure Read_WGL_NV_DX_interop; -begin - wglDXSetResourceShareHandleNV := dglGetProcAddress('wglDXSetResourceShareHandleNV'); - wglDXOpenDeviceNV := dglGetProcAddress('wglDXOpenDeviceNV'); - wglDXCloseDeviceNV := dglGetProcAddress('wglDXCloseDeviceNV'); - wglDXRegisterObjectNV := dglGetProcAddress('wglDXRegisterObjectNV'); - wglDXUnregisterObjectNV := dglGetProcAddress('wglDXUnregisterObjectNV'); - wglDXObjectAccessNV := dglGetProcAddress('wglDXObjectAccessNV'); - wglDXLockObjectsNV := dglGetProcAddress('wglDXLockObjectsNV'); - wglDXUnlockObjectsNV := dglGetProcAddress('wglDXUnlockObjectsNV'); -end; - - -procedure Read_WGL_OML_sync_control; -begin - wglGetSyncValuesOML := dglGetProcAddress('wglGetSyncValuesOML'); - wglGetMscRateOML := dglGetProcAddress('wglGetMscRateOML'); - wglSwapBuffersMscOML := dglGetProcAddress('wglSwapBuffersMscOML'); - wglSwapLayerBuffersMscOML := dglGetProcAddress('wglSwapLayerBuffersMscOML'); - wglWaitForMscOML := dglGetProcAddress('wglWaitForMscOML'); - wglWaitForSbcOML := dglGetProcAddress('wglWaitForSbcOML'); -end; - -procedure Read_WGL_3DL_stereo_control; -begin - wglSetStereoEmitterState3DL := dglGetProcAddress('wglSetStereoEmitterState3DL'); -end; - -procedure Read_WIN_draw_range_elements; -begin - glDrawRangeElementsWIN := dglGetProcAddress('glDrawRangeElementsWIN'); -end; - -procedure Read_WIN_swap_hint; -begin - glAddSwapHintRectWIN := dglGetProcAddress('glAddSwapHintRectWIN'); -end; -{$ENDIF} - - -procedure ReadExtensions; -begin - ReadOpenGLCore; - - Read_GL_3DFX_tbuffer; - Read_GL_APPLE_element_array; - Read_GL_APPLE_fence; - Read_GL_APPLE_vertex_array_object; - Read_GL_APPLE_vertex_array_range; - Read_GL_APPLE_texture_range; - Read_GL_APPLE_vertex_program_evaluators; - Read_GL_APPLE_object_purgeable; - Read_GL_ARB_matrix_palette; - Read_GL_ARB_multitexture; - Read_GL_ARB_point_parameters; - Read_GL_ARB_texture_compression; - Read_GL_ARB_transpose_matrix; - Read_GL_ARB_vertex_blend; - Read_GL_ARB_vertex_buffer_object; - Read_GL_ARB_vertex_program; - Read_GL_ARB_window_pos; - Read_GL_ARB_color_buffer_float; - Read_GL_ARB_Shader_Objects; - Read_GL_ARB_occlusion_query; - Read_GL_ARB_draw_instanced; - Read_GL_ARB_framebuffer_object; - Read_GL_ARB_geometry_shader4; - Read_GL_ARB_instanced_arrays; - Read_GL_ARB_map_buffer_range; - Read_GL_ARB_texture_buffer_object; - Read_GL_ARB_vertex_array_object; - Read_GL_ARB_uniform_buffer_object; - Read_GL_ARB_copy_buffer; - Read_GL_ARB_draw_elements_base_vertex; - Read_GL_ARB_provoking_vertex; - Read_GL_ARB_sync; - Read_GL_ARB_texture_multisample; - Read_GL_ARB_draw_buffers_blend; - Read_GL_ARB_sample_shading; - Read_GL_ARB_shading_language_include; - Read_GL_ARB_blend_func_extended; - Read_GL_ARB_sampler_objects; - Read_GL_ARB_timer_query; - Read_GL_ARB_vertex_type_2_10_10_10_rev; - Read_GL_ARB_draw_indirect; - Read_GL_ARB_gpu_shader_fp64; - Read_GL_ARB_shader_subroutine; - Read_GL_ARB_tessellation_shader; - Read_GL_ARB_transform_feedback2; - Read_GL_ARB_transform_feedback3; - Read_GL_ARB_ES2_compatibility; - Read_GL_ARB_get_program_binary; - Read_GL_ARB_separate_shader_objects; - Read_GL_ARB_vertex_attrib_64bit; - Read_GL_ARB_viewport_array; - Read_GL_ARB_cl_event; - Read_GL_ARB_debug_output; - Read_GL_ARB_robustness; - // - Read_GL_ATI_draw_buffers; - Read_GL_ATI_element_array; - Read_GL_ATI_envmap_bumpmap; - Read_GL_ATI_fragment_shader; - Read_GL_ATI_map_object_buffer; - Read_GL_ATI_pn_triangles; - Read_GL_ATI_separate_stencil; - Read_GL_ATI_vertex_array_object; - Read_GL_ATI_vertex_attrib_array_object; - Read_GL_ATI_vertex_streams; - Read_GL_AMD_performance_monitor; - Read_GL_AMD_vertex_shader_tesselator; - Read_GL_AMD_draw_buffers_blend; - Read_GL_AMD_name_gen_delete; - Read_GL_AMD_debug_output; - Read_GL_AMD_stencil_operation_extended; - Read_GL_EXT_blend_color; - Read_GL_EXT_blend_func_separate; - Read_GL_EXT_blend_minmax; - Read_GL_EXT_color_subtable; - Read_GL_EXT_compiled_vertex_array; - Read_GL_EXT_convolution; - Read_GL_EXT_coordinate_frame; - Read_GL_EXT_copy_texture; - Read_GL_EXT_cull_vertex; - Read_GL_EXT_draw_range_elements; - Read_GL_EXT_fog_coord; - Read_GL_EXT_framebuffer_object; - Read_GL_EXT_histogram; - Read_GL_EXT_index_func; - Read_GL_EXT_index_material; - Read_GL_EXT_multi_draw_arrays; - Read_GL_EXT_multisample; - Read_GL_EXT_paletted_texture; - Read_GL_EXT_pixel_transform; - Read_GL_EXT_point_parameters; - Read_GL_EXT_polygon_offset; - Read_GL_EXT_secondary_color; - Read_GL_EXT_stencil_two_side; - Read_GL_EXT_subtexture; - Read_GL_EXT_texture3D; - Read_GL_EXT_texture_object; - Read_GL_EXT_texture_perturb_normal; - Read_GL_EXT_vertex_array; - Read_GL_EXT_vertex_shader; - Read_GL_EXT_vertex_weighting; - Read_GL_EXT_depth_bounds_test; - Read_GL_EXT_blend_equation_separate; - Read_GL_EXT_stencil_clear_tag; - Read_GL_EXT_framebuffer_blit; - Read_GL_EXT_framebuffer_multisample; - Read_GL_EXT_timer_query; - Read_GL_EXT_gpu_program_parameters; - Read_GL_EXT_bindable_uniform; - Read_GL_EXT_draw_buffers2; - Read_GL_EXT_draw_instanced; - Read_GL_EXT_geometry_shader4; - Read_GL_EXT_gpu_shader4; - Read_GL_EXT_texture_array; - Read_GL_EXT_texture_buffer_object; - Read_GL_EXT_texture_integer; - Read_GL_EXT_transform_feedback; - Read_GL_EXT_direct_state_access; - Read_GL_EXT_separate_shader_objects; - Read_GL_EXT_shader_image_load_store; - Read_GL_EXT_vertex_attrib_64bit; - Read_GL_HP_image_transform; - Read_GL_IBM_multimode_draw_arrays; - Read_GL_IBM_vertex_array_lists; - Read_GL_INGR_blend_func_separate; - Read_GL_INTEL_parallel_arrays; - Read_GL_MESA_resize_buffers; - Read_GL_MESA_window_pos; - Read_GL_NV_evaluators; - Read_GL_NV_fence; - Read_GL_NV_fragment_program; - Read_GL_NV_half_float; - Read_GL_NV_occlusion_query; - Read_GL_NV_pixel_data_range; - Read_GL_NV_point_sprite; - Read_GL_NV_primitive_restart; - Read_GL_NV_register_combiners; - Read_GL_NV_register_combiners2; - Read_GL_NV_vertex_array_range; - Read_GL_NV_vertex_program; - Read_GL_NV_depth_buffer_float; - Read_GL_NV_framebuffer_multisample_coverage; - Read_GL_NV_geometry_program4; - Read_GL_NV_gpu_program4; - Read_GL_NV_parameter_buffer_object; - Read_GL_NV_transform_feedback; - Read_GL_NV_conditional_render; - Read_GL_NV_present_video; - Read_GL_NV_explicit_multisample; - Read_GL_NV_transform_feedback2; - Read_GL_NV_video_capture; - Read_GL_NV_copy_image; - Read_GL_NV_shader_buffer_load; - Read_GL_NV_vertex_buffer_unified_memory; - Read_GL_NV_gpu_program5; - Read_GL_NV_gpu_shader5; - Read_GL_NV_vertex_attrib_integer_64bit; - Read_GL_NV_vdpau_interop; - Read_GL_NV_texture_barrier; - Read_GL_NV_path_rendering; - Read_GL_NV_bindless_texture; - Read_GL_PGI_misc_hints; - Read_GL_SGIS_detail_texture; - Read_GL_SGIS_fog_function; - Read_GL_SGIS_multisample; - Read_GL_SGIS_pixel_texture; - Read_GL_SGIS_point_parameters; - Read_GL_SGIS_sharpen_texture; - Read_GL_SGIS_texture4D; - Read_GL_SGIS_texture_color_mask; - Read_GL_SGIS_texture_filter4; - Read_GL_SGIX_async; - Read_GL_SGIX_flush_raster; - Read_GL_SGIX_fragment_lighting; - Read_GL_SGIX_framezoom; - Read_GL_SGIX_igloo_interface; - Read_GL_SGIX_instruments; - Read_GL_SGIX_list_priority; - Read_GL_SGIX_pixel_texture; - Read_GL_SGIX_polynomial_ffd; - Read_GL_SGIX_reference_plane; - Read_GL_SGIX_sprite; - Read_GL_SGIX_tag_sample_buffer; - Read_GL_SGI_color_table; - Read_GL_SUNX_constant_data; - Read_GL_SUN_global_alpha; - Read_GL_SUN_mesh_array; - Read_GL_SUN_triangle_list; - Read_GL_SUN_vertex; - -{$IFDEF DGL_WIN} - Read_WGL_ARB_buffer_region; - Read_WGL_ARB_extensions_string; - Read_WGL_ARB_make_current_read; - Read_WGL_ARB_pbuffer; - Read_WGL_ARB_pixel_format; - Read_WGL_ARB_pixel_format_float; - Read_WGL_ARB_render_texture; - Read_WGL_ARB_create_context; - Read_WGL_AMD_gpu_association; - Read_WGL_EXT_display_color_table; - Read_WGL_EXT_extensions_string; - Read_WGL_EXT_make_current_read; - Read_WGL_EXT_pbuffer; - Read_WGL_EXT_pixel_format; - Read_WGL_EXT_swap_control; - Read_WGL_I3D_digital_video_control; - Read_WGL_I3D_gamma; - Read_WGL_I3D_genlock; - Read_WGL_I3D_image_buffer; - Read_WGL_I3D_swap_frame_lock; - Read_WGL_I3D_swap_frame_usage; - Read_WGL_NV_vertex_array_range; - Read_WGL_NV_present_video; - Read_WGL_NV_video_output; - Read_WGL_NV_swap_group; - Read_WGL_NV_gpu_affinity; - Read_WGL_NV_video_capture; - Read_WGL_NV_copy_image; - Read_WGL_NV_DX_interop; - Read_WGL_OML_sync_control; - Read_WGL_3DL_stereo_control; - - Read_WIN_draw_range_elements; - Read_WIN_swap_hint; -{$ENDIF} - - ExtensionsRead := True; -end; - -// ============================================================================= -// ReadCoreVersion -// ============================================================================= - -procedure ReadCoreVersion; -var - AnsiBuffer: AnsiString; - Buffer: String; - MajorVersion, MinorVersion: Integer; - - procedure TrimAndSplitVersionString(Buffer: String; var Max, Min: Integer); - // Peels out the X.Y form from the given Buffer which must contain a version string like "text Minor.Major.Build text" - // at least however "Major.Minor". - var - Separator: Integer; - begin - try - // There must be at least one dot to separate major and minor version number. - Separator := Pos('.', Buffer); - // At least one number must be before and one after the dot. - if (Separator > 1) and (Separator < Length(Buffer)) and (AnsiChar(Buffer[Separator - 1]) in ['0'..'9']) and - (AnsiChar(Buffer[Separator + 1]) in ['0'..'9']) then - begin - // OK, it's a valid version string. Now remove unnecessary parts. - Dec(Separator); - // Find last non-numeric character before version number. - while (Separator > 0) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do - Dec(Separator); - // Delete leading characters which do not belong to the version string. - Delete(Buffer, 1, Separator); - Separator := Pos('.', Buffer) + 1; - // Find first non-numeric character after version number - while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do - Inc(Separator); - // delete trailing characters not belonging to the version string - Delete(Buffer, Separator, 255); - // Now translate the numbers. - Separator := Pos('.', Buffer); // This is necessary because the buffer length might have changed. - Max := StrToInt(Copy(Buffer, 1, Separator - 1)); - Min := StrToInt(Copy(Buffer, Separator + 1, 1)); - end - else - Abort; - except - Min := 0; - Max := 0; - end; - end; - - -begin - // determine version of implementation - // GL - if not Assigned(@glGetString) then - glGetString := dglGetProcAddress('glGetString'); - - AnsiBuffer := glGetString(GL_VERSION); - Buffer := String(AnsiBuffer); - - TrimAndSplitVersionString(Buffer, MajorVersion, MinorVersion); - - GL_VERSION_1_0 := True; - GL_VERSION_1_1 := False; - GL_VERSION_1_2 := False; - GL_VERSION_1_3 := False; - GL_VERSION_1_4 := False; - GL_VERSION_1_5 := False; - GL_VERSION_2_0 := False; - GL_VERSION_2_1 := False; - GL_VERSION_3_0 := False; - GL_VERSION_3_1 := False; - GL_VERSION_3_2 := False; - GL_VERSION_3_3 := False; - GL_VERSION_4_0 := False; - GL_VERSION_4_1 := False; - GL_VERSION_4_2 := False; - GL_VERSION_4_3 := False; - - if MajorVersion = 1 then - begin - if MinorVersion >= 1 then - GL_VERSION_1_1 := True; - if MinorVersion >= 2 then - GL_VERSION_1_2 := True; - if MinorVersion >= 3 then - GL_VERSION_1_3 := True; - if MinorVersion >= 4 then - GL_VERSION_1_4 := True; - if MinorVersion >= 5 then - GL_VERSION_1_5 := True; - end; - - if MajorVersion >= 2 then - begin - GL_VERSION_1_1 := True; - GL_VERSION_1_2 := True; - GL_VERSION_1_3 := True; - GL_VERSION_1_4 := True; - GL_VERSION_1_5 := True; - GL_VERSION_2_0 := True; - - if MinorVersion >= 1 then - GL_VERSION_2_1 := True; - end; - - if MajorVersion >= 3 then - begin - GL_VERSION_2_1 := True; - GL_VERSION_3_0 := True; - - if MinorVersion >= 1 then - GL_VERSION_3_1 := True; - if MinorVersion >= 2 then - GL_VERSION_3_2 := True; - if MinorVersion >= 3 then - GL_VERSION_3_3 := True; - end; - - if MajorVersion >= 4 then - begin - GL_VERSION_3_1 := True; - GL_VERSION_3_2 := True; - GL_VERSION_3_3 := True; - GL_VERSION_4_0 := True; - - if MinorVersion >= 1 then - GL_VERSION_4_1 := True; - if MinorVersion >= 2 then - GL_VERSION_4_2 := True; - if MinorVersion >= 3 then - GL_VERSION_4_3 := True; - end; - - // GLU - GLU_VERSION_1_1 := False; - GLU_VERSION_1_2 := False; - GLU_VERSION_1_3 := False; - - if Assigned(gluGetString) then begin - AnsiBuffer := gluGetString(GLU_VERSION); - Buffer := String(AnsiBuffer); - - TrimAndSplitVersionString(Buffer, Majorversion, MinorVersion); - - GLU_VERSION_1_1 := True; - - if MinorVersion >= 2 then - GLU_VERSION_1_2 := True; - - if MinorVersion >= 3 then - GLU_VERSION_1_3 := True; - end; -end; - - -// ============================================================================= -// ReadImplementationProperties -// ============================================================================= - -procedure ReadImplementationProperties; -var - Buffer: Ansistring; -begin - ReadCoreVersion; - - // Check all extensions - Buffer := Int_GetExtensionString; - - // === 3DFX ==================================================================== - GL_3DFX_multisample := Int_CheckExtension(Buffer, 'GL_3DFX_multisample'); - GL_3DFX_tbuffer := Int_CheckExtension(Buffer, 'GL_3DFX_tbuffer'); - GL_3DFX_texture_compression_FXT1 := Int_CheckExtension(Buffer, 'GL_3DFX_texture_compression_FXT1'); - - // === APPLE =================================================================== - GL_APPLE_client_storage := Int_CheckExtension(Buffer, 'GL_APPLE_client_storage'); - GL_APPLE_element_array := Int_CheckExtension(Buffer, 'GL_APPLE_element_array'); - GL_APPLE_fence := Int_CheckExtension(Buffer, 'GL_APPLE_fence'); - GL_APPLE_specular_vector := Int_CheckExtension(Buffer, 'GL_APPLE_specular_vector'); - GL_APPLE_transform_hint := Int_CheckExtension(Buffer, 'GL_APPLE_transform_hint'); - GL_APPLE_vertex_array_object := Int_CheckExtension(Buffer, 'GL_APPLE_vertex_array_object'); - GL_APPLE_vertex_array_range := Int_CheckExtension(Buffer, 'GL_APPLE_vertex_array_range'); - GL_APPLE_ycbcr_422 := Int_CheckExtension(Buffer, 'GL_APPLE_ycbcr_422'); - GL_APPLE_texture_range := Int_CheckExtension(Buffer, 'GL_APPLE_texture_range'); - GL_APPLE_float_pixels := Int_CheckExtension(Buffer, 'GL_APPLE_float_pixels'); - GL_APPLE_vertex_program_evaluators := Int_CheckExtension(Buffer, 'GL_APPLE_vertex_program_evaluators'); - GL_APPLE_aux_depth_stencil := Int_CheckExtension(Buffer, 'GL_APPLE_aux_depth_stencil'); - GL_APPLE_object_purgeable := Int_CheckExtension(Buffer, 'GL_APPLE_object_purgeable'); - GL_APPLE_row_bytes := Int_CheckExtension(Buffer, 'GL_APPLE_row_bytes'); - GL_APPLE_rgb_422 := Int_CheckExtension(Buffer, 'GL_APPLE_rgb_422'); - - // === ARB ===================================================================== - GL_ARB_depth_texture := Int_CheckExtension(Buffer, 'GL_ARB_depth_texture'); - GL_ARB_fragment_program := Int_CheckExtension(Buffer, 'GL_ARB_fragment_program'); - GL_ARB_imaging := Int_CheckExtension(Buffer, 'GL_ARB_imaging'); - GL_ARB_matrix_palette := Int_CheckExtension(Buffer, 'GL_ARB_matrix_palette'); - GL_ARB_multisample := Int_CheckExtension(Buffer, 'GL_ARB_multisample'); - GL_ARB_multitexture := Int_CheckExtension(Buffer, 'GL_ARB_multitexture'); - GL_ARB_point_parameters := Int_CheckExtension(Buffer, 'GL_ARB_point_parameters'); - GL_ARB_shadow := Int_CheckExtension(Buffer, 'GL_ARB_shadow'); - GL_ARB_shadow_ambient := Int_CheckExtension(Buffer, 'GL_ARB_shadow_ambient'); - GL_ARB_texture_border_clamp := Int_CheckExtension(Buffer, 'GL_ARB_texture_border_clamp'); - GL_ARB_texture_compression := Int_CheckExtension(Buffer, 'GL_ARB_texture_compression'); - GL_ARB_texture_cube_map := Int_CheckExtension(Buffer, 'GL_ARB_texture_cube_map'); - GL_ARB_texture_env_add := Int_CheckExtension(Buffer, 'GL_ARB_texture_env_add'); - GL_ARB_texture_env_combine := Int_CheckExtension(Buffer, 'GL_ARB_texture_env_combine'); - GL_ARB_texture_env_crossbar := Int_CheckExtension(Buffer, 'GL_ARB_texture_env_crossbar'); - GL_ARB_texture_env_dot3 := Int_CheckExtension(Buffer, 'GL_ARB_texture_env_dot3'); - GL_ARB_texture_mirrored_repeat := Int_CheckExtension(Buffer, 'GL_ARB_texture_mirrored_repeat'); - GL_ARB_transpose_matrix := Int_CheckExtension(Buffer, 'GL_ARB_transpose_matrix'); - GL_ARB_vertex_blend := Int_CheckExtension(Buffer, 'GL_ARB_vertex_blend'); - GL_ARB_vertex_buffer_object := Int_CheckExtension(Buffer, 'GL_ARB_vertex_buffer_object'); - GL_ARB_vertex_program := Int_CheckExtension(Buffer, 'GL_ARB_vertex_program'); - GL_ARB_window_pos := Int_CheckExtension(Buffer, 'GL_ARB_window_pos'); - GL_ARB_shader_objects := Int_CheckExtension(Buffer, 'GL_ARB_shader_objects'); - GL_ARB_vertex_shader := Int_CheckExtension(Buffer, 'GL_ARB_vertex_shader'); - GL_ARB_fragment_shader := Int_CheckExtension(Buffer, 'GL_ARB_fragment_shader'); - GL_ARB_occlusion_query := Int_CheckExtension(Buffer, 'GL_ARB_occlusion_query'); - GL_ARB_shading_language_100 := Int_CheckExtension(Buffer, 'GL_ARB_shading_language_100'); - GL_ARB_point_sprite := Int_CheckExtension(Buffer, 'GL_ARB_point_sprite'); - GL_ARB_texture_non_power_of_two := Int_CheckExtension(Buffer, 'GL_ARB_texture_non_power_of_two'); - GL_ARB_fragment_program_shadow := Int_CheckExtension(Buffer, 'GL_ARB_fragment_program_shadow'); - GL_ARB_draw_buffers := Int_CheckExtension(Buffer, 'GL_ARB_draw_buffers'); - GL_ARB_texture_rectangle := Int_CheckExtension(Buffer, 'GL_ARB_texture_rectangle'); - GL_ARB_color_buffer_float := Int_CheckExtension(Buffer, 'GL_ARB_color_buffer_float'); - GL_ARB_half_float_pixel := Int_CheckExtension(Buffer, 'GL_ARB_half_float_pixel'); - GL_ARB_texture_float := Int_CheckExtension(Buffer, 'GL_ARB_texture_float'); - GL_ARB_pixel_buffer_object := Int_CheckExtension(Buffer, 'GL_ARB_pixel_buffer_object'); - GL_ARB_depth_buffer_float := Int_CheckExtension(Buffer, 'GL_ARB_depth_buffer_float'); - GL_ARB_draw_instanced := Int_CheckExtension(Buffer, 'GL_ARB_draw_instanced'); - GL_ARB_framebuffer_object := Int_CheckExtension(Buffer, 'GL_ARB_framebuffer_object'); - GL_ARB_framebuffer_sRGB := Int_CheckExtension(Buffer, 'GL_ARB_framebuffer_sRGB'); - GL_ARB_geometry_shader4 := Int_CheckExtension(Buffer, 'GL_ARB_geometry_shader4'); - GL_ARB_half_float_vertex := Int_CheckExtension(Buffer, 'GL_ARB_half_float_vertex'); - GL_ARB_instanced_arrays := Int_CheckExtension(Buffer, 'GL_ARB_instanced_arrays'); - GL_ARB_map_buffer_range := Int_CheckExtension(Buffer, 'GL_ARB_map_buffer_range'); - GL_ARB_texture_buffer_object := Int_CheckExtension(Buffer, 'GL_ARB_texture_buffer_object'); - GL_ARB_texture_compression_rgtc := Int_CheckExtension(Buffer, 'GL_ARB_texture_compression_rgtc'); - GL_ARB_texture_rg := Int_CheckExtension(Buffer, 'GL_ARB_texture_rg'); - GL_ARB_vertex_array_object := Int_CheckExtension(Buffer, 'GL_ARB_vertex_array_object'); - GL_ARB_uniform_buffer_object := Int_CheckExtension(Buffer, 'GL_ARB_uniform_buffer_object'); - GL_ARB_compatibility := Int_CheckExtension(Buffer, 'GL_ARB_compatibility'); - GL_ARB_copy_buffer := Int_CheckExtension(Buffer, 'GL_ARB_copy_buffer'); - GL_ARB_shader_texture_lod := Int_CheckExtension(Buffer, 'GL_ARB_shader_texture_lod'); - GL_ARB_depth_clamp := Int_CheckExtension(Buffer, 'GL_ARB_depth_clamp'); - GL_ARB_draw_elements_base_vertex := Int_CheckExtension(Buffer, 'GL_ARB_draw_elements_base_vertex'); - GL_ARB_fragment_coord_conventions := Int_CheckExtension(Buffer, 'GL_ARB_fragment_coord_conventions'); - GL_ARB_provoking_vertex := Int_CheckExtension(Buffer, 'GL_ARB_provoking_vertex'); - GL_ARB_seamless_cube_map := Int_CheckExtension(Buffer, 'GL_ARB_seamless_cube_map'); - GL_ARB_sync := Int_CheckExtension(Buffer, 'GL_ARB_sync'); - GL_ARB_texture_multisample := Int_CheckExtension(Buffer, 'GL_ARB_texture_multisample'); - GL_ARB_vertex_array_bgra := Int_CheckExtension(Buffer, 'GL_ARB_vertex_array_bgra'); - GL_ARB_draw_buffers_blend := Int_CheckExtension(Buffer, 'GL_ARB_draw_buffers_blend'); - GL_ARB_sample_shading := Int_CheckExtension(Buffer, 'GL_ARB_sample_shading'); - GL_ARB_texture_cube_map_array := Int_CheckExtension(Buffer, 'GL_ARB_texture_cube_map_array'); - GL_ARB_texture_gather := Int_CheckExtension(Buffer, 'GL_ARB_texture_gather'); - GL_ARB_texture_query_lod := Int_CheckExtension(Buffer, 'GL_ARB_texture_query_lod'); - GL_ARB_shading_language_include := Int_CheckExtension(Buffer, 'GL_ARB_shading_language_include'); - GL_ARB_texture_compression_bptc := Int_CheckExtension(Buffer, 'GL_ARB_texture_compression_bptc'); - GL_ARB_blend_func_extended := Int_CheckExtension(Buffer, 'GL_ARB_blend_func_extended'); - GL_ARB_explicit_attrib_location := Int_CheckExtension(Buffer, 'GL_ARB_explicit_attrib_location'); - GL_ARB_occlusion_query2 := Int_CheckExtension(Buffer, 'GL_ARB_occlusion_query2'); - GL_ARB_sampler_objects := Int_CheckExtension(Buffer, 'GL_ARB_sampler_objects'); - GL_ARB_shader_bit_encoding := Int_CheckExtension(Buffer, 'GL_ARB_shader_bit_encoding'); - GL_ARB_texture_rgb10_a2ui := Int_CheckExtension(Buffer, 'GL_ARB_texture_rgb10_a2ui'); - GL_ARB_texture_swizzle := Int_CheckExtension(Buffer, 'GL_ARB_texture_swizzle'); - GL_ARB_timer_query := Int_CheckExtension(Buffer, 'GL_ARB_timer_query'); - GL_ARB_vertex_type_2_10_10_10_rev := Int_CheckExtension(Buffer, 'GL_ARB_vertex_type_2_10_10_10_rev'); - GL_ARB_draw_indirect := Int_CheckExtension(Buffer, 'GL_ARB_draw_indirect'); - GL_ARB_gpu_shader5 := Int_CheckExtension(Buffer, 'GL_ARB_gpu_shader5'); - GL_ARB_gpu_shader_fp64 := Int_CheckExtension(Buffer, 'GL_ARB_gpu_shader_fp64'); - GL_ARB_shader_subroutine := Int_CheckExtension(Buffer, 'GL_ARB_shader_subroutine'); - GL_ARB_tessellation_shader := Int_CheckExtension(Buffer, 'GL_ARB_tessellation_shader'); - GL_ARB_texture_buffer_object_rgb32 := Int_CheckExtension(Buffer, 'GL_ARB_texture_buffer_object_rgb32'); - GL_ARB_transform_feedback2 := Int_CheckExtension(Buffer, 'GL_ARB_transform_feedback2'); - GL_ARB_transform_feedback3 := Int_CheckExtension(Buffer, 'GL_ARB_transform_feedback3'); - GL_ARB_ES2_compatibility := Int_CheckExtension(Buffer, 'GL_ARB_ES2_compatibility'); - GL_ARB_get_program_binary := Int_CheckExtension(Buffer, 'GL_ARB_get_program_binary'); - GL_ARB_separate_shader_objects := Int_CheckExtension(Buffer, 'GL_ARB_separate_shader_objects'); - GL_ARB_shader_precision := Int_CheckExtension(Buffer, 'GL_ARB_shader_precision'); - GL_ARB_vertex_attrib_64bit := Int_CheckExtension(Buffer, 'GL_ARB_vertex_attrib_64bit'); - GL_ARB_viewport_array := Int_CheckExtension(Buffer, 'GL_ARB_viewport_array'); - // GL 4.2 - GL_ARB_base_instance := Int_CheckExtension(Buffer, 'GL_ARB_base_instance'); - GL_ARB_shading_language_420pack := Int_CheckExtension(Buffer, 'GL_ARB_shading_language_420pack'); - GL_ARB_transform_feedback_instanced := Int_CheckExtension(Buffer, 'GL_ARB_transform_feedback_instanced'); - GL_ARB_compressed_texture_pixel_storage := Int_CheckExtension(Buffer, 'GL_ARB_compressed_texture_pixel_storage'); - GL_ARB_conservative_depth := Int_CheckExtension(Buffer, 'GL_ARB_conservative_depth'); - GL_ARB_internalformat_query := Int_CheckExtension(Buffer, 'GL_ARB_internalformat_query'); - GL_ARB_map_buffer_alignment := Int_CheckExtension(Buffer, 'GL_ARB_map_buffer_alignment'); - GL_ARB_shader_atomic_counters := Int_CheckExtension(Buffer, 'GL_ARB_shader_atomic_counters'); - GL_ARB_shader_image_load_store := Int_CheckExtension(Buffer, 'GL_ARB_shader_image_load_store'); - GL_ARB_shading_language_packing := Int_CheckExtension(Buffer, 'GL_ARB_shading_language_packing'); - GL_ARB_texture_storage := Int_CheckExtension(Buffer, 'GL_ARB_texture_storage'); - // GL 4.3 - GL_ARB_arrays_of_arrays := Int_CheckExtension(Buffer, 'GL_ARB_arrays_of_arrays'); - GL_ARB_fragment_layer_viewport := Int_CheckExtension(Buffer, 'GL_ARB_fragment_layer_viewport'); - GL_ARB_shader_image_size := Int_CheckExtension(Buffer, 'GL_ARB_shader_image_size'); - GL_ARB_ES3_compatibility := Int_CheckExtension(Buffer, 'GL_ARB_ES3_compatibility'); - GL_ARB_clear_buffer_object := Int_CheckExtension(Buffer, 'GL_ARB_clear_buffer_object'); - GL_ARB_compute_shader := Int_CheckExtension(Buffer, 'GL_ARB_compute_shader'); - GL_ARB_copy_image := Int_CheckExtension(Buffer, 'GL_ARB_copy_image'); - GL_KHR_debug := Int_CheckExtension(Buffer, 'GL_KHR_debug'); - GL_ARB_explicit_uniform_location := Int_CheckExtension(Buffer, 'GL_ARB_explicit_uniform_location'); - GL_ARB_framebuffer_no_attachments := Int_CheckExtension(Buffer, 'GL_ARB_framebuffer_no_attachments'); - GL_ARB_internalformat_query2 := Int_CheckExtension(Buffer, 'GL_ARB_internalformat_query2'); - GL_ARB_invalidate_subdata := Int_CheckExtension(Buffer, 'GL_ARB_invalidate_subdata'); - GL_ARB_multi_draw_indirect := Int_CheckExtension(Buffer, 'GL_ARB_multi_draw_indirect'); - GL_ARB_program_interface_query := Int_CheckExtension(Buffer, 'GL_ARB_program_interface_query'); - GL_ARB_robust_buffer_access_behavior := Int_CheckExtension(Buffer, 'GL_ARB_robust_buffer_access_behavior'); - GL_ARB_shader_storage_buffer_object := Int_CheckExtension(Buffer, 'GL_ARB_shader_storage_buffer_object'); - GL_ARB_stencil_texturing := Int_CheckExtension(Buffer, 'GL_ARB_stencil_texturing'); - GL_ARB_texture_buffer_range := Int_CheckExtension(Buffer, 'GL_ARB_texture_buffer_range'); - GL_ARB_texture_query_levels := Int_CheckExtension(Buffer, 'GL_ARB_texture_query_levels'); - GL_ARB_texture_storage_multisample := Int_CheckExtension(Buffer, 'GL_ARB_texture_storage_multisample'); - GL_ARB_texture_view := Int_CheckExtension(Buffer, 'GL_ARB_texture_view'); - GL_ARB_vertex_attrib_binding := Int_CheckExtension(Buffer, 'GL_ARB_vertex_attrib_binding'); - // - GL_ARB_cl_event := Int_CheckExtension(Buffer, 'GL_ARB_cl_event'); - GL_ARB_debug_output := Int_CheckExtension(Buffer, 'GL_ARB_debug_output'); - GL_ARB_robustness := Int_CheckExtension(Buffer, 'GL_ARB_robustness'); - GL_ARB_shader_stencil_export := Int_CheckExtension(Buffer, 'GL_ARB_shader_stencil_export'); - - // === ATI/AMD ================================================================ - GL_ATI_draw_buffers := Int_CheckExtension(Buffer, 'GL_ATI_draw_buffers'); - GL_ATI_element_array := Int_CheckExtension(Buffer, 'GL_ATI_element_array'); - GL_ATI_envmap_bumpmap := Int_CheckExtension(Buffer, 'GL_ATI_envmap_bumpmap'); - GL_ATI_fragment_shader := Int_CheckExtension(Buffer, 'GL_ATI_fragment_shader'); - GL_ATI_map_object_buffer := Int_CheckExtension(Buffer, 'GL_ATI_map_object_buffer'); - GL_ATI_pn_triangles := Int_CheckExtension(Buffer, 'GL_ATI_pn_triangles'); - GL_ATI_separate_stencil := Int_CheckExtension(Buffer, 'GL_ATI_separate_stencil'); - GL_ATI_text_fragment_shader := Int_CheckExtension(Buffer, 'GL_ATI_text_fragment_shader'); - GL_ATI_texture_env_combine3 := Int_CheckExtension(Buffer, 'GL_ATI_texture_env_combine3'); - GL_ATI_texture_float := Int_CheckExtension(Buffer, 'GL_ATI_texture_float'); - GL_ATI_texture_mirror_once := Int_CheckExtension(Buffer, 'GL_ATI_texture_mirror_once'); - GL_ATI_vertex_array_object := Int_CheckExtension(Buffer, 'GL_ATI_vertex_array_object'); - GL_ATI_vertex_attrib_array_object := Int_CheckExtension(Buffer, 'GL_ATI_vertex_attrib_array_object'); - GL_ATI_vertex_streams := Int_CheckExtension(Buffer, 'GL_ATI_vertex_streams'); - GL_ATI_meminfo := Int_CheckExtension(Buffer, 'GL_ATI_meminfo'); - GL_AMD_performance_monitor := Int_CheckExtension(Buffer, 'GL_AMD_performance_monitor'); - GL_AMD_texture_texture4 := Int_CheckExtension(Buffer, 'GL_AMD_texture_texture4'); - GL_AMD_vertex_shader_tesselator := Int_CheckExtension(Buffer, 'GL_AMD_vertex_shader_tesselator'); - GL_AMD_draw_buffers_blend := Int_CheckExtension(Buffer, 'GL_AMD_draw_buffers_blend'); - GL_AMD_shader_stencil_export := Int_CheckExtension(Buffer, 'GL_AMD_shader_stencil_export'); - GL_AMD_seamless_cubemap_per_texture := Int_CheckExtension(Buffer, 'GL_AMD_seamless_cubemap_per_texture'); - GL_AMD_conservative_depth := Int_CheckExtension(Buffer, 'GL_AMD_conservative_depth'); - GL_AMD_name_gen_delete := Int_CheckExtension(Buffer, 'GL_AMD_name_gen_delete'); - GL_AMD_debug_output := Int_CheckExtension(Buffer, 'GL_AMD_debug_output'); - GL_AMD_transform_feedback3_lines_triangles := Int_CheckExtension(Buffer, 'GL_AMD_transform_feedback3_lines_triangles'); - GL_AMD_depth_clamp_separate := Int_CheckExtension(Buffer, 'GL_AMD_depth_clamp_separate'); - // 4.3 - GL_AMD_pinned_memory := Int_CheckExtension(Buffer, 'GL_AMD_pinned_memory'); - GL_AMD_stencil_operation_extended := Int_CheckExtension(Buffer, 'GL_AMD_stencil_operation_extended'); - GL_AMD_vertex_shader_viewport_index := Int_CheckExtension(Buffer, 'GL_AMD_vertex_shader_viewport_index'); - GL_AMD_vertex_shader_layer := Int_CheckExtension(Buffer, 'GL_AMD_vertex_shader_layer'); - GL_AMD_query_buffer_object := Int_CheckExtension(Buffer, 'GL_AMD_query_buffer_object'); - - // === EXT ===================================================================== - GL_EXT_422_pixels := Int_CheckExtension(Buffer, 'GL_EXT_422_pixels'); - GL_EXT_abgr := Int_CheckExtension(Buffer, 'GL_EXT_abgr'); - GL_EXT_bgra := Int_CheckExtension(Buffer, 'GL_EXT_bgra'); - GL_EXT_blend_color := Int_CheckExtension(Buffer, 'GL_EXT_blend_color'); - GL_EXT_blend_func_separate := Int_CheckExtension(Buffer, 'GL_EXT_blend_func_separate'); - GL_EXT_blend_logic_op := Int_CheckExtension(Buffer, 'GL_EXT_blend_logic_op'); - GL_EXT_blend_minmax := Int_CheckExtension(Buffer, 'GL_EXT_blend_minmax'); - GL_EXT_blend_subtract := Int_CheckExtension(Buffer, 'GL_EXT_blend_subtract'); - GL_EXT_clip_volume_hint := Int_CheckExtension(Buffer, 'GL_EXT_clip_volume_hint'); - GL_EXT_cmyka := Int_CheckExtension(Buffer, 'GL_EXT_cmyka'); - GL_EXT_color_matrix := Int_CheckExtension(Buffer, 'GL_EXT_color_matrix'); - GL_EXT_color_subtable := Int_CheckExtension(Buffer, 'GL_EXT_color_subtable'); - GL_EXT_compiled_vertex_array := Int_CheckExtension(Buffer, 'GL_EXT_compiled_vertex_array'); - GL_EXT_convolution := Int_CheckExtension(Buffer, 'GL_EXT_convolution'); - GL_EXT_coordinate_frame := Int_CheckExtension(Buffer, 'GL_EXT_coordinate_frame'); - GL_EXT_copy_texture := Int_CheckExtension(Buffer, 'GL_EXT_copy_texture'); - GL_EXT_cull_vertex := Int_CheckExtension(Buffer, 'GL_EXT_cull_vertex'); - GL_EXT_draw_range_elements := Int_CheckExtension(Buffer, 'GL_EXT_draw_range_elements'); - GL_EXT_fog_coord := Int_CheckExtension(Buffer, 'GL_EXT_fog_coord'); - GL_EXT_framebuffer_object := Int_CheckExtension(Buffer, 'GL_EXT_framebuffer_object'); - GL_EXT_histogram := Int_CheckExtension(Buffer, 'GL_EXT_histogram'); - GL_EXT_index_array_formats := Int_CheckExtension(Buffer, 'GL_EXT_index_array_formats'); - GL_EXT_index_func := Int_CheckExtension(Buffer, 'GL_EXT_index_func'); - GL_EXT_index_material := Int_CheckExtension(Buffer, 'GL_EXT_index_material'); - GL_EXT_index_texture := Int_CheckExtension(Buffer, 'GL_EXT_index_texture'); - GL_EXT_light_texture := Int_CheckExtension(Buffer, 'GL_EXT_light_texture'); - GL_EXT_misc_attribute := Int_CheckExtension(Buffer, 'GL_EXT_misc_attribute'); - GL_EXT_multi_draw_arrays := Int_CheckExtension(Buffer, 'GL_EXT_multi_draw_arrays'); - GL_EXT_multisample := Int_CheckExtension(Buffer, 'GL_EXT_multisample'); - GL_EXT_packed_pixels := Int_CheckExtension(Buffer, 'GL_EXT_packed_pixels'); - GL_EXT_paletted_texture := Int_CheckExtension(Buffer, 'GL_EXT_paletted_texture'); - GL_EXT_pixel_transform := Int_CheckExtension(Buffer, 'GL_EXT_pixel_transform'); - GL_EXT_pixel_transform_color_table := Int_CheckExtension(Buffer, 'GL_EXT_pixel_transform_color_table'); - GL_EXT_point_parameters := Int_CheckExtension(Buffer, 'GL_EXT_point_parameters'); - GL_EXT_polygon_offset := Int_CheckExtension(Buffer, 'GL_EXT_polygon_offset'); - GL_EXT_rescale_normal := Int_CheckExtension(Buffer, 'GL_EXT_rescale_normal'); - GL_EXT_secondary_color := Int_CheckExtension(Buffer, 'GL_EXT_secondary_color'); - GL_EXT_separate_specular_color := Int_CheckExtension(Buffer, 'GL_EXT_separate_specular_color'); - GL_EXT_shadow_funcs := Int_CheckExtension(Buffer, 'GL_EXT_shadow_funcs'); - GL_EXT_shared_texture_palette := Int_CheckExtension(Buffer, 'GL_EXT_shared_texture_palette'); - GL_EXT_stencil_two_side := Int_CheckExtension(Buffer, 'GL_EXT_stencil_two_side'); - GL_EXT_stencil_wrap := Int_CheckExtension(Buffer, 'GL_EXT_stencil_wrap'); - GL_EXT_subtexture := Int_CheckExtension(Buffer, 'GL_EXT_subtexture'); - GL_EXT_texture := Int_CheckExtension(Buffer, 'GL_EXT_texture'); - GL_EXT_texture3D := Int_CheckExtension(Buffer, 'GL_EXT_texture3D'); - GL_EXT_texture_compression_s3tc := Int_CheckExtension(Buffer, 'GL_EXT_texture_compression_s3tc'); - GL_EXT_texture_cube_map := Int_CheckExtension(Buffer, 'GL_EXT_texture_cube_map'); - GL_EXT_texture_edge_clamp := Int_CheckExtension(Buffer, 'GL_EXT_texture_edge_clamp'); - GL_EXT_texture_env_add := Int_CheckExtension(Buffer, 'GL_EXT_texture_env_add'); - GL_EXT_texture_env_combine := Int_CheckExtension(Buffer, 'GL_EXT_texture_env_combine'); - GL_EXT_texture_env_dot3 := Int_CheckExtension(Buffer, 'GL_EXT_texture_env_dot3'); - GL_EXT_texture_filter_anisotropic := Int_CheckExtension(Buffer, 'GL_EXT_texture_filter_anisotropic'); - GL_EXT_texture_lod_bias := Int_CheckExtension(Buffer, 'GL_EXT_texture_lod_bias'); - GL_EXT_texture_object := Int_CheckExtension(Buffer, 'GL_EXT_texture_object'); - GL_EXT_texture_perturb_normal := Int_CheckExtension(Buffer, 'GL_EXT_texture_perturb_normal'); - GL_EXT_texture_rectangle := Int_CheckExtension(Buffer, 'GL_EXT_texture_rectangle'); - GL_EXT_vertex_array := Int_CheckExtension(Buffer, 'GL_EXT_vertex_array'); - GL_EXT_vertex_shader := Int_CheckExtension(Buffer, 'GL_EXT_vertex_shader'); - GL_EXT_vertex_weighting := Int_CheckExtension(Buffer, 'GL_EXT_vertex_weighting'); - GL_EXT_depth_bounds_test := Int_CheckExtension(Buffer, 'GL_EXT_depth_bounds_test'); - GL_EXT_texture_mirror_clamp := Int_CheckExtension(Buffer, 'GL_EXT_texture_mirror_clamp'); - GL_EXT_blend_equation_separate := Int_CheckExtension(Buffer, 'GL_EXT_blend_equation_separate'); - GL_EXT_pixel_buffer_object := Int_CheckExtension(Buffer, 'GL_EXT_pixel_buffer_object'); - GL_EXT_texture_compression_dxt1 := Int_CheckExtension(Buffer, 'GL_EXT_texture_compression_dxt1'); - GL_EXT_stencil_clear_tag := Int_CheckExtension(Buffer, 'GL_EXT_stencil_clear_tag'); - GL_EXT_packed_depth_stencil := Int_CheckExtension(Buffer, 'GL_EXT_packed_depth_stencil'); - GL_EXT_texture_sRGB := Int_CheckExtension(Buffer, 'GL_EXT_texture_sRGB'); - GL_EXT_framebuffer_blit := Int_CheckExtension(Buffer, 'GL_EXT_framebuffer_blit'); - GL_EXT_framebuffer_multisample := Int_CheckExtension(Buffer, 'GL_EXT_framebuffer_multisample'); - GL_EXT_timer_query := Int_CheckExtension(Buffer, 'GL_EXT_timer_query'); - GL_EXT_gpu_program_parameters := Int_CheckExtension(Buffer, 'GL_EXT_gpu_program_parameters'); - GL_EXT_bindable_uniform := Int_CheckExtension(Buffer, 'GL_EXT_bindable_uniform'); - GL_EXT_draw_buffers2 := Int_CheckExtension(Buffer, 'GL_EXT_draw_buffers2'); - GL_EXT_draw_instanced := Int_CheckExtension(Buffer, 'GL_EXT_draw_instanced'); - GL_EXT_framebuffer_sRGB := Int_CheckExtension(Buffer, 'GL_EXT_framebuffer_sRGB'); - GL_EXT_geometry_shader4 := Int_CheckExtension(Buffer, 'GL_EXT_geometry_shader4'); - GL_EXT_gpu_shader4 := Int_CheckExtension(Buffer, 'GL_EXT_gpu_shader4'); - GL_EXT_packed_float := Int_CheckExtension(Buffer, 'GL_EXT_packed_float'); - GL_EXT_texture_array := Int_CheckExtension(Buffer, 'GL_EXT_texture_array'); - GL_EXT_texture_buffer_object := Int_CheckExtension(Buffer, 'GL_EXT_texture_buffer_object'); - GL_EXT_texture_compression_latc := Int_CheckExtension(Buffer, 'GL_EXT_texture_compression_latc'); - GL_EXT_texture_compression_rgtc := Int_CheckExtension(Buffer, 'GL_EXT_texture_compression_rgtc'); - GL_EXT_texture_integer := Int_CheckExtension(Buffer, 'GL_EXT_texture_integer'); - GL_EXT_texture_shared_exponent := Int_CheckExtension(Buffer, 'GL_EXT_texture_shared_exponent'); - GL_EXT_transform_feedback := Int_CheckExtension(Buffer, 'GL_EXT_transform_feedback'); - GL_EXT_direct_state_access := Int_CheckExtension(Buffer, 'GL_EXT_direct_state_access'); - GL_EXT_vertex_array_bgra := Int_CheckExtension(Buffer, 'GL_EXT_vertex_array_bgra'); - GL_EXT_texture_swizzle := Int_CheckExtension(Buffer, 'GL_EXT_texture_swizzle'); - GL_EXT_provoking_vertex := Int_CheckExtension(Buffer, 'GL_EXT_provoking_vertex'); - GL_EXT_texture_snorm := Int_CheckExtension(Buffer, 'GL_EXT_texture_snorm'); - GL_EXT_separate_shader_objects := Int_CheckExtension(Buffer, 'GL_EXT_separate_shader_objects'); - GL_EXT_shader_image_load_store := Int_CheckExtension(Buffer, 'GL_EXT_shader_image_load_store'); - GL_EXT_vertex_attrib_64bit := Int_CheckExtension(Buffer, 'GL_EXT_vertex_attrib_64bit'); - GL_EXT_texture_sRGB_decode := Int_CheckExtension(Buffer, 'GL_EXT_texture_sRGB_decode'); - - // === HP ====================================================================== - GL_HP_convolution_border_modes := Int_CheckExtension(Buffer, 'GL_HP_convolution_border_modes'); - GL_HP_image_transform := Int_CheckExtension(Buffer, 'GL_HP_image_transform'); - GL_HP_occlusion_test := Int_CheckExtension(Buffer, 'GL_HP_occlusion_test'); - GL_HP_texture_lighting := Int_CheckExtension(Buffer, 'GL_HP_texture_lighting'); - - // === IBM ===================================================================== - GL_IBM_cull_vertex := Int_CheckExtension(Buffer, 'GL_IBM_cull_vertex'); - GL_IBM_multimode_draw_arrays := Int_CheckExtension(Buffer, 'GL_IBM_multimode_draw_arrays'); - GL_IBM_rasterpos_clip := Int_CheckExtension(Buffer, 'GL_IBM_rasterpos_clip'); - GL_IBM_texture_mirrored_repeat := Int_CheckExtension(Buffer, 'GL_IBM_texture_mirrored_repeat'); - GL_IBM_vertex_array_lists := Int_CheckExtension(Buffer, 'GL_IBM_vertex_array_lists'); - - // === INGR ==================================================================== - GL_INGR_blend_func_separate := Int_CheckExtension(Buffer, 'GL_INGR_blend_func_separate'); - GL_INGR_color_clamp := Int_CheckExtension(Buffer, 'GL_INGR_color_clamp'); - GL_INGR_interlace_read := Int_CheckExtension(Buffer, 'GL_INGR_interlace_read'); - GL_INGR_palette_buffer := Int_CheckExtension(Buffer, 'GL_INGR_palette_buffer'); - - // === INTEL =================================================================== - GL_INTEL_parallel_arrays := Int_CheckExtension(Buffer, 'GL_INTEL_parallel_arrays'); - GL_INTEL_texture_scissor := Int_CheckExtension(Buffer, 'GL_INTEL_texture_scissor'); - - // === MESA ==================================================================== - GL_MESA_resize_buffers := Int_CheckExtension(Buffer, 'GL_MESA_resize_buffers'); - GL_MESA_window_pos := Int_CheckExtension(Buffer, 'GL_MESA_window_pos'); - - // === NVIDIA ================================================================== - GL_NV_blend_square := Int_CheckExtension(Buffer, 'GL_NV_blend_square'); - GL_NV_copy_depth_to_color := Int_CheckExtension(Buffer, 'GL_NV_copy_depth_to_color'); - GL_NV_depth_clamp := Int_CheckExtension(Buffer, 'GL_NV_depth_clamp'); - GL_NV_evaluators := Int_CheckExtension(Buffer, 'GL_NV_evaluators'); - GL_NV_fence := Int_CheckExtension(Buffer, 'GL_NV_fence'); - GL_NV_float_buffer := Int_CheckExtension(Buffer, 'GL_NV_float_buffer'); - GL_NV_fog_distance := Int_CheckExtension(Buffer, 'GL_NV_fog_distance'); - GL_NV_fragment_program := Int_CheckExtension(Buffer, 'GL_NV_fragment_program'); - GL_NV_half_float := Int_CheckExtension(Buffer, 'GL_NV_half_float'); - GL_NV_light_max_exponent := Int_CheckExtension(Buffer, 'GL_NV_light_max_exponent'); - GL_NV_multisample_filter_hint := Int_CheckExtension(Buffer, 'GL_NV_multisample_filter_hint'); - GL_NV_occlusion_query := Int_CheckExtension(Buffer, 'GL_NV_occlusion_query'); - GL_NV_packed_depth_stencil := Int_CheckExtension(Buffer, 'GL_NV_packed_depth_stencil'); - GL_NV_pixel_data_range := Int_CheckExtension(Buffer, 'GL_NV_pixel_data_range'); - GL_NV_point_sprite := Int_CheckExtension(Buffer, 'GL_NV_point_sprite'); - GL_NV_primitive_restart := Int_CheckExtension(Buffer, 'GL_NV_primitive_restart'); - GL_NV_register_combiners := Int_CheckExtension(Buffer, 'GL_NV_register_combiners'); - GL_NV_register_combiners2 := Int_CheckExtension(Buffer, 'GL_NV_register_combiners2'); - GL_NV_texgen_emboss := Int_CheckExtension(Buffer, 'GL_NV_texgen_emboss'); - GL_NV_texgen_reflection := Int_CheckExtension(Buffer, 'GL_NV_texgen_reflection'); - GL_NV_texture_compression_vtc := Int_CheckExtension(Buffer, 'GL_NV_texture_compression_vtc'); - GL_NV_texture_env_combine4 := Int_CheckExtension(Buffer, 'GL_NV_texture_env_combine4'); - GL_NV_texture_expand_normal := Int_CheckExtension(Buffer, 'GL_NV_texture_expand_normal'); - GL_NV_texture_rectangle := Int_CheckExtension(Buffer, 'GL_NV_texture_rectangle'); - GL_NV_texture_shader := Int_CheckExtension(Buffer, 'GL_NV_texture_shader'); - GL_NV_texture_shader2 := Int_CheckExtension(Buffer, 'GL_NV_texture_shader2'); - GL_NV_texture_shader3 := Int_CheckExtension(Buffer, 'GL_NV_texture_shader3'); - GL_NV_vertex_array_range := Int_CheckExtension(Buffer, 'GL_NV_vertex_array_range'); - GL_NV_vertex_array_range2 := Int_CheckExtension(Buffer, 'GL_NV_vertex_array_range2'); - GL_NV_vertex_program := Int_CheckExtension(Buffer, 'GL_NV_vertex_program'); - GL_NV_vertex_program1_1 := Int_CheckExtension(Buffer, 'GL_NV_vertex_program1_1'); - GL_NV_vertex_program2 := Int_CheckExtension(Buffer, 'GL_NV_vertex_program2'); - GL_NV_fragment_program_option := Int_CheckExtension(Buffer, 'GL_NV_fragment_program_option'); - GL_NV_fragment_program2 := Int_CheckExtension(Buffer, 'GL_NV_fragment_program2'); - GL_NV_vertex_program2_option := Int_CheckExtension(Buffer, 'GL_NV_vertex_program2_option'); - GL_NV_vertex_program3 := Int_CheckExtension(Buffer, 'GL_NV_vertex_program3'); - GL_NV_depth_buffer_float := Int_CheckExtension(Buffer, 'GL_NV_depth_buffer_float'); - GL_NV_fragment_program4 := Int_CheckExtension(Buffer, 'GL_NV_fragment_program4'); - GL_NV_framebuffer_multisample_coverage := Int_CheckExtension(Buffer, 'GL_NV_framebuffer_multisample_coverage'); - GL_NV_geometry_program4 := Int_CheckExtension(Buffer, 'GL_NV_geometry_program4'); - GL_NV_gpu_program4 := Int_CheckExtension(Buffer, 'GL_NV_gpu_program4'); - GL_NV_parameter_buffer_object := Int_CheckExtension(Buffer, 'GL_NV_parameter_buffer_object'); - GL_NV_transform_feedback := Int_CheckExtension(Buffer, 'GL_NV_transform_feedback'); - GL_NV_vertex_program4 := Int_CheckExtension(Buffer, 'GL_NV_vertex_program4'); - GL_NV_conditional_render := Int_CheckExtension(Buffer, 'GL_NV_conditional_render'); - GL_NV_present_video := Int_CheckExtension(Buffer, 'GL_NV_present_video'); - GL_NV_explicit_multisample := Int_CheckExtension(Buffer, 'GL_NV_explicit_multisample'); - GL_NV_transform_feedback2 := Int_CheckExtension(Buffer, 'GL_NV_transform_feedback2'); - GL_NV_video_capture := Int_CheckExtension(Buffer, 'GL_NV_video_capture'); - GL_NV_copy_image := Int_CheckExtension(Buffer, 'GL_NV_copy_image'); - GL_NV_parameter_buffer_object2 := Int_CheckExtension(Buffer, 'GL_NV_parameter_buffer_object2'); - GL_NV_shader_buffer_load := Int_CheckExtension(Buffer, 'GL_NV_shader_buffer_load'); - GL_NV_vertex_buffer_unified_memory := Int_CheckExtension(Buffer, 'GL_NV_vertex_buffer_unified_memory'); - GL_NV_gpu_program5 := Int_CheckExtension(Buffer, 'GL_NV_gpu_program5'); - GL_NV_gpu_shader5 := Int_CheckExtension(Buffer, 'GL_NV_gpu_shader5'); - GL_NV_shader_buffer_store := Int_CheckExtension(Buffer, 'GL_NV_shader_buffer_store'); - GL_NV_tessellation_program5 := Int_CheckExtension(Buffer, 'GL_NV_tessellation_program5'); - GL_NV_vertex_attrib_integer_64bit := Int_CheckExtension(Buffer, 'GL_NV_vertex_attrib_integer_64bit'); - GL_NV_multisample_coverage := Int_CheckExtension(Buffer, 'GL_NV_multisample_coverage'); - GL_NV_vdpau_interop := Int_CheckExtension(Buffer, 'GL_NV_vdpau_interop'); - GL_NV_texture_barrier := Int_CheckExtension(Buffer, 'GL_NV_texture_barrier'); - // 4.3 - GL_NV_path_rendering := Int_CheckExtension(Buffer, 'GL_NV_path_rendering'); - GL_NV_bindless_texture := Int_CheckExtension(Buffer, 'GL_NV_bindless_texture'); - GL_NV_shader_atomic_float := Int_CheckExtension(Buffer, 'GL_NV_shader_atomic_float'); - - // === OML ===================================================================== - GL_OML_interlace := Int_CheckExtension(Buffer, 'GL_OML_interlace'); - GL_OML_resample := Int_CheckExtension(Buffer, 'GL_OML_resample'); - GL_OML_subsample := Int_CheckExtension(Buffer, 'GL_OML_subsample'); - - // === PGI ===================================================================== - GL_PGI_misc_hints := Int_CheckExtension(Buffer, 'GL_PGI_misc_hints'); - GL_PGI_vertex_hints := Int_CheckExtension(Buffer, 'GL_PGI_vertex_hints'); - - // === REND ==================================================================== - GL_REND_screen_coordinates := Int_CheckExtension(Buffer, 'GL_REND_screen_coordinates'); - - // === S3 ====================================================================== - GL_S3_s3tc := Int_CheckExtension(Buffer, 'GL_S3_s3tc'); - - // === SGIS ==================================================================== - GL_SGIS_detail_texture := Int_CheckExtension(Buffer, 'GL_SGIS_detail_texture'); - GL_SGIS_fog_function := Int_CheckExtension(Buffer, 'GL_SGIS_fog_function'); - GL_SGIS_generate_mipmap := Int_CheckExtension(Buffer, 'GL_SGIS_generate_mipmap'); - GL_SGIS_multisample := Int_CheckExtension(Buffer, 'GL_SGIS_multisample'); - GL_SGIS_pixel_texture := Int_CheckExtension(Buffer, 'GL_SGIS_pixel_texture'); - GL_SGIS_point_line_texgen := Int_CheckExtension(Buffer, 'GL_SGIS_point_line_texgen'); - GL_SGIS_point_parameters := Int_CheckExtension(Buffer, 'GL_SGIS_point_parameters'); - GL_SGIS_sharpen_texture := Int_CheckExtension(Buffer, 'GL_SGIS_sharpen_texture'); - GL_SGIS_texture4D := Int_CheckExtension(Buffer, 'GL_SGIS_texture4D'); - GL_SGIS_texture_border_clamp := Int_CheckExtension(Buffer, 'GL_SGIS_texture_border_clamp'); - GL_SGIS_texture_color_mask := Int_CheckExtension(Buffer, 'GL_SGIS_texture_color_mask'); - GL_SGIS_texture_edge_clamp := Int_CheckExtension(Buffer, 'GL_SGIS_texture_edge_clamp'); - GL_SGIS_texture_filter4 := Int_CheckExtension(Buffer, 'GL_SGIS_texture_filter4'); - GL_SGIS_texture_lod := Int_CheckExtension(Buffer, 'GL_SGIS_texture_lod'); - GL_SGIS_texture_select := Int_CheckExtension(Buffer, 'GL_SGIS_texture_select'); - - // === SGIX ==================================================================== - GL_FfdMaskSGIX := Int_CheckExtension(Buffer, 'GL_FfdMaskSGIX'); - GL_SGIX_async := Int_CheckExtension(Buffer, 'GL_SGIX_async'); - GL_SGIX_async_histogram := Int_CheckExtension(Buffer, 'GL_SGIX_async_histogram'); - GL_SGIX_async_pixel := Int_CheckExtension(Buffer, 'GL_SGIX_async_pixel'); - GL_SGIX_blend_alpha_minmax := Int_CheckExtension(Buffer, 'GL_SGIX_blend_alpha_minmax'); - GL_SGIX_calligraphic_fragment := Int_CheckExtension(Buffer, 'GL_SGIX_calligraphic_fragment'); - GL_SGIX_clipmap := Int_CheckExtension(Buffer, 'GL_SGIX_clipmap'); - GL_SGIX_convolution_accuracy := Int_CheckExtension(Buffer, 'GL_SGIX_convolution_accuracy'); - GL_SGIX_depth_pass_instrument := Int_CheckExtension(Buffer, 'GL_SGIX_depth_pass_instrument'); - GL_SGIX_depth_texture := Int_CheckExtension(Buffer, 'GL_SGIX_depth_texture'); - GL_SGIX_flush_raster := Int_CheckExtension(Buffer, 'GL_SGIX_flush_raster'); - GL_SGIX_fog_offset := Int_CheckExtension(Buffer, 'GL_SGIX_fog_offset'); - GL_SGIX_fog_scale := Int_CheckExtension(Buffer, 'GL_SGIX_fog_scale'); - GL_SGIX_fragment_lighting := Int_CheckExtension(Buffer, 'GL_SGIX_fragment_lighting'); - GL_SGIX_framezoom := Int_CheckExtension(Buffer, 'GL_SGIX_framezoom'); - GL_SGIX_igloo_interface := Int_CheckExtension(Buffer, 'GL_SGIX_igloo_interface'); - GL_SGIX_impact_pixel_texture := Int_CheckExtension(Buffer, 'GL_SGIX_impact_pixel_texture'); - GL_SGIX_instruments := Int_CheckExtension(Buffer, 'GL_SGIX_instruments'); - GL_SGIX_interlace := Int_CheckExtension(Buffer, 'GL_SGIX_interlace'); - GL_SGIX_ir_instrument1 := Int_CheckExtension(Buffer, 'GL_SGIX_ir_instrument1'); - GL_SGIX_list_priority := Int_CheckExtension(Buffer, 'GL_SGIX_list_priority'); - GL_SGIX_pixel_texture := Int_CheckExtension(Buffer, 'GL_SGIX_pixel_texture'); - GL_SGIX_pixel_tiles := Int_CheckExtension(Buffer, 'GL_SGIX_pixel_tiles'); - GL_SGIX_polynomial_ffd := Int_CheckExtension(Buffer, 'GL_SGIX_polynomial_ffd'); - GL_SGIX_reference_plane := Int_CheckExtension(Buffer, 'GL_SGIX_reference_plane'); - GL_SGIX_resample := Int_CheckExtension(Buffer, 'GL_SGIX_resample'); - GL_SGIX_scalebias_hint := Int_CheckExtension(Buffer, 'GL_SGIX_scalebias_hint'); - GL_SGIX_shadow := Int_CheckExtension(Buffer, 'GL_SGIX_shadow'); - GL_SGIX_shadow_ambient := Int_CheckExtension(Buffer, 'GL_SGIX_shadow_ambient'); - GL_SGIX_sprite := Int_CheckExtension(Buffer, 'GL_SGIX_sprite'); - GL_SGIX_subsample := Int_CheckExtension(Buffer, 'GL_SGIX_subsample'); - GL_SGIX_tag_sample_buffer := Int_CheckExtension(Buffer, 'GL_SGIX_tag_sample_buffer'); - GL_SGIX_texture_add_env := Int_CheckExtension(Buffer, 'GL_SGIX_texture_add_env'); - GL_SGIX_texture_coordinate_clamp := Int_CheckExtension(Buffer, 'GL_SGIX_texture_coordinate_clamp'); - GL_SGIX_texture_lod_bias := Int_CheckExtension(Buffer, 'GL_SGIX_texture_lod_bias'); - GL_SGIX_texture_multi_buffer := Int_CheckExtension(Buffer, 'GL_SGIX_texture_multi_buffer'); - GL_SGIX_texture_scale_bias := Int_CheckExtension(Buffer, 'GL_SGIX_texture_scale_bias'); - GL_SGIX_texture_select := Int_CheckExtension(Buffer, 'GL_SGIX_texture_select'); - GL_SGIX_vertex_preclip := Int_CheckExtension(Buffer, 'GL_SGIX_vertex_preclip'); - GL_SGIX_ycrcb := Int_CheckExtension(Buffer, 'GL_SGIX_ycrcb'); - GL_SGIX_ycrcb_subsample := Int_CheckExtension(Buffer, 'GL_SGIX_ycrcb_subsample'); - GL_SGIX_ycrcba := Int_CheckExtension(Buffer, 'GL_SGIX_ycrcba'); - - // === SGI ===================================================================== - GL_SGI_color_matrix := Int_CheckExtension(Buffer, 'GL_SGI_color_matrix'); - GL_SGI_color_table := Int_CheckExtension(Buffer, 'GL_SGI_color_table'); - GL_SGI_depth_pass_instrument := Int_CheckExtension(Buffer, 'GL_SGI_depth_pass_instrument'); - GL_SGI_texture_color_table := Int_CheckExtension(Buffer, 'GL_SGI_texture_color_table'); - - // === SUN ===================================================================== - GL_SUNX_constant_data := Int_CheckExtension(Buffer, 'GL_SUNX_constant_data'); - GL_SUN_convolution_border_modes := Int_CheckExtension(Buffer, 'GL_SUN_convolution_border_modes'); - GL_SUN_global_alpha := Int_CheckExtension(Buffer, 'GL_SUN_global_alpha'); - GL_SUN_mesh_array := Int_CheckExtension(Buffer, 'GL_SUN_mesh_array'); - GL_SUN_slice_accum := Int_CheckExtension(Buffer, 'GL_SUN_slice_accum'); - GL_SUN_triangle_list := Int_CheckExtension(Buffer, 'GL_SUN_triangle_list'); - GL_SUN_vertex := Int_CheckExtension(Buffer, 'GL_SUN_vertex'); - - // === WIN ===================================================================== - GL_WIN_phong_shading := Int_CheckExtension(Buffer, 'GL_WIN_phong_shading'); - GL_WIN_specular_fog := Int_CheckExtension(Buffer, 'GL_WIN_specular_fog'); - - {$IFDEF DGL_WIN} - // === WGL ===================================================================== - WGL_3DFX_multisample := Int_CheckExtension(Buffer, 'WGL_3DFX_multisample'); - WGL_ARB_buffer_region := Int_CheckExtension(Buffer, 'WGL_ARB_buffer_region'); - WGL_ARB_extensions_string := Int_CheckExtension(Buffer, 'WGL_ARB_extensions_string'); - WGL_ARB_make_current_read := Int_CheckExtension(Buffer, 'WGL_ARB_make_current_read'); - WGL_ARB_multisample := Int_CheckExtension(Buffer, 'WGL_ARB_multisample'); - WGL_ARB_pbuffer := Int_CheckExtension(Buffer, 'WGL_ARB_pbuffer'); - WGL_ARB_pixel_format := Int_CheckExtension(Buffer, 'WGL_ARB_pixel_format'); - WGL_ARB_pixel_format_float := Int_CheckExtension(Buffer, 'WGL_ARB_pixel_format_float'); - WGL_ARB_render_texture := Int_CheckExtension(Buffer, 'WGL_ARB_render_texture'); - WGL_ARB_create_context := Int_CheckExtension(Buffer, 'WGL_ARB_create_context'); - WGL_ARB_create_context_profile := Int_CheckExtension(Buffer, 'WGL_ARB_create_context_profile'); - WGL_ARB_framebuffer_sRGB := Int_CheckExtension(Buffer, 'WGL_ARB_framebuffer_sRGB'); - WGL_ARB_create_context_robustness := Int_CheckExtension(Buffer, 'WGL_ARB_create_context_robustness'); - WGL_ATI_pixel_format_float := Int_CheckExtension(Buffer, 'WGL_ATI_pixel_format_float'); - WGL_AMD_gpu_association := Int_CheckExtension(Buffer, 'WGL_AMD_gpu_association'); - WGL_EXT_depth_float := Int_CheckExtension(Buffer, 'WGL_EXT_depth_float'); - WGL_EXT_display_color_table := Int_CheckExtension(Buffer, 'WGL_EXT_display_color_table'); - WGL_EXT_extensions_string := Int_CheckExtension(Buffer, 'WGL_EXT_extensions_string'); - WGL_EXT_make_current_read := Int_CheckExtension(Buffer, 'WGL_EXT_make_current_read'); - WGL_EXT_multisample := Int_CheckExtension(Buffer, 'WGL_EXT_multisample'); - WGL_EXT_pbuffer := Int_CheckExtension(Buffer, 'WGL_EXT_pbuffer'); - WGL_EXT_pixel_format := Int_CheckExtension(Buffer, 'WGL_EXT_pixel_format'); - WGL_EXT_swap_control := Int_CheckExtension(Buffer, 'WGL_EXT_swap_control'); - WGL_EXT_create_context_es2_profile := Int_CheckExtension(Buffer, 'WGL_EXT_create_context_es2_profile'); - WGL_I3D_digital_video_control := Int_CheckExtension(Buffer, 'WGL_I3D_digital_video_control'); - WGL_I3D_gamma := Int_CheckExtension(Buffer, 'WGL_I3D_gamma'); - WGL_I3D_genlock := Int_CheckExtension(Buffer, 'WGL_I3D_genlock'); - WGL_I3D_image_buffer := Int_CheckExtension(Buffer, 'WGL_I3D_image_buffer'); - WGL_I3D_swap_frame_lock := Int_CheckExtension(Buffer, 'WGL_I3D_swap_frame_lock'); - WGL_I3D_swap_frame_usage := Int_CheckExtension(Buffer, 'WGL_I3D_swap_frame_usage'); - WGL_NV_float_buffer := Int_CheckExtension(Buffer, 'WGL_NV_float_buffer'); - WGL_NV_render_depth_texture := Int_CheckExtension(Buffer, 'WGL_NV_render_depth_texture'); - WGL_NV_render_texture_rectangle := Int_CheckExtension(Buffer, 'WGL_NV_render_texture_rectangle'); - WGL_NV_vertex_array_range := Int_CheckExtension(Buffer, 'WGL_NV_vertex_array_range'); - WGL_NV_present_video := Int_CheckExtension(Buffer, 'WGL_NV_present_video'); - WGL_NV_video_output := Int_CheckExtension(Buffer, 'WGL_NV_video_output'); - WGL_NV_swap_group := Int_CheckExtension(Buffer, 'WGL_NV_swap_group'); - WGL_NV_gpu_affinity := Int_CheckExtension(Buffer, 'WGL_NV_gpu_affinity'); - WGL_NV_video_capture := Int_CheckExtension(Buffer, 'WGL_NV_video_capture'); - WGL_NV_copy_image := Int_CheckExtension(Buffer, 'WGL_NV_copy_image'); - WGL_NV_multisample_coverage := Int_CheckExtension(Buffer, 'WGL_NV_multisample_coverage'); - WGL_NV_DX_interop := Int_CheckExtension(Buffer, 'WGL_NV_multisample_coverage'); - WGL_OML_sync_control := Int_CheckExtension(Buffer, 'WGL_OML_sync_control'); - WGL_3DL_stereo_control := Int_CheckExtension(Buffer, 'WGL_3DL_stereo_control'); - - WIN_draw_range_elements := Int_CheckExtension(Buffer, 'WIN_draw_range_elements'); - WIN_swap_hint := Int_CheckExtension(Buffer, 'WIN_swap_hint'); - {$ENDIF} - - {$IFDEF DGL_LINUX} - // === GLX ===================================================================== - GLX_ARB_multisample := Int_CheckExtension(Buffer, 'GLX_ARB_multisample'); - GLX_ARB_fbconfig_float := Int_CheckExtension(Buffer, 'GLX_ARB_fbconfig_float'); - GLX_ARB_get_proc_address := Int_CheckExtension(Buffer, 'GLX_ARB_get_proc_address'); - GLX_ARB_create_context := Int_CheckExtension(Buffer, 'GLX_ARB_create_context'); - GLX_ARB_create_context_profile := Int_CheckExtension(Buffer, 'GLX_ARB_create_context_profile'); - GLX_ARB_vertex_buffer_object := Int_CheckExtension(Buffer, 'GLX_ARB_vertex_buffer_object'); - GLX_ARB_framebuffer_sRGB := Int_CheckExtension(Buffer, 'GLX_ARB_framebuffer_sRGB'); - GLX_ARB_create_context_robustness := Int_CheckExtension(Buffer, 'GLX_ARB_create_context_robustness'); - GLX_EXT_visual_info := Int_CheckExtension(Buffer, 'GLX_EXT_visual_info'); - GLX_EXT_visual_rating := Int_CheckExtension(Buffer, 'GLX_EXT_visual_rating'); - GLX_EXT_import_context := Int_CheckExtension(Buffer, 'GLX_EXT_import_context'); - GLX_EXT_fbconfig_packed_float := Int_CheckExtension(Buffer, 'GLX_EXT_fbconfig_packed_float'); - GLX_EXT_framebuffer_sRGB := Int_CheckExtension(Buffer, 'GLX_EXT_framebuffer_sRGB'); - GLX_EXT_texture_from_pixmap := Int_CheckExtension(Buffer, 'GLX_EXT_texture_from_pixmap'); - GLX_EXT_swap_control := Int_CheckExtension(Buffer, 'GLX_EXT_swap_control'); - GLX_EXT_create_context_es2_profile := Int_CheckExtension(Buffer, 'GLX_EXT_create_context_es2_profile'); - {$ENDIF} - ImplementationRead := True; -end; - -{$IFDEF DGL_WIN} -// ============================================================================= -// RaiseLastOSError -// ============================================================================= -// Needed for compatibility with older Delphiversions -// ============================================================================= - -procedure RaiseLastOSError; -begin -{$IFDEF FPC} - raise Exception.Create('RaiseLastOSError!'); // To-Do: find a better solution -{$ELSE} - {$IFDEF DELPHI6_AND_DOWN} // If Delphi 6 or later - SysUtils.RaiseLastWin32Error; - {$ELSE} - SysUtils.RaiseLastOSError; - {$ENDIF} -{$ENDIF} -end; - -// ============================================================================= -// CreateRenderingContext -// ============================================================================= - -function CreateRenderingContext(DC: HDC; Options: TRCOptions; ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers: Integer; Layer: Integer): HGLRC; -const - OBJ_MEMDC = 10; - OBJ_ENHMETADC = 12; - OBJ_METADC = 4; - PFD_DOUBLEBUFFER = $00000001; - PFD_STEREO = $00000002; - PFD_DRAW_TO_WINDOW = $00000004; - PFD_DRAW_TO_BITMAP = $00000008; - PFD_SUPPORT_GDI = $00000010; - PFD_SUPPORT_OPENGL = $00000020; - PFD_TYPE_RGBA = 0; - PFD_MAIN_PLANE = 0; - PFD_OVERLAY_PLANE = 1; - PFD_UNDERLAY_PLANE = LongWord(-1); - MemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC]; -var - PFDescriptor: TPixelFormatDescriptor; - PixelFormat: Integer; - AType: DWORD; -begin - if GL_LibHandle = nil then - InitOpenGL; - - FillChar(PFDescriptor, SizeOf(PFDescriptor), 0); - - with PFDescriptor do - begin - nSize := SizeOf(PFDescriptor); - nVersion := 1; - dwFlags := PFD_SUPPORT_OPENGL; - - AType := GetObjectType(DC); - - if AType = 0 then - RaiseLastOSError; - - if AType in MemoryDCs then - dwFlags := dwFlags or PFD_DRAW_TO_BITMAP - else - dwFlags := dwFlags or PFD_DRAW_TO_WINDOW; - - if opDoubleBuffered in Options then - dwFlags := dwFlags or PFD_DOUBLEBUFFER; - - if opGDI in Options then - dwFlags := dwFlags or PFD_SUPPORT_GDI; - - if opStereo in Options then - dwFlags := dwFlags or PFD_STEREO; - - iPixelType := PFD_TYPE_RGBA; - cColorBits := ColorBits; - cDepthBits := zBits; - cStencilBits := StencilBits; - cAccumBits := AccumBits; - cAuxBuffers := AuxBuffers; - - if Layer = 0 then - iLayerType := PFD_MAIN_PLANE - else - if Layer > 0 then - iLayerType := PFD_OVERLAY_PLANE - else - iLayerType := Byte(PFD_UNDERLAY_PLANE); - end; - - PixelFormat := ChoosePixelFormat(DC, @PFDescriptor); - - if PixelFormat = 0 then - RaiseLastOSError; - - if GetPixelFormat(DC) <> PixelFormat then - if not SetPixelFormat(DC, PixelFormat, @PFDescriptor) then - RaiseLastOSError; - - DescribePixelFormat(DC, PixelFormat, SizeOf(PFDescriptor), PFDescriptor); - - Result := wglCreateContext(DC); - - if Result = 0 then - RaiseLastOSError - else - LastPixelFormat := 0; -end; - -// ============================================================================= -// CreateRenderingContextVersion -// ============================================================================= -// Creates a context for the more recent OpenGL versions (3.0) and up -// For that we first need to get a normal GL context for getting the -// function pointer to wglCreateContextAttribsARB first -// ============================================================================= -function CreateRenderingContextVersion(DC: HDC; Options: TRCOptions; MajorVersion, MinorVersion : Integer; ForwardCompatible : Boolean; ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers: Integer; Layer: Integer): HGLRC; -const - OBJ_MEMDC = 10; - OBJ_ENHMETADC = 12; - OBJ_METADC = 4; - PFD_DOUBLEBUFFER = $00000001; - PFD_STEREO = $00000002; - PFD_DRAW_TO_WINDOW = $00000004; - PFD_DRAW_TO_BITMAP = $00000008; - PFD_SUPPORT_GDI = $00000010; - PFD_SUPPORT_OPENGL = $00000020; - PFD_TYPE_RGBA = 0; - PFD_MAIN_PLANE = 0; - PFD_OVERLAY_PLANE = 1; - PFD_UNDERLAY_PLANE = LongWord(-1); - MemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC]; -var - PFDescriptor : TPixelFormatDescriptor; - PixelFormat : Integer; - AType : DWORD; - LegacyRC : HGLRC; - Attribs : array of Integer; -begin - if GL_LibHandle = nil then - InitOpenGL; - - if not Assigned(GL_LibHandle) then - raise Exception.Create('GL_LibHandle is NIL. Could not load OpenGL library!'); - - FillChar(PFDescriptor, SizeOf(PFDescriptor), 0); - - with PFDescriptor do - begin - nSize := SizeOf(PFDescriptor); - nVersion := 1; - dwFlags := PFD_SUPPORT_OPENGL; - AType := GetObjectType(DC); - - if AType = 0 then - RaiseLastOSError; - - if AType in MemoryDCs then - dwFlags := dwFlags or PFD_DRAW_TO_BITMAP - else - dwFlags := dwFlags or PFD_DRAW_TO_WINDOW; - - if opDoubleBuffered in Options then - dwFlags := dwFlags or PFD_DOUBLEBUFFER; - - if opGDI in Options then - dwFlags := dwFlags or PFD_SUPPORT_GDI; - - if opStereo in Options then - dwFlags := dwFlags or PFD_STEREO; - - iPixelType := PFD_TYPE_RGBA; - cColorBits := ColorBits; - cDepthBits := zBits; - cStencilBits := StencilBits; - cAccumBits := AccumBits; - cAuxBuffers := AuxBuffers; - - if Layer = 0 then - iLayerType := PFD_MAIN_PLANE - else - if Layer > 0 then - iLayerType := PFD_OVERLAY_PLANE - else - iLayerType := Byte(PFD_UNDERLAY_PLANE); - end; - - PixelFormat := ChoosePixelFormat(DC, @PFDescriptor); - - if PixelFormat = 0 then - RaiseLastOSError; - - if GetPixelFormat(DC) <> PixelFormat then - if not SetPixelFormat(DC, PixelFormat, @PFDescriptor) then - RaiseLastOSError; - - DescribePixelFormat(DC, PixelFormat, SizeOf(PFDescriptor), PFDescriptor); - - // Create legacy render context first for we need function pointers to - // create new OpenGL render contexts - LegacyRC := wglCreateContext(DC); - wglMakeCurrent(DC, LegacyRC); - - // Set attributes to describe our requested context - SetLength(Attribs, 5); - Attribs[0] := WGL_CONTEXT_MAJOR_VERSION_ARB; - Attribs[1] := MajorVersion; - Attribs[2] := WGL_CONTEXT_MINOR_VERSION_ARB; - Attribs[3] := MinorVersion; - - // Add context flag for forward compatible context - // Forward compatible means no more support for legacy functions like - // immediate mode (glvertex, glrotate, gltranslate, etc.) - if ForwardCompatible then - begin - SetLength(Attribs, Length(Attribs)+2); - Attribs[4] := WGL_CONTEXT_FLAGS_ARB; - Attribs[5] := WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB; - end; - - // Attribute flags must be finalized with a zero - Attribs[High(Attribs)] := 0; - - // Get function pointer for new context creation function - wglCreateContextAttribsARB := wglGetProcAddress('wglCreateContextAttribsARB'); - - if not Assigned(wglCreateContextAttribsARB) then - begin - raise Exception.Create('Could not get function pointer adress for wglCreateContextAttribsARB - OpenGL 3.x and above not supported!'); - wglDeleteContext(LegacyRC); - exit; - end; - - // Create context - Result := wglCreateContextAttribsARB(DC, 0, @Attribs[0]); - - if Result = 0 then - begin - raise Exception.Create('Could not create the desired OpenGL rendering context!'); - wglDeleteContext(LegacyRC); - exit; - end; - - wglDeleteContext(LegacyRC); - - if Result = 0 then - RaiseLastOSError - else - LastPixelFormat := 0; -end; - -// ============================================================================= -// DestroyRenderingContext -// ============================================================================= - -procedure DestroyRenderingContext(RC: HGLRC); -begin - wglDeleteContext(RC); -end; - - -// ============================================================================= -// ActivateRenderingContext -// ============================================================================= - -procedure ActivateRenderingContext(DC: HDC; RC: HGLRC; loadext: boolean = true); -begin - Assert((DC <> 0), 'DC must not be 0'); - Assert((RC <> 0), 'RC must not be 0'); - - wglMakeCurrent(DC, RC); - - {$ifdef DGL_TINY_HEADER} - ReadCoreVersion; - {$else} - ReadImplementationProperties; - - if (loadext) then - ReadExtensions; - {$endif} -end; - -// ============================================================================= -// DeactivateRenderingContext -// ============================================================================= - -procedure DeactivateRenderingContext; -begin - wglMakeCurrent(0, 0); -end; -{$ENDIF} - - -initialization - -{$IFDEF CPU386} - Set8087CW($133F); -{$ENDIF} - -finalization - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/jedi-sdl.inc b/components/vampireimaging/Demos/ObjectPascal/Common/jedi-sdl.inc deleted file mode 100644 index de76d0f..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/jedi-sdl.inc +++ /dev/null @@ -1,416 +0,0 @@ -{ - $Id: jedi-sdl.inc,v 1.15 2007/05/29 21:30:48 savage Exp $ -} -{******************************************************************************} -{ } -{ Borland Delphi SDL - Simple DirectMedia Layer } -{ Global Conditional Definitions for JEDI-SDL cross-compilation } -{ } -{ } -{ The initial developer of this Pascal code was : } -{ Prof. Abimbola Olowofoyeku <http> } -{ } -{ Portions created by Prof. Abimbola Olowofoyeku are } -{ Copyright (C) 2000 - 2100 Prof. Abimbola Olowofoyeku. } -{ } -{ } -{ Contributor(s) } -{ -------------- } -{ Prof. Abimbola Olowofoyeku <http> } -{ Dominqiue Louis <Dominique> } -{ } -{ Obtained through: } -{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } -{ } -{ You may retrieve the latest version of this file at the Project } -{ JEDI home page, located at http://delphi-jedi.org } -{ } -{ The contents of this file are used with permission, subject to } -{ the Mozilla Public License Version 1.1 (the "License"); you may } -{ not use this file except in compliance with the License. You may } -{ obtain a copy of the License at } -{ http://www.mozilla.org/MPL/MPL-1.1.html } -{ } -{ Software distributed under the License is distributed on an } -{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } -{ implied. See the License for the specific language governing } -{ rights and limitations under the License. } -{ } -{ Description } -{ ----------- } -{ This code has been copied from... } -{ Global Conditional Definitions for Chief's UNZIP package } -{ By Prof. Abimbola Olowofoyeku (The African Chief) } -{ http://www.bigfoot.com/~African_Chief/ } -{ } -{ } -{ Requires } -{ -------- } -{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } -{ They are available from... } -{ http://www.libsdl.org . } -{ } -{ Programming Notes } -{ ----------------- } -{ } -{ } -{ } -{ } -{ Revision History } -{ ---------------- } -{ 2003-04-03 DL - Initial addition } -{ } -{ 2003-04-07 DL - Added Macro ON derective for FPC and OpenGL and removed } -{ WEAKPACKAGE derective. WEAKPACKAGE should be set when } -{ appropriate. } -{ } -{ 2003-04-23 - DL : under instruction from Alexey Barkovoy I have added } -{ better TMT Pascal support and under instruction } -{ from Prof. Abimbola Olowofoyeku (The African Chief) } -{ I have added better Gnu Pascal support } -{ } -{ 2004-01-19 - DL : Under instruction from Marco van de Voort, I have added } -{ Better FPC support for FreeBSD. } -{ } -(* - $Log: jedi-sdl.inc,v $ - Revision 1.15 2007/05/29 21:30:48 savage - Changes as suggested by Almindor for 64bit compatibility. - - Revision 1.14 2007/05/20 20:29:11 savage - Initial Changes to Handle 64 Bits - - Revision 1.13 2007/01/21 15:51:45 savage - Added Delphi 2006 support - - Revision 1.12 2006/11/19 18:41:01 savage - removed THREADING ON flag as it is no longer needed in latest versions of FPC. - - Revision 1.11 2006/01/04 00:52:41 drellis - Updated to include defined for ENDIAN values, SDL_BYTEORDER should now be correctly defined depending onthe platform. Code taken from sdl_mixer - - Revision 1.10 2005/05/22 18:42:31 savage - Changes as suggested by Michalis Kamburelis. Thanks again. - - Revision 1.9 2004/12/23 23:42:17 savage - Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability. - - Revision 1.8 2004/10/20 22:43:04 savage - Ensure that UNSAFE type warning are off in D9 as well - - Revision 1.7 2004/04/05 09:59:51 savage - Changes for FreePacal as suggested by Marco - - Revision 1.6 2004/03/31 22:18:15 savage - Small comment for turning off warning under GnuPascal - - Revision 1.5 2004/03/30 22:41:02 savage - Added extra commenting due to previous compiler directive - - Revision 1.4 2004/03/30 22:08:33 savage - Added Kylix Define - - Revision 1.3 2004/03/30 21:34:40 savage - {$H+} needed for FPC compatiblity - - Revision 1.2 2004/02/14 00:23:39 savage - As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. - -*) -{******************************************************************************} - -{.$define Debug} { uncomment for debugging } - -{$IFNDEF FPC} - {$IFDEF __GPC__} - {$I-} - {$W-} // turn off GPC warnings - {$X+} - {$ELSE} {__GPC__} - {$IFDEF Debug} - {$F+,D+,Q-,L+,R+,I-,S+,Y+,A+} - {$ELSE} - {$F+,Q-,R-,S-,I-,A+} - {$ENDIF} - {$ENDIF} {__GPC__} -{$ELSE} {FPC} - //{$M+} -{$ENDIF} {FPC} - -{$IFDEF LINUX} -{$DEFINE UNIX} -{$ENDIF} - - -{$IFDEF ver90} - {$DEFINE Delphi} {Delphi 2.x} - {$DEFINE Delphi32} - {$DEFINE WIN32} - {$DEFINE WINDOWS} -{$ENDIF ver90} - -{$IFDEF ver100} - {$DEFINE Delphi} {Delphi 3.x} - {$DEFINE Delphi32} - {$DEFINE WIN32} - {$DEFINE WINDOWS} -{$ENDIF ver100} - -{$IFDEF ver93} - {$DEFINE Delphi} {C++ Builder 1.x} - {$DEFINE Delphi32} - {$DEFINE WINDOWS} -{$ENDIF ver93} - -{$IFDEF ver110} - {$DEFINE Delphi} {C++ Builder 3.x} - {$DEFINE Delphi32} - {$DEFINE WINDOWS} -{$ENDIF ver110} - -{$IFDEF ver120} - {$DEFINE Delphi} {Delphi 4.x} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Has_Int64} - {$DEFINE WINDOWS} -{$ENDIF ver120} - -{$IFDEF ver130} - {$DEFINE Delphi} {Delphi 5.x} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Has_Int64} - {$DEFINE WINDOWS} -{$ENDIF ver130} - -{$IFDEF ver140} - {$DEFINE Delphi} {Delphi 6.x} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF ver140} - -{$IFDEF ver150} - {$DEFINE Delphi} {Delphi 7.x} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF ver150} - -{$IFDEF ver160} - {$DEFINE Delphi} {Delphi 8} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$DEFINE Delphi8UP} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF ver160} - -{$IFDEF ver170} - {$DEFINE Delphi} {Delphi 2005} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$DEFINE Delphi8UP} - {$DEFINE Delphi9UP} - {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF ver170} - -{$IFDEF ver180} - {$DEFINE Delphi} {Delphi 2006} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$DEFINE Delphi8UP} - {$DEFINE Delphi9UP} - {$DEFINE Delphi10UP} - {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF ver180} - -{$IFDEF ver185} - {$DEFINE Delphi} {Delphi 2007} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$DEFINE Delphi8UP} - {$DEFINE Delphi9UP} - {$DEFINE Delphi10UP} - {$DEFINE Delphi11UP} - {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF ver185} - -{$IFDEF ver200} - {$DEFINE Delphi} {Delphi 2009} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$DEFINE Delphi8UP} - {$DEFINE Delphi9UP} - {$DEFINE Delphi10UP} - {$DEFINE Delphi11UP} - {$DEFINE Delphi12UP} - {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF ver200} - -{$IFDEF VER210} // RAD Studio 2010 - {$DEFINE Delphi} {Delphi 2009} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$DEFINE Delphi8UP} - {$DEFINE Delphi9UP} - {$DEFINE Delphi10UP} - {$DEFINE Delphi11UP} - {$DEFINE Delphi12UP} - {$DEFINE BDS} - {$DEFINE BDS7} - {$DEFINE COMPILER14} - {$IFDEF BCB} - {$DEFINE BCB14} - {$ELSE} - {$DEFINE DELPHI14} - {$DEFINE DELPHI2010} // synonym to DELPHI14 - {$DEFINE DELPHICOMPILER14} - {$ENDIF BCB} - {$DEFINE RTL210_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF VER210} - -{$IFDEF VER230} // XE2 - {$DEFINE Delphi} - {$DEFINE Delphi32} - {$DEFINE Delphi4UP} - {$DEFINE Delphi5UP} - {$DEFINE Delphi6UP} - {$DEFINE Delphi7UP} - {$DEFINE Delphi8UP} - {$DEFINE Delphi9UP} - {$DEFINE Delphi10UP} - {$DEFINE Delphi11UP} - {$DEFINE Delphi12UP} - {$DEFINE BDS} - {$DEFINE BDS7} - {$DEFINE COMPILER14} - {$IFDEF BCB} - {$DEFINE BCB14} - {$ELSE} - {$DEFINE DELPHI14} - {$DEFINE DELPHI2010} // synonym to DELPHI14 - {$DEFINE DELPHICOMPILER14} - {$ENDIF BCB} - {$DEFINE RTL210_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} - {$DEFINE Has_Int64} - {$DEFINE HAS_TYPES} -{$ENDIF VER210} - -{$IFDEF Delphi} - {$DEFINE Windows} - {$DEFINE USE_STDCALL} - //{$ALIGN ON} -{$ENDIF Delphi} - -{$IFDEF FPC} - {$MODE Delphi} { use Delphi compatibility mode } - {$H+} - {$PACKRECORDS C} // Added for record - {$MACRO ON} // Added For OpenGL - {$DEFINE Delphi} - {$DEFINE UseAT} - {$UNDEF USE_STDCALL} - {$DEFINE OS_BigMem} - {$DEFINE NO_EXPORTS} - {$DEFINE Has_Int64} - {$DEFINE NOCRT} - {$IFDEF UNIX} - {$DEFINE fpc_unix} - {$ELSE} - {$DEFINE __OS_DOS__} - {$ENDIF} - {$IFDEF WIN32} - {$DEFINE UseWin} - {$ENDIF} - {$DEFINE HAS_TYPES} -{$ENDIF FPC} - -{$IFDEF Win32} - {$DEFINE OS_BigMem} -{$ELSE Win32} - {$IFDEF ver70} - {$DEFINE assembler} - {$ENDIF} { use 16-bit assembler! } -{$ENDIF Win32} - -{ ************************** dos/dos-like platforms **************} -{$IFDEF Windows} - {$DEFINE __OS_DOS__} - {$DEFINE UseWin} - {$DEFINE MSWINDOWS} -{$ENDIF Delphi} - -{$IFDEF OS2} - {$DEFINE __OS_DOS__} - {$DEFINE Can_Use_DLL} -{$ENDIF Delphi} - -{$IFDEF UseWin} - {$DEFINE Can_Use_DLL} -{$ENDIF} - -{$IFDEF USE_STDCALL} - {$IFNDEF __TMT__} - {$DEFINE BY_NAME} - {$ENDIF} -{$ENDIF} - -{$IFNDEF ver70} - {$UNDEF assembler} -{$ENDIF} - -{*************** define LITTLE ENDIAN platforms ********************} - - -{$IFDEF Delphi} -{$DEFINE IA32} -{$ENDIF} - -{$IFDEF FPC} -{$IFDEF FPC_LITTLE_ENDIAN} -{$DEFINE IA32} -{$ENDIF} -{$ENDIF} \ No newline at end of file diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/jedi.inc b/components/vampireimaging/Demos/ObjectPascal/Common/jedi.inc deleted file mode 100644 index b7e7c30..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/jedi.inc +++ /dev/null @@ -1,1716 +0,0 @@ -{$IFNDEF JEDI_INC} -{$DEFINE JEDI_INC} - -{**************************************************************************************************} -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is: jedi.inc. } -{ The Initial Developer of the Original Code is Project JEDI http://www.delphi-jedi.org } -{ } -{ Alternatively, the contents of this file may be used under the terms of the GNU Lesser General } -{ Public License (the "LGPL License"), in which case the provisions of the LGPL License are } -{ applicable instead of those above. If you wish to allow use of your version of this file only } -{ under the terms of the LGPL License and not to allow others to use your version of this file } -{ under the MPL, indicate your decision by deleting the provisions above and replace them with } -{ the notice and other provisions required by the LGPL License. If you do not delete the } -{ provisions above, a recipient may use your version of this file under either the MPL or the } -{ LGPL License. } -{ } -{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html } -{ } -{**************************************************************************************************} -{ } -{ This file defines various generic compiler directives used in different libraries, e.g. in the } -{ JEDI Code Library (JCL) and JEDI Visual Component Library Library (JVCL). The directives in } -{ this file are of generic nature and consist mostly of mappings from the VERXXX directives } -{ defined by Delphi, C++Builder and FPC to friendly names such as DELPHI5 and } -{ SUPPORTS_WIDESTRING. These friendly names are subsequently used in the libraries to test for } -{ compiler versions and/or whether the compiler supports certain features (such as widestrings or } -{ 64 bit integers. The libraries provide an additional, library specific, include file. For the } -{ JCL e.g. this is jcl.inc. These files should be included in source files instead of this file } -{ (which is pulled in automatically). } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -(* - -- Development environment directives - - This file defines two directives to indicate which development environment the - library is being compiled with. Currently this can either be Delphi, Kylix, - C++Builder or FPC. - - Directive Description - ------------------------------------------------------------------------------ - DELPHI Defined if compiled with Delphi - KYLIX Defined if compiled with Kylix - DELPHICOMPILER Defined if compiled with Delphi or Kylix/Delphi - BCB Defined if compiled with C++Builder - CPPBUILDER Defined if compiled with C++Builder (alias for BCB) - BCBCOMPILER Defined if compiled with C++Builder or Kylix/C++ - DELPHILANGUAGE Defined if compiled with Delphi, Kylix or C++Builder - BORLAND Defined if compiled with Delphi, Kylix or C++Builder - FPC Defined if compiled with FPC - -- Platform Directives - - Platform directives are not all explicitly defined in this file, some are - defined by the compiler itself. They are listed here only for completeness. - - Directive Description - ------------------------------------------------------------------------------ - WIN32 Defined when target platform is 32 bit Windows - WIN64 Defined when target platform is 64 bit Windows - MSWINDOWS Defined when target platform is 32 bit Windows - LINUX Defined when target platform is Linux - UNIX Defined when target platform is Unix-like (including Linux) - CLR Defined when target platform is .NET - -- Architecture directives. These are auto-defined by FPC - CPU32 and CPU64 are mostly for generic pointer size dependant differences rather - than for a specific architecture. - - CPU386 Defined when target platform is native x86 (win32) - CPUx86_64 Defined when target platform is native x86_64 (win64) - CPU32 Defined when target is 32-bit - CPU64 Defined when target is 64-bit - CPUASM Defined when target assembler is available - -- Visual library Directives - - The following directives indicate for a visual library. In a Delphi/BCB - (Win32) application you need to define the VisualCLX symbol in the project - options, if you want to use the VisualCLX library. Alternatively you can use - the IDE expert, which is distributed with the JCL to do this automatically. - - Directive Description - ------------------------------------------------------------------------------ - VCL Defined for Delphi/BCB (Win32) exactly if VisualCLX is not defined - VisualCLX Defined for Kylix; needs to be defined for Delphi/BCB to - use JCL with VisualCLX applications. - - -- Other cross-platform related defines - - These symbols are intended to help in writing portable code. - - Directive Description - ------------------------------------------------------------------------------ - PUREPASCAL Code is machine-independent (as opposed to assembler code) - Win32API Code is specific for the Win32 API; - use instead of "{$IFNDEF CLR} {$IFDEF MSWINDOWS}" constructs - - -- Delphi Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is Delphi (ie DELPHI is defined). - - Directive Description - ------------------------------------------------------------------------------ - DELPHI1 Defined when compiling with Delphi 1 (Codename WASABI/MANGO) - DELPHI2 Defined when compiling with Delphi 2 (Codename POLARIS) - DELPHI3 Defined when compiling with Delphi 3 (Codename IVORY) - DELPHI4 Defined when compiling with Delphi 4 (Codename ALLEGRO) - DELPHI5 Defined when compiling with Delphi 5 (Codename ARGUS) - DELPHI6 Defined when compiling with Delphi 6 (Codename ILLIAD) - DELPHI7 Defined when compiling with Delphi 7 (Codename AURORA) - DELPHI8 Defined when compiling with Delphi 8 (Codename OCTANE) - DELPHI2005 Defined when compiling with Delphi 2005 (Codename DIAMONDBACK) - DELPHI9 Alias for DELPHI2005 - DELPHI10 Defined when compiling with Delphi 2006 (Codename DEXTER) - DELPHI2006 Alias for DELPHI10 - DELPHI11 Defined when compiling with Delphi 2007 for Win32 (Codename SPACELY) - DELPHI2007 Alias for DELPHI11 - DELPHI12 Defined when compiling with Delphi 2009 for Win32 (Codename TIBURON) - DELPHI2009 Alias for DELPHI12 - DELPHI14 Defined when compiling with Delphi 2010 for Win32 (Codename WEAVER) - DELPHI2010 Alias for DELPHI14 - DELPHI15 Defined when compiling with Delphi XE for Win32 (Codename FULCRUM) - DELPHIXE Alias for DELPHI15 - DELPHI16 Defined when compiling with Delphi XE2 for Win32 (Codename PULSAR) - DELPHIXE2 Alias for DELPHI16 - DELPHI17 Defined when compiling with Delphi XE3 for Win32 (Codename WATERDRAGON) - DELPHIXE3 Alias for DELPHI17 - DELPHI18 Defined when compiling with Delphi XE4 for Win32 (Codename QUINTESSENCE) - DELPHIXE4 Alias for DELPHI18 - DELPHI19 Defined when compiling with Delphi XE5 for Win32 (Codename ZEPHYR) - DELPHIXE5 Alias for DELPHI19 - DELPHI20 Defined when compiling with Delphi XE6 for Win32 (Codename PROTEUS) - DELPHIXE6 Alias for DELPHI20 - DELPHI21 Defined when compiling with Delphi XE7 for Win32 (Codename CARPATHIA) - DELPHIXE7 Alias for DELPHI21 - DELPHI22 Defined when compiling with Delphi XE8 for Win32 (Codename ELBRUS) - DELPHIXE8 Alias for DELPHI22 - DELPHI23 Defined when compiling with Delphi 10 for Win32 (Codename AITANA) - DELPHIX_SEATTLE Alias for DELPHI23 - DELPHI1_UP Defined when compiling with Delphi 1 or higher - DELPHI2_UP Defined when compiling with Delphi 2 or higher - DELPHI3_UP Defined when compiling with Delphi 3 or higher - DELPHI4_UP Defined when compiling with Delphi 4 or higher - DELPHI5_UP Defined when compiling with Delphi 5 or higher - DELPHI6_UP Defined when compiling with Delphi 6 or higher - DELPHI7_UP Defined when compiling with Delphi 7 or higher - DELPHI8_UP Defined when compiling with Delphi 8 or higher - DELPHI2005_UP Defined when compiling with Delphi 2005 or higher - DELPHI9_UP Alias for DELPHI2005_UP - DELPHI10_UP Defined when compiling with Delphi 2006 or higher - DELPHI2006_UP Alias for DELPHI10_UP - DELPHI11_UP Defined when compiling with Delphi 2007 for Win32 or higher - DELPHI2007_UP Alias for DELPHI11_UP - DELPHI12_UP Defined when compiling with Delphi 2009 for Win32 or higher - DELPHI2009_UP Alias for DELPHI12_UP - DELPHI14_UP Defined when compiling with Delphi 2010 for Win32 or higher - DELPHI2010_UP Alias for DELPHI14_UP - DELPHI15_UP Defined when compiling with Delphi XE for Win32 or higher - DELPHIXE_UP Alias for DELPHI15_UP - DELPHI16_UP Defined when compiling with Delphi XE2 for Win32 or higher - DELPHIXE2_UP Alias for DELPHI16_UP - DELPHI17_UP Defined when compiling with Delphi XE3 for Win32 or higher - DELPHIXE3_UP Alias for DELPHI17_UP - DELPHI18_UP Defined when compiling with Delphi XE4 for Win32 or higher - DELPHIXE4_UP Alias for DELPHI18_UP - DELPHI19_UP Defined when compiling with Delphi XE5 for Win32 or higher - DELPHIXE5_UP Alias for DELPHI19_UP - DELPHI20_UP Defined when compiling with Delphi XE6 for Win32 or higher - DELPHIXE6_UP Alias for DELPHI20_UP - DELPHI21_UP Defined when compiling with Delphi XE7 for Win32 or higher - DELPHIXE7_UP Alias for DELPHI21_UP - DELPHI22_UP Defined when compiling with Delphi XE8 for Win32 or higher - DELPHIXE8_UP Alias for DELPHI22_UP - DELPHI23_UP Defined when compiling with Delphi 10 for Win32 or higher - DELPHIX_SEATTLE_UP Alias for DELPHI23_UP - - -- Kylix Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is Kylix (ie KYLIX is defined). - - Directive Description - ------------------------------------------------------------------------------ - KYLIX1 Defined when compiling with Kylix 1 - KYLIX2 Defined when compiling with Kylix 2 - KYLIX3 Defined when compiling with Kylix 3 (Codename CORTEZ) - KYLIX1_UP Defined when compiling with Kylix 1 or higher - KYLIX2_UP Defined when compiling with Kylix 2 or higher - KYLIX3_UP Defined when compiling with Kylix 3 or higher - - -- Delphi Compiler Versions (Delphi / Kylix, not in BCB mode) - - Directive Description - ------------------------------------------------------------------------------ - DELPHICOMPILER1 Defined when compiling with Delphi 1 - DELPHICOMPILER2 Defined when compiling with Delphi 2 - DELPHICOMPILER3 Defined when compiling with Delphi 3 - DELPHICOMPILER4 Defined when compiling with Delphi 4 - DELPHICOMPILER5 Defined when compiling with Delphi 5 - DELPHICOMPILER6 Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 - DELPHICOMPILER7 Defined when compiling with Delphi 7 - DELPHICOMPILER8 Defined when compiling with Delphi 8 - DELPHICOMPILER9 Defined when compiling with Delphi 2005 - DELPHICOMPILER10 Defined when compiling with Delphi Personality of BDS 4.0 - DELPHICOMPILER11 Defined when compiling with Delphi 2007 for Win32 - DELPHICOMPILER12 Defined when compiling with Delphi Personality of BDS 6.0 - DELPHICOMPILER14 Defined when compiling with Delphi Personality of BDS 7.0 - DELPHICOMPILER15 Defined when compiling with Delphi Personality of BDS 8.0 - DELPHICOMPILER16 Defined when compiling with Delphi Personality of BDS 9.0 - DELPHICOMPILER17 Defined when compiling with Delphi Personality of BDS 10.0 - DELPHICOMPILER18 Defined when compiling with Delphi Personality of BDS 11.0 - DELPHICOMPILER19 Defined when compiling with Delphi Personality of BDS 12.0 - DELPHICOMPILER20 Defined when compiling with Delphi Personality of BDS 14.0 - DELPHICOMPILER21 Defined when compiling with Delphi Personality of BDS 15.0 - DELPHICOMPILER22 Defined when compiling with Delphi Personality of BDS 16.0 - DELPHICOMPILER23 Defined when compiling with Delphi Personality of BDS 17.0 - DELPHICOMPILER1_UP Defined when compiling with Delphi 1 or higher - DELPHICOMPILER2_UP Defined when compiling with Delphi 2 or higher - DELPHICOMPILER3_UP Defined when compiling with Delphi 3 or higher - DELPHICOMPILER4_UP Defined when compiling with Delphi 4 or higher - DELPHICOMPILER5_UP Defined when compiling with Delphi 5 or higher - DELPHICOMPILER6_UP Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 or higher - DELPHICOMPILER7_UP Defined when compiling with Delphi 7 or higher - DELPHICOMPILER8_UP Defined when compiling with Delphi 8 or higher - DELPHICOMPILER9_UP Defined when compiling with Delphi 2005 - DELPHICOMPILER10_UP Defined when compiling with Delphi 2006 or higher - DELPHICOMPILER11_UP Defined when compiling with Delphi 2007 for Win32 or higher - DELPHICOMPILER12_UP Defined when compiling with Delphi 2009 for Win32 or higher - DELPHICOMPILER14_UP Defined when compiling with Delphi 2010 for Win32 or higher - DELPHICOMPILER15_UP Defined when compiling with Delphi XE for Win32 or higher - DELPHICOMPILER16_UP Defined when compiling with Delphi XE2 for Win32 or higher - DELPHICOMPILER17_UP Defined when compiling with Delphi XE3 for Win32 or higher - DELPHICOMPILER18_UP Defined when compiling with Delphi XE4 for Win32 or higher - DELPHICOMPILER19_UP Defined when compiling with Delphi XE5 for Win32 or higher - DELPHICOMPILER20_UP Defined when compiling with Delphi XE6 for Win32 or higher - DELPHICOMPILER21_UP Defined when compiling with Delphi XE7 for Win32 or higher - DELPHICOMPILER22_UP Defined when compiling with Delphi XE8 for Win32 or higher - DELPHICOMPILER23_UP Defined when compiling with Delphi 10 for Win32 or higher - - -- C++Builder Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is C++Builder (ie BCB is defined). - - Directive Description - ------------------------------------------------------------------------------ - BCB1 Defined when compiling with C++Builder 1 - BCB3 Defined when compiling with C++Builder 3 - BCB4 Defined when compiling with C++Builder 4 - BCB5 Defined when compiling with C++Builder 5 (Codename RAMPAGE) - BCB6 Defined when compiling with C++Builder 6 (Codename RIPTIDE) - BCB10 Defined when compiling with C++Builder Personality of BDS 4.0 (also known as C++Builder 2006) (Codename DEXTER) - BCB11 Defined when compiling with C++Builder Personality of RAD Studio 2007 (also known as C++Builder 2007) (Codename COGSWELL) - BCB12 Defined when compiling with C++Builder Personality of RAD Studio 2009 (also known as C++Builder 2009) (Codename TIBURON) - BCB14 Defined when compiling with C++Builder Personality of RAD Studio 2010 (also known as C++Builder 2010) (Codename WEAVER) - BCB15 Defined when compiling with C++Builder Personality of RAD Studio XE (also known as C++Builder XE) (Codename FULCRUM) - BCB16 Defined when compiling with C++Builder Personality of RAD Studio XE2 (also known as C++Builder XE2) (Codename PULSAR) - BCB17 Defined when compiling with C++Builder Personality of RAD Studio XE3 (also known as C++Builder XE3) (Codename WATERDRAGON) - BCB18 Defined when compiling with C++Builder Personality of RAD Studio XE4 (also known as C++Builder XE4) (Codename QUINTESSENCE) - BCB19 Defined when compiling with C++Builder Personality of RAD Studio XE5 (also known as C++Builder XE5) (Codename ZEPHYR) - BCB20 Defined when compiling with C++Builder Personality of RAD Studio XE6 (also known as C++Builder XE6) (Codename PROTEUS) - BCB21 Defined when compiling with C++Builder Personality of RAD Studio XE7 (also known as C++Builder XE7) (Codename CARPATHIA) - BCB22 Defined when compiling with C++Builder Personality of RAD Studio XE8 (also known as C++Builder XE8) (Codename ELBRUS) - BCB23 Defined when compiling with C++Builder Personality of RAD Studio 10 Seattle (also known as C++Builder 10 Seattle) (Codename AITANA) - BCB1_UP Defined when compiling with C++Builder 1 or higher - BCB3_UP Defined when compiling with C++Builder 3 or higher - BCB4_UP Defined when compiling with C++Builder 4 or higher - BCB5_UP Defined when compiling with C++Builder 5 or higher - BCB6_UP Defined when compiling with C++Builder 6 or higher - BCB10_UP Defined when compiling with C++Builder Personality of BDS 4.0 or higher - BCB11_UP Defined when compiling with C++Builder Personality of RAD Studio 2007 or higher - BCB12_UP Defined when compiling with C++Builder Personality of RAD Studio 2009 or higher - BCB14_UP Defined when compiling with C++Builder Personality of RAD Studio 2010 or higher - BCB15_UP Defined when compiling with C++Builder Personality of RAD Studio XE or higher - BCB16_UP Defined when compiling with C++Builder Personality of RAD Studio XE2 or higher - BCB17_UP Defined when compiling with C++Builder Personality of RAD Studio XE3 or higher - BCB18_UP Defined when compiling with C++Builder Personality of RAD Studio XE4 or higher - BCB19_UP Defined when compiling with C++Builder Personality of RAD Studio XE5 or higher - BCB20_UP Defined when compiling with C++Builder Personality of RAD Studio XE6 or higher - BCB21_UP Defined when compiling with C++Builder Personality of RAD Studio XE7 or higher - BCB22_UP Defined when compiling with C++Builder Personality of RAD Studio XE8 or higher - BCB23_UP Defined when compiling with C++Builder Personality of RAD Studio 10 or higher - - -- RAD Studio / Borland Developer Studio Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated IDE. These directives are only defined if - the IDE is Borland Developer Studio Version 2 or above. - - Note: Borland Developer Studio 2006 is marketed as Delphi 2006 or C++Builder 2006, - but those provide only different labels for identical content. - - Directive Description - ------------------------------------------------------------------------------ - BDS Defined when compiling with BDS version of dcc32.exe (Codename SIDEWINDER) - BDS2 Defined when compiling with BDS 2.0 (Delphi 8) (Codename OCTANE) - BDS3 Defined when compiling with BDS 3.0 (Delphi 2005) (Codename DIAMONDBACK) - BDS4 Defined when compiling with BDS 4.0 (Borland Developer Studio 2006) (Codename DEXTER) - BDS5 Defined when compiling with BDS 5.0 (CodeGear RAD Studio 2007) (Codename HIGHLANDER) - BDS6 Defined when compiling with BDS 6.0 (CodeGear RAD Studio 2009) (Codename TIBURON) - BDS7 Defined when compiling with BDS 7.0 (Embarcadero RAD Studio 2010) (Codename WEAVER) - BDS8 Defined when compiling with BDS 8.0 (Embarcadero RAD Studio XE) (Codename FULCRUM) - BDS9 Defined when compiling with BDS 9.0 (Embarcadero RAD Studio XE2) (Codename PULSAR) - BDS10 Defined when compiling with BDS 10.0 (Embarcadero RAD Studio XE3) (Codename WATERDRAGON) - BDS11 Defined when compiling with BDS 11.0 (Embarcadero RAD Studio XE4) (Codename QUINTESSENCE) - BDS12 Defined when compiling with BDS 12.0 (Embarcadero RAD Studio XE5) (Codename ZEPHYR) - BDS14 Defined when compiling with BDS 14.0 (Embarcadero RAD Studio XE6) (Codename PROTEUS) - BDS15 Defined when compiling with BDS 15.0 (Embarcadero RAD Studio XE7) (Codename CARPATHIA) - BDS16 Defined when compiling with BDS 16.0 (Embarcadero RAD Studio XE8) (Codename ELBRUS) - BDS17 Defined when compiling with BDS 17.0 (Embarcadero RAD Studio 10) (Codename AITANA) - BDS2_UP Defined when compiling with BDS 2.0 or higher - BDS3_UP Defined when compiling with BDS 3.0 or higher - BDS4_UP Defined when compiling with BDS 4.0 or higher - BDS5_UP Defined when compiling with BDS 5.0 or higher - BDS6_UP Defined when compiling with BDS 6.0 or higher - BDS7_UP Defined when compiling with BDS 7.0 or higher - BDS8_UP Defined when compiling with BDS 8.0 or higher - BDS9_UP Defined when compiling with BDS 9.0 or higher - BDS10_UP Defined when compiling with BDS 10.0 or higher - BDS11_UP Defined when compiling with BDS 11.0 or higher - BDS12_UP Defined when compiling with BDS 12.0 or higher - BDS14_UP Defined when compiling with BDS 14.0 or higher - BDS15_UP Defined when compiling with BDS 15.0 or higher - BDS16_UP Defined when compiling with BDS 16.0 or higher - BDS17_UP Defined when compiling with BDS 17.0 or higher - -- Compiler Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. Unlike the DELPHI_X and BCB_X - directives, these directives are indepedent of the development environment. - That is, they are defined regardless of whether compilation takes place using - Delphi or C++Builder. - - Directive Description - ------------------------------------------------------------------------------ - COMPILER1 Defined when compiling with Delphi 1 - COMPILER2 Defined when compiling with Delphi 2 or C++Builder 1 - COMPILER3 Defined when compiling with Delphi 3 - COMPILER35 Defined when compiling with C++Builder 3 - COMPILER4 Defined when compiling with Delphi 4 or C++Builder 4 - COMPILER5 Defined when compiling with Delphi 5 or C++Builder 5 - COMPILER6 Defined when compiling with Delphi 6 or C++Builder 6 - COMPILER7 Defined when compiling with Delphi 7 - COMPILER8 Defined when compiling with Delphi 8 - COMPILER9 Defined when compiling with Delphi 9 - COMPILER10 Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 - COMPILER11 Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 - COMPILER12 Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 - COMPILER14 Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 - COMPILER15 Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 - COMPILER16 Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 - COMPILER17 Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 - COMPILER18 Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 - COMPILER19 Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 - COMPILER20 Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 - COMPILER21 Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 - COMPILER22 Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 - COMPILER23 Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 - COMPILER1_UP Defined when compiling with Delphi 1 or higher - COMPILER2_UP Defined when compiling with Delphi 2 or C++Builder 1 or higher - COMPILER3_UP Defined when compiling with Delphi 3 or higher - COMPILER35_UP Defined when compiling with C++Builder 3 or higher - COMPILER4_UP Defined when compiling with Delphi 4 or C++Builder 4 or higher - COMPILER5_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher - COMPILER6_UP Defined when compiling with Delphi 6 or C++Builder 6 or higher - COMPILER7_UP Defined when compiling with Delphi 7 - COMPILER8_UP Defined when compiling with Delphi 8 - COMPILER9_UP Defined when compiling with Delphi Personalities of BDS 3.0 - COMPILER10_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher - COMPILER11_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher - COMPILER12_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher - COMPILER14_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher - COMPILER15_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher - COMPILER16_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher - COMPILER17_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher - COMPILER18_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher - COMPILER19_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher - COMPILER20_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher - COMPILER21_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher - COMPILER22_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher - COMPILER23_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher - - -- RTL Versions - - Use e.g. following to determine the exact RTL version since version 14.0: - {$IFDEF CONDITIONALEXPRESSIONS} - {$IF Declared(RTLVersion) and (RTLVersion >= 14.2)} - // code for Delphi 6.02 or higher, Kylix 2 or higher, C++Builder 6 or higher - ... - {$IFEND} - {$ENDIF} - - Directive Description - ------------------------------------------------------------------------------ - RTL80_UP Defined when compiling with Delphi 1 or higher - RTL90_UP Defined when compiling with Delphi 2 or higher - RTL93_UP Defined when compiling with C++Builder 1 or higher - RTL100_UP Defined when compiling with Delphi 3 or higher - RTL110_UP Defined when compiling with C++Builder 3 or higher - RTL120_UP Defined when compiling with Delphi 4 or higher - RTL125_UP Defined when compiling with C++Builder 4 or higher - RTL130_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher - RTL140_UP Defined when compiling with Delphi 6, Kylix 1, 2 or 3 or C++Builder 6 or higher - RTL150_UP Defined when compiling with Delphi 7 or higher - RTL160_UP Defined when compiling with Delphi 8 or higher - RTL170_UP Defined when compiling with Delphi Personalities of BDS 3.0 or higher - RTL180_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher - RTL185_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher - RTL190_UP Defined when compiling with Delphi.NET of BDS 5.0 or higher - RTL200_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher - RTL210_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher - RTL220_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher - RTL230_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher - RTL240_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher - RTL250_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher - RTL260_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher - RTL270_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher - RTL280_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher - RTL290_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher - RTL300_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher - - -- CLR Versions - - Directive Description - ------------------------------------------------------------------------------ - CLR Defined when compiling for .NET - CLR10 Defined when compiling for .NET 1.0 (may be overriden by FORCE_CLR10) - CLR10_UP Defined when compiling for .NET 1.0 or higher - CLR11 Defined when compiling for .NET 1.1 (may be overriden by FORCE_CLR11) - CLR11_UP Defined when compiling for .NET 1.1 or higher - CLR20 Defined when compiling for .NET 2.0 (may be overriden by FORCE_CLR20) - CLR20_UP Defined when compiling for .NET 2.0 or higher - - -- Feature Directives - - The features directives are used to test if the compiler supports specific - features, such as method overloading, and adjust the sources accordingly. Use - of these directives is preferred over the use of the DELPHI and COMPILER - directives. - - Directive Description - ------------------------------------------------------------------------------ - SUPPORTS_CONSTPARAMS Compiler supports const parameters (D1+) - SUPPORTS_SINGLE Compiler supports the Single type (D1+) - SUPPORTS_DOUBLE Compiler supports the Double type (D1+) - SUPPORTS_EXTENDED Compiler supports the Extended type (D1+) - SUPPORTS_CURRENCY Compiler supports the Currency type (D2+) - SUPPORTS_THREADVAR Compiler supports threadvar declarations (D2+) - SUPPORTS_OUTPARAMS Compiler supports out parameters (D3+) - SUPPORTS_VARIANT Compiler supports variant (D2+) - SUPPORTS_WIDECHAR Compiler supports the WideChar type (D2+) - SUPPORTS_WIDESTRING Compiler supports the WideString type (D3+/BCB3+) - SUPPORTS_INTERFACE Compiler supports interfaces (D3+/BCB3+) - SUPPORTS_DISPINTERFACE Compiler supports dispatch interfaces (D3+/BCB3+) - SUPPORTS_DISPID Compiler supports dispatch ids (D3+/BCB3+/FPC) - SUPPORTS_EXTSYM Compiler supports the $EXTERNALSYM directive (D4+/BCB3+) - SUPPORTS_NODEFINE Compiler supports the $NODEFINE directive (D4+/BCB3+) - SUPPORTS_LONGWORD Compiler supports the LongWord type (unsigned 32 bit) (D4+/BCB4+) - SUPPORTS_INT64 Compiler supports the Int64 type (D4+/BCB4+) - SUPPORTS_UINT64 Compiler supports the UInt64 type (D7+) - SUPPORTS_DYNAMICARRAYS Compiler supports dynamic arrays (D4+/BCB4+) - SUPPORTS_DEFAULTPARAMS Compiler supports default parameters (D4+/BCB4+) - SUPPORTS_OVERLOAD Compiler supports overloading (D4+/BCB4+) - SUPPORTS_IMPLEMENTS Compiler supports implements (D4+/BCB4+) - SUPPORTS_DEPRECATED Compiler supports the deprecated directive (D6+/BCB6+) - SUPPORTS_PLATFORM Compiler supports the platform directive (D6+/BCB6+) - SUPPORTS_LIBRARY Compiler supports the library directive (D6+/BCB6+/FPC) - SUPPORTS_LOCAL Compiler supports the local directive (D6+/BCB6+) - SUPPORTS_SETPEFLAGS Compiler supports the SetPEFlags directive (D6+/BCB6+) - SUPPORTS_EXPERIMENTAL_WARNINGS Compiler supports the WARN SYMBOL_EXPERIMENTAL and WARN UNIT_EXPERIMENTAL directives (D6+/BCB6+) - SUPPORTS_INLINE Compiler supports the inline directive (D9+/FPC) - SUPPORTS_FOR_IN Compiler supports for in loops (D9+) - SUPPORTS_NESTED_CONSTANTS Compiler supports nested constants (D9+) - SUPPORTS_NESTED_TYPES Compiler supports nested types (D9+) - SUPPORTS_REGION Compiler supports the REGION and ENDREGION directives (D9+) - SUPPORTS_ENHANCED_RECORDS Compiler supports class [operator|function|procedure] for record types (D9.NET, D10+) - SUPPORTS_CLASS_FIELDS Compiler supports class fields (D9.NET, D10+) - SUPPORTS_CLASS_HELPERS Compiler supports class helpers (D9.NET, D10+) - SUPPORTS_CLASS_OPERATORS Compiler supports class operators (D9.NET, D10+) - SUPPORTS_CLASS_CTORDTORS Compiler supports class contructors/destructors (D14+) - SUPPORTS_STRICT Compiler supports strict keyword (D9.NET, D10+) - SUPPORTS_STATIC Compiler supports static keyword (D9.NET, D10+) - SUPPORTS_FINAL Compiler supports final keyword (D9.NET, D10+) - SUPPORTS_METHODINFO Compiler supports the METHODINFO directives (D10+) - SUPPORTS_GENERICS Compiler supports generic implementations (D11.NET, D12+) - SUPPORTS_DEPRECATED_DETAILS Compiler supports additional text for the deprecated directive (D11.NET, D12+) - ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC) - ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+/FPC) - ACCEPT_LIBRARY Compiler supports or ignores the library directive (D6+/BCB6+) - SUPPORTS_CUSTOMVARIANTS Compiler supports custom variants (D6+/BCB6+) - SUPPORTS_VARARGS Compiler supports varargs (D6+/BCB6+) - SUPPORTS_ENUMVALUE Compiler supports assigning ordinalities to values of enums (D6+/BCB6+) - SUPPORTS_DEPRECATED_WARNINGS Compiler supports deprecated warnings (D6+/BCB6+) - SUPPORTS_LIBRARY_WARNINGS Compiler supports library warnings (D6+/BCB6+) - SUPPORTS_PLATFORM_WARNINGS Compiler supports platform warnings (D6+/BCB6+) - SUPPORTS_UNSAFE_WARNINGS Compiler supports unsafe warnings (D7) - SUPPORTS_WEAKPACKAGEUNIT Compiler supports the WEAKPACKAGEUNIT directive - SUPPORTS_COMPILETIME_MESSAGES Compiler supports the MESSAGE directive - SUPPORTS_PACKAGES Compiler supports Packages - HAS_UNIT_LIBC Unit Libc exists (Kylix, FPC on Linux/x86) - HAS_UNIT_RTLCONSTS Unit RTLConsts exists (D6+/BCB6+/FPC) - HAS_UNIT_TYPES Unit Types exists (D6+/BCB6+/FPC) - HAS_UNIT_VARIANTS Unit Variants exists (D6+/BCB6+/FPC) - HAS_UNIT_STRUTILS Unit StrUtils exists (D6+/BCB6+/FPC) - HAS_UNIT_DATEUTILS Unit DateUtils exists (D6+/BCB6+/FPC) - HAS_UNIT_CONTNRS Unit contnrs exists (D6+/BCB6+/FPC) - HAS_UNIT_HTTPPROD Unit HTTPProd exists (D9+) - HAS_UNIT_GIFIMG Unit GifImg exists (D11+) - HAS_UNIT_ANSISTRINGS Unit AnsiStrings exists (D12+) - HAS_UNIT_PNGIMAGE Unit PngImage exists (D12+) - HAS_UNIT_CHARACTER Unit Character exists (D12+) - XPLATFORM_RTL The RTL supports crossplatform function names (e.g. RaiseLastOSError) (D6+/BCB6+/FPC) - SUPPORTS_UNICODE string type is aliased to an unicode string (WideString or UnicodeString) (DX.NET, D12+) - SUPPORTS_UNICODE_STRING Compiler supports UnicodeString (D12+) - SUPPORTS_INT_ALIASES Types Int8, Int16, Int32, UInt8, UInt16 and UInt32 are defined in the unit System (D12+) - HAS_UNIT_RTTI Unit RTTI is available (D14+) - SUPPORTS_CAST_INTERFACE_TO_OBJ The compiler supports casts from interfaces to objects (D14+) - SUPPORTS_DELAYED_LOADING The compiler generates stubs for delaying imported function loads (D14+) - HAS_UNIT_REGULAREXPRESSIONSAPI Unit RegularExpressionsAPI is available (D15+) - HAS_UNIT_SYSTEM_UITYPES Unit System.UITypes is available (D16+) - HAS_UNIT_SYSTEM_ACTIONS Unit System.Actions is available (D17+) - DEPRECATED_SYSUTILS_ANSISTRINGS AnsiString functions from SysUtils are deprecated and moved to System.AnsiStrings (D18+) - HAS_PROPERTY_STYLEELEMENTS TControl has a StyleElements property (D17+) - HAS_AUTOMATIC_DB_FIELDS Database fields are automatically created/refreshed (D20+) - HAS_EARGUMENTEXCEPTION Exception class EArgumentException is available (D14+) - HAS_ENOTIMPLEMENTED Exception class ENotImplemented is available (D15+) - HAS_UNIT_VCL_THEMES Unit Vcl.Themes is available (D16+) - HAS_UNIT_UXTHEME Unit (Vcl.)UxTheme is available (D7+) - HAS_EXCEPTION_STACKTRACE Exception class has the StackTrace propery (D12+) - - -- Compiler Settings - - The compiler settings directives indicate whether a specific compiler setting - is in effect. This facilitates changing compiler settings locally in a more - compact and readible manner. - - Directive Description - ------------------------------------------------------------------------------ - ALIGN_ON Compiling in the A+ state (no alignment) - BOOLEVAL_ON Compiling in the B+ state (complete boolean evaluation) - ASSERTIONS_ON Compiling in the C+ state (assertions on) - DEBUGINFO_ON Compiling in the D+ state (debug info generation on) - IMPORTEDDATA_ON Compiling in the G+ state (creation of imported data references) - LONGSTRINGS_ON Compiling in the H+ state (string defined as AnsiString) - IOCHECKS_ON Compiling in the I+ state (I/O checking enabled) - WRITEABLECONST_ON Compiling in the J+ state (typed constants can be modified) - LOCALSYMBOLS Compiling in the L+ state (local symbol generation) - LOCALSYMBOLS_ON Alias of LOCALSYMBOLS - TYPEINFO_ON Compiling in the M+ state (RTTI generation on) - OPTIMIZATION_ON Compiling in the O+ state (code optimization on) - OPENSTRINGS_ON Compiling in the P+ state (variable string parameters are openstrings) - OVERFLOWCHECKS_ON Compiling in the Q+ state (overflow checing on) - RANGECHECKS_ON Compiling in the R+ state (range checking on) - TYPEDADDRESS_ON Compiling in the T+ state (pointers obtained using the @ operator are typed) - SAFEDIVIDE_ON Compiling in the U+ state (save FDIV instruction through RTL emulation) - VARSTRINGCHECKS_ON Compiling in the V+ state (type checking of shortstrings) - STACKFRAMES_ON Compiling in the W+ state (generation of stack frames) - EXTENDEDSYNTAX_ON Compiling in the X+ state (Delphi extended syntax enabled) -*) - -{$DEFINE BORLAND} - -{ Set FreePascal to Delphi mode } -{$IFDEF FPC} - {$MODE DELPHI} - {$ASMMODE Intel} - {$UNDEF BORLAND} - {$DEFINE CPUASM} - // FPC defines CPU32, CPU64 and Unix automatically -{$ENDIF} - -{$IFDEF BORLAND} - {$IFDEF LINUX} - {$DEFINE KYLIX} - {$ENDIF LINUX} - {$IFNDEF CLR} - {$IFNDEF CPUX86} - {$IFNDEF CPUX64} - {$DEFINE CPU386} // For Borland compilers select the x86 compat assembler by default - {$DEFINE CPU32} // Assume Borland compilers are 32-bit (rather than 64-bit) - {$DEFINE CPUASM} - {$ELSE ~CPUX64} - {$DEFINE CPU64} - {$DEFINE CPUASM} - {$DEFINE DELPHI64_TEMPORARY} - {$ENDIF ~CPUX64} - {$ELSE ~CPUX86} - {$DEFINE CPU386} - {$DEFINE CPU32} - {$DEFINE CPUASM} - {$ENDIF ~CPUX86} - {$ENDIF ~CLR} -{$ENDIF BORLAND} - -{------------------------------------------------------------------------------} -{ VERXXX to COMPILERX, DELPHIX and BCBX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BORLAND} - {$IFDEF KYLIX} - {$I kylix.inc} // FPC incompatible stuff - {$ELSE ~KYLIX} - - {$DEFINE UNKNOWN_COMPILER_VERSION} - - {$IFDEF VER80} - {$DEFINE COMPILER1} - {$DEFINE DELPHI1} - {$DEFINE DELPHICOMPILER1} - {$DEFINE RTL80_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER90} - {$DEFINE COMPILER2} - {$DEFINE DELPHI2} - {$DEFINE DELPHICOMPILER2} - {$DEFINE RTL90_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER93} - {$DEFINE COMPILER2} - {$DEFINE BCB1} - {$DEFINE BCB} - {$DEFINE RTL93_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER100} - {$DEFINE COMPILER3} - {$DEFINE DELPHI3} - {$DEFINE DELPHICOMPILER3} - {$DEFINE RTL100_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER110} - {$DEFINE COMPILER35} - {$DEFINE BCB3} - {$DEFINE BCB} - {$DEFINE RTL110_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER120} - {$DEFINE COMPILER4} - {$DEFINE DELPHI4} - {$DEFINE DELPHICOMPILER4} - {$DEFINE RTL120_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER125} - {$DEFINE COMPILER4} - {$DEFINE BCB4} - {$DEFINE BCB} - {$DEFINE RTL125_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER130} - {$DEFINE COMPILER5} - {$IFDEF BCB} - {$DEFINE BCB5} - {$ELSE} - {$DEFINE DELPHI5} - {$DEFINE DELPHICOMPILER5} - {$ENDIF} - {$DEFINE RTL130_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER140} - {$DEFINE COMPILER6} - {$IFDEF BCB} - {$DEFINE BCB6} - {$ELSE} - {$DEFINE DELPHI6} - {$DEFINE DELPHICOMPILER6} - {$ENDIF} - {$DEFINE RTL140_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER150} - {$DEFINE COMPILER7} - {$DEFINE DELPHI7} - {$DEFINE DELPHICOMPILER7} - {$DEFINE RTL150_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER160} - {$DEFINE BDS2} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR10} - {$ENDIF CLR} - {$DEFINE COMPILER8} - {$DEFINE DELPHI8} - {$DEFINE DELPHICOMPILER8} - {$DEFINE RTL160_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER170} - {$DEFINE BDS3} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR11} - {$ENDIF CLR} - {$DEFINE COMPILER9} - {$DEFINE DELPHI9} - {$DEFINE DELPHI2005} // synonym to DELPHI9 - {$DEFINE DELPHICOMPILER9} - {$DEFINE RTL170_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER180} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR11} - {$ENDIF CLR} - {$IFDEF VER185} - {$DEFINE BDS5} - {$DEFINE COMPILER11} - {$IFDEF BCB} - {$DEFINE BCB11} - {$ELSE} - {$DEFINE DELPHI11} - {$DEFINE DELPHI2007} // synonym to DELPHI11 - {$DEFINE DELPHICOMPILER11} - {$ENDIF} - {$DEFINE RTL185_UP} - {$ELSE ~~VER185} - {$DEFINE BDS4} - {$DEFINE COMPILER10} - {$IFDEF BCB} - {$DEFINE BCB10} - {$ELSE} - {$DEFINE DELPHI10} - {$DEFINE DELPHI2006} // synonym to DELPHI10 - {$DEFINE DELPHICOMPILER10} - {$ENDIF} - {$DEFINE RTL180_UP} - {$ENDIF ~VER185} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER190} // Delphi 2007 for .NET - {$DEFINE BDS} - {$DEFINE BDS5} - {$IFDEF CLR} - {$DEFINE CLR20} - {$ENDIF CLR} - {$DEFINE COMPILER11} - {$DEFINE DELPHI11} - {$DEFINE DELPHI2007} // synonym to DELPHI11 - {$DEFINE DELPHICOMPILER11} - {$DEFINE RTL190_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER190} - - {$IFDEF VER200} // RAD Studio 2009 - {$DEFINE BDS} - {$DEFINE BDS6} - {$IFDEF CLR} - {$DEFINE CLR20} - {$ENDIF CLR} - {$DEFINE COMPILER12} - {$IFDEF BCB} - {$DEFINE BCB12} - {$ELSE} - {$DEFINE DELPHI12} - {$DEFINE DELPHI2009} // synonym to DELPHI12 - {$DEFINE DELPHICOMPILER12} - {$ENDIF BCB} - {$IFDEF CLR} - {$DEFINE RTL190_UP} - {$ELSE} - {$DEFINE RTL200_UP} - {$ENDIF} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER200} - - {$IFDEF VER210} // RAD Studio 2010 - {$DEFINE BDS} - {$DEFINE BDS7} - {$DEFINE COMPILER14} - {$IFDEF BCB} - {$DEFINE BCB14} - {$ELSE} - {$DEFINE DELPHI14} - {$DEFINE DELPHI2010} // synonym to DELPHI14 - {$DEFINE DELPHICOMPILER14} - {$ENDIF BCB} - {$DEFINE RTL210_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER210} - - {$IFDEF VER220} // RAD Studio XE - {$DEFINE BDS} - {$DEFINE BDS8} - {$DEFINE COMPILER15} - {$IFDEF BCB} - {$DEFINE BCB15} - {$ELSE} - {$DEFINE DELPHI15} - {$DEFINE DELPHIXE} // synonym to DELPHI15 - {$DEFINE DELPHICOMPILER15} - {$ENDIF BCB} - {$DEFINE RTL220_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER220} - - {$IFDEF VER230} // RAD Studio XE2 - {$DEFINE BDS} - {$DEFINE BDS9} - {$DEFINE COMPILER16} - {$IFDEF BCB} - {$DEFINE BCB16} - {$ELSE} - {$DEFINE DELPHI16} - {$DEFINE DELPHIXE2} // synonym to DELPHI16 - {$DEFINE DELPHICOMPILER16} - {$ENDIF BCB} - {$DEFINE RTL230_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER230} - - {$IFDEF VER240} // RAD Studio XE3 - {$DEFINE BDS} - {$DEFINE BDS10} - {$DEFINE COMPILER17} - {$IFDEF BCB} - {$DEFINE BCB17} - {$ELSE} - {$DEFINE DELPHI17} - {$DEFINE DELPHIXE3} // synonym to DELPHI17 - {$DEFINE DELPHICOMPILER17} - {$ENDIF BCB} - {$DEFINE RTL240_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER240} - - {$IFDEF VER250} // RAD Studio XE4 - {$DEFINE BDS} - {$DEFINE BDS11} - {$DEFINE COMPILER18} - {$IFDEF BCB} - {$DEFINE BCB18} - {$ELSE} - {$DEFINE DELPHI18} - {$DEFINE DELPHIXE4} // synonym to DELPHI18 - {$DEFINE DELPHICOMPILER18} - {$ENDIF BCB} - {$DEFINE RTL250_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER250} - - {$IFDEF VER260} // RAD Studio XE5 - {$DEFINE BDS} - {$DEFINE BDS12} - {$DEFINE COMPILER19} - {$IFDEF BCB} - {$DEFINE BCB19} - {$ELSE} - {$DEFINE DELPHI19} - {$DEFINE DELPHIXE5} // synonym to DELPHI19 - {$DEFINE DELPHICOMPILER19} - {$ENDIF BCB} - {$DEFINE RTL260_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER260} - - {$IFDEF VER270} // RAD Studio XE6 - {$DEFINE BDS} - {$DEFINE BDS14} - {$DEFINE COMPILER20} - {$IFDEF BCB} - {$DEFINE BCB20} - {$ELSE} - {$DEFINE DELPHI20} - {$DEFINE DELPHIXE6} // synonym to DELPHI20 - {$DEFINE DELPHICOMPILER20} - {$ENDIF BCB} - {$DEFINE RTL270_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER270} - - {$IFDEF VER280} // RAD Studio XE7 - {$DEFINE BDS} - {$DEFINE BDS15} - {$DEFINE COMPILER21} - {$IFDEF BCB} - {$DEFINE BCB21} - {$ELSE} - {$DEFINE DELPHI21} - {$DEFINE DELPHIXE7} // synonym to DELPHI21 - {$DEFINE DELPHICOMPILER21} - {$ENDIF BCB} - {$DEFINE RTL280_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER280} - - {$IFDEF VER290} // RAD Studio XE8 - {$DEFINE BDS} - {$DEFINE BDS16} - {$DEFINE COMPILER22} - {$IFDEF BCB} - {$DEFINE BCB22} - {$ELSE} - {$DEFINE DELPHI22} - {$DEFINE DELPHIXE8} // synonym to DELPHI22 - {$DEFINE DELPHICOMPILER22} - {$ENDIF BCB} - {$DEFINE RTL290_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER290} - - {$IFDEF VER300} // RAD Studio 10 - {$DEFINE BDS} - {$DEFINE BDS17} - {$DEFINE COMPILER23} - {$IFDEF BCB} - {$DEFINE BCB23} - {$ELSE} - {$DEFINE DELPHI23} - {$DEFINE DELPHIX_SEATTLE} // synonym to DELPHI23 - {$DEFINE DELPHICOMPILER23} - {$ENDIF BCB} - {$DEFINE RTL300_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER290} - - {$IFDEF UNKNOWN_COMPILER_VERSION} // adjust for newer version (always use latest version) - {$DEFINE BDS} - {$DEFINE BDS17} - {$DEFINE COMPILER23} - {$IFDEF BCB} - {$DEFINE BCB23} - {$ELSE} - {$DEFINE DELPHI23} - {$DEFINE DELPHIX_SEATTLE} // synonym to DELPHI23 - {$DEFINE DELPHICOMPILER23} - {$ENDIF BCB} - {$DEFINE RTL300_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$ENDIF ~KYLIX} - - {$IFDEF BCB} - {$DEFINE CPPBUILDER} - {$DEFINE BCBCOMPILER} - {$ELSE ~BCB} - {$DEFINE DELPHI} - {$DEFINE DELPHICOMPILER} - {$ENDIF ~BCB} - -{$ENDIF BORLAND} - -{------------------------------------------------------------------------------} -{ DELPHIX_UP from DELPHIX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHI23} {$DEFINE DELPHI23_UP} {$ENDIF} -{$IFDEF DELPHI22} {$DEFINE DELPHI22_UP} {$ENDIF} -{$IFDEF DELPHI21} {$DEFINE DELPHI21_UP} {$ENDIF} -{$IFDEF DELPHI20} {$DEFINE DELPHI20_UP} {$ENDIF} -{$IFDEF DELPHI19} {$DEFINE DELPHI19_UP} {$ENDIF} -{$IFDEF DELPHI18} {$DEFINE DELPHI18_UP} {$ENDIF} -{$IFDEF DELPHI17} {$DEFINE DELPHI17_UP} {$ENDIF} -{$IFDEF DELPHI16} {$DEFINE DELPHI16_UP} {$ENDIF} -{$IFDEF DELPHI15} {$DEFINE DELPHI15_UP} {$ENDIF} -{$IFDEF DELPHI14} {$DEFINE DELPHI14_UP} {$ENDIF} -{$IFDEF DELPHI12} {$DEFINE DELPHI12_UP} {$ENDIF} -{$IFDEF DELPHI11} {$DEFINE DELPHI11_UP} {$ENDIF} -{$IFDEF DELPHI10} {$DEFINE DELPHI10_UP} {$ENDIF} -{$IFDEF DELPHI9} {$DEFINE DELPHI9_UP} {$ENDIF} -{$IFDEF DELPHI8} {$DEFINE DELPHI8_UP} {$ENDIF} -{$IFDEF DELPHI7} {$DEFINE DELPHI7_UP} {$ENDIF} -{$IFDEF DELPHI6} {$DEFINE DELPHI6_UP} {$ENDIF} -{$IFDEF DELPHI5} {$DEFINE DELPHI5_UP} {$ENDIF} -{$IFDEF DELPHI4} {$DEFINE DELPHI4_UP} {$ENDIF} -{$IFDEF DELPHI3} {$DEFINE DELPHI3_UP} {$ENDIF} -{$IFDEF DELPHI2} {$DEFINE DELPHI2_UP} {$ENDIF} -{$IFDEF DELPHI1} {$DEFINE DELPHI1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHIX_UP from DELPHIX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHI23_UP} - {$DEFINE DELPHIX_SEATTLE_UP} // synonym to DELPHI23_UP - {$DEFINE DELPHI22_UP} -{$ENDIF} - -{$IFDEF DELPHI22_UP} - {$DEFINE DELPHIXE8_UP} // synonym to DELPHI22_UP - {$DEFINE DELPHI21_UP} -{$ENDIF} - -{$IFDEF DELPHI21_UP} - {$DEFINE DELPHIXE7_UP} // synonym to DELPHI21_UP - {$DEFINE DELPHI20_UP} -{$ENDIF} - -{$IFDEF DELPHI20_UP} - {$DEFINE DELPHIXE6_UP} // synonym to DELPHI20_UP - {$DEFINE DELPHI19_UP} -{$ENDIF} - -{$IFDEF DELPHI19_UP} - {$DEFINE DELPHIXE5_UP} // synonym to DELPHI19_UP - {$DEFINE DELPHI18_UP} -{$ENDIF} - -{$IFDEF DELPHI18_UP} - {$DEFINE DELPHIXE4_UP} // synonym to DELPHI18_UP - {$DEFINE DELPHI17_UP} -{$ENDIF} - -{$IFDEF DELPHI17_UP} - {$DEFINE DELPHIXE3_UP} // synonym to DELPHI17_UP - {$DEFINE DELPHI16_UP} -{$ENDIF} - -{$IFDEF DELPHI16_UP} - {$DEFINE DELPHIXE2_UP} // synonym to DELPHI16_UP - {$DEFINE DELPHI15_UP} -{$ENDIF} - -{$IFDEF DELPHI15_UP} - {$DEFINE DELPHIXE_UP} // synonym to DELPHI15_UP - {$DEFINE DELPHI14_UP} -{$ENDIF} - -{$IFDEF DELPHI14_UP} - {$DEFINE DELPHI2010_UP} // synonym to DELPHI14_UP - {$DEFINE DELPHI12_UP} -{$ENDIF} - -{$IFDEF DELPHI12_UP} - {$DEFINE DELPHI2009_UP} // synonym to DELPHI12_UP - {$DEFINE DELPHI11_UP} -{$ENDIF} - -{$IFDEF DELPHI11_UP} - {$DEFINE DELPHI2007_UP} // synonym to DELPHI11_UP - {$DEFINE DELPHI10_UP} -{$ENDIF} - -{$IFDEF DELPHI10_UP} - {$DEFINE DELPHI2006_UP} // synonym to DELPHI10_UP - {$DEFINE DELPHI9_UP} -{$ENDIF} - -{$IFDEF DELPHI9_UP} - {$DEFINE DELPHI2005_UP} // synonym to DELPHI9_UP - {$DEFINE DELPHI8_UP} -{$ENDIF} - -{$IFDEF DELPHI8_UP} {$DEFINE DELPHI7_UP} {$ENDIF} -{$IFDEF DELPHI7_UP} {$DEFINE DELPHI6_UP} {$ENDIF} -{$IFDEF DELPHI6_UP} {$DEFINE DELPHI5_UP} {$ENDIF} -{$IFDEF DELPHI5_UP} {$DEFINE DELPHI4_UP} {$ENDIF} -{$IFDEF DELPHI4_UP} {$DEFINE DELPHI3_UP} {$ENDIF} -{$IFDEF DELPHI3_UP} {$DEFINE DELPHI2_UP} {$ENDIF} -{$IFDEF DELPHI2_UP} {$DEFINE DELPHI1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BCBX_UP from BCBX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BCB23} {$DEFINE BCB23_UP} {$ENDIF} -{$IFDEF BCB22} {$DEFINE BCB22_UP} {$ENDIF} -{$IFDEF BCB21} {$DEFINE BCB21_UP} {$ENDIF} -{$IFDEF BCB20} {$DEFINE BCB20_UP} {$ENDIF} -{$IFDEF BCB19} {$DEFINE BCB19_UP} {$ENDIF} -{$IFDEF BCB18} {$DEFINE BCB18_UP} {$ENDIF} -{$IFDEF BCB17} {$DEFINE BCB17_UP} {$ENDIF} -{$IFDEF BCB16} {$DEFINE BCB16_UP} {$ENDIF} -{$IFDEF BCB15} {$DEFINE BCB15_UP} {$ENDIF} -{$IFDEF BCB14} {$DEFINE BCB14_UP} {$ENDIF} -{$IFDEF BCB12} {$DEFINE BCB12_UP} {$ENDIF} -{$IFDEF BCB11} {$DEFINE BCB11_UP} {$ENDIF} -{$IFDEF BCB10} {$DEFINE BCB10_UP} {$ENDIF} -{$IFDEF BCB6} {$DEFINE BCB6_UP} {$ENDIF} -{$IFDEF BCB5} {$DEFINE BCB5_UP} {$ENDIF} -{$IFDEF BCB4} {$DEFINE BCB4_UP} {$ENDIF} -{$IFDEF BCB3} {$DEFINE BCB3_UP} {$ENDIF} -{$IFDEF BCB1} {$DEFINE BCB1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BCBX_UP from BCBX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BCB23_UP} {$DEFINE BCB22_UP} {$ENDIF} -{$IFDEF BCB22_UP} {$DEFINE BCB21_UP} {$ENDIF} -{$IFDEF BCB21_UP} {$DEFINE BCB20_UP} {$ENDIF} -{$IFDEF BCB20_UP} {$DEFINE BCB19_UP} {$ENDIF} -{$IFDEF BCB19_UP} {$DEFINE BCB18_UP} {$ENDIF} -{$IFDEF BCB18_UP} {$DEFINE BCB17_UP} {$ENDIF} -{$IFDEF BCB17_UP} {$DEFINE BCB16_UP} {$ENDIF} -{$IFDEF BCB16_UP} {$DEFINE BCB15_UP} {$ENDIF} -{$IFDEF BCB15_UP} {$DEFINE BCB14_UP} {$ENDIF} -{$IFDEF BCB14_UP} {$DEFINE BCB12_UP} {$ENDIF} -{$IFDEF BCB12_UP} {$DEFINE BCB11_UP} {$ENDIF} -{$IFDEF BCB11_UP} {$DEFINE BCB10_UP} {$ENDIF} -{$IFDEF BCB10_UP} {$DEFINE BCB6_UP} {$ENDIF} -{$IFDEF BCB6_UP} {$DEFINE BCB5_UP} {$ENDIF} -{$IFDEF BCB5_UP} {$DEFINE BCB4_UP} {$ENDIF} -{$IFDEF BCB4_UP} {$DEFINE BCB3_UP} {$ENDIF} -{$IFDEF BCB3_UP} {$DEFINE BCB1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BDSX_UP from BDSX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BDS17} {$DEFINE BDS17_UP} {$ENDIF} -{$IFDEF BDS16} {$DEFINE BDS16_UP} {$ENDIF} -{$IFDEF BDS15} {$DEFINE BDS15_UP} {$ENDIF} -{$IFDEF BDS14} {$DEFINE BDS14_UP} {$ENDIF} -{$IFDEF BDS12} {$DEFINE BDS12_UP} {$ENDIF} -{$IFDEF BDS11} {$DEFINE BDS11_UP} {$ENDIF} -{$IFDEF BDS10} {$DEFINE BDS10_UP} {$ENDIF} -{$IFDEF BDS9} {$DEFINE BDS9_UP} {$ENDIF} -{$IFDEF BDS8} {$DEFINE BDS8_UP} {$ENDIF} -{$IFDEF BDS7} {$DEFINE BDS7_UP} {$ENDIF} -{$IFDEF BDS6} {$DEFINE BDS6_UP} {$ENDIF} -{$IFDEF BDS5} {$DEFINE BDS5_UP} {$ENDIF} -{$IFDEF BDS4} {$DEFINE BDS4_UP} {$ENDIF} -{$IFDEF BDS3} {$DEFINE BDS3_UP} {$ENDIF} -{$IFDEF BDS2} {$DEFINE BDS2_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BDSX_UP from BDSX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BDS17_UP} {$DEFINE BDS16_UP} {$ENDIF} -{$IFDEF BDS16_UP} {$DEFINE BDS15_UP} {$ENDIF} -{$IFDEF BDS15_UP} {$DEFINE BDS14_UP} {$ENDIF} -{$IFDEF BDS14_UP} {$DEFINE BDS12_UP} {$ENDIF} -{$IFDEF BDS12_UP} {$DEFINE BDS11_UP} {$ENDIF} -{$IFDEF BDS11_UP} {$DEFINE BDS10_UP} {$ENDIF} -{$IFDEF BDS10_UP} {$DEFINE BDS9_UP} {$ENDIF} -{$IFDEF BDS9_UP} {$DEFINE BDS8_UP} {$ENDIF} -{$IFDEF BDS8_UP} {$DEFINE BDS7_UP} {$ENDIF} -{$IFDEF BDS7_UP} {$DEFINE BDS6_UP} {$ENDIF} -{$IFDEF BDS6_UP} {$DEFINE BDS5_UP} {$ENDIF} -{$IFDEF BDS5_UP} {$DEFINE BDS4_UP} {$ENDIF} -{$IFDEF BDS4_UP} {$DEFINE BDS3_UP} {$ENDIF} -{$IFDEF BDS3_UP} {$DEFINE BDS2_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHICOMPILERX_UP from DELPHICOMPILERX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER23} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER22} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER21} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER20} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER19} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER18} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER17} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER16} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER15} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER14} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER12} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER11} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER10} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER9} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER7} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER6} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER5} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER4} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER3} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER2} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER1} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHICOMPILERX_UP from DELPHICOMPILERX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER23_UP} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER22_UP} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER21_UP} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER20_UP} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER19_UP} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER18_UP} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER17_UP} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER16_UP} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER15_UP} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER14_UP} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER12_UP} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER11_UP} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER10_UP} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER9_UP} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER7_UP} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER6_UP} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER5_UP} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER4_UP} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER3_UP} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER2_UP} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ COMPILERX_UP from COMPILERX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF COMPILER23} {$DEFINE COMPILER23_UP} {$ENDIF} -{$IFDEF COMPILER22} {$DEFINE COMPILER22_UP} {$ENDIF} -{$IFDEF COMPILER21} {$DEFINE COMPILER21_UP} {$ENDIF} -{$IFDEF COMPILER20} {$DEFINE COMPILER20_UP} {$ENDIF} -{$IFDEF COMPILER19} {$DEFINE COMPILER19_UP} {$ENDIF} -{$IFDEF COMPILER18} {$DEFINE COMPILER18_UP} {$ENDIF} -{$IFDEF COMPILER17} {$DEFINE COMPILER17_UP} {$ENDIF} -{$IFDEF COMPILER16} {$DEFINE COMPILER16_UP} {$ENDIF} -{$IFDEF COMPILER15} {$DEFINE COMPILER15_UP} {$ENDIF} -{$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} -{$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} -{$IFDEF COMPILER11} {$DEFINE COMPILER11_UP} {$ENDIF} -{$IFDEF COMPILER10} {$DEFINE COMPILER10_UP} {$ENDIF} -{$IFDEF COMPILER9} {$DEFINE COMPILER9_UP} {$ENDIF} -{$IFDEF COMPILER8} {$DEFINE COMPILER8_UP} {$ENDIF} -{$IFDEF COMPILER7} {$DEFINE COMPILER7_UP} {$ENDIF} -{$IFDEF COMPILER6} {$DEFINE COMPILER6_UP} {$ENDIF} -{$IFDEF COMPILER5} {$DEFINE COMPILER5_UP} {$ENDIF} -{$IFDEF COMPILER4} {$DEFINE COMPILER4_UP} {$ENDIF} -{$IFDEF COMPILER35} {$DEFINE COMPILER35_UP} {$ENDIF} -{$IFDEF COMPILER3} {$DEFINE COMPILER3_UP} {$ENDIF} -{$IFDEF COMPILER2} {$DEFINE COMPILER2_UP} {$ENDIF} -{$IFDEF COMPILER1} {$DEFINE COMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ COMPILERX_UP from COMPILERX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF COMPILER23_UP} {$DEFINE COMPILER22_UP} {$ENDIF} -{$IFDEF COMPILER22_UP} {$DEFINE COMPILER21_UP} {$ENDIF} -{$IFDEF COMPILER21_UP} {$DEFINE COMPILER20_UP} {$ENDIF} -{$IFDEF COMPILER20_UP} {$DEFINE COMPILER19_UP} {$ENDIF} -{$IFDEF COMPILER19_UP} {$DEFINE COMPILER18_UP} {$ENDIF} -{$IFDEF COMPILER18_UP} {$DEFINE COMPILER17_UP} {$ENDIF} -{$IFDEF COMPILER17_UP} {$DEFINE COMPILER16_UP} {$ENDIF} -{$IFDEF COMPILER16_UP} {$DEFINE COMPILER15_UP} {$ENDIF} -{$IFDEF COMPILER15_UP} {$DEFINE COMPILER14_UP} {$ENDIF} -{$IFDEF COMPILER14_UP} {$DEFINE COMPILER12_UP} {$ENDIF} -{$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} -{$IFDEF COMPILER11_UP} {$DEFINE COMPILER10_UP} {$ENDIF} -{$IFDEF COMPILER10_UP} {$DEFINE COMPILER9_UP} {$ENDIF} -{$IFDEF COMPILER9_UP} {$DEFINE COMPILER8_UP} {$ENDIF} -{$IFDEF COMPILER8_UP} {$DEFINE COMPILER7_UP} {$ENDIF} -{$IFDEF COMPILER7_UP} {$DEFINE COMPILER6_UP} {$ENDIF} -{$IFDEF COMPILER6_UP} {$DEFINE COMPILER5_UP} {$ENDIF} -{$IFDEF COMPILER5_UP} {$DEFINE COMPILER4_UP} {$ENDIF} -{$IFDEF COMPILER4_UP} {$DEFINE COMPILER35_UP} {$ENDIF} -{$IFDEF COMPILER35_UP} {$DEFINE COMPILER3_UP} {$ENDIF} -{$IFDEF COMPILER3_UP} {$DEFINE COMPILER2_UP} {$ENDIF} -{$IFDEF COMPILER2_UP} {$DEFINE COMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ RTLX_UP from RTLX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF RTL300_UP} {$DEFINE RTL290_UP} {$ENDIF} -{$IFDEF RTL290_UP} {$DEFINE RTL280_UP} {$ENDIF} -{$IFDEF RTL280_UP} {$DEFINE RTL270_UP} {$ENDIF} -{$IFDEF RTL270_UP} {$DEFINE RTL260_UP} {$ENDIF} -{$IFDEF RTL260_UP} {$DEFINE RTL250_UP} {$ENDIF} -{$IFDEF RTL250_UP} {$DEFINE RTL240_UP} {$ENDIF} -{$IFDEF RTL240_UP} {$DEFINE RTL230_UP} {$ENDIF} -{$IFDEF RTL230_UP} {$DEFINE RTL220_UP} {$ENDIF} -{$IFDEF RTL220_UP} {$DEFINE RTL210_UP} {$ENDIF} -{$IFDEF RTL210_UP} {$DEFINE RTL200_UP} {$ENDIF} -{$IFDEF RTL200_UP} {$DEFINE RTL190_UP} {$ENDIF} -{$IFDEF RTL190_UP} {$DEFINE RTL185_UP} {$ENDIF} -{$IFDEF RTL185_UP} {$DEFINE RTL180_UP} {$ENDIF} -{$IFDEF RTL180_UP} {$DEFINE RTL170_UP} {$ENDIF} -{$IFDEF RTL170_UP} {$DEFINE RTL160_UP} {$ENDIF} -{$IFDEF RTL160_UP} {$DEFINE RTL150_UP} {$ENDIF} -{$IFDEF RTL150_UP} {$DEFINE RTL145_UP} {$ENDIF} -{$IFDEF RTL145_UP} {$DEFINE RTL142_UP} {$ENDIF} -{$IFDEF RTL142_UP} {$DEFINE RTL140_UP} {$ENDIF} -{$IFDEF RTL140_UP} {$DEFINE RTL130_UP} {$ENDIF} -{$IFDEF RTL130_UP} {$DEFINE RTL125_UP} {$ENDIF} -{$IFDEF RTL125_UP} {$DEFINE RTL120_UP} {$ENDIF} -{$IFDEF RTL120_UP} {$DEFINE RTL110_UP} {$ENDIF} -{$IFDEF RTL110_UP} {$DEFINE RTL100_UP} {$ENDIF} -{$IFDEF RTL100_UP} {$DEFINE RTL93_UP} {$ENDIF} -{$IFDEF RTL93_UP} {$DEFINE RTL90_UP} {$ENDIF} -{$IFDEF RTL90_UP} {$DEFINE RTL80_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ Check for CLR overrides of default detection } -{------------------------------------------------------------------------------} - -{$IFDEF CLR} - {$IFDEF FORCE_CLR10} - {$DEFINE CLR10} - {$UNDEF CLR11} - {$UNDEF CLR20} - {$ENDIF FORCE_CLR10} - - {$IFDEF FORCE_CLR11} - {$UNDEF CLR10} - {$DEFINE CLR11} - {$UNDEF CLR20} - {$ENDIF FORCE_CLR11} - - {$IFDEF FORCE_CLR20} - {$UNDEF CLR10} - {$UNDEF CLR11} - {$DEFINE CLR20} - {$ENDIF FORCE_CLR20} -{$ENDIF CLR} - -{------------------------------------------------------------------------------} -{ CLRX from CLRX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF CLR10} {$DEFINE CLR10_UP} {$ENDIF} -{$IFDEF CLR11} {$DEFINE CLR11_UP} {$ENDIF} -{$IFDEF CLR20} {$DEFINE CLR20_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ CLRX_UP from CLRX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF CLR20_UP} {$DEFINE CLR11_UP} {$ENDIF} -{$IFDEF CLR11_UP} {$DEFINE CLR10_UP} {$ENDIF} - -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER} - {$DEFINE DELPHILANGUAGE} -{$ENDIF} - -{$IFDEF BCBCOMPILER} - {$DEFINE DELPHILANGUAGE} -{$ENDIF} - -{------------------------------------------------------------------------------} -{ KYLIXX_UP from KYLIXX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF KYLIX3} {$DEFINE KYLIX3_UP} {$ENDIF} -{$IFDEF KYLIX2} {$DEFINE KYLIX2_UP} {$ENDIF} -{$IFDEF KYLIX1} {$DEFINE KYLIX1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ KYLIXX_UP from KYLIXX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF KYLIX3_UP} {$DEFINE KYLIX2_UP} {$ENDIF} -{$IFDEF KYLIX2_UP} {$DEFINE KYLIX1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ Map COMPILERX_UP to friendly feature names } -{------------------------------------------------------------------------------} - -{$IFDEF FPC} - {$IFDEF VER1_0} - Please use FPC 2.0 or higher to compile this. - {$ELSE} - {$DEFINE SUPPORTS_OUTPARAMS} - {$DEFINE SUPPORTS_WIDECHAR} - {$DEFINE SUPPORTS_WIDESTRING} - {$IFDEF HASINTF} - {$DEFINE SUPPORTS_INTERFACE} - {$ENDIF} - {$IFDEF HASVARIANT} - {$DEFINE SUPPORTS_VARIANT} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_SINGLE} - {$DEFINE SUPPORTS_SINGLE} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_DOUBLE} - {$DEFINE SUPPORTS_DOUBLE} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_EXTENDED} - {$DEFINE SUPPORTS_EXTENDED} - {$ENDIF} - {$IFDEF HASCURRENCY} - {$DEFINE SUPPORTS_CURRENCY} - {$ENDIF} - {$DEFINE SUPPORTS_THREADVAR} - {$DEFINE SUPPORTS_CONSTPARAMS} - {$DEFINE SUPPORTS_LONGWORD} - {$DEFINE SUPPORTS_INT64} - {$DEFINE SUPPORTS_DYNAMICARRAYS} - {$DEFINE SUPPORTS_DEFAULTPARAMS} - {$DEFINE SUPPORTS_OVERLOAD} - {$DEFINE ACCEPT_DEPRECATED} // 2.2 also gives warnings - {$DEFINE ACCEPT_PLATFORM} // 2.2 also gives warnings - {$DEFINE ACCEPT_LIBRARY} - {$DEFINE SUPPORTS_EXTSYM} - {$DEFINE SUPPORTS_NODEFINE} - - {$DEFINE SUPPORTS_CUSTOMVARIANTS} - {$DEFINE SUPPORTS_VARARGS} - {$DEFINE SUPPORTS_ENUMVALUE} - {$IFDEF LINUX} - {$DEFINE HAS_UNIT_LIBC} - {$ENDIF LINUX} - {$DEFINE HAS_UNIT_CONTNRS} - {$DEFINE HAS_UNIT_TYPES} - {$DEFINE HAS_UNIT_VARIANTS} - {$DEFINE HAS_UNIT_STRUTILS} - {$DEFINE HAS_UNIT_DATEUTILS} - {$DEFINE HAS_UNIT_RTLCONSTS} - - {$DEFINE XPLATFORM_RTL} - - {$IFDEF VER2_2} - {$DEFINE SUPPORTS_DISPINTERFACE} - {$DEFINE SUPPORTS_IMPLEMENTS} - {$DEFINE SUPPORTS_DISPID} - {$ELSE} - {$UNDEF SUPPORTS_DISPINTERFACE} - {$UNDEF SUPPORTS_IMPLEMENTS} - {$endif} - {$UNDEF SUPPORTS_UNSAFE_WARNINGS} - {$ENDIF} -{$ENDIF FPC} - -{$IFDEF CLR} - {$DEFINE SUPPORTS_UNICODE} -{$ENDIF CLR} - -{$IFDEF COMPILER1_UP} - {$DEFINE SUPPORTS_CONSTPARAMS} - {$DEFINE SUPPORTS_SINGLE} - {$DEFINE SUPPORTS_DOUBLE} - {$DEFINE SUPPORTS_EXTENDED} - {$DEFINE SUPPORTS_PACKAGES} -{$ENDIF COMPILER1_UP} - -{$IFDEF COMPILER2_UP} - {$DEFINE SUPPORTS_CURRENCY} - {$DEFINE SUPPORTS_THREADVAR} - {$DEFINE SUPPORTS_VARIANT} - {$DEFINE SUPPORTS_WIDECHAR} -{$ENDIF COMPILER2_UP} - -{$IFDEF COMPILER3_UP} - {$DEFINE SUPPORTS_OUTPARAMS} - {$DEFINE SUPPORTS_WIDESTRING} - {$DEFINE SUPPORTS_INTERFACE} - {$DEFINE SUPPORTS_DISPINTERFACE} - {$DEFINE SUPPORTS_DISPID} - {$DEFINE SUPPORTS_WEAKPACKAGEUNIT} -{$ENDIF COMPILER3_UP} - -{$IFDEF COMPILER35_UP} - {$DEFINE SUPPORTS_EXTSYM} - {$DEFINE SUPPORTS_NODEFINE} -{$ENDIF COMPILER35_UP} - -{$IFDEF COMPILER4_UP} - {$DEFINE SUPPORTS_LONGWORD} - {$DEFINE SUPPORTS_INT64} - {$DEFINE SUPPORTS_DYNAMICARRAYS} - {$DEFINE SUPPORTS_DEFAULTPARAMS} - {$DEFINE SUPPORTS_OVERLOAD} - {$DEFINE SUPPORTS_IMPLEMENTS} -{$ENDIF COMPILER4_UP} - -{$IFDEF COMPILER6_UP} - {$DEFINE SUPPORTS_DEPRECATED} - {$DEFINE SUPPORTS_LIBRARY} - {$DEFINE SUPPORTS_PLATFORM} - {$DEFINE SUPPORTS_LOCAL} - {$DEFINE SUPPORTS_SETPEFLAGS} - {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS} - {$DEFINE ACCEPT_DEPRECATED} - {$DEFINE ACCEPT_PLATFORM} - {$DEFINE ACCEPT_LIBRARY} - {$DEFINE SUPPORTS_DEPRECATED_WARNINGS} - {$DEFINE SUPPORTS_LIBRARY_WARNINGS} - {$DEFINE SUPPORTS_PLATFORM_WARNINGS} - {$DEFINE SUPPORTS_CUSTOMVARIANTS} - {$DEFINE SUPPORTS_VARARGS} - {$DEFINE SUPPORTS_ENUMVALUE} - {$DEFINE SUPPORTS_COMPILETIME_MESSAGES} -{$ENDIF COMPILER6_UP} - -{$IFDEF COMPILER7_UP} - {$DEFINE SUPPORTS_UNSAFE_WARNINGS} - {$DEFINE SUPPORTS_UINT64} -{$ENDIF COMPILER7_UP} - -{$IFDEF COMPILER9_UP} - {$DEFINE SUPPORTS_FOR_IN} - {$DEFINE SUPPORTS_INLINE} - {$DEFINE SUPPORTS_NESTED_CONSTANTS} - {$DEFINE SUPPORTS_NESTED_TYPES} - {$DEFINE SUPPORTS_REGION} - {$IFDEF CLR} - {$DEFINE SUPPORTS_ENHANCED_RECORDS} - {$DEFINE SUPPORTS_CLASS_FIELDS} - {$DEFINE SUPPORTS_CLASS_HELPERS} - {$DEFINE SUPPORTS_CLASS_OPERATORS} - {$DEFINE SUPPORTS_STRICT} - {$DEFINE SUPPORTS_STATIC} - {$DEFINE SUPPORTS_FINAL} - {$ENDIF CLR} -{$ENDIF COMPILER9_UP} - -{$IFDEF COMPILER10_UP} - {$DEFINE SUPPORTS_ENHANCED_RECORDS} - {$DEFINE SUPPORTS_CLASS_FIELDS} - {$DEFINE SUPPORTS_CLASS_HELPERS} - {$DEFINE SUPPORTS_CLASS_OPERATORS} - {$DEFINE SUPPORTS_STRICT} - {$DEFINE SUPPORTS_STATIC} - {$DEFINE SUPPORTS_FINAL} - {$DEFINE SUPPORTS_METHODINFO} -{$ENDIF COMPILER10_UP} - -{$IFDEF COMPILER11_UP} - {$IFDEF CLR} - {$DEFINE SUPPORTS_GENERICS} - {$DEFINE SUPPORTS_DEPRECATED_DETAILS} - {$ENDIF CLR} -{$ENDIF COMPILER11_UP} - -{$IFDEF COMPILER12_UP} - {$DEFINE SUPPORTS_GENERICS} - {$DEFINE SUPPORTS_DEPRECATED_DETAILS} - {$DEFINE SUPPORTS_INT_ALIASES} - {$IFNDEF CLR} - {$DEFINE SUPPORTS_UNICODE} - {$DEFINE SUPPORTS_UNICODE_STRING} - {$ENDIF CLR} -{$ENDIF COMPILER12_UP} - -{$IFDEF COMPILER14_UP} - {$DEFINE SUPPORTS_CLASS_CTORDTORS} - {$DEFINE HAS_UNIT_RTTI} - {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ} - {$DEFINE SUPPORTS_DELAYED_LOADING} -{$ENDIF COMPILER14_UP} - -{$IFDEF COMPILER16_UP} - {$DEFINE USE_64BIT_TYPES} -{$ENDIF COMPILER16_UP} - -{$IFDEF RTL130_UP} - {$DEFINE HAS_UNIT_CONTNRS} -{$ENDIF RTL130_UP} - -{$IFDEF RTL140_UP} - {$IFDEF LINUX} - {$DEFINE HAS_UNIT_LIBC} - {$ENDIF LINUX} - {$DEFINE HAS_UNIT_RTLCONSTS} - {$DEFINE HAS_UNIT_TYPES} - {$DEFINE HAS_UNIT_VARIANTS} - {$DEFINE HAS_UNIT_STRUTILS} - {$DEFINE HAS_UNIT_DATEUTILS} - {$DEFINE XPLATFORM_RTL} -{$ENDIF RTL140_UP} - -{$IFDEF RTL150_UP} - {$DEFINE HAS_UNIT_UXTHEME} -{$ENDIF RTL150_UP} - -{$IFDEF RTL170_UP} - {$DEFINE HAS_UNIT_HTTPPROD} -{$ENDIF RTL170_UP} - -{$IFDEF RTL185_UP} - {$DEFINE HAS_UNIT_GIFIMG} -{$ENDIF RTL185_UP} - -{$IFDEF RTL200_UP} - {$DEFINE HAS_UNIT_ANSISTRINGS} - {$DEFINE HAS_UNIT_PNGIMAGE} - {$DEFINE HAS_UNIT_CHARACTER} - {$DEFINE HAS_EXCEPTION_STACKTRACE} -{$ENDIF RTL200_UP} - -{$IFDEF RTL210_UP} - {$DEFINE HAS_EARGUMENTEXCEPTION} -{$ENDIF RTL210_UP} - -{$IFDEF RTL220_UP} - {$DEFINE HAS_UNIT_REGULAREXPRESSIONSAPI} - {$DEFINE HAS_ENOTIMPLEMENTED} -{$ENDIF RTL220_UP} - -{$IFDEF RTL230_UP} - {$DEFINE HAS_UNITSCOPE} - {$DEFINE HAS_UNIT_SYSTEM_UITYPES} - {$DEFINE HAS_UNIT_VCL_THEMES} -{$ENDIF RTL230_UP} - -{$IFDEF RTL240_UP} - {$DEFINE HAS_UNIT_SYSTEM_ACTIONS} - {$DEFINE HAS_PROPERTY_STYLEELEMENTS} -{$ENDIF RTL240_UP} - -{$IFDEF RTL250_UP} - {$DEFINE DEPRECATED_SYSUTILS_ANSISTRINGS} -{$ENDIF RTL250_UP} - -{$IFDEF RTL270_UP} - {$DEFINE HAS_AUTOMATIC_DB_FIELDS} -{$ENDIF RTL270_UP} - -{------------------------------------------------------------------------------} -{ Cross-platform related defines } -{------------------------------------------------------------------------------} - -{$IFNDEF CPUASM} - {$DEFINE PUREPASCAL} -{$ENDIF ~CPUASM} - -{$IFDEF WIN32} - {$DEFINE MSWINDOWS} // predefined for D6+/BCB6+ - {$DEFINE Win32API} -{$ENDIF} - -{$IFDEF DELPHILANGUAGE} - {$IFDEF LINUX} - {$DEFINE UNIX} - {$ENDIF} - - {$IFNDEF CONSOLE} - {$IFDEF LINUX} - {$DEFINE VisualCLX} - {$ENDIF} - {$IFNDEF VisualCLX} - {$DEFINE VCL} - {$ENDIF} - {$ENDIF ~CONSOLE} -{$ENDIF DELPHILANGUAGE} - -{------------------------------------------------------------------------------} -{ Compiler settings } -{------------------------------------------------------------------------------} - -{$IFOPT A+} {$DEFINE ALIGN_ON} {$ENDIF} -{$IFOPT B+} {$DEFINE BOOLEVAL_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT C+} {$DEFINE ASSERTIONS_ON} {$ENDIF} -{$ENDIF} -{$IFOPT D+} {$DEFINE DEBUGINFO_ON} {$ENDIF} -{$IFOPT G+} {$DEFINE IMPORTEDDATA_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT H+} {$DEFINE LONGSTRINGS_ON} {$ENDIF} -{$ENDIF} - -// Hints -{$IFOPT I+} {$DEFINE IOCHECKS_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT J+} {$DEFINE WRITEABLECONST_ON} {$ENDIF} -{$ENDIF} -{$IFOPT L+} {$DEFINE LOCALSYMBOLS} {$DEFINE LOCALSYMBOLS_ON} {$ENDIF} -{$IFOPT M+} {$DEFINE TYPEINFO_ON} {$ENDIF} -{$IFOPT O+} {$DEFINE OPTIMIZATION_ON} {$ENDIF} -{$IFOPT P+} {$DEFINE OPENSTRINGS_ON} {$ENDIF} -{$IFOPT Q+} {$DEFINE OVERFLOWCHECKS_ON} {$ENDIF} -{$IFOPT R+} {$DEFINE RANGECHECKS_ON} {$ENDIF} - -// Real compatibility -{$IFOPT T+} {$DEFINE TYPEDADDRESS_ON} {$ENDIF} -{$IFOPT U+} {$DEFINE SAFEDIVIDE_ON} {$ENDIF} -{$IFOPT V+} {$DEFINE VARSTRINGCHECKS_ON} {$ENDIF} -{$IFOPT W+} {$DEFINE STACKFRAMES_ON} {$ENDIF} - -// Warnings -{$IFOPT X+} {$DEFINE EXTENDEDSYNTAX_ON} {$ENDIF} - -// for Delphi/BCB trial versions remove the point from the line below -{.$UNDEF SUPPORTS_WEAKPACKAGEUNIT} - -{$ENDIF ~JEDI_INC} diff --git a/components/vampireimaging/Demos/ObjectPascal/Common/sdl.pas b/components/vampireimaging/Demos/ObjectPascal/Common/sdl.pas deleted file mode 100644 index 05fe2ff..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/Common/sdl.pas +++ /dev/null @@ -1,4311 +0,0 @@ -unit sdl; -{ - $Id: sdl.pas,v 1.38 2008/01/26 10:09:32 savage Exp $ - -} -{******************************************************************************} -{ } -{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } -{ Conversion of the Simple DirectMedia Layer Headers } -{ } -{ Portions created by Sam Lantinga <slouken@devolution.com> are } -{ Copyright (C) 1997-2004 Sam Lantinga } -{ 5635-34 Springhouse Dr. } -{ Pleasanton, CA 94588 (USA) } -{ } -{ All Rights Reserved. } -{ } -{ The original files are : SDL.h } -{ SDL_main.h } -{ SDL_types.h } -{ SDL_rwops.h } -{ SDL_timer.h } -{ SDL_audio.h } -{ SDL_cdrom.h } -{ SDL_joystick.h } -{ SDL_mouse.h } -{ SDL_keyboard.h } -{ SDL_events.h } -{ SDL_video.h } -{ SDL_byteorder.h } -{ SDL_version.h } -{ SDL_active.h } -{ SDL_thread.h } -{ SDL_mutex .h } -{ SDL_getenv.h } -{ SDL_loadso.h } -{ } -{ The initial developer of this Pascal code was : } -{ Dominique Louis <Dominique@SavageSoftware.com.au> } -{ } -{ Portions created by Dominique Louis are } -{ Copyright (C) 2000 - 2004 Dominique Louis. } -{ } -{ } -{ Contributor(s) } -{ -------------- } -{ Tom Jones <tigertomjones@gmx.de> His Project inspired this conversion } -{ Matthias Thoma <ma.thoma@gmx.de> } -{ } -{ Obtained through: } -{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } -{ } -{ You may retrieve the latest version of this file at the Project } -{ JEDI home page, located at http://delphi-jedi.org } -{ } -{ The contents of this file are used with permission, subject to } -{ the Mozilla Public License Version 1.1 (the "License"); you may } -{ not use this file except in compliance with the License. You may } -{ obtain a copy of the License at } -{ http://www.mozilla.org/MPL/MPL-1.1.html } -{ } -{ Software distributed under the License is distributed on an } -{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } -{ implied. See the License for the specific language governing } -{ rights and limitations under the License. } -{ } -{ Description } -{ ----------- } -{ } -{ } -{ } -{ } -{ } -{ } -{ } -{ Requires } -{ -------- } -{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } -{ They are available from... } -{ http://www.libsdl.org . } -{ } -{ Programming Notes } -{ ----------------- } -{ } -{ } -{ } -{ } -{ Revision History } -{ ---------------- } -{ May 08 2001 - DL : Added Keyboard State Array ( See demos for how to } -{ use ) } -{ PKeyStateArr = ^TKeyStateArr; } -{ TKeyStateArr = array[0..65000] of UInt8; } -{ As most games will need it. } -{ } -{ April 02 2001 - DL : Added SDL_getenv.h definitions and tested version } -{ 1.2.0 compatability. } -{ } -{ March 13 2001 - MT : Added Linux compatibility. } -{ } -{ March 10 2001 - MT : Added externalsyms for DEFINES } -{ Changed the license header } -{ } -{ March 09 2001 - MT : Added Kylix Ifdefs/Deleted the uses mmsystem } -{ } -{ March 01 2001 - DL : Update conversion of version 1.1.8 } -{ } -{ July 22 2001 - DL : Added TUInt8Array and PUIntArray after suggestions } -{ from Matthias Thoma and Eric Grange. } -{ } -{ October 12 2001 - DL : Various changes as suggested by Matthias Thoma and } -{ David Acklam } -{ } -{ October 24 2001 - DL : Added FreePascal support as per suggestions from } -{ Dean Ellis. } -{ } -{ October 27 2001 - DL : Added SDL_BUTTON macro } -{ } -{ November 08 2001 - DL : Bug fix as pointed out by Puthoon. } -{ } -{ November 29 2001 - DL : Bug fix of SDL_SetGammaRamp as pointed out by Simon} -{ Rushton. } -{ } -{ November 30 2001 - DL : SDL_NOFRAME added as pointed out by Simon Rushton. } -{ } -{ December 11 2001 - DL : Added $WEAKPACKAGEUNIT ON to facilitate useage in } -{ Components } -{ } -{ January 05 2002 - DL : Added SDL_Swap32 function as suggested by Matthias } -{ Thoma and also made sure the _getenv from } -{ MSVCRT.DLL uses the right calling convention } -{ } -{ January 25 2002 - DL : Updated conversion of SDL_AddTimer & } -{ SDL_RemoveTimer as per suggestions from Matthias } -{ Thoma. } -{ } -{ January 27 2002 - DL : Commented out exported function putenv and getenv } -{ So that developers get used to using SDL_putenv } -{ SDL_getenv, as they are more portable } -{ } -{ March 05 2002 - DL : Added FreeAnNil procedure for Delphi 4 users. } -{ } -{ October 23 2002 - DL : Added Delphi 3 Define of Win32. } -{ If you intend to you Delphi 3... } -{ ( which is officially unsupported ) make sure you } -{ remove references to $EXTERNALSYM in this and other} -{ SDL files. } -{ } -{ November 29 2002 - DL : Fixed bug in Declaration of SDL_GetRGBA that was } -{ pointed out by Todd Lang } -{ } -{ April 03 2003 - DL : Added jedi-sdl.inc include file to support more } -{ Pascal compilers. Initial support is now included } -{ for GnuPascal, VirtualPascal, TMT and obviously } -{ continue support for Delphi Kylix and FreePascal. } -{ } -{ April 08 2003 - MK : Aka Mr Kroket - Added Better FPC support } -{ } -{ April 24 2003 - DL : under instruction from Alexey Barkovoy, I have added} -{ better TMT Pascal support and under instruction } -{ from Prof. Abimbola Olowofoyeku (The African Chief),} -{ I have added better Gnu Pascal support } -{ } -{ April 30 2003 - DL : under instruction from David Mears AKA } -{ Jason Siletto, I have added FPC Linux support. } -{ This was compiled with fpc 1.1, so remember to set } -{ include file path. ie. -Fi/usr/share/fpcsrc/rtl/* } -{ } -{ - $Log: sdl.pas,v $ - Revision 1.38 2008/01/26 10:09:32 savage - Added SDL_BUTTON_X1 and SDL_BUTTON_X2 constants for extended mouse buttons. Now makes SDL v1.2.13 compliant. - - Revision 1.37 2007/12/20 22:36:56 savage - Added SKYOS support, thanks to Sebastian-Torsten Tillmann - - Revision 1.36 2007/12/05 22:52:04 savage - Better Mac OS X support for Frameworks. - - Revision 1.35 2007/12/02 22:41:13 savage - Change for Mac OS X to link to SDL Framework - - Revision 1.34 2007/08/26 23:50:53 savage - Jonas supplied another fix. - - Revision 1.33 2007/08/26 15:59:46 savage - Mac OS changes as suggested by Jonas Maebe - - Revision 1.32 2007/08/22 21:18:43 savage - Thanks to Dean for his MouseDelta patch. - - Revision 1.31 2007/05/29 21:30:48 savage - Changes as suggested by Almindor for 64bit compatibility. - - Revision 1.30 2007/05/29 19:31:03 savage - Fix to TSDL_Overlay structure - thanks David Pethes (aka imcold) - - Revision 1.29 2007/05/20 20:29:11 savage - Initial Changes to Handle 64 Bits - - Revision 1.26 2007/02/11 13:38:04 savage - Added Nintendo DS support - Thanks Dean. - - Revision 1.25 2006/12/02 00:12:52 savage - Updated to latest version - - Revision 1.24 2006/05/18 21:10:04 savage - Added 1.2.10 Changes - - Revision 1.23 2005/12/04 23:17:52 drellis - Added declaration of SInt8 and PSInt8 - - Revision 1.22 2005/05/24 21:59:03 savage - Re-arranged uses clause to work on Win32 and Linux, Thanks again Michalis. - - Revision 1.21 2005/05/22 18:42:31 savage - Changes as suggested by Michalis Kamburelis. Thanks again. - - Revision 1.20 2005/04/10 11:48:33 savage - Changes as suggested by Michalis, thanks. - - Revision 1.19 2005/01/05 01:47:06 savage - Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively. - - Revision 1.18 2005/01/04 23:14:41 savage - Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively. - - Revision 1.17 2005/01/03 18:40:59 savage - Updated Version number to reflect latest one - - Revision 1.16 2005/01/01 02:02:06 savage - Updated to v1.2.8 - - Revision 1.15 2004/12/24 18:57:11 savage - forgot to apply Michalis Kamburelis' patch to the implementation section. now fixed - - Revision 1.14 2004/12/23 23:42:18 savage - Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability. - - Revision 1.13 2004/09/30 22:31:59 savage - Updated with slightly different header comments - - Revision 1.12 2004/09/12 21:52:58 savage - Slight changes to fix some issues with the sdl classes. - - Revision 1.11 2004/08/14 22:54:30 savage - Updated so that Library name defines are correctly defined for MacOS X. - - Revision 1.10 2004/07/20 23:57:33 savage - Thanks to Paul Toth for spotting an error in the SDL Audio Convertion structures. - In TSDL_AudioCVT the filters variable should point to and array of pointers and not what I had there previously. - - Revision 1.9 2004/07/03 22:07:22 savage - Added Bitwise Manipulation Functions for TSDL_VideoInfo struct. - - Revision 1.8 2004/05/10 14:10:03 savage - Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ). - - Revision 1.7 2004/04/13 09:32:08 savage - Changed Shared object names back to just the .so extension to avoid conflicts on various Linux/Unix distros. Therefore developers will need to create Symbolic links to the actual Share Objects if necessary. - - Revision 1.6 2004/04/01 20:53:23 savage - Changed Linux Shared Object names so they reflect the Symbolic Links that are created when installing the RPMs from the SDL site. - - Revision 1.5 2004/02/22 15:32:10 savage - SDL_GetEnv Fix so it also works on FPC/Linux. Thanks to Rodrigo for pointing this out. - - Revision 1.4 2004/02/21 23:24:29 savage - SDL_GetEnv Fix so that it is not define twice for FPC. Thanks to Rene Hugentobler for pointing out this bug, - - Revision 1.3 2004/02/18 22:35:51 savage - Brought sdl.pas up to 1.2.7 compatability - Thus... - Added SDL_GL_STEREO, - SDL_GL_MULTISAMPLEBUFFERS, - SDL_GL_MULTISAMPLESAMPLES - - Add DLL/Shared object functions - function SDL_LoadObject( const sofile : PAnsiChar ) : Pointer; - - function SDL_LoadFunction( handle : Pointer; const name : PAnsiChar ) : Pointer; - - procedure SDL_UnloadObject( handle : Pointer ); - - Added function to create RWops from const memory: SDL_RWFromConstMem() - function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops; - - Ported SDL_cpuinfo.h so Now you can test for Specific CPU types. - - Revision 1.2 2004/02/17 21:37:12 savage - Tidying up of units - - Revision 1.1 2004/02/05 00:08:20 savage - Module 1.0 release - -} -{******************************************************************************} - -{$I jedi.inc} - -{$IFDEF MSWINDOWS} - {$DEFINE WINDOWS} -{$ENDIF} - -{$IFDEF FPC} - {$DEFINE HAS_TYPES} -{$ENDIF} - -interface - -uses -{$IFDEF HAS_TYPES} - Types, -{$ENDIF} - -{$IFDEF WINDOWS} - Windows; -{$ENDIF} - -{$IFDEF UNIX} - {$IFDEF FPC} - {$IFNDEF SKYOS} - pthreads, - {$ENDIF} - baseunix, - {$IFNDEF GP2X} - {$IFNDEF DARWIN} - {$IFNDEF SKYOS} - unix, - {$ELSE} - unix; - {$ENDIF} - {$ELSE} - unix; - {$ENDIF} - {$ELSE} - unix; - {$ENDIF} - {$IFNDEF GP2X} - {$IFNDEF DARWIN} - {$IFNDEF SKYOS} - x, - xlib; - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ELSE} - Libc, - Xlib; - {$ENDIF} -{$ENDIF} - -const -{$IFDEF WINDOWS} - {$IF Defined (CPUX86_64) or Defined(CPUX64)} - SDLLibName = 'SDL64.dll'; - {$ELSE} - SDLLibName = 'SDL.dll'; - {$IFEND} -{$ENDIF} - -{$IFDEF UNIX} -{$IFDEF DARWIN} - SDLLibName = 'libSDL-1.2.0.dylib'; -{$ELSE} - {$IFDEF FPC} - SDLLibName = 'libSDL.so'; - {$ELSE} - SDLLibName = 'libSDL-1.2.so.0'; - {$ENDIF} -{$ENDIF} -{$ENDIF} - -{$IFDEF MACOS} - SDLLibName = 'SDL'; - {$linklib libSDL} -{$ENDIF} - - // SDL_verion.h constants - // Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL - SDL_MAJOR_VERSION = 1; -{$EXTERNALSYM SDL_MAJOR_VERSION} - SDL_MINOR_VERSION = 2; -{$EXTERNALSYM SDL_MINOR_VERSION} - SDL_PATCHLEVEL = 13; -{$EXTERNALSYM SDL_PATCHLEVEL} - - // SDL.h constants - SDL_INIT_TIMER = $00000001; -{$EXTERNALSYM SDL_INIT_TIMER} - SDL_INIT_AUDIO = $00000010; -{$EXTERNALSYM SDL_INIT_AUDIO} - SDL_INIT_VIDEO = $00000020; -{$EXTERNALSYM SDL_INIT_VIDEO} - SDL_INIT_CDROM = $00000100; -{$EXTERNALSYM SDL_INIT_CDROM} - SDL_INIT_JOYSTICK = $00000200; -{$EXTERNALSYM SDL_INIT_JOYSTICK} - SDL_INIT_NOPARACHUTE = $00100000; // Don't catch fatal signals -{$EXTERNALSYM SDL_INIT_NOPARACHUTE} - SDL_INIT_EVENTTHREAD = $01000000; // Not supported on all OS's -{$EXTERNALSYM SDL_INIT_EVENTTHREAD} - SDL_INIT_EVERYTHING = $0000FFFF; -{$EXTERNALSYM SDL_INIT_EVERYTHING} - - // SDL_error.h constants - ERR_MAX_STRLEN = 128; -{$EXTERNALSYM ERR_MAX_STRLEN} - ERR_MAX_ARGS = 5; -{$EXTERNALSYM ERR_MAX_ARGS} - - // SDL_types.h constants - SDL_PRESSED = $01; -{$EXTERNALSYM SDL_PRESSED} - SDL_RELEASED = $00; -{$EXTERNALSYM SDL_RELEASED} - - // SDL_timer.h constants - // This is the OS scheduler timeslice, in milliseconds - SDL_TIMESLICE = 10; -{$EXTERNALSYM SDL_TIMESLICE} - // This is the maximum resolution of the SDL timer on all platforms - TIMER_RESOLUTION = 10; // Experimentally determined -{$EXTERNALSYM TIMER_RESOLUTION} - - // SDL_audio.h constants - AUDIO_U8 = $0008; // Unsigned 8-bit samples -{$EXTERNALSYM AUDIO_U8} - AUDIO_S8 = $8008; // Signed 8-bit samples -{$EXTERNALSYM AUDIO_S8} - AUDIO_U16LSB = $0010; // Unsigned 16-bit samples -{$EXTERNALSYM AUDIO_U16LSB} - AUDIO_S16LSB = $8010; // Signed 16-bit samples -{$EXTERNALSYM AUDIO_S16LSB} - AUDIO_U16MSB = $1010; // As above, but big-endian byte order -{$EXTERNALSYM AUDIO_U16MSB} - AUDIO_S16MSB = $9010; // As above, but big-endian byte order -{$EXTERNALSYM AUDIO_S16MSB} - AUDIO_U16 = AUDIO_U16LSB; -{$EXTERNALSYM AUDIO_U16} - AUDIO_S16 = AUDIO_S16LSB; -{$EXTERNALSYM AUDIO_S16} - - - // SDL_cdrom.h constants - // The maximum number of CD-ROM tracks on a disk - SDL_MAX_TRACKS = 99; -{$EXTERNALSYM SDL_MAX_TRACKS} - // The types of CD-ROM track possible - SDL_AUDIO_TRACK = $00; -{$EXTERNALSYM SDL_AUDIO_TRACK} - SDL_DATA_TRACK = $04; -{$EXTERNALSYM SDL_DATA_TRACK} - - // Conversion functions from frames to Minute/Second/Frames and vice versa - CD_FPS = 75; -{$EXTERNALSYM CD_FPS} - // SDL_byteorder.h constants - // The two types of endianness - SDL_LIL_ENDIAN = 1234; -{$EXTERNALSYM SDL_LIL_ENDIAN} - SDL_BIG_ENDIAN = 4321; -{$EXTERNALSYM SDL_BIG_ENDIAN} - -{$IFDEF IA32} - - SDL_BYTEORDER = SDL_LIL_ENDIAN; -{$EXTERNALSYM SDL_BYTEORDER} - // Native audio byte ordering - AUDIO_U16SYS = AUDIO_U16LSB; -{$EXTERNALSYM AUDIO_U16SYS} - AUDIO_S16SYS = AUDIO_S16LSB; -{$EXTERNALSYM AUDIO_S16SYS} - -{$ELSE} - - SDL_BYTEORDER = SDL_BIG_ENDIAN; -{$EXTERNALSYM SDL_BYTEORDER} - // Native audio byte ordering - AUDIO_U16SYS = AUDIO_U16MSB; -{$EXTERNALSYM AUDIO_U16SYS} - AUDIO_S16SYS = AUDIO_S16MSB; -{$EXTERNALSYM AUDIO_S16SYS} - -{$ENDIF} - - - SDL_MIX_MAXVOLUME = 128; -{$EXTERNALSYM SDL_MIX_MAXVOLUME} - - // SDL_joystick.h constants - MAX_JOYSTICKS = 2; // only 2 are supported in the multimedia API -{$EXTERNALSYM MAX_JOYSTICKS} - MAX_AXES = 6; // each joystick can have up to 6 axes -{$EXTERNALSYM MAX_AXES} - MAX_BUTTONS = 32; // and 32 buttons -{$EXTERNALSYM MAX_BUTTONS} - AXIS_MIN = -32768; // minimum value for axis coordinate -{$EXTERNALSYM AXIS_MIN} - AXIS_MAX = 32767; // maximum value for axis coordinate -{$EXTERNALSYM AXIS_MAX} - JOY_AXIS_THRESHOLD = (((AXIS_MAX) - (AXIS_MIN)) / 100); // 1% motion -{$EXTERNALSYM JOY_AXIS_THRESHOLD} - //JOY_BUTTON_FLAG(n) (1<<n) - // array to hold joystick ID values - //static UInt SYS_JoystickID[MAX_JOYSTICKS]; - //static JOYCAPS SYS_Joystick[MAX_JOYSTICKS]; - - { Get the current state of a POV hat on a joystick - The return value is one of the following positions: } - SDL_HAT_CENTERED = $00; -{$EXTERNALSYM SDL_HAT_CENTERED} - SDL_HAT_UP = $01; -{$EXTERNALSYM SDL_HAT_UP} - SDL_HAT_RIGHT = $02; -{$EXTERNALSYM SDL_HAT_RIGHT} - SDL_HAT_DOWN = $04; -{$EXTERNALSYM SDL_HAT_DOWN} - SDL_HAT_LEFT = $08; -{$EXTERNALSYM SDL_HAT_LEFT} - SDL_HAT_RIGHTUP = SDL_HAT_RIGHT or SDL_HAT_UP; -{$EXTERNALSYM SDL_HAT_RIGHTUP} - SDL_HAT_RIGHTDOWN = SDL_HAT_RIGHT or SDL_HAT_DOWN; -{$EXTERNALSYM SDL_HAT_RIGHTDOWN} - SDL_HAT_LEFTUP = SDL_HAT_LEFT or SDL_HAT_UP; -{$EXTERNALSYM SDL_HAT_LEFTUP} - SDL_HAT_LEFTDOWN = SDL_HAT_LEFT or SDL_HAT_DOWN; -{$EXTERNALSYM SDL_HAT_LEFTDOWN} - - // SDL_events.h constants - SDL_NOEVENT = 0; // Unused (do not remove) -{$EXTERNALSYM SDL_NOEVENT} - SDL_ACTIVEEVENT = 1; // Application loses/gains visibility -{$EXTERNALSYM SDL_ACTIVEEVENT} - SDL_KEYDOWN = 2; // Keys pressed -{$EXTERNALSYM SDL_KEYDOWN} - SDL_KEYUP = 3; // Keys released -{$EXTERNALSYM SDL_KEYUP} - SDL_MOUSEMOTION = 4; // Mouse moved -{$EXTERNALSYM SDL_MOUSEMOTION} - SDL_MOUSEBUTTONDOWN = 5; // Mouse button pressed -{$EXTERNALSYM SDL_MOUSEBUTTONDOWN} - SDL_MOUSEBUTTONUP = 6; // Mouse button released -{$EXTERNALSYM SDL_MOUSEBUTTONUP} - SDL_JOYAXISMOTION = 7; // Joystick axis motion -{$EXTERNALSYM SDL_JOYAXISMOTION} - SDL_JOYBALLMOTION = 8; // Joystick trackball motion -{$EXTERNALSYM SDL_JOYBALLMOTION} - SDL_JOYHATMOTION = 9; // Joystick hat position change -{$EXTERNALSYM SDL_JOYHATMOTION} - SDL_JOYBUTTONDOWN = 10; // Joystick button pressed -{$EXTERNALSYM SDL_JOYBUTTONDOWN} - SDL_JOYBUTTONUP = 11; // Joystick button released -{$EXTERNALSYM SDL_JOYBUTTONUP} - SDL_QUITEV = 12; // User-requested quit ( Changed due to procedure conflict ) -{$EXTERNALSYM SDL_QUIT} - SDL_SYSWMEVENT = 13; // System specific event -{$EXTERNALSYM SDL_SYSWMEVENT} - SDL_EVENT_RESERVEDA = 14; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVEDA} - SDL_EVENT_RESERVED = 15; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVED} - SDL_VIDEORESIZE = 16; // User resized video mode -{$EXTERNALSYM SDL_VIDEORESIZE} - SDL_VIDEOEXPOSE = 17; // Screen needs to be redrawn -{$EXTERNALSYM SDL_VIDEOEXPOSE} - SDL_EVENT_RESERVED2 = 18; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVED2} - SDL_EVENT_RESERVED3 = 19; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVED3} - SDL_EVENT_RESERVED4 = 20; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVED4} - SDL_EVENT_RESERVED5 = 21; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVED5} - SDL_EVENT_RESERVED6 = 22; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVED6} - SDL_EVENT_RESERVED7 = 23; // Reserved for future use.. -{$EXTERNALSYM SDL_EVENT_RESERVED7} - // Events SDL_USEREVENT through SDL_MAXEVENTS-1 are for your use - SDL_USEREVENT = 24; -{$EXTERNALSYM SDL_USEREVENT} - // This last event is only for bounding internal arrays - // It is the number of bits in the event mask datatype -- UInt32 - SDL_NUMEVENTS = 32; -{$EXTERNALSYM SDL_NUMEVENTS} - - SDL_ALLEVENTS = $FFFFFFFF; -{$EXTERNALSYM SDL_ALLEVENTS} - - SDL_ACTIVEEVENTMASK = 1 shl SDL_ACTIVEEVENT; -{$EXTERNALSYM SDL_ACTIVEEVENTMASK} - SDL_KEYDOWNMASK = 1 shl SDL_KEYDOWN; -{$EXTERNALSYM SDL_KEYDOWNMASK} - SDL_KEYUPMASK = 1 shl SDL_KEYUP; -{$EXTERNALSYM SDL_KEYUPMASK} - SDL_MOUSEMOTIONMASK = 1 shl SDL_MOUSEMOTION; -{$EXTERNALSYM SDL_MOUSEMOTIONMASK} - SDL_MOUSEBUTTONDOWNMASK = 1 shl SDL_MOUSEBUTTONDOWN; -{$EXTERNALSYM SDL_MOUSEBUTTONDOWNMASK} - SDL_MOUSEBUTTONUPMASK = 1 shl SDL_MOUSEBUTTONUP; -{$EXTERNALSYM SDL_MOUSEBUTTONUPMASK} - SDL_MOUSEEVENTMASK = 1 shl SDL_MOUSEMOTION or - 1 shl SDL_MOUSEBUTTONDOWN or - 1 shl SDL_MOUSEBUTTONUP; -{$EXTERNALSYM SDL_MOUSEEVENTMASK} - SDL_JOYAXISMOTIONMASK = 1 shl SDL_JOYAXISMOTION; -{$EXTERNALSYM SDL_JOYAXISMOTIONMASK} - SDL_JOYBALLMOTIONMASK = 1 shl SDL_JOYBALLMOTION; -{$EXTERNALSYM SDL_JOYBALLMOTIONMASK} - SDL_JOYHATMOTIONMASK = 1 shl SDL_JOYHATMOTION; -{$EXTERNALSYM SDL_JOYHATMOTIONMASK} - SDL_JOYBUTTONDOWNMASK = 1 shl SDL_JOYBUTTONDOWN; -{$EXTERNALSYM SDL_JOYBUTTONDOWNMASK} - SDL_JOYBUTTONUPMASK = 1 shl SDL_JOYBUTTONUP; -{$EXTERNALSYM SDL_JOYBUTTONUPMASK} - SDL_JOYEVENTMASK = 1 shl SDL_JOYAXISMOTION or - 1 shl SDL_JOYBALLMOTION or - 1 shl SDL_JOYHATMOTION or - 1 shl SDL_JOYBUTTONDOWN or - 1 shl SDL_JOYBUTTONUP; -{$EXTERNALSYM SDL_JOYEVENTMASK} - SDL_VIDEORESIZEMASK = 1 shl SDL_VIDEORESIZE; -{$EXTERNALSYM SDL_VIDEORESIZEMASK} - SDL_QUITMASK = 1 shl SDL_QUITEV; -{$EXTERNALSYM SDL_QUITMASK} - SDL_SYSWMEVENTMASK = 1 shl SDL_SYSWMEVENT; -{$EXTERNALSYM SDL_SYSWMEVENTMASK} - - { This function allows you to set the state of processing certain events. - If 'state' is set to SDL_IGNORE, that event will be automatically dropped - from the event queue and will not event be filtered. - If 'state' is set to SDL_ENABLE, that event will be processed normally. - If 'state' is set to SDL_QUERY, SDL_EventState() will return the - current processing state of the specified event. } - - SDL_QUERY = -1; -{$EXTERNALSYM SDL_QUERY} - SDL_IGNORE = 0; -{$EXTERNALSYM SDL_IGNORE} - SDL_DISABLE = 0; -{$EXTERNALSYM SDL_DISABLE} - SDL_ENABLE = 1; -{$EXTERNALSYM SDL_ENABLE} - - //SDL_keyboard.h constants - // This is the mask which refers to all hotkey bindings - SDL_ALL_HOTKEYS = $FFFFFFFF; -{$EXTERNALSYM SDL_ALL_HOTKEYS} - -{ Enable/Disable keyboard repeat. Keyboard repeat defaults to off. - 'delay' is the initial delay in ms between the time when a key is - pressed, and keyboard repeat begins. - 'interval' is the time in ms between keyboard repeat events. } - - SDL_DEFAULT_REPEAT_DELAY = 500; -{$EXTERNALSYM SDL_DEFAULT_REPEAT_DELAY} - SDL_DEFAULT_REPEAT_INTERVAL = 30; -{$EXTERNALSYM SDL_DEFAULT_REPEAT_INTERVAL} - - // The keyboard syms have been cleverly chosen to map to ASCII - SDLK_UNKNOWN = 0; -{$EXTERNALSYM SDLK_UNKNOWN} - SDLK_FIRST = 0; -{$EXTERNALSYM SDLK_FIRST} - SDLK_BACKSPACE = 8; -{$EXTERNALSYM SDLK_BACKSPACE} - SDLK_TAB = 9; -{$EXTERNALSYM SDLK_TAB} - SDLK_CLEAR = 12; -{$EXTERNALSYM SDLK_CLEAR} - SDLK_RETURN = 13; -{$EXTERNALSYM SDLK_RETURN} - SDLK_PAUSE = 19; -{$EXTERNALSYM SDLK_PAUSE} - SDLK_ESCAPE = 27; -{$EXTERNALSYM SDLK_ESCAPE} - SDLK_SPACE = 32; -{$EXTERNALSYM SDLK_SPACE} - SDLK_EXCLAIM = 33; -{$EXTERNALSYM SDLK_EXCLAIM} - SDLK_QUOTEDBL = 34; -{$EXTERNALSYM SDLK_QUOTEDBL} - SDLK_HASH = 35; -{$EXTERNALSYM SDLK_HASH} - SDLK_DOLLAR = 36; -{$EXTERNALSYM SDLK_DOLLAR} - SDLK_AMPERSAND = 38; -{$EXTERNALSYM SDLK_AMPERSAND} - SDLK_QUOTE = 39; -{$EXTERNALSYM SDLK_QUOTE} - SDLK_LEFTPAREN = 40; -{$EXTERNALSYM SDLK_LEFTPAREN} - SDLK_RIGHTPAREN = 41; -{$EXTERNALSYM SDLK_RIGHTPAREN} - SDLK_ASTERISK = 42; -{$EXTERNALSYM SDLK_ASTERISK} - SDLK_PLUS = 43; -{$EXTERNALSYM SDLK_PLUS} - SDLK_COMMA = 44; -{$EXTERNALSYM SDLK_COMMA} - SDLK_MINUS = 45; -{$EXTERNALSYM SDLK_MINUS} - SDLK_PERIOD = 46; -{$EXTERNALSYM SDLK_PERIOD} - SDLK_SLASH = 47; -{$EXTERNALSYM SDLK_SLASH} - SDLK_0 = 48; -{$EXTERNALSYM SDLK_0} - SDLK_1 = 49; -{$EXTERNALSYM SDLK_1} - SDLK_2 = 50; -{$EXTERNALSYM SDLK_2} - SDLK_3 = 51; -{$EXTERNALSYM SDLK_3} - SDLK_4 = 52; -{$EXTERNALSYM SDLK_4} - SDLK_5 = 53; -{$EXTERNALSYM SDLK_5} - SDLK_6 = 54; -{$EXTERNALSYM SDLK_6} - SDLK_7 = 55; -{$EXTERNALSYM SDLK_7} - SDLK_8 = 56; -{$EXTERNALSYM SDLK_8} - SDLK_9 = 57; -{$EXTERNALSYM SDLK_9} - SDLK_COLON = 58; -{$EXTERNALSYM SDLK_COLON} - SDLK_SEMICOLON = 59; -{$EXTERNALSYM SDLK_SEMICOLON} - SDLK_LESS = 60; -{$EXTERNALSYM SDLK_LESS} - SDLK_EQUALS = 61; -{$EXTERNALSYM SDLK_EQUALS} - SDLK_GREATER = 62; -{$EXTERNALSYM SDLK_GREATER} - SDLK_QUESTION = 63; -{$EXTERNALSYM SDLK_QUESTION} - SDLK_AT = 64; -{$EXTERNALSYM SDLK_AT} - - { Skip uppercase letters } - - SDLK_LEFTBRACKET = 91; -{$EXTERNALSYM SDLK_LEFTBRACKET} - SDLK_BACKSLASH = 92; -{$EXTERNALSYM SDLK_BACKSLASH} - SDLK_RIGHTBRACKET = 93; -{$EXTERNALSYM SDLK_RIGHTBRACKET} - SDLK_CARET = 94; -{$EXTERNALSYM SDLK_CARET} - SDLK_UNDERSCORE = 95; -{$EXTERNALSYM SDLK_UNDERSCORE} - SDLK_BACKQUOTE = 96; -{$EXTERNALSYM SDLK_BACKQUOTE} - SDLK_a = 97; -{$EXTERNALSYM SDLK_a} - SDLK_b = 98; -{$EXTERNALSYM SDLK_b} - SDLK_c = 99; -{$EXTERNALSYM SDLK_c} - SDLK_d = 100; -{$EXTERNALSYM SDLK_d} - SDLK_e = 101; -{$EXTERNALSYM SDLK_e} - SDLK_f = 102; -{$EXTERNALSYM SDLK_f} - SDLK_g = 103; -{$EXTERNALSYM SDLK_g} - SDLK_h = 104; -{$EXTERNALSYM SDLK_h} - SDLK_i = 105; -{$EXTERNALSYM SDLK_i} - SDLK_j = 106; -{$EXTERNALSYM SDLK_j} - SDLK_k = 107; -{$EXTERNALSYM SDLK_k} - SDLK_l = 108; -{$EXTERNALSYM SDLK_l} - SDLK_m = 109; -{$EXTERNALSYM SDLK_m} - SDLK_n = 110; -{$EXTERNALSYM SDLK_n} - SDLK_o = 111; -{$EXTERNALSYM SDLK_o} - SDLK_p = 112; -{$EXTERNALSYM SDLK_p} - SDLK_q = 113; -{$EXTERNALSYM SDLK_q} - SDLK_r = 114; -{$EXTERNALSYM SDLK_r} - SDLK_s = 115; -{$EXTERNALSYM SDLK_s} - SDLK_t = 116; -{$EXTERNALSYM SDLK_t} - SDLK_u = 117; -{$EXTERNALSYM SDLK_u} - SDLK_v = 118; -{$EXTERNALSYM SDLK_v} - SDLK_w = 119; -{$EXTERNALSYM SDLK_w} - SDLK_x = 120; -{$EXTERNALSYM SDLK_x} - SDLK_y = 121; -{$EXTERNALSYM SDLK_y} - SDLK_z = 122; -{$EXTERNALSYM SDLK_z} - SDLK_DELETE = 127; -{$EXTERNALSYM SDLK_DELETE} - // End of ASCII mapped keysyms - - // International keyboard syms - SDLK_WORLD_0 = 160; // 0xA0 -{$EXTERNALSYM SDLK_WORLD_0} - SDLK_WORLD_1 = 161; -{$EXTERNALSYM SDLK_WORLD_1} - SDLK_WORLD_2 = 162; -{$EXTERNALSYM SDLK_WORLD_2} - SDLK_WORLD_3 = 163; -{$EXTERNALSYM SDLK_WORLD_3} - SDLK_WORLD_4 = 164; -{$EXTERNALSYM SDLK_WORLD_4} - SDLK_WORLD_5 = 165; -{$EXTERNALSYM SDLK_WORLD_5} - SDLK_WORLD_6 = 166; -{$EXTERNALSYM SDLK_WORLD_6} - SDLK_WORLD_7 = 167; -{$EXTERNALSYM SDLK_WORLD_7} - SDLK_WORLD_8 = 168; -{$EXTERNALSYM SDLK_WORLD_8} - SDLK_WORLD_9 = 169; -{$EXTERNALSYM SDLK_WORLD_9} - SDLK_WORLD_10 = 170; -{$EXTERNALSYM SDLK_WORLD_10} - SDLK_WORLD_11 = 171; -{$EXTERNALSYM SDLK_WORLD_11} - SDLK_WORLD_12 = 172; -{$EXTERNALSYM SDLK_WORLD_12} - SDLK_WORLD_13 = 173; -{$EXTERNALSYM SDLK_WORLD_13} - SDLK_WORLD_14 = 174; -{$EXTERNALSYM SDLK_WORLD_14} - SDLK_WORLD_15 = 175; -{$EXTERNALSYM SDLK_WORLD_15} - SDLK_WORLD_16 = 176; -{$EXTERNALSYM SDLK_WORLD_16} - SDLK_WORLD_17 = 177; -{$EXTERNALSYM SDLK_WORLD_17} - SDLK_WORLD_18 = 178; -{$EXTERNALSYM SDLK_WORLD_18} - SDLK_WORLD_19 = 179; -{$EXTERNALSYM SDLK_WORLD_19} - SDLK_WORLD_20 = 180; -{$EXTERNALSYM SDLK_WORLD_20} - SDLK_WORLD_21 = 181; -{$EXTERNALSYM SDLK_WORLD_21} - SDLK_WORLD_22 = 182; -{$EXTERNALSYM SDLK_WORLD_22} - SDLK_WORLD_23 = 183; -{$EXTERNALSYM SDLK_WORLD_23} - SDLK_WORLD_24 = 184; -{$EXTERNALSYM SDLK_WORLD_24} - SDLK_WORLD_25 = 185; -{$EXTERNALSYM SDLK_WORLD_25} - SDLK_WORLD_26 = 186; -{$EXTERNALSYM SDLK_WORLD_26} - SDLK_WORLD_27 = 187; -{$EXTERNALSYM SDLK_WORLD_27} - SDLK_WORLD_28 = 188; -{$EXTERNALSYM SDLK_WORLD_28} - SDLK_WORLD_29 = 189; -{$EXTERNALSYM SDLK_WORLD_29} - SDLK_WORLD_30 = 190; -{$EXTERNALSYM SDLK_WORLD_30} - SDLK_WORLD_31 = 191; -{$EXTERNALSYM SDLK_WORLD_31} - SDLK_WORLD_32 = 192; -{$EXTERNALSYM SDLK_WORLD_32} - SDLK_WORLD_33 = 193; -{$EXTERNALSYM SDLK_WORLD_33} - SDLK_WORLD_34 = 194; -{$EXTERNALSYM SDLK_WORLD_34} - SDLK_WORLD_35 = 195; -{$EXTERNALSYM SDLK_WORLD_35} - SDLK_WORLD_36 = 196; -{$EXTERNALSYM SDLK_WORLD_36} - SDLK_WORLD_37 = 197; -{$EXTERNALSYM SDLK_WORLD_37} - SDLK_WORLD_38 = 198; -{$EXTERNALSYM SDLK_WORLD_38} - SDLK_WORLD_39 = 199; -{$EXTERNALSYM SDLK_WORLD_39} - SDLK_WORLD_40 = 200; -{$EXTERNALSYM SDLK_WORLD_40} - SDLK_WORLD_41 = 201; -{$EXTERNALSYM SDLK_WORLD_41} - SDLK_WORLD_42 = 202; -{$EXTERNALSYM SDLK_WORLD_42} - SDLK_WORLD_43 = 203; -{$EXTERNALSYM SDLK_WORLD_43} - SDLK_WORLD_44 = 204; -{$EXTERNALSYM SDLK_WORLD_44} - SDLK_WORLD_45 = 205; -{$EXTERNALSYM SDLK_WORLD_45} - SDLK_WORLD_46 = 206; -{$EXTERNALSYM SDLK_WORLD_46} - SDLK_WORLD_47 = 207; -{$EXTERNALSYM SDLK_WORLD_47} - SDLK_WORLD_48 = 208; -{$EXTERNALSYM SDLK_WORLD_48} - SDLK_WORLD_49 = 209; -{$EXTERNALSYM SDLK_WORLD_49} - SDLK_WORLD_50 = 210; -{$EXTERNALSYM SDLK_WORLD_50} - SDLK_WORLD_51 = 211; -{$EXTERNALSYM SDLK_WORLD_51} - SDLK_WORLD_52 = 212; -{$EXTERNALSYM SDLK_WORLD_52} - SDLK_WORLD_53 = 213; -{$EXTERNALSYM SDLK_WORLD_53} - SDLK_WORLD_54 = 214; -{$EXTERNALSYM SDLK_WORLD_54} - SDLK_WORLD_55 = 215; -{$EXTERNALSYM SDLK_WORLD_55} - SDLK_WORLD_56 = 216; -{$EXTERNALSYM SDLK_WORLD_56} - SDLK_WORLD_57 = 217; -{$EXTERNALSYM SDLK_WORLD_57} - SDLK_WORLD_58 = 218; -{$EXTERNALSYM SDLK_WORLD_58} - SDLK_WORLD_59 = 219; -{$EXTERNALSYM SDLK_WORLD_59} - SDLK_WORLD_60 = 220; -{$EXTERNALSYM SDLK_WORLD_60} - SDLK_WORLD_61 = 221; -{$EXTERNALSYM SDLK_WORLD_61} - SDLK_WORLD_62 = 222; -{$EXTERNALSYM SDLK_WORLD_62} - SDLK_WORLD_63 = 223; -{$EXTERNALSYM SDLK_WORLD_63} - SDLK_WORLD_64 = 224; -{$EXTERNALSYM SDLK_WORLD_64} - SDLK_WORLD_65 = 225; -{$EXTERNALSYM SDLK_WORLD_65} - SDLK_WORLD_66 = 226; -{$EXTERNALSYM SDLK_WORLD_66} - SDLK_WORLD_67 = 227; -{$EXTERNALSYM SDLK_WORLD_67} - SDLK_WORLD_68 = 228; -{$EXTERNALSYM SDLK_WORLD_68} - SDLK_WORLD_69 = 229; -{$EXTERNALSYM SDLK_WORLD_69} - SDLK_WORLD_70 = 230; -{$EXTERNALSYM SDLK_WORLD_70} - SDLK_WORLD_71 = 231; -{$EXTERNALSYM SDLK_WORLD_71} - SDLK_WORLD_72 = 232; -{$EXTERNALSYM SDLK_WORLD_72} - SDLK_WORLD_73 = 233; -{$EXTERNALSYM SDLK_WORLD_73} - SDLK_WORLD_74 = 234; -{$EXTERNALSYM SDLK_WORLD_74} - SDLK_WORLD_75 = 235; -{$EXTERNALSYM SDLK_WORLD_75} - SDLK_WORLD_76 = 236; -{$EXTERNALSYM SDLK_WORLD_76} - SDLK_WORLD_77 = 237; -{$EXTERNALSYM SDLK_WORLD_77} - SDLK_WORLD_78 = 238; -{$EXTERNALSYM SDLK_WORLD_78} - SDLK_WORLD_79 = 239; -{$EXTERNALSYM SDLK_WORLD_79} - SDLK_WORLD_80 = 240; -{$EXTERNALSYM SDLK_WORLD_80} - SDLK_WORLD_81 = 241; -{$EXTERNALSYM SDLK_WORLD_81} - SDLK_WORLD_82 = 242; -{$EXTERNALSYM SDLK_WORLD_82} - SDLK_WORLD_83 = 243; -{$EXTERNALSYM SDLK_WORLD_83} - SDLK_WORLD_84 = 244; -{$EXTERNALSYM SDLK_WORLD_84} - SDLK_WORLD_85 = 245; -{$EXTERNALSYM SDLK_WORLD_85} - SDLK_WORLD_86 = 246; -{$EXTERNALSYM SDLK_WORLD_86} - SDLK_WORLD_87 = 247; -{$EXTERNALSYM SDLK_WORLD_87} - SDLK_WORLD_88 = 248; -{$EXTERNALSYM SDLK_WORLD_88} - SDLK_WORLD_89 = 249; -{$EXTERNALSYM SDLK_WORLD_89} - SDLK_WORLD_90 = 250; -{$EXTERNALSYM SDLK_WORLD_90} - SDLK_WORLD_91 = 251; -{$EXTERNALSYM SDLK_WORLD_91} - SDLK_WORLD_92 = 252; -{$EXTERNALSYM SDLK_WORLD_92} - SDLK_WORLD_93 = 253; -{$EXTERNALSYM SDLK_WORLD_93} - SDLK_WORLD_94 = 254; -{$EXTERNALSYM SDLK_WORLD_94} - SDLK_WORLD_95 = 255; // 0xFF -{$EXTERNALSYM SDLK_WORLD_95} - - // Numeric keypad - SDLK_KP0 = 256; -{$EXTERNALSYM SDLK_KP0} - SDLK_KP1 = 257; -{$EXTERNALSYM SDLK_KP1} - SDLK_KP2 = 258; -{$EXTERNALSYM SDLK_KP2} - SDLK_KP3 = 259; -{$EXTERNALSYM SDLK_KP3} - SDLK_KP4 = 260; -{$EXTERNALSYM SDLK_KP4} - SDLK_KP5 = 261; -{$EXTERNALSYM SDLK_KP5} - SDLK_KP6 = 262; -{$EXTERNALSYM SDLK_KP6} - SDLK_KP7 = 263; -{$EXTERNALSYM SDLK_KP7} - SDLK_KP8 = 264; -{$EXTERNALSYM SDLK_KP8} - SDLK_KP9 = 265; -{$EXTERNALSYM SDLK_KP9} - SDLK_KP_PERIOD = 266; -{$EXTERNALSYM SDLK_KP_PERIOD} - SDLK_KP_DIVIDE = 267; -{$EXTERNALSYM SDLK_KP_DIVIDE} - SDLK_KP_MULTIPLY = 268; -{$EXTERNALSYM SDLK_KP_MULTIPLY} - SDLK_KP_MINUS = 269; -{$EXTERNALSYM SDLK_KP_MINUS} - SDLK_KP_PLUS = 270; -{$EXTERNALSYM SDLK_KP_PLUS} - SDLK_KP_ENTER = 271; -{$EXTERNALSYM SDLK_KP_ENTER} - SDLK_KP_EQUALS = 272; -{$EXTERNALSYM SDLK_KP_EQUALS} - - // Arrows + Home/End pad - SDLK_UP = 273; -{$EXTERNALSYM SDLK_UP} - SDLK_DOWN = 274; -{$EXTERNALSYM SDLK_DOWN} - SDLK_RIGHT = 275; -{$EXTERNALSYM SDLK_RIGHT} - SDLK_LEFT = 276; -{$EXTERNALSYM SDLK_LEFT} - SDLK_INSERT = 277; -{$EXTERNALSYM SDLK_INSERT} - SDLK_HOME = 278; -{$EXTERNALSYM SDLK_HOME} - SDLK_END = 279; -{$EXTERNALSYM SDLK_END} - SDLK_PAGEUP = 280; -{$EXTERNALSYM SDLK_PAGEUP} - SDLK_PAGEDOWN = 281; -{$EXTERNALSYM SDLK_PAGEDOWN} - - // Function keys - SDLK_F1 = 282; -{$EXTERNALSYM SDLK_F1} - SDLK_F2 = 283; -{$EXTERNALSYM SDLK_F2} - SDLK_F3 = 284; -{$EXTERNALSYM SDLK_F3} - SDLK_F4 = 285; -{$EXTERNALSYM SDLK_F4} - SDLK_F5 = 286; -{$EXTERNALSYM SDLK_F5} - SDLK_F6 = 287; -{$EXTERNALSYM SDLK_F6} - SDLK_F7 = 288; -{$EXTERNALSYM SDLK_F7} - SDLK_F8 = 289; -{$EXTERNALSYM SDLK_F8} - SDLK_F9 = 290; -{$EXTERNALSYM SDLK_F9} - SDLK_F10 = 291; -{$EXTERNALSYM SDLK_F10} - SDLK_F11 = 292; -{$EXTERNALSYM SDLK_F11} - SDLK_F12 = 293; -{$EXTERNALSYM SDLK_F12} - SDLK_F13 = 294; -{$EXTERNALSYM SDLK_F13} - SDLK_F14 = 295; -{$EXTERNALSYM SDLK_F14} - SDLK_F15 = 296; -{$EXTERNALSYM SDLK_F15} - - // Key state modifier keys - SDLK_NUMLOCK = 300; -{$EXTERNALSYM SDLK_NUMLOCK} - SDLK_CAPSLOCK = 301; -{$EXTERNALSYM SDLK_CAPSLOCK} - SDLK_SCROLLOCK = 302; -{$EXTERNALSYM SDLK_SCROLLOCK} - SDLK_RSHIFT = 303; -{$EXTERNALSYM SDLK_RSHIFT} - SDLK_LSHIFT = 304; -{$EXTERNALSYM SDLK_LSHIFT} - SDLK_RCTRL = 305; -{$EXTERNALSYM SDLK_RCTRL} - SDLK_LCTRL = 306; -{$EXTERNALSYM SDLK_LCTRL} - SDLK_RALT = 307; -{$EXTERNALSYM SDLK_RALT} - SDLK_LALT = 308; -{$EXTERNALSYM SDLK_LALT} - SDLK_RMETA = 309; -{$EXTERNALSYM SDLK_RMETA} - SDLK_LMETA = 310; -{$EXTERNALSYM SDLK_LMETA} - SDLK_LSUPER = 311; // Left "Windows" key -{$EXTERNALSYM SDLK_LSUPER} - SDLK_RSUPER = 312; // Right "Windows" key -{$EXTERNALSYM SDLK_RSUPER} - SDLK_MODE = 313; // "Alt Gr" key -{$EXTERNALSYM SDLK_MODE} - SDLK_COMPOSE = 314; // Multi-key compose key -{$EXTERNALSYM SDLK_COMPOSE} - - // Miscellaneous function keys - SDLK_HELP = 315; -{$EXTERNALSYM SDLK_HELP} - SDLK_PRINT = 316; -{$EXTERNALSYM SDLK_PRINT} - SDLK_SYSREQ = 317; -{$EXTERNALSYM SDLK_SYSREQ} - SDLK_BREAK = 318; -{$EXTERNALSYM SDLK_BREAK} - SDLK_MENU = 319; -{$EXTERNALSYM SDLK_MENU} - SDLK_POWER = 320; // Power Macintosh power key -{$EXTERNALSYM SDLK_POWER} - SDLK_EURO = 321; // Some european keyboards -{$EXTERNALSYM SDLK_EURO} - -{$IFDEF GP2X} -SDLK_GP2X_UP = 0; -{$EXTERNALSYM SDLK_GP2X_UP} -SDLK_GP2X_UPLEFT = 1; -{$EXTERNALSYM SDLK_GP2X_UPLEFT} -SDLK_GP2X_LEFT = 2; -{$EXTERNALSYM SDLK_GP2X_LEFT} -SDLK_GP2X_DOWNLEFT = 3; -{$EXTERNALSYM SDLK_GP2X_DOWNLEFT} -SDLK_GP2X_DOWN = 4; -{$EXTERNALSYM SDLK_GP2X_DOWN} -SDLK_GP2X_DOWNRIGHT = 5; -{$EXTERNALSYM SDLK_GP2X_DOWNRIGHT} -SDLK_GP2X_RIGHT = 6; -{$EXTERNALSYM SDLK_GP2X_RIGHT} -SDLK_GP2X_UPRIGHT = 7; -{$EXTERNALSYM SDLK_GP2X_UPRIGHT} -SDLK_GP2X_START = 8; -{$EXTERNALSYM SDLK_GP2X_START} -SDLK_GP2X_SELECT = 9; -{$EXTERNALSYM SDLK_GP2X_SELECT} -SDLK_GP2X_L = 10; -{$EXTERNALSYM SDLK_GP2X_L} -SDLK_GP2X_R = 11; -{$EXTERNALSYM SDLK_GP2X_R} -SDLK_GP2X_A = 12; -{$EXTERNALSYM SDLK_GP2X_A} -SDLK_GP2X_B = 13; -{$EXTERNALSYM SDLK_GP2X_B} -SDLK_GP2X_Y = 14; -{$EXTERNALSYM SDLK_GP2X_Y} -SDLK_GP2X_X = 15; -{$EXTERNALSYM SDLK_GP2X_X} -SDLK_GP2X_VOLUP = 16; -{$EXTERNALSYM SDLK_GP2X_VOLUP} -SDLK_GP2X_VOLDOWN = 17; -{$EXTERNALSYM SDLK_GP2X_VOLDOWN} -SDLK_GP2X_CLICK = 18; -{$EXTERNALSYM SDLK_GP2X_CLICK} -{$ENDIF} - - // Enumeration of valid key mods (possibly OR'd together) - KMOD_NONE = $0000; -{$EXTERNALSYM KMOD_NONE} - KMOD_LSHIFT = $0001; -{$EXTERNALSYM KMOD_LSHIFT} - KMOD_RSHIFT = $0002; -{$EXTERNALSYM KMOD_RSHIFT} - KMOD_LCTRL = $0040; -{$EXTERNALSYM KMOD_LCTRL} - KMOD_RCTRL = $0080; -{$EXTERNALSYM KMOD_RCTRL} - KMOD_LALT = $0100; -{$EXTERNALSYM KMOD_LALT} - KMOD_RALT = $0200; -{$EXTERNALSYM KMOD_RALT} - KMOD_LMETA = $0400; -{$EXTERNALSYM KMOD_LMETA} - KMOD_RMETA = $0800; -{$EXTERNALSYM KMOD_RMETA} - KMOD_NUM = $1000; -{$EXTERNALSYM KMOD_NUM} - KMOD_CAPS = $2000; -{$EXTERNALSYM KMOD_CAPS} - KMOD_MODE = 44000; -{$EXTERNALSYM KMOD_MODE} - KMOD_RESERVED = $8000; -{$EXTERNALSYM KMOD_RESERVED} - - KMOD_CTRL = (KMOD_LCTRL or KMOD_RCTRL); -{$EXTERNALSYM KMOD_CTRL} - KMOD_SHIFT = (KMOD_LSHIFT or KMOD_RSHIFT); -{$EXTERNALSYM KMOD_SHIFT} - KMOD_ALT = (KMOD_LALT or KMOD_RALT); -{$EXTERNALSYM KMOD_ALT} - KMOD_META = (KMOD_LMETA or KMOD_RMETA); -{$EXTERNALSYM KMOD_META} - - //SDL_video.h constants - // Transparency definitions: These define alpha as the opacity of a surface */ - SDL_ALPHA_OPAQUE = 255; -{$EXTERNALSYM SDL_ALPHA_OPAQUE} - SDL_ALPHA_TRANSPARENT = 0; -{$EXTERNALSYM SDL_ALPHA_TRANSPARENT} - - // These are the currently supported flags for the SDL_surface - // Available for SDL_CreateRGBSurface() or SDL_SetVideoMode() - SDL_SWSURFACE = $00000000; // Surface is in system memory -{$EXTERNALSYM SDL_SWSURFACE} - SDL_HWSURFACE = $00000001; // Surface is in video memory -{$EXTERNALSYM SDL_HWSURFACE} - SDL_ASYNCBLIT = $00000004; // Use asynchronous blits if possible -{$EXTERNALSYM SDL_ASYNCBLIT} - // Available for SDL_SetVideoMode() - SDL_ANYFORMAT = $10000000; // Allow any video depth/pixel-format -{$EXTERNALSYM SDL_ANYFORMAT} - SDL_HWPALETTE = $20000000; // Surface has exclusive palette -{$EXTERNALSYM SDL_HWPALETTE} - SDL_DOUBLEBUF = $40000000; // Set up double-buffered video mode -{$EXTERNALSYM SDL_DOUBLEBUF} - SDL_FULLSCREEN = $80000000; // Surface is a full screen display -{$EXTERNALSYM SDL_FULLSCREEN} - SDL_OPENGL = $00000002; // Create an OpenGL rendering context -{$EXTERNALSYM SDL_OPENGL} - SDL_OPENGLBLIT = $00000002; // Create an OpenGL rendering context -{$EXTERNALSYM SDL_OPENGLBLIT} - SDL_RESIZABLE = $00000010; // This video mode may be resized -{$EXTERNALSYM SDL_RESIZABLE} - SDL_NOFRAME = $00000020; // No window caption or edge frame -{$EXTERNALSYM SDL_NOFRAME} - // Used internally (read-only) - SDL_HWACCEL = $00000100; // Blit uses hardware acceleration -{$EXTERNALSYM SDL_HWACCEL} - SDL_SRCCOLORKEY = $00001000; // Blit uses a source color key -{$EXTERNALSYM SDL_SRCCOLORKEY} - SDL_RLEACCELOK = $00002000; // Private flag -{$EXTERNALSYM SDL_RLEACCELOK} - SDL_RLEACCEL = $00004000; // Colorkey blit is RLE accelerated -{$EXTERNALSYM SDL_RLEACCEL} - SDL_SRCALPHA = $00010000; // Blit uses source alpha blending -{$EXTERNALSYM SDL_SRCALPHA} - SDL_SRCCLIPPING = $00100000; // Blit uses source clipping -{$EXTERNALSYM SDL_SRCCLIPPING} - SDL_PREALLOC = $01000000; // Surface uses preallocated memory -{$EXTERNALSYM SDL_PREALLOC} - - { The most common video overlay formats. - For an explanation of these pixel formats, see: - http://www.webartz.com/fourcc/indexyuv.htm - - For information on the relationship between color spaces, see: - http://www.neuro.sfc.keio.ac.jp/~aly/polygon/info/color-space-faq.html } - - SDL_YV12_OVERLAY = $32315659; // Planar mode: Y + V + U (3 planes) -{$EXTERNALSYM SDL_YV12_OVERLAY} - SDL_IYUV_OVERLAY = $56555949; // Planar mode: Y + U + V (3 planes) -{$EXTERNALSYM SDL_IYUV_OVERLAY} - SDL_YUY2_OVERLAY = $32595559; // Packed mode: Y0+U0+Y1+V0 (1 plane) -{$EXTERNALSYM SDL_YUY2_OVERLAY} - SDL_UYVY_OVERLAY = $59565955; // Packed mode: U0+Y0+V0+Y1 (1 plane) -{$EXTERNALSYM SDL_UYVY_OVERLAY} - SDL_YVYU_OVERLAY = $55595659; // Packed mode: Y0+V0+Y1+U0 (1 plane) -{$EXTERNALSYM SDL_YVYU_OVERLAY} - - // flags for SDL_SetPalette() - SDL_LOGPAL = $01; -{$EXTERNALSYM SDL_LOGPAL} - SDL_PHYSPAL = $02; -{$EXTERNALSYM SDL_PHYSPAL} - - //SDL_mouse.h constants - { Used as a mask when testing buttons in buttonstate - Button 1: Left mouse button - Button 2: Middle mouse button - Button 3: Right mouse button - Button 4: Mouse Wheel Up (may also be a real button) - Button 5: Mouse Wheel Down (may also be a real button) - Button 6: Mouse X1 (may also be a real button) - Button 7: Mouse X2 (may also be a real button) - } - SDL_BUTTON_LEFT = 1; -{$EXTERNALSYM SDL_BUTTON_LEFT} - SDL_BUTTON_MIDDLE = 2; -{$EXTERNALSYM SDL_BUTTON_MIDDLE} - SDL_BUTTON_RIGHT = 3; -{$EXTERNALSYM SDL_BUTTON_RIGHT} - SDL_BUTTON_WHEELUP = 4; -{$EXTERNALSYM SDL_BUTTON_WHEELUP} - SDL_BUTTON_WHEELDOWN = 5; -{$EXTERNALSYM SDL_BUTTON_WHEELDOWN} - SDL_BUTTON_X1 = 6; -{$EXTERNALSYM SDL_BUTTON_X1} - SDL_BUTTON_X2 = 7; -{$EXTERNALSYM SDL_BUTTON_X2} - - SDL_BUTTON_LMASK = SDL_PRESSED shl (SDL_BUTTON_LEFT - 1); -{$EXTERNALSYM SDL_BUTTON_LMASK} - SDL_BUTTON_MMASK = SDL_PRESSED shl (SDL_BUTTON_MIDDLE - 1); -{$EXTERNALSYM SDL_BUTTON_MMASK} - SDL_BUTTON_RMASK = SDL_PRESSED shl (SDL_BUTTON_RIGHT - 1); -{$EXTERNALSYM SDL_BUTTON_RMASK} - SDL_BUTTON_X1MASK = SDL_PRESSED shl (SDL_BUTTON_X1 - 1); -{$EXTERNALSYM SDL_BUTTON_X1MASK} - SDL_BUTTON_X2MASK = SDL_PRESSED shl (SDL_BUTTON_X2 - 1); -{$EXTERNALSYM SDL_BUTTON_X2MASK} - - // SDL_active.h constants - // The available application states - SDL_APPMOUSEFOCUS = $01; // The app has mouse coverage -{$EXTERNALSYM SDL_APPMOUSEFOCUS} - SDL_APPINPUTFOCUS = $02; // The app has input focus -{$EXTERNALSYM SDL_APPINPUTFOCUS} - SDL_APPACTIVE = $04; // The application is active -{$EXTERNALSYM SDL_APPACTIVE} - - // SDL_mutex.h constants - // Synchronization functions which can time out return this value - // they time out. - - SDL_MUTEX_TIMEDOUT = 1; -{$EXTERNALSYM SDL_MUTEX_TIMEDOUT} - - // This is the timeout value which corresponds to never time out - SDL_MUTEX_MAXWAIT = not Cardinal(0); -{$EXTERNALSYM SDL_MUTEX_MAXWAIT} - - {TSDL_GrabMode = ( - SDL_GRAB_QUERY, - SDL_GRAB_OFF, - SDL_GRAB_ON, - SDL_GRAB_FULLSCREEN ); // Used internally} - SDL_GRAB_QUERY = -1; - SDL_GRAB_OFF = 0; - SDL_GRAB_ON = 1; - //SDL_GRAB_FULLSCREEN // Used internally - -type - THandle = Cardinal; - //SDL_types.h types - // Basic data types - - SDL_Bool = (SDL_FALSE, SDL_TRUE); - TSDL_Bool = SDL_Bool; - - PUInt8Array = ^TUInt8Array; - PUInt8 = ^UInt8; - PPUInt8 = ^PUInt8; - UInt8 = Byte; -{$EXTERNALSYM UInt8} - TUInt8Array = array [0..MAXINT shr 1] of UInt8; - - PUInt16 = ^UInt16; - UInt16 = word; -{$EXTERNALSYM UInt16} - - PSInt8 = ^SInt8; - SInt8 = Shortint; -{$EXTERNALSYM SInt8} - - PSInt16 = ^SInt16; - SInt16 = smallint; -{$EXTERNALSYM SInt16} - - PUInt32 = ^UInt32; - UInt32 = Cardinal; -{$EXTERNALSYM UInt32} - - SInt32 = Integer; -{$EXTERNALSYM SInt32} - - PInt = ^Integer; - - PShortInt = ^ShortInt; - - PUInt64 = ^UInt64; - UInt64 = record - hi: UInt32; - lo: UInt32; - end; -{$EXTERNALSYM UInt64} - - PSInt64 = ^SInt64; - SInt64 = record - hi: UInt32; - lo: UInt32; - end; -{$EXTERNALSYM SInt64} - - TSDL_GrabMode = Integer; - - // SDL_error.h types - TSDL_errorcode = ( - SDL_ENOMEM, - SDL_EFREAD, - SDL_EFWRITE, - SDL_EFSEEK, - SDL_LASTERROR); - - SDL_errorcode = TSDL_errorcode; -{$EXTERNALSYM SDL_errorcode} - - TArg = record - case Byte of - 0: (value_ptr: Pointer); - (* #if 0 means: never - 1 : ( value_c : Byte ); - *) - 2: (value_i: Integer); - 3: (value_f: double); - 4: (buf: array[0..ERR_MAX_STRLEN - 1] of Byte); - end; - - PSDL_error = ^TSDL_error; - TSDL_error = record - { This is a numeric value corresponding to the current error } - error: Integer; - - { This is a key used to index into a language hashtable containing - internationalized versions of the SDL error messages. If the key - is not in the hashtable, or no hashtable is available, the key is - used directly as an error message format string. } - key: array[0..ERR_MAX_STRLEN - 1] of Byte; - - { These are the arguments for the error functions } - argc: Integer; - args: array[0..ERR_MAX_ARGS - 1] of TArg; - end; - - // SDL_rwops.h types - // This is the read/write operation structure -- very basic - // some helper types to handle the unions - // "packed" is only guessed - - TStdio = record - autoclose: Integer; - // FILE * is only defined in Kylix so we use a simple Pointer - fp: Pointer; - end; - - TMem = record - base: PUInt8; - here: PUInt8; - stop: PUInt8; - end; - - TUnknown = record - data1: Pointer; - end; - - // first declare the pointer type - PSDL_RWops = ^TSDL_RWops; - // now the pointer to function types - {$IFNDEF __GPC__} - TSeek = function( context: PSDL_RWops; offset: Integer; whence: Integer ): Integer; cdecl; - TRead = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer ): Integer; cdecl; - TWrite = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer ): Integer; cdecl; - TClose = function( context: PSDL_RWops ): Integer; cdecl; - {$ELSE} - TSeek = function( context: PSDL_RWops; offset: Integer; whence: Integer ): Integer; - TRead = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer ): Integer; - TWrite = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer ): Integer; - TClose = function( context: PSDL_RWops ): Integer; - {$ENDIF} - // the variant record itself - TSDL_RWops = record - seek: TSeek; - read: TRead; - write: TWrite; - close: TClose; - // a keyword as name is not allowed - type_: UInt32; - // be warned! structure alignment may arise at this point - case Integer of - 0: (stdio: TStdio); - 1: (mem: TMem); - 2: (unknown: TUnknown); - end; - - SDL_RWops = TSDL_RWops; -{$EXTERNALSYM SDL_RWops} - - - // SDL_timer.h types - // Function prototype for the timer callback function - {$IFNDEF __GPC__} - TSDL_TimerCallback = function( interval: UInt32 ): UInt32; cdecl; - {$ELSE} - TSDL_TimerCallback = function( interval: UInt32 ): UInt32; - {$ENDIF} - - { New timer API, supports multiple timers - Written by Stephane Peter <megastep@lokigames.com> } - - { Function prototype for the new timer callback function. - The callback function is passed the current timer interval and returns - the next timer interval. If the returned value is the same as the one - passed in, the periodic alarm continues, otherwise a new alarm is - scheduled. If the callback returns 0, the periodic alarm is cancelled. } - {$IFNDEF __GPC__} - TSDL_NewTimerCallback = function( interval: UInt32; param: Pointer ): UInt32; cdecl; - {$ELSE} - TSDL_NewTimerCallback = function( interval: UInt32; param: Pointer ): UInt32; - {$ENDIF} - - // Definition of the timer ID type - PSDL_TimerID = ^TSDL_TimerID; - TSDL_TimerID = record - interval: UInt32; - callback: TSDL_NewTimerCallback; - param: Pointer; - last_alarm: UInt32; - next: PSDL_TimerID; - end; - - {$IFNDEF __GPC__} - TSDL_AudioSpecCallback = procedure( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; - {$ELSE} - TSDL_AudioSpecCallback = procedure( userdata: Pointer; stream: PUInt8; len: Integer ); - {$ENDIF} - - // SDL_audio.h types - // The calculated values in this structure are calculated by SDL_OpenAudio() - PSDL_AudioSpec = ^TSDL_AudioSpec; - TSDL_AudioSpec = record - freq: Integer; // DSP frequency -- samples per second - format: UInt16; // Audio data format - channels: UInt8; // Number of channels: 1 mono, 2 stereo - silence: UInt8; // Audio buffer silence value (calculated) - samples: UInt16; // Audio buffer size in samples - padding: UInt16; // Necessary for some compile environments - size: UInt32; // Audio buffer size in bytes (calculated) - { This function is called when the audio device needs more data. - 'stream' is a pointer to the audio data buffer - 'len' is the length of that buffer in bytes. - Once the callback returns, the buffer will no longer be valid. - Stereo samples are stored in a LRLRLR ordering.} - callback: TSDL_AudioSpecCallback; - userdata: Pointer; - end; - - // A structure to hold a set of audio conversion filters and buffers - PSDL_AudioCVT = ^TSDL_AudioCVT; - - PSDL_AudioCVTFilter = ^TSDL_AudioCVTFilter; - TSDL_AudioCVTFilter = record - cvt: PSDL_AudioCVT; - format: UInt16; - end; - - PSDL_AudioCVTFilterArray = ^TSDL_AudioCVTFilterArray; - TSDL_AudioCVTFilterArray = array[0..9] of PSDL_AudioCVTFilter; - - TSDL_AudioCVT = record - needed: Integer; // Set to 1 if conversion possible - src_format: UInt16; // Source audio format - dst_format: UInt16; // Target audio format - rate_incr: double; // Rate conversion increment - buf: PUInt8; // Buffer to hold entire audio data - len: Integer; // Length of original audio buffer - len_cvt: Integer; // Length of converted audio buffer - len_mult: Integer; // buffer must be len*len_mult big - len_ratio: double; // Given len, final size is len*len_ratio - filters: TSDL_AudioCVTFilterArray; - filter_index: Integer; // Current audio conversion function - end; - - TSDL_Audiostatus = ( - SDL_AUDIO_STOPPED, - SDL_AUDIO_PLAYING, - SDL_AUDIO_PAUSED - ); - - // SDL_cdrom.h types - TSDL_CDStatus = ( - CD_ERROR, - CD_TRAYEMPTY, - CD_STOPPED, - CD_PLAYING, - CD_PAUSED ); - - PSDL_CDTrack = ^TSDL_CDTrack; - TSDL_CDTrack = record - id: UInt8; // Track number - type_: UInt8; // Data or audio track - unused: UInt16; - length: UInt32; // Length, in frames, of this track - offset: UInt32; // Offset, in frames, from start of disk - end; - - // This structure is only current as of the last call to SDL_CDStatus() - PSDL_CD = ^TSDL_CD; - TSDL_CD = record - id: Integer; // Private drive identifier - status: TSDL_CDStatus; // Current drive status - - // The rest of this structure is only valid if there's a CD in drive - numtracks: Integer; // Number of tracks on disk - cur_track: Integer; // Current track position - cur_frame: Integer; // Current frame offset within current track - track: array[0..SDL_MAX_TRACKS] of TSDL_CDTrack; - end; - - //SDL_joystick.h types - PTransAxis = ^TTransAxis; - TTransAxis = record - offset: Integer; - scale: single; - end; - - // The private structure used to keep track of a joystick - PJoystick_hwdata = ^TJoystick_hwdata; - TJoystick_hwdata = record - // joystick ID - id: Integer; - // values used to translate device-specific coordinates into SDL-standard ranges - transaxis: array[0..5] of TTransAxis; - end; - - PBallDelta = ^TBallDelta; - TBallDelta = record - dx: Integer; - dy: Integer; - end; // Current ball motion deltas - - // The SDL joystick structure - PSDL_Joystick = ^TSDL_Joystick; - TSDL_Joystick = record - index: UInt8; // Device index - name: PAnsiChar; // Joystick name - system dependent - - naxes: Integer; // Number of axis controls on the joystick - axes: PUInt16; // Current axis states - - nhats: Integer; // Number of hats on the joystick - hats: PUInt8; // Current hat states - - nballs: Integer; // Number of trackballs on the joystick - balls: PBallDelta; // Current ball motion deltas - - nbuttons: Integer; // Number of buttons on the joystick - buttons: PUInt8; // Current button states - - hwdata: PJoystick_hwdata; // Driver dependent information - - ref_count: Integer; // Reference count for multiple opens - end; - - // SDL_verion.h types - PSDL_version = ^TSDL_version; - TSDL_version = record - major: UInt8; - minor: UInt8; - patch: UInt8; - end; - - // SDL_keyboard.h types - TSDLKey = LongWord; - - TSDLMod = LongWord; - - PSDL_KeySym = ^TSDL_KeySym; - TSDL_KeySym = record - scancode: UInt8; // hardware specific scancode - sym: TSDLKey; // SDL virtual keysym - modifier: TSDLMod; // current key modifiers - unicode: UInt16; // translated character - end; - - // SDL_events.h types - {Checks the event queue for messages and optionally returns them. - If 'action' is SDL_ADDEVENT, up to 'numevents' events will be added to - the back of the event queue. - If 'action' is SDL_PEEKEVENT, up to 'numevents' events at the front - of the event queue, matching 'mask', will be returned and will not - be removed from the queue. - If 'action' is SDL_GETEVENT, up to 'numevents' events at the front - of the event queue, matching 'mask', will be returned and will be - removed from the queue. - This function returns the number of events actually stored, or -1 - if there was an error. This function is thread-safe. } - - TSDL_EventAction = (SDL_ADDEVENT, SDL_PEEKEVENT, SDL_GETEVENT); - - // Application visibility event structure - TSDL_ActiveEvent = record - type_: UInt8; // SDL_ACTIVEEVENT - gain: UInt8; // Whether given states were gained or lost (1/0) - state: UInt8; // A mask of the focus states - end; - - // Keyboard event structure - TSDL_KeyboardEvent = record - type_: UInt8; // SDL_KEYDOWN or SDL_KEYUP - which: UInt8; // The keyboard device index - state: UInt8; // SDL_PRESSED or SDL_RELEASED - keysym: TSDL_KeySym; - end; - - // Mouse motion event structure - TSDL_MouseMotionEvent = record - type_: UInt8; // SDL_MOUSEMOTION - which: UInt8; // The mouse device index - state: UInt8; // The current button state - x, y: UInt16; // The X/Y coordinates of the mouse - xrel: SInt16; // The relative motion in the X direction - yrel: SInt16; // The relative motion in the Y direction - end; - - // Mouse button event structure - TSDL_MouseButtonEvent = record - type_: UInt8; // SDL_MOUSEBUTTONDOWN or SDL_MOUSEBUTTONUP - which: UInt8; // The mouse device index - button: UInt8; // The mouse button index - state: UInt8; // SDL_PRESSED or SDL_RELEASED - x: UInt16; // The X coordinates of the mouse at press time - y: UInt16; // The Y coordinates of the mouse at press time - end; - - // Joystick axis motion event structure - TSDL_JoyAxisEvent = record - type_: UInt8; // SDL_JOYAXISMOTION - which: UInt8; // The joystick device index - axis: UInt8; // The joystick axis index - value: SInt16; // The axis value (range: -32768 to 32767) - end; - - // Joystick trackball motion event structure - TSDL_JoyBallEvent = record - type_: UInt8; // SDL_JOYAVBALLMOTION - which: UInt8; // The joystick device index - ball: UInt8; // The joystick trackball index - xrel: SInt16; // The relative motion in the X direction - yrel: SInt16; // The relative motion in the Y direction - end; - - // Joystick hat position change event structure - TSDL_JoyHatEvent = record - type_: UInt8; // SDL_JOYHATMOTION */ - which: UInt8; // The joystick device index */ - hat: UInt8; // The joystick hat index */ - value: UInt8; { The hat position value: - 8 1 2 - 7 0 3 - 6 5 4 - - Note that zero means the POV is centered. } - - end; - - // Joystick button event structure - TSDL_JoyButtonEvent = record - type_: UInt8; // SDL_JOYBUTTONDOWN or SDL_JOYBUTTONUP - which: UInt8; // The joystick device index - button: UInt8; // The joystick button index - state: UInt8; // SDL_PRESSED or SDL_RELEASED - end; - - { The "window resized" event - When you get this event, you are responsible for setting a new video - mode with the new width and height. } - TSDL_ResizeEvent = record - type_: UInt8; // SDL_VIDEORESIZE - w: Integer; // New width - h: Integer; // New height - end; - - // The "quit requested" event - PSDL_QuitEvent = ^TSDL_QuitEvent; - TSDL_QuitEvent = record - type_: UInt8; - end; - - // A user-defined event type - PSDL_UserEvent = ^TSDL_UserEvent; - TSDL_UserEvent = record - type_: UInt8; // SDL_USEREVENT through SDL_NUMEVENTS-1 - code: Integer; // User defined event code */ - data1: Pointer; // User defined data pointer */ - data2: Pointer; // User defined data pointer */ - end; - - // The "screen redraw" event - PSDL_ExposeEvent = ^TSDL_ExposeEvent; - TSDL_ExposeEvent = record - type_ : Uint8; // SDL_VIDEOEXPOSE - end; - - {$IFDEF Unix} - //These are the various supported subsystems under UNIX - TSDL_SysWm = ( SDL_SYSWM_X11 ) ; - {$ENDIF} - -// The windows custom event structure -{$IFDEF WINDOWS} - PSDL_SysWMmsg = ^TSDL_SysWMmsg; - TSDL_SysWMmsg = record - version: TSDL_version; - h_wnd: HWND; // The window for the message - msg: UInt; // The type of message - w_Param: WPARAM; // WORD message parameter - lParam: LPARAM; // LONG message parameter - end; -{$ELSE} - -{$IFDEF Unix} -{ The Linux custom event structure } - PSDL_SysWMmsg = ^TSDL_SysWMmsg; - TSDL_SysWMmsg = record - version : TSDL_version; - subsystem : TSDL_SysWm; - {$IFDEF FPC} - {$IFNDEF GP2X} - {$IFNDEF DARWIN} - {$IFNDEF SKYOS} - event : TXEvent; - {$ENDIF} - {$ENDIF} - {$ENDIF} - {$ELSE} - event : XEvent; - {$ENDIF} - end; -{$ELSE} -{ The generic custom event structure } - PSDL_SysWMmsg = ^TSDL_SysWMmsg; - TSDL_SysWMmsg = record - version: TSDL_version; - data: Integer; - end; -{$ENDIF} - -{$ENDIF} - -// The Windows custom window manager information structure -{$IFDEF WINDOWS} - PSDL_SysWMinfo = ^TSDL_SysWMinfo; - TSDL_SysWMinfo = record - version : TSDL_version; - window : HWnd; // The display window - end; -{$ELSE} - -// The Linux custom window manager information structure -{$IFDEF Unix} - {$IFNDEF GP2X} - {$IFNDEF DARWIN} - {$IFNDEF SKYOS} - TX11 = record - display : PDisplay; // The X11 display - window : TWindow ; // The X11 display window */ - {* These locking functions should be called around - any X11 functions using the display variable. - They lock the event thread, so should not be - called around event functions or from event filters. - *} - lock_func : Pointer; - unlock_func : Pointer; - - // Introduced in SDL 1.0.2 - fswindow : TWindow ; // The X11 fullscreen window */ - wmwindow : TWindow ; // The X11 managed input window */ - end; - {$ENDIF} - {$ENDIF} - {$ENDIF} - - PSDL_SysWMinfo = ^TSDL_SysWMinfo; - TSDL_SysWMinfo = record - version : TSDL_version ; - subsystem : TSDL_SysWm; - {$IFNDEF GP2X} - {$IFNDEF DARWIN} - {$IFNDEF SKYOS} - X11 : TX11; - {$ENDIF} - {$ENDIF} - {$ENDIF} - end; -{$ELSE} - // The generic custom window manager information structure - PSDL_SysWMinfo = ^TSDL_SysWMinfo; - TSDL_SysWMinfo = record - version : TSDL_version ; - data : integer; - end; -{$ENDIF} - -{$ENDIF} - - PSDL_SysWMEvent = ^TSDL_SysWMEvent; - TSDL_SysWMEvent = record - type_: UInt8; - msg: PSDL_SysWMmsg; - end; - - PSDL_Event = ^TSDL_Event; - TSDL_Event = record - case UInt8 of - SDL_NOEVENT: (type_: byte); - SDL_ACTIVEEVENT: (active: TSDL_ActiveEvent); - SDL_KEYDOWN, SDL_KEYUP: (key: TSDL_KeyboardEvent); - SDL_MOUSEMOTION: (motion: TSDL_MouseMotionEvent); - SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP: (button: TSDL_MouseButtonEvent ); - SDL_JOYAXISMOTION: (jaxis: TSDL_JoyAxisEvent ); - SDL_JOYBALLMOTION: (jball: TSDL_JoyBallEvent ); - SDL_JOYHATMOTION: (jhat: TSDL_JoyHatEvent ); - SDL_JOYBUTTONDOWN, SDL_JOYBUTTONUP: (jbutton: TSDL_JoyButtonEvent ); - SDL_VIDEORESIZE: (resize: TSDL_ResizeEvent ); - SDL_QUITEV: (quit: TSDL_QuitEvent ); - SDL_USEREVENT : ( user : TSDL_UserEvent ); - SDL_SYSWMEVENT: (syswm: TSDL_SysWMEvent ); - end; - - -{ This function sets up a filter to process all events before they - change internal state and are posted to the internal event queue. - - The filter is protypted as: } - {$IFNDEF __GPC__} - TSDL_EventFilter = function( event : PSDL_Event ): Integer; cdecl; - {$ELSE} - TSDL_EventFilter = function( event : PSDL_Event ): Integer; - {$ENDIF} - - // SDL_video.h types - // Useful data types - PPSDL_Rect = ^PSDL_Rect; - PSDL_Rect = ^TSDL_Rect; - TSDL_Rect = record - x, y: SInt16; - w, h: UInt16; - end; - - SDL_Rect = TSDL_Rect; -{$EXTERNALSYM SDL_Rect} - - PSDL_Color = ^TSDL_Color; - TSDL_Color = record - r: UInt8; - g: UInt8; - b: UInt8; - unused: UInt8; - end; - - PSDL_ColorArray = ^TSDL_ColorArray; - TSDL_ColorArray = array[0..65000] of TSDL_Color; - - PSDL_Palette = ^TSDL_Palette; - TSDL_Palette = record - ncolors: Integer; - colors: PSDL_ColorArray; - end; - - // Everything in the pixel format structure is read-only - PSDL_PixelFormat = ^TSDL_PixelFormat; - TSDL_PixelFormat = record - palette: PSDL_Palette; - BitsPerPixel: UInt8; - BytesPerPixel: UInt8; - Rloss: UInt8; - Gloss: UInt8; - Bloss: UInt8; - Aloss: UInt8; - Rshift: UInt8; - Gshift: UInt8; - Bshift: UInt8; - Ashift: UInt8; - RMask: UInt32; - GMask: UInt32; - BMask: UInt32; - AMask: UInt32; - colorkey: UInt32; // RGB color key information - alpha: UInt8; // Alpha value information (per-surface alpha) - end; - -{$IFDEF WINDOWS} - {PPrivate_hwdata = ^TPrivate_hwdata; - TPrivate_hwdata = record - dd_surface : IDIRECTDRAWSURFACE3; - dd_writebuf : IDIRECTDRAWSURFACE3; - end;} - {ELSE} -{$ENDIF} - - // The structure passed to the low level blit functions - PSDL_BlitInfo = ^TSDL_BlitInfo; - TSDL_BlitInfo = record - s_pixels: PUInt8; - s_width: Integer; - s_height: Integer; - s_skip: Integer; - d_pixels: PUInt8; - d_width: Integer; - d_height: Integer; - d_skip: Integer; - aux_data: Pointer; - src: PSDL_PixelFormat; - table: PUInt8; - dst: PSDL_PixelFormat; - end; - - // typedef for private surface blitting functions - PSDL_Surface = ^TSDL_Surface; - - {$IFNDEF __GPC__} - TSDL_Blit = function( src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect ): Integer; cdecl; - {$ELSE} - TSDL_Blit = function( src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect ): Integer; - {$ENDIF} - - // The type definition for the low level blit functions - //TSDL_LoBlit = procedure( info : PSDL_BlitInfo ); cdecl; - - // This is the private info structure for software accelerated blits - {PPrivate_swaccel = ^TPrivate_swaccel; - TPrivate_swaccel = record - blit : TSDL_LoBlit; - aux_data : Pointer; - end;} - - // Blit mapping definition - {PSDL_BlitMap = ^TSDL_BlitMap; - TSDL_BlitMap = record - dst : PSDL_Surface; - identity : Integer; - table : PUInt8; - hw_blit : TSDL_Blit; - sw_blit : TSDL_Blit; - hw_data : PPrivate_hwaccel; - sw_data : PPrivate_swaccel; - - // the version count matches the destination; mismatch indicates an invalid mapping - format_version : Cardinal; - end;} - - TSDL_Surface = record - flags: UInt32; // Read-only - format: PSDL_PixelFormat; // Read-only - w, h: Integer; // Read-only - pitch: UInt16; // Read-only - pixels: Pointer; // Read-write - offset: Integer; // Private - hwdata: Pointer; //TPrivate_hwdata; Hardware-specific surface info - - // clipping information: - clip_rect: TSDL_Rect; // Read-only - unused1: UInt32; // for binary compatibility - // Allow recursive locks - locked: UInt32; // Private - // info for fast blit mapping to other surfaces - Blitmap: Pointer; // PSDL_BlitMap; // Private - // format version, bumped at every change to invalidate blit maps - format_version: Cardinal; // Private - refcount: Integer; - end; - - // Useful for determining the video hardware capabilities - PSDL_VideoInfo = ^TSDL_VideoInfo; - TSDL_VideoInfo = record - hw_available: UInt8; // Hardware and WindowManager flags in first 2 bits ( see below ) - {hw_available: 1; // Can you create hardware surfaces - wm_available: 1; // Can you talk to a window manager? - UnusedBits1: 6;} - blit_hw: UInt8; // Blit Hardware flags. See below for which bits do what - {UnusedBits2: 1; - blit_hw: 1; // Flag:UInt32 Accelerated blits HW --> HW - blit_hw_CC: 1; // Flag:UInt32 Accelerated blits with Colorkey - blit_hw_A: 1; // Flag:UInt32 Accelerated blits with Alpha - blit_sw: 1; // Flag:UInt32 Accelerated blits SW --> HW - blit_sw_CC: 1; // Flag:UInt32 Accelerated blits with Colorkey - blit_sw_A: 1; // Flag:UInt32 Accelerated blits with Alpha - blit_fill: 1; // Flag:UInt32 Accelerated color fill} - UnusedBits3: UInt8; // Unused at this point - video_mem: UInt32; // The total amount of video memory (in K) - vfmt: PSDL_PixelFormat; // Value: The format of the video surface - current_w : SInt32; // Value: The current video mode width - current_h : SInt32; // Value: The current video mode height - end; - - // The YUV hardware video overlay - PSDL_Overlay = ^TSDL_Overlay; - TSDL_Overlay = record - format: UInt32; // Overlay format - w, h: Integer; // Width and height of overlay - planes: Integer; // Number of planes in the overlay. Usually either 1 or 3 - pitches: PUInt16; - // An array of pitches, one for each plane. Pitch is the length of a row in bytes. - pixels: PPUInt8; - // An array of pointers to the data of each plane. The overlay should be locked before these pointers are used. - hw_overlay: UInt32; - // This will be set to 1 if the overlay is hardware accelerated. - end; - - // Public enumeration for setting the OpenGL window attributes. - TSDL_GLAttr = ( - SDL_GL_RED_SIZE, - SDL_GL_GREEN_SIZE, - SDL_GL_BLUE_SIZE, - SDL_GL_ALPHA_SIZE, - SDL_GL_BUFFER_SIZE, - SDL_GL_DOUBLEBUFFER, - SDL_GL_DEPTH_SIZE, - SDL_GL_STENCIL_SIZE, - SDL_GL_ACCUM_RED_SIZE, - SDL_GL_ACCUM_GREEN_SIZE, - SDL_GL_ACCUM_BLUE_SIZE, - SDL_GL_ACCUM_ALPHA_SIZE, - SDL_GL_STEREO, - SDL_GL_MULTISAMPLEBUFFERS, - SDL_GL_MULTISAMPLESAMPLES, - SDL_GL_ACCELERATED_VISUAL, - SDL_GL_SWAP_CONTROL); - - - - PSDL_Cursor = ^TSDL_Cursor; - TSDL_Cursor = record - area: TSDL_Rect; // The area of the mouse cursor - hot_x, hot_y: SInt16; // The "tip" of the cursor - data: PUInt8; // B/W cursor data - mask: PUInt8; // B/W cursor mask - save: array[1..2] of PUInt8; // Place to save cursor area - wm_cursor: Pointer; // Window-manager cursor - end; - -// SDL_mutex.h types - -{$IFDEF WINDOWS} - PSDL_Mutex = ^TSDL_Mutex; - TSDL_Mutex = record - id: THANDLE; - end; -{$ENDIF} - -{$IFDEF Unix} - PSDL_Mutex = ^TSDL_Mutex; - TSDL_mutex = record - id: pthread_mutex_t; -{$IFDEF PTHREAD_NO_RECURSIVE_MUTEX} - recursive: Integer; - owner: pthread_t; -{$ENDIF} - end; -{$ENDIF} - -{$IFDEF NDS} - PSDL_mutex = ^TSDL_Mutex; - TSDL_Mutex = record - recursive: Integer; - Owner: UInt32; - sem: PSDL_sem; - end; -{$ENDIF} - -{$IFDEF __MACH__} - {$define USE_NAMED_SEMAPHORES} - // Broken sem_getvalue() in MacOS X Public Beta */ - {$define BROKEN_SEMGETVALUE} -{$ENDIF} - -PSDL_semaphore = ^TSDL_semaphore; -{$IFDEF WINDOWS} - // WINDOWS or Machintosh - TSDL_semaphore = record - id: THANDLE; - count: UInt32; - end; -{$ELSE} - {$IFDEF FPC} - // This should be semaphore.h - __sem_lock_t = {packed} record { Not in header file - anonymous } - status: Longint; - spinlock: Integer; - end; - - sem_t = {packed} record - __sem_lock: __sem_lock_t; - __sem_value: Integer; - __sem_waiting: longint ; {_pthread_queue;} - end; - {$ENDIF} - - TSDL_semaphore = record - sem: Pointer; //PSem_t; - {$IFNDEF USE_NAMED_SEMAPHORES} - sem_data: Sem_t; - {$ENDIF} - - {$IFDEF BROKEN_SEMGETVALUE} - { This is a little hack for MacOS X - - It's not thread-safe, but it's better than nothing } - sem_value: Integer; - {$ENDIF} - end; -{$ENDIF} - - PSDL_Sem = ^TSDL_Sem; - TSDL_Sem = TSDL_Semaphore; - - PSDL_Cond = ^TSDL_Cond; - TSDL_Cond = record -{$IFDEF Unix} - cond: pthread_cond_t; -{$ELSE} - // Generic Cond structure - lock: PSDL_mutex; - waiting: Integer; - signals: Integer; - wait_sem: PSDL_Sem; - wait_done: PSDL_Sem; -{$ENDIF} - end; - - // SDL_thread.h types -{$IFDEF WINDOWS} - TSYS_ThreadHandle = THandle; -{$ENDIF} - -{$IFDEF Unix} - TSYS_ThreadHandle = pthread_t; -{$ENDIF} - -{$IFDEF NDS} - TSYS_ThreadHandle = Integer; -{$ENDIF} - - { This is the system-independent thread info structure } - PSDL_Thread = ^TSDL_Thread; - TSDL_Thread = record - threadid: UInt32; - handle: TSYS_ThreadHandle; - status: Integer; - errbuf: TSDL_Error; - data: Pointer; - end; - - // Helper Types - - // Keyboard State Array ( See demos for how to use ) - PKeyStateArr = ^TKeyStateArr; - TKeyStateArr = array[0..65000] of UInt8; - - // Types required so we don't need to use Windows.pas - PInteger = ^Integer; - PByte = ^Byte; - PWord = ^Word; - PLongWord = ^Longword; - - // General arrays - PByteArray = ^TByteArray; - TByteArray = array[0..32767] of Byte; - - PWordArray = ^TWordArray; - TWordArray = array[0..16383] of Word; - - PPoint = ^TPoint; - {$IFDEF HAS_TYPES} - TPoint = Types.TPoint; - {$ELSE} - {$IFDEF WINDOWS} - {$IFDEF __GPC__} - TPoint = wintypes.TPoint; - {$ELSE} - TPoint = Windows.TPoint; - {$ENDIF} - {$ELSE} - //Can't define TPoint : neither Types nor Windows unit available. - {$ENDIF} - {$ENDIF} - - PRect = ^TRect; - {$IFDEF HAS_TYPES} - TRect = Types.TRect; - {$ELSE} - {$IFDEF WINDOWS} - {$IFDEF __GPC__} - TRect = wintypes.TRect; - {$ELSE} - TRect = Windows.TRect; - {$ENDIF} - {$ELSE} - //Can't define TRect: neither Types nor Windows unit available. - {$ENDIF} - {$ENDIF} - - { Generic procedure pointer } - TProcedure = procedure; - -{------------------------------------------------------------------------------} -{ initialization } -{------------------------------------------------------------------------------} - -{ This function loads the SDL dynamically linked library and initializes - the subsystems specified by 'flags' (and those satisfying dependencies) - Unless the SDL_INIT_NOPARACHUTE flag is set, it will install cleanup - signal handlers for some commonly ignored fatal signals (like SIGSEGV) } - -function SDL_Init( flags : UInt32 ) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_Init} - -// This function initializes specific SDL subsystems -function SDL_InitSubSystem( flags : UInt32 ) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_InitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_InitSubSystem} - -// This function cleans up specific SDL subsystems -procedure SDL_QuitSubSystem( flags : UInt32 ); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_QuitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_QuitSubSystem} - -{ This function returns mask of the specified subsystems which have - been initialized. - If 'flags' is 0, it returns a mask of all initialized subsystems. } - -function SDL_WasInit( flags : UInt32 ): UInt32; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WasInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WasInit} - -{ This function cleans up all initialized subsystems and unloads the - dynamically linked library. You should call it upon all exit conditions. } -procedure SDL_Quit; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Quit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_Quit} - -{$IFDEF WINDOWS} -// This should be called from your WinMain() function, if any -function SDL_RegisterApp(name: PAnsiChar; style: UInt32; h_Inst: Pointer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RegisterApp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_RegisterApp} -{$ENDIF} - -{$IFDEF __MACH__} -// This should be called from your main() function, if any -procedure SDL_InitQuickDraw( the_qd: QDGlobals ); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_InitQuickDraw'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_InitQuickDraw} -{$ENDIF} - - -{------------------------------------------------------------------------------} -{ types } -{------------------------------------------------------------------------------} -// The number of elements in a table -function SDL_TableSize( table: PAnsiChar ): Integer; -{$EXTERNALSYM SDL_TABLESIZE} - - -{------------------------------------------------------------------------------} -{ error-handling } -{------------------------------------------------------------------------------} -// Public functions -function SDL_GetError: PAnsiChar; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetError} -procedure SDL_SetError(fmt: PAnsiChar); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetError} -procedure SDL_ClearError; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ClearError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_ClearError} - -{$IFNDEF WINDOWS} -procedure SDL_Error(Code: TSDL_errorcode); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Error'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_Error} -{$ENDIF} - -// Private error message function - used internally -procedure SDL_OutOfMemory; - -{------------------------------------------------------------------------------} -{ io handling } -{------------------------------------------------------------------------------} -// Functions to create SDL_RWops structures from various data sources - -function SDL_RWFromFile(filename, mode: PAnsiChar): PSDL_RWops; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromFile'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_RWFromFile} -procedure SDL_FreeRW(area: PSDL_RWops); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeRW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_FreeRW} - -//fp is FILE *fp ??? -function SDL_RWFromFP(fp: Pointer; autoclose: Integer): PSDL_RWops; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromFP'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_RWFromFP} -function SDL_RWFromMem(mem: Pointer; size: Integer): PSDL_RWops; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromMem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_RWFromMem} -function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromConstMem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_RWFromConstMem} -function SDL_AllocRW: PSDL_RWops; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AllocRW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_AllocRW} - -function SDL_RWSeek(context: PSDL_RWops; offset: Integer; whence: Integer) : Integer; -{$EXTERNALSYM SDL_RWSeek} -function SDL_RWTell(context: PSDL_RWops): Integer; -{$EXTERNALSYM SDL_RWTell} -function SDL_RWRead(context: PSDL_RWops; ptr: Pointer; size: Integer; n : Integer): Integer; -{$EXTERNALSYM SDL_RWRead} -function SDL_RWWrite(context: PSDL_RWops; ptr: Pointer; size: Integer; n : Integer): Integer; -{$EXTERNALSYM SDL_RWWrite} -function SDL_RWClose(context: PSDL_RWops): Integer; -{$EXTERNALSYM SDL_RWClose} - -{------------------------------------------------------------------------------} -{ time-handling } -{------------------------------------------------------------------------------} - -{ Get the number of milliseconds since the SDL library initialization. } -{ Note that this value wraps if the program runs for more than ~49 days. } -function SDL_GetTicks: UInt32; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetTicks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetTicks} - -// Wait a specified number of milliseconds before returning -procedure SDL_Delay(msec: UInt32); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Delay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_Delay} - -{ Add a new timer to the pool of timers already running. } -{ Returns a timer ID, or NULL when an error occurs. } -function SDL_AddTimer(interval: UInt32; callback: TSDL_NewTimerCallback; param : Pointer): PSDL_TimerID; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AddTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_AddTimer} - -{ Remove one of the multiple timers knowing its ID. } -{ Returns a boolean value indicating success. } -function SDL_RemoveTimer(t: PSDL_TimerID): TSDL_Bool; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RemoveTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_RemoveTimer} - -function SDL_SetTimer(interval: UInt32; callback: TSDL_TimerCallback): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetTimer} - -{------------------------------------------------------------------------------} -{ audio-routines } -{------------------------------------------------------------------------------} - -{ These functions are used internally, and should not be used unless you - have a specific need to specify the audio driver you want to use. - You should normally use SDL_Init() or SDL_InitSubSystem(). } - -function SDL_AudioInit(driver_name: PAnsiChar): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_AudioInit} -procedure SDL_AudioQuit; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_AudioQuit} - -{ This function fills the given character buffer with the name of the - current audio driver, and returns a Pointer to it if the audio driver has - been initialized. It returns NULL if no driver has been initialized. } - -function SDL_AudioDriverName(namebuf: PAnsiChar; maxlen: Integer): PAnsiChar; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_AudioDriverName} - -{ This function opens the audio device with the desired parameters, and - returns 0 if successful, placing the actual hardware parameters in the - structure pointed to by 'obtained'. If 'obtained' is NULL, the audio - data passed to the callback function will be guaranteed to be in the - requested format, and will be automatically converted to the hardware - audio format if necessary. This function returns -1 if it failed - to open the audio device, or couldn't set up the audio thread. - - When filling in the desired audio spec structure, - 'desired->freq' should be the desired audio frequency in samples-per-second. - 'desired->format' should be the desired audio format. - 'desired->samples' is the desired size of the audio buffer, in samples. - This number should be a power of two, and may be adjusted by the audio - driver to a value more suitable for the hardware. Good values seem to - range between 512 and 8096 inclusive, depending on the application and - CPU speed. Smaller values yield faster response time, but can lead - to underflow if the application is doing heavy processing and cannot - fill the audio buffer in time. A stereo sample consists of both right - and left channels in LR ordering. - Note that the number of samples is directly related to time by the - following formula: ms = (samples*1000)/freq - 'desired->size' is the size in bytes of the audio buffer, and is - calculated by SDL_OpenAudio(). - 'desired->silence' is the value used to set the buffer to silence, - and is calculated by SDL_OpenAudio(). - 'desired->callback' should be set to a function that will be called - when the audio device is ready for more data. It is passed a pointer - to the audio buffer, and the length in bytes of the audio buffer. - This function usually runs in a separate thread, and so you should - protect data structures that it accesses by calling SDL_LockAudio() - and SDL_UnlockAudio() in your code. - 'desired->userdata' is passed as the first parameter to your callback - function. - - The audio device starts out playing silence when it's opened, and should - be enabled for playing by calling SDL_PauseAudio(0) when you are ready - for your audio callback function to be called. Since the audio driver - may modify the requested size of the audio buffer, you should allocate - any local mixing buffers after you open the audio device. } - -function SDL_OpenAudio(desired, obtained: PSDL_AudioSpec): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_OpenAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_OpenAudio} - -{ Get the current audio state: } -function SDL_GetAudioStatus: TSDL_Audiostatus; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetAudioStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetAudioStatus} - -{ This function pauses and unpauses the audio callback processing. - It should be called with a parameter of 0 after opening the audio - device to start playing sound. This is so you can safely initialize - data for your callback function after opening the audio device. - Silence will be written to the audio device during the pause. } - -procedure SDL_PauseAudio(pause_on: Integer); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PauseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_PauseAudio} - -{ This function loads a WAVE from the data source, automatically freeing - that source if 'freesrc' is non-zero. For example, to load a WAVE file, - you could do: - SDL_LoadWAV_RW(SDL_RWFromFile("sample.wav", "rb"), 1, ...); - - If this function succeeds, it returns the given SDL_AudioSpec, - filled with the audio data format of the wave data, and sets - 'audio_buf' to a malloc()'d buffer containing the audio data, - and sets 'audio_len' to the length of that audio buffer, in bytes. - You need to free the audio buffer with SDL_FreeWAV() when you are - done with it. - - This function returns NULL and sets the SDL error message if the - wave file cannot be opened, uses an unknown data format, or is - corrupt. Currently raw and MS-ADPCM WAVE files are supported. } - -function SDL_LoadWAV_RW(src: PSDL_RWops; freesrc: Integer; spec: - PSDL_AudioSpec; audio_buf: PUInt8; audiolen: PUInt32): PSDL_AudioSpec; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadWAV_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LoadWAV_RW} - -// Compatibility convenience function -- loads a WAV from a file -function SDL_LoadWAV(filename: PAnsiChar; spec: PSDL_AudioSpec; audio_buf: - PUInt8; audiolen: PUInt32): PSDL_AudioSpec; -{$EXTERNALSYM SDL_LoadWAV} - -{ This function frees data previously allocated with SDL_LoadWAV_RW() } - -procedure SDL_FreeWAV(audio_buf: PUInt8); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeWAV'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_FreeWAV} - -{ This function takes a source format and rate and a destination format - and rate, and initializes the 'cvt' structure with information needed - by SDL_ConvertAudio() to convert a buffer of audio data from one format - to the other. - This function returns 0, or -1 if there was an error. } -function SDL_BuildAudioCVT(cvt: PSDL_AudioCVT; src_format: UInt16; - src_channels: UInt8; src_rate: Integer; dst_format: UInt16; dst_channels: UInt8; - dst_rate: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_BuildAudioCVT'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_BuildAudioCVT} - -{ Once you have initialized the 'cvt' structure using SDL_BuildAudioCVT(), - created an audio buffer cvt->buf, and filled it with cvt->len bytes of - audio data in the source format, this function will convert it in-place - to the desired format. - The data conversion may expand the size of the audio data, so the buffer - cvt->buf should be allocated after the cvt structure is initialized by - SDL_BuildAudioCVT(), and should be cvt->len*cvt->len_mult bytes long. } -function SDL_ConvertAudio(cvt: PSDL_AudioCVT): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ConvertAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_ConvertAudio} - -{ This takes two audio buffers of the playing audio format and mixes - them, performing addition, volume adjustment, and overflow clipping. - The volume ranges from 0 - 128, and should be set to SDL_MIX_MAXVOLUME - for full audio volume. Note this does not change hardware volume. - This is provided for convenience -- you can mix your own audio data. } - -procedure SDL_MixAudio(dst, src: PUInt8; len: UInt32; volume: Integer); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MixAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_MixAudio} - -{ The lock manipulated by these functions protects the callback function. - During a LockAudio/UnlockAudio pair, you can be guaranteed that the - callback function is not running. Do not call these from the callback - function or you will cause deadlock. } -procedure SDL_LockAudio; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LockAudio} -procedure SDL_UnlockAudio; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_UnlockAudio} - -{ This function shuts down audio processing and closes the audio device. } - -procedure SDL_CloseAudio; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CloseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CloseAudio} - -{------------------------------------------------------------------------------} -{ CD-routines } -{------------------------------------------------------------------------------} - -{ Returns the number of CD-ROM drives on the system, or -1 if - SDL_Init() has not been called with the SDL_INIT_CDROM flag. } - -function SDL_CDNumDrives: Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDNumDrives'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDNumDrives} - -{ Returns a human-readable, system-dependent identifier for the CD-ROM. - Example: - "/dev/cdrom" - "E:" - "/dev/disk/ide/1/master" } - -function SDL_CDName(drive: Integer): PAnsiChar; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDName} - -{ Opens a CD-ROM drive for access. It returns a drive handle on success, - or NULL if the drive was invalid or busy. This newly opened CD-ROM - becomes the default CD used when other CD functions are passed a NULL - CD-ROM handle. - Drives are numbered starting with 0. Drive 0 is the system default CD-ROM. } - -function SDL_CDOpen(drive: Integer): PSDL_CD; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDOpen} - -{ This function returns the current status of the given drive. - If the drive has a CD in it, the table of contents of the CD and current - play position of the CD will be stored in the SDL_CD structure. } - -function SDL_CDStatus(cdrom: PSDL_CD): TSDL_CDStatus; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDStatus} - -{ Play the given CD starting at 'start_track' and 'start_frame' for 'ntracks' - tracks and 'nframes' frames. If both 'ntrack' and 'nframe' are 0, play - until the end of the CD. This function will skip data tracks. - This function should only be called after calling SDL_CDStatus() to - get track information about the CD. - - For example: - // Play entire CD: - if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) then - SDL_CDPlayTracks(cdrom, 0, 0, 0, 0); - // Play last track: - if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) then - begin - SDL_CDPlayTracks(cdrom, cdrom->numtracks-1, 0, 0, 0); - end; - - // Play first and second track and 10 seconds of third track: - if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) - SDL_CDPlayTracks(cdrom, 0, 0, 2, 10); - - This function returns 0, or -1 if there was an error. } - -function SDL_CDPlayTracks(cdrom: PSDL_CD; start_track: Integer; start_frame: - Integer; ntracks: Integer; nframes: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPlayTracks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDPlayTracks} - - -{ Play the given CD starting at 'start' frame for 'length' frames. - It returns 0, or -1 if there was an error. } - -function SDL_CDPlay(cdrom: PSDL_CD; start: Integer; length: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDPlay} - -// Pause play -- returns 0, or -1 on error -function SDL_CDPause(cdrom: PSDL_CD): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPause'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDPause} - -// Resume play -- returns 0, or -1 on error -function SDL_CDResume(cdrom: PSDL_CD): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDResume'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDResume} - -// Stop play -- returns 0, or -1 on error -function SDL_CDStop(cdrom: PSDL_CD): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDStop'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDStop} - -// Eject CD-ROM -- returns 0, or -1 on error -function SDL_CDEject(cdrom: PSDL_CD): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDEject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDEject} - -// Closes the handle for the CD-ROM drive -procedure SDL_CDClose(cdrom: PSDL_CD); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDClose'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CDClose} - -// Given a status, returns true if there's a disk in the drive -function SDL_CDInDrive( status : TSDL_CDStatus ) : LongBool; -{$EXTERNALSYM SDL_CDInDrive} - -// Conversion functions from frames to Minute/Second/Frames and vice versa -procedure FRAMES_TO_MSF(frames: Integer; var M: Integer; var S: Integer; var - F: Integer); -{$EXTERNALSYM FRAMES_TO_MSF} -function MSF_TO_FRAMES(M: Integer; S: Integer; F: Integer): Integer; -{$EXTERNALSYM MSF_TO_FRAMES} - -{------------------------------------------------------------------------------} -{ JoyStick-routines } -{------------------------------------------------------------------------------} - -{ Count the number of joysticks attached to the system } -function SDL_NumJoysticks: Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_NumJoysticks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_NumJoysticks} - -{ Get the implementation dependent name of a joystick. - This can be called before any joysticks are opened. - If no name can be found, this function returns NULL. } -function SDL_JoystickName(index: Integer): PAnsiChar; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickName} - -{ Open a joystick for use - the index passed as an argument refers to - the N'th joystick on the system. This index is the value which will - identify this joystick in future joystick events. - - This function returns a joystick identifier, or NULL if an error occurred. } -function SDL_JoystickOpen(index: Integer): PSDL_Joystick; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickOpen} - -{ Returns 1 if the joystick has been opened, or 0 if it has not. } -function SDL_JoystickOpened(index: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickOpened'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickOpened} - -{ Get the device index of an opened joystick. } -function SDL_JoystickIndex(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickIndex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickIndex} - -{ Get the number of general axis controls on a joystick } -function SDL_JoystickNumAxes(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumAxes'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickNumAxes} - -{ Get the number of trackballs on a joystick - Joystick trackballs have only relative motion events associated - with them and their state cannot be polled. } -function SDL_JoystickNumBalls(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumBalls'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickNumBalls} - - -{ Get the number of POV hats on a joystick } -function SDL_JoystickNumHats(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumHats'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickNumHats} - -{ Get the number of buttons on a joystick } -function SDL_JoystickNumButtons(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumButtons'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickNumButtons} - -{ Update the current state of the open joysticks. - This is called automatically by the event loop if any joystick - events are enabled. } - -procedure SDL_JoystickUpdate; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickUpdate'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickUpdate;} - -{ Enable/disable joystick event polling. - If joystick events are disabled, you must call SDL_JoystickUpdate() - yourself and check the state of the joystick when you want joystick - information. - The state can be one of SDL_QUERY, SDL_ENABLE or SDL_IGNORE. } - -function SDL_JoystickEventState(state: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickEventState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickEventState} - -{ Get the current state of an axis control on a joystick - The state is a value ranging from -32768 to 32767. - The axis indices start at index 0. } - -function SDL_JoystickGetAxis(joystick: PSDL_Joystick; axis: Integer) : SInt16; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetAxis'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickGetAxis} - -{ The hat indices start at index 0. } - -function SDL_JoystickGetHat(joystick: PSDL_Joystick; hat: Integer): UInt8; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetHat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickGetHat} - -{ Get the ball axis change since the last poll - This returns 0, or -1 if you passed it invalid parameters. - The ball indices start at index 0. } - -function SDL_JoystickGetBall(joystick: PSDL_Joystick; ball: Integer; var dx: Integer; var dy: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetBall'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickGetBall} - -{ Get the current state of a button on a joystick - The button indices start at index 0. } -function SDL_JoystickGetButton( joystick: PSDL_Joystick; Button: Integer): UInt8; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetButton'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickGetButton} - -{ Close a joystick previously opened with SDL_JoystickOpen() } -procedure SDL_JoystickClose(joystick: PSDL_Joystick); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickClose'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_JoystickClose} - -{------------------------------------------------------------------------------} -{ event-handling } -{------------------------------------------------------------------------------} - -{ Pumps the event loop, gathering events from the input devices. - This function updates the event queue and internal input device state. - This should only be run in the thread that sets the video mode. } - -procedure SDL_PumpEvents; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PumpEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_PumpEvents;} - -{ Checks the event queue for messages and optionally returns them. - If 'action' is SDL_ADDEVENT, up to 'numevents' events will be added to - the back of the event queue. - If 'action' is SDL_PEEKEVENT, up to 'numevents' events at the front - of the event queue, matching 'mask', will be returned and will not - be removed from the queue. - If 'action' is SDL_GETEVENT, up to 'numevents' events at the front - of the event queue, matching 'mask', will be returned and will be - removed from the queue. - This function returns the number of events actually stored, or -1 - if there was an error. This function is thread-safe. } - -function SDL_PeepEvents(events: PSDL_Event; numevents: Integer; action: TSDL_eventaction; mask: UInt32): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PeepEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_PeepEvents} - -{ Polls for currently pending events, and returns 1 if there are any pending - events, or 0 if there are none available. If 'event' is not NULL, the next - event is removed from the queue and stored in that area. } - -function SDL_PollEvent(event: PSDL_Event): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PollEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_PollEvent} - -{ Waits indefinitely for the next available event, returning 1, or 0 if there - was an error while waiting for events. If 'event' is not NULL, the next - event is removed from the queue and stored in that area. } - -function SDL_WaitEvent(event: PSDL_Event): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WaitEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WaitEvent} - -function SDL_PushEvent( event : PSDL_Event ) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PushEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_PushEvent} - -{ If the filter returns 1, then the event will be added to the internal queue. - If it returns 0, then the event will be dropped from the queue, but the - internal state will still be updated. This allows selective filtering of - dynamically arriving events. - - WARNING: Be very careful of what you do in the event filter function, as - it may run in a different thread! - - There is one caveat when dealing with the SDL_QUITEVENT event type. The - event filter is only called when the window manager desires to close the - application window. If the event filter returns 1, then the window will - be closed, otherwise the window will remain open if possible. - If the quit event is generated by an interrupt signal, it will bypass the - internal queue and be delivered to the application at the next event poll. } -procedure SDL_SetEventFilter( filter : TSDL_EventFilter ); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetEventFilter} - -{ Return the current event filter - can be used to "chain" filters. - If there is no event filter set, this function returns NULL. } - -function SDL_GetEventFilter: TSDL_EventFilter; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetEventFilter} - -{ This function allows you to set the state of processing certain events. - If 'state' is set to SDL_IGNORE, that event will be automatically dropped - from the event queue and will not event be filtered. - If 'state' is set to SDL_ENABLE, that event will be processed normally. - If 'state' is set to SDL_QUERY, SDL_EventState() will return the - current processing state of the specified event. } - -function SDL_EventState(type_: UInt8; state: Integer): UInt8; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EventState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_EventState} - -{------------------------------------------------------------------------------} -{ Version Routines } -{------------------------------------------------------------------------------} - -{ This macro can be used to fill a version structure with the compile-time - version of the SDL library. } -procedure SDL_VERSION(var X: TSDL_Version); -{$EXTERNALSYM SDL_VERSION} - -{ This macro turns the version numbers into a numeric value: - (1,2,3) -> (1203) - This assumes that there will never be more than 100 patchlevels } - -function SDL_VERSIONNUM(X, Y, Z: Integer): Integer; -{$EXTERNALSYM SDL_VERSIONNUM} - -// This is the version number macro for the current SDL version -function SDL_COMPILEDVERSION: Integer; -{$EXTERNALSYM SDL_COMPILEDVERSION} - -// This macro will evaluate to true if compiled with SDL at least X.Y.Z -function SDL_VERSION_ATLEAST(X: Integer; Y: Integer; Z: Integer) : LongBool; -{$EXTERNALSYM SDL_VERSION_ATLEAST} - -{ This function gets the version of the dynamically linked SDL library. - it should NOT be used to fill a version structure, instead you should - use the SDL_Version() macro. } - -function SDL_Linked_Version: PSDL_version; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Linked_Version'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_Linked_Version} - -{------------------------------------------------------------------------------} -{ video } -{------------------------------------------------------------------------------} - -{ These functions are used internally, and should not be used unless you - have a specific need to specify the video driver you want to use. - You should normally use SDL_Init() or SDL_InitSubSystem(). - - SDL_VideoInit() initializes the video subsystem -- sets up a connection - to the window manager, etc, and determines the current video mode and - pixel format, but does not initialize a window or graphics mode. - Note that event handling is activated by this routine. - - If you use both sound and video in your application, you need to call - SDL_Init() before opening the sound device, otherwise under Win32 DirectX, - you won't be able to set full-screen display modes. } - -function SDL_VideoInit(driver_name: PAnsiChar; flags: UInt32): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_VideoInit} -procedure SDL_VideoQuit; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_VideoQuit} - -{ This function fills the given character buffer with the name of the - video driver, and returns a pointer to it if the video driver has - been initialized. It returns NULL if no driver has been initialized. } - -function SDL_VideoDriverName(namebuf: PAnsiChar; maxlen: Integer): PAnsiChar; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_VideoDriverName} - -{ This function returns a pointer to the current display surface. - If SDL is doing format conversion on the display surface, this - function returns the publicly visible surface, not the real video - surface. } - -function SDL_GetVideoSurface: PSDL_Surface; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetVideoSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetVideoSurface} - -{ This function returns a read-only pointer to information about the - video hardware. If this is called before SDL_SetVideoMode(), the 'vfmt' - member of the returned structure will contain the pixel format of the - "best" video mode. } -function SDL_GetVideoInfo: PSDL_VideoInfo; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetVideoInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetVideoInfo} - -{ Check to see if a particular video mode is supported. - It returns 0 if the requested mode is not supported under any bit depth, - or returns the bits-per-pixel of the closest available mode with the - given width and height. If this bits-per-pixel is different from the - one used when setting the video mode, SDL_SetVideoMode() will succeed, - but will emulate the requested bits-per-pixel with a shadow surface. - - The arguments to SDL_VideoModeOK() are the same ones you would pass to - SDL_SetVideoMode() } - -function SDL_VideoModeOK(width, height, bpp: Integer; flags: UInt32): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoModeOK'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_VideoModeOK} - -{ Return a pointer to an array of available screen dimensions for the - given format and video flags, sorted largest to smallest. Returns - NULL if there are no dimensions available for a particular format, - or (SDL_Rect **)-1 if any dimension is okay for the given format. - - if 'format' is NULL, the mode list will be for the format given - by SDL_GetVideoInfo( ) - > vfmt } - -function SDL_ListModes(format: PSDL_PixelFormat; flags: UInt32): PPSDL_Rect; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ListModes'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_ListModes} - - -{ Set up a video mode with the specified width, height and bits-per-pixel. - - If 'bpp' is 0, it is treated as the current display bits per pixel. - - If SDL_ANYFORMAT is set in 'flags', the SDL library will try to set the - requested bits-per-pixel, but will return whatever video pixel format is - available. The default is to emulate the requested pixel format if it - is not natively available. - - If SDL_HWSURFACE is set in 'flags', the video surface will be placed in - video memory, if possible, and you may have to call SDL_LockSurface() - in order to access the raw framebuffer. Otherwise, the video surface - will be created in system memory. - - If SDL_ASYNCBLIT is set in 'flags', SDL will try to perform rectangle - updates asynchronously, but you must always lock before accessing pixels. - SDL will wait for updates to complete before returning from the lock. - - If SDL_HWPALETTE is set in 'flags', the SDL library will guarantee - that the colors set by SDL_SetColors() will be the colors you get. - Otherwise, in 8-bit mode, SDL_SetColors() may not be able to set all - of the colors exactly the way they are requested, and you should look - at the video surface structure to determine the actual palette. - If SDL cannot guarantee that the colors you request can be set, - i.e. if the colormap is shared, then the video surface may be created - under emulation in system memory, overriding the SDL_HWSURFACE flag. - - If SDL_FULLSCREEN is set in 'flags', the SDL library will try to set - a fullscreen video mode. The default is to create a windowed mode - if the current graphics system has a window manager. - If the SDL library is able to set a fullscreen video mode, this flag - will be set in the surface that is returned. - - If SDL_DOUBLEBUF is set in 'flags', the SDL library will try to set up - two surfaces in video memory and swap between them when you call - SDL_Flip(). This is usually slower than the normal single-buffering - scheme, but prevents "tearing" artifacts caused by modifying video - memory while the monitor is refreshing. It should only be used by - applications that redraw the entire screen on every update. - - This function returns the video framebuffer surface, or NULL if it fails. } - -function SDL_SetVideoMode(width, height, bpp: Integer; flags: UInt32): PSDL_Surface; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetVideoMode'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetVideoMode} - - -{ Makes sure the given list of rectangles is updated on the given screen. - If 'x', 'y', 'w' and 'h' are all 0, SDL_UpdateRect will update the entire - screen. - These functions should not be called while 'screen' is locked. } - -procedure SDL_UpdateRects(screen: PSDL_Surface; numrects: Integer; rects: PSDL_Rect); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_UpdateRects} -procedure SDL_UpdateRect(screen: PSDL_Surface; x, y: SInt32; w, h: UInt32); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpdateRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_UpdateRect} - - -{ On hardware that supports double-buffering, this function sets up a flip - and returns. The hardware will wait for vertical retrace, and then swap - video buffers before the next video surface blit or lock will return. - On hardware that doesn not support double-buffering, this is equivalent - to calling SDL_UpdateRect(screen, 0, 0, 0, 0); - The SDL_DOUBLEBUF flag must have been passed to SDL_SetVideoMode() when - setting the video mode for this function to perform hardware flipping. - This function returns 0 if successful, or -1 if there was an error.} - -function SDL_Flip(screen: PSDL_Surface): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Flip'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_Flip} - -{ Set the gamma correction for each of the color channels. - The gamma values range (approximately) between 0.1 and 10.0 - - If this function isn't supported directly by the hardware, it will - be emulated using gamma ramps, if available. If successful, this - function returns 0, otherwise it returns -1. } - -function SDL_SetGamma(redgamma: single; greengamma: single; bluegamma: single ): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetGamma'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetGamma} - -{ Set the gamma translation table for the red, green, and blue channels - of the video hardware. Each table is an array of 256 16-bit quantities, - representing a mapping between the input and output for that channel. - The input is the index into the array, and the output is the 16-bit - gamma value at that index, scaled to the output color precision. - - You may pass NULL for any of the channels to leave it unchanged. - If the call succeeds, it will return 0. If the display driver or - hardware does not support gamma translation, or otherwise fails, - this function will return -1. } - -function SDL_SetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetGammaRamp} - -{ Retrieve the current values of the gamma translation tables. - - You must pass in valid pointers to arrays of 256 16-bit quantities. - Any of the pointers may be NULL to ignore that channel. - If the call succeeds, it will return 0. If the display driver or - hardware does not support gamma translation, or otherwise fails, - this function will return -1. } - -function SDL_GetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetGammaRamp} - -{ Sets a portion of the colormap for the given 8-bit surface. If 'surface' - is not a palettized surface, this function does nothing, returning 0. - If all of the colors were set as passed to SDL_SetColors(), it will - return 1. If not all the color entries were set exactly as given, - it will return 0, and you should look at the surface palette to - determine the actual color palette. - - When 'surface' is the surface associated with the current display, the - display colormap will be updated with the requested colors. If - SDL_HWPALETTE was set in SDL_SetVideoMode() flags, SDL_SetColors() - will always return 1, and the palette is guaranteed to be set the way - you desire, even if the window colormap has to be warped or run under - emulation. } - - -function SDL_SetColors(surface: PSDL_Surface; colors: PSDL_Color; firstcolor : Integer; ncolors: Integer) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetColors'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetColors} - -{ Sets a portion of the colormap for a given 8-bit surface. - 'flags' is one or both of: - SDL_LOGPAL -- set logical palette, which controls how blits are mapped - to/from the surface, - SDL_PHYSPAL -- set physical palette, which controls how pixels look on - the screen - Only screens have physical palettes. Separate change of physical/logical - palettes is only possible if the screen has SDL_HWPALETTE set. - - The return value is 1 if all colours could be set as requested, and 0 - otherwise. - - SDL_SetColors() is equivalent to calling this function with - flags = (SDL_LOGPAL or SDL_PHYSPAL). } - -function SDL_SetPalette(surface: PSDL_Surface; flags: Integer; colors: PSDL_Color; firstcolor: Integer; ncolors: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetPalette'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetPalette} - -{ Maps an RGB triple to an opaque pixel value for a given pixel format } -function SDL_MapRGB(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8) : UInt32; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MapRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_MapRGB} - -{ Maps an RGBA quadruple to a pixel value for a given pixel format } -function SDL_MapRGBA(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8; a: UInt8): UInt32; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MapRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_MapRGBA} - -{ Maps a pixel value into the RGB components for a given pixel format } -procedure SDL_GetRGB(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetRGB} - -{ Maps a pixel value into the RGBA components for a given pixel format } -procedure SDL_GetRGBA(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8; a: PUInt8); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetRGBA} - -{ Allocate and free an RGB surface (must be called after SDL_SetVideoMode) - If the depth is 4 or 8 bits, an empty palette is allocated for the surface. - If the depth is greater than 8 bits, the pixel format is set using the - flags '[RGB]mask'. - If the function runs out of memory, it will return NULL. - - The 'flags' tell what kind of surface to create. - SDL_SWSURFACE means that the surface should be created in system memory. - SDL_HWSURFACE means that the surface should be created in video memory, - with the same format as the display surface. This is useful for surfaces - that will not change much, to take advantage of hardware acceleration - when being blitted to the display surface. - SDL_ASYNCBLIT means that SDL will try to perform asynchronous blits with - this surface, but you must always lock it before accessing the pixels. - SDL will wait for current blits to finish before returning from the lock. - SDL_SRCCOLORKEY indicates that the surface will be used for colorkey blits. - If the hardware supports acceleration of colorkey blits between - two surfaces in video memory, SDL will try to place the surface in - video memory. If this isn't possible or if there is no hardware - acceleration available, the surface will be placed in system memory. - SDL_SRCALPHA means that the surface will be used for alpha blits and - if the hardware supports hardware acceleration of alpha blits between - two surfaces in video memory, to place the surface in video memory - if possible, otherwise it will be placed in system memory. - If the surface is created in video memory, blits will be _much_ faster, - but the surface format must be identical to the video surface format, - and the only way to access the pixels member of the surface is to use - the SDL_LockSurface() and SDL_UnlockSurface() calls. - If the requested surface actually resides in video memory, SDL_HWSURFACE - will be set in the flags member of the returned surface. If for some - reason the surface could not be placed in video memory, it will not have - the SDL_HWSURFACE flag set, and will be created in system memory instead. } - -function SDL_AllocSurface(flags: UInt32; width, height, depth: Integer; - RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; -{$EXTERNALSYM SDL_AllocSurface} - -function SDL_CreateRGBSurface(flags: UInt32; width, height, depth: Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateRGBSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateRGBSurface} - -function SDL_CreateRGBSurfaceFrom(pixels: Pointer; width, height, depth, pitch - : Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateRGBSurfaceFrom'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateRGBSurfaceFrom} - -procedure SDL_FreeSurface(surface: PSDL_Surface); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_FreeSurface} - -function SDL_MustLock(Surface: PSDL_Surface): Boolean; -{$EXTERNALSYM SDL_MustLock} -{ SDL_LockSurface() sets up a surface for directly accessing the pixels. - Between calls to SDL_LockSurface()/SDL_UnlockSurface(), you can write - to and read from 'surface->pixels', using the pixel format stored in - 'surface->format'. Once you are done accessing the surface, you should - use SDL_UnlockSurface() to release it. - - Not all surfaces require locking. If SDL_MUSTLOCK(surface) evaluates - to 0, then you can read and write to the surface at any time, and the - pixel format of the surface will not change. In particular, if the - SDL_HWSURFACE flag is not given when calling SDL_SetVideoMode(), you - will not need to lock the display surface before accessing it. - - No operating system or library calls should be made between lock/unlock - pairs, as critical system locks may be held during this time. - - SDL_LockSurface() returns 0, or -1 if the surface couldn't be locked. } -function SDL_LockSurface(surface: PSDL_Surface): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LockSurface} - -procedure SDL_UnlockSurface(surface: PSDL_Surface); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_UnlockSurface} - -{ Load a surface from a seekable SDL data source (memory or file.) - If 'freesrc' is non-zero, the source will be closed after being read. - Returns the new surface, or NULL if there was an error. - The new surface should be freed with SDL_FreeSurface(). } -function SDL_LoadBMP_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LoadBMP_RW} - -// Convenience macro -- load a surface from a file -function SDL_LoadBMP(filename: PAnsiChar): PSDL_Surface; -{$EXTERNALSYM SDL_LoadBMP} - -{ Save a surface to a seekable SDL data source (memory or file.) - If 'freedst' is non-zero, the source will be closed after being written. - Returns 0 if successful or -1 if there was an error. } - -function SDL_SaveBMP_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SaveBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SaveBMP_RW} - -// Convenience macro -- save a surface to a file -function SDL_SaveBMP(surface: PSDL_Surface; filename: PAnsiChar): Integer; -{$EXTERNALSYM SDL_SaveBMP} - -{ Sets the color key (transparent pixel) in a blittable surface. - If 'flag' is SDL_SRCCOLORKEY (optionally OR'd with SDL_RLEACCEL), - 'key' will be the transparent pixel in the source image of a blit. - SDL_RLEACCEL requests RLE acceleration for the surface if present, - and removes RLE acceleration if absent. - If 'flag' is 0, this function clears any current color key. - This function returns 0, or -1 if there was an error. } - -function SDL_SetColorKey(surface: PSDL_Surface; flag, key: UInt32) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetColorKey'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetColorKey} - -{ This function sets the alpha value for the entire surface, as opposed to - using the alpha component of each pixel. This value measures the range - of transparency of the surface, 0 being completely transparent to 255 - being completely opaque. An 'alpha' value of 255 causes blits to be - opaque, the source pixels copied to the destination (the default). Note - that per-surface alpha can be combined with colorkey transparency. - - If 'flag' is 0, alpha blending is disabled for the surface. - If 'flag' is SDL_SRCALPHA, alpha blending is enabled for the surface. - OR:ing the flag with SDL_RLEACCEL requests RLE acceleration for the - surface; if SDL_RLEACCEL is not specified, the RLE accel will be removed. } - - -function SDL_SetAlpha(surface: PSDL_Surface; flag: UInt32; alpha: UInt8): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetAlpha} - -{ Sets the clipping rectangle for the destination surface in a blit. - - If the clip rectangle is NULL, clipping will be disabled. - If the clip rectangle doesn't intersect the surface, the function will - return SDL_FALSE and blits will be completely clipped. Otherwise the - function returns SDL_TRUE and blits to the surface will be clipped to - the intersection of the surface area and the clipping rectangle. - - Note that blits are automatically clipped to the edges of the source - and destination surfaces. } -procedure SDL_SetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl; -external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetClipRect} - -{ Gets the clipping rectangle for the destination surface in a blit. - 'rect' must be a pointer to a valid rectangle which will be filled - with the correct values. } -procedure SDL_GetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl; -external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetClipRect} - -{ Creates a new surface of the specified format, and then copies and maps - the given surface to it so the blit of the converted surface will be as - fast as possible. If this function fails, it returns NULL. - - The 'flags' parameter is passed to SDL_CreateRGBSurface() and has those - semantics. You can also pass SDL_RLEACCEL in the flags parameter and - SDL will try to RLE accelerate colorkey and alpha blits in the resulting - surface. - - This function is used internally by SDL_DisplayFormat(). } - -function SDL_ConvertSurface(src: PSDL_Surface; fmt: PSDL_PixelFormat; flags: UInt32): PSDL_Surface; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ConvertSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_ConvertSurface} - -{ - This performs a fast blit from the source surface to the destination - surface. It assumes that the source and destination rectangles are - the same size. If either 'srcrect' or 'dstrect' are NULL, the entire - surface (src or dst) is copied. The final blit rectangles are saved - in 'srcrect' and 'dstrect' after all clipping is performed. - If the blit is successful, it returns 0, otherwise it returns -1. - - The blit function should not be called on a locked surface. - - The blit semantics for surfaces with and without alpha and colorkey - are defined as follows: - - RGBA->RGB: - SDL_SRCALPHA set: - alpha-blend (using alpha-channel). - SDL_SRCCOLORKEY ignored. - SDL_SRCALPHA not set: - copy RGB. - if SDL_SRCCOLORKEY set, only copy the pixels matching the - RGB values of the source colour key, ignoring alpha in the - comparison. - - RGB->RGBA: - SDL_SRCALPHA set: - alpha-blend (using the source per-surface alpha value); - set destination alpha to opaque. - SDL_SRCALPHA not set: - copy RGB, set destination alpha to opaque. - both: - if SDL_SRCCOLORKEY set, only copy the pixels matching the - source colour key. - - RGBA->RGBA: - SDL_SRCALPHA set: - alpha-blend (using the source alpha channel) the RGB values; - leave destination alpha untouched. [Note: is this correct?] - SDL_SRCCOLORKEY ignored. - SDL_SRCALPHA not set: - copy all of RGBA to the destination. - if SDL_SRCCOLORKEY set, only copy the pixels matching the - RGB values of the source colour key, ignoring alpha in the - comparison. - - RGB->RGB: - SDL_SRCALPHA set: - alpha-blend (using the source per-surface alpha value). - SDL_SRCALPHA not set: - copy RGB. - both: - if SDL_SRCCOLORKEY set, only copy the pixels matching the - source colour key. - - If either of the surfaces were in video memory, and the blit returns -2, - the video memory was lost, so it should be reloaded with artwork and - re-blitted: - while ( SDL_BlitSurface(image, imgrect, screen, dstrect) = -2 ) do - begin - while ( SDL_LockSurface(image) < 0 ) do - Sleep(10); - -- Write image pixels to image->pixels -- - SDL_UnlockSurface(image); - end; - - This happens under DirectX 5.0 when the system switches away from your - fullscreen application. The lock will also fail until you have access - to the video memory again. } - -{ You should call SDL_BlitSurface() unless you know exactly how SDL - blitting works internally and how to use the other blit functions. } - -function SDL_BlitSurface(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; -{$EXTERNALSYM SDL_BlitSurface} - -{ This is the public blit function, SDL_BlitSurface(), and it performs - rectangle validation and clipping before passing it to SDL_LowerBlit() } -function SDL_UpperBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpperBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_UpperBlit} - -{ This is a semi-private blit function and it performs low-level surface - blitting only. } -function SDL_LowerBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LowerBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LowerBlit} - -{ This function performs a fast fill of the given rectangle with 'color' - The given rectangle is clipped to the destination surface clip area - and the final fill rectangle is saved in the passed in pointer. - If 'dstrect' is NULL, the whole surface will be filled with 'color' - The color should be a pixel of the format used by the surface, and - can be generated by the SDL_MapRGB() function. - This function returns 0 on success, or -1 on error. } - -function SDL_FillRect(dst: PSDL_Surface; dstrect: PSDL_Rect; color: UInt32) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FillRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_FillRect} - -{ This function takes a surface and copies it to a new surface of the - pixel format and colors of the video framebuffer, suitable for fast - blitting onto the display surface. It calls SDL_ConvertSurface() - - If you want to take advantage of hardware colorkey or alpha blit - acceleration, you should set the colorkey and alpha value before - calling this function. - - If the conversion fails or runs out of memory, it returns NULL } - -function SDL_DisplayFormat(surface: PSDL_Surface): PSDL_Surface; cdecl; -external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayFormat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_DisplayFormat} - -{ This function takes a surface and copies it to a new surface of the - pixel format and colors of the video framebuffer (if possible), - suitable for fast alpha blitting onto the display surface. - The new surface will always have an alpha channel. - - If you want to take advantage of hardware colorkey or alpha blit - acceleration, you should set the colorkey and alpha value before - calling this function. - - If the conversion fails or runs out of memory, it returns NULL } - - -function SDL_DisplayFormatAlpha(surface: PSDL_Surface): PSDL_Surface; cdecl; -external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayFormatAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_DisplayFormatAlpha} - -//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ -//* YUV video surface overlay functions */ -//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ - -{ This function creates a video output overlay - Calling the returned surface an overlay is something of a misnomer because - the contents of the display surface underneath the area where the overlay - is shown is undefined - it may be overwritten with the converted YUV data. } - -function SDL_CreateYUVOverlay(width: Integer; height: Integer; format: UInt32; display: PSDL_Surface): PSDL_Overlay; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateYUVOverlay} - -// Lock an overlay for direct access, and unlock it when you are done -function SDL_LockYUVOverlay(Overlay: PSDL_Overlay): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LockYUVOverlay} - -procedure SDL_UnlockYUVOverlay(Overlay: PSDL_Overlay); cdecl; -external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_UnlockYUVOverlay} - - -{ Blit a video overlay to the display surface. - The contents of the video surface underneath the blit destination are - not defined. - The width and height of the destination rectangle may be different from - that of the overlay, but currently only 2x scaling is supported. } - -function SDL_DisplayYUVOverlay(Overlay: PSDL_Overlay; dstrect: PSDL_Rect) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_DisplayYUVOverlay} - -// Free a video overlay -procedure SDL_FreeYUVOverlay(Overlay: PSDL_Overlay); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_FreeYUVOverlay} - -{------------------------------------------------------------------------------} -{ OpenGL Routines } -{------------------------------------------------------------------------------} - -{ Dynamically load a GL driver, if SDL is built with dynamic GL. - - SDL links normally with the OpenGL library on your system by default, - but you can compile it to dynamically load the GL driver at runtime. - If you do this, you need to retrieve all of the GL functions used in - your program from the dynamic library using SDL_GL_GetProcAddress(). - - This is disabled in default builds of SDL. } - - -function SDL_GL_LoadLibrary(filename: PAnsiChar): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_LoadLibrary'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_LoadLibrary} - -{ Get the address of a GL function (for extension functions) } -function SDL_GL_GetProcAddress(procname: PAnsiChar) : Pointer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_GetProcAddress'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_GetProcAddress} - -{ Set an attribute of the OpenGL subsystem before intialization. } -function SDL_GL_SetAttribute(attr: TSDL_GLAttr; value: Integer) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_SetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_SetAttribute} - -{ Get an attribute of the OpenGL subsystem from the windowing - interface, such as glX. This is of course different from getting - the values from SDL's internal OpenGL subsystem, which only - stores the values you request before initialization. - - Developers should track the values they pass into SDL_GL_SetAttribute - themselves if they want to retrieve these values. } - -function SDL_GL_GetAttribute(attr: TSDL_GLAttr; var value: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_GetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_GetAttribute} - -{ Swap the OpenGL buffers, if double-buffering is supported. } - -procedure SDL_GL_SwapBuffers; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_SwapBuffers'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_SwapBuffers;} - -{ Internal functions that should not be called unless you have read - and understood the source code for these functions. } - -procedure SDL_GL_UpdateRects(numrects: Integer; rects: PSDL_Rect); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_UpdateRects} -procedure SDL_GL_Lock; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_Lock'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_Lock;} -procedure SDL_GL_Unlock; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_Unlock'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GL_Unlock;} - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -{* These functions allow interaction with the window manager, if any. *} -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} - -{ Sets/Gets the title and icon text of the display window } -procedure SDL_WM_GetCaption(var title : PAnsiChar; var icon : PAnsiChar); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_GetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WM_GetCaption} -procedure SDL_WM_SetCaption(const title : PAnsiChar; const icon : PAnsiChar); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_SetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WM_SetCaption} - -{ Sets the icon for the display window. - This function must be called before the first call to SDL_SetVideoMode(). - It takes an icon surface, and a mask in MSB format. - If 'mask' is NULL, the entire icon surface will be used as the icon. } -procedure SDL_WM_SetIcon(icon: PSDL_Surface; mask: UInt8); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_SetIcon'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WM_SetIcon} - -{ This function iconifies the window, and returns 1 if it succeeded. - If the function succeeds, it generates an SDL_APPACTIVE loss event. - This function is a noop and returns 0 in non-windowed environments. } - -function SDL_WM_IconifyWindow: Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_IconifyWindow'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WM_IconifyWindow} - -{ Toggle fullscreen mode without changing the contents of the screen. - If the display surface does not require locking before accessing - the pixel information, then the memory pointers will not change. - - If this function was able to toggle fullscreen mode (change from - running in a window to fullscreen, or vice-versa), it will return 1. - If it is not implemented, or fails, it returns 0. - - The next call to SDL_SetVideoMode() will set the mode fullscreen - attribute based on the flags parameter - if SDL_FULLSCREEN is not - set, then the display will be windowed by default where supported. - - This is currently only implemented in the X11 video driver. } - -function SDL_WM_ToggleFullScreen(surface: PSDL_Surface): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_ToggleFullScreen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WM_ToggleFullScreen} - -{ Grabbing means that the mouse is confined to the application window, - and nearly all keyboard input is passed directly to the application, - and not interpreted by a window manager, if any. } - -function SDL_WM_GrabInput(mode: TSDL_GrabMode): TSDL_GrabMode; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_GrabInput'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WM_GrabInput} - -{------------------------------------------------------------------------------} -{ mouse-routines } -{------------------------------------------------------------------------------} - -{ Retrieve the current state of the mouse. - The current button state is returned as a button bitmask, which can - be tested using the SDL_BUTTON(X) macros, and x and y are set to the - current mouse cursor position. You can pass NULL for either x or y. } - -function SDL_GetMouseState(var x: Integer; var y: Integer): UInt8; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetMouseState} - -{ Retrieve the current state of the mouse. - The current button state is returned as a button bitmask, which can - be tested using the SDL_BUTTON(X) macros, and x and y are set to the - mouse deltas since the last call to SDL_GetRelativeMouseState(). } -function SDL_GetRelativeMouseState(var x: Integer; var y: Integer): UInt8; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRelativeMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetRelativeMouseState} - -{ Set the position of the mouse cursor (generates a mouse motion event) } -procedure SDL_WarpMouse(x, y: UInt16); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WarpMouse'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WarpMouse} - -{ Create a cursor using the specified data and mask (in MSB format). - The cursor width must be a multiple of 8 bits. - - The cursor is created in black and white according to the following: - data mask resulting pixel on screen - 0 1 White - 1 1 Black - 0 0 Transparent - 1 0 Inverted color if possible, black if not. - - Cursors created with this function must be freed with SDL_FreeCursor(). } -function SDL_CreateCursor(data, mask: PUInt8; w, h, hot_x, hot_y: Integer): PSDL_Cursor; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateCursor} - -{ Set the currently active cursor to the specified one. - If the cursor is currently visible, the change will be immediately - represented on the display. } -procedure SDL_SetCursor(cursor: PSDL_Cursor); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetCursor} - -{ Returns the currently active cursor. } -function SDL_GetCursor: PSDL_Cursor; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetCursor} - -{ Deallocates a cursor created with SDL_CreateCursor(). } -procedure SDL_FreeCursor(cursor: PSDL_Cursor); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_FreeCursor} - -{ Toggle whether or not the cursor is shown on the screen. - The cursor start off displayed, but can be turned off. - SDL_ShowCursor() returns 1 if the cursor was being displayed - before the call, or 0 if it was not. You can query the current - state by passing a 'toggle' value of -1. } -function SDL_ShowCursor(toggle: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ShowCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_ShowCursor} - -function SDL_BUTTON( Button : Integer ) : Integer; - -{------------------------------------------------------------------------------} -{ Keyboard-routines } -{------------------------------------------------------------------------------} - -{ Enable/Disable UNICODE translation of keyboard input. - This translation has some overhead, so translation defaults off. - If 'enable' is 1, translation is enabled. - If 'enable' is 0, translation is disabled. - If 'enable' is -1, the translation state is not changed. - It returns the previous state of keyboard translation. } -function SDL_EnableUNICODE(enable: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EnableUNICODE'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_EnableUNICODE} - -{ If 'delay' is set to 0, keyboard repeat is disabled. } -function SDL_EnableKeyRepeat(delay: Integer; interval: Integer): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EnableKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_EnableKeyRepeat} - -procedure SDL_GetKeyRepeat(delay : PInteger; interval: PInteger); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetKeyRepeat} - -{ Get a snapshot of the current state of the keyboard. - Returns an array of keystates, indexed by the SDLK_* syms. - Used: - - UInt8 *keystate = SDL_GetKeyState(NULL); - if ( keystate[SDLK_RETURN] ) ... <RETURN> is pressed } - -function SDL_GetKeyState(numkeys: PInt): PUInt8; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetKeyState} - -{ Get the current key modifier state } -function SDL_GetModState: TSDLMod; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetModState} - -{ Set the current key modifier state - This does not change the keyboard state, only the key modifier flags. } -procedure SDL_SetModState(modstate: TSDLMod); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SetModState} - -{ Get the name of an SDL virtual keysym } -function SDL_GetKeyName(key: TSDLKey): PAnsiChar; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetKeyName} - -{------------------------------------------------------------------------------} -{ Active Routines } -{------------------------------------------------------------------------------} - -{ This function returns the current state of the application, which is a - bitwise combination of SDL_APPMOUSEFOCUS, SDL_APPINPUTFOCUS, and - SDL_APPACTIVE. If SDL_APPACTIVE is set, then the user is able to - see your application, otherwise it has been iconified or disabled. } - -function SDL_GetAppState: UInt8; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetAppState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetAppState} - - -{ Mutex functions } - -{ Create a mutex, initialized unlocked } - -function SDL_CreateMutex: PSDL_Mutex; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateMutex} - -{ Lock the mutex (Returns 0, or -1 on error) } - - function SDL_mutexP(mutex: PSDL_mutex): Integer; - cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_mutexP'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{ $ EXTERNALSYM SDL_mutexP} - -function SDL_LockMutex(mutex: PSDL_mutex): Integer; -{$EXTERNALSYM SDL_LockMutex} - -{ Unlock the mutex (Returns 0, or -1 on error) } -function SDL_mutexV(mutex: PSDL_mutex): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_mutexV'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_mutexV} - -function SDL_UnlockMutex(mutex: PSDL_mutex): Integer; -{$EXTERNALSYM SDL_UnlockMutex} - -{ Destroy a mutex } -procedure SDL_DestroyMutex(mutex: PSDL_mutex); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroyMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_DestroyMutex} - -{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } -{ Semaphore functions } -{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } -{ Create a semaphore, initialized with value, returns NULL on failure. } -function SDL_CreateSemaphore(initial_value: UInt32): PSDL_Sem; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateSemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateSemaphore} - - -{ Destroy a semaphore } -procedure SDL_DestroySemaphore(sem: PSDL_sem); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroySemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_DestroySemaphore} - -{ This function suspends the calling thread until the semaphore pointed - to by sem has a positive count. It then atomically decreases the semaphore - count. } - -function SDL_SemWait(sem: PSDL_sem): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SemWait} - -{ Non-blocking variant of SDL_SemWait(), returns 0 if the wait succeeds, - SDL_MUTEX_TIMEDOUT if the wait would block, and -1 on error. } - -function SDL_SemTryWait(sem: PSDL_sem): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemTryWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SemTryWait} - -{ Variant of SDL_SemWait() with a timeout in milliseconds, returns 0 if - the wait succeeds, SDL_MUTEX_TIMEDOUT if the wait does not succeed in - the allotted time, and -1 on error. - On some platforms this function is implemented by looping with a delay - of 1 ms, and so should be avoided if possible. } - -function SDL_SemWaitTimeout(sem: PSDL_sem; ms: UInt32): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SemTryWait} - -{ Atomically increases the semaphore's count (not blocking), returns 0, - or -1 on error. } - -function SDL_SemPost(sem: PSDL_sem): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemPost'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SemTryWait} - -{ Returns the current count of the semaphore } - -function SDL_SemValue(sem: PSDL_sem): UInt32; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemValue'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_SemValue} - -{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } -{ Condition variable functions } -{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } -{ Create a condition variable } -function SDL_CreateCond: PSDL_Cond; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateCond'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateCond} - -{ Destroy a condition variable } -procedure SDL_DestroyCond(cond: PSDL_Cond); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroyCond'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_DestroyCond} - -{ Restart one of the threads that are waiting on the condition variable, - returns 0 or -1 on error. } - -function SDL_CondSignal(cond: PSDL_cond): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondSignal'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CondSignal} - -{ Restart all threads that are waiting on the condition variable, - returns 0 or -1 on error. } - -function SDL_CondBroadcast(cond: PSDL_cond): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondBroadcast'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CondBroadcast} - - -{ Wait on the condition variable, unlocking the provided mutex. - The mutex must be locked before entering this function! - Returns 0 when it is signaled, or -1 on error. } - -function SDL_CondWait(cond: PSDL_cond; mut: PSDL_mutex): Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CondWait} - -{ Waits for at most 'ms' milliseconds, and returns 0 if the condition - variable is signaled, SDL_MUTEX_TIMEDOUT if the condition is not - signaled in the allotted time, and -1 on error. - On some platforms this function is implemented by looping with a delay - of 1 ms, and so should be avoided if possible. } - -function SDL_CondWaitTimeout(cond: PSDL_cond; mut: PSDL_mutex; ms: UInt32) : Integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CondWaitTimeout} - -{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } -{ Condition variable functions } -{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } - -{ Create a thread } -function SDL_CreateThread(fn: PInt; data: Pointer): PSDL_Thread; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_CreateThread} - -{ Get the 32-bit thread identifier for the current thread } -function SDL_ThreadID: UInt32; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_ThreadID} - -{ Get the 32-bit thread identifier for the specified thread, - equivalent to SDL_ThreadID() if the specified thread is NULL. } -function SDL_GetThreadID(thread: PSDL_Thread): UInt32; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetThreadID} - -{ Wait for a thread to finish. - The return code for the thread function is placed in the area - pointed to by 'status', if 'status' is not NULL. } - -procedure SDL_WaitThread(thread: PSDL_Thread; var status: Integer); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WaitThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_WaitThread} - -{ Forcefully kill a thread without worrying about its state } -procedure SDL_KillThread(thread: PSDL_Thread); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_KillThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_KillThread} - -{------------------------------------------------------------------------------} -{ Get Environment Routines } -{------------------------------------------------------------------------------} -{$IFDEF WINDOWS} -function _putenv( const variable : PAnsiChar ): integer; -cdecl; -{$ENDIF} - -{$IFDEF Unix} -{$IFDEF FPC} -function _putenv( const variable : PAnsiChar ): integer; -cdecl; external 'libc.so' name 'putenv'; -{$ENDIF} -{$ENDIF} - -{ Put a variable of the form "name=value" into the environment } -//function SDL_putenv(const variable: PAnsiChar): integer; cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; -function SDL_putenv(const variable: PAnsiChar): integer; -{$EXTERNALSYM SDL_putenv} - -// The following function has been commented out to encourage developers to use -// SDL_putenv as it it more portable -//function putenv(const variable: PAnsiChar): integer; -//{$EXTERNALSYM putenv} - -{$IFDEF WINDOWS} -{$IFNDEF __GPC__} -function getenv( const name : PAnsiChar ): PAnsiChar; cdecl; -{$ENDIF} -{$ENDIF} - -{* Retrieve a variable named "name" from the environment } -//function SDL_getenv(const name: PAnsiChar): PAnsiChar; cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; -function SDL_getenv(const name: PAnsiChar): PAnsiChar; -{$EXTERNALSYM SDL_getenv} - -// The following function has been commented out to encourage developers to use -// SDL_getenv as it it more portable -//function getenv(const name: PAnsiChar): PAnsiChar; -//{$EXTERNALSYM getenv} - -{* - * This function gives you custom hooks into the window manager information. - * It fills the structure pointed to by 'info' with custom information and - * returns 1 if the function is implemented. If it's not implemented, or - * the version member of the 'info' structure is invalid, it returns 0. - *} -function SDL_GetWMInfo(info : PSDL_SysWMinfo) : integer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetWMInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_GetWMInfo} - -{------------------------------------------------------------------------------} - -//SDL_loadso.h -{* This function dynamically loads a shared object and returns a pointer - * to the object handle (or NULL if there was an error). - * The 'sofile' parameter is a system dependent name of the object file. - *} -function SDL_LoadObject( const sofile : PAnsiChar ) : Pointer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LoadObject} - -{* Given an object handle, this function looks up the address of the - * named function in the shared object and returns it. This address - * is no longer valid after calling SDL_UnloadObject(). - *} -function SDL_LoadFunction( handle : Pointer; const name : PAnsiChar ) : Pointer; -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadFunction'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_LoadFunction} - -{* Unload a shared object from memory *} -procedure SDL_UnloadObject( handle : Pointer ); -cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnloadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; -{$EXTERNALSYM SDL_UnloadObject} - - - -{------------------------------------------------------------------------------} - -function SDL_Swap32(D: Uint32): Uint32; -{$EXTERNALSYM SDL_Swap32} - -{ FreeAndNil frees the given TObject instance and sets the variable reference - to nil. Be careful to only pass TObjects to this routine. } -procedure FreeAndNil(var Obj); - -{ Exit procedure handling } - -{ AddExitProc adds the given procedure to the run-time library's exit - procedure list. When an application terminates, its exit procedures are - executed in reverse order of definition, i.e. the last procedure passed - to AddExitProc is the first one to get executed upon termination. } -procedure AddExitProc(Proc: TProcedure); - -// Bitwise Checking functions -function IsBitOn( value : integer; bit : Byte ) : boolean; - -function TurnBitOn( value : integer; bit : Byte ) : integer; - -function TurnBitOff( value : integer; bit : Byte ) : integer; - -implementation - -{$IFDEF __GPC__} - {$L 'sdl'} { link sdl.dll.a or libsdl.so or libsdl.a } -{$ENDIF} - -function SDL_TABLESIZE(table: PAnsiChar): Integer; -begin - Result := SizeOf(table) div SizeOf(table[0]); -end; - -procedure SDL_OutOfMemory; -begin - {$IFNDEF WINDOWS} - SDL_Error(SDL_ENOMEM); - {$ENDIF} -end; - -function SDL_RWSeek(context: PSDL_RWops; offset: Integer; whence: Integer) : Integer; -begin - Result := context^.seek(context, offset, whence); -end; - -function SDL_RWTell(context: PSDL_RWops): Integer; -begin - Result := context^.seek(context, 0, 1); -end; - -function SDL_RWRead(context: PSDL_RWops; ptr: Pointer; size: Integer; n: Integer): Integer; -begin - Result := context^.read(context, ptr, size, n); -end; - -function SDL_RWWrite(context: PSDL_RWops; ptr: Pointer; size: Integer; n: Integer): Integer; -begin - Result := context^.write(context, ptr, size, n); -end; - -function SDL_RWClose(context: PSDL_RWops): Integer; -begin - Result := context^.close(context); -end; - -function SDL_LoadWAV(filename: PAnsiChar; spec: PSDL_AudioSpec; audio_buf: PUInt8; audiolen: PUInt32): PSDL_AudioSpec; -begin - Result := SDL_LoadWAV_RW(SDL_RWFromFile(filename, 'rb'), 1, spec, audio_buf, audiolen); -end; - -function SDL_CDInDrive( status : TSDL_CDStatus ): LongBool; -begin - Result := ord( status ) > ord( CD_ERROR ); -end; - -procedure FRAMES_TO_MSF(frames: Integer; var M: Integer; var S: Integer; var - F: Integer); -var - value: Integer; -begin - value := frames; - F := value mod CD_FPS; - value := value div CD_FPS; - S := value mod 60; - value := value div 60; - M := value; -end; - -function MSF_TO_FRAMES(M: Integer; S: Integer; F: Integer): Integer; -begin - Result := M * 60 * CD_FPS + S * CD_FPS + F; -end; - -procedure SDL_VERSION(var X: TSDL_Version); -begin - X.major := SDL_MAJOR_VERSION; - X.minor := SDL_MINOR_VERSION; - X.patch := SDL_PATCHLEVEL; -end; - -function SDL_VERSIONNUM(X, Y, Z: Integer): Integer; -begin - Result := X * 1000 + Y * 100 + Z; -end; - -function SDL_COMPILEDVERSION: Integer; -begin - Result := SDL_VERSIONNUM(SDL_MAJOR_VERSION, SDL_MINOR_VERSION, SDL_PATCHLEVEL - ); -end; - -function SDL_VERSION_ATLEAST(X, Y, Z: Integer): LongBool; -begin - Result := (SDL_COMPILEDVERSION >= SDL_VERSIONNUM(X, Y, Z)); -end; - -function SDL_LoadBMP(filename: PAnsiChar): PSDL_Surface; -begin - Result := SDL_LoadBMP_RW(SDL_RWFromFile(filename, 'rb'), 1); -end; - -function SDL_SaveBMP(surface: PSDL_Surface; filename: PAnsiChar): Integer; -begin - Result := SDL_SaveBMP_RW(surface, SDL_RWFromFile(filename, 'wb'), 1); -end; - -function SDL_BlitSurface(src: PSDL_Surface; srcrect: PSDL_Rect; dst: - PSDL_Surface; - dstrect: PSDL_Rect): Integer; -begin - Result := SDL_UpperBlit(src, srcrect, dst, dstrect); -end; - -function SDL_AllocSurface(flags: UInt32; width, height, depth: Integer; - RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; -begin - Result := SDL_CreateRGBSurface(flags, width, height, depth, RMask, GMask, - BMask, AMask); -end; - -function SDL_MustLock(Surface: PSDL_Surface): Boolean; -begin - Result := ( ( surface^.offset <> 0 ) or - ( ( surface^.flags and ( SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL ) ) <> 0 ) ); -end; - -function SDL_LockMutex(mutex: PSDL_mutex): Integer; -begin - Result := SDL_mutexP(mutex); -end; - -function SDL_UnlockMutex(mutex: PSDL_mutex): Integer; -begin - Result := SDL_mutexV(mutex); -end; - -{$IFDEF WINDOWS} -function _putenv( const variable : PAnsiChar ): Integer; -cdecl; external {$IFDEF __GPC__}name '_putenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF __GPC__}; -{$ENDIF} - - -function SDL_putenv(const variable: PAnsiChar): Integer; -begin - {$IFDEF WINDOWS} - Result := _putenv(variable); - {$ENDIF} - - {$IFDEF UNIX} - {$IFDEF FPC} - Result := _putenv(variable); - {$ELSE} - Result := libc.putenv(variable); - {$ENDIF} - {$ENDIF} -end; - -{$IFDEF WINDOWS} -{$IFNDEF __GPC__} -function getenv( const name : PAnsiChar ): PAnsiChar; -cdecl; external {$IFDEF __GPC__}name 'getenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF}; -{$ENDIF} -{$ENDIF} - -function SDL_getenv(const name: PAnsiChar): PAnsiChar; -begin - {$IFDEF WINDOWS} - - {$IFDEF __GPC__} - Result := getenv( string( name ) ); - {$ELSE} - Result := getenv( name ); - {$ENDIF} - - {$ELSE} - - {$IFDEF UNIX} - - {$IFDEF FPC} - Result := fpgetenv(name); - {$ELSE} - Result := libc.getenv(name); - {$ENDIF} - - {$ENDIF} - - {$ENDIF} -end; - -function SDL_BUTTON( Button : Integer ) : Integer; -begin - Result := SDL_PRESSED shl ( Button - 1 ); -end; - -function SDL_Swap32(D: Uint32): Uint32; -begin - Result := ((D shl 24) or ((D shl 8) and $00FF0000) or ((D shr 8) and $0000FF00) or (D shr 24)); -end; - -procedure FreeAndNil(var Obj); -{$IFNDEF __GPC__} -{$IFNDEF __TMT__} -var - Temp: TObject; -{$ENDIF} -{$ENDIF} -begin -{$IFNDEF __GPC__} -{$IFNDEF __TMT__} - Temp := TObject(Obj); - Pointer(Obj) := nil; - Temp.Free; -{$ENDIF} -{$ENDIF} -end; - -{ Exit procedure handling } -type - PExitProcInfo = ^TExitProcInfo; - TExitProcInfo = record - Next: PExitProcInfo; - SaveExit: Pointer; - Proc: TProcedure; - end; - -var - ExitProcList: PExitProcInfo = nil; - -procedure DoExitProc; -var - P: PExitProcInfo; - Proc: TProcedure; -begin - P := ExitProcList; - ExitProcList := P^.Next; - ExitProc := P^.SaveExit; - Proc := P^.Proc; - Dispose(P); - Proc; -end; - -procedure AddExitProc(Proc: TProcedure); -var - P: PExitProcInfo; -begin - New(P); - P^.Next := ExitProcList; - P^.SaveExit := ExitProc; - P^.Proc := Proc; - ExitProcList := P; - ExitProc := @DoExitProc; -end; - -function IsBitOn( value : integer; bit : Byte ) : boolean; -begin - result := ( ( value and ( 1 shl bit ) ) <> 0 ); -end; - -function TurnBitOn( value : integer; bit : Byte ) : integer; -begin - result := ( value or ( 1 shl bit ) ); -end; - -function TurnBitOff( value : integer; bit : Byte ) : integer; -begin - result := ( value and not ( 1 shl bit ) ); -end; - -end. - - diff --git a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.dof b/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.dof deleted file mode 100644 index 52ffcd1..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.dof +++ /dev/null @@ -1,117 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=0 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=..\..\Bin -UnitOutputDir=..\..\Bin\Dcu\Win32 -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common -Conditionals=DONT_LINK_EXTRAS -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -Launcher= -UseLauncher=0 -DebugCWD= -[HistoryLists\hlConditionals] -Count=1 -Item1=DONT_LINK_EXTRAS -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common -[HistoryLists\hlOutputDirectorry] -Count=1 -Item0=..\..\Bin diff --git a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.dpr b/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.dpr deleted file mode 100644 index d0c8f29..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.dpr +++ /dev/null @@ -1,13 +0,0 @@ -program D3DDemo; - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses - DemoUnit; -begin - RunDemo; -end. - - diff --git a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.lpi b/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.lpi deleted file mode 100644 index 55f6ceb..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/D3DDemo.lpi +++ /dev/null @@ -1,86 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasUsesSectionForAllUnits Value="False"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="D3DDemo"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="2"> - <Unit0> - <Filename Value="D3DDemo.dpr"/> - <IsPartOfProject Value="True"/> - </Unit0> - <Unit1> - <Filename Value="DemoUnit.pas"/> - <IsPartOfProject Value="True"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\D3DDemo"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;$(ProjOutDir)"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <SyntaxMode Value="Delphi"/> - </SyntaxOptions> - </Parsing> - <Linking> - <Options> - <Win32> - <GraphicApplication Value="True"/> - </Win32> - </Options> - </Linking> - <Other> - <CustomOptions Value="-dDONT_LINK_EXTRAS"/> - </Other> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> diff --git a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/DemoUnit.pas b/components/vampireimaging/Demos/ObjectPascal/D3DDemo/DemoUnit.pas deleted file mode 100644 index 0521494..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/D3DDemo/DemoUnit.pas +++ /dev/null @@ -1,423 +0,0 @@ -{ - Vampyre Imaging Library Demo - D3D9 Demo (D3D9 extension) - - Demo that shows how to create Direct3D 9 textures from files - and Imaging's images and vice versa. This sample uses SDL to create - window and process messages. Background and sprite textures are loaded from - files and rendered. Sprite is rendered in each corner of the window - using various texture stage and blending settings. - You can change sprite's texture format by pressing SPACE key - (it cycles trough all TImageFormat values). Background texture - can be saved to file by pressing S key and sprite texture - can be saved by pressing D key. - -} -unit DemoUnit; - -{$I ImagingOptions.inc} -{$R ..\Common\MainIcon.res} - -interface - -procedure RunDemo; - -implementation - -uses - Windows, - SysUtils, - ImagingTypes, - Imaging, - ImagingUtility, - sdl, - Direct3D9, - ImagingDirect3D9, - ImagingSdl, - DemoUtils; - -type - TVector2 = record - X, Y: Single; - end; - - TVector4 = record - X, Y, Z, W: Single; - end; - - TVertex = record - Position: TVector4; - TexCoord1: TVector2; - TexCoord2: TVector2; - end; - - TRect = array[0..3] of TVertex; - -const - SWindowTitle = 'Vampyre Imaging Library (%s) - Direct3D9 Demo (format: %s)'; - SWindowIconTitle = 'Direct3D9 Demo'; - SBackImageFile = 'Tigers.jpg'; - SSpriteImageFile = 'Vezyr.png'; - SOutScreenFile = 'D3DScreen.png'; - SOutSpriteFile = 'D3DSprite.dds'; - SIconFile = 'Icon.png'; - DisplayWidth = 800; - DisplayHeight = 600; - SpriteWidth = 256.0; - SpriteHeight = 192.0; - FVF_VERTEX = D3DFVF_XYZRHW or D3DFVF_TEX2; - -var - WindowHandle: THandle; - Direct3D: IDirect3D9 = nil; - Device: IDirect3DDevice9 = nil; - BackTex: IDirect3DTexture9 = nil; - SpriteTex: IDirect3DTexture9 = nil; - PresentParams: TD3DPresentParameters; - DisplaySurface: PSDL_Surface = nil; - SpriteImage: TImageData; - SpriteFormat: TImageFormat = ifA8R8G8B8; - BackRect: TRect; - Rects: array[0..3] of TRect; - Event : TSDL_Event; - Running: Boolean = True; - Frames: LongInt = 0; - FPS: LongInt = 0; - LastTime: LongInt = 0; - TextureCaps: TD3DTextureCaps; - -function Vector2(X, Y: Single): TVector2; -begin - Result.X := X; - Result.Y := Y; -end; - -function Vector4(X, Y, Z, W: Single): TVector4; -begin - Result.X := X; - Result.Y := Y; - Result.Z := Z; - Result.W := W; -end; - -procedure PlaceRect(Index: LongInt; X, Y: Single); -begin - Rects[Index, 0].Position.X := X; - Rects[Index, 0].Position.Y := Y; - Rects[Index, 1].Position.X := X + SpriteWidth; - Rects[Index, 1].Position.Y := Y; - Rects[Index, 2].Position.X := X; - Rects[Index, 2].Position.Y := Y + SpriteHeight; - Rects[Index, 3].Position.X := X + SpriteWidth; - Rects[Index, 3].Position.Y := Y + SpriteHeight; -end; - -procedure MessageOut(Window: THandle; const Msg: string; const Args: array of const); -begin - MessageBox(Window, PChar(Format(Msg, Args)), 'Message', - MB_ICONINFORMATION or MB_OK); -end; - -procedure MessageOutAndHalt(Window: THandle; const Msg: string; const Args: array of const); -begin - MessageBox(Window, PChar(Format(Msg, Args)), 'Error', - MB_ICONERROR or MB_OK); - SDL_Quit; - Halt(1); -end; - -procedure UpdateCaption; -begin - SDL_WM_SetCaption(PAnsiChar(AnsiString(Format(SWindowTitle + ' FPS: %d', - [Imaging.GetVersionStr, GetFormatName(SpriteFormat), FPS]))), - SWindowIconTitle); -end; - -procedure CreateSpriteTexture(const Device: IDirect3DDevice9; Format: TImageFormat); -var - D3DFormat: TD3DFormat; - ConvTo: TImageFormat; - ConvImage: TImageData; -begin - // Find D3D format that matches given TImageFormat - D3DFormat := ImagingDirect3D9.ImageFormatToD3DFormat(Format, ConvTo); - if D3DFormat <> D3DFMT_UNKNOWN then - begin - // Free old texture and create new one in the different format - SpriteTex := nil; - Imaging.InitImage(ConvImage); - Imaging.CloneImage(SpriteImage, ConvImage); - // Create texture from image - ImagingDirect3D9.CreateD3DTextureFromImage(ConvImage, Device, SpriteTex, - SpriteImage.Width, SpriteImage.Height, 0, 0, D3DFormat, D3DPOOL_MANAGED); - Imaging.FreeImage(ConvImage); - end; -end; - -procedure Initialize; -var - Caption, Icon: PAnsiChar; - Mode: TD3DDisplayMode; - I: LongInt; -begin - // Get SDL app window - SDL_WM_GetCaption(Caption, Icon); - WindowHandle := FindWindowA('SDL_app', Caption); - if WindowHandle = 0 then - MessageOutAndHalt(GetActiveWindow, 'Cannot get SDL window handle', []); - - // Place window to the center of the screen - SetWindowPos(WindowHandle, 0, (GetSystemMetrics(SM_CXSCREEN) - DisplayWidth) div 2, - (GetSystemMetrics(SM_CYSCREEN) - DisplayHeight - 20) div 2, 0, 0, SWP_NOSIZE or SWP_NOZORDER); - - // Create IDirect3D interface - Direct3D := Direct3DCreate9(D3D_SDK_VERSION); - if Direct3D = nil then - MessageOutAndHalt(WindowHandle, 'Cannot create Direct3D interface', []); - - // Get the current display mode and fill presentation parameters - Direct3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, Mode); - FillChar(PresentParams, SizeOf(PresentParams), 0); - PresentParams.hDeviceWindow := WindowHandle; - PresentParams.Windowed := True; - PresentParams.BackBufferCount := 1; - PresentParams.BackBufferFormat := Mode.Format; - PresentParams.SwapEffect := D3DSWAPEFFECT_DISCARD; - PresentParams.PresentationInterval := D3DPRESENT_INTERVAL_IMMEDIATE; - // Create Direct3D device - if Failed(Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, PresentParams.hDeviceWindow, - D3DCREATE_SOFTWARE_VERTEXPROCESSING, @PresentParams, Device)) then - MessageOutAndHalt(WindowHandle, 'Cannot create Direct3D device', []); - - // Get texture caps - ImagingDirect3D9.GetDeviceTextureCaps(Device, TextureCaps); - - // Load background texture from file - ImagingDirect3D9.LoadD3DTextureFromFile(GetDataDir + PathDelim + SBackImageFile, Device, BackTex); - - Imaging.InitImage(SpriteImage); - // Load sprite image from file - Imaging.LoadImageFromFile(GetDataDir + PathDelim + SSpriteImageFile, SpriteImage); - // Create sprite texture from image - CreateSpriteTexture(Device, SpriteFormat); - - // Set render states - Device.SetRenderState(D3DRS_LIGHTING, 0); - Device.SetRenderState(D3DRS_ALPHABLENDENABLE, 1); - Device.SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA); - Device.SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA); - // Set texture stage states - Device.SetTextureStageState(0, D3DTSS_COLOROP, D3DTOP_MODULATE); - Device.SetTextureStageState(0, D3DTSS_COLORARG1, D3DTA_TEXTURE); - Device.SetTextureStageState(0, D3DTSS_COLORARG2, D3DTA_DIFFUSE); - Device.SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTOP_MODULATE); - Device.SetTextureStageState(0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE); - Device.SetTextureStageState(0, D3DTSS_ALPHAARG2, D3DTA_DIFFUSE); - Device.SetTextureStageState(1, D3DTSS_COLORARG1, D3DTA_TEXTURE); - Device.SetTextureStageState(1, D3DTSS_COLORARG2, D3DTA_CURRENT); - Device.SetTextureStageState(1, D3DTSS_ALPHAARG1, D3DTA_TEXTURE); - Device.SetTextureStageState(1, D3DTSS_ALPHAARG2, D3DTA_CURRENT); - - Device.SetSamplerState(0, D3DSAMP_MINFILTER, D3DTEXF_LINEAR); - Device.SetSamplerState(0, D3DSAMP_MAGFILTER, D3DTEXF_LINEAR); - Device.SetSamplerState(0, D3DSAMP_MIPFILTER, D3DTEXF_LINEAR); - - // Set size of the background - BackRect[0].Position := Vector4(0.0, 0.0, 0.0, 1.0); - BackRect[1].Position := Vector4(DisplayWidth, 0.0, 0.0, 1.0); - BackRect[2].Position := Vector4(0.0, DisplayHeight, 0.0, 1.0); - BackRect[3].Position := Vector4(DisplayWidth, DisplayHeight, 0.0, 1.0); - // Set background's tex coords - BackRect[0].TexCoord1 := Vector2(0.0, 0.0); - BackRect[1].TexCoord1 := Vector2(1.0, 0.0); - BackRect[2].TexCoord1 := Vector2(0.0, 1.0); - BackRect[3].TexCoord1 := Vector2(1.0, 1.0); - - // Set sprites' tex coords and defalt position - for I := 0 to 3 do - begin - Rects[I, 0].Position := Vector4(0.0, 0.0, 0.0, 1.0); - Rects[I, 1].Position := Vector4(0.0, 0.0, 0.0, 1.0); - Rects[I, 2].Position := Vector4(0.0, 0.0, 0.0, 1.0); - Rects[I, 3].Position := Vector4(0.0, 0.0, 0.0, 1.0); - - Rects[I, 0].TexCoord1 := Vector2(0.0, 0.0); - Rects[I, 1].TexCoord1 := Vector2(1.0, 0.0); - Rects[I, 2].TexCoord1 := Vector2(0.0, 1.0); - Rects[I, 3].TexCoord1 := Vector2(1.0, 1.0); - - Rects[I, 0].TexCoord2 := Vector2(0.0, 1.0); - Rects[I, 1].TexCoord2 := Vector2(1.0, 1.0); - Rects[I, 2].TexCoord2 := Vector2(0.0, 0.0); - Rects[I, 3].TexCoord2 := Vector2(1.0, 0.0); - end; - // Place sprites - PlaceRect(0, 0, 0); - PlaceRect(1, DisplayWidth - SpriteWidth, 0); - PlaceRect(2, 0, DisplayHeight - SpriteHeight); - PlaceRect(3, DisplayWidth - SpriteWidth, DisplayHeight - SpriteHeight); -end; - -procedure Present; -begin - Device.Clear(0, nil, D3DCLEAR_TARGET, $FFCCFFFF, 1.0, 0); - if Succeeded(Device.BeginScene) then - begin - Device.SetFVF(FVF_VERTEX); - // First render background - Device.SetTextureStageState(0, D3DTSS_COLOROP, D3DTOP_MODULATE); - Device.SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTOP_MODULATE); - Device.SetTextureStageState(1, D3DTSS_COLOROP, D3DTOP_DISABLE); - Device.SetTexture(0, BackTex); - Device.DrawPrimitiveUP(D3DPT_TRIANGLESTRIP, 2, BackRect, SizeOf(TVertex)); - - Device.SetTexture(0, SpriteTex); - Device.SetTexture(1, SpriteTex); - // Render first sprite - Device.DrawPrimitiveUP(D3DPT_TRIANGLESTRIP, 2, Rects[0], SizeOf(TVertex)); - // Render second sprite - Device.SetTextureStageState(0, D3DTSS_COLOROP, D3DTOP_ADDSIGNED); - Device.SetTextureStageState(1, D3DTSS_COLOROP, D3DTOP_ADDSIGNED); - Device.SetTextureStageState(1, D3DTSS_ALPHAOP, D3DTOP_MODULATE); - Device.DrawPrimitiveUP(D3DPT_TRIANGLESTRIP, 2, Rects[1], SizeOf(TVertex)); - // Render third sprite - Device.SetRenderState(D3DRS_SRCBLEND, D3DBLEND_ONE); - Device.SetRenderState(D3DRS_DESTBLEND, D3DBLEND_ONE); - Device.SetTextureStageState(0, D3DTSS_COLOROP, D3DTOP_MODULATE); - Device.SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTOP_DISABLE); - Device.SetTextureStageState(1, D3DTSS_COLOROP, D3DTOP_SUBTRACT); - Device.SetTextureStageState(1, D3DTSS_ALPHAOP, D3DTOP_DISABLE); - Device.DrawPrimitiveUP(D3DPT_TRIANGLESTRIP, 2, Rects[2], SizeOf(TVertex)); - Device.SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA); - Device.SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA); - // Render last sprite - Device.SetTextureStageState(0, D3DTSS_COLOROP, D3DTOP_DOTPRODUCT3); - Device.SetTextureStageState(1, D3DTSS_COLOROP, D3DTOP_DOTPRODUCT3); - Device.DrawPrimitiveUP(D3DPT_TRIANGLESTRIP, 2, Rects[3], SizeOf(TVertex)); - - Device.SetTexture(0, nil); - Device.SetTexture(1, nil); - - Device.EndScene; - end; - // Copy backbuffer to window - Device.Present(nil, nil, 0, nil); -end; - -procedure Finalize; -begin - BackTex := nil; - SpriteTex := nil; - Device := nil; - Direct3D := nil; - Imaging.FreeImage(SpriteImage); -end; - -procedure TakeScreenShot; -var - RenderTarget, OldRenderTarget: IDirect3DSurface9; - ScreenImg: TImageData; -begin - // Create new render target and activate it - Device.CreateRenderTarget(DisplayWidth, DisplayHeight, D3DFMT_A8R8G8B8, - D3DMULTISAMPLE_NONE, 0, True, RenderTarget, nil); - Device.GetRenderTarget(0, OldRenderTarget); - Device.SetRenderTarget(0, RenderTarget); - // Render to new target - Present; - // Activate old target - Device.SetRenderTarget(0, OldRenderTarget); - // Convert reder target surface to Imaging image and save it to file - ImagingDirect3D9.CreateImageFromD3DSurface(RenderTarget, ScreenImg); - Imaging.SaveImageToFile(SOutScreenFile, ScreenImg); - // Free all - Imaging.FreeImage(ScreenImg); - RenderTarget := nil; - OldRenderTarget := nil; -end; - -procedure RunDemo; -begin - // Initialize SDL - if (SDL_Init(SDL_INIT_VIDEO) < 0) then - MessageOutAndHalt(GetActiveWindow, 'SDL initialization failed: %s', [SDL_GetError]); - - SDL_WM_SetCaption(PAnsiChar(AnsiString(Format(SWindowTitle, [Imaging.GetVersionStr, - GetFormatName(SpriteFormat)]))), SWindowIconTitle); - SDL_WM_SetIcon(LoadSDLSurfaceFromFile(GetDataDir + PathDelim + SIconFile), 0); - - // Initialize video mode - DisplaySurface := SDL_SetVideoMode(DisplayWidth, DisplayHeight, 32, 0); - if DisplaySurface = nil then - MessageOutAndHalt(GetActiveWindow, 'SDL SetVideoMode failed: %s', [SDL_GetError]); - - // Initialize surfaces and enter main loop - Initialize; - LastTime := SDL_GetTicks; - while Running do - begin - while SDL_PollEvent(@Event) = 1 do - begin - case Event.type_ of - SDL_QUITEV: - begin - Running := False; - end; - SDL_KEYDOWN: - begin - with Event.key.keysym do - if ((sym = SDLK_F4) and ((modifier and KMOD_ALT) <> 0)) or - (Event.key.keysym.sym = SDLK_ESCAPE) then - Running := False; - - // Using S and D keys you can take screen shots and texture - // shots easily - // SPACE key can be used to cycle sprite image formats - case Event.key.keysym.sym of - SDLK_S: TakeScreenShot; - SDLK_D: ImagingDirect3D9.SaveD3DTextureToFile(SOutSpriteFile, SpriteTex); - SDLK_SPACE: - begin - SpriteFormat := NextFormat(SpriteFormat); - CreateSpriteTexture(Device, SpriteFormat); - UpdateCaption; - end; - end; - end; - end; - end; - - // Calculate FPS - if LongInt(SDL_GetTicks) - LastTime > 1000 then - begin - FPS := Frames; - UpdateCaption; - Frames := 0; - LastTime := SDL_GetTicks; - end; - Inc(Frames); - - // Renders background and sprites to the window - Present; - end; - // Frees all textures, images, and D3D objects - Finalize; - SDL_Quit; -end; - -{ - File Notes: - - -- 0.77.1 --------------------------------------------------- - - Refactored the demo (moved stuff to unit from dpr) and - added Lazarus project files. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Delphi 2009 compatibility pchar/string changes. - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - S key now saves screenshot to file -} - - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/AboutForm.fmx b/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/AboutForm.fmx deleted file mode 100644 index c583bcf..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/AboutForm.fmx +++ /dev/null @@ -1,91 +0,0 @@ -object FormAbout: TFormAbout - Left = 0 - Top = 0 - BorderIcons = [biSystemMenu] - BorderStyle = Single - Caption = 'About - FireMonkey Demo' - ClientHeight = 290 - ClientWidth = 318 - Position = Designed - FormFactor.Width = 320 - FormFactor.Height = 480 - FormFactor.Devices = [Desktop, iPhone, iPad] - OnCreate = FormCreate - DesignerMasterStyle = 0 - object PanelBack: TPanel - Align = Contents - Size.Width = 318.000000000000000000 - Size.Height = 290.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - object ImgLogo: TImage - MultiResBitmap = < - item - end> - Align = MostTop - Size.Width = 318.000000000000000000 - Size.Height = 111.000000000000000000 - Size.PlatformDefault = False - end - object BtnOk: TButton - Position.X = 60.000000000000000000 - Position.Y = 240.000000000000000000 - Size.Width = 202.000000000000000000 - Size.Height = 40.000000000000000000 - Size.PlatformDefault = False - TabOrder = 2 - Text = 'OK' - TextSettings.Font.Size = 14.000000000000000000 - OnClick = BtnOkClick - end - object Label1: TLabel - Position.X = 10.000000000000000000 - Position.Y = 120.000000000000000000 - Size.Width = 241.000000000000000000 - Size.Height = 15.000000000000000000 - Size.PlatformDefault = False - TextSettings.Font.Size = 14.000000000000000000 - Text = 'Vampyre Imaging Library' - end - object LabVersion: TLabel - Position.X = 10.000000000000000000 - Position.Y = 140.000000000000000000 - Size.Width = 241.000000000000000000 - Size.Height = 15.000000000000000000 - Size.PlatformDefault = False - TextSettings.Font.Size = 14.000000000000000000 - Text = 'version: ' - end - object LabWebsite: TLabel - Cursor = crHandPoint - Position.X = 10.000000000000000000 - Position.Y = 160.000000000000000000 - Size.Width = 241.000000000000000000 - Size.Height = 15.000000000000000000 - Size.PlatformDefault = False - TextSettings.Font.Size = 14.000000000000000000 - Text = 'http://imaginglib.sourceforge.net/' - end - object Effect: TWaveEffect - Enabled = False - Time = 0.000000000000000000 - WaveSize = 256.000000000000000000 - object WaveAnim: TFloatAnimation - AnimationType = Out - Enabled = True - Duration = 0.600000023841857900 - Interpolation = Exponential - OnFinish = WaveAnimFinish - PropertyName = 'WaveSize' - StartValue = 256.000000000000000000 - StopValue = 32.000000000000000000 - end - end - end - object Timer: TTimer - Enabled = False - Interval = 15 - Left = 270 - Top = 120 - end -end diff --git a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/AboutForm.pas b/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/AboutForm.pas deleted file mode 100644 index 5a18368..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/AboutForm.pas +++ /dev/null @@ -1,60 +0,0 @@ -unit AboutForm; - -interface - -uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, - FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Ani, - FMX.Filter.Effects, FMX.Effects, FMX.StdCtrls, FMX.Controls.Presentation, - - Imaging, - DemoUtils; - -type - TFormAbout = class(TForm) - ImgLogo: TImage; - PanelBack: TPanel; - Timer: TTimer; - BtnOk: TButton; - Label1: TLabel; - LabVersion: TLabel; - LabWebsite: TLabel; - Effect: TWaveEffect; - WaveAnim: TFloatAnimation; - procedure FormCreate(Sender: TObject); - procedure BtnOkClick(Sender: TObject); - procedure WaveAnimFinish(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - FormAbout: TFormAbout; - -implementation - -{$R *.fmx} - -procedure TFormAbout.WaveAnimFinish(Sender: TObject); -begin - Effect.Enabled := False; - Close; -end; - -procedure TFormAbout.FormCreate(Sender: TObject); -begin - ImgLogo.Bitmap.LoadFromFile(GetDataDir + PathDelim + 'LogoAlpha.png'); - LabVersion.Text := LabVersion.Text + GetVersionStr; -end; - -procedure TFormAbout.BtnOkClick(Sender: TObject); -begin - if Effect.Enabled then - Exit; - Effect.Enabled := True; - WaveAnim.Start; -end; - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.dpr b/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.dpr deleted file mode 100644 index ffa8f34..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.dpr +++ /dev/null @@ -1,19 +0,0 @@ -program FireMonkeyDemo; - -uses - //FastMM4, - FMX.Forms, - FMX.Types, - DemoUtils in '../Common/DemoUtils.pas', - MainForm in 'MainForm.pas' {FormMain}, - AboutForm in 'AboutForm.pas' {FormAbout}; - -{$R *.res} - -begin - //FMX.Types.GlobalUseDirect2DSoftware := True; - Application.Initialize; - Application.CreateForm(TFormMain, FormMain); - Application.CreateForm(TFormAbout, FormAbout); - Application.Run; -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.dproj b/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.dproj deleted file mode 100644 index 50b093a..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.dproj +++ /dev/null @@ -1,626 +0,0 @@ -<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> - <PropertyGroup> - <ProjectGuid>{D9FDA707-8AE6-48DB-B22E-7D4E4CA7055B}</ProjectGuid> - <ProjectVersion>18.0</ProjectVersion> - <FrameworkType>FMX</FrameworkType> - <MainSource>FireMonkeyDemo.dpr</MainSource> - <Base>True</Base> - <Config Condition="'$(Config)'==''">Debug</Config> - <Platform Condition="'$(Platform)'==''">Win32</Platform> - <TargetedPlatforms>7</TargetedPlatforms> - <AppType>Application</AppType> - </PropertyGroup> - <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Base)'=='true') or '$(Base_OSX32)'!=''"> - <Base_OSX32>true</Base_OSX32> - <CfgParent>Base</CfgParent> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''"> - <Base_Win32>true</Base_Win32> - <CfgParent>Base</CfgParent> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''"> - <Base_Win64>true</Base_Win64> - <CfgParent>Base</CfgParent> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''"> - <Cfg_1>true</Cfg_1> - <CfgParent>Base</CfgParent> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Cfg_1)'=='true') or '$(Cfg_1_OSX32)'!=''"> - <Cfg_1_OSX32>true</Cfg_1_OSX32> - <CfgParent>Cfg_1</CfgParent> - <Cfg_1>true</Cfg_1> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''"> - <Cfg_1_Win32>true</Cfg_1_Win32> - <CfgParent>Cfg_1</CfgParent> - <Cfg_1>true</Cfg_1> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''"> - <Cfg_2>true</Cfg_2> - <CfgParent>Base</CfgParent> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX32)'!=''"> - <Cfg_2_OSX32>true</Cfg_2_OSX32> - <CfgParent>Cfg_2</CfgParent> - <Cfg_2>true</Cfg_2> - <Base>true</Base> - </PropertyGroup> - <PropertyGroup Condition="'$(Base)'!=''"> - <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> - <SanitizedProjectName>FireMonkeyDemo</SanitizedProjectName> - <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0</VerInfo_Keys> - <VerInfo_Locale>1033</VerInfo_Locale> - <Manifest_File>None</Manifest_File> - <DCC_Define>FULL_FEATURE_SET;$(DCC_Define)</DCC_Define> - <DCC_UnitSearchPath>..\..\..\Extras\Extensions\LibTiff;..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> - <Icon_MainIcon>..\..\Data\Imaging.ico</Icon_MainIcon> - <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace> - <DCC_DcuOutput>..\..\Bin\Dcu\$(Platform)\$(Config)</DCC_DcuOutput> - <DCC_ExeOutput>..\..\Bin</DCC_ExeOutput> - </PropertyGroup> - <PropertyGroup Condition="'$(Base_OSX32)'!=''"> - <BT_BuildType>Debug</BT_BuildType> - <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> - <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> - <VerInfo_Keys>CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user</VerInfo_Keys> - </PropertyGroup> - <PropertyGroup Condition="'$(Base_Win32)'!=''"> - <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes> - <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> - <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File> - </PropertyGroup> - <PropertyGroup Condition="'$(Base_Win64)'!=''"> - <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes> - <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace> - <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File> - </PropertyGroup> - <PropertyGroup Condition="'$(Cfg_1)'!=''"> - <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> - <DCC_Optimize>false</DCC_Optimize> - <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames> - </PropertyGroup> - <PropertyGroup Condition="'$(Cfg_1_OSX32)'!=''"> - <BT_BuildType>Debug</BT_BuildType> - <VerInfo_Keys>CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);Last Compile=2012-05-26 02:52;NSHighResolutionCapable=true;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user</VerInfo_Keys> - <Debugger_Launcher>/usr/X11/bin/xterm -e "%debuggee%"</Debugger_Launcher> - <DCC_RemoteDebug>true</DCC_RemoteDebug> - </PropertyGroup> - <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> - <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes> - <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Last Compile=2013-10-23 22:56</VerInfo_Keys> - <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File> - <DCC_DebugDCUs>true</DCC_DebugDCUs> - <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> - </PropertyGroup> - <PropertyGroup Condition="'$(Cfg_2)'!=''"> - <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define> - </PropertyGroup> - <PropertyGroup Condition="'$(Cfg_2_OSX32)'!=''"> - <DCC_RemoteDebug>true</DCC_RemoteDebug> - <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> - </PropertyGroup> - <ItemGroup> - <DelphiCompile Include="$(MainSource)"> - <MainSource>MainSource</MainSource> - </DelphiCompile> - <DCCReference Include="..\Common\DemoUtils.pas"/> - <DCCReference Include="MainForm.pas"> - <Form>FormMain</Form> - </DCCReference> - <DCCReference Include="AboutForm.pas"> - <Form>FormAbout</Form> - </DCCReference> - <BuildConfiguration Include="Release"> - <Key>Cfg_2</Key> - <CfgParent>Base</CfgParent> - </BuildConfiguration> - <BuildConfiguration Include="Base"> - <Key>Base</Key> - </BuildConfiguration> - <BuildConfiguration Include="Debug"> - <Key>Cfg_1</Key> - <CfgParent>Base</CfgParent> - </BuildConfiguration> - </ItemGroup> - <ProjectExtensions> - <Borland.Personality>Delphi.Personality.12</Borland.Personality> - <Borland.ProjectType/> - <BorlandProject> - <Delphi.Personality> - <VersionInfo> - <VersionInfo Name="IncludeVerInfo">False</VersionInfo> - <VersionInfo Name="AutoIncBuild">False</VersionInfo> - <VersionInfo Name="MajorVer">1</VersionInfo> - <VersionInfo Name="MinorVer">0</VersionInfo> - <VersionInfo Name="Release">0</VersionInfo> - <VersionInfo Name="Build">0</VersionInfo> - <VersionInfo Name="Debug">False</VersionInfo> - <VersionInfo Name="PreRelease">False</VersionInfo> - <VersionInfo Name="Special">False</VersionInfo> - <VersionInfo Name="Private">False</VersionInfo> - <VersionInfo Name="DLL">False</VersionInfo> - <VersionInfo Name="Locale">1029</VersionInfo> - <VersionInfo Name="CodePage">1250</VersionInfo> - </VersionInfo> - <VersionInfoKeys> - <VersionInfoKeys Name="CompanyName"/> - <VersionInfoKeys Name="FileDescription"/> - <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> - <VersionInfoKeys Name="InternalName"/> - <VersionInfoKeys Name="LegalCopyright"/> - <VersionInfoKeys Name="LegalTrademarks"/> - <VersionInfoKeys Name="OriginalFilename"/> - <VersionInfoKeys Name="ProductName"/> - <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> - <VersionInfoKeys Name="Comments"/> - </VersionInfoKeys> - <Source> - <Source Name="MainSource">FireMonkeyDemo.dpr</Source> - </Source> - <Excluded_Packages> - <Excluded_Packages Name="$(BDSBIN)\dcloffice2k230.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> - <Excluded_Packages Name="$(BDSBIN)\dclofficexp230.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> - </Excluded_Packages> - </Delphi.Personality> - <Deployment Version="2"> - <DeployFile LocalName="..\..\Bin\FireMonkeyDemo.rsm" Configuration="Debug" Class="DebugSymbols"> - <Platform Name="OSX32"> - <RemoteDir>Contents\MacOS\</RemoteDir> - <RemoteName>FireMonkeyDemo.rsm</RemoteName> - <Overwrite>true</Overwrite> - </Platform> - </DeployFile> - <DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule"> - <Platform Name="OSX32"> - <Overwrite>true</Overwrite> - </Platform> - </DeployFile> - <DeployFile LocalName="..\..\Bin\FireMonkeyDemo.info.plist" Configuration="Debug" Class="ProjectOSXInfoPList"> - <Platform Name="OSX32"> - <RemoteName>Info.plist</RemoteName> - <Overwrite>true</Overwrite> - </Platform> - </DeployFile> - <DeployFile LocalName="..\..\Bin\FireMonkeyDemo" Configuration="Debug" Class="ProjectOutput"> - <Platform Name="OSX32"> - <Overwrite>true</Overwrite> - </Platform> - </DeployFile> - <DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule"> - <Platform Name="iOSSimulator"> - <Overwrite>true</Overwrite> - </Platform> - </DeployFile> - <DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule"> - <Platform Name="iOSSimulator"> - <Overwrite>true</Overwrite> - </Platform> - </DeployFile> - <DeployFile LocalName="..\..\Bin\FireMonkeyDemo.icns" Configuration="Debug" Class="ProjectOSXResource"> - <Platform Name="OSX32"> - <Overwrite>true</Overwrite> - </Platform> - </DeployFile> - <DeployClass Name="ProjectiOSDeviceResourceRules"> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectOSXResource"> - <Platform Name="OSX32"> - <RemoteDir>Contents\Resources</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidClassesDexFile"> - <Platform Name="Android"> - <RemoteDir>classes</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_LauncherIcon144"> - <Platform Name="Android"> - <RemoteDir>res\drawable-xxhdpi</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AdditionalDebugSymbols"> - <Platform Name="Win32"> - <RemoteDir>Contents\MacOS</RemoteDir> - <Operation>0</Operation> - </Platform> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="OSX32"> - <RemoteDir>Contents\MacOS</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidLibnativeMipsFile"> - <Platform Name="Android"> - <RemoteDir>library\lib\mips</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="iPad_Launch768"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Required="true" Name="ProjectOutput"> - <Platform Name="Win32"> - <Operation>0</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="OSX32"> - <RemoteDir>Contents\MacOS</RemoteDir> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - <Platform Name="Android"> - <RemoteDir>library\lib\armeabi-v7a</RemoteDir> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="DependencyFramework"> - <Platform Name="Win32"> - <Operation>0</Operation> - </Platform> - <Platform Name="OSX32"> - <RemoteDir>Contents\MacOS</RemoteDir> - <Operation>1</Operation> - <Extensions>.framework</Extensions> - </Platform> - </DeployClass> - <DeployClass Name="iPhone_Launch640"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidLibnativeX86File"> - <Platform Name="Android"> - <RemoteDir>library\lib\x86</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectiOSDeviceDebug"> - <Platform Name="iOSDevice64"> - <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="iPad_Launch1024"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectiOSSimulatorInfoPList"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="iPhone_Launch320"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidLibnativeArmeabiFile"> - <Platform Name="Android"> - <RemoteDir>library\lib\armeabi</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectiOSInfoPList"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="DebugSymbols"> - <Platform Name="Win32"> - <Operation>0</Operation> - </Platform> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="OSX32"> - <RemoteDir>Contents\MacOS</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="iPad_Launch1536"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_SplashImage470"> - <Platform Name="Android"> - <RemoteDir>res\drawable-normal</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_LauncherIcon96"> - <Platform Name="Android"> - <RemoteDir>res\drawable-xhdpi</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_SplashImage640"> - <Platform Name="Android"> - <RemoteDir>res\drawable-large</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="iPhone_Launch640x1136"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectiOSEntitlements"> - <Platform Name="iOSDevice64"> - <RemoteDir>../</RemoteDir> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <RemoteDir>../</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidGDBServer"> - <Platform Name="Android"> - <RemoteDir>library\lib\armeabi-v7a</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_LauncherIcon72"> - <Platform Name="Android"> - <RemoteDir>res\drawable-hdpi</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectOSXInfoPList"> - <Platform Name="OSX32"> - <RemoteDir>Contents</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectOSXEntitlements"> - <Platform Name="OSX32"> - <RemoteDir>../</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="iPad_Launch2048"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectiOSDeviceInfoPList"> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_SplashImage426"> - <Platform Name="Android"> - <RemoteDir>res\drawable-small</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidSplashImageDef"> - <Platform Name="Android"> - <RemoteDir>res\drawable</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectiOSResource"> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidSplashStyles"> - <Platform Name="Android"> - <RemoteDir>res\values</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="ProjectAndroidManifest"> - <Platform Name="Android"> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_DefaultAppIcon"> - <Platform Name="Android"> - <RemoteDir>res\drawable</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="File"> - <Platform Name="Win32"> - <Operation>0</Operation> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>0</Operation> - </Platform> - <Platform Name="OSX32"> - <RemoteDir>Contents\Resources\StartUp\</RemoteDir> - <Operation>0</Operation> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>0</Operation> - </Platform> - <Platform Name="Android"> - <Operation>0</Operation> - </Platform> - <Platform Name="iOSSimulator"> - <Operation>0</Operation> - </Platform> - </DeployClass> - <DeployClass Name="AndroidServiceOutput"> - <Platform Name="Android"> - <RemoteDir>library\lib\armeabi-v7a</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Required="true" Name="DependencyPackage"> - <Platform Name="Win32"> - <Operation>0</Operation> - <Extensions>.bpl</Extensions> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - <Platform Name="OSX32"> - <RemoteDir>Contents\MacOS</RemoteDir> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - </DeployClass> - <DeployClass Name="Android_LauncherIcon48"> - <Platform Name="Android"> - <RemoteDir>res\drawable-mdpi</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_SplashImage960"> - <Platform Name="Android"> - <RemoteDir>res\drawable-xlarge</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="Android_LauncherIcon36"> - <Platform Name="Android"> - <RemoteDir>res\drawable-ldpi</RemoteDir> - <Operation>1</Operation> - </Platform> - </DeployClass> - <DeployClass Name="DependencyModule"> - <Platform Name="Win32"> - <Operation>0</Operation> - <Extensions>.dll;.bpl</Extensions> - </Platform> - <Platform Name="iOSDevice64"> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - <Platform Name="OSX32"> - <RemoteDir>Contents\MacOS</RemoteDir> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - <Platform Name="iOSDevice32"> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - <Platform Name="iOSSimulator"> - <Operation>1</Operation> - <Extensions>.dylib</Extensions> - </Platform> - </DeployClass> - <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/> - <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/> - <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/> - <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/> - <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/> - <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/> - <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/> - </Deployment> - <Platforms> - <Platform value="OSX32">True</Platform> - <Platform value="Win32">True</Platform> - <Platform value="Win64">True</Platform> - </Platforms> - </BorlandProject> - <ProjectFileVersion>12</ProjectFileVersion> - </ProjectExtensions> - <Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/> - <Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/> - <Import Condition="Exists('$(MSBuildProjectName).deployproj')" Project="$(MSBuildProjectName).deployproj"/> -</Project> diff --git a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.res b/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.res deleted file mode 100644 index 6ca8f7b..0000000 Binary files a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/FireMonkeyDemo.res and /dev/null differ diff --git a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/MainForm.fmx b/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/MainForm.fmx deleted file mode 100644 index 728a250..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/MainForm.fmx +++ /dev/null @@ -1,325 +0,0 @@ -object FormMain: TFormMain - Left = 510 - Top = 270 - Caption = 'FireMonkeyDemo' - ClientHeight = 756 - ClientWidth = 975 - Position = ScreenCenter - StyleBook = StyleBook - Visible = True - FormFactor.Width = 320 - FormFactor.Height = 480 - FormFactor.Devices = [Desktop, iPhone, iPad] - OnCreate = FormCreate - OnDestroy = FormDestroy - Left = 510 - Top = 270 - DesignerMasterStyle = 0 - object StyleBook: TStyleBook - Styles = < - item - ResourcesBin = { - 464D585F5354594C4520322E3501060D546F6F6C626172427574746F6E03CD08 - 0607496D674F70656E03A5030607496D67536176650313020608496D6741626F - 757403DC03060B4C697374426F784974656D03F703005450463007544C61796F - 757400095374796C654E616D65060D546F6F6C626172427574746F6E0A506F73 - 6974696F6E2E580500000000000000EB07400A506F736974696F6E2E59050000 - 0000000080F007400A53697A652E576964746805000000000000009206400B53 - 697A652E4865696768740500000000000000B804401453697A652E506C617466 - 6F726D44656661756C74080756697369626C6508085461624F72646572020000 - 0A5452656374616E676C6500095374796C654E616D65060A6261636B67726F75 - 6E6405416C69676E0708436F6E74656E7473074869745465737408074F706163 - 69747905000000000017B7D1F13F0A53697A652E576964746805000000000000 - 009206400B53697A652E4865696768740500000000000000B804401453697A65 - 2E506C6174666F726D44656661756C74080B5374726F6B652E4B696E6407044E - 6F6E650758526164697573050000000000000080004007595261646975730500 - 000000000000800040000A5452656374616E676C650005416C69676E0708436F - 6E74656E74730946696C6C2E4B696E6407084772616469656E741446696C6C2E - 4772616469656E742E506F696E74730E0105436F6C6F72070978323446344634 - 4634064F66667365740500000000000000000000000105436F6C6F7207097832 - 34454145414541064F6666736574050000000000EE7CFFFD3F000105436F6C6F - 720709783445383638363836064F6666736574050000000000000080FE3F0000 - 0748697454657374080A53697A652E576964746805000000000000009206400B - 53697A652E4865696768740500000000000000B804401453697A652E506C6174 - 666F726D44656661756C74080C5374726F6B652E436F6C6F7207097834383446 - 3446344607585261646975730500000000000000800040075952616469757305 - 0000000000000080004000000F54466C6F6174416E696D6174696F6E00084475 - 726174696F6E050000000000CDCCCCFC3F0C50726F70657274794E616D650607 - 4F7061636974790A537461727456616C75650500000000000000000000095374 - 6F7056616C7565050000000000000080FF3F0754726967676572061049734D6F - 7573654F7665723D747275650E54726967676572496E7665727365061149734D - 6F7573654F7665723D66616C736500000F54436F6C6F72416E696D6174696F6E - 00084475726174696F6E050000000000CDCCCCFC3F0C50726F70657274794E61 - 6D65060A46696C6C2E436F6C6F720A537461727456616C756507097846464546 - 454645460953746F7056616C7565070978464646464435343107547269676765 - 72062049734D6F7573654F7665723D747275653B4973507265737365643D6661 - 6C736500000F54436F6C6F72416E696D6174696F6E00084475726174696F6E05 - 0000000000CDCCCCFC3F0C50726F70657274794E616D65060A46696C6C2E436F - 6C6F720A537461727456616C756507097846464646443534310953746F705661 - 6C756507097846464546454645460754726967676572062149734D6F7573654F - 7665723D66616C73653B4973507265737365643D66616C736500000F54436F6C - 6F72416E696D6174696F6E00084475726174696F6E050000000000CDCCCCFC3F - 07496E7665727365090C50726F70657274794E616D65060A46696C6C2E436F6C - 6F720A537461727456616C756507097846464443414530440953746F7056616C - 756507097846464646443534310754726967676572062049734D6F7573654F76 - 65723D66616C73653B4973507265737365643D7472756500000F54436F6C6F72 - 416E696D6174696F6E00084475726174696F6E050000000000CDCCCCFC3F0C50 - 726F70657274794E616D65060A46696C6C2E436F6C6F720A537461727456616C - 756507097846464443414530440953746F7056616C7565070978464646464435 - 34310754726967676572061F49734D6F7573654F7665723D747275653B497350 - 7265737365643D7472756500000A5452656374616E676C650005416C69676E07 - 06436C69656E740946696C6C2E4B696E6407044E6F6E65064C6F636B65640907 - 48697454657374080C50616464696E672E4C656674050000000000000080FF3F - 0B50616464696E672E546F70050000000000000080FF3F0D50616464696E672E - 5269676874050000000000000080FF3F0E50616464696E672E426F74746F6D05 - 0000000000000080FF3F0A53697A652E57696474680500000000000000920640 - 0B53697A652E4865696768740500000000000000B804401453697A652E506C61 - 74666F726D44656661756C74080C5374726F6B652E436F6C6F72070978393646 - 4346434643075852616469757305000000000000008000400759526164697573 - 050000000000000080004000000005545465787400095374796C654E616D6506 - 047465787405416C69676E0706436C69656E74064C6F636B6564090748697454 - 657374080C50616464696E672E4C6566740500000000000000C001400B506164 - 64696E672E546F7005000000000000008000400D50616464696E672E52696768 - 740500000000000000C001400E50616464696E672E426F74746F6D0500000000 - 0000008000400A53697A652E57696474680500000000001886D905400B53697A - 652E4865696768740500000000000000B804401453697A652E506C6174666F72 - 6D44656661756C740804546578740606627574746F6E16546578745365747469 - 6E67732E486F727A416C69676E07074C656164696E6700000654496D61676500 - 095374796C654E616D65060469636F6E0E4D756C74695265734269746D61700E - 01000005416C69676E07074669744C6566740748697454657374080C50616464 - 696E672E4C65667405000000000000008000400B50616464696E672E546F7005 - 000000000000008000400D50616464696E672E52696768740500000000000000 - 8000400E50616464696E672E426F74746F6D05000000000000008000400A5369 - 7A652E5769647468050000000000D0F39404400B53697A652E48656967687405 - 00000000000000B804401453697A652E506C6174666F726D44656661756C7408 - 000000545046300654496D61676500095374796C654E616D650607496D674F70 - 656E0E4D756C74695265734269746D61700E0105576964746802100648656967 - 6874021003504E470ADF02000089504E470D0A1A0A0000000D49484452000000 - 100000001008060000001FF3FF61000000017352474200AECE1CE90000000467 - 414D410000B18F0BFC61050000028949444154384F95525D489351187EF6EDC7 - E95C263A271536909AA9D082A28B0897ABAB54A29BFE20CAAE822056E46D8997 - FDC8EE2228A88B84E8220BBC0A9B7533C56A114935302CB52D1DE2CC7D3FE7DB - 399D73BECF4960173DF07ECF7BBEF3BE0FEFCF71600354C59DDF0025E4AD7023 - 18D88CE9D96C5AA1AE7E35613CB343CA70DAFC17488A25DCFB9DC384D29CB7C2 - 13BD7022D6A813E364BE793964A6D8B01D26B1A1800019A759334593A45D1FD3 - 8879AEE7C85EE4160B91E51DEA0773BCF4D90E8362F33FB19A2825D35333494D - 27381ADB83CA4AD7A07D25E1129F97773CDD0A733C977F6C5007EB397CC57861 - 1FC7E672F96843B006DB9B0221EDF27CA498206971E1584B8EC655383024A305 - 5E0DF6DA1EF0B8C0A075EC437DC08FCCF44F8C26A7FAD5417243DC29E5E4D223 - B012B1CC34B112BB88AE598AF35A35C67CB560BCD9A2A1C35BED415DBDEFFAA6 - 3E2FAB882BEFAD19A8F7C188C12767801904300D74EF6CC5DDE3670106C43ADB - 51E5F7A028623C0CCD6D41F0ADA4BD941E923300D1441C524303D08BCBF297C0 - 366E6728C3C391B738100DC344098BF915142667F0748B3BE253B02405A8A142 - 2DE441194547EF2D3E192167BDB128B796F404AE8D0E23BCBB11D97759BC8E3F - 81DFE9C6F88363F61A750DB9CC24024DADBC7FDE06E173586B89DBE9B6086E1E - EC4266228BDB913DA8F5B9B0901991A95280F10A16BE7F42C3D61630BDC84DE5 - A282D7FD53E15DF871A90FE1EA4AA054C2F49B7B72D59680AE43FDBD04BFBF0E - D08ADC56C1385B267C55FA54E53EDF10F8A604C43B9102F9F9AFF0D704CB49D4 - 4EB4D8F285B064DE62617E4A0A0848815F735F50DF1092E5AE976F31B55B110C - 836FCB24F8383220CB17B9E597280EFF83CEAB3A5F13F007A344696B90C45650 - 0000000049454E44AE42608200000A506F736974696F6E2E5805000000000000 - 808108400A506F736974696F6E2E590500000000000080EF07400A53697A652E - 57696474680500000000000000C804400B53697A652E48656967687405000000 - 00000000C804401453697A652E506C6174666F726D44656661756C7408075669 - 7369626C65080000545046300654496D61676500095374796C654E616D650607 - 496D67536176650E4D756C74695265734269746D61700E010557696474680210 - 06486569676874021003504E470A4D01000089504E470D0A1A0A0000000D4948 - 4452000000100000001008060000001FF3FF61000000017352474200AECE1CE9 - 0000000467414D410000B18F0BFC6105000000F749444154384F63A00E4803C3 - FF3F7FFE248841EAC0AAA180094ACF643086B2080188BA9960120818C124C854 - A0C4CF849F0C57AE5C010B61033A3A3A0CEC0BD81918CE0239B3207A310C2004 - 081A407717C002916C80E2828DE61BC15C7CC0FFA43F6E2F100DF019F0CCF73D - C3FFFFFF187EFDFCC1C0F0FF370333F37F0646464686F7EFBF31E84DD3626016 - 6766F8FBF22FEE30F8F7EF2F8374A3308362873490F79F818D8D898185052403 - D4840560350006585898812423C3DFBF7F19FEFEF9031144031806202B6401DA - FEEFEF3F863F7FFF800DC106606100CA1CE0F43DDB642B88C20A52CF7843590C - E9C0309805655302181800E741859CFB8BF8550000000049454E44AE42608200 - 000A506F736974696F6E2E5805000000000000808108400A506F736974696F6E - 2E590500000000000080EF07400A53697A652E57696474680500000000000000 - C804400B53697A652E4865696768740500000000000000C804401453697A652E - 506C6174666F726D44656661756C74080756697369626C650800005450463006 - 54496D61676500095374796C654E616D650608496D6741626F75740E4D756C74 - 695265734269746D61700E01055769647468021006486569676874021003504E - 470A1503000089504E470D0A1A0A0000000D4948445200000010000000100806 - 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F - 0BFC6105000002BF49444154384FAD535D481451183DB333BBEEB83FAEEB2E66 - 6C999622626860528F49562022BE063DFB120465454449F4FFA3524FBEF7D243 - D48BF8509109FA1011055264B9C1BAEEAEFBE3CCFECCCEEECCDC99E9CE245BD1 - 631DB85CEEF09DF3DD7BBE33F85730DBFB2FB43EE8623CCE33A1E6D028E7F185 - AC4F952D41282472F366559E41E6EA8A5DB78D3F05DAA7C6DB7A764C8F8C1CAE - EFD81741515221C90614E2C4EAD74DBC7BFA866436372E638B4C03D78845616D - A2858E99F18347FA662F4E9C7076B587208932FA9A65447C2AA2C92A3C810684 - 7BF63BA48A3154C8C6CB5016972DDA4F81EE87DD7BBB5A9F5F387794F3B85C88 - 2534904A01A38702D81DE6F1FAA38858AA0AA2C8E07776A2B0111DAC96FBE7A0 - 2DA61C169F3198D3C3C307DC4D7E27D2594AD67444332CA69E6570E3490ADF92 - 80414CE4E9ADA4C2161A7A075986755EB2B8B6803F181C4B332D588BEB50551D - A9AC84484087613A60529B5C9C01A1A8A2543121E44468AC823AAF77A826501F - F4377D5837F1682E8F4D4141A54A408886B3638DB872328C061EC88854A0AC22 - 99CDD23D0FD647BC350198063886201A9731FB42C0CABA8A572B0AE269059C43 - A79D0932B9223DA7A1564B80AE03C4B0A9B640359F13EB0C050CBD6A9E8E6EE9 - BD884F6B1235C784699A10C5324A991C344DB19B99BA014D72C93581F266719E - 29A6E1E7692C7495122D233518062DB6964E476ED24554B02C038636D1C4FC62 - 4D40AD9299E4C25BB22BCCD94F8156819B31C0BB400D04BC4EBB888E4281DB13 - 80125D374C4DBE6D717FE6A0F4322DE903B29B358E35B646A0282A4E0DB7A0B7 - CD0D5122F08682585E2D4277D4838965A07CFF7213B8F7D8A2FE16E5490E8D8E - 89E09EC02D5FE700E30BFBEC285B4FE19D2CC48400E973146A227607A8BB4EA3 - 6C7BF0F7CFC44FF6732EEEBCC9FB8EC3A5780D6A982950C3B4FC02F5E03E7077 - 69BBF27F00F8013A2C5A1BBC68CF690000000049454E44AE42608200000A506F - 736974696F6E2E580500000000000000EA07400A506F736974696F6E2E590500 - 000000000080F207400A53697A652E57696474680500000000000000C804400B - 53697A652E4865696768740500000000000000C804401453697A652E506C6174 - 666F726D44656661756C74080756697369626C650800005450463007544C6179 - 6F757400095374796C654E616D65060B4C697374426F784974656D0C50616464 - 696E672E4C65667405000000000000008000400B50616464696E672E546F7005 - 000000000000008000400D50616464696E672E52696768740500000000000000 - 8000400E50616464696E672E426F74746F6D05000000000000008000400A506F - 736974696F6E2E580500000000000000C707400A506F736974696F6E2E590500 - 000000000000B407400A53697A652E576964746805000000000000009007400B - 53697A652E4865696768740500000000000000C005401453697A652E506C6174 - 666F726D44656661756C7408085461624F726465720204000654496D61676500 - 095374796C654E616D650608496D675468756D620E4D756C7469526573426974 - 6D61700E01000005416C69676E07084D6F73744C656674074869745465737408 - 0C50616464696E672E4C65667405000000000000008001400B50616464696E67 - 2E546F700500000000000000C000400D50616464696E672E5269676874050000 - 00000000008001400E50616464696E672E426F74746F6D0500000000000000C0 - 00400D4D617267696E732E526967687405000000000000008000400A506F7369 - 74696F6E2E5805000000000000008000400A506F736974696F6E2E5905000000 - 000000008000400A53697A652E57696474680500000000000000D405400B5369 - 7A652E4865696768740500000000000000B805401453697A652E506C6174666F - 726D44656661756C7408000005545465787400095374796C654E616D65060954 - 6578745469746C6505416C69676E0703546F700748697454657374080A506F73 - 6974696F6E2E580500000000000000DC05400A506F736974696F6E2E59050000 - 00000000008000400A53697A652E57696474680500000000000000B006400B53 - 697A652E486569676874050000000000F051B003401453697A652E506C617466 - 6F726D44656661756C740804546578740609496D61676520312F321754657874 - 53657474696E67732E466F6E742E5374796C650B066673426F6C640016546578 - 7453657474696E67732E486F727A416C69676E07074C656164696E6700000554 - 5465787400095374796C654E616D65060854657874496E666F05416C69676E07 - 06436C69656E74084175746F53697A65090748697454657374080A53697A652E - 57696474680500000000000000B006400B53697A652E48656967687405000000 - 000084EB8B05401453697A652E506C6174666F726D44656661756C7408045465 - 7874060735313278363839165465787453657474696E67732E486F727A416C69 - 676E07074C656164696E67165465787453657474696E67732E56657274416C69 - 676E07074C656164696E67000000} - end> - Left = 122 - Top = 426 - end - object PanelBack: TPanel - Align = Client - Size.Width = 975.000000000000000000 - Size.Height = 756.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - object ToolBar: TToolBar - ControlType = Platform - Size.Width = 975.000000000000000000 - Size.Height = 36.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'toolbarstyle' - TabOrder = 0 - object BtnOpenImage: TSpeedButton - Align = Left - ControlType = Platform - Size.Width = 81.000000000000000000 - Size.Height = 36.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'toolbutton' - Text = 'Open' - OnClick = BtnOpenImageClick - end - object BtnSaveImage: TSpeedButton - Align = Left - ControlType = Platform - Position.X = 81.000000000000000000 - Size.Width = 81.000000000000000000 - Size.Height = 36.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'toolbutton' - Text = 'Save' - OnClick = BtnSaveImageClick - end - object BtnAbout: TSpeedButton - Align = MostRight - ControlType = Platform - Position.X = 894.000000000000000000 - Size.Width = 81.000000000000000000 - Size.Height = 36.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'toolbutton' - Text = 'About' - OnClick = BtnAboutClick - end - end - object Splitter: TSplitter - Align = Left - Cursor = crHSplit - MinSize = 250.000000000000000000 - Position.X = 265.000000000000000000 - Position.Y = 36.000000000000000000 - Size.Width = 5.000000000000000000 - Size.Height = 720.000000000000000000 - Size.PlatformDefault = False - end - object ListImages: TListBox - Align = Left - Position.Y = 36.000000000000000000 - Size.Width = 265.000000000000000000 - Size.Height = 720.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'listboxstyle' - TabOrder = 2 - AlternatingRowBackground = True - DisableFocusEffect = True - ItemHeight = 96.000000000000000000 - DefaultItemStyles.ItemStyle = '' - DefaultItemStyles.GroupHeaderStyle = '' - DefaultItemStyles.GroupFooterStyle = '' - OnChange = ListImagesChange - Viewport.Width = 261.000000000000000000 - Viewport.Height = 716.000000000000000000 - end - object ImageViewer: TImageViewer - Align = Client - Size.Width = 705.000000000000000000 - Size.Height = 720.000000000000000000 - Size.PlatformDefault = False - TabOrder = 3 - BackgroundFill.Bitmap.Bitmap.PNG = { - 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF - 61000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 - 002E49444154384F636C6868F8CF800700E519A14CAC80094A930D460D180C06 - E08D631020944E4603711818C0C00000053F069EBF784F440000000049454E44 - AE426082} - BackgroundFill.Bitmap.WrapMode = Tile - BackgroundFill.Kind = Bitmap - ShowBackground = True - Viewport.Width = 701.000000000000000000 - Viewport.Height = 716.000000000000000000 - end - object EmbossEffect: TEmbossEffect - Enabled = False - Amount = 0.100000001490116100 - Width = 1.000000000000000000 - end - end - object AniIndicator: TAniIndicator - Align = Center - Enabled = True - HitTest = False - Size.Width = 111.000000000000000000 - Size.Height = 104.000000000000000000 - Size.PlatformDefault = False - Style = Circular - Visible = False - end - object OpenDialog: TOpenDialog - Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing] - Left = 56 - Top = 426 - end - object SaveDialog: TSaveDialog - Left = 56 - Top = 508 - end -end diff --git a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/MainForm.pas b/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/MainForm.pas deleted file mode 100644 index e4aa0cf..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/FireMonkeyDemo/MainForm.pas +++ /dev/null @@ -1,297 +0,0 @@ -{ - Vampyre Imaging Library Demo - FireMonkey Demo (class api, fmx interaction) - - This demo is a simple image viewer. On the left of the window is a list box with - information and thumbnail of images loaded from file. Selecting item in - list box displays the image in image viewer component that fills the rest of - the app window. Loaded image can be saved back to disk in one the supported - file formats. - - Demo uses ImagingFmx extension to convert between Imaging's and FireMonkey's - image classes. - - Image is loaded from the file in a background thread while the UI shows - progress animation. - - Note: tested only in Delphi 10 Seattle now -} -unit MainForm; - -interface - -uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, - FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Filter.Effects, FMX.Graphics, - FMX.Layouts, FMX.ListBox, FMX.ExtCtrls, FMX.Objects, FMX.StdCtrls, FMX.Effects, - FMX.Controls.Presentation, - - ImagingTypes, - Imaging, - ImagingClasses, - ImagingUtility, - ImagingFmx; - -type - TFormMain = class(TForm) - Splitter: TSplitter; - ToolBar: TToolBar; - ListImages: TListBox; - BtnOpenImage: TSpeedButton; - ImageViewer: TImageViewer; - StyleBook: TStyleBook; - PanelBack: TPanel; - AniIndicator: TAniIndicator; - OpenDialog: TOpenDialog; - BtnSaveImage: TSpeedButton; - BtnAbout: TSpeedButton; - EmbossEffect: TEmbossEffect; - SaveDialog: TSaveDialog; - procedure BtnOpenImageClick(Sender: TObject); - procedure BtnAboutClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure BtnSaveImageClick(Sender: TObject); - procedure ListImagesChange(Sender: TObject); - private - FImage: TMultiImage; - FFileName: string; - FLoaderThread: TThread; - procedure LoadingFinished(Success: Boolean; const ErrorMsg: string); - procedure FillListBox(Image: TMultiImage); - procedure SelectImage(Index: Integer); - end; - -var - FormMain: TFormMain; - -implementation - -uses - AboutForm; - -{$R *.fmx} - -const - ThumbMaxX = 106; - ThumbMaxY = 92; - -type - TImgLoaderThread = class(TThread) - private - type - TFinishedHandler = reference to procedure(Success: Boolean; const ErrorMsg: string); - private - FFileName: string; - FImageRef: TMultiImage; - FFinishedHandler: TFinishedHandler; - protected - procedure Execute; override; - public - constructor Create(const FileName: string; ImageRef: TMultiImage; - FinishedHandler: TFinishedHandler); - end; - -procedure ClearImagesAndThumbs(Img: TMultiImage); -var - I: Integer; -begin - for I := 0 to Img.ImageCount - 1 do - begin - if Img.DataArray[I].Tag <> nil then - TObject(Img.DataArray[I].Tag).Free; - end; - Img.ClearAll; -end; - -{ TImgLoaderThread } - -constructor TImgLoaderThread.Create(const FileName: string; - ImageRef: TMultiImage; FinishedHandler: TFinishedHandler); -begin - FFileName := FileName; - FImageRef := ImageRef; - FFinishedHandler := FinishedHandler; - FreeOnTerminate := True; - - inherited Create(False); -end; - -procedure TImgLoaderThread.Execute; -var - I: Integer; - Success: Boolean; - ErrorMsg: string; - Thumb: TSingleImage; -begin - TThread.NameThreadForDebugging('ImageLoaderThread'); - ErrorMsg := ''; - - // Delete old images and thumbmails - ClearImagesAndThumbs(FImageRef); - - try - // Load image from file - FImageRef.LoadMultiFromFile(FFileName); - Success := FImageRef.AllImagesValid; - - // Generate thumbnails for subimages - for I := 0 to FImageRef.ImageCount - 1 do - begin - Thumb := TSingleImage.Create; - FImageRef.ActiveImage := I; - FImageRef.ResizeToFit(ThumbMaxX, ThumbMaxY, rfBilinear, Thumb); - FImageRef.DataArray[I].Tag := Thumb; - end; - except - on E: Exception do - begin - Success := False; - ErrorMsg := E.Message; - end; - end; - - Synchronize( - procedure - begin - FFinishedHandler(Success, ErrorMsg); - end); -end; - -{ TFormMain } - -procedure TFormMain.FillListBox(Image: TMultiImage); -var - Item: TListBoxItem; - I, ImgSize: Integer; - Data: TImageData; - Bmp: TBitmap; -begin - ListImages.Clear; - Bmp := TBitmap.Create(0, 0); - - try - for I := 0 to FImage.ImageCount - 1 do - begin - Data := FImage.DataArray[I]; - - Item := TListBoxItem.Create(ListImages); - Item.Parent := ListImages; - Item.StyleLookup := 'ListBoxItem'; - - ImgSize := Data.Size; - if ImgSize > 8192 then - ImgSize := ImgSize div 1024; - - ImagingFmx.ConvertImageToFmxBitmap(TSingleImage(Data.Tag), Bmp); - - Item.StylesData['ImgThumb'] := Bmp; - Item.StylesData['TextTitle'] := Format('Image %d/%d', [I + 1, FImage.ImageCount]); - Item.StylesData['TextInfo'] := - Format('Resolution: %dx%d', [Data.Width, Data.Height]) + sLineBreak + - Format('Format: %s', [GetFormatName(Data.Format)]) + sLineBreak + - Format('Size: %.0n %s', [ImgSize + 0.0, Iff(ImgSize = Data.Size, 'B', 'KiB')]); - end; - finally - Bmp.Free; - end; -end; - -procedure TFormMain.FormCreate(Sender: TObject); -begin - Caption := Caption + ' - ' + Imaging.SImagingLibTitle + ' ' + Imaging.GetVersionStr; - FImage := TMultiImage.Create; -end; - -procedure TFormMain.FormDestroy(Sender: TObject); -begin - ClearImagesAndThumbs(FImage); - FImage.Free; -end; - -procedure TFormMain.ListImagesChange(Sender: TObject); -begin - if ListImages.ItemIndex >= 0 then - SelectImage(ListImages.ItemIndex); -end; - -procedure TFormMain.LoadingFinished(Success: Boolean; const ErrorMsg: string); -begin - if Success then - begin - FillListBox(FImage); - ListImages.ItemIndex := 0; - end - else - begin - MessageDlg('Error loading image: ' + ErrorMsg, TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0); - FImage.ClearAll; - end; - - AniIndicator.Visible := False; - EmbossEffect.Enabled := False; - ToolBar.Enabled := True; -end; - -procedure TFormMain.SelectImage(Index: Integer); -begin - FImage.ActiveImage := Index; - - ImageViewer.BeginUpdate; - try - ImagingFmx.ConvertImageToFmxBitmap(FImage, ImageViewer.Bitmap); - ImageViewer.BestFit; - finally - ImageViewer.EndUpdate; - end; -end; - -procedure TFormMain.BtnSaveImageClick(Sender: TObject); -begin - if not FImage.AllImagesValid then - begin - MessageDlg('No image is loaded.', TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0); - Exit; - end; - - SaveDialog.Filter := GetImageFileFormatsFilter(False); - SaveDialog.FileName := ChangeFileExt(ExtractFileName(FFileName), ''); - SaveDialog.FilterIndex := GetFileNameFilterIndex(FFileName, False); - - if SaveDialog.Execute then - begin - FFileName := ChangeFileExt(SaveDialog.FileName, '.' + GetFilterIndexExtension(SaveDialog.FilterIndex, False)); - FImage.SaveMultiToFile(FFileName); - end; -end; - -procedure TFormMain.BtnAboutClick(Sender: TObject); -var - X, Y: Integer; -begin - // Place it manually - poMainFormCenter etc. doesn't really work - // when main form has poScreenCenter - X := Left + (Width - FormAbout.Width) div 2; - Y := Top + (Height - FormAbout.Height) div 2; - FormAbout.SetBounds(X, Y, FormAbout.Width, FormAbout.Height); - FormAbout.ShowModal; -end; - -procedure TFormMain.BtnOpenImageClick(Sender: TObject); -begin - OpenDialog.Filter := Imaging.GetImageFileFormatsFilter(True); - if OpenDialog.Execute then - begin - FFileName := OpenDialog.FileName; - - ListImages.Clear; - ImageViewer.Bitmap.SetSize(0, 0); - ToolBar.Enabled := False; - AniIndicator.Visible := True; - EmbossEffect.Enabled := True; - - FLoaderThread := TImgLoaderThread.Create(FFileName, FImage, LoadingFinished); - end; -end; - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.lfm b/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.lfm deleted file mode 100644 index b980bca..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.lfm +++ /dev/null @@ -1,325 +0,0 @@ -object AboutForm: TAboutForm - Left = 358 - Height = 320 - Top = 254 - Width = 286 - ActiveControl = BitBtn1 - BorderIcons = [] - BorderStyle = bsSingle - Caption = 'About' - ClientHeight = 320 - ClientWidth = 286 - Color = clWindow - OnShow = FormShow - Position = poMainFormCenter - LCLVersion = '1.0.12.0' - object Image: TImage - Left = 48 - Height = 89 - Top = 16 - Width = 188 - end - object Image2: TImage - Left = 56 - Height = 48 - Top = 208 - Width = 48 - Picture.Data = { - 055449636F6EBE1C00000000010001003030000000000000A81C000016000000 - 2800000030000000600000000100180000000000801C00000000000000000000 - 000000000000000057B7D968C3DD3A739E21242C1C1A191F22262229301E1C1A - 1A18161A19152536473B8CBF4087B63B6B9557ACCE498AAD2F414E5193AA72B1 - C82D39441D1C193451613C69854A7A8B73AFBF5D8EA64E80955C8E915F756A53 - 5D493940312C322A000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000068C5DF44779D1F1E - 221D1D1B2C4C64489CC144A0C727374F2635461C1B1A2128344194C42737491F - 1E21376A8A4AA1C759A6C084C8D856859B1D1C19293A445AA6C06BB4C77FC4D3 - 5C94AE3553694E82956BA7B4567B74546354414B3B2F3A2D33483C0000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000005097BE2326301B1A1725333D55B9D861C7DF63C7E044A0CD - 43A1CC1F242D21272F3675A31B1A181A1A162E4D6066BFD884D0DE82C7D7374F - 5C27343C4991AF82C9DA7FC8D781C0CE447691548EA575B1C26EA2AD6E9A9961 - 7D784C5847313A2D2D3B30000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000002E4B651C1A171B19 - 162D506758B9D941799E4893B767CDE154B1D41E212725384A3A8DBF1B1C1E1B - 19162B45547DCADC96D6E14A7386242628386B8674C3D46CACC152849CB4D9DD - B5D7DB70B1C376B6C576ACB77AACB25179744F695E3F4C3B2E342A0000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000252A321C1B171A1A1635677F325A7E201E1E2C4B5F63C7E0 - 559FBE1C1B192B4B6A419BC91D1D201F201F4B8DA57FCDDC5891A92123262D40 - 4A52A7C276B2C633424E4A6E7AA6CDD3A2CDD471B2C494CAD36DA7B56DA3AE4C - 7A7B466E724D655A334534334A3B000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000021201F201F1F1E1E - 1D408AB02429372122243F839E65C4DE2D465B1A191620262F2C456D242A343A - 7A9C82CEDD77BBCE23292E24272A4D94A964BDD63D5F7453757EADD1D497C7CE - 78B0BD97C9CFA8D3D76BA3B171A3AB4D7D85426A693E564E3648383049380000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000001D1D1D2D3B57242E3A4CADD32E4967417F9972CFE156A7C8 - 1E1E201A19151F1D1B2A3F594399BE7BD0E190D4E03E657C1D1D1A37709151AD - CC5EB2CF689EB35C8BA094C3CCB4D6D8A0C9CD94C6CE80BAC65D96A665989F43 - 6D7540696A4467624453443446362C332C000000000000000000000000000000 - 0000000000000000000000000000000000000000000000001A19151B1A162431 - 3B4AAFD448AAD065CBE16FD3E33E75971C1A171B1A16222B374597BE77D0E196 - D8E495D4E02C3E48232A2F448BAF57B2CF5994AA3C55615E828899C8CD9FCDD2 - BDD9D991C3C989BEC883BAC3548994507B804F7B7E42645C44594D3947382F3A - 2E30433300000000000000000000000000000000000000000000000000000000 - 00000000000000001A19151B1A172D506059C7E058C7E072D3E474D5E53A749C - 21252C21272A39728F7ED0E2A7DDE5A0DAE47AC1D521252A25282D5192AB5A9F - B6364E56769DA3A4CFD2A7D3D5A2CED2C5DCDC95C3C9A1C9CD9FC7CA8EB6BC88 - A9AA728E8D637C74546D6047594C3C503C314635304536000000000000000000 - 0000000000000000000000000000000000000000000000001B1A16202225409A - BB53C8E164CFE368D0E478D6E663CDE348A3C766B9D18CD6E3A1DCE585BACD3F - 6D8B4594BA2F4D6B4173846CBAD05999AB5C8D9B70A7B4A8CED3B1D5D9A9D1D4 - B4D3D395BFC3BAD2D3C9D9DAB1CCCDA9C0C08C9F9D8B9F9C7F96917B9085535F - 4E39503D30473600000000000000000000000000000000000000000000000000 - 0000000000000000263C503785A84DBBDC59C3E04688AB2F4F6A4289AE69CDE2 - 81D6E595D8E591D5E39AD8E43B5F742B3E4864BCD64386AC72BCD14D7B8D455D - 6648636B53829288B5BE94BFC699C0C58FB8BEB5D0D1B8D1D49BB8C085A5AE72 - 8C9474898983979590A9AA839C986B7A6D424F3F3E53412F3D2E000000000000 - 00000000000000000000000000000000000000000000000041ADD63A82AD273C - 532431421F20221B1A17252E3A5EB0CB7AC0D4477A954075956297B2304C6152 - A6BE5CB8D55FA7C16499AD5B7E84506B6F5379815C8F9F75A4AE8AB5BB6F9BA3 - A1BFC1D3DEDDC2D5D49FBCBF739196647D7E596762484E4A7B8D8D879C9992A9 - A293A2976A6E5844513F00000000000000000000000000000000000000000000 - 0000000000000000439FCB1F242D1B19161A19151A19151B1A161D1C1A5596AD - 4476911E1D1B3F738758A9C77CCCDD6CCEE273C3D796C9D27EB3C0A1CCD386B8 - C180B1BA76ACB87FB2BD85B2BA7EAAB6ABD2D8BDD8DAB8D2D49FC1C68FB6BC76 - 9BA87E9DA2687A7893ACB0C2D1D0C5D0CFCCD3D28C9688536356446F5D000000 - 0000000000000000000000000000000000000000000000003164921B1A181C1C - 1A2428321C1B171B19162126275DACC13F73912A353B7CC7D68DD9E56ECAE153 - ABCB84BBCABCDADDB7D9DCB5D9DCC3DCDEB7D7D9B4D3D6C8DADBBBD6D87AA6B6 - 9ACDD791C4CF88B7C28DB6C182B5C377ADBC6F929C4753547F969EC4D7D7B4CA - CBA2BFC07D98964B554A3B493661795700000000000000000000000000000000 - 000000000000000032608C1C1B1931607E3776AA1F1F231B1A162F4E607DD1E0 - 5BAFCF4D8EAA77C7DB78D4E34EA7CC80AEBC8BBCC7C8DEDFD2E2E2B9DBE0C9DE - DED8E2E1DBE2E2DDE3E2BBD8DE6AA1B585C6D46FB2C46BA6BA86B8C599C5CE9A - C2CA38454D23211F2A2B285D626087928E7C9B9B5F84864F5F58393B323B5D45 - 36A77E0000000000000000000000000000000000000000003A7BA82020223F88 - A84089B42120261E1D1A41819E6FCDE16DCCE05FA6C14890AF6ACCE05495B4B3 - D5D9A8D2DAB2D8DEA1CFD9CCE1E2DBE4E3E2E5E3DBE4E2DBE4E38FC0CE5C9BB4 - 80BFCE6BAFC282BACAA5CDD38BB3C14C677936414B2627262F302F1F1D193734 - 2A595E4D586F67506D6A3C443E43544144855A00000000000000000000000000 - 00000000000000002934421E1D1B3E76914CAACE31567C24282E4896B660C1DC - 4A86A4365E795DBDD74DB1D25E9EB689B4C157808EAED6DCABD3DACEE0E0E1E5 - E5E5E6E4DEE5E4C8E2E28FC4D2669AAF83BECE7FB8C88CBFCB8EB7C33A465034 - 3B402E333D2E32343838353638351E1C193D3D325D615252716E434E47464D41 - 445E433D6C4F0000000000000000000000000000000000001D1C1821211F2930 - 38396A8A2B3F4F26313A56B8D54899BF272C364E92AB61C1D94FA0C197C6D077 - 9BA7658B95BDDCDFD3E2E2D8E4E3E7E6E4E2E6E4BEDFE3A2DAE36EB4CA3D5665 - 68AEC580C4D2A1D2DB7096A3303538343C413C464D373B3F4647404246432928 - 2531322D5B5D4B526E6C3F514C3F473D3A463F364C3F00000000000000000000 - 000000000000000021212024252520201F2529311C1B182D46555DBDD730506B - 28363F5EBBD163C3D97FC3D3B7DBDD90B7C487B3C07DB5C5B9D6DBE3E6E4DFE5 - E5B3DBDF95D5E07ACCDC65B2CB33404C619DB376C2D391D2DE7CB8C649778D3F - 61733C5464415C6C3F505941575E394A503F535049554D465F633543413D4841 - 3E453A343E352F47420000000000000000000000000000003259822C37492120 - 21292D34262C345EABC284D5E35697B53252676BC7DB53A7C4A1D6DF79B3C4B8 - DADEB5D8DCA9D0D7D0E0E1D7E3E4CBE2E3B0DDE18ED3DF6EC1D55099BA395C74 - 47758968BCD168C1D871C5D96BC0D363B2C856A0BA4989A7447A9F497C96497E - 9B3B59623A494B42585C323A373A5653414C4136433B3A6C6000000000000000 - 0000000000000000345F7E2B35442D3B4F212123232B316BC0D490D8E57EC7DB - 4893B561C1D870BCD18AC3D34E829D4D7484ADD6DC8FBDCAA3D0D9C9E0E2ADD6 - DD7FC5D560B1CD5EAFCB4E95B5497E9C31414D569AB662B1CC66BBD36BC0D664 - B7CE5DB1CB498FB3468FB44889AD416A883B56633C4949353D3B3D433D3F6069 - 416167333B3832524B0000000000000000000000000000002E39402E39463254 - 78222226212121579AAF8ED6E392D8E46EC6DA83D3E296D7E267A5BC659BAF41 - 637379BED15DA1BA6FA4B884B8C864A5BC4F92B5457EA54278A04A82A14D7D98 - 3C535E334D61509EC058B3D16BC4D864B9D05BACC7498CB0448BB1457C9E3A58 - 713A546330383832342E3F4B47394E523852593745412D3A38385E5300000000 - 00000000000000002B2A2A2323212C363F2C3745211F1C3A596A6BB0C394D6E4 - 75CFDF90D6E286D0DF65ADC180BBCC5597B1385D715AA0B84A75879BD6E16FC3 - D8519FC042749A406B8B3E627A43677F4C6C7A272A2F3C719451A3C45AAFCB58 - A9C8529CBD4D98B94283AA3E67873A51663950592626233B433E405660426172 - 3A515A3A4D4C2F36313145360000000000000000000000002C2C2A2A29272524 - 222E3C4B27272B2423222932387AC2D374CBDD94D7E361AAC48FCAD582C6D66D - B9CC407F9F79C6D895D5E091D5E064B8D0478AB0416C8B41647A405E6F3F5B6D - 527481292F30354D5E488BAD4F97BA4D93B94B91B54F93B442779B3B5D7E3952 - 6437474C33322B4A646E4C768C5997AF4E7D9139545831403F32544000000000 - 000000000000000032383C313A3C2A2A282829282E333A211F1C2327296EB3C7 - 7FD1E092D7E471C7DA6DAFC5569FB96BC3D83C5C6D4E778685CDDD84CEDD5AB0 - CB4984A139596F4365773C54634C6B7A5F7C84374345303A403C627F4E8CAC52 - 96B94786AE416A8F3A638C3E6E933A5B752D333843453C5E8A9D5B9AB5528DA8 - 5790A93D5558314143345B4F0000000000000000000000000000003448483446 - 3D3539342E2E2C26252327282B5495AE8CD6E29EDAE481D1E04B8AA936576D4E - A2C459A5BE313C45548BA15FB2CE4580A43D5F7A3952623A56683C536056757F - 5F75752E312E333E4039566D4981A14B90B241709637557F3B6C9E406E963A57 - 712B313340433D6C9BAB599BB963A6BE569AB4487180292E2D36585438746100 - 00000000000000000000000000000000003439343236312D2D2B2B333A4890B1 - 93D6E296D7E375CADC72BCD13E678252A1C062BED659A1B82F3D483A67904784 - A74060753F5B6554717A6D8485677C7E4A575422211E3B4C4D3B596E456E8A48 - 86AC4177A138598A3D6F9C3D6F9737557035475032322C7598A09DCAD274B4C8 - 5DA5BF42708526282533403C365E500000000000000000000000000000000000 - 0000000035433932362F2928284079918DD2DF8DD5E060BED558A7C43B729749 - A0C068C1D66AC3D85BAECC3A6D9A4584A944687A627C825059582B2D2F242428 - 1E1C191B19183E50524060773C607F43769A42719B3856813B5E85416C943650 - 6933454C1C1A173337355B6A6B9CBABF93C8D2548DA0282B29333F39324D4200 - 0000000000000000000000000000000000000000000000374C41333A34354E59 - 74C2D377CADB5EBCD44691B732567543809D5DB9D255B3D04CA4CA2E45613858 - 7952717F4B54502827302C30572E3369292A3521211F4460673F5E723A587645 - 708F4676A0354B743958843B5D84334354313C3C211F2026252727282D313434 - 78969A4C737E2D302D373F382F433C324F420000000000000000000000000000 - 00000000000000395D51364B403134314D85995FB1CA52ADCB5AAECB447DA139 - 658B4589AA4FA8CA418DB93C7BA93252774258642526232929352C2D38272A39 - 2726292C3333405760374C5D3955763C5B7F3F678E34466D37598B3B618E3443 - 54343E3C2627272927262625281F1E1B38352E3B4540323C3B3338312D3A352F - 463D00000000000000000000000000000000000000000000000035514A33453E - 36525B5FB3CB55B0CC58AFCB355E81396C8F3B7FAA4493BD3B7EAB386B93365C - 7D3853673E545D2D3537292A282A2C2D405362384E673A4F6D34486339507039 - 5C863B5475313D59375F96375B92395780384B5F303A402A2C2C262524232625 - 353F41364748333E3E2D322E2C34312F3F3C0000000000000000000000000000 - 0000000000000000000000000033554F334A47457D9057AAC73981B0345D8436 - 597B366794376D9E3977A537658F39658C3A618441678245687F39454D405464 - 406B8D35517D3757843B5A85354A69374C6633465E2B3242385B8B3A679A385A - 893E658A36485E3743474350525A79844E6B703A4B4D353D3C2929262B332F2E - 3D38000000000000000000000000000000000000000000000000000000000000 - 33595136585B59A6BD4084AA355C82304966355375365781365F8C3868943969 - 953966903F79A24581A542718F477B9D417CA53655803C6999375885384E6D36 - 495E313A452C313C344A6B3959863A5C89385473354A5E3A53603F555D455E65 - 3A4949333D3C34373323231E282D28303C350000000000000000000000000000 - 0000000000000000000000000000000000000035615F427A8C4790B33870953A - 7AA43A6C933C6A9138567D3667953E7CA83D81B24288B54B9CC157A6C258A4C1 - 4380AA354C683E7BAA39628F3547662F3A46313B3F2A2C3234465E354A693958 - 793950682F394339515D3D565F3A4B4B323E3A353B352C2E2925231F2C353100 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000003565644892A2519DB9386A8F35668D39739C3B729A324C74365A873B75 - A4418EBC4492BE4A9CC44B9DC34F9CC04284B03650724281B1467CA434486435 - 47552F3B40282C2F37495639505D354657384C5530373A374A4E354649333F3E - 3034322C2D2A2A29252524202E3D380000000000000000000000000000000000 - 000000000000000000000000000000000000003F727857A4B84FA4C13D7EA637 - 6790396F95386386334B6B3551753763924291BC49A5C94DA6C9428AB74A97BF - 3F7AAB3D6995457CA5385A763445552C33362D33392F353D38495030383B343D - 40354143303A3C3743443542412D2E2E2928252A2B272826222B2F2B30433C00 - 0000000000000000000000000000000000000000000000000000000000000000 - 334B4C3C6D7551A1B84EA0BD438EB2386D97375B7F35527138597B313E53344E - 713D7CA64FA8CA4587AB4483AC4584AF4387B3437AA03A5B7A33404C3A506028 - 2E31313E522C313A343F412A2D2D313B3E2D302F3138373846462F39382A2A29 - 2725212624202B2B25303A31324A3D0000000000000000000000000000000000 - 00000000000000000000000000000000375D6059A2B44894B238769A33587B34 - 5679345477354F6B334C5F33485B303B4A2F3D543F769B2C34412F3B4A43789B - 38567126292B3E596E41627B3548542F3843344666374C63262A2C303A423F61 - 792D34373A4B533441462D33332A2B2A2928242928232C2C27323F35324E4100 - 0000000000000000000000000000000000000000000000000000000000000000 - 55919B69B8CB438DAF324E692F3D5334516D3C6687344F682D34392E363A323C - 412C333B303F503A5D803B5A7B3A5B763A576B323F4A40637E364B5B2930362F - 3A462E3A4B31415025282B457592426E8A2D353A34404A3038392F3839292B28 - 2D2C282C2A2433373136473E334C410000000000000000000000000000000000 - 000000000000000000000000000000004A7F8A55A7C3498AAD313C4639515D50 - 92AF5298B539586C2B384239515F292D312E3438375268375B772C3A45242728 - 272E352D3B4731414C2930312F394128292D2C323B28323D3E7396427A96364F - 653243502B2E2F36495035404231312D25231E2A2A2639443B344D4200000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 527D8471BACF5275832E2F2E2E2E2A354A52457E9459A0BA457D9A3953633442 - 4431393A2B353B33495A2E38433C657E3F7A9E38586F2628292A333B2F3B452A - 2E322E364232435534526A303D49375B78365669344247303B3F2F2F2B2B2A26 - 343B3C414E48344A3C3452430000000000000000000000000000000000000000 - 0000000000000000000000000000000051777A84C3D3669AAF4E798F394A542D - 2E2D2D35364E737D3D555E22221F1D1B1823242321211F222628314A5D34536D - 3A6C93376084304153313C492E364225262B2D384A2B35412C38453A63863757 - 6D324149242421383934404D4E4B6A73466261344B4135503E00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 2B363363919C8FC4D1669CB14F849D4462703E4A4A3939343C4C452D3A312B33 - 2D1A19171A18171A18161B1A18283239355673365673344A5F2E3B482D353B2E - 3A49303E4E303F5037546C324856222321262A24354139405F504371603E6958 - 324B3E314A400000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000003045426995966BA9BA5C9AAF48 - 6D7B43504A34403733493E335242344C3E282F2729342C22272421221F262725 - 222422242526272D302B3338292C29272A28282A2A282B2A2A2D2B2A302A3040 - 38324A3D304734334F3B00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000002F403A3F6263507B7E466563323F322E3B2F0000000000000000 - 0000000038534A344E4934474331433D31453B3040342E372E33493F334C3E30 - 3E2F2E362A2E372C2B342A000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000FFFF0000000000007FFF0000000000007FFF0000 - 000000007FFF0000000000003FFF0000000000003FFF0000000000001FFF0000 - 000000000FFF00000000000007FF00000000000007FF00000000000003FF0000 - 0000000003FF00000000000001FF00000000000000FF000000000000007F0000 - 00000000007F000000000000003F000000000000003F000000000000001F0000 - 00000000001F000000000000001F000000000000000F000000000000000F0000 - 00000000000F000000000000000F00008000000000070000E000000000070000 - F000000000070000F800000000030000F800000000030000FC00000000030000 - FE00000000030000FF00000000030000FF80000000070000FF80000000070000 - FF80000000070000FF00000000070000FF00000000070000FF00000000070000 - FF000000000F0000FF000000000F0000FF000000001F0000FF000000003F0000 - FF80000003FF0000FFC0F0007FFF0000FFFFFFFFFFFF0000FFFFFFFFFFFF0000 - FFFFFFFFFFFF0000 - } - end - object labImaging: TLabel - Left = 8 - Height = 32 - Top = 120 - Width = 272 - Alignment = taCenter - AutoSize = False - Caption = 'Vampyre Imaging Library' - Font.Color = clBlack - Font.Style = [fsBold] - ParentColor = False - ParentFont = False - end - object Label1: TLabel - Left = 112 - Height = 56 - Top = 208 - Width = 136 - AutoSize = False - Caption = 'Lazarus Imager Demo' - Font.Color = clBlack - Font.Style = [fsBold] - ParentColor = False - ParentFont = False - WordWrap = True - end - object ImLabel1: TLabel - Left = 8 - Height = 18 - Top = 176 - Width = 272 - Alignment = taCenter - AutoSize = False - Caption = 'http://imaginglib.sourceforge.net' - Font.Color = clBlue - Font.Height = 13 - Layout = tlCenter - ParentColor = False - ParentFont = False - OptimalFill = True - end - object BitBtn1: TBitBtn - Left = 104 - Height = 30 - Top = 280 - Width = 75 - BorderSpacing.InnerBorder = 2 - Caption = '&Close' - Kind = bkClose - NumGlyphs = 0 - TabOrder = 0 - end - object LabVersion: TLabel - Left = 0 - Height = 32 - Top = 148 - Width = 280 - Alignment = taCenter - AutoSize = False - Caption = 'version' - Font.Color = clBlack - ParentColor = False - ParentFont = False - end -end diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.lrs b/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.lrs deleted file mode 100644 index 718872a..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.lrs +++ /dev/null @@ -1,249 +0,0 @@ -{ This is an automatically generated lazarus resource file } - -LazarusResources.Add('TAboutForm','FORMDATA',[ - 'TPF0'#10'TAboutForm'#9'AboutForm'#4'Left'#3'f'#1#6'Height'#3'@'#1#3'Top'#3 - +#254#0#5'Width'#3#30#1#13'ActiveControl'#7#7'BitBtn1'#11'BorderIcons'#11#0#11 - +'BorderStyle'#7#8'bsSingle'#7'Caption'#6#5'About'#12'ClientHeight'#3'@'#1#11 - +'ClientWidth'#3#30#1#5'Color'#7#8'clWindow'#6'OnShow'#7#8'FormShow'#8'Positi' - +'on'#7#16'poMainFormCenter'#10'LCLVersion'#6#8'1.0.12.0'#0#6'TImage'#5'Image' - +#4'Left'#2'0'#6'Height'#2'Y'#3'Top'#2#16#5'Width'#3#188#0#0#0#6'TImage'#6'Im' - +'age2'#4'Left'#2'8'#6'Height'#2'0'#3'Top'#3#208#0#5'Width'#2'0'#12'Picture.D' - +'ata'#10#200#28#0#0#5'TIcon'#190#28#0#0#0#0#1#0#1#0'00'#0#0#0#0#0#0#168#28#0 - +#0#22#0#0#0'('#0#0#0'0'#0#0#0'`'#0#0#0#1#0#24#0#0#0#0#0#128#28#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0'W'#183#217'h'#195#221':s'#158'!$,'#28#26#25#31'"&")0' - +#30#28#26#26#24#22#26#25#21'%6G;'#140#191'@'#135#182';k'#149'W'#172#206'I' - +#138#173'/ANQ'#147#170'r'#177#200'-9D'#29#28#25'4Qa<i'#133'Jz'#139's'#175#191 - +']'#142#166'N'#128#149'\'#142#145'_ujS]I9@1,2*'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'h'#197#223 - +'Dw'#157#31#30'"'#29#29#27',LdH'#156#193'D'#160#199'''7O&5F'#28#27#26'!(4A' - +#148#196'''7I'#31#30'!7j'#138'J'#161#199'Y'#166#192#132#200#216'V'#133#155#29 - +#28#25'):DZ'#166#192'k'#180#199#127#196#211'\'#148#174'5SiN'#130#149'k'#167 - +#180'V{tTcTAK;/:-3H<'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'P'#151#190'#&0'#27#26#23'%3=U'#185#216'a' - +#199#223'c'#199#224'D'#160#205'C'#161#204#31'$-!''/6u'#163#27#26#24#26#26#22 - +'.M`f'#191#216#132#208#222#130#199#215'7O\''4<I'#145#175#130#201#218#127#200 - +#215#129#192#206'Dv'#145'T'#142#165'u'#177#194'n'#162#173'n'#154#153'a}xLXG1' - +':--;0'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0'.Ke'#28#26#23#27#25#22'-PgX'#185#217'Ay'#158'H'#147#183 - +'g'#205#225'T'#177#212#30'!''%8J:'#141#191#27#28#30#27#25#22'+ET}'#202#220 - +#150#214#225'Js'#134'$&(8k'#134't'#195#212'l'#172#193'R'#132#156#180#217#221 - +#181#215#219'p'#177#195'v'#182#197'v'#172#183'z'#172#178'QytOi^?L;.4*'#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0'%*2'#28#27#23#26#26#22'5g'#127'2Z~ '#30#30',K_c'#199#224'U'#159#190 - +#28#27#25'+KjA'#155#201#29#29' '#31' '#31'K'#141#165#127#205#220'X'#145#169 - +'!#&-@JR'#167#194'v'#178#198'3BNJnz'#166#205#211#162#205#212'q'#178#196#148 - +#202#211'm'#167#181'm'#163#174'Lz{FnrMeZ3E43J;'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'! '#31' '#31#31#30#30 - +#29'@'#138#176'$)7!"$?'#131#158'e'#196#222'-F['#26#25#22' &/,Em$*4:z'#156#130 - +#206#221'w'#187#206'#).$''*M'#148#169'd'#189#214'=_tSu~'#173#209#212#151#199 - +#206'x'#176#189#151#201#207#168#211#215'k'#163#177'q'#163#171'M}'#133'Bji>VN' - +'6H80I8'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#29#29#29'-;W$.:L'#173#211'.IgA'#127#153'r'#207#225'V'#167 - +#200#30#30' '#26#25#21#31#29#27'*?YC'#153#190'{'#208#225#144#212#224'>e|'#29 - +#29#26'7p'#145'Q'#173#204'^'#178#207'h'#158#179'\'#139#160#148#195#204#180 - +#214#216#160#201#205#148#198#206#128#186#198']'#150#166'e'#152#159'Cmu@ijDgb' - +'DSD4F6,3,'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#26#25#21#27#26#22'$1;J'#175#212'H'#170#208'e'#203#225'o'#211#227 - +'>u'#151#28#26#23#27#26#22'"+7E'#151#190'w'#208#225#150#216#228#149#212#224 - +',>H#*/D'#139#175'W'#178#207'Y'#148#170'<Ua^'#130#136#153#200#205#159#205#210 - +#189#217#217#145#195#201#137#190#200#131#186#195'T'#137#148'P{'#128'O{~Bd\DY' - +'M9G8/:.0C3'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#26#25#21#27#26#23'-P`Y'#199#224'X'#199#224'r'#211#228't'#213#229':t' - +#156'!%,!''*9r'#143'~'#208#226#167#221#229#160#218#228'z'#193#213'!%*%(-Q' - +#146#171'Z'#159#182'6NVv'#157#163#164#207#210#167#211#213#162#206#210#197#220 - +#220#149#195#201#161#201#205#159#199#202#142#182#188#136#169#170'r'#142#141 - +'c|tTm`GYL<P<1F50E6'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#27#26#22' "%@'#154#187'S'#200#225'd'#207#227'h'#208#228'x'#214#230 - +'c'#205#227'H'#163#199'f'#185#209#140#214#227#161#220#229#133#186#205'?m'#139 - +'E'#148#186'/MkAs'#132'l'#186#208'Y'#153#171'\'#141#155'p'#167#180#168#206 - +#211#177#213#217#169#209#212#180#211#211#149#191#195#186#210#211#201#217#218 - +#177#204#205#169#192#192#140#159#157#139#159#156#127#150#145'{'#144#133'S_N9' - +'P=0G6'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'&<' - +'P7'#133#168'M'#187#220'Y'#195#224'F'#136#171'/OjB'#137#174'i'#205#226#129 - +#214#229#149#216#229#145#213#227#154#216#228';_t+>Hd'#188#214'C'#134#172'r' - +#188#209'M{'#141'E]fHckS'#130#146#136#181#190#148#191#198#153#192#197#143#184 - +#190#181#208#209#184#209#212#155#184#192#133#165#174'r'#140#148't'#137#137 - +#131#151#149#144#169#170#131#156#152'kzmBO?>SA/=.'#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'A'#173#214':'#130#173'''<S$1B'#31' "'#27 - ,#26#23'%.:^'#176#203'z'#192#212'Gz'#149'@u'#149'b'#151#178'0LaR'#166#190'\' - +#184#213'_'#167#193'd'#153#173'[~'#132'PkoSy'#129'\'#143#159'u'#164#174#138 - +#181#187'o'#155#163#161#191#193#211#222#221#194#213#212#159#188#191's'#145 - +#150'd}~YgbHNJ{'#141#141#135#156#153#146#169#162#147#162#151'jnXDQ?'#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'C'#159#203#31'$-'#27#25 - +#22#26#25#21#26#25#21#27#26#22#29#28#26'U'#150#173'Dv'#145#30#29#27'?s'#135 - +'X'#169#199'|'#204#221'l'#206#226's'#195#215#150#201#210'~'#179#192#161#204 - +#211#134#184#193#128#177#186'v'#172#184#127#178#189#133#178#186'~'#170#182 - +#171#210#216#189#216#218#184#210#212#159#193#198#143#182#188'v'#155#168'~' - +#157#162'hzx'#147#172#176#194#209#208#197#208#207#204#211#210#140#150#136'Sc' - +'VDo]'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'1d'#146#27#26#24 - +#28#28#26'$(2'#28#27#23#27#25#22'!&'']'#172#193'?s'#145'*5;|'#199#214#141#217 - +#229'n'#202#225'S'#171#203#132#187#202#188#218#221#183#217#220#181#217#220 - +#195#220#222#183#215#217#180#211#214#200#218#219#187#214#216'z'#166#182#154 - +#205#215#145#196#207#136#183#194#141#182#193#130#181#195'w'#173#188'o'#146 - +#156'GST'#127#150#158#196#215#215#180#202#203#162#191#192'}'#152#150'KUJ;I6a' - +'yW'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'2`'#140#28#27#25'1`~7v' - +#170#31#31'#'#27#26#22'/N`}'#209#224'['#175#207'M'#142#170'w'#199#219'x'#212 - +#227'N'#167#204#128#174#188#139#188#199#200#222#223#210#226#226#185#219#224 - +#201#222#222#216#226#225#219#226#226#221#227#226#187#216#222'j'#161#181#133 - +#198#212'o'#178#196'k'#166#186#134#184#197#153#197#206#154#194#202'8EM#!'#31 - +'*+(]b`'#135#146#142'|'#155#155'_'#132#134'O_X9;2;]E6'#167'~'#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0':{'#168' "?'#136#168'@'#137#180'! &'#30#29#26'A' - +#129#158'o'#205#225'm'#204#224'_'#166#193'H'#144#175'j'#204#224'T'#149#180 - +#179#213#217#168#210#218#178#216#222#161#207#217#204#225#226#219#228#227#226 - +#229#227#219#228#226#219#228#227#143#192#206'\'#155#180#128#191#206'k'#175 - +#194#130#186#202#165#205#211#139#179#193'Lgy6AK&''&/0/'#31#29#25'74*Y^MXogPm' - +'j<D>CTAD'#133'Z'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0')4B'#30#29#27'>v' - +#145'L'#170#206'1V|$(.H'#150#182'`'#193#220'J'#134#164'6^y]'#189#215'M'#177 - +#210'^'#158#182#137#180#193'W'#128#142#174#214#220#171#211#218#206#224#224 - +#225#229#229#229#230#228#222#229#228#200#226#226#143#196#210'f'#154#175#131 - +#190#206#127#184#200#140#191#203#142#183#195':FP4;@.3=.24885685'#30#28#25'==' - +'2]aRRqnCNGFMAD^C=lO'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#29#28#24'!!'#31')0' - +'89j'#138'+?O&1:V'#184#213'H'#153#191''',6N'#146#171'a'#193#217'O'#160#193 - +#151#198#208'w'#155#167'e'#139#149#189#220#223#211#226#226#216#228#227#231 - +#230#228#226#230#228#190#223#227#162#218#227'n'#180#202'=Veh'#174#197#128#196 - +#210#161#210#219'p'#150#163'0584<A<FM7;?FG@BFC)(%12-[]KRnl?QL?G=:F?6L?'#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'!! $%% '#31'%)1'#28#27#24'-FU]'#189#215'0Pk(' - +'6?^'#187#209'c'#195#217#127#195#211#183#219#221#144#183#196#135#179#192'}' - +#181#197#185#214#219#227#230#228#223#229#229#179#219#223#149#213#224'z'#204 - +#220'e'#178#203'3@La'#157#179'v'#194#211#145#210#222'|'#184#198'Iw'#141'?as<' - +'TdA\l?PYAW^9JP?SPIUMF_c5CA=HA>E:4>5/GB'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'2Y' - +#130',7I! !)-4&,4^'#171#194#132#213#227'V'#151#181'2Rgk'#199#219'S'#167#196 - +#161#214#223'y'#179#196#184#218#222#181#216#220#169#208#215#208#224#225#215 - +#227#228#203#226#227#176#221#225#142#211#223'n'#193#213'P'#153#186'9\tGu'#137 - +'h'#188#209'h'#193#216'q'#197#217'k'#192#211'c'#178#200'V'#160#186'I'#137#167 - +'Dz'#159'I|'#150'I~'#155';Yb:IKBX\2:7:VSALA6C;:l`'#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0'4_~+5D-;O!!##+1k'#192#212#144#216#229'~'#199#219'H'#147#181'a'#193#216 - +'p'#188#209#138#195#211'N'#130#157'Mt'#132#173#214#220#143#189#202#163#208 - +#217#201#224#226#173#214#221#127#197#213'`'#177#205'^'#175#203'N'#149#181'I~' - +#156'1AMV'#154#182'b'#177#204'f'#187#211'k'#192#214'd'#183#206']'#177#203'I' - +#143#179'F'#143#180'H'#137#173'Aj'#136';Vc<II5=;=C=?`iAag3;82RK'#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0'.9@.9F2Tx""&!!!W'#154#175#142#214#227#146#216#228'n'#198 - +#218#131#211#226#150#215#226'g'#165#188'e'#155#175'Acsy'#190#209']'#161#186 - +'o'#164#184#132#184#200'd'#165#188'O'#146#181'E~'#165'Bx'#160'J'#130#161'M}' - +#152'<S^3MaP'#158#192'X'#179#209'k'#196#216'd'#185#208'['#172#199'I'#140#176 - +'D'#139#177'E|'#158':Xq:Tc08824.?KG9NR8RY7EA-:88^S'#0#0#0#0#0#0#0#0#0#0#0#0 - +'+**##!,6?,7E!'#31#28':Yjk'#176#195#148#214#228'u'#207#223#144#214#226#134 - +#208#223'e'#173#193#128#187#204'U'#151#177'8]qZ'#160#184'Ju'#135#155#214#225 - +'o'#195#216'Q'#159#192'Bt'#154'@k'#139'>bzCg'#127'Llz''*/<q'#148'Q'#163#196 - +'Z'#175#203'X'#169#200'R'#156#189'M'#152#185'B'#131#170'>g'#135':Qf9PY&&#;C>' - +'@V`Bar:QZ:ML/611E6'#0#0#0#0#0#0#0#0#0#0#0#0',,**)''%$".<K''''+$#")28z'#194 - +#211't'#203#221#148#215#227'a'#170#196#143#202#213#130#198#214'm'#185#204'@' - +#127#159'y'#198#216#149#213#224#145#213#224'd'#184#208'G'#138#176'Al'#139'Ad' - ,'z@^o?[mRt'#129')/05M^H'#139#173'O'#151#186'M'#147#185'K'#145#181'O'#147#180 - +'Bw'#155';]~9Rd7GL32+JdnLv'#140'Y'#151#175'N}'#145'9TX1@?2T@'#0#0#0#0#0#0#0#0 - +#0#0#0#0'28<1:<**(()(.3:!'#31#28'#'')n'#179#199#127#209#224#146#215#228'q' - +#199#218'm'#175#197'V'#159#185'k'#195#216'<\mNw'#134#133#205#221#132#206#221 - +'Z'#176#203'I'#132#161'9YoCew<TcLkz_|'#132'7CE0:@<b'#127'N'#140#172'R'#150 - +#185'G'#134#174'Aj'#143':c'#140'>n'#147':[u-38CE<^'#138#157'['#154#181'R'#141 - +#168'W'#144#169'=UX1AC4[O'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'4HH4F=594..,&%#''(+' - +'T'#149#174#140#214#226#158#218#228#129#209#224'K'#138#169'6WmN'#162#196'Y' - +#165#190'1<ET'#139#161'_'#178#206'E'#128#164'=_z9Rb:Vh<S`Vu'#127'_uu.1.3>@9V' - +'mI'#129#161'K'#144#178'Ap'#150'7U'#127';l'#158'@n'#150':Wq+13@C=l'#155#171 - +'Y'#155#185'c'#166#190'V'#154#180'Hq'#128').-6XT8ta'#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0'494261--++3:H'#144#177#147#214#226#150#215#227'u'#202#220'r'#188 - +#209'>g'#130'R'#161#192'b'#190#214'Y'#161#184'/=H:g'#144'G'#132#167'@`u?[eTq' - +'zm'#132#133'g|~JWT"!'#30';LM;YnEn'#138'H'#134#172'Aw'#161'8Y'#138'=o'#156'=' - +'o'#151'7Up5GP22,u'#152#160#157#202#210't'#180#200']'#165#191'Bp'#133'&(%3@<' - +'6^P'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'5C926/)((@y'#145#141#210#223 - +#141#213#224'`'#190#213'X'#167#196';r'#151'I'#160#192'h'#193#214'j'#195#216 - +'['#174#204':m'#154'E'#132#169'Dhzb|'#130'PYX+-/$$('#30#28#25#27#25#24'>PR@`' - +'w<`'#127'Cv'#154'Bq'#155'8V'#129';^'#133'Al'#148'6Pi3EL'#28#26#23'375[jk' - +#156#186#191#147#200#210'T'#141#160'(+)3?92MB'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0'7LA3:45NYt'#194#211'w'#202#219'^'#188#212'F'#145#183'2VuC' - +#128#157']'#185#210'U'#179#208'L'#164#202'.Ea8XyRq'#127'KTP(''0,0W.3i)*5!!' - +#31'D`g?^r:XvEp'#143'Fv'#160'5Kt9X'#132';]'#132'3CT1<<!'#31' &%''''(-144x' - +#150#154'Ls~-0-7?8/C<2OB'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'9]Q6K@14' - +'1M'#133#153'_'#177#202'R'#173#203'Z'#174#203'D}'#161'9e'#139'E'#137#170'O' - +#168#202'A'#141#185'<{'#169'2RwBXd%&#))5,-8''*9''&),33@W`7L]9Uv<['#127'?g' - +#142'4Fm7Y'#139';a'#142'4CT4><&'''')''&&%('#31#30#27'85.;E@2<;381-:5/F='#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'5QJ3E>6R[_'#179#203'U'#176#204 - +'X'#175#203'5^'#129'9l'#143';'#127#170'D'#147#189';~'#171'8k'#147'6\}8Sg>T]-' - +'57)*(*,-@Sb8Ng:Om4Hc9Pp9\'#134';Tu1=Y7_'#150'7['#146'9W'#128'8K_0:@*,,&%$#&' - +'%5?A6GH3>>-2.,41/?<'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +'3UO3JGE}'#144'W'#170#199'9'#129#176'4]'#132'6Y{6g'#148'7m'#158'9w'#165'7e' - +#143'9e'#140':a'#132'Ag'#130'Eh'#127'9EM@Td@k'#141'5Q}7W'#132';Z'#133'5Ji7Lf' - +'3F^+2B8['#139':g'#154'8Z'#137'>e'#138'6H^7CGCPRZy'#132'Nkp:KM5=<))&+3/.=8'#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'3YQ6X[Y'#166#189 - +'@'#132#170'5\'#130'0If5Su6W'#129'6_'#140'8h'#148'9i'#149'9f'#144'?y'#162'E' - +#129#165'Bq'#143'G{'#157'A|'#165'6U'#128'<i'#153'7X'#133'8Nm6I^1:E,1<4Jk9Y' - +#134':\'#137'8Ts5J^:S`?U]E^e:II3=<473##'#30'(-(0<5'#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'5a_Bz'#140'G'#144#179'8p'#149':z' - +#164':l'#147'<j'#145'8V}6g'#149'>|'#168'='#129#178'B'#136#181'K'#156#193'W' - +#166#194'X'#164#193'C'#128#170'5Lh>{'#170'9b'#143'5Gf/:F1;?*,24F^5Ji9Xy9Ph/9' - +'C9Q]=V_:KK2>:5;5,.)%#'#31',51'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0'5edH'#146#162'Q'#157#185'8j'#143'5f'#141'9s'#156 - +';r'#154'2Lt6Z'#135';u'#164'A'#142#188'D'#146#190'J'#156#196'K'#157#195'O' - +#156#192'B'#132#176'6PrB'#129#177'F|'#164'4Hd5GU/;@(,/7IV9P]5FW8LU07:7JN5FI3' - +'?>042,-**)%%$ .=8'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0'?rxW'#164#184'O'#164#193'=~'#166'7g'#144'9o'#149'8c'#134'3Kk5' - +'Qu7c'#146'B'#145#188'I'#165#201'M'#166#201'B'#138#183'J'#151#191'?z'#171'=i' - +#149'E|'#165'8Zv4EU,36-39/5=8IP08;4=@5AC0:<7CD5BA-..)(%*+''(&"+/+0C<'#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'3KL<muQ'#161#184 - +'N'#160#189'C'#142#178'8m'#151'7['#127'5Rq8Y{1>S4Nq=|'#166'O'#168#202'E'#135 - +#171'D'#131#172'E'#132#175'C'#135#179'Cz'#160':[z3@L:P`(.11>R,1:4?A*--1;>-0/' - +'1878FF/98**)''%!&$ ++%0:12J='#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0'7]`Y'#162#180'H'#148#178'8v'#154'3X{4Vy4Tw5Ok3L_3H[0;J/' - +'=T?v'#155',4A/;JCx'#155'8Vq&)+>YnAb{5HT/8C4Ff7Lc&*,0:B?ay-47:KS4AF-33*+*)($' - +')(#,,''2?52NA'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0'U'#145#155'i'#184#203'C'#141#175'2Ni/=S4Qm<f'#135'4Oh-49.6:2<A,3;0?P:]' - +#128';Z{:[v:Wk2?J@c~6K[)06/:F.:K1AP%(+Eu'#146'Bn'#138'-5:4@J089/89)+(-,(,*$3' - +'716G>3LA'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +'J'#127#138'U'#167#195'I'#138#173'1<F9Q]P'#146#175'R'#152#181'9Xl+8B9Q_)-1.4' - +'87Rh7[w,:E$''(''.5-;G1AL)01/9A()-,2;(2=>s'#150'Bz'#150'6Oe2CP+./6IP5@B11-%#' - +#30'**&9D;4MB'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0'R}'#132'q'#186#207'Ru'#131'./...*5JRE~'#148'Y'#160#186'E}'#154'9S' - +'c4BD19:+5;3IZ.8C<e~?z'#158'8Xo&()*3;/;E*.2.6B2CU4Rj0=I7[x6Vi4BG0;?//++*&4;<' - ,'ANH4J<4RC'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0'Qwz'#132#195#211'f'#154#175'Ny'#143'9JT-.--56Ns}=U^""'#31#29#27#24'#$' - +'#!!'#31'"&(1J]4Sm:l'#147'7`'#132'0AS1<I.6B%&+-8J+5A,8E:c'#134'7Wm2AI$$!894@' - +'MNKjsFba4KA5P>'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0'+63c'#145#156#143#196#209'f'#156#177'O'#132#157'Dbp>JJ994' - +'<LE-:1+3-'#26#25#23#26#24#23#26#24#22#27#26#24'(295Vs6Vs4J_.;H-5;.:I0>N0?P7' - +'Tl2HV"#!&*$5A9@_PCq`>iX2K>1J@'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'0EBi'#149#150'k'#169#186'\'#154 - +#175'Hm{CPJ4@73I>3RB4L>(/'')4,"''$!"'#31'&''%"$"$%&''-0+38),)''*((**(+**-+*0' - +'*0@82J=0G43O;'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'/@:?bcP{~Fec2?2.;' - +'/'#0#0#0#0#0#0#0#0#0#0#0#0'8SJ4NI4GC1C=1E;0@4.7.3I?3L>0>/.6*.7,+4*'#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 - +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#127#255#0#0#0 - +#0#0#0#127#255#0#0#0#0#0#0#127#255#0#0#0#0#0#0'?'#255#0#0#0#0#0#0'?'#255#0#0 - +#0#0#0#0#31#255#0#0#0#0#0#0#15#255#0#0#0#0#0#0#7#255#0#0#0#0#0#0#7#255#0#0#0 - +#0#0#0#3#255#0#0#0#0#0#0#3#255#0#0#0#0#0#0#1#255#0#0#0#0#0#0#0#255#0#0#0#0#0 - +#0#0#127#0#0#0#0#0#0#0#127#0#0#0#0#0#0#0'?'#0#0#0#0#0#0#0'?'#0#0#0#0#0#0#0#31 - +#0#0#0#0#0#0#0#31#0#0#0#0#0#0#0#31#0#0#0#0#0#0#0#15#0#0#0#0#0#0#0#15#0#0#0#0 - +#0#0#0#15#0#0#0#0#0#0#0#15#0#0#128#0#0#0#0#7#0#0#224#0#0#0#0#7#0#0#240#0#0#0 - +#0#7#0#0#248#0#0#0#0#3#0#0#248#0#0#0#0#3#0#0#252#0#0#0#0#3#0#0#254#0#0#0#0#3 - +#0#0#255#0#0#0#0#3#0#0#255#128#0#0#0#7#0#0#255#128#0#0#0#7#0#0#255#128#0#0#0 - +#7#0#0#255#0#0#0#0#7#0#0#255#0#0#0#0#7#0#0#255#0#0#0#0#7#0#0#255#0#0#0#0#15#0 - +#0#255#0#0#0#0#15#0#0#255#0#0#0#0#31#0#0#255#0#0#0#0'?'#0#0#255#128#0#0#3#255 - +#0#0#255#192#240#0#127#255#0#0#255#255#255#255#255#255#0#0#255#255#255#255 - +#255#255#0#0#255#255#255#255#255#255#0#0#0#0#6'TLabel'#10'labImaging'#4'Left' - +#2#8#6'Height'#2' '#3'Top'#2'x'#5'Width'#3#16#1#9'Alignment'#7#8'taCenter'#8 - +'AutoSize'#8#7'Caption'#6#23'Vampyre Imaging Library'#10'Font.Color'#7#7'clB' - +'lack'#10'Font.Style'#11#6'fsBold'#0#11'ParentColor'#8#10'ParentFont'#8#0#0#6 - +'TLabel'#6'Label1'#4'Left'#2'p'#6'Height'#2'8'#3'Top'#3#208#0#5'Width'#3#136 - +#0#8'AutoSize'#8#7'Caption'#6#19'Lazarus Imager Demo'#10'Font.Color'#7#7'clB' - +'lack'#10'Font.Style'#11#6'fsBold'#0#11'ParentColor'#8#10'ParentFont'#8#8'Wo' - +'rdWrap'#9#0#0#6'TLabel'#8'ImLabel1'#4'Left'#2#8#6'Height'#2#18#3'Top'#3#176 - +#0#5'Width'#3#16#1#9'Alignment'#7#8'taCenter'#8'AutoSize'#8#7'Caption'#6'!ht' - +'tp://imaginglib.sourceforge.net'#10'Font.Color'#7#6'clBlue'#11'Font.Height' - +#2#13#6'Layout'#7#8'tlCenter'#11'ParentColor'#8#10'ParentFont'#8#11'OptimalF' - +'ill'#9#0#0#7'TBitBtn'#7'BitBtn1'#4'Left'#2'h'#6'Height'#2#30#3'Top'#3#24#1#5 - +'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#6'&Close'#4'Kind' - +#7#7'bkClose'#9'NumGlyphs'#2#0#8'TabOrder'#2#0#0#0#6'TLabel'#10'LabVersion'#4 - +'Left'#2#0#6'Height'#2' '#3'Top'#3#148#0#5'Width'#3#24#1#9'Alignment'#7#8'ta' - +'Center'#8'AutoSize'#8#7'Caption'#6#7'version'#10'Font.Color'#7#7'clBlack'#11 - +'ParentColor'#8#10'ParentFont'#8#0#0#0 -]); diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.pas b/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.pas deleted file mode 100644 index 128f3ef..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/aboutunit.pas +++ /dev/null @@ -1,50 +0,0 @@ -unit AboutUnit; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, - ExtCtrls, StdCtrls, Imaging, DemoUtils; - -type - - { TAboutForm } - - TAboutForm = class(TForm) - BitBtn1: TBitBtn; - Image: TImage; - Image2: TImage; - labImaging: TLabel; - ImLabel1: TLabel; - LabVersion: TLabel; - Label1: TLabel; - procedure FormShow(Sender: TObject); - private - { private declarations } - public - { public declarations } - end; - -var - AboutForm: TAboutForm; - -implementation - -{ TAboutForm } - -procedure TAboutForm.FormShow(Sender: TObject); -begin - LabVersion.Caption := 'version ' + Imaging.GetVersionStr; - if Image.Picture.Graphic = nil then - begin - Image.Picture.LoadFromFile(GetDataDir + PathDelim + 'LogoAlpha.png'); - end; -end; - -initialization - {$I aboutunit.lrs} - -end. - diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.ico b/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.ico deleted file mode 100644 index c886676..0000000 Binary files a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.ico and /dev/null differ diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lpi b/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lpi deleted file mode 100644 index 1aa15b7..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lpi +++ /dev/null @@ -1,291 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <SaveClosedFiles Value="False"/> - <LRSInOutputDirectory Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="LCL Imager"/> - <Scaled Value="True"/> - <ResourceType Value="res"/> - <UseXPManifest Value="True"/> - <XPManifest> - <TextDesc Value="LCL Imager Demo"/> - </XPManifest> - <Icon Value="0"/> - </General> - <VersionInfo> - <UseVersionInfo Value="True"/> - <MinorVersionNr Value="80"/> - <StringTable ProductVersion="0.0.0.0"/> - </VersionInfo> - <BuildModes Count="5"> - <Item1 Name="Debug" Default="True"/> - <Item2 Name="Release - Win64"> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\LCLImager"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects;..\..\..\Extras\Extensions\LibTiff\Compiled"/> - <OtherUnitFiles Value="$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS);$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType);..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\..\..\Extras\Extensions\LibTiff;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <CodeGeneration> - <SmartLinkUnit Value="True"/> - <TargetCPU Value="x86_64"/> - <TargetOS Value="win64"/> - <Optimizations> - <OptimizationLevel Value="3"/> - <VariablesInRegisters Value="True"/> - </Optimizations> - <SmallerCode Value="True"/> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - <StripSymbols Value="True"/> - </Debugging> - <LinkSmart Value="True"/> - <Options> - <Win32> - <GraphicApplication Value="True"/> - </Win32> - </Options> - </Linking> - <Other> - <Verbosity> - <ShoLineNum Value="True"/> - </Verbosity> - <CustomOptions Value="-dFULL_FEATURE_SET"/> - </Other> - </CompilerOptions> - </Item2> - <Item3 Name="Release - Linux"> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\LCLImager"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects;..\..\..\Extras\Extensions\LibTiff\Compiled"/> - <OtherUnitFiles Value="$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS);$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType);..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\..\..\Extras\Extensions\LibTiff;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <CodeGeneration> - <SmartLinkUnit Value="True"/> - <TargetCPU Value="x86_64"/> - <TargetOS Value="linux"/> - <Optimizations> - <OptimizationLevel Value="3"/> - <VariablesInRegisters Value="True"/> - </Optimizations> - <SmallerCode Value="True"/> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - <StripSymbols Value="True"/> - </Debugging> - <LinkSmart Value="True"/> - <Options> - <Win32> - <GraphicApplication Value="True"/> - </Win32> - </Options> - </Linking> - <Other> - <Verbosity> - <ShoLineNum Value="True"/> - </Verbosity> - <CustomOptions Value="-dFULL_FEATURE_SET"/> - </Other> - </CompilerOptions> - </Item3> - <Item4 Name="Release - Win32"> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\LCLImager"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects;..\..\..\Extras\Extensions\LibTiff\Compiled"/> - <OtherUnitFiles Value="$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS);$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType);..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\..\..\Extras\Extensions\LibTiff;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <CodeGeneration> - <SmartLinkUnit Value="True"/> - <Optimizations> - <OptimizationLevel Value="3"/> - <VariablesInRegisters Value="True"/> - </Optimizations> - <SmallerCode Value="True"/> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - <StripSymbols Value="True"/> - </Debugging> - <LinkSmart Value="True"/> - <Options> - <Win32> - <GraphicApplication Value="True"/> - </Win32> - </Options> - </Linking> - <Other> - <Verbosity> - <ShoLineNum Value="True"/> - </Verbosity> - <CustomOptions Value="-dFULL_FEATURE_SET"/> - </Other> - </CompilerOptions> - </Item4> - <Item5 Name="Release - OSX"> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\LCLImager"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects;..\..\..\Extras\Extensions\LibTiff\Compiled"/> - <OtherUnitFiles Value="$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS);$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType);..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\..\..\Extras\Extensions\LibTiff;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <CodeGeneration> - <SmartLinkUnit Value="True"/> - <TargetCPU Value="i386"/> - <TargetOS Value="darwin"/> - <Optimizations> - <OptimizationLevel Value="3"/> - <VariablesInRegisters Value="True"/> - </Optimizations> - <SmallerCode Value="True"/> - </CodeGeneration> - <Linking> - <Debugging> - <GenerateDebugInfo Value="False"/> - <StripSymbols Value="True"/> - </Debugging> - <LinkSmart Value="True"/> - <Options> - <Win32> - <GraphicApplication Value="True"/> - </Win32> - </Options> - </Linking> - <Other> - <Verbosity> - <ShoLineNum Value="True"/> - </Verbosity> - <CustomOptions Value="-dFULL_FEATURE_SET"/> - </Other> - </CompilerOptions> - </Item5> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> - </local> - </RunParams> - <RequiredPackages Count="1"> - <Item1> - <PackageName Value="LCL"/> - </Item1> - </RequiredPackages> - <Units Count="3"> - <Unit0> - <Filename Value="lclimager.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="LCLImager"/> - </Unit0> - <Unit1> - <Filename Value="mainunit.pas"/> - <IsPartOfProject Value="True"/> - <ComponentName Value="MainForm"/> - <HasResources Value="True"/> - <ResourceBaseClass Value="Form"/> - <UnitName Value="MainUnit"/> - </Unit1> - <Unit2> - <Filename Value="aboutunit.pas"/> - <IsPartOfProject Value="True"/> - <ComponentName Value="AboutForm"/> - <HasResources Value="True"/> - <ResourceBaseClass Value="Form"/> - <UnitName Value="AboutUnit"/> - </Unit2> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\LCLImager"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects;..\..\..\Extras\Extensions\LibTiff\Compiled"/> - <OtherUnitFiles Value="$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS);$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType);..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\..\..\Extras\Extensions\LibTiff;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <IncludeAssertionCode Value="True"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <Checks> - <IOChecks Value="True"/> - <RangeChecks Value="True"/> - <OverflowChecks Value="True"/> - <StackChecks Value="True"/> - </Checks> - <VerifyObjMethodCallValidity Value="True"/> - <Optimizations> - <VariablesInRegisters Value="True"/> - </Optimizations> - <SmallerCode Value="True"/> - </CodeGeneration> - <Linking> - <Debugging> - <DebugInfoType Value="dsDwarf2Set"/> - <UseHeaptrc Value="True"/> - <TrashVariables Value="True"/> - <StripSymbols Value="True"/> - <UseExternalDbgSyms Value="True"/> - </Debugging> - <Options> - <Win32> - <GraphicApplication Value="True"/> - </Win32> - </Options> - </Linking> - <Other> - <Verbosity> - <ShoLineNum Value="True"/> - </Verbosity> - <CustomOptions Value="-dFULL_FEATURE_SET"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lpr b/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lpr deleted file mode 100644 index dfbb708..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lpr +++ /dev/null @@ -1,21 +0,0 @@ -program LCLImager; - -{$mode objfpc}{$H+} - -uses - Interfaces, // this includes the LCL widgetset - Forms - { add your units here }, - MainUnit, AboutUnit; - -{$R *.res} - -begin - Application.Scaled:=True; - Application.Title := 'LCL Imager'; - Application.Initialize; - Application.CreateForm(TMainForm, MainForm); - Application.CreateForm(TAboutForm, AboutForm); - Application.Run; -end. - diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lps b/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lps deleted file mode 100644 index 2992d98..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lps +++ /dev/null @@ -1,42 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectSession> - <PathDelim Value="\"/> - <Version Value="11"/> - <BuildModes Active="Debug"/> - <Units Count="3"> - <Unit0> - <Filename Value="lclimager.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="LCLImager"/> - <UsageCount Value="20"/> - </Unit0> - <Unit1> - <Filename Value="mainunit.pas"/> - <IsPartOfProject Value="True"/> - <ComponentName Value="MainForm"/> - <HasResources Value="True"/> - <ResourceBaseClass Value="Form"/> - <UnitName Value="MainUnit"/> - <IsVisibleTab Value="True"/> - <UsageCount Value="20"/> - <Loaded Value="True"/> - <LoadedDesigner Value="True"/> - </Unit1> - <Unit2> - <Filename Value="aboutunit.pas"/> - <IsPartOfProject Value="True"/> - <ComponentName Value="AboutForm"/> - <HasResources Value="True"/> - <ResourceBaseClass Value="Form"/> - <UnitName Value="AboutUnit"/> - <UsageCount Value="20"/> - </Unit2> - </Units> - <JumpHistory HistoryIndex="-1"/> - <RunParams> - <FormatVersion Value="2"/> - <Modes Count="0" ActiveMode="default"/> - </RunParams> - </ProjectSession> -</CONFIG> diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lrs b/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lrs deleted file mode 100644 index f54136a..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.lrs +++ /dev/null @@ -1,167 +0,0 @@ -LazarusResources.Add('MAINICON','ICO',[ - #0#0#1#0#1#0' '#0#0#1#0#24#0#168#12#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1 - +#0#24#0#0#0#0#0#0#12#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#251#252#251#251#252#251#251 - +#252#251#250#252#251#250#252#250#249#252#250#249#252#249#248#252#249#248#252 - +#250#249#252#251#250#252#251#251#252#251#251#252#251#251#252#251#251#252#251 - +#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#251#251#252#251#251#252#250 - +#250#252#249#248#252#246#244#252#241#240#252#237#236#252#234#233#252#234#233 - +#252#237#236#252#242#241#251#247#245#251#249#249#251#250#250#251#251#251#251 - +#251#251#251#251#251#251#251#251#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#251#251#252#251#251#252#251#250#252 - +#249#249#252#241#241#252#227#227#252#212#212#252#202#201#252#196#196#252#196 - +#195#252#203#202#252#213#213#251#226#226#251#238#237#251#246#245#251#249#249 - +#251#250#250#251#251#251#251#251#251#251#251#251#251#252#251#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#251#251#252#251#251#252#251#250#252#250#250 - +#252#242#242#252#223#222#252#196#195#252#174#172#252#162#161#252#159#158#252 - +#162#160#252#167#165#252#175#175#251#189#188#251#205#205#251#223#223#251#238 - +#238#251#247#247#251#250#250#251#251#250#251#251#251#251#251#251#252#251#251 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#251#251#252#251#251#252#250#250#252#244 - +#242#252#224#218#252#191#181#252#158#146#252#140#127#252#137'{'#252#140#128 - +#252#147#135#252#151#140#252#157#149#251#166#162#251#175#174#251#188#188#251 - +#209#208#251#230#230#250#244#244#250#249#249#251#250#250#251#251#251#251#251 - +#251#251#251#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#251#251#252#250#250#252#244#242#252 - +#219#207#252#175#149#252#139'f'#252'vK'#252'nA'#252'nB'#252'rG'#252'wM'#252 - +'yP'#252#128'^'#251#144'z'#251#159#150#251#168#165#251#179#178#251#198#198 - +#250#223#223#250#241#241#251#249#249#251#250#250#251#251#251#251#251#251#251 - +#252#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#251#251#252#249#248#252#230#222#252#171#140#252'|K'#252 - +'k5'#252'h2'#252'i3'#252'l6'#252'm7'#252'l6'#252'j3'#252'j5'#252'rB'#252#130 - +'_'#251#148#131#251#163#158#251#178#177#251#194#194#250#219#219#251#241#241 - +#250#249#249#251#250#250#251#251#251#251#251#251#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#251#251#252#248 - +#246#252#218#206#252#143'f'#252'm6'#252'r>'#251#127'S'#252#137'c'#252#147'n' - +#252#151'p'#252#140'a'#251'}L'#252'r>'#252'l4'#252'l7'#251'xL'#251#140'q'#251 - +#164#154#251#176#174#251#191#190#251#221#221#250#243#242#251#250#249#251#251 - +#251#251#251#251#252#252#251#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#251#251#252#248#246#252#220#207#252#146'j'#252 - +'yF'#252#157'{'#251#187#170#251#199#189#251#214#205#251#224#215#251#217#205 - +#251#196#175#251#170#139#252#138'_'#252'r>'#252'k4'#251'rB'#251#137'k'#251 - +#160#150#251#173#171#251#195#195#250#228#228#251#246#246#251#250#250#251#251 - +#251#252#251#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#251#251#252#249#248#252#231#223#252#172#142#252#143'f'#252 - +#196#177#251#227#222#251#231#230#251#238#238#251#246#245#251#247#246#251#242 - +#239#251#232#225#251#207#191#251#163#129#252'|K'#252'k5'#252'rB'#252#137'o' - +#251#162#156#251#178#177#251#208#208#251#238#238#251#249#249#251#251#251#252 - +#251#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#251#251#252#250#250#252#242#240#252#207#189#252#165#132#252#202#184 - +#251#239#234#251#244#243#251#247#246#251#249#249#251#251#251#251#250#250#251 - +#249#249#251#244#241#251#224#215#252#177#150#252'|L'#252'j4'#252'vK'#251#151 - +#137#251#169#167#251#190#190#251#227#226#251#247#246#252#250#250#252#251#251 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#251#251#252#251#250#252#249#248#252#234#227#252#198#177#252#202#184#251#239 - +#234#251#250#249#251#250#250#251#251#250#251#251#251#251#251#251#251#251#251 - +#251#250#250#251#247#246#252#225#215#252#164#130#252'q<'#252'n;'#252#139'p' - +#251#162#157#251#177#176#251#213#212#251#242#241#251#250#250#251#251#251#252 - +#252#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#251 - +#251#252#251#251#252#250#250#252#247#245#252#233#226#252#225#217#252#243#241 - +#252#250#250#252#251#251#252#251#251#252#251#251#252#251#251#252#251#251#252 - +#251#251#252#250#250#252#242#239#252#198#178#252'~M'#252'k5'#252#127'X'#252 - ,#155#145#252#167#166#252#201#200#251#235#235#251#249#249#251#251#251#252#251 - +#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#251#251#252#251#251#252#250#250#252#248#247#252#247#245#252#249#249#252 - +#251#251#252#251#251#252#252#251#252#252#251#252#252#251#252#252#251#252#251 - +#251#252#250#250#252#248#246#252#219#206#252#142'c'#252'm6'#252'wJ'#252#147 - +#132#252#162#160#252#194#194#251#231#230#251#248#248#251#251#251#251#251#251 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#251#252#251#251#252#251#251#252#251#251#252#251#251#252#251#251#252#251 - +#251#252#251#251#252#251#251#252#251#251#252#251#251#252#251#251#252#251#251 - +#252#251#251#252#249#248#252#229#220#252#157'x'#252'o9'#252'p?'#252#139't' - +#252#160#156#252#191#190#251#229#229#251#248#247#251#251#251#251#251#251#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#251#252#251#251#252#251#251#252#251#251#252#251#251#252#251#251 - +#252#251#251#252#251#250#252#251#250#252#251#250#252#251#250#252#251#250#252 - +#251#251#252#250#249#252#233#227#252#169#137#252'q<'#252'm9'#252#132'e'#252 - +#159#153#252#190#189#251#228#228#251#248#247#251#251#251#251#251#251#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#251#252#251#251#252 - +#251#251#252#250#249#252#247#245#252#245#243#252#247#246#252#250#249#252#251 - +#250#252#250#250#252#236#230#252#176#146#252't?'#252'm9'#252#132'b'#252#160 - +#153#252#190#190#251#228#228#251#248#247#251#251#251#251#251#251#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#251#251#252#251#251#252#251#250#252#250 - +#250#251#247#246#251#237#236#251#231#230#251#237#236#251#247#246#252#250#250 - +#252#251#250#252#239#234#252#183#156#252'wD'#252'n9'#252#132'b'#252#161#154 - +#252#191#190#251#228#228#251#247#247#251#251#251#251#251#251#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#251#251#252#251#251#252#250#249#252#247#245 - +#251#240#238#251#226#225#251#216#215#251#227#226#251#244#243#252#250#250#252 - +#251#250#252#241#237#252#193#170#252'{J'#252'n9'#252#132'a'#252#162#155#252 - +#191#191#251#228#227#251#247#247#251#251#251#251#251#251#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#251#251#252#250#250#252#243#239#252#223#213#251 - +#215#205#251#209#206#251#204#203#251#219#218#251#241#240#252#249#249#252#250 - +#250#252#243#240#252#201#182#252#127'O'#252'n8'#252#131'a'#252#160#153#252 - +#188#187#251#226#226#251#247#247#251#251#251#251#251#251#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#251#252#251#251#252#248#247#252#225#216#252#173#143#251 - +#162#133#251#182#173#251#189#188#251#210#209#251#235#234#252#247#246#251#249 - +#248#251#243#239#251#202#184#252#127'O'#252'n:'#252#133'd'#252#156#149#252 - +#180#179#251#223#223#250#246#246#251#251#251#251#251#251#251#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#251#252#251#251#252#247#245#252#214#200#252#146'j'#251 - +#133']'#251#162#147#251#175#173#251#193#192#251#218#217#252#233#232#251#239 - +#237#251#234#230#251#196#178#252#127'O'#252'p<'#252#135'j'#252#154#148#252 - +#176#175#251#221#221#250#246#246#251#251#251#251#251#251#251#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#251#252#251#251#252#245#243#252#209#193#252#138'_'#252 - +'}R'#252#157#140#252#165#162#252#169#168#252#186#185#252#201#200#251#208#207 - +#251#205#202#251#178#162#252'{N'#252'n='#252#135'n'#252#155#150#252#179#178 - +#251#221#221#250#245#245#251#251#251#251#251#251#251#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#251#252#251#251#252#244#241#252#203#185#252#132'V'#252'yL'#252 - +#154#136#252#160#156#252#152#151#252#156#155#252#163#162#252#167#165#252#165 - +#162#252#150#137#252'vL'#252'm='#252#133'o'#251#157#152#251#184#183#251#223 - +#222#251#245#244#251#251#251#251#251#251#251#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#251#252#251#251#252#245#242#252#205#188#252#131'U'#252'sA'#252#142'r' - +#252#153#140#252#148#139#252#145#139#252#144#138#252#142#133#252#138'}'#252 - +#130'l'#252'pD'#252'm='#252#141'u'#251#171#166#251#196#196#251#226#225#251 - +#244#244#251#251#251#251#251#251#251#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#251 - +#252#251#251#252#247#245#252#212#198#252#137']'#252'k3'#252'q@'#252'{R'#252 - +#127'\'#252#128'`'#252'}_'#252'wS'#252'qG'#252'm='#252'g2'#252'p<'#252#159 - ,#133#251#203#198#251#221#220#251#236#235#251#246#245#251#251#251#251#251#251 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#251#252#251#251#252#248#247#252#224 - +#214#252#157'y'#252'q='#252'i1'#252'j4'#252'k6'#252'l8'#252'l8'#252'k6'#252 - +'j3'#252'i1'#252'h0'#251'q<'#251#161#127#251#222#214#251#241#240#251#246#245 - +#251#249#249#251#251#251#251#251#251#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#251#251#252#250#249#252#239#235#252#200#180#252#156'w'#252#137'^' - +#252#135'['#252#134'Z'#252#134'['#252#135'['#252#136'\'#252#136'\'#252#135'Z' - +#252#131'T'#251#138'_'#251#174#144#251#229#221#251#247#246#251#250#250#251 - +#250#250#251#251#251#251#251#251#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#251#251#252#251#250#252#249#248#252#239#234#252#224#213#252#216#204#252 - +#215#202#252#214#201#252#214#201#252#215#201#252#215#202#251#216#203#251#215 - +#203#251#211#196#251#215#201#251#227#217#252#244#241#251#250#250#251#251#251 - +#251#251#251#251#251#251#252#251#251#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#251#251#252#251#251#252#251#251#252#250#250#252#249#247#252#248#246 - +#252#247#246#252#247#246#252#247#246#252#247#246#252#248#246#251#248#246#251 - +#248#246#251#247#245#251#247#246#251#249#248#252#251#250#252#251#251#252#251 - +#251#252#251#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#251#252#251#251#252#251#251#252#251#251#252#251#251#252#251 - +#251#252#251#251#252#251#251#252#251#251#252#251#251#252#251#251#251#251#251 - +#251#251#251#251#251#251#251#251#251#251#251#251#252#251#251#252#251#251#252 - +#251#251#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252#252 - +#248#0#7#255#248#0#1#255#240#0#0#127#224#0#0'?'#224#0#0#31#224#0#0#15#224#0#0 - +#15#224#0#0#7#224#0#0#7#224#0#0#7#224#0#0#7#224#0#0#3#224#0#0#3#240#0#0#3#240 - +#0#0#3#248#0#0#3#255#128#0#3#255#0#0#3#255#0#0#3#255#0#0#3#254#0#0#3#254#0#0 - +#3#254#0#0#3#254#0#0#3#254#0#0#3#254#0#0#3#254#0#0#3#255#0#0#3#255#0#0#3#255 - +#0#0#15#255#0#0#31#255#255#255#255 -]); - diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.manifest b/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.manifest deleted file mode 100644 index 07fb624..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.manifest +++ /dev/null @@ -1,17 +0,0 @@ -<?xml version="1.0" encoding="UTF-8" standalone="yes"?> -<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> - <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/> - <description>Your application description here.</description> - <dependency> - <dependentAssembly> - <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/> - </dependentAssembly> - </dependency> - <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> - <security> - <requestedPrivileges> - <requestedExecutionLevel level="asInvoker" uiAccess="false"/> - </requestedPrivileges> - </security> - </trustInfo> -</assembly> \ No newline at end of file diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.res b/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.res deleted file mode 100644 index c188852..0000000 Binary files a/components/vampireimaging/Demos/ObjectPascal/LCLImager/lclimager.res and /dev/null differ diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/mainunit.lfm b/components/vampireimaging/Demos/ObjectPascal/LCLImager/mainunit.lfm deleted file mode 100644 index dea5e8f..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/mainunit.lfm +++ /dev/null @@ -1,579 +0,0 @@ -object MainForm: TMainForm - Left = 427 - Height = 680 - Top = 226 - Width = 997 - AllowDropFiles = True - Caption = 'LCL Imager (Vampyre Imaging Library Demo)' - ClientHeight = 660 - ClientWidth = 997 - Constraints.MinHeight = 240 - Constraints.MinWidth = 320 - Icon.Data = { - BE0800000000010001002020000100000000A808000016000000280000002000 - 0000400000000100080000000000800400000000000000000000000000000000 - 000000000000000080000080000000808000800000008000800080800000C0C0 - C000C0DCC000F0CAA6000020400000206000002080000020A0000020C0000020 - E00000400000004020000040400000406000004080000040A0000040C0000040 - E00000600000006020000060400000606000006080000060A0000060C0000060 - E00000800000008020000080400000806000008080000080A0000080C0000080 - E00000A0000000A0200000A0400000A0600000A0800000A0A00000A0C00000A0 - E00000C0000000C0200000C0400000C0600000C0800000C0A00000C0C00000C0 - E00000E0000000E0200000E0400000E0600000E0800000E0A00000E0C00000E0 - E00040000000400020004000400040006000400080004000A0004000C0004000 - E00040200000402020004020400040206000402080004020A0004020C0004020 - E00040400000404020004040400040406000404080004040A0004040C0004040 - E00040600000406020004060400040606000406080004060A0004060C0004060 - E00040800000408020004080400040806000408080004080A0004080C0004080 - E00040A0000040A0200040A0400040A0600040A0800040A0A00040A0C00040A0 - E00040C0000040C0200040C0400040C0600040C0800040C0A00040C0C00040C0 - E00040E0000040E0200040E0400040E0600040E0800040E0A00040E0C00040E0 - E00080000000800020008000400080006000800080008000A0008000C0008000 - E00080200000802020008020400080206000802080008020A0008020C0008020 - E00080400000804020008040400080406000804080008040A0008040C0008040 - E00080600000806020008060400080606000806080008060A0008060C0008060 - E00080800000808020008080400080806000808080008080A0008080C0008080 - E00080A0000080A0200080A0400080A0600080A0800080A0A00080A0C00080A0 - E00080C0000080C0200080C0400080C0600080C0800080C0A00080C0C00080C0 - E00080E0000080E0200080E0400080E0600080E0800080E0A00080E0C00080E0 - E000C0000000C0002000C0004000C0006000C0008000C000A000C000C000C000 - E000C0200000C0202000C0204000C0206000C0208000C020A000C020C000C020 - E000C0400000C0402000C0404000C0406000C0408000C040A000C040C000C040 - E000C0600000C0602000C0604000C0606000C0608000C060A000C060C000C060 - E000C0800000C0802000C0804000C0806000C0808000C080A000C080C000C080 - E000C0A00000C0A02000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0 - E000C0C00000C0C02000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0 - A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF - FF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFFFFFFFF6F6F6F6F6F6F6F6FFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFFFFFF6F6F6EFEFEFEFF6F6F6F6FFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFFFF6F6EFEFEFAFEFEFEFEFEFF6F6F6FFFFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFF6F6EFAFA7A7A7A7A7AFEFEFEFF6F6F6FFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFF6F6EF9F97979797979F9FA7AFEFEFEFF6F6FFFFFFFFFFFFFF - FFFFFFFFFFFFFFF6E7979797979797979797979FA7EFEFEFF6F6FFFFFFFFFFFF - FFFFFFFFFFFFFFF69F97979F9F9FA79F9797979797A7EFEFEFF6F6FFFFFFFFFF - FFFFFFFFFFFFFFF69F97A7EFEFF6F6F6EFE79F9797979FEFEFEFF6F6FFFFFFFF - FFFFFFFFFFFFFFF6E79FEFF6F6F6F6F6F6F6EFE79797979FEFEFF6F6FFFFFFFF - FFFFFFFFFFFFFFF6EFE7EFF6F6F6FFFFFFFFF6F6EF979797A7EFEFF6F6FFFFFF - FFFFFFFFFFFFFFFFF6EFEFF6FFFFFFFFFFFFFFF6F6E79797A7EFEFF6F6FFFFFF - FFFFFFFFFFFFFFFFF6F6F6F6FFFFFFFFFFFFFFFFF6EF97979FAFEFEFF6FFFFFF - FFFFFFFFFFFFFFFFFFFFF6FFFFFFFFFFFFFFFFFFFFF69F9797A7EFEFF6FFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6A79797A7EFEFF6FFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6E797979FEFEFF6FFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6F6F6FFFFFFF6EF97979FEFEFF6FFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFF6F6F6F6F6FFFFF6EF97979FEFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFF6F6F6F6F6F6FFFFF6EF97979FEFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFFFF6F6F6F6EFF6F6FFFFF6EF97979FEFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFFFF6E7E7EFEFF6F6F6FFF6EF97979FAFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFF6F69F9FEFEFEFF6F6F6F6EF97979FAFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFF6EF9F9FA7EFEFEFEFF6EFEF97979FAFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFF6EF9F97A7EFAFAFEFEFEFA797979FAFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFF6EF9F97A7A7A7A7A7A7A79F9797A7EFEFF6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFF6EF9F97979F9F9F9F9F97979797A7EFF6F6F6FFFF - FFFFFFFFFFFFFFFFFFFFFFFFF6A79797979797979797979797E7F6F6F6FFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFF6EFA79F9F9F9F9F9F9F9F9F9FEFF6F6FFFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFF6F6F6F6F6F6F6F6F6F6EFF6F6F6FFFFFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6F6F6F6FFFFFFF6F6FFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000 - } - Menu = MainMenu - OnCreate = FormCreate - OnDestroy = FormDestroy - OnDropFiles = FormDropFiles - OnShow = FormShow - Position = poScreenCenter - LCLVersion = '1.8.0.6' - Visible = True - object StatusBar: TStatusBar - Left = 0 - Height = 23 - Top = 637 - Width = 997 - Panels = <> - end - object PairSplitter: TPairSplitter - Left = 0 - Height = 637 - Top = 0 - Width = 997 - Align = alClient - Position = 180 - object PairSplitterSideLeft: TPairSplitterSide - Cursor = crArrow - Left = 0 - Height = 637 - Top = 0 - Width = 180 - ClientWidth = 180 - ClientHeight = 637 - object TreeImage: TTreeView - Left = 0 - Height = 637 - Top = 0 - Width = 180 - Align = alClient - AutoExpand = True - HotTrack = True - ParentShowHint = False - ReadOnly = True - RightClickSelect = True - ShowHint = True - TabOrder = 0 - OnSelectionChanged = TreeImageSelectionChanged - Options = [tvoAutoExpand, tvoAutoItemHeight, tvoHideSelection, tvoHotTrack, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] - end - end - object PairSplitterSideRight: TPairSplitterSide - Cursor = crArrow - Left = 185 - Height = 637 - Top = 0 - Width = 812 - ClientWidth = 812 - ClientHeight = 637 - object Image: TImage - Cursor = crHandPoint - Left = 4 - Height = 637 - Top = 0 - Width = 804 - Align = alClient - AutoSize = True - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - Center = True - OnClick = ImageClick - Proportional = True - Stretch = True - end - end - end - object MainMenu: TMainMenu - left = 112 - top = 40 - object MenuItem1: TMenuItem - Caption = 'File' - object MenuItem3: TMenuItem - Caption = 'Open' - ShortCut = 16463 - OnClick = MenuItem3Click - end - object MenuItem44: TMenuItem - Caption = 'Reload' - ShortCut = 16466 - OnClick = MenuItem44Click - end - object MenuItem5: TMenuItem - Caption = 'Save As ...' - ShortCut = 16467 - OnClick = MenuItem5Click - end - object MenuItem25: TMenuItem - Caption = '-' - end - object MenuItem7: TMenuItem - Caption = 'Exit' - OnClick = MenuItem7Click - end - end - object MenuItem6: TMenuItem - Caption = 'View' - object MenuItem11: TMenuItem - Action = ActViewInfo - ShortCut = 16457 - OnClick = ActViewInfoExecute - end - object MenuItem86: TMenuItem - Caption = 'Show Metadata' - ShortCut = 16461 - OnClick = MenuItem86Click - end - object MenuItem87: TMenuItem - Caption = '-' - end - object MenuItem16: TMenuItem - Action = ActViewFitToWindow - Checked = True - OnClick = ActViewFitToWindowExecute - end - object MenuItem17: TMenuItem - Action = ActViewRealSize - OnClick = ActViewRealSizeExecute - end - object MenuItem32: TMenuItem - Caption = '-' - end - object MenuItemActSubImage: TMenuItem - Caption = 'Active Subimage:' - end - object MenuItem34: TMenuItem - Caption = 'Next Subimage' - ShortCut = 39 - OnClick = MenuItem34Click - end - object MenuItem35: TMenuItem - Caption = 'Previous Subimage' - ShortCut = 37 - OnClick = MenuItem35Click - end - end - object FormatItem: TMenuItem - Caption = 'Format' - object MenuItemConvertAll: TMenuItem - AutoCheck = True - Caption = 'Convert all subimages' - Checked = True - GlyphShowMode = gsmNever - end - end - object MenuItem8: TMenuItem - Caption = 'Manipulate' - object MenuItem2: TMenuItem - Caption = 'Flip' - OnClick = MenuItem2Click - end - object MenuItem4: TMenuItem - Caption = 'Mirror' - OnClick = MenuItem4Click - end - object MenuItem23: TMenuItem - Caption = 'Rotate 90 CW' - OnClick = MenuItem23Click - end - object MenuItem24: TMenuItem - Caption = 'Rotate 90 CCW' - OnClick = MenuItem24Click - end - object MenuItem80: TMenuItem - Caption = 'Free Rotate' - OnClick = MenuItem80Click - end - object MenuItem21: TMenuItem - Caption = 'Resize To 50%' - object MenuItem26: TMenuItem - Caption = 'Nearest' - OnClick = MenuItem26Click - end - object MenuItem27: TMenuItem - Caption = 'Bilinear' - OnClick = MenuItem27Click - end - object MenuItem28: TMenuItem - Caption = 'Bicubic' - OnClick = MenuItem28Click - end - object MenuItem88: TMenuItem - Caption = 'Lanczos' - OnClick = MenuItem88Click - end - end - object MenuItem22: TMenuItem - Caption = 'Resize To 200%' - object MenuItem29: TMenuItem - Caption = 'Nearest' - OnClick = MenuItem29Click - end - object MenuItem30: TMenuItem - Caption = 'Bilinear' - OnClick = MenuItem30Click - end - object MenuItem31: TMenuItem - Caption = 'Bicubic' - OnClick = MenuItem31Click - end - object MenuItem89: TMenuItem - Caption = 'Lanczos' - OnClick = MenuItem89Click - end - end - object MenuItem81: TMenuItem - Caption = 'Free Resize' - object MenuItem83: TMenuItem - Caption = 'Nearest' - OnClick = MenuItem83Click - end - object MenuItem84: TMenuItem - Caption = 'Bilinear' - OnClick = MenuItem84Click - end - object MenuItem85: TMenuItem - Caption = 'Bicubic' - OnClick = MenuItem85Click - end - object MenuItem90: TMenuItem - Caption = 'Lanczos' - OnClick = MenuItem90Click - end - end - object MenuItem12: TMenuItem - Caption = 'Swap Red <=> Blue' - OnClick = MenuItem12Click - end - object MenuItem13: TMenuItem - Caption = 'Swap Red <=> Green' - OnClick = MenuItem13Click - end - object MenuItem14: TMenuItem - Caption = 'Swap Green <=> Blue' - OnClick = MenuItem14Click - end - object MenuItem15: TMenuItem - Caption = 'Set Used Colors To 1024' - OnClick = MenuItem15Click - end - object MenuItem18: TMenuItem - Caption = 'Set Used Colors To 256' - OnClick = MenuItem18Click - end - object MenuItem19: TMenuItem - Caption = 'Set Used Colors To 64' - OnClick = MenuItem19Click - end - object MenuItem20: TMenuItem - Caption = 'Set Used Colors To 16' - OnClick = MenuItem20Click - end - object MenuItem33: TMenuItem - Caption = 'Set Used Colors To 2' - OnClick = MenuItem33Click - end - end - object MenuItem36: TMenuItem - Caption = 'Linear Filters' - object MenuItem37: TMenuItem - Caption = 'Gaussian Blur' - OnClick = MenuItem37Click - end - object MenuItem38: TMenuItem - Caption = 'Gaussian Blur More' - OnClick = MenuItem38Click - end - object MenuItem39: TMenuItem - Caption = 'Sharpen' - OnClick = MenuItem39Click - end - object MenuItem40: TMenuItem - Caption = 'Sharpen More' - OnClick = MenuItem40Click - end - object MenuItem41: TMenuItem - Caption = 'Edge Detect (LoG)' - OnClick = MenuItem41Click - end - object MenuItem42: TMenuItem - Caption = 'Edge Detect Horizontal' - object MenuItem49: TMenuItem - Caption = 'Sobel' - OnClick = MenuItem42Click - end - object MenuItem50: TMenuItem - Caption = 'Prewitt' - OnClick = MenuItem50Click - end - object MenuItem51: TMenuItem - Caption = 'Kirsh' - OnClick = MenuItem51Click - end - end - object MenuItem43: TMenuItem - Caption = 'Edge Detect Vertical' - object MenuItem52: TMenuItem - Caption = 'Sobel' - OnClick = MenuItem43Click - end - object MenuItem53: TMenuItem - Caption = 'Prewitt' - OnClick = MenuItem53Click - end - object MenuItem54: TMenuItem - Caption = 'Kirsh' - OnClick = MenuItem54Click - end - end - object MenuItem48: TMenuItem - Caption = 'Edge Enhance' - OnClick = MenuItem48Click - end - object MenuItem46: TMenuItem - Caption = 'Emboss' - OnClick = MenuItem46Click - end - object MenuItem45: TMenuItem - Caption = 'Glow' - OnClick = MenuItem45Click - end - end - object MenuItem63: TMenuItem - Caption = 'Nonlinear Filters' - object MenuItem64: TMenuItem - Caption = 'Median 3x3' - OnClick = MenuItem64Click - end - object MenuItem65: TMenuItem - Caption = 'Median 5x5' - OnClick = MenuItem65Click - end - object MenuItem66: TMenuItem - Caption = 'Min 3x3' - OnClick = MenuItem66Click - end - object MenuItem67: TMenuItem - Caption = 'Min 5x5' - OnClick = MenuItem67Click - end - object MenuItem68: TMenuItem - Caption = 'Max 3x3' - OnClick = MenuItem68Click - end - object MenuItem69: TMenuItem - Caption = 'Max 5x5' - OnClick = MenuItem69Click - end - end - object MenuItem55: TMenuItem - Caption = 'Point Transforms' - object MenuItem56: TMenuItem - Caption = 'Invert Colors' - OnClick = MenuItem56Click - end - object MenuItem47: TMenuItem - Caption = '+ Contrast' - OnClick = MenuItem47Click - end - object MenuItem57: TMenuItem - Caption = '- Contrast' - OnClick = MenuItem57Click - end - object MenuItem58: TMenuItem - Caption = '+ Brightness' - OnClick = MenuItem58Click - end - object MenuItem59: TMenuItem - Caption = '- Brightness' - OnClick = MenuItem59Click - end - object MenuItem60: TMenuItem - Caption = '+ Gamma' - OnClick = MenuItem60Click - end - object MenuItem61: TMenuItem - Caption = '- Gamma' - OnClick = MenuItem61Click - end - object MenuItem62: TMenuItem - Caption = 'RGB Tresholding' - OnClick = MenuItem62Click - end - object MenuItem75: TMenuItem - Caption = 'Levels (B:0.0;W:0.5;M:1.0)' - OnClick = MenuItem75Click - end - object MenuItem76: TMenuItem - Caption = 'Levels (B:0.35;W:1.0;M:0.9)' - OnClick = MenuItem76Click - end - object MenuItem78: TMenuItem - Caption = 'Premultiply Alpha' - OnClick = MenuItem78Click - end - object MenuItem79: TMenuItem - Caption = 'UnPremultiply Alpha' - OnClick = MenuItem79Click - end - end - object MenuItem77: TMenuItem - Caption = 'Colors' - object AlphaItem: TMenuItem - Caption = 'Alpha' - end - object RedItem: TMenuItem - Caption = 'Red' - end - object GreenItem: TMenuItem - Caption = 'Green' - end - object BlueItem: TMenuItem - Caption = 'Blue' - end - object MenuItem82: TMenuItem - Caption = 'Show Histograms' - OnClick = MenuItem82Click - end - end - object MIAdditional: TMenuItem - Caption = 'Additional Operations' - object MIMorphology: TMenuItem - Caption = 'Binary Morphology' - object MenuItem71: TMenuItem - Caption = 'Erode' - OnClick = MenuItem71Click - end - object MenuItem72: TMenuItem - Caption = 'Dilate' - OnClick = MenuItem72Click - end - object MenuItem73: TMenuItem - Caption = 'Open' - OnClick = MenuItem73Click - end - object MenuItem74: TMenuItem - Caption = 'Close' - OnClick = MenuItem74Click - end - end - object MenuItem70: TMenuItem - Caption = 'Otsu Thresholding' - OnClick = MenuItem70Click - end - object MenuItem91: TMenuItem - Caption = 'Deskewing (for text)' - OnClick = MenuItem91Click - end - end - object MenuItem9: TMenuItem - Caption = 'Help' - object MenuItem10: TMenuItem - Caption = 'About' - OnClick = MenuItem10Click - end - end - end - object OpenDialog: TOpenPictureDialog - Filter = 'Graphic (*.dds;*.tga;*.png;*.jpe;*.jfif;*.jif;*.jpeg;*.jpg;*.dib;*.bmp;*.ico;*.ppm;*.pgm;*.pbm;*.png;*.xpm;*.bmp)|*.dds;*.tga;*.png;*.jpe;*.jfif;*.jif;*.jpeg;*.jpg;*.dib;*.bmp;*.ico;*.ppm;*.pgm;*.pbm;*.png;*.xpm;*.bmp|DirectDraw Surface (*.dds)|*.dds|True' - FilterIndex = 0 - Options = [ofFileMustExist, ofEnableSizing, ofViewDetail, ofAutoPreview] - left = 232 - top = 104 - end - object ActionList: TActionList - left = 112 - top = 104 - object ActViewFitToWindow: TAction - Caption = 'Fit To Window' - OnExecute = ActViewFitToWindowExecute - end - object ActViewRealSize: TAction - Caption = 'Real Size' - Checked = True - OnExecute = ActViewRealSizeExecute - end - object ActViewInfo: TAction - Caption = 'Image Info' - OnExecute = ActViewInfoExecute - end - end - object SaveDialog: TSavePictureDialog - DefaultExt = '.png' - Filter = 'Graphic (*.dds;*.tga;*.png;*.jpe;*.jfif;*.jif;*.jpeg;*.jpg;*.dib;*.bmp;*.ico;*.ppm;*.pgm;*.pbm;*.png;*.xpm;*.bmp)|*.dds;*.tga;*.png;*.jpe;*.jfif;*.jif;*.jpeg;*.jpg;*.dib;*.bmp;*.ico;*.ppm;*.pgm;*.pbm;*.png;*.xpm;*.bmp|DirectDraw Surface (*.dds)|*.dds|True' - FilterIndex = 0 - Options = [ofOverwritePrompt, ofHideReadOnly, ofExtensionDifferent, ofPathMustExist, ofEnableSizing, ofViewDetail, ofAutoPreview] - left = 232 - top = 40 - end -end diff --git a/components/vampireimaging/Demos/ObjectPascal/LCLImager/mainunit.pas b/components/vampireimaging/Demos/ObjectPascal/LCLImager/mainunit.pas deleted file mode 100644 index 25e1be3..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/LCLImager/mainunit.pas +++ /dev/null @@ -1,1273 +0,0 @@ -{ - Vampyre Imaging Library Demo - LCL Imager (ObjectPascal, high level/component sets/canvas, Win32/Linux/BSD) - tested in Lazarus 0.9.30.2 (Windows: Win32; Linux: Gtk2, Qt; OSX: Carbon) - written by Marek Mauder - - Simple image manipulator program which shows usage of Imaging VCL/CLX/LCL - classes (TImagingGraphic and its descendants) to display images on form. - It also uses high level image classes and some low level functions. - Demo uses TMultiImage class to store images (loaded from one file - MNG, DDS) - which can be modified by user. After each modification image - is assigned to TImagingBitmap class which provides visualization - on the app form (using standard TImage component). Demo also uses new - TImagingCanvas class to do some effects. - - In File menu you can open new image and save the current one. Items in - View menu provide information about the current image and controls - how it is displayed. You can also select next and previous subimage if loaded file - contains more than one image. Format menu allows you to convert image - to different image data formats supported by Imaging. Manipulate - menu allows you to enlarge/shrink/flip/mirror/swap channels/other - of the current image. Effects menu allows you to apply various effects to the - image (provided by TImagingCanvas). -} - -unit MainUnit; - -{$I ImagingOptions.inc} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Variants, - Menus, ExtCtrls, ExtDlgs, DemoUtils, AboutUnit, ActnList, StdCtrls, ComCtrls, - PairSplitter, FileUtil, ImagingTypes, Imaging, ImagingClasses, ImagingComponents, - ImagingCanvases, ImagingBinary, ImagingUtility; - -type - TManipulationType = (mtFlip, mtMirror, mtRotate90CW, mtRotate90CCW, - mtFreeRotate, mtResize50, mtResize200, mtFreeResize, - mtSwapRB, mtSwapRG, mtSwapGB, mtReduce1024, - mtReduce256, mtReduce64, mtReduce16, mtReduce2); - TPointTransform = (ptInvert, ptIncContrast, ptDecContrast, ptIncBrightness, - ptDecBrightness, ptIncGamma, ptDecGamma, ptThreshold, ptLevelsLow, - ptLevelsHigh, ptAlphaPreMult, ptAlphaUnPreMult); - TNonLinearFilter = (nfMedian, nfMin, nfMax); - TMorphology = (mpErode, mpDilate, mpOpen, mpClose); - TAdditionalOp = (aoOtsuThreshold, aoDeskew); - - { TMainForm } - TMainForm = class(TForm) - ActViewInfo: TAction; - ActViewFitToWindow: TAction; - ActViewRealSize: TAction; - ActionList: TActionList; - Image: TImage; - MainMenu: TMainMenu; - MenuItem1: TMenuItem; - MenuItem10: TMenuItem; - MenuItem11: TMenuItem; - MenuItem12: TMenuItem; - MenuItem13: TMenuItem; - MenuItem14: TMenuItem; - MenuItem15: TMenuItem; - MenuItem16: TMenuItem; - MenuItem17: TMenuItem; - FormatItem: TMenuItem; - MenuItem18: TMenuItem; - MenuItem19: TMenuItem; - MenuItem2: TMenuItem; - MenuItem20: TMenuItem; - MenuItem21: TMenuItem; - MenuItem22: TMenuItem; - MenuItem23: TMenuItem; - MenuItem24: TMenuItem; - MenuItem25: TMenuItem; - MenuItem26: TMenuItem; - MenuItem27: TMenuItem; - MenuItem28: TMenuItem; - MenuItem29: TMenuItem; - MenuItem3: TMenuItem; - MenuItem30: TMenuItem; - MenuItem31: TMenuItem; - MenuItem32: TMenuItem; - MenuItem33: TMenuItem; - MenuItem36: TMenuItem; - MenuItem37: TMenuItem; - MenuItem38: TMenuItem; - MenuItem39: TMenuItem; - MenuItem40: TMenuItem; - MenuItem41: TMenuItem; - MenuItem42: TMenuItem; - MenuItem43: TMenuItem; - MenuItem44: TMenuItem; - MenuItem45: TMenuItem; - MenuItem46: TMenuItem; - MenuItem47: TMenuItem; - MenuItem48: TMenuItem; - MenuItem49: TMenuItem; - MenuItem50: TMenuItem; - MenuItem51: TMenuItem; - MenuItem52: TMenuItem; - MenuItem53: TMenuItem; - MenuItem54: TMenuItem; - MenuItem55: TMenuItem; - MenuItem56: TMenuItem; - MenuItem57: TMenuItem; - MenuItem58: TMenuItem; - MenuItem59: TMenuItem; - MenuItem60: TMenuItem; - MenuItem61: TMenuItem; - MenuItem62: TMenuItem; - MenuItem63: TMenuItem; - MenuItem64: TMenuItem; - MenuItem65: TMenuItem; - MenuItem66: TMenuItem; - MenuItem67: TMenuItem; - MenuItem68: TMenuItem; - MenuItem69: TMenuItem; - MenuItem70: TMenuItem; - MenuItem91: TMenuItem; - MIMorphology: TMenuItem; - MenuItem71: TMenuItem; - MenuItem72: TMenuItem; - MenuItem73: TMenuItem; - MenuItem74: TMenuItem; - MenuItem75: TMenuItem; - MenuItem76: TMenuItem; - MenuItem77: TMenuItem; - AlphaItem: TMenuItem; - MenuItem78: TMenuItem; - MenuItem79: TMenuItem; - MenuItem80: TMenuItem; - MenuItem81: TMenuItem; - MenuItem83: TMenuItem; - MenuItem84: TMenuItem; - MenuItem85: TMenuItem; - MenuItem86: TMenuItem; - MenuItem87: TMenuItem; - MenuItem88: TMenuItem; - MenuItem89: TMenuItem; - MenuItem90: TMenuItem; - MenuItemConvertAll: TMenuItem; - MIAdditional: TMenuItem; - PairSplitter: TPairSplitter; - PairSplitterSideLeft: TPairSplitterSide; - PairSplitterSideRight: TPairSplitterSide; - RedItem: TMenuItem; - GreenItem: TMenuItem; - BlueItem: TMenuItem; - MenuItem82: TMenuItem; - MenuItemActSubImage: TMenuItem; - MenuItem34: TMenuItem; - MenuItem35: TMenuItem; - MenuItem4: TMenuItem; - MenuItem5: TMenuItem; - MenuItem6: TMenuItem; - MenuItem7: TMenuItem; - MenuItem8: TMenuItem; - MenuItem9: TMenuItem; - OpenDialog: TOpenPictureDialog; - SaveDialog: TSavePictureDialog; - StatusBar: TStatusBar; - TreeImage: TTreeView; - procedure ActViewFitToWindowExecute(Sender: TObject); - procedure ActViewInfoExecute(Sender: TObject); - procedure ActViewRealSizeExecute(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure FormDropFiles(Sender: TObject; const FileNames: array of String); - procedure FormShow(Sender: TObject); - procedure ImageClick(Sender: TObject); - procedure MenuItem10Click(Sender: TObject); - procedure MenuItem12Click(Sender: TObject); - procedure MenuItem13Click(Sender: TObject); - procedure MenuItem14Click(Sender: TObject); - procedure MenuItem15Click(Sender: TObject); - procedure MenuItem18Click(Sender: TObject); - procedure MenuItem19Click(Sender: TObject); - procedure MenuItem20Click(Sender: TObject); - procedure MenuItem23Click(Sender: TObject); - procedure MenuItem24Click(Sender: TObject); - procedure MenuItem26Click(Sender: TObject); - procedure MenuItem27Click(Sender: TObject); - procedure MenuItem28Click(Sender: TObject); - procedure MenuItem29Click(Sender: TObject); - procedure MenuItem2Click(Sender: TObject); - procedure MenuItem30Click(Sender: TObject); - procedure MenuItem31Click(Sender: TObject); - procedure MenuItem33Click(Sender: TObject); - procedure MenuItem34Click(Sender: TObject); - procedure MenuItem35Click(Sender: TObject); - procedure MenuItem37Click(Sender: TObject); - procedure MenuItem38Click(Sender: TObject); - procedure MenuItem39Click(Sender: TObject); - procedure MenuItem3Click(Sender: TObject); - procedure MenuItem40Click(Sender: TObject); - procedure MenuItem41Click(Sender: TObject); - procedure MenuItem42Click(Sender: TObject); - procedure MenuItem43Click(Sender: TObject); - procedure MenuItem44Click(Sender: TObject); - procedure MenuItem45Click(Sender: TObject); - procedure MenuItem46Click(Sender: TObject); - procedure MenuItem47Click(Sender: TObject); - procedure MenuItem48Click(Sender: TObject); - procedure MenuItem4Click(Sender: TObject); - procedure MenuItem50Click(Sender: TObject); - procedure MenuItem51Click(Sender: TObject); - procedure MenuItem53Click(Sender: TObject); - procedure MenuItem54Click(Sender: TObject); - procedure MenuItem56Click(Sender: TObject); - procedure MenuItem57Click(Sender: TObject); - procedure MenuItem58Click(Sender: TObject); - procedure MenuItem59Click(Sender: TObject); - procedure MenuItem5Click(Sender: TObject); - procedure MenuItem60Click(Sender: TObject); - procedure MenuItem61Click(Sender: TObject); - procedure MenuItem62Click(Sender: TObject); - procedure MenuItem64Click(Sender: TObject); - procedure MenuItem65Click(Sender: TObject); - procedure MenuItem66Click(Sender: TObject); - procedure MenuItem67Click(Sender: TObject); - procedure MenuItem68Click(Sender: TObject); - procedure MenuItem69Click(Sender: TObject); - procedure MenuItem70Click(Sender: TObject); - procedure MenuItem71Click(Sender: TObject); - procedure MenuItem72Click(Sender: TObject); - procedure MenuItem73Click(Sender: TObject); - procedure MenuItem74Click(Sender: TObject); - procedure MenuItem75Click(Sender: TObject); - procedure MenuItem76Click(Sender: TObject); - procedure MenuItem78Click(Sender: TObject); - procedure MenuItem79Click(Sender: TObject); - procedure MenuItem7Click(Sender: TObject); - procedure FormatChangeClick(Sender: TObject); - procedure ChannelSetClick(Sender: TObject); - procedure MenuItem80Click(Sender: TObject); - procedure MenuItem82Click(Sender: TObject); - procedure MenuItem83Click(Sender: TObject); - procedure MenuItem84Click(Sender: TObject); - procedure MenuItem85Click(Sender: TObject); - procedure MenuItem86Click(Sender: TObject); - procedure MenuItem88Click(Sender: TObject); - procedure MenuItem89Click(Sender: TObject); - procedure MenuItem90Click(Sender: TObject); - procedure MenuItem91Click(Sender: TObject); - procedure TreeImageSelectionChanged(Sender: TObject); - private - FBitmap: TImagingBitmap; - FImage: TMultiImage; - FImageCanvas: TImagingCanvas; - FFileName: string; - FFileSize: Integer; - FParam1, FParam2, FParam3: Integer; - procedure OpenFile(const FileName: string); - procedure SaveFile(const FileName: string); - procedure SelectSubimage(Index: LongInt); - procedure UpdateView(RebuildTree: Boolean); - function CheckCanvasFormat: Boolean; - procedure ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean); - procedure ApplyPointTransform(Transform: TPointTransform); - procedure ApplyManipulation(ManipType: TManipulationType); - procedure ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer); - procedure ApplyMorphology(MorphOp: TMorphology); - procedure ApplyAdditionalOp(Op: TAdditionalOp); - procedure MeasureTime(const Msg: string; const OldTime: Int64); - procedure FreeResizeInput; - function InputInteger(const ACaption, APrompt: string; var Value: Integer): Boolean; - procedure BuildImageTree; - public - - end; - -const - SWindowTitle = 'LCL Imager - Vampyre Imaging Library %s Demo'; - -var - MainForm: TMainForm; - -implementation - -{$R *.lfm} - -{$IFDEF MSWINDOWS} -uses - Windows; -{$ENDIF} - -{ TMainForm } - -procedure TMainForm.FormCreate(Sender: TObject); -var - Item: TMenuItem; - Fmt: TImageFormat; - Info: TImageFormatInfo; - Platform: string; - - function Clone(AItem: TMenuItem): TMenuItem; - begin - Result := TMenuItem.Create(MainMenu); - Result.Caption := AItem.Caption; - Result.Tag := AItem.Tag; - Result.OnClick := AItem.OnClick;; - end; - - procedure AddSetChannelItem(const Caption: string; Value: Integer); - begin - Item := TMenuItem.Create(MainMenu); - Item.Caption := Caption; - Item.Tag := Value; - Item.OnClick := ChannelSetClick; - AlphaItem.Add(Item); - RedItem.Add(Clone(Item)); - GreenItem.Add(Clone(Item)); - BlueItem.Add(Clone(Item)); - end; - -begin - Platform := ''; -{$IF Defined(WIN64)} - Platform := ' - WIN64'; -{$ELSEIF Defined(WIN32)} - Platform := ' - WIN32'; -{$ELSEIF Defined(LINUX)} - Platform := ' - Linux'; -{$ELSEIF Defined(DARWIN)} - Platform := ' - OSX'; -{$ENDIF} - - Caption := Format(SWindowTitle, [Imaging.GetVersionStr]) + Platform; - - { Source image and Image's graphic are created and - default image is opened.} - FImage := TMultiImage.Create; - FBitmap := TImagingBitmap.Create; - Image.Picture.Graphic := FBitmap; - FImageCanvas := TImagingCanvas.Create; - - { This builds Format submenu containing all possible - image data formats (it dos not start at Low(TImageFormat) - because there are some helper formats). Format for each item - is stored in its Tag for later use in OnClick event.} - for Fmt := ifIndex8 to High(TImageFormat) do - begin - GetImageFormatInfo(Fmt, Info); - if Info.Name <> '' then - begin - Item := TMenuItem.Create(MainMenu); - Item.Caption := Info.Name; - Item.Tag := Ord(Fmt); - Item.OnClick := FormatChangeClick; - FormatItem.Add(Item); - end; - end; - - AddSetChannelItem('Set to 5%', 12); - AddSetChannelItem('Set to 50%', 128); - AddSetChannelItem('Set to 100%', 255); - - // Set 'Fit to window' mode - ActViewFitToWindowExecute(Self); - - if (ParamCount > 0) and FileExists(ParamStr(1)) then - OpenFile(ParamStr(1)) - else - OpenFile(GetDataDir + PathDelim + 'Tigers.jpg'); -end; - -procedure TMainForm.MenuItem10Click(Sender: TObject); -begin - AboutForm.ShowModal; -end; - -procedure TMainForm.MenuItem12Click(Sender: TObject); -begin - ApplyManipulation(mtSwapRB); -end; - -procedure TMainForm.MenuItem13Click(Sender: TObject); -begin - ApplyManipulation(mtSwapRG); -end; - -procedure TMainForm.MenuItem14Click(Sender: TObject); -begin - ApplyManipulation(mtSwapGB); -end; - -procedure TMainForm.MenuItem15Click(Sender: TObject); -begin - ApplyManipulation(mtReduce1024); -end; - -procedure TMainForm.MenuItem18Click(Sender: TObject); -begin - ApplyManipulation(mtReduce256); -end; - -procedure TMainForm.MenuItem19Click(Sender: TObject); -begin - ApplyManipulation(mtReduce64); -end; - -procedure TMainForm.MenuItem20Click(Sender: TObject); -begin - ApplyManipulation(mtReduce16); -end; - -procedure TMainForm.MenuItem4Click(Sender: TObject); -begin - ApplyManipulation(mtMirror); -end; - -procedure TMainForm.MenuItem23Click(Sender: TObject); -begin - ApplyManipulation(mtRotate90CW); -end; - -procedure TMainForm.MenuItem24Click(Sender: TObject); -begin - ApplyManipulation(mtRotate90CCW); -end; - -procedure TMainForm.MenuItem26Click(Sender: TObject); -begin - FParam1 := Ord(rfNearest); - ApplyManipulation(mtResize50); -end; - -procedure TMainForm.MenuItem27Click(Sender: TObject); -begin - FParam1 := Ord(rfBilinear); - ApplyManipulation(mtResize50); -end; - -procedure TMainForm.MenuItem28Click(Sender: TObject); -begin - FParam1 := Ord(rfBicubic); - ApplyManipulation(mtResize50); -end; - -procedure TMainForm.MenuItem29Click(Sender: TObject); -begin - FParam1 := Ord(rfNearest); - ApplyManipulation(mtResize200); -end; - -procedure TMainForm.MenuItem30Click(Sender: TObject); -begin - FParam1 := Ord(rfBilinear); - ApplyManipulation(mtResize200); -end; - -procedure TMainForm.MenuItem31Click(Sender: TObject); -begin - FParam1 := Ord(rfBicubic); - ApplyManipulation(mtResize200); -end; - -procedure TMainForm.MenuItem2Click(Sender: TObject); -begin - ApplyManipulation(mtFlip); -end; - -procedure TMainForm.MenuItem33Click(Sender: TObject); -begin - ApplyManipulation(mtReduce2); -end; - -procedure TMainForm.MenuItem37Click(Sender: TObject); -begin - ApplyConvolution(@FilterGaussian3x3, 3, False); -end; - -procedure TMainForm.MenuItem38Click(Sender: TObject); -begin - ApplyConvolution(@FilterGaussian5x5, 5, False); -end; - -procedure TMainForm.MenuItem39Click(Sender: TObject); -begin - ApplyConvolution(@FilterSharpen3x3, 3, False); -end; - -procedure TMainForm.MenuItem40Click(Sender: TObject); -begin - ApplyConvolution(@FilterSharpen5x5, 5, False); -end; - -procedure TMainForm.MenuItem41Click(Sender: TObject); -begin - ApplyConvolution(@FilterLaplace5x5, 5, True); -end; - -procedure TMainForm.MenuItem42Click(Sender: TObject); -begin - ApplyConvolution(@FilterSobelHorz3x3, 3, True); -end; - -procedure TMainForm.MenuItem43Click(Sender: TObject); -begin - ApplyConvolution(@FilterSobelVert3x3, 3, True); -end; - -procedure TMainForm.MenuItem44Click(Sender: TObject); -begin - OpenFile(FFileName); -end; - -procedure TMainForm.MenuItem45Click(Sender: TObject); -begin - ApplyConvolution(@FilterGlow5x5, 5, False); -end; - -procedure TMainForm.MenuItem46Click(Sender: TObject); -begin - ApplyConvolution(@FilterEmboss3x3, 3, True); -end; - -procedure TMainForm.MenuItem47Click(Sender: TObject); -begin - ApplyPointTransform(ptIncContrast); -end; - -procedure TMainForm.MenuItem48Click(Sender: TObject); -begin - ApplyConvolution(@FilterEdgeEnhance3x3, 3, False); -end; - -procedure TMainForm.MenuItem50Click(Sender: TObject); -begin - ApplyConvolution(@FilterPrewittHorz3x3, 3, True); -end; - -procedure TMainForm.MenuItem51Click(Sender: TObject); -begin - ApplyConvolution(@FilterKirshHorz3x3, 3, True); -end; - -procedure TMainForm.MenuItem53Click(Sender: TObject); -begin - ApplyConvolution(@FilterPrewittVert3x3, 3, True); -end; - -procedure TMainForm.MenuItem54Click(Sender: TObject); -begin - ApplyConvolution(@FilterKirshVert3x3, 3, True); -end; - -procedure TMainForm.MenuItem56Click(Sender: TObject); -begin - ApplyPointTransform(ptInvert); -end; - -procedure TMainForm.MenuItem57Click(Sender: TObject); -begin - ApplyPointTransform(ptDecContrast); -end; - -procedure TMainForm.MenuItem58Click(Sender: TObject); -begin - ApplyPointTransform(ptIncBrightness); -end; - -procedure TMainForm.MenuItem59Click(Sender: TObject); -begin - ApplyPointTransform(ptDecBrightness); -end; - -procedure TMainForm.MenuItem34Click(Sender: TObject); -begin - SelectSubimage(FImage.ActiveImage + 1); -end; - -procedure TMainForm.MenuItem35Click(Sender: TObject); -begin - SelectSubimage(FImage.ActiveImage - 1); -end; - -function TMainForm.CheckCanvasFormat: Boolean; -begin - Result := FImage.Format in FImageCanvas.GetSupportedFormats; - if not Result then - MessageDlg('Image is in format that is not supported by TImagingCanvas.', mtError, [mbOK], 0); -end; - -procedure TMainForm.ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean); -var - T: Int64; -begin - if CheckCanvasFormat then - begin - FImageCanvas.CreateForImage(FImage); - T := GetTimeMicroseconds; - - if NeedsBlur then - FImageCanvas.ApplyConvolution3x3(FilterGaussian3x3); - if Size = 3 then - FImageCanvas.ApplyConvolution3x3(TConvolutionFilter3x3(Kernel^)) - else - FImageCanvas.ApplyConvolution5x5(TConvolutionFilter5x5(Kernel^)); - - MeasureTime('Image convolved in:', T); - UpdateView(False); - end; -end; - -procedure TMainForm.ApplyPointTransform(Transform: TPointTransform); -var - T: Int64; -begin - if CheckCanvasFormat then - begin - FImageCanvas.CreateForImage(FImage); - T := GetTimeMicroseconds; - - case Transform of - ptInvert: FImageCanvas.InvertColors; - ptIncContrast: FImageCanvas.ModifyContrastBrightness(20, 0); - ptDecContrast: FImageCanvas.ModifyContrastBrightness(-20, 0); - ptIncBrightness: FImageCanvas.ModifyContrastBrightness(0, 20); - ptDecBrightness: FImageCanvas.ModifyContrastBrightness(0, -20); - ptIncGamma: FImageCanvas.GammaCorection(1.2, 1.2, 1.2); - ptDecGamma: FImageCanvas.GammaCorection(0.8, 0.8, 0.8); - ptThreshold: FImageCanvas.Threshold(0.5, 0.5, 0.5); - ptLevelsLow: FImageCanvas.AdjustColorLevels(0.0, 0.5, 1.0); - ptLevelsHigh: FImageCanvas.AdjustColorLevels(0.35, 1.0, 0.9); - ptAlphaPreMult: FImageCanvas.PremultiplyAlpha; - ptAlphaUnPreMult: FImageCanvas.UnPremultiplyAlpha; - end; - - MeasureTime('Point transform done in:', T); - UpdateView(False); - end; -end; - -procedure TMainForm.ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer); -var - T: Int64; -begin - if CheckCanvasFormat then - begin - FImageCanvas.CreateForImage(FImage); - T := GetTimeMicroseconds; - - case FilterType of - nfMedian: FImageCanvas.ApplyMedianFilter(FilterSize); - nfMin: FImageCanvas.ApplyMinFilter(FilterSize); - nfMax: FImageCanvas.ApplyMaxFilter(FilterSize); - end; - - MeasureTime('Point transform done in:', T); - UpdateView(False); - end; -end; - -procedure TMainForm.ApplyMorphology(MorphOp: TMorphology); -var - T: Int64; - Strel: TStructElement; -begin - T := GetTimeMicroseconds; - FImage.Format := ifGray8; - OtsuThresholding(FImage.ImageDataPointer^); - - SetLength(Strel, 3, 3); - Strel[0, 0] := 0; - Strel[1, 0] := 1; - Strel[2, 0] := 0; - Strel[0, 1] := 1; - Strel[1, 1] := 1; - Strel[2, 1] := 1; - Strel[0, 2] := 0; - Strel[1, 2] := 1; - Strel[2, 2] := 0; - - case MorphOp of - mpErode: Morphology(FImage.ImageDataPointer^, Strel, moErode); - mpDilate: Morphology(FImage.ImageDataPointer^, Strel, moDilate); - mpOpen: - begin - Morphology(FImage.ImageDataPointer^, Strel, moErode); - Morphology(FImage.ImageDataPointer^, Strel, moDilate); - end; - mpClose: - begin - Morphology(FImage.ImageDataPointer^, Strel, moDilate); - Morphology(FImage.ImageDataPointer^, Strel, moErode); - end; - end; - MeasureTime('Morphology operation applied in:', T); - UpdateView(True); -end; - -procedure TMainForm.ApplyAdditionalOp(Op: TAdditionalOp); -var - T: Int64; -begin - T := GetTimeMicroseconds; - case Op of - aoOtsuThreshold: - begin - FImage.Format := ifGray8; - OtsuThresholding(FImage.ImageDataPointer^, True); - end; - aoDeskew: DeskewImage(FImage.ImageDataPointer^); - end; - MeasureTime('Operation completed in:', T); - UpdateView(False); -end; - -procedure TMainForm.ApplyManipulation(ManipType: TManipulationType); -var - T: Int64; - OldFmt: TImageFormat; - OldSize: Integer; - RebuildTree: Boolean; -begin - OldFmt := FImage.Format; - OldSize := FImage.Size; - - T := GetTimeMicroseconds; - case ManipType of - mtFlip: FImage.Flip; - mtMirror: FImage.Mirror; - mtRotate90CW: FImage.Rotate(-90); - mtRotate90CCW: FImage.Rotate(90); - mtFreeRotate: FImage.Rotate(FParam1); - mtResize50: FImage.Resize(FImage.Width div 2, FImage.Height div 2, TResizeFilter(FParam1)); - mtResize200: FImage.Resize(FImage.Width * 2, FImage.Height * 2, TResizeFilter(FParam1)); - mtFreeResize: FImage.Resize(FParam2, FParam3, TResizeFilter(FParam1)); - mtSwapRB: FImage.SwapChannels(ChannelRed, ChannelBlue); - mtSwapRG: FImage.SwapChannels(ChannelRed, ChannelGreen); - mtSwapGB: FImage.SwapChannels(ChannelGreen, ChannelBlue); - mtReduce1024: ReduceColors(FImage.ImageDataPointer^, 1024); - mtReduce256: ReduceColors(FImage.ImageDataPointer^, 256); - mtReduce64: ReduceColors(FImage.ImageDataPointer^, 64); - mtReduce16: ReduceColors(FImage.ImageDataPointer^, 16); - mtReduce2: ReduceColors(FImage.ImageDataPointer^, 2); - end; - MeasureTime('Image manipulated in:', T); - - RebuildTree := (FImage.Format <> OldFmt) or (FImage.Size <> OldSize); - UpdateView(RebuildTree); -end; - -procedure TMainForm.FormatChangeClick(Sender: TObject); -var - T: Int64; - Fmt: TImageFormat; -begin - with Sender as TMenuItem do - begin - T := GetTimeMicroseconds; - Fmt := TImageFormat(Tag); - if MenuItemConvertAll.Checked then - FImage.ConvertImages(Fmt) - else - FImage.Format := Fmt; - MeasureTime('Image converted in:', T); - UpdateView(True); - end; -end; - -procedure TMainForm.ChannelSetClick(Sender: TObject); -var - T: Int64; - Canvas: TImagingCanvas; - ChanId: Integer; -begin - if CheckCanvasFormat then - with Sender as TMenuItem do - begin - case Parent.Caption[1] of - 'A': ChanId := ChannelAlpha; - 'R': ChanId := ChannelRed; - 'G': ChanId := ChannelGreen; - 'B': ChanId := ChannelBlue; - else - ChanId := ChannelRed; - end; - - Canvas := TImagingCanvas.CreateForImage(FImage); - - T := GetTimeMicroseconds; - Canvas.FillChannel(ChanId, Tag); - MeasureTime('Channel filled in:', T); - - Canvas.Free; - UpdateView(False); - end; -end; - -procedure TMainForm.MenuItem80Click(Sender: TObject); -begin - if InputInteger('Free Rotate', 'Enter angle in degrees:', FParam1) then - ApplyManipulation(mtFreeRotate); -end; - -procedure TMainForm.FreeResizeInput; -begin - if InputInteger('Free Resize', 'Enter width in pixels', FParam2) and - InputInteger('Free Resize', 'Enter height in pixels', FParam3) then - begin - ApplyManipulation(mtFreeResize); - end; -end; - -function TMainForm.InputInteger(const ACaption, APrompt: string; - var Value: Integer): Boolean; -var - StrVal: string; -begin - Result := False; - StrVal := ''; - - if Dialogs.InputQuery(ACaption, APrompt, StrVal) then - begin - if TryStrToInt(StrVal, Value) then - Exit(True) - else - MessageDlg('Cannot convert input to number', mtError, [mbOK], 0); - end; -end; - -procedure TMainForm.MenuItem82Click(Sender: TObject); -var - T: Int64; - Canvas: TImagingCanvas; - Red, Green, Blue, Alpha, Gray: THistogramArray; - I, MaxPixels: Integer; - Factor: Single; - - procedure VisualizeHistogram(const Histo: THistogramArray; Color: TColor32; Offset: Integer); - var - I: Integer; - begin - Canvas.PenColor32 := Color; - for I := 0 to 255 do - Canvas.VertLine(I + Offset, 256 - Round(Histo[I] * Factor), 255); - end; - -begin - if CheckCanvasFormat then - begin - Canvas := TImagingCanvas.CreateForImage(FImage); - - T := GetTimeMicroseconds; - Canvas.GetHistogram(Red, Green, Blue, Alpha, Gray); - MeasureTime('Histograms computed in:', T); - - FImage.ActiveImage := FImage.AddImage(1024, 256, ifA8R8G8B8); - Canvas.CreateForImage(FImage); - Canvas.FillColor32 := pcBlack; - Canvas.FillRect(FImage.BoundsRect); - - MaxPixels := 0; - for I := 0 to 255 do - if Red[I] > MaxPixels then MaxPixels := Red[I]; - for I := 0 to 255 do - if Green[I] > MaxPixels then MaxPixels := Green[I]; - for I := 0 to 255 do - if Blue[I] > MaxPixels then MaxPixels := Blue[I]; - for I := 0 to 255 do - if Gray[I] > MaxPixels then MaxPixels := Gray[I]; - - Factor := 256 / MaxPixels; - - VisualizeHistogram(Red, pcRed, 0); - VisualizeHistogram(Green, pcGreen, 256); - VisualizeHistogram(Blue, pcBlue, 512); - VisualizeHistogram(Gray, pcGray, 768); - - Canvas.Free; - UpdateView(True); - end; -end; - -procedure TMainForm.MenuItem83Click(Sender: TObject); -begin - FParam1 := Ord(rfNearest); - FreeResizeInput; -end; - -procedure TMainForm.MenuItem84Click(Sender: TObject); -begin - FParam1 := Ord(rfBilinear); - FreeResizeInput; -end; - -procedure TMainForm.MenuItem85Click(Sender: TObject); -begin - FParam1 := Ord(rfBicubic); - FreeResizeInput; -end; - -procedure TMainForm.MenuItem86Click(Sender: TObject); -var - Form: TForm; - Memo: TMemo; - I: Integer; - Item: TMetadataItem; - S: string; -begin - Form := TForm.Create(Self); - Form.BorderIcons := [biSystemMenu]; - Form.Caption := 'Detected Image Metadata'; - Form.Position := poOwnerFormCenter; - Form.Width := 512; - Form.Height := 512; - Memo := TMemo.Create(Form); - Memo.Parent := Form; - Memo.Align := alClient; - Memo.ReadOnly := True; - Memo.ScrollBars := ssVertical; - - if GlobalMetadata.MetaItemCount > 0 then - begin - for I := 0 to GlobalMetadata.MetaItemCount - 1 do - begin - Item := GlobalMetadata.MetaItemsByIdx[I]; - S := Format('%s (idx: %d, type: %s): %s', [Item.Id, Item.ImageIndex, - VarTypeAsText(VarType(Item.Value)), VarToStrDef(Item.Value, 'couldn''t convert Variant to string')]); - Memo.Lines.Add(S); - end; - end - else - Memo.Lines.Add('No metadata loaded for this image'); - - Form.ShowModal; - Form.Free; -end; - -procedure TMainForm.MenuItem88Click(Sender: TObject); -begin - FParam1 := Ord(rfLanczos); - ApplyManipulation(mtResize50); -end; - -procedure TMainForm.MenuItem89Click(Sender: TObject); -begin - FParam1 := Ord(rfLanczos); - ApplyManipulation(mtResize200); -end; - -procedure TMainForm.MenuItem90Click(Sender: TObject); -begin - FParam1 := Ord(rfLanczos); - FreeResizeInput; -end; - -procedure TMainForm.MenuItem91Click(Sender: TObject); -begin - ApplyAdditionalOp(aoDeskew); -end; - -procedure TMainForm.TreeImageSelectionChanged(Sender: TObject); -var - Node: TTreeNode; -begin - Node := TreeImage.Selected; - if Node <> nil then - SelectSubimage(PtrInt(Node.Data)); -end; - -procedure TMainForm.ActViewRealSizeExecute(Sender: TObject); -begin - ActViewRealSize.Checked := True; - ActViewFitToWindow.Checked := False; - Image.Proportional := False; - Image.Stretch := False; -end; - -procedure TMainForm.ActViewFitToWindowExecute(Sender: TObject); -begin - ActViewFitToWindow.Checked := True; - ActViewRealSize.Checked := False; - Image.Proportional := True; - Image.Stretch := True; -end; - -procedure TMainForm.ActViewInfoExecute(Sender: TObject); -begin -{$IFDEF MSWINDOWS} - // For some strange reason ordinary MessageDlg sometimes shows empty message for - // A8R8G8B8 images. Using Win32 msg box instead now. - MessageBox(Handle, PChar(ImageToStr(FImage.ImageDataPointer^)), 'Image information', MB_OK or MB_ICONINFORMATION); -{$ELSE} - MessageDlg(ImageToStr(FImage.ImageDataPointer^), mtInformation, [mbOK], 0); -{$ENDIF} -end; - -procedure TMainForm.FormDestroy(Sender: TObject); -begin - FImageCanvas.Free; - FBitmap.Free; - FImage.Free; -end; - -procedure TMainForm.FormDropFiles(Sender: TObject; - const FileNames: array of String); -begin - if Length(FileNames) > 0 then - OpenFile(FileNames[0]); -end; - -procedure TMainForm.FormShow(Sender: TObject); -begin - if ClientWidth > 600 then - PairSplitterSideLeft.Width := 280; - WindowState := wsMaximized; -end; - -procedure TMainForm.ImageClick(Sender: TObject); -begin - ActViewInfo.Execute; -end; - -procedure TMainForm.MenuItem3Click(Sender: TObject); -begin - OpenDialog.Filter := GetImageFileFormatsFilter(True); - if OpenDialog.Execute then - OpenFile(OpenDialog.FileName); -end; - -procedure TMainForm.MenuItem5Click(Sender: TObject); -begin - SaveDialog.Filter := GetImageFileFormatsFilter(False); - SaveDialog.FileName := ChangeFileExt(ExtractFileName(FFileName), ''); - SaveDialog.FilterIndex := GetFileNameFilterIndex(FFileName, False); - if SaveDialog.Execute then - begin - FFileName := ChangeFileExt(SaveDialog.FileName, '.' + GetFilterIndexExtension(SaveDialog.FilterIndex, False)); - SaveFile(FFileName); - end; -end; - -procedure TMainForm.MenuItem60Click(Sender: TObject); -begin - ApplyPointTransform(ptIncGamma); -end; - -procedure TMainForm.MenuItem61Click(Sender: TObject); -begin - ApplyPointTransform(ptDecGamma); -end; - -procedure TMainForm.MenuItem62Click(Sender: TObject); -begin - ApplyPointTransform(ptThreshold); -end; - -procedure TMainForm.MenuItem64Click(Sender: TObject); -begin - ApplyNonLinear(nfMedian, 3); -end; - -procedure TMainForm.MenuItem65Click(Sender: TObject); -begin - ApplyNonLinear(nfMedian, 5); -end; - -procedure TMainForm.MenuItem66Click(Sender: TObject); -begin - ApplyNonLinear(nfMin, 3); -end; - -procedure TMainForm.MenuItem67Click(Sender: TObject); -begin - ApplyNonLinear(nfMin, 5); -end; - -procedure TMainForm.MenuItem68Click(Sender: TObject); -begin - ApplyNonLinear(nfMax, 3); -end; - -procedure TMainForm.MenuItem69Click(Sender: TObject); -begin - ApplyNonLinear(nfMax, 5); -end; - -procedure TMainForm.MenuItem70Click(Sender: TObject); -begin - ApplyAdditionalOp(aoOtsuThreshold); -end; - -procedure TMainForm.MenuItem71Click(Sender: TObject); -begin - ApplyMorphology(mpErode); -end; - -procedure TMainForm.MenuItem72Click(Sender: TObject); -begin - ApplyMorphology(mpDilate); -end; - -procedure TMainForm.MenuItem73Click(Sender: TObject); -begin - ApplyMorphology(mpOpen); -end; - -procedure TMainForm.MenuItem74Click(Sender: TObject); -begin - ApplyMorphology(mpClose); -end; - -procedure TMainForm.MenuItem75Click(Sender: TObject); -begin - ApplyPointTransform(ptLevelsLow); -end; - -procedure TMainForm.MenuItem76Click(Sender: TObject); -begin - ApplyPointTransform(ptLevelsHigh); -end; - -procedure TMainForm.MenuItem78Click(Sender: TObject); -begin - ApplyPointTransform(ptAlphaPreMult); -end; - -procedure TMainForm.MenuItem79Click(Sender: TObject); -begin - ApplyPointTransform(ptAlphaUnPreMult); -end; - -procedure TMainForm.MenuItem7Click(Sender: TObject); -begin - Close; -end; - -procedure TMainForm.OpenFile(const FileName: string); -var - T: Int64; -begin - FFileName := FileName; - try - T := GetTimeMicroseconds; - GlobalMetadata.ClearMetaItems; - FImage.LoadMultiFromFile(FileName); - FFileSize := FileSize(FileName); - BuildImageTree; - GlobalMetadata.CopyLoadedMetaItemsForSaving; - MeasureTime(Format('File %s opened in:', [ExtractFileName(FileName)]), T); - except - MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0); - FImage.CreateFromParams(32, 32, ifA8R8G8B8, 1); - TreeImage.Items.Clear; - end; - SelectSubimage(0); -end; - -procedure TMainForm.BuildImageTree; -var - Root, Node: TTreeNode; - I: PtrInt; - Lab: string; - Data: TImageData; -begin - TreeImage.Items.Clear; - - Lab := Format('%s (%d images)', [ExtractFileName(FFileName), FImage.ImageCount]); - Root := TreeImage.Items.Add(nil, Lab); - - for I := 0 to FImage.ImageCount - 1 do - begin - Data := FImage.Images[I]; - Lab := Format('Img%.2d %dx%d %s', [I, Data.Width, Data.Height, GetFormatName(Data.Format)]); - Node := TreeImage.Items.AddChild(Root, Lab); - Node.Data := Pointer(I); - end; -end; - -procedure TMainForm.SaveFile(const FileName: string); -var - T: Int64; -begin - try - T := GetTimeMicroseconds; - FImage.SaveMultiToFile(FileName); - MeasureTime(Format('File %s saved in:', [ExtractFileName(FileName)]), T); - except - MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0); - end; -end; - -procedure TMainForm.SelectSubimage(Index: LongInt); -begin - FImage.ActiveImage := Index; - MenuItemActSubImage.Caption := Format('Active Subimage: %d/%d', [FImage.ActiveImage + 1, FImage.ImageCount]); - UpdateView(False); -end; - -procedure TMainForm.UpdateView(RebuildTree: Boolean); -begin - Image.Picture.Graphic.Assign(FImage); - if RebuildTree then - BuildImageTree; -end; - -procedure TMainForm.MeasureTime(const Msg: string; const OldTime: Int64); -begin - StatusBar.SimpleText := Format(' %s %.0n ms', [Msg, (GetTimeMicroseconds - OldTime) / 1000.0]); -end; - -{ - File Notes: - - -- 0.77.1 Changes/Bug Fixes --------------------------------- - - Writing metadata from loaded file when resaving. - - Added Otsu Thresholding and Deskwing, reorganized some menus. - - Added Lanczos filtering option to resize image functions. - - Added option to convert data format of all subimages by default. - - UI enhancements: added TreeView with image/subimage list, - added StatusBar instead of simple Panel. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - You can drop file on the form to open it. - - Added "Show Metadata" item to View menu + related functionality. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Added Free Resize and Free Rotate functions to Manipulate menu. - - Added premult/unpremult alpha point transforms. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Added "show histogram" menu item and functionality. - - Added new Colors submenu with "set channel set value" commands. - - Added Canvas.AdjustColorLevels example. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Added binary morphology operations. - - Added point transforms and non-linear filters. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Added status bar which shows times taken by some oprations. - - Reworked manipulation commands to get rid of UpdateView calls - everywhere. - - With Lazarus 0.9.24 images are now displayed with - proper transparency (those with alpha). Also it doesn't - screw up some images with 'Fit to window' so that is now - default. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Catches exceptions during file load/save. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Save As... now saves all images levels instead of just current one. - - Added XP controls manifest to resource file. - - Added new filters to Effects menu. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - you can now open image in Imager from shell by passing - path to image as parameter: 'LCLImager /home/myimage.jpg' - - added Reload from File menu to reload image from disk - (poor man's Undo) - - added Effects menu with some convolution filters - - added support for displaying of multi images - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - added Nearest, Bilinear, and Bicubic filter options to - Resize To 50/200% menu items - - better handling of file exts when using save dialog - - added rotations to Manipulate menu - - now works well in Linux too - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - created -} - -end. - - diff --git a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/DemoUnit.pas b/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/DemoUnit.pas deleted file mode 100644 index 56aa03c..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/DemoUnit.pas +++ /dev/null @@ -1,379 +0,0 @@ -{ - Vampyre Imaging Library Demo - OpenGL Demo (OpenGL extension) - - Demo that shows how to create OpenGL textures from files - and Imaging's images and vice versa. This sample uses SDL to create - window and process messages. Background and sprite textures are loaded from - files and rendered. Sprite is mapped on the spinning cube in the - center of the window. You can change sprite's texture format - by pressing SPACE key (it cycles trough all TImageFormat values). - Background texture can be saved to file by pressing S key and sprite texture - can be saved by pressing D key. -} - -unit DemoUnit; - -{ Define this symbol if you want to use dglOpenGL header.} -{$DEFINE USE_DGL_HEADERS} -{ $DEFINE USE_GLSCENE_HEADERS} - -{$I ImagingOptions.inc} -{$R ..\Common\MainIcon.res} - -interface - -procedure RunDemo; - -implementation - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} - SysUtils, - ImagingTypes, - Imaging, - ImagingUtility, - sdl, -{$IF Defined(USE_DGL_HEADERS)} - dglOpenGL, -{$ELSEIF Defined(USE_GLSCENE_HEADERS)} - OpenGL1x, -{$ELSE} - gl, glext, -{$IFEND} - ImagingOpenGL, - ImagingSdl, - DemoUtils; - -const - SWindowTitle = 'Vampyre Imaging Library (%s) - OpenGL Demo (format: %s)'; - SWindowIconTitle = 'OpenGL Demo'; - SBackImageFile = 'Tigers.jng'; - SSpriteImageFile = 'Vezyr.png'; - SOutScreenFile = 'GLScreen.png'; - SOutSpriteFile = 'GLSprite.dds'; - SIconFile = 'Icon.png'; - DisplayWidth = 800; - DisplayHeight = 600; - CubeSize = 200.0; - -var - BackTex: GLuint = 0; - SpriteTex: GLuint = 0; - DisplaySurface: PSDL_Surface = nil; - SpriteImage: TImageData; - SpriteFormat: TImageFormat = ifA8R8G8B8; - Event : TSDL_Event; - Running: Boolean = True; - Frames: LongInt = 0; - FPS, Elapsed: Single; - CurrTime, FrameTime, LastTime: Cardinal; - Angle: Single = 0.0; - TextureCaps: TGLTextureCaps; -{$IFDEF MSWINDOWS} - WindowHandle: THandle; -{$ENDIF} - -procedure MessageOut(const Msg: string; const Args: array of const); -begin -{$IFDEF MSWINDOWS} - MessageBox(GetActiveWindow, PChar(Format(Msg, Args)), 'Message', - MB_ICONINFORMATION or MB_OK); -{$ENDIF} -{$IFDEF UNIX} - WriteLn(Format(Msg, Args)); -{$ENDIF} -end; - -procedure MessageOutAndHalt(const Msg: string; const Args: array of const); -begin -{$IFDEF MSWINDOWS} - MessageBox(GetActiveWindow, PChar(Format(Msg, Args)), 'Error', - MB_ICONERROR or MB_OK); -{$ENDIF} -{$IFDEF UNIX} - WriteLn('Error: '); - MessageOut(' ' + Msg, Args); - WriteLn('Press RETURN to exit'); - ReadLn; -{$ENDIF} - SDL_Quit; - Halt(1); -end; - -procedure UpdateCaption; -begin - SDL_WM_SetCaption(PAnsiChar(AnsiString(Format(SWindowTitle + ' FPS: %.1f', - [Imaging.GetVersionStr, GetFormatName(SpriteFormat), FPS]))), SWindowIconTitle); -end; - -procedure CreateSpriteTexture(Format: TImageFormat); -var - Info: TImageFormatInfo; -begin - // Delete old texture and create new one in the different format - glDeleteTextures(1, @SpriteTex); - SpriteTex := ImagingOpenGL.CreateGLTextureFromImage(SpriteImage, - 256, 256, True, SpriteFormat); - if SpriteTex = 0 then - MessageOut('Sprite texture creation failed.', []); - // Set tex parameters - glBindTexture(GL_TEXTURE_2D, SpriteTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); - if TextureCaps.MaxAnisotropy > 0 then - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAX_ANISOTROPY_EXT, TextureCaps.MaxAnisotropy); - - if Imaging.GetImageFormatInfo(SpriteFormat, Info) then - begin - if Info.IsFloatingPoint and (Info.BytesPerPixel in [4, 16]) then - begin - // Floating point textures (not half float though) should use nearest - // filter on current hardware. I get 900 fps with nearest filter - // and only 2 fps with linear filter - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST_MIPMAP_NEAREST); - end - else - begin - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - end; - end; -end; - -procedure Initialize; -{$IFDEF MSWINDOWS} -var - Caption, Icon: PAnsiChar; -{$ENDIF} -begin -{$IFDEF MSWINDOWS} - SDL_WM_GetCaption(Caption, Icon); - WindowHandle := FindWindowA('SDL_app', Caption); - if WindowHandle <> 0 then - begin - // Place window to the center of the screen - SetWindowPos(WindowHandle, 0, (GetSystemMetrics(SM_CXSCREEN) - DisplayWidth) div 2, - (GetSystemMetrics(SM_CYSCREEN) - DisplayHeight - 20) div 2, 0, 0, SWP_NOSIZE or SWP_NOZORDER); - end; -{$ENDIF} - -{$IFDEF USE_DGL_HEADERS} - dglOpenGL.InitOpenGL; - dglOpenGL.ReadExtensions; - dglOpenGL.ReadImplementationProperties; -{$ENDIF} - ImagingOpenGL.GetGLTextureCaps(TextureCaps); - // Disable some GL states - glDisable(GL_LIGHTING); - // Enable some GL states - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - // Prepare for alpha blending - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - // Set projections and model view transformations - glViewport(0, 0, DisplayWidth, DisplayHeight); - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, DisplayWidth, DisplayHeight, 0, -1000.0, 1000.0); - - // Load background texture from file - BackTex := ImagingOpenGL.LoadGLTextureFromFile(GetDataDir + PathDelim + SBackImageFile); - // Set tex parameters - glBindTexture(GL_TEXTURE_2D, BackTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - Imaging.InitImage(SpriteImage); - // Load sprite image from file - Imaging.LoadImageFromFile(GetDataDir + PathDelim + SSpriteImageFile, SpriteImage); - // Create sprite texture from image - CreateSpriteTexture(SpriteFormat); -end; - -procedure Present; -begin - // Clear depth and color buffers - glClearColor(0.0, 0.8, 1.0, 1.0); - glClearDepth(1.0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - - glMatrixMode(GL_MODELVIEW); - glLoadIdentity; - // First draw background - glBindTexture(GL_TEXTURE_2D, BackTex); - glDisable(GL_DEPTH_TEST); - glBegin(GL_QUADS); - glTexCoord2f(0.0, 0.0); glVertex2f(0.0, 0.0); - glTexCoord2f(1.0, 0.0); glVertex2f(DisplayWidth, 0.0); - glTexCoord2f(1.0, 1.0); glVertex2f(DisplayWidth, DisplayHeight); - glTexCoord2f(0.0, 1.0); glVertex2f(0.0, DisplayHeight); - glEnd; - // Then draw the spinning cube - glEnable(GL_DEPTH_TEST); - glTranslatef(DisplayWidth / 2.0, DisplayHeight / 2.0, 0.0); - glRotatef(-30.0, 1.0, 0.0, 0.0); - glRotatef(Angle, 0.0, 1.0, 0.0); - glTranslatef(-CubeSize / 2.0, -CubeSize / 2.0, -CubeSize / 2.0); - glBindTexture(GL_TEXTURE_2D, SpriteTex); - glBegin(GL_QUADS); - glTexCoord2f(1.0, 0.0); glVertex3f(0.0, 0.0, 0.0); - glTexCoord2f(0.0, 0.0); glVertex3f(CubeSize, 0.0, 0.0); - glTexCoord2f(0.0, 1.0); glVertex3f(CubeSize, CubeSize, 0.0); - glTexCoord2f(1.0, 1.0); glVertex3f(0.0, CubeSize, 0.0); - - glTexCoord2f(0.0, 0.0); glVertex3f(0.0, 0.0, CubeSize); - glTexCoord2f(1.0, 0.0); glVertex3f(CubeSize, 0.0, CubeSize); - glTexCoord2f(1.0, 1.0); glVertex3f(CubeSize, CubeSize, CubeSize); - glTexCoord2f(0.0, 1.0); glVertex3f(0.0, CubeSize, CubeSize); - - glTexCoord2f(0.0, 0.0); glVertex3f(0.0, 0.0, 0.0); - glTexCoord2f(0.0, 1.0); glVertex3f(0.0, CubeSize, 0.0); - glTexCoord2f(1.0, 1.0); glVertex3f(0.0, CubeSize, CubeSize); - glTexCoord2f(1.0, 0.0); glVertex3f(0.0, 0.0, CubeSize); - - glTexCoord2f(1.0, 0.0); glVertex3f(CubeSize, 0.0, 0.0); - glTexCoord2f(1.0, 1.0); glVertex3f(CubeSize, CubeSize, 0.0); - glTexCoord2f(0.0, 1.0); glVertex3f(CubeSize, CubeSize, CubeSize); - glTexCoord2f(0.0, 0.0); glVertex3f(CubeSize, 0.0, CubeSize); - glEnd; - - Angle := Angle + 50 * Elapsed; - SDL_GL_SwapBuffers; -end; - -procedure Finalize; -begin - // Free textures and images - glDeleteTextures(1, @BackTex); - glDeleteTextures(1, @SpriteTex); - Imaging.FreeImage(SpriteImage); -end; - -procedure TakeScreenShot; -var - RenderTarget: Gluint; -begin - // Setup render target texture - glGenTextures(1, @RenderTarget); - glBindTexture(GL_TEXTURE_2D, RenderTarget); - glTexImage2D(GL_TEXTURE_2D, 0, 3, DisplayWidth, DisplayHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, nil); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - // Render all - Present; - // Copy framebuffer to texture - glBindTexture(GL_TEXTURE_2D, RenderTarget); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, DisplayWidth, DisplayHeight, 0); - // Save texture & delete it - ImagingOpenGL.SaveGLTextureToFile(SOutScreenFile, RenderTarget); - glDeleteTextures(1, @RenderTarget); -end; - -procedure RunDemo; -begin - // Initialize SDL - if (SDL_Init(SDL_INIT_VIDEO) < 0) then - MessageOutAndHalt('SDL initialization failed: %s', [SDL_GetError]); - - SDL_WM_SetCaption(PAnsiChar(AnsiString(Format(SWindowTitle, [Imaging.GetVersionStr, - GetFormatName(SpriteFormat)]))), SWindowIconTitle); - SDL_WM_SetIcon(LoadSDLSurfaceFromFile(GetDataDir + PathDelim + SIconFile), 0); - - // Set GL attributes using SDL - SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8); - SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8); - SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8); - SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24); - SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 0); - SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - - // Initialize video mode - DisplaySurface := SDL_SetVideoMode(DisplayWidth, DisplayHeight, 32, SDL_OPENGL); - if DisplaySurface = nil then - MessageOutAndHalt('SDL SetVideoMode failed: %s', [SDL_GetError]); - - // Initialize surfaces and enter main loop - Initialize; - LastTime := SDL_GetTicks; - FrameTime := LastTime; - - while Running do - begin - while SDL_PollEvent(@Event) = 1 do - begin - case Event.type_ of - SDL_QUITEV: - begin - Running := False; - end; - SDL_KEYDOWN: - begin - with Event.key.keysym do - if ((sym = SDLK_F4) and ((modifier and KMOD_ALT) <> 0)) or - (Event.key.keysym.sym = SDLK_ESCAPE) then - Running := False; - - // Using S and D keys you can take screen shots and texture - // shots easily - // SPACE key can be used to cycle sprite image formats - case Event.key.keysym.sym of - SDLK_S: TakeScreenShot; - SDLK_D: ImagingOpenGL.SaveGLTextureToFile(SOutSpriteFile, SpriteTex); - SDLK_SPACE: - begin - SpriteFormat := NextFormat(SpriteFormat); - CreateSpriteTexture(SpriteFormat); - UpdateCaption; - end; - end; - end; - end; - end; - - CurrTime := SDL_GetTicks; - Elapsed := (CurrTime - LastTime) / 1000; - LastTime := CurrTime; - Inc(Frames); - // Calculate FPS - if CurrTime - FrameTime > 1000 then - begin - FPS := Frames / (CurrTime - FrameTime) * 1000; - UpdateCaption; - Frames := 0; - FrameTime := CurrTime; - end; - - // Renders background and sprites to the window - Present; - end; - // Frees everything - Finalize; - SDL_Quit; -end; - -{ - File Notes: - - -- 0.77.1 --------------------------------------------------- - - Refactored the demo (moved stuff to unit from dpr) and - added Lazarus project files. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Added support for GLScene's OpenGL header. - - Delphi 2009 compatibility pchar/string changes. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Changes in timing. - - Can use dglOpenGL headers now. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - screenshots now work in all OSs and ImagingComponents is no longer needed - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - S key now saves screenshot to file - - anisotropic filtering enabled if supported by hardware -} - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.dof b/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.dof deleted file mode 100644 index 52ffcd1..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.dof +++ /dev/null @@ -1,117 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=0 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=..\..\Bin -UnitOutputDir=..\..\Bin\Dcu\Win32 -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common -Conditionals=DONT_LINK_EXTRAS -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -Launcher= -UseLauncher=0 -DebugCWD= -[HistoryLists\hlConditionals] -Count=1 -Item1=DONT_LINK_EXTRAS -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common -[HistoryLists\hlOutputDirectorry] -Count=1 -Item0=..\..\Bin diff --git a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.dpr b/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.dpr deleted file mode 100644 index 7d191f2..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.dpr +++ /dev/null @@ -1,14 +0,0 @@ -program OpenGLDemo; - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses - DemoUnit; -begin - RunDemo; -end. - - - diff --git a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.lpi b/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.lpi deleted file mode 100644 index 4c88d75..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.lpi +++ /dev/null @@ -1,79 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasUsesSectionForAllUnits Value="False"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="OpenGLDemo"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="2"> - <Unit0> - <Filename Value="OpenGLDemo.dpr"/> - <IsPartOfProject Value="True"/> - </Unit0> - <Unit1> - <Filename Value="DemoUnit.pas"/> - <IsPartOfProject Value="True"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\OpenGLDemo"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;$(ProjOutDir)"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <SyntaxMode Value="Delphi"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-dDONT_LINK_EXTRAS"/> - </Other> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> diff --git a/components/vampireimaging/Demos/ObjectPascal/PascalDemos.XE2.groupproj b/components/vampireimaging/Demos/ObjectPascal/PascalDemos.XE2.groupproj deleted file mode 100644 index c00f732..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/PascalDemos.XE2.groupproj +++ /dev/null @@ -1,108 +0,0 @@ - <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> - <PropertyGroup> - <ProjectGuid>{C8FC4C46-6430-43CF-87A8-405B54996A5A}</ProjectGuid> - </PropertyGroup> - <ItemGroup> - <Projects Include="OpenGLDemo\OpenGLDemo.XE2.dproj"> - <Dependencies/> - </Projects> - <Projects Include="D3DDemo\D3DDemo.XE2.dproj"> - <Dependencies/> - </Projects> - <Projects Include="FireMonkeyDemo\FireMonkeyDemo.dproj"> - <Dependencies/> - </Projects> - <Projects Include="SDLDemo\SDLDemo.XE2.dproj"> - <Dependencies/> - </Projects> - <Projects Include="VampConvert\VampConvert.XE2.dproj"> - <Dependencies/> - </Projects> - <Projects Include="Benchmark\Bench.XE2.dproj"> - <Dependencies/> - </Projects> - <Projects Include="VCLImageBrowser\ImgBrowser.XE2.dproj"> - <Dependencies/> - </Projects> - </ItemGroup> - <ProjectExtensions> - <Borland.Personality>Default.Personality.12</Borland.Personality> - <Borland.ProjectType/> - <BorlandProject> - <Default.Personality/> - </BorlandProject> - </ProjectExtensions> - <Target Name="OpenGLDemo_XE2"> - <MSBuild Projects="OpenGLDemo\OpenGLDemo.XE2.dproj"/> - </Target> - <Target Name="OpenGLDemo_XE2:Clean"> - <MSBuild Projects="OpenGLDemo\OpenGLDemo.XE2.dproj" Targets="Clean"/> - </Target> - <Target Name="OpenGLDemo_XE2:Make"> - <MSBuild Projects="OpenGLDemo\OpenGLDemo.XE2.dproj" Targets="Make"/> - </Target> - <Target Name="D3DDemo_XE2"> - <MSBuild Projects="D3DDemo\D3DDemo.XE2.dproj"/> - </Target> - <Target Name="D3DDemo_XE2:Clean"> - <MSBuild Projects="D3DDemo\D3DDemo.XE2.dproj" Targets="Clean"/> - </Target> - <Target Name="D3DDemo_XE2:Make"> - <MSBuild Projects="D3DDemo\D3DDemo.XE2.dproj" Targets="Make"/> - </Target> - <Target Name="FireMonkeyDemo"> - <MSBuild Projects="FireMonkeyDemo\FireMonkeyDemo.dproj"/> - </Target> - <Target Name="FireMonkeyDemo:Clean"> - <MSBuild Projects="FireMonkeyDemo\FireMonkeyDemo.dproj" Targets="Clean"/> - </Target> - <Target Name="FireMonkeyDemo:Make"> - <MSBuild Projects="FireMonkeyDemo\FireMonkeyDemo.dproj" Targets="Make"/> - </Target> - <Target Name="SDLDemo_XE2"> - <MSBuild Projects="SDLDemo\SDLDemo.XE2.dproj"/> - </Target> - <Target Name="SDLDemo_XE2:Clean"> - <MSBuild Projects="SDLDemo\SDLDemo.XE2.dproj" Targets="Clean"/> - </Target> - <Target Name="SDLDemo_XE2:Make"> - <MSBuild Projects="SDLDemo\SDLDemo.XE2.dproj" Targets="Make"/> - </Target> - <Target Name="VampConvert_XE2"> - <MSBuild Projects="VampConvert\VampConvert.XE2.dproj"/> - </Target> - <Target Name="VampConvert_XE2:Clean"> - <MSBuild Projects="VampConvert\VampConvert.XE2.dproj" Targets="Clean"/> - </Target> - <Target Name="VampConvert_XE2:Make"> - <MSBuild Projects="VampConvert\VampConvert.XE2.dproj" Targets="Make"/> - </Target> - <Target Name="Bench_XE2"> - <MSBuild Projects="Benchmark\Bench.XE2.dproj"/> - </Target> - <Target Name="Bench_XE2:Clean"> - <MSBuild Projects="Benchmark\Bench.XE2.dproj" Targets="Clean"/> - </Target> - <Target Name="Bench_XE2:Make"> - <MSBuild Projects="Benchmark\Bench.XE2.dproj" Targets="Make"/> - </Target> - <Target Name="ImgBrowser_XE2"> - <MSBuild Projects="VCLImageBrowser\ImgBrowser.XE2.dproj"/> - </Target> - <Target Name="ImgBrowser_XE2:Clean"> - <MSBuild Projects="VCLImageBrowser\ImgBrowser.XE2.dproj" Targets="Clean"/> - </Target> - <Target Name="ImgBrowser_XE2:Make"> - <MSBuild Projects="VCLImageBrowser\ImgBrowser.XE2.dproj" Targets="Make"/> - </Target> - <Target Name="Build"> - <CallTarget Targets="OpenGLDemo_XE2;D3DDemo_XE2;FireMonkeyDemo;SDLDemo_XE2;VampConvert_XE2;Bench_XE2;ImgBrowser_XE2"/> - </Target> - <Target Name="Clean"> - <CallTarget Targets="OpenGLDemo_XE2:Clean;D3DDemo_XE2:Clean;FireMonkeyDemo:Clean;SDLDemo_XE2:Clean;VampConvert_XE2:Clean;Bench_XE2:Clean;ImgBrowser_XE2:Clean"/> - </Target> - <Target Name="Make"> - <CallTarget Targets="OpenGLDemo_XE2:Make;D3DDemo_XE2:Make;FireMonkeyDemo:Make;SDLDemo_XE2:Make;VampConvert_XE2:Make;Bench_XE2:Make;ImgBrowser_XE2:Make"/> - </Target> - <Import Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')" Project="$(BDS)\Bin\CodeGear.Group.Targets"/> - </Project> diff --git a/components/vampireimaging/Demos/ObjectPascal/PascalDemos.bpg b/components/vampireimaging/Demos/ObjectPascal/PascalDemos.bpg deleted file mode 100644 index 3e3e4c0..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/PascalDemos.bpg +++ /dev/null @@ -1,36 +0,0 @@ -#------------------------------------------------------------------------------ -VERSION = BWS.01 -#------------------------------------------------------------------------------ -!ifndef ROOT -ROOT = $(MAKEDIR)\.. -!endif -#------------------------------------------------------------------------------ -MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** -DCC = $(ROOT)\bin\dcc32.exe $** -BRCC = $(ROOT)\bin\brcc32.exe $** -#------------------------------------------------------------------------------ -PROJECTS = Bench.exe ImgBrowser.exe SDLDemo.exe D3DDemo.exe OpenGLDemo.exe \ - VampConvert.exe -#------------------------------------------------------------------------------ -default: $(PROJECTS) -#------------------------------------------------------------------------------ - -Bench.exe: Benchmark\Bench.dpr - $(DCC) - -ImgBrowser.exe: VCLImageBrowser\ImgBrowser.dpr - $(DCC) - -SDLDemo.exe: SDLDemo\SDLDemo.dpr - $(DCC) - -D3DDemo.exe: D3DDemo\D3DDemo.dpr - $(DCC) - -OpenGLDemo.exe: OpenGLDemo\OpenGLDemo.dpr - $(DCC) - -VampConvert.exe: VampConvert\VampConvert.dpr - $(DCC) - - diff --git a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/DemoUnit.pas b/components/vampireimaging/Demos/ObjectPascal/SDLDemo/DemoUnit.pas deleted file mode 100644 index 404598f..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/DemoUnit.pas +++ /dev/null @@ -1,305 +0,0 @@ -{ - Vampyre Imaging Library Demo - SDL Demo (SDL extension) - - Demo that shows how to create SDL surfaces from Imaging's - images and vice versa. SDL window is opened and background - and sprite surfaces are loaded and blitted to window. You can change - sprite's data format by pressing SPACE key (it cycles trough all - TImageFormat values) and toggle alpha blending (working only - when sprite's current format has alpha channel) and color keying. - Sprite can be moved accross the screen using arrow keys. - Screenshots can also be taken. Status of the sprite - and list of active keys are shown in the console window. - } -unit DemoUnit; - -{$I ImagingOptions.inc} -{$R ..\Common\MainIcon.res} - -interface - -procedure RunDemo; - -implementation - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} - SysUtils, - sdl, - ImagingTypes, - Imaging, - ImagingSdl, - ImagingUtility, - DemoUtils; - -const - DisplayWidth = 800; - DisplayHeight = 600; - SIconFile = 'Icon.png'; - SBackImageFile = 'Tigers.jpg'; - SSpriteImageFile = 'Vezyr.png'; - SOutScreenFile = 'SDLScreen.png'; - SOutSpriteFile = 'SDLSprite.png'; - SWindowTitle = 'Vampyre Imaging Library (version: %s) SDL Demo'; - SWindowIconTitle = 'SDL Demo'; - -var - VideoInfo: PSDL_VideoInfo; - Flags: LongWord = SDL_HWPALETTE; - DisplaySurface: PSDL_Surface = nil; - BackSurface: PSDL_Surface = nil; - SpriteSurface: PSDL_Surface = nil; - SpriteImage: TImageData; - Event : TSDL_Event; - Running: Boolean = True; - AlphaBlending: Boolean = True; - ColorKeying: Boolean = True; - SpriteFormat: TImageFormat = ifA8R8G8B8; - SpriteX: LongInt = 100; - SpriteY: LongInt = 50; - Keys: PByteArray; - Info: TImageFormatInfo; - Frames: LongInt = 0; - LastTime: LongInt = 0; - -procedure MessageOut(const Msg: string; const Args: array of const); -begin - WriteLn(Format(Msg, Args)); -end; - -procedure MessageOutAndHalt(const Msg: string; const Args: array of const); -begin - WriteLn('Error: '); - MessageOut(' ' + Msg, Args); - WriteLn('Press RETURN to exit'); - ReadLn; - Halt(1); -end; - -procedure ConvertSprite(Format: TImageFormat); -var - Surface: PSDL_Surface; - AlphaMsg: string; - Key: UInt32; -begin - Key := 0; - SDL_FreeSurface(SpriteSurface); - // Convert sprite image to SDL surface with Format override - Surface := ImagingSDL.CreateSDLSurfaceFromImage(SpriteImage, SDL_SWSURFACE, Format); - // Convert to display format for faster blits and use alpha - // if enabled and present - if (Surface.format.Aloss <> 8) and AlphaBlending then - begin - if ColorKeying then - begin - // Set color key if enabled - Move(Surface.pixels^, Key, Surface.format.BytesPerPixel); - SDL_SetColorKey(Surface, SDL_SRCCOLORKEY or SDL_RLEACCEL, Key); - end; - SpriteSurface := SDL_DisplayFormatAlpha(Surface); - end - else - begin - SpriteSurface := SDL_DisplayFormat(Surface); - if ColorKeying then - begin - // Set color key if enabled - Move(SpriteSurface.pixels^, Key, SpriteSurface.format.BytesPerPixel); - SDL_SetColorKey(SpriteSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, Key); - end; - end; - if SpriteSurface = nil then - MessageOutAndHalt('Cannot create sprite surface: %s', [SDL_GetError]); - SDL_FreeSurface(Surface); - - // Output sprite info - Imaging.GetImageFormatInfo(Format, Info); - MessageOut('Sprite converted', []); - MessageOut(' Current sprite format: %s', [Info.Name]); - AlphaMsg := Iff((SpriteSurface.format.Aloss <> 8) and (SpriteSurface.format.palette = nil), - 'Enabled', 'Disabled or not supported in this format'); - MessageOut(' Alpha blending: %s', [AlphaMsg]); - MessageOut(' Color keying: %s', [Iff(ColorKeying, 'Enabled', 'Disabled')]); -end; - -procedure Initialize; -var - Image: TImageData; - Surface: PSDL_Surface; -{$IFDEF MSWINDOWS} - Caption, Icon: PAnsiChar; - WindowHandle: THandle; -{$ENDIF} -begin -{$IFDEF MSWINDOWS} - SDL_WM_GetCaption(Caption, Icon); - WindowHandle := FindWindowA('SDL_app', Caption); - if WindowHandle <> 0 then - // Place window to the center of the screen - SetWindowPos(WindowHandle, 0, (GetSystemMetrics(SM_CXSCREEN) - DisplayWidth) div 2, - (GetSystemMetrics(SM_CYSCREEN) - DisplayHeight - 20) div 2, 0, 0, SWP_NOSIZE or SWP_NOZORDER); -{$ENDIF} - - // Load background image from file, resize it to fit the window, - // convert it to SDL surface and convert this surface to - // display format for faster blitting - if not Imaging.LoadImageFromFile(GetDataDir + PathDelim + SBackImageFile, Image) then - MessageOutAndHalt('Cannot load background image: %s', [SBackImageFile]); - Imaging.ResizeImage(Image, DisplayWidth, DisplayHeight, rfBilinear); - Surface := ImagingSDL.CreateSDLSurfaceFromImage(Image, SDL_SWSURFACE); - BackSurface := SDL_DisplayFormat(Surface); - Imaging.FreeImage(Image); - SDL_FreeSurface(Surface); - if BackSurface = nil then - MessageOutAndHalt('Cannot create background surface.', []); - - // Load sprite image - if not Imaging.LoadImageFromFile(GetDataDir + PathDelim + SSpriteImageFile, SpriteImage) then - MessageOutAndHalt('Cannot load sprite image: %s', [SSpriteImageFile]); - ConvertSprite(SpriteFormat); -end; - -procedure Present; -var - Dest: TSDL_Rect; -begin - Dest.x := SpriteX; - Dest.y := SpriteY; - Dest.w := SpriteSurface.w; - Dest.h := SpriteSurface.h; - - SDL_BlitSurface(BackSurface, nil, DisplaySurface, nil); - SDL_BlitSurface(SpriteSurface, nil, DisplaySurface, @Dest); - SDL_UpdateRect(DisplaySurface, 0, 0, DisplayWidth, DisplayHeight); -end; - -procedure Finalize; -begin - // Free all surfaces and images - SDL_FreeSurface(BackSurface); - SDL_FreeSurface(SpriteSurface); - Imaging.FreeImage(SpriteImage); -end; - -procedure RunDemo; -begin - MessageOut('Vampyre Imaging Library Demo - SDL (version %s)' + sLineBreak + - 'written by Marek Mauder' + sLineBreak, [Imaging.GetVersionStr]); - MessageOut('Keys (when SDL window has focus): ' + sLineBreak + - ' SPACE - cycle image data formats' + sLineBreak + - ' A - toggle alpha blending (only if alpha channel is present)' + sLinebreak + - ' C - toggle color keying' + sLineBreak + - ' S - take screenshot and save (%s)' + sLineBreak + - ' D - save sprite surface (%s)' + sLineBreak + - ' LEFT/RIGHT/UP/DOWN - move sprite' + sLineBreak + - ' ESC/ALT+F4 - quit' + sLineBreak, [SOutScreenFile, SOutSpriteFile]); - - // Initialize SDL - if (SDL_Init(SDL_INIT_VIDEO) < 0) then - MessageOutAndHalt('SDL initialization failed: %s', [SDL_GetError]); - - // Get video info and set flags - VideoInfo := SDL_GetVideoInfo; - if VideoInfo = nil then - MessageOutAndHalt('SDL GetVideoInfo failed: %s', [SDL_GetError]); - if VideoInfo.hw_available <> 0 then - Flags := Flags or SDL_HWSURFACE - else - Flags := Flags or SDL_SWSURFACE; - - SDL_WM_SetCaption(PAnsiChar(AnsiString(Format(SWindowTitle, [Imaging.GetVersionStr]))), SWindowIconTitle); - SDL_WM_SetIcon(LoadSDLSurfaceFromFile(GetDataDir + PathDelim + SIconFile), 0); - - // Initialize video mode - DisplaySurface := SDL_SetVideoMode(DisplayWidth, DisplayHeight, 32, Flags); - if DisplaySurface = nil then - MessageOutAndHalt('SDL SetVideoMode failed: %s', [SDL_GetError]); - - // Initialize surfaces and enter main loop - Initialize; - LastTime := SDL_GetTicks; - while Running do - begin - while SDL_PollEvent(@Event) = 1 do - begin - case Event.type_ of - SDL_QUITEV: - begin - Running := False; - end; - SDL_KEYDOWN: - begin - with Event.key.keysym do - if ((sym = SDLK_F4) and ((modifier and KMOD_ALT) <> 0)) or - (Event.key.keysym.sym = SDLK_ESCAPE) then - Running := False; - - if Event.key.keysym.sym in [SDLK_A, SDLK_C, SDLK_SPACE] then - begin - // You can toggle alpha blending with A key, - // color keying with C key, SPACE key - // can be used to cycle sprite image formats - case Event.key.keysym.sym of - SDLK_A: AlphaBlending := not AlphaBlending; - SDLK_C: ColorKeying := not ColorKeying; - SDLK_SPACE: SpriteFormat := NextFormat(SpriteFormat); - end; - ConvertSprite(SpriteFormat); - end; - - // Using S and D keys you can take screen shots and sprite - // shots easily - case Event.key.keysym.sym of - SDLK_S: ImagingSDL.SaveSDLSurfaceToFile(SOutScreenFile, DisplaySurface); - SDLK_D: ImagingSDL.SaveSDLSurfaceToFile(SOutSpriteFile, SpriteSurface); - end; - end; - end; - end; - - // Sprite can be moved around screen using arrow keys - Keys := PByteArray(SDL_GetKeyState(nil)); - if Keys[SDLK_LEFT] > 0 then - SpriteX := Max(0, SpriteX - 1); - if Keys[SDLK_RIGHT] > 0 then - SpriteX := Min(DisplayWidth - SpriteSurface.w, SpriteX + 1); - if Keys[SDLK_UP] > 0 then - SpriteY := Max(0, SpriteY - 1); - if Keys[SDLK_DOWN] > 0 then - SpriteY := Min(DisplayHeight - SpriteSurface.h, SpriteY + 1); - - // Calculate FPS - if LongInt(SDL_GetTicks) - LastTime > 1000 then - begin - SDL_WM_SetCaption(PAnsiChar(AnsiString(Format(SWindowTitle + ' FPS: %d', - [Imaging.GetVersionStr, Frames]))), SWindowIconTitle); - Frames := 0; - LastTime := SDL_GetTicks; - end; - Inc(Frames); - - // Blits background and sprite to display surface - Present; - end; - // Frees all surfaces and images - Finalize; - SDL_Quit; -end; - -{ - File Notes: - - -- 0.77.1 --------------------------------------------------- - - Refactored the demo (moved stuff to unit from dpr) and - added Lazarus project files. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Changed resolution to 800x600. - - Delphi 2009 compatibility pchar/string changes. -} - - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.dof b/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.dof deleted file mode 100644 index 3ec82e9..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.dof +++ /dev/null @@ -1,118 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=0 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=..\..\Bin -UnitOutputDir=..\..\Bin\Dcu\Win32 -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common -Conditionals=DONT_LINK_EXTRAS -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -Launcher= -UseLauncher=0 -DebugCWD= -[HistoryLists\hlConditionals] -Count=1 -Item1=DONT_LINK_EXTRAS -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common -[HistoryLists\hlOutputDirectorry] -Count=1 -Item0=..\..\Bin - diff --git a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.dpr b/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.dpr deleted file mode 100644 index db3ec90..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.dpr +++ /dev/null @@ -1,15 +0,0 @@ -program SDLDemo; - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$IFDEF MSWINDOWS} - {$APPTYPE CONSOLE} -{$ENDIF} - -uses - DemoUnit; -begin - RunDemo; -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.lpi b/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.lpi deleted file mode 100644 index 6673d57..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/SDLDemo/SDLDemo.lpi +++ /dev/null @@ -1,79 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasUsesSectionForAllUnits Value="False"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="SDLDemo"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="2"> - <Unit0> - <Filename Value="SDLDemo.dpr"/> - <IsPartOfProject Value="True"/> - </Unit0> - <Unit1> - <Filename Value="DemoUnit.pas"/> - <IsPartOfProject Value="True"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\SDLDemo"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;$(ProjOutDir)"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <SyntaxMode Value="Delphi"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-dDONT_LINK_EXTRAS"/> - </Other> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> diff --git a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.dof b/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.dof deleted file mode 100644 index 0ca5a74..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.dof +++ /dev/null @@ -1,117 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=1 -M=0 -N=1 -O=0 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=0 -W=1 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=..\..\Bin -UnitOutputDir=..\..\Bin\Dcu\Win32 -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common;..\..\..\Extras\Extensions\LibTiff -Conditionals=FULL_FEATURE_SET -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -Launcher= -UseLauncher=0 -DebugCWD= -[HistoryLists\hlConditionals] -Count=1 -Item1=FULL_FEATURE_SET -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common;..\..\..\Extras\Extensions\LibTiff -[HistoryLists\hlOutputDirectorry] -Count=1 -Item0=..\..\Bin diff --git a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.dpr b/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.dpr deleted file mode 100644 index 0b066b9..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.dpr +++ /dev/null @@ -1,14 +0,0 @@ -program ImgBrowser; - -uses - Forms, - Main; - -{$R *.res} - -begin - Application.Initialize; - Application.Title := 'VCL Image Browser'; - Application.CreateForm(TMainForm, MainForm); - Application.Run; -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.res b/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.res deleted file mode 100644 index e4dabb7..0000000 Binary files a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/ImgBrowser.res and /dev/null differ diff --git a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/Main.dfm b/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/Main.dfm deleted file mode 100644 index ccf7b69..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/Main.dfm +++ /dev/null @@ -1,426 +0,0 @@ -object MainForm: TMainForm - Left = 167 - Top = 103 - Caption = 'VCL Image Browser - Vampyre Imaging Library Demo' - ClientHeight = 791 - ClientWidth = 1026 - Color = clWhite - Font.Charset = EASTEUROPE_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Verdana' - Font.Style = [fsBold] - OldCreateOrder = False - Position = poScreenCenter - OnCreate = FormCreate - OnDestroy = FormDestroy - PixelsPerInch = 96 - TextHeight = 13 - object Splitter1: TSplitter - Left = 249 - Top = 0 - Height = 791 - end - object LeftPanel: TPanel - Left = 0 - Top = 0 - Width = 249 - Height = 791 - Align = alLeft - BevelOuter = bvNone - Color = clWhite - TabOrder = 0 - object Tree: TShellTreeView - Left = 0 - Top = 0 - Width = 249 - Height = 791 - ObjectTypes = [otFolders, otNonFolders, otHidden] - Root = 'rfMyComputer' - UseShellImages = True - Align = alClient - AutoRefresh = False - Indent = 19 - ParentColor = False - RightClickSelect = True - ShowRoot = False - TabOrder = 0 - OnKeyDown = TreeKeyDown - OnChange = TreeChange - end - end - object RightPanel: TPanel - Left = 252 - Top = 0 - Width = 774 - Height = 791 - Align = alClient - BevelOuter = bvNone - Color = clWhite - Constraints.MinHeight = 300 - Constraints.MinWidth = 400 - TabOrder = 1 - object InfoPanel: TPanel - Left = 0 - Top = 0 - Width = 774 - Height = 97 - Align = alTop - BevelOuter = bvNone - Color = clWhite - TabOrder = 0 - DesignSize = ( - 774 - 97) - object LabDataFormat: TLabel - Left = 136 - Top = 56 - Width = 281 - Height = 13 - AutoSize = False - end - object LabFileFormat: TLabel - Left = 136 - Top = 40 - Width = 281 - Height = 13 - AutoSize = False - end - object LabDim: TLabel - Left = 136 - Top = 24 - Width = 281 - Height = 13 - AutoSize = False - end - object LabFileName: TLabel - Left = 136 - Top = 8 - Width = 281 - Height = 13 - AutoSize = False - end - object Label3: TLabel - Left = 8 - Top = 56 - Width = 82 - Height = 13 - Caption = 'Data format:' - end - object Label2: TLabel - Left = 8 - Top = 40 - Width = 76 - Height = 13 - Caption = 'File format:' - end - object Label1: TLabel - Left = 8 - Top = 24 - Width = 79 - Height = 13 - Caption = 'Dimensions:' - end - object Lab1: TLabel - Left = 8 - Top = 8 - Width = 85 - Height = 13 - Caption = 'Selected file:' - end - object Label4: TLabel - Left = 8 - Top = 72 - Width = 112 - Height = 13 - Caption = 'Active subimage:' - end - object LabActImage: TLabel - Left = 136 - Top = 72 - Width = 281 - Height = 13 - AutoSize = False - end - object BtnPrev: TSpeedButton - Left = 232 - Top = 69 - Width = 23 - Height = 22 - Hint = 'Previous subimage' - Glyph.Data = { - 76050000424D7605000000000000360400002800000011000000100000000100 - 0800000000004001000000000000000000000001000000000000000000000000 - 80000080000000808000800000008000800080800000C0C0C000808080000000 - FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00710000005001 - 0000ACCEBE00C023BD00000102000405060008090A000C0D0E00101112001415 - 160018191A001C1D1E00202022002424260028282A002C2C2E00303032003434 - 360038383A003C3C3E004041410044454600484949004C4D4E00505151005455 - 5600585959005C5D5E0070000000910000000000000000BBBE00223401005003 - 94000CBBBE007C7D7E008081820018BBBE0088898A008C8D8E0024BBBE009395 - 960098999A0030BBBE00A0A1A200A3A5A6003CBBBE00ACADAE00C00000009100 - 00000000000050BBBE00BE33010088B6AE005CBBBE0060BBBE00D0D1D20068BB - BE0000000000DCDDDE0074BBBE00E3E5E600E8E9EA0080BBBE00910000005000 - 00008CBBBE004023BD000000000098BBBE000000000000000000A4BBBE000000 - 000000000000B0BBBE0000000000000000000000000000000000000000000000 - 0000000000001E001F0050010000410000000000000000000000550B13004C72 - BE0000000000C90A89005472BE0000000000690B05005C72BE0000000000DB0A - 72006472BE00120000004100000031000000F8BBBE00E0BBBE00000000000000 - 0000D4BBBE00ECBBBE0000000000FF00FF00FFFF0000FFFFFF0031000000D100 - 0000333333003333330030000000333333003333330030000000333F33003333 - 330030000000338EFF003333330030000000338EEE003333330030000000338E - EE00FF33330030000000338EEE00EEFF330030000000338EEE00EEEEFF003000 - 0000338EEE00EEEE880030000000338EEE00EE88330030000000338EEE008833 - 330030000000338EEE003333330030000000338E880033333300300000003388 - 3300333333003000000033333300333333003000000033333300333333003000 - 0000FFFFFF000F000000D1000000810000002800000011000000100000000100 - 040000000000C000000000000000000000001000000010000000000000000000 - 80000080000000808000800000008000800080800000C0C0C000808080000000 - FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FF00FF0000FF - FF00FFFFFF00EE4F00008100000041000000D0BDBE0000000000C1330100C4FC - BD00D4BDBE00C0300100D4FCBD00B8BDBE000400000000000000000000000000 - 000000000000FFFFFF00410000004100000050BEBE00000000003F34010084FC - BD0000000000C233010094FCBD00E0BDBE00BE330100A4FCBD00ECBDBE00AC30 - 0100B4FCBD004023BD004100000041000000E096BE0000000000BF33010074FC - BD002CBEBE00000000000000000038BEBE000000000000000000030303030303 - 0303030303030303030303000000030303030303030303030303030303030300 - 0000030303030303030303030303030F03030300000003030303030303030303 - 030F0F0E0803030000000303030303030303030F0F0E0E0E0803030000000303 - 03030303030F0F0E0E0E0E0E08030300000003030303030F0F0E0E0E0E0E0E0E - 0803030000000303030F0F0E0E0E0E0E0E0E0E0E08030300000003030F08080E - 0E0E0E0E0E0E0E0E080303000000030303030308080E0E0E0E0E0E0E08030300 - 00000303030303030308080E0E0E0E0E08030300000003030303030303030308 - 080E0E0E080303000000030303030303030303030308080E0803030000000303 - 0303030303030303030303080803030000000303030303030303030303030303 - 0303030000000303030303030303030303030303030303000000} - ParentShowHint = False - ShowHint = True - OnClick = BtnPrevClick - end - object BtnNext: TSpeedButton - Left = 261 - Top = 69 - Width = 23 - Height = 22 - Hint = 'Next subimage' - Glyph.Data = { - 76050000424D7605000000000000360400002800000011000000100000000100 - 0800000000004001000000000000000000000001000000000000000000000000 - 80000080000000808000800000008000800080800000C0C0C000808080000000 - FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000030303030303 - 0303030303030303030303000000030303030303030303030303030303030300 - 00000303030F030303030303030303030303030000000303080E0F0F03030303 - 030303030303030000000303080E0E0E0F0F0303030303030303030000000303 - 080E0E0E0E0E0F0F030303030303030000000303080E0E0E0E0E0E0E0F0F0303 - 0303030000000303080E0E0E0E0E0E0E0E0E0F0F0303030000000303080E0E0E - 0E0E0E0E0E0E08080F03030000000303080E0E0E0E0E0E0E0808030303030300 - 00000303080E0E0E0E0E0808030303030303030000000303080E0E0E08080303 - 030303030303030000000303080E080803030303030303030303030000000303 - 0808030303030303030303030303030000000303030303030303030303030303 - 0303030000000303030303030303030303030303030303000000} - Layout = blGlyphRight - ParentShowHint = False - ShowHint = True - OnClick = BtnNextClick - end - object BtnFirst: TSpeedButton - Left = 320 - Top = 69 - Width = 23 - Height = 22 - Hint = 'First subimage' - Glyph.Data = { - 76050000424D7605000000000000360400002800000014000000100000000100 - 0800000000004001000000000000000000000001000000000000000000000000 - 80000080000000808000800000008000800080800000C0C0C000808080000000 - FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000030303030303 - 0303030303030303030303030303030303030303030303030303030303030303 - 03030303080F0F03030303030303030303030F0F03030303080E0F0303030303 - 030303030F0F0E0F03030303080E0F030303030303030F0F0E0E0E0F03030303 - 080E0F03030303030F0F0E0E0E0E0E0F03030303080E0F0303030F0F0E0E0E0E - 0E0E0E0F03030303080E0F03030F0E0E0E0E0E0E0E0E0E0F03030303080E0F03 - 08080E0E0E0E0E0E0E0E0E0F03030303080E0F03030308080E0E0E0E0E0E0E0F - 03030303080E0F030303030308080E0E0E0E0E0F03030303080E0F0303030303 - 030308080E0E0E0F03030303080E0F03030303030303030308080E0F03030303 - 08080F0303030303030303030303080F03030303030303030303030303030303 - 0303030303030303030303030303030303030303030303030303} - ParentShowHint = False - ShowHint = True - OnClick = BtnFirstClick - end - object BtnLast: TSpeedButton - Left = 349 - Top = 69 - Width = 23 - Height = 22 - Hint = 'Last subimage' - Glyph.Data = { - B6050000424DB605000000000000360400002800000015000000100000000100 - 0800000000008001000000000000000000000001000000000000000000000000 - 80000080000000808000800000008000800080800000C0C0C000808080000000 - FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000030303030303 - 0303030303030303030303030303030000000303030303030303030303030303 - 030303030303030000000303030F030303030303030303030303080F0F030300 - 00000303080E0F0F03030303030303030303080E0F03030000000303080E0E0E - 0F0F0303030303030303080E0F03030000000303080E0E0E0E0E0F0F03030303 - 0303080E0F03030000000303080E0E0E0E0E0E0E0F0F03030303080E0F030300 - 00000303080E0E0E0E0E0E0E0E0E0F0F0303080E0F03030000000303080E0E0E - 0E0E0E0E0E0E08080F03080E0F03030000000303080E0E0E0E0E0E0E08080303 - 0303080E0F03030000000303080E0E0E0E0E0808030303030303080E0F030300 - 00000303080E0E0E08080303030303030303080E0F03030000000303080E0808 - 03030303030303030303080E0F03030000000303080803030303030303030303 - 030308080F030300000003030303030303030303030303030303030303030300 - 0000030303030303030303030303030303030303030303000000} - ParentShowHint = False - ShowHint = True - OnClick = BtnLastClick - end - object BtnSave: TButton - Left = 641 - Top = 3 - Width = 129 - Height = 25 - Anchors = [akTop, akRight] - Caption = 'Save Image Copy' - TabOrder = 0 - OnClick = BtnSaveClick - end - object CheckFilter: TCheckBox - Left = 641 - Top = 39 - Width = 121 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Bicubic filtering' - Checked = True - State = cbChecked - TabOrder = 1 - OnClick = CheckFilterClick - end - end - object ViewPanel: TPanel - Left = 0 - Top = 97 - Width = 774 - Height = 694 - Align = alClient - BevelOuter = bvNone - Color = 16777126 - TabOrder = 1 - OnResize = ViewPanelResize - object PaintBox: TPaintBox - Left = 0 - Top = 0 - Width = 774 - Height = 675 - Align = alClient - Color = 16773862 - ParentColor = False - OnPaint = PaintBoxPaint - end - object StatusBar: TStatusBar - Left = 0 - Top = 675 - Width = 774 - Height = 19 - Color = clWhite - Panels = <> - SimplePanel = True - end - end - end - object SaveDialog: TSavePictureDialog - Left = 104 - Top = 320 - end -end diff --git a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/Main.pas b/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/Main.pas deleted file mode 100644 index 485d2ed..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VCLImageBrowser/Main.pas +++ /dev/null @@ -1,412 +0,0 @@ -{ - Vampyre Imaging Library Demo - VCL Image Browser (class api, canvas, vcl interaction) - - This simple viewer application shows usage of high level class interface - to Imaging library and also drawing images onto standard VCL TCanvas. - TImagingCanvas class is also used here. - - In the left part of the window is shell tree view component. Here you can - select files located in your computer. If the selected file is in one of the - supported formats it is displayed in the viewer - area and some information about the file is displayed in the info area. - If image file contains subimages you can view them too. Select active subimage - by clicking on buttons with arrows (Previous/Next). - - When supported file is selected in shell tree view it is loaded to - TMultiImage and converted to ifA8R8G8B8 - data format. Active subimage is then drawn TPainBox component's - client area using DisplayImage procedure (direct bit copy, no need to - convert Imaging's data to TGraphic). - - You need ShellCtrls unit and its components installed in Delphi for this demo. - In BDS 2006 you can find them in Demos\DelphiWin32\VCLWin32\ShellControls - directory. In some other versions of Delphi it is installed by default during - IDE installation. -} - -unit Main; - -{$I ImagingOptions.inc} - -{$IF not Defined(COMPONENT_SET_VCL) or not Defined(DELPHI)} - {$MESSAGE ERROR 'This program requires Delphi with VCL'} -{$IFEND} - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ComCtrls, ShellCtrls, ExtCtrls, StdCtrls, Buttons, ExtDlgs, - ImagingTypes, - Imaging, - ImagingClasses, - ImagingComponents, - ImagingCanvases, - ImagingFormats, - ImagingUtility; - -type - TMainForm = class(TForm) - LeftPanel: TPanel; - RightPanel: TPanel; - InfoPanel: TPanel; - LabDataFormat: TLabel; - LabFileFormat: TLabel; - LabDim: TLabel; - LabFileName: TLabel; - Label3: TLabel; - Label2: TLabel; - Label1: TLabel; - Lab1: TLabel; - ViewPanel: TPanel; - PaintBox: TPaintBox; - Tree: TShellTreeView; - Splitter1: TSplitter; - Label4: TLabel; - LabActImage: TLabel; - StatusBar: TStatusBar; - BtnPrev: TSpeedButton; - BtnNext: TSpeedButton; - BtnFirst: TSpeedButton; - BtnLast: TSpeedButton; - BtnSave: TButton; - SaveDialog: TSavePictureDialog; - CheckFilter: TCheckBox; - procedure PaintBoxPaint(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure TreeChange(Sender: TObject; Node: TTreeNode); - procedure BtnPrevClick(Sender: TObject); - procedure BtnNextClick(Sender: TObject); - procedure TreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure BtnFirstClick(Sender: TObject); - procedure BtnLastClick(Sender: TObject); - procedure BtnSaveClick(Sender: TObject); - procedure ViewPanelResize(Sender: TObject); - procedure CheckFilterClick(Sender: TObject); - private - // Class that holds multiple images (loaded from MNG or DDS files for instance) - FImage: ImagingClasses.TMultiImage; - // Canvas for drawing on loaded images - FImageCanvas: ImagingCanvases.TImagingCanvas; - // Image background - FBack: ImagingClasses.TSingleImage; - // Canvas for background image - FBackCanvas: ImagingCanvases.TImagingCanvas; - FFileName: string; - FLastTime: LongInt; - FOriginalFormats: array of TImageFormat; - FOriginalSizes: array of Integer; - FSupported: Boolean; - public - procedure SetSupported; - procedure SetUnsupported; - procedure LoadFile; - procedure FillDefault; - end; - -const - FillColor = $FFE6F2FF; - CheckersDensity = 32; - SUnsupportedFormat = 'Selected item format not supported'; - -var - MainForm: TMainForm; - -implementation - -{$R *.dfm} -{$IF (CompilerVersion >= 15.0) and (CompilerVersion <= 23.0)} -uses - XPMan; -{$IFEND} - -procedure TMainForm.LoadFile; -var - I: LongInt; - T: Int64; -begin - try - // DetermineFileFormat reads file header and returns image - // file format identifier (like 'jpg', 'tga') if file is valid, - // otherwise empty string is returned - if Imaging.DetermineFileFormat(FFileName) <> '' then - try - // Load all subimages in file - T := ImagingUtility.GetTimeMicroseconds; - FImage.LoadMultiFromFile(FFileName); - - if not FImage.AllImagesValid then - begin - SetUnsupported; - Exit; - end; - - FLastTime := (ImagingUtility.GetTimeMicroseconds - T) div 1000; - StatusBar.SimpleText := Format('Last image loaded in: %.0n ms', [FLastTime * 1.0]); - - // Store original data formats and sizes for later use - SetLength(FOriginalFormats, FImage.ImageCount); - SetLength(FOriginalSizes, FImage.ImageCount); - - for I := 0 to FImage.ImageCount - 1 do - begin - FImage.ActiveImage := I; - FOriginalFormats[I] := FImage.Format; - FOriginalSizes[I] := FImage.Size; - // Convert image to 32bit ARGB format if current format is not supported - // by canvas class - if not (FImage.Format in TImagingCanvas.GetSupportedFormats) then - FImage.Format := ifA8R8G8B8; - end; - // Activate first image and update UI - FImage.ActiveImage := 0; - SetSupported; - PaintBox.Repaint; - except - SetUnsupported; - raise; - end - else - SetUnsupported; - except - SetUnsupported; - end; -end; - -procedure TMainForm.SetSupported; -var - XRes, YRes: Single; - ImgSize: Integer; -begin - // Update image info and enable previous/next buttons - ImgSize := FOriginalSizes[FImage.ActiveImage]; - if ImgSize > 8192 then - ImgSize := ImgSize div 1024; - LabDim.Caption := Format('%dx%d pixels', [FImage.Width, FImage.Height]); - if GlobalMetadata.GetPhysicalPixelSize(ruDpi, XRes, YRes) then - LabDim.Caption := LabDim.Caption + Format(' (DPI %.0nx%.0n)', [XRes, YRes]); - LabFileFormat.Caption := Imaging.FindImageFileFormatByName(FFileName).Name; - LabDataFormat.Caption := Imaging.GetFormatName(FOriginalFormats[FImage.ActiveImage]); - LabDataFormat.Caption := LabDataFormat.Caption + - Format(' (Size in memory: %s %s)', [IntToStrFmt(ImgSize), Iff(ImgSize = FOriginalSizes[FImage.ActiveImage], 'B', 'KiB')]); - LabActImage.Caption := Format('%d/%d', [FImage.ActiveImage + 1, FImage.ImageCount]); - BtnPrev.Enabled := True; - BtnNext.Enabled := True; - BtnFirst.Enabled := True; - BtnLast.Enabled := True; - BtnSave.Enabled := True; - CheckFilter.Enabled := True; - FSupported := True; -end; - -procedure TMainForm.SetUnsupported; -var - X, Y, Step: LongInt; -begin - // Set info texts to 'unsupported' and create default image to show - LabDim.Caption := SUnsupportedFormat; - LabFileFormat.Caption := SUnsupportedFormat; - LabDataFormat.Caption := SUnsupportedFormat; - LabActImage.Caption := '0/0'; - StatusBar.SimpleText := 'No image loaded'; - BtnPrev.Enabled := False; - BtnNext.Enabled := False; - BtnFirst.Enabled := False; - BtnLast.Enabled := False; - BtnSave.Enabled := False; - CheckFilter.Enabled := False; - FSupported := False; - - if Assigned(FImage) then - begin - FImage.CreateFromParams(CheckersDensity, CheckersDensity, ifA8R8G8B8, 1); - FImageCanvas.Free; - FImageCanvas := FindBestCanvasForImage(FImage).CreateForImage(FImage); - - Step := FImage.Width div CheckersDensity; - for Y := 0 to CheckersDensity - 1 do - for X := 0 to CheckersDensity - 1 do - begin - FImageCanvas.FillColor32 := IffUnsigned((Odd(X) and not Odd(Y)) or (not Odd(X) and Odd(Y)), - pcWhite, pcGray); - FImageCanvas.FillRect(Rect(X * Step, Y * Step, (X + 1) * Step, (Y + 1) * Step)); - end; - end; - // Paint current image - PaintBox.Repaint; -end; - -procedure TMainForm.BtnPrevClick(Sender: TObject); -begin - FImage.ActiveImage := FImage.ActiveImage - 1; - SetSupported; - PaintBox.Repaint; -end; - -procedure TMainForm.BtnSaveClick(Sender: TObject); -var - CopyPath: string; -begin - SaveDialog.Filter := Imaging.GetImageFileFormatsFilter(False); - SaveDialog.FileName := ChangeFileExt(ExtractFileName(FFileName), ''); - SaveDialog.FilterIndex := Imaging.GetFileNameFilterIndex(FFileName, False); - if SaveDialog.Execute then - begin - CopyPath := ChangeFileExt(SaveDialog.FileName, '.' + - Imaging.GetFilterIndexExtension(SaveDialog.FilterIndex, False)); - FImage.SaveMultiToFile(CopyPath); - end; -end; - -procedure TMainForm.CheckFilterClick(Sender: TObject); -begin - PaintBox.Repaint; -end; - -procedure TMainForm.BtnFirstClick(Sender: TObject); -begin - FImage.ActiveImage := 0; - SetSupported; - PaintBox.Repaint; -end; - -procedure TMainForm.BtnLastClick(Sender: TObject); -begin - FImage.ActiveImage := FImage.ImageCount - 1; - SetSupported; - PaintBox.Repaint; -end; - -procedure TMainForm.BtnNextClick(Sender: TObject); -begin - FImage.ActiveImage := FImage.ActiveImage + 1; - SetSupported; - PaintBox.Repaint; -end; - -procedure TMainForm.TreeChange(Sender: TObject; Node: TTreeNode); -begin - // Selected item in the shell tree view has been changed - // we check whether the selected item is valid file in one of the - // supported formats - FFileName := Tree.Path; - LabFileName.Caption := ExtractFileName(FFileName); - if FileExists(FFileName) and Assigned(Imaging.FindImageFileFormatByName(FFileName)) then - LoadFile - else - SetUnsupported; -end; - -procedure TMainForm.TreeKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - if FImage.ImageCount > 1 then - begin - if Key = VK_SPACE then - BtnNextClick(Self); - end; -end; - -procedure TMainForm.ViewPanelResize(Sender: TObject); -begin - // Resize background image to fit the paint box - FBack.Resize(PaintBox.ClientWidth, PaintBox.ClientHeight, rfNearest); - // Update back canvas state after resizing of associated image - FBackCanvas.UpdateCanvasState; -end; - -procedure TMainForm.FormDestroy(Sender: TObject); -begin - FImage.Free; - FImageCanvas.Free; - FBack.Free; - FBackCanvas.Free; -end; - -procedure TMainForm.FormCreate(Sender: TObject); -begin - Caption := Caption + ' version ' + Imaging.GetVersionStr; - FImage := TMultiImage.Create; - FImageCanvas := TImagingCanvas.Create; - FBack := TSingleImage.CreateFromParams(128, 128, ifA8R8G8B8); - FBackCanvas := FindBestCanvasForImage(FBack).CreateForImage(FBack); - SetUnsupported; -end; - -procedure TMainForm.PaintBoxPaint(Sender: TObject); -var - R: TRect; - Filter: TResizeFilter; -begin - // Fill background with default color - FillDefault; - - // Determine which stretching filter to use - if FSupported and CheckFilter.Checked then - Filter := rfBicubic - else - Filter := rfNearest; - // Scale image to fit the paint box - R := ImagingUtility.ScaleRectToRect(FImage.BoundsRect, PaintBox.ClientRect); - // Create canvas for current image frame - FImageCanvas.Free; - FImageCanvas := FindBestCanvasForImage(FImage).CreateForImage(FImage); - // Stretch image over background canvas - FImageCanvas.StretchDrawAlpha(FImage.BoundsRect, FBackCanvas, R, Filter); - - // Draw image to canvas (without conversion) using OS drawing functions. - // Note that DisplayImage only supports images in ifA8R8G8B8 format so - // if you have image in different format you must convert it or - // create standard TBitmap by calling ImagingComponents.ConvertImageToBitmap - ImagingComponents.DisplayImage(PaintBox.Canvas, PaintBox.BoundsRect, FBack); -end; - -procedure TMainForm.FillDefault; -begin - // Fill background canvas with default color - FBackCanvas.FillColor32 := FillColor; - FBackCanvas.FillRect(Rect(0, 0, FBack.Width, FBack.Height)); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77 Changes/Bug Fixes --------------------------------- - - Displays size of image in memory. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Displays image physical resolution if present. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Creates best canvas class for given image for faster - blending and scaling. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Added alpha blended drawing with optional filtered stretching. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added Save Image Copy button and related stuff. - - Added XP controls manifest (no TXPManifest since its not - in older Delphis). - - Wrong active image index was shown sometimes after several - clicks on Prev/Next buttons. - - Added First/Last subimage buttons. - - Original data format of subimages at index >1 is displayed right now - (was always A8R8G8B8) - - Space key now shows next subimage if multi-images is loaded. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added canvas usage too - - added support for viewing multiimages (like MNG) - - change drawing to use stuff from ImagingComponents unit instead of - converting to TBitmap - - changed demo to use high level interface instead of low level - -} - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/VampConvert/DemoUnit.pas b/components/vampireimaging/Demos/ObjectPascal/VampConvert/DemoUnit.pas deleted file mode 100644 index 7860193..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VampConvert/DemoUnit.pas +++ /dev/null @@ -1,417 +0,0 @@ -{ - Vampyre Imaging Library Demo - Vampyre Image Converter (core low level API) - - Image Converter is command line tool for converting images between - file and data formats. It also provides some basic manipulation functions - like resizing, rotating, or color reduction. - See PrintUsage procedure for usage details (or just run binary without parameters). - Note: Operations (change format, resize, rotate) are processed in the same order - as they appear on the command line. -} -unit DemoUnit; - -{$I ImagingOptions.inc} - -interface - -procedure RunDemo; - -implementation - -uses - SysUtils, - Classes, - ImagingTypes, - Imaging, - ImagingUtility; - -const - DefaultOutputFile = 'output.png'; - DefaultFileFormat = 'png'; - -var - InFile, OutFile: string; - Operations: TStringList; - -procedure PrintHeader; -begin - WriteLn('Vampyre Image Converter (library version ', Imaging.GetVersionStr, ')'); - WriteLn('by Marek Mauder'); - WriteLn; -end; - -procedure PrintUsage; -type - TFormatInfo = record - Ext: string; - CanSave: Boolean; - end; -var - I: LongInt; - FmtIter: TImageFormat; - Info: TImageFormatInfo; - Name, Ext, Masks: string; - CanSave, IsMulti: Boolean; - FileFormats: array of TFormatInfo; -begin - WriteLn('Usage:'); - WriteLn('VampConvert [-op=arg] [..] -infile=file.ext [..] [-outfile=file.ext] [-op=arg]'); - WriteLn(' Options:'); - WriteLn(' -infile | -i: specify input image file path'); - WriteLn(' -outfile | -o: specify output image file path'); - WriteLn(' argument: file path or "*.ext" where input file name will be used '); - WriteLn(' but with "ext" extension'); - WriteLn(' Operations:'); - WriteLn(' Note: they are processed in the same order as they appear on command line'); - WriteLn(' -format: changes data format of input images'); - WriteLn(' argument: name of data format supported by Imaging like A8R8G8B8'); - WriteLn(' -resize: changes size of input images'); - WriteLn(' argument: string in format AxBxC (%dx%dx%s) where A is desired'); - WriteLn(' width, B is desired height, and C is resampling filter used.'); - WriteLn(' If A or B is 0 then original dimension will be preserved.'); - WriteLn(' C is optional and can have one of following values: '); - WriteLn(' nearest(default), bilinear, bicubic.'); - WriteLn(' -flip: flips input images upside down'); - WriteLn(' -mirror: mirrors input images left to right'); - WriteLn(' -colorcount: reduces number of colors in image'); - WriteLn(' argument: number of desired colors (2-4096)'); - WriteLn(' -genmipmaps: generates mipmaps for main image'); - WriteLn(' argument: number of desired mip levels. 0 or no arg means'); - WriteLn(' create all possible levels'); - WriteLn(' -rotate: rotates input images counterclockwise'); - WriteLn(' argument: angle in degrees, multiple of 90'); - - // Enumerate all supported file formats and store default ext and - // their capability to save files to string list. - I := 0; - while EnumFileFormats(I, Name, Ext, Masks, CanSave, IsMulti) do - begin - SetLength(FileFormats, I); - FileFormats[I - 1].Ext := Ext; - FileFormats[I - 1].CanSave := CanSave; - end; - // Print all file formats that support loading files (just write all) - WriteLn; - WriteLn(' Supported file formats (INPUT):'); - for I := 0 to High(FileFormats) do - Write(FileFormats[I].Ext, ' '); - - WriteLn; - // Print all file formats that support saving files - WriteLn(' Supported file formats (OUTPUT):'); - for I := 0 to High(FileFormats) do - begin - if FileFormats[I].CanSave then - Write(FileFormats[I].Ext, ' '); - end; - - WriteLn; - // Iterate over all image data formats and write their names - Write(' Supported data formats: '); - for FmtIter := ifIndex8 to High(TImageFormat) do - begin - if Imaging.GetImageFormatInfo(FmtIter, Info) then - Write(Info.Name, ' '); - end; -end; - -procedure PrintError(const Msg: string; const Args: array of const); -begin - WriteLn(Format('Error: ' + Msg, Args)); - WriteLn; - PrintUsage; - Operations.Free; - Halt(1); -end; - -procedure PrintWarning(const Msg: string; const Args: array of const); -begin - WriteLn(Format('Warning: ' + Msg, Args)); -end; - -procedure PrintInfo(const Msg: string; const Args: array of const); -begin - WriteLn(Format('Info: ' + Msg, Args)); -end; - -procedure ParseCommandLine; -var - I: LongInt; - - procedure ParseOption(const Opt: string); - var - I: LongInt; - S, Arg: string; - begin - S := Opt; - I := Pos('=', S); - if I > 0 then - Arg := Copy(S, I + 1, MaxInt) - else - Arg := 'none'; - - Delete(S, I, MaxInt); - Delete(S, 1, 1); - S := LowerCase(S); - - if (S = 'infile') or (S = 'i') then - InFile := Arg - else if (S = 'outfile') or (S = 'o') then - OutFile := Arg - else - Operations.Add(Format('%s=%s', [S, LowerCase(Arg)])); - end; - -begin - for I := 1 to ParamCount do - ParseOption(ParamStr(I)); -end; - -procedure CheckOptions; -var - InFileName, InFileDir: string; -begin - // Check if input and input filenames are valid - if InFile = '' then - PrintError('Input file not specified', []); - - if not FileExists(InFile) then - PrintError('Input file not found: "%s"', [InFile]); - - if not Imaging.IsFileFormatSupported(InFile) then - PrintError('Input file format not supported: %s', [ImagingUtility.GetFileExt(InFile)]); - - if OutFile = '' then - begin - PrintWarning('Output file not specified, using default: %s (in current directory)', - [DefaultOutputFile]); - OutFile := DefaultOutputFile; - end; - - InFileName := ExtractFileName(InFile); - InFileDir := ExtractFileDir(InFile); - InFileDir := Iff(InFileDir <> '', PathDelim, InFileDir); - - // If outpout filename is in format "*.ext" then input filename is used - // but with "ext" extension - if ChangeFileExt(ExtractFileName(OutFile), '') = '*' then - OutFile := InFileDir + ChangeFileExt(InFileName, ExtractFileExt(OutFile)); - - if not Imaging.IsFileFormatSupported(OutFile) then - begin - PrintWarning('Output file format not supported, using default: %s', - [DefaultFileFormat]); - OutFile := InFileDir + ChangeFileExt(InFileName, '.' + DefaultFileFormat); - end; -end; - -procedure ProcessOperations; -var - I, J, X, Y, NewWidth, NewHeight: LongInt; - OpName, Arg, S: string; - Images: TDynImageDataArray; - Format: TImageFormat; - ResFilter: TResizeFilter; - MainImage: TImageData; - - procedure PrintInvalidArg(const OpName, Arg: string); - begin - PrintError('Invalid argument (%s) for operation: %s', [Arg, OpName]); - end; - - function FindFormat(const FmtString: string): TImageFormat; - var - I: TImageFormat; - Name: string; - begin - Result := ifUnknown; - for I := ifIndex8 to High(TImageFormat) do - begin - Name := Imaging.GetFormatName(I); - if SameText(FmtString, Name) or SameText(FmtString, 'if' + Name) then - begin - Result := I; - Exit; - end; - end; - end; - -begin - Operations.NameValueSeparator := '='; - InitImage(MainImage); - - try - // Load input image - if not Imaging.LoadMultiImageFromFile(InFile, Images) then - PrintError('Input file loading failed: %s', [ImagingUtility.GetExceptObject.Message]); - // Check if all loaded images are OK or if they are any at all - if (Length(Images) = 0) or not Imaging.TestImagesInArray(Images) then - PrintError('Input file loaded but it does not contain any images or some of them are invalid', []); - - PrintInfo('Input images (count: %d) loaded succesfully from: %s', [Length(Images), InFile]); - - // Now process operations one by one - for I := 0 to Operations.Count - 1 do - begin - // Get operation name and argument - OpName := Operations.Names[I]; - Arg := Operations.ValueFromIndex[I]; - - if OpName = 'format' then - begin - // Check if argument is name of some data format - Format := FindFormat(Arg); - if Format = ifUnknown then - PrintInvalidArg(OpName, Arg); - // If some format was found then all images are converted to it - PrintInfo('Converting images to data format: %s', [Imaging.GetFormatName(Format)]); - for J := 0 to High(Images) do - Imaging.ConvertImage(Images[J], Format); - end - else if OpName = 'resize' then - begin - // Parse argument in format %dx%d[x%s] - J := Pos('x', Arg); - if J = 0 then - PrintInvalidArg(OpName, Arg); - X := StrToIntDef(Copy(Arg, 1, J - 1), Images[0].Width); - Delete(Arg, 1, J); - J := Pos('x', Arg); - S := 'nearest'; - if J <> 0 then - begin - S := Copy(Arg, J + 1, MaxInt); - Delete(Arg, J, MaxInt); - end; - Y := StrToIntDef(Arg, 0); - // Limit new dimensions to 8192 and convert - // invalid dimensions are set to 0 which is special value (later) - X := ClampInt(X, 0, 8192); - Y := ClampInt(Y, 0, 8192); - // Select filtering method used for resizing according to argument - ResFilter := rfNearest; - if Pos('bil', S) = 1 then - ResFilter := rfBilinear - else if Pos('bic', S) = 1 then - ResFilter := rfBicubic; - - PrintInfo('Resizing images to %dx%d using [%s] filter: ', [X, Y, S]); - - for J := 0 to High(Images) do - begin - // If any of new dimensions is 0 we use the original dimension - // of image - NewWidth := Iff(X = 0, Images[J].Width, X); - NewHeight := Iff(Y = 0, Images[J].Height, Y); - Imaging.ResizeImage(Images[J], NewWidth, NewHeight, ResFilter); - end; - end - else if OpName = 'flip' then - begin - // Simply flip all images - PrintInfo('Flipping images upside down', []); - for J := 0 to High(Images) do - Imaging.FlipImage(Images[J]); - end - else if OpName = 'mirror' then - begin - // Simply mirror all images - PrintInfo('Mirroring images left to right', []); - for J := 0 to High(Images) do - Imaging.MirrorImage(Images[J]); - end - else if OpName = 'colorcount' then - begin - // Get value of the argument ... - if not TryStrToInt(Arg, X) then - PrintInvalidArg(OpName, Arg); - X := ClampInt(X, 2, 4096); - PrintInfo('Reducing color count of images to: %d', [X]); - // ... and reduce number of colors of all images - for J := 0 to High(Images) do - Imaging.ReduceColors(Images[J], X); - end - else if OpName = 'genmipmaps' then - begin - // Get number of mipmaps from argument or use - // default 0 which means "create all mip levels you can" - X := StrToIntDef(Arg, 0); - PrintInfo('Generating mipmaps for main image', []); - // Clone main image and use input array as the output of - // mipmap generation function - Imaging.CloneImage(Images[0], MainImage); - Imaging.GenerateMipMaps(MainImage, X, Images); - end - else if OpName = 'rotate' then - begin - // Parse argument, only multiples of 90 degrees are allowed - if not TryStrToInt(Arg, X) then - PrintInvalidArg(OpName, Arg); - if X mod 90 <> 0 then - PrintInvalidArg(OpName, Arg); - PrintInfo('Rotating images: %d degrees CCW', [X]); - // Rotate all - for J := 0 to High(Images) do - Imaging.RotateImage(Images[J], X); - end - else - begin - // Warn about unknown operations passed to program - PrintWarning('Unrecognized operation: ' + OpName, []); - end; - end; - - // Copy metadata if present - GlobalMetadata.CopyLoadedMetaItemsForSaving; - - // Finally save the result - if not Imaging.SaveMultiImageToFile(OutFile, Images) then - PrintError('Output file saving failed: %s', [ImagingUtility.GetExceptObject.Message]) - else - PrintInfo('Output images saved succesfully to: %s', [OutFile]) - finally - // Free images in array as well as temp image - Imaging.FreeImagesInArray(Images); - Imaging.FreeImage(MainImage); - end; -end; - -procedure RunDemo; -begin - PrintHeader; - Operations := TStringList.Create; - ParseCommandLine; - CheckOptions; - try - ProcessOperations; - except - PrintError('Exception raised during processing oprations: %s', - [ImagingUtility.GetExceptObject.Message]); - end; - Operations.Free; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - more operations - - allow changing ImagingOptions too - - rotations not only multipples of 90 - - -- 0.77.1 --------------------------------------------------- - - Refactored the demo (moved stuff to unit from dpr) and - added Lazarus project files. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - added -i and -o shortcut cmd line parameters and fixed - FPC 32/64 bit compatibility issue - - List of supported file formats printed by PrintUsage is now - dynamic and shows input and output formats separately - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - demo created -} - -end. diff --git a/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.dof b/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.dof deleted file mode 100644 index a4d1a69..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.dof +++ /dev/null @@ -1,117 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=0 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=..\..\Bin -UnitOutputDir=..\..\Bin\Dcu\Win32 -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common;..\..\..\Extras\Extensions\LibTiff -Conditionals=FULL_FEATURE_SET -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -Launcher= -UseLauncher=0 -DebugCWD= -[HistoryLists\hlConditionals] -Count=1 -Item0=FULL_FEATURE_SET -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=..\..\..\Source;..\..\..\Source\JpegLib;..\..\..\Source\ZLib;..\..\..\Extras\Extensions;..\Common;..\..\..\Extras\Extensions\LibTiff -[HistoryLists\hlOutputDirectorry] -Count=1 -Item0=..\..\Bin diff --git a/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.dpr b/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.dpr deleted file mode 100644 index d65f6d8..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.dpr +++ /dev/null @@ -1,17 +0,0 @@ -program VampConvert; - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$IFDEF MSWINDOWS} - {$APPTYPE CONSOLE} -{$ENDIF} - -uses - DemoUnit; - -begin - RunDemo; -end. - diff --git a/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.lpi b/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.lpi deleted file mode 100644 index f4819c3..0000000 --- a/components/vampireimaging/Demos/ObjectPascal/VampConvert/VampConvert.lpi +++ /dev/null @@ -1,79 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<CONFIG> - <ProjectOptions> - <Version Value="10"/> - <PathDelim Value="\"/> - <General> - <Flags> - <MainUnitHasUsesSectionForAllUnits Value="False"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <Title Value="VampConvert"/> - <UseAppBundle Value="False"/> - <ResourceType Value="res"/> - </General> - <i18n> - <EnableI18N LFM="False"/> - </i18n> - <BuildModes Count="1"> - <Item1 Name="Default" Default="True"/> - </BuildModes> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - </local> - </RunParams> - <Units Count="2"> - <Unit0> - <Filename Value="VampConvert.dpr"/> - <IsPartOfProject Value="True"/> - </Unit0> - <Unit1> - <Filename Value="DemoUnit.pas"/> - <IsPartOfProject Value="True"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="..\..\Bin\VampConvert"/> - </Target> - <SearchPaths> - <IncludeFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;$(ProjOutDir)"/> - <Libraries Value="..\..\..\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;..\..\..\Extras\Extensions\LibTiff;..\Common"/> - <UnitOutputDirectory Value="..\..\Bin\Dcu\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <SyntaxMode Value="Delphi"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-dFULL_FEATURE_SET"/> - </Other> - </CompilerOptions> - <Debugging> - <Exceptions Count="3"> - <Item1> - <Name Value="EAbort"/> - </Item1> - <Item2> - <Name Value="ECodetoolError"/> - </Item2> - <Item3> - <Name Value="EFOpenError"/> - </Item3> - </Exceptions> - </Debugging> -</CONFIG> diff --git a/components/vampireimaging/Doc/Common/bullet.png b/components/vampireimaging/Doc/Common/bullet.png deleted file mode 100644 index 1406348..0000000 Binary files a/components/vampireimaging/Doc/Common/bullet.png and /dev/null differ diff --git a/components/vampireimaging/Doc/Common/doc.css b/components/vampireimaging/Doc/Common/doc.css deleted file mode 100644 index 459ff46..0000000 --- a/components/vampireimaging/Doc/Common/doc.css +++ /dev/null @@ -1,457 +0,0 @@ -/************************************* - Main elements -**************************************/ - -body -{ - color: #000000; - font-family: Arial, Sans-serif; - font-size: 10pt; - margin-left: 12pt; - margin-top: 12pt; - text-align: left; -} - -/************************************* - Headers & Captions -**************************************/ - -.title -{ - display: block; - margin-bottom: 10pt; - font-size: 220%; - font-weight: bold; - font-style: normal; - color: Navy; - border-left-color: activecaption; - border-left-style: groove; - border-left-width: medium; - border-top: medium groove activecaption; - padding-left: 5pt; -} - -.subtopic1 -{ - display: block; - margin-top: 20pt; - margin-bottom: 6pt; - font-size: 160%; - font-weight: bold; - font-style: normal; - border: none; - border-top: medium groove activecaption; -} - -.subtopic2 -{ - display: block; - margin-top: 18pt; - margin-bottom: 6pt; - font-size: 125%; - font-weight: bold; - font-style: normal; - color: #000000; - border: none; -} - -.caption -{ - display: block; - margin-top: 12pt; - margin-bottom: 6pt; - font-size: 100%; - font-weight: bold; - font-style: normal; - border: none; -} - -/************************************* - Lists -**************************************/ - -ul, ol -{ - margin: 0pt; - padding: 0pt; -} - -.orderedlist -{ - display: block; - list-style: outside decimal; - font-weight: normal; - font-style: normal; - margin-top: 6pt; - margin-bottom: 3pt; - padding-left: 6pt; -} - -.bullet -{ - display: block; - list-style-image: url(bullet.png); - list-style-position: outside; - font-weight: normal; - font-style: normal; - margin-top: 6pt; - padding-left: 6pt; -} - -.list -{ - display: block; - list-style-type: none; - list-style-image: none; - list-style-position: outside; - font-weight: normal; - font-style: normal; - margin-top: 5pt; - margin-bottom: 5pt; - margin-left: 0pt; -} - -.li, li -{ - display: list-item; - color: black; - font-weight: normal; - list-style-position: outside; - font-size: 100%; - margin-top: 0pt; - margin-bottom: 3pt; - margin-left: 24pt; -} - -.tasklist -{ - display: block; - list-style: decimal outside; - font-weight: normal; - font-style: normal; -} - -/************************************* - Menues -**************************************/ - -.menupath -{ - color: #4682B4; -} - -.menuitem -{ - color: #4682B4; - font-weight: bold; -} - -/************************************* - Tip, Note, Warning -**************************************/ - -.ntwpara -{ - display: inline; - font-weight: normal; - font-style: normal; - margin-left: 3pt; - color: black; -} - -.tip -{ - display: block; - font-weight: bold; - font-style: normal; - margin-top: 8pt; - margin-bottom: 8pt; - list-style-position: outside; - list-style-type: none; - margin-left: 23pt; - text-indent: -24pt; -} - -.note -{ - display: block; - font-weight: bold; - font-style: normal; - margin-top: 8pt; - margin-bottom: 8pt; - list-style-position: outside; - list-style-type: none; - margin-left: 29pt; - text-indent: -31pt; - color: Navy; -} - -.warning -{ - display: block; - font-weight: bold; - font-style: normal; - margin-top: 8pt; - margin-bottom: 8pt; - list-style-position: outside; - list-style-type: none; - margin-left: 47pt; - text-indent: -49pt; - color: #B22222; -} - -/************************************* - Syntax & Code -**************************************/ - -.keyword -{ - font-size: 100%; - font-weight: bold; - font-family: Courier New, Courier; -} - -.keyboard -{ - font-size: 83%; - font-family: Arial; - font-style: normal; - color: #767676; - text-transform: uppercase; -} - -.codeinline, .keyinput -{ - font-size: 100%; - font-weight: normal; - font-style: normal; - color: #001095; - font-family: Courier New, Courier; -} - -.syntax -{ - font-size: 100%; - color: #001095; - font-family: Courier New, Courier; - margin-top: 3pt; - margin-bottom: 0pt; - padding-top: 3pt; - padding-left: 5pt; - padding-right: 5pt; - padding-bottom: 3pt; - background-color: #F5F5F5; - overflow: visible; - visibility: visible; -} - -/************************************* - Links -**************************************/ - -a -{ - text-decoration: none; -} - -.linklist -{ - display: block; - margin-top: 12pt; - margin-bottom: 8pt; - font-weight: bold; - font-size: 100%; - color: Navy; -} - -.listedlink -{ - color: blue; - font-weight: normal; - font-size: 100%; -} - -.linklistitem -{ - display: list-item; - list-style-type: none; - margin-top: 1pt; - margin-left: 24pt; -} - -.listedlink a -{ - color: blue; - font-weight: normal; - font-size: 100%; - text-decoration: underline; -} - -.link a -{ - display: inline; - text-decoration: none; - color: #316AC5; - border-bottom: 0.5pt dashed #B0C4DE; - padding-bottom: 0.35pt; -} - -/************************************* - Images -**************************************/ - -.imageblock -{ - display: block; - margin-left: 18pt; - margin-top: 12pt; - margin-bottom: 12pt; -} - -.imageinline -{ - display: inline; -} - -/************************************* - Tables -**************************************/ - -.tabletitle -{ - font-size: 90%; - font-weight: bold; - font-style: italic; - display: inline; - margin-top: 6pt; -} - -.table -{ - display: table; - font-size: 93%; - font-weight: normal; - text-align: left; - margin-top: 3pt; - margin-bottom: 10pt; - border-top: 1.25pt solid Silver; - border-bottom: 1.25pt solid Silver; -} - -.tablepara -{ - display: block; - margin-top: 1pt; - margin-bottom: 1pt; - font-size: 100%; - margin-left: 3pt; - margin-right: 3pt; -} - -.tr -{ - display: table-row; - vertical-align: top; -} - -.th -{ - vertical-align: bottom; - font-weight: bold; - display: table-cell; - padding-left: 4pt; - font-size: 100%; -} - -.td -{ - display: table-cell; - vertical-align: top; - border-top: 1pt solid Silver; -} - -/************************************* - Other -**************************************/ - -.para -{ - display: block; - margin-top: 6pt; - margin-bottom: 6pt; - font-size: 100%; - font-weight: normal; - font-style: normal; - color: #000000; -} - -.s -{ - display: block; - margin-bottom: 2pt; -} - -.footer -{ - border-top: 1px solid silver; - display: block; - font-size: 80%; -} - -/************************************* - TOC -**************************************/ - -.tocbody -{ - margin-left: -12pt; - margin-top: -6pt; -} - -.toctitle -{ - margin: 5pt; - font-size: 120%; - display: block; - text-align: center; - font-weight: bold; -} - -.toc a -{ - color: blue; -} - -.toc a:hover -{ - color: #FFFFFF; - background-color: #C23333; -} - -.toc ul -{ - display: block; - list-style-image: none; - list-style-type: none; - list-style-position: outside; - margin-top: 1pt; - margin-bottom: 2pt; - margin-left: 0pt; - border-left: solid 1px #F0F0F0; -} - -.toc li -{ - list-style-image: url(path.png); - margin-top: 0pt; - margin-bottom: 1pt; - margin-left: 16pt; -} - - - - - - - - diff --git a/components/vampireimaging/Doc/Common/imaging.ico b/components/vampireimaging/Doc/Common/imaging.ico deleted file mode 100644 index c886676..0000000 Binary files a/components/vampireimaging/Doc/Common/imaging.ico and /dev/null differ diff --git a/components/vampireimaging/Doc/Common/logo.png b/components/vampireimaging/Doc/Common/logo.png deleted file mode 100644 index 25d5f91..0000000 Binary files a/components/vampireimaging/Doc/Common/logo.png and /dev/null differ diff --git a/components/vampireimaging/Doc/Common/path.png b/components/vampireimaging/Doc/Common/path.png deleted file mode 100644 index 6ce8794..0000000 Binary files a/components/vampireimaging/Doc/Common/path.png and /dev/null differ diff --git a/components/vampireimaging/Doc/ImagingOnlineDocs.url b/components/vampireimaging/Doc/ImagingOnlineDocs.url deleted file mode 100644 index 8bc6d7f..0000000 --- a/components/vampireimaging/Doc/ImagingOnlineDocs.url +++ /dev/null @@ -1,2 +0,0 @@ -[InternetShortcut] -URL=http://galfar.vevb.net/imaging/doc/imaging.html \ No newline at end of file diff --git a/components/vampireimaging/Doc/Readme.txt b/components/vampireimaging/Doc/Readme.txt deleted file mode 100644 index 3f86d65..0000000 --- a/components/vampireimaging/Doc/Readme.txt +++ /dev/null @@ -1,7 +0,0 @@ -Vampyre Imaging Library -http://imaginglib.sourceforge.net - -version 0.26.4 (11th October 2009) - -If you are looking for some information open imaging.html or Imaging*.chm or look -at library's homepage. \ No newline at end of file diff --git a/components/vampireimaging/Doc/VampyreDoc/Contents.xml b/components/vampireimaging/Doc/VampyreDoc/Contents.xml deleted file mode 100644 index ced146d..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Contents.xml +++ /dev/null @@ -1,117 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<?xml-stylesheet type="text/xsl" href="Xsl/toc2html.xsl"?> -<toc> - <title>Table Of Contents - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/DataFormats/DataFormats.xml b/components/vampireimaging/Doc/VampyreDoc/DataFormats/DataFormats.xml deleted file mode 100644 index afcbdc7..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/DataFormats/DataFormats.xml +++ /dev/null @@ -1,332 +0,0 @@ - - - - Supported Data Formats - - Supported Data Formats - Image data format is the internal memory representation of every image. - Data formats are described by TImageFormat enumeration - member of TImageData structure. - Additional information about each of the data formats is stored in - TImageFormatInfo structure. - - - Functions related to data formats (low level interface) - -
Function name
-
Usage
- - - GetImageFormatInfo - Returns additional information about the given data format - - - GetPixelsSize - Returns number of bytes occupied by Width x Height area of pixels in the given data format - (works for all data formats) - - - GetFormatName - Returns symbolic name of the given data format - - - ConvertImage - Converts images between different data formats - - - NewImage - Creates new image with the given data format - -
- - Data Format Categories - - Image data formats can be divided to these main categories: - -
  • ARGB Formats
    - Each pixel consists of several color channels and - optional alpha transparency channel. -
    • -
  • Indexed Formats
    - Each pixel is index to the array of colors called the palette. -
    • -
  • Grayscale Formats
    - Pixels consist of intensity channel and optional alpha transparency channel. -
    • -
  • Floating-point ARGB Formats
    - These formats are similar to ARGB formats but color values are stored - as floating-point numbers. -
    • -
  • Special Formats
    - Each special format requires special and unique conversion - procedures. Compressed formats like DXTC belong to this category. -
    • -     - - Meaning of Data Format Symbolic Names - - Each data format has its symbolic name. - These names are formed in the way which tells something about - its internal structure. Symbolic names look like this:

    -
    if[(channel1)(channel1sizebits)]..[(channeln)(channelnsizebits)][modifier1]..[modifiern]
    -
    - For example ifA8R8G8B8 shows that each image pixel - contains four 8 bit sized channels. - ifR32F format contains one 32 bit channel and F - modifier indicates that this is floating-point format. - All channels in the symbolic names are listed from left to right, - most significant bit (MSB) to least significant bit (LSB). - For example, ifA8R8G8B8 is ordered from the MSB channel - A (alpha), to the LSB channel B (blue). - When traversing image data on little endian machines, - the data is stored in memory from LSB to MSB, which means that the channel order in memory is - from LSB (blue) to MSB (alpha).
    - Special data format names do not follow this naming convention. - Their symbolic names refer for example to compression technology used - (ifDXT5 is data format of image compressed with DXT5). - -     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Symbolic Name FragmentInfoXUnused memory spaceRRed color channelGGreen color channelBBlue color channelAAlpha transparency channelIndexIndex to paletteGrayGrayscale intensity channelFIndicates that this format stores channel values as - floating point numbers
    - - ARGB Formats - The following table lists all ARGB formats supported in the current - version of Imaging library. Channel values are stored as unsigned - integers. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Symbolic NameInfoifX5R1G1B18 bit format with one bit for each color channel. 5 bits are unused.ifR3G3B28 bit format with 3 bits for read and green and 2 bits for blue channel.ifR5G6B516 bit format with 5 bits for read and blue and 6 bits for green channel.ifA1R5G5B516 bit format with 5 bits for each color and one bit for alpha.ifA4R4G4B416 bit format with 4 bits for each color and alpha.ifX1R5G5B516 bit format with 5 bits for each color and one unused bit.ifX4R4G4B416 bit format with 4 bits for each color and 4 unused bits.ifR8G8B824 bit format with 8 bits for each color.ifA8R8G8B832 bit format with 8 bits for each color and alpha.ifX8R8G8B832 bit format with 8 bits for each color and 8 unused bits.ifR16G16B1648 bit format with 16 bits for each color.ifA16R16G16B1664 bit format with 16 bits for each color and alpha.ifB16G16R1648 bit BGR format with 16 bits for each color.ifA16B16G16R1664 bit BGR format with 16 bits for each color and alpha.
    - - - Indexed Formats - The following table lists all indexed formats supported in the current - version of Imaging library. Indexes are stored as unsigned - integers. Palette is PPalette32 member of TImageData - structure. It is a pointer to array of 32 bit ARGB values in - ifA8R8G8B8 format. - - - - - - - - - - -
    Symbolic NameInfoifIndex88 bit format with 8 bits for index.
    - - Grayscale Formats - The following table lists all grayscale formats supported in the current - version of Imaging library. - Channels values are stored as unsigned integers. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Symbolic NameInfoifGray88 bit format with 8 bits for grayscale intensity.ifA8Gray816 bit format with 8 bits for alpha transparency and - 8 bits for grayscale intensity.ifGray1616 bit format with 16 bits for grayscale intensity.ifGray3232 bit format with 32 bits for grayscale intensity.ifGray6464 bit format with 64 bits for grayscale intensity.ifA16Gray1632 bit format with 16 bits for alpha transparency and - 16 bits for grayscale intensity.
    - - Floating-point ARGB Formats - The following table lists all floating-point formats supported in the current - version of Imaging library. - Channels values are stored as signed floating-point numbers. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Symbolic NameInfoifR32F32 bit format with one red 32 bit IEEE-754 channel.ifA32R32G32B32F128 bit format with 32 bit IEEE-754 channel for each color and alpha.ifA32B32G32R32F128 bit BGR format with 32 bit IEEE-754 channel for each color and alpha.ifR16F16 bit format with one red 16 bit half-float (s1e5m10) channel.ifA16R16G16B16F64 bit format with 16 bit half-float (s1e5m10) channel for each color and alpha.ifA16B16G16R16F64 bit BGR format with 16 bit half-float (s1e5m10) channel for each color and alpha.
    - - Special Formats - The following table lists all special formats supported in the current - version of Imaging library. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Symbolic NameInfoifDXT1Image in this format is compressed with DXT1 compression - (15/16 bit interpolated color, zero or one bit alpha).ifDXT3Image in this format is compressed with DXT3 compression - (16 bit interpolated color, 4 bit explicit alpha).ifDXT5Image in this format is compressed with DXT5 compression - (16 bit interpolated color, 8 bit interpolated alpha).ifBTCImage in this format is compressed with BTC compression - (block truncation coding, grayscale, 2bits per pixel).ifATI1NImage in this format is compressed using 3Dc+ compression - (one channel, 4bits per pixel).ifATI2NImage in this format is compressed using original 3Dc compression - (two channels, 8bits per pixel).
    - - There maybe some legal issues when using DXTC/S3TC compression - (3Dc probably too as it is "subset" of DXT5) as S3 holds patent to this. - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/Cpp.xml b/components/vampireimaging/Doc/VampyreDoc/Demos/Cpp.xml deleted file mode 100644 index 76f24cb..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Demos/Cpp.xml +++ /dev/null @@ -1,124 +0,0 @@ - - - - C/C++ Demos - - C/C++ Demos - These C/C++ demos currently exist: - -
  • Benchmark
    • -
  • Small Test
    • -     - - If you want to use Imaging in C/C++ you must include - ImagingImport.h header and link compiled - ImagingImport.c file (both located in - Source\Wrappers\Cpp directory) - and for C++ use namespace - Imaging. You must call ImLoadLibrary - before usage of any Imaging functions and you must call - ImFreeLibrary when you don't want to use library anymore. - - - All non-Object Pascal programs using Imaging require VampyreImaging.dll - (Windows) or libVampyreImaging.so (Linux) to run. - Compiled Imaging library must be located somewhere on system's - search path for these demos to work. - - - - - Benchmark - - This is not actually benchmark like Object Pascal - version because - all measured functions are called from external library, but it - shows how to use Imaging dll from C/C++ at least. - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameBenchmarkLanguageC++Source Path(Imaging Root)\Demos\Cpp\BenchmarkExe Path(Imaging Root)\Demos\Bin\BenchCpp.exePlatforms (tested)Win32Compilers (tested)MSVC 8.0 W, GCC 3.4.2 WDemo shows usage oflow level (using dyn. library wrapper)
    - - - For details look at Object Pascal - version. There are only two - differences: - -
  • Log file with result is called Results.Cpp.
    • -
  • - Executable must be located - in Demos\Bin or anywhere in the subdirectories of Demos\Cpp dir to - be able to find used data files.
    • -     - - Small Test - - Simple test program that shows how to use Imaging library from C/C++ - environment. - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameSmall TestLanguageC/C++Source Path(Imaging Root)\Demos\Cpp\TestExe Path(Imaging Root)\Demos\Bin\test[.exe]Platforms (tested)Win32, LinuxCompilers (tested)MSVC 8.0 W, GCC 3.4.2 WLImaging interfacelow level (using dyn. library wrapper)
    - - - Test image is created and diagonal line is drawn across it. - Then it is saved to ctestimage.png file. -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/Delphi.NET.xml b/components/vampireimaging/Doc/VampyreDoc/Demos/Delphi.NET.xml deleted file mode 100644 index 9782d1c..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Demos/Delphi.NET.xml +++ /dev/null @@ -1,79 +0,0 @@ - - - - Delphi.NET Demos - - Delphi.NET Demos - These Delphi.NET demos currently exist: - -
  • Demo 01
    • -     - - - If you want to use Imaging in Delphi.NET you must include - ImagingNET.pas (located in - Source\Wrappers\Delphi.NET directory) - unit to your uses clause. - You can use Imaging class which encapsulates - imported functions and uses more dotNET-like names and types or - functions directly imported from dll. There are also some - dotNET only functions and extensions (for example color records like - TColor32Rec and others have various conversion methods and - some overloaded operators). - Only tested compiler for dotNET demos is Delphi 2006 but - Delphi 8/2005/Turbo.NET should work too. Imaging .NET demos work - in Mono too. - - - All non-Object Pascal programs using Imaging require VampyreImaging.dll - (Windows) or libVampyreImaging.so (Linux) to run. - Compiled Imaging library must be located somewhere on system's - search path for these demos to work. - - - - - Demo 01 - - Simple image viewer program demonstrating usage of Imaging library - in Delphi.NET. - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameDemo 01LanguageDelphi.NETSource Path(Imaging Root)\Demos\Delphi.NET\Demo01Exe Path(Imaging Root)\Demos\Bin\Demo01.exePlatforms (tested).NET on Win32Compilers (tested)Delphi 2006 (.NET)Demo shows usage oflow level (using dyn. library wrapper)
    - - It loads image stored in one of file formats - supported by Imaging library and assigns it to PictureBox component. - You can get some information about loaded image by clicking on PictureBox. - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/Demos.xml b/components/vampireimaging/Doc/VampyreDoc/Demos/Demos.xml deleted file mode 100644 index 18e0f4d..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Demos/Demos.xml +++ /dev/null @@ -1,30 +0,0 @@ - - - - Demos - - Demos - - Here you can find some information on programs that - demostrate usage and capabilities of Imaging library. - They are divided by languages they are written in. - There is short information about what each demo demostrates, - supported compilers and platforms etc. - - - C++ and .NET demos are no longer maintained. - - - In This Section - Object Pascal Demos - Delphi.NET Demos - C/C++ Demos - - - - You can also find some additional unofficial demos in Extras package. - Those are not covered here but they should should contain desciptions - and comments. - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/Pascal.xml b/components/vampireimaging/Doc/VampyreDoc/Demos/Pascal.xml deleted file mode 100644 index 8ce4e40..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Demos/Pascal.xml +++ /dev/null @@ -1,520 +0,0 @@ - - - - Object Pascal Demos - - Object Pascal Demos - These Object Pascal demos currently exist: - -
  • Benchmark
    • -
  • VCL Image Browser
    • -
  • LCL Imager
    • -
  • VampConvert
    • -
  • OpenGL Demo
    • -
  • Direct3D 9 Demo
    • -
  • SDL Demo
    • -     - - - If you have paths to compilers properly set you can build basic demos at - once by calling build scripts named BuildDemos*.bat - for Windows and DOS and BuildDemos*.sh for Linux. - They are located in Scripts directory and compiled demos will be - placed in Demos/Bin directory. - Demos of Imaging extensions (like OpenGL support) - which require 3rd party units (like OpenGL headers) - can be compiled using BuildExtDemos*.bat and - BuildExtDemos*.sh scripts. Remember that you must - first set paths to required headers in these scripts for them to - work. - - - - Some demos from older Imaging releases were removed. DXTTool has been - replaced by VampConvert. HighLevel was there to show how to use - high level interface (class based) which is now used by - nearly all demos so HighLevel is no longer necessary. - - - - - Benchmark - - Simple program which measures time taken by the main Imaging functions - (loading, manipulation, saving) in microsecond resolution. - You can use it to compare the speeds of executables created by the supported - compilers - (you can find results for my machine in BenchmarkResults directory). - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameBenchmarkLanguageObject PascalSource Path(Imaging Root)\Demos\ObjectPascal\BenchmarkExe Path(Imaging Root)\Demos\Bin\Bench[.exe]Platforms (tested)Windows, Linux, FreeBSDCompilers (tested)Delphi 7/2007/2009/2010 W - Free Pascal 2.2.4 WLBDDemo shows usage oflow level
    - - Benchmark first loads images (one for each supported and registered - file format) - and then calls various image manipulation functions on them. - Finally, images are saved and log file (with time consumption of - each action) is written. You can change behaviour of program by - commenting/uncommenting two defines: - -
  • LOG_TO_FILE If defined log is written to file (ResultsPas.log - in the directory where executable is located), otherwise it is - written to console.
    • -
  • SAVE_IMAGES_TO_FILES If not defined, modified - images are saved only to memory and taken time is measured. - If defined, these images are saved to files - after measurement.
    • -     - - Also note these things before running this demo: - -
  • During the test large amounts of memory can be allocated by - the program (e.g. conversion from 3000x3000x64 bit image to 128 bit requires - over 200 MB of memory).
    • -
  • Program's executable must be located in Demos, - Demos\SomeDir or Demos\SomeDir1\SomeDir2 to be able to find used data - files.
    • -     - - - VCL Image Browser - - - This simple viewer application shows usage of high level class interface - to Imaging library and also drawing images onto standard VCL TCanvas. - TImagingCanvas class is also used here. - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameVCL Image BrowserLanguageObject PascalSource Path(Imaging Root)\Demos\ObjectPascal\VCLImageBrowserExe Path(Imaging Root)\Demos\Bin\ImgBrowser.exePlatforms (tested)Win32Compilers (tested)Delphi 7/2007/2009/2010 WDemo shows usage ofhigh level/component sets/canvas
    - - - In the left part of the window is shell tree view component. Here you can - select files located in your computer. If the selected file is in one of the - supported formats it is displayed in the viewer - area and some information about the file is displayed in the info area. - If image file contains subimages you can view them too. Select active subimage - by clicking on buttons with arrows (Previous/Next or First/Last). There is also Save Image Copy - button that allows you to save copy (that is used for display, in A8R8G8B8) - of currently selected image to file. - - - When supported file is selected in shell tree view it is loaded to - TMultiImage and converted to ifA8R8G8B8 - data format. - Active subimage is then drawn - (with alpha blending if there is a alpha channel present - - methods of TImagingCanvas are used) on background - image (filled with back color). - Final blended image is then drawn into - TPainBox component's - client area using DisplayImage procedure (direct bit copy, no need to - convert Imaging's data to TGraphic). - Image is rescaled to fit the whole display area and - there is optional bicubic filtering (nearest neighbor is used when disabled). - - - - - LCL Imager - - - Simple image manipulator program which shows usage of Imaging - LCL classes (TImagingGraphic and - its descendants) to display images on the form. - It also uses high level image classes and low level functions. - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameLCL ImagerLanguageObject PascalSource Path(Imaging Root)\Demos\ObjectPascal\LCLImagerExe Path(Imaging Root)\Demos\Bin\LCLImager.exePlatforms (tested)Windows, Linux, FreeBSDCompilers (tested)Lazarus 0.9.28 WLB interfaces: Win32/64, GTK/GTK2, Qt, CarbonDemo shows usage ofhigh level/component sets/canvas
    - - - Demo uses TMultiImage class to store images - (loaded from one file so its usually only one for most formats with - exceptions like MNG and DDS) - which can be modified by user. After each modification image - is assigned to TImagingBitmap class which provides visualization - on the app form (using standard TImage component). - Demo also uses new TImagingCanvas class to do some effects. - - - In File menu you can open new image and save the - current one. Items in View menu provide - information about the current image and controls how it is displayed. - You can also select next and previous subimage if loaded file - contains more than one image. - Format menu allows you to convert image - to different image data formats supported by Imaging. Manipulate - menu allows you to enlarge/shrink/flip/mirror/swap channels/reduce colors - of the current image. - Linear Filters menu allows you to apply various linear filters - to the image like bluring, sharpening, - or edge detection. - Nonlinear Filters menu allows you to apply nonlinear filters - like median or maximum. - Using operations in Point Transforms menu you can - adjust image contrast, brightness, or gamma. - Filters and point transforms are provided by TImagingCanvas. - Binary Morphology menu provides image segmentation - functions using basic morphology operators (unit ImagingBinary). - Colors menu allows user to - set the value of specific color/alpha channel of all image pixels. - There is also option to show histogram of current image (R, G, B, and Gray - values displayed). - - - - - VampConvert - - Image Converter is command line tool for converting images between - file and data formats. It also provides some basic manipulation functions - like resizing, rotating, or color reduction. - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameVampConvertLanguageObject PascalSource Path(Imaging Root)\Demos\ObjectPascal\VampConvertExe Path(Imaging Root)\Demos\Bin\VampConvert[.exe]Platforms (tested)Windows, Linux, FreeBSDCompilers (tested)Delphi 7/2007/2009/2010 W, - Free Pascal 2.2.4 WLBDDemo shows usage oflow level
    - - - Here is usage information with possible command switches and parameters - (as printed by demo if invalid input is given): - - -Vampyre Image Converter (library version 0.26.0) -by Marek Mauder - -Error: Input file not specified - -Usage: -VampConvert [-op=arg] [..] -infile=file.ext [..] [-outfile=file.ext] [-op=arg] - Options: - -infile | -i: specify input image file path - -outfile | -o: specify output image file path - argument: file path or "*.ext" where input file name will be used - but with "ext" extension - Operations: - Note: they are processed in the same order as they appear on command line - -format: changes data format of input images - argument: name of data format supported by Imaging like A8R8G8B8 - -resize: changes size of input images - argument: string in format AxBxC (%dx%dx%s) where A is desired - width, B is desired height, and C is resampling filter used. - If A or B is 0 then original dimension will be preserved. - C is optional and can have one of following values: - nearest(default), bilinear, bicubic. - -flip: flips input images upside down - -mirror: mirrors input images left to right - -colorcount: reduces number of colors in image - argument: number of desired colors (2-4096) - -genmipmaps: generates mipmaps for main image - argument: number of desired mip levels. 0 or no arg means - create all possible levels - -rotate: rotates input images counterclockwise - argument: angle in degrees, multiple of 90 - - Supported file formats (INPUT): -bmp jpg png mng jng gif dds tga pbm pgm ppm pam pfm jp2 psd pcx xpm bsi cif img -dagtexture - Supported file formats (OUTPUT): -bmp jpg png mng jng gif dds tga pgm ppm pam pfm jp2 psd cif img - Supported data formats: Index8 Gray8 A8Gray8 Gray16 Gray32 Gray64 A16Gray16 X5 -R1G1B1 R3G3B2 R5G6B5 A1R5G5B5 A4R4G4B4 X1R5G5B5 X4R4G4B4 R8G8B8 A8R8G8B8 X8R8G8B -8 R16G16B16 A16R16G16B16 B16G16R16 A16B16G16R16 R32F A32R32G32B32F A32B32G32R32F - R16F A16R16G16B16F A16B16G16R16F DXT1 DXT3 DXT5 BTC ATI1N ATI2N - - - - Operations (change format, resize, rotate) are processed in the same order - as they appear on the command line. - - - - OpenGL Demo - - - Demo that shows how to create OpenGL textures from files - and Imaging's images and vice versa. - This demo requires OpenGL drivers and - SDL installed to run and requires - Object Pascal headers to compile. - - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameOpenGL DemoLanguageObject PascalSource Path(Imaging Root)\Demos\ObjectPascal\OpenGLDemoExe Path(Imaging Root)\Demos\Bin\OpenGLDemo[.exe]Platforms (tested)Win32, LinuxCompilers (tested)Delphi 7/2007/2009/2010 WFPC 2.2.4 WLDemo shows usage oflow level/OpenGL extension
    - - - This sample uses SDL to create - window and process messages. Background and sprite textures are loaded from - files and rendered. Sprite is mapped on the spinning cube in the - center of the window. - You can change sprite's texture format by pressing SPACE key - (it cycles trough all TImageFormat values). - Screehshot - can be saved to file by pressing S key and sprite texture - can be saved by pressing D key. - - - - - Direct3D 9 Demo - - - Demo that shows how to create Direct3D 9 textures - from files and Imaging's images and vice versa. - This demo requires Direct3D 9.0 and - SDL installed to run and requires - Object Pascal headers to compile. - - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameD3D DemoLanguageObject PascalSource Path(Imaging Root)\Demos\ObjectPascal\D3DDemoExe Path(Imaging Root)\Demos\Bin\D3DDemo.exePlatforms (tested)Win32Compilers (tested)Delphi 7/2007/2009/2010 W, FPC 2.0.4 WDemo shows usage oflow level/D3D9 extension
    - - - This sample uses SDL to create - window and process messages. Background and sprite textures are loaded from - files and rendered. Sprite is rendered in each corner of the window - using various texture stage and blending settings. - You can change sprite's texture format by pressing SPACE key - (it cycles trough all TImageFormat values). Screehshot can be - saved to file by pressing S key and sprite texture - can be saved by pressing D key. - - - - - - SDL Demo - - - Demo that shows how to create SDL surfaces from Imaging's - images and vice versa. - This demo requires SDL installed to run and requires - Object Pascal headers to compile. - - - - - Demo Information - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameSDL DemoLanguageObject PascalSource Path(Imaging Root)\Demos\ObjectPascal\SDLDemoExe Path(Imaging Root)\Demos\Bin\SDLDemo[.exe]Platforms (tested)Win32, LinuxCompilers (tested)Delphi 7/2007/2009/2010 W, FPC 2.2.4 WLDemo shows usage oflow level/SDL extension
    - - - SDL window is opened and background - and sprite surfaces are loaded and blitted to window. You can change - sprite's data format by pressing SPACE key (it cycles trough all - TImageFormat values) and toggle alpha blending (working only - when sprite's current format has alpha channel) and color keying. - Sprite can be moved across the screen using arrow keys. - Screenshots can also be taken. Status of the sprite - and list of active keys are shown in the console window (but SDL - window must have focus for the key input to be recognized). - - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/d3ddemo.jpg b/components/vampireimaging/Doc/VampyreDoc/Demos/d3ddemo.jpg deleted file mode 100644 index 43b4adc..0000000 Binary files a/components/vampireimaging/Doc/VampyreDoc/Demos/d3ddemo.jpg and /dev/null differ diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/dotnetdemo01.png b/components/vampireimaging/Doc/VampyreDoc/Demos/dotnetdemo01.png deleted file mode 100644 index 2b04acc..0000000 Binary files a/components/vampireimaging/Doc/VampyreDoc/Demos/dotnetdemo01.png and /dev/null differ diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/imgbrowser.jpg b/components/vampireimaging/Doc/VampyreDoc/Demos/imgbrowser.jpg deleted file mode 100644 index 882a841..0000000 Binary files a/components/vampireimaging/Doc/VampyreDoc/Demos/imgbrowser.jpg and /dev/null differ diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/lclimager.jpg b/components/vampireimaging/Doc/VampyreDoc/Demos/lclimager.jpg deleted file mode 100644 index 54cc63d..0000000 Binary files a/components/vampireimaging/Doc/VampyreDoc/Demos/lclimager.jpg and /dev/null differ diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/opengldemo.jpg b/components/vampireimaging/Doc/VampyreDoc/Demos/opengldemo.jpg deleted file mode 100644 index 08f8df5..0000000 Binary files a/components/vampireimaging/Doc/VampyreDoc/Demos/opengldemo.jpg and /dev/null differ diff --git a/components/vampireimaging/Doc/VampyreDoc/Demos/sdldemo.jpg b/components/vampireimaging/Doc/VampyreDoc/Demos/sdldemo.jpg deleted file mode 100644 index e8c50c1..0000000 Binary files a/components/vampireimaging/Doc/VampyreDoc/Demos/sdldemo.jpg and /dev/null differ diff --git a/components/vampireimaging/Doc/VampyreDoc/Documentation.xml b/components/vampireimaging/Doc/VampyreDoc/Documentation.xml deleted file mode 100644 index c42f70b..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Documentation.xml +++ /dev/null @@ -1,23 +0,0 @@ - - - - Documentation - - Documentation - This section contains hand-written (keyboard-typed) - Imaging library documentation. - - In This Section - Introduction - Using Library - Extensions - How To ... - Supported Data Formats - Supported File Formats - Demos - - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Extensions/Direct3D.xml b/components/vampireimaging/Doc/VampyreDoc/Extensions/Direct3D.xml deleted file mode 100644 index 945ca01..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Extensions/Direct3D.xml +++ /dev/null @@ -1,66 +0,0 @@ - - - - Direct3D Textures - - Direct3D Textures - - This extensions contains functions for loading and saving - Direct3D textures - using Imaging and for converting images to textures and vice versa. - Currently supported Direct3D version is 9.0. - You need Direct3D headers for - Object Pascal to be able to compile this extension. - They can be found at http://www.clootie.ru. - Extension does not require D3DX library so if you use it - only for loading or saving textures you can replace it by Imaging - and remove dependency on 2+ MiB dll file. - It is implemented in ImagingDirect3D9.pas unit located - in (ImagingRoot)\Source\Extensions directory. - To use it simply add this unit to uses list of your program. - Currently only 2D textures are supported, DXTC/S3TC and 3Dc compressed, and - floating point textures are created if supported by hardware. - - - - Here is the table with Direct3D functions - currently available. - There is also Imaging Direct3D demo you can look at - for inspiration Object Pascal Direct3D Demo. - - - - Imaging Direct3D extension functions - - - - - - - - - - - - - - - - - - - - -
    Loading FunctionsLoadD3DTextureFromFileLoadD3DTextureFromStreamLoadD3DTextureFromMemorySaving FunctionsSaveD3DTextureToFileSaveD3DTextureToStreamSaveD3DTextureToMemoryConversion FunctionsCreateD3DTextureFromImageCreateD3DTextureFromMultiImageCreateD3DSurfaceFromImageCreateImageFromD3DTextureCreateMultiImageFromD3DTextureCreateImageFromD3DSurfaceOther FunctionsGetDeviceTextureCapsIsD3DFormatSupportedImageFormatToD3DFormatD3DFormatToImageFormat
    - - - LoadD3DTextureFromFile and similar functions use - these default values: All mipmap levels are created, Pool - is D3DPOOL_MANAGED, Usage is 0, Format and size are taken from image. - If you want to set those parameters to other values use - CreateD3DTextureFromImage or CreateD3DTextureFromMultiImage - instead. - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Extensions/ExtFileFormats.xml b/components/vampireimaging/Doc/VampyreDoc/Extensions/ExtFileFormats.xml deleted file mode 100644 index f0c488e..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Extensions/ExtFileFormats.xml +++ /dev/null @@ -1,70 +0,0 @@ - - - - File Format Extensions - - File Format Extensions - - These extensions allow Imaging to load and save images from/to - files in various formats. - File formats included in Imaging core (that is in - Source directory) must satisfy these requirements: - both loading and saving support, native crossplatform - Object Pascal implementation, support as many data formats as possible, - be stream safe (you have multiple images in one stream and you load them - one by one without exactly knowing where they start - after loading one - stream position must be precisely at the beginning of another - some - file formats (e.g. Daggerfall images) need to know exact file size during loading so - they are inherently unsafe). - File format loaders/savers that do not meet these requirements are - located in Extras package (Extras\Extensions directory). - - - - Some complex file formats make compiled binaries significantly larger. - Most notably TIFF (around 400 KiB), - JPEG (around 100 KiB), JPEG2000 (around 150 KiB), and PNG - (around 50 KiB). Some formats use others internally - MNG and JNG use - PNG and JPEG. If you know you won't be needing some of those formats - and you don't want large binaries you can disable them at compile stage. - - This is done by uncommenting DONT_LINK_* (where * is file format - identifier) symbols in - ImagingOptions.inc include file - located in Source directory. - All core file formats have corresponding symbols here and all - are enabled by default in this include file. - - There is also DONT_LINK_EXTRAS symbol that controls - automatic linking with file formats declared in Extras package - (individual DONT_LINK_* symbols for these file format can be turned - on/off in ImagingExtras.pas - unit located in Extras\Extensions directory). - - - - In Imaging 0.26.2 file format linking symbols were changed - from LINK_* to DONT_LINK_*. - So if you used these symbols somewhere in you projects - please check your code if it still works as intended - after 0.26.2 installation. -
    - Why did it change?
    - Since all formats are enabled by default in Imaging releases, - if you wanted to disable one format you had to manually edit - ImagingOptions.inc and comment out appropriate - $DEFINE statement. - So there was a problem when you had more projects using the same - Imaging installation and each wanting to use different subset of file formats. - With new symbols you don't have to edit the include file at all, - just add DONT_LINK_* to "Conditional defines" (or its Lazarus equivalent) - in compiler options of each project. -     - - - More on supported file formats - Supported File Formats - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Extensions/Extensions.xml b/components/vampireimaging/Doc/VampyreDoc/Extensions/Extensions.xml deleted file mode 100644 index 3216da1..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Extensions/Extensions.xml +++ /dev/null @@ -1,47 +0,0 @@ - - - - Extensions - - Extensions - - Imaging's functionality can be extended by so called - extensions. These provide additional file format support, - interaction between Imaging and various graphics APIs and - libraries (OpenGL, Direct3D, SDL) - and other functionality. - - - Extensions can be divided into two categories. One that is used - automatically by Imaging core like image file format extensions. - Imaging will register all these extensions on startup. - - - Second category extensions provide user interface to some - extended functions like OpenGL texture creation. - These extensions are ordinary Pascal units. If you want to use them - simply add these units to your project's uses list and call their functions. - Those extensions are currently not accessible using DLL/SO interface. - - - There is also another extension classification. - Extensions that meet Imaging's crossplatform and/or other requirements are - located in Source directory (core extensions). - Extensions that do not meet them are located in Extras - directory (extras). - - - - Currently available file format extensions (core + extras) - File Format Extensions - - - - Currently available core extensions - OpenGL Textures - Direct3D Textures - SDL Surfaces - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Extensions/OpenGL.xml b/components/vampireimaging/Doc/VampyreDoc/Extensions/OpenGL.xml deleted file mode 100644 index 1bf34db..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Extensions/OpenGL.xml +++ /dev/null @@ -1,64 +0,0 @@ - - - - OpenGL Textures - - OpenGL Textures - - This extensions contains functions for loading and saving - OpenGL textures - using Imaging and for converting images to textures and vice versa. - You need OpenGL headers for - Object Pascal to be able to compile this extension. - Headers from - Delphi GL (dglOpenGL.pas), - JEDI-SDL (gl.pas), and - GLScene (OpenGL1x.pas) - were tested and they work. - Extension is implemented in ImagingOpenGL.pas unit located - in (ImagingRoot)\Source\Extensions directory. - To use it simply add this unit to uses list of your program. - Currently only 2D textures are supported, DXTC/S3TC and 3Dc compressed, and - floating point textures are created if supported by hardware. - - - - Here is the table with OpenGL functions - currently available. - There is also Imaging OpenGL demo you can look at - for inspiration Object Pascal OpenGL Demo. - - - - Imaging OpenGL extension functions - - - - - - - - - - - - - - - - - - -
    Loading FunctionsLoadGLTextureFromFileLoadGLTextureFromStreamLoadGLTextureFromMemorySaving FunctionsSaveGLTextureToFileSaveGLTextureToStreamSaveGLTextureToMemoryConversion FunctionsCreateGLTextureFromImageCreateGLTextureFromMultiImageCreateImageFromGLTextureCreateMultiImageFromGLTextureOther FunctionsGetGLTextureCapsGetGLProcAddressIsGLExtensionSupportedImageFormatToGL
    - - - All OpenGL textures created by Imaging functions - have default parameters set - that means that no - glTexParameter calls are made so default filtering, - wrapping, and other parameters are used. Created textures - are left bound by glBindTexture when function is exited. - - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Extensions/SDL.xml b/components/vampireimaging/Doc/VampyreDoc/Extensions/SDL.xml deleted file mode 100644 index 36395cf..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Extensions/SDL.xml +++ /dev/null @@ -1,54 +0,0 @@ - - - - SDL Surfaces - - SDL Surfaces - - This extension provides functions for loading/saving - SDL surfaces using Imaging and for converting - images to SDL surfaces and vice versa. - You need SDL headers for Object Pascal - (JEDI-SDL) to compile this extension. - It is implemented in ImagingSDL.pas unit located - in (ImagingRoot)\Source\Extensions directory. - To use it simply add this unit to uses list of your program. - Imaging library with this extension can be used as a replacement - for SDL_image library if you don't want your - application to be dependent on four C dll/so libraries - (SDL_image + jpeglib + libpng + zlib). - - - - Here is the table with SDL functions - currently available. - There is also Imaging SDL demo you can look at - for inspiration Object Pascal SDL Demo. - - - - Imaging SDL extension functions - - - - - - - - - - - -
    Loading FunctionsLoadSDLSurfaceFromFileLoadSDLSurfaceFromStreamLoadSDLSurfaceFromMemorySaving FunctionsSaveSDLSurfaceToFileSaveSDLSurfaceToStreamSaveSDLSurfaceToMemoryConversion FunctionsCreateSDLSurfaceFromImageCreateImageFromSDLSurface
    - - - LoadSDLSurfaceFromFile and similar functions use - SDL_SWSURFACE as Flags when creating - SDL surface. If you want other - Flags to be used load image by standard - LoadImageFromFile and similar functions and then call - CreateSDLSurfaceFromImage which has more options. - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Bitmap.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Bitmap.xml deleted file mode 100644 index 5acf624..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Bitmap.xml +++ /dev/null @@ -1,124 +0,0 @@ - - - - Windows Bitmap File Format - - Windows Bitmap File Format - - Windows bitmap files are stored in a device-independent bitmap (DIB) - format - that allows Windows to display the bitmap on any type of display device. The - term "device independent" means that the bitmap specifies pixel color in a - form independent of the method used by a display to represent color. - Bitmaps can store 1, 4 and 8 bit indexed images and 16, 24 - and 32 RGB images. 4 and 8 bit images can also be compressed with RLE. - Imaging can also read OS/2 bitmaps but can not save them. - - - - Windows Bitmap File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving1 bit indexedifIndex8YesNo4 bit indexedifIndex8YesNo8 bit indexedifIndex8YesYes4 bit indexed RLE compressedifIndex8YesNo8 bit indexed RLE compressedifIndex8YesYes16 bit 555 RGBifX1R5G5B5YesYes16 bit 565 RGB (note 1)ifR5G6B5YesYes16 bit 444 RGB (note 1)ifX4R4G4B4YesYes24 bit RGBifR8G8B8YesYes32 bit RGBifX8R8G8B8YesYes16 bit 1555 ARGB (note 2)ifA1R5G5B5YesYes16 bit 4444 ARGB (note 2)ifA4R4G4B4YesYes32 bit ARGB (note 2)ifA8R8G8B8YesYes
    - - - 1) Many image viewers and image editing programs do not support - these 16 bit formats and treat them as X1R5G5B5 format.
    - 2) Alpha channels in BMP files are often ignored by some (many) viewers/editors. -     - - - When working with Bitmap files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TBitmapFileFormat - class. - - - Options Related to Bitmap Files - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingBitmapRLE0 (false) or 1 (true)Indicates whether 8 bit Bitmap images will be saved with or without - RLE compression (efficient only for images - with large areas of the same color). - Default value is 1 (true).
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Dds.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Dds.xml deleted file mode 100644 index 6b7ba62..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Dds.xml +++ /dev/null @@ -1,234 +0,0 @@ - - - - DirectDraw Surface File Format - - DirectDraw Surface File Format - - The Microsoft DirectDraw Surface (.dds) - file format is used to store textures and - cubic environment maps, both with and - without mipmap levels. This format can - store uncompressed and compressed formats, and is the preferred file format - for storing DXTn compressed data. - This format was introduced with DirectX 7.0. - In DirectX 8.0, support for volume textures was added. - Many new games use DDS files to store their textures. - More information on DDS files can be found in DirectX SDK documentation. - - - Imaging supports loading and saving of all three types of DDS files - - standard textures, cube maps and volume textures. Each of these types can - be with or without mipmaps and compressed with DXTC. - Pixel formats of DDS files supported by Imaging can be found in the table below. - - - - DirectDraw Surface File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    D3DFORMATTImageFormat equivalentLoadingSavingD3DFMT_R3G3B2ifR3G3B2YesYesD3DFMT_R5G6B5ifR5G6B5YesYesD3DFMT_X1R5G5B5ifX1R5G5B5YesYesD3DFMT_X4R4G4B4ifX4R4G4B4YesYesD3DFMT_R8G8B8ifR8G8B8YesYesD3DFMT_X8R8G8B8ifX8R8G8B8YesYesD3DFMT_A1R5G5B5ifA1R5G5B5YesYesD3DFMT_A4R4G4B4ifA4R4G4B4YesYesD3DFMT_A8R8G8B8ifA8R8G8B8YesYesD3DFMT_A16B16G16R16ifA16B16G16R16YesYesD3DFMT_L8ifGray8YesYesD3DFMT_A8L8ifA8Gray8YesYesD3DFMT_L16ifGray16YesYesD3DFMT_R32FifR32FYesYesD3DFMT_A32B32G32R32FifA32B32G32R32FYesYesD3DFMT_X8B8G8R8ifX8R8G8B8YesNoD3DFMT_A8B8G8R8ifA8R8G8B8YesNoD3DFMT_X8L8V8U8ifX8R8G8B8YesNoD3DFMT_Q8W8V8U8ifA8R8G8B8YesNoD3DFMT_Q16W16V16U16ifA16B16G16R16YesNoD3DFMT_V8U8ifA8Gray8YesNoD3DFMT_DXT1ifDXT1YesYesD3DFMT_DXT3ifDXT3YesYesD3DFMT_DXT5ifDXT5YesYes
    - - - - When working with DDS files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TDDSFileFormat - class. - Options are divided into two groups - loading options and saving options. - Loading options have prefix ImagingDDSLoaded and - they store some properties of the last loaded DDS file. - You can use saving options with prefix ImagingDDSSave - to tell Imaging how to save the next DDS file (save settings persist - until they are changed by SetOption call) - ordinary texture - or volume texture with mipmaps or other? - You can learn how to use these options and how to load and save DDS files - in Loading and Saving DDS Files - section. - - - - Options Related to DDS Files - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingDDSLoadedCubeMap0 (false) or 1 (true)Indicates whether the last loaded DDS file contained cube - environment map or not. ImagingDDSLoadedVolume0 (false) or 1 (true)Indicates whether the last loaded DDS file contained - volume texture or not. ImagingDDSLoadedMipMapCount1 to NNumber of mip map levels of the last loaded DDS file.ImagingDDSLoadedDepth1 to NDepth (slices of volume texture or faces of - cube map) of the last loaded DDS file.ImagingDDSSaveCubeMap0 (false) or 1 (true)Indicates whether DDS files will be saved as cube - environment map or not. Default value is 0 (false).ImagingDDSSaveVolume0 (false) or 1 (true)Indicates whether DDS files will be saved as - volume texture or not. Default value is 0 (false).ImagingDDSSaveMipMapCount1 to NNumber of mip map levels to be saved to the next saved DDS file. - Default value is 1.ImagingDDSSaveDepth1 to NDepth (slices of volume texture or faces of - cube map) of the next saved DDS file. - Default value is 1.
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/ElderImagery.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/ElderImagery.xml deleted file mode 100644 index 5bf7722..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/ElderImagery.xml +++ /dev/null @@ -1,92 +0,0 @@ - - - - Elder Imagery - - Elder Imagery - - Elder Imagery is extension for Vampyre Imaging Library that - adds support for loading and saving of images and textures from older - Bethesda games like Redguard, BatteSpire, - Terminator: FS, and TES: Arena, but mostly for - The Elder Scrolls 2: Daggerfall (loads all images and textures - from this game). All formats are 8bit indexed images (plus some 16bit color - mapping in Battlespire) and palettes are often external. - Default palettes for most images of each game are included in Elder Imagery - but there are usually few images that use others (you can load them manually - and assign them to loader class). Elder Imagery extension resides in - Extras package. - Here is the list of file formats supported by Elder Imagery: - - - -
  • - IMG - Daggerfall Image - is 8 bit indexed format found in Daggerfall, Arena, Terminator: FS, - and maybe other old Bethesda games. Files can be RLE compressed - and may contain palette although most images use external palettes. - Some files have no header at all so exact file size must be known - prior to loading (otherwise no-header files wont be recognized or whole - image could be identified as CIF as they use the same header). -
    • -
  • - CIF - Daggerfall MultiImage - is basically a sequence of images in IMG images stored in one file - (with exception of Weapo*.cif files which are little bit more complex). - As with IMG files CIF files can be RLE compressed and there are - also special CIFs without header. - Total number of frames in file is known after the whole file was parsed - so exact file size must be known prior to loading. -
    • -
  • - TEXTURE - Daggerfall Texture - is format for texture storage in TES2: Daggerfall - (works for Terminator: FS and maybe other games too). - Textures are stored in 8bit indexed format with external palette. - This format is very complicated (more images with subimages, - nonstandard RLE, many unknowns) so only loading is supported. - These texture files cannot be recognized by filename extension because - their filenames are in form texture.### where # is number. Use filename - masks instead. -
    • -
  • - BSI - Bethesda Image - is format for textures and images found - in Redguard and BattleSpire (maybe in other games too, Skynet?). This format - uses chunk structure similar to PNG (HDR/DAT/END). Redguard stores - multiple images in one file (usually related like textures for various - parts of single 3d object). Image data is stored as 8bit. Each image - can have its own embedded palette or it can use external default palette. - BattleSpire BSI use *.bsi file extension whilst Redguard uses - texbsi.* mask with number extension (just like Daggerfall). - Only loading is supported for this format. - BattleSpire images also contain some sort of 8bit->16bit color mapping data - which I've not yet figured out (only blue channel known) so - don't expect to get pretty results from it now. -
    • -
  • - SKY - Daggerfall Sky Images - are used as backdrops in outdoor areas. There's about 200MB of - sky images in Daggerfall installation. Each sky file (sky##.dat) - contains 64 images 512x220 pixels each. Images in one file - are for one climate zone and each is used for certain time of the day. -
    • -     - - - When saving image in IMG or CIF format it gets converted to 8bit indexed - format and mapped to current palette set in saver class. Also note - that max size (in bytes) of image that can be saved is 65535 bytes - (it is resized automatically if bigger). - - - - Since most people won't need support for these formats they are disabled - by default (not compiled into your binary). - If you want them go to ImagingExtras.pas unit - and comment out or delete {$DEFINE DONT_LINK_ELDER} - line. - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/FileFormats.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/FileFormats.xml deleted file mode 100644 index 0ba55ad..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/FileFormats.xml +++ /dev/null @@ -1,49 +0,0 @@ - - - - Supported File Formats - - Supported File Formats - - Image file format is device independent representation of image data. - Images in these formats are usually stored as external - files on hard disk. Many different file formats - have been created but majority of the images stored anywhere - are saved in one of a few most widely used formats. - Main goal of Imaging's file format support is to fully support - these widely used formats. This means - successful loading and saving of all images stored in these formats. - So if you have some image in one of supported formats and it can not - be loaded by Imaging, please send it to me so I will be able to fix it. - - - - Core File Formats - BMP Windows Bitmap File Format - JPEG File Format - PNG Portable Network Graphics File Format - GIF Graphics Interchange Format - TGA Targa File Format - DDS DirectDraw Surface File Format - MNG Multiple Network Graphics File Format - JNG JPEG Network Graphics File Format - Portable Maps: PBM, PGM, PPM, PAM, and PFM File Formats - - - - Extras File Formats - JPEG2000 File Format - PSD Photoshop Document File Format - TIFF Tagged Image File Format - PCX ZSoft PaintBrush File Format - X Window Pixmap File Format - Elder Imagery Extension - - - - What are Core and Extras File Formats? Look at - Extensions - File Formats section for information. - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Gif.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Gif.xml deleted file mode 100644 index 91c3634..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Gif.xml +++ /dev/null @@ -1,85 +0,0 @@ - - - - Graphics Interchange Format - - Graphics Interchange Format - - GIF was - (and is still used) popular format for storing images supporting - multiple images per file and single color transparency. - Pixel format is 8 bit indexed where each image frame can have - its own color palette. GIF uses lossless LZW compression - (patent expired few years ago). - Imaging can load and save all GIFs with all frames and supports - transparency. - - - - Loadng of animated GIFs was rewritten in Imaging 0.26.2 (based - on ExtraGIF mod by Sergey Galezdinov). - It now supports two modes of operation: - -
  • Raw Frames just extracts raw frames from GIF files - without any modification. Useful when you want to do your own - GIF animator. Extracted frames are all in ifIndex8. -
    • -
  • Animated Frames animates all frames using disposal methods - and placement of frames onto logical screen. Correctly animates - all tested GIFs (several thousand). Animated frames are - in ifA8R8G8B8 format so even rare true color GIFs - are supported (each frame has only 256 colors but you can place them - side by side onto logical screen to create one larger true color image). - This is the default mode. -
    • -     -     - - - You can select which mode you wan to use - with ImagingGIFLoadAnimated option along with - SetOption and GetOption functions. - Or you can set them by modifying properties of TGIFFileFormat - class. - - - - Options Related to GIF Files - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingGIFLoadAnimated0 (false) or 1 (true)Boolean option that specifies whether GIF images with more frames - are animated by Imaging (according to frame disposal methods) or just - raw frames are loaded and sent to user (if you want to animate GIF yourself). - Default value is 1 (true).
    - - - GIF File Format Support - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSavingup to 256 colors indexedifIndex8YesYestrue color with transparency for animated framesifA8R8G8B8YesNo
    - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jng.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jng.xml deleted file mode 100644 index b2acd7d..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jng.xml +++ /dev/null @@ -1,124 +0,0 @@ - - - - JPEG Network Graphics File Format - - JPEG Network Graphics File Format - - - JNG is a lossy single-image member of the Network Graphics format family. - It encapsulates a JPEG datastream in PNG-style chunks, - along with an optional alpha channel. - While JNG is primarily intended as a subformat of - the MNG (Multiple Network Graphics) - format, standalone JNG files are also possible. - - - - Alpha channel in JNG images is stored separately from color/gray data and - can be lossy (as JPEG image) or lossless (as PNG image) compressed. - - - - JPEG Network Graphics File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving24 bit RGBifR8G8B8YesYes32 bit ARGBifA8R8G8B8YesYes8 bit grayscaleifGray8YesYes16 bit grayscale + alphaifA8Gray8YesYes
    - - - Lossless JNG alpha channels can have 1, 2, 4, 8, or 16 bit depths - but they are converted to 8 bits so that corresponding Imaging data formats - for joint color/gray + alpha images can be found. Alpha channels are always - saved as 8 bit. - - - - - When working with JNG files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TJNGFileFormat - class. - - - - Options Related to JNG Files - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingJNGLossyAlpha0 (False) or 1 (True) Specifies whether alpha channels of JNG images are lossy compressed. - Default value is 0. ImagingJNGAlphaPreFilter0, 1, 2, 3, 4, 5, 6Sets precompression filter used when saving lossless alpha channels. - Allowed values are: - -
  • 0 - None Filter
    • -
  • 1 - Sub Filter
    • -
  • 2 - Up Filter
    • -
  • 3 - Average Filter
    • -
  • 4 - Paeth Filter
    • -
  • 5 - Use 0 for indexed/gray images and 4 for RGB/ARGB images
    • -
  • 6 - Adaptive filtering - use best filter for each scanline - very slow
    • -     - Note that filters 3 and 4 are much slower than filters 1 and 2. - Default value is 5.     		ImagingJNGAlphaCompressLevel0 (no compression) to 9 (best compression)Sets ZLib compression level used when saving lossless alpha channels. - Default value is 5. ImagingJNGQuality1 to 100Defines compression quality used when saving JNG images (and lossy alpha channels). - Higher value means worse compression/better image quality/larger file size. - Default value is 90.ImagingJNGProgressive0 (False) or 1 (True)Specifies whether JNG images are saved in progressive format. - Progressive JPEG rearranges the stored data into a series of scans of - increasing quality. In situations where a JPEG file is transmitted across a - slow communications link, a decoder can generate a low-quality image very - quickly from the first scan, then gradually improve the displayed quality as - more scans are received. Default value is 0 (False).
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jpeg.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jpeg.xml deleted file mode 100644 index 4c2dae3..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jpeg.xml +++ /dev/null @@ -1,77 +0,0 @@ - - - - JPEG File Format - - JPEG File Format - - JPEG (Joint Photographic Experts Group) format - is good choice for storing images with large number of colors - and without sharp edges. It uses lossy compression which can greatly - reduce size of image file. Imaging uses Independent JPEG Group's jpeglib - library to load and save JPEG files. It was translated to Pascal by - Jacques Nomssi Nzali. As stated in jpeglib's documentation this library - can read and write JFIF format which is most widely used JPEG - format. But there are also some proprietary and other JPEG formats - which can not be read/written by jpeglib thus Imaging can not - read/write them also. - - - - JPEG File Format Support - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving24 bit RGBifR8G8B8YesYes8 bit grayscaleifGray8YesYes
    - - - When working with JPEG files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TJpegFileFormat - class. - - - - Options Related to JPEG Files - - - - - - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingJpegQuality1 to 100JPEG compression quality used when saving images. - Higher value means worse compression/better image quality/larger file size. - Default value is 90.ImagingJpegProgressive0 (False) or 1 (True)Indicates whether JPEG is saved as progressive or not. - Progressive JPEG rearranges the stored data into a series of scans of - increasing quality. In situations where a JPEG file is transmitted across a - slow communications link, a decoder can generate a low-quality image very - quickly from the first scan, then gradually improve the displayed quality as - more scans are received. Default value is 0 (False).
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jpeg2000.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jpeg2000.xml deleted file mode 100644 index 04f4135..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Jpeg2000.xml +++ /dev/null @@ -1,142 +0,0 @@ - - - - JPEG 2000 Format - - JPEG 2000 Format - - JPEG 2000 is a wavelet-based image compression standard. - It was created by the Joint Photographic Experts Group committee - as a replacement for their own DCT based JPEG standard. - JPEG 2000 can operate at higher compression - ratios without generating 'blocky and blurry' - artifacts of the older JPEG standard. - Nowadays JPEG 2000 is not as widely supported as its predecessor. - Common file name extensions are .jp2, .j2c, and .j2k (for code stream only). - - - As of version 0.24.2 Imaging uses OpenJPEG library - compiled to object files (Delphi) or static libraries (FPC) - and linked to Object Pascal program. - Therefore, JPEG 2000 support is not a part of core library - (not native Pascal) now - and is located in Extras package. - Currently Imaging supports JPEG 2000 on Win32 - (for Delphi and FPC) and Linux systems (FPC only - no Kylix support). - For Linux there are precompiled objects for x86 and x86_64 architectures. - - - JPEG 2000 supports wide variety of data formats. You can have arbitrary number - of components/channels, each with different bitdepth and optional - "signedness". JPEG 2000 images can be lossy or lossless compressed. - Imaging can load most data formats (except multichannel images - with component bitdepth > 16 => no Imaging data format equivalents). - Components with sample separation are loaded correctly, ICC profiles - or palettes are not used, YCbCr images are translated to RGB. - - - - JPEG 2000 File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving8 bit grayscaleifGray8YesYes16 bit grayscaleifGray16YesYes32 bit grayscaleifGray32YesYes8 bit grayscale + alphaifA8Gray8YesYes16 bit grayscale + alphaifA16Gray16YesYes24 bit RGBifR8G8B8YesYes48 bit RGBifR16G16B16YesYes32 bit ARGBifA8R8G8B8YesYes64 bit ARGBifA16R16G16B16YesYes
    - - - JPEG 2000 offers vast amount of channel count and bitdepth combinations - but formats listed in table are the most common ones. - - - - When working with JPEG 2000 files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TJpeg2000FileFormat - class. - - - Options Related to JPEG 2000 Files - - - - - - - - - - - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingJpeg2000Quality1 to 100 - JPEG 2000 compression quality used when saving images. - Higher value means worse compression/better image quality/larger file size. - Default value is 80. - ImagingJpeg2000CodeStreamOnly0 (False) or 1 (True) - Controls whether JPEG 2000 image is saved with full file headers or just - as code stream. Default value is False (0). - ImagingJpeg2000LosslessCompression0 (False) or 1 (True) - Specifies JPEG 2000 image compression type. If True (1), saved JPEG 2000 files - will be losslessly compressed. Otherwise lossy compression is used. - Default value is False (0). -
    - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Mng.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Mng.xml deleted file mode 100644 index 25be028..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Mng.xml +++ /dev/null @@ -1,111 +0,0 @@ - - - - Multiple Network Graphics File Format - - Multiple Network Graphics File Format - - - MNG is a multiple-image member of the Network Graphics - format family. It can contain animations, slide shows, - or complex still frames, comprised of multiple - PNG or JNG single-image datastreams. - This format has complex animation capabilities but Imaging only - extracts frames. Individual frames are stored as standard PNG or JNG - images. - - - Imaging saves MNG files as MNG-VLC (very low complexity) so it is basically - an array of image frames without MNG animation chunks. Frames can be saved - as lossless PNG or lossy JNG images. - Every frame can be in different data format. - - - - For information about supported data formats of individual frames look - at PNG and JNG file formats, which are internally used to store frames. - - - - MNG frame formats - PNG File Format - JNG File Format - - - - When working with MNG files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TMNGFileFormat - class. - - - - Options Related to MNG Files - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingMNGLossyCompression0 (False) or 1 (True)Specifies whether MNG animation frames are saved with lossy or lossless - compression. Lossless frames are saved as PNG images and lossy frames are - saved as JNG images. - Default value is 0. ImagingMNGLossyAlpha0 (False) or 1 (True) Defines whether alpha channel of lossy compressed MNG frames - (when ImagingMNGLossyCompression is 1) is lossy compressed too. - Default value is 0. ImagingMNGPreFilter0, 1, 2, 3, 4, 5, 6Sets precompression filter used when saving MNG frames as PNG images. - Allowed values are: - -
  • 0 - None Filter
    • -
  • 1 - Sub Filter
    • -
  • 2 - Up Filter
    • -
  • 3 - Average Filter
    • -
  • 4 - Paeth Filter
    • -
  • 5 - Use 0 for indexed/gray images and 4 for RGB/ARGB images
    • -
  • 6 - Adaptive filtering - use best filter for each scanline - very slow
    • -     - Note that filters 3 and 4 are much slower than filters 1 and 2. - Default value is 5.     		ImagingMNGCompressLevel0 (no compression) to 9 (best compression)Sets ZLib compression level used when saving MNG frames as PNG images. - Default value is 5. ImagingMNGQuality1 to 100Specifies compression quality used when saving MNG frames as JNG images. - Higher value means worse compression/better image quality/larger file size. - Default value is 90.ImagingMNGProgressive0 (False) or 1 (True)Specifies whether images are saved in progressive format when saving MNG - frames as JNG images. - Progressive JPEG rearranges the stored data into a series of scans of - increasing quality. In situations where a JPEG file is transmitted across a - slow communications link, a decoder can generate a low-quality image very - quickly from the first scan, then gradually improve the displayed quality as - more scans are received. Default value is 0 (False).
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Pcx.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Pcx.xml deleted file mode 100644 index 4168567..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Pcx.xml +++ /dev/null @@ -1,53 +0,0 @@ - - - - ZSoft Paintbrush Image - - ZSoft Paintbrush Image - - PCX was the native file format for ZSoft PC Paintbrush graphics editor - which was popular in old DOS days. - Most PCX files use a color palette, but the format has also been extended - to support true color images. It uses a simple run-length - encoding as compression. - PCX was quite popular on early DOS and Windows systems (it is - native texture file format of Unreal 1 engine) - but it has been largely replaced by more powerful formats like - PNG and JPEG. Imaging supports only loading of PCX files - (I don't wont this venerable format to spread). - - - - PCX File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalent1 bit monoifIndex82 bit indexedifIndex84 bit indexed (rare)ifIndex88 bit indexedifIndex824 bit RGBifR8G8B832 bit ARGB (rare)ifA8R8G8B8
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Png.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Png.xml deleted file mode 100644 index 51946f7..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Png.xml +++ /dev/null @@ -1,175 +0,0 @@ - - - - Portable Network Graphics File Format - - Portable Network Graphics File Format - - - PNG is extensible file format for the lossless, portable, well-compressed - storage of raster images. PNG provides a patent-free replacement for GIF and can also - replace many common uses of TIFF. Indexed-color, grayscale, and truecolor images - are supported, plus an optional alpha channel. Sample depths range from 1 to 16 bits. - - - - Images can also be filtered using different lossless filter for each scanline so that - subsequent compression can produce even smaller images. PNG also supports interlaced - images to allow progressive display. - Imaging can load all possible PNG data formats but cannot save 1, 2, and 4 bit or - interlaced images. It supports all filters when loading or saving images. - Imaging uses ZLib library written by Jean-loup Gailly and Mark Adler - to compress and decompress PNG image data. - It was translated to Pascal by Jacques Nomssi Nzali. - - - - As of version 0.26.4, Imaging also supports APNG format. - APNG is unofficial extension of PNG image file format created by two guys from Mozilla Corporation. - The point of APNG is to allow storing simple animations in PNG files (hence the "A" for "Animated"). - There is already PNG-like chunk based format for animations called MNG - (already supported by Imaging - at least the basic features). - However, MNG is quite complex format and its support among browsers and image viewers/editors is lacking. - Code library supporting all MNG features is huge. - APNG on the other hand is just an extension of PNG and its implementation is not so complex. Imaging can load APNG files, animate them (optional - put frames - at desired positions, blend frames, apply disposal methods), - and also save multiple images as single APNG file. - - - - Portable Network Graphics File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving1 bit indexedifIndex8YesNo2 bit indexedifIndex8YesNo4 bit indexedifIndex8YesNo8 bit indexedifIndex8YesYes24 bit RGBifR8G8B8YesYes48 bit RGBifR16G16B16YesYes32 bit ARGBifA8R8G8B8YesYes64 bit ARGBifA16R16G16B16YesYes1 bit grayscaleifGray8YesNo2 bit grayscaleifGray8YesNo4 bit grayscaleifGray8YesNo8 bit grayscaleifGray8YesYes16 bit grayscaleifGray16YesYes16 bit grayscale + alphaifA8Gray8YesYes32 bit grayscale + alphaifA16Gray16YesYes
    - - - When working with PNG files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TPNGFileFormat - class. - - - - Options Related to PNG Files - - - - - - - - - - - - - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingPNGPreFilter0, 1, 2, 3, 4, 5, 6Sets precompression filter used when saving PNG images. Allowed values - are: - -
  • 0 - None Filter
    • -
  • 1 - Sub Filter
    • -
  • 2 - Up Filter
    • -
  • 3 - Average Filter
    • -
  • 4 - Paeth Filter
    • -
  • 5 - Use 0 for indexed/gray images and 4 for RGB/ARGB images
    • -
  • 6 - Adaptive filtering - use best filter for each scanline - very slow
    • -     - Note that filters 3 and 4 are much slower than filters 1 and 2. - Default value is 5.     		ImagingPNGCompressLevel0 (no compression) to 9 (best compression)Sets ZLib compression level used when saving PNG images. - Default value is 5. ImagingPNGLoadAnimated0 (false) or 1 (true)Boolean option that specifies whether PNG images with more frames (APNG format) - are animated by Imaging (according to frame disposal/blend methods) or just - raw frames are loaded and sent to user (if you want to animate APNG yourself). - Default value is 1.
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Pnm.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Pnm.xml deleted file mode 100644 index be4e908..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Pnm.xml +++ /dev/null @@ -1,183 +0,0 @@ - - - - Portable Maps - - Portable Maps - - Portable Maps or AnyMaps (PNM) is collective - name refering to family - of very similar raster file formats. Their format is very simple - and most of them contain just two-byte Id, Width, Height, and raster data. - Data can be stored in binary format or in text format (whick produces - very large files). Most formats can store images with 8 or 16 bit channels - but not all viewer and editor programs support 16 bit PNMs (or binary ones). - Imaging supports five PNM formats where PBM, PGM, and PPM - are quite common - but PAM and PFM are somewhat rare. - - - -
  • - - PBM - Portable Bit Map - stores monochrome 1bit images. Raster data - can be saved as text or binary data. Either way value of 0 represents white - and 1 is black. As Imaging does not have support for 1bit data formats - PBM images can be loaded but not saved. Loaded images are returned in - ifGray8 format (witch pixel values scaled from 1bit to 8bit). - -
    • -
  • - - PBM - Portable Gray Map - stores grayscale 8bit or 16bit images. Raster data can be - saved as text or binary data. - -
    • -
  • - - PPM - Portable Pixel Map - stores RGB images with 8bit or 16bit channels. - Raster data can be saved as text or binary data. - -
    • -
  • - - PAM - Portable Arbitrary Map - is more complex format that can store image data formats - of PBM, PGM, and PPM formats with optional alpha channel. Raster data - can be stored only in binary format. - -
    • -
  • - - PFM - Portable Float Map - is unofficial extension of PNM format family which - can store images with floating point pixels. Raster data is saved in - binary format as array of IEEE 32 bit floating point numbers. One channel - or RGB images are supported by PFM format (so no alpha). - -
    • -     - - - There is a complete list of data formats supported by PNM file formats, - their Imaging equivalents, and load/cave capability. - - - - Portable Maps File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSavingSupported By Map Format1 bit monoifGray8YesNoPBM, PAM1bit mono + alphaifA8Gray8YesNoPAM8 bit grayscaleifGray8YesYesPGM, PAM16 bit grayscaleifGray16YesYesPGM, PAM8 bit grayscale + alphaifA8Gray8YesYesPAM16 bit grayscale + alphaifA16Gray16YesYesPAM24 bit RGBifR8G8B8YesYesPPM, PAM48 bit RGBifR16G16B16YesYesPPM, PAM32 bit ARGBifA8R8G8B8YesYesPAM64 bit ARGBifA16R16G16B16YesYesPAM32 bit R FP32ifR32FYesYesPFM96 bit RGB FP32ifA32R32G32B32FYesYesPFM
    - - - When working with PNM files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TPGMFileFormat - and TPPMFileFormat classes. - - - Options Related to PNM Files - - - - - - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingPGMSaveBinary0 (false) or 1 (true)If set to True PGM images will be saved in binary format, otherwise - they will be saved in text format (which could result in 5-10x bigger file). - Default value is 1 (true). ImagingPPMSaveBinary0 (false) or 1 (true)If set to True PPM images will be saved in binary format, otherwise - they will be saved in text format (which could result in 5-10x bigger file). - Default value is 1 (true).
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Psd.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Psd.xml deleted file mode 100644 index 42c4f93..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Psd.xml +++ /dev/null @@ -1,136 +0,0 @@ - - - - Photoshop Document - - Photoshop Document - - The .PSD (Photoshop Document) format stores an image with support - for most imaging options available in Adobe Photoshop program. - These include layers with masks, color spaces, - ICC profiles, transparency, text, alpha channels, etc. - - - Loading and saving of indexed, grayscale, RGB(A), HDR (FP32), and CMYK - (auto converted to RGB) images is supported. Non-HDR gray, RGB, - and CMYK images can have 8bit or 16bit color channels. - There is no support for loading mono images, duotone images are treated - like grayscale images, and multichannel and CIE Lab images are loaded as - RGB images but without actual conversion to RGB color space. - Also no layer information is loaded. - - - As of Imaging version 0.26.2 images with alpha channel can be - saved using layers. That way when opened in Photoshop they - have proper transparency, not alpha channel - (will have one layer, RGB color channels, and transparency). - PSD files with layers are bigger because image has to be stored - as background as well as layer data. - Therefore, RLE compression was implemented to keep the files smaller - (Photoshop saves PSDs RLE compressed too by default). - Note that layers are not supported for floating point image data formats - since it's not supported by Photoshop itself. - Saving of layers can also be disabled - (will be opened in PS as background raster with RGBA channels) - using appropriate option. - - - - Photoshop Document File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving8 bit indexedifIndex8YesYes24 bit RGBifR8G8B8YesYes48 bit RGBifR16G16B16YesYes32 bit ARGBifA8R8G8B8YesYes64 bit ARGBifA16R16G16B16YesYes8 bit grayscaleifGray8YesYes16 bit grayscaleifGray16YesYes16 bit grayscale + alphaifA8Gray8YesYes32 bit grayscale + alphaifA16Gray16YesYes32 bit R FP32ifR32FYesYes128 bit ARGB FP32ifA32B32G32R32FYesYesother typesdepends on typeYes/NoNo
    - - - When working with PSD files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TPSDFileFormat - class. - - - - Options Related to PSD Files - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingPSDSaveAsLayer0 (false) or 1 (true)If enabled image data is saved as layer of PSD file. This is required - to get proper transparency when opened in Photoshop for images with - alpha data (will be opened with one layer, RGB color channels, and transparency). - If you don't need this Photoshop compatibility turn this option off as you'll get - smaller file (will be opened in PS as background raster with RGBA channels) - Default value is 1 (true).
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Targa.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Targa.xml deleted file mode 100644 index ac14b7d..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Targa.xml +++ /dev/null @@ -1,98 +0,0 @@ - - - - Truevision Targa File Format - - Truevision Targa File Format - - Truevision defined the TGA file format in 1984 for use with its - first videographics products. It was the first truecolor - file format widely available. They are still widely used for - images with alpha channels. - It can store indexed, grayscale, RGB and ARGB images. - Targas can be uncompressed or compressed with RLE (run length encoding) - algorithm. - - - - Targa File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving8 bit indexedifIndex8YesYes8 bit grayscaleifGray8YesYes16 bit ARGBifA1R5G5B5YesYes24 bit RGBifR8G8B8YesYes32 bit ARGBifA8R8G8B8YesYesAll above but RLE compressed-YesYes8 bit indexed Huffman, Delta, RLEifIndex8NoNo8 bit indexed Huffman, Delta, RLE, 4-passifIndex8NoNo
    - - - If anyone has some information about two last formats (TGA image type - codes 32 and 33) please tell me. - - - - When working with Targa files you can find useful some options - which can be set by SetOption function and their current values - can be get by GetOption function. - Or you can set them by modifying properties of TTargaFileFormat - class. - - - - Options Related to Targa Files - - - - - - - - - - -
    OptionIdAllowed ValuesUsageImagingTargaRLE0 (false) or 1 (true)Indicates whether Targa image will be saved with or without - RLE compression (efficient only for images - with large areas of the same color). - Default value is 0 (false).
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Tiff.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Tiff.xml deleted file mode 100644 index 2d1206d..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Tiff.xml +++ /dev/null @@ -1,121 +0,0 @@ - - - - Tagged Image File Format - - Tagged Image File Format - - TIFF is a flexible and adaptable file format. - It can handle multiple images and data in a single file through the - inclusion of "tags" in the file header. - Tags can indicate the basic geometry of the image, such as its size, - or define how the image data is arranged and whether various image compression - options are used. - For example, TIFF can be used as a container for JPEG and RLE - compressed images. - The ability to store image data in a - lossless format makes TIFF files a useful method for archiving images. - Other TIFF file options include multiple layers or pages. - - - Currently Imaging uses LibTiff C library to load and save TIFFs. - It can read and write most types of TIFF files. - But it is currently available only in Delphi (uses LibTiffDelphi object files) - and it can make your compiled binaries quite big (almost 400 KiB size increase - when compiled with TIFF support). - - If you don't need TIFF support and want smaller exe instead you - can disable it by uncommenting {$DEFINE DONT_LINK_TIFF} - line in in ImagingExtras.pas unit. - - - - Native Object Pascal TIFF support is planned for some future Imaging release. - - - - Tagged Image File Format File Format Support - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    FormatTImageFormat equivalentLoadingSaving8 bit indexedifIndex8YesYes24 bit RGBifR8G8B8YesYes48 bit RGBifR16G16B16YesYes32 bit ARGBifA8R8G8B8YesYes64 bit ARGBifA16R16G16B16YesYes8 bit grayscaleifGray8YesYes16 bit grayscaleifGray16YesYes16 bit grayscale + alphaifA8Gray8YesYes32 bit grayscale + alphaifA16Gray16YesYes32 bit grayscaleifGray32YesYes16 bit R FP16ifR16FYesYes64 bit ARGB FP16ifA16R16G16B16FYesYes32 bit R FP32ifR32FYesYes128 bit ARGB FP32ifA32B32G32R32FYesYesother typesdepends on typeYes/NoNo
    -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Xpm.xml b/components/vampireimaging/Doc/VampyreDoc/FileFormats/Xpm.xml deleted file mode 100644 index d5ddedf..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/FileFormats/Xpm.xml +++ /dev/null @@ -1,33 +0,0 @@ - - - - X Window Pixmap Image - - X Window Pixmap Image - - X Pixmap is an ASCII-text-based image format used by the X Window System. - It was created in 1989 at the INRIA, France, and was later enhanced. - It is intended primarily for creating icon pixmaps, - and supports transparent color. - It has a simple structure. - It can be created and manipulated using any text editor - and can be included in a C language file. - - - Imaging supports loading and saving of XPM files (not XPM2 or XBM). - - - - XPM File Format Support - - - - - - - - -
    FormatTImageFormat equivalentIndexed, custom number of colorsifA8R8G8B8
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Imaging.vdocproj b/components/vampireimaging/Doc/VampyreDoc/Imaging.vdocproj deleted file mode 100644 index 697ca8e..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Imaging.vdocproj +++ /dev/null @@ -1,10 +0,0 @@ - - - - Vampyre Imaging Library - Contents.xml - Root.xml - Xsl - Imaging - ../RefDoc - \ No newline at end of file diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/About.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/About.xml deleted file mode 100644 index 0980501..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/About.xml +++ /dev/null @@ -1,34 +0,0 @@ - - - - About - - About - - Imaging is native Object Pascal image loading, saving and - manipulation library. It is available for several platforms - and does not require any third party dynamic libraries or other compiled binaries. - - - Main development language is Object Pascal - (Delphi and Free Pascal compilers are supported) - and there are interfaces to the library - (compiled into dll/so) for other languages like C/C++ and - Delphi.NET. Currently supported operating systems are Windows, - Linux, FreeBSD (and some other Unixes), and Mac OS X (on Intel). - Supported CPU architectures are x86 and AMD64. - - - Currently supported image file formats - are: (loading and saving) BMP, JPEG, PNG/APNG, GIF, - TGA, DDS, MNG, JNG, - JPEG2000, PSD, TIFF, PGM, - PPM, PAM, PFM, XPM, - (loading only) PCX, and PBM. - Many internal image data formats are supported: - 8/16/24/32/48/64 bit RGB and ARGB formats, indexed formats, - grayscale formats, half/single precision floating point formats, - and compressed formats DXT1/3/5, 3Dc, and BTC. - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/Contrib.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/Contrib.xml deleted file mode 100644 index 6767aab..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/Contrib.xml +++ /dev/null @@ -1,46 +0,0 @@ - - - - Contributions - - Contributions - - Several modifications and extensions contributed by Imaging users are - included in release packages - (located in (Imaging Root)\Extras\Contrib directory). - Currently they are: - - - - - - - - - - - - - - - - -
    NameDescription
    ExtraGIFModification that provides extra functionality targeting - GIF file format. Adds new self-animating TGraphic class - and full frame information. Created by Sergey Galezdinov - for QIP messenger. - More info in included readme file.
    NIF LoaderFile format extension that reads texture from version 3 NIF - 3D models (ST: Bridge Commander). Author: Delfi.
    hq2x for Pascal - Pascal translation of great - h2qx magnification filter. - Demo showing how to use it with Imaging is included. - Translated to Pascal by Jeremy Darling. -
    - - - Also many thanks to all those who sent bug reports, fixes, diff patches, - new functions, and feedback of any kind. - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/Credits.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/Credits.xml deleted file mode 100644 index c23c68d..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/Credits.xml +++ /dev/null @@ -1,31 +0,0 @@ - - - - Credits - - Credits - Imaging Library developers: - -
  • Marek Mauder( - galfar(at)users(dot)sourceforge(dot)net)
    • -     - - Imaging Library uses: - -
  • PasJPEG by Jacques Nomssi Nzali - (Pascal translation of JPEGLib by Independent JPEG Group).
    • -
  • PasZLib by Jacques Nomssi Nzali - (Pascal translation of ZLib by - Jean-loup Gailly and Mark Adler).
    • -
  • OpenJPEG for JPEG 2000 support by - Communications and remote sensing Laboratory, - Universite catholique de Louvain, Belgium
    • -
  • LibTiff for TIFF support by - Sam Leffler, Silicon Graphics, Inc., and contributors. - LibTiffDelphi (pre-compiled LibTiff for Borland Delphi) - by AWare Systems. -
    • -     - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/Faq.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/Faq.xml deleted file mode 100644 index 6e8264b..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/Faq.xml +++ /dev/null @@ -1,99 +0,0 @@ - - - - FAQ - - FAQ - Here are answers to some user questions that showed up in the forums/mails and - some made up (but maybe useful) questions too : - - -
  • - I'm using Delphi XYZ or Lazarus ABC and I want to install Imaging package - into IDE. Where do I find the right package? - Package projects are located in (Imaging Root)\Source\Projects - directory: - -
  • VampyreImagingPackage.D2009.dproj package for Delphi 2009 and 2010.
    • -
  • VampyreImagingPackage.D2007.dproj package for Delphi 2007 (Codegear RAD Studio).
    • -
  • VampyreImagingPackage.D2006.bdsproj package for Delphi 2006 (Borland Developer Studio), - should work for Turbo Delphi too.
    • -
  • VampyreImagingPackageD7.dpkw package for Delphi 7, should work for Delphi 6 too.
    • -
  • vampyreimagingpackage.lpk package for latest Lazarus.
    • - - - -
  • - Imaging doesn't compile in Lazarus, there are errors in ImagingComponents.pas unit! - Lazarus is still beta and breaking changes in LCL occur from time to time. - Imaging release always compiles with latest official Lazarus release. - Fixes are sometimes already in SVN repository but they are commented out - until new Lazarus version is released. - If you get errors in this unit it can be one of these cases: - -
  • You are using latest official Lazarus release that was released - after latest Imaging release: Check Imaging's SVN repository, - LCL version conflicts will probably already be fixed (or fixes would be there - but commented out - so just uncomment them). -
    • -
  • You are using some working Lazarus SVN revision: Check Imaging's SVN repository, - fixes could already be there but commented out. If they're not - please let me know and I'll add them. -
    • -     - So basically if you get the latest Imaging from SVN and problem is still there - with no commented fix please let me know, better yet send the diff patch of - the unit (my thanks to those who did). - - -
  • - Imaging won't compile in Linux, error while linking: "cannot find library stdc++" - This library was needed for JPEG 2000 support but as of Imaging 0.26.2 - it is no longer the case (replaced by libc and few Pascal functions). -
    • -
  • - My compiled programs are very very large! - Delphi: With all file formats enabled your binary can be about ~900KiB bigger than - without Imaging. If you don't like this you can disable some file formats. - Best candidates are: TIFF ~400KiB!, JPEG 2000 ~150KiB, JPEG ~100KiB, - PNG ~50KiB. Info about how to enable/disable file formats - is in File Format Extensions. -
    - FPC: There's no large TIFF support and FPC generated exes are - bigger than Delphi's anyway so binary size may not bother you so much. - But if it does you can disable file formats too. -     -
    • -
  • - How can I display images to user using Imaging? And it should be fast too... - Displaying images wasn't one of Imaging's design goals: - "You can use it to load images, prepare them, and then display them - using some other library designed and optimized for this purpose." - You can quickly and easily create Direct3D, OpenGL, and SDL textures/surfaces - using Imaging and then display them using these APIs. - VCL/LCL TGraphic descendant classes were later added - to allow easy display of your images on you forms. - But it basically just converts image to TBitmap and all drawing - is handled by GDI (GTK/Qt/whatever) just like your regular TBitmap. - Only 32bit images can be directly displayed on TCanvas (GDI/GTK only) - using simple underlying OS/toolkit call in - DisplayImage function (but with no fancy stuff like alpha blending etc.). - - - So Imaging is best used if you prepare your in-memory image with it (load, resample, - change format, gamma correction, alpha blend, etc.) and then show it to - the user using libraries like OpenGL, Direct3D, SDL, Graphics32 - or convert it to TBitmap and use it in regular VCL/LCL way. - -
    • -
  • - Where is collision detection? Window management? Audio support? - Imaging is image library not gaming or any other. It can load, save, - and alter raster images. - -
    • - - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/Features.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/Features.xml deleted file mode 100644 index 6309933..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/Features.xml +++ /dev/null @@ -1,73 +0,0 @@ - - - - Features - - Features - -
  • - Native Object Pascal open source crossplatform library with no dependencies - on any dynamically linked libraries or other platform specific binaries. - Supported platforms are: - -
  • Windows x86/AMD64
    • -
  • Linux x86/AMD64
    • -
  • FreeBSD x86/AMD64
    • -
  • Mac OS X on Intel
    • -     - -
  • - Loading and saving of these image file formats: - -
  • BMP
    • -
  • JPEG, JPEG2000
    • -
  • PNG/APNG, MNG, JNG
    • -
  • GIF
    • -
  • TGA
    • -
  • DDS
    • -
  • PBM, PGM, PPM, PAM, PFM
    • -
  • TIFF
    • -
  • PSD
    • -
  • PCX
    • -
  • XPM
    • -
  • and more
    • - - -
  • - Many internal image data formats: - -
  • 8, 16, 24, 32, 48 and 64 bit RGB and ARGB formats
    • -
  • indexed formats
    • -
  • grayscale formats
    • -
  • floating point formats (IEEE754 and half precision)
    • -
  • compressed formats like DXT1/3/5, 3Dc, and BTC
    • - - -
  • - Basic image manipulation functions working for all supported data formats and - conversions between them (bilinear/bicubic resizing, mipmap generation, - color reduction, ...). -
    • -
  • - Low level library interface (accessible by other programming languages) - and high level OOP one. -
    • -
  • - Extensions for creating OpenGL, Direct3D, and SDL textures/surfaces. -
    • -
  • - VCL and LCL graphic classes and functions. -
    • -
  • - Image drawing with blending, linear and nonlinear filters, point transforms, - binary morphology, drawing lines, ellipses, rectangles, etc. -
    • -
  • - Support for mipmaps, multiimages, direct access to image data, - user-specified file formats, overriding default read and write functions, - and more. -
    • - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/Future.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/Future.xml deleted file mode 100644 index cdc25d5..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/Future.xml +++ /dev/null @@ -1,54 +0,0 @@ - - - - Vampyre Imaging Library Future - - Vampyre Imaging Library Future - - - In the long term I'm planning to redesign and rewrite major parts - (practically create new library - no compatibility with current version) - of library in future to make it more compact and easier to use and extend. - - - - Current 0.2x branch is still be updated from time to time - by minor release (like 0.24.2) or even larger release with more - new functionality (like 0.26.0). - Eventually, this branch will be made into version 1.0 (maybe just - after current 0.26.4 release). - - - - Since I don't have that much free time these days I cannot say when - new library will be ready. Although I have some desings done, it's - still far from usable code. - Working in progress version of Imaging 2.0 will be 1.9x branch in SVN - when there is some code to show. - - - Here is a list of some of the features I want to include in future - Imaging releases: - -
  • new library core
    • -
  • native Pascal TIFF support
    • -
  • register your own data formats
    • -
  • native Pascal JPEG2000 support
    • -
  • more texture related functions
    • -
  • extend canvas class (more effects, drawing of various primitives)
    • -
  • own file format?
    • -
  • more supported platforms (big endian?)
    • -     -     -     - - - - - - - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/History.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/History.xml deleted file mode 100644 index 4480645..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/History.xml +++ /dev/null @@ -1,888 +0,0 @@ - - - - Vampyre Imaging Library History - - - Vampyre Imaging Library History - - - You can find a listing of Imaging versions on this page. - There is the release date of each version together with - a short note and a list of the most important changes that were made. - You can find the change tags explained here - Changes Legend. - - - - -
    - Version 0.26.4 - 11th October 2009 - - For complete list of changes see File Notes - section at the end of each source file. - - -
  • - [+] - APNG file format (Animated PNG) loading, animating, and saving - added to existing PNG support. -
    • -
  • - [+] - Arbitrary angle image rotation. -
    • -
  • - [*] - Mac OS X (Intel) compatibility (garbled LCL bitmaps in Carbon, JPEG 2000 support, ...). -
    • -
  • - [+] - XPM file format saving added, JPEG 2000 file format loading - improved. -
    • -
  • - [+/F] - New canvas methods: premultiply and unpremultiply alpha. - New methods for TFastARGB32Canvas: InvertColors, DrawAlpha/StretchDrawAlpha. - Fixed DrawAlpha/StretchDrawAlpha destination alpha calculation. -
    • -
  • - [+] - Three new extensions in Extras/Extensions directory: - ImagingJpegIJL.pas uses Intel Jpeg Library to load/save Jpegs (DLL needed), - ImagingSquishLib.pas uses Squish DXTC library with Imaging (DLL needed), - ElderImagerySky.pas loads SKY images from Daggerfall. -
    • -
  • - [+] - Conversions between RGB and YCoCg colorspaces. -
    • -
  • - [F] - Bug fixes: loading of some GIFs when using D2009+ failed, - bugged XPM loading in Linux, indexed images resizing leak, - PNM saving using D2009+, DXT3 alpha encoding, RGB>>CMYK conversion, - garbled images in Lazarus GTK IDE. -
    • -
  • - [*] - Delphi 2010 and Lazarus 0.9.28 compatibility fixes. -
    • -     -
    - - -
    - Version 0.26.2 - 28th December 2008 - - For complete list of changes see File Notes - section at the end of each source file. - - -
  • - [*] - Delphi 2009 and Lazarus 0.9.26 compatibility fixes. - New project files for Delphi 2009 added. Kylix and CLX - stuff removed. -
    • -
  • - [+] - New canvas methods: flood and boundary fills, color channel - fills, color level adjustment, histogram calculation. -
    • -
  • - [+] - Animated GIF support rewritten and it now - properly animates all tested GIFs (several thousand, true color ones too). -
    • -
  • - [+] - Added new Extras/Contrib directory with - Imaging modifications, extensions, demos, etc. contributed - by users (now with ExtraGIF, NIF loader, and HqResampler). -
    • -
  • - [*] - Changed LINK defined symbols that control which file formats will be - automatically registered. More in File Format Extensions -
    • -
  • - [+] - PSD images with alpha channel are now saved as layers - to get proper transparency when opened in Photoshop. -
    • -
  • - [*] - Changed conditional compilation of ImagingComponents.pas - unit to properly work with LCL widget sets other than - Win32 and GTK. -
    • -
  • - [*] - Removed linking against libstdc++ library in JPEG 2000 headers in Unix - (replaced with libc and Pascal functions). -
    • -
  • - [F] - Fixed problem with loading of progressive JPEGs (out of memory) - when using FPC Win32. -
    • -     -
    - - -
    - Version 0.26.0 - 27th August 2008 - - For complete list of changes see File Notes - section at the end of each source file. - - -
  • - [+] - New data formats using 3Dc compression added: ifATI1N - and ifATI2N. - DDS file format updated to be able to load and save - images in this format. - OpenGL and Direct3D extensions were updated - to allow creating textures in these formats. -
    • -
  • - [+] - Canvas class was extended with many new methods and effects. - They include image drawing with blending (custom blending factors), - filtered image stretching, nonlinear filters (min, max, median), - point transforms (contrast, brightness, gamma, threshold), and blended - rectangle filling. -
    • -
  • - [+] - New unit ImagingBinary.pas was added to Extras - extensions with morphologic operations on binary images. -
    • -
  • - [+] - XPM file format loader was added to Extras - extensions. -
    • -
  • - [E] - LCL Imager and Image Browser demos were extended - with new functionality provided by canvas class (blending, filters, - morphology, etc.). -
    • -
  • - [*] - Updated OpenJpeg library (JPEG 2000) to version with - my CDEF patch that saves JP2 files with alpha properly. -
    • -
  • - [*] - Changed some file format loaders/savers to be more thread safe - so more images can be loaded concurrently.. -
    • -
  • - [F] - Many bugs in library fixed (GIF, BMP, and PNM loaders, - ConvertSpecial, linear filters, ...). -
    • -     -
    - - -
    - Version 0.24.2 - 11th December 2007 - - For complete list of changes see File Notes - section at the end of each source file. - - -
  • - [*] - Updated OpenJpeg library (JPEG 2000) to latest - revision and added Imaging JPEG support for 64bit Linux. -
    • -
  • - [F] - Fixed various user reported bugs in file format - support for GIF and JPEG images. -
    • -
  • - [*/+] - Compatibility changes and project files for new Pascal - compilers/IDEs: Lazarus 0.9.24 (LCL support update), - FPC 2.2, RAD Studio 2007 (project files). -
    • -
  • - [D] - LCL Imager demo updated - operation timing added. Supports - alpha blending with new Lazarus. -
    • -
  • - [+] - New features added to OpenGL texture builder: skip mipmap levels - and alternate pow2 texture resizing. -
    • -
  • - [+] - Pascal translation of Hq resampler with Imaging demo added - to Extras directory. -
    • -
  • - [F] - Some bugs in library fixed. -
    • -     -
    - - -
    - Version 0.24.0 - 27th June 2007 - - For complete list of changes see File Notes - section at the end of each source file. - - -
  • - [D] - Documentation updated to version 0.24. -
    • -
  • - [+] - TIFF image file format - loading and saving added to Extras. - Not yet native Object Pascal. -
    • -
  • - [+] - GIF image file format - loading and saving added to core library. -
    • -
  • - [+] - New compressed image data format added: ifBTC - (block truncation coding). -
    • -
  • - [*] - Changed headers of some low level interface functions. -
    • -
  • - [+] - High level interface in ImagingClasses.pas unit - was slightly extended. -
    • -
  • - [+] - Other library enhancements (color conversions for 16bit channels, - new buffered file IO, ...). -
    • -
  • - [+/*/F] - Compatibility enhancements (Bitmap saving, JPEG loading, - DDS loading/saving, - UNIX compilation, Win64 compilation, FPC compilation, ...). -
    • -
  • - [F] - Many bugs in library fixed. -
    • -
  • - [+] - Photoshop PSD image file format - loading and saving added to Extras. -
    • -     -
    - - -
    - Version 0.22.0 - 25.01.2007 - - For complete list of changes see File Notes - section at the end of each source file. - - -
  • - [D] - Documentation updated to version 0.22. -
    • -
  • - [E] - Some demos were extended, updated, and some bugs were fixed. -
    • -
  • - [+] - New unit ImagingColors.pas added. - Some color space conversion functions are there now. -
    • -
  • - [*/F] - High level interface in ImagingClasses.pas unit - was extended and many bugs were fixed there. -
    • -
  • - [+] - Canvas class was extended. FrameRect, Rectangle, Ellipse, and Line methods - were added, and you can now specify PenColor, PenMode, and FillMode. - New convolution kernels were added too. -
    • -
  • - [+] - JPEG 2000 image file format - loading and saving added to Extras. - Not yet native Object Pascal. -
    • -
  • - [+] - PCX (ZSoft Paintbrush) image file format - loading added to Extras. -
    • -
  • - [+] - PBM, PGM, PPM, PAM, PFM (Portable Maps) image file formats - loading and saving added. -
    • -
  • - [+] - Elder Imagery extension added to Extras - for loading and saving images from older Bethesda games (Daggerfall mainly). -
    • -
  • - [+] - Added new Extras package (located in - (ImagingRoot)\Extras folder) - with additional extensions, demos, and tools for Imaging. -
    • -
  • - [+] - Functions added to the low level interface: - EnumFileFormats. -
    • -
  • - [+/*] - Many changes to image file format loader/saver classes - for easier creation of new formats (old formats were updated - and some (Bitmap, DDS) have various parts rewritten). - Some new stuff added (file name masks). - Also file format enumeration functions were added. -
    • -
  • - [F] - Many bugs in library fixed. -
    • -     -
    - - -
    - Version 0.20.0 - 30.10.2006 - -
  • - [E] - New demo VampConvert replaced old DXTTool. - Demo High Level was removed because other demos - now use high level interface more. -
    • -
  • - [+] - Added new unit ImagingCanvases.pas with - classes for drawing/effects functions added - (not much functionality here yet). -
    • -
  • - [+/F] - High level interface in ImagingClasses.pas unit - was extended and several bugs here were fixed. -
    • -
  • - [*] - Imaging now compiles and works on 64bit - AMD64 CPU architecture (tested in Linux). -
    • -
  • - [+] - VCL/CLX/LCL support in ImagingComponents.pas unit - was extended. -
    • -
  • - [+] - New image data formats based on half-float (FP16) type added: - ifR16F, ifA16R16G16B16F, ifA16B16G16R16F. - Direct3D and OpenGL extensions now create textures in these formats too. -
    • -
  • - [+] - New low level interface functions: - IsFileFormatSupported, GetPixelDirect, SetPixelDirect, - GetPixel32, SetPixel32, GetPixelFP, SetPixelFP. - GetPixelBytes was removed (same data can be obtained by - GetImageFormatInfo). -
    • -
  • - [F/*] - Many many bug fixes in many parts of the library as well as some optimizations, - changes, and tweaks. -
    • -     -
    - - - -
    - Version 00.18 - 25.04.2006 - Source code is about 620 KiB in size. - -
  • - [D] - Documentation updated to version 0.18. -
    • -
  • - [E] - Demos were extended or updated. -
    • -
  • - [+] - High level interface in ImagingClasses.pas unit - was extended. -
    • -
  • - [*/+] - Mipmap generation in library core and - in Direct3D 9 and OpenGL - extensions is now filtered. - Also Direct3D 9 extension was extended and works - with D3D surfaces now. -
    • -
  • - [F] - There was a bug in conversion between Imaging image - and TBitmap in ImagingComponents.pas - unit when using LCL component set (with GTK interface). -
    • -
  • - [*] - Imaging now compiles and works in - FreeBSD and maybe in other Unixes as well. -
    • -
  • - [+] - Functions added to the low level interface: - StretchRect. -
    • -
  • - [+/*] - Filtered resizing and stretching implemented. ResizeImage - and other functions now take advantage of it. -
    • -
  • - [+] - MNG (Multiple Network Graphics) image file format loading and - saving added. Supports usage of PNG and JNG frames, animation - capabilities are not used. -
    • -
  • - [+] - JNG (JPEG Network Graphics) image file format loading and - saving added. Supports 8 bit gray and 24 bit RGB images with - optional alpha channel. -
    • -
  • - [*/-] - PNG support moved from ImagingPng unit to - the new ImagingNetworkGraphics.pas unit. Old unit was - removed from Imaging. -
    • -
  • - [+] - New unit ImagingNetworkGraphics.pas added for - future handling of all Network Graphics image formats. -
    • -     -
    - - - -
    - Version 00.16 - 22.12.2005 - Source code is about 535 KiB in size. - -
  • - [D] - Documentation updated to version 0.16. -
    • -
  • - [E] - New demos created: D3D Demo, OpenGL Demo (Object Pascal). -
    • -
  • - [+] - Functions added to the low level interface: - RotateImage. -
    • -
  • - [E] - New demos created: SDL Demo, LCL Demo (Object Pascal). -
    • -
  • - [+] - Extension for creating/loading/saving Direct3D 9 - textures using Imaging added to the new ImagingDirect3D9.pas unit. -
    • -
  • - [+] - Extension for creating/loading/saving SDL - surfaces using Imaging added to the new ImagingSDL.pas unit. -
    • -
  • - [+] - Extension for creating/loading/saving OpenGL - textures using Imaging added to the new ImagingOpenGL.pas unit. -
    • -
  • - [+] - Functions added to the low level interface: - ReplaceColor. -
    • -
  • - [+] - TGraphic descendant classes which use Imaging - added for VCL, CLX and - LCL components sets. They are in the new - ImagingComponents.pas unit. -
    • -
  • - [F*] - Bugs (in 48/64 bit image handling) fixed in - PNG (Portable Network Graphics) image file format - handling and support for color keying (if present in image) added. -
    • -
  • - [F] - Headers of some functions exported from Imaging dll/so library were - changed in ImagingExport.pas unit and in the wrappers for - the other languages. -
    • -
  • - [+] - New options ImagingLoadOverrideFormat and - ImagingSaveOverrideFormat added. Also all - option values are checked for validity before they are used. -
    • -     -
    - - - -
    - Version 00.14 - 10.07.2005 - Source code is about 418 KiB in size. - -
  • - [D] - Documentation updated to version 0.14. -
    • -
  • - [E] - New demos created: High Level (Object Pascal), - dotNET Demo01 (Delphi.NET). -
    • -
  • - [*] - You can now use Imaging with MPL or LGPL license. -
    • -
  • - [*] - Large changes in Delphi.NET wrapper. Function names and - parameter types are now almost same as in Object Pascal - without using dll. Some .NET only things added too. -
    • -
  • - [+] - Functions added to low level interface: - NewPalette, CopyPalette, FreePalette, - DetermineFileFormat, DetermineStreamFormat, DetermineMemoryFormat, GetPixelsSize. -
    • -
  • - [*] - Pixel format conversions rewritten to get better color - quality when converting from low bitcounts to higher - (visible mainly when using formats like ifR3G3B2 - or ifA4R4G4B4). -
    • -
  • - [+] - Functions added to low level interface: - MapImageToPalette, FillRect, SplitImage, MakePaletteForImages. -
    • -
  • - [+] - Basic high level interface created. Classes - TSingleImage and TMultiImage - added to ImagingClasses.pas unit. -
    • -
  • - [+] - Functions added to low level interface: - CopyRect. -
    • -
  • - [+] - New image formats added: - ifA16Gray16. -
    • -
  • - [+] - PNG (Portable Network Graphics) image file format loading and - saving added. Supports 1, 2, 4, 8, 16, 24, 32, 48 and 64 bit images. - 1, 2 and 4 bit images can be only loaded. -
    • -
  • - [F] - Various bugs fixed in Imaging, ImagingBitmap - and ImagingExport units, - look there for details. -
    • -
  • - [+] - Functions added to low level interface: - GenerateMipMaps, TestImagesInArray. -
    • -
  • - [+] - Added wrapper unit for Delphi.NET. -
    • -     -
    - - -
    - Version 00.12 - 13.03.2005 - First version released to the public. Source code size - was about 250 KiB in size. - -
  • - [*] - DXTC compression and decompression code optimized - and it is now about 20% faster. -
    • -
  • - [T] - VampyreDoc tool for documentation management created. - It can create XHMTL and HTMLHelp documentation - from XML based projects. -
    • -
  • - [+] - New field IsRBSwapped - added to TImageFormatInfo record. - It is used in conversions and in channel related functions to - distinguish between ARGB and ABGR formats. -
    • -
  • - [+] - New image formats added: - ifA32R32G32B32F, ifA16B16G16R16, ifB16G16R16. -
    • -
  • - [+] - Functions added to low level interface: - ReduceColors, GetImageFormatInfo. -
    • -
  • - [*] - Image format conversions between all types of formats are now - supported (ChannelToIndex and - FloatToIndex implemented). -
    • -
  • - [+] Color quantization with support - for alpha channel (using Median Cut algorithm) added. -
    • -
  • - [F] - Fixed huge memory leak in Windows Bitmap file format (occurred when - loading 8bit uncompressed image). -
    • -
  • - [E] - Demos created: DXT Tool (Object Pascal), Test (C/C++), - VCL Image Browser (Object Pascal). -
    • -
  • - [U] - Vampyre Imaging Library project registered at - SourceForge (03.12.2004). -
    • -
  • - [+] - Added PushOptions and - PopOptions low level functions for - pushing and popping Imaging options. -
    • -
  • - [*] - SwapChannels and - SwapChannelsOfPalette - low level functions extended - to allow to swap all channels, not only red and blue. -
    • -
  • - [*] - Checked and if necessary added support for special image formats - (only DXTC images now) in all low level functions. -
    • -
  • - [+] - DXT1, DXT3 and DXT5 decoding and encoding added. -
    • -
  • - [+] - DDS (DirecDraw Surface) image file format saving added. - Supports mipmaps, cube maps, volume textures and ordinary images. -
    • -
  • - [E] - Demos created: Benchmark (Object Pascal/C++). -
    • -     -
    - - -
    - Version 00.11 - 18.11.2004 - Source code size was about 150 KiB in size. - -
  • - [+] - New image format added: - ifR32F, ifDXT1, ifDXT3, ifDXT5. -
    • -
  • - [+] - DDS (DirecDraw Surface) image file format loading added. - Supports mipmaps, cube maps, volume textures and ordinary images. -
    • -
  • - [+] - New image formats added: - ifX8R8G8B8, ifX1R5G5B5, ifX4R4G4B4. -
    • -
  • - [+] - Property SupportedFormats added to - TImageFileFormat class. - It is set of TImageFormat values - which can be saved by this file format. Also - MakeCompatible method was added. - It converts unsupported formats to supported before saving. -
    • -
  • - [*] - Made PasZLib library compatible with all compilers and platforms - supported by Imaging (needed for PNG support). -
    • -
  • - [+] - New low level functions for palette support added: - FindColor, FillGrayscalePalette, FillCustomPalette, SwapChannelsOfPalette. -
    • -
  • - [+] - Added import unit and header for Object Pascal and C/C++ to - enable using Imaging library compiled into dynamic link library (dll/so). -
    • -
  • - [+] - BMP (Windows Bitmap) image file format loading and saving added. - Supports 1, 4, 8, 16, 24 and 32 bit images with or without RLE compression. - 1 and 4 bit images can be only loaded. -
    • -
  • - [+] - Added support for function inlining in Delphi 2005 (although not tested yet) - and Free Pascal (although compiler crashes on this now). -
    • -
  • - [+] - New image formats added: - ifA8Gray8, ifR3G3B2, ifR1G1B1. -
    • -
  • - [+] - New low level functions added: - ConvertImage, FlipImage, MirrorImage, SwapChannels, CloneImage, - FreeImagesInArray, ResizeImage. -
    • -
  • - [+] - Added image format conversion engine which will support all - members of TImageFormat. - Some indexed and special format conversions are not implemented yet. -
    • -
  • - [+] - TGA (Truevision Targa) image file format loading and saving added. - Supports 8, 15/16, 24 and 32 bit images with or without RLE compression. -
    • -     -
    - - -
    - Version 00.10 - 23.09.2004 - First working version. Source code size was about 80 KiB in size. - -
  • - [+] - JPEG (Joint Photographic Experts Group) image file format loading and saving added. - Supports 8 and 24 bit images. -
    • -
  • - [*] - Made PasJpeg library compatible with all compilers and platforms - supported by Imaging. -
    • -
  • - [+] - Initial low level functions added: - InitImage, NewImage, TestImage, FreeImage, - LoadImageFromFile, LoadImageFromStream, LoadImageFromMemory, - LoadMultiImageFromFile, LoadMultiImageFromStream, LoadMultiImageFromMemory, - SaveImageToFile, SaveImageToStream, SaveImageToMemory, SaveMultiImageToFile, - SaveMultiImageToStream, SaveMultiImageToMemory, SetOption, GetOption, - SetUserFileIO, ResetFileIO, GetPixelBytes. -
    • -
  • - [+] - Initial image formats added: - ifUnknown, ifDefault, ifIndex8, ifGray8, ifGray16, ifGray32, - ifGray64, ifR5G6B5, ifA1R5G5B5, ifA4R4G4B4, ifR8G8B8, ifA8R8G8B8, - ifR16G16B16, ifA16R16G16B16, ifA32B32G32R32F. -
    • -
  • - [*] - Basic structure of library created. -
    • -
  • - [U] - Vampyre Imaging Library project started (about 08.09.2004). -
    • -     -
    -

    - Changes Legend - -
  • [+] Addition (new features, functions etc.)
    • -
  • [-] Removal (old features, functions etc.)
    • -
  • [*] Change (existing features, functions etc. changed or extended)
    • -
  • [F] Bug fix
    • -
  • [D] Documentation related
    • -
  • [E] Examples and demos related
    • -
  • [T] Tools related
    • -
  • [U] Unique event
    • -     - Top -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/Introduction.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/Introduction.xml deleted file mode 100644 index 67c9180..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/Introduction.xml +++ /dev/null @@ -1,25 +0,0 @@ - - - - Introduction - - Introduction - - You can find general information on Imaging library in this section. - What is it, what it does and similar questions are answered here. - - - - In This Section - About - Features - History - Future - Faq - Credits - Contributions - License - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/LGPL.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/LGPL.xml deleted file mode 100644 index 9c72980..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/LGPL.xml +++ /dev/null @@ -1,525 +0,0 @@ - - - - GNU LESSER GENERAL PUBLIC LICENSE - - GNU LESSER GENERAL PUBLIC LICENSE -
    - Version 2.1, February 1999
    -
    - Copyright (C) 1991, 1999 Free Software Foundation, Inc.
    - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
    - Everyone is permitted to copy and distribute verbatim copies
    - of this license document, but changing it is not allowed.
    -
    -[This is the first released version of the Lesser GPL. It also counts
    - as the successor of the GNU Library Public License, version 2, hence
    - the version number 2.1.]
    -
    - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. - - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it becomes -a de-facto standard. To achieve this, non-free programs must be -allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. - - -
    GNU LESSER GENERAL PUBLIC LICENSE
    - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
     - - -
  • 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control compilation -and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - -
    • -
  • 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. -
    • -
  • 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - -
  • a) The modified work must itself be a software library.
    • - -
  • b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change.
    • - -
  • c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License.
    • - -
  • d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.)
    • -     -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - -
  • 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. -
    • -
  • 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - -
    • -
  • 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - -
    • -
  • 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - -
  • a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.)
    • - -
  • b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with.
    • - -
  • c) Accompany the work with a written offer, valid for at - least three years, to give the same user the materials - specified in Subsection 6a, above, for a charge no more - than the cost of performing this distribution.
    • - -
  • d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place.
    • - -
  • e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy.
    • - - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - -
  • 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - -
  • a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above.
    • - -
  • b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work.
    • - - -
  • 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. -
    • -
  • 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. -
    • -
  • 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. -
    • -
  • 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under any -particular circumstance, the balance of the section is intended to apply, -and the section as a whole is intended to apply in other circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. -
    • -
  • 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License may add -an explicit geographical distribution limitation excluding those countries, -so that distribution is permitted only in or among countries not thus -excluded. In such case, this License incorporates the limitation as if -written in the body of this License. -
    • -
  • 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. -
    • -
  • 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. -
    • -
  • NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. -
    • -
  • 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS -
    • - - - How to Apply These Terms to Your New Libraries - -If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms of the -ordinary General Public License). - -To apply these terms, attach the following notices to the library. It is -safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - -<one line to give the library's name and a brief idea of what it does.> -Copyright (C) <year> <name of author> - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public -License as published by the Free Software Foundation; either -version 2.1 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with this library; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - -Yoyodyne, Inc., hereby disclaims all copyright interest in the -library `Frob' (a library for tweaking knobs) written by James Random Hacker. - -<signature of Ty Coon>, 1 April 1990 -Ty Coon, President of Vice - -That's all there is to it! - -     -     - diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/License.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/License.xml deleted file mode 100644 index a222e38..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/License.xml +++ /dev/null @@ -1,14 +0,0 @@ - - - - License - - License - Imaging comes with two licenses from which you can choose the one which - fits your needs best: - -
  • Mozilla Public License
    • -
  • GNU Lesser General Public License
    • -     -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Introduction/MPL.xml b/components/vampireimaging/Doc/VampyreDoc/Introduction/MPL.xml deleted file mode 100644 index ba7868e..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Introduction/MPL.xml +++ /dev/null @@ -1,511 +0,0 @@ - - - - Mozilla Public License 1.1 - - Mozilla Public License 1.1 - - 1. Definitions. - -
  • - 1.0.1. "Commercial Use" means distribution or otherwise making the Covered Code - available to a third party. -
    • -
  • - 1.1. "Contributor" means each entity that creates or contributes to the creation of - Modifications. -
    • -
  • - 1.2. "Contributor Version" means the combination of the Original Code, prior - Modifications used by a Contributor, and the Modifications made by that particular - Contributor. -
    • -
  • - 1.3. "Covered Code" means the Original Code or Modifications or the combination of - the Original Code and Modifications, in each case including portions thereof. -
    • -
  • - 1.4. "Electronic Distribution Mechanism" means a mechanism generally accepted in the - software development community for the electronic transfer of data. -
    • -
  • - 1.5. "Executable" means Covered Code in any form other than Source Code. -
    • -
  • - 1.6. "Initial Developer" means the individual or entity identified as the Initial - Developer in the Source Code notice required by Exhibit A. -
    • -
  • - 1.7. "Larger Work" means a work which combines Covered Code or portions thereof with - code not governed by the terms of this License. -
    • -
  • - 1.8. "License" means this document. -
    • -
  • - 1.8.1. "Licensable" means having the right to grant, to the maximum extent possible, - whether at the time of the initial grant or subsequently acquired, any and all of the - rights conveyed herein. -
    • -
  • - 1.9. "Modifications" means any addition to or deletion from the substance or - structure of either the Original Code or any previous Modifications. When Covered Code is - released as a series of files, a Modification is: - -
  • - (a) Any addition to or deletion from the contents of a file containing Original Code - or previous Modifications. -
    • -
  • - (b) Any new file that contains any part of the Original Code or previous - Modifications. -
    • -     - -
  • - 1.10. "Original Code" means Source Code of computer software code which is - described in the Source Code notice required by Exhibit A as Original Code, and which, - at the time of its release under this License is not already Covered Code governed by this - License. -
    • -
  • - 1.10.1. "Patent Claims" means any patent claim(s), now owned or hereafter acquired, - including without limitation, method, process, and apparatus claims, in any patent - Licensable by grantor. -
    • -
  • - 1.11. "Source Code" means the preferred form of the Covered Code for making - modifications to it, including all modules it contains, plus any associated interface - definition files, scripts used to control compilation and installation of an Executable, or - source code differential comparisons against either the Original Code or another well - known, available Covered Code of the Contributor's choice. The Source Code can be in a - compressed or archival form, provided the appropriate decompression or de-archiving - software is widely available for no charge. -
    • -
  • - 1.12. "You" (or "Your") means an individual or a legal entity exercising rights - under, and complying with all of the terms of, this License or a future version of this - License issued under Section 6.1. For legal entities, "You" includes any entity which - controls, is controlled by, or is under common control with You. For purposes of this - definition, "control" means (a) the power, direct or indirect, to cause the direction or - management of such entity, whether by contract or otherwise, or (b) ownership of more than - fifty percent (50%) of the outstanding shares or beneficial ownership of such entity. -
    • - - - 2. Source Code License. - -
  • - 2.1. The Initial Developer Grant.
    - The Initial Developer hereby grants You a world-wide, royalty-free, non-exclusive license, - subject to third party intellectual property claims: - -
  • - (a) under intellectual property rights (other than patent or trademark) Licensable by - Initial Developer to use, reproduce, modify, display, perform, sublicense and distribute - the Original Code (or portions thereof) with or without Modifications, and/or as part of a - Larger Work; and -
    • -
  • - (b) under Patents Claims infringed by the making, using or selling of Original - Code, to make, have made, use, practice, sell, and offer for sale, and/or otherwise - dispose of the Original Code (or portions thereof). -
    • (c) the licenses granted in this Section 2.1(a) and (b) are effective on the - date Initial Developer first distributes Original Code under the terms of this License. -
  • - (d) Notwithstanding Section 2.1(b) above, no patent license is granted: - 1) for code that You delete from the Original Code; - 2) separate from the Original Code; - or 3)for infringements caused by: i) the modification of the Original Code or ii) the - combination of the Original Code with other software or devices. -
    • -     - -
  • 2.2. Contributor Grant.
    - Subject to third party intellectual property claims, each Contributor hereby grants You a - world-wide, royalty-free, non-exclusive license - -
  • - (a) under intellectual property rights (other than patent or trademark) Licensable - by Contributor, to use, reproduce, modify, display, perform, sublicense and distribute the - Modifications created by such Contributor (or portions thereof) either on an unmodified - basis, with other Modifications, as Covered Code and/or as part of a Larger Work; and -
    • -
  • - (b) under Patent Claims infringed by the making, using, or selling of - Modifications made by that Contributor either alone and/or in combination with its - Contributor Version (or portions of such combination), to make, use, sell, offer for - sale, have made, and/or otherwise dispose of: 1) Modifications made by that Contributor - (or portions thereof); and 2) the combination of Modifications made by that Contributor - with its Contributor Version (or portions of such combination). -
    • -
  • - (c) the licenses granted in Sections 2.2(a) and 2.2(b) are effective on the date - Contributor first makes Commercial Use of the Covered Code. -
    • -
  • - (d) Notwithstanding Section 2.2(b) above, no patent license is granted: 1) for any - code that Contributor has deleted from the Contributor Version; 2) separate from the - Contributor Version; 3) for infringements caused by: i) third party modifications of - Contributor Version or ii) the combination of Modifications made by that Contributor with - other software (except as part of the Contributor Version) or other devices; or 4) under - Patent Claims infringed by Covered Code in the absence of Modifications made by that - Contributor. -
    • - - - - - 3. Distribution Obligations. - -
  • - 3.1. Application of License.
    - The Modifications which You create or to which You contribute are governed by the terms of - this License, including without limitation Section 2.2. The Source Code version of - Covered Code may be distributed only under the terms of this License or a future version of - this License released under Section 6.1, and You must include a copy of this License - with every copy of the Source Code You distribute. You may not offer or impose any terms on - any Source Code version that alters or restricts the applicable version of this License or - the recipients' rights hereunder. However, You may include an additional document offering - the additional rights described in Section 3.5. -
    • -
  • - 3.2. Availability of Source Code.
    - Any Modification which You create or to which You contribute must be made available in - Source Code form under the terms of this License either on the same media as an Executable - version or via an accepted Electronic Distribution Mechanism to anyone to whom you made an - Executable version available; and if made available via Electronic Distribution Mechanism, - must remain available for at least twelve (12) months after the date it initially became - available, or at least six (6) months after a subsequent version of that particular - Modification has been made available to such recipients. You are responsible for ensuring - that the Source Code version remains available even if the Electronic Distribution - Mechanism is maintained by a third party. -
    • -
  • - 3.3. Description of Modifications.
    - You must cause all Covered Code to which You contribute to contain a file documenting the - changes You made to create that Covered Code and the date of any change. You must include a - prominent statement that the Modification is derived, directly or indirectly, from Original - Code provided by the Initial Developer and including the name of the Initial Developer in - (a) the Source Code, and (b) in any notice in an Executable version or related - documentation in which You describe the origin or ownership of the Covered Code. -
    • -
  • - 3.4. Intellectual Property Matters - -
  • - (a) Third Party Claims.
    - If Contributor has knowledge that a license under a third party's intellectual property - rights is required to exercise the rights granted by such Contributor under Sections 2.1 or - 2.2, Contributor must include a text file with the Source Code distribution titled "LEGAL" - which describes the claim and the party making the claim in sufficient detail that a - recipient will know whom to contact. If Contributor obtains such knowledge after the - Modification is made available as described in Section 3.2, Contributor shall promptly - modify the LEGAL file in all copies Contributor makes available thereafter and shall take - other steps (such as notifying appropriate mailing lists or newsgroups) reasonably - calculated to inform those who received the Covered Code that new knowledge has been - obtained. -
    • -
  • - (b) Contributor APIs.
    - If Contributor's Modifications include an application programming interface and - Contributor has knowledge of patent licenses which are reasonably necessary to implement - that API, Contributor must also include this information in the LEGAL file. -
    • -
  • (c) Representations.
    - Contributor represents that, except as disclosed pursuant to Section 3.4(a) above, - Contributor believes that Contributor's Modifications are Contributor's original - creation(s) and/or Contributor has sufficient rights to grant the rights conveyed by this - License. -
    • -     - -
  • - 3.5. Required Notices.
    - You must duplicate the notice in Exhibit A in each file of the Source Code. If it - is not possible to put such notice in a particular Source Code file due to its structure, - then You must include such notice in a location (such as a relevant directory) where a user - would be likely to look for such a notice. If You created one or more Modification(s) You - may add your name as a Contributor to the notice described in Exhibit A. You must - also duplicate this License in any documentation for the Source Code where You describe - recipients' rights or ownership rights relating to Covered Code. You may choose to offer, - and to charge a fee for, warranty, support, indemnity or liability obligations to one or - more recipients of Covered Code. However, You may do so only on Your own behalf, and not on - behalf of the Initial Developer or any Contributor. You must make it absolutely clear than - any such warranty, support, indemnity or liability obligation is offered by You alone, and - You hereby agree to indemnify the Initial Developer and every Contributor for any liability - incurred by the Initial Developer or such Contributor as a result of warranty, support, - indemnity or liability terms You offer. -
    • -
  • - 3.6. Distribution of Executable Versions.
    - You may distribute Covered Code in Executable form only if the requirements of Section - 3.1-3.5 have been met for that Covered Code, and if You include a notice stating - that the Source Code version of the Covered Code is available under the terms of this - License, including a description of how and where You have fulfilled the obligations of - Section 3.2. The notice must be conspicuously included in any notice in an - Executable version, related documentation or collateral in which You describe recipients' - rights relating to the Covered Code. You may distribute the Executable version of Covered - Code or ownership rights under a license of Your choice, which may contain terms different - from this License, provided that You are in compliance with the terms of this License and - that the license for the Executable version does not attempt to limit or alter the - recipient's rights in the Source Code version from the rights set forth in this License. If - You distribute the Executable version under a different license You must make it absolutely - clear that any terms which differ from this License are offered by You alone, not by the - Initial Developer or any Contributor. You hereby agree to indemnify the Initial Developer - and every Contributor for any liability incurred by the Initial Developer or such - Contributor as a result of any such terms You offer. -
    • -
  • - 3.7. Larger Works.
    - You may create a Larger Work by combining Covered Code with other code not governed by the - terms of this License and distribute the Larger Work as a single product. In such a case, - You must make sure the requirements of this License are fulfilled for the Covered Code. -
    • - - - - 4. Inability to Comply Due to Statute or Regulation. - - -
  • - If it is impossible for You to comply with any of the terms of this License with respect to - some or all of the Covered Code due to statute, judicial order, or regulation then You must: - (a) comply with the terms of this License to the maximum extent possible; and (b) describe - the limitations and the code they affect. Such description must be included in the LEGAL file - described in Section 3.4 and must be included with all distributions of the Source - Code. Except to the extent prohibited by statute or regulation, such description must be - sufficiently detailed for a recipient of ordinary skill to be able to understand it. -
    • -     - - - 5. Application of this License. - - -
  • - This License applies to code to which the Initial Developer has attached the notice in - Exhibit A and to related Covered Code. -
    • -     - - - 6. Versions of the License. - - -
  • - 6.1. New Versions.
    - Netscape Communications Corporation ("Netscape") may publish revised and/or new versions of - the License from time to time. Each version will be given a distinguishing version number. -
    • -
  • - 6.2. Effect of New Versions.
    - Once Covered Code has been published under a particular version of the License, You may - always continue to use it under the terms of that version. You may also choose to use such - Covered Code under the terms of any subsequent version of the License published by - Netscape. No one other than Netscape has the right to modify the terms applicable to - Covered Code created under this License. -
    • -
  • - 6.3. Derivative Works.
    - If You create or use a modified version of this License (which you may only do in order to - apply it to code which is not already Covered Code governed by this License), You must (a) - rename Your license so that the phrases "Mozilla", "MOZILLAPL", "MOZPL", "Netscape", "MPL", - "NPL" or any confusingly similar phrase do not appear in your license (except to note that - your license differs from this License) and (b) otherwise make it clear that Your version - of the license contains terms which differ from the Mozilla Public License and Netscape - Public License. (Filling in the name of the Initial Developer, Original Code or Contributor - in the notice described in Exhibit A shall not of themselves be deemed to be - modifications of this License.) -
    • -     - - - 7. DISCLAIMER OF WARRANTY. - - -
  • - COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, WITHOUT WARRANTY OF ANY - KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, WARRANTIES THAT THE COVERED - CODE IS FREE OF DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE OR NON-INFRINGING. THE - ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED CODE IS WITH YOU. SHOULD ANY - COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, YOU (NOT THE INITIAL DEVELOPER OR ANY OTHER - CONTRIBUTOR) ASSUME THE COST OF ANY NECESSARY SERVICING, REPAIR OR CORRECTION. THIS - DISCLAIMER OF WARRANTY CONSTITUTES AN ESSENTIAL PART OF THIS LICENSE. NO USE OF ANY COVERED - CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. -
    • -     - - - 8. TERMINATION. - - -
  • - 8.1. This License and the rights granted hereunder will terminate automatically if You - fail to comply with terms herein and fail to cure such breach within 30 days of becoming - aware of the breach. All sublicenses to the Covered Code which are properly granted shall - survive any termination of this License. Provisions which, by their nature, must remain in - effect beyond the termination of this License shall survive. -
    • -
  • - 8.2. If You initiate litigation by asserting a patent infringement claim (excluding - declatory judgment actions) against Initial Developer or a Contributor (the Initial - Developer or Contributor against whom You file such action is referred to as "Participant") - alleging that: - - -
  • - (a) such Participant's Contributor Version directly or indirectly infringes any - patent, then any and all rights granted by such Participant to You under Sections 2.1 - and/or 2.2 of this License shall, upon 60 days notice from Participant terminate - prospectively, unless if within 60 days after receipt of notice You either: (i) agree in - writing to pay Participant a mutually agreeable reasonable royalty for Your past and - future use of Modifications made by such Participant, or (ii) withdraw Your litigation - claim with respect to the Contributor Version against such Participant. If within 60 days - of notice, a reasonable royalty and payment arrangement are not mutually agreed upon in - writing by the parties or the litigation claim is not withdrawn, the rights granted by - Participant to You under Sections 2.1 and/or 2.2 automatically terminate at the - expiration of the 60 day notice period specified above. -
    • -
  • - (b) any software, hardware, or device, other than such Participant's Contributor - Version, directly or indirectly infringes any patent, then any rights granted to You by - such Participant under Sections 2.1(b) and 2.2(b) are revoked effective as of the date - You first made, used, sold, distributed, or had made, Modifications made by that - Participant. -
    • -     - -
  • - 8.3. If You assert a patent infringement claim against Participant alleging that - such Participant's Contributor Version directly or indirectly infringes any patent where - such claim is resolved (such as by license or settlement) prior to the initiation of patent - infringement litigation, then the reasonable value of the licenses granted by such - Participant under Sections 2.1 or 2.2 shall be taken into account in determining the amount - or value of any payment or license. -
    • -
  • - 8.4. In the event of termination under Sections 8.1 or 8.2 above, all end user - license agreements (excluding distributors and resellers) which have been validly granted - by You or any distributor hereunder prior to termination shall survive termination. -
    • - - - - 9. LIMITATION OF LIABILITY. - - -
  • - UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT (INCLUDING NEGLIGENCE), - CONTRACT, OR OTHERWISE, SHALL YOU, THE INITIAL DEVELOPER, ANY OTHER CONTRIBUTOR, OR ANY - DISTRIBUTOR OF COVERED CODE, OR ANY SUPPLIER OF ANY OF SUCH PARTIES, BE LIABLE TO ANY PERSON - FOR ANY INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY CHARACTER INCLUDING, - WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, WORK STOPPAGE, COMPUTER FAILURE OR - MALFUNCTION, OR ANY AND ALL OTHER COMMERCIAL DAMAGES OR LOSSES, EVEN IF SUCH PARTY SHALL HAVE - BEEN INFORMED OF THE POSSIBILITY OF SUCH DAMAGES. THIS LIMITATION OF LIABILITY SHALL NOT - APPLY TO LIABILITY FOR DEATH OR PERSONAL INJURY RESULTING FROM SUCH PARTY'S NEGLIGENCE TO THE - EXTENT APPLICABLE LAW PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE - EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO THIS EXCLUSION AND - LIMITATION MAY NOT APPLY TO YOU. -
    • -     - - - 10. U.S. GOVERNMENT END USERS. - - -
  • - The Covered Code is a "commercial item," as that term is defined in 48 C.F.R. 2.101 (Oct. - 1995), consisting of "commercial computer software" and "commercial computer software - documentation," as such terms are used in 48 C.F.R. 12.212 (Sept. 1995). Consistent with 48 - C.F.R. 12.212 and 48 C.F.R. 227.7202-1 through 227.7202-4 (June 1995), all U.S. Government - End Users acquire Covered Code with only those rights set forth herein. -
    • -     - - - 11. MISCELLANEOUS. - - -
  • - This License represents the complete agreement concerning subject matter hereof. If any - provision of this License is held to be unenforceable, such provision shall be reformed only - to the extent necessary to make it enforceable. This License shall be governed by California - law provisions (except to the extent applicable law, if any, provides otherwise), excluding - its conflict-of-law provisions. With respect to disputes in which at least one party is a - citizen of, or an entity chartered or registered to do business in the United States of - America, any litigation relating to this License shall be subject to the jurisdiction of the - Federal Courts of the Northern District of California, with venue lying in Santa Clara - County, California, with the losing party responsible for costs, including without - limitation, court costs and reasonable attorneys' fees and expenses. The application of the - United Nations Convention on Contracts for the International Sale of Goods is expressly - excluded. Any law or regulation which provides that the language of a contract shall be - construed against the drafter shall not apply to this License. -
    • -     - - - 12. RESPONSIBILITY FOR CLAIMS. - - -
  • - As between Initial Developer and the Contributors, each party is responsible for claims and - damages arising, directly or indirectly, out of its utilization of rights under this License - and You agree to work with Initial Developer and Contributors to distribute such - responsibility on an equitable basis. Nothing herein is intended or shall be deemed to - constitute any admission of liability. -
    • -     - - - 13. MULTIPLE-LICENSED CODE. - - -
  • - Initial Developer may designate portions of the Covered Code as Multiple-Licensed. - Multiple-Licensed means that the Initial Developer permits you to utilize portions of the - Covered Code under Your choice of the MPL or the alternative licenses, if any, specified by - the Initial Developer in the file described in Exhibit A. -
    • -     - - - EXHIBIT A - Mozilla Public License. - - -
  • - -The contents of this file are used with permission, subject to the Mozilla -Public License Version 1.1 (the "License"); you may not use this file except -in compliance with the License. You may obtain a copy of the License at -http://www.mozilla.org/MPL/MPL-1.1.html - -Software distributed under the License is distributed on an "AS IS" basis, -WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for -the specific language governing rights and limitations under the License. - -The Original Code is ______________________________________. -The Initial Developer of the Original Code is ________________________. -Portions created by _____________________ are Copyright (C) -______ _______________________. All Rights Reserved. - -Contributor(s): ______________________________________. - -Alternatively, the contents of this file may be used under the terms of the _____ license -(the [___] License), in which case the provisions of [______] License are applicable -instead of those above. If you wish to allow use of your version of this file only under -the terms of the [____] License and not to allow others to use your version of this file -under the MPL, indicate your decision by deleting the provisions above and replace them -with the notice and other provisions required by the [___] License. If you do not delete -the provisions above, a recipient may use your version of this file under either the MPL or -the [___] License. - - - [NOTE: The text of this Exhibit A may differ slightly from the text of the notices in the - Source Code files of the Original Code. You should use the text of this Exhibit A rather - than the text found in the Original Code Source Code for Your Modifications.] - -
    • -     -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Canvas.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Canvas.xml deleted file mode 100644 index 4444ac0..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Canvas.xml +++ /dev/null @@ -1,146 +0,0 @@ - - - - Canvas Class Tips - - Canvas Class Tips - - You can find few code snippets that show how to use - TImagingCanvas class to draw onto images. - - - Canvas Creation And Updating - - You can create canvas for both TBaseImage - class descendants and TImageData structure. - - - uses - Imaging, ImagingTypes, ImagingClasses, ImagingCanvases; - var - ImgData: TImageData; - ImgObj: TSingleImage; - Canvas: TImagingCanvas; - begin - // Load image to TImageData struct - InitImage(ImgData); - LoadImageFromFile('umajo.png', ImgData); - // Load image to TSingleImage object - ImgObj := TSingleImage.CreateFromFile('umajo2.png'); - - // Create canvas for ImgData - Canvas := TImagingCanvas.CreateForData(@ImgData); - // Do some drawing - ... - // Resize image, you must then update canvas - ResizeImage(ImgData, 600, 400, rfBicubic); - Canvas.UpdateCanvasState; - // Draw some more - ... - - // Recreate canvas, now for high level object - Canvas.CreateForImage(ImgObj); - // Do some drawing - ... - // Change image format, you must then update canvas - ImgObj.Format := ifGray8; - Canvas.UpdateCanvasState; - // Draw some more - ... - - - // Free all - FreeImage(ImgData); - Canvas.Free; - ImgObj.Free; - end; - - - Drawing Primitives And Filling - - Now you will see how to draw lines, ellipses, and - rectangles. - - - Canvas := TImagingCanvas.CreateForImage(Image); - ... - // You can set colors as 32bit or FP 128bit, they're automatically converted - Canvas.FillColor32 := $FF808040; - Canvas.PenColorFP := ColorFP(1.0, 0.6, 0.6, 1.0); - // Set fill mode and pen mode to solid - Canvas.PenMode := pmSolid; - Canvas.FillMode := fmSolid; - - // Now set some pixels and draw lines using pen - Canvas.Pixels32[200, 200] := $80FF0000; - Canvas.VertLine(20, 0, Image.Height); - Canvas.HorzLine(0, Image.Widht, 20); - Canvas.Line(10, 10, 90, 100); - - // Draw filled rectangle and ellipse with outline - Canvas.Rectangle(Canvas.ClipRect); - Canvas.Ellipse(Canvas.ClipRect); - - // Draw outlined rectangle and ellipse - Canvas.FillMode := fmClear; - Canvas.Rectangle(Rect(0, 0, 50, 100)); - Canvas.Ellipse(Rect(0, 0, 50, 100)); - - // Clear whole canvas (uses fill color) - Canvas.FillColor32 := $FF000000; - Canvas.Clear - - - Drawing Image - - You can draw part of the canvas on another canvas. - Blending with custom source and dest factors is supported with some - best known combinations predefined (like alpha blending). - Stretching part of the canvas is also possible with - optional filtering (bilinear, bicubic, nearest). - - - Canvas := TImagingCanvas.CreateForImage(Image); - ... - // Stretch part of canvas onto another one with alpha blending and bicubic filtering - Canvas.StretchDrawAlpha(SrcRect, DestCanvas, DestRect, rfBicubic); - // Draw part of canvas onto another one with custom combination of blend factors - Canvas.DrawBlend(SrcRect, DestCanvas, DestX, DestY, bfDstColor, bfSrcAlpha); - // Draw part of canvas onto another one with additive blending - Canvas.DrawAdd(SrcRect, DestCanvas, DestX, DestY); - // Draw part of canvas onto another one with additive blending (using factors) - Canvas.DrawBlend(SrcRect, DestCanvas, DestX, DestY, bfOne, bfOne); - // Stretch part of canvas onto another one with addtive blending and bilinear filtering (default param) - Canvas.StretchDrawAdd(SrcRect, DestCanvas, DestRect); - - - Effects - - Canvas class also allows you to apply linear and nonlinear filters - and use point transforms. You can always use your own kernels - and functions but there are also some predefined. - - - Canvas := TImagingCanvas.CreateForImage(Image); - ... - // 3x3 Gaussian blurr - Canvas.ApplyConvolution3x3(FilterGaussian3x3); - // 7x7 Median filter - Canvas.ApplyMedianFilter(7); - // Modify contrast and brightness - Canvas.ModifyContrastBrightness(20, -10); - // Adjust gamma for each color channel - Canvas.GammaCorection(0.9, 1.3, 0.75); - - - - Look at VCL Image Browser Demo - and LCL Imager Demo - for more Canvas examples. - General info on canvas usage is in - Using Canvas Class - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Components/ProcComp.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Components/ProcComp.xml deleted file mode 100644 index 1709255..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Components/ProcComp.xml +++ /dev/null @@ -1,97 +0,0 @@ - - - - How To ... (VCL/LCL Classes) - - How To ... (VCL/LCL Classes) - - This section shows few possible usages of - VCL/LCL Imaging Classes and related functions - described in - VCL/LCL Classes. - You can also learn how to use these classes - by looking at demos which use them - Pascal Demos. - - - - Using TGraphic Imaging descendants: - -... - -uses - ImagingTypes, Imaging, ImagingClasses, - // Add unit with VCL/LCL support, new file formats are automatically - // registered to TPicture (so they will appear in TOpenPictureDialog for example) - ImagingComponents; - -... - -procedure Assignments; -var - ImgBitmap: TImagingBitmap; - ImgData: TImageData; - ImgClass: TBaseImage -begin - // Create empty Imaging bitmap - ImgBitmap := TImagingBitmap.Create; - // Load image from file to TImageData record and assign it to bitmap - InitImage(ImgData); - LoadImageFromFile('littlecat.png', ImgData); - ImgBitmap.AssignFromData(ImgData); - // Now create high level image class from file and assign it to bitmap - // by overridden TPersistent.Assign method - ImgClass := TSingleImage.CreateFromFile('notsolittlecat.png'); - ImgBitmap.Assign(ImgClass); - // Assign Imaging bitmap to TImage component on Form1 (it should be immediately - // displayed) - Form1.Image.Picture.Graphic := ImgBitmap; - // Free loaded images - FreeImage(ImgData); - ImgClass.Free; -end; - - - Displaying Imaging's images in VCL/LCL: - -// This procedure shows given image (high level class) on form -// by converting it to TBitmap and then drawing on form's canvas -procedure ShowImageOnForm1(Form: TForm; Image: TBaseImage); -var - Bitmap: TBitmap; -begin - Bitmap := TBitmap.Create; - // Call Imaging procedure for converting images to Graphics' TBitmap object - ConvertImageToBitmap(Image, Bitmap); - // Draw bitmap onto form's canvas - Form.Canvas.Draw(0, 0, Bitmap); - Bitmap.Free; -end; - -// This procedure shows given image (high level class) on form's -// canvas directly without conversion so it is significantly faster -// than ShowImageOnForm1. But it has a drawback: it does not work -// with all image data formats. -procedure ShowImageOnForm2(Form: TForm; Image: TBaseImage); -begin - // Call Imaging procedure for displaying images directly on canvas without - // costly conversion. Drawback of this is that it supports only images in - // ifA8R8G8B8 data format - DisplayImage(Form.Canvas, Form.BoundsRect, Image, Image.BoundsRect); -end; - -// You have TBitmap and you want to save it as PNG or other file format -// supported by Imaging -procedure SaveBitmapAsPNG(Bitmap: TBitmap; const FileName: string); -var - PNG: TImagingPNG; -begin - PNG := TImagingPNG.Create; - PNG.Assign(Bitmap); - PNG.SaveToFile(FileName); - PNG.Free; -end; - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/High/High.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/High/High.xml deleted file mode 100644 index 04d14e4..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/High/High.xml +++ /dev/null @@ -1,72 +0,0 @@ - - - - How To ... (High Level) - - How To ... (High Level) - - High Level interface in the current version is made of - the base class TBaseImage and its two descendants - TSingleImage and TMultiImage. - More information on the current state of high level interface - can be found in - Usage/High Level Interface - section. - - You can learn how to use high level interface from the - following code fragments or (more useful) high level - Pascal Demos. - - -// high level interface test -uses - ImagingTypes, - // high level classes are declared in this unit - ImagingClasses; -var - // this is one level image container - SImg: TSingleImage; - // this is multi level image container - MImg: TMultiImage; -begin - // new 400x300x24 image is created - SImg := TSingleImage.CreateFromParams(400, 300, ifR8G8B8); - // resize image - SImg.Resize(512, 384, rfBicubic); - // you can find out whether image is valid or not this way: - if SImg.Valid then - WriteLn('Image is valid!'); - // you are free to use low level functions on high level classes - // you can use ImageData property to get access to underlying structure - SwapChannels(SImg.ImageDataPointer^, ChannelRed, ChannelGreen); - // image can be converted to another format by simply setting Format property - SImg.Format := ifIndex8; - // extended format info is accessible trough FormatInfo property - WriteLn('Image has ', SImg.FormatInfo.PaletteEntries, ' palette entries'); - - // new multi image without parameters is created (default sized 1 level image - // will be created) - MImg := TMultiImage.Create; - // single image is assigned to multi image - multi image will now have - // one level identical to source single image - MImg.Assign(SImg); - // single image is resized - SImg.Width := SImg.Width * 2; - // new level is added to multi image (SImg is cloned) - MImg.AddLevel(SImg); - // single image is converted - SImg.Format := ifR32F; - // new level is inserted to multi image at index 0 (SImg is cloned) - MImg.InsertLevel(0, SImg); - // all levels of multi image are written to stream - MImg.SaveMultiToStream('tga', SomeStream); - - // images are freed - SImg.Free; - MImg.Free; -end. - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/DdsFiles.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/DdsFiles.xml deleted file mode 100644 index ff95648..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/DdsFiles.xml +++ /dev/null @@ -1,196 +0,0 @@ - - - - Loading and Saving DDS Files - - Loading and Saving DDS Files - - DirectDraw Surface is Microsoft's file format for storing textures. - You can find information on this file format and on its Imaging support - in Supported File Formats/DDS - section. This section shows how to perform - some load/save operations specific for DDS files (cube map and volume texture support). - Each example consists of description of a action you want to do and - code listing in which the action is carried out by Imaging. - - - Example 1: Simple Loading and Saving - - You have single texture without mipmaps and you want to load it and - save it. - - - -uses - ImagingTypes, Imaging; -var - Img: TImageData; -begin - // call this before using any TImageData record - InitImage(Img); - // load texture from file - LoadImageFromFile('X:\images\tex01.dds', Img); - ... - // do something with the image - ... - // save the image to file - SaveImageToFile('X:\images\tex02.dds', Img); - // memory occupied by the image is freed - FreeImage(Img); -end. - - - - Example 2: Loading and Saving Mipmapped Texture - - You have single texture with mipmaps and you want to load it and - save it. - - - - Imaging saves mipmaps in the same order as you send them to - SaveMultiImageTo* functions in Images parameter. - Mipmap dimensions (next level has width and height of the previous level divided by two) - and format (must be same as the main image's) are automatically adjusted - during saving. - - - -uses - ImagingTypes, Imaging; -var - ImgArray: TDynImageDataArray; - MipMapLevels: LongInt; -begin - // load texture from file - LoadMultiImageFromFile('X:\images\tex01mip.dds', ImgArray); - // get the number of mipmap levels in the loaded DDS file - // in this case it is equal to Length(ImgArray) - MipMapLevels := GetOption(ImagingDDSLoadedMipMapCount); - ... - // do something with the image - ... - // save the texture with mipmaps to file, number of mipmaps saved to - // file will be Length(ImgArray) - SaveMultiImageToFile('X:\images\tex02mip.dds', ImgArray); - // memory occupied by the images is freed - FreeImagesInArray(ImgArray); -end. - - - - Example 3: Loading and Saving Mipmapped Cube Map - - You have cubic environment map with mipmaps and you want to load it and - save it. - The cube faces in DDS files are written in this order: positive x, negative x, - positive y, negative y, positive z, negative z. - Each face is written with its main image - followed by any mipmap levels. All faces must be the same size - and have the same number of mipmap levels. - - - Imaging saves cube faces and mipmaps in the same order as you send them to - SaveMultiImageTo* functions in Images parameter. - Make sure that number of images you send to saving functions is equal to - NumberOfFaces * MipMapLevels where these two values are defined by options - interface (see code below). If the number of images is not right then DDS is - saved as simple 2D texture. - Mipmap dimensions (next level has width and height of the previous level divided by two) - and format (must be same as the main image's) are automatically adjusted - during saving. - - -uses - ImagingTypes, Imaging; -var - ImgArray: TDynImageDataArray; - MipMapLevels, Faces: LongInt; - IsCubeMap: Boolean; -begin - // load texture from file - LoadMultiImageFromFile('X:\images\tex01cubemip.dds', ImgArray); - // get the number of mipmap levels in the loaded DDS file - // in this case it is equal to Length(ImgArray) div Faces - MipMapLevels := GetOption(ImagingDDSLoadedMipMapCount); - // check whether we have loaded cube map - IsCubeMap := Boolean(GetOption(ImagingDDSLoadedCubeMap)); - // get the number of cube faces in the loaded DDS file - // Length(ImgArray) = Faces * MipMapLevels - Faces := GetOption(ImagingDDSLoadedDepth); - ... - // do something with the image - ... - // tell Imaging how many mipmap levels next DDS file should have (for each face) - SetOption(ImagingDDSSaveMipMapCount, MipMapLevels); - // tell Imaging that the next DDS file should be cubic environment map - SetOption(ImagingDDSSaveCubeMap, IsCubeMap); - // tell Imaging how many faces next DDS file should have - SetOption(ImagingDDSSaveDepth, Faces); - // save the cube map with mipmaps to file - SaveMultiImageToFile('X:\images\tex02cubemip.dds', ImgArray); - // memory occupied by the images is freed - FreeImagesInArray(ImgArray); -end. - - - Example 4: Loading and Saving Mipmapped Volume Texture - - You have volume texture with mipmaps and you want to load it and - save it. - For volumes without mipmaps, - each depth slice is written to the file in order. - If mipmaps are included, all depth slices for a given mipmap - level are written together, with each level - containing half as many slices as the previous level - with a minimum of 1. Volume textures do not support - DXTn compression as of DirectX 9.0. - - - Imaging saves volume slices and mipmaps in the same order as you send them to - SaveMultiImageTo* functions in Images parameter. - Make sure that number of images you send to saving functions is right - (it is not NumberOfFaces * MipMapLevels!). - If the number of images is not right then DDS is - saved as simple 2D texture. - Mipmap dimensions (next level has width and height of the previous level divided by two) - and format (must be same as the main image's) are automatically adjusted - during saving. - - -uses - ImagingTypes, Imaging; -var - ImgArray: TDynImageDataArray; - MipMapLevels, Slices: LongInt; - IsVolume: Boolean; -begin - // load texture from file - LoadMultiImageFromFile('X:\images\tex01volmip.dds', ImgArray); - // get the number of mipmap levels in the loaded DDS file - // in this case it is NOT equal to Length(ImgArray) div Slices - MipMapLevels := GetOption(ImagingDDSLoadedMipMapCount); - // check whether we have loaded volume texture - IsVolume := Boolean(GetOption(ImagingDDSLoadedVolume)); - // get the number of volume slices in the loaded DDS file - // Length(ImgArray) <> Slices * MipMapLevels - Slices := GetOption(ImagingDDSLoadedDepth); - ... - // do something with the image - ... - // tell Imaging how many mipmap levels next DDS file should have - SetOption(ImagingDDSSaveMipMapCount, MipMapLevels); - // tell Imaging that the next DDS file should be volume texture - SetOption(ImagingDDSSaveVolume, IsVolume); - // tell Imaging how many slices next DDS file should have - SetOption(ImagingDDSSaveDepth, Slices); - // save the volume texture with mipmaps to file - SaveMultiImageToFile('X:\images\tex02volmip.dds', ImgArray); - // memory occupied by the images is freed - FreeImagesInArray(ImgArray); -end. - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Loading.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Loading.xml deleted file mode 100644 index 14f7b1a..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Loading.xml +++ /dev/null @@ -1,153 +0,0 @@ - - - - Loading Images - - Loading Images - - Images can be loaded from the files on disk, from the streams or - from a memory referenced by a pointer. - The following table lists functions for loading images. These are low level - functions operating on TImageData structure. - - - - -
    Function name
    -
    Usage
    -     - - LoadImageFromFile - Load single image from file - - - LoadImageFromStream - Load single image from stream - (TStream descendants, Object Pascal only) - - - LoadImageFromMemory - Load single image from memory - - - LoadMultiImageFromFile - Load multiple images from file - - - LoadMultiImageFromStream - Load multiple images from stream - (TStream descendants, Object Pascal only) - - - LoadMultiImageFromMemory - Load multiple images from memory - -
    - - - If you want to make sure that image in file is really in format - suggested by its extension or if you have some unknown images - in stream or memory, you can use these functions to get - their file format: - - - - -
    Function name
    -
    Usage
    -     - - DetermineFileFormat - Determines format of image specified by its file name - - - DetermineStreamFormat - Determines format of image located in stream - (TStream descendants, Object Pascal only) - - - DetermineMemoryFormat - Determines format of image located in memory - -
    - - - This example loads image from file and prints its width, height and - size of memory it occupies. - - -uses - SysUtils, Classes, ImagingTypes, Imaging; -var - Img: TImageData; -begin - // call this before using any TImageData record - InitImage(Img); - // load tigers from file - LoadImageFromFile('X:\images\tigers.jpg', Img); - //write some image info - WriteLn('Mighty tigers have resolution ', Img.Width, 'x', Img.Height, - ' and occupy ', Img.Size, ' bytes of your memory.'); - // memory occupied by image is freed - FreeImage(Img); -end. - - - - This example shows how to load multiple images stored in one file - (DDS texture in this case) located in the memory. - - - -var - Data: Pointer; - Size: LongInt; - Images: TDynImageDataArray; - I: LongInt; -begin - // Here you for example load DDS texture compressed by your new - // compression algorithm from file and decompress it. - // Decompressed image is now in memory referenced by Data and - // size of this image is in Size variable. - // Note that there is no need to call InitImage for TDynImageDataArray. - LoadMultiImageFromMemory(Data, Size, Images); - // write something - WriteLn('DDS file contains ', Length(Image), 'subimages.'); - // You can then free images in array by calling FreeImage for all of them ... - for I := 0 to Length(Images) - 1 do - FreeImage(Images[I]); - // ... or simply call FreeImagesInArray which does the same job - FreeImagesInArray(Images); -end; - - - - This example shows how to load image from stream without knowing - what format it is in. - - - -function LoadImage(var Img: TImageData; Stream: TStream): Boolean; -var - Ext: string; -begin - // call this before using any TImageData record - InitImage(Img); - // determine image's format - Ext := DetermineStreamFormat(Stream); - // if image is in unsupported format or is invalid we output error - if Ext = '' then - begin - WriteLn('Image in stream in unsupported formatus!'); - Result := False; - end - else - begin - // load image if its type is known - Result := LoadImageFromStream(Stream, Img); - end; -end; - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Low.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Low.xml deleted file mode 100644 index 47f394b..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Low.xml +++ /dev/null @@ -1,19 +0,0 @@ - - - - How to ... (Low Level) - - How to ... (Low Level) - Here you can find information how to perform some - basic actions using Imaging library. - - In This Section - Loading Images - Saving Images - Manipulating Images - Using dll/so access - Loading and Saving DDS Files - - - - \ No newline at end of file diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Manipulating.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Manipulating.xml deleted file mode 100644 index f76a1d7..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Manipulating.xml +++ /dev/null @@ -1,107 +0,0 @@ - - - - Manipulating Images - - Manipulating Images - Imaging offers some image manipulation functions which work - with all supported image data formats. Conversions, resizing, - color reduction and other are available. - You can find list of all low level image manipulation and drawing/pixel - functions in Low Level Interface section. - You can look at usage of many of these functions in the - VampConvert - and - Benchmark Object Pascal demos - and C++ Benchmark demo. - - In the following code listing you can see typical usage of Imaging's - manipulation functions. - - -uses - ImagingTypes, Imaging; -var - Img, ImgClone: TImageData; -begin - ... - // image is now initialized and loaded - // now we want image to be mirrored - MirrorImage(Img); - // and flipped - FlipImage(Img); - // conversion to 32bit ARGB format - ConvertImage(Img, ifA8R8G8B8); - // swap alpha channel with green channel - SwapChannels(Img, ChannelAlpha, ChannelGreen); - // now we make clone of image - InitImage(ImgClone); - CloneImage(Img, ImgClone); - // reduce colors of clone to 1024 - ReduceColors(ImgClone, 1024); - // and resize original image - ResizeImage(Img, Img.Width * 2, Image.Height div 2, rfBicubic); - // finally convert clone to DXT5 - ConvertImage(ImgClone, ifDXT5); - // do something else with image - ... -end. - - - In this example you can find how to pass fill color parameters to - functions like FillRect. These functions work for all possible image - data format so fill color is defined as pointer to pixel in image's format. - You can also use GetPixel32, SetPixel32, - GetPixelFP, and SetPixelFP to set/get pixel colors - which are automatically converted to native color format of each data format. - - - - -var - Img: TImageData; - Pix32: TColor32Rec - Pix24: TColor24Rec - Pix64: TColor64Rec - Pix48: TColor48Rec - PixWord: Word; - PixByte: Byte; -begin - ... - // image is now initialized and loaded - // now we set pixel colors - Pix32.Color := $FFFF0000; // opaque red - Pix64.Color := $FFFF0000FFFF0000; // opaque green - with Pix24 do begin R := $FF; G := $FF; B := 0; end; // yellow - with Pix48 do begin R := $FF00; G := $00FF; B := $0800; end; // something redish - PixWord := (31 shl 10) or (15 shl 5) or 25; // something violetish in R5G5B5 - PixByte := 111; - - // image is then converted between various formats - // and rectangle is filled with appropriate pixels - - ConvertImage(Img, ifA16R16G16B16); - FillRect(Img, 20, 20, 60, 40, @Pix64); - - ConvertImage(Img, ifA8R8G8B8); - FillRect(Img, 20, 20, 60, 40, @Pix32); - - ConvertImage(Img, ifR16G16B16); - FillRect(Img, 20, 20, 60, 40, @Pix48); - - ConvertImage(Img, ifR8G8B8); - FillRect(Img, 20, 20, 60, 40, @Pix24); - - ConvertImage(Img, ifX1R5G5B5); - FillRect(Img, 20, 20, 60, 40, @PixWord); - - ConvertImage(Img, ifGray8); - FillRect(Img, 20, 20, 60, 40, @PixByte); - - ... -end. - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Saving.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Saving.xml deleted file mode 100644 index 7af8482..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/Saving.xml +++ /dev/null @@ -1,91 +0,0 @@ - - - - Saving Images - - Saving Images - Images can be saved to the files on disk, to the streams or - to a memory referenced by a pointer. - The following table lists functions which can be used for saving images. - These are low level functions operating on TImageData structure. - - -
    Function name
    -
    Usage
    -     - - SaveImageToFile - Save single image to file - - - SaveImageToStream - Save single image to stream - (TStream descendants, Object Pascal only) - - - SaveImageToMemory - Save single image to memory - - - SaveMultiImageToFile - Save multiple images to file - - - SaveMultiImageToStream - Save multiple images to stream - (TStream descendants, Object Pascal only) - - - SaveMultiImageToMemory - Save multiple images to memory - -
    - You can learn how to use these functions from the - following code fragments. - - This example creates empty image and draws diagonal line from - left-top to right-bottom corner. Finally, image is saved to the file. - -uses - SysUtils, Classes, ImagingTypes, Imaging; -var - Img: TImageData; - I: LongInt; -begin - // call this before using any TImageData record - InitImage(Img); - // create 8 bit grayscale image - NewImage(1024, 1024, ifGray8, Img); - // draw diagonal line by direct writing to image's memory - for I := 0 to Img.Width - 1 do - PByteArray(@PByteArray(Img.Bits)[I * Img.Width])[I] := 128; - // save image to file - SaveImageToFile('/home/galfar/images/line.tga', Img); - // memory occupied by image is freed - FreeImage(Img); -end. - - - In this example DDS image is loaded from stream. All contained - subimages are then compressed to DXT5 format and written to output stream. - -procedure LoadAndSaveSomethingInDXT5(InStream, OutStream: TStream); -var - Images: TDynImageDataArray; - I: LongInt; -begin - // load DDS multiimage from stream to Images array - LoadMultiImageFromStream(InStream, Images); - // convert all loaded images to DXT5 format - for I := 0 to Length(Images) - 1 do - ConvertImage(Images[I], ifDXT5); - // save converted images to output stream in DDS format - SaveMultiImageToStream('dds', OutStream, Images); - // all images are freed - FreeImagesInArray(Images); -end; - - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/UsingDll.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/UsingDll.xml deleted file mode 100644 index d582e0c..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Low/UsingDll.xml +++ /dev/null @@ -1,125 +0,0 @@ - - - - Using dll/so Access - - Using dll/so Access - You can use Imaging library directly from your Object Pascal - project by means of uses clause. - This kind of usage is recommended but you can also use Imaging library - in the form of external library - dynamic link library (Windows - dll file) or shared objects (Linux SO file). - Using external library can be useful if you have have more executables - using Imaging which will be distributed together (so you can have - smaller executables). This is also only way how to use Imaging from - programming languages other than Object Pascal. - - First you need Imaging compiled to external library. Projects - for building external library can be found in - Source/Projects directory. - You can also use build scripts named BuildLibrary*.bat - and BuildLibrary*.sh. They are located in - Scripts directory and compiled library will be placed - in Bin directory. In order to successfully use - these scripts you must have paths to compilers properly set. - When you have compiled library you must assure that operating system is - be able to find it at your application's startup. - Windows library is named VampyreImaging.dll and - Linux version has name libVampyreImaging.so. - - - - Next thing you need is wrapper for programming language you want to use. - Now there are wrappers for Object Pascal, C/C++ - and Delphi.NET. Wrappers are located in - Source/Wrappers directory. - - - - Some types of function parameters differ between dll/so usage and - direct usage. string types are changed to PChar - types, dynamic arrays are not used at all - wrapper type - TImageDataList is used instead. - Also all function names have Im prefix. - - - - Here you can find some code fragments which will show you how - to use dll/so access to Imaging library. - If you want samples in language other than Object Pascal look - at Demos. - - - -uses - ImagingTypes, ImagingImport; -var - Img: TImageData -begin - // this call loads external Imaging library, you should check if it was successful - if not ImLoadLibrary then - WriteLn('Imaging library dll was not loaded successfully, program will crash soon!'); - // call this before any access to TImageData is made - ImInitImage(Img); - // load some image - ImLoadImageFromFile('/home/galfar/images/jaguar.jpg', Img); - // compress it to DXT1 format - ImConvertImage(Img, ifDXT1); - // and save it in DDS file format - ImSaveImageToFile('/home/galfar/images/jaguar.dds', Img); - // free memory occupied by image - ImFreeImage(Img); - // unload Imaging library - ImFreeLibrary; -end. - - - Since TDynImageDataArray is Object Pascal dynamic array, - which can not be used from other languages, all parameters of this - type are replaced with TImageDataList typed parameters. - Some new functions are introduced for accessing list's items and properties. - You can see them all in action in the next code listing. - - - -uses - ImagingTypes, ImagingImport; -var - ImgList: TImageDataList; - Img: TImageData; - I, Size: LongInt; -begin - // this call loads external Imaging library, you should check if it was successful - if not ImLoadLibrary then - WriteLn('Imaging library dll was not loaded successfully, program will crash soon!'); - // make sure list pointer doesn't point to invalid memory address - ImgList := nil; - // load some images, list's size is changed during loading - ImLoadMultiImageFromFile('/home/galfar/images/jaguar_with_mipmaps.jpg', Img); - // get the actual list's size - Size := ImGetImageListSize(ImgList); - for I := 0 to Size - 1 do - begin - // get list's element - ImGetImageListElement(ImgList, Img, I); - // resize element - ImResizeImage(Img, Img.Width / 2, Img.Height / 2, rfBicubic); - // set list's element - ImSetImageListElement(ImgList, Img, I); - end; - // create space for new image in the list - ImSetImageListSize(ImgList, Size + 1); - // create new image - ImNewImage(256, 256, ifDXT1, Img); - // put this new image into the list - ImSetImageListElement(ImgList, Img, Size); - // save halved images to file - ImSaveMultiImageToFile('/home/galfar/images/jaguar_smaller.dds', Img); - // free all images in list and list itself - ImFreeImageList(ImgList); - // unload Imaging library - ImFreeLibrary; -end. - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Procedures/Procedures.xml b/components/vampireimaging/Doc/VampyreDoc/Procedures/Procedures.xml deleted file mode 100644 index e80959e..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Procedures/Procedures.xml +++ /dev/null @@ -1,18 +0,0 @@ - - - - How to ... - - How to ... - Here you can find information how to perform some - basic actions using Imaging library. - - In This Section - Low Level Interface - High Level Interface - VCL/LCL Classes - Canvas Class Tips - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Reference.xml b/components/vampireimaging/Doc/VampyreDoc/Reference.xml deleted file mode 100644 index 884f68a..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Reference.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - - Reference - - Reference - Here you can find Imaging reference documentation - generated from source code and comments. -
    -
    -
    - Enter Imaging Reference -
    -
    -     -     \ No newline at end of file diff --git a/components/vampireimaging/Doc/VampyreDoc/Root.xml b/components/vampireimaging/Doc/VampyreDoc/Root.xml deleted file mode 100644 index 078df34..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Root.xml +++ /dev/null @@ -1,23 +0,0 @@ - - - - Vampyre Imaging Library - -
    -


    - -

    - Version 0.26.4 -

    - Handwritten Documentation -

    - Reference (generated from source code) -

    -



    - External: Vampyre Imaging Library Homepage -
    - External: Vampyre Imaging Library Forum -

    -
    -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Template.xml b/components/vampireimaging/Doc/VampyreDoc/Template.xml deleted file mode 100644 index 9398b8f..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Template.xml +++ /dev/null @@ -1,9 +0,0 @@ - - - - Template - - Template - This file was autogenerated by VampyreDoc - - \ No newline at end of file diff --git a/components/vampireimaging/Doc/VampyreDoc/Usage/CanvasUsage.xml b/components/vampireimaging/Doc/VampyreDoc/Usage/CanvasUsage.xml deleted file mode 100644 index 417a6b7..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Usage/CanvasUsage.xml +++ /dev/null @@ -1,72 +0,0 @@ - - - - Using Canvas Class - - Using Canvas Class - - - Class TImagingCanvas in ImagingCanvases.pas - unit allows library user to draw onto image and apply various effects. - Base canvas class works for all image data formats with direct pixel access - (so not for compressed formats). - Because of this some operations are slower (sometimes a lot) - than implementation optimized for just one data format - (as it is done for example in Graphics32 library). - - - - Descendants optimized for specific data formats can be created. - Currently there is only most basic TFastARGB32Canvas class - for ifA8R8G8B8 images. - - - - Canvas can be created for both low and high level images. - Image data is only referenced by canvas. - If you change image data size (like format conversion or resizing) - you must update canvas by calling UpdateCanvasState - method so that canvas can update its helper structures depending - on size of the data (like scanline pointers). - You only need to update the canvas when size of image data - changes, not after setting pixels or drawing outside of the canvas - (like using CopyRect function). - - - - Currently Canvas class has these features: - - - -
  • Set pen and fill color in 32bit and FP format. Set - pen width and pen/fill mode (supported only in few functions).
    • -
  • Set and get pixel colors.
    • -
  • Clipping against custom rectangle.
    • -
  • Draw lines, framed rectangles, and ellipses.
    • -
  • Fill rectangles with solid color or with blending.
    • -
  • Draw part of canvas onto another canvas.
    • -
  • Stretch part of canvas onto another canvas with filtering (bilinear/bicubic/nearest).
    • -
  • Drawing (Draw/StretchDraw/FillRect) with blending. - Several source and destination blending factors are supported - (so you can get alpha blending, adding, modulate, ...).
    • -
  • Linear filters (convolution) with custom kernels and some predefined.
    • -
  • Nonlinear filters with custom functions and some predefined (min, max, median).
    • -
  • Point filters with custom functions and some predefined (contrast, gamma, thresholding, brightness, - premultiply alpha, ...).
    • -     - - - You can find some canvas usage code in Tips article linked bellow - and in the demos. There is still a lot of functions that can be added to - canvas and hopefully they will be. - - - - More Canvas Info - Canvas Class Tips - VCL Image Browser Demo - LCL Imager Demo - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Usage/Components.xml b/components/vampireimaging/Doc/VampyreDoc/Usage/Components.xml deleted file mode 100644 index 831b472..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Usage/Components.xml +++ /dev/null @@ -1,71 +0,0 @@ - - - - VCL/LCL Classes - - VCL/LCL Classes - - Imaging contains VCL/LCL - TGraphic descendant which uses Imaging library - for loading and saving various different file formats. - They actually descend from TBitmap and override only - loading, saving, and assigning procedures. - These classes are implemented in ImagingComponents.pas unit. - - - - Classes are automatically registered in unit's initialization - section so you only need to add ImagingComponents to - uses list somewhere in your project and - TPicture class will be able to load and save images using - Imaging. - There are packages for Delphi, - and Lazarus in - Source\Projects directory which you can install - to your IDEs and use Imaging classes in form design stage too. - - - - Note that TImagingGraphic and all its descendants - can load images in all file formats supported by Imaging - but save images only in file format they are named after - (i.e. TImagingJpeg saves jpeg images). - TImagingGraphic itself doesn't override - saving methods so TBitmap's saving is used. - - - - Classes and functions in ImagingComponents - - - - - - - - - - - - - - - - - - - - - - - -
    ClassesTImagingGraphicTImagingBitmapTImagingJpegTImagingPNGTImagingGIFTImagingTargaTImagingDDSTImagingMNGTImagingJNGFunctionsDataFormatToPixelFormatPixelFormatToDataFormatConvertImageToBitmapConvertBitmapToImageConvertDataToBitmapConvertBitmapToDataDisplayImageDisplayImageDataUseful functions in other unitsGetImageFileFormatsFilterGetFilterIndexExtensionGetFileNameFilterIndex
    - - - Information about the usage of VCL/LCL Classes - How To ... - Object Pascal Demos - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Usage/HighLevel.xml b/components/vampireimaging/Doc/VampyreDoc/Usage/HighLevel.xml deleted file mode 100644 index 83a169b..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Usage/HighLevel.xml +++ /dev/null @@ -1,37 +0,0 @@ - - - - High Level Interface - - High Level Interface - Imaging's high level interface is set of classes build on top - of low level interface - implemented in ImagingClasses.pas unit. - It is Object Pascal only, therefore it is not accessible - from other programming languages (although creating high level interface - for other languages using low level interface imported from dll/so should not - be difficult). - - High level interface - consists of the base class TBaseImage with two descendant classes. - The first is TSingleImage and it is high level wrapper to TImageData - structure. The second is TMultiImage and it is wrapper to - TDynImageDataArray array. - - These classes provide access to all members of underlying structures - trough properties. This access is read/write so you can for example - convert image to another format by setting Format property - to new value. You can also assign single image to multi image and vice versa. - Some image manipulation functions are integrated into high level interface. - However, you can use even those that are not integrated - with high level images classes. You can find information - how to do this and more in the following pages. - - - Information about usage of the high level interface - How To ... - Object Pascal Demos - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Usage/Install.xml b/components/vampireimaging/Doc/VampyreDoc/Usage/Install.xml deleted file mode 100644 index 858093e..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Usage/Install.xml +++ /dev/null @@ -1,219 +0,0 @@ - - - - Install and Compile - - Install and Compile - - Simply extract contents of distributed archive somewhere - on your hard disk and Imaging is installed. - However, you need to setup your compilers to be able to compile - Imaging. - - - - Source directories needed to be known by compilers - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    DirectoryContents(Imaging Root)\SourceImaging library source code(Imaging Root)\Source\JpegLibJpegLib needed by Imaging to load/save JPEG/JNG images(Imaging Root)\Source\ZLibZLib needed by Imaging to decode/decode PNG/MNG image data and other things(Imaging Root)\Source\ProjectsProject files for libraries and packages(Imaging Root)\Source\ExtensionsImaging extensions source code(Imaging Root)\Source\Wrappers\*Wrappers for other languages(Imaging Root)\Demos\ObjectPascal\CommonSome common routines used by Object Pascal demos(Imaging Root)\Extras\ExtensionsExtras extensions source code (mainly new file formats)(Imaging Root)\Extras\Extensions\J2KObjectsDir with static libraries needed for FPC if you have - JPEG 2000 support enabled. Must be added to FPC library path (-Fl).(Imaging Root)\Extras\Extensions\LibTiffNeeded for TIFF support in Delphi.
    - - Compiler Setup - - Compiling Library - - Delphi/Kylix Setup - - You need to add directories listed in the above - table to library path. - - -
  • Choose ToolsOptionsEnvironment OptionsDelphi OptionsLibrary - Win32 - in Delphi 2005+ or ToolsEnvironment OptionsLibrary in Delphi 7- and Kylix. -
    • -
  • Add directories to Library path string.
    • -     - - Free Pascal Setup - - You can write settings to fpc.cfg configuration - file or use them directly as command line parameters - - -
  • - Use -FuUnitPath parameter for all - directories listed in the above table and -FiIncludePath - only for (Imaging_Root)\Source directory. - Also library path must me added for JPEG2000 - (Imaging Root\Extras\Extensions\J2KObjects) using -FlLibPath. - Example: fpc -FuD:\Imaging\Source -FuD:\Imaging\Source\JpegLib ... -FiD:\Imaging\Source -
    • -
  • - You should also set compiler mode and other compilation specific options. - I use -Sgi2dh and it works. - g means allow goto, - i means allow function inlining, - 2 allows some Delphi 2 extensions, - d turns on Delphi compatibility mode - and h turns on ANSI strings. -
    • -     - - Using Wrappers For Other Languages - Delphi.NET Setup - - You need to add directory in which Delphi.NET wrapper is located - to library path. - - -
  • Choose ToolsOptionsEnvironment OptionsDelphi OptionsLibrary - NET - in Delphi 2005+.
    • -
  • Add directory to Library path string.
    • -     - - C/C++ Compiler Setup - - Settings depend entirely on the compiler used. - You need to add directory in which C/C++ wrapper headers are located - to its include path and then compile ImagingImport.c - file located in wrapper directory and link it with your object files. - You can find working MS VC++ 8.0 project in Demos\Cpp\Bench - directory. - - - Build Scripts - - You can also compile Imaging library and demos without - setting your compilers. All you need is to make sure that you have - paths to compilers' executables in your system's search path - (PATH environment variable). - Then you can run one of these scripts located in Scripts - directory: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Script NameUsageBuildLibraryDelphi.bat (Win32)Builds VampyreImaging.dll in - Bin directory using DelphiBuildLibraryFPC.bat (Win32)Builds VampyreImaging.dll in - Bin directory using Free PascalBuildLibraryFPC.sh (Linux/Unix)Builds libVampyreImaging.so in - Bin directory using Free PascalBuildDemosDelphi.bat (Win32)Builds demos in Demos\Bin directory using DelphiBuildExtDemosDelphi.bat (Win32)Builds demos of Imaging extensions which require external units - in Demos\Bin - directory using Delphi (Note)BuildDemosFPC.bat (Win32)Builds demos in Demos\Bin directory using Free PascalBuildDemosFPC64.bat (Win64)Builds demos in Demos\Bin directory using Free PascalBuildExtDemosFPC.bat (Win32)Builds demos of Imaging extensions which require external units - in Demos\Bin - directory using Free Pascal (Note)BuildDemosDOS.bat (DOS)Builds demos in Demos\Bin directory using Free PascalBuildDemosFPC.sh (Linux/Unix)Builds demos in Demos/Bin directory using Free PascalBuildExtDemosFPC.sh (Linux/Unix)Builds demos of Imaging extensions which require external units - in Demos\Bin - directory using Free Pascal (Note)
    - - - - You must first set search directories in which - third party units required by some demos (like JEDI-SDL, - Direct3D, ...) are located. Just open the script and - you will see couple of empty variables (like set SDLDIR= in - *.bat or SDLDIR="" in *.sh script). Set the variables - to paths to required libraries and run the script. If you don't have - some of these libraries installed and variables are left empty - demos which require them will be simply skipped when the script is - executed. - - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Usage/LibUsage.xml b/components/vampireimaging/Doc/VampyreDoc/Usage/LibUsage.xml deleted file mode 100644 index f5397fd..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Usage/LibUsage.xml +++ /dev/null @@ -1,21 +0,0 @@ - - - - Using Library - - Using Library - You can find information on supported compilers and platforms, - Imaging installation and compilation, and other topics in this section. - - - In This Section - Supported Compilers and Platforms - Install and Compile - Low Level Interface - High Level Interface - VCL/LCL Classes - Using Canvas Class - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Usage/LowLevel.xml b/components/vampireimaging/Doc/VampyreDoc/Usage/LowLevel.xml deleted file mode 100644 index 1f4451a..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Usage/LowLevel.xml +++ /dev/null @@ -1,135 +0,0 @@ - - - - Low Level Interface - - Low Level Interface - - Imaging's low level interface is set of functions operating - on TImageData structure and TDynImageDataArray. - These functions are implemented in Imaging.pas unit - and you can find how to use them in - How To ... section. - You can also look at Demos section. - Low level interface is accessible from programming languages other - than Object Pascal. Information on this can be found in - Using dll/so Access section. - - - - There are more functions in Imaging that are not part of low level interface - but can be freely used with it. Ulike those, low level interface functions are - provided for other programming languages too. - Look at Imaging.pas, ImagingFormats.pas, and other units - for more functions. - - - - Here is the table with all low level interface functions currently available. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    General FunctionsInitImageNewImageTestImageFreeImageFreeImagesInArrayTestImagesInArrayDetermineFileFormatDetermineStreamFormatDetermineMemoryFormatIsFileFormatSupportedEnumFileFormatsLoading FunctionsLoadImageFromFileLoadImageFromStreamLoadImageFromMemoryLoadMultiImageFromFileLoadMultiImageFromStreamLoadMultiImageFromMemorySaving FunctionsSaveImageToFileSaveImageToStreamSaveImageToMemorySaveMultiImageToFileSaveMultiImageToStreamSaveMultiImageToMemoryManipulation FunctionsCloneImageConvertImageFlipImageMirrorImageResizeImageSwapChannelsReduceColorsGenerateMipMapsMapImageToPaletteSplitImageMakePaletteForImagesRotateImageDrawing/Pixel FunctionsCopyRectFillRectReplaceColorStretchRectGetPixelDirectSetPixelDirectGetPixel32SetPixel32GetPixelFPSetPixelFPPalette FunctionsNewPaletteFreePaletteCopyPaletteFindColorFillGrayscalePaletteFillCustomPaletteSwapChannelsOfPaletteOptions FunctionsSetOptionGetOptionPushOptionsPopOptionsImage Format FunctionsGetImageFormatInfoGetPixelsSizeIO FunctionsSetUserFileIOResetFileIO
    - - - You can find other functions in Reference - but they are not available for other languages thus they are not - part of the low level interface. Some of them are even dangerous to use - if you do not know what you are doing. - - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Usage/Supported.xml b/components/vampireimaging/Doc/VampyreDoc/Usage/Supported.xml deleted file mode 100644 index ef70b61..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Usage/Supported.xml +++ /dev/null @@ -1,59 +0,0 @@ - - - - Supported Compilers and Platforms - - Supported Compilers and Platforms - - Main development language is Object Pascal and two - main supported compilers are Borland/CodeGear/Embarcadero Delphi and Free Pascal. - Kylix worked too but latest versions were not tested - (IDE won't work well in current Linux distros). - C++ Builder crashes on internal error. - Other Pascal compilers like GPC or TMT were not tested (probably won't work). - Supported platforms are now Windows, Linux, Mac OS X (Intel), FreeBSD - (some other Unix systems most probably too). - Imaging was tested on 32bit x86 - and 64bit AMD64 (Linux64 and Win64 using Free Pascal) - CPU architectures. - It could work on some big endian machines too (except some file format loaders - that assume little endian) but I can't test it on any. - - - - Following table contains information about which compilers have - been tested and whether Imaging was successfully compiled by them. - - - - Object Pascal Compilers - - - - - - - - - - - - - - - - - - - - - - - - -
    Compiler Name and VersionInfoDelphi 6/7/2006/2007/2009/2010 (Win32)Tested and everything compiled successfully (Delphi 2005, and TurboDelphi - should work too, older probably not)Free Pascal 2.2.4 (Win32/Win64, Linux, FreeBSD, Mac OS X)Tested and everything compiled successfullyLazarus 0.9.28 (Win32/Win64, Linux, FreeBSD, Mac OS X)Tested and everything compiled successfullyKylix 3 (Linux)Tested and everything compiled successfully (previous library versions, - Kylix is not tested anymore - won't work well in current Linux distros)C++ Builder 6/2006 (Win32)Tested but crashed during compilation (internal compiler error)
    - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc.ppr b/components/vampireimaging/Doc/VampyreDoc/VampyreDoc.ppr deleted file mode 100644 index 7e9f8c8..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc.ppr +++ /dev/null @@ -1,247 +0,0 @@ -[Config] -Compilator.SaveAll=0 -Compilator.Capture=0 -Compilator.HideOutput=0 -Compilator.LogType=0 -DefaultCPIndex=0 -LogtoEnd=1 -DontOpen=0 -AbsolutePath=0 -FileFormat=0 -ProjectFilesOnly=0 -[Project tree] -VampyreDoc - +VampyreDoc - +DataFormats - DataFormats\DataFormats.xml - +Demos - Demos\Cpp.xml - Demos\Delphi.NET.xml - Demos\Demos.xml - Demos\Pascal.xml - +Extensions - Extensions\Direct3D.xml - Extensions\Extensions.xml - Extensions\ExtFileFormats.xml - Extensions\OpenGL.xml - Extensions\SDL.xml - +FileFormats - FileFormats\Bitmap.xml - FileFormats\Dds.xml - FileFormats\FileFormats.xml - FileFormats\Jng.xml - FileFormats\Jpeg.xml - FileFormats\Mng.xml - FileFormats\Png.xml - FileFormats\Targa.xml - FileFormats\ElderImagery.xml - FileFormats\Jpeg2000.xml - FileFormats\Pcx.xml - FileFormats\Pnm.xml - FileFormats\Tiff.xml - FileFormats\Psd.xml - FileFormats\Gif.xml - FileFormats\Xpm.xml - +Introduction - Introduction\About.xml - Introduction\Credits.xml - Introduction\Features.xml - Introduction\Future.xml - Introduction\History.xml - Introduction\Introduction.xml - Introduction\LGPL.xml - Introduction\License.xml - Introduction\MPL.xml - Introduction\Contrib.xml - Introduction\Faq.xml - +Procedures - +Components - Procedures\Components\ProcComp.xml - +High - Procedures\High\High.xml - +Low - Procedures\Low\DdsFiles.xml - Procedures\Low\Loading.xml - Procedures\Low\Low.xml - Procedures\Low\Manipulating.xml - Procedures\Low\Saving.xml - Procedures\Low\UsingDll.xml - Procedures\Procedures.xml - Procedures\Canvas.xml - +Usage - Usage\Components.xml - Usage\HighLevel.xml - Usage\Install.xml - Usage\LibUsage.xml - Usage\LowLevel.xml - Usage\Supported.xml - Usage\CanvasUsage.xml - -Misc - -VampyreDoc - VampyreDoc\TagReference.xml - VampyreDoc\Usage.xml - VampyreDoc\VampyreDoc.xml - +Xsl - Xsl\doc2html.xsl - Xsl\proj2hhp.xsl - Xsl\proj2html.xsl - Xsl\toc2hhc.xsl - Xsl\toc2html.xsl - Contents.xml - Documentation.xml - Imaging.vdocproj - Reference.xml - Root.xml - Template.xml -[Open project files] -0=Introduction\History.xml -1=Extensions\Extensions.xml -2=Extensions\ExtFileFormats.xml -3=Usage\Install.xml -4=Extensions\Direct3D.xml -5=Contents.xml -6=Root.xml -7=Introduction\Contrib.xml -8=Introduction\Faq.xml -9=Introduction\Credits.xml -10=Introduction\About.xml -11=Introduction\Features.xml -12=Introduction\Future.xml -13=Introduction\Introduction.xml -14=Introduction\LGPL.xml -15=Introduction\License.xml -16=Usage\CanvasUsage.xml -17=FileFormats\Xpm.xml -18=FileFormats\Psd.xml -19=FileFormats\Pnm.xml -20=FileFormats\Jpeg2000.xml -21=FileFormats\ElderImagery.xml -22=FileFormats\Png.xml -23=DataFormats\DataFormats.xml -24=Demos\Cpp.xml -25=Demos\Demos.xml -26=Demos\Pascal.xml -27=FileFormats\FileFormats.xml -28=Procedures\Components\ProcComp.xml -29=Procedures\Low\Loading.xml -30=Procedures\Canvas.xml -31=Usage\Components.xml -32=Usage\HighLevel.xml -33=Usage\LibUsage.xml -34=Usage\LowLevel.xml -35=Usage\Supported.xml -36=Extensions\OpenGL.xml -[Selected Project Files] -Main= -Selected=Extensions\OpenGL.xml -[Introduction\History.xml] -TopLine=1 -Caret=37,14 -[Extensions\Extensions.xml] -TopLine=1 -Caret=1,1 -[Extensions\ExtFileFormats.xml] -TopLine=1 -Caret=7,26 -[Usage\Install.xml] -TopLine=25 -Caret=61,25 -[Extensions\Direct3D.xml] -TopLine=1 -Caret=1,1 -[Contents.xml] -TopLine=1 -Caret=37,18 -[Root.xml] -TopLine=1 -Caret=1,1 -[Introduction\Contrib.xml] -TopLine=1 -Caret=1,1 -[Introduction\Faq.xml] -TopLine=21 -Caret=47,21 -[Introduction\Credits.xml] -TopLine=1 -Caret=30,20 -[Introduction\About.xml] -TopLine=1 -Caret=56,26 -[Introduction\Features.xml] -TopLine=17 -Caret=1,17 -[Introduction\Future.xml] -TopLine=13 -Caret=1,55 -[Introduction\Introduction.xml] -TopLine=1 -Caret=1,1 -[Introduction\LGPL.xml] -TopLine=1 -Caret=1,1 -[Introduction\License.xml] -TopLine=1 -Caret=1,1 -[Usage\CanvasUsage.xml] -TopLine=1 -Caret=39,12 -[FileFormats\Xpm.xml] -TopLine=1 -Caret=43,17 -[FileFormats\Psd.xml] -TopLine=91 -Caret=53,125 -[FileFormats\Pnm.xml] -TopLine=1 -Caret=1,1 -[FileFormats\Jpeg2000.xml] -TopLine=22 -Caret=16,22 -[FileFormats\ElderImagery.xml] -TopLine=37 -Caret=1,73 -[FileFormats\Png.xml] -TopLine=131 -Caret=5,131 -[DataFormats\DataFormats.xml] -TopLine=33 -Caret=24,33 -[Demos\Cpp.xml] -TopLine=1 -Caret=1,1 -[Demos\Demos.xml] -TopLine=1 -Caret=1,1 -[Demos\Pascal.xml] -TopLine=1 -Caret=35,24 -[FileFormats\FileFormats.xml] -TopLine=1 -Caret=15,20 -[Procedures\Components\ProcComp.xml] -TopLine=29 -Caret=1,29 -[Procedures\Low\Loading.xml] -TopLine=13 -Caret=1,13 -[Procedures\Canvas.xml] -TopLine=23 -Caret=28,23 -[Usage\Components.xml] -TopLine=2 -Caret=10,28 -[Usage\HighLevel.xml] -TopLine=1 -Caret=1,1 -[Usage\LibUsage.xml] -TopLine=1 -Caret=1,1 -[Usage\LowLevel.xml] -TopLine=1 -Caret=1,1 -[Usage\Supported.xml] -TopLine=14 -Caret=13,56 -[Extensions\OpenGL.xml] -TopLine=1 -Caret=50,16 diff --git a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/TagReference.xml b/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/TagReference.xml deleted file mode 100644 index a0d65e5..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/TagReference.xml +++ /dev/null @@ -1,23 +0,0 @@ - - - - VampyreDoc Tool - - VampyreDoc Tag Reference - Here follows a list of allowed tags which can be used in - VampyreDoc XML files. Each tag can have alternate - (shortened) names and zero or more attributes. - - -
  • - doc - This is the root element of the each XML file. - -
    • - - - -     - -     -     diff --git a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/Usage.xml b/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/Usage.xml deleted file mode 100644 index d20e318..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/Usage.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - VampyreDoc Tool - - VampyreDoc Usage - I created VampyreDoc ... - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/VampyreDoc.xml b/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/VampyreDoc.xml deleted file mode 100644 index c773168..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/VampyreDoc/VampyreDoc.xml +++ /dev/null @@ -1,14 +0,0 @@ - - - - VampyreDoc Tool - - VampyreDoc Tool - VampyreDoc is a tool ... - - In This Section - Usage - Tag Reference - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Xsl/doc2html.xsl b/components/vampireimaging/Doc/VampyreDoc/Xsl/doc2html.xsl deleted file mode 100644 index ebec679..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Xsl/doc2html.xsl +++ /dev/null @@ -1,369 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -
    - -
    - - -     - - - - - - - - - - - - - - - - <xsl:choose> - <xsl:when test="title!=''"> - <xsl:value-of select="title"/> - </xsl:when> - <xsl:otherwise> - Documentation - </xsl:otherwise> - </xsl:choose> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      - -
    -     - - -
    -
    - -
    - -
    -     - - -
      - -
    -     - - -
      - -
    -     - - -
  • - -
    • -     - - - - - - - - - - - - - - - - - - - - - - -
    - -
    -     - - -
    -     - - -

    - -

    -     - - - 
    -    
-
    -     - - - - - - - - - - - - - - -
    - Tip: - - - -
    -     - - -
    - Warning: - - - -
    -     - - -
    - Note: - - - -
    -     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    - -
    -     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    -
    - - Vampyre Imaging Library (Documentation for version 0.26.4) - -
    - - http://imaginglib.sourceforge.net -
    -
    -     - -     diff --git a/components/vampireimaging/Doc/VampyreDoc/Xsl/proj2hhp.xsl b/components/vampireimaging/Doc/VampyreDoc/Xsl/proj2hhp.xsl deleted file mode 100644 index e7ef301..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Xsl/proj2hhp.xsl +++ /dev/null @@ -1,47 +0,0 @@ - - - - - - - - - - - - - -[OPTIONS] -Title= -Compiled file=..\.chm -Contents file= -Default topic= -Compatibility=1.1 or later -Display compile progress=Yes -Full-text search=Yes -Auto Index=Yes -Flat=True -Binary Index=No -Binary TOC=No - - - -[FILES] - - - - - - - - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Xsl/proj2html.xsl b/components/vampireimaging/Doc/VampyreDoc/Xsl/proj2html.xsl deleted file mode 100644 index 6dcea0f..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Xsl/proj2html.xsl +++ /dev/null @@ -1,51 +0,0 @@ - - - - - - - - - - - - - - - <xsl:choose> - <xsl:when test="title!=''"> - <xsl:value-of select="title"/> - </xsl:when> - <xsl:otherwise> - VampyreDoc Project - </xsl:otherwise> - </xsl:choose> - - - - - - - - - - - - - - - - - - - diff --git a/components/vampireimaging/Doc/VampyreDoc/Xsl/toc2hhc.xsl b/components/vampireimaging/Doc/VampyreDoc/Xsl/toc2hhc.xsl deleted file mode 100644 index 67b2b8b..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Xsl/toc2hhc.xsl +++ /dev/null @@ -1,54 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -
      - -
    -     - - -
  • - - - - - - - - - - - - - -
    • -     - -     - diff --git a/components/vampireimaging/Doc/VampyreDoc/Xsl/toc2html.xsl b/components/vampireimaging/Doc/VampyreDoc/Xsl/toc2html.xsl deleted file mode 100644 index cb95e51..0000000 --- a/components/vampireimaging/Doc/VampyreDoc/Xsl/toc2html.xsl +++ /dev/null @@ -1,77 +0,0 @@ - - - - - - - - - - - - - - - - - <xsl:choose> - <xsl:when test="title!=''"> - <xsl:value-of select="title"/> - </xsl:when> - <xsl:otherwise> - Contents - </xsl:otherwise> - </xsl:choose> - - - -
    - - -
    - - -     - - - - - - - - - - - - -
      - -
    -     - - -
  • - - - - - - - -
    • -     - -     - diff --git a/components/vampireimaging/Extras/Contrib/ExtraGIF.zip b/components/vampireimaging/Extras/Contrib/ExtraGIF.zip deleted file mode 100644 index fa7536c..0000000 Binary files a/components/vampireimaging/Extras/Contrib/ExtraGIF.zip and /dev/null differ diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/FormMain.dfm b/components/vampireimaging/Extras/Contrib/HqResampler/FormMain.dfm deleted file mode 100644 index 91dfb6f..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/FormMain.dfm +++ /dev/null @@ -1,111 +0,0 @@ -object MainForm: TMainForm - Left = 289 - Top = 115 - AutoSize = True - BorderIcons = [biSystemMenu, biMinimize] - BorderStyle = bsSingle - Caption = 'HqResampler Demo' - ClientHeight = 281 - ClientWidth = 556 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - Position = poScreenCenter - OnCreate = FormCreate - OnDestroy = FormDestroy - PixelsPerInch = 96 - TextHeight = 13 - object Image: TImage - AlignWithMargins = True - Left = 288 - Top = 13 - Width = 256 - Height = 256 - Margins.Left = 12 - Margins.Top = 12 - Margins.Right = 12 - Margins.Bottom = 12 - Proportional = True - Stretch = True - end - object Panel1: TPanel - Left = 0 - Top = 0 - Width = 281 - Height = 281 - Align = alCustom - TabOrder = 0 - object Label1: TLabel - Left = 8 - Top = 13 - Width = 53 - Height = 13 - Caption = 'Image File:' - end - object EdFileName: TEdit - Left = 8 - Top = 32 - Width = 201 - Height = 21 - ReadOnly = True - TabOrder = 0 - end - object Button1: TButton - Left = 215 - Top = 30 - Width = 58 - Height = 25 - Caption = 'Browse' - TabOrder = 1 - OnClick = Button1Click - end - object Btn2x: TButton - Left = 8 - Top = 72 - Width = 105 - Height = 25 - Align = alCustom - Caption = 'hq2x Resample' - Enabled = False - TabOrder = 2 - OnClick = Btn2xClick - end - object Btn3x: TButton - Left = 8 - Top = 103 - Width = 105 - Height = 25 - Caption = 'hq3x Resample' - Enabled = False - TabOrder = 3 - OnClick = Btn3xClick - end - object Btn4x: TButton - Left = 8 - Top = 134 - Width = 105 - Height = 25 - Caption = 'hq4x Resample' - Enabled = False - TabOrder = 4 - OnClick = Btn4xClick - end - object Button2: TButton - Left = 8 - Top = 244 - Width = 75 - Height = 25 - Caption = 'About' - TabOrder = 5 - OnClick = Button2Click - end - end - object DlgOpen: TOpenPictureDialog - Left = 216 - Top = 72 - end -end diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/FormMain.pas b/components/vampireimaging/Extras/Contrib/HqResampler/FormMain.pas deleted file mode 100644 index c825f63..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/FormMain.pas +++ /dev/null @@ -1,157 +0,0 @@ -unit FormMain; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ExtCtrls, StdCtrls, Buttons, ExtDlgs, - - ImagingTypes, - Imaging, - ImagingClasses, - ImagingComponents, - hq2x; - -type - TMainForm = class(TForm) - Panel1: TPanel; - Image: TImage; - Label1: TLabel; - EdFileName: TEdit; - Button1: TButton; - Btn2x: TButton; - Btn3x: TButton; - Btn4x: TButton; - Button2: TButton; - DlgOpen: TOpenPictureDialog; - procedure Button2Click(Sender: TObject); - procedure Btn2xClick(Sender: TObject); - procedure Btn3xClick(Sender: TObject); - procedure Btn4xClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure Button1Click(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - Source: TSingleImage; - Resampled: TSingleImage; - FileName: string; - Bitmap: TImagingBitmap; - - procedure ResampleFile(Magnification: Integer); - procedure ShowImage; - end; - -var - MainForm: TMainForm; - -const - AboutMsg = 'Original hq2x, hq3x, hq4x: Maxim Stepin' + SLineBreak + - 'Pascal translation: Jeremy Darling' + SLineBreak + - 'Imaging hq demo: Marek Mauder'; - -implementation - -uses FormView; - -{$R *.dfm} - -procedure TMainForm.Btn2xClick(Sender: TObject); -begin - ResampleFile(2); -end; - -procedure TMainForm.Btn3xClick(Sender: TObject); -begin - ResampleFile(3); -end; - -procedure TMainForm.Btn4xClick(Sender: TObject); -begin - ResampleFile(4); -end; - -procedure TMainForm.Button1Click(Sender: TObject); -var - ValidFile: Boolean; -begin - DlgOpen.Filter := GetImageFileFormatsFilter(True); - if DlgOpen.Execute then - begin - EdFileName.Text := DlgOpen.FileName; - FileName := DlgOpen.FileName; - - ValidFile := FileExists(FileName) and - (Imaging.DetermineFileFormat(FileName) <> ''); - Btn2x.Enabled := ValidFile; - Btn3x.Enabled := ValidFile; - Btn4x.Enabled := ValidFile; - - if ValidFile then - begin - Source.LoadFromFile(FileName); - Image.SetBounds(Image.Left, Image.Top, Source.Width, Source.Height); - Image.Picture.Bitmap.Assign(Source); - end; - end; -end; - -procedure TMainForm.Button2Click(Sender: TObject); -begin - ShowMessage(AboutMsg); -end; - -procedure TMainForm.FormCreate(Sender: TObject); -begin - Source := TSingleImage.Create; - Resampled := TSingleImage.Create; - Bitmap := TImagingBitmap.Create; - Image.Picture.Bitmap := Bitmap; -end; - -procedure TMainForm.FormDestroy(Sender: TObject); -begin - Source.Free; - Resampled.Free; - Bitmap.Free; -end; - -procedure TMainForm.ResampleFile(Magnification: Integer); -begin - if not (Magnification in [2, 3, 4]) then - begin - ShowMessage('Requested magnification not supported'); - Exit; - end; - - if Magnification in [3, 4] then - begin - ShowMessage('Requested magnification not YET supported'); - Exit; - end; - - Source.Format := ifR5G6B5; - Resampled.CreateFromParams(Source.Width * Magnification, Source.Height * Magnification, ifX8R8G8B8); - try - case Magnification of - 2: hq2x_32(Source.Bits, Resampled.Bits, Source.Width, Source.Height, Resampled.Width * 4); - 3: ; - 4: ; - end; - except - ShowMessage('Error during resampling'); - end; - - ShowImage; -end; - -procedure TMainForm.ShowImage; -begin - ViewForm.Image.SetBounds(0, ViewForm.Image.Top, Resampled.Width, Resampled.Height); - ViewForm.Image.Picture.Bitmap.Assign(Resampled); - ViewForm.ShowModal; -end; - -end. diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/FormView.dfm b/components/vampireimaging/Extras/Contrib/HqResampler/FormView.dfm deleted file mode 100644 index 79f5605..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/FormView.dfm +++ /dev/null @@ -1,57 +0,0 @@ -object ViewForm: TViewForm - Left = 128 - Top = 232 - AutoSize = True - BorderIcons = [biSystemMenu, biMinimize] - Caption = 'View Form' - ClientHeight = 357 - ClientWidth = 642 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - Position = poScreenCenter - OnCreate = FormCreate - OnDestroy = FormDestroy - OnShow = FormShow - PixelsPerInch = 96 - TextHeight = 13 - object Image: TImage - Left = 0 - Top = 39 - Width = 642 - Height = 318 - Align = alCustom - Proportional = True - Stretch = True - end - object PnlBle: TPanel - Left = 0 - Top = 0 - Width = 642 - Height = 41 - Align = alTop - TabOrder = 0 - ExplicitLeft = 8 - DesignSize = ( - 642 - 41) - object Button1: TButton - Left = 257 - Top = 8 - Width = 129 - Height = 25 - Anchors = [akLeft, akTop, akRight] - Caption = 'Save To File' - TabOrder = 0 - OnClick = Button1Click - end - end - object DlgSave: TSavePictureDialog - Left = 528 - Top = 64 - end -end diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/FormView.pas b/components/vampireimaging/Extras/Contrib/HqResampler/FormView.pas deleted file mode 100644 index f8adaf2..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/FormView.pas +++ /dev/null @@ -1,68 +0,0 @@ -unit FormView; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ExtCtrls, ExtDlgs, - - Imaging, - ImagingComponents; - -type - TViewForm = class(TForm) - Image: TImage; - PnlBle: TPanel; - Button1: TButton; - DlgSave: TSavePictureDialog; - procedure FormCreate(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure Button1Click(Sender: TObject); - procedure FormDestroy(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - Bitmap: TImagingBitmap; - end; - -var - ViewForm: TViewForm; - -implementation - -uses FormMain; - -{$R *.dfm} - -procedure TViewForm.Button1Click(Sender: TObject); -begin - DlgSave.Filter := GetImageFileFormatsFilter(False); - DlgSave.FileName := ChangeFileExt(ExtractFileName(MainForm.FileName), ''); - DlgSave.FilterIndex := GetFileNameFilterIndex(MainForm.FileName, False); - if DlgSave.Execute then - begin - DlgSave.FileName := ChangeFileExt(DlgSave.FileName, '.' + GetFilterIndexExtension(DlgSave.FilterIndex, False)); - MainForm.Resampled.SaveToFile(DlgSave.FileName); - MainForm.FileName := DlgSave.FileName; - end; -end; - -procedure TViewForm.FormCreate(Sender: TObject); -begin - Bitmap := TImagingBitmap.Create; - ViewForm.Image.Picture.Bitmap := Bitmap; -end; - -procedure TViewForm.FormDestroy(Sender: TObject); -begin - Bitmap.Free; -end; - -procedure TViewForm.FormShow(Sender: TObject); -begin - Left := (Screen.Width - Width) div 2; - Top := (Screen.Height - Height) div 2; -end; - -end. diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.dpr b/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.dpr deleted file mode 100644 index 95af384..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.dpr +++ /dev/null @@ -1,16 +0,0 @@ -program HqDemo; - -uses - Forms, - FormMain in 'FormMain.pas' {MainForm}, - FormView in 'FormView.pas' {ViewForm}; - -{$R *.res} - -begin - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.CreateForm(TMainForm, MainForm); - Application.CreateForm(TViewForm, ViewForm); - Application.Run; -end. diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.dproj b/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.dproj deleted file mode 100644 index e55f0df..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.dproj +++ /dev/null @@ -1,39 +0,0 @@ - - - {1b8c75e3-ad7b-450d-a75b-97a60f7f36e6} - Debug - AnyCPU - DCC32 - HqDemo.exe - HqDemo.dpr - - - 7.0 - False - False - 0 - RELEASE - - - 7.0 - DEBUG - - - Delphi.Personality - - -FalseTrueFalseFalseFalse1000FalseFalseFalseFalseFalse102912501.0.0.01.0.0.0HqDemo.dpr - - - - - MainSource - - -
    MainForm
    -     - -
    ViewForm
    -     -     -     \ No newline at end of file diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.res b/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.res deleted file mode 100644 index eb3c900..0000000 Binary files a/components/vampireimaging/Extras/Contrib/HqResampler/HqDemo.res and /dev/null differ diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/hq2x.cpp b/components/vampireimaging/Extras/Contrib/HqResampler/hq2x.cpp deleted file mode 100644 index 126c66a..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/hq2x.cpp +++ /dev/null @@ -1,2954 +0,0 @@ -//hq2x filter demo program -//---------------------------------------------------------- -//Copyright (C) 2003 MaxSt ( maxst@hiend3d.com ) - -//This program is free software; you can redistribute it and/or -//modify it under the terms of the GNU Lesser General Public -//License as published by the Free Software Foundation; either -//version 2.1 of the License, or (at your option) any later version. -// -//This program is distributed in the hope that it will be useful, -//but WITHOUT ANY WARRANTY; without even the implied warranty of -//MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -//Lesser General Public License for more details. -// -//You should have received a copy of the GNU Lesser General Public -//License along with this program; if not, write to the Free Software -//Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -#include -#include -#include -#include -#include -#include "Image.h" - -static int LUT16to32[65536]; -static int RGBtoYUV[65536]; -static int YUV1, YUV2; -const int Ymask = 0x00FF0000; -const int Umask = 0x0000FF00; -const int Vmask = 0x000000FF; -const int trY = 0x00300000; -const int trU = 0x00000700; -const int trV = 0x00000006; - -inline void Interp1(unsigned char * pc, int c1, int c2) -{ - *((int*)pc) = (c1*3+c2) >> 2; -} - -inline void Interp2(unsigned char * pc, int c1, int c2, int c3) -{ - *((int*)pc) = (c1*2+c2+c3) >> 2; -} - -inline void Interp5(unsigned char * pc, int c1, int c2) -{ - *((int*)pc) = (c1+c2) >> 1; -} - -inline void Interp6(unsigned char * pc, int c1, int c2, int c3) -{ - //*((int*)pc) = (c1*5+c2*2+c3)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*5 + (c2 & 0x00FF00)*2 + (c3 & 0x00FF00) ) & 0x0007F800) + - (((c1 & 0xFF00FF)*5 + (c2 & 0xFF00FF)*2 + (c3 & 0xFF00FF) ) & 0x07F807F8)) >> 3; -} - -inline void Interp7(unsigned char * pc, int c1, int c2, int c3) -{ - //*((int*)pc) = (c1*6+c2+c3)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*6 + (c2 & 0x00FF00) + (c3 & 0x00FF00) ) & 0x0007F800) + - (((c1 & 0xFF00FF)*6 + (c2 & 0xFF00FF) + (c3 & 0xFF00FF) ) & 0x07F807F8)) >> 3; -} - -inline void Interp9(unsigned char * pc, int c1, int c2, int c3) -{ - //*((int*)pc) = (c1*2+(c2+c3)*3)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*2 + ((c2 & 0x00FF00) + (c3 & 0x00FF00))*3 ) & 0x0007F800) + - (((c1 & 0xFF00FF)*2 + ((c2 & 0xFF00FF) + (c3 & 0xFF00FF))*3 ) & 0x07F807F8)) >> 3; -} - -inline void Interp10(unsigned char * pc, int c1, int c2, int c3) -{ - //*((int*)pc) = (c1*14+c2+c3)/16; - - *((int*)pc) = ((((c1 & 0x00FF00)*14 + (c2 & 0x00FF00) + (c3 & 0x00FF00) ) & 0x000FF000) + - (((c1 & 0xFF00FF)*14 + (c2 & 0xFF00FF) + (c3 & 0xFF00FF) ) & 0x0FF00FF0)) >> 4; -} - - -#define PIXEL00_0 *((int*)(pOut)) = c[5]; -#define PIXEL00_10 Interp1(pOut, c[5], c[1]); -#define PIXEL00_11 Interp1(pOut, c[5], c[4]); -#define PIXEL00_12 Interp1(pOut, c[5], c[2]); -#define PIXEL00_20 Interp2(pOut, c[5], c[4], c[2]); -#define PIXEL00_21 Interp2(pOut, c[5], c[1], c[2]); -#define PIXEL00_22 Interp2(pOut, c[5], c[1], c[4]); -#define PIXEL00_60 Interp6(pOut, c[5], c[2], c[4]); -#define PIXEL00_61 Interp6(pOut, c[5], c[4], c[2]); -#define PIXEL00_70 Interp7(pOut, c[5], c[4], c[2]); -#define PIXEL00_90 Interp9(pOut, c[5], c[4], c[2]); -#define PIXEL00_100 Interp10(pOut, c[5], c[4], c[2]); -#define PIXEL01_0 *((int*)(pOut+4)) = c[5]; -#define PIXEL01_10 Interp1(pOut+4, c[5], c[3]); -#define PIXEL01_11 Interp1(pOut+4, c[5], c[2]); -#define PIXEL01_12 Interp1(pOut+4, c[5], c[6]); -#define PIXEL01_20 Interp2(pOut+4, c[5], c[2], c[6]); -#define PIXEL01_21 Interp2(pOut+4, c[5], c[3], c[6]); -#define PIXEL01_22 Interp2(pOut+4, c[5], c[3], c[2]); -#define PIXEL01_60 Interp6(pOut+4, c[5], c[6], c[2]); -#define PIXEL01_61 Interp6(pOut+4, c[5], c[2], c[6]); -#define PIXEL01_70 Interp7(pOut+4, c[5], c[2], c[6]); -#define PIXEL01_90 Interp9(pOut+4, c[5], c[2], c[6]); -#define PIXEL01_100 Interp10(pOut+4, c[5], c[2], c[6]); -#define PIXEL10_0 *((int*)(pOut+BpL)) = c[5]; -#define PIXEL10_10 Interp1(pOut+BpL, c[5], c[7]); -#define PIXEL10_11 Interp1(pOut+BpL, c[5], c[8]); -#define PIXEL10_12 Interp1(pOut+BpL, c[5], c[4]); -#define PIXEL10_20 Interp2(pOut+BpL, c[5], c[8], c[4]); -#define PIXEL10_21 Interp2(pOut+BpL, c[5], c[7], c[4]); -#define PIXEL10_22 Interp2(pOut+BpL, c[5], c[7], c[8]); -#define PIXEL10_60 Interp6(pOut+BpL, c[5], c[4], c[8]); -#define PIXEL10_61 Interp6(pOut+BpL, c[5], c[8], c[4]); -#define PIXEL10_70 Interp7(pOut+BpL, c[5], c[8], c[4]); -#define PIXEL10_90 Interp9(pOut+BpL, c[5], c[8], c[4]); -#define PIXEL10_100 Interp10(pOut+BpL, c[5], c[8], c[4]); -#define PIXEL11_0 *((int*)(pOut+BpL+4)) = c[5]; -#define PIXEL11_10 Interp1(pOut+BpL+4, c[5], c[9]); -#define PIXEL11_11 Interp1(pOut+BpL+4, c[5], c[6]); -#define PIXEL11_12 Interp1(pOut+BpL+4, c[5], c[8]); -#define PIXEL11_20 Interp2(pOut+BpL+4, c[5], c[6], c[8]); -#define PIXEL11_21 Interp2(pOut+BpL+4, c[5], c[9], c[8]); -#define PIXEL11_22 Interp2(pOut+BpL+4, c[5], c[9], c[6]); -#define PIXEL11_60 Interp6(pOut+BpL+4, c[5], c[8], c[6]); -#define PIXEL11_61 Interp6(pOut+BpL+4, c[5], c[6], c[8]); -#define PIXEL11_70 Interp7(pOut+BpL+4, c[5], c[6], c[8]); -#define PIXEL11_90 Interp9(pOut+BpL+4, c[5], c[6], c[8]); -#define PIXEL11_100 Interp10(pOut+BpL+4, c[5], c[6], c[8]); - - - -inline bool Diff(unsigned int w1, unsigned int w2) -{ - YUV1 = RGBtoYUV[w1]; - YUV2 = RGBtoYUV[w2]; - return ( ( abs((YUV1 & Ymask) - (YUV2 & Ymask)) > trY ) || - ( abs((YUV1 & Umask) - (YUV2 & Umask)) > trU ) || - ( abs((YUV1 & Vmask) - (YUV2 & Vmask)) > trV ) ); -} - -void hq2x_32( unsigned char * pIn, unsigned char * pOut, int Xres, int Yres, int BpL ) -{ - int i, j, k; - int prevline, nextline; - int w[10]; - int c[10]; - - // +----+----+----+ - // | | | | - // | w1 | w2 | w3 | - // +----+----+----+ - // | | | | - // | w4 | w5 | w6 | - // +----+----+----+ - // | | | | - // | w7 | w8 | w9 | - // +----+----+----+ - - for (j=0; j0) prevline = -Xres*2; else prevline = 0; - if (j0) - { - w[1] = *((unsigned short*)(pIn + prevline - 2)); - w[4] = *((unsigned short*)(pIn - 2)); - w[7] = *((unsigned short*)(pIn + nextline - 2)); - } - else - { - w[1] = w[2]; - w[4] = w[5]; - w[7] = w[8]; - } - - if (i trY ) || - ( abs((YUV1 & Umask) - (YUV2 & Umask)) > trU ) || - ( abs((YUV1 & Vmask) - (YUV2 & Vmask)) > trV ) ) - pattern |= flag; - } - flag <<= 1; - } - - for (k=1; k<=9; k++) - c[k] = LUT16to32[w[k]]; - - switch (pattern) - { - case 0: - case 1: - case 4: - case 32: - case 128: - case 5: - case 132: - case 160: - case 33: - case 129: - case 36: - case 133: - case 164: - case 161: - case 37: - case 165: - { - PIXEL00_20 - PIXEL01_20 - PIXEL10_20 - PIXEL11_20 - break; - } - case 2: - case 34: - case 130: - case 162: - { - PIXEL00_22 - PIXEL01_21 - PIXEL10_20 - PIXEL11_20 - break; - } - case 16: - case 17: - case 48: - case 49: - { - PIXEL00_20 - PIXEL01_22 - PIXEL10_20 - PIXEL11_21 - break; - } - case 64: - case 65: - case 68: - case 69: - { - PIXEL00_20 - PIXEL01_20 - PIXEL10_21 - PIXEL11_22 - break; - } - case 8: - case 12: - case 136: - case 140: - { - PIXEL00_21 - PIXEL01_20 - PIXEL10_22 - PIXEL11_20 - break; - } - case 3: - case 35: - case 131: - case 163: - { - PIXEL00_11 - PIXEL01_21 - PIXEL10_20 - PIXEL11_20 - break; - } - case 6: - case 38: - case 134: - case 166: - { - PIXEL00_22 - PIXEL01_12 - PIXEL10_20 - PIXEL11_20 - break; - } - case 20: - case 21: - case 52: - case 53: - { - PIXEL00_20 - PIXEL01_11 - PIXEL10_20 - PIXEL11_21 - break; - } - case 144: - case 145: - case 176: - case 177: - { - PIXEL00_20 - PIXEL01_22 - PIXEL10_20 - PIXEL11_12 - break; - } - case 192: - case 193: - case 196: - case 197: - { - PIXEL00_20 - PIXEL01_20 - PIXEL10_21 - PIXEL11_11 - break; - } - case 96: - case 97: - case 100: - case 101: - { - PIXEL00_20 - PIXEL01_20 - PIXEL10_12 - PIXEL11_22 - break; - } - case 40: - case 44: - case 168: - case 172: - { - PIXEL00_21 - PIXEL01_20 - PIXEL10_11 - PIXEL11_20 - break; - } - case 9: - case 13: - case 137: - case 141: - { - PIXEL00_12 - PIXEL01_20 - PIXEL10_22 - PIXEL11_20 - break; - } - case 18: - case 50: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_20 - } - PIXEL10_20 - PIXEL11_21 - break; - } - case 80: - case 81: - { - PIXEL00_20 - PIXEL01_22 - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_20 - } - break; - } - case 72: - case 76: - { - PIXEL00_21 - PIXEL01_20 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_20 - } - PIXEL11_22 - break; - } - case 10: - case 138: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_20 - } - PIXEL01_21 - PIXEL10_22 - PIXEL11_20 - break; - } - case 66: - { - PIXEL00_22 - PIXEL01_21 - PIXEL10_21 - PIXEL11_22 - break; - } - case 24: - { - PIXEL00_21 - PIXEL01_22 - PIXEL10_22 - PIXEL11_21 - break; - } - case 7: - case 39: - case 135: - { - PIXEL00_11 - PIXEL01_12 - PIXEL10_20 - PIXEL11_20 - break; - } - case 148: - case 149: - case 180: - { - PIXEL00_20 - PIXEL01_11 - PIXEL10_20 - PIXEL11_12 - break; - } - case 224: - case 228: - case 225: - { - PIXEL00_20 - PIXEL01_20 - PIXEL10_12 - PIXEL11_11 - break; - } - case 41: - case 169: - case 45: - { - PIXEL00_12 - PIXEL01_20 - PIXEL10_11 - PIXEL11_20 - break; - } - case 22: - case 54: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_20 - PIXEL11_21 - break; - } - case 208: - case 209: - { - PIXEL00_20 - PIXEL01_22 - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 104: - case 108: - { - PIXEL00_21 - PIXEL01_20 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_22 - break; - } - case 11: - case 139: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_21 - PIXEL10_22 - PIXEL11_20 - break; - } - case 19: - case 51: - { - if (Diff(w[2], w[6])) - { - PIXEL00_11 - PIXEL01_10 - } - else - { - PIXEL00_60 - PIXEL01_90 - } - PIXEL10_20 - PIXEL11_21 - break; - } - case 146: - case 178: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_10 - PIXEL11_12 - } - else - { - PIXEL01_90 - PIXEL11_61 - } - PIXEL10_20 - break; - } - case 84: - case 85: - { - PIXEL00_20 - if (Diff(w[6], w[8])) - { - PIXEL01_11 - PIXEL11_10 - } - else - { - PIXEL01_60 - PIXEL11_90 - } - PIXEL10_21 - break; - } - case 112: - case 113: - { - PIXEL00_20 - PIXEL01_22 - if (Diff(w[6], w[8])) - { - PIXEL10_12 - PIXEL11_10 - } - else - { - PIXEL10_61 - PIXEL11_90 - } - break; - } - case 200: - case 204: - { - PIXEL00_21 - PIXEL01_20 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - PIXEL11_11 - } - else - { - PIXEL10_90 - PIXEL11_60 - } - break; - } - case 73: - case 77: - { - if (Diff(w[8], w[4])) - { - PIXEL00_12 - PIXEL10_10 - } - else - { - PIXEL00_61 - PIXEL10_90 - } - PIXEL01_20 - PIXEL11_22 - break; - } - case 42: - case 170: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - PIXEL10_11 - } - else - { - PIXEL00_90 - PIXEL10_60 - } - PIXEL01_21 - PIXEL11_20 - break; - } - case 14: - case 142: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - PIXEL01_12 - } - else - { - PIXEL00_90 - PIXEL01_61 - } - PIXEL10_22 - PIXEL11_20 - break; - } - case 67: - { - PIXEL00_11 - PIXEL01_21 - PIXEL10_21 - PIXEL11_22 - break; - } - case 70: - { - PIXEL00_22 - PIXEL01_12 - PIXEL10_21 - PIXEL11_22 - break; - } - case 28: - { - PIXEL00_21 - PIXEL01_11 - PIXEL10_22 - PIXEL11_21 - break; - } - case 152: - { - PIXEL00_21 - PIXEL01_22 - PIXEL10_22 - PIXEL11_12 - break; - } - case 194: - { - PIXEL00_22 - PIXEL01_21 - PIXEL10_21 - PIXEL11_11 - break; - } - case 98: - { - PIXEL00_22 - PIXEL01_21 - PIXEL10_12 - PIXEL11_22 - break; - } - case 56: - { - PIXEL00_21 - PIXEL01_22 - PIXEL10_11 - PIXEL11_21 - break; - } - case 25: - { - PIXEL00_12 - PIXEL01_22 - PIXEL10_22 - PIXEL11_21 - break; - } - case 26: - case 31: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_22 - PIXEL11_21 - break; - } - case 82: - case 214: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 88: - case 248: - { - PIXEL00_21 - PIXEL01_22 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 74: - case 107: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_21 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_22 - break; - } - case 27: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_10 - PIXEL10_22 - PIXEL11_21 - break; - } - case 86: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_21 - PIXEL11_10 - break; - } - case 216: - { - PIXEL00_21 - PIXEL01_22 - PIXEL10_10 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 106: - { - PIXEL00_10 - PIXEL01_21 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_22 - break; - } - case 30: - { - PIXEL00_10 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_22 - PIXEL11_21 - break; - } - case 210: - { - PIXEL00_22 - PIXEL01_10 - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 120: - { - PIXEL00_21 - PIXEL01_22 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_10 - break; - } - case 75: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_21 - PIXEL10_10 - PIXEL11_22 - break; - } - case 29: - { - PIXEL00_12 - PIXEL01_11 - PIXEL10_22 - PIXEL11_21 - break; - } - case 198: - { - PIXEL00_22 - PIXEL01_12 - PIXEL10_21 - PIXEL11_11 - break; - } - case 184: - { - PIXEL00_21 - PIXEL01_22 - PIXEL10_11 - PIXEL11_12 - break; - } - case 99: - { - PIXEL00_11 - PIXEL01_21 - PIXEL10_12 - PIXEL11_22 - break; - } - case 57: - { - PIXEL00_12 - PIXEL01_22 - PIXEL10_11 - PIXEL11_21 - break; - } - case 71: - { - PIXEL00_11 - PIXEL01_12 - PIXEL10_21 - PIXEL11_22 - break; - } - case 156: - { - PIXEL00_21 - PIXEL01_11 - PIXEL10_22 - PIXEL11_12 - break; - } - case 226: - { - PIXEL00_22 - PIXEL01_21 - PIXEL10_12 - PIXEL11_11 - break; - } - case 60: - { - PIXEL00_21 - PIXEL01_11 - PIXEL10_11 - PIXEL11_21 - break; - } - case 195: - { - PIXEL00_11 - PIXEL01_21 - PIXEL10_21 - PIXEL11_11 - break; - } - case 102: - { - PIXEL00_22 - PIXEL01_12 - PIXEL10_12 - PIXEL11_22 - break; - } - case 153: - { - PIXEL00_12 - PIXEL01_22 - PIXEL10_22 - PIXEL11_12 - break; - } - case 58: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_11 - PIXEL11_21 - break; - } - case 83: - { - PIXEL00_11 - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 92: - { - PIXEL00_21 - PIXEL01_11 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 202: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - PIXEL01_21 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - PIXEL11_11 - break; - } - case 78: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - PIXEL01_12 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - PIXEL11_22 - break; - } - case 154: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_22 - PIXEL11_12 - break; - } - case 114: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_12 - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 89: - { - PIXEL00_12 - PIXEL01_22 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 90: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 55: - case 23: - { - if (Diff(w[2], w[6])) - { - PIXEL00_11 - PIXEL01_0 - } - else - { - PIXEL00_60 - PIXEL01_90 - } - PIXEL10_20 - PIXEL11_21 - break; - } - case 182: - case 150: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - PIXEL11_12 - } - else - { - PIXEL01_90 - PIXEL11_61 - } - PIXEL10_20 - break; - } - case 213: - case 212: - { - PIXEL00_20 - if (Diff(w[6], w[8])) - { - PIXEL01_11 - PIXEL11_0 - } - else - { - PIXEL01_60 - PIXEL11_90 - } - PIXEL10_21 - break; - } - case 241: - case 240: - { - PIXEL00_20 - PIXEL01_22 - if (Diff(w[6], w[8])) - { - PIXEL10_12 - PIXEL11_0 - } - else - { - PIXEL10_61 - PIXEL11_90 - } - break; - } - case 236: - case 232: - { - PIXEL00_21 - PIXEL01_20 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - PIXEL11_11 - } - else - { - PIXEL10_90 - PIXEL11_60 - } - break; - } - case 109: - case 105: - { - if (Diff(w[8], w[4])) - { - PIXEL00_12 - PIXEL10_0 - } - else - { - PIXEL00_61 - PIXEL10_90 - } - PIXEL01_20 - PIXEL11_22 - break; - } - case 171: - case 43: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL10_11 - } - else - { - PIXEL00_90 - PIXEL10_60 - } - PIXEL01_21 - PIXEL11_20 - break; - } - case 143: - case 15: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_12 - } - else - { - PIXEL00_90 - PIXEL01_61 - } - PIXEL10_22 - PIXEL11_20 - break; - } - case 124: - { - PIXEL00_21 - PIXEL01_11 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_10 - break; - } - case 203: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_21 - PIXEL10_10 - PIXEL11_11 - break; - } - case 62: - { - PIXEL00_10 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_11 - PIXEL11_21 - break; - } - case 211: - { - PIXEL00_11 - PIXEL01_10 - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 118: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_12 - PIXEL11_10 - break; - } - case 217: - { - PIXEL00_12 - PIXEL01_22 - PIXEL10_10 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 110: - { - PIXEL00_10 - PIXEL01_12 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_22 - break; - } - case 155: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_10 - PIXEL10_22 - PIXEL11_12 - break; - } - case 188: - { - PIXEL00_21 - PIXEL01_11 - PIXEL10_11 - PIXEL11_12 - break; - } - case 185: - { - PIXEL00_12 - PIXEL01_22 - PIXEL10_11 - PIXEL11_12 - break; - } - case 61: - { - PIXEL00_12 - PIXEL01_11 - PIXEL10_11 - PIXEL11_21 - break; - } - case 157: - { - PIXEL00_12 - PIXEL01_11 - PIXEL10_22 - PIXEL11_12 - break; - } - case 103: - { - PIXEL00_11 - PIXEL01_12 - PIXEL10_12 - PIXEL11_22 - break; - } - case 227: - { - PIXEL00_11 - PIXEL01_21 - PIXEL10_12 - PIXEL11_11 - break; - } - case 230: - { - PIXEL00_22 - PIXEL01_12 - PIXEL10_12 - PIXEL11_11 - break; - } - case 199: - { - PIXEL00_11 - PIXEL01_12 - PIXEL10_21 - PIXEL11_11 - break; - } - case 220: - { - PIXEL00_21 - PIXEL01_11 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 158: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_22 - PIXEL11_12 - break; - } - case 234: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - PIXEL01_21 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_11 - break; - } - case 242: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_12 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 59: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_11 - PIXEL11_21 - break; - } - case 121: - { - PIXEL00_12 - PIXEL01_22 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 87: - { - PIXEL00_11 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 79: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_12 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - PIXEL11_22 - break; - } - case 122: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 94: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 218: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 91: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 229: - { - PIXEL00_20 - PIXEL01_20 - PIXEL10_12 - PIXEL11_11 - break; - } - case 167: - { - PIXEL00_11 - PIXEL01_12 - PIXEL10_20 - PIXEL11_20 - break; - } - case 173: - { - PIXEL00_12 - PIXEL01_20 - PIXEL10_11 - PIXEL11_20 - break; - } - case 181: - { - PIXEL00_20 - PIXEL01_11 - PIXEL10_20 - PIXEL11_12 - break; - } - case 186: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_11 - PIXEL11_12 - break; - } - case 115: - { - PIXEL00_11 - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_12 - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 93: - { - PIXEL00_12 - PIXEL01_11 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 206: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - PIXEL01_12 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - PIXEL11_11 - break; - } - case 205: - case 201: - { - PIXEL00_12 - PIXEL01_20 - if (Diff(w[8], w[4])) - { - PIXEL10_10 - } - else - { - PIXEL10_70 - } - PIXEL11_11 - break; - } - case 174: - case 46: - { - if (Diff(w[4], w[2])) - { - PIXEL00_10 - } - else - { - PIXEL00_70 - } - PIXEL01_12 - PIXEL10_11 - PIXEL11_20 - break; - } - case 179: - case 147: - { - PIXEL00_11 - if (Diff(w[2], w[6])) - { - PIXEL01_10 - } - else - { - PIXEL01_70 - } - PIXEL10_20 - PIXEL11_12 - break; - } - case 117: - case 116: - { - PIXEL00_20 - PIXEL01_11 - PIXEL10_12 - if (Diff(w[6], w[8])) - { - PIXEL11_10 - } - else - { - PIXEL11_70 - } - break; - } - case 189: - { - PIXEL00_12 - PIXEL01_11 - PIXEL10_11 - PIXEL11_12 - break; - } - case 231: - { - PIXEL00_11 - PIXEL01_12 - PIXEL10_12 - PIXEL11_11 - break; - } - case 126: - { - PIXEL00_10 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_10 - break; - } - case 219: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_10 - PIXEL10_10 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 125: - { - if (Diff(w[8], w[4])) - { - PIXEL00_12 - PIXEL10_0 - } - else - { - PIXEL00_61 - PIXEL10_90 - } - PIXEL01_11 - PIXEL11_10 - break; - } - case 221: - { - PIXEL00_12 - if (Diff(w[6], w[8])) - { - PIXEL01_11 - PIXEL11_0 - } - else - { - PIXEL01_60 - PIXEL11_90 - } - PIXEL10_10 - break; - } - case 207: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_12 - } - else - { - PIXEL00_90 - PIXEL01_61 - } - PIXEL10_10 - PIXEL11_11 - break; - } - case 238: - { - PIXEL00_10 - PIXEL01_12 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - PIXEL11_11 - } - else - { - PIXEL10_90 - PIXEL11_60 - } - break; - } - case 190: - { - PIXEL00_10 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - PIXEL11_12 - } - else - { - PIXEL01_90 - PIXEL11_61 - } - PIXEL10_11 - break; - } - case 187: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL10_11 - } - else - { - PIXEL00_90 - PIXEL10_60 - } - PIXEL01_10 - PIXEL11_12 - break; - } - case 243: - { - PIXEL00_11 - PIXEL01_10 - if (Diff(w[6], w[8])) - { - PIXEL10_12 - PIXEL11_0 - } - else - { - PIXEL10_61 - PIXEL11_90 - } - break; - } - case 119: - { - if (Diff(w[2], w[6])) - { - PIXEL00_11 - PIXEL01_0 - } - else - { - PIXEL00_60 - PIXEL01_90 - } - PIXEL10_12 - PIXEL11_10 - break; - } - case 237: - case 233: - { - PIXEL00_12 - PIXEL01_20 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_100 - } - PIXEL11_11 - break; - } - case 175: - case 47: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_100 - } - PIXEL01_12 - PIXEL10_11 - PIXEL11_20 - break; - } - case 183: - case 151: - { - PIXEL00_11 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_100 - } - PIXEL10_20 - PIXEL11_12 - break; - } - case 245: - case 244: - { - PIXEL00_20 - PIXEL01_11 - PIXEL10_12 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_100 - } - break; - } - case 250: - { - PIXEL00_10 - PIXEL01_10 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 123: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_10 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_10 - break; - } - case 95: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_10 - PIXEL11_10 - break; - } - case 222: - { - PIXEL00_10 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_10 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 252: - { - PIXEL00_21 - PIXEL01_11 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_100 - } - break; - } - case 249: - { - PIXEL00_12 - PIXEL01_22 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_100 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 235: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_21 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_100 - } - PIXEL11_11 - break; - } - case 111: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_100 - } - PIXEL01_12 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_22 - break; - } - case 63: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_100 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_11 - PIXEL11_21 - break; - } - case 159: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_100 - } - PIXEL10_22 - PIXEL11_12 - break; - } - case 215: - { - PIXEL00_11 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_100 - } - PIXEL10_21 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 246: - { - PIXEL00_22 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - PIXEL10_12 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_100 - } - break; - } - case 254: - { - PIXEL00_10 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_100 - } - break; - } - case 253: - { - PIXEL00_12 - PIXEL01_11 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_100 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_100 - } - break; - } - case 251: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_10 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_100 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 239: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_100 - } - PIXEL01_12 - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_100 - } - PIXEL11_11 - break; - } - case 127: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_100 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_20 - } - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_20 - } - PIXEL11_10 - break; - } - case 191: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_100 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_100 - } - PIXEL10_11 - PIXEL11_12 - break; - } - case 223: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_100 - } - PIXEL10_10 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_20 - } - break; - } - case 247: - { - PIXEL00_11 - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_100 - } - PIXEL10_12 - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_100 - } - break; - } - case 255: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_100 - } - if (Diff(w[2], w[6])) - { - PIXEL01_0 - } - else - { - PIXEL01_100 - } - if (Diff(w[8], w[4])) - { - PIXEL10_0 - } - else - { - PIXEL10_100 - } - if (Diff(w[6], w[8])) - { - PIXEL11_0 - } - else - { - PIXEL11_100 - } - break; - } - } - pIn+=2; - pOut+=8; - } - pOut+=BpL; - } -} - -void InitLUTs(void) -{ - int i, j, k, r, g, b, Y, u, v; - - for (i=0; i<65536; i++) - LUT16to32[i] = ((i & 0xF800) << 8) + ((i & 0x07E0) << 5) + ((i & 0x001F) << 3); - - for (i=0; i<32; i++) - for (j=0; j<64; j++) - for (k=0; k<32; k++) - { - r = i << 3; - g = j << 2; - b = k << 3; - Y = (r + g + b) >> 2; - u = 128 + ((r - b) >> 2); - v = 128 + ((-r + 2*g -b)>>3); - RGBtoYUV[ (i << 11) + (j << 5) + k ] = (Y<<16) + (u<<8) + v; - } -} - -int main(int argc, char* argv[]) -{ - int nRes; - CImage ImageIn; - CImage ImageOut; - char * szFilenameIn; - char * szFilenameOut; - - if (argc <= 2) - { - printf("\nUsage: hq2x.exe input.bmp output.bmp\n"); - printf("supports .bmp and .tga formats\n"); - return 1; - } - - szFilenameIn = argv[1]; - szFilenameOut = argv[2]; - - if ( GetFileAttributes( szFilenameIn ) == -1 ) - { - printf( "ERROR: file '%s'\n not found", szFilenameIn ); - return 1; - } - - if ( ImageIn.Load( szFilenameIn ) != 0 ) - { - printf( "ERROR: can't load '%s'\n", szFilenameIn ); - return 1; - } - - if ( ImageIn.m_BitPerPixel != 16 ) - { - if ( ImageIn.ConvertTo16() != 0 ) - { - printf( "ERROR: '%s' conversion to 16 bit failed\n", szFilenameIn ); - return 1; - } - } - - printf( "\n%s is %ix%ix%i\n", szFilenameIn, ImageIn.m_Xres, ImageIn.m_Yres, ImageIn.m_BitPerPixel ); - - if ( ImageOut.Init( ImageIn.m_Xres*2, ImageIn.m_Yres*2, 32 ) != 0 ) - { - printf( "ERROR: ImageOut.Init()\n" ); - return 1; - }; - - InitLUTs(); - - hq2x_32( ImageIn.m_pBitmap, ImageOut.m_pBitmap, ImageIn.m_Xres, ImageIn.m_Yres, ImageOut.m_Xres*4 ); - - nRes = ImageOut.Save( szFilenameOut ); - if ( nRes != 0 ) - { - printf( "ERROR %i: ImageOut.Save(\"%s\")\n", nRes, szFilenameOut ); - return nRes; - } - printf( "%s is %ix%ix%i\n", szFilenameOut, ImageOut.m_Xres, ImageOut.m_Yres, ImageOut.m_BitPerPixel ); - - printf( "\nOK\n" ); - return 0; -} diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/hq2x.pas b/components/vampireimaging/Extras/Contrib/HqResampler/hq2x.pas deleted file mode 100644 index 9eb8f83..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/hq2x.pas +++ /dev/null @@ -1,2725 +0,0 @@ -{ - - HQ2X - - Original author: Maxim Stepin - Pascal translation: Jeremy Darling - -} - - -unit hq2x; - -{$DEFINE HAS_INLINE} - -interface - -type - hq2xnumber = Longword; - phq2xnumber=^hq2xnumber; - -procedure hq2x_32(Input, Output: Pointer; XResolution, YResolution, Bpl: hq2xnumber); - -implementation - -{$IFNDEF FPC} - {$G-} -{$ENDIF} - -var - LUT16to32: array[0..65535] of hq2xnumber; - RGBtoYUV: array[0..65535] of hq2xnumber; - -const - _Ymask = $00FF0000; - _Umask = $0000FF00; - _Vmask = $000000FF; - _trY = $00300000; - _trU = $00000700; - _trV = $00000006; - -procedure Interp1(pc: Pointer; c1, c2: hq2xnumber); {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: *((int*)pc) = (c1*3+c2) >> 2; - Phq2xnumber(pc)^ := (c1 * 3 + c2) shr 2; -end; - -procedure Interp2(pc: Pointer; c1, c2, c3: hq2xnumber); {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: *((int*)pc) = (c1*2+c2+c3) >> 2; - Phq2xnumber(pc)^ := (c1 * 2 + c2 + c3) shr 2; -end; - -procedure Interp5(pc: Pointer; c1, c2: hq2xnumber); {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: *((int*)pc) = (c1+c2) >> 1; - Phq2xnumber(pc)^ := (c1 + c2) shr 1; -end; - -procedure Interp6(pc: Pointer; c1, c2, c3: hq2xnumber); {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: *((int*)pc) = ((((c1 & 0x00FF00)*5 + (c2 & 0x00FF00)*2 + (c3 & 0x00FF00) ) & 0x0007F800) + - // (((c1 & 0xFF00FF)*5 + (c2 & 0xFF00FF)*2 + (c3 & 0xFF00FF) ) & 0x07F807F8)) >> 3; - Phq2xnumber(pc)^ := ((((c1 and $00FF00) * 5 + (c2 and $00FF00) * 2 + (c3 and $00FF00)) and - $0007F800) + (((c1 and $FF00FF) * 5 + (c2 and $FF00FF) * 2 + - (c3 and $FF00FF)) and $07F807F8)) shr 3; -end; - -procedure Interp7(pc: Pointer; c1, c2, c3: hq2xnumber); {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: *((int*)pc) = ((((c1 & 0x00FF00)*6 + (c2 & 0x00FF00) + (c3 & 0x00FF00) ) & 0x0007F800) + - // (((c1 & 0xFF00FF)*6 + (c2 & 0xFF00FF) + (c3 & 0xFF00FF) ) & 0x07F807F8)) >> 3; - Phq2xnumber(pc)^ := ((((c1 and $00FF00) * 6 + (c2 and $00FF00) + (c3 and $00FF00)) and - $0007F800) + (((c1 and $FF00FF) * 6 + (c2 and $FF00FF) + - (c3 and $FF00FF)) and $07F807F8)) shr 3; -end; - -procedure Interp9(pc: Pointer; c1, c2, c3: hq2xnumber); {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: *((int*)pc) = ((((c1 & 0x00FF00)*2 + ((c2 & 0x00FF00) + (c3 & 0x00FF00))*3 ) & 0x0007F800) + - // (((c1 & 0xFF00FF)*2 + ((c2 & 0xFF00FF) + (c3 & 0xFF00FF))*3 ) & 0x07F807F8)) >> 3; - Phq2xnumber(pc)^ := ((((c1 and $00FF00) * 2 + ((c2 and $00FF00) + (c3 and $00FF00)) * 3) and - $0007F800) + (((c1 and $FF00FF) * 2 + - ((c2 and $FF00FF) + (c3 and $FF00FF)) * 3) and $07F807F8)) shr 3; -end; - -procedure Interp10(pc: Pointer; c1, c2, c3: hq2xnumber); {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: *((int*)pc) = ((((c1 & 0x00FF00)*14 + (c2 & 0x00FF00) + (c3 & 0x00FF00) ) & 0x000FF000) + - // (((c1 & 0xFF00FF)*14 + (c2 & 0xFF00FF) + (c3 & 0xFF00FF) ) & 0x0FF00FF0)) >> 4; - Phq2xnumber(pc)^ := ((((c1 and $00FF00) * 14 + (c2 and $00FF00) + (c3 and $00FF00)) and - $000FF000) + (((c1 and $FF00FF) * 14 + (c2 and $FF00FF) + - (c3 and $FF00FF)) and $0FF00FF0)) shr 4; -end; - -function Diff(var YUV1, YUV2: hq2xnumber; w1, w2: hq2xnumber): Boolean; {$IFDEF HAS_INLINE}inline;{$ENDIF} -begin - // C Source: - // YUV1 = RGBtoYUV[w1]; - // YUV2 = RGBtoYUV[w2]; - // return ( ( abs((YUV1 & Ymask) - (YUV2 & Ymask)) > trY ) || - // ( abs((YUV1 & Umask) - (YUV2 & Umask)) > trU ) || - // ( abs((YUV1 & Vmask) - (YUV2 & Vmask)) > trV ) ); - YUV1 := RGBToYUV[w1]; - YUV2 := RGBToYUV[w2]; - Result := ((Abs(Integer((YUV1 and _Ymask)) - Integer((YUV2 and _Ymask))) > _trY) or - (Abs(Integer((YUV1 and _Umask)) - Integer((YUV2 and _Umask))) > _trU) or - (Abs(Integer((YUV1 and _Vmask)) - Integer((YUV2 and _Vmask))) > _trV)); -end; - -procedure hq2x_32(Input, Output: Pointer; XResolution, YResolution, Bpl: hq2xnumber); -var - W, C: array[0..9] of hq2xnumber; - I, J, K: hq2xnumber; - Prevline, Nextline: hq2xnumber; - Pattern, Flag: hq2xnumber; - YUV1, YUV2: hq2xnumber; -begin - if (Input = nil) or (Output = nil) or (XResolution = 0) or - (YResolution = 0) or (Bpl = 0) then - begin - // Possibly raise exception here - Exit; - end; - - // These lines are not crucial but may help in debugging - FillChar(W, SizeOf(W), 0); - FillChar(C, SizeOf(C), 0); - - // See hq2x.cpp for C Source - for J := 0 to YResolution - 1 do - begin - if J > 0 then - begin - Prevline := -XResolution * 2; - end else - begin - Prevline := 0; - end; - - if J < YResolution - 1 then - begin - Nextline := XResolution * 2 - end else - begin - Nextline := 0; - end; - - for I := 0 to XResolution - 1 do - begin - W[2] := PWord(PChar(Input) + Prevline)^; - W[5] := PWord(Input)^; - W[8] := PWord(PChar(Input) + Nextline)^; - - if I > 0 then - begin - W[1] := PWord(PChar(Input) + Prevline - 2)^; - W[4] := PWord(PChar(Input) - 2)^; - W[7] := PWord(PChar(Input) + Nextline - 2)^; - end else - begin - W[1] := W[2]; - W[4] := W[5]; - W[7] := W[8]; - end; - - if I < XResolution - 1 then - begin - W[3] := PWord(PChar(Input) + Prevline + 2)^; - W[6] := PWord(PChar(Input) + 2)^; - W[9] := PWord(PChar(Input) + Nextline + 2)^; - end else - begin - W[3] := W[2]; - W[6] := W[5]; - W[9] := W[8]; - end; - - Pattern := 0; - Flag := 1; - YUV1 := RGBtoYUV[W[5]]; - - for K := 1 to 9 do - begin - if K <> 5 then - begin - if W[K] <> W[5] then - begin - YUV2 := RGBtoYUV[W[K]]; - if ((Abs((YUV1 and _Ymask) - (YUV2 and _Ymask)) > _trY) or - (Abs((YUV1 and _Umask) - (YUV2 and _Umask)) > _trU) or - (Abs((YUV1 and _Vmask) - (YUV2 and _Vmask)) > _trV)) then - begin - Pattern := Pattern or Flag; - end; - end; - Flag := Flag shl 1; - end; - - C[K] := LUT16to32[W[K]]; - end; - - // The big case statement starts here - case (Pattern) of - 0, - 1, - 4, - 32, - 128, - 5, - 132, - 160, - 33, - 129, - 36, - 133, - 164, - 161, - 37, - 165: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 2, - 34, - 130, - 162: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 16, - 17, - 48, - 49: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 64, - 65, - 68, - 69: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 8, - 12, - 136, - 140: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 3, - 35, - 131, - 163: - begin - Interp1(Output, C[5], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 6, - 38, - 134, - 166: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 20, - 21, - 52, - 53: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 144, - 145, - 176, - 177: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 192, - 193, - 196, - 197: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 96, - 97, - 100, - 101: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 40, - 44, - 168, - 172: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 9, - 13, - 137, - 141: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 18, - 50: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 80, - 81: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 72, - 76: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 10, - 138: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 66: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 24: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 7, - 39, - 135: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 148, - 149, - 180: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 224, - 228, - 225: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 41, - 169, - 45: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 22, - 54: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 208, - 209: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 104, - 108: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 11, - 139: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 19, - 51: - begin - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp6(Output, C[5], C[2], C[4]); - Interp9(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 146, - 178: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - end else - begin - Interp9(PChar(Output) + 4, C[5], C[2], C[6]); - Interp6(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - //break; - end; - 84, - 85: - begin - Interp2(Output, C[5], C[4], C[2]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp6(PChar(Output) + 4, C[5], C[6], C[2]); - Interp9(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - //break; - end; - 112, - 113: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp6(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp9(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 200, - 204: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - end else - begin - Interp9(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp6(PChar(Output) + Bpl + 4, C[5], C[8], C[6]); - end; - //break; - end; - 73, - 77: - begin - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(Output, C[5], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp6(Output, C[5], C[4], C[2]); - Interp9(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 42, - 170: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - end else - begin - Interp9(Output, C[5], C[4], C[2]); - Interp6(PChar(Output) + Bpl, C[5], C[4], C[8]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 14, - 142: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - Interp1(PChar(Output) + 4, C[5], C[6]); - end else - begin - Interp9(Output, C[5], C[4], C[2]); - Interp6(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 67: - begin - Interp1(Output, C[5], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 70: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 28: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 152: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 194: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 98: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 56: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 25: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 26, - 31: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 82, - 214: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 88, - 248: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 74, - 107: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 27: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[3]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 86: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 216: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[7]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 106: - begin - Interp1(Output, C[5], C[1]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 30: - begin - Interp1(Output, C[5], C[1]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 210: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp1(PChar(Output) + 4, C[5], C[3]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 120: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 75: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[7]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 29: - begin - Interp1(Output, C[5], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 198: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 184: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 99: - begin - Interp1(Output, C[5], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 57: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 71: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 156: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 226: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 60: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 195: - begin - Interp1(Output, C[5], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 102: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 153: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 58: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 83: - begin - Interp1(Output, C[5], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 92: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 202: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 78: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 154: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 114: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 89: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 90: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 55, - 23: - begin - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(Output, C[5], C[4]); - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp6(Output, C[5], C[2], C[4]); - Interp9(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 182, - 150: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - end else - begin - Interp9(PChar(Output) + 4, C[5], C[2], C[6]); - Interp6(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - //break; - end; - 213, - 212: - begin - Interp2(Output, C[5], C[4], C[2]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + 4, C[5], C[2]); - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp6(PChar(Output) + 4, C[5], C[6], C[2]); - Interp9(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - //break; - end; - 241, - 240: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp6(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp9(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 236, - 232: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - end else - begin - Interp9(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp6(PChar(Output) + Bpl + 4, C[5], C[8], C[6]); - end; - //break; - end; - 109, - 105: - begin - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(Output, C[5], C[2]); - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp6(Output, C[5], C[4], C[2]); - Interp9(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 171, - 43: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - end else - begin - Interp9(Output, C[5], C[4], C[2]); - Interp6(PChar(Output) + Bpl, C[5], C[4], C[8]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 143, - 15: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - Interp1(PChar(Output) + 4, C[5], C[6]); - end else - begin - Interp9(Output, C[5], C[4], C[2]); - Interp6(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 124: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 203: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[7]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 62: - begin - Interp1(Output, C[5], C[1]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 211: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[3]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 118: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 217: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[7]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 110: - begin - Interp1(Output, C[5], C[1]); - Interp1(PChar(Output) + 4, C[5], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 155: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[3]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 188: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 185: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 61: - begin - Interp1(Output, C[5], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 157: - begin - Interp1(Output, C[5], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 103: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 227: - begin - Interp1(Output, C[5], C[4]); - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 230: - begin - Interp2(Output, C[5], C[1], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 199: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 220: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 158: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 234: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 242: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 59: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 121: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 87: - begin - Interp1(Output, C[5], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 79: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 122: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 94: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 218: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 91: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 229: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 167: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 173: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 181: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 186: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 115: - begin - Interp1(Output, C[5], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 93: - begin - Interp1(Output, C[5], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 206: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 205, - 201: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[7]); - end else - begin - Interp7(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 174, - 46: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Interp1(Output, C[5], C[1]); - end else - begin - Interp7(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 179, - 147: - begin - Interp1(Output, C[5], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(PChar(Output) + 4, C[5], C[3]); - end else - begin - Interp7(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 117, - 116: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - end else - begin - Interp7(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 189: - begin - Interp1(Output, C[5], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 231: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 126: - begin - Interp1(Output, C[5], C[1]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 219: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[3]); - Interp1(PChar(Output) + Bpl, C[5], C[7]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 125: - begin - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Interp1(Output, C[5], C[2]); - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp6(Output, C[5], C[4], C[2]); - Interp9(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 221: - begin - Interp1(Output, C[5], C[2]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + 4, C[5], C[2]); - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp6(PChar(Output) + 4, C[5], C[6], C[2]); - Interp9(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[7]); - //break; - end; - 207: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - Interp1(PChar(Output) + 4, C[5], C[6]); - end else - begin - Interp9(Output, C[5], C[4], C[2]); - Interp6(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[7]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 238: - begin - Interp1(Output, C[5], C[1]); - Interp1(PChar(Output) + 4, C[5], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - end else - begin - Interp9(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp6(PChar(Output) + Bpl + 4, C[5], C[8], C[6]); - end; - //break; - end; - 190: - begin - Interp1(Output, C[5], C[1]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - end else - begin - Interp9(PChar(Output) + 4, C[5], C[2], C[6]); - Interp6(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - //break; - end; - 187: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - end else - begin - Interp9(Output, C[5], C[4], C[2]); - Interp6(PChar(Output) + Bpl, C[5], C[4], C[8]); - end; - Interp1(PChar(Output) + 4, C[5], C[3]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 243: - begin - Interp1(Output, C[5], C[4]); - Interp1(PChar(Output) + 4, C[5], C[3]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp6(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp9(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 119: - begin - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Interp1(Output, C[5], C[4]); - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp6(Output, C[5], C[2], C[4]); - Interp9(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 237, - 233: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 175, - 47: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp10(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[6]); - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - //break; - end; - 183, - 151: - begin - Interp1(Output, C[5], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 245, - 244: - begin - Interp2(Output, C[5], C[4], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - Interp1(PChar(Output) + Bpl, C[5], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 250: - begin - Interp1(Output, C[5], C[1]); - Interp1(PChar(Output) + 4, C[5], C[3]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 123: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[3]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 95: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[7]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 222: - begin - Interp1(Output, C[5], C[1]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[7]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 252: - begin - Interp2(Output, C[5], C[1], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 249: - begin - Interp1(Output, C[5], C[2]); - Interp2(PChar(Output) + 4, C[5], C[3], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 235: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp2(PChar(Output) + 4, C[5], C[3], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 111: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp10(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[6]); - //break; - end; - 63: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp10(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp2(PChar(Output) + Bpl + 4, C[5], C[9], C[8]); - //break; - end; - 159: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 215: - begin - Interp1(Output, C[5], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp2(PChar(Output) + Bpl, C[5], C[7], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 246: - begin - Interp2(Output, C[5], C[1], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 254: - begin - Interp1(Output, C[5], C[1]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 253: - begin - Interp1(Output, C[5], C[2]); - Interp1(PChar(Output) + 4, C[5], C[2]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 251: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[3]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 239: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp10(Output, C[5], C[4], C[2]); - end; - Interp1(PChar(Output) + 4, C[5], C[6]); - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[6]); - //break; - end; - 127: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp10(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - Interp1(PChar(Output) + Bpl + 4, C[5], C[9]); - //break; - end; - 191: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp10(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[8]); - Interp1(PChar(Output) + Bpl + 4, C[5], C[8]); - //break; - end; - 223: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp2(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[7]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp2(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 247: - begin - Interp1(Output, C[5], C[4]); - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + 4, C[5], C[2], C[6]); - end; - Interp1(PChar(Output) + Bpl, C[5], C[4]); - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - 255: - begin - if Diff(YUV1, YUV2, W[4], W[2]) then - begin - Phq2xnumber(Output)^ := C[5]; - end else - begin - Interp10(Output, C[5], C[4], C[2]); - end; - if Diff(YUV1, YUV2, W[2], W[6]) then - begin - Phq2xnumber(PChar(Output) + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + 4, C[5], C[2], C[6]); - end; - if Diff(YUV1, YUV2, W[8], W[4]) then - begin - Phq2xnumber(PChar(Output) + Bpl)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl, C[5], C[8], C[4]); - end; - if Diff(YUV1, YUV2, W[6], W[8]) then - begin - Phq2xnumber(PChar(Output) + Bpl + 4)^ := C[5]; - end else - begin - Interp10(PChar(Output) + Bpl + 4, C[5], C[6], C[8]); - end; - //break; - end; - end; - // The big case statement ends here - - Inc(PByte(Input), 2); - Inc(PByte(Output), 8); - end; - Inc(PByte(Output), Bpl); - end; -end; - -procedure InitLUTs; -var - I, J, K, R, G, B, Y, U, V: hq2xnumber; -begin - // C Source: - // int i, j, k, r, g, b, Y, u, v; - // for (i=0; i<65536; i++) - // LUT16to32[i] = ((i & 0xF800) << 8) + ((i & 0x07E0) << 5) + ((i & 0x001F) << 3); - // for (i=0; i<32; i++) - // for (j=0; j<64; j++) - // for (k=0; k<32; k++) - // { - // r = i << 3; - // g = j << 2; - // b = k << 3; - // Y = (r + g + b) >> 2; - // u = 128 + ((r - b) >> 2); - // v = 128 + ((-r + 2*g -b)>>3); - // RGBtoYUV[ (i << 11) + (j << 5) + k ] = (Y<<16) + (u<<8) + v; - // } - for I := 0 to High(LUT16to32) do - begin - LUT16to32[I] := ((I and $F800) shl 8) + ((I and $7E0) shl 5) + ((I and $1F) shl 3); - end; - - for I := 0 to 31 do - begin - for J := 0 to 63 do - begin - for K := 0 to 31 do - begin - R := I shl 3; - G := J shl 2; - B := K shl 3; - Y := (R + G + B) shr 2; - U := 128 + ((R - B) shr 2); - // original line: v = 128 + ((-r + 2*g -b)>>3); - // Changed so that FPC wouldn't complain about mixing signed values - V := 128 + ((2 * G - B - R) shr 3); - RGBtoYUV[(I shl 11) + (J shl 5) + K] := (Y shl 16) + (U shl 8) + V; - end; - end; - end; -end; - -initialization - InitLUTs; - -end. diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/hq3x.cpp b/components/vampireimaging/Extras/Contrib/HqResampler/hq3x.cpp deleted file mode 100644 index bea37f6..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/hq3x.cpp +++ /dev/null @@ -1,3914 +0,0 @@ -//hq3x filter demo program -//---------------------------------------------------------- -//Copyright (C) 2003 MaxSt ( maxst@hiend3d.com ) - -//This program is free software; you can redistribute it and/or -//modify it under the terms of the GNU Lesser General Public -//License as published by the Free Software Foundation; either -//version 2.1 of the License, or (at your option) any later version. -// -//This program is distributed in the hope that it will be useful, -//but WITHOUT ANY WARRANTY; without even the implied warranty of -//MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -//Lesser General Public License for more details. -// -//You should have received a copy of the GNU Lesser General Public -//License along with this program; if not, write to the Free Software -//Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -#include -#include -#include -#include -#include -#include "Image.h" - -static int LUT16to32[65536]; -static int RGBtoYUV[65536]; -static int YUV1, YUV2; -const int Ymask = 0x00FF0000; -const int Umask = 0x0000FF00; -const int Vmask = 0x000000FF; -const int trY = 0x00300000; -const int trU = 0x00000700; -const int trV = 0x00000006; - -inline void Interp1(unsigned char * pc, int c1, int c2) -{ - *((int*)pc) = (c1*3+c2) >> 2; -} - -inline void Interp2(unsigned char * pc, int c1, int c2, int c3) -{ - *((int*)pc) = (c1*2+c2+c3) >> 2; -} - -inline void Interp3(unsigned char * pc, int c1, int c2) -{ - //*((int*)pc) = (c1*7+c2)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*7 + (c2 & 0x00FF00) ) & 0x0007F800) + - (((c1 & 0xFF00FF)*7 + (c2 & 0xFF00FF) ) & 0x07F807F8)) >> 3; -} - -inline void Interp4(unsigned char * pc, int c1, int c2, int c3) -{ - //*((int*)pc) = (c1*2+(c2+c3)*7)/16; - - *((int*)pc) = ((((c1 & 0x00FF00)*2 + ((c2 & 0x00FF00) + (c3 & 0x00FF00))*7 ) & 0x000FF000) + - (((c1 & 0xFF00FF)*2 + ((c2 & 0xFF00FF) + (c3 & 0xFF00FF))*7 ) & 0x0FF00FF0)) >> 4; -} - -inline void Interp5(unsigned char * pc, int c1, int c2) -{ - *((int*)pc) = (c1+c2) >> 1; -} - -#define PIXEL00_1M Interp1(pOut, c[5], c[1]); -#define PIXEL00_1U Interp1(pOut, c[5], c[2]); -#define PIXEL00_1L Interp1(pOut, c[5], c[4]); -#define PIXEL00_2 Interp2(pOut, c[5], c[4], c[2]); -#define PIXEL00_4 Interp4(pOut, c[5], c[4], c[2]); -#define PIXEL00_5 Interp5(pOut, c[4], c[2]); -#define PIXEL00_C *((int*)(pOut)) = c[5]; - -#define PIXEL01_1 Interp1(pOut+4, c[5], c[2]); -#define PIXEL01_3 Interp3(pOut+4, c[5], c[2]); -#define PIXEL01_6 Interp1(pOut+4, c[2], c[5]); -#define PIXEL01_C *((int*)(pOut+4)) = c[5]; - -#define PIXEL02_1M Interp1(pOut+8, c[5], c[3]); -#define PIXEL02_1U Interp1(pOut+8, c[5], c[2]); -#define PIXEL02_1R Interp1(pOut+8, c[5], c[6]); -#define PIXEL02_2 Interp2(pOut+8, c[5], c[2], c[6]); -#define PIXEL02_4 Interp4(pOut+8, c[5], c[2], c[6]); -#define PIXEL02_5 Interp5(pOut+8, c[2], c[6]); -#define PIXEL02_C *((int*)(pOut+8)) = c[5]; - -#define PIXEL10_1 Interp1(pOut+BpL, c[5], c[4]); -#define PIXEL10_3 Interp3(pOut+BpL, c[5], c[4]); -#define PIXEL10_6 Interp1(pOut+BpL, c[4], c[5]); -#define PIXEL10_C *((int*)(pOut+BpL)) = c[5]; - -#define PIXEL11 *((int*)(pOut+BpL+4)) = c[5]; - -#define PIXEL12_1 Interp1(pOut+BpL+8, c[5], c[6]); -#define PIXEL12_3 Interp3(pOut+BpL+8, c[5], c[6]); -#define PIXEL12_6 Interp1(pOut+BpL+8, c[6], c[5]); -#define PIXEL12_C *((int*)(pOut+BpL+8)) = c[5]; - -#define PIXEL20_1M Interp1(pOut+BpL+BpL, c[5], c[7]); -#define PIXEL20_1D Interp1(pOut+BpL+BpL, c[5], c[8]); -#define PIXEL20_1L Interp1(pOut+BpL+BpL, c[5], c[4]); -#define PIXEL20_2 Interp2(pOut+BpL+BpL, c[5], c[8], c[4]); -#define PIXEL20_4 Interp4(pOut+BpL+BpL, c[5], c[8], c[4]); -#define PIXEL20_5 Interp5(pOut+BpL+BpL, c[8], c[4]); -#define PIXEL20_C *((int*)(pOut+BpL+BpL)) = c[5]; - -#define PIXEL21_1 Interp1(pOut+BpL+BpL+4, c[5], c[8]); -#define PIXEL21_3 Interp3(pOut+BpL+BpL+4, c[5], c[8]); -#define PIXEL21_6 Interp1(pOut+BpL+BpL+4, c[8], c[5]); -#define PIXEL21_C *((int*)(pOut+BpL+BpL+4)) = c[5]; - -#define PIXEL22_1M Interp1(pOut+BpL+BpL+8, c[5], c[9]); -#define PIXEL22_1D Interp1(pOut+BpL+BpL+8, c[5], c[8]); -#define PIXEL22_1R Interp1(pOut+BpL+BpL+8, c[5], c[6]); -#define PIXEL22_2 Interp2(pOut+BpL+BpL+8, c[5], c[6], c[8]); -#define PIXEL22_4 Interp4(pOut+BpL+BpL+8, c[5], c[6], c[8]); -#define PIXEL22_5 Interp5(pOut+BpL+BpL+8, c[6], c[8]); -#define PIXEL22_C *((int*)(pOut+BpL+BpL+8)) = c[5]; - -inline bool Diff(unsigned int w1, unsigned int w2) -{ - YUV1 = RGBtoYUV[w1]; - YUV2 = RGBtoYUV[w2]; - return ( ( abs((YUV1 & Ymask) - (YUV2 & Ymask)) > trY ) || - ( abs((YUV1 & Umask) - (YUV2 & Umask)) > trU ) || - ( abs((YUV1 & Vmask) - (YUV2 & Vmask)) > trV ) ); -} - -void hq3x_32( unsigned char * pIn, unsigned char * pOut, int Xres, int Yres, int BpL ) -{ - int i, j, k; - int prevline, nextline; - int w[10]; - int c[10]; - - // +----+----+----+ - // | | | | - // | w1 | w2 | w3 | - // +----+----+----+ - // | | | | - // | w4 | w5 | w6 | - // +----+----+----+ - // | | | | - // | w7 | w8 | w9 | - // +----+----+----+ - - for (j=0; j0) prevline = -Xres*2; else prevline = 0; - if (j0) - { - w[1] = *((unsigned short*)(pIn + prevline - 2)); - w[4] = *((unsigned short*)(pIn - 2)); - w[7] = *((unsigned short*)(pIn + nextline - 2)); - } - else - { - w[1] = w[2]; - w[4] = w[5]; - w[7] = w[8]; - } - - if (i trY ) || - ( abs((YUV1 & Umask) - (YUV2 & Umask)) > trU ) || - ( abs((YUV1 & Vmask) - (YUV2 & Vmask)) > trV ) ) - pattern |= flag; - } - flag <<= 1; - } - - for (k=1; k<=9; k++) - c[k] = LUT16to32[w[k]]; - - switch (pattern) - { - case 0: - case 1: - case 4: - case 32: - case 128: - case 5: - case 132: - case 160: - case 33: - case 129: - case 36: - case 133: - case 164: - case 161: - case 37: - case 165: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_2 - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_2 - PIXEL21_1 - PIXEL22_2 - break; - } - case 2: - case 34: - case 130: - case 162: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_2 - PIXEL21_1 - PIXEL22_2 - break; - } - case 16: - case 17: - case 48: - case 49: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_2 - PIXEL21_1 - PIXEL22_1M - break; - } - case 64: - case 65: - case 68: - case 69: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_2 - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 8: - case 12: - case 136: - case 140: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_2 - PIXEL10_C - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_1 - PIXEL22_2 - break; - } - case 3: - case 35: - case 131: - case 163: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_2 - PIXEL21_1 - PIXEL22_2 - break; - } - case 6: - case 38: - case 134: - case 166: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_2 - PIXEL21_1 - PIXEL22_2 - break; - } - case 20: - case 21: - case 52: - case 53: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1U - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_2 - PIXEL21_1 - PIXEL22_1M - break; - } - case 144: - case 145: - case 176: - case 177: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_2 - PIXEL21_1 - PIXEL22_1D - break; - } - case 192: - case 193: - case 196: - case 197: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_2 - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - break; - } - case 96: - case 97: - case 100: - case 101: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_2 - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - break; - } - case 40: - case 44: - case 168: - case 172: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_2 - PIXEL10_C - PIXEL11 - PIXEL12_1 - PIXEL20_1D - PIXEL21_1 - PIXEL22_2 - break; - } - case 9: - case 13: - case 137: - case 141: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_2 - PIXEL10_C - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_1 - PIXEL22_2 - break; - } - case 18: - case 50: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_1M - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_1 - PIXEL11 - PIXEL20_2 - PIXEL21_1 - PIXEL22_1M - break; - } - case 80: - case 81: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_1M - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 72: - case 76: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_2 - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_1M - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 10: - case 138: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1M - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_1 - PIXEL22_2 - break; - } - case 66: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 24: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1M - break; - } - case 7: - case 39: - case 135: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_2 - PIXEL21_1 - PIXEL22_2 - break; - } - case 148: - case 149: - case 180: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1U - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_2 - PIXEL21_1 - PIXEL22_1D - break; - } - case 224: - case 228: - case 225: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_2 - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1R - break; - } - case 41: - case 169: - case 45: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_2 - PIXEL10_C - PIXEL11 - PIXEL12_1 - PIXEL20_1D - PIXEL21_1 - PIXEL22_2 - break; - } - case 22: - case 54: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_1 - PIXEL11 - PIXEL20_2 - PIXEL21_1 - PIXEL22_1M - break; - } - case 208: - case 209: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 104: - case 108: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_2 - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 11: - case 139: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1M - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_1 - PIXEL22_2 - break; - } - case 19: - case 51: - { - if (Diff(w[2], w[6])) - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL12_C - } - else - { - PIXEL00_2 - PIXEL01_6 - PIXEL02_5 - PIXEL12_1 - } - PIXEL10_1 - PIXEL11 - PIXEL20_2 - PIXEL21_1 - PIXEL22_1M - break; - } - case 146: - case 178: - { - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_1M - PIXEL12_C - PIXEL22_1D - } - else - { - PIXEL01_1 - PIXEL02_5 - PIXEL12_6 - PIXEL22_2 - } - PIXEL00_1M - PIXEL10_1 - PIXEL11 - PIXEL20_2 - PIXEL21_1 - break; - } - case 84: - case 85: - { - if (Diff(w[6], w[8])) - { - PIXEL02_1U - PIXEL12_C - PIXEL21_C - PIXEL22_1M - } - else - { - PIXEL02_2 - PIXEL12_6 - PIXEL21_1 - PIXEL22_5 - } - PIXEL00_2 - PIXEL01_1 - PIXEL10_1 - PIXEL11 - PIXEL20_1M - break; - } - case 112: - case 113: - { - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - } - else - { - PIXEL12_1 - PIXEL20_2 - PIXEL21_6 - PIXEL22_5 - } - PIXEL00_2 - PIXEL01_1 - PIXEL02_1M - PIXEL10_1 - PIXEL11 - break; - } - case 200: - case 204: - { - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - } - else - { - PIXEL10_1 - PIXEL20_5 - PIXEL21_6 - PIXEL22_2 - } - PIXEL00_1M - PIXEL01_1 - PIXEL02_2 - PIXEL11 - PIXEL12_1 - break; - } - case 73: - case 77: - { - if (Diff(w[8], w[4])) - { - PIXEL00_1U - PIXEL10_C - PIXEL20_1M - PIXEL21_C - } - else - { - PIXEL00_2 - PIXEL10_6 - PIXEL20_5 - PIXEL21_1 - } - PIXEL01_1 - PIXEL02_2 - PIXEL11 - PIXEL12_1 - PIXEL22_1M - break; - } - case 42: - case 170: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - PIXEL01_C - PIXEL10_C - PIXEL20_1D - } - else - { - PIXEL00_5 - PIXEL01_1 - PIXEL10_6 - PIXEL20_2 - } - PIXEL02_1M - PIXEL11 - PIXEL12_1 - PIXEL21_1 - PIXEL22_2 - break; - } - case 14: - case 142: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL10_C - } - else - { - PIXEL00_5 - PIXEL01_6 - PIXEL02_2 - PIXEL10_1 - } - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_1 - PIXEL22_2 - break; - } - case 67: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 70: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 28: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1M - break; - } - case 152: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 194: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - break; - } - case 98: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - break; - } - case 56: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 25: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1M - break; - } - case 26: - case 31: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL10_3 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL02_4 - PIXEL12_3 - } - PIXEL11 - PIXEL20_1M - PIXEL21_1 - PIXEL22_1M - break; - } - case 82: - case 214: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - } - else - { - PIXEL01_3 - PIXEL02_4 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 88: - case 248: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1M - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - } - else - { - PIXEL10_3 - PIXEL20_4 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL22_4 - } - break; - } - case 74: - case 107: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - } - else - { - PIXEL00_4 - PIXEL01_3 - } - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 27: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1M - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1M - break; - } - case 86: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_1 - PIXEL11 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 216: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 106: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 30: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_C - PIXEL11 - PIXEL20_1M - PIXEL21_1 - PIXEL22_1M - break; - } - case 210: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 120: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1M - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 75: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1M - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 29: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1M - break; - } - case 198: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - break; - } - case 184: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1D - break; - } - case 99: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - break; - } - case 57: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 71: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 156: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 226: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1R - break; - } - case 60: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 195: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - break; - } - case 102: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - break; - } - case 153: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 58: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 83: - { - PIXEL00_1L - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 92: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 202: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1R - break; - } - case 78: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1R - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1M - break; - } - case 154: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 114: - { - PIXEL00_1M - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1L - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 89: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 90: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_C - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 55: - case 23: - { - if (Diff(w[2], w[6])) - { - PIXEL00_1L - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL00_2 - PIXEL01_6 - PIXEL02_5 - PIXEL12_1 - } - PIXEL10_1 - PIXEL11 - PIXEL20_2 - PIXEL21_1 - PIXEL22_1M - break; - } - case 182: - case 150: - { - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - PIXEL22_1D - } - else - { - PIXEL01_1 - PIXEL02_5 - PIXEL12_6 - PIXEL22_2 - } - PIXEL00_1M - PIXEL10_1 - PIXEL11 - PIXEL20_2 - PIXEL21_1 - break; - } - case 213: - case 212: - { - if (Diff(w[6], w[8])) - { - PIXEL02_1U - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL02_2 - PIXEL12_6 - PIXEL21_1 - PIXEL22_5 - } - PIXEL00_2 - PIXEL01_1 - PIXEL10_1 - PIXEL11 - PIXEL20_1M - break; - } - case 241: - case 240: - { - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL20_1L - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_1 - PIXEL20_2 - PIXEL21_6 - PIXEL22_5 - } - PIXEL00_2 - PIXEL01_1 - PIXEL02_1M - PIXEL10_1 - PIXEL11 - break; - } - case 236: - case 232: - { - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - PIXEL22_1R - } - else - { - PIXEL10_1 - PIXEL20_5 - PIXEL21_6 - PIXEL22_2 - } - PIXEL00_1M - PIXEL01_1 - PIXEL02_2 - PIXEL11 - PIXEL12_1 - break; - } - case 109: - case 105: - { - if (Diff(w[8], w[4])) - { - PIXEL00_1U - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL00_2 - PIXEL10_6 - PIXEL20_5 - PIXEL21_1 - } - PIXEL01_1 - PIXEL02_2 - PIXEL11 - PIXEL12_1 - PIXEL22_1M - break; - } - case 171: - case 43: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - PIXEL20_1D - } - else - { - PIXEL00_5 - PIXEL01_1 - PIXEL10_6 - PIXEL20_2 - } - PIXEL02_1M - PIXEL11 - PIXEL12_1 - PIXEL21_1 - PIXEL22_2 - break; - } - case 143: - case 15: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL02_1R - PIXEL10_C - } - else - { - PIXEL00_5 - PIXEL01_6 - PIXEL02_2 - PIXEL10_1 - } - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_1 - PIXEL22_2 - break; - } - case 124: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 203: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1M - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - break; - } - case 62: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_C - PIXEL11 - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 211: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 118: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_1 - PIXEL11 - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - break; - } - case 217: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 110: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 155: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1M - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 188: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1D - break; - } - case 185: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1D - break; - } - case 61: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 157: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 103: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - break; - } - case 227: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1R - break; - } - case 230: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1R - break; - } - case 199: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - break; - } - case 220: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 158: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_C - PIXEL11 - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 234: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1M - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1R - break; - } - case 242: - { - PIXEL00_1M - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL20_1L - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 59: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 121: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 87: - { - PIXEL00_1L - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_1 - PIXEL11 - PIXEL20_1M - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 79: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1R - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1M - break; - } - case 122: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 94: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_C - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 218: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_C - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 91: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 229: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_2 - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1R - break; - } - case 167: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_2 - PIXEL21_1 - PIXEL22_2 - break; - } - case 173: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_2 - PIXEL10_C - PIXEL11 - PIXEL12_1 - PIXEL20_1D - PIXEL21_1 - PIXEL22_2 - break; - } - case 181: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1U - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_2 - PIXEL21_1 - PIXEL22_1D - break; - } - case 186: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1D - break; - } - case 115: - { - PIXEL00_1L - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1L - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 93: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 206: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1R - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1R - break; - } - case 205: - case 201: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_2 - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_1M - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1R - break; - } - case 174: - case 46: - { - if (Diff(w[4], w[2])) - { - PIXEL00_1M - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1R - PIXEL10_C - PIXEL11 - PIXEL12_1 - PIXEL20_1D - PIXEL21_1 - PIXEL22_2 - break; - } - case 179: - case 147: - { - PIXEL00_1L - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_1M - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_2 - PIXEL21_1 - PIXEL22_1D - break; - } - case 117: - case 116: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1U - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1L - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_1M - } - else - { - PIXEL22_2 - } - break; - } - case 189: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1D - break; - } - case 231: - { - PIXEL00_1L - PIXEL01_C - PIXEL02_1R - PIXEL10_1 - PIXEL11 - PIXEL12_1 - PIXEL20_1L - PIXEL21_C - PIXEL22_1R - break; - } - case 126: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_4 - PIXEL12_3 - } - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 219: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL01_3 - PIXEL10_3 - } - PIXEL02_1M - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 125: - { - if (Diff(w[8], w[4])) - { - PIXEL00_1U - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL00_2 - PIXEL10_6 - PIXEL20_5 - PIXEL21_1 - } - PIXEL01_1 - PIXEL02_1U - PIXEL11 - PIXEL12_C - PIXEL22_1M - break; - } - case 221: - { - if (Diff(w[6], w[8])) - { - PIXEL02_1U - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL02_2 - PIXEL12_6 - PIXEL21_1 - PIXEL22_5 - } - PIXEL00_1U - PIXEL01_1 - PIXEL10_C - PIXEL11 - PIXEL20_1M - break; - } - case 207: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL02_1R - PIXEL10_C - } - else - { - PIXEL00_5 - PIXEL01_6 - PIXEL02_2 - PIXEL10_1 - } - PIXEL11 - PIXEL12_1 - PIXEL20_1M - PIXEL21_C - PIXEL22_1R - break; - } - case 238: - { - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - PIXEL22_1R - } - else - { - PIXEL10_1 - PIXEL20_5 - PIXEL21_6 - PIXEL22_2 - } - PIXEL00_1M - PIXEL01_C - PIXEL02_1R - PIXEL11 - PIXEL12_1 - break; - } - case 190: - { - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - PIXEL22_1D - } - else - { - PIXEL01_1 - PIXEL02_5 - PIXEL12_6 - PIXEL22_2 - } - PIXEL00_1M - PIXEL10_C - PIXEL11 - PIXEL20_1D - PIXEL21_1 - break; - } - case 187: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - PIXEL20_1D - } - else - { - PIXEL00_5 - PIXEL01_1 - PIXEL10_6 - PIXEL20_2 - } - PIXEL02_1M - PIXEL11 - PIXEL12_C - PIXEL21_1 - PIXEL22_1D - break; - } - case 243: - { - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL20_1L - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_1 - PIXEL20_2 - PIXEL21_6 - PIXEL22_5 - } - PIXEL00_1L - PIXEL01_C - PIXEL02_1M - PIXEL10_1 - PIXEL11 - break; - } - case 119: - { - if (Diff(w[2], w[6])) - { - PIXEL00_1L - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL00_2 - PIXEL01_6 - PIXEL02_5 - PIXEL12_1 - } - PIXEL10_1 - PIXEL11 - PIXEL20_1L - PIXEL21_C - PIXEL22_1M - break; - } - case 237: - case 233: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_2 - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_C - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1R - break; - } - case 175: - case 47: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1R - PIXEL10_C - PIXEL11 - PIXEL12_1 - PIXEL20_1D - PIXEL21_1 - PIXEL22_2 - break; - } - case 183: - case 151: - { - PIXEL00_1L - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_2 - PIXEL21_1 - PIXEL22_1D - break; - } - case 245: - case 244: - { - PIXEL00_2 - PIXEL01_1 - PIXEL02_1U - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1L - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_C - } - else - { - PIXEL22_2 - } - break; - } - case 250: - { - PIXEL00_1M - PIXEL01_C - PIXEL02_1M - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - } - else - { - PIXEL10_3 - PIXEL20_4 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL22_4 - } - break; - } - case 123: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - } - else - { - PIXEL00_4 - PIXEL01_3 - } - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 95: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL10_3 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL02_4 - PIXEL12_3 - } - PIXEL11 - PIXEL20_1M - PIXEL21_C - PIXEL22_1M - break; - } - case 222: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - } - else - { - PIXEL01_3 - PIXEL02_4 - } - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 252: - { - PIXEL00_1M - PIXEL01_1 - PIXEL02_1U - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - } - else - { - PIXEL10_3 - PIXEL20_4 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_C - } - else - { - PIXEL22_2 - } - break; - } - case 249: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1M - PIXEL10_C - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL20_C - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL22_4 - } - break; - } - case 235: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - } - else - { - PIXEL00_4 - PIXEL01_3 - } - PIXEL02_1M - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_C - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1R - break; - } - case 111: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1R - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 63: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL02_4 - PIXEL12_3 - } - PIXEL10_C - PIXEL11 - PIXEL20_1D - PIXEL21_1 - PIXEL22_1M - break; - } - case 159: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL10_3 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - } - else - { - PIXEL02_2 - } - PIXEL11 - PIXEL12_C - PIXEL20_1M - PIXEL21_1 - PIXEL22_1D - break; - } - case 215: - { - PIXEL00_1L - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 246: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - } - else - { - PIXEL01_3 - PIXEL02_4 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1L - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_C - } - else - { - PIXEL22_2 - } - break; - } - case 254: - { - PIXEL00_1M - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - } - else - { - PIXEL01_3 - PIXEL02_4 - } - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - } - else - { - PIXEL10_3 - PIXEL20_4 - } - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL21_3 - PIXEL22_2 - } - break; - } - case 253: - { - PIXEL00_1U - PIXEL01_1 - PIXEL02_1U - PIXEL10_C - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_C - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_C - } - else - { - PIXEL22_2 - } - break; - } - case 251: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - } - else - { - PIXEL00_4 - PIXEL01_3 - } - PIXEL02_1M - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL10_C - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL10_3 - PIXEL20_2 - PIXEL21_3 - } - if (Diff(w[6], w[8])) - { - PIXEL12_C - PIXEL22_C - } - else - { - PIXEL12_3 - PIXEL22_4 - } - break; - } - case 239: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - } - else - { - PIXEL00_2 - } - PIXEL01_C - PIXEL02_1R - PIXEL10_C - PIXEL11 - PIXEL12_1 - if (Diff(w[8], w[4])) - { - PIXEL20_C - } - else - { - PIXEL20_2 - } - PIXEL21_C - PIXEL22_1R - break; - } - case 127: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL01_C - PIXEL10_C - } - else - { - PIXEL00_2 - PIXEL01_3 - PIXEL10_3 - } - if (Diff(w[2], w[6])) - { - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL02_4 - PIXEL12_3 - } - PIXEL11 - if (Diff(w[8], w[4])) - { - PIXEL20_C - PIXEL21_C - } - else - { - PIXEL20_4 - PIXEL21_3 - } - PIXEL22_1M - break; - } - case 191: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - } - else - { - PIXEL02_2 - } - PIXEL10_C - PIXEL11 - PIXEL12_C - PIXEL20_1D - PIXEL21_1 - PIXEL22_1D - break; - } - case 223: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - PIXEL10_C - } - else - { - PIXEL00_4 - PIXEL10_3 - } - if (Diff(w[2], w[6])) - { - PIXEL01_C - PIXEL02_C - PIXEL12_C - } - else - { - PIXEL01_3 - PIXEL02_2 - PIXEL12_3 - } - PIXEL11 - PIXEL20_1M - if (Diff(w[6], w[8])) - { - PIXEL21_C - PIXEL22_C - } - else - { - PIXEL21_3 - PIXEL22_4 - } - break; - } - case 247: - { - PIXEL00_1L - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - } - else - { - PIXEL02_2 - } - PIXEL10_1 - PIXEL11 - PIXEL12_C - PIXEL20_1L - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_C - } - else - { - PIXEL22_2 - } - break; - } - case 255: - { - if (Diff(w[4], w[2])) - { - PIXEL00_C - } - else - { - PIXEL00_2 - } - PIXEL01_C - if (Diff(w[2], w[6])) - { - PIXEL02_C - } - else - { - PIXEL02_2 - } - PIXEL10_C - PIXEL11 - PIXEL12_C - if (Diff(w[8], w[4])) - { - PIXEL20_C - } - else - { - PIXEL20_2 - } - PIXEL21_C - if (Diff(w[6], w[8])) - { - PIXEL22_C - } - else - { - PIXEL22_2 - } - break; - } - } - pIn+=2; - pOut+=12; - } - pOut+=BpL; - pOut+=BpL; - } -} - -void InitLUTs(void) -{ - int i, j, k, r, g, b, Y, u, v; - - for (i=0; i<65536; i++) - LUT16to32[i] = ((i & 0xF800) << 8) + ((i & 0x07E0) << 5) + ((i & 0x001F) << 3); - - for (i=0; i<32; i++) - for (j=0; j<64; j++) - for (k=0; k<32; k++) - { - r = i << 3; - g = j << 2; - b = k << 3; - Y = (r + g + b) >> 2; - u = 128 + ((r - b) >> 2); - v = 128 + ((-r + 2*g -b)>>3); - RGBtoYUV[ (i << 11) + (j << 5) + k ] = (Y<<16) + (u<<8) + v; - } -} - -int main(int argc, char* argv[]) -{ - int nRes; - CImage ImageIn; - CImage ImageOut; - char * szFilenameIn; - char * szFilenameOut; - - if (argc <= 2) - { - printf("\nUsage: hq3x.exe input.bmp output.bmp\n"); - printf("supports .bmp and .tga formats\n"); - return 1; - } - - szFilenameIn = argv[1]; - szFilenameOut = argv[2]; - - if ( GetFileAttributes( szFilenameIn ) == -1 ) - { - printf( "ERROR: file '%s'\n not found", szFilenameIn ); - return 1; - } - - if ( ImageIn.Load( szFilenameIn ) != 0 ) - { - printf( "ERROR: can't load '%s'\n", szFilenameIn ); - return 1; - } - - if ( ImageIn.m_BitPerPixel != 16 ) - { - if ( ImageIn.ConvertTo16() != 0 ) - { - printf( "ERROR: '%s' conversion to 16 bit failed\n", szFilenameIn ); - return 1; - } - } - - printf( "\n%s is %ix%ix%i\n", szFilenameIn, ImageIn.m_Xres, ImageIn.m_Yres, ImageIn.m_BitPerPixel ); - - if ( ImageOut.Init( ImageIn.m_Xres*3, ImageIn.m_Yres*3, 32 ) != 0 ) - { - printf( "ERROR: ImageOut.Init()\n" ); - return 1; - }; - - InitLUTs(); - - hq3x_32( ImageIn.m_pBitmap, ImageOut.m_pBitmap, ImageIn.m_Xres, ImageIn.m_Yres, ImageOut.m_Xres*4 ); - - nRes = ImageOut.Save( szFilenameOut ); - if ( nRes != 0 ) - { - printf( "ERROR %i: ImageOut.Save(\"%s\")\n", nRes, szFilenameOut ); - return nRes; - } - printf( "%s is %ix%ix%i\n", szFilenameOut, ImageOut.m_Xres, ImageOut.m_Yres, ImageOut.m_BitPerPixel ); - - printf( "\nOK\n" ); - return 0; -} diff --git a/components/vampireimaging/Extras/Contrib/HqResampler/hq4x.cpp b/components/vampireimaging/Extras/Contrib/HqResampler/hq4x.cpp deleted file mode 100644 index 2c0a4e4..0000000 --- a/components/vampireimaging/Extras/Contrib/HqResampler/hq4x.cpp +++ /dev/null @@ -1,5379 +0,0 @@ -//hq4x filter demo program -//---------------------------------------------------------- -//Copyright (C) 2003 MaxSt ( maxst@hiend3d.com ) - -//This program is free software; you can redistribute it and/or -//modify it under the terms of the GNU Lesser General Public -//License as published by the Free Software Foundation; either -//version 2.1 of the License, or (at your option) any later version. -// -//This program is distributed in the hope that it will be useful, -//but WITHOUT ANY WARRANTY; without even the implied warranty of -//MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -//Lesser General Public License for more details. -// -//You should have received a copy of the GNU Lesser General Public -//License along with this program; if not, write to the Free Software -//Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -#include -#include -#include -#include -#include -#include "Image.h" - -static int LUT16to32[65536]; -static int RGBtoYUV[65536]; -static int YUV1, YUV2; -const int Ymask = 0x00FF0000; -const int Umask = 0x0000FF00; -const int Vmask = 0x000000FF; -const int trY = 0x00300000; -const int trU = 0x00000700; -const int trV = 0x00000006; - -inline void Interp1(unsigned char * pc, int c1, int c2) -{ - *((int*)pc) = (c1*3+c2) >> 2; -} - -inline void Interp2(unsigned char * pc, int c1, int c2, int c3) -{ - *((int*)pc) = (c1*2+c2+c3) >> 2; -} - -inline void Interp3(unsigned char * pc, int c1, int c2) -{ - //*((int*)pc) = (c1*7+c2)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*7 + (c2 & 0x00FF00) ) & 0x0007F800) + - (((c1 & 0xFF00FF)*7 + (c2 & 0xFF00FF) ) & 0x07F807F8)) >> 3; -} - -inline void Interp5(unsigned char * pc, int c1, int c2) -{ - *((int*)pc) = (c1+c2) >> 1; -} - -inline void Interp6(unsigned char * pc, int c1, int c2, int c3) -{ - //*((int*)pc) = (c1*5+c2*2+c3)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*5 + (c2 & 0x00FF00)*2 + (c3 & 0x00FF00) ) & 0x0007F800) + - (((c1 & 0xFF00FF)*5 + (c2 & 0xFF00FF)*2 + (c3 & 0xFF00FF) ) & 0x07F807F8)) >> 3; -} - -inline void Interp7(unsigned char * pc, int c1, int c2, int c3) -{ - //*((int*)pc) = (c1*6+c2+c3)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*6 + (c2 & 0x00FF00) + (c3 & 0x00FF00) ) & 0x0007F800) + - (((c1 & 0xFF00FF)*6 + (c2 & 0xFF00FF) + (c3 & 0xFF00FF) ) & 0x07F807F8)) >> 3; -} - -inline void Interp8(unsigned char * pc, int c1, int c2) -{ - //*((int*)pc) = (c1*5+c2*3)/8; - - *((int*)pc) = ((((c1 & 0x00FF00)*5 + (c2 & 0x00FF00)*3 ) & 0x0007F800) + - (((c1 & 0xFF00FF)*5 + (c2 & 0xFF00FF)*3 ) & 0x07F807F8)) >> 3; -} - -#define PIXEL00_0 *((int*)(pOut)) = c[5]; -#define PIXEL00_11 Interp1(pOut, c[5], c[4]); -#define PIXEL00_12 Interp1(pOut, c[5], c[2]); -#define PIXEL00_20 Interp2(pOut, c[5], c[2], c[4]); -#define PIXEL00_50 Interp5(pOut, c[2], c[4]); -#define PIXEL00_80 Interp8(pOut, c[5], c[1]); -#define PIXEL00_81 Interp8(pOut, c[5], c[4]); -#define PIXEL00_82 Interp8(pOut, c[5], c[2]); -#define PIXEL01_0 *((int*)(pOut+4)) = c[5]; -#define PIXEL01_10 Interp1(pOut+4, c[5], c[1]); -#define PIXEL01_12 Interp1(pOut+4, c[5], c[2]); -#define PIXEL01_14 Interp1(pOut+4, c[2], c[5]); -#define PIXEL01_21 Interp2(pOut+4, c[2], c[5], c[4]); -#define PIXEL01_31 Interp3(pOut+4, c[5], c[4]); -#define PIXEL01_50 Interp5(pOut+4, c[2], c[5]); -#define PIXEL01_60 Interp6(pOut+4, c[5], c[2], c[4]); -#define PIXEL01_61 Interp6(pOut+4, c[5], c[2], c[1]); -#define PIXEL01_82 Interp8(pOut+4, c[5], c[2]); -#define PIXEL01_83 Interp8(pOut+4, c[2], c[4]); -#define PIXEL02_0 *((int*)(pOut+8)) = c[5]; -#define PIXEL02_10 Interp1(pOut+8, c[5], c[3]); -#define PIXEL02_11 Interp1(pOut+8, c[5], c[2]); -#define PIXEL02_13 Interp1(pOut+8, c[2], c[5]); -#define PIXEL02_21 Interp2(pOut+8, c[2], c[5], c[6]); -#define PIXEL02_32 Interp3(pOut+8, c[5], c[6]); -#define PIXEL02_50 Interp5(pOut+8, c[2], c[5]); -#define PIXEL02_60 Interp6(pOut+8, c[5], c[2], c[6]); -#define PIXEL02_61 Interp6(pOut+8, c[5], c[2], c[3]); -#define PIXEL02_81 Interp8(pOut+8, c[5], c[2]); -#define PIXEL02_83 Interp8(pOut+8, c[2], c[6]); -#define PIXEL03_0 *((int*)(pOut+12)) = c[5]; -#define PIXEL03_11 Interp1(pOut+12, c[5], c[2]); -#define PIXEL03_12 Interp1(pOut+12, c[5], c[6]); -#define PIXEL03_20 Interp2(pOut+12, c[5], c[2], c[6]); -#define PIXEL03_50 Interp5(pOut+12, c[2], c[6]); -#define PIXEL03_80 Interp8(pOut+12, c[5], c[3]); -#define PIXEL03_81 Interp8(pOut+12, c[5], c[2]); -#define PIXEL03_82 Interp8(pOut+12, c[5], c[6]); -#define PIXEL10_0 *((int*)(pOut+BpL)) = c[5]; -#define PIXEL10_10 Interp1(pOut+BpL, c[5], c[1]); -#define PIXEL10_11 Interp1(pOut+BpL, c[5], c[4]); -#define PIXEL10_13 Interp1(pOut+BpL, c[4], c[5]); -#define PIXEL10_21 Interp2(pOut+BpL, c[4], c[5], c[2]); -#define PIXEL10_32 Interp3(pOut+BpL, c[5], c[2]); -#define PIXEL10_50 Interp5(pOut+BpL, c[4], c[5]); -#define PIXEL10_60 Interp6(pOut+BpL, c[5], c[4], c[2]); -#define PIXEL10_61 Interp6(pOut+BpL, c[5], c[4], c[1]); -#define PIXEL10_81 Interp8(pOut+BpL, c[5], c[4]); -#define PIXEL10_83 Interp8(pOut+BpL, c[4], c[2]); -#define PIXEL11_0 *((int*)(pOut+BpL+4)) = c[5]; -#define PIXEL11_30 Interp3(pOut+BpL+4, c[5], c[1]); -#define PIXEL11_31 Interp3(pOut+BpL+4, c[5], c[4]); -#define PIXEL11_32 Interp3(pOut+BpL+4, c[5], c[2]); -#define PIXEL11_70 Interp7(pOut+BpL+4, c[5], c[4], c[2]); -#define PIXEL12_0 *((int*)(pOut+BpL+8)) = c[5]; -#define PIXEL12_30 Interp3(pOut+BpL+8, c[5], c[3]); -#define PIXEL12_31 Interp3(pOut+BpL+8, c[5], c[2]); -#define PIXEL12_32 Interp3(pOut+BpL+8, c[5], c[6]); -#define PIXEL12_70 Interp7(pOut+BpL+8, c[5], c[6], c[2]); -#define PIXEL13_0 *((int*)(pOut+BpL+12)) = c[5]; -#define PIXEL13_10 Interp1(pOut+BpL+12, c[5], c[3]); -#define PIXEL13_12 Interp1(pOut+BpL+12, c[5], c[6]); -#define PIXEL13_14 Interp1(pOut+BpL+12, c[6], c[5]); -#define PIXEL13_21 Interp2(pOut+BpL+12, c[6], c[5], c[2]); -#define PIXEL13_31 Interp3(pOut+BpL+12, c[5], c[2]); -#define PIXEL13_50 Interp5(pOut+BpL+12, c[6], c[5]); -#define PIXEL13_60 Interp6(pOut+BpL+12, c[5], c[6], c[2]); -#define PIXEL13_61 Interp6(pOut+BpL+12, c[5], c[6], c[3]); -#define PIXEL13_82 Interp8(pOut+BpL+12, c[5], c[6]); -#define PIXEL13_83 Interp8(pOut+BpL+12, c[6], c[2]); -#define PIXEL20_0 *((int*)(pOut+BpL+BpL)) = c[5]; -#define PIXEL20_10 Interp1(pOut+BpL+BpL, c[5], c[7]); -#define PIXEL20_12 Interp1(pOut+BpL+BpL, c[5], c[4]); -#define PIXEL20_14 Interp1(pOut+BpL+BpL, c[4], c[5]); -#define PIXEL20_21 Interp2(pOut+BpL+BpL, c[4], c[5], c[8]); -#define PIXEL20_31 Interp3(pOut+BpL+BpL, c[5], c[8]); -#define PIXEL20_50 Interp5(pOut+BpL+BpL, c[4], c[5]); -#define PIXEL20_60 Interp6(pOut+BpL+BpL, c[5], c[4], c[8]); -#define PIXEL20_61 Interp6(pOut+BpL+BpL, c[5], c[4], c[7]); -#define PIXEL20_82 Interp8(pOut+BpL+BpL, c[5], c[4]); -#define PIXEL20_83 Interp8(pOut+BpL+BpL, c[4], c[8]); -#define PIXEL21_0 *((int*)(pOut+BpL+BpL+4)) = c[5]; -#define PIXEL21_30 Interp3(pOut+BpL+BpL+4, c[5], c[7]); -#define PIXEL21_31 Interp3(pOut+BpL+BpL+4, c[5], c[8]); -#define PIXEL21_32 Interp3(pOut+BpL+BpL+4, c[5], c[4]); -#define PIXEL21_70 Interp7(pOut+BpL+BpL+4, c[5], c[4], c[8]); -#define PIXEL22_0 *((int*)(pOut+BpL+BpL+8)) = c[5]; -#define PIXEL22_30 Interp3(pOut+BpL+BpL+8, c[5], c[9]); -#define PIXEL22_31 Interp3(pOut+BpL+BpL+8, c[5], c[6]); -#define PIXEL22_32 Interp3(pOut+BpL+BpL+8, c[5], c[8]); -#define PIXEL22_70 Interp7(pOut+BpL+BpL+8, c[5], c[6], c[8]); -#define PIXEL23_0 *((int*)(pOut+BpL+BpL+12)) = c[5]; -#define PIXEL23_10 Interp1(pOut+BpL+BpL+12, c[5], c[9]); -#define PIXEL23_11 Interp1(pOut+BpL+BpL+12, c[5], c[6]); -#define PIXEL23_13 Interp1(pOut+BpL+BpL+12, c[6], c[5]); -#define PIXEL23_21 Interp2(pOut+BpL+BpL+12, c[6], c[5], c[8]); -#define PIXEL23_32 Interp3(pOut+BpL+BpL+12, c[5], c[8]); -#define PIXEL23_50 Interp5(pOut+BpL+BpL+12, c[6], c[5]); -#define PIXEL23_60 Interp6(pOut+BpL+BpL+12, c[5], c[6], c[8]); -#define PIXEL23_61 Interp6(pOut+BpL+BpL+12, c[5], c[6], c[9]); -#define PIXEL23_81 Interp8(pOut+BpL+BpL+12, c[5], c[6]); -#define PIXEL23_83 Interp8(pOut+BpL+BpL+12, c[6], c[8]); -#define PIXEL30_0 *((int*)(pOut+BpL+BpL+BpL)) = c[5]; -#define PIXEL30_11 Interp1(pOut+BpL+BpL+BpL, c[5], c[8]); -#define PIXEL30_12 Interp1(pOut+BpL+BpL+BpL, c[5], c[4]); -#define PIXEL30_20 Interp2(pOut+BpL+BpL+BpL, c[5], c[8], c[4]); -#define PIXEL30_50 Interp5(pOut+BpL+BpL+BpL, c[8], c[4]); -#define PIXEL30_80 Interp8(pOut+BpL+BpL+BpL, c[5], c[7]); -#define PIXEL30_81 Interp8(pOut+BpL+BpL+BpL, c[5], c[8]); -#define PIXEL30_82 Interp8(pOut+BpL+BpL+BpL, c[5], c[4]); -#define PIXEL31_0 *((int*)(pOut+BpL+BpL+BpL+4)) = c[5]; -#define PIXEL31_10 Interp1(pOut+BpL+BpL+BpL+4, c[5], c[7]); -#define PIXEL31_11 Interp1(pOut+BpL+BpL+BpL+4, c[5], c[8]); -#define PIXEL31_13 Interp1(pOut+BpL+BpL+BpL+4, c[8], c[5]); -#define PIXEL31_21 Interp2(pOut+BpL+BpL+BpL+4, c[8], c[5], c[4]); -#define PIXEL31_32 Interp3(pOut+BpL+BpL+BpL+4, c[5], c[4]); -#define PIXEL31_50 Interp5(pOut+BpL+BpL+BpL+4, c[8], c[5]); -#define PIXEL31_60 Interp6(pOut+BpL+BpL+BpL+4, c[5], c[8], c[4]); -#define PIXEL31_61 Interp6(pOut+BpL+BpL+BpL+4, c[5], c[8], c[7]); -#define PIXEL31_81 Interp8(pOut+BpL+BpL+BpL+4, c[5], c[8]); -#define PIXEL31_83 Interp8(pOut+BpL+BpL+BpL+4, c[8], c[4]); -#define PIXEL32_0 *((int*)(pOut+BpL+BpL+BpL+8)) = c[5]; -#define PIXEL32_10 Interp1(pOut+BpL+BpL+BpL+8, c[5], c[9]); -#define PIXEL32_12 Interp1(pOut+BpL+BpL+BpL+8, c[5], c[8]); -#define PIXEL32_14 Interp1(pOut+BpL+BpL+BpL+8, c[8], c[5]); -#define PIXEL32_21 Interp2(pOut+BpL+BpL+BpL+8, c[8], c[5], c[6]); -#define PIXEL32_31 Interp3(pOut+BpL+BpL+BpL+8, c[5], c[6]); -#define PIXEL32_50 Interp5(pOut+BpL+BpL+BpL+8, c[8], c[5]); -#define PIXEL32_60 Interp6(pOut+BpL+BpL+BpL+8, c[5], c[8], c[6]); -#define PIXEL32_61 Interp6(pOut+BpL+BpL+BpL+8, c[5], c[8], c[9]); -#define PIXEL32_82 Interp8(pOut+BpL+BpL+BpL+8, c[5], c[8]); -#define PIXEL32_83 Interp8(pOut+BpL+BpL+BpL+8, c[8], c[6]); -#define PIXEL33_0 *((int*)(pOut+BpL+BpL+BpL+12)) = c[5]; -#define PIXEL33_11 Interp1(pOut+BpL+BpL+BpL+12, c[5], c[6]); -#define PIXEL33_12 Interp1(pOut+BpL+BpL+BpL+12, c[5], c[8]); -#define PIXEL33_20 Interp2(pOut+BpL+BpL+BpL+12, c[5], c[8], c[6]); -#define PIXEL33_50 Interp5(pOut+BpL+BpL+BpL+12, c[8], c[6]); -#define PIXEL33_80 Interp8(pOut+BpL+BpL+BpL+12, c[5], c[9]); -#define PIXEL33_81 Interp8(pOut+BpL+BpL+BpL+12, c[5], c[6]); -#define PIXEL33_82 Interp8(pOut+BpL+BpL+BpL+12, c[5], c[8]); - - - -inline bool Diff(unsigned int w1, unsigned int w2) -{ - YUV1 = RGBtoYUV[w1]; - YUV2 = RGBtoYUV[w2]; - return ( ( abs((YUV1 & Ymask) - (YUV2 & Ymask)) > trY ) || - ( abs((YUV1 & Umask) - (YUV2 & Umask)) > trU ) || - ( abs((YUV1 & Vmask) - (YUV2 & Vmask)) > trV ) ); -} - -void hq4x_32( unsigned char * pIn, unsigned char * pOut, int Xres, int Yres, int BpL ) -{ - int i, j, k; - int prevline, nextline; - int w[10]; - int c[10]; - - // +----+----+----+ - // | | | | - // | w1 | w2 | w3 | - // +----+----+----+ - // | | | | - // | w4 | w5 | w6 | - // +----+----+----+ - // | | | | - // | w7 | w8 | w9 | - // +----+----+----+ - - for (j=0; j0) prevline = -Xres*2; else prevline = 0; - if (j0) - { - w[1] = *((unsigned short*)(pIn + prevline - 2)); - w[4] = *((unsigned short*)(pIn - 2)); - w[7] = *((unsigned short*)(pIn + nextline - 2)); - } - else - { - w[1] = w[2]; - w[4] = w[5]; - w[7] = w[8]; - } - - if (i trY ) || - ( abs((YUV1 & Umask) - (YUV2 & Umask)) > trU ) || - ( abs((YUV1 & Vmask) - (YUV2 & Vmask)) > trV ) ) - pattern |= flag; - } - flag <<= 1; - } - - for (k=1; k<=9; k++) - c[k] = LUT16to32[w[k]]; - - switch (pattern) - { - case 0: - case 1: - case 4: - case 32: - case 128: - case 5: - case 132: - case 160: - case 33: - case 129: - case 36: - case 133: - case 164: - case 161: - case 37: - case 165: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_60 - PIXEL03_20 - PIXEL10_60 - PIXEL11_70 - PIXEL12_70 - PIXEL13_60 - PIXEL20_60 - PIXEL21_70 - PIXEL22_70 - PIXEL23_60 - PIXEL30_20 - PIXEL31_60 - PIXEL32_60 - PIXEL33_20 - break; - } - case 2: - case 34: - case 130: - case 162: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_61 - PIXEL11_30 - PIXEL12_30 - PIXEL13_61 - PIXEL20_60 - PIXEL21_70 - PIXEL22_70 - PIXEL23_60 - PIXEL30_20 - PIXEL31_60 - PIXEL32_60 - PIXEL33_20 - break; - } - case 16: - case 17: - case 48: - case 49: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_61 - PIXEL03_80 - PIXEL10_60 - PIXEL11_70 - PIXEL12_30 - PIXEL13_10 - PIXEL20_60 - PIXEL21_70 - PIXEL22_30 - PIXEL23_10 - PIXEL30_20 - PIXEL31_60 - PIXEL32_61 - PIXEL33_80 - break; - } - case 64: - case 65: - case 68: - case 69: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_60 - PIXEL03_20 - PIXEL10_60 - PIXEL11_70 - PIXEL12_70 - PIXEL13_60 - PIXEL20_61 - PIXEL21_30 - PIXEL22_30 - PIXEL23_61 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 8: - case 12: - case 136: - case 140: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_60 - PIXEL03_20 - PIXEL10_10 - PIXEL11_30 - PIXEL12_70 - PIXEL13_60 - PIXEL20_10 - PIXEL21_30 - PIXEL22_70 - PIXEL23_60 - PIXEL30_80 - PIXEL31_61 - PIXEL32_60 - PIXEL33_20 - break; - } - case 3: - case 35: - case 131: - case 163: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL10_81 - PIXEL11_31 - PIXEL12_30 - PIXEL13_61 - PIXEL20_60 - PIXEL21_70 - PIXEL22_70 - PIXEL23_60 - PIXEL30_20 - PIXEL31_60 - PIXEL32_60 - PIXEL33_20 - break; - } - case 6: - case 38: - case 134: - case 166: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_61 - PIXEL11_30 - PIXEL12_32 - PIXEL13_82 - PIXEL20_60 - PIXEL21_70 - PIXEL22_70 - PIXEL23_60 - PIXEL30_20 - PIXEL31_60 - PIXEL32_60 - PIXEL33_20 - break; - } - case 20: - case 21: - case 52: - case 53: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_81 - PIXEL03_81 - PIXEL10_60 - PIXEL11_70 - PIXEL12_31 - PIXEL13_31 - PIXEL20_60 - PIXEL21_70 - PIXEL22_30 - PIXEL23_10 - PIXEL30_20 - PIXEL31_60 - PIXEL32_61 - PIXEL33_80 - break; - } - case 144: - case 145: - case 176: - case 177: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_61 - PIXEL03_80 - PIXEL10_60 - PIXEL11_70 - PIXEL12_30 - PIXEL13_10 - PIXEL20_60 - PIXEL21_70 - PIXEL22_32 - PIXEL23_32 - PIXEL30_20 - PIXEL31_60 - PIXEL32_82 - PIXEL33_82 - break; - } - case 192: - case 193: - case 196: - case 197: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_60 - PIXEL03_20 - PIXEL10_60 - PIXEL11_70 - PIXEL12_70 - PIXEL13_60 - PIXEL20_61 - PIXEL21_30 - PIXEL22_31 - PIXEL23_81 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - break; - } - case 96: - case 97: - case 100: - case 101: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_60 - PIXEL03_20 - PIXEL10_60 - PIXEL11_70 - PIXEL12_70 - PIXEL13_60 - PIXEL20_82 - PIXEL21_32 - PIXEL22_30 - PIXEL23_61 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - break; - } - case 40: - case 44: - case 168: - case 172: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_60 - PIXEL03_20 - PIXEL10_10 - PIXEL11_30 - PIXEL12_70 - PIXEL13_60 - PIXEL20_31 - PIXEL21_31 - PIXEL22_70 - PIXEL23_60 - PIXEL30_81 - PIXEL31_81 - PIXEL32_60 - PIXEL33_20 - break; - } - case 9: - case 13: - case 137: - case 141: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_60 - PIXEL03_20 - PIXEL10_32 - PIXEL11_32 - PIXEL12_70 - PIXEL13_60 - PIXEL20_10 - PIXEL21_30 - PIXEL22_70 - PIXEL23_60 - PIXEL30_80 - PIXEL31_61 - PIXEL32_60 - PIXEL33_20 - break; - } - case 18: - case 50: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL12_0 - PIXEL13_50 - } - PIXEL10_61 - PIXEL11_30 - PIXEL20_60 - PIXEL21_70 - PIXEL22_30 - PIXEL23_10 - PIXEL30_20 - PIXEL31_60 - PIXEL32_61 - PIXEL33_80 - break; - } - case 80: - case 81: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_61 - PIXEL03_80 - PIXEL10_60 - PIXEL11_70 - PIXEL12_30 - PIXEL13_10 - PIXEL20_61 - PIXEL21_30 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 72: - case 76: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_60 - PIXEL03_20 - PIXEL10_10 - PIXEL11_30 - PIXEL12_70 - PIXEL13_60 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_50 - PIXEL21_0 - PIXEL30_50 - PIXEL31_50 - } - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 10: - case 138: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - PIXEL11_0 - } - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_61 - PIXEL20_10 - PIXEL21_30 - PIXEL22_70 - PIXEL23_60 - PIXEL30_80 - PIXEL31_61 - PIXEL32_60 - PIXEL33_20 - break; - } - case 66: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_61 - PIXEL11_30 - PIXEL12_30 - PIXEL13_61 - PIXEL20_61 - PIXEL21_30 - PIXEL22_30 - PIXEL23_61 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 24: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_61 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_61 - PIXEL32_61 - PIXEL33_80 - break; - } - case 7: - case 39: - case 135: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_32 - PIXEL03_82 - PIXEL10_81 - PIXEL11_31 - PIXEL12_32 - PIXEL13_82 - PIXEL20_60 - PIXEL21_70 - PIXEL22_70 - PIXEL23_60 - PIXEL30_20 - PIXEL31_60 - PIXEL32_60 - PIXEL33_20 - break; - } - case 148: - case 149: - case 180: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_81 - PIXEL03_81 - PIXEL10_60 - PIXEL11_70 - PIXEL12_31 - PIXEL13_31 - PIXEL20_60 - PIXEL21_70 - PIXEL22_32 - PIXEL23_32 - PIXEL30_20 - PIXEL31_60 - PIXEL32_82 - PIXEL33_82 - break; - } - case 224: - case 228: - case 225: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_60 - PIXEL03_20 - PIXEL10_60 - PIXEL11_70 - PIXEL12_70 - PIXEL13_60 - PIXEL20_82 - PIXEL21_32 - PIXEL22_31 - PIXEL23_81 - PIXEL30_82 - PIXEL31_32 - PIXEL32_31 - PIXEL33_81 - break; - } - case 41: - case 169: - case 45: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_60 - PIXEL03_20 - PIXEL10_32 - PIXEL11_32 - PIXEL12_70 - PIXEL13_60 - PIXEL20_31 - PIXEL21_31 - PIXEL22_70 - PIXEL23_60 - PIXEL30_81 - PIXEL31_81 - PIXEL32_60 - PIXEL33_20 - break; - } - case 22: - case 54: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_61 - PIXEL11_30 - PIXEL12_0 - PIXEL20_60 - PIXEL21_70 - PIXEL22_30 - PIXEL23_10 - PIXEL30_20 - PIXEL31_60 - PIXEL32_61 - PIXEL33_80 - break; - } - case 208: - case 209: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_61 - PIXEL03_80 - PIXEL10_60 - PIXEL11_70 - PIXEL12_30 - PIXEL13_10 - PIXEL20_61 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 104: - case 108: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_60 - PIXEL03_20 - PIXEL10_10 - PIXEL11_30 - PIXEL12_70 - PIXEL13_60 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 11: - case 139: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_61 - PIXEL20_10 - PIXEL21_30 - PIXEL22_70 - PIXEL23_60 - PIXEL30_80 - PIXEL31_61 - PIXEL32_60 - PIXEL33_20 - break; - } - case 19: - case 51: - { - if (Diff(w[2], w[6])) - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL00_12 - PIXEL01_14 - PIXEL02_83 - PIXEL03_50 - PIXEL12_70 - PIXEL13_21 - } - PIXEL10_81 - PIXEL11_31 - PIXEL20_60 - PIXEL21_70 - PIXEL22_30 - PIXEL23_10 - PIXEL30_20 - PIXEL31_60 - PIXEL32_61 - PIXEL33_80 - break; - } - case 146: - case 178: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - PIXEL23_32 - PIXEL33_82 - } - else - { - PIXEL02_21 - PIXEL03_50 - PIXEL12_70 - PIXEL13_83 - PIXEL23_13 - PIXEL33_11 - } - PIXEL10_61 - PIXEL11_30 - PIXEL20_60 - PIXEL21_70 - PIXEL22_32 - PIXEL30_20 - PIXEL31_60 - PIXEL32_82 - break; - } - case 84: - case 85: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_81 - if (Diff(w[6], w[8])) - { - PIXEL03_81 - PIXEL13_31 - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL03_12 - PIXEL13_14 - PIXEL22_70 - PIXEL23_83 - PIXEL32_21 - PIXEL33_50 - } - PIXEL10_60 - PIXEL11_70 - PIXEL12_31 - PIXEL20_61 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - break; - } - case 112: - case 113: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_61 - PIXEL03_80 - PIXEL10_60 - PIXEL11_70 - PIXEL12_30 - PIXEL13_10 - PIXEL20_82 - PIXEL21_32 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_70 - PIXEL23_21 - PIXEL30_11 - PIXEL31_13 - PIXEL32_83 - PIXEL33_50 - } - break; - } - case 200: - case 204: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_60 - PIXEL03_20 - PIXEL10_10 - PIXEL11_30 - PIXEL12_70 - PIXEL13_60 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - } - else - { - PIXEL20_21 - PIXEL21_70 - PIXEL30_50 - PIXEL31_83 - PIXEL32_14 - PIXEL33_12 - } - PIXEL22_31 - PIXEL23_81 - break; - } - case 73: - case 77: - { - if (Diff(w[8], w[4])) - { - PIXEL00_82 - PIXEL10_32 - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL00_11 - PIXEL10_13 - PIXEL20_83 - PIXEL21_70 - PIXEL30_50 - PIXEL31_21 - } - PIXEL01_82 - PIXEL02_60 - PIXEL03_20 - PIXEL11_32 - PIXEL12_70 - PIXEL13_60 - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 42: - case 170: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - PIXEL20_31 - PIXEL30_81 - } - else - { - PIXEL00_50 - PIXEL01_21 - PIXEL10_83 - PIXEL11_70 - PIXEL20_14 - PIXEL30_12 - } - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_61 - PIXEL21_31 - PIXEL22_70 - PIXEL23_60 - PIXEL31_81 - PIXEL32_60 - PIXEL33_20 - break; - } - case 14: - case 142: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_50 - PIXEL01_83 - PIXEL02_13 - PIXEL03_11 - PIXEL10_21 - PIXEL11_70 - } - PIXEL12_32 - PIXEL13_82 - PIXEL20_10 - PIXEL21_30 - PIXEL22_70 - PIXEL23_60 - PIXEL30_80 - PIXEL31_61 - PIXEL32_60 - PIXEL33_20 - break; - } - case 67: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL10_81 - PIXEL11_31 - PIXEL12_30 - PIXEL13_61 - PIXEL20_61 - PIXEL21_30 - PIXEL22_30 - PIXEL23_61 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 70: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_61 - PIXEL11_30 - PIXEL12_32 - PIXEL13_82 - PIXEL20_61 - PIXEL21_30 - PIXEL22_30 - PIXEL23_61 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 28: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_61 - PIXEL32_61 - PIXEL33_80 - break; - } - case 152: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_61 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 194: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_61 - PIXEL11_30 - PIXEL12_30 - PIXEL13_61 - PIXEL20_61 - PIXEL21_30 - PIXEL22_31 - PIXEL23_81 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - break; - } - case 98: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_61 - PIXEL11_30 - PIXEL12_30 - PIXEL13_61 - PIXEL20_82 - PIXEL21_32 - PIXEL22_30 - PIXEL23_61 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - break; - } - case 56: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_61 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 25: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_61 - PIXEL32_61 - PIXEL33_80 - break; - } - case 26: - case 31: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL11_0 - PIXEL12_0 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_61 - PIXEL32_61 - PIXEL33_80 - break; - } - case 82: - case 214: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_61 - PIXEL11_30 - PIXEL12_0 - PIXEL20_61 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 88: - case 248: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_61 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - break; - } - case 74: - case 107: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_61 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 27: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_61 - PIXEL32_61 - PIXEL33_80 - break; - } - case 86: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_61 - PIXEL11_30 - PIXEL12_0 - PIXEL20_61 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 216: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_61 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 106: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_61 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 30: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_10 - PIXEL11_30 - PIXEL12_0 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_61 - PIXEL32_61 - PIXEL33_80 - break; - } - case 210: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_61 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - PIXEL20_61 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 120: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_61 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 75: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_61 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_61 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 29: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_81 - PIXEL03_81 - PIXEL10_32 - PIXEL11_32 - PIXEL12_31 - PIXEL13_31 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_61 - PIXEL32_61 - PIXEL33_80 - break; - } - case 198: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_61 - PIXEL11_30 - PIXEL12_32 - PIXEL13_82 - PIXEL20_61 - PIXEL21_30 - PIXEL22_31 - PIXEL23_81 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - break; - } - case 184: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_61 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - PIXEL20_31 - PIXEL21_31 - PIXEL22_32 - PIXEL23_32 - PIXEL30_81 - PIXEL31_81 - PIXEL32_82 - PIXEL33_82 - break; - } - case 99: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL10_81 - PIXEL11_31 - PIXEL12_30 - PIXEL13_61 - PIXEL20_82 - PIXEL21_32 - PIXEL22_30 - PIXEL23_61 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - break; - } - case 57: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 71: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_32 - PIXEL03_82 - PIXEL10_81 - PIXEL11_31 - PIXEL12_32 - PIXEL13_82 - PIXEL20_61 - PIXEL21_30 - PIXEL22_30 - PIXEL23_61 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 156: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 226: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_61 - PIXEL11_30 - PIXEL12_30 - PIXEL13_61 - PIXEL20_82 - PIXEL21_32 - PIXEL22_31 - PIXEL23_81 - PIXEL30_82 - PIXEL31_32 - PIXEL32_31 - PIXEL33_81 - break; - } - case 60: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 195: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL10_81 - PIXEL11_31 - PIXEL12_30 - PIXEL13_61 - PIXEL20_61 - PIXEL21_30 - PIXEL22_31 - PIXEL23_81 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - break; - } - case 102: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_61 - PIXEL11_30 - PIXEL12_32 - PIXEL13_82 - PIXEL20_82 - PIXEL21_32 - PIXEL22_30 - PIXEL23_61 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - break; - } - case 153: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 58: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 83: - { - PIXEL00_81 - PIXEL01_31 - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL10_81 - PIXEL11_31 - PIXEL20_61 - PIXEL21_30 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 92: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 202: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_61 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - PIXEL22_31 - PIXEL23_81 - PIXEL32_31 - PIXEL33_81 - break; - } - case 78: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - PIXEL02_32 - PIXEL03_82 - PIXEL12_32 - PIXEL13_82 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 154: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 114: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL10_61 - PIXEL11_30 - PIXEL20_82 - PIXEL21_32 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - PIXEL30_82 - PIXEL31_32 - break; - } - case 89: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 90: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 55: - case 23: - { - if (Diff(w[2], w[6])) - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_0 - PIXEL03_0 - PIXEL12_0 - PIXEL13_0 - } - else - { - PIXEL00_12 - PIXEL01_14 - PIXEL02_83 - PIXEL03_50 - PIXEL12_70 - PIXEL13_21 - } - PIXEL10_81 - PIXEL11_31 - PIXEL20_60 - PIXEL21_70 - PIXEL22_30 - PIXEL23_10 - PIXEL30_20 - PIXEL31_60 - PIXEL32_61 - PIXEL33_80 - break; - } - case 182: - case 150: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL12_0 - PIXEL13_0 - PIXEL23_32 - PIXEL33_82 - } - else - { - PIXEL02_21 - PIXEL03_50 - PIXEL12_70 - PIXEL13_83 - PIXEL23_13 - PIXEL33_11 - } - PIXEL10_61 - PIXEL11_30 - PIXEL20_60 - PIXEL21_70 - PIXEL22_32 - PIXEL30_20 - PIXEL31_60 - PIXEL32_82 - break; - } - case 213: - case 212: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_81 - if (Diff(w[6], w[8])) - { - PIXEL03_81 - PIXEL13_31 - PIXEL22_0 - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL03_12 - PIXEL13_14 - PIXEL22_70 - PIXEL23_83 - PIXEL32_21 - PIXEL33_50 - } - PIXEL10_60 - PIXEL11_70 - PIXEL12_31 - PIXEL20_61 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - break; - } - case 241: - case 240: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_61 - PIXEL03_80 - PIXEL10_60 - PIXEL11_70 - PIXEL12_30 - PIXEL13_10 - PIXEL20_82 - PIXEL21_32 - if (Diff(w[6], w[8])) - { - PIXEL22_0 - PIXEL23_0 - PIXEL30_82 - PIXEL31_32 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL22_70 - PIXEL23_21 - PIXEL30_11 - PIXEL31_13 - PIXEL32_83 - PIXEL33_50 - } - break; - } - case 236: - case 232: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_60 - PIXEL03_20 - PIXEL10_10 - PIXEL11_30 - PIXEL12_70 - PIXEL13_60 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL21_0 - PIXEL30_0 - PIXEL31_0 - PIXEL32_31 - PIXEL33_81 - } - else - { - PIXEL20_21 - PIXEL21_70 - PIXEL30_50 - PIXEL31_83 - PIXEL32_14 - PIXEL33_12 - } - PIXEL22_31 - PIXEL23_81 - break; - } - case 109: - case 105: - { - if (Diff(w[8], w[4])) - { - PIXEL00_82 - PIXEL10_32 - PIXEL20_0 - PIXEL21_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL00_11 - PIXEL10_13 - PIXEL20_83 - PIXEL21_70 - PIXEL30_50 - PIXEL31_21 - } - PIXEL01_82 - PIXEL02_60 - PIXEL03_20 - PIXEL11_32 - PIXEL12_70 - PIXEL13_60 - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 171: - case 43: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - PIXEL11_0 - PIXEL20_31 - PIXEL30_81 - } - else - { - PIXEL00_50 - PIXEL01_21 - PIXEL10_83 - PIXEL11_70 - PIXEL20_14 - PIXEL30_12 - } - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_61 - PIXEL21_31 - PIXEL22_70 - PIXEL23_60 - PIXEL31_81 - PIXEL32_60 - PIXEL33_20 - break; - } - case 143: - case 15: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL02_32 - PIXEL03_82 - PIXEL10_0 - PIXEL11_0 - } - else - { - PIXEL00_50 - PIXEL01_83 - PIXEL02_13 - PIXEL03_11 - PIXEL10_21 - PIXEL11_70 - } - PIXEL12_32 - PIXEL13_82 - PIXEL20_10 - PIXEL21_30 - PIXEL22_70 - PIXEL23_60 - PIXEL30_80 - PIXEL31_61 - PIXEL32_60 - PIXEL33_20 - break; - } - case 124: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 203: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_61 - PIXEL20_10 - PIXEL21_30 - PIXEL22_31 - PIXEL23_81 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - break; - } - case 62: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_10 - PIXEL11_30 - PIXEL12_0 - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 211: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL10_81 - PIXEL11_31 - PIXEL12_30 - PIXEL13_10 - PIXEL20_61 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 118: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_61 - PIXEL11_30 - PIXEL12_0 - PIXEL20_82 - PIXEL21_32 - PIXEL22_30 - PIXEL23_10 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - break; - } - case 217: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 110: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_10 - PIXEL11_30 - PIXEL12_32 - PIXEL13_82 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 155: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 188: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - PIXEL20_31 - PIXEL21_31 - PIXEL22_32 - PIXEL23_32 - PIXEL30_81 - PIXEL31_81 - PIXEL32_82 - PIXEL33_82 - break; - } - case 185: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - PIXEL20_31 - PIXEL21_31 - PIXEL22_32 - PIXEL23_32 - PIXEL30_81 - PIXEL31_81 - PIXEL32_82 - PIXEL33_82 - break; - } - case 61: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_81 - PIXEL03_81 - PIXEL10_32 - PIXEL11_32 - PIXEL12_31 - PIXEL13_31 - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 157: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_81 - PIXEL03_81 - PIXEL10_32 - PIXEL11_32 - PIXEL12_31 - PIXEL13_31 - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 103: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_32 - PIXEL03_82 - PIXEL10_81 - PIXEL11_31 - PIXEL12_32 - PIXEL13_82 - PIXEL20_82 - PIXEL21_32 - PIXEL22_30 - PIXEL23_61 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - break; - } - case 227: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL10_81 - PIXEL11_31 - PIXEL12_30 - PIXEL13_61 - PIXEL20_82 - PIXEL21_32 - PIXEL22_31 - PIXEL23_81 - PIXEL30_82 - PIXEL31_32 - PIXEL32_31 - PIXEL33_81 - break; - } - case 230: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_61 - PIXEL11_30 - PIXEL12_32 - PIXEL13_82 - PIXEL20_82 - PIXEL21_32 - PIXEL22_31 - PIXEL23_81 - PIXEL30_82 - PIXEL31_32 - PIXEL32_31 - PIXEL33_81 - break; - } - case 199: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_32 - PIXEL03_82 - PIXEL10_81 - PIXEL11_31 - PIXEL12_32 - PIXEL13_82 - PIXEL20_61 - PIXEL21_30 - PIXEL22_31 - PIXEL23_81 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - break; - } - case 220: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - break; - } - case 158: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL12_0 - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 234: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_61 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_31 - PIXEL23_81 - PIXEL32_31 - PIXEL33_81 - break; - } - case 242: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL10_61 - PIXEL11_30 - PIXEL20_82 - PIXEL21_32 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_82 - PIXEL31_32 - break; - } - case 59: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL11_0 - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 121: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 87: - { - PIXEL00_81 - PIXEL01_31 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_81 - PIXEL11_31 - PIXEL12_0 - PIXEL20_61 - PIXEL21_30 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 79: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_32 - PIXEL03_82 - PIXEL11_0 - PIXEL12_32 - PIXEL13_82 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 122: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 94: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL12_0 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 218: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - break; - } - case 91: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL11_0 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 229: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_60 - PIXEL03_20 - PIXEL10_60 - PIXEL11_70 - PIXEL12_70 - PIXEL13_60 - PIXEL20_82 - PIXEL21_32 - PIXEL22_31 - PIXEL23_81 - PIXEL30_82 - PIXEL31_32 - PIXEL32_31 - PIXEL33_81 - break; - } - case 167: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_32 - PIXEL03_82 - PIXEL10_81 - PIXEL11_31 - PIXEL12_32 - PIXEL13_82 - PIXEL20_60 - PIXEL21_70 - PIXEL22_70 - PIXEL23_60 - PIXEL30_20 - PIXEL31_60 - PIXEL32_60 - PIXEL33_20 - break; - } - case 173: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_60 - PIXEL03_20 - PIXEL10_32 - PIXEL11_32 - PIXEL12_70 - PIXEL13_60 - PIXEL20_31 - PIXEL21_31 - PIXEL22_70 - PIXEL23_60 - PIXEL30_81 - PIXEL31_81 - PIXEL32_60 - PIXEL33_20 - break; - } - case 181: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_81 - PIXEL03_81 - PIXEL10_60 - PIXEL11_70 - PIXEL12_31 - PIXEL13_31 - PIXEL20_60 - PIXEL21_70 - PIXEL22_32 - PIXEL23_32 - PIXEL30_20 - PIXEL31_60 - PIXEL32_82 - PIXEL33_82 - break; - } - case 186: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL20_31 - PIXEL21_31 - PIXEL22_32 - PIXEL23_32 - PIXEL30_81 - PIXEL31_81 - PIXEL32_82 - PIXEL33_82 - break; - } - case 115: - { - PIXEL00_81 - PIXEL01_31 - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL10_81 - PIXEL11_31 - PIXEL20_82 - PIXEL21_32 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - PIXEL30_82 - PIXEL31_32 - break; - } - case 93: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_81 - PIXEL03_81 - PIXEL10_32 - PIXEL11_32 - PIXEL12_31 - PIXEL13_31 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - break; - } - case 206: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - PIXEL02_32 - PIXEL03_82 - PIXEL12_32 - PIXEL13_82 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - PIXEL22_31 - PIXEL23_81 - PIXEL32_31 - PIXEL33_81 - break; - } - case 205: - case 201: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_60 - PIXEL03_20 - PIXEL10_32 - PIXEL11_32 - PIXEL12_70 - PIXEL13_60 - if (Diff(w[8], w[4])) - { - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - } - else - { - PIXEL20_12 - PIXEL21_0 - PIXEL30_20 - PIXEL31_11 - } - PIXEL22_31 - PIXEL23_81 - PIXEL32_31 - PIXEL33_81 - break; - } - case 174: - case 46: - { - if (Diff(w[4], w[2])) - { - PIXEL00_80 - PIXEL01_10 - PIXEL10_10 - PIXEL11_30 - } - else - { - PIXEL00_20 - PIXEL01_12 - PIXEL10_11 - PIXEL11_0 - } - PIXEL02_32 - PIXEL03_82 - PIXEL12_32 - PIXEL13_82 - PIXEL20_31 - PIXEL21_31 - PIXEL22_70 - PIXEL23_60 - PIXEL30_81 - PIXEL31_81 - PIXEL32_60 - PIXEL33_20 - break; - } - case 179: - case 147: - { - PIXEL00_81 - PIXEL01_31 - if (Diff(w[2], w[6])) - { - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - } - else - { - PIXEL02_11 - PIXEL03_20 - PIXEL12_0 - PIXEL13_12 - } - PIXEL10_81 - PIXEL11_31 - PIXEL20_60 - PIXEL21_70 - PIXEL22_32 - PIXEL23_32 - PIXEL30_20 - PIXEL31_60 - PIXEL32_82 - PIXEL33_82 - break; - } - case 117: - case 116: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_81 - PIXEL03_81 - PIXEL10_60 - PIXEL11_70 - PIXEL12_31 - PIXEL13_31 - PIXEL20_82 - PIXEL21_32 - if (Diff(w[6], w[8])) - { - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - } - else - { - PIXEL22_0 - PIXEL23_11 - PIXEL32_12 - PIXEL33_20 - } - PIXEL30_82 - PIXEL31_32 - break; - } - case 189: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_81 - PIXEL03_81 - PIXEL10_32 - PIXEL11_32 - PIXEL12_31 - PIXEL13_31 - PIXEL20_31 - PIXEL21_31 - PIXEL22_32 - PIXEL23_32 - PIXEL30_81 - PIXEL31_81 - PIXEL32_82 - PIXEL33_82 - break; - } - case 231: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_32 - PIXEL03_82 - PIXEL10_81 - PIXEL11_31 - PIXEL12_32 - PIXEL13_82 - PIXEL20_82 - PIXEL21_32 - PIXEL22_31 - PIXEL23_81 - PIXEL30_82 - PIXEL31_32 - PIXEL32_31 - PIXEL33_81 - break; - } - case 126: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_10 - PIXEL11_30 - PIXEL12_0 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 219: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_10 - PIXEL20_10 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 125: - { - if (Diff(w[8], w[4])) - { - PIXEL00_82 - PIXEL10_32 - PIXEL20_0 - PIXEL21_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL00_11 - PIXEL10_13 - PIXEL20_83 - PIXEL21_70 - PIXEL30_50 - PIXEL31_21 - } - PIXEL01_82 - PIXEL02_81 - PIXEL03_81 - PIXEL11_32 - PIXEL12_31 - PIXEL13_31 - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 221: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_81 - if (Diff(w[6], w[8])) - { - PIXEL03_81 - PIXEL13_31 - PIXEL22_0 - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL03_12 - PIXEL13_14 - PIXEL22_70 - PIXEL23_83 - PIXEL32_21 - PIXEL33_50 - } - PIXEL10_32 - PIXEL11_32 - PIXEL12_31 - PIXEL20_10 - PIXEL21_30 - PIXEL30_80 - PIXEL31_10 - break; - } - case 207: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL02_32 - PIXEL03_82 - PIXEL10_0 - PIXEL11_0 - } - else - { - PIXEL00_50 - PIXEL01_83 - PIXEL02_13 - PIXEL03_11 - PIXEL10_21 - PIXEL11_70 - } - PIXEL12_32 - PIXEL13_82 - PIXEL20_10 - PIXEL21_30 - PIXEL22_31 - PIXEL23_81 - PIXEL30_80 - PIXEL31_10 - PIXEL32_31 - PIXEL33_81 - break; - } - case 238: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_32 - PIXEL03_82 - PIXEL10_10 - PIXEL11_30 - PIXEL12_32 - PIXEL13_82 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL21_0 - PIXEL30_0 - PIXEL31_0 - PIXEL32_31 - PIXEL33_81 - } - else - { - PIXEL20_21 - PIXEL21_70 - PIXEL30_50 - PIXEL31_83 - PIXEL32_14 - PIXEL33_12 - } - PIXEL22_31 - PIXEL23_81 - break; - } - case 190: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL12_0 - PIXEL13_0 - PIXEL23_32 - PIXEL33_82 - } - else - { - PIXEL02_21 - PIXEL03_50 - PIXEL12_70 - PIXEL13_83 - PIXEL23_13 - PIXEL33_11 - } - PIXEL10_10 - PIXEL11_30 - PIXEL20_31 - PIXEL21_31 - PIXEL22_32 - PIXEL30_81 - PIXEL31_81 - PIXEL32_82 - break; - } - case 187: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - PIXEL11_0 - PIXEL20_31 - PIXEL30_81 - } - else - { - PIXEL00_50 - PIXEL01_21 - PIXEL10_83 - PIXEL11_70 - PIXEL20_14 - PIXEL30_12 - } - PIXEL02_10 - PIXEL03_80 - PIXEL12_30 - PIXEL13_10 - PIXEL21_31 - PIXEL22_32 - PIXEL23_32 - PIXEL31_81 - PIXEL32_82 - PIXEL33_82 - break; - } - case 243: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_10 - PIXEL03_80 - PIXEL10_81 - PIXEL11_31 - PIXEL12_30 - PIXEL13_10 - PIXEL20_82 - PIXEL21_32 - if (Diff(w[6], w[8])) - { - PIXEL22_0 - PIXEL23_0 - PIXEL30_82 - PIXEL31_32 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL22_70 - PIXEL23_21 - PIXEL30_11 - PIXEL31_13 - PIXEL32_83 - PIXEL33_50 - } - break; - } - case 119: - { - if (Diff(w[2], w[6])) - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_0 - PIXEL03_0 - PIXEL12_0 - PIXEL13_0 - } - else - { - PIXEL00_12 - PIXEL01_14 - PIXEL02_83 - PIXEL03_50 - PIXEL12_70 - PIXEL13_21 - } - PIXEL10_81 - PIXEL11_31 - PIXEL20_82 - PIXEL21_32 - PIXEL22_30 - PIXEL23_10 - PIXEL30_82 - PIXEL31_32 - PIXEL32_10 - PIXEL33_80 - break; - } - case 237: - case 233: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_60 - PIXEL03_20 - PIXEL10_32 - PIXEL11_32 - PIXEL12_70 - PIXEL13_60 - PIXEL20_0 - PIXEL21_0 - PIXEL22_31 - PIXEL23_81 - if (Diff(w[8], w[4])) - { - PIXEL30_0 - } - else - { - PIXEL30_20 - } - PIXEL31_0 - PIXEL32_31 - PIXEL33_81 - break; - } - case 175: - case 47: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_0 - PIXEL02_32 - PIXEL03_82 - PIXEL10_0 - PIXEL11_0 - PIXEL12_32 - PIXEL13_82 - PIXEL20_31 - PIXEL21_31 - PIXEL22_70 - PIXEL23_60 - PIXEL30_81 - PIXEL31_81 - PIXEL32_60 - PIXEL33_20 - break; - } - case 183: - case 151: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_0 - if (Diff(w[2], w[6])) - { - PIXEL03_0 - } - else - { - PIXEL03_20 - } - PIXEL10_81 - PIXEL11_31 - PIXEL12_0 - PIXEL13_0 - PIXEL20_60 - PIXEL21_70 - PIXEL22_32 - PIXEL23_32 - PIXEL30_20 - PIXEL31_60 - PIXEL32_82 - PIXEL33_82 - break; - } - case 245: - case 244: - { - PIXEL00_20 - PIXEL01_60 - PIXEL02_81 - PIXEL03_81 - PIXEL10_60 - PIXEL11_70 - PIXEL12_31 - PIXEL13_31 - PIXEL20_82 - PIXEL21_32 - PIXEL22_0 - PIXEL23_0 - PIXEL30_82 - PIXEL31_32 - PIXEL32_0 - if (Diff(w[6], w[8])) - { - PIXEL33_0 - } - else - { - PIXEL33_20 - } - break; - } - case 250: - { - PIXEL00_80 - PIXEL01_10 - PIXEL02_10 - PIXEL03_80 - PIXEL10_10 - PIXEL11_30 - PIXEL12_30 - PIXEL13_10 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - break; - } - case 123: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_10 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 95: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL11_0 - PIXEL12_0 - PIXEL20_10 - PIXEL21_30 - PIXEL22_30 - PIXEL23_10 - PIXEL30_80 - PIXEL31_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 222: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_10 - PIXEL11_30 - PIXEL12_0 - PIXEL20_10 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 252: - { - PIXEL00_80 - PIXEL01_61 - PIXEL02_81 - PIXEL03_81 - PIXEL10_10 - PIXEL11_30 - PIXEL12_31 - PIXEL13_31 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_0 - PIXEL23_0 - PIXEL32_0 - if (Diff(w[6], w[8])) - { - PIXEL33_0 - } - else - { - PIXEL33_20 - } - break; - } - case 249: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_61 - PIXEL03_80 - PIXEL10_32 - PIXEL11_32 - PIXEL12_30 - PIXEL13_10 - PIXEL20_0 - PIXEL21_0 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - if (Diff(w[8], w[4])) - { - PIXEL30_0 - } - else - { - PIXEL30_20 - } - PIXEL31_0 - break; - } - case 235: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_61 - PIXEL20_0 - PIXEL21_0 - PIXEL22_31 - PIXEL23_81 - if (Diff(w[8], w[4])) - { - PIXEL30_0 - } - else - { - PIXEL30_20 - } - PIXEL31_0 - PIXEL32_31 - PIXEL33_81 - break; - } - case 111: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_0 - PIXEL02_32 - PIXEL03_82 - PIXEL10_0 - PIXEL11_0 - PIXEL12_32 - PIXEL13_82 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_61 - PIXEL32_10 - PIXEL33_80 - break; - } - case 63: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_0 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_0 - PIXEL11_0 - PIXEL12_0 - PIXEL20_31 - PIXEL21_31 - PIXEL22_30 - PIXEL23_10 - PIXEL30_81 - PIXEL31_81 - PIXEL32_61 - PIXEL33_80 - break; - } - case 159: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_0 - if (Diff(w[2], w[6])) - { - PIXEL03_0 - } - else - { - PIXEL03_20 - } - PIXEL11_0 - PIXEL12_0 - PIXEL13_0 - PIXEL20_10 - PIXEL21_30 - PIXEL22_32 - PIXEL23_32 - PIXEL30_80 - PIXEL31_61 - PIXEL32_82 - PIXEL33_82 - break; - } - case 215: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_0 - if (Diff(w[2], w[6])) - { - PIXEL03_0 - } - else - { - PIXEL03_20 - } - PIXEL10_81 - PIXEL11_31 - PIXEL12_0 - PIXEL13_0 - PIXEL20_61 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 246: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_61 - PIXEL11_30 - PIXEL12_0 - PIXEL20_82 - PIXEL21_32 - PIXEL22_0 - PIXEL23_0 - PIXEL30_82 - PIXEL31_32 - PIXEL32_0 - if (Diff(w[6], w[8])) - { - PIXEL33_0 - } - else - { - PIXEL33_20 - } - break; - } - case 254: - { - PIXEL00_80 - PIXEL01_10 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_10 - PIXEL11_30 - PIXEL12_0 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_0 - PIXEL23_0 - PIXEL32_0 - if (Diff(w[6], w[8])) - { - PIXEL33_0 - } - else - { - PIXEL33_20 - } - break; - } - case 253: - { - PIXEL00_82 - PIXEL01_82 - PIXEL02_81 - PIXEL03_81 - PIXEL10_32 - PIXEL11_32 - PIXEL12_31 - PIXEL13_31 - PIXEL20_0 - PIXEL21_0 - PIXEL22_0 - PIXEL23_0 - if (Diff(w[8], w[4])) - { - PIXEL30_0 - } - else - { - PIXEL30_20 - } - PIXEL31_0 - PIXEL32_0 - if (Diff(w[6], w[8])) - { - PIXEL33_0 - } - else - { - PIXEL33_20 - } - break; - } - case 251: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_10 - PIXEL03_80 - PIXEL11_0 - PIXEL12_30 - PIXEL13_10 - PIXEL20_0 - PIXEL21_0 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - if (Diff(w[8], w[4])) - { - PIXEL30_0 - } - else - { - PIXEL30_20 - } - PIXEL31_0 - break; - } - case 239: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_0 - PIXEL02_32 - PIXEL03_82 - PIXEL10_0 - PIXEL11_0 - PIXEL12_32 - PIXEL13_82 - PIXEL20_0 - PIXEL21_0 - PIXEL22_31 - PIXEL23_81 - if (Diff(w[8], w[4])) - { - PIXEL30_0 - } - else - { - PIXEL30_20 - } - PIXEL31_0 - PIXEL32_31 - PIXEL33_81 - break; - } - case 127: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_0 - if (Diff(w[2], w[6])) - { - PIXEL02_0 - PIXEL03_0 - PIXEL13_0 - } - else - { - PIXEL02_50 - PIXEL03_50 - PIXEL13_50 - } - PIXEL10_0 - PIXEL11_0 - PIXEL12_0 - if (Diff(w[8], w[4])) - { - PIXEL20_0 - PIXEL30_0 - PIXEL31_0 - } - else - { - PIXEL20_50 - PIXEL30_50 - PIXEL31_50 - } - PIXEL21_0 - PIXEL22_30 - PIXEL23_10 - PIXEL32_10 - PIXEL33_80 - break; - } - case 191: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_0 - PIXEL02_0 - if (Diff(w[2], w[6])) - { - PIXEL03_0 - } - else - { - PIXEL03_20 - } - PIXEL10_0 - PIXEL11_0 - PIXEL12_0 - PIXEL13_0 - PIXEL20_31 - PIXEL21_31 - PIXEL22_32 - PIXEL23_32 - PIXEL30_81 - PIXEL31_81 - PIXEL32_82 - PIXEL33_82 - break; - } - case 223: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - PIXEL01_0 - PIXEL10_0 - } - else - { - PIXEL00_50 - PIXEL01_50 - PIXEL10_50 - } - PIXEL02_0 - if (Diff(w[2], w[6])) - { - PIXEL03_0 - } - else - { - PIXEL03_20 - } - PIXEL11_0 - PIXEL12_0 - PIXEL13_0 - PIXEL20_10 - PIXEL21_30 - PIXEL22_0 - if (Diff(w[6], w[8])) - { - PIXEL23_0 - PIXEL32_0 - PIXEL33_0 - } - else - { - PIXEL23_50 - PIXEL32_50 - PIXEL33_50 - } - PIXEL30_80 - PIXEL31_10 - break; - } - case 247: - { - PIXEL00_81 - PIXEL01_31 - PIXEL02_0 - if (Diff(w[2], w[6])) - { - PIXEL03_0 - } - else - { - PIXEL03_20 - } - PIXEL10_81 - PIXEL11_31 - PIXEL12_0 - PIXEL13_0 - PIXEL20_82 - PIXEL21_32 - PIXEL22_0 - PIXEL23_0 - PIXEL30_82 - PIXEL31_32 - PIXEL32_0 - if (Diff(w[6], w[8])) - { - PIXEL33_0 - } - else - { - PIXEL33_20 - } - break; - } - case 255: - { - if (Diff(w[4], w[2])) - { - PIXEL00_0 - } - else - { - PIXEL00_20 - } - PIXEL01_0 - PIXEL02_0 - if (Diff(w[2], w[6])) - { - PIXEL03_0 - } - else - { - PIXEL03_20 - } - PIXEL10_0 - PIXEL11_0 - PIXEL12_0 - PIXEL13_0 - PIXEL20_0 - PIXEL21_0 - PIXEL22_0 - PIXEL23_0 - if (Diff(w[8], w[4])) - { - PIXEL30_0 - } - else - { - PIXEL30_20 - } - PIXEL31_0 - PIXEL32_0 - if (Diff(w[6], w[8])) - { - PIXEL33_0 - } - else - { - PIXEL33_20 - } - break; - } - } - pIn+=2; - pOut+=16; - } - pOut+=BpL; - pOut+=BpL; - pOut+=BpL; - } -} - -void InitLUTs(void) -{ - int i, j, k, r, g, b, Y, u, v; - - for (i=0; i<65536; i++) - LUT16to32[i] = ((i & 0xF800) << 8) + ((i & 0x07E0) << 5) + ((i & 0x001F) << 3); - - for (i=0; i<32; i++) - for (j=0; j<64; j++) - for (k=0; k<32; k++) - { - r = i << 3; - g = j << 2; - b = k << 3; - Y = (r + g + b) >> 2; - u = 128 + ((r - b) >> 2); - v = 128 + ((-r + 2*g -b)>>3); - RGBtoYUV[ (i << 11) + (j << 5) + k ] = (Y<<16) + (u<<8) + v; - } -} - -int main(int argc, char* argv[]) -{ - int nRes; - CImage ImageIn; - CImage ImageOut; - char * szFilenameIn; - char * szFilenameOut; - - if (argc <= 2) - { - printf("\nUsage: hq4x.exe input.bmp output.bmp\n"); - printf("supports .bmp and .tga formats\n"); - return 1; - } - - szFilenameIn = argv[1]; - szFilenameOut = argv[2]; - - if ( GetFileAttributes( szFilenameIn ) == -1 ) - { - printf( "ERROR: file '%s'\n not found", szFilenameIn ); - return 1; - } - - if ( ImageIn.Load( szFilenameIn ) != 0 ) - { - printf( "ERROR: can't load '%s'\n", szFilenameIn ); - return 1; - } - - if ( ImageIn.m_BitPerPixel != 16 ) - { - if ( ImageIn.ConvertTo16() != 0 ) - { - printf( "ERROR: '%s' conversion to 16 bit failed\n", szFilenameIn ); - return 1; - } - } - - printf( "\n%s is %ix%ix%i\n", szFilenameIn, ImageIn.m_Xres, ImageIn.m_Yres, ImageIn.m_BitPerPixel ); - - if ( ImageOut.Init( ImageIn.m_Xres*4, ImageIn.m_Yres*4, 32 ) != 0 ) - { - printf( "ERROR: ImageOut.Init()\n" ); - return 1; - }; - - InitLUTs(); - - hq4x_32( ImageIn.m_pBitmap, ImageOut.m_pBitmap, ImageIn.m_Xres, ImageIn.m_Yres, ImageOut.m_Xres*4 ); - - nRes = ImageOut.Save( szFilenameOut ); - if ( nRes != 0 ) - { - printf( "ERROR %i: ImageOut.Save(\"%s\")\n", nRes, szFilenameOut ); - return nRes; - } - printf( "%s is %ix%ix%i\n", szFilenameOut, ImageOut.m_Xres, ImageOut.m_Yres, ImageOut.m_BitPerPixel ); - - printf( "\nOK\n" ); - return 0; -} diff --git a/components/vampireimaging/Extras/Contrib/ImagingNif.pas b/components/vampireimaging/Extras/Contrib/ImagingNif.pas deleted file mode 100644 index 044531f..0000000 --- a/components/vampireimaging/Extras/Contrib/ImagingNif.pas +++ /dev/null @@ -1,106 +0,0 @@ -{ - This unit contains image format loader for textures in NIF model files. - Works for NIF version 3 (StarTrek Bridge Commander, ...). - Author: Delfi -} - -unit ImagingNIF; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -type - { Class for loading and saving NIF images. It can load 24 bit RGB and 32 bit RGBA images} - TNIFFileFormat = class(TImageFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SNIFFormatName = 'NetImmerse Image'; - SNIFMasks = '*.nif'; - -type - { NIF file header.} - TNIFHeader = packed record - Width: LongWord; - Height: LongWord; - PixelFmt: LongWord; - end; - -{ TNIFFileFormat class implementation } - -procedure TNIFFileFormat.Define; -begin - inherited; - FName := SNIFFormatName; - FFeatures := [ffLoad]; - - AddMasks(SNIFMasks); -end; - -function TNIFFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TNIFHeader; - FmtInfo: TImageFormatInfo; -begin - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Read NIF header - - Seek(Handle, 170, smFromBeginning); - - Read(Handle, @Hdr.Width, SizeOf(Hdr.Width)); - Read(Handle, @Hdr.Height, SizeOf(Hdr.Height)); - Read(Handle, @Hdr.PixelFmt, SizeOf(Hdr.PixelFmt)); - - Seek(Handle, 182, smFromBeginning); - - // Determine image format - Format := ifR8G8B8; - - if Hdr.PixelFmt = 2 then - Format := ifA8R8G8B8; - - NewImage(Hdr.Width, Hdr.Height, Format, Images[0]); - FmtInfo := GetFormatInfo(Format); - - Read(Handle, Bits, Size); - - SwapChannels(Images[0], ChannelRed, ChannelBlue); - - Result := True; - end; -end; - -function TNIFFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: longword; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - if Hdr = 1232364878 then Result := True; - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - end; -end; - -initialization - RegisterImageFileFormat(TNIFFileFormat); - -end. - diff --git a/components/vampireimaging/Extras/Demos/ClippingTest/ClipForm.dfm b/components/vampireimaging/Extras/Demos/ClippingTest/ClipForm.dfm deleted file mode 100644 index 0c0e0ad..0000000 --- a/components/vampireimaging/Extras/Demos/ClippingTest/ClipForm.dfm +++ /dev/null @@ -1,151 +0,0 @@ -object MainForm: TMainForm - Left = 108 - Top = 118 - BorderIcons = [biSystemMenu] - BorderStyle = bsSingle - Caption = 'Clipping Test' - ClientHeight = 652 - ClientWidth = 1036 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - Position = poScreenCenter - OnCreate = FormCreate - OnDestroy = FormDestroy - PixelsPerInch = 96 - TextHeight = 13 - object PanelConf: TPanel - Left = 0 - Top = 0 - Width = 1036 - Height = 497 - Align = alTop - Color = clSkyBlue - DragCursor = crDefault - TabOrder = 0 - object ImageDst: TImage - Left = 494 - Top = 80 - Width = 450 - Height = 337 - DragCursor = crDefault - Proportional = True - end - object ClipDst: TJvMovableBevel - Left = 592 - Top = 136 - Width = 329 - Height = 241 - Hint = 'Dest Clip Rect' - ParentShowHint = False - Shape = bsFrame - ShowHint = True - Style = bsRaised - BorderSize = 5 - end - object ImageSrc: TImage - Left = 64 - Top = 120 - Width = 300 - Height = 225 - DragCursor = crDefault - Proportional = True - end - object SelDst: TJvMovableBevel - Left = 568 - Top = 208 - Width = 265 - Height = 97 - Hint = 'Dest Selection' - ParentShowHint = False - Shape = bsFrame - ShowHint = True - Style = bsRaised - end - object SelSrc: TJvMovableBevel - Left = 128 - Top = 176 - Width = 177 - Height = 97 - Hint = 'Source Selection' - ParentShowHint = False - Shape = bsFrame - ShowHint = True - Style = bsRaised - end - end - object PanelCmd: TPanel - Left = 0 - Top = 497 - Width = 1036 - Height = 155 - Align = alClient - TabOrder = 1 - object Button1: TButton - Left = 424 - Top = 16 - Width = 137 - Height = 25 - Caption = 'Reset Copy Selections' - TabOrder = 0 - OnClick = Button1Click - end - object Button2: TButton - Left = 424 - Top = 47 - Width = 137 - Height = 25 - Caption = 'Reset Stretch Selections' - TabOrder = 1 - OnClick = Button2Click - end - object Button3: TButton - Left = 344 - Top = 96 - Width = 145 - Height = 25 - Caption = 'CopyRect Test' - TabOrder = 2 - OnClick = Button3Click - end - object Button4: TButton - Left = 512 - Top = 96 - Width = 145 - Height = 25 - Caption = 'StretchRect Test' - TabOrder = 3 - OnClick = Button4Click - end - object Button5: TButton - Left = 344 - Top = 127 - Width = 145 - Height = 25 - Caption = 'Canvas.Draw Test' - TabOrder = 4 - OnClick = Button5Click - end - object Button6: TButton - Left = 512 - Top = 127 - Width = 145 - Height = 25 - Caption = 'Canvas.StretchDraw Test' - TabOrder = 5 - OnClick = Button6Click - end - object CheckGenCanvas: TCheckBox - Left = 704 - Top = 24 - Width = 209 - Height = 17 - Caption = 'Force generic canvas class' - TabOrder = 6 - end - end -end diff --git a/components/vampireimaging/Extras/Demos/ClippingTest/ClipForm.pas b/components/vampireimaging/Extras/Demos/ClippingTest/ClipForm.pas deleted file mode 100644 index 125bb2a..0000000 --- a/components/vampireimaging/Extras/Demos/ClippingTest/ClipForm.pas +++ /dev/null @@ -1,289 +0,0 @@ -{ - - Clipping Demo - Vampyre Imaging Library - http://imaginglib.sourceforge.net - - I used this demo during fixing of clipping for CopyRect/StretchRect functions. - You have a source and destination images on the form and few movable and - resizable bevels that represent source, destnation, and clipping rectangle. - Fiddle with them as you want and then click CopyRect Test or StretchRect Test - button. New form will be shown with results. One image created by - Imaging's Copy/Stretch rect functions (wrapped in TBaseImage here) - and the second created by WinAPI's BitBlt and StretchBlt functions. - Copied images should look exactly the same and stretched ones should - have the same clipping and very similar looks (Imaging's stretch is filtered, - WinAPI's not). - - Demo shows usage of high level Imaging classes (TBaseImage->TSingleImage) - and VCL component support (TImagingBitmap). Needs JVCL library to compile. - -} -unit ClipForm; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ExtCtrls, JvExExtCtrls, JvMovableBevel, StdCtrls, Buttons, - ImagingTypes, - Imaging, - ImagingClasses, - ImagingComponents, - ImagingCanvases, - ImagingFormats, - ImagingUtility; - -type - TMainForm = class(TForm) - PanelConf: TPanel; - ImageSrc: TImage; - ImageDst: TImage; - SelDst: TJvMovableBevel; - SelSrc: TJvMovableBevel; - PanelCmd: TPanel; - Button1: TButton; - Button2: TButton; - Button3: TButton; - Button4: TButton; - ClipDst: TJvMovableBevel; - Button5: TButton; - Button6: TButton; - CheckGenCanvas: TCheckBox; - procedure BtnLoadImagesClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure Button1Click(Sender: TObject); - procedure Button2Click(Sender: TObject); - procedure Button3Click(Sender: TObject); - procedure Button4Click(Sender: TObject); - procedure Button5Click(Sender: TObject); - procedure Button6Click(Sender: TObject); - public - SrcImage, DstImage: TSingleImage; - SrcBitmap, DstBitmap: TImagingBitmap; - procedure DoTest(Stretch, CanvasDraw: Boolean); - end; - -const - DefaultSrc = 'Vezyr.png'; - DefaultDst = 'Tigers.jpg'; - ForceFormat = ifA8R8G8B8; - -var - MainForm: TMainForm; - -implementation - -uses - ResultsForm; - -{$R *.dfm} - -function GetTestImage(const FileName: string): string; -begin - Result := ExtractFileDir(ExtractFileDir(ExtractFileDir(GetAppDir))) + - PathDelim + 'Demos' + PathDelim + 'Data' + PathDelim + FileName; -end; - -procedure TMainForm.FormCreate(Sender: TObject); -begin - // Create working images - SrcImage := TSingleImage.Create; - DstImage := TSingleImage.Create; - // Create our bitmaps which will be assigned to TImage components. - // Standard TBitmap could be used but our bitmaps can be assigned directly - // from TSingleImage. - SrcBitmap := TImagingBitmap.Create; - DstBitmap := TImagingBitmap.Create; - - ImageSrc.Picture.Graphic := SrcBitmap; - ImageDst.Picture.Graphic := DstBitmap; - - BtnLoadImagesClick(Self); -end; - -procedure TMainForm.FormDestroy(Sender: TObject); -begin - // Free used images - SrcImage.Free; - DstImage.Free; - // Free bitmaps asigned to TImage too - it wont free them automatically - SrcBitmap.Free; - DstBitmap.Free; -end; - -procedure TMainForm.BtnLoadImagesClick(Sender: TObject); -begin - // Load test images - SrcImage.LoadFromFile(GetTestImage(DefaultSrc)); - DstImage.LoadFromFile(GetTestImage(DefaultDst)); - // Change their format to A8R8G8B8 (for faster drawing later) - SrcImage.Format := ForceFormat; - DstImage.Format := ForceFormat; - // Resize them to fit in TImages on form - SrcImage.Resize(ImageSrc.Width, ImageSrc.Height, rfNearest); - DstImage.Resize(ImageDst.Width, ImageDst.Height, rfNearest); - // Finally assign them to those TImages - ImageSrc.Picture.Graphic.Assign(SrcImage); - ImageDst.Picture.Graphic.Assign(DstImage); -end; - -procedure TMainForm.Button1Click(Sender: TObject); -begin - SelSrc.SetBounds(ImageSrc.Left, ImageSrc.Top, ImageSrc.Width, ImageSrc.Height); - SelDst.SetBounds(ImageDst.Left, ImageDst.Top, ImageSrc.Width, ImageSrc.Height); - ClipDst.SetBounds(ImageDst.Left - 20, ImageDst.Top - 20, ImageDst.Width + 40, ImageDst.Height + 40); -end; - -procedure TMainForm.Button2Click(Sender: TObject); -begin - SelSrc.SetBounds(ImageSrc.Left, ImageSrc.Top, ImageSrc.Width, ImageSrc.Height); - SelDst.SetBounds(ImageDst.Left, ImageDst.Top, ImageDst.Width, ImageDst.Height); - ClipDst.SetBounds(ImageDst.Left - 20, ImageDst.Top - 20, ImageDst.Width + 40, ImageDst.Height + 40); -end; - -procedure TMainForm.Button3Click(Sender: TObject); -begin - DoTest(False, False); -end; - -procedure TMainForm.Button4Click(Sender: TObject); -begin - DoTest(True, False); -end; - -procedure TMainForm.Button5Click(Sender: TObject); -begin - DoTest(False, True); -end; - -procedure TMainForm.Button6Click(Sender: TObject); -begin - DoTest(True, True); -end; - -procedure TMainForm.DoTest(Stretch, CanvasDraw: Boolean); -var - Result: TSingleImage; - SrcBounds, DstBounds, DstClip: TRect; - SrcBmp, DstBmp: TImagingBitmap; - Rgn: HRGN; - SrcCanvas, DestCanvas: TImagingCanvas; -begin - // First use Imaging to copy/stretch images ---------------- - - // Create result image and get rects from movable bevels on the form - Result := TSingleImage.CreateFromImage(DstImage); - SrcBounds := Rect(SelSrc.Left - ImageSrc.Left, SelSrc.Top - ImageSrc.Top, - SelSrc.Width, SelSrc.Height); - DstBounds := Rect(SelDst.Left - ImageDst.Left, SelDst.Top - ImageDst.Top, - SelDst.Width, SelDst.Height); - DstClip := Rect(ClipDst.Left - ImageDst.Left, ClipDst.Top - ImageDst.Top, - ClipDst.Left - ImageDst.Left + ClipDst.Width, ClipDst.Top - ImageDst.Top + ClipDst.Height); - - if not CanvasDraw then - begin - if Stretch then - begin - // Clips rects for stretching - ImagingUtility.ClipStretchBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, SrcImage.Width, SrcImage.Height, DstClip); - // Call image's stretch method - SrcImage.StretchTo(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - Result, DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, rfBilinear); - end - else - begin - // Clips rects for copying - ImagingUtility.ClipCopyBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - DstBounds.Left, DstBounds.Top, SrcImage.Width, SrcImage.Height, DstClip); - // Call image's copy method - SrcImage.CopyTo(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - Result, DstBounds.Left, DstBounds.Top); - end; - end - else - begin - if CheckGenCanvas.Checked then - begin - SrcCanvas := TImagingCanvas.CreateForImage(SrcImage); - DestCanvas := TImagingCanvas.CreateForImage(Result); - end - else - begin - SrcCanvas := FindBestCanvasForImage(SrcImage).CreateForImage(SrcImage); - DestCanvas := FindBestCanvasForImage(Result).CreateForImage(Result); - end; - - if Stretch then - begin - // Clips rects for stretching - ImagingUtility.ClipStretchBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, SrcImage.Width, SrcImage.Height, DstClip); - // Call stretch method - SrcCanvas.StretchDrawAlpha(Rect(SrcBounds.Left, SrcBounds.Top, SrcBounds.Left + SrcBounds.Right, SrcBounds.Top + SrcBounds.Bottom), - DestCanvas, Rect(DstBounds.Left, DstBounds.Top, DstBounds.Left + DstBounds.Right, DstBounds.Top + DstBounds.Bottom), - rfBilinear); - end - else - begin - // Clips rects for copying - ImagingUtility.ClipCopyBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - DstBounds.Left, DstBounds.Top, SrcImage.Width, SrcImage.Height, DstClip); - // Call draw method - SrcCanvas.DrawAlpha(Rect(SrcBounds.Left, SrcBounds.Top, SrcBounds.Left + SrcBounds.Right, SrcBounds.Top + SrcBounds.Bottom), - DestCanvas, DstBounds.Left, DstBounds.Top); - end; - - SrcCanvas.Free; - DestCanvas.Free; - end; - - // Assign Imaging result to TImage on Result form - ResultForm.ImageMy.Picture.Graphic.Assign(Result); - - // Now use WinAPI to copy/stretch images ---------------------- - - // Create bitmaps and assign source and dest images to them - SrcBmp := TImagingBitmap.Create; - SrcBmp.Assign(SrcImage); - DstBmp := TImagingBitmap.Create; - DstBmp.Assign(DstImage); - - // Get fresh bounds - SrcBounds := Rect(SelSrc.Left - ImageSrc.Left, SelSrc.Top - ImageSrc.Top, - SelSrc.Width, SelSrc.Height); - DstBounds := Rect(SelDst.Left - ImageDst.Left, SelDst.Top - ImageDst.Top, - SelDst.Width, SelDst.Height); - - // Now create and set clipping region - Rgn := CreateRectRgn(DstClip.Left, DstClip.Top, DstClip.Right, DstClip.Bottom); - SelectClipRgn(DstBmp.Canvas.Handle, Rgn); - - // Now stretch or copy - if Stretch then - begin - StretchBlt(DstBmp.Canvas.Handle, DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, - SrcBmp.Canvas.Handle, SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, SRCCOPY); - end - else - begin - BitBlt(DstBmp.Canvas.Handle, DstBounds.Left, DstBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - SrcBmp.Canvas.Handle, SrcBounds.Left, SrcBounds.Top, SRCCOPY); - end; - - // Assign Imaging result to TImage on Result form - ResultForm.ImageWin.Picture.Graphic.Assign(DstBmp); - - Result.Free; - SrcBmp.Free; - DstBmp.Free; - //SelectClipRgn(DstBmp.Canvas.Handle, 0); - //DeleteObject(Rgn); - - // Show results - ResultForm.ShowModal; -end; - -end. diff --git a/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.dpr b/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.dpr deleted file mode 100644 index 8327548..0000000 --- a/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.dpr +++ /dev/null @@ -1,15 +0,0 @@ -program ClippingTest; - -uses - Forms, - ClipForm in 'ClipForm.pas' {MainForm}, - ResultsForm in 'ResultsForm.pas' {ResultForm}; - -{$R *.res} - -begin - Application.Initialize; - Application.CreateForm(TMainForm, MainForm); - Application.CreateForm(TResultForm, ResultForm); - Application.Run; -end. diff --git a/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.dproj b/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.dproj deleted file mode 100644 index 6164260..0000000 --- a/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.dproj +++ /dev/null @@ -1,112 +0,0 @@ - - - {ea1f2d8b-15cd-407b-b39e-2708f355dee0} - ClippingTest.dpr - Debug - AnyCPU - DCC32 - ClippingTest.exe - 12.0 - Debug - - - true - - - true - Base - true - - - true - Base - true - - - DONT_LINK_TIFF;$(DCC_Define) - ..\..\..\Source;..\..\..\Source\ZLib;..\..\..\Source\JpegLib;..\..\..\Extras\Extensions;$(DCC_UnitSearchPath) - ClippingTest.exe - - - 7.0 - False - False - False - True - 0 - RELEASE;$(DCC_Define) - - - 7.0 - False - True - DEBUG;$(DCC_Define) - - - Delphi.Personality.12 - - - - - False - True - False - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1029 - 1250 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - ClippingTest.dpr - - - - 12 - - - - MainSource - - -
    MainForm
    -     - -
    ResultForm
    -     - - Base - - - Cfg_2 - Base - - - Cfg_1 - Base - -     - -     diff --git a/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.res b/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.res deleted file mode 100644 index 9946d07..0000000 Binary files a/components/vampireimaging/Extras/Demos/ClippingTest/ClippingTest.res and /dev/null differ diff --git a/components/vampireimaging/Extras/Demos/ClippingTest/ResultsForm.dfm b/components/vampireimaging/Extras/Demos/ClippingTest/ResultsForm.dfm deleted file mode 100644 index b4238b3..0000000 --- a/components/vampireimaging/Extras/Demos/ClippingTest/ResultsForm.dfm +++ /dev/null @@ -1,53 +0,0 @@ -object ResultForm: TResultForm - Left = 86 - Top = 156 - BorderStyle = bsToolWindow - Caption = 'Results' - ClientHeight = 388 - ClientWidth = 994 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - Position = poMainFormCenter - OnCreate = FormCreate - OnDestroy = FormDestroy - OnMouseDown = FormMouseDown - PixelsPerInch = 96 - TextHeight = 13 - object ImageMy: TImage - Left = 30 - Top = 35 - Width = 450 - Height = 337 - DragCursor = crDefault - Proportional = True - OnMouseDown = ImageMyMouseDown - end - object ImageWin: TImage - Left = 510 - Top = 35 - Width = 450 - Height = 337 - DragCursor = crDefault - Proportional = True - OnMouseDown = ImageWinMouseDown - end - object Label1: TLabel - Left = 30 - Top = 16 - Width = 99 - Height = 13 - Caption = 'Drawing by Imaging:' - end - object Label2: TLabel - Left = 510 - Top = 16 - Width = 96 - Height = 13 - Caption = 'Drawing by WinAPI:' - end -end diff --git a/components/vampireimaging/Extras/Demos/ClippingTest/ResultsForm.pas b/components/vampireimaging/Extras/Demos/ClippingTest/ResultsForm.pas deleted file mode 100644 index 7892014..0000000 --- a/components/vampireimaging/Extras/Demos/ClippingTest/ResultsForm.pas +++ /dev/null @@ -1,68 +0,0 @@ -unit ResultsForm; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ExtCtrls, - ImagingComponents, StdCtrls; - -type - TResultForm = class(TForm) - ImageMy: TImage; - ImageWin: TImage; - Label1: TLabel; - Label2: TLabel; - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure FormMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure ImageMyMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure ImageWinMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - public - MyBitmap, WinBitmap: TImagingBitmap; - end; - -var - ResultForm: TResultForm; - -implementation - -{$R *.dfm} - -procedure TResultForm.FormCreate(Sender: TObject); -begin - MyBitmap := TImagingBitmap.Create; - WinBitmap := TImagingBitmap.Create; - - ImageMy.Picture.Graphic := MyBitmap; - ImageWin.Picture.Graphic := WinBitmap; -end; - -procedure TResultForm.FormDestroy(Sender: TObject); -begin - MyBitmap.Free; - WinBitmap.Free; -end; - -procedure TResultForm.FormMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - Close; -end; - -procedure TResultForm.ImageMyMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - Close; -end; - -procedure TResultForm.ImageWinMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - Close; -end; - -end. diff --git a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.cpp b/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.cpp deleted file mode 100644 index 466aa39..0000000 --- a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.cpp +++ /dev/null @@ -1,428 +0,0 @@ -// Vampyre Imaging Library Demo -// Benchmark (C++, dll library usage, Win32) -// tested in MSVC 8.0, BC++ 5.6.4 -// written by Marek Mauder -// -// This is not actually benchmark like ObjectPascal version because -// all measured functions are called from external library, but it -// shows how to use Imaging dll from C/C++ at least. -// -// Important: -// 1) During the test large amounts of memory can be allocated by -// the program (e.g. conversion from 3000x3000x64 bit image to 128 bit -// requires over 200 MB of memory). -// 2) Program's executable must be located in Demos\Bin, -// or anywhere in the subdirectories of Demos\Cpp dir to be able to find -// used data files. -// -// Compiled Imaging library must be located somewhere on system's -// search path for this sample to work (usually VampyreImaging.dll -// in C:\Windows or libVampyreImaging.so in /lib). - -#include -#include -#include -#include -#include -#include "..\..\..\Wrappers\Cpp\ImagingImport.h" - -using namespace Imaging; -using namespace std; - -// Define this to write results to log file or undef it to -// display them on screen. -#define LOG_TO_FILE -// Define this to write images created in saving test on disk. -// They are saved only to memory when testing. -#define SAVE_IMAGES_TO_FILES - -LARGE_INTEGER PerfFrequency; -double InvPerfFrequency; - -const string SDataDir = "Data\\"; -const string SImageName = "Tigers"; -const string SSaveImage = "_BenchOut"; -const int BufSize = 8 * 1024 * 1024; - -enum TManipulation {maResize3k, maResize1k, maFlip, maMirror, maSwapChannels, - maConvARGB64, maConvARGBF, maConvARGB16, maConvRGB24, maConvARGB32, - maCompressDXT, maDecompressDXT, maReduceColors, maClone, maMipMaps, - maCopyRect, maMapImage, maFill, maSplit, maMakePal, maReplace, maRotate180, - maRotate90, maStretchRect}; - -struct TFileFormatInfo -{ - char Name[64]; - char Ext[16]; - char Masks[128]; - Boolean CanSave; - Boolean IsMulti; -}; - -#ifdef LOG_TO_FILE -fstream Out; -#else -// If logging to files is not defined standard cout is used -ostream &Out = cout; -#endif -TImageData Img, ImgClone; -LONGLONG Time; -string Dir; -char SaveBuf[BufSize]; -TImageDataList Subs = 0; -TColor32Rec FillColor, NewColor; -int I, XCount, YCount; -PPalette32 Pal = NULL; -vector Formats; - -string GetAppDir(void); -string GetDataDir(void); -string GetImageName(const string &Ext); -LONGLONG GetTimeMicroseconds(void); -void LoadImage(const string &Name); -void SaveImage(const string &Ext); -void ManipulateImage(const TManipulation Man); - -int main(int argc, char ** argv) -{ - char tmp; - int Major, Minor, Patch; - Dir = argv[0]; - FillColor.Color = 0xFFFF0000; - NewColor.Color = 0xFF00CCFF; - - QueryPerformanceFrequency(&PerfFrequency); - InvPerfFrequency = (double)1.0 / PerfFrequency.QuadPart; - -#ifdef LOG_TO_FILE - // if logging to file is defined new output file is created - // and all messages are written into it - Out.open("ResultsCpp.log", ios::out); - cout << "Benchmarking..." << endl; -#endif - // This call must be made before any atempt to use any Imaging function. - // Everything is imported from dll here. - ImLoadLibrary(); - // Call this before any manipulation with TImageData record - ImInitImage(&Img); - - ImGetVersion(&Major, &Minor, &Patch); - Out << "Vampyre Imaging Library Benchmark Demo (C++) version " << - Major << '.' << Minor << '.' << Patch << endl << endl; - - I = 0; - Formats.resize(1); - // Enumerate all supported file formats and store their properties - // to dyn array. After each iteration dyn array's size is increased by one - // so next call to EnumFileFormats will have free space for results. - // After enumerating last array item should be deleted because its empty. - while (ImEnumFileFormats(&I, Formats[I].Name, Formats[I].Ext, Formats[I].Masks, &Formats[I].CanSave, &Formats[I].IsMulti)) - Formats.resize(I + 1); - Formats.resize(I); - - // Test image loading functions for all supported image file formats - // note that image loaded in one LoadImage is automaticaly - // freed in then next LoadImage call so no leaks (should) occurr. - Out << "------------- Loading Images -------------" << endl; - for (I = 0; I < (int)Formats.size(); I++) - LoadImage(GetImageName(Formats[I].Ext)); - - // Test image manipulation functions like conversions, resizing and other - Out << endl << "----------- Image Manipulation -----------" << endl; - ManipulateImage(maResize3k); - ManipulateImage(maConvARGB64); - ManipulateImage(maFlip); - ManipulateImage(maMirror); - ManipulateImage(maSwapChannels); - ManipulateImage(maConvARGBF); - ManipulateImage(maConvARGB16); - ManipulateImage(maConvARGB32); - ManipulateImage(maClone); - ManipulateImage(maCopyRect); - ManipulateImage(maFill); - ManipulateImage(maStretchRect); - ManipulateImage(maReplace); - ManipulateImage(maMipMaps); - ManipulateImage(maSplit); - ManipulateImage(maResize1k); - ManipulateImage(maRotate180); - ManipulateImage(maRotate90); - ManipulateImage(maReduceColors); - ManipulateImage(maMakePal); - ManipulateImage(maMapImage); - ManipulateImage(maCompressDXT); - ManipulateImage(maDecompressDXT); - ManipulateImage(maConvRGB24); - - // Test image saving functions. Image is now in R8G8B8 format. Note that - // some supported file formats cannot save images in R8G8B8 so their - // time includes conversions. - Out << endl << "------------- Saving Images --------------" << endl; - for (I = 0; I < (int)Formats.size(); I++) - { - if (Formats[I].CanSave) - SaveImage(Formats[I].Ext); - } - - // Image must be freed in the end - ImFreeImage(&Img); - // Call this if you no longer need to use Imaging functions - // Imaging dll is unloaded here - ImFreeLibrary(); -#ifdef LOG_TO_FILE - Out.close(); - cout << "Results written to 'ResultsCpp.log' file." << endl; -#endif - cout << "Press any key to exit" << endl; - cin.get(tmp); - return 0; -} - -string GetAppDir(void) -{ - int Idx; - string Res = Dir; - - Idx = static_cast(Res.rfind("\\")); - if (Idx > 0) - Res.erase(Idx + 1); - - return Res; -} - -string GetDataDir(void) -{ - int Idx; - string Res = Dir; - - Idx = static_cast(Res.find("Bin\\")); - if (Idx >= 0) - return Res.erase(Idx) + SDataDir; - - Idx = static_cast(Res.find("Cpp\\")); - if (Idx >= 0) - return Res.erase(Idx) + SDataDir; - - return Res; -} - -string GetImageName(const string &Ext) -{ - return GetDataDir() + SImageName + '.' + Ext; -} - -LONGLONG GetTimeMicroseconds(void) -{ - LARGE_INTEGER Time; - - QueryPerformanceCounter(&Time); - return static_cast(1000000 * InvPerfFrequency * Time.QuadPart); -} - -void LoadImage(const string &Name) -{ - FILE *File = fopen(Name.c_str(), "rb"); - if (File == NULL) - return; - else - fclose(File); - - Out << "Loading image: " << Name << endl; - Time = GetTimeMicroseconds(); - ImLoadImageFromFile(Name.c_str(), &Img); - Out << "Image loaded in: " << GetTimeMicroseconds() - Time << " us" << endl; -} - -void SaveImage(const string &Ext) -{ - int Size = BufSize; - Out << "Saving image to format: " << Ext << endl; - Time = GetTimeMicroseconds(); - ImSaveImageToMemory(Ext.c_str(), (void*)SaveBuf, &Size, &Img); - Out << "Image saved in: " << GetTimeMicroseconds() - Time << " us" << endl; -#ifdef SAVE_IMAGES_TO_FILES - ImSaveImageToFile((GetAppDir() + SSaveImage + '.' + Ext).c_str(), &Img); -#endif -} - -void ManipulateImage(const TManipulation Man) -{ - // According to the enum value image manipulation functions are - // called and measured. - switch (Man) - { - case maResize3k: - Out << "Resizing image to 3000x3000 (bilinear) ..." << endl; - Time = GetTimeMicroseconds(); - ImResizeImage(&Img, 3000, 3000, rfBilinear); - Out << "Image resized in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maResize1k: - Out << "Resizing image to 1000x1000 (bicubic) ..." << endl; - Time = GetTimeMicroseconds(); - ImResizeImage(&Img, 1000, 1000, rfBicubic); - Out << "Image resized in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maFlip: - Out << "Flipping image ..." << endl; - Time = GetTimeMicroseconds(); - ImFlipImage(&Img); - Out << "Image flipped in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maMirror: - Out << "Mirroring image ..." << endl; - Time = GetTimeMicroseconds(); - ImMirrorImage(&Img); - Out << "Image mirrored in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maSwapChannels: - Out << "Swapping channels of image ..." << endl; - Time = GetTimeMicroseconds(); - ImSwapChannels(&Img, ChannelRed, ChannelGreen); - Out << "Channels swapped in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maConvARGB64: - Out << "Converting image to A16R16G16B16 64bit format ..." << endl; - Time = GetTimeMicroseconds(); - ImConvertImage(&Img, ifA16R16G16B16); - Out << "Image converted in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maConvARGBF: - Out << "Converting image to A32B32G32R32F 128bit floating point format ..." << endl; - Time = GetTimeMicroseconds(); - ImConvertImage(&Img, ifA32B32G32R32F); - Out << "Image converted in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maConvARGB16: - Out << "Converting image to A4R4G4B4 16bit format ..." << endl; - Time = GetTimeMicroseconds(); - ImConvertImage(&Img, ifA4R4G4B4); - Out << "Image converted in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maConvRGB24: - Out << "Converting image to R8G8B8 24bit format ..." << endl; - Time = GetTimeMicroseconds(); - ImConvertImage(&Img, ifR8G8B8); - Out << "Image converted in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maConvARGB32: - Out << "Converting image to A8R8G8B8 32bit format ..." << endl; - Time = GetTimeMicroseconds(); - ImConvertImage(&Img, ifA8R8G8B8); - Out << "Image converted in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maCompressDXT: - Out << "Compressing image to DXT1 format ..." << endl; - Time = GetTimeMicroseconds(); - ImConvertImage(&Img, ifDXT1); - Out << "Image compressed in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maDecompressDXT: - Out << "Decompressing image from DXT1 format ..." << endl; - Time = GetTimeMicroseconds(); - ImConvertImage(&Img, ifA8R8G8B8); - Out << "Image decompressed in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maReduceColors: - Out << "Reducing colors count to 1024 ..." << endl; - Time = GetTimeMicroseconds(); - ImReduceColors(&Img, 1024); - Out << "Colors reduced in in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maMipMaps: - Out << "Creating mipmaps ..." << endl; - Time = GetTimeMicroseconds(); - ImGenerateMipMaps(&Img, 0, &Subs); - Out << "Mipmaps created in: " << GetTimeMicroseconds() - Time << " us" << endl; - ImFreeImageList(&Subs); - break; - case maClone: - Out << "Cloning image ..." << endl; - ImInitImage(&ImgClone); - Time = GetTimeMicroseconds(); - ImCloneImage(&Img, &ImgClone); - Out << "Image cloned in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maCopyRect: - Out << "Copying rectangle ..." << endl; - Time = GetTimeMicroseconds(); - ImCopyRect(&ImgClone, 0, 1500, 1500, 1500, &Img, 0, 0); - Out << "Rectangle copied in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maStretchRect: - Out << "Stretching rectangle (bicubic) ... " << endl; - Time = GetTimeMicroseconds(); - ImStretchRect(&ImgClone, 0, 1500, 1500, 1500, &Img, 500, 500, 2000, 2000, rfBicubic); - Out << "Rectangle stretched in: " << GetTimeMicroseconds() - Time << " us" << endl; - ImFreeImage(&ImgClone); - break; - case maMapImage: - Out << "Mapping image to existing palette ..." << endl; - Time = GetTimeMicroseconds(); - ImMapImageToPalette(&Img, Pal, 256); - Out << "Image mapped in: " << GetTimeMicroseconds() - Time << " us" << endl; - ImFreePalette(&Pal); - break; - case maFill: - Out << "Filling rectangle ..." << endl; - Time = GetTimeMicroseconds(); - ImFillRect(&Img, 1500, 0, 1500, 1500, &FillColor); - Out << "Rectangle filled in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maReplace: - Out << "Replacing colors in rectagle ..." << endl; - Time = GetTimeMicroseconds(); - ImReplaceColor(&Img, 0, 0, Img.Width, Img.Height, &FillColor, &NewColor); - Out << "Colors replaced in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maSplit: - Out << "Splitting image ..." << endl; - Time = GetTimeMicroseconds(); - Subs = 0; - ImSplitImage(&Img, &Subs, 300, 300, &XCount, &YCount, True, &FillColor); - Out << "Image split in: " << GetTimeMicroseconds() - Time << " us" << endl; - ImFreeImageList(&Subs); - break; - case maMakePal: - Out << "Making palette for images ..." << endl; - ImNewPalette(256, &Pal); - ImInitImageList(1, &Subs); - ImSetImageListElement(Subs, 0, &Img); - Time = GetTimeMicroseconds(); - ImMakePaletteForImages(Subs, Pal, 256, False); - Out << "Palette made in: " << GetTimeMicroseconds() - Time << " us" << endl; - ImFreeImage(&Img); - ImGetImageListElement(Subs, 0, &Img); - ImFreeImageList(&Subs); - break; - case maRotate180: - Out << "Rotating image 180 degrees CCW ... " << endl; - Time = GetTimeMicroseconds(); - ImRotateImage(&Img, 180); - Out << "Image rotated in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - case maRotate90: - Out << "Rotating image 90 degrees CCW ... " << endl; - Time = GetTimeMicroseconds(); - ImRotateImage(&Img, 90); - Out << "Image rotated in: " << GetTimeMicroseconds() - Time << " us" << endl; - break; - } -} - -/* - Changes/Bug Fixes: - - -- 0.21 ----------------------------------------------------- - - Updated according to Object Pascal version of demo. - - -- 0.17 ----------------------------------------------------- - - made changes to be up to date with Pascal version - (new tests, filtered resizing, ...) - - -- 0.15 ----------------------------------------------------- - - changed working with ImageDataList types because of change - in header - -*/ - diff --git a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.sln b/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.sln deleted file mode 100644 index 59f9f66..0000000 --- a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.sln +++ /dev/null @@ -1,19 +0,0 @@ -Microsoft Visual Studio Solution File, Format Version 11.00 -# Visual Studio 2010 -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Bench", "Bench.vcxproj", "{9DA4C203-CBD7-47D0-8E6F-6601620679D8}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Win32 = Debug|Win32 - Release|Win32 = Release|Win32 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {9DA4C203-CBD7-47D0-8E6F-6601620679D8}.Debug|Win32.ActiveCfg = Debug|Win32 - {9DA4C203-CBD7-47D0-8E6F-6601620679D8}.Debug|Win32.Build.0 = Debug|Win32 - {9DA4C203-CBD7-47D0-8E6F-6601620679D8}.Release|Win32.ActiveCfg = Release|Win32 - {9DA4C203-CBD7-47D0-8E6F-6601620679D8}.Release|Win32.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.vcxproj b/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.vcxproj deleted file mode 100644 index 43ee9ca..0000000 --- a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.vcxproj +++ /dev/null @@ -1,100 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - {9DA4C203-CBD7-47D0-8E6F-6601620679D8} - Bench - Win32Proj - - - - Application - MultiByte - - - Application - MultiByte - - - - - - - - - - - - - - - <_ProjectFileVersion>10.0.40219.1 - ..\..\..\..\..\Demos\Bin - ..\..\..\..\..\Demos\Bin - true - ..\..\..\..\..\Demos\Bin - ..\..\..\..\..\Demos\Bin - false - $(ProjectName)Cpp - $(ProjectName)Cpp - - - - Disabled - WIN32;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) - true - EnableFastChecks - MultiThreadedDebug - - - Level3 - EditAndContinue - - - $(OutDir)BenchCpp.exe - true - $(OutDir)Bench.pdb - Console - MachineX86 - - - - - Size - WIN32;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) - MultiThreaded - - - Level3 - ProgramDatabase - - - $(OutDir)BenchCpp.exe - true - Console - true - true - MachineX86 - - - - - - - - - - - - - - \ No newline at end of file diff --git a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.vcxproj.filters b/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.vcxproj.filters deleted file mode 100644 index 7884a31..0000000 --- a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Benchmark/Bench.vcxproj.filters +++ /dev/null @@ -1,33 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx - - - - - Source Files - - - Source Files - - - - - Header Files - - - Header Files - - - \ No newline at end of file diff --git a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Test/test.c b/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Test/test.c deleted file mode 100644 index d5f93af..0000000 --- a/components/vampireimaging/Extras/DynamicLib/Demos/Cpp/Test/test.c +++ /dev/null @@ -1,66 +0,0 @@ -/* Vampyre Imaging Library Demo - test (C/C++, dll library usage, Win32/Linux) - tested in MSVC 7.1, GCC 3.2 - written by Marek Mauder - - Simple test program that shows how to use Imaging library from C/C++ - environment. - - Important: - Compiled Imaging library must be located somewhere on system's - search path for this sample to work (usually VampyreImaging.dll - in C:\Windows or libVampyreImaging.so in /lib). -*/ - -#include "ImagingImport.h" -#include "stdio.h" - -#ifdef __cplusplus -using namespace Imaging; -#endif - -int main(void) -{ - TImageData Img; - TColor32Rec * Col; - int X = 0; - int Major, Minor, Patch; - - /* load all library functions */ - if (!ImLoadLibrary()) - { - printf("Error loading library"); - return 1; - } - /* get Imaging library version */ - ImGetVersion(&Major, &Minor, &Patch); - printf("Imaging test (library version %d.%d.%d)\n", Major, Minor, Patch); - /* initialize image data struct */ - ImInitImage(&Img); - /* create new 256x256 32bit image with alpha */ - ImNewImage(256, 256, ifA8R8G8B8, &Img); - - /* draw diagonal line across the image */ - for (;X < Img.Width; X++) - { - Col = (TColor32Rec*)Img.Bits + X * Img.Width + X; - Col->A = 0xff; - Col->R = X; - Col->G = 0xff - X; - Col->B = X / 2; - } - - /* save image to Targa format */ - ImSaveImageToFile("ctestimage.png", &Img); - /* free image data */ - ImFreeImage(&Img); - /* free library */ - ImFreeLibrary(); - - printf("Image written to 'ctestimage.png'\n"); - - return 0; -} - - - diff --git a/components/vampireimaging/Extras/DynamicLib/ImagingExport.pas b/components/vampireimaging/Extras/DynamicLib/ImagingExport.pas deleted file mode 100644 index 42fc589..0000000 --- a/components/vampireimaging/Extras/DynamicLib/ImagingExport.pas +++ /dev/null @@ -1,892 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This function contains functions exported from Imaging dynamic link library. - All string are exported as PChars and all var parameters are exported - as pointers. All posible exceptions getting out of dll are catched.} -unit ImagingExport; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, - Imaging; - -{ Returns version of Imaging library. } -procedure ImGetVersion(var Major, Minor, Patch: LongInt); cdecl; -{ Look at InitImage for details.} -procedure ImInitImage(var Image: TImageData); cdecl; -{ Look at NewImage for details.} -function ImNewImage(Width, Height: LongInt; Format: TImageFormat; - var Image: TImageData): Boolean; cdecl; -{ Look at TestImage for details.} -function ImTestImage(var Image: TImageData): Boolean; cdecl; -{ Look at FreeImage for details.} -function ImFreeImage(var Image: TImageData): Boolean; cdecl; -{ Look at DetermineFileFormat for details. Ext should have enough space for - result file extension.} -function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean; cdecl; -{ Look at DetermineMemoryFormat for details. Ext should have enough space for - result file extension.} -function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean; cdecl; -{ Look at IsFileFormatSupported for details.} -function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean; cdecl; -{ Look at EnumFileFormats for details.} -function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar; - var CanSave, IsMultiImageFormat: Boolean): Boolean; cdecl; - -{ Inits image list.} -function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean; cdecl; -{ Returns size of image list.} -function ImGetImageListSize(ImageList: TImageDataList): LongInt; cdecl; -{ Returns image list's element at given index. Output image is not cloned it's - Bits point to Bits in list => do not free OutImage.} -function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt; - var OutImage: TImageData): Boolean; cdecl; -{ Sets size of image list.} -function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt): Boolean; cdecl; -{ Sets image list element at given index. Input image is not cloned - image in - list will point to InImage's Bits.} -function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt; - const InImage: TImageData): Boolean; cdecl; -{ Returns True if all images in list pass ImTestImage test. } -function ImTestImagesInList(ImageList: TImageDataList): Boolean; cdecl; -{ Frees image list and all images in it.} -function ImFreeImageList(var ImageList: TImageDataList): Boolean; cdecl; - -{ Look at LoadImageFromFile for details.} -function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean; cdecl; -{ Look at LoadImageFromMemory for details.} -function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; cdecl; -{ Look at LoadMultiImageFromFile for details.} -function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList): Boolean; cdecl; -{ Look at LoadMultiImageFromMemory for details.} -function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt; - var ImageList: TImageDataList): Boolean; cdecl; - -{ Look at SaveImageToFile for details.} -function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean; cdecl; -{ Look at SaveImageToMemory for details.} -function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt; - const Image: TImageData): Boolean; cdecl; -{ Look at SaveMultiImageToFile for details.} -function ImSaveMultiImageToFile(FileName: PAnsiChar; ImageList: TImageDataList): Boolean; cdecl; -{ Look at SaveMultiImageToMemory for details.} -function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt; - ImageList: TImageDataList): Boolean; cdecl; - -{ Look at CloneImage for details.} -function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean; cdecl; -{ Look at ConvertImage for details.} -function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; cdecl; -{ Look at FlipImage for details.} -function ImFlipImage(var Image: TImageData): Boolean; cdecl; -{ Look at MirrorImage for details.} -function ImMirrorImage(var Image: TImageData): Boolean; cdecl; -{ Look at ResizeImage for details.} -function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; - Filter: TResizeFilter): Boolean; cdecl; -{ Look at SwapChannels for details.} -function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; cdecl; -{ Look at ReduceColors for details.} -function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; cdecl; -{ Look at GenerateMipMaps for details.} -function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt; - var MipMaps: TImageDataList): Boolean; cdecl; -{ Look at MapImageToPalette for details.} -function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32; - Entries: LongInt): Boolean; cdecl; -{ Look at SplitImage for details.} -function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList; - ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; - PreserveSize: Boolean; Fill: Pointer): Boolean; cdecl; -{ Look at MakePaletteForImages for details.} -function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32; - MaxColors: LongInt; ConvertImages: Boolean): Boolean; cdecl; -{ Look at RotateImage for details.} -function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; cdecl; - -{ Look at CopyRect for details.} -function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; - var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl; -{ Look at FillRect for details.} -function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt; - Fill: Pointer): Boolean; cdecl; -{ Look at ReplaceColor for details.} -function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt; - OldPixel, NewPixel: Pointer): Boolean; cdecl; -{ Look at StretchRect for details.} -function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl; -{ Look at GetPixelDirect for details.} -procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl; -{ Look at SetPixelDirect for details.} -procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl; -{ Look at GetPixel32 for details.} -function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl; -{ Look at SetPixel32 for details.} -procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); cdecl; -{ Look at GetPixelFP for details.} -function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl; -{ Look at SetPixelFP for details.} -procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); cdecl; - -{ Look at NewPalette for details.} -function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean; cdecl; -{ Look at FreePalette for details.} -function ImFreePalette(var Pal: PPalette32): Boolean; cdecl; -{ Look at CopyPalette for details.} -function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; cdecl; -{ Look at FindColor for details.} -function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt; cdecl; -{ Look at FillGrayscalePalette for details.} -function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean; cdecl; -{ Look at FillCustomPalette for details.} -function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits, - BBits: Byte; Alpha: Byte): Boolean; cdecl; -{ Look at SwapChannelsOfPalette for details.} -function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel, - DstChannel: LongInt): Boolean; cdecl; - -{ Look at SetOption for details.} -function ImSetOption(OptionId, Value: LongInt): Boolean; cdecl; -{ Look at GetOption for details.} -function ImGetOption(OptionId: LongInt): LongInt; cdecl; -{ Look at PushOptions for details.} -function ImPushOptions: Boolean; cdecl; -{ Look at PopOptions for details.} -function ImPopOptions: Boolean; cdecl; - -{ Look at GetImageFormatInfo for details.} -function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; cdecl; -{ Look at GetPixelsSize for details.} -function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; cdecl; - -{ Look at SetUserFileIO for details.} -procedure ImSetUserFileIO(OpenProc: TOpenProc; CloseProc: TCloseProc; EofProc: TEofProc; - SeekProc: TSeekProc; TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); cdecl; -{ Look at ResetFileIO for details.} -procedure ImResetFileIO; cdecl; - -{ These are only for documentation generation reasons.} -{ Loads Imaging functions from dll/so library.} -function ImLoadLibrary: Boolean; -{ Frees Imaging functions loaded from dll/so and releases library.} -function ImFreeLibrary: Boolean; - -implementation - -uses - SysUtils, - ImagingUtility; - -function ImLoadLibrary: Boolean; begin Result := True; end; -function ImFreeLibrary: Boolean; begin Result := True; end; - -type - TInternalList = record - List: TDynImageDataArray; - end; - PInternalList = ^TInternalList; - -procedure ImGetVersion(var Major, Minor, Patch: LongInt); -begin - Major := ImagingVersionMajor; - Minor := ImagingVersionMinor; - Patch := 0; -end; - -procedure ImInitImage(var Image: TImageData); -begin - try - Imaging.InitImage(Image); - except - end; -end; - -function ImNewImage(Width, Height: LongInt; Format: TImageFormat; - var Image: TImageData): Boolean; -begin - try - Result := Imaging.NewImage(Width, Height, Format, Image); - except - Result := False; - end; -end; - -function ImTestImage(var Image: TImageData): Boolean; -begin - try - Result := Imaging.TestImage(Image); - except - Result := False; - end; -end; - -function ImFreeImage(var Image: TImageData): Boolean; -begin - try - Imaging.FreeImage(Image); - Result := True; - except - Result := False; - end; -end; - -function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean; -var - S: string; -begin - try - S := Imaging.DetermineFileFormat(FileName); - Result := S <> ''; - StrCopy(Ext, PAnsiChar(AnsiString(S))); - except - Result := False; - end; -end; - -function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean; -var - S: string; -begin - try - S := Imaging.DetermineMemoryFormat(Data, Size); - Result := S <> ''; - StrCopy(Ext, PAnsiChar(AnsiString(S))); - except - Result := False; - end; -end; - -function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean; -begin - try - Result := Imaging.IsFileFormatSupported(FileName); - except - Result := False; - end; -end; - -function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar; - var CanSave, IsMultiImageFormat: Boolean): Boolean; -var - StrName, StrDefaultExt, StrMasks: string; -begin - try - Result := Imaging.EnumFileFormats(Index, StrName, StrDefaultExt, StrMasks, CanSave, - IsMultiImageFormat); - StrCopy(Name, PAnsiChar(AnsiString(StrName))); - StrCopy(DefaultExt, PAnsiChar(AnsiString(StrDefaultExt))); - StrCopy(Masks, PAnsiChar(AnsiString(StrMasks))); - except - Result := False; - end; -end; - -function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean; -var - Int: PInternalList; -begin - try - try - ImFreeImageList(ImageList); - except - end; - New(Int); - SetLength(Int.List, Size); - ImageList := TImageDataList(Int); - Result := True; - except - Result := False; - ImageList := nil; - end; -end; - -function ImGetImageListSize(ImageList: TImageDataList): LongInt; -begin - try - Result := Length(PInternalList(ImageList).List); - except - Result := -1; - end; -end; - -function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt; - var OutImage: TImageData): Boolean; -begin - try - Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1); - ImCloneImage(PInternalList(ImageList).List[Index], OutImage); - Result := True; - except - Result := False; - end; -end; - -function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt): - Boolean; -var - I, OldSize: LongInt; -begin - try - OldSize := Length(PInternalList(ImageList).List); - if NewSize < OldSize then - for I := NewSize to OldSize - 1 do - Imaging.FreeImage(PInternalList(ImageList).List[I]); - SetLength(PInternalList(ImageList).List, NewSize); - Result := True; - except - Result := False; - end; -end; - -function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt; - const InImage: TImageData): Boolean; -begin - try - Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1); - ImCloneImage(InImage, PInternalList(ImageList).List[Index]); - Result := True; - except - Result := False; - end; -end; - -function ImTestImagesInList(ImageList: TImageDataList): Boolean; -var - I: LongInt; - Arr: TDynImageDataArray; -begin - Arr := nil; - try - Arr := PInternalList(ImageList).List; - Result := True; - for I := 0 to Length(Arr) - 1 do - begin - Result := Result and Imaging.TestImage(Arr[I]); - if not Result then Break; - end; - except - Result := False; - end; -end; - -function ImFreeImageList(var ImageList: TImageDataList): Boolean; -var - Int: PInternalList; -begin - try - if ImageList <> nil then - begin - Int := PInternalList(ImageList); - FreeImagesInArray(Int.List); - Dispose(Int); - ImageList := nil; - end; - Result := True; - except - Result := False; - end; -end; - -function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean; -begin - try - Result := Imaging.LoadImageFromFile(FileName, Image); - except - Result := False; - end; -end; - -function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; -begin - try - Result := Imaging.LoadImageFromMemory(Data, Size, Image); - except - Result := False; - end; -end; - -function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList): - Boolean; -begin - try - ImInitImageList(0, ImageList); - Result := Imaging.LoadMultiImageFromFile(FileName, - PInternalList(ImageList).List); - except - Result := False; - end; -end; - -function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt; - var ImageList: TImageDataList): Boolean; -begin - try - ImInitImageList(0, ImageList); - Result := Imaging.LoadMultiImageFromMemory(Data, Size, PInternalList(ImageList).List); - except - Result := False; - end; -end; - -function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean; -begin - try - Result := Imaging.SaveImageToFile(FileName, Image); - except - Result := False; - end; -end; - -function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt; - const Image: TImageData): Boolean; -begin - try - Result := Imaging.SaveImageToMemory(Ext, Data, Size, Image); - except - Result := False; - end; -end; - -function ImSaveMultiImageToFile(FileName: PAnsiChar; - ImageList: TImageDataList): Boolean; -begin - try - Result := Imaging.SaveMultiImageToFile(FileName, - PInternalList(ImageList).List); - except - Result := False; - end; -end; - -function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt; - ImageList: TImageDataList): Boolean; -begin - try - Result := Imaging.SaveMultiImageToMemory(Ext, Data, Size^, - PInternalList(ImageList).List); - except - Result := False; - end; -end; - -function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean; -begin - try - Result := Imaging.CloneImage(Image, Clone); - except - Result := False; - end; -end; - -function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; -begin - try - Result := Imaging.ConvertImage(Image, DestFormat); - except - Result := False; - end; -end; - -function ImFlipImage(var Image: TImageData): Boolean; -begin - try - Result := Imaging.FlipImage(Image); - except - Result := False; - end; -end; - -function ImMirrorImage(var Image: TImageData): Boolean; -begin - try - Result := Imaging.MirrorImage(Image); - except - Result := False; - end; -end; - -function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; - Filter: TResizeFilter): Boolean; -begin - try - Result := Imaging.ResizeImage(Image, NewWidth, NewHeight, Filter); - except - Result := False; - end; -end; - -function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): - Boolean; -begin - try - Result := Imaging.SwapChannels(Image, SrcChannel, DstChannel); - except - Result := False; - end; -end; - -function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; -begin - try - Result := Imaging.ReduceColors(Image, MaxColors); - except - Result := False; - end; -end; - -function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt; - var MipMaps: TImageDataList): Boolean; -begin - try - ImInitImageList(0, MipMaps); - Result := Imaging.GenerateMipMaps(Image, Levels, - PInternalList(MipMaps).List); - except - Result := False; - end; -end; - -function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32; - Entries: LongInt): Boolean; -begin - try - Result := Imaging.MapImageToPalette(Image, Pal, Entries); - except - Result := False; - end; -end; - -function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList; - ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; - PreserveSize: Boolean; Fill: Pointer): Boolean; -begin - try - ImInitImageList(0, Chunks); - Result := Imaging.SplitImage(Image, PInternalList(Chunks).List, - ChunkWidth, ChunkHeight, XChunks, YChunks, PreserveSize, Fill); - except - Result := False; - end; -end; - -function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32; - MaxColors: LongInt; ConvertImages: Boolean): Boolean; -begin - try - Result := Imaging.MakePaletteForImages(PInternalList(Images).List, - Pal, MaxColors, ConvertImages); - except - Result := False; - end; -end; - -function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; -begin - Result := True; - try - Imaging.RotateImage(Image, Angle); - except - Result := False; - end; -end; - -function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; - var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl; -begin - try - Result := Imaging.CopyRect(SrcImage, SrcX, SrcY, Width, Height, - DstImage, DstX, DstY); - except - Result := False; - end; -end; - -function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt; - Fill: Pointer): Boolean; -begin - try - Result := Imaging.FillRect(Image, X, Y, Width, Height, Fill); - except - Result := False; - end; -end; - -function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt; - OldPixel, NewPixel: Pointer): Boolean; -begin - try - Result := Imaging.ReplaceColor(Image, X, Y, Width, Height, OldPixel, NewPixel); - except - Result := False; - end; -end; - -function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl; -begin - try - Result := Imaging.StretchRect(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight, - DstImage, DstX, DstY, DstWidth, DstHeight, Filter); - except - Result := False; - end; -end; - -procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); -begin - try - Imaging.GetPixelDirect(Image, X, Y, Pixel); - except - end; -end; - -procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); -begin - try - Imaging.SetPixelDirect(Image, X, Y, Pixel); - except - end; -end; - -function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl; -begin - try - Result := Imaging.GetPixel32(Image, X, Y); - except - Result.Color := 0; - end; -end; - -procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); -begin - try - Imaging.SetPixel32(Image, X, Y, Color); - except - end; -end; - -function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl; -begin - try - Result := Imaging.GetPixelFP(Image, X, Y); - except - FillChar(Result, SizeOf(Result), 0); - end; -end; - -procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); -begin - try - Imaging.SetPixelFP(Image, X, Y, Color); - except - end; -end; - -function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean; -begin - try - Imaging.NewPalette(Entries, Pal); - Result := True; - except - Result := False; - end; -end; - -function ImFreePalette(var Pal: PPalette32): Boolean; -begin - try - Imaging.FreePalette(Pal); - Result := True; - except - Result := False; - end; -end; - -function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; -begin - try - Imaging.CopyPalette(SrcPal, DstPal, SrcIdx, DstIdx, Count); - Result := True; - except - Result := False; - end; -end; - -function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt; -begin - try - Result := Imaging.FindColor(Pal, Entries, Color); - except - Result := 0; - end; -end; - -function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean; -begin - try - Imaging.FillGrayscalePalette(Pal, Entries); - Result := True; - except - Result := False; - end; -end; - -function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits, - BBits: Byte; Alpha: Byte): Boolean; -begin - try - Imaging.FillCustomPalette(Pal, Entries, RBits, GBits, BBits, Alpha); - Result := True; - except - Result := False; - end; -end; - -function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel, - DstChannel: LongInt): Boolean; -begin - try - Imaging.SwapChannelsOfPalette(Pal, Entries, SrcChannel, DstChannel); - Result := True; - except - Result := False; - end; -end; - -function ImSetOption(OptionId, Value: LongInt): Boolean; -begin - try - Result := Imaging.SetOption(OptionId, Value); - except - Result := False; - end; -end; - -function ImGetOption(OptionId: LongInt): LongInt; -begin - try - Result := GetOption(OptionId); - except - Result := InvalidOption; - end; -end; - -function ImPushOptions: Boolean; -begin - try - Result := Imaging.PushOptions; - except - Result := False; - end; -end; - -function ImPopOptions: Boolean; -begin - try - Result := Imaging.PopOptions; - except - Result := False; - end; -end; - -function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; -begin - try - Result := Imaging.GetImageFormatInfo(Format, Info); - except - Result := False; - end; -end; - -function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; -begin - try - Result := Imaging.GetPixelsSize(Format, Width, Height); - except - Result := 0; - end; -end; - -procedure ImSetUserFileIO(OpenProc: TOpenProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc; - TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); -begin - try - Imaging.SetUserFileIO(OpenProc, CloseProc, EofProc, - SeekProc, TellProc, ReadProc, WriteProc); - except - end; -end; - -procedure ImResetFileIO; -begin - try - Imaging.ResetFileIO; - except - end; -end; - -{ - Changes/Bug Fixes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 --------------------------------------------------- - - IO functions updates. - - -- 0.26.3 --------------------------------------------------- - - changed PChars to PAnsiChars and some more D2009 friendly - casts. - - -- 0.19 ----------------------------------------------------- - - updated to reflect changes in low level interface (added pixel set/get, ...) - - changed ImInitImage to procedure to reflect change in Imaging.pas - - added ImIsFileFormatSupported - - -- 0.15 ----------------------------------------------------- - - behaviour of ImGetImageListElement and ImSetImageListElement - has changed - list items are now cloned rather than referenced, - because of this ImFreeImageListKeepImages was no longer needed - and was removed - - many function headers were changed - mainly pointers were - replaced with var and const parameters - - -- 0.13 ----------------------------------------------------- - - added TestImagesInList function and new 0.13 functions - - images were not freed when image list was resized in ImSetImageListSize - - ImSaveMultiImageTo* recreated the input image list with size = 0 - -} -end. - diff --git a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingImport.c b/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingImport.c deleted file mode 100644 index f45d44c..0000000 --- a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingImport.c +++ /dev/null @@ -1,217 +0,0 @@ -/* - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -*/ - -#include "ImagingImport.h" -#ifdef __cplusplus -namespace Imaging -{ - extern "C" - { -#endif - -#ifndef NULL - #define NULL 0 -#endif - -/* General Functions */ -TImGetVersion ImGetVersion = NULL; -TImInitImage ImInitImage = NULL; -TImNewImage ImNewImage = NULL; -TImTestImage ImTestImage = NULL; -TImFreeImage ImFreeImage = NULL; -TImDetermineFileFormat ImDetermineFileFormat = NULL; -TImDetermineMemoryFormat ImDetermineMemoryFormat = NULL; -TImIsFileFormatSupported ImIsFileFormatSupported = NULL; -TImEnumFileFormats ImEnumFileFormats = NULL; -/* Image List Functions */ -TImInitImageList ImInitImageList = NULL; -TImGetImageListSize ImGetImageListSize = NULL; -TImGetImageListElement ImGetImageListElement = NULL; -TImSetImageListSize ImSetImageListSize = NULL; -TImSetImageListElement ImSetImageListElement = NULL; -TImTestImagesInList ImTestImagesInList = NULL; -TImFreeImageList ImFreeImageList = NULL; -/* Loading Functions */ -TImLoadImageFromFile ImLoadImageFromFile = NULL; -TImLoadImageFromMemory ImLoadImageFromMemory = NULL; -TImLoadMultiImageFromFile ImLoadMultiImageFromFile = NULL; -TImLoadMultiImageFromMemory ImLoadMultiImageFromMemory = NULL; -/* Saving Functions */ -TImSaveImageToFile ImSaveImageToFile = NULL; -TImSaveImageToMemory ImSaveImageToMemory = NULL; -TImSaveMultiImageToFile ImSaveMultiImageToFile = NULL; -TImSaveMultiImageToMemory ImSaveMultiImageToMemory = NULL; -/* Manipulation Functions */ -TImCloneImage ImCloneImage = NULL; -TImConvertImage ImConvertImage = NULL; -TImFlipImage ImFlipImage = NULL; -TImMirrorImage ImMirrorImage = NULL; -TImResizeImage ImResizeImage = NULL; -TImSwapChannels ImSwapChannels = NULL; -TImReduceColors ImReduceColors = NULL; -TImGenerateMipMaps ImGenerateMipMaps = NULL; -TImMapImageToPalette ImMapImageToPalette = NULL; -TImSplitImage ImSplitImage = NULL; -TImMakePaletteForImages ImMakePaletteForImages = NULL; -TImRotateImage ImRotateImage = NULL; -/* Drawing/Pixel functions */ -TImCopyRect ImCopyRect = NULL; -TImFillRect ImFillRect = NULL; -TImReplaceColor ImReplaceColor = NULL; -TImStretchRect ImStretchRect = NULL; -TImGetPixelDirect ImGetPixelDirect = NULL; -TImSetPixelDirect ImSetPixelDirect = NULL; -TImGetPixel32 ImGetPixel32 = NULL; -TImSetPixel32 ImSetPixel32 = NULL; -TImGetPixelFP ImGetPixelFP = NULL; -TImSetPixelFP ImSetPixelFP = NULL; -/* Palette Functions */ -TImNewPalette ImNewPalette; -TImFreePalette ImFreePalette; -TImCopyPalette ImCopyPalette; -TImFindColor ImFindColor = NULL; -TImFillGrayscalePalette ImFillGrayscalePalette = NULL; -TImFillCustomPalette ImFillCustomPalette = NULL; -TImSwapChannelsOfPalette ImSwapChannelsOfPalette = NULL; -/* Options Functions */ -TImSetOption ImSetOption = NULL; -TImGetOption ImGetOption = NULL; -TImPopOptions ImPopOptions = NULL; -TImPushOptions ImPushOptions = NULL; -/* Image Format Functions */ -TImGetPixelBytes ImGetPixelBytes = NULL; -TImGetImageFormatInfo ImGetImageFormatInfo = NULL; -TImGetPixelsSize ImGetPixelsSize = NULL; -/* IO Functions */ -TImSetUserFileIO ImSetUserFileIO = NULL; -TImResetFileIO ImResetFileIO = NULL; - -TModuleHandle LibHandle = NULL; - -Boolean ImLoadLibrary(void) -{ - LibHandle = DllLoad(LibraryName); - if (!LibHandle) - return False; - - /* General Functions */ - ImGetVersion = (TImGetVersion)DllGet(LibHandle, "ImGetVersion"); - ImInitImage = (TImInitImage)DllGet(LibHandle, "ImInitImage"); - ImNewImage = (TImNewImage)DllGet(LibHandle, "ImNewImage"); - ImTestImage = (TImTestImage)DllGet(LibHandle, "ImTestImage"); - ImFreeImage = (TImFreeImage)DllGet(LibHandle, "ImFreeImage"); - ImDetermineFileFormat = (TImDetermineFileFormat)DllGet(LibHandle, "ImDetermineFileFormat"); - ImDetermineMemoryFormat = (TImDetermineMemoryFormat)DllGet(LibHandle, "ImDetermineMemoryFormat"); - ImIsFileFormatSupported = (TImIsFileFormatSupported)DllGet(LibHandle, "ImIsFileFormatSupported"); - ImEnumFileFormats = (TImEnumFileFormats)DllGet(LibHandle, "ImEnumFileFormats"); - /* Image List Functions */ - ImInitImageList = (TImInitImageList)DllGet(LibHandle, "ImInitImageList"); - ImGetImageListSize = (TImGetImageListSize)DllGet(LibHandle, "ImGetImageListSize"); - ImGetImageListElement = (TImGetImageListElement)DllGet(LibHandle, "ImGetImageListElement"); - ImSetImageListSize = (TImSetImageListSize)DllGet(LibHandle, "ImSetImageListSize"); - ImSetImageListElement = (TImSetImageListElement)DllGet(LibHandle, "ImSetImageListElement"); - ImTestImagesInList = (TImTestImagesInList)DllGet(LibHandle, "ImTestImagesInList"); - ImFreeImageList = (TImFreeImageList)DllGet(LibHandle, "ImFreeImageList"); - /* Loading Functions */ - ImLoadImageFromFile = (TImLoadImageFromFile)DllGet(LibHandle, "ImLoadImageFromFile"); - ImLoadImageFromMemory = (TImLoadImageFromMemory)DllGet(LibHandle, "ImLoadImageFromMemory"); - ImLoadMultiImageFromFile = (TImLoadMultiImageFromFile)DllGet(LibHandle, "ImLoadMultiImageFromFile"); - ImLoadMultiImageFromMemory = (TImLoadMultiImageFromMemory)DllGet(LibHandle, "ImLoadMultiImageFromMemory"); - /* Saving Functions */ - ImSaveImageToFile = (TImSaveImageToFile)DllGet(LibHandle, "ImSaveImageToFile"); - ImSaveImageToMemory = (TImSaveImageToMemory)DllGet(LibHandle, "ImSaveImageToMemory"); - ImSaveMultiImageToFile = (TImSaveMultiImageToFile)DllGet(LibHandle, "ImSaveMultiImageToFile"); - ImSaveMultiImageToMemory = (TImSaveMultiImageToMemory)DllGet(LibHandle, "ImSaveMultiImageToMemory"); - /* Manipulation Functions */ - ImCloneImage = (TImCloneImage)DllGet(LibHandle, "ImCloneImage"); - ImConvertImage = (TImConvertImage)DllGet(LibHandle, "ImConvertImage"); - ImFlipImage = (TImFlipImage)DllGet(LibHandle, "ImFlipImage"); - ImMirrorImage = (TImMirrorImage)DllGet(LibHandle, "ImMirrorImage"); - ImResizeImage = (TImResizeImage)DllGet(LibHandle, "ImResizeImage"); - ImSwapChannels = (TImSwapChannels)DllGet(LibHandle, "ImSwapChannels"); - ImReduceColors = (TImReduceColors)DllGet(LibHandle, "ImReduceColors"); - ImGenerateMipMaps = (TImGenerateMipMaps)DllGet(LibHandle, "ImGenerateMipMaps"); - ImMapImageToPalette = (TImMapImageToPalette)DllGet(LibHandle, "ImMapImageToPalette"); - ImSplitImage = (TImSplitImage)DllGet(LibHandle, "ImSplitImage"); - ImMakePaletteForImages = (TImMakePaletteForImages)DllGet(LibHandle, "ImMakePaletteForImages"); - ImRotateImage = (TImRotateImage)DllGet(LibHandle, "ImRotateImage"); - /* Drawing/Pixel functions */ - ImCopyRect = (TImCopyRect)DllGet(LibHandle, "ImCopyRect"); - ImFillRect = (TImFillRect)DllGet(LibHandle, "ImFillRect"); - ImReplaceColor = (TImReplaceColor)DllGet(LibHandle, "ImReplaceColor"); - ImStretchRect = (TImStretchRect)DllGet(LibHandle, "ImStretchRect"); - ImGetPixelDirect = (TImGetPixelDirect)DllGet(LibHandle, "ImGetPixelDirect"); - ImSetPixelDirect = (TImSetPixelDirect)DllGet(LibHandle, "ImSetPixelDirect"); - ImGetPixel32 = (TImGetPixel32)DllGet(LibHandle, "ImGetPixel32"); - ImSetPixel32 = (TImSetPixel32)DllGet(LibHandle, "ImSetPixel32"); - ImGetPixelFP = (TImGetPixelFP)DllGet(LibHandle, "ImGetPixelFP"); - ImSetPixelFP = (TImSetPixelFP)DllGet(LibHandle, "ImSetPixelFP"); - /* Palette Functions */ - ImNewPalette = (TImNewPalette)DllGet(LibHandle, "ImNewPalette"); - ImFreePalette = (TImFreePalette)DllGet(LibHandle, "ImFreePalette"); - ImCopyPalette = (TImCopyPalette)DllGet(LibHandle, "ImCopyPalette"); - ImFindColor = (TImFindColor)DllGet(LibHandle, "ImFindColor"); - ImFillGrayscalePalette = (TImFillGrayscalePalette)DllGet(LibHandle, "ImFillGrayscalePalette"); - ImFillCustomPalette = (TImFillCustomPalette)DllGet(LibHandle, "ImFillCustomPalette"); - ImSwapChannelsOfPalette = (TImSwapChannelsOfPalette)DllGet(LibHandle, "ImSwapChannelsOfPalette"); - /* Options Functions */ - ImSetOption = (TImSetOption)DllGet(LibHandle, "ImSetOption"); - ImGetOption = (TImGetOption)DllGet(LibHandle, "ImGetOption"); - ImPopOptions = (TImPopOptions)DllGet(LibHandle, "ImPopOptions"); - ImPushOptions = (TImPushOptions)DllGet(LibHandle, "ImPushOptions"); - /* Image Format Functions */ - ImGetPixelBytes = (TImGetPixelBytes)DllGet(LibHandle, "ImGetPixelBytes"); - ImGetImageFormatInfo = (TImGetImageFormatInfo)DllGet(LibHandle, "ImGetImageFormatInfo"); - ImGetPixelsSize = (TImGetPixelsSize)DllGet(LibHandle, "ImGetPixelsSize"); - /* IO Functions */ - ImSetUserFileIO = (TImSetUserFileIO)DllGet(LibHandle, "ImSetUserFileIO"); - ImResetFileIO = (TImResetFileIO)DllGet(LibHandle, "ImResetFileIO"); - - return True; -} - -Boolean ImFreeLibrary(void) -{ - if (DllFree(LibHandle)) - return True; - else - return False; -} - -#ifdef __cplusplus - } -} -#endif - -/* - Changes/Bug Fixes: - - -- 0.13 ----------------------------------------------------- - - file created with instances of extern variables from ImagingImport.h - and ImLoadLibrary/ImFreeLibrary functions - -*/ diff --git a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingImport.h b/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingImport.h deleted file mode 100644 index f0d9b5b..0000000 --- a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingImport.h +++ /dev/null @@ -1,241 +0,0 @@ -/* - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -*/ - -#ifndef IMAGINGIMPORT_H -#define IMAGINGIMPORT_H -#include "ImagingTypes.h" - -#ifdef __cplusplus -namespace Imaging -{ - extern "C" - { -#endif - -#if defined(__WIN32__) || defined(_WIN32) - #include - typedef HMODULE TModuleHandle; - #define LibraryName "VampyreImaging.dll" - #define DllLoad(A) LoadLibrary(A) - #define DllGet(A, B) GetProcAddress(A, B) - #define DllFree(A) FreeLibrary(A) -#elif defined (linux) || defined(__linux__) - #include - typedef void * TModuleHandle; - #define LibraryName "libVampyreImaging.so" - #define DllLoad(A) dlopen(A, RTLD_LAZY) - #define DllGet(A, B) dlsym(A, B) - #define DllFree(A) dlclose(A) -#endif - -/* Loads Imaging dynamic library, must be called before any other function. */ -extern Boolean ImLoadLibrary(void); -/* Frees Imaging library. */ -extern Boolean ImFreeLibrary(void); - -/* General Functions */ - -typedef void (ImagingAPI * TImGetVersion)(int * Major, int * Minor, int * Patch); -typedef void (ImagingAPI * TImInitImage)(PImageData Image); -typedef Boolean (ImagingAPI * TImNewImage)(int Width, int Height, TImageFormat Format, PImageData Image); -typedef Boolean (ImagingAPI * TImTestImage)(PImageData Image); -typedef Boolean (ImagingAPI * TImFreeImage)(PImageData Image); -typedef Boolean (ImagingAPI * TImDetermineFileFormat)(const char * FileName, char * Ext); -typedef Boolean (ImagingAPI * TImDetermineMemoryFormat)(const void * Data, int Size, char * Ext); -typedef Boolean (ImagingAPI * TImIsFileFormatSupported)(const char * FileName); -typedef Boolean (ImagingAPI * TImEnumFileFormats)(int * Index, char * Name, char * DefaultExt, char * Masks, Boolean * CanSave, Boolean * IsMultiImageFormat); - -extern TImGetVersion ImGetVersion; -extern TImInitImage ImInitImage; -extern TImNewImage ImNewImage; -extern TImTestImage ImTestImage; -extern TImFreeImage ImFreeImage; -extern TImDetermineFileFormat ImDetermineFileFormat; -extern TImDetermineMemoryFormat ImDetermineMemoryFormat; -extern TImIsFileFormatSupported ImIsFileFormatSupported; -extern TImEnumFileFormats ImEnumFileFormats; - -/* Image List Functions */ - -typedef Boolean (ImagingAPI * TImInitImageList)(int Size, PImageDataList ImageList); -typedef int (ImagingAPI * TImGetImageListSize)(PImageDataList ImageList); -typedef Boolean (ImagingAPI * TImGetImageListElement)(TImageDataList ImageList, int Index, PImageData OutImage); -typedef Boolean (ImagingAPI * TImSetImageListSize)(TImageDataList ImageList, int NewSize); -typedef Boolean (ImagingAPI * TImSetImageListElement)(TImageDataList ImageList, int Index, PImageData InImage); -typedef Boolean (ImagingAPI * TImTestImagesInList)(TImageDataList ImageList); -typedef Boolean (ImagingAPI * TImFreeImageList)(PImageDataList ImageList); - -extern TImInitImageList ImInitImageList; -extern TImGetImageListSize ImGetImageListSize; -extern TImGetImageListElement ImGetImageListElement; -extern TImSetImageListSize ImSetImageListSize; -extern TImSetImageListElement ImSetImageListElement; -extern TImTestImagesInList ImTestImagesInList; -extern TImFreeImageList ImFreeImageList; - -/* Loading Functions */ - -typedef Boolean (ImagingAPI * TImLoadImageFromFile)(const char * FileName, PImageData Image); -typedef Boolean (ImagingAPI * TImLoadImageFromMemory)(const void * Data, int Size, PImageData Image); -typedef Boolean (ImagingAPI * TImLoadMultiImageFromFile)(const char * FileName, PImageDataList ImageList); -typedef Boolean (ImagingAPI * TImLoadMultiImageFromMemory)(const void * Data, int Size, PImageDataList ImageList); - -extern TImLoadImageFromFile ImLoadImageFromFile; -extern TImLoadImageFromMemory ImLoadImageFromMemory; -extern TImLoadMultiImageFromFile ImLoadMultiImageFromFile; -extern TImLoadMultiImageFromMemory ImLoadMultiImageFromMemory; - -/* Saving Functions */ - -typedef Boolean (ImagingAPI * TImSaveImageToFile)(const char * FileName, PImageData Image); -typedef Boolean (ImagingAPI * TImSaveImageToMemory)(const char * Ext, void * Data, int * Size, PImageData Image); -typedef Boolean (ImagingAPI * TImSaveMultiImageToFile)(const char * FileName, TImageDataList ImageList); -typedef Boolean (ImagingAPI * TImSaveMultiImageToMemory)(const char * Ext, void * Data, int * Size, TImageDataList ImageList); - -extern TImSaveImageToFile ImSaveImageToFile; -extern TImSaveImageToMemory ImSaveImageToMemory; -extern TImSaveMultiImageToFile ImSaveMultiImageToFile; -extern TImSaveMultiImageToMemory ImSaveMultiImageToMemory; - -/* Manipulation Functions */ - -typedef Boolean (ImagingAPI * TImCloneImage)(PImageData Image, PImageData Clone); -typedef Boolean (ImagingAPI * TImConvertImage)(PImageData Image, TImageFormat DestFormat); -typedef Boolean (ImagingAPI * TImFlipImage)(PImageData Image); -typedef Boolean (ImagingAPI * TImMirrorImage)(PImageData Image); -typedef Boolean (ImagingAPI * TImResizeImage)(PImageData Image, int NewWidth, int NewHeight, TResizeFilter Filter); -typedef Boolean (ImagingAPI * TImSwapChannels)(PImageData Image, int SrcChannel, int DstChannel); -typedef Boolean (ImagingAPI * TImReduceColors)(PImageData Image, int MaxColors); -typedef Boolean (ImagingAPI * TImGenerateMipMaps)(PImageData Image, int Levels, PImageDataList MipMaps); -typedef Boolean (ImagingAPI * TImMapImageToPalette)(PImageData Image, PPalette32 Pal, int Entries); -typedef Boolean (ImagingAPI * TImSplitImage)(PImageData Image, PImageDataList Chunks, int ChunkWidth, int ChunkHeight, int * XChunks, int * YChunks, Boolean PreserveSize, const void * Fill); -typedef Boolean (ImagingAPI * TImMakePaletteForImages)(TImageDataList Images, PPalette32 Pal, int MaxColors, Boolean ConvertImages); -typedef Boolean (ImagingAPI * TImRotateImage)(PImageData Image, float Angle); - -extern TImCloneImage ImCloneImage; -extern TImConvertImage ImConvertImage; -extern TImFlipImage ImFlipImage; -extern TImMirrorImage ImMirrorImage; -extern TImResizeImage ImResizeImage; -extern TImSwapChannels ImSwapChannels; -extern TImReduceColors ImReduceColors; -extern TImGenerateMipMaps ImGenerateMipMaps; -extern TImMapImageToPalette ImMapImageToPalette; -extern TImSplitImage ImSplitImage; -extern TImMakePaletteForImages ImMakePaletteForImages; -extern TImRotateImage ImRotateImage; - -/* Drawing/Pixel functions */ - -typedef Boolean (ImagingAPI * TImCopyRect)(PImageData SrcImage, int SrcX, int SrcY, int Width, int Height, PImageData DstImage, int DstX, int DstY); -typedef Boolean (ImagingAPI * TImFillRect)(PImageData Image, int X, int Y, int Width, int Height, const void * Fill); -typedef Boolean (ImagingAPI * TImReplaceColor)(PImageData Image, int X, int Y, int Width, int Height, const void * OldPixel, const void * NewPixel); -typedef Boolean (ImagingAPI * TImStretchRect)(PImageData SrcImage, int SrcX, int SrcY, int SrcWidth, int SrcHeight, PImageData DstImage, int DstX, int DstY, int DstWidth, int DstHeight, TResizeFilter Filter); -typedef void (ImagingAPI * TImGetPixelDirect)(PImageData Image, int X, int Y, Pointer Pixel); -typedef void (ImagingAPI * TImSetPixelDirect)(PImageData Image, int X, int Y, Pointer Pixel); -typedef TColor32Rec (ImagingAPI * TImGetPixel32)(PImageData Image, int X, int Y); -typedef void (ImagingAPI * TImSetPixel32)(PImageData Image, int X, int Y, TColor32Rec Color); -typedef TColorFPRec (ImagingAPI * TImGetPixelFP)(PImageData Image, int X, int Y); -typedef void (ImagingAPI * TImSetPixelFP)(PImageData Image, int X, int Y, TColorFPRec Color); - -extern TImCopyRect ImCopyRect; -extern TImFillRect ImFillRect; -extern TImReplaceColor ImReplaceColor; -extern TImStretchRect ImStretchRect; -extern TImGetPixelDirect ImGetPixelDirect; -extern TImSetPixelDirect ImSetPixelDirect; -extern TImGetPixel32 ImGetPixel32; -extern TImSetPixel32 ImSetPixel32; -extern TImGetPixelFP ImGetPixelFP; -extern TImSetPixelFP ImSetPixelFP; - -/* Palette Functions */ - -typedef Boolean (ImagingAPI * TImNewPalette)(int Entries, PPalette32 * Pal); -typedef Boolean (ImagingAPI * TImFreePalette)(PPalette32 * Pal); -typedef Boolean (ImagingAPI * TImCopyPalette)(PPalette32 SrcPal, PPalette32 DstPal, int SrcIdx, int DstIdx, int Count); -typedef int (ImagingAPI * TImFindColor)(PPalette32 Pal, int Entries, TColor32 Color); -typedef Boolean (ImagingAPI * TImFillGrayscalePalette)(PPalette32 Pal, int Entries); -typedef Boolean (ImagingAPI * TImFillCustomPalette)(PPalette32 Pal, int Entries, Byte RBits, Byte GBits, Byte BBits, Byte Alpha); -typedef Boolean (ImagingAPI * TImSwapChannelsOfPalette)(PPalette32 Pal, int Entries, int SrcChannel, int DstChannel); - -extern TImNewPalette ImNewPalette; -extern TImFreePalette ImFreePalette; -extern TImCopyPalette ImCopyPalette; -extern TImFindColor ImFindColor; -extern TImFillGrayscalePalette ImFillGrayscalePalette; -extern TImFillCustomPalette ImFillCustomPalette; -extern TImSwapChannelsOfPalette ImSwapChannelsOfPalette; - -/* Options Functions */ - -typedef Boolean (ImagingAPI * TImSetOption)(int OptionId, int Value); -typedef int (ImagingAPI * TImGetOption)(int OptionId); -typedef Boolean (ImagingAPI * TImPushOptions)(void); -typedef Boolean (ImagingAPI * TImPopOptions)(void); - -extern TImSetOption ImSetOption; -extern TImGetOption ImGetOption; -extern TImPopOptions ImPopOptions; -extern TImPushOptions ImPushOptions; - -/* Image Format Functions */ - -typedef int (ImagingAPI * TImGetPixelBytes)(TImageFormat Format); -typedef Boolean (ImagingAPI * TImGetImageFormatInfo)(TImageFormat Format, PImageFormatInfo Info); -typedef int (ImagingAPI * TImGetPixelsSize)(TImageFormat Format, int Width, int Height); - -extern TImGetPixelBytes ImGetPixelBytes; -extern TImGetImageFormatInfo ImGetImageFormatInfo; -extern TImGetPixelsSize ImGetPixelsSize; - -/* IO Functions */ - -typedef Boolean (ImagingAPI * TImSetUserFileIO)(TOpenReadProc OpenReadProc, TOpenWriteProc OpenWriteProc, TCloseProc CloseProc, TEofProc EofProc, TSeekProc SeekProc, TTellProc TellProc, TReadProc ReadProc, TWriteProc WriteProc); -typedef Boolean (ImagingAPI * TImResetFileIO)(void); - -extern TImSetUserFileIO ImSetUserFileIO; -extern TImResetFileIO ImResetFileIO; - -#ifdef __cplusplus - } -} -#endif - -#endif - -/* - Changes/Bug Fixes: - - -- 0.21 ----------------------------------------------------- - - Updated to current DLL version. - - -- 0.15 ----------------------------------------------------- - - changed some parameter declarations in headers of some functions - because of changes in Imaging dll, mainly ImageDataList stuff - -*/ diff --git a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingTypes.h b/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingTypes.h deleted file mode 100644 index c162f63..0000000 --- a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Cpp/ImagingTypes.h +++ /dev/null @@ -1,320 +0,0 @@ -/* - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -*/ - -#ifndef IMAGINGTYPES_H -#define IMAGINGTYPES_H - -#ifdef __cplusplus -namespace Imaging -{ - extern "C" - { -#endif - -#pragma pack(push, 1) - -#if defined(__WIN32__) || defined(_WIN32) - #define ImagingAPI __cdecl -#elif defined (linux) || defined (__linux__) - #define ImagingAPI -#endif - -#define ImagingMajor 0 -#define ImagingMinor 26 -#define ImagingPatch 4 - -#define ImagingJpegQuality 10 -#define ImagingJpegProgressive 11 -#define ImagingBitmapRLE 12 -#define ImagingTargaRLE 13 -#define ImagingDDSLoadedCubeMap 14 -#define ImagingDDSLoadedVolume 15 -#define ImagingDDSLoadedMipMapCount 16 -#define ImagingDDSLoadedDepth 17 -#define ImagingDDSSaveCubeMap 18 -#define ImagingDDSSaveVolume 19 -#define ImagingDDSSaveMipMapCount 20 -#define ImagingDDSSaveDepth 21 -#define ImagingPNGPreFilter 25 -#define ImagingPNGCompressLevel 26 -#define ImagingMNGLossyCompression 28 -#define ImagingMNGLossyAlpha 29 -#define ImagingMNGPreFilter 30 -#define ImagingMNGCompressLevel 31 -#define ImagingMNGQuality 32 -#define ImagingMNGProgressive 33 -#define ImagingJNGLossyAlpha 40 -#define ImagingJNGAlphaPreFilter 41 -#define ImagingJNGAlphaCompressLevel 42 -#define ImagingJNGQuality 43 -#define ImagingJNGProgressive 44 - -#define ImagingJpeg2000Quality 55; -#define ImagingJpeg2000CodeStreamOnly 56; -#define ImagingJpeg2000LosslessCompression 57; -#define ImagingTiffCompression 65; - -#define ImagingColorReductionMask 128 -#define ImagingLoadOverrideFormat 129 -#define ImagingSaveOverrideFormat 130 -#define ImagingMipMapFilter 131 - -#define InvalidOption -0x7FFFFFFF - -#define ChannelBlue 0 -#define ChannelGreen 1 -#define ChannelRed 2 -#define ChannelAlpha 3 - -#define False 0 -#define True 1 - -typedef unsigned char Byte; -typedef Byte Boolean; -typedef unsigned short Word; -typedef unsigned long LongWord; -typedef void * Pointer; - -typedef enum TImageFormat -{ - ifUnknown = 0, - ifDefault = 1, - /* indexed formats */ - ifIndex8 = 10, - /* grayscale formats */ - ifGray8 = 40, - ifA8Gray8 = 41, - ifGray16 = 42, - ifGray32 = 43, - ifGray64 = 44, - ifA16Gray16 = 45, - /* ARGB formats */ - ifR1G1B1 = 80, - ifR3G3B2 = 81, - ifR5G6B5 = 82, - ifA1R5G5B5 = 83, - ifA4R4G4B4 = 84, - ifX1R5G5B5 = 85, - ifX4R4G4B4 = 86, - ifR8G8B8 = 87, - ifA8R8G8B8 = 88, - ifX8R8G8B8 = 89, - ifR16G16B16 = 90, - ifA16R16G16B16 = 91, - ifB16G16R16 = 92, - ifA16B16G16R16 = 93, - /* floating-point formats */ - ifR32F = 170, - ifA32R32G32B32F = 171, - ifA32B32G32R32F = 172, - ifR16F = 173, - ifA16R16G16B16F = 174, - ifA16B16G16R16F = 175, - /* special formats */ - ifDXT1 = 220, - ifDXT3 = 221, - ifDXT5 = 222, - ifBTC = 223, - /* dummy */ - ifForce32 = 0x7FFFFFFF -} TImageFormat; - -typedef unsigned long TColor32; -typedef struct TColor64 -{ - TColor32 Low; - TColor32 High; -} TColor64; - -typedef struct TColor24Rec -{ - union - { - struct - { - Byte B; - Byte G; - Byte R; - }; - Byte Channels[3]; - }; -} TColor24Rec; - -typedef struct TColor32Rec -{ - union - { - struct - { - Byte B; - Byte G; - Byte R; - Byte A; - }; - TColor32 Color; - Byte Channels[4]; - }; -} TColor32Rec; - -typedef struct TColor48Rec -{ - union - { - struct - { - Word B; - Word G; - Word R; - }; - Word Channels[3]; - }; -} TColor48Rec; - -typedef struct TColor64Rec -{ - union - { - struct - { - Word B; - Word G; - Word R; - Word A; - - }; - TColor64 Color; - Word Channels[4]; - }; -} TColor64Rec; - -typedef struct TColorFPRec -{ - union - { - struct - { - float B; - float G; - float R; - float A; - }; - float Channels[4]; - }; -} TColorFPRec; - -typedef TColor32Rec * PPalette32; - -typedef struct TImageData -{ - int Width; - int Height; - TImageFormat Format; - int Size; - void * Bits; - PPalette32 Palette; -} TImageData; - -typedef TImageData * PImageData; - -typedef struct TPixelFormat -{ - Byte ABitCount, RBitCount, GBitCount, BBitCount; - LongWord ABitMask, RBitMask, GBitMask, BBitMask; - Byte AShift, RShift, GShift, BShift; - Byte ARecDiv, RRecDiv, GRecDiv, BRecDiv; -} TPixelFormat; - -typedef TPixelFormat * PPixelFormat; - -typedef struct TImageFormatInfo -{ - TImageFormat Format; - char Name[16]; - Byte BytesPerPixel; - int PaletteEntries; - Boolean HasGrayChannel; - Boolean HasAlphaChannel; - Boolean IsFloatingPoint; - Boolean UsePixelFormat; - Boolean IsRBSwapped; - Boolean IsIndexed; - Boolean IsSpecial; - PPixelFormat PixelFormat; - Pointer GetPixelsSize; - Pointer CheckDimensions; - Pointer GetPixel32; - Pointer GetPixelFP; - Pointer SetPixel32; - Pointer SetPixelFP; -} TImageFormatInfo; - -typedef TImageFormatInfo * PImageFormatInfo; - -typedef unsigned long TImageDataList; -typedef TImageDataList * PImageDataList; - -typedef Pointer TImagingHandle; - -typedef enum TResizeFilter -{ - rfNearest = 0, - rfBilinear = 1, - rfBicubic = 2 -} TResizeFilter; - -typedef enum TSeekMode -{ - smFromBeginning = 0, - smFromCurrent = 1, - smFromEnd = 2 -} TSeekMode; - -typedef TImagingHandle (ImagingAPI * TOpenReadProc) (char * Source); -typedef TImagingHandle (ImagingAPI * TOpenWriteProc) (char * Source); -typedef void (ImagingAPI * TCloseProc) (TImagingHandle Handle); -typedef Boolean (ImagingAPI * TEofProc) (TImagingHandle Handle); -typedef int (ImagingAPI * TSeekProc) (TImagingHandle Handle, int Offset, TSeekMode Mode); -typedef int (ImagingAPI * TTellProc) (TImagingHandle Handle); -typedef int (ImagingAPI * TReadProc) (TImagingHandle Handle, Pointer Buffer, int Count); -typedef int (ImagingAPI * TWriteProc) (TImagingHandle Handle, Pointer Buffer, int Count); - -#ifdef __cplusplus - } -} -#endif - -#pragma pack(pop) - -#endif - -/* - Changes/Bug Fixes: - - -- 0.21 ----------------------------------------------------- - - Added ifForce32 to TImageFormat to ensure that this enum has size of 4 bytes. - -*/ diff --git a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Delphi.NET/ImagingNET.pas b/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Delphi.NET/ImagingNET.pas deleted file mode 100644 index ad2b95b..0000000 --- a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Delphi.NET/ImagingNET.pas +++ /dev/null @@ -1,1468 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This is import wrapper for Delphi.NET. You need VampyreImaging.dll - located somewhere Windows can find it. You can use functions directly - imported from DLL or much more dotNET-like Imaging class members. - - Note that this wrapper was not tested extensively so there may be various bugs.} -unit ImagingNET; - -{$MINENUMSIZE 4} - -interface - -uses - System.Runtime.InteropServices, System.Security, System.Text, SysUtils; - -const - ImagingVersionMajor = 0; - ImagingVersionMinor = 24; - ImagingVersionPatch = 0; - - ImagingJpegQuality = 10; - ImagingJpegProgressive = 11; - ImagingBitmapRLE = 12; - ImagingTargaRLE = 13; - ImagingDDSLoadedCubeMap = 14; - ImagingDDSLoadedVolume = 15; - ImagingDDSLoadedMipMapCount = 16; - ImagingDDSLoadedDepth = 17; - ImagingDDSSaveCubeMap = 18; - ImagingDDSSaveVolume = 19; - ImagingDDSSaveMipMapCount = 20; - ImagingDDSSaveDepth = 21; - ImagingPNGPreFilter = 25; - ImagingPNGCompressLevel = 26; - ImagingMNGLossyCompression = 28; - ImagingMNGLossyAlpha = 29; - ImagingMNGPreFilter = 30; - ImagingMNGCompressLevel = 31; - ImagingMNGQuality = 32; - ImagingMNGProgressive = 33; - ImagingJNGLossyAlpha = 40; - ImagingJNGAlphaPreFilter = 41; - ImagingJNGAlphaCompressLevel = 42; - ImagingJNGQuality = 43; - ImagingJNGProgressive = 44; - ImagingPGMSaveBinary = 50; - ImagingPPMSaveBinary = 51; - - ImagingJpeg2000Quality = 55; - ImagingJpeg2000CodeStreamOnly = 56; - ImagingJpeg2000LosslessCompression = 57; - ImagingJpeg2000ScaleOutput = 58; - ImagingTiffCompression = 65; - - ImagingColorReductionMask = 128; - ImagingLoadOverrideFormat = 129; - ImagingSaveOverrideFormat = 130; - ImagingMipMapFilter = 131; - - InvalidOption = -$7FFFFFFF; - - ChannelBlue = 0; - ChannelGreen = 1; - ChannelRed = 2; - ChannelAlpha = 3; - -type - TImageFormat = ( - ifUnknown = 0, - ifDefault = 1, - // indexed formats using palette - ifIndex8 = 10, - // grayscale formats - ifGray8 = 40, - ifA8Gray8 = 41, - ifGray16 = 42, - ifGray32 = 43, - ifGray64 = 44, - ifA16Gray16 = 45, - // ARGB formats - ifX5R1G1B1 = 80, - ifR3G3B2 = 81, - ifR5G6B5 = 82, - ifA1R5G5B5 = 83, - ifA4R4G4B4 = 84, - ifX1R5G5B5 = 85, - ifX4R4G4B4 = 86, - ifR8G8B8 = 87, - ifA8R8G8B8 = 88, - ifX8R8G8B8 = 89, - ifR16G16B16 = 90, - ifA16R16G16B16 = 91, - ifB16G16R16 = 92, - ifA16B16G16R16 = 93, - // floating point formats - ifR32F = 170, - ifA32R32G32B32F = 171, - ifA32B32G32R32F = 172, - ifR16F = 173, - ifA16R16G16B16F = 174, - ifA16B16G16R16F = 175, - // special formats - ifDXT1 = 220, - ifDXT3 = 221, - ifDXT5 = 222, - ifBTC = 223); - - TColor32 = UInt32; - TColor64 = UInt64; - - TPalette32 = IntPtr; - TImageDataList = UInt32; - - [StructLayout(LayoutKind.Sequential)] - TImageData = packed record - Width: LongInt; - Height: LongInt; - Format: TImageFormat; - Size: LongInt; - Bits: IntPtr; - Palette: TPalette32; - end; - - [StructLayout(LayoutKind.Sequential)] - TImageFormatInfo = packed record - Format: TImageFormat; - [MarshalAs(UnmanagedType.ByValTStr, SizeConst = 16)] - Name: string; - BytesPerPixel: Byte; - PaletteEntries: LongInt; - HasGrayChannel: Boolean; - HasAlphaChannel: Boolean; - IsFloatingPoint: Boolean; - UsePixelFormat: Boolean; - IsRBSwapped: Boolean; - IsIndexed: Boolean; - IsSpecial: Boolean; - PixelFormat: IntPtr; - GetPixelsSize: IntPtr; - CheckDimensions: IntPtr; - GetPixel32: IntPtr; - GetPixelFP: IntPtr; - SetPixel32: IntPtr; - SetPixelFP: IntPtr; - end; - - TResizeFilter = ( - rfNearest = 0, - rfBilinear = 1, - rfBicubic = 2); - - TColor24Rec = record; - TColor32Rec = record; - TColor48Rec = record; - TColor64Rec = record; - TColorFPRec = record; - - TColor24Rec = packed record - public - B, G, R: Byte; - function SetColor(Color: TColor32): TColor24Rec; overload; - function SetColor(R, G, B: Byte): TColor24Rec; overload; - function SetColor(ColorRec: TColor24Rec): TColor24Rec; overload; - function SetColor(ColorRec: TColor32Rec): TColor24Rec; overload; - function SetColor(ColorRec: TColor48Rec): TColor24Rec; overload; - function SetColor(ColorRec: TColor64Rec): TColor24Rec; overload; - function SetColor(ColorRec: TColorFPRec): TColor24Rec; overload; - function GetColor: TColor32; - class operator Equal(const Left, Right: TColor24Rec): Boolean; - class operator NotEqual(const Left, Right: TColor24Rec): Boolean; - end; - - TColor32Rec = packed record - public - B, G, R, A: Byte; - function SetColor(Color: TColor32): TColor32Rec; overload; - function SetColor(A, R, G, B: Byte): TColor32Rec; overload; - function SetColor(ColorRec: TColor24Rec): TColor32Rec; overload; - function SetColor(ColorRec: TColor32Rec): TColor32Rec; overload; - function SetColor(ColorRec: TColor48Rec): TColor32Rec; overload; - function SetColor(ColorRec: TColor64Rec): TColor32Rec; overload; - function SetColor(ColorRec: TColorFPRec): TColor32Rec; overload; - function GetColor: TColor32; - class operator Equal(const Left, Right: TColor32Rec): Boolean; - class operator NotEqual(const Left, Right: TColor32Rec): Boolean; - end; - - TColor48Rec = packed record - public - B, G, R: Word; - function SetColor(Color: TColor64): TColor48Rec; overload; - function SetColor(R, G, B: Word): TColor48Rec; overload; - function SetColor(ColorRec: TColor24Rec): TColor48Rec; overload; - function SetColor(ColorRec: TColor32Rec): TColor48Rec; overload; - function SetColor(ColorRec: TColor48Rec): TColor48Rec; overload; - function SetColor(ColorRec: TColor64Rec): TColor48Rec; overload; - function SetColor(ColorRec: TColorFPRec): TColor48Rec; overload; - function GetColor: TColor64; - class operator Equal(const Left, Right: TColor48Rec): Boolean; - class operator NotEqual(const Left, Right: TColor48Rec): Boolean; - end; - - TColor64Rec = packed record - public - B, G, R, A: Word; - function SetColor(Color: TColor64): TColor64Rec; overload; - function SetColor(A, R, G, B: Word): TColor64Rec; overload; - function SetColor(ColorRec: TColor24Rec): TColor64Rec; overload; - function SetColor(ColorRec: TColor32Rec): TColor64Rec; overload; - function SetColor(ColorRec: TColor48Rec): TColor64Rec; overload; - function SetColor(ColorRec: TColor64Rec): TColor64Rec; overload; - function SetColor(ColorRec: TColorFPRec): TColor64Rec; overload; - function GetColor: TColor64; - class operator Equal(const Left, Right: TColor64Rec): Boolean; - class operator NotEqual(const Left, Right: TColor64Rec): Boolean; - end; - - TColorFPRec = packed record - public - B, G, R, A: Single; - function SetColor(Color: TColor64): TColorFPRec; overload; - function SetColor(A, R, G, B: Single): TColorFPRec; overload; - function SetColor(ColorRec: TColor24Rec): TColorFPRec; overload; - function SetColor(ColorRec: TColor32Rec): TColorFPRec; overload; - function SetColor(ColorRec: TColor48Rec): TColorFPRec; overload; - function SetColor(ColorRec: TColor64Rec): TColorFPRec; overload; - function SetColor(ColorRec: TColorFPRec): TColorFPRec; overload; - function GetColor: TColor64; - class operator Equal(const Left, Right: TColorFPRec): Boolean; - class operator NotEqual(const Left, Right: TColorFPRec): Boolean; - end; - - TDynImageDataArray = array of TImageData; - -const - LibraryName = 'VampyreImaging.dll'; - -{ Low Level Imported Functions } - -{ General Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -procedure ImGetVersion(var Major, Minor, Patch: LongInt); external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -procedure ImInitImage(var Image: TImageData); external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImNewImage(Width, Height: LongInt; Format: TImageFormat; - var Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImTestImage(const Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFreeImage(var Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImDetermineFileFormat(const FileName: string; Ext: StringBuilder): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImDetermineMemoryFormat(Data: array of Byte; Size: LongInt; Ext: StringBuilder): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImIsFileFormatSupported(const FileName: string): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: StringBuilder; - var CanSave, IsMultiImageFormat: Boolean): Boolean; external; - -{ Image List Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetImageListSize(ImageList: TImageDataList): LongInt; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt; - var OutImage: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt; - var InImage: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImTestImagesInList(ImageList: TImageDataList): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFreeImageList(var ImageList: TImageDataList): Boolean; external; - -{ Loading Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImLoadImageFromFile(const FileName: string; var Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImLoadImageFromMemory(const Data: array of Byte; Size: LongInt; - var Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImLoadMultiImageFromFile(const FileName: string; var ImageList: TImageDataList): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImLoadMultiImageFromMemory(const Data: array of Byte; Size: LongInt; - var ImageList: TImageDataList): Boolean; external; - -{ Saving Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSaveImageToFile(const FileName: string; const Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSaveImageToMemory(const Ext: string; const Data: array of Byte; var Size: LongInt; - const Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSaveMultiImageToFile(const FileName: string; ImageList: TImageDataList): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSaveMultiImageToMemory(const Ext: string; const Data: array of Byte; var Size: LongInt; - ImageList: TImageDataList): Boolean; external; - -{ Manipulation Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFlipImage(var Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImMirrorImage(var Image: TImageData): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; Filter: TResizeFilter): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt; - var MipMaps: TImageDataList): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImMapImageToPalette(var Image: TImageData; Pal: TPalette32; - Entries: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList; - ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; - PreserveSize: Boolean; Fill: IntPtr): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImMakePaletteForImages(var Images: TImageDataList; Pal: TPalette32; - MaxColors: LongInt; ConvertImages: Boolean): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; external; - -{ Drawing/Pixel functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; - var DstImage: TImageData; DstX, DstY: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt; - Fill: IntPtr): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt; - OldPixel, NewPixel: IntPtr): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TResizeFilter): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: IntPtr); external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: IntPtr); external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); external; - -{ Palette Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImNewPalette(Entries: LongInt; var Pal: TPalette32): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFreePalette(var Pal: TPalette32): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImCopyPalette(SrcPal, DstPal: TPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFindColor(Pal: TPalette32; Entries: LongInt; Color: TColor32): LongInt; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFillGrayscalePalette(Pal: TPalette32; Entries: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImFillCustomPalette(Pal: TPalette32; Entries: LongInt; RBits, GBits, - BBits: Byte; Alpha: Byte): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSwapChannelsOfPalette(Pal: TPalette32; Entries, SrcChannel, - DstChannel: LongInt): Boolean; external; - -{ Options Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImSetOption(OptionId, Value: LongInt): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetOption(OptionId: LongInt): LongInt; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImPushOptions: Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImPopOptions: Boolean; external; - -{ Image Format Functions } - -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetPixelBytes(Format: TImageFormat): LongInt; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; external; -[SuppressUnmanagedCodeSecurity, DllImport(LibraryName, CallingConvention = CallingConvention.Cdecl)] -function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; external; - -type - { Record with information about one of imag file formats supported by Imaging.} - TFileFormatInfo = record - Name: string; - DefaultExt: string; - Masks: string; - CanSave: Boolean; - IsMultiImageFormat: Boolean; - end; - - { Class which encapsulates all Imaging functions without Im prefix and - with dotNET friendly parameter types. There are also some dotNET only - members.} - Imaging = class(TObject) - public - class var FileFormats: array of TFileFormatInfo; - class procedure BuildFileFormatList; - class function EnumFileFormats(var Index: LongInt; var Name, DefaultExt, Masks: string; var CanSave, IsMultiImageFormat: Boolean): Boolean; static; - class function ListToArray(List: TImageDataList; var Arr: TDynImageDataArray): Boolean; static; - class function ArrayToList(const Arr: TDynImageDataArray; var List: TImageDataList): Boolean; static; - public - { General Functions } - class procedure GetVersion(var Major, Minor, Patch: LongInt); static; - class procedure InitImage(var Image: TImageData); static; - class function NewImage(Width, Height: LongInt; Format: TImageFormat; var Image: TImageData): Boolean; static; - class function TestImage(const Image: TImageData): Boolean; static; - class function FreeImage(var Image: TImageData): Boolean; static; - class function FreeImagesInArray(var Images: TDynImageDataArray): Boolean; static; - class function TestImagesInArray(const Images: TDynImageDataArray): Boolean; static; - class function DetermineFileFormat(const FileName: string): string; static; - class function DetermineMemoryFormat(const Data: array of Byte): string; static; - class function IsFileFormatSupported(const FileName: string): Boolean; static; - class function GetFileFormatCount: LongInt; static; - class function GetFileFormatInfo(Index: LongInt): TFileFormatInfo; static; - class function GetImageFileFormatsFilter(OpenFileFilter: Boolean): string; static; - { Loading Functions } - class function LoadImageFromFile(const FileName: string; var Image: TImageData): Boolean; static; - class function LoadImageFromMemory(const Data: array of Byte; var Image: TImageData): Boolean; static; - class function LoadMultiImageFromFile(const FileName: string; var Images: TDynImageDataArray): Boolean; static; - class function LoadMultiImageFromMemory(const Data: array of Byte; var Images: TDynImageDataArray): Boolean; static; - { Saving Functions } - class function SaveImageToFile(const FileName: string; const Image: TImageData): Boolean; static; - class function SaveImageToMemory(const Ext: string; Data: array of Byte; var Size: LongInt; const Image: TImageData): Boolean; static; - class function SaveMultiImageToFile(const FileName: string; const Images: TDynImageDataArray): Boolean; static; - class function SaveMultiImageToMemory(const Ext: string; Data: array of Byte; var Size: LongInt; const Images: TDynImageDataArray): Boolean; static; - { Manipulation Functions } - class function CloneImage(const Image: TImageData; var Clone: TImageData): Boolean; static; - class function ConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; static; - class function FlipImage(var Image: TImageData): Boolean; static; - class function MirrorImage(var Image: TImageData): Boolean; static; - class function ResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; Filter: TResizeFilter): Boolean; static; - class function SwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; static; - class function ReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; static; - class function GenerateMipMaps(const Image: TImageData; Levels: LongInt; var MipMaps: TDynImageDataArray): Boolean; static; - class function MapImageToPalette(var Image: TImageData; Pal: TPalette32; Entries: LongInt): Boolean; static; - class function SplitImage(var Image: TImageData; var Chunks: TDynImageDataArray; ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; PreserveSize: Boolean; Fill: TObject): Boolean; static; - class function MakePaletteForImages(var Images: TDynImageDataArray; Pal: TPalette32; MaxColors: LongInt; ConvertImages: Boolean): Boolean; static; - class function RotateImage(var Image: TImageData; Angle: Single): Boolean; static; - { Drawing/Pixel functions } - class function CopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; var DstImage: TImageData; DstX, DstY: LongInt): Boolean; static; - class function FillRect(var Image: TImageData; X, Y, Width, Height: LongInt; Fill: TObject): Boolean; static; - class function ReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt; OldPixel, NewPixel: TObject): Boolean; static; - class function StretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter): Boolean; static; - class procedure GetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: TObject); static; - class procedure SetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: TObject); static; - class function GetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; static; - class procedure SetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); static; - class function GetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; static; - class procedure SetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); static; - { Palette Functions } - class function NewPalette(Entries: LongInt; var Pal: TPalette32): Boolean; static; - class function FreePalette(var Pal: TPalette32): Boolean; static; - class function CopyPalette(SrcPal, DstPal: TPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; static; - class function FindColor(Pal: TPalette32; Entries: LongInt; Color: TColor32): LongInt; static; - class function FillGrayscalePalette(Pal: TPalette32; Entries: LongInt): Boolean; static; - class function FillCustomPalette(Pal: TPalette32; Entries: LongInt; RBits, GBits, BBits: Byte; Alpha: Byte): Boolean; static; - class function SwapChannelsOfPalette(Pal: TPalette32; Entries, SrcChannel, DstChannel: LongInt): Boolean; static; - { dotNET only} - class function GetPaletteColor(Pal: TPalette32; Index: LongInt): TColor32; static; - class procedure SetPaletteColor(Pal: TPalette32; Index: LongInt; Color: TColor32); static; - { Options Functions } - class function SetOption(OptionId, Value: LongInt): Boolean; static; - class function GetOption(OptionId: LongInt): LongInt; static; - class function PushOptions: Boolean; static; - class function PopOptions: Boolean; static; - { Image Format Functions } - class function GetPixelBytes(Format: TImageFormat): LongInt; static; - class function GetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; static; - class function GetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; static; - end; - -implementation - -{ Imaging private methods } - -class function Imaging.ListToArray(List: TImageDataList; var Arr: TDynImageDataArray): Boolean; -var - Img: TImageData; - I, Size: LongInt; -begin - Result := True; - Size := ImGetImageListSize(List); - FreeImagesInArray(Arr); - SetLength(Arr, Size); - for I := 0 to Size - 1 do - begin - Result := Result and ImGetImageListElement(List, I, Img); - Arr[I] := Img; - if not Result then Break; - end; -end; - -class function Imaging.ArrayToList(const Arr: TDynImageDataArray; var List: TImageDataList): Boolean; -var - Img: TImageData; - I, Size: LongInt; -begin - Size := Length(Arr); - Result := ImInitImageList(Size, List); - for I := 0 to Size - 1 do - begin - Img := Arr[I]; - Result := Result and ImSetImageListElement(List, I, Img); - if not Result then Break; - end; -end; - -{ Imaging public methods } - -class procedure Imaging.GetVersion(var Major, Minor, Patch: LongInt); -begin - ImGetVersion(Major, Minor, Patch); -end; - -class procedure Imaging.InitImage(var Image: TImageData); -begin - ImInitImage(Image); -end; - -class function Imaging.IsFileFormatSupported(const FileName: string): Boolean; -begin - Result := IsFileFormatSupported(FileName); -end; - -class function Imaging.NewImage(Width, Height: LongInt; Format: TImageFormat; var Image: TImageData): Boolean; -begin - Result := ImNewImage(Width, Height, Format, Image); -end; - -class function Imaging.TestImage(const Image: TImageData): Boolean; -begin - Result := ImTestImage(Image); -end; - -class function Imaging.FreeImage(var Image: TImageData): Boolean; -begin - Result := ImFreeImage(Image); -end; - -class function Imaging.FreeImagesInArray(var Images: TDynImageDataArray): Boolean; -var - I: LongInt; -begin - Result := True; - for I := 0 to Length(Images) - 1 do - Result := Result and ImFreeImage(Images[I]); -end; - -class function Imaging.TestImagesInArray(const Images: TDynImageDataArray): Boolean; -var - I: LongInt; -begin - Result := True; - for I := 0 to Length(Images) - 1 do - begin - Result := Result and ImTestImage(Images[I]); - if not Result then Break; - end; -end; - -const - ExtLen = 16; - -class function Imaging.DetermineFileFormat(const FileName: string): string; -var - Builder: StringBuilder; -begin - Builder := StringBuilder.Create(ExtLen); - if ImDetermineFileFormat(FileName, Builder) then - Result := Builder.ToString - else - Result := ''; -end; - -class function Imaging.DetermineMemoryFormat(const Data: array of Byte): string; -var - Builder: StringBuilder; -begin - Builder := StringBuilder.Create(ExtLen); - if ImDetermineMemoryFormat(Data, Length(Data), Builder) then - Result := Builder.ToString - else - Result := ''; -end; - -class function Imaging.EnumFileFormats(var Index: Integer; var Name, DefaultExt, - Masks: string; var CanSave, IsMultiImageFormat: Boolean): Boolean; -var - AName, AExt, AMasks: StringBuilder; -begin - AName := StringBuilder.Create(128); - AExt := StringBuilder.Create(ExtLen); - AMasks := StringBuilder.Create(256); - - Result := ImEnumFileFormats(Index, AName, AExt, AMasks, CanSave, IsMultiImageFormat); - // TODO: Result always is True, even if DLL function explicitly returns False. WTF? - // So this check is added to ensure enumerating will end some time. - Result := Result and (AName.Length > 0); - - Name := AName.ToString; - DefaultExt := AExt.ToString; - Masks := AMasks.ToString; -end; - -class function Imaging.LoadImageFromFile(const FileName: string; var Image: TImageData): Boolean; -begin - Result := ImLoadImageFromFile(FileName, Image); -end; - -class function Imaging.LoadImageFromMemory(const Data: array of Byte; var Image: TImageData): Boolean; -begin - Result := ImLoadImageFromMemory(Data, Length(Data), Image); -end; - -class function Imaging.LoadMultiImageFromFile(const FileName: string; var Images: TDynImageDataArray): Boolean; -var - List: TImageDataList; -begin - Result := ImLoadMultiImageFromFile(FileName, List); - if Result then - begin - FreeImagesInArray(Images); - Result := ListToArray(List, Images); - ImFreeImageList(List); - end; -end; - -class function Imaging.LoadMultiImageFromMemory(const Data: array of Byte; var Images: TDynImageDataArray): Boolean; -var - List: TImageDataList; -begin - Result := ImLoadMultiImageFromMemory(Data, Length(Data), List); - if Result then - begin - FreeImagesInArray(Images); - Result := ListToArray(List, Images); - ImFreeImageList(List); - end; -end; - -class function Imaging.SaveImageToFile(const FileName: string; const Image: TImageData): Boolean; -begin - Result := ImSaveImageToFile(FileName, Image); -end; - -class function Imaging.SaveImageToMemory(const Ext: string; Data: array of Byte; var Size: LongInt; const Image: TImageData): Boolean; -begin - Size := Length(Data); - Result := ImSaveImageToMemory(Ext, Data, Size, Image); -end; - -class function Imaging.SaveMultiImageToFile(const FileName: string; const Images: TDynImageDataArray): Boolean; -var - List: TImageDataList; -begin - Result := ArrayToList(Images, List); - if Result then - begin - Result := ImSaveMultiImageToFile(FileName, List); - ImFreeImageList(List); - end; -end; - -class function Imaging.SaveMultiImageToMemory(const Ext: string; Data: array of Byte; var Size: LongInt; const Images: TDynImageDataArray): Boolean; -var - List: TImageDataList; -begin - Result := ArrayToList(Images, List); - if Result then - begin - Size := Length(Data); - Result := ImSaveMultiImageToMemory(Ext, Data, Size, List); - ImFreeImageList(List); - end; -end; - -class procedure Imaging.BuildFileFormatList; -var - I: LongInt; -begin - I := 0; - SetLength(FileFormats, 1); - while Imaging.EnumFileFormats(I, FileFormats[I].Name, FileFormats[I].DefaultExt, - FileFormats[I].Masks, FileFormats[I].CanSave, FileFormats[I].IsMultiImageFormat) do - begin - SetLength(FileFormats, I + 1); - end; - SetLength(FileFormats, I); -end; - -class function Imaging.CloneImage(const Image: TImageData; var Clone: TImageData): Boolean; -begin - Result := ImCloneImage(Image, Clone); -end; - -class function Imaging.ConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; -begin - Result := ImConvertImage(Image, DestFormat); -end; - -class function Imaging.FlipImage(var Image: TImageData): Boolean; -begin - Result := ImFlipImage(Image); -end; - -class function Imaging.MirrorImage(var Image: TImageData): Boolean; -begin - Result := ImMirrorImage(Image); -end; - -class function Imaging.ResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; Filter: TResizeFilter): Boolean; -begin - Result := ImResizeImage(Image, NewWidth, NewHeight, Filter); -end; - -class function Imaging.SwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; -begin - Result := ImSwapChannels(Image, SrcChannel, DstChannel); -end; - -class function Imaging.ReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; -begin - Result := ImReduceColors(Image, MaxColors); -end; - -class function Imaging.GenerateMipMaps(const Image: TImageData; Levels: LongInt; var MipMaps: TDynImageDataArray): Boolean; -var - List: TImageDataList; -begin - Result := ImGenerateMipMaps(Image, Levels, List); - if Result then - begin - FreeImagesInArray(MipMaps); - Result := ListToArray(List, MipMaps); - ImFreeImageList(List); - end; -end; - -class function Imaging.MapImageToPalette(var Image: TImageData; Pal: TPalette32; Entries: LongInt): Boolean; -begin - Result := ImMapImageToPalette(Image, Pal, Entries); -end; - -class function Imaging.SplitImage(var Image: TImageData; var Chunks: TDynImageDataArray; ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; PreserveSize: Boolean; Fill: TObject): Boolean; -var - Ptr: IntPtr; - List: TImageDataList; -begin - Ptr := Marshal.AllocHGlobal(Marshal.SizeOf(Fill)); - Marshal.StructureToPtr(Fill, Ptr, False); - Result := ImSplitImage(Image, List, ChunkWidth, ChunkHeight, XChunks, YChunks, - PreserveSize, Ptr); - if Result then - begin - FreeImagesInArray(Chunks); - Result := ListToArray(List, Chunks); - ImFreeImageList(List); - end; - Marshal.FreeHGlobal(Ptr); -end; - -class function Imaging.MakePaletteForImages(var Images: TDynImageDataArray; Pal: TPalette32; MaxColors: LongInt; ConvertImages: Boolean): Boolean; -var - List: TImageDataList; -begin - Result := ArrayToList(Images, List); - if Result then - begin - Result := ImMakePaletteForImages(List, Pal, MaxColors, ConvertImages); - Result := Result and ListToArray(List, Images); - ImFreeImageList(List); - end; -end; - -class function Imaging.RotateImage(var Image: TImageData; Angle: Single): Boolean; -begin - Result := ImRotateImage(Image, Angle); -end; - -class function Imaging.CopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; var DstImage: TImageData; DstX, DstY: LongInt): Boolean; -begin - Result := ImCopyRect(SrcImage, SrcX, SrcY, Width, Height, DstImage, DstX, DstY); -end; - -class function Imaging.FillRect(var Image: TImageData; X, Y, Width, Height: LongInt; Fill: TObject): Boolean; -var - Ptr: IntPtr; -begin - Ptr := Marshal.AllocHGlobal(Marshal.SizeOf(Fill)); - Marshal.StructureToPtr(Fill, Ptr, False); - Result := ImFillRect(Image, X, Y, Width, Height, Ptr); - Marshal.FreeHGlobal(Ptr); -end; - -class function Imaging.ReplaceColor(var Image: TImageData; X, Y, Width, - Height: LongInt; OldPixel, NewPixel: TObject): Boolean; -var - OldPtr, NewPtr: IntPtr; -begin - OldPtr := Marshal.AllocHGlobal(Marshal.SizeOf(OldPixel)); - Marshal.StructureToPtr(OldPixel, OldPtr, False); - NewPtr := Marshal.AllocHGlobal(Marshal.SizeOf(NewPixel)); - Marshal.StructureToPtr(NewPixel, NewPtr, False); - Result := ReplaceColor(Image, X, Y, Width, Height, OldPtr, NewPtr); - Marshal.FreeHGlobal(OldPtr); - Marshal.FreeHGlobal(NewPtr); -end; - -class function Imaging.StretchRect(const SrcImage: TImageData; SrcX, SrcY, - SrcWidth, SrcHeight: Integer; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: Integer; Filter: TResizeFilter): Boolean; -begin - Result := ImStretchRect(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight, - DstImage, DstX, DstY, DstWidth, DstHeight, Filter); -end; - -class procedure Imaging.GetPixelDirect(const Image: TImageData; X, Y: Integer; - Pixel: TObject); -var - Ptr: IntPtr; -begin - Ptr := Marshal.AllocHGlobal(Marshal.SizeOf(Pixel)); - ImGetPixelDirect(Image, X, Y, Ptr); - Marshal.PtrToStructure(Ptr, Pixel); - Marshal.FreeHGlobal(Ptr); -end; - -class function Imaging.GetPixel32(const Image: TImageData; X, - Y: Integer): TColor32Rec; -begin - Result := ImGetPixel32(Image, X, Y); -end; - -class procedure Imaging.SetPixel32(const Image: TImageData; X, Y: Integer; - const Color: TColor32Rec); -begin - ImSetPixel32(Image, X, Y, Color); -end; - -class function Imaging.GetPixelFP(const Image: TImageData; X, - Y: Integer): TColorFPRec; -begin - Result := ImGetPixelFP(Image, X, Y); -end; - -class procedure Imaging.SetPixelDirect(const Image: TImageData; X, Y: Integer; - Pixel: TObject); -var - Ptr: IntPtr; -begin - Ptr := Marshal.AllocHGlobal(Marshal.SizeOf(Pixel)); - Marshal.StructureToPtr(Pixel, Ptr, False); - ImSetPixelDirect(Image, X, Y, Ptr); - Marshal.FreeHGlobal(Ptr); -end; - -class procedure Imaging.SetPixelFP(const Image: TImageData; X, Y: Integer; - const Color: TColorFPRec); -begin - ImSetPixelFP(Image, X, Y, Color); -end; - -class function Imaging.NewPalette(Entries: LongInt; var Pal: TPalette32): Boolean; -begin - Result := ImNewPalette(Entries, Pal); -end; - -class function Imaging.FreePalette(var Pal: TPalette32): Boolean; -begin - Result := ImFreePalette(Pal); -end; - -class function Imaging.CopyPalette(SrcPal, DstPal: TPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; -begin - Result := ImCopyPalette(SrcPal, DstPal, SrcIdx, DstIdx, Count); -end; - -class function Imaging.FindColor(Pal: TPalette32; Entries: LongInt; Color: TColor32): LongInt; -begin - Result := ImFindColor(Pal, Entries, Color); -end; - -class function Imaging.FillGrayscalePalette(Pal: TPalette32; Entries: LongInt): Boolean; -begin - Result := ImFillGrayscalePalette(Pal, Entries); -end; - -class function Imaging.FillCustomPalette(Pal: TPalette32; Entries: LongInt; RBits, GBits, BBits: Byte; Alpha: Byte): Boolean; -begin - Result := ImFillCustomPalette(Pal, Entries, RBits, GBits, BBits, Alpha); -end; - -class function Imaging.SwapChannelsOfPalette(Pal: TPalette32; Entries, SrcChannel, DstChannel: LongInt): Boolean; -begin - Result := ImSwapChannelsOfPalette(Pal, Entries, SrcChannel, DstChannel); -end; - -class function Imaging.GetPaletteColor(Pal: TPalette32; Index: LongInt): TColor32; -begin - Result := Marshal.ReadInt32(Pal, Index * SizeOf(TColor32)); -end; - -class procedure Imaging.SetPaletteColor(Pal: TPalette32; Index: LongInt; Color: TColor32); -begin - Marshal.WriteInt32(Pal, Index * SizeOf(TColor32), Color); -end; - -class function Imaging.SetOption(OptionId, Value: LongInt): Boolean; -begin - Result := ImSetOption(OptionId, Value); -end; - -class function Imaging.GetOption(OptionId: LongInt): LongInt; -begin - Result := ImGetOption(OptionId); -end; - -class function Imaging.PushOptions: Boolean; -begin - Result := ImPushOptions; -end; - -class function Imaging.PopOptions: Boolean; -begin - Result := ImPopOptions; -end; - -class function Imaging.GetPixelBytes(Format: TImageFormat): LongInt; -begin - Result := ImGetPixelBytes(Format); -end; - -class function Imaging.GetFileFormatCount: LongInt; -begin - Result := Length(FileFormats); -end; - -class function Imaging.GetFileFormatInfo(Index: LongInt): TFileFormatInfo; -begin - if (Index >= Low(FileFormats)) and (Index <= High(FileFormats)) then - Result := FileFormats[Index]; -end; - -class function Imaging.GetImageFileFormatsFilter( - OpenFileFilter: Boolean): string; -const - SAllFilter = 'All Images'; -var - I, Count: LongInt; - Descriptions: string; - Filters, CurFilter: string; -begin - Descriptions := ''; - Filters := ''; - Count := 0; - for I := 0 to Length(FileFormats) - 1 do - begin - if not OpenFileFilter and not FileFormats[I].CanSave then - Continue; - CurFilter := FileFormats[I].Masks; - FmtStr(Descriptions, '%s%s (%s)|%2:s', [Descriptions, FileFormats[I].Name, CurFilter]); - FmtStr(Filters, '%s;%s', [Filters, CurFilter]); - if I < Length(FileFormats) - 1 then - Descriptions := Descriptions + '|'; - Inc(Count); - end; - - if (Count > 1) and OpenFileFilter then - FmtStr(Descriptions, '%s (%s)|%1:s|%s', [SAllFilter, Filters, Descriptions]); - Result := Descriptions; -end; - -class function Imaging.GetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; -begin - Result := ImGetImageFormatInfo(Format, Info); -end; - -class function Imaging.GetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; -begin - Result := ImGetPixelsSize(Format, Width, Height); -end; - -{ Color Records implementations } - -{ TColor24Rec } - -function TColor24Rec.SetColor(Color: TColor32): TColor24Rec; -begin - R := (Color shr 16) and $FF; - G := (Color shr 8) and $FF; - B := Color and $FF; - Result := Self; -end; - -function TColor24Rec.GetColor: TColor32; -begin - Result := ($FF shl 24) or (R shl 16) or (G shl 8) or B; -end; - -function TColor24Rec.SetColor(R, G, B: Byte): TColor24Rec; -begin - Self.R := R; - Self.G := G; - Self.B := B; - Result := Self; -end; - -function TColor24Rec.SetColor(ColorRec: TColorFPRec): TColor24Rec; -begin - Self.R := Math.Max(0, Math.Min(255, Trunc(ColorRec.R * 255))); - Self.G := Math.Max(0, Math.Min(255, Trunc(ColorRec.G * 255))); - Self.B := Math.Max(0, Math.Min(255, Trunc(ColorRec.B * 255))); - Result := Self; -end; - -function TColor24Rec.SetColor(ColorRec: TColor64Rec): TColor24Rec; -begin - Self.R := ColorRec.R shr 8; - Self.G := ColorRec.G shr 8; - Self.B := ColorRec.B shr 8; - Result := Self; -end; - -function TColor24Rec.SetColor(ColorRec: TColor48Rec): TColor24Rec; -begin - Self.R := ColorRec.R shr 8; - Self.G := ColorRec.G shr 8; - Self.B := ColorRec.B shr 8; - Result := Self; -end; - -function TColor24Rec.SetColor(ColorRec: TColor32Rec): TColor24Rec; -begin - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -function TColor24Rec.SetColor(ColorRec: TColor24Rec): TColor24Rec; -begin - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -class operator TColor24Rec.Equal(const Left, Right: TColor24Rec): Boolean; -begin - Result := (Left.R = Right.R) and (Left.G = Right.G) and (Left.B = Right.B); -end; - -class operator TColor24Rec.NotEqual(const Left, Right: TColor24Rec): Boolean; -begin - Result := not TColor24Rec.Equals(Left, Right); -end; - -{ TColor32Rec } - -function TColor32Rec.SetColor(Color: TColor32): TColor32Rec; -begin - A := Color shr 24; - R := (Color shr 16) and $FF; - G := (Color shr 8) and $FF; - B := Color and $FF; - Result := Self; -end; - -function TColor32Rec.GetColor: TColor32; -begin - Result := (A shl 24) or (R shl 16) or (G shl 8) or B; -end; - -function TColor32Rec.SetColor(A, R, G, B: Byte): TColor32Rec; -begin - Self.A := A; - Self.R := R; - Self.G := G; - Self.B := B; - Result := Self; -end; - -function TColor32Rec.SetColor(ColorRec: TColorFPRec): TColor32Rec; -begin - Self.A := Math.Max(0, Math.Min($FF, Trunc(ColorRec.A * $FF))); - Self.R := Math.Max(0, Math.Min($FF, Trunc(ColorRec.R * $FF))); - Self.G := Math.Max(0, Math.Min($FF, Trunc(ColorRec.G * $FF))); - Self.B := Math.Max(0, Math.Min($FF, Trunc(ColorRec.B * $FF))); - Result := Self; -end; - -function TColor32Rec.SetColor(ColorRec: TColor64Rec): TColor32Rec; -begin - Self.A := ColorRec.A shr 8; - Self.R := ColorRec.R shr 8; - Self.G := ColorRec.G shr 8; - Self.B := ColorRec.B shr 8; - Result := Self; -end; - -function TColor32Rec.SetColor(ColorRec: TColor48Rec): TColor32Rec; -begin - Self.A := $FF; - Self.R := ColorRec.R shr 8; - Self.G := ColorRec.G shr 8; - Self.B := ColorRec.B shr 8; - Result := Self; -end; - -function TColor32Rec.SetColor(ColorRec: TColor32Rec): TColor32Rec; -begin - Self.A := ColorRec.A; - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -function TColor32Rec.SetColor(ColorRec: TColor24Rec): TColor32Rec; -begin - Self.A := $FF; - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -class operator TColor32Rec.Equal(const Left, Right: TColor32Rec): Boolean; -begin - Result := (Left.A = Right.A) and (Left.R = Right.R) and (Left.G = Right.G) and - (Left.B = Right.B); -end; - -class operator TColor32Rec.NotEqual(const Left, Right: TColor32Rec): Boolean; -begin - Result := not TColor32Rec.Equals(Left, Right); -end; - -{ TColor48Rec } - -function TColor48Rec.SetColor(Color: TColor64): TColor48Rec; -begin - R := (Color shr 32) and $FFFF; - G := (Color shr 16) and $FFFF; - B := Color and $FFFF; - Result := Self; -end; - -function TColor48Rec.GetColor: TColor64; -begin - Result := (UInt64($FFFF) shl 48) or (UInt64(R) shl 32) or (G shl 16) or B; -end; - -function TColor48Rec.SetColor(R, G, B: Word): TColor48Rec; -begin - Self.R := R; - Self.G := G; - Self.B := B; - Result := Self; -end; - -function TColor48Rec.SetColor(ColorRec: TColorFPRec): TColor48Rec; -begin - Self.R := Math.Max(0, Math.Min($FFFF, Trunc(ColorRec.R * $FFFF))); - Self.G := Math.Max(0, Math.Min($FFFF, Trunc(ColorRec.G * $FFFF))); - Self.B := Math.Max(0, Math.Min($FFFF, Trunc(ColorRec.B * $FFFF))); - Result := Self; -end; - -function TColor48Rec.SetColor(ColorRec: TColor64Rec): TColor48Rec; -begin - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -function TColor48Rec.SetColor(ColorRec: TColor48Rec): TColor48Rec; -begin - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -function TColor48Rec.SetColor(ColorRec: TColor32Rec): TColor48Rec; -begin - Self.R := ColorRec.R shl 8; - Self.G := ColorRec.G shl 8; - Self.B := ColorRec.B shl 8; - Result := Self; -end; - -function TColor48Rec.SetColor(ColorRec: TColor24Rec): TColor48Rec; -begin - Self.R := ColorRec.R shl 8; - Self.G := ColorRec.G shl 8; - Self.B := ColorRec.B shl 8; - Result := Self; -end; - -class operator TColor48Rec.Equal(const Left, Right: TColor48Rec): Boolean; -begin - Result := (Left.R = Right.R) and (Left.G = Right.G) and (Left.B = Right.B); -end; - -class operator TColor48Rec.NotEqual(const Left, Right: TColor48Rec): Boolean; -begin - Result := not TColor48Rec.Equals(Left, Right); -end; - -{ TColor64Rec } - -function TColor64Rec.SetColor(Color: TColor64): TColor64Rec; -begin - A := Color shr 48; - R := (Color shr 32) and $FFFF; - G := (Color shr 16) and $FFFF; - B := Color and $FFFF; - Result := Self; -end; - -function TColor64Rec.GetColor: TColor64; -begin - Result := (UInt64(A) shl 48) or (UInt64(R) shl 32) or (G shl 16) or B; -end; - -function TColor64Rec.SetColor(A, R, G, B: Word): TColor64Rec; -begin - Self.A := A; - Self.R := R; - Self.G := G; - Self.B := B; - Result := Self; -end; - -function TColor64Rec.SetColor(ColorRec: TColorFPRec): TColor64Rec; -begin - Self.A := Math.Max(0, Math.Min($FFFF, Trunc(ColorRec.A * $FFFF))); - Self.R := Math.Max(0, Math.Min($FFFF, Trunc(ColorRec.R * $FFFF))); - Self.G := Math.Max(0, Math.Min($FFFF, Trunc(ColorRec.G * $FFFF))); - Self.B := Math.Max(0, Math.Min($FFFF, Trunc(ColorRec.B * $FFFF))); - Result := Self; -end; - -function TColor64Rec.SetColor(ColorRec: TColor64Rec): TColor64Rec; -begin - Self.A := ColorRec.A; - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -function TColor64Rec.SetColor(ColorRec: TColor48Rec): TColor64Rec; -begin - Self.A := $FFFF; - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -function TColor64Rec.SetColor(ColorRec: TColor32Rec): TColor64Rec; -begin - Self.A := ColorRec.A shl 8; - Self.R := ColorRec.R shl 8; - Self.G := ColorRec.G shl 8; - Self.B := ColorRec.B shl 8; - Result := Self; -end; - -function TColor64Rec.SetColor(ColorRec: TColor24Rec): TColor64Rec; -begin - Self.A := $FFFF; - Self.R := ColorRec.R shl 8; - Self.G := ColorRec.G shl 8; - Self.B := ColorRec.B shl 8; - Result := Self; -end; - -class operator TColor64Rec.Equal(const Left, Right: TColor64Rec): Boolean; -begin - Result := (Left.A = Right.A) and (Left.R = Right.R) and (Left.G = Right.G) and - (Left.B = Right.B); -end; - -class operator TColor64Rec.NotEqual(const Left, Right: TColor64Rec): Boolean; -begin - Result := not TColor64Rec.Equals(Left, Right); -end; - -{ TColorFRec } - -function TColorFPRec.SetColor(Color: TColor64): TColorFPRec; -var - C64: TColor64Rec; -begin - C64.SetColor(Color); - Self.SetColor(C64); - Result := Self; -end; - -function TColorFPRec.GetColor: TColor64; -var - C64: TColor64Rec; -begin - C64.SetColor(Self); - Result := C64.GetColor; -end; - -function TColorFPRec.SetColor(A, R, G, B: Single): TColorFPRec; -begin - Self.A := A; - Self.R := R; - Self.G := G; - Self.B := B; - Result := Self; -end; - -function TColorFPRec.SetColor(ColorRec: TColorFPRec): TColorFPRec; -begin - Self.A := ColorRec.A; - Self.R := ColorRec.R; - Self.G := ColorRec.G; - Self.B := ColorRec.B; - Result := Self; -end; - -function TColorFPRec.SetColor(ColorRec: TColor64Rec): TColorFPRec; -begin - Self.A := ColorRec.A / $FFFF; - Self.R := ColorRec.R / $FFFF; - Self.G := ColorRec.G / $FFFF; - Self.B := ColorRec.B / $FFFF; - Result := Self; -end; - -function TColorFPRec.SetColor(ColorRec: TColor48Rec): TColorFPRec; -begin - Self.A := 1.0; - Self.R := ColorRec.R / $FFFF; - Self.G := ColorRec.G / $FFFF; - Self.B := ColorRec.B / $FFFF; - Result := Self; -end; - -function TColorFPRec.SetColor(ColorRec: TColor32Rec): TColorFPRec; -begin - Self.A := ColorRec.A / $FF; - Self.R := ColorRec.R / $FF; - Self.G := ColorRec.G / $FF; - Self.B := ColorRec.B / $FF; - Result := Self; -end; - -function TColorFPRec.SetColor(ColorRec: TColor24Rec): TColorFPRec; -begin - Self.A := 1.0; - Self.R := ColorRec.R / $FF; - Self.G := ColorRec.G / $FF; - Self.B := ColorRec.B / $FF; - Result := Self; -end; - -class operator TColorFPRec.Equal(const Left, Right: TColorFPRec): Boolean; -begin - Result := (Left.A = Right.A) and (Left.R = Right.R) and (Left.G = Right.G) and - (Left.B = Right.B); -end; - -class operator TColorFPRec.NotEqual(const Left, Right: TColorFPRec): Boolean; -begin - Result := not TColorFPRec.Equals(Left, Right); -end; - -initialization - Imaging.BuildFileFormatList; - -{ - Changes/Bug Fixes: - - -- TODOS ---------------------------------------------------- - - add typecast operators to color records rather than SetColor methods - - add create System.Drawing.Bitmap from TImageData function - - -- 0.23 ----------------------------------------------------- - - Updated to DLL new version. - - -- 0.21 ----------------------------------------------------- - - Changed out PChar parameter types of imported functions to StringBuilders - for easier conversions to System.String in Imaging class methods. - - Added GetImageFileFormatFilter method to Imaging class. - - Updated to DLL new version, some changes in Imaging class methods - that return strings. - - -- 0.19 ----------------------------------------------------- - - updated to DLL new version - - -- 0.17 ----------------------------------------------------- - - added new low level functions and their equivalents in Imaging class, - some old function headers updated - - -- 0.15 ----------------------------------------------------- - - changed headers of some functions because of changes in DLL - mainly related to TImageDataList parameters. Few other - "update" changes. - - -- 0.13 ----------------------------------------------------- - - Imaging class added - - various color records implemented - - several .NET only functions added - - unit created -} - -end. diff --git a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Pascal/ImagingImport.pas b/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Pascal/ImagingImport.pas deleted file mode 100644 index 5d46e8f..0000000 --- a/components/vampireimaging/Extras/DynamicLib/ImportHeaders/Pascal/ImagingImport.pas +++ /dev/null @@ -1,123 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains Pascal interface to Imaging library which is - compiled into the dynamic link library.} -unit ImagingImport; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes; - -const -{$IFDEF MSWINDOWS} - LibraryName = 'VampyreImaging.dll'; -{$ENDIF} -{$IFDEF LINUX} - LibraryName = 'libVampyreImaging.so'; -{$ENDIF} - -procedure ImGetVersion(var Major, Minor, Patch: LongInt); cdecl; external LibraryName; -procedure ImInitImage(var Image: TImageData); cdecl; external LibraryName; -function ImNewImage(Width, Height: LongInt; Format: TImageFormat; var Image: TImageData): Boolean; cdecl; external LibraryName; -function ImTestImage(var Image: TImageData): Boolean; cdecl; external LibraryName; -function ImFreeImage(var Image: TImageData): Boolean; cdecl; external LibraryName; -function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean; cdecl; external LibraryName; -function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean; cdecl; external LibraryName; -function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean; cdecl; external LibraryName; -function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar; var CanSave, IsMultiImageFormat: Boolean): Boolean; cdecl; external LibraryName; - -function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean; cdecl; external LibraryName; -function ImGetImageListSize(ImageList: TImageDataList): LongInt; cdecl; external LibraryName; -function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt; var OutImage: TImageData): Boolean; cdecl; external LibraryName; -function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt): Boolean; cdecl; external LibraryName; -function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt; const InImage: TImageData): Boolean; cdecl; external LibraryName; -function ImTestImagesInList(ImageList: TImageDataList): Boolean; cdecl; external LibraryName; -function ImFreeImageList(var ImageList: TImageDataList): Boolean; cdecl; external LibraryName; - -function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean; cdecl; external LibraryName; -function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; cdecl; external LibraryName; -function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList): Boolean; cdecl; external LibraryName; -function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt; var ImageList: TImageDataList): Boolean; cdecl; external LibraryName; - -function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean; cdecl; external LibraryName; -function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt; const Image: TImageData): Boolean; cdecl; external LibraryName; -function ImSaveMultiImageToFile(FileName: PAnsiChar; ImageList: TImageDataList): Boolean; cdecl; external LibraryName; -function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt; ImageList: TImageDataList): Boolean; cdecl; external LibraryName; - -function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean; cdecl; external LibraryName; -function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; cdecl; external LibraryName; -function ImFlipImage(var Image: TImageData): Boolean; cdecl; external LibraryName; -function ImMirrorImage(var Image: TImageData): Boolean; cdecl; external LibraryName; -function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl; external LibraryName; -function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; cdecl; external LibraryName; -function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; cdecl; external LibraryName; -function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt; var MipMaps: TImageDataList): Boolean; cdecl; external LibraryName; -function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32; Entries: LongInt): Boolean; cdecl; external LibraryName; -function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList; ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; PreserveSize: Boolean; Fill: Pointer): Boolean; cdecl; external LibraryName; -function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32; MaxColors: LongInt; ConvertImages: Boolean): Boolean; cdecl; external LibraryName; -function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; cdecl; external LibraryName; - -function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl; external LibraryName; -function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt; Fill: Pointer): Boolean; cdecl; external LibraryName; -function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt; OldPixel, NewPixel: Pointer): Boolean; cdecl; external LibraryName; -function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl; external LibraryName; -procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl; external LibraryName; -procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl; external LibraryName; -function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl; external LibraryName; -procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); cdecl; external LibraryName; -function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl; external LibraryName; -procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); cdecl; external LibraryName; - -function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean; cdecl; external LibraryName; -function ImFreePalette(var Pal: PPalette32): Boolean; cdecl; external LibraryName; -function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; cdecl; external LibraryName; -function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt; cdecl; external LibraryName; -function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean; cdecl; external LibraryName; -function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits, BBits: Byte; Alpha: Byte): Boolean; cdecl; external LibraryName; -function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel, DstChannel: LongInt): Boolean; cdecl; external LibraryName; - -function ImSetOption(OptionId, Value: LongInt): Boolean; cdecl; external LibraryName; -function ImGetOption(OptionId: LongInt): LongInt; cdecl; external LibraryName; -function ImPushOptions: Boolean; cdecl; external LibraryName; -function ImPopOptions: Boolean; cdecl; external LibraryName; - -function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; cdecl; external LibraryName; -function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; cdecl; external LibraryName; - -procedure ImSetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc: - TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc; - TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); cdecl; external LibraryName; -procedure ImResetFileIO; cdecl; external LibraryName; - -implementation - -end. - diff --git a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.XE2.dproj b/components/vampireimaging/Extras/DynamicLib/VampyreImaging.XE2.dproj deleted file mode 100644 index 1739f04..0000000 --- a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.XE2.dproj +++ /dev/null @@ -1,152 +0,0 @@ - - - {d660e9b2-6523-4217-b95e-0f48ad9a69d8} - VampyreImaging.dpr - Release - DCC32 - ..\..\Bin\VampyreImaging.dll - 13.4 - Release - None - True - Win32 - 3 - Library - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - None - ..\..\Bin\Dcu\$(Platform)\$(Config) - 0 - 1033 - true - 78 - FileVersion=0.78.0.0;ProductVersion=0.78.0.0;CompanyName=http://imaginglib.sourceforge.net;FileDescription=Image loading, saving and manipulation library;InternalName=VampyreImaging.dll;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=Vampyre Imaging Library;Last Compile=2012-06-01 00:18 - true - FULL_FEATURE_SET;$(DCC_Define) - ..\..\Bin - ..\..\Source;..\..\Source\JpegLib;..\..\Source\ZLib;..\Extensions;..\Extensions\LibTiff;$(DCC_UnitSearchPath) - ..\..\Source;..\..\Source\JpegLib;..\..\Source\ZLib;..\Extensions;$(DCC_ResourcePath) - ..\..\Source;..\..\Source\JpegLib;..\..\Source\ZLib;..\Extensions;$(DCC_ObjPath) - ..\..\Source;..\..\Source\JpegLib;..\..\Source\ZLib;..\Extensions;$(DCC_IncludePath) - true - ..\..\Bin\VampyreImaging.dll - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - - - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - - - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - - - 7.0 - RELEASE;$(DCC_Define) - - - None - - - 7.0 - 2 - DEBUG;$(DCC_Define) - False - True - True - True - - - Delphi.Personality.12 - - - - - False - True - False - - - True - False - 0 - 78 - 0 - 0 - False - False - False - False - True - 1033 - 1252 - - - 0.78.0.0 - 0.78.0.0 - http://imaginglib.sourceforge.net - Image loading, saving and manipulation library - VampyreImaging.dll - - - - Vampyre Imaging Library - - - VampyreImaging.dpr - - - - True - False - True - - - 12 - - - - MainSource - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - diff --git a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.dof b/components/vampireimaging/Extras/DynamicLib/VampyreImaging.dof deleted file mode 100644 index ea155ef..0000000 --- a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.dof +++ /dev/null @@ -1,131 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=0 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=0 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=0 -W=0 -X=1 -Y=0 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=7995392 -ExeDescription= -[Directories] -OutputDir=..\..\Bin -UnitOutputDir=..\..\Bin\Dcu\Win32 -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath=..\..\Source;..\..\Source\JpegLib;..\..\Source\ZLib;..\Extensions;..\Extensions\LibTiff -Packages= -Conditionals=FULL_FEATURE_SET -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -Launcher= -UseLauncher=0 -DebugCWD= -[Version Info] -IncludeVerInfo=1 -AutoIncBuild=0 -MajorVer=0 -MinorVer=80 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=1 -Locale=1033 -CodePage=1252 -[Version Info Keys] -CompanyName=http://imaginglib.sourceforge.net -FileDescription=Image loading, saving and manipulation library -FileVersion=0.80.0.0 -InternalName=VampyreImaging.dll -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName=Vampyre Imaging Library -ProductVersion=0.80.0.0 diff --git a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.dpr b/components/vampireimaging/Extras/DynamicLib/VampyreImaging.dpr deleted file mode 100644 index 79dd81d..0000000 --- a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.dpr +++ /dev/null @@ -1,149 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This is main file for Imaging dynamic link library. It exports - some low level functions operating on TImageData record. All string are - exported as PChars.} -library VampyreImaging; - -{ $DEFINE EXPORT_GLEXT} - - -{$I ImagingOptions.inc} - -uses -{$IFDEF EXPORT_GLEXT} - ImagingOpenGL, -{$ENDIF} - ImagingTypes, - ImagingExport; - -{$IFDEF MSWINDOWS} - {$R *.res} -{$ENDIF} - -{$IFDEF EXPORT_GLEXT} -function ImLoadGLTextureFromFile(FileName: PAnsiChar): LongWord; cdecl; -begin - Result := ImagingOpenGL.LoadGLTextureFromFile(FileName, nil, nil); -end; -{$ENDIF} - -exports - -{$IFDEF EXPORT_GLEXT} - ImLoadGLTextureFromFile, -{$ENDIF} - - ImGetVersion, - ImInitImage, - ImNewImage, - ImTestImage, - ImFreeImage, - ImDetermineFileFormat, - ImDetermineMemoryFormat, - ImIsFileFormatSupported, - ImEnumFileFormats, - - ImInitImageList, - ImGetImageListSize, - ImGetImageListElement, - ImSetImageListSize, - ImSetImageListElement, - ImTestImagesInList, - ImFreeImageList, - - ImLoadImageFromFile, - ImLoadMultiImageFromFile, - ImLoadImageFromMemory, - ImLoadMultiImageFromMemory, - - ImSaveImageToFile, - ImSaveImageToMemory, - ImSaveMultiImageToFile, - ImSaveMultiImageToMemory, - - ImCloneImage, - ImConvertImage, - ImFlipImage, - ImMirrorImage, - ImResizeImage, - ImSwapChannels, - ImReduceColors, - ImGenerateMipMaps, - ImMapImageToPalette, - ImSplitImage, - ImMakePaletteForImages, - ImRotateImage, - - ImCopyRect, - ImFillRect, - ImReplaceColor, - ImStretchRect, - ImGetPixelDirect, - ImSetPixelDirect, - ImGetPixel32, - ImSetPixel32, - ImGetPixelFP, - ImSetPixelFP, - - ImNewPalette, - ImFreePalette, - ImCopyPalette, - ImFindColor, - ImFillGrayscalePalette, - ImFillCustomPalette, - ImSwapChannelsOfPalette, - - ImSetOption, - ImGetOption, - ImPushOptions, - ImPopOptions, - - ImGetImageFormatInfo, - ImGetPixelsSize, - - ImSetUserFileIO, - ImResetFileIO; - -begin - -{ - Changes/Bug Fixes: - - -- 0.26.3 --------------------------------------------------- - - Added optional GL extension exports. - - -- 0.19 ----------------------------------------------------- - - updated to reflect changes in ImagingExport - - -- 0.13 ----------------------------------------------------- - - Free Pascal's smartlinking was turned off when building library - because nothing got exported from it when it was on - -} -end. diff --git a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.lpi b/components/vampireimaging/Extras/DynamicLib/VampyreImaging.lpi deleted file mode 100644 index e949b66..0000000 --- a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.lpi +++ /dev/null @@ -1,249 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.lpr b/components/vampireimaging/Extras/DynamicLib/VampyreImaging.lpr deleted file mode 100644 index 0fdc0e5..0000000 --- a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.lpr +++ /dev/null @@ -1,128 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This is main file for Imaging dynamic link library. It exports - some low level functions operating on TImageData record. All string are - exported as PChars.} -library VampyreImaging; - -{$I ImagingOptions.inc} - -uses - ImagingTypes, - ImagingExport; - -{$IFDEF MSWINDOWS} - {$R *.res} -{$ENDIF} - -exports - ImGetVersion, - ImInitImage, - ImNewImage, - ImTestImage, - ImFreeImage, - ImDetermineFileFormat, - ImDetermineMemoryFormat, - ImIsFileFormatSupported, - ImEnumFileFormats, - - ImInitImageList, - ImGetImageListSize, - ImGetImageListElement, - ImSetImageListSize, - ImSetImageListElement, - ImTestImagesInList, - ImFreeImageList, - - ImLoadImageFromFile, - ImLoadMultiImageFromFile, - ImLoadImageFromMemory, - ImLoadMultiImageFromMemory, - - ImSaveImageToFile, - ImSaveImageToMemory, - ImSaveMultiImageToFile, - ImSaveMultiImageToMemory, - - ImCloneImage, - ImConvertImage, - ImFlipImage, - ImMirrorImage, - ImResizeImage, - ImSwapChannels, - ImReduceColors, - ImGenerateMipMaps, - ImMapImageToPalette, - ImSplitImage, - ImMakePaletteForImages, - ImRotateImage, - - ImCopyRect, - ImFillRect, - ImReplaceColor, - ImStretchRect, - ImGetPixelDirect, - ImSetPixelDirect, - ImGetPixel32, - ImSetPixel32, - ImGetPixelFP, - ImSetPixelFP, - - ImNewPalette, - ImFreePalette, - ImCopyPalette, - ImFindColor, - ImFillGrayscalePalette, - ImFillCustomPalette, - ImSwapChannelsOfPalette, - - ImSetOption, - ImGetOption, - ImPushOptions, - ImPopOptions, - - ImGetImageFormatInfo, - ImGetPixelsSize, - - ImSetUserFileIO, - ImResetFileIO; - -begin -{ - Changes/Bug Fixes: - - -- 0.19 ----------------------------------------------------- - - updated to reflect changes in ImagingExport - - -- 0.13 ----------------------------------------------------- - - Free Pascal's smartlinking was turned off when building library - because nothing got exported from it when it was on - -} -end. - diff --git a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.res b/components/vampireimaging/Extras/DynamicLib/VampyreImaging.res deleted file mode 100644 index bfb68b7..0000000 Binary files a/components/vampireimaging/Extras/DynamicLib/VampyreImaging.res and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/ElderImagery.pas b/components/vampireimaging/Extras/Extensions/ElderImagery.pas deleted file mode 100644 index d131d8e..0000000 --- a/components/vampireimaging/Extras/Extensions/ElderImagery.pas +++ /dev/null @@ -1,657 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This is basic unit of Elder Imagery extension for Vampyre Imaging Library. - It adds support for loading and saving of images and textures from older - Bethesda games (like TES2: Daggerfall, Redguard, Terminator: FS, TES: Arena, ...). - This unit registers all file formats declared in additional ElderImagery units - so its the only unit you need to add to uses clause of your project - for Imaging to be able to load/save these new formats using standard - loading/saving functions.} -unit ElderImagery; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging; - -type - TElderFileFormat = class; - TElderFileFormatClass = class of TElderFileFormat; - - { Used to hold information about some special images without headers.} - TNoHeaderFileInfo = record - Size: LongInt; - Width: LongInt; - Height: LongInt; - end; - - { Basic class for image formats used mainly in TES2: Daggerfall.} - TElderFileFormat = class(TImageFileFormat) - protected - FPalette: TPalette24Size256; - FARGBPalette: PPalette32; - procedure Define; override; - { Decodes RLE compressed data.} - procedure DagRLEDecode(InData: Pointer; OutSize: LongInt; out OutData: Pointer); - function FindNoHeaderInfo(Size: LongInt; Infos: array of TNoHeaderFileInfo): LongInt; - function TestNoHeaderFormat(Handle: TImagingHandle): TElderFileFormatClass; - procedure ConvertPalette(const ElderPal: TPalette24Size256; ARGBPal: PPalette32); - procedure SetPalette(const Value: TPalette24Size256); - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - function IsSupported(const Image: TImageData): Boolean; override; - public - destructor Destroy; override; - function TestFormat(Handle: TImagingHandle): Boolean; override; - { Current palette used when loading and saving images. Nearly all images - in Daggerfall use external palettes. Change this property if you want - images that don't use default palette to load correctly.} - property Palette: TPalette24Size256 read FPalette write SetPalette; - end; - - { Header of IMG and CIF files.} - TImgHeader = packed record - XOff: Word; - YOff: Word; - Width: Word; - Height: Word; - Unk: Word; // Might indicate compressed data or not - ImageSize: Word; // Size of Image data (but not always) - end; - -const - { This is default Daggerfall's palette (C:\Dagger\Arena2\pal.pal). - Every TElderFileFormat descendant loads this pal in constructor.} - DaggerfallPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 244; G: 202; R: 167), - (B: 227; G: 180; R: 144), (B: 207; G: 152; R: 118), (B: 193; G: 133; R: 100), - (B: 180; G: 113; R: 80), (B: 165; G: 100; R: 70), (B: 152; G: 93; R: 63), - (B: 140; G: 86; R: 55), (B: 129; G: 79; R: 48), (B: 122; G: 75; R: 43), - (B: 112; G: 70; R: 40), (B: 103; G: 64; R: 39), (B: 91; G: 67; R: 38), - (B: 79; G: 63; R: 43), (B: 66; G: 54; R: 41), (B: 54; G: 50; R: 40), - (B: 232; G: 196; R: 196), (B: 220; G: 177; R: 177), (B: 204; G: 157; R: 157), - (B: 188; G: 138; R: 138), (B: 175; G: 122; R: 122), (B: 155; G: 105; R: 106), - (B: 143; G: 94; R: 97), (B: 126; G: 81; R: 89), (B: 109; G: 72; R: 88), - (B: 101; G: 68; R: 85), (B: 86; G: 61; R: 77), (B: 75; G: 55; R: 71), - (B: 67; G: 51; R: 63), (B: 63; G: 47; R: 56), (B: 56; G: 45; R: 52), - (B: 46; G: 44; R: 46), (B: 245; G: 212; R: 172), (B: 229; G: 193; R: 150), - (B: 213; G: 174; R: 128), (B: 196; G: 154; R: 105), (B: 183; G: 140; R: 88), - (B: 173; G: 127; R: 78), (B: 160; G: 118; R: 74), (B: 151; G: 110; R: 69), - (B: 134; G: 103; R: 65), (B: 123; G: 92; R: 60), (B: 109; G: 85; R: 54), - (B: 96; G: 76; R: 51), (B: 83; G: 71; R: 44), (B: 69; G: 63; R: 42), - (B: 61; G: 54; R: 38), (B: 50; G: 45; R: 34), (B: 205; G: 205; R: 224), - (B: 188; G: 188; R: 199), (B: 165; G: 165; R: 174), (B: 145; G: 145; R: 159), - (B: 135; G: 135; R: 149), (B: 122; G: 122; R: 137), (B: 114; G: 114; R: 127), - (B: 103; G: 103; R: 116), (B: 94; G: 94; R: 109), (B: 85; G: 85; R: 96), - (B: 75; G: 75; R: 85), (B: 68; G: 68; R: 80), (B: 61; G: 61; R: 67), - (B: 53; G: 53; R: 59), (B: 48; G: 48; R: 50), (B: 44; G: 44; R: 45), - (B: 176; G: 205; R: 255), (B: 147; G: 185; R: 244), (B: 123; G: 164; R: 230), - (B: 104; G: 152; R: 217), (B: 87; G: 137; R: 205), (B: 68; G: 124; R: 192), - (B: 68; G: 112; R: 179), (B: 62; G: 105; R: 167), (B: 55; G: 97; R: 154), - (B: 49; G: 90; R: 142), (B: 45; G: 82; R: 122), (B: 51; G: 77; R: 102), - (B: 52; G: 69; R: 87), (B: 50; G: 62; R: 73), (B: 47; G: 59; R: 60), - (B: 44; G: 48; R: 49), (B: 220; G: 220; R: 220), (B: 197; G: 197; R: 197), - (B: 185; G: 185; R: 185), (B: 174; G: 174; R: 174), (B: 162; G: 162; R: 162), - (B: 147; G: 147; R: 147), (B: 132; G: 132; R: 132), (B: 119; G: 119; R: 119), - (B: 110; G: 110; R: 110), (B: 99; G: 99; R: 99), (B: 87; G: 87; R: 87), - (B: 78; G: 78; R: 78), (B: 67; G: 67; R: 67), (B: 58; G: 58; R: 58), - (B: 51; G: 51; R: 51), (B: 44; G: 44; R: 44), (B: 182; G: 218; R: 227), - (B: 158; G: 202; R: 202), (B: 134; G: 187; R: 187), (B: 109; G: 170; R: 170), - (B: 87; G: 154; R: 154), (B: 77; G: 142; R: 142), (B: 70; G: 135; R: 135), - (B: 62; G: 124; R: 124), (B: 54; G: 112; R: 112), (B: 46; G: 103; R: 103), - (B: 39; G: 91; R: 91), (B: 40; G: 83; R: 83), (B: 45; G: 72; R: 72), - (B: 47; G: 63; R: 63), (B: 50; G: 55; R: 55), (B: 45; G: 48; R: 48), - (B: 255; G: 246; R: 103), (B: 241; G: 238; R: 45), (B: 226; G: 220; R: 0), - (B: 212; G: 203; R: 0), (B: 197; G: 185; R: 0), (B: 183; G: 168; R: 0), - (B: 168; G: 150; R: 0), (B: 154; G: 133; R: 0), (B: 139; G: 115; R: 0), - (B: 127; G: 106; R: 4), (B: 116; G: 97; R: 7), (B: 104; G: 87; R: 11), - (B: 93; G: 78; R: 14), (B: 81; G: 69; R: 18), (B: 69; G: 60; R: 21), - (B: 58; G: 51; R: 25), (B: 202; G: 221; R: 196), (B: 175; G: 200; R: 168), - (B: 148; G: 176; R: 141), (B: 123; G: 156; R: 118), (B: 107; G: 144; R: 109), - (B: 93; G: 130; R: 94), (B: 82; G: 116; R: 86), (B: 77; G: 110; R: 78), - (B: 68; G: 99; R: 67), (B: 61; G: 89; R: 53), (B: 52; G: 77; R: 45), - (B: 46; G: 68; R: 37), (B: 39; G: 60; R: 39), (B: 30; G: 55; R: 30), - (B: 34; G: 51; R: 34), (B: 40; G: 47; R: 40), (B: 179; G: 107; R: 83), - (B: 175; G: 95; R: 75), (B: 175; G: 87; R: 67), (B: 163; G: 79; R: 59), - (B: 155; G: 75; R: 51), (B: 147; G: 71; R: 47), (B: 155; G: 91; R: 47), - (B: 139; G: 83; R: 43), (B: 127; G: 75; R: 39), (B: 115; G: 67; R: 35), - (B: 99; G: 63; R: 31), (B: 87; G: 55; R: 27), (B: 75; G: 47; R: 23), - (B: 59; G: 39; R: 19), (B: 47; G: 31; R: 15), (B: 35; G: 23; R: 11), - (B: 216; G: 227; R: 162), (B: 185; G: 205; R: 127), (B: 159; G: 183; R: 101), - (B: 130; G: 162; R: 77), (B: 109; G: 146; R: 66), (B: 101; G: 137; R: 60), - (B: 92; G: 127; R: 54), (B: 84; G: 118; R: 48), (B: 76; G: 108; R: 42), - (B: 65; G: 98; R: 37), (B: 53; G: 87; R: 34), (B: 51; G: 75; R: 35), - (B: 45; G: 64; R: 37), (B: 43; G: 56; R: 39), (B: 38; G: 51; R: 40), - (B: 43; G: 46; R: 45), (B: 179; G: 115; R: 79), (B: 175; G: 111; R: 75), - (B: 171; G: 107; R: 71), (B: 167; G: 103; R: 67), (B: 159; G: 99; R: 63), - (B: 155; G: 95; R: 59), (B: 151; G: 91; R: 55), (B: 143; G: 87; R: 51), - (B: 40; G: 40; R: 40), (B: 38; G: 38; R: 38), (B: 35; G: 35; R: 35), - (B: 31; G: 31; R: 31), (B: 27; G: 27; R: 27), (B: 23; G: 23; R: 23), - (B: 19; G: 19; R: 19), (B: 15; G: 15; R: 15), (B: 254; G: 255; R: 199), - (B: 254; G: 245; R: 185), (B: 254; G: 235; R: 170), (B: 254; G: 225; R: 156), - (B: 255; G: 215; R: 141), (B: 255; G: 205; R: 127), (B: 255; G: 195; R: 112), - (B: 255; G: 185; R: 98), (B: 255; G: 175; R: 83), (B: 241; G: 167; R: 54), - (B: 234; G: 155; R: 50), (B: 226; G: 143; R: 46), (B: 219; G: 131; R: 43), - (B: 212; G: 119; R: 39), (B: 205; G: 107; R: 35), (B: 198; G: 95; R: 31), - (B: 190; G: 84; R: 27), (B: 183; G: 72; R: 23), (B: 176; G: 60; R: 19), - (B: 169; G: 48; R: 15), (B: 162; G: 36; R: 12), (B: 154; G: 24; R: 8), - (B: 147; G: 12; R: 4), (B: 130; G: 22; R: 0), (B: 111; G: 34; R: 0), - (B: 102; G: 33; R: 1), (B: 92; G: 33; R: 3), (B: 83; G: 32; R: 10), - (B: 74; G: 39; R: 27), (B: 65; G: 41; R: 33), (B: 57; G: 43; R: 39), - (B: 48; G: 45; R: 45)); - - { This is default Redguard's palette (Redguard\fxart\Redguard.col). - It is default palette for BSI image file format.} - RedguardPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 133; G: 196; R: 183), (B: 100; G: 181; R: 153), - (B: 66; G: 165; R: 124), (B: 33; G: 150; R: 94), (B: 31; G: 139; R: 87), - (B: 28; G: 127; R: 80), (B: 26; G: 116; R: 73), (B: 24; G: 105; R: 66), - (B: 21; G: 93; R: 59), (B: 19; G: 82; R: 52), (B: 17; G: 71; R: 45), - (B: 14; G: 59; R: 38), (B: 12; G: 48; R: 31), (B: 10; G: 37; R: 24), - (B: 7; G: 25; R: 17), (B: 5; G: 14; R: 10), (B: 230; G: 179; R: 142), - (B: 216; G: 155; R: 127), (B: 199; G: 151; R: 136), (B: 205; G: 134; R: 118), - (B: 199; G: 131; R: 103), (B: 191; G: 130; R: 108), (B: 202; G: 113; R: 95), - (B: 180; G: 112; R: 94), (B: 197; G: 95; R: 78), (B: 183; G: 106; R: 78), - (B: 174; G: 96; R: 75), (B: 160; G: 91; R: 63), (B: 166; G: 84; R: 55), - (B: 151; G: 91; R: 54), (B: 152; G: 75; R: 49), (B: 142; G: 81; R: 51), - (B: 216; G: 227; R: 162), (B: 155; G: 212; R: 109), (B: 95; G: 198; R: 57), - (B: 34; G: 183; R: 4), (B: 32; G: 169; R: 4), (B: 29; G: 155; R: 4), - (B: 27; G: 141; R: 4), (B: 25; G: 127; R: 4), (B: 22; G: 113; R: 4), - (B: 20; G: 100; R: 4), (B: 18; G: 86; R: 3), (B: 15; G: 72; R: 3), - (B: 13; G: 58; R: 3), (B: 11; G: 44; R: 3), (B: 8; G: 30; R: 3), - (B: 6; G: 16; R: 3), (B: 134; G: 72; R: 57), (B: 132; G: 71; R: 47), - (B: 122; G: 75; R: 51), (B: 123; G: 61; R: 44), (B: 119; G: 59; R: 37), - (B: 103; G: 55; R: 41), (B: 104; G: 47; R: 31), (B: 98; G: 47; R: 27), - (B: 91; G: 45; R: 33), (B: 83; G: 42; R: 34), (B: 75; G: 40; R: 24), - (B: 80; G: 33; R: 22), (B: 63; G: 29; R: 24), (B: 66; G: 24; R: 16), - (B: 51; G: 27; R: 24), (B: 40; G: 24; R: 24), (B: 255; G: 246; R: 103), - (B: 241; G: 238; R: 45), (B: 235; G: 247; R: 0), (B: 228; G: 228; R: 3), - (B: 204; G: 207; R: 1), (B: 189; G: 187; R: 2), (B: 173; G: 166; R: 2), - (B: 158; G: 146; R: 3), (B: 142; G: 126; R: 3), (B: 127; G: 106; R: 4), - (B: 114; G: 97; R: 9), (B: 96; G: 81; R: 7), (B: 75; G: 63; R: 6), - (B: 53; G: 47; R: 6), (B: 35; G: 31; R: 6), (B: 19; G: 18; R: 6), - (B: 184; G: 116; R: 83), (B: 175; G: 96; R: 57), (B: 166; G: 75; R: 30), - (B: 157; G: 55; R: 4), (B: 145; G: 51; R: 4), (B: 133; G: 47; R: 4), - (B: 122; G: 43; R: 4), (B: 110; G: 39; R: 3), (B: 98; G: 35; R: 3), - (B: 86; G: 31; R: 3), (B: 74; G: 26; R: 3), (B: 62; G: 22; R: 3), - (B: 51; G: 18; R: 3), (B: 39; G: 14; R: 2), (B: 27; G: 10; R: 2), - (B: 15; G: 6; R: 2), (B: 255; G: 255; R: 184), (B: 255; G: 241; R: 137), - (B: 255; G: 226; R: 90), (B: 255; G: 212; R: 43), (B: 240; G: 189; R: 39), - (B: 225; G: 166; R: 35), (B: 211; G: 144; R: 30), (B: 196; G: 121; R: 26), - (B: 181; G: 98; R: 22), (B: 163; G: 92; R: 20), (B: 127; G: 73; R: 15), - (B: 105; G: 60; R: 13), (B: 83; G: 46; R: 12), (B: 61; G: 33; R: 10), - (B: 39; G: 20; R: 8), (B: 26; G: 15; R: 9), (B: 252; G: 203; R: 179), - (B: 245; G: 189; R: 158), (B: 222; G: 167; R: 133), (B: 196; G: 147; R: 111), - (B: 186; G: 134; R: 91), (B: 174; G: 125; R: 81), (B: 161; G: 118; R: 78), - (B: 147; G: 110; R: 72), (B: 136; G: 102; R: 65), (B: 122; G: 93; R: 59), - (B: 110; G: 85; R: 55), (B: 98; G: 79; R: 53), (B: 85; G: 69; R: 46), - (B: 66; G: 54; R: 37), (B: 46; G: 40; R: 29), (B: 27; G: 25; R: 20), - (B: 228; G: 133; R: 133), (B: 225; G: 96; R: 94), (B: 222; G: 58; R: 55), - (B: 219; G: 21; R: 16), (B: 202; G: 20; R: 15), (B: 185; G: 18; R: 14), - (B: 167; G: 17; R: 13), (B: 150; G: 16; R: 12), (B: 133; G: 14; R: 11), - (B: 116; G: 13; R: 11), (B: 98; G: 12; R: 10), (B: 81; G: 10; R: 9), - (B: 64; G: 9; R: 8), (B: 47; G: 8; R: 7), (B: 29; G: 6; R: 6), - (B: 12; G: 5; R: 5), (B: 255; G: 255; R: 255), (B: 240; G: 240; R: 240), - (B: 220; G: 220; R: 220), (B: 201; G: 201; R: 201), (B: 181; G: 181; R: 181), - (B: 162; G: 162; R: 162), (B: 148; G: 148; R: 148), (B: 135; G: 135; R: 135), - (B: 121; G: 121; R: 121), (B: 108; G: 108; R: 108), (B: 90; G: 90; R: 90), - (B: 74; G: 74; R: 74), (B: 58; G: 58; R: 58), (B: 42; G: 42; R: 42), - (B: 22; G: 22; R: 22), (B: 8; G: 8; R: 8), (B: 104; G: 150; R: 233), - (B: 93; G: 125; R: 242), (B: 82; G: 98; R: 249), (B: 72; G: 72; R: 255), - (B: 48; G: 48; R: 255), (B: 25; G: 25; R: 254), (B: 7; G: 7; R: 246), - (B: 7; G: 7; R: 220), (B: 6; G: 6; R: 194), (B: 6; G: 6; R: 169), - (B: 5; G: 5; R: 143), (B: 5; G: 5; R: 117), (B: 4; G: 4; R: 91), - (B: 4; G: 4; R: 66), (B: 3; G: 3; R: 40), (B: 3; G: 3; R: 14), - (B: 191; G: 88; R: 117), (B: 180; G: 63; R: 97), (B: 169; G: 38; R: 78), - (B: 159; G: 14; R: 56), (B: 147; G: 13; R: 52), (B: 135; G: 12; R: 48), - (B: 123; G: 12; R: 44), (B: 111; G: 11; R: 40), (B: 99; G: 10; R: 36), - (B: 87; G: 9; R: 32), (B: 75; G: 8; R: 27), (B: 63; G: 7; R: 23), - (B: 51; G: 7; R: 19), (B: 39; G: 6; R: 15), (B: 27; G: 5; R: 11), - (B: 15; G: 4; R: 7), (B: 135; G: 224; R: 255), (B: 91; G: 213; R: 255), - (B: 46; G: 197; R: 255), (B: 2; G: 184; R: 255), (B: 2; G: 170; R: 235), - (B: 2; G: 156; R: 215), (B: 2; G: 141; R: 195), (B: 2; G: 127; R: 175), - (B: 2; G: 113; R: 155), (B: 3; G: 99; R: 136), (B: 3; G: 84; R: 116), - (B: 3; G: 70; R: 96), (B: 3; G: 56; R: 76), (B: 3; G: 42; R: 56), - (B: 3; G: 27; R: 36), (B: 3; G: 13; R: 16), (B: 254; G: 255; R: 199), - (B: 254; G: 235; R: 170), (B: 255; G: 215; R: 141), (B: 255; G: 205; R: 127), - (B: 255; G: 195; R: 112), (B: 255; G: 175; R: 83), (B: 234; G: 155; R: 50), - (B: 219; G: 131; R: 43), (B: 205; G: 107; R: 35), (B: 190; G: 84; R: 27), - (B: 176; G: 60; R: 19), (B: 155; G: 24; R: 10), (B: 130; G: 21; R: 9), - (B: 105; G: 19; R: 8), (B: 80; G: 16; R: 7), (B: 55; G: 13; R: 6), - (B: 197; G: 215; R: 255), (B: 181; G: 196; R: 233), (B: 165; G: 177; R: 212), - (B: 149; G: 158; R: 190), (B: 138; G: 146; R: 176), (B: 126; G: 134; R: 162), - (B: 115; G: 122; R: 147), (B: 103; G: 110; R: 133), (B: 92; G: 98; R: 119), - (B: 81; G: 87; R: 105), (B: 69; G: 75; R: 90), (B: 58; G: 63; R: 76), - (B: 46; G: 51; R: 62), (B: 35; G: 39; R: 48), (B: 23; G: 27; R: 33), - (B: 12; G: 15; R: 19)); - - { This is default Arena's palette (Arena\pal.col).} - ArenaPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 0; G: 0; R: 170), (B: 0; G: 170; R: 0), - (B: 0; G: 170; R: 170), (B: 170; G: 0; R: 0), (B: 170; G: 0; R: 170), - (B: 170; G: 85; R: 0), (B: 170; G: 170; R: 170), (B: 85; G: 85; R: 85), - (B: 85; G: 85; R: 255), (B: 85; G: 255; R: 85), (B: 85; G: 255; R: 255), - (B: 255; G: 85; R: 85), (B: 255; G: 85; R: 255), (B: 255; G: 255; R: 85), - (B: 255; G: 255; R: 255), (B: 212; G: 232; R: 248), (B: 193; G: 211; R: 227), - (B: 174; G: 190; R: 205), (B: 155; G: 169; R: 184), (B: 136; G: 148; R: 163), - (B: 118; G: 128; R: 142), (B: 99; G: 107; R: 120), (B: 80; G: 86; R: 99), - (B: 61; G: 65; R: 78), (B: 42; G: 44; R: 56), (B: 0; G: 180; R: 0), - (B: 0; G: 160; R: 0), (B: 0; G: 144; R: 0), (B: 144; G: 184; R: 0), - (B: 124; G: 160; R: 0), (B: 108; G: 140; R: 0), (B: 175; G: 175; R: 187), - (B: 160; G: 160; R: 172), (B: 145; G: 145; R: 157), (B: 129; G: 129; R: 141), - (B: 114; G: 114; R: 126), (B: 99; G: 99; R: 111), (B: 84; G: 84; R: 96), - (B: 69; G: 69; R: 81), (B: 53; G: 53; R: 65), (B: 38; G: 38; R: 50), - (B: 139; G: 127; R: 127), (B: 127; G: 117; R: 118), (B: 116; G: 106; R: 109), - (B: 104; G: 96; R: 99), (B: 93; G: 85; R: 90), (B: 81; G: 75; R: 81), - (B: 69; G: 65; R: 72), (B: 58; G: 54; R: 63), (B: 46; G: 44; R: 53), - (B: 35; G: 33; R: 44), (B: 127; G: 127; R: 139), (B: 117; G: 117; R: 129), - (B: 106; G: 106; R: 118), (B: 96; G: 96; R: 108), (B: 85; G: 85; R: 97), - (B: 75; G: 75; R: 87), (B: 65; G: 65; R: 77), (B: 54; G: 54; R: 66), - (B: 44; G: 44; R: 56), (B: 33; G: 33; R: 45), (B: 0; G: 0; R: 203), - (B: 0; G: 0; R: 175), (B: 30; G: 97; R: 134), (B: 29; G: 90; R: 124), - (B: 29; G: 82; R: 114), (B: 28; G: 75; R: 104), (B: 27; G: 67; R: 94), - (B: 27; G: 60; R: 85), (B: 26; G: 53; R: 75), (B: 25; G: 45; R: 65), - (B: 24; G: 38; R: 55), (B: 24; G: 30; R: 45), (B: 0; G: 127; R: 127), - (B: 2; G: 117; R: 118), (B: 5; G: 106; R: 109), (B: 7; G: 96; R: 99), - (B: 9; G: 85; R: 90), (B: 12; G: 75; R: 81), (B: 14; G: 65; R: 72), - (B: 16; G: 54; R: 63), (B: 18; G: 44; R: 53), (B: 21; G: 33; R: 44), - (B: 75; G: 92; R: 95), (B: 70; G: 85; R: 89), (B: 65; G: 78; R: 83), - (B: 59; G: 71; R: 77), (B: 54; G: 64; R: 71), (B: 49; G: 58; R: 65), - (B: 44; G: 51; R: 59), (B: 39; G: 44; R: 53), (B: 33; G: 37; R: 47), - (B: 28; G: 30; R: 41), (B: 187; G: 39; R: 239), (B: 195; G: 0; R: 199), - (B: 231; G: 215; R: 0), (B: 255; G: 167; R: 0), (B: 223; G: 119; R: 0), - (B: 231; G: 83; R: 0), (B: 139; G: 139; R: 150), (B: 111; G: 111; R: 123), - (B: 95; G: 95; R: 107), (B: 79; G: 79; R: 91), (B: 63; G: 63; R: 75), - (B: 51; G: 51; R: 59), (B: 43; G: 43; R: 51), (B: 39; G: 39; R: 47), - (B: 31; G: 31; R: 43), (B: 27; G: 27; R: 39), (B: 23; G: 23; R: 35), - (B: 19; G: 19; R: 31), (B: 15; G: 15; R: 27), (B: 255; G: 255; R: 255), - (B: 255; G: 255; R: 255), (B: 30; G: 9; R: 1), (B: 112; G: 112; R: 112), - (B: 103; G: 103; R: 104), (B: 94; G: 94; R: 97), (B: 85; G: 85; R: 89), - (B: 76; G: 76; R: 81), (B: 68; G: 68; R: 74), (B: 59; G: 59; R: 66), - (B: 50; G: 50; R: 58), (B: 41; G: 41; R: 50), (B: 32; G: 32; R: 43), - (B: 2; G: 221; R: 221), (B: 0; G: 175; R: 175), (B: 155; G: 51; R: 51), - (B: 142; G: 48; R: 49), (B: 129; G: 45; R: 48), (B: 115; G: 43; R: 46), - (B: 102; G: 40; R: 45), (B: 89; G: 37; R: 43), (B: 76; G: 34; R: 41), - (B: 63; G: 31; R: 40), (B: 49; G: 29; R: 38), (B: 36; G: 26; R: 37), - (B: 127; G: 0; R: 0), (B: 117; G: 2; R: 4), (B: 106; G: 5; R: 7), - (B: 96; G: 7; R: 11), (B: 85; G: 9; R: 14), (B: 75; G: 12; R: 18), - (B: 65; G: 14; R: 21), (B: 54; G: 16; R: 25), (B: 44; G: 18; R: 28), - (B: 33; G: 21; R: 32), (B: 78; G: 61; R: 48), (B: 73; G: 57; R: 47), - (B: 67; G: 53; R: 45), (B: 62; G: 50; R: 44), (B: 56; G: 46; R: 43), - (B: 51; G: 42; R: 42), (B: 45; G: 38; R: 40), (B: 40; G: 34; R: 39), - (B: 34; G: 31; R: 38), (B: 29; G: 27; R: 36), (B: 225; G: 2; R: 2), - (B: 195; G: 0; R: 0), (B: 0; G: 127; R: 0), (B: 2; G: 117; R: 4), - (B: 5; G: 106; R: 7), (B: 7; G: 96; R: 11), (B: 9; G: 85; R: 14), - (B: 12; G: 75; R: 18), (B: 14; G: 65; R: 21), (B: 16; G: 54; R: 25), - (B: 18; G: 44; R: 28), (B: 21; G: 33; R: 32), (B: 55; G: 63; R: 39), - (B: 52; G: 59; R: 39), (B: 49; G: 55; R: 38), (B: 45; G: 51; R: 38), - (B: 42; G: 47; R: 37), (B: 39; G: 43; R: 37), (B: 36; G: 39; R: 37), - (B: 33; G: 35; R: 36), (B: 29; G: 31; R: 36), (B: 26; G: 27; R: 35), - (B: 158; G: 176; R: 195), (B: 145; G: 161; R: 179), (B: 131; G: 145; R: 163), - (B: 118; G: 130; R: 147), (B: 104; G: 115; R: 131), (B: 91; G: 100; R: 115), - (B: 77; G: 84; R: 99), (B: 64; G: 69; R: 83), (B: 50; G: 54; R: 67), - (B: 37; G: 38; R: 51), (B: 56; G: 25; R: 25), (B: 36; G: 20; R: 26), - (B: 215; G: 159; R: 7), (B: 196; G: 145; R: 10), (B: 177; G: 132; R: 13), - (B: 157; G: 118; R: 15), (B: 138; G: 105; R: 18), (B: 119; G: 91; R: 21), - (B: 100; G: 77; R: 24), (B: 81; G: 64; R: 27), (B: 61; G: 50; R: 29), - (B: 42; G: 37; R: 32), (B: 139; G: 115; R: 0), (B: 127; G: 106; R: 4), - (B: 116; G: 97; R: 7), (B: 104; G: 87; R: 11), (B: 93; G: 78; R: 14), - (B: 81; G: 69; R: 18), (B: 69; G: 60; R: 21), (B: 58; G: 51; R: 25), - (B: 46; G: 41; R: 28), (B: 35; G: 32; R: 32), (B: 151; G: 99; R: 0), - (B: 138; G: 91; R: 4), (B: 125; G: 84; R: 7), (B: 113; G: 76; R: 11), - (B: 100; G: 69; R: 14), (B: 87; G: 61; R: 18), (B: 74; G: 53; R: 21), - (B: 61; G: 46; R: 25), (B: 49; G: 38; R: 28), (B: 36; G: 31; R: 32), - (B: 254; G: 170; R: 0), (B: 255; G: 184; R: 0), (B: 211; G: 203; R: 179), - (B: 208; G: 195; R: 167), (B: 205; G: 186; R: 155), (B: 212; G: 178; R: 143), - (B: 200; G: 163; R: 131), (B: 187; G: 148; R: 119), (B: 183; G: 133; R: 107), - (B: 170; G: 118; R: 95), (B: 156; G: 104; R: 84), (B: 143; G: 89; R: 72), - (B: 126; G: 74; R: 60), (B: 103; G: 59; R: 48), (B: 90; G: 45; R: 36), - (B: 77; G: 30; R: 24), (B: 64; G: 15; R: 12), (B: 41; G: 0; R: 0), - (B: 212; G: 120; R: 8), (B: 209; G: 111; R: 9), (B: 206; G: 102; R: 10), - (B: 204; G: 92; R: 10), (B: 201; G: 83; R: 11), (B: 198; G: 74; R: 12), - (B: 195; G: 65; R: 13), (B: 192; G: 56; R: 14), (B: 190; G: 46; R: 14), - (B: 187; G: 37; R: 15), (B: 184; G: 28; R: 16), (B: 0; G: 0; R: 60), - (B: 251; G: 239; R: 79), (B: 191; G: 115; R: 0), (B: 197; G: 197; R: 197), - (B: 52; G: 52; R: 52)); - - { This is default Terminator Future Shock's palette (Shock\Gamedata\Shock.col).} - FutureShockPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 255; G: 255; R: 255), (B: 255; G: 255; R: 211), - (B: 255; G: 255; R: 177), (B: 255; G: 255; R: 127), (B: 255; G: 255; R: 97), - (B: 255; G: 210; R: 67), (B: 255; G: 166; R: 55), (B: 255; G: 0; R: 0), - (B: 255; G: 131; R: 0), (B: 0; G: 255; R: 0), (B: 71; G: 71; R: 255), - (B: 255; G: 255; R: 0), (B: 254; G: 137; R: 46), (B: 216; G: 111; R: 37), - (B: 177; G: 88; R: 29), (B: 51; G: 55; R: 55), (B: 55; G: 51; R: 55), - (B: 51; G: 51; R: 53), (B: 51; G: 51; R: 54), (B: 59; G: 51; R: 63), - (B: 59; G: 51; R: 54), (B: 51; G: 55; R: 57), (B: 51; G: 51; R: 51), - (B: 239; G: 51; R: 239), (B: 239; G: 51; R: 239), (B: 239; G: 51; R: 239), - (B: 239; G: 51; R: 239), (B: 64; G: 41; R: 38), (B: 49; G: 33; R: 32), - (B: 33; G: 26; R: 27), (B: 18; G: 18; R: 21), (B: 191; G: 239; R: 211), - (B: 179; G: 223; R: 195), (B: 163; G: 207; R: 179), (B: 147; G: 191; R: 159), - (B: 131; G: 175; R: 143), (B: 115; G: 155; R: 127), (B: 103; G: 139; R: 111), - (B: 91; G: 131; R: 103), (B: 83; G: 119; R: 91), (B: 75; G: 107; R: 83), - (B: 67; G: 95; R: 71), (B: 63; G: 87; R: 67), (B: 59; G: 79; R: 63), - (B: 55; G: 71; R: 59), (B: 55; G: 63; R: 55), (B: 51; G: 55; R: 51), - (B: 227; G: 203; R: 203), (B: 211; G: 187; R: 187), (B: 191; G: 175; R: 171), - (B: 175; G: 159; R: 159), (B: 159; G: 143; R: 143), (B: 143; G: 127; R: 127), - (B: 127; G: 111; R: 111), (B: 115; G: 99; R: 99), (B: 103; G: 91; R: 91), - (B: 91; G: 83; R: 83), (B: 83; G: 71; R: 71), (B: 75; G: 67; R: 67), - (B: 71; G: 63; R: 63), (B: 67; G: 59; R: 59), (B: 63; G: 55; R: 55), - (B: 59; G: 51; R: 51), (B: 179; G: 235; R: 247), (B: 163; G: 219; R: 231), - (B: 147; G: 203; R: 219), (B: 131; G: 187; R: 203), (B: 115; G: 171; R: 191), - (B: 99; G: 155; R: 175), (B: 83; G: 139; R: 163), (B: 75; G: 127; R: 151), - (B: 67; G: 115; R: 139), (B: 59; G: 103; R: 123), (B: 51; G: 91; R: 111), - (B: 51; G: 83; R: 99), (B: 51; G: 79; R: 91), (B: 51; G: 71; R: 79), - (B: 51; G: 63; R: 67), (B: 51; G: 55; R: 55), (B: 207; G: 207; R: 215), - (B: 191; G: 191; R: 199), (B: 175; G: 179; R: 187), (B: 163; G: 163; R: 171), - (B: 147; G: 151; R: 155), (B: 131; G: 135; R: 143), (B: 119; G: 119; R: 127), - (B: 107; G: 111; R: 115), (B: 99; G: 103; R: 107), (B: 87; G: 91; R: 95), - (B: 79; G: 83; R: 83), (B: 71; G: 75; R: 79), (B: 67; G: 71; R: 71), - (B: 63; G: 63; R: 67), (B: 55; G: 59; R: 59), (B: 51; G: 55; R: 55), - (B: 231; G: 211; R: 171), (B: 215; G: 195; R: 155), (B: 199; G: 179; R: 143), - (B: 187; G: 159; R: 127), (B: 171; G: 143; R: 111), (B: 155; G: 127; R: 95), - (B: 139; G: 107; R: 83), (B: 131; G: 99; R: 75), (B: 119; G: 87; R: 67), - (B: 107; G: 75; R: 59), (B: 95; G: 67; R: 51), (B: 87; G: 63; R: 51), - (B: 79; G: 59; R: 51), (B: 71; G: 59; R: 51), (B: 63; G: 55; R: 51), - (B: 55; G: 51; R: 51), (B: 140; G: 47; R: 47), (B: 179; G: 54; R: 54), - (B: 255; G: 99; R: 0), (B: 255; G: 191; R: 0), (B: 151; G: 78; R: 26), - (B: 112; G: 70; R: 41), (B: 94; G: 57; R: 53), (B: 64; G: 41; R: 38), - (B: 47; G: 47; R: 52), (B: 43; G: 43; R: 49), (B: 38; G: 38; R: 44), - (B: 35; G: 35; R: 40), (B: 31; G: 31; R: 36), (B: 27; G: 27; R: 30), - (B: 22; G: 22; R: 27), (B: 18; G: 18; R: 21), (B: 175; G: 219; R: 219), - (B: 131; G: 231; R: 231), (B: 95; G: 231; R: 231), (B: 51; G: 239; R: 239), - (B: 51; G: 235; R: 235), (B: 51; G: 219; R: 219), (B: 51; G: 199; R: 199), - (B: 51; G: 175; R: 179), (B: 51; G: 159; R: 163), (B: 51; G: 139; R: 143), - (B: 51; G: 119; R: 123), (B: 51; G: 99; R: 107), (B: 51; G: 87; R: 91), - (B: 51; G: 71; R: 79), (B: 51; G: 55; R: 63), (B: 51; G: 51; R: 51), - (B: 219; G: 219; R: 175), (B: 231; G: 231; R: 131), (B: 231; G: 231; R: 95), - (B: 239; G: 239; R: 51), (B: 235; G: 235; R: 51), (B: 219; G: 219; R: 51), - (B: 199; G: 199; R: 51), (B: 179; G: 175; R: 51), (B: 163; G: 159; R: 51), - (B: 143; G: 139; R: 51), (B: 123; G: 119; R: 51), (B: 107; G: 99; R: 51), - (B: 91; G: 87; R: 51), (B: 79; G: 71; R: 51), (B: 63; G: 55; R: 51), - (B: 51; G: 51; R: 51), (B: 219; G: 175; R: 219), (B: 231; G: 131; R: 231), - (B: 231; G: 95; R: 231), (B: 239; G: 51; R: 239), (B: 235; G: 51; R: 235), - (B: 219; G: 51; R: 219), (B: 199; G: 51; R: 199), (B: 179; G: 51; R: 179), - (B: 163; G: 51; R: 159), (B: 143; G: 51; R: 139), (B: 123; G: 51; R: 119), - (B: 107; G: 51; R: 99), (B: 91; G: 51; R: 87), (B: 79; G: 51; R: 71), - (B: 63; G: 51; R: 55), (B: 51; G: 51; R: 51), (B: 175; G: 219; R: 175), - (B: 131; G: 231; R: 131), (B: 99; G: 231; R: 99), (B: 55; G: 235; R: 55), - (B: 55; G: 231; R: 55), (B: 55; G: 211; R: 55), (B: 63; G: 187; R: 63), - (B: 71; G: 159; R: 71), (B: 67; G: 143; R: 67), (B: 67; G: 127; R: 67), - (B: 63; G: 111; R: 63), (B: 59; G: 99; R: 59), (B: 59; G: 83; R: 59), - (B: 55; G: 71; R: 55), (B: 55; G: 59; R: 55), (B: 51; G: 55; R: 51), - (B: 143; G: 143; R: 223), (B: 123; G: 123; R: 235), (B: 95; G: 95; R: 243), - (B: 59; G: 59; R: 255), (B: 55; G: 55; R: 235), (B: 59; G: 59; R: 211), - (B: 63; G: 63; R: 191), (B: 67; G: 67; R: 167), (B: 63; G: 63; R: 151), - (B: 63; G: 63; R: 131), (B: 59; G: 59; R: 119), (B: 55; G: 55; R: 103), - (B: 55; G: 55; R: 91), (B: 55; G: 55; R: 75), (B: 51; G: 51; R: 63), - (B: 51; G: 51; R: 55), (B: 219; G: 131; R: 131), (B: 235; G: 111; R: 111), - (B: 239; G: 95; R: 95), (B: 243; G: 67; R: 67), (B: 235; G: 51; R: 51), - (B: 215; G: 51; R: 51), (B: 199; G: 55; R: 55), (B: 179; G: 51; R: 51), - (B: 163; G: 51; R: 51), (B: 143; G: 51; R: 51), (B: 123; G: 51; R: 51), - (B: 107; G: 51; R: 51), (B: 91; G: 51; R: 51), (B: 79; G: 51; R: 51), - (B: 63; G: 51; R: 51), (B: 51; G: 51; R: 51), (B: 203; G: 187; R: 227), - (B: 191; G: 175; R: 211), (B: 175; G: 163; R: 195), (B: 159; G: 147; R: 179), - (B: 147; G: 135; R: 167), (B: 131; G: 123; R: 151), (B: 119; G: 107; R: 135), - (B: 107; G: 99; R: 123), (B: 99; G: 91; R: 111), (B: 91; G: 83; R: 103), - (B: 79; G: 71; R: 91), (B: 75; G: 67; R: 83), (B: 71; G: 63; R: 79), - (B: 67; G: 59; R: 71), (B: 63; G: 55; R: 67), (B: 59; G: 51; R: 63), - (B: 183; G: 219; R: 227), (B: 167; G: 203; R: 211), (B: 151; G: 187; R: 191), - (B: 135; G: 167; R: 175), (B: 119; G: 151; R: 155), (B: 99; G: 135; R: 139), - (B: 83; G: 119; R: 119), (B: 75; G: 107; R: 111), (B: 67; G: 95; R: 99), - (B: 67; G: 91; R: 91), (B: 63; G: 83; R: 83), (B: 59; G: 75; R: 79), - (B: 59; G: 71; R: 71), (B: 55; G: 63; R: 63), (B: 51; G: 59; R: 59), - (B: 49; G: 51; R: 51)); - -implementation - -uses - Types, - SysUtils, - Classes, - ImagingIO, - ImagingUtility, - ElderImageryBsi, - ElderImageryCif, - ElderImageryImg, - ElderImageryTexture, - ElderImagerySky; - -{ TDaggerfallFileFormat class implementation } - -procedure TElderFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffSave, ffMultiImage]; - FSupportedFormats := []; - - GetMem(FARGBPalette, Length(FPalette) * SizeOf(TColor32Rec)); - SetPalette(DaggerfallPalette); -end; - -destructor TElderFileFormat.Destroy; -begin - FreeMem(FARGBPalette); - inherited Destroy; -end; - -procedure TElderFileFormat.DagRLEDecode(InData: Pointer; OutSize: LongInt; - out OutData: Pointer); -var - I, Pos, CByte: LongInt; - Rle, B: Byte; -begin - Pos := 0; - CByte := 0; - while Pos < OutSize do - begin - Rle := PByteArray(InData)[CByte]; - CByte := CByte + 1; - if Rle < 128 then - begin - Rle := Rle + 1; - Move(PByteArray(InData)[CByte], PByteArray(OutData)[Pos], Rle); - CByte := CByte + Rle; - Pos := Pos + Rle; - end - else - begin - Rle := Rle - 127; - B := PByteArray(InData)[CByte];; - CByte := CByte + 1; - for I := 0 to Rle - 1 do - begin - PByteArray(OutData)[Pos] := B; - Pos := Pos + 1; - end; - end; - end; -end; - -function TElderFileFormat.FindNoHeaderInfo(Size: LongInt; - Infos: array of TNoHeaderFileInfo): LongInt; -var - I: LongInt; -begin - for I := Low(Infos) to High(Infos) do - begin - if Size = Infos[I].Size then - begin - Result := I; - Exit; - end; - end; - Result := -1; -end; - -function TElderFileFormat.TestNoHeaderFormat(Handle: TImagingHandle): TElderFileFormatClass; -var - InputSize, I: LongInt; -begin - Result := nil; - if Handle <> nil then - begin - InputSize := GetInputSize(GetIO, Handle); - // Check special IMG files - I := FindNoHeaderInfo(InputSize, NoHeaderIMGInfos); - if I >= 0 then - begin - Result := TIMGFileFormat; - Exit; - end; - // Check special CIF files - I := FindNoHeaderInfo(InputSize, NoHeaderCIFInfos); - if I >= 0 then - begin - Result := TCIFFileFormat; - Exit; - end; - end; -end; - -procedure TElderFileFormat.ConvertPalette(const ElderPal: TPalette24Size256; - ARGBPal: PPalette32); -var - I: LongInt; -begin - for I := Low(ElderPal) to High(ElderPal) do - begin - ARGBPal[I].A := $FF; - ARGBPal[I].R := ElderPal[I].B; - ARGBPal[I].G := ElderPal[I].G; - ARGBPal[I].B := ElderPal[I].R; - end; - // Palette index 0 represents transparent color - ARGBPal[0].A := 0; -end; - -procedure TElderFileFormat.SetPalette(const Value: TPalette24Size256); -begin - FPalette := Value; - ConvertPalette(FPalette, FARGBPalette); -end; - -procedure TElderFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - R: TRect; -begin - if CanSave then - begin - if Image.Width * Image.Height > 65535 then - begin - // Regular CIF and IMG files can only store images no larger than 65535 bytes - if Image.Width > Image.Height then - R := Rect(0, 0, 320, 200) - else - R := Rect(0, 0, 200, 320); - R := ScaleRectToRect(Rect(0, 0, Image.Width, Image.Height), R); - ResizeImage(Image, R.Right - R.Left, R.Bottom - R.Top, rfBilinear); - end; - // Map image to current palette - MapImageToPalette(Image, FARGBPalette, Length(FPalette)); - end; -end; - -function TElderFileFormat.IsSupported(const Image: TImageData): Boolean; -begin - // Image is supported for saving if its indexed and is mapped to current palette - Result := (Image.Format = ifIndex8) and - CompareMem(Image.Palette, FARGBPalette, Length(FPalette) * SizeOf(TColor32Rec)); -end; - -function TElderFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TImgHeader; - DagClass: TElderFileFormatClass; - ReadCount: LongInt; -begin - // TestFormat for both IMG and CIF formats - Result := False; - DagClass := TestNoHeaderFormat(Handle); - if (DagClass = nil) and (Handle <> nil) then - begin - // Check ordinary IMG/CIF files with header - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount > 0) and (Hdr.ImageSize <= Hdr.Width * Hdr.Height) and - (Hdr.Width * Hdr.Height <= High(Word)) and (Hdr.ImageSize <> 0) and - (Hdr.Width <> 0) and (Hdr.Height <> 0); - if IsMultiImageFormat then - Result := Result and (GetInputSize(GetIO, Handle) > Hdr.ImageSize + SizeOf(Hdr)) - else - Result := Result and (GetInputSize(GetIO, Handle) = Hdr.ImageSize + SizeOf(Hdr)); - end - else if DagClass = Self.ClassType then - Result := True; -end; - -initialization - RegisterImageFileFormat(TBSIFileFormat); - RegisterImageFileFormat(TCIFFileFormat); - RegisterImageFileFormat(TIMGFileFormat); - RegisterImageFileFormat(TTextureFileFormat); - RegisterImageFileFormat(TSKYFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Fixed TestFormat which could identify something (eof) as image. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Too large images that are to be saved in CIF/IMG formats are - automatically rescaled in ConvertToSupported method. - - MakeCompatible method moved to base class, put ConvertToSupported here. - GetSupportedFormats removed, it is now set in constructor. - - Added default palettes for more games. - - Added transparency to Daggerfall palettes. - - Initial version created based on my older code. -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ElderImageryBsi.pas b/components/vampireimaging/Extras/Extensions/ElderImageryBsi.pas deleted file mode 100644 index e592071..0000000 --- a/components/vampireimaging/Extras/Extensions/ElderImageryBsi.pas +++ /dev/null @@ -1,409 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader for textures and images - from Redguard and BattleSpire.} -unit ElderImageryBsi; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ElderImagery, ImagingUtility; - -type - { Class for loading of BSI format textures and images found - in Redguard and BattleSpire (maybe in other games too, Skynet?). This format - uses chunk structure similar to PNG (HDR/DAT/END). Redguard stores - multiple images in one file (usually related like textures for various - parts of single 3d object). Image data is stored as 8bit. Each image - can have its own embedded palette or it can use external default palette. - BattleSpire BSI use *.bsi file extension whilst Redguard uses - texbsi.* mask with number extension (just like Daggerfall). - Only loading is supported for this format. - BattleSpire images also contain some sort of 8bit->16bit color mapping data - which I've not yet figured out (only blue channel known).} - TBSIFileFormat = class(TElderFileFormat) - private - function IsMultiBSI(Handle: TImagingHandle): Boolean; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SBSIFormatName = 'Bethesda Image'; - SBSIMasks = '*.bsi,texbsi.*'; - -resourcestring - SErrorLoadingChunk = 'Error when reading %s chunk data.'; - -type - { BSI chunk header.} - TChunk = packed record - ChunkID: TChar4; - DataSize: LongWord; // In Big Endian! - end; - - { Additional header of BSI textures.} - TTextureBSIHeader = packed record - Name: array[0..8] of AnsiChar; - ImageSize: LongInt; - end; - - { Main image info header located in BHDR chunk's data.} - TBHDRChunk = packed record - OffsetX: Word; - OffsetY: Word; - Width: SmallInt; - Height: SmallInt; - Unk1, Unk2: Byte; - Unk3, Unk4: Word; - Frames: Word; - Unk6, Unk7, Unk8: Word; - Unk9, Unk10: Byte; - Unk11: Word; - end; - -const - IFHDSignature: TChar4 = 'IFHD'; - BSIFSignature: TChar4 = 'BSIF'; - BHDRSignature: TChar4 = 'BHDR'; - CMAPSignature: TChar4 = 'CMAP'; - HICLSignature: TChar4 = 'HICL'; - HTBLSignature: TChar4 = 'HTBL'; - DATASignature: TChar4 = 'DATA'; - ENDSignature: TChar4 = 'END '; - - -{ TBSIFileFormat class implementation } - -procedure TBSIFileFormat.Define; -begin - inherited; - FName := SBSIFormatName; - FFeatures := [ffLoad, ffMultiImage]; - - AddMasks(SBSIMasks); - SetPalette(RedguardPalette); -end; - -function TBSIFileFormat.IsMultiBSI(Handle: TImagingHandle): Boolean; -var - ReadCount, StartPos: LongInt; - Sig: TChar4; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - StartPos := Tell(Handle); - // Redguard textures have 13 byte tex header and then IFHD or BSIF - Seek(Handle, SizeOf(TTextureBSIHeader), smFromCurrent); - ReadCount := Read(Handle, @Sig, SizeOf(Sig)); - Seek(Handle, StartPos, smFromBeginning); - Result := Result or ((ReadCount = SizeOf(Sig)) and - ((Sig = IFHDSignature) or (Sig = BSIFSignature))); - end; -end; - -function TBSIFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Chunk: TChunk; - ChunkData: Pointer; - DATASize: LongInt; - BHDR: TBHDRChunk; - PalLoaded: TPalette24Size256; - HICL: PByteArray; - HTBL: PWordArray; - IsMulti: Boolean; - TextureHdr: TTextureBSIHeader; - PaletteFound: Boolean; - - procedure ReadChunk; - begin - GetIO.Read(Handle, @Chunk, SizeOf(Chunk)); - Chunk.DataSize := SwapEndianUInt32(Chunk.DataSize); - end; - - procedure ReadChunkData; - var - ReadBytes: LongWord; - begin - FreeMemNil(ChunkData); - GetMem(ChunkData, Chunk.DataSize); - ReadBytes := GetIO.Read(Handle, ChunkData, Chunk.DataSize); - if ReadBytes <> Chunk.DataSize then - RaiseImaging(SErrorLoadingChunk, [Chunk.ChunkID]); - end; - - procedure SkipChunkData; - begin - GetIO.Seek(Handle, Chunk.DataSize, smFromCurrent); - end; - - procedure GetBHDR; - begin - ReadChunkData; - BHDR := TBHDRChunk(ChunkData^); - end; - - procedure GetHICL; - begin - ReadChunkData; - GetMem(HICL, Chunk.DataSize); - Move(ChunkData^, HICL[0], Chunk.DataSize); - end; - - procedure GetHTBL; - begin - ReadChunkData; - GetMem(HTBL, Chunk.DataSize); - Move(ChunkData^, HTBL[0], Chunk.DataSize); - end; - - procedure GetCMAP; - begin - ReadChunkData; - Move(ChunkData^, PalLoaded, Chunk.DataSize); - PaletteFound := True; - end; - - procedure GetDATA; - begin - ReadChunkData; - DATASize := Chunk.DataSize; - end; - - function AddImage(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifIndex8, Images[Result]); - if not PaletteFound then - Move(FARGBPalette[0], Images[Result].Palette[0], Length(FPalette) * SizeOf(TColor32Rec)) - else - ConvertPalette(PalLoaded, Images[Result].Palette); - end; - - function AddImageHiColor(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifA8R8G8B8, Images[Result]); - end; - - procedure Reconstruct; - var - Index, I, J, K: LongInt; - RowOffsets: PUInt32Array; - Idx: Byte; - W: Word; - begin - if HICL = nil then - begin - if BHDR.Frames = 1 then - begin - // Load simple image - Index := AddImage(BHDR.Width, BHDR.Height); - Move(ChunkData^, Images[Index].Bits^, Images[Index].Size); - end - else - begin - // Load animated image: - // At the beggining of the chunk data there is BHDR.Height * BHDR.Frames - // 32bit offsets. Each BHDR.Height offsets point to rows of the current frame - RowOffsets := PUInt32Array(ChunkData); - - for I := 0 to BHDR.Frames - 1 do - begin - Index := AddImage(BHDR.Width, BHDR.Height); - with Images[Index] do - for J := 0 to BHDR.Height - 1 do - Move(PByteArray(ChunkData)[RowOffsets[I * BHDR.Height + J]], - PByteArray(Bits)[J * Width], Width); - end; - end; - end - else - begin - if BHDR.Frames = 1 then - begin - // Experimental BattleSpire 16bit image support! - Index := AddImageHiColor(BHDR.Width, BHDR.Height); - with Images[Index] do - for I := 0 to DATASize - 1 do - with PColor32RecArray(Bits)[I] do - begin - // It looks like "HICL[PByteArray(ChunkData)[I]] and 63" gives - // value of 6bit Blue channel, not other channels are sure yet. - // So now it looks grayscalish. - // You can also get interesting results using HTBL as look up table - // 8->16bit. There are 16 tables for shading (table 0 - darkest colors, - // table 15 - lightest) each with 256 16bit Words. But their data format - // is weird (555 is closest). There are some pixels that look - // as they should (proper color) but some does not. - // PWordArray(Bits)[I] := HTBL[256 * 15 + PByteArray(ChunkData)[I]] - Idx := PByteArray(ChunkData)[I]; - A := Iff(Idx <> 0, 255, 0); - R := MulDiv(HICL[Idx] and 63, 255, 63); - G := MulDiv(HICL[Idx] and 63, 255, 63); - B := MulDiv(HICL[Idx] and 63, 255, 63); - end; - end - else - begin - // Load animated BattleSpire image, uses offset list just like Redguard - // animated textures (but high word must be zeroed first to get valid offset) - RowOffsets := PUInt32Array(ChunkData); - - for I := 0 to BHDR.Frames - 1 do - begin - Index := AddImageHiColor(BHDR.Width, BHDR.Height); - with Images[Index] do - for J := 0 to BHDR.Height - 1 do - for K := 0 to BHDR.Width - 1 do - with PColor32RecArray(Bits)[J * BHDR.Width + K] do - begin - Idx := PByteArray(ChunkData)[RowOffsets[I * BHDR.Height + J] and $FFFF + K]; - W := HTBL[256 * 15 + Idx]; - A := Iff(Idx <> 0, 255, 0); - R := MulDiv(W shr 10 and 31, 255, 31); - G := MulDiv(W shr 5 and 31, 255, 31); - B := MulDiv(W and 31, 255, 31); - { A := Iff(Idx <> 0, 255, 0); - R := MulDiv(HICL[Idx] and 63, 255, 63); - G := MulDiv(HICL[Idx] and 63, 255, 63); - B := MulDiv(HICL[Idx] and 63, 255, 63);} - end; - end; - end; - end; - end; - - procedure ReadTextureHeader; - begin - FillChar(TextureHdr, SizeOf(TextureHdr), 0); - if IsMulti then - GetIO.Read(Handle, @TextureHdr, SizeOf(TextureHdr)) - else if Length(Images) = 0 then - // Ensure that while loop that reads chunks is executed for - // single-image files - TextureHdr.ImageSize := 1; - end; - -begin - ChunkData := nil; - HICL := nil; - HTBL := nil; - SetLength(Images, 0); - IsMulti := IsMultiBSI(Handle); - with GetIO do - begin - // Redguard textures can contain more than one image. Try to read texture - // header and if ImageSize is >0 there is another image. - ReadTextureHeader; - while TextureHdr.ImageSize > 0 do - try - PaletteFound := False; - ReadChunk; - SkipChunkData; - // Read data chunks. If they are recognized their data is stored for - // later image reconstruction - repeat - ReadChunk; - if Chunk.ChunkID = BHDRSignature then - GetBHDR - else if Chunk.ChunkID = HICLSignature then - GetHICL - else if Chunk.ChunkID = HTBLSignature then - GetHTBL - else if Chunk.ChunkID = CMAPSignature then - GetCMAP - else if Chunk.ChunkID = DATASignature then - GetDATA - else - SkipChunkData; - until Eof(Handle) or (Chunk.ChunkID = ENDSignature); - // Recontruct current image according to data read from chunks - Reconstruct; - // Read header for next image - ReadTextureHeader; - finally - FreeMemNil(ChunkData); - FreeMemNil(HICL); - FreeMemNil(HTBL); - end; - Result := True; - end; -end; - -function TBSIFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - ReadCount: LongInt; - Sig: TChar4; -begin - // First check if have multi-image BSI file (Redguard textures) - Result := IsMultiBSI(Handle); - if not Result and (Handle <> nil) then - with GetIO do - begin - // Check standard Bettlespire images with IFHD chunk at - // the beginning of the file - ReadCount := Read(Handle, @Sig, SizeOf(Sig)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(Sig)) and (Sig = IFHDSignature); - end; -end; - - -{ - Changes/Bug Fixes: - - -- TODOS ---------------------------------------------------- - - crack the BattleSpire format completely - - -- 0.21 ----------------------------------------------------- - - Blue channel of BattleSpire images cracked but others arer still unknown. - - Added support for animated BattleSpire images. - - Added support for animated Redguard textures. - - Added support for Redguard textures (Battlespire images still don't figured out). - - Updated to current Imaging version. - - -- 0.13 ----------------------------------------------------- - - TBSIFileFormat class added - -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ElderImageryCif.pas b/components/vampireimaging/Extras/Extensions/ElderImageryCif.pas deleted file mode 100644 index 22bbd35..0000000 --- a/components/vampireimaging/Extras/Extensions/ElderImageryCif.pas +++ /dev/null @@ -1,289 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Daggerfall - multi-image fomat CIF.} -unit ElderImageryCif; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingIO, ElderImagery; - -type - { Class for loading and saving of multi-images in CIF format. It is - 8 bit indexed format found in Daggerfall. It is basically a sequence of - images in IMG (see TIMGFileFormat) stored in one file (with exception - of Weapo*.cif files which are little bit more complex). As with IMG files - CIF files can be RLE compressed and there are also special CIFs without header. - Total number of frames in file is known after the whole file was parsed - so exact file size must be known prior to loading.} - TCIFFileFormat = class(TElderFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - end; - -const - { Info about special CIFs without header.} - NoHeaderCIFInfos: array[0..6] of TNoHeaderFileInfo = ( - (Size: 2601; Width: 17; Height: 17), // MPOP.RCI - (Size: 3168; Width: 44; Height: 9), // NOTE.RCI - (Size: 4356; Width: 22; Height: 22), // SPOP.RCI - (Size: 10752; Width: 32; Height: 16), // BUTTONS.RCI - (Size: 49152; Width: 64; Height: 64), // CHLD00I0.RCI - (Size: 249856; Width: 64; Height: 64), // FACES.CIF - (Size: 2060295; Width: 64; Height: 64)); // TFAC00I0.RCI - -implementation - -const - SCIFFormatName = 'Daggerfall MultiImage'; - SCIFMasks = '*.cif,*.rci'; - -resourcestring - SInvalidImageSize = 'Size of image in IMG/CIF format cannot exceed 65535 bytes. %s'; - -type - { Header for CIF group files.} - TCIFGroup = packed record - Width: Word; - Height: Word; - XOff: Word; - YOff: Word; - Unk: Word; - ImageSize: Word; // Size of Image data (but not always) - Offsets: array[0..31] of Word; // Offsets from beginning of header to - // image datas. Last offset points to next - // group header - end; - -{ TCIFFileFormat class implementation } - -procedure TCIFFileFormat.Define; -begin - inherited; - FName := SCIFFormatName; - AddMasks(SCIFMasks); -end; - -function TCIFFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TImgHeader; - Group: TCIFGroup; - Data: Pointer; - IsWeapon, ISW9, IsStandard, IsFirst: Boolean; - InputSize, I, FrameWidth, FrameHeight, OldPos, Index, BufferSize: LongInt; - HasHeader: Boolean; - - function AddImage(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifIndex8, Images[Result]); - Move(FARGBPalette[0], Images[Result].Palette[0], Length(FPalette) * SizeOf(TColor32Rec)); - end; - -begin - SetLength(Images, 0); - with GetIO do - begin - InputSize := GetInputSize(GetIO, Handle); - HasHeader := True; - IsWeapon := False; - IsW9 := False; - IsFirst := True; - FrameWidth := 0; - FrameHeight := 0; - - // Check if this is one of special CIF with no header - I := FindNoHeaderInfo(InputSize, NoHeaderCIFInfos); - - if I >= 0 then - begin - // It is no-header CIF - FrameWidth := NoHeaderCIFInfos[I].Width; - FrameHeight := NoHeaderCIFInfos[I].Height; - HasHeader := False; - end; - - if HasHeader then - begin - OldPos := Tell(Handle); - // CIF has header so use its values - Read(Handle, @Hdr, SizeOf(Hdr)); - - if Hdr.Unk = $15 then - begin - // This file is weapon09.cif (shooting arrows) - IsWeapon := True; - IsW9 := True; - end; - - if Tell(Handle) + Hdr.ImageSize < InputSize then - begin - Seek(Handle, Hdr.ImageSize, smFromCurrent); - Read(Handle, @Group, SizeOf(Group)); - if Group.Offsets[0] = 76 then - // CIF is regular weapon file - IsWeapon := True; - end; - Seek(Handle, OldPos, smFromBeginning); - end; - - IsStandard := HasHeader and (not IsWeapon); - - while not Eof(Handle) do - begin - if IsStandard then - begin - // Handle CIFs in standard format with header - Read(Handle, @Hdr, SizeOf(Hdr)); - Index := AddImage(Hdr.Width, Hdr.Height); - if Hdr.Unk <> 2 then - begin - // Read uncompressed data - Read(Handle, Images[Index].Bits, Hdr.ImageSize); - end - else - begin - GetMem(Data, Hdr.ImageSize); - try - // Read RLE compressed data - Read(Handle, Data, Hdr.ImageSize); - DagRLEDecode(Data, Images[Index].Size, Images[Index].Bits); - finally - FreeMem(Data); - end; - end; - end - else if not HasHeader then - begin - // Handle CIFs in standard format without header - if Tell(Handle) + FrameWidth * FrameHeight <= InputSize then - begin - Index := AddImage(FrameWidth, FrameHeight); - Read(Handle, Images[Index].Bits, Images[Index].Size); - end - else - Break; - end - else if IsWeapon then - begin - // Handle CIFs with weapon animations - if IsFirst and (not IsW9) then - begin - // First frame is std IMG file, next ones are not - // but if IsW9 is true this first frame is missing - Read(Handle, @Hdr, SizeOf(Hdr)); - Index := AddImage(Hdr.Width, Hdr.Height); - Read(Handle, Images[Index].Bits, Images[Index].Size); - IsFirst := False; - end - else - begin - OldPos := Tell(Handle); - // Read next group - Read(Handle, @Group, SizeOf(Group)); - // Read images in group - I := 0; - while Group.Offsets[I] <> 0 do - begin - BufferSize := Group.Offsets[I + 1] - Group.Offsets[I]; - if BufferSize < 0 then - BufferSize := Group.Offsets[31] - Group.Offsets[I]; - - Seek(Handle, OldPos + Group.Offsets[I], smFromBeginning); - Index := AddImage(Group.Width, Group.Height); - // Read current image from current group and decode it - GetMem(Data, BufferSize); - try - Read(Handle, Data, BufferSize); - DagRLEDecode(Data, Images[Index].Size, Images[Index].Bits); - Inc(I); - finally - FreeMem(Data); - end; - end; - Seek(Handle, OldPos + Group.Offsets[31], smFromBeginning); - end; - end; - end; - Result := True; - end; -end; - -function TCIFFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - Hdr: TImgHeader; - ImageToSave: TImageData; - MustBeFreed: Boolean; - I: LongInt; -begin - Result := False; - for I := FFirstIdx to FLastIdx do - begin - if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - FillChar(Hdr, SizeOf(Hdr), 0); - Hdr.Width := Width; - Hdr.Height := Height; - // Hdr.ImageSize is Word so max size of image in bytes can be 65535 - if Width * Height > High(Word) then - RaiseImaging(SInvalidImageSize, [ImageToStr(ImageToSave)]); - Hdr.ImageSize := Width * Height; - Write(Handle, @Hdr, SizeOf(Hdr)); - Write(Handle, Bits, Hdr.ImageSize); - finally - if MustBeFreed then - FreeImage(ImageToSave); - end - else - Exit; - end; - Result := True; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Initial version created based on my older code (fixed few things). -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ElderImageryImg.pas b/components/vampireimaging/Extras/Extensions/ElderImageryImg.pas deleted file mode 100644 index 19c37d8..0000000 --- a/components/vampireimaging/Extras/Extensions/ElderImageryImg.pas +++ /dev/null @@ -1,226 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for IMG file format used - in Daggerfall and other old Bethesda games.} -unit ElderImageryImg; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingIO, ElderImagery; - -type - { Class for loading and saving of images in IMG format. It is - 8 bit indexed format found in Daggerfall, Arena, Terminator: FS, - and maybe other old Bethesda games. Files can be RLE compressed - and may contain palette although most images use external palettes. - Some files have no header at all so exact file size must be known - prior to loading (otherwise no-header files wont be recognized or whole - image could be identified as CIF as they use the same header).} - TIMGFileFormat = class(TElderFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - end; - -const - { Info about special images without header.} - NoHeaderIMGInfos: array[0..18] of TNoHeaderFileInfo = ( - (Size: 64; Width: 8; Height: 8), // Arena file - (Size: 90; Width: 9; Height: 10), // Arena file - (Size: 128; Width: 8; Height: 16), // Arena file - (Size: 720; Width: 9; Height: 80), - (Size: 990; Width: 45; Height: 22), - (Size: 1720; Width: 43; Height: 40), - (Size: 2140; Width: 107; Height: 20), - (Size: 2916; Width: 81; Height: 36), - (Size: 3200; Width: 40; Height: 80), - (Size: 3938; Width: 179; Height: 22), - (Size: 4096; Width: 64; Height: 64), // Textures from TES: Arena - (Size: 4280; Width: 107; Height: 40), - (Size: 4508; Width: 322; Height: 14), - (Size: 20480; Width: 320; Height: 64), - (Size: 26496; Width: 184; Height: 144), - (Size: 64000; Width: 320; Height: 200), - (Size: 64768; Width: 320; Height: 200), // These contain palette - (Size: 68800; Width: 320; Height: 215), - (Size: 112128; Width: 512; Height: 219)); - -implementation - -const - SIMGFormatName = 'Daggerfall Image'; - SIMGMasks = '*.img'; - -resourcestring - SInvalidImageSize = 'Size of image in IMG format cannot exceed 65535 bytes. %s'; - -{ TIMGFileFormat class implementation } - -procedure TIMGFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffSave]; - FName := SIMGFormatName; - AddMasks(SIMGMasks); -end; - -function TIMGFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TImgHeader; - PalUsed: TPalette24Size256; - Data: Pointer; - IsRLE: Boolean; - InputSize, I: LongInt; - - procedure SetSize(W, H: LongInt); - begin - Images[0].Width := W; - Images[0].Height := H; - Images[0].Size := W * H; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - InputSize := GetInputSize(GetIO, Handle); - Format := ifIndex8; - IsRLE := False; - - // Check if this is one of special images with no header - I := FindNoHeaderInfo(InputSize, NoHeaderIMGInfos); - - if I >= 0 then - begin - // It is no-header image - NewImage(NoHeaderIMGInfos[I].Width, NoHeaderIMGInfos[I].Height, ifIndex8, Images[0]); - end - else - begin - // Image has header so use its values - Read(Handle, @Hdr, SizeOf(Hdr)); - NewImage(Hdr.Width, Hdr.Height, ifIndex8, Images[0]); - IsRLE := Hdr.Unk = 2; - end; - - if (Hdr.Unk = 260) or (Hdr.Unk = 264) then - begin - // Compressed data from Arena: - // compression algorithm is unknown to me now - // if Unk = 264 then after header is word size of original data - // if Unk = 260 no size after head - Exit; - end; - - if not IsRLE then - begin - // Read uncompressed data - GetMem(Bits, Size); - Read(Handle, Bits, Size); - end - else - begin - GetMem(Data, Hdr.ImageSize); - try - // Read compressed data - Read(Handle, Data, Hdr.ImageSize); - DagRLEDecode(Data, Size, Bits); - finally - FreeMem(Data); - end; - end; - - // Palette handling - GetMem(Palette, 256 * SizeOf(TColor32Rec)); - - if (InputSize = Tell(Handle) + 768) then - begin - // Some IMG files has embedded palette - Read(Handle, @PalUsed, 768); - for I := Low(PalUsed) to High(PalUsed) do - begin - Palette[I].A := $FF; - Palette[I].R := PalUsed[I].B; - Palette[I].G := PalUsed[I].G; - Palette[I].B := PalUsed[I].R; - end; - Palette[0].A := 0; - end - else - Move(FARGBPalette[0], Palette[0], Length(FPalette) * SizeOf(TColor32Rec)); - - Result := True; - end; -end; - -function TIMGFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - Hdr: TImgHeader; - ImageToSave: TImageData; - MustBeFreed: Boolean; -begin - Result := False; - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - FillChar(Hdr, SizeOf(Hdr), 0); - Hdr.Width := Width; - Hdr.Height := Height; - // Hdr.ImageSize is Word so max size of image in bytes can be 65535 - if Width * Height > High(Word) then - RaiseImaging(SInvalidImageSize, [ImageToStr(ImageToSave)]); - Hdr.ImageSize := Width * Height; - Write(Handle, @Hdr, SizeOf(Hdr)); - Write(Handle, Bits, Hdr.ImageSize); - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Initial version created based on my older code (fixed few things). -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ElderImagerySky.pas b/components/vampireimaging/Extras/Extensions/ElderImagerySky.pas deleted file mode 100644 index 254c664..0000000 --- a/components/vampireimaging/Extras/Extensions/ElderImagerySky.pas +++ /dev/null @@ -1,141 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for SKY file format used - in Daggerfall to store sky backdrops.} -unit ElderImagerySky; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ElderImagery; - -type - { Class for loading and saving of images in SKY format. It is - 8 bit indexed format found in Daggerfall, and maybe other old Bethesda - games. Files are named SKY##.DAT and each contains two sets of 32 images - (512 by 220 pixels), each with its palette. First set contains sky - without sun, seconf set sky with sun. } - TSKYFileFormat = class(TElderFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SSKYFormatName = 'Daggerfall Sky Images'; - SSKYMasks = '*.dagsky,sky??.dat'; - - SkyWidth = 512; - SkyHeight = 220; - SkyCount = 64; - DataOffset = 549120; - PalFileSize = 776; - SkyImageSize = SkyWidth * SkyHeight; - - SkyFileId: array[0..5] of Byte = ($08, $03, $00, $00, $23, $B1); - -{ TSKYFileFormat class implementation } - -procedure TSKYFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffMultiImage]; - FName := SSKYFormatName; - AddMasks(SSKYMasks); -end; - -function TSKYFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - I: Integer; - Pal24: TPalette24Size256; - - procedure CopyPalette(Dest: PPalette32); - var - I: Integer; - begin - for I := 0 to 255 do - begin - Dest[I].A := 255; - Dest[I].R := Pal24[I].B; - Dest[I].G := Pal24[I].G; - Dest[I].B := Pal24[I].R; - end; - end; - -begin - SetLength(Images, SkyCount); - for I := 0 to SkyCount - 1 do - begin - NewImage(SkyWidth, SkyHeight, ifIndex8, Images[I]); - // Read corresponding palette from file - GetIO.Seek(Handle, PalFileSize * (I mod 32) + 8, smFromBeginning); - GetIO.Read(Handle, @Pal24, SizeOf(Pal24)); - CopyPalette(Images[I].Palette); - // Now read image pixels - GetIO.Seek(Handle, DataOffset + I * SkyImageSize, smFromBeginning); - GetIO.Read(Handle, Images[I].Bits, SkyImageSize); - end; - Result := True; -end; - -function TSKYFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Id: array[0..5] of Byte; - ReadCount: Integer; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - FillChar(ID, SizeOf(Id), 0); - ReadCount := Read(Handle, @Id, SizeOf(Id)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(Id)) and - CompareMem(@Id, @SkyFileId, SizeOf(SkyFileId)); - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Initial version created. -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ElderImageryTexture.pas b/components/vampireimaging/Extras/Extensions/ElderImageryTexture.pas deleted file mode 100644 index d57f86d..0000000 --- a/components/vampireimaging/Extras/Extensions/ElderImageryTexture.pas +++ /dev/null @@ -1,390 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader of Daggerfall texture file format.} -unit ElderImageryTexture; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ElderImagery, ImagingIO, ImagingUtility; - -type - { Class that proveides loading of textures from TES2: Daggerfall - (works for Terminator: FS and maybe other games too). - Textures are stored in 8bit indexed format with external palette. - This format is very complicated (more images with subimages, - non-standard RLE, many unknowns) so module supports only loading. - These texture files cannot be recognized by filename extension because - their filenames are in form texture.### where # is number. Use filename - masks instead. Also note that after loading the input position is not set - at the exact end of the data so it's not "stream-safe".} - TTextureFileFormat = class(TElderFileFormat) - private - FLastTextureName: string; - { Deletes non-valid chars from texture name.} - function RepairName(const S: array of AnsiChar): string; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - { Internal name of the last texture loaded.} - property LastTextureName: string read FLastTextureName; - end; - -const - { Metadata item id for accessing name of last loaded Daggetfall texture. - Value type is string.} - SMetaDagTextureName = 'DagTexture.Name'; - -implementation - -const - STextureFormatName = 'Daggerfall Texture'; - STextureMasks = '*.dagtexture,texture.*'; // fake ext first, it's used as format id - -type - { Main texture header.} - TTexHeader = packed record - ImgCount: Word; // Number of images in texture - TexName: array[0..23] of AnsiChar; // Name of texture - end; - - { Offset list for texture.} - TOffset = packed record - Type1: Word; // ?? - HdrOffset: LongInt; // Contains offsetof Img header from the origin - // of the file - Type2: Word; // ?? - Unk: LongWord; // Ranges from 0 to 4 (0 in 90%) - Null1: LongWord; // Always 0 - Null2: LongWord; // Always 0 - end; - - TOffsetList = array[Word] of TOffset; - POffsetList = ^TOffsetList; - - { Image header for texture.} - TTexImgHeader = packed record - XOff: Word; - YOff: Word; - Width: Word; - Height: Word; - Unk1: Word; // $0108 = Image has subimages which are RLE - // compressed data. - // $1108 = Image has RLE type compressed data with - // a row offset section before the single image data. - ImageSize: LongInt; // Image size (including header) - ImageOff: LongInt; // Pointer to start of image data from this header - Unk2: Word; // $0000 = Image has subimages in special - // compressed format. - // $00C0 = Usual value, regular single image. - // NonZero = Regular single image.Unknown what the - // differences indicate - SubImages: Word; // Number of subimages (1 = single image) - Unk3: LongInt; - Unk4: Word; - end; - -{ TTextureFileFormat } - -procedure TTextureFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffMultiImage]; - FName := STextureFormatName; - AddMasks(STextureMasks); -end; - -function TTextureFileFormat.RepairName(const S: array of AnsiChar): string; -var - I: LongInt; - First: Boolean; -begin - I := 1; - Result := string(S); - First := False; - while I <= Length(Result) do - begin - if (Ord(Result[I]) < 32) or ((Ord(Result[I]) = 32) and (not First)) then - begin - Delete(Result, I, 1); - end - else - begin - Inc(I); - First := True; - end; - end; -end; - -function TTextureFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TTexHeader; - InputSize, BasePos, HdrPos, Index, I, Bias: LongInt; - List: POffsetList; - ImageHdr: TTexImgHeader; - - function AddImage(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifIndex8, Images[Result]); - Move(FARGBPalette[0], Images[Result].Palette[0], Length(FPalette) * SizeOf(TColor32Rec)); - end; - - procedure LoadUncompressed; - var - I: LongInt; - begin - // Add image and read its pixels row by row - Index := AddImage(ImageHdr.Width, ImageHdr.Height); - with GetIO, Images[Index] do - for I := 0 to ImageHdr.Height - 1 do - begin - Read(Handle, @PByteArray(Bits)[I * Width], Width); - Seek(Handle, 256 - Width, smFromCurrent); - end; - end; - - procedure LoadUncompressedSubImages; - var - SubOffs: packed array[0..63] of LongInt; - I, StartPos, J, WritePos: LongInt; - NumZeroes, NumImageBytes: Byte; - SubWidth, SubHeight: Word; - begin - // Read subimages offset list - StartPos := GetIO.Tell(Handle); - FillChar(SubOffs, SizeOf(SubOffs), 0); - GetIO.Read(Handle, @SubOffs, ImageHdr.SubImages * 4); - for I := 0 to ImageHdr.SubImages - 1 do - begin - // Add new subimage and load its pixels - Index := AddImage(ImageHdr.Width, ImageHdr.Height); - with GetIO, Images[Index] do - begin - Seek(Handle, StartPos + SubOffs[I], smFromBeginning); - Read(Handle, @SubWidth, 2); - Read(Handle, @SubHeight, 2); - // Read rows - for J := 0 to SubHeight - 1 do - begin - WritePos := 0; - while WritePos < SubWidth do - begin - // First there is a number of zero pixels that should be written - // to this row (slight compression as many images/sprites have - // many zero pixels) - Read(Handle, @NumZeroes, 1); - FillChar(PByteArray(Bits)[J * SubWidth + WritePos], NumZeroes, 0); - WritePos := WritePos + NumZeroes; - // Now there is a number of bytes that contain image data and should - // be copied to this row - Read(Handle, @NumImageBytes, 1); - Read(Handle, @PByteArray(Bits)[J * SubWidth + WritePos], NumImageBytes); - WritePos := WritePos + NumImageBytes; - end; - end; - end; - end; - end; - - procedure LoadRLESubImages; - type - TRowOff = packed record - Off: Word; - RLEStatus: Word; - end; - var - RowOffs: packed array[0..255] of TRowOff; - I, J, WritePos, NextOffsetPos: LongInt; - RLEData: Byte; - ByteCount, RowWidth: SmallInt; - begin - NextOffsetPos := GetIO.Tell(Handle); - for I := 0 to ImageHdr.SubImages - 1 do - begin - // Read row offsets for RLE subimage - FillChar(RowOffs, SizeOf(RowOffs), 0); - GetIO.Seek(Handle, NextOffsetPos, smFromBeginning); - GetIO.Read(Handle, @RowOffs, ImageHdr.Height * SizeOf(TRowOff)); - NextOffsetPos := GetIO.Tell(Handle); - // Add new image - Index := AddImage(ImageHdr.Width, ImageHdr.Height); - with GetIO, Images[Index] do - begin - for J := 0 to Height - 1 do - begin - // Seek to the beginning of the current row in the source - Seek(Handle, HdrPos + RowOffs[J].Off, smFromBeginning); - if RowOffs[J].RLEStatus = $8000 then - begin - // This row is compressed so it must be decoded (it is different - // from RLE in IMG/CIF files) - Read(Handle, @RowWidth, 2); - WritePos := 0; - while WritePos < RowWidth do - begin - Read(Handle, @ByteCount, 2); - if ByteCount > 0 then - begin - Read(Handle, @PByteArray(Bits)[J * Width + WritePos], ByteCount); - WritePos := WritePos + ByteCount; - end - else - begin - Read(Handle, @RLEData, 1); - FillChar(PByteArray(Bits)[J * Width + WritePos], -ByteCount, RLEData); - WritePos := WritePos - ByteCount; - end; - end; - end - else - // Read uncompressed row - Read(Handle, @PByteArray(Bits)[J * Width], Width); - end; - end; - end; - end; - -begin - Result := False; - SetLength(Images, 0); - with GetIO do - begin - InputSize := GetInputSize(GetIO, Handle); - BasePos := Tell(Handle); - Read(Handle, @Hdr, SizeOf(Hdr)); - FLastTextureName := RepairName(Hdr.TexName); - FMetadata.SetMetaItem(SMetaDagTextureName, FLastTextureName); - - if InputSize = 2586 then - begin - // Handle texture.001 and texture.000 files - // They contain only indices to palette so we create small - // images with colors defined by these indices - Bias := 0; - if Pos('B', FLastTextureName) > 0 then - Bias := 128; - for I := 0 to Hdr.ImgCount - 1 do - begin - Index := AddImage(16, 16); - FillMemoryByte(Images[Index].Bits, Images[Index].Size, I + Bias); - end; - end - else if (InputSize = 46) or (InputSize = 126) or (InputSize = 266) then - begin - // These textures don't contain any image data - Exit; - end - else - begin - GetMem(List, Hdr.ImgCount * SizeOf(TOffset)); - try - // Load offsets - for I := 0 to Hdr.ImgCount - 1 do - Read(Handle, @List[I], SizeOf(TOffset)); - // Load subimages one by one - for I := 0 to Hdr.ImgCount - 1 do - begin - // Jump at position of image header - Seek(Handle, BasePos + List[I].HdrOffset, smFromBeginning); - HdrPos := Tell(Handle); - Read(Handle, @ImageHdr, SizeOf(ImageHdr)); - Seek(Handle, HdrPos + ImageHdr.ImageOff, smFromBeginning); - // According to number of subimages and RLE settings appropriate - // procedure is called to load subimages - if ImageHdr.SubImages = 1 then - begin - if (ImageHdr.Unk1 <> $1108) and (ImageHdr.Unk1 <> $0108) then - LoadUncompressed - else - LoadRLESubImages; - end - else - begin - if (ImageHdr.Unk1 <> $0108) then - LoadUncompressedSubImages - else - LoadRLESubImages; - end; - end; - finally - FreeMem(List); - end; - end; - Result := True; - end; -end; - -function TTextureFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TTexHeader; - ReadCount, I: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(Hdr)) and (Hdr.ImgCount > 0) and - (Hdr.ImgCount <= 2048); - if Result then - begin - for I := 0 to High(Hdr.TexName) do - begin - if not (Hdr.TexName[I] in [#0, #32, 'a'..'z', 'A'..'Z', '0'..'9', '.', - '(', ')', '_', ',', '-', '''', '"', '/', '\', #9, '+']) then - begin - Result := False; - Exit; - end; - end; - end; - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Last texture name now accessible trough metadata interface. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Initial version created based on my older code (fixed few things). -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingBinary.pas b/components/vampireimaging/Extras/Extensions/ImagingBinary.pas deleted file mode 100644 index c2253a6..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingBinary.pas +++ /dev/null @@ -1,458 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ Unit with operations on binary images. Binary images in Imaging are - ifGray8 images where pixels with value 0 are considerend off, an pixels > 0 - are on. - Note: Native ifBinary data format was later added to Imaging. However, - these functions still use ifGray8 for representation for less complex - and faster processing. ifBinary is meant moreless like interchange - format for IO file formats. } -unit ImagingBinary; - -{$I ImagingOptions.inc} - -interface - -uses - Types, ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -type - { Basic morphologic operators.} - TMorphologyOp = ( - moErode, // Erosion - moDilate // Dilatation - ); - - { Structuring element for morphology operations. Use ones and - zeroes to define your struct elements.} - TStructElement = array of array of Byte; - - TCalcSkewAngleStats = record - PixelCount: Integer; - TestedPixels: Integer; - AccumulatorSize: Integer; - AccumulatedCounts: Integer; - BestCount: Integer; - end; - PCalcSkewAngleStats = ^TCalcSkewAngleStats; - -{ Thresholding using Otsu's method (which chooses the threshold - to minimize the intraclass variance of the black and white pixels!). - Functions returns calculated threshold level value [0..255]. - If BinarizeImage is True then the Image is automatically converted to binary using - computed threshold level.} -function OtsuThresholding(var Image: TImageData; BinarizeImage: Boolean = False): Integer; -{ Applies basic morphology operators (Erode/Dilate) on Image using given structuring element - Strel. You can do composite operations (Open/Close) by calling this function - twice each time with different operator.} -procedure Morphology(var Image: TImageData; const Strel: TStructElement; Op: TMorphologyOp); -{ Calculates rotation angle for given 8bit grayscale image. - Useful for finding skew of scanned documents etc. - Uses Hough transform internally. - MaxAngle is maximal (abs. value) expected skew angle in degrees (to speed things up) - and Threshold (0..255) is used to classify pixel as black (text) or white (background). - Area of interest rectangle can be defined to restrict the detection to - work only in defined part of image (useful when the document has text only in - smaller area of page and non-text features outside the area confuse the rotation detector). - Various calculations stats can be retrieved by passing Stats parameter.} -function CalcRotationAngle(MaxAngle: Integer; Treshold: Integer; - Width, Height: Integer; Pixels: PByteArray; DetectionArea: PRect = nil; - Stats: PCalcSkewAngleStats = nil): Double; -{ Deskews given image. Finds rotation angle and rotates image accordingly. - Works best on low-color document-like images (scans). - MaxAngle is maximal (abs. value) expected skew angle in degrees (to speed things up) - and Threshold (0..255) is used to classify pixel as black (text) or white (background). - If Treshold=-1 then auto threshold calculated by OtsuThresholding is used.} -procedure DeskewImage(var Image: TImageData; MaxAngle: Integer = 10; Threshold: Integer = -1); - -implementation - -function OtsuThresholding(var Image: TImageData; BinarizeImage: Boolean): Integer; -var - Histogram: array[Byte] of Single; - Level, Max, Min, I, J, NumPixels: Integer; - Pix: PByte; - Mean, Variance: Single; - Mu, Omega, LevelMean, LargestMu: Single; -begin - Assert(Image.Format = ifGray8); - - FillChar(Histogram, SizeOf(Histogram), 0); - Min := 255; - Max := 0; - Level := 0; - NumPixels := Image.Width * Image.Height; - Pix := Image.Bits; - - // Compute histogram and determine min and max pixel values - for I := 0 to NumPixels - 1 do - begin - Histogram[Pix^] := Histogram[Pix^] + 1.0; - if Pix^ < Min then - Min := Pix^; - if Pix^ > Max then - Max := Pix^; - Inc(Pix); - end; - - // Normalize histogram - for I := 0 to 255 do - Histogram[I] := Histogram[I] / NumPixels; - - // Compute image mean and variance - Mean := 0.0; - Variance := 0.0; - for I := 0 to 255 do - Mean := Mean + (I + 1) * Histogram[I]; - for I := 0 to 255 do - Variance := Variance + Sqr(I + 1 - Mean) * Histogram[I]; - - // Now finally compute threshold level - LargestMu := 0; - - for I := 0 to 255 do - begin - Omega := 0.0; - LevelMean := 0.0; - - for J := 0 to I - 1 do - begin - Omega := Omega + Histogram[J]; - LevelMean := LevelMean + (J + 1) * Histogram[J]; - end; - - Mu := Sqr(Mean * Omega - LevelMean); - Omega := Omega * (1.0 - Omega); - - if Omega > 0.0 then - Mu := Mu / Omega - else - Mu := 0; - - if Mu > LargestMu then - begin - LargestMu := Mu; - Level := I; - end; - end; - - if BinarizeImage then - begin - // Do thresholding using computed level - Pix := Image.Bits; - for I := 0 to Image.Width * Image.Height - 1 do - begin - if Pix^ >= Level then - Pix^ := 255 - else - Pix^ := 0; - Inc(Pix); - end; - end; - - Result := Level; -end; - -procedure Morphology(var Image: TImageData; const Strel: TStructElement; Op: TMorphologyOp); -var - X, Y, I, J: Integer; - SWidth, SHeight, PixCount, PixVal, NumOnes, PosX, PosY: Integer; - ImgOut: TImageData; - OutPix: PByte; -begin - Assert(Image.Format = ifGray8); - Assert((Length(Strel) > 0) and (Length(Strel[0]) > 0)); - - SWidth := Length(Strel); - SHeight := Length(Strel[0]); - - NumOnes := 0; - if Op = moErode then - begin - // We need to know number of ones in the strel for erosion - for I := 0 to SWidth - 1 do - for J := 0 to SHeight - 1 do - NumOnes := NumOnes + Strel[I, J]; - end; - - InitImage(ImgOut); - NewImage(Image.Width, Image.Height, ifGray8, ImgOut); - OutPix := ImgOut.Bits; - - for J := 0 to Image.Height - 1 do - for I := 0 to Image.Width - 1 do - begin - PixCount := 0; - - for X := 0 to SWidth - 1 do - begin - PosX := ClampInt(X + I - SWidth div 2, 0, Image.Width - 1); - for Y := 0 to SHeight - 1 do - begin - PosY := ClampInt(Y + J - SHeight div 2, 0, Image.Height - 1); - if (PosX >= 0) and (PosX < Image.Width) and - (PosY >= 0) and (PosY < Image.Height) then - begin - PixVal := PByteArray(Image.Bits)[PosY * Image.Width + PosX]; - end - else - PixVal := 0; - - if (Strel[X, Y] > 0) and (PixVal > 0) then - Inc(PixCount); - end; - end; - - case Op of - moErode: OutPix^ := Iff(PixCount = NumOnes, 255, 0); - moDilate: OutPix^ := Iff(PixCount > 0, 255, 0); - end; - - Inc(OutPix); - end; - - FreeImage(Image); - Image := ImgOut; -end; - -function CalcRotationAngle(MaxAngle: Integer; Treshold: Integer; - Width, Height: Integer; Pixels: PByteArray; DetectionArea: PRect; Stats: PCalcSkewAngleStats): Double; -const - // Number of "best" lines we take into account when determining - // resulting rotation angle (lines with most votes). - BestLinesCount = 20; - // Angle step used in alpha parameter quantization - AlphaStep = 0.1; -type - TLine = record - Count: Integer; - Index: Integer; - Alpha: Double; - D: Double; - end; - TLineArray = array of TLine; -var - AlphaStart, MinD, SumAngles: Double; - AlphaSteps, DCount, AccumulatorSize, I, AccumulatedCounts: Integer; - BestLines: TLineArray; - HoughAccumulator: array of Integer; - PageWidth, PageHeight: Integer; - ContentRect: TRect; - - // Classifies pixel at [X, Y] as black or white using threshold. - function IsPixelBlack(X, Y: Integer): Boolean; - begin - Result := Pixels[Y * Width + X] < Treshold; - end; - - // Calculates alpha parameter for given angle step. - function GetAlpha(Index: Integer): Double; - begin - Result := AlphaStart + Index * AlphaStep; - end; - - function CalcDIndex(D: Double): Integer; - begin - Result := Trunc(D - MinD); - end; - - // Calculates angle and distance parameters for all lines - // going through point [X, Y]. - procedure CalcLines(X, Y: Integer); - var - D, Rads: Double; - I, DIndex, Index: Integer; - begin - for I := 0 to AlphaSteps - 1 do - begin - Rads := GetAlpha(I) * Pi / 180; // Angle for current step in radians - D := Y * Cos(Rads) - X * Sin(Rads); // Parameter D of the line y=tg(alpha)x + d - DIndex := CalcDIndex(D); - Index := DIndex * AlphaSteps + I; - HoughAccumulator[Index] := HoughAccumulator[Index] + 1; // Add one vote for current line - end; - end; - - // Uses Hough transform to calculate all lines that intersect - // interesting points (those classified as beign on base line of the text). - procedure CalcHoughTransform; - var - Y, X: Integer; - begin - for Y := 0 to PageHeight - 1 do - for X := 0 to PageWidth - 1 do - begin - if IsPixelBlack(ContentRect.Left + X, ContentRect.Top + Y) and - not IsPixelBlack(ContentRect.Left + X, ContentRect.Top + Y + 1) then - begin - CalcLines(X, Y); - end; - end; - end; - - // Chooses "best" lines (with the most votes) from the accumulator - function GetBestLines(Count: Integer): TLineArray; - var - I, J, DIndex, AlphaIndex: Integer; - Temp: TLine; - begin - SetLength(Result, Count); - - for I := 0 to AccumulatorSize - 1 do - begin - if HoughAccumulator[I] > Result[Count - 1].Count then - begin - // Current line has more votes than the last selected one, - // let's put it the pot - Result[Count - 1].Count := HoughAccumulator[I]; - Result[Count - 1].Index := I; - J := Count - 1; - - // Sort the lines based on number of votes - while (J > 0) and (Result[J].Count > Result[J - 1].Count) do - begin - Temp := Result[J]; - Result[J] := Result[J - 1]; - Result[J - 1] := Temp; - J := J - 1; - end; - end; - - AccumulatedCounts := AccumulatedCounts + HoughAccumulator[I]; - end; - - for I := 0 to Count - 1 do - begin - // Caculate line angle and distance according to index in the accumulator - DIndex := Result[I].Index div AlphaSteps; - AlphaIndex := Result[I].Index - DIndex * AlphaSteps; - Result[I].Alpha := GetAlpha(AlphaIndex); - Result[I].D := DIndex + MinD; - end; - end; - -begin - AccumulatedCounts := 0; - - // Use supplied page content rect or just the whole image - ContentRect := Rect(0, 0, Width, Height); - if DetectionArea <> nil then - begin - Assert((RectWidth(DetectionArea^) <= Width) and (RectHeight(DetectionArea^) <= Height)); - ContentRect := DetectionArea^; - end; - - PageWidth := ContentRect.Right - ContentRect.Left; - PageHeight := ContentRect.Bottom - ContentRect.Top; - - AlphaStart := -MaxAngle; - AlphaSteps := Round(2 * MaxAngle / AlphaStep); // Number of angle steps = samples from interval <-MaxAngle, MaxAngle> - MinD := -PageWidth; - DCount := 2 * (PageWidth + PageHeight); - - // Determine the size of line accumulator - AccumulatorSize := DCount * AlphaSteps; - SetLength(HoughAccumulator, AccumulatorSize); - - // Calculate Hough transform - CalcHoughTransform; - - // Get the best lines with most votes - BestLines := GetBestLines(BestLinesCount); - - // Average angles of the selected lines to get the rotation angle of the image - SumAngles := 0; - for I := 0 to BestLinesCount - 1 do - SumAngles := SumAngles + BestLines[I].Alpha; - - Result := SumAngles / BestLinesCount; - - if Stats <> nil then - begin - Stats.BestCount := BestLines[0].Count; - Stats.PixelCount := PageWidth * PageHeight; - Stats.AccumulatorSize := AccumulatorSize; - Stats.AccumulatedCounts := AccumulatedCounts; - Stats.TestedPixels := AccumulatedCounts div AlphaSteps; - end; -end; - -procedure DeskewImage(var Image: TImageData; MaxAngle: Integer; Threshold: Integer); -var - Angle: Double; - OutputImage: TImageData; - Info: TImageFormatInfo; -begin - if not TestImage(Image) then - raise EImagingBadImage.Create; - - // Clone input image and convert it to 8bit grayscale. This will be our - // working image. - CloneImage(Image, OutputImage); - ConvertImage(Image, ifGray8); - - if Threshold < 0 then - begin - // Determine the threshold automatically if needed. - Threshold := OtsuThresholding(Image); - end; - - // Main step - calculate image rotation angle - Angle := CalcRotationAngle(MaxAngle, Threshold, Image.Width, Image.Height, Image.Bits); - - // Finally, rotate the image. We rotate the original input image, not the working - // one so the color space is preserved. - GetImageFormatInfo(OutputImage.Format, Info); - if Info.IsIndexed or Info.IsSpecial then - ConvertImage(OutputImage, ifA8R8G8B8); // Rotation doesn't like indexed and compressed images - RotateImage(OutputImage, Angle); - - FreeImage(Image); - Image := OutputImage; -end; - - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77 ------------------------------------------------------- - - OtsuThresholding signature changed, now it's a function and - always returns the computed level. - - Extended CalcRotationAngle, added margins and stats. - - Added CalcRotationAngle and DeskewImage functions. - - -- 0.25.0 Changes/Bug Fixes ----------------------------------- - - Unit created with basic stuff (otsu and erode/dilate morphology ops). - -} - -end. - diff --git a/components/vampireimaging/Extras/Extensions/ImagingCompare.pas b/components/vampireimaging/Extras/Extensions/ImagingCompare.pas deleted file mode 100644 index 37dd6ff..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingCompare.pas +++ /dev/null @@ -1,131 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ - This unit contains various image comparing functions and image difference - computations. -} -unit ImagingCompare; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -{ Computes various error metrics for two images. Images must have - the same size and format. Only formats with 1, 2, and 4 byte samples are - supported (no indexed, compressed, etc.).} -procedure ComputeErrorMetrics(const Image1, Image2: TImageData; - var PSNR, MSE, RMSE, PAE, MAE: Single); - -implementation - -procedure ComputeErrorMetrics(const Image1, Image2: TImageData; - var PSNR, MSE, RMSE, PAE, MAE: Single); -var - I: Integer; - Info: TImageFormatInfo; - Samples, Bps: Integer; - PixelPtr1, PixelPtr2: PByte; - Diff, MaxSample: Single; -begin - GetImageFormatInfo(Image1.Format, Info); - Bps := Info.ChannelCount div Info.BytesPerPixel; - Assert((Image1.Width = Image2.Width) and (Image1.Height = Image2.Height) and - (Image1.Format = Image2.Format)); - Assert(not Info.IsIndexed and not Info.IsSpecial and not Info.UsePixelFormat - and (Bps in [1, 2, 4])); - - Diff := 0; - PSNR := 0; - MSE := 0; - RMSE := 0; - PAE := 0; - MAE := 0; - PixelPtr1 := Image1.Bits; - PixelPtr2 := Image2.Bits; - Samples := Image1.Width * Image1.Height * Info.ChannelCount; - - for I := 0 to Samples - 1 do - begin - // Compute difference betwen pixels - case Bps of - 1: Diff := Abs(PixelPtr2^ - PixelPtr1^); - 2: - begin - if Info.IsFloatingPoint then - Diff := Abs(HalfToFloat(PWord(PixelPtr2)^) - HalfToFloat(PWord(PixelPtr1)^)) - else - Diff := Abs(PWord(PixelPtr2)^ - PWord(PixelPtr1)^); - end; - 4: - begin - if Info.IsFloatingPoint then - Diff := Abs(PSingle(PixelPtr2)^ - PSingle(PixelPtr1)^) - else - Diff := Abs(PUInt32(PixelPtr2)^ - PUInt32(PixelPtr1)^); - end; - end; - - // Update metrics - MAE := MAE + Diff; - PAE := MaxFloat(PAE, Diff); - MSE := MSE + Diff * Diff; - - Inc(PixelPtr1, Bps); - Inc(PixelPtr2, Bps); - end; - - if Info.IsFloatingPoint then - MaxSample := 1.0 - else - MaxSample := Pow2Int(Bps * 8) - 1; - - // Final metrics calculations - MAE := MAE / Samples; - MSE := MSE / Samples; - RMSE := Sqrt(MSE); - if RMSE < 0.0001 then - PSNR := 1e06 - else - PSNR := 20 * Log10(MaxSample / RMSE); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - none - - -- 0.26.5 Changes/Bug Fixes ----------------------------------- - - Added ComputeErrorMetrics. - - Unit created. -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingDirect3D9.pas b/components/vampireimaging/Extras/Extensions/ImagingDirect3D9.pas deleted file mode 100644 index 01656bc..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingDirect3D9.pas +++ /dev/null @@ -1,784 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains functions for loading and saving Direct3D 9 textures - using Imaging and for converting images to textures and vice versa.} -unit ImagingDirect3D9; - -{$I ImagingOptions.inc} - -interface - -uses - Windows, SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats, - ImagingUtility, Direct3D9; - -type - { Contains some texture capabilities of Direct3D device.} - TD3DTextureCaps = record - PowerOfTwo: Boolean; - CubePowerOfTwo: Boolean; - VolumePowerOfTwo: Boolean; - MaxWidth: LongInt; - MaxHeight: LongInt; - DXTCompression: Boolean; - ATI3DcCompression: Boolean; - MaxAnisotropy: LongInt; - MaxSimultaneousTextures: LongInt; - end; - -{ Returns some texture capabilities of the given D3D device.} -function GetDeviceTextureCaps(Device: IDirect3DDevice9; var Caps: TD3DTextureCaps): Boolean; -{ Returns True if the given Format is valid texture format for the given D3D device.} -function IsD3DFormatSupported(Device: IDirect3DDevice9; Format: TD3DFormat): Boolean; -{ Returns D3D format equivalent to the given TImageFormatInfo. It returns D3DFMT_UNKNOWN - if equivalent cannot be found. If returned ConversionTo is not the same - as input format then image must be first converted to this format for - the returned D3D format to be valid. You should also check if returned D3D - format is supported by the current D3D device using IsD3DFormatSupported.} -function ImageFormatToD3DFormat(const Format: TImageFormat; var ConversionTo: TImageFormat): TD3DFormat; -{ Returns TImageFormat equivalent to the given D3D format. If equivalent does - not exist ifUnknown is returned.} -function D3DFormatToImageFormat(Format: TD3DFormat): TImageFormat; - -{ LoadD3DTextureFromFile and similar functions use these default values: - All mipmap levels are created, Pool is D3DPOOL_MANAGED, - Usage is 0, Format and size are taken from image.} - -{ Creates D3D texture from image in file in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadD3DTextureFromFile(const FileName: string; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): Boolean; -{ Creates D3D texture from image in stream in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadD3DTextureFromStream(Stream: TStream; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): Boolean; -{ Creates D3D texture from image in memory in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadD3DTextureFromMemory(Data: Pointer; Size: LongInt; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): Boolean; - -{ Converts TImageData structure to IDirect3DTexture9 texture. - Input images is used as main mipmap level and additional requested - levels are generated from this one. For the details on parameters - look at CreateD3DTextureFromMultiImage function.} -function CreateD3DTextureFromImage(const Image: TImageData; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width: LongInt = 0; - Height: LongInt = 0; MipLevels: LongInt = 0; Usage: LongWord = 0; - Format: TD3DFormat = D3DFMT_UNKNOWN; Pool: TD3DPool = D3DPOOL_MANAGED; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): Boolean; -{ Converts images in TDymImageDataArray to one IDirect3DTexture9 texture. - First image in array is used as main mipmap level and additional images - are used as subsequent levels. If MipLevels is larger than number of images - in array missing levels are automatically generated. - If Device supports only power of two sized textures images are resized. - If Format is D3DFMT_UNKNOWN then format of input image is used. - If desired texture format is not supported by hardware default - A8R8G8B8 format is used instead. - Width and Height of 0 mean use width and height of main image. - MipLevels set to 0 mean build all possible levels. For details on - Usage and Pool parameters look at DirectX SDK docs. - You can use CreatedWidth and CreatedHeight parameters to query dimensions of - created texture's largest mipmap level (it could differ from dimensions - of source image).} -function CreateD3DTextureFromMultiImage(const Images: TDynImageDataArray; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width: LongInt = 0; - Height: LongInt = 0; MipLevels: LongInt = 0; Usage: LongWord = 0; - Format: TD3DFormat = D3DFMT_UNKNOWN; Pool: TD3DPool = D3DPOOL_MANAGED; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): Boolean; - -{ Saves D3D texture to file in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveD3DTextureToFile(const FileName: string; const Texture: IDirect3DTexture9): Boolean; -{ Saves D3D texture to stream in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveD3DTextureToStream(const Ext: string; Stream: TStream; const Texture: IDirect3DTexture9): Boolean; -{ Saves D3D texture to memory in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveD3DTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: IDirect3DTexture9): Boolean; - -{ Converts main level of the D3D texture to TImageData strucrue. OverrideFormat - can be used to convert output image to the specified format rather - than use the format taken from D3D texture, ifUnknown means no conversion.} -function CreateImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Image: TImageData; OverrideFormat: TImageFormat = ifUnknown): Boolean; -{ Converts D3D texture to TDynImageDataArray array of images. You can specify - how many mipmap levels of the input texture you want to be converted - (default is all levels). OverrideFormat can be used to convert output images to - the specified format rather than use the format taken from D3D texture, - ifUnknown means no conversion.} -function CreateMultiImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Images: TDynImageDataArray; MipLevels: LongInt = 0; - OverrideFormat: TImageFormat = ifUnknown): Boolean; - -{ Creates contents of Image to D3D surface. Surface must exist before calling this - function so it can be used to fill various types of surfaces (textures surfaces, - offscreen, depth buffer, ...). Surface must be lockable for function to work.} -function CreateD3DSurfaceFromImage(const Image: TImageData; Surface: IDirect3DSurface9): Boolean; -{ Creates image filled with contents of input D3D surface. - Surface must be lockable for function to work.} -function CreateImageFromD3DSurface(Surface: IDirect3DSurface9; var Image: TImageData): Boolean; - -const - D3DFMT_ATI1 = TD3DFormat(Byte('A') or (Byte('T') shl 8) or (Byte('I') shl 16) or - (Byte('1') shl 24)); - D3DFMT_ATI2 = TD3DFormat(Byte('A') or (Byte('T') shl 8) or (Byte('I') shl 16) or - (Byte('2') shl 24)); - -implementation - -const - DefaultUsage = 0; - DefaultPool = D3DPOOL_MANAGED; - -function GetDeviceTextureCaps(Device: IDirect3DDevice9; - var Caps: TD3DTextureCaps): Boolean; -var - D3DCaps: TD3DCaps9; -begin - FillChar(Caps, SizeOf(Caps), 0); - Result := Device <> nil; - // Get D3D Device Caps and fill our caps - if Result and (Device.GetDeviceCaps(D3DCaps) = D3D_OK) then - begin - Caps.PowerOfTwo := (D3DCaps.TextureCaps and D3DPTEXTURECAPS_POW2) = D3DPTEXTURECAPS_POW2; - Caps.CubePowerOfTwo := (D3DCaps.TextureCaps and D3DPTEXTURECAPS_CUBEMAP_POW2) = D3DPTEXTURECAPS_CUBEMAP_POW2; - Caps.VolumePowerOfTwo := (D3DCaps.TextureCaps and D3DPTEXTURECAPS_VOLUMEMAP_POW2) = D3DPTEXTURECAPS_VOLUMEMAP_POW2; - Caps.MaxWidth := D3DCaps.MaxTextureWidth; - Caps.MaxHeight := D3DCaps.MaxTextureHeight; - if (D3DCaps.TextureFilterCaps and D3DPTFILTERCAPS_MINFANISOTROPIC) = D3DPTFILTERCAPS_MINFANISOTROPIC then - Caps.MaxAnisotropy := D3DCaps.MaxAnisotropy - else - Caps.MaxAnisotropy := 0; - Caps.MaxSimultaneousTextures := D3DCaps.MaxSimultaneousTextures; - // Texture format caps - Caps.DXTCompression := IsD3DFormatSupported(Device, D3DFMT_DXT1) and - IsD3DFormatSupported(Device, D3DFMT_DXT3) and IsD3DFormatSupported(Device, D3DFMT_DXT5); - Caps.ATI3DcCompression := IsD3DFormatSupported(Device, D3DFMT_ATI1) and - IsD3DFormatSupported(Device, D3DFMT_ATI2); - end; -end; - -function IsD3DFormatSupported(Device: IDirect3DDevice9; Format: TD3DFormat): Boolean; -var - Direct3D: IDirect3D9; - Mode: TD3DDisplayMode; - Hr: HResult; -begin - Result := False; - if Device <> nil then - begin - Device.GetDirect3D(Direct3D); - if Direct3D <> nil then - begin - Direct3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, Mode); - Hr := Direct3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, - D3DDEVTYPE_HAL, Mode.Format, 0, D3DRTYPE_TEXTURE, Format); - Result := Succeeded(Hr); - end; - end; -end; - -function ImageFormatToD3DFormat(const Format: TImageFormat; var ConversionTo: TImageFormat): TD3DFormat; -begin - Result := D3DFMT_UNKNOWN; - ConversionTo := Format; - case Format of - ifIndex8: Result := D3DFMT_P8; - ifGray8: Result := D3DFMT_L8; - ifA8Gray8: Result := D3DFMT_A8L8; - ifGray16: Result := D3DFMT_L16; - ifGray32, - ifGray64: - begin - Result := D3DFMT_L16; - ConversionTo := ifGray16; - end; - ifA16Gray16: - begin - Result := D3DFMT_A8L8; - ConversionTo := ifA8Gray8; - end; - ifX5R1G1B1: - begin - Result := D3DFMT_R3G3B2; - ConversionTo := ifR3G3B2; - end; - ifR3G3B2: Result := D3DFMT_R3G3B2; - ifR5G6B5: Result := D3DFMT_R5G6B5; - ifA1R5G5B5: Result := D3DFMT_A1R5G5B5; - ifA4R4G4B4: Result := D3DFMT_A4R4G4B4; - ifX1R5G5B5: Result := D3DFMT_X1R5G5B5; - ifX4R4G4B4: Result := D3DFMT_X4R4G4B4; - ifR8G8B8: Result := D3DFMT_R8G8B8; - ifA8R8G8B8: Result := D3DFMT_A8R8G8B8; - ifX8R8G8B8: Result := D3DFMT_X8R8G8B8; - ifR16G16B16, - ifA16R16G16B16, - ifB16G16R16: - begin - Result := D3DFMT_A16B16G16R16; - ConversionTo := ifA16B16G16R16; - end; - ifA16B16G16R16: Result := D3DFMT_A16B16G16R16; - ifR32F: Result := D3DFMT_R32F; - ifA32B32G32R32F: Result := D3DFMT_A32B32G32R32F; - ifA32R32G32B32F: - begin - Result := D3DFMT_A32B32G32R32F; - ConversionTo := ifA32B32G32R32F; - end; - ifR16F: Result := D3DFMT_R16F; - ifA16B16G16R16F: Result := D3DFMT_A16B16G16R16F; - ifA16R16G16B16F: - begin - Result := D3DFMT_A16B16G16R16F; - ConversionTo := ifA16B16G16R16F; - end; - ifDXT1: Result := D3DFMT_DXT1; - ifDXT3: Result := D3DFMT_DXT3; - ifDXT5: Result := D3DFMT_DXT5; - ifATI1N: Result := D3DFMT_ATI1; - ifATI2N: Result := D3DFMT_ATI2; - end; -end; - -function D3DFormatToImageFormat(Format: TD3DFormat): TImageFormat; -begin - Result := ifUnknown; - case Format of - D3DFMT_P8: Result := ifIndex8; - D3DFMT_A8, - D3DFMT_L8: Result := ifGray8; - D3DFMT_A8L8, - D3DFMT_V8U8: Result := ifA8Gray8; - D3DFMT_L16: Result := ifGray16; - D3DFMT_R3G3B2: Result := ifR3G3B2; - D3DFMT_R5G6B5: Result := ifR5G6B5; - D3DFMT_X1R5G5B5: Result := ifX1R5G5B5; - D3DFMT_A1R5G5B5: Result := ifA1R5G5B5; - D3DFMT_A4R4G4B4: Result := ifA4R4G4B4; - D3DFMT_X4R4G4B4: Result := ifX4R4G4B4; - D3DFMT_R8G8B8: Result := ifR8G8B8; - D3DFMT_A8R8G8B8, - D3DFMT_Q8W8V8U8, - D3DFMT_A8B8G8R8: Result := ifA8R8G8B8; - D3DFMT_X8R8G8B8, - D3DFMT_X8L8V8U8, - D3DFMT_X8B8G8R8: Result := ifX8R8G8B8; - D3DFMT_A16B16G16R16, - D3DFMT_Q16W16V16U16: Result := ifA16B16G16R16; - D3DFMT_R32F: Result := ifR32F; - D3DFMT_A32B32G32R32F: Result := ifA32B32G32R32F; - D3DFMT_R16F: Result := ifR16F; - D3DFMT_A16B16G16R16F: Result := ifA16B16G16R16F; - D3DFMT_DXT1: Result := ifDXT1; - D3DFMT_DXT3: Result := ifDXT3; - D3DFMT_DXT5: Result := ifDXT5; - D3DFMT_ATI1: Result := ifATI1N; - D3DFMT_ATI2: Result := ifATI2N; - end; -end; - -function LoadD3DTextureFromFile(const FileName: string; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromFile(FileName, Images) and (Length(Images) > 0) then - begin - Result := CreateD3DTextureFromMultiImage(Images, Device, Texture, - Images[0].Width, Images[0].Height, 0, DefaultUsage, D3DFMT_UNKNOWN, - DefaultPool, CreatedWidth, CreatedHeight); - end - else - Result := False; - FreeImagesInArray(Images); -end; - -function LoadD3DTextureFromStream(Stream: TStream; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromStream(Stream, Images) and (Length(Images) > 0) then - begin - Result := CreateD3DTextureFromMultiImage(Images, Device, Texture, - Images[0].Width, Images[0].Height, 0, DefaultUsage, D3DFMT_UNKNOWN, - DefaultPool, CreatedWidth, CreatedHeight); - end - else - Result := False; - FreeImagesInArray(Images); -end; - -function LoadD3DTextureFromMemory(Data: Pointer; Size: LongInt; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; - CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromMemory(Data, Size, Images) and (Length(Images) > 0) then - begin - Result := CreateD3DTextureFromMultiImage(Images, Device, Texture, Images[0].Width, - Images[0].Height, 0, DefaultUsage, D3DFMT_UNKNOWN, DefaultPool, - CreatedWidth, CreatedHeight); - end - else - Result := False; - FreeImagesInArray(Images); -end; - -function CreateD3DTextureFromImage(const Image: TImageData; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width, - Height, MipLevels: LongInt; Usage: LongWord; Format: TD3DFormat; - Pool: TD3DPool; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - SetLength(Arr, 1); - Arr[0] := Image; - Result := CreateD3DTextureFromMultiImage(Arr, Device, Texture, Width, Height, - MipLevels, Usage, Format, Pool, CreatedWidth, CreatedHeight); -end; - -procedure FillLockedRectWithImage(var Rect: TD3DLockedRect; const Image: TImageData); -var - I, LineBytes: LongInt; - Info: TImageFormatInfo; -begin - GetImageFormatInfo(Image.Format, Info); - LineBytes := Info.GetPixelsSize(Info.Format, Image.Width, 1); - // Pixels of the image are copied to D3D texture - if (not Info.IsSpecial) and (LineBytes < Rect.Pitch) then - begin - for I := 0 to Image.Height - 1 do - Move(PByteArray(Image.Bits)[I * LineBytes], - PByteArray(Rect.pBits)[I * Rect.Pitch], LineBytes); - end - else - Move(Image.Bits^, Rect.pBits^, Image.Size); -end; - -function CreateD3DTextureFromMultiImage(const Images: TDynImageDataArray; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width, - Height, MipLevels: LongInt; Usage: LongWord; Format: TD3DFormat; - Pool: TD3DPool; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - I, PossibleLevels, ExistingLevels, CurrentWidth, CurrentHeight: LongInt; - Caps: TD3DTextureCaps; - Rect: TD3DLockedRect; - ConvTo: TImageFormat; - LevelsArray: TDynImageDataArray; - NeedsResize, NeedsConvert: Boolean; -begin - Texture := nil; - ExistingLevels := 0; - Result := False; - // Get texture caps of the current device and test if there is anything to convert - if GetDeviceTextureCaps(Device, Caps) and (Length(Images) > 0) then - try - // First check desired size and modify it if necessary - if Width <= 0 then Width := Images[0].Width; - if Height <= 0 then Height := Images[0].Height; - if Caps.PowerOfTwo then - begin - // If device supports only power of 2 texture sizes - Width := NextPow2(Width); - Height := NextPow2(Height); - end; - Width := ClampInt(Width, 1, Caps.MaxWidth); - Height := ClampInt(Height, 1, Caps.MaxHeight); - - // Get various mipmap level counts and modify - // desired MipLevels if its value is invalid - ExistingLevels := Length(Images); - PossibleLevels := GetNumMipMapLevels(Width, Height); - if (MipLevels < 1) or (MipLevels > PossibleLevels) then - MipLevels := PossibleLevels; - - // Now determine which image format will be used - if Format = D3DFMT_UNKNOWN then - begin - // D3D texture format is not explicitly defined so we use - // the current format of the input image - Format := ImageFormatToD3DFormat(Images[0].Format, ConvTo); - // Format is now either D3DFMT_UNKNOWN or some valid format and - // ConvTo contains format to which input image must be converted first - // (if ConvTo and input image's format differ). - // We must also test if returned D3D format is supported by D3D device - if (Format = D3DFMT_UNKNOWN) or not IsD3DFormatSupported(Device, Format) then - begin - Format := D3DFMT_A8R8G8B8; - ConvTo := ifA8R8G8B8; - end; - end - else - begin - // Image format coresponding to desired D3D format is either found - // and image is converted to it (if the image is not in this format already) - // or it is not found (or not supported by hardware) and default format is used - ConvTo := D3DFormatToImageFormat(Format); - if (ConvTo = ifUnknown) or not IsD3DFormatSupported(Device, Format) then - begin - Format := D3DFMT_A8R8G8B8; - ConvTo := ifA8R8G8B8; - end; - end; - - // Prepare array for mipmap levels - SetLength(LevelsArray, MipLevels); - - CurrentWidth := Width; - CurrentHeight := Height; - - for I := 0 to MipLevels - 1 do - begin - // Check if we can use input image array as a source for this mipmap level - if I < ExistingLevels then - begin - // Check if input image for this mipmap level has the right - // size and format - NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight)); - NeedsConvert := not (Images[I].Format = ConvTo); - - if NeedsResize or NeedsConvert then - begin - // Input image must be resized or converted to different format - // to become valid mipmap level - CloneImage(Images[I], LevelsArray[I]); - if NeedsConvert then - ConvertImage(LevelsArray[I], ConvTo); - if NeedsResize then - ResizeImage(LevelsArray[I], CurrentWidth, CurrentHeight, rfBilinear); - end - else - // Input image can be used without any changes - LevelsArray[I] := Images[I]; - end - else - begin - // This mipmap level is not present in the input image array - // so we create a new level - FillMipMapLevel(LevelsArray[I - 1], CurrentWidth, CurrentHeight, LevelsArray[I]); - end; - // Calculate width and height of the next mipmap level - CurrentWidth := ClampInt(CurrentWidth div 2, 1, CurrentWidth); - CurrentHeight := ClampInt(CurrentHeight div 2, 1, CurrentHeight); - end; - - // Finally create D3D texture object - if Succeeded(Device.CreateTexture(LevelsArray[0].Width, - LevelsArray[0].Height, MipLevels, Usage, Format, Pool, Texture, nil)) then - begin - // Fill each mipmap level - for I := 0 to MipLevels - 1 do - if Succeeded(Texture.LockRect(I, Rect, nil, 0)) then - begin - FillLockedRectWithImage(Rect, LevelsArray[I]); - Texture.UnlockRect(I); - end; - Result := True; - end; - - // If user is interested in width and height of created texture lets - // give him that - if CreatedWidth <> nil then CreatedWidth^ := LevelsArray[0].Width; - if CreatedHeight <> nil then CreatedHeight^ := LevelsArray[0].Height; - - finally - // Free local image copies - for I := 0 to Length(LevelsArray) - 1 do - begin - if ((I < ExistingLevels) and (LevelsArray[I].Bits <> Images[I].Bits)) or - (I >= ExistingLevels) then - FreeImage(LevelsArray[I]); - end; - end; -end; - -function SaveD3DTextureToFile(const FileName: string; const Texture: IDirect3DTexture9): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromD3DTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByName(FileName); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToFile(FileName, Arr); - if IsDDS then - PopOptions; - end; - end; -end; - -function SaveD3DTextureToStream(const Ext: string; Stream: TStream; const Texture: IDirect3DTexture9): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromD3DTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToStream(Ext, Stream, Arr); - if IsDDS then - PopOptions; - end; - end; -end; - -function SaveD3DTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: IDirect3DTexture9): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromD3DTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToMemory(Ext, Data, Size, Arr); - if IsDDS then - PopOptions; - end; - end; -end; - -function CreateImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Image: TImageData; OverrideFormat: TImageFormat): Boolean; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - FreeImage(Image); - SetLength(Arr, 1); - Result := CreateMultiImageFromD3DTexture(Texture, Arr, 1, OverrideFormat); - Image := Arr[0]; -end; - -procedure FillImageWithLockedRect(var Image: TImageData; const Rect: TD3DLockedRect); -var - I, LineBytes: LongInt; - Info: TImageFormatInfo; -begin - GetImageFormatInfo(Image.Format, Info); - LineBytes := Info.GetPixelsSize(Info.Format, Image.Width, 1); - // Pixels are copied from D3D texture to the image - if (not Info.IsSpecial) and (LineBytes < Rect.Pitch) then - begin - for I := 0 to Image.Height - 1 do - Move(PByteArray(Rect.pBits)[I * Rect.Pitch], - PByteArray(Image.Bits)[I * LineBytes], LineBytes); - end - else - Move(Rect.pBits^, Image.Bits^, Image.Size); -end; - -function CreateMultiImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Images: TDynImageDataArray; MipLevels: LongInt; OverrideFormat: TImageFormat): Boolean; -var - Rect: TD3DLockedRect; - Desc: TD3DSurfaceDesc; - I,ExistingLevels: LongInt; - CurrentFormat: TImageFormat; - Info: TImageFormatInfo; -begin - FreeImagesInArray(Images); - SetLength(Images, 0); - Result := False; - if Texture <> nil then - begin - // Check if desired mipmap level count is valid - ExistingLevels := Texture.GetLevelCount; - if (MipLevels <= 0) or (Miplevels > ExistingLevels) then - MipLevels := ExistingLevels; - - Texture.GetLevelDesc(0, Desc); - // Try to find image format compatible with d3d texture's format - CurrentFormat := D3DFormatToImageFormat(Desc.Format); - // Exit if no compatible image format is found - if CurrentFormat = ifUnknown then - Exit; - - SetLength(Images, MipLevels); - GetImageFormatInfo(CurrentFormat, Info); - - for I := 0 to MipLevels - 1 do - begin - if Failed(Texture.LockRect(I, Rect, nil, D3DLOCK_READONLY)) then Exit; - Texture.GetLevelDesc(I, Desc); - - // Create image for the current mipmap level and copy texture data to it - NewImage(Desc.Width, Desc.Height, CurrentFormat, Images[I]); - FillImageWithLockedRect(Images[I], Rect); - - // If override format is set each mipmap level is converted to it - if OverrideFormat <> ifUnknown then - ConvertImage(Images[I], OverrideFormat); - - Texture.UnlockRect(I); - end; - Result := True; - end; -end; - -function CreateD3DSurfaceFromImage(const Image: TImageData; Surface: IDirect3DSurface9): Boolean; -var - ConvTo: TImageFormat; - Desc: TD3DSurfaceDesc; - Rect: TD3DLockedRect; - WorkImage: TImageData; -begin - Result := False; - if (Surface = nil) or not TestImage(Image) then - Exit; - // Get surface's format and find Imaging data format match - Surface.GetDesc(Desc); - ConvTo := D3DFormatToImageFormat(Desc.Format); - // If no Imaging data format was found we must exit - if ConvTo = ifUnknown then - Exit; - - if (LongInt(Desc.Width) <> Image.Width) or (LongInt(Desc.Height) <> Image.Height) or - (Image.Format <> ConvTo) then - begin - // Source image has different dimensions or format than dest surface, - // working image is created - InitImage(WorkImage); - NewImage(Desc.Width, Desc.Height, ConvTo, WorkImage); - StretchRect(Image, 0, 0, Image.Width, Image.Height, WorkImage, 0, 0, - WorkImage.Width, WorkImage.Height, rfBilinear); - end - else - WorkImage := Image; - - try - // Lock surface and fill it with image - if Succeeded(Surface.LockRect(Rect, nil, 0)) then - begin - FillLockedRectWithImage(Rect, WorkImage); - Surface.UnlockRect; - Result := True; - end; - finally - // Free working image if it is not reference to source image - if WorkImage.Bits <> Image.Bits then - FreeImage(WorkImage); - end; -end; - -function CreateImageFromD3DSurface(Surface: IDirect3DSurface9; var Image: TImageData): Boolean; -var - CurrentFormat: TImageFormat; - Desc: TD3DSurfaceDesc; - Rect: TD3DLockedRect; -begin - Result := False; - FreeImage(Image); - if Surface = nil then - Exit; - Surface.GetDesc(Desc); - CurrentFormat := D3DFormatToImageFormat(Desc.Format); - // Exit if no compatible image format is found - if CurrentFormat = ifUnknown then - Exit; - - if Succeeded(Surface.LockRect(Rect, nil, D3DLOCK_READONLY)) then - begin - // If surface was successfuly locked a new image is created - // and surface's contents are copied to it - NewImage(Desc.Width, Desc.Height, CurrentFormat, Image); - FillImageWithLockedRect(Image, Rect); - Surface.UnlockRect; - Result := True; - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - support for cube and volume maps - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Added support for 3Dc compressed texture formats. - - Added detection of 3Dc support to texture caps. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added CreatedWidth and CreatedHeight parameters to most - LoadD3DTextureFromXXX/CreateD3DTextureFromXXX functions. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - fixed bug in CreateGLTextureFromMultiImage which caused assert failure - when creating mipmaps (using FillMipMapLevel) for DXTC formats - - added support for 16bit half-float texture formats - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - D3D surface support - fill surface with image and vice versa - - more texture caps added - - filtered mipmap creation - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - unit created and initial stuff added -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingExtras.pas b/components/vampireimaging/Extras/Extensions/ImagingExtras.pas deleted file mode 100644 index 4ef0fca..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingExtras.pas +++ /dev/null @@ -1,150 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This is helper unit that registers all image file formats in Extras package - to Imaging core loading and saving functions. Just put this unit in your uses - clause instead of adding every unit that provides new file format support. - Also new constants for SetOption/GetOption functions for new file formats - are located here.} -unit ImagingExtras; - -{$I ImagingOptions.inc} - -{.$DEFINE DONT_LINK_JPEG2000} // link support for JPEG2000 images -{.$DEFINE DONT_LINK_TIFF} // link support for TIFF images -{.$DEFINE DONT_LINK_PSD} // link support for PSD images -{.$DEFINE DONT_LINK_PCX} // link support for PCX images -{.$DEFINE DONT_LINK_XPM} // link support for XPM images - -{$IFNDEF FULL_FEATURE_SET} - {$DEFINE DONT_LINK_ELDER} // link support for Elder Imagery images -{$ENDIF} - -{$IF not ( - (Defined(DCC) and Defined(CPUX86) and not Defined(MACOS)) or - (Defined(FPC) and not Defined(MSDOS) and - ((Defined(CPUX86) and (Defined(LINUX) or Defined(WIN32) or Defined(MACOS)) or - (Defined(CPUX64) and Defined(LINUX))))) - )} - // JPEG2000 only for 32bit Windows/Linux/OSX and for 64bit Unix with FPC - {$DEFINE DONT_LINK_JPEG2000} -{$IFEND} - -interface - -const - { Those are new options for GetOption/SetOption interface. } - - { Controls JPEG 2000 lossy compression quality. It is number in range 1..100. - 1 means small/ugly file, 100 means large/nice file. Default is 80.} - ImagingJpeg2000Quality = 55; - { Controls whether JPEG 2000 image is saved with full file headers or just - as code stream. Default value is False (0).} - ImagingJpeg2000CodeStreamOnly = 56; - { Specifies JPEG 2000 image compression type. If True (1), saved JPEG 2000 files - will be losslessly compressed. Otherwise lossy compression is used. - Default value is False (0).} - ImagingJpeg2000LosslessCompression = 57; - { Specifies JPEG 2000 output scaling. Since JPEG 2000 supports arbitrary Bit Depths, - the default behaviour is to scale the images up to the next 8^n bit depth. - This can be disabled by setting this option to False. - Defaul value is True. } - ImagingJpeg2000ScaleOutput = 58; - { Specifies compression scheme used when saving TIFF images. Supported values - are 0 (Uncompressed), 1 (LZW), 2 (PackBits RLE), 3 (Deflate - ZLib), 4 (JPEG), - 5 (CCITT Group 4 fax encoding - for binary images only). - Default is 1 (LZW). Note that not all images can be stored with - JPEG compression - these images will be saved with default compression if - JPEG is set.} - ImagingTiffCompression = 65; - { Controls compression quality when selected TIFF compression is Jpeg. - It is number in range 1..100. 1 means small/ugly file, - 100 means large/nice file. Accessible trough ImagingTiffJpegQuality option.} - ImagingTiffJpegQuality = 66; - { If enabled image data is saved as layer of PSD file. This is required - to get proper transparency when opened in Photoshop for images with - alpha data (will be opened with one layer, RGB color channels, and transparency). - If you don't need this Photoshop compatibility turn this option off as you'll get - smaller file (will be opened in PS as background raster with RGBA channels). - Default value is True (1). } - ImagingPSDSaveAsLayer = 70; - -implementation - -uses -{$IFNDEF DONT_LINK_FILE_FORMATS} -{$IFNDEF DONT_LINK_JPEG2000} - ImagingJpeg2000, -{$ENDIF} -{$IFNDEF DONT_LINK_TIFF} - ImagingTiff, -{$ENDIF} -{$IFNDEF DONT_LINK_PSD} - ImagingPsd, -{$ENDIF} -{$IFNDEF DONT_LINK_PCX} - ImagingPcx, -{$ENDIF} -{$IFNDEF DONT_LINK_XPM} - ImagingXpm, -{$ENDIF} -{$IFNDEF DONT_LINK_ELDER} - ElderImagery, -{$ENDIF} -{$ENDIF} - Imaging; - -{ - File Notes: - - -- TODOS ----------------------------------------------------- - - nothing now - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Added Group 4 Fax encoding as compression for TIFF files. - - Added ImagingTiffJpegQuality option. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Allowed JPEG2000 for Mac OS X x86 - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - ElderImagery formats are disabled by default, TIFF enabled. - - Changed _LINK_ symbols according to changes in ImagingOptions.inc. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Allowed JPEG2000 for x86_64 CPUS in Linux - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Better IF conditional to disable JPEG2000 on unsupported platforms. - - Added PSD and TIFF related stuff. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Created with initial stuff. - -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingFmx.pas b/components/vampireimaging/Extras/Extensions/ImagingFmx.pas deleted file mode 100644 index 90b46fd..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingFmx.pas +++ /dev/null @@ -1,310 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ Functions and classes for interoperability between Imaging and - FireMonkey framework.} -unit ImagingFmx; - -{$I ImagingOptions.inc} - -interface - -uses - Types, - SysUtils, - ImagingTypes, - Imaging, - ImagingFormats, - ImagingClasses, - ImagingUtility, - UITypes, - Fmx.Types, - Fmx.Utils, - Fmx.Graphics; - -{ Converts image from TImageData record to FMX bitmap. Bitmap must be already instantiated.} -procedure ConvertImageDataToFmxBitmap(const Image: TImageData; Bitmap: TBitmap); -{ Converts FMX bitmap to TImageData. Image Data must already instantiated.} -procedure ConvertFmxBitmapToImageData(const Bitmap: TBitmap; Image: TImageData); - -{ Converts image from TBaseImage instance to FMX bitmap. Bitmap must be already instantiated.} -procedure ConvertImageToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap); - -{ Copies rectangular area of pixels from TImageData record to existing FMX bitmap.} -procedure CopyRectToFmxBitmap(const Image: TImageData; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: LongInt); overload; -{ Copies rectangular area of pixels from TBaseImage instance to existing FMX bitmap.} -procedure CopyRectToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: LongInt); overload; - -implementation - -procedure ConvertFmxBitmapToImageData(const Bitmap: TBitmap; Image: TImageData); -var - Color32: TColor32Rec; - MapData: TBitmapData; - SourceData: PAlphaColorRec; - TargetData: PByte; - X, Y, Bpp, SrcWidthBytes: Integer; - TargetInfo: TImageFormatInfo; -begin - Bitmap.Map(TMapAccess.maRead, MapData); - GetImageFormatInfo(Image.Format, TargetInfo); - - Bpp := TargetInfo.BytesPerPixel; - SrcWidthBytes := Image.Width * Bpp; - TargetData := @PByteArray(Image.Bits)[0]; - - for Y := 0 to Pred(Bitmap.Height) do - for X:= 0 to Pred(Bitmap.Width) do - begin - SourceData:= @PAlphaColorRecArray(MapData.Data)[Y * (MapData.Pitch div 4) + X]; - case TargetInfo.Format of - ifIndex8: - begin - Image.Palette[TargetData^].R := SourceData^.R; - Image.Palette[TargetData^].G := SourceData^.G; - Image.Palette[TargetData^].B := SourceData^.B; - Image.Palette[TargetData^].A := SourceData^.A; - end; - ifGray8: - TargetData^ := SourceData.R; - ifA8Gray8: - begin - TargetData^ := SourceData.R; - PWordRec(TargetData).High := SourceData.A; - end; - ifGray16: - PWord(TargetData)^ := SourceData.R; - ifR8G8B8: - begin - PColor24Rec(TargetData)^.R := SourceData.R; - PColor24Rec(TargetData)^.G := SourceData.G; - PColor24Rec(TargetData)^.B := SourceData.B; - end; - ifA8R8G8B8: - begin - PColor32Rec(TargetData)^.A := SourceData^.B; - PColor32Rec(TargetData)^.G := SourceData^.R; - PColor32Rec(TargetData)^.R := SourceData^.G; - PColor32Rec(TargetData)^.B := SourceData^.A; - end; - ifR16G16B16: - begin - PColor48Rec(TargetData).R := Round(SourceData.R * $FFFF / 255); - PColor48Rec(TargetData).G := Round(SourceData.G * $FFFF / 255); - PColor48Rec(TargetData).B := Round(SourceData.B * $FFFF / 255); - end; - ifA16R16G16B16: - begin - PColor64Rec(TargetData).R := Round(SourceData.R * $FFFF / 255); - PColor64Rec(TargetData).G := Round(SourceData.G * $FFFF / 255); - PColor64Rec(TargetData).B := Round(SourceData.B * $FFFF / 255); - PColor64Rec(TargetData).A := Round(SourceData.A * $FFFF / 255); - end; - else - Color32.R := SourceData^.R; - Color32.G := SourceData^.G; - Color32.B := SourceData^.B; - Color32.A := SourceData^.A; - TargetInfo.SetPixel32(TargetData,@TargetInfo, Image.Palette,Color32); - end; - Inc(TargetData, Bpp); - end; - Bitmap.Unmap(MapData); -end; - -procedure ConvertImageDataToFmxBitmap(const Image: TImageData; Bitmap: TBitmap); -begin - Assert(TestImage(Image)); - Bitmap.SetSize(Image.Width, Image.Height); - CopyRectToFmxBitmap(Image, Bitmap, 0, 0, Image.Width, Image.Height, 0, 0); -end; - -procedure ConvertImageToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap); -begin - ConvertImageDataToFmxBitmap(Image.ImageDataPointer^, Bitmap); -end; - -procedure ConvertToAlphaColorRec(SrcPix: PByte; DestPix: PAlphaColorRec; - const SrcInfo: TImageFormatInfo; SrcPalette: PPalette32); -var - Color32:TColor32Rec; -begin - case SrcInfo.Format of - ifIndex8: - begin - DestPix^.R := SrcPalette[SrcPix^].R; - DestPix^.G := SrcPalette[SrcPix^].G; - DestPix^.B := SrcPalette[SrcPix^].B; - DestPix^.A := SrcPalette[SrcPix^].A; - end; - ifGray8: - begin - DestPix.R := SrcPix^; - DestPix.G := SrcPix^; - DestPix.B := SrcPix^; - DestPix.A := 255; - end; - ifA8Gray8: - begin - DestPix.R := SrcPix^; - DestPix.G := SrcPix^; - DestPix.B := SrcPix^; - DestPix.A := PWordRec(SrcPix).High; - end; - ifGray16: - begin - DestPix.R := PWord(SrcPix)^ shr 8; - DestPix.G := DestPix.R; - DestPix.B := DestPix.R; - DestPix.A := 255; - end; - ifR8G8B8: - begin - DestPix.R := PColor24Rec(SrcPix)^.R; - DestPix.G := PColor24Rec(SrcPix)^.G; - DestPix.B := PColor24Rec(SrcPix)^.B; - DestPix.A := 255; - end; - ifA8R8G8B8: - begin - DestPix^.R := PColor32Rec(SrcPix)^.R; - DestPix^.G := PColor32Rec(SrcPix)^.G; - DestPix^.B := PColor32Rec(SrcPix)^.B; - DestPix^.A := PColor32Rec(SrcPix)^.A; - end; - ifR16G16B16: - begin - DestPix.R := PColor48Rec(SrcPix).R shr 8; - DestPix.G := PColor48Rec(SrcPix).G shr 8; - DestPix.B := PColor48Rec(SrcPix).B shr 8; - DestPix.A := 255; - end; - ifA16R16G16B16: - begin - DestPix.R := PColor64Rec(SrcPix).R shr 8; - DestPix.G := PColor64Rec(SrcPix).G shr 8; - DestPix.B := PColor64Rec(SrcPix).B shr 8; - DestPix.A := PColor64Rec(SrcPix).A shr 8; - end; - else - Color32:=SrcInfo.GetPixel32(SrcPix, @SrcInfo, SrcPalette); - DestPix^.R := Color32.R; - DestPix^.G := Color32.G; - DestPix^.B := Color32.B; - DestPix^.A := Color32.A; - end; -end; - -procedure CopyRectToFmxBitmap(const Image: TImageData; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: LongInt); -var - TempImage: TImageData; - X, Y, Bpp, SrcWidthBytes, MoveBytes: Integer; - SrcPtr: PByte; - Info: TImageFormatInfo; - MapData: TBitmapData; - DstPtr: PAlphaColorRec; - ARGB: TAlphaColorRec; -begin - Assert(TestImage(Image) and not Bitmap.IsEmpty); - - ClipCopyBounds(SrcX, SrcY, Width, Height, DstX, DstY, Image.Width, Image.Height, - Rect(0, 0, Bitmap.Width, Bitmap.Height)); - GetImageFormatInfo(Image.Format, Info); - - if not Info.IsSpecial then - begin - Bpp := Info.BytesPerPixel; - SrcWidthBytes := Image.Width * Bpp; - MoveBytes := Width * Bpp; - SrcPtr := @PByteArray(Image.Bits)[SrcY * SrcWidthBytes + SrcX * Bpp]; - Bitmap.Map(TMapAccess.maReadWrite, MapData); - - for Y := 0 to Height - 1 do - begin - if Info.Format = ifA8R8G8B8 then - begin - for X := 0 to Pred(Width) do - begin - DstPtr := @PColor32RecArray(MapData.Data)[Y * (MapData.Pitch div 4) + X]; - Move(SrcPtr^, ARGB, 4); - DstPtr^.A := ARGB.A; - DstPtr^.R := ARGB.R; - DstPtr^.G := ARGB.G; - DstPtr^.B := ARGB.B; - Inc(SrcPtr, 4); - end; - end - else - begin - for X := 0 to Width - 1 do - begin - DstPtr := @PColor32RecArray(MapData.Data)[Y * (MapData.Pitch div 4)+X]; - ConvertToAlphaColorRec(SrcPtr, DstPtr, Info, Image.Palette); - Inc(SrcPtr, Bpp); - end; - end; - end; - end - else - begin - InitImage(TempImage); - CloneImage(Image, TempImage); - ConvertImage(TempImage, ifA8R8G8B8); - try - CopyRectToFmxBitmap(TempImage, Bitmap, SrcX, SrcY, Width, Height, DstX, DstY); - finally - FreeImage(TempImage); - end; - end; - Bitmap.UnMap(MapData); -end; - -procedure CopyRectToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: LongInt); -begin - CopyRectToFmxBitmap(Image.ImageDataPointer^, Bitmap, - SrcX, SrcY, Width, Height, DstX, DstY); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 Changes/Bug Fixes --------------------------------- - - Removed support for old FMX versions (XE2 etc.) - - Support for current FMX version (XE4+) contributed by Ken Schafer. - - -- 0.77 Changes/Bug Fixes ----------------------------------- - - Unit created with initial stuff, working with FMX1 in Delphi XE2. - } - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingGraphics32.pas b/components/vampireimaging/Extras/Extensions/ImagingGraphics32.pas deleted file mode 100644 index 6966873..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingGraphics32.pas +++ /dev/null @@ -1,256 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ Unit functions for converting and copying images between Imaging and Graphics32 library.} -unit ImagingGraphics32; - -{$I ImagingOptions.inc} - -interface - -uses - Types, GR32, ImagingTypes, Imaging, ImagingFormats, ImagingUtility, ImagingClasses; - -{ Converts image from TImageData record to GR32's bitmap. Bitmap32 must be already - instantiated.} -procedure ConvertImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -{ Converts image from TBaseImage instance to GR32's bitmap. Bitmap32 must be already - instantiated.} -procedure ConvertImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); - -{ Converts image data from GR32's bitmap to TImageData record.} -procedure ConvertBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); -{ Converts image data from GR32's bitmap to existing TBaseImage instance.} -procedure ConvertBitmap32ToImage(Bitmap32: TCustomBitmap32; Image: TBaseImage); - -{ Copies pixels from TImageData record (with all the necessary conversion if - the format is not 32bit) to existing GR32's bitmap. Both Image and Bitmap32 must - have the same width and height. } -procedure CopyImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -{ Copies pixels from TBaseImage instance (with all the necessary conversion if - the format is not 32bit) to existing GR32's bitmap. Both Image and Bitmap32 must - have the same width and height. } -procedure CopyImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); - -{ Copies rectangular area of pixels from TImageData record to existing GR32's bitmap.} -procedure CopyRectToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload; -{ Copies rectangular area of pixels from TBaseImage instance to existing GR32's bitmap.} -procedure CopyRectToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload; - -{ Maps GR32 bitmap on TImageData record so that they'll both share - the same pixels in memory (Bitmap32.Bits and Image.Bits point to the same - memory address). Usefull if you wan to e.g. save Bitmap32 using Imaging - and don't want to needlesly duplicate the entire image in memory. - Note that you must not call FreeImage on Image after the mapping or - the memory of Bitmap32 would be freed too.} -procedure MapBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); - -implementation - -procedure ConvertImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -begin - Assert(TestImage(Image)); - Bitmap32.SetSize(Image.Width, Image.Height); - CopyImageDataToBitmap32(Image, Bitmap32); -end; - -procedure ConvertImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); -begin - ConvertImageDataToBitmap32(Image.ImageDataPointer^, Bitmap32); -end; - -procedure ConvertBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); -begin - Assert(not Bitmap32.Empty); - NewImage(Bitmap32.Width, Bitmap32.Height, ifA8R8G8B8, Image); - Move(Bitmap32.Bits^, Image.Bits^, Image.Size); -end; - -procedure ConvertBitmap32ToImage(Bitmap32: TCustomBitmap32; Image: TBaseImage); -begin - ConvertBitmap32ToImageData(Bitmap32, Image.ImageDataPointer^); -end; - -procedure CopyImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -begin - Assert(TestImage(Image) and (Image.Width = Bitmap32.Width) and (Image.Height = Bitmap32.Height)); - CopyRectToBitmap32(Image, Bitmap32, 0, 0, Image.Width, Image.Height, 0, 0); -end; - -procedure CopyImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); -begin - CopyImageDataToBitmap32(Image.ImageDataPointer^, Bitmap32); -end; - -procedure CopyRectToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); -var - TempImage: TImageData; - X, Y, Bpp, SrcWidthBytes, DstWidth, MoveBytes: Integer; - DstPtr: PColor32Rec; - SrcPtr: PByte; - Info: TImageFormatInfo; -begin - Assert(TestImage(Image) and not Bitmap32.Empty); - - ClipCopyBounds(SrcX, SrcY, Width, Height, DstX, DstY, Image.Width, Image.Height, - Rect(0, 0, Bitmap32.Width, Bitmap32.Height)); - - if Image.Format in [ifIndex8, ifGray8, ifA8Gray8, ifGray16, ifR8G8B8, ifA8R8G8B8, - ifR16G16B16, ifA16R16G16B16] then - begin - GetImageFormatInfo(Image.Format, Info); - Bpp := Info.BytesPerPixel; - SrcWidthBytes := Image.Width * Bpp; - DstWidth := Bitmap32.Width; - MoveBytes := Width * Bpp; - SrcPtr := @PByteArray(Image.Bits)[SrcY * SrcWidthBytes + SrcX * Bpp]; - DstPtr := @PColor32RecArray(Bitmap32.Bits)[DstY * DstWidth + DstX]; - - for Y := 0 to Height - 1 do - begin - case Image.Format of - ifIndex8: - for X := 0 to Width - 1 do - begin - DstPtr^ := Image.Palette[SrcPtr^]; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifGray8: - for X := 0 to Width - 1 do - begin - DstPtr.R := SrcPtr^; - DstPtr.G := SrcPtr^; - DstPtr.B := SrcPtr^; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifA8Gray8: - for X := 0 to Width - 1 do - begin - DstPtr.R := SrcPtr^; - DstPtr.G := SrcPtr^; - DstPtr.B := SrcPtr^; - DstPtr.A := PWordRec(SrcPtr).High; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifGray16: - for X := 0 to Width - 1 do - begin - DstPtr.R := PWord(SrcPtr)^ shr 8; - DstPtr.G := DstPtr.R; - DstPtr.B := DstPtr.R; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifR8G8B8: - for X := 0 to Width - 1 do - begin - DstPtr.Color24Rec := PColor24Rec(SrcPtr)^; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifA8R8G8B8: - begin - Move(SrcPtr^, DstPtr^, MoveBytes); - Inc(DstPtr, Width); - Inc(SrcPtr, MoveBytes); - end; - ifR16G16B16: - for X := 0 to Width - 1 do - begin - DstPtr.R := PColor48Rec(SrcPtr).R shr 8; - DstPtr.G := PColor48Rec(SrcPtr).G shr 8; - DstPtr.B := PColor48Rec(SrcPtr).B shr 8; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifA16R16G16B16: - for X := 0 to Width - 1 do - begin - DstPtr.R := PColor64Rec(SrcPtr).R shr 8; - DstPtr.G := PColor64Rec(SrcPtr).G shr 8; - DstPtr.B := PColor64Rec(SrcPtr).B shr 8; - DstPtr.A := PColor64Rec(SrcPtr).A shr 8; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - end; - - Inc(SrcPtr, SrcWidthBytes - MoveBytes); - Inc(DstPtr, DstWidth - Width); - end; - end - else - begin - InitImage(TempImage); - CloneImage(Image, TempImage); - ConvertImage(TempImage, ifA8R8G8B8); - try - CopyRectToBitmap32(TempImage, Bitmap32, SrcX, SrcY, Width, Height, DstX, DstY); - finally - FreeImage(TempImage); - end; - end; -end; - -procedure CopyRectToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); -begin - CopyRectToBitmap32(Image.ImageDataPointer^, Bitmap32, - SrcX, SrcY, Width, Height, DstX, DstY); -end; - -procedure MapBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); -begin - Assert(not Bitmap32.Empty); - FreeImage(Image); - - Image.Width := Bitmap32.Width; - Image.Height := Bitmap32.Height; - Image.Format := ifA8R8G8B8; - Image.Size := Image.Width * Image.Height * 4; - - Image.Bits := Bitmap32.Bits; -end; - -{ - File Notes: - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Created with initial stuff. -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingJpeg2000.pas b/components/vampireimaging/Extras/Extensions/ImagingJpeg2000.pas deleted file mode 100644 index 9973279..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingJpeg2000.pas +++ /dev/null @@ -1,642 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Jpeg 2000 images.} -unit ImagingJpeg2000; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingColors, ImagingIO, ImagingUtility, - ImagingExtras, OpenJpeg; - -type - { Type Jpeg 2000 file (needed for OpenJPEG codec settings).} - TJpeg2000FileType = (jtInvalid, jtJP2, jtJ2K, jtJPT); - - { Class for loading/saving Jpeg 2000 images. It uses OpenJPEG library - compiled to object files and linked to Object Pascal program. Jpeg 2000 - supports wide variety of data formats. You can have arbitrary number - of components/channels, each with different bitdepth and optional - "signedness". Jpeg 2000 images can be lossy or lossless compressed. - - Imaging can load most data formats (except images - with componenet bitdepth > 16 => no Imaging data format equivalents). - Components with sample separation are loaded correctly, ICC profiles - or palettes are not used, YCbCr images are translated to RGB. - - You can set various options when saving Jpeg-2000 images. Look at - properties of TJpeg2000FileFormat for details.} - TJpeg2000FileFormat = class(TImageFileFormat) - private - FQuality: LongInt; - FCodeStreamOnly: LongBool; - FLosslessCompression: LongBool; - FScaleOutput: LongBool; - function GetFileType(Handle: TImagingHandle): TJpeg2000FileType; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - procedure CheckOptionsValidity; override; - published - { Controls JPEG 2000 lossy compression quality. It is number in range 1..100. - 1 means small/ugly file, 100 means large/nice file. Accessible trough - ImagingJpeg2000Quality option. Default value is 80.} - property Quality: LongInt read FQuality write FQuality; - { Controls whether JPEG 2000 image is saved with full file headers or just - as code stream. Default value is False. Accessible trough - ImagingJpeg2000CodeStreamOnly option.} - property CodeStreamOnly: LongBool read FCodeStreamOnly write FCodeStreamOnly; - { Specifies JPEG 2000 image compression type. If True, saved JPEG 2000 files - will be losslessly compressed. Otherwise lossy compression is used. - Default value is False. Accessible trough - ImagingJpeg2000LosslessCompression option.} - property LosslessCompression: LongBool read FLosslessCompression write FLosslessCompression; - { Specifies JPEG 2000 output scaling. Since JPEG 2000 supports arbitrary Bit Depths, - the default behaviour is to scale the images up tp the next 8^n bit depth. - This can be disabled by setting this option to False. - Defaul value is True. Accessible through - ImagingJpeg2000ScaleOutput option.} - property ScaleOutput: LongBool read FScaleOutput write FScaleOutput; - end; - -implementation - -const - SJpeg2000FormatName = 'JPEG 2000 Image'; - SJpeg2000Masks = '*.jp2,*.j2k,*.j2c,*.jpx,*.jpc'; - Jpeg2000SupportedFormats: TImageFormats = [ifGray8, ifGray16, - ifA8Gray8, ifA16Gray16, ifR8G8B8, ifR16G16B16, ifA8R8G8B8, ifA16R16G16B16]; - Jpeg2000DefaultQuality = 80; - Jpeg2000DefaultCodeStreamOnly = False; - Jpeg2000DefaultLosslessCompression = False; - Jpeg2000DefaultScaleOutput = True; - -const - JP2Signature: TChar8 = #0#0#0#$0C#$6A#$50#$20#$20; - J2KSignature: TChar4 = #$FF#$4F#$FF#$51; - -procedure TJpeg2000FileFormat.Define; -begin - inherited; - FName := SJpeg2000FormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := Jpeg2000SupportedFormats; - - FQuality := Jpeg2000DefaultQuality; - FCodeStreamOnly := Jpeg2000DefaultCodeStreamOnly; - FLosslessCompression := Jpeg2000DefaultLosslessCompression; - FScaleOutput := Jpeg2000DefaultScaleOutput; - - AddMasks(SJpeg2000Masks); - RegisterOption(ImagingJpeg2000Quality, @FQuality); - RegisterOption(ImagingJpeg2000CodeStreamOnly, @FCodeStreamOnly); - RegisterOption(ImagingJpeg2000LosslessCompression, @FLosslessCompression); - RegisterOption(ImagingJpeg2000ScaleOutput, @FScaleOutput); -end; - -procedure TJpeg2000FileFormat.CheckOptionsValidity; -begin - // Check if option values are valid - if not (FQuality in [1..100]) then - FQuality := Jpeg2000DefaultQuality; -end; - -function TJpeg2000FileFormat.GetFileType(Handle: TImagingHandle): TJpeg2000FileType; -var - ReadCount: LongInt; - Id: TChar8; -begin - Result := jtInvalid; - with GetIO do - begin - ReadCount := Read(Handle, @Id, SizeOf(Id)); - if ReadCount = SizeOf(Id) then - begin - // Check if we have full JP2 file format or just J2K code stream - if CompareMem(@Id, @JP2Signature, SizeOf(JP2Signature)) then - Result := jtJP2 - else if CompareMem(@Id, @J2KSignature, SizeOf(J2KSignature)) then - Result := jtJ2K; - end; - Seek(Handle, -ReadCount, smFromCurrent); - end; -end; - -function TJpeg2000FileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -type - TChannelInfo = record - DestOffset: Integer; - CompType: OPJ_COMPONENT_TYPE; - Shift: Integer; - SrcMaxValue: Integer; - DestMaxValue: Integer; - end; -var - FileType: TJpeg2000FileType; - Buffer: PByte; - BufferSize, ChannelSize, I: Integer; - Info: TImageFormatInfo; - dinfo: popj_dinfo_t; - parameters: opj_dparameters_t; - cio: popj_cio_t; - image: popj_image_t; - StartPos: Int64; - Channels: array of TChannelInfo; - - procedure WriteSample(Dest: PByte; ChannelSize, Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - begin - case ChannelSize of - 1: Dest^ := Value; - 2: PWord(Dest)^ := Value; - 4: PUInt32(Dest)^ := Value; - end; - end; - - procedure CopySample(Src, Dest: PByte; ChannelSize: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - begin - case ChannelSize of - 1: Dest^ := Src^; - 2: PWord(Dest)^ := PWord(Src)^; - 4: PUInt32(Dest)^ := PUInt32(Src)^; - end; - end; - - procedure ReadChannel(const Image: TImageData; const Info: TChannelInfo; const Comp: opj_image_comp; BytesPerPixel: Integer); - var - X, Y, SX, SY, SrcIdx, LineBytes: Integer; - DestPtr, NewPtr, LineUpPtr: PByte; - DontScaleSamples: Boolean; - begin - DontScaleSamples := (Info.SrcMaxValue = Info.DestMaxValue) or not FScaleOutput; - LineBytes := Image.Width * BytesPerPixel; - DestPtr := @PByteArray(Image.Bits)[Info.DestOffset]; - SrcIdx := 0; - - if (Comp.dx = 1) and (Comp.dy = 1) then - begin - // X and Y sample separation is 1 so just need to assign component values - // to image pixels one by one - for Y := 0 to Image.Height * Image.Width - 1 do - begin - if DontScaleSamples then - WriteSample(DestPtr, ChannelSize, Comp.data[SrcIdx] + Info.Shift) - else - WriteSample(DestPtr, ChannelSize, MulDiv(Comp.data[SrcIdx] + Info.Shift, Info.DestMaxValue, Info.SrcMaxValue)); - - Inc(SrcIdx); - Inc(DestPtr, BytesPerPixel); - end; - end - else - begin - // Sample separation is active - component is sub-sampled. Real component - // dimensions are [Comp.w * Comp.dx, Comp.h * Comp.dy] - for Y := 0 to Comp.h - 1 do - begin - LineUpPtr := @PByteArray(Image.Bits)[Y * Comp.dy * LineBytes + Info.DestOffset]; - DestPtr := LineUpPtr; - - for X := 0 to Comp.w - 1 do - begin - if DontScaleSamples then - WriteSample(DestPtr, ChannelSize, Comp.data[SrcIdx] + Info.Shift) - else - WriteSample(DestPtr, ChannelSize, MulDiv(Comp.data[SrcIdx] + Info.Shift, Info.DestMaxValue, Info.SrcMaxValue)); - - NewPtr := DestPtr; - - for SX := 1 to Comp.dx - 1 do - begin - if X * Comp.dx + SX >= Image.Width then Break; - // Replicate pixels on line - Inc(NewPtr, BytesPerPixel); - CopySample(DestPtr, NewPtr, ChannelSize); - end; - - Inc(SrcIdx); - Inc(DestPtr, BytesPerPixel * Comp.dx); - end; - - for SY := 1 to Comp.dy - 1 do - begin - if Y * Comp.dy + SY >= Image.Height then Break; - // Replicate line - NewPtr := @PByteArray(Image.Bits)[(Y * Comp.dy + SY) * LineBytes + Info.DestOffset]; - for X := 0 to Image.Width - 1 do - begin - CopySample(LineUpPtr, NewPtr, ChannelSize); - Inc(LineUpPtr, BytesPerPixel); - Inc(NewPtr, BytesPerPixel); - end; - end; - end; - end; - end; - - procedure ConvertYCbCrToRGB(Pixels: PByte; NumPixels, BytesPerPixel: Integer); - var - I: Integer; - PixPtr: PByte; - CY, CB, CR: Byte; - CYW, CBW, CRW: Word; - begin - PixPtr := Pixels; - for I := 0 to NumPixels - 1 do - begin - if BytesPerPixel in [3, 4] then - with PColor24Rec(PixPtr)^ do - begin - CY := R; - CB := G; - CR := B; - YCbCrToRGB(CY, CB, CR, R, G, B); - end - else - with PColor48Rec(PixPtr)^ do - begin - CYW := R; - CBW := G; - CRW := B; - YCbCrToRGB16(CYW, CBW, CRW, R, G, B); - end; - Inc(PixPtr, BytesPerPixel); - end; - end; - -begin - Result := False; - image := nil; - cio := nil; - opj_set_default_decoder_parameters(@parameters); - // Determine which codec to use - FileType := GetFileType(Handle); - case FileType of - jtJP2: dinfo := opj_create_decompress(CODEC_JP2); - jtJ2K: dinfo := opj_create_decompress(CODEC_J2K); - jtJPT: dinfo := opj_create_decompress(CODEC_JPT); - else - Exit; - end; - // Set event manager to nil to avoid getting messages - dinfo.event_mgr := nil; - // Currently OpenJPEG can load images only from memory so we have to - // preload whole input to mem buffer. Not good but no other way now. - // At least we set stream pos to end of JP2 data after loading (we will now - // the exact size by then). - StartPos := GetIO.Tell(Handle); - BufferSize := ImagingIO.GetInputSize(GetIO, Handle); - GetMem(Buffer, BufferSize); - - SetLength(Images, 1); - with GetIO, Images[0] do - try - Read(Handle, Buffer, BufferSize); - cio := opj_cio_open(opj_common_ptr(dinfo), Buffer, BufferSize); - opj_setup_decoder(dinfo, @parameters); - // Decode image - image := opj_decode(dinfo, cio); - if image = nil then - Exit; - - // Determine which Imaging data format to use accorsing to - // decoded image components - case image.numcomps of - 2: case image.comps[0].prec of - 1..8: Format := ifA8Gray8; - 9..16: Format := ifA16Gray16; - end; - 3: case image.comps[0].prec of - 1..8: Format := ifR8G8B8; - 9..16: Format := ifR16G16B16; - end; - 4: case image.comps[0].prec of - 1..8: Format := ifA8R8G8B8; - 9..16: Format := ifA16R16G16B16; - end; - else - // There is only one component or there is more than four => - // just load the first one as gray - case image.comps[0].prec of - 1..8: Format := ifGray8; - 9..16: Format := ifGray16; - 17..32: Format := ifGray32; - end; - end; - // Exit if no compatible format was found - if Format = ifUnknown then - Exit; - - NewImage(image.x1 - image.x0, image.y1 - image.y0, Format, Images[0]); - Info := GetFormatInfo(Format); - ChannelSize := Info.BytesPerPixel div Info.ChannelCount; - SetLength(Channels, Info.ChannelCount); - - // Get information about all channels/components of JP2 file - for I := 0 to Info.ChannelCount - 1 do - begin - // Get component type for this channel and based on this - // determine where in dest image bits write this channel's data - Channels[I].CompType := image.comps[I].comp_type; - case Channels[I].CompType of - COMPTYPE_UNKNOWN: - begin - if Info.ChannelCount <> 4 then - begin - // Missing CDEF box in file - usually BGR order - Channels[I].DestOffset := image.numcomps - I - 1 - end - else - begin - // Missing CDEF box in file - usually ABGR order - if I = 3 then - Channels[I].DestOffset := 3 - else - Channels[I].DestOffset := image.numcomps - I - 2 - end; - end; - COMPTYPE_R: Channels[I].DestOffset := 2; - COMPTYPE_G: Channels[I].DestOffset := 1; - COMPTYPE_B: Channels[I].DestOffset := 0; - COMPTYPE_CB: Channels[I].DestOffset := 1; - COMPTYPE_CR: Channels[I].DestOffset := 0; - COMPTYPE_OPACITY: Channels[I].DestOffset := 3; - COMPTYPE_Y: - case image.color_space of - CLRSPC_SYCC: Channels[I].DestOffset := 2; // Y is intensity part of YCC - CLRSPC_GRAY: Channels[I].DestOffset := 0; // Y is independent gray channel - end; - end; - // Scale channel offset - Channels[I].DestOffset := Channels[I].DestOffset * ChannelSize; - // Signed componets must be scaled to [0, 1] interval (depends on precision) - if image.comps[I].sgnd = 1 then - Channels[I].Shift := 1 shl (image.comps[I].prec - 1); - // Max channel values used to easier scaling of precisions - // not supported by Imaging to supported ones (like 12bits etc.). - Channels[I].SrcMaxValue := 1 shl image.comps[I].prec - 1; - Channels[I].DestMaxValue := 1 shl (ChannelSize * 8) - 1; - end; - - // Images components are stored separately in JP2, each can have - // different dimensions, bitdepth, ... - for I := 0 to Info.ChannelCount - 1 do - ReadChannel(Images[0], Channels[I], image.comps[I], Info.BytesPerPixel); - - // If we have YCbCr image we need to convert it to RGB - if (image.color_space = CLRSPC_SYCC) and (Info.ChannelCount in [3, 4]) then - ConvertYCbCrToRGB(Bits, Width * Height, Info.BytesPerPixel); - - // Set the input position just after end of image - Seek(Handle, StartPos + Cardinal(cio.bp) - Cardinal(cio.start), smFromBeginning); - - Result := True; - finally - opj_image_destroy(image); - opj_destroy_decompress(dinfo); - opj_cio_close(cio); - FreeMem(Buffer); - end; -end; - -function TJpeg2000FileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - TargetSize, Rate: Single; - ImageToSave: TImageData; - MustBeFreed: Boolean; - Info: TImageFormatInfo; - I, Z, InvZ, Channel, ChannelSize, NumPixels: Integer; - Pix: PByte; - image: popj_image_t; - cio: popj_cio_t; - cinfo: popj_cinfo_t; - parameters: opj_cparameters_t; - compparams: popj_image_cmptparm_array; - ColorSpace: OPJ_COLOR_SPACE; - - function GetComponentType(Comp: Integer): OPJ_COMPONENT_TYPE; - begin - if Info.HasAlphaChannel and (Comp = Info.ChannelCount - 1) then - Result := COMPTYPE_OPACITY - else if Info.HasGrayChannel then - Result := COMPTYPE_Y - else if Comp = 2 then - Result := COMPTYPE_B - else if Comp = 1 then - Result := COMPTYPE_G - else if Comp = 0 then - Result := COMPTYPE_R - else - Result := COMPTYPE_UNKNOWN; - end; - -begin - Result := False; - image := nil; - compparams := nil; - cinfo := nil; - cio := nil; - // Makes image to save compatible with Jpeg 2000 saving capabilities - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - Info := GetFormatInfo(Format); - ChannelSize := Info.BytesPerPixel div Info.ChannelCount; - - // Fill component info structures and then create OpenJPEG image - GetMem(compparams, Info.ChannelCount * SizeOf(opj_image_comptparm)); - for I := 0 to Info.ChannelCount - 1 do - with compparams[I] do - begin - dx := 1; - dy := 1; - w := Width; - h := Height; - prec := (Info.BytesPerPixel div Info.ChannelCount) * 8; - bpp := prec; - sgnd := 0; - comp_type := GetComponentType(I); - x0 := 0; - y0 := 0; - end; - - if Info.HasGrayChannel then - ColorSpace := CLRSPC_GRAY - else - ColorSpace := CLRSPC_SRGB; - - image := opj_image_create(Info.ChannelCount, @compparams[0], ColorSpace); - if image = nil then Exit; - image.x1 := Width; - image.y1 := Height; - - if FCodeStreamOnly then - cinfo := opj_create_compress(CODEC_J2K) - else - cinfo := opj_create_compress(CODEC_JP2); - - // Set event manager to nil to avoid getting messages - cinfo.event_mgr := nil; - // Set compression parameters based current file format properties - opj_set_default_encoder_parameters(@parameters); - parameters.cod_format := Iff(FCodeStreamOnly, 0, 1); - parameters.numresolution := 6; - parameters.tcp_numlayers := 1; - parameters.cp_disto_alloc := 1; - if FLosslessCompression then - begin - // Set rate to 0 -> lossless - parameters.tcp_rates[0] := 0; - end - else - begin - // Quality -> Rate computation taken from ImageMagick - Rate := 100.0 / Sqr(115 - FQuality); - NumPixels := Width * Height * Info.BytesPerPixel; - TargetSize := (NumPixels * Rate) + 550 + (Info.ChannelCount - 1) * 142; - parameters.tcp_rates[0] := 1.0 / (TargetSize / NumPixels); - end; - // Setup encoder - opj_setup_encoder(cinfo, @parameters, image); - - // Fill component samples in data with values taken from - // image pixels. - // Components should be ordered like this: RGBA, YA, RGB, etc. - for Channel := 0 to Info.ChannelCount - 1 do - begin - Z := Channel; - InvZ := Info.ChannelCount - 1 - Z; - if Info.HasAlphaChannel then - begin - if Channel = Info.ChannelCount - 1 then - InvZ := Z - else - InvZ := Info.ChannelCount - 2 - Z; - end; - Pix := @PByteArray(Bits)[InvZ * ChannelSize]; - for I := 0 to Width * Height - 1 do - begin - case ChannelSize of - 1: image.comps[Z].data[I] := Pix^; - 2: image.comps[Z].data[I] := PWord(Pix)^; - 4: UInt32(image.comps[Z].data[I]) := PUInt32(Pix)^; - end; - Inc(Pix, Info.BytesPerPixel); - end; - end; - - // Open OpenJPEG output - cio := opj_cio_open(opj_common_ptr(cinfo), nil, 0); - // Try to encode the image - if not opj_encode(cinfo, cio, image, nil) then - Exit; - // Finally write buffer with encoded image to output - Write(Handle, cio.buffer, cio_tell(cio)); - - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - opj_destroy_compress(cinfo); - opj_image_destroy(image); - opj_cio_close(cio); - FreeMem(compparams); - end; -end; - -procedure TJpeg2000FileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - ConvFormat := IffFormat(Info.ChannelCount = 1, ifGray16, ifA16R16G16B16) - else if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16) - else if Info.IsIndexed then - ConvFormat := ifA8R8G8B8 - else if Info.BytesPerPixel div Info.ChannelCount > 1 then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16R16G16B16, ifR16G16B16) - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(Image, ConvFormat); -end; - -function TJpeg2000FileFormat.TestFormat(Handle: TImagingHandle): Boolean; -begin - Result := False; - if Handle <> nil then - Result := GetFileType(Handle) <> jtInvalid; -end; - -initialization - RegisterImageFileFormat(TJpeg2000FileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - -- 0.27 Changes --------------------------------------------- - - by Hanno Hugenberg - - introduced the ImagingJpeg2000ScaleOutput parameter for keeping - the original decoded images by avoiding upscaling of output images - - -- 0.26.3 Changes/Bug Fixes ----------------------------------- - - Rewritten JP2 loading part (based on PasJpeg2000) to be - more readable (it's a bit faster too) and handled more JP2 files better: - components with precisions like 12bit (not direct Imaging equivalent) - are properly scaled, images/components with offsets are loaded ok. - - -- 0.24.3 Changes/Bug Fixes ----------------------------------- - - Alpha channels are now saved properly in FPC (GCC optimization issue), - FPC lossy compression enabled again! - - Added handling of component types (CDEF Box), JP2 images with alpha - are now properly recognized by other applications. - - Fixed wrong color space when saving grayscale images - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Removed ifGray32 from supported formats, OpenJPEG crashes when saving them. - - Added Seek after loading to set input pos to the end of image. - - Saving added losy/lossless, quality option added. - - Initial loading-only version created. - -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingJpegIJL.pas b/components/vampireimaging/Extras/Extensions/ImagingJpegIJL.pas deleted file mode 100644 index 352c83e..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingJpegIJL.pas +++ /dev/null @@ -1,447 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format alternative loader/saver for Jpeg images - using Intel Jpeg Library (Win32 only).} -unit ImagingJpegIJL; - -{$I ImagingOptions.inc} - -{$IFNDEF WIN32} - {$ERROR 'IJL 1.5 only for Win32'} -{$ENDIF} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingUtility, ImagingIO; - -type - { Class for loading/saving Jpeg images. This is alternative to - default built-in Jpeg handler (which uses JpegLib). - This handler uses Intel Jpeg Library 1.5 (DLL needed) and is - much faster than JpegLib (2-4x). Also supports reading and writing of - alpha channels in Jpeg files.} - TJpegFileFormatIJL = class(TImageFileFormat) - private - FQuality: LongInt; - procedure JpegError(Code: Integer); - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - procedure CheckOptionsValidity; override; - published - { Controls Jpeg save compression quality. It is number in range 1..100. - 1 means small/ugly file, 100 means large/nice file. Accessible trough - ImagingJpegQuality option.} - property Quality: LongInt read FQuality write FQuality; - end; - -implementation - -{$MINENUMSIZE 4} // Min enum size: 4 B - -uses - Types; - -const - SJpegFormatName = 'JPEG Image (IJL)'; - SJpegMasks = '*.jpg,*.jpeg,*.jfif,*.jpe,*.jif,*.jpa'; - JpegSupportedFormats: TImageFormats = [ifGray8, ifR8G8B8, ifA8R8G8B8]; - JpegDefaultQuality = 90; - JpegDefaultProgressive = False; - -resourcestring - SJpegError = 'JPEG Error'; - -const - { Jpeg file identifiers.} - JpegMagic: TChar2 = #$FF#$D8; - SIJLLibrary = 'ijl15.dll'; - -const - IJL_SETUP = -1; - IJL_OK = 0; - IJL_NONE = 0; - IJL_OTHER = 255; - JBUFSIZE = 4096; // Size of file I/O buffer (4K). - -type - { - Purpose: Possible types of data read/write/other operations to be - performed by the functions IJL_Read and IJL_Write. - See the Developer's Guide for details on appropriate usage. - Fields: - IJL_JFILE_XXXXXXX Indicates JPEG data in a stdio file. - IJL_JBUFF_XXXXXXX Indicates JPEG data in an addressable buffer. - } - TIJLIOType = ( - // Read JPEG parameters (i.e., height, width, channels, sampling, etc.) - // from a JPEG bit stream. - IJL_JFILE_READPARAMS = 0, - IJL_JBUFF_READPARAMS = 1, - // Read a JPEG Interchange Format image. - IJL_JFILE_READWHOLEIMAGE = 2, - IJL_JBUFF_READWHOLEIMAGE = 3, - // Read JPEG tables from a JPEG Abbreviated Format bit stream. - IJL_JFILE_READHEADER = 4, - IJL_JBUFF_READHEADER = 5, - // Read image info from a JPEG Abbreviated Format bit stream. - IJL_JFILE_READENTROPY = 6, - IJL_JBUFF_READENTROPY = 7, - // Write an entire JFIF bit stream. - IJL_JFILE_WRITEWHOLEIMAGE = 8, - IJL_JBUFF_WRITEWHOLEIMAGE = 9, - // Write a JPEG Abbreviated Format bit stream. - IJL_JFILE_WRITEHEADER = 10, - IJL_JBUFF_WRITEHEADER = 11, - // Write image info to a JPEG Abbreviated Format bit stream. - IJL_JFILE_WRITEENTROPY = 12, - IJL_JBUFF_WRITEENTROPY = 13, - - // Scaled Decoding Options: - // Reads a JPEG image scaled to 1/2 size. - IJL_JFILE_READONEHALF = 14, - IJL_JBUFF_READONEHALF = 15, - // Reads a JPEG image scaled to 1/4 size. - IJL_JFILE_READONEQUARTER = 16, - IJL_JBUFF_READONEQUARTER = 17, - // Reads a JPEG image scaled to 1/8 size. - IJL_JFILE_READONEEIGHTH = 18, - IJL_JBUFF_READONEEIGHTH = 19, - // Reads an embedded thumbnail from a JFIF bit stream. - IJL_JFILE_READTHUMBNAIL = 20, - IJL_JBUFF_READTHUMBNAIL = 21 - ); - - { - Purpose: Possible color space formats. - Note these formats do *not* necessarily denote - the number of channels in the color space. - There exists separate "channel" fields in the - JPEG_CORE_PROPERTIES data structure specifically - for indicating the number of channels in the - JPEG and/or DIB color spaces.} - TIJL_COLOR = ( - IJL_RGB = 1, // Red-Green-Blue color space. - IJL_BGR = 2, // Reversed channel ordering from IJL_RGB. - IJL_YCBCR = 3, // Luminance-Chrominance color space as defined - // by CCIR Recommendation 601. - IJL_G = 4, // Grayscale color space. - IJL_RGBA_FPX = 5, // FlashPix RGB 4 channel color space that - // has pre-multiplied opacity. - IJL_YCBCRA_FPX = 6 // FlashPix YCbCr 4 channel color space that - // has pre-multiplied opacity. - //IJL_OTHER = 255 // Some other color space not defined by the IJL. - // (This means no color space conversion will - // be done by the IJL.) - ); - - { Purpose: Possible subsampling formats used in the JPEG.} - TIJL_JPGSUBSAMPLING = ( - IJL_NOSUBSAMP = 0, - IJL_411 = 1, // Valid on a JPEG w/ 3 channels. - IJL_422 = 2, // Valid on a JPEG w/ 3 channels. - IJL_4114 = 3, // Valid on a JPEG w/ 4 channels. - IJL_4224 = 4 // Valid on a JPEG w/ 4 channels. - ); - - { Purpose: Possible subsampling formats used in the DIB. } - TIJL_DIBSUBSAMPLING = TIJL_JPGSUBSAMPLING; - - { Purpose: This is the primary data structure between the IJL and - the external user. It stores JPEG state information - and controls the IJL. It is user-modifiable. - Context: Used by all low-level IJL routines to store - pseudo-global information.} - TJpegCoreProperties = packed record - UseJPEGPROPERTIES : LongBool; // default = 0 - // DIB specific I/O data specifiers. - DIBBytes : PByte; // default = NULL - DIBWidth : UInt32; // default = 0 - DIBHeight : UInt32; // default = 0 - DIBPadBytes : UInt32; // default = 0 - DIBChannels : UInt32; // default = 3 - DIBColor : TIJL_COLOR; // default = IJL_BGR - DIBSubsampling : TIJL_DIBSUBSAMPLING; // default = IJL_NONE - // JPEG specific I/O data specifiers. - JPGFile : PAnsiChar; // default = NULL - JPGBytes : PByte; // default = NULL - JPGSizeBytes : UInt32; // default = 0 - JPGWidth : UInt32; // default = 0 - JPGHeight : UInt32; // default = 0 - JPGChannels : UInt32; // default = 3 - JPGColor : TIJL_COLOR; // default = IJL_YCBCR - JPGSubsampling : TIJL_JPGSUBSAMPLING; // default = IJL_411 - JPGThumbWidth : UInt32; // default = 0 - JPGThumbHeight : UInt32; // default = 0 - // JPEG conversion properties. - NeedsConvert : LongBool; // default = TRUE - NeedsResample : LongBool; // default = TRUE - Quality : UInt32; // default = 75 - // Low-level properties. - PropsAndUnused : array[0..19987] of Byte; - end; - PJpegCoreProperties = ^TJpegCoreProperties; - -function ijlInit(var Props: TJpegCoreProperties): Integer; stdcall; external SIJLLibrary; -function ijlFree(var Props: TJpegCoreProperties): Integer; stdcall; external SIJLLibrary; -function ijlRead(var Props: TJpegCoreProperties; IoType : TIJLIOTYPE): Integer; stdcall; external SIJLLibrary; -function ijlWrite(var Props: TJpegCoreProperties; IoType : TIJLIOTYPE): Integer; stdcall; external SIJLLibrary; -function ijlErrorStr(Code : Integer) : PAnsiChar; stdcall; external SIJLLibrary; - -{ TJpegFileFormatIJL class implementation } - -procedure TJpegFileFormatIJL.Define; -begin - inherited; - FName := SJpegFormatName; - FCanLoad := True; - FCanSave := True; - FIsMultiImageFormat := False; - FSupportedFormats := JpegSupportedFormats; - - FQuality := JpegDefaultQuality; - - AddMasks(SJpegMasks); - RegisterOption(ImagingJpegQuality, @FQuality); -end; - -procedure TJpegFileFormatIJL.CheckOptionsValidity; -begin - // Check if option values are valid - if not (FQuality in [1..100]) then - FQuality := JpegDefaultQuality; -end; - -procedure TJpegFileFormatIJL.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - if Info.HasAlphaChannel then - ConvertImage(Image, ifA8R8G8B8) - else if Info.HasGrayChannel then - ConvertImage(Image, ifGray8) - else - ConvertImage(Image, ifR8G8B8); -end; - -function TJpegFileFormatIJL.TestFormat(Handle: TImagingHandle): Boolean; -var - ReadCount: LongInt; - ID: array[0..9] of AnsiChar; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - FillChar(ID, SizeOf(ID), 0); - ReadCount := Read(Handle, @ID, SizeOf(ID)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(ID)) and - CompareMem(@ID, @JpegMagic, SizeOf(JpegMagic)); - end; -end; - -procedure TJpegFileFormatIJL.JpegError(Code: Integer); -begin - raise EImagingError.Create(SJpegError + ': ' + ijlErrorStr(Code)); -end; - -function TJpegFileFormatIJL.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Props: TJpegCoreProperties; - Status: Integer; - Buffer: TDynByteArray; - InputLen: Integer; - JpegFmt: TImageFormat; -begin - // Copy IO functions to global var used in JpegLib callbacks - Result := False; - SetLength(Images, 1); - - with Images[0] do - try - InputLen := GetInputSize(GetIO, Handle); - - Status := IjlInit(Props); - if Status = IJL_OK then - begin - // Load input to memory and read Jpeg props - SetLength(Buffer, InputLen); - Props.JPGSizeBytes := InputLen; - Props.JPGBytes := @Buffer[0]; - GetIO.Read(Handle, @Buffer[0], InputLen); - Status := ijlRead(Props, IJL_JBUFF_READPARAMS); - end; - - if Status = IJL_OK then - begin - // Set image and DIB props based on Jpeg params read from input - case Props.JPGChannels of - 1: - begin - JpegFmt := ifGray8; - Props.DIBColor := IJL_G; - end; - 3: - begin - JpegFmt := ifR8G8B8; - Props.DIBColor := IJL_BGR; - end; - 4: - begin - JpegFmt := ifA8R8G8B8; - Props.DIBColor := IJL_RGBA_FPX; - end - else - Exit; - end; - - NewImage(Props.JPGWidth, Props.JPGHeight, JpegFmt, Images[0]); - - Props.DIBWidth := Props.JPGWidth; - Props.DIBHeight := Props.JPGHeight; - Props.DIBChannels := Props.JPGChannels; - Props.DIBPadBytes := 0; - Props.DIBBytes := Bits; - - // Now read the image bits - Status := ijlRead(Props, IJL_JBUFF_READWHOLEIMAGE); - end; - - if Status <> IJL_OK then - JpegError(Status); - - // Decoded images with alpha are in ABGR format so R and B chanels are switched - if JpegFmt = ifA8R8G8B8 then - SwapChannels(Images[0], ChannelRed, ChannelBlue); - - Result := True; - finally - ijlFree(Props); - end; -end; - -function TJpegFileFormatIJL.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - Props: TJpegCoreProperties; - Status: Integer; - Info: TImageFormatInfo; - ImageToSave: TImageData; - MustBeFreed: Boolean; - Buffer: TDynByteArray; -begin - Result := False; - // Makes image to save compatible with Jpeg saving capabilities - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with ImageToSave do - try - Status := ijlInit(Props); - if Status = IJL_OK then - begin - Info := GetFormatInfo(Format); - // Set all the needed props - Props.DIBWidth := Width; - Props.DIBHeight := Height; - Props.DIBChannels := Info.ChannelCount; - Props.DIBPadBytes := 0; - Props.DIBBytes := Bits; - - Props.Quality := FQuality; - - Props.JPGWidth := Width; - Props.JPGHeight := Height; - Props.JPGChannels := Info.ChannelCount; - SetLength(Buffer, Size); - Props.JPGSizeBytes := Size; - Props.JPGBytes := @Buffer[0]; - - case Info.ChannelCount of - 1: - begin - Props.DIBColor := IJL_G; - Props.JPGColor := IJL_G; - Props.JPGSubsampling := IJL_NOSUBSAMP; - end; - 3: - begin - Props.DIBColor := IJL_BGR; - Props.JPGColor := IJL_YCBCR; - Props.JPGSubsampling := IJL_411; - end; - 4: - begin - Props.DIBColor := IJL_RGBA_FPX; - Props.JPGColor := IJL_YCBCRA_FPX; - Props.JPGSubsampling := IJL_4114; - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); // IJL expects ABGR order - end; - end; - - // Encode image - Status := ijlWrite(Props, IJL_JBUFF_WRITEWHOLEIMAGE); - end; - - if Status <> IJL_OK then - JpegError(Status); - - // Write temp buffer to file - GetIO.Write(Handle, @Buffer[0], Props.JPGSizeBytes); - - Result := True; - finally - ijlFree(Props); - if MustBeFreed then - FreeImage(ImageToSave) - else if Format = ifA8R8G8B8 then - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); // Swap image back to ARGB if not temp - end; -end; - -initialization - RegisterImageFileFormat(TJpegFileFormatIJL); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Initial version created. -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingOpenGL.pas b/components/vampireimaging/Extras/Extensions/ImagingOpenGL.pas deleted file mode 100644 index dda150d..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingOpenGL.pas +++ /dev/null @@ -1,964 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains functions for loading and saving OpenGL textures - using Imaging and for converting images to textures and vice versa.} -unit ImagingOpenGL; - -{$I ImagingOptions.inc} - -{ Define this symbol if you want to use dglOpenGL header.} -{$DEFINE OPENGL_USE_DGL_HEADERS} -{ $DEFINE OPENGL_USE_GLSCENE_HEADERS} - -{$IFDEF OPENGL_NO_EXT_HEADERS} - {$UNDEF OPENGL_USE_DGL_HEADERS} - {$UNDEF OPENGL_USE_GLSCENE_HEADERS} -{$ENDIF} - -interface - -uses - SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats, -{$IF Defined(OPENGL_USE_DGL_HEADERS)} - dglOpenGL, -{$ELSEIF Defined(OPENGL_USE_GLSCENE_HEADERS)} - OpenGL1x, -{$ELSE} - gl, glext, -{$IFEND} - ImagingUtility; - -type - { Various texture capabilities of installed OpenGL driver.} - TGLTextureCaps = record - MaxTextureSize: LongInt; // Max size of texture in pixels supported by HW - NonPowerOfTwo: Boolean; // HW has full support for NPOT textures - DXTCompression: Boolean; // HW supports S3TC/DXTC compressed textures - ATI3DcCompression: Boolean; // HW supports ATI 3Dc compressed textures (ATI2N) - LATCCompression: Boolean; // HW supports LATC/RGTC compressed textures (ATI1N+ATI2N) - FloatTextures: Boolean; // HW supports floating point textures - MaxAnisotropy: LongInt; // Max anisotropy for aniso texture filtering - MaxSimultaneousTextures: LongInt; // Number of texture units - ClampToEdge: Boolean; // GL_EXT_texture_edge_clamp - TextureLOD: Boolean; // GL_SGIS_texture_lod - VertexTextureUnits: Integer; // Texture units accessible in vertex programs - end; - -{ Returns texture capabilities of installed OpenGL driver.} -function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean; -{ Function which can be used to retrieve GL extension functions.} -function GetGLProcAddress(const ProcName: string): Pointer; -{ Returns True if the given GL extension is supported.} -function IsGLExtensionSupported(const Extension: string): Boolean; -{ Returns True if the given image format can be represented as GL texture - format. GLFormat, GLType, and GLInternal are parameters for functions like - glTexImage. Note that GLU functions like gluBuildMipmaps cannot handle some - formats returned by this function (i.e. GL_UNSIGNED_SHORT_5_5_5_1 as GLType). - If you are using compressed or floating-point images make sure that they are - supported by hardware using GetGLTextureCaps, ImageFormatToGL does not - check this.} -function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum; - var GLType: GLenum; var GLInternal: GLint; const Caps: TGLTextureCaps): Boolean; - -{ All GL textures created by Imaging functions have default parameters set - - that means that no glTexParameter calls are made so default filtering, - wrapping, and other parameters are used. Created textures - are left bound by glBindTexture when function is exited.} - -{ Creates GL texture from image in file in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadGLTextureFromFile(const FileName: string; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): GLuint; -{ Creates GL texture from image in stream in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadGLTextureFromStream(Stream: TStream; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): GLuint; -{ Creates GL texture from image in memory in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; - -{ Converts TImageData structure to OpenGL texture. - Input images is used as main mipmap level and additional requested - levels are generated from this one. For the details on parameters - look at CreateGLTextureFromMultiImage function.} -function CreateGLTextureFromImage(const Image: TImageData; - Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True; - OverrideFormat: TImageFormat = ifUnknown; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): GLuint; -{ Converts images in TDymImageDataArray to one OpenGL texture. - Image at index MainLevelIndex in the array is used as main mipmap level and - additional images are used as subsequent levels. If there is not enough images - in array missing levels are automatically generated (and if there is enough images - but they have wrong dimensions or format then they are resized/converted). - If driver supports only power of two sized textures images are resized. - OverrideFormat can be used to convert image into specific format before - it is passed to OpenGL, ifUnknown means no conversion. - If desired texture format is not supported by hardware default - A8R8G8B8 format is used instead for color images and ifGray8 is used - for luminance images. DXTC (S3TC) compressed and floating point textures - are created if supported by hardware. - Width and Height can be used to set size of main mipmap level according - to your needs, Width and Height of 0 mean use width and height of input - image that will become main level mipmap. - MipMaps set to True mean build all possible levels, False means use only level 0. - You can use CreatedWidth and CreatedHeight parameters to query dimensions of - created texture's largest mipmap level (it could differ from dimensions - of source image).} -function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray; - Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True; - MainLevelIndex: LongInt = 0; OverrideFormat: TImageFormat = ifUnknown; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; - -{ Saves GL texture to file in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean; -{ Saves GL texture to stream in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean; -{ Saves GL texture to memory in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean; - -{ Converts main level of the GL texture to TImageData strucrue. OverrideFormat - can be used to convert output image to the specified format rather - than use the format taken from GL texture, ifUnknown means no conversion.} -function CreateImageFromGLTexture(const Texture: GLuint; - var Image: TImageData; OverrideFormat: TImageFormat = ifUnknown): Boolean; -{ Converts GL texture to TDynImageDataArray array of images. You can specify - how many mipmap levels of the input texture you want to be converted - (default is all levels). OverrideFormat can be used to convert output images to - the specified format rather than use the format taken from GL texture, - ifUnknown means no conversion.} -function CreateMultiImageFromGLTexture(const Texture: GLuint; - var Images: TDynImageDataArray; MipLevels: LongInt = 0; - OverrideFormat: TImageFormat = ifUnknown): Boolean; - -var - { Standard behaviour of image->texture functions like CreateGLTextureFrom(Multi)Image is: - If graphic card supports non power of 2 textures and image is nonpow2 then - texture is created directly from image. - If graphic card does not support them input image is rescaled (bilinear) - to power of 2 size. - If you set PasteNonPow2ImagesIntoPow2 to True then instead of rescaling, a new - pow2 texture is created and nonpow2 input image is pasted into it - keeping its original size. This could be useful for some 2D stuff - (and its faster than rescaling of course). Note that this is applied - to all rescaling smaller->bigger operations that might ocurr during - image->texture process (usually only pow2/nonpow2 stuff and when you - set custom Width & Height in CreateGLTextureFrom(Multi)Image).} - PasteNonPow2ImagesIntoPow2: Boolean = False; - { Standard behaviur if GL_ARB_texture_non_power_of_two extension is not supported - is to rescale image to power of 2 dimensions. NPOT extension is exposed only - when HW has full support for NPOT textures but some cards - (pre-DX10 ATI Radeons, some other maybe) have partial NPOT support. - Namely Radeons can use NPOT textures but not mipmapped. If you know what you are doing - you can disable NPOT support check so the image won't be rescaled to POT - by seting DisableNPOTSupportCheck to True.} - DisableNPOTSupportCheck: Boolean = False; - -implementation - -const - // Cube map consts - GL_TEXTURE_BINDING_CUBE_MAP = $8514; - GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515; - GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516; - GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518; - GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A; - - // Texture formats - GL_COLOR_INDEX = $1900; - GL_STENCIL_INDEX = $1901; - GL_DEPTH_COMPONENT = $1902; - GL_RED = $1903; - GL_GREEN = $1904; - GL_BLUE = $1905; - GL_ALPHA = $1906; - GL_RGB = $1907; - GL_RGBA = $1908; - GL_LUMINANCE = $1909; - GL_LUMINANCE_ALPHA = $190A; - GL_BGR_EXT = $80E0; - GL_BGRA_EXT = $80E1; - - // Texture internal formats - GL_ALPHA4 = $803B; - GL_ALPHA8 = $803C; - GL_ALPHA12 = $803D; - GL_ALPHA16 = $803E; - GL_LUMINANCE4 = $803F; - GL_LUMINANCE8 = $8040; - GL_LUMINANCE12 = $8041; - GL_LUMINANCE16 = $8042; - GL_LUMINANCE4_ALPHA4 = $8043; - GL_LUMINANCE6_ALPHA2 = $8044; - GL_LUMINANCE8_ALPHA8 = $8045; - GL_LUMINANCE12_ALPHA4 = $8046; - GL_LUMINANCE12_ALPHA12 = $8047; - GL_LUMINANCE16_ALPHA16 = $8048; - GL_INTENSITY = $8049; - GL_INTENSITY4 = $804A; - GL_INTENSITY8 = $804B; - GL_INTENSITY12 = $804C; - GL_INTENSITY16 = $804D; - GL_R3_G3_B2 = $2A10; - GL_RGB4 = $804F; - GL_RGB5 = $8050; - GL_RGB8 = $8051; - GL_RGB10 = $8052; - GL_RGB12 = $8053; - GL_RGB16 = $8054; - GL_RGBA2 = $8055; - GL_RGBA4 = $8056; - GL_RGB5_A1 = $8057; - GL_RGBA8 = $8058; - GL_RGB10_A2 = $8059; - GL_RGBA12 = $805A; - GL_RGBA16 = $805B; - GL_RGB565 = $8D62; - - // Floating point texture formats - GL_RGBA32F_ARB = $8814; - GL_INTENSITY32F_ARB = $8817; - GL_LUMINANCE32F_ARB = $8818; - GL_RGBA16F_ARB = $881A; - GL_INTENSITY16F_ARB = $881D; - GL_LUMINANCE16F_ARB = $881E; - - // Compressed texture formats - // S3TC/DXTC - GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0; - GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1; - GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2; - GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3; - // 3Dc LATC - GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI = $8837; - GL_COMPRESSED_LUMINANCE_LATC1_EXT = $8C70; - GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT = $8C71; - GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT = $8C72; - GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT = $8C73; - // ETC1 GL_OES_compressed_ETC1_RGB8_texture - GL_ETC1_RGB_OES = $8D64; - // PVRTC GL_IMG_texture_compression_pvrtc - GL_COMPRESSED_RGB_PVRTC_4BPPV1_IMG = $8C00; - GL_COMPRESSED_RGB_PVRTC_2BPPV1_IMG = $8C01; - GL_COMPRESSED_RGBA_PVRTC_4BPPV1_IMG = $8C02; - GL_COMPRESSED_RGBA_PVRTC_2BPPV1_IMG = $8C03; - // AMD ATC - GL_ATC_RGBA_EXPLICIT_ALPHA_AMD = $8C93; - GL_ATC_RGBA_INTERPOLATED_ALPHA_AMD = $87EE; - // ETC2/EAC - GL_COMPRESSED_R11_EAC = $9270; - GL_COMPRESSED_SIGNED_R11_EAC = $9271; - GL_COMPRESSED_RG11_EAC = $9272; - GL_COMPRESSED_SIGNED_RG11_EAC = $9273; - GL_COMPRESSED_RGB8_ETC2 = $9274; - GL_COMPRESSED_SRGB8_ETC2 = $9275; - GL_COMPRESSED_RGB8_PUNCHTHROUGH_ALPHA1_ETC2 = $9276; - GL_COMPRESSED_SRGB8_PUNCHTHROUGH_ALPHA1_ETC2 = $9277; - GL_COMPRESSED_RGBA8_ETC2_EAC = $9278; - GL_COMPRESSED_SRGB8_ALPHA8_ETC2_EAC = $9279; - - // Various GL extension constants - GL_MAX_TEXTURE_UNITS = $84E2; - GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; - GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; - - // Texture source data formats - GL_UNSIGNED_BYTE_3_3_2 = $8032; - GL_UNSIGNED_SHORT_4_4_4_4 = $8033; - GL_UNSIGNED_SHORT_5_5_5_1 = $8034; - GL_UNSIGNED_INT_8_8_8_8 = $8035; - GL_UNSIGNED_INT_10_10_10_2 = $8036; - GL_UNSIGNED_BYTE_2_3_3_REV = $8362; - GL_UNSIGNED_SHORT_5_6_5 = $8363; - GL_UNSIGNED_SHORT_5_6_5_REV = $8364; - GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365; - GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366; - GL_UNSIGNED_INT_8_8_8_8_REV = $8367; - GL_UNSIGNED_INT_2_10_10_10_REV = $8368; - GL_HALF_FLOAT_ARB = $140B; - - // Other GL constants - GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C; - - -{$IFDEF MSWINDOWS} - GLLibName = 'opengl32.dll'; -{$ENDIF} -{$IFDEF UNIX} - GLLibName = 'libGL.so'; -{$ENDIF} - -type - TglCompressedTexImage2D = procedure (Target: GLenum; Level: GLint; - InternalFormat: GLenum; Width: GLsizei; Height: GLsizei; Border: GLint; - ImageSize: GLsizei; const Data: PGLvoid); - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -var - glCompressedTexImage2D: TglCompressedTexImage2D = nil; - ExtensionBuffer: string = ''; - -{$IFDEF MSWINDOWS} -function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external GLLibName; -{$ENDIF} -{$IFDEF UNIX} -function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external GLLibName; -{$ENDIF} - -function IsGLExtensionSupported(const Extension: string): Boolean; -var - ExtPos: LongInt; -begin - if ExtensionBuffer = '' then - ExtensionBuffer := glGetString(GL_EXTENSIONS); - - ExtPos := Pos(Extension, ExtensionBuffer); - Result := ExtPos > 0; - if Result then - begin - Result := ((ExtPos + Length(Extension) - 1) = Length(ExtensionBuffer)) or - not (ExtensionBuffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']); - end; -end; - -function GetGLProcAddress(const ProcName: string): Pointer; -begin -{$IFDEF MSWINDOWS} - Result := wglGetProcAddress(PAnsiChar(AnsiString(ProcName))); -{$ENDIF} -{$IFDEF UNIX} - Result := glXGetProcAddress(PAnsiChar(AnsiString(ProcName))); -{$ENDIF} -end; - -function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean; -begin - // Check DXTC support and load extension functions if necesary - Caps.DXTCompression := IsGLExtensionSupported('GL_ARB_texture_compression') and - IsGLExtensionSupported('GL_EXT_texture_compression_s3tc'); - if Caps.DXTCompression then - glCompressedTexImage2D := GetGLProcAddress('glCompressedTexImage2D'); - Caps.DXTCompression := Caps.DXTCompression and (@glCompressedTexImage2D <> nil); - Caps.ATI3DcCompression := Caps.DXTCompression and - IsGLExtensionSupported('GL_ATI_texture_compression_3dc'); - Caps.LATCCompression := Caps.DXTCompression and - IsGLExtensionSupported('GL_EXT_texture_compression_latc'); - // Check non power of 2 textures - Caps.NonPowerOfTwo := IsGLExtensionSupported('GL_ARB_texture_non_power_of_two'); - // Check for floating point textures support - Caps.FloatTextures := IsGLExtensionSupported('GL_ARB_texture_float'); - // Get max texture size - glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize); - // Get max anisotropy - if IsGLExtensionSupported('GL_EXT_texture_filter_anisotropic') then - glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @Caps.MaxAnisotropy) - else - Caps.MaxAnisotropy := 0; - // Get number of texture units - if IsGLExtensionSupported('GL_ARB_multitexture') then - glGetIntegerv(GL_MAX_TEXTURE_UNITS, @Caps.MaxSimultaneousTextures) - else - Caps.MaxSimultaneousTextures := 1; - // Get number of vertex texture units - if IsGLExtensionSupported('GL_ARB_vertex_shader') then - glGetIntegerv(GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS, @Caps.VertexTextureUnits) - else - Caps.VertexTextureUnits := 1; - // Get max texture size - glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize); - // Clamp texture to edge? - Caps.ClampToEdge := IsGLExtensionSupported('GL_EXT_texture_edge_clamp'); - // Texture LOD extension? - Caps.TextureLOD := IsGLExtensionSupported('GL_SGIS_texture_lod'); - - Result := True; -end; - -function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum; - var GLType: GLenum; var GLInternal: GLint; const Caps: TGLTextureCaps): Boolean; -begin - GLFormat := 0; - GLType := 0; - GLInternal := 0; - case Format of - // Gray formats - ifGray8, ifGray16: - begin - GLFormat := GL_LUMINANCE; - GLType := Iff(Format = ifGray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT); - GLInternal := Iff(Format = ifGray8, GL_LUMINANCE8, GL_LUMINANCE16); - end; - ifA8Gray8, ifA16Gray16: - begin - GLFormat := GL_LUMINANCE_ALPHA; - GLType := Iff(Format = ifA8Gray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT); - GLInternal := Iff(Format = ifA8Gray8, GL_LUMINANCE8_ALPHA8, GL_LUMINANCE16_ALPHA16); - end; - // RGBA formats - ifR3G3B2: - begin - GLFormat := GL_RGB; - GLType := GL_UNSIGNED_BYTE_3_3_2; - GLInternal := GL_R3_G3_B2; - end; - ifR5G6B5: - begin - GLFormat := GL_RGB; - GLType := GL_UNSIGNED_SHORT_5_6_5; - GLInternal := GL_RGB5; //GL_RGB565 ot working on Radeons - end; - ifA1R5G5B5, ifX1R5G5B5: - begin - GLFormat := GL_BGRA_EXT; - GLType := GL_UNSIGNED_SHORT_1_5_5_5_REV; - GLInternal := Iff(Format = ifA1R5G5B5, GL_RGB5_A1, GL_RGB5); - end; - ifA4R4G4B4, ifX4R4G4B4: - begin - GLFormat := GL_BGRA_EXT; - GLType := GL_UNSIGNED_SHORT_4_4_4_4_REV; - GLInternal := Iff(Format = ifA4R4G4B4, GL_RGBA4, GL_RGB4); - end; - ifR8G8B8: - begin - GLFormat := GL_BGR_EXT; - GLType := GL_UNSIGNED_BYTE; - GLInternal := GL_RGB8; - end; - ifA8R8G8B8, ifX8R8G8B8: - begin - GLFormat := GL_BGRA_EXT; - GLType := GL_UNSIGNED_BYTE; - GLInternal := Iff(Format = ifA8R8G8B8, GL_RGBA8, GL_RGB8); - end; - ifR16G16B16, ifB16G16R16: - begin - GLFormat := Iff(Format = ifR16G16B16, GL_BGR_EXT, GL_RGB); - GLType := GL_UNSIGNED_SHORT; - GLInternal := GL_RGB16; - end; - ifA16R16G16B16, ifA16B16G16R16: - begin - GLFormat := Iff(Format = ifA16R16G16B16, GL_BGRA_EXT, GL_RGBA); - GLType := GL_UNSIGNED_SHORT; - GLInternal := GL_RGBA16; - end; - // Floating-Point formats - ifR32F: - begin - GLFormat := GL_RED; - GLType := GL_FLOAT; - GLInternal := GL_LUMINANCE32F_ARB; - end; - ifA32R32G32B32F, ifA32B32G32R32F: - begin - GLFormat := Iff(Format = ifA32R32G32B32F, GL_BGRA_EXT, GL_RGBA); - GLType := GL_FLOAT; - GLInternal := GL_RGBA32F_ARB; - end; - ifR16F: - begin - GLFormat := GL_RED; - GLType := GL_HALF_FLOAT_ARB; - GLInternal := GL_LUMINANCE16F_ARB; - end; - ifA16R16G16B16F, ifA16B16G16R16F: - begin - GLFormat := Iff(Format = ifA16R16G16B16F, GL_BGRA_EXT, GL_RGBA); - GLType := GL_HALF_FLOAT_ARB; - GLInternal := GL_RGBA16F_ARB; - end; - // Special formats - ifDXT1: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; - ifDXT3: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; - ifDXT5: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; - ifATI1N: GLInternal := GL_COMPRESSED_LUMINANCE_LATC1_EXT; - ifATI2N: - begin - GLInternal := GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; - if not Caps.LATCCompression and Caps.ATI3DcCompression then - GLInternal := GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; - end; - end; - Result := GLInternal <> 0; -end; - -function LoadGLTextureFromFile(const FileName: string; CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromFile(FileName, Images) and (Length(Images) > 0) then - begin - Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, - Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); - end - else - Result := 0; - FreeImagesInArray(Images); -end; - -function LoadGLTextureFromStream(Stream: TStream; CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromStream(Stream, Images) and (Length(Images) > 0) then - begin - Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, - Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); - end - else - Result := 0; - FreeImagesInArray(Images); -end; - -function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromMemory(Data, Size, Images) and (Length(Images) > 0) then - begin - Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, - Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); - end - else - Result := 0; - FreeImagesInArray(Images); -end; - -function CreateGLTextureFromImage(const Image: TImageData; - Width, Height: LongInt; MipMaps: Boolean; OverrideFormat: TImageFormat; - CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - SetLength(Arr, 1); - Arr[0] := Image; - Result := CreateGLTextureFromMultiImage(Arr, Width, Height, MipMaps, 0, - OverrideFormat, CreatedWidth, CreatedHeight); -end; - -function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray; - Width, Height: LongInt; MipMaps: Boolean; MainLevelIndex: LongInt; OverrideFormat: TImageFormat; - CreatedWidth, CreatedHeight: PLongInt): GLuint; -const - BlockCompressedFormats: TImageFormats = [ifDXT1, ifDXT3, ifDXT5, ifATI1N, ifATI2N]; -var - I, MipLevels, PossibleLevels, ExistingLevels, CurrentWidth, CurrentHeight: LongInt; - Caps: TGLTextureCaps; - GLFormat: GLenum; - GLType: GLenum; - GLInternal: GLint; - Desired, ConvTo: TImageFormat; - Info: TImageFormatInfo; - LevelsArray: TDynImageDataArray; - NeedsResize, NeedsConvert: Boolean; - UnpackAlignment, UnpackSkipRows, UnpackSkipPixels, UnpackRowLength: LongInt; - - procedure PasteImage(var Image: TImageData; Width, Height: LongInt); - var - Clone: TImageData; - begin - CloneImage(Image, Clone); - NewImage(Width, Height, Clone.Format, Image); - FillRect(Image, 0, 0, Width, Height, Clone.Bits); - CopyRect(Clone, 0, 0, Clone.Width, Clone.Height, Image, 0, 0); - FreeImage(Clone); - end; - -begin - Result := 0; - ExistingLevels := Length(Images); - - if GetGLTextureCaps(Caps) and (ExistingLevels > 0) then - try - // Check if requested main level is at valid index - if (MainLevelIndex < 0) or (MainLevelIndex > High(Images)) then - MainLevelIndex := 0; - - // First check desired size and modify it if necessary - if Width <= 0 then Width := Images[MainLevelIndex].Width; - if Height <= 0 then Height := Images[MainLevelIndex].Height; - if not Caps.NonPowerOfTwo and not DisableNPOTSupportCheck then - begin - // If device supports only power of 2 texture sizes - Width := NextPow2(Width); - Height := NextPow2(Height); - end; - Width := ClampInt(Width, 1, Caps.MaxTextureSize); - Height := ClampInt(Height, 1, Caps.MaxTextureSize); - - // Get various mipmap level counts and modify - // desired MipLevels if its value is invalid - PossibleLevels := GetNumMipMapLevels(Width, Height); - if MipMaps then - MipLevels := PossibleLevels - else - MipLevels := 1; - - // Prepare array for mipmap levels. Make it larger than necessary - that - // way we can use the same index for input images and levels in the large loop below - SetLength(LevelsArray, MipLevels + MainLevelIndex); - - // Now determine which image format will be used - if OverrideFormat = ifUnknown then - Desired := Images[MainLevelIndex].Format - else - Desired := OverrideFormat; - - // Check if the hardware supports floating point and compressed textures - GetImageFormatInfo(Desired, Info); - if Info.IsFloatingPoint and not Caps.FloatTextures then - Desired := ifA8R8G8B8; - if (Desired in [ifDXT1, ifDXT3, ifDXT5]) and not Caps.DXTCompression then - Desired := ifA8R8G8B8; - if (Desired = ifATI1N) and not Caps.LATCCompression then - Desired := ifGray8; - if (Desired = ifATI2N) and not (Caps.ATI3DcCompression or Caps.LATCCompression) then - Desired := ifA8Gray8; - - // Try to find GL format equivalent to image format and if it is not - // found use one of default formats - if not ImageFormatToGL(Desired, GLFormat, GLType, GLInternal, Caps) then - begin - GetImageFormatInfo(Desired, Info); - if Info.HasGrayChannel then - ConvTo := ifGray8 - else - ConvTo := ifA8R8G8B8; - if not ImageFormatToGL(ConvTo, GLFormat, GLType, GLInternal, Caps) then - Exit; - end - else - ConvTo := Desired; - - CurrentWidth := Width; - CurrentHeight := Height; - // If user is interested in width and height of created texture lets - // give him that - if CreatedWidth <> nil then CreatedWidth^ := CurrentWidth; - if CreatedHeight <> nil then CreatedHeight^ := CurrentHeight; - - // Store old pixel unpacking settings - glGetIntegerv(GL_UNPACK_ALIGNMENT, @UnpackAlignment); - glGetIntegerv(GL_UNPACK_SKIP_ROWS, @UnpackSkipRows); - glGetIntegerv(GL_UNPACK_SKIP_PIXELS, @UnpackSkipPixels); - glGetIntegerv(GL_UNPACK_ROW_LENGTH, @UnpackRowLength); - // Set new pixel unpacking settings - glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - glPixelStorei(GL_UNPACK_SKIP_ROWS, 0); - glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0); - glPixelStorei(GL_UNPACK_ROW_LENGTH, 0); - - // Generate new texture, bind it and set - glGenTextures(1, @Result); - glBindTexture(GL_TEXTURE_2D, Result); - if Byte(glIsTexture(Result)) <> GL_TRUE then - Exit; - - for I := MainLevelIndex to MipLevels - 1 + MainLevelIndex do - begin - // Check if we can use input image array as a source for this mipmap level - if I < ExistingLevels then - begin - // Check if input image for this mipmap level has the right - // size and format - NeedsConvert := not (Images[I].Format = ConvTo); - if ConvTo in BlockCompressedFormats then - begin - // Input images in DXTC will have min dimensions of 4, but we need - // current Width and Height to be lesser (for glCompressedTexImage2D) - NeedsResize := not ((Images[I].Width = Max(4, CurrentWidth)) and - (Images[I].Height = Max(4, CurrentHeight))); - end - else - NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight)); - - if NeedsResize or NeedsConvert then - begin - // Input image must be resized or converted to different format - // to become valid mipmap level - CloneImage(Images[I], LevelsArray[I]); - if NeedsConvert then - ConvertImage(LevelsArray[I], ConvTo); - if NeedsResize then - begin - if (not PasteNonPow2ImagesIntoPow2) or (LevelsArray[I].Width > CurrentWidth) or - (LevelsArray[I].Height > CurrentHeight)then - begin - // If pasteNP2toP2 is disabled or if source is bigger than target - // we rescale image, otherwise we paste it with the same size - ResizeImage(LevelsArray[I], CurrentWidth, CurrentHeight, rfBilinear) - end - else - PasteImage(LevelsArray[I], CurrentWidth, CurrentHeight); - end; - end - else - // Input image can be used without any changes - LevelsArray[I] := Images[I]; - end - else - begin - // This mipmap level is not present in the input image array - // so we create a new level - FillMipMapLevel(LevelsArray[I - 1], CurrentWidth, CurrentHeight, LevelsArray[I]); - end; - - if ConvTo in BlockCompressedFormats then - begin - // Note: GL DXTC texture snaller than 4x4 must have width and height - // as expected for non-DXTC texture (like 1x1 - we cannot - // use LevelsArray[I].Width and LevelsArray[I].Height - they are - // at least 4 for DXTC images). But Bits and Size passed to - // glCompressedTexImage2D must contain regular 4x4 DXTC block. - glCompressedTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth, - CurrentHeight, 0, LevelsArray[I].Size, LevelsArray[I].Bits) - end - else - begin - glTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth, - CurrentHeight, 0, GLFormat, GLType, LevelsArray[I].Bits); - end; - - // Calculate width and height of the next mipmap level - CurrentWidth := ClampInt(CurrentWidth div 2, 1, CurrentWidth); - CurrentHeight := ClampInt(CurrentHeight div 2, 1, CurrentHeight); - end; - - // Restore old pixel unpacking settings - glPixelStorei(GL_UNPACK_ALIGNMENT, UnpackAlignment); - glPixelStorei(GL_UNPACK_SKIP_ROWS, UnpackSkipRows); - glPixelStorei(GL_UNPACK_SKIP_PIXELS, UnpackSkipPixels); - glPixelStorei(GL_UNPACK_ROW_LENGTH, UnpackRowLength); - finally - // Free local image copies - for I := 0 to Length(LevelsArray) - 1 do - begin - if ((I < ExistingLevels) and (LevelsArray[I].Bits <> Images[I].Bits)) or - (I >= ExistingLevels) then - FreeImage(LevelsArray[I]); - end; - end; -end; - -function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromGLTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByName(FileName); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToFile(FileName, Arr); - if IsDDS then - PopOptions; - end; - FreeImagesInArray(Arr); - end; -end; - -function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromGLTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToStream(Ext, Stream, Arr); - if IsDDS then - PopOptions; - end; - FreeImagesInArray(Arr); - end; -end; - -function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromGLTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToMemory(Ext, Data, Size, Arr); - if IsDDS then - PopOptions; - end; - FreeImagesInArray(Arr); - end; -end; - -function CreateImageFromGLTexture(const Texture: GLuint; - var Image: TImageData; OverrideFormat: TImageFormat): Boolean; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - FreeImage(Image); - SetLength(Arr, 1); - Result := CreateMultiImageFromGLTexture(Texture, Arr, 1, OverrideFormat); - Image := Arr[0]; -end; - -function CreateMultiImageFromGLTexture(const Texture: GLuint; - var Images: TDynImageDataArray; MipLevels: LongInt; OverrideFormat: TImageFormat): Boolean; -var - I, Width, Height, ExistingLevels: LongInt; -begin - FreeImagesInArray(Images); - SetLength(Images, 0); - Result := False; - if Byte(glIsTexture(Texture)) = GL_TRUE then - begin - // Check if desired mipmap level count is valid - glBindTexture(GL_TEXTURE_2D, Texture); - if MipLevels <= 0 then - begin - glGetTexLevelParameteriv(GL_TEXTURE_2D, 0, GL_TEXTURE_WIDTH, @Width); - glGetTexLevelParameteriv(GL_TEXTURE_2D, 0, GL_TEXTURE_HEIGHT, @Height); - MipLevels := GetNumMipMapLevels(Width, Height); - end; - SetLength(Images, MipLevels); - ExistingLevels := 0; - - for I := 0 to MipLevels - 1 do - begin - // Get the current level size - glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_WIDTH, @Width); - glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_HEIGHT, @Height); - // Break when the mipmap chain is broken - if (Width = 0) or (Height = 0) then - Break; - // Create new image and copy texture data - NewImage(Width, Height, ifA8R8G8B8, Images[I]); - glGetTexImage(GL_TEXTURE_2D, I, GL_BGRA_EXT, GL_UNSIGNED_BYTE, Images[I].Bits); - Inc(ExistingLevels); - end; - // Resize mipmap array if necessary - if MipLevels <> ExistingLevels then - SetLength(Images, ExistingLevels); - // Convert images to desired format if set - if OverrideFormat <> ifUnknown then - for I := 0 to Length(Images) - 1 do - ConvertImage(Images[I], OverrideFormat); - - Result := True; - end; -end; - -initialization - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - -- 0.77.1 --------------------------------------------------- - - Added some new compressed formats IDs - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Fixed GetGLProcAddress in Unicode Delphi. Compressed - textures didn't work because of this. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Added support for GLScene's OpenGL header. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Added 3Dc compressed texture formats support. - - Added detection of 3Dc formats to texture caps. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Added DisableNPOTSupportCheck option and related functionality. - - Added some new texture caps detection. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Added PasteNonPow2ImagesIntoPow2 option and related functionality. - - Better NeedsResize determination for small DXTC textures - - avoids needless resizing. - - Added MainLevelIndex to CreateMultiImageFromGLTexture. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added CreatedWidth and CreatedHeight parameters to most - LoadGLTextureFromXXX/CreateGLTextureFromXXX functions. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - fixed bug in CreateGLTextureFromMultiImage which caused assert failure - when creating mipmaps (using FillMipMapLevel) for DXTC formats - - changed single channel floating point texture formats from - GL_INTENSITY..._ARB to GL_LUMINANCE..._ARB - - added support for half float texture formats (GL_RGBA16F_ARB etc.) - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - filtered mipmap creation - - more texture caps added - - fixed memory leaks in SaveGLTextureTo... functions - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - unit created and initial stuff added -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingPcx.pas b/components/vampireimaging/Extras/Extensions/ImagingPcx.pas deleted file mode 100644 index dca1eac..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingPcx.pas +++ /dev/null @@ -1,375 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader for ZSoft Paintbrush images known as PCX.} -unit ImagingPcx; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingFormats, ImagingUtility, ImagingIO; - -type - { Class for loading ZSoft Paintbrush images known as PCX. It is old - format which can store 1bit, 2bit, 4bit, 8bit, and 24bit (and 32bit but is - probably non-standard) images. Only loading is supported (you can still come - accross some PCX files) but saving is not (I don't wont this venerable format - to spread).} - TPCXFileFormat = class(TImageFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SPCXFormatName = 'ZSoft Paintbrush Image'; - SPCXMasks = '*.pcx'; - -type - TPCXHeader = packed record - Id: Byte; // Always $0A - Version: Byte; // 0, 2, 3, 4, 5 - Encoding: Byte; // 0, 1 - BitsPerPixel: Byte; // 1, 2, 4, 8 - X0, Y0: Word; // Image window top-left - X1, Y1: Word; // Image window bottom-right - DpiX: Word; - DpiY: Word; - Palette16: array [0..15] of TColor24Rec; - Reserved1: Byte; - Planes: Byte; // 1, 3, 4 - BytesPerLine: Word; - PaletteType: Word; // 1: color or s/w 2: grayscale - Reserved2: array [0..57] of Byte; - end; - -{ TPCXFileFormat } - -procedure TPCXFileFormat.Define; -begin - inherited; - FName := SPCXFormatName; - FFeatures := [ffLoad]; - - AddMasks(SPCXMasks); -end; - -function TPCXFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -const - ifMono: TImageFormat = TImageFormat(250); - ifIndex2: TImageFormat = TImageFormat(251); - ifIndex4: TImageFormat = TImageFormat(252); -var - Hdr: TPCXHeader; - PalID, B: Byte; - PalPCX: TPalette24Size256; - FileDataFormat: TImageFormat; - I, J, UncompSize, BytesPerLine, ByteNum, BitNum: LongInt; - UncompData, RowPointer, PixelIdx: PByte; - Pixel24: PColor24Rec; - Pixel32: PColor32Rec; - AlphaPlane, RedPlane, GreenPlane, BluePlane, - Plane1, Plane2, Plane3, Plane4: PByteArray; - - procedure RleDecode(Target: PByte; UnpackedSize: LongInt); - var - Count: LongInt; - Source: Byte; - begin - while UnpackedSize > 0 do - with GetIO do - begin - GetIO.Read(Handle, @Source, SizeOf(Source)); - if (Source and $C0) = $C0 then - begin - // RLE data - Count := Source and $3F; - if UnpackedSize < Count then - Count := UnpackedSize; - Read(Handle, @Source, SizeOf(Source)); - FillChar(Target^, Count, Source); - //Inc(Source); - Inc(Target, Count); - Dec(UnpackedSize, Count); - end - else - begin - // Uncompressed data - Target^ := Source; - Inc(Target); - Dec(UnpackedSize); - end; - end; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Read PCX header and store input position (start of image data) - Read(Handle, @Hdr, SizeOf(Hdr)); - FileDataFormat := ifUnknown; - - // Determine image's data format and find its Imaging equivalent - // (using some custom TImageFormat constants) - case Hdr.BitsPerPixel of - 1: - case Hdr.Planes of - 1: FileDataFormat := ifMono; - 4: FileDataFormat := ifIndex4; - end; - 2: FileDataFormat := ifIndex2; - 4: FileDataFormat := ifIndex4; - 8: - case Hdr.Planes of - 1: FileDataFormat := ifIndex8; - 3: FileDataFormat := ifR8G8B8; - 4: FileDataFormat := ifA8R8G8B8; - end; - end; - - // No compatible Imaging format found, exit - if FileDataFormat = ifUnknown then - Exit; - - // Get width, height, and output data format (unsupported formats - // like ifMono are converted later to ifIndex8) - Width := Hdr.X1 - Hdr.X0 + 1; - Height := Hdr.Y1 - Hdr.Y0 + 1; - if FileDataFormat in [ifIndex8, ifR8G8B8] then - Format := FileDataFormat - else - Format := ifIndex8; - - NewImage(Width, Height, Format, Images[0]); - - if not (FileDataFormat in [ifIndex8, ifR8G8B8]) then - begin - // other formats use palette embedded to file header - for I := Low(Hdr.Palette16) to High(Hdr.Palette16) do - begin - Palette[I].A := $FF; - Palette[I].R := Hdr.Palette16[I].B; - Palette[I].G := Hdr.Palette16[I].G; - Palette[I].B := Hdr.Palette16[I].R; - end; - end; - - // Now we determine various data sizes - BytesPerLine := Hdr.BytesPerLine * Hdr.Planes; - UncompSize := BytesPerLine * Height; - - GetMem(UncompData, UncompSize); - try - if Hdr.Encoding = 1 then - begin - // Image data is compressed -> read and decompress - RleDecode(UncompData, UncompSize); - end - else - begin - // Just read uncompressed data - Read(Handle, UncompData, UncompSize); - end; - - if FileDataFormat in [ifR8G8B8, ifA8R8G8B8] then - begin - // RGB and ARGB images are stored in layout different from - // Imaging's (and most other file formats'). First there is - // Width red values then there is Width green values and so on - RowPointer := UncompData; - - if FileDataFormat = ifA8R8G8B8 then - begin - Pixel32 := Bits; - for I := 0 to Height - 1 do - begin - AlphaPlane := PByteArray(RowPointer); - RedPlane := @AlphaPlane[Hdr.BytesPerLine]; - GreenPlane := @AlphaPlane[Hdr.BytesPerLine * 2]; - BluePlane := @AlphaPlane[Hdr.BytesPerLine * 3]; - for J := 0 to Width - 1 do - begin - Pixel32.A := AlphaPlane[J]; - Pixel32.R := RedPlane[J]; - Pixel32.G := GreenPlane[J]; - Pixel32.B := BluePlane[J]; - Inc(Pixel32); - end; - Inc(RowPointer, BytesPerLine); - end; - end - else - begin - Pixel24 := Bits; - for I := 0 to Height - 1 do - begin - RedPlane := PByteArray(RowPointer); - GreenPlane := @RedPlane[Hdr.BytesPerLine]; - BluePlane := @RedPlane[Hdr.BytesPerLine * 2]; - for J := 0 to Width - 1 do - begin - Pixel24.R := RedPlane[J]; - Pixel24.G := GreenPlane[J]; - Pixel24.B := BluePlane[J]; - Inc(Pixel24); - end; - Inc(RowPointer, BytesPerLine); - end; - end; - end - else if FileDataFormat = ifIndex8 then - begin - // Just copy 8bit lines - for I := 0 to Height - 1 do - Move(PByteArray(UncompData)[I * Hdr.BytesPerLine], PByteArray(Bits)[I * Width], Width); - end - else if FileDataFormat = ifMono then - begin - // Convert 1bit images to ifIndex8 - Convert1To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False); - end - else if FileDataFormat = ifIndex2 then - begin - // Convert 2bit images to ifIndex8. Note that 2bit PCX images - // usually use (from specs, I've never seen one myself) CGA palette - // which is not array of RGB tripplets. So 2bit PCXs are loaded but - // their colors would be wrong - Convert2To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False); - end - else if FileDataFormat = ifIndex4 then - begin - // 4bit images can be stored similar to RGB images (in four one bit planes) - // or like array of nibbles (which is more common) - if (Hdr.BitsPerPixel = 1) and (Hdr.Planes = 4) then - begin - RowPointer := UncompData; - PixelIdx := Bits; - for I := 0 to Height - 1 do - begin - Plane1 := PByteArray(RowPointer); - Plane2 := @Plane1[Hdr.BytesPerLine]; - Plane3 := @Plane1[Hdr.BytesPerLine * 2]; - Plane4 := @Plane1[Hdr.BytesPerLine * 3]; - - for J := 0 to Width - 1 do - begin - B := 0; - ByteNum := J div 8; - BitNum := 7 - (J mod 8); - if (Plane1[ByteNum] shr BitNum) and $1 <> 0 then B := B or $01; - if (Plane2[ByteNum] shr BitNum) and $1 <> 0 then B := B or $02; - if (Plane3[ByteNum] shr BitNum) and $1 <> 0 then B := B or $04; - if (Plane4[ByteNum] shr BitNum) and $1 <> 0 then B := B or $08; - PixelIdx^ := B; - Inc(PixelIdx); - end; - Inc(RowPointer, BytesPerLine); - end; - end - else if (Hdr.BitsPerPixel = 4) and (Hdr.Planes = 1) then - begin - // Convert 4bit images to ifIndex8 - Convert4To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False); - end - end; - - if FileDataFormat = ifIndex8 then - begin - // 8bit palette is appended at the end of the file - // with $0C identifier - //Seek(Handle, -769, smFromEnd); - Read(Handle, @PalID, SizeOf(PalID)); - if PalID = $0C then - begin - Read(Handle, @PalPCX, SizeOf(PalPCX)); - for I := Low(PalPCX) to High(PalPCX) do - begin - Palette[I].A := $FF; - Palette[I].R := PalPCX[I].B; - Palette[I].G := PalPCX[I].G; - Palette[I].B := PalPCX[I].R; - end; - end - else - Seek(Handle, -SizeOf(PalID), smFromCurrent); - end; - - finally - FreeMem(UncompData); - end; - Result := True; - end; -end; - -function TPCXFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TPCXHeader; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Hdr)) and - (Hdr.Id = $0A) and - (Hdr.Version in [0, 2, 3, 4, 5]) and - (Hdr.Encoding in [0..1]) and - (Hdr.BitsPerPixel in [1, 2, 4, 8]) and - (Hdr.Planes in [1, 3, 4]) and - (Hdr.PaletteType in [1..2]); - end; - -end; - -initialization - RegisterImageFileFormat(TPCXFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Made loader stream-safe - stream position is exactly at the end of the - image after loading and file size doesn't need to be know during the process. - - Initial TPCXFileFormat class implemented. - -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingPsd.pas b/components/vampireimaging/Extras/Extensions/ImagingPsd.pas deleted file mode 100644 index 6afa081..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingPsd.pas +++ /dev/null @@ -1,801 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Photoshop PSD image format.} -unit ImagingPsd; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingColors, ImagingUtility; - -type - { Class for loading and saving Adobe Photoshop PSD images. - Loading and saving of indexed, grayscale, RGB(A), HDR (FP32), and CMYK - (auto converted to RGB) images is supported. Non-HDR gray, RGB, - and CMYK images can have 8bit or 16bit color channels. - There is no support for loading mono images, duotone images are treated - like grayscale images, and multichannel and CIE Lab images are loaded as - RGB images but without actual conversion to RGB color space. - Also no layer information is loaded.} - TPSDFileFormat = class(TImageFileFormat) - private - FSaveAsLayer: LongBool; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - published - property SaveAsLayer: LongBool read FSaveAsLayer write FSaveAsLayer; - end; - -implementation - -uses - ImagingExtras; - -const - SPSDFormatName = 'Photoshop Image'; - SPSDMasks = '*.psd,*.pdd'; - PSDSupportedFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, - ifR8G8B8, ifA8R8G8B8, ifGray16, ifA16Gray16, ifR16G16B16, ifA16R16G16B16, - ifR32F, ifR32G32B32F, ifA32R32G32B32F]; - PSDDefaultSaveAsLayer = True; - -const - SPSDMagic = '8BPS'; - CompressionNone: Word = 0; - CompressionRLE: Word = 1; - -type - {$MINENUMSIZE 2} - { PSD Image color mode.} - TPSDColorMode = ( - cmMono = 0, - cmGrayscale = 1, - cmIndexed = 2, - cmRGB = 3, - cmCMYK = 4, - cmMultiChannel = 7, - cmDuoTone = 8, - cmLab = 9 - ); - - { PSD image main header.} - TPSDHeader = packed record - Signature: TChar4; // Format ID '8BPS' - Version: Word; // Always 1 - Reserved: array[0..5] of Byte; // Reserved, all zero - Channels: Word; // Number of color channels (1-24) including alpha channels - Rows : UInt32; // Height of image in pixels (1-30000) - Columns: UInt32; // Width of image in pixels (1-30000) - Depth: Word; // Number of bits per channel (1, 8, and 16) - Mode: TPSDColorMode; // Color mode - end; - - TPSDChannelInfo = packed record - ChannelID: Word; // 0 = Red, 1 = Green, 2 = Blue etc., -1 = Transparency mask, -2 = User mask - Size: UInt32; // Size of channel data. - end; - -procedure SwapHeader(var Header: TPSDHeader); -begin - Header.Version := SwapEndianWord(Header.Version); - Header.Channels := SwapEndianWord(Header.Channels); - Header.Depth := SwapEndianWord(Header.Depth); - Header.Rows := SwapEndianUInt32(Header.Rows); - Header.Columns := SwapEndianUInt32(Header.Columns); - Header.Mode := TPSDColorMode(SwapEndianWord(Word(Header.Mode))); -end; - -{ - TPSDFileFormat class implementation -} - -procedure TPSDFileFormat.Define; -begin - inherited; - FName := SPSDFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := PSDSupportedFormats; - AddMasks(SPSDMasks); - - FSaveAsLayer := PSDDefaultSaveAsLayer; - RegisterOption(ImagingPSDSaveAsLayer, @FSaveAsLayer); -end; - -function TPSDFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Header: TPSDHeader; - ByteCount: UInt32; - RawPal: array[0..767] of Byte; - Compression, PackedSize: Word; - LineSize, ChannelPixelSize, WidthBytes, - CurrChannel, MaxRLESize, I, Y, X: LongInt; - Info: TImageFormatInfo; - PackedLine, LineBuffer: PByte; - RLELineSizes: array of Word; - Col32: TColor32Rec; - Col64: TColor64Rec; - PCol32: PColor32Rec; - PCol64: PColor64Rec; - - { PackBits RLE decode code from Mike Lischke's GraphicEx library.} - procedure DecodeRLE(Source, Dest: PByte; PackedSize, UnpackedSize: LongInt); - var - Count: LongInt; - begin - while (UnpackedSize > 0) and (PackedSize > 0) do - begin - Count := ShortInt(Source^); - Inc(Source); - Dec(PackedSize); - if Count < 0 then - begin - // Replicate next byte -Count + 1 times - if Count = -128 then - Continue; - Count := -Count + 1; - if Count > UnpackedSize then - Count := UnpackedSize; - FillChar(Dest^, Count, Source^); - Inc(Source); - Dec(PackedSize); - Inc(Dest, Count); - Dec(UnpackedSize, Count); - end - else - begin - // Copy next Count + 1 bytes from input - Inc(Count); - if Count > UnpackedSize then - Count := UnpackedSize; - if Count > PackedSize then - Count := PackedSize; - Move(Source^, Dest^, Count); - Inc(Dest, Count); - Inc(Source, Count); - Dec(PackedSize, Count); - Dec(UnpackedSize, Count); - end; - end; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Read PSD header - Read(Handle, @Header, SizeOf(Header)); - SwapHeader(Header); - - // Determine image data format - Format := ifUnknown; - case Header.Mode of - cmGrayscale, cmDuoTone: - begin - if Header.Depth in [8, 16] then - begin - if Header.Channels = 1 then - Format := IffFormat(Header.Depth = 8, ifGray8, ifGray16) - else if Header.Channels >= 2 then - Format := IffFormat(Header.Depth = 8, ifA8Gray8, ifA16Gray16); - end - else if (Header.Depth = 32) and (Header.Channels = 1) then - Format := ifR32F; - end; - cmIndexed: - begin - if Header.Depth = 8 then - Format := ifIndex8; - end; - cmRGB, cmMultiChannel, cmCMYK, cmLab: - begin - if Header.Depth in [8, 16] then - begin - if Header.Channels = 3 then - Format := IffFormat(Header.Depth = 8, ifR8G8B8, ifR16G16B16) - else if Header.Channels >= 4 then - Format := IffFormat(Header.Depth = 8, ifA8R8G8B8, ifA16R16G16B16); - end - else if Header.Depth = 32 then - begin - if Header.Channels = 3 then - Format := ifR32G32B32F - else if Header.Channels >= 4 then - Format := ifA32R32G32B32F; - end; - end; - cmMono:; // Not supported - end; - - // Exit if no compatible format was found - if Format = ifUnknown then - Exit; - - NewImage(Header.Columns, Header.Rows, Format, Images[0]); - Info := GetFormatInfo(Format); - - // Read or skip Color Mode Data Block (palette) - Read(Handle, @ByteCount, SizeOf(ByteCount)); - ByteCount := SwapEndianUInt32(ByteCount); - if Format = ifIndex8 then - begin - // Read palette only for indexed images - Read(Handle, @RawPal, SizeOf(RawPal)); - for I := 0 to 255 do - begin - Palette[I].A := $FF; - Palette[I].R := RawPal[I + 0]; - Palette[I].G := RawPal[I + 256]; - Palette[I].B := RawPal[I + 512]; - end; - end - else - Seek(Handle, ByteCount, smFromCurrent); - - // Skip Image Resources Block - Read(Handle, @ByteCount, SizeOf(ByteCount)); - ByteCount := SwapEndianUInt32(ByteCount); - Seek(Handle, ByteCount, smFromCurrent); - // Now there is Layer and Mask Information Block - Read(Handle, @ByteCount, SizeOf(ByteCount)); - ByteCount := SwapEndianUInt32(ByteCount); - // Skip Layer and Mask Information Block - Seek(Handle, ByteCount, smFromCurrent); - - // Read compression flag - Read(Handle, @Compression, SizeOf(Compression)); - Compression := SwapEndianWord(Compression); - - if Compression = CompressionRLE then - begin - // RLE compressed PSDs (most) have first lengths of compressed scanlines - // for each channel stored - SetLength(RLELineSizes, Height * Header.Channels); - Read(Handle, @RLELineSizes[0], Length(RLELineSizes) * SizeOf(Word)); - SwapEndianWord(@RLELineSizes[0], Height * Header.Channels); - MaxRLESize := RLELineSizes[0]; - for I := 1 to High(RLELineSizes) do - begin - if MaxRLESize < RLELineSizes[I] then - MaxRLESize := RLELineSizes[I]; - end; - end - else - MaxRLESize := 0; - - ChannelPixelSize := Info.BytesPerPixel div Info.ChannelCount; - LineSize := Width * ChannelPixelSize; - WidthBytes := Width * Info.BytesPerPixel; - GetMem(LineBuffer, LineSize); - GetMem(PackedLine, MaxRLESize); - - try - // Image color chanels are stored separately in PSDs so we will load - // one by one and copy their data to appropriate addresses of dest image. - for I := 0 to Header.Channels - 1 do - begin - // Now determine to which color channel of destination image we are going - // to write pixels. - if I <= 4 then - begin - // If PSD has alpha channel we need to switch current channel order - - // PSDs have alpha stored after blue channel but Imaging has alpha - // before red. - if Info.HasAlphaChannel and (Header.Mode <> cmCMYK) then - begin - if I = Info.ChannelCount - 1 then - CurrChannel := I - else - CurrChannel := Info.ChannelCount - 2 - I; - end - else - CurrChannel := Info.ChannelCount - 1 - I; - end - else - begin - // No valid channel remains - CurrChannel := -1; - end; - - if CurrChannel >= 0 then - begin - for Y := 0 to Height - 1 do - begin - if Compression = CompressionRLE then - begin - // Read RLE line and decompress it - PackedSize := RLELineSizes[I * Height + Y]; - Read(Handle, PackedLine, PackedSize); - DecodeRLE(PackedLine, LineBuffer, PackedSize, LineSize); - end - else - begin - // Just read uncompressed line - Read(Handle, LineBuffer, LineSize); - end; - - // Swap endian if needed - if ChannelPixelSize = 4 then - SwapEndianUInt32(PUInt32(LineBuffer), Width) - else if ChannelPixelSize = 2 then - SwapEndianWord(PWordArray(LineBuffer), Width); - - if Info.ChannelCount > 1 then - begin - // Copy each pixel fragment to its right place in destination image - for X := 0 to Width - 1 do - begin - Move(PByteArray(LineBuffer)[X * ChannelPixelSize], - PByteArray(Bits)[Y * WidthBytes + X * Info.BytesPerPixel + CurrChannel * ChannelPixelSize], - ChannelPixelSize); - end; - end - else - begin - // Just copy the line - Move(LineBuffer^, PByteArray(Bits)[Y * LineSize], LineSize); - end; - end; - end - else - begin - // Skip current color channel, not needed for image loading - just to - // get stream's position to the end of PSD - if Compression = CompressionRLE then - begin - for Y := 0 to Height - 1 do - Seek(Handle, RLELineSizes[I * Height + Y], smFromCurrent); - end - else - Seek(Handle, LineSize * Height, smFromCurrent); - end; - end; - - if Header.Mode = cmCMYK then - begin - // Convert CMYK images to RGB (alpha is ignored here). PSD stores CMYK - // channels in the way that first requires substraction from max channel value - if ChannelPixelSize = 1 then - begin - PCol32 := Bits; - for X := 0 to Width * Height - 1 do - begin - Col32.A := 255 - PCol32.A; - Col32.R := 255 - PCol32.R; - Col32.G := 255 - PCol32.G; - Col32.B := 255 - PCol32.B; - CMYKToRGB(Col32.A, Col32.R, Col32.G, Col32.B, PCol32.R, PCol32.G, PCol32.B); - PCol32.A := 255; - Inc(PCol32); - end; - end - else - begin - PCol64 := Bits; - for X := 0 to Width * Height - 1 do - begin - Col64.A := 65535 - PCol64.A; - Col64.R := 65535 - PCol64.R; - Col64.G := 65535 - PCol64.G; - Col64.B := 65535 - PCol64.B; - CMYKToRGB16(Col64.A, Col64.R, Col64.G, Col64.B, PCol64.R, PCol64.G, PCol64.B); - PCol64.A := 65535; - Inc(PCol64); - end; - end; - end; - - Result := True; - finally - FreeMem(LineBuffer); - FreeMem(PackedLine); - end; - end; -end; - -function TPSDFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -type - TURect = packed record - Top, Left, Bottom, Right: UInt32; - end; -const - BlendMode: TChar8 = '8BIMnorm'; - LayerOptions: array[0..3] of Byte = (255, 0, 0, 0); - LayerName: array[0..7] of AnsiChar = #7'Layer 0'; -var - MustBeFreed: Boolean; - ImageToSave: TImageData; - Info: TImageFormatInfo; - Header: TPSDHeader; - I, CurrChannel, ChannelPixelSize: LongInt; - LayerBlockOffset, SaveOffset, ChannelInfoOffset: Integer; - ChannelInfo: TPSDChannelInfo; - R: TURect; - LongVal: UInt32; - WordVal, LayerCount: Word; - RawPal: array[0..767] of Byte; - ChannelDataSizes: array of Integer; - - function PackLine(Src, Dest: PByteArray; Length: Integer): Integer; - var - I, Remaining: Integer; - begin - Remaining := Length; - Result := 0; - while Remaining > 0 do - begin - I := 0; - // Look for characters same as the first - while (I < 128) and (Remaining - I > 0) and (Src[0] = Src[I]) do - Inc(I); - - if I > 2 then - begin - Dest[0] := Byte(-(I - 1)); - Dest[1] := Src[0]; - Dest := PByteArray(@Dest[2]); - - Src := PByteArray(@Src[I]); - Dec(Remaining, I); - Inc(Result, 2); - end - else - begin - // Look for different characters - I := 0; - while (I < 128) and (Remaining - (I + 1) > 0) and - ((Src[I] <> Src[I + 1]) or (Remaining - (I + 2) <= 0) or - (Src[I] <> Src[I + 2])) do - begin - Inc(I); - end; - // If there's only 1 remaining, the previous WHILE doesn't catch it - if Remaining = 1 then - I := 1; - - if I > 0 then - begin - // Some distinct ones found - Dest[0] := I - 1; - Move(Src[0], Dest[1], I); - Dest := PByteArray(@Dest[1 + I]); - Src := PByteArray(@Src[I]); - Dec(Remaining, I); - Inc(Result, I + 1); - end; - end; - end; - end; - - procedure WriteChannelData(SeparateChannelStorage: Boolean); - var - I, X, Y, LineSize, WidthBytes, RLETableOffset, CurrentOffset, WrittenLineSize: Integer; - LineBuffer, RLEBuffer: PByteArray; - RLELengths: array of Word; - Compression: Word; - begin - LineSize := ImageToSave.Width * ChannelPixelSize; - WidthBytes := ImageToSave.Width * Info.BytesPerPixel; - GetMem(LineBuffer, LineSize); - GetMem(RLEBuffer, LineSize * 3); - SetLength(RLELengths, ImageToSave.Height * Info.ChannelCount); - RLETableOffset := 0; - // No compression for FP32, Photoshop won't open them - Compression := Iff(Info.IsFloatingPoint, CompressionNone, CompressionRLE); - - if not SeparateChannelStorage then - begin - // This is for storing background merged image. There's only one - // compression flag and one RLE lenghts table for all channels - WordVal := Swap(Compression); - GetIO.Write(Handle, @WordVal, SizeOf(WordVal)); - if Compression = CompressionRLE then - begin - RLETableOffset := GetIO.Tell(Handle); - GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height * Info.ChannelCount); - end; - end; - - for I := 0 to Info.ChannelCount - 1 do - begin - if SeparateChannelStorage then - begin - // Layer image data has compression flag and RLE lenghts table - // independent for each channel - WordVal := Swap(CompressionRLE); - GetIO.Write(Handle, @WordVal, SizeOf(WordVal)); - if Compression = CompressionRLE then - begin - RLETableOffset := GetIO.Tell(Handle); - GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height); - ChannelDataSizes[I] := 0; - end; - end; - - // Now determine which color channel we are going to write to file. - if Info.HasAlphaChannel then - begin - if I = Info.ChannelCount - 1 then - CurrChannel := I - else - CurrChannel := Info.ChannelCount - 2 - I; - end - else - CurrChannel := Info.ChannelCount - 1 - I; - - for Y := 0 to ImageToSave.Height - 1 do - begin - if Info.ChannelCount > 1 then - begin - // Copy each pixel fragment to its right place in destination image - for X := 0 to ImageToSave.Width - 1 do - begin - Move(PByteArray(ImageToSave.Bits)[Y * WidthBytes + X * Info.BytesPerPixel + CurrChannel * ChannelPixelSize], - PByteArray(LineBuffer)[X * ChannelPixelSize], ChannelPixelSize); - end; - end - else - Move(PByteArray(ImageToSave.Bits)[Y * LineSize], LineBuffer^, LineSize); - - // Write current channel line to file (swap endian if needed first) - if ChannelPixelSize = 4 then - SwapEndianUInt32(PUInt32(LineBuffer), ImageToSave.Width) - else if ChannelPixelSize = 2 then - SwapEndianWord(PWordArray(LineBuffer), ImageToSave.Width); - - if Compression = CompressionRLE then - begin - // Compress and write line - WrittenLineSize := PackLine(LineBuffer, RLEBuffer, LineSize); - RLELengths[ImageToSave.Height * I + Y] := SwapEndianWord(WrittenLineSize); - GetIO.Write(Handle, RLEBuffer, WrittenLineSize); - end - else - begin - WrittenLineSize := LineSize; - GetIO.Write(Handle, LineBuffer, WrittenLineSize); - end; - - if SeparateChannelStorage then - Inc(ChannelDataSizes[I], WrittenLineSize); - end; - - if SeparateChannelStorage and (Compression = CompressionRLE) then - begin - // Update channel RLE lengths - CurrentOffset := GetIO.Tell(Handle); - GetIO.Seek(Handle, RLETableOffset, smFromBeginning); - GetIO.Write(Handle, @RLELengths[ImageToSave.Height * I], SizeOf(Word) * ImageToSave.Height); - GetIO.Seek(Handle, CurrentOffset, smFromBeginning); - Inc(ChannelDataSizes[I], SizeOf(Word) * ImageToSave.Height); - end; - end; - - if not SeparateChannelStorage and (Compression = CompressionRLE) then - begin - // Update channel RLE lengths - CurrentOffset := GetIO.Tell(Handle); - GetIO.Seek(Handle, RLETableOffset, smFromBeginning); - GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height * Info.ChannelCount); - GetIO.Seek(Handle, CurrentOffset, smFromBeginning); - end; - - FreeMem(LineBuffer); - FreeMem(RLEBuffer); - end; - -begin - Result := False; - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - Info := GetFormatInfo(Format); - ChannelPixelSize := Info.BytesPerPixel div Info.ChannelCount; - - // Fill header with proper info and save it - FillChar(Header, SizeOf(Header), 0); - Header.Signature := SPSDMagic; - Header.Version := 1; - Header.Channels := Info.ChannelCount; - Header.Rows := Height; - Header.Columns := Width; - Header.Depth := Info.BytesPerPixel div Info.ChannelCount * 8; - if Info.IsIndexed then - Header.Mode := cmIndexed - else if Info.HasGrayChannel or (Info.ChannelCount = 1) then - Header.Mode := cmGrayscale - else - Header.Mode := cmRGB; - - SwapHeader(Header); - Write(Handle, @Header, SizeOf(Header)); - - // Write palette size and data - LongVal := SwapEndianUInt32(IffUnsigned(Info.IsIndexed, SizeOf(RawPal), 0)); - Write(Handle, @LongVal, SizeOf(LongVal)); - if Info.IsIndexed then - begin - for I := 0 to Info.PaletteEntries - 1 do - begin - RawPal[I] := Palette[I].R; - RawPal[I + 256] := Palette[I].G; - RawPal[I + 512] := Palette[I].B; - end; - Write(Handle, @RawPal, SizeOf(RawPal)); - end; - - // Write empty resource and layer block sizes - LongVal := 0; - Write(Handle, @LongVal, SizeOf(LongVal)); - LayerBlockOffset := Tell(Handle); - Write(Handle, @LongVal, SizeOf(LongVal)); - - if FSaveAsLayer and (ChannelPixelSize < 4) then // No Layers for FP32 images - begin - LayerCount := SwapEndianWord(Iff(Info.HasAlphaChannel, Word(-1), 1)); // Must be -1 to get transparency in Photoshop - R.Top := 0; - R.Left := 0; - R.Bottom := SwapEndianUInt32(Height); - R.Right := SwapEndianUInt32(Width); - WordVal := SwapEndianWord(Info.ChannelCount); - Write(Handle, @LongVal, SizeOf(LongVal)); // Layer section size, empty now - Write(Handle, @LayerCount, SizeOf(LayerCount)); // Layer count - Write(Handle, @R, SizeOf(R)); // Bounds rect - Write(Handle, @WordVal, SizeOf(WordVal)); // Channel count - - ChannelInfoOffset := Tell(Handle); - SetLength(ChannelDataSizes, Info.ChannelCount); // Empty channel infos - FillChar(ChannelInfo, SizeOf(ChannelInfo), 0); - for I := 0 to Info.ChannelCount - 1 do - Write(Handle, @ChannelInfo, SizeOf(ChannelInfo)); - - Write(Handle, @BlendMode, SizeOf(BlendMode)); // Blend mode = normal - Write(Handle, @LayerOptions, SizeOf(LayerOptions)); // Predefined options - LongVal := SwapEndianUInt32(16); // Extra data size (4 (mask size) + 4 (ranges size) + 8 (name)) - Write(Handle, @LongVal, SizeOf(LongVal)); - LongVal := 0; - Write(Handle, @LongVal, SizeOf(LongVal)); // Mask size = 0 - LongVal := 0; - Write(Handle, @LongVal, SizeOf(LongVal)); // Blend ranges size - Write(Handle, @LayerName, SizeOf(LayerName)); // Layer name - - WriteChannelData(True); // Write Layer image data - - Write(Handle, @LongVal, SizeOf(LongVal)); // Global mask info size = 0 - - SaveOffset := Tell(Handle); - Seek(Handle, LayerBlockOffset, smFromBeginning); - - // Update layer and mask section sizes - LongVal := SwapEndianUInt32(SaveOffset - LayerBlockOffset - 4); - Write(Handle, @LongVal, SizeOf(LongVal)); - LongVal := SwapEndianUInt32(SaveOffset - LayerBlockOffset - 8); - Write(Handle, @LongVal, SizeOf(LongVal)); - - // Update layer channel info - Seek(Handle, ChannelInfoOffset, smFromBeginning); - for I := 0 to Info.ChannelCount - 1 do - begin - ChannelInfo.ChannelID := SwapEndianWord(I); - if (I = Info.ChannelCount - 1) and Info.HasAlphaChannel then - ChannelInfo.ChannelID := Swap(Word(-1)); - ChannelInfo.Size := SwapEndianUInt32(ChannelDataSizes[I] + 2); // datasize (incl RLE table) + comp. flag - Write(Handle, @ChannelInfo, SizeOf(ChannelInfo)); - end; - - Seek(Handle, SaveOffset, smFromBeginning); - end; - - // Write background merged image - WriteChannelData(False); - - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -procedure TPSDFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - begin - if Info.ChannelCount = 1 then - ConvFormat := ifR32F - else if Info.HasAlphaChannel then - ConvFormat := ifA32R32G32B32F - else - ConvFormat := ifR32G32B32F; - end - else if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16) - else if Info.RBSwapFormat in GetSupportedFormats then - ConvFormat := Info.RBSwapFormat - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(Image, ConvFormat); -end; - -function TPSDFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Header: TPSDHeader; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Header, SizeOf(Header)); - SwapHeader(Header); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Header)) and - (Header.Signature = SPSDMagic) and - (Header.Version = 1); - end; -end; - -initialization - RegisterImageFileFormat(TPSDFileFormat); - -{ - File Notes: - - -- 0.77.1 --------------------------------------------------- - - 3 channel RGB float images are loaded and saved directly - as ifR32G32B32F. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - PSDs are now saved with RLE compression. - - Mask layer saving added to SaveData for images with alpha - (shows proper transparency when opened in Photoshop). Can be - enabled/disabled using option - - Fixed memory leak in SaveData. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Saving implemented. - - Loading implemented. - - Unit created with initial stuff! -} - -end. - diff --git a/components/vampireimaging/Extras/Extensions/ImagingSdl.pas b/components/vampireimaging/Extras/Extensions/ImagingSdl.pas deleted file mode 100644 index 2975b58..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingSdl.pas +++ /dev/null @@ -1,393 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains functions for loading/saving SDL surfaces using Imaging - and for converting images to surfaces and vice versa.} -unit ImagingSDL; - -{$I ImagingOptions.inc} - -interface - -uses - Classes, sdl, ImagingTypes, Imaging, ImagingUtility; - -type - { This SDL type is redefined here so ImagingExport unit does not - need sdl unit in the uses list.} - PSDL_Surface = sdl.PSDL_Surface; - -{ LoadSDLSurfaceFromFile and similar functions use SDL_SWSURFACE as Flags when creating - SDL surface. If you want other Flags to be used load image by standard - LoadImageFromFile and similar functions and then call CreateSDLSurfaceFromImage - which has more options.} - -{ Creates SDL surface from image in file in format supported by Imaging.} -function LoadSDLSurfaceFromFile(const FileName: string): PSDL_Surface; -{ Creates SDL surface from image in stream in format supported by Imaging.} -function LoadSDLSurfaceFromStream(Stream: TStream): PSDL_Surface; -{ Creates SDL surface from image in memory in format supported by Imaging.} -function LoadSDLSurfaceFromMemory(Data: Pointer; Size: LongInt): PSDL_Surface; - -{ Converts image to SDL surface. Flags is used when creating SDL surface - using SDL_CreateRGBSurface and is passed to it. OverrideFormat can be - used to convert image to specified format before SDL surface is created, - ifUnknown means no conversion.} -function CreateSDLSurfaceFromImage(const ImageData: TImageData; - Flags: UInt32; OverrideFormat: TImageFormat = ifUnknown): PSDL_Surface; - -{ Saves SDL surface to file in one of the formats supported by Imaging.} -function SaveSDLSurfaceToFile(const FileName: string; Surface: PSDL_Surface): Boolean; -{ Saves SDL surface to stream in one of the formats supported by Imaging defined by Ext.} -function SaveSDLSurfaceToStream(const Ext: string; Stream: TStream; Surface: PSDL_Surface): Boolean; -{ Saves SDL surface to memory in one of the formats supported by Imaging defined - by Ext. Size must contain size of available memory before the function - is called and memory size taken up by the image is returned in this parameter.} -function SaveSDLSurfaceToMemory(const Ext: string; Data: Pointer; var Size: LongInt; Surface: PSDL_Surface): Boolean; - -{ Converts SDL surface to TImageData structure. OverrideFormat can be - used to convert output image to the specified format rather than - use the format taken from SDL surface, ifUnknown means no conversion.} -function CreateImageFromSDLSurface(Surface: PSDL_Surface; var ImageData: TImageData; - OverrideFormat: TImageFormat = ifUnknown): Boolean; - -implementation - -const - DefaultFlags = SDL_SWSURFACE; - -function Iff(Condition: Boolean; const TruePart, FalsePart: TImageFormat): TImageFormat; overload; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function LoadSDLSurfaceFromFile(const FileName: string): PSDL_Surface; -var - ImageData: TImageData; -begin - InitImage(ImageData); - if LoadImageFromFile(FileName, ImageData) then - Result := CreateSDLSurfaceFromImage(ImageData, DefaultFlags) - else - Result := nil; - FreeImage(ImageData); -end; - -function LoadSDLSurfaceFromStream(Stream: TStream): PSDL_Surface; -var - ImageData: TImageData; -begin - InitImage(ImageData); - if LoadImageFromStream(Stream, ImageData) then - Result := CreateSDLSurfaceFromImage(ImageData, DefaultFlags) - else - Result := nil; - FreeImage(ImageData); -end; - -function LoadSDLSurfaceFromMemory(Data: Pointer; Size: LongInt): PSDL_Surface; -var - ImageData: TImageData; -begin - InitImage(ImageData); - if LoadImageFromMemory(Data, Size, ImageData) then - Result := CreateSDLSurfaceFromImage(ImageData, DefaultFlags) - else - Result := nil; - FreeImage(ImageData); -end; - -function CreateSDLSurfaceFromImage(const ImageData: TImageData; - Flags: UInt32; OverrideFormat: TImageFormat): PSDL_Surface; -var - WorkData: TImageData; - Info: TImageFormatInfo; - ConvFormat: TImageFormat; - AMask, RMask, GMask, BMask: UInt32; - I, LineBytes: LongInt; - - procedure DetermineSDLMasks(var AMask, RMask, GMask, BMask: UInt32); - begin - if Info.UsePixelFormat then - begin - AMask := Info.PixelFormat.ABitMask; - RMask := Info.PixelFormat.RBitMask; - GMask := Info.PixelFormat.GBitMask; - BMask := Info.PixelFormat.BBitMask; - end - else - begin - AMask := IffUnsigned(Info.HasAlphaChannel, $FF000000, 0); - RMask := $00FF0000; - GMask := $0000FF00; - BMask := $000000FF; - end; - end; - -begin - Result := nil; - if TestImage(ImageData) then - begin - InitImage(WorkData); - CloneImage(ImageData, WorkData); - // Image is converted to override format - if OverrideFormat <> ifUnknown then - ConvertImage(WorkData, OverrideFormat); - - GetImageFormatInfo(WorkData.Format, Info); - // Image is first converted to format supported by SDL - if Info.IsFloatingPoint or Info.IsSpecial then - ConvFormat := ifA8R8G8B8 - else - if Info.UsePixelFormat then - begin - if Info.BytesPerPixel < 2 then - ConvFormat := Iff(Info.HasAlphaChannel, ifA4R4G4B4, ifR5G6B5) - else - ConvFormat := WorkData.Format; - end - else - if Info.IsIndexed then - ConvFormat := ifIndex8 - else - ConvFormat := Iff(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(WorkData, ConvFormat); - GetImageFormatInfo(WorkData.Format, Info); - // Channel masks are determined based on image's format, - // only 8/16/24/32bit images should be here now - DetermineSDLMasks(AMask, RMask, GMask, BMask); - - // SDL surface is created - Result := SDL_CreateRGBSurface(Flags, WorkData.Width, WorkData.Height, - Info.BytesPerPixel * 8, RMask, GMask, BMask, AMask); - - if Result <> nil then - begin - LineBytes := Info.BytesPerPixel * WorkData.Width; - - if SDL_MustLock(Result) then - SDL_LockSurface(Result); - - // Pixels of image are copied to SDL surface - if LineBytes = Result.pitch then - Move(WorkData.Bits^, Result.pixels^, WorkData.Size) - else - for I := 0 to WorkData.Height - 1 do - Move(PByteArray(WorkData.Bits)[I * LineBytes], - PByteArray(Result.pixels)[I * Result.pitch], LineBytes); - - if SDL_MustLock(Result) then - SDL_UnlockSurface(Result); - - // If surface is in indexed format, palette is copied - if (Info.Format = ifIndex8) and (Result.format.palette <> nil) then - begin - Result.format.palette.ncolors := Info.PaletteEntries; - for I := 0 to Info.PaletteEntries - 1 do - begin - Result.format.palette.colors[I].r := WorkData.Palette[I].R; - Result.format.palette.colors[I].g := WorkData.Palette[I].G; - Result.format.palette.colors[I].b := WorkData.Palette[I].B; - Result.format.palette.colors[I].unused := 0; - end; - end; - end; - - FreeImage(WorkData); - end; -end; - -function SaveSDLSurfaceToFile(const FileName: string; Surface: PSDL_Surface): Boolean; -var - ImageData: TImageData; -begin - Result := False; - if CreateImageFromSDLSurface(Surface, ImageData) then - begin - Result := SaveImageToFile(FileName, ImageData); - FreeImage(ImageData); - end; -end; - -function SaveSDLSurfaceToStream(const Ext: string; Stream: TStream; Surface: PSDL_Surface): Boolean; -var - ImageData: TImageData; -begin - Result := False; - if CreateImageFromSDLSurface(Surface, ImageData) then - begin - Result := SaveImageToStream(Ext, Stream, ImageData); - FreeImage(ImageData); - end; -end; - -function SaveSDLSurfaceToMemory(const Ext: string; Data: Pointer; var Size: LongInt; Surface: PSDL_Surface): Boolean; -var - ImageData: TImageData; -begin - Result := False; - if CreateImageFromSDLSurface(Surface, ImageData) then - begin - Result := SaveImageToMemory(Ext, Data, Size, ImageData); - FreeImage(ImageData); - end; -end; - -function CreateImageFromSDLSurface(Surface: PSDL_Surface; var ImageData: TImageData; - OverrideFormat: TImageFormat): Boolean; -const - SDL_A8R8G8B8Format: TSDL_PixelFormat = (palette: nil; BitsPerPixel: 32; - BytesPerPixel: 4; Rloss: 0; Gloss: 0; Bloss: 0; Aloss: 0; - Rshift: 16; Gshift: 8; Bshift: 0; Ashift: 24; - Rmask: $00FF0000; Gmask: $0000FF00; Bmask: $000000FF; Amask: $FF000000; - colorkey: 0; alpha: $FF); -var - Format: TImageFormat; - Converted: PSDL_Surface; - Info: TImageFormatInfo; - I, LineBytes: LongInt; - - function DetermineImageFormat: TImageFormat; - var - Fmt: TImageFormat; - begin - Result := ifUnknown; - case Surface.format.BitsPerPixel of - 8: Result := ifIndex8; - 16: - begin - // go trough 16bit formats supported by Imaging and - // if there is one that matches SDL format's masks then use it - for Fmt := ifR5G6B5 to ifX4R4G4B4 do - begin - GetImageFormatInfo(Fmt, Info); - if (Info.PixelFormat.ABitMask = Surface.format.AMask) and - (Info.PixelFormat.RBitMask = Surface.format.RMask) and - (Info.PixelFormat.GBitMask = Surface.format.GMask) and - (Info.PixelFormat.BBitMask = Surface.format.BMask) then - begin - Result := Fmt; - Break; - end; - end; - end; - 24: - begin - if (Surface.format.RMask = $FF0000) and - (Surface.format.GMask = $00FF00) and - (Surface.format.BMask = $0000FF) then - Result := ifR8G8B8; - end; - 32: - begin - if (Surface.format.RMask = $00FF0000) and - (Surface.format.GMask = $0000FF00) and - (Surface.format.BMask = $000000FF) then - if (Surface.format.AMask = $FF000000) then - Result := ifA8R8G8B8 - else - Result := ifX8R8G8B8 - end; - end; - end; - -begin - Result := False; - FreeImage(ImageData); - - // See if surface is in format supported by Imaging and if it is - // not then it is converted to A8R8G8B8 - Format := DetermineImageFormat; - if Format = ifUnknown then - begin - Converted := SDL_ConvertSurface(Surface, @SDL_A8R8G8B8Format, SDL_SWSURFACE); - Format := ifA8R8G8B8; - end - else - Converted := Surface; - - if (Converted <> nil) and NewImage(Converted.w, Converted.h, Format, ImageData) then - begin - GetImageFormatInfo(Format, Info); - LineBytes := Info.BytesPerPixel * ImageData.Width; - - if SDL_MustLock(Converted) then - SDL_LockSurface(Converted); - - // New image is created and pixels are copied from SDL surface - if LineBytes = Converted.pitch then - Move(Converted.pixels^, ImageData.Bits^, ImageData.Size) - else - for I := 0 to ImageData.Height - 1 do - Move(PByteArray(Converted.pixels)[I * Converted.pitch], - PByteArray(ImageData.Bits)[I * LineBytes], LineBytes); - - if SDL_MustLock(Converted) then - SDL_UnlockSurface(Converted); - - // Copy palette if necessary - // If surface is in indexed format, palette is copied - if (Info.Format = ifIndex8) and (Converted.format.palette <> nil) then - begin - for I := 0 to Min(Info.PaletteEntries, Converted.format.palette.ncolors) - 1 do - begin - ImageData.Palette[I].A := 255; - ImageData.Palette[I].R := Converted.format.palette.colors[I].r; - ImageData.Palette[I].G := Converted.format.palette.colors[I].g; - ImageData.Palette[I].B := Converted.format.palette.colors[I].b; - end; - end; - - // Image is converted to override format - if OverrideFormat <> ifUnknown then - ConvertImage(ImageData, OverrideFormat); - - Result := True; - end; - - if Converted <> Surface then - SDL_FreeSurface(Converted); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Fixed possible int overflow in CreateSDLSurfaceFromImage. - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - unit created and initial stuff added -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingSquishLib.pas b/components/vampireimaging/Extras/Extensions/ImagingSquishLib.pas deleted file mode 100644 index c570645..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingSquishLib.pas +++ /dev/null @@ -1,170 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ High quality DXTC compressor using Squish library (dynamicaly linked).} -unit ImagingSquishLib; - -interface - -{$I ImagingOptions.inc} - -uses - ImagingTypes, Imaging, ImagingFormats; - -type - TDXTCompressor = ( - dcClusterFit, // Use a slow but high quality colour compressor (the default). - dcRangeFit, // Use a fast but low quality colour compressor. - dcClusterFitAlphaWeighted // Cluster fit that weights the colour by alpha. - // For images that are rendered using alpha blending, - // this can significantly increase the perceived quality. - ); - - TColorMetric = ( - cmPerceptual, // Use a perceptual metric for colour error (the default). - cmUniform // Use a uniform metric for colour error. - ); - -{ Compresses SrcImage using selected DXTn compression into DestImage. - DestImage should be cleared before calling.} -procedure DXTCompressImage(const SrcImage: TImageData; var DestImage: TImageData; - DXTFormat: TImageFormat; Compressor: TDXTCompressor = dcClusterFit; - Metric: TColorMetric = cmPerceptual); - -implementation - -const - FlagDXT1 = 1 shl 0; - FlagDXT3 = 1 shl 1; - FlagDXT5 = 1 shl 2; - FlagColourClusterFit = 1 shl 3; - FlagColourRangeFit = 1 shl 4; - FlagColourMetricPerceptual = 1 shl 5; - FlagColourMetricUniform = 1 shl 6; - FlagWeightColourByAlpha = 1 shl 7; - -(* @brief Compresses an image in memory. - - @param rgba The pixels of the source. - @param width The width of the source image. - @param height The height of the source image. - @param blocks Storage for the compressed output. - @param flags Compression flags. - - The source pixels should be presented as a contiguous array of width*height - rgba values, with each component as 1 byte each. In memory this should be: - - { r1, g1, b1, a1, .... , rn, gn, bn, an } for n = width*height - - The flags parameter should specify either kDxt1, kDxt3 or kDxt5 compression, - however, DXT1 will be used by default if none is specified. When using DXT1 - compression, 8 bytes of storage are required for each compressed DXT block. - DXT3 and DXT5 compression require 16 bytes of storage per block. - - The flags parameter can also specify a preferred colour compressor and - colour error metric to use when fitting the RGB components of the data. - Possible colour compressors are: kColourClusterFit (the default) or - kColourRangeFit. Possible colour error metrics are: kColourMetricPerceptual - (the default) or kColourMetricUniform. If no flags are specified in any - particular category then the default will be used. Unknown flags are - ignored. - - When using kColourClusterFit, an additional flag can be specified to - weight the colour of each pixel by its alpha value. For images that are - rendered using alpha blending, this can significantly increase the - perceived quality. - - Internally this function calls squish::Compress for each block. To see how - much memory is required in the compressed image, use - squish::GetStorageRequirements. -*) - -procedure CompressImage(RGBA: PByte; Width, Height: Integer; Blocks: Pointer; - Flags: Integer); cdecl; external 'libsquish.dll'; - - -procedure DXTCompressImage(const SrcImage: TImageData; var DestImage: TImageData; - DXTFormat: TImageFormat; Compressor: TDXTCompressor = dcClusterFit; - Metric: TColorMetric = cmPerceptual); -var - Width, Height: Integer; - Info: TImageFormatInfo; - TempImage: TImageData; - Flags: Integer; - - function GetSquishFlags: Integer; - begin - Result := 0; - - case DXTFormat of - ifDXT1: Result := FlagDXT1; - ifDXT3: Result := FlagDXT3; - ifDXT5: Result := FlagDXT5; - end; - - case Compressor of - dcClusterFit: Result := Result or FlagColourClusterFit; - dcRangeFit: Result := Result or FlagColourRangeFit; - dcClusterFitAlphaWeighted: Result := Result or FlagColourClusterFit or FlagWeightColourByAlpha; - end; - - case Metric of - cmPerceptual: Result := Result or FlagColourMetricPerceptual; - cmUniform: Result := Result or FlagColourMetricUniform; - end; - end; - -begin - Assert(DXTFormat in [ifDXT1, ifDXT3, ifDXT5]); - - Width := SrcImage.Width; - Height := SrcImage.Height; - Flags := GetSquishFlags; - - // Check if input has correct dimensions and change them if needed - GetImageFormatInfo(DXTFormat, Info); - Info.CheckDimensions(DXTFormat, Width, Height); - - try - // Create temp image as input for squish (must be ABGR order with - // dimensions being multiples of 4) - NewImage(Width, Height, ifA8R8G8B8, TempImage); - CopyRect(SrcImage, 0, 0, SrcImage.Width, SrcImage.Height, TempImage, 0, 0); - SwapChannels(TempImage, ChannelRed, ChannelBlue); - - // Init and create out image - InitImage(DestImage); - NewImage(Width, Height, DXTFormat, DestImage); - - // Finally call Squish - CompressImage(TempImage.Bits, Width, Height, DestImage.Bits, Flags); - finally - FreeImage(TempImage); - end; -end; - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingTiff.pas b/components/vampireimaging/Extras/Extensions/ImagingTiff.pas deleted file mode 100644 index 1ef2122..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingTiff.pas +++ /dev/null @@ -1,117 +0,0 @@ -unit ImagingTiff; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Imaging, ImagingTypes, ImagingUtility, ImagingIO, ImagingExtras; - -type - { TIFF (Tag Image File Format) loader/saver base class.} - TBaseTiffFileFormat = class(TImageFileFormat) - protected - FCompression: Integer; - FJpegQuality: Integer; - procedure Define; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - { Specifies compression scheme used when saving TIFF images. Supported values - are 0 (Uncompressed), 1 (LZW), 2 (PackBits RLE), 3 (Deflate - ZLib), 4 (JPEG), - 5 (CCITT Group 4 fax encoding - for binary images only). - Default is 1 (LZW). Note that not all images can be stored with - JPEG compression - these images will be saved with default compression if - JPEG is set.} - property Compression: Integer read FCompression write FCompression; - { Controls compression quality when selected TIFF compression is Jpeg. - It is number in range 1..100. 1 means small/ugly file, - 100 means large/nice file. Accessible trough ImagingTiffJpegQuality option.} - property JpegQuality: Integer read FJpegQuality write FJpegQuality; - end; - -const - TiffCompressionOptionNone = 0; - TiffCompressionOptionLzw = 1; - TiffCompressionOptionPackbitsRle = 2; - TiffCompressionOptionDeflate = 3; - TiffCompressionOptionJpeg = 4; - TiffCompressionOptionGroup4 = 5; - - { Read only metadata info - name of compression scheme (LZW, none, JPEG, G4, ...) - used in last loaded TIFF. } - SMetaTiffCompressionName = 'TiffCompressionName'; - { Original resolution unit of loaded TIFF. Type is UInt. - RESUNIT_NONE = 1; // no meaningful units - RESUNIT_INCH = 2; // english - RESUNIT_CENTIMETER = 3; // metric } - SMetaTiffResolutionUnit = 'TiffResolutionUnit'; - -implementation - -{$IFNDEF DONT_LINK_FILE_FORMATS} - -// So far we have only one TIFF support implementation - libtiff -{$DEFINE USE_LIBTIFF} - -// libtiff for FPC ARM is disabled by default due to potential hardfp/softfp -// ABI problems (without linking to any lib FPC generated binary does not call "ld" -// and hardfp exe can run on softfp target). If you know what you're doing enable it. -{$IF Defined(FPC) and Defined(CPUARM)} - {$UNDEF USE_LIBTIFF} -{$IFEND} - -// Not even dynamic linking works at the moment -{$IF Defined(DELPHI) and Defined(MACOS))} - {$UNDEF USE_LIBTIFF} -{$IFEND} - -{$IFDEF USE_LIBTIFF} -uses - ImagingTiffLib; -{$ENDIF} - -{$ENDIF} - -const - STiffFormatName = 'Tagged Image File Format'; - STiffMasks = '*.tif,*.tiff'; - TiffDefaultCompression = 1; - TiffDefaultJpegQuality = 90; - -const - TiffBEMagic: TChar4 = 'MM'#0#42; - TiffLEMagic: TChar4 = 'II'#42#0; - -{ - TBaseTiffFileFormat implementation -} - -procedure TBaseTiffFileFormat.Define; -begin - inherited; - FName := STiffFormatName; - FFeatures := [ffLoad, ffSave, ffMultiImage]; - FCompression := TiffDefaultCompression; - FJpegQuality := TiffDefaultJpegQuality; - - AddMasks(STiffMasks); - RegisterOption(ImagingTiffCompression, @FCompression); - RegisterOption(ImagingTiffJpegQuality, @FJpegQuality); -end; - -function TBaseTiffFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Magic: TChar4; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Magic, SizeOf(Magic)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Magic)) and - ((Magic = TiffBEMagic) or (Magic = TiffLEMagic)); - end; -end; - -end. diff --git a/components/vampireimaging/Extras/Extensions/ImagingXpm.pas b/components/vampireimaging/Extras/Extensions/ImagingXpm.pas deleted file mode 100644 index 4607a8a..0000000 --- a/components/vampireimaging/Extras/Extensions/ImagingXpm.pas +++ /dev/null @@ -1,582 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader for X Window Pixmap images. } -unit ImagingXpm; -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, Contnrs, ImagingTypes, Imaging, ImagingUtility, - ImagingFormats, ImagingIO, ImagingCanvases; - -type - { Class for loading X Window Pixmap images known as XPM. - It is ASCII-text-based format, basicaly a fragment of C code - declaring static array. Loaded image is in ifA8R8G8B8 data format. - Loading as well as saving is supported now. } - TXPMFileFormat = class(TImageFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SXPMFormatName = 'X Window Pixmap'; - SXPMMasks = '*.xpm'; - XPMSupportedFormats: TImageFormats = [ifA8R8G8B8]; - -const - SXPMId = '/* XPM */'; - WhiteSpaces = [#9, #10, #13, #32]; - -const - BucketCount = 257; - -type - TColorHolder = class - public - Color: TColor32; - end; - - TBucketItem = record - Key: TColor32; - Data: string[8]; - end; - - TBucketItemArray = array of TBucketItem; - - TBucket = record - Count: Integer; - ItemIdxStart: Integer; - Items: TBucketItemArray; - end; - - TBucketArray = array of TBucket; - - { Simple color-string hash table for faster than linear searches - during XPM saving. } - TSimpleBucketList = class - private - FBuckets: TBucketArray; - FItemCount: Integer; - FABucket, FAIndex: Integer; - function GetData(AKey: TColor32): string; - procedure SetData(AKey: TColor32; const AData: string); - function FindItem(AKey: TColor32; out ABucket, AIndex: Integer): Boolean; - public - constructor Create; - procedure Add(AKey: TColor32; const AData: string); - function Exists(AKey: TColor32): Boolean; - function EnumNext(out AData: string): TColor32; - property Data[AKey: TColor32]: string read GetData write SetData; default; - property ItemCount: Integer read FItemCount; - end; - - { TSimpleBucketList } - -constructor TSimpleBucketList.Create; -begin - SetLength(FBuckets, BucketCount); -end; - -function TSimpleBucketList.GetData(AKey: TColor32): string; -var - Bucket, Index: Integer; -begin - Result := ''; - if FindItem(AKey, Bucket, Index) then - Result := string(FBuckets[Bucket].Items[Index].Data); -end; - -procedure TSimpleBucketList.SetData(AKey: TColor32; const AData: string); -var - Bucket, Index: Integer; -begin - if FindItem(AKey, Bucket, Index) then - FBuckets[Bucket].Items[Index].Data := ShortString(AData); -end; - -function TSimpleBucketList.EnumNext(out AData: string): TColor32; -begin - // Skip empty buckets - while FAIndex >= FBuckets[FABucket].Count do - begin - Inc(FABucket); - if FABucket >= Length(FBuckets) then - FABucket := 0; - FAIndex := 0; - end; - - Result := FBuckets[FABucket].Items[FAIndex].Key; - AData := string(FBuckets[FABucket].Items[FAIndex].Data); - Inc(FAIndex); -end; - -function TSimpleBucketList.FindItem(AKey: TColor32; out ABucket, - AIndex: Integer): Boolean; -var - I: Integer; - Col: TColor32Rec; -begin - Result := False; - Col := TColor32Rec(AKey); - ABucket := (Col.A + 11 * Col.B + 59 * Col.R + 119 * Col.G) mod BucketCount; - with FBuckets[ABucket] do - for I := 0 to Count - 1 do - if Items[I].Key = AKey then - begin - AIndex := I; - Result := True; - Break; - end; -end; - -procedure TSimpleBucketList.Add(AKey: TColor32; const AData: string); -var - Bucket, Index, Delta, Size: Integer; -begin - if not FindItem(AKey, Bucket, Index) then - with FBuckets[Bucket] do - begin - Size := Length(Items); - if Count = Size then - begin - if Size > 64 then - Delta := Size div 4 - else - Delta := 16; - SetLength(Items, Size + Delta); - end; - - with Items[Count] do - begin - Key := AKey; - Data := ShortString(AData); - end; - Inc(Count); - Inc(FItemCount); - end; -end; - -function TSimpleBucketList.Exists(AKey: TColor32): Boolean; -var - Bucket, Index: Integer; -begin - Result := FindItem(AKey, Bucket, Index); -end; - -{ - TXPMFileFormat implementation -} - -procedure TXPMFileFormat.Define; -begin - inherited; - FName := SXPMFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := XPMSupportedFormats; - - AddMasks(SXPMMasks); -end; - -function TXPMFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Contents, PalLookup: TStringList; - S: AnsiString; - I, J, NumColors, Cpp, Line: Integer; - - procedure SkipWhiteSpace(var Line: string); - begin - while (Length(Line) > 0) and (AnsiChar(Line[1]) in WhiteSpaces) do - Delete(Line, 1, 1); - end; - - function ReadString(var Line: string): string; - begin - Result := ''; - SkipWhiteSpace(Line); - while (Length(Line) > 0) and not (AnsiChar(Line[1]) in WhiteSpaces) do - begin - SetLength(Result, Length(Result) + 1); - Result[Length(Result)] := Line[1]; - Delete(Line, 1, 1); - end; - end; - - function ReadInt(var Line: string): Integer; - begin - Result := StrToInt(ReadString(Line)); - end; - - function ParseHeader: Boolean; - var - S: string; - begin - S := Contents[0]; - try - Images[0].Width := ReadInt(S); - Images[0].Height := ReadInt(S); - NumColors := ReadInt(S); - Cpp := ReadInt(S); - Line := 1; - Result := True; - except - Result := False; - end; - end; - - function NamedToColor(const ColStr: string): TColor32; - var - S: string; - begin - S := LowerCase(ColStr); - if (S = 'transparent') or (S = 'none') then - Result := pcClear - else if S = 'black' then - Result := pcBlack - else if S = 'blue' then - Result := pcBlue - else if S = 'green' then - Result := pcGreen - else if S = 'cyan' then - Result := pcAqua - else if S = 'red' then - Result := pcRed - else if S = 'magenta' then - Result := pcFuchsia - else if S = 'yellow' then - Result := pcYellow - else if S = 'white' then - Result := pcWhite - else if S = 'gray' then - Result := pcLtGray - else if S = 'dkblue' then - Result := pcNavy - else if S = 'dkgreen' then - Result := pcGreen - else if S = 'dkcyan' then - Result := pcTeal - else if S = 'dkred' then - Result := pcMaroon - else if S = 'dkmagenta' then - Result := pcPurple - else if S = 'dkyellow' then - Result := pcOlive - else if S = 'maroon' then - Result := pcMaroon - else if S = 'olive' then - Result := pcOlive - else if S = 'navy' then - Result := pcNavy - else if S = 'purple' then - Result := pcPurple - else if S = 'teal' then - Result := pcTeal - else if S = 'silver' then - Result := pcSilver - else if S = 'lime' then - Result := pcLime - else if S = 'fuchsia' then - Result := pcFuchsia - else if S = 'aqua' then - Result := pcAqua - else - Result := pcClear; - end; - - procedure ParsePalette; - var - I: Integer; - S, ColType, ColStr, Code: string; - Color: TColor32; - Holder: TColorHolder; - begin - for I := 0 to NumColors - 1 do - begin - Holder := TColorHolder.Create; - // Parse pixel code and color - S := Contents[Line + I]; - Code := Copy(S, 1, Cpp); - Delete(S, 1, Cpp); - ColType := ReadString(S); - ColStr := ReadString(S); - // Convert color from hex number or named constant - if ColStr[1] = '#' then - begin - Delete(ColStr, 1, 1); - Color := UInt32(StrToInt('$' + Trim(ColStr))) or $FF000000; - end - else - Color := NamedToColor(ColStr); - // Store code and color in table for later lookup - Holder.Color := Color; - PalLookup.AddObject(Code, Holder); - end; - Inc(Line, NumColors); - end; - - procedure ParsePixels; - var - X, Y, Idx: Integer; - S, Code: string; - Pix: PColor32; - begin - Pix := Images[0].Bits; - for Y := 0 to Images[0].Height - 1 do - begin - S := Contents[Line + Y]; - for X := 0 to Images[0].Width - 1 do - begin - // Read code and look up color in the palette - Code := Copy(S, X * Cpp + 1, Cpp); - if PalLookup.Find(Code, Idx) then - Pix^ := TColorHolder(PalLookup.Objects[Idx]).Color - else - Pix^ := pcClear; - Inc(Pix); - end; - end; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Look up table for XPM palette entries - PalLookup := TStringList.Create; - PalLookup.Sorted := True; - PalLookup.CaseSensitive := True; - // Read whole file and assign it to string list - Contents := TStringList.Create; - SetLength(S, GetInputSize(GetIO, Handle)); - Read(Handle, @S[1], Length(S)); - Contents.Text := string(S); - // Remove quotes and other stuff - for I := Contents.Count - 1 downto 0 do - begin - J := Pos('"', Contents[I]); - if J > 0 then - Contents[I] := Copy(Contents[I], J + 1, LastDelimiter('"', Contents[I]) - J - 1) - else - Contents.Delete(I); - end; - // Parse header and create new image - if not ParseHeader then - Exit; - NewImage(Width, Height, ifA8R8G8B8, Images[0]); - // Read palette entries and assign colors to pixels - ParsePalette; - ParsePixels; - - Contents.Free; - for I := 0 to PalLookup.Count - 1 do - PalLookup.Objects[I].Free; - PalLookup.Free; - Result := True; - end; -end; - -function TXPMFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -const - ColorCharsCount = 92; - ColorChars = ' .XoO+@#$%&*=-;:>,<1234567890qwertyuipasdfghjklzxcvbnmMNBVCZASDFGHJKLPIUYTREWQ!~^/()_`''][{}|'; -var - X, Y: Integer; - ImageToSave: TImageData; - MustBeFreed: Boolean; - StrFile: TStringList; - ColTable: TSimpleBucketList; - Stream: TMemoryStream; - Line, Id: string; - CharsPerPixel: Integer; - Ptr: PColor32Rec; - ColRec: TColor32Rec; - - procedure BuildColorTables(const Img: TImageData); - var - I: Integer; - begin - Ptr := Img.Bits; - for I := 0 to Img.Width * Img.Height - 1 do - begin - if not ColTable.Exists(Ptr.Color) then - ColTable.Add(Ptr.Color, ''); - Inc(Ptr); - end; - end; - - procedure MakeStrIdsForColors; - var - I, J, K: Integer; - Id, Data: string; - begin - SetLength(Id, CharsPerPixel); - for I := 0 to ColTable.ItemCount - 1 do - begin - ColRec.Color := ColTable.EnumNext(Data); - K := I; - for J := 0 to CharsPerPixel - 1 do - begin - Id[J + 1] := ColorChars[K mod ColorCharsCount + 1]; - K := K div ColorCharsCount; - end; - ColTable.Data[ColRec.Color] := Id; - end; - end; - -begin - Result := False; - - StrFile := TStringList.Create; - ColTable := TSimpleBucketList.Create; - Stream := TMemoryStream.Create; - - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - try - // Put all unique colors of image to table - BuildColorTables(ImageToSave); - // Compute the character per pixel - CharsPerPixel := 1; - X := ColorCharsCount; - while ColTable.ItemCount > X do - begin - X := X * ColorCharsCount; - Inc(CharsPerPixel); - end; - // Assign char id to each color - MakeStrIdsForColors; - - // Start writing XPM file - StrFile.Add(SXPMId); - StrFile.Add('static char *graphic[] = {'); - StrFile.Add('/* width height num_colors chars_per_pixel */'); - StrFile.Add(SysUtils.Format('"%d %d %d %d", ', [ImageToSave.Width, - ImageToSave.Height, ColTable.ItemCount, CharsPerPixel])); - StrFile.Add('/* colors */'); - - // Write 'colors' part of XPM file - for X := 0 to ColTable.ItemCount - 1 do - begin - ColRec.Color := ColTable.EnumNext(Id); - if ColRec.A >= 128 then - StrFile.Add(Format('"%s c #%.2x%.2x%.2x",', [Id, ColRec.R, ColRec.G, ColRec.B])) - else - StrFile.Add(Format('"%s c None",', [Id])); - end; - - StrFile.Add('/* pixels */'); - - // Write pixels - for aech pixel of image find its char id - // and append it to line - Ptr := ImageToSave.Bits; - for Y := 0 to ImageToSave.Height - 1 do - begin - Line := ''; - for X := 0 to ImageToSave.Width - 1 do - begin - Line := Line + ColTable.Data[Ptr.Color]; - Inc(Ptr); - end; - Line := '"' + Line + '"'; - if Y < ImageToSave.Height - 1 then - Line := Line + ','; - StrFile.Add(Line); - end; - - StrFile.Add('};'); - - // Finally save strings to stream and write stream's data to output - // (we could directly write lines from list to output, but stream method - // takes care of D2009+ Unicode strings). - StrFile.SaveToStream(Stream); - GetIO.Write(Handle, Stream.Memory, Stream.Size); - - Result := True; - finally - StrFile.Free; - ColTable.Free; - Stream.Free; - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -procedure TXPMFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - ConvertImage(Image, ifA8R8G8B8) -end; - -function TXPMFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Id: array[0 .. 8] of AnsiChar; - ReadCount: Integer; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Id, SizeOf(Id)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (Id = SXPMId) and (ReadCount = SizeOf(Id)); - end; -end; - -initialization - -RegisterImageFileFormat(TXPMFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes ----------------------------------- - - Added XPM saving. - - -- 0.25.0 Changes/Bug Fixes ----------------------------------- - - Added XPM loading. - - Unit created. -} - -end. - - diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/bio.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/bio.obj deleted file mode 100644 index f28a922..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/bio.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/cio.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/cio.obj deleted file mode 100644 index 072ff44..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/cio.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/dwt.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/dwt.obj deleted file mode 100644 index c90e979..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/dwt.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/event.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/event.obj deleted file mode 100644 index dbc8db5..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/event.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/image.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/image.obj deleted file mode 100644 index 635b5c6..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/image.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/j2k.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/j2k.obj deleted file mode 100644 index 23f3601..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/j2k.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/j2k_lib.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/j2k_lib.obj deleted file mode 100644 index 3dbe8d5..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/j2k_lib.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/jp2.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/jp2.obj deleted file mode 100644 index 587d7a7..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/jp2.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/jpt.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/jpt.obj deleted file mode 100644 index a294924..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/jpt.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/libcrtdll.a b/components/vampireimaging/Extras/Extensions/J2KObjects/libcrtdll.a deleted file mode 100644 index 7128707..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/libcrtdll.a and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpeglinx86.a b/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpeglinx86.a deleted file mode 100644 index 32e4dd0..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpeglinx86.a and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpeglinx86_64.a b/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpeglinx86_64.a deleted file mode 100644 index a6af544..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpeglinx86_64.a and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpegosxx86.a b/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpegosxx86.a deleted file mode 100644 index 1f7dd32..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpegosxx86.a and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpegwin32.a b/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpegwin32.a deleted file mode 100644 index efef2ac..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/libopenjpegwin32.a and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/mct.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/mct.obj deleted file mode 100644 index 4a25c0d..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/mct.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/mqc.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/mqc.obj deleted file mode 100644 index cd84bbe..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/mqc.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/openjpeg.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/openjpeg.obj deleted file mode 100644 index 9b971a1..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/openjpeg.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/pi.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/pi.obj deleted file mode 100644 index 5e60649..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/pi.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/raw.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/raw.obj deleted file mode 100644 index e020708..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/raw.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/t1.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/t1.obj deleted file mode 100644 index 9f4cd22..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/t1.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/t2.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/t2.obj deleted file mode 100644 index 7cb0389..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/t2.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/tcd.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/tcd.obj deleted file mode 100644 index 3006018..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/tcd.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/J2KObjects/tgt.obj b/components/vampireimaging/Extras/Extensions/J2KObjects/tgt.obj deleted file mode 100644 index 3396853..0000000 Binary files a/components/vampireimaging/Extras/Extensions/J2KObjects/tgt.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/adler32.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/adler32.obj deleted file mode 100644 index 4ea3e76..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/adler32.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/compress.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/compress.obj deleted file mode 100644 index e2b153e..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/compress.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/crc32.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/crc32.obj deleted file mode 100644 index 25d86be..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/crc32.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/deflate.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/deflate.obj deleted file mode 100644 index 25bbf9d..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/deflate.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inffast.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inffast.obj deleted file mode 100644 index cfaf0b6..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inffast.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inflate.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inflate.obj deleted file mode 100644 index 6b15361..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inflate.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inftrees.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inftrees.obj deleted file mode 100644 index 4357da2..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/inftrees.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcapimin.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcapimin.obj deleted file mode 100644 index 1979f24..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcapimin.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcapistd.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcapistd.obj deleted file mode 100644 index b6b51c1..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcapistd.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jccoefct.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jccoefct.obj deleted file mode 100644 index 505b1a3..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jccoefct.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jccolor.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jccolor.obj deleted file mode 100644 index 7e8d7dc..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jccolor.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcdctmgr.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcdctmgr.obj deleted file mode 100644 index 4dc9d10..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcdctmgr.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jchuff.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jchuff.obj deleted file mode 100644 index fe396b8..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jchuff.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcinit.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcinit.obj deleted file mode 100644 index 6a6d0a4..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcinit.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmainct.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmainct.obj deleted file mode 100644 index e9cbdfe..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmainct.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmarker.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmarker.obj deleted file mode 100644 index d65aed3..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmarker.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmaster.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmaster.obj deleted file mode 100644 index 7e7d2e1..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcmaster.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcomapi.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcomapi.obj deleted file mode 100644 index 655eb62..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcomapi.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcparam.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcparam.obj deleted file mode 100644 index 4de1113..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcparam.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcphuff.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcphuff.obj deleted file mode 100644 index cacf644..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcphuff.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcprepct.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcprepct.obj deleted file mode 100644 index 744687d..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcprepct.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcsample.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcsample.obj deleted file mode 100644 index 1bfaf5b..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jcsample.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jctrans.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jctrans.obj deleted file mode 100644 index 90204b1..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jctrans.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdapimin.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdapimin.obj deleted file mode 100644 index e427785..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdapimin.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdapistd.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdapistd.obj deleted file mode 100644 index ba183e8..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdapistd.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdatadst.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdatadst.obj deleted file mode 100644 index 22be293..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdatadst.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdatasrc.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdatasrc.obj deleted file mode 100644 index 0b20f8b..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdatasrc.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdcoefct.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdcoefct.obj deleted file mode 100644 index 79348f7..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdcoefct.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdcolor.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdcolor.obj deleted file mode 100644 index bbc03e3..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdcolor.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jddctmgr.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jddctmgr.obj deleted file mode 100644 index ad7d4bb..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jddctmgr.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdhuff.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdhuff.obj deleted file mode 100644 index 75e2a82..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdhuff.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdinput.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdinput.obj deleted file mode 100644 index 6f66c54..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdinput.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmainct.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmainct.obj deleted file mode 100644 index 2e17085..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmainct.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmarker.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmarker.obj deleted file mode 100644 index 877b3e2..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmarker.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmaster.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmaster.obj deleted file mode 100644 index 615bec6..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmaster.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmerge.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmerge.obj deleted file mode 100644 index dddbf74..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdmerge.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdphuff.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdphuff.obj deleted file mode 100644 index 9729489..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdphuff.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdpostct.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdpostct.obj deleted file mode 100644 index ea40e46..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdpostct.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdsample.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdsample.obj deleted file mode 100644 index 279e125..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdsample.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdtrans.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdtrans.obj deleted file mode 100644 index 98ce998..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jdtrans.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jerror.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jerror.obj deleted file mode 100644 index 543ab46..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jerror.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctflt.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctflt.obj deleted file mode 100644 index 9a86617..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctflt.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctfst.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctfst.obj deleted file mode 100644 index dca0149..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctfst.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctint.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctint.obj deleted file mode 100644 index c03cc60..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jfdctint.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctflt.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctflt.obj deleted file mode 100644 index 0d0cc68..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctflt.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctfst.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctfst.obj deleted file mode 100644 index a237e99..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctfst.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctint.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctint.obj deleted file mode 100644 index 25fba0b..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctint.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctred.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctred.obj deleted file mode 100644 index 5ca86ac..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jidctred.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jmemmgr.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jmemmgr.obj deleted file mode 100644 index 2667f56..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jmemmgr.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jmemnobs.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jmemnobs.obj deleted file mode 100644 index 7860f54..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jmemnobs.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jquant1.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jquant1.obj deleted file mode 100644 index 5fa2e41..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jquant1.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jquant2.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jquant2.obj deleted file mode 100644 index 91adacb..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jquant2.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jutils.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jutils.obj deleted file mode 100644 index 84003fa..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/jutils.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/libtiffpack-win32.a b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/libtiffpack-win32.a deleted file mode 100644 index 0d3f9c6..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/libtiffpack-win32.a and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/libtiffpack-win64.a b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/libtiffpack-win64.a deleted file mode 100644 index e7899e7..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/libtiffpack-win64.a and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_aux.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_aux.obj deleted file mode 100644 index e98da55..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_aux.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_close.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_close.obj deleted file mode 100644 index b85ecdc..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_close.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_codec.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_codec.obj deleted file mode 100644 index 6963428..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_codec.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_color.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_color.obj deleted file mode 100644 index 26b2cd0..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_color.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_compress.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_compress.obj deleted file mode 100644 index 26a919a..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_compress.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dir.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dir.obj deleted file mode 100644 index 4282fee..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dir.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirinfo.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirinfo.obj deleted file mode 100644 index dcf31dc..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirinfo.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirread.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirread.obj deleted file mode 100644 index 2e3c2d3..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirread.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirwrite.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirwrite.obj deleted file mode 100644 index 687b5f0..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dirwrite.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dumpmode.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dumpmode.obj deleted file mode 100644 index 98dbf07..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_dumpmode.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_error.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_error.obj deleted file mode 100644 index 72ef9d5..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_error.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_extension.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_extension.obj deleted file mode 100644 index 717df59..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_extension.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_fax3.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_fax3.obj deleted file mode 100644 index 3818b96..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_fax3.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_fax3sm.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_fax3sm.obj deleted file mode 100644 index 806ecc7..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_fax3sm.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_flush.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_flush.obj deleted file mode 100644 index 2a4cfca..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_flush.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_getimage.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_getimage.obj deleted file mode 100644 index acd6476..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_getimage.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_jpeg.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_jpeg.obj deleted file mode 100644 index b7fb867..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_jpeg.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_luv.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_luv.obj deleted file mode 100644 index 2baa443..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_luv.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_lzw.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_lzw.obj deleted file mode 100644 index 6baebbb..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_lzw.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_next.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_next.obj deleted file mode 100644 index f241b30..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_next.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_ojpeg.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_ojpeg.obj deleted file mode 100644 index f460b3e..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_ojpeg.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_open.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_open.obj deleted file mode 100644 index 5731976..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_open.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_packbits.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_packbits.obj deleted file mode 100644 index 65f2b8b..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_packbits.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_pixarlog.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_pixarlog.obj deleted file mode 100644 index 34314f1..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_pixarlog.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_predict.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_predict.obj deleted file mode 100644 index 1a2d227..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_predict.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_print.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_print.obj deleted file mode 100644 index 3bdc51d..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_print.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_read.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_read.obj deleted file mode 100644 index 34546af..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_read.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_strip.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_strip.obj deleted file mode 100644 index 0fe67ce..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_strip.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_swab.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_swab.obj deleted file mode 100644 index 6da888d..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_swab.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_thunder.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_thunder.obj deleted file mode 100644 index d3909ab..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_thunder.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_tile.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_tile.obj deleted file mode 100644 index 1194a0f..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_tile.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_version.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_version.obj deleted file mode 100644 index 4b3920d..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_version.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_warning.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_warning.obj deleted file mode 100644 index 226c2e1..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_warning.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_write.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_write.obj deleted file mode 100644 index 7b22eb8..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_write.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_zip.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_zip.obj deleted file mode 100644 index cba16ef..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/tif_zip.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/trees.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/trees.obj deleted file mode 100644 index b0bf941..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/trees.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/uncompr.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/uncompr.obj deleted file mode 100644 index 2d22cbb..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/uncompr.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/zutil.obj b/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/zutil.obj deleted file mode 100644 index 5dc64c8..0000000 Binary files a/components/vampireimaging/Extras/Extensions/LibTiff/Compiled/zutil.obj and /dev/null differ diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/ImagingTiffLib.pas b/components/vampireimaging/Extras/Extensions/LibTiff/ImagingTiffLib.pas deleted file mode 100644 index c4c3dfa..0000000 --- a/components/vampireimaging/Extras/Extensions/LibTiff/ImagingTiffLib.pas +++ /dev/null @@ -1,668 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for TIFF images - using LibTiff C library compiled to object files or LibTiff DLL/SO. - - Supported platforms/compilers are now: - Win32 Delphi: obj, dll - Win64 Delphi: dll - Win32, Win64 FPC: obj, dll - Linux/Unix/macOS 32/64 FPC: dll -} -unit ImagingTiffLib; - -{$I ImagingOptions.inc} - -{$IF Defined(LINUX) or Defined(BSD) or Defined(MACOS)} - // Use LibTiff dynamic library in Linux/BSD instead of precompiled objects. - // It's installed on most systems so let's use it and keep the binary smaller. - // In macOS it's usually not installed but if it is let's use it. - {$DEFINE USE_DYN_LIB} -{$IFEND} - -{$IF Defined(DCC) and Defined(WIN64)} - // For Delphi Win64 target try to use LibTiff dynamic library. - {$DEFINE USE_DYN_LIB} -{$IFEND} - -{$IF Defined(POSIX) and Defined(CPUX64)} - // Workaround for problem on 64bit Linux where thandle_t in libtiff is - // still 32bit so it cannot be used to pass pointers (for IO functions). - {$DEFINE HANDLE_NOT_POINTER_SIZED} -{$IFEND} - -{.$DEFINE USE_DYN_LIB} - -interface - -uses - SysUtils, Imaging, ImagingTypes, ImagingUtility, ImagingIO, - ImagingTiff, -{$IFDEF USE_DYN_LIB} - LibTiffDynLib; -{$ELSE} - LibTiffDelphi; -{$ENDIF} - -type - { TIFF (Tag Image File Format) loader/saver class. Uses LibTiff so - it can handle most types of TIFF files.} - TTiffLibFileFormat = class(TBaseTiffFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: Integer): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - end; - -implementation - -const - TiffSupportedFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, - ifGray16, ifA16Gray16, ifGray32, ifR8G8B8, ifA8R8G8B8, ifR16G16B16, - ifA16R16G16B16, ifR32F, ifA32R32G32B32F, ifR16F, ifA16R16G16B16F, ifBinary]; - -type - TTiffIOWrapper = record - IO: TIOFunctions; - Handle: TImagingHandle; - end; - PTiffIOWrapper = ^TTiffIOWrapper; - -{$IFDEF HANDLE_NOT_POINTER_SIZED} -var - TiffIOWrapper: TTiffIOWrapper; -{$ENDIF} - -function GetTiffIOWrapper(Fd: THandle): PTiffIOWrapper; -begin -{$IFDEF HANDLE_NOT_POINTER_SIZED} - Result := @TiffIOWrapper; -{$ELSE} - Result := PTiffIOWrapper(Fd); -{$ENDIF} -end; - -function TIFFReadProc(Fd: THandle; Buffer: Pointer; Size: Integer): Integer; cdecl; -var - Wrapper: PTiffIOWrapper; -begin - Wrapper := GetTiffIOWrapper(Fd); - Result := Wrapper.IO.Read(Wrapper.Handle, Buffer, Size); -end; - -function TIFFWriteProc(Fd: THandle; Buffer: Pointer; Size: Integer): Integer; cdecl; -var - Wrapper: PTiffIOWrapper; -begin - Wrapper := GetTiffIOWrapper(Fd); - Result := Wrapper.IO.Write(Wrapper.Handle, Buffer, Size); -end; - -function TIFFSizeProc(Fd: THandle): toff_t; cdecl; -var - Wrapper: PTiffIOWrapper; -begin - Wrapper := GetTiffIOWrapper(Fd); - Result := ImagingIO.GetInputSize(Wrapper.IO, Wrapper.Handle); -end; - -function TIFFSeekProc(Fd: THandle; Offset: toff_t; Where: Integer): toff_t; cdecl; -const - SEEK_SET = 0; - SEEK_CUR = 1; - SEEK_END = 2; -var - Mode: TSeekMode; - Wrapper: PTiffIOWrapper; -begin - Wrapper := GetTiffIOWrapper(Fd); - if Offset = $FFFFFFFF then - begin - Result := $FFFFFFFF; - Exit; - end; - case Where of - SEEK_SET: Mode := smFromBeginning; - SEEK_CUR: Mode := smFromCurrent; - SEEK_END: Mode := smFromEnd; - else - Mode := smFromBeginning; - end; - Result := Wrapper.IO.Seek(Wrapper.Handle, Offset, Mode); -end; - -function TIFFCloseProc(Fd: THandle): Integer; cdecl; -begin - Result := 0; -end; - -function TIFFNoMapProc(Fd: THandle; Base: PPointer; Size: PCardinal): Integer; cdecl; -begin - Result := 0; -end; - -procedure TIFFNoUnmapProc(Fd: THandle; Base: Pointer; Size: Cardinal); cdecl; -begin -end; - -var - LastError: string = 'None'; - -procedure TIFFErrorHandler(const Module, Message: AnsiString); -begin - LastError := string(Module + ': ' + Message); -end; - -{ - TTiffFileFormat implementation -} - -procedure TTiffLibFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffSave, ffMultiImage]; - FSupportedFormats := TiffSupportedFormats; -end; - -function TTiffLibFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Tiff: PTIFF; - IOWrapper: TTiffIOWrapper; - I, Idx, TiffResult, ScanLineSize, NumDirectories, X: Integer; - RowsPerStrip: UInt32; - Orientation, BitsPerSample, SamplesPerPixel, Photometric, - PlanarConfig, SampleFormat: Word; - DataFormat: TImageFormat; - CanAccessScanlines: Boolean; - Ptr: PByte; - Red, Green, Blue: PWordRecArray; - - procedure LoadMetadata(Tiff: PTiff; TiffPage: Integer); - var - TiffResUnit, CompressionScheme: Word; - XRes, YRes: Single; - ResUnit: TResolutionUnit; - CompressionName: string; - begin - TIFFGetFieldDefaulted(Tiff, TIFFTAG_RESOLUTIONUNIT, @TiffResUnit); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_XRESOLUTION, @XRes); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_YRESOLUTION, @YRes); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_COMPRESSION, @CompressionScheme); - - FMetadata.SetMetaItem(SMetaTiffResolutionUnit, TiffResUnit); - - if (TiffResUnit <> RESUNIT_NONE) and (XRes >= 0.1) and (YRes >= 0.1) then - begin - ResUnit := ruDpi; - if TiffResUnit = RESUNIT_CENTIMETER then - ResUnit := ruDpcm; - FMetadata.SetPhysicalPixelSize(ResUnit, XRes, YRes, False, TiffPage); - end; - - case CompressionScheme of - COMPRESSION_NONE: CompressionName := 'None'; - COMPRESSION_LZW: CompressionName := 'LZW'; - COMPRESSION_JPEG: CompressionName := 'JPEG'; - COMPRESSION_PACKBITS: CompressionName := 'Packbits RLE'; - COMPRESSION_DEFLATE: CompressionName := 'Deflate'; - COMPRESSION_CCITTFAX4: CompressionName := 'CCITT Group 4 Fax'; - COMPRESSION_OJPEG: CompressionName := 'Old JPEG'; - COMPRESSION_CCITTRLE..COMPRESSION_CCITTFAX3: CompressionName := 'CCITT'; - else - CompressionName := 'Unknown'; - end; - - FMetadata.SetMetaItem(SMetaTiffCompressionName, CompressionName); - end; - -begin - Result := False; - SetUserMessageHandlers(TIFFErrorHandler, nil); - - // Set up IO wrapper and open TIFF - IOWrapper.IO := GetIO; - IOWrapper.Handle := Handle; -{$IFDEF HANDLE_NOT_POINTER_SIZED} - TiffIOWrapper := IOWrapper; -{$ENDIF} - - Tiff := TIFFClientOpen('LibTIFF', 'r', THandle(@IOWrapper), @TIFFReadProc, - @TIFFWriteProc, @TIFFSeekProc, @TIFFCloseProc, - @TIFFSizeProc, @TIFFNoMapProc, @TIFFNoUnmapProc); - - if Tiff <> nil then - TIFFSetFileNo(Tiff, THandle(@IOWrapper)) - else - Exit; - - NumDirectories := TIFFNumberOfDirectories(Tiff); - if OnlyFirstLevel then - NumDirectories := Min(1, NumDirectories); - - SetLength(Images, NumDirectories); - - for Idx := 0 to NumDirectories - 1 do - begin - TIFFSetDirectory(Tiff, Idx); - - // Set defaults for TIFF fields - DataFormat := ifUnknown; - - // Read some TIFF fields with basic image info - TIFFGetField(Tiff, TIFFTAG_IMAGEWIDTH, @Images[Idx].Width); - TIFFGetField(Tiff, TIFFTAG_IMAGELENGTH, @Images[Idx].Height); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_ORIENTATION, @Orientation); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_BITSPERSAMPLE, @BitsPerSample); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_SAMPLESPERPIXEL, @SamplesPerPixel); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_SAMPLEFORMAT, @SampleFormat); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_PHOTOMETRIC, @Photometric); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_PLANARCONFIG, @PlanarConfig); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_ROWSPERSTRIP, @RowsPerStrip); - - // Load supported metadata - LoadMetadata(Tiff, Idx); - // See if we can just copy scanlines from TIFF to Imaging image - CanAccessScanlines := (PlanarConfig = PLANARCONFIG_CONTIG) or (SamplesPerPixel = 1); - - if CanAccessScanlines then - begin - // We can copy scanlines so we try to find data format that best matches - // TIFFs internal data format - if (Photometric = PHOTOMETRIC_MINISBLACK) or (Photometric = PHOTOMETRIC_MINISWHITE) then - begin - if SampleFormat = SAMPLEFORMAT_UINT then - begin - case BitsPerSample of - 1: - if SamplesPerPixel = 1 then - DataFormat := ifBinary; - 8: - case SamplesPerPixel of - 1: DataFormat := ifGray8; - 2: DataFormat := ifA8Gray8; - end; - 16: - case SamplesPerPixel of - 1: DataFormat := ifGray16; - 2: DataFormat := ifA16Gray16; - end; - 32: - if SamplesPerPixel = 1 then - DataFormat := ifGray32; - end; - end - else if SampleFormat = SAMPLEFORMAT_IEEEFP then - begin - case BitsPerSample of - 16: - if SamplesPerPixel = 1 then - DataFormat := ifR16F; - 32: - if SamplesPerPixel = 1 then - DataFormat := ifR32F; - end; - end; - end - else if Photometric = PHOTOMETRIC_RGB then - begin - if SampleFormat = SAMPLEFORMAT_UINT then - begin - case BitsPerSample of - 8: - case SamplesPerPixel of - 3: DataFormat := ifR8G8B8; - 4: DataFormat := ifA8R8G8B8; - end; - 16: - case SamplesPerPixel of - 3: DataFormat := ifR16G16B16; - 4: DataFormat := ifA16R16G16B16; - end; - end; - end - else if SampleFormat = SAMPLEFORMAT_IEEEFP then - begin - case BitsPerSample of - 16: - if SamplesPerPixel = 4 then - DataFormat := ifA16R16G16B16F; - 32: - if SamplesPerPixel = 4 then - DataFormat := ifA32R32G32B32F; - end; - end; - end - else if Photometric = PHOTOMETRIC_PALETTE then - begin - if (SamplesPerPixel = 1) and (SampleFormat = SAMPLEFORMAT_UINT) and (BitsPerSample = 8) then - DataFormat := ifIndex8 - end; - end; - - if DataFormat = ifUnknown then - begin - // Use RGBA interface to read A8R8G8B8 TIFFs and mainly TIFFs in various - // formats with no Imaging equivalent, exotic color spaces etc. - NewImage(Images[Idx].Width, Images[Idx].Height, ifA8R8G8B8, Images[Idx]); - TiffResult := TIFFReadRGBAImageOriented(Tiff, Images[Idx].Width, Images[Idx].Height, - Images[Idx].Bits, Orientation, 0); - if TiffResult = 0 then - RaiseImaging(LastError, []); - // Swap Red and Blue, if YCbCr. - if Photometric=PHOTOMETRIC_YCBCR then - SwapChannels(Images[Idx], ChannelRed, ChannelBlue); - end - else - begin - // Create new image in given format and read scanlines from TIFF, - // read palette too if needed - NewImage(Images[Idx].Width, Images[Idx].Height, DataFormat, Images[Idx]); - ScanLineSize := TIFFScanlineSize(Tiff); - - for I := 0 to Images[Idx].Height - 1 do - TIFFReadScanline(Tiff, @PByteArray(Images[Idx].Bits)[I * ScanLineSize], I, 0); - - if DataFormat = ifIndex8 then - begin - TIFFGetField(Tiff, TIFFTAG_COLORMAP, @Red, @Green, @Blue); - for I := 0 to 255 do - with Images[Idx].Palette[I] do - begin - A := 255; - R := Red[I].High; - G := Green[I].High; - B := Blue[I].High; - end; - end; - - // TIFF uses BGR order so we must swap it (but not images we got - // from TiffLib RGBA interface) - if Photometric = PHOTOMETRIC_RGB then - SwapChannels(Images[Idx], ChannelRed, ChannelBlue); - - // We need to negate 'MinIsWhite' formats to get common grayscale - // formats where min sample value is black - if Photometric = PHOTOMETRIC_MINISWHITE then - for I := 0 to Images[Idx].Height - 1 do - begin - Ptr := @PByteArray(Images[Idx].Bits)[I * ScanLineSize]; - for X := 0 to ScanLineSize - 1 do - begin - Ptr^ := not Ptr^; - Inc(Ptr); - end; - end; - end; - end; - - TIFFClose(Tiff); - Result := True; -end; - -function TTiffLibFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -const - Compressions: array[0..5] of Word = (COMPRESSION_NONE, COMPRESSION_LZW, - COMPRESSION_PACKBITS, COMPRESSION_DEFLATE, COMPRESSION_JPEG, COMPRESSION_CCITTFAX4); -var - Tiff: PTIFF; - IOWrapper: TTiffIOWrapper; - I, J, ScanLineSize: Integer; - ImageToSave: TImageData; - MustBeFreed: Boolean; - Info: TImageFormatInfo; - Orientation, BitsPerSample, SamplesPerPixel, Photometric, - PlanarConfig, SampleFormat, CompressionScheme: Word; - RowsPerStrip: UInt32; - Red, Green, Blue: array[Byte] of TWordRec; - CompressionMismatch: Boolean; - OpenMode: PAnsiChar; - - procedure SaveMetadata(Tiff: PTiff; TiffPage: Integer); - var - XRes, YRes: Single; - ResUnit: TResolutionUnit; - TiffResUnit, StoredTiffResUnit: Word; - begin - XRes := -1; - YRes := -1; - - ResUnit := ruDpcm; - TiffResUnit := RESUNIT_CENTIMETER; - - if FMetadata.HasMetaItemForSaving(SMetaTiffResolutionUnit) then - begin - // Check if DPI resolution unit is requested to be used (e.g. to - // use the same unit when just resaving files - also some ) - StoredTiffResUnit := FMetadata.MetaItemsForSaving[SMetaTiffResolutionUnit]; - if StoredTiffResUnit = RESUNIT_INCH then - begin - ResUnit := ruDpi; - TiffResUnit := RESUNIT_INCH; - end; - end; - - // First try to find phys. size for current TIFF page index. If not found then - // try size for main image (index 0). - if not FMetadata.GetPhysicalPixelSize(ResUnit, XRes, YRes, True, TiffPage) then - FMetadata.GetPhysicalPixelSize(ResUnit, XRes, YRes, True, 0); - - if (XRes > 0) and (YRes > 0) then - begin - TIFFSetField(Tiff, TIFFTAG_RESOLUTIONUNIT, TiffResUnit); - TIFFSetField(Tiff, TIFFTAG_XRESOLUTION, XRes); - TIFFSetField(Tiff, TIFFTAG_YRESOLUTION, YRes); - end; - end; - -begin - Result := False; - SetUserMessageHandlers(TIFFErrorHandler, nil); - - if not (FCompression in [0..5]) then - FCompression := COMPRESSION_LZW; - - // Set up IO wrapper and open TIFF - IOWrapper.IO := GetIO; - IOWrapper.Handle := Handle; -{$IFDEF HANDLE_NOT_POINTER_SIZED} - TiffIOWrapper := IOWrapper; -{$ENDIF} - - OpenMode := 'w'; - - Tiff := TIFFClientOpen('LibTIFF', OpenMode, THandle(@IOWrapper), @TIFFReadProc, - @TIFFWriteProc, @TIFFSeekProc, @TIFFCloseProc, - @TIFFSizeProc, @TIFFNoMapProc, @TIFFNoUnmapProc); - - if Tiff <> nil then - TIFFSetFileNo(Tiff, THandle(@IOWrapper)) - else - Exit; - - for I := FFirstIdx to FLastIdx do - begin - if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - GetImageFormatInfo(Format, Info); - - // Set Tag values - Orientation := ORIENTATION_TOPLEFT; - BitsPerSample := Info.BytesPerPixel div Info.ChannelCount * 8; - if Info.Format = ifBinary then - BitsPerSample := 1; - SamplesPerPixel := Info.ChannelCount; - SampleFormat := Iff(not Info.IsFloatingPoint, SAMPLEFORMAT_UINT, SAMPLEFORMAT_IEEEFP); - PlanarConfig := PLANARCONFIG_CONTIG; - CompressionScheme := Compressions[FCompression]; - - // Check if selected compression scheme can be used for current image - CompressionMismatch := (CompressionScheme = COMPRESSION_JPEG) and ((BitsPerSample <> 8) or - not (SamplesPerPixel in [1, 3]) or Info.IsIndexed or Info.IsFloatingPoint); - CompressionMismatch := CompressionMismatch or ((CompressionScheme = COMPRESSION_CCITTFAX4) and (Info.Format <> ifBinary)); - if CompressionMismatch then - CompressionScheme := COMPRESSION_LZW; - // If we have some compression scheme selected and it's not Fax then select it automatically - better comp ratios! - if (Info.Format = ifBinary) and (CompressionScheme <> COMPRESSION_NONE) and (CompressionScheme <> COMPRESSION_CCITTFAX4) then - CompressionScheme := COMPRESSION_CCITTFAX4; - - RowsPerStrip := TIFFDefaultStripSize(Tiff, Height); - if Info.IsIndexed then - Photometric := PHOTOMETRIC_PALETTE - else if (Info.HasGrayChannel) or (Info.ChannelCount = 1) then - Photometric := PHOTOMETRIC_MINISBLACK - else - Photometric := PHOTOMETRIC_RGB; - - // Write tags - TIFFSetField(Tiff, TIFFTAG_IMAGEWIDTH, Width); - TIFFSetField(Tiff, TIFFTAG_IMAGELENGTH, Height); - TIFFSetField(Tiff, TIFFTAG_PHOTOMETRIC, Photometric); - TIFFSetField(Tiff, TIFFTAG_PLANARCONFIG, PlanarConfig); - TIFFSetField(Tiff, TIFFTAG_ORIENTATION, Orientation); - TIFFSetField(Tiff, TIFFTAG_BITSPERSAMPLE, BitsPerSample); - TIFFSetField(Tiff, TIFFTAG_SAMPLESPERPIXEL, SamplesPerPixel); - TIFFSetField(Tiff, TIFFTAG_SAMPLEFORMAT, SampleFormat); - TIFFSetField(Tiff, TIFFTAG_COMPRESSION, CompressionScheme); - if CompressionScheme = COMPRESSION_JPEG then - TIFFSetField(Tiff, TIFFTAG_JPEGQUALITY, FJpegQuality); - TIFFSetField(Tiff, TIFFTAG_ROWSPERSTRIP, RowsPerStrip); - // Save supported metadata - SaveMetadata(Tiff, I); - - if Format = ifIndex8 then - begin - // Set paletee for indexed images - for J := 0 to 255 do - with ImageToSave.Palette[J] do - begin - Red[J].High := R; - Green[J].High := G; - Blue[J].High := B; - end; - TIFFSetField(Tiff, TIFFTAG_COLORMAP, @Red[0], @Green[0], @Blue[0]); - end; - - ScanLineSize := Info.GetPixelsSize(Info.Format, Width, 1); - - if Photometric = PHOTOMETRIC_RGB then - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); - // Write image scanlines and then directory for current image - for J := 0 to Height - 1 do - TIFFWriteScanline(Tiff, @PByteArray(Bits)[J * ScanLineSize], J, 0); - if Info.ChannelCount > 1 then - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); - - TIFFWriteDirectory(Tiff); - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; - end; - - TIFFClose(Tiff); - Result := True; -end; - -procedure TTiffLibFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.RBSwapFormat in GetSupportedFormats then - ConvFormat := Info.RBSwapFormat - else if Info.IsFloatingPoint then - ConvFormat := IffFormat(Info.ChannelCount = 1, ifR32F, ifA32R32G32B32F) - else if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray32) - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(Image, ConvFormat); -end; - -initialization -{$IFDEF USE_DYN_LIB} - // If using dynamic library only register the format if - // the library loads successfully. - if LibTiffDynLib.LoadTiffLibrary then -{$ENDIF} - RegisterImageFileFormat(TTiffLibFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.3 ---------------------------------------------------- - - Lot more platforms than just 32bit Delphi supported now. - - Workaround for problem on 64bit Linux where thandle_t in libtiff is - still 32bit so it cannot be used to pass pointers (for IO functions). - - Support for libtiff as DLL/SO instead of linking object files to exe. - Useful for platforms like Linux where libtiff is already installed - most of the time (and exe could be make smaller not linking the objects). - - Removed problematic append mode. - - Renamed and refactored to be based on common Tiff base class - (for shared stuff between other Tiff implementations (WIC, Quartz)). - - -- 0.77.1 ---------------------------------------------------- - - Renamed unit to ImagingLibTiffDelphi since there will be more - Tiff implementations in the future, cleaned up interface units - and obj file a little bit. - - Updated LibTiff to version 3.9.4 and added EXIF tag support. - - Added TIFF Append mode: when saving existing files are not - overwritten but images are appended to TIFF instead. - - Images in ifBinary format are now supported for loading/saving - (optional Group 4 fax encoding added). - - PHOTOMETRIC_MINISWHITE is now properly read as Grayscale/Binary - instead of using unefficient RGBA interface. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Fix: All pages of multipage TIFF were loaded even when - OnlyFirstLevel was True. - - Loading and saving of physical resolution metadata. - - Unicode compatibility fixes in LibTiffDelphi. - - Added Jpeg compression quality setting. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Fixed bug in loading and saving of 2 channel images - Imaging - tried to swap R and B channels here. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added TIFF loading and saving. - - Unit created and initial code added. -} - -end. diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/LibDelphi.pas b/components/vampireimaging/Extras/Extensions/LibTiff/LibDelphi.pas deleted file mode 100644 index 9415520..0000000 --- a/components/vampireimaging/Extras/Extensions/LibTiff/LibDelphi.pas +++ /dev/null @@ -1,214 +0,0 @@ -unit LibDelphi; - -{$ifdef FPC} - {$MODE OBJFPC} -{$endif} - -interface - -uses - SysUtils; - -type - va_list = Pointer; - -{$IFNDEF FPC} -{$IF CompilerVersion <= 18.5} - SizeInt = Integer; - PtrUInt = Cardinal; -{$ELSE} - SizeInt = NativeInt; - PtrUInt = NativeUInt; -{$IFEND} -{$ENDIF} - -const -{$IFDEF MSWINDOWS} - SRuntimeLib = 'msvcrt.dll'; -{$ELSE} - SRuntimeLib = 'libc.so'; -{$ENDIF} - -function fprintf(stream: Pointer; format: Pointer; arguments: va_list): Integer; cdecl; {$ifdef FPC}[public];{$endif} -function sprintf(buffer: Pointer; format: Pointer; arguments: va_list): Integer; cdecl; {$ifdef FPC}[public];{$endif} -function snprintf(buffer: Pointer; n: Integer; format: Pointer; arguments: va_list): Integer; cdecl; {$ifdef FPC}[public];{$endif} -function fputs(s: Pointer; stream: Pointer): Integer; cdecl; external SRuntimeLib; -function fputc(c: Integer; stream: Pointer): Integer; cdecl; external SRuntimeLib; -function isprint(c: Integer): Integer; cdecl; external SRuntimeLib; -procedure memset(a: Pointer; b: Integer; c: SizeInt); cdecl; {$ifdef FPC}[public];{$endif} -function memcpy(dest: Pointer; const src: Pointer; count: SizeInt): Pointer; cdecl; {$ifdef FPC}[public];{$endif} -function memcmp(a, b: Pointer; c:SizeInt):Integer; cdecl; {$ifdef FPC}[public];{$endif} -function malloc(s: Longint): Pointer; cdecl; {$ifdef FPC}[public];{$endif} -procedure free(p: Pointer); cdecl; {$ifdef FPC}[public];{$endif} -{$ifndef FPC} -function _ftol: Integer; cdecl; external SRuntimeLib; -function _ltolower(ch: Integer): Integer; cdecl; external SRuntimeLib; -function _ltoupper(ch: Integer): Integer; cdecl; external SRuntimeLib; -function _ltowlower(ch: Integer): Integer; cdecl; external SRuntimeLib; -function _ltowupper(ch: Integer): Integer; cdecl; external SRuntimeLib; -function fwrite(ptr:pointer; size, count:SizeInt; stream:pointer ):SizeInt; cdecl; external SRuntimeLib; -{$endif} -function strcpy(dest: Pointer; src: Pointer): Pointer; cdecl; {$ifdef FPC}[public];{$endif} - -{$ifdef FPC} -function fwrite(ptr:pointer; size, count:SizeInt; stream:pointer ):SizeInt; cdecl; {$ifdef FPC}[public];{$endif} -function __udivdi3(a,b:int64):int64; cdecl; [public]; -function {$ifdef CPUX86}_imp__isprint{$else}__imp_isprint{$endif}(c: char): integer; cdecl; [public]; -{$endif} - -{$ifndef FPC} -var - __turboFloat: LongBool = False; - _streams: Integer; - -{$else} -type - // from mingw - stdio.h - cIoBuf = record - _ptr:Pointer; - _cnt:LongInt; - _base:Pointer; - _flag:LongInt; - _file:LongInt; - _charbuf:LongInt; - _bufsiz:LongInt; - _tmpfname:Pointer; - end; - pIoBuf = ^cIoBuf; - -var - _imp___iob:array[0..2] of cIoBuf; cvar; // stdin,stdout,stderr - iob:pIoBuf; cvar; -{$endif} - -implementation - -{$ifndef FPC} -uses - Windows; -{$endif} - -{$ifdef FPC} -function __udivdi3(a, b: int64): int64; cdecl; -begin - Result:=a div b; -end; -function {$ifdef CPUX86}_imp__isprint{$else}__imp_isprint{$endif}(c: char): integer; cdecl; -begin - if (c>=#32)and(c<=#127) then - Result:=1 - else - Result:=0; -end; -{$endif} - -procedure free(p: Pointer); cdecl; -begin - FreeMem(p); -end; - -function malloc(s: Longint): Pointer; cdecl; -begin - Result := AllocMem(s); -end; - -function memcpy(dest: Pointer; const src: Pointer; count: SizeInt): Pointer; cdecl; -begin - system.Move(src^,dest^,count); - Result:=dest; -end; - -procedure memset(a: Pointer; b: Integer; c: SizeInt); cdecl; -begin - system.FillChar(a^,c,b); -end; - -function memcmp(a, b: Pointer; c: SizeInt): Integer; cdecl; {$ifdef FPC}[public];{$endif} -{$ifndef FPC} -var - ma,mb: PByte; - n: Integer; -begin - ma:=a; - mb:=b; - n:=0; - while Cardinal(n)mb^ then - begin - if ma^ next byte to write in buffer } - FreeInBuffer: Cardinal; { # of byte spaces remaining in buffer } - InitDestination: TJpegInitDestination; - EmptyOutputBuffer: TJpegEmptyOutputBuffer; - TermDestination: TJpegTermDestination; - end; - - TJpegInitSource = procedure(cinfo: PRJpegDecompressStruct); cdecl; - TJpegFillInputBuffer = function(cinfo: PRJpegDecompressStruct): Boolean; cdecl; - TJpegSkipInputData = procedure(cinfo: PRJpegDecompressStruct; NumBytes: Integer); cdecl; - TJpegResyncToRestart = function(cinfo: PRJpegDecompressStruct; Desired: Integer): Boolean; cdecl; - TJpegTermSource = procedure(cinfo: PRJpegDecompressStruct); cdecl; - - RJpegSourceMgr = record - NextInputByte: Pointer; - BytesInBuffer: Cardinal; - InitSource: TJpegInitSource; - FillInputBuffer: TJpegFillInputBuffer; - SkipInputData: TJpegSkipInputData; - ResyncToRestart: TJpegResyncToRestart; - TermSource: TJpegTermSource; - end; - - RJpegComponentInfo = record - { Basic info about one component (color channel). } - { These values are fixed over the whole image. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOF marker. } - ComponentId: Integer; { identifier for this component (0..255) } - ComponentIndex: Integer; { its index in SOF or cinfo->comp_info[] } - HSampFactor: Integer; { horizontal sampling factor (1..4) } - VSampFactor: Integer; { vertical sampling factor (1..4) } - QuantTblNo: Integer; { quantization table selector (0..3) } - { These values may vary between scans. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOS marker. } - { The decompressor output side may not use these variables. } - DcTblNo: Integer; { DC entropy table selector (0..3) } - AsTblNo: Integer; { AC entropy table selector (0..3) } - { Remaining fields should be treated as private by applications. } - { These values are computed during compression or decompression startup: } - { Component's size in DCT blocks. Any dummy blocks added to complete an MCU are not counted; therefore these values do not depend - on whether a scan is interleaved or not. } - WidthInBlocks: Cardinal; - HeightInBlocks: Cardinal; - { Size of a DCT block in samples. Always DCTSIZE for compression. For decompression this is the size of the output from one DCT - block, reflecting any scaling we choose to apply during the IDCT step. Values of 1,2,4,8 are likely to be supported. Note that - different components may receive different IDCT scalings. } - DctScaledSize: Integer; - { The downsampled dimensions are the component's actual, unpadded number of samples at the main buffer (preprocessing/compression - interface), thus downsampled_width = ceil(image_width * Hi/Hmax) and similarly for height. For decompression, IDCT scaling is - included, so downsampled_width = ceil(image_width * Hi/Hmax * DCT_scaled_size/DCTSIZE) } - DownsampledWidth: Cardinal; { actual width in samples } - DownsampledHeight: Cardinal; { actual height in samples } - { This flag is used only for decompression. In cases where some of the components will be ignored (eg grayscale output from YCbCr - image), we can skip most computations for the unused components. } - ComponentNeeded: Boolean; { do we need the value of this component? } - { These values are computed before starting a scan of the component. } - { The decompressor output side may not use these variables. } - McuWidth: Integer; { number of blocks per MCU, horizontally } - McuHeight: Integer; { number of blocks per MCU, vertically } - McuBlocks: Integer; { MCU_width * MCU_height } - McuSampleWidth: Integer; { MCU width in samples, MCU_width*DCT_scaled_size } - LastColWidth: Integer; { # of non-dummy blocks across in last MCU } - LastRowHeight: Integer; { # of non-dummy blocks down in last MCU } - { Saved quantization table for component; NULL if none yet saved. See jdinput.c comments about the need for this information. This - field is currently used only for decompression. } - QuantTable: PRJpegQuantTbl; - { Private per-component storage for DCT or IDCT subsystem. } - DctTable: Pointer; - end; - - RJpegCommonStruct = record - Err: PRJpegErrorMgr; { Error handler module } - Mem: PRJpegMemoryMgr; { Memory manager module } - Progress: PRJpegProgressMgr; { Progress monitor, or NULL if none } - ClientData: Pointer; { Available for use by application } - IsDecompressor: Boolean; { So common code can tell which is which } - GlobalState: Integer; { For checking call sequence validity } - end; - - RJpegCompressStruct = record - Err: PRJpegErrorMgr; { Error handler module } - Mem: PRJpegMemoryMgr; { Memory manager module } - Progress: PRJpegProgressMgr; { Progress monitor, or NULL if none } - ClientData: Pointer; { Available for use by application } - IsDecompressor: Boolean; { So common code can tell which is which } - GlobalState: Integer; { For checking call sequence validity } - { Destination for compressed data } - Dest: PRJpegDestinationMgr; - { Description of source image --- these fields must be filled in by outer application before starting compression. - in_color_space must be correct before you can even call jpeg_set_defaults(). } - ImageWidth: Cardinal; { input image width } - ImageHeight: Cardinal; { input image height } - InputComponents: Integer; { # of color components in input image } - InColorSpace: Integer; { colorspace of input image } - InputGamme: Double; { image gamma of input image } - { Compression parameters --- these fields must be set before calling jpeg_start_compress(). We recommend calling - jpeg_set_defaults() to initialize everything to reasonable defaults, then changing anything the application specifically wants - to change. That way you won't get burnt when new parameters are added. Also note that there are several helper routines to - simplify changing parameters. } - DataPrecision: Integer; { bits of precision in image data } - NumComponents: Integer; { # of color components in JPEG image } - JpegColorSpace: Integer; { colorspace of JPEG image } - CompInfo: PRJpegComponentInfo; { comp_info[i] describes component that appears i'th in SOF } - QuantTblPtrs: array[0..NUM_QUANT_TBLS-1] of PRJpegQuantTbl; {ptrs to coefficient quantization tables, or NULL if not defined } - DcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of PRJpegHuffTbl; {ptrs to Huffman coding tables, or NULL if not defined } - AcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of PRJpegHuffTbl; - ArithDcL: array[0..NUM_ARITH_TBLS-1] of Byte; { L values for DC arith-coding tables } - ArithDcU: array[0..NUM_ARITH_TBLS-1] of Byte; { U values for DC arith-coding tables } - ArithAcK: array[0..NUM_ARITH_TBLS-1] of Byte; { Kx values for AC arith-coding tables } - NumScans: Integer; { # of entries in scan_info array } - ScanInfo: PRJpegScanInfo; { script for multi-scan file, or NULL } - { The default value of scan_info is NULL, which causes a single-scan sequential JPEG file to be emitted. To create a multi-scan - file, set num_scans and scan_info to point to an array of scan definitions. } - RawDataIn: Boolean; { TRUE=caller supplies downsampled data } - ArithCode: Boolean; { TRUE=arithmetic coding, FALSE=Huffman } - OptimizeCoding: Boolean; { TRUE=optimize entropy encoding parms } - CCIR601Sampling: Boolean; { TRUE=first samples are cosited } - SmoothingFactor: Integer; { 1..100, or 0 for no input smoothing } - DctMethod: Integer; { DCT algorithm selector } - { The restart interval can be specified in absolute MCUs by setting restart_interval, or in MCU rows by setting restart_in_rows - (in which case the correct restart_interval will be figured for each scan). } - RestartInterval: Cardinal; { MCUs per restart, or 0 for no restart } - RestartInRows: Integer; { if > 0, MCU rows per restart interval } - { Parameters controlling emission of special markers. } - WriteJfifHeader: Boolean; { should a JFIF marker be written? } - JfifMajorVersion: Byte; { What to write for the JFIF version number } - JFifMinorVersion: Byte; - { These three values are not used by the JPEG code, merely copied into the JFIF APP0 marker. density_unit can be 0 for unknown, - 1 for dots/inch, or 2 for dots/cm. Note that the pixel aspect ratio is defined by X_density/Y_density even when density_unit=0. } - DensityUnit: Byte; { JFIF code for pixel size units } - XDensity: Word; { Horizontal pixel density } - YDensity: WOrd; { Vertical pixel density } - WriteAdobeMarker: Boolean; { should an Adobe marker be written? } - { State variable: index of next scanline to be written to jpeg_write_scanlines(). Application may use this to control its - processing loop, e.g., "while (next_scanline < image_height)". } - NextScanline: Cardinal; { 0 .. image_height-1 } - { Remaining fields are known throughout compressor, but generally should not be touched by a surrounding application. } - { These fields are computed during compression startup } - ProgressiveMode: Boolean; { TRUE if scan script uses progressive mode } - MaxHSampFactor: Integer; { largest h_samp_factor } - MaxVSampFactor: Integer; { largest v_samp_factor } - TotalIMCURows: Cardinal; { # of iMCU rows to be input to coef ctlr } - { The coefficient controller receives data in units of MCU rows as defined for fully interleaved scans (whether the JPEG file is - interleaved or not). There are v_samp_factor * DCTSIZE sample rows of each component in an "iMCU" (interleaved MCU) row. } - { These fields are valid during any one scan. They describe the components and MCUs actually appearing in the scan. } - CompsInScan: Integer; { # of JPEG components in this scan } - CurCompInfo: array[0..MAX_COMPS_IN_SCAN-1] of PRJpegComponentInfo; - { *cur_comp_info[i] describes component that appears i'th in SOS } - MCUsPerRow: Cardinal; { # of MCUs across the image } - MCUsRowsInScan: Cardinal; { # of MCU rows in the image } - BlocksInMcu: Integer; { # of DCT blocks per MCU } - MCUMembership: array[0..C_MAX_BLOCKS_IN_MCU-1] of Integer; - { MCU_membership[i] is index in cur_comp_info of component owning i'th block in an MCU } - Ss,Se,Ah,Al: Integer; { progressive JPEG parameters for scan } - { Links to compression subobjects (methods and private variables of modules) } - Master: PRJpegCompMaster; - Main: PRJpegCMainController; - Prep: PRJpegCPrepController; - Coef: PRJpegCCoefController; - Marker: PRJpegMarkerWriter; - CConvert: PRJpegColorConverter; - Downsample: PRJpegDownsampler; - FDct: PRJpegForwardDct; - Entropy: PRJpegEntropyEncoder; - ScriptSpace: PRJpegScanInfo; { workspace for jpeg_simple_progression } - ScriptSpaceSize: Integer; - end; - - RJpegDecompressStruct = record - { Fields shared with jpeg_compress_struct } - Err: PRJpegErrorMgr; { Error handler module } - Mem: PRJpegMemoryMgr; { Memory manager module } - Progress: PRJpegProgressMgr; { Progress monitor, or NULL if none } - ClientData: Pointer; { Available for use by application } - IsDecompressor: Boolean; { So common code can tell which is which } - GlobalState: Integer; { For checking call sequence validity } - { Source of compressed data } - Src: PRJpegSourceMgr; - { Basic description of image --- filled in by jpeg_read_header(). } - { Application may inspect these values to decide how to process image. } - ImageWidth: Cardinal; { nominal image width (from SOF marker) } - ImageHeight: Cardinal; { nominal image height } - NumComponents: Integer; { # of color components in JPEG image } - JpegColorSpace: Integer; { colorspace of JPEG image } - { Decompression processing parameters --- these fields must be set before calling jpeg_start_decompress(). Note that - jpeg_read_header() initializes them to default values. } - OutColorSpace: Integer; { colorspace for output } - ScaleNum,ScaleDenom: Cardinal; { fraction by which to scale image } - OutputGamme: Double; { image gamma wanted in output } - BufferedImage: Boolean; { TRUE=multiple output passes } - RawDataOut: Boolean; { TRUE=downsampled data wanted } - DctMethod: Integer; { IDCT algorithm selector } - DoFancyUpsampling: Boolean; { TRUE=apply fancy upsampling } - DoBlockSmoothing: Boolean; { TRUE=apply interblock smoothing } - QuantizeColors: Boolean; { TRUE=colormapped output wanted } - { the following are ignored if not quantize_colors: } - DitherMode: Integer; { type of color dithering to use } - TwoPassQuantize: Boolean; { TRUE=use two-pass color quantization } - DesiredNumberOfColors: Integer;{ max # colors to use in created colormap } - { these are significant only in buffered-image mode: } - Enable1PassQuant: Boolean; { enable future use of 1-pass quantizer } - EnableExternalQuant: Boolean; { enable future use of external colormap } - Enable2PassQuant: Boolean; { enable future use of 2-pass quantizer } - { Description of actual output image that will be returned to application. These fields are computed by jpeg_start_decompress(). - You can also use jpeg_calc_output_dimensions() to determine these values in advance of calling jpeg_start_decompress(). } - OutputWidth: Cardinal; { scaled image width } - OutputHeight: Cardinal; { scaled image height } - OutColorComponents: Integer; { # of color components in out_color_space } - OutputComponents: Integer; { # of color components returned } - { output_components is 1 (a colormap index) when quantizing colors; otherwise it equals out_color_components. } - RecOutbufHeight: Integer; { min recommended height of scanline buffer } - { If the buffer passed to jpeg_read_scanlines() is less than this many rows high, space and time will be wasted due to unnecessary - data copying. Usually rec_outbuf_height will be 1 or 2, at most 4. } - { When quantizing colors, the output colormap is described by these fields. The application can supply a colormap by setting - colormap non-NULL before calling jpeg_start_decompress; otherwise a colormap is created during jpeg_start_decompress or - jpeg_start_output. The map has out_color_components rows and actual_number_of_colors columns. } - ActualNumberOfColors: Integer; { number of entries in use } - Colormap: Pointer; { The color map as a 2-D pixel array } - { State variables: these variables indicate the progress of decompression. The application may examine these but must not modify - them. } - { Row index of next scanline to be read from jpeg_read_scanlines(). Application may use this to control its processing loop, e.g., - "while (output_scanline < output_height)". } - OutputScanline: Cardinal; { 0 .. output_height-1 } - { Current input scan number and number of iMCU rows completed in scan. These indicate the progress of the decompressor input side. } - InputScanNumber: Integer; { Number of SOS markers seen so far } - InputIMcuRow: Cardinal; { Number of iMCU rows completed } - { The "output scan number" is the notional scan being displayed by the output side. The decompressor will not allow output - scan/row number to get ahead of input scan/row, but it can fall arbitrarily far behind. } - OutputScanNumber: Integer; { Nominal scan number being displayed } - OutputIMcuRow: Cardinal; { Number of iMCU rows read } - { Current progression status. coef_bits[c][i] indicates the precision with which component c's DCT coefficient i (in zigzag order) - is known. It is -1 when no data has yet been received, otherwise it is the point transform (shift) value for the most recent scan - of the coefficient (thus, 0 at completion of the progression). This pointer is NULL when reading a non-progressive file. } - CoefBits: Pointer; { -1 or current Al value for each coef } - { Internal JPEG parameters --- the application usually need not look at these fields. Note that the decompressor output side may - not use any parameters that can change between scans. } - { Quantization and Huffman tables are carried forward across input datastreams when processing abbreviated JPEG datastreams. } - QuantTblPtrs: array[0..NUM_QUANT_TBLS-1] of Pointer; - { ptrs to coefficient quantization tables, or NULL if not defined } - DcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of Pointer; - AcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of Pointer; - { ptrs to Huffman coding tables, or NULL if not defined } - { These parameters are never carried across datastreams, since they are given in SOF/SOS markers or defined to be reset by SOI. } - DataPrecision: Integer; { bits of precision in image data } - CompInfo: PRJpegComponentInfo; { comp_info[i] describes component that appears i'th in SOF } - ProgressiveMode: Boolean; { TRUE if SOFn specifies progressive mode } - ArithCode: Boolean; { TRUE=arithmetic coding, FALSE=Huffman } - ArithDcL: array[0..NUM_ARITH_TBLS-1] of Byte; { L values for DC arith-coding tables } - ArithDcY: array[0..NUM_ARITH_TBLS-1] of Byte; { U values for DC arith-coding tables } - ArithAcK: array[0..NUM_ARITH_TBLS-1] of Byte; { Kx values for AC arith-coding tables } - RestartInterval: Cardinal; { MCUs per restart interval, or 0 for no restart } - { These fields record data obtained from optional markers recognized by the JPEG library. } - SawJfifMarker: Boolean; { TRUE iff a JFIF APP0 marker was found } - { Data copied from JFIF marker; only valid if saw_JFIF_marker is TRUE: } - JfifMajorVersion: Byte; { JFIF version number } - JfifMinorVersion: Byte; { JFIF code for pixel size units } - XDensity: Word; { Horizontal pixel density } - YDensity: Word; { Vertical pixel density } - SawAdobeMarker: Boolean; { TRUE iff an Adobe APP14 marker was found } - AdobeTransform: Byte; { Color transform code from Adobe marker } - Ccir601Sampling: Boolean; { TRUE=first samples are cosited } - { Aside from the specific data retained from APPn markers known to the library, the uninterpreted contents of any or all APPn and - COM markers can be saved in a list for examination by the application. } - MarkerList: PRJpegSavedMarker; { Head of list of saved markers } - { Remaining fields are known throughout decompressor, but generally should not be touched by a surrounding application. } - { These fields are computed during decompression startup } - MaxHSampFactor: Integer; { largest h_samp_factor } - MaxVSampFactor: Integer; { largest v_samp_factor } - MinDctScaledSize: Integer; { smallest DCT_scaled_size of any component } - TotalIMcuRows: Cardinal; { # of iMCU rows in image } - { The coefficient controller's input and output progress is measured in units of "iMCU" (interleaved MCU) rows. These are the same - as MCU rows in fully interleaved JPEG scans, but are used whether the scan is interleaved or not. We define an iMCU row as - v_samp_factor DCT block rows of each component. Therefore, the IDCT output contains v_samp_factor*DCT_scaled_size sample rows - of a component per iMCU row. } - SampleRangeLimit: Pointer; { table for fast range-limiting } - { These fields are valid during any one scan. They describe the components and MCUs actually appearing in the scan. Note that the - decompressor output side must not use these fields. } - CompsInScan: Integer; { # of JPEG components in this scan } - CurCompInfo: array[0..MAX_COMPS_IN_SCAN-1] of PRJpegComponentInfo; - { *cur_comp_info[i] describes component that appears i'th in SOS } - McusPerRow: Cardinal; { # of MCUs across the image } - McuRowsInScan: Cardinal; { # of MCU rows in the image } - BlocksInMcu: Integer; { # of DCT blocks per MCU } - McuMembership: array[0..D_MAX_BLOCKS_IN_MCU-1] of Integer; - { MCU_membership[i] is index in cur_comp_info of component owning i'th block in an MCU } - Ss,Se,Ah,Al: Integer; { progressive JPEG parameters for scan } - { This field is shared between entropy decoder and marker parser. It is either zero or the code of a JPEG marker that has been read - from the data source, but has not yet been processed. } - UnreadMarker: Integer; - { Links to decompression subobjects (methods, private variables of modules) } - Master: PRJpegDecompMaster; - Main: PRJpegDMainController; - Coef: PRJpegDCoefController; - Post: PRJpegDPosController; - InputCtl: PRJpegInputController; - Marker: PRJpegMarkerReader; - Entropy: PRJpegEntropyDecoder; - IDct: PRJpegInverseDct; - Upsample: PRJpegUpsampler; - CConvert: PRJpegColorDeconverter; - CQuantize: PRJpegColorQuantizer; - end; - -procedure jpeg_create_compress(cinfo: PRJpegCompressStruct); cdecl; -procedure jpeg_CreateCompress(cinfo: PRJpegCompressStruct; version: Integer; structsize: Cardinal); cdecl; external; -procedure jpeg_create_decompress(cinfo: PRJpegDecompressStruct); cdecl; -procedure jpeg_CreateDecompress(cinfo: PRJpegDecompressStruct; version: Integer; structsize: Cardinal); cdecl; external; -procedure jpeg_abort(cinfo: PRJpegCommonStruct); cdecl; external; -procedure jpeg_set_defaults(cinfo: PRJpegCompressStruct); cdecl; external; -procedure jpeg_set_colorspace(cinfo: PRJpegCompressStruct; colorspace: Integer); cdecl; external; -procedure jpeg_set_quality(cinfo: PRJpegCompressStruct; quality: Integer; force_baseline: Byte); cdecl; external; -procedure jpeg_suppress_tables(cinfo: PRJpegCompressStruct; suppress: Byte); cdecl; external; -procedure jpeg_start_compress(cinfo: PRJpegCompressStruct; write_all_tables: Byte); cdecl; external; -function jpeg_write_scanlines(cinfo: PRJpegCompressStruct; scanlines: PPointer; num_lines: Cardinal): Cardinal; cdecl; external; -function jpeg_write_raw_data(cinfo: PRJpegCompressStruct; data: Pointer; num_lines: Cardinal): Cardinal; cdecl; external; -procedure jpeg_finish_compress(cinfo: PRJpegCompressStruct); cdecl; external; -procedure jpeg_write_tables(cinfo: PRJpegCompressStruct); cdecl; external; -function jpeg_read_header(cinfo: PRJpegDecompressStruct; require_image: Boolean): Integer; cdecl; external; -function jpeg_start_decompress(cinfo: PRJpegDecompressStruct): Byte; cdecl; external; -function jpeg_read_scanlines(cinfo: PRJpegDecompressStruct; scanlines: Pointer; max_lines: Cardinal): Cardinal; cdecl; external; -function jpeg_read_raw_data(cinfo: PRJpegDecompressStruct; data: Pointer; max_lines: Cardinal): Cardinal; cdecl; external; -function jpeg_finish_decompress(cinfo: PRJpegDecompressStruct): Byte; cdecl; external; -procedure jpeg_destroy(cinfo: PRJpegCommonStruct); cdecl; external; -function jpeg_std_error(err: PRJpegErrorMgr): Pointer; cdecl; external; -function jpeg_resync_to_restart(cinfo: PRJpegDecompressStruct; desired: Integer): Byte; cdecl; external; - -implementation - -uses - LibDelphi; - -procedure jpeg_error_exit_raise; cdecl; {$ifdef FPC}[public];{$endif} -begin - raise Exception.Create('LibJpeg error_exit'); -end; - -{$ifdef FPC} -function jpeg_sizeof_compress:Integer; cdecl; external; -function jpeg_sizeof_decompress:Integer; cdecl; external; - -procedure jpeg_create_compress(cinfo: PRJpegCompressStruct); cdecl; -begin - jpeg_CreateCompress(cinfo,JPEG_LIB_VERSION,jpeg_sizeof_compress()); -end; - -procedure jpeg_create_decompress(cinfo: PRJpegDecompressStruct); cdecl; -begin - jpeg_CreateDecompress(cinfo,JPEG_LIB_VERSION,jpeg_sizeof_decompress()); -end; -{$else} -procedure jpeg_create_compress(cinfo: PRJpegCompressStruct); cdecl; -begin - jpeg_CreateCompress(cinfo,JPEG_LIB_VERSION,SizeOf(RJpegCompressStruct)); -end; - -procedure jpeg_create_decompress(cinfo: PRJpegDecompressStruct); cdecl; -begin - jpeg_CreateDecompress(cinfo,JPEG_LIB_VERSION,SizeOf(RJpegDecompressStruct)); -end; -{$endif} - -function jpeg_get_small(cinfo: PRJpegCommonStruct; sizeofobject: Cardinal): Pointer; cdecl; external; -function jpeg_get_large(cinfo: PRJpegCommonStruct; sizeofobject: Cardinal): Pointer; cdecl; external; -function jpeg_mem_available(cinfo: PRJpegCommonStruct; min_bytes_needed: Integer; max_bytes_needed: Integer; already_allocated: Integer): Integer; cdecl; external; -procedure jpeg_open_backing_store(cinfo: PRJpegCommonStruct; info: Pointer; total_bytes_needed: Integer); cdecl; external; -procedure jpeg_free_large(cinfo: PRJpegCommonStruct; objectt: Pointer; sizeofobject: Cardinal); cdecl; external; -procedure jpeg_free_small(cinfo: PRJpegCommonStruct; objectt: Pointer; sizeofobject: Cardinal); cdecl; external; -procedure jpeg_mem_term(cinfo: PRJpegCommonStruct); cdecl; external; -function jpeg_mem_init(cinfo: PRJpegCommonStruct): Integer; cdecl; external; -procedure jinit_memory_mgr(cinfo: PRJpegCommonStruct); cdecl; external; -function jpeg_alloc_huff_table(cinfo: PRJpegCommonStruct): Pointer; cdecl; external; -function jpeg_alloc_quant_table(cinfo: PRJpegCommonStruct): Pointer; cdecl; external; -function jdiv_round_up(a: Integer; b: Integer): Integer; cdecl; external; -procedure jcopy_sample_rows(input_array: Pointer; source_row: Integer; output_array: Pointer; dest_row: Integer; num_rows: Integer; - num_cols: Cardinal); cdecl; external; -function jround_up(a: Integer; b: Integer): Integer; cdecl; external; -procedure jcopy_block_row(input_row: Pointer; output_row: Pointer; num_blocks: Cardinal); cdecl; external; - -{$IF Defined(DCC) and Defined(MSWINDOWS) and not Defined(CPUX64)} - // Windows 32bit Delphi only - OMF object format - {$L Compiled\jmemnobs.obj} - {$L Compiled\jmemmgr.obj} - {$L Compiled\jcomapi.obj} - {$L Compiled\jerror.obj} - {$L Compiled\jcapimin.obj} - {$L Compiled\jcmarker.obj} - {$L Compiled\jutils.obj} - {$L Compiled\jdapimin.obj} - {$L Compiled\jdmarker.obj} - {$L Compiled\jdinput.obj} - {$L Compiled\jcparam.obj} - {$L Compiled\jcapistd.obj} - {$L Compiled\jcinit.obj} - {$L Compiled\jcmaster.obj} - {$L Compiled\jccolor.obj} - {$L Compiled\jcsample.obj} - {$L Compiled\jcprepct.obj} - {$L Compiled\jcdctmgr.obj} - {$L Compiled\jcphuff.obj} - {$L Compiled\jchuff.obj} - {$L Compiled\jccoefct.obj} - {$L Compiled\jcmainct.obj} - {$L Compiled\jfdctint.obj} - {$L Compiled\jfdctfst.obj} - {$L Compiled\jfdctflt.obj} - {$L Compiled\jdapistd.obj} - {$L Compiled\jdmaster.obj} - {$L Compiled\jquant1.obj} - {$L Compiled\jquant2.obj} - {$L Compiled\jdmerge.obj} - {$L Compiled\jdcolor.obj} - {$L Compiled\jdsample.obj} - {$L Compiled\jdpostct.obj} - {$L Compiled\jddctmgr.obj} - {$L Compiled\jdphuff.obj} - {$L Compiled\jdhuff.obj} - {$L Compiled\jdcoefct.obj} - {$L Compiled\jdmainct.obj} - {$L Compiled\jidctred.obj} - {$L Compiled\jidctint.obj} - {$L Compiled\jidctfst.obj} - {$L Compiled\jidctflt.obj} -{$IFEND} -end. - - - diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/LibTiffDelphi.pas b/components/vampireimaging/Extras/Extensions/LibTiff/LibTiffDelphi.pas deleted file mode 100644 index 866a751..0000000 --- a/components/vampireimaging/Extras/Extensions/LibTiff/LibTiffDelphi.pas +++ /dev/null @@ -1,1510 +0,0 @@ -{ - LibTiffDelphi - - Original: Aware Systems - Modifications: Marek Mauder, Do-wan Kim - -} - -unit LibTiffDelphi; - -{$IFDEF FPC} - {$MODE OBJFPC} - {$DEFINE VER403} // libtiff 4.0.3 -{$ELSE} - {$DEFINE DCC} - {$ALIGN 8} - {$MINENUMSIZE 1} -{$ENDIF} - -interface - -uses - SysUtils, Classes, LibDelphi; - -type - tmsize_t = SizeInt; - tsize_t = SizeInt; - toff_t = {$ifdef VER403}int64{$else}Integer{$endif}; - poff_t = ^toff_t; - tsample_t = Word; - // Beware: THandle is 32bit in size even on 64bit Linux - this may cause - // problems as pointers to client data are passed in thandle_t vars. - thandle_t = THandle; - tdata_t = Pointer; - ttag_t = UInt32; - tdir_t = Word; - tstrip_t = UInt32; - -const - TIFF_NOTYPE = 0; - TIFF_BYTE = 1; { 8-bit unsigned integer } - TIFF_ASCII = 2; { 8-bit bytes w/ last byte null } - TIFF_SHORT = 3; { 16-bit unsigned integer } - TIFF_LONG = 4; { 32-bit unsigned integer } - TIFF_RATIONAL = 5; { 64-bit unsigned fraction } - TIFF_SBYTE = 6; { !8-bit signed integer } - TIFF_UNDEFINED = 7; { !8-bit untyped data } - TIFF_SSHORT = 8; { !16-bit signed integer } - TIFF_SLONG = 9; { !32-bit signed integer } - TIFF_SRATIONAL = 10; { !64-bit signed fraction } - TIFF_FLOAT = 11; { !32-bit IEEE floating point } - TIFF_DOUBLE = 12; { !64-bit IEEE floating point } - TIFF_IFD = 13; { %32-bit unsigned integer (offset) } - TIFF_UNICODE = 14; - TIFF_COMPLEX = 15; - TIFF_LONG8 = 16; - TIFF_SLONG8 = 17; - TIFF_IFD8 = 18; - - TIFFTAG_SUBFILETYPE = 254; { subfile data descriptor } - FILETYPE_REDUCEDIMAGE = $1; { reduced resolution version } - FILETYPE_PAGE = $2; { one page of many } - FILETYPE_MASK = $4; { transparency mask } - TIFFTAG_OSUBFILETYPE = 255; { kind of data in subfile } - OFILETYPE_IMAGE = 1; { full resolution image data } - OFILETYPE_REDUCEDIMAGE = 2; { reduced size image data } - OFILETYPE_PAGE = 3; { one page of many } - TIFFTAG_IMAGEWIDTH = 256; { image width in pixels } - TIFFTAG_IMAGELENGTH = 257; { image height in pixels } - TIFFTAG_BITSPERSAMPLE = 258; { bits per channel (sample) } - TIFFTAG_COMPRESSION = 259; { data compression technique } - COMPRESSION_NONE = 1; { dump mode } - COMPRESSION_CCITTRLE = 2; { CCITT modified Huffman RLE } - COMPRESSION_CCITTFAX3 = 3; { CCITT Group 3 fax encoding } - COMPRESSION_CCITT_T4 = 3; { CCITT T.4 (TIFF 6 name) } - COMPRESSION_CCITTFAX4 = 4; { CCITT Group 4 fax encoding } - COMPRESSION_CCITT_T6 = 4; { CCITT T.6 (TIFF 6 name) } - COMPRESSION_LZW = 5; { Lempel-Ziv & Welch } - COMPRESSION_OJPEG = 6; { !6.0 JPEG } - COMPRESSION_JPEG = 7; { %JPEG DCT compression } - COMPRESSION_NEXT = 32766; { NeXT 2-bit RLE } - COMPRESSION_CCITTRLEW = 32771; { #1 w/ word alignment } - COMPRESSION_PACKBITS = 32773; { Macintosh RLE } - COMPRESSION_THUNDERSCAN = 32809; { ThunderScan RLE } - { codes 32895-32898 are reserved for ANSI IT8 TIFF/IT } - COMPRESSION_DCS = 32947; { Kodak DCS encoding } - COMPRESSION_JBIG = 34661; { ISO JBIG } - COMPRESSION_SGILOG = 34676; { SGI Log Luminance RLE } - COMPRESSION_SGILOG24 = 34677; { SGI Log 24-bit packed } - COMPRESSION_JP2000 = 34712; { Leadtools JPEG2000 } - TIFFTAG_PHOTOMETRIC = 262; { photometric interpretation } - PHOTOMETRIC_MINISWHITE = 0; { min value is white } - PHOTOMETRIC_MINISBLACK = 1; { min value is black } - PHOTOMETRIC_RGB = 2; { RGB color model } - PHOTOMETRIC_PALETTE = 3; { color map indexed } - PHOTOMETRIC_MASK = 4; { $holdout mask } - PHOTOMETRIC_SEPARATED = 5; { !color separations } - PHOTOMETRIC_YCBCR = 6; { !CCIR 601 } - PHOTOMETRIC_CIELAB = 8; { !1976 CIE L*a*b* } - PHOTOMETRIC_ICCLAB = 9; { ICC L*a*b* [Adobe TIFF Technote 4] } - PHOTOMETRIC_ITULAB = 10; { ITU L*a*b* } - PHOTOMETRIC_LOGL = 32844; { CIE Log2(L) } - PHOTOMETRIC_LOGLUV = 32845; { CIE Log2(L) (u',v') } - TIFFTAG_THRESHHOLDING = 263; { thresholding used on data } - THRESHHOLD_BILEVEL = 1; { b&w art scan } - THRESHHOLD_HALFTONE = 2; { or dithered scan } - THRESHHOLD_ERRORDIFFUSE = 3; { usually floyd-steinberg } - TIFFTAG_CELLWIDTH = 264; { +dithering matrix width } - TIFFTAG_CELLLENGTH = 265; { +dithering matrix height } - TIFFTAG_FILLORDER = 266; { data order within a byte } - FILLORDER_MSB2LSB = 1; { most significant -> least } - FILLORDER_LSB2MSB = 2; { least significant -> most } - TIFFTAG_DOCUMENTNAME = 269; { name of doc. image is from } - TIFFTAG_IMAGEDESCRIPTION = 270; { info about image } - TIFFTAG_MAKE = 271; { scanner manufacturer name } - TIFFTAG_MODEL = 272; { scanner model name/number } - TIFFTAG_STRIPOFFSETS = 273; { offsets to data strips } - TIFFTAG_ORIENTATION = 274; { +image orientation } - ORIENTATION_TOPLEFT = 1; { row 0 top, col 0 lhs } - ORIENTATION_TOPRIGHT = 2; { row 0 top, col 0 rhs } - ORIENTATION_BOTRIGHT = 3; { row 0 bottom, col 0 rhs } - ORIENTATION_BOTLEFT = 4; { row 0 bottom, col 0 lhs } - ORIENTATION_LEFTTOP = 5; { row 0 lhs, col 0 top } - ORIENTATION_RIGHTTOP = 6; { row 0 rhs, col 0 top } - ORIENTATION_RIGHTBOT = 7; { row 0 rhs, col 0 bottom } - ORIENTATION_LEFTBOT = 8; { row 0 lhs, col 0 bottom } - TIFFTAG_SAMPLESPERPIXEL = 277; { samples per pixel } - TIFFTAG_ROWSPERSTRIP = 278; { rows per strip of data } - TIFFTAG_STRIPBYTECOUNTS = 279; { bytes counts for strips } - TIFFTAG_MINSAMPLEVALUE = 280; { +minimum sample value } - TIFFTAG_MAXSAMPLEVALUE = 281; { +maximum sample value } - TIFFTAG_XRESOLUTION = 282; { pixels/resolution in x } - TIFFTAG_YRESOLUTION = 283; { pixels/resolution in y } - TIFFTAG_PLANARCONFIG = 284; { storage organization } - PLANARCONFIG_CONTIG = 1; { single image plane } - PLANARCONFIG_SEPARATE = 2; { separate planes of data } - TIFFTAG_PAGENAME = 285; { page name image is from } - TIFFTAG_XPOSITION = 286; { x page offset of image lhs } - TIFFTAG_YPOSITION = 287; { y page offset of image lhs } - TIFFTAG_FREEOFFSETS = 288; { +byte offset to free block } - TIFFTAG_FREEBYTECOUNTS = 289; { +sizes of free blocks } - - {matched with tag reference up to this point} - - TIFFTAG_GRAYRESPONSEUNIT = 290; { $gray scale curve accuracy } - GRAYRESPONSEUNIT_10S = 1; { tenths of a unit } - GRAYRESPONSEUNIT_100S = 2; { hundredths of a unit } - GRAYRESPONSEUNIT_1000S = 3; { thousandths of a unit } - GRAYRESPONSEUNIT_10000S = 4; { ten-thousandths of a unit } - GRAYRESPONSEUNIT_100000S = 5; { hundred-thousandths } - TIFFTAG_GRAYRESPONSECURVE = 291; { $gray scale response curve } - TIFFTAG_GROUP3OPTIONS = 292; { 32 flag bits } - TIFFTAG_T4OPTIONS = 292; { TIFF 6.0 proper name alias } - GROUP3OPT_2DENCODING = $1; { 2-dimensional coding } - GROUP3OPT_UNCOMPRESSED = $2; { data not compressed } - GROUP3OPT_FILLBITS = $4; { fill to byte boundary } - TIFFTAG_GROUP4OPTIONS = 293; { 32 flag bits } - TIFFTAG_T6OPTIONS = 293; { TIFF 6.0 proper name } - GROUP4OPT_UNCOMPRESSED = $2; { data not compressed } - TIFFTAG_RESOLUTIONUNIT = 296; { units of resolutions } - RESUNIT_NONE = 1; { no meaningful units } - RESUNIT_INCH = 2; { english } - RESUNIT_CENTIMETER = 3; { metric } - TIFFTAG_PAGENUMBER = 297; { page numbers of multi-page } - TIFFTAG_COLORRESPONSEUNIT = 300; { $color curve accuracy } - COLORRESPONSEUNIT_10S = 1; { tenths of a unit } - COLORRESPONSEUNIT_100S = 2; { hundredths of a unit } - COLORRESPONSEUNIT_1000S = 3; { thousandths of a unit } - COLORRESPONSEUNIT_10000S = 4; { ten-thousandths of a unit } - COLORRESPONSEUNIT_100000S = 5; { hundred-thousandths } - TIFFTAG_TRANSFERFUNCTION = 301; { !colorimetry info } - TIFFTAG_SOFTWARE = 305; { name & release } - TIFFTAG_DATETIME = 306; { creation date and time } - TIFFTAG_ARTIST = 315; { creator of image } - TIFFTAG_HOSTCOMPUTER = 316; { machine where created } - TIFFTAG_PREDICTOR = 317; { prediction scheme w/ LZW } - TIFFTAG_WHITEPOINT = 318; { image white point } - TIFFTAG_PRIMARYCHROMATICITIES = 319; { !primary chromaticities } - TIFFTAG_COLORMAP = 320; { RGB map for pallette image } - TIFFTAG_HALFTONEHINTS = 321; { !highlight+shadow info } - TIFFTAG_TILEWIDTH = 322; { !rows/data tile } - TIFFTAG_TILELENGTH = 323; { !cols/data tile } - TIFFTAG_TILEOFFSETS = 324; { !offsets to data tiles } - TIFFTAG_TILEBYTECOUNTS = 325; { !byte counts for tiles } - TIFFTAG_BADFAXLINES = 326; { lines w/ wrong pixel count } - TIFFTAG_CLEANFAXDATA = 327; { regenerated line info } - CLEANFAXDATA_CLEAN = 0; { no errors detected } - CLEANFAXDATA_REGENERATED = 1; { receiver regenerated lines } - CLEANFAXDATA_UNCLEAN = 2; { uncorrected errors exist } - TIFFTAG_CONSECUTIVEBADFAXLINES = 328; { max consecutive bad lines } - TIFFTAG_SUBIFD = 330; { subimage descriptors } - TIFFTAG_INKSET = 332; { !inks in separated image } - INKSET_CMYK = 1; { !cyan-magenta-yellow-black color } - INKSET_MULTIINK = 2; { !multi-ink or hi-fi color } - TIFFTAG_INKNAMES = 333; { !ascii names of inks } - TIFFTAG_NUMBEROFINKS = 334; { !number of inks } - TIFFTAG_DOTRANGE = 336; { !0% and 100% dot codes } - TIFFTAG_TARGETPRINTER = 337; { !separation target } - TIFFTAG_EXTRASAMPLES = 338; { !info about extra samples } - EXTRASAMPLE_UNSPECIFIED = 0; { !unspecified data } - EXTRASAMPLE_ASSOCALPHA = 1; { !associated alpha data } - EXTRASAMPLE_UNASSALPHA = 2; { !unassociated alpha data } - TIFFTAG_SAMPLEFORMAT = 339; { !data sample format } - SAMPLEFORMAT_UINT = 1; { !unsigned integer data } - SAMPLEFORMAT_INT = 2; { !signed integer data } - SAMPLEFORMAT_IEEEFP = 3; { !IEEE floating point data } - SAMPLEFORMAT_VOID = 4; { !untyped data } - SAMPLEFORMAT_COMPLEXINT = 5; { !complex signed int } - SAMPLEFORMAT_COMPLEXIEEEFP = 6; { !complex ieee floating } - TIFFTAG_SMINSAMPLEVALUE = 340; { !variable MinSampleValue } - TIFFTAG_SMAXSAMPLEVALUE = 341; { !variable MaxSampleValue } - TIFFTAG_CLIPPATH = 343; { %ClipPath [Adobe TIFF technote 2] } - TIFFTAG_XCLIPPATHUNITS = 344; { %XClipPathUnits [Adobe TIFF technote 2] } - TIFFTAG_YCLIPPATHUNITS = 345; { %YClipPathUnits [Adobe TIFF technote 2] } - TIFFTAG_INDEXED = 346; { %Indexed [Adobe TIFF Technote 3] } - TIFFTAG_JPEGTABLES = 347; { %JPEG table stream } - TIFFTAG_OPIPROXY = 351; { %OPI Proxy [Adobe TIFF technote] } - { Tags 512-521 are obsoleted by Technical Note #2 - which specifies a revised JPEG-in-TIFF scheme. } - TIFFTAG_JPEGPROC = 512; { !JPEG processing algorithm } - JPEGPROC_BASELINE = 1; { !baseline sequential } - JPEGPROC_LOSSLESS = 14; { !Huffman coded lossless } - TIFFTAG_JPEGIFOFFSET = 513; { !pointer to SOI marker } - TIFFTAG_JPEGIFBYTECOUNT = 514; { !JFIF stream length } - TIFFTAG_JPEGRESTARTINTERVAL = 515; { !restart interval length } - TIFFTAG_JPEGLOSSLESSPREDICTORS = 517; { !lossless proc predictor } - TIFFTAG_JPEGPOINTTRANSFORM = 518; { !lossless point transform } - TIFFTAG_JPEGQTABLES = 519; { !Q matrice offsets } - TIFFTAG_JPEGDCTABLES = 520; { !DCT table offsets } - TIFFTAG_JPEGACTABLES = 521; { !AC coefficient offsets } - TIFFTAG_YCBCRCOEFFICIENTS = 529; { !RGB -> YCbCr transform } - TIFFTAG_YCBCRSUBSAMPLING = 530; { !YCbCr subsampling factors } - TIFFTAG_YCBCRPOSITIONING = 531; { !subsample positioning } - YCBCRPOSITION_CENTERED = 1; { !as in PostScript Level 2 } - YCBCRPOSITION_COSITED = 2; { !as in CCIR 601-1 } - TIFFTAG_REFERENCEBLACKWHITE = 532; { !colorimetry info } - TIFFTAG_XMLPACKET = 700; { %XML packet [Adobe XMP technote 9-14-02] (dkelly@apago.com) } - TIFFTAG_OPIIMAGEID = 32781; { %OPI ImageID [Adobe TIFF technote] } - { tags 32952-32956 are private tags registered to Island Graphics } - TIFFTAG_REFPTS = 32953; { image reference points } - TIFFTAG_REGIONTACKPOINT = 32954; { region-xform tack point } - TIFFTAG_REGIONWARPCORNERS = 32955; { warp quadrilateral } - TIFFTAG_REGIONAFFINE = 32956; { affine transformation mat } - { tags 32995-32999 are private tags registered to SGI } - TIFFTAG_MATTEING = 32995; { $use ExtraSamples } - TIFFTAG_DATATYPE = 32996; { $use SampleFormat } - TIFFTAG_IMAGEDEPTH = 32997; { z depth of image } - TIFFTAG_TILEDEPTH = 32998; { z depth/data tile } - { tags 33300-33309 are private tags registered to Pixar } - { TIFFTAG_PIXAR_IMAGEFULLWIDTH and TIFFTAG_PIXAR_IMAGEFULLLENGTH are set when an image has been cropped out of a larger image. - They reflect the size of the original uncropped image. The TIFFTAG_XPOSITION and TIFFTAG_YPOSITION can be used to determine the - position of the smaller image in the larger one. } - TIFFTAG_PIXAR_IMAGEFULLWIDTH = 33300; { full image size in x } - TIFFTAG_PIXAR_IMAGEFULLLENGTH = 33301; { full image size in y } - { Tags 33302-33306 are used to identify special image modes and data used by Pixar's texture formats. } - TIFFTAG_PIXAR_TEXTUREFORMAT = 33302; { texture map format } - TIFFTAG_PIXAR_WRAPMODES = 33303; { s & t wrap modes } - TIFFTAG_PIXAR_FOVCOT = 33304; { cotan(fov) for env. maps } - TIFFTAG_PIXAR_MATRIX_WORLDTOSCREEN = 33305; - TIFFTAG_PIXAR_MATRIX_WORLDTOCAMERA = 33306; - { tag 33405 is a private tag registered to Eastman Kodak } - TIFFTAG_WRITERSERIALNUMBER = 33405; { device serial number } - { tag 33432 is listed in the 6.0 spec w/ unknown ownership } - TIFFTAG_COPYRIGHT = 33432; { copyright string } - { IPTC TAG from RichTIFF specifications } - TIFFTAG_RICHTIFFIPTC = 33723; - { 34016-34029 are reserved for ANSI IT8 TIFF/IT } - TIFFTAG_STONITS = 37439; { Sample value to Nits } - { tag 34929 is a private tag registered to FedEx } - TIFFTAG_FEDEX_EDR = 34929; { unknown use } - { tag 65535 is an undefined tag used by Eastman Kodak } - TIFFTAG_DCSHUESHIFTVALUES = 65535; { hue shift correction data } - { The following are ``pseudo tags'' that can be used to control codec-specific functionality. These tags are not written to file. - Note that these values start at 0xffff+1 so that they'll never collide with Aldus-assigned tags. } - TIFFTAG_FAXMODE = 65536; { Group 3/4 format control } - FAXMODE_CLASSIC = $0; { default, include RTC } - FAXMODE_NORTC = $1; { no RTC at end of data } - FAXMODE_NOEOL = $2; { no EOL code at end of row } - FAXMODE_BYTEALIGN = $4; { byte align row } - FAXMODE_WORDALIGN = $8; { word align row } - FAXMODE_CLASSF = FAXMODE_NORTC; { TIFF Class F } - TIFFTAG_JPEGQUALITY = 65537; { Compression quality level } - { Note: quality level is on the IJG 0-100 scale. Default value is 75 } - TIFFTAG_JPEGCOLORMODE = 65538; { Auto RGB<=>YCbCr convert? } - JPEGCOLORMODE_RAW = $0; { no conversion (default) } - JPEGCOLORMODE_RGB = $1; { do auto conversion } - TIFFTAG_JPEGTABLESMODE = 65539; { What to put in JPEGTables } - JPEGTABLESMODE_QUANT = $1; { include quantization tbls } - JPEGTABLESMODE_HUFF = $2; { include Huffman tbls } - { Note: default is JPEGTABLESMODE_QUANT | JPEGTABLESMODE_HUFF } - TIFFTAG_FAXFILLFUNC = 65540; { G3/G4 fill function } - TIFFTAG_PIXARLOGDATAFMT = 65549; { PixarLogCodec I/O data sz } - PIXARLOGDATAFMT_8BIT = 0; { regular u_char samples } - PIXARLOGDATAFMT_8BITABGR = 1; { ABGR-order u_chars } - PIXARLOGDATAFMT_11BITLOG = 2; { 11-bit log-encoded (raw) } - PIXARLOGDATAFMT_12BITPICIO = 3; { as per PICIO (1.0==2048) } - PIXARLOGDATAFMT_16BIT = 4; { signed short samples } - PIXARLOGDATAFMT_FLOAT = 5; { IEEE float samples } - { 65550-65556 are allocated to Oceana Matrix } - TIFFTAG_DCSIMAGERTYPE = 65550; { imager model & filter } - DCSIMAGERMODEL_M3 = 0; { M3 chip (1280 x 1024) } - DCSIMAGERMODEL_M5 = 1; { M5 chip (1536 x 1024) } - DCSIMAGERMODEL_M6 = 2; { M6 chip (3072 x 2048) } - DCSIMAGERFILTER_IR = 0; { infrared filter } - DCSIMAGERFILTER_MONO = 1; { monochrome filter } - DCSIMAGERFILTER_CFA = 2; { color filter array } - DCSIMAGERFILTER_OTHER = 3; { other filter } - TIFFTAG_DCSINTERPMODE = 65551; { interpolation mode } - DCSINTERPMODE_NORMAL = 0; { whole image, default } - DCSINTERPMODE_PREVIEW = 1; { preview of image (384x256) } - TIFFTAG_DCSBALANCEARRAY = 65552; { color balance values } - TIFFTAG_DCSCORRECTMATRIX = 65553; { color correction values } - TIFFTAG_DCSGAMMA = 65554; { gamma value } - TIFFTAG_DCSTOESHOULDERPTS = 65555; { toe & shoulder points } - TIFFTAG_DCSCALIBRATIONFD = 65556; { calibration file desc } - { Note: quality level is on the ZLIB 1-9 scale. Default value is -1 } - TIFFTAG_ZIPQUALITY = 65557; { compression quality level } - TIFFTAG_PIXARLOGQUALITY = 65558; { PixarLog uses same scale } - { 65559 is allocated to Oceana Matrix } - TIFFTAG_DCSCLIPRECTANGLE = 65559; { area of image to acquire } - TIFFTAG_SGILOGDATAFMT = 65560; { SGILog user data format } - SGILOGDATAFMT_FLOAT = 0; { IEEE float samples } - SGILOGDATAFMT_16BIT = 1; { 16-bit samples } - SGILOGDATAFMT_RAW = 2; { uninterpreted data } - SGILOGDATAFMT_8BIT = 3; { 8-bit RGB monitor values } - TIFFTAG_SGILOGENCODE = 65561; { SGILog data encoding control } - SGILOGENCODE_NODITHER = 0; { do not dither encoded values } - SGILOGENCODE_RANDITHER = 1; { randomly dither encd values } - - - { Flags to pass to TIFFPrintDirectory to control printing of data structures that are potentially very large. Bit-or these flags to - enable printing multiple items. } - TIFFPRINT_NONE = $0; { no extra info } - TIFFPRINT_STRIPS = $1; { strips/tiles info } - TIFFPRINT_CURVES = $2; { color/gray response curves } - TIFFPRINT_COLORMAP = $4; { colormap } - TIFFPRINT_JPEGQTABLES = $100; { JPEG Q matrices } - TIFFPRINT_JPEGACTABLES = $200; { JPEG AC tables } - TIFFPRINT_JPEGDCTABLES = $200; { JPEG DC tables } - - - TIFF_ANY = TIFF_NOTYPE; { for field descriptor searching } - TIFF_VARIABLE = -1; { marker for variable length tags } - TIFF_SPP = -2; { marker for SamplesPerPixel tags } - TIFF_VARIABLE2 = -3; { marker for uint32 var-length tags } - - FIELD_CUSTOM = 65; - - {added for LibTiff 3.9.4 by Alex (leontyyy@gmail.com) Dec.2011} - TIFFTAG_EXIFIFD = 34665; { pointer to the Exif IFD } - EXIFTAG_FOCALLENGTH = 37386; { focal length } - EXIFTAG_FOCALLENGTHIN35MMFILM = 41989; { indicates the equivalent focal length assuming a 35mm film camera, in mm } - EXIFTAG_EXIFVERSION = 36864; { version of exif format } - EXIFTAG_DATETIMEDIGITIZED = 36868; { date and time when the image was stored as digital data } - EXIFTAG_DATETIMEORIGINAL = 36867; { date and time when the original image data was generated } - EXIFTAG_EXPOSURETIME = 33434; { exposure time, given in seconds } - EXIFTAG_FNUMBER = 33437; { F number } - EXIFTAG_EXPOSUREPROGRAM = 34850; { class of the program used by the camera to set exposure } - EXIFTAG_SPECTRALSENSITIVITY = 34852; { spectral sensitivity of each channel of the camera used } - EXIFTAG_ISOSPEEDRATINGS = 34855; { ISO Speed and ISO Latitude } - EXIFTAG_OECF = 34856; { Opto-Electric Conversion Function } - EXIFTAG_COMPONENTSCONFIGURATION = 37121; { meaning of each component } - EXIFTAG_COMPRESSEDBITSPERPIXEL = 37122; { compression mode } - EXIFTAG_SHUTTERSPEEDVALUE = 37377; { shutter speed } - EXIFTAG_APERTUREVALUE = 37378; { lens aperture } - EXIFTAG_BRIGHTNESSVALUE = 37379; { brightness } - EXIFTAG_EXPOSUREBIASVALUE = 37380; { exposure bias } - EXIFTAG_MAXAPERTUREVALUE = 37381; { maximum lens aperture } - EXIFTAG_SUBJECTDISTANCE = 37382; { distance to the subject in meters } - EXIFTAG_METERINGMODE = 37383; { metering mode } - EXIFTAG_LIGHTSOURCE = 37384; { light source } - EXIFTAG_FLASH = 37385; { flash } - EXIFTAG_SUBJECTAREA = 37396; { subject area (in exif ver.2.2) } - EXIFTAG_MAKERNOTE = 37500; { manufacturer notes } - EXIFTAG_USERCOMMENT = 37510; { user comments } - EXIFTAG_SUBSECTIME = 37520; { DateTime subseconds } - EXIFTAG_SUBSECTIMEORIGINAL = 37521; { DateTimeOriginal subseconds } - EXIFTAG_SUBSECTIMEDIGITIZED = 37522; { DateTimeDigitized subseconds } - EXIFTAG_FLASHPIXVERSION = 40960; { FlashPix format version } - EXIFTAG_COLORSPACE = 40961; { color space information } - EXIFTAG_PIXELXDIMENSION = 40962; { valid image width } - EXIFTAG_PIXELYDIMENSION = 40963; { valid image height } - EXIFTAG_RELATEDSOUNDFILE = 40964; { related audio file } - EXIFTAG_FLASHENERGY = 41483; { flash energy } - EXIFTAG_SPATIALFREQUENCYRESPONSE = 41484; { spatial frequency response } - EXIFTAG_FOCALPLANEXRESOLUTION = 41486; { focal plane X resolution } - EXIFTAG_FOCALPLANEYRESOLUTION = 41487; { focal plane Y resolution } - EXIFTAG_FOCALPLANERESOLUTIONUNIT = 41488; { focal plane resolution unit } - EXIFTAG_SUBJECTLOCATION = 41492; { subject location } - EXIFTAG_EXPOSUREINDEX = 41493; { exposure index } - EXIFTAG_SENSINGMETHOD = 41495; { sensing method } - EXIFTAG_FILESOURCE = 41728; { file source } - EXIFTAG_SCENETYPE = 41729; { scene type } - EXIFTAG_CFAPATTERN = 41730; { CFA pattern } - EXIFTAG_CUSTOMRENDERED = 41985; { custom image processing (in exif ver.2.2) } - EXIFTAG_EXPOSUREMODE = 41986; { exposure mode (in exif ver.2.2) } - EXIFTAG_WHITEBALANCE = 41987; { white balance (in exif ver.2.2) } - EXIFTAG_DIGITALZOOMRATIO = 41988; { digital zoom ratio (in exif ver.2.2) } - EXIFTAG_SCENECAPTURETYPE = 41990; { scene capture type (in exif ver.2.2) } - EXIFTAG_GAINCONTROL = 41991; { gain control (in exif ver.2.2) } - EXIFTAG_CONTRAST = 41992; { contrast (in exif ver.2.2) } - EXIFTAG_SATURATION = 41993; { saturation (in exif ver.2.2) } - EXIFTAG_SHARPNESS = 41994; { sharpness (in exif ver.2.2) } - EXIFTAG_DEVICESETTINGDESCRIPTION = 41995; { device settings description (in exif ver.2.2) } - EXIFTAG_SUBJECTDISTANCERANGE = 41996; { subject distance range (in exif ver.2.2) } - EXIFTAG_IMAGEUNIQUEID = 42016; { Unique image ID (in exif ver.2.2) } - -type - - PTIFF = Pointer; - PTIFFRGBAImage = Pointer; - - TIFFErrorHandler = procedure(Module: PAnsiChar; Format: PAnsiChar; Params: va_list); cdecl; - LibTiffDelphiErrorHandler = procedure(const a,b: AnsiString); - TIFFReadWriteProc = function(Fd: THandle; Buffer: Pointer; Size: tmsize_t): Integer; cdecl; - TIFFCloseProc = function(Fd: THandle): Integer; cdecl; - TIFFSeekProc = function(Fd: THandle; Off: toff_t; Whence: Integer): toff_t; cdecl; - TIFFSizeProc = function(Fd: THandle): toff_t; cdecl; - TIFFMapFileProc = function(Fd: THandle; PBase: PPointer; PSize: poff_t): Integer; cdecl; - TIFFUnmapFileProc = procedure(Fd: THandle; Base: Pointer; Size: toff_t); cdecl; - TIFFExtendProc = procedure(Handle: PTIFF); cdecl; - - TIFFInitMethod = function(Handle: PTIFF; Scheme: Integer): Integer; cdecl; - - PTIFFCodec = ^TIFFCodec; - TIFFCodec = record - Name: PAnsiChar; - Scheme: Word; - Init: TIFFInitMethod; - end; - - PTIFFFieldInfo = ^TIFFFieldInfo; - TIFFFieldInfo = record - FieldTag: Cardinal; { field's tag } - FieldReadCount: Smallint; { read count/TIFF_VARIABLE/TIFF_SPP } - FieldWriteCount: Smallint; { write count/TIFF_VARIABLE } - FieldType: Integer; { type of associated data } - FieldBit: Word; { bit in fieldsset bit vector } - FieldOkToChange: Byte; { if true, can change while writing } - FieldPassCount: Byte; { if true, pass dir count on set } - FieldName: PAnsiChar; { ASCII name } - end; - - PTIFFTagValue = ^TIFFTagValue; - TIFFTagValue = record - Info: PTIFFFieldInfo; - Count: Integer; - Value: Pointer; - end; - -function TIFFGetVersion: PAnsiChar; cdecl; external; -function TIFFFindCODEC(Scheme: Word): PTIFFCodec; cdecl; external; -function TIFFRegisterCODEC(Scheme: Word; Name: PAnsiChar; InitMethod: TIFFInitMethod): PTIFFCodec; cdecl; external; -procedure TIFFUnRegisterCODEC(c: PTIFFCodec); cdecl; external; -function TIFFIsCODECConfigured(Scheme: Word): Integer; cdecl; external; -function TIFFGetConfiguredCODECs: PTIFFCodec; cdecl; external; - -function TIFFOpen(const Name: AnsiString; const Mode: AnsiString): PTIFF; -function TIFFClientOpen(Name: PAnsiChar; - Mode: PAnsiChar; - ClientData: THandle; - ReadProc: TIFFReadWriteProc; - WriteProc: TIFFReadWriteProc; - SeekProc: TIFFSeekProc; - CloseProc: TIFFCloseProc; - SizeProc: TIFFSizeProc; - MapProc: TIFFMapFileProc; - UnmapProc: TIFFUnmapFileProc): PTIFF; cdecl; external; -procedure TIFFCleanup(Handle: PTIFF); cdecl; external; -procedure TIFFClose(Handle: PTIFF); cdecl; external; -function TIFFFileno(Handle: PTIFF): Integer; cdecl; external; -function TIFFSetFileno(Handle: PTIFF; Newvalue: Integer): Integer; cdecl; external; -function TIFFClientdata(Handle: PTIFF): THandle; cdecl; external; -function TIFFSetClientdata(Handle: PTIFF; Newvalue: THandle): THandle; cdecl; external; -function TIFFGetMode(Handle: PTIFF): Integer; cdecl; external; -function TIFFSetMode(Handle: PTIFF; Mode: Integer): Integer; cdecl; external; -function TIFFFileName(Handle: PTIFF): Pointer; cdecl; external; -function TIFFSetFileName(Handle: PTIFF; Name: PAnsiChar): PAnsiChar; cdecl; external; -function TIFFGetReadProc(Handle: PTIFF): TIFFReadWriteProc; cdecl; external; -function TIFFGetWriteProc(Handle: PTIFF): TIFFReadWriteProc; cdecl; external; -function TIFFGetSeekProc(Handle: PTIFF): TIFFSeekProc; cdecl; external; -function TIFFGetCloseProc(Handle: PTIFF): TIFFCloseProc; cdecl; external; -function TIFFGetSizeProc(Handle: PTIFF): TIFFSizeProc; cdecl; external; -procedure TIFFError(Module: Pointer; Fmt: Pointer); cdecl; external; varargs; -function TIFFSetErrorHandler(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; external; -procedure TIFFWarning(Module: Pointer; Fmt: Pointer); cdecl; external; varargs; -function TIFFSetWarningHandler(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; external; -function TIFFSetTagExtender(Extender: TIFFExtendProc): TIFFExtendProc; cdecl; external; - -function TIFFFlush(Handle: PTIFF): Integer; cdecl; external; -function TIFFFlushData(Handle: PTIFF): Integer; cdecl; external; - -{added for LibTiff 3.9.4 by Alex (leontyyy@gmail.com) Dec.2011} -function TIFFReadEXIFDirectory(Handle: PTIFF; Diroff: toff_t): Integer; cdecl; external; - -function TIFFReadDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFCurrentDirectory(Handle: PTIFF): Word; cdecl; external; -function TIFFCurrentDirOffset(Handle: PTIFF): {$ifdef VER403}int64{$else}Cardinal{$endif}; cdecl; external; -function TIFFLastDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFNumberOfDirectories(Handle: PTIFF): Word; cdecl; external; -function TIFFSetDirectory(Handle: PTIFF; Dirn: Word): Integer; cdecl; external; -function TIFFSetSubDirectory(Handle: PTIFF; Diroff: {$ifdef VER403}int64{$else}Cardinal{$endif}): Integer; cdecl; external; -function TIFFCreateDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFWriteDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFUnlinkDirectory(handle: PTIFF; Dirn: Word): Integer; cdecl; external; -procedure TIFFPrintDirectory(Handle: PTIFF; Fd: Pointer; Flags: Integer); cdecl; external; - -function TIFFGetField(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external; varargs; -function TIFFGetFieldDefaulted(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external; varargs; -function TIFFVGetField(Handle: PTIFF; Tag: Cardinal; Ap: Pointer): Integer; cdecl; external; -function TIFFSetField(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external; varargs; -function TIFFVSetField(Handle: PTIFF; Tag: Cardinal; Ap: Pointer): Integer; cdecl; external; -function TIFFIsBigEndian(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsTiled(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsByteSwapped(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsUpSampled(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsMSB2LSB(Handle: PTIFF): Integer; cdecl; external; - -function TIFFGetTagListCount(Handle: PTIFF): Integer; cdecl; external; -function TIFFGetTagListEntry(Handle: PTIFF; TagIndex: Integer): Cardinal; cdecl; external; -procedure TIFFMergeFieldInfo(Handle: PTIFF; Info: PTIFFFieldInfo; N: Integer); cdecl; external; -function TIFFFindFieldInfo(Handle: PTIFF; Tag: Cardinal; Dt: Integer): PTIFFFieldInfo; cdecl; external; -function TIFFFindFieldInfoByName(Handle: PTIFF; FIeldName: PAnsiChar; Dt: Integer): PTIFFFieldInfo; cdecl; external; -function TIFFFieldWithTag(Handle: PTIFF; Tag: Cardinal): PTIFFFieldInfo; cdecl; external; -function TIFFFieldWithName(Handle: PTIFF; FieldName: PAnsiChar): PTIFFFieldInfo; cdecl; external; -function TIFFDataWidth(DataType: Integer): Integer; cdecl; external; - -function TIFFReadRGBAImage(Handle: PTIFF; RWidth,RHeight: Cardinal; Raster: Pointer; Stop: Integer): Integer; cdecl; external; -function TIFFReadRGBAImageOriented(Handle: PTIFF; RWidth,RHeight: Cardinal; Raster: Pointer; Orientation: Integer; Stop: Integer): Integer; cdecl; external; -function TIFFReadRGBAStrip(Handle: PTIFF; Row: Cardinal; Raster: Pointer): Integer; cdecl; external; -function TIFFReadRGBATile(Handle: PTIFF; Col,Row: Cardinal; Raster: Pointer): Integer; cdecl; external; -function TIFFRGBAImageOk(Handle: PTIFF; Emsg: PAnsiChar): Integer; cdecl; external; -function TIFFRGBAImageBegin(Img: PTIFFRGBAImage; Handle: PTIFF; Stop: Integer; Emsg: PAnsiChar): Integer; cdecl; external; -function TIFFRGBAImageGet(Img: PTIFFRGBAImage; Raster: Pointer; W,H: Cardinal): Integer; cdecl; external; -procedure TIFFRGBAImageEnd(Img: PTIFFRGBAImage); cdecl; external; - -function TIFFCurrentRow(Handle: PTIFF): Cardinal; cdecl; external; - -function TIFFStripSize(Handle: PTIFF): tmsize_t; cdecl; external; -function TIFFRawStripSize(Handle: PTIFF; Strip: Cardinal): tmsize_t; cdecl; external; -function TIFFVStripSize(Handle: PTIFF; NRows: Cardinal): tmsize_t; cdecl; external; -function TIFFDefaultStripSize(Handle: PTIFF; Request: Cardinal): Cardinal; cdecl; external; -function TIFFNumberOfStrips(Handle: PTIFF): Cardinal; cdecl; external; -function TIFFComputeStrip(Handle: PTIFF; Row: Cardinal; Sample: Word): Cardinal; cdecl; external; -function TIFFReadRawStrip(Handle: PTIFF; Strip: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external; -function TIFFReadEncodedStrip(Handle: PTIFF; Strip: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external; -function TIFFWriteRawStrip(Handle: PTIFF; Strip: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external; -function TIFFWriteEncodedStrip(Handle: PTIFF; Strip: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external; -function TIFFCurrentStrip(Handle: PTIFF): Cardinal; cdecl; external; - -function TIFFTileSize(Handle: PTIFF): tmsize_t; cdecl; external; -function TIFFTileRowSize(Handle: PTIFF): tmsize_t; cdecl; external; -function TIFFVTileSize(Handle: PTIFF; NRows: Cardinal): tmsize_t; cdecl; external; -procedure TIFFDefaultTileSize(Handle: PTIFF; Tw: PCardinal; Th: PCardinal); cdecl; external; -function TIFFNumberOfTiles(Handle: PTIFF): Cardinal; cdecl; external; -function TIFFComputeTile(Handle: PTIFF; X,Y,Z: Cardinal; S: Word): Cardinal; cdecl; external; -function TIFFReadRawTile(Handle: PTIFF; Tile: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external; -function TIFFReadEncodedTile(Handle: PTIFF; Tile: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external; -function TIFFWriteRawTile(Handle: PTIFF; Tile: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external; -function TIFFWriteEncodedTile(Handle: PTIFF; Tile: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external; -function TIFFCurrentTile(Handle: PTIFF): Cardinal; cdecl; external; - -function TIFFScanlineSize(Handle: PTIFF): tmsize_t; cdecl; external; -{$ifdef VER403} -function TIFFScanlineSize64(Handle: PTIFF): int64; cdecl; external; -function TIFFRasterScanlineSize64(Handle: PTIFF): int64; cdecl; external; -{$endif} -function TIFFRasterScanlineSize(Handle: PTIFF): tmsize_t; cdecl; external; -function TIFFReadScanline(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: Word): Integer; cdecl; external; -function TIFFWriteScanline(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: Word): Integer; cdecl; external; - -procedure TIFFSetWriteOffset(Handle: PTIFF; Off: toff_t); cdecl; external; - -procedure TIFFSwabShort(Wp: PWord); cdecl; external; -procedure TIFFSwabLong(Lp: PCardinal); cdecl; external; -procedure TIFFSwabDouble(Dp: PDouble); cdecl; external; -procedure TIFFSwabArrayOfShort(Wp: PWord; N: tmsize_t); cdecl; external; -{$ifdef VER403} -procedure TIFFSwabArrayOfTriples(tp:PByte; n: tmsize_t); cdecl; external; -{$endif} -procedure TIFFSwabArrayOfLong(Lp: PCardinal; N: tmsize_t); cdecl; external; -procedure TIFFSwabArrayOfDouble(Dp: PDouble; N: tmsize_t); cdecl; external; -procedure TIFFReverseBits(Cp: Pointer; N: tmsize_t); cdecl; external; -function TIFFGetBitRevTable(Reversed: Integer): Pointer; cdecl; external; - -function _TIFFmalloc(s: tmsize_t): Pointer; cdecl; {$ifdef FPC}[public];{$endif} -function _TIFFrealloc(p: Pointer; s: tmsize_t): Pointer; cdecl; {$ifdef FPC}[public];{$endif} -procedure _TIFFfree(p: Pointer); cdecl; {$ifdef FPC}[public];{$endif} - -type - TUserTiffErrorHandler = procedure(const Module, Message: AnsiString); - -procedure SetUserMessageHandlers(ErrorHandler, WarningHandler: TUserTiffErrorHandler); - -implementation - -uses - Math, -{$IF Defined(DCC) and (CompilerVersion < 20)} - Windows, -{$IFEND} - LibJpegDelphi, - ZLibDelphi; - -var - { For FPC 3.0+ these must be marked as exported } - _TIFFwarningHandler: TIFFErrorHandler; {$ifdef FPC}cvar; export;{$endif} - _TIFFerrorHandler: TIFFErrorHandler; {$ifdef FPC}cvar; export;{$endif} - -type - TCompareFunc = function(a,b: Pointer): Integer; cdecl; - -function floor(x: Double): Double; cdecl; forward; {$ifdef FPC}[public];{$endif} -function pow(x: Double; y: Double): Double; cdecl; forward; {$ifdef FPC}[public];{$endif} -function sqrt(x: Double): Double; cdecl; forward; {$ifdef FPC}[public];{$endif} -function atan2(y: Double; x: Double): Double; cdecl; forward; {$ifdef FPC}[public];{$endif} -function exp(x: Double): Double; cdecl; forward; {$ifdef FPC}[public];{$endif} -function log(x: Double): Double; cdecl; forward; {$ifdef FPC}[public];{$endif} -function fabs(x: Double): Double; cdecl; forward; -function rand: Integer; cdecl; forward; {$ifdef FPC}[public];{$endif} -function strlen(s: Pointer): Cardinal; cdecl; forward; {$ifdef FPC}[public];{$endif} -function strcmp(a: Pointer; b: Pointer): Integer; cdecl; forward; {$ifdef FPC}[public];{$endif} -function strncmp(a: Pointer; b: Pointer; c: Longint): Integer; cdecl; forward; {$ifdef FPC}[public];{$endif} -procedure qsort(base: Pointer; num: Cardinal; width: Cardinal; compare: TCompareFunc); cdecl; forward; {$ifdef FPC}[public];{$endif} -//DW function bsearch(key: Pointer; base: Pointer; nelem: Cardinal; width: Cardinal; fcmp: TCompareFunc): Pointer; cdecl; forward; -function memmove(dest: Pointer; src: Pointer; n: Cardinal): Pointer; cdecl; forward; {$ifdef FPC}[public];{$endif} -function strchr(s: Pointer; c: Integer): Pointer; cdecl; forward; {$ifdef FPC}[public];{$endif} - -procedure _TIFFmemcpy(d: Pointer; s: Pointer; c: tmsize_t); cdecl; forward; {$ifdef FPC}[public];{$endif} -procedure _TIFFmemset(p: Pointer; v: Integer; c: tmsize_t); cdecl; forward; {$ifdef FPC}[public];{$endif} -function _TIFFmemcmp(buf1: Pointer; buf2: Pointer; count: tmsize_t): Integer; cdecl; forward; {$ifdef FPC}[public];{$endif} - -function fabs(x: Double): Double; cdecl; -begin - if x<0 then - Result:=-x - else - Result:=x; -end; - -function atan2(y: Double; x: Double): Double; cdecl; -begin - Result:=ArcTan2(y,x); -end; - -function rand: Integer; cdecl; -begin - Result:=Trunc(Random*($7FFF+1)); -end; - -function sqrt(x: Double): Double; cdecl; -begin - Result:=System.Sqrt(x); -end; - -function log(x: Double): Double; cdecl; -begin - Result:=Ln(x); -end; - -function exp(x: Double): Double; cdecl; -begin - Result:=System.Exp(x); -end; - -function strchr(s: Pointer; c: Integer): Pointer; cdecl; -{$ifndef FPC} -begin - Result:=s; - while True do - begin - if PByte(Result)^=c then exit; - if PByte(Result)^=0 then - begin - Result:=nil; - exit; - end; - Inc(PByte(Result)); - end; -{$else} -begin - Result:=strchr(s,c); -{$endif} -end; - -function memmove(dest: Pointer; src: Pointer; n: Cardinal): Pointer; cdecl; -begin - system.Move(src^,dest^,n); - Result:=dest; -end; - -function _TIFFmemcmp(buf1: Pointer; buf2: Pointer; count: tmsize_t): Integer; - cdecl; -{$ifndef FPC} -var - ma,mb: PByte; - n: Integer; -begin - ma:=buf1; - mb:=buf2; - n:=0; - while Cardinal(n)mb^ then - begin - if ma^=0 then - ob:=0 - else - begin - oa:=0; - ob:=n; - while oa+1mb^ then - begin - if ma^mb^ then - begin - if ma^0 do - begin - Inc(Result); - Inc(m); - end; - {$endif} -end; - -procedure _TIFFfree(p: Pointer); cdecl; -begin - FreeMem(p); -end; - -procedure _TIFFmemcpy(d: Pointer; s: Pointer; c: tmsize_t); cdecl; -begin - system.Move(s^,d^,c); -end; - -function pow(x: Double; y: Double): Double; cdecl; -begin - Result:=Power(x,y); -end; - -function floor(x: Double): Double; cdecl; -begin - Result:=Trunc(x); -end; - -function _TIFFmalloc(s: tmsize_t): Pointer; cdecl; -begin - Result:=AllocMem(s); -end; - -{LibTiffDelphi} - -var - UserTiffWarningHandler: TUserTiffErrorHandler; - UserTiffErrorHandler: TUserTiffErrorHandler; - -procedure SetUserMessageHandlers(ErrorHandler, WarningHandler: TUserTiffErrorHandler); -begin - UserTiffErrorHandler := ErrorHandler; - UserTiffWarningHandler := WarningHandler; -end; - -procedure FormatAndCallHandler(Handler: TUserTiffErrorHandler; Module: PAnsiChar; Format: PAnsiChar; Params: va_list); -var - Len: Integer; - Buffer: array[0..511] of AnsiChar; - Msg: AnsiString; -begin - Len := snprintf(@Buffer, 512, Format, Params); - SetString(Msg, Buffer, Len); - Handler(Module, Msg); -end; - -procedure InternalTIFFWarning(Module: PAnsiChar; Format: PAnsiChar; Params: va_list); cdecl; -begin - if Assigned(UserTiffWarningHandler) then - FormatAndCallHandler(UserTiffWarningHandler, Module, Format, Params); -end; - -procedure InternallTIFFError(Module: PAnsiChar; Format: PAnsiChar; Params: va_list); cdecl; -begin - if Assigned(UserTiffErrorHandler) then - FormatAndCallHandler(UserTiffErrorHandler, Module, Format, Params); -end; - -{tif_read} - -procedure _TIFFSwab16BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -procedure _TIFFSwab24BitData(tif: pointer; buf: pointer; cc: integer); cdecl; external; //DW 3.8.2 -procedure _TIFFSwab32BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -procedure _TIFFSwab64BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -procedure _TIFFNoPostDecode(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -function TIFFReadTile(tif: Pointer; buf: Pointer; x: Cardinal; y: Cardinal; z: Cardinal; s: Word): tmsize_t; cdecl; external; -function TIFFFillTile(tif: Pointer; tile: UInt32):integer; cdecl; external; //DW 3.8.2 - -{tif_dirinfo} - -function _TIFFSampleToTagType(tif: Pointer): Integer; cdecl; external; -procedure _TIFFSetupFieldInfo(tif: Pointer); cdecl; external; -function _TIFFCreateAnonFieldInfo(tif: Pointer; tag: Cardinal; field_type: Integer): Pointer; cdecl; external; -function _TIFFGetExifFieldInfo(size : plongint):pointer; cdecl; external; //DW 3.8.2 -function _TIFFDataSize(TIFFDataType : longint):longint; cdecl; external; //DW 3.8.2 -function _TIFFGetFieldInfo(size : plongint):pointer; cdecl; external; //DW 3.8.2 -function _TIFFMergeFieldInfo(tif: Pointer; fieldinfo : Pointer; n : Integer):Integer; cdecl; external; //DW 3.9.1 - -{tif_dirwrite} - -{tif_flush} - -{tif_write} - -function TIFFFlushData1(tif: Pointer): Integer; cdecl; external; -function TIFFSetupStrips(tif: Pointer): Integer; cdecl; external; - -{tif_dumpmode} - -function TIFFInitDumpMode(tif: Pointer; scheme: Integer): Integer; cdecl; external; - -{tif_compress} - -function TIFFSetCompressionScheme(tif: Pointer; scheme: Integer): Integer; cdecl; external; -procedure _TIFFSetDefaultCompressionState(tif: Pointer); cdecl; external; - -{tif_dirread} - -{tif_dir} - -procedure TIFFFreeDirectory(tif: Pointer); cdecl; external; -function TIFFDefaultDirectory(tif: Pointer): Integer; cdecl; external; -function TIFFReassignTagToIgnore(task: Integer; TIFFtagID: Integer): Integer; cdecl; external; -procedure _TIFFsetString(cpp: Pointer; cp: Pointer); cdecl; external; -procedure _TIFFsetByteArray(vpp: Pointer; vp: Pointer; n: Integer); cdecl; external; - -{tif_aux} - -function TIFFVGetFieldDefaulted(tif: Pointer; tag: Cardinal; ap: Pointer): Integer; cdecl; external; - -{tif_color} - -procedure TIFFCIELabToXYZ(cielab: Pointer; l: Cardinal; a: Integer; b: Integer; X: Pointer; Y: Pointer; Z: Pointer); cdecl; external; -procedure TIFFXYZToRGB(cielab: Pointer; X: Single; Y: Single; Z: Single; r: Pointer; g: Pointer; b: Pointer); cdecl; external; -procedure TIFFYCbCrtoRGB(ycbcr: Pointer; Y: Cardinal; Cb: Integer; Cr: Integer; r: Pointer; g: Pointer; b: Pointer); cdecl; external; -function TIFFYCbCrToRGBInit(ycbcr: Pointer; luma: PSingle; refBlackWhite: PSingle): Integer; cdecl; external; -function TIFFCIELabToRGBInit(cielab: Pointer; display: Pointer; refWhite: Pointer): Integer; cdecl; external; - -{tif_close} - -{tif_extension} - -{tif_open} - -function _TIFFgetMode(mode: PAnsiChar; module: PAnsiChar): Integer; cdecl; external; - -{tif_getimage} - -{tif_predict} - -function TIFFPredictorInit(tif: PTIFF): Integer; cdecl; external; -function TIFFPredictorCleanup(tif: PTIFF):integer; cdecl; external; //DW 3.8.2 - -{tif_print} - -{tif_error} - -{tif_strip} - -function _TIFFDefaultStripSize(tif: Pointer; s: Cardinal): Cardinal; cdecl; external; -function TIFFOldScanlineSize(tif: Pointer):Cardinal; cdecl; external; //DW 3.9.1 - -{tif_swab} - -{tif_tile} - -function TIFFCheckTile(tif: Pointer; x: Cardinal; y: Cardinal; z: Cardinal; s: Word): Integer; cdecl; external; -procedure _TIFFDefaultTileSize(tif: Pointer; tw: Pointer; th: Pointer); cdecl; external; - -{tif_warning} - -{tif_fax3} - -function TIFFInitCCITTRLE(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFInitCCITTRLEW(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFInitCCITTFax3(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFInitCCITTFax4(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_fax3sm} - -{tif_jpeg} - -procedure TIFFjpeg_error_exit_raise(errcode:Integer); cdecl; {$ifdef FPC}[public];{$endif} -begin - raise Exception.Create(Format('jpeg error code %d',[errcode])); -end; - -function TIFFcallvjpeg_jpeg_CreateCompress(cinfo: Pointer; version: Integer; structsize: Cardinal): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_CreateCompress(cinfo,version,structsize); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_CreateDecompress(cinfo: Pointer; version: Integer; structsize: Cardinal): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_CreateDecompress(cinfo,version,structsize); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_set_defaults(cinfo: Pointer): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_set_defaults(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_set_colorspace(cinfo: Pointer; colorspace: Integer): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_set_colorspace(cinfo, colorspace); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_set_quality(cinfo: Pointer; quality: Integer; force_baseline: Byte): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_set_quality(cinfo,quality,force_baseline); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_suppress_tables(cinfo: Pointer; suppress: Byte): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_suppress_tables(cinfo,suppress); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_start_compress(cinfo: Pointer; write_all_tables: Byte): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_start_compress(cinfo,write_all_tables); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcalljpeg_jpeg_write_scanlines(errreturn: Integer; cinfo: Pointer; scanlines: Pointer; num_lines: Cardinal): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - Result:=jpeg_write_scanlines(cinfo,scanlines,num_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcalljpeg_jpeg_write_raw_data(errreturn: Integer; cinfo: Pointer; data: Pointer; num_lines: Cardinal): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - Result:=jpeg_write_raw_data(cinfo,data,num_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcallvjpeg_jpeg_finish_compress(cinfo: Pointer): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_finish_compress(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_write_tables(cinfo: Pointer): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_write_tables(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcalljpeg_jpeg_read_header(errreturn: Integer; cinfo: Pointer; require_image: Byte): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - Result:=jpeg_read_header(cinfo,Boolean(require_image)); - except - Result:=errreturn; - end; -end; - -function TIFFcallvjpeg_jpeg_start_decompress(cinfo: Pointer): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_start_decompress(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcalljpeg_jpeg_read_scanlines(errreturn: Integer; cinfo: Pointer; scanlines: Pointer; max_lines: Cardinal): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - Result:=jpeg_read_scanlines(cinfo,scanlines,max_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcalljpeg_jpeg_read_raw_data(errreturn: Integer; cinfo: Pointer; data: Pointer; max_lines: Cardinal): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - Result:=jpeg_read_raw_data(cinfo,data,max_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcalljpeg_jpeg_finish_decompress(errreturn: Integer; cinfo: PRJpegDecompressStruct): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - Result:=jpeg_finish_decompress(cinfo); - except - Result:=errreturn; - end; -end; - -function TIFFcallvjpeg_jpeg_abort(cinfo: Pointer): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_abort(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_destroy(cinfo: Pointer): Integer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - jpeg_destroy(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -type - jpeg_alloc_sarray = function(cinfo: Pointer; pool_id: Integer; samplesperrow: Cardinal; numrows: Cardinal): Pointer; cdecl; - -function TIFFcalljpeg_alloc_sarray(alloc_sarray: jpeg_alloc_sarray; cinfo: PRJpegCommonStruct; pool_id: Integer; samplesperrow: Cardinal; - numrows: Cardinal): Pointer; cdecl; {$ifdef FPC}[public];{$endif} -begin - try - Result:=alloc_sarray(cinfo,pool_id,samplesperrow,numrows); - except - Result:=nil; - end; -end; - -function TIFFInitJPEG(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFFillStrip(tif : PTIFF; Len : UInt32): integer; cdecl; external; //DW 3.8.2 - -{tif_luv} - -function TIFFInitSGILog(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_lzw} - -function TIFFInitLZW(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_next} - -function TIFFInitNeXT(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_packbits} - -function TIFFInitPackBits(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_pixarlog} - -function TIFFInitPixarLog(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_thunder} - -function TIFFInitThunderScan(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_version} - -{tif_zip} - -function TIFFInitZIP(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{tif_codec} - -function NotConfigured(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{DW -const - - _TIFFBuiltinCODECS: array[0..17] of TIFFCodec = ( - (name:'None'; scheme: COMPRESSION_NONE; init: TIFFInitDumpMode), - (name:'LZW'; scheme: COMPRESSION_LZW; init: TIFFInitLZW), - (name:'PackBits'; scheme: COMPRESSION_PACKBITS; init: TIFFInitPackBits), - (name:'ThunderScan'; scheme: COMPRESSION_THUNDERSCAN; init: TIFFInitThunderScan), - (name:'NeXT'; scheme: COMPRESSION_NEXT; init: TIFFInitNeXT), - (name:'JPEG'; scheme: COMPRESSION_JPEG; init: TIFFInitJPEG), - (name:'Old-style JPEG'; scheme: COMPRESSION_OJPEG; init: NotConfigured), - (name:'CCITT RLE'; scheme: COMPRESSION_CCITTRLE; init: TIFFInitCCITTRLE), - (name:'CCITT RLE/W'; scheme: COMPRESSION_CCITTRLEW; init: TIFFInitCCITTRLEW), - (name:'CCITT Group 3'; scheme: COMPRESSION_CCITTFAX3; init: TIFFInitCCITTFax3), - (name:'CCITT Group 4'; scheme: COMPRESSION_CCITTFAX4; init: TIFFInitCCITTFax4), - (name:'ISO JBIG'; scheme: COMPRESSION_JBIG; init: NotConfigured), - (name:'Deflate'; scheme: COMPRESSION_DEFLATE; init: TIFFInitZIP), - (name:'AdobeDeflate'; scheme: COMPRESSION_ADOBE_DEFLATE; init: TIFFInitZIP), - (name:'PixarLog'; scheme: COMPRESSION_PIXARLOG; init: TIFFInitPixarLog), - (name:'SGILog'; scheme: COMPRESSION_SGILOG; init: TIFFInitSGILog), - (name:'SGILog24'; scheme: COMPRESSION_SGILOG24; init: TIFFInitSGILog), - (name:nil; scheme:0; init:nil)); -} - -{LibTiffDelphi} - -function TIFFFileReadProc(Fd: THandle; Buffer: Pointer; Size: Integer): Integer; cdecl; forward; -function TIFFFileWriteProc(Fd: THandle; Buffer: Pointer; Size: Integer): Integer; cdecl; forward; -function TIFFFileSizeProc(Fd: THandle): {$ifdef VER403}int64{$else}Cardinal{$endif}; cdecl; forward; -function TIFFFileSeekProc(Fd: THandle; Off: {$ifdef VER403}int64{$else}Cardinal{$endif}; Whence: Integer): {$ifdef VER403}int64{$else}Cardinal{$endif}; cdecl; forward; -function TIFFFileCloseProc(Fd: THandle): Integer; cdecl; forward; - -function TIFFNoMapProc(Fd: THandle; PBase: PPointer; PSize: {$ifdef VER403}PInt64{$else}PCardinal{$endif}): Integer; cdecl; forward; -procedure TIFFNoUnmapProc(Fd: THandle; Base: Pointer; Size: {$ifdef VER403}int64{$else}Cardinal{$endif}); cdecl; forward; - -function TIFFFileCloseProc(Fd: THandle): Integer; cdecl; -begin - FileClose(Fd); - Result:=0; - { - if CloseHandle(Fd)=True then - Result:=0 - else - Result:=-1; - } -end; - -const - SEEK_SET = 0; - SEEK_CUR = 1; - SEEK_END = 2; - -function TIFFFileSizeProc(Fd: THandle): {$ifdef VER403}int64{$else}Cardinal{$endif}; cdecl; -begin - Result := FileSeek(fd, 0, SEEK_END); - {$ifndef VER403} - if Result <> UInt32(-1) then - Result := 0; - {$endif} - //Result:=GetFileSize(Fd,nil); -end; - -function TIFFFileSeekProc(Fd: THandle; Off: {$ifdef VER403}int64{$else}Cardinal{$endif}; Whence: Integer): {$ifdef VER403}int64{$else}Cardinal{$endif}; cdecl; -begin - if Off = UInt32(-1) then - begin - Result := UInt32(-1); - exit; - end; - Result := FileSeek(Fd,Off,Whence); -end; - -function TIFFFileReadProc(Fd: THandle; Buffer: Pointer; Size: Integer): Integer; cdecl; -begin - Result:=FileRead(Fd,Buffer^,Cardinal(Size)); - if Result<0 then - Result:=0; -end; - -function TIFFFileWriteProc(Fd: THandle; Buffer: Pointer; Size: Integer): Integer; cdecl; -begin - Result:=FileWrite(Fd,Buffer^,Cardinal(Size)); - if Result<0 then - Result:=0; -end; - -function TIFFNoMapProc(Fd: THandle; PBase: PPointer; PSize: {$ifdef VER403}PInt64{$else}PCardinal{$endif}): Integer; cdecl; -begin - Result:=0; -end; - -procedure TIFFNoUnmapProc(Fd: THandle; Base: Pointer; Size: {$ifdef VER403}int64{$else}Cardinal{$endif}); cdecl; -begin -end; - -function TIFFOpen(const Name: AnsiString; const Mode: AnsiString): PTIFF; -const - Module: AnsiString = 'TIFFOpen'; - O_RDONLY = 0; - O_WRONLY = 1; - O_RDWR = 2; - O_CREAT = $0100; - O_TRUNC = $0200; -var - m: Integer; - DesiredAccess: Cardinal; - fd: THandle; - InvalidHandle: THandle; -begin - m:=_TIFFgetMode(PAnsiChar(Mode),PAnsiChar(Module)); - if m=o_RDONLY then - DesiredAccess:=fmOpenRead - else - DesiredAccess:=fmOpenReadWrite; - - case m of - O_RDONLY: DesiredAccess:=fmOpenRead; - O_RDWR: DesiredAccess:=fmOpenReadWrite; - (O_RDWR or O_CREAT): DesiredAccess:=DesiredAccess or fmCreate; - (O_RDWR or O_TRUNC): DesiredAccess:=fmCreate; - (O_RDWR or O_CREAT or O_TRUNC): DesiredAccess:=fmCreate; - else - Result:=nil; - exit; - end; - -{$IFDEF DCC} - InvalidHandle := INVALID_HANDLE_VALUE; -{$ELSE} - InvalidHandle := feInvalidHandle; -{$ENDIF} - - if DesiredAccess = fmCreate then - fd := FileCreate(Name, fmShareDenyWrite) - else - fd := FileOpen(Name, fmShareDenyWrite or DesiredAccess); - - if fd = InvalidHandle then - begin - TiffError(PAnsiChar(Module), PAnsiChar('Cannot open file: ' + Name), nil); - Result:=nil; - exit; - end; - - Result := TIFFClientOpen(PAnsiChar(Name), PAnsiChar(Mode), fd, - TIFFReadWriteProc(@TIFFFileReadProc), TIFFReadWriteProc(@TIFFFileWriteProc), TIFFSeekProc(@TIFFFileSeekProc), TIFFCloseProc(@TIFFFileCloseProc), - TIFFSizeProc(@TIFFFileSizeProc), TIFFMapFileProc(@TIFFNoMapProc), TIFFUnmapFileProc(@TIFFNoUnmapProc)); - - if Result <> nil then - TIFFSetFileno(Result,fd) - else - FileClose(fd); -end; - -{$IF Defined(DCC) and Defined(MSWINDOWS) and not Defined(CPUX64)} - // Delphi Win32 - {$L Compiled\tif_read.obj} - {$L Compiled\tif_dirinfo.obj} - {$L Compiled\tif_dirwrite.obj} - {$L Compiled\tif_flush.obj} - {$L Compiled\tif_write.obj} - {$L Compiled\tif_dumpmode.obj} - {$L Compiled\tif_compress.obj} - {$L Compiled\tif_dirread.obj} - {$L Compiled\tif_dir.obj} - {$L Compiled\tif_aux.obj} - {$L Compiled\tif_color.obj} - {$L Compiled\tif_close.obj} - {$L Compiled\tif_extension.obj} - {$L Compiled\tif_open.obj} - {$L Compiled\tif_getimage.obj} - {$L Compiled\tif_predict.obj} - {$L Compiled\tif_print.obj} - {$L Compiled\tif_error.obj} - {$L Compiled\tif_strip.obj} - {$L Compiled\tif_swab.obj} - {$L Compiled\tif_tile.obj} - {$L Compiled\tif_warning.obj} - {$L Compiled\tif_fax3.obj} - {$L Compiled\tif_fax3sm.obj} - {$L Compiled\tif_jpeg.obj} - {$L Compiled\tif_luv.obj} - {$L Compiled\tif_lzw.obj} - {$L Compiled\tif_next.obj} - {$L Compiled\tif_packbits.obj} - {$L Compiled\tif_pixarlog.obj} - {$L Compiled\tif_thunder.obj} - {$L Compiled\tif_version.obj} - {$L Compiled\tif_zip.obj} - {$L Compiled\tif_codec.obj} -{$ELSEIF Defined(FPC) and Defined(WIN32)} - // Windows 32bit FPC - COFF format lib - {$LINKLIB libtiffpack-win32.a} -{$ELSEIF Defined(FPC) and Defined(WIN64)} - // Windows 64bit FPC - COFF format lib - {$LINKLIB libtiffpack-win64.a} -{$IFEND} - -initialization - TIFFSetWarningHandler(@InternalTIFFWarning); - TIFFSetErrorHandler(@InternallTIFFError); - -end. - diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/LibTiffDynLib.pas b/components/vampireimaging/Extras/Extensions/LibTiff/LibTiffDynLib.pas deleted file mode 100644 index e2a3f5f..0000000 --- a/components/vampireimaging/Extras/Extensions/LibTiff/LibTiffDynLib.pas +++ /dev/null @@ -1,803 +0,0 @@ -unit LibTiffDynLib; - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -// We prefer dynamic loading of the library (GetProcAddress/dlsym way) -// so that we don't get a crash with "libtiff not found!" message on startup -// if libtiff is not found in user's system. -{$DEFINE DYNAMIC_DLL_LOADING} - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} - SysUtils; - -type - va_list = Pointer; -{$IFNDEF FPC} -{$IF CompilerVersion <= 18.5} - SizeInt = Integer; -{$ELSE} - SizeInt = NativeInt; -{$IFEND} -{$ENDIF} - -type - tmsize_t = SizeInt; - tsize_t = SizeInt; - // typedef uint64 toff_t; /* file offset */ - toff_t = Int64; - poff_t = ^toff_t; - tsample_t = Word; - // Beware: THandle is 32bit in size even on 64bit Linux - this may cause - // problems as pointers to client data are passed in thandle_t vars. - thandle_t = THandle; - tdata_t = Pointer; - ttag_t = UInt32; - tdir_t = Word; - tstrip_t = UInt32; - -const - // LibTiff 4.0 -{$IF Defined(MSWINDOWS)} - SLibName = 'libtiff.dll'; // make sure you have DLL with the same bitness as your app! -{$ELSEIF Defined(DARWIN)} // macOS - SLibName = 'libtiff.5.dylib'; -{$ELSE} // Linux, BSD - SLibName = 'libtiff.so.5'; // yes, SONAME for libtiff v4.0 is actually libtiff5 (and libtiff.so.4 is libtiff v3.9) -{$IFEND} - - TIFF_NOTYPE = 0; - TIFF_BYTE = 1; { 8-bit unsigned integer } - TIFF_ASCII = 2; { 8-bit bytes w/ last byte null } - TIFF_SHORT = 3; { 16-bit unsigned integer } - TIFF_LONG = 4; { 32-bit unsigned integer } - TIFF_RATIONAL = 5; { 64-bit unsigned fraction } - TIFF_SBYTE = 6; { !8-bit signed integer } - TIFF_UNDEFINED = 7; { !8-bit untyped data } - TIFF_SSHORT = 8; { !16-bit signed integer } - TIFF_SLONG = 9; { !32-bit signed integer } - TIFF_SRATIONAL = 10; { !64-bit signed fraction } - TIFF_FLOAT = 11; { !32-bit IEEE floating point } - TIFF_DOUBLE = 12; { !64-bit IEEE floating point } - TIFF_IFD = 13; { %32-bit unsigned integer (offset) } - TIFF_UNICODE = 14; - TIFF_COMPLEX = 15; - TIFF_LONG8 = 16; - TIFF_SLONG8 = 17; - TIFF_IFD8 = 18; - - TIFFTAG_SUBFILETYPE = 254; { subfile data descriptor } - FILETYPE_REDUCEDIMAGE = $1; { reduced resolution version } - FILETYPE_PAGE = $2; { one page of many } - FILETYPE_MASK = $4; { transparency mask } - TIFFTAG_OSUBFILETYPE = 255; { kind of data in subfile } - OFILETYPE_IMAGE = 1; { full resolution image data } - OFILETYPE_REDUCEDIMAGE = 2; { reduced size image data } - OFILETYPE_PAGE = 3; { one page of many } - TIFFTAG_IMAGEWIDTH = 256; { image width in pixels } - TIFFTAG_IMAGELENGTH = 257; { image height in pixels } - TIFFTAG_BITSPERSAMPLE = 258; { bits per channel (sample) } - TIFFTAG_COMPRESSION = 259; { data compression technique } - COMPRESSION_NONE = 1; { dump mode } - COMPRESSION_CCITTRLE = 2; { CCITT modified Huffman RLE } - COMPRESSION_CCITTFAX3 = 3; { CCITT Group 3 fax encoding } - COMPRESSION_CCITT_T4 = 3; { CCITT T.4 (TIFF 6 name) } - COMPRESSION_CCITTFAX4 = 4; { CCITT Group 4 fax encoding } - COMPRESSION_CCITT_T6 = 4; { CCITT T.6 (TIFF 6 name) } - COMPRESSION_LZW = 5; { Lempel-Ziv & Welch } - COMPRESSION_OJPEG = 6; { !6.0 JPEG } - COMPRESSION_JPEG = 7; { %JPEG DCT compression } - COMPRESSION_NEXT = 32766; { NeXT 2-bit RLE } - COMPRESSION_CCITTRLEW = 32771; { #1 w/ word alignment } - COMPRESSION_PACKBITS = 32773; { Macintosh RLE } - COMPRESSION_THUNDERSCAN = 32809; { ThunderScan RLE } - { codes 32895-32898 are reserved for ANSI IT8 TIFF/IT } - COMPRESSION_DCS = 32947; { Kodak DCS encoding } - COMPRESSION_JBIG = 34661; { ISO JBIG } - COMPRESSION_SGILOG = 34676; { SGI Log Luminance RLE } - COMPRESSION_SGILOG24 = 34677; { SGI Log 24-bit packed } - COMPRESSION_JP2000 = 34712; { Leadtools JPEG2000 } - TIFFTAG_PHOTOMETRIC = 262; { photometric interpretation } - PHOTOMETRIC_MINISWHITE = 0; { min value is white } - PHOTOMETRIC_MINISBLACK = 1; { min value is black } - PHOTOMETRIC_RGB = 2; { RGB color model } - PHOTOMETRIC_PALETTE = 3; { color map indexed } - PHOTOMETRIC_MASK = 4; { $holdout mask } - PHOTOMETRIC_SEPARATED = 5; { !color separations } - PHOTOMETRIC_YCBCR = 6; { !CCIR 601 } - PHOTOMETRIC_CIELAB = 8; { !1976 CIE L*a*b* } - PHOTOMETRIC_ICCLAB = 9; { ICC L*a*b* [Adobe TIFF Technote 4] } - PHOTOMETRIC_ITULAB = 10; { ITU L*a*b* } - PHOTOMETRIC_LOGL = 32844; { CIE Log2(L) } - PHOTOMETRIC_LOGLUV = 32845; { CIE Log2(L) (u',v') } - TIFFTAG_THRESHHOLDING = 263; { thresholding used on data } - THRESHHOLD_BILEVEL = 1; { b&w art scan } - THRESHHOLD_HALFTONE = 2; { or dithered scan } - THRESHHOLD_ERRORDIFFUSE = 3; { usually floyd-steinberg } - TIFFTAG_CELLWIDTH = 264; { +dithering matrix width } - TIFFTAG_CELLLENGTH = 265; { +dithering matrix height } - TIFFTAG_FILLORDER = 266; { data order within a byte } - FILLORDER_MSB2LSB = 1; { most significant -> least } - FILLORDER_LSB2MSB = 2; { least significant -> most } - TIFFTAG_DOCUMENTNAME = 269; { name of doc. image is from } - TIFFTAG_IMAGEDESCRIPTION = 270; { info about image } - TIFFTAG_MAKE = 271; { scanner manufacturer name } - TIFFTAG_MODEL = 272; { scanner model name/number } - TIFFTAG_STRIPOFFSETS = 273; { offsets to data strips } - TIFFTAG_ORIENTATION = 274; { +image orientation } - ORIENTATION_TOPLEFT = 1; { row 0 top, col 0 lhs } - ORIENTATION_TOPRIGHT = 2; { row 0 top, col 0 rhs } - ORIENTATION_BOTRIGHT = 3; { row 0 bottom, col 0 rhs } - ORIENTATION_BOTLEFT = 4; { row 0 bottom, col 0 lhs } - ORIENTATION_LEFTTOP = 5; { row 0 lhs, col 0 top } - ORIENTATION_RIGHTTOP = 6; { row 0 rhs, col 0 top } - ORIENTATION_RIGHTBOT = 7; { row 0 rhs, col 0 bottom } - ORIENTATION_LEFTBOT = 8; { row 0 lhs, col 0 bottom } - TIFFTAG_SAMPLESPERPIXEL = 277; { samples per pixel } - TIFFTAG_ROWSPERSTRIP = 278; { rows per strip of data } - TIFFTAG_STRIPBYTECOUNTS = 279; { bytes counts for strips } - TIFFTAG_MINSAMPLEVALUE = 280; { +minimum sample value } - TIFFTAG_MAXSAMPLEVALUE = 281; { +maximum sample value } - TIFFTAG_XRESOLUTION = 282; { pixels/resolution in x } - TIFFTAG_YRESOLUTION = 283; { pixels/resolution in y } - TIFFTAG_PLANARCONFIG = 284; { storage organization } - PLANARCONFIG_CONTIG = 1; { single image plane } - PLANARCONFIG_SEPARATE = 2; { separate planes of data } - TIFFTAG_PAGENAME = 285; { page name image is from } - TIFFTAG_XPOSITION = 286; { x page offset of image lhs } - TIFFTAG_YPOSITION = 287; { y page offset of image lhs } - TIFFTAG_FREEOFFSETS = 288; { +byte offset to free block } - TIFFTAG_FREEBYTECOUNTS = 289; { +sizes of free blocks } - - {matched with tag reference up to this point} - - TIFFTAG_GRAYRESPONSEUNIT = 290; { $gray scale curve accuracy } - GRAYRESPONSEUNIT_10S = 1; { tenths of a unit } - GRAYRESPONSEUNIT_100S = 2; { hundredths of a unit } - GRAYRESPONSEUNIT_1000S = 3; { thousandths of a unit } - GRAYRESPONSEUNIT_10000S = 4; { ten-thousandths of a unit } - GRAYRESPONSEUNIT_100000S = 5; { hundred-thousandths } - TIFFTAG_GRAYRESPONSECURVE = 291; { $gray scale response curve } - TIFFTAG_GROUP3OPTIONS = 292; { 32 flag bits } - TIFFTAG_T4OPTIONS = 292; { TIFF 6.0 proper name alias } - GROUP3OPT_2DENCODING = $1; { 2-dimensional coding } - GROUP3OPT_UNCOMPRESSED = $2; { data not compressed } - GROUP3OPT_FILLBITS = $4; { fill to byte boundary } - TIFFTAG_GROUP4OPTIONS = 293; { 32 flag bits } - TIFFTAG_T6OPTIONS = 293; { TIFF 6.0 proper name } - GROUP4OPT_UNCOMPRESSED = $2; { data not compressed } - TIFFTAG_RESOLUTIONUNIT = 296; { units of resolutions } - RESUNIT_NONE = 1; { no meaningful units } - RESUNIT_INCH = 2; { english } - RESUNIT_CENTIMETER = 3; { metric } - TIFFTAG_PAGENUMBER = 297; { page numbers of multi-page } - TIFFTAG_COLORRESPONSEUNIT = 300; { $color curve accuracy } - COLORRESPONSEUNIT_10S = 1; { tenths of a unit } - COLORRESPONSEUNIT_100S = 2; { hundredths of a unit } - COLORRESPONSEUNIT_1000S = 3; { thousandths of a unit } - COLORRESPONSEUNIT_10000S = 4; { ten-thousandths of a unit } - COLORRESPONSEUNIT_100000S = 5; { hundred-thousandths } - TIFFTAG_TRANSFERFUNCTION = 301; { !colorimetry info } - TIFFTAG_SOFTWARE = 305; { name & release } - TIFFTAG_DATETIME = 306; { creation date and time } - TIFFTAG_ARTIST = 315; { creator of image } - TIFFTAG_HOSTCOMPUTER = 316; { machine where created } - TIFFTAG_PREDICTOR = 317; { prediction scheme w/ LZW } - TIFFTAG_WHITEPOINT = 318; { image white point } - TIFFTAG_PRIMARYCHROMATICITIES = 319; { !primary chromaticities } - TIFFTAG_COLORMAP = 320; { RGB map for pallette image } - TIFFTAG_HALFTONEHINTS = 321; { !highlight+shadow info } - TIFFTAG_TILEWIDTH = 322; { !rows/data tile } - TIFFTAG_TILELENGTH = 323; { !cols/data tile } - TIFFTAG_TILEOFFSETS = 324; { !offsets to data tiles } - TIFFTAG_TILEBYTECOUNTS = 325; { !byte counts for tiles } - TIFFTAG_BADFAXLINES = 326; { lines w/ wrong pixel count } - TIFFTAG_CLEANFAXDATA = 327; { regenerated line info } - CLEANFAXDATA_CLEAN = 0; { no errors detected } - CLEANFAXDATA_REGENERATED = 1; { receiver regenerated lines } - CLEANFAXDATA_UNCLEAN = 2; { uncorrected errors exist } - TIFFTAG_CONSECUTIVEBADFAXLINES = 328; { max consecutive bad lines } - TIFFTAG_SUBIFD = 330; { subimage descriptors } - TIFFTAG_INKSET = 332; { !inks in separated image } - INKSET_CMYK = 1; { !cyan-magenta-yellow-black color } - INKSET_MULTIINK = 2; { !multi-ink or hi-fi color } - TIFFTAG_INKNAMES = 333; { !ascii names of inks } - TIFFTAG_NUMBEROFINKS = 334; { !number of inks } - TIFFTAG_DOTRANGE = 336; { !0% and 100% dot codes } - TIFFTAG_TARGETPRINTER = 337; { !separation target } - TIFFTAG_EXTRASAMPLES = 338; { !info about extra samples } - EXTRASAMPLE_UNSPECIFIED = 0; { !unspecified data } - EXTRASAMPLE_ASSOCALPHA = 1; { !associated alpha data } - EXTRASAMPLE_UNASSALPHA = 2; { !unassociated alpha data } - TIFFTAG_SAMPLEFORMAT = 339; { !data sample format } - SAMPLEFORMAT_UINT = 1; { !unsigned integer data } - SAMPLEFORMAT_INT = 2; { !signed integer data } - SAMPLEFORMAT_IEEEFP = 3; { !IEEE floating point data } - SAMPLEFORMAT_VOID = 4; { !untyped data } - SAMPLEFORMAT_COMPLEXINT = 5; { !complex signed int } - SAMPLEFORMAT_COMPLEXIEEEFP = 6; { !complex ieee floating } - TIFFTAG_SMINSAMPLEVALUE = 340; { !variable MinSampleValue } - TIFFTAG_SMAXSAMPLEVALUE = 341; { !variable MaxSampleValue } - TIFFTAG_CLIPPATH = 343; { %ClipPath [Adobe TIFF technote 2] } - TIFFTAG_XCLIPPATHUNITS = 344; { %XClipPathUnits [Adobe TIFF technote 2] } - TIFFTAG_YCLIPPATHUNITS = 345; { %YClipPathUnits [Adobe TIFF technote 2] } - TIFFTAG_INDEXED = 346; { %Indexed [Adobe TIFF Technote 3] } - TIFFTAG_JPEGTABLES = 347; { %JPEG table stream } - TIFFTAG_OPIPROXY = 351; { %OPI Proxy [Adobe TIFF technote] } - { Tags 512-521 are obsoleted by Technical Note #2 - which specifies a revised JPEG-in-TIFF scheme. } - TIFFTAG_JPEGPROC = 512; { !JPEG processing algorithm } - JPEGPROC_BASELINE = 1; { !baseline sequential } - JPEGPROC_LOSSLESS = 14; { !Huffman coded lossless } - TIFFTAG_JPEGIFOFFSET = 513; { !pointer to SOI marker } - TIFFTAG_JPEGIFBYTECOUNT = 514; { !JFIF stream length } - TIFFTAG_JPEGRESTARTINTERVAL = 515; { !restart interval length } - TIFFTAG_JPEGLOSSLESSPREDICTORS = 517; { !lossless proc predictor } - TIFFTAG_JPEGPOINTTRANSFORM = 518; { !lossless point transform } - TIFFTAG_JPEGQTABLES = 519; { !Q matrice offsets } - TIFFTAG_JPEGDCTABLES = 520; { !DCT table offsets } - TIFFTAG_JPEGACTABLES = 521; { !AC coefficient offsets } - TIFFTAG_YCBCRCOEFFICIENTS = 529; { !RGB -> YCbCr transform } - TIFFTAG_YCBCRSUBSAMPLING = 530; { !YCbCr subsampling factors } - TIFFTAG_YCBCRPOSITIONING = 531; { !subsample positioning } - YCBCRPOSITION_CENTERED = 1; { !as in PostScript Level 2 } - YCBCRPOSITION_COSITED = 2; { !as in CCIR 601-1 } - TIFFTAG_REFERENCEBLACKWHITE = 532; { !colorimetry info } - TIFFTAG_XMLPACKET = 700; { %XML packet [Adobe XMP technote 9-14-02] (dkelly@apago.com) } - TIFFTAG_OPIIMAGEID = 32781; { %OPI ImageID [Adobe TIFF technote] } - { tags 32952-32956 are private tags registered to Island Graphics } - TIFFTAG_REFPTS = 32953; { image reference points } - TIFFTAG_REGIONTACKPOINT = 32954; { region-xform tack point } - TIFFTAG_REGIONWARPCORNERS = 32955; { warp quadrilateral } - TIFFTAG_REGIONAFFINE = 32956; { affine transformation mat } - { tags 32995-32999 are private tags registered to SGI } - TIFFTAG_MATTEING = 32995; { $use ExtraSamples } - TIFFTAG_DATATYPE = 32996; { $use SampleFormat } - TIFFTAG_IMAGEDEPTH = 32997; { z depth of image } - TIFFTAG_TILEDEPTH = 32998; { z depth/data tile } - { tags 33300-33309 are private tags registered to Pixar } - { TIFFTAG_PIXAR_IMAGEFULLWIDTH and TIFFTAG_PIXAR_IMAGEFULLLENGTH are set when an image has been cropped out of a larger image. - They reflect the size of the original uncropped image. The TIFFTAG_XPOSITION and TIFFTAG_YPOSITION can be used to determine the - position of the smaller image in the larger one. } - TIFFTAG_PIXAR_IMAGEFULLWIDTH = 33300; { full image size in x } - TIFFTAG_PIXAR_IMAGEFULLLENGTH = 33301; { full image size in y } - { Tags 33302-33306 are used to identify special image modes and data used by Pixar's texture formats. } - TIFFTAG_PIXAR_TEXTUREFORMAT = 33302; { texture map format } - TIFFTAG_PIXAR_WRAPMODES = 33303; { s & t wrap modes } - TIFFTAG_PIXAR_FOVCOT = 33304; { cotan(fov) for env. maps } - TIFFTAG_PIXAR_MATRIX_WORLDTOSCREEN = 33305; - TIFFTAG_PIXAR_MATRIX_WORLDTOCAMERA = 33306; - { tag 33405 is a private tag registered to Eastman Kodak } - TIFFTAG_WRITERSERIALNUMBER = 33405; { device serial number } - { tag 33432 is listed in the 6.0 spec w/ unknown ownership } - TIFFTAG_COPYRIGHT = 33432; { copyright string } - { IPTC TAG from RichTIFF specifications } - TIFFTAG_RICHTIFFIPTC = 33723; - { 34016-34029 are reserved for ANSI IT8 TIFF/IT } - TIFFTAG_STONITS = 37439; { Sample value to Nits } - { tag 34929 is a private tag registered to FedEx } - TIFFTAG_FEDEX_EDR = 34929; { unknown use } - { tag 65535 is an undefined tag used by Eastman Kodak } - TIFFTAG_DCSHUESHIFTVALUES = 65535; { hue shift correction data } - { The following are ``pseudo tags'' that can be used to control codec-specific functionality. These tags are not written to file. - Note that these values start at 0xffff+1 so that they'll never collide with Aldus-assigned tags. } - TIFFTAG_FAXMODE = 65536; { Group 3/4 format control } - FAXMODE_CLASSIC = $0; { default, include RTC } - FAXMODE_NORTC = $1; { no RTC at end of data } - FAXMODE_NOEOL = $2; { no EOL code at end of row } - FAXMODE_BYTEALIGN = $4; { byte align row } - FAXMODE_WORDALIGN = $8; { word align row } - FAXMODE_CLASSF = FAXMODE_NORTC; { TIFF Class F } - TIFFTAG_JPEGQUALITY = 65537; { Compression quality level } - { Note: quality level is on the IJG 0-100 scale. Default value is 75 } - TIFFTAG_JPEGCOLORMODE = 65538; { Auto RGB<=>YCbCr convert? } - JPEGCOLORMODE_RAW = $0; { no conversion (default) } - JPEGCOLORMODE_RGB = $1; { do auto conversion } - TIFFTAG_JPEGTABLESMODE = 65539; { What to put in JPEGTables } - JPEGTABLESMODE_QUANT = $1; { include quantization tbls } - JPEGTABLESMODE_HUFF = $2; { include Huffman tbls } - { Note: default is JPEGTABLESMODE_QUANT | JPEGTABLESMODE_HUFF } - TIFFTAG_FAXFILLFUNC = 65540; { G3/G4 fill function } - TIFFTAG_PIXARLOGDATAFMT = 65549; { PixarLogCodec I/O data sz } - PIXARLOGDATAFMT_8BIT = 0; { regular u_char samples } - PIXARLOGDATAFMT_8BITABGR = 1; { ABGR-order u_chars } - PIXARLOGDATAFMT_11BITLOG = 2; { 11-bit log-encoded (raw) } - PIXARLOGDATAFMT_12BITPICIO = 3; { as per PICIO (1.0==2048) } - PIXARLOGDATAFMT_16BIT = 4; { signed short samples } - PIXARLOGDATAFMT_FLOAT = 5; { IEEE float samples } - { 65550-65556 are allocated to Oceana Matrix } - TIFFTAG_DCSIMAGERTYPE = 65550; { imager model & filter } - DCSIMAGERMODEL_M3 = 0; { M3 chip (1280 x 1024) } - DCSIMAGERMODEL_M5 = 1; { M5 chip (1536 x 1024) } - DCSIMAGERMODEL_M6 = 2; { M6 chip (3072 x 2048) } - DCSIMAGERFILTER_IR = 0; { infrared filter } - DCSIMAGERFILTER_MONO = 1; { monochrome filter } - DCSIMAGERFILTER_CFA = 2; { color filter array } - DCSIMAGERFILTER_OTHER = 3; { other filter } - TIFFTAG_DCSINTERPMODE = 65551; { interpolation mode } - DCSINTERPMODE_NORMAL = 0; { whole image, default } - DCSINTERPMODE_PREVIEW = 1; { preview of image (384x256) } - TIFFTAG_DCSBALANCEARRAY = 65552; { color balance values } - TIFFTAG_DCSCORRECTMATRIX = 65553; { color correction values } - TIFFTAG_DCSGAMMA = 65554; { gamma value } - TIFFTAG_DCSTOESHOULDERPTS = 65555; { toe & shoulder points } - TIFFTAG_DCSCALIBRATIONFD = 65556; { calibration file desc } - { Note: quality level is on the ZLIB 1-9 scale. Default value is -1 } - TIFFTAG_ZIPQUALITY = 65557; { compression quality level } - TIFFTAG_PIXARLOGQUALITY = 65558; { PixarLog uses same scale } - { 65559 is allocated to Oceana Matrix } - TIFFTAG_DCSCLIPRECTANGLE = 65559; { area of image to acquire } - TIFFTAG_SGILOGDATAFMT = 65560; { SGILog user data format } - SGILOGDATAFMT_FLOAT = 0; { IEEE float samples } - SGILOGDATAFMT_16BIT = 1; { 16-bit samples } - SGILOGDATAFMT_RAW = 2; { uninterpreted data } - SGILOGDATAFMT_8BIT = 3; { 8-bit RGB monitor values } - TIFFTAG_SGILOGENCODE = 65561; { SGILog data encoding control } - SGILOGENCODE_NODITHER = 0; { do not dither encoded values } - SGILOGENCODE_RANDITHER = 1; { randomly dither encd values } - - - { Flags to pass to TIFFPrintDirectory to control printing of data structures that are potentially very large. Bit-or these flags to - enable printing multiple items. } - TIFFPRINT_NONE = $0; { no extra info } - TIFFPRINT_STRIPS = $1; { strips/tiles info } - TIFFPRINT_CURVES = $2; { color/gray response curves } - TIFFPRINT_COLORMAP = $4; { colormap } - TIFFPRINT_JPEGQTABLES = $100; { JPEG Q matrices } - TIFFPRINT_JPEGACTABLES = $200; { JPEG AC tables } - TIFFPRINT_JPEGDCTABLES = $200; { JPEG DC tables } - - - TIFF_ANY = TIFF_NOTYPE; { for field descriptor searching } - TIFF_VARIABLE = -1; { marker for variable length tags } - TIFF_SPP = -2; { marker for SamplesPerPixel tags } - TIFF_VARIABLE2 = -3; { marker for uint32 var-length tags } - - FIELD_CUSTOM = 65; - - {added for LibTiff 3.9.4 by Alex (leontyyy@gmail.com) Dec.2011} - TIFFTAG_EXIFIFD = 34665; { pointer to the Exif IFD } - EXIFTAG_FOCALLENGTH = 37386; { focal length } - EXIFTAG_FOCALLENGTHIN35MMFILM = 41989; { indicates the equivalent focal length assuming a 35mm film camera, in mm } - EXIFTAG_EXIFVERSION = 36864; { version of exif format } - EXIFTAG_DATETIMEDIGITIZED = 36868; { date and time when the image was stored as digital data } - EXIFTAG_DATETIMEORIGINAL = 36867; { date and time when the original image data was generated } - EXIFTAG_EXPOSURETIME = 33434; { exposure time, given in seconds } - EXIFTAG_FNUMBER = 33437; { F number } - EXIFTAG_EXPOSUREPROGRAM = 34850; { class of the program used by the camera to set exposure } - EXIFTAG_SPECTRALSENSITIVITY = 34852; { spectral sensitivity of each channel of the camera used } - EXIFTAG_ISOSPEEDRATINGS = 34855; { ISO Speed and ISO Latitude } - EXIFTAG_OECF = 34856; { Opto-Electric Conversion Function } - EXIFTAG_COMPONENTSCONFIGURATION = 37121; { meaning of each component } - EXIFTAG_COMPRESSEDBITSPERPIXEL = 37122; { compression mode } - EXIFTAG_SHUTTERSPEEDVALUE = 37377; { shutter speed } - EXIFTAG_APERTUREVALUE = 37378; { lens aperture } - EXIFTAG_BRIGHTNESSVALUE = 37379; { brightness } - EXIFTAG_EXPOSUREBIASVALUE = 37380; { exposure bias } - EXIFTAG_MAXAPERTUREVALUE = 37381; { maximum lens aperture } - EXIFTAG_SUBJECTDISTANCE = 37382; { distance to the subject in meters } - EXIFTAG_METERINGMODE = 37383; { metering mode } - EXIFTAG_LIGHTSOURCE = 37384; { light source } - EXIFTAG_FLASH = 37385; { flash } - EXIFTAG_SUBJECTAREA = 37396; { subject area (in exif ver.2.2) } - EXIFTAG_MAKERNOTE = 37500; { manufacturer notes } - EXIFTAG_USERCOMMENT = 37510; { user comments } - EXIFTAG_SUBSECTIME = 37520; { DateTime subseconds } - EXIFTAG_SUBSECTIMEORIGINAL = 37521; { DateTimeOriginal subseconds } - EXIFTAG_SUBSECTIMEDIGITIZED = 37522; { DateTimeDigitized subseconds } - EXIFTAG_FLASHPIXVERSION = 40960; { FlashPix format version } - EXIFTAG_COLORSPACE = 40961; { color space information } - EXIFTAG_PIXELXDIMENSION = 40962; { valid image width } - EXIFTAG_PIXELYDIMENSION = 40963; { valid image height } - EXIFTAG_RELATEDSOUNDFILE = 40964; { related audio file } - EXIFTAG_FLASHENERGY = 41483; { flash energy } - EXIFTAG_SPATIALFREQUENCYRESPONSE = 41484; { spatial frequency response } - EXIFTAG_FOCALPLANEXRESOLUTION = 41486; { focal plane X resolution } - EXIFTAG_FOCALPLANEYRESOLUTION = 41487; { focal plane Y resolution } - EXIFTAG_FOCALPLANERESOLUTIONUNIT = 41488; { focal plane resolution unit } - EXIFTAG_SUBJECTLOCATION = 41492; { subject location } - EXIFTAG_EXPOSUREINDEX = 41493; { exposure index } - EXIFTAG_SENSINGMETHOD = 41495; { sensing method } - EXIFTAG_FILESOURCE = 41728; { file source } - EXIFTAG_SCENETYPE = 41729; { scene type } - EXIFTAG_CFAPATTERN = 41730; { CFA pattern } - EXIFTAG_CUSTOMRENDERED = 41985; { custom image processing (in exif ver.2.2) } - EXIFTAG_EXPOSUREMODE = 41986; { exposure mode (in exif ver.2.2) } - EXIFTAG_WHITEBALANCE = 41987; { white balance (in exif ver.2.2) } - EXIFTAG_DIGITALZOOMRATIO = 41988; { digital zoom ratio (in exif ver.2.2) } - EXIFTAG_SCENECAPTURETYPE = 41990; { scene capture type (in exif ver.2.2) } - EXIFTAG_GAINCONTROL = 41991; { gain control (in exif ver.2.2) } - EXIFTAG_CONTRAST = 41992; { contrast (in exif ver.2.2) } - EXIFTAG_SATURATION = 41993; { saturation (in exif ver.2.2) } - EXIFTAG_SHARPNESS = 41994; { sharpness (in exif ver.2.2) } - EXIFTAG_DEVICESETTINGDESCRIPTION = 41995; { device settings description (in exif ver.2.2) } - EXIFTAG_SUBJECTDISTANCERANGE = 41996; { subject distance range (in exif ver.2.2) } - EXIFTAG_IMAGEUNIQUEID = 42016; { Unique image ID (in exif ver.2.2) } - -type - PTIFF = Pointer; - PTIFFRGBAImage = Pointer; - - TIFFReadWriteProc = function(fd: thandle_t; buf: tdata_t; size: tsize_t): tsize_t; cdecl; - TIFFSeekProc = function(fd: thandle_t; off: toff_t; whence: Integer): toff_t; cdecl; - TIFFCloseProc = function(fd: thandle_t): Integer; cdecl; - TIFFSizeProc = function(fd: thandle_t): toff_t; cdecl; - TIFFMapFileProc = function(fd: thandle_t; var pbase: tdata_t; var psize: toff_t): Integer; cdecl; - TIFFUnmapFileProc = procedure(fd: thandle_t; base: tdata_t; size: toff_t); cdecl; - TIFFExtendProc = procedure(Handle: PTIFF); cdecl; - TIFFErrorHandler = procedure(Module: PAnsiChar; const Format: PAnsiChar; Params: va_list); cdecl; - TIFFInitMethod = function(Handle: PTIFF; Scheme: Integer): Integer; cdecl; - - PTIFFCodec = ^TIFFCodec; - TIFFCodec = record - Name: PAnsiChar; - Scheme: Word; - Init: TIFFInitMethod; - end; - - PTIFFFieldInfo = ^TIFFFieldInfo; - TIFFFieldInfo = record - FieldTag: Cardinal; { field's tag } - FieldReadCount: Smallint; { read count/TIFF_VARIABLE/TIFF_SPP } - FieldWriteCount: Smallint; { write count/TIFF_VARIABLE } - FieldType: Integer; { type of associated data } - FieldBit: Word; { bit in fieldsset bit vector } - FieldOkToChange: Byte; { if true, can change while writing } - FieldPassCount: Byte; { if true, pass dir count on set } - FieldName: PAnsiChar; { ASCII name } - end; - - PTIFFTagValue = ^TIFFTagValue; - TIFFTagValue = record - Info: PTIFFFieldInfo; - Count: Integer; - Value: Pointer; - end; - -{$IFDEF DYNAMIC_DLL_LOADING} -var - TIFFGetVersion: function(): PAnsiChar; cdecl; - TIFFOpen: function (const FileName: PAnsiChar; const Mode: PAnsiChar): PTIFF; cdecl; - TIFFClientOpen: function( - const Name: PAnsiChar; - const Mode: PAnsiChar; - ClientData: Cardinal; - ReadProc: TIFFReadWriteProc; - WriteProc: TIFFReadWriteProc; - SeekProc: TIFFSeekProc; - CloseProc: TIFFCloseProc; - SizeProc: TIFFSizeProc; - MapProc: TIFFMapFileProc; - UnmapProc: TIFFUnmapFileProc): PTIFF; cdecl; - TIFFClose: procedure(Handle: PTIFF); cdecl; - TIFFSetFileno: function(Handle: PTIFF; Newvalue: Integer): Integer; cdecl; - TIFFSetField: function(Handle: PTIFF; Tag: Cardinal): Integer; cdecl varargs; - TIFFGetField: function(Handle: PTIFF; Tag: Cardinal): Integer; cdecl varargs; - TIFFGetFieldDefaulted: function(Handle: PTIFF; Tag: Cardinal): Integer; cdecl varargs; - TIFFReadRGBAImageOriented: function(Handle: PTIFF; RWidth,RHeight: Cardinal; Raster: Pointer; Orientation: Integer; Stop: Integer): Integer; cdecl; - TIFFReadScanline: function(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: tsample_t): Integer; cdecl; - TIFFWriteScanline: function(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: tsample_t): Integer; cdecl; - TIFFScanlineSize: function(Handle: PTIFF): tmsize_t; cdecl; - TIFFDefaultStripSize: function(Handle: PTIFF; Request: Cardinal): Cardinal; cdecl; - TIFFNumberOfDirectories: function(Handle: PTIFF): Word; cdecl; - TIFFSetDirectory: function(Handle: PTIFF; Dirn: Word): Integer; cdecl; - TIFFWriteDirectory: function(Handle: PTIFF): Integer; cdecl; - TIFFReadEXIFDirectory: function(Handle: PTIFF; Diroff: toff_t): Integer; cdecl; - TIFFSetErrorHandler: function(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; - TIFFSetWarningHandler: function(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; - -function LoadTiffLibrary: Boolean; -{$ELSE} -function TIFFGetVersion: PAnsiChar; cdecl; external SLibName; -function TIFFFindCODEC(Scheme: Word): PTIFFCodec; cdecl; external SLibName; -function TIFFRegisterCODEC(Scheme: Word; Name: PAnsiChar; InitMethod: TIFFInitMethod): PTIFFCodec; cdecl; external SLibName; -procedure TIFFUnRegisterCODEC(c: PTIFFCodec); cdecl; external SLibName; -function TIFFIsCODECConfigured(Scheme: Word): Integer; cdecl; external SLibName; -function TIFFGetConfiguredCODECs: PTIFFCodec; cdecl; external SLibName; -function TIFFClientOpen(Name: PAnsiChar; Mode: PAnsiChar; ClientData: THandle; - ReadProc: TIFFReadWriteProc; - WriteProc: TIFFReadWriteProc; - SeekProc: TIFFSeekProc; - CloseProc: TIFFCloseProc; - SizeProc: TIFFSizeProc; - MapProc: TIFFMapFileProc; - UnmapProc: TIFFUnmapFileProc): PTIFF; cdecl; external SLibName; -procedure TIFFCleanup(Handle: PTIFF); cdecl; external SLibName; -procedure TIFFClose(Handle: PTIFF); cdecl; external SLibName; -function TIFFFileno(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFSetFileno(Handle: PTIFF; Newvalue: Integer): Integer; cdecl; external SLibName; -function TIFFClientdata(Handle: PTIFF): THandle; cdecl; external SLibName; -function TIFFSetClientdata(Handle: PTIFF; Newvalue: THandle): THandle; cdecl; external SLibName; -function TIFFGetMode(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFSetMode(Handle: PTIFF; Mode: Integer): Integer; cdecl; external SLibName; -function TIFFFileName(Handle: PTIFF): Pointer; cdecl; external SLibName; -function TIFFSetFileName(Handle: PTIFF; Name: PAnsiChar): PAnsiChar; cdecl; external SLibName; -function TIFFGetReadProc(Handle: PTIFF): TIFFReadWriteProc; cdecl; external SLibName; -function TIFFGetWriteProc(Handle: PTIFF): TIFFReadWriteProc; cdecl; external SLibName; -function TIFFGetSeekProc(Handle: PTIFF): TIFFSeekProc; cdecl; external SLibName; -function TIFFGetCloseProc(Handle: PTIFF): TIFFCloseProc; cdecl; external SLibName; -function TIFFGetSizeProc(Handle: PTIFF): TIFFSizeProc; cdecl; external SLibName; -procedure TIFFError(Module: Pointer; Fmt: Pointer); cdecl; external SLibName; varargs; -function TIFFSetErrorHandler(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; external SLibName; -procedure TIFFWarning(Module: Pointer; Fmt: Pointer); cdecl; external SLibName; varargs; -function TIFFSetWarningHandler(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; external SLibName; -function TIFFSetTagExtender(Extender: TIFFExtendProc): TIFFExtendProc; cdecl; external SLibName; -function TIFFFlush(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFFlushData(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFReadEXIFDirectory(Handle: PTIFF; Diroff: toff_t): Integer; cdecl; external SLibName; -function TIFFReadDirectory(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFCurrentDirectory(Handle: PTIFF): Word; cdecl; external SLibName; -function TIFFCurrentDirOffset(Handle: PTIFF): toff_t; cdecl; external SLibName; -function TIFFLastDirectory(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFNumberOfDirectories(Handle: PTIFF): Word; cdecl; external SLibName; -function TIFFSetDirectory(Handle: PTIFF; Dirn: Word): Integer; cdecl; external SLibName; -function TIFFSetSubDirectory(Handle: PTIFF; Diroff: toff_t): Integer; cdecl; external SLibName; -function TIFFCreateDirectory(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFWriteDirectory(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFUnlinkDirectory(handle: PTIFF; Dirn: Word): Integer; cdecl; external SLibName; -procedure TIFFPrintDirectory(Handle: PTIFF; Fd: Pointer; Flags: Integer); cdecl; external SLibName; -function TIFFGetField(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external SLibName; varargs; -function TIFFGetFieldDefaulted(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external SLibName; varargs; -function TIFFVGetField(Handle: PTIFF; Tag: Cardinal; Ap: Pointer): Integer; cdecl; external SLibName; -function TIFFSetField(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external SLibName; varargs; -function TIFFVSetField(Handle: PTIFF; Tag: Cardinal; Ap: Pointer): Integer; cdecl; external SLibName; -function TIFFIsBigEndian(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFIsTiled(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFIsByteSwapped(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFIsUpSampled(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFIsMSB2LSB(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFGetTagListCount(Handle: PTIFF): Integer; cdecl; external SLibName; -function TIFFGetTagListEntry(Handle: PTIFF; TagIndex: Integer): Cardinal; cdecl; external SLibName; -procedure TIFFMergeFieldInfo(Handle: PTIFF; Info: PTIFFFieldInfo; N: Integer); cdecl; external SLibName; -function TIFFFindFieldInfo(Handle: PTIFF; Tag: Cardinal; Dt: Integer): PTIFFFieldInfo; cdecl; external SLibName; -function TIFFFindFieldInfoByName(Handle: PTIFF; FIeldName: PAnsiChar; Dt: Integer): PTIFFFieldInfo; cdecl; external SLibName; -function TIFFFieldWithTag(Handle: PTIFF; Tag: Cardinal): PTIFFFieldInfo; cdecl; external SLibName; -function TIFFFieldWithName(Handle: PTIFF; FieldName: PAnsiChar): PTIFFFieldInfo; cdecl; external SLibName; -function TIFFDataWidth(DataType: Integer): Integer; cdecl; external SLibName; -function TIFFReadRGBAImage(Handle: PTIFF; RWidth,RHeight: Cardinal; Raster: Pointer; Stop: Integer): Integer; cdecl; external SLibName; -function TIFFReadRGBAImageOriented(Handle: PTIFF; RWidth,RHeight: Cardinal; Raster: Pointer; Orientation: Integer; Stop: Integer): Integer; cdecl; external SLibName; -function TIFFReadRGBAStrip(Handle: PTIFF; Row: Cardinal; Raster: Pointer): Integer; cdecl; external SLibName; -function TIFFReadRGBATile(Handle: PTIFF; Col,Row: Cardinal; Raster: Pointer): Integer; cdecl; external SLibName; -function TIFFRGBAImageOk(Handle: PTIFF; Emsg: PAnsiChar): Integer; cdecl; external SLibName; -function TIFFRGBAImageBegin(Img: PTIFFRGBAImage; Handle: PTIFF; Stop: Integer; Emsg: PAnsiChar): Integer; cdecl; external SLibName; -function TIFFRGBAImageGet(Img: PTIFFRGBAImage; Raster: Pointer; W, H: Cardinal): Integer; cdecl; external SLibName; -procedure TIFFRGBAImageEnd(Img: PTIFFRGBAImage); cdecl; external SLibName; -function TIFFCurrentRow(Handle: PTIFF): Cardinal; cdecl; external SLibName; -function TIFFStripSize(Handle: PTIFF): tmsize_t; cdecl; external SLibName; -function TIFFRawStripSize(Handle: PTIFF; Strip: Cardinal): tmsize_t; cdecl; external SLibName; -function TIFFVStripSize(Handle: PTIFF; NRows: Cardinal): tmsize_t; cdecl; external SLibName; -function TIFFDefaultStripSize(Handle: PTIFF; Request: Cardinal): Cardinal; cdecl; external SLibName; -function TIFFNumberOfStrips(Handle: PTIFF): Cardinal; cdecl; external SLibName; -function TIFFComputeStrip(Handle: PTIFF; Row: Cardinal; Sample: Word): Cardinal; cdecl; external SLibName; -function TIFFReadRawStrip(Handle: PTIFF; Strip: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFReadEncodedStrip(Handle: PTIFF; Strip: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFWriteRawStrip(Handle: PTIFF; Strip: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFWriteEncodedStrip(Handle: PTIFF; Strip: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFCurrentStrip(Handle: PTIFF): Cardinal; cdecl; external SLibName; -function TIFFTileSize(Handle: PTIFF): tmsize_t; cdecl; external SLibName; -function TIFFTileRowSize(Handle: PTIFF): tmsize_t; cdecl; external SLibName; -function TIFFVTileSize(Handle: PTIFF; NRows: Cardinal): tmsize_t; cdecl; external SLibName; -procedure TIFFDefaultTileSize(Handle: PTIFF; Tw: PCardinal; Th: PCardinal); cdecl; external SLibName; -function TIFFNumberOfTiles(Handle: PTIFF): Cardinal; cdecl; external SLibName; -function TIFFComputeTile(Handle: PTIFF; X,Y,Z: Cardinal; S: Word): Cardinal; cdecl; external SLibName; -function TIFFReadRawTile(Handle: PTIFF; Tile: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFReadEncodedTile(Handle: PTIFF; Tile: Cardinal; Buf: Pointer; Size: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFWriteRawTile(Handle: PTIFF; Tile: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFWriteEncodedTile(Handle: PTIFF; Tile: Cardinal; Data: Pointer; Cc: tmsize_t): tmsize_t; cdecl; external SLibName; -function TIFFCurrentTile(Handle: PTIFF): Cardinal; cdecl; external SLibName; -function TIFFScanlineSize(Handle: PTIFF): tmsize_t; cdecl; external SLibName; -function TIFFScanlineSize64(Handle: PTIFF): Int64; cdecl; external SLibName; -function TIFFRasterScanlineSize64(Handle: PTIFF): Int64; cdecl; external SLibName; -function TIFFRasterScanlineSize(Handle: PTIFF): tmsize_t; cdecl; external SLibName; -function TIFFReadScanline(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: tsample_t): Integer; cdecl; external SLibName; -function TIFFWriteScanline(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: tsample_t): Integer; cdecl; external SLibName; -procedure TIFFSetWriteOffset(Handle: PTIFF; Off: toff_t); cdecl; external SLibName; -procedure TIFFSwabShort(Wp: PWord); cdecl; external SLibName; -procedure TIFFSwabLong(Lp: PCardinal); cdecl; external SLibName; -procedure TIFFSwabDouble(Dp: PDouble); cdecl; external SLibName; -procedure TIFFSwabArrayOfShort(Wp: PWord; N: tmsize_t); cdecl; external SLibName; -procedure TIFFSwabArrayOfTriples(tp:PByte; n: tmsize_t); cdecl; external SLibName; -procedure TIFFSwabArrayOfLong(Lp: PCardinal; N: tmsize_t); cdecl; external SLibName; -procedure TIFFSwabArrayOfDouble(Dp: PDouble; N: tmsize_t); cdecl; external SLibName; -procedure TIFFReverseBits(Cp: Pointer; N: tmsize_t); cdecl; external SLibName; -function TIFFGetBitRevTable(Reversed: Integer): Pointer; cdecl; external SLibName; -{$ENDIF} - -type - TUserTiffErrorHandler = procedure(const Module, Message: AnsiString); - -procedure SetUserMessageHandlers(ErrorHandler, WarningHandler: TUserTiffErrorHandler); -function IsVersion4: Boolean; - -implementation - -{$IFDEF FPC} -uses - dynlibs; -{$ENDIF} - -var - UserTiffWarningHandler: TUserTiffErrorHandler; - UserTiffErrorHandler: TUserTiffErrorHandler; - -procedure SetUserMessageHandlers(ErrorHandler, WarningHandler: TUserTiffErrorHandler); -begin - UserTiffErrorHandler := ErrorHandler; - UserTiffWarningHandler := WarningHandler; -end; - -procedure SetInternalMessageHandlers(ErrorHandler, WarningHandler: TIFFErrorHandler); -begin - TIFFSetWarningHandler(@WarningHandler); - TIFFSetErrorHandler(@ErrorHandler); -end; - -const -{$IFDEF MSWINDOWS} - SRuntimeLib = 'msvcrt.dll'; -{$ELSE} - SRuntimeLib = 'libc.so'; -{$ENDIF} - -function snprintf(S: PAnsiChar; N: Integer; const Format: PAnsiChar): Integer; cdecl; varargs; external SRuntimeLib name {$IFDEF MSWINDOWS}'_snprintf'{$ELSE}'snprintf'{$ENDIF}; - -procedure FormatAndCallHandler(Handler: TUserTiffErrorHandler; Module: PAnsiChar; Format: PAnsiChar; Params: va_list); -var - Len: Integer; - Buffer: array[0..511] of AnsiChar; - Msg: AnsiString; -begin - Len := snprintf(@Buffer, 512, Format, Params); - SetString(Msg, Buffer, Len); - Handler(Module, Msg); -end; - -procedure InternalTIFFWarning(Module: PAnsiChar; Format: PAnsiChar; Params: va_list); cdecl; -begin - if Assigned(UserTiffWarningHandler) then - FormatAndCallHandler(UserTiffWarningHandler, Module, Format, Params); -end; - -procedure InternallTIFFError(Module: PAnsiChar; Format: PAnsiChar; Params: va_list); cdecl; -begin - if Assigned(UserTiffErrorHandler) then - FormatAndCallHandler(UserTiffErrorHandler, Module, Format, Params); -end; - -function IsVersion4: Boolean; -var - Version: PAnsiChar; -begin - Version := TIFFGetVersion; - Result := Pos(AnsiString('Version 4'), Version) > 0; -end; - -procedure CheckVersion; -begin -{$IFDEF UNIX} - if not IsVersion4 then - WriteLn('Warning: installed libtiff seems to be version 3.x. TIFF functions will probably fail. Install libtiff5 package to get libtiff 4.x.'); -{$ENDIF} -end; - -{$IFDEF DYNAMIC_DLL_LOADING} -var - TiffLibHandle: {$IFDEF FPC}TLibHandle{$ELSE}THandle{$ENDIF} = 0; - -function GetProcAddr(const AProcName: PAnsiChar): Pointer; -begin - Result := GetProcAddress(TiffLibHandle, AProcName); - if Addr(Result) = nil then begin - RaiseLastOSError; - end; -end; - -function LoadTiffLibrary: Boolean; -begin - Result := False; - - if TiffLibHandle = 0 then - begin - TiffLibHandle := LoadLibrary(SLibName); - {$IF Defined(DARWIN)} - if TiffLibHandle = 0 then - TiffLibHandle := LoadLibrary('@executable_path/' + SLibName); - {$IFEND} - - if TiffLibHandle <> 0 then - begin - TIFFGetVersion := GetProcAddr('TIFFGetVersion'); - TIFFOpen := GetProcAddr('TIFFOpen'); - TIFFClientOpen := GetProcAddr('TIFFClientOpen'); - TIFFClose := GetProcAddr('TIFFClose'); - TIFFSetFileno := GetProcAddr('TIFFSetFileno'); - TIFFSetField := GetProcAddr('TIFFSetField'); - TIFFGetField := GetProcAddr('TIFFGetField'); - TIFFGetFieldDefaulted := GetProcAddr('TIFFGetFieldDefaulted'); - TIFFReadRGBAImageOriented := GetProcAddr('TIFFReadRGBAImageOriented'); - TIFFReadScanline := GetProcAddr('TIFFReadScanline'); - TIFFWriteScanline := GetProcAddr('TIFFWriteScanline'); - TIFFScanlineSize := GetProcAddr('TIFFScanlineSize'); - TIFFDefaultStripSize := GetProcAddr('TIFFDefaultStripSize'); - TIFFNumberOfDirectories := GetProcAddr('TIFFNumberOfDirectories'); - TIFFSetDirectory := GetProcAddr('TIFFSetDirectory'); - TIFFWriteDirectory := GetProcAddr('TIFFWriteDirectory'); - TIFFReadEXIFDirectory := GetProcAddr('TIFFReadEXIFDirectory'); - TIFFSetErrorHandler := GetProcAddr('TIFFSetErrorHandler'); - TIFFSetWarningHandler := GetProcAddr('TIFFSetWarningHandler'); - - SetInternalMessageHandlers(@InternallTIFFError, @InternalTIFFWarning); - CheckVersion; - - Result := True; - end; - end; -end; - -procedure FreeTiffLibrary; -begin - if TiffLibHandle <> 0 then begin - FreeLibrary(TiffLibHandle); - TiffLibHandle := 0; - end; -end; -{$ENDIF} - -initialization -{$IFNDEF DYNAMIC_DLL_LOADING} - SetInternalMessageHandlers(@InternallTIFFError, @InternalTIFFWarning); - CheckVersion; -{$ENDIF} - -finalization -{$IFDEF DYNAMIC_DLL_LOADING} - FreeTiffLibrary; -{$ENDIF} -end. - diff --git a/components/vampireimaging/Extras/Extensions/LibTiff/ZLibDelphi.pas b/components/vampireimaging/Extras/Extensions/LibTiff/ZLibDelphi.pas deleted file mode 100644 index 1c91b4b..0000000 --- a/components/vampireimaging/Extras/Extensions/LibTiff/ZLibDelphi.pas +++ /dev/null @@ -1,89 +0,0 @@ -unit ZLibDelphi; - -{$IFDEF FPC} - {$MODE OBJFPC} -{$ELSE} - {$DEFINE DCC} -{$ENDIF} - -interface - -uses - SysUtils; - -const - - ZLIB_VERSION = '1.2.1'; - - Z_NO_FLUSH = 0; - Z_FINISH = 4; - - Z_OK = 0; - Z_STREAM_END = 1; - -type - - PRZStream = ^RZStream; - - RZStream = record - NextIn: PByte; - AvailIn: Cardinal; - TotalIn: Cardinal; - NextOut: PByte; - AvailOut: Cardinal; - TotalOut: Cardinal; - Msg: PAnsiChar; - State: Pointer; - AllocFunc: Pointer; - FreeFunc: Pointer; - Opaque: Cardinal; - DataType: Integer; - Adler: Cardinal; - Reserved: Cardinal; - end; - -function inflateInit_(strm: Pointer; version: Pointer; stream_size: Integer): Integer; cdecl; external; -function inflateReset(strm: Pointer): Integer; cdecl; external; -function inflate(strm: Pointer; flush: Integer): Integer; cdecl; external; -function inflateSync(strm: Pointer): Integer; cdecl; external; -function deflateInit(strm: Pointer; level: Integer): Integer; -function deflateInit_(strm: Pointer; level: Integer; version: Pointer; stream_size: Integer): Integer; cdecl; external; -function deflateReset(strm: Pointer): Integer; cdecl; external; -function deflate(strm: Pointer; flush: Integer): Integer; cdecl; external; -function deflateEnd(strm: Pointer): Integer; cdecl; external; -function inflateEnd(strm: Pointer): Integer; cdecl; external; -function deflateParams(strm: Pointer; level: Integer; strategy: Integer): Integer; cdecl; external; - -implementation - -uses - LibDelphi; - -function deflateInit(strm: Pointer; level: Integer): Integer; -begin - Result:=deflateInit_(strm,level,PAnsiChar(ZLIB_VERSION),SizeOf(RZStream)); -end; - -{$IF Defined(DCC) and Defined(MSWINDOWS) and not Defined(CPUX64)} - // Windows 32bit Delphi only - OMF object format - {$L Compiled\inflate.obj} - {$L Compiled\crc32.obj} - {$L Compiled\adler32.obj} - {$L Compiled\inftrees.obj} - {$L Compiled\inffast.obj} - {$L Compiled\deflate.obj} - {$L Compiled\zutil.obj} - {$L Compiled\trees.obj} - {$L Compiled\compress.obj} - {$L Compiled\uncompr.obj} -{$IFEND} - -end. - - - - - - - - diff --git a/components/vampireimaging/Extras/Extensions/OpenJpeg.pas b/components/vampireimaging/Extras/Extensions/OpenJpeg.pas deleted file mode 100644 index d4a4401..0000000 --- a/components/vampireimaging/Extras/Extensions/OpenJpeg.pas +++ /dev/null @@ -1,741 +0,0 @@ -(* - * Copyright (c) 2002-2007, Communications and Remote Sensing Laboratory, Universite catholique de Louvain (UCL), Belgium - * Copyright (c) 2002-2007, Professor Benoit Macq - * Copyright (c) 2001-2003, David Janssens - * Copyright (c) 2002-2003, Yannick Verschueren - * Copyright (c) 2003-2007, Francois-Olivier Devaux and Antonin Descampe - * Copyright (c) 2005, Herve Drolon, FreeImage Team - * Copyright (c) 2006-2007, Parvatha Elangovan - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS `AS IS' - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *) - -{ - PasOpenJpeg - Free JPEG 2000 library for Delphi and Free Pascal - - Headers translated to Object Pascal and C code precompliled - by Marek Mauder (http://galfar.vevb.net) - for Vampyre Imaging Library (http://imaginglib.sourceforge.net). - - Supported compilers: Delphi, Free Pascal - Supported platforms (tested): Windows 32bit, Linux 32/64bit - - OpenJpeg Homepage: http://www.openjpeg.org - PasOpenJpeg Homepage: http://galfar.vevb.net/openjpeg - - Current Version: 1.05 (OpenJpeg 1.3 SVN revision 611 with CDEF/PCLR patch) - - History: - v1.05 (2010-08-12): - - added palette support - - added CMYK support - v1.04 (2010-06-08): - - added few Pascal-looking type aliases - v1.03 (2009-06-04): - - added Mac OSX x86 support - v1.02 (2009-01-30): - - removed linking to stdc++ lib in LINUX/UNIX - v1.01 (2008-12-27): - - Delphi 2009 compatibility checks - v1.00 (2008-03-01): - - CDEF patch for OpenJpeg, added component types -} - -unit OpenJpeg; - -{$IFDEF FPC} - { Free Pascal settings } - {$PACKRECORDS 8} - {$PACKENUM 4} -{$ELSE} - { Delphi settings } - {$DEFINE DCC} - {$ALIGN 8} - {$MINENUMSIZE 4} -{$ENDIF} - -interface - -const - OPENJPEG_VERSION = '1.3.0'; - -type - Bool = ByteBool; - Char = AnsiChar; - -{ Constant Definitions } - -const - { Maximum allowed size for filenames } - OPJ_PATH_LEN = 4096; - - { Number of maximum resolution level authorized } - J2K_MAXRLVLS = 33; - { Number of maximum sub-band linked to number of resolution level } - J2K_MAXBANDS = 3 * J2K_MAXRLVLS - 2; - - JPWL_MAX_NO_TILESPECS = 16; - JPWL_MAX_NO_PACKSPECS = 16; - JPWL_MAX_NO_MARKERS = 512; - JPWL_PRIVATEINDEX_NAME = 'jpwl_index_privatefilename'; - JPWL_EXPECTED_COMPONENTS = 3; - JPWL_MAXIMUM_TILES = 8192; - JPWL_MAXIMUM_HAMMING = 2; - JPWL_MAXIMUM_EPB_ROOM = 65450; - -{ Enum Definitions } - -type - { Rsiz capabilities } - OPJ_RSIZ_CAPABILITIES = ( - STD_RSIZ = 0, { Standard JPEG2000 profile } - CINEMA2K = 3, { Profile name for a 2K image } - CINEMA4K = 4 { Profile name for a 4K image } - ); - - { Digital cinema operation mode } - OPJ_CINEMA_MODE = ( - OFF = 0, { Not Digital Cinema } - CINEMA2K_24 = 1, { 2K Digital Cinema at 24 fps } - CINEMA2K_48 = 2, { 2K Digital Cinema at 48 fps } - CINEMA4K_24 = 3 { 4K Digital Cinema at 24 fps } - ); - - { Progression order } - OPJ_PROG_ORDER = ( - PROG_UNKNOWN = -1, { place-holder } - LRCP = 0, { layer-resolution-component-precinct order } - RLCP = 1, { resolution-layer-component-precinct order } - RPCL = 2, { resolution-precinct-component-layer order } - PCRL = 3, { precinct-component-resolution-layer order } - CPRL = 4 { component-precinct-resolution-layer order } - ); - - { Supported image color spaces } - OPJ_COLOR_SPACE = ( - CLRSPC_UNKNOWN = -1, { place-holder } - CLRSPC_SRGB = 1, { sRGB } - CLRSPC_GRAY = 2, { grayscale } - CLRSPC_SYCC = 3, { YUV } - CLRSPC_CMYK = 4 { CMYK } - ); - TOpjColorSpace = OPJ_COLOR_SPACE; - - { Supported image component types - added by patch } - OPJ_COMPONENT_TYPE = ( - COMPTYPE_UNKNOWN = 0, { unknown component type, cdef box not present } - COMPTYPE_R = 1, { red component of sRGB image } - COMPTYPE_G = 2, { green component of sRGB image } - COMPTYPE_B = 3, { blue component of sRGB image } - COMPTYPE_L = 4, { luminance component of YUV and grayscale images } - COMPTYPE_CB = 5, { Cb component of YUV image } - COMPTYPE_CR = 6, { Cr component of YUV image } - COMPTYPE_OPACITY = 7, { opacity/alpha channel } - COMPTYPE_C = 8, { C component of CMYK image } - COMPTYPE_M = 9, { M component of CMYK image } - COMPTYPE_Y = 10, { Y component of CMYK image } - COMPTYPE_K = 11 { K component of CMYK image } - ); - TOpjComponentType = OPJ_COMPONENT_TYPE; - - { Supported codec } - OPJ_CODEC_FORMAT = ( - CODEC_UNKNOWN = -1, { place-holder } - CODEC_J2K = 0, { JPEG-2000 codestream : read/write } - CODEC_JPT = 1, { JPT-stream (JPEG 2000, JPIP) : read only } - CODEC_JP2 = 2 { JPEG-2000 file format : read/write } - ); - - { Limit decoding to certain portions of the codestream. } - OPJ_LIMIT_DECODING = ( - NO_LIMITATION = 0, { No limitation for the decoding. The entire codestream will de decoded } - LIMIT_TO_MAIN_HEADER = 1, { The decoding is limited to the Main Header } - DECODE_ALL_BUT_PACKETS = 2 { Decode everything except the JPEG 2000 packets } - ); - -{ Event Manager Type Definitions } - - { Callback function prototype for events } - opj_msg_callback = procedure(msg: PAnsiChar; client_data: Pointer); cdecl; - { Message handler object } - opj_event_mgr = record - error_handler: opj_msg_callback; { Error message callback if available, NULL otherwise } - warning_handler: opj_msg_callback; { Warning message callback if available, NULL otherwise } - info_handler: opj_msg_callback; { Debug message callback if available, NULL otherwise } - end; - opj_event_mgr_t = opj_event_mgr; - popj_event_mgr_t = ^opj_event_mgr_t; - - -{ Codec Type Definitions } - - { Progression order changes } - opj_poc = record - resno0, compno0: Integer; - layno1, resno1, compno1: Integer; - layno0, precno0, precno1: Integer; - prg1, prg: OPJ_PROG_ORDER; - progorder: array[0..4] of Char; - tile: Integer; - tx0, tx1, ty0, ty1: Integer; - layS, resS, compS, prcS: Integer; - layE, resE, compE, prcE: Integer; - txS, txE, tyS, tyE, dx, dy: Integer; - lay_t, res_t, comp_t, prc_t, tx0_t, ty0_t: Integer; - end; - opj_poc_t = opj_poc; - - { Compression parameters } - opj_cparameters = record - tile_size_on: Bool; - cp_tx0: Integer; - cp_ty0: Integer; - cp_tdx: Integer; - cp_tdy: Integer; - cp_disto_alloc: Integer; - cp_fixed_alloc: Integer; - cp_fixed_quality: Integer; - cp_matrice: PInteger; - cp_comment: PAnsiChar; - csty: Integer; - prog_order: OPJ_PROG_ORDER; - POC: array[0..31] of opj_poc_t; - numpocs: Integer; - tcp_numlayers: Integer; - tcp_rates: array[0..99] of Single; - tcp_distoratio: array[0..99] of Single; - numresolution: Integer; - cblockw_init: Integer; - cblockh_init: Integer; - mode: Integer; - irreversible: Integer; - roi_compno: Integer; - roi_shift: Integer; - res_spec: Integer; - prcw_init: array[0..J2K_MAXRLVLS - 1] of Integer; - prch_init: array[0..J2K_MAXRLVLS - 1] of Integer; - infile: array[0..OPJ_PATH_LEN - 1] of Char; - outfile: array[0..OPJ_PATH_LEN - 1] of Char; - index_on: Integer; - index: array[0..OPJ_PATH_LEN - 1] of Char; - image_offset_x0: Integer; - image_offset_y0: Integer; - subsampling_dx: Integer; - subsampling_dy: Integer; - decod_format: Integer; - cod_format: Integer; - jpwl_epc_on: Bool; - jpwl_hprot_MH: Integer; - jpwl_hprot_TPH_tileno: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - jpwl_hprot_TPH: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - jpwl_pprot_tileno: array[0..JPWL_MAX_NO_PACKSPECS - 1] of Integer; - jpwl_pprot_packno: array[0..JPWL_MAX_NO_PACKSPECS - 1] of Integer; - jpwl_pprot: array[0..JPWL_MAX_NO_PACKSPECS - 1] of Integer; - jpwl_sens_size: Integer; - jpwl_sens_addr: Integer; - jpwl_sens_range: Integer; - jpwl_sens_MH: Integer; - jpwl_sens_TPH_tileno: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - jpwl_sens_TPH: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - cp_cinema: OPJ_CINEMA_MODE; - max_comp_size: Integer; - cp_rsiz: OPJ_RSIZ_CAPABILITIES; - tp_on: Byte; - tp_flag: Byte; - tcp_mct: Byte; - end; - opj_cparameters_t = opj_cparameters; - popj_cparameters_t = ^opj_cparameters_t; - TOpjCParameters = opj_cparameters_t; - - { Decompression parameters } - opj_dparameters = record - cp_reduce: Integer; - cp_layer: Integer; - infile: array[0..OPJ_PATH_LEN - 1] of Char; - outfile: array[0..OPJ_PATH_LEN - 1] of Char; - decod_format: Integer; - cod_format: Integer; - jpwl_correct: Bool; - jpwl_exp_comps: Integer; - jpwl_max_tiles: Integer; - cp_limit_decoding: OPJ_LIMIT_DECODING; - end; - opj_dparameters_t = opj_dparameters; - popj_dparameters_t = ^opj_dparameters_t; - TOpjDParameters = opj_dparameters_t; - - { Routines that are to be used by both halves of the library are declared - to receive a Pointer to this structure. There are no actual instances of - opj_common_struct_t, only of opj_cinfo_t and opj_dinfo_t. } - opj_common_struct = record - event_mgr: popj_event_mgr_t; { Pointer to the event manager } - client_data: Pointer; { Available for use by application } - is_decompressor: Bool; { So common code can tell which is which } - codec_format: OPJ_CODEC_FORMAT; { selected codec } - j2k_handle: Pointer; { Pointer to the J2K codec } - jp2_handle: Pointer; { Pointer to the JP2 codec } - mj2_handle: Pointer; - end; - opj_common_struct_t = opj_common_struct; - opj_common_ptr = ^opj_common_struct_t; - - { Compression context info } - opj_cinfo = record - event_mgr: popj_event_mgr_t; - client_data: Pointer; - is_decompressor: Bool; - codec_format: OPJ_CODEC_FORMAT; - j2k_handle: Pointer; - jp2_handle: Pointer; - mj2_handle: Pointer; - end; - opj_cinfo_t = opj_cinfo; - popj_cinfo_t = ^opj_cinfo_t; - TOpjCInfo = opj_cinfo_t; - POpjCInfo = popj_cinfo_t; - - { Decompression context info } - opj_dinfo = record - event_mgr: popj_event_mgr_t; - client_data: Pointer; - is_decompressor: Bool; - codec_format: OPJ_CODEC_FORMAT; - j2k_handle: Pointer; - jp2_handle: Pointer; - mj2_handle: Pointer; - end; - opj_dinfo_t = opj_dinfo; - popj_dinfo_t = ^opj_dinfo_t; - TOpjDInfo = opj_dinfo_t; - POpjDInfo = popj_dinfo_t; - -{ I/O Stream Types Definitions } - -const - { Stream open flags } - { The stream was opened for reading } - OPJ_STREAM_READ = $0001; - { The stream was opened for writing } - OPJ_STREAM_WRITE = $0002; - -type - { Byte input-output stream (CIO) } - opj_cio = record - cinfo: opj_common_ptr; { codec context } - openmode: Integer; { open mode (read/write) either OPJ_STREAM_READ or OPJ_STREAM_WRITE } - buffer: PAnsiChar; { Pointer to the start of the buffer } - length: Integer; { buffer size in bytes } - start: PAnsiChar; { Pointer to the start of the stream } - end_: PAnsiChar; { Pointer to the end of the stream } - bp: PAnsiChar; { Pointer to the current position } - end; - opj_cio_t = opj_cio; - popj_cio_t = ^opj_cio_t; - TOpjCio = opj_cio_t; - POpjCio = popj_cio_t; - -{ Image Type Definitions } - - { Defines a single image component } - opj_image_comp = record - dx: Integer; { XRsiz: horizontal separation of a sample of ith component with respect to the reference grid } - dy: Integer; { YRsiz: vertical separation of a sample of ith component with respect to the reference grid } - w: Integer; { data width } - h: Integer; { data height } - x0: Integer; { x component offset compared to the whole image } - y0: Integer; { y component offset compared to the whole image } - prec: Integer; { precision } - bpp: Integer; { image depth in bits } - sgnd: Integer; { signed (1) / unsigned (0) } - resno_decoded: Integer; { number of decoded resolution } - factor: Integer; { number of division by 2 of the out image compared to the original size of image } - comp_type: OPJ_COMPONENT_TYPE; { type of this component: color channel, opacity, ... } - data: PIntegerArray; { image component data } - end; - opj_image_comp_t = opj_image_comp; - popj_image_comp_t = ^opj_image_comp_t; - opj_image_comp_array = array[0..255] of opj_image_comp_t; - popj_image_comp_array = ^opj_image_comp_array; - TOpjImageComp = opj_image_comp_t; - POpjImageComp = popj_image_comp_t; - - { Defines image palette - added by patch } - opj_image_palette = record - hascmap: Integer; { set to one if the original image had a component mapping box } - haspalette: Integer; { set to one if the original image had a palette color box } - numchans: Integer; { number of channels the palette has } - numentrs: Integer; { number of entries the palette has } - sizentr: Integer; { size of one entry for one channel (in bytes) } - paldata: PByte; { byte pointer to the palette data } - end; - opj_image_palette_t = opj_image_palette; - popj_image_palette_t = ^opj_image_palette_t; - - { Defines image data and characteristics } - opj_image = record - x0: Integer; { XOsiz: horizontal offset from the origin of the reference grid to the left side of the image area } - y0: Integer; { YOsiz: vertical offset from the origin of the reference grid to the top side of the image area } - x1: Integer; { Xsiz: width of the reference grid } - y1: Integer; { Ysiz: height of the reference grid } - numcomps: Integer; { number of components in the image } - color_space: OPJ_COLOR_SPACE; { color space: sRGB, Greyscale or YUV } - comps: popj_image_comp_array; { image components } - palette: popj_image_palette_t; { palette structure } - end; - opj_image_t = opj_image; - popj_image_t = ^opj_image_t; - TOpjImage = opj_image_t; - POpjImage = popj_image_t; - - { Component parameters structure used by the opj_image_create function } - opj_image_comptparm = record - dx: Integer; { XRsiz: horizontal separation of a sample of ith component with respect to the reference grid } - dy: Integer; { YRsiz: vertical separation of a sample of ith component with respect to the reference grid } - w: Integer; { data width } - h: Integer; { data height } - x0: Integer; { x component offset compared to the whole image } - y0: Integer; { y component offset compared to the whole image } - prec: Integer; { precision } - bpp: Integer; { image depth in bits } - sgnd: Integer; { signed (1) / unsigned (0) } - comp_type: OPJ_COMPONENT_TYPE; { type of this component: color channel, opacity, ... } - end; - opj_image_cmptparm_t = opj_image_comptparm; - popj_image_cmptparm_t = ^opj_image_cmptparm_t; - opj_image_cmptparm_array = array[0..255] of opj_image_cmptparm_t; - popj_image_cmptparm_array = ^opj_image_cmptparm_array; - TOpjImageCompParam = opj_image_cmptparm_t; - -{ OpenJpeg Version Functions Definitions } - -function opj_version: PAnsiChar; cdecl; external; - -{ Image Functions Definitions } - -{ Create an image - @param numcmpts number of components - @param cmptparms components parameters - @param clrspc image color space - @return returns a new image structure if successful, returns NULL otherwise } -function opj_image_create(numcmpts: Integer; cmptparms: popj_image_cmptparm_t; - clrspc: OPJ_COLOR_SPACE): popj_image_t; cdecl; external; - -{ Deallocate any resources associated with an image - @param image image to be destroyed } -procedure opj_image_destroy(image: popj_image_t); cdecl; external; - -{ Stream Functions Definitions } - -{ Open and allocate a memory stream for read / write. - On reading, the user must provide a buffer containing encoded data. The buffer - will be wrapped by the returned CIO handle. - On writing, buffer parameters must be set to 0: a buffer will be allocated - by the library to contain encoded data. - @param cinfo Codec context info - @param buffer Reading: buffer address. Writing: NULL - @param length Reading: buffer length. Writing: 0 - @return Returns a CIO handle if successful, returns NULL otherwise } -function opj_cio_open(cinfo: opj_common_ptr; buffer: PByte; - length: Integer): popj_cio_t; cdecl; external; - -{ Close and free a CIO handle - @param cio CIO handle to free } -procedure opj_cio_close(cio: popj_cio_t); cdecl; external; - -{ Get position in byte stream - @param cio CIO handle - @return Returns the position in bytes } -function cio_tell(cio: popj_cio_t): Integer; cdecl; external; - -{ Set position in byte stream - @param cio CIO handle - @param pos Position, in number of bytes, from the beginning of the stream } -procedure cio_seek(cio: popj_cio_t; pos: Integer); cdecl; external; - -{ Event Manager Functions Definitions } - -function opj_set_event_mgr(cinfo: opj_common_ptr; event_mgr: popj_event_mgr_t; - context: Pointer): popj_event_mgr_t; cdecl; external; - -{ Codec Functions Definitions } - -{ Creates a J2K/JPT/JP2 decompression structure - @param format Decoder to select - @return Returns a handle to a decompressor if successful, returns NULL otherwise } -function opj_create_decompress(format: OPJ_CODEC_FORMAT): popj_dinfo_t; cdecl; external; - -{ Destroy a decompressor handle - @param dinfo decompressor handle to destroy } -procedure opj_destroy_decompress(dinfo: popj_dinfo_t); cdecl; external; - -{ Set decoding parameters to default values - @param parameters Decompression parameters } -procedure opj_set_default_decoder_parameters(parameters: popj_dparameters_t); cdecl; external ; - -{ Setup the decoder decoding parameters using user parameters. - Decoding parameters are returned in j2k->cp. - @param dinfo decompressor handle - @param parameters decompression parameters } -procedure opj_setup_decoder(dinfo: popj_dinfo_t; parameters: popj_dparameters_t); cdecl; external; - -{ Decode an image from a JPEG-2000 codestream - @param dinfo decompressor handle - @param cio Input buffer stream - @return Returns a decoded image if successful, returns NULL otherwise } -function opj_decode(dinfo: popj_dinfo_t; cio: popj_cio_t): popj_image_t; cdecl; external; - -{ Creates a J2K/JP2 compression structure - @param format Coder to select - @return Returns a handle to a compressor if successful, returns NULL otherwise } -function opj_create_compress(format: OPJ_CODEC_FORMAT): popj_cinfo_t; cdecl; external; - -{ Destroy a compressor handle - @param cinfo compressor handle to destroy } -procedure opj_destroy_compress(cinfo: popj_cinfo_t); cdecl; external; - -{ Set encoding parameters to default values, that means : -
      -
    • Lossless -
    • 1 tile -
    • Size of precinct : 2^15 x 2^15 (means 1 precinct) -
    • Size of code-block : 64 x 64 -
    • Number of resolutions: 6 -
    • No SOP marker in the codestream -
    • No EPH marker in the codestream -
    • No sub-sampling in x or y direction -
    • No mode switch activated -
    • Progression order: LRCP -
    • No index file -
    • No ROI upshifted -
    • No offset of the origin of the image -
    • No offset of the origin of the tiles -
    • Reversible DWT 5-3 -
    - @param parameters Compression parameters } -procedure opj_set_default_encoder_parameters(parameters: popj_cparameters_t); cdecl; external; - -{ Setup the encoder parameters using the current image and using user parameters. - @param cinfo compressor handle - @param parameters compression parameters - @param image input filled image } -procedure opj_setup_encoder(cinfo: popj_cinfo_t; parameters: popj_cparameters_t; - image: popj_image_t); cdecl; external; - -{ Encode an image into a JPEG-2000 codestream - @param cinfo compressor handle - @param cio Output buffer stream - @param image Image to encode - @param index Name of the index file if required, NULL otherwise - @return Returns true if successful, returns false otherwise } -function opj_encode(cinfo: popj_cinfo_t; cio: popj_cio_t; image: popj_image_t; - index: PAnsiChar): Bool; cdecl; external; - -implementation - -{$IF Defined(MSWINDOWS)} - {$IF Defined(DCC)} - { Delphi Win32 } - { Link object files created with C++ Builder.} - {$L J2KObjects\pi.obj} - {$L J2KObjects\openjpeg.obj} - {$L J2KObjects\j2k_lib.obj} - {$L J2KObjects\event.obj} - {$L J2KObjects\cio.obj} - {$L J2KObjects\image.obj} - {$L J2KObjects\j2k.obj} - {$L J2KObjects\jp2.obj} - {$L J2KObjects\jpt.obj} - {$L J2KObjects\mqc.obj} - {$L J2KObjects\raw.obj} - {$L J2KObjects\bio.obj} - {$L J2KObjects\tgt.obj} - {$L J2KObjects\tcd.obj} - {$L J2KObjects\t1.obj} - {$L J2KObjects\dwt.obj} - {$L J2KObjects\t2.obj} - {$L J2KObjects\mct.obj} - - const - { MS C Runtime library needed for importing std C functions.} - MSCRuntimeLib = 'msvcrt.dll'; - var - { Some unresolved external constants.} - __turboFloat: LongBool = False; - _max_dble: Double = 1.7e308; - _streams: Pointer; - - { Internal OpenJpeg functions external declarations. - Delphi yells 'unsatisfied external declaration' if they are not referenced here.} - procedure mqc_create; cdecl; external; - procedure raw_create; cdecl; external; - procedure bio_create; cdecl; external; - procedure opj_image_create0; cdecl; external; - procedure opj_event_msg; cdecl; external; - procedure opj_clock; cdecl; external; - procedure cio_read; cdecl; external; - procedure cio_write; cdecl; external; - procedure cio_skip; cdecl; external; - procedure bio_read; cdecl; external; - procedure bio_write; cdecl; external; - procedure cio_numbytesleft; cdecl; external; - procedure cio_getbp; cdecl; external; - procedure j2k_destroy_compress; cdecl; external; - procedure tgt_create; cdecl; external; - procedure tgt_destroy; cdecl; external; - procedure mqc_bypass_enc; cdecl; external; - procedure mqc_encode; cdecl; external; - procedure mqc_decode; cdecl; external; - procedure raw_decode; cdecl; external; - procedure mqc_resetstates; cdecl; external; - procedure mqc_setstate; cdecl; external; - procedure mqc_init_enc; cdecl; external; - procedure mqc_segmark_enc; cdecl; external; - procedure mqc_flush; cdecl; external; - procedure mqc_bypass_init_enc; cdecl; external; - procedure mqc_numbytes; cdecl; external; - procedure mqc_reset_enc; cdecl; external; - procedure mqc_erterm_enc; cdecl; external; - procedure mqc_init_dec; cdecl; external; - procedure raw_init_dec; cdecl; external; - procedure mqc_destroy; cdecl; external; - procedure mqc_restart_init_enc; cdecl; external; - procedure raw_destroy; cdecl; external; - procedure tgt_reset; cdecl; external; - procedure tgt_setvalue; cdecl; external; - procedure bio_init_enc; cdecl; external; - procedure bio_flush; cdecl; external; - procedure bio_numbytes; cdecl; external; - procedure bio_destroy; cdecl; external; - procedure bio_init_dec; cdecl; external; - procedure pi_create_encode; cdecl; external; - procedure pi_initialise_encode; cdecl; external; - procedure pi_create_decode; cdecl; external; - procedure pi_next; cdecl; external; - procedure pi_destroy; cdecl; external; - procedure tgt_encode; cdecl; external; - procedure tgt_decode; cdecl; external; - procedure bio_inalign; cdecl; external; - - procedure _llmul; cdecl; - asm - { from Delphi's System.pas __llmul } - push edx - push eax - - mov eax, [esp+16] - mul dword ptr [esp] - mov ecx, eax - - mov eax, [esp+4] - mul dword ptr [esp+12] - add ecx, eax - - mov eax, [esp] - mul dword ptr [esp+12] - add edx, ecx - - pop ecx - pop ecx - - ret 8 - end; - - function pow(const Base, Exponent: Double): Double; cdecl; - begin - if Exponent = 0.0 then - Result := 1.0 - else if (Base = 0.0) and (Exponent > 0.0) then - Result := 0.0 - else - Result := Exp(Exponent * Ln(Base)); - end; - - { C library imports } - function malloc(size: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_malloc'{$ENDIF}; - function calloc(nelem, elsize: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_calloc'{$ENDIF}; - procedure free(ptr: Pointer); cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_free'{$ENDIF}; - function realloc(ptr: Pointer; size: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_realloc'{$ENDIF}; - function memset(s: Pointer; c, n: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_memset'{$ENDIF}; - function memcpy(s1, s2: Pointer; n: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_memcpy'{$ENDIF}; - function floor(const x: Double): Double; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_floor'{$ENDIF}; - function ceil(const num: Double): Double; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_ceil'{$ENDIF}; - function printf(format: PAnsiChar): Integer; cdecl; varargs; external MSCRuntimeLib{$IFDEF BCB} name '_printf'{$ENDIF}; - function fprintf(f: Pointer; format: PAnsiChar): Integer; cdecl; varargs; external MSCRuntimeLib{$IFDEF BCB} name '_fprintf'{$ENDIF}; - function vsprintf(s, format: PAnsiChar): Integer; cdecl; varargs; external MSCRuntimeLib{$IFDEF BCB} name '_vsprintf'{$ENDIF}; - function _ftol(x: Single): LongInt; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '__ftol'{$ENDIF}; - function strcpy(s1, s2: PAnsiChar): PAnsiChar; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_strcpy'{$ENDIF}; - function wcscpy(s1, s2: PAnsiChar): PAnsiChar; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_wstrcpy'{$ENDIF}; - function strncpy(s1, s2: PAnsiChar; maxlen: Integer): PAnsiChar; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_strncpy'{$ENDIF}; - function strlen(s: PAnsiChar): Integer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_strlen'{$ENDIF}; - {$ELSEIF Defined(FPC)} - { Free Pascal Win32 } - { Link OpenJpeg static library and C runtime library.} - {$LINKLIB libopenjpegwin32.a} - {$LINKLIB libcrtdll.a} - {$IFEND} - -{$ELSEIF Defined(LINUX)} - {$IF Defined(FPC)} - { Free Pascal Linux } - { Link C runtime library.} - {$LINKLIB c} - {$LINKLIB m} - - {$IF Defined(CPU86)} - { Free Pascal Linux x86 } - { Link OpenJpeg static library.} - {$LINKLIB libopenjpeglinx86.a} - {$ELSEIF Defined(CPUX86_64)} - { Free Pascal Linux x86_64 } - { Link OpenJpeg static library.} - {$LINKLIB libopenjpeglinx86_64.a} - {$ELSE} - No support for this CPU architecture. - {$IFEND} - {$ELSE} - No support for this compiler - {$IFEND} -{$ELSEIF Defined(DARWIN)} - {$IF Defined(FPC)} - { Free Pascal MacOSX } - { Link C runtime library.} - {$LINKLIB c} - - {$IF Defined(CPU86)} - { Free Pascal MacOSX x86 } - { Link OpenJpeg static library.} - {$LINKLIB libopenjpegosxx86.a} - {$ELSE} - No support for this CPU architecture. - {$IFEND} - {$ELSE} - No support for this compiler - {$IFEND} -{$ELSE} - No suppor for this OS -{$IFEND} - -end. - diff --git a/components/vampireimaging/Extras/IdePackages/Lazarus/vampyreimagingpackage.lpk b/components/vampireimaging/Extras/IdePackages/Lazarus/vampyreimagingpackage.lpk deleted file mode 100644 index 5240b0c..0000000 --- a/components/vampireimaging/Extras/IdePackages/Lazarus/vampyreimagingpackage.lpk +++ /dev/null @@ -1,126 +0,0 @@ - - - - - - - - - - - - - - -